source: LMDZ6/branches/Portage_acc/libf/phylmdiso/phyetat0_get_mod.F90 @ 4743

Last change on this file since 4743 was 4447, checked in by Laurent Fairhead, 16 months ago

Added some routines from the trunk that were previously links and that svn did not want to commit on the previous commit (with an
"Node filename has unexpectedly changed kind" error)
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.