My Project
 All Classes Files Functions Variables Macros
dynredem_mod.F90
Go to the documentation of this file.
1 !
2 ! $Id$
3 !
5 
6 CONTAINS
7 
8  SUBROUTINE dynredem_write_u(ncid,id,var,ll)
9  USE dimensions
10  USE parallel
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
75  USE parallel
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
140  USE parallel
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 
204 END MODULE dynredem_mod
205 
206