source: LMDZ6/branches/Amaury_dev/libf/phylmd/phyetat0_get_mod.F90 @ 5116

Last change on this file since 5116 was 5112, checked in by abarral, 4 months ago

Rename modules in phy_common from *_mod > lmdz_*
File size: 6.5 KB
Line 
1MODULE phyetat0_get_mod
2
3  PRIVATE
4  PUBLIC :: phyetat0_get, phyetat0_srf
5
6  INTERFACE phyetat0_get
7    MODULE PROCEDURE phyetat0_get10, phyetat0_get20, phyetat0_get11, phyetat0_get21
8  END INTERFACE phyetat0_get
9  INTERFACE phyetat0_srf
10    MODULE PROCEDURE phyetat0_srf20, phyetat0_srf30, phyetat0_srf21, phyetat0_srf31
11  END INTERFACE phyetat0_srf
12
13CONTAINS
14
15  !==============================================================================
16  LOGICAL FUNCTION phyetat0_get10(field, name, descr, default) RESULT(lFound)
17    ! Read a field. Check whether reading succeded and use default value if not.
18    IMPLICIT NONE
19    REAL, INTENT(INOUT) :: field(:) ! klon
20    CHARACTER(LEN = *), INTENT(IN) :: name
21    CHARACTER(LEN = *), INTENT(IN) :: descr
22    REAL, INTENT(IN) :: default
23    !------------------------------------------------------------------------------
24    REAL :: fld(SIZE(field), 1)
25    lFound = phyetat0_get21(fld, [name], descr, default); field = fld(:, 1)
26  END FUNCTION phyetat0_get10
27  !==============================================================================
28  LOGICAL FUNCTION phyetat0_get20(field, name, descr, default) RESULT(lFound)
29    ! Same as phyetat0_get11, field on multiple levels.
30    IMPLICIT NONE
31    REAL, INTENT(INOUT) :: field(:, :) ! klon, nlev
32    CHARACTER(LEN = *), INTENT(IN) :: name
33    CHARACTER(LEN = *), INTENT(IN) :: descr
34    REAL, INTENT(IN) :: default
35    !-----------------------------------------------------------------------------
36    lFound = phyetat0_get21(field, [name], descr, default)
37  END FUNCTION phyetat0_get20
38  !==============================================================================
39  LOGICAL FUNCTION phyetat0_get11(field, name, descr, default) RESULT(lFound)
40    ! Same as phyetat0_get11, multiple names.
41    IMPLICIT NONE
42    REAL, INTENT(INOUT) :: field(:) ! klon
43    CHARACTER(LEN = *), INTENT(IN) :: name(:)
44    CHARACTER(LEN = *), INTENT(IN) :: descr
45    REAL, INTENT(IN) :: default
46    !-----------------------------------------------------------------------------
47    REAL :: fld(SIZE(field), 1)
48    lFound = phyetat0_get21(fld, name, descr, default); field = fld(:, 1)
49  END FUNCTION phyetat0_get11
50  !==============================================================================
51  LOGICAL FUNCTION phyetat0_get21(field, name, descr, default, tname) RESULT(lFound)
52    ! Same as phyetat0_get11, field on multiple levels, multiple names.
53    USE iostart, ONLY: get_field
54    USE lmdz_print_control, ONLY: lunout
55    IMPLICIT NONE
56    REAL, INTENT(INOUT) :: field(:, :) ! klon, nlev
57    CHARACTER(LEN = *), INTENT(IN) :: name(:)
58    CHARACTER(LEN = *), INTENT(IN) :: descr
59    REAL, INTENT(IN) :: default
60    CHARACTER(LEN = *), OPTIONAL, INTENT(OUT) :: tname
61    !-----------------------------------------------------------------------------
62    CHARACTER(LEN = LEN(name)) :: tnam
63    INTEGER :: i
64    DO i = 1, SIZE(name)
65      CALL get_field(TRIM(name(i)), field, lFound)
66      IF(lFound) EXIT
67      WRITE(lunout, *) "phyetat0: Missing field <", TRIM(name(i)), "> "
68    END DO
69    IF(.NOT.lFound) THEN
70      WRITE(lunout, *) "Slightly distorted start ; continuing."
71      field(:, :) = default
72      tnam = name(1)
73    ELSE
74      tnam = name(i)
75    END IF
76    WRITE(lunout, '(2(a,ES14.7))') 'phyetat0: ' // TRIM(tnam) // ' (' // TRIM(descr) // ') min/max=', &
77            MINval(field), ' ', MAXval(field)
78    IF(PRESENT(tname)) tname = tnam
79  END FUNCTION phyetat0_get21
80  !==============================================================================
81  LOGICAL FUNCTION phyetat0_srf20(field, name, descr, default) RESULT(lFound)
82    ! Read a field per sub-surface.
83    ! Check whether reading succeded and use default value if not.
84    IMPLICIT NONE
85    REAL, INTENT(INOUT) :: field(:, :)
86    CHARACTER(LEN = *), INTENT(IN) :: name
87    CHARACTER(LEN = *), INTENT(IN) :: descr
88    REAL, INTENT(IN) :: default
89    !-----------------------------------------------------------------------------
90    REAL :: fld(SIZE(field, 1), 1, SIZE(field, 2))
91    lFound = phyetat0_srf31(fld, [name], descr, default); field = fld(:, 1, :)
92  END FUNCTION phyetat0_srf20
93
94  !==============================================================================
95  LOGICAL FUNCTION phyetat0_srf30(field, name, descr, default) RESULT(lFound)
96    ! Same as phyetat0_sfr11, multiple names tested one after the other.
97    IMPLICIT NONE
98    REAL, INTENT(INOUT) :: field(:, :, :)
99    CHARACTER(LEN = *), INTENT(IN) :: name
100    CHARACTER(LEN = *), INTENT(IN) :: descr
101    REAL, INTENT(IN) :: default
102    !-----------------------------------------------------------------------------
103    lFound = phyetat0_srf31(field, [name], descr, default)
104  END FUNCTION phyetat0_srf30
105
106  !==============================================================================
107  LOGICAL FUNCTION phyetat0_srf21(field, name, descr, default) RESULT(lFound)
108    ! Same as phyetat0_sfr11, field on multiple levels.
109    IMPLICIT NONE
110    REAL, INTENT(INOUT) :: field(:, :)
111    CHARACTER(LEN = *), INTENT(IN) :: name(:)
112    CHARACTER(LEN = *), INTENT(IN) :: descr
113    REAL, INTENT(IN) :: default
114    !-----------------------------------------------------------------------------
115    REAL :: fld(SIZE(field, 1), 1, SIZE(field, 2))
116    lFound = phyetat0_srf31(fld, name, descr, default); field = fld(:, 1, :)
117  END FUNCTION phyetat0_srf21
118
119  !==============================================================================
120  LOGICAL FUNCTION phyetat0_srf31(field, name, descr, default) RESULT(lFound)
121    ! Same as phyetat0_sfr11, field on multiple levels, multiple names tested one after the other.
122    USE iostart, ONLY: get_field
123    USE lmdz_print_control, ONLY: lunout
124    USE strings_mod, ONLY: int2str, maxlen
125    USE lmdz_abort_physic, ONLY: abort_physic
126    IMPLICIT NONE
127    REAL, INTENT(INOUT) :: field(:, :, :)
128    CHARACTER(LEN = *), INTENT(IN) :: name(:)
129    CHARACTER(LEN = *), INTENT(IN) :: descr
130    REAL, INTENT(IN) :: default
131    !-----------------------------------------------------------------------------
132    INTEGER :: nsrf, i
133    CHARACTER(LEN = maxlen) :: nam(SIZE(name)), tname, des
134    IF(SIZE(field, 3)>99) CALL abort_physic("phyetat0", "Too much sub-cells", 1)
135    DO nsrf = 1, SIZE(field, 3)
136      DO i = 1, SIZE(name); nam(i) = TRIM(name(i)) // TRIM(int2str(nsrf, 2));
137      END DO
138      des = TRIM(descr) // " srf:" // int2str(nsrf, 2)
139      lFound = phyetat0_get21(field(:, :, nsrf), nam, TRIM(des), default, tname)
140    END DO
141    WRITE(lunout, '(2(a,ES14.7))') 'phyetat0: ' // TRIM(tname) // ' (' // TRIM(descr) // ') min/max=', &
142            MINval(field), ' ', MAXval(field)
143  END FUNCTION phyetat0_srf31
144
145END MODULE phyetat0_get_mod
Note: See TracBrowser for help on using the repository browser.