|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE PREP_VER_ISBA 00003 ! ################################################################################# 00004 ! 00005 !!**** *PREP_VER_ISBA* - change in ISBA fields due to altitude change 00006 !! 00007 !! PURPOSE 00008 !! ------- 00009 ! 00010 !!** METHOD 00011 !! ------ 00012 !! 00013 !! REFERENCE 00014 !! --------- 00015 !! 00016 !! 00017 !! AUTHOR 00018 !! ------ 00019 !! V. Masson 00020 !! 00021 !! MODIFICATIONS 00022 !! ------------- 00023 !! Original 01/2004 00024 !! Modified by B. Decharme (01/2009), Optional Arpege deep soil temperature initialization 00025 !! S. Riette 04/2010 Modification of XTG corrections after freezing 00026 !!------------------------------------------------------------------ 00027 ! 00028 00029 ! 00030 USE MODD_ISBA_n, ONLY : XZS, XTG, XWG, XWGI, XWSAT, TSNOW, & 00031 CISBA, XDG, NGROUND_LAYER, & 00032 LTEMP_ARP, NTEMPLAYER_ARP 00033 USE MODD_ISBA_PAR, ONLY : XWGMIN 00034 USE MODD_SURF_PAR, ONLY : XUNDEF 00035 USE MODD_PREP, ONLY : XZS_LS, XT_CLIM_GRAD 00036 USE MODD_PREP_ISBA, ONLY : LSNOW_IDEAL 00037 USE MODD_CSTS, ONLY : XTT, XDAY, XLMTT, XRHOLW 00038 ! 00039 USE MODE_THERMOS 00040 USE MODI_PREP_VER_SNOW 00041 ! 00042 ! 00043 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00044 USE PARKIND1 ,ONLY : JPRB 00045 ! 00046 IMPLICIT NONE 00047 ! 00048 !* 0.1 declarations of arguments 00049 ! 00050 ! 00051 !* 0.2 declarations of local variables 00052 ! 00053 INTEGER :: JL ! loop counter on layers 00054 INTEGER :: JP ! loop counter on patches 00055 INTEGER :: IWORK ! Work integer 00056 ! 00057 REAL, DIMENSION(:), ALLOCATABLE :: ZWGTOT ! total water content 00058 REAL, DIMENSION(:), ALLOCATABLE :: ZDW ! variation of water in soil 00059 REAL, DIMENSION(:), ALLOCATABLE :: ZZSFREEZE ! altitude where soil temperature equals XTT 00060 INTEGER :: IDEEP_SOIL! layer corresponding to deep soil temperature 00061 ! 00062 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWGI_CLIM_GRAD ! ice content vertical gradient 00063 ! 00064 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTG_LS! temperature on initial orography 00065 ! 00066 REAL :: ZGRADX = 5.E-4 ! slope of ice content gradient 00067 REAL :: ZH0 = 5.E-1 ! constant used to define ice content gradient 00068 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00069 !------------------------------------------------------------------------------------- 00070 ! 00071 !* 1.0 Ice content climatologic gradient 00072 ! 00073 IF (LHOOK) CALL DR_HOOK('PREP_VER_ISBA',0,ZHOOK_HANDLE) 00074 ALLOCATE(ZWGI_CLIM_GRAD (SIZE(XWG,1),SIZE(XWG,2),SIZE(XWG,3))) 00075 ! 00076 ZWGI_CLIM_GRAD(:,:,:) = ZGRADX * EXP( - XDG(:,:,:) / ZH0 ) 00077 !------------------------------------------------------------------------------------- 00078 ! 00079 !* 1.1 Temperature profile 00080 ! 00081 ALLOCATE(ZTG_LS(SIZE(XTG,1),SIZE(XTG,2),SIZE(XTG,3))) 00082 ZTG_LS(:,:,:) = XTG(:,:,:) 00083 ! 00084 DO JP=1,SIZE(XTG,3) 00085 DO JL=1,SIZE(XTG,2) 00086 WHERE(XTG(:,JL,JP)/=XUNDEF) & 00087 XTG(:,JL,JP) = XTG(:,JL,JP) + XT_CLIM_GRAD * (XZS - XZS_LS) 00088 END DO 00089 END DO 00090 ! 00091 !------------------------------------------------------------------------------------- 00092 ! 00093 !* 1.2 Water and ice in the soil 00094 ! 00095 ALLOCATE(ZZSFREEZE (SIZE(XWG,1))) 00096 ALLOCATE(ZWGTOT (SIZE(XWG,1))) 00097 ALLOCATE(ZDW (SIZE(XWG,1))) 00098 ! 00099 !* general case 00100 ! 00101 IF(LTEMP_ARP)THEN 00102 IWORK=SIZE(XWG,2) 00103 ELSE 00104 IWORK=SIZE(XTG,2) 00105 ENDIF 00106 ! 00107 DO JP=1,SIZE(XWG,3) 00108 ! 00109 DO JL=1,IWORK 00110 ! 00111 ZDW(:) = 0. 00112 ! altitude where deep soil freezes (diurnal surface response is not treated) 00113 ZZSFREEZE(:) = XZS + (XTT - XTG(:,JL,JP)) / XT_CLIM_GRAD 00114 ! 00115 WHERE(XTG(:,JL,JP)/=XUNDEF) 00116 ! 00117 WHERE (ZTG_LS(:,JL,JP) < XTT) 00118 ! 00119 WHERE (XZS <= XZS_LS) 00120 ! 00121 WHERE (XZS > ZZSFREEZE) 00122 ZDW(:) = ZWGI_CLIM_GRAD(:,JL,JP) * (XZS - XZS_LS) 00123 ELSEWHERE 00124 ZDW(:) = ZWGI_CLIM_GRAD(:,JL,JP) * (ZZSFREEZE - XZS_LS) + ZGRADX * (XZS - ZZSFREEZE) 00125 ENDWHERE 00126 ! 00127 ELSEWHERE 00128 ! 00129 ZDW(:) = ZWGI_CLIM_GRAD(:,JL,JP) * (XZS - XZS_LS) 00130 ! 00131 ENDWHERE 00132 ! 00133 ELSEWHERE 00134 ! 00135 WHERE (XZS <= XZS_LS) 00136 ! 00137 ZDW(:) = ZGRADX * (XZS - XZS_LS) 00138 ! 00139 ELSEWHERE 00140 ! 00141 ZDW(:) = ZWGI_CLIM_GRAD(:,JL,JP) * (XZS - ZZSFREEZE) 00142 ! 00143 END WHERE 00144 ! 00145 END WHERE 00146 ! 00147 ZWGTOT(:) = XUNDEF 00148 ! 00149 WHERE(XWG(:,JL,JP)/=XUNDEF) 00150 ZWGTOT(:) = XWG(:,JL,JP) + XWGI(:,JL,JP) 00151 ENDWHERE 00152 ! 00153 WHERE(XWG(:,JL,JP)/=XUNDEF) 00154 XWGI(:,JL,JP) = XWGI(:,JL,JP) + ZDW(:) 00155 XWG (:,JL,JP) = XWG (:,JL,JP) - ZDW(:) 00156 ENDWHERE 00157 ! 00158 WHERE (XWGI(:,JL,JP)<0.0.AND.XWGI(:,JL,JP)/=XUNDEF) 00159 XWGI(:,JL,JP) = 0. 00160 XWG (:,JL,JP) = ZWGTOT(:) 00161 END WHERE 00162 ! 00163 WHERE (XWG(:,JL,JP)<XWGMIN.AND.XWG(:,JL,JP)/=XUNDEF) 00164 XWG (:,JL,JP) = XWGMIN 00165 XWGI(:,JL,JP) = ZWGTOT(:) - XWGMIN 00166 END WHERE 00167 ! 00168 WHERE(XWGI(:,JL,JP)>0.0.AND.XWGI(:,JL,JP)/=XUNDEF) 00169 XTG(:,JL,JP) = MIN(XTT,XTG(:,JL,JP)) 00170 ELSEWHERE 00171 XTG(:,JL,JP) = MAX(XTT,XTG(:,JL,JP)) 00172 ENDWHERE 00173 ! 00174 END WHERE 00175 ! 00176 END DO 00177 ! 00178 END DO 00179 ! 00180 !* limits in force-restore case 00181 ! 00182 IF (CISBA=='3-L') THEN 00183 DO JP=1,SIZE(XWG,3) 00184 WHERE (XWGI(:,3,JP) /= XUNDEF) 00185 XWG (:,3,JP) = XWG(:,3,JP)+XWGI(:,3,JP) 00186 XWGI(:,3,JP) = 0. 00187 XTG (:,3,JP) = ZTG_LS(:,3,JP) + XT_CLIM_GRAD * (XZS - XZS_LS) 00188 END WHERE 00189 IF(LTEMP_ARP)THEN 00190 XTG (:,4:SIZE(XTG,2),JP) = ZTG_LS(:,4:SIZE(XTG,2),JP) 00191 ENDIF 00192 END DO 00193 ELSEIF(CISBA=='2-L'.AND.LTEMP_ARP) THEN 00194 DO JP=1,SIZE(XWG,3) 00195 XTG (:,3:SIZE(XTG,2),JP) = ZTG_LS(:,3:SIZE(XTG,2),JP) 00196 END DO 00197 END IF 00198 ! 00199 DEALLOCATE(ZZSFREEZE) 00200 DEALLOCATE(ZWGI_CLIM_GRAD) 00201 DEALLOCATE(ZWGTOT ) 00202 DEALLOCATE(ZDW ) 00203 ! 00204 !* masks where fields are not defined 00205 WHERE (XTG(:,1:SIZE(XWG,2),:) == XUNDEF) 00206 XWG (:,:,:) = XUNDEF 00207 XWGI(:,:,:) = XUNDEF 00208 END WHERE 00209 ! 00210 !------------------------------------------------------------------------------------- 00211 ! 00212 !* 1.4 Snow variables 00213 ! 00214 !* vertical shift 00215 IF (.NOT.LSNOW_IDEAL) THEN 00216 IF (CISBA=='DIF') THEN 00217 IDEEP_SOIL = NGROUND_LAYER 00218 ELSE 00219 IDEEP_SOIL = 2 00220 END IF 00221 CALL PREP_VER_SNOW(TSNOW,XZS_LS,XZS,ZTG_LS,XTG,IDEEP_SOIL) 00222 ENDIF 00223 ! 00224 !------------------------------------------------------------------------------------- 00225 ! 00226 !* 2. Deallocation of large-scale orography 00227 ! 00228 DEALLOCATE(ZTG_LS) 00229 IF (LHOOK) CALL DR_HOOK('PREP_VER_ISBA',1,ZHOOK_HANDLE) 00230 !------------------------------------------------------------------------------------- 00231 ! 00232 END SUBROUTINE PREP_VER_ISBA
1.8.0
