|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ############################################################################### 00002 SUBROUTINE COUPLING_ISBA_SVAT_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_SVAT_n * - Chooses the time method (explicit, 00014 !! implicit, time-spliting) for ISBA scheme 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 !! A. Bogatchev 09/2005 EBA snow option 00034 !! A. Boone 11/2009 Exner correction for Offline T-B coef 00035 !! B. Decharme 11/2009 Implicit coupling ok with all snow scheme 00036 !!------------------------------------------------------------------- 00037 ! 00038 USE MODD_ISBA_n, ONLY : XTSTEP 00039 USE MODD_SURF_PAR, ONLY : XUNDEF 00040 ! 00041 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00042 USE PARKIND1 ,ONLY : JPRB 00043 ! 00044 USE MODI_COUPLING_ISBA_OROGRAPHY_n 00045 ! 00046 IMPLICIT NONE 00047 ! 00048 !* 0.1 declarations of arguments 00049 ! 00050 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes 00051 CHARACTER(LEN=1), INTENT(IN) :: HCOUPLING ! type of coupling 00052 ! 'E' : explicit 00053 ! 'I' : implicit 00054 INTEGER, INTENT(IN) :: KYEAR ! current year (UTC) 00055 INTEGER, INTENT(IN) :: KMONTH ! current month (UTC) 00056 INTEGER, INTENT(IN) :: KDAY ! current day (UTC) 00057 REAL, INTENT(IN) :: PTIME ! current time since midnight (UTC, s) 00058 INTEGER, INTENT(IN) :: KI ! number of points 00059 INTEGER, INTENT(IN) :: KSV ! number of scalars 00060 INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands 00061 REAL, DIMENSION(KI), INTENT(IN) :: PTSUN ! solar time (s from midnight) 00062 REAL, INTENT(IN) :: PTSTEP ! atmospheric time-step (s) 00063 REAL, DIMENSION(KI), INTENT(IN) :: PZREF ! height of T,q forcing (m) 00064 REAL, DIMENSION(KI), INTENT(IN) :: PUREF ! height of wind forcing (m) 00065 ! 00066 REAL, DIMENSION(KI), INTENT(IN) :: PTA ! air temperature forcing (K) 00067 REAL, DIMENSION(KI), INTENT(IN) :: PQA ! air humidity forcing (kg/m3) 00068 REAL, DIMENSION(KI), INTENT(IN) :: PRHOA ! air density (kg/m3) 00069 REAL, DIMENSION(KI,KSV),INTENT(IN) :: PSV ! scalar variables 00070 ! ! chemistry: first char. in HSV: '#' (molecule/m3) 00071 ! ! 00072 CHARACTER(LEN=6), DIMENSION(KSV),INTENT(IN):: HSV ! name of all scalar variables 00073 REAL, DIMENSION(KI), INTENT(IN) :: PU ! zonal wind (m/s) 00074 REAL, DIMENSION(KI), INTENT(IN) :: PV ! meridian wind (m/s) 00075 REAL, DIMENSION(KI,KSW),INTENT(IN) :: PDIR_SW ! direct solar radiation (on horizontal surf.) 00076 ! ! (W/m2) 00077 REAL, DIMENSION(KI,KSW),INTENT(IN) :: PSCA_SW ! diffuse solar radiation (on horizontal surf.) 00078 ! ! (W/m2) 00079 REAL, DIMENSION(KSW),INTENT(IN) :: PSW_BANDS ! mean wavelength of each shortwave band (m) 00080 REAL, DIMENSION(KI), INTENT(IN) :: PZENITH ! zenithal angle at t (radian from the vertical) 00081 REAL, DIMENSION(KI), INTENT(IN) :: PZENITH2 ! zenithal angle at t+1 (radian from the vertical) 00082 REAL, DIMENSION(KI), INTENT(IN) :: PAZIM ! azimuthal angle (radian from North, clockwise) 00083 REAL, DIMENSION(KI), INTENT(IN) :: PLW ! longwave radiation (on horizontal surf.) 00084 ! ! (W/m2) 00085 REAL, DIMENSION(KI), INTENT(IN) :: PPS ! pressure at atmospheric model surface (Pa) 00086 REAL, DIMENSION(KI), INTENT(IN) :: PPA ! pressure at forcing level (Pa) 00087 REAL, DIMENSION(KI), INTENT(IN) :: PZS ! atmospheric model orography (m) 00088 REAL, DIMENSION(KI), INTENT(IN) :: PCO2 ! CO2 concentration in the air (kg/m3) 00089 REAL, DIMENSION(KI), INTENT(IN) :: PSNOW ! snow precipitation (kg/m2/s) 00090 REAL, DIMENSION(KI), INTENT(IN) :: PRAIN ! liquid precipitation (kg/m2/s) 00091 ! 00092 ! 00093 REAL, DIMENSION(KI), INTENT(OUT) :: PSFTH ! flux of heat (W/m2) 00094 REAL, DIMENSION(KI), INTENT(OUT) :: PSFTQ ! flux of water vapor (kg/m2/s) 00095 REAL, DIMENSION(KI), INTENT(OUT) :: PSFU ! zonal momentum flux (Pa) 00096 REAL, DIMENSION(KI), INTENT(OUT) :: PSFV ! meridian momentum flux (Pa) 00097 REAL, DIMENSION(KI), INTENT(OUT) :: PSFCO2 ! flux of CO2 (kg/m2/s) 00098 REAL, DIMENSION(KI,KSV),INTENT(OUT):: PSFTS ! flux of scalar var. (kg/m2/s) 00099 ! 00100 REAL, DIMENSION(KI), INTENT(OUT) :: PTRAD ! radiative temperature (K) 00101 REAL, DIMENSION(KI,KSW),INTENT(OUT):: PDIR_ALB! direct albedo for each spectral band (-) 00102 REAL, DIMENSION(KI,KSW),INTENT(OUT):: PSCA_ALB! diffuse albedo for each spectral band (-) 00103 REAL, DIMENSION(KI), INTENT(OUT) :: PEMIS ! emissivity (-) 00104 ! 00105 REAL, DIMENSION(KI), INTENT(IN) :: PPEW_A_COEF! implicit coefficients 00106 REAL, DIMENSION(KI), INTENT(IN) :: PPEW_B_COEF! needed if HCOUPLING='I' 00107 REAL, DIMENSION(KI), INTENT(IN) :: PPET_A_COEF 00108 REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_A_COEF 00109 REAL, DIMENSION(KI), INTENT(IN) :: PPET_B_COEF 00110 REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_B_COEF 00111 CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK' 00112 ! 00113 !* 0.2 declarations of local variables 00114 ! 00115 REAL, DIMENSION(KI) :: ZSFTH ! surface temperature flux 00116 REAL, DIMENSION(KI) :: ZSFTQ ! surface water vapor flux 00117 REAL, DIMENSION(KI) :: ZSFCO2 ! surface CO2 flux 00118 REAL, DIMENSION(KI,KSV):: ZSFTS ! surface scalar flux 00119 REAL, DIMENSION(KI) :: ZSFU ! zonal momentum flux 00120 REAL, DIMENSION(KI) :: ZSFV ! meridian momentum flux 00121 REAL, DIMENSION(KI) :: ZTRAD ! surface radiative temperature 00122 REAL, DIMENSION(KI) :: ZEMIS ! surface emissivity 00123 REAL, DIMENSION(KI,KSW) :: ZDIR_ALB! direct surface albedo 00124 REAL, DIMENSION(KI,KSW) :: ZSCA_ALB! diffuse surface albedo 00125 ! 00126 REAL, DIMENSION(KI) :: ZWORK_LW ! work array for mean upward longwave surface flux 00127 ! 00128 INTEGER :: JT ! time loop counter 00129 INTEGER :: IT ! total number of surface timesteps in one atmospheric timestep 00130 REAL :: ZT ! total number of surface timesteps in one atmospheric timestep 00131 REAL :: ZTSTEP ! surface time step 00132 ! 00133 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00134 ! 00135 !------------------------------------------------------------------------------------- 00136 ! 00137 !* 1. number of time-steps 00138 ! -------------------- 00139 ! 00140 !* only one timestep in Implicit coupling 00141 IF (LHOOK) CALL DR_HOOK('COUPLING_ISBA_SVAT_N',0,ZHOOK_HANDLE) 00142 IF (HCOUPLING=='I') THEN 00143 IT=1 00144 ZT=1. 00145 ZTSTEP=PTSTEP 00146 ! 00147 !* same timestep as atmospheric timestep as default 00148 ELSE IF (XTSTEP==XUNDEF) THEN 00149 IT=1 00150 ZT=1. 00151 ZTSTEP=PTSTEP 00152 ! 00153 !* case of specified SVAT time-step 00154 ELSE 00155 IT=MAX(NINT(PTSTEP/XTSTEP),1) 00156 ZT=FLOAT(IT) 00157 ZTSTEP=PTSTEP/ZT 00158 ENDIF 00159 ! 00160 !* 3. initialization of outputs 00161 ! ------------------------- 00162 ! 00163 PSFTQ = 0. 00164 PSFTH = 0. 00165 PSFTS = 0. 00166 PSFCO2 = 0. 00167 PSFU = 0. 00168 PSFV = 0. 00169 PTRAD = 0. 00170 PDIR_ALB= 0. 00171 PSCA_ALB= 0. 00172 PEMIS = 0. 00173 ! 00174 ZWORK_LW = 0. 00175 ! 00176 ! 00177 !* 4. loop on surface time-step 00178 ! ------------------------- 00179 ! 00180 DO JT=1,IT 00181 CALL COUPLING_ISBA_OROGRAPHY_n(HPROGRAM, HCOUPLING, & 00182 ZTSTEP, KYEAR, KMONTH, KDAY, PTIME, & 00183 KI, KSV, KSW, & 00184 PTSUN, PZENITH, PZENITH2, PAZIM, & 00185 PZREF, PUREF, PZS, PU, PV, PQA, PTA, PRHOA, PSV, PCO2, HSV, & 00186 PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, PPS, PPA, & 00187 ZSFTQ, ZSFTH, ZSFTS, ZSFCO2, ZSFU, ZSFV, & 00188 ZTRAD, ZDIR_ALB, ZSCA_ALB, ZEMIS, & 00189 PPEW_A_COEF, PPEW_B_COEF, & 00190 PPET_A_COEF, PPEQ_A_COEF, PPET_B_COEF, PPEQ_B_COEF, & 00191 'OK' ) 00192 ! 00193 PSFTQ = PSFTQ + ZSFTQ / ZT 00194 PSFTH = PSFTH + ZSFTH / ZT 00195 PSFTS = PSFTS + ZSFTS / ZT 00196 PSFCO2 = PSFCO2 + ZSFCO2 / ZT 00197 PSFU = PSFU + ZSFU / ZT 00198 PSFV = PSFV + ZSFV / ZT 00199 PEMIS = PEMIS + ZEMIS / ZT 00200 PDIR_ALB = PDIR_ALB + ZDIR_ALB / ZT 00201 PSCA_ALB = PSCA_ALB + ZSCA_ALB / ZT 00202 ZWORK_LW = ZWORK_LW + ZEMIS*ZTRAD**4 / ZT 00203 END DO 00204 ! 00205 !* radiative temperature retrieved from upward longwave flux 00206 ! 00207 PTRAD = (ZWORK_LW/PEMIS)**(0.25) 00208 IF (LHOOK) CALL DR_HOOK('COUPLING_ISBA_SVAT_N',1,ZHOOK_HANDLE) 00209 ! 00210 !------------------------------------------------------------------------------------- 00211 ! 00212 END SUBROUTINE COUPLING_ISBA_SVAT_n
1.8.0
