source: LMDZ4/branches/LMDZ4V5.0-dev/libf/phylmd/iostart.F90 @ 3126

Last change on this file since 3126 was 1298, checked in by Laurent Fairhead, 15 years ago
  • sauvegarde de variables des thermiques dans le restart physique
  • modification de iostart pour pouvoir sauvegarder des champs en klevp1
  • nettoyage sur physiq.F pour gfortran
  • variables from the new version of the thermics are saved to the restart file
  • iostart is modified to allow the writing of fields dimensionned in klevp1
  • some clean-up work on physiq.F for the gfortran compilation
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 12.8 KB
RevLine 
[1001]1MODULE iostart
2
3PRIVATE
4    INTEGER,SAVE :: nid_start
5    INTEGER,SAVE :: nid_restart
6   
[1298]7    INTEGER,SAVE :: idim1,idim2,idim3,idim4
[1001]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
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    IF (PRESENT(found)) THEN
92      CALL Get_field_rgen(field_name,field,1,found)
93    ELSE
94      CALL Get_field_rgen(field_name,field,1)
95    ENDIF
96     
97  END SUBROUTINE Get_Field_r1
98 
99  SUBROUTINE Get_Field_r2(field_name,field,found)
100  IMPLICIT NONE
101    CHARACTER(LEN=*),INTENT(IN)    :: Field_name
102    REAL,INTENT(INOUT)               :: Field(:,:)
103    LOGICAL,INTENT(OUT),OPTIONAL   :: found
104
105    IF (PRESENT(found)) THEN
106      CALL Get_field_rgen(field_name,field,size(field,2),found)
107    ELSE
108      CALL Get_field_rgen(field_name,field,size(field,2))
109    ENDIF
110
111     
112  END SUBROUTINE Get_Field_r2
113 
114  SUBROUTINE Get_Field_r3(field_name,field,found)
115  IMPLICIT NONE
116    CHARACTER(LEN=*),INTENT(IN)    :: Field_name
117    REAL,INTENT(INOUT)               :: Field(:,:,:)
118    LOGICAL,INTENT(OUT),OPTIONAL   :: found
119
120    IF (PRESENT(found)) THEN
121      CALL Get_field_rgen(field_name,field,size(field,2)*size(field,3),found)
122    ELSE
123      CALL Get_field_rgen(field_name,field,size(field,2)*size(field,3))
124    ENDIF
125     
126  END SUBROUTINE Get_Field_r3
127 
128  SUBROUTINE Get_field_rgen(field_name,field,field_size,found)
129  USE netcdf
130  USE dimphy
131  USE mod_grid_phy_lmdz
132  USE mod_phys_lmdz_para
133  IMPLICIT NONE
134    CHARACTER(LEN=*) :: Field_name
135    INTEGER          :: field_size
136    REAL             :: field(klon,field_size)
137    LOGICAL,OPTIONAL :: found
138   
139    REAL    :: field_glo(klon_glo,field_size)
140    LOGICAL :: tmp_found
141    INTEGER :: varid
142    INTEGER :: ierr
143   
144    IF (is_mpi_root .AND. is_omp_root) THEN
145 
146      ierr=NF90_INQ_VARID(nid_start,Field_name,varid)
147     
148      IF (ierr==NF90_NOERR) THEN
149        CALL body(field_glo)
150        tmp_found=.TRUE.
151      ELSE
152        tmp_found=.FALSE.
153      ENDIF
154   
155    ENDIF
156   
157    CALL bcast(tmp_found)
158
159    IF (tmp_found) THEN
160      CALL scatter(field_glo,field)
161    ENDIF
162   
163    IF (PRESENT(found)) THEN
164      found=tmp_found
165    ELSE
166      IF (.NOT. tmp_found) THEN
167        PRINT*, 'phyetat0: Le champ <'//field_name//'> est absent'
168        CALL abort
169      ENDIF
170    ENDIF
171 
172   
173    CONTAINS
174     
175     SUBROUTINE body(field_glo)
176       REAL :: field_glo(klon_glo*field_size)
177         ierr=NF90_GET_VAR(nid_start,varid,field_glo)
178         IF (ierr/=NF90_NOERR) THEN
179           PRINT*, 'phyetat0: Lecture echouee pour <'//field_name//'>'
180           CALL abort
181         ENDIF
182
183     END SUBROUTINE body
184
185  END SUBROUTINE Get_field_rgen
186 
187
188  SUBROUTINE get_var_r0(var_name,var,found)
189  IMPLICIT NONE 
190    CHARACTER(LEN=*),INTENT(IN)  :: var_name
191    REAL,INTENT(INOUT)             :: var
192    LOGICAL,OPTIONAL,INTENT(OUT) :: found
193
194    REAL                         :: varout(1)
195   
196    IF (PRESENT(found)) THEN
197      CALL Get_var_rgen(var_name,varout,size(varout),found)
198    ELSE
199      CALL Get_var_rgen(var_name,varout,size(varout))
200    ENDIF
201    var=varout(1)
202 
203  END SUBROUTINE get_var_r0
204
205  SUBROUTINE get_var_r1(var_name,var,found)
206  IMPLICIT NONE 
207    CHARACTER(LEN=*),INTENT(IN)  :: var_name
208    REAL,INTENT(INOUT)             :: var(:)
209    LOGICAL,OPTIONAL,INTENT(OUT) :: found
210   
211    IF (PRESENT(found)) THEN
212      CALL Get_var_rgen(var_name,var,size(var),found)
213    ELSE
214      CALL Get_var_rgen(var_name,var,size(var))
215    ENDIF
216 
217  END SUBROUTINE get_var_r1
218
219  SUBROUTINE get_var_r2(var_name,var,found)
220  IMPLICIT NONE 
221    CHARACTER(LEN=*),INTENT(IN)  :: var_name
222    REAL,INTENT(OUT)             :: var(:,:)
223    LOGICAL,OPTIONAL,INTENT(OUT) :: found
224   
225    IF (PRESENT(found)) THEN
226      CALL Get_var_rgen(var_name,var,size(var),found)
227    ELSE
228      CALL Get_var_rgen(var_name,var,size(var))
229    ENDIF
230 
231  END SUBROUTINE get_var_r2
232
233  SUBROUTINE get_var_r3(var_name,var,found)
234  IMPLICIT NONE 
235    CHARACTER(LEN=*),INTENT(IN)  :: var_name
236    REAL,INTENT(INOUT)             :: var(:,:,:)
237    LOGICAL,OPTIONAL,INTENT(OUT) :: found
238   
239    IF (PRESENT(found)) THEN
240      CALL Get_var_rgen(var_name,var,size(var),found)
241    ELSE
242      CALL Get_var_rgen(var_name,var,size(var))
243    ENDIF
244 
245  END SUBROUTINE get_var_r3
246
247  SUBROUTINE Get_var_rgen(var_name,var,var_size,found)
248  USE netcdf
249  USE dimphy
250  USE mod_grid_phy_lmdz
251  USE mod_phys_lmdz_para
252  IMPLICIT NONE
253    CHARACTER(LEN=*) :: var_name
254    INTEGER          :: var_size
255    REAL             :: var(var_size)
256    LOGICAL,OPTIONAL :: found
257   
258    LOGICAL :: tmp_found
259    INTEGER :: varid
260    INTEGER :: ierr
261   
262    IF (is_mpi_root .AND. is_omp_root) THEN
263 
264      ierr=NF90_INQ_VARID(nid_start,var_name,varid)
265     
266      IF (ierr==NF90_NOERR) THEN
267        ierr=NF90_GET_VAR(nid_start,varid,var)
268        IF (ierr/=NF90_NOERR) THEN
269          PRINT*, 'phyetat0: Lecture echouee pour <'//var_name//'>'
270          CALL abort
271        ENDIF
272        tmp_found=.TRUE.
273      ELSE
274        tmp_found=.FALSE.
275      ENDIF
276   
277    ENDIF
278   
279    CALL bcast(tmp_found)
280
281    IF (tmp_found) THEN
282      CALL bcast(var)
283    ENDIF
284   
285    IF (PRESENT(found)) THEN
286      found=tmp_found
287    ELSE
288      IF (.NOT. tmp_found) THEN
289        PRINT*, 'phyetat0: La variable champ <'//var_name//'> est absente'
290        CALL abort
291      ENDIF
292    ENDIF
293
294  END SUBROUTINE Get_var_rgen
295
296
297  SUBROUTINE open_restartphy(filename)
298  USE netcdf
299  USE mod_phys_lmdz_para
300  USE mod_grid_phy_lmdz
301  USE dimphy
302  IMPLICIT NONE
303    CHARACTER(LEN=*),INTENT(IN) :: filename
304    INTEGER                     :: ierr
305   
306    IF (is_mpi_root .AND. is_omp_root) THEN
307      ierr = NF90_CREATE(filename, NF90_CLOBBER, nid_restart)
308      IF (ierr/=NF90_NOERR) THEN
309        write(6,*)' Pb d''ouverture du fichier '//filename
310        write(6,*)' ierr = ', ierr
311        CALL ABORT
312      ENDIF
313
314      ierr = NF90_PUT_ATT (nid_restart, NF90_GLOBAL, "title","Fichier redemmarage physique")
315
316      ierr = NF90_DEF_DIM (nid_restart, "index", length, idim1)
317      ierr = NF90_DEF_DIM (nid_restart, "points_physiques", klon_glo, idim2)
318      ierr = NF90_DEF_DIM (nid_restart, "horizon_vertical", klon_glo*klev, idim3)
[1298]319      ierr = NF90_DEF_DIM (nid_restart, "horizon_klevp1", klon_glo*klevp1, idim4)
[1001]320
321      ierr = NF90_ENDDEF(nid_restart)
322    ENDIF
323
324  END SUBROUTINE open_restartphy
325 
326  SUBROUTINE close_restartphy
327  USE netcdf
328  USE mod_phys_lmdz_para
329  IMPLICIT NONE
330    INTEGER          :: ierr
331
332    IF (is_mpi_root .AND. is_omp_root) THEN
333      ierr = NF90_CLOSE (nid_restart)
334    ENDIF
335 
336  END SUBROUTINE close_restartphy
337
338 
339  SUBROUTINE put_field_r1(field_name,title,field)
340  IMPLICIT NONE
341  CHARACTER(LEN=*),INTENT(IN)    :: field_name
342  CHARACTER(LEN=*),INTENT(IN)    :: title
343  REAL,INTENT(IN)                :: field(:)
344 
345    CALL put_field_rgen(field_name,title,field,1)
346 
347  END SUBROUTINE put_field_r1
348
349  SUBROUTINE put_field_r2(field_name,title,field)
350  IMPLICIT NONE
351  CHARACTER(LEN=*),INTENT(IN)    :: field_name
352  CHARACTER(LEN=*),INTENT(IN)    :: title
353  REAL,INTENT(IN)                :: field(:,:)
354 
355    CALL put_field_rgen(field_name,title,field,size(field,2))
356 
357  END SUBROUTINE put_field_r2
358
359  SUBROUTINE put_field_r3(field_name,title,field)
360  IMPLICIT NONE
361  CHARACTER(LEN=*),INTENT(IN)    :: field_name
362  CHARACTER(LEN=*),INTENT(IN)    :: title
363  REAL,INTENT(IN)                :: field(:,:,:)
364 
365    CALL put_field_rgen(field_name,title,field,size(field,2)*size(field,3))
366 
367  END SUBROUTINE put_field_r3
368 
369  SUBROUTINE put_field_rgen(field_name,title,field,field_size)
370  USE netcdf
371  USE dimphy
372  USE mod_grid_phy_lmdz
373  USE mod_phys_lmdz_para
374  IMPLICIT NONE
375  CHARACTER(LEN=*),INTENT(IN)    :: field_name
376  CHARACTER(LEN=*),INTENT(IN)    :: title
377  INTEGER,INTENT(IN)             :: field_size
378  REAL,INTENT(IN)                :: field(klon,field_size)
379 
380  REAL                           :: field_glo(klon_glo,field_size)
381  INTEGER                        :: ierr
382  INTEGER                        :: nvarid
383  INTEGER                        :: idim
384   
385   
386    CALL gather(field,field_glo)
387   
388    IF (is_mpi_root .AND. is_omp_root) THEN
[1298]389
[1001]390      IF (field_size==1) THEN
391        idim=idim2
392      ELSE IF (field_size==klev) THEN
393        idim=idim3
[1298]394      ELSE IF (field_size==klevp1) THEN
395        idim=idim4
[1001]396      ELSE
397        PRINT *, "erreur phyredem : probleme de dimension"
398        CALL ABORT
399      ENDIF
400         
401      ierr = NF90_REDEF (nid_restart)
402#ifdef NC_DOUBLE
403      ierr = NF90_DEF_VAR (nid_restart, field_name, NF90_DOUBLE,(/ idim /),nvarid)
404#else
405      ierr = NF90_DEF_VAR (nid_restart, field_name, NF90_FLOAT,(/ idim /),nvarid)
406#endif
407      IF (LEN_TRIM(title) > 0) ierr = NF90_PUT_ATT (nid_restart,nvarid,"title", title)
408      ierr = NF90_ENDDEF(nid_restart)
409      ierr = NF90_PUT_VAR(nid_restart,nvarid,RESHAPE(field_glo,(/klon_glo*field_size/)))
410    ENDIF
411   
412   END SUBROUTINE put_field_rgen 
413 
414   SUBROUTINE put_var_r0(var_name,title,var)
415   IMPLICIT NONE
416     CHARACTER(LEN=*),INTENT(IN) :: var_name
417     CHARACTER(LEN=*),INTENT(IN) :: title
418     REAL,INTENT(IN)             :: var
419     REAL                        :: varin(1)
420     
421     varin(1)=var
422     
423     CALL put_var_rgen(var_name,title,varin,size(varin))
424
425  END SUBROUTINE put_var_r0
426
427
428   SUBROUTINE put_var_r1(var_name,title,var)
429   IMPLICIT NONE
430     CHARACTER(LEN=*),INTENT(IN) :: var_name
431     CHARACTER(LEN=*),INTENT(IN) :: title
432     REAL,INTENT(IN)             :: var(:)
433     
434     CALL put_var_rgen(var_name,title,var,size(var))
435
436  END SUBROUTINE put_var_r1
437 
438  SUBROUTINE put_var_r2(var_name,title,var)
439   IMPLICIT NONE
440     CHARACTER(LEN=*),INTENT(IN) :: var_name
441     CHARACTER(LEN=*),INTENT(IN) :: title
442     REAL,INTENT(IN)             :: var(:,:)
443     
444     CALL put_var_rgen(var_name,title,var,size(var))
445
446  END SUBROUTINE put_var_r2     
447 
448  SUBROUTINE put_var_r3(var_name,title,var)
449   IMPLICIT NONE
450     CHARACTER(LEN=*),INTENT(IN) :: var_name
451     CHARACTER(LEN=*),INTENT(IN) :: title
452     REAL,INTENT(IN)             :: var(:,:,:)
453     
454     CALL put_var_rgen(var_name,title,var,size(var))
455
456  END SUBROUTINE put_var_r3
457
458  SUBROUTINE put_var_rgen(var_name,title,var,var_size)
459  USE netcdf
460  USE dimphy
461  USE mod_phys_lmdz_para
462  IMPLICIT NONE
463     CHARACTER(LEN=*),INTENT(IN) :: var_name
464     CHARACTER(LEN=*),INTENT(IN) :: title
465     INTEGER,INTENT(IN)          :: var_size
466     REAL,INTENT(IN)             :: var(var_size)
467     
468     INTEGER :: ierr
469     INTEGER :: nvarid
470         
471    IF (is_mpi_root .AND. is_omp_root) THEN
[1298]472
[1001]473      IF (var_size/=length) THEN
474        PRINT *, "erreur phyredem : probleme de dimension"
475        CALL abort
476      ENDIF
477     
478      ierr = NF90_REDEF (nid_restart)
479
480#ifdef NC_DOUBLE
481      ierr = NF90_DEF_VAR (nid_restart, var_name, NF90_DOUBLE,(/ idim1 /),nvarid)
482#else
483      ierr = NF90_DEF_VAR (nid_restart, var_name, NF90_FLOAT,(/ idim1 /),nvarid)
484#endif
485      IF (LEN_TRIM(title)>0) ierr = NF90_PUT_ATT (nid_restart,nvarid,"title", title)
486      ierr = NF90_ENDDEF(nid_restart)
487     
488      ierr = NF90_PUT_VAR(nid_restart,nvarid,var)
489
490    ENDIF
491   
492  END SUBROUTINE put_var_rgen     
493   
494END MODULE iostart
Note: See TracBrowser for help on using the repository browser.