|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 ! ###################################################################### 00002 SUBROUTINE THERMAL_LAYERS_CONF(HTYPE,PHC,PTC,PD,PHC_OUT,PTC_OUT,PD_OUT) 00003 ! ###################################################################### 00004 ! 00005 !!**** *THERMAL_LAYERS_CONF* 00006 !! 00007 !! PURPOSE 00008 !! ------- 00009 ! Adjust the thermal characteristics of the layers in road, wall, roof or 00010 ! floor depending on the number of layers that the user wants to use during 00011 ! the simulations. 00012 ! Initial data are prescribed depending on user preference. 00013 ! They have to be averaged on the layers use in the simulation 00014 ! 00015 !! 00016 !!** METHOD 00017 !! ------ 00018 !! 00019 !! EXTERNAL 00020 !! -------- 00021 !! 00022 !! IMPLICIT ARGUMENTS 00023 !! ------------------ 00024 !! 00025 !! REFERENCE 00026 !! --------- 00027 !! 00028 !! AUTHOR 00029 !! ------ 00030 !! V. Masson *Meteo France* 00031 !! 00032 !! MODIFICATIONS 00033 !! ------------- 00034 !! Original 05/2012 00035 !------------------------------------------------------------------------------- 00036 ! 00037 !* 0. DECLARATIONS 00038 ! ------------ 00039 ! 00040 USE MODD_SURF_PAR, ONLY : XUNDEF 00041 USE MODI_TEBGRID 00042 ! 00043 IMPLICIT NONE 00044 ! 00045 !* 0.1 Declarations of arguments 00046 ! ------------------------- 00047 ! 00048 CHARACTER(LEN=5), INTENT(IN) :: HTYPE ! type of surface 00049 REAL, DIMENSION(:,:), INTENT(IN) :: PHC ! input Heat Capacity 00050 REAL, DIMENSION(:,:), INTENT(IN) :: PTC ! input Thermal conductivity 00051 REAL, DIMENSION(:,:), INTENT(IN) :: PD ! input Layer Thickness 00052 REAL, DIMENSION(:,:), INTENT(OUT) :: PHC_OUT ! output Heat Capacity 00053 REAL, DIMENSION(:,:), INTENT(OUT) :: PTC_OUT ! output Thermal conductivity 00054 REAL, DIMENSION(:,:), INTENT(OUT) :: PD_OUT ! output Layer Thickness 00055 ! 00056 !* 0.2 Declarations of local variables 00057 ! 00058 REAL, DIMENSION(SIZE(PHC,1)) :: ZD_TOT ! Total depth 00059 REAL, DIMENSION(SIZE(PHC,1)) :: ZD_HALF ! Depth of the half of the total surface 00060 ! ! (excluding central layer in case 00061 ! ! of odd number of layers) 00062 REAL, DIMENSION(SIZE(PHC,1)) :: ZD_MID ! Thickness of the layer in the middle 00063 ! ! in case of odd number of layers 00064 REAL, DIMENSION(SIZE(PHC,1),0:SIZE(PHC ,2))::ZD_IN ! Depth from the surface 00065 ! ! to the layer bottom 00066 REAL, DIMENSION(SIZE(PHC,1),0:SIZE(PHC_OUT,2))::ZD_OUT ! Depth from the surface 00067 ! ! to the layer bottom 00068 REAL, DIMENSION(SIZE(PHC,1),SIZE(PHC,2)) :: ZW ! 1/TC 00069 REAL, DIMENSION(SIZE(PHC,1),SIZE(PHC_OUT,2)) :: ZW_OUT ! 1/TC 00070 INTEGER :: IIN ! Number of layer in input data 00071 INTEGER :: IOUT ! Number of layer in output fields 00072 INTEGER :: JIN ! Loop counter on input layers 00073 INTEGER :: JOUT ! Loop counter on output layers 00074 ! 00075 REAL, PARAMETER :: ZD_G1 = 0.001 ! uppermost soil layer 00076 ! ! thickness/depth ( m) 00077 ! ! Can not be too thin as 00078 ! ! then definition of soil 00079 ! ! properties (i.e. phyiscal 00080 ! ! representation of) and 00081 ! ! accuarcy of 00082 ! ! numerical solution come 00083 ! ! into question. If it is too 00084 ! ! thick, then resolution of 00085 ! ! diurnal cycle not as valid. 00086 !------------------------------------------------------------------------------- 00087 ! 00088 IIN = SIZE(PHC,2) 00089 IOUT= SIZE(PHC_OUT,2) 00090 ! 00091 !------------------------------------------------------------------------------- 00092 ! 00093 !* Depths for the computational grid 00094 ! 00095 !* total depth: 00096 ! 00097 ! 00098 ZD_IN(:,0) = 0. 00099 DO JIN=1,IIN 00100 ZD_IN(:,JIN) = ZD_IN(:,JIN-1) + PD(:,JIN) 00101 END DO 00102 ZD_TOT(:) = ZD_IN(:,IIN) 00103 ! 00104 !* surface like road or floor (thin grid at the surface, coarse at the bottom) 00105 ! 00106 IF (HTYPE=='ROAD ' .OR. HTYPE=='FLOOR') THEN 00107 ZD_OUT(:,0) = 0. 00108 CALL TEBGRID(ZD_TOT,ZD_OUT(:,1:),ZD_G1) 00109 PD_OUT(:,1) = ZD_OUT(:,1) 00110 DO JOUT=2,IOUT 00111 PD_OUT(:,JOUT) = ZD_OUT(:,JOUT) - ZD_OUT(:,JOUT-1) ! Depths => Thickness of layer 00112 END DO 00113 ELSE 00114 ! 00115 !* surface like roof or wall (thin grid on both sides, coarse in the middle) 00116 ! 00117 IF (MOD(IOUT,2)==0) THEN ! even number of output layers 00118 ZD_HALF(:) = ZD_TOT(:) / 2. 00119 ELSE ! odd number of output layers 00120 ZD_MID (:) = 2. * ZD_TOT(:) / IOUT ! middle layer is arbitrarily fixed 00121 IF (IOUT==3) ZD_MID=MAX(ZD_MID,ZD_TOT-2.*ZD_G1) ! to impose layers equal 00122 ! to ZD_G1 on both sides 00123 ZD_HALF(:) = (ZD_TOT(:)-ZD_MID(:)) / 2. 00124 PD_OUT (:,IOUT/2+1) = ZD_MID (:) 00125 END IF 00126 ZD_OUT(:,0) = 0. 00127 CALL TEBGRID(ZD_HALF,ZD_OUT(:,1:IOUT/2),ZD_G1) 00128 PD_OUT(:,1) = ZD_OUT(:,1) 00129 DO JOUT=2,IOUT/2 00130 PD_OUT(:,JOUT) = ZD_OUT(:,JOUT) - ZD_OUT(:,JOUT-1) ! Depths => Thickness of layer 00131 END DO 00132 DO JOUT=1,IOUT/2 00133 PD_OUT(:,IOUT+1-JOUT) = PD_OUT(:,JOUT) 00134 END DO 00135 !* recomputes Depths for further averagings 00136 DO JOUT=2,IOUT 00137 ZD_OUT(:,JOUT) = ZD_OUT(:,JOUT-1) + PD_OUT(:,JOUT) 00138 END DO 00139 00140 END IF 00141 ! 00142 DO JOUT=1,IOUT 00143 WHERE (PD(:,1)==XUNDEF) PD_OUT(:,JOUT) = XUNDEF 00144 END DO 00145 !------------------------------------------------------------------------------- 00146 ! 00147 !* Averaging of the Heat Capacity and the Thermal conductivity 00148 ! 00149 ZW=1./PTC(:,:) 00150 CALL AV_THERMAL_DATA(PHC,ZW,PHC_OUT,ZW_OUT) 00151 PTC_OUT=XUNDEF 00152 WHERE (ZW_OUT/=XUNDEF) PTC_OUT=1./ZW_OUT 00153 ! 00154 !------------------------------------------------------------------------------- 00155 CONTAINS 00156 !------------------------------------------------------------------------------- 00157 SUBROUTINE AV_THERMAL_DATA(PF1,PF2,PF1_OUT,PF2_OUT) 00158 REAL, DIMENSION(:,:), INTENT(IN) :: PF1 00159 REAL, DIMENSION(:,:), INTENT(IN) :: PF2 00160 REAL, DIMENSION(:,:), INTENT(OUT) :: PF1_OUT 00161 REAL, DIMENSION(:,:), INTENT(OUT) :: PF2_OUT 00162 ! 00163 REAL :: ZF1! ponderated field 00164 REAL :: ZF2! ponderated field 00165 REAL :: ZS ! sum of weights 00166 REAL :: ZC ! coefficient of ponderation 00167 REAL :: ZD_LIM ! limit of previous layer that has been treated 00168 ! 00169 INTEGER :: JL ! loop counter on spatial points 00170 REAL :: ZEPS=1.E-6 00171 ! 00172 DO JL=1,SIZE(PF1,1) 00173 IF (PD(JL,1)==XUNDEF) THEN 00174 PF1_OUT(JL,:) = XUNDEF 00175 PF2_OUT(JL,:) = XUNDEF 00176 CYCLE 00177 END IF 00178 ! 00179 ZF1 = 0. 00180 ZF2 = 0. 00181 ZS = 0. 00182 JIN = 1 00183 JOUT= 1 00184 ZD_LIM = 0. 00185 DO 00186 IF (JOUT>IOUT) EXIT 00187 ! 00188 IF (ZD_IN(JL,JIN)< ZD_OUT(JL,JOUT)-ZEPS) THEN 00189 ! ZC = ZD_IN(JL,JIN) - MAX(ZD_IN(JL,JIN-1),ZD_OUT(JL,JOUT-1)) 00190 ZC = ZD_IN(JL,JIN) - ZD_LIM 00191 ZF1 = ZF1 + ZC * PF1(JL,JIN) 00192 ZF2 = ZF2 + ZC * PF2(JL,JIN) 00193 ZS = ZS + ZC 00194 ZD_LIM = ZD_IN(JL,JIN) 00195 ! 00196 JIN=JIN+1 00197 ELSE 00198 ! ZC = ZD_OUT(JL,JOUT) - MAX(ZD_IN(JL,JIN-1),ZD_OUT(JL,JOUT-1)) 00199 ZC = ZD_OUT(JL,JOUT) - ZD_LIM 00200 ZF1 = ZF1 + ZC * PF1(JL,JIN) 00201 ZF2 = ZF2 + ZC * PF2(JL,JIN) 00202 ZS = ZS + ZC 00203 PF1_OUT(JL,JOUT) = ZF1/ZS 00204 PF2_OUT(JL,JOUT) = ZF2/ZS 00205 ZD_LIM = ZD_OUT(JL,JOUT) 00206 ! 00207 JOUT = JOUT+1 00208 ZF1 = 0. 00209 ZF2 = 0. 00210 ZS = 0. 00211 END IF 00212 END DO 00213 END DO 00214 ! 00215 END SUBROUTINE 00216 ! 00217 END SUBROUTINE THERMAL_LAYERS_CONF
1.8.0
