SUBROUTINE CLASSB(THPOR,THLRET,THLMIN,BI,PSISAT,GRKSAT, 1
1 GRKTLD,THLRAT,HCPS,TCS,THFC,PSIWLT,
2 DELZW,ZBOTW,ALGWET,ALGDRY,
3 SAND,CLAY,ORGM,SDEPTH,
4 NT,NM,IT,IM,IG)
C
C * AUG 19/04 - Y.DELAGE. REGROUP COMMON BLOCKS
C MAKE EXPLICIT DECLARATIONS
C * JUN 28/02 - D.VERSEGHY. ASSIGN SOIL HYDROLOGICAL AND
C * THERMAL PROPERTIES BASED ON
C * SAND, CLAY AND ORGANIC MATTER
C * CONTENT.
IMPLICIT NONE
INTEGER NT,NM,IT,IM,IG,I,M,J
REAL VSAND,VORG,VCLAY,VTOT
C
C * OUTPUT ARRAYS.
C
REAL THPOR (NT,NM,IG), THLRET(NT,NM,IG), THLMIN(NT,NM,IG),
1 BI (NT,NM,IG), PSISAT(NT,NM,IG), GRKSAT(NT,NM,IG),
2 GRKTLD(NT,NM,IG), THLRAT(NT,NM,IG), HCPS (NT,NM,IG),
3 TCS (NT,NM,IG), THFC (NT,NM,IG), PSIWLT(NT,NM,IG),
4 DELZW (NT,NM,IG), ZBOTW (NT,NM,IG),
4 ALGWET(NT,NM), ALGDRY(NT,NM)
C
INTEGER ISAND (NT,NM,IG), IORG (NT,NM,IG)
C
C * INPUT ARRAYS.
C
REAL SAND (NT,NM,IG), CLAY (NT,NM,IG), ORGM (NT,NM,IG),
1 SDEPTH(NT,NM)
C
C * WORK ARRAYS.
C
REAL THSAND(NT,NM,IG), THCLAY(NT,NM,IG), THORG (NT,NM,IG)
C
#include "class_com.cdk"
C---------------------------------------------------------------------
C
DO 100 J=1,IG
DO 100 M=1,IM
DO 100 I=1,IT
ISAND (I,M,J)=NINT(SAND(I,M,J))
IORG (I,M,J)=NINT(ORGM(I,M,J))
IF(ISAND(I,M,J).EQ.-4) THEN
THPOR (I,M,J)=0.0
THLRET(I,M,J)=0.0
THLMIN(I,M,J)=0.0
BI (I,M,J)=0.0
PSISAT(I,M,J)=0.0
GRKSAT(I,M,J)=0.0
GRKTLD(I,M,J)=0.0
THLRAT(I,M,J)=0.0
HCPS(I,M,J)=HCPICE
TCS(I,M,J)=TCICE
ELSEIF(ISAND(I,M,J).EQ.-3) THEN
THPOR (I,M,J)=0.0
THLRET(I,M,J)=0.0
THLMIN(I,M,J)=0.0
BI (I,M,J)=0.0
PSISAT(I,M,J)=0.0
GRKSAT(I,M,J)=0.0
GRKTLD(I,M,J)=0.0
THLRAT(I,M,J)=0.0
HCPS(I,M,J)=HCPSND
TCS(I,M,J)=TCSAND
ELSEIF(ISAND(I,M,J).EQ.-2) THEN
THPOR (I,M,J)=THPORG(IORG(I,M,J))
THLRET(I,M,J)=THRORG(IORG(I,M,J))
THLMIN(I,M,J)=THMORG(IORG(I,M,J))
BI (I,M,J)=BORG(IORG(I,M,J))
PSISAT(I,M,J)=PSISORG(IORG(I,M,J))
GRKSAT(I,M,J)=GRKSORG(IORG(I,M,J))
GRKTLD(I,M,J)=GRKSAT(I,M,J)/2.0
THLRAT(I,M,J)=0.5**(1.0/(2.0*BI(I,M,J)+3.0))
HCPS(I,M,J)=HCPOM
TCS(I,M,J)=TCOM
ELSEIF(SAND(I,M,J).GT.0) THEN
THPOR (I,M,J)=(-0.126*SAND(I,M,J)+48.9)/100.0
THLRET(I,M,J)=0.04
THLMIN(I,M,J)=0.04
BI (I,M,J)=0.159*CLAY(I,M,J)+2.91
PSISAT(I,M,J)=(10.0**(-0.0131*SAND(I,M,J)+1.88))/100.0
GRKSAT(I,M,J)=(10.0**(0.0153*SAND(I,M,J)-0.884))*
1 7.0556E-6
GRKTLD(I,M,J)=GRKSAT(I,M,J)/2.0
THLRAT(I,M,J)=0.5**(1.0/(2.0*BI(I,M,J)+3.0))
VSAND=SAND(I,M,J)/(RHOSOL*100.0)
VORG=ORGM(I,M,J)/(RHOOM*100.0)
VCLAY=(100.0-SAND(I,M,J)-ORGM(I,M,J))/(RHOSOL*100.0)
VTOT=VSAND+VCLAY+VORG
THSAND(I,M,J)=(1.0-THPOR(I,M,J))*VSAND/VTOT
THORG(I,M,J)=(1.0-THPOR(I,M,J))*VORG/VTOT
THCLAY(I,M,J)=1.0-THPOR(I,M,J)-THSAND(I,M,J)-THORG(I,M,J)
HCPS(I,M,J)=(HCPSND*THSAND(I,M,J)+HCPCLY*THCLAY(I,M,J)+
1 HCPOM*THORG(I,M,J))/(1.0-THPOR(I,M,J))
TCS(I,M,J)=((TCSAND**THSAND(I,M,J))*(TCOM**THORG(I,M,J))*
1 (TCCLAY**THCLAY(I,M,J)))**(1.0/(1.0-THPOR(I,M,J)))
ENDIF
IF(THPOR(I,M,J).GT.0.0) THEN
THFC(I,M,J)=EXP(LOG(1.157E-9/GRKSAT(I,M,J))/
1 (2.0*BI(I,M,J)+3.0)+LOG(THPOR(I,M,J)))
PSIWLT(I,M,J)=PSISAT(I,M,J)*(MIN(0.5*THFC(I,M,J),
1 THLMIN(I,M,J))/THPOR(I,M,J))**(-BI(I,M,J))
ELSE
THFC(I,M,J)=0.0
PSIWLT(I,M,J)=0.0
ENDIF
100 CONTINUE
C
DO 200 M=1,IM
DO 200 I=1,IT
IF(SDEPTH(I,M).LE.ZBOT(1)) THEN
DELZW(I,M,1)=SDEPTH(I,M)
DELZW(I,M,2)=0.0
DELZW(I,M,3)=0.0
ELSEIF(SDEPTH(I,M).LE.ZBOT(2)) THEN
DELZW(I,M,1)=DELZ(1)
DELZW(I,M,2)=SDEPTH(I,M)-ZBOT(1)
if(DELZW(I,M,2).lt..01) DELZW(I,M,2)=0.
DELZW(I,M,3)=0.0
ELSEIF(SDEPTH(I,M).LE.ZBOT(3)) THEN
DELZW(I,M,1)=DELZ(1)
DELZW(I,M,2)=DELZ(2)
DELZW(I,M,3)=SDEPTH(I,M)-ZBOT(2)
if(DELZW(I,M,3).lt..01) DELZW(I,M,3)=0.
ELSE
DELZW(I,M,1)=DELZ(1)
DELZW(I,M,2)=DELZ(2)
DELZW(I,M,3)=DELZ(3)
ENDIF
ZBOTW(I,M,1)=DELZW(I,M,1)
ZBOTW(I,M,2)=ZBOTW(I,M,1)+DELZW(I,M,2)
ZBOTW(I,M,3)=ZBOTW(I,M,2)+DELZW(I,M,3)
IF(SAND(I,M,1).GE.0.0) THEN
ALGWET(I,M)=0.08+0.0006*SAND(I,M,1)
ALGDRY(I,M)=0.14+0.0024*SAND(I,M,1)
ELSE
ALGWET(I,M)=0.0
ALGDRY(I,M)=0.0
ENDIF
200 CONTINUE
C
RETURN
END