source: LMDZ6/trunk/libf/dyn3dmem/dynredem_mod.f90 @ 5420

Last change on this file since 5420 was 5285, checked in by abarral, 8 weeks ago

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