coupling_tsz0n.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 coupling_tsz0_n (DTCO, UG, U, USS, IM, DTZ, NDST, SLT, HPROGRAM, HCOUPLING,   &
                            PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN,&
                            PZENITH, PZENITH2, PAZIM, PZREF, PUREF, PZS, PU, PV,    &
                            PQA, PTA, PRHOA, PSV, PCO2, HSV, PRAIN, PSNOW, PLW,     &
                            PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, PSFTQ, PSFTH,    &
                            PSFTS, PSFCO2, PSFU, PSFV, PTRAD, PDIR_ALB, PSCA_ALB,   &
                            PEMIS, PTSURF, PZ0, PZ0H, PQSURF, PPEW_A_COEF,          &
                            PPEW_B_COEF, PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF,     &
                            PPEQ_B_COEF, HTEST      )  
!     ###############################################################################
!
!!****  *COUPLING_TSZ0_n * - Call of fluxes from vegetation scheme ISBA but 
!!        without temporal evolution of the soil/vegetation.
!!
!!    PURPOSE
!!    -------
!
!!**  METHOD
!!    ------
!!
!!    REFERENCE
!!    ---------
!!      
!!
!!    AUTHOR
!!    ------
!!     V. Masson 
!!
!!    MODIFICATIONS
!!    -------------
!!      Original    01/2004
!!      Modified    09/2012 : J. Escobar , SIZE(PTA) not allowed without-interface , replace by KI
!!      B. Decharme 04/2013 new coupling variables
!!      P. LeMoigne 12/2014 bug in "implicit" coefficients 
!!------------------------------------------------------------------
!
USE modd_isba_n, ONLY : isba_p_t, isba_pe_t
USE modd_surfex_n, ONLY : isba_model_t
!
USE modd_data_cover_n, ONLY : data_cover_t
USE modd_surf_atm_grid_n, ONLY : surf_atm_grid_t
USE modd_surf_atm_n, ONLY : surf_atm_t
USE modd_sso_n, ONLY : sso_t
USE modd_data_tsz0_n, ONLY : data_tsz0_t
USE modd_data_isba_n, ONLY : data_isba_t
USE modd_dst_n, ONLY : dst_np_t
USE modd_slt_n, ONLY : slt_t
!
!
USE modd_surf_par, ONLY : xundef
USE modd_csts,   ONLY : xp00, xrd, xcpd
!
USE modi_tsz0
USE modi_coupling_isba_orography_n
! 
USE yomhook   ,ONLY : lhook,   dr_hook
USE parkind1  ,ONLY : jprb
!
IMPLICIT NONE
!
!*      0.1    declarations of arguments
!
TYPE(isba_model_t), INTENT(INOUT) :: IM
!
TYPE(data_cover_t), INTENT(INOUT) :: DTCO
TYPE(surf_atm_grid_t), INTENT(INOUT) :: UG
TYPE(surf_atm_t), INTENT(INOUT) :: U
TYPE(sso_t), INTENT(INOUT) :: USS
TYPE(data_tsz0_t), INTENT(INOUT) :: DTZ
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=1),    INTENT(IN)  :: HCOUPLING ! type of coupling
                                              ! 'E' : explicit
                                              ! 'I' : implicit
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)
INTEGER,             INTENT(IN)  :: KI        ! number of points
INTEGER,             INTENT(IN)  :: KSV       ! number of scalars
INTEGER,             INTENT(IN)  :: KSW       ! number of short-wave spectral bands
REAL, DIMENSION(KI), INTENT(IN)  :: PTSUN     ! solar time                    (s from midnight)
REAL,                INTENT(IN)  :: PTSTEP    ! atmospheric time-step                 (s)
REAL, DIMENSION(KI), INTENT(IN)  :: PZREF     ! height of T,q forcing                 (m)
REAL, DIMENSION(KI), INTENT(IN)  :: PUREF     ! height of wind forcing                (m)
!
REAL, DIMENSION(KI), INTENT(IN)  :: PTA       ! air temperature forcing               (K)
REAL, DIMENSION(KI), INTENT(IN)  :: PQA       ! air humidity forcing                  (kg/m3)
REAL, DIMENSION(KI), INTENT(IN)  :: PRHOA     ! air density                           (kg/m3)
REAL, DIMENSION(KI,KSV),INTENT(IN) :: PSV     ! scalar variables
!                                             ! chemistry:   first char. in HSV: '#'  (molecule/m3)
!                                             !
 CHARACTER(LEN=6), DIMENSION(KSV),INTENT(IN):: HSV  ! name of all scalar variables
REAL, DIMENSION(KI), INTENT(IN)  :: PU        ! zonal wind                            (m/s)
REAL, DIMENSION(KI), INTENT(IN)  :: PV        ! meridian wind                         (m/s)
REAL, DIMENSION(KI,KSW),INTENT(IN) :: PDIR_SW ! direct  solar radiation (on horizontal surf.)
!                                             !                                       (W/m2)
REAL, DIMENSION(KI,KSW),INTENT(IN) :: PSCA_SW ! diffuse solar radiation (on horizontal surf.)
!                                             !                                       (W/m2)
REAL, DIMENSION(KSW),INTENT(IN)  :: PSW_BANDS ! mean wavelength of each shortwave band (m)
REAL, DIMENSION(KI), INTENT(IN)  :: PZENITH   ! zenithal angle at t      (radian from the vertical)
REAL, DIMENSION(KI), INTENT(IN)  :: PZENITH2  ! zenithal angle at t+1    (radian from the vertical)
REAL, DIMENSION(KI), INTENT(IN)  :: PAZIM     ! azimuthal angle      (radian from North, clockwise)
REAL, DIMENSION(KI), INTENT(IN)  :: PLW       ! longwave radiation (on horizontal surf.)
!                                             !                                       (W/m2)
REAL, DIMENSION(KI), INTENT(IN)  :: PPS       ! pressure at atmospheric model surface (Pa)
REAL, DIMENSION(KI), INTENT(IN)  :: PPA       ! pressure at forcing level             (Pa)
REAL, DIMENSION(KI), INTENT(IN)  :: PZS       ! atmospheric model orography           (m)
REAL, DIMENSION(KI), INTENT(IN)  :: PCO2      ! CO2 concentration in the air          (kg/m3)
REAL, DIMENSION(KI), INTENT(IN)  :: PSNOW     ! snow precipitation                    (kg/m2/s)
REAL, DIMENSION(KI), INTENT(IN)  :: PRAIN     ! liquid precipitation                  (kg/m2/s)
!
!
REAL, DIMENSION(KI), INTENT(OUT) :: PSFTH     ! flux of heat                          (W/m2)
REAL, DIMENSION(KI), INTENT(OUT) :: PSFTQ     ! flux of water vapor                   (kg/m2/s)
REAL, DIMENSION(KI), INTENT(OUT) :: PSFU      ! zonal momentum flux                   (Pa)
REAL, DIMENSION(KI), INTENT(OUT) :: PSFV      ! meridian momentum flux                (Pa)
REAL, DIMENSION(KI), INTENT(OUT) :: PSFCO2    ! flux of CO2                           (m/s*kg_CO2/kg_air)
REAL, DIMENSION(KI,KSV),INTENT(OUT):: PSFTS   ! flux of scalar var.                   (kg/m2/s)
!
REAL, DIMENSION(KI), INTENT(OUT) :: PTRAD     ! radiative temperature                 (K)
REAL, DIMENSION(KI,KSW),INTENT(OUT):: PDIR_ALB! direct albedo for each spectral band  (-)
REAL, DIMENSION(KI,KSW),INTENT(OUT):: PSCA_ALB! diffuse albedo for each spectral band (-)
REAL, DIMENSION(KI), INTENT(OUT) :: PEMIS     ! emissivity                            (-)
!
REAL, DIMENSION(KI), INTENT(OUT) :: PTSURF    ! surface effective temperature         (K)
REAL, DIMENSION(KI), INTENT(OUT) :: PZ0       ! roughness length for momentum         (m)
REAL, DIMENSION(KI), INTENT(OUT) :: PZ0H      ! roughness length for heat             (m)
REAL, DIMENSION(KI), INTENT(OUT) :: PQSURF    ! specific humidity at surface          (kg/kg)
!
REAL, DIMENSION(KI), INTENT(IN) :: PPEW_A_COEF! implicit coefficients
REAL, DIMENSION(KI), INTENT(IN) :: PPEW_B_COEF! needed if HCOUPLING='I'
REAL, DIMENSION(KI), INTENT(IN) :: PPET_A_COEF
REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_A_COEF
REAL, DIMENSION(KI), INTENT(IN) :: PPET_B_COEF
REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_B_COEF
 CHARACTER(LEN=2),    INTENT(IN) :: HTEST ! must be equal to 'OK'
!
!*      0.2    declarations of local variables
!
!
TYPE(isba_p_t), POINTER :: PK
TYPE(isba_pe_t), POINTER :: PEK
!
REAL, DIMENSION(KI,IM%O%NGROUND_LAYER,IM%O%NPATCH) :: ZTG   ! soil temperature
REAL, DIMENSION(KI,IM%O%NGROUND_LAYER,IM%O%NPATCH) :: ZWG   ! soil water content
REAL, DIMENSION(KI,IM%O%NGROUND_LAYER,IM%O%NPATCH) :: ZWGI  ! soil ice content
REAL, DIMENSION(KI,IM%O%NPATCH) :: ZWR   ! interception reservoir
REAL, DIMENSION(KI,IM%O%NPATCH) :: ZRESA ! aerodynamical resistance
REAL, DIMENSION(KI,IM%NPE%AL(1)%TSNOW%NLAYER,IM%O%NPATCH) :: ZWSNOW! snow reservoir
REAL, DIMENSION(KI,IM%NPE%AL(1)%TSNOW%NLAYER,IM%O%NPATCH) :: ZRHOSN! snow density
REAL, DIMENSION(KI,IM%NPE%AL(1)%TSNOW%NLAYER,IM%O%NPATCH) :: ZHEASN! snow heat content
REAL, DIMENSION(KI,IM%O%NPATCH) :: ZALBSN! snow albedo
REAL, DIMENSION(KI,IM%O%NPATCH) :: ZEMISN! snow emissivity
!
REAL, DIMENSION(KI)     :: ZPEW_A_COEF ! implicit coefficients
REAL, DIMENSION(KI)     :: ZPEW_B_COEF ! needed if HCOUPLING='I'
REAL, DIMENSION(KI)     :: ZPET_A_COEF
REAL, DIMENSION(KI)     :: ZPEQ_A_COEF
REAL, DIMENSION(KI)     :: ZPET_B_COEF
REAL, DIMENSION(KI)     :: ZPEQ_B_COEF
INTEGER :: JP
REAL(KIND=JPRB) :: ZHOOK_HANDLE
!-------------------------------------------------------------------------------------
!
IF (lhook) CALL dr_hook('COUPLING_TSZ0_N',0,zhook_handle)
!
!*      1.     Specified evolution of ISBA prognostic variables
!              ------------------------------------------------
!
DO jp = 1,im%O%NPATCH
  CALL tsz0(dtz, ptime, ptstep, im%NK%AL(jp), im%NPE%AL(jp))
ENDDO
!
!
!*      2.     Saves the prognostic variables
!              ------------------------------
!
DO jp = 1,im%O%NPATCH
  pk => im%NP%AL(jp)
  pek => im%NPE%AL(jp)
  !
  ztg(1:pk%NSIZE_P,:,jp) = pek%XTG        (:,:)
  zwg(1:pk%NSIZE_P,:,jp) = pek%XWG        (:,:)
  zwgi(1:pk%NSIZE_P,:,jp) = pek%XWGI       (:,:)
  zwr(1:pk%NSIZE_P,jp)   = pek%XWR        (:)
  zresa(1:pk%NSIZE_P,jp)   = pek%XRESA      (:)
  zwsnow(1:pk%NSIZE_P,:,jp)= pek%TSNOW%WSNOW(:,:)
  zrhosn(1:pk%NSIZE_P,:,jp)= pek%TSNOW%RHO  (:,:)
  zalbsn(1:pk%NSIZE_P,jp)  = pek%TSNOW%ALB  (:)
  IF (pek%TSNOW%SCHEME=='3-L' .OR. pek%TSNOW%SCHEME=='CRO') THEN
    zheasn(1:pk%NSIZE_P,:,jp)= pek%TSNOW%HEAT (:,:)
    zemisn(1:pk%NSIZE_P,jp)  = pek%TSNOW%EMIS (:)
  END IF
ENDDO
!
!
!*      3.     Call to surface scheme
!              ----------------------
!
 CALL coupling_isba_orography_n(dtco, ug, u, uss, im%SB, im%NAG, im%CHI, im%NCHI, im%DTV, im%ID, &
                                im%NGB, im%GB, im%ISS, im%NISS, im%G, im%NG, im%O, im%S, im%K, im%NK, &
                                im%NP, im%NPE, ndst, slt, hprogram, 'E', 0.001, kyear,   &
                                kmonth, kday, ptime,  ki, ksv, ksw, ptsun, pzenith,       &
                                pzenith2, pazim, pzref, puref, pzs, pu, pv, pqa, pta,     &
                                prhoa, psv, pco2, hsv, prain, psnow, plw, pdir_sw,        &
                                psca_sw, psw_bands, pps, ppa, psftq, psfth, psfts, psfco2,&
                                psfu, psfv, ptrad, pdir_alb, psca_alb, pemis, ptsurf, pz0,&
                                pz0h, pqsurf, ppew_a_coef, ppew_b_coef, ppet_a_coef,      &
                                ppeq_a_coef, ppet_b_coef, ppeq_b_coef, 'OK'  )  
!
!
!*      4.     Removes temporal evolution of ISBA variables
!              --------------------------------------------
!
!
DO jp = 1,im%O%NPATCH
  pk => im%NP%AL(jp)
  pek => im%NPE%AL(jp)
  !
  pek%XTG        (:,:) = ztg(1:pk%NSIZE_P,:,jp)
  pek%XWG        (:,:) = zwg(1:pk%NSIZE_P,:,jp)
  pek%XWGI       (:,:) = zwgi(1:pk%NSIZE_P,:,jp)
  pek%XWR        (:)   = zwr(1:pk%NSIZE_P,jp)  
  pek%XRESA      (:)   = zresa(1:pk%NSIZE_P,jp) 
  pek%TSNOW%WSNOW(:,:) = zwsnow(1:pk%NSIZE_P,:,jp)
  pek%TSNOW%RHO  (:,:) = zrhosn(1:pk%NSIZE_P,:,jp)
  pek%TSNOW%ALB  (:)   = zalbsn(1:pk%NSIZE_P,jp)
  IF (pek%TSNOW%SCHEME=='3-L' .OR. pek%TSNOW%SCHEME=='CRO') THEN
    pek%TSNOW%HEAT (:,:) = zheasn(1:pk%NSIZE_P,:,jp)
    pek%TSNOW%EMIS (:)   = zemisn(1:pk%NSIZE_P,jp) 
  END IF
ENDDO
!
IF (lhook) CALL dr_hook('COUPLING_TSZ0_N',1,zhook_handle)
!
!-------------------------------------------------------------------------------------
!
END SUBROUTINE coupling_tsz0_n