PROGRAM WRM1X1H C======================================================================= C SOLUTION OF D2U/DXDX + ALPHA*U = 0 USING WEIGHTED RESIDUAL METHOD C WITH AN APPROXIMATING FUNCTION OF U(X)=F0(X)+A1*F1(X) C AND BOUNDARY CONDITIONS OF U(0)=0. & U(1)=1; C -------------- VARIABLE DEFNITION ----------- June/1993 EIJI FUKUMORI C XST & XEN: INTEGRATION LIMITS; NSEG: NUMBER OF SEGMENTS IN LIMITS; C UNKNOWN COEFFICENT (A1) IN THE APPROXIMATING FUNCTION IS EVALUATED C BY THE FOLLOWING EQUATION: B1 * A1 + C1 = 0. C======================================================================= IMPLICIT REAL * 8 ( A-H , O-Z ) PARAMETER ( N = 3, NSEG=100, MULTI=10 ) DIMENSION SAI(N) , W(N) COMMON / DEL / DELTAX /DOMAIN/ RL /BORDER/ U0, UL EXTERNAL F0, F1, H1 C======================================================================= C THREE-SAMPLING-POINT GAUSS INTEGRATION METHOD C N: NUMBER OF SAMPLING POINTS IN EACH SEGMENET C SAI(I) & W(I): NON-DIMENSIONALIZED COORDINATE & WEIGHTING FACTOR DATA SAI/-0.7745966692415D0,0.0000000000000D0, 0.7745966692415D0/ DATA W / 0.5555555555555D0,0.8888888888888D0, 0.5555555555555D0/ C======================================================================= C MATERIAL DATA AND BOUNDARY VALUES ALPHA=1. XST=0. XEN=1. U0 = 0. UL = 1. C======================================================================= OPEN ( 1, FILE='WRM1X1H.FEM',STATUS='UNKNOWN' ) WRITE(1,*)' ==== DIRICHLET - DIRICHLET PROBLEM ====' WRITE(1,*)' ---- NON-GALERKIN WEIGHTING FUNCTION----' WRITE(1,*)' APPROXIMATING FUNCTION: F0(X) + A1*F1(X)' WRITE(1,*)' WHERE F0(X) = X/L AND F1(X) = (X/L)*(1-X/L)' WRITE(1,*)' WEIGHTING FUNCTION H(X)=(X/L)*(1-(X/L)**2)' C======================================================================= C DELTAX: SPACIAL DEFERENTIAL LENGTH FOR DERIVATIVE EVALUATION. RL = XEN - XST DELTAX = RL / ( MULTI * NSEG ) C======================================================================= C COMPUTATION OF H(F0,F1) AND H(F1,F1) CALL INTE ( ALPHA, XST, XEN, NSEG, N, SAI, W, F0, H1, C1 ) CALL INTE ( ALPHA, XST, XEN, NSEG, N, SAI, W, F1, H1, B1 ) C======================================================================= C EVALUATION OF UNKNOWN A1 IN THE APPROXIMATING FUNCTION U(X) A1 = - C1 / B1 C======================================================================= C PRINTING RESULTS WRITE (1,100) B1, C1 WRITE (1,110) A1 100 FORMAT ( 1X, F20.10, 1X, '* A1 +', F20.10, ' = 0' ) 110 FORMAT ( 2X, 'U(X) = F0(X) + ',F15.10, ' * F1(X)' ) CALL OUTPUT ( XST, XEN, A1 ) CLOSE (1) STOP END C C SUBROUTINE INTE ( ALPHA,XST,XEN,NSEG, N,SAI,W, G1,G2, TOTAL ) IMPLICIT REAL * 8 ( A-H , O-Z ) DIMENSION SAI(N) , W(N) EXTERNAL G1, G2 TOTAL = 0. DX = ( XEN - XST ) / NSEG DO I = 1 , NSEG X1 = DX*(I-1) + XST X2 = X1 + DX SUM = 0. SH = ( X2 - X1 ) / 2. XM = ( X1 + X2 ) / 2. DO J = 1 , N X = SH * SAI(J) + XM SUM = SUM + F(G1,G2,ALPHA,X) * W(J) END DO TOTAL = TOTAL + SH * SUM END DO RETURN END C C FUNCTION F(G1,G2,ALPHA,X) IMPLICIT REAL * 8 ( A-H , O-Z ) EXTERNAL G1, G2 F = -DERIV(G1,X)*DERIV(G2,X) + ALPHA*G1(X)*G2(X) RETURN END C C FUNCTION F0(X) IMPLICIT REAL * 8 ( A-H , O-Z ) COMMON /DOMAIN/ RL COMMON /BORDER/ U0, UL F0 = U0*(1.-X/RL) + UL*(X/RL) RETURN END C C FUNCTION F1(X) IMPLICIT REAL * 8 ( A-H , O-Z ) COMMON /DOMAIN/ RL F1 = (X/RL) * ( 1. - X/RL ) RETURN END C C FUNCTION H1(X) IMPLICIT REAL * 8 ( A-H , O-Z ) COMMON /DOMAIN/ RL H1 = (X/RL) * ( 1. - (X/RL)**2 ) RETURN END C C FUNCTION DERIV(Y,X) IMPLICIT REAL * 8 ( A-H , O-Z ) COMMON / DEL / DELTAX EXTERNAL Y DERIV = ( Y(X+DELTAX) - Y(X-DELTAX) ) / ( 2.*DELTAX ) RETURN END C C SUBROUTINE OUTPUT ( XST,XEN,A1 ) IMPLICIT REAL * 8 ( A-H , O-Z ) EXTERNAL F0, F1 NDIV = 10 DX = ( XEN - XST ) / NDIV DO I = 1 , NDIV+1 X = DX*(I-1) + XST UX = F0(X) + A1*F1(X) DUDX = DERIV(F0,X)+A1*DERIV(F1,X) WRITE(1,100)X, UX, DUDX 100 FORMAT ( 'X=',G15.7,' U(X)=',G15.7,' DU/DX=',G15.7 ) END DO RETURN END