2D AMRCLAW
igetsp.f
Go to the documentation of this file.
1 c
6 c ----------------------------------------------------------
7 c
8  function igetsp (nwords)
9 c
10  use amr_module
11  implicit double precision (a-h,o-z)
12 
13 c
14 c ::::::::::::::::::::::::::: IGETSP ::::::::::::::::::::::::::::
15 c
16 c allocate contiguous space of length nword in main storage array
17 c alloc. user code (or pointer to the owner of this storage)
18 c is mptr. lenf = current length of lfree list.
19 c
20 c ::::::::::::::::::::::::::: IGETSP ::::::::::::::::::::::::::::
21 c
22 
23 !$OMP CRITICAL (MemMgmt)
24 
25 c find first fit from free space list
26 c
27  10 continue
28  itake = 0
29  do 20 i = 1, lenf
30  if (lfree(i,2) .lt. nwords) go to 20
31  itake = i
32  go to 25
33  20 continue
34  go to 900
35 c
36 c anything left?
37 c
38  25 left = lfree(itake,2) - nwords
39  igetsp = lfree(itake,1)
40  iendtake = lfree(itake,1) + nwords
41  if (lendim .lt. iendtake) lendim = iendtake
42 c
43 c the following code which is ignored for now adds the new
44  if (left .le. 0) go to 30
45  lfree(itake,2) = left
46  lfree(itake,1) = iendtake
47  go to 99
48 c
49 c item is totally removed. move next items in list up one.
50 c
51  30 lenf = lenf - 1
52  do 40 i = itake, lenf
53  lfree(i,1) = lfree(i+1,1)
54  40 lfree(i,2) = lfree(i+1,2)
55  go to 99
56 c
57  900 write(outunit,901) nwords
58  write(*,901) nwords
59  901 format(' require ',i10,' words - either none left or not big',
60  1 ' enough space')
61  write(outunit,902) ((lfree(i,j),j=1,2),i=1,lenf)
62  write(*,902) ((lfree(i,j),j=1,2),i=1,lenf)
63  902 format(' free list: ',//,2x,50(i10,4x,i10,/,2x))
64 
65  ! Dynamic memory adjustment
66  ! Attempt to allocate new memory
67  factor = 2.0d0
68  istatus = 1
69  old_memsize = memsize
70  do while (istatus > 0)
71  factor = 0.5d0 * factor
72  if (factor < 0.1d0) then
73  print *, 'Allocation failed, not enough memory'
74  stop
75  endif
76  new_size = ceiling((1.d0+factor) * memsize)
77  iadd_size = ceiling(factor * memsize)
78  call resize_storage(new_size,istatus)
79  enddo
80 
81  if (lfree(lenf-1,1) + lfree(lenf-1,2) - 1 .eq. old_memsize) then
82  ! Merge new block with last free block on list, adjust sentinel to
83  ! reflect new memory size
84  lfree(lenf-1,2) = iadd_size + lfree(lenf-1,2)
85  lfree(lenf,1) = new_size + 2
86  else
87  ! New free block added to end, make new sentinel
88  lfree(lenf,1) = old_memsize+1
89  lfree(lenf,2) = iadd_size
90  lfree(lenf+1,1) = new_size+2
91  lfree(lenf+1,2) = 0
92  lenf = lenf + 1
93  endif
94  go to 10
95 
96  99 lentot = lentot + nwords
97  if (lenmax .lt. lentot) lenmax = lentot
98  if (sprint) write(outunit,100) nwords, igetsp, lentot, lenmax
99  100 format(' allocating ',i8,' words in location ',i8,
100  1 ' lentot, lenmax ', 2i10)
101 
102 !$OMP END CRITICAL (MemMgmt)
103 
104  return
105  end
integer lendim
Definition: amr_module.f90:247
function igetsp(nwords)
Allocate contiguous space of length nword in main storage array alloc.
Definition: igetsp.f:9
logical sprint
Definition: amr_module.f90:297
integer lenmax
Definition: amr_module.f90:247
integer memsize
Definition: amr_module.f90:219
integer lentot
Definition: amr_module.f90:247
integer, parameter outunit
Definition: amr_module.f90:290
integer, dimension(lfdim, 2) lfree
Definition: amr_module.f90:225
subroutine resize_storage(new_size, status)
integer lenf
Definition: amr_module.f90:225
The module contains the definition of a "node descriptor" as well as other global variables used duri...
Definition: amr_module.f90:21