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

Last change on this file since 5099 was 5099, checked in by abarral, 4 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
RevLine 
[2299]1MODULE dynredem_mod
2
[5088]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
[5090]5  USE lmdz_cppkeys_wrapper, ONLY: nf90_format
[5069]6  IMPLICIT NONE; PRIVATE
[2299]7  PUBLIC :: dynredem_write_u, dynredem_write_v, dynredem_read_u, err
[5060]8  PUBLIC :: cre_var, put_var1, put_var2, fil, modname, msg
[2299]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!===============================================================================
[5099]19
[2299]20SUBROUTINE dynredem_write_u(ncid,id,var,ll)
[5099]21
[2299]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
[5099]37
[2299]38!===============================================================================
39
40
41!===============================================================================
[5099]42
[2299]43SUBROUTINE dynredem_write_v(ncid,id,var,ll)
[5099]44
[2299]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
[5099]60
[2299]61!===============================================================================
62
63
64!===============================================================================
[5099]65
[2299]66SUBROUTINE dynredem_read_u(ncid,id,var,ll)
[5099]67
[2299]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)
[5099]80  CALL err(nf90_get_var(ncid,nvarid,var,start,count),"get",id)
[2299]81 
82END SUBROUTINE dynredem_read_u   
[5099]83
[2299]84!===============================================================================
85
86
87!===============================================================================
[5099]88
[2299]89SUBROUTINE cre_var(ncid,var,title,did,units)
[5099]90
[2299]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!===============================================================================
[5088]98  CALL err(NF90_DEF_VAR(ncid,var,nf90_format,did,nvarid),"inq",var)
[2299]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
[5099]103
[2299]104!===============================================================================
105
106
107!===============================================================================
[5099]108
[2299]109SUBROUTINE put_var1(ncid,var,title,did,v,units)
[5099]110
[2299]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
[5099]126
[2299]127!===============================================================================
128
129
130!===============================================================================
[5099]131
[2299]132SUBROUTINE put_var2(ncid,var,title,did,v,units)
[5099]133
[2299]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
[5099]149
[2299]150!===============================================================================
151
152
153!===============================================================================
[5099]154
[2299]155FUNCTION msg(typ,nam)
[5099]156
[2299]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
[5099]174
[2299]175!===============================================================================
176
177
178!===============================================================================
[5099]179
[2299]180SUBROUTINE err(ierr,typ,nam)
[5099]181
[2299]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!===============================================================================
[5099]188  IF(ierr==nf90_noerr) RETURN
[2299]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
[5099]196
[2299]197!===============================================================================
198
199END MODULE dynredem_mod   
200   
201   
Note: See TracBrowser for help on using the repository browser.