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

Last change on this file since 5411 was 5159, checked in by abarral, 5 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
RevLine 
[1632]1MODULE dynredem_mod
2
[5159]3  USE lmdz_dimensions
4  USE lmdz_paramet
[1823]5  USE parallel_lmdz
[1632]6  USE mod_hallo
[5088]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
[5090]9  USE lmdz_cppkeys_wrapper, ONLY: nf90_format
[2299]10  PRIVATE
11  PUBLIC :: dynredem_write_u, dynredem_write_v, dynredem_read_u, err
[5060]12  PUBLIC :: cre_var, put_var, fil, modname, msg
[2299]13  CHARACTER(LEN=256), SAVE :: fil, modname
14  INTEGER,            SAVE :: nvarid
15
16
17CONTAINS
18
19
20!===============================================================================
[5099]21
[2299]22SUBROUTINE dynredem_write_u(ncid,id,var,ll)
[5099]23
[2299]24!===============================================================================
[1632]25  IMPLICIT NONE
[2299]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
[5101]40  IF(mpi_rank==0) CALL err(nf90_inq_varid(ncid,id,nvarid),"inq",id)
[1632]41!$OMP END MASTER
42
43!$OMP MASTER
[2299]44  ALLOCATE(var_tmp(ijb_u:ije_u,ll),var_glo(ip1jmp1))
[1632]45!$OMP END MASTER
46!$OMP BARRIER
47
48!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
[2299]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
[5100]55      CALL err(nf90_put_var(ncid,nvarid,var_glo,start,count),"put",id)
[2299]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
[5099]66
[2299]67!===============================================================================
[1632]68
[2299]69
70!===============================================================================
[5099]71
[2299]72SUBROUTINE dynredem_write_v(ncid,id,var,ll)
[5099]73
[2299]74!===============================================================================
[1632]75  IMPLICIT NONE
[2299]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
[5101]90  IF(mpi_rank==0) CALL err(nf90_inq_varid(ncid,id,nvarid),"inq",id)
[1632]91!$OMP END MASTER
[2299]92
[1632]93!$OMP MASTER
[2299]94  ALLOCATE(var_tmp(ijb_v:ije_v,ll),var_glo(ip1jm))
[1632]95!$OMP END MASTER
96!$OMP BARRIER
97
98!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
[2299]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
[5100]105      CALL err(nf90_put_var(ncid,nvarid,var_glo,start,count),"put",id)
[2299]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
[1632]114 
[2299]115END SUBROUTINE dynredem_write_v
[5099]116
[2299]117!===============================================================================
[1632]118
[2299]119
120!===============================================================================
[5099]121
[2299]122SUBROUTINE dynredem_read_u(ncid,id,var,ll)
[5099]123
[2299]124!===============================================================================
[1632]125  IMPLICIT NONE
[2299]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
[5101]140  IF(mpi_rank==0) CALL err(nf90_inq_varid(ncid,id,nvarid),'inq',id)
[1632]141!$OMP END MASTER
[2299]142
[1632]143!$OMP MASTER
[2299]144  ALLOCATE(var_tmp(ijb_u:ije_u,ll),var_glo(ip1jmp1))
[1632]145!$OMP END MASTER
146!$OMP BARRIER
147
[2299]148  DO l=1,ll
149    IF(mpi_rank==0) THEN
150    !$OMP MASTER
151      start(3)=l
[5099]152      CALL err(nf90_get_var(ncid,nvarid,var_glo,start,count),"get",id)
[2299]153    !$OMP END MASTER
154    END IF
155    CALL scatter_field_u(var_glo,var_tmp(:,l),1)
156  END DO
[1632]157
[2299]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   
[5099]168
[2299]169!===============================================================================
170
171
172!===============================================================================
[5099]173
[2299]174SUBROUTINE cre_var(ncid,var,title,did,units)
[5099]175
[2299]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!===============================================================================
[5100]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)
[1632]188
[2299]189END SUBROUTINE cre_var
[5099]190
[2299]191!===============================================================================
192
193
194!===============================================================================
[5099]195
[2299]196SUBROUTINE put_var(ncid,var,title,did,v,units)
[5099]197
[2299]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)
[5100]211  CALL err(nf90_enddef(ncid))
[2299]212  nd=SIZE(did)
[5099]213  DO k=1,nd; CALL err(nf90_inquire_dimension(ncid,did(k),len=nn(k))); END DO
[5100]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)
[5101]216  CALL err(nf90_redef(ncid))
[2299]217END SUBROUTINE put_var
[5099]218
[2299]219!===============================================================================
220
221
222!===============================================================================
[5099]223
[2299]224FUNCTION msg(typ,nam)
[5099]225
[2299]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
[5099]245
[2299]246!===============================================================================
247
248
249!===============================================================================
[5099]250
[2299]251SUBROUTINE err(ierr,typ,nam)
[5099]252
[2299]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!===============================================================================
[5099]260  IF(ierr==nf90_noerr) RETURN
[2299]261  IF(.NOT.PRESENT(typ)) THEN
[5101]262    CALL ABORT_gcm(modname,nf90_strerror(ierr),ierr)
[2299]263  ELSE
264    CALL ABORT_gcm(modname,msg(typ,nam),ierr)
265  END IF
266
267END SUBROUTINE err
[5099]268
[2299]269!===============================================================================
270
[1632]271END MODULE dynredem_mod   
[2299]272
[1632]273   
274   
Note: See TracBrowser for help on using the repository browser.