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.