init_output_ncn.F90

Go to the documentation of this file.

!SFX_LIC Copyright 1994-2014 CNRS, Meteo-France and Universite Paul Sabatier
!SFX_LIC This is part of the SURFEX software governed by the CeCILL-C licence
!SFX_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt  
!SFX_LIC for details. version 1.
!     #########
      SUBROUTINE init_output_nc_n (BDD, CHE, CHN, CHU, DTS, DTT, DTZ, IM, UG, U, HSELECT)
!     ######################
!
!!****  *INIT_OUTPUT_NC* Keep in memory the netcdf ID of the output files
!!
!!    PURPOSE
!!    -------
!
!!
!!**  IMPLICIT ARGUMENTS
!!    ------------------
!!      None 
!!
!!    REFERENCE
!!    ---------
!!
!!    AUTHOR
!!    ------
!!      F. Habets   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      modified 05/04 by P. LeMoigne *Meteo France*
!!      modified 06/10 by S. Faroux *Meteo France*
!!=================================================================
!
!*       0.   DECLARATIONS
!             ------------
!
USE modd_diag_n, ONLY : diag_t
USE modd_bld_description_n, ONLY : bld_desc_t
USE modd_ch_emis_field_n, ONLY : ch_emis_field_t
USE modd_ch_snap_n, ONLY : ch_emis_snap_t
USE modd_ch_surf_n, ONLY : ch_surf_t
USE modd_data_seaflux_n, ONLY : data_seaflux_t
USE modd_data_teb_n, ONLY : data_teb_t
USE modd_data_tsz0_n, ONLY : data_tsz0_t
USE modd_surfex_n, ONLY : isba_model_t
USE modd_surf_atm_grid_n, ONLY : surf_atm_grid_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
USE modd_write_surf_atm, ONLY : lsplit_patch
!
USE modd_surf_conf,      ONLY : csoftware
!
USE modd_surfex_mpi, ONLY : npio, nrank
!
USE modd_data_cover, ONLY : ldata_irrig
USE modd_data_cover_par, ONLY : nvegtype, jpcover
!
USE modd_io_surf_nc, ONLY : cfileout_nc, nid_nc, lcreated, cfileout_nc_save, ldef
!
USE modn_io_offline, ONLY : lrestart, lwrite_coord
!
USE mode_gridtype_gauss
!
USE modi_get_bld_conf_n
USE modi_get_data_seaflux_conf_n
USE modi_get_isba_conf_n
USE modi_ol_define_dim
USE modi_create_file
!
USE modi_get_dim_full_n
USE modi_def_var_netcdf
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE netcdf
!
IMPLICIT NONE
!
!
!
TYPE(bld_desc_t), INTENT(INOUT) :: BDD
TYPE(ch_emis_field_t), INTENT(INOUT) :: CHE
TYPE(ch_emis_snap_t), INTENT(INOUT) :: CHN
TYPE(ch_surf_t), INTENT(INOUT) :: CHU
TYPE(data_seaflux_t), INTENT(INOUT) :: DTS
TYPE(data_teb_t), INTENT(INOUT) :: DTT
TYPE(data_tsz0_t), INTENT(INOUT) :: DTZ
TYPE(isba_model_t), INTENT(INOUT) :: IM
TYPE(surf_atm_grid_t), INTENT(INOUT) :: UG
TYPE(surf_atm_t), INTENT(INOUT) :: U
!
 CHARACTER(LEN=*), DIMENSION(:), INTENT(IN) :: HSELECT
!
 CHARACTER(LEN=100), DIMENSION(:), POINTER :: YNAME_DIM
 CHARACTER(LEN=100), DIMENSION(1) :: YATT_TITLE, YATT
 CHARACTER(LEN=13),DIMENSION(1)  :: YUNIT1, YUNIT2
 CHARACTER(LEN=3)                 :: YISBA 
!
REAL,DIMENSION(:), POINTER       :: ZX, ZY
!
INTEGER, DIMENSION(:), POINTER   :: IDIMS, IDDIM
INTEGER           :: IDIM1, INDIMS
INTEGER          :: INI, INPATCH, INLVLD, INLVLS, INBIOMASS, &
                    INLITTER, INLITTLEVS, INSOILCARB
INTEGER          :: IDESC_ROOF_LAYER, IDESC_ROAD_LAYER, IDESC_WALL_LAYER, &
                    IDESC_FLOOR_LAYER, IDESC_CODE, IDESC_USE, IDESC_AGE, IDESC_BLD
INTEGER          :: IRET, IL, IFULL, ISNAP, INLATI, ISNOW_LAYER
INTEGER          :: ILUOUT, IDIMID, ITIME, ITOT
INTEGER          :: ID0
!
LOGICAL          :: GEXIST, GOPENED, GSST_DATA
LOGICAL          :: GDATA_BLDTYPE, GDATA_BLD_AGE, GDATA_USETYPE
!
REAL(KIND=JPRB)  :: ZHOOK_HANDLE
!------------------------------------------------------------------------------ 
IF (lhook) CALL dr_hook('INIT_OUTPUT_NC_N',0,zhook_handle)
!
 CALL get_dim_full_n(u%NDIM_FULL, ifull)

IF (nrank==npio) THEN
  INQUIRE(file=cfileout_nc,exist=gexist)
  INQUIRE(file=cfileout_nc,opened=gopened)
  IF (.NOT.gopened) THEN
    iret = nf90_open(cfileout_nc,nf90_write,nid_nc)
  ENDIF
  IF (.NOT.gexist .OR. .NOT.lcreated .OR. cfileout_nc/=cfileout_nc_save) THEN
    IF (csoftware=='PREP' .OR. csoftware=='OFFLINE' .OR. csoftware=='SODA') THEN
      CALL get_isba_conf_n(im%O, im%NPE%AL(1)%TSNOW%NLAYER, &
                           yisba, inpatch, inlvld, inlvls, inbiomass, &
                           inlitter, inlittlevs, insoilcarb)
    ENDIF
    IF (ug%G%CGRID=='IGN') lwrite_coord = .true.
    IF (csoftware=='PGD') THEN
      IF (lsplit_patch) THEN
        CALL ol_define_dim(ug, u%NSIZE_FULL, 'NOTIME ', iluout, ifull, idim1, yunit1, yunit2, &
                           zx, zy, idims, iddim, yname_dim)       
      ELSE 
        CALL ol_define_dim(ug, u%NSIZE_FULL, 'NOTIME ', iluout, ifull, idim1, yunit1, yunit2, &
                           zx, zy, idims, iddim, yname_dim, inpatch) 
      ENDIF        
    ELSE
      IF (lsplit_patch) THEN
        CALL ol_define_dim(ug, u%NSIZE_FULL, 'NOTIME ', iluout, ifull, idim1, yunit1, yunit2, &
                           zx, zy, idims, iddim, yname_dim)
      ELSE
        CALL ol_define_dim(ug, u%NSIZE_FULL, 'NOTIME ', iluout, ifull, idim1, yunit1, yunit2, &
                           zx, zy, idims, iddim, yname_dim, inpatch)
      ENDIF
    ENDIF
    CALL create_file(cfileout_nc,idims,yname_dim,nid_nc,iddim) 
    !IF (UG%G%CGRID=='IGN') THEN
      !YATT_TITLE(1) = "comment"
      !YATT(1) = "longitude"
      !CALL DEF_VAR_NETCDF(HSELECT,NID_NC,'XLON','XLON',IDDIM(1:1),YATT_TITLE,YATT,ID0,NF90_DOUBLE)
      !YATT(1) = "latitude"
      !CALL DEF_VAR_NETCDF(HSELECT,NID_NC,'XLAT','XLAT',IDDIM(1:1),YATT_TITLE,YATT,ID0,NF90_DOUBLE)
    !ENDIF      
    cfileout_nc_save = cfileout_nc
    lcreated = .true.
    IF (csoftware=='PGD') iret = nf90_def_dim(nid_nc,"Nb_of_input_data",nvegtype*im%DTV%NTIME,idimid)
    IF (csoftware=='PGD' .OR. ( csoftware=='OFFLINE' .AND. lrestart ) ) THEN
      iret = nf90_def_dim(nid_nc,"Number_of_covers",jpcover,idimid)
      IF (ldata_irrig) iret = nf90_def_dim(nid_nc,"Irrig_parameters",6,idimid)
      IF (csoftware=='PGD') THEN
        isnow_layer = 0
      ELSE
        isnow_layer = im%NPE%AL(1)%TSNOW%NLAYER
      ENDIF
      CALL get_isba_conf_n(im%O, isnow_layer, &
                           yisba, inpatch, inlvld, inlvls, inbiomass, &
                           inlitter, inlittlevs, insoilcarb)
      IF (yisba=='DIF') iret = nf90_def_dim(nid_nc,"Nground_layers",inlvld,idimid)
      CALL get_data_seaflux_conf_n(dts, gsst_data,itime)
      IF (gsst_data) iret = nf90_def_dim(nid_nc,"Number_of_dates",itime,idimid)
      CALL get_bld_conf_n(bdd, dtt, gdata_bldtype, gdata_bld_age, gdata_usetype, &
                 idesc_roof_layer, idesc_road_layer, idesc_wall_layer, &
                 idesc_floor_layer, idesc_code, idesc_use, idesc_age, idesc_bld)
      IF (gdata_bldtype .OR. gdata_bld_age .OR. gdata_usetype) THEN
        itot = (21+3*idesc_roof_layer+3*idesc_road_layer+3*idesc_wall_layer+3*idesc_floor_layer)&
                *idesc_code + 9*idesc_use+2*idesc_age+idesc_bld
        iret = nf90_def_dim(nid_nc,"Bld_dimensions  ",7,idimid)
        iret = nf90_def_dim(nid_nc,"Bld_parameters  ",itot,idimid)
      ENDIF
      IF (chu%LCH_EMIS) THEN
        IF (chu%CCH_EMIS=='AGGR') THEN
          IF (che%NEMIS_NBR/=0) iret = nf90_def_dim(nid_nc,"Temporal_emiss  ",che%NTIME_MAX,idimid)
        ELSE IF (chu%CCH_EMIS=='SNAP') THEN
          isnap = max(chn%NSNAP_M,chn%NSNAP_D,chn%NSNAP_H)
          IF (isnap/=0 .AND. chn%NEMIS_SNAP/=0) THEN
            iret = nf90_def_dim(nid_nc,"Nemis_snap",chn%NEMIS_SNAP,idimid)
            iret = nf90_def_dim(nid_nc,"Nsnap_temp",isnap,idimid)
          ENDIF
        ENDIF
      ENDIF
      IF (ASSOCIATED(dtz%XDATA_DTS)) THEN
        itime = SIZE(dtz%XDATA_DTS) 
        IF (itime/=0) iret = nf90_def_dim(nid_nc,"Nforc_tsz0",itime,idimid)
      ENDIF
    ENDIF
    IF (ug%G%CGRID=='GAUSS') THEN
      CALL get_gridtype_gauss(ug%G%XGRID_PAR,inlati)
      iret = nf90_def_dim(nid_nc,"Nlati",inlati,idimid)
    ENDIF
  ELSE
    IF (ldef) iret = nf90_redef(nid_nc)
  ENDIF
  IF (ldef) iret = nf90_enddef(nid_nc)
  iret = nf90_close(nid_nc)
ELSE
  IF (ug%G%CGRID=='IGN') lwrite_coord = .true.
ENDIF
!
!------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('INIT_OUTPUT_NC_N',1,zhook_handle)
!------------------------------------------------------------------------------
!
END SUBROUTINE init_output_nc_n