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

Last change on this file since 5073 was 5069, checked in by abarral, 5 months ago

Reduce use of #ifdef NC_DOUBLE to single instance in lmdz_netcdf.F90
Add nf_get_vara_rd in lmdz_netcdf.F90
Remove #ifdef NC_DOUBLE in dynredem_mod.F90 & guide_loc_mod.F90
(minor) fix some casting in ncdf calls in guide_loc_mod.F90
(minor) replace netcdf call & reduncate implicit none in dynredem_mod.F90
File size: 7.3 KB
Line 
1MODULE dynredem_mod
2
3  USE lmdz_netcdf
4  IMPLICIT NONE; 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! Arguments:
22  INTEGER,          INTENT(IN) :: ncid
23  CHARACTER(LEN=*), INTENT(IN) :: id
24  REAL,             INTENT(IN) :: var(iip1,jjp1,ll)
25  INTEGER,          INTENT(IN) :: ll
26!===============================================================================
27! Local variables:
28  INTEGER :: start(4), count(4)
29!===============================================================================
30  start(:)=[1,1,1,1]; count(:)=[iip1,jjp1,ll,1]
31  CALL err(NF90_INQ_VARID(ncid,id,nvarid),"inq",id)
32  CALL err(NF90_PUT_VAR(ncid,nvarid,var,start,count),"put",id)
33 
34END SUBROUTINE dynredem_write_u
35!
36!===============================================================================
37
38
39!===============================================================================
40!
41SUBROUTINE dynredem_write_v(ncid,id,var,ll)
42!
43!===============================================================================
44! Arguments:
45  INTEGER,          INTENT(IN) :: ncid
46  CHARACTER(LEN=*), INTENT(IN) :: id
47  REAL,             INTENT(IN) :: var(iip1,jjm,ll)
48  INTEGER,          INTENT(IN) :: ll
49!===============================================================================
50! Local variables:
51  INTEGER :: start(4), count(4)
52!===============================================================================
53  start(:)=[1,1,1,1]; count(:)=[iip1,jjm,ll,1]
54  CALL err(NF90_INQ_VARID(ncid,id,nvarid),"inq",id)
55  CALL err(NF90_PUT_VAR(ncid,nvarid,var,start,count),"put",id)
56 
57END SUBROUTINE dynredem_write_v
58!
59!===============================================================================
60
61
62!===============================================================================
63!
64SUBROUTINE dynredem_read_u(ncid,id,var,ll)
65!
66!===============================================================================
67! Arguments:
68  INTEGER,          INTENT(IN)  :: ncid
69  CHARACTER(LEN=*), INTENT(IN)  :: id
70  REAL,             INTENT(OUT) :: var(iip1,jjp1,ll)
71  INTEGER,          INTENT(IN)  :: ll
72!===============================================================================
73! Local variables:
74  INTEGER :: start(4), count(4)
75!===============================================================================
76  start(:)=[1,1,1,1]; count(:)=[iip1,jjp1,ll,1]
77  CALL err(NF90_INQ_VARID(ncid,id,nvarid),"inq",id)
78  CALL err(NF90_GET_VAR(ncid,nvarid,var,start,count),"get",id)
79 
80END SUBROUTINE dynredem_read_u   
81!
82!===============================================================================
83
84
85!===============================================================================
86!
87SUBROUTINE cre_var(ncid,var,title,did,units)
88!
89!===============================================================================
90! Arguments:
91  INTEGER,                    INTENT(IN) :: ncid
92  CHARACTER(LEN=*),           INTENT(IN) :: var, title
93  INTEGER,                    INTENT(IN) :: did(:)
94  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units
95!===============================================================================
96  CALL err(NF90_DEF_VAR(ncid,var,NF90_FORMAT,did,nvarid),"inq",var)
97  IF(title/="")      CALL err(NF90_PUT_ATT(ncid,nvarid,"title",title),var)
98  IF(PRESENT(units)) CALL err(NF90_PUT_ATT(ncid,nvarid,"units",units),var)
99
100END SUBROUTINE cre_var
101!
102!===============================================================================
103
104
105!===============================================================================
106!
107SUBROUTINE put_var1(ncid,var,title,did,v,units)
108!
109!===============================================================================
110! Arguments:
111  INTEGER,                    INTENT(IN) :: ncid
112  CHARACTER(LEN=*),           INTENT(IN) :: var, title
113  INTEGER,                    INTENT(IN) :: did(1)
114  REAL,                       INTENT(IN) :: v(:)
115  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units
116!===============================================================================
117  IF(     PRESENT(units)) CALL cre_var(ncid,var,title,did,units)
118  IF(.NOT.PRESENT(units)) CALL cre_var(ncid,var,title,did)
119  CALL err(NF90_ENDDEF(ncid))
120  CALL err(NF90_PUT_VAR(ncid,nvarid,v),"put",var)
121  CALL err(NF90_REDEF(ncid))
122
123END SUBROUTINE put_var1
124!
125!===============================================================================
126
127
128!===============================================================================
129!
130SUBROUTINE put_var2(ncid,var,title,did,v,units)
131!
132!===============================================================================
133! Arguments:
134  INTEGER,                    INTENT(IN) :: ncid
135  CHARACTER(LEN=*),           INTENT(IN) :: var, title
136  INTEGER,                    INTENT(IN) :: did(2)
137  REAL,                       INTENT(IN) :: v(:,:)
138  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units
139!===============================================================================
140  IF(     PRESENT(units)) CALL cre_var(ncid,var,title,did,units)
141  IF(.NOT.PRESENT(units)) CALL cre_var(ncid,var,title,did)
142  CALL err(NF90_ENDDEF(ncid))
143  CALL err(NF90_PUT_VAR(ncid,nvarid,v),"put",var)
144  CALL err(NF90_REDEF(ncid))
145
146END SUBROUTINE put_var2
147!
148!===============================================================================
149
150
151!===============================================================================
152!
153FUNCTION msg(typ,nam)
154!
155!===============================================================================
156! Arguments:
157  CHARACTER(LEN=256)                     :: msg    !--- STANDARDIZED MESSAGE
158  CHARACTER(LEN=*),           INTENT(IN) :: typ    !--- TYPE OF OPERATION
159  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: nam    !--- FIELD NAME
160!===============================================================================
161  SELECT CASE(typ)
162    CASE('open');  msg="Opening failed for <"//TRIM(fil)//">"
163    CASE('close'); msg="Closing failed for <"//TRIM(fil)//">"
164    CASE('get');   msg="Reading failed for <"//TRIM(nam)//">"
165    CASE('put');   msg="Writting failed for <"//TRIM(nam)//">"
166    CASE('inq');   msg="Missing field <"//TRIM(nam)//">"
167    CASE('fnd');   msg="Found field <"//TRIM(nam)//">"
168  END SELECT
169  msg=TRIM(msg)//" in file <"//TRIM(fil)//">"
170
171END FUNCTION msg
172!
173!===============================================================================
174
175
176!===============================================================================
177!
178SUBROUTINE err(ierr,typ,nam)
179!
180!===============================================================================
181! Arguments:
182  INTEGER,                    INTENT(IN) :: ierr   !--- NetCDF ERROR CODE
183  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: typ    !--- TYPE OF OPERATION
184  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: nam    !--- FIELD NAME
185!===============================================================================
186  IF(ierr==NF90_NoERR) RETURN
187  IF(.NOT.PRESENT(typ)) THEN
188    CALL ABORT_gcm(modname,NF90_STRERROR(ierr),ierr)
189  ELSE
190    CALL ABORT_gcm(modname,msg(typ,nam),ierr)
191  END IF
192
193END SUBROUTINE err
194!
195!===============================================================================
196
197END MODULE dynredem_mod   
198   
199   
Note: See TracBrowser for help on using the repository browser.