deallblo.f

Go to the documentation of this file.

!                   *****************
                    SUBROUTINE deallblo
!                   *****************
!
     &( blo )
!
!***********************************************************************
! BIEF   V6P3
!***********************************************************************
!
!brief    DEALLOCATES MEMORY FOR A BLOCK STRUCTURE.
!
!history  Y AUDOUIN (LNHE)
!+        25/05/2015
!+        V7P0
!+
!
!history  S.E.BOURBAN (HRW)
!+        20/01/2017
!+        V7P4
!+        DEALLOCATION of a pointer switched to a NULLIFY statement
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| BLO            |-->| THE BLOCK TO BE DEALLOCATED
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      TYPE(bief_obj)  , INTENT(INOUT) :: BLO
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER I,J
!
!-----------------------------------------------------------------------
!
      ! If the block contains nothing ... do nothing
      IF(blo%N.GT.0) THEN
        DO i=1,blo%N
          IF(ASSOCIATED(blo%ADR(i)%P)) THEN
            IF(blo%ADR(i)%P%FATHER.EQ.blo%NAME) THEN
              IF(blo%ADR(i)%P%TYPE.EQ.4) THEN
                ! Not deallocating element in the block as they should
                ! point on block from a higher level that will be
                ! deallocatted later
                DO j=1,blo%ADR(i)%P%N
                  NULLIFY(blo%ADR(i)%P%ADR(j)%P)
                ENDDO
                DEALLOCATE(blo%ADR(i)%P%ADR)
                NULLIFY(blo%ADR(i)%P%ADR)
              ELSE IF(blo%ADR(i)%P%TYPE.EQ.2) THEN
                CALL bief_deallvec(blo%ADR(i)%P)
              ELSE IF(blo%ADR(i)%P%TYPE.EQ.3) THEN
                CALL bief_deallmat(blo%ADR(i)%P)
              ELSE
                WRITE(lu,*) 'UNKNOWN BIEF_OBJ TYPE'
                WRITE(lu,*) 'FOR OBJECT NAMED: ',blo%ADR(i)%P%NAME
                WRITE(lu,*) 'OF TYPE: ',blo%ADR(i)%P%TYPE
                CALL plante(1)
                stop
              ENDIF
              DEALLOCATE(blo%ADR(i)%P)
              NULLIFY(blo%ADR(i)%P)
            ENDIF
          NULLIFY(blo%ADR(i)%P)
          ENDIF
        ENDDO
      ENDIF
      DEALLOCATE(blo%ADR)
      NULLIFY(blo%ADR)
!
!-----------------------------------------------------------------------
!
      RETURN
      END