Segmentation (SIGSEV) fault and SIGBUS fault while running fortran code - fortran

I'm running a fortran code using .f90 to do some cavity study for natural convection. However I encountered the above mentioned errors.
Program received signal SIGSEGV: Segmentation fault - invalid memory reference.
Backtrace for this error:
Program received signal SIGBUS: Access to an undefined portion of a memory object.
Backtrace for this error:
My code is shown here below:
! PROGRAM MAIN
IMPLICIT REAL*8(A-H,O-Z)
DIMENSION AX(50,50),XX(50) ,AY(50,50),YY(50)
DIMENSION U(50,50),V(50,50) ,DP(50,50), P(50,50)
DIMENSION T(50,50),W(50,50) ,DT(50,50),DW(50,50)
! INPUT NUMBER OF MESH POINTS, MAXIMUM ITERATION NUMBER, TIME STEP SIZE, CONVERGERENCE CRITERIA, PRANDTL NUMBER AND RAYLEIGH NUMBER
WRITE(6,*) 'N,M,NTT,H,ERRT,ERRVORT,ERRSTREAM,PR,RA'
READ(5,*) N,M,NTT,H,EPS1,EPS2,EPS3,PR,RA
AX=1/(N-1)
AY=1/(M-1)
! MESH GENERATION AND SET-UP OF INITIAL FLOW FIELD
CALL GRID(N,M,XX,YY,U,V,W,T,DT,DW)
! START ITERATION
88 CONTINUE
! EULER METHOD TO SOLVE RESULTANT ORDINARY DIFFERENTIAL EQUATIONS FOR VORTICITY
CALL EULER(M,N,U,V,T,W,DT,DW)
! CALCULATE STREAM FUNCTION USING JACOBI RELAXATION SOLVER
CALL SOLP(N,M,W,P,DP)
! IMPLEMENT BOUNDARY CONDITIONS FOR VORTICITY
CALL BCVOR(N,M,W,P)
! COMPUTE VELOCITY U, V
CALL CALUV(N,M,U,V,P)
! IMPLEMENT BOUNDARY CONDITIONS FOR TEMPERATURE
CALL BCT(N,M,T)
! FIND OUT MAXIMUM RESIDUALS
ERR1=DT(1,1) **2
ERR2=DW(1,1) **2
ERR3=DP(1,1)**2
DO 91 I=l,N
DO 91 J=l,M
ERR1=DT(I,J)**2+ERR1
ERR2=DW(I,J)**2+ERR2
ERR3=DP(I,J)**2+ERR3
91 CONTINUE
NM=N*M
ERR1=SQRT(ERR1/NM)
ERR2 = SQRT (ERR2/NM)
ERR3=SQRT(ERR3/NM)
WRITE(6,113) NT,ERR1,ERR2,ERR3
113 FORMAT(1X,I10,5X,' ERR1=',E10.5,5X,'ERR2=',E10.5, 5X,'ERR3=',E10.5)
! CHECK CONVERGENCE CRITERIA
IF(ERR1.LE.EPS1.AND.ERR2.LE.EPS2.AND.ERR3.LE.EPS3) GO TO 92
IF(NT.GE.NTT) GO TO 92
NT=NT+1
GO TO 88
92 CONTINUE
! COMPUTE NUSSELT NUMBERS
CALL NUSEC(N,M,XX,YY,AX,U,V,T)
! INTERPOLATE NUMERICAL RESULTS FROM COARSE MESH TO FINE MESH FOR PLOTTING AND OTHER PURPOSE
CALL OUTPLT(N,M,XX,YY,U,V,W,T,P)
STOP
END
The compiler was able to compile the code, so I'm unsure what went wrong inside the code. Hopefully some can help me with this.
Further details of the code:
! THIS SUBROUTINE IS TO GENERATE THE COORDINATES OF MESH POINTS
SUBROUTINE GRID(N,M,XX,YY,U,V,W,T,DT,DW)
IMPLICIT REAL*8 (A-H,O-Z)
DIMENSION XX(50),YY(50),U(50,50),V(50,50)
DIMENSION T(50,50),W(50,50),DT(50,50),DW(50,50)
! THIS SUBROUTINE IS TO GENERATE THE COORDINATES OF MESH POINTS
WRITE(6,*) 'ALAX,ALAY'
READ(5,*) ALAX,ALAY
PI=4. *ATAN(1.)
DO 71 I=1,N
ALFA=PI*FLOAT(I-1)/FLOAT(N-1)
71 XX(I)=0.5*(1.-COS(ALFA))
X11=XX(1)
! STRETCH THE MESH TOWARDS THE BOUNDARY, ALAX<1
DO 76 I=1,N
76 XX(I)=(1.-ALAX)*(3.*XX(I)**2-2.*XX(I)**3)+ALAX*XX(I)
DO 81 J=1,M
ALFA=PI*FLOAT(J-1)/FLOAT(M-1)
81 YY(J)=0.5*(1.-COS(ALFA))
! STRETCH THE MESH TOWARDS THE BOUNDARY, ALAY<1
DO 86 J=1,M
86 YY(J)=(1.-ALAY)*(3.*YY(J)**2-2.*YY(J)**3)+ALAY*YY(J)
YY(MH)=0.5
! SET UP INITIAL FLOW FIELD
DO 18 J=1,M
DO 10 I=1,N
U(I,J)=0D0
V(I,J)=0D0
T(I,J)=0D0
W(I,J)=0D0
DT(I,J)=0D0
DW(I,J)=0D0
10 CONTINUE
T(1,J)=1.0
18 CONTINUE
RETURN
END
! EULER METHOD TO SOLVE RESULTANT ORDINARY DIFFERENTIAL EQUATIONS FOR VORTICITY
SUBROUTINE EULER(M,N,U,V,T,W,DT,DW)
IMPLICIT REAL*8(A-H,O-Z)
DIMENSION W(50,50),U(50,50),V(50,50),DW(50,50),T(50,50),DT(50,50)
CALL RESOVR(N,M,H,U,V,T,DT,AX,AY,W,DW,PR,RA)
DO I=2,N-1
DO J=2,M-1
W(I,J)=W(I,J)+0.25*H*DW(I,J)
END DO
END DO
RETURN
END
! COMPUTE THE RESIDUAL VORTICITY
SUBROUTINE RESOVR(N,M,H,U,V,T,DT,AX,AY,W,DW,PR,RA)
IMPLICIT REAL*8(A-H,O-Z)
DIMENSION U(50,50),V(50,50),W(50,50),DW(50,50),T(50,50),DT(50,50)
CALL SOLT(N,M,H,U,V,T,DT,AX,AY)
DO I=2,N-1
DO J=2,M-1
DWX2=(W(I+1,J)-2*W(I,J)+W(I-1,J))/(AX**2)
DWY2=(W(I,J+1)-2*W(I,J)+W(I,J-1))/(AY**2)
DWX1=U(I,J)*(W(I+1,J)-W(I-1,J))/(2*AX)
DWY1=V(I,J)*(W(I,J+1)-W(I,J-1))/(2*AY)
DW(I,J)=PR*(DWX2+DWY2)+PR*RA*T(I,J)-DWX1-DWY1
END DO
END DO
RETURN
END
! COMPUTE FOR TEMPERATURE
SUBROUTINE SOLT(N,M,H,U,V,T,DT,AX,AY)
IMPLICIT REAL*8(A-H,O-Z)
DIMENSION U(50,50),V(50,50),T(50,50),DT(50,50)
CALL REST(N,M,U,V,T,DT,AX,AY)
DO I=2,N-1
DO J=2,M-1
T(I,J)=T(I,J)+H*DT(I,J)
END DO
END DO
RETURN
END
! CALCULATE RESIDUAL TEMPERATURE
SUBROUTINE REST(N,M,U,V,T,DT,AX,AY)
IMPLICIT REAL*8(A-H,O-Z)
DIMENSION U(50,50),V(50,50),T(50,50),DT(50,50)
DO I =2,N-1
DO J=2,M-1
DTX1=0.5*(T(I+1,J)-T(I-1,J))/AX
DTY1=0.5*(T(I,J+1)-T(I,J-1))/AY
DTX2=(T(I+1,J)-2*T(I,J)+T(I-1,J))/(AX**2)
DTY2=(T(I,J+1)-2*T(I,J)+T(I,J-1))/(AY**2)
DT(I,J)=DTX2+DTY2-U(I,J)*DTX1-V(I,J)*DTY1
END DO
END DO
RETURN
END
! CALCULATE STREAM FUNCTION USING JACOBI RELAXATION SOLVER
SUBROUTINE SOLP(N,M,W,P,DP)
IMPLICIT REAL*8(A-H,O-Z)
DIMENSION P(50,50),DP(50,50),W(50,50)
CALL RESP(N,M,AX,AY,W,P,DP)
B=0.1
BW=1/(AX**2)
BS=1/(AY**2)
BP=-2*(BW+BS)
DO I=2,N-1
DO J=2,M-1
P(I,J)=P(I,J)+(B*DP(I,J))/BP
END DO
END DO
RETURN
END
! COMPUTE RESIDUAL STREAM FUNCTION
SUBROUTINE RESP(N,M,AX,AY,W,P,DP)
IMPLICIT REAL*8(A-H,O-Z)
DIMENSION W(50,50),P(50,50),DP(50,50)
DO I=2,N-1
DO J=2,M-1
DP(I,J)=W(I,J)-(P(I+1,J)-2*P(I,J)+P(I-1,J))/(AX**2)-(P(I,J+1)-2*P(I,J)+P(I,J-1))/(AY**2)
END DO
END DO
RETURN
END
! UPDATE STREAM FUNCTION AT BOUNDARY POINTS
SUBROUTINE BCP(N,M,AY,P)
IMPLICIT REAL*8(A-H,O-Z)
DIMENSION P(50,50)
DO J=2,M-1
P(2,J)=0.25*P(3,J)
P(N-1,J)=0.25*P(N-2,J)
END DO
DO I=2,N-1
P(I,2)=0.25*P(I,3)
P(I,M-1)=0.25*(P(I,M-2)-2*AY)
END DO
RETURN
END
! IMPLEMENT BOUNDARY CONDITIONS FOR VORTICITY
SUBROUTINE BCVOR(N,M,W,P)
IMPLICIT REAL*8(A-H,O-Z)
DIMENSION W(50,50),P(50,50)
DO J=1,M
W(1,J)=3*P(2,J)/(AX**2)-0.5*W(2,J)
W(N,J)=3*P(N-1,J)/(AX**2)-0.5*W(N-1,J)
END DO
DO I=2,N-1
W(I,1)=3*P(I,2)/(AY**2)-0.5*W(I,2)
W(I,M)=3*(P(I,M-1)+AY)/(AY**2)-0.5*W(I,M-1)
END DO
RETURN
END
! COMPUTE VELOCITY U, V
SUBROUTINE CALUV(N,M,U,V,P)
IMPLICIT REAL*8(A-H,O-Z)
DIMENSION P(50,50),U(50,50),V(50,50)
DO J=1,M
U(1,J)=0
U(N,J)=0
V(1,J)=0
V(N,J)=0
END DO
DO I=2,N-1
U(I,1)=0
V(I,1)=0
U(I,M)=0
V(I,M)=0
END DO
DO I=2,N-1
DO J=2,M-1
U(I,J)=0.5*(P(I,J+1)-P(I,J-1))/AY
V(I,J)=0.5*(P(I-1,J)-P(I+1,J))/AX
END DO
END DO
RETURN
END
! IMPLEMENT BOUNDARY CONDITIONS FOR TEMPERATURE
SUBROUTINE BCT(N,M,T)
IMPLICIT REAL*8(A-H,O-Z)
DIMENSION T(50,50)
DO I=1,N
T(I,1)=(4*T(I,2)-T(I,3))/3
T(I,M)=(4*T(I,M-1)-T(I,M-2))/3
END DO
DO J=1,M
T(1,J)=(4*T(2,J)-T(J,3))/3
T(N,J)=(4*T(N-1,J)-T(J,N-2))/3
END DO
RETURN
END
! COMPUTE NUSSELT NUMBERS
SUBROUTINE NUSEC(N,M,XX,YY,AX,U,V,T)
IMPLICIT REAL*8(A-H,O-Z)
DIMENSION XX(50),YY(50),X2(201),Y2(201),AX(50,50),U(50,50),V(50,50)
DIMENSION T(50,50),QQ(50,50),QI(50),QT(50,201),CNU(50),CNUT(201)
! COMPUTE LOCAL HEAT FLUX IN A HORIZONTAL DIRECTION Q(X,Y)
DO 10 I=1,N
DO 10 J=1,M
DTI=0.
DO 11 K=1,N
11 DTI=DTI+AX(I,K)*T(K,J)
10 QQ(I,J)=U(I,J)*T(I,J)-DTI
! SET UP A FINE MESH
NN=81
MM=81
TDX=(XX(N)-XX(1))/FLOAT(NN-1)
TDY=(YY(M)-YY(1))/FLOAT(MM-1)
DO 20 I=1,NN
20 X2(I)=FLOAT(I-1)*TDX
DO 30 J=1,MM
30 Y2(J)=FLOAT(J-1)*TDY
! INTERPOLATE Q(X,Y) TO THE FINE MESH IN THE Y DIRECTION
DO 40 I=1,N
DO 41 J=1,M
QI(J)=QQ(I,J)
41 CONTINUE
DO 42 J=1,MM
YJ=Y2(J)
CALL CZ(M,YJ,YY,QI,QOUT)
QT(I,J)=QOUT
42 CONTINUE
40 CONTINUE
! COMPUTE AVERAGE NUSSELT NUMBER ON THE VERTICAL LINE
DO 188 I=1,N
SUM=0.0
DO 198 J=2,MM
SUM=SUM+0.5*(QT(I,J)+QT(I,J-1))*TDY
198 CONTINUE
CNU(I) = SUM
188 CONTINUE
DO 52 I=1,NN
XI=X2(I)
CALL CZ(N,XI,XX,CNU,CNUOUT)
CNUT(I)=CNUOUT
52 CONTINUE
! FIND OUT MAXIMUM LOCAL NUSSELT NUMBERS AT X=0 TOGETHER WITH THEIR POSITIONS
AMIN=QT(1,1)
AMAX=QT(1,1)
DO 518 J=1,MM
IF(QT(1,J).LE.AMAX) GO TO 518
AMAX=QT(1,J)
YMAX=Y2(J)
518 CONTINUE
NH= (N+1) /2
! FIND OUT MAXIMUM VELOCITY AT VERTICAL MID-PLANE TOGETHER WITH THEIR POSITIONS
AMAX=U(1,1)
MPV=(NN+1)/2
DO 519 J=1,MM
IF(U(MPV,J).LE.AMAX) GO TO 519
UXMAX=X2(MPV)
UYMAX=Y2(J)
519 CONTINUE
NH= (N+1) /2
! FIND OUT MAXIMUM VELOCITY AT HORIZONTAL MID-PLANE TOGETHER WITH THEIR POSITIONS
AMAX=V(1,1)
MPH=(MM+1)/2
DO 520 I=1,NN
IF(V(I,MPH).LE.AMAX) GO TO 520
VXMAX=X2(I)
VYMAX=Y2(MPH)
520 CONTINUE
NH= (N+1) /2
! OUTPUT THE NUSSELT NUMBERS
WRITE(6,70) CNU(1)
70 FORMAT (2X, 'AVERAGE NUSSELT NUMBER AT X=0',5X,F15.4)
WRITE(6,72) CNU(NH)
72 FORMAT (2X, 'AVERAGE NUSSELT NUMBER AT X=0.5',3X,F15.4)
WRITE(6,74) AMAX,YMAX
74 FORMAT (2X, 'NUMAX AND POSITION AT X=0',5X,F10.4,5X,F10.4)
WRITE(6,76) UXMAX,UYMAX
76 FORMAT (2X, 'MAXIMUM HORIZONTAL VELOCITY AT VERTICAL MIDLPANE',5X,F15.4)
WRITE(6,78) VXMAX,VYMAX
78 FORMAT (2X, 'MAXIMUM VERTICAL VELOCITY AT HORIZONTAL MIDLPANE',5X,F15.4)
RETURN
END
! LAGRANGE INTERPOLATION
SUBROUTINE CZ(N,XX,X,F,FV)
IMPLICIT REAL*8 (A-H,O-Z)
DIMENSION X(50),F(50)
FV=0.
DO 10 I=1,N
AD=1.
DO 20 J=1,N
IF(J.EQ.I) GO TO 21
AD1=(XX-X(J))/(X(I)-X(J))
GO TO 22
21 AD1=1.
22 AD=AD*AD1
20 CONTINUE
FV=FV+AD*F(I)
10 CONTINUE
RETURN
END
! INTERPOLATE THE NUMERICAL RESULTS FROM A COARSE MESH TO A FINE MESH
SUBROUTINE OUTPLT(N,M,X1,Y1,U,V,W,G,P)
IMPLICIT REAL*8(A-H,O-Z)
DIMENSION X1(50),Y1(50),X2(81),Y2(81),P(50,50),W(50,50)
DIMENSION U(50,50),V(50,50),G(50,50),UT(81,81),VT(81,81)
DIMENSION GT(81,81),PT(81,81),WT(81,81),UI(51),UJ(51)
DIMENSION VI(51),VJ(51),WI(51),WJ(51),PI(51),PJ(51),GI(50),GJ(50)
X2(1)=X1(1)
Y2(1)=Y1(1)
WRITE(6,*) 'READ THE VALUES OF NN, MM FOR INTERPOLATION'
READ(5,*) NN,MM
TDX=(X1(N)-X1(1))/FLOAT(NN-1)
TDY=(Y1(M)-Y1(1))/FLOAT(MM-1)
! GENERATE FINE MESH
DO 20 I=2,NN
20 X2(I)=X2(I-1)+TDX
DO 30 J=2,MM
30 Y2(J)=Y2(J-1)+TDY
! INTERPOLATION IN THE X DIRECTION
DO 40 J=1,M
DO 41 I=1,N
UI(I)=U(I,J)
VI(I)=V(I,J)
WI(I)=W(I,J)
GI(I)=G(I,J)
PI(I)=P(I,J)
41 CONTINUE
DO 42 I=1,NN
XI=X2(I)
CALL CZ(N,XI,X1,UI,UOUT)
CALL CZ(N,XI,X1,VI,VOUT)
CALL CZ(N,XI,X1,WI,WOUT)
CALL CZ(N,XI,X1,GI,GOUT)
CALL CZ(N,XI,X1,PI,POUT)
UT(I,J)=UOUT
VT(I,J)=VOUT
WT(I,J)=WOUT
GT(I,J)=GOUT
PT(I,J)=POUT
42 CONTINUE
40 CONTINUE
! INTERPOLATION IN THE Y DIRECTION
DO 50 I=1,NN
DO 51 J=1,M
UJ(J)=UT(I,J)
VJ(J)=VT(I,J)
WJ(J)=WT(I,J)
GJ(J)=GT(I,J)
PJ(J)=PT(I,J)
51 CONTINUE
DO 52 J=1,MM
YJ=Y2(J)
CALL CZ(M,YJ,Y1,UJ,UOUT)
CALL CZ(M,YJ,Y1,VJ,VOUT)
CALL CZ(M,YJ,Y1,WJ,WOUT)
CALL CZ(M,YJ,Y1,GJ,GOUT)
CALL CZ(M,YJ,Y1,PJ,POUT)
UT(I,J)=UOUT
VT(I,J)=VOUT
WT(I,J)=WOUT
GT(I,J)=GOUT
PT(I,J)=POUT
52 CONTINUE
50 CONTINUE
! OUTPUT DATA FOR CONTOUR PLOTTING BY TECPLOT
OPEN(7,FILE='NSTO.DAT')
WRITE(7,*) 'TITLE= '
WRITE(7,*) 'VARIABLES= X,Y,U,V,T,P,W'
WRITE(7,*) 'ZONE I=',NN, ' J=',MM, ' F=POINT'
DO 850 J=1,MM
DO 850 I=1,NN
WRITE(7,950) X2(I),Y2(J),UT(I,J),VT(I,J),GT(I,J),PT(I,J),WT(I,J)
850 CONTINUE
950 FORMAT(F7.4,1X,F7.4,1X,E11.5,2X,E11.5,2X,E11.5,2X,E11.5,2X,E11.5)
CLOSE(7)
RETURN
END

Related

How to increase eqsteps without getting that much fluctuation in a 1D Ising model code?

I have written a Fortran 90 code of 1-D Ising model for 100 lattice sites. I have calculated magnetization, energy, susceptibility and specific heat and plotted using gnuplot. I am getting almost expected results in E~t and m~t plots but I am unsure if c~t and sus~t plots are correct or not.
Also I have taken 100000 eqsteps for equilibrium. If i reduce the eqsteps to 100 or 200, I am getting too much fluctuation. Please help me how can I get result with smaller eqsteps.
program ising1d
implicit none
integer,allocatable,dimension(:)::lattice
real,allocatable,dimension(:)::mag
integer,dimension(100000)::seed=12345678
integer::i,row,d,p,eqsteps
integer::mcs,w
real::j,t,rval1,rval2,average_m
real::y,dE,sum_m,sum_E,average_E,E
real::sum_m2,sum_E2,average_m2,average_E2,c,sus
real,dimension(20000)::mm,EE
j=1.0
t=0.01
d=100
allocate(lattice(d))
open (unit = 9, file = "ss.txt", action = "write", status = "replace")
do while (t <= 10)
sum_E=0
sum_m=0
sum_m2=0
average_m2=0
w=1
do mcs=1,200
do row=1,d
call random_number(rval1)
if (rval1 .ge. 0.5)then
lattice(row)=1.0
else
lattice(row)=-1.0
end if
end do
! This loop is for taking measurements
! This loop is for getting equilibrium
do eqsteps=1,100000
! print*,lattice
! choosing an random site to flip
call random_number(y)
p=1+floor(y*d)
! print*,"the flipping site is :",p
! boundary condition
if(p==d) then
lattice(p+1)=lattice(1)
else if (p==1)then
lattice(p-1)=lattice(d)
else
lattice(p)=lattice(p)
end if
! energy change
dE=2*(lattice(p))*(lattice(p-1)+lattice(p+1))
! print*,"the change of energy is :",dE
! metropolis part
if (dE .le. 0) then
lattice(p)=-lattice(p)
! print*, "flipped"
else if (dE .gt. 0) then
call random_number(rval2)
if (rval2 .lt. exp(-1.0*dE/t)) then
lattice(p)=-lattice(p)
! print*, "flipped"
else
lattice(p)=lattice(p)
! print*, " not flipped"
end if
else
lattice(p)=lattice(p)
end if
end do
mm(w)=abs(sum(lattice))
sum_m = sum_m + mm(w)
sum_m2=sum_m2 + mm(w)*mm(w)
call calc_energy(d,row,E)
EE(w)=E
sum_E=sum_E+EE(w)
sum_E2=sum_E2+EE(w)*EE(w)
w=w+1
end do
average_m=sum_m/(w*d)
average_E=sum_E/(w*d)
average_m2=sum_m2/(w*w*d*d)
average_E2=sum_E2/(w*w*d*d)
c=(average_E2-average_E*average_E)/(t*t)
sus=(average_m2-average_m*average_m)/t
write(9,*) t,average_m,average_E,c,sus
print*,t,average_m,average_E,c,sus
t = t + 0.01
end do
close(9)
contains
!energy calculation
subroutine calc_energy(d,row,E)
integer,intent(in)::d,row
real, intent(out)::E
integer::k
real::E00=0
do k=2,d-1
E00=E00+lattice(k)*(lattice(k-1)+lattice(k+1))
end do
E=-0.5*(E00+lattice(1)*(lattice(2)+lattice(d))+lattice(d)*(lattice(d-1)+lattice(1)))
E00=0
end subroutine calc_energy
end program ising1d
I am expecting to get result with smaller eqstep size.

Program that decodes a message in Fortran

How can I take a text file that first lists a 2x2 matrix that was used to encrypt a message, followed by one integer per line (total 32 lines) that encode a message? Basically, I want to create a program that will:
1) Read and invert the 2x2 encryption matrix
2) Write a subroutine for determinant function to help invert matrix
3) Decrypt by reading in two integers at a time and inserting them into a character string (chracter*32 = full string)
And finally, print the hidden message.
I am pretty new to Fortran (and programming in general) but here is what I have so far and would appreciate any help.
program Program2
implicit none
INTEGER, DIMENSION(2,2) :: M, M2, M3
INTEGER :: B(32)
INTEGER :: row,col,max_rows,max_cols, Det, i, n, a
max_rows = 2
max_cols = 2
open(11, file = 'Data3.txt')
DO row = 1,max_rows
READ(11,*) (M(row,col),col=1,max_cols)
END DO
!Finding the inverse of a 2x2 matrix and reassigning.
M2(1,1) = M(2,2)
M2(2,2) = M(1,1)
M2(1,2) = -M(1,2)
M2(2,1) = -M(2,1)
! Could not get determinant function to yield correct answer (calc by hand)
M3 = M2/-1
print*, M3
print*, Det
open(11, file = 'Data3.txt')
i = a
do i = 1, 16
read(11,*) n
print*, n
enddo
close(11)
end program Program2
! Determinant function for a 2x2 matrix
function Determinant(M2) result(Det)
implicit none
INTEGER, DIMENSION(2,2) :: M, M2, M3
INTEGER :: B(32)
INTEGER :: row,col,max_rows,max_cols, Det, i, n, a
Det = M2(1,1)*M2(2,2) - M2(1,2)*M2(2,1)
end function Determinant
Here is the text file (or just a copy of what it looks like):
3 11
2 7
1488
955
703
458
1379
887
1465
943
1196
764
1392
895
1433
922
1403
902
1372
876
1467
943
697
454
1518
975
1596
1026
1392
895
1536
988
726
473

First of all, to get your Determinant function working, it needs a type (see Function has no implicit type):
INTEGER :: Determinant
Edit:
No need to be referenced as external, as pointed out in the comments. Thanks.
Then it can be used and it works well:
Det = Determinant(M2)
print*, Det
prints -1.
Second, could you please provide more explanation about what you want to do in step 3) so that we can help you out.
3) Decrypt by reading in two integers at a time and inserting them into a character string (chracter*32 = full string)

Implicit none makes program inaccurate

I am writing a program that uses a given subroutine to calculate spherical Bessel functions. I modified the subroutine which gives a table into a function which only gives one value. However, I realized that when I call my function I need to have IMPLICIT DOUBLE PRECISION (A-H,O-Z) in my program or it will give me a wrong value or error. Below I have included a sample program that works correctly.
! n = 3, x = 2 should return ~ 6.07E-2
program hello
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
doubleprecision :: bessel, ans
WRITE(*,*)'Please enter n and x '
READ(*,*)N,X
ans = bessel(N,X)
print *, ans
end program
SUBROUTINE SPHJ(N,X,NM,SJ,DJ)
! =======================================================
! Purpose: Compute spherical Bessel functions jn(x) and
! their derivatives
! Input : x --- Argument of jn(x)
! n --- Order of jn(x) ( n = 0,1,??? )
! Output: SJ(n) --- jn(x)
! DJ(n) --- jn'(x)
! NM --- Highest order computed
! Routines called:
! MSTA1 and MSTA2 for computing the starting
! point for backward recurrence
! =======================================================
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
DIMENSION SJ(0:N),DJ(0:N)
NM=N
IF (DABS(X).EQ.1.0D-100) THEN
DO 10 K=0,N
SJ(K)=0.0D0
10 DJ(K)=0.0D0
SJ(0)=1.0D0
DJ(1)=.3333333333333333D0
RETURN
ENDIF
SJ(0)=DSIN(X)/X
SJ(1)=(SJ(0)-DCOS(X))/X
IF (N.GE.2) THEN
SA=SJ(0)
SB=SJ(1)
M=MSTA1(X,200)
IF (M.LT.N) THEN
NM=M
ELSE
M=MSTA2(X,N,15)
ENDIF
F0=0.0D0
F1=1.0D0-100
DO 15 K=M,0,-1
F=(2.0D0*K+3.0D0)*F1/X-F0
IF (K.LE.NM) SJ(K)=F
F0=F1
15 F1=F
IF (DABS(SA).GT.DABS(SB)) CS=SA/F
IF (DABS(SA).LE.DABS(SB)) CS=SB/F0
DO 20 K=0,NM
20 SJ(K)=CS*SJ(K)
ENDIF
DJ(0)=(DCOS(X)-DSIN(X)/X)/X
DO 25 K=1,NM
25 DJ(K)=SJ(K-1)-(K+1.0D0)*SJ(K)/X
RETURN
END
INTEGER FUNCTION MSTA1(X,MP)
! ===================================================
! Purpose: Determine the starting point for backward
! recurrence such that the magnitude of
! Jn(x) at that point is about 10^(-MP)
! Input : x --- Argument of Jn(x)
! MP --- Value of magnitude
! Output: MSTA1 --- Starting point
! ===================================================
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
A0=DABS(X)
N0=INT(1.1*A0)+1
F0=ENVJ(N0,A0)-MP
N1=N0+5
F1=ENVJ(N1,A0)-MP
DO 10 IT=1,20
NN=N1-(N1-N0)/(1.0D0-F0/F1)
F=ENVJ(NN,A0)-MP
IF(ABS(NN-N1).LT.1) GO TO 20
N0=N1
F0=F1
N1=NN
10 F1=F
20 MSTA1=NN
RETURN
END
INTEGER FUNCTION MSTA2(X,N,MP)
! ===================================================
! Purpose: Determine the starting point for backward
! recurrence such that all Jn(x) has MP
! significant digits
! Input : x --- Argument of Jn(x)
! n --- Order of Jn(x)
! MP --- Significant digit
! Output: MSTA2 --- Starting point
! ===================================================
IMPLICIT DOUBLE PRECISION (A-H,O-Z)
A0=DABS(X)
HMP=0.5D0*MP
EJN=ENVJ(N,A0)
IF (EJN.LE.HMP) THEN
OBJ=MP
N0=INT(1.1*A0)
ELSE
OBJ=HMP+EJN
N0=N
ENDIF
F0=ENVJ(N0,A0)-OBJ
N1=N0+5
F1=ENVJ(N1,A0)-OBJ
DO 10 IT=1,20
NN=N1-(N1-N0)/(1.0D0-F0/F1)
F=ENVJ(NN,A0)-OBJ
IF (ABS(NN-N1).LT.1) GO TO 20
N0=N1
F0=F1
N1=NN
10 F1=F
20 MSTA2=NN+10
RETURN
END
REAL*8 FUNCTION ENVJ(N,X)
DOUBLE PRECISION X
ENVJ=0.5D0*DLOG10(6.28D0*N)-N*DLOG10(1.36D0*X/N)
RETURN
END
!end of file msphj.f90
doubleprecision function bessel(N,X)
implicit doubleprecision(A-Z)
DIMENSION SJ(0:250),DJ(0:250)
integer :: N
CALL SPHJ(N,X,N,SJ,DJ)
bessel = SJ(N)
end function
And here is a sample program that does not work, using the same function.
program hello
IMPLICIT none
doubleprecision :: bessel, ans
integer :: N, X
WRITE(*,*)'Please enter n and x '
READ(*,*)N,X
ans = bessel(N,X)
print *, ans
end program
I am relatively new to Fortran and don't understand why my program doesn't work. I appreciate any help that anyone can provide.

I guess the non working sample program uses the same implementation of bessel as the working sample.
If so, there is a conflict of type between the the type of N and X (integer in the non working main program) and the corresponding arguments in bessel which are all double precision per the specification
implicit doubleprecision(A-Z)
Everything in bessel is by default doubleprecision. Your main program must define N and X as doubleprecision.
The best solution as I said in the comment above is to use explicit typing everywhere.

Data smoothing with robust local regression in fortran

I have very oscillated 1D velocity data. I wanted to do smooth and remove some outliers from my data. I have gone through internet to know how to do this and based on findings, I have done following code for my data.
program smoothing
parameter (ni=775)
real ulb(ni), copu(ni), ri(ni), temp(ni),wei(ni)
real med
open(131,file='copy.txt' )
open(130,file='u.txt' )
read(130,'(10000f10.4)') (ulb(i), i=1,ni)
copu=0.
ri=0.
do i=1,ni
copu(i)=ulb(i)
enddo
print*, copu(200)
write(131,'(10000f10.4)') ( copu(i),i=2,ni)
! first smoothing
do i=4,ni-4
copu(i)=(copu(i-3)+copu(i-2)+copu(i-1)+copu(i)+copu(i+1)
& +copu(i+2)+copu(i+3))/7.
if(i.eq.1.or.i.eq.ni) copu(i)=copu(i)
if(i.eq.2.or.i.eq.ni-1) copu(i)=(copu(i+1)+copu(i)+copu(i-1))/3.
if(i.eq.3.or.i.eq.ni-2) copu(i)=(copu(i+2)+copu(i+1)
& +copu(i)+copu(i-1)+copu(i-2))/5.
enddo
write(131,'(10000f10.4)') ( copu(i),i=2,ni)
do k=1,4 ! iteration
! calculating resudial
do i=1,ni
ri(i)=ulb(i)-copu(i)
enddo
print*, ri(200)
! finding median along resudials
do i=1,ni
temp(i)=copu(i)
enddo
call sort(ri,ni)
if(mod(ni,2).eq.0) then
med=((ri(ni/2))+ri(ni/(2+1)))/2.
else
med=ri(ni/(2+1))
endif
print*, k, med
! calculating robust weigths
do i=1,ni
if(abs(ri(i)).ge.6.*med) then
wei(i)=0.
else if(abs(ri(i)).lt.6.*med) then
wei(i)=(1.-(ri(i)/(6.*med))**2)**2
endif
copu(i)=copu(i)+wei(i)*copu(i)
enddo
enddo ! iteration
write(131,'(10000f10.4)') ( copu(i),i=2,ni)
close (131)
end program
! ---------------------------------------------
subroutine sort(ri,ni)
real ri(ni)
do i=1,ni-1
do j=1,ni-1
if(ri(j).gt.ri(j+1)) then
tempu=ri(j)
ri(j)=ri(j+1)
ri(j+1)=tempu
end if
end do
end do
return
end subroutine
I had used four times smoothing with polynomial simple smoothing as
"first smoothing". Because of spin length, some outliers does not fitted appropriately. So I decided to apply Robust local regression in my code. But it does not work so far. I followed document of Mathlab. Any correction/suggestion would be very appreciated.

Cannot call a function from the same scope

I'm confused about the scope. I downloaded a Fortran file which has 1 main program, 1 subroutine and 1 function in 1 source file. The main program does not contain the subprograms, and the function is called by the subroutine. It works fine, but when I modified the main program to contain those 2 subprograms using "contains", it gives compile error, saying the function is not defined. However, if I create a small function within the same contained section and call from the subroutine, it does not give an error.
What is the difference between those 2 functions? Why do I get the error?
I created a small program with the same structure, 1 main that contains a subroutine and a func and it did not give an error.
My environment is ubuntu 14.04 and using gfortran compiler.
Building target: QRbasic
Invoking: GNU Fortran Linker
gfortran -o "QRbasic" ./main.o
./main.o: In function qrbasic':
/*/QRbasic/Debug/../main.f95:79: undefined reference toajnorm_'
/home/kenji/workspace/QRbasic/Debug/../main.f95:104: undefined reference to `ajnorm_'
collect2: error: ld returned 1 exit status
make: *** [QRbasic] Error 1
Program Main
!====================================================================
! QR basic method to find the eigenvalues
! of matrix A
!====================================================================
implicit none
integer, parameter :: n=3
double precision, parameter:: eps=1.0e-07
double precision :: a(n,n), e(n)
integer i, j, iter
! matrix A
! data (a(1,i), i=1,3) / 8.0, -2.0, -2.0 /
! data (a(2,i), i=1,3) / -2.0, 4.0, -2.0 /
! data (a(3,i), i=1,3) / -2.0, -2.0, 13.0 /
data (a(1,i), i=1,3) / 1.0, 2.0, 3.0 /
data (a(2,i), i=1,3) / 2.0, 2.0, -2.0 /
data (a(3,i), i=1,3) / 3.0, -2.0, 4.0 /
! print a header and the original matrix
write (*,200)
do i=1,n
write (*,201) (a(i,j),j=1,n)
end do
! print: guess vector x(i)
! write (*,204)
! write (*,201) (y(i),i=1,3)
call QRbasic(a,e,eps,n,iter)
! print solutions
write (*,202)
write (*,201) (e(i),i=1,n)
write (*,205) iter
200 format (' QR basic method - eigenvalues for A(n,n)',/, &
' Matrix A')
201 format (6f12.6)
202 format (/,' The eigenvalues')
205 format (/,' iterations = ',i5)
!end program main
contains
subroutine QRbasic(a,e,eps,n,iter)
!==============================================================
! Compute all eigenvalues: real symmetric matrix a(n,n,)
! a*x = lambda*x
! method: the basic QR method
! Alex G. (January 2010)
!--------------------------------------------------------------
! input ...
! a(n,n) - array of coefficients for matrix A
! n - dimension
! eps - convergence tolerance
! output ...
! e(n) - eigenvalues
! iter - number of iterations to achieve the tolerance
! comments ...
! kmax - max number of allowed iterations
!==============================================================
implicit none
integer n, iter
double precision a(n,n), e(n), eps
double precision q(n,n), r(n,n), w(n), an, Ajnorm, sum, e0,e1
integer k, i, j, m
integer, parameter::kmax=1000
! initialization
q = 0.0
r = 0.0
e0 = 0.0
do k=1,kmax ! iterations
! step 1: compute Q(n,n) and R(n,n)
! column 1
an = Ajnorm(a,n,1)
r(1,1) = an
do i=1,n
q(i,1) = a(i,1)/an
end do
! columns 2,...,n
do j=2,n
w = 0.0
do m=1,j-1
! product q^T*a result = scalar
sum = 0.0
do i=1,n
sum = sum + q(i,m)*a(i,j)
end do
r(m,j) = sum
! product (q^T*a)*q result = vector w(n)
do i=1,n
w(i) = w(i) + sum*q(i,m)
end do
end do
! new a'(j)
do i =1,n
a(i,j) = a(i,j) - w(i)
end do
! evaluate the norm for a'(j)
an = Ajnorm(a,n,j)
r(j,j) = an
! vector q(j)
do i=1,n
q(i,j) = a(i,j)/an
end do
end do
! step 2: compute A=R(n,n)*Q(n,n)
a = matmul(r,q)
! egenvalues and the average eigenvale
sum = 0.0
do i=1,n
e(i) = a(i,i)
sum = sum+e(i)*e(i)
end do
e1 = sqrt(sum)
! print here eigenvalues
! write (*,201) (e(i),i=1,n)
!201 format (6f12.6)
! check for convergence
if (abs(e1-e0) < eps) exit
! prepare for the next iteration
e0 = e1
end do
iter = k
if(k == kmax) write (*,*)'The eigenvlue failed to converge'
print *, func1()
end subroutine QRbasic
function Ajnorm(a,n,j)
implicit none
integer n, j, i
double precision a(n,n), Ajnorm
double precision sum
sum = 0.0
do i=1,n
sum = sum + a(i,j)*a(i,j)
end do
Ajnorm = sqrt(sum)
end function Ajnorm
integer function func1()
print *, "dummy"
func1=1
end function
end program
The original program did not contain those 2 programs. This is the version I get an error.

Your main program contains a declaration of the type of function Ajnorm(). As a result, when the compiler finds that name to be used as a function name, it interprets it as an external function. That's quite correct in the original form of the program, with the function defined as an independent unit, but it is wrong for an internal (contained) function. Your program compiles cleanly for me once I remove the unneeded declaration.