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