cpstmt.f

Go to the documentation of this file.

!                   *****************
                    SUBROUTINE cpstmt
!                   *****************
!
     &( x , y , trans )
!
!***********************************************************************
! BIEF   V7P2
!***********************************************************************
!
!brief    COPIES A MATRIX STRUCTURE ONTO ANOTHER.
!+                X COPIED ONTO Y.
!
!history  J-M HERVOUET (LNHE)
!+        03/02/2010
!+        V6P0
!+   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 (LNHE)
!+        22/03/2016
!+        V7P2
!+   Adding the copy of STOX.
!
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!| TRANS          |-->| IF YES, Y WILL BE CONSIDERED TRANSPOSED OF X
!| X              |-->| THE STRUCTURE OF X WILL BE COPIED ON Y
!| Y              |<->| THE MODIFIED MATRIX STRUCTURE
!~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
!
      USE bief, ex_cpstmt => cpstmt
!
      USE declarations_special
      IMPLICIT NONE
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      TYPE(bief_obj), INTENT(IN)    :: X
      TYPE(bief_obj), INTENT(INOUT) :: Y
      LOGICAL, INTENT(IN), OPTIONAL :: TRANS
!
!+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
!
      INTEGER IELM1,IELM2,IELN1,IELN2
      LOGICAL TR
!
!-----------------------------------------------------------------------
!  TREATS ONLY MATRICES HERE :
!-----------------------------------------------------------------------
!
      IF(x%TYPE.NE.3.OR.y%TYPE.NE.3) THEN
        WRITE(lu,201) x%NAME,x%TYPE,y%NAME,y%TYPE
201     FORMAT(1x,'CPSTMT : FORBIDDEN CASE FOR X AND Y:',/,1x,
     &            'X=',a6,' TYPE :',1i6                 ,/,1x,
     &            'Y=',a6,' TYPE :',1i6)
        CALL plante(1)
        stop
      ENDIF
!
!-----------------------------------------------------------------------
!
      IF(PRESENT(trans)) THEN
        tr = trans
      ELSE
        tr = .false.
      ENDIF
!
      IF(.NOT.tr) THEN
        ielm1 = x%ELMLIN
        ielm2 = x%ELMCOL
      ELSE
        ielm1 = x%ELMCOL
        ielm2 = x%ELMLIN
      ENDIF
!
! CONTROLS MEMORY SIZE FOR DIAGONAL AND EXTRA-DIAGONAL TERMS :
!
      IF(x%D%DIM1.GT.y%D%MAXDIM1.OR.
     &   x%X%DIM2*x%X%DIM1.GT.y%X%MAXDIM1*y%X%MAXDIM2) THEN
        ieln1 = y%ELMLIN
        ieln2 = y%ELMCOL
        WRITE(lu,401) x%NAME,ielm1,ielm2,y%NAME,ieln1,ieln2
        WRITE(lu,403) x%TYPDIA,x%D%DIM1,x%TYPEXT,
     &                x%X%DIM2*x%X%DIM1,
     &                y%TYPDIA,y%D%MAXDIM1,
     &                y%TYPEXT,y%X%MAXDIM1*y%X%MAXDIM2
 401    FORMAT(1x,'CPSTMT : FORBIDDEN CASE FOR X AND Y:',/,1x,
     &            'X=',a6,/,1x,'ELEMENTS ',1i3,' AND ',1i3,/,1x,
     &            'Y=',a6,/,1x,'ELEMENTS ',1i3,' AND ',1i3,/,1x,
     &            'Y IS SMALLER THAN X')
 403    FORMAT(1x,'X HAS A DIAGONAL OF TYPE ',a1,/,1x,
     &            'WITH A SIZE OF ',1i8,/,1x,
     &            'AND OFF-DIAGONAL TERMS OF TYPE ',a1,/,1x,
     &            'WITH A SIZE OF ',1i8,/,1x,
     &            'Y HAS A DIAGONAL OF TYPE ',a1,/,1x,
     &            'AND A MAXIMUM SIZE OF ',1i8,/,1x,
     &            'AND OFF-DIAGONAL TERMS OF TYPE ',a1,/,1x,
     &            'AND A MAXIMUM SIZE OF ',1i8)
        CALL plante(1)
        stop
      ENDIF
!
! COPIES TYPES OF ELEMENTS
!
      y%ELMLIN = ielm1
      y%ELMCOL = ielm2
!
! 4) COPIES TYPES OF DIAGONAL AND EXTRADIAGONAL TERMS
!
      CALL cpstvc(x%D,y%D)
      CALL cpstvc(x%X,y%X)
!
! 5) COPIES THE MATRIX CHARACTERISTICS
!
      y%TYPDIA = x%TYPDIA
      y%TYPEXT = x%TYPEXT
      y%STOX   = x%STOX
!
!-----------------------------------------------------------------------
!
      RETURN
      END