|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE ECUME_SEAFLUX(PZ0SEA,PMASK,KSIZE_WATER,KSIZE_ICE, & 00003 PTA,PEXNA,PRHOA,PSST,PEXNS,PQA, & 00004 PRAIN,PSNOW,PVMOD,PZREF,PUREF,PPS, & 00005 PICHCE,OPRECIP,OPWEBB, OPWG, PQSAT, & 00006 PSFTH,PSFTQ,PUSTAR,PCD,PCDN,PCH, & 00007 PCE,PRI,PRESA,PZ0HSEA) 00008 ! ####################################################################### 00009 ! 00010 ! 00011 !!**** *ECUME_SEAFLUX* 00012 !! 00013 !! PURPOSE 00014 !! ------- 00015 ! 00016 ! Calculate the sea surface fluxes with modified bulk algorithm COARE: 00017 ! 00018 ! Calculates the surface fluxes of heat, moisture, and momentum over 00019 ! sea surface with Unified Turbulent fluxes parameterization with calibration 00020 ! multi-campaign of neutral transfer coefficient from 00021 ! ALBATROS dataset (exp. POMME, CATCH, FETCH, SEMAPHORE, EQUALANT99) 00022 ! 00023 ! based on water_flux computation for sea ice 00024 ! 00025 !!** METHOD 00026 !! ------ 00027 ! 00028 !! EXTERNAL 00029 !! -------- 00030 !! 00031 !! IMPLICIT ARGUMENTS 00032 !! ------------------ 00033 !! 00034 !! REFERENCE 00035 !! --------- 00036 !! 00037 !! AUTHOR 00038 !! ------ 00039 !! C. Lebeaupin *Météo-France* 00040 !! 00041 !! MODIFICATIONS 00042 !! ------------- 00043 !! Original 18/03/2005 00044 !! Modified 08/2009 B. Decharme 00045 !------------------------------------------------------------------------------- 00046 ! 00047 !* 0. DECLARATIONS 00048 ! ------------ 00049 !! 00050 USE MODI_ICE_SEA_FLUX 00051 USE MODI_ECUME_FLUX 00052 ! 00053 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00054 USE PARKIND1 ,ONLY : JPRB 00055 ! 00056 IMPLICIT NONE 00057 ! 00058 !* 0.1 declarations of arguments 00059 ! 00060 REAL, DIMENSION(:), INTENT(IN) :: PMASK 00061 INTEGER , INTENT(IN) :: KSIZE_WATER ! number of points of sea water 00062 INTEGER , INTENT(IN) :: KSIZE_ICE ! and of sea ice 00063 ! 00064 REAL, DIMENSION(:), INTENT(IN) :: PTA ! air temperature at atm. level (K) 00065 REAL, DIMENSION(:), INTENT(IN) :: PQA ! air humidity at atm. level (kg/kg) 00066 REAL, DIMENSION(:), INTENT(IN) :: PEXNA ! Exner function at atm. level 00067 REAL, DIMENSION(:), INTENT(IN) :: PRHOA ! air density at atm. level 00068 REAL, DIMENSION(:), INTENT(IN) :: PVMOD ! module of wind at atm. wind level (m/s) 00069 REAL, DIMENSION(:), INTENT(IN) :: PZREF ! atm. level for temp. and humidity (m) 00070 REAL, DIMENSION(:), INTENT(IN) :: PUREF ! atm. level for wind (m) 00071 REAL, DIMENSION(:), INTENT(IN) :: PSST ! Sea Surface Temperature (K) 00072 REAL, DIMENSION(:), INTENT(IN) :: PEXNS ! Exner function at sea surface 00073 REAL, DIMENSION(:), INTENT(IN) :: PPS ! air pressure at sea surface (Pa) 00074 REAL, DIMENSION(:), INTENT(IN) :: PRAIN ! precipitation rate (kg/s/m2) 00075 REAL, DIMENSION(:), INTENT(IN) :: PSNOW ! snow rate (kg/s/m2) 00076 ! 00077 REAL, INTENT(IN) :: PICHCE ! 00078 LOGICAL, INTENT(IN) :: OPRECIP! 00079 LOGICAL, INTENT(IN) :: OPWEBB ! 00080 LOGICAL, INTENT(IN) :: OPWG ! 00081 ! 00082 REAL, DIMENSION(:), INTENT(INOUT) :: PZ0SEA! roughness length over the ocean 00083 ! 00084 ! surface fluxes : latent heat, sensible heat, friction fluxes 00085 REAL, DIMENSION(:), INTENT(OUT) :: PSFTH ! heat flux (W/m2) 00086 REAL, DIMENSION(:), INTENT(OUT) :: PSFTQ ! water flux (kg/m2/s) 00087 REAL, DIMENSION(:), INTENT(OUT) :: PUSTAR! friction velocity (m/s) 00088 ! 00089 ! diagnostics 00090 REAL, DIMENSION(:), INTENT(OUT) :: PQSAT ! humidity at saturation 00091 REAL, DIMENSION(:), INTENT(OUT) :: PCD ! heat drag coefficient 00092 REAL, DIMENSION(:), INTENT(OUT) :: PCDN ! momentum drag coefficient 00093 REAL, DIMENSION(:), INTENT(OUT) :: PCH ! neutral momentum drag coefficient 00094 REAL, DIMENSION(:), INTENT(OUT) :: PCE !transfer coef. for latent heat flux 00095 REAL, DIMENSION(:), INTENT(OUT) :: PRI ! Richardson number 00096 REAL, DIMENSION(:), INTENT(OUT) :: PRESA ! aerodynamical resistance 00097 REAL, DIMENSION(:), INTENT(OUT) :: PZ0HSEA ! heat roughness length 00098 ! 00099 !* 0.2 declarations of local variables 00100 ! 00101 INTEGER, DIMENSION(KSIZE_WATER) :: IR_WATER 00102 INTEGER, DIMENSION(KSIZE_ICE) :: IR_ICE 00103 INTEGER :: J1,J2,JJ 00104 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00105 ! 00106 !------------------------------------------------------------------------------- 00107 ! 00108 ! 1. Create Masks for ice and water sea 00109 ! ------------------------------------ 00110 IF (LHOOK) CALL DR_HOOK('ECUME_SEAFLUX',0,ZHOOK_HANDLE) 00111 ! 00112 IR_WATER(:)=0 00113 IR_ICE(:)=0 00114 J1=0 00115 J2=0 00116 ! 00117 DO JJ=1,SIZE(PSST(:)) 00118 IF (PMASK(JJ) >=0.0 ) THEN 00119 J1 = J1 + 1 00120 IR_WATER(J1)= JJ 00121 ELSE 00122 J2 = J2 + 1 00123 IR_ICE(J2)= JJ 00124 ENDIF 00125 END DO 00126 ! 00127 !------------------------------------------------------------------------------- 00128 ! 00129 ! 2. water sea : call to ECUME_FLUX 00130 ! ------------------------------------------------ 00131 ! 00132 IF (KSIZE_WATER > 0 ) CALL TREAT_SURF(IR_WATER,'W') 00133 ! 00134 !------------------------------------------------------------------------------- 00135 ! 00136 ! 3. sea ice : call to ICE_SEA_FLUX 00137 ! ------------------------------------ 00138 ! 00139 IF (KSIZE_ICE > 0 ) CALL TREAT_SURF(IR_ICE,'I') 00140 ! 00141 IF (LHOOK) CALL DR_HOOK('ECUME_SEAFLUX',1,ZHOOK_HANDLE) 00142 !------------------------------------------------------------------------------- 00143 ! 00144 CONTAINS 00145 00146 SUBROUTINE TREAT_SURF(KMASK,YTYPE) 00147 ! 00148 IMPLICIT NONE 00149 ! 00150 INTEGER, INTENT(IN), DIMENSION(:) :: KMASK 00151 CHARACTER(LEN=1), INTENT(IN) :: YTYPE 00152 ! 00153 REAL, DIMENSION(SIZE(KMASK)) :: ZW_TA ! air temperature at atm. level (K) 00154 REAL, DIMENSION(SIZE(KMASK)) :: ZW_QA ! air humidity at atm. level (kg/kg) 00155 REAL, DIMENSION(SIZE(KMASK)) :: ZW_EXNA ! Exner function at atm. level 00156 REAL, DIMENSION(SIZE(KMASK)) :: ZW_RHOA ! air density at atm. level 00157 REAL, DIMENSION(SIZE(KMASK)) :: ZW_VMOD ! module of wind at atm. wind level (m/s) 00158 REAL, DIMENSION(SIZE(KMASK)) :: ZW_ZREF ! atm. level for temp. and humidity (m) 00159 REAL, DIMENSION(SIZE(KMASK)) :: ZW_UREF ! atm. level for wind (m) 00160 REAL, DIMENSION(SIZE(KMASK)) :: ZW_SST ! Sea Surface Temperature (K) 00161 REAL, DIMENSION(SIZE(KMASK)) :: ZW_EXNS ! Exner function at sea surface 00162 REAL, DIMENSION(SIZE(KMASK)) :: ZW_PS ! air pressure at sea surface (Pa) 00163 REAL, DIMENSION(SIZE(KMASK)) :: ZW_RAIN !precipitation rate (kg/s/m2) 00164 REAL, DIMENSION(SIZE(KMASK)) :: ZW_SNOW !snow rate (kg/s/m2) 00165 ! 00166 REAL, DIMENSION(SIZE(KMASK)) :: ZW_Z0SEA! roughness length over the ocean 00167 ! 00168 ! surface fluxes : latent heat, sensible heat, friction fluxes 00169 REAL, DIMENSION(SIZE(KMASK)) :: ZW_SFTH ! heat flux (W/m2) 00170 REAL, DIMENSION(SIZE(KMASK)) :: ZW_SFTQ ! water flux (kg/m2/s) 00171 REAL, DIMENSION(SIZE(KMASK)) :: ZW_USTAR! friction velocity (m/s) 00172 ! 00173 ! diagnostics 00174 REAL, DIMENSION(SIZE(KMASK)) :: ZW_QSAT ! humidity at saturation 00175 REAL, DIMENSION(SIZE(KMASK)) :: ZW_CD ! heat drag coefficient 00176 REAL, DIMENSION(SIZE(KMASK)) :: ZW_CDN ! momentum drag coefficient 00177 REAL, DIMENSION(SIZE(KMASK)) :: ZW_CH ! neutral momentum drag coefficient 00178 REAL, DIMENSION(SIZE(KMASK)) :: ZW_CE !transfer coef. for latent heat flux 00179 REAL, DIMENSION(SIZE(KMASK)) :: ZW_RI ! Richardson number 00180 REAL, DIMENSION(SIZE(KMASK)) :: ZW_RESA ! aerodynamical resistance 00181 REAL, DIMENSION(SIZE(KMASK)) :: ZW_Z0HSEA ! heat roughness length 00182 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00183 ! 00184 IF (LHOOK) CALL DR_HOOK('ECUME_SEAFLUX:TREAT_SURF',0,ZHOOK_HANDLE) 00185 DO JJ=1, SIZE(KMASK) 00186 ZW_TA(JJ) = PTA(KMASK(JJ)) 00187 ZW_QA(JJ) = PQA(KMASK(JJ)) 00188 ZW_EXNA(JJ) = PEXNA(KMASK(JJ)) 00189 ZW_RHOA(JJ) = PRHOA(KMASK(JJ)) 00190 ZW_VMOD(JJ) = PVMOD(KMASK(JJ)) 00191 ZW_ZREF(JJ) = PZREF(KMASK(JJ)) 00192 ZW_UREF(JJ) = PUREF(KMASK(JJ)) 00193 ZW_SST(JJ) = PSST(KMASK(JJ)) 00194 ZW_EXNS(JJ) = PEXNS(KMASK(JJ)) 00195 ZW_PS(JJ) = PPS(KMASK(JJ)) 00196 ZW_QSAT(JJ) = PQSAT(KMASK(JJ)) 00197 ZW_RAIN(JJ) = PRAIN(KMASK(JJ)) 00198 ZW_SNOW(JJ) = PSNOW(KMASK(JJ)) 00199 ZW_Z0SEA(JJ)= PZ0SEA(KMASK(JJ)) 00200 ZW_SFTH(JJ) = PSFTH(KMASK(JJ)) 00201 ZW_SFTQ(JJ) = PSFTQ(KMASK(JJ)) 00202 ZW_USTAR(JJ) = PUSTAR(KMASK(JJ)) 00203 ZW_CD(JJ) = PCD(KMASK(JJ)) 00204 ZW_CDN(JJ) = PCDN(KMASK(JJ)) 00205 ZW_CH(JJ) = PCH(KMASK(JJ)) 00206 ZW_CE(JJ) = PCE(KMASK(JJ)) 00207 ZW_RI(JJ) = PRI(KMASK(JJ)) 00208 ZW_RESA(JJ) = PRESA(KMASK(JJ)) 00209 ZW_Z0HSEA(JJ) = PZ0HSEA(KMASK(JJ)) 00210 END DO 00211 ! 00212 IF (YTYPE=='W') THEN 00213 ! 00214 CALL ECUME_FLUX(ZW_Z0SEA,ZW_TA,ZW_EXNA,ZW_RHOA,ZW_SST,ZW_EXNS, & 00215 ZW_QA,ZW_VMOD,ZW_ZREF,ZW_UREF,ZW_PS,PICHCE,OPRECIP,OPWEBB,OPWG,& 00216 ZW_QSAT,ZW_SFTH,ZW_SFTQ,ZW_USTAR,ZW_CD,ZW_CDN,ZW_CH,ZW_CE, & 00217 ZW_RI,ZW_RESA,ZW_RAIN,ZW_Z0HSEA) 00218 ! 00219 ELSEIF (YTYPE=='I') THEN 00220 ! 00221 CALL ICE_SEA_FLUX(ZW_Z0SEA,ZW_TA,ZW_EXNA,ZW_RHOA,ZW_SST,ZW_EXNS,ZW_QA,ZW_RAIN,ZW_SNOW, & 00222 ZW_VMOD,ZW_ZREF,ZW_UREF,ZW_PS,ZW_QSAT,ZW_SFTH,ZW_SFTQ,ZW_USTAR,ZW_CD, & 00223 ZW_CDN,ZW_CH,ZW_RI,ZW_RESA,ZW_Z0HSEA) 00224 ! 00225 ENDIF 00226 ! 00227 DO JJ=1, SIZE(KMASK) 00228 PQSAT(KMASK(JJ)) = ZW_QSAT(JJ) 00229 PZ0SEA(KMASK(JJ))= ZW_Z0SEA(JJ) 00230 PSFTH(KMASK(JJ)) = ZW_SFTH(JJ) 00231 PSFTQ(KMASK(JJ)) = ZW_SFTQ(JJ) 00232 PUSTAR(KMASK(JJ))= ZW_USTAR(JJ) 00233 PCD(KMASK(JJ)) = ZW_CD(JJ) 00234 PCDN(KMASK(JJ)) = ZW_CDN(JJ) 00235 PCH(KMASK(JJ)) = ZW_CH(JJ) 00236 PCE(KMASK(JJ)) = ZW_CE(JJ) 00237 PRI(KMASK(JJ)) = ZW_RI(JJ) 00238 PRESA(KMASK(JJ)) = ZW_RESA(JJ) 00239 PZ0HSEA(KMASK(JJ)) = ZW_Z0HSEA(JJ) 00240 END DO 00241 IF (LHOOK) CALL DR_HOOK('ECUME_SEAFLUX:TREAT_SURF',1,ZHOOK_HANDLE) 00242 END SUBROUTINE TREAT_SURF 00243 ! 00244 END SUBROUTINE ECUME_SEAFLUX
1.8.0
