|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ############################################################ 00002 SUBROUTINE COUPLING_IDEAL_FLUX(HPROGRAM, HCOUPLING, PTIMEC, & 00003 PTSTEP, KYEAR, KMONTH, KDAY, PTIME, KI, KSV, KSW, PTSUN, PZENITH, PAZIM, & 00004 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_IDEAL_FLUX * - Computes the surface fluxes for the temperature, 00014 !! vapor, horizontal components of the wind and the scalar variables. 00015 !! 00016 !! PURPOSE 00017 !! ------- 00018 ! Give prescribed values of the surface fluxes for the potential 00019 ! temperature, the vapor, the horizontal components of the wind and the 00020 ! scalar variables. These fluxes are unsteady when a diurnal cycle 00021 ! is taken into account. 00022 ! 00023 !!** METHOD 00024 !! ------ 00025 !! A temporal interpolation is performed to recover the values of the 00026 !! fluxes at every instant of the simulation. The different values of the 00027 !! prescribed fluxes are given at their declarations. 00028 !! For the wind, z0 can also be prescribed and the flux is determined 00029 !! with a neutral drag coefficient. 00030 !! 00031 !! 00032 !! REFERENCE 00033 !! --------- 00034 !! 00035 !! 00036 !! AUTHOR 00037 !! ------ 00038 !! V. Masson 00039 !! (from J. Cuxart and J. Stein) 00040 !! 00041 !! MODIFICATIONS 00042 !! ------------- 00043 !! Original 01/2004 00044 !! Modified 09/2012 : J. Escobar , SIZE(PTA) not allowed without-interface , replace by KI 00045 !------------------------------------------------------------------------------- 00046 ! 00047 !* 0. DECLARATIONS 00048 ! ------------ 00049 ! 00050 USE MODD_CSTS, ONLY : XRD, XCPD, XP00, XPI, XLVTT, XDAY 00051 USE MODD_IDEAL_FLUX, ONLY : NFORCF, NFORCT, XSFTH, XSFTQ, XSFTS, XSFCO2, & 00052 CUSTARTYPE, XUSTAR, XZ0, XALB, XEMIS, XTSRAD, & 00053 XTIMEF, XTIMET 00054 USE MODD_SURF_PAR, ONLY : XUNDEF 00055 USE MODD_DIAG_IDEAL_n, ONLY : XH, XLE, XRN, XGFLUX, LSURF_BUDGET, & 00056 LCOEF, XZ0_d=>XZ0, XZ0H_d=>XZ0H, & 00057 LSURF_VARS, XQS 00058 ! 00059 USE MODE_SBLS 00060 USE MODE_THERMOS 00061 ! 00062 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00063 USE PARKIND1 ,ONLY : JPRB 00064 ! 00065 USE MODI_ABOR1_SFX 00066 ! 00067 IMPLICIT NONE 00068 ! 00069 !* 0.1 declarations of arguments 00070 ! 00071 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes 00072 CHARACTER(LEN=1), INTENT(IN) :: HCOUPLING ! type of coupling 00073 ! 'E' : explicit 00074 ! 'I' : implicit 00075 REAL, INTENT(IN) :: PTIMEC ! cumulated time since beginning of simulation 00076 INTEGER, INTENT(IN) :: KYEAR ! current year (UTC) 00077 INTEGER, INTENT(IN) :: KMONTH ! current month (UTC) 00078 INTEGER, INTENT(IN) :: KDAY ! current day (UTC) 00079 REAL, INTENT(IN) :: PTIME ! current time since midnight (UTC, s) 00080 INTEGER, INTENT(IN) :: KI ! number of points 00081 INTEGER, INTENT(IN) :: KSV ! number of scalars 00082 INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands 00083 REAL, DIMENSION(KI), INTENT(IN) :: PTSUN ! solar time (s from midnight) 00084 REAL, INTENT(IN) :: PTSTEP ! atmospheric time-step (s) 00085 REAL, DIMENSION(KI), INTENT(IN) :: PZREF ! height of T,q forcing (m) 00086 REAL, DIMENSION(KI), INTENT(IN) :: PUREF ! height of wind forcing (m) 00087 ! 00088 REAL, DIMENSION(KI), INTENT(IN) :: PTA ! air temperature forcing (K) 00089 REAL, DIMENSION(KI), INTENT(IN) :: PQA ! air humidity forcing (kg/m3) 00090 REAL, DIMENSION(KI), INTENT(IN) :: PRHOA ! air density (kg/m3) 00091 REAL, DIMENSION(KI,KSV),INTENT(IN) :: PSV ! scalar variables 00092 ! ! chemistry: first char. in HSV: '#' (molecule/m3) 00093 ! ! 00094 CHARACTER(LEN=6), DIMENSION(KSV),INTENT(IN):: HSV ! name of all scalar variables 00095 REAL, DIMENSION(KI), INTENT(IN) :: PU ! zonal wind (m/s) 00096 REAL, DIMENSION(KI), INTENT(IN) :: PV ! meridian wind (m/s) 00097 REAL, DIMENSION(KI,KSW),INTENT(IN) :: PDIR_SW ! direct solar radiation (on horizontal surf.) 00098 ! ! (W/m2) 00099 REAL, DIMENSION(KI,KSW),INTENT(IN) :: PSCA_SW ! diffuse solar radiation (on horizontal surf.) 00100 ! ! (W/m2) 00101 REAL, DIMENSION(KSW),INTENT(IN) :: PSW_BANDS ! mean wavelength of each shortwave band (m) 00102 REAL, DIMENSION(KI), INTENT(IN) :: PZENITH ! zenithal angle (radian from the vertical) 00103 REAL, DIMENSION(KI), INTENT(IN) :: PAZIM ! azimuthal angle (radian from North, clockwise) 00104 REAL, DIMENSION(KI), INTENT(IN) :: PLW ! longwave radiation (on horizontal surf.) 00105 ! ! (W/m2) 00106 REAL, DIMENSION(KI), INTENT(IN) :: PPS ! pressure at atmospheric model surface (Pa) 00107 REAL, DIMENSION(KI), INTENT(IN) :: PPA ! pressure at forcing level (Pa) 00108 REAL, DIMENSION(KI), INTENT(IN) :: PZS ! atmospheric model orography (m) 00109 REAL, DIMENSION(KI), INTENT(IN) :: PCO2 ! CO2 concentration in the air (kg/m3) 00110 REAL, DIMENSION(KI), INTENT(IN) :: PSNOW ! snow precipitation (kg/m2/s) 00111 REAL, DIMENSION(KI), INTENT(IN) :: PRAIN ! liquid precipitation (kg/m2/s) 00112 ! 00113 ! 00114 REAL, DIMENSION(KI), INTENT(OUT) :: PSFTH ! flux of heat (W/m2) 00115 REAL, DIMENSION(KI), INTENT(OUT) :: PSFTQ ! flux of water vapor (kg/m2/s) 00116 REAL, DIMENSION(KI), INTENT(OUT) :: PSFU ! zonal momentum flux (Pa) 00117 REAL, DIMENSION(KI), INTENT(OUT) :: PSFV ! meridian momentum flux (Pa) 00118 REAL, DIMENSION(KI), INTENT(OUT) :: PSFCO2 ! flux of CO2 (kg/m2/s) 00119 REAL, DIMENSION(KI,KSV),INTENT(OUT):: PSFTS ! flux of scalar var. (kg/m2/s) 00120 ! 00121 REAL, DIMENSION(KI), INTENT(OUT) :: PTRAD ! radiative temperature (K) 00122 REAL, DIMENSION(KI,KSW),INTENT(OUT):: PDIR_ALB! direct albedo for each spectral band (-) 00123 REAL, DIMENSION(KI,KSW),INTENT(OUT):: PSCA_ALB! diffuse albedo for each spectral band (-) 00124 REAL, DIMENSION(KI), INTENT(OUT) :: PEMIS ! emissivity (-) 00125 ! 00126 REAL, DIMENSION(KI), INTENT(IN) :: PPEW_A_COEF! implicit coefficients 00127 REAL, DIMENSION(KI), INTENT(IN) :: PPEW_B_COEF! needed if HCOUPLING='I' 00128 REAL, DIMENSION(KI), INTENT(IN) :: PPET_A_COEF 00129 REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_A_COEF 00130 REAL, DIMENSION(KI), INTENT(IN) :: PPET_B_COEF 00131 REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_B_COEF 00132 CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK' 00133 00134 ! 00135 ! 00136 !* 0.2 declarations of local variables 00137 ! 00138 REAL, DIMENSION(KI) :: ZZ0 ! roughness length 00139 REAL, DIMENSION(KI) :: ZLMO ! Monin-Obuhkov length 00140 REAL, DIMENSION(KI) :: ZTHA ! air potential temperature 00141 REAL, DIMENSION(KI) :: ZRVA ! water vapor mixing ratio 00142 REAL, DIMENSION(KI) :: ZUSTAR ! friction velocity 00143 REAL, DIMENSION(KI) :: ZWIND ! wind 00144 REAL, DIMENSION(KI) :: ZQ0 ! surface temperature flux (mK/s) 00145 REAL, DIMENSION(KI) :: ZE0 ! surface vapor flux (mkg/kg/s) 00146 REAL, DIMENSION(KI) :: ZQA ! specific humidity (kg/kg) 00147 ! 00148 REAL :: ZALPHA ! interpolation coefficient 00149 INTEGER :: IHOURF ! number of hours since midnight 00150 INTEGER :: IHOURT 00151 INTEGER :: JITER ! convergence loop counter 00152 INTEGER :: JSV ! loop on scalar variables 00153 ! 00154 LOGICAL :: GCALL_LMO ! flag in non-neutral case 00155 ! 00156 INTEGER :: ILUOUT ! output listing logical unit 00157 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00158 ! 00159 !------------------------------------------------------------------------------------- 00160 IF (LHOOK) CALL DR_HOOK('COUPLING_IDEAL_FLUX',0,ZHOOK_HANDLE) 00161 IF (HTEST/='OK') THEN 00162 CALL ABOR1_SFX('COUPLING_IDEAL_FLUX: FATAL ERROR DURING ARGUMENT TRANSFER') 00163 END IF 00164 !---------------------------------------------------------------------------------- 00165 ! 00166 !* 2. COMPUTE TIME 00167 ! ------------ 00168 ! 00169 CALL TEMP_FORC_DISTS (PTIMEC,NFORCF,XTIMEF,IHOURF,ZALPHA) 00170 ! 00171 !---------------------------------------------------------------------------------- 00172 ! 00173 !* 3. CONS. TEMPERATURE SURFACE FLUX 00174 ! ------------------------------ 00175 ! 00176 PSFTH(:) = XSFTH(IHOURF) + ( XSFTH(IHOURF+1)-XSFTH(IHOURF) )*ZALPHA 00177 ! 00178 GCALL_LMO = ( XSFTH(IHOURF) + ( XSFTH(IHOURF+1)-XSFTH(IHOURF) )*ZALPHA ) /=0. 00179 !---------------------------------------------------------------------------------- 00180 ! 00181 !* 4. CONS. MIXING RATIO SURFACE FLUX 00182 ! ------------------------------- 00183 ! 00184 PSFTQ(:) = XSFTQ(IHOURF) + ( XSFTQ(IHOURF+1)-XSFTQ(IHOURF) )*ZALPHA 00185 ! 00186 GCALL_LMO = GCALL_LMO .OR. ( XSFTQ(IHOURF) + ( XSFTQ(IHOURF+1)-XSFTQ(IHOURF) )*ZALPHA ) /=0. 00187 !---------------------------------------------------------------------------------- 00188 ! 00189 !* 5. WIND SURFACE FLUX 00190 ! ----------------- 00191 ! 00192 !* 5.1 wind 00193 ! 00194 ZWIND(:) = SQRT(PU**2+PV**2) 00195 ! 00196 !* 5.2 Compute the surface stresses 00197 ! 00198 SELECT CASE (CUSTARTYPE) 00199 ! 00200 ! 00201 CASE ('USTAR') 00202 ! when u* is prescribed 00203 ZUSTAR(:) = XUSTAR(IHOURF) + ( XUSTAR(IHOURF+1)-XUSTAR(IHOURF) )*ZALPHA 00204 ! 00205 CASE ('Z0 ') 00206 ! 00207 !* spatialized roughness length 00208 ! 00209 ZZ0(:) = XZ0 00210 ! 00211 !* water mixing ratio 00212 ! 00213 ZRVA(:) = 0. 00214 ZQA(:) = PQA(:) / PRHOA(:) 00215 ! 00216 WHERE (ZQA(:)/=0.) ZRVA(:) = 1./(1./ZQA(:) - 1.) 00217 ! 00218 !* air potential temperature 00219 ZTHA(:) = PTA(:) * (XP00/PPA(:))**(XRD/XCPD) 00220 ! 00221 !* cinematic surface fluxes 00222 ZQ0(:) = PSFTH(:) / XCPD / PRHOA(:) 00223 ZE0(:) = PSFTQ(:) / PRHOA(:) 00224 ! 00225 ! 00226 !* neutral case, as guess 00227 ZLMO (:) = XUNDEF 00228 ZUSTAR(:) = USTAR(ZWIND(:),PZREF(:),ZZ0(:),ZLMO(:)) 00229 ! 00230 !* iterations in non-neutral case 00231 IF (GCALL_LMO) THEN 00232 ZUSTAR(:) = MAX ( ZUSTAR(:), 0.01 ) 00233 DO JITER=1,10 00234 ZLMO (:) = LMO (ZUSTAR(:),ZTHA(:),ZRVA(:),ZQ0(:),ZE0(:)) 00235 ZUSTAR(:) = USTAR(ZWIND(:),PZREF(:),ZZ0(:),ZLMO(:)) 00236 END DO 00237 END IF 00238 ! 00239 ! 00240 END SELECT 00241 ! 00242 PSFU = 0. 00243 PSFV = 0. 00244 WHERE (ZWIND>0.) 00245 PSFU = - PRHOA * ZUSTAR**2 * PU / ZWIND 00246 PSFV = - PRHOA * ZUSTAR**2 * PV / ZWIND 00247 END WHERE 00248 ! 00249 !------------------------------------------------------------------------------- 00250 ! 00251 !* 6. SCALAR VARIABLES FLUXES. 00252 ! ----------------------- 00253 ! 00254 DO JSV=1,SIZE(PSFTS,2) 00255 PSFTS(:,JSV) = XSFTS(IHOURF,JSV) + ( XSFTS(IHOURF+1,JSV)-XSFTS(IHOURF,JSV) )*ZALPHA 00256 END DO 00257 ! 00258 !------------------------------------------------------------------------------- 00259 ! 00260 !* 7. CO2 FLUXES. 00261 ! ---------- 00262 ! 00263 PSFCO2(:) = XSFCO2(IHOURF) + ( XSFCO2(IHOURF+1)-XSFCO2(IHOURF) )*ZALPHA 00264 ! 00265 !------------------------------------------------------------------------------- 00266 ! 00267 !* 8. OTHER OUTPUTS (RADIATIVE QUANTITIES) SET TO A CONSTANT VALUE 00268 ! ------------------------------------ 00269 ! 00270 CALL TEMP_FORC_DISTS (PTIMEC,NFORCT,XTIMET,IHOURT,ZALPHA) 00271 ! 00272 PTRAD(:) = XTSRAD(IHOURT) + ( XTSRAD(IHOURT+1)-XTSRAD(IHOURT) )*ZALPHA 00273 ! 00274 PDIR_ALB = XALB 00275 PSCA_ALB = XALB 00276 PEMIS = XEMIS 00277 ! 00278 !------------------------------------------------------------------------------- 00279 ! 00280 !* 9. turbulent fluxes as diagnostics 00281 ! ------------------------------------ 00282 IF (LSURF_BUDGET) THEN 00283 XH = PSFTH 00284 XLE = XLVTT * PSFTQ 00285 XRN = XH+XLE 00286 XGFLUX = 0. 00287 ENDIF 00288 ! 00289 IF (LCOEF) THEN 00290 XZ0_d = XZ0 00291 XZ0H_d = XZ0 00292 ENDIF 00293 ! 00294 IF (LSURF_VARS) THEN 00295 XQS(:) = QSAT(PTRAD(:),PPS(:)) 00296 ENDIF 00297 ! 00298 IF (LHOOK) CALL DR_HOOK('COUPLING_IDEAL_FLUX',1,ZHOOK_HANDLE) 00299 ! 00300 !------------------------------------------------------------------------------- 00301 CONTAINS 00302 ! 00303 SUBROUTINE TEMP_FORC_DISTS (PTIMEIN,KFORC,PTIMES,KHOUR,PALPHA) 00304 ! 00305 IMPLICIT NONE 00306 ! 00307 REAL, INTENT(IN) :: PTIMEIN 00308 INTEGER, INTENT(IN) :: KFORC 00309 REAL, DIMENSION(:), INTENT(IN) :: PTIMES 00310 INTEGER, INTENT(OUT):: KHOUR 00311 REAL, INTENT(OUT):: PALPHA 00312 ! 00313 INTEGER :: JT 00314 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00315 ! 00316 IF (LHOOK) CALL DR_HOOK('COUPLING_IDEAL_FLUX:TEMP_FORC_DISTS',0,ZHOOK_HANDLE) 00317 ! 00318 IF (PTIMES(KFORC)==XUNDEF) THEN 00319 KHOUR = 1 00320 PALPHA = 0. 00321 ELSEIF (PTIMEIN<PTIMES(1).OR.PTIMEIN>PTIMES(KFORC)) THEN 00322 CALL ABOR1_SFX("COUPLING_IDEAL_FLUX:TEMP_FORC_DISTS: PTIMEC OUT OF BOUNDS!!!") 00323 ELSE 00324 DO JT = KFORC,1,-1 00325 IF (PTIMEIN.GE.PTIMES(JT)) THEN 00326 KHOUR = JT 00327 EXIT 00328 ENDIF 00329 ENDDO 00330 PALPHA = (PTIMEIN-PTIMES(KHOUR)) / (PTIMES(KHOUR+1)-PTIMES(KHOUR)) 00331 ENDIF 00332 ! 00333 IF (LHOOK) CALL DR_HOOK('COUPLING_IDEAL_FLUX:TEMP_FORC_DISTS',1,ZHOOK_HANDLE) 00334 ! 00335 END SUBROUTINE TEMP_FORC_DISTS 00336 ! 00337 END SUBROUTINE COUPLING_IDEAL_FLUX
1.8.0
