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

Last change on this file since 5445 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
Line 
1MODULE dynredem_mod
2  USE dimensions_mod, ONLY: iim, jjm, llm, ndm
3  USE paramet_mod_h
4  USE parallel_lmdz
5  USE mod_hallo
6  USE netcdf
7  PRIVATE
8  PUBLIC :: dynredem_write_u, dynredem_write_v, dynredem_read_u, err
9  PUBLIC :: cre_var, put_var, fil, modname, msg
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!===============================================================================
21  IMPLICIT NONE
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)
37!$OMP END MASTER
38
39!$OMP MASTER
40  ALLOCATE(var_tmp(ijb_u:ije_u,ll),var_glo(ip1jmp1))
41!$OMP END MASTER
42!$OMP BARRIER
43
44!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
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
60
61END SUBROUTINE dynredem_write_u
62!
63!===============================================================================
64
65
66!===============================================================================
67!
68SUBROUTINE dynredem_write_v(ncid,id,var,ll)
69!
70!===============================================================================
71  IMPLICIT NONE
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)
87!$OMP END MASTER
88
89!$OMP MASTER
90  ALLOCATE(var_tmp(ijb_v:ije_v,ll),var_glo(ip1jm))
91!$OMP END MASTER
92!$OMP BARRIER
93
94!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
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
110
111END SUBROUTINE dynredem_write_v
112!
113!===============================================================================
114
115
116!===============================================================================
117!
118SUBROUTINE dynredem_read_u(ncid,id,var,ll)
119!
120!===============================================================================
121  IMPLICIT NONE
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)
137!$OMP END MASTER
138
139!$OMP MASTER
140  ALLOCATE(var_tmp(ijb_u:ije_u,ll),var_glo(ip1jmp1))
141!$OMP END MASTER
142!$OMP BARRIER
143
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
153
154!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
155  DO l=1,ll; var(:,l)=var_tmp(:,l); END DO
156
157!$OMP BARRIER
158!$OMP MASTER
159  DEALLOCATE(var_glo,var_tmp)
160!$OMP END MASTER
161!$OMP BARRIER
162
163END SUBROUTINE dynredem_read_u
164!
165!===============================================================================
166
167
168!===============================================================================
169!
170SUBROUTINE cre_var(ncid,var,title,did,units)
171  USE lmdz_cppkeys_wrapper, ONLY: nf90_format
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!===============================================================================
180  CALL err(NF90_DEF_VAR(ncid,var,nf90_format ,did,nvarid),"inq",var)
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)
183
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
267END MODULE dynredem_mod
268
269
270
Note: See TracBrowser for help on using the repository browser.