SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/SURFEX/coupling

Go to the documentation of this file.
00001 !     ###############################################################################
00002 SUBROUTINE COUPLING_TSZ0_n(HPROGRAM, HCOUPLING,                                              &
00003                  PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PZENITH2, &
00004                  PAZIM, PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV,          &
00005                  PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA,                   &
00006                  PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV,                                    &
00007                  PTRAD, PDIR_ALB, PSCA_ALB, PEMIS,                                           &
00008                  PPEW_A_COEF, PPEW_B_COEF,                                                   &
00009                  PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF,                         &
00010                  HTEST                                                                       )  
00011 !     ###############################################################################
00012 !
00013 !!****  *COUPLING_TSZ0_n * - Call of fluxes from vegetation scheme ISBA but 
00014 !!        without temporal evolution of the soil/vegetation.
00015 !!
00016 !!    PURPOSE
00017 !!    -------
00018 !
00019 !!**  METHOD
00020 !!    ------
00021 !!
00022 !!    REFERENCE
00023 !!    ---------
00024 !!      
00025 !!
00026 !!    AUTHOR
00027 !!    ------
00028 !!     V. Masson 
00029 !!
00030 !!    MODIFICATIONS
00031 !!    -------------
00032 !!      Original    01/2004
00033 !!      Modified    09/2012 : J. Escobar , SIZE(PTA) not allowed without-interface , replace by KI
00034 !!------------------------------------------------------------------
00035 !
00036 !
00037 USE MODD_SURF_PAR, ONLY : XUNDEF
00038 USE MODD_CSTS,   ONLY : XP00, XRD, XCPD
00039 USE MODD_ISBA_n, ONLY : XTG, XWG, XWGI, XWR, XRESA, TSNOW, NPATCH, NGROUND_LAYER, XWFC
00040 !
00041 USE MODI_TSZ0
00042 USE MODI_COUPLING_ISBA_OROGRAPHY_n
00043 ! 
00044 USE YOMHOOK   ,ONLY : LHOOK,   DR_HOOK
00045 USE PARKIND1  ,ONLY : JPRB
00046 !
00047 IMPLICIT NONE
00048 !
00049 !*      0.1    declarations of arguments
00050 !
00051  CHARACTER(LEN=6),    INTENT(IN)  :: HPROGRAM  ! program calling surf. schemes
00052  CHARACTER(LEN=1),    INTENT(IN)  :: HCOUPLING ! type of coupling
00053                                               ! 'E' : explicit
00054                                               ! 'I' : implicit
00055 INTEGER,             INTENT(IN)  :: KYEAR     ! current year (UTC)
00056 INTEGER,             INTENT(IN)  :: KMONTH    ! current month (UTC)
00057 INTEGER,             INTENT(IN)  :: KDAY      ! current day (UTC)
00058 REAL,                INTENT(IN)  :: PTIME     ! current time since midnight (UTC, s)
00059 INTEGER,             INTENT(IN)  :: KI        ! number of points
00060 INTEGER,             INTENT(IN)  :: KSV       ! number of scalars
00061 INTEGER,             INTENT(IN)  :: KSW       ! number of short-wave spectral bands
00062 REAL, DIMENSION(KI), INTENT(IN)  :: PTSUN     ! solar time                    (s from midnight)
00063 REAL,                INTENT(IN)  :: PTSTEP    ! atmospheric time-step                 (s)
00064 REAL, DIMENSION(KI), INTENT(IN)  :: PZREF     ! height of T,q forcing                 (m)
00065 REAL, DIMENSION(KI), INTENT(IN)  :: PUREF     ! height of wind forcing                (m)
00066 !
00067 REAL, DIMENSION(KI), INTENT(IN)  :: PTA       ! air temperature forcing               (K)
00068 REAL, DIMENSION(KI), INTENT(IN)  :: PQA       ! air humidity forcing                  (kg/m3)
00069 REAL, DIMENSION(KI), INTENT(IN)  :: PRHOA     ! air density                           (kg/m3)
00070 REAL, DIMENSION(KI,KSV),INTENT(IN) :: PSV     ! scalar variables
00071 !                                             ! chemistry:   first char. in HSV: '#'  (molecule/m3)
00072 !                                             !
00073  CHARACTER(LEN=6), DIMENSION(KSV),INTENT(IN):: HSV  ! name of all scalar variables
00074 REAL, DIMENSION(KI), INTENT(IN)  :: PU        ! zonal wind                            (m/s)
00075 REAL, DIMENSION(KI), INTENT(IN)  :: PV        ! meridian wind                         (m/s)
00076 REAL, DIMENSION(KI,KSW),INTENT(IN) :: PDIR_SW ! direct  solar radiation (on horizontal surf.)
00077 !                                             !                                       (W/m2)
00078 REAL, DIMENSION(KI,KSW),INTENT(IN) :: PSCA_SW ! diffuse solar radiation (on horizontal surf.)
00079 !                                             !                                       (W/m2)
00080 REAL, DIMENSION(KSW),INTENT(IN)  :: PSW_BANDS ! mean wavelength of each shortwave band (m)
00081 REAL, DIMENSION(KI), INTENT(IN)  :: PZENITH   ! zenithal angle at t      (radian from the vertical)
00082 REAL, DIMENSION(KI), INTENT(IN)  :: PZENITH2  ! zenithal angle at t+1    (radian from the vertical)
00083 REAL, DIMENSION(KI), INTENT(IN)  :: PAZIM     ! azimuthal angle      (radian from North, clockwise)
00084 REAL, DIMENSION(KI), INTENT(IN)  :: PLW       ! longwave radiation (on horizontal surf.)
00085 !                                             !                                       (W/m2)
00086 REAL, DIMENSION(KI), INTENT(IN)  :: PPS       ! pressure at atmospheric model surface (Pa)
00087 REAL, DIMENSION(KI), INTENT(IN)  :: PPA       ! pressure at forcing level             (Pa)
00088 REAL, DIMENSION(KI), INTENT(IN)  :: PZS       ! atmospheric model orography           (m)
00089 REAL, DIMENSION(KI), INTENT(IN)  :: PCO2      ! CO2 concentration in the air          (kg/m3)
00090 REAL, DIMENSION(KI), INTENT(IN)  :: PSNOW     ! snow precipitation                    (kg/m2/s)
00091 REAL, DIMENSION(KI), INTENT(IN)  :: PRAIN     ! liquid precipitation                  (kg/m2/s)
00092 !
00093 !
00094 REAL, DIMENSION(KI), INTENT(OUT) :: PSFTH     ! flux of heat                          (W/m2)
00095 REAL, DIMENSION(KI), INTENT(OUT) :: PSFTQ     ! flux of water vapor                   (kg/m2/s)
00096 REAL, DIMENSION(KI), INTENT(OUT) :: PSFU      ! zonal momentum flux                   (Pa)
00097 REAL, DIMENSION(KI), INTENT(OUT) :: PSFV      ! meridian momentum flux                (Pa)
00098 REAL, DIMENSION(KI), INTENT(OUT) :: PSFCO2    ! flux of CO2                           (kg/m2/s)
00099 REAL, DIMENSION(KI,KSV),INTENT(OUT):: PSFTS   ! flux of scalar var.                   (kg/m2/s)
00100 !
00101 REAL, DIMENSION(KI), INTENT(OUT) :: PTRAD     ! radiative temperature                 (K)
00102 REAL, DIMENSION(KI,KSW),INTENT(OUT):: PDIR_ALB! direct albedo for each spectral band  (-)
00103 REAL, DIMENSION(KI,KSW),INTENT(OUT):: PSCA_ALB! diffuse albedo for each spectral band (-)
00104 REAL, DIMENSION(KI), INTENT(OUT) :: PEMIS     ! emissivity                            (-)
00105 !
00106 REAL, DIMENSION(KI), INTENT(IN) :: PPEW_A_COEF! implicit coefficients
00107 REAL, DIMENSION(KI), INTENT(IN) :: PPEW_B_COEF! needed if HCOUPLING='I'
00108 REAL, DIMENSION(KI), INTENT(IN) :: PPET_A_COEF
00109 REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_A_COEF
00110 REAL, DIMENSION(KI), INTENT(IN) :: PPET_B_COEF
00111 REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_B_COEF
00112  CHARACTER(LEN=2),    INTENT(IN) :: HTEST ! must be equal to 'OK'
00113 
00114 !
00115 !*      0.2    declarations of local variables
00116 !
00117 !
00118 REAL, DIMENSION(KI,NGROUND_LAYER,NPATCH) :: ZTG   ! soil temperature
00119 REAL, DIMENSION(KI,NGROUND_LAYER,NPATCH) :: ZWG   ! soil water content
00120 REAL, DIMENSION(KI,NGROUND_LAYER,NPATCH) :: ZWGI  ! soil ice content
00121 REAL, DIMENSION(KI,NPATCH) :: ZWR   ! interception reservoir
00122 REAL, DIMENSION(KI,NPATCH) :: ZRESA ! aerodynamical resistance
00123 REAL, DIMENSION(KI,TSNOW%NLAYER,NPATCH) :: ZWSNOW! snow reservoir
00124 REAL, DIMENSION(KI,TSNOW%NLAYER,NPATCH) :: ZRHOSN! snow density
00125 REAL, DIMENSION(KI,TSNOW%NLAYER,NPATCH) :: ZHEASN! snow heat content
00126 REAL, DIMENSION(KI,NPATCH) :: ZALBSN! snow albedo
00127 REAL, DIMENSION(KI,NPATCH) :: ZEMISN! snow emissivity
00128 !
00129 REAL, DIMENSION(KI)     :: ZPEW_A_COEF ! implicit coefficients
00130 REAL, DIMENSION(KI)     :: ZPEW_B_COEF ! needed if HCOUPLING='I'
00131 REAL, DIMENSION(KI)     :: ZPET_A_COEF
00132 REAL, DIMENSION(KI)     :: ZPEQ_A_COEF
00133 REAL, DIMENSION(KI)     :: ZPET_B_COEF
00134 REAL, DIMENSION(KI)     :: ZPEQ_B_COEF
00135 REAL(KIND=JPRB) :: ZHOOK_HANDLE
00136 !-------------------------------------------------------------------------------------
00137 !
00138 IF (LHOOK) CALL DR_HOOK('COUPLING_TSZ0_N',0,ZHOOK_HANDLE)
00139 !
00140 !*      1.     Specified evolution of ISBA prognostic variables
00141 !              ------------------------------------------------
00142 !
00143  CALL TSZ0(PTIME, PTSTEP, XWFC, XTG, XWG)
00144 !
00145 !
00146 !*      2.     Saves the prognostic variables
00147 !              ------------------------------
00148 !
00149 ZTG  (:,:,:) = XTG        (:,:,:)
00150 ZWG  (:,:,:) = XWG        (:,:,:)
00151 ZWGI (:,:,:) = XWGI       (:,:,:)
00152 ZWR  (:,:)   = XWR        (:,:)
00153 ZRESA(:,:)   = XRESA      (:,:)
00154 ZWSNOW(:,:,:)= TSNOW%WSNOW(:,:,:)
00155 ZRHOSN(:,:,:)= TSNOW%RHO  (:,:,:)
00156 ZALBSN(:,:)  = TSNOW%ALB  (:,:)
00157 IF (TSNOW%SCHEME=='3-L' .OR. TSNOW%SCHEME=='CRO') THEN
00158   ZHEASN(:,:,:)= TSNOW%HEAT (:,:,:)
00159   ZEMISN(:,:)  = TSNOW%EMIS (:,:)
00160 END IF
00161 !
00162 !*      3.     Explicit coupling only
00163 !              ----------------------
00164 !
00165 ZPET_A_COEF =  XUNDEF
00166 !this modif changes results in MUSC
00167 ZPET_B_COEF =  XUNDEF
00168 ZPEQ_A_COEF =  XUNDEF
00169 ZPEQ_B_COEF =  XUNDEF
00170 ZPEW_A_COEF =  XUNDEF
00171 ZPEW_B_COEF =  XUNDEF
00172 !
00173 !
00174 !*      4.     Call to surface scheme
00175 !              ----------------------
00176 !
00177  CALL COUPLING_ISBA_OROGRAPHY_n(HPROGRAM, 'E',                                              &
00178                  0.001, KYEAR, KMONTH, KDAY, PTIME,                                          &
00179                  KI, KSV, KSW,                                                               &
00180                  PTSUN, PZENITH, PZENITH2, PAZIM,                                            &
00181                  PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV,                 &
00182                  PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA,                   &
00183                  PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV,                                    &
00184                  PTRAD, PDIR_ALB, PSCA_ALB, PEMIS,                                           &
00185                  ZPEW_A_COEF, ZPEW_B_COEF,                                                   &
00186                  ZPET_A_COEF, ZPEQ_A_COEF, ZPET_B_COEF, ZPEQ_B_COEF,                         &
00187                  'OK'                                                                        )  
00188 !
00189 !
00190 !*      5.     Removes temporal evolution of ISBA variables
00191 !              --------------------------------------------
00192 !
00193 !
00194 XTG  (:,:,:) = ZTG
00195 XWG  (:,:,:) = ZWG
00196 XWGI (:,:,:) = ZWGI
00197 XWR  (:,:)   = ZWR
00198 XRESA(:,:)   = ZRESA
00199 TSNOW%WSNOW(:,:,:) = ZWSNOW
00200 TSNOW%RHO  (:,:,:) = ZRHOSN
00201 TSNOW%ALB  (:,:)   = ZALBSN
00202 IF (TSNOW%SCHEME=='3-L' .OR. TSNOW%SCHEME=='CRO') THEN
00203   TSNOW%HEAT (:,:,:) = ZHEASN
00204   TSNOW%EMIS (:,:)   = ZEMISN
00205 END IF
00206 !
00207 IF (LHOOK) CALL DR_HOOK('COUPLING_TSZ0_N',1,ZHOOK_HANDLE)
00208 !
00209 !-------------------------------------------------------------------------------------
00210 !
00211 END SUBROUTINE COUPLING_TSZ0_n