init_surf_landusen.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_surf_landuse_n (YSC, &
                                hprogram,hinit,oland_use,                  &
                               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_SURF_LANDUSE_n* - routine to initialize LAND USE 
!!
!!    PURPOSE
!!    -------
!!
!!**  METHOD
!!    ------
!!
!!    EXTERNAL
!!    --------
!!
!!
!!    IMPLICIT ARGUMENTS
!!    ------------------
!!
!!    REFERENCE
!!    ---------
!!
!!
!!    AUTHOR
!!    ------
!!    S. Faroux    *Meteo France*
!!
!!    MODIFICATIONS
!!    -------------
!!
!!      modified    06-13  B. Decharme  : New coupling variable
!-------------------------------------------------------------------------------
!
!*       0.    DECLARATIONS
!              ------------
!
!
USE modd_surfex_n, ONLY : surfex_t
!
USE yomhook   ,   ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modd_data_cover_par, ONLY : nvegtype
!
!
USE modi_init_io_surf_n
USE modi_end_io_surf_n
!
USE modi_get_type_dim_n
USE modi_read_surf
!
USE modi_set_vegtypes_fractions
USE modi_compute_isba_parameters
USE modi_abor1_sfx
!
IMPLICIT NONE
!
!*       0.1   Declarations of arguments
!              -------------------------
!
TYPE(surfex_t), INTENT(INOUT) :: ysc
!
 CHARACTER(LEN=6),                 INTENT(IN)  :: hprogram  ! program calling surf. schemes
 CHARACTER(LEN=3),                 INTENT(IN)  :: hinit     ! choice of fields to initialize
LOGICAL,                          INTENT(IN)  :: oland_use ! choice of doing land use or not 
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'
!
!
!*       0.2   Declarations of local variables
!              -------------------------------
REAL, DIMENSION(:,:),ALLOCATABLE  :: zwork      ! 2D array to write data in file
INTEGER           :: jlayer
INTEGER           :: ilu          ! 1D physical dimension
INTEGER           :: iresp          ! Error code after redding
 CHARACTER(LEN=12) :: yrecfm         ! Name of the article to be read
 CHARACTER(LEN=4)  :: ylvl
REAL(KIND=JPRB) :: zhook_handle
!
!-------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('INIT_SURF_LANDUSE_N',0,zhook_handle)
!
IF (htest/='OK') THEN
   CALL abor1_sfx('INIT_SURF_LANDUSEN: FATAL ERROR DURING ARGUMENT TRANSFER')
END IF
!
IF (.NOT. oland_use)THEN
   IF (lhook) CALL dr_hook('INIT_SURF_LANDUSE_N',1,zhook_handle)
   RETURN
ENDIF
!
IF (ysc%IM%I%CISBA=='DIF') THEN
   CALL abor1_sfx('INIT_SURF_LANDUSEN: LAND USE NOT IMPLEMENTED WITH DIF')
ENDIF
!
!-------------------------------------------------------------------------------
!
!* initialization for I/O
!
 CALL init_io_surf_n(ysc%DTCO, ysc%DGU, ysc%U, &
                        hprogram,'NATURE','ISBA  ','READ ')
!
!* 1D physical dimension
!
 CALL get_type_dim_n(ysc%DTCO, ysc%U, &
                     'NATURE',ilu)
ALLOCATE(zwork(ilu,ysc%IM%I%NPATCH))
!
ysc%IM%DTI%LDATA_MIXPAR = .true.
IF (.NOT.ASSOCIATED(ysc%IM%DTI%XPAR_VEGTYPE)) ALLOCATE(ysc%IM%DTI%XPAR_VEGTYPE(ilu,nvegtype))
IF (ysc%IM%DTI%NTIME==0) ysc%IM%DTI%NTIME = 36
IF (.NOT.ASSOCIATED(ysc%IM%DTI%XPAR_LAI)) ALLOCATE(ysc%IM%DTI%XPAR_LAI(ilu,ysc%IM%DTI%NTIME,nvegtype))
IF (.NOT.ASSOCIATED(ysc%IM%DTI%XPAR_H_TREE)) ALLOCATE(ysc%IM%DTI%XPAR_H_TREE(ilu,nvegtype))
IF (.NOT.ASSOCIATED(ysc%IM%DTI%XPAR_ROOT_DEPTH)) ALLOCATE(ysc%IM%DTI%XPAR_ROOT_DEPTH(ilu,nvegtype))
IF (.NOT.ASSOCIATED(ysc%IM%DTI%XPAR_ROOT_DEPTHGV)) ALLOCATE(ysc%IM%DTI%XPAR_ROOT_DEPTHGV(ilu,nvegtype))
IF (.NOT.ASSOCIATED(ysc%IM%DTI%XPAR_GROUND_DEPTH)) ALLOCATE(ysc%IM%DTI%XPAR_GROUND_DEPTH(ilu,nvegtype))
IF (.NOT.ASSOCIATED(ysc%IM%DTI%XPAR_IRRIG)) ALLOCATE(ysc%IM%DTI%XPAR_IRRIG(ilu,ysc%IM%DTI%NTIME,nvegtype))
IF (.NOT.ASSOCIATED(ysc%IM%DTI%XPAR_WATSUP)) ALLOCATE(ysc%IM%DTI%XPAR_WATSUP(ilu,ysc%IM%DTI%NTIME,nvegtype))
!
!* read old patch fraction
!       
ALLOCATE(ysc%IM%I%XPATCH_OLD(ilu,ysc%IM%I%NPATCH))       
yrecfm = 'PATCH'
 CALL read_surf(&
                hprogram,yrecfm,ysc%IM%I%XPATCH_OLD(:,:),iresp)
!
!* read old soil layer thicknesses (m)
!
ALLOCATE(ysc%IM%I%XDG_OLD(ilu,ysc%IM%I%NGROUND_LAYER,ysc%IM%I%NPATCH))
!
DO jlayer=1,ysc%IM%I%NGROUND_LAYER
  WRITE(ylvl,'(I4)') jlayer
  yrecfm='OLD_DG'//adjustl(ylvl(:len_trim(ylvl)))
  CALL read_surf(&
                hprogram,yrecfm,zwork(:,:),iresp)
  ysc%IM%I%XDG_OLD(:,jlayer,:)=zwork
END DO
DEALLOCATE(zwork)
!
!* End of IO
!
 CALL end_io_surf_n(hprogram)
!
!-------------------------------------------------------------------------------
!
!* read new fraction of each vege type
! and then extrapolate parameters defined by cover
!       
 CALL set_vegtypes_fractions(ysc%DTCO, ysc%DGU, ysc%IM%DTI, ysc%IM%IG, ysc%IM%I, ysc%UG, ysc%U, &
                             hprogram)
!
!* re-initialize ISBA with new parameters
!       
 CALL compute_isba_parameters(ysc%DTCO, ysc%DGU, ysc%UG, ysc%U, ysc%IM, &
                             ysc%DST, ysc%SLT,  ysc%SV, &
                              hprogram,hinit,oland_use,                  &
                             ilu,ksv,ksw,                                &
                             hsv,pco2,prhoa,                            &
                             pzenith,psw_bands,pdir_alb,psca_alb,       &
                             pemis,ptsrad,ptsurf,                       &
                             htest                                      )
!-------------------------------------------------------------------------------
!                       
IF (lhook) CALL dr_hook('INIT_SURF_LANDUSE_N',1,zhook_handle)
!
END SUBROUTINE init_surf_landuse_n