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

Last change on this file since 5249 was 5249, checked in by abarral, 3 days ago

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