Fortran runtime error for an input.dat file - fortran
Similar question was asked before but my problem is different: I've been trying an old fortran code to execute with gfortran on my mac. The input file is not working for some reason - I don't know whether it's a shortcoming of the code or the input file. The source code and the input file are on the same directory. Here's the code:
C***************** M.R.T.M *********************************************
C
IMPLICIT REAL*8(A-H,O-Z)
CHARACTER*64 FNAMEI,FNAMEO
COMMON/L1/ C(101),DC(101),DU(101),DL(101),E(101),S1(101),S2(101)
COMMON/L2/ SIR(101),CX(101),S1X(101),S2X(101)
COMMON/L3/ X(101),S3(101),S3X(101)
COMMON/L4/ TH,ROU,COL,WFLX,CI,CS,D,K1,K2,W,K3,K4,U,KS,K5,K6,KD
COMMON/L5/ NEQ,IT,N,NM1,NP1
COMMON/L6/ TPULSE,TTOTAL,TPRINT,DT,DX,GAMMA,BETA
CHARACTER*64 USER,SOIL,SOLUTE,DATE
REAL*8 K1,K2,K3,K4,K5,K6,KS,KD,NEQ
C
C
C------ READ INPUT PARAMETERS----------------
C
WRITE(*,*) 'PLEASE ENTER USER NAME (OPTIONAL):'
READ(*,800) USER
WRITE(*,*) ' PLEASE ENTER NAME OF SOIL (OPTIONAL):'
READ(*,800) SOIL
WRITE(*,*) ' PLEASE ENTER NAME OF SOLUTE (OPTIONAL):'
READ(*,800) SOLUTE
WRITE(*,*) ' ENTER DATE OR OTHER IDENTIFICATION (OPTIONAL):'
READ(*,800) DATE
WRITE(*,*) ' '
WRITE(*,*)
$'--------- INPUT PARAMETERS SECTION -------------'
WRITE(*,*) ' '
WRITE(*,*) ' INPUT PARAMETERS CAN BE PROVIDED IN TWO WAYS; '
WRITE(*,*) ' ENTER 1 if you wish to enter the input data using'
WRITE(*,*) ' the keyboard (i.e. interactively) '
WRITE(*,*) ' '
WRITE(*,*) ' OR '
WRITE(*,*) ' '
WRITE(*,*) ' ENTER 2 if an input data file is to be provided '
WRITE(*,*)
$' PLEASE ENTER EITHER 1 OR 2'
READ(*,950) IFLAG
IF(IFLAG.NE.1) THEN
WRITE(*,'(A)') ' PLEASE ENTER NAME OF INPUT FILE?'
WRITE(*,*) '(for example A:XX.DAT or C:UU.DAT for hard disk)'
READ(*,'(A)') FNAMEI
OPEN(5,FILE=FNAMEI)
C
C
READ(5,700) TH,ROU,COL,WFLX
READ(5,700) CI,CS,D
READ(5,700) KD,NEQ
READ(5,700) K1,K2,W
READ(5,700) K3,K4,U
READ(5,700) KS
READ(5,700) K5,K6
READ(5,750) IT
READ(5,700) TPULSE,TTOTAL,TPRINT,DT,DX
ELSE
C
WRITE(*,*)
$'PLEASE ENTER THE FOLLOWING INPUT PARAMETERS :'
WRITE(*,*) ' '
WRITE(*,*)
$' (1) MOISTURE CONTENT, CM3/CM3 (TH) ='
WRITE(*,*)
$' (Values usually less than 0.65 cm3/cm3). Enter your value NOW'
READ(*,900) TH
WRITE(*,*)
$' (2) BULK DENSITY, G/CM3 (ROU) ='
WRITE(*,*)
$' (Range of values 1.1 - 1.7 g/cm3). Enter your value NOW'
READ(*,900) ROU
WRITE(*,*)
$' (3) PROFILE OR SOIL COLUMN LENGTH, CM (COL) ='
READ(*,900) COL
WRITE(*,*)
$' (4) WATER FLUX, CM/HOUR (WFLX) ='
WRITE(*,*)
$'(Range of values 0.01 - 5 cm/hr). Enter your value NOW'
READ(*,900) WFLX
WRITE(*,*)
$' (5) INITIAL CONCENTRATION, MG/L (CI)='
READ(*,900) CI
WRITE(*,*)
$' (6) APPLIED CONCENTRATION, MG/L (CS)='
READ(*,900) CS
WRITE(*,*)
$' (7) DISPERSION COEFFICIENT,D, CM2/HOUR (D) ='
WRITE(*,*)
$'(Range of values 0.1 - 1.5 cm2/hour). Enter your value NOW'
READ(*,900) D
WRITE(*,*)
$' (8) DISTRIBUTION COEFFICIENT, KD (KD) ='
WRITE(*,*)
$' (Range of values 0 - 300 cm3/g) Enter your value NOW'
READ(*,900) KD
WRITE(*,*)
$' (9) NONLINEAR FREUNDLICH PARAMETER, N (NEQ)='
WRITE(*,*) '(Range of values 0.3 - 0.9). Enter your value NOW'
READ(*,900) NEQ
WRITE(*,*)
$' (10) FORWARD RATE REACTION, K1, HR-1 (K1) ='
WRITE(*,*) '(Range of values 0.01 - 2 hr-1). Enter your value NOW'
READ(*,900) K1
WRITE(*,*)
$' (11) BACKWARD RATE REACTION, K2, HR-1 (K2) ='
WRITE(*,*) '(Range of values 0.01 - 5 hr-1). Enter your value NOW'
READ(*,900) K2
WRITE(*,*)
$' (12) NONLINEAR KINETIC PARAMETER, W, (W)='
WRITE(*,*) '(Range of values 0.3 - 0.9). Enter your value NOW'
READ(*,900) W
WRITE(*,*)
$' (13) FORWARD RATE REACTION, K3, HR-1 (K3)='
WRITE(*,*) '(Ranges from 0.0001 - 0.1 hr-1). Enter your value NOW'
READ(*,900) K3
WRITE(*,*)
$' (14) BACKWARD RATE REACTION, K4, HR-1 (K4)='
WRITE(*,*) '(Ranges from 0.01 - 0.1 hr-1). Enter your value NOW'
READ(*,900) K4
WRITE(*,*)
$' (15) NONLINEAR KINETIC PARAMETER, U, (U) ='
WRITE(*,*) '(Range of values 0.3 - 0.9). Enter your value NOW'
READ (*,900) U
WRITE(*,*)
$' (16) IRREVERSIBLE REACTION PATE,KS,HR-1 (KS) ='
WRITE(*,*) '(Range is 0.0001 - 0.01 hr-1). Enter your value NOW'
READ(*,900) KS
WRITE(*,*)
$' (17) FORWARD RATE REACTION, K5,HR-1 (K5) ='
WRITE(*, *) '(Range is 0.0001 - 0.01 hr-1). Enter your value NOW'
READ(*,900) K5
WRITE(*,*)
$' (18) BACKWARD RATE REACTION, K6, HR-1 (K6) ='
WRITE(*,*) '(Range is 0.001 - 0.1 hr-1). Enter your value NOW'
READ(*,900) K6
WRITE(*,*)
$' (19) NUMBER OF ITERATIONS (IT) AN INTEGER (FROM 0 TO 9)'
READ(*,950) IT
WRITE(*,*)
$' (20) INPUT PULSE DURATION, HOURS (TPULSE) ='
READ(*,900) TPULSE
WRITE(*,*)
$' (21) TOTAL SIMULATION TIME, HOURS (TTOTAL) ='
READ(*,900) TTOTAL
WRITE(*,*)
$' (22) PRINTOUT TIME DESIRED, HOURS (TPRINT) ='
READ(*, 900) TPRINT
WRITE(*,*)
$' (23) INCREMENTAL TIME STEP, HOURS (DT) ='
WRITE(*,*)
$' A default value of DT=0.02 is given'
READ(*,900) DDT
WRITE(*,*)
$' (24) INCREMENTAL DEPTH, CM (DX)='
WRITE(*,*)
$' A default value of DX=1.00 is given '
READ(*,900) DDX
ENDIF
C
XIN=1.00
IF(DDX.NE.0.0) THEN
DX=DDX
ELSE
DX=XIN
ENDIF
C
PIN=0.02
IF(DDT.NE.0.0) THEN
DT=DDT
ELSE
DT=PIN
ENDIF
WRITE(*,'(A)') 'PLEASE ENTER NAME OF THE OUTPUT FILE (FOR EXAMPLE
* B:ZZ.DAT)'
READ(*,'(A)') FNAMEO
OPEN (6,FILE=FNAMEO,STATUS='UNKNOWN')
PV=WFLX/TH
RS=NEQ*ROU*KD/TH
C0=CS
C
TIME=0.0D0
EF=0.0D0
5 CONTINUE
GAMMA=DT/(2.D0*DX*DX)
BETA=DT/DX
IF((BETA*PV).GT.0.50D0) GO TO 7
IF((GAMMA*D/(BETA*PV)).LT.0.5D0) GO TO 6
GO TO 8
6 DX=DX/2
GO TO 5
7 DT=DT/2
GO TO 5
8 CONTINUE
N=INT(COL/DX)
NM1=N-1
NM2=N-2
NP1=N+1
GAMMA=DT/(2*DX*DX)
BETA=DT/DX
C
IF(N.LT.500) GO TO 9
WRITE(*,*) 'W A R N I N G'
WRITE(*,*)
&'Dimension of variables exceeds 500. Did you increase array sizes'
WRITE(*,*)
&' If not, the program will terminate abruptly (see text).'
9 CONTINUE
C
C--- WRITE TITLE HEADING ---------------
WRITE(6,800) USER
WRITE(6,800) SOIL
WRITE(6,800) SOLUTE
WRITE(6,800) DATE
WRITE(6,300) TH,ROU,COL,WFLX,CI,CS,D,K1,K2,B,K3,K4,W,KS
WRITE(6,310) K5,K6,IT,KD,NEQ
&,TPULSE,TTOTAL,TPRINT
WRITE(6,400) DX,DT
C
DO 10 I=1,NP1
S1(I)=0.0D0
S2(I)=0.0D0
S3(I)=0.0D0
SIR(I)=0.0D0
S1X(I)=0.0D0
S2X(I)=0.0D0
S3X(I)=0.0D0
CX(I)=CI
10 C(I)=CI
WRITE(*,*) '------INITIAL CONDITIONS COMPLETED --------'
C
WRITE(*,*) '------Execution Begins Please Wait---------------'
WRITE(*,*) '------Please Wait -------------'
IT=IT+1
FF=2*DX
NKK=INT(TPRINT/DT+0.50D0)
KLM=INT(TTOTAL/DT+0.50D0)
KK=INT(KLM/NKK+0.5D0)
C
L=0
SINT=TPULSE*CS*WFLX
DO 50 JJ=1,KK
DO 20 LL=1,NKK
TT=LL*DT+(JJ-1)*TPRINT
IF(DABS(TT-TPULSE).LT.0.01D0) CS=0.0D0
L=L+1
CALL SMRTM
EF=C(N)+EF
20 CONTINUE
TIME=JJ*TPRINT
C
WRITE(6,500) TIME
VV0=WFLX*TIME/(COL*TH)
CC0=C(N)/C0
WRITE(6,525) VV0,CC0
WRITE(*, 650) TIME,VV0,CC0
WRITE(*,*) '--------Execution Continues--------'
WRITE(*,*) '--------Please Wait---------'
WRITE (6, 550)
DO 30 I=1, NP1
DEPTH=DX*(I-1)
SEQ=KD*C(I)**NEQ
TOTAL=SEQ+S1(I)+S2(I)+S3(I)+SIR(I)
30 WRITE(6,600) DEPTH, C(I),SEQ,S1(I),S2(I),S3(I),SIR(I),TOTAL
CALL INTEG(DX,C,X,NP1)
TSWATR=TH*X(NP1)
C
DO 40 I=1,NP1
40 E(I)=C(I)**NEQ
CALL INTEG(DX, E, X, NP1)
TSEQ=ROU*KD*X(NP1)
SINP=TIME*CS*WFLX
IF(SINP.GT.SINT) SINP=SINT
IF(CS.EQ.0.D0) SINP=SINT
C
CALL INTEG(DX,S1,X,NP1)
TSKIN1=ROU*X(NP1)
C
CALL INTEG(DX,S2,X,NP1)
TSKIN2=ROU*X(NP1)
C
CALL INTEG(DX,S3,X,NP1)
TSKIN3=ROU*X(NP1)
C
TEFFL=DT*WFLX*EF
C
CALL INTEG(DX,SIR,X,NP1)
TSIR=ROU*X(NP1)
BAL=(TEFFL+TSKIN1+TSKIN2+TSKIN3+TSIR+TSEQ+TSWATR)*100.0D0/SINP
50 WRITE(6,200) SINP,TSWATR,TSEQ,TSKIN1,TSKIN2,TSKIN3,TSIR,TEFFL,BAL
CONTINUE
C
200 FORMAT(//,2X,'S A L T B A L A N C E:',//
&7X, 'TOTAL INPUT SOLUTE FROM PULSE (MG) = ',F10.4,/
&7X, 'TOTAL SOLUTE SOIL SOLUTION PHASE (MG) = ',F10.4,/,
&7X, 'TOTAL SORBED IN (EQUILIB) PHASE SE (MG) = ',F10.4,/,
&7X, 'TOTAL SORBED IN (KINETIC) PHASE S1 (MG) = ',F10.4,/,
&7X, 'TOTAL SORBED IN (KINETIC) PHASE S2 (MG) = ',F10.4,/,
&7X, 'TOTAL SORBED IN (KINETIC) PHASE S3 (MG) = ',F10.4,/,
&7X, 'TOTAL SORBED IN IRREVERSIBLE PHASE (MG) = ',F10.4,/,
&7X, 'TOTAL SORBED IN THE EFFLUENT (MG) = ',F10.4,/,
&7X, 'MASS BALANCE (CALC.OUTPUT/INPUT) (%) = ',F10.4,/)
300 FORMAT(//,
$2X, 'INPUT PARAMETERS :',//
$5X,'1. MOISTURE CONTENT, CM3/CM3 (TH) = ',F10.5,/
$5X,'2. BULK DENSITY, G/CM3 (ROU) = ',F10.5,/
$5X,'3. COLUMN LENGTH, CM (COL) = ',F10.5,/
$5X,'4. WATER FLUX, CM/HOUR (WFLX) = ',F10.5,/
$5X,'5. INITIAL CONCENTRATION, MG/L (CI) = ',F10.5,/
$5X,'6. CONCEN.IN INPUT PULSE, MG/L (CS) = ',F10.5,/
$5X,'7. DISPERSION COEFFICIENT, CM2/HR (D) = ',F10.5,/
$5X,'8. FOWARD RATE REACTION, K1,HR-1 (K1) = ',F10.5,/
$5X,'9. BACKWARD RATE REACTION, K2,HR-1 (K2) = ',F10.5,/
$4X,'10. NONLINEAR KINETIC PARAMETER, W, (W) = ',F10.5,/
$4X,'11. FORWARD RATE REACTION, K3/HR-1 (K3) = ',F10.5,/
$4X,'12. BACKWARD RATE REACTION, K4/HR-1 (K4) = ',F10.5,/
$4X,'13. NONLINEAR KINETIC PARAMETER, U, (U) = ',F10.5,/
$4X,'14. IRREVERSIBLE REACTION RATE, KS/HR-1 (KS) = ',F10.5,/)
310 FORMAT(
$4X,'15. FORWARD RATE REACTION, K5,HR-1 (K5) = ',F10.5,/
$4X,'16. BACKWARD RATE REACTION, K6,HR-1 (K6) = ',F10.5,/
$4X,'17. NUMBER OF ITERATIONS (IT) = ',I10.5,/
$4X,'18. DISTRIBUTION COEFFICIENT FOR EQUILIBRIUM',/
$4X,' SORPTION, KD, CM3/G (KD) = ',F10.5,/
$4X,'19. NONLINEAR PARAMETER FOR EQUILIBRIRUM',/
$4X,' Mechanism, NEQ (NEQ) = ',F10.5,/
$4X,'20. INPUT PULSE DURATION, HR (TPULSE) = ',F10.5,/
$4X,'21. TOTAL SIMULATION TIME, HR (TTOTAL) = ',F10.5,/
$4X,'22. PRINTOUT TIME DESIRED,HR (TPRINT) = ',F10.5,////)
400 FORMAT(2X, 'THE INCREMENTS USED WERE : ',//
$5X,'1. SIMULATION DEPTH INTERVAL, CM (DX)=',F10.5,/
$5X,'2. INCREMENTAL TIME STEP,HR (DT)=',F10.5,///)
500 FORMAT(/////////,
$2X'S I M U L A T I O N T I M E (HOUR) = ',F8.2/)
525 FORMAT(
$2X'PORE VOLUMES (V/V0) = ',F10.2,8X,'REL. CONCENTRATION (C/C0) =',
&F8.4)
550 FORMAT(///1H, 72(1H*)//1H, 20X, 'CONCENTRATION DISTRIBUTION',
*//1H , 172(1H*)//1H, 2X,
*'DEPTH SOLUT EQUIL KINETIC KINETIC KINETIC IRREV.
*TOTAL'/, 9X, 'CONC.', 4X,
*'PHASE PHASE 1 PHASE 2 PHASE 3 SINK SORBED'/,
*' X C SE S1 S2 S3 SIR
* S'//,1X
1,' CM ',2X,'--MG/L--',2X,
1'--------------------- MG/KG ---------------------'/)
600 FORMAT(1X,F6.2,1X,F9.4,1X,F8.4,1X,F8.3,
*1X,3(F9.3,1X),F7.3)
650 FORMAT(/////,2X,'SIMULATIONS ARE NOW COMPLETE UP TO',///,5X,
$'S I M U L A T I O N T I M E (HOUR) = ',F8.2,//2X,
$'PORE VOLUMES (V/V0) = ',F10.2,8X,'REL CONCENTRATION (C/C0)=',
&F8.4//)
700 FORMAT(50X, E10.6)
750 FORMAT(50X,I3)
800 FORMAT(A64)
900 FORMAT(F12.0)
950 FORMAT(I1)
WRITE(*,*)
WRITE(*,*) '------ Requested Simulations Completed ------'
WRITE(*,*)
WRITE(*,*) '------- MRTM TERMINATED SUCCESSFULLY -------'
WRITE(*,*)
WRITE(*,*) '------- THANK YOU FOR USING MRTM --------'
END
C
C
C **************************************************************
C SUBROUNTINE SMRTM GIVES A SOLUTION OF THE FINITE DIFFERENCE EQ.
C OF THE CONVECTIVE-DISPERSION AND MULTIREACTION SYSTEM
C ***************************************************************
C
SUBROUTINE SMRTM
IMPLICIT REAL*8 (A-H,O-Z)
COMMON/LI/ C(101),DC(101),DU(101),DL(101),E(101),S1(101),S2(101)
COMMON/L2/ SIR(101),CX(101),S1X(101),S2X(101)
COMMON/L3/ X(101) ,S3(101) ,S3X(101)
COMMON/L4/ TH,ROU,COL,WFLX,CI,CS,D,K1,K2,W,K3,K4,U,KS,K5,K6,KD
COMMON/L5/ NEQ,IT,N,NM1,NP1
COMMON/L6/ TPULSE,TTOTAL,TPRINT,DT,DX,GAMMA,BETA
REAL*8 K1,K2,K3,K4,K5,K6,KS,KD,NEQ
C
C
FF=2*DX
PV=WFLX/TH
RS=NEQ*ROU*KD/TH
C(1)=(WFLX*FF*CS+D*TH*C(3))/(WFLX*FF+D*TH)
DO 35 IJ=1,IT
M=2
DO 10 I=1,NM1
DC(I) =1.0D0+2.D0*GAMMA*D-BETA*PV
DU(I)=BETA*PV-GAMMA*D
E(I)=C(M)+GAMMA*D*(C(M+1) -2.0D0*C(M) + C(M-1))
DL(I)=-GAMMA*D
M=I+2
10 CONTINUE
M=N
DC(NM1)=1.D0+GAMMA*D
E(1)=E(1)+GAMMA*D*C(1)
C
C INCORPORATION OF NONLINEAR KINETIC AND EQUILIBRIUM PROCESSES
C (REVERSIBLE) IN MAIN DIAGONAL ELEMENTS AND RHS VECTOR
C
DO 20 I=1,NM1
DC(I)=DC(I)+DT*KS/2
R=0.0D0
H1=0.0D0
H2=0.0D0
IF((C(I+1).LT.1.0D-4) .OR. (CX(I+1).LE.1.0D-4)) GO TO 15
R =RS*(0.50D0*(C(I+1)+CX(I+1)))**(NEQ-1.0D0)
H1=(0.50D0*(C(I+1)+CX(I+1)))**W
H2=(0.50D0*(C(I+1)+CX(I+1)))**U
15 DC(I)=DC(I)+R
E(I)=E(I)-DT*(K1*H1-K2*(ROU/TH)*(S1(I+1)+S1X(I+1))/2)
&-DT*(K3*H2-K4*(ROU/TH)*(S2(I+1)+S2X(I+1))/2)
20 E(I)=E(I)+C(I+1)*R-DT*(KS/2)*((C(I+1)+CX(I+1))/2)
C
CALL TRIDM(DC,DU,DL,E,NM1)
DO 25 I=2,N
25 CX(I)=E(I-1)
CX(NP1)=CX(N)
CX(1)=C(1)
DO 30 I=1,NP1
H1=0.0D0
H2=0.0D0
IF(C(I).GT.1.0D-4) H1=((C(I)+CX(I))/2)**W
IF(C(I).GT.1.0D-4) H2=((C(I)+CX(I))/2)**U
S1X(I) =S1(I)+ DT*(K1*(TH/ROU)*H1-K2*(S1(I)+S1X(I))/2)
S2X(I) =S2(I) + DT*K3*(TH/ROU)*H2-(K4+K5)*DT*(S2(I)+S2X(I))/2
$+DT*K6*S3(I)
30 CONTINUE
35 CONTINUE
C
C
DO 50 I=1, NP1
C(I)=CX(I)
S1(I)=S1X(I)
S2(I)=S2X(I)
S3(I)=S3(I)+DT*K5*S2(I)
$-DT*K6*S3(I)
50 SIR(I)=SIR(I) + DT*KS*(TH/ROU)*C(I)
RETURN
END
C
C *****************************************************************
C SUBROUNTINE TRIDM GIVES A SOLUTION OF A TRIDIAGONAL MATRIX-VECTOR
C EQUATION USING THOMAS ALGORITHM
C ***************************************************************
C
SUBROUTINE TRIDM(A,B,C,D,N)
IMPLICIT REAL*8(A-H,O-Z)
DIMENSION A(N),B(N),C(N),D(N)
DO 1 I=2,N
C(I)=C(I)/A(I-1)
A(I)=A(I)-(C(I)*B(I-1))
1 CONTINUE
DO 2 I=2, N
D(I)=D(I)-(C(I)*D(I-1))
2 CONTINUE
D(N)=D(N)/A(N)
DO 3 I=2, N
D(N+1-I)=(D(N+1-I)-(B(N+1-I)*D(N+2-I)))/A(N+1-I)
3 CONTINUE
RETURN
END
C
C *****************************************************************
C SUBROUNTINE INTEG PERFORMS INTEGRATION OF A TABULAR FUNCTION Y
C GIVEN AT EQUAL DISTANCES H USING TRAPEZOIDAL RULE
C ***************************************************************
C
SUBROUTINE INTEG(H,Y,Z,N)
IMPLICIT REAL*8(A-H,O-Z)
DIMENSION Y(N),Z(N)
S2=0.0D0
IF(N-1) 40,30,10
10 HH=H/2.0D0
DO 20 I=2,N
S1=S2
S2=S2+HH*(Y(I)+Y(I-1))
20 Z(I-1)=S1
30 Z(N)=S2
40 RETURN
END
here is the input file:
1. MOISTURE CONTENT,CM3/CM3 (TH) = 0.400E00
2. BULK DENSITY,G/CM3 (ROU) = 1.250E00
3. COLUMN LENGTH,CM (COL) = 10.000E00
4. WATER FLUX,CM/HR (WFLX) = 1.000E00
5. INITIAL CONCENTRATION,MG/L (CI) = 0.000E00
6. CONCEN.IN INPUT PULSE, MG/L (CS) = 10.000E00
7. DISPERSION COEFFICIENT,D,CM2/HR (D) = 1.000E00
8. DISTRIB. COEFF.FOR EQL. SORP,CM3/G (KD) = 1.000E00
9. NONLINEAR PARAM.FOR EQUL. MECH. (NEQ) = 1.000E00
10. FORWARD RATE REACTION, K1,HR-1 (K1) = 0.100E00
11. BACKWARD RATE REACTION, K2,HR-1 (K2) = 0.100E00
12. NONLINEAR KINETIC PARAMETER, W, (W) = 0.500E00
13. FORWARD RATE REACTION, K3,HR-1 (K3) = 0.000E00
14. BACKWARD RATE REACTION, K4,HR-1 (K4) = 0.000E00
15. NONLINEAR KINETIC PARAMETER, U, (U) = 0.000E00
16. IRREVERSIBLE REACTION RATE,KS,HR-1 (KS) = 0.000E00
17. FORWARD RATE REACTION, K5,HR-1 (K5) = 0.000E00
18. BACKWARD RATE REACTION, K6,HR-1 (K6) = 0.000E00
19. NUMBER OF ITERATIONS (M) (IT) = 000
20. INPUT PULSE DURATION,HR (TPULSE) = 12.000E00
21. TOTAL SIMULATION TIME,HR (TTOTAL) = 16.000E00
22. PRINTOUT TIME DESIRED,HR (TPRINT) = 4.000E00
23. INCREMENTAL TIME STEP,HR (DT) = 0.200E00
24. INCREMENTAL DEPTH, CM (DX) = 1.000E00
And the error I'm receiving:
Ms-MacBook-Pro-2:~ Tonoy$ gfortran mrtm.f
Ms-MacBook-Pro-2:~ Tonoy$ ./a.out
PLEASE ENTER USER NAME (OPTIONAL):
rm
PLEASE ENTER NAME OF SOIL (OPTIONAL):
bd
PLEASE ENTER NAME OF SOLUTE (OPTIONAL):
cr
ENTER DATE OR OTHER IDENTIFICATION (OPTIONAL):
2015
--------- INPUT PARAMETERS SECTION -------------
INPUT PARAMETERS CAN BE PROVIDED IN TWO WAYS;
ENTER 1 if you wish to enter the input data using
the keyboard (i.e. interactively)
OR
ENTER 2 if an input data file is to be provided
PLEASE ENTER EITHER 1 OR 2
2
PLEASE ENTER NAME OF INPUT FILE?
(for example A:XX.DAT or C:UU.DAT for hard disk)
input.DAT
PLEASE ENTER NAME OF THE OUTPUT FILE (FOR EXAMPLE B:ZZ.DAT)
At line 173 of file mrtm.f (unit = 5, file = 'input.DAT')
Fortran runtime error: End of file
Error termination. Backtrace:
#0 0x10c688729
#1 0x10c6893f5
#2 0x10c689b59
#3 0x10c751f8b
#4 0x10c752527
#5 0x10c74f5c3
#6 0x10c7545b4
#7 0x10c679590
#8 0x10c67b2a0
Ms-MacBook-Pro-2:~ Tonoy$
The expected outcome given the input should give (first 8 hr out of 16 hr):
In FORTRAN convention on Unix machines Unit 5 is connected to Standard Input when the program stats.
The statement on line 45
OPEN(5,FILE=FNAMEI)
happens to disconnect standard input and attaches an input file to standard input so that subsequent READ(*,FORMAT) statements try to read from this file and encounter its end. This causes the Input/output error you report.
If you follow the suggestion given by francescalus in the comments, and replace Unit 5 on lines 45 and 48-56 with Unit 15, this error will be gone.
If you compile with the options suggested by Vladimir, i.e.
gfortran -Wall -g -fbacktrace -fcheck=all mrtm.for -o mrtm
the program runs to completion and produces some output.
:~> ./mrtm
PLEASE ENTER USER NAME (OPTIONAL):
rm
PLEASE ENTER NAME OF SOIL (OPTIONAL):
bd
PLEASE ENTER NAME OF SOLUTE (OPTIONAL):
cr
ENTER DATE OR OTHER IDENTIFICATION (OPTIONAL):
2015
--------- INPUT PARAMETERS SECTION -------------
INPUT PARAMETERS CAN BE PROVIDED IN TWO WAYS;
ENTER 1 if you wish to enter the input data using
the keyboard (i.e. interactively)
OR
ENTER 2 if an input data file is to be provided
PLEASE ENTER EITHER 1 OR 2
2
PLEASE ENTER NAME OF INPUT FILE?
(for example A:XX.DAT or C:UU.DAT for hard disk)
input.dat
PLEASE ENTER NAME OF THE OUTPUT FILE (FOR EXAMPLE B:ZZ.DAT)
zz.dat
Without -fcheck=all the program fails with Segmentation fault - invalid memory reference on line 253.
Related
write(*,'(A,g0.1,A,F10.2,A,F10.2)') "Original Price Tag Before Tax", & 1 Error: Fortran 2008: ‘G0’ in format at (1) in fortran
i am a beginner and trying to learn fortran however i face the following issue , i'm an absolute beginner at this , i really find it challenging i changed the g0, Iw and I but none work as specified as i saw in previous posts ,thhe same error keeps spawining again and again, b, the f10.2 also doesnt work **1. below is my code ** `program discount_chart implicit none ! Declare variables real :: original_price, discounted_price_cad, discounted_price_usd real :: max_price, min_price, discount_percent, cad_to_usd_rate integer :: i ! Prompt user for input write(*,*) "Enter the minimum price tag (in CAD, ending in .49 or .99):" read(*,*) min_price write(*,*) "Enter the maximum price tag (in CAD, ending in .49 or .99):" read(*,*) max_price write(*,*) "Enter the discount percentage (e.g. 20 for 20% off):" read(*,*) discount_percent write(*,*) "Enter the CAD to USD exchange rate:" read(*,*) cad_to_usd_rate ! Check validity of input do while (mod(min_price, 1.0) /= 0.49 .and. mod(min_price, 1.0) /= 0.99) write(*,*) "Minimum price tag must end in .49 or .99. Please enter again:" read(*,*) min_price end do do while (mod(max_price, 1.0) /= 0.49 .and. mod(max_price, 1.0) /= 0.99) write(*,*) "Maximum price tag must end in .49 or .99. Please enter again:" read(*,*) max_price end do do while (discount_percent <= 0 .or. discount_percent >= 100) write(*,*) "Discount percentage must be between 0 and 100. Please enter again:" read(*,*) discount_percent end do do while (cad_to_usd_rate <= 0) write(*,*) "CAD to USD exchange rate must be positive. Please enter again:" read(*,*) cad_to_usd_rate end do ! Print chart header write(*,'(A,Iw.6,A,F10.2,A,F10.2)') "Original Price Tag Before Tax", & " Discounted Price After Tax (CAD)", " Discounted Price After Tax (USD)" ! Compute and print discounted prices for each original price in range do i = 0, 100 original_price = min_price + i * 0.01 if (original_price > max_price) exit discounted_price_cad = original_price * (100 - discount_percent) / 100 * 1.13 discounted_price_usd = discounted_price_cad / cad_to_usd_rate write(*,'(F12.8, F12.8, F12.8)') original_price, discounted_price_cad, discounted_price_usd end do end program discount_chart` the error is below main.f95:41:15: write(*,'(A,Iw.6,A,F10.2,A,F10.2)') "Original Price Tag Before Tax", & 1 Error: Nonnegative width required in format string at (1)
Fortran error with the FORMAT statement
I'm trying to compile some Fortran code but I keep getting errors with the FORMAT statement. It says I'm missing brackets and characters but it looks fine to me. I am compiling it with silverfrost. The code is shown below: ! PROGRAM TO SOLVE DEEP-BED DRYING MODEL ! ! BASIC STATEMENTS ! CHARACTER*20 FiIe1, File2 COMMON AMo COMMON /DENS/ Pmo, Pme COMMON /THICK/ dxo, Dxe DIMENSION AM1(50), AM2(50), T(50), Gs(51), Vs(51), Ts(51), Dx(50), X(50) ! !To define a number of statement functions AMe(Ts)=0.62*EXP(-1.116*(Ts-100)**0.3339) A(Ts, Vs)=(1.2925-0.00058*Ts) * (0.9991-0.0963*Vs) AK(Ts, Vs)=(0.00273*Ts-0.2609)*(2.0984*Vs+0.2174) AN(Ts)=0.00222*Ts+0.9599 Ps(Ts)=0.7401-0.001505*Ts ! !INPUT SECTION OF THE PROGR.A,M ! PRINT*, 'Input the mass of the sample (g) :' READ*, Wo PRINT*, 'Input the initial moisture content (db):' READ*, AMo PRINT*, 'lnput the depth of the sample bed (mm):' READ*, Xo PRINT*, 'Input the number of layers in the bed:' READ*, Nx PRINT*, 'Input the steam temperature at inlet (oC):' READ*, Tso PRINT*, 'input the steam flow rate at inlet (kg/(m2.s)):' READ*, Gso PRINT*, 'lnput the expected drying time (min):' READ*, Timeo PRINT*, 'lnput the time interval- (min) :' READ*, Dt ! ! TO DEFINE AND OPEN DATA FILES ! PRINT*, 'Name for the file recording the simulation +process:' READ*, File1 OPEN (1, FILE=File1) PRINT*, 'Name for the file recording major data:' READ*, File2 OPEN (2, FILE=File2) ! ! TO WRITE INPUTTED PARAMETERS IN THE DATA FILES ! WRITE (1, *) 'Mass of sample:', Wo, ' g' WRITE (1, *) 'Initial moisture content:', AMo, ' kg/kg' WRITE (1, *) 'Depth of sample bed:', Xo, 'mm' WRITE (1, *) 'Number of layers in sample bed:', Nx WRITE (1, *) 'Steam temperature at inlet', Tso, 'deg C' WRITE (1, *) 'Steam flow rate at inlet', Gso, 'kg/m2s' WRITE (1, *) 'Expected drying time', Timeo, ' min' WRITE (1, *) 'Time interval:', Dt, ' min' ! WRITE (2, *) 'Mass of sample', Wo, 'g' WRITE (2, *) 'Initial moisture content', AMo, 'kg/kg' WRITE (2, *) 'Depth of sample bed', Xo, 'mm' WRITE (2, *) 'Number of layers in sample bed', Nx WRITE (2, *) 'Steam temperature at inlet', Tso, ' deg C' WRITE (2, *) 'Steam flow rate at inlet', Gso, ' kg/m2*s' WRITE (2, *) 'Expected drying time', Timeo, ' min' WRITE (2, *) 'Time interval:', Dt, ' min' ! !BASIC CALCULATION BASED ON THE INPUT DATA ! Dxo=Xo/1000/Nx Dxe=0.867*Dxo D1=0.066 Pmo=4*(Wo/l000)/(3.14159*D1**2*(Xo/1000)*(1+AMo)) Pme=Pmo/0.867 AMeo=AMe(Tso) NT=NINT(Timeo/Dt) Pso=Ps(Tso) Vso=Gso/Pso ! !TO SET VALUES FOR SOME PHYSTCAL AND THERMODYNAMTC PROPERTIES ! Cs=2000 Cw1=4193 Cw=4313 C=1245 ! !TO CALCULATE THE INTTIAL MOISTURE CONTENT CONSIDERING STEAM CONDENSATION ! AMo1=AMo+(C+Cw1*AMo)/(2257000+Cs*(Tso-100))*(100-10) ! !TO SET JUDGE CRITERION FOR TERMINATING THE DRYING OF A LAYER !(A small difference between moisture content and equilibrium moisture content) DM=0.0001 ! !MAJOR DERIVATION FOR DRYING SIMULATION ! J=0 Time=0 m=1 ! WRITE(2, 100) 100 FORMAT(4H J, 9H T(min), 8H M(db),7H Gs , 10H Ts(C) ,9H Front1, 5H L1, 9H Front2, 5h L2, 9H Depth) ! 200 m5=m-1 IF (J .GT. Nt) GO to 800 ! PRINT*, ' ' PRINT*, ' ' PRINT*, 'Time inverval:', J, ' Drying time:', Time, ' min' WRITE(1, x) ' ' WRITE(1, *) 'Time interval:', J, ' Drying time:', Time, ' min' WRITE(*, 300) WRITE(1, 300) 300 FORMAT(1x, 3H, I, 7H, X(i), 8H M(i), 10H T(i), 10H Gs(i), 8H Ts(i)) ! AveM=0 ! ! For dried region ! IF(m .GT. 1) THEN DO 500 i=1, m-1 Dx(i)=Dxe X(i)=(i-0.5)*Dxe AM1(i)=AM2(i) T(i)=Tso Gs(i)=Gso Vs(i)=Vso Ts(i)=Tso AveM=AveM+AM1(i) WRITE(*, 400) i, X(i), AM1(i), T(i), Gs(i), Ts(i) WRITE(1, 400) i, X(i), AM1(i), T(i), Gs(i), Ts(i) 400 FORMAT(1X, I3, 2X, F6.4, 2X, F6.4, 2X, F8.3, 2X, F7.3, 2X, F7.3) 500 CONTINUE ENDIF ! Calculation of the drying front position IF (m .EQ. l) THEN X1=-1 No1=-1 ELSE Xl=X(m-1)+Dx(m-1)/2 No1=m-1 ENDIF ! IF (m .GT. Nx) GO TO 900 ! Ts(m)=Tso Vs(m)=Vso L=0 DO 600 i=m, Nx IF(L .NE.0) GO TO 510 ! ! For drying region ! If (J .EQ. O) THEN Am1(i)=AMo1 Else AM1(i)=AM2(i) ENDIF Dx(i)=Dxx(AM1(i)) IF (i .EQ. 1) THEN X(i)=Dx(i)/2 ELSE X(i)=X(i-1)+Dx(i-1)/2+Dx(i)/2 ENDIF ! ! To define transition variables ! AMe5=AMe(Ts(i)) A5=A(Ts(i),Vs(i)) AK5=AK(Ts(i),Vs(i)) AN5=AN(Ts(i)) Ps5=Ps(Ts(i)) P5=P(AMl(i)) Dt5=Dt* 60 ! ! Derivation ! AMmax=A5*(AMo-AMe5)/EXP((AN5-1)/AN5)+AMe5 IF (AM1(i) .GE. AMmax) THEN AM2(i)=AM1(i)-Dt5*AK5*AN5*(AMmax-AMe5)*(ALOG(A5*(AMo-AMe5)/(AMmax-AMe5))/AK5)**((AN5-1)/AN5)/60 ELSE AM2(i)=AM1(i)-Dt5*AK5*AN5*(AM1(i)-AMe5)*(ALOG(A5*(AMo-AMe5)/(AM1(i)-AMe5))/AK5)**((AN5-1)/AN5)/60 ENDIF DR=(AM2(i)-AM1(i))/Dt5 ! IF (AM1(i) .GE. AMo) THEN T(i)=100 DerT=0 ELSE T(i)=Tso-(Tso-100)*(AM1(i)-AMeo)/(AMo-AMeo) DerT=-(Tso-l00)/(AMo-AMeo)*DR ENDIF ! Gs(i)=Vs(i)*Ps5 Gs(i+l)=Gs(i)-Dx(i)*P5*DR Vs(i+1)=Gs(i+1)/Ps5 Hv5=Hv(AMl(i), T(i)) Ts(i+1)=Ts(i)+Dx(i)*P5*(Hv5+Cs*(Ts(i)-T(i)))/(Gs(i)*Cs)*DR-Dx(i)*P5*(C+Cw*AMl(i))/(Gs(i)*Cs)*DerT ! ! To find the first layer in wet region ! IF (Ts(i+l) .LE. l00) THEN Ts(i+1)=100 L=i ENDIF ! ! To check if the layer has been dried to equilibrium ! IF ((AM2(i)-AMeo) .LE. DM) THEN m5=i AM2(i)=AMeo ENDIF GO TO 520 ! ! For wet region ! 510 AM1(i)=AMo1 AM2(i)=AMo1 T(i)=100 Gs(i+l)=Gs(i) Vs(i+1)=Vs(i) Ts(i+1)=100 ! Dx(i)=Dxx(AM1(i)) IF (i .EQ. 1) THEN X(i)=Dx(i)/2 ELSE X(i)=X(i-1)+Dx(i-1)/2+Dx(i)/2 ENDIF ! 520 AveM=AveM+AM1(i) WRITE(*, 400) i, X(i), AM1(i), T(i), Gs(i), Ts(i) WRITE(1, 400) i, X(i), AM1(i), T(i), Gs(i), Ts(i) 600 CONTINUE ! ! Calculation of wet front position IF (L .EQ. O) THEN X2=-1 No2=-1 ELSE X2=X(L)+Dx(L)/2 No2=L+1 ENDIF ! AveM=AveM/Nx Depth=X(Nx)+Dx(Nx)/2 ! WRITE(*, 100) WRITE(*, 700) J, Time, AveM, Gs(Nx*1), Ts(Nx*1), XI, No1, X2, No2, Depth WRITE (2, 700) J, Time, AveM, Gs(Nx+1), Ts(Nx*1), X1, No1, X2, No2, Depth 700 FORMAT(I4, 2X, F7.3, 2X, F6.4, 2X, F6.4, 2X, F7.3, 2X, F7.4, 2x, I3, 2X, F7.4, 2X, I3, 2x, F7.4) ! J=J+1 Time=Time+Dt m=m5+1 GO TO 200 ! 800 PRINT*, ' ' PRINT*, 'The drying time was up to the specified time.' PRINT*, 'The drying simulation was stopped.' PRINT*, 'The sample was not dried to equilibrium' WRITE(1,*) ' ' WRITE(1,*) 'The drying time was up to the specified time.' WRITE(1,*) 'The drying simulation was stopped' WRITE(1,*) 'The sample was not dried to equilibrium' WRITE(1,*) ' ' WRITE(2,*) 'The drying time was up to the specified time' WRITE(2,*) 'The drying simulation was stopped' WRITE(2,*) 'The drying simulation was stopped' WRITE(2,*) 'The sample was not dried to equilirbium' GO TO 910 ! 900 No2=-1 X2=-1 AveM=AveM/Nx WRITE(*, 100) WRITE(*, 700) J, Time, AveM, Gs(Nx+1), Ts(Nx+1), X1, No1, X2, No2, Depth WRITE(2, 700) J, Time, AveM, Gs(Nx+1), Ts(Nx+1), X1, No1, X2, No2, Depth ! PRINT*, ' ' PRINT*, 'The sample was dried to equilibrium' PRINT*, 'The drying simulation was stopped.' WRITE(1,*) ' ' WRITE(1,*) 'The sample was dried to equilibrium' WRITE(1,*) 'The drying simulation was stopped' WRITE(2,*) ' ' WRITE(2,*) 'The sample was not dried to equilirbium' WRITE(2,*) 'The drying simulation was stopped' ! 910 CLOSE(1) CLOSE(2) END ! !********************************************************************************** ! ! EXTERNAL FUNCTION FOR LATENT HEAT OF EVAPORATION ! FUNCTION Hv(AM, T) Hfg=2257000-2916.7*(T-100) IF (AM .GE. 0.2) THEN Hv=Hfg ELSE Hv=Hfg*(1+EXP(-19.9*AM)) ENDIF RETURN END ! ! EXTERNAL FUNCTION FOR BULK DENSITY ! FUNCTION P(AM) COMMON AMo/DENS/ Pmo, Pme IF (AM .GE. AMo) THEN P=Pmo ELSE IF (AM .LT. 0.11) THEN P=Pme ELSE P=Pmo-(Pmo-Pme)*(AMo-AM)/(AMo-0.11) ENDIF RETURN END ! ! EXTERNAL FUNCTION FOR LAYER THICKNESS ! FUNCTION Dxx(AM) COMMON AMo/THICK/ Dxo, Dxe IF (AM .GE. AMO) THEN Dxx=Dxo ELSE IF (AM .LT. 0.11) THEN Dxx=Dxe ELSE Dxx=Dxo-(Dxo-Dxe)*(AMo-AM)/(AMo-0.11) ENDIF RETURN END ! !**************************************************************************************** And the errors are shown below: Compiling and linking file: SHSDRYING.F95 C:\Users\steva\Desktop\SHSDRYING.F95(104) : error 58 - Unpaired right bracket(s) C:\Users\steva\Desktop\SHSDRYING.F95(45) : error 259 - Scalar, default-kind, CHARACTER expression expected for the FILE keyword C:\Users\steva\Desktop\SHSDRYING.F95(45) : warning 868 - Opening unit 1 may affect the operation of input from the default unit '*' - are you sure you want to do this? C:\Users\steva\Desktop\SHSDRYING.F95(48) : warning 868 - Opening unit 2 may affect the operation of output to the default unit '*' - are you sure you want to do this? C:\Users\steva\Desktop\SHSDRYING.F95(116) : warning 792 - Comma missing in format C:\Users\steva\Desktop\SHSDRYING.F95(116) : warning 792 - Comma missing in format C:\Users\steva\Desktop\SHSDRYING.F95(116) : error 270 - Missing width count for 'G' descriptor C:\Users\steva\Desktop\SHSDRYING.F95(116) : warning 792 - Comma missing in format C:\Users\steva\Desktop\SHSDRYING.F95(116) : error 274 - Unknown edit descriptor '(', or missing comma C:\Users\steva\Desktop\SHSDRYING.F95(292) : warning 868 - Closing unit 1 may affect the operation of input from the default unit '*' - are you sure you want to do this? C:\Users\steva\Desktop\SHSDRYING.F95(293) : warning 868 - Closing unit 2 may affect the operation of output to the default unit '*' - are you sure you want to do this? C:\Users\steva\Desktop\SHSDRYING.F95(103) : error 90 - FORMAT label 100 does not exist Compilation failed.
Unit 5,6 and 1,2 (and others) are reserved... If you make UNIT=1 become UNIT=21 and UNIT=2 become UNIT=22 it will work. Better is probably to use NEWUNIT ! PROGRAM TO SOLVE DEEP-BED DRYING MODEL ! ! BASIC STATEMENTS ! PROGRAM DEEP_BED_DRYING !New IMPLICIT NONE !New CHARACTER*20 FiIe1, File2 COMMON AMo COMMON /DENS/ Pmo, Pme COMMON /THICK/ dxo, Dxe ... OPEN (NEWUNIT=MyUnit1, FILE=File1) !New WRITE(*,*)' Unit1=',MyUnit1 !New ... OPEN (NEWUNIT=MyUnit2, FILE=File2) !New WRITE(*,*)' Unit2=',MyUnit2 !New enter code here !WRITE(1,*) ... WRITE(MyUnit1,*) ... IMPLICIT NONE is not a bad habit to get into using. I would line up things for ease of reading... WRITE (1, *) 'Mass of sample:' , Wo , ' g' WRITE (1, *) 'Initial moisture content:' , AMo , ' kg/kg' WRITE (1, *) 'Depth of sample bed:' , Xo , 'mm' WRITE (1, *) 'Number of layers in sample bed:' , Nx WRITE (1, *) 'Steam temperature at inlet' , Tso , 'deg C' WRITE (1, *) 'Steam flow rate at inlet' , Gso , 'kg/m2s' WRITE (1, *) 'Expected drying time' , Timeo , ' min' WRITE (1, *) 'Time interval:' , Dt , ' min' You either need to compile with -132 or use line continuation... .F77 or -fixed compiler switch (Anything n Column #6): WRITE(2, 100) 100 FORMAT(4H J, 9H T(min), 8H M(db),7H Gs , 10H Ts(C) , !234567 & 9H Front1, 5H L1, 9H Front2, 5h L2, 9H Depth) .F90 or -free compiler switch (& at the end): WRITE(2, 100) !Here 100 FORMAT(4H J, 9H T(min), 8H M(db),7H Gs , 10H Ts(C) , & !234567 9H Front1, 5H L1, 9H Front2, 5h L2, 9H Depth)
The FORMAT statements in the program use Hollerith edit descriptors, which was a feature deleted from the language as of Fortran 95. These are notoriously error prone - character string edit descriptors should be used instead. Hollerith edit descriptors are of the form nHxxx - where n characters following the H are equivalent to a character literal. The problem with the identified statement (at least) is that the parenthesis that is meant to close the format statement is being considered part of the literal - probably because a space or similar has been deleted from the source. 100 FORMAT(...9H Depth) 123456789 The error messages also identify that the variable named File1 is not suitable as a FILE= specifier in an open statement. This is because there is no variable declaration for File1, so it is assumed to be of type REAL. There is a declaration for a variable FiIe1. IMPLICIT NONE helps find these sorts of spelling mistakes, but the code has clearly been written using implicit typing. These sorts of errors suggest that the source has come from optical character recognition or similar. If so, you will need to be very mindful of OCR errors elsewhere in the source.
data entrance error Fortran
I'm learning how to programming with fortran90 and i need receive data from a txt file by the command prompt (something like that: program.exe"<"data.txt). at the Input txt file I'll always have a single line with at least 6 numbers till infinity. if the data was wrote line by line it runs fine but as single line I'm receiving the error: "traceback:not available,compile with - ftrace=frame or - ftrace=full fortran runtime error:end file" *note: i'm using Force fortran 2.0 here is example of data: 0 1 0.001 5 3 1 0 -9 3 edit: just clarifying: the code is working fine itself except for the read statement, which is a simple "read*,". I want know how To read a entire line from a txt once the entrance will be made by the promt command with stream direction. ( you can see more about that here: https://www.microsoft.com/resources/documentation/windows/xp/all/proddocs/en-us/redirection.mspx?mfr=true). there is no need to read the code, i've posted it just for knowledge. I'm sorry about the whole inconvenience. here is the code so far: program bissecao implicit none integer::cont,int,e,k,intc,t1,t2,t3 doubleprecision::ii,is,pre,prec,erro,somaa,somab,xn doubleprecision,dimension(:),allocatable::co t1=0 t2=0 t3=0 ! print*,"insira um limite inf da funcao" read*,ii !print*,"insira o limite superior da func" read*,is ! print*,"insira a precisÆo admissivel" read*,pre if (erro<=0) then !elimina criterio de parada negativo ou zero Print*,"erro" go to 100 end if !print*,"insira a qtd iteracoes admissiveis" read*,int !print*,"insira o grau da f(x)" read*,e if (e<=0) then ! elimina expoente negativo e=(e**2)**(0.5) end if allocate(co(e+1)) !print*, "insira os coeficientes na ordem:& ! &c1x^n+...+(cn-1)x^1+cnx^0" read(*,*)(co(k),k=e+1,1,-1) somab=2*pre intc=0 do while (intc<int.and.(somab**2)**0.5>pre.and.((is-ii)**2)**0.5>pre) somab=0 somaa=0 xn =(ii+is)/2 do k=1,e+1,1 if (ii /=0) then somaa=ii**(k-1)*co(k)+somaa else somaa=co(1) end if ! print*,"somaa",k,"=",somaa end do do k=1,(e+1),1 if (xn/=0) then somab=xn**(k-1)*co(k)+somab else somab=co(1) end if !print*,"somab",k,"=",somab end do if ((somaa*somab)<0) then is=xn else if((somaa*somab)>0)then ii=xn else if ((somaa*somab)==0) then xn=(ii+is)/2 go to 100 end if intc =intc+1 prec=is-ii if ((((is-ii)**2)**.5)< pre) then t3=1 end if if (((somab**2)**.5)< pre) then t2=1. end if if (intc>=int) then t1=1 end if end do somab=0 xn=(ii+is)/2 do k=1,(e+1),1 if (xn/=0) then somab=xn**(k-1)*co(k)+somab else somab=co(1) end if end do 100 write(*,'(A,F20.15,A,F20.15,A,A,F20.15,A,F20.15,A,I2)'),"I:[",ii,",",is,"]","raiz:",xn,"Fraiz:",somab,"Iteracoes:",intc end program !----------------------------------------------------------------------------
In your program, you are using the "list-directed input" (i.e., read *, or read(*,*)) read *, ii read *, is read *, pre read *, int read *, e read *, ( co( k ), k = e+1, 1, -1 ) which means that the program goes to the next line of the data file after each read statement (by neglecting any remaining data in the same line). So, the program works if the data file (say "multi.dat") consists of separate lines (as suggested by OP): 0 1 0.001 5 3 1 0 -9 3 But now you are trying to read an input file containing only a single line (say "single.dat") 0 1 0.001 5 3 1 0 -9 3 In this case, we need to read all the values with a single read statement (if list-directed input is to be used). A subtle point here is that the range of array co depends on e, which also needs to be read by the same read statement. A workaround might be to just pre-allocate co with a sufficiently large number of elements (say 100) and read the data in a single line, e.g., integer :: k allocate( co( 100 ) ) read *, ii, is, pre, int, e, ( co( k ), k = e+1, 1, -1 ) For completeness, here is a test program where you can choose method = 1 or 2 to read "multi.dat" or "single.dat". program main implicit none integer :: int, e, k, method double precision :: ii, is, pre double precision, allocatable :: co(:) allocate( co( 1000 ) ) method = 1 !! 1:multi-line-data, 2:single-line-data if ( method == 1 ) then call system( "cat multi.dat" ) read*, ii read*, is read*, pre read*, int read*, e read*, ( co( k ), k = e+1, 1, -1 ) else call system( "cat single.dat" ) read*, ii, is, pre, int, e, ( co( k ), k = e+1, 1, -1 ) endif print *, "Input data obtained:" print *, "ii = ", ii print *, "is = ", is print *, "pre = ", pre print *, "int = ", int print *, "e = ", e do k = 1, e+1 print *, "co(", k, ") = ", co( k ) enddo end program You can pass the input file from standard input as ./a.out < multi.dat (for method=1) ./a.out < single.dat (for method=2) Please note that "multi.dat" can also be read directly by using "<".
Syntax error of DATA statement in Fortran 90
I have to compute few complex integrals and for this purpose I got from my supervisor old program written in Fortran 77. However I have few problems with it. Mostly associated with syntax errors of DATA Statement. This is a part of code with a function calculating real integrals: FUNCTION CAUSSA(F,A,B,EPS) IMPLICIT DOUBLE PRECISION (A-H,O-Z) external f REAL :: W(12),X(12) DATA CONST /1.0D-12/ DATA W & 1 /0.10122 85362 9037 , 0.22238 10344 5337 , 0.31370 66458 7788 ,& 2 0.36268 37833 7836 , 0.02715 24594 1175 , 0.06225 35239 3864 ,& 3 0.09515 85116 8249 , 0.12462 89712 5553 , 0.14959 59888 1657 ,& 4 0.16915 65193 9500 , 0.18260 34150 4492 , 0.18945 06104 5506 / DATA X & 1 /0.96028 98564 9753 , 0.79666 64774 1362 , 0.52553 24099 1632 ,& 2 0.18343 46424 9565 , 0.98940 09349 9165 , 0.94457 50230 7323 ,& 3 0.86563 12023 8783 , 0.75540 44083 5500 , 0.61787 62444 0264 ,& 4 0.45801 67776 5722 , 0.28160 35507 7925 , 0.09501 25098 3763 / DELTA=CONST*DABS(A-B) CAUSSA=0.d0 AA=A 5 Y=B-AA IF(DABS(Y) .LE. DELTA) RETURN 2 BB=AA+Y C1=0.5*(AA+BB) C2=C1-AA S8=0.d0 S16=0.d0 DO 1 I=1,4 U=X(I)*C2 1 S8=S8+W(I)*(F(C1+U)+F(C1-U)) DO 3 I = 5,12 U=X(I)*C2 3 S16=S16+W(I)*(F(C1+U)+F(C1-U)) S8=S8*C2 S16=S16*C2 IF(DABS(S16-S8).GT.EPS*DABS(S16)) GO TO 4 CAUSSA= CAUSSA+S16 A=BB GO TO 5 4 Y=0.5*Y IF(DABS(Y) .GT. DELTA) GO TO 2 write(2,7) write(5,7) 7 FORMAT(1X,35HCAUSSA...TOO HIGH ACCURACY REQUIRED) CAUSSA=0.d0 RETURN END The result of compilation is following: sample.f90:11: 1 /0.10122 85362 9037 , 0.22238 10344 5337 , 0.31370 66458 7788 ,& 1 Error: Syntax error in DATA statement at (1) sample.f90:17: 1 /0.96028 98564 9753 , 0.79666 64774 1362 , 0.52553 24099 1632 ,& 1 Error: Syntax error in DATA statement at (1) I use gfortran version 4.4.7. I tried to rewrite those arrays but the result is always the same. Although this function is not the best for integrating, I still need it. Without it, that old program is collapsing. I would appreciate any advice.
If you want to compile this as free form source, there are two things you will probably need to change I am pretty sure that labels are illegal in continuation lines, so they should be removed gfortran will misinterpreted the spaces between sections of the floating point numbers, so those also should be removed. Something like this: DATA W & /0.10122853629037 , 0.22238103445337 , 0.31370664587788 ,& 0.36268378337836 , 0.02715245941175 , 0.06225352393864 ,& 0.09515851168249 , 0.12462897125553 , 0.14959598881657 ,& 0.16915651939500 , 0.18260341504492 , 0.18945061045506 / should probably compile correctly [note written in browser and not tested].
Your original code was erroneously mixing both free-form and fixed-source format. Line continuations in free-form are performed by using a trailing ampersand character, &, rather than entering a character in column 6 of the following line. In fixed-source form, the first six columns are reserved for statement labels, with column 1 also used to indicate comment lines. In modern code, using structured control statements (such as select case or if-then-else) statement labels are uncommon. The first five columns are therefore wasted because they are rarely used. Here is the same code in free-form and fixed-source format: program main use ISO_Fortran_env, only: & compiler_version, & compiler_options ! Explicit typing only implicit none ! Variable declarations double precision :: a, b, eps, x a = 1.0d0 b = 2.0d0 eps = epsilon(a) x = caussa(my_func, a, b, eps) print '(/4a/)', & ' This file was compiled using ', compiler_version(), & ' using the options ', compiler_options() contains function my_func(arg) result (return_value) ! Dummy arguments double precision, intent (in) :: arg double precision :: return_value return_value = arg * 42.0d0 end function my_func function caussa(f,a,b,eps) use ISO_Fortran_env, only: & stderr => ERROR_UNIT implicit double precision (a-h,o-z) external f integer :: i real :: w(12),x(12) data const /1.0d-12/ data w & /0.10122853629037, 0.22238103445337, 0.31370664587788 ,& 0.36268378337836, 0.02715245941175, 0.06225352393864 , & 0.09515851168249, 0.12462897125553, 0.14959598881657 , & 0.16915651939500, 0.18260341504492, 0.18945061045506 / data x & /0.96028985649753, 0.79666647741362, 0.52553240991632, & 0.18343464249565, 0.98940093499165, 0.94457502307323, & 0.86563120238783, 0.75540440835500, 0.61787624440264, & 0.45801677765722, 0.28160355077925, 0.09501250983763 / delta=const*dabs(a-b) caussa=0.d0 aa=a 5 y=b-aa if (dabs(y) <= delta) return 2 bb=aa+y c1=0.5*(aa+bb) c2=c1-aa s8=0.d0 s16=0.d0 do 1 i=1,4 u=x(i)*c2 1 s8=s8+w(i)*(f(c1+u)+f(c1-u)) do 3 i = 5,12 u=x(i)*c2 3 s16=s16+w(i)*(f(c1+u)+f(c1-u)) s8=s8*c2 s16=s16*c2 if (dabs(s16-s8)>eps*dabs(s16)) go to 4 caussa = caussa+s16 a = bb go to 5 4 y = 0.5*y if (dabs(y) > delta) go to 2 write(2,7) write(stderr,7) ! ! 7 format(1x,35hcaussa...too high accuracy required) ! Hollerith format specifier is a Fortran 95 deleted feature ! 7 format(1x, 'caussa...too high accuracy required') caussa=0.d0 end function caussa end program main Here's the fixed-form version PROGRAM MAIN USE ISO_FORTRAN_ENV, ONLY: 1 COMPILER_VERSION, 2 COMPILER_OPTIONS C EXPLICIT TYPING ONLY IMPLICIT NONE C VARIABLE DECLARATIONS DOUBLE PRECISION :: A, B, EPS, X A = 1.0D0 B = 2.0D0 EPS = EPSILON(A) X = CAUSSA(MY_FUNC, A, B, EPS) PRINT '(/4A/)', 1 ' THIS FILE WAS COMPILED USING ', COMPILER_VERSION(), 2 ' USING THE OPTIONS ', COMPILER_OPTIONS() CONTAINS FUNCTION MY_FUNC(ARG) RESULT (RETURN_VALUE) C DUMMY ARGUMENTS DOUBLE PRECISION, INTENT (IN) :: ARG DOUBLE PRECISION :: RETURN_VALUE RETURN_VALUE = ARG * 42.0D0 END FUNCTION MY_FUNC FUNCTION CAUSSA(F,A,B,EPS) USE ISO_FORTRAN_ENV, ONLY: 1 STDERR => ERROR_UNIT IMPLICIT DOUBLE PRECISION (A-H,O-Z) EXTERNAL F INTEGER I REAL :: W(12), X(12) DATA CONST /1.0D-12/ DATA W 1 /0.10122 85362 9037, 0.22238 10344 5337, 0.31370 66458 7788, 2 0.36268 37833 7836, 0.02715 24594 1175, 0.06225 35239 3864, 3 0.09515 85116 8249, 0.12462 89712 5553, 0.14959 59888 1657, 4 0.16915 65193 9500, 0.18260 34150 4492, 0.18945 06104 5506 / DATA X 1 /0.96028 98564 9753, 0.79666 64774 1362, 0.52553 24099 1632, 2 0.18343 46424 9565, 0.98940 09349 9165, 0.94457 50230 7323, 3 0.86563 12023 8783, 0.75540 44083 5500, 0.61787 62444 0264, 4 0.45801 67776 5722, 0.28160 35507 7925, 0.09501 25098 3763 / DELTA=CONST*DABS(A-B) CAUSSA=0.D0 AA=A 5 Y=B-AA IF(DABS(Y) .LE. DELTA) RETURN 2 BB=AA+Y C1=0.5*(AA+BB) C2=C1-AA S8=0.D0 S16=0.D0 DO 1 I=1,4 U=X(I)*C2 1 S8=S8+W(I)*(F(C1+U)+F(C1-U)) DO 3 I = 5,12 U=X(I)*C2 3 S16=S16+W(I)*(F(C1+U)+F(C1-U)) S8=S8*C2 S16=S16*C2 IF(DABS(S16-S8).GT.EPS*DABS(S16)) GO TO 4 CAUSSA= CAUSSA+S16 A=BB GO TO 5 4 Y=0.5*Y IF(DABS(Y) .GT. DELTA) GO TO 2 WRITE(2,7) WRITE(STDERR,7) C C 7 FORMAT(1X,35HCAUSSA...TOO HIGH ACCURACY REQUIRED) C HOLLERITH FORMAT SPECIFIER IS A FORTRAN 95 DELETED FEATURE C 7 FORMAT(1X, 'CAUSSA...TOO HIGH ACCURACY REQUIRED') CAUSSA=0.D0 RETURN END FUNCTION CAUSSA END PROGRAM MAIN With free-form, the concept of “significant blanks” was introduced. In fixed-source, blanks were insignificant in most contexts. Here is a sample of a fixed-source statement showing what are now considered significant blanks followed by an equivalent statement without the blanks: DO N = 1, MAX ITER S DO N = 1, MAXITERS Notice how we rewrote DATA W 1 /0.10122 85362 9037, blah blah as data w & /0.10122853629037, blah blah
Fortran rank mismatch error
I receive the following error Compiling file: tropic.f Warning: Extension: Tab character in format at (1) C:\Users\Marchant\Desktop\tropic.f(432) : error - Expected a right parenthesis in expression at column 72 Warning: Rank mismatch in argument 'tk' at (1) (scalar and rank-1) Warning: Rank mismatch in argument 't' at (1) (scalar and rank-1) Warning: Rank mismatch in argument 'tk' at (1) (scalar and rank-1) Warning: Rank mismatch in argument 't' at (1) (scalar and rank-1) Compilation failed. in this program, dimension ts1(3),ts2(3),ta1(3),ta2(3),out(14,300) real lwc, lambda common /params/xkap,pr,tr,xl,cp,rgas,grav,taue,taus,taup,tauc common /param2/ pbot,ptop,dp,gam, bt,ct,tao,a21,lambda,lwc common /heat/ beta,olr1,olr2,alb0,albgr,expo1,expo2,alb1,alb2 pbot=1.0e5 ptop=2.0e4 dp=pbot-ptop open(12,file='tropic.in',form='formatted') read(12,*) itermx, delt, iprint read(12,*) lambda, gam, bt, ct, a1 read(12,*) beta,olr1,olr2,alb0,albgr,expo1,expo2 write(*,*) 'olr1=',olr1,', olr2=',olr2,', expo1=',expo1,', expo2=' 1 ,expo2 c ** Set relative areas of convecting a1 and nonconvecting a2 regions. c a1=.3 tao=265. alpha=0.06 alpha2=alpha/2. alpha1=1.-alpha c expo1=80. c expo2=80. expa1=0. expa2=0. co=4.2e7 ca=1.0e7 xkap=0.288 rvap=461. cp=1004. rgas=287. grav=9.81 c gam=1.0e-3 c lambda=1.0e3 pr=1.0e5 tr=300. xl=2.5e6 write(*,*) ' gam=',gam c** structure of output array c out(1)=a1; 2=gam; 3=lambda c 4=ts1 5=ts2 6=alb1 7=alb2 c 8=r1 9=r2 10=ts1tend 11=ts2tend c 13=thet1 14=thet2 ikase=0 c ********* BIG LOOP **************** do 888 nn=1,2 a1=0.1+0.2*nn do 888 ll=1,7 c gam=1.0e-3*facg gam=1/1024.*2.0**(ll-1) do 888 mm=1,7 c lambda=1.0e+3*facl lambda=64*2.0**(mm-1) c write(*,*) '*******************************' c write(*,*) 'GAM=',gam,', LAMBDA=',lambda,', A1=',a1 a2=1.-a1 a21=a2/a1 a12=a1/a2 c initialize variables do i = 1,3 ts1(i)=301. ts2(i)=300. ta1(i)=302. ta2(i)=300. end do is=1 js=2 tdelto=2.*delt/co tdelta=2.*delt/ca c write(*,999) ts1(js),ts2(js),ta1(js),ta2(js),r1,r2,ra1,ra2 999 format(1x,9f8.1) c write(*,*) pbot,ptop,dp,pr,gam,bt,ct,tao,a21,lambda,lwc ikase=ikase+1 c*** Time Loop ***** do 1000 it=1,itermx dta=ta1(js)-ta2(js) dto=ts1(js)-ts2(js) call radiat(ts1(js),ts2(js),ta1(js),ta2(js),r1,r2,ra1,ra2) call theta(ts1(js),ts2(js),ta1(js),ta2(js),demdp,demd2,deddp) c** Note that demdp = del(theta)/grav ts1(3)=ts1(is)+tdelto*(r1-gam*dto*cp*demdp-expo1) ts2(3)=ts2(is)+tdelto*(r2+a12*gam*dto*cp*demdp-expo2) c ta1(3)=ta1(is)+tdelta*(ra1-a21*gam*dto*cp*demdp-expa1) c ta2(3)=ta2(is)+tdelta*(ra2+gam*dto*cp*deddp-expa2) c apply Robert/Asselin filter ts1(js)=ts1(js)*alpha1 +alpha2*(ts1(3)+ts1(is)) ts2(js)=ts2(js)*alpha1 +alpha2*(ts2(3)+ts2(is)) c if((it-1)/iprint*iprint.eq.it-1) then if((it.eq.itermx)) then time=(it-1)*delt/86400. ts1tend=(r1-gam*dto*cp*demdp-expo1)*86400./co ts2tend=(r2+a12*gam*dto*cp*demdp-expo2)*86400./co c ta1tend=(-a21*gam*dto*cp*demdp) c ta2tend=( gam*dto*cp*demdp) thet1=thet(ts1,qsat(ts1,pbot),pbot) thet2=thet(ts2,qsat(ts2,pbot),pbot) c** structure of output array c out(1)=a1; 2=gam; 3=lambda c 4=ts1 5=ts2 6=alb1 7=alb2 c 8=r1 9=r2 10=ts1tend 11=ts2tend c 12=thet1 13=thet2 c Set up array out(1,ikase)=a1 out(2,ikase)=gam out(3,ikase)=lambda out(4,ikase)=ts1(js) out(5,ikase)=ts2(js) out(6,ikase)=alb1 out(7,ikase)=alb2 out(8,ikase)=r1 out(9,ikase)=r2 out(10,ikase)=ts1tend out(11,ikase)=ts2tend out(12,ikase)=thet1 out(13,ikase)=thet2 out(14,ikase)=qsat(ts1(js),pr) c write(*,*) 'Day=',time, ', iter=',it c write(*,*) a21,gam,dto,cp,demdp c write(*,*) 'demdp, demd2,deddp', demdp, demd2,deddp c write(*,*) 'lwc=',lwc,alb1, alb2 c*********x*********x*********x*********x*********x*********x*********x********** c write(*,*) ' ts1, ts2, ta1, ta2, r1, r2, ra1, c 1 ra2' c write(*,999) ts1(3),ts2(3),ta1(3),ta2(3),r1,r2,ra1,ra2 c write(*,999) ts1(js),ts2(js),ta1(js),ta2(js),r1,r2,ra1,ra2 c write(*,998) ts1tend,ts2tend,ta1tend,ta2tend, thet1, thet2 998 format(1x,8f10.5) endif c ** Update Variables is=3-is js=3-js ts1(js)=ts1(3) ts2(js)=ts2(3) ta1(js)=ta1(3) ta2(js)=ta2(3) 1000 continue 888 continue open(13,file='tropic.out',form='formatted') c*********x*********x*********x*********x*********x*********x*********x********** write(*,*) ' A1 gam lambda ts1 ts2 alb1 1alb2 r1 r2 ts1tend ts2tend thet1 thet2 qsat' write(13,*) ' A1 gam lambda ts1 ts2 alb1 1alb2 r1 r2 ts1tend ts2tend thet1 thet2 qsat' do ii=1,ikase xkrap=out(2,ii)*out(3,ii) write(*,789) (out(j,ii),j=1,14),xkrap write(13,789) (out(j,ii),j=1,14),xkrap 789 format(1x,f6.1,f9.5,7f9.2,2f9.5,2f8.2,2f8.4) enddo stop end c ****************************************************** subroutine theta(ts1,ts2,ta1,ta2,demdp,demd2,deddp) c ** This subroutine finds the theta gradients real lwc, lambda common /param2/ pbot,ptop,dp,gam, bt,ct,tao,a21,lambda,lwc common /params/xkap,pr,tr,xl,cp,rgas,grav,taue,taus,taup,tauc demdp=(thet(ts1,qsat(ts1,pbot),pbot)-thet(ts2,qsat(ts2,pbot), 1 pbot))/9.81 c 1 pbot))/dp demd2=(thet(ta1,0.001,ptop)-thet(ts1,qsat(ts1,pbot),pbot)) 1 /9.81 c 1 /dp deddp=(thet(ts1,0.00001,ptop)-thet(ts2,0.00001,pbot))/9.81 c 1 /dp return end c ****************************************************** subroutine radiat(ts1,ts2,ta1,ta2,r1,r2,ra1,ra2) real lwc, lambda common /param2/ pbot,ptop,dp,gam, bt,ct,tao,a21,lambda,lwc common /params/xkap,pr,tr,xl,cp,rgas,grav,taue,taus,taup,tauc common /heat/ beta,olr1,olr2,alb0,albgr,expo1,expo2,alb1,alb2 dta=ta1-ta2 dto=ts1-ts2 if(dto.gt.0.0) then c ** radiation parameterization for atmosphere ra1=-40-bt*(ta1-tao)+ct*(ts1-(ta1+29)) ra2=-200-bt*(ta2-tao)+ct*(ts2-(ta2+29)) c ** Get liquid water content c lwc=lambda*a21*gam*abs(dto)*qsat(ts1,pr) c ** Get albedo as function of LWC alb2=alb0 alb1=alb0+lambda*gam*abs(dto)*qsat(ts1,pr) if(alb1.gt.0.75) alb1=0.75 r1=400.*(1.-alb1)-olr1-beta*(ts1-300.) r2=400.*(1.-alb2)-olr2-beta*(ts2-300.) else c ** here ts2 is hotter than ts1 c ** radiation parameterization for atmosphere ra1=-200-bt*(ta1-tao)+ct*(ts1-(ta1+29)) ra2=-40-bt*(ta2-tao)+ct*(ts2-(ta2+29)) c ** Get liquid water content c lwc=lambda*gam*abs(dto)*qsat(ts2,pr) c ** Get albedo as function of LWC alb1=alb0 alb2=alb0+lambda*gam*abs(dto)*qsat(ts2,pr) if(alb2.gt.0.75) alb2=0.75 r1=400.*(1.-alb1)-olr2-beta*(ts1-300.) r2=400.*(1.-alb2)-olr1-beta*(ts2-300.) endif c write(*,*) 'lwc=',lwc,', alb1,2=',alb1,alb2,', r,ra-',r1,r2,ra1,ra2 return end c*********x*********x*********x*********x*********x*********x*********x********** c************************************************************* function temp(the,rv,p) c** Function calculates temperature given thetaE, rv and p common /params/xkap,pr,tr,xl,cp,rgas,grav,taue,taus,taup,tauc temp=the/((pr/p)**xkap*exp(xl*rv/(cp*tr))) return end c************************************************************* function thet(t,rv,p) c** Function calculates thetaE given t, rv and p common /params/xkap,pr,tr,xl,cp,rgas,grav,taue,taus,taup,tauc thet=t*(pr/p)**xkap*exp(xl*rv/(cp*tr)) return end c************************************************************* function thets(t,p) c** Function calculates thetaEsaturate given t and p common /params/xkap,pr,tr,xl,cp,rgas,grav,taue,taus,taup,tauc if(t.lt.273.15) then es=esice(t) else es=esat(t) endif rs=0.622*es/(p-es) thets=t*(pr/p)**xkap*exp(xl*rs/(cp*tr)) return end c************************************************************* subroutine plevs(p,xlp,dlp,dp) c** Subroutine to set pressure levels parameter(ilx=25) dimension p(ilx),xlp(ilx),dlp(ilx),dp(ilx) write(*,*) 'Setting Pressure Levels' write(*,*) ' i p(i) dp(i) logp dlogp' pmin=2000. pmax=101300. delpo=pmax-pmin delp=delpo/(ilx-1) do i=1,ilx p(i)=pmin+(i-1.)*delp xlp(i)=alog(p(i)) end do do i=1,ilx-1 dlp(i)=xlp(i+1)-xlp(i) dp(i)=p(i+1)-p(i) end do dlp(ilx)=0.0 do i=1,ilx write(*,*) i,p(i),dp(i),xlp(i),dlp(i) end do return end c************************************************************* subroutine radini(teq,p,t,sst) c** Calculates variables needed by radiation relaxation code parameter (ilx=25) dimension p(ilx),t(ilx),teq(ilx) do i=1,ilx if(p(i).lt.12000.) then teq(i)=t(i) c elseif(p(i).gt.80000.) then else teq(i)=t(i)-10. c teq(i)=t(i)-(p(ilx)/10000.)*2. endif end do return end c************************************************************* subroutine initlz(the,rt,rs,t,rv,p,sst) c** Subroutine to set initial values of all variables parameter (ilx=25) dimension the(ilx),rt(ilx),rs(ilx),t(ilx),rv(ilx), 1 p(ilx) common /params/xkap,pr,tr,xl,cp,rgas,grav,taue,taus,taup,tauc ttrop=200. tsurf=300. ptrop=10000. dtdp=(tsurf-ttrop)/(p(ilx)-ptrop) relhum=0.80 c** Set T(p) do i=1,ilx if(p(i).lt.ptrop) then t(i)=200.+10.*(ptrop-p(i))/(ptrop-p(1)) else t(i)=200.+dtdp*(p(i)-ptrop) endif end do c** Next calculate vapor mixing ratio and thetaE write(*,*) 'index, pressure, temp., vapor mr, thetaE' do i=1,ilx if(p(i).lt.ptrop) then rfrac=0.05 else rfrac=relhum endif if(t(i).lt.273.) then es=esice(t(i)) else es=esat(t(i)) endif rv(i)=rfrac*0.622*es/(p(i)-es) rs(i)=0.622*es/(p(i)-es) rt(i)=rv(i) the(i)=t(i)*(pr/p(i))**xkap*exp(xl*rv(i)/(cp*tr)) write(*,100) i,p(i),t(i),rv(i),the(i) 100 format(1x,i3,f12.1,f7.1,e13.3,f7.1) end do return end c************************************************************* function signum(x) c** Hankel function if(x.eq.0) then signum=1. else signum=(abs(x)+x)*0.5/abs(x) endif return end c************************************************************* subroutine zero(x,n) dimension x(n) do i=1,n x(i)=0.0 end do return end C####################################################################### FUNCTION ESICE(TK) C THIS FUNCTION RETURNS THE SATURATION VAPOR PRESSURE WITH RESPECT TO C ICE ESICE (Pascals) GIVEN THE TEMPERATURE T (Kelvin). DLH 11.19.97 C THE FORMULA USED IS BASED UPON THE INTEGRATION OF THE CLAUSIUS- C CLAPEYRON EQUATION BY GOFF AND GRATCH. THE FORMULA APPEARS ON P.350 C OF THE SMITHSONIAN METEOROLOGICAL TABLES, SIXTH REVISED EDITION, C 1963. DATA CTA,EIS/273.15,6.1071/ C CTA = DIFFERENCE BETWEEN KELVIN AND CELSIUS TEMPERATURE C EIS = SATURATION VAPOR PRESSURE (MB) OVER A WATER-ICE MIXTURE AT 0C DATA C1,C2,C3/9.09718,3.56654,0.876793/ C C1,C2,C3 = EMPIRICAL COEFFICIENTS IN THE GOFF-GRATCH FORMULA c**** Convert to Celsius c tc=t-273.15 IF (TK.LE.CTA) GO TO 5 ESICE = 99999. WRITE(6,3)ESICE 3 FORMAT(' SATURATION VAPOR PRESSURE FOR ICE CANNOT BE COMPUTED', 1 /' FOR TEMPERATURE > 0C. ESICE =',F7.0) RETURN 5 CONTINUE C FREEZING POINT OF WATER (K) TF = CTA C GOFF-GRATCH FORMULA RHS = -C1*(TF/TK-1.)-C2*ALOG10(TF/TK)+C3*(1.-TK/TF)+ALOG10(EIS) ESI = 10.**RHS IF (ESI.LT.0.) ESI = 0. ESICE = ESI*100. RETURN END C####################################################################### FUNCTION ESAT(TK) C THIS FUNCTION RETURNS THE SATURATION VAPOR PRESSURE OVER C WATER (Pa) GIVEN THE TEMPERATURE (Kelvin). DLH 11.19.97 C THE ALGORITHM IS DUE TO NORDQUIST, W.S.,1973: "NUMERICAL APPROXIMA- C TIONS OF SELECTED METEORLOLGICAL PARAMETERS FOR CLOUD PHYSICS PROB- C LEMS," ECOM-5475, ATMOSPHERIC SCIENCES LABORATORY, U.S. ARMY C ELECTRONICS COMMAND, WHITE SANDS MISSILE RANGE, NEW MEXICO 88002. IF (TD.NE. 99999.0) THEN C IF (TD.NE.-1001.0) THEN c**** Convert to Celsius c TK = TD+273.15 P1 = 11.344-0.0303998*TK P2 = 3.49149-1302.8844/TK C1 = 23.832241-5.02808*ALOG10(TK) ESAT = 100.*10.**(C1-1.3816E-7*10.**P1+8.1328E-3*10.**P2-2949.076/TK) else esat = 0. END IF RETURN END C####################################################################### function qsat(tk,p) qsat=esat(tk)*0.622/p return end Can someone show me how to fix this? its a fortran77 file being compiled in mingw gfortran
At least the line ESAT = 100.*10.**(C1-1.3816E-7*10.**P1+8.1328E-3*10.**P2-2949.076/TK) is too long for FORTRAN 77 standard. At least when the statement starts at column 7. In your code it appears to start earlier, but that is wrong. Break it, ESAT = 100.*10.**(C1-1.3816E-7*10.**P1+ * 8.1328E-3*10.**P2-2949.076/TK) or use an option like -ffixed-line-length-132 to make the limit larger (it is non-standard!). Also many of your statements appear to start on earlier column than 7. This may be a copy-paste error to this page, it may be due to the non-conforming tab characters the compiler warns about. If it is not the case, correct it too, they must start at column 7 or further. For example, this is very strange: IF (TD.NE. 99999.0) THEN C IF (TD.NE.-1001.0) THEN There may be other errors, but your code is simply too long and cannot be compiled by copy-paste.