bief_allvec.f

Go to the documentation of this file.

!                   **********************
                    SUBROUTINE bief_allvec
!                   **********************
!
     &( nat , vec , nom , ielm , dim2 , statut , mesh )
!
!***********************************************************************
! BIEF   V7P3
!***********************************************************************
!
!brief    ALLOCATES MEMORY FOR A VECTOR STRUCTURE.
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        13/07/2010
!+        V6P0
!+   Translation of French comments within the FORTRAN sources into
!+   English comments
!
!history  N.DURAND (HRW), S.E.BOURBAN (HRW)
!+        21/08/2010
!+        V6P0
!+   Creation of DOXYGEN tags for automated documentation and
!+   cross-referencing of the FORTRAN sources

!history  R.NHEILI (Universite de Perpignan, DALI)
!+        24/02/2016
!+        V7P3
!+       ALLOCATE THE ELEMENT E IN THE VECTOR STUCTURE (BIEF_OBJ)
!
!history  J-M HERVOUET (EDF LAB, LNHE)
!+        21/01/2016
!+        V7P2
!+   Adding NAT = 3. With both integers and doube precision arrays
!+   allocated
!
!history  J-M HERVOUET (jubilado)
!+        07/09/2017
!+        V7P3
!+   Allowing several successive allocations of the same BIEF_OBJ.
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| DIM2           |-->| SECOND DIMENSION OF VECTOR
!| IELM           |-->| TYPE OF ELEMENT, OR DIMENSION
!|                |   | (DEPENDING ON 'STATUT')
!| NAT            |<--| 1: DOUBLE PRECISION   2:VECTOR OF INTEGERS
!|                |   | 3: DOUBLE PRECISION AND VECTOR OF INTEGERS
!| NOM            |-->| FORTRAN NAME
!| REFINE         |-->| NUMBER OF REFINEMENT LEVELS
!| STATUT         |-->| VECTOR STATUS:
!|                |   | 0 : FREE VECTOR, IELM IS ITS DIMENSION
!|                |   | 1 : VECTOR DEFINED ON A MESH
!|                |   | IELM IS THEN THE ELEMENT TYPE
!|                |   | CHANGING DISCRETISATION FORBIDDEN
!|                |   | 2 : LIKE 1 BUT CHANGING DISCRETISATION ALLOWED
!| VEC            |<--| VECTOR TO BE ALLOCATED
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief, ex_bief_allvec => bief_allvec
      USE declarations_telemac, ONLY : modass
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      TYPE(bief_obj)  , INTENT(INOUT) :: VEC
      INTEGER         , INTENT(IN)    :: NAT,IELM,DIM2,STATUT
      CHARACTER(LEN=6), INTENT(IN)    :: NOM
      TYPE(bief_mesh) , INTENT(IN)    :: MESH
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER ERR,IMAX,I
      LOGICAL INIT
      DOUBLE PRECISION XMAX
!
      INTRINSIC max
!
      err = 0
!
!-----------------------------------------------------------------------
!  HEADER COMMON TO ALL OBJECTS
!-----------------------------------------------------------------------
!
!     KEY OF THE OBJECT - TO CHECK MEMORY CRASHES
!
      vec%KEY = 123456
!
!     TYPE OF THE OBJECT (HERE VECTOR)
!
      vec%TYPE = 2
!
!     Defines how the object was created
!
      vec%FATHER = 'XXXXXX'
!
!     NAME OF THE OBJECT
!
      vec%NAME = nom
!
!-----------------------------------------------------------------------
!  PART SPECIFIC TO VECTORS
!-----------------------------------------------------------------------
!
!     NATURE
!
      vec%NAT = nat
!
!     MAXIMUM SIZE PER DIMENSION
!
      IF(statut.EQ.1.OR.statut.EQ.2) THEN
        vec%MAXDIM1 = bief_nbmpts(ielm,mesh)
      ELSE
        vec%MAXDIM1 = ielm
      ENDIF
!
!     VEC%MAXDIM1 MUST BE AT LEAST 1
!     TO AVOID BOUND CHECKING ERRORS ON SOME COMPILERS
!
      vec%MAXDIM1=max(vec%MAXDIM1,1)
!
!     DISCRETISES
!
      IF(statut.EQ.1.OR.statut.EQ.2) THEN
        vec%ELM = ielm
      ELSE
        vec%ELM = -1000
      ENDIF
!
!     FIRST DIMENSION OF VECTOR
!
      IF(statut.EQ.1.OR.statut.EQ.2) THEN
        vec%DIM1 = bief_nbpts(ielm,mesh)
      ELSE
        vec%DIM1 = ielm
      ENDIF
!
!     SECOND DIMENSION OF VECTOR (VEC%DIM2 MAY BE CHANGED)
!
      vec%DIM2    = dim2
      vec%MAXDIM2 = dim2
!
!     CASE OF DISCONTINUITY BETWEEN ELEMENTS
!     (SEE CORRSL, VC13AA, VC13BB)
!
      vec%DIMDISC = 0
!
!     STATUS
!
      vec%STATUS = statut
!
!     INFORMATION ON CONTENT
!
      vec%TYPR = '?'
      vec%TYPI = '?'
!
!     DYNAMICALLY ALLOCATES MEMORY (REAL AND/OR INTEGER, DEPENDING OF NAT)
!
      IF(nat.EQ.1.OR.nat.EQ.3) THEN
!
        init=.false.
        IF(.NOT.ASSOCIATED(vec%R)) THEN
          ALLOCATE(vec%R(vec%MAXDIM1*vec%DIM2),stat=err)
          init=.true.
        ELSEIF(SIZE(vec%R).LT.vec%MAXDIM1*vec%DIM2) THEN
          WRITE(lu,*) 'DEALLOCATING AND REALLOCATING %R OF ',
     &                vec%NAME,vec%MAXDIM1,vec%DIM2,SIZE(vec%R)
          DEALLOCATE(vec%R)
          ALLOCATE(vec%R(vec%MAXDIM1*vec%DIM2),stat=err)
          init=.true.
        ENDIF
        CALL check_allocate(err,'VECTOR '//vec%NAME//'%R')
!
!       FILLS ARRAY WITH BIG NUMBERS
!       TO RAISE QUESTIONS IF NOT INITIALISED
!
        IF(init) THEN
          xmax = huge(100.d0)
          CALL ov('X=C     ', x=vec%R, c=xmax,
     &            dim1=vec%MAXDIM1*vec%DIM2)
        ENDIF
!
        IF(modass .EQ.3) THEN
          ALLOCATE(vec%E(vec%MAXDIM1*vec%DIM2),stat=err)
          CALL ov('X=C     ', x=vec%E, c=0.d0,
     &            dim1=vec%MAXDIM1*vec%DIM2)
        ENDIF
!
!
      ENDIF
!
      IF(nat.EQ.2.OR.nat.EQ.3) THEN
!
        init=.false.
        IF(.NOT.ASSOCIATED(vec%I)) THEN
          ALLOCATE(vec%I(vec%MAXDIM1*vec%DIM2),stat=err)
          init=.true.
        ELSEIF(SIZE(vec%I).LT.vec%MAXDIM1*vec%DIM2) THEN
          WRITE(lu,*) 'REALLOCATING %I OF ',vec%NAME
          WRITE(lu,*) 'OLD SIZE: ',SIZE(vec%I)
          WRITE(lu,*) 'NEW SIZE: ',vec%MAXDIM1*vec%DIM2
          DEALLOCATE(vec%I)
          ALLOCATE(vec%I(vec%MAXDIM1*vec%DIM2),stat=err)
          init=.true.
        ENDIF
        CALL check_allocate(err,'VECTOR '//vec%NAME//'%I')
!
!       FILLS ARRAY WITH BIG NUMBERS
!       TO RAISE QUESTIONS IF NOT INITIALISED
!
        IF(init) THEN
          imax = huge(100)
          DO i=1,vec%MAXDIM1*vec%DIM2
            vec%I(i) = imax
          ENDDO
        ENDIF
!
      ENDIF
!
      IF(nat.EQ.1) THEN
        NULLIFY(vec%I)
      ELSEIF(nat.EQ.2) THEN
        NULLIFY(vec%R)
      ELSEIF(nat.NE.3) THEN
        WRITE(lu,*) 'UNKNOWN NAT IN ALLVEC:',nat
        CALL plante(1)
        stop
      ENDIF
!
!-----------------------------------------------------------------------
!
      RETURN
      END