0% found this document useful (0 votes)
46 views7 pages

Direct Data Put

This program solves two-dimensional potential problems using linear boundary elements with direct hardcoded data input. It includes subroutines to input the data, generate the G and H matrices, solve the system of equations, interpolate values at internal points, and output the results. The key steps are generating the system matrices from the boundary element definitions, solving the system of equations to determine the potential values along the boundaries, and interpolating the potential at internal points.

Uploaded by

gjsfwhjdsncv
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
0% found this document useful (0 votes)
46 views7 pages

Direct Data Put

This program solves two-dimensional potential problems using linear boundary elements with direct hardcoded data input. It includes subroutines to input the data, generate the G and H matrices, solve the system of equations, interpolate values at internal points, and output the results. The key steps are generating the system matrices from the boundary element definitions, solving the system of equations to determine the potential values along the boundaries, and interpolating the potential at internal points.

Uploaded by

gjsfwhjdsncv
Copyright
© © All Rights Reserved
We take content rights seriously. If you suspect this is your content, claim it here.
Available Formats
Download as TXT, PDF, TXT or read online on Scribd
You are on page 1/ 7

C------------------------------------------------------------------------------

C
PROGRAM POLINBE

C
C THIS PROGRAM SOLVES TWO DIMENSIONAL (PO)TENTIAL PROBLEMS
C USING (LIN)EAR (B)OUNDARY (E)LEMENTS WITH DIRECT DATA INPUT
C
COMMON/MATG/ G(80,160)
COMMON/MATH/ H(80,80)
COMMON N,L
DIMENSION X(81),Y(81),FI(80),DFI(160)
DIMENSION KODE(160),CX(20),CY(20),SOL(20)

C MAXIMUM DIMENSION OF THE SYSTEM OF EQUATIONS


NX=80
NX1=2*NX

C DIRECTLY CALL SUBROUTINES WITH HARDCODED DATA


CALL INPUTPL(CX,CY,X,Y,KODE,DFI)
CALL GHMATPL(X,Y,G,H,FI,DFI,KODE,NX,NX1)
CALL SLNPD(H,FI,D,N,NX)
CALL INTERPL(FI,DFI,KODE,CX,CY,X,Y,SOL)
CALL OUTPTPL(X,Y,FI,DFI,CX,CY,SOL)

STOP
END
C------------------------------------------------------------------------
SUBROUTINE INPUTPL(CX,CY,X,Y,KODE,DFI)
C
C PROGRAM 10
C
C N= NUMBER OF BOUNDARY ELEMENTS
C L= NUMBER OF INTERNAL POINTS
C
CHARACTER*80 TITLE
COMMON N,L,INP,IPR
DIMENSION CX(20),CY(20),X(81),Y(81),KODE(160),DFI(160)
WRITE(IPR,100)
100 FORMAT(' ',79('*'))
C
C SET TITLE AND DATA DIRECTLY
C
TITLE = 'HEAT FLOW EXAMPLE (12 LINEAR ELEMENTS)'
WRITE(IPR,'(A)') TITLE

C SET NUMBER OF ELEMENTS AND INTERNAL POINTS


N=12
L=5
WRITE(IPR,300)N,L
300 FORMAT(//' DATA'//2X,'NUMBER OF BOUNDARY ELEMENTS =',I3/2X,
1 'NUMBER OF INTERNAL POINTS WHERE THE FUNCTION IS CALCULATED =',I3)

C SET BOUNDARY NODES COORDINATES IN ARRAYS X AND Y


DATA X /0., 2., 4., 6., 6., 6., 6., 4., 2., 0., 0., 0., 0./
DATA Y /0., 0., 0., 0., 2., 4., 6., 6., 6., 6., 4., 2., 0./

C SET BOUNDARY CONDITIONS IN DFI VECTOR AND KODE


DATA KODE /1, 1, 1, 1, 1, 1, 0, 0, 0, 1, 1, 1, 0, 0, 0, 1, 1, 1, 0, 0, 0, 1, 1,
1/
DATA DFI /0., 0., 0., 0., 0., 0., 300., 300., 300., 0., 0., 0., 300., 300.,
300., 0., 0., 0., 300., 300., 300., 0., 0., 0./

C SET COORDINATES OF THE INTERNAL POINTS


DATA CX /2., 2., 2., 4., 3./
DATA CY /2., 4., 3., 2., 4./

RETURN
END

C------------------------------------------------------------------------
SUBROUTINE GHMATPL(X,Y,G,H,FI,DFI,KODE,NX,NX1)
C
C PROGRAM 11
C
C THIS SUBROUTINE COMPUTES THE G AND H MATRICES
C AND FORMS THE SYSTEM OF EQUATIONS A X = F
C H IS A SQUARE MATRIX (N,N); G IS RECTANGULAR (N,2*N)
C
COMMON N,L,INP,IPR
DIMENSION X(81),Y(81),G(NX,NX1),H(NX,NX),FI(80),KODE(160),DFI(160)
NN=2*N
DO 10 I=1,N
DO 6 J=1,N
6 H(I,J)=0.
DO 10 J=1,NN
10 G(I,J)=0.
C
C COMPUTE THE COEFFICIENTS OF G AND H MATRICES
C
X(N+1)=X(1)
Y(N+1)=Y(1)
DO 100 I=1,N
NF=I+1
NS=I+N-2
DO 50 JJ=NF,NS
IF(JJ-N)30,30,20
20 J=JJ-N
GO TO 40
30 J=JJ
40 CALL EXTINPL(X(I),Y(I),X(J),Y(J),X(J+1),Y(J+1),A1,A2,B1,B2)
IF(J-N)42,43,43
42 H(I,J+1)=H(I,J+1)+A2
GO TO 44
43 H(I,1)=H(I,1)+A2
44 H(I,J)=H(I,J)+A1
G(I,2*J-1)=B1
G(I,2*J)=B2
50 H(I,I)=H(I,I)-A1-A2
NF=I+N-1
NS=I+N
DO 95 JJ=NF,NS
IF(JJ-N)70,70,60
60 J=JJ-N
GO TO 80
70 J=JJ
80 CALL LOCINPL(X(J),Y(J),X(J+1),Y(J+1),B1,B2)
IF(JJ-NF)82,82,83
82 CH=B1
B1=B2
B2=CH
83 G(I,2*J-1)=B1
95 G(I,2*J)=B2
C
C ADD ONE TO THE DIAGONAL COEFFICIENTS
C FOR EXTERNAL PROBLEMS.
C
IF(H(I,I)) 98,100,100
98 H(I,I)=1.+H(I,I)
100 CONTINUE
C
C REORDER THE COLUMNS OF THE SYSTEM OF EQUATIONS IN ACCORDANCE
C WITH THE BOUNDARY CONDITIONS AND FORM THE SYSTEM MATRIX A
C WHICH IS STORED IN H
C
DO 155 I=1,N
DO 150 J=1,2
IF(KODE(2*I-2+J))110,110,150
110 IF(I.NE.N .OR. J.NE.2) GO TO 125
IF(KODE(1)) 115,115,113
113 DO 114 K=1,N
CH=H(K,1)
H(K,1)=-G(K,2*N)
114 G(K,2*N)=-CH
GO TO 150
115 DO 116 K=1,N
H(K,1)=H(K,1)-G(K,2*N)
116 G(K,2*N)=0.
GO TO 150
125 IF(I.EQ.1 .OR. J.GT.1 .OR. KODE(2*I-2).EQ.1) GO TO 130
DO 129 K=1,N
H(K,I)=H(K,I)-G(K,2*I-1)
129 G(K,2*I-1)=0.
GO TO 150
130 DO 132 K=1,N
CH=H(K,I-1+J)
H(K,I-1+J)=-G(K,2*I-2+J)
132 G(K,2*I-2+J)=-CH
150 CONTINUE
155 CONTINUE
C
C FORM THE RIGHT HAND SIDE VECTOR F WHICH IS STORED IN FI
C
DO 160 I=1,N
FI(I)=0.
DO 160 J=1,NN
FI(I)=FI(I)+G(I,J)*DFI(J)
160 CONTINUE
RETURN
END
C------------------------------------------------------------------------
SUBROUTINE EXTINPL(XP,YP,X1,Y1,X2,Y2,A1,A2,B1,B2)
C
C PROGRAM 12
C
C THIS SUBROUTINE COMPUTES THE G AND H COEFFITIENTS
C THAT RELATE A NODE (XP,YP) WITH A BOUNDARY ELEMENT
C USING GAUSS QUADRATURE
C
C DIST=DISTANCE FROM THE COLOCATION POINT TO THE
C LINE TANGENT TO THE ELEMENT.
C RA=DISTANCE FROM THE COLOCATION POINT TO THE
C GAUSS INTEGRATION POINTS ON THE BOUNDARY ELEMENTS
C
DIMENSION XCO(4),YCO(4),GI(4),OME(4)
DATA GI/0.86113631,-0.86113631,0.33998104,-0.33998104/
DATA OME/0.34785485,0.34785485,0.65214515,0.65214515/
C
AX=(X2-X1)/2
BX=(X2+X1)/2
AY=(Y2-Y1)/2
BY=(Y2+Y1)/2
C
C COMPUTE THE DISTANCE FROM THE POINT TO THE LINE OF THE ELEMENT
C
IF(AX)10,20,10
10 TA=AY/AX
DIST=ABS((TA*XP-YP+Y1-TA*X1)/SQRT(TA**2+1))
GO TO 30
20 DIST=ABS(XP-X1)
C
C DETERMINE THE DIRECTION OF THE OUTWARD NORMAL
C
30 SIG=(X1-XP)*(Y2-YP)-(X2-XP)*(Y1-YP)
IF(SIG)31,32,32
31 DIST=-DIST
32 A1=0.
A2=0.
B1=0.
B2=0.
C
C COMPUTE THE TERMS TO BE ADDED TO THE G AND H COEFFITIENTS
C
DO 40 I=1,4
XCO(I)=AX*GI(I)+BX
YCO(I)=AY*GI(I)+BY
RA=SQRT((XP-XCO(I))**2+(YP-YCO(I))**2)
H=DIST*OME(I)*SQRT(AX**2+AY**2)/RA**2
G=ALOG(1/RA)*OME(I)*SQRT(AX**2+AY**2)
A1=A1+(GI(I)-1)*H/2
A2=A2-(GI(I)+1)*H/2
B1=B1-(GI(I)-1)*G/2
40 B2=B2+(GI(I)+1)*G/2
RETURN
END
C------------------------------------------------------------------------
SUBROUTINE LOCINPL(X1,Y1,X2,Y2,B1,B2)
C
C PROGRAM 13
C
C THIS SUBROUTINE COMPUTES THE PARTS OF THE G MATRIX
C COEFFICIENTS CORRESPONDING TO INTEGRALS ALONG AN ELEMENT
C THAT INCLUDES THE COLLOCATION POINT.
C
SEP=SQRT((X2-X1)**2+(Y2-Y1)**2)
B1=SEP*(1.5-ALOG(SEP))/2
B2=SEP*(0.5-ALOG(SEP))/2
RETURN
END
C------------------------------------------------------------------------
SUBROUTINE SLNPD(A,B,D,N,NX)
C
C PROGRAM 6
C
C SOLUTION OF LINEAR SYSTEMS OF EQUATIONS
C BY THE GAUSS ELIMINATION METHOD PROVIDING
C FOR INTERCHANGING ROWS WHEN ENCOUNTERING A
C ZERO DIAGONAL COEFICIENT
C
C A : SYSTEM MATRIX
C B : ORIGINALLY IT CONTAINS THE INDEPENDENT
C COEFFICIENTS. AFTER SOLUTION IT CONTAINS
C THE VALUES OF THE SYSTEM UNKNOWNS.
C
C N : ACTUAL NUMBER OF UNKNOWNS
C NX: ROW AND COLUMN DIMENSION OF A
C
COMMON NMUDO,LMUDO,INP,IPR
DIMENSION A(NX,NX),B(NX)
C
TOL=1.E-6
C
N1=N-1
DO 100 K=1,N1
K1=K+1
C=A(K,K)
IF(ABS(C)-TOL)1,1,3
1 DO 7 J=K1,N
C
C TRY TO INTERCHANGE ROWS TO GET NON ZERO DIAGONAL COEFFICIENT
C
IF(ABS(A(J,K)-TOL))7,7,5
5 DO 6 L=K,N
C=A(K,L)
A(K,L)=A(J,L)
6 A(J,L)=C
C=B(K)
B(K)=B(J)
B(J)=C
C=A(K,K)
GO TO 3
7 CONTINUE
C
C DIVIDE ROW BY DIAGONAL COEFFICIENT
C
3 C=A(K,K)
DO 4 J=K1,N
4 A(K,J)=A(K,J)/C
B(K)=B(K)/C
C
C ELIMINATE UNKNOWN X(K) FROM ROW I
C
DO 10 I=K1,N
C=A(I,K)
DO 9 J=K1,N
9 A(I,J)=A(I,J)-C*A(K,J)
10 B(I)=B(I)-C*B(K)
100 CONTINUE
C
C COMPUTE LAST UNKNOWN
C
IF(ABS(A(N,N))-TOL)8,8,101
101 B(N)=B(N)/A(N,N)
C
C APPLY BACKSUBSTITUTION PROCESS TO COMPUTE REMAINING UNKNOWNS
C
DO 200 L=1,N1
K=N-L
K1=K+1
DO 200 J=K1,N
200 B(K)=B(K)-A(K,J)*B(J)
C
C COMPUTE VALUE OF DETERMINANT
C
D=1.
DO 250 I=1,N
250 D=D*A(I,I)
GO TO 300
8 WRITE(IPR,2) K
2 FORMAT(' **** SINGULARITY IN ROW',I5)
D=0.
300 RETURN
END
C------------------------------------------------------------------------
SUBROUTINE INTERPL(FI,DFI,KODE,CX,CY,X,Y,SOL)
C
C PROGRAM 14
C
C THIS SUBROUTINE COMPUTES THE VALUES OF POTENTIAL AT
C INTERNAL POINTS
C
COMMON N,L,INP,IPR
DIMENSION FI(80),DFI(160),KODE(160),CX(20),CY(20),X(81),Y(81)
DIMENSION SOL(20)
C
C REARRANGE THE FI AND DFI ARRAYS TO STORE ALL THE VALUES OF THE
C POTENTIAL IN FI AND ALL THE VALUES OF THE DERIVATIVE IN DFI
C
DO 155 I=1,N
DO 150 J=1,2
IF(KODE(2*I-2+J))110,110,150
110 IF(I.NE.N .OR. J.NE.2) GO TO 125
IF(KODE(1)) 114,114,113
113 CH=FI(1)
FI(1)=DFI(2*N)
DFI(2*N)=CH
GO TO 150
114 DFI(2*N)=DFI(1)
GO TO 150
125 IF(I.EQ.1 .OR. J.EQ.2 .OR. KODE(2*I-2).EQ.1) GO TO 130
DFI(2*I-1)=DFI(2*I-2)
GO TO 150
130 CH=FI(I-1+J)
FI(I-1+J)=DFI(2*I-2+J)
DFI(2*I-2+J)=CH
150 CONTINUE
155 CONTINUE
C
C COMPUTE THE VALUES OF POTENTIAL AT INTERNAL POINTS
C
IF(L.EQ.0) GO TO 50
DO 40 K=1,L
SOL(K)=0.
DO 30 J=1,N
CALL EXTINPL(CX(K),CY(K),X(J),Y(J),X(J+1),Y(J+1),A1,A2,B1,B2)
IF(J-N)32,33,33
32 SOL(K)=SOL(K)+DFI(2*J-1)*B1+DFI(2*J)*B2-FI(J)*A1-FI(J+1)*A2
GO TO 30
33 SOL(K)=SOL(K)+DFI(2*J-1)*B1+DFI(2*J)*B2-FI(J)*A1-FI(1)*A2
30 CONTINUE
40 SOL(K)=SOL(K)/(2*3.1415926)
50 RETURN
END
C------------------------------------------------------------------------
SUBROUTINE OUTPTPL(X,Y,FI,DFI,CX,CY,SOL)
C
C PROGRAM 15
C
C THIS SUROUTINE PRINTS THE VALUES OF THE POTENTIAL AND ITS
C NORMAL DERIVATIVE AT BOUNDARY NODES. IT ALSO PRINTS THE
C VALUES OF THE POTENTIAL AT INTERNAL POINTS.
C
COMMON N,L,INP,IPR
DIMENSION X(81),Y(81),FI(80),DFI(160),CX(20),CY(20),SOL(20)
C
WRITE(IPR,100)
100 FORMAT(' ',79('*')//2X,'RESULTS'//2X,'BOUNDARY NODES'//
156X,'POTENTIAL DERIVATIVE'/
29X,'X',15X,'Y',12X,'POTENTIAL',6X,'BEFORE NODE',6X,'AFTER NODE'/)
WRITE(IPR,200) X(1),Y(1),FI(1),DFI(2*N),DFI(1)
DO 10 I=2,N
10 WRITE(IPR,200) X(I),Y(I),FI(I),DFI(2*I-2),DFI(2*I-1)
200 FORMAT(5(2X,E14.5))
C
IF(L.EQ.0) GO TO 30
WRITE(IPR,300)
300 FORMAT(//,2X,'INTERNAL POINTS',//9X,'X',15X,'Y',12X,'POTENTIAL',/)
DO 20 K=1,L
20 WRITE(IPR,400)CX(K),CY(K),SOL(K)
400 FORMAT(3(2X,E14.5))
30 WRITE(IPR,500)
500 FORMAT(' ',79('*'))
RETURN
END
C-----------------------------------------------------------------------

You might also like