C Copyright(C) 1999-2020 National Technology & Engineering Solutions
C of Sandia, LLC (NTESS).  Under the terms of Contract DE-NA0003525 with
C NTESS, the U.S. Government retains certain rights in this software.
C
C See packages/seacas/LICENSE for details

      PROGRAM MEMTEST

C     THIS PROGRAM TESTS THE SUPES MEMORY MANAGER.

      PARAMETER (MFIELD=4)
      CHARACTER*32 VERSN
      CHARACTER*8 CV(MFIELD)
      PARAMETER (MAXSIZ=256)
      CHARACTER*1 CBASE(MAXSIZ)
      COMMON /EXTCLB/ CBASE
      DIMENSION KV(MFIELD),IV(MFIELD),RV(MFIELD),BASE(1),IBASE(1)
      EQUIVALENCE (BASE,IBASE)

      CALL GSUPEV(VERSN)
      WRITE (*,'(A, A)') ' SUPES Version ', VERSN

c      CALL EXNAME (6, CV(1), LEN)
c      OPEN (6, STATUS='unknown',FILE=CV(1)(1:LEN))
c      CALL EXNAME (8, CV(1), LEN)
c      OPEN (8, STATUS='unknown',FILE=CV(1)(1:LEN))
  100 CALL FREFLD( 0,8,'FUNC: ',MFIELD,IOSTAT,N,KV,CV,IV,RV )
      IF ( IOSTAT .NE. 0 ) CV(1) = 'EXIT'
      IF ( CV(1) .EQ. 'MDINIT' ) THEN
         IOFF = IV(2) + 1
         CALL MDINIT (IBASE(IOFF))
      ELSE IF ( CV(1) .EQ. 'MCINIT' ) THEN
         IOFF = IV(2) + 1
         CALL MCINIT (CBASE(IOFF))
      ELSE IF (CV(1) .EQ. 'MDCOMP') THEN
         CALL MDCOMP()
      ELSE IF (CV(1) .EQ. 'MCCOMP') THEN
         CALL MCCOMP()
      ELSE IF (CV(1) .EQ. 'MDDEBG') THEN
         CALL MDDEBG (6)
      ELSE IF (CV(1) .EQ. 'MCDEBG') THEN
         CALL MCDEBG (6)
      ELSE IF (CV(1) .EQ. 'MDDEL') THEN
         CALL MDDEL (CV(2))
      ELSE IF (CV(1) .EQ. 'MCDEL') THEN
         CALL MCDEL (CV(2))
      ELSE IF (CV(1) .EQ. 'MDEFIX') THEN
         CALL MDEFIX (IV(2), IV(3))
         WRITE (6,10000) 'ERROR CODE ', IV(2)
         WRITE (6,10000) 'NEW COUNT  ', IV(3)
         WRITE (8,10000) 'ERROR CODE ', IV(2)
         WRITE (8,10000) 'NEW COUNT  ', IV(3)
      ELSE IF (CV(1) .EQ. 'MCEFIX') THEN
         CALL MCEFIX (IV(2), IV(3))
         WRITE (6,10000) 'ERROR CODE ', IV(2)
         WRITE (6,10000) 'NEW COUNT  ', IV(3)
         WRITE (8,10000) 'ERROR CODE ', IV(2)
         WRITE (8,10000) 'NEW COUNT  ', IV(3)
      ELSE IF (CV(1) .EQ. 'MDEROR') THEN
         CALL MDEROR (6)
         CALL MDEROR (8)
      ELSE IF (CV(1) .EQ. 'MCEROR') THEN
         CALL MCEROR (6)
         CALL MCEROR (8)
      ELSE IF (CV(1) .EQ. 'MDERPT') THEN
         CALL MDERPT (IV(2), IV(3))
         WRITE (6,10000) 'ERROR CODE  ', IV(2)
         WRITE (6,10000) 'ERROR COUNT ', IV(3)
         WRITE (8,10000) 'ERROR CODE  ', IV(2)
         WRITE (8,10000) 'ERROR COUNT ', IV(3)
      ELSE IF (CV(1) .EQ. 'MCERPT') THEN
         CALL MCERPT (IV(2), IV(3))
         WRITE (6,10000) 'ERROR CODE  ', IV(2)
         WRITE (6,10000) 'ERROR COUNT ', IV(3)
         WRITE (8,10000) 'ERROR CODE  ', IV(2)
         WRITE (8,10000) 'ERROR COUNT ', IV(3)
      ELSE IF (CV(1) .EQ. 'MDEXEC') THEN
         WRITE (6,10000) 'POINTER BEFORE ', IP
         WRITE (8,10000) 'POINTER BEFORE ', IP
         CALL MDEXEC ()
         WRITE (6,10000) 'POINTER AFTER ', IP
         WRITE (8,10000) 'POINTER AFTER ', IP
      ELSE IF (CV(1) .EQ. 'MCEXEC') THEN
         WRITE (6,10000) 'POINTER BEFORE ', IP
         WRITE (8,10000) 'POINTER BEFORE ', IP
         CALL MCEXEC ()
         WRITE (6,10000) 'POINTER AFTER ', IP
         WRITE (8,10000) 'POINTER AFTER ', IP
      ELSE IF (CV(1) .EQ. 'MDFIND') THEN
         CALL MDFIND (CV(2), IP, IL)
         WRITE (6, 10000) 'POINTER:',IP,'LENGTH:',IL
         WRITE (8, 10000) 'POINTER:',IP,'LENGTH:',IL
      ELSE IF (CV(1) .EQ. 'MCFIND') THEN
         CALL MCFIND (CV(2), IP, IL)
         WRITE (6, 10000) 'POINTER:',IP,'LENGTH:',IL
         WRITE (8, 10000) 'POINTER:',IP,'LENGTH:',IL
      ELSE IF (CV(1) .EQ. 'MDFILL') THEN
         IF (KV(2) .EQ. 1) THEN
            CALL MDFILL (RV(2))
         ELSE
            TMP = IV(2)
            CALL MDFILL (TMP)
         END IF
      ELSE IF (CV(1) .EQ. 'MCFILL') THEN
         CALL MCFILL (CV(2))
      ELSE IF (CV(1) .EQ. 'MDFOFF') THEN
         CALL MDFOFF ()
      ELSE IF (CV(1) .EQ. 'MCFOFF') THEN
         CALL MCFOFF ()
      ELSE IF (CV(1) .EQ. 'MDGET') THEN
         CALL MDGET (IV(2))
      ELSE IF (CV(1) .EQ. 'MCGET') THEN
         CALL MCGET (IV(2))
      ELSE IF (CV(1) .EQ. 'MDGIVE') THEN
         CALL MDGIVE()
      ELSE IF (CV(1) .EQ. 'MCGIVE') THEN
         CALL MCGIVE()
      ELSE IF (CV(1) .EQ. 'MDLAST') THEN
         CALL MDLAST (IP)
         WRITE (6,10000) 'ERROR NUMBER:',IP
         WRITE (8,10000) 'ERROR NUMBER:',IP
      ELSE IF (CV(1) .EQ. 'MCLAST') THEN
         CALL MCLAST (IP)
         WRITE (6,10000) 'ERROR NUMBER:',IP
         WRITE (8,10000) 'ERROR NUMBER:',IP
      ELSE IF (CV(1) .EQ. 'MDLIST') THEN
         CALL MDLIST (6)
         CALL MDLIST (8)
      ELSE IF (CV(1) .EQ. 'MCLIST') THEN
         CALL MCLIST (6)
         CALL MCLIST (8)
      ELSE IF (CV(1) .EQ. 'MDLONG') THEN
         CALL MDLONG (CV(2), IP, IV(3))
         WRITE (6,10000) 'POINTER:',IP
         WRITE (8,10000) 'POINTER:',IP
      ELSE IF (CV(1) .EQ. 'MCLONG') THEN
         CALL MCLONG (CV(2), IP, IV(3))
         WRITE (6,10000) 'POINTER:',IP
         WRITE (8,10000) 'POINTER:',IP
      ELSE IF (CV(1) .EQ. 'MDMEMS') THEN
         CALL MDMEMS (NSUA, NSUD, NSUV, NSULV)
         WRITE (6,10000) '   ALLOCATED:', NSUA
         WRITE (6,10000) '    DEFERRED:', NSUD
         WRITE (6,10000) '       VOIDS:', NSUV
         WRITE (6,10000) 'LARGEST VOID:', NSULV
         WRITE (8,10000) '   ALLOCATED:', NSUA
         WRITE (8,10000) '    DEFERRED:', NSUD
         WRITE (8,10000) '       VOIDS:', NSUV
         WRITE (8,10000) 'LARGEST VOID:', NSULV
      ELSE IF (CV(1) .EQ. 'MCMEMS') THEN
         CALL MCMEMS (NSUA, NSUD, NSUV, NSULV)
         WRITE (6,10000) '   ALLOCATED:', NSUA
         WRITE (6,10000) '    DEFERRED:', NSUD
         WRITE (6,10000) '       VOIDS:', NSUV
         WRITE (6,10000) 'LARGEST VOID:', NSULV
         WRITE (8,10000) '   ALLOCATED:', NSUA
         WRITE (8,10000) '    DEFERRED:', NSUD
         WRITE (8,10000) '       VOIDS:', NSUV
         WRITE (8,10000) 'LARGEST VOID:', NSULV
      ELSE IF (CV(1) .EQ. 'MDNAME') THEN
         CALL MDNAME (CV(2), CV(3))
      ELSE IF (CV(1) .EQ. 'MCNAME') THEN
         CALL MCNAME (CV(2), CV(3))
      ELSE IF (CV(1) .EQ. 'MDPRNT') THEN
         CALL MDPRNT (CV(2), 6, CV(3))
         CALL MDPRNT (CV(2), 8, CV(3))
      ELSE IF (CV(1) .EQ. 'MCPRNT') THEN
         CALL MCPRNT (CV(2), 6, IV(3))
         CALL MCPRNT (CV(2), 8, IV(3))
      ELSE IF (CV(1) .EQ. 'MDRSRV') THEN
         CALL MDRSRV (CV(2),IP,IV(3))
         WRITE (6,10000) 'POINTER:',IP
         WRITE (8,10000) 'POINTER:',IP
      ELSE IF (CV(1) .EQ. 'MCRSRV') THEN
         CALL MCRSRV (CV(2),IP,IV(3))
         WRITE (6,10000) 'POINTER:',IP
         WRITE (8,10000) 'POINTER:',IP
      ELSE IF (CV(1) .EQ. 'MDSTAT') THEN
         CALL MDSTAT (MNERRS, MNUSED)
         WRITE (6, 10000) 'ERRORS:',MNERRS,'USED:', MNUSED
         WRITE (8, 10000) 'ERRORS:',MNERRS,'USED:', MNUSED
      ELSE IF (CV(1) .EQ. 'MCSTAT') THEN
         CALL MCSTAT (MNERRS, MNUSED)
         WRITE (6, 10000) 'ERRORS:',MNERRS,'USED:', MNUSED
         WRITE (8, 10000) 'ERRORS:',MNERRS,'USED:', MNUSED
      ELSE IF (CV(1) .EQ. 'MDWAIT') THEN
         CALL MDWAIT ()
      ELSE IF (CV(1) .EQ. 'MCWAIT') THEN
         CALL MCWAIT ()
      ELSE IF (CV(1) .EQ. 'MEMY') THEN
         CALL EXMEMY (1, L, M)
      ELSE IF (CV(1) .EQ. 'EXIT') THEN
         CLOSE (6)
         CLOSE (8)
         STOP ' '
      ELSE
         WRITE (6,10000) 'UNKNOWN COMMAND'
         WRITE (8,10000) 'UNKNOWN COMMAND'
      END IF
      GO TO 100
10000 FORMAT ((1X,A,I32))
      END
