|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ############################################################################### 00002 SUBROUTINE COUPLING_ISBA_OROGRAPHY_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_ISBA_OROGRAPHY_n * - Parameterizes effects of subgrid 00014 !! orography on radiative and energy fluxes 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 05/2004 by P. LeMoigne: vertical shift of implicit 00034 !! coefficients 00035 !! B. Decharme 2008 reset the subgrid topographic effect on the forcing 00036 !---------------------------------------------------------------- 00037 ! 00038 USE MODD_CSTS, ONLY : XSTEFAN, XCPD, XRD, XP00 00039 USE MODD_ISBA_n, ONLY : XSSO_SLOPE, XEMIS_NAT, XTSRAD_NAT, XZS 00040 ! 00041 USE MODD_SURF_ATM, ONLY : LNOSOF, LVERTSHIFT 00042 ! 00043 USE MODI_FORCING_VERT_SHIFT 00044 USE MODI_COUPLING_ISBA_CANOPY_n 00045 ! 00046 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00047 USE PARKIND1 ,ONLY : JPRB 00048 ! 00049 IMPLICIT NONE 00050 ! 00051 !* 0.1 declarations of arguments 00052 ! 00053 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes 00054 CHARACTER(LEN=1), INTENT(IN) :: HCOUPLING ! type of coupling 00055 ! 'E' : explicit 00056 ! 'I' : implicit 00057 INTEGER, INTENT(IN) :: KYEAR ! current year (UTC) 00058 INTEGER, INTENT(IN) :: KMONTH ! current month (UTC) 00059 INTEGER, INTENT(IN) :: KDAY ! current day (UTC) 00060 REAL, INTENT(IN) :: PTIME ! current time since midnight (UTC, s) 00061 INTEGER, INTENT(IN) :: KI ! number of points 00062 INTEGER, INTENT(IN) :: KSV ! number of scalars 00063 INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands 00064 REAL, DIMENSION(KI), INTENT(IN) :: PTSUN ! solar time (s from midnight) 00065 REAL, INTENT(IN) :: PTSTEP ! atmospheric time-step (s) 00066 REAL, DIMENSION(KI), INTENT(IN) :: PZREF ! height of T,q forcing (m) 00067 REAL, DIMENSION(KI), INTENT(IN) :: PUREF ! height of wind forcing (m) 00068 ! 00069 REAL, DIMENSION(KI), INTENT(IN) :: PTA ! air temperature forcing (K) 00070 REAL, DIMENSION(KI), INTENT(IN) :: PQA ! air humidity forcing (kg/m3) 00071 REAL, DIMENSION(KI), INTENT(IN) :: PRHOA ! air density (kg/m3) 00072 REAL, DIMENSION(KI,KSV),INTENT(IN) :: PSV ! scalar variables 00073 ! ! chemistry: first char. in HSV: '#' (molecule/m3) 00074 ! ! 00075 CHARACTER(LEN=6), DIMENSION(KSV),INTENT(IN):: HSV ! name of all scalar variables 00076 REAL, DIMENSION(KI), INTENT(IN) :: PU ! zonal wind (m/s) 00077 REAL, DIMENSION(KI), INTENT(IN) :: PV ! meridian wind (m/s) 00078 REAL, DIMENSION(KI,KSW),INTENT(IN) :: PDIR_SW ! direct solar radiation (on horizontal surf.) 00079 ! ! (W/m2) 00080 REAL, DIMENSION(KI,KSW),INTENT(IN) :: PSCA_SW ! diffuse solar radiation (on horizontal surf.) 00081 ! ! (W/m2) 00082 REAL, DIMENSION(KSW),INTENT(IN) :: PSW_BANDS ! mean wavelength of each shortwave band (m) 00083 REAL, DIMENSION(KI), INTENT(IN) :: PZENITH ! zenithal angle at t (radian from the vertical) 00084 REAL, DIMENSION(KI), INTENT(IN) :: PZENITH2 ! zenithal angle at t+1(radian from the vertical) 00085 REAL, DIMENSION(KI), INTENT(IN) :: PAZIM ! azimuthal angle (radian from North, clockwise) 00086 REAL, DIMENSION(KI), INTENT(IN) :: PLW ! longwave radiation (on horizontal surf.) 00087 ! ! (W/m2) 00088 REAL, DIMENSION(KI), INTENT(IN) :: PPS ! pressure at atmospheric model surface (Pa) 00089 REAL, DIMENSION(KI), INTENT(IN) :: PPA ! pressure at forcing level (Pa) 00090 REAL, DIMENSION(KI), INTENT(IN) :: PZS ! atmospheric model orography (m) 00091 REAL, DIMENSION(KI), INTENT(IN) :: PCO2 ! CO2 concentration in the air (kg/m3) 00092 REAL, DIMENSION(KI), INTENT(IN) :: PSNOW ! snow precipitation (kg/m2/s) 00093 REAL, DIMENSION(KI), INTENT(IN) :: PRAIN ! liquid precipitation (kg/m2/s) 00094 ! 00095 ! 00096 REAL, DIMENSION(KI), INTENT(OUT) :: PSFTH ! flux of heat (W/m2) 00097 REAL, DIMENSION(KI), INTENT(OUT) :: PSFTQ ! flux of water vapor (kg/m2/s) 00098 REAL, DIMENSION(KI), INTENT(OUT) :: PSFU ! zonal momentum flux (Pa) 00099 REAL, DIMENSION(KI), INTENT(OUT) :: PSFV ! meridian momentum flux (Pa) 00100 REAL, DIMENSION(KI), INTENT(OUT) :: PSFCO2 ! flux of CO2 (kg/m2/s) 00101 REAL, DIMENSION(KI,KSV),INTENT(OUT):: PSFTS ! flux of scalar var. (kg/m2/s) 00102 ! 00103 REAL, DIMENSION(KI), INTENT(OUT) :: PTRAD ! radiative temperature (K) 00104 REAL, DIMENSION(KI,KSW),INTENT(OUT):: PDIR_ALB! direct albedo for each spectral band (-) 00105 REAL, DIMENSION(KI,KSW),INTENT(OUT):: PSCA_ALB! diffuse albedo for each spectral band (-) 00106 REAL, DIMENSION(KI), INTENT(OUT) :: PEMIS ! emissivity (-) 00107 ! 00108 REAL, DIMENSION(KI), INTENT(IN) :: PPEW_A_COEF! implicit coefficients 00109 REAL, DIMENSION(KI), INTENT(IN) :: PPEW_B_COEF! needed if HCOUPLING='I' 00110 REAL, DIMENSION(KI), INTENT(IN) :: PPET_A_COEF 00111 REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_A_COEF 00112 REAL, DIMENSION(KI), INTENT(IN) :: PPET_B_COEF 00113 REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_B_COEF 00114 CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK' 00115 ! 00116 !* 0.2 declarations of local variables 00117 ! 00118 REAL, DIMENSION(KI) :: ZTA ! Temperature at forcing height above surface orography 00119 REAL, DIMENSION(KI) :: ZPA ! Pressure at forcing height above surface orography 00120 REAL, DIMENSION(KI) :: ZPS ! Pressure at surface orography 00121 REAL, DIMENSION(KI) :: ZQA ! Humidity at forcing height above surface orography 00122 REAL, DIMENSION(KI) :: ZRHOA ! Density at forcing height above surface orography 00123 ! 00124 ! 00125 REAL, DIMENSION(KI) :: Z3D_TOT_SURF ! ratio between actual surface 00126 ! ! and horizontal surface 00127 REAL, DIMENSION(KI,KSW)::ZDIR_SW ! incoming direct SW radiation 00128 ! ! per m2 of actual surface 00129 REAL, DIMENSION(KI,KSW)::ZSCA_SW ! incoming diffuse SW radiation 00130 ! ! per m2 of actual surface 00131 REAL, DIMENSION(KI) :: ZLW ! incoming LW radiation per m2 of actual surface 00132 ! 00133 REAL, DIMENSION(KI) :: ZRAIN ! liquid precipitation per m2 of actual surface 00134 REAL, DIMENSION(KI) :: ZSNOW ! solid precipitation per m2 of actual surface 00135 ! 00136 REAL, DIMENSION(KI) :: ZPEQ_B_COEF ! 1st explicit coefficient 00137 REAL, DIMENSION(KI) :: ZPET_B_COEF ! 2nd explicit coefficient 00138 ! 00139 INTEGER :: ISWB ! number of shortwave spectral bands 00140 INTEGER :: JSWB ! loop on shortwave spectral bands 00141 INTEGER :: JSV ! loop on scalar variables 00142 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00143 ! 00144 !------------------------------------------------------------------------------------- 00145 ! 00146 !* 1. Goes from atmospheric orography to surface orography 00147 ! ---------------------------------------------------- 00148 ! 00149 IF (LHOOK) CALL DR_HOOK('COUPLING_ISBA_OROGRAPHY_N',0,ZHOOK_HANDLE) 00150 ! 00151 ZPEQ_B_COEF = PPEQ_B_COEF 00152 ZPET_B_COEF = PPET_B_COEF 00153 ! 00154 IF(LVERTSHIFT)THEN 00155 ! 00156 CALL FORCING_VERT_SHIFT(PZS,XZS,PTA,PQA,PPA,PRHOA,ZTA,ZQA,ZPA,ZRHOA) 00157 ! 00158 ZPS = ZPA + (PPS - PPA) 00159 ! 00160 IF (HCOUPLING=='I') THEN 00161 ZPEQ_B_COEF = PPEQ_B_COEF + ZQA - PQA 00162 ZPET_B_COEF = PPET_B_COEF + ZTA/(ZPA/XP00)**(XRD/XCPD) - PTA/(PPA/XP00)**(XRD/XCPD) 00163 ENDIF 00164 ! 00165 ELSE 00166 ! 00167 ZTA = PTA 00168 ZQA = PQA 00169 ZPS = PPS 00170 ZPA = PPS 00171 ZRHOA = PRHOA 00172 ! 00173 ENDIF 00174 ! 00175 !------------------------------------------------------------------------------------- 00176 ! 00177 !* 2. Presence of orography slopes 00178 ! ---------------------------- 00179 ! 00180 !* Incoming and outgoing fluxes are supposed to be on a horizontal surface. 00181 ! When slopes are present, the actual surface is LARGER than the 00182 ! horizontal surface. 00183 ! 00184 !* Therefore, this increase of surface will lead to modify the 00185 ! radiative and energy fluxes. 00186 ! 00187 !* Note that momentum fluxes are not modified, because the 00188 ! effect of subgrid orography is already taken into account 00189 ! in the effective roughness length. 00190 ! 00191 ! 00192 ! 00193 !* 2. Estimation of total surface 00194 ! --------------------------- 00195 ! 00196 ! The subgrid slope comes from the XSSO_SLOPE field. 00197 ! 00198 IF(LNOSOF)THEN 00199 Z3D_TOT_SURF(:) = 1. 00200 ELSE 00201 Z3D_TOT_SURF(:) = SQRT(1.+XSSO_SLOPE(:)**2) 00202 ENDIF 00203 ! 00204 ! 00205 !------------------------------------------------------------------------------------- 00206 ! 00207 !* 3. Modification of the incoming radiation 00208 ! -------------------------------------- 00209 ! 00210 ! number of spectral shortwave bands 00211 ! 00212 ISWB = SIZE(PSW_BANDS) 00213 ! 00214 DO JSWB=1,ISWB 00215 ! correcting for the slope angle (scaterred SW flux) 00216 ! 00217 ZSCA_SW(:,JSWB) = PSCA_SW(:,JSWB) / Z3D_TOT_SURF(:) 00218 00219 ! correcting for the slope angle (scaterred SW flux) 00220 ! 00221 ZDIR_SW(:,JSWB) = PDIR_SW(:,JSWB) / Z3D_TOT_SURF(:) 00222 END DO 00223 ! 00224 ! part of LW flux is received from the surface itself, so the outgoing flux 00225 ! is needed. 00226 ! 00227 ! correction for LW flux. 00228 ! 00229 ZLW(:) = PLW(:) * 1./Z3D_TOT_SURF(:)& 00230 + XSTEFAN*XEMIS_NAT(:)*XTSRAD_NAT(:)**4 * (1.-1./Z3D_TOT_SURF(:)) 00231 ! 00232 !------------------------------------------------------------------------------------- 00233 ! 00234 !* 4. Modification of precipitation 00235 ! ----------------------------- 00236 ! 00237 ! correction for RAIN flux. 00238 ! 00239 ZRAIN(:) = PRAIN(:) / Z3D_TOT_SURF(:) 00240 ! 00241 ! correction for SNOW flux. 00242 ! 00243 ZSNOW(:) = PSNOW(:) / Z3D_TOT_SURF(:) 00244 ! 00245 !------------------------------------------------------------------------------------- 00246 ! 00247 !* 5. Call of ISBA 00248 ! ------------ 00249 ! 00250 CALL COUPLING_ISBA_CANOPY_n(HPROGRAM, HCOUPLING, & 00251 PTSTEP, KYEAR, KMONTH, KDAY, PTIME, & 00252 KI, KSV, KSW, & 00253 PTSUN, PZENITH, PZENITH2, PAZIM, & 00254 PZREF, PUREF, PZS, PU, PV, ZQA, ZTA, ZRHOA, PSV, PCO2, HSV, & 00255 ZRAIN, ZSNOW, ZLW, ZDIR_SW, ZSCA_SW, PSW_BANDS, ZPS, ZPA, & 00256 PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, & 00257 PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, & 00258 PPEW_A_COEF, PPEW_B_COEF, & 00259 PPET_A_COEF, PPEQ_A_COEF, ZPET_B_COEF, ZPEQ_B_COEF, & 00260 'OK' ) 00261 ! 00262 !------------------------------------------------------------------------------------- 00263 ! 00264 !* 6. Modification of turbulent energy and gaz fluxes 00265 ! ----------------------------------------------- 00266 ! 00267 PSFTH (:) = PSFTH (:) * Z3D_TOT_SURF(:) 00268 PSFTQ (:) = PSFTQ (:) * Z3D_TOT_SURF(:) 00269 PSFCO2(:) = PSFCO2(:) * Z3D_TOT_SURF(:) 00270 DO JSV=1,SIZE(PSFTS,2) 00271 PSFTS(:,JSV) = PSFTS(:,JSV) * Z3D_TOT_SURF(:) 00272 END DO 00273 IF (LHOOK) CALL DR_HOOK('COUPLING_ISBA_OROGRAPHY_N',1,ZHOOK_HANDLE) 00274 ! 00275 !------------------------------------------------------------------------------------- 00276 ! 00277 END SUBROUTINE COUPLING_ISBA_OROGRAPHY_n
1.8.0
