source: LMDZ6/trunk/libf/dyn3d/dynredem_mod.F90 @ 5246

Last change on this file since 5246 was 5084, checked in by Laurent Fairhead, 11 months ago

Reverting to r4065. Updating fortran standard broke too much stuff. Will do it by smaller chunks
AB, LF
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, 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.