GCC Code Coverage Report


Directory: ./
File: phys/iophy.f90
Date: 2022-01-11 19:19:34
Exec Total Coverage
Lines: 150 387 38.8%
Branches: 168 646 26.0%

Line Branch Exec Source
1 !
2 ! $Id: iophy.F90 3488 2019-04-26 11:41:36Z fairhead $
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 INTERFACE histwrite_phy
19 MODULE PROCEDURE histwrite2d_phy,histwrite3d_phy,histwrite2d_phy_old,histwrite3d_phy_old
20 END INTERFACE
21
22 INTERFACE histbeg_phy_all
23 MODULE PROCEDURE histbeg_phy,histbeg_phyxios,histbeg_phy_points
24 END INTERFACE
25
26
27 CONTAINS
28
29 ! ug Routine pour définir itau_iophy depuis phys_output_write_mod:
30 122401 SUBROUTINE set_itau_iophy(ito)
31 IMPLICIT NONE
32 INTEGER, INTENT(IN) :: ito
33 481 itau_iophy = ito
34 481 END SUBROUTINE
35
36 1 SUBROUTINE init_iophy_new(rlat,rlon)
37
38 USE dimphy, ONLY: klon
39 USE mod_phys_lmdz_para, ONLY: gather, bcast, &
40 jj_nb, jj_begin, jj_end, ii_begin, ii_end, &
41 mpi_size, mpi_rank, klon_mpi, &
42 is_sequential, is_south_pole_dyn
43 USE mod_grid_phy_lmdz, ONLY: nbp_lon, nbp_lat, klon_glo, grid_type, unstructured
44 USE print_control_mod, ONLY: prt_level,lunout
45 USE ioipsl, ONLY: flio_dom_set
46 IMPLICIT NONE
47 REAL,DIMENSION(klon),INTENT(IN) :: rlon
48 REAL,DIMENSION(klon),INTENT(IN) :: rlat
49
50 2 REAL,DIMENSION(klon_glo) :: rlat_glo
51 2 REAL,DIMENSION(klon_glo) :: rlon_glo
52
53 INTEGER,DIMENSION(2) :: ddid
54 INTEGER,DIMENSION(2) :: dsg
55 INTEGER,DIMENSION(2) :: dsl
56 INTEGER,DIMENSION(2) :: dpf
57 INTEGER,DIMENSION(2) :: dpl
58 INTEGER,DIMENSION(2) :: dhs
59 INTEGER,DIMENSION(2) :: dhe
60 INTEGER :: i
61 INTEGER :: data_ibegin, data_iend
62
63
64
65
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 IF (grid_type==unstructured) THEN
66
67
68 ELSE
69
70 1 CALL gather(rlat,rlat_glo)
71 1 CALL bcast(rlat_glo)
72 1 CALL gather(rlon,rlon_glo)
73 1 CALL bcast(rlon_glo)
74
75 !$OMP MASTER
76
3/6
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 1 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 1 times.
1 ALLOCATE(io_lat(nbp_lat))
77
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF (klon_glo == 1) THEN
78 io_lat(1)=rlat_glo(1)
79 ELSE
80 1 io_lat(1)=rlat_glo(1)
81 1 io_lat(nbp_lat)=rlat_glo(klon_glo)
82
2/2
✓ Branch 0 taken 31 times.
✓ Branch 1 taken 1 times.
32 DO i=2,nbp_lat-1
83 32 io_lat(i)=rlat_glo(2+(i-2)*nbp_lon)
84 ENDDO
85 ENDIF
86
87
3/6
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 1 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 1 times.
1 ALLOCATE(io_lon(nbp_lon))
88
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1 times.
1 IF (klon_glo == 1) THEN
89 io_lon(1)=rlon_glo(1)
90 ELSE
91
2/2
✓ Branch 0 taken 32 times.
✓ Branch 1 taken 1 times.
33 io_lon(1:nbp_lon)=rlon_glo(2:nbp_lon+1)
92 ENDIF
93
94 !! (I) dtnb : total number of domains
95 !! (I) dnb : domain number
96 !! (I) did(:) : distributed dimensions identifiers
97 !! (up to 5 dimensions are supported)
98 !! (I) dsg(:) : total number of points for each dimension
99 !! (I) dsl(:) : local number of points for each dimension
100 !! (I) dpf(:) : position of first local point for each dimension
101 !! (I) dpl(:) : position of last local point for each dimension
102 !! (I) dhs(:) : start halo size for each dimension
103 !! (I) dhe(:) : end halo size for each dimension
104 !! (C) cdnm : Model domain definition name.
105 !! The names actually supported are :
106 !! "BOX", "APPLE", "ORANGE".
107 !! These names are case insensitive.
108
109 1 ddid=(/ 1,2 /)
110
2/2
✓ Branch 0 taken 2 times.
✓ Branch 1 taken 1 times.
3 dsg=(/ nbp_lon, nbp_lat /)
111
2/2
✓ Branch 0 taken 2 times.
✓ Branch 1 taken 1 times.
3 dsl=(/ nbp_lon, jj_nb /)
112
2/2
✓ Branch 0 taken 2 times.
✓ Branch 1 taken 1 times.
3 dpf=(/ 1,jj_begin /)
113
2/2
✓ Branch 0 taken 2 times.
✓ Branch 1 taken 1 times.
3 dpl=(/ nbp_lon, jj_end /)
114
2/2
✓ Branch 0 taken 2 times.
✓ Branch 1 taken 1 times.
3 dhs=(/ ii_begin-1,0 /)
115
1/2
✓ Branch 0 taken 1 times.
✗ Branch 1 not taken.
1 IF (mpi_rank==mpi_size-1) THEN
116 1 dhe=(/0,0/)
117 ELSE
118 dhe=(/ nbp_lon-ii_end,0 /)
119 ENDIF
120
121 CALL flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, &
122 1 'APPLE',phys_domain_id)
123 !$OMP END MASTER
124
125
126 ENDIF
127
128 1 END SUBROUTINE init_iophy_new
129
130
131 SUBROUTINE init_iophy(lat,lon)
132
133 USE mod_phys_lmdz_para, ONLY: jj_begin, jj_end, ii_begin, ii_end, jj_nb, &
134 mpi_size, mpi_rank
135 USE ioipsl, ONLY: flio_dom_set
136 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
137
138 IMPLICIT NONE
139
140 REAL,DIMENSION(nbp_lon),INTENT(IN) :: lon
141 REAL,DIMENSION(nbp_lat),INTENT(IN) :: lat
142
143 INTEGER,DIMENSION(2) :: ddid
144 INTEGER,DIMENSION(2) :: dsg
145 INTEGER,DIMENSION(2) :: dsl
146 INTEGER,DIMENSION(2) :: dpf
147 INTEGER,DIMENSION(2) :: dpl
148 INTEGER,DIMENSION(2) :: dhs
149 INTEGER,DIMENSION(2) :: dhe
150
151 !$OMP MASTER
152 ALLOCATE(io_lat(nbp_lat))
153 io_lat(:)=lat(:)
154 ALLOCATE(io_lon(nbp_lon))
155 io_lon(:)=lon(:)
156
157 ddid=(/ 1,2 /)
158 dsg=(/ nbp_lon, nbp_lat /)
159 dsl=(/ nbp_lon, jj_nb /)
160 dpf=(/ 1,jj_begin /)
161 dpl=(/ nbp_lon, jj_end /)
162 dhs=(/ ii_begin-1,0 /)
163 IF (mpi_rank==mpi_size-1) THEN
164 dhe=(/0,0/)
165 ELSE
166 dhe=(/ nbp_lon-ii_end,0 /)
167 ENDIF
168
169 call flio_dom_set(mpi_size,mpi_rank,ddid,dsg,dsl,dpf,dpl,dhs,dhe, &
170 'APPLE',phys_domain_id)
171 !$OMP END MASTER
172
173 END SUBROUTINE init_iophy
174
175 SUBROUTINE histbeg_phyxios(name,itau0,zjulian,dtime,ffreq,lev,nhori,nid_day)
176 ! USE dimphy
177 USE mod_phys_lmdz_para, ONLY: is_sequential, is_using_mpi, is_mpi_root, &
178 jj_begin, jj_end, jj_nb
179 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
180 USE ioipsl, ONLY: histbeg
181 IMPLICIT NONE
182 INCLUDE 'clesphys.h'
183
184 CHARACTER*(*), INTENT(IN) :: name
185 INTEGER, INTENT(IN) :: itau0
186 REAL,INTENT(IN) :: zjulian
187 REAL,INTENT(IN) :: dtime
188 CHARACTER(LEN=*), INTENT(IN) :: ffreq
189 INTEGER,INTENT(IN) :: lev
190 INTEGER,INTENT(OUT) :: nhori
191 INTEGER,INTENT(OUT) :: nid_day
192
193 !$OMP MASTER
194 IF (is_sequential) THEN
195 CALL histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
196 1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day)
197 ELSE
198 CALL histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
199 1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day,phys_domain_id)
200 ENDIF
201
202 !$OMP END MASTER
203
204 END SUBROUTINE histbeg_phyxios
205
206 4 SUBROUTINE histbeg_phy(name,itau0,zjulian,dtime,nhori,nid_day)
207
208 USE mod_phys_lmdz_para, ONLY: jj_begin, jj_end, jj_nb, is_sequential
209 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
210 USE ioipsl, ONLY: histbeg
211
212 IMPLICIT NONE
213
214 CHARACTER*(*), INTENT(IN) :: name
215 INTEGER, INTENT(IN) :: itau0
216 REAL,INTENT(IN) :: zjulian
217 REAL,INTENT(IN) :: dtime
218 INTEGER,INTENT(OUT) :: nhori
219 INTEGER,INTENT(OUT) :: nid_day
220
221 !$OMP MASTER
222
1/2
✓ Branch 0 taken 4 times.
✗ Branch 1 not taken.
4 IF (is_sequential) THEN
223 CALL histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
224 4 1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day)
225 ELSE
226 CALL histbeg(name,nbp_lon,io_lon, jj_nb,io_lat(jj_begin:jj_end), &
227 1,nbp_lon,1,jj_nb,itau0, zjulian, dtime, nhori, nid_day,phys_domain_id)
228 ENDIF
229 !$OMP END MASTER
230
231 4 END SUBROUTINE histbeg_phy
232
233
234 SUBROUTINE histbeg_phy_points(rlon,rlat,pim,tabij,ipt,jpt, &
235 plon,plat,plon_bounds,plat_bounds, &
236 nname,itau0,zjulian,dtime,nnhori,nnid_day)
237 USE dimphy, ONLY: klon
238 USE mod_phys_lmdz_para, ONLY: gather, bcast, &
239 is_sequential, klon_mpi_begin, klon_mpi_end, &
240 mpi_rank
241 USE mod_grid_phy_lmdz, ONLY: klon_glo, nbp_lon, nbp_lat, grid1dTo2d_glo
242 USE ioipsl, ONLY: histbeg
243
244 IMPLICIT NONE
245
246 REAL,DIMENSION(klon),INTENT(IN) :: rlon
247 REAL,DIMENSION(klon),INTENT(IN) :: rlat
248 INTEGER, INTENT(IN) :: itau0
249 REAL,INTENT(IN) :: zjulian
250 REAL,INTENT(IN) :: dtime
251 INTEGER, INTENT(IN) :: pim
252 INTEGER, intent(out) :: nnhori
253 CHARACTER(len=20), INTENT(IN) :: nname
254 INTEGER, INTENT(OUT) :: nnid_day
255 INTEGER :: i
256 REAL,DIMENSION(klon_glo) :: rlat_glo
257 REAL,DIMENSION(klon_glo) :: rlon_glo
258 INTEGER, DIMENSION(pim), INTENT(IN) :: tabij
259 REAL,DIMENSION(pim), INTENT(IN) :: plat, plon
260 INTEGER,DIMENSION(pim), INTENT(IN) :: ipt, jpt
261 REAL,DIMENSION(pim,2), intent(out) :: plat_bounds, plon_bounds
262
263 INTEGER, SAVE :: tabprocbeg, tabprocend
264 !$OMP THREADPRIVATE(tabprocbeg, tabprocend)
265 INTEGER :: ip
266 INTEGER, PARAMETER :: nip=1
267 INTEGER :: npproc
268 REAL, allocatable, DIMENSION(:) :: npplat, npplon
269 REAL, allocatable, DIMENSION(:,:) :: npplat_bounds, npplon_bounds
270 REAL, DIMENSION(nbp_lon,nbp_lat) :: zx_lon, zx_lat
271
272 CALL gather(rlat,rlat_glo)
273 CALL bcast(rlat_glo)
274 CALL gather(rlon,rlon_glo)
275 CALL bcast(rlon_glo)
276
277 !$OMP MASTER
278 DO i=1,pim
279
280 ! print*,'CFMIP_iophy i tabij lon lat',i,tabij(i),plon(i),plat(i)
281
282 plon_bounds(i,1)=rlon_glo(tabij(i)-1)
283 plon_bounds(i,2)=rlon_glo(tabij(i)+1)
284 IF (plon_bounds(i,2).LE.0..AND.plon_bounds(i,1).GE.0.) THEN
285 IF (rlon_glo(tabij(i)).GE.0.) THEN
286 plon_bounds(i,2)=-1*plon_bounds(i,2)
287 ENDIF
288 ENDIF
289 IF (plon_bounds(i,2).GE.0..AND.plon_bounds(i,1).LE.0.) THEN
290 IF (rlon_glo(tabij(i)).LE.0.) THEN
291 plon_bounds(i,2)=-1*plon_bounds(i,2)
292 ENDIF
293 ENDIF
294 !
295 IF ( tabij(i).LE.nbp_lon) THEN
296 plat_bounds(i,1)=rlat_glo(tabij(i))
297 ELSE
298 plat_bounds(i,1)=rlat_glo(tabij(i)-nbp_lon)
299 ENDIF
300 plat_bounds(i,2)=rlat_glo(tabij(i)+nbp_lon)
301 !
302 ! print*,'CFMIP_iophy point i lon lon_bds',i,plon_bounds(i,1),rlon_glo(tabij(i)),plon_bounds(i,2)
303 ! print*,'CFMIP_iophy point i lat lat_bds',i,plat_bounds(i,1),rlat_glo(tabij(i)),plat_bounds(i,2)
304 !
305 ENDDO
306 if (is_sequential) then
307
308 npstn=pim
309 IF(.NOT. ALLOCATED(nptabij)) THEN
310 ALLOCATE(nptabij(pim))
311 ENDIF
312 DO i=1,pim
313 nptabij(i)=tabij(i)
314 ENDDO
315
316 CALL grid1dTo2d_glo(rlon_glo,zx_lon)
317 IF ((nbp_lon*nbp_lat).GT.1) THEN
318 DO i = 1, nbp_lon
319 zx_lon(i,1) = rlon_glo(i+1)
320 zx_lon(i,nbp_lat) = rlon_glo(i+1)
321 ENDDO
322 ENDIF
323 CALL grid1dTo2d_glo(rlat_glo,zx_lat)
324
325 DO i=1,pim
326 ! print*,'CFMIP_iophy i tabij lon lat',i,tabij(i),plon(i),plat(i)
327
328 plon_bounds(i,1)=zx_lon(ipt(i)-1,jpt(i))
329 plon_bounds(i,2)=zx_lon(ipt(i)+1,jpt(i))
330
331 IF (ipt(i).EQ.1) THEN
332 plon_bounds(i,1)=zx_lon(nbp_lon,jpt(i))
333 plon_bounds(i,2)=360.+zx_lon(ipt(i)+1,jpt(i))
334 ENDIF
335
336 IF (ipt(i).EQ.nbp_lon) THEN
337 plon_bounds(i,2)=360.+zx_lon(1,jpt(i))
338 ENDIF
339
340 plat_bounds(i,1)=zx_lat(ipt(i),jpt(i)-1)
341 plat_bounds(i,2)=zx_lat(ipt(i),jpt(i)+1)
342
343 IF (jpt(i).EQ.1) THEN
344 plat_bounds(i,1)=zx_lat(ipt(i),1)+0.001
345 plat_bounds(i,2)=zx_lat(ipt(i),1)-0.001
346 ENDIF
347
348 IF (jpt(i).EQ.nbp_lat) THEN
349 plat_bounds(i,1)=zx_lat(ipt(i),nbp_lat)+0.001
350 plat_bounds(i,2)=zx_lat(ipt(i),nbp_lat)-0.001
351 ENDIF
352 !
353 ! print*,'CFMIP_iophy point i lon lon_bds',i,plon_bounds(i,1),rlon(tabij(i)),plon_bounds(i,2)
354 ! print*,'CFMIP_iophy point i lat lat_bds',i,plat_bounds(i,1),rlat(tabij(i)),plat_bounds(i,2)
355 !
356 ENDDO
357
358 CALL histbeg(nname,pim,plon,plon_bounds, &
359 plat,plat_bounds, &
360 itau0, zjulian, dtime, nnhori, nnid_day)
361 ELSE
362 npproc=0
363 DO ip=1, pim
364 tabprocbeg=klon_mpi_begin
365 tabprocend=klon_mpi_end
366 IF(tabij(ip).GE.tabprocbeg.AND.tabij(ip).LE.tabprocend) THEN
367 npproc=npproc+1
368 npstn=npproc
369 ENDIF
370 ENDDO
371 ! print*,'CFMIP_iophy mpi_rank npstn',mpi_rank,npstn
372 IF(.NOT. ALLOCATED(nptabij)) THEN
373 ALLOCATE(nptabij(npstn))
374 ALLOCATE(npplon(npstn), npplat(npstn))
375 ALLOCATE(npplon_bounds(npstn,2), npplat_bounds(npstn,2))
376 ENDIF
377 npproc=0
378 DO ip=1, pim
379 IF(tabij(ip).GE.tabprocbeg.AND.tabij(ip).LE.tabprocend) THEN
380 npproc=npproc+1
381 nptabij(npproc)=tabij(ip)
382 ! print*,'mpi_rank npproc ip plon plat tabij=',mpi_rank,npproc,ip, &
383 ! plon(ip),plat(ip),tabij(ip)
384 npplon(npproc)=plon(ip)
385 npplat(npproc)=plat(ip)
386 npplon_bounds(npproc,1)=plon_bounds(ip,1)
387 npplon_bounds(npproc,2)=plon_bounds(ip,2)
388 npplat_bounds(npproc,1)=plat_bounds(ip,1)
389 npplat_bounds(npproc,2)=plat_bounds(ip,2)
390 !!!
391 !!! print qui sert a reordonner les points stations selon l'ordre CFMIP
392 !!! ne pas enlever
393 print*,'iophy_mpi rank ip lon lat',mpi_rank,ip,plon(ip),plat(ip)
394 !!!
395 ENDIF
396 ENDDO
397 CALL histbeg(nname,npstn,npplon,npplon_bounds, &
398 npplat,npplat_bounds, &
399 itau0,zjulian,dtime,nnhori,nnid_day,phys_domain_id)
400 ENDIF
401 !$OMP END MASTER
402
403 END SUBROUTINE histbeg_phy_points
404
405
406 SUBROUTINE histdef2d_old (iff,lpoint,flag_var,nomvar,titrevar,unitvar)
407
408 USE ioipsl, ONLY: histdef
409 USE mod_phys_lmdz_para, ONLY: jj_nb, is_master
410 USE phys_output_var_mod, ONLY: type_ecri, zoutm, zdtime_moy, lev_files, &
411 nid_files, nhorim, swaero_diag, dryaod_diag, nfiles, &
412 ok_4xCO2atm
413 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
414 USE aero_mod, ONLY : naero_tot, name_aero_tau
415 USE print_control_mod, ONLY: prt_level,lunout
416
417 IMPLICIT NONE
418
419 INCLUDE "clesphys.h"
420
421 INTEGER :: iff
422 INTEGER :: naero
423 LOGICAL :: lpoint
424 INTEGER, DIMENSION(nfiles) :: flag_var
425 CHARACTER(LEN=20) :: nomvar
426 CHARACTER(LEN=*) :: titrevar
427 CHARACTER(LEN=*) :: unitvar
428
429 REAL zstophym
430
431 IF (type_ecri(iff)=='inst(X)'.OR.type_ecri(iff)=='once') THEN
432 zstophym=zoutm(iff)
433 ELSE
434 zstophym=zdtime_moy
435 ENDIF
436 IF (check_dim .AND. is_master) WRITE(lunout,*)'histdef2d_old for ', nomvar
437 ! Appel a la lecture des noms et niveau d'ecriture des variables dans output.def
438 CALL conf_physoutputs(nomvar,flag_var)
439
440 IF(.NOT.lpoint) THEN
441 IF ( flag_var(iff)<=lev_files(iff) ) THEN
442 CALL histdef (nid_files(iff),nomvar,titrevar,unitvar, &
443 nbp_lon,jj_nb,nhorim(iff), 1,1,1, -99, 32, &
444 type_ecri(iff), zstophym,zoutm(iff))
445 ENDIF
446 ELSE
447 IF ( flag_var(iff)<=lev_files(iff) ) THEN
448 CALL histdef (nid_files(iff),nomvar,titrevar,unitvar, &
449 npstn,1,nhorim(iff), 1,1,1, -99, 32, &
450 type_ecri(iff), zstophym,zoutm(iff))
451 ENDIF
452 ENDIF
453
454 ! Set swaero_diag=true if at least one of the concerned variables are defined
455 IF (nomvar=='topswad' .OR. nomvar=='topswad0' .OR. nomvar=='solswad' .OR. nomvar=='solswad0' .OR. &
456 nomvar=='toplwad' .OR. nomvar=='toplwad0' .OR. nomvar=='sollwad' .OR. nomvar=='sollwad0' .OR. &
457 nomvar=='topswai' .OR. nomvar=='solswai' ) THEN
458 IF ( flag_var(iff)<=lev_files(iff) ) swaero_diag=.TRUE.
459 ENDIF
460
461 ! Set dryaod_diag=true if at least one of the concerned variables are defined
462 IF (nomvar=='dryod550aer') THEN
463 IF ( flag_var(iff)<=lev_files(iff) ) dryaod_diag=.TRUE.
464 ENDIF
465 DO naero = 1, naero_tot-1
466 IF (nomvar=='dryod550_'//name_aero_tau(naero)) THEN
467 IF ( flag_var(iff)<=lev_files(iff) ) dryaod_diag=.TRUE.
468 ENDIF
469 ENDDO
470
471 ! Set ok_4xCO2atm=true if at least one of the concerned variables are
472 ! defined
473 IF (nomvar=='rsut4co2'.OR.nomvar=='rlut4co2'.OR.nomvar=='rsutcs4co2' &
474 .OR. nomvar=='rlutcs4co2'.OR.nomvar=='rsu4co2'.OR.nomvar=='rsucs4co2' &
475 .OR.nomvar=='rsu4co2'.OR.nomvar=='rsucs4co2'.OR.nomvar=='rsd4co2'.OR. &
476 nomvar=='rsdcs4co2'.OR.nomvar=='rlu4co2'.OR.nomvar=='rlucs4co2'.OR.&
477 nomvar=='rld4co2'.OR.nomvar=='rldcs4co2') THEN
478 IF ( flag_var(iff)<=lev_files(iff) ) ok_4xCO2atm=.TRUE.
479 ENDIF
480 END SUBROUTINE histdef2d_old
481
482 SUBROUTINE histdef3d_old (iff,lpoint,flag_var,nomvar,titrevar,unitvar)
483
484 USE ioipsl, ONLY: histdef
485 USE dimphy, ONLY: klev
486 USE mod_phys_lmdz_para, ONLY: jj_nb, is_master
487 USE phys_output_var_mod, ONLY: type_ecri, zoutm, lev_files, nid_files, &
488 nhorim, zdtime_moy, levmin, levmax, &
489 nvertm, nfiles
490 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
491 USE print_control_mod, ONLY: prt_level,lunout
492 IMPLICIT NONE
493
494 INCLUDE "clesphys.h"
495
496 INTEGER :: iff
497 LOGICAL :: lpoint
498 INTEGER, DIMENSION(nfiles) :: flag_var
499 CHARACTER(LEN=20) :: nomvar
500 CHARACTER(LEN=*) :: titrevar
501 CHARACTER(LEN=*) :: unitvar
502
503 REAL zstophym
504
505 ! Appel a la lecture des noms et niveau d'ecriture des variables dans output.def
506 CALL conf_physoutputs(nomvar,flag_var)
507
508 IF (check_dim .AND. is_master) WRITE(lunout,*)'histdef3d_old for ', nomvar
509
510 IF (type_ecri(iff)=='inst(X)'.OR.type_ecri(iff)=='once') THEN
511 zstophym=zoutm(iff)
512 ELSE
513 zstophym=zdtime_moy
514 ENDIF
515
516 IF(.NOT.lpoint) THEN
517 IF ( flag_var(iff)<=lev_files(iff) ) THEN
518 CALL histdef (nid_files(iff), nomvar, titrevar, unitvar, &
519 nbp_lon, jj_nb, nhorim(iff), klev, levmin(iff), &
520 levmax(iff)-levmin(iff)+1, nvertm(iff), 32, type_ecri(iff), &
521 zstophym, zoutm(iff))
522 ENDIF
523 ELSE
524 IF ( flag_var(iff)<=lev_files(iff) ) THEN
525 CALL histdef (nid_files(iff), nomvar, titrevar, unitvar, &
526 npstn,1,nhorim(iff), klev, levmin(iff), &
527 levmax(iff)-levmin(iff)+1, nvertm(iff), 32, &
528 type_ecri(iff), zstophym,zoutm(iff))
529 ENDIF
530 ENDIF
531 END SUBROUTINE histdef3d_old
532
533 1520 SUBROUTINE histdef2d (iff,var)
534
535 USE ioipsl, ONLY: histdef
536 USE mod_phys_lmdz_para, ONLY: jj_nb, is_master
537 USE phys_output_var_mod, ONLY: ctrl_out, type_ecri_files, zoutm, zdtime_moy, &
538 clef_stations, phys_out_filenames, lev_files, &
539 nid_files, nhorim, swaerofree_diag, swaero_diag, dryaod_diag,&
540 ok_4xCO2atm
541 USE print_control_mod, ONLY: prt_level,lunout
542 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
543 USE aero_mod, ONLY : naero_tot, name_aero_tau
544 USE print_control_mod, ONLY: prt_level,lunout
545 IMPLICIT NONE
546
547 INCLUDE "clesphys.h"
548
549 INTEGER :: iff
550 INTEGER :: naero
551 TYPE(ctrl_out) :: var
552
553 REAL zstophym
554 CHARACTER(LEN=20) :: typeecrit
555
556
1/4
✗ Branch 0 not taken.
✓ Branch 1 taken 1520 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
1520 IF (check_dim .AND. is_master) WRITE(lunout,*)'histdef2d for ', var%name
557
558 ! ug On récupère le type écrit de la structure:
559 ! Assez moche, à refaire si meilleure méthode...
560
2/2
✓ Branch 0 taken 8 times.
✓ Branch 1 taken 1512 times.
1520 IF (INDEX(var%type_ecrit(iff), "once") > 0) THEN
561 8 typeecrit = 'once'
562
2/2
✓ Branch 0 taken 4 times.
✓ Branch 1 taken 1508 times.
1512 ELSE IF(INDEX(var%type_ecrit(iff), "t_min") > 0) THEN
563 4 typeecrit = 't_min(X)'
564
2/2
✓ Branch 0 taken 12 times.
✓ Branch 1 taken 1496 times.
1508 ELSE IF(INDEX(var%type_ecrit(iff), "t_max") > 0) THEN
565 12 typeecrit = 't_max(X)'
566
2/2
✓ Branch 0 taken 180 times.
✓ Branch 1 taken 1316 times.
1496 ELSE IF(INDEX(var%type_ecrit(iff), "inst") > 0) THEN
567 180 typeecrit = 'inst(X)'
568 ELSE
569 1316 typeecrit = type_ecri_files(iff)
570 ENDIF
571
572
4/4
✓ Branch 0 taken 1011 times.
✓ Branch 1 taken 509 times.
✓ Branch 2 taken 8 times.
✓ Branch 3 taken 1003 times.
1520 IF (typeecrit=='inst(X)'.OR.typeecrit=='once') THEN
573 517 zstophym=zoutm(iff)
574 ELSE
575 1003 zstophym=zdtime_moy
576 ENDIF
577
578 ! Appel a la lecture des noms et niveau d'ecriture des variables dans output.def
579 1520 CALL conf_physoutputs(var%name, var%flag)
580
581
1/2
✓ Branch 0 taken 1520 times.
✗ Branch 1 not taken.
1520 IF(.NOT.clef_stations(iff)) THEN
582
583
584
2/2
✓ Branch 0 taken 528 times.
✓ Branch 1 taken 992 times.
1520 IF ( var%flag(iff)<=lev_files(iff) ) THEN
585 CALL histdef (nid_files(iff), var%name, var%description, var%unit, &
586 nbp_lon,jj_nb,nhorim(iff), 1,1,1, -99, 32, &
587 528 typeecrit, zstophym,zoutm(iff))
588 ENDIF
589 ELSE
590 IF ( var%flag(iff)<=lev_files(iff)) THEN
591 CALL histdef (nid_files(iff), var%name, var%description, var%unit, &
592 npstn,1,nhorim(iff), 1,1,1, -99, 32, &
593 typeecrit, zstophym,zoutm(iff))
594 ENDIF
595 ENDIF
596
597 ! Set swaero_diag=true if at least one of the concerned variables are defined
598 !--OB 30/05/2016 use wider set of variables
599 IF ( var%name=='topswad' .OR. var%name=='topswad0' .OR. var%name=='solswad' .OR. var%name=='solswad0' .OR. &
600
12/24
✓ Branch 0 taken 1520 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1520 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1520 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 1520 times.
✗ Branch 7 not taken.
✓ Branch 8 taken 1520 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 1520 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 1520 times.
✗ Branch 13 not taken.
✓ Branch 14 taken 1520 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 1520 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 1520 times.
✗ Branch 19 not taken.
✓ Branch 20 taken 1520 times.
✗ Branch 21 not taken.
✗ Branch 22 not taken.
✓ Branch 23 taken 1520 times.
3040 var%name=='topswai' .OR. var%name=='solswai' .OR. ( iflag_rrtm==1 .AND. ( &
601 var%name=='toplwad' .OR. var%name=='toplwad0' .OR. var%name=='sollwad' .OR. var%name=='sollwad0' .OR. &
602 var%name=='toplwai' .OR. var%name=='sollwai' ) ) ) THEN
603 IF ( var%flag(iff)<=lev_files(iff) ) swaero_diag=.TRUE.
604 ENDIF
605
606 ! Set swaerofree_diag=true if at least one of the concerned variables are defined
607 IF (var%name=='SWupTOAcleanclr' .OR. var%name=='SWupSFCcleanclr' .OR. var%name=='SWdnSFCcleanclr' .OR. &
608
10/10
✓ Branch 0 taken 1516 times.
✓ Branch 1 taken 4 times.
✓ Branch 2 taken 1512 times.
✓ Branch 3 taken 4 times.
✓ Branch 4 taken 1508 times.
✓ Branch 5 taken 4 times.
✓ Branch 6 taken 1504 times.
✓ Branch 7 taken 4 times.
✓ Branch 8 taken 4 times.
✓ Branch 9 taken 1500 times.
1520 var%name=='LWupTOAcleanclr' .OR. var%name=='LWdnSFCcleanclr' ) THEN
609
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 20 times.
20 IF ( var%flag(iff)<=lev_files(iff) ) swaerofree_diag=.TRUE.
610 ENDIF
611
612 ! set dryaod_dry=true if at least one of the concerned variables are defined
613
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 1520 times.
1520 IF (var%name=='dryod550aer') THEN
614 IF ( var%flag(iff)<=lev_files(iff) ) dryaod_diag=.TRUE.
615 ENDIF
616 !
617
2/2
✓ Branch 0 taken 19760 times.
✓ Branch 1 taken 1520 times.
21280 DO naero = 1, naero_tot-1
618
1/2
✗ Branch 1 not taken.
✓ Branch 2 taken 19760 times.
21280 IF (var%name=='dryod550_'//name_aero_tau(naero)) THEN
619 IF ( var%flag(iff)<=lev_files(iff) ) dryaod_diag=.TRUE.
620 ENDIF
621 ENDDO
622 ! Set ok_4xCO2atm=true if at least one of the concerned variables are
623 ! defined
624 IF (var%name=='rsut4co2'.OR.var%name=='rlut4co2'.OR.var%name=='rsutcs4co2' &
625 .OR. var%name=='rlutcs4co2'.OR.var%name=='rsu4co2'.OR.var%name=='rsucs4co2' &
626 .OR.var%name=='rsu4co2'.OR.var%name=='rsucs4co2'.OR.var%name=='rsd4co2'.OR. &
627 var%name=='rsdcs4co2'.OR.var%name=='rlu4co2'.OR.var%name=='rlucs4co2'.OR.&
628
12/24
✓ Branch 0 taken 1520 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 1520 times.
✗ Branch 3 not taken.
✓ Branch 4 taken 1520 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 1520 times.
✗ Branch 7 not taken.
✓ Branch 8 taken 1520 times.
✗ Branch 9 not taken.
✓ Branch 10 taken 1520 times.
✗ Branch 11 not taken.
✓ Branch 12 taken 1520 times.
✗ Branch 13 not taken.
✓ Branch 14 taken 1520 times.
✗ Branch 15 not taken.
✓ Branch 16 taken 1520 times.
✗ Branch 17 not taken.
✓ Branch 18 taken 1520 times.
✗ Branch 19 not taken.
✓ Branch 20 taken 1520 times.
✗ Branch 21 not taken.
✗ Branch 22 not taken.
✓ Branch 23 taken 1520 times.
1520 var%name=='rld4co2'.OR.var%name=='rldcs4co2') THEN
629 IF ( var%flag(iff)<=lev_files(iff) ) ok_4xCO2atm=.TRUE.
630 ENDIF
631 1520 END SUBROUTINE histdef2d
632
633 788 SUBROUTINE histdef3d (iff,var)
634
635
1/2
✓ Branch 0 taken 1520 times.
✗ Branch 1 not taken.
1520 USE ioipsl, ONLY: histdef
636 USE dimphy, ONLY: klev
637 USE mod_phys_lmdz_para, ONLY: jj_nb, is_master
638 USE phys_output_var_mod, ONLY: ctrl_out, type_ecri_files, zoutm, zdtime_moy, &
639 clef_stations, phys_out_filenames, lev_files, &
640 nid_files, nhorim, swaerofree_diag, levmin, &
641 levmax, nvertm
642 USE print_control_mod, ONLY: prt_level,lunout
643 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
644 USE print_control_mod, ONLY: prt_level,lunout
645 IMPLICIT NONE
646
647 INCLUDE "clesphys.h"
648
649 INTEGER :: iff
650 TYPE(ctrl_out) :: var
651
652 REAL zstophym
653 CHARACTER(LEN=20) :: typeecrit
654
655
1/4
✗ Branch 0 not taken.
✓ Branch 1 taken 788 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
788 IF (check_dim .AND. is_master) WRITE(lunout,*)'histdef3d for ', var%name
656
657 ! ug On récupère le type écrit de la structure:
658 ! Assez moche, à refaire si meilleure méthode...
659
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 788 times.
788 IF (INDEX(var%type_ecrit(iff), "once") > 0) THEN
660 typeecrit = 'once'
661
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 788 times.
788 ELSE IF(INDEX(var%type_ecrit(iff), "t_min") > 0) THEN
662 typeecrit = 't_min(X)'
663
2/2
✓ Branch 0 taken 24 times.
✓ Branch 1 taken 764 times.
788 ELSE IF(INDEX(var%type_ecrit(iff), "t_max") > 0) THEN
664 24 typeecrit = 't_max(X)'
665
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 764 times.
764 ELSE IF(INDEX(var%type_ecrit(iff), "inst") > 0) THEN
666 typeecrit = 'inst(X)'
667 ELSE
668 764 typeecrit = type_ecri_files(iff)
669 ENDIF
670
671 ! Appel a la lecture des noms et niveau d'ecriture des variables dans output.def
672 788 CALL conf_physoutputs(var%name,var%flag)
673
674
3/4
✓ Branch 0 taken 597 times.
✓ Branch 1 taken 191 times.
✗ Branch 2 not taken.
✓ Branch 3 taken 597 times.
788 IF (typeecrit=='inst(X)'.OR.typeecrit=='once') THEN
675 191 zstophym=zoutm(iff)
676 ELSE
677 597 zstophym=zdtime_moy
678 ENDIF
679
680
1/2
✓ Branch 0 taken 788 times.
✗ Branch 1 not taken.
788 IF(.NOT.clef_stations(iff)) THEN
681
682
683
2/2
✓ Branch 0 taken 256 times.
✓ Branch 1 taken 532 times.
788 IF ( var%flag(iff)<=lev_files(iff) ) THEN
684 CALL histdef (nid_files(iff), var%name, var%description, var%unit, &
685 nbp_lon, jj_nb, nhorim(iff), klev, levmin(iff), &
686 levmax(iff)-levmin(iff)+1, nvertm(iff), 32, typeecrit, &
687 256 zstophym, zoutm(iff))
688 ENDIF
689 ELSE
690 IF ( var%flag(iff)<=lev_files(iff)) THEN
691 CALL histdef (nid_files(iff), var%name, var%description, var%unit, &
692 npstn,1,nhorim(iff), klev, levmin(iff), &
693 levmax(iff)-levmin(iff)+1, nvertm(iff), 32, &
694 typeecrit, zstophym,zoutm(iff))
695 ENDIF
696 ENDIF
697
698 ! Set swaerofree_diag=true if at least one of the concerned variables are defined
699
4/4
✓ Branch 0 taken 784 times.
✓ Branch 1 taken 4 times.
✓ Branch 2 taken 4 times.
✓ Branch 3 taken 780 times.
788 IF (var%name=='rsucsaf' .OR. var%name=='rsdcsaf') THEN
700
2/2
✓ Branch 0 taken 2 times.
✓ Branch 1 taken 6 times.
8 IF ( var%flag(iff)<=lev_files(iff) ) swaerofree_diag=.TRUE.
701 ENDIF
702
703 788 END SUBROUTINE histdef3d
704
705 2308 SUBROUTINE conf_physoutputs(nam_var,flag_var)
706 !!! Lecture des noms et niveau de sortie des variables dans output.def
707 ! en utilisant les routines getin de IOIPSL
708 USE ioipsl, ONLY: getin
709 USE phys_output_var_mod, ONLY: nfiles
710 USE print_control_mod, ONLY: prt_level,lunout
711 IMPLICIT NONE
712
713 CHARACTER(LEN=20) :: nam_var
714 INTEGER, DIMENSION(nfiles) :: flag_var
715
716
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 2308 times.
2308 IF(prt_level>10) WRITE(lunout,*)'Avant getin: nam_var flag_var ',nam_var,flag_var(:)
717 2308 CALL getin('flag_'//nam_var,flag_var)
718 2308 CALL getin('name_'//nam_var,nam_var)
719
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 2308 times.
2308 IF(prt_level>10) WRITE(lunout,*)'Apres getin: nam_var flag_var ',nam_var,flag_var(:)
720
721 2308 END SUBROUTINE conf_physoutputs
722
723
724 SUBROUTINE histwrite2d_phy_old(nid,lpoint,name,itau,field)
725
726 USE dimphy, ONLY: klon
727 USE mod_phys_lmdz_para, ONLY: Gather_omp, grid1Dto2D_mpi, &
728 is_sequential, klon_mpi_begin, klon_mpi_end, &
729 jj_nb, klon_mpi, is_master
730 USE ioipsl, ONLY: histwrite
731 USE print_control_mod, ONLY: prt_level,lunout
732 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
733
734 IMPLICIT NONE
735
736 INTEGER,INTENT(IN) :: nid
737 LOGICAL,INTENT(IN) :: lpoint
738 CHARACTER*(*), INTENT(IN) :: name
739 INTEGER, INTENT(IN) :: itau
740 REAL,DIMENSION(:),INTENT(IN) :: field
741 REAL,DIMENSION(klon_mpi) :: buffer_omp
742 INTEGER, allocatable, DIMENSION(:) :: index2d
743 REAL :: Field2d(nbp_lon,jj_nb)
744
745 INTEGER :: ip
746 REAL,ALLOCATABLE,DIMENSION(:) :: fieldok
747
748 IF (size(field)/=klon) CALL abort_physic('iophy::histwrite2d','Field first DIMENSION not equal to klon',1)
749 IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite2d_phy_old for ', name
750
751 CALL Gather_omp(field,buffer_omp)
752 !$OMP MASTER
753 CALL grid1Dto2D_mpi(buffer_omp,Field2d)
754 IF (.NOT.lpoint) THEN
755 ALLOCATE(index2d(nbp_lon*jj_nb))
756 ALLOCATE(fieldok(nbp_lon*jj_nb))
757 IF (prt_level >= 10) write(lunout,*)'Sending ',name,' to IOIPSL'
758 CALL histwrite(nid,name,itau,Field2d,nbp_lon*jj_nb,index2d)
759 IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL'
760 ELSE
761 ALLOCATE(fieldok(npstn))
762 ALLOCATE(index2d(npstn))
763
764 IF (is_sequential) THEN
765 ! klon_mpi_begin=1
766 ! klon_mpi_end=klon
767 DO ip=1, npstn
768 fieldok(ip)=buffer_omp(nptabij(ip))
769 ENDDO
770 ELSE
771 DO ip=1, npstn
772 ! print*,'histwrite2d is_sequential npstn ip name nptabij',npstn,ip,name,nptabij(ip)
773 IF(nptabij(ip).GE.klon_mpi_begin.AND. &
774 nptabij(ip).LE.klon_mpi_end) THEN
775 fieldok(ip)=buffer_omp(nptabij(ip)-klon_mpi_begin+1)
776 ENDIF
777 ENDDO
778 ENDIF
779 IF (prt_level >= 10) write(lunout,*)'Sending ',name,' to IOIPSL'
780 CALL histwrite(nid,name,itau,fieldok,npstn,index2d)
781 IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL'
782 !
783 ENDIF
784 DEALLOCATE(index2d)
785 DEALLOCATE(fieldok)
786 !$OMP END MASTER
787
788
789 END SUBROUTINE histwrite2d_phy_old
790
791 SUBROUTINE histwrite3d_phy_old(nid,lpoint,name,itau,field)
792
793 USE dimphy, ONLY: klon
794 USE mod_phys_lmdz_para, ONLY: Gather_omp, grid1Dto2D_mpi, &
795 is_sequential, klon_mpi_begin, klon_mpi_end, &
796 jj_nb, klon_mpi, is_master
797 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat
798 USE ioipsl, ONLY: histwrite
799 USE print_control_mod, ONLY: prt_level,lunout
800
801 IMPLICIT NONE
802
803 INTEGER,INTENT(IN) :: nid
804 LOGICAL,INTENT(IN) :: lpoint
805 CHARACTER*(*), INTENT(IN) :: name
806 INTEGER, INTENT(IN) :: itau
807 REAL,DIMENSION(:,:),INTENT(IN) :: field ! --> field(klon,:)
808 REAL,DIMENSION(klon_mpi,size(field,2)) :: buffer_omp
809 REAL :: Field3d(nbp_lon,jj_nb,size(field,2))
810 INTEGER :: ip, n, nlev
811 INTEGER, ALLOCATABLE, DIMENSION(:) :: index3d
812 REAL,allocatable, DIMENSION(:,:) :: fieldok
813
814 IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite3d_phy_old for ', name
815
816 IF (size(field,1)/=klon) CALL abort_physic('iophy::histwrite3d','Field first DIMENSION not equal to klon',1)
817 nlev=size(field,2)
818
819 CALL Gather_omp(field,buffer_omp)
820 !$OMP MASTER
821 CALL grid1Dto2D_mpi(buffer_omp,field3d)
822 IF (.NOT.lpoint) THEN
823 ALLOCATE(index3d(nbp_lon*jj_nb*nlev))
824 ALLOCATE(fieldok(nbp_lon*jj_nb,nlev))
825 IF (prt_level >= 10) write(lunout,*)'Sending ',name,' to IOIPSL'
826 CALL histwrite(nid,name,itau,Field3d,nbp_lon*jj_nb*nlev,index3d)
827 IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL'
828 ELSE
829 nlev=size(field,2)
830 ALLOCATE(index3d(npstn*nlev))
831 ALLOCATE(fieldok(npstn,nlev))
832
833 IF (is_sequential) THEN
834 ! klon_mpi_begin=1
835 ! klon_mpi_end=klon
836 DO n=1, nlev
837 DO ip=1, npstn
838 fieldok(ip,n)=buffer_omp(nptabij(ip),n)
839 ENDDO
840 ENDDO
841 ELSE
842 DO n=1, nlev
843 DO ip=1, npstn
844 IF(nptabij(ip).GE.klon_mpi_begin.AND. &
845 nptabij(ip).LE.klon_mpi_end) THEN
846 fieldok(ip,n)=buffer_omp(nptabij(ip)-klon_mpi_begin+1,n)
847 ENDIF
848 ENDDO
849 ENDDO
850 ENDIF
851 IF (prt_level >= 10) write(lunout,*)'Sending ',name,' to IOIPSL'
852 CALL histwrite(nid,name,itau,fieldok,npstn*nlev,index3d)
853 IF (prt_level >= 10) write(lunout,*)'Finished sending ',name,' to IOIPSL'
854 ENDIF
855 DEALLOCATE(index3d)
856 DEALLOCATE(fieldok)
857 !$OMP END MASTER
858
859 END SUBROUTINE histwrite3d_phy_old
860
861
862 ! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
863
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 364598 times.
364598 SUBROUTINE histwrite2d_phy(var,field, STD_iff)
864
865 USE mod_phys_lmdz_omp_transfert, ONLY: bcast_omp
866 USE dimphy, ONLY: klon, klev
867 USE mod_phys_lmdz_para, ONLY: gather_omp, grid1dto2d_mpi, &
868 jj_nb, klon_mpi, klon_mpi_begin, &
869 klon_mpi_end, is_sequential, is_master
870 USE ioipsl, ONLY: histwrite
871 USE phys_output_var_mod, ONLY: ctrl_out, clef_files, lev_files, &
872 nfiles, vars_defined, clef_stations, &
873 nid_files, swaerofree_diag, swaero_diag, dryaod_diag, ok_4xCO2atm
874 USE print_control_mod, ONLY: prt_level,lunout
875 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid_type, unstructured, regular_lonlat
876 USE print_control_mod, ONLY: lunout, prt_level
877
878 IMPLICIT NONE
879 INCLUDE 'clesphys.h'
880
881 TYPE(ctrl_out), INTENT(IN) :: var
882 REAL, DIMENSION(:), INTENT(IN) :: field
883 INTEGER, INTENT(IN), OPTIONAL :: STD_iff ! ug RUSTINE POUR LES STD LEVS.....
884
885 INTEGER :: iff, iff_beg, iff_end
886 LOGICAL, SAVE :: firstx
887 !$OMP THREADPRIVATE(firstx)
888
889 729196 REAL,DIMENSION(klon_mpi) :: buffer_omp
890 INTEGER, allocatable, DIMENSION(:) :: index2d
891 729196 REAL :: Field2d(nbp_lon,jj_nb)
892
893 INTEGER :: ip
894 364598 REAL, ALLOCATABLE, DIMENSION(:) :: fieldok
895
896
1/4
✗ Branch 0 not taken.
✓ Branch 1 taken 364598 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
364598 IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite2d_phy for ',trim(var%name)
897
898
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 364598 times.
364598 IF (prt_level >= 10) THEN
899 WRITE(lunout,*)'Begin histwrite2d_phy for ',trim(var%name)
900 ENDIF
901
902 ! ug RUSTINE POUR LES STD LEVS.....
903
2/2
✓ Branch 0 taken 202020 times.
✓ Branch 1 taken 162578 times.
364598 IF (PRESENT(STD_iff)) THEN
904 202020 iff_beg = STD_iff
905 iff_end = STD_iff
906 ELSE
907 iff_beg = 1
908 iff_end = nfiles
909 ENDIF
910
911 ! On regarde si on est dans la phase de définition ou d'écriture:
912
2/2
✓ Branch 0 taken 758 times.
✓ Branch 1 taken 363840 times.
364598 IF (.NOT.vars_defined) THEN
913 !$OMP MASTER
914 !Si phase de définition.... on définit
915 758 IF (.not. ok_all_xml) THEN
916
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 758 times.
758 IF (prt_level >= 10) THEN
917 write(lunout,*)"histwrite2d_phy: .not.vars_defined ; time to define ", &
918 trim(var%name)
919 ENDIF
920
2/2
✓ Branch 0 taken 3800 times.
✓ Branch 1 taken 758 times.
4558 DO iff=iff_beg, iff_end
921
2/2
✓ Branch 0 taken 1520 times.
✓ Branch 1 taken 2280 times.
4558 IF (clef_files(iff)) THEN
922 1520 CALL histdef2d(iff, var)
923 ENDIF
924 ENDDO
925 ENDIF
926 !$OMP END MASTER
927 !--broadcasting the flags that have been changed in histdef2d on OMP masters
928 758 CALL bcast_omp(swaero_diag)
929 758 CALL bcast_omp(swaerofree_diag)
930 758 CALL bcast_omp(dryaod_diag)
931 758 CALL bcast_omp(ok_4xCO2atm)
932
933 ELSE
934
935 !Et sinon on.... écrit
936
1/6
✗ Branch 0 not taken.
✓ Branch 1 taken 363840 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✗ Branch 5 not taken.
363840 IF (SIZE(field)/=klon .AND. SIZE(field)/=klev .AND. SIZE(field)/=klev+1) CALL abort_physic('iophy::histwrite2d_phy','Field first DIMENSION not equal to klon/klev',1)
937
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 363840 times.
363840 IF (prt_level >= 10) THEn
938 WRITE (lunout,*)"histwrite2d_phy: .not.vars_defined ; time to gather and write ", trim(var%name)
939 ENDIF
940
941
942
1/2
✓ Branch 0 taken 363840 times.
✗ Branch 1 not taken.
363840 IF (SIZE(field) == klon) then
943 363840 CALL Gather_omp(field,buffer_omp)
944 ELSE
945 buffer_omp(:)=0.
946 ENDIF
947 !$OMP MASTER
948
1/2
✓ Branch 0 taken 363840 times.
✗ Branch 1 not taken.
363840 IF (grid_type==regular_lonlat) CALL grid1Dto2D_mpi(buffer_omp,Field2d)
949
950 ! La boucle sur les fichiers:
951 363840 firstx=.true.
952
953 363840 IF (ok_all_xml) THEN
954 CALL abort_physic ('iophy','cannot have ok_all_xml = .T. without CPP_XIOS defined' ,1)
955 ELSE
956
2/2
✓ Branch 0 taken 1824000 times.
✓ Branch 1 taken 363840 times.
2187840 DO iff=iff_beg, iff_end
957
4/4
✓ Branch 0 taken 256800 times.
✓ Branch 1 taken 1567200 times.
✓ Branch 2 taken 253440 times.
✓ Branch 3 taken 3360 times.
2187840 IF (var%flag(iff) <= lev_files(iff) .AND. clef_files(iff)) THEN
958
959
960
1/2
✓ Branch 0 taken 253440 times.
✗ Branch 1 not taken.
253440 IF (.NOT.clef_stations(iff)) THEN
961
2/4
✓ Branch 0 taken 253440 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 253440 times.
253440 ALLOCATE(index2d(nbp_lon*jj_nb))
962
3/6
✓ Branch 0 taken 253440 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 253440 times.
✗ Branch 5 not taken.
✓ Branch 6 taken 253440 times.
253440 ALLOCATE(fieldok(nbp_lon*jj_nb))
963 253440 CALL histwrite(nid_files(iff),var%name,itau_iophy,Field2d,nbp_lon*jj_nb,index2d)
964 !#ifdef CPP_XIOS
965 ! IF (iff == iff_beg) THEN
966 ! IF (prt_level >= 10) THEN
967 ! write(lunout,*)"histwrite2d_phy: .NOT.clef_stations(iff) and iff==iff_beg, call xios_send_field"
968 ! ENDIF
969 ! CALL xios_send_field(var%name, Field2d)
970 ! ENDIF
971 !#endif
972 ELSE
973 ALLOCATE(fieldok(npstn))
974 ALLOCATE(index2d(npstn))
975
976 IF (is_sequential) THEN
977 DO ip=1, npstn
978 fieldok(ip)=buffer_omp(nptabij(ip))
979 ENDDO
980 ELSE
981 DO ip=1, npstn
982 write(lunout,*)'histwrite2d_phy is_sequential npstn ip namenptabij',npstn,ip,var%name,nptabij(ip)
983 IF(nptabij(ip).GE.klon_mpi_begin.AND. &
984 nptabij(ip).LE.klon_mpi_end) THEN
985 fieldok(ip)=buffer_omp(nptabij(ip)-klon_mpi_begin+1)
986 ENDIF
987 ENDDO
988 ENDIF ! of IF (is_sequential)
989 IF (prt_level >= 10) THEN
990 write(lunout,*)"histwrite2d_phy: clef_stations(iff) and iff==iff_beg, call wxios_write_2D"
991 ENDIF
992 CALL histwrite(nid_files(iff),var%name,itau_iophy,fieldok,npstn,index2d)
993 ENDIF ! of IF(.NOT.clef_stations(iff))
994
995
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 253440 times.
253440 DEALLOCATE(index2d)
996
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 253440 times.
253440 DEALLOCATE(fieldok)
997 ENDIF !levfiles
998 ENDDO ! of DO iff=iff_beg, iff_end
999 ENDIF
1000 !$OMP END MASTER
1001 ENDIF ! vars_defined
1002
1003
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 364598 times.
364598 IF (prt_level >= 10) WRITE(lunout,*)'End histwrite2d_phy ',trim(var%name)
1004
1005
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 364598 times.
364598 END SUBROUTINE histwrite2d_phy
1006
1007
1008 ! ug NOUVELLE VERSION DES WRITE AVEC LA BOUCLE DO RENTREE
1009
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 122174 times.
122174 SUBROUTINE histwrite3d_phy(var, field, STD_iff)
1010
1011
2/4
✓ Branch 0 taken 758 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 363840 times.
364598 USE mod_phys_lmdz_omp_transfert, ONLY: bcast_omp
1012 USE dimphy, ONLY: klon, klev
1013 USE mod_phys_lmdz_para, ONLY: gather_omp, grid1dto2d_mpi, &
1014 jj_nb, klon_mpi, klon_mpi_begin, &
1015 klon_mpi_end, is_sequential, is_master
1016 USE ioipsl, ONLY: histwrite
1017 USE phys_output_var_mod, ONLY: ctrl_out, clef_files, lev_files, &
1018 nfiles, vars_defined, clef_stations, &
1019 nid_files, swaerofree_diag
1020 USE mod_grid_phy_lmdz, ONLY : nbp_lon, nbp_lat, grid_type, regular_lonlat, unstructured
1021 USE print_control_mod, ONLY: prt_level,lunout
1022
1023 IMPLICIT NONE
1024 INCLUDE 'clesphys.h'
1025
1026 TYPE(ctrl_out), INTENT(IN) :: var
1027 REAL, DIMENSION(:,:), INTENT(IN) :: field ! --> field(klon,:)
1028 INTEGER, INTENT(IN), OPTIONAL :: STD_iff ! ug RUSTINE POUR LES STD LEVS.....
1029
1030 INTEGER :: iff, iff_beg, iff_end
1031 LOGICAL, SAVE :: firstx
1032 !$OMP THREADPRIVATE(firstx)
1033 244348 REAL,DIMENSION(klon_mpi,SIZE(field,2)) :: buffer_omp
1034 244348 REAL :: Field3d(nbp_lon,jj_nb,SIZE(field,2))
1035 INTEGER :: ip, n, nlev, nlevx
1036 INTEGER, ALLOCATABLE, DIMENSION(:) :: index3d
1037 122174 REAL,ALLOCATABLE, DIMENSION(:,:) :: fieldok
1038
1039
1/4
✗ Branch 0 not taken.
✓ Branch 1 taken 122174 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
122174 IF (check_dim .AND. is_master) WRITE(lunout,*)'histwrite3d_phy for ', trim(var%name)
1040
1041
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 122174 times.
122174 IF (prt_level >= 10) write(lunout,*)'Begin histrwrite3d ',var%name
1042
1043 ! ug RUSTINE POUR LES STD LEVS.....
1044
2/2
✓ Branch 0 taken 27417 times.
✓ Branch 1 taken 94757 times.
122174 IF (PRESENT(STD_iff)) THEN
1045 27417 iff_beg = STD_iff
1046 iff_end = STD_iff
1047 ELSE
1048 iff_beg = 1
1049 iff_end = nfiles
1050 ENDIF
1051
1052 ! On regarde si on est dans la phase de définition ou d'écriture:
1053
2/2
✓ Branch 0 taken 254 times.
✓ Branch 1 taken 121920 times.
122174 IF (.NOT.vars_defined) THEN
1054 !Si phase de définition.... on définit
1055 !$OMP MASTER
1056
2/2
✓ Branch 0 taken 2027 times.
✓ Branch 1 taken 254 times.
2281 DO iff=iff_beg, iff_end
1057
2/2
✓ Branch 0 taken 788 times.
✓ Branch 1 taken 1239 times.
2281 IF (clef_files(iff)) THEN
1058 788 CALL histdef3d(iff, var)
1059 ENDIF
1060 ENDDO
1061 !$OMP END MASTER
1062 !--broadcasting the flag that have been changed in histdef3d on OMP masters
1063 254 CALL bcast_omp(swaerofree_diag)
1064 ELSE
1065 !Et sinon on.... écrit
1066
1067
1/6
✗ Branch 0 not taken.
✓ Branch 1 taken 121920 times.
✗ Branch 2 not taken.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✗ Branch 5 not taken.
121920 IF (SIZE(field,1)/=klon .AND. SIZE(field,1)/=klev .AND. SIZE(field,1)/=klev+1) CALL abort_physic('iophy::histwrite3d_phy','Field first DIMENSION not equal to klon/klev',1)
1068
1069 nlev=SIZE(field,2)
1070 IF (nlev.EQ.klev+1) THEN
1071 nlevx=klev
1072 ELSE
1073 nlevx=nlev
1074 ENDIF
1075
1076
1/2
✓ Branch 0 taken 121920 times.
✗ Branch 1 not taken.
121920 IF (SIZE(field,1) == klon) then
1077 121920 CALL Gather_omp(field,buffer_omp)
1078 ELSE
1079 buffer_omp(:,:)=0.
1080 ENDIF
1081 !$OMP MASTER
1082
1/2
✓ Branch 0 taken 121920 times.
✗ Branch 1 not taken.
121920 IF (grid_type==regular_lonlat) CALL grid1Dto2D_mpi(buffer_omp,field3d)
1083
1084 ! BOUCLE SUR LES FICHIERS
1085 121920 firstx=.true.
1086
1087
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 121920 times.
121920 IF (ok_all_xml) THEN
1088 CALL abort_physic ('iophy','cannot have ok_all_xml = .T. without CPP_XIOS defined' ,1)
1089 ELSE
1090
1091
2/2
✓ Branch 0 taken 972960 times.
✓ Branch 1 taken 121920 times.
1094880 DO iff=iff_beg, iff_end
1092
4/4
✓ Branch 0 taken 137280 times.
✓ Branch 1 taken 835680 times.
✓ Branch 2 taken 122880 times.
✓ Branch 3 taken 14400 times.
1094880 IF (var%flag(iff) <= lev_files(iff) .AND. clef_files(iff)) THEN
1093
1/2
✓ Branch 0 taken 122880 times.
✗ Branch 1 not taken.
122880 IF (.NOT.clef_stations(iff)) THEN
1094
2/4
✓ Branch 0 taken 122880 times.
✗ Branch 1 not taken.
✗ Branch 2 not taken.
✓ Branch 3 taken 122880 times.
122880 ALLOCATE(index3d(nbp_lon*jj_nb*nlev))
1095
5/10
✓ Branch 0 taken 122880 times.
✗ Branch 1 not taken.
✓ Branch 2 taken 122880 times.
✗ Branch 3 not taken.
✗ Branch 4 not taken.
✓ Branch 5 taken 122880 times.
✗ Branch 7 not taken.
✓ Branch 8 taken 122880 times.
✗ Branch 10 not taken.
✓ Branch 11 taken 122880 times.
245760 ALLOCATE(fieldok(nbp_lon*jj_nb,nlev))
1096
1097 122880 CALL histwrite(nid_files(iff),var%name,itau_iophy,Field3d,nbp_lon*jj_nb*nlev,index3d)
1098
1099 !#ifdef CPP_XIOS
1100 ! IF (iff == 1) THEN
1101 ! CALL xios_send_field(var%name, Field3d(:,:,1:klev))
1102 ! ENDIF
1103 !#endif
1104 !
1105 ELSE
1106 nlev=size(field,2)
1107 ALLOCATE(index3d(npstn*nlev))
1108 ALLOCATE(fieldok(npstn,nlev))
1109
1110 IF (is_sequential) THEN
1111 DO n=1, nlev
1112 DO ip=1, npstn
1113 fieldok(ip,n)=buffer_omp(nptabij(ip),n)
1114 ENDDO
1115 ENDDO
1116 ELSE
1117 DO n=1, nlev
1118 DO ip=1, npstn
1119 IF(nptabij(ip).GE.klon_mpi_begin.AND. &
1120 nptabij(ip).LE.klon_mpi_end) THEN
1121 fieldok(ip,n)=buffer_omp(nptabij(ip)-klon_mpi_begin+1,n)
1122 ENDIF
1123 ENDDO
1124 ENDDO
1125 ENDIF
1126 CALL histwrite(nid_files(iff),var%name,itau_iophy,fieldok,npstn*nlev,index3d)
1127 ENDIF
1128
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 122880 times.
122880 DEALLOCATE(index3d)
1129
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 122880 times.
122880 DEALLOCATE(fieldok)
1130 ENDIF
1131 ENDDO
1132 ENDIF
1133 !$OMP END MASTER
1134 ENDIF ! vars_defined
1135
1136
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 122174 times.
122174 IF (prt_level >= 10) write(lunout,*)'End histrwrite3d ',var%name
1137
1138
1/2
✗ Branch 0 not taken.
✓ Branch 1 taken 122174 times.
122174 END SUBROUTINE histwrite3d_phy
1139
1140
1141 ! VERSION DES HISTWRITE DEDIEES AU TOUT-XIOS-XML DEJA UTILISEE DANS PHYDEV
1142 END MODULE iophy
1143