source: LMDZ5/trunk/libf/dyn3dmem/dynredem_mod.F90 @ 2178

Last change on this file since 2178 was 1907, checked in by lguez, 11 years ago

Added a copyright property to every file of the distribution, except
for the fcm files (which have their own copyright). Use svn propget on
a file to see the copyright. For instance:

$ svn propget copyright libf/phylmd/physiq.F90
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

Also added the files defining the CeCILL version 2 license, in French
and English, at the top of the LMDZ tree.
  • 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: 4.5 KB
Line 
1!
2! $Id$
3!
4MODULE dynredem_mod
5
6CONTAINS
7
8  SUBROUTINE dynredem_write_u(ncid,id,var,ll)
9  USE dimensions_mod
10  USE parallel_lmdz
11  USE mod_hallo
12  IMPLICIT NONE
13    INTEGER          :: ncid
14    CHARACTER(LEN=*) :: id
15    REAL             :: var(ijb_u:ije_u,ll)
16    REAL,ALLOCATABLE,SAVE  :: var_tmp(:,:)
17    REAL,ALLOCATABLE,SAVE  :: var_glo(:)
18    INTEGER          :: ll
19    INTEGER          :: count(4)
20    INTEGER          :: start(4)
21    INTEGER          :: l
22    INTEGER          :: nvarid
23    INTEGER          :: ierr
24    INCLUDE 'netcdf.inc'   
25   
26    count(:)=(/ iip1,jjp1,1,1 /)
27    start(:)=(/ 1,1,1,1 /)
28   
29!$OMP MASTER   
30   IF (mpi_rank==0) THEN
31     ierr = NF_INQ_VARID(ncid, id, nvarid)
32     IF (ierr .NE. NF_NOERR) THEN
33       PRINT*, "Variable "//id//" n est pas definie"
34       CALL abort
35     ENDIF
36   ENDIF
37!$OMP END MASTER
38
39!$OMP MASTER
40    ALLOCATE(var_tmp(ijb_u:ije_u,ll))
41    ALLOCATE(var_glo(ip1jmp1))
42!$OMP END MASTER
43!$OMP BARRIER
44
45!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
46    DO l=1,ll
47      var_tmp(:,l)=var(:,l)
48    ENDDO
49
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#ifdef NC_DOUBLE
56        ierr = NF_PUT_VARA_DOUBLE (ncid,nvarid,start,count,var_glo)
57#else
58        ierr = NF_PUT_VARA_REAL (ncid,nvarid,start,count,var_glo)
59#endif
60   !$OMP END MASTER
61       ENDIF
62    ENDDO
63   
64  !$OMP BARRIER
65  !$OMP MASTER
66    DEALLOCATE(var_tmp)
67    DEALLOCATE(var_glo)
68  !$OMP END MASTER
69  !$OMP BARRIER
70 
71  END SUBROUTINE dynredem_write_u
72     
73  SUBROUTINE dynredem_write_v(ncid,id,var,ll)
74  USE dimensions_mod
75  USE parallel_lmdz
76  USE mod_hallo
77  IMPLICIT NONE
78    INTEGER          :: ncid
79    CHARACTER(LEN=*) :: id
80    REAL             :: var(ijb_v:ije_v,ll)
81    REAL,ALLOCATABLE,SAVE  :: var_tmp(:,:)
82    REAL,ALLOCATABLE,SAVE  :: var_glo(:)
83    INTEGER          :: ll
84    INTEGER          :: count(4)
85    INTEGER          :: start(4)
86    INTEGER          :: l
87    INTEGER          :: nvarid
88    INTEGER          :: ierr
89    INCLUDE 'netcdf.inc'   
90   
91    count(:)=(/ iip1,jjm,1,1 /)
92    start(:)=(/ 1,1,1,1 /)
93   
94!$OMP MASTER   
95   IF (mpi_rank==0) THEN
96     ierr = NF_INQ_VARID(ncid, id, nvarid)
97     IF (ierr .NE. NF_NOERR) THEN
98       PRINT*, "Variable "//id//" n est pas definie"
99       CALL abort
100     ENDIF
101   ENDIF
102!$OMP END MASTER
103 
104!$OMP MASTER
105    ALLOCATE(var_tmp(ijb_v:ije_v,ll))
106    ALLOCATE(var_glo(ip1jm))
107!$OMP END MASTER
108!$OMP BARRIER
109
110!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
111    DO l=1,ll
112      var_tmp(:,l)=var(:,l)
113    ENDDO
114
115    DO l=1,ll
116      CALL gather_field_v(var_tmp(:,l),var_glo,1)
117       IF (mpi_rank==0) THEN
118   !$OMP MASTER
119        start(3)=l
120#ifdef NC_DOUBLE
121        ierr = NF_PUT_VARA_DOUBLE (ncid,nvarid,start,count,var_glo)
122#else
123        ierr = NF_PUT_VARA_REAL (ncid,nvarid,start,count,var_glo)
124#endif
125   !$OMP END MASTER
126       ENDIF
127    ENDDO
128   
129  !$OMP BARRIER
130  !$OMP MASTER
131    DEALLOCATE(var_tmp)
132    DEALLOCATE(var_glo)
133  !$OMP END MASTER
134  !$OMP BARRIER
135 
136  END SUBROUTINE dynredem_write_v
137
138  SUBROUTINE dynredem_read_u(ncid,id,var,ll)
139  USE dimensions_mod
140  USE parallel_lmdz
141  USE mod_hallo
142  IMPLICIT NONE
143    INTEGER          :: ncid
144    CHARACTER(LEN=*) :: id
145    REAL             :: var(ijb_u:ije_u,ll)
146    REAL,ALLOCATABLE,SAVE  :: var_tmp(:,:)
147    REAL,ALLOCATABLE,SAVE  :: var_glo(:)
148    INTEGER          :: ll
149    INTEGER          :: count(4)
150    INTEGER          :: start(4)
151    INTEGER          :: l
152    INTEGER          :: nvarid
153    INTEGER          :: ierr
154    INCLUDE 'netcdf.inc'   
155   
156    count(:)=(/ iip1,jjp1,1,1 /)
157    start(:)=(/ 1,1,1,1 /)
158   
159!$OMP MASTER   
160   IF (mpi_rank==0) THEN
161     ierr = NF_INQ_VARID(ncid, id, nvarid)
162     IF (ierr .NE. NF_NOERR) THEN
163       PRINT*, "Variable "//id//" n est pas definie"
164       CALL abort
165     ENDIF
166   ENDIF
167!$OMP END MASTER
168 
169!$OMP MASTER
170    ALLOCATE(var_tmp(ijb_u:ije_u,ll))
171    ALLOCATE(var_glo(ip1jmp1))
172!$OMP END MASTER
173!$OMP BARRIER
174
175
176    DO l=1,ll
177       IF (mpi_rank==0) THEN
178   !$OMP MASTER
179        start(3)=l
180#ifdef NC_DOUBLE
181        ierr = NF_GET_VARA_DOUBLE (ncid,nvarid,start,count,var_glo)
182#else
183        ierr = NF_GET_VARA_REAL (ncid,nvarid,start,count,var_glo)
184#endif
185   !$OMP END MASTER
186       ENDIF
187       CALL scatter_field_u(var_glo,var_tmp(:,l),1)
188    ENDDO
189
190!$OMP DO SCHEDULE(STATIC,OMP_CHUNK)
191    DO l=1,ll
192      var(:,l)=var_tmp(:,l)
193    ENDDO
194   
195  !$OMP BARRIER
196  !$OMP MASTER
197    DEALLOCATE(var_tmp)
198    DEALLOCATE(var_glo)
199  !$OMP END MASTER
200  !$OMP BARRIER
201 
202  END SUBROUTINE dynredem_read_u   
203 
204END MODULE dynredem_mod   
205   
206   
Note: See TracBrowser for help on using the repository browser.