|
CP2K 2.5 (Revision 12981)
|
00001 !-----------------------------------------------------------------------------! 00002 ! CP2K: A general program to perform molecular dynamics simulations ! 00003 ! Copyright (C) 2000 - 2013 CP2K developers group ! 00004 !-----------------------------------------------------------------------------! 00005 00006 ! ***************************************************************************** 00028 MODULE cp_units 00029 USE f77_blas 00030 USE kinds, ONLY: default_string_length,& 00031 dp 00032 USE mathconstants, ONLY: radians,& 00033 twopi 00034 USE physcon, ONLY: & 00035 atm, bar, bohr, e_mass, evolt, femtoseconds, joule, kcalmol, kelvin, & 00036 kjmol, massunit, pascal, picoseconds, seconds, wavenumbers 00037 USE string_utilities, ONLY: compress,& 00038 s2a,& 00039 uppercase 00040 #include "cp_common_uses.h" 00041 00042 IMPLICIT NONE 00043 PRIVATE 00044 00045 LOGICAL, PRIVATE, PARAMETER :: debug_this_module=.TRUE. 00046 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'cp_units' 00047 INTEGER, SAVE, PRIVATE :: last_unit_id=0, last_unit_set_id=0 00048 00049 INTEGER, PARAMETER, PUBLIC :: cp_ukind_none=0, 00050 cp_ukind_energy=1, 00051 cp_ukind_length=2, 00052 cp_ukind_temperature=3, 00053 cp_ukind_angle=4, 00054 cp_ukind_pressure=5, 00055 cp_ukind_time=6, 00056 cp_ukind_mass=7, 00057 cp_ukind_undef=8, 00058 cp_ukind_potential=9, 00059 cp_ukind_max=9 00060 00061 ! General 00062 INTEGER, PARAMETER, PUBLIC :: cp_units_none=100, 00063 cp_units_au=101 00064 ! Mass 00065 INTEGER, PARAMETER, PUBLIC :: cp_units_m_e=110, 00066 cp_units_amu=111, 00067 cp_units_kg=112 00068 ! Energy 00069 INTEGER, PARAMETER, PUBLIC :: cp_units_hartree=130, 00070 cp_units_wavenum=131, 00071 cp_units_joule=132, 00072 cp_units_kcalmol=133, 00073 cp_units_Ry=134, 00074 cp_units_eV=135, 00075 cp_units_kjmol=136, 00076 cp_units_jmol=137, 00077 cp_units_keV=138 00078 00079 ! Length 00080 INTEGER, PARAMETER, PUBLIC :: cp_units_bohr=140, 00081 cp_units_angstrom=141, 00082 cp_units_m=142, 00083 cp_units_pm=143, 00084 cp_units_nm=144 00085 ! Temperature 00086 INTEGER, PARAMETER, PUBLIC :: cp_units_k=150 00087 ! Pressure 00088 INTEGER, PARAMETER, PUBLIC :: cp_units_bar=161 00089 INTEGER, PARAMETER, PUBLIC :: cp_units_atm=162 00090 INTEGER, PARAMETER, PUBLIC :: cp_units_kbar=163 00091 INTEGER, PARAMETER, PUBLIC :: cp_units_Pa=164 00092 INTEGER, PARAMETER, PUBLIC :: cp_units_MPa=165 00093 INTEGER, PARAMETER, PUBLIC :: cp_units_GPa=166 00094 ! Angles 00095 INTEGER, PARAMETER, PUBLIC :: cp_units_rad=170, 00096 cp_units_deg=171 00097 ! Time 00098 INTEGER, PARAMETER, PUBLIC :: cp_units_fs=180, 00099 cp_units_s=181, 00100 cp_units_wn=182, 00101 cp_units_ps=183 00102 ! Potential 00103 INTEGER, PARAMETER, PUBLIC :: cp_units_volt=190 00104 00105 INTEGER, PARAMETER, PUBLIC :: cp_unit_max_kinds=8, cp_unit_basic_desc_length=15, 00106 cp_unit_desc_length=cp_unit_max_kinds*cp_unit_basic_desc_length 00107 00108 PUBLIC :: cp_unit_type, cp_unit_p_type, cp_unit_set_type 00109 PUBLIC :: cp_unit_create, cp_unit_retain, cp_unit_release, & 00110 cp_unit_to_cp2k, cp_unit_from_cp2k, cp_unit_desc,& 00111 cp_unit_set_create, cp_unit_set_retain, cp_unit_set_release,& 00112 cp_unit_to_cp2k1, cp_unit_from_cp2k1, cp_unit_compatible, print_all_units 00113 00114 ! ***************************************************************************** 00122 TYPE cp_unit_type 00123 INTEGER :: id_nr,ref_count,n_kinds 00124 INTEGER, DIMENSION(cp_unit_max_kinds):: kind_id, unit_id, power 00125 END TYPE cp_unit_type 00126 00127 ! ***************************************************************************** 00132 TYPE cp_unit_p_type 00133 TYPE(cp_unit_type), POINTER :: unit 00134 END TYPE cp_unit_p_type 00135 00136 ! ***************************************************************************** 00140 TYPE cp_unit_set_type 00141 INTEGER :: id_nr, ref_count 00142 TYPE(cp_unit_p_type), DIMENSION(cp_ukind_max) :: units 00143 END TYPE cp_unit_set_type 00144 00145 CONTAINS 00146 00147 ! ***************************************************************************** 00155 SUBROUTINE cp_unit_create(unit, string, error) 00156 TYPE(cp_unit_type), POINTER :: unit 00157 CHARACTER(len=*), INTENT(in) :: string 00158 TYPE(cp_error_type), INTENT(inout) :: error 00159 00160 CHARACTER(len=*), PARAMETER :: routineN = 'cp_unit_create', 00161 routineP = moduleN//':'//routineN 00162 00163 CHARACTER(default_string_length) :: desc 00164 CHARACTER(LEN=40) :: formatstr 00165 INTEGER :: i_high, i_low, i_unit, 00166 len_string, next_power 00167 INTEGER, DIMENSION(cp_unit_max_kinds) :: kind_id, power, unit_id 00168 LOGICAL :: failure 00169 00170 failure=.FALSE. 00171 unit_id=cp_units_none 00172 kind_id=cp_ukind_none 00173 power=0 00174 i_low=1 00175 i_high=1 00176 len_string=LEN(string) 00177 i_unit=0 00178 next_power=1 00179 DO WHILE(i_low<len_string) 00180 IF (string(i_low:i_low)/=' ') EXIT 00181 i_low=i_low+1 00182 END DO 00183 i_high=i_low 00184 DO WHILE(i_high<=len_string) 00185 IF ( string(i_high:i_high)==' '.OR.string(i_high:i_high)=='^'.OR.& 00186 string(i_high:i_high)=='*'.OR.string(i_high:i_high)=='/') EXIT 00187 i_high=i_high+1 00188 END DO 00189 DO WHILE(.NOT.failure) 00190 IF (i_high<=i_low.OR.i_low>len_string) EXIT 00191 i_unit=i_unit+1 00192 IF (i_unit>cp_unit_max_kinds) THEN 00193 CALL cp_assert(.FALSE.,cp_failure_level,& 00194 cp_assertion_failed,routineP,& 00195 "maximum number of combined units exceded",& 00196 error,failure) 00197 EXIT 00198 END IF 00199 ! read unit 00200 SELECT CASE(string(i_low:i_high-1)) 00201 CASE("internal_cp2k") 00202 unit_id(i_unit)=cp_units_none 00203 kind_id(i_unit)=cp_ukind_undef 00204 CASE("hartree") 00205 unit_id(i_unit)=cp_units_hartree 00206 kind_id(i_unit)=cp_ukind_energy 00207 CASE("au_e") 00208 unit_id(i_unit)=cp_units_au 00209 kind_id(i_unit)=cp_ukind_energy 00210 CASE("wavenumber_e") 00211 unit_id(i_unit)=cp_units_wavenum 00212 kind_id(i_unit)=cp_ukind_energy 00213 CASE("joule") 00214 unit_id(i_unit)=cp_units_joule 00215 kind_id(i_unit)=cp_ukind_energy 00216 CASE("kcalmol") 00217 unit_id(i_unit)=cp_units_kcalmol 00218 kind_id(i_unit)=cp_ukind_energy 00219 CASE("kjmol") 00220 unit_id(i_unit)=cp_units_kjmol 00221 kind_id(i_unit)=cp_ukind_energy 00222 CASE("jmol") 00223 unit_id(i_unit)=cp_units_jmol 00224 kind_id(i_unit)=cp_ukind_energy 00225 CASE("Ry") 00226 unit_id(i_unit)=cp_units_Ry 00227 kind_id(i_unit)=cp_ukind_energy 00228 CASE("eV") 00229 unit_id(i_unit)=cp_units_eV 00230 kind_id(i_unit)=cp_ukind_energy 00231 CASE("keV") 00232 unit_id(i_unit)=cp_units_keV 00233 kind_id(i_unit)=cp_ukind_energy 00234 CASE("K_e") 00235 unit_id(i_unit)=cp_units_k 00236 kind_id(i_unit)=cp_ukind_energy 00237 CASE("energy") 00238 unit_id(i_unit)=cp_units_none 00239 kind_id(i_unit)=cp_ukind_energy 00240 CASE("au_l") 00241 unit_id(i_unit)=cp_units_au 00242 kind_id(i_unit)=cp_ukind_length 00243 CASE("bohr") 00244 unit_id(i_unit)=cp_units_bohr 00245 kind_id(i_unit)=cp_ukind_length 00246 CASE("m") 00247 unit_id(i_unit)=cp_units_m 00248 kind_id(i_unit)=cp_ukind_length 00249 CASE("pm") 00250 unit_id(i_unit)=cp_units_pm 00251 kind_id(i_unit)=cp_ukind_length 00252 CASE("nm") 00253 unit_id(i_unit)=cp_units_nm 00254 kind_id(i_unit)=cp_ukind_length 00255 CASE("angstrom") 00256 unit_id(i_unit)=cp_units_angstrom 00257 kind_id(i_unit)=cp_ukind_length 00258 CASE ("length") 00259 unit_id(i_unit)=cp_units_none 00260 kind_id(i_unit)=cp_ukind_length 00261 CASE("K","K_temp") 00262 unit_id(i_unit)=cp_units_k 00263 kind_id(i_unit)=cp_ukind_temperature 00264 CASE("au_temp") 00265 unit_id(i_unit)=cp_units_au 00266 kind_id(i_unit)=cp_ukind_temperature 00267 CASE("temperature") 00268 unit_id(i_unit)=cp_units_none 00269 kind_id(i_unit)=cp_ukind_temperature 00270 CASE("atm") 00271 unit_id(i_unit)=cp_units_atm 00272 kind_id(i_unit)=cp_ukind_pressure 00273 CASE("bar") 00274 unit_id(i_unit)=cp_units_bar 00275 kind_id(i_unit)=cp_ukind_pressure 00276 CASE("kbar") 00277 unit_id(i_unit)=cp_units_kbar 00278 kind_id(i_unit)=cp_ukind_pressure 00279 CASE("Pa") 00280 unit_id(i_unit)=cp_units_Pa 00281 kind_id(i_unit)=cp_ukind_pressure 00282 CASE("MPa") 00283 unit_id(i_unit)=cp_units_MPa 00284 kind_id(i_unit)=cp_ukind_pressure 00285 CASE("GPa") 00286 unit_id(i_unit)=cp_units_GPa 00287 kind_id(i_unit)=cp_ukind_pressure 00288 CASE("au_p") 00289 unit_id(i_unit)=cp_units_au 00290 kind_id(i_unit)=cp_ukind_pressure 00291 CASE("pressure") 00292 unit_id(i_unit)=cp_units_none 00293 kind_id(i_unit)=cp_ukind_pressure 00294 CASE("rad") 00295 unit_id(i_unit)=cp_units_rad 00296 kind_id(i_unit)=cp_ukind_angle 00297 CASE("deg") 00298 unit_id(i_unit)=cp_units_deg 00299 kind_id(i_unit)=cp_ukind_angle 00300 CASE("angle") 00301 unit_id(i_unit)=cp_units_none 00302 kind_id(i_unit)=cp_ukind_angle 00303 CASE("s") 00304 unit_id(i_unit)=cp_units_s 00305 kind_id(i_unit)=cp_ukind_time 00306 CASE("fs") 00307 unit_id(i_unit)=cp_units_fs 00308 kind_id(i_unit)=cp_ukind_time 00309 CASE("ps") 00310 unit_id(i_unit)=cp_units_ps 00311 kind_id(i_unit)=cp_ukind_time 00312 CASE("wavenumber_t") 00313 unit_id(i_unit)=cp_units_wn 00314 kind_id(i_unit)=cp_ukind_time 00315 CASE("au_t") 00316 unit_id(i_unit)=cp_units_au 00317 kind_id(i_unit)=cp_ukind_time 00318 CASE("time") 00319 unit_id(i_unit)=cp_units_none 00320 kind_id(i_unit)=cp_ukind_time 00321 CASE("kg") 00322 unit_id(i_unit)=cp_units_kg 00323 kind_id(i_unit)=cp_ukind_mass 00324 CASE("amu") 00325 unit_id(i_unit)=cp_units_amu 00326 kind_id(i_unit)=cp_ukind_mass 00327 CASE("m_e") 00328 unit_id(i_unit)=cp_units_m_e 00329 kind_id(i_unit)=cp_ukind_mass 00330 CASE("au_m") 00331 unit_id(i_unit)=cp_units_au 00332 kind_id(i_unit)=cp_ukind_mass 00333 CASE("mass") 00334 unit_id(i_unit)=cp_units_none 00335 kind_id(i_unit)=cp_ukind_mass 00336 CASE("volt") 00337 unit_id(i_unit)=cp_units_volt 00338 kind_id(i_unit)=cp_ukind_potential 00339 CASE("au_pot") 00340 unit_id(i_unit)=cp_units_au 00341 kind_id(i_unit)=cp_ukind_potential 00342 CASE("potential") 00343 unit_id(i_unit)=cp_units_none 00344 kind_id(i_unit)=cp_ukind_potential 00345 CASE("au") 00346 CALL cp_assert(.FALSE.,cp_failure_level,& 00347 cp_assertion_failed,routineP,& 00348 "au unit without specifing its kind not accepted, use (au_e, au_t, au_temp, au_l, au_m, au_p, au_pot)",& 00349 error,failure) 00350 CASE default 00351 CALL cp_assert(.FALSE.,cp_failure_level,cp_assertion_failed,& 00352 routineP,"unknown unit:"//string(i_low:i_high-1),& 00353 error,failure) 00354 END SELECT 00355 power(i_unit)=next_power 00356 ! parse op 00357 i_low=i_high 00358 DO WHILE(i_low<=len_string) 00359 IF (string(i_low:i_low)/=' ') EXIT 00360 i_low=i_low+1 00361 END DO 00362 i_high=i_low 00363 DO WHILE(i_high<=len_string) 00364 IF ( string(i_high:i_high)==' '.OR.string(i_high:i_high)=='^'.OR.& 00365 string(i_high:i_high)=='*'.OR.string(i_high:i_high)=='/') EXIT 00366 i_high=i_high+1 00367 END DO 00368 IF (i_high<i_low.OR.i_low>len_string) EXIT 00369 00370 IF (i_high<=len_string) THEN 00371 IF (string(i_low:i_high)=='^') THEN 00372 i_low=i_high+1 00373 DO WHILE(i_low<=len_string) 00374 IF (string(i_low:i_low)/=' ') EXIT 00375 i_low=i_low+1 00376 END DO 00377 i_high=i_low 00378 DO WHILE(i_high<=len_string) 00379 SELECT CASE(string(i_high:i_high)) 00380 CASE('+','-','0','1','2','3','4','5','6','7','8','9') 00381 i_high=i_high+1 00382 CASE default 00383 EXIT 00384 END SELECT 00385 END DO 00386 IF (i_high<=i_low.OR.i_low>len_string) THEN 00387 CALL cp_assert(.FALSE.,cp_failure_level,& 00388 cp_assertion_failed,routineP,& 00389 "an integer number is expected after a '^'",& 00390 error,failure) 00391 EXIT 00392 END IF 00393 formatstr="(i"//cp_to_string(i_high-i_low+1)//")" 00394 READ (string(i_low:i_high-1),formatstr)& 00395 next_power 00396 power(i_unit)=power(i_unit)*next_power 00397 ! next op 00398 i_low=i_high 00399 DO WHILE(i_low<len_string) 00400 IF (string(i_low:i_low)/=' ') EXIT 00401 i_low=i_low+1 00402 END DO 00403 i_high=i_low 00404 DO WHILE(i_high<=len_string) 00405 IF ( string(i_high:i_high)==' '.OR.string(i_high:i_high)=='^'.OR.& 00406 string(i_high:i_high)=='*'.OR.string(i_high:i_high)=='/') EXIT 00407 i_high=i_high+1 00408 END DO 00409 END IF 00410 ENDIF 00411 IF (i_low>len_string) EXIT 00412 next_power=1 00413 IF (i_high<=len_string) THEN 00414 IF (string(i_low:i_high)=="*".OR.string(i_low:i_high)=='/') THEN 00415 IF (string(i_low:i_high)=='/') next_power=-1 00416 i_low=i_high+1 00417 DO WHILE(i_low<=len_string) 00418 IF (string(i_low:i_low)/=' ') EXIT 00419 i_low=i_low+1 00420 END DO 00421 i_high=i_low 00422 DO WHILE(i_high<=len_string) 00423 IF ( string(i_high:i_high)==' '.OR.string(i_high:i_high)=='^'.OR.& 00424 string(i_high:i_high)=='*'.OR.string(i_high:i_high)=='/') EXIT 00425 i_high=i_high+1 00426 END DO 00427 END IF 00428 ENDIF 00429 END DO 00430 CALL cp_unit_create2(unit,kind_id=kind_id, unit_id=unit_id, & 00431 power=power, error=error) 00432 desc=cp_unit_desc(unit,error=error) 00433 END SUBROUTINE cp_unit_create 00434 00435 ! ***************************************************************************** 00446 SUBROUTINE cp_unit_create2(unit, kind_id, unit_id, power, error) 00447 TYPE(cp_unit_type), POINTER :: unit 00448 INTEGER, DIMENSION(:), INTENT(in) :: kind_id, unit_id 00449 INTEGER, DIMENSION(:), INTENT(in), 00450 OPTIONAL :: power 00451 TYPE(cp_error_type), INTENT(inout) :: error 00452 00453 CHARACTER(len=*), PARAMETER :: routineN = 'cp_unit_create2', 00454 routineP = moduleN//':'//routineN 00455 00456 INTEGER :: i, j, max_kind, max_pos, stat 00457 LOGICAL :: failure, repeat 00458 00459 failure=.FALSE. 00460 00461 CPPrecondition(.NOT.ASSOCIATED(unit),cp_failure_level,routineP,error,failure) 00462 CPPrecondition(SIZE(kind_id)<=cp_unit_max_kinds,cp_failure_level,routineP,error,failure) 00463 CPPrecondition(SIZE(unit_id)<=cp_unit_max_kinds,cp_failure_level,routineP,error,failure) 00464 ALLOCATE(unit,stat=stat) 00465 CPPostcondition(stat==0,cp_fatal_level,routineP,error,failure) 00466 unit%ref_count=1 00467 last_unit_id=last_unit_id+1 00468 unit%id_nr=last_unit_id 00469 unit%kind_id(1:SIZE(kind_id))=kind_id 00470 unit%kind_id(SIZE(kind_id)+1:)=cp_ukind_none 00471 unit%unit_id(1:SIZE(unit_id))=unit_id 00472 unit%unit_id(SIZE(unit_id):)=cp_units_none 00473 IF (PRESENT(power)) THEN 00474 unit%power(1:SIZE(power))=power 00475 unit%power(SIZE(power)+1:)=0 00476 DO i=1,SIZE(unit%power) 00477 IF (unit%power(i)==0) THEN 00478 unit%kind_id(i)=cp_ukind_none 00479 unit%unit_id(i)=cp_units_none 00480 END IF 00481 END DO 00482 ELSE 00483 DO i=1,SIZE(unit%power) 00484 IF (unit%unit_id(i)/=0) THEN 00485 unit%power(i)=1 00486 ELSE 00487 unit%power(i)=0 00488 END IF 00489 END DO 00490 END IF 00491 00492 ! remove unnecessary units 00493 ! reorder & compress 00494 unit%n_kinds=0 00495 DO i=1,SIZE(unit%kind_id) 00496 ! find max and compress in the rest 00497 DO 00498 max_kind=unit%kind_id(i) 00499 max_pos=i 00500 repeat=.FALSE. 00501 DO j=i+1,SIZE(unit%kind_id) 00502 IF (unit%kind_id(j)>=max_kind) THEN 00503 IF (unit%kind_id(j)/=0.AND.unit%kind_id(j)==max_kind.AND.& 00504 unit%unit_id(j)==unit%unit_id(max_pos)) THEN 00505 unit%power(max_pos)=unit%power(max_pos)+unit%power(j) 00506 unit%kind_id(j)=cp_ukind_none 00507 unit%unit_id(j)=cp_units_none 00508 unit%power(j)=0 00509 IF (unit%power(max_pos)==0) THEN 00510 unit%kind_id(max_pos)=cp_ukind_none 00511 unit%unit_id(max_pos)=cp_units_none 00512 unit%power(max_pos)=0 00513 repeat=.TRUE. 00514 EXIT 00515 END IF 00516 ELSE IF (unit%kind_id(j)>max_kind.OR.& 00517 (unit%kind_id(j)==max_kind.AND.& 00518 unit%unit_id(j)>unit%unit_id(max_pos))) THEN 00519 max_kind=unit%kind_id(j) 00520 max_pos=j 00521 END IF 00522 END IF 00523 END DO 00524 IF (.not.repeat) EXIT 00525 END DO 00526 IF (max_kind/=0) unit%n_kinds=unit%n_kinds+1 00527 ! put the max at pos i 00528 IF (max_pos/=i) THEN 00529 unit%kind_id(max_pos)=unit%kind_id(i) 00530 unit%kind_id(i)=max_kind 00531 max_kind=unit%unit_id(max_pos) 00532 unit%unit_id(max_pos)=unit%unit_id(i) 00533 unit%unit_id(i)=max_kind 00534 max_kind=unit%power(max_pos) 00535 unit%power(max_pos)=unit%power(i) 00536 unit%power(i)=max_kind 00537 END IF 00538 ! check unit 00539 failure=failure.OR..NOT.cp_basic_unit_check(basic_kind=unit%kind_id(i),& 00540 basic_unit=unit%unit_id(i),error=error) 00541 END DO 00542 END SUBROUTINE cp_unit_create2 00543 00544 ! ***************************************************************************** 00553 SUBROUTINE cp_unit_retain(unit,error) 00554 TYPE(cp_unit_type), POINTER :: unit 00555 TYPE(cp_error_type), INTENT(inout) :: error 00556 00557 CHARACTER(len=*), PARAMETER :: routineN = 'cp_unit_retain', 00558 routineP = moduleN//':'//routineN 00559 00560 LOGICAL :: failure 00561 00562 failure=.FALSE. 00563 00564 CPPrecondition(ASSOCIATED(unit),cp_failure_level,routineP,error,failure) 00565 IF (.NOT. failure) THEN 00566 CPPreconditionNoFail(unit%ref_count>0,cp_failure_level,routineP,error) 00567 unit%ref_count=unit%ref_count+1 00568 END IF 00569 END SUBROUTINE cp_unit_retain 00570 00571 ! ***************************************************************************** 00580 SUBROUTINE cp_unit_release(unit,error) 00581 TYPE(cp_unit_type), POINTER :: unit 00582 TYPE(cp_error_type), INTENT(inout) :: error 00583 00584 CHARACTER(len=*), PARAMETER :: routineN = 'cp_unit_release', 00585 routineP = moduleN//':'//routineN 00586 00587 INTEGER :: stat 00588 LOGICAL :: failure 00589 00590 failure=.FALSE. 00591 00592 IF (ASSOCIATED(unit)) THEN 00593 CPPreconditionNoFail(unit%ref_count>0,cp_failure_level,routineP,error) 00594 unit%ref_count=unit%ref_count-1 00595 IF (unit%ref_count==0) THEN 00596 DEALLOCATE(unit,stat=stat) 00597 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 00598 END IF 00599 END IF 00600 END SUBROUTINE cp_unit_release 00601 00602 ! ***************************************************************************** 00612 FUNCTION cp_basic_unit_check(basic_kind,basic_unit,error_level,error)& 00613 RESULT(res) 00614 INTEGER, INTENT(in) :: basic_kind, basic_unit 00615 INTEGER, INTENT(in), OPTIONAL :: error_level 00616 TYPE(cp_error_type), INTENT(inout) :: error 00617 LOGICAL :: res 00618 00619 CHARACTER(len=*), PARAMETER :: routineN = 'cp_basic_unit_check', 00620 routineP = moduleN//':'//routineN 00621 00622 INTEGER :: my_error_level 00623 LOGICAL :: failure 00624 00625 failure=.FALSE. 00626 my_error_level=cp_failure_level 00627 IF (PRESENT(error_level)) my_error_level=error_level 00628 00629 IF (.NOT. failure) THEN 00630 SELECT CASE(basic_kind) 00631 CASE(cp_ukind_undef) 00632 SELECT CASE (basic_unit) 00633 CASE(cp_units_none) 00634 CASE default 00635 CALL cp_assert(.FALSE.,my_error_level,cp_assertion_failed,& 00636 routineP,"unknown undef unit:"//TRIM(cp_to_string(basic_unit)),& 00637 error,failure) 00638 END SELECT 00639 CASE(cp_ukind_energy) 00640 SELECT CASE (basic_unit) 00641 CASE(cp_units_hartree, cp_units_wavenum, cp_units_joule, cp_units_kcalmol,& 00642 cp_units_kjmol, cp_units_Ry, cp_units_eV, cp_units_keV, cp_units_au, cp_units_k,& 00643 cp_units_jmol, cp_units_none) 00644 CASE default 00645 CALL cp_assert(.FALSE.,my_error_level,cp_assertion_failed,& 00646 routineP,"unknown energy unit:"//TRIM(cp_to_string(basic_unit)),& 00647 error,failure) 00648 END SELECT 00649 CASE(cp_ukind_length) 00650 SELECT CASE (basic_unit) 00651 CASE(cp_units_bohr, cp_units_angstrom, cp_units_au, cp_units_none, cp_units_m,& 00652 cp_units_pm, cp_units_nm) 00653 CASE default 00654 CALL cp_assert(.FALSE.,my_error_level,cp_assertion_failed,& 00655 routineP,"unknown length unit:"//TRIM(cp_to_string(basic_unit)),& 00656 error,failure) 00657 END SELECT 00658 CASE(cp_ukind_temperature) 00659 SELECT CASE (basic_unit) 00660 CASE(cp_units_k,cp_units_au,cp_units_none) 00661 CASE default 00662 CALL cp_assert(.FALSE.,my_error_level,cp_assertion_failed,& 00663 routineP,"unknown temperature unit:"//TRIM(cp_to_string(basic_unit)),& 00664 error,failure) 00665 END SELECT 00666 CASE(cp_ukind_pressure) 00667 SELECT CASE (basic_unit) 00668 CASE(cp_units_bar,cp_units_atm,cp_units_kbar,cp_units_Pa,cp_units_MPa,cp_units_GPa,cp_units_au,cp_units_none) 00669 CASE default 00670 CALL cp_assert(.FALSE.,my_error_level,cp_assertion_failed,& 00671 routineP,"unknown pressure unit:"//TRIM(cp_to_string(basic_unit)),& 00672 error,failure) 00673 END SELECT 00674 CASE(cp_ukind_angle) 00675 SELECT CASE (basic_unit) 00676 CASE(cp_units_rad, cp_units_deg,cp_units_none) 00677 CASE default 00678 CALL cp_assert(.FALSE.,my_error_level,cp_assertion_failed,& 00679 routineP,"unknown angle unit:"//TRIM(cp_to_string(basic_unit)),& 00680 error,failure) 00681 END SELECT 00682 CASE(cp_ukind_time) 00683 SELECT CASE (basic_unit) 00684 CASE(cp_units_s, cp_units_fs, cp_units_ps, cp_units_au, cp_units_wn, cp_units_none) 00685 CASE default 00686 CALL cp_assert(.FALSE.,my_error_level,cp_assertion_failed,& 00687 routineP,"unknown time unit:"//TRIM(cp_to_string(basic_unit)),& 00688 error,failure) 00689 END SELECT 00690 CASE(cp_ukind_mass) 00691 SELECT CASE (basic_unit) 00692 CASE(cp_units_kg, cp_units_amu, cp_units_m_e, cp_units_au, cp_units_none) 00693 CASE default 00694 CALL cp_assert(.FALSE.,my_error_level,cp_assertion_failed,& 00695 routineP,"unknown mass unit:"//TRIM(cp_to_string(basic_unit)),& 00696 error,failure) 00697 END SELECT 00698 CASE(cp_ukind_potential) 00699 SELECT CASE (basic_unit) 00700 CASE(cp_units_volt, cp_units_au, cp_units_none) 00701 CASE default 00702 CALL cp_assert(.FALSE.,my_error_level,cp_assertion_failed,& 00703 routineP,"unknown potential unit:"//TRIM(cp_to_string(basic_unit)),& 00704 error,failure) 00705 END SELECT 00706 CASE(cp_ukind_none) 00707 CALL cp_assert(basic_unit==cp_units_none,my_error_level,& 00708 cp_assertion_failed, routineP,& 00709 "if the kind of the unit is none also unit must be undefined,not:"& 00710 //TRIM(cp_to_string(basic_unit)),& 00711 error,failure) 00712 CASE default 00713 CALL cp_assert(.FALSE.,my_error_level,cp_assertion_failed,& 00714 routineP,"unknown kind of unit:"//TRIM(cp_to_string(basic_kind)),& 00715 error,failure) 00716 END SELECT 00717 END IF 00718 res=.not.failure 00719 END FUNCTION cp_basic_unit_check 00720 00721 ! ***************************************************************************** 00731 FUNCTION cp_basic_unit_to_cp2k(value,basic_kind,basic_unit,power,error) RESULT(res) 00732 REAL(kind=dp), INTENT(in) :: value 00733 INTEGER, INTENT(in) :: basic_kind, basic_unit 00734 INTEGER, INTENT(in), OPTIONAL :: power 00735 TYPE(cp_error_type), INTENT(inout) :: error 00736 REAL(kind=dp) :: res 00737 00738 CHARACTER(len=*), PARAMETER :: routineN = 'cp_basic_unit_to_cp2k', 00739 routineP = moduleN//':'//routineN 00740 INTEGER, PARAMETER :: my_error_level = cp_failure_level 00741 00742 INTEGER :: my_power 00743 LOGICAL :: failure 00744 00745 failure=.FALSE. 00746 my_power=1 00747 IF (PRESENT(power)) my_power=power 00748 IF (basic_unit==cp_units_none.AND.basic_kind/=cp_ukind_undef) THEN 00749 CALL cp_assert(basic_kind==cp_units_none,my_error_level,& 00750 cp_assertion_failed,routineP,& 00751 "unit not yet fully specified, unit of kind "//& 00752 TRIM(cp_to_string(basic_unit)),error,failure) 00753 END IF 00754 IF (.NOT.failure) THEN 00755 SELECT CASE(basic_kind) 00756 CASE(cp_ukind_undef) 00757 SELECT CASE (basic_unit) 00758 CASE(cp_units_none) 00759 res = value 00760 CASE default 00761 CALL cp_assert(.FALSE.,my_error_level,cp_assertion_failed,& 00762 routineP,"unknown energy unit:"//TRIM(cp_to_string(basic_unit)),& 00763 error,failure) 00764 END SELECT 00765 CASE(cp_ukind_energy) 00766 SELECT CASE (basic_unit) 00767 CASE(cp_units_hartree,cp_units_au) 00768 res=value 00769 CASE(cp_units_wavenum) 00770 res=wavenumbers**(-my_power)*value 00771 CASE(cp_units_joule) 00772 res=joule**(-my_power)*value 00773 CASE(cp_units_kcalmol) 00774 res=kcalmol**(-my_power)*value 00775 CASE(cp_units_kjmol) 00776 res=kjmol**(-my_power)*value 00777 CASE(cp_units_jmol) 00778 res=(kjmol*1000.0_dp)**(-my_power)*value 00779 CASE(cp_units_Ry) 00780 res=0.5_dp**my_power*value 00781 CASE(cp_units_eV) 00782 res=evolt**(-my_power)*value 00783 CASE(cp_units_keV) 00784 res=(0.001_dp*evolt)**(-my_power)*value 00785 CASE(cp_units_k) 00786 res=kelvin**(-my_power)*value 00787 CASE default 00788 CALL cp_assert(.FALSE.,my_error_level,cp_assertion_failed,& 00789 routineP,"unknown energy unit:"//TRIM(cp_to_string(basic_unit)),& 00790 error,failure) 00791 END SELECT 00792 CASE(cp_ukind_length) 00793 SELECT CASE (basic_unit) 00794 CASE(cp_units_bohr,cp_units_au) 00795 res=value 00796 CASE(cp_units_m) 00797 res=value*(1.e10_dp*bohr)**my_power 00798 CASE(cp_units_pm) 00799 res=value*(0.01_dp*bohr)**my_power 00800 CASE(cp_units_nm) 00801 res=value*(10_dp*bohr)**my_power 00802 CASE(cp_units_angstrom) 00803 res=value*bohr**my_power 00804 CASE default 00805 CALL cp_assert(.FALSE.,my_error_level,cp_assertion_failed,& 00806 routineP,"unknown length unit:"//TRIM(cp_to_string(basic_unit)),& 00807 error,failure) 00808 END SELECT 00809 CASE(cp_ukind_temperature) 00810 SELECT CASE (basic_unit) 00811 CASE(cp_units_k) 00812 res=kelvin**(-my_power)*value 00813 CASE(cp_units_au) 00814 res=value 00815 CASE default 00816 CALL cp_assert(.FALSE.,my_error_level,cp_assertion_failed,& 00817 routineP,"unknown temperature unit:"//TRIM(cp_to_string(basic_unit)),& 00818 error,failure) 00819 END SELECT 00820 CASE(cp_ukind_pressure) 00821 SELECT CASE (basic_unit) 00822 CASE(cp_units_bar) 00823 res = bar**(-my_power)*value 00824 CASE(cp_units_atm) 00825 res = atm**(-my_power)*value 00826 CASE(cp_units_kbar) 00827 res = 1.0E+3_dp*bar**(-my_power)*value 00828 CASE(cp_units_Pa) 00829 res = pascal**(-my_power)*value 00830 CASE(cp_units_MPa) 00831 res = 1.0E+6_dp*pascal**(-my_power)*value 00832 CASE(cp_units_GPa) 00833 res = 1.0E+9_dp*pascal**(-my_power)*value 00834 CASE(cp_units_au) 00835 res = value 00836 CASE default 00837 CALL cp_assert(.FALSE.,my_error_level,cp_assertion_failed,& 00838 routineP,"unknown pressure unit:"//TRIM(cp_to_string(basic_unit)),& 00839 error,failure) 00840 END SELECT 00841 CASE(cp_ukind_angle) 00842 SELECT CASE (basic_unit) 00843 CASE(cp_units_rad) 00844 res=value 00845 CASE(cp_units_deg) 00846 res=value*(radians)**my_power 00847 CASE default 00848 CALL cp_assert(.FALSE.,my_error_level,cp_assertion_failed,& 00849 routineP,"unknown angle unit:"//TRIM(cp_to_string(basic_unit)),& 00850 error,failure) 00851 END SELECT 00852 CASE(cp_ukind_time) 00853 SELECT CASE (basic_unit) 00854 CASE(cp_units_s) 00855 res=value*seconds**(-my_power) 00856 CASE(cp_units_fs) 00857 res=value*femtoseconds**(-my_power) 00858 CASE(cp_units_ps) 00859 res=value*picoseconds**(-my_power) 00860 CASE(cp_units_au) 00861 res=value 00862 CASE(cp_units_wn) 00863 res=(twopi*wavenumbers)**(my_power)/value 00864 CASE default 00865 CALL cp_assert(.FALSE.,my_error_level,cp_assertion_failed,& 00866 routineP,"unknown time unit:"//TRIM(cp_to_string(basic_unit)),& 00867 error,failure) 00868 END SELECT 00869 CASE(cp_ukind_mass) 00870 SELECT CASE (basic_unit) 00871 CASE(cp_units_kg) 00872 res=e_mass**my_power*value 00873 CASE(cp_units_amu) 00874 res=massunit**my_power*value 00875 CASE(cp_units_m_e,cp_units_au) 00876 res=value 00877 CASE default 00878 CALL cp_assert(.FALSE.,my_error_level,cp_assertion_failed,& 00879 routineP,"unknown mass unit:"//TRIM(cp_to_string(basic_unit)),& 00880 error,failure) 00881 END SELECT 00882 CASE(cp_ukind_potential) 00883 SELECT CASE (basic_unit) 00884 CASE(cp_units_volt) 00885 res=evolt**(-my_power)*value 00886 CASE(cp_units_au) 00887 res=value 00888 CASE default 00889 CALL cp_assert(.FALSE.,my_error_level,cp_assertion_failed,& 00890 routineP,"unknown potential unit:"//TRIM(cp_to_string(basic_unit)),& 00891 error,failure) 00892 END SELECT 00893 CASE(cp_ukind_none) 00894 CALL cp_assert(.FALSE.,my_error_level,& 00895 cp_assertion_failed, routineP,& 00896 "if the kind of the unit is none also unit must be undefined,not:"& 00897 //TRIM(cp_to_string(basic_unit)),& 00898 error,failure) 00899 CASE default 00900 CALL cp_assert(.FALSE.,my_error_level,cp_assertion_failed,& 00901 routineP,"unknown kind of unit:"//TRIM(cp_to_string(basic_kind)),& 00902 error,failure) 00903 END SELECT 00904 END IF 00905 END FUNCTION cp_basic_unit_to_cp2k 00906 00907 ! ***************************************************************************** 00916 FUNCTION cp_basic_unit_desc(basic_kind,basic_unit,power,accept_undefined,error)& 00917 RESULT(res) 00918 INTEGER, INTENT(in) :: basic_kind, basic_unit 00919 INTEGER, INTENT(in), OPTIONAL :: power 00920 LOGICAL, INTENT(in), OPTIONAL :: accept_undefined 00921 TYPE(cp_error_type), INTENT(inout) :: error 00922 CHARACTER(len=cp_unit_basic_desc_length) :: res 00923 00924 CHARACTER(len=*), PARAMETER :: routineN = 'cp_basic_unit_desc', 00925 routineP = moduleN//':'//routineN 00926 INTEGER, PARAMETER :: my_error_level = cp_failure_level 00927 00928 INTEGER :: a, my_power 00929 LOGICAL :: failure, my_accept_undefined 00930 00931 failure=.FALSE. 00932 my_power=1 00933 res="" 00934 my_accept_undefined=.FALSE. 00935 IF (accept_undefined) my_accept_undefined=accept_undefined 00936 IF (PRESENT(power)) my_power=power 00937 IF (basic_unit==cp_units_none) THEN 00938 CALL cp_assert(my_accept_undefined.OR.basic_kind/=cp_units_none,& 00939 my_error_level,cp_assertion_failed,routineP,& 00940 "unit not yet fully specified, unit of kind "//& 00941 TRIM(cp_to_string(basic_kind)),error,failure) 00942 END IF 00943 IF (.NOT.failure) THEN 00944 SELECT CASE(basic_kind) 00945 CASE(cp_ukind_undef) 00946 SELECT CASE (basic_unit) 00947 CASE(cp_units_none) 00948 res="internal_cp2k" 00949 CASE DEFAULT 00950 CALL cp_assert(.FALSE.,my_error_level,& 00951 cp_assertion_failed,routineP,& 00952 "unit not yet fully specified, unit of kind "//& 00953 TRIM(res),error,failure) 00954 END SELECT 00955 CASE(cp_ukind_energy) 00956 SELECT CASE (basic_unit) 00957 CASE(cp_units_hartree,cp_units_au) 00958 res="hartree" 00959 CASE(cp_units_wavenum) 00960 res="wavenumber_e" 00961 CASE(cp_units_joule) 00962 res="joule" 00963 CASE(cp_units_kcalmol) 00964 res="kcalmol" 00965 CASE(cp_units_kjmol) 00966 res="kjmol" 00967 CASE(cp_units_jmol) 00968 res="jmol" 00969 CASE(cp_units_Ry) 00970 res="Ry" 00971 CASE(cp_units_eV) 00972 res="eV" 00973 CASE(cp_units_keV) 00974 res="keV" 00975 CASE(cp_units_k) 00976 res="K_e" 00977 CASE(cp_units_none) 00978 res="energy" 00979 CALL cp_assert(my_accept_undefined,my_error_level,& 00980 cp_assertion_failed,routineP,& 00981 "unit not yet fully specified, unit of kind "//& 00982 TRIM(res),error,failure) 00983 CASE default 00984 CALL cp_assert(.FALSE.,my_error_level,cp_assertion_failed,& 00985 routineP,"unknown energy unit:"//TRIM(cp_to_string(basic_unit)),& 00986 error,failure) 00987 END SELECT 00988 CASE(cp_ukind_length) 00989 SELECT CASE (basic_unit) 00990 CASE(cp_units_bohr,cp_units_au) 00991 res="bohr" 00992 CASE(cp_units_m) 00993 res="m" 00994 CASE(cp_units_pm) 00995 res="pm" 00996 CASE(cp_units_nm) 00997 res="nm" 00998 CASE(cp_units_angstrom) 00999 res="angstrom" 01000 CASE default 01001 res="length" 01002 CALL cp_assert(.FALSE.,my_error_level,cp_assertion_failed,& 01003 routineP,"unknown length unit:"//TRIM(cp_to_string(basic_unit)),& 01004 error,failure) 01005 END SELECT 01006 CASE(cp_ukind_temperature) 01007 SELECT CASE (basic_unit) 01008 CASE(cp_units_k) 01009 res="K" 01010 CASE(cp_units_au) 01011 res="au_temp" 01012 CASE(cp_units_none) 01013 res="temperature" 01014 CALL cp_assert(my_accept_undefined,my_error_level,& 01015 cp_assertion_failed,routineP,& 01016 "unit not yet fully specified, unit of kind "//& 01017 TRIM(res),error,failure) 01018 CASE default 01019 CALL cp_assert(.FALSE.,my_error_level,cp_assertion_failed,& 01020 routineP,"unknown temperature unit:"//TRIM(cp_to_string(basic_unit)),& 01021 error,failure) 01022 END SELECT 01023 CASE(cp_ukind_pressure) 01024 SELECT CASE (basic_unit) 01025 CASE(cp_units_bar) 01026 res="bar" 01027 CASE(cp_units_atm) 01028 res="atm" 01029 CASE(cp_units_kbar) 01030 res="kbar" 01031 CASE(cp_units_Pa) 01032 res="Pa" 01033 CASE(cp_units_MPa) 01034 res="MPa" 01035 CASE(cp_units_GPa) 01036 res="GPa" 01037 CASE(cp_units_au) 01038 res="au_p" 01039 CASE(cp_units_none) 01040 res="pressure" 01041 CALL cp_assert(my_accept_undefined,my_error_level,& 01042 cp_assertion_failed,routineP,& 01043 "unit not yet fully specified, unit of kind "//& 01044 TRIM(res),error,failure) 01045 CASE default 01046 CALL cp_assert(.FALSE.,my_error_level,cp_assertion_failed,& 01047 routineP,"unknown pressure unit:"//TRIM(cp_to_string(basic_unit)),& 01048 error,failure) 01049 END SELECT 01050 CASE(cp_ukind_angle) 01051 SELECT CASE (basic_unit) 01052 CASE(cp_units_rad) 01053 res="rad" 01054 CASE(cp_units_deg) 01055 res="deg" 01056 CASE(cp_units_none) 01057 res="angle" 01058 CALL cp_assert(my_accept_undefined,my_error_level,& 01059 cp_assertion_failed,routineP,& 01060 "unit not yet fully specified, unit of kind "//& 01061 TRIM(res),error,failure) 01062 CASE default 01063 CALL cp_assert(.FALSE.,my_error_level,cp_assertion_failed,& 01064 routineP,"unknown angle unit:"//TRIM(cp_to_string(basic_unit)),& 01065 error,failure) 01066 END SELECT 01067 CASE(cp_ukind_time) 01068 SELECT CASE (basic_unit) 01069 CASE(cp_units_s) 01070 res="s" 01071 CASE(cp_units_fs) 01072 res="fs" 01073 CASE(cp_units_ps) 01074 res="ps" 01075 CASE(cp_units_au) 01076 res="au_t" 01077 CASE(cp_units_wn) 01078 res="wavenumber_t" 01079 CASE(cp_units_none) 01080 res="time" 01081 CALL cp_assert(my_accept_undefined,my_error_level,& 01082 cp_assertion_failed,routineP,& 01083 "unit not yet fully specified, unit of kind "//& 01084 TRIM(res),error,failure) 01085 CASE default 01086 CALL cp_assert(.FALSE.,my_error_level,cp_assertion_failed,& 01087 routineP,"unknown time unit:"//TRIM(cp_to_string(basic_unit)),& 01088 error,failure) 01089 END SELECT 01090 CASE(cp_ukind_mass) 01091 SELECT CASE (basic_unit) 01092 CASE(cp_units_kg) 01093 res="kg" 01094 CASE(cp_units_amu) 01095 res="amu" 01096 CASE(cp_units_m_e,cp_units_au) 01097 res="m_e" 01098 CASE(cp_units_none) 01099 res="mass" 01100 CALL cp_assert(my_accept_undefined,my_error_level,& 01101 cp_assertion_failed,routineP,& 01102 "unit not yet fully specified, unit of kind "//& 01103 TRIM(res),error,failure) 01104 CASE default 01105 CALL cp_assert(.FALSE.,my_error_level,cp_assertion_failed,& 01106 routineP,"unknown mass unit:"//TRIM(cp_to_string(basic_unit)),& 01107 error,failure) 01108 END SELECT 01109 CASE(cp_ukind_potential) 01110 SELECT CASE (basic_unit) 01111 CASE(cp_units_volt) 01112 res="volt" 01113 CASE(cp_units_au) 01114 res="au_pot" 01115 CASE(cp_units_none) 01116 res="potential" 01117 CALL cp_assert(my_accept_undefined,my_error_level,& 01118 cp_assertion_failed,routineP,& 01119 "unit not yet fully specified, unit of kind "//& 01120 TRIM(res),error,failure) 01121 CASE default 01122 CALL cp_assert(.FALSE.,my_error_level,cp_assertion_failed,& 01123 routineP,"unknown potential unit:"//TRIM(cp_to_string(basic_unit)),& 01124 error,failure) 01125 END SELECT 01126 CASE(cp_ukind_none) 01127 CALL cp_assert(.FALSE.,my_error_level,& 01128 cp_assertion_failed, routineP,& 01129 "if the kind of the unit is none also unit must be undefined,not:"& 01130 //TRIM(cp_to_string(basic_unit)),& 01131 error,failure) 01132 CASE default 01133 CALL cp_assert(.FALSE.,my_error_level,cp_assertion_failed,& 01134 routineP,"unknown kind of unit:"//TRIM(cp_to_string(basic_kind)),& 01135 error,failure) 01136 END SELECT 01137 IF (my_power/=1) THEN 01138 a=LEN_TRIM(res) 01139 CPPrecondition(LEN(res)-a>=3,cp_failure_level,routineP,error,failure) 01140 WRITE (res(a+1:),"('^',i3)") my_power 01141 CALL compress(res,.TRUE.) 01142 END IF 01143 END IF 01144 END FUNCTION cp_basic_unit_desc 01145 01146 ! ***************************************************************************** 01156 FUNCTION cp_unit_desc(unit,defaults,accept_undefined,error)& 01157 RESULT(res) 01158 TYPE(cp_unit_type), POINTER :: unit 01159 TYPE(cp_unit_set_type), OPTIONAL, 01160 POINTER :: defaults 01161 LOGICAL, INTENT(in), OPTIONAL :: accept_undefined 01162 TYPE(cp_error_type), INTENT(inout) :: error 01163 CHARACTER(len=cp_unit_desc_length) :: res 01164 01165 CHARACTER(len=*), PARAMETER :: routineN = 'cp_unit_desc', 01166 routineP = moduleN//':'//routineN 01167 01168 INTEGER :: i, my_unit, pos 01169 LOGICAL :: check, failure, has_defaults, 01170 my_accept_undefined 01171 01172 failure=.FALSE. 01173 01174 CPPrecondition(ASSOCIATED(unit),cp_failure_level,routineP,error,failure) 01175 IF (.NOT. failure) THEN 01176 res="" 01177 pos=1 01178 my_accept_undefined=.FALSE. 01179 IF (PRESENT(accept_undefined)) my_accept_undefined=accept_undefined 01180 DO i=1,unit%n_kinds 01181 CPPrecondition(unit%kind_id(i)/=0,cp_failure_level,routineP,error,failure) 01182 CPPrecondition(pos<LEN(res),cp_failure_level,routineP,error,failure) 01183 IF (failure) EXIT 01184 my_unit=unit%unit_id(i) 01185 has_defaults=.FALSE. 01186 IF (PRESENT(defaults)) has_defaults=ASSOCIATED(defaults) 01187 IF (my_unit==0) THEN 01188 IF (has_defaults) THEN 01189 my_unit=defaults%units(unit%kind_id(i))%unit%unit_id(1) 01190 ELSE 01191 check = my_accept_undefined.OR.unit%kind_id(i)/=0 01192 CPPrecondition(check,cp_failure_level,routineP,error,failure) 01193 END IF 01194 END IF 01195 res(pos:)=TRIM(cp_basic_unit_desc(basic_kind=unit%kind_id(i),& 01196 basic_unit=my_unit,accept_undefined=my_accept_undefined,& 01197 power=unit%power(i),error=error)) 01198 pos=LEN_TRIM(res)+1 01199 END DO 01200 END IF 01201 END FUNCTION cp_unit_desc 01202 01203 ! ***************************************************************************** 01214 FUNCTION cp_unit_to_cp2k1(value,unit,defaults,power,error) RESULT(res) 01215 REAL(kind=dp), INTENT(in) :: value 01216 TYPE(cp_unit_type), POINTER :: unit 01217 TYPE(cp_unit_set_type), OPTIONAL, 01218 POINTER :: defaults 01219 INTEGER, INTENT(in), OPTIONAL :: power 01220 TYPE(cp_error_type), INTENT(inout) :: error 01221 REAL(kind=dp) :: res 01222 01223 CHARACTER(len=*), PARAMETER :: routineN = 'cp_unit_to_cp2k1', 01224 routineP = moduleN//':'//routineN 01225 01226 INTEGER :: i_unit, my_basic_unit, 01227 my_power 01228 LOGICAL :: failure 01229 01230 failure=.FALSE. 01231 my_power=1 01232 IF (PRESENT(power)) my_power=power 01233 res=value 01234 CPPrecondition(ASSOCIATED(unit),cp_failure_level,routineP,error,failure) 01235 IF (.NOT. failure) THEN 01236 DO i_unit=1,unit%n_kinds 01237 CPPrecondition(unit%kind_id(i_unit)>0,cp_failure_level,routineP,error,failure) 01238 my_basic_unit=unit%unit_id(i_unit) 01239 IF (my_basic_unit==0.AND.unit%kind_id(i_unit)/=cp_ukind_undef) THEN 01240 CPPrecondition(PRESENT(defaults),cp_failure_level,routineP,error,failure) 01241 IF (failure) EXIT 01242 CPPrecondition(ASSOCIATED(defaults),cp_failure_level,routineP,error,failure) 01243 IF (failure) EXIT 01244 CALL cp_assert(ASSOCIATED(defaults%units(unit%kind_id(i_unit))%unit),& 01245 cp_failure_level,cp_assertion_failed,routineP,& 01246 CPSourceFileRef,& 01247 error,failure) 01248 IF (failure) EXIT 01249 my_basic_unit=defaults%units(unit%kind_id(i_unit))%unit%unit_id(1) 01250 END IF 01251 res=cp_basic_unit_to_cp2k(value=res,basic_unit=my_basic_unit,& 01252 basic_kind=unit%kind_id(i_unit),& 01253 power=my_power*unit%power(i_unit),error=error) 01254 END DO 01255 END IF 01256 END FUNCTION cp_unit_to_cp2k1 01257 01258 ! ***************************************************************************** 01269 FUNCTION cp_unit_from_cp2k1(value,unit,defaults,power,error) RESULT(res) 01270 REAL(kind=dp), INTENT(in) :: value 01271 TYPE(cp_unit_type), POINTER :: unit 01272 TYPE(cp_unit_set_type), OPTIONAL, 01273 POINTER :: defaults 01274 INTEGER, INTENT(in), OPTIONAL :: power 01275 TYPE(cp_error_type), INTENT(inout) :: error 01276 REAL(kind=dp) :: res 01277 01278 CHARACTER(len=*), PARAMETER :: routineN = 'cp_unit_from_cp2k1', 01279 routineP = moduleN//':'//routineN 01280 01281 INTEGER :: my_power 01282 LOGICAL :: failure 01283 01284 failure=.FALSE. 01285 my_power=1 01286 IF (PRESENT(power)) my_power=power 01287 IF (PRESENT(defaults)) THEN 01288 res=cp_unit_to_cp2k1(value=value,unit=unit,defaults=defaults,& 01289 power=-my_power,error=error) 01290 ELSE 01291 res=cp_unit_to_cp2k1(value=value,unit=unit,power=-my_power,error=error) 01292 END IF 01293 END FUNCTION cp_unit_from_cp2k1 01294 01295 ! ***************************************************************************** 01306 FUNCTION cp_unit_to_cp2k(value,unit_str,defaults,power,error) RESULT(res) 01307 REAL(kind=dp), INTENT(in) :: value 01308 CHARACTER(len=*), INTENT(in) :: unit_str 01309 TYPE(cp_unit_set_type), OPTIONAL, 01310 POINTER :: defaults 01311 INTEGER, INTENT(in), OPTIONAL :: power 01312 TYPE(cp_error_type), INTENT(inout) :: error 01313 REAL(kind=dp) :: res 01314 01315 CHARACTER(len=*), PARAMETER :: routineN = 'cp_unit_to_cp2k', 01316 routineP = moduleN//':'//routineN 01317 01318 TYPE(cp_unit_type), POINTER :: my_unit 01319 01320 NULLIFY(my_unit) 01321 CALL cp_unit_create(my_unit,unit_str,error=error) 01322 IF (PRESENT(defaults)) THEN 01323 res=cp_unit_to_cp2k1(value=value,unit=my_unit,defaults=defaults,& 01324 power=power,error=error) 01325 ELSE 01326 res=cp_unit_to_cp2k1(value=value,unit=my_unit,power=power,error=error) 01327 END IF 01328 CALL cp_unit_release(my_unit,error=error) 01329 END FUNCTION cp_unit_to_cp2k 01330 01331 ! ***************************************************************************** 01342 FUNCTION cp_unit_from_cp2k(value,unit_str,defaults,power,error) RESULT(res) 01343 REAL(kind=dp), INTENT(in) :: value 01344 CHARACTER(len=*), INTENT(in) :: unit_str 01345 TYPE(cp_unit_set_type), OPTIONAL, 01346 POINTER :: defaults 01347 INTEGER, INTENT(in), OPTIONAL :: power 01348 TYPE(cp_error_type), INTENT(inout) :: error 01349 REAL(kind=dp) :: res 01350 01351 CHARACTER(len=*), PARAMETER :: routineN = 'cp_unit_from_cp2k', 01352 routineP = moduleN//':'//routineN 01353 01354 TYPE(cp_unit_type), POINTER :: my_unit 01355 01356 NULLIFY(my_unit) 01357 CALL cp_unit_create(my_unit,unit_str,error=error) 01358 IF (PRESENT(defaults)) THEN 01359 res=cp_unit_from_cp2k1(value=value,unit=my_unit,defaults=defaults,& 01360 power=power,error=error) 01361 ELSE 01362 res=cp_unit_from_cp2k1(value=value,unit=my_unit,power=power,error=error) 01363 END IF 01364 CALL cp_unit_release(my_unit,error=error) 01365 END FUNCTION cp_unit_from_cp2k 01366 01367 ! ***************************************************************************** 01373 FUNCTION cp_unit_compatible(ref_unit,unit,error) RESULT(res) 01374 TYPE(cp_unit_type), POINTER :: ref_unit, unit 01375 TYPE(cp_error_type), INTENT(inout) :: error 01376 LOGICAL :: res 01377 01378 CHARACTER(len=*), PARAMETER :: routineN = 'cp_unit_compatible', 01379 routineP = moduleN//':'//routineN 01380 01381 INTEGER :: i 01382 01383 res = .TRUE. 01384 DO i = 1, SIZE(ref_unit%kind_id) 01385 IF (ref_unit%kind_id(i)==unit%kind_id(i)) CYCLE 01386 IF ((ref_unit%kind_id(1)==cp_ukind_undef).AND.(ALL(ref_unit%kind_id(2:)==cp_ukind_none))) CYCLE 01387 res = .FALSE. 01388 EXIT 01389 END DO 01390 01391 END FUNCTION cp_unit_compatible 01392 01393 ! ***************************************************************************** 01402 SUBROUTINE cp_unit_set_create(unit_set,name,error) 01403 TYPE(cp_unit_set_type), POINTER :: unit_set 01404 CHARACTER(len=*), INTENT(in) :: name 01405 TYPE(cp_error_type), INTENT(inout) :: error 01406 01407 CHARACTER(len=*), PARAMETER :: routineN = 'cp_unit_set_create', 01408 routineP = moduleN//':'//routineN 01409 01410 CHARACTER(len=default_string_length) :: my_name 01411 INTEGER :: i, stat 01412 LOGICAL :: failure 01413 01414 failure=.FALSE. 01415 CPPrecondition(.NOT.ASSOCIATED(unit_set),cp_failure_level,routineP,error,failure) 01416 ALLOCATE(unit_set,stat=stat) 01417 CPPostcondition(stat==0,cp_fatal_level,routineP,error,failure) 01418 unit_set%ref_count=1 01419 last_unit_set_id=last_unit_set_id+1 01420 unit_set%id_nr=last_unit_set_id 01421 my_name=name 01422 CALL uppercase(my_name) 01423 IF (.NOT.failure) THEN 01424 01425 DO i=1,cp_ukind_max 01426 NULLIFY(unit_set%units(i)%unit) 01427 END DO 01428 DO i=1,cp_ukind_max 01429 SELECT CASE(name) 01430 CASE('ATOM','ATOMIC','INTERNAL','CP2K') 01431 IF (i==cp_ukind_angle) THEN 01432 CALL cp_unit_create2(unit_set%units(i)%unit, kind_id=(/i/),& 01433 unit_id=(/cp_units_rad/), power=(/1/), error=error) 01434 ELSE 01435 CALL cp_unit_create2(unit_set%units(i)%unit, kind_id=(/i/),& 01436 unit_id=(/cp_units_au/), power=(/1/), error=error) 01437 END IF 01438 CASE('OUTPUT') 01439 SELECT CASE(i) 01440 CASE(cp_ukind_undef) 01441 CALL cp_unit_create2(unit_set%units(i)%unit, kind_id=(/i/), unit_id=(/cp_units_none/),& 01442 power=(/1/), error=error) 01443 CASE(cp_ukind_energy) 01444 CALL cp_unit_create2(unit_set%units(i)%unit, kind_id=(/i/), unit_id=(/cp_units_hartree/),& 01445 power=(/1/), error=error) 01446 CASE (cp_ukind_length) 01447 CALL cp_unit_create2(unit_set%units(i)%unit, kind_id=(/i/), unit_id=(/cp_units_angstrom/),& 01448 power=(/1/), error=error) 01449 CASE (cp_ukind_temperature) 01450 CALL cp_unit_create2(unit_set%units(i)%unit, kind_id=(/i/), unit_id=(/cp_units_k/),& 01451 power=(/1/), error=error) 01452 CASE (cp_ukind_angle) 01453 CALL cp_unit_create2(unit_set%units(i)%unit, kind_id=(/i/), unit_id=(/cp_units_deg/),& 01454 power=(/1/), error=error) 01455 CASE (cp_ukind_pressure) 01456 CALL cp_unit_create2(unit_set%units(i)%unit, kind_id=(/i/), unit_id=(/cp_units_bar/),& 01457 power=(/1/), error=error) 01458 CASE (cp_ukind_time) 01459 CALL cp_unit_create2(unit_set%units(i)%unit, kind_id=(/i/), unit_id=(/cp_units_fs/),& 01460 power=(/1/), error=error) 01461 CASE (cp_ukind_mass) 01462 CALL cp_unit_create2(unit_set%units(i)%unit, kind_id=(/i/), unit_id=(/cp_units_amu/),& 01463 power=(/1/), error=error) 01464 CASE (cp_ukind_potential) 01465 CALL cp_unit_create2(unit_set%units(i)%unit, kind_id=(/i/), unit_id=(/cp_units_volt/),& 01466 power=(/1/), error=error) 01467 CASE default 01468 CALL cp_assert(.FALSE.,cp_assertion_failed,cp_failure_level,routineP,& 01469 "unhandled unit type "//TRIM(cp_to_string(i)),error,failure) 01470 EXIT 01471 END SELECT 01472 CASE default 01473 CALL cp_assert(.FALSE.,cp_assertion_failed,cp_failure_level,& 01474 routineP,'unknown parameter set name '//TRIM(name),& 01475 error,failure) 01476 END SELECT 01477 END DO 01478 END IF 01479 END SUBROUTINE cp_unit_set_create 01480 01481 ! ***************************************************************************** 01488 SUBROUTINE cp_unit_set_retain(unit_set,error) 01489 TYPE(cp_unit_set_type), POINTER :: unit_set 01490 TYPE(cp_error_type), INTENT(inout) :: error 01491 01492 CHARACTER(len=*), PARAMETER :: routineN = 'cp_unit_set_retain', 01493 routineP = moduleN//':'//routineN 01494 01495 LOGICAL :: failure 01496 01497 failure=.FALSE. 01498 01499 CPPrecondition(ASSOCIATED(unit_set),cp_failure_level,routineP,error,failure) 01500 IF (.NOT. failure) THEN 01501 CPPrecondition(unit_set%ref_count>0,cp_failure_level,routineP,error,failure) 01502 unit_set%ref_count=unit_set%ref_count+1 01503 END IF 01504 END SUBROUTINE cp_unit_set_retain 01505 01506 ! ***************************************************************************** 01513 SUBROUTINE cp_unit_set_release(unit_set,error) 01514 TYPE(cp_unit_set_type), POINTER :: unit_set 01515 TYPE(cp_error_type), INTENT(inout) :: error 01516 01517 CHARACTER(len=*), PARAMETER :: routineN = 'cp_unit_set_release', 01518 routineP = moduleN//':'//routineN 01519 01520 INTEGER :: i, stat 01521 LOGICAL :: failure 01522 01523 failure=.FALSE. 01524 01525 IF (ASSOCIATED(unit_set)) THEN 01526 CPPrecondition(unit_set%ref_count>0,cp_failure_level,routineP,error,failure) 01527 unit_set%ref_count=unit_set%ref_count-1 01528 IF (unit_set%ref_count == 0) THEN 01529 DO i = 1, SIZE(unit_set%units) 01530 CALL cp_unit_release(unit_set%units(i)%unit,error) 01531 END DO 01532 DEALLOCATE(unit_set,stat=stat) 01533 CPPostconditionNoFail(stat==0,cp_warning_level,routineP,error) 01534 END IF 01535 END IF 01536 END SUBROUTINE cp_unit_set_release 01537 01538 ! ***************************************************************************** 01542 SUBROUTINE print_all_units(unit_nr) 01543 INTEGER, INTENT(IN) :: unit_nr 01544 01545 CHARACTER(len=*), PARAMETER :: routineN = 'print_all_units', 01546 routineP = moduleN//':'//routineN 01547 01548 CALL print_section_unit(unit_label="Undefined",description="If the default unit "//& 01549 "of a keyword is explicitly undefined, all possible units of measurement can "//& 01550 "be used to define a proper value.",& 01551 units_set=s2a("internal_cp2k"), unit_nr=unit_nr) 01552 01553 CALL print_section_unit(unit_label="Energy",description="Possible units of measurement "//& 01554 "for Energies. The [energy] entry acts like a dummy flag (assumes the unit of "//& 01555 "measurement of energy is in internal units), useful for dimensional analysis.",& 01556 units_set=s2a("hartree","wavenumber_e","joule","kcalmol","kjmol","Ry",& 01557 "eV","K_e","energy"), unit_nr=unit_nr) 01558 01559 CALL print_section_unit(unit_label="Length",description="Possible units of measurement "//& 01560 "for Lengths. The [length] entry acts like a dummy flag (assumes the unit of "//& 01561 "measurement of length is in internal units), useful for dimensional analysis.",& 01562 units_set=s2a("bohr","m","pm","nm","angstrom","length"), unit_nr=unit_nr) 01563 01564 CALL print_section_unit(unit_label="Temperature",description="Possible units of measurement "//& 01565 "for Temperature. The [temperature] entry acts like a dummy flag (assumes the unit of "//& 01566 "measurement of temperature is in internal units), useful for dimensional analysis.",& 01567 units_set=s2a("K","au_temp","temperature"), unit_nr=unit_nr) 01568 01569 CALL print_section_unit(unit_label="Pressure",description="Possible units of measurement "//& 01570 "for Pressure. The [pressure] entry acts like a dummy flag (assumes the unit of "//& 01571 "measurement of pressure is in internal units), useful for dimensional analysis.",& 01572 units_set=s2a("bar","atm","kbar","Pa","MPa","GPa","au_p","pressure"),& 01573 unit_nr=unit_nr) 01574 01575 CALL print_section_unit(unit_label="Angle",description="Possible units of measurement "//& 01576 "for Angles. The [angle] entry acts like a dummy flag (assumes the unit of "//& 01577 "measurement of angle is in internal units), useful for dimensional analysis.",& 01578 units_set=s2a("rad","deg","angle"),unit_nr=unit_nr) 01579 01580 CALL print_section_unit(unit_label="Time",description="Possible units of measurement "//& 01581 "for Time. The [time] entry acts like a dummy flag (assumes the unit of "//& 01582 "measurement of time is in internal units), useful for dimensional analysis.",& 01583 units_set=s2a("s","fs","ps","au_t","wavenumber_t","time"),unit_nr=unit_nr) 01584 01585 CALL print_section_unit(unit_label="Mass",description="Possible units of measurement "//& 01586 "for Masses. The [mass] entry acts like a dummy flag (assumes the unit of "//& 01587 "measurement of mass is in internal units), useful for dimensional analysis.",& 01588 units_set=s2a("kg","amu","m_e","mass"),unit_nr=unit_nr) 01589 01590 CALL print_section_unit(unit_label="Potential",description="Possible units of measurement "//& 01591 "for potentials. The [potential] entry acts like a dummy flag (assumes the unit of "//& 01592 "measurement of potential is in internal units), useful for dimensional analysis.",& 01593 units_set=s2a("volt","au_pot","potential"),unit_nr=unit_nr) 01594 01595 END SUBROUTINE print_all_units 01596 01597 ! ***************************************************************************** 01601 SUBROUTINE print_section_unit(unit_label, description, units_set, unit_nr) 01602 CHARACTER(LEN=*), INTENT(IN) :: unit_label, description 01603 CHARACTER(LEN=*), DIMENSION(:), 01604 INTENT(IN) :: units_set 01605 INTEGER, INTENT(IN) :: unit_nr 01606 01607 CHARACTER(len=*), PARAMETER :: routineN = 'print_section_unit', 01608 routineP = moduleN//':'//routineN 01609 01610 INTEGER :: i 01611 01612 WRITE(unit_nr,FMT='(A)') "<H2>"//TRIM(unit_label)//"</H2>" 01613 WRITE(unit_nr,FMT='(A)')description//"<BR><DL>" 01614 DO i =1, SIZE(units_set) 01615 WRITE(unit_nr,FMT='(A)')"<DD><B>"//TRIM(units_set(i))//"</B></DD>" 01616 END DO 01617 WRITE(unit_nr,FMT='(A)')"</DL><P>" 01618 END SUBROUTINE print_section_unit 01619 01620 END MODULE cp_units
1.7.3