[Fortran] 纯文本查看 复制代码
MODULE PARM
IMPLICIT NONE
INTEGER,PARAMETER::SL=10
INTEGER::K,I,DEPTHLAYER
INTEGER::Z(11)
REAL::SBETA,DDFROOT,CV,DG,WT1,&
&DP,WC,DD,ST0,DF,ZD,BCV,TBARE,TCOV,TSURF,TLAG,&
&UND,CNB,&
&PUND,STN,RAT,DELG,PHU,G,PAR,EFFECTIVE_LAI,PDM,BE,&
&ADM,ADM1,ADM2,DAYNPP,ALAI,DM,&
&RATE_REDUCTION1,RATE_REDUCTION2,RATE_REDUCTION3,AGLIVE_REDUCTION,&
&AGDEAD_REDUCTION,BGDM_REDUCTION,AGDEAD,RSD1,FON1,X,WFPS,FL
REAL::CN_ACTIVE,CN_PASSIVE,WFACTOR,TFACTOR,TWFACTOR,CNR,&
&CNRF,CNFACTOR,DECR,FRESHC,TO_BC,TO_MC,&
&FRESHN,N_DEMAND,NIT,N_SUPPLY,SCALEOF,RMN,F_NH4,F_NO3,DELTA_N,&
&HMC,HMN,HC,HN,DEATH_N,RBN1,&
&RBC2,D_NH4,FT,ZZ,FDEPTH,FCEC,&
&SWFACTOR,STFACTOR,PHFACTOR,RNIT,WDFACTOR,RDEN,VNO3,VNH4
REAL::BETA(SL),SOILBD(SL),SOILPOR(SL),SOILWP(SL),SOILFC(SL),&
&SOILSW(SL),SOILSAT(SL),KSAT(SL),CEC(SL),PH(SL),HUM(SL),WP(SL),&
&FC(SL),SWMAX(SL),SW(SL),SW25(SL),T(SL),MTC(SL),BTC(SL),WATERFLUX(SL)
REAL::RSD(SL),SMN(SL),SN(SL),SBN1(SL),SBN2(SL),SMC(SL),SC(SL),&
&SBC1(SL),SBC2(SL),AMMO(SL),SNH4(SL),NITR(SL),SNO3(SL),UPNO3(SL),&
&UPNH4(SL),UP_SNH4(SL),UP_SNO3(SL),FON(SL)
!SOIL PHYSICAL PROPERTIES
DATA SOILBD/1.15,1.49,1.43,1.35,1.35,1.35,1.35,1.35,1.35,1.35/
DATA SOILWP/0.1,0.1,0.1,0.1,0.1,0.1,0.1,0.1,0.1,0.1/
DATA SOILFC/0.5,0.4,0.4,0.4,0.4,0.3,0.3,0.3,0.3,0.3/
DATA SOILSW/0.08,0.15,0.2,0.2,0.2,0.2,0.2,0.2,0.2,0.2/
DATA SOILSAT/0.57,0.44,0.46,0.49,0.49,0.49,0.49,0.49,0.49,0.49/
DATA KSAT/33,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5/
!SOIL CHEMICAL PROPERTIES
DATA CEC/8.2,6.6,8.5,11.8,5,5,5,5,5,5/
DATA PH/5.1,4.9,5.7,6.1,6.1,7.1,7.1,7.1,7.1,7.1/
DATA HUM/2.83,1.15,0.8,0.63,1.91,1.31,1.15,1.15,1.15,1.15/
DATA FON/0.15,0.06,0.05,0.05,0.05,0.05,0.05,0.05,0.05,0.05/
DATA SNO3/26.6,10,25,15,5,5,5,5,5,5/
DATA SNH4/1.5,2.5,2.5,1.5,1.5,1.5,1.5,1.5,1.5,1.5/
INTEGER::SLAYER=10
REAL::FBC1=0.25,FBC2=0.75,ANNNPP=0,ABD=0
REAL::RAD=27 !临时数据
REAL::TMX=38 !临时数据
REAL::TMN=23 !临时数据
REAL::RAINFALL=1.3 !临时数据
END MODULE PARM
!INITIALIZE THE SOIL PROPERTY
SUBROUTINE SOILPROP()
USE PARM
IMPLICIT NONE
REAL::FAOT,ALFA,FWMC,CN_MC,CFON,RESIDUE
FAOT=0.01
ALFA=0.04
FWMC=0.468
CN_MC=11.8
RESIDUE=2000
CFON=0.4
DO I=1,100
IF (I==1) THEN
Z(I)=0
ELSE IF (1<I<=11) THEN
Z(I)=(I-1)*10
ELSE IF (I>11.AND.I<=13) THEN
Z(I)=100+(I-11)*50
ELSE IF (I>13) THEN
Z(I)=200+(I-13)*100
END IF
END DO
DO K=1,SLAYER-1
MTC(K)=EXP(-FAOT*(Z(K)+Z(K+1))*0.5)
BTC(K)=MTC(K)
END DO
DO K=1,SLAYER
SOILPOR(K)=SOILBD(K)/2.65
DG=Z(K+1)-Z(K)
WT1=SOILBD(K)*DG/100
ABD=ABD+SOILPOR(K)*DG*10
T(K)=20
SBC1(K)=ALFA*BTC(K)*HUM(K)*FBC1
SBN1(K)=SBC1(K)/8
SBC2(K)=ALFA*BTC(K)*HUM(K)*FBC2
SBN2(K)=3*SBN1(K)
SMC(K)=FWMC*MTC(K)*(HUM(K)-SBC1(K)-SBC2(K))
SMN(K)=SMC(K)/CN_MC
SC(K)=HUM(K)-SBC1(K)-SBC2(K)-SMC(K)
SN(K)=FON(K)*10000*WT1-SBN1(K)-SBN2(K)-SMN(K)
SNO3(K)=SNO3(K)*WT1
SNH4(K)=SNH4(K)*WT1
IF (K==1) THEN
RSD(K)=RESIDUE+RESIDUE/0.7*0.3*BETA(K)
ELSE
RSD(K)=RESIDUE/0.7*0.3*BETA(K)
END IF
FON(K)=RSD(K)*CFON/100
END DO
ABD=ABD/(10*Z(SLAYER))
CV=RSD(1)
DO K=1,SLAYER
WP(K)=SOILWP(K)
FC(K)=SOILFC(K)-SOILWP(K)
SWMAX(K)=SOILSAT(K)-SOILWP(K)
SW(K)=SOILSW(K)-SOILWP(K)
SW(K)=MIN(SWMAX(K),SW(K))
END DO
RETURN
END SUBROUTINE SOILPROP
PROGRAM MAIN
USE PARM
IMPLICIT NONE
CALL SOILPROP()
WRITE(*,*) (SBC1(K),K=1,10)
END