|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE PREP_SNOW_EXTERN(HPROGRAM,HSURF,HFILE,HFILETYPE,HFILEPGD,HFILEPGDTYPE,& 00003 KLUOUT,PFIELD,OSNOW_IDEAL,KLAYER) 00004 ! ################################################################################# 00005 ! 00006 ! 00007 USE MODD_TYPE_SNOW 00008 USE MODD_PREP, ONLY : CINGRID_TYPE, CINTERP_TYPE 00009 USE MODD_PREP_SNOW, ONLY : XGRID_SNOW, NGRID_LEVEL 00010 USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE 00011 USE MODD_SURF_PAR, ONLY : XUNDEF 00012 USE MODD_CSTS, ONLY : XTT 00013 ! 00014 USE MODE_SNOW3L 00015 ! 00016 USE YOMHOOK ,ONLY : LHOOK, DR_HOOK 00017 USE PARKIND1 ,ONLY : JPRB 00018 ! 00019 USE MODI_TOWN_PRESENCE 00020 USE MODI_PUT_ON_ALL_VEGTYPES 00021 USE MODI_ABOR1_SFX 00022 USE MODI_PREP_GRID_EXTERN 00023 USE MODI_OPEN_AUX_IO_SURF 00024 USE MODI_CLOSE_AUX_IO_SURF 00025 USE MODI_ALLOCATE_GR_SNOW 00026 USE MODI_INTERP_GRID 00027 USE MODI_READ_GR_SNOW 00028 USE MODI_READ_SURF 00029 USE MODI_SNOW_T_WLIQ_TO_HEAT 00030 USE MODI_GET_CURRENT_TEB_PATCH 00031 USE MODI_READ_TEB_PATCH 00032 ! 00033 IMPLICIT NONE 00034 ! 00035 !* 0.1 declarations of arguments 00036 ! 00037 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes 00038 CHARACTER(LEN=10), INTENT(IN) :: HSURF ! type of field 00039 CHARACTER(LEN=28), INTENT(IN) :: HFILE ! name of file 00040 CHARACTER(LEN=6), INTENT(IN) :: HFILETYPE ! type of file 00041 CHARACTER(LEN=28), INTENT(IN) :: HFILEPGD ! name of file 00042 CHARACTER(LEN=6), INTENT(IN) :: HFILEPGDTYPE ! type of file 00043 INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing 00044 REAL,DIMENSION(:,:,:), POINTER :: PFIELD ! field to interpolate horizontally 00045 LOGICAL, INTENT(IN) :: OSNOW_IDEAL 00046 INTEGER, INTENT(IN) :: KLAYER 00047 ! 00048 !* 0.2 declarations of local variables 00049 ! 00050 TYPE(SURF_SNOW) :: TZSNOW ! snow characteristics 00051 00052 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZFIELD ! work field on input snow grid 00053 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZFIELD_FINE ! work field on fine snow grid 00054 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZTEMP ! snow temperature 00055 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZWLIQ ! liquid water snow pack content 00056 REAL, DIMENSION(:,:), ALLOCATABLE :: ZD ! total snow depth 00057 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZDEPTH ! thickness of each layer (m) 00058 REAL, DIMENSION(:,:,:), ALLOCATABLE :: ZGRID ! normalized input grid 00059 ! 00060 LOGICAL :: GTOWN ! town variables written in the file 00061 CHARACTER(LEN=12) :: YRECFM ! record name 00062 INTEGER :: IRESP ! error return code 00063 INTEGER :: IVERSION ! SURFEX version 00064 LOGICAL :: GOLD_NAME ! old name flag 00065 INTEGER :: IBUGFIX ! SURFEX bug version 00066 INTEGER :: IVEGTYPE ! actual number of vegtypes 00067 INTEGER :: JLAYER ! loop on snow vertical grids 00068 INTEGER :: INI 00069 CHARACTER(LEN=8) :: YAREA ! area treated ('ROOF','ROAD','VEG ') 00070 CHARACTER(LEN=3) :: YPREFIX ! prefix to identify patch 00071 INTEGER :: IPATCH ! number of input patch 00072 INTEGER :: ITEB_PATCH ! number of input patch for TEB 00073 INTEGER :: ICURRENT_TEB_PATCH ! current patch for TEB 00074 INTEGER :: JPATCH ! loop on patch 00075 CHARACTER(LEN=6) :: YMASK ! type of tile mask 00076 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00077 ! 00078 !------------------------------------------------------------------------------------- 00079 ! 00080 !* 3. Area being treated 00081 ! ------------------ 00082 ! 00083 IF (LHOOK) CALL DR_HOOK('PREP_SNOW_EXTERN',0,ZHOOK_HANDLE) 00084 ! 00085 !------------------------------------------------------------------------------------- 00086 ! 00087 YAREA=' ' 00088 YAREA(1:4) = HSURF(7:10) 00089 ! 00090 IF (YAREA(1:4)=='VEG ') THEN 00091 IVEGTYPE = NVEGTYPE 00092 YMASK = 'NATURE' 00093 YPREFIX = ' ' 00094 ELSE 00095 IVEGTYPE = 1 00096 YMASK = 'TOWN ' 00097 IPATCH = 1 00098 YPREFIX = ' ' 00099 END IF 00100 ! 00101 !* 1. Preparation of IO for reading in the file 00102 ! ----------------------------------------- 00103 ! 00104 !* Note that all points are read, even those without physical meaning. 00105 ! These points will not be used during the horizontal interpolation step. 00106 ! Their value must be defined as XUNDEF. 00107 ! 00108 CALL OPEN_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE,YMASK) 00109 ! 00110 !* reading of version of the file being read 00111 CALL READ_SURF(HFILEPGDTYPE,'VERSION',IVERSION,IRESP) 00112 CALL READ_SURF(HFILEPGDTYPE,'BUG',IBUGFIX,IRESP) 00113 GOLD_NAME=(IVERSION<7 .OR. (IVERSION==7 .AND. IBUGFIX<3)) 00114 ! 00115 IF (YAREA(1:4)=='VEG ') THEN 00116 YRECFM = 'PATCH_NUMBER' 00117 CALL READ_SURF(HFILEPGDTYPE,YRECFM,IPATCH,IRESP) 00118 ELSE 00119 IF (.NOT.GOLD_NAME) THEN 00120 IF (YAREA(1:4)=='ROOF') YAREA(1:4) = 'RF ' 00121 IF (YAREA(1:4)=='ROAD') YAREA(1:4) = 'RD ' 00122 ENDIF 00123 CALL READ_TEB_PATCH(HFILEPGDTYPE,ITEB_PATCH) 00124 IF (ITEB_PATCH>1) THEN 00125 CALL GET_CURRENT_TEB_PATCH(ICURRENT_TEB_PATCH) 00126 WRITE(YPREFIX,FMT='(A,I1,A)') 'T',MIN(ICURRENT_TEB_PATCH,ITEB_PATCH),'_' 00127 END IF 00128 END IF 00129 ! 00130 !------------------------------------------------------------------------------------- 00131 ! 00132 !* 2. Reading of grid 00133 ! --------------- 00134 ! 00135 CALL PREP_GRID_EXTERN(HFILEPGDTYPE,KLUOUT,CINGRID_TYPE,CINTERP_TYPE,INI) 00136 ! 00137 !------------------------------------------------------------------------------------- 00138 ! 00139 !* 4. Reading of snow data 00140 ! --------------------- 00141 ! 00142 IF (YAREA(1:2)=='RO' .OR. YAREA(1:2)=='GA' .OR. YAREA(1:2)=='RF' .OR. YAREA(1:2)=='RD') THEN 00143 CALL TOWN_PRESENCE(HFILEPGDTYPE,GTOWN) 00144 CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE) 00145 IF (.NOT. GTOWN) THEN 00146 TZSNOW%SCHEME='1-L' 00147 CALL ALLOCATE_GR_SNOW(TZSNOW,INI,IPATCH) 00148 ELSE 00149 CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,YMASK) 00150 CALL READ_GR_SNOW(HFILETYPE,TRIM(YAREA),YPREFIX,INI,IPATCH,TZSNOW,HDIR='A') 00151 CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE) 00152 ENDIF 00153 ELSE 00154 CALL CLOSE_AUX_IO_SURF(HFILEPGD,HFILEPGDTYPE) 00155 CALL OPEN_AUX_IO_SURF(HFILE,HFILETYPE,YMASK) 00156 CALL READ_GR_SNOW(HFILETYPE,TRIM(YAREA),YPREFIX,INI,IPATCH,TZSNOW,HDIR='A') 00157 CALL CLOSE_AUX_IO_SURF(HFILE,HFILETYPE) 00158 ENDIF 00159 ! 00160 IF (TZSNOW%NLAYER.GT.KLAYER) THEN 00161 TZSNOW%NLAYER=KLAYER 00162 ELSEIF (TZSNOW%NLAYER.LT.KLAYER) THEN 00163 CALL ABOR1_SFX("PREP_SNOW_EXTERN: SNOW NLAYER IN EXTERN FILE MUST BE GROWER THAN CURRENT NLAYER") 00164 ENDIF 00165 ! 00166 ! 00167 !------------------------------------------------------------------------------------- 00168 ! 00169 !* 5. Total snow content 00170 ! ------------------ 00171 ! 00172 SELECT CASE (HSURF(1:3)) 00173 CASE ('WWW') 00174 IF (OSNOW_IDEAL) THEN 00175 ALLOCATE(ZFIELD(INI,KLAYER,IPATCH)) 00176 ZFIELD(:,:,:) = TZSNOW%WSNOW(:,1:KLAYER,:) 00177 ALLOCATE(PFIELD(INI,KLAYER,IVEGTYPE)) 00178 CALL PUT_ON_ALL_VEGTYPES(INI,KLAYER,IPATCH,IVEGTYPE,ZFIELD,PFIELD) 00179 ELSE 00180 ALLOCATE(ZFIELD(INI,1,IPATCH)) 00181 ZFIELD = 0. 00182 DO JLAYER=1,TZSNOW%NLAYER 00183 ZFIELD(:,1,:) = ZFIELD(:,1,:) + TZSNOW%WSNOW(:,JLAYER,:) 00184 END DO 00185 ALLOCATE(PFIELD(INI,1,IVEGTYPE)) 00186 CALL PUT_ON_ALL_VEGTYPES(INI,1,IPATCH,IVEGTYPE,ZFIELD,PFIELD) 00187 ENDIF 00188 DEALLOCATE(ZFIELD) 00189 ! 00190 !------------------------------------------------------------------------------------- 00191 ! 00192 !* 6. Albedo 00193 ! ------ 00194 ! 00195 CASE ('ALB') 00196 ALLOCATE(ZFIELD(INI,1,IPATCH)) 00197 ZFIELD(:,1,:) = TZSNOW%ALB(:,:) 00198 ! 00199 ALLOCATE(PFIELD(INI,1,IVEGTYPE)) 00200 CALL PUT_ON_ALL_VEGTYPES(INI,1,IPATCH,IVEGTYPE,ZFIELD,PFIELD) 00201 DEALLOCATE(ZFIELD) 00202 ! 00203 !------------------------------------------------------------------------------------- 00204 ! 00205 !* 7. Total depth 00206 ! ----------- 00207 ! 00208 CASE ('DEP') 00209 IF (OSNOW_IDEAL) THEN 00210 ALLOCATE(ZDEPTH(INI,KLAYER,IPATCH)) 00211 ZDEPTH(:,:,:) = TZSNOW%WSNOW(:,1:KLAYER,:)/TZSNOW%RHO(:,1:KLAYER,:) 00212 WHERE(TZSNOW%WSNOW(:,1:KLAYER,:)==XUNDEF) ZDEPTH(:,:,:)=XUNDEF 00213 ALLOCATE(PFIELD(INI,KLAYER,IVEGTYPE)) 00214 CALL PUT_ON_ALL_VEGTYPES(INI,KLAYER,IPATCH,IVEGTYPE,ZDEPTH,PFIELD) 00215 ELSE 00216 ALLOCATE(ZDEPTH(INI,1,IPATCH)) 00217 ZDEPTH = 0. 00218 DO JPATCH=1,IPATCH 00219 DO JLAYER=1,TZSNOW%NLAYER 00220 ZDEPTH(:,1,JPATCH) = ZDEPTH(:,1,JPATCH) + & 00221 TZSNOW%WSNOW(:,JLAYER,JPATCH)/TZSNOW%RHO(:,JLAYER,JPATCH) 00222 END DO 00223 WHERE(TZSNOW%WSNOW(:,1,JPATCH)==XUNDEF) ZDEPTH(:,1,JPATCH)=XUNDEF 00224 END DO 00225 ALLOCATE(PFIELD(INI,1,IVEGTYPE)) 00226 CALL PUT_ON_ALL_VEGTYPES(INI,1,IPATCH,IVEGTYPE,ZDEPTH,PFIELD) 00227 ENDIF 00228 DEALLOCATE(ZDEPTH) 00229 ! 00230 !------------------------------------------------------------------------------------- 00231 ! 00232 !* 8. Density or heat profile 00233 ! ----------------------- 00234 ! 00235 CASE ('RHO','HEA') 00236 ALLOCATE(ZFIELD (INI,TZSNOW%NLAYER,IPATCH)) 00237 00238 SELECT CASE (TZSNOW%SCHEME) 00239 CASE ('D95','1-L','EBA') 00240 ALLOCATE(ZFIELD_FINE(INI,NGRID_LEVEL,IPATCH)) 00241 !* computes output physical variable 00242 IF (HSURF(1:1)=='R') ZFIELD(:,1,:) = TZSNOW%RHO(:,1,:) 00243 IF (HSURF(1:1)=='H') THEN 00244 ALLOCATE(ZTEMP(INI,TZSNOW%NLAYER,IPATCH)) 00245 ALLOCATE(ZWLIQ(INI,TZSNOW%NLAYER,IPATCH)) 00246 IF (TZSNOW%SCHEME=='D95'.OR.TZSNOW%SCHEME=='EBA') ZTEMP(:,1,:) = XTT 00247 IF (TZSNOW%SCHEME=='1-L') ZTEMP(:,1,:) = TZSNOW%T(:,1,:) 00248 ZWLIQ(:,:,:) = 0. 00249 CALL SNOW_T_WLIQ_TO_HEAT(ZFIELD,TZSNOW%RHO,ZTEMP,ZWLIQ) 00250 DEALLOCATE(ZTEMP) 00251 DEALLOCATE(ZWLIQ) 00252 END IF 00253 !* put profile on fine snow grid 00254 DO JLAYER=1,NGRID_LEVEL 00255 ZFIELD_FINE(:,JLAYER,:) = ZFIELD(:,1,:) 00256 END DO 00257 ALLOCATE(PFIELD(INI,NGRID_LEVEL,IVEGTYPE)) 00258 CALL PUT_ON_ALL_VEGTYPES(INI,NGRID_LEVEL,IPATCH,IVEGTYPE,ZFIELD_FINE,PFIELD) 00259 00260 CASE ('3-L','CRO') 00261 !* input physical variable 00262 IF (HSURF(1:1)=='R') ZFIELD(:,:,:) = TZSNOW%RHO (:,1:TZSNOW%NLAYER,:) 00263 IF (HSURF(1:1)=='H') ZFIELD(:,:,:) = TZSNOW%HEAT(:,1:TZSNOW%NLAYER,:) 00264 ! 00265 IF (OSNOW_IDEAL) THEN 00266 ALLOCATE(ZFIELD_FINE(INI,KLAYER,IPATCH)) 00267 IF (HSURF(1:1)=='R') ZFIELD_FINE(:,:,:) = ZFIELD(:,:,:) 00268 IF (HSURF(1:1)=='H') ZFIELD_FINE(:,:,:) = ZFIELD(:,:,:) 00269 ALLOCATE(PFIELD(INI,KLAYER,IVEGTYPE)) 00270 CALL PUT_ON_ALL_VEGTYPES(INI,KLAYER,IPATCH,IVEGTYPE,ZFIELD_FINE,PFIELD) 00271 ELSE 00272 ALLOCATE(ZFIELD_FINE(INI,NGRID_LEVEL,IPATCH)) 00273 !* total depth 00274 ALLOCATE(ZD(INI,IPATCH)) 00275 ZD = 0. 00276 DO JLAYER=1,TZSNOW%NLAYER 00277 ZD(:,:) = ZD(:,:) + TZSNOW%WSNOW(:,JLAYER,:)/TZSNOW%RHO(:,JLAYER,:) 00278 END DO 00279 !* input snow layer thickness 00280 ALLOCATE(ZDEPTH(INI,TZSNOW%NLAYER,IPATCH)) 00281 DO JPATCH=1,IPATCH 00282 CALL SNOW3LGRID(ZDEPTH(:,:,JPATCH),ZD(:,JPATCH)) 00283 END DO 00284 !* input normalized grid 00285 ALLOCATE(ZGRID(INI,TZSNOW%NLAYER,IPATCH)) 00286 WHERE(ZD(:,:)>0.) 00287 ZGRID(:,1,:) = 0.5 * ZDEPTH(:,1,:) / ZD(:,:) 00288 ELSEWHERE 00289 ZGRID(:,1,:) = 0.5 / FLOAT(KLAYER) 00290 END WHERE 00291 DO JLAYER = 2,TZSNOW%NLAYER 00292 WHERE (ZD(:,:)>0.) 00293 ZGRID(:,JLAYER,:) = ZGRID(:,JLAYER-1,:) & 00294 + 0.5 * ZDEPTH(:,JLAYER-1,:) / ZD(:,:) & 00295 + 0.5 * ZDEPTH(:,JLAYER ,:) / ZD(:,:) 00296 ELSEWHERE 00297 ZGRID(:,JLAYER,:) = (FLOAT(JLAYER)-0.5) / FLOAT(KLAYER) 00298 END WHERE 00299 END DO 00300 DEALLOCATE(ZD) 00301 DEALLOCATE(ZDEPTH) 00302 !* interpolation of profile onto fine normalized snow grid 00303 DO JPATCH=1,IPATCH 00304 CALL INTERP_GRID(ZGRID(:,:,JPATCH),ZFIELD(:,:,JPATCH), & 00305 XGRID_SNOW(:), ZFIELD_FINE(:,:,JPATCH)) 00306 END DO 00307 DEALLOCATE(ZGRID) 00308 ALLOCATE(PFIELD(INI,NGRID_LEVEL,IVEGTYPE)) 00309 CALL PUT_ON_ALL_VEGTYPES(INI,NGRID_LEVEL,IPATCH,IVEGTYPE,ZFIELD_FINE,PFIELD) 00310 ENDIF 00311 END SELECT 00312 ! 00313 !* put field form patch to all vegtypes 00314 DEALLOCATE(ZFIELD) 00315 DEALLOCATE(ZFIELD_FINE) 00316 ! 00317 !* 9. Crocus specific fields 00318 ! ----------------------- 00319 ! 00320 CASE ('SG1','SG2','HIS','AGE') 00321 ALLOCATE(ZFIELD(INI,KLAYER,IPATCH)) 00322 IF (HSURF(1:3)=='SG1') ZFIELD(:,:,:) = TZSNOW%GRAN1(:,1:KLAYER,:) 00323 IF (HSURF(1:3)=='SG2') ZFIELD(:,:,:) = TZSNOW%GRAN2(:,1:KLAYER,:) 00324 IF (HSURF(1:3)=='HIS') ZFIELD(:,:,:) = TZSNOW%HIST(:,1:KLAYER,:) 00325 IF (HSURF(1:3)=='AGE') ZFIELD(:,:,:) = TZSNOW%AGE(:,1:KLAYER,:) 00326 ALLOCATE(PFIELD(INI,KLAYER,IVEGTYPE)) 00327 CALL PUT_ON_ALL_VEGTYPES(INI,KLAYER,IPATCH,IVEGTYPE,ZFIELD,PFIELD) 00328 DEALLOCATE(ZFIELD) 00329 ! 00330 END SELECT 00331 ! 00332 !------------------------------------------------------------------------------------- 00333 ! 00334 !* 9. End of IO 00335 ! --------- 00336 ! 00337 IF (LHOOK) CALL DR_HOOK('PREP_SNOW_EXTERN',1,ZHOOK_HANDLE) 00338 ! 00339 !------------------------------------------------------------------------------------- 00340 END SUBROUTINE PREP_SNOW_EXTERN
1.8.0
