PROGRAM BVLE2
implicit real*8(a-h,o-z)
DIMENSION A(2,2), X(2),Y(2),PHIL(2),PHIV(2),B(2,2),YM(2),XM(2),yx(2)
DIMENSION DB(2),SA(2),AO(2,2),PR(2,2),PB(2,2)
COMMON/PUR/TC(3),PC(3),W(3),IND(3)
CHARACTER *55 TITLE
R=82.06
NC=2
READ(43,*) P1S,P2S,A(1,1),B(1,1),A(2,2),B(2,2)
READ(43,*) WM1,V1,WM2,V2
DO 22 I=1,NC
DO 22 J=1,NC
PR(I,J)=0.
22 PB(I,J)=0.
WRITE(6,*) 'TITLE=?'
READ(5,75) TITLE
75 FORMAT(A55)
write(22,77)title
77 format(10x,a55/5x,'X2',15x,'Y2',10x,'P(psia)',8x,'Y1/X1',10x,'Y2/X2'/)
40 WRITE(6,*) 'PR(1,2),PR(2,1),PB(1,2)=?TEMP,NWRITE=?'
READ(5,*) PR(1,2),PR(2,1),PB(1,2),TEMP,NWRITE
30 WRITE(6,*)' X1=? Y1(GUESS),PSIA(GUESS)=?'
READ(5,*) X(1),Y(1),PSIA
PB(2,1)=PB(1,2)
P=PSIA/14.696
XINC=0.
Y(2)=1.-Y(1)
43 IREP=0
ISK=0
NP=1
NY=1
DP=P*0.01
c DP=P*0.001
41 X(2)=1.-X(1)
CALL PRMIX2(A,B,X,2,NC,TEMP,P,PHIL,VL,DB,SA,AO,PR,PB)
NX1=0
IPS=0
62 CALL PRMIX2(A,B,Y,1,NC,TEMP,P,PHIV,VV,DB,SA,AO,PR,PB)
if(nwrite.eq.10) go to 85
DO 61 I=1,NC
if(y(i).eq.0) go to 61
Y(I)=DEXP(PHIL(I)-PHIV(I)+DLOG(Y(I)))
61 CONTINUE
CALL PRESEK(Y,NC,NX1,1.D-6,IPS,YSUM0,YSUM)
IF(IPS) 90,62,65
65 CONTINUE
CALL SEEK(YSUM,NY,P,DP,1.D-6,ISK,QI,PI,PF)
NP=NP+1
IF(NP.GT.50) THEN
WRITE(6,*) 'NP>50,P,YSUM,X,Y=',P,YSUM,X,Y
GO TO 90
END IF
IF(ISK) 91,41,80
91 CONTINUE
WRITE(6,*) 'YSUM UNCONV',YSUM,X,Y
GO TO 90
80 YDIF=YSUM-1.
Y(1)=Y(1)/YSUM
Y(2)=Y(2)/YSUM
CALL PRMIX2(A,B,Y,1,NC,TEMP,P,PHIV,VV,DB,SA,AO,PR,PB)
PSIA=P*14.696
85 denv=(wm1*y(1)+wm2*y(2))/vv
denl=(wm1*x(1)+wm2*x(2))/vl
write(6,*) 'vapor & liquid density=', denv,denl
WRITE(6,14)TEMP,PSIA,YDIF,VL,VV,X,Y,PHIL(1),PHIV(1),
1 PHIL(2),PHIV(2)
14 FORMAT(F8.3,2E15.5,2F13.3/4E15.6/4E15.6)
do 94 i=1,NC
if(x(i).eq.0) then
yx(i)=dexp(phil(i)-phiv(i))
go to 94
end if
yx(i)=Y(i)/x(i)
94 continue
IF(NWRITE.EQ.1) THEN
write(22,16) x(2),y(2),psia,yx(1),yx(2)
write(6,*) yx(1),yx(2)
write(6,*) a(2,2),b(2,2)
16 format(1x,e12.6,3x,e12.6,3x,f10.4,3x,e12.6,3x,e12.6)
WRITE(23,16) X(1),Y(1),psia,vl,vv
WRITE(25,*) Y(2),Psia
WRITE(28,*) X(2),yx(1)
WRITE(29,*) X(2),yx(2)
END IF
IF (NWRITE.EQ.2) THEN
WX2=X(2)*WM2/(X(1)*WM1+X(2)*WM2)
WY2=Y(2)*WM2/(Y(1)*WM1+Y(2)*WM2)
WRITE(22,16) WX2,WY2,PSIA
WRITE(23,*) WX2,WY2
WRITE(24,17) WX2,PSIA,denl,denv
17 format(1x,f10.6,3x,f10.3,3x,f10.4,3x,f10.6)
WRITE(25,*) WY2,PSIA
END IF
2 CONTINUE
IF(XINC.EQ.0) GO TO 90
X(1)=X(1)+XINC
IF(XINC.LT.0.and.X(1).LT.XEND) GO TO 90
IF(XINC.GT.0.and.X(1).GT.XEND) GO TO 90
GO TO 43
90 WRITE(6,*) 'FLAG=? 1: read x1,y1, 2: KA,KB; 3:XINC'
READ(5,*) FLAG
IF(FLAG.EQ.3) THEN
WRITE(6,*) 'X1=? XINC=? XEND=?'
READ(5,*) X(1),XINC,XEND
GO TO 43
END IF
if(flag.eq.1) go to 30
IF(FLAG.NE.0.) GO TO 40
95 continue
WRITE(22,33) temp,PR(1,2),PR(2,1),PB(1,2)
33 format(/1x,F10.2,' C', 5x,' KA12=',f7.4,5x,'KA21=',f7.4,5x,'KB=',f6.3)
stop
END
SUBROUTINE PRMIX2(A,B,Y,NX,NC,T,P,PHI,VMIX,DB,SA,AO,PR,PB)
implicit real*8(a-h,o-z)
DIMENSION A(NC,NC),B(NC,NC),DB(NC),Y(NC),PHI(NC),SA(NC)
R=82.06000
NCOMP=NC
AMIX=0.
BMIX=0.
YSUM=0.
DO 10 I=1,NCOMP
YSUM=YSUM+Y(I)
SA(I)=0.
DO 10 J=1,NCOMP
10 AO(I,J)=(A(I,I)*A(J,J))**.5
DO 20 I=1,NCOMP
DO 20 J=1,NCOMP
b(i,j)=.5*(b(i,i)+b(j,j))*(1.-pb(i,j))
IF(Y(I).EQ.0..AND.Y(J).EQ.0.) GO TO 20
A(I,J)=AO(I,J)*(1.-(PR(I,J)*Y(I)+PR(J,I)*Y(J))/(Y(I)+Y(J)))
SA(I)=SA(I)+AO(I,J)*(Y(J)-(2.*Y(I)*Y(J)*PR(I,J)+Y(J)*Y(J)*PR(J,I))/(Y(I)+Y(J))+(Y(I)*Y(I)*Y(J)*PR(I,J)+Y(I)*Y(J)*Y(J)*PR(J,I))/(Y(I)+Y(J))**2)/YSUM
20 CONTINUE
DO 33 I=1,NCOMP
DB(I)=0.
DO 33 J=1,NCOMP
AMIX=AMIX+Y(I)*Y(J)*A(I,J)
BMIX=BMIX+Y(I)*Y(J)*B(I,J)
33 CONTINUE
AMIX=AMIX/YSUM**2
BMIX=BMIX/YSUM**2
if(p.le.0.001.and.nx.eq.2) then
aq=amix/(r*t)
sec=((2.*bmix-aq)**2+4.*(bmix**2-aq*bmix))**.5
vmix=(aq-2.*bmix-sec)*.5
go to 4
end if
if(p.le.0.001.and.nx.eq.1) then
vmix=r*t/p
go to 4
end if
34 CONTINUE
RTP=R*T/P
A2=BMIX-R*T/P
A1=AMIX/P-3.*BMIX**2-2.*BMIX*R*T/P
A0=BMIX**3+BMIX**2*R*T/P-AMIX*BMIX/P
CALL VOLUME(A2,A1,A0,NX,VMIX)
4 CONTINUE
IF(VMIX.LE.BMIX) WRITE(6,*) ' VMIX < BMIX,nx,P,VMIX,BMIX=',
1nx,P,VMIX,BMIX
TERM2=(VMIX+(1.+2.**.5)*BMIX)/(VMIX+(1.-2.**.5)*BMIX)
DO 70 I=1,NCOMP
DO 80 J=1,NCOMP
DB(I)=DB(I)+2.*Y(J)*B(J,I)/YSUM
80 CONTINUE
DB(I)=DB(I)-BMIX
TERM3=(2.*SA(I)/AMIX-DB(I)/BMIX)*AMIX/(8.**.5*R*T*BMIX)
TERM1=(P*VMIX/(R*T)-1.)*DB(I)/BMIX-DLOG((VMIX-BMIX)/(R*T))
PHI(I)=TERM1-TERM3*DLOG(TERM2)
IF(Y(I).EQ.0.) GO TO 70
PHI(I)=PHI(I)+DLOG(Y(I))
70 CONTINUE
RETURN
END
SUBROUTINE PRMIX(A,B,Y,NX,NC,T,P,PHI,VMIX)
implicit real*8(a-h,o-z)
DIMENSION A(NC,NC),B(NC,NC),DB(3),Y(NC),PHI(NC),SA(3)
COMMON/DEV/AMIX,BMIX,DADT,DA(3)
R=82.06
NCOMP=NC
AMIX=0.
BMIX=0.
YSUM=0.
DADT=0.
DO 33 I=1,NCOMP
YSUM=YSUM+Y(I)
SA(I)=0.
DB(I)=0.
DO 33 J=1,NCOMP
AMIX=AMIX+Y(I)*Y(J)*A(I,J)
BMIX=BMIX+Y(I)*Y(J)*B(I,J)
DADT=.5*Y(I)*Y(J)*A(I,J)*(DA(I)/A(I,I)+DA(J)/A(J,J))+DADT
33 CONTINUE
AMIX=AMIX/YSUM**2
BMIX=BMIX/YSUM**2
DADT=DADT/YSUM**2
IF(P.GT..001) GO TO 34
AQ=AMIX/(R*T)
SEC=((2.*BMIX-AQ)**2+4.*(BMIX**2-AQ*BMIX))**.5
IF(NX.EQ.1) VMIX=R*T/P
IF(NX.EQ.2) VMIX=(AQ-2.*BMIX-SEC)*.5
GO TO 4
34 CONTINUE
A2=BMIX-R*T/P
A1=AMIX/P-3.*BMIX**2-2.*BMIX*R*T/P
A0=BMIX**3+BMIX**2*R*T/P-AMIX*BMIX/P
CALL VOLUME(A2,A1,A0,NX,VMIX)
4 CONTINUE
IF(VMIX.LE.BMIX) THEN
WRITE(6,*) ' VMIX < BMIX, NX,P,VMIX,BMIX=',NX,P,VMIX,BMIX
AQ=AMIX/(R*T)
SEC=((2.*BMIX-AQ)**2+4.*(BMIX**2-AQ*BMIX))**.5
IF(NX.EQ.1) VMIX=R*T/P
IF(NX.EQ.2) VMIX=(AQ-2.*BMIX-SEC)*.5
WRITE(6,*) VMIX
END IF
DO 70 I=1,NCOMP
TERM2=(VMIX+(1.+2.**.5)*BMIX)/(VMIX+(1.-2.**.5)*BMIX)
DO 80 J=1,NCOMP
SA(I)=SA(I)+Y(J)*A(J,I)/YSUM
DB(I)=DB(I)+2.*Y(J)*B(J,I)/YSUM
80 CONTINUE
DB(I)=DB(I)-BMIX
TERM3=(2.*SA(I)/AMIX-DB(I)/BMIX)*AMIX/(8.**.5*R*T*BMIX)
TERM1=(P*VMIX/(R*T)-1.)*DB(I)/BMIX-DLOG((VMIX-BMIX)/(R*T))
PHI(I)=TERM1-TERM3*DLOG(TERM2)
IF(Y(I).EQ.0.) GO TO 70
PHI(I)=PHI(I)+DLOG(Y(I))
70 CONTINUE
RETURN
END
SUBROUTINE CUBICR(SB,C,D,XR,XI)
implicit real*8(a-h,o-z)
DIMENSION XR(3),XI(3)
PI=3.141592654-8.7D-8
THIRD=1./3.
P=(3.*C-SB*SB)/3.
Q=D-SB*C/3.+SB*SB*SB/13.5
R=P*P*P/27.+Q*Q/4.
IF(R)10,20,30
20 A0=-Q*.5
IF(A0)23,24,25
24 A=0.
GO TO 29
25 A=A0**THIRD
GO TO 29
23 A=-(-A0)**THIRD
29 B=A
GO TO 32
30 A0=-Q*.5+R**.5
B0=-Q*.5-R**.5
IF(A0)33,34,35
34 A=0.
GO TO 39
35 A=A0**THIRD
GO TO 39
33 A=-(-A0)**THIRD
39 IF(B0)43,44,45
44 B=0.
GO TO 32
45 B=B0**THIRD
GO TO 32
43 B=-(-B0)**THIRD
32 XI(1)=0.
XI(2)=3.**.5*(A-B)*.5
XI(3)=-XI(2)
XR(1)=A+B-SB/3.
XR(2)=(A+B)*(-.5)-SB/3.
XR(3)=XR(2)
GO TO 100
10 ANG=DACOS((-Q*Q*27.*.25/P**3)**.5)
IN=1
IF(Q.LT.0.) IN=2
DO 11 I=1,3
XR(I)=-SB/3.+(-1.)**IN*2.*(-P/3.)**.5*DCOS(ANG/3.+2.*PI*(I-1)/3.)
XI(I)=0.
11 CONTINUE
100 RETURN
END
SUBROUTINE VOLUME(SB,SC,SD,NX,VOL)
implicit real*8(a-h,o-z)
DIMENSION XR(3),XI(3),ROOT(3)
CALL CUBICR(SB,SC,SD,XR,XI)
DO 10 J=1,3
ROOT(J)=XR(J)
IF(XI(J).NE.0.) ROOT(J)=(-1)**NX*1.E9
10 CONTINUE
IF(NX.EQ.1) VOL=DMAX1(ROOT(1),ROOT(2),ROOT(3))
IF(NX.EQ.2) VOL=DMIN1(ROOT(1),ROOT(2),ROOT(3))
RETURN
END
SUBROUTINE PRESEK(X,NC,NX1,ERR,IPS,XSUM0,XSUM)
implicit real*8(a-h,o-z)
DIMENSION X(NC)
IF(NX1) 63,63,64
63 XSUM0=0.
DO 3 I=1,NC
3 XSUM0=XSUM0+X(I)
NX1=NX1+1
RETURN
64 XSUM=0.
DO 4 I=1,NC
4 XSUM=XSUM+X(I)
IF(ABS(XSUM-XSUM0).LE.ERR) THEN
IPS=1
RETURN
END IF
XSUM0=XSUM
NX1=NX1+1
IF(NX1.GT.50) THEN
WRITE(6,*)' XSUM UNCONV.',XSUM,X
IPS=-1
RETURN
END IF
RETURN
END
SUBROUTINE SEEK(YSUM,NY,X3,DX3,ERR,IND,QI,X3I,X3F)
implicit real*8(a-h,o-z)
YDIF=YSUM-1.
IF(YDIF.EQ.0) THEN
IND=1
RETURN
END IF
IF(DABS(YDIF).LE.ERR.AND.NY.GT.2) THEN
IND=1
RETURN
END IF
IF(NY-2)71,72,73
71 X3I=X3
QI=YDIF
IF(YDIF.LT.0.) DX3=-1.*DX3
X3 =X3I+DX3
NY=2
RETURN
72 CONTINUE
PROD=QI*YDIF
IF(PROD.GT.0.) THEN
c IF(PROD.GT.1.e-16) THEN
X3I=X3
QI=YDIF
X3 =X3I+DX3
RETURN
END IF
93 X3F=X3
NY=3
73 QF=YDIF
if(qf.eq.qi) then
c write(6,*) 'QI=QF',QI,QF,X3I,X3F
ind=1
RETURN
END IF
X3 =X3F-QF*(X3F-X3I)/(QF-QI)
xerr=dabs(x3-x3i)-dabs(x3f-x3i)
X3F=X3
RETURN
END
Write, Run & Share Fortran code online using OneCompiler's Fortran online compiler for free. It's one of the robust, feature-rich online compilers for Fortran language, running on the latest version 7. Getting started with the OneCompiler's Fortran compiler is simple and pretty fast. The editor shows sample boilerplate code when you choose language as Fortran and start coding.
OneCompiler's Fortran online editor supports stdin and users can give inputs to programs using the STDIN textbox under the I/O tab. Following is a sample Fortran program which takes name as input and prints hello message with your name.
program hello
character :: name*30
read *, name
print *, "Hello ", name
end program hello
Fortran language was initially developed for scientific calculations by IBM in 1957. It has a number of in-built functions to perform mathematical calculations and is ideal for applications which has more mathematical calculations.
| Data type | Description | Usage |
|---|---|---|
| Integer | To store integer variables | integer :: x |
| Real | To store float values | real :: x |
| Complex | To store complex numbers | complex :: x,y |
| Logical | To store boolean values True or false | logical :: x=.True. , logical :: x = .FALSE. |
| Character | To store characters and strings | character :: x |
Variable is a name given to the storage area in order to manipulate them in our programs.
data type :: variable_name
Array is a collection of similar data which is stored in continuous memory addresses.
data-type, dimension (x,y) :: array-name
integer, dimension(3,3) :: cube
Do is used to execute a set of statement(s) iteratively when a given condition is true and the loop variable must be an integer.
do i = start, stop [,step]
! code
end do
Do-While is used to execute a set of statement(s) iteratively when a given condition is true.
do while (condition)
!Code
end do
If is used to execute a set of statements based on a condition.
if (logical-expression) then
!Code
end if
If is used to execute a set of statements based on a condition and execute another set of statements present in else block, if condition specified in If block fails.
if (logical-expression) then
!code when the condition is true
else
!code when the condition fails
end if
Case is similar to switch in C language.
[name:] select case (regular-expression)
case (value1)
! code for value 1
... case (value2)
! code for value 2
...
case default
! default code
...
end select [name]