|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE PREP_VER_SNOW(TPSNOW,PZS_LS,PZS,PTG_LS,PTG,KDEEP_SOIL) 00003 ! ########################################### 00004 ! 00005 ! 00006 !!**** *PREP_VER_SNOW* - change in snow variables due to altitude change 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 !!------------------------------------------------------------------ 00026 ! 00027 00028 USE MODD_TYPE_SNOW 00029 USE MODD_CSTS, ONLY : XTT 00030 USE MODD_PREP, ONLY : XT_CLIM_GRAD 00031 USE MODD_PREP_SNOW, ONLY : XWSNOW_CLIM_GRAD 00032 USE MODD_SURF_PAR, ONLY : XUNDEF 00033 ! 00034 USE MODI_SNOW_HEAT_TO_T_WLIQ 00035 USE MODI_SNOW_T_WLIQ_TO_HEAT 00036 USE MODI_MKFLAG_SNOW 00037 ! 00038 ! 00039 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00040 USE PARKIND1 ,ONLY : JPRB 00041 ! 00042 IMPLICIT NONE 00043 ! 00044 !* 0.1 declarations of arguments 00045 ! 00046 TYPE(SURF_SNOW), INTENT(INOUT) :: TPSNOW ! snow mantel characteristics 00047 REAL, DIMENSION(:), INTENT(IN) :: PZS_LS ! initial orography 00048 REAL, DIMENSION(:), INTENT(IN) :: PZS ! final orography 00049 REAL, DIMENSION(:,:,:),INTENT(IN),OPTIONAL:: PTG_LS ! soil temperature on initial orography 00050 REAL, DIMENSION(:,:,:),INTENT(IN),OPTIONAL:: PTG ! soil temperature on final orography 00051 INTEGER, INTENT(IN),OPTIONAL:: KDEEP_SOIL ! index of deep soil temperature 00052 ! 00053 !* 0.2 declarations of local variables 00054 ! 00055 INTEGER :: IPATCH ! number of patches 00056 INTEGER :: JPATCH ! loop counter on patches 00057 INTEGER :: JLAYER ! loop counter on snow layers 00058 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWSNOW_LS ! snow reservoir on initial orography 00059 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTSNOW_LS ! snow temperature on initial orography 00060 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWSNOW ! snow content on final orography 00061 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTSNOW ! snow temperature on final orography 00062 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWSNOW2 ! snow content on final orography 00063 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTSNOW2 ! snow temperature on final orography 00064 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWLIQ ! snow liquid water content 00065 REAL, DIMENSION(:,:), ALLOCATABLE :: ZZSFREEZE ! altitude where deep soil freezes 00066 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00067 ! 00068 !------------------------------------------------------------------------------------- 00069 ! 00070 IF (LHOOK) CALL DR_HOOK('PREP_VER_SNOW',0,ZHOOK_HANDLE) 00071 IPATCH = SIZE(TPSNOW%WSNOW,3) 00072 ! 00073 !* 1. Snow reservoir on initial orography 00074 ! ----------------------------------- 00075 ! 00076 ALLOCATE(ZWSNOW_LS(SIZE(TPSNOW%WSNOW,1),SIZE(TPSNOW%WSNOW,2),IPATCH)) 00077 ZWSNOW_LS(:,:,:) = TPSNOW%WSNOW(:,:,:) 00078 ! 00079 !------------------------------------------------------------------------------------- 00080 ! 00081 !* 2. temperature of snow on initial orography 00082 ! ---------------------------------------- 00083 ! 00084 ALLOCATE(ZTSNOW_LS(SIZE(TPSNOW%WSNOW,1),SIZE(TPSNOW%WSNOW,2),IPATCH)) 00085 SELECT CASE(TPSNOW%SCHEME) 00086 CASE ('D95','EBA') 00087 IF (PRESENT(PTG_LS)) THEN 00088 DO JPATCH=1,IPATCH 00089 ZTSNOW_LS(:,1,JPATCH) = MIN(PTG_LS(:,1,JPATCH),XTT) 00090 END DO 00091 ELSE 00092 ZTSNOW_LS = XUNDEF 00093 END IF 00094 CASE ('1-L') 00095 ZTSNOW_LS(:,:,:) = TPSNOW%T(:,:,:) 00096 CASE ('3-L','CRO') 00097 CALL SNOW_HEAT_TO_T_WLIQ(TPSNOW%HEAT(:,:,:),TPSNOW%RHO(:,:,:),ZTSNOW_LS(:,:,:)) 00098 END SELECT 00099 ! 00100 !------------------------------------------------------------------------------------- 00101 ! 00102 !* 3. vertical shift of temperature 00103 ! ----------------------------- 00104 ! 00105 ALLOCATE(ZTSNOW(SIZE(TPSNOW%WSNOW,1),SIZE(TPSNOW%WSNOW,2),IPATCH)) 00106 DO JPATCH=1,IPATCH 00107 DO JLAYER=1,TPSNOW%NLAYER 00108 ZTSNOW(:,JLAYER,JPATCH) = ZTSNOW_LS(:,JLAYER,JPATCH) + XT_CLIM_GRAD * (PZS(:) - PZS_LS(:)) 00109 END DO 00110 END DO 00111 ! 00112 !------------------------------------------------------------------------------------- 00113 ! 00114 !* 4. vertical shift of snow content where snow already exists 00115 ! ------------------------------ 00116 ! 00117 !* use of climatological snow content gradient 00118 ! 00119 ALLOCATE(ZWSNOW(SIZE(TPSNOW%WSNOW,1),SIZE(TPSNOW%WSNOW,2),IPATCH)) 00120 ! 00121 ZWSNOW(:,:,:) = ZWSNOW_LS(:,:,:) 00122 ! 00123 IF (PRESENT(PTG)) THEN 00124 DO JPATCH=1,IPATCH 00125 DO JLAYER=1,TPSNOW%NLAYER 00126 WHERE(ZWSNOW_LS(:,JLAYER,JPATCH)>0..AND.((PTG(:,KDEEP_SOIL,JPATCH)-XTT >= 2.).OR.(PZS(:) > PZS_LS(:)))) 00127 ZWSNOW(:,JLAYER,JPATCH) = ZWSNOW_LS(:,JLAYER,JPATCH) + XWSNOW_CLIM_GRAD * (PZS(:) - PZS_LS(:)) 00128 ZWSNOW(:,JLAYER,JPATCH) = MAX(ZWSNOW(:,JLAYER,JPATCH),0.) 00129 END WHERE 00130 END DO 00131 END DO 00132 ELSE 00133 DO JPATCH=1,IPATCH 00134 DO JLAYER=1,TPSNOW%NLAYER 00135 WHERE(ZWSNOW_LS(:,JLAYER,JPATCH)>0.) 00136 ZWSNOW(:,JLAYER,JPATCH) = ZWSNOW_LS(:,JLAYER,JPATCH) + XWSNOW_CLIM_GRAD * (PZS(:) - PZS_LS(:)) 00137 ZWSNOW(:,JLAYER,JPATCH) = MAX(ZWSNOW(:,JLAYER,JPATCH),0.) 00138 END WHERE 00139 END DO 00140 END DO 00141 ENDIF 00142 ! 00143 WHERE(TPSNOW%WSNOW(:,:,:)/=XUNDEF) TPSNOW%WSNOW = ZWSNOW 00144 ! 00145 !------------------------------------------------------------------------------------- 00146 ! 00147 ! 5. Where snow did not exist on initial orography 00148 ! --------------------------------------------- 00149 ! 00150 !* in this case, new snow can appear only if orography differences in larger 00151 ! than 1000m, and starts at an altitude where the deep soil temperature becomes negative 00152 ! 00153 !* the same climatological gradient is used, but the value zero for the snow 00154 ! content is defined as the altitude where deep soil freezes. 00155 ! 00156 !* 5.1 Altitude where deep soil freezes (only if soil temperatures are provided) 00157 ! -------------------------------- 00158 ! 00159 IF (PRESENT(PTG)) THEN 00160 ALLOCATE(ZZSFREEZE(SIZE(TPSNOW%WSNOW,1),IPATCH)) 00161 DO JPATCH=1,IPATCH 00162 ZZSFREEZE(:,JPATCH) = PZS & 00163 + (XTT - PTG(:,KDEEP_SOIL,JPATCH)) / XT_CLIM_GRAD 00164 END DO 00165 ! 00166 !* 5.2 Amount and Temperature of new snow (only if soil temperatures are provided) 00167 ! ---------------------------------- 00168 ! 00169 !* Snow temperature is then defined as the deep soil temperature at the final 00170 ! altitude. 00171 ! 00172 ALLOCATE(ZWSNOW2(SIZE(TPSNOW%WSNOW,1),TPSNOW%NLAYER,IPATCH)) 00173 ALLOCATE(ZTSNOW2(SIZE(TPSNOW%WSNOW,1),TPSNOW%NLAYER,IPATCH)) 00174 DO JPATCH=1,IPATCH 00175 DO JLAYER=1,TPSNOW%NLAYER 00176 ZWSNOW2(:,JLAYER,JPATCH) = XWSNOW_CLIM_GRAD * (PZS(:) - ZZSFREEZE(:,JPATCH)) 00177 ZWSNOW2(:,JLAYER,JPATCH) = MAX(ZWSNOW2(:,JLAYER,JPATCH),0.) 00178 ZTSNOW2 (:,JLAYER,JPATCH) = PTG(:,KDEEP_SOIL,JPATCH) 00179 END DO 00180 END DO 00181 ! 00182 !* 5.3 Apply maximum between this value and the shifted one 00183 ! ---------------------------------------------------- 00184 ! 00185 DO JPATCH=1,IPATCH 00186 DO JLAYER=1,TPSNOW%NLAYER 00187 WHERE(TPSNOW%WSNOW(:,JLAYER,JPATCH)/=XUNDEF .AND. ZWSNOW_LS(:,JLAYER,JPATCH)==0. & 00188 .AND. (PZS(:)-PZS_LS(:))>1000. ) 00189 TPSNOW%WSNOW(:,JLAYER,JPATCH) = ZWSNOW2(:,JLAYER,JPATCH) 00190 ZTSNOW (:,JLAYER,JPATCH) = ZTSNOW2(:,JLAYER,JPATCH) 00191 END WHERE 00192 END DO 00193 END DO 00194 00195 DEALLOCATE(ZZSFREEZE) 00196 DEALLOCATE(ZWSNOW2 ) 00197 DEALLOCATE(ZTSNOW2 ) 00198 END IF 00199 ! 00200 !------------------------------------------------------------------------------------- 00201 ! 00202 !* 6. Coherence between temperature and snow content 00203 ! ---------------------------------------------- 00204 ! 00205 SELECT CASE(TPSNOW%SCHEME) 00206 CASE('1-L') 00207 !* snow temperature cannot be larger than 0 C 00208 TPSNOW%T (:,:,:) = MIN ( ZTSNOW(:,:,:), XTT ) 00209 CASE('3-L','CRO') 00210 ALLOCATE(ZWLIQ(SIZE(TPSNOW%WSNOW,1),SIZE(TPSNOW%WSNOW,2),IPATCH)) 00211 CALL SNOW_T_WLIQ_TO_HEAT(TPSNOW%HEAT,TPSNOW%RHO,ZTSNOW) 00212 CALL SNOW_HEAT_TO_T_WLIQ(TPSNOW%HEAT,TPSNOW%RHO,ZTSNOW,ZWLIQ) 00213 CALL SNOW_T_WLIQ_TO_HEAT(TPSNOW%HEAT,TPSNOW%RHO,ZTSNOW,ZWLIQ) 00214 DEALLOCATE(ZWLIQ) 00215 END SELECT 00216 ! 00217 !------------------------------------------------------------------------------------- 00218 ! 00219 !* 7. Masking where there is no snow 00220 ! ------------------------------ 00221 ! 00222 CALL MKFLAG_SNOW(TPSNOW) 00223 ! 00224 !------------------------------------------------------------------------------------- 00225 DEALLOCATE(ZWSNOW_LS) 00226 DEALLOCATE(ZTSNOW_LS) 00227 DEALLOCATE(ZWSNOW ) 00228 DEALLOCATE(ZTSNOW ) 00229 IF (LHOOK) CALL DR_HOOK('PREP_VER_SNOW',1,ZHOOK_HANDLE) 00230 !------------------------------------------------------------------------------------- 00231 ! 00232 END SUBROUTINE PREP_VER_SNOW
1.8.0
