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