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 (DTCO, OREAD_BUDGETC, U, UG, IM, SV, SLT, NDST, &
                               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_data_cover_n, ONLY : data_cover_t
USE modd_surf_atm_n, ONLY : surf_atm_t
USE modd_surf_atm_grid_n, ONLY : surf_atm_grid_t
USE modd_surfex_n, ONLY : isba_model_t
USE modd_dst_n, ONLY : dst_np_t
USE modd_slt_n, ONLY : slt_t
USE modd_sv_n, ONLY : sv_t
!
USE modd_surfex_mpi, ONLY : nrank, npio, ncomm
!
USE yomhook   ,   ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
USE modd_data_cover_par, ONLY : nvegtype
!
USE modi_pack_same_rank
USE modi_init_io_surf_n
USE modi_end_io_surf_n
!
USE modi_get_type_dim_n
USE modi_read_surf
USE modi_make_choice_array
!
USE modi_set_vegtypes_fractions
USE modi_compute_isba_parameters
USE modi_abor1_sfx
!
IMPLICIT NONE
!
#ifdef SFX_MPI
include "mpif.h"
#endif
!
!*       0.1   Declarations of arguments
!              -------------------------
!
TYPE(data_cover_t) :: DTCO
LOGICAL, INTENT(IN) :: OREAD_BUDGETC
TYPE(surf_atm_t) :: U
TYPE(surf_atm_grid_t) :: UG
TYPE(isba_model_t) :: IM
TYPE(sv_t), INTENT(INOUT) :: SV
TYPE(dst_np_t), INTENT(INOUT) :: NDST
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
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
!              -------------------------------
INTEGER           :: JLAYER, INFOMPI
INTEGER           :: ILU, JP         ! 1D physical dimension
INTEGER           :: IRESP          ! Error code after redding
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 (im%O%CISBA=='DIF') THEN
   CALL abor1_sfx('INIT_SURF_LANDUSEN: LAND USE NOT IMPLEMENTED WITH DIF')
ENDIF
!
!-------------------------------------------------------------------------------
!
#ifdef SFX_MPI
 CALL mpi_bcast(ug%NGRID_FULL_PAR,kind(ug%NGRID_FULL_PAR)/4,mpi_integer,npio,ncomm,infompi)
#endif
IF (nrank/=npio) ALLOCATE(ug%XGRID_FULL_PAR(ug%NGRID_FULL_PAR))
#ifdef SFX_MPI
 CALL mpi_bcast(ug%XGRID_FULL_PAR,&
                SIZE(ug%XGRID_FULL_PAR)*kind(ug%XGRID_FULL_PAR)/4,mpi_real,npio,ncomm,infompi)
#endif
!   
!* initialization for I/O
!
 CALL init_io_surf_n(dtco, u, hprogram,'NATURE','ISBA  ','READ ')
!
!* 1D physical dimension
!
 CALL get_type_dim_n(dtco, u, 'NATURE',ilu)
!
!* End of IO
!
 CALL end_io_surf_n(hprogram)
!
im%DTV%LDATA_MIXPAR = .true.
IF (.NOT.ASSOCIATED(im%DTV%XPAR_VEGTYPE)) ALLOCATE(im%DTV%XPAR_VEGTYPE(ilu,nvegtype))
IF (im%DTV%NTIME==0) im%DTV%NTIME = 36
IF (.NOT.ASSOCIATED(im%DTV%XPAR_LAI)) ALLOCATE(im%DTV%XPAR_LAI(ilu,im%DTV%NTIME,nvegtype))
IF (.NOT.ASSOCIATED(im%DTV%XPAR_H_TREE)) ALLOCATE(im%DTV%XPAR_H_TREE(ilu,nvegtype))
IF (.NOT.ASSOCIATED(im%DTV%XPAR_ROOT_DEPTH)) ALLOCATE(im%DTV%XPAR_ROOT_DEPTH(ilu,nvegtype))
IF (.NOT.ASSOCIATED(im%DTV%XPAR_GROUND_DEPTH)) ALLOCATE(im%DTV%XPAR_GROUND_DEPTH(ilu,nvegtype))
IF (.NOT.ASSOCIATED(im%DTV%XPAR_IRRIG)) ALLOCATE(im%DTV%XPAR_IRRIG(ilu,im%DTV%NTIME,nvegtype))
IF (.NOT.ASSOCIATED(im%DTV%XPAR_WATSUP)) ALLOCATE(im%DTV%XPAR_WATSUP(ilu,im%DTV%NTIME,nvegtype))
!
!
!-------------------------------------------------------------------------------
!
!* read new fraction of each vege type
! and then extrapolate parameters defined by cover
!       
 CALL set_vegtypes_fractions(dtco, im%DTV, im%G%NDIM, im%O, im%S, ug, u, hprogram)
!
!* re-initialize ISBA with new parameters
!       
 CALL compute_isba_parameters(dtco, oread_budgetc, ug, u, &
                              im%O, im%DTV, im%SB, im%S, im%G, im%K, im%NK,  &
                              im%NG, im%NP, im%NPE, im%NAG, im%NISS, im%ISS, &
                              im%NCHI, im%CHI, im%ID, im%GB, im%NGB,         &
                              ndst, slt, 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