source: trunk/LMDZ.GENERIC/libf/phystd/iostart.F90 @ 2987

Last change on this file since 2987 was 1621, checked in by emillour, 8 years ago

Further work on full dynamics/physics separation.

LMDZ.COMMON:

  • added phy_common/vertical_layers_mod.F90 to store information on vertical grid. This is where routines in the physics should get the information.
  • The contents of vertical_layers_mod intialized via dynphy_lonlat/inigeomphy_mod.F90.

LMDZ.MARS:

  • physics now completely decoupled from dynamics; the physics package may now be compiled as a library (-libphy option of makelmdz_fcm).
  • created an "ini_tracer_mod" routine in module "tracer_mod" for a cleaner initialization of the later.
  • removed some purely dynamics-related outputs (etot0, zoom parameters, etc.) from diagfi.nc and stats.nc outputs as these informations are not available in the physics.

LMDZ.GENERIC:

  • physics now completely decoupled from dynamics; the physics package may now be compiled as a library (-libphy option of makelmdz_fcm).
  • added nqtot to tracer_h.F90.
  • removed some purely dynamics-related outputs (etot0, zoom parameters, etc.) from diagfi.nc and stats.nc outputs as these informations are not available in the physics.

LMDZ.VENUS:

  • physics now completely decoupled from dynamics; the physics package may now be compiled as a library (-libphy option of makelmdz_fcm).
  • added infotrac_phy.F90 to store information on tracers in the physics. Initialized via iniphysiq.
  • added cpdet_phy_mod.F90 to store t2tpot etc. functions to be used in the physics. Initialized via iniphysiq. IMPORTANT: there are some hard-coded constants! These should match what is in cpdet_mod.F90 in the dynamics.
  • got rid of references to moyzon_mod module within the physics. The required variables (tmoy, plevmoy) are passed to the physics as arguments to physiq.

LMDZ.TITAN:

  • added infotrac_phy.F90 to store information on tracers in the physics. Initialized via iniphysiq.
  • added cpdet_phy_mod.F90 to store t2tpot etc. functions to be used in the physics.
  • Extra work required to completely decouple physics and dynamics: moyzon_mod should be cleaned up and information passed from dynamics to physics as as arguments. Likewise moyzon_ch and moyzon_mu should not be queried from logic_mod (which is in the dynamics).

EM

File size: 34.0 KB
Line 
1MODULE iostart
2
3    IMPLICIT NONE
4PRIVATE
5    INTEGER,SAVE :: nid_start ! NetCDF file identifier for startfi.nc file
6    INTEGER,SAVE :: nid_restart ! NetCDF file identifier for restartfi.nc file
7!$OMP THREADPRIVATE(nid_start,nid_restart)
8   
9    ! restartfi.nc file dimension identifiers: (see open_restartphy())
10    INTEGER,SAVE :: idim1 ! "index" dimension
11    INTEGER,SAVE :: idim2 ! "physical_points" dimension
12    INTEGER,SAVE :: idim3 ! "subsurface_layers" dimension
13    INTEGER,SAVE :: idim4 ! "nlayer_plus_1" dimension
14    INTEGER,SAVE :: idim5 ! "number_of_advected_fields" dimension
15    INTEGER,SAVE :: idim6 ! "nlayer" dimension
16    INTEGER,SAVE :: idim7 ! "Time" dimension
17    INTEGER,SAVE :: idim8 ! "ocean_layers" dimension
18    INTEGER,SAVE :: timeindex ! current time index (for time-dependent fields)
19!$OMP THREADPRIVATE(idim1,idim2,idim3,idim4,idim5,idim6,idim7,timeindex)
20    INTEGER,PARAMETER :: length=100 ! size of tab_cntrl array
21   
22    INTERFACE get_field
23      MODULE PROCEDURE Get_field_r1,Get_field_r2,Get_field_r3
24    END INTERFACE get_field
25   
26    INTERFACE get_var
27      MODULE PROCEDURE get_var_r0,Get_var_r1,Get_var_r2,Get_var_r3
28    END INTERFACE get_var
29
30    INTERFACE put_field
31      MODULE PROCEDURE put_field_r1,put_field_r2,put_field_r3
32    END INTERFACE put_field
33
34    INTERFACE put_var
35      MODULE PROCEDURE put_var_r0,put_var_r1,put_var_r2,put_var_r3
36    END INTERFACE put_var
37
38    PUBLIC nid_start, length
39    PUBLIC get_field,get_var,put_field,put_var
40    PUBLIC inquire_dimension, inquire_dimension_length
41    PUBLIC inquire_field, inquire_field_ndims
42    PUBLIC open_startphy,close_startphy,open_restartphy,close_restartphy
43   
44CONTAINS
45
46  SUBROUTINE open_startphy(filename)
47  USE netcdf, only: NF90_OPEN, NF90_NOERR, NF90_NOWRITE, nf90_strerror
48  USE mod_phys_lmdz_para, only: is_master, bcast
49  IMPLICIT NONE
50    CHARACTER(LEN=*) :: filename
51    INTEGER          :: ierr
52
53    IF (is_master) THEN
54      ierr = NF90_OPEN (filename, NF90_NOWRITE, nid_start)
55      IF (ierr.NE.NF90_NOERR) THEN
56        write(*,*)'open_startphy: problem opening file '//trim(filename)
57        write(*,*)trim(nf90_strerror(ierr))
58        CALL ABORT
59      ENDIF
60    ENDIF
61   
62    CALL bcast(nid_start) ! tell all procs about nid_start
63 
64  END SUBROUTINE open_startphy
65
66  SUBROUTINE close_startphy
67  USE netcdf, only: NF90_CLOSE
68  USE mod_phys_lmdz_para, only: is_master
69  IMPLICIT NONE
70    INTEGER          :: ierr
71
72    IF (is_master) THEN
73        ierr = NF90_CLOSE (nid_start)
74    ENDIF
75
76  END SUBROUTINE close_startphy
77
78
79  FUNCTION inquire_field(Field_name)
80  ! check if a given field is present in the input file
81  USE netcdf, only: NF90_INQ_VARID, NF90_NOERR
82  USE mod_phys_lmdz_para, only: is_master, bcast
83  IMPLICIT NONE
84    CHARACTER(LEN=*),INTENT(IN) :: Field_name
85    LOGICAL :: inquire_field
86    INTEGER :: varid
87    INTEGER :: ierr
88   
89    IF (is_master) THEN
90      ierr=NF90_INQ_VARID(nid_start,Field_name,varid)
91      IF (ierr==NF90_NOERR) THEN
92        Inquire_field=.TRUE.
93      ELSE
94        Inquire_field=.FALSE.
95      ENDIF
96    ENDIF
97
98    CALL bcast(inquire_field)
99
100  END FUNCTION inquire_field
101
102
103  FUNCTION inquire_field_ndims(Field_name)
104  ! give the number of dimensions of "Field_name" stored in the input file
105  USE netcdf, only: nf90_inq_varid, nf90_inquire_variable, &
106                    NF90_NOERR, nf90_strerror
107  USE mod_phys_lmdz_para, only: is_master, bcast
108  IMPLICIT NONE
109    CHARACTER(LEN=*),INTENT(IN) :: Field_name
110    INTEGER :: inquire_field_ndims
111    INTEGER :: varid
112    INTEGER :: ierr
113   
114    IF (is_master) THEN
115      ierr=nf90_inq_varid(nid_start,Field_name,varid)
116      ierr=nf90_inquire_variable(nid_start,varid,&
117                                  ndims=inquire_field_ndims)
118      IF (ierr.NE.NF90_NOERR) THEN
119        write(*,*)'inquire_field_ndims: problem obtaining ndims of '&
120                  //trim(field_name)
121        write(*,*)trim(nf90_strerror(ierr))
122        CALL ABORT
123      ENDIF
124    ENDIF
125
126    CALL bcast(inquire_field_ndims)
127
128  END FUNCTION inquire_field_ndims
129
130
131  FUNCTION inquire_dimension(Field_name)
132  ! check if a given dimension is present in the input file
133  USE netcdf, only: nf90_inq_dimid, NF90_NOERR
134  USE mod_phys_lmdz_para, only: is_master, bcast
135  IMPLICIT NONE
136    CHARACTER(LEN=*),INTENT(IN) :: Field_name
137    LOGICAL :: inquire_dimension
138    INTEGER :: varid
139    INTEGER :: ierr
140   
141    IF (is_master) THEN
142      ierr=NF90_INQ_DIMID(nid_start,Field_name,varid)
143      IF (ierr==NF90_NOERR) THEN
144        Inquire_dimension=.TRUE.
145      ELSE
146        Inquire_dimension=.FALSE.
147      ENDIF
148    ENDIF
149
150    CALL bcast(inquire_dimension)
151
152  END FUNCTION inquire_dimension
153
154  FUNCTION inquire_dimension_length(Field_name)
155  ! give the length of the "Field_name" dimension stored in the input file
156  USE netcdf, only: nf90_inquire_dimension, nf90_inq_dimid, &
157                    NF90_NOERR, nf90_strerror
158  USE mod_phys_lmdz_para, only: is_master, bcast
159  IMPLICIT NONE
160    CHARACTER(LEN=*),INTENT(IN) :: Field_name
161    INTEGER :: inquire_dimension_length
162    INTEGER :: varid
163    INTEGER :: ierr
164   
165    IF (is_master) THEN
166      ierr=nf90_inq_dimid(nid_start,Field_name,varid)
167      ierr=nf90_inquire_dimension(nid_start,varid,&
168                                  len=inquire_dimension_length)
169      IF (ierr.NE.NF90_NOERR) THEN
170        write(*,*)'inquire_field_length: problem obtaining length of '&
171                  //trim(field_name)
172        write(*,*)trim(nf90_strerror(ierr))
173        CALL ABORT
174      ENDIF
175    ENDIF
176
177    CALL bcast(inquire_dimension_length)
178
179  END FUNCTION inquire_dimension_length
180
181
182
183  SUBROUTINE Get_Field_r1(field_name,field,found,timeindex)
184  ! For a surface field
185  use mod_grid_phy_lmdz, only: klon_glo ! number of atmospheric columns (full grid)
186  IMPLICIT NONE
187    CHARACTER(LEN=*),INTENT(IN)    :: Field_name
188    REAL,INTENT(INOUT)               :: Field(:)
189    LOGICAL,INTENT(OUT),OPTIONAL   :: found
190    INTEGER,INTENT(IN),OPTIONAL    :: timeindex ! time index of sought data
191
192    integer :: edges(4), corners(4)
193
194    edges(1)=klon_glo
195    edges(2:4)=1
196    corners(1:4)=1
197    if (PRESENT(timeindex)) then
198      corners(2)=timeindex
199    endif
200
201    IF (PRESENT(found)) THEN
202      CALL Get_field_rgen(field_name,field,1,corners,edges,found)
203    ELSE
204      CALL Get_field_rgen(field_name,field,1,corners,edges)
205    ENDIF
206     
207  END SUBROUTINE Get_Field_r1
208 
209  SUBROUTINE Get_Field_r2(field_name,field,found,timeindex)
210  ! For a "3D" horizontal-vertical field
211  use mod_grid_phy_lmdz, only: klon_glo ! number of atmospheric columns (full grid)
212  IMPLICIT NONE
213    CHARACTER(LEN=*),INTENT(IN)    :: Field_name
214    REAL,INTENT(INOUT)               :: Field(:,:)
215    LOGICAL,INTENT(OUT),OPTIONAL   :: found
216    INTEGER,INTENT(IN),OPTIONAL    :: timeindex ! time index of sought data
217
218    integer :: edges(4), corners(4)
219
220    edges(1)=klon_glo
221    edges(2)=size(field,2)
222    edges(3:4)=1
223    corners(1:4)=1
224    if (PRESENT(timeindex)) then
225      corners(3)=timeindex
226    endif
227   
228    IF (PRESENT(found)) THEN
229      CALL Get_field_rgen(field_name,field,size(field,2),&
230                          corners,edges,found)
231    ELSE
232      CALL Get_field_rgen(field_name,field,size(field,2),&
233                          corners,edges)
234    ENDIF
235
236     
237  END SUBROUTINE Get_Field_r2
238 
239  SUBROUTINE Get_Field_r3(field_name,field,found,timeindex)
240  ! for a "4D" field surf/alt/??
241  use mod_grid_phy_lmdz, only: klon_glo ! number of atmospheric columns (full grid)
242  IMPLICIT NONE
243    CHARACTER(LEN=*),INTENT(IN)    :: Field_name
244    REAL,INTENT(INOUT)               :: Field(:,:,:)
245    LOGICAL,INTENT(OUT),OPTIONAL   :: found
246    INTEGER,INTENT(IN),OPTIONAL    :: timeindex ! time index of sought data
247
248    integer :: edges(4), corners(4)
249
250    edges(1)=klon_glo
251    edges(2)=size(field,2)
252    edges(3)=size(field,3)
253    edges(4)=1
254    corners(1:4)=1
255    if (PRESENT(timeindex)) then
256      corners(4)=timeindex
257    endif
258   
259    IF (PRESENT(found)) THEN
260      CALL Get_field_rgen(field_name,field,size(field,2)*size(field,3),&
261                          corners,edges,found)
262    ELSE
263      CALL Get_field_rgen(field_name,field,size(field,2)*size(field,3),&
264                          corners,edges)
265    ENDIF
266     
267  END SUBROUTINE Get_Field_r3
268 
269  SUBROUTINE Get_field_rgen(field_name,field,field_size, &
270                            corners,edges,found)
271  USE netcdf
272  USE dimphy
273  USE mod_grid_phy_lmdz
274  USE mod_phys_lmdz_para
275  IMPLICIT NONE
276    CHARACTER(LEN=*) :: Field_name
277    INTEGER          :: field_size
278    REAL             :: field(klon,field_size)
279    INTEGER,INTENT(IN) :: corners(4)
280    INTEGER,INTENT(IN) :: edges(4)
281    LOGICAL,OPTIONAL :: found
282   
283    REAL    :: field_glo(klon_glo,field_size)
284    LOGICAL :: tmp_found
285    INTEGER :: varid
286    INTEGER :: ierr
287   
288    IF (is_master) THEN
289 
290      ierr=NF90_INQ_VARID(nid_start,Field_name,varid)
291     
292      IF (ierr==NF90_NOERR) THEN
293        CALL body(field_glo)
294        tmp_found=.TRUE.
295      ELSE
296        tmp_found=.FALSE.
297      ENDIF
298   
299    ENDIF
300   
301    CALL bcast(tmp_found)
302
303    IF (tmp_found) THEN
304      CALL scatter(field_glo,field)
305    ENDIF
306   
307    IF (PRESENT(found)) THEN
308      found=tmp_found
309    ELSE
310      IF (.NOT. tmp_found) THEN
311        PRINT*, 'get_field_rgen: Field <'//field_name//'> not found'
312        CALL abort
313      ENDIF
314    ENDIF
315 
316   
317    CONTAINS
318     
319     SUBROUTINE body(field_glo)
320       REAL :: field_glo(klon_glo*field_size)
321         ierr=NF90_GET_VAR(nid_start,varid,field_glo,corners,edges)
322         IF (ierr/=NF90_NOERR) THEN
323           ! La variable exist dans le fichier mais la lecture a echouee.
324           PRINT*, 'get_field_rgen: Failed reading <'//field_name//'>'
325
326!           IF (field_name=='CLWCON' .OR. field_name=='RNEBCON' .OR. field_name=='RATQS') THEN
327!              ! Essaye de lire le variable sur surface uniqument, comme fait avant
328!              field_glo(:)=0.
329!              ierr=NF90_GET_VAR(nid_start,varid,field_glo(1:klon_glo))
330!              IF (ierr/=NF90_NOERR) THEN
331!                 PRINT*, 'phyetat0: Lecture echouee aussi en 2D pour <'//field_name//'>'
332!                 CALL abort
333!              ELSE
334!                 PRINT*, 'phyetat0: La variable <'//field_name//'> lu sur surface seulement'!, selon ancien format, le reste mis a zero'
335!              END IF
336!           ELSE
337              CALL abort
338!           ENDIF
339         ENDIF
340
341     END SUBROUTINE body
342
343  END SUBROUTINE Get_field_rgen
344
345
346  SUBROUTINE get_var_r0(var_name,var,found)
347  ! Get a scalar from input file
348  IMPLICIT NONE 
349    CHARACTER(LEN=*),INTENT(IN)  :: var_name
350    REAL,INTENT(INOUT)             :: var
351    LOGICAL,OPTIONAL,INTENT(OUT) :: found
352
353    REAL                         :: varout(1)
354   
355    IF (PRESENT(found)) THEN
356      CALL Get_var_rgen(var_name,varout,size(varout),found)
357    ELSE
358      CALL Get_var_rgen(var_name,varout,size(varout))
359    ENDIF
360    var=varout(1)
361 
362  END SUBROUTINE get_var_r0
363
364  SUBROUTINE get_var_r1(var_name,var,found)
365  ! Get a vector from input file
366  IMPLICIT NONE 
367    CHARACTER(LEN=*),INTENT(IN)  :: var_name
368    REAL,INTENT(INOUT)             :: var(:)
369    LOGICAL,OPTIONAL,INTENT(OUT) :: found
370   
371    IF (PRESENT(found)) THEN
372      CALL Get_var_rgen(var_name,var,size(var),found)
373    ELSE
374      CALL Get_var_rgen(var_name,var,size(var))
375    ENDIF
376 
377  END SUBROUTINE get_var_r1
378
379  SUBROUTINE get_var_r2(var_name,var,found)
380  ! Get a 2D field from input file
381  IMPLICIT NONE 
382    CHARACTER(LEN=*),INTENT(IN)  :: var_name
383    REAL,INTENT(OUT)             :: var(:,:)
384    LOGICAL,OPTIONAL,INTENT(OUT) :: found
385   
386    IF (PRESENT(found)) THEN
387      CALL Get_var_rgen(var_name,var,size(var),found)
388    ELSE
389      CALL Get_var_rgen(var_name,var,size(var))
390    ENDIF
391 
392  END SUBROUTINE get_var_r2
393
394  SUBROUTINE get_var_r3(var_name,var,found)
395  ! Get a 3D field frominput file
396  IMPLICIT NONE 
397    CHARACTER(LEN=*),INTENT(IN)  :: var_name
398    REAL,INTENT(INOUT)             :: var(:,:,:)
399    LOGICAL,OPTIONAL,INTENT(OUT) :: found
400   
401    IF (PRESENT(found)) THEN
402      CALL Get_var_rgen(var_name,var,size(var),found)
403    ELSE
404      CALL Get_var_rgen(var_name,var,size(var))
405    ENDIF
406 
407  END SUBROUTINE get_var_r3
408
409  SUBROUTINE Get_var_rgen(var_name,var,var_size,found)
410  USE netcdf
411  USE dimphy
412  USE mod_grid_phy_lmdz
413  USE mod_phys_lmdz_para
414  IMPLICIT NONE
415    CHARACTER(LEN=*) :: var_name
416    INTEGER          :: var_size
417    REAL             :: var(var_size)
418    LOGICAL,OPTIONAL :: found
419   
420    LOGICAL :: tmp_found
421    INTEGER :: varid
422    INTEGER :: ierr
423   
424    IF (is_mpi_root .AND. is_omp_root) THEN
425 
426      ierr=NF90_INQ_VARID(nid_start,var_name,varid)
427     
428      IF (ierr==NF90_NOERR) THEN
429        ierr=NF90_GET_VAR(nid_start,varid,var)
430        IF (ierr/=NF90_NOERR) THEN
431          PRINT*, 'phyetat0: Failed loading <'//trim(var_name)//'>'
432          CALL abort
433        ENDIF
434        tmp_found=.TRUE.
435      ELSE
436        tmp_found=.FALSE.
437      ENDIF
438   
439    ENDIF
440   
441    CALL bcast(tmp_found)
442
443    IF (tmp_found) THEN
444      CALL bcast(var)
445    ENDIF
446   
447    IF (PRESENT(found)) THEN
448      found=tmp_found
449    ELSE
450      IF (.NOT. tmp_found) THEN
451        PRINT*, 'phyetat0: Variable <'//trim(var_name)//'> not found'
452        CALL abort
453      ENDIF
454    ENDIF
455
456  END SUBROUTINE Get_var_rgen
457
458!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
459
460  SUBROUTINE open_restartphy(filename)
461  USE netcdf, only: NF90_CREATE, NF90_CLOBBER, NF90_64BIT_OFFSET, &
462                    NF90_NOERR, nf90_strerror, &
463                    NF90_PUT_ATT, NF90_GLOBAL, NF90_DEF_DIM, &
464                    NF90_UNLIMITED, NF90_ENDDEF, &
465                    NF90_WRITE, NF90_OPEN
466  USE mod_phys_lmdz_para, only: is_master
467  USE mod_grid_phy_lmdz, only: klon_glo
468  USE dimphy, only: klev, klevp1
469  USE tracer_h, only: nqtot
470  USE comsoil_h, only: nsoilmx
471  USE slab_ice_h, only: noceanmx
472
473  IMPLICIT NONE
474    CHARACTER(LEN=*),INTENT(IN) :: filename
475    INTEGER                     :: ierr
476    LOGICAL,SAVE :: already_created=.false.
477!$OMP THREADPRIVATE(already_created)
478   
479    IF (is_master) THEN
480      if (.not.already_created) then
481        ! At the very first call, create the file
482        ierr=NF90_CREATE(filename,IOR(NF90_CLOBBER,NF90_64BIT_OFFSET), &
483                          nid_restart)
484        IF (ierr/=NF90_NOERR) THEN
485          write(*,*)'open_restartphy: problem creating file '//trim(filename)
486          write(*,*)trim(nf90_strerror(ierr))
487          CALL ABORT
488        ENDIF
489        already_created=.true.
490      else
491        ! Just open the file
492        ierr=NF90_OPEN(filename,NF90_WRITE,nid_restart)
493        IF (ierr/=NF90_NOERR) THEN
494          write(*,*)'open_restartphy: problem opening file '//trim(filename)
495          write(*,*)trim(nf90_strerror(ierr))
496          CALL ABORT
497        ENDIF
498        return
499      endif ! of if (.not.already_created)
500
501      ierr=NF90_PUT_ATT(nid_restart,NF90_GLOBAL,"title",&
502                        "Physics start file")
503      IF (ierr/=NF90_NOERR) THEN
504        write(*,*)'open_restartphy: problem writing title '
505        write(*,*)trim(nf90_strerror(ierr))
506      ENDIF
507
508      ierr=NF90_DEF_DIM(nid_restart,"index",length,idim1)
509      IF (ierr/=NF90_NOERR) THEN
510        write(*,*)'open_restartphy: problem defining index dimension '
511        write(*,*)trim(nf90_strerror(ierr))
512        CALL ABORT
513      ENDIF
514     
515      ierr=NF90_DEF_DIM(nid_restart,"physical_points",klon_glo,idim2)
516      IF (ierr/=NF90_NOERR) THEN
517        write(*,*)'open_restartphy: problem defining physical_points dimension '
518        write(*,*)trim(nf90_strerror(ierr))
519        CALL ABORT
520      ENDIF
521     
522      ierr=NF90_DEF_DIM(nid_restart,"subsurface_layers",nsoilmx,idim3)
523      IF (ierr/=NF90_NOERR) THEN
524        write(*,*)'open_restartphy: problem defining subsurface_layers dimension '
525        write(*,*)trim(nf90_strerror(ierr))
526        CALL ABORT
527      ENDIF
528     
529      ierr=NF90_DEF_DIM(nid_restart,"nlayer_plus_1",klevp1,idim4)
530      IF (ierr/=NF90_NOERR) THEN
531        write(*,*)'open_restartphy: problem defining nlayer_plus_1 dimension '
532        write(*,*)trim(nf90_strerror(ierr))
533        CALL ABORT
534      ENDIF
535     
536      if (nqtot>0) then
537        ! only define a tracer dimension if there are tracers
538        ierr=NF90_DEF_DIM(nid_restart,"number_of_advected_fields",nqtot,idim5)
539        IF (ierr/=NF90_NOERR) THEN
540          write(*,*)'open_restartphy: problem defining number_of_advected_fields dimension '
541          write(*,*)trim(nf90_strerror(ierr))
542          CALL ABORT
543        ENDIF
544      endif
545
546      ierr=NF90_DEF_DIM(nid_restart,"nlayer",klev,idim6)
547      IF (ierr/=NF90_NOERR) THEN
548        write(*,*)'open_restartphy: problem defining nlayer dimension '
549        write(*,*)trim(nf90_strerror(ierr))
550        CALL ABORT
551      ENDIF
552     
553      ierr=NF90_DEF_DIM(nid_restart,"Time",NF90_UNLIMITED,idim7)
554      IF (ierr/=NF90_NOERR) THEN
555        write(*,*)'open_restartphy: problem defining Time dimension '
556        write(*,*)trim(nf90_strerror(ierr))
557        CALL ABORT
558      ENDIF
559
560      ierr=NF90_DEF_DIM(nid_restart,"ocean_layers",noceanmx,idim8)
561      IF (ierr/=NF90_NOERR) THEN
562        write(*,*)'open_restartphy: problem defining oceanic layer dimension '
563        write(*,*)trim(nf90_strerror(ierr))
564        CALL ABORT
565      ENDIF
566
567
568      ierr=NF90_ENDDEF(nid_restart)
569      IF (ierr/=NF90_NOERR) THEN
570        write(*,*)'open_restartphy: problem ending definition mode '
571        write(*,*)trim(nf90_strerror(ierr))
572        CALL ABORT
573      ENDIF
574    ENDIF
575
576  END SUBROUTINE open_restartphy
577
578  SUBROUTINE close_restartphy
579  USE netcdf, only: NF90_CLOSE
580  USE mod_phys_lmdz_para, only: is_master
581  IMPLICIT NONE
582    INTEGER          :: ierr
583
584    IF (is_master) THEN
585      ierr = NF90_CLOSE (nid_restart)
586    ENDIF
587 
588  END SUBROUTINE close_restartphy
589
590  SUBROUTINE put_field_r1(field_name,title,field,time)
591  ! For a surface field
592  IMPLICIT NONE
593  CHARACTER(LEN=*),INTENT(IN)    :: field_name
594  CHARACTER(LEN=*),INTENT(IN)    :: title
595  REAL,INTENT(IN)                :: field(:)
596  REAL,OPTIONAL,INTENT(IN)       :: time
597 
598  IF (present(time)) THEN
599    ! if timeindex is present, it is a time-dependent variable
600    CALL put_field_rgen(field_name,title,field,1,time)
601  ELSE
602    CALL put_field_rgen(field_name,title,field,1)
603  ENDIF
604 
605  END SUBROUTINE put_field_r1
606
607  SUBROUTINE put_field_r2(field_name,title,field,time)
608  ! For a "3D" horizontal-vertical field
609  IMPLICIT NONE
610  CHARACTER(LEN=*),INTENT(IN)    :: field_name
611  CHARACTER(LEN=*),INTENT(IN)    :: title
612  REAL,INTENT(IN)                :: field(:,:)
613  REAL,OPTIONAL,INTENT(IN)       :: time
614 
615  IF (present(time)) THEN
616    ! if timeindex is present, it is a time-dependent variable
617    CALL put_field_rgen(field_name,title,field,size(field,2),time)
618  ELSE
619    CALL put_field_rgen(field_name,title,field,size(field,2))
620  ENDIF
621 
622  END SUBROUTINE put_field_r2
623
624  SUBROUTINE put_field_r3(field_name,title,field,time)
625  ! For a "4D" field surf/alt/??
626  IMPLICIT NONE
627  CHARACTER(LEN=*),INTENT(IN)    :: field_name
628  CHARACTER(LEN=*),INTENT(IN)    :: title
629  REAL,INTENT(IN)                :: field(:,:,:)
630  REAL,OPTIONAL,INTENT(IN)       :: time
631 
632  IF (present(time)) THEN
633    ! if timeindex is present, it is a time-dependent variable
634    CALL put_field_rgen(field_name,title,field,size(field,2)*size(field,3),&
635                        time)
636  ELSE 
637    CALL put_field_rgen(field_name,title,field,size(field,2)*size(field,3))
638  ENDIF
639 
640  END SUBROUTINE put_field_r3
641 
642  SUBROUTINE put_field_rgen(field_name,title,field,field_size,time)
643  USE netcdf
644  USE dimphy
645  USE comsoil_h, only: nsoilmx
646  USE mod_grid_phy_lmdz
647  USE mod_phys_lmdz_para
648  USE slab_ice_h, only: noceanmx
649  IMPLICIT NONE
650  CHARACTER(LEN=*),INTENT(IN)    :: field_name
651  CHARACTER(LEN=*),INTENT(IN)    :: title
652  INTEGER,INTENT(IN)             :: field_size
653  REAL,INTENT(IN)                :: field(klon,field_size)
654  REAL,OPTIONAL,INTENT(IN)       :: time
655 
656  REAL                           :: field_glo(klon_glo,field_size)
657  INTEGER                        :: ierr
658  INTEGER                        :: nvarid
659  INTEGER                        :: idim
660   
661    CALL gather(field,field_glo)
662   
663    IF (is_master) THEN
664
665      IF (field_size==1) THEN
666        ! input is a 1D "surface field" array
667        if (.not.present(time)) then ! for a time-independent field
668          ierr=NF90_REDEF(nid_restart)
669#ifdef NC_DOUBLE
670          ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
671                            (/idim2/),nvarid)
672#else
673          ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
674                            (/idim2/),nvarid)
675#endif
676          if (ierr.ne.NF90_NOERR) then
677            write(*,*)"put_field_rgen error: failed to define "//trim(field_name)
678            write(*,*)trim(nf90_strerror(ierr))
679          endif
680          IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
681          ierr=NF90_ENDDEF(nid_restart)
682          ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo)
683        else
684          ! check if the variable has already been defined:
685          ierr=NF90_INQ_VARID(nid_restart,field_name,nvarid)
686          if (ierr/=NF90_NOERR) then ! variable not found, define it
687            ierr=NF90_REDEF(nid_restart)
688#ifdef NC_DOUBLE
689            ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
690                              (/idim2,idim7/),nvarid)
691#else
692            ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
693                              (/idim2,idim7/),nvarid)
694#endif
695            if (ierr.ne.NF90_NOERR) then
696              write(*,*)"put_field_rgen error: failed to define "//trim(field_name)
697              write(*,*)trim(nf90_strerror(ierr))
698            endif
699            IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
700            ierr=NF90_ENDDEF(nid_restart)
701          endif
702          ! Write the variable
703          ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo,&
704                            start=(/1,timeindex/))
705        endif ! of if (.not.present(timeindex))
706
707      ELSE IF (field_size==klev) THEN
708        ! input is a 2D "atmospheric field" array
709        if (.not.present(time)) then ! for a time-independent field
710          ierr=NF90_REDEF(nid_restart)
711#ifdef NC_DOUBLE
712          ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
713                            (/idim2,idim6/),nvarid)
714#else
715          ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
716                            (/idim2,idim6/),nvarid)
717#endif
718          if (ierr.ne.NF90_NOERR) then
719            write(*,*)"put_field_rgen error: failed to define "//trim(field_name)
720            write(*,*)trim(nf90_strerror(ierr))
721          endif
722          IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
723          ierr=NF90_ENDDEF(nid_restart)
724          ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo)
725        else
726          ! check if the variable has already been defined:
727          ierr=NF90_INQ_VARID(nid_restart,field_name,nvarid)
728          if (ierr/=NF90_NOERR) then ! variable not found, define it
729            ierr=NF90_REDEF(nid_restart)
730#ifdef NC_DOUBLE
731            ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
732                              (/idim2,idim6,idim7/),nvarid)
733#else
734            ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
735                              (/idim2,idim6,idim7/),nvarid)
736#endif
737            if (ierr.ne.NF90_NOERR) then
738              write(*,*)"put_field_rgen error: failed to define "//trim(field_name)
739              write(*,*)trim(nf90_strerror(ierr))
740            endif
741            IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
742            ierr=NF90_ENDDEF(nid_restart)
743          endif
744          ! Write the variable
745          ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo,&
746                            start=(/1,1,timeindex/))
747        endif ! of if (.not.present(time))
748
749      ELSE IF (field_size==klevp1) THEN
750        ! input is a 2D "interlayer atmospheric field" array
751        if (.not.present(time)) then ! for a time-independent field
752          ierr=NF90_REDEF(nid_restart)
753#ifdef NC_DOUBLE
754          ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
755                            (/idim2,idim4/),nvarid)
756#else
757          ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
758                            (/idim2,idim4/),nvarid)
759#endif
760          if (ierr.ne.NF90_NOERR) then
761            write(*,*)"put_field_rgen error: failed to define "//trim(field_name)
762            write(*,*)trim(nf90_strerror(ierr))
763          endif
764          IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
765          ierr = NF90_ENDDEF(nid_restart)
766          ierr = NF90_PUT_VAR(nid_restart,nvarid,field_glo)
767        else
768          ! check if the variable has already been defined:
769          ierr=NF90_INQ_VARID(nid_restart,field_name,nvarid)
770          if (ierr/=NF90_NOERR) then ! variable not found, define it
771            ierr=NF90_REDEF(nid_restart)
772#ifdef NC_DOUBLE
773            ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
774                              (/idim2,idim4,idim7/),nvarid)
775#else
776            ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
777                              (/idim2,idim4,idim7/),nvarid)
778#endif
779            if (ierr.ne.NF90_NOERR) then
780              write(*,*)"put_field_rgen error: failed to define "//trim(field_name)
781              write(*,*)trim(nf90_strerror(ierr))
782            endif
783            IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
784            ierr=NF90_ENDDEF(nid_restart)
785          endif
786          ! Write the variable
787          ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo,&
788                            start=(/1,1,timeindex/))
789        endif ! of if (.not.present(timeindex))
790
791      ELSE IF (field_size==nsoilmx) THEN
792        ! input is a 2D "subsurface field" array
793        if (.not.present(time)) then ! for a time-independent field
794          ierr = NF90_REDEF(nid_restart)
795#ifdef NC_DOUBLE
796          ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
797                            (/idim2,idim3/),nvarid)
798#else
799          ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
800                            (/idim2,idim3/),nvarid)
801#endif
802          if (ierr.ne.NF90_NOERR) then
803            write(*,*)"put_field_rgen error: failed to define "//trim(field_name)
804            write(*,*)trim(nf90_strerror(ierr))
805          endif
806          IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
807          ierr = NF90_ENDDEF(nid_restart)
808          ierr = NF90_PUT_VAR(nid_restart,nvarid,field_glo)
809        else
810          ! check if the variable has already been defined:
811          ierr=NF90_INQ_VARID(nid_restart,field_name,nvarid)
812          if (ierr/=NF90_NOERR) then ! variable not found, define it
813            ierr=NF90_REDEF(nid_restart)
814#ifdef NC_DOUBLE
815            ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
816                              (/idim2,idim3,idim7/),nvarid)
817#else
818            ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
819                              (/idim2,idim3,idim7/),nvarid)
820#endif
821           if (ierr.ne.NF90_NOERR) then
822              write(*,*)"put_field_rgen error: failed to define "//trim(field_name)
823              write(*,*)trim(nf90_strerror(ierr))
824            endif
825            IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
826            ierr=NF90_ENDDEF(nid_restart)
827          endif
828          ! Write the variable
829          ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo,&
830                            start=(/1,1,timeindex/))
831
832        endif ! of if (.not.present(time))
833
834      ELSE IF (field_size==noceanmx) THEN
835        ! input is a 2D "oceanic field" array
836        if (.not.present(time)) then ! for a time-independent field
837          ierr = NF90_REDEF(nid_restart)
838#ifdef NC_DOUBLE
839          ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
840                            (/idim2,idim8/),nvarid)
841#else
842          ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
843                            (/idim2,idim8/),nvarid)
844#endif
845          if (ierr.ne.NF90_NOERR) then
846            write(*,*)"put_field_rgen error: failed to define "//trim(field_name)
847            write(*,*)trim(nf90_strerror(ierr))
848          endif
849          IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
850          ierr = NF90_ENDDEF(nid_restart)
851          ierr = NF90_PUT_VAR(nid_restart,nvarid,field_glo)
852        else
853          ! check if the variable has already been defined:
854          ierr=NF90_INQ_VARID(nid_restart,field_name,nvarid)
855          if (ierr/=NF90_NOERR) then ! variable not found, define it
856            ierr=NF90_REDEF(nid_restart)
857#ifdef NC_DOUBLE
858            ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
859                              (/idim2,idim8,idim7/),nvarid)
860#else
861            ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
862                              (/idim2,idim8,idim7/),nvarid)
863#endif
864           if (ierr.ne.NF90_NOERR) then
865              write(*,*)"put_field_rgen error: failed to define "//trim(field_name)
866              write(*,*)trim(nf90_strerror(ierr))
867            endif
868            IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
869            ierr=NF90_ENDDEF(nid_restart)
870          endif
871          ! Write the variable
872          ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo,&
873                            start=(/1,1,timeindex/))
874
875        endif ! of if (.not.present(time))
876
877
878      ELSE
879        PRINT *, "Error phyredem(put_field_rgen) : wrong dimension for ",trim(field_name)
880        write(*,*) "  field_size =",field_size
881        CALL ABORT
882      ENDIF
883
884      ! Check the writting of field to file went OK
885      if (ierr.ne.NF90_NOERR) then
886        write(*,*) " Error phyredem(put_field_rgen) : failed writing ",trim(field_name)
887        write(*,*)trim(nf90_strerror(ierr))
888        call abort
889      endif
890
891    ENDIF ! of IF (is_master)
892   
893  END SUBROUTINE put_field_rgen 
894 
895  SUBROUTINE put_var_r0(var_name,title,var)
896  ! Put a scalar in file
897   IMPLICIT NONE
898     CHARACTER(LEN=*),INTENT(IN) :: var_name
899     CHARACTER(LEN=*),INTENT(IN) :: title
900     REAL,INTENT(IN)             :: var
901     REAL                        :: varin(1)
902     
903     varin(1)=var
904     
905     CALL put_var_rgen(var_name,title,varin,size(varin))
906
907  END SUBROUTINE put_var_r0
908
909
910  SUBROUTINE put_var_r1(var_name,title,var)
911  ! Put a vector in file
912   IMPLICIT NONE
913     CHARACTER(LEN=*),INTENT(IN) :: var_name
914     CHARACTER(LEN=*),INTENT(IN) :: title
915     REAL,INTENT(IN)             :: var(:)
916     
917     CALL put_var_rgen(var_name,title,var,size(var))
918
919  END SUBROUTINE put_var_r1
920 
921  SUBROUTINE put_var_r2(var_name,title,var)
922  ! Put a 2D field in file
923   IMPLICIT NONE
924     CHARACTER(LEN=*),INTENT(IN) :: var_name
925     CHARACTER(LEN=*),INTENT(IN) :: title
926     REAL,INTENT(IN)             :: var(:,:)
927     
928     CALL put_var_rgen(var_name,title,var,size(var))
929
930  END SUBROUTINE put_var_r2     
931 
932  SUBROUTINE put_var_r3(var_name,title,var)
933  ! Put a 3D field in file
934   IMPLICIT NONE
935     CHARACTER(LEN=*),INTENT(IN) :: var_name
936     CHARACTER(LEN=*),INTENT(IN) :: title
937     REAL,INTENT(IN)             :: var(:,:,:)
938     
939     CALL put_var_rgen(var_name,title,var,size(var))
940
941  END SUBROUTINE put_var_r3
942
943  SUBROUTINE put_var_rgen(var_name,title,var,var_size)
944  USE netcdf, only: NF90_REDEF, NF90_DEF_VAR, NF90_ENDDEF, NF90_PUT_VAR, &
945                    NF90_FLOAT, NF90_DOUBLE, &
946                    NF90_PUT_ATT, NF90_NOERR, nf90_strerror, &
947                    nf90_inq_dimid, nf90_inquire_dimension, NF90_INQ_VARID
948  USE comsoil_h, only: nsoilmx
949  USE mod_phys_lmdz_para, only: is_master
950  USE slab_ice_h, only: noceanmx
951  IMPLICIT NONE
952     CHARACTER(LEN=*),INTENT(IN) :: var_name
953     CHARACTER(LEN=*),INTENT(IN) :: title
954     INTEGER,INTENT(IN)          :: var_size
955     REAL,INTENT(IN)             :: var(var_size)
956     
957     INTEGER :: ierr
958     INTEGER :: nvarid
959     INTEGER :: idim1d
960     logical,save :: firsttime=.true.
961!$OMP THREADPRIVATE(firsttime)
962         
963    IF (is_master) THEN
964
965      IF (var_name=="Time") THEN
966        ! Very specific case of "Time" variable
967        if (firsttime) then
968          ! Create the "Time variable"
969          ierr=NF90_REDEF(nid_restart)
970#ifdef NC_DOUBLE
971          ierr=NF90_DEF_VAR(nid_restart,var_name,NF90_DOUBLE,&
972                            (/idim7/),nvarid)
973#else
974          ierr=NF90_DEF_VAR(nid_restart,var_name,NF90_FLOAT,&
975                            (/idim7/),nvarid)
976#endif
977          IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
978          ierr=NF90_ENDDEF(nid_restart)
979         
980          firsttime=.false.
981        endif
982        ! Append "time" value
983        ! get current length of "Time" dimension
984        ierr=nf90_inq_dimid(nid_restart,var_name,idim1d)
985        ierr=nf90_inquire_dimension(nid_restart,idim1d,len=timeindex)
986        timeindex=timeindex+1
987        ierr=NF90_INQ_VARID(nid_restart,var_name,nvarid)
988        ierr=NF90_PUT_VAR(nid_restart,nvarid,var,&
989                           start=(/timeindex/))
990        IF (ierr/=NF90_NOERR) THEN
991          write(*,*)'put_var_rgen: problem writing Time'
992          write(*,*)trim(nf90_strerror(ierr))
993          CALL ABORT
994        ENDIF
995        return ! nothing left to do
996      ELSEIF (var_size==length) THEN
997        ! We know it is a "controle" kind of 1D array
998        idim1d=idim1
999      ELSEIF (var_size==nsoilmx) THEN
1000        ! We know it is an  "mlayer" kind of 1D array
1001        idim1d=idim3
1002      ELSEIF (var_size==noceanmx) THEN
1003        ! We know it is an  "mlayer" kind of 1D array
1004        idim1d=idim8
1005      ELSE
1006        PRINT *, "put_var_rgen error : wrong dimension"
1007        write(*,*) "  var_size =",var_size
1008        CALL abort
1009
1010      ENDIF ! of IF (var_size==length) THEN
1011
1012      ! Swich to NetCDF define mode
1013      ierr=NF90_REDEF (nid_restart)
1014      ! Define the variable
1015#ifdef NC_DOUBLE
1016      ierr=NF90_DEF_VAR(nid_restart,var_name,NF90_DOUBLE,(/idim1d/),nvarid)
1017#else
1018      ierr=NF90_DEF_VAR(nid_restart,var_name,NF90_FLOAT,(/idim1d/),nvarid)
1019#endif
1020      ! Add a "title" attribute
1021      IF (LEN_TRIM(title)>0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
1022      ! Swich out of define mode
1023      ierr=NF90_ENDDEF(nid_restart)
1024      ! Write variable to file
1025      ierr=NF90_PUT_VAR(nid_restart,nvarid,var)
1026      IF (ierr/=NF90_NOERR) THEN
1027        write(*,*)'put_var_rgen: problem writing '//trim(var_name)
1028        write(*,*)trim(nf90_strerror(ierr))
1029        CALL ABORT
1030      ENDIF
1031    ENDIF ! of IF (is_master)
1032   
1033  END SUBROUTINE put_var_rgen     
1034
1035END MODULE iostart
Note: See TracBrowser for help on using the repository browser.