source: LMDZ6/trunk/libf/dyn3dmem/dynredem_mod.F90 @ 5079

Last change on this file since 5079 was 5075, checked in by abarral, 5 months ago

[continued & end] replace netcdf by lmdz_netcdf.F90 wrapper
"use netcdf" is now only used in lmdz_netcdf.F90 (except ecrad and obsolete/)
<include "netcdf.inc"> is now likewise only used in lmdz_netcdf.F90.

systematically specify explicitely <USE lmdz_netcdf, ONLY:> (probably left some missing, to correct later on)

Further replacement of nf_put_* by nf90_put_* (same for _get_)

[minor] replace deprecated boolean operators along the way
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
File size: 9.1 KB
RevLine 
[1632]1MODULE dynredem_mod
2
[1810]3  USE dimensions_mod
[1823]4  USE parallel_lmdz
[1632]5  USE mod_hallo
[5075]6  USE lmdz_netcdf, ONLY:nf90_strerror,nf90_noerr,nf90_redef,nf90_put_var,nf90_inquire_dimension,&
7          nf90_format,nf90_inq_varid,nf90_get_var,nf90_def_var,nf90_enddef,nf90_put_att
[2299]8  PRIVATE
9  PUBLIC :: dynredem_write_u, dynredem_write_v, dynredem_read_u, err
[5060]10  PUBLIC :: cre_var, put_var, fil, modname, msg
[2299]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!===============================================================================
[1632]23  IMPLICIT NONE
[2299]24!===============================================================================
25! Arguments:
26  INTEGER,          INTENT(IN) :: ncid
27  CHARACTER(LEN=*), INTENT(IN) :: id
28  REAL,             INTENT(IN) :: var(ijb_u:ije_u,ll)
29  INTEGER,          INTENT(IN) :: ll
30!===============================================================================
31! Local variables:
32  REAL, ALLOCATABLE, SAVE :: var_tmp(:,:), var_glo(:)
33  INTEGER :: start(4), count(4), l, ierr
34!===============================================================================
35  start(:)=[1,1,1,1]; count(:)=[iip1,jjp1,1,1]
36
37!$OMP MASTER
38  IF(mpi_rank==0) CALL err(NF90_INQ_VARID(ncid,id,nvarid),"inq",id)
[1632]39!$OMP END MASTER
40
41!$OMP MASTER
[2299]42  ALLOCATE(var_tmp(ijb_u:ije_u,ll),var_glo(ip1jmp1))
[1632]43!$OMP END MASTER
44!$OMP BARRIER
45
46!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
[2299]47  DO l=1,ll; var_tmp(:,l)=var(:,l); END DO
48  DO l=1,ll
49    CALL gather_field_u(var_tmp(:,l),var_glo,1)
50    IF(mpi_rank==0) THEN
51    !$OMP MASTER
52      start(3)=l
53      CALL err(NF90_PUT_VAR(ncid,nvarid,var_glo,start,count),"put",id)
54    !$OMP END MASTER
55    END IF
56  END DO
57!$OMP BARRIER
58!$OMP MASTER
59  DEALLOCATE(var_glo,var_tmp)
60!$OMP END MASTER
61!$OMP BARRIER
62 
63END SUBROUTINE dynredem_write_u
64!
65!===============================================================================
[1632]66
[2299]67
68!===============================================================================
69!
70SUBROUTINE dynredem_write_v(ncid,id,var,ll)
71!
72!===============================================================================
[1632]73  IMPLICIT NONE
[2299]74!===============================================================================
75! Arguments:
76  INTEGER,          INTENT(IN) :: ncid
77  CHARACTER(LEN=*), INTENT(IN) :: id
78  REAL,             INTENT(IN) :: var(ijb_v:ije_v,ll)
79  INTEGER,          INTENT(IN) :: ll
80!===============================================================================
81! Local variables:
82  REAL, ALLOCATABLE, SAVE :: var_tmp(:,:), var_glo(:)
83  INTEGER :: start(4), count(4), l, ierr
84!===============================================================================
85  start(:)=[1,1,1,1]; count(:)=[iip1,jjm,1,1]
86
87!$OMP MASTER
88  IF(mpi_rank==0) CALL err(NF90_INQ_VARID(ncid,id,nvarid),"inq",id)
[1632]89!$OMP END MASTER
[2299]90
[1632]91!$OMP MASTER
[2299]92  ALLOCATE(var_tmp(ijb_v:ije_v,ll),var_glo(ip1jm))
[1632]93!$OMP END MASTER
94!$OMP BARRIER
95
96!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
[2299]97  DO l=1,ll; var_tmp(:,l)=var(:,l); END DO
98  DO l=1,ll
99    CALL gather_field_v(var_tmp(:,l),var_glo,1)
100    IF(mpi_rank==0) THEN
101    !$OMP MASTER
102      start(3)=l
103      CALL err(NF90_PUT_VAR(ncid,nvarid,var_glo,start,count),"put",id)
104    !$OMP END MASTER
105    END IF
106  END DO
107!$OMP BARRIER
108!$OMP MASTER
109  DEALLOCATE(var_glo,var_tmp)
110!$OMP END MASTER
111!$OMP BARRIER
[1632]112 
[2299]113END SUBROUTINE dynredem_write_v
114!
115!===============================================================================
[1632]116
[2299]117
118!===============================================================================
119!
120SUBROUTINE dynredem_read_u(ncid,id,var,ll)
121!
122!===============================================================================
[1632]123  IMPLICIT NONE
[2299]124!===============================================================================
125! Arguments:
126  INTEGER,          INTENT(IN)  :: ncid
127  CHARACTER(LEN=*), INTENT(IN)  :: id
128  REAL,             INTENT(OUT) :: var(ijb_u:ije_u,ll)
129  INTEGER,          INTENT(IN)  :: ll
130!===============================================================================
131! Local variables:
132  REAL, ALLOCATABLE, SAVE :: var_tmp(:,:), var_glo(:)
133  INTEGER :: start(4), count(4), l, ierr
134!===============================================================================
135  start(:)=[1,1,1,1]; count(:)=[iip1,jjp1,1,1]
136
137!$OMP MASTER
138  IF(mpi_rank==0) CALL err(NF90_INQ_VARID(ncid,id,nvarid),'inq',id)
[1632]139!$OMP END MASTER
[2299]140
[1632]141!$OMP MASTER
[2299]142  ALLOCATE(var_tmp(ijb_u:ije_u,ll),var_glo(ip1jmp1))
[1632]143!$OMP END MASTER
144!$OMP BARRIER
145
[2299]146  DO l=1,ll
147    IF(mpi_rank==0) THEN
148    !$OMP MASTER
149      start(3)=l
150      CALL err(NF90_GET_VAR(ncid,nvarid,var_glo,start,count),"get",id)
151    !$OMP END MASTER
152    END IF
153    CALL scatter_field_u(var_glo,var_tmp(:,l),1)
154  END DO
[1632]155
[2299]156!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
157  DO l=1,ll; var(:,l)=var_tmp(:,l); END DO
158   
159!$OMP BARRIER
160!$OMP MASTER
161  DEALLOCATE(var_glo,var_tmp)
162!$OMP END MASTER
163!$OMP BARRIER
164 
165END SUBROUTINE dynredem_read_u   
166!
167!===============================================================================
168
169
170!===============================================================================
171!
172SUBROUTINE cre_var(ncid,var,title,did,units)
173!
174!===============================================================================
175  IMPLICIT NONE
176!===============================================================================
177! Arguments:
178  INTEGER,                    INTENT(IN) :: ncid
179  CHARACTER(LEN=*),           INTENT(IN) :: var, title
180  INTEGER,                    INTENT(IN) :: did(:)
181  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units
182!===============================================================================
[5069]183  CALL err(NF90_DEF_VAR(ncid,var,NF90_FORMAT,did,nvarid),"inq",var)
[2299]184  IF(title/="")      CALL err(NF90_PUT_ATT(ncid,nvarid,"title",title),var)
185  IF(PRESENT(units)) CALL err(NF90_PUT_ATT(ncid,nvarid,"units",units),var)
[1632]186
[2299]187END SUBROUTINE cre_var
188!
189!===============================================================================
190
191
192!===============================================================================
193!
194SUBROUTINE put_var(ncid,var,title,did,v,units)
195!
196!===============================================================================
197  IMPLICIT NONE
198!===============================================================================
199! Arguments:
200  INTEGER,                    INTENT(IN) :: ncid
201  CHARACTER(LEN=*),           INTENT(IN) :: var, title
202  INTEGER,                    INTENT(IN) :: did(:)
203  REAL,                       INTENT(IN) :: v(:)
204  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units
205!===============================================================================
206  INTEGER :: nd, k, nn(2)
207  IF(     PRESENT(units)) CALL cre_var(ncid,var,title,did,units)
208  IF(.NOT.PRESENT(units)) CALL cre_var(ncid,var,title,did)
209  CALL err(NF90_ENDDEF(ncid))
210  nd=SIZE(did)
211  DO k=1,nd; CALL err(NF90_INQUIRE_DIMENSION(ncid,did(k),len=nn(k))); END DO
212  IF(nd==1) CALL err(NF90_PUT_VAR(ncid,nvarid,RESHAPE(v,nn(1:1))),var)
213  IF(nd==2) CALL err(NF90_PUT_VAR(ncid,nvarid,RESHAPE(v,nn(1:2))),var)
214  CALL err(NF90_REDEF(ncid))
215END SUBROUTINE put_var
216!
217!===============================================================================
218
219
220!===============================================================================
221!
222FUNCTION msg(typ,nam)
223!
224!===============================================================================
225  IMPLICIT NONE
226!===============================================================================
227! Arguments:
228  CHARACTER(LEN=256)                     :: msg    !--- STANDARDIZED MESSAGE
229  CHARACTER(LEN=*),           INTENT(IN) :: typ    !--- TYPE OF OPERATION
230  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: nam    !--- FIELD NAME
231!===============================================================================
232  SELECT CASE(typ)
233    CASE('open');  msg="Opening failed for <"//TRIM(fil)//">"
234    CASE('close'); msg="Closing failed for <"//TRIM(fil)//">"
235    CASE('get');   msg="Reading failed for <"//TRIM(nam)//">"
236    CASE('put');   msg="Writting failed for <"//TRIM(nam)//">"
237    CASE('inq');   msg="Missing field <"//TRIM(nam)//">"
238    CASE('fnd');   msg="Found field <"//TRIM(nam)//">"
239  END SELECT
240  msg=TRIM(msg)//" in file <"//TRIM(fil)//">"
241
242END FUNCTION msg
243!
244!===============================================================================
245
246
247!===============================================================================
248!
249SUBROUTINE err(ierr,typ,nam)
250!
251!===============================================================================
252  IMPLICIT NONE
253!===============================================================================
254! Arguments:
255  INTEGER,                    INTENT(IN) :: ierr   !--- NetCDF ERROR CODE
256  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: typ    !--- TYPE OF OPERATION
257  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: nam    !--- FIELD NAME
258!===============================================================================
259  IF(ierr==NF90_NoERR) RETURN
260  IF(.NOT.PRESENT(typ)) THEN
261    CALL ABORT_gcm(modname,NF90_STRERROR(ierr),ierr)
262  ELSE
263    CALL ABORT_gcm(modname,msg(typ,nam),ierr)
264  END IF
265
266END SUBROUTINE err
267!
268!===============================================================================
269
[1632]270END MODULE dynredem_mod   
[2299]271
[1632]272   
273   
Note: See TracBrowser for help on using the repository browser.