1C 2C /* Deck so_memmax */ 3 SUBROUTINE SO_MEMMAX(SUBNM,MEMOFREE) 4C 5C This routine is part of the atomic integral direct SOPPA program. 6C 7C Stephan P. A. Sauer, 25 November 2003 8C 9C PURPOSE: Collect and print information about memory usage in SOPPA 10C calculation. 11C 12#include "implicit.h" 13#include "priunit.h" 14C 15#include "soppinf.h" 16C 17C 18 CHARACTER*(*) SUBNM 19 INTEGER MEMOFREE 20 PARAMETER (WORTOMB = 131072.D0) 21C 22 CHARACTER*56 LINE1,LINE2 23 REAL*8 SOMEMMB 24C 25 LINE1 = '|=====================================================|' 26 LINE2 = '|-----------------------------------------------------|' 27C 28C------------------------- 29C Initializes routine. 30C------------------------- 31C 32 IF (SUBNM(1:5) .EQ. 'START') THEN 33C 34 DO I = 1, LSOSUB 35 SOSUBNM(I) = ' ' 36 END DO 37C 38 ISOSUB = 1 39C 40 LWTOTAL = MEMOFREE 41C 42 LNM = LEN(SUBNM) 43 SOSUBNM(ISOSUB) = SUBNM(1:LNM) 44 SOMEMO(ISOSUB) = LWTOTAL - MEMOFREE 45C 46C-------------------------------- 47C Print memory statistics. 48C-------------------------------- 49C 50 ELSE IF (SUBNM(1:10) .EQ. 'STATISTICS') THEN 51C 52 WRITE(LUPRI,'(1X)') 53 WRITE(LUPRI,'(1X,A)') LINE1 54 WRITE(LUPRI,'(1X,A)') 55 & '| Memory statistics for AO-SOPPA subroutines |' 56 WRITE(LUPRI,'(1X,A)') LINE1 57 WRITE(LUPRI,'(1X,A)') 58 & '| Routine in Words in MB |' 59 WRITE(LUPRI,'(1X,A)') LINE2 60C 61 DO I = 1, ISOSUB 62C 63 SOMEMMB = SOMEMO(I)/WORTOMB 64 WRITE(LUPRI,'(1X,A3,A16,6X,I12,6X,F8.1,A4)') 65 & '| ',SOSUBNM(I),SOMEMO(I),SOMEMMB,' |' 66C 67 END DO 68 WRITE(LUPRI,'(1X,A)') LINE1 69C 70C---------------------------------------------------------------------- 71C Compares memory requirements with previous maximum. 72C If the new memory requirement is larger, adds it to the array. 73C---------------------------------------------------------------------- 74C 75 ELSE 76C 77 IF ( (LWTOTAL - MEMOFREE) .GT. SOMEMO(ISOSUB) ) THEN 78C 79 ISOSUB = ISOSUB + 1 80C 81 IF (ISOSUB .GT. LSOSUB) THEN 82C 83 WRITE(LUPRI,'(A,/,A,A)') 84 & 'ERROR: ISOSUB exceeds LSOSUB in SO_MEMMAX.', 85 & ' Recompile with larger value of LSOSUB ', 86 & ' in soppinf.h!' 87 CALL QUIT('ERROR: dimension to small in SO_MEMMAX') 88C 89 END IF 90C 91 LNM = LEN(SUBNM) 92 SOSUBNM(ISOSUB) = SUBNM(1:LNM) 93 SOMEMO(ISOSUB) = LWTOTAL - MEMOFREE 94C 95 END IF 96C 97 END IF 98C 99 CALL FLSHFO(LUPRI) 100C 101C 102 RETURN 103 END 104