1      subroutine memory_input(rtdb, ostore, stack_size, heap_size,
2     $     global_size, total_size, overify, ohardfail)
3C$Id$
4      implicit none
5#include "errquit.fh"
6#include "inp.fh"
7#include "mafdecls.fh"
8#include "rtdb.fh"
9#include "context.fh"
10      integer rtdb              ! [input]
11      logical ostore            ! [input]
12      integer stack_size        ! [output]
13      integer heap_size         ! [output]
14      integer global_size       ! [output]
15      integer total_size        ! [output]
16      logical overify           ! [output]
17      logical ohardfail         ! [output]
18c
19      character*8 user_units, ctest
20      double precision user_stack, user_heap, user_global, user_total
21      character*1 stack_Src, heap_Src, global_Src, total_Src
22      integer mem(3)            ! Used to stuff data into the rtdb
23      integer nunits
24      integer ind
25      integer meg,gig
26      character*255 name        ! Used to store info in the rtdb
27      logical memory_units
28      external memory_units
29      parameter (nunits = 9)
30      parameter (meg = 1024*1024)
31      parameter (gig = 1024*1024*1024)
32      integer conv_units(nunits)
33      character*8 units(nunits)
34      data units /'double','real','integer','byte','kb',
35     &            'mb','mw','gb','gw'/
36      data conv_units /1,1,1,1,1024,
37     &     meg,meg,gig,gig/
38c
39c     Parse memory directive
40c
41c     memory [[total] <total_size>] [stack <stack_size>]
42c            [heap <heap_size>] [global <global_size>]
43c            [<units>] [verify|noverify] [hardfail|nohardfail]
44c
45c     input units default to doubles
46c
47c     Return required sizes in units of double precision words
48c     or default if not specified in the input
49c
50c     If (ostore) store the values in the rtdb using the current context
51c     (so that in the near future each module can control its own memory)
52c
53      user_stack  =  0.0
54      user_heap   =  0.0
55      user_global =  0.0
56      user_total  =  0.0
57      user_units  = 'double'
58      stack_Src    = 'N'
59      heap_Src     = 'N'
60      global_Src   = 'N'
61      total_Src    = 'N'
62c
63c     units conversion
64c
65      conv_units(3)= ma_sizeof(mt_int, conv_units(3),   mt_dbl)
66      conv_units(4)= ma_sizeof(mt_byte, conv_units(4),   mt_dbl)
67      conv_units(5)= ma_sizeof(mt_byte, conv_units(5),   mt_dbl)
68      conv_units(6)= ma_sizeof(mt_byte, conv_units(6),   mt_dbl)
69      conv_units(8)= ma_sizeof(mt_byte, conv_units(8),   mt_dbl)
70c
71c     Check input line is vaguely sensible
72c
73      call inp_set_field(0)
74      if (.not. inp_a(ctest)) goto 1000
75      if (.not. inp_compare(.false., ctest, 'memory')) goto 1000
76      if (inp_n_field() .lt. 2) goto 1000
77c
78c     Parse the input line
79c
80 10   if (inp_a_trunc(ctest)) then
81         if (inp_compare(.false.,'verify',ctest)) then
82            overify = .true.
83         else if (inp_compare(.false.,'noverify',ctest)) then
84            overify = .false.
85         else if (inp_compare(.false.,'trace',ctest)) then
86            call ma_trace(1)
87         else if (inp_compare(.false.,'hardfail',ctest)) then
88            ohardfail = .true.
89         else if (inp_compare(.false.,'nohardfail',ctest)) then
90            ohardfail = .false.
91         else if (inp_compare(.false.,'heap', ctest)) then
92            if (.not. memory_units(heap_size,
93     n           units,nunits,conv_units)) goto 1000
94            heap_Src = 'U'
95         else if (inp_compare(.false.,'stack', ctest)) then
96            if (.not. memory_units(stack_size,
97     n           units,nunits,conv_units)) goto 1000
98            Stack_Src = 'U'
99         else if (inp_compare(.false.,'global', ctest)) then
100            if (.not. memory_units(global_size,
101     n           units,nunits,conv_units)) goto 1000
102            Global_Src = 'U'
103         else if (inp_compare(.false.,'total', ctest)) then
104            if (.not. memory_units(total_size,
105     n           units,nunits,conv_units)) goto 1000
106            Total_Src = 'U'
107         else
108            call inp_prev_field
109            if (.not. memory_units(total_size,
110     n           units,nunits,conv_units)) goto 1000
111            Total_Src = 'U'
112         endif
113         goto 10
114      endif
115C
116C     User inputs must be non-negative
117C
118      If ( User_Stack .lt. 0 .OR. User_Heap .lt. 0
119     $   .OR. User_Global .lt. 0 .OR. User_Total .lt. 0) Call ErrQuit(
120     $   'Memory_Input: Memory limits must be non-negative', 0,
121     &       INPUT_ERR)
122c$$$c
123c$$$c     debug
124c$$$c
125c$$$      write(0,*) ' total ', user_total, ' heap ', user_heap, ' stack ',
126c$$$     $     user_stack, ' global ', user_global, ' ',
127c$$$     $     user_units, ' verify ', overify
128C
129C     Take what the user has entered and turn it into a complete
130C     memory specification.
131C
132      Call Memory_Defaults(Total_Size, Total_Src, Heap_Size, Heap_Src,
133     $   Stack_Size, Stack_Src, Global_Size, Global_Src)
134C
135c$$$      write(0,*) ' total ', total_size, ' heap ', heap_size, ' stack ',
136c$$$     $     stack_size, ' global ', global_size, ' doubles ',
137c$$$     $     ' verify ', overify
138c
139c     Store data to the rtdb
140c
141      if(global_size.eq.0) call errquit(
142     E     'memory_input: no global memory defined ',0,MEM_ERR)
143      if (ostore) then
144         mem(1) = heap_size
145         mem(2) = stack_size
146         mem(3) = global_size
147         if (.not. context_prefix('memory',name))
148     $        call errquit('memory_input: context buffer too small',0,
149     &       INPUT_ERR)
150         if (.not. rtdb_put(rtdb, name, mt_int, 3, mem))
151     $        call errquit('memory_input: rtdb_put failed', 0,
152     &       RTDB_ERR)
153      endif
154      return
155c
156 1000 call errquit('input_mem_size: memory [[total] <total_size>] '//
157     $   '[heap <heap_size>] [stack <stack_size>] '//
158     $   '[global <global_size>] [<units>] [verify|noverify] '//
159     $   '[hardfail|nohardfail]', 0, INPUT_ERR)
160c
161      end
162      logical function memory_units(memory_size,
163     n     units,nunits,conv_units)
164      implicit none
165#include "errquit.fh"
166#include "inp.fh"
167c
168      integer memory_size ! [out]
169      character*8 units(*) ! [in]
170      integer nunits,conv_units(*) ! [in]
171c
172      double precision user_memory
173      character*8 ctest
174      integer ind
175c
176      memory_units=.false.
177      if (.not. inp_f(user_memory)) goto 1000
178      if (.not.inp_a(ctest)) goto 1000
179      if (inp_match(nunits, .false., ctest, units, ind)) then
180         memory_size  = int(user_memory)*conv_units(ind)
181         memory_units=.true.
182      else
183         call errquit('inp_match: units missing ',0,INPUT_ERR)
184      endif
185 1000 continue
186      return
187      end
188