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, I, UG, U, DGU)
!     ######################
!
!!****  *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_surf_atm_n, ONLY : diag_surf_atm_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_isba_n, ONLY : isba_t
USE modd_surf_atm_grid_n, ONLY : surf_atm_grid_t
USE modd_surf_atm_n, ONLY : surf_atm_t
!
USE modd_surf_conf,      ONLY : csoftware
!
USE modd_surfex_mpi, ONLY : npio, nrank
!
USE modd_ol_fileid, ONLY : xvar_to_fileout, xid, xout
!
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
!
IMPLICIT NONE
!
include "netcdf.inc"
!
!
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_t), INTENT(INOUT) :: i
TYPE(surf_atm_grid_t), INTENT(INOUT) :: ug
TYPE(surf_atm_t), INTENT(INOUT) :: u
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
!
 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
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, &
                    ifull)

IF (nrank==npio) THEN
  INQUIRE(file=cfileout_nc,exist=gexist)
  INQUIRE(file=cfileout_nc,opened=gopened)
  IF (.NOT.gopened) THEN
    iret = nf_open(cfileout_nc,nf_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(i, &
                           yisba, inpatch, inlvld, inlvls, inbiomass, &
                           inlitter, inlittlevs, insoilcarb)
    ELSEIF (csoftware=='PGD') THEN
      inpatch = nvegtype
    ENDIF
    IF (ug%CGRID=='IGN') lwrite_coord = .true.
    CALL ol_define_dim(ug, u, &
                         'NOTIME ', iluout, ifull, idim1, yunit1, yunit2, &
                     zx, zy, idims, iddim, yname_dim, knpatch=inpatch)
    IF (ALLOCATED(xvar_to_fileout)) DEALLOCATE(xvar_to_fileout)
    IF (ALLOCATED(xid)) DEALLOCATE(xid)
    ALLOCATE(xid(0))
    xout=0
    CALL create_file(cfileout_nc,idims,yname_dim,nid_nc,iddim) 
    IF (ug%CGRID=='IGN') THEN
      yatt_title(1) = "comment"
      yatt(1) = "longitude"
      CALL def_var_netcdf(dgu,nid_nc,'XLON','XLON',iddim(1:1),yatt_title,yatt,id0,nf_double)
      yatt(1) = "latitude"
      CALL def_var_netcdf(dgu,nid_nc,'XLAT','XLAT',iddim(1:1),yatt_title,yatt,id0,nf_double)
    ENDIF      
    cfileout_nc_save = cfileout_nc
    lcreated = .true.
    IF (csoftware=='PGD' .OR. ( csoftware=='OFFLINE' .AND. lrestart ) ) THEN
      iret = nf_def_dim(nid_nc,"Number_of_covers",jpcover,idimid)
      IF (ldata_irrig) iret = nf_def_dim(nid_nc,"Irrig_parameters",6,idimid)
      CALL get_isba_conf_n(i, &
                           yisba, inpatch, inlvld, inlvls, inbiomass, &
                           inlitter, inlittlevs, insoilcarb)
      IF (yisba=='DIF') iret = nf_def_dim(nid_nc,"Nground_layers",inlvld,idimid)
      CALL get_data_seaflux_conf_n(dts, &
                                   gsst_data,itime)
      IF (gsst_data) iret = nf_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 = nf_def_dim(nid_nc,"Bld_dimensions  ",7,idimid)
        iret = nf_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 = nf_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 = nf_def_dim(nid_nc,"Nemis_snap",chn%NEMIS_SNAP,idimid)
            iret = nf_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 = nf_def_dim(nid_nc,"Nforc_tsz0",itime,idimid)
      ENDIF
    ENDIF
    IF (ug%CGRID=='GAUSS') THEN
      CALL get_gridtype_gauss(ug%XGRID_PAR,inlati)
      iret = nf_def_dim(nid_nc,"Nlati",inlati,idimid)
    ENDIF
  ELSE
    IF (ldef) iret = nf_redef(nid_nc)
  ENDIF
  IF (ldef) iret = nf_enddef(nid_nc)
  iret = nf_close(nid_nc)
ENDIF
!
!------------------------------------------------------------------------------
IF (lhook) CALL dr_hook('INIT_OUTPUT_NC_N',1,zhook_handle)
!------------------------------------------------------------------------------
!
END SUBROUTINE init_output_nc_n