You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
203 lines
7.4 KiB
203 lines
7.4 KiB
2 years ago
|
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
|