TABLE OF CONTENTS


ABINIT/m_VectorInt [ Modules ]

[ Top ] [ Modules ]

NAME

  m_VectorInt

FUNCTION

  Manage an integer vector

COPYRIGHT

  Copyright (C) 2013-2022 ABINIT group (J. Bieder)
  This file is distributed under the terms of the
  GNU General Public License, see ~abinit/COPYING
  or http://www.gnu.org/copyleft/gpl.txt .

NOTES

SOURCE

22 #include "defs.h"
23 MODULE m_VectorInt
24 USE m_Global
25 IMPLICIT NONE

ABINIT/m_VectorInt/VectorInt_clear [ Functions ]

[ Top ] [ Functions ]

NAME

  VectorInt_clear

FUNCTION

  Clear vector

COPYRIGHT

  Copyright (C) 2013-2022 ABINIT group (J. Bieder)
  This file is distributed under the terms of the
  GNU General Public License, see ~abinit/COPYING
  or http://www.gnu.org/copyleft/gpl.txt .

INPUTS

  this=vector

OUTPUT

SIDE EFFECTS

NOTES

SOURCE

276 SUBROUTINE VectorInt_clear(this)
277 
278 !Arguments ------------------------------------
279   TYPE(VectorInt), INTENT(INOUT) :: this
280   this%tail = 0 
281 END SUBROUTINE VectorInt_clear

ABINIT/m_VectorInt/VectorInt_destroy [ Functions ]

[ Top ] [ Functions ]

NAME

  VectorInt_destroy

FUNCTION

  Destroy vector 

COPYRIGHT

  Copyright (C) 2013-2022 ABINIT group (J. Bieder)
  This file is distributed under the terms of the
  GNU General Public License, see ~abinit/COPYING
  or http://www.gnu.org/copyleft/gpl.txt .

INPUTS

  this=vector

OUTPUT

SIDE EFFECTS

NOTES

SOURCE

356 SUBROUTINE VectorInt_destroy(this)
357 
358 !Arguments ------------------------------------
359   TYPE(VectorInt), INTENT(INOUT) :: this
360 
361   FREEIF(this%vec)
362 
363   this%tail     = 0
364   this%size     = 0
365 END SUBROUTINE VectorInt_destroy

ABINIT/m_VectorInt/VectorInt_enlarge [ Functions ]

[ Top ] [ Functions ]

NAME

  VectorInt_enlarge

FUNCTION

  enlarge memory size

COPYRIGHT

  Copyright (C) 2013-2022 ABINIT group (J. Bieder)
  This file is distributed under the terms of the
  GNU General Public License, see ~abinit/COPYING
  or http://www.gnu.org/copyleft/gpl.txt .

INPUTS

  this=vector
  size=memory size to add

OUTPUT

SIDE EFFECTS

NOTES

SOURCE

177 SUBROUTINE VectorInt_enlarge(this, size)
178 
179 !Arguments ------------------------------------
180   TYPE(VectorInt)     , INTENT(INOUT)        :: this
181   INTEGER             , INTENT(IN   )        :: size
182 !Local variables ------------------------------
183   INTEGER                                 :: width
184   INTEGER                                 :: tail
185   INTEGER, ALLOCATABLE, DIMENSION(:) :: thistemp 
186   INTEGER                                 :: size_val
187 
188   IF ( ALLOCATED(this%vec) ) THEN
189     FREEIF(thistemp)
190     width = this%size
191     tail  = this%tail
192     size_val = size 
193     MALLOC(thistemp,(1:tail))
194     thistemp(1:tail) = this%vec(1:tail)
195     FREE(this%vec)
196     this%size = width + size_val
197     MALLOC(this%vec,(1:this%size))
198     this%vec(1:tail) = thistemp(1:tail)
199     FREE(thistemp)
200   ELSE
201     CALL VectorInt_init(this, Global_SIZE)
202   END IF
203 END SUBROUTINE VectorInt_enlarge

ABINIT/m_VectorInt/VectorInt_init [ Functions ]

[ Top ] [ Functions ]

NAME

  VectorInt_init

FUNCTION

  initialize

COPYRIGHT

  Copyright (C) 2013-2022 ABINIT group (J. Bieder)
  This file is distributed under the terms of the
  GNU General Public License, see ~abinit/COPYING
  or http://www.gnu.org/copyleft/gpl.txt .

INPUTS

  this=vector
  size=size of initialization

OUTPUT

SIDE EFFECTS

NOTES

SOURCE

 89 SUBROUTINE VectorInt_init(this, size)
 90 
 91 !Arguments ------------------------------------
 92   TYPE(VectorInt)     , INTENT(INOUT) :: this
 93   INTEGER, OPTIONAL, INTENT(IN   ) :: size
 94 !Local variables ------------------------------
 95   INTEGER                          :: size_val
 96 
 97   size_val = Global_SIZE
 98   IF ( PRESENT(size) ) size_val = size
 99   this%size = size_val
100   FREEIF(this%vec)
101   MALLOC(this%vec,(1:size_val))
102   this%tail = 0 
103   this%vec  = 0
104 END SUBROUTINE VectorInt_init

ABINIT/m_VectorInt/VectorInt_print [ Functions ]

[ Top ] [ Functions ]

NAME

  VectorInt_print

FUNCTION

  print vector

COPYRIGHT

  Copyright (C) 2013-2022 ABINIT group (J. Bieder)
  This file is distributed under the terms of the
  GNU General Public License, see ~abinit/COPYING
  or http://www.gnu.org/copyleft/gpl.txt .

INPUTS

  this=vector
  ostream=file stream

OUTPUT

SIDE EFFECTS

NOTES

SOURCE

309 SUBROUTINE VectorInt_print(this,ostream)
310 
311 !Arguments ------------------------------------
312   TYPE(VectorInt), INTENT(IN) :: this
313   INTEGER, OPTIONAL, INTENT(IN) :: ostream
314 !Local variables ------------------------------
315   INTEGER                       :: ostream_val
316   INTEGER                       :: it1
317   CHARACTER(LEN=4 )             :: size
318   CHARACTER(LEN=15)             :: string
319 
320   ostream_val = 6
321   IF ( PRESENT(ostream) ) ostream_val = ostream
322   WRITE(size,'(I4)') this%tail
323   WRITE(ostream_val,'(A)') "("
324   string ='(1x,1ES10.2)'
325   DO it1 = 1, this%tail
326     WRITE(ostream_val,string) this%vec(it1)
327   END DO
328   WRITE(ostream_val,'(A)') ")"
329 END SUBROUTINE VectorInt_print

ABINIT/m_VectorInt/VectorInt_pushBack [ Functions ]

[ Top ] [ Functions ]

NAME

  VectorInt_pushBack

FUNCTION

  push an element at the end

COPYRIGHT

  Copyright (C) 2013-2022 ABINIT group (J. Bieder)
  This file is distributed under the terms of the
  GNU General Public License, see ~abinit/COPYING
  or http://www.gnu.org/copyleft/gpl.txt .

INPUTS

  this=vector
  value=value to add

OUTPUT

SIDE EFFECTS

NOTES

SOURCE

231 SUBROUTINE VectorInt_pushBack(this, value)
232 
233 !Arguments ------------------------------------
234   TYPE(VectorInt)    , INTENT(INOUT) :: this
235   INTEGER, INTENT(IN   ) :: value
236 !Local variables ------------------------------
237   INTEGER                         :: tail
238 
239   IF ( this%size .EQ. 0 ) THEN
240     CALL VectorInt_init(this, Global_SIZE)
241   END IF
242   tail = this%tail
243   tail = tail + 1
244   IF ( tail .GT. this%size ) THEN
245     CALL VectorInt_enlarge(this,Global_SIZE)
246   END IF
247   this%vec(tail) = value
248   this%tail      = tail
249 END SUBROUTINE VectorInt_pushBack

ABINIT/m_VectorInt/VectorInt_setSize [ Functions ]

[ Top ] [ Functions ]

NAME

  VectorInt_setSize

FUNCTION

  impose size

COPYRIGHT

  Copyright (C) 2013-2022 ABINIT group (J. Bieder)
  This file is distributed under the terms of the
  GNU General Public License, see ~abinit/COPYING
  or http://www.gnu.org/copyleft/gpl.txt .

INPUTS

  this=vector
  new_tail=new_size

OUTPUT

SIDE EFFECTS

NOTES

SOURCE

132 SUBROUTINE VectorInt_setSize(this,new_tail)
133 
134 !Arguments ------------------------------------
135   TYPE(VectorInt), INTENT(INOUT) :: this
136   INTEGER     , INTENT(IN   ) :: new_tail
137 !Local variables ------------------------------
138   INTEGER                     :: size
139 
140   IF ( .NOT. ALLOCATED(this%vec) ) THEN
141     CALL VectorInt_init(this,new_tail)
142   ELSE
143     size = this%size
144     IF( new_tail .GT. size ) THEN
145       CALL VectorInt_enlarge(this,MAX(new_tail-size,Global_SIZE))
146     END IF
147   END IF
148   this%tail = new_tail
149 END SUBROUTINE VectorInt_setSize  

m_VectorInt/VectorInt [ Types ]

[ Top ] [ m_VectorInt ] [ Types ]

NAME

  VectorInt

FUNCTION

  This structured datatype contains the necessary data

COPYRIGHT

  Copyright (C) 2013-2022 ABINIT group (J. Bieder)
  This file is distributed under the terms of the
  GNU General Public License, see ~abinit/COPYING
  or http://www.gnu.org/copyleft/gpl.txt .

SOURCE

46 TYPE, PUBLIC :: VectorInt
47   INTEGER _PRIVATE :: size
48   INTEGER          :: tail
49   INTEGER, ALLOCATABLE, DIMENSION(:)         :: vec
50 END TYPE VectorInt