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

Last change on this file since 5258 was 5249, checked in by abarral, 5 weeks ago

Replace uses of cpp key NC_DOUBLE
File size: 7.9 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  USE lmdz_cppkeys_wrapper, ONLY: nf90_format
95  IMPLICIT NONE
96
97  INTEGER,                    INTENT(IN) :: ncid
98  CHARACTER(LEN=*),           INTENT(IN) :: var, title
99  INTEGER,                    INTENT(IN) :: did(:)
100  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units
101
102  CALL err(NF90_DEF_VAR(ncid,var,nf90_format,did,nvarid),"inq",var)
103  IF(title/="")      CALL err(NF90_PUT_ATT(ncid,nvarid,"title",title),var)
104  IF(PRESENT(units)) CALL err(NF90_PUT_ATT(ncid,nvarid,"units",units),var)
105END SUBROUTINE cre_var
106!
107!===============================================================================
108
109
110!===============================================================================
111!
112SUBROUTINE put_var1(ncid,var,title,did,v,units)
113!
114!===============================================================================
115  IMPLICIT NONE
116!===============================================================================
117! Arguments:
118  INTEGER,                    INTENT(IN) :: ncid
119  CHARACTER(LEN=*),           INTENT(IN) :: var, title
120  INTEGER,                    INTENT(IN) :: did(1)
121  REAL,                       INTENT(IN) :: v(:)
122  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units
123!===============================================================================
124  IF(     PRESENT(units)) CALL cre_var(ncid,var,title,did,units)
125  IF(.NOT.PRESENT(units)) CALL cre_var(ncid,var,title,did)
126  CALL err(NF90_ENDDEF(ncid))
127  CALL err(NF90_PUT_VAR(ncid,nvarid,v),"put",var)
128  CALL err(NF90_REDEF(ncid))
129
130END SUBROUTINE put_var1
131!
132!===============================================================================
133
134
135!===============================================================================
136!
137SUBROUTINE put_var2(ncid,var,title,did,v,units)
138!
139!===============================================================================
140  IMPLICIT NONE
141!===============================================================================
142! Arguments:
143  INTEGER,                    INTENT(IN) :: ncid
144  CHARACTER(LEN=*),           INTENT(IN) :: var, title
145  INTEGER,                    INTENT(IN) :: did(2)
146  REAL,                       INTENT(IN) :: v(:,:)
147  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units
148!===============================================================================
149  IF(     PRESENT(units)) CALL cre_var(ncid,var,title,did,units)
150  IF(.NOT.PRESENT(units)) CALL cre_var(ncid,var,title,did)
151  CALL err(NF90_ENDDEF(ncid))
152  CALL err(NF90_PUT_VAR(ncid,nvarid,v),"put",var)
153  CALL err(NF90_REDEF(ncid))
154
155END SUBROUTINE put_var2
156!
157!===============================================================================
158
159
160!===============================================================================
161!
162FUNCTION msg(typ,nam)
163!
164!===============================================================================
165  IMPLICIT NONE
166!===============================================================================
167! Arguments:
168  CHARACTER(LEN=256)                     :: msg    !--- STANDARDIZED MESSAGE
169  CHARACTER(LEN=*),           INTENT(IN) :: typ    !--- TYPE OF OPERATION
170  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: nam    !--- FIELD NAME
171!===============================================================================
172  SELECT CASE(typ)
173    CASE('open');  msg="Opening failed for <"//TRIM(fil)//">"
174    CASE('close'); msg="Closing failed for <"//TRIM(fil)//">"
175    CASE('get');   msg="Reading failed for <"//TRIM(nam)//">"
176    CASE('put');   msg="Writting failed for <"//TRIM(nam)//">"
177    CASE('inq');   msg="Missing field <"//TRIM(nam)//">"
178    CASE('fnd');   msg="Found field <"//TRIM(nam)//">"
179  END SELECT
180  msg=TRIM(msg)//" in file <"//TRIM(fil)//">"
181
182END FUNCTION msg
183!
184!===============================================================================
185
186
187!===============================================================================
188!
189SUBROUTINE err(ierr,typ,nam)
190!
191!===============================================================================
192  IMPLICIT NONE
193!===============================================================================
194! Arguments:
195  INTEGER,                    INTENT(IN) :: ierr   !--- NetCDF ERROR CODE
196  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: typ    !--- TYPE OF OPERATION
197  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: nam    !--- FIELD NAME
198!===============================================================================
199  IF(ierr==NF90_NoERR) RETURN
200  IF(.NOT.PRESENT(typ)) THEN
201    CALL ABORT_gcm(modname,NF90_STRERROR(ierr),ierr)
202  ELSE
203    CALL ABORT_gcm(modname,msg(typ,nam),ierr)
204  END IF
205
206END SUBROUTINE err
207!
208!===============================================================================
209
210END MODULE dynredem_mod   
211   
212   
Note: See TracBrowser for help on using the repository browser.