init_townn.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_town_n (DTCO, DGU, UG, U, CHI, DTI, I, &
                              tm, gdm, grm, dgl, dst, slt, &                        
                                  hprogram,hinit,                            &
                                   ki,ksv,ksw,                                &
                                   hsv,pco2,prhoa,                            &
                                   pzenith,pazim,psw_bands,pdir_alb,psca_alb, &
                                   pemis,ptsrad,ptsurf,                       &
                                   kyear, kmonth,kday, ptime,                 &
                                   hatmfile,hatmfiletype,                     &
                                   htest                                      )  
!     #############################################################
!
!!****  *INIT_TOWN_n* - chooses initialization routine for towns
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!      V. Masson   *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    27/09/96 
!!       V.Masson   18/08/97 call to fmread directly with dates and strings
!!       V.Masson   15/03/99 new PGD treatment with COVER types
!        F.Solmon  06/00   adaptation for patch approach
!!       B.Decharme 04/2013 new coupling variables
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
!
USE modd_data_cover_n, ONLY : data_cover_t
USE modd_diag_surf_atm_n, ONLY : diag_surf_atm_t
USE modd_surf_atm_grid_n, ONLY : surf_atm_grid_t
USE modd_surf_atm_n, ONLY : surf_atm_t
USE modd_ch_isba_n, ONLY : ch_isba_t
USE modd_data_isba_n, ONLY : data_isba_t
USE modd_isba_n, ONLY : isba_t
USE modd_surfex_n, ONLY : teb_model_t
USE modd_surfex_n, ONLY : teb_garden_model_t
USE modd_surfex_n, ONLY : teb_greenroof_model_t
USE modd_diag_ideal_n, ONLY : diag_ideal_t
USE modd_dst_n, ONLY : dst_t
USE modd_slt_n, ONLY : slt_t
!
USE modd_csts,       ONLY : xtt
!
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modi_init_ideal_flux
!
USE modi_init_teb_n
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
!
TYPE(data_cover_t), INTENT(INOUT) :: dtco
TYPE(diag_surf_atm_t), INTENT(INOUT) :: dgu
TYPE(surf_atm_grid_t), INTENT(INOUT) :: ug
TYPE(surf_atm_t), INTENT(INOUT) :: u
TYPE(ch_isba_t), INTENT(INOUT) :: chi
TYPE(data_isba_t), INTENT(INOUT) :: dti
TYPE(isba_t), INTENT(INOUT) :: i
TYPE(teb_model_t), INTENT(INOUT) :: tm
TYPE(teb_garden_model_t), INTENT(INOUT) :: gdm
TYPE(teb_greenroof_model_t), INTENT(INOUT) :: grm
TYPE(diag_ideal_t), INTENT(INOUT) :: dgl
TYPE(dst_t), INTENT(INOUT) :: dst
TYPE(slt_t), INTENT(INOUT) :: slt
!
!
 CHARACTER(LEN=6),                 INTENT(IN)  :: hprogram  ! program calling surf. schemes
 CHARACTER(LEN=3),                 INTENT(IN)  :: hinit     ! choice of fields to initialize
INTEGER,                          INTENT(IN)  :: ki        ! number of points
INTEGER,                          INTENT(IN)  :: ksv       ! number of scalars
INTEGER,                          INTENT(IN)  :: ksw       ! number of short-wave spectral bands
 CHARACTER(LEN=6), DIMENSION(KSV), INTENT(IN)  :: hsv       ! name of all scalar variables
REAL,             DIMENSION(KI),  INTENT(IN)  :: pco2      ! CO2 concentration (kg/m3)
REAL,             DIMENSION(KI),  INTENT(IN)  :: prhoa     ! air density
REAL,             DIMENSION(KI),  INTENT(IN)  :: pzenith   ! solar zenithal angle
REAL,             DIMENSION(KI),  INTENT(IN)  :: pazim     ! solar azimuthal angle (rad from N, clock)
REAL,             DIMENSION(KSW), INTENT(IN)  :: psw_bands ! middle wavelength of each band
REAL,             DIMENSION(KI,KSW),INTENT(OUT) :: pdir_alb  ! direct albedo for each band
REAL,             DIMENSION(KI,KSW),INTENT(OUT) :: psca_alb  ! diffuse albedo for each band
REAL,             DIMENSION(KI),  INTENT(OUT) :: pemis     ! emissivity
REAL,             DIMENSION(KI),  INTENT(OUT) :: ptsrad    ! radiative temperature
REAL,             DIMENSION(KI),  INTENT(OUT) :: ptsurf    ! surface effective temperature         (K)
INTEGER,                          INTENT(IN)  :: kyear     ! current year (UTC)
INTEGER,                          INTENT(IN)  :: kmonth    ! current month (UTC)
INTEGER,                          INTENT(IN)  :: kday      ! current day (UTC)
REAL,                             INTENT(IN)  :: ptime     ! current time since
                                                          !  midnight (UTC, s)
!
 CHARACTER(LEN=28),                INTENT(IN)  :: hatmfile    ! atmospheric file name
 CHARACTER(LEN=6),                 INTENT(IN)  :: hatmfiletype! atmospheric file type
 CHARACTER(LEN=2),                 INTENT(IN)  :: htest       ! must be equal to 'OK'
REAL(KIND=JPRB) :: zhook_handle
!
!
!
!*       0.2   Declarations of local variables
!              -------------------------------
!
!-------------------------------------------------------------------------------
!
!*       2.     Selection of surface scheme
!               ---------------------------
!
IF (lhook) CALL dr_hook('INIT_TOWN_N',0,zhook_handle)
IF (u%CTOWN=='NONE  ') THEN
  pdir_alb=0.
  psca_alb=0.
  pemis   =1.
  ptsrad  =xtt
  ptsurf  =xtt
ELSE IF (u%CTOWN=='FLUX  ') THEN
  CALL init_ideal_flux(dgl, dgu%LREAD_BUDGETC, &
                       hprogram,hinit,ki,ksv,ksw,hsv,pco2,prhoa,     &
                           pzenith,pazim,psw_bands,pdir_alb,psca_alb,  &
                           pemis,ptsrad,ptsurf,'OK'                    )  
ELSE IF (u%CTOWN=='TEB   ') THEN
  CALL init_teb_n(dtco, dgu, ug, u, chi, dti, i, &
                  tm, gdm, grm, dst, slt, &
                  hprogram,hinit,                               &
                    ki,ksv,ksw,hsv,pco2,prhoa,                    &
                    pzenith,pazim,psw_bands,pdir_alb,psca_alb,    &
                    pemis,ptsrad,ptsurf,                          &
                    kyear,kmonth,kday,ptime,hatmfile,hatmfiletype,&
                    'OK'                                          )  
END IF
IF (lhook) CALL dr_hook('INIT_TOWN_N',1,zhook_handle)
!
!-------------------------------------------------------------------------------
END SUBROUTINE init_town_n