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

Last change on this file since 1549 was 1508, checked in by emillour, 10 years ago

Common dynamics:
Updates in the dynamics (seq and ) to keep up with updates
in LMDZ5 (up to LMDZ5 trunk, rev 2325):
IMPORTANT: Modifications for isotopes are only done in dyn3d, not in dyn3dpar

as in LMDZ5 these modifications were done in dyn3dmem.
Related LMDZ5 revisions are r2270 and r2281

  • in dynlonlat_phylonlat:
  • add module "grid_atob_m.F90" (a regridding utility so far only used by phylmd/ce0l.F90, used to be dyn3d_common/grid_atob.F)
  • in misc:
  • follow up updates on wxios.F (add missing_val module variable)
  • in dyn3d_common:
  • pression.F => pression.F90
  • misc_mod.F90: moved from misc to dyn3d_common
  • added new iso_verif_dyn.F
  • covcont.F => covcont.F90
  • infotrac.F90 : add handling of isotopes (reading of corresponding traceur.def for planets not implemented)
  • dynetat0.F => dynetat0.F90 with some code factorization
  • dynredem.F => dynredem.F90 with some code factorization
  • added dynredem_mod.F90: routines used by dynredem
  • iniacademic.F90 : added isotopes-related initialization for Earth case
  • in dyn3d:
  • added check_isotopes.F
  • modified (isotopes) advtrac.F90, caladvtrac.F
  • guide_mod.F90: ported updates
  • leapfrog.F : (isotopes) updates (NB: call integrd with nqtot tracers)
  • qminimium.F : adaptations for isotopes (copied over, except that #include comvert.h is not needed).
  • vlsplt.F: adaptations for isotopes (copied over, except than #include logic.h, comvert.h not needed, and replace "include comconst.h" with use comconst_mod, ONLY: pi)
  • vlspltqs.F : same as vlsplt.F, but also keeping added modification for CP(T)
  • in dyn3dpar:
  • leapfrog_p.F: remove unecessary #ifdef CPP_EARTH cpp flag. and call integrd_p with nqtot tracers (only important for Earth)
  • dynredem_p.F => dynredem_p.F90 and some code factorization
  • and no isotopes-relates changes in dyn3dpar (since these changes have been made in LMDZ5 dyn3dmem).

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