source: trunk/LMDZ.COMMON/libf/dyn3d_common/dynredem_mod.F90 @ 3711

Last change on this file since 3711 was 3510, checked in by jbclement, 12 months ago

Dynamic:
Following of r3509, the description of the 'controle' array in the "start.nc" file is adapted to the planet type (earth, mars or titan).
JBC
File size: 10.7 KB
Line 
1MODULE dynredem_mod
2
3  USE netcdf, ONLY: NF90_NOERR, NF90_DOUBLE, NF90_STRERROR, &
4                    NF90_REDEF, NF90_ENDDEF, NF90_PUT_VAR, &
5                    NF90_PUT_ATT, NF90_GET_VAR, NF90_INQ_VARID, &
6                    NF90_DEF_VAR, NF90_CHAR
7  PRIVATE
8  PUBLIC :: dynredem_write_u, dynredem_write_v, dynredem_read_u, err, int2fmtstr
9  PUBLIC :: cre_var, get_var1, put_var1, put_var2, put_char1, fil, modname, msg
10  include "dimensions.h"
11  include "paramet.h"
12  CHARACTER(LEN=256), SAVE :: fil, modname
13  INTEGER,            SAVE :: nvarid
14
15
16CONTAINS
17
18
19!===============================================================================
20!
21SUBROUTINE dynredem_write_u(ncid,id,var,ll,nb)
22!
23!===============================================================================
24  IMPLICIT NONE
25!===============================================================================
26! Arguments:
27  INTEGER,          INTENT(IN) :: ncid
28  CHARACTER(LEN=*), INTENT(IN) :: id
29  REAL,             INTENT(IN) :: var(iip1,jjp1,ll)
30  INTEGER,          INTENT(IN) :: ll
31  INTEGER,          INTENT(IN) :: nb
32!===============================================================================
33! Local variables:
34  INTEGER :: start(4), count(4)
35!===============================================================================
36  IF (ll.eq.1) THEN
37    start(:)=[1,1,nb,1]
38    count(:)=[iip1,jjp1,1,1]
39  ELSE
40    start(:)=[1,1,1,nb]
41    count(:)=[iip1,jjp1,ll,1]
42  ENDIF
43  CALL err(NF90_INQ_VARID(ncid,id,nvarid),"inq",id)
44  CALL err(NF90_PUT_VAR(ncid,nvarid,var,start,count),"put",id)
45 
46END SUBROUTINE dynredem_write_u
47!
48!===============================================================================
49
50
51!===============================================================================
52!
53SUBROUTINE dynredem_write_v(ncid,id,var,ll,nb)
54!
55!===============================================================================
56  IMPLICIT NONE
57!===============================================================================
58! Arguments:
59  INTEGER,          INTENT(IN) :: ncid
60  CHARACTER(LEN=*), INTENT(IN) :: id
61  REAL,             INTENT(IN) :: var(iip1,jjm,ll)
62  INTEGER,          INTENT(IN) :: ll
63  INTEGER,          INTENT(IN) :: nb
64!===============================================================================
65! Local variables:
66  INTEGER :: start(4), count(4)
67!===============================================================================
68  IF (ll.eq.1) THEN
69    start(:)=[1,1,nb,1]
70    count(:)=[iip1,jjm,1,1]
71  ELSE
72    start(:)=[1,1,1,nb]
73    count(:)=[iip1,jjm,ll,1]
74  ENDIF
75  CALL err(NF90_INQ_VARID(ncid,id,nvarid),"inq",id)
76  CALL err(NF90_PUT_VAR(ncid,nvarid,var,start,count),"put",id)
77 
78END SUBROUTINE dynredem_write_v
79!
80!===============================================================================
81
82
83!===============================================================================
84!
85SUBROUTINE dynredem_read_u(ncid,id,var,ll)
86!
87!===============================================================================
88  IMPLICIT NONE
89!===============================================================================
90! Arguments:
91  INTEGER,          INTENT(IN)  :: ncid
92  CHARACTER(LEN=*), INTENT(IN)  :: id
93  REAL,             INTENT(OUT) :: var(iip1,jjp1,ll)
94  INTEGER,          INTENT(IN)  :: ll
95!===============================================================================
96! Local variables:
97  INTEGER :: start(4), count(4)
98!===============================================================================
99  start(:)=[1,1,1,1]; count(:)=[iip1,jjp1,ll,1]
100  CALL err(NF90_INQ_VARID(ncid,id,nvarid),"inq",id)
101  CALL err(NF90_GET_VAR(ncid,nvarid,var,start,count),"get",id)
102 
103END SUBROUTINE dynredem_read_u   
104!
105!===============================================================================
106
107
108!===============================================================================
109!
110SUBROUTINE cre_var(ncid,var,title,did,units)
111!
112!===============================================================================
113  IMPLICIT NONE
114!===============================================================================
115! Arguments:
116  INTEGER,                    INTENT(IN) :: ncid
117  CHARACTER(LEN=*),           INTENT(IN) :: var, title
118  INTEGER,                    INTENT(IN) :: did(:)
119  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units
120!===============================================================================
121#ifdef NC_DOUBLE
122  CALL err(NF90_DEF_VAR(ncid,var,NF90_DOUBLE,did,nvarid),"inq",var)
123#else
124  CALL err(NF90_DEF_VAR(ncid,var,NF90_FLOAT ,did,nvarid),"inq",var)
125#endif
126  IF(title/="")      CALL err(NF90_PUT_ATT(ncid,nvarid,"title",title),var)
127  IF(PRESENT(units)) CALL err(NF90_PUT_ATT(ncid,nvarid,"units",units),var)
128
129END SUBROUTINE cre_var
130!
131!===============================================================================
132
133
134!===============================================================================
135!
136SUBROUTINE put_var1(ncid,var,title,did,v,units)
137!
138!===============================================================================
139  IMPLICIT NONE
140!===============================================================================
141! Arguments:
142  INTEGER,                    INTENT(IN) :: ncid
143  CHARACTER(LEN=*),           INTENT(IN) :: var, title
144  INTEGER,                    INTENT(IN) :: did(1)
145  REAL,                       INTENT(IN) :: v(:)
146  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units
147!===============================================================================
148  IF(     PRESENT(units)) CALL cre_var(ncid,var,title,did,units)
149  IF(.NOT.PRESENT(units)) CALL cre_var(ncid,var,title,did)
150  CALL err(NF90_ENDDEF(ncid))
151  CALL err(NF90_PUT_VAR(ncid,nvarid,v),"put",var)
152  CALL err(NF90_REDEF(ncid))
153
154END SUBROUTINE put_var1
155!
156!===============================================================================
157
158
159!===============================================================================
160!
161SUBROUTINE put_var2(ncid,var,title,did,v,units)
162!
163!===============================================================================
164  IMPLICIT NONE
165!===============================================================================
166! Arguments:
167  INTEGER,                    INTENT(IN) :: ncid
168  CHARACTER(LEN=*),           INTENT(IN) :: var, title
169  INTEGER,                    INTENT(IN) :: did(2)
170  REAL,                       INTENT(IN) :: v(:,:)
171  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units
172!===============================================================================
173  IF(     PRESENT(units)) CALL cre_var(ncid,var,title,did,units)
174  IF(.NOT.PRESENT(units)) CALL cre_var(ncid,var,title,did)
175  CALL err(NF90_ENDDEF(ncid))
176  CALL err(NF90_PUT_VAR(ncid,nvarid,v),"put",var)
177  CALL err(NF90_REDEF(ncid))
178
179END SUBROUTINE put_var2
180!
181!===============================================================================
182
183
184!===============================================================================
185!
186SUBROUTINE put_char1(ncid,var,title,did,v,units)
187!
188!===============================================================================
189  IMPLICIT NONE
190!===============================================================================
191! Arguments:
192  INTEGER,                    INTENT(IN) :: ncid
193  CHARACTER(LEN=*),           INTENT(IN) :: var, title
194  INTEGER,                    INTENT(IN) :: did(2)
195  CHARACTER(*),               INTENT(IN) :: v(:)
196  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units
197!===============================================================================
198  CALL err(NF90_DEF_VAR(ncid,var,NF90_CHAR,did,nvarid),"inq",var)
199  IF(title/="")      CALL err(NF90_PUT_ATT(ncid,nvarid,"title",title),var)
200  IF(PRESENT(units)) CALL err(NF90_PUT_ATT(ncid,nvarid,"units",units),var)
201  CALL err(NF90_ENDDEF(ncid))
202  CALL err(NF90_PUT_VAR(ncid,nvarid,v),"put",var)
203  CALL err(NF90_REDEF(ncid))
204
205END SUBROUTINE put_char1
206!
207!===============================================================================
208
209
210!===============================================================================
211!
212FUNCTION msg(typ,nam)
213!
214!===============================================================================
215  IMPLICIT NONE
216!===============================================================================
217! Arguments:
218  CHARACTER(LEN=256)                     :: msg    !--- STANDARDIZED MESSAGE
219  CHARACTER(LEN=*),           INTENT(IN) :: typ    !--- TYPE OF OPERATION
220  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: nam    !--- FIELD NAME
221!===============================================================================
222  SELECT CASE(typ)
223    CASE('open');  msg="Opening failed for <"//TRIM(fil)//">"
224    CASE('close'); msg="Closing failed for <"//TRIM(fil)//">"
225    CASE('get');   msg="Reading failed for <"//TRIM(nam)//">"
226    CASE('put');   msg="Writting failed for <"//TRIM(nam)//">"
227    CASE('inq');   msg="Missing field <"//TRIM(nam)//">"
228    CASE('fnd');   msg="Found field <"//TRIM(nam)//">"
229  END SELECT
230  msg=TRIM(msg)//" in file <"//TRIM(fil)//">"
231
232END FUNCTION msg
233!
234!===============================================================================
235
236
237!===============================================================================
238!
239SUBROUTINE err(ierr,typ,nam)
240!
241!===============================================================================
242  IMPLICIT NONE
243!===============================================================================
244! Arguments:
245  INTEGER,                    INTENT(IN) :: ierr   !--- NetCDF ERROR CODE
246  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: typ    !--- TYPE OF OPERATION
247  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: nam    !--- FIELD NAME
248!===============================================================================
249  IF(ierr==NF90_NoERR) RETURN
250  IF(.NOT.PRESENT(typ)) THEN
251    CALL ABORT_gcm(modname,NF90_STRERROR(ierr),ierr)
252  ELSE
253    CALL ABORT_gcm(modname,msg(typ,nam),ierr)
254  END IF
255
256END SUBROUTINE err
257!
258!===============================================================================
259
260
261!===============================================================================
262!
263FUNCTION int2fmtstr(i) RESULT(fmtstr)
264!
265!===============================================================================
266! Conversion of an integer (0 < i < 100) to the formatted string needed for the
267! desccription of the 'controle' array
268!===============================================================================
269! Arguments:
270  integer, intent(in) :: i      !--- Input
271  character(4)        :: fmtstr !--- Output
272!===============================================================================
273  if (i < 1 .or. i > 99) call ABORT_gcm(modname,'Invalid integer given to int2fmtstr!',1)
274  write(fmtstr,'(i2)') i
275  if (len(trim(adjustl(fmtstr))) > 1) then
276    fmtstr = '('//trim(adjustl(fmtstr))//')'
277  else
278    fmtstr = '('//trim(adjustl(fmtstr))//') '
279  endif
280
281END FUNCTION int2fmtstr
282!
283!===============================================================================
284
285END MODULE dynredem_mod   
Note: See TracBrowser for help on using the repository browser.