|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ######### 00002 SUBROUTINE PREP_SNOW_BUFFER(HPROGRAM,HSURF,KLUOUT,PFIELD) 00003 ! ################################################################################# 00004 ! 00005 !!**** *PREP_SNOW_BUFFER* - prepares snow field from operational BUFFER 00006 !! 00007 !! PURPOSE 00008 !! ------- 00009 ! 00010 !!** METHOD 00011 !! ------ 00012 !! 00013 !! REFERENCE 00014 !! --------- 00015 !! 00016 !! 00017 !! AUTHOR 00018 !! ------ 00019 !! S. Malardel 00020 !! 00021 !! MODIFICATIONS 00022 !! ------------- 00023 !! Original 03/2005 00024 !!------------------------------------------------------------------ 00025 ! 00026 ! 00027 USE MODE_READ_BUFFER 00028 ! 00029 USE MODD_TYPE_DATE_SURF 00030 ! 00031 USE MODI_PREP_BUFFER_GRID 00032 USE MODI_SNOW_T_WLIQ_TO_HEAT 00033 ! 00034 USE MODD_PREP, ONLY : CINTERP_TYPE 00035 USE MODD_PREP_SNOW, ONLY : XGRID_SNOW 00036 USE MODD_DATA_COVER_PAR, ONLY : NVEGTYPE 00037 USE MODD_SURF_PAR, ONLY : XUNDEF 00038 USE MODD_GRID_BUFFER, ONLY : NNI 00039 USE MODD_SNOW_PAR, ONLY : XANSMIN, XANSMAX, XRHOSMAX 00040 USE MODD_CSTS, ONLY : XTT 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 CHARACTER(LEN=6), INTENT(IN) :: HPROGRAM ! program calling surf. schemes 00051 CHARACTER(LEN=10), INTENT(IN) :: HSURF ! type of field 00052 INTEGER, INTENT(IN) :: KLUOUT ! logical unit of output listing 00053 REAL,DIMENSION(:,:,:), POINTER :: PFIELD ! field to interpolate horizontally 00054 ! 00055 !* 0.2 declarations of local variables 00056 ! 00057 TYPE (DATE_TIME) :: TZTIME_BUFFER ! current date and time 00058 CHARACTER(LEN=6) :: YINMODEL ! model from which GRIB file originates 00059 REAL, DIMENSION(:), POINTER :: ZFIELD1D ! field read 00060 REAL, DIMENSION(:), POINTER :: ZHEAT ! heat in snow 00061 REAL, DIMENSION(:), POINTER :: ZRHO ! density of snow 00062 INTEGER :: JVEGTYPE ! loop counter on vegtypes 00063 INTEGER :: JLAYER ! loop on snow fine grid 00064 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00065 ! 00066 !------------------------------------------------------------------------------------- 00067 ! 00068 !* 1. Reading of grid 00069 ! --------------- 00070 ! 00071 IF (LHOOK) CALL DR_HOOK('PREP_SNOW_BUFFER',0,ZHOOK_HANDLE) 00072 CALL PREP_BUFFER_GRID(KLUOUT,YINMODEL,TZTIME_BUFFER) 00073 ! 00074 !------------------------------------------------------------------------------------- 00075 ! 00076 !* 2. Reading of the physical field for urban areas 00077 ! --------------------------------------------- 00078 ! 00079 IF (HSURF(7:8)=='RO') THEN 00080 ! 00081 SELECT CASE(HSURF(1:3)) 00082 CASE('DEP','ALB','WWW') 00083 ALLOCATE(PFIELD(NNI,1,1)) 00084 CASE('HEA','RHO') 00085 ALLOCATE(PFIELD(NNI,SIZE(XGRID_SNOW),1)) 00086 END SELECT 00087 ! 00088 PFIELD(:,:,:) = 0. 00089 ! 00090 !------------------------------------------------------------------------------------- 00091 ! 00092 !* 3. Reading of the physical field for vegetated areas 00093 ! ------------------------------------------------- 00094 ! 00095 ELSE 00096 ! 00097 SELECT CASE(HSURF(1:3)) 00098 ! 00099 !* 3.1 Total snow content (kg/m2) 00100 ! 00101 CASE('WWW') 00102 CALL READ_BUFFER_SNOW_VEG(KLUOUT,YINMODEL,ZFIELD1D) 00103 ! 00104 ALLOCATE(PFIELD(NNI,1,NVEGTYPE)) 00105 DO JVEGTYPE=1,NVEGTYPE 00106 PFIELD(:,1,JVEGTYPE)=ZFIELD1D(:) 00107 END DO 00108 DEALLOCATE(ZFIELD1D) 00109 ! 00110 ! 00111 !* 3.2 Total snow depth (m) 00112 ! 00113 CASE('DEP') 00114 CALL READ_BUFFER_SNOW_VEG_DEPTH(KLUOUT,YINMODEL,ZFIELD1D) 00115 ! 00116 ALLOCATE(PFIELD(NNI,1,NVEGTYPE)) 00117 DO JVEGTYPE=1,NVEGTYPE 00118 PFIELD(:,1,JVEGTYPE)=ZFIELD1D(:) 00119 END DO 00120 DEALLOCATE(ZFIELD1D) 00121 ! 00122 ! 00123 !* 3.3 Profile of heat in the snow 00124 ! 00125 CASE('HEA') 00126 !* read temperature 00127 CALL READ_BUFFER_TS(KLUOUT,YINMODEL,ZFIELD1D) 00128 WHERE (ZFIELD1D/=XUNDEF) ZFIELD1D(:) = MIN(ZFIELD1D,XTT) 00129 !* assumes no liquid water in the snow 00130 ALLOCATE(ZHEAT(SIZE(ZFIELD1D))) 00131 ALLOCATE(ZRHO (SIZE(ZFIELD1D))) 00132 ZRHO(:) = XRHOSMAX 00133 ! 00134 CALL SNOW_T_WLIQ_TO_HEAT(ZHEAT,ZRHO,ZFIELD1D) 00135 ! 00136 ALLOCATE(PFIELD(NNI,SIZE(XGRID_SNOW),NVEGTYPE)) 00137 DO JVEGTYPE=1,NVEGTYPE 00138 DO JLAYER=1,SIZE(XGRID_SNOW) 00139 PFIELD(:,JLAYER,JVEGTYPE)=ZHEAT(:) 00140 END DO 00141 END DO 00142 DEALLOCATE(ZFIELD1D) 00143 DEALLOCATE(ZHEAT ) 00144 DEALLOCATE(ZRHO ) 00145 ! 00146 !* 3.4 Albedo 00147 ! 00148 CASE('ALB') 00149 ALLOCATE(PFIELD(NNI,1,NVEGTYPE)) 00150 PFIELD = 0.5 * ( XANSMIN + XANSMAX ) 00151 ! 00152 !* 3.5 Density 00153 ! 00154 CASE('RHO') 00155 ALLOCATE(PFIELD(NNI,SIZE(XGRID_SNOW),NVEGTYPE)) 00156 PFIELD = XRHOSMAX 00157 00158 END SELECT 00159 ! 00160 END IF 00161 ! 00162 !------------------------------------------------------------------------------------- 00163 ! 00164 !* 4. Interpolation method 00165 ! -------------------- 00166 ! 00167 CINTERP_TYPE='BUFFER' 00168 IF (LHOOK) CALL DR_HOOK('PREP_SNOW_BUFFER',1,ZHOOK_HANDLE) 00169 ! 00170 !------------------------------------------------------------------------------------- 00171 END SUBROUTINE PREP_SNOW_BUFFER
1.8.0
