source: LMDZ6/branches/Amaury_dev/libf/dyn3d/dynredem_mod.F90 @ 5099

Last change on this file since 5099 was 5099, checked in by abarral, 3 months ago

Replace most uses of CPP_DUST by the corresponding logical defined in lmdz_cppkeys_wrapper.F90
Convert several files from .F to .f90 to allow Dust to compile w/o rrtm/ecrad
Create lmdz_yoerad.f90
(lint) Remove "!" on otherwise empty line
File size: 7.5 KB
Line 
1MODULE dynredem_mod
2
3  USE netcdf, ONLY: nf90_strerror,nf90_noerr,nf90_redef,nf90_put_var,nf90_enddef,nf90_put_att,&
4          nf90_inq_varid,nf90_get_var,nf90_def_var
5  USE lmdz_cppkeys_wrapper, ONLY: nf90_format
6  IMPLICIT NONE; PRIVATE
7  PUBLIC :: dynredem_write_u, dynredem_write_v, dynredem_read_u, err
8  PUBLIC :: cre_var, put_var1, put_var2, fil, modname, msg
9  include "dimensions.h"
10  include "paramet.h"
11  CHARACTER(LEN=256), SAVE :: fil, modname
12  INTEGER,            SAVE :: nvarid
13
14
15CONTAINS
16
17
18!===============================================================================
19
20SUBROUTINE dynredem_write_u(ncid,id,var,ll)
21
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! Arguments:
47  INTEGER,          INTENT(IN) :: ncid
48  CHARACTER(LEN=*), INTENT(IN) :: id
49  REAL,             INTENT(IN) :: var(iip1,jjm,ll)
50  INTEGER,          INTENT(IN) :: ll
51!===============================================================================
52! Local variables:
53  INTEGER :: start(4), count(4)
54!===============================================================================
55  start(:)=[1,1,1,1]; count(:)=[iip1,jjm,ll,1]
56  CALL err(NF90_INQ_VARID(ncid,id,nvarid),"inq",id)
57  CALL err(NF90_PUT_VAR(ncid,nvarid,var,start,count),"put",id)
58 
59END SUBROUTINE dynredem_write_v
60
61!===============================================================================
62
63
64!===============================================================================
65
66SUBROUTINE dynredem_read_u(ncid,id,var,ll)
67
68!===============================================================================
69! Arguments:
70  INTEGER,          INTENT(IN)  :: ncid
71  CHARACTER(LEN=*), INTENT(IN)  :: id
72  REAL,             INTENT(OUT) :: var(iip1,jjp1,ll)
73  INTEGER,          INTENT(IN)  :: ll
74!===============================================================================
75! Local variables:
76  INTEGER :: start(4), count(4)
77!===============================================================================
78  start(:)=[1,1,1,1]; count(:)=[iip1,jjp1,ll,1]
79  CALL err(NF90_INQ_VARID(ncid,id,nvarid),"inq",id)
80  CALL err(nf90_get_var(ncid,nvarid,var,start,count),"get",id)
81 
82END SUBROUTINE dynredem_read_u   
83
84!===============================================================================
85
86
87!===============================================================================
88
89SUBROUTINE cre_var(ncid,var,title,did,units)
90
91!===============================================================================
92! Arguments:
93  INTEGER,                    INTENT(IN) :: ncid
94  CHARACTER(LEN=*),           INTENT(IN) :: var, title
95  INTEGER,                    INTENT(IN) :: did(:)
96  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units
97!===============================================================================
98  CALL err(NF90_DEF_VAR(ncid,var,nf90_format,did,nvarid),"inq",var)
99  IF(title/="")      CALL err(NF90_PUT_ATT(ncid,nvarid,"title",title),var)
100  IF(PRESENT(units)) CALL err(NF90_PUT_ATT(ncid,nvarid,"units",units),var)
101
102END SUBROUTINE cre_var
103
104!===============================================================================
105
106
107!===============================================================================
108
109SUBROUTINE put_var1(ncid,var,title,did,v,units)
110
111!===============================================================================
112! Arguments:
113  INTEGER,                    INTENT(IN) :: ncid
114  CHARACTER(LEN=*),           INTENT(IN) :: var, title
115  INTEGER,                    INTENT(IN) :: did(1)
116  REAL,                       INTENT(IN) :: v(:)
117  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units
118!===============================================================================
119  IF(     PRESENT(units)) CALL cre_var(ncid,var,title,did,units)
120  IF(.NOT.PRESENT(units)) CALL cre_var(ncid,var,title,did)
121  CALL err(NF90_ENDDEF(ncid))
122  CALL err(NF90_PUT_VAR(ncid,nvarid,v),"put",var)
123  CALL err(NF90_REDEF(ncid))
124
125END SUBROUTINE put_var1
126
127!===============================================================================
128
129
130!===============================================================================
131
132SUBROUTINE put_var2(ncid,var,title,did,v,units)
133
134!===============================================================================
135! Arguments:
136  INTEGER,                    INTENT(IN) :: ncid
137  CHARACTER(LEN=*),           INTENT(IN) :: var, title
138  INTEGER,                    INTENT(IN) :: did(2)
139  REAL,                       INTENT(IN) :: v(:,:)
140  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units
141!===============================================================================
142  IF(     PRESENT(units)) CALL cre_var(ncid,var,title,did,units)
143  IF(.NOT.PRESENT(units)) CALL cre_var(ncid,var,title,did)
144  CALL err(NF90_ENDDEF(ncid))
145  CALL err(NF90_PUT_VAR(ncid,nvarid,v),"put",var)
146  CALL err(NF90_REDEF(ncid))
147
148END SUBROUTINE put_var2
149
150!===============================================================================
151
152
153!===============================================================================
154
155FUNCTION msg(typ,nam)
156
157!===============================================================================
158! Arguments:
159  CHARACTER(LEN=256)                     :: msg    !--- STANDARDIZED MESSAGE
160  CHARACTER(LEN=*),           INTENT(IN) :: typ    !--- TYPE OF OPERATION
161  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: nam    !--- FIELD NAME
162!===============================================================================
163  SELECT CASE(typ)
164    CASE('open');  msg="Opening failed for <"//TRIM(fil)//">"
165    CASE('close'); msg="Closing failed for <"//TRIM(fil)//">"
166    CASE('get');   msg="Reading failed for <"//TRIM(nam)//">"
167    CASE('put');   msg="Writting failed for <"//TRIM(nam)//">"
168    CASE('inq');   msg="Missing field <"//TRIM(nam)//">"
169    CASE('fnd');   msg="Found field <"//TRIM(nam)//">"
170  END SELECT
171  msg=TRIM(msg)//" in file <"//TRIM(fil)//">"
172
173END FUNCTION msg
174
175!===============================================================================
176
177
178!===============================================================================
179
180SUBROUTINE err(ierr,typ,nam)
181
182!===============================================================================
183! Arguments:
184  INTEGER,                    INTENT(IN) :: ierr   !--- NetCDF ERROR CODE
185  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: typ    !--- TYPE OF OPERATION
186  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: nam    !--- FIELD NAME
187!===============================================================================
188  IF(ierr==nf90_noerr) RETURN
189  IF(.NOT.PRESENT(typ)) THEN
190    CALL ABORT_gcm(modname,NF90_STRERROR(ierr),ierr)
191  ELSE
192    CALL ABORT_gcm(modname,msg(typ,nam),ierr)
193  END IF
194
195END SUBROUTINE err
196
197!===============================================================================
198
199END MODULE dynredem_mod   
200   
201   
Note: See TracBrowser for help on using the repository browser.