更新 Fortran/SUB_SHUILIANGJISUAN.f90

This commit is contained in:
zzx 2025-05-09 17:54:04 +08:00
parent 027e45867b
commit c8bef7928e

View File

@ -3,21 +3,21 @@
! FUNCTIONS/SUBROUTINES exported from SUB_SHUILIANGJISUAN.dll: ! FUNCTIONS/SUBROUTINES exported from SUB_SHUILIANGJISUAN.dll:
! SUB_SHUILIANGJISUAN - subroutine ! SUB_SHUILIANGJISUAN - subroutine
! !
subroutine SUB_SHUILIANGJISUAN( NDATA ,& ! // subroutine SUB_SHUILIANGJISUAN( NDATA ,& ! //
LONG ,& ! LONG ,& !
INbd ,& ! INbd ,& !
INzd ,& ! INzd ,& !
INsm ,& ! INsm ,& !
INrough ,& ! INrough ,& !
ZZ0 ,& ! ZZ0 ,& !
DB ,& ! 1. 2. DB ,& ! 1. 2.
UQ ,& ! UQ ,& !
DQH ,& ! / DQH ,& ! /
dt ,& ! dt ,& !
OUTT ,& ! OUTT ,& !
OUTQ ,& ! OUTQ ,& !
OUTH ) ! OUTH )& !
BIND(C, NAME="SUB_SHUILIANGJISUAN")
! Expose subroutine SUB_SHUILIANGJISUAN to users of this DLL ! Expose subroutine SUB_SHUILIANGJISUAN to users of this DLL
! !
!DEC$ ATTRIBUTES DLLEXPORT::SUB_SHUILIANGJISUAN !DEC$ ATTRIBUTES DLLEXPORT::SUB_SHUILIANGJISUAN
@ -43,11 +43,11 @@ INTEGER::FHD
REAL::OUTH(1000) REAL::OUTH(1000)
REAL::OUTT(1000) REAL::OUTT(1000)
REAL::DDGC ! REAL::DDGC !
REAL::MAXH REAL::MAXH
INTEGER::MY ! 1. 2. INTEGER::MY ! 1. 2.
integer River,tstep integer River,tstep
! node ! node
@ -84,44 +84,48 @@ INTEGER::FHD
INTEGER::TEMP INTEGER::TEMP
!OPEN(1,FILE='OUTFHDL.TXT') !OPEN(1,FILE='OUTFHDL.TXT')
!WRITE(1,*)' ! 计算时刻数 ', NDATA ,& !WRITE(1,*)' ! 计算时刻数 ', NDATA ,&
! ' ! 河道长度 ', LONG ,& ! ' ! 河道长度 ', LONG ,&
! '! 断面底宽 ', INbd ,& ! '! 断面底宽 ', INbd ,&
! '! 底高程 ' , INzd ,& ! '! 底高程 ' , INzd ,&
! '! 边坡系数 ', INsm ,& ! '! 边坡系数 ', INsm ,&
! ' ! 糙率 ' , INrough ,& ! ' ! 糙率 ' , INrough ,&
! ' ! 计算区域初始水位 ', ZZ0 ,& ! ' ! 计算区域初始水位 ', ZZ0 ,&
! ' ! 下游边界条件类型 1.水位边界 2.流量边界 ', DB ,& ! ' ! 下游边界条件类型 1.水位边界 2.流量边界 ', DB ,&
! ' ! 上游流量过程 ' , UQ ,& ! ' ! 上游流量过程 ' , UQ ,&
! ' ! 上游水位/流量过程 ', DQH ,& ! ' ! 上游水位/流量过程 ', DQH ,&
! ' ! 计算步长( 秒) ', dt ,& ! ' ! 计算步长( 秒) ', dt ,&
! '! 计算断面堤顶高程 ', DDGC ! '! 计算断面堤顶高程 ', DDGC
FHD = 0 FHD = 0
TEMP = 0 TEMP = 0
! 1. ! 1.
!open(1,file='河道组态数据.TXT') !open(1,file='河道组态数据.TXT')
! 1. 2. 3. 4. ! 1. 2. 3. 4.
!CALL SUB_GETNXT(1) !CALL SUB_GETNXT(1)
!read(1,*) !read(1,*)
nriver = 1 nriver = 1
nsect = 6 nsect = 6
krc = 0 krc = 0
mriver=nsect - 1 ! -1 mriver=nsect - 1 ! -1
ALLOCATE(Ns(nriver),Pc(nriver),Nrc(krc,nriver),Lc(krc,nriver)) ALLOCATE(Ns(nriver),Pc(nriver),Nrc(krc,nriver),Lc(krc,nriver))
ALLOCATE(Dric(krc,nriver),Qj(ndata,krc,nriver),Asave(krc,nriver)) ALLOCATE(Dric(krc,nriver),Qj(ndata,krc,nriver),Asave(krc,nriver))
ALLOCATE(ds(mriver,nriver),bd(nsect,nriver),zd(nsect,nriver),sm(nsect,nriver), rough(nsect,nriver)) ALLOCATE(ds(mriver,nriver),bd(nsect,nriver),zd(nsect,nriver),&
ALLOCATE(UB1(nriver),UB2(nriver),DB1(nriver),DB2(nriver),NUB(2,nriver),NDB(2,nriver)) sm(nsect,nriver), rough(nsect,nriver))
ALLOCATE(UBV(ndata,nriver),Aphi(2,nriver),DBV(ndata,nriver),Gate(4,nriver)) ALLOCATE(UB1(nriver),UB2(nriver),DB1(nriver),DB2(nriver),&
ALLOCATE(Z0(nsect,nriver),Q0(nsect,nriver),Z(nsect,nriver),Q(nsect,nriver),V(nsect,nriver)) NUB(2,nriver),NDB(2,nriver))
ALLOCATE(UBV(ndata,nriver),Aphi(2,nriver),DBV(ndata,nriver),&
Gate(4,nriver))
ALLOCATE(Z0(nsect,nriver),Q0(nsect,nriver),Z(nsect,nriver),&
Q(nsect,nriver),V(nsect,nriver))
ALLOCATE(Qp(ndata)) ALLOCATE(Qp(ndata))
ALLOCATE(Zc(nsect,nriver),Qc(nsect,nriver)) ALLOCATE(Zc(nsect,nriver),Qc(nsect,nriver))
! 1. 2. 3. ! 1. 2. 3.
! !
! CALL SUB_GETNXT(1) ! CALL SUB_GETNXT(1)
! DO I = 1,nriver ! DO I = 1,nriver
!read(1,*)II,Ns(i),Pc(i) !read(1,*)II,Ns(i),Pc(i)
@ -129,9 +133,9 @@ INTEGER::FHD
Ns(1) = 6 Ns(1) = 6
Pc(1) = 0 Pc(1) = 0
!! 1. 2. 3. 4. !! 1. 2. 3. 4.
! 123 ! 123
! 1-1 ! 1-1
Nrc = 0 Nrc = 0
Lc = 0 Lc = 0
Dric = 0 Dric = 0
@ -142,7 +146,7 @@ INTEGER::FHD
! END DO ! END DO
! END DO ! END DO
! !
Qj = 0.0 Qj = 0.0
!DO k=1,nriver !DO k=1,nriver
! DO j=1,Pc(k) ! DO j=1,Pc(k)
@ -153,7 +157,7 @@ INTEGER::FHD
! END DO ! END DO
! END DO ! END DO
! m2 ! m2
Asave = 0.0 Asave = 0.0
!DO k=1,nriver !DO k=1,nriver
! DO j=1,Pc(k) ! DO j=1,Pc(k)
@ -164,12 +168,12 @@ INTEGER::FHD
! END DO ! END DO
! END DO ! END DO
! 2. ! 2.
! CALL SUB_GETNXT(1) ! CALL SUB_GETNXT(1)
! ds = 0.0 ! ds = 0.0
! DO J = 1,nriver ! DO J = 1,nriver
! DO I = 1,Ns(j)-1 ! DO I = 1,Ns(j)-1
!read(1,*)II,II,ds(i,j) ! 0 !read(1,*)II,II,ds(i,j) ! 0
! END DO ! END DO
! END DO ! END DO
@ -182,7 +186,7 @@ INTEGER::FHD
! rough = 0.0 ! rough = 0.0
! DO j=1,nriver ! DO j=1,nriver
! DO I =1,Ns(j) ! DO I =1,Ns(j)
!read(1,*)II,II,bd(i,j),zd(i,j),sm(i,j),rough(i,j) ! !read(1,*)II,II,bd(i,j),zd(i,j),sm(i,j),rough(i,j) !
! END DO ! END DO
! END DO ! END DO
@ -191,31 +195,31 @@ INTEGER::FHD
sm = INsm sm = INsm
rough = INrough rough = INrough
! 3. ! 3.
! CALL SUB_GETNXT(1) ! CALL SUB_GETNXT(1)
! read(1,*)ZZ0,Zctr ! ZZ0,Zctr, ! read(1,*)ZZ0,Zctr ! ZZ0,Zctr,
Zctr = 0.0 Zctr = 0.0
Scanal = 0.0 ! Scanalql Scanal = 0.0 ! Scanalql
DO J = 1,nriver DO J = 1,nriver
DO I = 1,Ns(j)-1 DO I = 1,Ns(j)-1
Scanal = Scanal + ds(i,j) ! 0 Scanal = Scanal + ds(i,j) ! 0
END DO END DO
END DO END DO
!CALL SUB_GETNXT(1) !CALL SUB_GETNXT(1)
!DO I = 1,ndata !DO I = 1,ndata
! read(1,*)II,Qp(i) ! Qp ! read(1,*)II,Qp(i) ! Qp
! END DO ! END DO
Qp = 0.0 Qp = 0.0
! UB1上游边界条件类型112,3 ! UB1上游边界条件类型112,3
! UB2上游边界条件类型212 ! UB2上游边界条件类型212
! DB1下游边界条件类型112,3 ! DB1下游边界条件类型112,3
! DB2下游边界条件类型212 ! DB2下游边界条件类型212
!CALL SUB_GETNXT(1) !CALL SUB_GETNXT(1)
! DO I = 1,nriver ! DO I = 1,nriver
! read(1,*)II,UB1(i),UB2(i),DB1(i),DB2(i) ! read(1,*)II,UB1(i),UB2(i),DB1(i),DB2(i)
@ -234,10 +238,10 @@ INTEGER::FHD
UBV = 0.0 UBV = 0.0
NUB = 0 NUB = 0
!DO i=1,nriver !DO i=1,nriver
! if(UB2(i).eq.1)then ! ! if(UB2(i).eq.1)then !
! read(1,*)II,II,II,(UBV(j,i),j=1,ndata) ! ! read(1,*)II,II,II,(UBV(j,i),j=1,ndata) !
! elseif(UB2(i).eq.2)then ! ! elseif(UB2(i).eq.2)then !
! read(1,*)II,II,II,(NUB(j,i),j=1,2) ! ! read(1,*)II,II,II,(NUB(j,i),j=1,2) !
! endif ! endif
! END DO ! END DO
@ -247,17 +251,19 @@ INTEGER::FHD
!CALL SUB_GETNXT(1) !CALL SUB_GETNXT(1)
!DO i=1,nriver !DO i=1,nriver
! if(DB2(i).eq.1)then ! ! if(DB2(i).eq.1)then !
! if(DB1(i).eq.3)then ! ! if(DB1(i).eq.3)then !
! read(1,*)II,II,II,(DBV(j,i),j=1,ndata),(Gate(j,i),j=1,4) ! Gate(1,i) = Gate(2,i) = Gate(3,i) = C1Gate(4,i) = C2 Q=C1*B*e*dZ^C2中的C1和C2 ! read(1,*)II,II,II,(DBV(j,i),j=1,ndata),&
(Gate(j,i),j=1,4) ! Gate(1,i) = Gate(2,i) = Gate(3,i) = C1Gate(4,i) = C2 Q=C1*B*e*dZ^C2中的C1和C2
! ELSE ! ELSE
! read(1,*)II,II,II,(DBV(j,i),j=1,ndata) ! ! read(1,*)II,II,II,(DBV(j,i),j=1,ndata) !
! end if ! end if
! elseif(DB2(i).eq.2)then ! ! elseif(DB2(i).eq.2)then !
! if(DB1(i).eq.2)then ! if(DB1(i).eq.2)then
! read(1,*)II,II,II,(NDB(j,i),j=1,2),(Aphi(j,i),j=1,2) ! ! read(1,*)II,II,II,(NDB(j,i),j=1,2),&
(Aphi(j,i),j=1,2) !
! ELSE ! ELSE
! read(1,*)II,II,II,(NDB(j,i),j=1,2) ! ! read(1,*)II,II,II,(NDB(j,i),j=1,2) !
! end if ! end if
! endif ! endif
!END DO !END DO
@ -266,13 +272,13 @@ INTEGER::FHD
DBV(I,1) = DQH(I) DBV(I,1) = DQH(I)
END DO END DO
! 4. ! 4.
!CALL SUB_GETNXT(1) !CALL SUB_GETNXT(1)
!read(1,*)period,dt,sita ! perioddt,sita !read(1,*)period,dt,sita ! perioddt,sita
!CALL SUB_GETNXT(1) !CALL SUB_GETNXT(1)
!read(1,*)sorz,sorq,epsz,epsq ! sorzsorq,epszepsq !read(1,*)sorz,sorq,epsz,epsq ! sorzsorq,epszepsq
!CALL SUB_GETNXT(1) !CALL SUB_GETNXT(1)
!read(1,*)Bsor1,Bsor2 ! Bsor1Bsor2 !read(1,*)Bsor1,Bsor2 ! Bsor1Bsor2
!close(1) !close(1)
period =REAL( NDATA - 1 ) period =REAL( NDATA - 1 )
@ -290,11 +296,11 @@ INTEGER::FHD
Bsor2 = 0.1 Bsor2 = 0.1
! !
maxtstep=period*3600/dt maxtstep=period*3600/dt
maxiter=1000 ! 仿 maxiter=1000 ! 仿
! !
DO river=1,nriver DO river=1,nriver
DO Is=1,Ns(river) DO Is=1,Ns(river)
Z0(Is,river)=ZZ0 Z0(Is,river)=ZZ0
@ -302,24 +308,24 @@ INTEGER::FHD
END DO END DO
END DO END DO
! !
!open(1,file='河道1各断面水位变化.TXT') !open(1,file='河道1各断面水位变化.TXT')
!open(2,file='河道2各断面水位变化.TXT') !open(2,file='河道2各断面水位变化.TXT')
!open(3,file='河道3各断面水位变化.TXT') !open(3,file='河道3各断面水位变化.TXT')
!open(4,file='河道4各断面水位变化.TXT') !open(4,file='河道4各断面水位变化.TXT')
! !
!open(11,file='河道1各断面流量变化.TXT') !open(11,file='河道1各断面流量变化.TXT')
!open(12,file='河道2各断面流量变化.TXT') !open(12,file='河道2各断面流量变化.TXT')
!open(13,file='河道3各断面流量变化.TXT') !open(13,file='河道3各断面流量变化.TXT')
!open(14,file='河道4各断面流量变化.TXT') !open(14,file='河道4各断面流量变化.TXT')
! ---------------------------------------------------------------------------------- ! ----------------------------------------------------------------------------------
! !
! ---------------------------------------------------------------------------------- ! ----------------------------------------------------------------------------------
DO tstep=1,maxtstep ! DO tstep=1,maxtstep !
TEMP = TEMP + 1 TEMP = TEMP + 1
ttime=dt*tstep/3600.0 ! ttime=dt*tstep/3600.0 !
! write(*,15)ttime ! write(*,15)ttime
iter=0 iter=0
@ -330,11 +336,11 @@ INTEGER::FHD
END DO END DO
END DO END DO
! !
call int_a( ttime ,& ! // call int_a( ttime ,& ! //
ndata ,& ! ndata ,& !
Qp ,& ! 线 Qp ,& ! 线
fc ) ! // fc ) ! //
ql=fc/Scanal ql=fc/Scanal
@ -348,7 +354,7 @@ INTEGER::FHD
END DO END DO
DO river=1,nriver DO river=1,nriver
! !
call sub_bound( NRIVER ,& call sub_bound( NRIVER ,&
NSECT ,& NSECT ,&
MRIVER ,& MRIVER ,&
@ -387,7 +393,7 @@ INTEGER::FHD
condu ,& condu ,&
condd ) condd )
! Z和流量Q ! Z和流量Q
call sub_QZ( NRIVER ,& call sub_QZ( NRIVER ,&
NSECT ,& NSECT ,&
MRIVER ,& MRIVER ,&
@ -461,8 +467,10 @@ INTEGER::FHD
DO river=1,nriver DO river=1,nriver
DO Is=1,Ns(river) DO Is=1,Ns(river)
Z(Is,river)=(1.0-sorz)*Zc(Is,river)+sorz*Z(Is,river) Z(Is,river)=(1.0-sorz)*Zc(Is,river)+&
Q(Is,river)=(1.0-sorq)*Qc(Is,river)+sorq*Q(Is,river) sorz*Z(Is,river)
Q(Is,river)=(1.0-sorq)*Qc(Is,river)+&
sorq*Q(Is,river)
END DO END DO
END DO END DO
@ -477,7 +485,7 @@ INTEGER::FHD
DO river=1,nriver DO river=1,nriver
DO Is=1,Ns(river) DO Is=1,Ns(river)
! !
call sub_sect(NRIVER ,& call sub_sect(NRIVER ,&
NSECT ,& NSECT ,&
MRIVER ,& MRIVER ,&
@ -499,7 +507,7 @@ INTEGER::FHD
END DO END DO
END DO END DO
! !
DO jj=1,nriver DO jj=1,nriver
!write(jj,80)ttime,(Z(ii,jj),ii=1,Ns(jj)) !write(jj,80)ttime,(Z(ii,jj),ii=1,Ns(jj))
END DO END DO
@ -540,8 +548,9 @@ INTEGER::FHD
close(14) close(14)
15 format(55x,'time=',f10.2) 15 format(55x,'time=',f10.2)
50 format(55x,'iter=',i5/1x,'maxz_r=',i5,5x,'maxz_s=',i5,5x,'dzmax=',e10.4/1x,'maxq_r=',i5,5x,'maxq_s=',i5,5x,'dqmax=',e10.4) 50 format(55x,'iter=',i5/1x,'maxz_r=',i5,5x,'maxz_s=',i5,&
55 format(1x,'迭代发散') 5x,'dzmax=',e10.4/1x,'maxq_r=',i5,5x,'maxq_s=',i5,5x,'dqmax=',e10.4)
55 format(1x,'迭代发散')
80 format(1x,40f12.4) 80 format(1x,40f12.4)
@ -552,10 +561,10 @@ INTEGER::FHD
! MY = 0 ! MY = 0
!END IF !END IF
!WRITE(1,*)' ! 1.漫溢 0.未漫溢 ' , MY ,& !WRITE(1,*)' ! 1.漫溢 0.未漫溢 ' , MY ,&
! '! 计算断面输出时刻 ', OUTT ,& ! '! 计算断面输出时刻 ', OUTT ,&
! '! 计算断面输出流量 ', OUTQ ,& ! '! 计算断面输出流量 ', OUTQ ,&
! '! 计算断面输出水位 ', OUTH ! '! 计算断面输出水位 ', OUTH
CLOSE(1) CLOSE(1)