matvct.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\matvct.f
00002 !
00087                      SUBROUTINE MATVCT
00088 !                    *****************
00089 !
00090      &(OP, X , DA,TYPDIA,XA,TYPEXT, Y ,
00091      & C,IKLE,NPT,NELEM,NELMAX,W,LEGO,IELM1,IELM2,IELMX,LV,
00092      & S,P,IKLEM1,DIMIKM,LIMVOI,MXPTVS,NPMAX,NPOIN,NPTFR,
00093      & GLOSEG,SIZGLO,SIZXA,NDP,MESH)
00094 !
00095 !***********************************************************************
00096 ! BIEF   V6P1                                   21/08/2010
00097 !***********************************************************************
00098 !
00099 !
00100 !
00101 !
00102 !
00103 !
00104 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00105 !| C              |-->| A GIVEN CONSTANT
00106 !| DA             |-->| MATRIX DIAGONAL
00107 !| DIMIKM         |-->| FIRST DIMENSION OF IKLEM1.
00108 !| GLOSEG         |-->| FIRST AND SECOND POINT OF SEGMENTS
00109 !| IELM1          |-->| TYPE OF ELEMENT FOR LINES
00110 !| IELM2          |-->| TYPE OF ELEMENT FOR COLUMNS
00111 !| IELMX          |-->| TYPE OF ELEMENT OF RESULT
00112 !|                |   | CAN BE IELM1 OR IELM2 DEPENDING ON OP
00113 !| IKLE           |-->| CONNECTIVITY TABLE.
00114 !| IKLEM1         |-->| CONNECTIVITY TABLE USED FOR MATRIX-VECTOR 2
00115 !| LEGO           |-->| = .TRUE. W1,2,... ARE ASSEMBLED ON X
00116 !|                |   | =.FALSE. W1,2,... ARE NOT ASSEMBLED
00117 !| LIMVOI         |-->| ARRAY USED FOR MATRIX-VECTOR 2
00118 !| LV             |-->| VECTOR LENGTH OF THE MACHINE
00119 !| MXPTVS         |-->| MAXIMUM NUMBER OF NEIGHBOURS OF A POINT
00120 !| NELEM          |-->| NUMBER OF ELEMENTS
00121 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00122 !| NPMAX          |-->| MAXIMUM NUMBER OF POINTS IN THE MESH
00123 !| NPOIN          |-->| NUMBER OF POINTS
00124 !| NPT            |-->| DIMENSION OF DIAGONAL
00125 !| NPTFR          |-->| NUMBER OF BOUNDARY POINTS
00126 !| OP             |-->| OPERATION TO BE DONE
00127 !| P              |-->| TYPE OF MATRIX X VECTOR PRODUCT.
00128 !| S              |-->| TYPE OF STORAGE.
00129 !| SIZGLO         |-->| FIRST DIMENSION OF GLOSEG
00130 !| SIZXA          |-->| FIRST DIMENSION OF ARRAY XA
00131 !| TYPDIA         |-->| TYPE OF DIAGONAL:
00132 !|                |   | TYPDIA = 'Q' : ANY VALUE
00133 !|                |   | TYPDIA = 'I' : IDENTITY
00134 !|                |   | TYPDIA = '0' : ZERO
00135 !| TYPEXT         |-->| TYPE OF OFF-DIAGONAL TERMS
00136 !|                |   | TYPEXT = 'Q' : ANY VALUE
00137 !|                |   | TYPEXT = 'S' : SYMMETRIC
00138 !|                |   | TYPEXT = '0' : ZERO
00139 !| W              |<--| WORK ARRAY WITH NON ASSEMBLED RESULT
00140 !| X              |<--| RESULTING VECTOR
00141 !| XA             |-->| OFF-DIAGONAL TERMS IN THE MATRIX A
00142 !| Y              |-->| A GIVEN VECTOR USED IN OPERATION OP
00143 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00144 !
00145       USE BIEF, EX_MATVCT => MATVCT
00146 !
00147       IMPLICIT NONE
00148       INTEGER LNG,LU
00149       COMMON/INFO/LNG,LU
00150 !
00151 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00152 !
00153       INTEGER, INTENT(IN)    :: IELM1,IELM2,IELMX,NPOIN,NPMAX,S,P,SIZXA
00154       INTEGER, INTENT(IN)    :: NDP
00155       INTEGER, INTENT(INOUT) :: NPT
00156       INTEGER, INTENT(IN) :: NELEM,NELMAX,LV,DIMIKM,MXPTVS,NPTFR,SIZGLO
00157       INTEGER, INTENT(IN) :: IKLE(NELMAX,*),IKLEM1(*),LIMVOI(*)
00158       INTEGER, INTENT(IN) :: GLOSEG(SIZGLO,2)
00159       CHARACTER(LEN=8), INTENT(IN)    :: OP
00160       CHARACTER(LEN=1),INTENT(IN)     :: TYPDIA,TYPEXT
00161       DOUBLE PRECISION, INTENT(INOUT) :: X(*)
00162       DOUBLE PRECISION, INTENT(IN)    :: Y(*),DA(*),XA(SIZXA,*),C
00163       DOUBLE PRECISION, INTENT(INOUT) :: W(NELMAX,*)
00164       LOGICAL, INTENT(IN)             :: LEGO
00165       TYPE(BIEF_MESH), INTENT(IN)     :: MESH
00166 !
00167 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00168 !
00169       INTEGER NSEG1,NSEG2,SYM,NPT2
00170 !
00171       INTEGER AAQ(3,3,2),ABQ(3,4,2),BAQ(4,3,2)
00172       INTEGER ACQ(3,6,2),BBQ(4,4,2),CAQ(6,3,2),PPQ(6,6,2)
00173       INTEGER AAS(3,3,2),BBS(4,4,2),PPS(6,6,2)
00174 !      INTEGER OOS(2,2,2)
00175 !
00176       DOUBLE PRECISION Z(1)
00177 !
00178       INTRINSIC MIN
00179 !
00180 !     THESE DATA ALSO APPEAR IN MATVCT
00181 !
00182 !     DATA OOS/  0 ,  1 ,
00183 !    *           1 ,  0 ,
00184 ! S=2 NOT IMPLEMENTED
00185 !    *           0 ,  0 ,
00186 !    *           0 ,  0 /
00187 !
00188 !     SYMMETRICAL P1-P1 EBE (S=1)
00189       DATA AAS/  0 ,  1 ,  2 ,
00190      &           1 ,  0 ,  3 ,
00191      &           2 ,  3 ,  0 ,
00192 !     SYMMETRICAL P1-P1 PRE-ASSEMBLED EBE (S=2)
00193      &           0 ,  1 ,  3 ,
00194      &           1 ,  0 ,  2 ,
00195      &           3 ,  2 ,  0 /
00196 !
00197 !     NONSYMMETRICAL P1-P1 EBE (S=1)
00198       DATA AAQ/  0 ,  4 ,  5 ,
00199      &           1 ,  0 ,  6 ,
00200      &           2 ,  3 ,  0 ,
00201 !     NONSYMMETRICAL P1-P1 PRE-ASSEMBLED EBE (S=2)
00202      &           0 ,  4 ,  3 ,
00203      &           1 ,  0 ,  5 ,
00204      &           6 ,  2 ,  0 /
00205 !
00206 !     SYMMETRICAL QUASI-BUBBLE QUASI-BUBBLE EBE (S=1)
00207       DATA BBS/  0 ,  1 ,  2 ,  3 ,
00208      &           1 ,  0 ,  4 ,  5 ,
00209      &           2 ,  4 ,  0 ,  6 ,
00210      &           3 ,  5 ,  6 ,  0 ,
00211 !     SYMMETRICAL QUASI-BUBBLE QUASI-BUBBLE PRE-ASSEMBLED EBE (S=2)
00212      &           0 ,  4 ,  6 ,  1 ,
00213      &           4 ,  0 ,  5 ,  2 ,
00214      &           6 ,  5 ,  0 ,  3 ,
00215      &           1 ,  2 ,  3 ,  0 /
00216 !
00217 !     NONSYMMETRICAL QUASI-BUBBLE QUASI-BUBBLE EBE (S=1)
00218       DATA BBQ/  0 ,  7 ,  8 ,  9 ,
00219      &           1 ,  0 , 10 , 11 ,
00220      &           2 ,  4 ,  0 , 12 ,
00221      &           3 ,  5 ,  6 ,  0 ,
00222 !     NONSYMMETRICAL QUASI-BUBBLE QUASI-BUBBLE PRE-ASSEMBLED EBE (S=2)
00223      &           0 , 10 ,  6 ,  7 ,
00224      &           4 ,  0 , 11 ,  8 ,
00225      &          12 ,  5 ,  0 ,  9 ,
00226      &           1 ,  2 ,  3 ,  0 /
00227 !
00228 !     NONSYMMETRICAL P1 QUASI-BUBBLE EBE (S=1)
00229       DATA ABQ/  0 ,  4 ,  7 ,
00230      &           1 ,  0 ,  8 ,
00231      &           2 ,  5 ,  0 ,
00232      &           3 ,  6 ,  9 ,
00233 !     NONSYMMETRICAL P1 QUASI-BUBBLE PRE-ASSEMBLED EBE (S=2)
00234      &           0 ,  7 ,  3 ,
00235      &           1 ,  0 ,  8 ,
00236      &           9 ,  2 ,  0 ,
00237      &           4 ,  5 ,  6 /
00238 !     NONSYMMETRICAL P1 P2 EBE (S=1)
00239       DATA ACQ/   0 ,  6 ,  11,
00240      &            1 ,  0 ,  12,
00241      &            2 ,  7 ,  0 ,
00242      &            3 ,  8 ,  13,
00243      &            4 ,  9 ,  14,
00244      &            5 ,  10,  15,
00245 ! S=2 NOT IMPLEMENTED
00246      &            0 ,  0 ,  0 ,
00247      &            0 ,  0 ,  0 ,
00248      &            0 ,  0 ,  0 ,
00249      &            0 ,  0 ,  0 ,
00250      &            0 ,  0 ,  0 ,
00251      &            0 ,  0 ,  0 /
00252 !     NONSYMMETRICAL QUASI-BUBBLE P1 EBE (S=1)
00253       DATA BAQ/  0 ,  3 ,  5 ,  7 ,
00254      &           1 ,  0 ,  6 ,  8 ,
00255      &           2 ,  4 ,  0 ,  9 ,
00256 !     NONSYMMETRICAL QUASI-BUBBLE P1 PRE-ASSEMBLED EBE (S=2)
00257      &           0 ,  7 ,  3 ,  4 ,
00258      &           1 ,  0 ,  8 ,  5 ,
00259      &           9 ,  2 ,  0 ,  6 /
00260 !     NONSYMMETRICAL P2 P1 EBE (S=1)
00261       DATA CAQ/  0 ,  3 ,  5 ,  7 , 10 , 13 ,
00262      &           1 ,  0 ,  6 ,  8 , 11 , 14 ,
00263      &           2 ,  4 ,  0 ,  9 , 12 , 15 ,
00264 !     NONSYMMETRICAL P2 P1 PRE-ASSEMBLED EBE (S=2)
00265 !     - NOT IMPLEMENTED
00266      &           0 ,  0 ,  0 ,  0 ,  0 ,  0 ,
00267      &           0 ,  0 ,  0 ,  0 ,  0 ,  0 ,
00268      &           0 ,  0 ,  0 ,  0 ,  0 ,  0 /
00269 !
00270 !     SYMMETRICAL P1-P1 PRISMS AND P2 TRIANGLES EBE (S=1)
00271       DATA PPS/  0 ,  1 ,  2 ,  3 ,  4 ,  5 ,
00272      &           1 ,  0 ,  6 ,  7 ,  8 ,  9 ,
00273      &           2 ,  6 ,  0 , 10 , 11 , 12 ,
00274      &           3 ,  7 , 10 ,  0 , 13 , 14 ,
00275      &           4 ,  8 , 11 , 13 ,  0 , 15 ,
00276      &           5 ,  9 , 12 , 14 , 15 ,  0 ,
00277 !     SYMMETRICAL P1-P1 PRISMS AND P2 TRIANGLES PRE-ASSEMBLED EBE (S=2)
00278 !     - NOT IMPLEMENTED
00279      &           0 ,  0 ,  0 ,  0 ,  0 ,  0 ,
00280      &           0 ,  0 ,  0 ,  0 ,  0 ,  0 ,
00281      &           0 ,  0 ,  0 ,  0 ,  0 ,  0 ,
00282      &           0 ,  0 ,  0 ,  0 ,  0 ,  0 ,
00283      &           0 ,  0 ,  0 ,  0 ,  0 ,  0 ,
00284      &           0 ,  0 ,  0 ,  0 ,  0 ,  0 /
00285 !
00286 !     NONSYMMETRICAL P1-P1 PRISMS AND P2 TRIANGLES EBE (S=1)
00287       DATA PPQ/  0 , 16 , 17 , 18 , 19 , 20 ,
00288      &           1 ,  0 , 21 , 22 , 23 , 24 ,
00289      &           2 ,  6 ,  0 , 25 , 26 , 27 ,
00290      &           3 ,  7 , 10 ,  0 , 28 , 29 ,
00291      &           4 ,  8 , 11 , 13 ,  0 , 30 ,
00292      &           5 ,  9 , 12 , 14 , 15 ,  0 ,
00293 !    NONSYMMETRICAL P1-P1 PRISMS AND P2 TRIANGLES PRE-ASSEMBLED EBE (S=2)
00294 !     - NOT IMPLEMENTED
00295      &           0 ,  0 ,  0 ,  0 ,  0 ,  0 ,
00296      &           0 ,  0 ,  0 ,  0 ,  0 ,  0 ,
00297      &           0 ,  0 ,  0 ,  0 ,  0 ,  0 ,
00298      &           0 ,  0 ,  0 ,  0 ,  0 ,  0 ,
00299      &           0 ,  0 ,  0 ,  0 ,  0 ,  0 ,
00300      &           0 ,  0 ,  0 ,  0 ,  0 ,  0 /
00301 !
00302 !-----------------------------------------------------------------------
00303 !
00304       IF(S.EQ.1) THEN
00305 !
00306 !-----------------------------------------------------------------------
00307 !
00308 !     TRADITIONAL EBE STORAGE AND TRADITIONAL EBE MATRIX X VECTOR PRODUCT
00309 !
00310 !-----------------------------------------------------------------------
00311 !
00312       IF(IELM1.EQ.1) THEN
00313 !
00314         IF(IELM2.EQ.1) THEN
00315           CALL MV0202(OP, X , DA,TYPDIA,
00316      &                XA(1,1),XA(1,2),TYPEXT, Y,C,
00317      &                IKLE(1,1),IKLE(1,2),
00318      &                NPT,NELEM,W(1,1),W(1,2))
00319         ELSE
00320           IF (LNG.EQ.1) WRITE(LU,100) IELM1,IELM2,S
00321           IF (LNG.EQ.2) WRITE(LU,101) IELM1,IELM2,S
00322           CALL PLANTE(1)
00323           STOP
00324         ENDIF
00325 !
00326       ELSEIF(IELM1.EQ.11) THEN
00327 !
00328         IF(IELM2.EQ.11) THEN
00329           IF(TYPEXT(1:1).EQ.'S') THEN
00330             CALL MV0303(OP, X , DA,TYPDIA,
00331      &                  XA(1,AAS(1,2,S)),
00332      &                  XA(1,AAS(1,3,S)),
00333      &                  XA(1,AAS(2,1,S)),
00334      &                  XA(1,AAS(2,3,S)),
00335      &                  XA(1,AAS(3,1,S)),
00336      &                  XA(1,AAS(3,2,S)),
00337      &                  TYPEXT,Y,C,
00338      &                  IKLE(1,1),IKLE(1,2),IKLE(1,3),
00339      &                  NPT,NELEM,
00340      &                  W(1,1),W(1,2),W(1,3))
00341           ELSE
00342             CALL MV0303(OP, X , DA,TYPDIA,
00343      &                  XA(1,AAQ(1,2,S)),
00344      &                  XA(1,AAQ(1,3,S)),
00345      &                  XA(1,AAQ(2,1,S)),
00346      &                  XA(1,AAQ(2,3,S)),
00347      &                  XA(1,AAQ(3,1,S)),
00348      &                  XA(1,AAQ(3,2,S)),
00349      &                  TYPEXT,Y,C,
00350      &                  IKLE(1,1),IKLE(1,2),IKLE(1,3),
00351      &                  NPT,NELEM,
00352      &                  W(1,1),W(1,2),W(1,3))
00353           ENDIF
00354 !
00355         ELSEIF(IELM2.EQ.12) THEN
00356 !
00357           CALL MV0304(OP, X , DA,TYPDIA,
00358      &                XA(1,ABQ(1,2,S)),
00359      &                XA(1,ABQ(1,3,S)),
00360      &                XA(1,ABQ(1,4,S)),
00361      &                XA(1,ABQ(2,1,S)),
00362      &                XA(1,ABQ(2,3,S)),
00363      &                XA(1,ABQ(2,4,S)),
00364      &                XA(1,ABQ(3,1,S)),
00365      &                XA(1,ABQ(3,2,S)),
00366      &                XA(1,ABQ(3,4,S)),
00367      &                TYPEXT, Y,C,
00368      &                IKLE(1,1),IKLE(1,2),IKLE(1,3),IKLE(1,4),
00369      &                NPT,NELEM,
00370      &                W(1,1),W(1,2),W(1,3),W(1,4))
00371 !
00372         ELSEIF(IELM2.EQ.13) THEN
00373 !
00374           NPT2=BIEF_NBPTS(IELM2,MESH)
00375           CALL MV0306(OP, X , DA,TYPDIA,
00376      &                XA(1,ACQ(1,2,S)), XA(1,ACQ(1,3,S)),
00377      &                XA(1,ACQ(1,4,S)), XA(1,ACQ(1,5,S)),
00378      &                XA(1,ACQ(1,6,S)), XA(1,ACQ(2,1,S)),
00379      &                XA(1,ACQ(2,3,S)), XA(1,ACQ(2,4,S)),
00380      &                XA(1,ACQ(2,5,S)), XA(1,ACQ(2,6,S)),
00381      &                XA(1,ACQ(3,1,S)), XA(1,ACQ(3,2,S)),
00382      &                XA(1,ACQ(3,4,S)), XA(1,ACQ(3,5,S)),
00383      &                XA(1,ACQ(3,6,S)),
00384      &                TYPEXT, Y,C,
00385      &                IKLE(1,1),IKLE(1,2),IKLE(1,3),
00386      &                IKLE(1,4),IKLE(1,5),IKLE(1,6),
00387      &                NPT,NPT2,NELEM,
00388      &                W(1,1),W(1,2),W(1,3),
00389      &                W(1,4),W(1,5),W(1,6))
00390 !
00391         ELSE
00392           IF (LNG.EQ.1) WRITE(LU,100) IELM1,IELM2,S
00393           IF (LNG.EQ.2) WRITE(LU,101) IELM1,IELM2,S
00394           CALL PLANTE(1)
00395           STOP
00396         ENDIF
00397 !
00398       ELSEIF(IELM1.EQ.12.OR.IELM2.EQ.31.OR.IELM2.EQ.51) THEN
00399 !
00400         IF(IELM2.EQ.12.OR.IELM2.EQ.31.OR.IELM2.EQ.51) THEN
00401           IF(TYPEXT(1:1).EQ.'S') THEN
00402             CALL MV0404(OP, X , DA,TYPDIA,
00403      &                  XA(1,BBS(1,2,S)),
00404      &                  XA(1,BBS(1,3,S)),
00405      &                  XA(1,BBS(1,4,S)),
00406      &                  XA(1,BBS(2,1,S)),
00407      &                  XA(1,BBS(2,3,S)),
00408      &                  XA(1,BBS(2,4,S)),
00409      &                  XA(1,BBS(3,1,S)),
00410      &                  XA(1,BBS(3,2,S)),
00411      &                  XA(1,BBS(3,4,S)),
00412      &                  XA(1,BBS(4,1,S)),
00413      &                  XA(1,BBS(4,2,S)),
00414      &                  XA(1,BBS(4,3,S)),
00415      &                  TYPEXT, Y,C,
00416      &                  IKLE(1,1),IKLE(1,2),IKLE(1,3),IKLE(1,4),
00417      &                  NPT,NELEM,
00418      &                  W(1,1),W(1,2),W(1,3),W(1,4))
00419           ELSE
00420             CALL MV0404(OP, X , DA,TYPDIA,
00421      &                  XA(1,BBQ(1,2,S)),
00422      &                  XA(1,BBQ(1,3,S)),
00423      &                  XA(1,BBQ(1,4,S)),
00424      &                  XA(1,BBQ(2,1,S)),
00425      &                  XA(1,BBQ(2,3,S)),
00426      &                  XA(1,BBQ(2,4,S)),
00427      &                  XA(1,BBQ(3,1,S)),
00428      &                  XA(1,BBQ(3,2,S)),
00429      &                  XA(1,BBQ(3,4,S)),
00430      &                  XA(1,BBQ(4,1,S)),
00431      &                  XA(1,BBQ(4,2,S)),
00432      &                  XA(1,BBQ(4,3,S)),
00433      &                  TYPEXT, Y,C,
00434      &                  IKLE(1,1),IKLE(1,2),IKLE(1,3),IKLE(1,4),
00435      &                  NPT,NELEM,
00436      &                  W(1,1),W(1,2),W(1,3),W(1,4))
00437           ENDIF
00438         ELSEIF(IELM2.EQ.11) THEN
00439           CALL MV0403(OP, X , DA,TYPDIA,
00440      &                XA(1,BAQ(1,2,S)),
00441      &                XA(1,BAQ(1,3,S)),
00442      &                XA(1,BAQ(2,1,S)),
00443      &                XA(1,BAQ(2,3,S)),
00444      &                XA(1,BAQ(3,1,S)),
00445      &                XA(1,BAQ(3,2,S)),
00446      &                XA(1,BAQ(4,1,S)),
00447      &                XA(1,BAQ(4,2,S)),
00448      &                XA(1,BAQ(4,3,S)),
00449      &                TYPEXT, Y,C,
00450      &                IKLE(1,1),IKLE(1,2),IKLE(1,3),IKLE(1,4),
00451      &                NPT,NELEM,
00452      &                W(1,1),W(1,2),W(1,3),W(1,4))
00453         ELSE
00454           IF (LNG.EQ.1) WRITE(LU,100) IELM1,IELM2,S
00455           IF (LNG.EQ.2) WRITE(LU,101) IELM1,IELM2,S
00456           CALL PLANTE(1)
00457           STOP
00458         ENDIF
00459 !
00460       ELSEIF(IELM1.EQ.41.OR.IELM1.EQ.13) THEN
00461 !
00462         IF(IELM2.EQ.41.OR.IELM2.EQ.13) THEN
00463 !
00464           CALL MV0606(OP, X , DA,TYPDIA,XA,TYPEXT, Y,C,
00465      &                IKLE(1,1),IKLE(1,2),IKLE(1,3),
00466      &                IKLE(1,4),IKLE(1,5),IKLE(1,6),
00467      &                NPT,NELEM,NELMAX,
00468      &                W(1,1),W(1,2),W(1,3),W(1,4),W(1,5),W(1,6))
00469 !
00470         ELSEIF(IELM2.EQ.11) THEN
00471 !
00472 !         HERE IELM1=13
00473           NPT2=BIEF_NBPTS(IELM1,MESH)
00474           CALL MV0603(OP, X , DA,TYPDIA,
00475      &                XA(1,CAQ(1,2,S)),XA(1,CAQ(1,3,S)),
00476      &                XA(1,CAQ(2,1,S)),XA(1,CAQ(2,3,S)),
00477      &                XA(1,CAQ(3,1,S)),XA(1,CAQ(3,2,S)),
00478      &                XA(1,CAQ(4,1,S)),XA(1,CAQ(4,2,S)),
00479      &                XA(1,CAQ(4,3,S)),XA(1,CAQ(5,1,S)),
00480      &                XA(1,CAQ(5,2,S)),XA(1,CAQ(5,3,S)),
00481      &                XA(1,CAQ(6,1,S)),XA(1,CAQ(6,2,S)),
00482      &                XA(1,CAQ(6,3,S)),
00483      &                TYPEXT, Y,C,
00484      &                IKLE(1,1),IKLE(1,2),IKLE(1,3),
00485      &                IKLE(1,4),IKLE(1,5),IKLE(1,6),
00486      &                NPT,NPT2,NELEM,
00487      &                W(1,1),W(1,2),W(1,3),
00488      &                W(1,4),W(1,5),W(1,6))
00489 !
00490         ELSE
00491           IF (LNG.EQ.1) WRITE(LU,100) IELM1,IELM2,S
00492           IF (LNG.EQ.2) WRITE(LU,101) IELM1,IELM2,S
00493           CALL PLANTE(1)
00494           STOP
00495         ENDIF
00496 !
00497 !  IELM1 NOT IMPLEMENTED : ERROR
00498 !
00499       ELSE
00500 !
00501         IF (LNG.EQ.1) WRITE(LU,100) IELM1,IELM2,S
00502         IF (LNG.EQ.2) WRITE(LU,101) IELM1,IELM2,S
00503 100     FORMAT(1X,'MATVCT (BIEF) : ELEMENTS ',1I2,' ET ',1I2,/,1X,
00504      &            'ET STOCKAGE ',1I2,'   CAS NON PREVU')
00505 101     FORMAT(1X,'MATVCT (BIEF) : ELEMENTS ',1I2,' AND ',1I2,/,1X,
00506      &            'AND STORAGE ',1I2,'   CASE NOT IMPLEMENTED')
00507         CALL PLANTE(1)
00508         STOP
00509 !
00510       ENDIF
00511 !
00512 !     POSSIBLE FINAL ASSEMBLY OF X
00513 !
00514 !     SINCE INIT = FALSE HERE, MAY NOT NEED NPT
00515       NPT = BIEF_NBPTS(IELMX,MESH)
00516       IF(LEGO) CALL ASSVEC(X,IKLE,NPT,NELEM,NELMAX,IELMX,W,
00517      &                     .FALSE.,LV,.FALSE.,Z,NDP)
00518 !
00519       ELSEIF(S.EQ.3.AND.P.EQ.2) THEN
00520 !
00521 !-----------------------------------------------------------------------
00522 !
00523 !  SEGMENT STORAGE AND FRONTAL MATRIX X VECTOR PRODUCT
00524 !
00525 !-----------------------------------------------------------------------
00526 !
00527       IF(IELM1.EQ.1) THEN
00528 !
00529         IF(IELM2.EQ.1) THEN
00530 !         CALL MW0202(OP, X , DA,TYPDIA,
00531 !    *                XA(1,1),XA(1,2),TYPEXT, Y,C,
00532 !    *                IKLE(1,1),IKLE(1,2),
00533 !    *                NPT,NELEM,
00534 !    *                W(1,1),W(1,2))
00535 !       ELSE
00536           IF (LNG.EQ.1) WRITE(LU,100) IELM1,IELM2,S
00537           IF (LNG.EQ.2) WRITE(LU,101) IELM1,IELM2,S
00538           CALL PLANTE(1)
00539           STOP
00540         ENDIF
00541 !
00542       ELSEIF(IELM1.EQ.11) THEN
00543 !
00544         IF(IELM2.EQ.11) THEN
00545 !
00546           CALL MW0303(OP, X , DA,TYPDIA,XA,TYPEXT, Y,C,
00547      &                IKLEM1,DIMIKM,LIMVOI,MXPTVS,NPMAX,NPOIN,W)
00548 !
00549         ELSEIF(IELM2.EQ.12) THEN
00550 !
00551 !         CALL MW0304(OP, X , DA,TYPDIA,
00552 !    *                XA(1,1),XA(1,2),XA(1,3),
00553 !    *                XA(1,4),XA(1,5),XA(1,6),
00554 !    *                XA(1,7),XA(1,8),XA(1,9),
00555 !    *                TYPEXT, Y,C,
00556 !    *                IKLE(1,1),IKLE(1,2),IKLE(1,3),IKLE(1,4),
00557 !    *                NPT,NELEM,
00558 !    *                W(1,1),W(1,2),W(1,3),W(1,4))
00559 !       ELSE
00560           IF (LNG.EQ.1) WRITE(LU,100) IELM1,IELM2,S
00561           IF (LNG.EQ.2) WRITE(LU,101) IELM1,IELM2,S
00562           CALL PLANTE(1)
00563           STOP
00564         ENDIF
00565 !
00566       ELSEIF(IELM1.EQ.12) THEN
00567 !
00568         IF(IELM2.EQ.12) THEN
00569 !           CALL MW0404(OP, X , DA,TYPDIA,
00570 !    *                  XA(1,1),XA(1,2),XA(1,3),XA(1,1),
00571 !    *                  XA(1,4),XA(1,5),XA(1,2),XA(1,4),
00572 !    *                  XA(1,6),XA(1,3),XA(1,5),XA(1,6),
00573 !    *                  TYPEXT, Y,C,
00574 !    *                  IKLE(1,1),IKLE(1,2),IKLE(1,3),IKLE(1,4),
00575 !    *                  NPT,NELEM,
00576 !    *                  W(1,1),W(1,2),W(1,3),W(1,4))
00577 !       ELSEIF(IELM2.EQ.11) THEN
00578 !         CALL MW0403(OP, X , DA,TYPDIA,
00579 !    *                XA(1,1),XA(1,2),XA(1,3),
00580 !    *                XA(1,4),XA(1,5),XA(1,6),
00581 !    *                XA(1,7),XA(1,8),XA(1,9),
00582 !    *                TYPEXT, Y,C,
00583 !    *                IKLE(1,1),IKLE(1,2),IKLE(1,3),IKLE(1,4),
00584 !    *                NPT,NELEM,
00585 !    *                W(1,1),W(1,2),W(1,3),W(1,4))
00586 !       ELSE
00587           IF (LNG.EQ.1) WRITE(LU,100) IELM1,IELM2,S
00588           IF (LNG.EQ.2) WRITE(LU,101) IELM1,IELM2,S
00589           CALL PLANTE(1)
00590           STOP
00591         ENDIF
00592 !
00593       ELSEIF(IELM1.EQ.41) THEN
00594 !
00595         IF(IELM2.EQ.41) THEN
00596 !
00597 !         CALL MW0606(OP, X , DA,TYPDIA,XA,TYPEXT, Y,C,
00598 !    *                IKLE(1,1),IKLE(1,2),IKLE(1,3),
00599 !    *                IKLE(1,4),IKLE(1,5),IKLE(1,6),
00600 !    *                NPT,NELEM,NELMAX,
00601 !    *                W(1,1),W(1,2),W(1,3),W(1,4),W(1,5),W(1,6))
00602 !       ELSE
00603           IF (LNG.EQ.1) WRITE(LU,100) IELM1,IELM2,S
00604           IF (LNG.EQ.2) WRITE(LU,101) IELM1,IELM2,S
00605           CALL PLANTE(1)
00606           STOP
00607         ENDIF
00608 !
00609 !  IELM1 NOT IMPLEMENTED : ERROR
00610 !
00611       ELSE
00612 !
00613         IF (LNG.EQ.1) WRITE(LU,100) IELM1,IELM2,S
00614         IF (LNG.EQ.2) WRITE(LU,101) IELM1,IELM2,S
00615         CALL PLANTE(1)
00616         STOP
00617 !
00618       ENDIF
00619 !
00620 !  STORAGE BY SEGMENTS
00621 !
00622       ELSEIF(S.EQ.3.AND.P.EQ.1) THEN
00623 !
00624 !-----------------------------------------------------------------------
00625 !
00626 !  SEGMENT STORAGE AND TRADITIONAL MATRIX X VECTOR PRODUCT
00627 !
00628 !-----------------------------------------------------------------------
00629 !
00630       NSEG1 = BIEF_NBSEG(IELM1,MESH)
00631       NSEG2 = BIEF_NBSEG(IELM2,MESH)
00632 !
00633 !     IN LINEAR-QUADRATIC RECTANGULAR MATRICES, PURELY QUADRATIC
00634 !     SEGMENTS ARE NOT CONSIDERED (NUMBER 13,14 AND 15, SO 3 PER ELEMENT)
00635 !
00636       IF(IELM1.EQ.11.AND.IELM2.EQ.13) THEN
00637         NSEG2=NSEG2-3*NELEM
00638       ELSEIF(IELM1.EQ.13.AND.IELM2.EQ.11) THEN
00639         NSEG1=NSEG1-3*NELEM
00640       ENDIF
00641 !
00642       IF(TYPEXT(1:1).EQ.'Q') THEN
00643         SYM = MIN(NSEG1,NSEG2)
00644       ELSE
00645         SYM = 0
00646       ENDIF
00647       CALL MVSEG (OP, X , DA,TYPDIA,XA(1,1),XA(SYM+1,1),
00648      &            TYPEXT,Y,C,NPT,NELEM,NSEG1,NSEG2,
00649      &            GLOSEG(1,1),GLOSEG(1,2),IELM1,IELM2)
00650 !
00651 !-----------------------------------------------------------------------
00652 !
00653 !  STORAGE NOT IMPLEMENTED
00654 !
00655 !-----------------------------------------------------------------------
00656 !
00657       ELSE
00658         IF (LNG.EQ.1) WRITE(LU,102) S,P
00659         IF (LNG.EQ.2) WRITE(LU,103) S,P
00660 102     FORMAT(1X,'MATVCT (BIEF) : ',1I2,' ET ',1I2,/,1X,
00661      &            'STOCKAGE ET PRODUIT MATRICE-VECTEUR INCOMPATIBLES')
00662 103     FORMAT(1X,'MATVCT (BIEF) : ',1I2,' AND ',1I2,/,1X,
00663      &            'STORAGE AND MATRIX-VECTOR PRODUCT INCOMPATIBLE')
00664         CALL PLANTE(1)
00665         STOP
00666       ENDIF
00667 !
00668 !=======================================================================
00669 !
00670       RETURN
00671       END

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