00001 00002 !==================SUBROUTINE DELEF====================================== 00003 00004 subroutine delef(sib,sib_loc) 00005 00006 use kinds 00007 use sibtype 00008 00009 use physical_parameters, only: & 00010 cp => spec_heat_cp, & 00011 hltm 00012 use sib_const_module, only: & 00013 snofac, & 00014 dtt 00015 00016 !======================================================================== 00017 ! 00018 ! Calculation of partial derivatives of canopy and ground latent 00019 ! heat fluxes with respect to Tc, Tg, Theta-m, and Qm. 00020 ! Calculation of initial latent heat fluxes. 00021 ! 00022 !pl the ETC, ETG and so on are the vapor pressure at temps TC, TG and so on 00023 !pl the BTC, BTG are the derivatives of ETC, ETG with relation to TC, TG etc. 00024 ! 00025 !======================================================================== 00026 00027 !++++++++++++++++++++++++++++++OUTPUT+++++++++++++++++++++++++++++++++++ 00028 ! 00029 ! EC ECT + ECI 00030 ! EG EGS + EGI 00031 ! ECDTC dEC/dTC 00032 ! ECDTG dEC/dTG 00033 ! ECDQM dEC/dQM 00034 ! EGDTC dEG/dTC 00035 ! EGDTG dEG/dTG 00036 ! EGDQM dEG/dQM 00037 ! BBC dE/dTC 00038 ! BBG dE/dTG 00039 ! BBM dE/dQM 00040 ! 00041 !+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 00042 00043 implicit none 00044 00045 !---------------------------------------------------------------------- 00046 00047 type(sib_t), intent(inout) :: sib 00048 00049 type(sib_local_vars) ,intent(inout) :: sib_loc 00050 ! variables local to SiB 00051 00052 !---------------------------------------------------------------------- 00053 00054 00055 ! local variables 00056 real(kind=dbl_kind) :: cpdpsy ! cp/psy 00057 00058 ! MODIFICATION FOR SOIL DRYNESS : HR=REL. HUMIDITY IN TOP LAYER 00059 00060 cpdpsy = cp / sib%diag%psy 00061 00062 !----------------------------------------------------------------------- 00063 ! 00064 ! CALCULATION OF SURFACE RESISTANCE COMPONENTS, SEE EQUATIONS (64,66) 00065 ! OF SE-86 00066 !pl gect(i) = (1. -wc(i)) / rc(i) 00067 !pl geci(i) = epsc(i) * wc(i) / (RB(I) + RB(I)) 00068 !pl gegs(i) = (1-wg(i)) / (rds(i)) 00069 !pl gegi(i) = epsg(i) * wg(i) / rd(i) 00070 ! 00071 !----------------------------------------------------------------------- 00072 00073 sib_loc%cog1 = (sib_loc%gegi + sib_loc%gegs*sib%diag%hrr) 00074 sib_loc%cog2 = (sib_loc%gegi + sib_loc%gegs ) 00075 00076 ! D2(I) = 1.0 / RA(I) + COC(I) + COG2(I) 00077 !----------------------------------------------------------------------- 00078 ! 00079 ! FLUXES EXPRESSED IN JOULES M-2 CPL WHY ????? 00080 ! 00081 ! ec (EC) : EQUATION (64) , SE-86 00082 ! eg (EG) : EQUATION (66) , SE-86 00083 ! es (ES) : EQUATION (66) , SE-86 00084 ! ea (EA) : EQUATION ???? 00085 !----------------------------------------------------------------------- 00086 00087 !pl these are the current time step fluxes in J/m2 00088 00089 !pl notice that the fluxes are already limited by the altered e*(T) values 00090 00091 sib%diag%ec = (sib_loc%etc - sib%prog%ea) * sib_loc%coc * & 00092 sib%prog%ros * dtt * cpdpsy 00093 00094 sib%diag%eg = ( sib_loc%etg * sib_loc%cog1 & 00095 - sib%prog%ea * sib_loc%cog2) * & 00096 sib%prog%ros * dtt * cpdpsy 00097 00098 sib%diag%es = ((sib_loc%ets - sib%prog%ea)/sib%diag%rd )* & 00099 sib%prog%ros * dtt * cpdpsy/snofac 00100 00101 sib%diag%fws = ((sib%prog%ea - sib%prog%em ) / sib%diag%ra) & 00102 * sib%prog%ros * dtt * cpdpsy 00103 00104 !pl now we do the partial derivatives these assume W/m2 00105 00106 !pl for the canopy leaves vapor pressure: W/ (m2* K) 00107 sib_loc%ecdtc = sib_loc%getc * sib_loc%coc * sib%prog%ros * cpdpsy 00108 00109 sib_loc%ecdea = - sib_loc%coc * sib%prog%ros * cpdpsy 00110 00111 !pl for ground latent heat fluxes: W/ (m2* K) 00112 sib_loc%egdtg = sib_loc%getg * sib_loc%cog1 * sib%prog%ros * cpdpsy 00113 00114 sib_loc%egdea = - sib_loc%cog2 * sib%prog%ros * cpdpsy 00115 00116 !pl for snow latent heat fluxes: W/ (m2* K) 00117 sib_loc%esdts = sib_loc%gets * sib%prog%ros * cpdpsy / sib%diag%rd / snofac 00118 00119 !pl for snow latent heat fluxes: W/ (m2 * Pa) 00120 sib_loc%esdea = - sib%prog%ros * cpdpsy / sib%diag%rd / snofac 00121 00122 !pl for CAS latent heat fluxes: W/ (m2* Pa) 00123 sib_loc%eadea = sib%prog%ros * cpdpsy / sib%diag%ra 00124 00125 sib_loc%eadem = - sib_loc%eadea 00126 00127 !PL ATTENTION !!!! DANGER !!! do not use without sibdrv = true 00128 !pl these all need to be re-done for the GCM (no sibdrv) 00129 !----------------------------------------------------------------------- 00130 ! BBC (dE/dTC) : EQUATION (13) , SA-89B 00131 ! BBG (dE/dTG) : EQUATION (13) , SA-89B 00132 ! BBM (dE/dQM) : EQUATION (13) , SA-89B 00133 !----------------------------------------------------------------------- 00134 ! BBG(I) = (COG1(I) / D2(i)) 00135 ! * * btg(I) * 0.622 * ps(i) 00136 ! * / ((ps(i) - etg(I)) * (ps(i) - etg(I))) 00137 ! BBC(I) = (COC(I) / D2(i)) 00138 ! * * getc(I) * 0.622 * ps(i) 00139 ! * / ((ps(i) - etc(I)) * (ps(i) - etc(I))) 00140 ! BBM(I) = 1.0 / (ra(I) * D2(i)) 00141 00142 00143 end subroutine delef
1.7.1