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