C E X A M P L E 2
C
C Program name:
CHARACTER*9 MYNAME
PARAMETER (MYNAME='EXAMPLE_2')
C
C Input data functions:
INTEGER ASK_I
C
C Data type = complex:
PARAMETER (IDTYPE = 2)
C
C Number of RHS vectors:
PARAMETER (NUMRHS = 1)
C
C Number of vectors to reduce during factoring:
PARAMETER (NUMRED = 0)
C
C Skip operations during solving (no):
PARAMETER (ISKIP = 0)
C
C FMS matrix and vector file attributes:
INTEGER LUA(25)
INTEGER LUX(25)
C
C FMS memory management requires the following arrays:
POINTER (CMD_PTR, CMD)
POINTER (RMD_PTR, RMD)
POINTER (IMD_PTR, IMD)
COMPLEX*16 CMD(0:1)
REAL*8 RMD(0:1)
INTEGER IMD(0:1)
C
C Local variables:
INTEGER N, LA, LX
REAL*8 EI, ERROR
C
C (1) Initialize FMS:
CALL FMSINI
CALL FMSPSH (MYNAME)
CALL FMSIST ('IPRF',1026)
CALL FMSIGT ('MEMPTR',IMD_PTR)
CALL FMSIGT ('MEMPTR',RMD_PTR)
CALL FMSIGT ('MEMPTR',CMD_PTR)
N = ASK_I ('Enter the number of equations')
C
C Populate [A] and {X} with test data:
CALL FMSCMG (CMD, LA, N*N)
CALL FMSCMG (CMD, LX, N)
CALL MATGEN (CMD(LA), N, N, CMD(LX))
C
C (2) Open FMS files:
CALL CNDANN (CMD(LA), N, N, LUA)
CALL FMSOV2 (N, IDTYPE, NUMRHS, CMD(LX), N, LUX)
C
C (3) Write data to FMS files:(Not required)
C
C (4) Perform matrix algebra:
CALL CNDF (LUA, LUA, LUX, LUX, NUMRED)
CALL CNDS (LUA, LUX, LUX, NUMRHS, ISKIP)
C (5) Read data from FMS files:(Not required)
C
C Check the answer:
ERROR = 0.0D0
DO 50 I = 1,N
EI = ABS(CMD(LX-1+I) - 1.0D0)
IF(EI .GT. ERROR) ERROR = EI
50 CONTINUE
WRITE(6,*) 'MAXIMUM ERROR =', ERROR
C
C (6) Close FMS files:
CALL FMSCM (LUA)
CALL FMSCV (LUX)
CALL FMSCMR (CMD, LA, N*N)
CALL FMSCMR (CMD, LX, N)
CALL FMSPOP(MYNAME)
CALL FMSEND
END
C=======================================================================
SUBROUTINE MATGEN (A, LDA, N, B)
C=======================================================================
CHARACTER*6 MYNAME
COMPLEX*16 A(LDA,N), B(N), ZERO, ONE
PARAMETER (MYNAME='MATGEN')
PARAMETER (ZERO=(0.D0,0.D0), ONE=(1.D0,1.D0))
C
C Populate [A] and {B} with test data:
C [A] {X} = {B}
C +- -+ + + + +
C | N -1 -1 -1 -1| | 1 | | 1 |
C |-1 1 0 0 0| | 1 | | 0 |
C |-1 0 1 0 0| | 1 | = | 0 |
C |-1 0 0 1 0| | 1 | | 0 |
C |-1 0 0 0 1| | 1 | | 0 |
C +- -+ + + + +
C
CALL FMSPSH(MYNAME)
A(1,1) = DCMPLX(N,N)
B(1) = ONE
DO 20 I = 2,N
DO 10 J = 2,N
A(I,J) = ZERO
10 CONTINUE
A(1,I) =-ONE
A(I,1) =-ONE
A(I,I) = ONE
B(I) = ZERO
20 CONTINUE
CALL FMSPOP(MYNAME)
RETURN
END
C=======================================================================
INTEGER FUNCTION ASK_I(STRING)
C=======================================================================
CHARACTER* (*) STRING
WRITE(6,2000) STRING
READ (5,*) ASK_I
RETURN
2000 FORMAT (1X,A,'>')
END