| GCC Code Coverage Report | |||||||||||||||||||||
|
|||||||||||||||||||||
| Line | Branch | Exec | Source |
1 |
MODULE iostart |
||
2 |
|||
3 |
PRIVATE |
||
4 |
INTEGER,SAVE :: nid_start |
||
5 |
INTEGER,SAVE :: nid_restart |
||
6 |
|||
7 |
INTEGER,SAVE :: idim1,idim2,idim3,idim4 |
||
8 |
INTEGER,PARAMETER :: length=100 |
||
9 |
|||
10 |
INTERFACE get_field |
||
11 |
MODULE PROCEDURE Get_field_r1,Get_field_r2,Get_field_r3 |
||
12 |
END INTERFACE get_field |
||
13 |
|||
14 |
INTERFACE get_var |
||
15 |
MODULE PROCEDURE get_var_r0,Get_var_r1,Get_var_r2,Get_var_r3 |
||
16 |
END INTERFACE get_var |
||
17 |
|||
18 |
INTERFACE put_field |
||
19 |
MODULE PROCEDURE put_field_r1,put_field_r2,put_field_r3 |
||
20 |
END INTERFACE put_field |
||
21 |
|||
22 |
INTERFACE put_var |
||
23 |
MODULE PROCEDURE put_var_r0,put_var_r1,put_var_r2,put_var_r3 |
||
24 |
END INTERFACE put_var |
||
25 |
|||
26 |
PUBLIC get_field,get_var,put_field,put_var |
||
27 |
PUBLIC Open_startphy,close_startphy,open_restartphy,close_restartphy, enddef_restartphy |
||
28 |
|||
29 |
CONTAINS |
||
30 |
|||
31 |
1 |
SUBROUTINE Open_startphy(filename) |
|
32 |
USE netcdf |
||
33 |
USE mod_phys_lmdz_para |
||
34 |
IMPLICIT NONE |
||
35 |
CHARACTER(LEN=*) :: filename |
||
36 |
INTEGER :: ierr |
||
37 |
|||
38 |
✓✗✓✗ |
1 |
IF (is_mpi_root .AND. is_omp_root) THEN |
39 |
1 |
ierr = NF90_OPEN (filename, NF90_NOWRITE,nid_start) |
|
40 |
✗✓ | 1 |
IF (ierr.NE.NF90_NOERR) THEN |
41 |
write(6,*)' Pb d''ouverture du fichier '//filename |
||
42 |
write(6,*)' ierr = ', ierr |
||
43 |
CALL abort_physic("", "", 1) |
||
44 |
ENDIF |
||
45 |
ENDIF |
||
46 |
|||
47 |
1 |
END SUBROUTINE Open_startphy |
|
48 |
|||
49 |
1 |
SUBROUTINE Close_startphy |
|
50 |
USE netcdf |
||
51 |
USE mod_phys_lmdz_para |
||
52 |
IMPLICIT NONE |
||
53 |
INTEGER :: ierr |
||
54 |
|||
55 |
✓✗✓✗ |
1 |
IF (is_mpi_root .AND. is_omp_root) THEN |
56 |
1 |
ierr = NF90_CLOSE (nid_start) |
|
57 |
ENDIF |
||
58 |
|||
59 |
1 |
END SUBROUTINE close_startphy |
|
60 |
|||
61 |
|||
62 |
FUNCTION Inquire_Field(Field_name) |
||
63 |
USE netcdf |
||
64 |
USE mod_phys_lmdz_para |
||
65 |
IMPLICIT NONE |
||
66 |
CHARACTER(LEN=*) :: Field_name |
||
67 |
LOGICAL :: inquire_field |
||
68 |
INTEGER :: varid |
||
69 |
INTEGER :: ierr |
||
70 |
|||
71 |
IF (is_mpi_root .AND. is_omp_root) THEN |
||
72 |
ierr=NF90_INQ_VARID(nid_start,Field_name,varid) |
||
73 |
IF (ierr==NF90_NOERR) THEN |
||
74 |
Inquire_field=.TRUE. |
||
75 |
ELSE |
||
76 |
Inquire_field=.FALSE. |
||
77 |
ENDIF |
||
78 |
ENDIF |
||
79 |
|||
80 |
CALL bcast(Inquire_field) |
||
81 |
|||
82 |
END FUNCTION Inquire_Field |
||
83 |
|||
84 |
|||
85 |
✗✓ | 7 |
SUBROUTINE Get_Field_r1(field_name,field,found) |
86 |
IMPLICIT NONE |
||
87 |
CHARACTER(LEN=*),INTENT(IN) :: Field_name |
||
88 |
REAL,INTENT(INOUT) :: Field(:) |
||
89 |
LOGICAL,INTENT(OUT),OPTIONAL :: found |
||
90 |
|||
91 |
✗✓ | 7 |
CALL Get_field_rgen(field_name,field,1,found) |
92 |
|||
93 |
7 |
END SUBROUTINE Get_Field_r1 |
|
94 |
|||
95 |
✗✓ | 349 |
SUBROUTINE Get_Field_r2(field_name,field,found) |
96 |
IMPLICIT NONE |
||
97 |
CHARACTER(LEN=*),INTENT(IN) :: Field_name |
||
98 |
REAL,INTENT(INOUT) :: Field(:,:) |
||
99 |
LOGICAL,INTENT(OUT),OPTIONAL :: found |
||
100 |
|||
101 |
✗✓ | 349 |
CALL Get_field_rgen(field_name,field,size(field,2),found) |
102 |
|||
103 |
|||
104 |
349 |
END SUBROUTINE Get_Field_r2 |
|
105 |
|||
106 |
SUBROUTINE Get_Field_r3(field_name,field,found) |
||
107 |
IMPLICIT NONE |
||
108 |
CHARACTER(LEN=*),INTENT(IN) :: Field_name |
||
109 |
REAL,INTENT(INOUT) :: Field(:,:,:) |
||
110 |
LOGICAL,INTENT(OUT),OPTIONAL :: found |
||
111 |
|||
112 |
CALL Get_field_rgen(field_name,field,size(field,2)*size(field,3),found) |
||
113 |
|||
114 |
END SUBROUTINE Get_Field_r3 |
||
115 |
|||
116 |
356 |
SUBROUTINE Get_field_rgen(field_name,field,field_size,found) |
|
117 |
USE netcdf |
||
118 |
USE dimphy |
||
119 |
USE geometry_mod |
||
120 |
USE mod_grid_phy_lmdz |
||
121 |
USE mod_phys_lmdz_para |
||
122 |
IMPLICIT NONE |
||
123 |
CHARACTER(LEN=*) :: Field_name |
||
124 |
INTEGER :: field_size |
||
125 |
REAL :: field(klon,field_size) |
||
126 |
LOGICAL,OPTIONAL :: found |
||
127 |
|||
128 |
356 |
REAL,ALLOCATABLE :: field_glo(:,:) |
|
129 |
REAL,ALLOCATABLE :: field_glo_tmp(:,:) |
||
130 |
356 |
INTEGER,ALLOCATABLE :: ind_cell_glo_glo(:) |
|
131 |
LOGICAL :: tmp_found |
||
132 |
INTEGER :: varid |
||
133 |
INTEGER :: ierr,i |
||
134 |
|||
135 |
✓✗ | 356 |
IF (is_master) THEN |
136 |
✓✗✗✓ |
356 |
ALLOCATE(ind_cell_glo_glo(klon_glo)) |
137 |
✓✗✓✗ ✗✓✗✓ |
712 |
ALLOCATE(field_glo(klon_glo,field_size)) |
138 |
✓✗✗✓ ✗✓ |
712 |
ALLOCATE(field_glo_tmp(klon_glo,field_size)) |
139 |
ELSE |
||
140 |
ALLOCATE(ind_cell_glo_glo(0)) |
||
141 |
ALLOCATE(field_glo(0,0)) |
||
142 |
ENDIF |
||
143 |
|||
144 |
356 |
CALL gather(ind_cell_glo,ind_cell_glo_glo) |
|
145 |
|||
146 |
✓✗ | 356 |
IF (is_master) THEN |
147 |
|||
148 |
356 |
ierr=NF90_INQ_VARID(nid_start,Field_name,varid) |
|
149 |
|||
150 |
✓✓ | 356 |
IF (ierr==NF90_NOERR) THEN |
151 |
326 |
CALL body(field_glo_tmp) |
|
152 |
326 |
tmp_found=.TRUE. |
|
153 |
ELSE |
||
154 |
30 |
tmp_found=.FALSE. |
|
155 |
ENDIF |
||
156 |
|||
157 |
ENDIF |
||
158 |
|||
159 |
356 |
CALL bcast(tmp_found) |
|
160 |
|||
161 |
✓✓ | 356 |
IF (tmp_found) THEN |
162 |
✓✗ | 326 |
IF (is_master) THEN |
163 |
✓✓ | 324370 |
DO i=1,klon_glo |
164 |
✓✓ | 1565876 |
field_glo(i,:)=field_glo_tmp(ind_cell_glo_glo(i),:) |
165 |
ENDDO |
||
166 |
ENDIF |
||
167 |
326 |
CALL scatter(field_glo,field) |
|
168 |
ENDIF |
||
169 |
|||
170 |
✓✓✓✗ ✓✗✓✗ |
712 |
IF (PRESENT(found)) THEN |
171 |
354 |
found=tmp_found |
|
172 |
ELSE |
||
173 |
✗✓ | 2 |
IF (.NOT. tmp_found) THEN |
174 |
PRINT*, 'phyetat0: Le champ <'//field_name//'> est absent' |
||
175 |
call abort_physic("", "", 1) |
||
176 |
ENDIF |
||
177 |
ENDIF |
||
178 |
|||
179 |
|||
180 |
CONTAINS |
||
181 |
|||
182 |
326 |
SUBROUTINE body(field_glo) |
|
183 |
REAL :: field_glo(klon_glo*field_size) |
||
184 |
326 |
ierr=NF90_GET_VAR(nid_start,varid,field_glo) |
|
185 |
✗✓ | 326 |
IF (ierr/=NF90_NOERR) THEN |
186 |
! La variable exist dans le fichier mais la lecture a echouee. |
||
187 |
PRINT*, 'phyetat0: Lecture echouee pour <'//field_name//'>' |
||
188 |
|||
189 |
IF (field_name=='CLWCON' .OR. field_name=='RNEBCON' .OR. field_name=='RATQS') THEN |
||
190 |
! Essaye de lire le variable sur surface uniqument, comme fait avant |
||
191 |
field_glo(:)=0. |
||
192 |
ierr=NF90_GET_VAR(nid_start,varid,field_glo(1:klon_glo)) |
||
193 |
IF (ierr/=NF90_NOERR) THEN |
||
194 |
PRINT*, 'phyetat0: Lecture echouee aussi en 2D pour <'//field_name//'>' |
||
195 |
call abort_physic("", "", 1) |
||
196 |
ELSE |
||
197 |
PRINT*, 'phyetat0: La variable <'//field_name//'> lu sur surface seulement'!, selon ancien format, le reste mis a zero' |
||
198 |
END IF |
||
199 |
ELSE |
||
200 |
call abort_physic("", "", 1) |
||
201 |
ENDIF |
||
202 |
ENDIF |
||
203 |
|||
204 |
326 |
END SUBROUTINE body |
|
205 |
|||
206 |
END SUBROUTINE Get_field_rgen |
||
207 |
|||
208 |
|||
209 |
SUBROUTINE get_var_r0(var_name,var,found) |
||
210 |
IMPLICIT NONE |
||
211 |
CHARACTER(LEN=*),INTENT(IN) :: var_name |
||
212 |
REAL,INTENT(INOUT) :: var |
||
213 |
LOGICAL,OPTIONAL,INTENT(OUT) :: found |
||
214 |
|||
215 |
REAL :: varout(1) |
||
216 |
|||
217 |
CALL Get_var_rgen(var_name,varout,size(varout),found) |
||
218 |
var=varout(1) |
||
219 |
|||
220 |
END SUBROUTINE get_var_r0 |
||
221 |
|||
222 |
✗✓ | 1 |
SUBROUTINE get_var_r1(var_name,var,found) |
223 |
IMPLICIT NONE |
||
224 |
CHARACTER(LEN=*),INTENT(IN) :: var_name |
||
225 |
REAL,INTENT(INOUT) :: var(:) |
||
226 |
LOGICAL,OPTIONAL,INTENT(OUT) :: found |
||
227 |
|||
228 |
✗✓ | 1 |
CALL Get_var_rgen(var_name,var,size(var),found) |
229 |
|||
230 |
1 |
END SUBROUTINE get_var_r1 |
|
231 |
|||
232 |
SUBROUTINE get_var_r2(var_name,var,found) |
||
233 |
IMPLICIT NONE |
||
234 |
CHARACTER(LEN=*),INTENT(IN) :: var_name |
||
235 |
REAL,INTENT(OUT) :: var(:,:) |
||
236 |
LOGICAL,OPTIONAL,INTENT(OUT) :: found |
||
237 |
|||
238 |
CALL Get_var_rgen(var_name,var,size(var),found) |
||
239 |
|||
240 |
END SUBROUTINE get_var_r2 |
||
241 |
|||
242 |
SUBROUTINE get_var_r3(var_name,var,found) |
||
243 |
IMPLICIT NONE |
||
244 |
CHARACTER(LEN=*),INTENT(IN) :: var_name |
||
245 |
REAL,INTENT(INOUT) :: var(:,:,:) |
||
246 |
LOGICAL,OPTIONAL,INTENT(OUT) :: found |
||
247 |
|||
248 |
CALL Get_var_rgen(var_name,var,size(var),found) |
||
249 |
|||
250 |
END SUBROUTINE get_var_r3 |
||
251 |
|||
252 |
1 |
SUBROUTINE Get_var_rgen(var_name,var,var_size,found) |
|
253 |
USE netcdf |
||
254 |
USE dimphy |
||
255 |
USE mod_grid_phy_lmdz |
||
256 |
USE mod_phys_lmdz_para |
||
257 |
IMPLICIT NONE |
||
258 |
CHARACTER(LEN=*) :: var_name |
||
259 |
INTEGER :: var_size |
||
260 |
REAL :: var(var_size) |
||
261 |
LOGICAL,OPTIONAL :: found |
||
262 |
|||
263 |
LOGICAL :: tmp_found |
||
264 |
INTEGER :: varid |
||
265 |
INTEGER :: ierr |
||
266 |
|||
267 |
✓✗✓✗ |
1 |
IF (is_mpi_root .AND. is_omp_root) THEN |
268 |
|||
269 |
1 |
ierr=NF90_INQ_VARID(nid_start,var_name,varid) |
|
270 |
|||
271 |
✓✗ | 1 |
IF (ierr==NF90_NOERR) THEN |
272 |
1 |
ierr=NF90_GET_VAR(nid_start,varid,var) |
|
273 |
✗✓ | 1 |
IF (ierr/=NF90_NOERR) THEN |
274 |
PRINT*, 'phyetat0: Lecture echouee pour <'//var_name//'>' |
||
275 |
call abort_physic("", "", 1) |
||
276 |
ENDIF |
||
277 |
1 |
tmp_found=.TRUE. |
|
278 |
ELSE |
||
279 |
tmp_found=.FALSE. |
||
280 |
ENDIF |
||
281 |
|||
282 |
ENDIF |
||
283 |
|||
284 |
1 |
CALL bcast(tmp_found) |
|
285 |
|||
286 |
✓✗ | 1 |
IF (tmp_found) THEN |
287 |
1 |
CALL bcast(var) |
|
288 |
ENDIF |
||
289 |
|||
290 |
✗✓ | 1 |
IF (PRESENT(found)) THEN |
291 |
found=tmp_found |
||
292 |
ELSE |
||
293 |
✗✓ | 1 |
IF (.NOT. tmp_found) THEN |
294 |
PRINT*, 'phyetat0: La variable champ <'//var_name//'> est absente' |
||
295 |
call abort_physic("", "", 1) |
||
296 |
ENDIF |
||
297 |
ENDIF |
||
298 |
|||
299 |
1 |
END SUBROUTINE Get_var_rgen |
|
300 |
|||
301 |
|||
302 |
1 |
SUBROUTINE open_restartphy(filename) |
|
303 |
USE netcdf |
||
304 |
USE mod_phys_lmdz_para, ONLY: is_master |
||
305 |
USE mod_grid_phy_lmdz, ONLY: klon_glo |
||
306 |
USE dimphy, ONLY: klev, klevp1 |
||
307 |
USE print_control_mod, ONLY: lunout |
||
308 |
IMPLICIT NONE |
||
309 |
CHARACTER(LEN=*),INTENT(IN) :: filename |
||
310 |
INTEGER :: ierr |
||
311 |
|||
312 |
✓✗ | 1 |
IF (is_master) THEN |
313 |
ierr = NF90_CREATE(filename, IOR(NF90_CLOBBER,NF90_64BIT_OFFSET), & |
||
314 |
1 |
nid_restart) |
|
315 |
✗✓ | 1 |
IF (ierr/=NF90_NOERR) THEN |
316 |
write(lunout,*)'open_restartphy: problem creating file '//trim(filename) |
||
317 |
write(lunout,*)trim(nf90_strerror(ierr)) |
||
318 |
CALL abort_physic("open_restartphy", trim(nf90_strerror(ierr)), 1) |
||
319 |
ENDIF |
||
320 |
|||
321 |
1 |
ierr = NF90_PUT_ATT (nid_restart, NF90_GLOBAL, "title","Fichier redemmarage physique") |
|
322 |
|||
323 |
1 |
ierr = NF90_DEF_DIM (nid_restart, "index", length, idim1) |
|
324 |
1 |
ierr = NF90_DEF_DIM (nid_restart, "points_physiques", klon_glo, idim2) |
|
325 |
1 |
ierr = NF90_DEF_DIM (nid_restart, "horizon_vertical", klon_glo*klev, idim3) |
|
326 |
1 |
ierr = NF90_DEF_DIM (nid_restart, "horizon_klevp1", klon_glo*klevp1, idim4) |
|
327 |
|||
328 |
! ierr = NF90_ENDDEF(nid_restart) |
||
329 |
ENDIF |
||
330 |
|||
331 |
1 |
END SUBROUTINE open_restartphy |
|
332 |
|||
333 |
1 |
SUBROUTINE enddef_restartphy |
|
334 |
USE netcdf |
||
335 |
USE mod_phys_lmdz_para |
||
336 |
IMPLICIT NONE |
||
337 |
INTEGER :: ierr |
||
338 |
|||
339 |
✓✗ | 1 |
IF (is_master) ierr = NF90_ENDDEF(nid_restart) |
340 |
|||
341 |
1 |
END SUBROUTINE enddef_restartphy |
|
342 |
|||
343 |
1 |
SUBROUTINE close_restartphy |
|
344 |
USE netcdf |
||
345 |
USE mod_phys_lmdz_para |
||
346 |
IMPLICIT NONE |
||
347 |
INTEGER :: ierr |
||
348 |
|||
349 |
✓✗ | 1 |
IF (is_master) ierr = NF90_CLOSE (nid_restart) |
350 |
|||
351 |
1 |
END SUBROUTINE close_restartphy |
|
352 |
|||
353 |
|||
354 |
✗✓ | 364 |
SUBROUTINE put_field_r1(pass, field_name,title,field) |
355 |
IMPLICIT NONE |
||
356 |
INTEGER, INTENT(IN) :: pass |
||
357 |
CHARACTER(LEN=*),INTENT(IN) :: field_name |
||
358 |
CHARACTER(LEN=*),INTENT(IN) :: title |
||
359 |
REAL,INTENT(IN) :: field(:) |
||
360 |
✗✓ | 364 |
CALL put_field_rgen(pass, field_name,title,field,1) |
361 |
|||
362 |
364 |
END SUBROUTINE put_field_r1 |
|
363 |
|||
364 |
✗✓ | 62 |
SUBROUTINE put_field_r2(pass, field_name,title,field) |
365 |
IMPLICIT NONE |
||
366 |
INTEGER, INTENT(IN) :: pass |
||
367 |
CHARACTER(LEN=*),INTENT(IN) :: field_name |
||
368 |
CHARACTER(LEN=*),INTENT(IN) :: title |
||
369 |
REAL,INTENT(IN) :: field(:,:) |
||
370 |
|||
371 |
✗✓ | 62 |
CALL put_field_rgen(pass, field_name,title,field,size(field,2)) |
372 |
|||
373 |
62 |
END SUBROUTINE put_field_r2 |
|
374 |
|||
375 |
SUBROUTINE put_field_r3(pass, field_name,title,field) |
||
376 |
IMPLICIT NONE |
||
377 |
INTEGER, INTENT(IN) :: pass |
||
378 |
CHARACTER(LEN=*),INTENT(IN) :: field_name |
||
379 |
CHARACTER(LEN=*),INTENT(IN) :: title |
||
380 |
REAL,INTENT(IN) :: field(:,:,:) |
||
381 |
|||
382 |
CALL put_field_rgen(pass, field_name,title,field,size(field,2)*size(field,3)) |
||
383 |
|||
384 |
END SUBROUTINE put_field_r3 |
||
385 |
|||
386 |
426 |
SUBROUTINE put_field_rgen(pass, field_name,title,field,field_size) |
|
387 |
USE netcdf |
||
388 |
USE dimphy |
||
389 |
USE geometry_mod |
||
390 |
USE mod_grid_phy_lmdz |
||
391 |
USE mod_phys_lmdz_para |
||
392 |
IMPLICIT NONE |
||
393 |
INTEGER, INTENT(IN) :: pass |
||
394 |
CHARACTER(LEN=*),INTENT(IN) :: field_name |
||
395 |
CHARACTER(LEN=*),INTENT(IN) :: title |
||
396 |
INTEGER,INTENT(IN) :: field_size |
||
397 |
REAL,INTENT(IN) :: field(klon,field_size) |
||
398 |
|||
399 |
! REAL :: field_glo(klon_glo,field_size) |
||
400 |
! REAL :: field_glo_tmp(klon_glo,field_size) |
||
401 |
426 |
REAL ,ALLOCATABLE :: field_glo(:,:) |
|
402 |
426 |
REAL ,ALLOCATABLE :: field_glo_tmp(:,:) |
|
403 |
426 |
INTEGER,ALLOCATABLE :: ind_cell_glo_glo(:) |
|
404 |
! INTEGER :: ind_cell_glo_glo(klon_glo) |
||
405 |
INTEGER :: ierr,i |
||
406 |
INTEGER :: nvarid |
||
407 |
INTEGER :: idim |
||
408 |
|||
409 |
! first pass : definition |
||
410 |
✓✓ | 426 |
IF (pass==1) THEN |
411 |
|||
412 |
✓✗ | 213 |
IF (is_master) THEN |
413 |
|||
414 |
✓✓ | 213 |
IF (field_size==1) THEN |
415 |
182 |
idim=idim2 |
|
416 |
✓✓ | 31 |
ELSE IF (field_size==klev) THEN |
417 |
20 |
idim=idim3 |
|
418 |
✓✗ | 11 |
ELSE IF (field_size==klevp1) THEN |
419 |
11 |
idim=idim4 |
|
420 |
ELSE |
||
421 |
PRINT *, "erreur phyredem : probleme de dimension" |
||
422 |
CALL abort_physic("", "", 1) |
||
423 |
ENDIF |
||
424 |
|||
425 |
! ierr = NF90_REDEF (nid_restart) |
||
426 |
#ifdef NC_DOUBLE |
||
427 |
✓✓ | 426 |
ierr = NF90_DEF_VAR (nid_restart, field_name, NF90_DOUBLE,(/ idim /),nvarid) |
428 |
#else |
||
429 |
ierr = NF90_DEF_VAR (nid_restart, field_name, NF90_FLOAT,(/ idim /),nvarid) |
||
430 |
#endif |
||
431 |
✓✓ | 213 |
IF (LEN_TRIM(title) > 0) ierr = NF90_PUT_ATT (nid_restart,nvarid,"title", title) |
432 |
! ierr = NF90_ENDDEF(nid_restart) |
||
433 |
ENDIF |
||
434 |
|||
435 |
! second pass : write |
||
436 |
✓✗ | 213 |
ELSE IF (pass==2) THEN |
437 |
|||
438 |
✓✗ | 213 |
IF (is_master) THEN |
439 |
✓✗✗✓ |
213 |
ALLOCATE(ind_cell_glo_glo(klon_glo)) |
440 |
✓✗✓✗ ✗✓✗✓ |
426 |
ALLOCATE(field_glo(klon_glo,field_size)) |
441 |
✓✗✗✓ ✗✓ |
426 |
ALLOCATE(field_glo_tmp(klon_glo,field_size)) |
442 |
ELSE |
||
443 |
ALLOCATE(ind_cell_glo_glo(0)) |
||
444 |
ALLOCATE(field_glo_tmp(0,0)) |
||
445 |
ENDIF |
||
446 |
|||
447 |
213 |
CALL gather(ind_cell_glo,ind_cell_glo_glo) |
|
448 |
|||
449 |
213 |
CALL gather(field,field_glo_tmp) |
|
450 |
|||
451 |
✓✗ | 213 |
IF (is_master) THEN |
452 |
|||
453 |
✓✓ | 211935 |
DO i=1,klon_glo |
454 |
✓✓ | 1605523 |
field_glo(ind_cell_glo_glo(i),:)=field_glo_tmp(i,:) |
455 |
ENDDO |
||
456 |
|||
457 |
213 |
ierr = NF90_INQ_VARID(nid_restart, field_name, nvarid) |
|
458 |
✓✓ | 426 |
ierr = NF90_PUT_VAR(nid_restart,nvarid,RESHAPE(field_glo,(/klon_glo*field_size/))) |
459 |
ENDIF |
||
460 |
ENDIF |
||
461 |
|||
462 |
✓✓✓✓ ✓✓ |
426 |
END SUBROUTINE put_field_rgen |
463 |
|||
464 |
|||
465 |
SUBROUTINE put_var_r0(pass, var_name,title,var) |
||
466 |
IMPLICIT NONE |
||
467 |
INTEGER, INTENT(IN) :: pass |
||
468 |
CHARACTER(LEN=*),INTENT(IN) :: var_name |
||
469 |
CHARACTER(LEN=*),INTENT(IN) :: title |
||
470 |
REAL,INTENT(IN) :: var |
||
471 |
REAL :: varin(1) |
||
472 |
|||
473 |
varin(1)=var |
||
474 |
|||
475 |
CALL put_var_rgen(pass, var_name,title,varin,size(varin)) |
||
476 |
|||
477 |
END SUBROUTINE put_var_r0 |
||
478 |
|||
479 |
|||
480 |
✗✓ | 2 |
SUBROUTINE put_var_r1(pass, var_name,title,var) |
481 |
IMPLICIT NONE |
||
482 |
INTEGER, INTENT(IN) :: pass |
||
483 |
CHARACTER(LEN=*),INTENT(IN) :: var_name |
||
484 |
CHARACTER(LEN=*),INTENT(IN) :: title |
||
485 |
REAL,INTENT(IN) :: var(:) |
||
486 |
|||
487 |
✗✓ | 2 |
CALL put_var_rgen(pass, var_name,title,var,size(var)) |
488 |
|||
489 |
2 |
END SUBROUTINE put_var_r1 |
|
490 |
|||
491 |
SUBROUTINE put_var_r2(pass, var_name,title,var) |
||
492 |
IMPLICIT NONE |
||
493 |
INTEGER, INTENT(IN) :: pass |
||
494 |
CHARACTER(LEN=*),INTENT(IN) :: var_name |
||
495 |
CHARACTER(LEN=*),INTENT(IN) :: title |
||
496 |
REAL,INTENT(IN) :: var(:,:) |
||
497 |
|||
498 |
CALL put_var_rgen(pass, var_name,title,var,size(var)) |
||
499 |
|||
500 |
END SUBROUTINE put_var_r2 |
||
501 |
|||
502 |
SUBROUTINE put_var_r3(pass, var_name,title,var) |
||
503 |
IMPLICIT NONE |
||
504 |
INTEGER, INTENT(IN) :: pass |
||
505 |
CHARACTER(LEN=*),INTENT(IN) :: var_name |
||
506 |
CHARACTER(LEN=*),INTENT(IN) :: title |
||
507 |
REAL,INTENT(IN) :: var(:,:,:) |
||
508 |
|||
509 |
CALL put_var_rgen(pass, var_name,title,var,size(var)) |
||
510 |
|||
511 |
END SUBROUTINE put_var_r3 |
||
512 |
|||
513 |
2 |
SUBROUTINE put_var_rgen(pass, var_name,title,var,var_size) |
|
514 |
USE netcdf |
||
515 |
USE dimphy |
||
516 |
USE mod_phys_lmdz_para |
||
517 |
IMPLICIT NONE |
||
518 |
INTEGER, INTENT(IN) :: pass |
||
519 |
CHARACTER(LEN=*),INTENT(IN) :: var_name |
||
520 |
CHARACTER(LEN=*),INTENT(IN) :: title |
||
521 |
INTEGER,INTENT(IN) :: var_size |
||
522 |
REAL,INTENT(IN) :: var(var_size) |
||
523 |
|||
524 |
INTEGER :: ierr |
||
525 |
INTEGER :: nvarid |
||
526 |
|||
527 |
✓✗ | 2 |
IF (is_master) THEN |
528 |
|||
529 |
✗✓ | 2 |
IF (var_size/=length) THEN |
530 |
PRINT *, "erreur phyredem : probleme de dimension" |
||
531 |
call abort_physic("", "", 1) |
||
532 |
ENDIF |
||
533 |
|||
534 |
! first pass : definition |
||
535 |
✓✓ | 2 |
IF (pass==1) THEN |
536 |
|||
537 |
! ierr = NF90_REDEF (nid_restart) |
||
538 |
|||
539 |
#ifdef NC_DOUBLE |
||
540 |
✓✓ | 2 |
ierr = NF90_DEF_VAR (nid_restart, var_name, NF90_DOUBLE,(/ idim1 /),nvarid) |
541 |
#else |
||
542 |
ierr = NF90_DEF_VAR (nid_restart, var_name, NF90_FLOAT,(/ idim1 /),nvarid) |
||
543 |
#endif |
||
544 |
✓✗ | 1 |
IF (LEN_TRIM(title)>0) ierr = NF90_PUT_ATT (nid_restart,nvarid,"title", title) |
545 |
! ierr = NF90_ENDDEF(nid_restart) |
||
546 |
|||
547 |
! second pass : write |
||
548 |
✓✗ | 1 |
ELSE IF (pass==2) THEN |
549 |
1 |
ierr = NF90_INQ_VARID(nid_restart, var_name, nvarid) |
|
550 |
1 |
ierr = NF90_PUT_VAR(nid_restart,nvarid,var) |
|
551 |
ENDIF |
||
552 |
ENDIF |
||
553 |
|||
554 |
2 |
END SUBROUTINE put_var_rgen |
|
555 |
|||
556 |
END MODULE iostart |
| Generated by: GCOVR (Version 4.2) |