source: LMDZ6/trunk/libf/dyn3d/dynredem_mod.f90 @ 5299

Last change on this file since 5299 was 5285, checked in by abarral, 6 weeks ago

As discussed internally, remove generic ONLY: ... for new _mod_h modules
File size: 7.9 KB
Line 
1MODULE dynredem_mod
2  USE netcdf
3  USE dimensions_mod, ONLY: iim, jjm, llm, ndm
4  USE paramet_mod_h
5  PRIVATE
6  PUBLIC :: dynredem_write_u, dynredem_write_v, dynredem_read_u, err
7  PUBLIC :: cre_var, put_var1, put_var2, fil, modname, msg
8  CHARACTER(LEN=256), SAVE :: fil, modname
9  INTEGER,            SAVE :: nvarid
10
11
12CONTAINS
13
14
15!===============================================================================
16!
17SUBROUTINE dynredem_write_u(ncid,id,var,ll)
18!
19!===============================================================================
20  IMPLICIT NONE
21!===============================================================================
22! Arguments:
23  INTEGER,          INTENT(IN) :: ncid
24  CHARACTER(LEN=*), INTENT(IN) :: id
25  REAL,             INTENT(IN) :: var(iip1,jjp1,ll)
26  INTEGER,          INTENT(IN) :: ll
27!===============================================================================
28! Local variables:
29  INTEGER :: start(4), count(4)
30!===============================================================================
31  start(:)=[1,1,1,1]; count(:)=[iip1,jjp1,ll,1]
32  CALL err(NF90_INQ_VARID(ncid,id,nvarid),"inq",id)
33  CALL err(NF90_PUT_VAR(ncid,nvarid,var,start,count),"put",id)
34 
35END SUBROUTINE dynredem_write_u
36!
37!===============================================================================
38
39
40!===============================================================================
41!
42SUBROUTINE dynredem_write_v(ncid,id,var,ll)
43!
44!===============================================================================
45  IMPLICIT NONE
46!===============================================================================
47! Arguments:
48  INTEGER,          INTENT(IN) :: ncid
49  CHARACTER(LEN=*), INTENT(IN) :: id
50  REAL,             INTENT(IN) :: var(iip1,jjm,ll)
51  INTEGER,          INTENT(IN) :: ll
52!===============================================================================
53! Local variables:
54  INTEGER :: start(4), count(4)
55!===============================================================================
56  start(:)=[1,1,1,1]; count(:)=[iip1,jjm,ll,1]
57  CALL err(NF90_INQ_VARID(ncid,id,nvarid),"inq",id)
58  CALL err(NF90_PUT_VAR(ncid,nvarid,var,start,count),"put",id)
59 
60END SUBROUTINE dynredem_write_v
61!
62!===============================================================================
63
64
65!===============================================================================
66!
67SUBROUTINE dynredem_read_u(ncid,id,var,ll)
68!
69!===============================================================================
70  IMPLICIT NONE
71!===============================================================================
72! Arguments:
73  INTEGER,          INTENT(IN)  :: ncid
74  CHARACTER(LEN=*), INTENT(IN)  :: id
75  REAL,             INTENT(OUT) :: var(iip1,jjp1,ll)
76  INTEGER,          INTENT(IN)  :: ll
77!===============================================================================
78! Local variables:
79  INTEGER :: start(4), count(4)
80!===============================================================================
81  start(:)=[1,1,1,1]; count(:)=[iip1,jjp1,ll,1]
82  CALL err(NF90_INQ_VARID(ncid,id,nvarid),"inq",id)
83  CALL err(NF90_GET_VAR(ncid,nvarid,var,start,count),"get",id)
84 
85END SUBROUTINE dynredem_read_u   
86!
87!===============================================================================
88
89
90!===============================================================================
91!
92SUBROUTINE cre_var(ncid,var,title,did,units)
93  USE lmdz_cppkeys_wrapper, ONLY: nf90_format
94  IMPLICIT NONE
95
96  INTEGER,                    INTENT(IN) :: ncid
97  CHARACTER(LEN=*),           INTENT(IN) :: var, title
98  INTEGER,                    INTENT(IN) :: did(:)
99  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units
100
101  CALL err(NF90_DEF_VAR(ncid,var,nf90_format,did,nvarid),"inq",var)
102  IF(title/="")      CALL err(NF90_PUT_ATT(ncid,nvarid,"title",title),var)
103  IF(PRESENT(units)) CALL err(NF90_PUT_ATT(ncid,nvarid,"units",units),var)
104END SUBROUTINE cre_var
105!
106!===============================================================================
107
108
109!===============================================================================
110!
111SUBROUTINE put_var1(ncid,var,title,did,v,units)
112!
113!===============================================================================
114  IMPLICIT NONE
115!===============================================================================
116! Arguments:
117  INTEGER,                    INTENT(IN) :: ncid
118  CHARACTER(LEN=*),           INTENT(IN) :: var, title
119  INTEGER,                    INTENT(IN) :: did(1)
120  REAL,                       INTENT(IN) :: v(:)
121  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units
122!===============================================================================
123  IF(     PRESENT(units)) CALL cre_var(ncid,var,title,did,units)
124  IF(.NOT.PRESENT(units)) CALL cre_var(ncid,var,title,did)
125  CALL err(NF90_ENDDEF(ncid))
126  CALL err(NF90_PUT_VAR(ncid,nvarid,v),"put",var)
127  CALL err(NF90_REDEF(ncid))
128
129END SUBROUTINE put_var1
130!
131!===============================================================================
132
133
134!===============================================================================
135!
136SUBROUTINE put_var2(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(2)
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_var2
155!
156!===============================================================================
157
158
159!===============================================================================
160!
161FUNCTION msg(typ,nam)
162!
163!===============================================================================
164  IMPLICIT NONE
165!===============================================================================
166! Arguments:
167  CHARACTER(LEN=256)                     :: msg    !--- STANDARDIZED MESSAGE
168  CHARACTER(LEN=*),           INTENT(IN) :: typ    !--- TYPE OF OPERATION
169  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: nam    !--- FIELD NAME
170!===============================================================================
171  SELECT CASE(typ)
172    CASE('open');  msg="Opening failed for <"//TRIM(fil)//">"
173    CASE('close'); msg="Closing failed for <"//TRIM(fil)//">"
174    CASE('get');   msg="Reading failed for <"//TRIM(nam)//">"
175    CASE('put');   msg="Writting failed for <"//TRIM(nam)//">"
176    CASE('inq');   msg="Missing field <"//TRIM(nam)//">"
177    CASE('fnd');   msg="Found field <"//TRIM(nam)//">"
178  END SELECT
179  msg=TRIM(msg)//" in file <"//TRIM(fil)//">"
180
181END FUNCTION msg
182!
183!===============================================================================
184
185
186!===============================================================================
187!
188SUBROUTINE err(ierr,typ,nam)
189!
190!===============================================================================
191  IMPLICIT NONE
192!===============================================================================
193! Arguments:
194  INTEGER,                    INTENT(IN) :: ierr   !--- NetCDF ERROR CODE
195  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: typ    !--- TYPE OF OPERATION
196  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: nam    !--- FIELD NAME
197!===============================================================================
198  IF(ierr==NF90_NoERR) RETURN
199  IF(.NOT.PRESENT(typ)) THEN
200    CALL ABORT_gcm(modname,NF90_STRERROR(ierr),ierr)
201  ELSE
202    CALL ABORT_gcm(modname,msg(typ,nam),ierr)
203  END IF
204
205END SUBROUTINE err
206!
207!===============================================================================
208
209END MODULE dynredem_mod   
210   
211   
Note: See TracBrowser for help on using the repository browser.