| GCC Code Coverage Report | |||||||||||||||||||||
|
|||||||||||||||||||||
| Line | Branch | Exec | Source |
1 |
! |
||
2 |
! $Id: iophy.F90 4260 2022-09-20 14:09:50Z lguez $ |
||
3 |
! |
||
4 |
MODULE iophy |
||
5 |
|||
6 |
! abd REAL,private,allocatable,DIMENSION(:),save :: io_lat |
||
7 |
! abd REAL,private,allocatable,DIMENSION(:),save :: io_lon |
||
8 |
REAL,ALLOCATABLE,DIMENSION(:),SAVE :: io_lat |
||
9 |
REAL,ALLOCATABLE,DIMENSION(:),SAVE :: io_lon |
||
10 |
INTEGER, SAVE :: phys_domain_id |
||
11 |
INTEGER, SAVE :: npstn |
||
12 |
INTEGER, ALLOCATABLE, DIMENSION(:), SAVE :: nptabij |
||
13 |
INTEGER, SAVE :: itau_iophy |
||
14 |
LOGICAL :: check_dim = .false. |
||
15 |
|||
16 |
!$OMP THREADPRIVATE(itau_iophy) |
||
17 |
|||
18 |
#ifdef CPP_XIOS |
||
19 |
INTERFACE histwrite_phy |
||
20 |
MODULE PROCEDURE histwrite2d_phy,histwrite3d_phy,histwrite2d_phy_old,histwrite3d_phy_old,histwrite2d_xios,histwrite3d_xios,histwrite0d_xios |
||
21 |
END INTERFACE |
||
22 |
#else |
||
23 |
INTERFACE histwrite_phy |
||
24 |
MODULE PROCEDURE histwrite2d_phy,histwrite3d_phy,histwrite2d_phy_old,histwrite3d_phy_old |
||
25 |
END INTERFACE |
||
26 |
#endif |
||
27 |
|||
28 |
INTERFACE histbeg_phy_all |
||
29 |
MODULE PROCEDURE histbeg_phy,histbeg_phyxios,histbeg_phy_points |
||
30 |
END INTERFACE |
||
31 |
|||
32 |
|||
33 |
CONTAINS |
||
34 |
|||
35 |
! ug Routine pour définir itau_iophy depuis phys_output_write_mod: |
||
36 |
74881 |
SUBROUTINE set_itau_iophy(ito) |
|
37 |
IMPLICIT NONE |
||
38 |
INTEGER, INTENT(IN) :: ito |
||
39 |
289 |
itau_iophy = ito |
|
40 |
289 |
END SUBROUTINE |
|
41 |
|||
42 |
1 |
SUBROUTINE init_iophy_new(rlat,rlon) |
|
43 |
|||
44 |
USE dimphy, ONLY: klon |
||
45 |
USE mod_phys_lmdz_para, ONLY: gather, bcast, & |
||
46 |
jj_nb, jj_begin, jj_end, ii_begin, ii_end, & |
||
47 |
mpi_size, mpi_rank, klon_mpi, & |
||
48 |
is_sequential, is_south_pole_dyn |
||
49 |
USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo, grid_type, unstructured |
||
50 |
USE print_control_mod, ONLY: prt_level,lunout |
||
51 |
#ifdef CPP_IOIPSL |
||
52 |
USE ioipsl, ONLY: flio_dom_set |
||
53 |
#endif |
||
54 |
#ifdef CPP_XIOS |
||
55 |
use wxios, ONLY: wxios_domain_param, wxios_domain_param_unstructured, wxios_context_init |
||
56 |
#endif |
||
57 |
IMPLICIT NONE |
||
58 |
REAL,DIMENSION(klon),INTENT(IN) :: rlon |
||
59 |
REAL,DIMENSION(klon),INTENT(IN) :: rlat |
||
60 |
|||
61 |
2 |
REAL,DIMENSION(klon_glo) :: rlat_glo |
|
62 |
2 |
REAL,DIMENSION(klon_glo) :: rlon_glo |
|
63 |
|||
64 |
INTEGER,DIMENSION(2) :: ddid |
||
65 |
INTEGER,DIMENSION(2) :: dsg |
||
66 |
INTEGER,DIMENSION(2) :: dsl |
||
67 |
INTEGER,DIMENSION(2) :: dpf |
||
68 |
INTEGER,DIMENSION(2) :: dpl |
||
69 |
INTEGER,DIMENSION(2) :: dhs |
||
70 |
INTEGER,DIMENSION(2) :: dhe |
||
71 |
INTEGER :: i |
||
72 |
INTEGER :: data_ibegin, data_iend |
||
73 |
|||
74 |
#ifdef CPP_XIOS |
||
75 |
CALL wxios_context_init |
||
76 |
#endif |
||
77 |
|||
78 |
|||
79 |
✓✗ | 1 |
IF (grid_type==unstructured) THEN |
80 |
|||
81 |
#ifdef CPP_XIOS |
||
82 |
CALL wxios_domain_param_unstructured("dom_glo") |
||
83 |
#endif |
||
84 |
|||
85 |
ELSE |
||
86 |
|||
87 |
1 |
CALL gather(rlat,rlat_glo) |
|
88 |
1 |
CALL bcast(rlat_glo) |
|
89 |
1 |
CALL gather(rlon,rlon_glo) |
|
90 |
1 |
CALL bcast(rlon_glo) |
|
91 |
|||
92 |
!$OMP MASTER |
||
93 |
✓✗✗✓ ✗✓ |
1 |
ALLOCATE(io_lat(nbp_lat)) |
94 |
✗✓ | 1 |
IF (klon_glo == 1) THEN |
95 |
io_lat(1)=rlat_glo(1) |
||
96 |
ELSE |
||
97 |
1 |
io_lat(1)=rlat_glo(1) |
|
98 |
1 |
io_lat(nbp_lat)=rlat_glo(klon_glo) |
|
99 |
✓✓ | 32 |
DO i=2,nbp_lat-1 |
100 |
32 |
io_lat(i)=rlat_glo(2+(i-2)*nbp_lon) |
|
101 |
ENDDO |
||
102 |
ENDIF |
||
103 |
|||
104 |
✓✗✗✓ ✗✓ |
1 |
ALLOCATE(io_lon(nbp_lon)) |
105 |
✗✓ | 1 |
IF (klon_glo == 1) THEN |
106 |
io_lon(1)=rlon_glo(1) |
||
107 |
ELSE |
||
108 |
✓✓ | 33 |
io_lon(1:nbp_lon)=rlon_glo(2:nbp_lon+1) |
109 |
ENDIF |
||
110 |
|||
111 |
!! (I) dtnb : total number of domains |
||
112 |
!! (I) dnb : domain number |
||
113 |
!! (I) did(:) : distributed dimensions identifiers |
||
114 |
!! (up to 5 dimensions are supported) |
||
115 |
!! (I) dsg(:) : total number of points for each dimension |
||
116 |
!! (I) dsl(:) : local number of points for each dimension |
||
117 |
!! (I) dpf(:) : position of first local point for each dimension |
||
118 |
!! (I) dpl(:) : position of last local point for each dimension |
||
119 |
!! (I) dhs(:) : start halo size for each dimension |
||
120 |
!! (I) dhe(:) : end halo size for each dimension |
||
121 |
!! (C) cdnm : Model domain definition name. |
||
122 |
!! The names actually supported are : |
||
123 |
!! "BOX", "APPLE", "ORANGE". |
||
124 |
!! These names are case insensitive. |
||
125 |
|||
126 |
1 |
ddid=(/ 1,2 /) |
|
127 |
✓✓ | 3 |
dsg=(/ nbp_lon, nbp_lat /) |
128 |
✓✓ | 3 |
dsl=(/ nbp_lon, jj_nb /) |
129 |
✓✓ | 3 |
dpf=(/ 1,jj_begin /) |
130 |
✓✓ | 3 |
dpl=(/ nbp_lon, jj_end /) |
131 |
✓✓ | 3 |
dhs=(/ ii_begin-1,0 /) |
132 |
✓✗ | 1 |
IF (mpi_rank==mpi_size-1) THEN |
133 |
1 |
dhe=(/0,0/) |
|
134 |
ELSE |
||
135 |
dhe=(/ nbp_lon-ii_end,0 /) |
||
136 |
ENDIF |
||
137 |
|||
138 |
#ifndef CPP_IOIPSL_NO_OUTPUT |
||
139 |
CALL flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, & |
||
140 |
1 |
'APPLE',phys_domain_id) |
|
141 |
#endif |
||
142 |
#ifdef CPP_XIOS |
||
143 |
! Set values for the mask: |
||
144 |
IF (mpi_rank == 0) THEN |
||
145 |
data_ibegin = 0 |
||
146 |
ELSE |
||
147 |
data_ibegin = ii_begin - 1 |
||
148 |
END IF |
||
149 |
|||
150 |
IF (mpi_rank == mpi_size-1) THEN |
||
151 |
data_iend = nbp_lon |
||
152 |
ELSE |
||
153 |
data_iend = ii_end + 1 |
||
154 |
END IF |
||
155 |
|||
156 |
IF (prt_level>=10) THEN |
||
157 |
write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," iibegin=",ii_begin , " ii_end=",ii_end," jjbegin=",jj_begin," jj_nb=",jj_nb," jj_end=",jj_end |
||
158 |
write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," nbp_lon=",nbp_lon," nbp_lat=",nbp_lat |
||
159 |
write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend |
||
160 |
write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," data_ibegin=",data_ibegin," data_iend=",data_iend |
||
161 |
write(lunout,*) "init_iophy_new: mpirank=",mpi_rank," is_south_pole_dyn=",is_south_pole_dyn |
||
162 |
ENDIF |
||
163 |
|||
164 |
! Initialize the XIOS domain coreesponding to this process: |
||
165 |
#endif |
||
166 |
!$OMP END MASTER |
||
167 |
|||
168 |
#ifdef CPP_XIOS |
||
169 |
CALL wxios_domain_param("dom_glo") |
||
170 |
#endif |
||
171 |
|||
172 |
ENDIF |
||
173 |
|||
174 |
1 |
END SUBROUTINE init_iophy_new |
|
175 |
|||
176 |
|||
177 |
SUBROUTINE init_iophy(lat,lon) |
||
178 |
|||
179 |
USE mod_phys_lmdz_para, ONLY: jj_begin, jj_end, ii_begin, ii_end, jj_nb, & |
||
180 |
mpi_size, mpi_rank |
||
181 |
USE ioipsl, ONLY: flio_dom_set |
||
182 |
USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat |
||
183 |
|||
184 |
IMPLICIT NONE |
||
185 |
|||
186 |
REAL,DIMENSION(nbp_lon),INTENT(IN) :: lon |
||
187 |
REAL,DIMENSION(nbp_lat),INTENT(IN) :: lat |
||
188 |
|||
189 |
INTEGER,DIMENSION(2) :: ddid |
||
190 |
INTEGER,DIMENSION(2) :: dsg |
||
191 |
INTEGER,DIMENSION(2) :: dsl |
||
192 |
INTEGER,DIMENSION(2) :: dpf |
||
193 |
INTEGER,DIMENSION(2) :: dpl |
||
194 |
INTEGER,DIMENSION(2) :: dhs |
||
195 |
INTEGER,DIMENSION(2) :: dhe |
||
196 |
|||
197 |
!$OMP MASTER |
||
198 |
ALLOCATE(io_lat(nbp_lat)) |
||
199 |
io_lat(:)=lat(:) |
||
200 |
ALLOCATE(io_lon(nbp_lon)) |
||
201 |
io_lon(:)=lon(:) |
||
202 |
|||
203 |
ddid=(/ 1,2 /) |
||
204 |
dsg=(/ nbp_lon, nbp_lat /) |
||
205 |
dsl=(/ nbp_lon, jj_nb /) |
||
206 |
dpf=(/ 1,jj_begin /) |
||
207 |
dpl=(/ nbp_lon, jj_end /) |
||
208 |
dhs=(/ ii_begin-1,0 /) |
||
209 |
IF (mpi_rank==mpi_size-1) THEN |
||
210 |
dhe=(/0,0/) |
||
211 |
ELSE |
||
212 |
dhe=(/ nbp_lon-ii_end,0 /) |
||
213 |
ENDIF |
||
214 |
|||
215 |
#ifndef CPP_IOIPSL_NO_OUTPUT |
||
216 |
call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, & |
||
217 |
'APPLE',phys_domain_id) |
||
218 |
#endif |
||
219 |
!$OMP END MASTER |
||
220 |
|||
221 |
END SUBROUTINE init_iophy |
||
222 |
|||
223 |
SUBROUTINE histbeg_phyxios(name,itau0,zjulian,dtime,ffreq,lev,nhori,nid_day) |
||
224 |
! USE dimphy |
||
225 |
USE mod_phys_lmdz_para, ONLY: is_sequential, is_using_mpi, is_mpi_root, & |
||
226 |
jj_begin, jj_end, jj_nb |
||
227 |
USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat |
||
228 |
USE ioipsl, ONLY: histbeg |
||
229 |
#ifdef CPP_XIOS |
||
230 |
USE wxios, ONLY: wxios_add_file |
||
231 |
#endif |
||
232 |
IMPLICIT NONE |
||
233 |
INCLUDE 'clesphys.h' |
||
234 |
|||
235 |
CHARACTER*(*), INTENT(IN) :: name |
||
236 |
INTEGER, INTENT(IN) :: itau0 |
||
237 |
REAL,INTENT(IN) :: zjulian |
||
238 |
REAL,INTENT(IN) :: dtime |
||
239 |
CHARACTER(LEN=*), INTENT(IN) :: ffreq |
||
240 |
INTEGER,INTENT(IN) :: lev |
||
241 |
INTEGER,INTENT(OUT) :: nhori |
||
242 |
INTEGER,INTENT(OUT) :: nid_day |
||
243 |
|||
244 |
!$OMP MASTER |
||
245 |
IF (is_sequential) THEN |
||
246 |
CALL histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), & |
||
247 |
1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day) |
||
248 |
ELSE |
||
249 |
CALL histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), & |
||
250 |
1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day,phys_domain_id) |
||
251 |
ENDIF |
||
252 |
|||
253 |
#ifdef CPP_XIOS |
||
254 |
! ug OMP en chantier... |
||
255 |
IF((.NOT. is_using_mpi) .OR. is_mpi_root) THEN |
||
256 |
! ug Création du fichier |
||
257 |
IF (.not. ok_all_xml) THEN |
||
258 |
CALL wxios_add_file(name, ffreq, lev) |
||
259 |
ENDIF |
||
260 |
ENDIF |
||
261 |
#endif |
||
262 |
!$OMP END MASTER |
||
263 |
|||
264 |
END SUBROUTINE histbeg_phyxios |
||
265 |
|||
266 |
4 |
SUBROUTINE histbeg_phy(name,itau0,zjulian,dtime,nhori,nid_day) |
|
267 |
|||
268 |
USE mod_phys_lmdz_para, ONLY: jj_begin, jj_end, jj_nb, is_sequential |
||
269 |
USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat |
||
270 |
USE ioipsl, ONLY: histbeg |
||
271 |
|||
272 |
IMPLICIT NONE |
||
273 |
|||
274 |
CHARACTER*(*), INTENT(IN) :: name |
||
275 |
INTEGER, INTENT(IN) :: itau0 |
||
276 |
REAL,INTENT(IN) :: zjulian |
||
277 |
REAL,INTENT(IN) :: dtime |
||
278 |
INTEGER,INTENT(OUT) :: nhori |
||
279 |
INTEGER,INTENT(OUT) :: nid_day |
||
280 |
|||
281 |
!$OMP MASTER |
||
282 |
#ifndef CPP_IOIPSL_NO_OUTPUT |
||
283 |
✓✗ | 4 |
IF (is_sequential) THEN |
284 |
CALL histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), & |
||
285 |
4 |
1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day) |
|
286 |
ELSE |
||
287 |
CALL histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), & |
||
288 |
1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day,phys_domain_id) |
||
289 |
ENDIF |
||
290 |
#endif |
||
291 |
!$OMP END MASTER |
||
292 |
|||
293 |
4 |
END SUBROUTINE histbeg_phy |
|
294 |
|||
295 |
|||
296 |
SUBROUTINE histbeg_phy_points(rlon,rlat,pim,tabij,ipt,jpt, & |
||
297 |
plon,plat,plon_bounds,plat_bounds, & |
||
298 |
nname,itau0,zjulian,dtime,nnhori,nnid_day) |
||
299 |
USE dimphy, ONLY: klon |
||
300 |
USE mod_phys_lmdz_para, ONLY: gather, bcast, & |
||
301 |
is_sequential, klon_mpi_begin, klon_mpi_end, & |
||
302 |
mpi_rank |
||
303 |
USE mod_grid_phy_lmdz, ONLY: klon_glo, nbp_lon, nbp_lat, grid1dTo2d_glo |
||
304 |
USE ioipsl, ONLY: histbeg |
||
305 |
|||
306 |
IMPLICIT NONE |
||
307 |
|||
308 |
REAL,DIMENSION(klon),INTENT(IN) :: rlon |
||
309 |
REAL,DIMENSION(klon),INTENT(IN) :: rlat |
||
310 |
INTEGER, INTENT(IN) :: itau0 |
||
311 |
REAL,INTENT(IN) :: zjulian |
||
312 |
REAL,INTENT(IN) :: dtime |
||
313 |
INTEGER, INTENT(IN) :: pim |
||
314 |
INTEGER, intent(out) :: nnhori |
||
315 |
CHARACTER(len=20), INTENT(IN) :: nname |
||
316 |
INTEGER, INTENT(OUT) :: nnid_day |
||
317 |
INTEGER :: i |
||
318 |
REAL,DIMENSION(klon_glo) :: rlat_glo |
||
319 |
REAL,DIMENSION(klon_glo) :: rlon_glo |
||
320 |
INTEGER, DIMENSION(pim), INTENT(IN) :: tabij |
||
321 |
REAL,DIMENSION(pim), INTENT(IN) :: plat, plon |
||
322 |
INTEGER,DIMENSION(pim), INTENT(IN) :: ipt, jpt |
||
323 |
REAL,DIMENSION(pim,2), intent(out) :: plat_bounds, plon_bounds |
||
324 |
|||
325 |
INTEGER, SAVE :: tabprocbeg, tabprocend |
||
326 |
!$OMP THREADPRIVATE(tabprocbeg, tabprocend) |
||
327 |
INTEGER :: ip |
||
328 |
INTEGER, PARAMETER :: nip=1 |
||
329 |
INTEGER :: npproc |
||
330 |
REAL, allocatable, DIMENSION(:) :: npplat, npplon |
||
331 |
REAL, allocatable, DIMENSION(:,:) :: npplat_bounds, npplon_bounds |
||
332 |
REAL, DIMENSION(nbp_lon,nbp_lat) :: zx_lon, zx_lat |
||
333 |
|||
334 |
CALL gather(rlat,rlat_glo) |
||
335 |
CALL bcast(rlat_glo) |
||
336 |
CALL gather(rlon,rlon_glo) |
||
337 |
CALL bcast(rlon_glo) |
||
338 |
|||
339 |
!$OMP MASTER |
||
340 |
DO i=1,pim |
||
341 |
|||
342 |
! print*,'CFMIP_iophy i tabij lon lat',i,tabij(i),plon(i),plat(i) |
||
343 |
|||
344 |
plon_bounds(i,1)=rlon_glo(tabij(i)-1) |
||
345 |
plon_bounds(i,2)=rlon_glo(tabij(i)+1) |
||
346 |
IF (plon_bounds(i,2).LE.0..AND.plon_bounds(i,1).GE.0.) THEN |
||
347 |
IF (rlon_glo(tabij(i)).GE.0.) THEN |
||
348 |
plon_bounds(i,2)=-1*plon_bounds(i,2) |
||
349 |
ENDIF |
||
350 |
ENDIF |
||
351 |
IF (plon_bounds(i,2).GE.0..AND.plon_bounds(i,1).LE.0.) THEN |
||
352 |
IF (rlon_glo(tabij(i)).LE.0.) THEN |
||
353 |
plon_bounds(i,2)=-1*plon_bounds(i,2) |
||
354 |
ENDIF |
||
355 |
ENDIF |
||
356 |
! |
||
357 |
IF ( tabij(i).LE.nbp_lon) THEN |
||
358 |
plat_bounds(i,1)=rlat_glo(tabij(i)) |
||
359 |
ELSE |
||
360 |
plat_bounds(i,1)=rlat_glo(tabij(i)-nbp_lon) |
||
361 |
ENDIF |
||
362 |
plat_bounds(i,2)=rlat_glo(tabij(i)+nbp_lon) |
||
363 |
! |
||
364 |
! print*,'CFMIP_iophy point i lon lon_bds',i,plon_bounds(i,1),rlon_glo(tabij(i)),plon_bounds(i,2) |
||
365 |
! print*,'CFMIP_iophy point i lat lat_bds',i,plat_bounds(i,1),rlat_glo(tabij(i)),plat_bounds(i,2) |
||
366 |
! |
||
367 |
ENDDO |
||
368 |
if (is_sequential) then |
||
369 |
|||
370 |
npstn=pim |
||
371 |
IF(.NOT. ALLOCATED(nptabij)) THEN |
||
372 |
ALLOCATE(nptabij(pim)) |
||
373 |
ENDIF |
||
374 |
DO i=1,pim |
||
375 |
nptabij(i)=tabij(i) |
||
376 |
ENDDO |
||
377 |
|||
378 |
CALL grid1dTo2d_glo(rlon_glo,zx_lon) |
||
379 |
IF ((nbp_lon*nbp_lat).GT.1) THEN |
||
380 |
DO i = 1, nbp_lon |
||
381 |
zx_lon(i,1) = rlon_glo(i+1) |
||
382 |
zx_lon(i,nbp_lat) = rlon_glo(i+1) |
||
383 |
ENDDO |
||
384 |
ENDIF |
||
385 |
CALL grid1dTo2d_glo(rlat_glo,zx_lat) |
||
386 |
|||
387 |
DO i=1,pim |
||
388 |
! print*,'CFMIP_iophy i tabij lon lat',i,tabij(i),plon(i),plat(i) |
||
389 |
|||
390 |
plon_bounds(i,1)=zx_lon(ipt(i)-1,jpt(i)) |
||
391 |
plon_bounds(i,2)=zx_lon(ipt(i)+1,jpt(i)) |
||
392 |
|||
393 |
IF (ipt(i).EQ.1) THEN |
||
394 |
plon_bounds(i,1)=zx_lon(nbp_lon,jpt(i)) |
||
395 |
plon_bounds(i,2)=360.+zx_lon(ipt(i)+1,jpt(i)) |
||
396 |
ENDIF |
||
397 |
|||
398 |
IF (ipt(i).EQ.nbp_lon) THEN |
||
399 |
plon_bounds(i,2)=360.+zx_lon(1,jpt(i)) |
||
400 |
ENDIF |
||
401 |
|||
402 |
plat_bounds(i,1)=zx_lat(ipt(i),jpt(i)-1) |
||
403 |
plat_bounds(i,2)=zx_lat(ipt(i),jpt(i)+1) |
||
404 |
|||
405 |
IF (jpt(i).EQ.1) THEN |
||
406 |
plat_bounds(i,1)=zx_lat(ipt(i),1)+0.001 |
||
407 |
plat_bounds(i,2)=zx_lat(ipt(i),1)-0.001 |
||
408 |
ENDIF |
||
409 |
|||
410 |
IF (jpt(i).EQ.nbp_lat) THEN |
||
411 |
plat_bounds(i,1)=zx_lat(ipt(i),nbp_lat)+0.001 |
||
412 |
plat_bounds(i,2)=zx_lat(ipt(i),nbp_lat)-0.001 |
||
413 |
ENDIF |
||
414 |
! |
||
415 |
! print*,'CFMIP_iophy point i lon lon_bds',i,plon_bounds(i,1),rlon(tabij(i)),plon_bounds(i,2) |
||
416 |
! print*,'CFMIP_iophy point i lat lat_bds',i,plat_bounds(i,1),rlat(tabij(i)),plat_bounds(i,2) |
||
417 |
! |
||
418 |
ENDDO |
||
419 |
|||
420 |
#ifndef CPP_IOIPSL_NO_OUTPUT |
||
421 |
CALL histbeg(nname,pim,plon,plon_bounds, & |
||
422 |
plat,plat_bounds, & |
||
423 |
itau0, zjulian, dtime, nnhori, nnid_day) |
||
424 |
#endif |
||
425 |
ELSE |
||
426 |
npproc=0 |
||
427 |
DO ip=1, pim |
||
428 |
tabprocbeg=klon_mpi_begin |
||
429 |
tabprocend=klon_mpi_end |
||
430 |
IF(tabij(ip).GE.tabprocbeg.AND.tabij(ip).LE.tabprocend) THEN |
||
431 |
npproc=npproc+1 |
||
432 |
npstn=npproc |
||
433 |
ENDIF |
||
434 |
ENDDO |
||
435 |
! print*,'CFMIP_iophy mpi_rank npstn',mpi_rank,npstn |
||
436 |
IF(.NOT. ALLOCATED(nptabij)) THEN |
||
437 |
ALLOCATE(nptabij(npstn)) |
||
438 |
ALLOCATE(npplon(npstn), npplat(npstn)) |
||
439 |
ALLOCATE(npplon_bounds(npstn,2), npplat_bounds(npstn,2)) |
||
440 |
ENDIF |
||
441 |
npproc=0 |
||
442 |
DO ip=1, pim |
||
443 |
IF(tabij(ip).GE.tabprocbeg.AND.tabij(ip).LE.tabprocend) THEN |
||
444 |
npproc=npproc+1 |
||
445 |
nptabij(npproc)=tabij(ip) |
||
446 |
! print*,'mpi_rank npproc ip plon plat tabij=',mpi_rank,npproc,ip, & |
||
447 |
! plon(ip),plat(ip),tabij(ip) |
||
448 |
npplon(npproc)=plon(ip) |
||
449 |
npplat(npproc)=plat(ip) |
||
450 |
npplon_bounds(npproc,1)=plon_bounds(ip,1) |
||
451 |
npplon_bounds(npproc,2)=plon_bounds(ip,2) |
||
452 |
npplat_bounds(npproc,1)=plat_bounds(ip,1) |
||
453 |
npplat_bounds(npproc,2)=plat_bounds(ip,2) |
||
454 |
!!! |
||
455 |
!!! print qui sert a reordonner les points stations selon l'ordre CFMIP |
||
456 |
!!! ne pas enlever |
||
457 |
print*,'iophy_mpi rank ip lon lat',mpi_rank,ip,plon(ip),plat(ip) |
||
458 |
!!! |
||
459 |
ENDIF |
||
460 |
ENDDO |
||
461 |
#ifndef CPP_IOIPSL_NO_OUTPUT |
||
462 |
CALL histbeg(nname,npstn,npplon,npplon_bounds, & |
||
463 |
npplat,npplat_bounds, & |
||
464 |
itau0,zjulian,dtime,nnhori,nnid_day,phys_domain_id) |
||
465 |
#endif |
||
466 |
ENDIF |
||
467 |
!$OMP END MASTER |
||
468 |
|||
469 |
END SUBROUTINE histbeg_phy_points |
||
470 |
|||
471 |
|||
472 |
SUBROUTINE histdef2d_old (iff,lpoint,flag_var,nomvar,titrevar,unitvar) |
||
473 |
|||
474 |
USE ioipsl, ONLY: histdef |
||
475 |
USE mod_phys_lmdz_para, ONLY: jj_nb, is_master |
||
476 |
USE phys_output_var_mod, ONLY: type_ecri, zoutm, zdtime_moy, lev_files, & |
||
477 |
nid_files, nhorim, swaero_diag, dryaod_diag, nfiles, & |
||
478 |
ok_4xCO2atm |
||
479 |
USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat |
||
480 |
USE aero_mod, ONLY : naero_tot, name_aero_tau |
||
481 |
USE print_control_mod, ONLY: prt_level,lunout |
||
482 |
|||
483 |
IMPLICIT NONE |
||
484 |
|||
485 |
INCLUDE "clesphys.h" |
||
486 |
|||
487 |
INTEGER :: iff |
||
488 |
INTEGER :: naero |
||
489 |
LOGICAL :: lpoint |
||
490 |
INTEGER, DIMENSION(nfiles) :: flag_var |
||
491 |
CHARACTER(LEN=20) :: nomvar |
||
492 |
CHARACTER(LEN=*) :: titrevar |
||
493 |
CHARACTER(LEN=*) :: unitvar |
||
494 |
|||
495 |
REAL zstophym |
||
496 |
|||
497 |
IF (type_ecri(iff)=='inst(X)'.OR.type_ecri(iff)=='once') THEN |
||
498 |
zstophym=zoutm(iff) |
||
499 |
ELSE |
||
500 |
zstophym=zdtime_moy |
||
501 |
ENDIF |
||
502 |
IF (check_dim .AND. is_master) WRITE(lunout,*)'histdef2d_old for ', nomvar |
||
503 |
! Appel a la lecture des noms et niveau d'ecriture des variables dans output.def |
||
504 |
CALL conf_physoutputs(nomvar,flag_var) |
||
505 |
|||
506 |
IF(.NOT.lpoint) THEN |
||
507 |
IF ( flag_var(iff)<=lev_files(iff) ) THEN |
||
508 |
CALL histdef (nid_files(iff),nomvar,titrevar,unitvar, & |
||
509 |
nbp_lon,jj_nb,nhorim(iff), 1,1,1, -99, 32, & |
||
510 |
type_ecri(iff), zstophym,zoutm(iff)) |
||
511 |
ENDIF |
||
512 |
ELSE |
||
513 |
IF ( flag_var(iff)<=lev_files(iff) ) THEN |
||
514 |
CALL histdef (nid_files(iff),nomvar,titrevar,unitvar, & |
||
515 |
npstn,1,nhorim(iff), 1,1,1, -99, 32, & |
||
516 |
type_ecri(iff), zstophym,zoutm(iff)) |
||
517 |
ENDIF |
||
518 |
ENDIF |
||
519 |
|||
520 |
! Set swaero_diag=true if at least one of the concerned variables are defined |
||
521 |
IF (nomvar=='topswad' .OR. nomvar=='topswad0' .OR. nomvar=='solswad' .OR. nomvar=='solswad0' .OR. & |
||
522 |
nomvar=='toplwad' .OR. nomvar=='toplwad0' .OR. nomvar=='sollwad' .OR. nomvar=='sollwad0' .OR. & |
||
523 |
nomvar=='topswai' .OR. nomvar=='solswai' ) THEN |
||
524 |
IF ( flag_var(iff)<=lev_files(iff) ) swaero_diag=.TRUE. |
||
525 |
ENDIF |
||
526 |
|||
527 |
! Set dryaod_diag=true if at least one of the concerned variables are defined |
||
528 |
IF (nomvar=='dryod550aer') THEN |
||
529 |
IF ( flag_var(iff)<=lev_files(iff) ) dryaod_diag=.TRUE. |
||
530 |
ENDIF |
||
531 |
DO naero = 1, naero_tot-1 |
||
532 |
IF (nomvar=='dryod550_'//name_aero_tau(naero)) THEN |
||
533 |
IF ( flag_var(iff)<=lev_files(iff) ) dryaod_diag=.TRUE. |
||
534 |
ENDIF |
||
535 |
ENDDO |
||
536 |
|||
537 |
! Set ok_4xCO2atm=true if at least one of the concerned variables are |
||
538 |
! defined |
||
539 |
IF (nomvar=='rsut4co2'.OR.nomvar=='rlut4co2'.OR.nomvar=='rsutcs4co2' & |
||
540 |
.OR. nomvar=='rlutcs4co2'.OR.nomvar=='rsu4co2'.OR.nomvar=='rsucs4co2' & |
||
541 |
.OR.nomvar=='rsu4co2'.OR.nomvar=='rsucs4co2'.OR.nomvar=='rsd4co2'.OR. & |
||
542 |
nomvar=='rsdcs4co2'.OR.nomvar=='rlu4co2'.OR.nomvar=='rlucs4co2'.OR.& |
||
543 |
nomvar=='rld4co2'.OR.nomvar=='rldcs4co2') THEN |
||
544 |
IF ( flag_var(iff)<=lev_files(iff) ) ok_4xCO2atm=.TRUE. |
||
545 |
ENDIF |
||
546 |
END SUBROUTINE histdef2d_old |
||
547 |
|||
548 |
SUBROUTINE histdef3d_old (iff,lpoint,flag_var,nomvar,titrevar,unitvar) |
||
549 |
|||
550 |
USE ioipsl, ONLY: histdef |
||
551 |
USE dimphy, ONLY: klev |
||
552 |
USE mod_phys_lmdz_para, ONLY: jj_nb, is_master |
||
553 |
USE phys_output_var_mod, ONLY: type_ecri, zoutm, lev_files, nid_files, & |
||
554 |
nhorim, zdtime_moy, levmin, levmax, & |
||
555 |
nvertm, nfiles |
||
556 |
USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat |
||
557 |
USE print_control_mod, ONLY: prt_level,lunout |
||
558 |
IMPLICIT NONE |
||
559 |
|||
560 |
INCLUDE "clesphys.h" |
||
561 |
|||
562 |
INTEGER :: iff |
||
563 |
LOGICAL :: lpoint |
||
564 |
INTEGER, DIMENSION(nfiles) :: flag_var |
||
565 |
CHARACTER(LEN=20) :: nomvar |
||
566 |
CHARACTER(LEN=*) :: titrevar |
||
567 |
CHARACTER(LEN=*) :: unitvar |
||
568 |
|||
569 |
REAL zstophym |
||
570 |
|||
571 |
! Appel a la lecture des noms et niveau d'ecriture des variables dans output.def |
||
572 |
CALL conf_physoutputs(nomvar,flag_var) |
||
573 |
|||
574 |
IF (check_dim .AND. is_master) WRITE(lunout,*)'histdef3d_old for ', nomvar |
||
575 |
|||
576 |
IF (type_ecri(iff)=='inst(X)'.OR.type_ecri(iff)=='once') THEN |
||
577 |
zstophym=zoutm(iff) |
||
578 |
ELSE |
||
579 |
zstophym=zdtime_moy |
||
580 |
ENDIF |
||
581 |
|||
582 |
IF(.NOT.lpoint) THEN |
||
583 |
IF ( flag_var(iff)<=lev_files(iff) ) THEN |
||
584 |
CALL histdef (nid_files(iff), nomvar, titrevar, unitvar, & |
||
585 |
nbp_lon, jj_nb, nhorim(iff), klev, levmin(iff), & |
||
586 |
levmax(iff)-levmin(iff)+1, nvertm(iff), 32, type_ecri(iff), & |
||
587 |
zstophym, zoutm(iff)) |
||
588 |
ENDIF |
||
589 |
ELSE |
||
590 |
IF ( flag_var(iff)<=lev_files(iff) ) THEN |
||
591 |
CALL histdef (nid_files(iff), nomvar, titrevar, unitvar, & |
||
592 |
npstn,1,nhorim(iff), klev, levmin(iff), & |
||
593 |
levmax(iff)-levmin(iff)+1, nvertm(iff), 32, & |
||
594 |
type_ecri(iff), zstophym,zoutm(iff)) |
||
595 |
ENDIF |
||
596 |
ENDIF |
||
597 |
END SUBROUTINE histdef3d_old |
||
598 |
|||
599 |
1524 |
SUBROUTINE histdef2d (iff,var) |
|
600 |
|||
601 |
USE ioipsl, ONLY: histdef |
||
602 |
USE mod_phys_lmdz_para, ONLY: jj_nb, is_master |
||
603 |
USE phys_output_var_mod, ONLY: ctrl_out, type_ecri_files, zoutm, zdtime_moy, & |
||
604 |
clef_stations, phys_out_filenames, lev_files, & |
||
605 |
nid_files, nhorim, swaerofree_diag, swaero_diag, dryaod_diag,& |
||
606 |
ok_4xCO2atm |
||
607 |
USE print_control_mod, ONLY: prt_level,lunout |
||
608 |
USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat |
||
609 |
USE aero_mod, ONLY : naero_tot, name_aero_tau |
||
610 |
#ifdef CPP_XIOS |
||
611 |
USE wxios, ONLY: wxios_add_field_to_file |
||
612 |
#endif |
||
613 |
USE print_control_mod, ONLY: prt_level,lunout |
||
614 |
IMPLICIT NONE |
||
615 |
|||
616 |
INCLUDE "clesphys.h" |
||
617 |
|||
618 |
INTEGER :: iff |
||
619 |
INTEGER :: naero |
||
620 |
TYPE(ctrl_out) :: var |
||
621 |
|||
622 |
REAL zstophym |
||
623 |
CHARACTER(LEN=20) :: typeecrit |
||
624 |
|||
625 |
✗✓✗✗ |
1524 |
IF (check_dim .AND. is_master) WRITE(lunout,*)'histdef2d for ', var%name |
626 |
|||
627 |
! ug On récupère le type écrit de la structure: |
||
628 |
! Assez moche, à refaire si meilleure méthode... |
||
629 |
✓✓ | 1524 |
IF (INDEX(var%type_ecrit(iff), "once") > 0) THEN |
630 |
8 |
typeecrit = 'once' |
|
631 |
✓✓ | 1516 |
ELSE IF(INDEX(var%type_ecrit(iff), "t_min") > 0) THEN |
632 |
4 |
typeecrit = 't_min(X)' |
|
633 |
✓✓ | 1512 |
ELSE IF(INDEX(var%type_ecrit(iff), "t_max") > 0) THEN |
634 |
12 |
typeecrit = 't_max(X)' |
|
635 |
✓✓ | 1500 |
ELSE IF(INDEX(var%type_ecrit(iff), "inst") > 0) THEN |
636 |
180 |
typeecrit = 'inst(X)' |
|
637 |
ELSE |
||
638 |
1320 |
typeecrit = type_ecri_files(iff) |
|
639 |
ENDIF |
||
640 |
|||
641 |
✓✓✓✓ |
1524 |
IF (typeecrit=='inst(X)'.OR.typeecrit=='once') THEN |
642 |
518 |
zstophym=zoutm(iff) |
|
643 |
ELSE |
||
644 |
1006 |
zstophym=zdtime_moy |
|
645 |
ENDIF |
||
646 |
|||
647 |
! Appel a la lecture des noms et niveau d'ecriture des variables dans output.def |
||
648 |
1524 |
CALL conf_physoutputs(var%name, var%flag) |
|
649 |
|||
650 |
✓✗ | 1524 |
IF(.NOT.clef_stations(iff)) THEN |
651 |
|||
652 |
#ifdef CPP_XIOS |
||
653 |
IF (.not. ok_all_xml) THEN |
||
654 |
IF ( var%flag(iff)<=lev_files(iff) ) THEN |
||
655 |
CALL wxios_add_field_to_file(var%name, 2, iff, phys_out_filenames(iff), & |
||
656 |
var%description, var%unit, var%flag(iff), typeecrit) |
||
657 |
IF (prt_level >= 10) THEN |
||
658 |
WRITE(lunout,*) 'histdef2d: call wxios_add_field_to_file var%name iff: ', & |
||
659 |
trim(var%name),iff |
||
660 |
ENDIF |
||
661 |
ENDIF |
||
662 |
ENDIF |
||
663 |
#endif |
||
664 |
#ifndef CPP_IOIPSL_NO_OUTPUT |
||
665 |
|||
666 |
✓✓ | 1524 |
IF ( var%flag(iff)<=lev_files(iff) ) THEN |
667 |
CALL histdef (nid_files(iff), var%name, var%description, var%unit, & |
||
668 |
nbp_lon,jj_nb,nhorim(iff), 1,1,1, -99, 32, & |
||
669 |
538 |
typeecrit, zstophym,zoutm(iff)) |
|
670 |
ENDIF |
||
671 |
ELSE |
||
672 |
IF ( var%flag(iff)<=lev_files(iff)) THEN |
||
673 |
CALL histdef (nid_files(iff), var%name, var%description, var%unit, & |
||
674 |
npstn,1,nhorim(iff), 1,1,1, -99, 32, & |
||
675 |
typeecrit, zstophym,zoutm(iff)) |
||
676 |
ENDIF |
||
677 |
#endif |
||
678 |
ENDIF |
||
679 |
|||
680 |
! Set swaero_diag=true if at least one of the concerned variables are defined |
||
681 |
!--OB 30/05/2016 use wider set of variables |
||
682 |
IF ( var%name=='topswad' .OR. var%name=='topswad0' .OR. var%name=='solswad' .OR. var%name=='solswad0' .OR. & |
||
683 |
✓✗✓✗ ✓✗✓✗ ✓✗✓✗ ✓✗✓✗ ✓✗✓✗ ✓✗✗✓ |
3048 |
var%name=='topswai' .OR. var%name=='solswai' .OR. ( iflag_rrtm==1 .AND. ( & |
684 |
var%name=='toplwad' .OR. var%name=='toplwad0' .OR. var%name=='sollwad' .OR. var%name=='sollwad0' .OR. & |
||
685 |
var%name=='toplwai' .OR. var%name=='sollwai' ) ) ) THEN |
||
686 |
IF ( var%flag(iff)<=lev_files(iff) ) swaero_diag=.TRUE. |
||
687 |
ENDIF |
||
688 |
|||
689 |
! Set swaerofree_diag=true if at least one of the concerned variables are defined |
||
690 |
IF (var%name=='SWupTOAcleanclr' .OR. var%name=='SWupSFCcleanclr' .OR. var%name=='SWdnSFCcleanclr' .OR. & |
||
691 |
✓✓✓✓ ✓✓✓✓ ✓✓ |
1524 |
var%name=='LWupTOAcleanclr' .OR. var%name=='LWdnSFCcleanclr' ) THEN |
692 |
✗✓ | 20 |
IF ( var%flag(iff)<=lev_files(iff) ) swaerofree_diag=.TRUE. |
693 |
ENDIF |
||
694 |
|||
695 |
! set dryaod_dry=true if at least one of the concerned variables are defined |
||
696 |
✗✓ | 1524 |
IF (var%name=='dryod550aer') THEN |
697 |
IF ( var%flag(iff)<=lev_files(iff) ) dryaod_diag=.TRUE. |
||
698 |
ENDIF |
||
699 |
! |
||
700 |
✓✓ | 21336 |
DO naero = 1, naero_tot-1 |
701 |
✗✓ | 21336 |
IF (var%name=='dryod550_'//name_aero_tau(naero)) THEN |
702 |
IF ( var%flag(iff)<=lev_files(iff) ) dryaod_diag=.TRUE. |
||
703 |
ENDIF |
||
704 |
ENDDO |
||
705 |
! Set ok_4xCO2atm=true if at least one of the concerned variables are |
||
706 |
! defined |
||
707 |
IF (var%name=='rsut4co2'.OR.var%name=='rlut4co2'.OR.var%name=='rsutcs4co2' & |
||
708 |
.OR. var%name=='rlutcs4co2'.OR.var%name=='rsu4co2'.OR.var%name=='rsucs4co2' & |
||
709 |
.OR.var%name=='rsu4co2'.OR.var%name=='rsucs4co2'.OR.var%name=='rsd4co2'.OR. & |
||
710 |
var%name=='rsdcs4co2'.OR.var%name=='rlu4co2'.OR.var%name=='rlucs4co2'.OR.& |
||
711 |
✓✗✓✗ ✓✗✓✗ ✓✗✓✗ ✓✗✓✗ ✓✗✓✗ ✓✗✗✓ |
1524 |
var%name=='rld4co2'.OR.var%name=='rldcs4co2') THEN |
712 |
IF ( var%flag(iff)<=lev_files(iff) ) ok_4xCO2atm=.TRUE. |
||
713 |
ENDIF |
||
714 |
1524 |
END SUBROUTINE histdef2d |
|
715 |
|||
716 |
808 |
SUBROUTINE histdef3d (iff,var) |
|
717 |
|||
718 |
✓✗ | 1524 |
USE ioipsl, ONLY: histdef |
719 |
USE dimphy, ONLY: klev |
||
720 |
USE mod_phys_lmdz_para, ONLY: jj_nb, is_master |
||
721 |
USE phys_output_var_mod, ONLY: ctrl_out, type_ecri_files, zoutm, zdtime_moy, & |
||
722 |
clef_stations, phys_out_filenames, lev_files, & |
||
723 |
nid_files, nhorim, swaerofree_diag, levmin, & |
||
724 |
levmax, nvertm |
||
725 |
USE print_control_mod, ONLY: prt_level,lunout |
||
726 |
USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat |
||
727 |
#ifdef CPP_XIOS |
||
728 |
USE wxios, ONLY: wxios_add_field_to_file |
||
729 |
#endif |
||
730 |
USE print_control_mod, ONLY: prt_level,lunout |
||
731 |
IMPLICIT NONE |
||
732 |
|||
733 |
INCLUDE "clesphys.h" |
||
734 |
|||
735 |
INTEGER :: iff |
||
736 |
TYPE(ctrl_out) :: var |
||
737 |
|||
738 |
REAL zstophym |
||
739 |
CHARACTER(LEN=20) :: typeecrit |
||
740 |
|||
741 |
✗✓✗✗ |
808 |
IF (check_dim .AND. is_master) WRITE(lunout,*)'histdef3d for ', var%name |
742 |
|||
743 |
! ug On récupère le type écrit de la structure: |
||
744 |
! Assez moche, à refaire si meilleure méthode... |
||
745 |
✗✓ | 808 |
IF (INDEX(var%type_ecrit(iff), "once") > 0) THEN |
746 |
typeecrit = 'once' |
||
747 |
✗✓ | 808 |
ELSE IF(INDEX(var%type_ecrit(iff), "t_min") > 0) THEN |
748 |
typeecrit = 't_min(X)' |
||
749 |
✓✓ | 808 |
ELSE IF(INDEX(var%type_ecrit(iff), "t_max") > 0) THEN |
750 |
24 |
typeecrit = 't_max(X)' |
|
751 |
✗✓ | 784 |
ELSE IF(INDEX(var%type_ecrit(iff), "inst") > 0) THEN |
752 |
typeecrit = 'inst(X)' |
||
753 |
ELSE |
||
754 |
784 |
typeecrit = type_ecri_files(iff) |
|
755 |
ENDIF |
||
756 |
|||
757 |
! Appel a la lecture des noms et niveau d'ecriture des variables dans output.def |
||
758 |
808 |
CALL conf_physoutputs(var%name,var%flag) |
|
759 |
|||
760 |
✓✓✗✓ |
808 |
IF (typeecrit=='inst(X)'.OR.typeecrit=='once') THEN |
761 |
196 |
zstophym=zoutm(iff) |
|
762 |
ELSE |
||
763 |
612 |
zstophym=zdtime_moy |
|
764 |
ENDIF |
||
765 |
|||
766 |
✓✗ | 808 |
IF(.NOT.clef_stations(iff)) THEN |
767 |
|||
768 |
#ifdef CPP_XIOS |
||
769 |
IF (.not. ok_all_xml) THEN |
||
770 |
IF ( var%flag(iff)<=lev_files(iff) ) THEN |
||
771 |
CALL wxios_add_field_to_file(var%name, 3, iff, phys_out_filenames(iff), & |
||
772 |
var%description, var%unit, var%flag(iff), typeecrit) |
||
773 |
IF (prt_level >= 10) THEN |
||
774 |
WRITE(lunout,*) 'histdef3d: call wxios_add_field_to_file var%name iff: ', & |
||
775 |
trim(var%name),iff |
||
776 |
ENDIF |
||
777 |
ENDIF |
||
778 |
ENDIF |
||
779 |
#endif |
||
780 |
#ifndef CPP_IOIPSL_NO_OUTPUT |
||
781 |
|||
782 |
✓✓ | 808 |
IF ( var%flag(iff)<=lev_files(iff) ) THEN |
783 |
CALL histdef (nid_files(iff), var%name, var%description, var%unit, & |
||
784 |
nbp_lon, jj_nb, nhorim(iff), klev, levmin(iff), & |
||
785 |
levmax(iff)-levmin(iff)+1, nvertm(iff), 32, typeecrit, & |
||
786 |
259 |
zstophym, zoutm(iff)) |
|
787 |
ENDIF |
||
788 |
ELSE |
||
789 |
IF ( var%flag(iff)<=lev_files(iff)) THEN |
||
790 |
CALL histdef (nid_files(iff), var%name, var%description, var%unit, & |
||
791 |
npstn,1,nhorim(iff), klev, levmin(iff), & |
||
792 |
levmax(iff)-levmin(iff)+1, nvertm(iff), 32, & |
||
793 |
typeecrit, zstophym,zoutm(iff)) |
||
794 |
ENDIF |
||
795 |
#endif |
||
796 |
ENDIF |
||
797 |
|||
798 |
! Set swaerofree_diag=true if at least one of the concerned variables are defined |
||
799 |
✓✓✓✓ |
808 |
IF (var%name=='rsucsaf' .OR. var%name=='rsdcsaf') THEN |
800 |
✓✓ | 8 |
IF ( var%flag(iff)<=lev_files(iff) ) swaerofree_diag=.TRUE. |
801 |
ENDIF |
||
802 |
|||
803 |
808 |
END SUBROUTINE histdef3d |
|
804 |
|||
805 |
2332 |
SUBROUTINE conf_physoutputs(nam_var,flag_var) |
|
806 |
!!! Lecture des noms et niveau de sortie des variables dans output.def |
||
807 |
! en utilisant les routines getin de IOIPSL |
||
808 |
USE ioipsl, ONLY: getin |
||
809 |
USE phys_output_var_mod, ONLY: nfiles |
||
810 |
USE print_control_mod, ONLY: prt_level,lunout |
||
811 |
IMPLICIT NONE |
||
812 |
|||
813 |
CHARACTER(LEN=*), INTENT(INOUT) :: nam_var |
||
814 |
INTEGER, INTENT(INOUT) :: flag_var(nfiles) |
||
815 |
|||
816 |
✗✓ | 2332 |
IF(prt_level>10) WRITE(lunout,*)'Avant getin: nam_var flag_var ',nam_var,flag_var(:) |
817 |
2332 |
CALL getin('flag_'//nam_var,flag_var) |
|
818 |
2332 |
CALL getin('name_'//nam_var,nam_var) |
|
819 |
✗✓ | 2332 |
IF(prt_level>10) WRITE(lunout,*)'Apres getin: nam_var flag_var ',nam_var,flag_var(:) |
820 |
|||
821 |
2332 |
END SUBROUTINE conf_physoutputs |
|
822 |
|||
823 |
|||
824 |
SUBROUTINE histwrite2d_phy_old(nid,lpoint,name,itau,field) |
||
825 |
|||
826 |
USE dimphy, ONLY: klon |
||
827 |
USE mod_phys_lmdz_para, ONLY: Gather_omp, grid1Dto2D_mpi, & |
||
828 |
is_sequential, klon_mpi_begin, klon_mpi_end, & |
||
829 |
jj_nb, klon_mpi, is_master |
||
830 |
USE ioipsl, ONLY: histwrite |
||
831 |
USE print_control_mod, ONLY: prt_level,lunout |
||
832 |
USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat |
||
833 |
|||
834 |
IMPLICIT NONE |
||
835 |
|||
836 |
INTEGER,INTENT(IN) :: nid |
||
837 |
LOGICAL,INTENT(IN) :: lpoint |
||
838 |
CHARACTER*(*), INTENT(IN) :: name |
||
839 |
INTEGER, INTENT(IN) :: itau |
||
840 |
REAL,DIMENSION(:),INTENT(IN) :: field |
||
841 |
REAL,DIMENSION(klon_mpi) :: buffer_omp |
||
842 |
INTEGER, allocatable, DIMENSION(:) :: index2d |
||
843 |
REAL :: Field2d(nbp_lon,jj_nb) |
||
844 |
|||
845 |
INTEGER :: ip |
||
846 |
REAL,ALLOCATABLE,DIMENSION(:) :: fieldok |
||
847 |
|||
848 |
IF (size(field)/=klon) CALL abort_physic('iophy::histwrite2d','Field first DIMENSION not equal to klon',1) |
||
849 |
IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite2d_phy_old for ', name |
||
850 |
|||
851 |
CALL Gather_omp(field,buffer_omp) |
||
852 |
!$OMP MASTER |
||
853 |
CALL grid1Dto2D_mpi(buffer_omp,Field2d) |
||
854 |
IF (.NOT.lpoint) THEN |
||
855 |
ALLOCATE(index2d(nbp_lon*jj_nb)) |
||
856 |
ALLOCATE(fieldok(nbp_lon*jj_nb)) |
||
857 |
IF (prt_level >= 10) write(lunout,*)'Sending ',name,' to IOIPSL' |
||
858 |
CALL histwrite(nid,name,itau,Field2d,nbp_lon*jj_nb,index2d) |
||
859 |
IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL' |
||
860 |
ELSE |
||
861 |
ALLOCATE(fieldok(npstn)) |
||
862 |
ALLOCATE(index2d(npstn)) |
||
863 |
|||
864 |
IF (is_sequential) THEN |
||
865 |
! klon_mpi_begin=1 |
||
866 |
! klon_mpi_end=klon |
||
867 |
DO ip=1, npstn |
||
868 |
fieldok(ip)=buffer_omp(nptabij(ip)) |
||
869 |
ENDDO |
||
870 |
ELSE |
||
871 |
DO ip=1, npstn |
||
872 |
! print*,'histwrite2d is_sequential npstn ip name nptabij',npstn,ip,name,nptabij(ip) |
||
873 |
IF(nptabij(ip).GE.klon_mpi_begin.AND. & |
||
874 |
nptabij(ip).LE.klon_mpi_end) THEN |
||
875 |
fieldok(ip)=buffer_omp(nptabij(ip)-klon_mpi_begin+1) |
||
876 |
ENDIF |
||
877 |
ENDDO |
||
878 |
ENDIF |
||
879 |
IF (prt_level >= 10) write(lunout,*)'Sending ',name,' to IOIPSL' |
||
880 |
CALL histwrite(nid,name,itau,fieldok,npstn,index2d) |
||
881 |
IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL' |
||
882 |
! |
||
883 |
ENDIF |
||
884 |
DEALLOCATE(index2d) |
||
885 |
DEALLOCATE(fieldok) |
||
886 |
!$OMP END MASTER |
||
887 |
|||
888 |
|||
889 |
END SUBROUTINE histwrite2d_phy_old |
||
890 |
|||
891 |
SUBROUTINE histwrite3d_phy_old(nid,lpoint,name,itau,field) |
||
892 |
|||
893 |
USE dimphy, ONLY: klon |
||
894 |
USE mod_phys_lmdz_para, ONLY: Gather_omp, grid1Dto2D_mpi, & |
||
895 |
is_sequential, klon_mpi_begin, klon_mpi_end, & |
||
896 |
jj_nb, klon_mpi, is_master |
||
897 |
USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat |
||
898 |
USE ioipsl, ONLY: histwrite |
||
899 |
USE print_control_mod, ONLY: prt_level,lunout |
||
900 |
|||
901 |
IMPLICIT NONE |
||
902 |
|||
903 |
INTEGER,INTENT(IN) :: nid |
||
904 |
LOGICAL,INTENT(IN) :: lpoint |
||
905 |
CHARACTER*(*), INTENT(IN) :: name |
||
906 |
INTEGER, INTENT(IN) :: itau |
||
907 |
REAL,DIMENSION(:,:),INTENT(IN) :: field ! --> field(klon,:) |
||
908 |
REAL,DIMENSION(klon_mpi,size(field,2)) :: buffer_omp |
||
909 |
REAL :: Field3d(nbp_lon,jj_nb,size(field,2)) |
||
910 |
INTEGER :: ip, n, nlev |
||
911 |
INTEGER, ALLOCATABLE, DIMENSION(:) :: index3d |
||
912 |
REAL,allocatable, DIMENSION(:,:) :: fieldok |
||
913 |
|||
914 |
IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite3d_phy_old for ', name |
||
915 |
|||
916 |
IF (size(field,1)/=klon) CALL abort_physic('iophy::histwrite3d','Field first DIMENSION not equal to klon',1) |
||
917 |
nlev=size(field,2) |
||
918 |
|||
919 |
CALL Gather_omp(field,buffer_omp) |
||
920 |
!$OMP MASTER |
||
921 |
CALL grid1Dto2D_mpi(buffer_omp,field3d) |
||
922 |
IF (.NOT.lpoint) THEN |
||
923 |
ALLOCATE(index3d(nbp_lon*jj_nb*nlev)) |
||
924 |
ALLOCATE(fieldok(nbp_lon*jj_nb,nlev)) |
||
925 |
IF (prt_level >= 10) write(lunout,*)'Sending ',name,' to IOIPSL' |
||
926 |
CALL histwrite(nid,name,itau,Field3d,nbp_lon*jj_nb*nlev,index3d) |
||
927 |
IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL' |
||
928 |
ELSE |
||
929 |
nlev=size(field,2) |
||
930 |
ALLOCATE(index3d(npstn*nlev)) |
||
931 |
ALLOCATE(fieldok(npstn,nlev)) |
||
932 |
|||
933 |
IF (is_sequential) THEN |
||
934 |
! klon_mpi_begin=1 |
||
935 |
! klon_mpi_end=klon |
||
936 |
DO n=1, nlev |
||
937 |
DO ip=1, npstn |
||
938 |
fieldok(ip,n)=buffer_omp(nptabij(ip),n) |
||
939 |
ENDDO |
||
940 |
ENDDO |
||
941 |
ELSE |
||
942 |
DO n=1, nlev |
||
943 |
DO ip=1, npstn |
||
944 |
IF(nptabij(ip).GE.klon_mpi_begin.AND. & |
||
945 |
nptabij(ip).LE.klon_mpi_end) THEN |
||
946 |
fieldok(ip,n)=buffer_omp(nptabij(ip)-klon_mpi_begin+1,n) |
||
947 |
ENDIF |
||
948 |
ENDDO |
||
949 |
ENDDO |
||
950 |
ENDIF |
||
951 |
IF (prt_level >= 10) write(lunout,*)'Sending ',name,' to IOIPSL' |
||
952 |
CALL histwrite(nid,name,itau,fieldok,npstn*nlev,index3d) |
||
953 |
IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL' |
||
954 |
ENDIF |
||
955 |
DEALLOCATE(index3d) |
||
956 |
DEALLOCATE(fieldok) |
||
957 |
!$OMP END MASTER |
||
958 |
|||
959 |
END SUBROUTINE histwrite3d_phy_old |
||
960 |
|||
961 |
|||
962 |
! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE |
||
963 |
✗✓ | 219351 |
SUBROUTINE histwrite2d_phy(var,field, STD_iff) |
964 |
|||
965 |
USE mod_phys_lmdz_omp_transfert, ONLY: bcast_omp |
||
966 |
USE dimphy, ONLY: klon, klev |
||
967 |
USE mod_phys_lmdz_para, ONLY: gather_omp, grid1dto2d_mpi, & |
||
968 |
jj_nb, klon_mpi, klon_mpi_begin, & |
||
969 |
klon_mpi_end, is_sequential, is_master |
||
970 |
USE ioipsl, ONLY: histwrite |
||
971 |
USE phys_output_var_mod, ONLY: ctrl_out, clef_files, lev_files, & |
||
972 |
nfiles, vars_defined, clef_stations, & |
||
973 |
nid_files, swaerofree_diag, swaero_diag, dryaod_diag, ok_4xCO2atm |
||
974 |
USE print_control_mod, ONLY: prt_level,lunout |
||
975 |
USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid_type, unstructured, regular_lonlat |
||
976 |
#ifdef CPP_XIOS |
||
977 |
USE xios, ONLY: xios_send_field, xios_field_is_active |
||
978 |
#endif |
||
979 |
USE print_control_mod, ONLY: lunout, prt_level |
||
980 |
|||
981 |
IMPLICIT NONE |
||
982 |
INCLUDE 'clesphys.h' |
||
983 |
|||
984 |
TYPE(ctrl_out), INTENT(IN) :: var |
||
985 |
REAL, DIMENSION(:), INTENT(IN) :: field |
||
986 |
INTEGER, INTENT(IN), OPTIONAL :: STD_iff ! ug RUSTINE POUR LES STD LEVS..... |
||
987 |
|||
988 |
INTEGER :: iff, iff_beg, iff_end |
||
989 |
LOGICAL, SAVE :: firstx |
||
990 |
!$OMP THREADPRIVATE(firstx) |
||
991 |
|||
992 |
438702 |
REAL,DIMENSION(klon_mpi) :: buffer_omp |
|
993 |
INTEGER, allocatable, DIMENSION(:) :: index2d |
||
994 |
438702 |
REAL :: Field2d(nbp_lon,jj_nb) |
|
995 |
|||
996 |
INTEGER :: ip |
||
997 |
219351 |
REAL, ALLOCATABLE, DIMENSION(:) :: fieldok |
|
998 |
logical, save :: is_active = .true. |
||
999 |
|||
1000 |
✗✓✗✗ |
219351 |
IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite2d_phy for ',trim(var%name) |
1001 |
|||
1002 |
✗✓ | 219351 |
IF (prt_level >= 10) THEN |
1003 |
WRITE(lunout,*)'Begin histwrite2d_phy for ',trim(var%name) |
||
1004 |
ENDIF |
||
1005 |
|||
1006 |
! ug RUSTINE POUR LES STD LEVS..... |
||
1007 |
✓✓ | 219351 |
IF (PRESENT(STD_iff)) THEN |
1008 |
121380 |
iff_beg = STD_iff |
|
1009 |
iff_end = STD_iff |
||
1010 |
ELSE |
||
1011 |
iff_beg = 1 |
||
1012 |
iff_end = nfiles |
||
1013 |
ENDIF |
||
1014 |
|||
1015 |
! On regarde si on est dans la phase de définition ou d'écriture: |
||
1016 |
✓✓ | 219351 |
IF (.NOT.vars_defined) THEN |
1017 |
!$OMP MASTER |
||
1018 |
!Si phase de définition.... on définit |
||
1019 |
759 |
IF (.not. ok_all_xml) THEN |
|
1020 |
✗✓ | 759 |
IF (prt_level >= 10) THEN |
1021 |
write(lunout,*)"histwrite2d_phy: .not.vars_defined ; time to define ", & |
||
1022 |
trim(var%name) |
||
1023 |
ENDIF |
||
1024 |
✓✓ | 4569 |
DO iff=iff_beg, iff_end |
1025 |
✓✓ | 4569 |
IF (clef_files(iff)) THEN |
1026 |
1524 |
CALL histdef2d(iff, var) |
|
1027 |
ENDIF |
||
1028 |
ENDDO |
||
1029 |
ENDIF |
||
1030 |
!$OMP END MASTER |
||
1031 |
!--broadcasting the flags that have been changed in histdef2d on OMP masters |
||
1032 |
759 |
CALL bcast_omp(swaero_diag) |
|
1033 |
759 |
CALL bcast_omp(swaerofree_diag) |
|
1034 |
759 |
CALL bcast_omp(dryaod_diag) |
|
1035 |
759 |
CALL bcast_omp(ok_4xCO2atm) |
|
1036 |
|||
1037 |
ELSE |
||
1038 |
#ifdef CPP_XIOS |
||
1039 |
IF (ok_all_xml) THEN |
||
1040 |
!$omp barrier |
||
1041 |
!$omp master |
||
1042 |
is_active = xios_field_is_active(var%name, at_current_timestep_arg=.false.) |
||
1043 |
!$omp end master |
||
1044 |
!$omp barrier |
||
1045 |
IF(.not. is_active) RETURN |
||
1046 |
ENDIF |
||
1047 |
#endif |
||
1048 |
|||
1049 |
!Et sinon on.... écrit |
||
1050 |
IF (SIZE(field)/=klon .AND. SIZE(field)/=klev .AND. SIZE(field)/=klev+1) & |
||
1051 |
CALL abort_physic('iophy::histwrite2d_phy',& |
||
1052 |
✗✓ | 218592 |
'Field first DIMENSION not equal to klon/klev',1) |
1053 |
✗✓ | 218592 |
IF (prt_level >= 10) THEn |
1054 |
WRITE (lunout,*)"histwrite2d_phy: .not.vars_defined ; time to gather and write ", trim(var%name) |
||
1055 |
ENDIF |
||
1056 |
|||
1057 |
|||
1058 |
✓✗ | 218592 |
IF (SIZE(field) == klon) then |
1059 |
218592 |
CALL Gather_omp(field,buffer_omp) |
|
1060 |
ELSE |
||
1061 |
buffer_omp(:)=0. |
||
1062 |
ENDIF |
||
1063 |
!$OMP MASTER |
||
1064 |
✓✗ | 218592 |
IF (grid_type==regular_lonlat) CALL grid1Dto2D_mpi(buffer_omp,Field2d) |
1065 |
|||
1066 |
! La boucle sur les fichiers: |
||
1067 |
218592 |
firstx=.true. |
|
1068 |
|||
1069 |
218592 |
IF (ok_all_xml) THEN |
|
1070 |
#ifdef CPP_XIOS |
||
1071 |
IF (prt_level >= 10) THEN |
||
1072 |
write(lunout,*)'Dans iophy histwrite2D,var%name ', trim(var%name) |
||
1073 |
ENDIF |
||
1074 |
|||
1075 |
IF (grid_type==regular_lonlat) THEN |
||
1076 |
IF (SIZE(field) == klon) then |
||
1077 |
CALL xios_send_field(var%name, Field2d) |
||
1078 |
ELSE |
||
1079 |
CALL xios_send_field(var%name, field) |
||
1080 |
ENDIF |
||
1081 |
ELSE IF (grid_type==unstructured) THEN |
||
1082 |
IF (SIZE(field) == klon) then |
||
1083 |
CALL xios_send_field(var%name, buffer_omp) |
||
1084 |
ELSE |
||
1085 |
CALL xios_send_field(var%name, field) |
||
1086 |
ENDIF |
||
1087 |
|||
1088 |
ENDIF |
||
1089 |
IF (prt_level >= 10) THEN |
||
1090 |
write(lunout,*)'Dans iophy histwrite2D,var%name apres xios_send ',& |
||
1091 |
trim(var%name) |
||
1092 |
ENDIF |
||
1093 |
#else |
||
1094 |
CALL abort_physic ('iophy','cannot have ok_all_xml = .T. without CPP_XIOS defined' ,1) |
||
1095 |
#endif |
||
1096 |
ELSE |
||
1097 |
✓✓ | 1315872 |
DO iff=iff_beg, iff_end |
1098 |
✓✓✓✓ |
1315872 |
IF (var%flag(iff) <= lev_files(iff) .AND. clef_files(iff)) THEN |
1099 |
|||
1100 |
#ifdef CPP_XIOS |
||
1101 |
IF (firstx) THEN |
||
1102 |
IF (prt_level >= 10) THEN |
||
1103 |
write(lunout,*)'Dans iophy histwrite2D,iff,var%name ',& |
||
1104 |
iff,trim(var%name) |
||
1105 |
write(lunout,*)"histwrite2d_phy:.NOT.clef_stations(iff)and iff==iff_beg, call xios_send_field" |
||
1106 |
ENDIF |
||
1107 |
IF (grid_type==regular_lonlat) THEN |
||
1108 |
IF (SIZE(field) == klon) then |
||
1109 |
CALL xios_send_field(var%name, Field2d) |
||
1110 |
ELSE |
||
1111 |
CALL xios_send_field(var%name, field) |
||
1112 |
ENDIF |
||
1113 |
ELSE IF (grid_type==unstructured) THEN |
||
1114 |
IF (SIZE(field) == klon) then |
||
1115 |
CALL xios_send_field(var%name, buffer_omp) |
||
1116 |
ELSE |
||
1117 |
CALL xios_send_field(var%name, field) |
||
1118 |
ENDIF |
||
1119 |
ENDIF |
||
1120 |
|||
1121 |
firstx=.false. |
||
1122 |
ENDIF |
||
1123 |
#endif |
||
1124 |
|||
1125 |
✓✗ | 154944 |
IF (.NOT.clef_stations(iff)) THEN |
1126 |
✓✗✗✓ |
154944 |
ALLOCATE(index2d(nbp_lon*jj_nb)) |
1127 |
✓✗✗✓ ✗✓ |
154944 |
ALLOCATE(fieldok(nbp_lon*jj_nb)) |
1128 |
#ifndef CPP_IOIPSL_NO_OUTPUT |
||
1129 |
154944 |
CALL histwrite(nid_files(iff),var%name,itau_iophy,Field2d,nbp_lon*jj_nb,index2d) |
|
1130 |
#endif |
||
1131 |
!#ifdef CPP_XIOS |
||
1132 |
! IF (iff == iff_beg) THEN |
||
1133 |
! IF (prt_level >= 10) THEN |
||
1134 |
! write(lunout,*)"histwrite2d_phy: .NOT.clef_stations(iff) and iff==iff_beg, call xios_send_field" |
||
1135 |
! ENDIF |
||
1136 |
! CALL xios_send_field(var%name, Field2d) |
||
1137 |
! ENDIF |
||
1138 |
!#endif |
||
1139 |
ELSE |
||
1140 |
ALLOCATE(fieldok(npstn)) |
||
1141 |
ALLOCATE(index2d(npstn)) |
||
1142 |
|||
1143 |
IF (is_sequential) THEN |
||
1144 |
DO ip=1, npstn |
||
1145 |
fieldok(ip)=buffer_omp(nptabij(ip)) |
||
1146 |
ENDDO |
||
1147 |
ELSE |
||
1148 |
DO ip=1, npstn |
||
1149 |
write(lunout,*)'histwrite2d_phy is_sequential npstn ip namenptabij',npstn,ip,var%name,nptabij(ip) |
||
1150 |
IF(nptabij(ip).GE.klon_mpi_begin.AND. & |
||
1151 |
nptabij(ip).LE.klon_mpi_end) THEN |
||
1152 |
fieldok(ip)=buffer_omp(nptabij(ip)-klon_mpi_begin+1) |
||
1153 |
ENDIF |
||
1154 |
ENDDO |
||
1155 |
ENDIF ! of IF (is_sequential) |
||
1156 |
#ifndef CPP_IOIPSL_NO_OUTPUT |
||
1157 |
IF (prt_level >= 10) THEN |
||
1158 |
write(lunout,*)"histwrite2d_phy: clef_stations(iff) and iff==iff_beg, call wxios_write_2D" |
||
1159 |
ENDIF |
||
1160 |
CALL histwrite(nid_files(iff),var%name,itau_iophy,fieldok,npstn,index2d) |
||
1161 |
#endif |
||
1162 |
ENDIF ! of IF(.NOT.clef_stations(iff)) |
||
1163 |
|||
1164 |
✗✓ | 154944 |
DEALLOCATE(index2d) |
1165 |
✗✓ | 154944 |
DEALLOCATE(fieldok) |
1166 |
ENDIF !levfiles |
||
1167 |
ENDDO ! of DO iff=iff_beg, iff_end |
||
1168 |
ENDIF |
||
1169 |
!$OMP END MASTER |
||
1170 |
ENDIF ! vars_defined |
||
1171 |
|||
1172 |
✗✓ | 219351 |
IF (prt_level >= 10) WRITE(lunout,*)'End histwrite2d_phy ',trim(var%name) |
1173 |
|||
1174 |
✗✓ | 219351 |
END SUBROUTINE histwrite2d_phy |
1175 |
|||
1176 |
|||
1177 |
! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE |
||
1178 |
✗✓ | 74851 |
SUBROUTINE histwrite3d_phy(var, field, STD_iff) |
1179 |
|||
1180 |
✓✗✗✓ |
219351 |
USE mod_phys_lmdz_omp_transfert, ONLY: bcast_omp |
1181 |
USE dimphy, ONLY: klon, klev |
||
1182 |
USE mod_phys_lmdz_para, ONLY: gather_omp, grid1dto2d_mpi, & |
||
1183 |
jj_nb, klon_mpi, klon_mpi_begin, & |
||
1184 |
klon_mpi_end, is_sequential, is_master |
||
1185 |
USE ioipsl, ONLY: histwrite |
||
1186 |
USE phys_output_var_mod, ONLY: ctrl_out, clef_files, lev_files, & |
||
1187 |
nfiles, vars_defined, clef_stations, & |
||
1188 |
nid_files, swaerofree_diag |
||
1189 |
USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid_type, regular_lonlat, unstructured |
||
1190 |
#ifdef CPP_XIOS |
||
1191 |
USE xios, ONLY: xios_send_field, xios_field_is_active |
||
1192 |
#endif |
||
1193 |
USE print_control_mod, ONLY: prt_level,lunout |
||
1194 |
|||
1195 |
IMPLICIT NONE |
||
1196 |
INCLUDE 'clesphys.h' |
||
1197 |
|||
1198 |
TYPE(ctrl_out), INTENT(IN) :: var |
||
1199 |
REAL, DIMENSION(:,:), INTENT(IN) :: field ! --> field(klon,:) |
||
1200 |
INTEGER, INTENT(IN), OPTIONAL :: STD_iff ! ug RUSTINE POUR LES STD LEVS..... |
||
1201 |
|||
1202 |
INTEGER :: iff, iff_beg, iff_end |
||
1203 |
LOGICAL, SAVE :: firstx |
||
1204 |
!$OMP THREADPRIVATE(firstx) |
||
1205 |
149702 |
REAL,DIMENSION(klon_mpi,SIZE(field,2)) :: buffer_omp |
|
1206 |
149702 |
REAL :: Field3d(nbp_lon,jj_nb,SIZE(field,2)) |
|
1207 |
INTEGER :: ip, n, nlev, nlevx |
||
1208 |
INTEGER, ALLOCATABLE, DIMENSION(:) :: index3d |
||
1209 |
74851 |
REAL,ALLOCATABLE, DIMENSION(:,:) :: fieldok |
|
1210 |
logical, save :: is_active = .true. |
||
1211 |
|||
1212 |
✗✓✗✗ |
74851 |
IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite3d_phy for ', trim(var%name) |
1213 |
|||
1214 |
✗✓ | 74851 |
IF (prt_level >= 10) write(lunout,*)'Begin histrwrite3d ',var%name |
1215 |
|||
1216 |
! ug RUSTINE POUR LES STD LEVS..... |
||
1217 |
✓✓ | 74851 |
IF (PRESENT(STD_iff)) THEN |
1218 |
16473 |
iff_beg = STD_iff |
|
1219 |
iff_end = STD_iff |
||
1220 |
ELSE |
||
1221 |
iff_beg = 1 |
||
1222 |
iff_end = nfiles |
||
1223 |
ENDIF |
||
1224 |
|||
1225 |
! On regarde si on est dans la phase de définition ou d'écriture: |
||
1226 |
✓✓ | 74851 |
IF (.NOT.vars_defined) THEN |
1227 |
!Si phase de définition.... on définit |
||
1228 |
!$OMP MASTER |
||
1229 |
✓✓ | 2336 |
DO iff=iff_beg, iff_end |
1230 |
✓✓ | 2336 |
IF (clef_files(iff)) THEN |
1231 |
808 |
CALL histdef3d(iff, var) |
|
1232 |
ENDIF |
||
1233 |
ENDDO |
||
1234 |
!$OMP END MASTER |
||
1235 |
!--broadcasting the flag that have been changed in histdef3d on OMP masters |
||
1236 |
259 |
CALL bcast_omp(swaerofree_diag) |
|
1237 |
ELSE |
||
1238 |
#ifdef CPP_XIOS |
||
1239 |
IF (ok_all_xml) THEN |
||
1240 |
!$omp barrier |
||
1241 |
!$omp master |
||
1242 |
is_active = xios_field_is_active(var%name, at_current_timestep_arg=.false.) |
||
1243 |
!$omp end master |
||
1244 |
!$omp barrier |
||
1245 |
IF(.not. is_active) RETURN |
||
1246 |
ENDIF |
||
1247 |
#endif |
||
1248 |
|||
1249 |
!Et sinon on.... écrit |
||
1250 |
IF (SIZE(field,1)/=klon .AND. SIZE(field,1)/=klev & |
||
1251 |
.AND. SIZE(field,1)/=klev+1) & |
||
1252 |
CALL abort_physic('iophy::histwrite3d_phy', & |
||
1253 |
✗✓ | 74592 |
'Field first DIMENSION not equal to klon/klev',1) |
1254 |
|||
1255 |
nlev=SIZE(field,2) |
||
1256 |
nlevx=nlev |
||
1257 |
! IF (nlev.EQ.klev+1) THEN |
||
1258 |
! nlevx=klev |
||
1259 |
! ELSE |
||
1260 |
! nlevx=nlev |
||
1261 |
! ENDIF |
||
1262 |
|||
1263 |
✓✗ | 74592 |
IF (SIZE(field,1) == klon) then |
1264 |
74592 |
CALL Gather_omp(field,buffer_omp) |
|
1265 |
ELSE |
||
1266 |
buffer_omp(:,:)=0. |
||
1267 |
ENDIF |
||
1268 |
!$OMP MASTER |
||
1269 |
✓✗ | 74592 |
IF (grid_type==regular_lonlat) CALL grid1Dto2D_mpi(buffer_omp,field3d) |
1270 |
|||
1271 |
! BOUCLE SUR LES FICHIERS |
||
1272 |
74592 |
firstx=.true. |
|
1273 |
|||
1274 |
✗✓ | 74592 |
IF (ok_all_xml) THEN |
1275 |
#ifdef CPP_XIOS |
||
1276 |
IF (prt_level >= 10) THEN |
||
1277 |
write(lunout,*)'Dans iophy histwrite3D,var%name ',& |
||
1278 |
trim(var%name) |
||
1279 |
ENDIF |
||
1280 |
IF (grid_type==regular_lonlat) THEN |
||
1281 |
IF (SIZE(field,1) == klon) then |
||
1282 |
CALL xios_send_field(var%name, Field3d(:,:,1:nlevx)) |
||
1283 |
ELSE |
||
1284 |
CALL xios_send_field(var%name, field) |
||
1285 |
ENDIF |
||
1286 |
ELSE IF (grid_type==unstructured) THEN |
||
1287 |
IF (SIZE(field,1) == klon) then |
||
1288 |
CALL xios_send_field(var%name, buffer_omp(:,1:nlevx)) |
||
1289 |
ELSE |
||
1290 |
CALL xios_send_field(var%name, field) |
||
1291 |
ENDIF |
||
1292 |
ENDIF |
||
1293 |
|||
1294 |
#else |
||
1295 |
CALL abort_physic ('iophy','cannot have ok_all_xml = .T. without CPP_XIOS defined' ,1) |
||
1296 |
#endif |
||
1297 |
ELSE |
||
1298 |
|||
1299 |
✓✓ | 672768 |
DO iff=iff_beg, iff_end |
1300 |
✓✓✓✓ |
672768 |
IF (var%flag(iff) <= lev_files(iff) .AND. clef_files(iff)) THEN |
1301 |
#ifdef CPP_XIOS |
||
1302 |
IF (firstx) THEN |
||
1303 |
IF (prt_level >= 10) THEN |
||
1304 |
write(lunout,*)'Dans iophy, histwrite3D iff nlev klev firstx', & |
||
1305 |
iff,nlev,klev, firstx |
||
1306 |
write(lunout,*)'histwrite3d_phy: call xios_send_field for ', & |
||
1307 |
trim(var%name), ' with iim jjm nlevx = ', & |
||
1308 |
nbp_lon,jj_nb,nlevx |
||
1309 |
ENDIF |
||
1310 |
IF (grid_type==regular_lonlat) THEN |
||
1311 |
IF (SIZE(field,1) == klon) then |
||
1312 |
CALL xios_send_field(var%name, Field3d(:,:,1:nlevx)) |
||
1313 |
ELSE |
||
1314 |
CALL xios_send_field(var%name, field) |
||
1315 |
ENDIF |
||
1316 |
ELSE IF (grid_type==unstructured) THEN |
||
1317 |
IF (SIZE(field,1) == klon) then |
||
1318 |
CALL xios_send_field(var%name, buffer_omp(:,1:nlevx)) |
||
1319 |
ELSE |
||
1320 |
CALL xios_send_field(var%name, field) |
||
1321 |
ENDIF |
||
1322 |
ENDIF |
||
1323 |
|||
1324 |
firstx=.false. |
||
1325 |
ENDIF |
||
1326 |
#endif |
||
1327 |
✓✗ | 74592 |
IF (.NOT.clef_stations(iff)) THEN |
1328 |
✓✗✗✓ |
74592 |
ALLOCATE(index3d(nbp_lon*jj_nb*nlev)) |
1329 |
✓✗✓✗ ✗✓✗✓ ✗✓ |
149184 |
ALLOCATE(fieldok(nbp_lon*jj_nb,nlev)) |
1330 |
|||
1331 |
#ifndef CPP_IOIPSL_NO_OUTPUT |
||
1332 |
74592 |
CALL histwrite(nid_files(iff),var%name,itau_iophy,Field3d,nbp_lon*jj_nb*nlev,index3d) |
|
1333 |
#endif |
||
1334 |
|||
1335 |
!#ifdef CPP_XIOS |
||
1336 |
! IF (iff == 1) THEN |
||
1337 |
! CALL xios_send_field(var%name, Field3d(:,:,1:klev)) |
||
1338 |
! ENDIF |
||
1339 |
!#endif |
||
1340 |
! |
||
1341 |
ELSE |
||
1342 |
nlev=size(field,2) |
||
1343 |
ALLOCATE(index3d(npstn*nlev)) |
||
1344 |
ALLOCATE(fieldok(npstn,nlev)) |
||
1345 |
|||
1346 |
IF (is_sequential) THEN |
||
1347 |
DO n=1, nlev |
||
1348 |
DO ip=1, npstn |
||
1349 |
fieldok(ip,n)=buffer_omp(nptabij(ip),n) |
||
1350 |
ENDDO |
||
1351 |
ENDDO |
||
1352 |
ELSE |
||
1353 |
DO n=1, nlev |
||
1354 |
DO ip=1, npstn |
||
1355 |
IF(nptabij(ip).GE.klon_mpi_begin.AND. & |
||
1356 |
nptabij(ip).LE.klon_mpi_end) THEN |
||
1357 |
fieldok(ip,n)=buffer_omp(nptabij(ip)-klon_mpi_begin+1,n) |
||
1358 |
ENDIF |
||
1359 |
ENDDO |
||
1360 |
ENDDO |
||
1361 |
ENDIF |
||
1362 |
#ifndef CPP_IOIPSL_NO_OUTPUT |
||
1363 |
CALL histwrite(nid_files(iff),var%name,itau_iophy,fieldok,npstn*nlev,index3d) |
||
1364 |
#endif |
||
1365 |
ENDIF |
||
1366 |
✗✓ | 74592 |
DEALLOCATE(index3d) |
1367 |
✗✓ | 74592 |
DEALLOCATE(fieldok) |
1368 |
ENDIF |
||
1369 |
ENDDO |
||
1370 |
ENDIF |
||
1371 |
!$OMP END MASTER |
||
1372 |
ENDIF ! vars_defined |
||
1373 |
|||
1374 |
✗✓ | 74851 |
IF (prt_level >= 10) write(lunout,*)'End histrwrite3d ',var%name |
1375 |
|||
1376 |
✗✓ | 74851 |
END SUBROUTINE histwrite3d_phy |
1377 |
|||
1378 |
|||
1379 |
! VERSION DES HISTWRITE DEDIEES AU TOUT-XIOS-XML DEJA UTILISEE DANS PHYDEV |
||
1380 |
#ifdef CPP_XIOS |
||
1381 |
SUBROUTINE histwrite2d_xios(field_name,field) |
||
1382 |
|||
1383 |
USE dimphy, ONLY: klon, klev |
||
1384 |
USE mod_phys_lmdz_para, ONLY: gather_omp, grid1Dto2D_mpi, & |
||
1385 |
is_sequential, klon_mpi_begin, klon_mpi_end, & |
||
1386 |
jj_nb, klon_mpi, is_master |
||
1387 |
USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid_type, unstructured |
||
1388 |
USE xios, ONLY: xios_send_field |
||
1389 |
USE print_control_mod, ONLY: prt_level,lunout |
||
1390 |
|||
1391 |
IMPLICIT NONE |
||
1392 |
|||
1393 |
CHARACTER(LEN=*), INTENT(IN) :: field_name |
||
1394 |
REAL, DIMENSION(:), INTENT(IN) :: field |
||
1395 |
|||
1396 |
REAL,DIMENSION(klon_mpi) :: buffer_omp |
||
1397 |
INTEGER, allocatable, DIMENSION(:) :: index2d |
||
1398 |
REAL :: Field2d(nbp_lon,jj_nb) |
||
1399 |
|||
1400 |
INTEGER :: ip |
||
1401 |
REAL, ALLOCATABLE, DIMENSION(:) :: fieldok |
||
1402 |
|||
1403 |
IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite2d_xios for ', field_name |
||
1404 |
|||
1405 |
IF (prt_level >= 10) WRITE(lunout,*)'Begin histrwrite2d_xios ',field_name |
||
1406 |
|||
1407 |
!Et sinon on.... écrit |
||
1408 |
IF (SIZE(field)/=klon .AND. SIZE(field)/=klev .AND. SIZE(field)/=klev+1) CALL abort_physic('iophy::histwrite2d_xios','Field first DIMENSION not equal to klon/klev',1) |
||
1409 |
IF (SIZE(field) == klev .OR. SIZE(field) == klev+1) then |
||
1410 |
!$OMP MASTER |
||
1411 |
|||
1412 |
CALL xios_send_field(field_name,field) |
||
1413 |
!$OMP END MASTER |
||
1414 |
ELSE |
||
1415 |
CALL Gather_omp(field,buffer_omp) |
||
1416 |
!$OMP MASTER |
||
1417 |
|||
1418 |
IF (grid_type==unstructured) THEN |
||
1419 |
|||
1420 |
CALL xios_send_field(field_name, buffer_omp) |
||
1421 |
|||
1422 |
ELSE |
||
1423 |
|||
1424 |
CALL grid1Dto2D_mpi(buffer_omp,Field2d) |
||
1425 |
|||
1426 |
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
||
1427 |
!ATTENTION, STATIONS PAS GEREES ! |
||
1428 |
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
||
1429 |
!IF(.NOT.clef_stations(iff)) THEN |
||
1430 |
IF (.TRUE.) THEN |
||
1431 |
|||
1432 |
CALL xios_send_field(field_name, Field2d) |
||
1433 |
|||
1434 |
ELSE |
||
1435 |
ALLOCATE(fieldok(npstn)) |
||
1436 |
ALLOCATE(index2d(npstn)) |
||
1437 |
|||
1438 |
IF (is_sequential) THEN |
||
1439 |
DO ip=1, npstn |
||
1440 |
fieldok(ip)=buffer_omp(nptabij(ip)) |
||
1441 |
ENDDO |
||
1442 |
ELSE |
||
1443 |
DO ip=1, npstn |
||
1444 |
PRINT*,'histwrite2d_xios is_sequential npstn ip namenptabij',npstn,ip,field_name,nptabij(ip) |
||
1445 |
IF(nptabij(ip).GE.klon_mpi_begin.AND. & |
||
1446 |
nptabij(ip).LE.klon_mpi_end) THEN |
||
1447 |
fieldok(ip)=buffer_omp(nptabij(ip)-klon_mpi_begin+1) |
||
1448 |
ENDIF |
||
1449 |
ENDDO |
||
1450 |
ENDIF |
||
1451 |
DEALLOCATE(index2d) |
||
1452 |
DEALLOCATE(fieldok) |
||
1453 |
|||
1454 |
ENDIF |
||
1455 |
ENDIF |
||
1456 |
!$OMP END MASTER |
||
1457 |
ENDIF |
||
1458 |
|||
1459 |
IF (prt_level >= 10) WRITE(lunout,*)'End histrwrite2d_xios ',field_name |
||
1460 |
END SUBROUTINE histwrite2d_xios |
||
1461 |
|||
1462 |
|||
1463 |
! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE |
||
1464 |
SUBROUTINE histwrite3d_xios(field_name, field) |
||
1465 |
|||
1466 |
USE dimphy, ONLY: klon, klev |
||
1467 |
USE mod_phys_lmdz_para, ONLY: gather_omp, grid1Dto2D_mpi, & |
||
1468 |
is_sequential, klon_mpi_begin, klon_mpi_end, & |
||
1469 |
jj_nb, klon_mpi, is_master |
||
1470 |
USE xios, ONLY: xios_send_field |
||
1471 |
USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid_type, unstructured |
||
1472 |
USE print_control_mod, ONLY: prt_level,lunout |
||
1473 |
|||
1474 |
IMPLICIT NONE |
||
1475 |
|||
1476 |
CHARACTER(LEN=*), INTENT(IN) :: field_name |
||
1477 |
REAL, DIMENSION(:,:), INTENT(IN) :: field ! --> field(klon,:) |
||
1478 |
|||
1479 |
REAL,DIMENSION(klon_mpi,SIZE(field,2)) :: buffer_omp |
||
1480 |
REAL :: Field3d(nbp_lon,jj_nb,SIZE(field,2)) |
||
1481 |
INTEGER :: ip, n, nlev |
||
1482 |
INTEGER, ALLOCATABLE, DIMENSION(:) :: index3d |
||
1483 |
REAL,ALLOCATABLE, DIMENSION(:,:) :: fieldok |
||
1484 |
|||
1485 |
IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite3d_xios for ', field_name |
||
1486 |
|||
1487 |
IF (prt_level >= 10) write(lunout,*)'Begin histrwrite3d_xios ',field_name |
||
1488 |
|||
1489 |
!Et on.... écrit |
||
1490 |
IF (SIZE(field,1)/=klon .AND. SIZE(field,1)/=klev .AND. SIZE(field,1)/=klev+1) then |
||
1491 |
write(lunout,*)' histrwrite3d_xios ', field_name, SIZE(field) |
||
1492 |
CALL abort_physic('iophy::histwrite3d_xios','Field first DIMENSION not equal to klon/klev',1) |
||
1493 |
ENDIF |
||
1494 |
|||
1495 |
IF (SIZE(field,1) == klev .OR. SIZE(field,1) == klev+1) then |
||
1496 |
!$OMP MASTER |
||
1497 |
CALL xios_send_field(field_name,field) |
||
1498 |
!$OMP END MASTER |
||
1499 |
ELSE |
||
1500 |
nlev=SIZE(field,2) |
||
1501 |
|||
1502 |
|||
1503 |
CALL Gather_omp(field,buffer_omp) |
||
1504 |
!$OMP MASTER |
||
1505 |
|||
1506 |
IF (grid_type==unstructured) THEN |
||
1507 |
|||
1508 |
CALL xios_send_field(field_name, buffer_omp(:,1:nlev)) |
||
1509 |
|||
1510 |
ELSE |
||
1511 |
CALL grid1Dto2D_mpi(buffer_omp,field3d) |
||
1512 |
|||
1513 |
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
||
1514 |
!ATTENTION, STATIONS PAS GEREES ! |
||
1515 |
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! |
||
1516 |
!IF (.NOT.clef_stations(iff)) THEN |
||
1517 |
IF(.TRUE.)THEN |
||
1518 |
|||
1519 |
CALL xios_send_field(field_name, Field3d(:,:,1:nlev)) |
||
1520 |
|||
1521 |
ELSE |
||
1522 |
nlev=size(field,2) |
||
1523 |
ALLOCATE(index3d(npstn*nlev)) |
||
1524 |
ALLOCATE(fieldok(npstn,nlev)) |
||
1525 |
|||
1526 |
IF (is_sequential) THEN |
||
1527 |
DO n=1, nlev |
||
1528 |
DO ip=1, npstn |
||
1529 |
fieldok(ip,n)=buffer_omp(nptabij(ip),n) |
||
1530 |
ENDDO |
||
1531 |
ENDDO |
||
1532 |
ELSE |
||
1533 |
DO n=1, nlev |
||
1534 |
DO ip=1, npstn |
||
1535 |
IF(nptabij(ip).GE.klon_mpi_begin.AND. & |
||
1536 |
nptabij(ip).LE.klon_mpi_end) THEN |
||
1537 |
fieldok(ip,n)=buffer_omp(nptabij(ip)-klon_mpi_begin+1,n) |
||
1538 |
ENDIF |
||
1539 |
ENDDO |
||
1540 |
ENDDO |
||
1541 |
ENDIF |
||
1542 |
DEALLOCATE(index3d) |
||
1543 |
DEALLOCATE(fieldok) |
||
1544 |
ENDIF |
||
1545 |
ENDIF |
||
1546 |
!$OMP END MASTER |
||
1547 |
ENDIF |
||
1548 |
|||
1549 |
IF (prt_level >= 10) write(lunout,*)'End histrwrite3d_xios ',field_name |
||
1550 |
|||
1551 |
END SUBROUTINE histwrite3d_xios |
||
1552 |
|||
1553 |
#ifdef CPP_XIOS |
||
1554 |
SUBROUTINE histwrite0d_xios(field_name, field) |
||
1555 |
USE xios, ONLY: xios_send_field |
||
1556 |
USE mod_phys_lmdz_para, ONLY: is_master |
||
1557 |
USE print_control_mod, ONLY: prt_level,lunout |
||
1558 |
IMPLICIT NONE |
||
1559 |
|||
1560 |
CHARACTER(LEN=*), INTENT(IN) :: field_name |
||
1561 |
REAL, INTENT(IN) :: field ! --> scalar |
||
1562 |
|||
1563 |
IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite0d_xios for ', field_name |
||
1564 |
|||
1565 |
!$OMP MASTER |
||
1566 |
CALL xios_send_field(field_name, field) |
||
1567 |
!$OMP END MASTER |
||
1568 |
|||
1569 |
END SUBROUTINE histwrite0d_xios |
||
1570 |
#endif |
||
1571 |
|||
1572 |
#endif |
||
1573 |
END MODULE iophy |
| Generated by: GCOVR (Version 4.2) |