source: LMDZ6/branches/Amaury_dev/libf/dyn3dmem/dynredem_mod.F90 @ 5225

Last change on this file since 5225 was 5159, checked in by abarral, 3 months ago

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