source: LMDZ6/branches/Ocean_skin/libf/phylmd/iostart.F90 @ 3463

Last change on this file since 3463 was 3401, checked in by Ehouarn Millour, 6 years ago

Make produced "limit.nc" and "restartphy.nc" files be of "64-bit offset" type rather than "classic" NetCDF format to enable creation of large files (>2Gb).
EM
  • Property copyright set to
    Name of program: LMDZ
    Creation date: 1984
    Version: LMDZ5
    License: CeCILL version 2
    Holder: Laboratoire de m\'et\'eorologie dynamique, CNRS, UMR 8539
    See the license file in the root directory
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 13.1 KB
Line 
1MODULE iostart
2
3PRIVATE
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
28   
29CONTAINS
30
31  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    IF (is_mpi_root .AND. is_omp_root) THEN
39      ierr = NF90_OPEN (filename, NF90_NOWRITE,nid_start)
40      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  END SUBROUTINE Open_startphy
48
49  SUBROUTINE Close_startphy
50  USE netcdf
51  USE mod_phys_lmdz_para
52  IMPLICIT NONE
53    INTEGER          :: ierr
54
55    IF (is_mpi_root .AND. is_omp_root) THEN
56        ierr = NF90_CLOSE (nid_start)
57    ENDIF
58
59  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  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    CALL Get_field_rgen(field_name,field,1,found)
92     
93  END SUBROUTINE Get_Field_r1
94 
95  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    CALL Get_field_rgen(field_name,field,size(field,2),found)
102
103     
104  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  SUBROUTINE Get_field_rgen(field_name,field,field_size,found)
117  USE netcdf
118  USE dimphy
119  USE mod_grid_phy_lmdz
120  USE mod_phys_lmdz_para
121  IMPLICIT NONE
122    CHARACTER(LEN=*) :: Field_name
123    INTEGER          :: field_size
124    REAL             :: field(klon,field_size)
125    LOGICAL,OPTIONAL :: found
126   
127    REAL    :: field_glo(klon_glo,field_size)
128    LOGICAL :: tmp_found
129    INTEGER :: varid
130    INTEGER :: ierr
131   
132    IF (is_mpi_root .AND. is_omp_root) THEN
133 
134      ierr=NF90_INQ_VARID(nid_start,Field_name,varid)
135     
136      IF (ierr==NF90_NOERR) THEN
137        CALL body(field_glo)
138        tmp_found=.TRUE.
139      ELSE
140        tmp_found=.FALSE.
141      ENDIF
142   
143    ENDIF
144   
145    CALL bcast(tmp_found)
146
147    IF (tmp_found) THEN
148      CALL scatter(field_glo,field)
149    ENDIF
150   
151    IF (PRESENT(found)) THEN
152      found=tmp_found
153    ELSE
154      IF (.NOT. tmp_found) THEN
155        PRINT*, 'phyetat0: Le champ <'//field_name//'> est absent'
156        call abort_physic("", "", 1)
157      ENDIF
158    ENDIF
159 
160   
161    CONTAINS
162     
163     SUBROUTINE body(field_glo)
164       REAL :: field_glo(klon_glo*field_size)
165         ierr=NF90_GET_VAR(nid_start,varid,field_glo)
166         IF (ierr/=NF90_NOERR) THEN
167           ! La variable exist dans le fichier mais la lecture a echouee.
168           PRINT*, 'phyetat0: Lecture echouee pour <'//field_name//'>'
169
170           IF (field_name=='CLWCON' .OR. field_name=='RNEBCON' .OR. field_name=='RATQS') THEN
171              ! Essaye de lire le variable sur surface uniqument, comme fait avant
172              field_glo(:)=0.
173              ierr=NF90_GET_VAR(nid_start,varid,field_glo(1:klon_glo))
174              IF (ierr/=NF90_NOERR) THEN
175                 PRINT*, 'phyetat0: Lecture echouee aussi en 2D pour <'//field_name//'>'
176                 call abort_physic("", "", 1)
177              ELSE
178                 PRINT*, 'phyetat0: La variable <'//field_name//'> lu sur surface seulement'!, selon ancien format, le reste mis a zero'
179              END IF
180           ELSE
181              call abort_physic("", "", 1)
182           ENDIF
183         ENDIF
184
185     END SUBROUTINE body
186
187  END SUBROUTINE Get_field_rgen
188 
189
190  SUBROUTINE get_var_r0(var_name,var,found)
191  IMPLICIT NONE 
192    CHARACTER(LEN=*),INTENT(IN)  :: var_name
193    REAL,INTENT(INOUT)             :: var
194    LOGICAL,OPTIONAL,INTENT(OUT) :: found
195
196    REAL                         :: varout(1)
197   
198    CALL Get_var_rgen(var_name,varout,size(varout),found)
199    var=varout(1)
200 
201  END SUBROUTINE get_var_r0
202
203  SUBROUTINE get_var_r1(var_name,var,found)
204  IMPLICIT NONE 
205    CHARACTER(LEN=*),INTENT(IN)  :: var_name
206    REAL,INTENT(INOUT)             :: var(:)
207    LOGICAL,OPTIONAL,INTENT(OUT) :: found
208   
209    CALL Get_var_rgen(var_name,var,size(var),found)
210 
211  END SUBROUTINE get_var_r1
212
213  SUBROUTINE get_var_r2(var_name,var,found)
214  IMPLICIT NONE 
215    CHARACTER(LEN=*),INTENT(IN)  :: var_name
216    REAL,INTENT(OUT)             :: var(:,:)
217    LOGICAL,OPTIONAL,INTENT(OUT) :: found
218   
219    CALL Get_var_rgen(var_name,var,size(var),found)
220 
221  END SUBROUTINE get_var_r2
222
223  SUBROUTINE get_var_r3(var_name,var,found)
224  IMPLICIT NONE 
225    CHARACTER(LEN=*),INTENT(IN)  :: var_name
226    REAL,INTENT(INOUT)             :: var(:,:,:)
227    LOGICAL,OPTIONAL,INTENT(OUT) :: found
228   
229    CALL Get_var_rgen(var_name,var,size(var),found)
230 
231  END SUBROUTINE get_var_r3
232
233  SUBROUTINE Get_var_rgen(var_name,var,var_size,found)
234  USE netcdf
235  USE dimphy
236  USE mod_grid_phy_lmdz
237  USE mod_phys_lmdz_para
238  IMPLICIT NONE
239    CHARACTER(LEN=*) :: var_name
240    INTEGER          :: var_size
241    REAL             :: var(var_size)
242    LOGICAL,OPTIONAL :: found
243   
244    LOGICAL :: tmp_found
245    INTEGER :: varid
246    INTEGER :: ierr
247   
248    IF (is_mpi_root .AND. is_omp_root) THEN
249 
250      ierr=NF90_INQ_VARID(nid_start,var_name,varid)
251     
252      IF (ierr==NF90_NOERR) THEN
253        ierr=NF90_GET_VAR(nid_start,varid,var)
254        IF (ierr/=NF90_NOERR) THEN
255          PRINT*, 'phyetat0: Lecture echouee pour <'//var_name//'>'
256          call abort_physic("", "", 1)
257        ENDIF
258        tmp_found=.TRUE.
259      ELSE
260        tmp_found=.FALSE.
261      ENDIF
262   
263    ENDIF
264   
265    CALL bcast(tmp_found)
266
267    IF (tmp_found) THEN
268      CALL bcast(var)
269    ENDIF
270   
271    IF (PRESENT(found)) THEN
272      found=tmp_found
273    ELSE
274      IF (.NOT. tmp_found) THEN
275        PRINT*, 'phyetat0: La variable champ <'//var_name//'> est absente'
276        call abort_physic("", "", 1)
277      ENDIF
278    ENDIF
279
280  END SUBROUTINE Get_var_rgen
281
282
283  SUBROUTINE open_restartphy(filename)
284  USE netcdf
285  USE mod_phys_lmdz_para, ONLY: is_master
286  USE mod_grid_phy_lmdz, ONLY: klon_glo
287  USE dimphy, ONLY: klev, klevp1
288  USE print_control_mod, ONLY: lunout
289  IMPLICIT NONE
290    CHARACTER(LEN=*),INTENT(IN) :: filename
291    INTEGER                     :: ierr
292   
293    IF (is_master) THEN
294      ierr = NF90_CREATE(filename, IOR(NF90_CLOBBER,NF90_64BIT_OFFSET), &
295                          nid_restart)
296      IF (ierr/=NF90_NOERR) THEN
297        write(lunout,*)'open_restartphy: problem creating file '//trim(filename)
298        write(lunout,*)trim(nf90_strerror(ierr))
299        CALL abort_physic("open_restartphy", trim(nf90_strerror(ierr)), 1)
300      ENDIF
301
302      ierr = NF90_PUT_ATT (nid_restart, NF90_GLOBAL, "title","Fichier redemmarage physique")
303
304      ierr = NF90_DEF_DIM (nid_restart, "index", length, idim1)
305      ierr = NF90_DEF_DIM (nid_restart, "points_physiques", klon_glo, idim2)
306      ierr = NF90_DEF_DIM (nid_restart, "horizon_vertical", klon_glo*klev, idim3)
307      ierr = NF90_DEF_DIM (nid_restart, "horizon_klevp1", klon_glo*klevp1, idim4)
308
309      ierr = NF90_ENDDEF(nid_restart)
310    ENDIF
311
312  END SUBROUTINE open_restartphy
313 
314  SUBROUTINE close_restartphy
315  USE netcdf
316  USE mod_phys_lmdz_para
317  IMPLICIT NONE
318    INTEGER          :: ierr
319
320    IF (is_mpi_root .AND. is_omp_root) THEN
321      ierr = NF90_CLOSE (nid_restart)
322    ENDIF
323 
324  END SUBROUTINE close_restartphy
325
326 
327  SUBROUTINE put_field_r1(field_name,title,field)
328  IMPLICIT NONE
329  CHARACTER(LEN=*),INTENT(IN)    :: field_name
330  CHARACTER(LEN=*),INTENT(IN)    :: title
331  REAL,INTENT(IN)                :: field(:)
332 
333    CALL put_field_rgen(field_name,title,field,1)
334 
335  END SUBROUTINE put_field_r1
336
337  SUBROUTINE put_field_r2(field_name,title,field)
338  IMPLICIT NONE
339  CHARACTER(LEN=*),INTENT(IN)    :: field_name
340  CHARACTER(LEN=*),INTENT(IN)    :: title
341  REAL,INTENT(IN)                :: field(:,:)
342 
343    CALL put_field_rgen(field_name,title,field,size(field,2))
344 
345  END SUBROUTINE put_field_r2
346
347  SUBROUTINE put_field_r3(field_name,title,field)
348  IMPLICIT NONE
349  CHARACTER(LEN=*),INTENT(IN)    :: field_name
350  CHARACTER(LEN=*),INTENT(IN)    :: title
351  REAL,INTENT(IN)                :: field(:,:,:)
352 
353    CALL put_field_rgen(field_name,title,field,size(field,2)*size(field,3))
354 
355  END SUBROUTINE put_field_r3
356 
357  SUBROUTINE put_field_rgen(field_name,title,field,field_size)
358  USE netcdf
359  USE dimphy
360  USE mod_grid_phy_lmdz
361  USE mod_phys_lmdz_para
362  IMPLICIT NONE
363  CHARACTER(LEN=*),INTENT(IN)    :: field_name
364  CHARACTER(LEN=*),INTENT(IN)    :: title
365  INTEGER,INTENT(IN)             :: field_size
366  REAL,INTENT(IN)                :: field(klon,field_size)
367 
368  REAL                           :: field_glo(klon_glo,field_size)
369  INTEGER                        :: ierr
370  INTEGER                        :: nvarid
371  INTEGER                        :: idim
372   
373   
374    CALL gather(field,field_glo)
375   
376    IF (is_mpi_root .AND. is_omp_root) THEN
377
378      IF (field_size==1) THEN
379        idim=idim2
380      ELSE IF (field_size==klev) THEN
381        idim=idim3
382      ELSE IF (field_size==klevp1) THEN
383        idim=idim4
384      ELSE
385        PRINT *, "erreur phyredem : probleme de dimension"
386        CALL abort_physic("", "", 1)
387      ENDIF
388         
389      ierr = NF90_REDEF (nid_restart)
390#ifdef NC_DOUBLE
391      ierr = NF90_DEF_VAR (nid_restart, field_name, NF90_DOUBLE,(/ idim /),nvarid)
392#else
393      ierr = NF90_DEF_VAR (nid_restart, field_name, NF90_FLOAT,(/ idim /),nvarid)
394#endif
395      IF (LEN_TRIM(title) > 0) ierr = NF90_PUT_ATT (nid_restart,nvarid,"title", title)
396      ierr = NF90_ENDDEF(nid_restart)
397      ierr = NF90_PUT_VAR(nid_restart,nvarid,RESHAPE(field_glo,(/klon_glo*field_size/)))
398    ENDIF
399   
400   END SUBROUTINE put_field_rgen 
401 
402   SUBROUTINE put_var_r0(var_name,title,var)
403   IMPLICIT NONE
404     CHARACTER(LEN=*),INTENT(IN) :: var_name
405     CHARACTER(LEN=*),INTENT(IN) :: title
406     REAL,INTENT(IN)             :: var
407     REAL                        :: varin(1)
408     
409     varin(1)=var
410     
411     CALL put_var_rgen(var_name,title,varin,size(varin))
412
413  END SUBROUTINE put_var_r0
414
415
416   SUBROUTINE put_var_r1(var_name,title,var)
417   IMPLICIT NONE
418     CHARACTER(LEN=*),INTENT(IN) :: var_name
419     CHARACTER(LEN=*),INTENT(IN) :: title
420     REAL,INTENT(IN)             :: var(:)
421     
422     CALL put_var_rgen(var_name,title,var,size(var))
423
424  END SUBROUTINE put_var_r1
425 
426  SUBROUTINE put_var_r2(var_name,title,var)
427   IMPLICIT NONE
428     CHARACTER(LEN=*),INTENT(IN) :: var_name
429     CHARACTER(LEN=*),INTENT(IN) :: title
430     REAL,INTENT(IN)             :: var(:,:)
431     
432     CALL put_var_rgen(var_name,title,var,size(var))
433
434  END SUBROUTINE put_var_r2     
435 
436  SUBROUTINE put_var_r3(var_name,title,var)
437   IMPLICIT NONE
438     CHARACTER(LEN=*),INTENT(IN) :: var_name
439     CHARACTER(LEN=*),INTENT(IN) :: title
440     REAL,INTENT(IN)             :: var(:,:,:)
441     
442     CALL put_var_rgen(var_name,title,var,size(var))
443
444  END SUBROUTINE put_var_r3
445
446  SUBROUTINE put_var_rgen(var_name,title,var,var_size)
447  USE netcdf
448  USE dimphy
449  USE mod_phys_lmdz_para
450  IMPLICIT NONE
451     CHARACTER(LEN=*),INTENT(IN) :: var_name
452     CHARACTER(LEN=*),INTENT(IN) :: title
453     INTEGER,INTENT(IN)          :: var_size
454     REAL,INTENT(IN)             :: var(var_size)
455     
456     INTEGER :: ierr
457     INTEGER :: nvarid
458         
459    IF (is_mpi_root .AND. is_omp_root) THEN
460
461      IF (var_size/=length) THEN
462        PRINT *, "erreur phyredem : probleme de dimension"
463        call abort_physic("", "", 1)
464      ENDIF
465     
466      ierr = NF90_REDEF (nid_restart)
467
468#ifdef NC_DOUBLE
469      ierr = NF90_DEF_VAR (nid_restart, var_name, NF90_DOUBLE,(/ idim1 /),nvarid)
470#else
471      ierr = NF90_DEF_VAR (nid_restart, var_name, NF90_FLOAT,(/ idim1 /),nvarid)
472#endif
473      IF (LEN_TRIM(title)>0) ierr = NF90_PUT_ATT (nid_restart,nvarid,"title", title)
474      ierr = NF90_ENDDEF(nid_restart)
475     
476      ierr = NF90_PUT_VAR(nid_restart,nvarid,var)
477
478    ENDIF
479   
480  END SUBROUTINE put_var_rgen     
481   
482END MODULE iostart
Note: See TracBrowser for help on using the repository browser.