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

Last change on this file since 3000 was 1824, checked in by emillour, 7 years ago

Common dynamics:

  • enable possiblity to store multiple time steps in the restart.nc file (flag "ecritstart" gives the frequency, in dynamical steps).
  • fixed dynredem_mod.F90 to correctly write multiple time steps.
  • fixed computation of JH_cur in the mars case where "hour_ini" contains the initial time of day read from the start.nc file
  • minor fix in dynetat0.F90

RY
File size: 8.6 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
7  PRIVATE
8  PUBLIC :: dynredem_write_u, dynredem_write_v, dynredem_read_u, err
9  PUBLIC :: cre_var, get_var1, put_var1, put_var2, 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!
186FUNCTION msg(typ,nam)
187!
188!===============================================================================
189  IMPLICIT NONE
190!===============================================================================
191! Arguments:
192  CHARACTER(LEN=256)                     :: msg    !--- STANDARDIZED MESSAGE
193  CHARACTER(LEN=*),           INTENT(IN) :: typ    !--- TYPE OF OPERATION
194  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: nam    !--- FIELD NAME
195!===============================================================================
196  SELECT CASE(typ)
197    CASE('open');  msg="Opening failed for <"//TRIM(fil)//">"
198    CASE('close'); msg="Closing failed for <"//TRIM(fil)//">"
199    CASE('get');   msg="Reading failed for <"//TRIM(nam)//">"
200    CASE('put');   msg="Writting failed for <"//TRIM(nam)//">"
201    CASE('inq');   msg="Missing field <"//TRIM(nam)//">"
202    CASE('fnd');   msg="Found field <"//TRIM(nam)//">"
203  END SELECT
204  msg=TRIM(msg)//" in file <"//TRIM(fil)//">"
205
206END FUNCTION msg
207!
208!===============================================================================
209
210
211!===============================================================================
212!
213SUBROUTINE err(ierr,typ,nam)
214!
215!===============================================================================
216  IMPLICIT NONE
217!===============================================================================
218! Arguments:
219  INTEGER,                    INTENT(IN) :: ierr   !--- NetCDF ERROR CODE
220  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: typ    !--- TYPE OF OPERATION
221  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: nam    !--- FIELD NAME
222!===============================================================================
223  IF(ierr==NF90_NoERR) RETURN
224  IF(.NOT.PRESENT(typ)) THEN
225    CALL ABORT_gcm(modname,NF90_STRERROR(ierr),ierr)
226  ELSE
227    CALL ABORT_gcm(modname,msg(typ,nam),ierr)
228  END IF
229
230END SUBROUTINE err
231!
232!===============================================================================
233
234END MODULE dynredem_mod   
Note: See TracBrowser for help on using the repository browser.