solaux.f

Go to the documentation of this file.

!                   *****************
                    SUBROUTINE solaux
!                   *****************
!
     &(ipt, tb,tbb,itb,itbb,s)
!
!***********************************************************************
! BIEF   V6P1                                   21/08/2010
!***********************************************************************
!
!brief    TB IS A BLOCK OF VECTORS AND TBB A BLOCK OF BLOCKS.
!+                SOLAUX PREPARES A TBB BLOCK BY FILLING IT IN WITH
!+                MAX(1,S) VECTORS FROM TB.
!+
!+            THE OUTPUT ADDRESS IS AN ADDRESS RELATIVE TO TBB.
!+
!+            IN PRACTICE TB OBJECTS ARE VECTORS.
!
!history  J.M. HERVOUET (LNH)
!+        01/02/95
!+        V5P1
!+
!
!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
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| IPT            |<--| POINTER IN TBB OF THE BIEF_OBJ STRUCTURE ASKED
!| ITB            |-->| FIRST FREE VECTOR IN TB
!| ITBB           |-->| FIRST FREE BLOCK IN TBB
!| S              |-->| SIZE OF SYSTEM 1: 1 MATRIX
!|                |   |                2: 4 MATRICES
!|                |   |                3: 9 MATRICES
!| TB             |-->| BLOCK OF WORKING BIEF_OBJ STRUCTURES
!| TBB            |-->| BLOCK OF BLOCKS
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief, ex_solaux => solaux
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER, INTENT(IN) :: S
      INTEGER, INTENT(INOUT) :: ITB,IPT,ITBB
!
!-----------------------------------------------------------------------
!
!  STRUCTURES OF BLOCKS OF WORKING ARRAYS
!
      TYPE(bief_obj), INTENT(INOUT) :: TB,TBB
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER K,IAD,MAXTB,MAXTBB
!
!-----------------------------------------------------------------------
!
      maxtbb = tbb%N
      IF(itbb.GT.maxtbb) THEN
        WRITE(lu,31) itbb
        CALL plante(1)
        stop
      ENDIF
      ipt = itbb
      maxtb = tb%N
      itbb = itbb + 1
!     REINITIALISES THE BLOCK
      DO k=1,tbb%ADR(ipt)%P%N
        NULLIFY(tbb%ADR(ipt)%P%ADR(k)%P)
      ENDDO
      tbb%ADR(ipt)%P%N=0
      DO k = 1 , max(s,1)
        IF(itb.GT.maxtb) THEN
          WRITE(lu,11) itb + max(s,1) - k + 1
          CALL plante(1)
          stop
        ENDIF
        iad=itb
        CALL addblo(tbb%ADR(ipt)%P,tb%ADR(iad)%P)
        itb = itb + 1
      ENDDO ! K
!
!-----------------------------------------------------------------------
!
11    FORMAT(1x,'SOLAUX (BIEF): INSUFFICIENT NUMBER OF ARRAYS',/,
     &       1x,'IN BLOCK TB. MINIMUM REQUIRED:',1i4)
31    FORMAT(1x,'SOLAUX (BIEF): INSUFFICIENT NUMBER OF BLOCKS',/,
     &       1x,'IN BLOCK TBB. MINIMUM REQUIRED:',1i4)
!
!-----------------------------------------------------------------------
!
      RETURN
      END