C       E X A M P L E   22
C
C	Program name:
	CHARACTER*10 MYNAME
	PARAMETER (MYNAME='EXAMPLE_22')
C
C	Input Data:
	LOGICAL ASK
	INTEGER ASK_I
C
C	FMS vector file attributes:
	INTEGER     LUX(25)
C
C	FMS memory management requires the following arrays:
	POINTER (RMD_PTR, RMD)
	REAL*8     RMD(0:1)
C
C	Local variables:
	INTEGER     LUPR
	INTEGER     MBYTES, NTIMES
	INTEGER     IDTYPE, I, LX, LDX, LDISK
	REAL*8      TCPU1,  TCPU2
	REAL*8      TWALL1, TWALL2
	REAL*8      TIO1,   TIO2
	REAL*8      TWRITE, TREAD, TMBYTE
C
C (1)   Initialize FMS:
	CALL FMSINI
	CALL FMSPSH (MYNAME)
    1	CONTINUE
	MBYTES = ASK_I('Enter the transfer length (Mbytes)')
	NTIMES = ASK_I('Enter the number of times to transfer')
	WRITE (6,*) 'You may now alter any FMS parameter.'
	WRITE (6,*) 'When you are finished, type the letters RETURN'
	CALL FMSSET
	CALL FMSIGT ('MEMPTR', RMD_PTR)
	CALL FMSIGT ('LUPR', LUPR)
C
C (2)   Open FMS files:
	N      = 1024*1024*MBYTES/8
	IDTYPE = 1
	CALL FMSOV (N, IDTYPE, NTIMES, 'LUX', LUX)
	LDX    = LUX(4)
	TMBYTE = DFLOAT(8*LDX/(1024*1024)) * DFLOAT(NTIMES)
C
C	Allocate memory:
	CALL FMSRMG (RMD, LX, LDX)
C
C	Initialize the memory:
	DO I = 1,LDX
	   RMD(LX+I-1) = DFLOAT(I)
	END DO
C
C (3)   Write data to FMS files:
C
	LDISK = 1
	WRITE(LUPR,2001) TMBYTE
	CALL FMSTIM (TCPU1, TWALL1, TIO1)
	DO I=1,NTIMES
	   CALL FMSWRT (LUX(1), LDISK, RMD(LX), LDX)
	   LDISK = LDISK + LDX
	END DO
	CALL FMSTIM (TCPU2, TWALL2, TIO2)
	TWRITE = TWALL2 - TWALL1
	IF(TWRITE .NE. 0) THEN
	   TWRITE = TMBYTE/TWRITE
	ELSE
	   TWRITE = 0.0D0
	END IF
C
C (4)   Perform matrix algebra:
C	None required.
C
C
C (5)   Read data from FMS files:
C
	LDISK = 1
	WRITE(LUPR,2002), TMBYTE
	CALL FMSTIM (TCPU1, TWALL1, TIO1)
	DO I=1,NTIMES
	   CALL FMSRED (LUX(1), LDISK, RMD(LX), LDX)
	   LDISK = LDISK + LDX
	END DO
	CALL FMSTIM (TCPU2, TWALL2, TIO2)
	TREAD  = TWALL2 - TWALL1
	IF(TREAD  .NE. 0) THEN
	   TREAD  = TMBYTE/TREAD
	ELSE
	   TREAD  = 0.0D0
	END IF
C
C	Print the results:
	WRITE(LUPR,2000) MBYTES, NTIMES, TWRITE, TREAD
C
C (6)   Close FMS files:
C
C	Return the work array:
	CALL FMSRMR (RMD, LX, LDX)
	CALL FMSCV (LUX)
	IF(ASK('Do you want another solution?')) GO TO 1
	CALL FMSPOP (MYNAME)
	CALL FMSEND
 2000	FORMAT (/
     1	' <--Transfers-->    <--Rate(Mb/Sec)-->'/
     2	' Mbytes    Times      Write       Read'/
     3	' ======    =====    =======    ======='/
     4	I7,I9,2F11.3/)
 2001	FORMAT (/
     1	' Writing ',F10.0,' Mbytes')
 2002	FORMAT (
     1	' Reading ',F10.0,' Mbytes')
	END
C=======================================================================
	LOGICAL FUNCTION ASK(QUESTION)
C=======================================================================
	CHARACTER* (*) QUESTION
	CHARACTER*1 IYN
	GO TO 20
   10	CONTINUE
	WRITE(6,2001)
   20	CONTINUE
	WRITE(6,2000) QUESTION
	READ (5,1000,ERR=10) 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 (1X,'Bad Input.  Try again.')
	END
C=======================================================================
	INTEGER FUNCTION ASK_I(STRING)
C=======================================================================
	CHARACTER* (*) STRING
	GO TO 20
   10	CONTINUE
	WRITE(6,2001)
   20	CONTINUE
	WRITE(6,2000,ERR=10) STRING
	READ (5,*) ASK_I
	RETURN
 2000	FORMAT (1X,A,'>')
 2001	FORMAT (1X,'Bad Input.  Try again.')
	END