source: LMDZ5/trunk/libf/dynredem_mod.F90 @ 1630

Last change on this file since 1630 was 1630, checked in by Laurent Fairhead, 12 years ago

Importation initiale du répertoire dyn3dmem

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