2002 |
c-----temporary parameters |
c-----temporary parameters |
2003 |
|
|
2004 |
_RL zth,ff,xx,taup,sscp,gp,gm1,gm2,gm3,akk,alf1,alf2, |
_RL zth,ff,xx,taup,sscp,gp,gm1,gm2,gm3,akk,alf1,alf2, |
2005 |
* all,bll,st7,st8,cll,dll,fll,ell,st1,st2,st3,st4 |
* all1,bll,st7,st8,cll,dll,fll,ell,st1,st2,st3,st4 |
2006 |
c |
c |
2007 |
zth = one / csm |
zth = one / csm |
2008 |
|
|
2039 |
alf1 = gm1 - gm3 * xx |
alf1 = gm1 - gm3 * xx |
2040 |
alf2 = gm2 + gm3 * xx |
alf2 = gm2 + gm3 * xx |
2041 |
|
|
2042 |
c all is last term in eq(21) of K & H |
c all1 is last term in eq(21) of K & H |
2043 |
c bll is last term in eq(22) of K & H |
c bll is last term in eq(22) of K & H |
2044 |
|
|
2045 |
xx = akk * two |
xx = akk * two |
2046 |
all = (gm3 - alf2 * zth )*xx*td |
all1 = (gm3 - alf2 * zth )*xx*td |
2047 |
bll = (one - gm3 + alf1*zth)*xx |
bll = (one - gm3 + alf1*zth)*xx |
2048 |
|
|
2049 |
xx = akk * zth |
xx = akk * zth |
2069 |
c rr is r-hat of eq(21) of K & H |
c rr is r-hat of eq(21) of K & H |
2070 |
c tt is diffuse part of t-hat of eq(22) of K & H |
c tt is diffuse part of t-hat of eq(22) of K & H |
2071 |
|
|
2072 |
rr = ( cll-dll*st4 -all*st2)*st1 |
rr = ( cll-dll*st4 -all1*st2)*st1 |
2073 |
tt = - ((fll-ell*st4)*td-bll*st2)*st1 |
tt = - ((fll-ell*st4)*td-bll*st2)*st1 |
2074 |
|
|
2075 |
rr = max(rr,zero) |
rr = max(rr,zero) |
2528 |
c-----temporary array |
c-----temporary array |
2529 |
|
|
2530 |
integer i,j,k,ic,iw |
integer i,j,k,ic,iw |
2531 |
_RL xx,clog,wlog,dc,dw,x1,x2,y2 |
_RL xx,clog1,wlog,dc,dw,x1,x2,y2 |
2532 |
|
|
2533 |
c******************************************************************** |
c******************************************************************** |
2534 |
c-----include co2 look-up table |
c-----include co2 look-up table |
2545 |
do j= 1, n |
do j= 1, n |
2546 |
do i= 1, m |
do i= 1, m |
2547 |
xx=1./.3 |
xx=1./.3 |
2548 |
clog=log10(swc(i,j,k)*csm(i,j)) |
clog1=log10(swc(i,j,k)*csm(i,j)) |
2549 |
wlog=log10(swh(i,j,k)*csm(i,j)) |
wlog=log10(swh(i,j,k)*csm(i,j)) |
2550 |
ic=int( (clog+3.15)*xx+1.) |
ic=int( (clog1+3.15)*xx+1.) |
2551 |
iw=int( (wlog+4.15)*xx+1.) |
iw=int( (wlog+4.15)*xx+1.) |
2552 |
if(ic.lt.2)ic=2 |
if(ic.lt.2)ic=2 |
2553 |
if(iw.lt.2)iw=2 |
if(iw.lt.2)iw=2 |
2554 |
if(ic.gt.22)ic=22 |
if(ic.gt.22)ic=22 |
2555 |
if(iw.gt.19)iw=19 |
if(iw.gt.19)iw=19 |
2556 |
dc=clog-float(ic-2)*.3+3. |
dc=clog1-float(ic-2)*.3+3. |
2557 |
dw=wlog-float(iw-2)*.3+4. |
dw=wlog-float(iw-2)*.3+4. |
2558 |
x1=cah(1,iw-1)+(cah(1,iw)-cah(1,iw-1))*xx*dw |
x1=cah(1,iw-1)+(cah(1,iw)-cah(1,iw-1))*xx*dw |
2559 |
x2=cah(ic-1,iw-1)+(cah(ic-1,iw)-cah(ic-1,iw-1))*xx*dw |
x2=cah(ic-1,iw-1)+(cah(ic-1,iw)-cah(ic-1,iw-1))*xx*dw |