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