source: LMDZ5/branches/IPSLCM6.0.11pre/libf/dyn3d/dynredem_mod.F90 @ 5360

Last change on this file since 5360 was 2299, checked in by dcugnet, 10 years ago

In dyn3d/:
etat0dyn_netcdf.F90: "startget_dyn3d" syntax slightly simplified.
dynredem.F90: Shortcut routines (put_var*, cre_var,
dynredem_write_*, dynredem_read_u)

modified to match dyn3dmem version and put in

module dyredem_mod.F90.
dynetat0.F90 -> *.f90: Few simplifications (no usage of NC_DOUBLE
needed => no precompilation)

Add tracers initialization in the isotope case

suppressed by accident.
dynredem_mod.F90: Created to mimic dyn3dmem equivalent.

In dyn3dmem/:
dynetat0_loc.F -> *.f90: Converted into fortran 90 to match the dyn3d
version.
dynredem_loc.F -> *.F90: Converted into fortran 90.
dynredem_mod.F90: Add some shortcut routines to match the dyn3d
version.

In phylmd/:
phyredem.F90: Bug fix: nsw instead of nsoilmx was used as
Tsoil second maximum index.

Bug fix: fevap instead of snow was saved for

"SNOW".
etat0phys_netcdf.F90: "filtreg_mod" module usage suppressed.

Local variable rugo computation removed (not

used).

In dynlonlat_phylonlat/:
grid_atob_m.F90 -> *.f90 DOUBLE PRECISION variables usage removed.

Precompilation o longer needed => .F90 extension.
File size: 8.2 KB
Line 
1MODULE dynredem_mod
2
3  USE netcdf
4  PRIVATE
5  PUBLIC :: dynredem_write_u, dynredem_write_v, dynredem_read_u, err
6  PUBLIC :: cre_var, get_var1, put_var1, put_var2, fil, modname, msg
7  include "dimensions.h"
8  include "paramet.h"
9  CHARACTER(LEN=256), SAVE :: fil, modname
10  INTEGER,            SAVE :: nvarid
11
12
13CONTAINS
14
15
16!===============================================================================
17!
18SUBROUTINE dynredem_write_u(ncid,id,var,ll)
19!
20!===============================================================================
21  IMPLICIT NONE
22!===============================================================================
23! Arguments:
24  INTEGER,          INTENT(IN) :: ncid
25  CHARACTER(LEN=*), INTENT(IN) :: id
26  REAL,             INTENT(IN) :: var(iip1,jjp1,ll)
27  INTEGER,          INTENT(IN) :: ll
28!===============================================================================
29! Local variables:
30  INTEGER :: start(4), count(4)
31!===============================================================================
32  start(:)=[1,1,1,1]; count(:)=[iip1,jjp1,ll,1]
33  CALL err(NF90_INQ_VARID(ncid,id,nvarid),"inq",id)
34  CALL err(NF90_PUT_VAR(ncid,nvarid,var,start,count),"put",id)
35 
36END SUBROUTINE dynredem_write_u
37!
38!===============================================================================
39
40
41!===============================================================================
42!
43SUBROUTINE dynredem_write_v(ncid,id,var,ll)
44!
45!===============================================================================
46  IMPLICIT NONE
47!===============================================================================
48! Arguments:
49  INTEGER,          INTENT(IN) :: ncid
50  CHARACTER(LEN=*), INTENT(IN) :: id
51  REAL,             INTENT(IN) :: var(iip1,jjm,ll)
52  INTEGER,          INTENT(IN) :: ll
53!===============================================================================
54! Local variables:
55  INTEGER :: start(4), count(4)
56!===============================================================================
57  start(:)=[1,1,1,1]; count(:)=[iip1,jjm,ll,1]
58  CALL err(NF90_INQ_VARID(ncid,id,nvarid),"inq",id)
59  CALL err(NF90_PUT_VAR(ncid,nvarid,var,start,count),"put",id)
60 
61END SUBROUTINE dynredem_write_v
62!
63!===============================================================================
64
65
66!===============================================================================
67!
68SUBROUTINE dynredem_read_u(ncid,id,var,ll)
69!
70!===============================================================================
71  IMPLICIT NONE
72!===============================================================================
73! Arguments:
74  INTEGER,          INTENT(IN)  :: ncid
75  CHARACTER(LEN=*), INTENT(IN)  :: id
76  REAL,             INTENT(OUT) :: var(iip1,jjp1,ll)
77  INTEGER,          INTENT(IN)  :: ll
78!===============================================================================
79! Local variables:
80  INTEGER :: start(4), count(4)
81!===============================================================================
82  start(:)=[1,1,1,1]; count(:)=[iip1,jjp1,ll,1]
83  CALL err(NF90_INQ_VARID(ncid,id,nvarid),"inq",id)
84  CALL err(NF90_GET_VAR(ncid,nvarid,var,start,count),"get",id)
85 
86END SUBROUTINE dynredem_read_u   
87!
88!===============================================================================
89
90
91!===============================================================================
92!
93SUBROUTINE cre_var(ncid,var,title,did,units)
94!
95!===============================================================================
96  IMPLICIT NONE
97!===============================================================================
98! Arguments:
99  INTEGER,                    INTENT(IN) :: ncid
100  CHARACTER(LEN=*),           INTENT(IN) :: var, title
101  INTEGER,                    INTENT(IN) :: did(:)
102  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units
103!===============================================================================
104#ifdef NC_DOUBLE
105  CALL err(NF90_DEF_VAR(ncid,var,NF90_DOUBLE,did,nvarid),"inq",var)
106#else
107  CALL err(NF90_DEF_VAR(ncid,var,NF90_FLOAT ,did,nvarid),"inq",var)
108#endif
109  IF(title/="")      CALL err(NF90_PUT_ATT(ncid,nvarid,"title",title),var)
110  IF(PRESENT(units)) CALL err(NF90_PUT_ATT(ncid,nvarid,"units",units),var)
111
112END SUBROUTINE cre_var
113!
114!===============================================================================
115
116
117!===============================================================================
118!
119SUBROUTINE put_var1(ncid,var,title,did,v,units)
120!
121!===============================================================================
122  IMPLICIT NONE
123!===============================================================================
124! Arguments:
125  INTEGER,                    INTENT(IN) :: ncid
126  CHARACTER(LEN=*),           INTENT(IN) :: var, title
127  INTEGER,                    INTENT(IN) :: did(1)
128  REAL,                       INTENT(IN) :: v(:)
129  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units
130!===============================================================================
131  IF(     PRESENT(units)) CALL cre_var(ncid,var,title,did,units)
132  IF(.NOT.PRESENT(units)) CALL cre_var(ncid,var,title,did)
133  CALL err(NF90_ENDDEF(ncid))
134  CALL err(NF90_PUT_VAR(ncid,nvarid,v),"put",var)
135  CALL err(NF90_REDEF(ncid))
136
137END SUBROUTINE put_var1
138!
139!===============================================================================
140
141
142!===============================================================================
143!
144SUBROUTINE put_var2(ncid,var,title,did,v,units)
145!
146!===============================================================================
147  IMPLICIT NONE
148!===============================================================================
149! Arguments:
150  INTEGER,                    INTENT(IN) :: ncid
151  CHARACTER(LEN=*),           INTENT(IN) :: var, title
152  INTEGER,                    INTENT(IN) :: did(2)
153  REAL,                       INTENT(IN) :: v(:,:)
154  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units
155!===============================================================================
156  IF(     PRESENT(units)) CALL cre_var(ncid,var,title,did,units)
157  IF(.NOT.PRESENT(units)) CALL cre_var(ncid,var,title,did)
158  CALL err(NF90_ENDDEF(ncid))
159  CALL err(NF90_PUT_VAR(ncid,nvarid,v),"put",var)
160  CALL err(NF90_REDEF(ncid))
161
162END SUBROUTINE put_var2
163!
164!===============================================================================
165
166
167!===============================================================================
168!
169FUNCTION msg(typ,nam)
170!
171!===============================================================================
172  IMPLICIT NONE
173!===============================================================================
174! Arguments:
175  CHARACTER(LEN=256)                     :: msg    !--- STANDARDIZED MESSAGE
176  CHARACTER(LEN=*),           INTENT(IN) :: typ    !--- TYPE OF OPERATION
177  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: nam    !--- FIELD NAME
178!===============================================================================
179  SELECT CASE(typ)
180    CASE('open');  msg="Opening failed for <"//TRIM(fil)//">"
181    CASE('close'); msg="Closing failed for <"//TRIM(fil)//">"
182    CASE('get');   msg="Reading failed for <"//TRIM(nam)//">"
183    CASE('put');   msg="Writting failed for <"//TRIM(nam)//">"
184    CASE('inq');   msg="Missing field <"//TRIM(nam)//">"
185    CASE('fnd');   msg="Found field <"//TRIM(nam)//">"
186  END SELECT
187  msg=TRIM(msg)//" in file <"//TRIM(fil)//">"
188
189END FUNCTION msg
190!
191!===============================================================================
192
193
194!===============================================================================
195!
196SUBROUTINE err(ierr,typ,nam)
197!
198!===============================================================================
199  IMPLICIT NONE
200!===============================================================================
201! Arguments:
202  INTEGER,                    INTENT(IN) :: ierr   !--- NetCDF ERROR CODE
203  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: typ    !--- TYPE OF OPERATION
204  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: nam    !--- FIELD NAME
205!===============================================================================
206  IF(ierr==NF90_NoERR) RETURN
207  IF(.NOT.PRESENT(typ)) THEN
208    CALL ABORT_gcm(modname,NF90_STRERROR(ierr),ierr)
209  ELSE
210    CALL ABORT_gcm(modname,msg(typ,nam),ierr)
211  END IF
212
213END SUBROUTINE err
214!
215!===============================================================================
216
217END MODULE dynredem_mod   
218   
219   
Note: See TracBrowser for help on using the repository browser.