C 17 JAN 06 - RAK - ADD FLUSHONWRITE ROUTINE FOR IBM/AIX
C 19 NOV 05 - TJP - ADD *XT3 CODE FOR CRAY XT3
C  5 JUL 05 - MWS - SELECT NEW ATOM,BASIS,EFP,PCM,DAF DIMENSIONS
C  1 JUN 05 - MWS - FLSHBF: IBM/AIX SHOULD PASS 4 BYTE ARG TO FLUSH_
C  5 FEB 05 - MWS - FLSHBF: ADD ITANIUM CODING
C  7 SEP 04 - MWS - PAD COMMON BLOCK INTFIL
C 23 JUL 03 - SK,HU,TJP - INCLUDE 64 BIT AMD CHIP VERSION (*AMD)
C  4 NOV 03 - TJP - INCLUDE ROUTINE FOR EFFECTIVE VECTOR LENGTH
C  3 SEP 03 - MWS - TSECND: *ITA TIMING CALLS FIXED
C  3 JUL 03 - JMM - SUPPRESS PRINTING FOR MONTE CARLO JOBS
C 26 MAR 03 - TJP - ADD *CX1 CODE FOR CRAY-X1
C 28 JAN 03 - MWS - ADAPTATIONS FOR A 64 BIT SUN VERSION
C 12 DEC 02 - YA  - GETFM: LET ANY NODE PRINT MEMORY ALLOCATION ERROR
C  7 AUG 02 - ZK  - USE FORTRAN LIBRARY ROUTINES FOR THE HP VERSION
C 20 JUN 02 - FPA - ADD *ITA ITANIUM LINUX VERSION
C 17 APR 02 - KRG - REMOVE A STOP STATEMENT
C 16 FEB 02 - MWS - TSECND,TMDATE: CHANGE IBM TIMING CALLS
C 24 JAN 02 - MWS - ABRT: STALL 2 SECONDS TO ALLOW FOR OUTPUT FLUSH
C  7 DEC 01 - STE - ADD *WIN LINES FOR WIN32 VERSION
C  8 OCT 01 - MWS - PARSET: OMIT BALTYP OVERRIDES, UPDATE ITRFAO VALS
C  6 SEP 01 - MWS - FLSHBF: DIGITAL CHANGED
C 10 JUL 01 - MWS - TMDATE: ADD 1900 TO HP'S YEAR VALUE
C  1 MAY 00 - MWS - CHANGES TO MATCH MODIFIED ZUNIX.C
C 25 MAR 00 - MWS - REMOVE BRIAN'S GO AT A SEPARATE ALPHA LINUX VERSION
C 25 SEP 99 - MWS - BEGING: REMOVE ZMIPS CALL
C 29 AUG 99 - BSD - ADD STATIC MEMORY ALPHA LINUX CODE
C  6 JUN 99 - MWS - ADD CALLING ARGS TO DDI_PBEG AND DDI_PEND
C 12 NOV 98 - MWS - T3D TO T3E, DEL CONVEX (CVX), LOGSHF, DEC=64 BIT
C 22 APR 98 - MWS - ENDING: AVOID FINAL FLOATING PT. WARNINGS ON SUN
C 13 APR 98 - AJL - FLUSH OUTPUT ON FUJITSU
C 27 FEB 98 - AR,AR - CORRECT FUJITSU LOGICAL FUNCTIONS, CHANGE TIMING
C  6 JAN 98 - MY  - INCLUDE HITACHI SR VERSION
C 28 SEP 97 - MWS - DEPRECATE MANY OLD MACHINES. NAMELY, WE DROP SUPPORT
C                   FOR *ALL, *AMD, *APO, *CEL, *INT, *KSR, *STR, *TMC
C  8 SEP 97 - MWS - CONVERT PARALLEL CALLS FROM TCGMSG TO DDI
C  2 SEP 97 - MWS - ABRT: INSERT PROPER F2C CODE
C 24 JUL 97 - KRG - TIMIT: CHANGE FORMATTING TO 2 LINES
C 22 JUL 97 - DGF - ADD BIT OPERATIONS LOGNOT, LOGOR, LOGSHF, LOGXOR
C 19 FEB 97 - FPR - TMDATE: DECLARATION FOR HP
C 20 DEC 96 - HPP - BEGING,TSECND: T3E IN BANNER, ADD CPU TIMING
C 12 MAY 96 - MWS - PARSET,MSGSET: CHANGES FOR MPI INTERFACE
C 24 MAY 95 - MWS - PARSET: ASSIGN PARALLEL AO TRANSFORMATION STORAGE
C 29 MAR 95 - MK  - AIX'S XLF VERSION 3 CAN FLUSH_
C  6 MAR 95 - KPG - TSECND: USE AN ACTUAL TIMING CALL
C 17 NOV 94 - MWS - ADD TEXIT,TIMIT TO CONSOLIDATE ALL TIMING CODE
C 11 NOV 94 - MWS - REMOVE A FEW FTNCHEK WARNINGS
C 28 OCT 94 - MWS - BEGING: USE XDR UNTIL AFTER $SYSTEM IS READ
C 23 AUG 94 - ML  - INCLUDE CRAY-T3D VERSION
C 10 AUG 94 - MWS - INCREASE NUMBER OF DAF RECORDS
C 19 JUL 94 - MWS - ADD ROUTINE ASKVEC
C 19 JUN 94 - DM  - TSECND: CHANGE HP TIMING CALL
C  4 APR 94 - MWS - MSGSET: XDR USAGE IS OPTIONAL
C 18 MAR 94 - MM  - TSECND: CONVEX CPUTIME IS SINGLE PRECISION
C 29 DEC 93 - PVZ - ADDED F2C OPTION FOR F2C/GCC COMPILATION
C 31 SEP 93 - GJA - ADD FLUSH FOR AIX
C 24 SEP 93 - JF  - ADD *NEC LINES FOR NEC
C 20 SEP 93 - WS,JAB - ADD *KSR LINES
C  7 SEP 93 - SS  - BEGING: CM-5 NEEDS MODE OF STDERR RESET
C 19 AUG 93 - RHN - TMDATE: CHANGE HP TIME STAMP CALLS
C 24 MAY 93 - NAN - MSGSET: DON'T USE MESSAGE MASKS FOR CRAY
C 10 FEB 93 - TLW - THINKING MACHINES VERSION
C 31 OCT 92 - MWS - TMDATE: FIX COUNTING LEAP YEARS FOR AIX
C 20 JUN 92 - DP,FS,CJ,TH - HP9000-7X0 TIMING CODE
C 17 APR 92 - TLW,MWS - ADD PARSET, OTHER IPSC/860 MODIFICATIONS
C  7 APR 92 - MS  - SETFM: USE MALLOPT(%VAL(1),%VAL(0)) FOR AIX 3.1.5
C 26 MAR 92 - TLW - MESSAGE MASKS DEFINED IN ROUTINE MSGSET
C  2 MAR 92 - TLW - FLSHBF: ONLY MASTER WORK
C 30 JAN 92 - TLW - TMDATE: FIX PARALLEL CALLS
C 29 JAN 92 - TLW - BEGING: PUT IN PARALLEL INITIALIZATION;
C                   ENDING: PUT IN PARALLEL CLEANUP
C 11 JAN 92 - TLW - ABRT: RUN IN PARALLEL
C  8 JAN 92 - TLW - MAKE WRITES PARALLEL; ADD COMMON PAR
C  1 JAN 92 - MWS - FLSHBF: UNICOS VERSION 6 HAS FLUSH CALL
C 18 DEC 91 - MWS - PUT IN FRED SENESE'S HP CODE
C 18 NOV 91 - NM  - ABRT: NO ARGUMENT IN AIX CALL TO ABORT
C  6 SEP 91 - JAB - ADD INT FOR INTEL IPSC/860 RUNNING NX/2
C 28 AUG 91 - RHN - ADD FUJITSU UXP/M SUPPORT
C 20 JUN 91 - MWS - CHANGE IN TMDATE'S DECSTATION CODE FOR F77 3.0
C 15 FEB 91 - TLW - PRAGMA ADDED TO ABRT FOR AIX/370
C  4 FEB 91 - TLW - ABRT: ADD IF ICORFL LINES
C 29 JAN 91 - TLW - ABRT: ADD COMMON MACHSW AND FLUSHES
C  8 DEC 90 - UK  - TMDATE: FIX LEAP YEAR COMPUTATION FOR AIX
C 15 SEP 90 - MWS - MOVE UPCASE BACK INTO FRFMT SECTION
C  1 AUG 90 - MWS - AIX CHANGED TO USE DYNAMIC MEMORY
C 20 JUN 90 - FRJ - TSECND: CONVEX CPUTIME IS DOUBLE PRECISION
C  1 MAY 90 - STE - BEGING: ENABLE FP EXCEPT. ON MIPS BASED SYSTEMS
C  5 APR 90 - JHJ - ADD UPCASE ROUTINE
C 20 MAR 90 - MG  - ADD ETIME SIMULATOR FOR 68000 BASED APOLLOS.
C 23 FEB 90 - MWS - DECSTN MEMORY ALLOCATION MUST HAVE EXTERNAL LOC,
C                   FLUSH PUNCH BUFFER IN BIGFM.
C  6 FEB 90 - MWS - SETFM: LIMFM SHOULD BE MEMLIM, NOT MEMAVL
C 22 JAN 90 - MWS - UNICOS VERSION, WITH DYNAMIC MEMORY
C 16 JAN 90 - MWS - SETFM: EXPLANATORY COMMENTS, DYNAMIC MEMORY ALA
C                   STEVE ELBERT FOR ALL,ARD,CEL,CVX,SUN VERSIONS.
C  3 JAN 90 - STE - DYNAMIC MEMORY SUPPORT FOR DEC, SGI VERSIONS
C 29 DEC 89 - JAM - CONVEX CAN FLUSH BUFFERS TOO.
C 22 SEP 89 - MWS - ADD STEVE'S APO, SGI, STR, SUN VERSIONS
C 21 SEP 89 - STE - MOVE LOGAND FROM MTHLIB TO HERE
C 21 AUG 89 - CFJ - ABRT CALLS TRACEBACK FOR CONVEX VERSION
C 18 AUG 89 - MWS - ADD IBM AIX SUPPORT
C 11 JUL 89 - STE - ADD DECSTATION SUPPORT (MIPS CHIP)
C  5 JUL 89 - FJ  - ADD AMDAHL SUPPORT
C  7 JUN 89 - MWS - ADD ARDENT TITAN SUPPORT
C 10 APR 89 - STE - ABORT IF REQUESTED MEMORY EXCEEDS AMOUNT AVAILABLE
C 22 FEB 89 - STE - PUT ALL THE NASTY MACHINE DEPENDENCIES HERE
C*MODULE UNPORT
C-----------------------------------------------------------------------
C     THIS IS THE NASTIEST, TOTALLY UNPORTABLE CODE IN GAMESS.
C     THE VERSIONS WHICH ARE SUPPORTED HERE ARE
C          *AIX - IBM POWER, POWERPC, SP, ETC RUNNING AIX (SEE IRON.DOC)
C          *CRY - CRAY PARALLEL VECTOR PROCESSOR (OLDER MODELS),
C                 SEE ALSO OTHER CRAY PRODUCTS *T3E, *CX1, *XT3
C          *CX1 - CRAY X1 OR X1E (THE MODERN VECTOR SYSTEMS) (UNICOS/MP)
C          *DEC - DECSTATION/DECSYSTEM (UNIX)
C          *F2C - F2C/GCC COMPILER ON PC RUNNING UNIX (LINUX,BSD386,ETC)
C          *F77 - A GENERIC, AND MOSTLY DO NOTHING VERSION
C          *FUJ - FUJITSU UXP/M
C          *HIT - HITACHI SR2201(RUNNING HI-UX/MPP)
C          *HP  - HEWLETT-PACKARD HP/9000 SERIES
C          *IBM - IBM MAINFRAME (VM OR MVS, VS FORTRAN) - SEE ALSO *AIX
C          *ITA - ITANIUM UNDER LINUX (NOT WELL TESTED)
C          *NEC - NEC SX (SUPER-UX)
C          *SGI - SILICON GRAPHICS INC.
C          *SUN - SUN WORKSTATIONS
C          *T3E - CRAY T3E (T3D MAY NOT WORK)
C          *VMS - VMS SYSTEMS RUNNING ON EITHER VAX OR AXP PROCESSORS
C          *WIN - WIN32 SYSTEMS USING UWIN LIBRARIES FOR UNIX FUNCTIONS
C          *XT3 - CRAY XT3 (CATAMOUNT)
C-----------------------------------------------------------------------
C
C*MODULE UNPORT  *DECK ABRT
      SUBROUTINE ABRT
C
C     ----- GENERATE A CALLING SEQUENCE TRACE AND STOP EXECUTION -----
C
      DOUBLE PRECISION TIMSTR(3)
C
      LOGICAL GOPARR,DSKWRK,MASWRK
C
      COMMON /IOFILE/ IR,IW,IP,IS,IPK,IDAF,NAV,IODA(950)
      COMMON /PAR   / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK
      COMMON /MACHIN/ NWDVAR,MAXFM,MAXSM,LIMFM,LIMSM
      COMMON /MACHSW/ KDIAG,ICORFL,IXDR
C
C     ----- PRINT ACCOUNTING INFO AND GOODBYE MESSAGE -----
C
      CALL TMDATE(TIMSTR)
      IF (MASWRK) WRITE(IW,900) TIMSTR
  900 FORMAT(1X,'EXECUTION OF GAMESS TERMINATED -ABNORMALLY- AT ',3A8)
      CALL BIGFM(MAXFM)
      CALL TIMIT(1)
C
C     STALL FOR A SHORT WHILE TO ALLOW A CHANCE OF PRINTING
C     ANY ERROR MESSAGES, BEFORE DDIKICK.X BLOWS US AWAY.
C
      CALL FLSHBF(IW)
      CALL FLSHBF(IP)
      IDELAY=2
      CALL NAPTIME(IDELAY)
C
C     ----- EXIT PARALLEL RUNS GRACELESSLY -----
C
      CALL DDI_PEND(1)
C
C     ----- DO A TRACEBACK AND/OR CORE DUMP -----
C
      IF (MASWRK) THEN
C-----------------------------------------------------------------------
C                          IBM RUNNING AIX
*AIX  IF (ICORFL.EQ.1) THEN
*AIX     WRITE(IW,1) 'DBX','WHERE','QUIT'
*AIX     CALL ABORT
*AIX  ELSE
*AIX     WRITE(IW,2)
*AIX  END IF
C-----------------------------------------------------------------------
C                          AMD64 - PGI
*AMD  IF (ICORFL.EQ.1) THEN
*AMD     WRITE(IW,1) 'GDB','BACKTRACE','QUIT'
*AMD     CALL ABORT
*AMD  ELSE
*AMD     WRITE(IW,2)
*AMD  END IF
C-----------------------------------------------------------------------
C                          CRAY UNICOS
*CRY  IF (ICORFL.EQ.1) THEN
*CRY     CALL TRBK(6)
*CRY     WRITE(IW,1) 'CDBX','WHERE','QUIT'
*CRY     CALL ABORT('CORE DEBUG FILE CREATED')
*CRY  ELSE
*CRY     WRITE(IW,2)
*CRY     CALL TRBK(6)
*CRY  END IF
C-----------------------------------------------------------------------
C                          CRAY X1 - UNICOS/MP
C          (IDENTICAL TO *CRY, EXCEPT DEBUGGER HAS CHANGED)
*CX1  IF (ICORFL.EQ.1) THEN
*CX1     WRITE(IW,1) 'GDB','WHERE','QUIT'
*CX1     CALL ABORT('CORE DEBUG FILE CREATED')
*CX1  ELSE
*CX1     WRITE(IW,2)
*CX1  END IF
C-----------------------------------------------------------------------
C                          DIGITAL EQUIPMENT CORPORATION
*DEC  IF (ICORFL.EQ.1) THEN
*DEC     WRITE(IW,1) 'DBX','WHERE','QUIT'
*DEC     CALL ABORT('CORE DEBUG FILE CREATED')
*DEC  ELSE
*DEC     WRITE(IW,2)
*DEC  END IF
C-----------------------------------------------------------------------
C                          PC-UNIX
*F2C  IF (ICORFL.EQ.1) THEN
*F2C     WRITE(IW,1) 'GDB','BACKTRACE','QUIT'
*F2C     CALL ABORT
*F2C  ELSE
*F2C     WRITE(IW,2)
*F2C  END IF
C-----------------------------------------------------------------------
C                          GENERIC FORTRAN 77
*F77  BYEBYE = SQRT(REAL(-IW))
C-----------------------------------------------------------------------
C                          FUJITSU
*FUJ  CALL ERRTRA
C-----------------------------------------------------------------------
C                          HITACHI HI-UX/MPP
*HIT  IF (ICORFL.EQ.1) THEN
*HIT     CALL ERRTRA
*HIT     WRITE(IW,1) 'NDB','WHERE','QUIT'
*HIT     CALL HF_CFUNC('ABORT',0,ITRASH,0)
*HIT  ELSE
*HIT     WRITE(IW,2)
*HIT     CALL ERRTRA
*HIT  END IF
C-----------------------------------------------------------------------
C                          HEWLETT-PACKARD
*HP   IF (ICORFL.EQ.1) THEN
*HP      WRITE(IW,1) 'ADB','C','Q'
*HP      CALL EXIT(1)
*HP   ELSE
*HP      WRITE(IW,2)
*HP   END IF
C-----------------------------------------------------------------------
C                          INTERNATIONAL BUSINESS MACHINES
*IBM  CALL ERRTRA
C-----------------------------------------------------------------------
C                          LINUX ON ITANIUM
*ITA  IF (ICORFL.EQ.1) THEN
*ITA     WRITE(IW,1) 'GDB','BACKTRACE','QUIT'
*ITA     CALL ABORT
*ITA  ELSE
*ITA     WRITE(IW,2)
*ITA  END IF
C-----------------------------------------------------------------------
C                          NEC SX SUPER-UX
*NEC  IF (ICORFL.EQ.1) THEN
*NEC     WRITE(IW,1) 'DBX','$WHERE','$Q'
*NEC     CALL MESPUT('CORE DEBUG FILE CREATED',23,1)
*NEC     CALL ABORT()
*NEC  ELSE
*NEC     WRITE(IW,2)
*NEC     CALL MESPUT('ABORT FROM GAMESS',17,1)
*NEC  END IF
C-----------------------------------------------------------------------
C                          SILICON GRAPHICS
*SGI  IF (ICORFL.EQ.1) THEN
*SGI     WRITE(IW,1) 'DBX','$WHERE','$Q'
*SGI     CALL ABORT('CORE DEBUG FILE CREATED')
*SGI  ELSE
*SGI     WRITE(IW,2)
*SGI  END IF
C-----------------------------------------------------------------------
*SUN  IF (ICORFL.EQ.1) THEN
*SUN     WRITE(IW,1) 'DBX','$WHERE','$Q'
*SUN     CALL ABORT('CORE DEBUG FILE CREATED')
*SUN  ELSE
*SUN     WRITE(IW,2)
*SUN  END IF
C-----------------------------------------------------------------------
C                          CRAY T3E (IDENTICAL TO *CRY)
*T3E  IF (ICORFL.EQ.1) THEN
*T3E     CALL TRBK(6)
*T3E     WRITE(IW,1) 'CDBX','WHERE','QUIT'
*T3E     CALL ABORT('CORE DEBUG FILE CREATED')
*T3E  ELSE
*T3E     WRITE(IW,2)
*T3E     CALL TRBK(6)
*T3E  END IF
C-----------------------------------------------------------------------
C                          DIGITAL EQUIPMENT CORPORATION
*VMS  CALL LIB$STOP(%VAL(0))
C-----------------------------------------------------------------------
C                          CRAY XT3
*XT3  IF (ICORFL.EQ.1) THEN
*XT3     WRITE(IW,1) 'GDB','BACKTRACE','QUIT'
*XT3     CALL ABORT('CORE DEBUG FILE CREATED')
*XT3  ELSE
*XT3     WRITE(IW,2)
*XT3  END IF
C-----------------------------------------------------------------------
C
      END IF
C
C        ----- GENERIC STOP, IN CASE YOU GET THIS FAR -----
C
      STOP 'IN ABRT'
C
    1 FORMAT(1X,'TRACEBACK CAN BE OBTAINED BY LOCATING',
     *          ' THE ''CORE'' MEMORY DUMP FILE'/
     *   1X,'AND TYPING THE FOLLOWING (IN LOWER CASE)'/
     *   1X,A,' /U.../GAMESS/GAMESS.01.X CORE (INVOKES DEBUGGER)'/
     *   1X,'   ',A,'                         (PRINTS TRACEBACK)'/
     *   1X,'   ',A,'                         (QUITS DEBUGGER)')
    2 FORMAT(1X,'IF YOU WANT A CORE FILE, SET COREFL=.TRUE.',
     *          ' IN $SYSTEM.')
      END
C*MODULE UNPORT  *DECK BEGING
      SUBROUTINE BEGING(VERSN)
C
C------------------------------------------------
C     ----- TAKE CARE OF RUN INITIALIZATION -----
C------------------------------------------------
C
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
C
      LOGICAL GOPARR,DSKWRK,MASWRK
C
      CHARACTER*40 VERSN
C
C
      COMMON /MACHIN/ NWDVAR,MAXFM,MAXSM,LIMFM,LIMSM
      COMMON /MACHSW/ KDIAG,ICORFL,IXDR
      COMMON /PAR   / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK
C
C-----------------------------------------------------------------------
C     ----- SET -NWDVAR- IN COMMON /MACHIN/ -----
C     THIS IS THE NUMBER OF INTEGERS IN A WORKING PRECISION
C     FLOATING POINT NUMBER, WHICH IS MOST COMMONLY 64 BITS.
C     THUS SYSTEMS WITH 64 BIT INTEGERS USE A VALUE OF 1, WHILE
C          SYSTEMS WITH 32 BIT INTEGERS USE A VALUE OF 2.
C
      NWDVAR = 2
*AMD  NWDVAR = 1
*CRY  NWDVAR = 1
*CX1  NWDVAR = 1
*DEC  NWDVAR = 1
*ITA  NWDVAR = 1
*NEC  NWDVAR = 1
*T3E  NWDVAR = 1
*XT3  NWDVAR = 1
      MAXFM=0
      MAXSM=0
C
C-----------------------------------------------------------------------
C
C INITIALIZE PARALLEL
C
      CALL DDI_PBEG(NWDVAR)
      CALL DDI_NPROC(NPROC,ME)
      MASTER = 0
      GOPARR = NPROC.GT.1
      MASWRK = ME.EQ.MASTER
      DSKWRK = .FALSE.
      IXDR   = 1
C-----------------------------------------------------------------------
C
C     ----- SPECIAL ERROR/CONDITION HANDLING -----
C
C        KILL UNDERFLOW ERROR LOGGING ON IBM MAINFRAME
*IBM  CALL XUFLOW(0)
C
C        KILL OUTPUT CONVERSION ERRORS FOR VAX/VMS SYSTEMS
C        THIS LINE SHOULD NOT BE USED ON ALPHA VMS SYSTEMS
CVAX  CALL ERRSET(63,,,,.FALSE.,1000)
C-----------------------------------------------------------------------
C
C        ----- DEFINE THE MACHINE VERSION -----
C
*AIX  VERSN = '*********** IBM (AIX) VERSION **********'
*AMD  VERSN = '********** AMD 64 BIT VERSION **********'
*CRY  VERSN = '*********** CRAY PVP VERSION ***********'
*CX1  VERSN = '************ CRAY X1 VERSION ***********'
*DEC  VERSN = '********* COMPAQ (DEC) VERSION *********'
*F2C  VERSN = '************ PC-UNIX VERSION ***********'
*F77  VERSN = '****** GENERIC FORTRAN 77 VERSION ******'
*FUJ  VERSN = '******** FUJITSU UXP/M VERSION *********'
*HIT  VERSN = '****** HITACHI HI-UX/MPP VERSION *******'
*HP   VERSN = '*** HEWLETT-PACKARD (HP-UX) VERSION ****'
*IBM  VERSN = '********* IBM (MVS/VM) VERSION *********'
*ITA  VERSN = '********* LINUX-ITANIUM VERSION ********'
*NEC  VERSN = '******* NEC SX (SUPER-UX) VERSION ******'
*SGI  VERSN = '******** SILICON GRAPHICS VERSION ******'
*SUN  VERSN = '***** SUN MICROSYSTEMS INC. VERSION ****'
*T3E  VERSN = '*********** CRAY T3E VERSION ***********'
*VMS  VERSN = '********* VAX/AXP (VMS) VERSION ********'
*WIN  VERSN = '************ WINDOWS VERSION ***********'
*XT3  VERSN = '*********** CRAY XT3 VERSION ***********'
C
      RETURN
      END
C*MODULE UNPORT  *DECK ENDING
      SUBROUTINE ENDING
      COMMON /IOFILE/ IR,IW,IP,IS,IPK,IDAF,NAV,IODA(950)
C
C     ----- TERMINATE EXECUTION SMOOTHLY -----
C     THE TIME DELAY IS TO TRY TO ALLOW ALL BUFFERS TO FLUSH PROPERLY
C
      CALL FLSHBF(IW)
      CALL FLSHBF(IP)
      IDELAY=2
      CALL NAPTIME(IDELAY)
C
C        CLEAN UP PARALLEL EXECUTION
C
      CALL DDI_PEND(0)
C
C        THIS AVOIDS THE "FORTRAN STOP" MESSAGE
*VMS  CALL EXIT
      RETURN
      END
C*MODULE UNPORT  *DECK FLSHBF
      SUBROUTINE FLSHBF(LUNIT)
C
      LOGICAL GOPARR,DSKWRK,MASWRK
*AIX  INTEGER*4 LTEMP
*CX1  INTEGER*4 LTEMP
*DEC  INTEGER*4 LTEMP
*ITA  INTEGER*4 LTEMP
*ITA  LOGICAL*4 STAT,COMMITQQ
*SGI  INTEGER*4 LTEMP
*SUN  INTEGER*4 LTEMP,FLUSH,ISTAT
C
      COMMON /PAR   / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK
C
C        ----- FLUSH THE BUFFER FOR LOGICAL UNIT LUNIT -----
C        THIS ROUTINE IS MOST IMPORTANT FOR UNIX SYSTEMS,
C        WHERE OUTPUT OTHERWISE STAYS IN BUFFERS FOREVER.
C
C     NOTE: ON AIX SYSTEMS WITH XLF VERSION 2, THE FLUSH CALL DOES
C           NOT WORK WELL, AND SHOULD BE COMMENTED OUT.  THE MOST
C           PROMINENT SIGN OF A BAD "FLUSH_" IS GARBAGE CHARACTERS
C           IN THE PUNCH FILE.  E.G., CHANGE TO "C---*AIX ..."
C
      IF (MASWRK) THEN
*AIX  LTEMP = LUNIT
*AIX  CALL FLUSH_(LTEMP)
*AMD  CALL FLUSH(LUNIT)
*CRY  CALL FLUSH(LUNIT)
*CX1  LTEMP = LUNIT
*CX1  CALL FLUSH(LTEMP)
*DEC  LTEMP = LUNIT
*DEC  CALL FLUSH(LTEMP)
*F2C  CALL FLUSH(LUNIT)
*FUJ  CALL FLUSH(LUNIT)
*HIT  CALL HF_FLUSH(LUNIT)
*HP   CALL FLUSH(LUNIT)
*ITA  LTEMP = LUNIT
*ITA  STAT = COMMITQQ(LTEMP)
*NEC  CALL FLUSH(LUNIT)
*SGI  LTEMP = LUNIT
*SGI  CALL FLUSH(LTEMP)
*SUN  LTEMP = LUNIT
*SUN  ISTAT = FLUSH(LTEMP)
*T3E  CALL FLUSH(LUNIT)
*WIN  CALL FLUSH(LUNIT)
*XT3  CALL FLUSH(LUNIT)
      END IF
      RETURN
      END
C*MODULE UNPORT  *DECK FLUSHONWRITE
      SUBROUTINE FLUSHONWRITE(LUNIT)
C
C        THE AIX SYSTEM'S FLUSH_ CALL WORKS ONLY ON UNIT 6, WHICH IS
C        CONSIDERED CONNECTED TO A TERMINAL, BUT NOT OTHER UNITS.
C
*AIX  INCLUDE "fiosetup_.h"
*AIX  INTEGER*4 LTEMP, IGOOD, IRESULT, FIOSETUP_
*AIX  LTEMP = LUNIT
*AIX  IGOOD = 0
*AIX  IRESULT = FIOSETUP_(LTEMP,
*AIX *                    IO_CMD_FLUSH_AFTER_WRITE,
*AIX *                    IO_ARG_FLUSH_YES)
*AIX  IF (IRESULT.EQ.IGOOD) RETURN
*AIX  WRITE(6,9) IRESULT
*AIX9 FORMAT(1X,'FLUSHONWRITE: ERROR, FIOSETUP_ RETURNED IRESULT=',I5)
*AIX  CALL ABRT
      RETURN
      END
C*MODULE UNPORT  *DECK IGETGRDVECLEN
      INTEGER FUNCTION IGETGRDVECLEN(MAXVEC)
C
C        SCALAR MACHINES SHOULD AVOID SPECIAL VECTOR ROUTINES
C        IN THE GRADIENT PROGRAM BY THE FOLLOWING COMPUTATION.
C
      IGETGRDVECLEN = MAXVEC*3+1
C
C        VECTOR MACHINES MAY WISH TO EXPERIMENT WITH THE VECTOR
C        LENGTH AT WHICH TO CALL THE SPECIAL GRADIENT ROUTINES.
C        NOTE THAT THIS IS NOT INTENDED TO BE A GENERAL ROUTINE
C        FOR DECIDING ON PIPELINE LENGTHS, BUT RATHER AS THE NAME
C        OF THE ROUTINE IMPLIES, IS SPECIFIC TO THE GRADIENT CODES.
C
C        THE CRAY-X1 VALUE WAS SELECTED BY TED PACKWOOD IN 2003
C
*CRY  IGETGRDVECLEN = 24
*CX1  IGETGRDVECLEN = 4
*FUJ  IGETGRDVECLEN = 24
*IBM  IGETGRDVECLEN = 24
*NEC  IGETGRDVECLEN = 24
      RETURN
      END
C*MODULE UNPORT  *DECK LOGAND
      INTEGER FUNCTION LOGAND(IVAL,JVAL)
      INTEGER IVAL,JVAL
C
C     RETURN LOGICAL AND OF ALL BITS IN THE INTEGERS IVAL, JVAL
C
*AMD  INTEGER AND
*CRY  INTEGER AND
*CX1  INTEGER AND
*DEC  INTEGER AND
*F2C  INTEGER AND
*NEC  INTEGER AND
*SGI  INTEGER AND
*SUN  INTEGER AND
*T3E  INTEGER AND
*WIN  INTEGER AND
C
*AIX  LOGAND = IAND(IVAL,JVAL)
*AMD  LOGAND =  AND(IVAL,JVAL)
*CRY  LOGAND =  AND(IVAL,JVAL)
*CX1  LOGAND =  AND(IVAL,JVAL)
*DEC  LOGAND =  AND(IVAL,JVAL)
*F2C  LOGAND =  AND(IVAL,JVAL)
*F77  LOGAND = 0
*F77  IF (IVAL .GE. JVAL) LOGAND = 1
*FUJ  LOGAND = IAND(IVAL,JVAL)
*HIT  LOGAND = IAND(IVAL,JVAL)
*HP   LOGAND = IAND(IVAL,JVAL)
*IBM  LOGAND = IAND(IVAL,JVAL)
*ITA  LOGAND = IAND(IVAL,JVAL)
*NEC  LOGAND =  AND(IVAL,JVAL)
*SGI  LOGAND =  AND(IVAL,JVAL)
*SUN  LOGAND =  AND(IVAL,JVAL)
*T3E  LOGAND =  AND(IVAL,JVAL)
*VMS  LOGAND = IAND(IVAL,JVAL)
*WIN  LOGAND =  AND(IVAL,JVAL)
*XT3  LOGAND =  AND(IVAL,JVAL)
      RETURN
      END
C
C*MODULE UNPORT  *DECK LOGOR
      INTEGER FUNCTION LOGOR(IVAL,JVAL)
      INTEGER IVAL,JVAL
C
C     RETURN LOGICAL OR OF ALL BITS IN THE INTEGERS IVAL, JVAL
C
*AIX  INTEGER OR
*AMD  INTEGER OR
*CRY  INTEGER OR
*CX1  INTEGER OR
*DEC  INTEGER OR
*F2C  INTEGER OR
*NEC  INTEGER OR
*SGI  INTEGER OR
*SUN  INTEGER OR
*T3E  INTEGER OR
*WIN  INTEGER OR
C
*AIX  LOGOR =  OR(IVAL,JVAL)
*AMD  LOGOR =  OR(IVAL,JVAL)
*CRY  LOGOR =  OR(IVAL,JVAL)
*CX1  LOGOR =  OR(IVAL,JVAL)
*DEC  LOGOR =  OR(IVAL,JVAL)
*F2C  LOGOR =  OR(IVAL,JVAL)
*F77  LOGOR = 0
*F77  IF (IVAL.NE.0.AND.JVAL.NE.0) LOGOR = 1
*FUJ  LOGOR = IOR(IVAL,JVAL)
*HIT  LOGOR = IOR(IVAL,JVAL)
*HP   LOGOR = IOR(IVAL,JVAL)
*IBM  LOGOR = IOR(IVAL,JVAL)
*ITA  LOGOR = IOR(IVAL,JVAL)
*NEC  LOGOR =  OR(IVAL,JVAL)
*SGI  LOGOR =  OR(IVAL,JVAL)
*SUN  LOGOR =  OR(IVAL,JVAL)
*T3E  LOGOR =  OR(IVAL,JVAL)
*VMS  LOGOR = IOR(IVAL,JVAL)
*WIN  LOGOR =  OR(IVAL,JVAL)
*XT3  LOGOR =  OR(IVAL,JVAL)
      RETURN
      END
C
C*MODULE UNPORT  *DECK LOGSHF
      INTEGER FUNCTION LOGSHF(IVAL,JVAL)
      LOGSHF = ISHFT(IVAL,JVAL)
      RETURN
      END
C
C*MODULE UNPORT  *DECK LOGXOR
      INTEGER FUNCTION LOGXOR(IVAL,JVAL)
      INTEGER IVAL,JVAL
C
C     RETURN LOGICAL XOR OF ALL BITS IN THE INTEGERS IVAL, JVAL
C
*AIX  INTEGER XOR
*AMD  INTEGER XOR
*CRY  INTEGER XOR
*CX1  INTEGER XOR
*DEC  INTEGER XOR
*F2C  INTEGER XOR
*NEC  INTEGER XOR
*SGI  INTEGER XOR
*SUN  INTEGER XOR
*T3E  INTEGER XOR
*WIN  INTEGER XOR
C
*AIX  LOGXOR =  XOR(IVAL,JVAL)
*AMD  LOGXOR =  XOR(IVAL,JVAL)
*CRY  LOGXOR =  XOR(IVAL,JVAL)
*CX1  LOGXOR =  XOR(IVAL,JVAL)
*DEC  LOGXOR =  XOR(IVAL,JVAL)
*F2C  LOGXOR =  XOR(IVAL,JVAL)
*F77  LOGXOR = 0
*F77  IF (IVAL.NE.JVAL) LOGXOR = 1
*FUJ  LOGXOR =  XOR(IVAL,JVAL)
*HIT  LOGXOR = IEOR(IVAL,JVAL)
*HP   LOGXOR = IXOR(IVAL,JVAL)
*IBM  LOGXOR = IEOR(IVAL,JVAL)
*ITA  LOGXOR = IEOR(IVAL,JVAL)
*NEC  LOGXOR =  XOR(IVAL,JVAL)
*SGI  LOGXOR =  XOR(IVAL,JVAL)
*SUN  LOGXOR =  XOR(IVAL,JVAL)
*T3E  LOGXOR =  XOR(IVAL,JVAL)
*VMS  LOGXOR = IEOR(IVAL,JVAL)
*WIN  LOGXOR =  XOR(IVAL,JVAL)
*XT3  LOGXOR =  XOR(IVAL,JVAL)
      RETURN
      END
C
C*MODULE UNPORT  *DECK PARSET
      SUBROUTINE PARSET
      IMPLICIT DOUBLE PRECISION (A-H,O-Z)
      LOGICAL GOPARR,DSKWRK,MASWRK,DIRTRF
      COMMON /PAR   / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK
      COMMON /TRFOPT/ CUTTRF,NWDTRF,MPTRAN,ITRFAO,NOSYMT,IPURTF,DIRTRF
C
C     ----- SET CONTROL FOR PARALLEL COMPUTATION -----
C
C     ITRFAO CONTROLS AO INTEGRAL DISK STORAGE DURING CONVENTIONAL
C     INTEGRAL TRANSFORMATIONS, 1=DUPLICATE AO LIST IF COMMUNICATION
C     SPEED IS VERY POOR, E.G. ETHERNET, 2=DISTRIBUTE AO LIST BECAUSE
C     BROADCAST OF INTEGRALS MAY BE MORE EFFICIENT THAN DISK I/O, E.G.
C     THE SWITCH IN A SP2 MACHINE.  THIS VARIABLE CAN BE OVERRIDDEN
C     LATER BY INPUT IN $MP2 OR $TRANS GROUPS.
C
C     IBM AND COMPAQ/DIGITAL WORKSTATIONS WITH SLOWER NETWORKS WILL
C     PREFER TO USE DUPLICATED AO INTEGRAL LISTS IN THE INTEGRAL
C     TRANSFORMATIONS.  HOWEVER, THE IBM SP OR THE COMPAQ SUPERCLUSTER
C     WITH BETTER COMMUNICATIONS MIGHT LIKE TO HAVE THE DEFAULT BE
C     DUPLICATED AO INTEGRAL LISTS.  ANY SUCH MACHINE CAN USE A
C     "SED HACK" TO SELECT THE *TRF LINE BELOW.
C
      ITRFAO=1
C
*TRF  ITRFAO= 2
C
*FUJ  ITRFAO= 2
C
*HIT  ITRFAO= 2
C
*NEC  ITRFAO= 2
C
*CX1  ITRFAO= 2
C
*T3E  ITRFAO= 2
C
C          IPTIM IS AN INACTIVE OPTION, JUST TURN IT OFF
C
      IPTIM = 0
      RETURN
      END
C*MODULE UNPORT  *DECK SETFM
      SUBROUTINE SETFM(IPAR)
C-----------------------------------------------------------------------
C     ----- FAST MEMORY (FM) MANAGEMENT ROUTINES -----
C     NOTE THAT THERE ARE SIX ROUTINES, NAMELY
C        SETFM AND BIGFM ARE CALLED ONLY ONCE EACH,
C             TO OBTAIN AND RELEASE THE TOTAL MEMORY POOL.  IN UNIX,
C             THESE NORMALLY WIND UP CALLING 'MALLOC' AND 'FREE'.
C        VALFM, GETFM, RETFM ARE USED TOGETHER, AS TRIPLETS OF CALLS:
C           VALFM TELLS THE LOCATION OF THE AVAILABLE MEMORY
C           GETFM ASKS TO USE SOME OF THAT MEMORY
C           RETFM GIVES THE MEMORY BACK WHEN FINISHED
C              THESE TRIPLETS CAN BE NESTED, SO LONG AS THE CALLS
C              TO RETFM ARE IN REVERSE ORDER OF THE CALLS TO GETFM,
C              THAT IS TO SAY, THE IMPLEMENTATION IS A STACK.
C        GOTFM MAY BE USED TO LEARN THE TOTAL AMOUNT OF AVAILABLE
C              MEMORY, E.G. NOT YET COMMITTED BY GETFM'S.
C
C     ALL MEMORY CALCULATIONS HERE ARE TO BE BASED ON -WORDS-,
C     WHERE A WORD IS DEFINED AS BEING A 64 BIT QUANTITY.
C
C     SETFM(IPAR) - ON ENTRY, IPAR IS MAXIMUM MEMORY DESIRED BY USER.
C                   ON EXIT, IPAR IS MAXIMUM MEMORY ACTUALLY AVAILABLE.
C                   ALLOCATES THE MEMORY POOL FROM THE SYSTEM.
C
C     BIGFM(IPAR) - ON EXIT, IPAR IS MAXIMUM MEMORY EVER USED.
C                   FREES THE ENTIRE MEMORY POOL TO THE SYSTEM.
C
C     VALFM(IPAR) - ON EXIT, IPAR IS AN OFFSET (LTOP) TO THE HIGHEST
C                   POSITION IN MEMORY CURRENTLY USED.
C
C     GETFM(IPAR) - ON ENTRY, IPAR IS THE MEMORY PIECE REQUESTED.
C                   IT IS ALLOCATED AT LTOP+1, AFTER WHICH THE
C                   LTOP POINTER IS AUTOMATICALLY ADJUSTED UPWARDS.
C
C     RETFM(IPAR) - ON ENTRY, IPAR IS THE MEMORY PIECE TO BE FREED.
C                   THE LTOP POINTER IS AUTOMATICALLY ADJUSTED DOWN.
C
C     GOTFM(IPAR) - ON EXIT, IPAR IS THE CURRENTLY UNUSED MEMORY.
C
C--------------------------------------------------------------------
C
C     A TYPICAL MEMORY REQUEST SEQUENCE IS VALFM,GETFM,...,RETFM.
C     IT IS CRUCIAL THAT RETFM'S BE IN INVERSE ORDER OF GETFM CALLS.
C     THE DYNAMIC POOL DURING THE MIDDLE ELLIPSIS OF THE SEQUENCE
C
C         CALL VALFM,GETFM,...VALFM,GETFM,...RETFM,...RETFM
C     WITH ARG=      NEED1          NEED2    NEED2    NEED1
C
C     LOOKS LIKE THIS
C
C            .....RESERVED........      AVAILABLE
C            <-------><----------><---------------------->
C            X  NEED1    NEED2   Y                       Z
C
C     WHERE X=LOFFS, Y=LTOP, Z=MEMLIM
C
C     THERE ARE TWO IMPLEMENTATION STRATEGIES BELOW.
C
C     ONE APPROACH IS TO DECLARE A LARGE FIXED LENGTH ARRAY
C     X(MEMSIZ) JUST BELOW.  THE USER REQUESTED MEMORY -MEMLIM-
C     CANNOT EXCEED THE "STATIC" SIZE -MEMSIZ- UNLESS -MEMSIZ-
C     IS INCREASED HERE IN THE SOURCE, AND THE CODE RECOMPILED.
C
C     THE OTHER ALLOCATES ONLY A SINGLE WORD X(1), AND ACTUALLY
C     ALLOCATES THE POOL ELSEWHERE.  -LOFFS- MUST BE THE DISTANCE
C     IN WORDS FROM X(1) TO WHEREVER THIS POOL IS ALLOCATED.
C     THIS STRATEGY IS TRULY "DYNAMIC", THE CALL TO SETFM CAN REQUEST
C     ANY AMOUNT UP TO WHATEVER LIMITS THE OPERATING SYSTEM IMPOSES.
C     IN THIS CASE, -MEMSIZ- IS JUST A DEFAULT, NOT AN UPPER BOUND.
C
C-----------------------------------------------------------------------
C
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
C
      LOGICAL GOPARR,DSKWRK,MASWRK
C
      COMMON /FMPARM/ LTOP,LOFFS,LENHI,LOCMEM,MEMLIM,MEMOK
      COMMON /IOFILE/ IR,IW,IP,IS,IPK,IDAF,NAV,IODA(950)
      COMMON /MACHIN/ NWDVAR,MAXFM,MAXSM,LIMFM,LIMSM
      COMMON /PAR   / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK
C
*AIX  PARAMETER (MEMSIZ= 1 000 000)
*AIX  COMMON /FMCOM / X(1)
C
*AMD  PARAMETER (MEMSIZ= 1 000 000)
*AMD  COMMON /FMCOM / X(1)
C
*CRY  PARAMETER (MEMSIZ= 1 000 000)
*CRY  COMMON /FMCOM / X(1)
C
*CX1  PARAMETER (MEMSIZ= 1 000 000)
*CX1  COMMON /FMCOM / X(1)
C
*DEC  PARAMETER (MEMSIZ= 1 000 000)
*DEC  COMMON /FMCOM / X(1)
*DEC  EXTERNAL LOC
C
*F2C  PARAMETER (MEMSIZ= 1 000 000)
*F2C  COMMON /FMCOM / X(1)
C
*F77  PARAMETER (MEMSIZ= 1 000 000)
*F77  COMMON /FMCOM / X(MEMSIZ)
C
*FUJ  PARAMETER (MEMSIZ= 1 000 000)
*FUJ  COMMON /FMCOM / X(1)
C
*HIT  PARAMETER (MEMSIZ= 1 000 000)
*HIT  COMMON /FMCOM / X(1)
C
*HP   PARAMETER (MEMSIZ= 1 000 000)
*HP   COMMON /FMCOM / X(1)
C
*IBM  PARAMETER (MEMSIZ= 1 000 000)
*IBM  COMMON /FMCOM / X(MEMSIZ)
C
*ITA  PARAMETER (MEMSIZ= 1 000 000)
*ITA  COMMON /FMCOM / X(1)
C
*NEC  PARAMETER (MEMSIZ= 1 000 000)
*NEC  COMMON /FMCOM / X(1)
C
*SGI  PARAMETER (MEMSIZ= 1 000 000)
*SGI  COMMON /FMCOM / X(1)
C
*SUN  PARAMETER (MEMSIZ= 1 000 000)
*SUN  COMMON /FMCOM / X(1)
C
*T3E  PARAMETER (MEMSIZ= 1 000 000)
*T3E  COMMON /FMCOM / X(1)
C
*VMS  PARAMETER (MEMSIZ= 1 000 000)
*VMS  COMMON /FMCOM / X(1)
C
*WIN  PARAMETER (MEMSIZ= 1 000 000)
*WIN  COMMON /FMCOM / X(1)
*WIN    INTERFACE
*WIN        FUNCTION LADDRS(X)
*WIN        DOUBLE PRECISION X(1)
*WIN        !DEC$ ATTRIBUTES C::LADDRS
*WIN        !DEC$ ATTRIBUTES REFERENCE::X
*WIN        END FUNCTION LADDRS
*WIN    END INTERFACE
*WIN    INTERFACE
*WIN        FUNCTION MEMGET(MEMLIM)
*WIN        !DEC$ ATTRIBUTES C::MEMGET
*WIN        !DEC$ ATTRIBUTES REFERENCE::MEMLIM
*WIN        END FUNCTION MEMGET
*WIN    END INTERFACE
*WIN    INTERFACE
*WIN        FUNCTION MEMREL(LOCMEM)
*WIN        !DEC$ ATTRIBUTES C::MEMREL
*WIN        !DEC$ ATTRIBUTES REFERENCE::LOCMEM
*WIN        END FUNCTION MEMREL
*WIN    END INTERFACE
C
*XT3  PARAMETER (MEMSIZ= 1 000 000)
*XT3  COMMON /FMCOM / X(1)
C
C     ----- INITIALIZE FAST MEMORY (FM) MANAGEMENT -----
C     -LOCX- IS THE ADDRESS OF THE FIRST ELEMENT OF X.
C     FOR STATIC IMPLEMENTATIONS, THIS SHOULD BE JUST 1.
C
      LOCX = 1
*AIX  LOCX = LADDRS(X)
*AMD  LOCX = LOC(X)
*CRY  LOCX = LOC(X)
*CX1  LOCX = LOC(X)
*DEC  LOCX = LOC(X)
*F2C  LOCX = LADDRS(X)
*FUJ  LOCX = LADDRS(X)
*HIT  LOCX = LADDRS(X)
*HP   LOCX = LOC(X)
*ITA  LOCX = LOC(X)
*NEC  LOCX = LOC(X)
*NEC  CALL LADDRS(X,LOCX)
*SGI  LOCX = LOC(X)
*SUN  LOCX = LOC(X)
*T3E  LOCX = LOC(X)
*VMS  LOCX = %LOC(X)
*WIN  LOCX = LADDRS(X)
*XT3  LOCX = LOC(X)
C
C     -MEMLIM- IS THE DESIRED MAXIMUM SIZE OF THE MEMORY POOL.
C
      MEMLIM = IPAR
      IF (MEMLIM .LE. 0) MEMLIM = MEMSIZ
C
C     ----- CHECK FOR AVAILABILITY OF MEMORY -----
C     -MEMSIZ- IS AN ABSOLUTE BOUND FOR STATIC IMPLEMENTATIONS
C
      MEMAVL = MEMLIM
*F77  MEMAVL = MEMSIZ
*IBM  MEMAVL = MEMSIZ
C
      IF (MEMLIM .GT. MEMAVL) THEN
         IF (MASWRK)
     *   WRITE(IW,FMT='('' REQUESTED AMOUNT OF MEMORY ('',I10,
     *      '' WORDS) EXCEEDS THE AMOUNT AVAILABLE ('',I10,'')'')')
     *               MEMLIM,MEMAVL
         CALL ABRT
      END IF
C
C     ----- ALLOCATE THE DYNAMIC MEMORY POOL -----
C     -LOCMEM- IS THE STARTING ADDRESS OF THE DYNAMIC POOL.
C     FOR STATIC IMPLEMENTATIONS, THIS SHOULD JUST BE 1.
C
      LOCMEM = 1
*AIX  LOCMEM = MEMGET(MEMLIM)
*AMD  LOCMEM = MEMGET(MEMLIM)
*CRY  LOCMEM = MEMGET(MEMLIM)
*CX1  LOCMEM = MEMGET(MEMLIM)
*DEC  LOCMEM = MEMGET(MEMLIM)
*F2C  LOCMEM = MEMGET(MEMLIM)
*FUJ  LOCMEM = MEMGET(MEMLIM)
*HIT  LOCMEM = MEMGET(MEMLIM)
*HP   LOCMEM = MALLOC((MEMLIM+2)*8)
*ITA  LOCMEM = MEMGET(MEMLIM)
*NEC  CALL MEMGET(MEMLIM,LOCMEM)
*SGI  LOCMEM = MEMGET(MEMLIM)
*SUN  LOCMEM = MEMGET(MEMLIM)
*T3E  LOCMEM = MEMGET(MEMLIM)
*VMS  ISTAT = LIB$GET_VM(8*MEMLIM+MOD(LOCX,8),LOCMEM)
*VMS  IF (.NOT.ISTAT) CALL LIB$STOP(%VAL(ISTAT))
*WIN  LOCMEM = MEMGET(MEMLIM)
*XT3  LOCMEM = MEMGET(MEMLIM)
C
      IF (LOCMEM .EQ. 0) THEN
         IF (MASWRK) WRITE(IW,*) MEMLIM,' WORDS OF MEMORY UNAVAILABLE'
         CALL ABRT
      END IF
C
C         COMPUTE THE OFFSET -LOFFS- FROM X(1) TO THE BEGINNING
C         OF THE DYNAMIC POOL (E.G. BYTE TO WORD CONVERSION).
C         -LOFFS- WILL BE ZERO FOR STATIC IMPLEMENTATIONS.
C
      LOFFS = LOCMEM - LOCX
*AIX  LOFFS = (LOFFS+7)/8 + 1
*AMD  LOFFS = (LOFFS+7)/8 + 1
*CRY  LOFFS =  LOFFS
*CX1  LOFFS = (LOFFS+7)/8 + 1
*DEC  LOFFS = (LOFFS+7)/8 + 1
*FUJ  LOFFS = (LOFFS+7)/8 + 1
*F2C  LOFFS = (LOFFS+7)/8 + 1
*HIT  LOFFS = (LOFFS+7)/8 + 1
*HP   LOFFS = (LOFFS+7)/8 + 1
*ITA  LOFFS = (LOFFS+7)/8 + 1
*NEC  LOFFS = (LOFFS+7)/8 + 1
*SGI  LOFFS = (LOFFS+7)/8 + 1
*SUN  LOFFS = (LOFFS+7)/8 + 1
*T3E  LOFFS = (LOFFS+7)/8 + 1
*VMS  LOFFS = (LOFFS+7)/8 + 1
*WIN  LOFFS = (LOFFS+7)/8 + 1
*XT3  LOFFS = (LOFFS+7)/8 + 1
C
      LTOP  = 0
      LENHI = 0
      MEMOK = 99
C
C     ----- REPORT MEMORY AVAILABILITY -----
C
      MEMEXT = MEMAVL - MEMLIM
      IF (MASWRK) THEN
      IF (MEMEXT .NE. 0) THEN
         WRITE(IW,*) MEMLIM,' WORDS REQUESTED ',
     *               MEMAVL,' WORDS AVAILABLE ',
     *               MEMEXT,' WORDS REMAIN FREE'
      ELSE
         WRITE(IW,FMT='(1X,I10,'' WORDS OF MEMORY AVAILABLE'')') MEMLIM
      END IF
      END IF
C
C     SET /MACHIN/ VALUES.
C        MAXFM/SM  = TOTAL FAST/SLOW MEMORY IN DYNAMIC POOL.
C        LIMFM/SM  = TOP ADDRESS OF THE FAST/SLOW DYNAMIC POOL.
C     GAMESS DOES NOT CURRENTLY USE SLOW MEMORY.
C
      MAXFM = MEMLIM
      LIMFM = MEMLIM + LOFFS
      MAXSM = 0
      LIMSM = 0
C
      IPAR = MEMAVL
      RETURN
      END
C*MODULE UNPORT  *DECK BIGFM
      SUBROUTINE BIGFM(IPAR)
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      LOGICAL GOPARR,DSKWRK,MASWRK
      COMMON /FMPARM/ LTOP,LOFFS,LENHI,LOCMEM,MEMLIM,MEMOK
      COMMON /PAR   / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK
      COMMON /IOFILE/ IR,IW,IP,IS,IPK,IDAF,NAV,IODA(950)
C
C     ----- RETURN MAXIMUM MEMORY USED -----
C
      IF (MEMOK .NE. 99) RETURN
      MEMOK = 0
      IPAR = LENHI
      IF (MASWRK) WRITE(IW,*) IPAR,' WORDS OF DYNAMIC MEMORY USED'
      CALL FLSHBF(IW)
      CALL FLSHBF(IP)
C
C        ----- RELEASE MEMORY TO SYSTEM -----
C     STATIC IMPLEMENTATIONS SHOULDN'T DO ANYTHING HERE.
C
*AIX  CALL MEMREL(LOCMEM)
*AMD  CALL MEMREL(LOCMEM)
*CRY  CALL MEMREL(LOCMEM)
*CX1  CALL MEMREL(LOCMEM)
CDEC  CALL MEMREL(LOCMEM)    NOTE: ALPHA CORE DUMPS IF CALLED
*F2C  CALL MEMREL(LOCMEM)
*FUJ  CALL MEMREL(LOCMEM)
*HIT  CALL MEMREL(LOCMEM)
*HP   CALL FREE(LOCMEM)
*ITA  CALL MEMREL(LOCMEM)
*NEC  CALL MEMREL(LOCMEM)
*SGI  CALL MEMREL(LOCMEM)
*SUN  CALL MEMREL(LOCMEM)
*T3E  CALL MEMREL(LOCMEM)
*VMS  ISTAT = LIB$FREE_VM(8*MEMLIM,LOCMEM,)
*VMS  IF (.NOT.ISTAT) CALL LIB$STOP(%VAL(ISTAT))
*WIN  CALL MEMREL(LOCMEM)
*XT3  CALL MEMREL(LOCMEM)
      RETURN
      END
C*MODULE UNPORT  *DECK VALFM
      SUBROUTINE VALFM(IPAR)
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      COMMON /FMPARM/ LTOP,LOFFS,LENHI,LOCMEM,MEMLIM,MEMOK
C
C     ----- RETURN THE CURRENT TOP OF FM ARRAY -----
C
      IPAR = LTOP + LOFFS
      RETURN
      END
C*MODULE UNPORT  *DECK GETFM
      SUBROUTINE GETFM(IPAR)
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      LOGICAL GOPARR,DSKWRK,MASWRK
      COMMON /FMPARM/ LTOP,LOFFS,LENHI,LOCMEM,MEMLIM,MEMOK
      COMMON /IOFILE/ IR,IW,IP,IS,IPK,IDAF,NAV,IODA(950)
      COMMON /PAR   / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK
C
C         UNCOMMENT NEXT LINE AND ALSO IN -RETFM- FOR PLUMBING JOBS.
CLEAK IF(MASWRK) WRITE(IW,*) 'GETFM: ALLOCATING',IPAR
C
C     ----- RESERVE IPAR WORDS OF FM -----
C
      LTOP = LTOP + IPAR
      IF (LTOP .LE. MEMLIM ) THEN
         LENHI = MAX(LENHI,LTOP)
      ELSE
         WRITE(IW,9000) ME,LTOP,MEMLIM
         CALL ABRT
      END IF
      RETURN
C
 9000 FORMAT(1X,'***** ERROR: MEMORY REQUEST EXCEEDS AVAILABLE MEMORY'/
     *    1X,'PROCESS NO.',I5,' WORDS REQUIRED=',I10,' AVAILABLE=',I10)
      END
C*MODULE UNPORT  *DECK RETFM
      SUBROUTINE RETFM(IPAR)
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      COMMON /FMPARM/ LTOP,LOFFS,LENHI,LOCMEM,MEMLIM,MEMOK
C
C         UNCOMMENT NEXT LINES AND ALSO IN -GETFM- FOR PLUMBING JOBS.
CLEAK LOGICAL GOPARR,DSKWRK,MASWRK
CLEAK COMMON /IOFILE/ IR,IW,IP,IS,IPK,IDAF,NAV,IODA(950)
CLEAK COMMON /PAR   / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK
CLEAK IF(MASWRK) WRITE(IW,*) 'RETFM:  RETURNING',IPAR
C
C     ----- RETURN IPAR WORDS OF FM -----
C
      LTOP = LTOP - IPAR
      RETURN
      END
C*MODULE UNPORT  *DECK GOTFM
      SUBROUTINE GOTFM(IPAR)
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
      COMMON /FMPARM/ LTOP,LOFFS,LENHI,LOCMEM,MEMLIM,MEMOK
C
C     ----- RETURN NUMBER OF FREE WORDS IN FM -----
C
      IPAR = MEMLIM - LTOP
      RETURN
      END
C*MODULE UNPORT  *DECK TEXIT
      SUBROUTINE TEXIT(NCALL,NREST)
C
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
C
      LOGICAL PACK,GOPARR,DSKWRK,MASWRK
C
      COMMON /IOFILE/ IR,IW,IP,IS,IPK,IDAF,NAV,IODA(950)
      COMMON /RESTAR/ TIMLIM,IREST,NREC,INTLOC,IST,JST,KST,LST
      COMMON /OUTPUT/ NPRINT,ITOL,ICUT,NORMF,NORMP,NOPK
      COMMON /PAR   / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK
      COMMON /INTFIL/ NINTMX,NHEX,NTUPL,PACK,INTTYP,IGRDTYP
      COMMON /TMVALS/ TI,TX,TIM
C
      CALL TIMIT(NCALL)
      IF (TIM .LT. TIMLIM) RETURN
      IF (MASWRK) THEN
         WRITE(IW,9018)
         WRITE (IW,9008) TIMLIM,NPRINT,ITOL,ICUT,NORMF,NORMP,NOPK,
     *       NREST,IST,JST,KST,LST,NREC,INTLOC,NINTMX
      END IF
      CALL ABRT
      RETURN
C
 9008 FORMAT(F10.0,11I3,I10,2I5)
 9018 FORMAT(1X,'**** JOB HAS EXHAUSTED ITS CPU ALLOTMENT ****')
      END
C*MODULE UNPORT  *DECK TIMIT
      SUBROUTINE TIMIT(INDEX)
      IMPLICIT DOUBLE PRECISION(A-H,O-Z)
C
      LOGICAL GOPARR,DSKWRK,MASWRK
C
      COMMON /IOFILE/ IR,IW,IP,IS,IPK,IDAF,NAV,IODA(950)
      COMMON /PAR   / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK
      COMMON /TMVALS/ TI,TX,TIM
      COMMON /TIMING/ CPU,WALL
      COMMON /SIMDAT/ NACC,NREJ,IGOMIN,NRPA,IBWM,NACCT,NREJT,NRPAT,
     *                NPRTGO,IDPUNC,IGOFLG
C
C        COMPUTE AND PRINT INTERVAL CPU TIME
C        THIS IS CALLED WITH INDEX=0 ONLY FROM THE MAIN PROGRAM
C        ALL OTHER CALLS SHOULD PRINT THE INTERVAL TIME.
C
      CALL TSECND(TIM)
      TX = TIM-TI
      TI = TIM
      IF (INDEX .EQ. 0) RETURN
C
      RATIO=100.0D+00
      IF(WALL.GT.0.0D+00) RATIO = 100.0D+00*TIM/WALL
      TMINUT = TIM/60.0D+00
      IF(MASWRK.AND.NPRTGO.NE.2) THEN
         IF(GOPARR) THEN
            WRITE(IW,9010) TX,TIM,TMINUT,WALL,RATIO
         ELSE
            WRITE(IW,9000) TX,TIM,TMINUT,WALL,RATIO
         END IF
      END IF
      CALL FLSHBF(IW)
      CALL FLSHBF(IP)
      RETURN
C
 9000 FORMAT(1X,'STEP CPU TIME =',F9.2,
     *          ' TOTAL CPU TIME =',F11.1,' (',F7.1,' MIN)'/
     *       1X,'TOTAL WALL CLOCK TIME=',F11.1,
     *          ' SECONDS, CPU UTILIZATION IS',F7.2,'%')
 9010 FORMAT(1X,'ON NODE 0, STEP CPU TIME =',F9.2,
     *          ' TOTAL CPU TIME =',F11.1,' (',F7.1,' MIN)'/
     *       1X,'TOTAL WALL CLOCK TIME=',F11.1,
     *          ' SECONDS, CPU UTILIZATION IS',F7.2,'%')
      END
C*MODULE UNPORT  *DECK TMDATE
      SUBROUTINE TMDATE(TIMSTR)
C-----------------------------------------------------------------------
C     ----- RETURN REAL ARRAY CONTAINING 24 CHARACTER TIME STAMP -----
C           ANY FORMAT RESEMBLING "HH:MM:SS DD-MMM-YYYY" WILL DO.
C-----------------------------------------------------------------------
C
C            IBM RS/6000 RUNNING AIX
*AIX  DOUBLE PRECISION TIMSTR(3)
*AIX  CHARACTER*26 STAMP
*AIX  CALL FDATE_(STAMP)
*AIX  READ (UNIT=STAMP,FMT='(3A8)') TIMSTR
C
C        THE ROUTINE 'FDATE' FIRST APPEARED IN IBM'S XL FORTRAN AT
C        VERSION 2.3, RELEASED SEPTEMBER 1992.  IF YOU HAVE RECEIVED
C        AN UNRESOLVED EXTERNAL REFERENCE FOR 'FDATE', YOUR COMPILER
C        MUST BE AN ANTIQUE!  IN THIS CASE, YOU CAN USE OUR ORIGINAL
C        CODE WRITTEN FOR XL FORTRAN 1.0 RELEASED APRIL 1990, BELOW:
CAIX  DOUBLE PRECISION WALL,TIMSTR(3)
CAIX  CHARACTER*24 STAMP
CAIX  CHARACTER*3 MONTHS(12)
CAIX  DIMENSION IDAYS(12)
CAIX  INTEGER*4 IWALL
CAIX  DATA MONTHS/'JAN','FEB','MAR','APR','MAY','JUN',
CAIX *            'JUL','AUG','SEP','OCT','NOV','DEC'/
CAIX  DATA IDAYS/31,28,31, 30,31,30, 31,31,30, 31,30,31/
C
C     UGH!!!  AIX RETURNS THE NUMBER OF SECONDS SINCE 1-JAN-1970 GMT.
C     (GMT IS 6 HOURS AHEAD OF AMES'S CST).
C
CAIX  ISTAT = TIME(IWALL)
CAIX  ITZONE = 6
CAIX  IWALL = IWALL - ITZONE*3600
CAIX  WALL = IWALL
C         NLEAP IS LEAP YEARS AFTER 1970 --PRIOR-- TO THIS YEAR
CAIX  NDAY = WALL/86400.0D+00
CAIX  WALL = WALL - 86400.0D+00*NDAY
CAIX  NYEAR = NDAY/365.25
CAIX  NLEAP = (NYEAR+1)/4
CAIX  WALL = IWALL - 86400.0D+00*(NYEAR*365 + NLEAP)
CAIX  NYEAR = NYEAR+1970
CAIX  IF(MOD(NYEAR,4).EQ.0) IDAYS(2) = 29
C
CAIX  NDAY = WALL/86400.0D+00
CAIX  WALL = WALL - 86400.0D+00*NDAY
CAIX  NDAY = NDAY+1
CAIX  DO 1 M=1,12
CAIX     MONTH = M
CAIX     NDAY = NDAY - IDAYS(MONTH)
CAIX     IF(NDAY.LE.0) GO TO 2
CAIX1 CONTINUE
CAIX2 CONTINUE
CAIX  NDAY = NDAY + IDAYS(MONTH)
C
CAIX  NHOUR = WALL/3600.0D+00
CAIX  WALL = WALL - 3600.0D+00*NHOUR
CAIX  NMIN = WALL/60.0D+00
CAIX  WALL = WALL - 60.0D+00*NMIN
CAIX  NSEC = WALL
CAIX  WRITE(UNIT=STAMP,FMT=5) NHOUR,NMIN,NSEC,NDAY,MONTHS(MONTH),NYEAR
CAIX5 FORMAT(I2,':',I2.2,':',I2.2,' CST ',I2,'-',A3,'-',I4)
CAIX  READ(UNIT=STAMP,FMT='(3A8)') TIMSTR
C-----------------------------------------------------------------------
C
*AMD  DOUBLE PRECISION TIMSTR(3)
*AMD  CHARACTER*24 STAMP
*AMD  CALL FDATE(STAMP)
*AMD  READ(UNIT=STAMP,FMT='(3A8)') TIMSTR
C-----------------------------------------------------------------------
C
*CRY  DIMENSION TIMSTR(3)
*CRY  DATA BLANK/8H        /
*CRY  CALL CLOCK(TIMSTR(1))
*CRY  TIMSTR(2) = BLANK
*CRY  CALL DATE(TIMSTR(3))
C-----------------------------------------------------------------------
C
*CX1  DIMENSION TIMSTR(3)
*CX1  REAL*8 TTIMSTR(3)
*CX1  CHARACTER*8 DATESTR,TIMESTR
*CX1  DATA BLANK/8H        /
*CX1  EQUIVALENCE (TIMESTR,TTIMSTR(1))
*CX1  EQUIVALENCE (BLANK,TTIMSTR(2))
*CX1  EQUIVALENCE (DATESTR,TTIMSTR(3))
*CX1  CALL CLOCK(TIMESTR)
*CX1  CALL DATE(DATESTR)
*CX1  TIMSTR(1) = TTIMSTR(1)
*CX1  TIMSTR(2) = TTIMSTR(2)
*CX1  TIMSTR(3) = TTIMSTR(3)
C-----------------------------------------------------------------------
C
*DEC  EXTERNAL FDATE
*DEC  DOUBLE PRECISION TIMSTR(3)
*DEC  CHARACTER*24 FDATE,STAMP
*DEC  STAMP = FDATE()
*DEC  READ (UNIT=STAMP,FMT='(3A8)') TIMSTR
C-----------------------------------------------------------------------
C
C        FDATE IS IMPLEMENTED IN ZUNIX.C, NOT A SYSTEM LIBRARY CALL
*F2C  DOUBLE PRECISION TIMSTR(3)
*F2C  CHARACTER*24 STAMP
*F2C  CALL FDATE(STAMP)
*F2C  READ(UNIT=STAMP,FMT='(3A8)') TIMSTR
C-----------------------------------------------------------------------
C
*F77  DOUBLE PRECISION TIMSTR(3)
*F77  CHARACTER*24 STAMP
*F77  STAMP='HH:MM:SS DD-MMM-19YY    '
*F77  READ(UNIT=STAMP,FMT='(3A8)') TIMSTR
C-----------------------------------------------------------------------
C
*FUJ  EXTERNAL FDATE
*FUJ  DOUBLE PRECISION TIMSTR(3)
*FUJ  CHARACTER*24 FDATE,STAMP
*FUJ  STAMP = FDATE()
*FUJ  READ (UNIT=STAMP,FMT='(3A8)') TIMSTR
C-----------------------------------------------------------------------
C
*HIT  DOUBLE PRECISION BLANK,TIMSTR(3)
*HIT  CHARACTER*8 CLKSTR
*HIT  DATA BLANK/8H        /
C
*HIT  CALL CLOCK(IS,2)
*HIT  IM=IS/60
*HIT  IH=IM/60
*HIT  IM=IM-60*IH
*HIT  IS=IS-60*IM-3600*IH
*HIT  WRITE (UNIT=CLKSTR,FMT=1) IH,IM,IS
*HIT1 FORMAT(I2,':',I2,':',I2)
*HIT  READ  (UNIT=CLKSTR,FMT='(1A8)') TIMSTR(1)
C
*HIT  TIMSTR(2) = BLANK
*HIT  CALL DATE(TIMSTR(3))
C-----------------------------------------------------------------------
C
*HP   DOUBLE PRECISION TIMSTR(3)
*HP   CHARACTER*24 STAMP
*HP   CALL FDATE(STAMP)
*HP   READ (UNIT=STAMP,FMT='(3A8)') TIMSTR
C-----------------------------------------------------------------------
C
*IBM  DOUBLE PRECISION TIMSTR(3)
*IBM  CALL ZDATE(TIMSTR)
C-----------------------------------------------------------------------
C
*ITA  DOUBLE PRECISION TIMSTR(3)
*ITA  CHARACTER*24 STAMP
*ITA  CALL FDATE(STAMP)
*ITA  READ(UNIT=STAMP,FMT='(3A8)') TIMSTR
C-----------------------------------------------------------------------
C
*NEC  DOUBLE PRECISION TIMSTR(3)
*NEC  CHARACTER*24 DATSTR
*NEC  CALL FDATE(DATSTR)
*NEC  READ (UNIT=DATSTR,FMT='(3A8)') TIMSTR
C-----------------------------------------------------------------------
C
*SGI  DOUBLE PRECISION TIMSTR(3)
*SGI  CHARACTER*24 FDATE
*SGI  READ (UNIT=FDATE(),FMT='(3A8)') TIMSTR
C-----------------------------------------------------------------------
C
*SUN  DOUBLE PRECISION TIMSTR(3)
*SUN  CHARACTER*24 DATSTR
*SUN  CALL FDATE(DATSTR)
*SUN  READ (UNIT=DATSTR,FMT='(3A8)') TIMSTR
C-----------------------------------------------------------------------
C
*T3E  DIMENSION TIMSTR(3)
*T3E  DATA BLANK/8H        /
*T3E  CALL CLOCK(TIMSTR(1))
*T3E  TIMSTR(2) = BLANK
*T3E  CALL DATE(TIMSTR(3))
C-----------------------------------------------------------------------
C
*VMS  DIMENSION TIMSTR(6)
*VMS  DATA BLANK/4H    /
*VMS  CALL TIME(TIMSTR)
*VMS  TIMSTR(3)=BLANK
*VMS  TIMSTR(6)=BLANK
*VMS  CALL DATE(TIMSTR(4))
C-----------------------------------------------------------------------
C
*WIN  DOUBLE PRECISION TIMSTR(3)
*WIN  CHARACTER*24 STAMP
*WIN  CALL FDATE(STAMP)
*WIN  READ(UNIT=STAMP,FMT='(3A8)') TIMSTR
C-----------------------------------------------------------------------
C
*XT3  DOUBLE PRECISION TIMSTR(3)
*XT3  CHARACTER*24 STAMP
*XT3  CALL FDATE(STAMP)
*XT3  READ(UNIT=STAMP,FMT='(3A8)') TIMSTR
C-----------------------------------------------------------------------
C
      RETURN
      END
C*MODULE UNPORT  *DECK TSECND
      SUBROUTINE TSECND(TIM)
C-----------------------------------------------------------------------
C       ----- THIS ROUTINE PERFORMS CPU AND WALL CLOCK TIMING -----
C
C       THIS ROUTINE SHOULD SET 'CPU' AND 'WALL' VARIABLES
C       TO THE TOTAL ELAPSED CPU AND WALL CLOCK TIMES,
C       MEASURED IN SECONDS.  IN ADDITION, THE CALLING
C       ARGUMENT 'TIM' SHOULD BE SET EQUAL TO 'CPU'.
C
C       ON THE FIRST ENTRY, 'CPU0' AND 'WALL0' SHOULD BE SET
C       TO THE APPROPRIATE BASE VALUE ON JOB START.
C
C-----------------------------------------------------------------------
C
C                       >>>>> UNIX NOTE <<<<<
C
C     DEPENDING ON JUST WHAT UNIX YOU ARE USING, ETIME IS EITHER
C     SINGLE OR DOUBLE PRECISION (DOUBLE ON THE CELERITY AND ALLIANT).
C     SOME SYSTEMS ALSO DON'T RETURN THE SUM OF USER AND SYSTEM
C     TIME AS THE FUNCTION VALUE.  THEREFORE, THE MOST PORTABLE
C     WAY OF DOING THIS TIMING IS TO ADD THE USER AND SYSTEM TIMES
C     RETURNED IN TARRAY, WHICH SEEMS TO BE SINGLE PRECISION ON
C     ALL UNIX SYSTEMS THUS FAR TESTED.
C
C-----------------------------------------------------------------------
C      * * * *  IBM RUNNING AIX PORTION  * * * *
C
*AIX  IMPLICIT DOUBLE PRECISION(A-H,O-Z)
*AIX  REAL*4 ETIME_
*AIX  TYPE TB_TYPE
*AIX    SEQUENCE
*AIX    REAL*4 USRTIME
*AIX    REAL*4 SYSTIME
*AIX  END TYPE
*AIX  TYPE (TB_TYPE) ETIME_STRUCT
*AIX  INTEGER*4 TIME_
*AIX  LOGICAL FIRST
*AIX  COMMON /TIMING/ CPU,WALL
*AIX  SAVE FIRST,CPU0,WALL0
*AIX  DATA FIRST/.TRUE./
C
C       ----- INITIALIZE CLOCKS -----
C
*AIX  IF(FIRST) THEN
*AIX     FIRST = .FALSE.
*AIX     CPU0  = ETIME_(ETIME_STRUCT)
*AIX     WALL0 = TIME_()
*AIX  END IF
C
C       ----- OBTAIN ELAPSED TIMES SINCE JOB STARTED -----
C
*AIX  CPU  = ETIME_(ETIME_STRUCT)
*AIX  CPU  = CPU - CPU0
*AIX  WALL = TIME_()
*AIX  WALL = WALL - WALL0
*AIX  TIM  = CPU
*AIX  RETURN
C
C        THE ROUTINE 'ETIME' FIRST APPEARED IN IBM'S XL FORTRAN AT
C        VERSION 2.3, RELEASED SEPTEMBER 1992.  IF YOU HAVE RECEIVED
C        AN UNRESOLVED EXTERNAL REFERENCE FOR 'ETIME', YOUR COMPILER
C        MUST BE AN ANTIQUE!  IN THIS CASE, YOU CAN USE OUR ORIGINAL
C        CODE WRITTEN FOR XL FORTRAN 1.0 RELEASED APRIL 1990, BELOW:
CAIX  DOUBLE PRECISION CPU0,WALL0,CPU,WALL,TIM
CAIX  LOGICAL FIRST
CAIX  INTEGER*4 BUF(4)
CAIX  INTEGER*4 IWALL
CAIX  PARAMETER (TCFCTR=100.0D+00)
CAIX  COMMON /TIMING/ CPU,WALL
CAIX  SAVE FIRST,CPU0,WALL0
CAIX  DATA FIRST/.TRUE./
C
CAIX  IF(FIRST) THEN
CAIX     FIRST=.FALSE.
CAIX     ISTAT = TIME(IWALL)
CAIX     WALL0 = IWALL
CAIX     CPU0 = 0.0D+00
CAIX  END IF
C
CAIX  ISTAT = TIME(IWALL)
CAIX  WALL = IWALL
CAIX  WALL = WALL-WALL0
CAIX  ISTAT = TIMES(BUF)
CAIX  USER   = BUF(1)/TCFCTR
CAIX  SYSTEM = BUF(2)/TCFCTR
CAIX  CPU = USER+SYSTEM
CAIX  CPU = CPU-CPU0
CAIX  TIM = CPU
CAIX  RETURN
C-----------------------------------------------------------------------
C     AMD64-PGI SPECIFIC PORTION
C
*AMD  IMPLICIT DOUBLE PRECISION(A-H,O-Z)
*AMD  EXTERNAL ETIME,TIME
*AMD  REAL ETIME
*AMD  INTEGER TIME
*AMD  REAL TARRAY(2)
*AMD  LOGICAL FIRST
*AMD  COMMON /TIMING/ CPU,WALL
*AMD  SAVE FIRST,CPU0,WALL0
*AMD  DATA FIRST/.TRUE./
C
*AMD  IF(FIRST) THEN
*AMD     FIRST = .FALSE.
*AMD     DUMMY = ETIME(TARRAY)
*AMD     CPU0  = TARRAY(1)+TARRAY(2)
*AMD     WALL0 = TIME()
*AMD  END IF
C
*AMD  DUMMY = ETIME(TARRAY)
*AMD  CPU   = TARRAY(1)+TARRAY(2)
*AMD  CPU   = CPU - CPU0
*AMD  WALL  = TIME()
*AMD  WALL  = WALL - WALL0
*AMD  TIM   = CPU
*AMD  RETURN
C-----------------------------------------------------------------------
C      * * * *  CRAY (UNICOS) SPECIFIC PORTION  * * * *
C
*CRY  REAL CPU0,WALL0,CPU,WALL,TIM
*CRY  LOGICAL FIRST
*CRY  COMMON /TIMING/ CPU,WALL
*CRY  SAVE FIRST,CPU0,WALL0
*CRY  DATA FIRST/.TRUE./
C
C       ----- INITIALIZE CLOCKS -----
C
*CRY  IF(FIRST) THEN
*CRY     FIRST=.FALSE.
*CRY     CPU0 = 0.0E+00
*CRY     WALL0 = TIMEF()
*CRY     WALL0 = 0.001E+00*WALL0
*CRY  END IF
C
C       ----- OBTAIN ELAPSED TIMES SINCE JOB STARTED -----
C
*CRY  CALL SECOND(CPU)
*CRY  WALL = TIMEF()
*CRY  WALL = 0.001E+00 * WALL - WALL0
*CRY  TIM = CPU
*CRY  RETURN
C
C-----------------------------------------------------------------------
C      * * * *  CRAY X1 SPECIFIC PORTION  * * * *
C
*CX1  REAL CPU0,CPU,TIM,WALL0,WALL
*CX1  REAL*4 SECOND
*CX1  LOGICAL FIRST
*CX1  COMMON /TIMING/ CPU,WALL
*CX1  SAVE FIRST,CPU0,WALL0
*CX1  DATA FIRST/.TRUE./
C
C       ----- INITIALIZE CLOCKS -----
C
*CX1  IF(FIRST) THEN
*CX1     FIRST=.FALSE.
*CX1     CPU0 = 0.0E+00
*CX1     WALL0 = TIMEF()
*CX1     WALL0 = 0.001E+00*WALL0
*CX1  END IF
C
C       ----- OBTAIN ELAPSED TIMES SINCE JOB STARTED -----
C
*CX1  CPU = SECOND()
*CX1  WALL = TIMEF()
*CX1  WALL = 0.001E+00 * WALL - WALL0
*CX1  TIM = CPU
*CX1  RETURN
C
C-----------------------------------------------------------------------
C      * * * *  DECSTATION SPECIFIC PORTION  * * * *
C
*DEC  IMPLICIT DOUBLE PRECISION(A-H,O-Z)
C        --EXTERNAL STATEMENT NEEDED HERE
*DEC  EXTERNAL ETIME,TIME
*DEC  DOUBLE PRECISION ETIME
*DEC  REAL TARRAY(2)
*DEC  INTEGER TIME
*DEC  LOGICAL FIRST
*DEC  COMMON /TIMING/ CPU,WALL
*DEC  SAVE FIRST,CPU0,WALL0
*DEC  DATA FIRST/.TRUE./
C
C       ----- INITIALIZE CLOCKS -----
C
*DEC  IF(FIRST) THEN
*DEC     FIRST=.FALSE.
*DEC     DUMMY = ETIME(TARRAY)
*DEC     CPU0 = TARRAY(1)+TARRAY(2)
*DEC     WALL0 = TIME()
*DEC  END IF
C
C       ----- OBTAIN ELAPSED TIMES SINCE JOB STARTED -----
C
*DEC  DUMMY = ETIME(TARRAY)
*DEC  CPU = TARRAY(1)+TARRAY(2)
*DEC  CPU = CPU - CPU0
*DEC  WALL = TIME()
*DEC  WALL = WALL - WALL0
*DEC  TIM = CPU
*DEC  RETURN
C
C-----------------------------------------------------------------------
C           * * * *  PC-UNIX SPECIFIC PORTION  * * * *
C     THIS PART USES A CUSTOM VERSION OF -ETIME- IMPLEMENTED IN ZUNIX.C
C     IN PARTICULAR, NOTE THAT THIS ETIME WILL RETURN THE ELAPSED TIME,
C     MEANING WALL CLOCK TIME, WHICH DIFFERS FROM THE STANDARD RETURN
C     VALUE OF THIS ROUTINE IN EVERY OTHER FLAVOR OF UNIX, NAMELY CPU.
C
*F2C  DOUBLE PRECISION CPU0,WALL0,CPU,WALL,TIM
*F2C  EXTERNAL ETIME
*F2C  DOUBLE PRECISION ETIME
*F2C  REAL TARRAY(2)
*F2C  LOGICAL FIRST
*F2C  COMMON /TIMING/ CPU,WALL
*F2C  SAVE FIRST,CPU0,WALL0
*F2C  DATA FIRST/.TRUE./
C
*F2C  IF(FIRST) THEN
*F2C     TARRAY(1)=0.0E+00
*F2C     FIRST=.FALSE.
*F2C     WALL0 = ETIME(TARRAY)
*F2C     CPU0 = TARRAY(1)+TARRAY(2)
*F2C  END IF
C
*F2C  WALL = ETIME(TARRAY)
*F2C  CPU = TARRAY(1)+TARRAY(2)
*F2C  CPU = CPU - CPU0
*F2C  WALL = WALL - WALL0
*F2C  TIM = CPU
*F2C  RETURN
C-----------------------------------------------------------------------
C      * * * *  GENERIC FORTRAN 77 SPECIFIC PORTION  * * * *
C
*F77  DOUBLE PRECISION CPU,WALL
*F77  COMMON /TIMING/ CPU,WALL
C
*F77  CPU = 0.0D+00
*F77  WALL =0.0D+00
*F77  RETURN
C
C-----------------------------------------------------------------------
C      * * * *  FUJITSU SPECIFIC PORTION  * * * *
C
*FUJ  IMPLICIT DOUBLE PRECISION(A-H,O-Z)
C        --EXTERNAL STATEMENT NEEDED HERE
*FUJ  EXTERNAL ETIME,TIME
*FUJ  DOUBLE PRECISION ETIME
*FUJ  REAL TARRAY(2)
*FUJ  INTEGER TIME
*FUJ  LOGICAL FIRST
*FUJ  COMMON /TIMING/ CPU,WALL
*FUJ  SAVE FIRST,CPU0,WALL0
*FUJ  DATA FIRST/.TRUE./
C
C       ----- INITIALIZE CLOCKS -----
C
*FUJ  IF(FIRST) THEN
*FUJ     FIRST=.FALSE.
*FUJ     DUMMY = ETIME(TARRAY)
*FUJ     CPU0 = TARRAY(1)+TARRAY(2)
*FUJ     WALL0 = TIME()
*FUJ  END IF
C
C       ----- OBTAIN ELAPSED TIMES SINCE JOB STARTED -----
C
*FUJ  DUMMY = ETIME(TARRAY)
*FUJ  CPU = TARRAY(1)+TARRAY(2)
*FUJ  CPU = CPU - CPU0
*FUJ  WALL = TIME()
*FUJ  WALL = WALL - WALL0
*FUJ  TIM = CPU
*FUJ  RETURN
C
C-----------------------------------------------------------------------
C      * * * *  HITACHI RUNNING HI-UX/MPP PORTION  * * * *
C
*HIT  DOUBLE PRECISION CPU,WALL,TIM
*HIT  LOGICAL FIRST
*HIT  COMMON /TIMING/ CPU,WALL
*HIT  DATA FIRST/.TRUE./
C
*HIT  IF(FIRST) THEN
*HIT     FIRST=.FALSE.
*HIT     CALL XCLOCK(DUMMY,3)
*HIT     CALL XCLOCK(DUMMY,7)
*HIT  END IF
C
*HIT  CALL XCLOCK(CPU,5)
*HIT  CALL XCLOCK(WALL,8)
*HIT  TIM = CPU
*HIT  RETURN
C
C-----------------------------------------------------------------------
C      * * * *  HP 9000 SPECIFIC PORTION  * * * *
C
*HP   DOUBLE PRECISION CPU0,WALL0,CPU,WALL,TIM
*HP   EXTERNAL ETIME,TIME
*HP   REAL ETIME
*HP   REAL TARRAY(2)
*HP   INTEGER TIME
*HP   LOGICAL FIRST
*HP   COMMON /TIMING/ CPU,WALL
*HP   SAVE FIRST,CPU0,WALL0
*HP   DATA FIRST/.TRUE./
*HP   IF(FIRST) THEN
*HP      FIRST=.FALSE.
*HP      CPU0 = ETIME(TARRAY)
*HP      WALL0 = TIME()
*HP   END IF
*HP   CPU = ETIME(TARRAY)
*HP   CPU = CPU - CPU0
*HP   WALL = TIME()
*HP   WALL = WALL - WALL0
*HP   TIM = CPU
*HP   RETURN
C
C-----------------------------------------------------------------------
C      * * * *  IBM MAINFRAME SPECIFIC PORTION  * * * *
C
*IBM  DOUBLE PRECISION CPU0,WALL0,CPU,WALL,TIM
*IBM  LOGICAL FIRST
*IBM  COMMON /TIMING/ CPU,WALL
*IBM  SAVE FIRST,CPU0,WALL0
*IBM  DATA FIRST/.TRUE./
C
C       ----- INITIALIZE CLOCKS -----
C
*IBM  IF(FIRST) THEN
*IBM     FIRST=.FALSE.
*IBM     WALL0 =0.0D+00
*IBM     CPU0 =0.0D+00
*IBM     CALL ZTIME1(WALL0,CPU0)
*IBM  END IF
C
C       ----- OBTAIN ELAPSED TIMES SINCE JOB STARTED -----
C
*IBM  CPU = CPU0
*IBM  WALL = WALL0
*IBM  CALL ZTIME2(WALL,CPU)
*IBM  TIM = CPU
*IBM  RETURN
C
C-----------------------------------------------------------------------
C           * * * *  ITANIUM-LINUX SPECIFIC PORTION  * * * *
C
*ITA  DOUBLE PRECISION CPU0,WALL0,CPU,WALL,TIM
*ITA  REAL*4 ETIME,TIMEF,DUMMY,TARRAY(2)
*ITA  LOGICAL FIRST
*ITA  INTEGER TIME
*ITA  COMMON /TIMING/ CPU,WALL
*ITA  SAVE FIRST,CPU0,WALL0
*ITA  DATA FIRST/.TRUE./
C
*ITA  IF(FIRST) THEN
*ITA     FIRST=.FALSE.
*ITA     DUMMY = ETIME(TARRAY)
*ITA     CPU0 = TARRAY(1)+TARRAY(2)
*ITA     WALL0 = TIMEF()
*ITA  END IF
C
*ITA  DUMMY = ETIME(TARRAY)
*ITA  CPU = TARRAY(1)+TARRAY(2)
*ITA  CPU = CPU - CPU0
*ITA  WALL = TIMEF()
*ITA  WALL = WALL - WALL0
*ITA  TIM = CPU
*ITA  RETURN
C-----------------------------------------------------------------------
C                  * * * NEC SX (SUPER-UX) * * *
*NEC  LOGICAL FIRST
*NEC  COMMON /TIMING/ CPU,WALL
*NEC  SAVE FIRST,CPU0,WALL0
*NEC  DATA FIRST/.TRUE./
*NEC  CHARACTER*8 SXDAT
C
*NEC  IF(FIRST) THEN
*NEC     FIRST=.FALSE.
*NEC     ITIC = MCLOCK()
*NEC     CPU0 = ITIC * 0.005
*NEC     CALL DATIM(SXDAT,SXTIM,3)
*NEC     WALL0 = SXTIM*3600.E0
*NEC  END IF
C
*NEC  ITIC = MCLOCK()
*NEC  CPU  = ITIC * 0.005
*NEC  CPU = CPU - CPU0
*NEC  CALL DATIM(SXDAT,SXTIM,3)
*NEC  WALL  = SXTIM*3600.E0
*NEC  WALL = WALL - WALL0
*NEC  TIM = CPU
*NEC  RETURN
C-----------------------------------------------------------------------
C
C                  * * * SILICON GRAPHICS * * *
*SGI  IMPLICIT DOUBLE PRECISION(A-H,O-Z)
*SGI  EXTERNAL TIME
*SGI  DOUBLE PRECISION ETIME
*SGI  REAL TARRAY(2)
*SGI  INTEGER TIME
*SGI  LOGICAL FIRST
*SGI  COMMON /TIMING/ CPU,WALL
*SGI  SAVE FIRST,CPU0,WALL0
*SGI  DATA FIRST/.TRUE./
C
*SGI  IF(FIRST) THEN
*SGI     FIRST=.FALSE.
*SGI     DUMMY = ETIME(TARRAY)
*SGI     CPU0 = TARRAY(1)+TARRAY(2)
*SGI     WALL0 = TIME()
*SGI  END IF
C
*SGI  DUMMY = ETIME(TARRAY)
*SGI  CPU = TARRAY(1)+TARRAY(2)
*SGI  CPU = CPU - CPU0
*SGI  WALL = TIME()
*SGI  WALL = WALL - WALL0
*SGI  TIM = CPU
*SGI  RETURN
C
C-----------------------------------------------------------------------
C                  * * * SUN WORKSTATIONS * * *
*SUN  IMPLICIT DOUBLE PRECISION(A-H,O-Z)
*SUN  REAL ETIME,TARRAY(2)
*SUN  INTEGER TIME
*SUN  LOGICAL FIRST
*SUN  COMMON /TIMING/ CPU,WALL
*SUN  SAVE FIRST,CPU0,WALL0
*SUN  DATA FIRST/.TRUE./
C
*SUN  IF(FIRST) THEN
*SUN     FIRST=.FALSE.
*SUN     DUMMY = ETIME(TARRAY)
*SUN     CPU0 = TARRAY(1)+TARRAY(2)
*SUN     WALL0 = TIME()
*SUN  END IF
C
*SUN  DUMMY = ETIME(TARRAY)
*SUN  CPU = TARRAY(1)+TARRAY(2)
*SUN  CPU = CPU - CPU0
*SUN  WALL = TIME()
*SUN  WALL = WALL - WALL0
*SUN  TIM = CPU
*SUN  RETURN
C
C-----------------------------------------------------------------------
C      * * * *  CRAY T3E SPECIFIC PORTION  (IDENTICAL TO *CRY) * * * *
C
*T3E  REAL CPU0,WALL0,CPU,WALL,TIM
*T3E  LOGICAL FIRST
*T3E  COMMON /TIMING/ CPU,WALL
*T3E  SAVE FIRST,CPU0,WALL0
*T3E  DATA FIRST/.TRUE./
C
C       ----- INITIALIZE CLOCKS -----
C
*T3E  IF(FIRST) THEN
*T3E     FIRST=.FALSE.
*T3E     CPU0 = 0.0E+00
*T3E     WALL0 = TIMEF()
*T3E     WALL0 = 0.001E+00*WALL0
*T3E  END IF
C
C       ----- OBTAIN ELAPSED TIMES SINCE JOB STARTED -----
C
*T3E  CALL SECOND(CPU)
*T3E  WALL = TIMEF()
*T3E  WALL = 0.001E+00 * WALL - WALL0
*T3E  TIM = CPU
*T3E  RETURN
C
C-----------------------------------------------------------------------
C      * * * *  VMS SPECIFIC PORTION  * * * *
C
*VMS  DOUBLE PRECISION CPU0,WALL0,CPU,WALL,TIM
*VMS  CHARACTER*8 BUF
*VMS  LOGICAL FIRST,GOPARR,DSKWRK,MASWRK
*VMS  INTEGER CPUTIM, ITMLST(4), SYS$GETJPI
*VMS  PARAMETER JPI$_CPUTIM = '04070004'X   ! ACCUMULATED CPU, 10 MS
*VMS  COMMON /PAR   / ME,MASTER,NPROC,IBTYP,IPTIM,GOPARR,DSKWRK,MASWRK
*VMS  COMMON /TIMING/ CPU,WALL
*VMS  SAVE FIRST,CPU0,WALL0
*VMS  DATA FIRST/.TRUE./
C
C       ----- INITIALIZE CLOCKS -----
C
*VMS  IF(FIRST) THEN
*VMS     FIRST=.FALSE.
C              INITIALIZE ITEM LIST FOR VMS GETJPI
*VMS     ITMLST(1) = JPI$_CPUTIM  ! SET ITEM CODE, INCLUDING LENGTH
*VMS     ITMLST(2) = %LOC(CPUTIM) ! LOCATION OF CPUTIM VARIABLE
*VMS     ITMLST(3) = 0            ! LENGTH NOT NEEDED
*VMS     ITMLST(4) = 0            ! TERMINATE ITMLST
C              GET CPUTIM INFORMATION FROM GETJPI
*VMS     IF( .NOT. SYS$GETJPI(,,,ITMLST,,,) .AND. MASWRK)
*VMS *      WRITE(6,*) 'GETJPI ERROR'
*VMS     CPU0=CPUTIM*0.01D+00
C              NOW GET STARTING WALL TIME
*VMS     CALL IDATE(MONTH0,IDAY,IYEAR)
*VMS     CALL TIME(BUF)
*VMS     READ(UNIT=BUF,FMT='(I2,1X,I2,1X,I2)') IHH,IMM,ISS
*VMS     WALL0 = ((IDAY*24.0+IHH)*60.0+IMM)*60.0+ISS
*VMS  END IF
C
C       ----- OBTAIN ELAPSED TIMES SINCE JOB STARTED -----
C   (INCORRECT OVER MONTH END, IF YEAR END OR IF PREV. MONTH.NE.31 DAYS)
C
*VMS  IF( .NOT. SYS$GETJPI(,,,ITMLST,,,) .AND. MASWRK)
*VMS *   WRITE(6,*) 'GETJPI ERROR'
*VMS  CPU=CPUTIM*0.01D+00 - CPU0
*VMS  CALL IDATE(MONTH,IDAY,IYEAR)
*VMS  IF(MONTH.GT.MONTH0) IDAY=IDAY+31   ! WELL, SOME MONTHS ANYWAY
*VMS  CALL TIME(BUF)
*VMS  READ(UNIT=BUF,FMT='(I2,1X,I2,1X,I2)') IHH,IMM,ISS
*VMS  WALL = ((IDAY*24.0+IHH)*60.0+IMM)*60.0+ISS - WALL0
*VMS  TIM=CPU
*VMS  RETURN
C
C-----------------------------------------------------------------------
C           * * * *  MS WINDOWS (WIN32) SPECIFIC PORTION  * * * *
C
*WIN  DOUBLE PRECISION CPU0,WALL0,CPU,WALL,TIM
*WIN  EXTERNAL ETIME
*WIN  DOUBLE PRECISION ETIME
*WIN  REAL TARRAY(2)
*WIN  LOGICAL FIRST
*WIN  COMMON /TIMING/ CPU,WALL
*WIN  SAVE FIRST,CPU0,WALL0
*WIN  DATA FIRST/.TRUE./
C
*WIN  IF(FIRST) THEN
*WIN     FIRST=.FALSE.
*WIN     WALL0 = ETIME(TARRAY)
*WIN     CPU0 = TARRAY(1)+TARRAY(2)
*WIN  END IF
C
*WIN  WALL = ETIME(TARRAY)
*WIN  CPU = TARRAY(1)+TARRAY(2)
*WIN  CPU = CPU - CPU0
*WIN  WALL = WALL - WALL0
*WIN  TIM = CPU
*WIN  RETURN
C-----------------------------------------------------------------------
C           * * * *  CRAY XT3 SPECIFIC PORTION  * * * *
C
*XT3  DOUBLE PRECISION CPU0,WALL0,CPU,WALL,TIM,MPI_WTIME
*XT3  LOGICAL FIRST
*XT3  INTEGER TIME
*XT3  COMMON /TIMING/ CPU,WALL
*XT3  SAVE FIRST,CPU0,WALL0
*XT3  DATA FIRST/.TRUE./
C
*XT3  IF(FIRST) THEN
*XT3     FIRST=.FALSE.
*XT3     CALL CPU_TIME(CPU0)
*XT3     WALL0 = MPI_WTIME()
*XT3  END IF
C
*XT3  CALL CPU_TIME(CPU)
*XT3  CPU = CPU - CPU0
*XT3  WALL = MPI_WTIME()
*XT3  WALL = WALL - WALL0
*XT3  TIM = CPU
*XT3  RETURN
C-----------------------------------------------------------------------
C     THE END STATEMENT FOR THE ROUTINE ABOVE IS AT THE VERY END OF
C     THIS FILE, SO THAT WE CAN OBEY THE FORTRAN RULE THAT THERE
C     SHOULD BE NO COMMENTS AFTER THE LAST END STATEMENT.
C     ANY LITTLE DUMMY ROUTINES THAT ONLY ONE SYSTEM NEEDS GO HERE,
C     EACH MUST BEGIN WITH AN END STATEMENT FOR THE ABOVE ROUTINE.
C-----------------------------------------------------------------------
C
C        GETENV USING A POSIX CALL, USEFUL ON THE T3E
C
*T3E  END
*T3E  SUBROUTINE GETENV(NAME,VALUE)
*T3E  CHARACTER*(*) NAME,VALUE
C
*T3E  LENNAM = LEN(NAME)
*T3E  IF(LENNAM.LE.0) THEN
*T3E     WRITE(6,*) '--ERROR CALLING GETENV--'
*T3E     CALL ABRT
*T3E  END IF
*T3E  CALL PXFGETENV(NAME,LENNAM,VALUE,LENVAL,IERROR)
C
C        GETENV USING A POSIX CALL, USEFUL ON THE X1
C
*CX1  END
*CX1  SUBROUTINE GETENV(NAME,VALUE)
*CX1  CHARACTER*(*) NAME,VALUE
C
*CX1  LENNAM = LEN(NAME)
*CX1  IF(LENNAM.LE.0) THEN
*CX1     WRITE(6,*) '--ERROR CALLING GETENV--'
*CX1     CALL ABRT
*CX1  END IF
*CX1  CALL PXFGETENV(NAME,LENNAM,VALUE,LENVAL,IERROR)
C
      END
