source: trunk/LMDZ.COMMON/libf/evolution/iostart_PEM.F90 @ 3383

MODULE iostart_PEM
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
!!!
!!! Purpose: Read and write specific netcdf for the PEM
!!!
!!!
!!! Author: LL, inspired by iostart from the PCM
!!!
!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

    IMPLICIT NONE
PRIVATE
    INTEGER,SAVE :: nid_start ! NetCDF file identifier for startfi.nc file
    INTEGER,SAVE :: nid_restart ! NetCDF file identifier for restartfi.nc file

    ! restartfi.nc file dimension identifiers: (see open_restartphy())
    INTEGER,SAVE :: idim1  ! "index" dimension
    INTEGER,SAVE :: idim2  ! "physical_points" dimension
    INTEGER,SAVE :: idim3  ! "subsurface_layers" dimension
    INTEGER,SAVE :: idim4  ! "nlayer_plus_1" dimension
    INTEGER,SAVE :: idim5  ! "number_of_advected_fields" dimension
    INTEGER,SAVE :: idim6  ! "nlayer" dimension
    INTEGER,SAVE :: idim7  ! "Time" dimension
    INTEGER,SAVE :: idim8  ! "nslope" dimension
    INTEGER,SAVE :: idim9  ! "inter slope" dimension
    INTEGER,SAVE :: idim10 ! "nb_str_max" dimension
    INTEGER,SAVE :: timeindex ! current time index (for time-dependent fields)
    INTEGER,PARAMETER :: length=100 ! size of tab_cntrl array

    INTERFACE get_field
      MODULE PROCEDURE Get_field_r1,Get_field_r2,Get_field_r3
    END INTERFACE get_field

    INTERFACE get_var
      MODULE PROCEDURE get_var_r0,Get_var_r1,Get_var_r2,Get_var_r3
    END INTERFACE get_var

    INTERFACE put_field
      MODULE PROCEDURE put_field_r1,put_field_r2,put_field_r3
    END INTERFACE put_field

    INTERFACE put_var
      MODULE PROCEDURE put_var_r0,put_var_r1,put_var_r2,put_var_r3
    END INTERFACE put_var

    PUBLIC nid_start, length
    PUBLIC get_field,get_var,put_field,put_var
    PUBLIC inquire_dimension, inquire_dimension_length
    PUBLIC inquire_field, inquire_field_ndims
    PUBLIC open_startphy,close_startphy,open_restartphy,close_restartphy

CONTAINS

  SUBROUTINE open_startphy(filename)
  USE netcdf, only: NF90_OPEN, NF90_NOERR, NF90_NOWRITE, nf90_strerror
  USE mod_phys_lmdz_para, only: is_master, bcast
  IMPLICIT NONE
    CHARACTER(LEN=*) :: filename
    INTEGER          :: ierr

    IF (is_master) THEN
      ierr = NF90_OPEN (filename, NF90_NOWRITE, nid_start)
      IF (ierr.NE.NF90_NOERR) THEN
        write(*,*)'open_startphy: problem opening file '//trim(filename)
        write(*,*)trim(nf90_strerror(ierr))
        CALL abort_physic("open_startphy","Cannot open file",1)
      ENDIF
    ENDIF

    CALL bcast(nid_start) ! tell all procs about nid_start

  END SUBROUTINE open_startphy

  SUBROUTINE close_startphy
  USE netcdf, only: NF90_CLOSE
  USE mod_phys_lmdz_para, only: is_master
  IMPLICIT NONE
    INTEGER          :: ierr

    IF (is_master) THEN
        ierr = NF90_CLOSE (nid_start)
    ENDIF

  END SUBROUTINE close_startphy


  FUNCTION inquire_field(Field_name)
  ! check if a given field is present in the input file
  USE netcdf, only: NF90_INQ_VARID, NF90_NOERR
  USE mod_phys_lmdz_para, only: is_master, bcast
  IMPLICIT NONE
    CHARACTER(LEN=*),INTENT(IN) :: Field_name
    LOGICAL :: inquire_field
    INTEGER :: varid
    INTEGER :: ierr

    IF (is_master) THEN
      ierr=NF90_INQ_VARID(nid_start,Field_name,varid)
      IF (ierr==NF90_NOERR) THEN
        Inquire_field=.TRUE.
      ELSE
        Inquire_field=.FALSE.
      ENDIF
    ENDIF

    CALL bcast(inquire_field)

  END FUNCTION inquire_field


  FUNCTION inquire_field_ndims(Field_name)
  ! give the number of dimensions of "Field_name" stored in the input file
  USE netcdf, only: nf90_inq_varid, nf90_inquire_variable, &
                    NF90_NOERR, nf90_strerror
  USE mod_phys_lmdz_para, only: is_master, bcast
  IMPLICIT NONE
    CHARACTER(LEN=*),INTENT(IN) :: Field_name
    INTEGER :: inquire_field_ndims
    INTEGER :: varid
    INTEGER :: ierr

    IF (is_master) THEN
      ierr=nf90_inq_varid(nid_start,Field_name,varid)
      ierr=nf90_inquire_variable(nid_start,varid,&
                                  ndims=inquire_field_ndims)
      IF (ierr.NE.NF90_NOERR) THEN
        write(*,*)'inquire_field_ndims: problem obtaining ndims of '&
                  //trim(field_name)
        write(*,*)trim(nf90_strerror(ierr))
        CALL abort_physic("inquire_field_ndims","Failed to get ndims",1)
      ENDIF
    ENDIF

    CALL bcast(inquire_field_ndims)

  END FUNCTION inquire_field_ndims


  FUNCTION inquire_dimension(Field_name)
  ! check if a given dimension is present in the input file
  USE netcdf, only: nf90_inq_dimid, NF90_NOERR
  USE mod_phys_lmdz_para, only: is_master, bcast
  IMPLICIT NONE
    CHARACTER(LEN=*),INTENT(IN) :: Field_name
    LOGICAL :: inquire_dimension
    INTEGER :: varid
    INTEGER :: ierr

    IF (is_master) THEN
      ierr=NF90_INQ_DIMID(nid_start,Field_name,varid)
      IF (ierr==NF90_NOERR) THEN
        Inquire_dimension=.TRUE.
      ELSE
        Inquire_dimension=.FALSE.
      ENDIF
    ENDIF

    CALL bcast(inquire_dimension)

  END FUNCTION inquire_dimension

  FUNCTION inquire_dimension_length(Field_name)
  ! give the length of the "Field_name" dimension stored in the input file
  USE netcdf, only: nf90_inquire_dimension, nf90_inq_dimid, &
                    NF90_NOERR, nf90_strerror
  USE mod_phys_lmdz_para, only: is_master, bcast
  IMPLICIT NONE
    CHARACTER(LEN=*),INTENT(IN) :: Field_name
    INTEGER :: inquire_dimension_length
    INTEGER :: varid
    INTEGER :: ierr

    IF (is_master) THEN
      ierr=nf90_inq_dimid(nid_start,Field_name,varid)
      ierr=nf90_inquire_dimension(nid_start,varid,&
                                  len=inquire_dimension_length)
      IF (ierr.NE.NF90_NOERR) THEN
        write(*,*)'inquire_field_length: problem obtaining length of '&
                  //trim(field_name)
        write(*,*)trim(nf90_strerror(ierr))
        CALL abort_physic("inquire_field_ndims","Failed to get length",1)
      ENDIF
    ENDIF

    CALL bcast(inquire_dimension_length)

  END FUNCTION inquire_dimension_length



  SUBROUTINE Get_Field_r1(field_name,field,found,timeindex)
  ! For a surface field
  use mod_grid_phy_lmdz, only: klon_glo ! number of atmospheric columns (full grid)
  IMPLICIT NONE
    CHARACTER(LEN=*),INTENT(IN)    :: Field_name
    REAL,INTENT(INOUT)               :: Field(:)
    LOGICAL,INTENT(OUT),OPTIONAL   :: found
    INTEGER,INTENT(IN),OPTIONAL    :: timeindex ! time index of sought data

    integer :: edges(4), corners(4)

    edges(1)=klon_glo
    edges(2:4)=1
    corners(1:4)=1
    if (PRESENT(timeindex)) then
      corners(2)=timeindex
    endif

    IF (PRESENT(found)) THEN
      CALL Get_field_rgen(field_name,field,1,corners,edges,found)
    ELSE
      CALL Get_field_rgen(field_name,field,1,corners,edges)
    ENDIF

  END SUBROUTINE Get_Field_r1

  SUBROUTINE Get_Field_r2(field_name,field,found,timeindex)
  ! For a "3D" horizontal-vertical field
  use mod_grid_phy_lmdz, only: klon_glo ! number of atmospheric columns (full grid)
  IMPLICIT NONE
    CHARACTER(LEN=*),INTENT(IN)    :: Field_name
    REAL,INTENT(INOUT)               :: Field(:,:)
    LOGICAL,INTENT(OUT),OPTIONAL   :: found
    INTEGER,INTENT(IN),OPTIONAL    :: timeindex ! time index of sought data

    integer :: edges(4), corners(4)

    edges(1)=klon_glo
    edges(2)=size(field,2)
    edges(3:4)=1
    corners(1:4)=1
    if (PRESENT(timeindex)) then
      corners(3)=timeindex
    endif

    IF (PRESENT(found)) THEN
      CALL Get_field_rgen(field_name,field,size(field,2),&
                          corners,edges,found)
    ELSE
      CALL Get_field_rgen(field_name,field,size(field,2),&
                          corners,edges)
    ENDIF


  END SUBROUTINE Get_Field_r2

  SUBROUTINE Get_Field_r3(field_name,field,found,timeindex)
  ! for a "4D" field surf/alt/??
  use mod_grid_phy_lmdz, only: klon_glo ! number of atmospheric columns (full grid)
  IMPLICIT NONE
    CHARACTER(LEN=*),INTENT(IN)    :: Field_name
    REAL,INTENT(INOUT)               :: Field(:,:,:)
    LOGICAL,INTENT(OUT),OPTIONAL   :: found
    INTEGER,INTENT(IN),OPTIONAL    :: timeindex ! time index of sought data

    integer :: edges(4), corners(4)

    edges(1)=klon_glo
    edges(2)=size(field,2)
    edges(3)=size(field,3)
    edges(4)=1
    corners(1:4)=1
    if (PRESENT(timeindex)) then
      corners(4)=timeindex
    endif

    IF (PRESENT(found)) THEN
      CALL Get_field_rgen(field_name,field,size(field,2)*size(field,3),&
                          corners,edges,found)
    ELSE
      CALL Get_field_rgen(field_name,field,size(field,2)*size(field,3),&
                          corners,edges)
    ENDIF

  END SUBROUTINE Get_Field_r3

  SUBROUTINE Get_field_rgen(field_name,field,field_size, &
                            corners,edges,found)
  USE netcdf
  USE dimphy
  USE mod_grid_phy_lmdz
  USE mod_phys_lmdz_para
  IMPLICIT NONE
    CHARACTER(LEN=*) :: Field_name
    INTEGER          :: field_size
    REAL             :: field(klon,field_size)
    INTEGER,INTENT(IN) :: corners(4)
    INTEGER,INTENT(IN) :: edges(4)
    LOGICAL,OPTIONAL :: found

    REAL    :: field_glo(klon_glo,field_size)
    LOGICAL :: tmp_found
    INTEGER :: varid
    INTEGER :: ierr

    IF (is_master) THEN

      ierr=NF90_INQ_VARID(nid_start,Field_name,varid)

      IF (ierr==NF90_NOERR) THEN
        CALL body(field_glo)
        tmp_found=.TRUE.
      ELSE
        tmp_found=.FALSE.
      ENDIF

    ENDIF

    CALL bcast(tmp_found)

    IF (tmp_found) THEN
      CALL scatter(field_glo,field)
    ENDIF

    IF (PRESENT(found)) THEN
      found=tmp_found
    ELSE
      IF (.NOT. tmp_found) THEN
        write(*,*) 'get_field_rgen: Field <'//field_name//'> not found'
        CALL abort_physic("get_field_rgen","Failed to get field",1)
      ENDIF
    ENDIF


    CONTAINS

     SUBROUTINE body(field_glo)
       REAL :: field_glo(klon_glo*field_size)
         ierr=NF90_GET_VAR(nid_start,varid,field_glo,corners,edges)
         IF (ierr/=NF90_NOERR) THEN
           ! La variable exist dans le fichier mais la lecture a echouee.
           write(*,*) 'get_field_rgen: Failed reading <'//field_name//'>'

!           IF (field_name=='CLWCON' .OR. field_name=='RNEBCON' .OR. field_name=='RATQS') THEN
!              ! Essaye de lire le variable sur surface uniqument, comme fait avant
!              field_glo(:)=0.
!              ierr=NF90_GET_VAR(nid_start,varid,field_glo(1:klon_glo))
!              IF (ierr/=NF90_NOERR) THEN
!                 write(*,*) 'phyetat0: Lecture echouee aussi en 2D pour <'//field_name//'>'
!                 CALL abort
!              ELSE
!                 write(*,*) 'phyetat0: La variable <'//field_name//'> lu sur surface seulement'!, selon ancien format, le reste mis a zero'
!              END IF
!           ELSE
              CALL abort_physic("get_field_rgen","Failed to read field",1)
!           ENDIF
         ENDIF

     END SUBROUTINE body

  END SUBROUTINE Get_field_rgen


  SUBROUTINE get_var_r0(var_name,var,found)
  ! Get a scalar from input file
  IMPLICIT NONE
    CHARACTER(LEN=*),INTENT(IN)  :: var_name
    REAL,INTENT(INOUT)             :: var
    LOGICAL,OPTIONAL,INTENT(OUT) :: found

    REAL                         :: varout(1)

    IF (PRESENT(found)) THEN
      CALL Get_var_rgen(var_name,varout,size(varout),found)
    ELSE
      CALL Get_var_rgen(var_name,varout,size(varout))
    ENDIF
    var=varout(1)

  END SUBROUTINE get_var_r0

  SUBROUTINE get_var_r1(var_name,var,found)
  ! Get a vector from input file
  IMPLICIT NONE
    CHARACTER(LEN=*),INTENT(IN)  :: var_name
    REAL,INTENT(INOUT)             :: var(:)
    LOGICAL,OPTIONAL,INTENT(OUT) :: found

    IF (PRESENT(found)) THEN
      CALL Get_var_rgen(var_name,var,size(var),found)
    ELSE
      CALL Get_var_rgen(var_name,var,size(var))
    ENDIF

  END SUBROUTINE get_var_r1

  SUBROUTINE get_var_r2(var_name,var,found)
  ! Get a 2D field from input file
  IMPLICIT NONE
    CHARACTER(LEN=*),INTENT(IN)  :: var_name
    REAL,INTENT(OUT)             :: var(:,:)
    LOGICAL,OPTIONAL,INTENT(OUT) :: found

    IF (PRESENT(found)) THEN
      CALL Get_var_rgen(var_name,var,size(var),found)
    ELSE
      CALL Get_var_rgen(var_name,var,size(var))
    ENDIF

  END SUBROUTINE get_var_r2

  SUBROUTINE get_var_r3(var_name,var,found)
  ! Get a 3D field frominput file
  IMPLICIT NONE
    CHARACTER(LEN=*),INTENT(IN)  :: var_name
    REAL,INTENT(INOUT)             :: var(:,:,:)
    LOGICAL,OPTIONAL,INTENT(OUT) :: found

    IF (PRESENT(found)) THEN
      CALL Get_var_rgen(var_name,var,size(var),found)
    ELSE
      CALL Get_var_rgen(var_name,var,size(var))
    ENDIF

  END SUBROUTINE get_var_r3

  SUBROUTINE Get_var_rgen(var_name,var,var_size,found)
  USE netcdf
  USE dimphy
  USE mod_grid_phy_lmdz
  USE mod_phys_lmdz_para
  IMPLICIT NONE
    CHARACTER(LEN=*) :: var_name
    INTEGER          :: var_size
    REAL             :: var(var_size)
    LOGICAL,OPTIONAL :: found

    LOGICAL :: tmp_found
    INTEGER :: varid
    INTEGER :: ierr

    IF (is_mpi_root .AND. is_omp_root) THEN

      ierr=NF90_INQ_VARID(nid_start,var_name,varid)

      IF (ierr==NF90_NOERR) THEN
        ierr=NF90_GET_VAR(nid_start,varid,var)
        IF (ierr/=NF90_NOERR) THEN
          write(*,*) 'phyetat0: Failed loading <'//trim(var_name)//'>'
          CALL abort_physic("get_var_rgen","Failed to read variable",1)
        ENDIF
        tmp_found=.TRUE.
      ELSE
        tmp_found=.FALSE.
      ENDIF

    ENDIF

    CALL bcast(tmp_found)

    IF (tmp_found) THEN
      CALL bcast(var)
    ENDIF

    IF (PRESENT(found)) THEN
      found=tmp_found
    ELSE
      IF (.NOT. tmp_found) THEN
        write(*,*) 'phyetat0: Variable <'//trim(var_name)//'> not found'
        CALL abort_physic("get_var_rgen","Failed to read variable",1)
      ENDIF
    ENDIF

  END SUBROUTINE Get_var_rgen

!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  SUBROUTINE open_restartphy(filename)
  USE netcdf, only: NF90_CREATE, NF90_CLOBBER, NF90_64BIT_OFFSET, &
                    NF90_NOERR, nf90_strerror, &
                    NF90_PUT_ATT, NF90_GLOBAL, NF90_DEF_DIM, &
                    NF90_UNLIMITED, NF90_ENDDEF, &
                    NF90_WRITE, NF90_OPEN
  USE mod_phys_lmdz_para, only: is_master
  USE mod_grid_phy_lmdz, only: klon_glo
  USE dimphy, only: klev, klevp1
#ifndef CPP_STD
  USE tracer_mod, only: nqmx
#else
  use tracer_h, only:   nqtot
#endif
  USE comsoil_h_PEM, only:  nsoilmx_PEM
  USE comslope_mod, only: nslope
  use layering_mod, only: nb_str_max
  IMPLICIT NONE
    CHARACTER(LEN=*),INTENT(IN) :: filename
    INTEGER                     :: ierr
    LOGICAL,SAVE :: already_created=.false.

#ifdef CPP_STD
    INTEGER :: nqmx
    nqmx=nqtot
#endif

    IF (is_master) THEN
      if (.not.already_created) then
        ! At the very first call, create the file
        ierr=NF90_CREATE(filename,IOR(NF90_CLOBBER,NF90_64BIT_OFFSET), &
                          nid_restart)
        IF (ierr/=NF90_NOERR) THEN
          write(*,*)'open_restartphy: problem creating file '//trim(filename)
          write(*,*)trim(nf90_strerror(ierr))
          CALL abort_physic("open_restartphy","Failed creating file",1)
        ENDIF
        already_created=.true.
      else
        ! Just open the file
        ierr=NF90_OPEN(filename,NF90_WRITE,nid_restart)
        IF (ierr/=NF90_NOERR) THEN
          write(*,*)'open_restartphy: problem opening file '//trim(filename)
          write(*,*)trim(nf90_strerror(ierr))
          CALL abort_physic("open_restartphy","Failed opening file",1)
        ENDIF
        return
      endif ! of if (.not.already_created)

      ierr=NF90_PUT_ATT(nid_restart,NF90_GLOBAL,"title",&
                        "Physics start file")
      IF (ierr/=NF90_NOERR) THEN
        write(*,*)'open_restartphy: problem writing title '
        write(*,*)trim(nf90_strerror(ierr))
      ENDIF

      ierr=NF90_DEF_DIM(nid_restart,"index",length,idim1)
      IF (ierr/=NF90_NOERR) THEN
        write(*,*)'open_restartphy: problem defining index dimension '
        write(*,*)trim(nf90_strerror(ierr))
        CALL abort_physic("open_restartphy","Failed defining index",1)
      ENDIF

      ierr=NF90_DEF_DIM(nid_restart,"physical_points",klon_glo,idim2)
      IF (ierr/=NF90_NOERR) THEN
        write(*,*)'open_restartphy: problem defining physical_points dimension '
        write(*,*)trim(nf90_strerror(ierr))
        CALL abort_physic("open_restartphy","Failed defining physical_points",1)
      ENDIF

      ierr=NF90_DEF_DIM(nid_restart,"subsurface_layers",nsoilmx_PEM,idim3)
      IF (ierr/=NF90_NOERR) THEN
        write(*,*)'open_restartphy: problem defining subsurface_layers dimension '
        write(*,*)trim(nf90_strerror(ierr))
        CALL abort_physic("open_restartphy","Failed defining subsurface_layers",1)
      ENDIF

      ierr=NF90_DEF_DIM(nid_restart,"nlayer_plus_1",klevp1,idim4)
      IF (ierr/=NF90_NOERR) THEN
        write(*,*)'open_restartphy: problem defining nlayer_plus_1 dimension '
        write(*,*)trim(nf90_strerror(ierr))
        CALL abort_physic("open_restartphy","Failed defining nlayer_plus_1",1)
      ENDIF

      if (nqmx.ne.0) then
        ierr=NF90_DEF_DIM(nid_restart,"number_of_advected_fields",nqmx,idim5)
      else
        ! pretend nqmx=1 because 0 size implies unlimited dimension for NetCDF
        ierr=NF90_DEF_DIM(nid_restart,"number_of_advected_fields",1,idim5)
      endif
      IF (ierr/=NF90_NOERR) THEN
        write(*,*)'open_restartphy: problem defining number_of_advected_fields dimension '
        write(*,*)trim(nf90_strerror(ierr))
        CALL abort_physic("open_restartphy","Failed defining number_of_advected_fields",1)
      ENDIF

      ierr=NF90_DEF_DIM(nid_restart,"nlayer",klev,idim6)
      IF (ierr/=NF90_NOERR) THEN
        write(*,*)'open_restartphy: problem defining nlayer dimension '
        write(*,*)trim(nf90_strerror(ierr))
        CALL abort_physic("open_restartphy","Failed defining nlayer",1)
      ENDIF

      ierr=NF90_DEF_DIM(nid_restart,"Time",NF90_UNLIMITED,idim7)
      IF (ierr/=NF90_NOERR) THEN
        write(*,*)'open_restartphy: problem defining Time dimension '
        write(*,*)trim(nf90_strerror(ierr))
        CALL abort_physic("open_restartphy","Failed defining Time",1)
      ENDIF

      ierr=NF90_DEF_DIM(nid_restart,"nslope",nslope,idim8)
      IF (ierr/=NF90_NOERR) THEN
        write(*,*)'phyredem: problem defining nslope dimension'
        write(*,*)trim(nf90_strerror(ierr))
        CALL ABORT
      ENDIF

      ierr=NF90_DEF_DIM(nid_restart,"inter slope",nslope+1,idim9)
      IF (ierr/=NF90_NOERR) THEN
        write(*,*)'phyredem: problem defining inter slope dimension'
        write(*,*)trim(nf90_strerror(ierr))
        CALL ABORT
      ENDIF

      ierr=NF90_DEF_DIM(nid_restart,"nb_str_max",nb_str_max,idim10)
      IF (ierr/=NF90_NOERR) THEN
        write(*,*)'phyredem: problem defining nb_str_max dimension'
        write(*,*)trim(nf90_strerror(ierr))
        CALL ABORT
      ENDIF

      ierr=NF90_ENDDEF(nid_restart)
      IF (ierr/=NF90_NOERR) THEN
        write(*,*)'open_restartphy: problem ending definition mode '
        write(*,*)trim(nf90_strerror(ierr))
        CALL abort_physic("open_restartphy","Failed ending definition mode",1)
      ENDIF
    ENDIF

  END SUBROUTINE open_restartphy

  SUBROUTINE close_restartphy
  USE netcdf, only: NF90_CLOSE
  USE mod_phys_lmdz_para, only: is_master
  IMPLICIT NONE
    INTEGER          :: ierr

    IF (is_master) THEN
      ierr = NF90_CLOSE (nid_restart)
    ENDIF

  END SUBROUTINE close_restartphy

  SUBROUTINE put_field_r1(field_name,title,field,time)
  ! For a surface field
  IMPLICIT NONE
  CHARACTER(LEN=*),INTENT(IN)    :: field_name
  CHARACTER(LEN=*),INTENT(IN)    :: title
  REAL,INTENT(IN)                :: field(:)
  REAL,OPTIONAL,INTENT(IN)       :: time

  IF (present(time)) THEN
    ! if timeindex is present, it is a time-dependent variable
    CALL put_field_rgen(field_name,title,field,1,time)
  ELSE
    CALL put_field_rgen(field_name,title,field,1)
  ENDIF

  END SUBROUTINE put_field_r1

  SUBROUTINE put_field_r2(field_name,title,field,time)
  ! For a "3D" horizontal-vertical field
  IMPLICIT NONE
  CHARACTER(LEN=*),INTENT(IN)    :: field_name
  CHARACTER(LEN=*),INTENT(IN)    :: title
  REAL,INTENT(IN)                :: field(:,:)
  REAL,OPTIONAL,INTENT(IN)       :: time

  IF (present(time)) THEN
    ! if timeindex is present, it is a time-dependent variable
    CALL put_field_rgen(field_name,title,field,size(field,2),time)
  ELSE
    CALL put_field_rgen(field_name,title,field,size(field,2))
  ENDIF

  END SUBROUTINE put_field_r2

  SUBROUTINE put_field_r3(field_name,title,field,time)
  ! For a "4D" field surf/alt/??
  IMPLICIT NONE
  CHARACTER(LEN=*),INTENT(IN)    :: field_name
  CHARACTER(LEN=*),INTENT(IN)    :: title
  REAL,INTENT(IN)                :: field(:,:,:)
  REAL,OPTIONAL,INTENT(IN)       :: time

  IF (present(time)) THEN
    ! if timeindex is present, it is a time-dependent variable
    CALL put_field_rgen(field_name,title,field,size(field,2)*size(field,3),&
                        time)
  ELSE
    CALL put_field_rgen(field_name,title,field,size(field,2)*size(field,3))
  ENDIF

  END SUBROUTINE put_field_r3

  SUBROUTINE put_field_rgen(field_name,title,field,field_size,time)
  USE netcdf
  USE dimphy
  USE comsoil_h_PEM, only:  nsoilmx_PEM
  USE comslope_mod, ONLY: nslope
  use layering_mod, only: nb_str_max
  USE mod_grid_phy_lmdz
  USE mod_phys_lmdz_para
  IMPLICIT NONE
  CHARACTER(LEN=*),INTENT(IN)    :: field_name
  CHARACTER(LEN=*),INTENT(IN)    :: title
  INTEGER,INTENT(IN)             :: field_size
  REAL,INTENT(IN)                :: field(klon,field_size)
  REAL,OPTIONAL,INTENT(IN)       :: time

  REAL                           :: field_glo(klon_glo,field_size)
  INTEGER                        :: ierr
  INTEGER                        :: nvarid

    CALL gather(field,field_glo)

    IF (is_master) THEN

      IF (field_size==1) THEN
        ! input is a 1D "surface field" array
        if (.not.present(time)) then ! for a time-independent field
          ierr=NF90_REDEF(nid_restart)
#ifdef NC_DOUBLE
          ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
                            (/idim2/),nvarid)
#else
          ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
                            (/idim2/),nvarid)
#endif
          if (ierr.ne.NF90_NOERR) then
            write(*,*)"put_field_rgen error: failed to define "//trim(field_name)
            write(*,*)trim(nf90_strerror(ierr))
          endif
          IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
          ierr=NF90_ENDDEF(nid_restart)
          ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo)
        else
          ! check if the variable has already been defined:
          ierr=NF90_INQ_VARID(nid_restart,field_name,nvarid)
          if (ierr/=NF90_NOERR) then ! variable not found, define it
            ierr=NF90_REDEF(nid_restart)
#ifdef NC_DOUBLE
            ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
                              (/idim2,idim7/),nvarid)
#else
            ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
                              (/idim2,idim7/),nvarid)
#endif
            if (ierr.ne.NF90_NOERR) then
              write(*,*)"put_field_rgen error: failed to define "//trim(field_name)
              write(*,*)trim(nf90_strerror(ierr))
            endif
            IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
            ierr=NF90_ENDDEF(nid_restart)
          endif
          ! Write the variable
          ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo,&
                            start=(/1,timeindex/))
        endif ! of if (.not.present(timeindex))

      ELSE IF (field_size==klev) THEN
        ! input is a 2D "atmospheric field" array
        if (.not.present(time)) then ! for a time-independent field
          ierr=NF90_REDEF(nid_restart)
#ifdef NC_DOUBLE
          ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
                            (/idim2,idim6/),nvarid)
#else
          ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
                            (/idim2,idim6/),nvarid)
#endif
          if (ierr.ne.NF90_NOERR) then
            write(*,*)"put_field_rgen error: failed to define "//trim(field_name)
            write(*,*)trim(nf90_strerror(ierr))
          endif
          IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
          ierr=NF90_ENDDEF(nid_restart)
          ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo)
        else
          ! check if the variable has already been defined:
          ierr=NF90_INQ_VARID(nid_restart,field_name,nvarid)
          if (ierr/=NF90_NOERR) then ! variable not found, define it
            ierr=NF90_REDEF(nid_restart)
#ifdef NC_DOUBLE
            ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
                              (/idim2,idim6,idim7/),nvarid)
#else
            ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
                              (/idim2,idim6,idim7/),nvarid)
#endif
            if (ierr.ne.NF90_NOERR) then
              write(*,*)"put_field_rgen error: failed to define "//trim(field_name)
              write(*,*)trim(nf90_strerror(ierr))
            endif
            IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
            ierr=NF90_ENDDEF(nid_restart)
          endif
          ! Write the variable
          ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo,&
                            start=(/1,1,timeindex/))
        endif ! of if (.not.present(time))

      ELSE IF (field_size==klevp1) THEN
        ! input is a 2D "interlayer atmospheric field" array
        if (.not.present(time)) then ! for a time-independent field
          ierr=NF90_REDEF(nid_restart)
#ifdef NC_DOUBLE
          ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
                            (/idim2,idim4/),nvarid)
#else
          ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
                            (/idim2,idim4/),nvarid)
#endif
          if (ierr.ne.NF90_NOERR) then
            write(*,*)"put_field_rgen error: failed to define "//trim(field_name)
            write(*,*)trim(nf90_strerror(ierr))
          endif
          IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
          ierr = NF90_ENDDEF(nid_restart)
          ierr = NF90_PUT_VAR(nid_restart,nvarid,field_glo)
        else
          ! check if the variable has already been defined:
          ierr=NF90_INQ_VARID(nid_restart,field_name,nvarid)
          if (ierr/=NF90_NOERR) then ! variable not found, define it
            ierr=NF90_REDEF(nid_restart)
#ifdef NC_DOUBLE
            ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
                              (/idim2,idim4,idim7/),nvarid)
#else
            ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
                              (/idim2,idim4,idim7/),nvarid)
#endif
            if (ierr.ne.NF90_NOERR) then
              write(*,*)"put_field_rgen error: failed to define "//trim(field_name)
              write(*,*)trim(nf90_strerror(ierr))
            endif
            IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
            ierr=NF90_ENDDEF(nid_restart)
          endif
          ! Write the variable
          ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo,&
                            start=(/1,1,timeindex/))
        endif ! of if (.not.present(timeindex))

      ELSE IF (field_size==nsoilmx_PEM) THEN
        ! input is a 2D "subsurface field" array
        if (.not.present(time)) then ! for a time-independent field
          ierr = NF90_REDEF(nid_restart)
#ifdef NC_DOUBLE
          ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
                            (/idim2,idim3/),nvarid)
#else
          ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
                            (/idim2,idim3/),nvarid)
#endif
          if (ierr.ne.NF90_NOERR) then
            write(*,*)"put_field_rgen error: failed to define "//trim(field_name)
            write(*,*)trim(nf90_strerror(ierr))
          endif
          IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
          ierr = NF90_ENDDEF(nid_restart)
          ierr = NF90_PUT_VAR(nid_restart,nvarid,field_glo)
        else
          ! check if the variable has already been defined:
          ierr=NF90_INQ_VARID(nid_restart,field_name,nvarid)
          if (ierr/=NF90_NOERR) then ! variable not found, define it
            ierr=NF90_REDEF(nid_restart)
#ifdef NC_DOUBLE
            ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
                              (/idim2,idim3,idim7/),nvarid)
#else
            ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
                              (/idim2,idim3,idim7/),nvarid)
#endif
           if (ierr.ne.NF90_NOERR) then
              write(*,*)"put_field_rgen error: failed to define "//trim(field_name)
              write(*,*)trim(nf90_strerror(ierr))
            endif
            IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
            ierr=NF90_ENDDEF(nid_restart)
          endif
          ! Write the variable
          ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo,&
                            start=(/1,1,timeindex/))

        endif ! of if (.not.present(time))


      ELSE IF (field_size==nslope) THEN
        ! input is a 2D "subsurface field" array
        if (.not.present(time)) then ! for a time-independent field
          ierr = NF90_REDEF(nid_restart)
#ifdef NC_DOUBLE
          ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
                            (/idim2,idim8/),nvarid)
#else
          ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
                            (/idim2,idim8/),nvarid)
#endif
          if (ierr.ne.NF90_NOERR) then
            write(*,*)"put_field_rgen error: failed to define"//trim(field_name)
            write(*,*)trim(nf90_strerror(ierr))
          endif
          IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
          ierr = NF90_ENDDEF(nid_restart)
          ierr = NF90_PUT_VAR(nid_restart,nvarid,field_glo)
        else
          ! check if the variable has already been defined:
          ierr=NF90_INQ_VARID(nid_restart,field_name,nvarid)
          if (ierr/=NF90_NOERR) then ! variable not found, define it
            ierr=NF90_REDEF(nid_restart)
#ifdef NC_DOUBLE
            ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
                              (/idim2,idim8,idim7/),nvarid)
#else
            ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
                              (/idim2,idim8,idim7/),nvarid)
#endif
           if (ierr.ne.NF90_NOERR) then
              write(*,*)"put_field_rgen error: failed to define"//trim(field_name)
              write(*,*)trim(nf90_strerror(ierr))
            endif
            IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
            ierr=NF90_ENDDEF(nid_restart)
          endif
          ! Write the variable
          ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo,&
                            start=(/1,1,timeindex/))

        endif ! of if (.not.present(time))

      ELSE IF (field_size == nb_str_max) THEN
        ! input is a 2D "stratification" array
        if (.not.present(time)) then ! for a time-independent field
          ierr = NF90_REDEF(nid_restart)
#ifdef NC_DOUBLE
          ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
                            (/idim2,idim8/),nvarid)
#else
          ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
                            (/idim2,idim8/),nvarid)
#endif
          if (ierr.ne.NF90_NOERR) then
            write(*,*)"put_field_rgen error: failed to define"//trim(field_name)
            write(*,*)trim(nf90_strerror(ierr))
          endif
          IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
          ierr = NF90_ENDDEF(nid_restart)
          ierr = NF90_PUT_VAR(nid_restart,nvarid,field_glo)
        else
          ! check if the variable has already been defined:
          ierr=NF90_INQ_VARID(nid_restart,field_name,nvarid)
          if (ierr/=NF90_NOERR) then ! variable not found, define it
            ierr=NF90_REDEF(nid_restart)
#ifdef NC_DOUBLE
            ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_DOUBLE,&
                              (/idim2,idim10,idim7/),nvarid)
#else
            ierr=NF90_DEF_VAR(nid_restart,field_name,NF90_FLOAT,&
                              (/idim2,idim10,idim7/),nvarid)
#endif
           if (ierr.ne.NF90_NOERR) then
              write(*,*)"put_field_rgen error: failed to define"//trim(field_name)
              write(*,*)trim(nf90_strerror(ierr))
            endif
            IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
            ierr=NF90_ENDDEF(nid_restart)
          endif
          ! Write the variable
          ierr=NF90_PUT_VAR(nid_restart,nvarid,field_glo,&
                            start=(/1,1,timeindex/))

        endif ! of if (.not.present(time))

      ELSE
        write(*,*) "Error phyredem(put_field_rgen) : wrong dimension for ",trim(field_name)
        write(*,*) "  field_size =",field_size
        CALL abort_physic("put_field_rgen","wrong field dimension",1)
      ENDIF

      ! Check the writting of field to file went OK
      if (ierr.ne.NF90_NOERR) then
        write(*,*) " Error phyredem(put_field_rgen) : failed writing ",trim(field_name)
        write(*,*)trim(nf90_strerror(ierr))
        CALL abort_physic("put_field_rgen","Failed writing field",1)
      endif

    ENDIF ! of IF (is_master)

  END SUBROUTINE put_field_rgen

  SUBROUTINE put_var_r0(var_name,title,var)
  ! Put a scalar in file
   IMPLICIT NONE
     CHARACTER(LEN=*),INTENT(IN) :: var_name
     CHARACTER(LEN=*),INTENT(IN) :: title
     REAL,INTENT(IN)             :: var
     REAL                        :: varin(1)

     varin(1)=var

     CALL put_var_rgen(var_name,title,varin,size(varin))

  END SUBROUTINE put_var_r0


  SUBROUTINE put_var_r1(var_name,title,var)
  ! Put a vector in file
   IMPLICIT NONE
     CHARACTER(LEN=*),INTENT(IN) :: var_name
     CHARACTER(LEN=*),INTENT(IN) :: title
     REAL,INTENT(IN)             :: var(:)

     CALL put_var_rgen(var_name,title,var,size(var))

  END SUBROUTINE put_var_r1

  SUBROUTINE put_var_r2(var_name,title,var)
  ! Put a 2D field in file
   IMPLICIT NONE
     CHARACTER(LEN=*),INTENT(IN) :: var_name
     CHARACTER(LEN=*),INTENT(IN) :: title
     REAL,INTENT(IN)             :: var(:,:)

     CALL put_var_rgen(var_name,title,var,size(var))

  END SUBROUTINE put_var_r2

  SUBROUTINE put_var_r3(var_name,title,var)
  ! Put a 3D field in file
   IMPLICIT NONE
     CHARACTER(LEN=*),INTENT(IN) :: var_name
     CHARACTER(LEN=*),INTENT(IN) :: title
     REAL,INTENT(IN)             :: var(:,:,:)

     CALL put_var_rgen(var_name,title,var,size(var))

  END SUBROUTINE put_var_r3

  SUBROUTINE put_var_rgen(var_name,title,var,var_size)
  USE netcdf, only: NF90_REDEF, NF90_DEF_VAR, NF90_ENDDEF, NF90_PUT_VAR, &
                    NF90_FLOAT, NF90_DOUBLE, &
                    NF90_PUT_ATT, NF90_NOERR, nf90_strerror, &
                    nf90_inq_dimid, nf90_inquire_dimension, NF90_INQ_VARID
  USE comsoil_h_PEM, only:  nsoilmx_PEM
  USE comslope_mod, only: nslope
  USE mod_phys_lmdz_para, only: is_master
  IMPLICIT NONE
     CHARACTER(LEN=*),INTENT(IN) :: var_name
     CHARACTER(LEN=*),INTENT(IN) :: title
     INTEGER,INTENT(IN)          :: var_size
     REAL,INTENT(IN)             :: var(var_size)

     INTEGER :: ierr
     INTEGER :: nvarid
     INTEGER :: idim1d
     logical,save :: firsttime=.true.

    IF (is_master) THEN

      IF (var_name=="Time") THEN
        ! Very specific case of "Time" variable
        if (firsttime) then
          ! Create the "Time variable"
          ierr=NF90_REDEF(nid_restart)
#ifdef NC_DOUBLE
          ierr=NF90_DEF_VAR(nid_restart,var_name,NF90_DOUBLE,&
                            (/idim7/),nvarid)
#else
          ierr=NF90_DEF_VAR(nid_restart,var_name,NF90_FLOAT,&
                            (/idim7/),nvarid)
#endif
          IF (LEN_TRIM(title) > 0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
          ierr=NF90_ENDDEF(nid_restart)

          firsttime=.false.
        endif
        ! Append "time" value
        ! get current length of "Time" dimension
        ierr=nf90_inq_dimid(nid_restart,var_name,idim1d)
        ierr=nf90_inquire_dimension(nid_restart,idim1d,len=timeindex)
        timeindex=timeindex+1
        ierr=NF90_INQ_VARID(nid_restart,var_name,nvarid)
        ierr=NF90_PUT_VAR(nid_restart,nvarid,var,&
                           start=(/timeindex/))
        IF (ierr/=NF90_NOERR) THEN
          write(*,*)'put_var_rgen: problem writing Time'
          write(*,*)trim(nf90_strerror(ierr))
          CALL abort_physic("get_var_rgen","Failed to write Time",1)
        ENDIF
        return ! nothing left to do
      ELSEIF (var_size==length) THEN
        ! We know it is a "controle" kind of 1D array
        idim1d=idim1
      ELSEIF (var_size==nsoilmx_PEM) THEN
        ! We know it is an "mlayer" kind of 1D array
        idim1d=idim3
      ELSEIF (var_size==nslope+1) THEN
        ! We know it is an "inter slope" kind of 1D array
        idim1d=idim9
      ELSEIF (var_name == "nb_str_max") THEN
        ! We know it is a kind of stratification array
        idim1d = idim10
      ELSE
        write(*,*) "put_var_rgen error : wrong dimension"
        write(*,*) "  var_size =",var_size
        CALL abort_physic("get_var_rgen","Wrong variable dimension",1)

      ENDIF ! of IF (var_size==length) THEN

      ! Swich to NetCDF define mode
      ierr=NF90_REDEF (nid_restart)
      ! Define the variable
#ifdef NC_DOUBLE
      ierr=NF90_DEF_VAR(nid_restart,var_name,NF90_DOUBLE,(/idim1d/),nvarid)
#else
      ierr=NF90_DEF_VAR(nid_restart,var_name,NF90_FLOAT,(/idim1d/),nvarid)
#endif
      ! Add a "title" attribute
      IF (LEN_TRIM(title)>0) ierr=NF90_PUT_ATT(nid_restart,nvarid,"title",title)
      ! Swich out of define mode
      ierr=NF90_ENDDEF(nid_restart)
      ! Write variable to file
      ierr=NF90_PUT_VAR(nid_restart,nvarid,var)
      IF (ierr/=NF90_NOERR) THEN
        write(*,*)'put_var_rgen: problem writing '//trim(var_name)
        write(*,*)trim(nf90_strerror(ierr))
        CALL abort_physic("get_var_rgen","Failed writing variable",1)
      ENDIF
    ENDIF ! of IF (is_master)

  END SUBROUTINE put_var_rgen

END MODULE iostart_PEM