This example illustrates the use of subroutine FMSIN2 and FMS Parameter NOOPEN for estimating disk space requirements for matrix and vector files.

The following input may be specified: 

C       E X A M P L E   20
C
C	Program name:
	CHARACTER*10 MYNAME
	PARAMETER (MYNAME='EXAMPLE_20')
C
C	FMS matrix file attribute:
C	Unfactored matrix:
	   INTEGER     LUA(25)
C	FMS matrix attribute elements:
	   INTEGER     LUA_LENRLU
	   PARAMETER  (LUA_LENRLU= 5)
	   INTEGER     LUA_LENDIA
	   PARAMETER  (LUA_LENDIA= 9)
	   INTEGER     LUA_NUMRLU
	   PARAMETER  (LUA_NUMRLU=10)
	   INTEGER     LUA_LENTAB
	   PARAMETER  (LUA_LENTAB=15)
C
C	FMS vector file attributes:
C	FMS vector file attributes:
	   INTEGER     LUX(25)
C	FMS vector attribute elements:
	   INTEGER     LUX_LENREC
	   PARAMETER  (LUX_LENREC= 4)
	   INTEGER     LUX_NUMVEC
	   PARAMETER  (LUX_NUMVEC= 6)
C
C	FMS Parameter values:
	   INTEGER     MFMAT
	   INTEGER     INCORE, INCORE_S
	   INTEGER     NOOPEN, NOOPEN_S
	   INTEGER     NUMIOQ
C
C	Local variables:
C	FMS Module number:
	   INTEGER     MOD
C	Number of equations:
	   INTEGER     N
	   REAL*8      R8_N
C	Number of R.H.S. vectors:
	   INTEGER     NRHS
C	Data type:
	   INTEGER     IDTYPE
C	Matrix symmetry:
	   INTEGER     ISTYPE
C	Input function:
	   LOGICAL     ASK
	   INTEGER     ASK_I
C	Minimum file size
	   REAL*8      R8SIZE
	   INTEGER     KBMIN
C	FMS Off-diagonal matrix size:
	   REAL*8      R8OFF
	   INTEGER     KBOFF
C	FMS Striped file size (Kbytes)
	   INTEGER     KBS
C	FMS Non-striped file size (Kbytes)
	   INTEGER     KBNS
C	Ratio of FMS to minimum size:
	   REAL*8      RATIO
C	Profile vector for a full matrix:
	   INTEGER     LOWEQ(1)
	   DATA        LOWEQ/-1/
  100	CONTINUE
    1	CONTINUE
	WRITE (6,*) 'The FMS modules are numbered as follows:'
	WRITE (6,*) '   1 = Real Symmetric'
	WRITE (6,*) '   2 = Real Nonsymmetric'
	WRITE (6,*) '   3 = Complex Hermitian'
	WRITE (6,*) '   4 = Complex Symmetric'
	WRITE (6,*) '   5 = Complex Nonsymmetric'
	MOD    = ASK_I('Enter the FMS module number (1 to 5)')
	IF( (MOD.LT.1) .OR. (MOD.GT.5) ) GO TO 1
	IDTYPE = 1
	IF(MOD .EQ. 3) IDTYPE = 2
	IF(MOD .EQ. 4) IDTYPE = 2
	IF(MOD .EQ. 5) IDTYPE = 2
	ISTYPE = 1
	IF((MOD .EQ. 2) .OR. (MOD .EQ. 5)) ISTYPE = 2
	IF (MOD .EQ. 3) ISTYPE = 3
	N      = ASK_I('Enter the number of equations')
	R8_N   = DFLOAT(N)
	NRHS   = ASK_I('Enter the number of solution vectors')
	WRITE (6,*) 'FMS may be initialized as follows:'
	WRITE (6,*) '   0 = Normal'
	WRITE (6,*) '   1 = Reduced with some output'
	WRITE (6,*) '   2 = Reduced with no output'
	INIT   = ASK_I('Type of initialization (Argument to FMSIN2)')
C
C (1)	Initialize FMS:
	CALL FMSIGT ('LICAPL' , LICAPL  )
	CALL FMSIN2 (INIT)
	CALL FMSPSH(MYNAME)
	WRITE (6,*) 'You may now alter any FMS parameter.'
	WRITE (6,*) 'When you are finished, type the letters RETURN'
	CALL FMSSET
	CALL FMSIGT ('MFMAT' , MFMAT   )
	CALL FMSIGT ('NUMIOQ', NUMIOQ  )
	CALL FMSIGT ('INCORE', INCORE_S)
	CALL FMSIST ('INCORE',        0)
	CALL FMSIGT ('NOOPEN', NOOPEN_S)
	CALL FMSIST ('NOOPEN',        1)
C
C (2)   Open FMS files:
	IF(MOD.EQ.1) CALL RSDI (LOWEQ, N, 'LUA', LUA)
	IF(MOD.EQ.2) CALL RNDI (LOWEQ, N, 'LUA', LUA)
	IF(MOD.EQ.3) CALL CHDI (LOWEQ, N, 'LUA', LUA)
	IF(MOD.EQ.4) CALL CSDI (LOWEQ, N, 'LUA', LUA)
	IF(MOD.EQ.5) CALL CNDI (LOWEQ, N, 'LUA', LUA)
C
C	Compute the size of the off-diagonal matrix files:
	R8OFF  = DFLOAT(LUA(LUA_LENRLU)) * DFLOAT(LUA(LUA_NUMRLU))
	IF(ISTYPE .EQ. 2) R8OFF = (2.0D0)*R8OFF
	KBOFF  = INT(R8OFF/(128.0D0))
C
C	Compute the size of the striped and non-striped files:
	KBNS = ( LUA(LUA_LENDIA) +
     1	         LUA(LUA_LENTAB) )/128
	IF(NUMIOQ .EQ. 0) THEN
C	   Matrix files are not striped:
	   KBS  = 0
	   KBNS = KBNS + KBOFF
	ELSE
C	   Matrix files are striped:
	   KBS  = KBOFF
	END IF
C
C	Compute the minimum size required:
	IF(ISTYPE .EQ. 2) THEN
	   R8SIZE = R8_N * R8_N
	ELSE
	   R8SIZE = R8_N * (R8_N + 1.0D0)/(2.0D0)
	END IF
	IF(IDTYPE .EQ. 2) R8SIZE = (2.0D0)*R8SIZE
	KBMIN = INT(R8SIZE/(128.0D0))
	RATIO = DFLOAT(KBS+KBNS)/DFLOAT(KBMIN)
	WRITE(6,2000) N, MFMAT, IDTYPE, ISTYPE, KBMIN, KBS, KBNS, RATIO
C
C	Compute the size of the FMS vector file:
	CALL FMSOV  (N, IDTYPE, NRHS, 'LUX', LUX)
	R8SIZE = DFLOAT(LUX(LUX_LENREC)) * DFLOAT(LUX(LUX_NUMVEC))
	KBX    = INT( R8SIZE/(128.0D0) )
	IF(NUMIOQ .EQ. 0) THEN
C	   Vector file is not striped:
	   KBNS = KBX
	   KBS  = 0
	ELSE
C	   Vector file is striped:
	   KBNS = 0
	   KBS  = KBX
	END IF
C
C	Compute the minimum space required:
	R8SIZE = R8_N * DFLOAT(NRHS)
	IF(IDTYPE .EQ. 2) R8SIZE = (2.0D0)*R8SIZE
	KBMIN = INT(R8SIZE/(128.0D0))
	RATIO = DFLOAT(KBS+KBNS)/DFLOAT(KBMIN)
	WRITE(6,2001) N, NRHS, IDTYPE, KBMIN, KBS, KBNS, RATIO
C
C	Show the status of the Matrix and Vector files:
	CALL FMSIST ('SHOW', 'FILES')
C
C (6)   Close FMS files:
	CALL FMSCM (LUA)
	CALL FMSCV (LUX)
	CALL FMSIST ('INCORE', INCORE_S)
	CALL FMSIST ('NOOPEN', NOOPEN_S)
	CALL FMSPOP(MYNAME)
	CALL FMSEND
	IF(ASK('Do you want another solution?')) GO TO 100
 2000	FORMAT (/
     1	 'File size for matrix:'/
     2	 '   Number of equations.............=',I10/
     3	 '   Matrix format...................=',I10/
     4	 '   Data type.......................=',I10/
     5	 '   Symmetry........................=',I10/
     6	 '   Minimum space...........(Kbytes)=',I10/
     7	 '   FMS striped space.......(Kbytes)=',I10/
     8	 '   FMS non-striped space...(Kbytes)=',I10/
     9	 '   Ratio (FMS space/Minimum space).=',F10.2)
 2001	FORMAT (/
     1	 'File size for vectors:'/
     2	 '   Number of equations.............=',I10/
     3	 '   Number of vectors...............=',I10/
     4	 '   Data type.......................=',I10/
     5	 '   Minimum space...........(Kbytes)=',I10/
     6	 '   FMS striped space.......(Kbytes)=',I10/
     7	 '   FMS non-striped space...(Kbytes)=',I10/
     8	 '   Ratio (FMS space/Minimum space).=',F10.2)
	END
C=======================================================================
	LOGICAL FUNCTION ASK(QUESTION)
C=======================================================================
	CHARACTER* (*) QUESTION
	CHARACTER*1 IYN
	WRITE(6,2000) QUESTION
	READ (5,1000) IYN
	WRITE(6,2001) IYN
	IF( (IYN .EQ. 'Y') .OR. (IYN .EQ. 'y') ) THEN
	   ASK = .TRUE.
	ELSE
	   ASK = .FALSE.
	END IF
	RETURN
 1000	FORMAT (A)
 2000	FORMAT (1X,A,' (y,n)>')
 2001	FORMAT (4X,'You entered ',A)
	END
C=======================================================================
	INTEGER FUNCTION ASK_I(STRING)
C=======================================================================
	CHARACTER* (*) STRING
	WRITE(6,2000) STRING
	READ (5,*) ASK_I
	RETURN
 2000	FORMAT (1X,A,'>')
	END