bief_allvec_in_block.f

Go to the documentation of this file.

!                   *******************************
                    SUBROUTINE bief_allvec_in_block
!                   *******************************
!
     &( blo , n , nat , nomgen , ielm , ndim , statut , mesh )
!
!***********************************************************************
! BIEF   V7P3
!***********************************************************************
!
!brief    ALLOCATES MEMORY FOR N VECTORS, WHICH WILL BE PART
!+                OF A GIVEN BLOCK.
!
!note     THIS MODIFICATION OF ALLVEC_IN_BLOCK ALLOWS ADDING A NUMBER
!+         OF IDENTICALLY NUMBERED VECTORS TO AN ALREADY EXISTING BLOCK
!+         WITHOUT DESTROYING THE PREVIOUS STRUCTURE.
!
!history  J-M HERVOUET (LNH)
!+        11/07/1995
!+        V5P1
!+   First version
!
!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  J-M HERVOUET (jubilado)
!+        07/09/2017
!+        V7P3
!+   Allowing several successive allocations of the same BIEF_OBJ.
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| BLO            |<->| BLOCK WHERE THE VECTORS WILL BE ALLOCATED
!| IELM           |-->| TYPE OF ELEMENT OF VECTORS, OR DIMENSION
!|                |   | (DEPENDING ON 'STATUT', SEE BELOW)
!| N              |-->| NUMBER OF VECTORS TO BE ALLOCATED
!| NAT            |<--| 1: REAL VECTOR   2:VECTOR OF INTEGERS
!| NDIM           |-->| SECOND DIMENSION OF VECTORS
!| NOMGEN         |-->| GENERIC NAME OF VECTORS
!|                |   | WILL BE COMPLETED WITH RANK
!| 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
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief, ex_bief_allvec_in_block => bief_allvec_in_block
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      TYPE(bief_obj)  , INTENT(INOUT) :: BLO
      INTEGER         , INTENT(IN)    :: IELM,NDIM,STATUT,NAT,N
      CHARACTER(LEN=6), INTENT(IN)    :: NOMGEN
      TYPE(bief_mesh) , INTENT(IN)    :: MESH
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER IDEB,I,II
!
      CHARACTER(LEN=6) :: NOM
      CHARACTER(LEN=1), PARAMETER :: CHIFFRE(0:9) =
     &            (/'0','1','2','3','4','5','6','7','8','9'/)
!
!-----------------------------------------------------------------------
!
      ideb = 6
      DO i=5,2,-1
        IF(nomgen(i:i).EQ.' ') ideb = i
      ENDDO
!
!-----------------------------------------------------------------------
!
      IF(blo%N+n.LE.blo%MAXBLOCK) THEN
!
        IF(n.GT.0) THEN
!
          DO i = blo%N+1 , blo%N+n
!
!           NAME OF THE VECTOR
!
            nom=nomgen
            IF(i.LT.10) THEN
              ideb = min(6,ideb)
              nom(ideb:ideb) = chiffre(i)
            ELSEIF(i.LT.100) THEN
              ideb = min(5,ideb)
              nom(ideb  :ideb  ) = chiffre(i/10)
              nom(ideb+1:ideb+1) = chiffre(i-10*(i/10))
            ELSEIF(i.LT.1000) THEN
              ideb = min(4,ideb)
              nom(ideb  :ideb  ) = chiffre(i/100)
              ii=i-100*(i/100)
              nom(ideb+1:ideb+1) = chiffre(ii/10)
              nom(ideb+2:ideb+2) = chiffre(ii-10*(ii/10))
            ELSE
              WRITE(lu,*) 'MORE THAN 999 VECTORS ASKED
     &                     IN ALLVEC_IN_BLOCK'
              CALL plante(1)
              stop
            ENDIF
!
!           ALLOCATES THE VECTOR
!
            IF(.NOT.ASSOCIATED(blo%ADR(i)%P)) THEN
              ALLOCATE(blo%ADR(i)%P)
              NULLIFY(blo%ADR(i)%P%R)
              NULLIFY(blo%ADR(i)%P%I)
            ENDIF
            CALL bief_allvec(nat,blo%ADR(i)%P,nom,ielm,ndim,statut,mesh)
            blo%ADR(i)%P%FATHER = blo%NAME
!
          ENDDO ! I
!
          blo%N=blo%N+n
!
        ENDIF
!
      ELSE
!
        WRITE(lu,*) 'BIEF_ALLVEC_IN_BLOCK:'
        WRITE(lu,*) 'MORE THAN ',blo%MAXBLOCK,'(',n,')'
        WRITE(lu,*) 'VECTORS TO BE ALLOCATED'
        WRITE(lu,*) 'CHANGE MAXBLOCK IN ALLBLO.'
        CALL plante(1)
        stop
!
      ENDIF
!
!-----------------------------------------------------------------------
!
      RETURN
      END