source: LMDZ5/branches/testing/libf/dyn3dmem/dynredem_mod.F90 @ 5165

Last change on this file since 5165 was 2408, checked in by Laurent Fairhead, 9 years ago

Merged trunk changes r2298:2396 into testing branch
  • 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.0 KB
RevLine 
[1632]1MODULE dynredem_mod
2
[1864]3  USE dimensions_mod
4  USE parallel_lmdz
[1632]5  USE mod_hallo
[2408]6  USE netcdf
7  PRIVATE
8  PUBLIC :: dynredem_write_u, dynredem_write_v, dynredem_read_u, err
9  PUBLIC :: cre_var, get_var1, 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!===============================================================================
[1632]22  IMPLICIT NONE
[2408]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)
[1632]38!$OMP END MASTER
39
40!$OMP MASTER
[2408]41  ALLOCATE(var_tmp(ijb_u:ije_u,ll),var_glo(ip1jmp1))
[1632]42!$OMP END MASTER
43!$OMP BARRIER
44
45!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
[2408]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!===============================================================================
[1632]65
[2408]66
67!===============================================================================
68!
69SUBROUTINE dynredem_write_v(ncid,id,var,ll)
70!
71!===============================================================================
[1632]72  IMPLICIT NONE
[2408]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)
[1632]88!$OMP END MASTER
[2408]89
[1632]90!$OMP MASTER
[2408]91  ALLOCATE(var_tmp(ijb_v:ije_v,ll),var_glo(ip1jm))
[1632]92!$OMP END MASTER
93!$OMP BARRIER
94
95!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
[2408]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
[1632]111 
[2408]112END SUBROUTINE dynredem_write_v
113!
114!===============================================================================
[1632]115
[2408]116
117!===============================================================================
118!
119SUBROUTINE dynredem_read_u(ncid,id,var,ll)
120!
121!===============================================================================
[1632]122  IMPLICIT NONE
[2408]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)
[1632]138!$OMP END MASTER
[2408]139
[1632]140!$OMP MASTER
[2408]141  ALLOCATE(var_tmp(ijb_u:ije_u,ll),var_glo(ip1jmp1))
[1632]142!$OMP END MASTER
143!$OMP BARRIER
144
[2408]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
[1632]154
[2408]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!
173!===============================================================================
174  IMPLICIT NONE
175!===============================================================================
176! Arguments:
177  INTEGER,                    INTENT(IN) :: ncid
178  CHARACTER(LEN=*),           INTENT(IN) :: var, title
179  INTEGER,                    INTENT(IN) :: did(:)
180  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units
181!===============================================================================
[1632]182#ifdef NC_DOUBLE
[2408]183  CALL err(NF90_DEF_VAR(ncid,var,NF90_DOUBLE,did,nvarid),"inq",var)
[1632]184#else
[2408]185  CALL err(NF90_DEF_VAR(ncid,var,NF90_FLOAT ,did,nvarid),"inq",var)
[1632]186#endif
[2408]187  IF(title/="")      CALL err(NF90_PUT_ATT(ncid,nvarid,"title",title),var)
188  IF(PRESENT(units)) CALL err(NF90_PUT_ATT(ncid,nvarid,"units",units),var)
[1632]189
[2408]190END SUBROUTINE cre_var
191!
192!===============================================================================
193
194
195!===============================================================================
196!
197SUBROUTINE put_var(ncid,var,title,did,v,units)
198!
199!===============================================================================
200  IMPLICIT NONE
201!===============================================================================
202! Arguments:
203  INTEGER,                    INTENT(IN) :: ncid
204  CHARACTER(LEN=*),           INTENT(IN) :: var, title
205  INTEGER,                    INTENT(IN) :: did(:)
206  REAL,                       INTENT(IN) :: v(:)
207  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: units
208!===============================================================================
209  INTEGER :: nd, k, nn(2)
210  IF(     PRESENT(units)) CALL cre_var(ncid,var,title,did,units)
211  IF(.NOT.PRESENT(units)) CALL cre_var(ncid,var,title,did)
212  CALL err(NF90_ENDDEF(ncid))
213  nd=SIZE(did)
214  DO k=1,nd; CALL err(NF90_INQUIRE_DIMENSION(ncid,did(k),len=nn(k))); END DO
215  IF(nd==1) CALL err(NF90_PUT_VAR(ncid,nvarid,RESHAPE(v,nn(1:1))),var)
216  IF(nd==2) CALL err(NF90_PUT_VAR(ncid,nvarid,RESHAPE(v,nn(1:2))),var)
217  CALL err(NF90_REDEF(ncid))
218END SUBROUTINE put_var
219!
220!===============================================================================
221
222
223!===============================================================================
224!
225FUNCTION msg(typ,nam)
226!
227!===============================================================================
228  IMPLICIT NONE
229!===============================================================================
230! Arguments:
231  CHARACTER(LEN=256)                     :: msg    !--- STANDARDIZED MESSAGE
232  CHARACTER(LEN=*),           INTENT(IN) :: typ    !--- TYPE OF OPERATION
233  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: nam    !--- FIELD NAME
234!===============================================================================
235  SELECT CASE(typ)
236    CASE('open');  msg="Opening failed for <"//TRIM(fil)//">"
237    CASE('close'); msg="Closing failed for <"//TRIM(fil)//">"
238    CASE('get');   msg="Reading failed for <"//TRIM(nam)//">"
239    CASE('put');   msg="Writting failed for <"//TRIM(nam)//">"
240    CASE('inq');   msg="Missing field <"//TRIM(nam)//">"
241    CASE('fnd');   msg="Found field <"//TRIM(nam)//">"
242  END SELECT
243  msg=TRIM(msg)//" in file <"//TRIM(fil)//">"
244
245END FUNCTION msg
246!
247!===============================================================================
248
249
250!===============================================================================
251!
252SUBROUTINE err(ierr,typ,nam)
253!
254!===============================================================================
255  IMPLICIT NONE
256!===============================================================================
257! Arguments:
258  INTEGER,                    INTENT(IN) :: ierr   !--- NetCDF ERROR CODE
259  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: typ    !--- TYPE OF OPERATION
260  CHARACTER(LEN=*), OPTIONAL, INTENT(IN) :: nam    !--- FIELD NAME
261!===============================================================================
262  IF(ierr==NF90_NoERR) RETURN
263  IF(.NOT.PRESENT(typ)) THEN
264    CALL ABORT_gcm(modname,NF90_STRERROR(ierr),ierr)
265  ELSE
266    CALL ABORT_gcm(modname,msg(typ,nam),ierr)
267  END IF
268
269END SUBROUTINE err
270!
271!===============================================================================
272
[1632]273END MODULE dynredem_mod   
[2408]274
[1632]275   
276   
Note: See TracBrowser for help on using the repository browser.