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 |