|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ############################################################################### 00002 SUBROUTINE COUPLING_TEB_OROGRAPHY_n(HPROGRAM, HCOUPLING, & 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_TEB_OROGRAPHY_n * - Modifies the input forcing if not 00014 !! initially at town level 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 !! B. Decharme 2008 reset the subgrid topographic effect on the forcing 00034 !! J. Escobar 09/2012 SIZE(PTA) not allowed without-interface , replace by KI 00035 !!------------------------------------------------------------- 00036 ! 00037 USE MODD_CSTS, ONLY : XCPD, XRD, XP00 00038 USE MODD_TEB_n, ONLY : XZS 00039 ! 00040 USE MODD_SURF_ATM, ONLY : LVERTSHIFT 00041 ! 00042 USE MODI_FORCING_VERT_SHIFT 00043 ! 00044 ! 00045 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00046 USE PARKIND1 ,ONLY : JPRB 00047 ! 00048 USE MODI_COUPLING_TEB_n 00049 ! 00050 IMPLICIT NONE 00051 ! 00052 !* 0.1 declarations of arguments 00053 ! 00054 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes 00055 CHARACTER(LEN=1), INTENT(IN) :: HCOUPLING ! type of coupling 00056 ! 'E' : explicit 00057 ! 'I' : implicit 00058 INTEGER, INTENT(IN) :: KYEAR ! current year (UTC) 00059 INTEGER, INTENT(IN) :: KMONTH ! current month (UTC) 00060 INTEGER, INTENT(IN) :: KDAY ! current day (UTC) 00061 REAL, INTENT(IN) :: PTIME ! current time since midnight (UTC, s) 00062 INTEGER, INTENT(IN) :: KI ! number of points 00063 INTEGER, INTENT(IN) :: KSV ! number of scalars 00064 INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands 00065 REAL, DIMENSION(KI), INTENT(IN) :: PTSUN ! solar time (s from midnight) 00066 REAL, INTENT(IN) :: PTSTEP ! atmospheric time-step (s) 00067 REAL, DIMENSION(KI), INTENT(IN) :: PZREF ! height of T,q forcing (m) 00068 REAL, DIMENSION(KI), INTENT(IN) :: PUREF ! height of wind forcing (m) 00069 ! 00070 REAL, DIMENSION(KI), INTENT(IN) :: PTA ! air temperature forcing (K) 00071 REAL, DIMENSION(KI), INTENT(IN) :: PQA ! air humidity forcing (kg/m3) 00072 REAL, DIMENSION(KI), INTENT(IN) :: PRHOA ! air density (kg/m3) 00073 REAL, DIMENSION(KI,KSV),INTENT(IN) :: PSV ! scalar variables 00074 ! ! chemistry: first char. in HSV: '#' (molecule/m3) 00075 ! ! 00076 CHARACTER(LEN=6), DIMENSION(KSV),INTENT(IN):: HSV ! name of all scalar variables 00077 REAL, DIMENSION(KI), INTENT(IN) :: PU ! zonal wind (m/s) 00078 REAL, DIMENSION(KI), INTENT(IN) :: PV ! meridian wind (m/s) 00079 REAL, DIMENSION(KI,KSW),INTENT(IN) :: PDIR_SW ! direct solar radiation (on horizontal surf.) 00080 ! ! (W/m2) 00081 REAL, DIMENSION(KI,KSW),INTENT(IN) :: PSCA_SW ! diffuse solar radiation (on horizontal surf.) 00082 ! ! (W/m2) 00083 REAL, DIMENSION(KSW),INTENT(IN) :: PSW_BANDS ! mean wavelength of each shortwave band (m) 00084 REAL, DIMENSION(KI), INTENT(IN) :: PZENITH ! zenithal angle (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) :: ZPEQ_B_COEF ! 1st explicit coefficient 00119 REAL, DIMENSION(KI) :: ZPET_B_COEF ! 2nd explicit coefficient 00120 ! 00121 REAL, DIMENSION(KI) :: ZTA ! Temperature at forcing height above surface orography 00122 REAL, DIMENSION(KI) :: ZPA ! Pressure at forcing height above surface orography 00123 REAL, DIMENSION(KI) :: ZPS ! Pressure at surface orography 00124 REAL, DIMENSION(KI) :: ZQA ! Humidity at forcing height above surface orography 00125 REAL, DIMENSION(KI) :: ZRHOA ! Density at forcing height above surface orography 00126 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00127 !------------------------------------------------------------------------------------- 00128 ! Preliminaries: 00129 !------------------------------------------------------------------------------------- 00130 ! 00131 IF (LHOOK) CALL DR_HOOK('COUPLING_TEB_OROGRAPHY_N',0,ZHOOK_HANDLE) 00132 ! 00133 ZPEQ_B_COEF = PPEQ_B_COEF 00134 ZPET_B_COEF = PPET_B_COEF 00135 ! 00136 IF(LVERTSHIFT)THEN 00137 ! 00138 CALL FORCING_VERT_SHIFT(PZS,XZS,PTA,PQA,PPA,PRHOA,ZTA,ZQA,ZPA,ZRHOA) 00139 ! 00140 ZPS = ZPA + (PPS - PPA) 00141 ! 00142 IF (HCOUPLING=='I') THEN 00143 ZPEQ_B_COEF = PPEQ_B_COEF + ZQA - PQA 00144 ZPET_B_COEF = PPET_B_COEF + ZTA/(ZPA/XP00)**(XRD/XCPD) - PTA/(PPA/XP00)**(XRD/XCPD) 00145 ENDIF 00146 ! 00147 ELSE 00148 ! 00149 ZTA = PTA 00150 ZQA = PQA 00151 ZPS = PPS 00152 ZPA = PPS 00153 ZRHOA = PRHOA 00154 ! 00155 ENDIF 00156 ! 00157 CALL COUPLING_TEB_n(HPROGRAM, HCOUPLING, & 00158 PTSTEP, KYEAR, KMONTH, KDAY, PTIME, & 00159 KI, KSV, KSW, & 00160 PTSUN, PZENITH, PAZIM, & 00161 PZREF, PUREF, XZS, PU, PV, ZQA, ZTA, ZRHOA,PSV, PCO2, HSV, & 00162 PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, ZPS, ZPA, & 00163 PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, & 00164 PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, & 00165 PPEW_A_COEF, PPEW_B_COEF, & 00166 PPET_A_COEF, PPEQ_A_COEF, ZPET_B_COEF, ZPEQ_B_COEF, & 00167 'OK' ) 00168 IF (LHOOK) CALL DR_HOOK('COUPLING_TEB_OROGRAPHY_N',1,ZHOOK_HANDLE) 00169 ! 00170 !------------------------------------------------------------------------------------- 00171 ! 00172 END SUBROUTINE COUPLING_TEB_OROGRAPHY_n
1.8.0
