MODULE phyetat0_get_mod PRIVATE PUBLIC :: phyetat0_get, phyetat0_srf INTERFACE phyetat0_get MODULE PROCEDURE phyetat0_get10, phyetat0_get20, phyetat0_get11, phyetat0_get21 END INTERFACE phyetat0_get INTERFACE phyetat0_srf MODULE PROCEDURE phyetat0_srf20, phyetat0_srf30, phyetat0_srf21, phyetat0_srf31 END INTERFACE phyetat0_srf CONTAINS !============================================================================== LOGICAL FUNCTION phyetat0_get10(field, name, descr, default) RESULT(lFound) ! Read a field. Check whether reading succeded and use default value if not. IMPLICIT NONE REAL, INTENT(INOUT) :: field(:) ! klon CHARACTER(LEN=*), INTENT(IN) :: name CHARACTER(LEN=*), INTENT(IN) :: descr REAL, INTENT(IN) :: default !------------------------------------------------------------------------------ REAL :: fld(SIZE(field),1) lFound = phyetat0_get21(fld, [name], descr, default); field = fld(:,1) END FUNCTION phyetat0_get10 !============================================================================== LOGICAL FUNCTION phyetat0_get20(field, name, descr, default) RESULT(lFound) ! Same as phyetat0_get11, field on multiple levels. IMPLICIT NONE REAL, INTENT(INOUT) :: field(:,:) ! klon, nlev CHARACTER(LEN=*), INTENT(IN) :: name CHARACTER(LEN=*), INTENT(IN) :: descr REAL, INTENT(IN) :: default !----------------------------------------------------------------------------- lFound = phyetat0_get21(field, [name], descr, default) END FUNCTION phyetat0_get20 !============================================================================== LOGICAL FUNCTION phyetat0_get11(field, name, descr, default) RESULT(lFound) ! Same as phyetat0_get11, multiple names. IMPLICIT NONE REAL, INTENT(INOUT) :: field(:) ! klon CHARACTER(LEN=*), INTENT(IN) :: name(:) CHARACTER(LEN=*), INTENT(IN) :: descr REAL, INTENT(IN) :: default !----------------------------------------------------------------------------- REAL :: fld(SIZE(field),1) lFound = phyetat0_get21(fld, name, descr, default); field = fld(:,1) END FUNCTION phyetat0_get11 !============================================================================== LOGICAL FUNCTION phyetat0_get21(field, name, descr, default, tname) RESULT(lFound) ! Same as phyetat0_get11, field on multiple levels, multiple names. USE iostart, ONLY: get_field USE print_control_mod, ONLY: lunout IMPLICIT NONE REAL, INTENT(INOUT) :: field(:,:) ! klon, nlev CHARACTER(LEN=*), INTENT(IN) :: name(:) CHARACTER(LEN=*), INTENT(IN) :: descr REAL, INTENT(IN) :: default CHARACTER(LEN=*), OPTIONAL, INTENT(OUT) :: tname !----------------------------------------------------------------------------- CHARACTER(LEN=LEN(name)) :: tnam INTEGER :: i DO i = 1, SIZE(name) CALL get_field(TRIM(name(i)), field, lFound) IF(lFound) EXIT WRITE(lunout,*) "phyetat0: Missing field <",TRIM(name(i)),"> " END DO IF(.NOT.lFound) THEN WRITE(lunout,*) "Slightly distorted start ; continuing." field(:,:) = default tnam = name(1) ELSE tnam = name(i) END IF WRITE(lunout,'(2(a,ES14.7))') 'phyetat0: '//TRIM(tnam)//' ('//TRIM(descr)//') min/max=', & MINval(field),' ',MAXval(field) IF(PRESENT(tname)) tname = tnam END FUNCTION phyetat0_get21 !============================================================================== LOGICAL FUNCTION phyetat0_srf20(field, name, descr, default) RESULT(lFound) ! Read a field per sub-surface. ! Check whether reading succeded and use default value if not. IMPLICIT NONE REAL, INTENT(INOUT) :: field(:,:) CHARACTER(LEN=*), INTENT(IN) :: name CHARACTER(LEN=*), INTENT(IN) :: descr REAL, INTENT(IN) :: default !----------------------------------------------------------------------------- REAL :: fld(SIZE(field,1),1,SIZE(field,2)) lFound = phyetat0_srf31(fld, [name], descr, default); field = fld(:,1,:) END FUNCTION phyetat0_srf20 !============================================================================== LOGICAL FUNCTION phyetat0_srf30(field, name, descr, default) RESULT(lFound) ! Same as phyetat0_sfr11, multiple names tested one after the other. IMPLICIT NONE REAL, INTENT(INOUT) :: field(:,:,:) CHARACTER(LEN=*), INTENT(IN) :: name CHARACTER(LEN=*), INTENT(IN) :: descr REAL, INTENT(IN) :: default !----------------------------------------------------------------------------- lFound = phyetat0_srf31(field, [name], descr, default) END FUNCTION phyetat0_srf30 !============================================================================== LOGICAL FUNCTION phyetat0_srf21(field, name, descr, default) RESULT(lFound) ! Same as phyetat0_sfr11, field on multiple levels. IMPLICIT NONE REAL, INTENT(INOUT) :: field(:,:) CHARACTER(LEN=*), INTENT(IN) :: name(:) CHARACTER(LEN=*), INTENT(IN) :: descr REAL, INTENT(IN) :: default !----------------------------------------------------------------------------- REAL :: fld(SIZE(field,1),1,SIZE(field,2)) lFound = phyetat0_srf31(fld, name, descr, default); field = fld(:,1,:) END FUNCTION phyetat0_srf21 !============================================================================== LOGICAL FUNCTION phyetat0_srf31(field, name, descr, default) RESULT(lFound) ! Same as phyetat0_sfr11, field on multiple levels, multiple names tested one after the other. USE iostart, ONLY: get_field USE print_control_mod, ONLY: lunout USE strings_mod, ONLY: int2str, maxlen IMPLICIT NONE REAL, INTENT(INOUT) :: field(:,:,:) CHARACTER(LEN=*), INTENT(IN) :: name(:) CHARACTER(LEN=*), INTENT(IN) :: descr REAL, INTENT(IN) :: default !----------------------------------------------------------------------------- INTEGER :: nsrf, i CHARACTER(LEN=maxlen) :: nam(SIZE(name)), tname, des IF(SIZE(field,3)>99) CALL abort_physic("phyetat0", "Too much sub-cells", 1) DO nsrf = 1, SIZE(field,3) DO i = 1, SIZE(name); nam(i) = TRIM(name(i))//TRIM(int2str(nsrf,2)); END DO des = TRIM(descr)//" srf:"//int2str(nsrf,2) lFound = phyetat0_get21(field(:,:,nsrf), nam, TRIM(des), default, tname) END DO WRITE(lunout,'(2(a,ES14.7))') 'phyetat0: '//TRIM(tname)//' ('//TRIM(descr)//') min/max=', & MINval(field),' ',MAXval(field) END FUNCTION phyetat0_srf31 END MODULE phyetat0_get_mod