00001 00002 !===================SUBROUTINE DELHF25===================================== 00003 00004 subroutine delhf(sib,sib_loc) 00005 00006 use kinds 00007 use sibtype 00008 00009 use physical_parameters, only : & 00010 cp => spec_heat_cp 00011 00012 use sib_const_module, only : & 00013 dtt 00014 00015 !======================================================================== 00016 ! 00017 ! Calculation of partial derivatives of canopy and ground sensible 00018 ! heat fluxes with respect to Tc, Tg, and Theta-m. 00019 ! Calculation of initial sensible heat fluxes. 00020 ! 00021 !======================================================================== 00022 00023 00024 !++++++++++++++++++++++++++++++OUTPUT+++++++++++++++++++++++++++++++++++ 00025 ! 00026 ! HC CANOPY SENSIBLE HEAT FLUX (J M-2) 00027 ! HG GROUND SENSIBLE HEAT FLUX (J M-2) 00028 ! HS SNOW SENSIBLE HEAT FLUX (J M-2) 00029 ! HA CAS SENSIBLE HEAT FLUX (J M-2) 00030 ! HCDTC dHC/dTC 00031 ! HCDTA dHC/dTA 00032 ! HGDTG dHG/dTG 00033 ! HGDTA dHG/dTA 00034 ! HSDTS dHS/dTS 00035 ! HSDTA dHS/dTA 00036 ! HADTA dHA/dTA 00037 ! HADTH dHA/dTH 00038 ! AAC dH/dTC 00039 ! AAG dH/dTG 00040 ! AAM dH/dTH 00041 ! 00042 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 00043 00044 implicit none 00045 00046 !---------------------------------------------------------------------- 00047 00048 type(sib_t), intent(inout) :: sib 00049 00050 type(sib_local_vars) ,intent(inout) :: sib_loc 00051 ! variables local to SiB 00052 00053 !---------------------------------------------------------------------- 00054 00055 00056 ! local variables 00057 ! REALX8 D1, d1i, 00058 real(kind=dbl_kind) :: rai ! 1/ra 00059 real(kind=dbl_kind) :: rbi ! 1/rb 00060 real(kind=dbl_kind) :: rdi ! 1/rd 00061 integer i 00062 00063 !----------------------------------------------------------------------- 00064 ! 00065 ! FLUXES EXPRESSED IN JOULES M-2, although in SIBSLV WE THEN WANT W/m2 00066 ! WHY ???? 00067 ! 00068 ! if we were to keep things simple, there is no need to separate 00069 ! HG and HS, but it helps the derivatives keep clean. 00070 ! 00071 ! HC (HC) : EQUATION (63) , SE-86 00072 ! HG (HG) : EQUATION (65) , SE-86 00073 ! HS (HS) : EQUATION (65) , SE-86 00074 ! HA (HA) : EQUATION ??? 00075 !----------------------------------------------------------------------- 00076 00077 rai = 1.0 / sib%diag%ra 00078 rbi = 1.0 / sib%diag%rb 00079 rdi = 1.0 / sib%diag%rd 00080 00081 ! these are the current time step fluxes in J/m2 00082 ! can we change this to W/m2 ??? 00083 sib%diag%hc = cp * sib%prog%ros * (sib%prog%tc - sib%prog%ta) & 00084 * rbi * dtt 00085 00086 if(sib%prog%nsl == 0 ) then !no snow case 00087 sib%diag%hg = cp * sib%prog%ros * & 00088 (sib%prog%td(1) - sib%prog%ta) * rdi * dtt 00089 sib%diag%hs = 0.0 00090 else ! snow case 00091 sib%diag%hg = 0.0 00092 sib%diag%hs = cp * sib%prog%ros * & 00093 (sib%prog%td(sib%prog%nsl+1) - sib%prog%ta) * rdi * dtt 00094 endif 00095 00096 00097 00098 sib%diag%fss = cp * sib%prog%ros * (sib%prog%ta - sib%prog%tm) & 00099 * rai * dtt 00100 00101 ! now we do the partial derivatives 00102 ! these are done assuming the fluxes in W/m2 00103 00104 ! for canopy leaves sensible heat flux: W/(m2 * K) 00105 ! 00106 sib_loc%hcdtc = cp * sib%prog%ros * rbi 00107 sib_loc%hcdta = - sib_loc%hcdtc 00108 ! 00109 ! for ground and snow sensible heat fluxes: W/(m2 * K) 00110 ! 00111 sib_loc%hgdtg = cp * sib%prog%ros * rdi 00112 sib_loc%hsdts = sib_loc%hgdtg 00113 sib_loc%hgdta = - sib_loc%hgdtg 00114 sib_loc%hsdta = - sib_loc%hgdtg 00115 ! 00116 ! for the canopy air space (CAS) sensible heat flux: W/(m2 * K) 00117 ! 00118 sib_loc%hadta = cp * sib%prog%ros * rai 00119 sib_loc%hadth = - sib_loc%hadta/sib%prog%bps(1) 00120 00121 ! ATTENTION !!!! DANGER !!!!! THIS WILL NOT WORK WITHOUT sibdrv = true 00122 ! for mixed layer (ref temp if not sibdrv): YET TO BE DONE 00123 !itb...LOOK AT SATO ET AL... 00124 ! AAG(I) = rdi * d1i 00125 ! AAC(I) = rbi * d1i 00126 ! AAM(I) = rai * d1i * bps(i) 00127 00128 00129 end subroutine delhf
1.7.1