phyetat0_get_mod.f90 Source File

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: num2str, 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(num2str(nsrf,2)); END DO
    des = TRIM(descr)//" srf:"//num2str(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