|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ############################################################################### 00002 SUBROUTINE COUPLING_FLAKE_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_FLAKE_OROGRAPHY_n * - Modifies the input forcing if not 00014 !! initially at lake 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 !! Modified 09/2012 : J. Escobar , SIZE(PTA) not allowed without-interface , replace by KI 00035 !!------------------------------------------------------------- 00036 ! 00037 USE MODD_CSTS, ONLY : XCPD, XRD, XP00 00038 USE MODD_FLAKE_n, ONLY : LSBL, XTS, XZ0, XZS 00039 USE MODD_FLAKE_SBL_n, ONLY : XZ, XU, NLVL, XTKE, XT, XQ, XLMO, XZF, XDZ, XDZF, XP 00040 USE MODD_DIAG_FLAKE_n, ONLY : N2M, XT2M, XQ2M, XHU2M, XZON10M, XMER10M 00041 ! 00042 USE MODD_SURF_ATM, ONLY : LVERTSHIFT 00043 ! 00044 USE MODI_FORCING_VERT_SHIFT 00045 ! 00046 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00047 USE PARKIND1 ,ONLY : JPRB 00048 ! 00049 USE MODI_COUPLING_SEAWAT_SBL_n 00050 ! 00051 IMPLICIT NONE 00052 ! 00053 !* 0.1 declarations of arguments 00054 ! 00055 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes 00056 CHARACTER(LEN=1), INTENT(IN) :: HCOUPLING ! type of coupling 00057 ! 'E' : explicit 00058 ! 'I' : implicit 00059 INTEGER, INTENT(IN) :: KYEAR ! current year (UTC) 00060 INTEGER, INTENT(IN) :: KMONTH ! current month (UTC) 00061 INTEGER, INTENT(IN) :: KDAY ! current day (UTC) 00062 REAL, INTENT(IN) :: PTIME ! current time since midnight (UTC, s) 00063 INTEGER, INTENT(IN) :: KI ! number of points 00064 INTEGER, INTENT(IN) :: KSV ! number of scalars 00065 INTEGER, INTENT(IN) :: KSW ! number of short-wave spectral bands 00066 REAL, DIMENSION(KI), INTENT(IN) :: PTSUN ! solar time (s from midnight) 00067 REAL, INTENT(IN) :: PTSTEP ! atmospheric time-step (s) 00068 REAL, DIMENSION(KI), INTENT(IN) :: PZREF ! height of T,q forcing (m) 00069 REAL, DIMENSION(KI), INTENT(IN) :: PUREF ! height of wind forcing (m) 00070 ! 00071 REAL, DIMENSION(KI), INTENT(IN) :: PTA ! air temperature forcing (K) 00072 REAL, DIMENSION(KI), INTENT(IN) :: PQA ! air humidity forcing (kg/m3) 00073 REAL, DIMENSION(KI), INTENT(IN) :: PRHOA ! air density (kg/m3) 00074 REAL, DIMENSION(KI,KSV),INTENT(IN) :: PSV ! scalar variables 00075 ! ! chemistry: first char. in HSV: '#' (molecule/m3) 00076 ! ! 00077 CHARACTER(LEN=6), DIMENSION(KSV),INTENT(IN):: HSV ! name of all scalar variables 00078 REAL, DIMENSION(KI), INTENT(IN) :: PU ! zonal wind (m/s) 00079 REAL, DIMENSION(KI), INTENT(IN) :: PV ! meridian wind (m/s) 00080 REAL, DIMENSION(KI,KSW),INTENT(IN) :: PDIR_SW ! direct solar radiation (on horizontal surf.) 00081 ! ! (W/m2) 00082 REAL, DIMENSION(KI,KSW),INTENT(IN) :: PSCA_SW ! diffuse solar radiation (on horizontal surf.) 00083 ! ! (W/m2) 00084 REAL, DIMENSION(KSW),INTENT(IN) :: PSW_BANDS ! mean wavelength of each shortwave band (m) 00085 REAL, DIMENSION(KI), INTENT(IN) :: PZENITH ! zenithal angle (radian from the vertical) 00086 REAL, DIMENSION(KI), INTENT(IN) :: PAZIM ! azimuthal angle (radian from North, clockwise) 00087 REAL, DIMENSION(KI), INTENT(IN) :: PLW ! longwave radiation (on horizontal surf.) 00088 ! ! (W/m2) 00089 REAL, DIMENSION(KI), INTENT(IN) :: PPS ! pressure at atmospheric model surface (Pa) 00090 REAL, DIMENSION(KI), INTENT(IN) :: PPA ! pressure at forcing level (Pa) 00091 REAL, DIMENSION(KI), INTENT(IN) :: PZS ! atmospheric model orography (m) 00092 REAL, DIMENSION(KI), INTENT(IN) :: PCO2 ! CO2 concentration in the air (kg/m3) 00093 REAL, DIMENSION(KI), INTENT(IN) :: PSNOW ! snow precipitation (kg/m2/s) 00094 REAL, DIMENSION(KI), INTENT(IN) :: PRAIN ! liquid precipitation (kg/m2/s) 00095 ! 00096 ! 00097 REAL, DIMENSION(KI), INTENT(OUT) :: PSFTH ! flux of heat (W/m2) 00098 REAL, DIMENSION(KI), INTENT(OUT) :: PSFTQ ! flux of water vapor (kg/m2/s) 00099 REAL, DIMENSION(KI), INTENT(OUT) :: PSFU ! zonal momentum flux (Pa) 00100 REAL, DIMENSION(KI), INTENT(OUT) :: PSFV ! meridian momentum flux (Pa) 00101 REAL, DIMENSION(KI), INTENT(OUT) :: PSFCO2 ! flux of CO2 (kg/m2/s) 00102 REAL, DIMENSION(KI,KSV),INTENT(OUT):: PSFTS ! flux of scalar var. (kg/m2/s) 00103 ! 00104 REAL, DIMENSION(KI), INTENT(OUT) :: PTRAD ! radiative temperature (K) 00105 REAL, DIMENSION(KI,KSW),INTENT(OUT):: PDIR_ALB! direct albedo for each spectral band (-) 00106 REAL, DIMENSION(KI,KSW),INTENT(OUT):: PSCA_ALB! diffuse albedo for each spectral band (-) 00107 REAL, DIMENSION(KI), INTENT(OUT) :: PEMIS ! emissivity (-) 00108 ! 00109 REAL, DIMENSION(KI), INTENT(IN) :: PPEW_A_COEF! implicit coefficients 00110 REAL, DIMENSION(KI), INTENT(IN) :: PPEW_B_COEF! needed if HCOUPLING='I' 00111 REAL, DIMENSION(KI), INTENT(IN) :: PPET_A_COEF 00112 REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_A_COEF 00113 REAL, DIMENSION(KI), INTENT(IN) :: PPET_B_COEF 00114 REAL, DIMENSION(KI), INTENT(IN) :: PPEQ_B_COEF 00115 CHARACTER(LEN=2), INTENT(IN) :: HTEST ! must be equal to 'OK' 00116 00117 ! 00118 !* 0.2 declarations of local variables 00119 ! 00120 REAL, DIMENSION(KI) :: ZPEQ_B_COEF ! 1st explicit coefficient 00121 REAL, DIMENSION(KI) :: ZPET_B_COEF ! 2nd explicit coefficient 00122 ! 00123 REAL, DIMENSION(KI) :: ZTA ! Temperature at forcing height above surface orography 00124 REAL, DIMENSION(KI) :: ZPA ! Pressure at forcing height above surface orography 00125 REAL, DIMENSION(KI) :: ZPS ! Pressure at surface orography 00126 REAL, DIMENSION(KI) :: ZQA ! Humidity at forcing height above surface orography 00127 REAL, DIMENSION(KI) :: ZRHOA ! Density at forcing height above surface orography 00128 ! 00129 REAL, DIMENSION(KI) :: ZWIND10M 00130 REAL, DIMENSION(KI) :: ZWIND10M_MAX 00131 REAL, DIMENSION(KI) :: ZT2M_MIN 00132 REAL, DIMENSION(KI) :: ZT2M_MAX 00133 REAL, DIMENSION(KI) :: ZHU2M_MIN 00134 REAL, DIMENSION(KI) :: ZHU2M_MAX 00135 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00136 !------------------------------------------------------------------------------------- 00137 ! Preliminaries: 00138 !------------------------------------------------------------------------------------- 00139 ! 00140 IF (LHOOK) CALL DR_HOOK('COUPLING_FLAKE_OROGRAPHY_N',0,ZHOOK_HANDLE) 00141 ! 00142 ZPEQ_B_COEF = PPEQ_B_COEF 00143 ZPET_B_COEF = PPET_B_COEF 00144 ! 00145 IF(LVERTSHIFT)THEN 00146 ! 00147 CALL FORCING_VERT_SHIFT(PZS,XZS,PTA,PQA,PPA,PRHOA,ZTA,ZQA,ZPA,ZRHOA) 00148 ! 00149 ZPS = ZPA + (PPS - PPA) 00150 ! 00151 IF (HCOUPLING=='I') THEN 00152 ZPEQ_B_COEF = PPEQ_B_COEF + ZQA - PQA 00153 ZPET_B_COEF = PPET_B_COEF + ZTA/(ZPA/XP00)**(XRD/XCPD) - PTA/(PPA/XP00)**(XRD/XCPD) 00154 ENDIF 00155 ! 00156 ELSE 00157 ! 00158 ZTA = PTA 00159 ZQA = PQA 00160 ZPS = PPS 00161 ZPA = PPS 00162 ZRHOA = PRHOA 00163 ! 00164 ENDIF 00165 ! 00166 CALL COUPLING_SEAWAT_SBL_n(HPROGRAM, HCOUPLING, 'F', & 00167 PTSTEP, KYEAR, KMONTH, KDAY, PTIME, & 00168 KI, KSV, KSW, & 00169 PTSUN, PZENITH, PZENITH, PAZIM, & 00170 PZREF, PUREF, XZS, PU, PV, ZQA, ZTA, ZRHOA, PSV, PCO2, HSV, & 00171 PRAIN, PSNOW, PLW, PDIR_SW, PSCA_SW, PSW_BANDS, ZPS, ZPA, & 00172 PSFTQ, PSFTH, PSFTS, PSFCO2, PSFU, PSFV, LSBL, XTS, XZ0, & 00173 XZ, XU, NLVL, XTKE, XT, XQ, XLMO, XZF, XDZ, XDZF, XP, & 00174 N2M, XT2M, XQ2M, XHU2M, XZON10M, XMER10M, ZWIND10M, ZWIND10M_MAX, & 00175 ZT2M_MIN, ZT2M_MAX, ZHU2M_MIN, ZHU2M_MAX, & 00176 PTRAD, PDIR_ALB, PSCA_ALB, PEMIS, & 00177 PPEW_A_COEF, PPEW_B_COEF, & 00178 PPET_A_COEF, PPEQ_A_COEF, ZPET_B_COEF, ZPEQ_B_COEF, & 00179 'OK' ) 00180 ! 00181 IF (LHOOK) CALL DR_HOOK('COUPLING_FLAKE_OROGRAPHY_N',1,ZHOOK_HANDLE) 00182 ! 00183 !------------------------------------------------------------------------------------- 00184 ! 00185 END SUBROUTINE COUPLING_FLAKE_OROGRAPHY_n
1.8.0
