source: LMDZ4/branches/LMDZ4-dev-20091210/libf/phylmd/iostart.F90 @ 5297

Last change on this file since 5297 was 1001, checked in by Laurent Fairhead, 16 years ago
  • Modifs sur le parallelisme: masquage dans la physique
  • Inclusion strato
  • mise en coherence etat0
  • le mode offline fonctionne maintenant en parallele,
  • les fichiers de la dynamiques sont correctement sortis et peuvent etre reconstruit avec rebuild
  • la version parallele de la dynamique peut s'executer sans MPI (sur 1 proc)
  • L'OPENMP fonctionne maintenant sans la parallelisation MPI.

YM
LF
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 12.6 KB
Line 
1MODULE iostart
2
3PRIVATE
4    INTEGER,SAVE :: nid_start
5    INTEGER,SAVE :: nid_restart
6   
7    INTEGER,SAVE :: idim1,idim2,idim3
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)
319
320      ierr = NF90_ENDDEF(nid_restart)
321    ENDIF
322
323  END SUBROUTINE open_restartphy
324 
325  SUBROUTINE close_restartphy
326  USE netcdf
327  USE mod_phys_lmdz_para
328  IMPLICIT NONE
329    INTEGER          :: ierr
330
331    IF (is_mpi_root .AND. is_omp_root) THEN
332      ierr = NF90_CLOSE (nid_restart)
333    ENDIF
334 
335  END SUBROUTINE close_restartphy
336
337 
338  SUBROUTINE put_field_r1(field_name,title,field)
339  IMPLICIT NONE
340  CHARACTER(LEN=*),INTENT(IN)    :: field_name
341  CHARACTER(LEN=*),INTENT(IN)    :: title
342  REAL,INTENT(IN)                :: field(:)
343 
344    CALL put_field_rgen(field_name,title,field,1)
345 
346  END SUBROUTINE put_field_r1
347
348  SUBROUTINE put_field_r2(field_name,title,field)
349  IMPLICIT NONE
350  CHARACTER(LEN=*),INTENT(IN)    :: field_name
351  CHARACTER(LEN=*),INTENT(IN)    :: title
352  REAL,INTENT(IN)                :: field(:,:)
353 
354    CALL put_field_rgen(field_name,title,field,size(field,2))
355 
356  END SUBROUTINE put_field_r2
357
358  SUBROUTINE put_field_r3(field_name,title,field)
359  IMPLICIT NONE
360  CHARACTER(LEN=*),INTENT(IN)    :: field_name
361  CHARACTER(LEN=*),INTENT(IN)    :: title
362  REAL,INTENT(IN)                :: field(:,:,:)
363 
364    CALL put_field_rgen(field_name,title,field,size(field,2)*size(field,3))
365 
366  END SUBROUTINE put_field_r3
367 
368  SUBROUTINE put_field_rgen(field_name,title,field,field_size)
369  USE netcdf
370  USE dimphy
371  USE mod_grid_phy_lmdz
372  USE mod_phys_lmdz_para
373  IMPLICIT NONE
374  CHARACTER(LEN=*),INTENT(IN)    :: field_name
375  CHARACTER(LEN=*),INTENT(IN)    :: title
376  INTEGER,INTENT(IN)             :: field_size
377  REAL,INTENT(IN)                :: field(klon,field_size)
378 
379  REAL                           :: field_glo(klon_glo,field_size)
380  INTEGER                        :: ierr
381  INTEGER                        :: nvarid
382  INTEGER                        :: idim
383   
384   
385    CALL gather(field,field_glo)
386   
387    IF (is_mpi_root .AND. is_omp_root) THEN
388     
389      IF (field_size==1) THEN
390        idim=idim2
391      ELSE IF (field_size==klev) THEN
392        idim=idim3
393      ELSE
394        PRINT *, "erreur phyredem : probleme de dimension"
395        CALL ABORT
396      ENDIF
397         
398      ierr = NF90_REDEF (nid_restart)
399#ifdef NC_DOUBLE
400      ierr = NF90_DEF_VAR (nid_restart, field_name, NF90_DOUBLE,(/ idim /),nvarid)
401#else
402      ierr = NF90_DEF_VAR (nid_restart, field_name, NF90_FLOAT,(/ idim /),nvarid)
403#endif
404      IF (LEN_TRIM(title) > 0) ierr = NF90_PUT_ATT (nid_restart,nvarid,"title", title)
405      ierr = NF90_ENDDEF(nid_restart)
406      ierr = NF90_PUT_VAR(nid_restart,nvarid,RESHAPE(field_glo,(/klon_glo*field_size/)))
407    ENDIF
408   
409   END SUBROUTINE put_field_rgen 
410 
411   SUBROUTINE put_var_r0(var_name,title,var)
412   IMPLICIT NONE
413     CHARACTER(LEN=*),INTENT(IN) :: var_name
414     CHARACTER(LEN=*),INTENT(IN) :: title
415     REAL,INTENT(IN)             :: var
416     REAL                        :: varin(1)
417     
418     varin(1)=var
419     
420     CALL put_var_rgen(var_name,title,varin,size(varin))
421
422  END SUBROUTINE put_var_r0
423
424
425   SUBROUTINE put_var_r1(var_name,title,var)
426   IMPLICIT NONE
427     CHARACTER(LEN=*),INTENT(IN) :: var_name
428     CHARACTER(LEN=*),INTENT(IN) :: title
429     REAL,INTENT(IN)             :: var(:)
430     
431     CALL put_var_rgen(var_name,title,var,size(var))
432
433  END SUBROUTINE put_var_r1
434 
435  SUBROUTINE put_var_r2(var_name,title,var)
436   IMPLICIT NONE
437     CHARACTER(LEN=*),INTENT(IN) :: var_name
438     CHARACTER(LEN=*),INTENT(IN) :: title
439     REAL,INTENT(IN)             :: var(:,:)
440     
441     CALL put_var_rgen(var_name,title,var,size(var))
442
443  END SUBROUTINE put_var_r2     
444 
445  SUBROUTINE put_var_r3(var_name,title,var)
446   IMPLICIT NONE
447     CHARACTER(LEN=*),INTENT(IN) :: var_name
448     CHARACTER(LEN=*),INTENT(IN) :: title
449     REAL,INTENT(IN)             :: var(:,:,:)
450     
451     CALL put_var_rgen(var_name,title,var,size(var))
452
453  END SUBROUTINE put_var_r3
454
455  SUBROUTINE put_var_rgen(var_name,title,var,var_size)
456  USE netcdf
457  USE dimphy
458  USE mod_phys_lmdz_para
459  IMPLICIT NONE
460     CHARACTER(LEN=*),INTENT(IN) :: var_name
461     CHARACTER(LEN=*),INTENT(IN) :: title
462     INTEGER,INTENT(IN)          :: var_size
463     REAL,INTENT(IN)             :: var(var_size)
464     
465     INTEGER :: ierr
466     INTEGER :: nvarid
467         
468    IF (is_mpi_root .AND. is_omp_root) THEN
469   
470      IF (var_size/=length) THEN
471        PRINT *, "erreur phyredem : probleme de dimension"
472        CALL abort
473      ENDIF
474     
475      ierr = NF90_REDEF (nid_restart)
476
477#ifdef NC_DOUBLE
478      ierr = NF90_DEF_VAR (nid_restart, var_name, NF90_DOUBLE,(/ idim1 /),nvarid)
479#else
480      ierr = NF90_DEF_VAR (nid_restart, var_name, NF90_FLOAT,(/ idim1 /),nvarid)
481#endif
482      IF (LEN_TRIM(title)>0) ierr = NF90_PUT_ATT (nid_restart,nvarid,"title", title)
483      ierr = NF90_ENDDEF(nid_restart)
484     
485      ierr = NF90_PUT_VAR(nid_restart,nvarid,var)
486
487    ENDIF
488   
489  END SUBROUTINE put_var_rgen     
490   
491END MODULE iostart
Note: See TracBrowser for help on using the repository browser.