source: LMDZ6/branches/Ocean_skin/libf/phylmd/phyetat0_get_mod.F90 @ 4999

Last change on this file since 4999 was 4369, checked in by lguez, 2 years ago

Sync latest trunk changes to branch Ocean_skin
File size: 6.4 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!==============================================================================
16LOGICAL 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)
26END FUNCTION phyetat0_get10
27!==============================================================================
28LOGICAL 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)
37END FUNCTION phyetat0_get20
38!==============================================================================
39LOGICAL 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)
49END FUNCTION phyetat0_get11
50!==============================================================================
51LOGICAL 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 print_control_mod, 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
79END FUNCTION phyetat0_get21
80!==============================================================================
81LOGICAL 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,:)
92END FUNCTION phyetat0_srf20
93
94!==============================================================================
95LOGICAL 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)
104END FUNCTION phyetat0_srf30
105
106!==============================================================================
107LOGICAL 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,:)
117END FUNCTION phyetat0_srf21
118
119!==============================================================================
120LOGICAL 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 print_control_mod, ONLY: lunout
124  USE strings_mod,       ONLY: int2str, maxlen
125  IMPLICIT NONE
126  REAL,             INTENT(INOUT) :: field(:,:,:)
127  CHARACTER(LEN=*), INTENT(IN)    :: name(:)
128  CHARACTER(LEN=*), INTENT(IN)    :: descr
129  REAL,             INTENT(IN)    :: default
130!-----------------------------------------------------------------------------
131  INTEGER :: nsrf, i
132  CHARACTER(LEN=maxlen) :: nam(SIZE(name)), tname, des
133  IF(SIZE(field,3)>99) CALL abort_physic("phyetat0", "Too much sub-cells", 1)
134  DO nsrf = 1, SIZE(field,3)
135    DO i = 1, SIZE(name); nam(i) = TRIM(name(i))//TRIM(int2str(nsrf,2)); END DO
136    des = TRIM(descr)//" srf:"//int2str(nsrf,2)
137    lFound = phyetat0_get21(field(:,:,nsrf), nam, TRIM(des), default, tname)
138  END DO
139  WRITE(lunout,'(2(a,ES14.7))') 'phyetat0: '//TRIM(tname)//' ('//TRIM(descr)//') min/max=', &
140    MINval(field),' ',MAXval(field)
141END FUNCTION phyetat0_srf31
142
143END MODULE phyetat0_get_mod
Note: See TracBrowser for help on using the repository browser.