cpstmt.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\cpstmt.f
00002 !
00060                      SUBROUTINE CPSTMT
00061 !                    *****************
00062 !
00063      &( X , Y , TRANS )
00064 !
00065 !***********************************************************************
00066 ! BIEF   V6P1                                   21/08/2010
00067 !***********************************************************************
00068 !
00069 !
00070 !
00071 !
00072 !
00073 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00074 !| TRANS          |-->| IF YES, Y WILL BE CONSIDERED TRANSPOSED OF X
00075 !| X              |-->| THE STRUCTURE OF X WILL BE COPIED ON Y
00076 !| Y              |<->| THE MODIFIED MATRIX STRUCTURE
00077 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00078 !
00079       USE BIEF, EX_CPSTMT => CPSTMT
00080 !
00081       IMPLICIT NONE
00082       INTEGER LNG,LU
00083       COMMON/INFO/LNG,LU
00084 !
00085 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00086 !
00087       TYPE(BIEF_OBJ), INTENT(IN)    :: X
00088       TYPE(BIEF_OBJ), INTENT(INOUT) :: Y
00089       LOGICAL, INTENT(IN), OPTIONAL :: TRANS
00090 !
00091 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00092 !
00093       INTEGER IELM1,IELM2,IELN1,IELN2
00094       LOGICAL TR
00095 !
00096 !-----------------------------------------------------------------------
00097 !  TREATS ONLY MATRICES HERE :
00098 !-----------------------------------------------------------------------
00099 !
00100       IF(X%TYPE.NE.3.OR.Y%TYPE.NE.3) THEN
00101         IF(LNG.EQ.1) WRITE(LU,200) X%NAME,X%TYPE,Y%NAME,Y%TYPE
00102         IF(LNG.EQ.2) WRITE(LU,201) X%NAME,X%TYPE,Y%NAME,Y%TYPE
00103 200     FORMAT(1X,'CPSTMT : CAS NON PREVU POUR X ET Y :',/,1X,
00104      &            'X=',A6,' TYPE :',1I6                 ,/,1X,
00105      &            'Y=',A6,' TYPE :',1I6)
00106 201     FORMAT(1X,'CPSTMT : FORBIDDEN CASE FOR X AND Y:',/,1X,
00107      &            'X=',A6,' TYPE :',1I6                 ,/,1X,
00108      &            'Y=',A6,' TYPE :',1I6)
00109         CALL PLANTE(1)
00110         STOP
00111       ENDIF
00112 !
00113 !-----------------------------------------------------------------------
00114 !
00115       IF(PRESENT(TRANS)) THEN
00116         TR = TRANS
00117       ELSE
00118         TR = .FALSE.
00119       ENDIF
00120 !
00121       IF(.NOT.TR) THEN
00122         IELM1 = X%ELMLIN
00123         IELM2 = X%ELMCOL
00124       ELSE
00125         IELM1 = X%ELMCOL
00126         IELM2 = X%ELMLIN
00127       ENDIF
00128 !
00129 ! CONTROLS MEMORY SIZE FOR DIAGONAL AND EXTRA-DIAGONAL TERMS :
00130 !
00131       IF(X%D%DIM1.GT.Y%D%MAXDIM1.OR.
00132      &   X%X%DIM2*X%X%DIM1.GT.Y%X%MAXDIM1*Y%X%MAXDIM2) THEN
00133         IELN1 = Y%ELMLIN
00134         IELN2 = Y%ELMCOL
00135         IF(LNG.EQ.1) WRITE(LU,400) X%NAME,IELM1,IELM2,Y%NAME,IELN1,IELN2
00136         IF(LNG.EQ.2) WRITE(LU,401) X%NAME,IELM1,IELM2,Y%NAME,IELN1,IELN2
00137         IF(LNG.EQ.1) WRITE(LU,402) X%TYPDIA,X%D%DIM1,X%TYPEXT,
00138      &                 X%X%DIM2*X%X%DIM1,
00139      &                 Y%TYPDIA,Y%D%MAXDIM1,
00140      &                 Y%TYPEXT,Y%X%MAXDIM1*Y%X%MAXDIM2
00141         IF(LNG.EQ.2) WRITE(LU,403) X%TYPDIA,X%D%DIM1,X%TYPEXT,
00142      &                 X%X%DIM2*X%X%DIM1,
00143      &                 Y%TYPDIA,Y%D%MAXDIM1,
00144      &                 Y%TYPEXT,Y%X%MAXDIM1*Y%X%MAXDIM2
00145  400    FORMAT(1X,'CPSTMT : CAS IMPOSSIBLE POUR X ET Y :',/,1X,
00146      &            'X=',A6,/,1X,'ELEMENTS ',1I3,' ET ',1I3,/,1X,
00147      &            'Y=',A6,/,1X,'ELEMENTS ',1I3,' ET ',1I3,/,1X,
00148      &            'Y EST PLUS PETITE QUE X')
00149  402    FORMAT(1X,'X A UNE DIAGONALE DE TYPE ',A1,/,1X,
00150      &            'AVEC UNE TAILLE DE ',1I8,/,1X,
00151      &            'DES TERMES EXTRADIAGONAUX DE TYPE ',A1,/,1X,
00152      &            'AVEC UNE TAILLE DE ',1I8,/,1X,
00153      &            'Y A UNE DIAGONALE DE TYPE ',A1,/,1X,
00154      &            'ET DE TAILLE MAXIMUM ',1I8,/,1X,
00155      &            'DES TERMES EXTRADIAGONAUX DE TYPE ',A1,/,1X,
00156      &            'ET UNE TAILLE MAXIMUM DE ',1I8)
00157  401    FORMAT(1X,'CPSTMT : FORBIDDEN CASE FOR X AND Y:',/,1X,
00158      &            'X=',A6,/,1X,'ELEMENTS ',1I3,' AND ',1I3,/,1X,
00159      &            'Y=',A6,/,1X,'ELEMENTS ',1I3,' AND ',1I3,/,1X,
00160      &            'Y IS SMALLER THAN X')
00161  403    FORMAT(1X,'X HAS A DIAGONAL OF TYPE ',A1,/,1X,
00162      &            'WITH A SIZE OF ',1I8,/,1X,
00163      &            'AND OFF-DIAGONAL TERMS OF TYPE ',A1,/,1X,
00164      &            'WITH A SIZE OF ',1I8,/,1X,
00165      &            'Y HAS A DIAGONAL OF TYPE ',A1,/,1X,
00166      &            'AND A MAXIMUM SIZE OF ',1I8,/,1X,
00167      &            'AND OFF-DIAGONAL TERMS OF TYPE ',A1,/,1X,
00168      &            'AND A MAXIMUM SIZE OF ',1I8)
00169         CALL PLANTE(1)
00170         STOP
00171       ENDIF
00172 !
00173 ! COPIES TYPES OF ELEMENTS
00174 !
00175       Y%ELMLIN = IELM1
00176       Y%ELMCOL = IELM2
00177 !
00178 ! 4) COPIES TYPES OF DIAGONAL AND EXTRADIAGONAL TERMS
00179 !
00180       CALL CPSTVC(X%D,Y%D)
00181       CALL CPSTVC(X%X,Y%X)
00182 !
00183 ! 5) COPIES THE MATRIX CHARACTERISTICS
00184 !
00185       Y%TYPDIA = X%TYPDIA
00186       Y%TYPEXT = X%TYPEXT
00187 !
00188 !-----------------------------------------------------------------------
00189 !
00190       RETURN
00191       END

Generated on Fri Aug 31 2013 18:12:58 by S.E.Bourban (HRW) using doxygen 1.7.0