FMS Example 2

This example extends example 1 to include the FMS memory manager. The storage for A(N,N) and X(N) are dynamically allocated at run time. This example is also limited to full matrices which may be stored in memory. If you specify a matrix size N that is too large, fatal error FMS$ERR_MEMORY will result. Subroutine MATGEN from the previous example is used to generate test data.

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

FMS Example 2. FMS Memory Management