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
Copyright © Multipath Corporation