|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE PREP_PERM_SNOW(TPSNOW,PTG,PPERM_SNOW_FRAC,KSNOW) 00003 ! ################################################ 00004 ! 00005 ! 00006 !!**** *PREP_PERM_SNOW* - takes into account permanent snow into prognostic snow 00007 !! 00008 !! PURPOSE 00009 !! ------- 00010 ! 00011 !!** METHOD 00012 !! ------ 00013 !! 00014 !! REFERENCE 00015 !! --------- 00016 !! 00017 !! 00018 !! AUTHOR 00019 !! ------ 00020 !! V. Masson 00021 !! 00022 !! MODIFICATIONS 00023 !! ------------- 00024 !! Original 01/2004 00025 !! B. Decharme 03/2009: Consistency with Arpege permanent 00026 !! snow/ice treatment 00027 !! B. Decharme 07/2012: 3-L or Crocus adjustments 00028 !! M. Lafaysse 09/2012: adaptation with new snow age in Crocus 00029 !!------------------------------------------------------------------ 00030 ! 00031 00032 USE MODD_TYPE_SNOW 00033 USE MODD_CSTS, ONLY : XTT 00034 USE MODD_DATA_COVER_PAR, ONLY : NVT_SNOW 00035 USE MODD_SNOW_PAR, ONLY : XRHOSMAX, XANSMAX, XANSMIN, & 00036 XAGLAMAX, XAGLAMIN, XHGLA, & 00037 XRHOSMAX_ES 00038 USE MODD_SURF_PAR, ONLY : XUNDEF 00039 ! 00040 USE MODD_ISBA_PAR, ONLY : XWGMIN 00041 USE MODD_ISBA_n, ONLY : CISBA,XWG,XWGI,XWSAT, & 00042 NGROUND_LAYER,LGLACIER, & 00043 TTIME 00044 ! 00045 USE MODI_SNOW_HEAT_TO_T_WLIQ 00046 USE MODI_SNOW_T_WLIQ_TO_HEAT 00047 USE MODI_MKFLAG_SNOW 00048 USE MODE_SURF_SNOW_FRAC 00049 USE MODE_SNOW3L 00050 ! 00051 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00052 USE PARKIND1 ,ONLY : JPRB 00053 ! 00054 IMPLICIT NONE 00055 ! 00056 !* 0.1 declarations of arguments 00057 ! 00058 TYPE(SURF_SNOW), INTENT(INOUT) :: TPSNOW ! snow mantel characteristics 00059 REAL, DIMENSION(:,:), INTENT(IN):: PTG ! soil temperature for patch KSNOW 00060 REAL, DIMENSION(:,:), INTENT(IN):: PPERM_SNOW_FRAC ! fraction of permanent snow for patch KSNOW 00061 INTEGER, INTENT(IN):: KSNOW ! patch number where permanent snow is 00062 ! 00063 !* 0.2 declarations of local variables 00064 ! 00065 INTEGER :: JLAYER ! loop counter on snow layers 00066 REAL, DIMENSION(:), ALLOCATABLE :: ZWSNOW_PERM ! snow total reservoir due to perm. snow 00067 REAL, DIMENSION(:), ALLOCATABLE :: ZWSNOW ! initial snow total reservoir 00068 REAL, DIMENSION(:), ALLOCATABLE :: ZD ! new snow total depth 00069 REAL, DIMENSION(:,:), ALLOCATABLE :: ZDEPTH ! depth of each layer 00070 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZT ! new snow temperature profile 00071 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWLIQ ! liquid water in the snow 00072 REAL, DIMENSION(:), ALLOCATABLE :: ZPSN ! permanent snow fraction 00073 ! 00074 LOGICAL, DIMENSION(:), ALLOCATABLE :: LWORK 00075 INTEGER :: IWORK 00076 ! 00077 REAL ::ZRHOSMAX 00078 REAL ::ZAGE_NOW 00079 ! 00080 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00081 ! 00082 !------------------------------------------------------------------------------------- 00083 ! 00084 !* 1. Snow where permanent snow is 00085 ! ---------------------------- 00086 ! 00087 !* snow fraction must be at least equal to permanent snow fraction 00088 ! The snow fraction is computed as Wsnow/(Wsnow+XWCRN) 00089 ! 00090 ! 00091 IF (LHOOK) CALL DR_HOOK('PREP_PERM_SNOW',0,ZHOOK_HANDLE) 00092 ! 00093 ZRHOSMAX=XRHOSMAX 00094 IF(TPSNOW%SCHEME=='3-L'.OR.TPSNOW%SCHEME=='CRO')THEN 00095 ZRHOSMAX=XRHOSMAX_ES 00096 ENDIF 00097 ! 00098 ALLOCATE(ZPSN(SIZE(PTG,1))) 00099 ZPSN(:) = MIN ( PPERM_SNOW_FRAC(:,NVT_SNOW) , 0.9999 ) 00100 ! 00101 !* if no permanent snow present 00102 ! 00103 IF (ALL(ZPSN(:)==0.)) THEN 00104 DEALLOCATE(ZPSN) 00105 IF (LHOOK) CALL DR_HOOK('PREP_PERM_SNOW',1,ZHOOK_HANDLE) 00106 RETURN 00107 END IF 00108 ! 00109 !* total snow amount due to permanent snow 00110 ! 00111 ALLOCATE(ZWSNOW_PERM(SIZE(PTG,1))) 00112 ZWSNOW_PERM(:) = WSNOW_FROM_SNOW_FRAC_GROUND(ZPSN) 00113 ! 00114 !* limitation of maximum snow amount 00115 ! 00116 IF(LGLACIER)THEN 00117 ! limited to 33.3 meters of aged snow 00118 ZWSNOW_PERM(:) = MIN(ZWSNOW_PERM(:),XHGLA * ZRHOSMAX ) 00119 ELSE 00120 ! limited to 2. meters of aged snow 00121 ZWSNOW_PERM(:) = MIN(ZWSNOW_PERM(:),2.0 * ZRHOSMAX ) 00122 ENDIF 00123 ! 00124 !* permanent snow can be added only if deep soil temperature is below 5 C 00125 ! (glaciers on subgrid mountains tops that are contained in the grid mesh are neglected) 00126 ! 00127 IF(.NOT.LGLACIER)THEN 00128 WHERE(PTG(:,SIZE(PTG,2))>XTT+5.) ZWSNOW_PERM(:) = 0. 00129 ENDIF 00130 ! 00131 !------------------------------------------------------------------------------------- 00132 ! 00133 !* 2. Other parameters of new snow, except temperature 00134 ! ------------------------------------------------ 00135 ! 00136 !* rho must be defined for snow 3-L before temperature and heat computations 00137 ! 00138 !* rho 00139 ! 00140 ALLOCATE(LWORK(SIZE(PTG,1))) 00141 ! 00142 DO JLAYER=1,TPSNOW%NLAYER 00143 ! 00144 LWORK(:)=.FALSE. 00145 ! 00146 IF(LGLACIER)THEN 00147 WHERE(ZWSNOW_PERM(:)>0.)LWORK(:)=.TRUE. 00148 ELSE 00149 WHERE(ZWSNOW_PERM(:)>0..AND.TPSNOW%WSNOW(:,JLAYER,KSNOW)==0.)LWORK(:)=.TRUE. 00150 ENDIF 00151 ! 00152 WHERE(LWORK(:)) 00153 TPSNOW%RHO(:,JLAYER,KSNOW) = ZRHOSMAX 00154 END WHERE 00155 ! 00156 !* albedo 00157 ! 00158 IF(LGLACIER)THEN 00159 WHERE(LWORK(:)) 00160 TPSNOW%ALB(:,KSNOW) = (XAGLAMAX+XAGLAMIN)/2.0 00161 END WHERE 00162 ELSE 00163 WHERE(LWORK(:)) 00164 TPSNOW%ALB(:,KSNOW) = (XANSMAX+XANSMIN)/2.0 00165 END WHERE 00166 ENDIF 00167 ! 00168 END DO 00169 ! 00170 IF (TPSNOW%SCHEME=='CRO') THEN 00171 00172 DO JLAYER=1,TPSNOW%NLAYER/4 00173 WHERE(LWORK(:)) 00174 !TPSNOW%RHO(:,JLAYER,KSNOW) = ZRHOSMAX* & 00175 ! (1.+ FLOAT(JLAYER)/FLOAT(TPSNOW%NLAYER)) 00176 TPSNOW%GRAN1(:,JLAYER,KSNOW) = MIN(-1.,-99.* & 00177 (1.-4*FLOAT(JLAYER)/FLOAT(TPSNOW%NLAYER))) 00178 TPSNOW%GRAN2(:,JLAYER,KSNOW) = 50. 00179 TPSNOW%HIST(:,JLAYER,KSNOW) = 0 00180 TPSNOW%AGE(:,JLAYER,KSNOW) = 365.*FLOAT(JLAYER-1)/ & 00181 FLOAT(TPSNOW%NLAYER) 00182 END WHERE 00183 END DO 00184 DO JLAYER=1+TPSNOW%NLAYER/4,TPSNOW%NLAYER 00185 WHERE(LWORK(:)) 00186 !TPSNOW%RHO(:,JLAYER,KSNOW) = ZRHOSMAX* & 00187 ! (1.+ FLOAT(JLAYER)/FLOAT(TPSNOW%NLAYER)) 00188 TPSNOW%GRAN1(:,JLAYER,KSNOW) = 99. 00189 TPSNOW%GRAN2(:,JLAYER,KSNOW) = 0.0003 00190 TPSNOW%HIST(:,JLAYER,KSNOW) = 0 00191 TPSNOW%AGE(:,JLAYER,KSNOW) = 3650.*FLOAT(JLAYER-1)/ & 00192 FLOAT(TPSNOW%NLAYER) 00193 END WHERE 00194 END DO 00195 END IF 00196 ! 00197 !------------------------------------------------------------------------------------- 00198 ! 00199 !* 3. Modification of snow reservoir profile 00200 ! -------------------------------------- 00201 ! 00202 !* initial snow content 00203 ! 00204 ALLOCATE(ZWSNOW(SIZE(PTG,1))) 00205 ZWSNOW(:) = 0. 00206 DO JLAYER=1,TPSNOW%NLAYER 00207 ZWSNOW(:) = ZWSNOW(:) + TPSNOW%WSNOW(:,JLAYER,KSNOW) 00208 END DO 00209 ! 00210 !* new total snow content 00211 ! 00212 ZWSNOW_PERM(:) = MAX(ZWSNOW_PERM(:),ZWSNOW(:)) 00213 ! 00214 !* new total snow depth 00215 ! 00216 ALLOCATE(ZD(SIZE(PTG,1))) 00217 ZD(:) = 0. 00218 DO JLAYER=1,TPSNOW%NLAYER 00219 ZD(:) = ZD(:) + TPSNOW%WSNOW(:,JLAYER,KSNOW)/TPSNOW%RHO(:,JLAYER,KSNOW) 00220 END DO 00221 ZD(:) = ZD(:) + (ZWSNOW_PERM(:)-ZWSNOW(:))/ZRHOSMAX 00222 ! 00223 !* modified snow content profile 00224 ! 00225 SELECT CASE(TPSNOW%SCHEME) 00226 CASE('D95','1-L','EBA') 00227 LWORK(:)=.FALSE. 00228 IF(LGLACIER)THEN 00229 WHERE(ZWSNOW(:)>=0..AND.TPSNOW%WSNOW(:,1,KSNOW)/=XUNDEF)LWORK(:)=.TRUE. 00230 ELSE 00231 WHERE(ZWSNOW(:)==0..AND.TPSNOW%WSNOW(:,1,KSNOW)/=XUNDEF)LWORK(:)=.TRUE. 00232 ENDIF 00233 WHERE(LWORK(:)) 00234 TPSNOW%WSNOW(:,1,KSNOW) = ZWSNOW_PERM(:) 00235 END WHERE 00236 CASE('3-L','CRO') 00237 !* grid 00238 ALLOCATE(ZDEPTH(SIZE(PTG,1),TPSNOW%NLAYER)) 00239 CALL SNOW3LGRID(ZDEPTH,ZD) 00240 DO JLAYER=1,TPSNOW%NLAYER 00241 WHERE(ZWSNOW(:)> 0. .AND. TPSNOW%WSNOW(:,JLAYER,KSNOW)/=XUNDEF) 00242 TPSNOW%WSNOW(:,JLAYER,KSNOW) = ZDEPTH(:,JLAYER) * TPSNOW%RHO(:,JLAYER,KSNOW) 00243 END WHERE 00244 WHERE(ZWSNOW(:)==0. .AND. TPSNOW%WSNOW(:,JLAYER,KSNOW)/=XUNDEF) 00245 TPSNOW%WSNOW(:,JLAYER,KSNOW) = ZDEPTH(:,JLAYER) * ZRHOSMAX 00246 END WHERE 00247 END DO 00248 DEALLOCATE(ZDEPTH) 00249 00250 END SELECT 00251 ! 00252 DEALLOCATE(ZD) 00253 DEALLOCATE(LWORK) 00254 !------------------------------------------------------------------------------------- 00255 ! 00256 !* 4. Temperature of new snow 00257 ! ----------------------- 00258 ! 00259 ALLOCATE(ZT (SIZE(TPSNOW%WSNOW,1),SIZE(TPSNOW%WSNOW,2),SIZE(TPSNOW%WSNOW,3))) 00260 ALLOCATE(ZWLIQ(SIZE(TPSNOW%WSNOW,1),SIZE(TPSNOW%WSNOW,2),SIZE(TPSNOW%WSNOW,3))) 00261 ! 00262 SELECT CASE(TPSNOW%SCHEME) 00263 CASE('1-L') 00264 ZT(:,:,:) = TPSNOW%T (:,:,:) 00265 CASE('3-L','CRO') 00266 CALL SNOW_HEAT_TO_T_WLIQ(TPSNOW%HEAT,TPSNOW%RHO,ZT,ZWLIQ) 00267 END SELECT 00268 ! 00269 !* new snow is set to deep ground temperature 00270 ! 00271 DO JLAYER=1,TPSNOW%NLAYER 00272 WHERE(ZWSNOW_PERM(:)>0. .AND. ZWSNOW(:)==0.) 00273 ZT(:,JLAYER,KSNOW) = MIN(PTG(:,SIZE(PTG,2)), XTT) 00274 END WHERE 00275 END DO 00276 ! 00277 SELECT CASE(TPSNOW%SCHEME) 00278 CASE('1-L') 00279 TPSNOW%T (:,:,:) = ZT(:,:,:) 00280 CASE('3-L','CRO') 00281 CALL SNOW_T_WLIQ_TO_HEAT(TPSNOW%HEAT,TPSNOW%RHO,ZT,ZWLIQ) 00282 END SELECT 00283 ! 00284 DEALLOCATE(ZT ) 00285 DEALLOCATE(ZWLIQ) 00286 ! 00287 ! 00288 !------------------------------------------------------------------------------------- 00289 ! 00290 !* 5. Soil ice initialization for LGLACIER 00291 ! ----------------------- 00292 ! 00293 IF(LGLACIER)THEN 00294 ! 00295 IF (CISBA == 'DIF') THEN 00296 IWORK=NGROUND_LAYER 00297 ELSE 00298 IWORK=2 00299 ENDIF 00300 ! 00301 DO JLAYER=1,IWORK 00302 WHERE(PPERM_SNOW_FRAC(:,NVT_SNOW)>0.0) 00303 XWGI(:,JLAYER,KSNOW) = MAX(XWGI(:,JLAYER,KSNOW),XWSAT(:,JLAYER)*ZPSN(:)) 00304 XWG (:,JLAYER,KSNOW) = MIN(XWG (:,JLAYER,KSNOW),MAX(XWSAT(:,JLAYER)-XWGI(:,JLAYER,KSNOW),XWGMIN)) 00305 END WHERE 00306 WHERE(XWG(:,JLAYER,KSNOW) /= XUNDEF .AND. (XWG(:,JLAYER,KSNOW) + XWGI(:,JLAYER,KSNOW)) > XWSAT(:,JLAYER) ) 00307 XWGI(:,JLAYER,KSNOW) = XWSAT(:,JLAYER)-XWG (:,JLAYER,KSNOW) !WGT<=WSAT 00308 END WHERE 00309 ENDDO 00310 ! 00311 ENDIF 00312 ! 00313 DEALLOCATE(ZPSN) 00314 ! 00315 !------------------------------------------------------------------------------------- 00316 ! 00317 !* 6. Masking where there is no snow 00318 ! ------------------------------ 00319 ! 00320 CALL MKFLAG_SNOW(TPSNOW) 00321 IF (LHOOK) CALL DR_HOOK('PREP_PERM_SNOW',1,ZHOOK_HANDLE) 00322 ! 00323 !------------------------------------------------------------------------------------- 00324 ! 00325 END SUBROUTINE PREP_PERM_SNOW
1.8.0
