mv0603.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\mv0603.f
00002 !
00080                      SUBROUTINE MV0603
00081 !                    *****************
00082 !
00083      &(OP, X , DA,TYPDIA,
00084      & XA12,XA13,XA21,XA23,XA31,XA32,XA41,XA42,XA43,
00085      & XA51,XA52,XA53,XA61,XA62,XA63,
00086      & TYPEXT, Y,C,
00087      & IKLE1,IKLE2,IKLE3,IKLE4,IKLE5,IKLE6,
00088      & NPOIN,NPT2,NELEM,W1,W2,W3,W4,W5,W6)
00089 !
00090 !***********************************************************************
00091 ! BIEF   V6P1                                   21/08/2010
00092 !***********************************************************************
00093 !
00094 !
00095 !
00096 !
00097 !
00098 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00099 !| C              |-->| A GIVEN CONSTANT
00100 !| DA             |-->| MATRIX DIAGONAL
00101 !| IKLE1          |-->| FIRST POINTS OF ELEMENTS
00102 !| IKLE2          |-->| SECOND POINTS OF ELEMENTS
00103 !| IKLE3          |-->| THIRD POINTS OF ELEMENTS
00104 !| IKLE4          |-->| FOURTH POINTS OF ELEMENTS
00105 !| IKLE5          |-->| FIFTH POINTS OF ELEMENTS
00106 !| IKLE6          |-->| SIXTH POINTS OF ELEMENTS
00107 !| NELEM          |-->| NUMBER OF ELEMENTS
00108 !| NPOIN          |-->| NUMBER OF LINEAR POINTS
00109 !| NPT2           |-->| NUMBER OF QUADRATIC POINTS
00110 !| OP             |-->| OPERATION TO BE DONE (SEE ABOVE)
00111 !| TYPDIA         |-->| TYPE OF DIAGONAL:
00112 !|                |   | TYPDIA = 'Q' : ANY VALUE
00113 !|                |   | TYPDIA = 'I' : IDENTITY
00114 !|                |   | TYPDIA = '0' : ZERO
00115 !| TYPEXT         |-->| TYPE OF OFF-DIAGONAL TERMS
00116 !|                |   | TYPEXT = 'Q' : ANY VALUE
00117 !|                |   | TYPEXT = 'S' : SYMMETRIC
00118 !|                |   | TYPEXT = '0' : ZERO
00119 !| W1             |<->| RESULT IN NON ASSEMBLED FORM
00120 !| W2             |<->| RESULT IN NON ASSEMBLED FORM
00121 !| W3             |<->| RESULT IN NON ASSEMBLED FORM
00122 !| W4             |<->| RESULT IN NON ASSEMBLED FORM
00123 !| W5             |<->| RESULT IN NON ASSEMBLED FORM
00124 !| W6             |<->| RESULT IN NON ASSEMBLED FORM
00125 !| X              |<->| RESULT IN ASSEMBLED FORM
00126 !| XA13           |-->| OFF-DIAGONAL TERM OF MATRIX
00127 !| XA21           |-->| OFF-DIAGONAL TERM OF MATRIX
00128 !| XA23           |-->| OFF-DIAGONAL TERM OF MATRIX
00129 !| XA31           |-->| OFF-DIAGONAL TERM OF MATRIX
00130 !| XA32           |-->| OFF-DIAGONAL TERM OF MATRIX
00131 !| XA41           |-->| OFF-DIAGONAL TERM OF MATRIX
00132 !| XA42           |-->| OFF-DIAGONAL TERM OF MATRIX
00133 !| XA43           |-->| OFF-DIAGONAL TERM OF MATRIX|
00134 !| XA51           |-->| OFF-DIAGONAL TERM OF MATRIX
00135 !| XA52           |-->| OFF-DIAGONAL TERM OF MATRIX
00136 !| XA53           |-->| OFF-DIAGONAL TERM OF MATRIX
00137 !| XA61           |-->| OFF-DIAGONAL TERM OF MATRIX
00138 !| XA62           |-->| OFF-DIAGONAL TERM OF MATRIX
00139 !| XA63           |-->| OFF-DIAGONAL TERM OF MATRIX
00140 !| Y              |-->| VECTOR USED IN THE OPERATION
00141 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00142 !
00143       USE BIEF!, EX_MV0603 => MV0603
00144 !
00145       IMPLICIT NONE
00146       INTEGER LNG,LU
00147       COMMON/INFO/LNG,LU
00148 !
00149 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00150 !
00151       INTEGER, INTENT(IN) :: NELEM,NPOIN,NPT2
00152 !
00153       INTEGER, INTENT(IN) :: IKLE1(*),IKLE2(*),IKLE3(*)
00154       INTEGER, INTENT(IN) :: IKLE4(*),IKLE5(*),IKLE6(*)
00155 !
00156       DOUBLE PRECISION, INTENT(INOUT) :: W1(*),W2(*),W3(*)
00157       DOUBLE PRECISION, INTENT(INOUT) :: W4(*),W5(*),W6(*)
00158       DOUBLE PRECISION, INTENT(IN) :: Y(*),DA(*)
00159       DOUBLE PRECISION, INTENT(INOUT) :: X(*)
00160       DOUBLE PRECISION, INTENT(IN) :: XA12(*),XA13(*),XA21(*)
00161       DOUBLE PRECISION, INTENT(IN) :: XA23(*),XA31(*),XA32(*)
00162       DOUBLE PRECISION, INTENT(IN) :: XA41(*),XA42(*),XA43(*)
00163       DOUBLE PRECISION, INTENT(IN) :: XA51(*),XA52(*),XA53(*)
00164       DOUBLE PRECISION, INTENT(IN) :: XA61(*),XA62(*),XA63(*)
00165       DOUBLE PRECISION, INTENT(IN) :: C
00166 !
00167       CHARACTER(LEN=8), INTENT(IN) :: OP
00168       CHARACTER(LEN=1), INTENT(IN) :: TYPDIA,TYPEXT
00169 !
00170 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00171 !
00172       INTEGER IELEM
00173       DOUBLE PRECISION Z(1)
00174 !
00175 !-----------------------------------------------------------------------
00176 !
00177       IF(OP(1:8).EQ.'X=AY    ') THEN
00178 !
00179 !   CONTRIBUTION OF THE DIAGONAL:
00180 !
00181         IF(TYPDIA(1:1).EQ.'Q') THEN
00182           CALL OV ('X=YZ    ', X , Y , DA , C  , NPOIN )
00183         ELSEIF(TYPDIA(1:1).EQ.'I') THEN
00184           CALL OV ('X=Y     ', X , Y , Z  , C  , NPOIN )
00185         ELSEIF(TYPDIA(1:1).EQ.'0') THEN
00186           CALL OV ('X=C     ', X , Y , Z  , 0.D0 , NPOIN )
00187         ELSE
00188           IF (LNG.EQ.1) WRITE(LU,2000) TYPDIA
00189           IF (LNG.EQ.2) WRITE(LU,2001) TYPDIA
00190           CALL PLANTE(1)
00191           STOP
00192         ENDIF
00193 !
00194 !       THE DIAGONAL REACHES ONLY LINEAR POINTS, OTHERS NOT INITIALISED
00195 !       THEY ARE SET TO 0 HERE
00196         CALL OV ('X=C     ',X(NPOIN+1:NPT2),Y,Z,0.D0,NPT2-NPOIN)
00197 !
00198 !   CONTRIBUTION OF EXTRADIAGONAL TERMS:
00199 !
00200         IF(TYPEXT(1:1).EQ.'Q') THEN
00201 !
00202           DO IELEM = 1 , NELEM
00203             W1(IELEM) =     XA12(IELEM) * Y(IKLE2(IELEM))
00204      &                    + XA13(IELEM) * Y(IKLE3(IELEM))
00205             W2(IELEM) =     XA21(IELEM) * Y(IKLE1(IELEM))
00206      &                    + XA23(IELEM) * Y(IKLE3(IELEM))
00207             W3(IELEM) =     XA31(IELEM) * Y(IKLE1(IELEM))
00208      &                    + XA32(IELEM) * Y(IKLE2(IELEM))
00209             W4(IELEM) =     XA41(IELEM) * Y(IKLE1(IELEM))
00210      &                    + XA42(IELEM) * Y(IKLE2(IELEM))
00211      &                    + XA43(IELEM) * Y(IKLE3(IELEM))
00212             W5(IELEM) =     XA51(IELEM) * Y(IKLE1(IELEM))
00213      &                    + XA52(IELEM) * Y(IKLE2(IELEM))
00214      &                    + XA53(IELEM) * Y(IKLE3(IELEM))
00215             W6(IELEM) =     XA61(IELEM) * Y(IKLE1(IELEM))
00216      &                    + XA62(IELEM) * Y(IKLE2(IELEM))
00217      &                    + XA63(IELEM) * Y(IKLE3(IELEM))
00218           ENDDO ! IELEM
00219 !
00220         ELSEIF(TYPEXT(1:1).EQ.'0') THEN
00221 !
00222           CALL OV ('X=C     ', W1 , Y , Z , 0.D0 , NELEM )
00223           CALL OV ('X=C     ', W2 , Y , Z , 0.D0 , NELEM )
00224           CALL OV ('X=C     ', W3 , Y , Z , 0.D0 , NELEM )
00225           CALL OV ('X=C     ', W4 , Y , Z , 0.D0 , NELEM )
00226           CALL OV ('X=C     ', W5 , Y , Z , 0.D0 , NELEM )
00227           CALL OV ('X=C     ', W6 , Y , Z , 0.D0 , NELEM )
00228 !
00229         ELSE
00230 !
00231           IF (LNG.EQ.1) WRITE(LU,1000) TYPEXT
00232           IF (LNG.EQ.2) WRITE(LU,1001) TYPEXT
00233           CALL PLANTE(1)
00234           STOP
00235 !
00236         ENDIF
00237 !
00238 !-----------------------------------------------------------------------
00239 !
00240       ELSEIF(OP(1:8).EQ.'X=-AY   ') THEN
00241 !
00242 !   CONTRIBUTION OF THE DIAGONAL:
00243 !
00244         IF(TYPDIA(1:1).EQ.'Q') THEN
00245           CALL OV ('X=-YZ   ', X , Y , DA , C  , NPOIN )
00246         ELSEIF(TYPDIA(1:1).EQ.'I') THEN
00247           CALL OV ('X=-Y    ', X , Y , Z  , C  , NPOIN )
00248         ELSEIF(TYPDIA(1:1).EQ.'0') THEN
00249           CALL OV ('X=C     ', X , Y , Z  , 0.D0 , NPOIN )
00250         ELSE
00251           IF (LNG.EQ.1) WRITE(LU,2000) TYPDIA
00252           IF (LNG.EQ.2) WRITE(LU,2001) TYPDIA
00253           CALL PLANTE(1)
00254           STOP
00255         ENDIF
00256 !
00257 !       THE DIAGONAL REACHES ONLY LINEAR POINTS, OTHERS NOT INITIALISED
00258 !       THEY ARE SET TO 0 HERE
00259         CALL OV ('X=C     ',X(NPOIN+1:NPT2),Y,Z,0.D0,NPT2-NPOIN)
00260 !
00261 !   CONTRIBUTION OF EXTRADIAGONAL TERMS:
00262 !
00263         IF(TYPEXT(1:1).EQ.'Q') THEN
00264 !
00265           DO IELEM = 1 , NELEM
00266             W1(IELEM) =   - XA12(IELEM) * Y(IKLE2(IELEM))
00267      &                    - XA13(IELEM) * Y(IKLE3(IELEM))
00268             W2(IELEM) =   - XA21(IELEM) * Y(IKLE1(IELEM))
00269      &                    - XA23(IELEM) * Y(IKLE3(IELEM))
00270             W3(IELEM) =   - XA31(IELEM) * Y(IKLE1(IELEM))
00271      &                    - XA32(IELEM) * Y(IKLE2(IELEM))
00272             W4(IELEM) =   - XA41(IELEM) * Y(IKLE1(IELEM))
00273      &                    - XA42(IELEM) * Y(IKLE2(IELEM))
00274      &                    - XA43(IELEM) * Y(IKLE3(IELEM))
00275             W5(IELEM) =   - XA51(IELEM) * Y(IKLE1(IELEM))
00276      &                    - XA52(IELEM) * Y(IKLE2(IELEM))
00277      &                    - XA53(IELEM) * Y(IKLE3(IELEM))
00278             W6(IELEM) =   - XA61(IELEM) * Y(IKLE1(IELEM))
00279      &                    - XA62(IELEM) * Y(IKLE2(IELEM))
00280      &                    - XA63(IELEM) * Y(IKLE3(IELEM))
00281           ENDDO ! IELEM
00282 !
00283         ELSEIF(TYPEXT(1:1).EQ.'0') THEN
00284 !
00285           CALL OV ('X=C     ', W1 , Y , Z , 0.D0 , NELEM )
00286           CALL OV ('X=C     ', W2 , Y , Z , 0.D0 , NELEM )
00287           CALL OV ('X=C     ', W3 , Y , Z , 0.D0 , NELEM )
00288           CALL OV ('X=C     ', W4 , Y , Z , 0.D0 , NELEM )
00289           CALL OV ('X=C     ', W5 , Y , Z , 0.D0 , NELEM )
00290           CALL OV ('X=C     ', W6 , Y , Z , 0.D0 , NELEM )
00291 !
00292         ELSE
00293 !
00294           IF (LNG.EQ.1) WRITE(LU,1000) TYPEXT
00295           IF (LNG.EQ.2) WRITE(LU,1001) TYPEXT
00296           CALL PLANTE(1)
00297           STOP
00298 !
00299         ENDIF
00300 !
00301 !-----------------------------------------------------------------------
00302 !
00303       ELSEIF(OP(1:8).EQ.'X=X+AY  ') THEN
00304 !
00305 !   CONTRIBUTION OF EXTRADIAGONAL TERMS:
00306 !
00307         IF(TYPEXT(1:1).EQ.'Q') THEN
00308 !
00309           DO IELEM = 1 , NELEM
00310             W1(IELEM) = W1(IELEM) + XA12(IELEM) * Y(IKLE2(IELEM))
00311      &                            + XA13(IELEM) * Y(IKLE3(IELEM))
00312             W2(IELEM) = W2(IELEM) + XA21(IELEM) * Y(IKLE1(IELEM))
00313      &                            + XA23(IELEM) * Y(IKLE3(IELEM))
00314             W3(IELEM) = W3(IELEM) + XA31(IELEM) * Y(IKLE1(IELEM))
00315      &                            + XA32(IELEM) * Y(IKLE2(IELEM))
00316             W4(IELEM) = W4(IELEM) + XA41(IELEM) * Y(IKLE1(IELEM))
00317      &                            + XA42(IELEM) * Y(IKLE2(IELEM))
00318      &                            + XA43(IELEM) * Y(IKLE3(IELEM))
00319             W5(IELEM) = W5(IELEM) + XA51(IELEM) * Y(IKLE1(IELEM))
00320      &                            + XA52(IELEM) * Y(IKLE2(IELEM))
00321      &                            + XA53(IELEM) * Y(IKLE3(IELEM))
00322             W6(IELEM) = W6(IELEM) + XA61(IELEM) * Y(IKLE1(IELEM))
00323      &                            + XA62(IELEM) * Y(IKLE2(IELEM))
00324      &                            + XA63(IELEM) * Y(IKLE3(IELEM))
00325           ENDDO ! IELEM
00326 !
00327         ELSEIF(TYPEXT(1:1).NE.'0') THEN
00328 !
00329           IF (LNG.EQ.1) WRITE(LU,1000) TYPEXT
00330           IF (LNG.EQ.2) WRITE(LU,1001) TYPEXT
00331           CALL PLANTE(1)
00332           STOP
00333 !
00334         ENDIF
00335 !
00336 !   CONTRIBUTION OF THE DIAGONAL:
00337 !
00338         IF(TYPDIA(1:1).EQ.'Q') THEN
00339           CALL OV ('X=X+YZ  ', X , Y , DA , C , NPOIN )
00340         ELSEIF(TYPDIA(1:1).EQ.'I') THEN
00341           CALL OV ('X=X+Y   ', X , Y , Z  , C  , NPOIN )
00342         ELSEIF(TYPDIA(1:1).NE.'0') THEN
00343           IF (LNG.EQ.1) WRITE(LU,2000) TYPDIA
00344           IF (LNG.EQ.2) WRITE(LU,2001) TYPDIA
00345           CALL PLANTE(1)
00346           STOP
00347         ENDIF
00348 !
00349 !       THE DIAGONAL REACHES ONLY LINEAR POINTS, OTHERS NOT INITIALISED
00350 !       THEY ARE SET TO 0 HERE
00351         CALL OV ('X=C     ',X(NPOIN+1:NPT2),Y,Z,0.D0,NPT2-NPOIN)
00352 !
00353 !-----------------------------------------------------------------------
00354 !
00355       ELSEIF(OP(1:8).EQ.'X=X-AY  ') THEN
00356 !
00357 !   CONTRIBUTION OF EXTRADIAGONAL TERMS:
00358 !
00359         IF(TYPEXT(1:1).EQ.'Q') THEN
00360 !
00361           DO IELEM = 1 , NELEM
00362             W1(IELEM) = W1(IELEM) - XA12(IELEM) * Y(IKLE2(IELEM))
00363      &                            - XA13(IELEM) * Y(IKLE3(IELEM))
00364             W2(IELEM) = W2(IELEM) - XA21(IELEM) * Y(IKLE1(IELEM))
00365      &                            - XA23(IELEM) * Y(IKLE3(IELEM))
00366             W3(IELEM) = W3(IELEM) - XA31(IELEM) * Y(IKLE1(IELEM))
00367      &                            - XA32(IELEM) * Y(IKLE2(IELEM))
00368             W4(IELEM) = W4(IELEM) - XA41(IELEM) * Y(IKLE1(IELEM))
00369      &                            - XA42(IELEM) * Y(IKLE2(IELEM))
00370      &                            - XA43(IELEM) * Y(IKLE3(IELEM))
00371             W5(IELEM) = W5(IELEM) - XA51(IELEM) * Y(IKLE1(IELEM))
00372      &                            - XA52(IELEM) * Y(IKLE2(IELEM))
00373      &                            - XA53(IELEM) * Y(IKLE3(IELEM))
00374             W6(IELEM) = W6(IELEM) - XA61(IELEM) * Y(IKLE1(IELEM))
00375      &                            - XA62(IELEM) * Y(IKLE2(IELEM))
00376      &                            - XA63(IELEM) * Y(IKLE3(IELEM))
00377           ENDDO ! IELEM
00378 !
00379         ELSEIF(TYPEXT(1:1).NE.'0') THEN
00380 !
00381           IF (LNG.EQ.1) WRITE(LU,1000) TYPEXT
00382           IF (LNG.EQ.2) WRITE(LU,1001) TYPEXT
00383           CALL PLANTE(1)
00384           STOP
00385 !
00386         ENDIF
00387 !
00388 !   CONTRIBUTION OF THE DIAGONAL:
00389 !
00390         IF(TYPDIA(1:1).EQ.'Q') THEN
00391           CALL OV ('X=X-YZ  ', X , Y , DA , C , NPOIN )
00392         ELSEIF(TYPDIA(1:1).EQ.'I') THEN
00393           CALL OV ('X=X-Y   ', X , Y , Z  , C  , NPOIN )
00394         ELSEIF(TYPDIA(1:1).NE.'0') THEN
00395           IF (LNG.EQ.1) WRITE(LU,2000) TYPDIA
00396           IF (LNG.EQ.2) WRITE(LU,2001) TYPDIA
00397           CALL PLANTE(1)
00398           STOP
00399         ENDIF
00400 !
00401 !       THE DIAGONAL REACHES ONLY LINEAR POINTS, OTHERS NOT INITIALISED
00402 !       THEY ARE SET TO 0 HERE
00403         CALL OV ('X=C     ',X(NPOIN+1:NPT2),Y,Z,0.D0,NPT2-NPOIN)
00404 !
00405 !-----------------------------------------------------------------------
00406 !
00407       ELSEIF(OP(1:8).EQ.'X=X+CAY ') THEN
00408 !
00409 !   CONTRIBUTION OF EXTRADIAGONAL TERMS:
00410 !
00411         IF(TYPEXT(1:1).EQ.'Q') THEN
00412 !
00413           DO IELEM = 1 , NELEM
00414             W1(IELEM) = W1(IELEM)
00415      &              + C * (      XA12(IELEM) * Y(IKLE2(IELEM))
00416      &                         + XA13(IELEM) * Y(IKLE3(IELEM)) )
00417             W2(IELEM) = W2(IELEM)
00418      &              + C * (      XA21(IELEM) * Y(IKLE1(IELEM))
00419      &                         + XA23(IELEM) * Y(IKLE3(IELEM)) )
00420             W3(IELEM) = W3(IELEM)
00421      &              + C * (      XA31(IELEM) * Y(IKLE1(IELEM))
00422      &                         + XA32(IELEM) * Y(IKLE2(IELEM)) )
00423             W4(IELEM) = W4(IELEM)
00424      &              + C * (      XA41(IELEM) * Y(IKLE1(IELEM))
00425      &                         + XA42(IELEM) * Y(IKLE2(IELEM))
00426      &                         + XA43(IELEM) * Y(IKLE3(IELEM)) )
00427             W5(IELEM) = W5(IELEM)
00428      &              + C * (      XA51(IELEM) * Y(IKLE1(IELEM))
00429      &                         + XA52(IELEM) * Y(IKLE2(IELEM))
00430      &                         + XA53(IELEM) * Y(IKLE3(IELEM)) )
00431             W6(IELEM) = W6(IELEM)
00432      &              + C * (      XA61(IELEM) * Y(IKLE1(IELEM))
00433      &                         + XA62(IELEM) * Y(IKLE2(IELEM))
00434      &                         + XA63(IELEM) * Y(IKLE3(IELEM)) )
00435           ENDDO ! IELEM
00436 !
00437         ELSEIF(TYPEXT(1:1).NE.'0') THEN
00438 !
00439           IF (LNG.EQ.1) WRITE(LU,1000) TYPEXT
00440           IF (LNG.EQ.2) WRITE(LU,1001) TYPEXT
00441           CALL PLANTE(1)
00442           STOP
00443 !
00444         ENDIF
00445 !
00446 !   CONTRIBUTION OF THE DIAGONAL:
00447 !
00448         IF(TYPDIA(1:1).EQ.'Q') THEN
00449           CALL OV ('X=X+CYZ  ', X , Y , DA , C , NPOIN )
00450         ELSEIF(TYPDIA(1:1).EQ.'I') THEN
00451           CALL OV ('X=X+CY   ', X , Y , Z  , C  , NPOIN )
00452         ELSEIF(TYPDIA(1:1).NE.'0') THEN
00453           IF (LNG.EQ.1) WRITE(LU,2000) TYPDIA
00454           IF (LNG.EQ.2) WRITE(LU,2001) TYPDIA
00455           CALL PLANTE(1)
00456           STOP
00457         ENDIF
00458 !
00459 !       THE DIAGONAL REACHES ONLY LINEAR POINTS, OTHERS NOT INITIALISED
00460 !       THEY ARE SET TO 0 HERE
00461         CALL OV ('X=C     ',X(NPOIN+1:NPT2),Y,Z,0.D0,NPT2-NPOIN)
00462 !
00463 !-----------------------------------------------------------------------
00464 !
00465       ELSEIF(OP(1:8).EQ.'X=TAY   ') THEN
00466 !
00467 !   CONTRIBUTION OF THE DIAGONAL
00468 !
00469         IF(TYPDIA(1:1).EQ.'Q') THEN
00470           CALL OV ('X=YZ    ', X , Y , DA , C  , NPOIN )
00471         ELSEIF(TYPDIA(1:1).EQ.'I') THEN
00472           CALL OV ('X=Y     ', X , Y , Z  , C  , NPOIN )
00473         ELSEIF(TYPDIA(1:1).EQ.'0') THEN
00474           CALL OV ('X=C     ', X , Y , DA , 0.D0 , NPOIN )
00475         ELSE
00476           IF (LNG.EQ.1) WRITE(LU,2000) TYPDIA
00477           IF (LNG.EQ.2) WRITE(LU,2001) TYPDIA
00478           CALL PLANTE(1)
00479           STOP
00480         ENDIF
00481 !
00482 !   CONTRIBUTION OF EXTRADIAGONAL TERMS:
00483 !
00484         IF(TYPEXT(1:1).EQ.'Q') THEN
00485 !
00486           DO IELEM = 1 , NELEM
00487             W1(IELEM) =   + XA21(IELEM) * Y(IKLE2(IELEM))
00488      &                    + XA31(IELEM) * Y(IKLE3(IELEM))
00489      &                    + XA41(IELEM) * Y(IKLE4(IELEM))
00490      &                    + XA51(IELEM) * Y(IKLE5(IELEM))
00491      &                    + XA61(IELEM) * Y(IKLE6(IELEM))
00492             W2(IELEM) =   + XA12(IELEM) * Y(IKLE1(IELEM))
00493      &                    + XA32(IELEM) * Y(IKLE3(IELEM))
00494      &                    + XA42(IELEM) * Y(IKLE4(IELEM))
00495      &                    + XA52(IELEM) * Y(IKLE5(IELEM))
00496      &                    + XA62(IELEM) * Y(IKLE6(IELEM))
00497             W3(IELEM) =   + XA13(IELEM) * Y(IKLE1(IELEM))
00498      &                    + XA23(IELEM) * Y(IKLE2(IELEM))
00499      &                    + XA43(IELEM) * Y(IKLE4(IELEM))
00500      &                    + XA53(IELEM) * Y(IKLE5(IELEM))
00501      &                    + XA63(IELEM) * Y(IKLE6(IELEM))
00502           ENDDO ! IELEM
00503 !
00504         ELSEIF(TYPEXT(1:1).EQ.'0') THEN
00505 !
00506           CALL OV ('X=C     ', W1 , Y , Z , 0.D0 , NELEM )
00507           CALL OV ('X=C     ', W2 , Y , Z , 0.D0 , NELEM )
00508           CALL OV ('X=C     ', W3 , Y , Z , 0.D0 , NELEM )
00509 !
00510         ELSE
00511 !
00512           IF (LNG.EQ.1) WRITE(LU,1000) TYPEXT
00513           IF (LNG.EQ.2) WRITE(LU,1001) TYPEXT
00514           CALL PLANTE(1)
00515           STOP
00516 !
00517         ENDIF
00518 !
00519 !-----------------------------------------------------------------------
00520 !
00521       ELSEIF(OP(1:8).EQ.'X=-TAY  ') THEN
00522 !
00523 !   CONTRIBUTION OF EXTRADIAGONAL TERMS:
00524 !
00525         IF(TYPEXT(1:1).EQ.'Q') THEN
00526 !
00527           DO IELEM = 1 , NELEM
00528             W1(IELEM) =   - XA21(IELEM) * Y(IKLE2(IELEM))
00529      &                    - XA31(IELEM) * Y(IKLE3(IELEM))
00530      &                    - XA41(IELEM) * Y(IKLE4(IELEM))
00531      &                    - XA51(IELEM) * Y(IKLE5(IELEM))
00532      &                    - XA61(IELEM) * Y(IKLE6(IELEM))
00533             W2(IELEM) =   - XA12(IELEM) * Y(IKLE1(IELEM))
00534      &                    - XA32(IELEM) * Y(IKLE3(IELEM))
00535      &                    - XA42(IELEM) * Y(IKLE4(IELEM))
00536      &                    - XA52(IELEM) * Y(IKLE5(IELEM))
00537      &                    - XA62(IELEM) * Y(IKLE6(IELEM))
00538             W3(IELEM) =   - XA13(IELEM) * Y(IKLE1(IELEM))
00539      &                    - XA23(IELEM) * Y(IKLE2(IELEM))
00540      &                    - XA43(IELEM) * Y(IKLE4(IELEM))
00541      &                    - XA53(IELEM) * Y(IKLE5(IELEM))
00542      &                    - XA63(IELEM) * Y(IKLE6(IELEM))
00543           ENDDO ! IELEM
00544 !
00545         ELSEIF(TYPEXT(1:1).EQ.'0') THEN
00546 !
00547           CALL OV ('X=C     ', W1 , Y , Z , 0.D0 , NELEM )
00548           CALL OV ('X=C     ', W2 , Y , Z , 0.D0 , NELEM )
00549           CALL OV ('X=C     ', W3 , Y , Z , 0.D0 , NELEM )
00550 !
00551         ELSE
00552 !
00553           IF (LNG.EQ.1) WRITE(LU,1000) TYPEXT
00554           IF (LNG.EQ.2) WRITE(LU,1001) TYPEXT
00555           CALL PLANTE(1)
00556           STOP
00557 !
00558         ENDIF
00559 !
00560 !   CONTRIBUTION OF THE DIAGONAL
00561 !
00562         IF(TYPDIA(1:1).EQ.'Q') THEN
00563           CALL OV ('X=-YZ   ', X , Y , DA , C  , NPOIN )
00564         ELSEIF(TYPDIA(1:1).EQ.'I') THEN
00565           CALL OV ('X=-Y    ', X , Y , Z  , C  , NPOIN )
00566         ELSEIF(TYPDIA(1:1).EQ.'0') THEN
00567           CALL OV ('X=C     ', X , Y , DA , 0.D0 , NPOIN )
00568         ELSE
00569           IF (LNG.EQ.1) WRITE(LU,2000) TYPDIA
00570           IF (LNG.EQ.2) WRITE(LU,2001) TYPDIA
00571           CALL PLANTE(1)
00572           STOP
00573         ENDIF
00574 !
00575 !-----------------------------------------------------------------------
00576 !
00577       ELSEIF(OP(1:8).EQ.'X=X+TAY ') THEN
00578 !
00579 !   CONTRIBUTION OF EXTRADIAGONAL TERMS:
00580 !
00581         IF(TYPEXT(1:1).EQ.'Q') THEN
00582 !
00583           DO IELEM = 1 , NELEM
00584             W1(IELEM) = W1(IELEM) + XA21(IELEM) * Y(IKLE2(IELEM))
00585      &                            + XA31(IELEM) * Y(IKLE3(IELEM))
00586      &                            + XA41(IELEM) * Y(IKLE4(IELEM))
00587      &                            + XA51(IELEM) * Y(IKLE5(IELEM))
00588      &                            + XA61(IELEM) * Y(IKLE6(IELEM))
00589             W2(IELEM) = W2(IELEM) + XA12(IELEM) * Y(IKLE1(IELEM))
00590      &                            + XA32(IELEM) * Y(IKLE3(IELEM))
00591      &                            + XA42(IELEM) * Y(IKLE4(IELEM))
00592      &                            + XA52(IELEM) * Y(IKLE5(IELEM))
00593      &                            + XA62(IELEM) * Y(IKLE6(IELEM))
00594             W3(IELEM) = W3(IELEM) + XA13(IELEM) * Y(IKLE1(IELEM))
00595      &                            + XA23(IELEM) * Y(IKLE2(IELEM))
00596      &                            + XA43(IELEM) * Y(IKLE4(IELEM))
00597      &                            + XA53(IELEM) * Y(IKLE5(IELEM))
00598      &                            + XA63(IELEM) * Y(IKLE6(IELEM))
00599           ENDDO ! IELEM
00600 !
00601         ELSEIF(TYPEXT(1:1).NE.'0') THEN
00602 !
00603           IF (LNG.EQ.1) WRITE(LU,1000) TYPEXT
00604           IF (LNG.EQ.2) WRITE(LU,1001) TYPEXT
00605           CALL PLANTE(1)
00606           STOP
00607 !
00608         ENDIF
00609 !
00610 !   CONTRIBUTION OF THE DIAGONAL
00611 !
00612         IF(TYPDIA(1:1).EQ.'Q') THEN
00613           CALL OV ('X=X+YZ  ', X , Y , DA , C , NPOIN )
00614         ELSEIF(TYPDIA(1:1).EQ.'I') THEN
00615           CALL OV ('X=X+Y   ', X , Y , Z  , C  , NPOIN )
00616         ELSEIF(TYPDIA(1:1).NE.'0') THEN
00617           IF (LNG.EQ.1) WRITE(LU,2000) TYPDIA
00618           IF (LNG.EQ.2) WRITE(LU,2001) TYPDIA
00619           CALL PLANTE(1)
00620           STOP
00621         ENDIF
00622 !
00623 !-----------------------------------------------------------------------
00624 !
00625       ELSEIF(OP(1:8).EQ.'X=X-TAY ') THEN
00626 !
00627 !   CONTRIBUTION OF EXTRADIAGONAL TERMS:
00628 !
00629         IF(TYPEXT(1:1).EQ.'Q') THEN
00630 !
00631           DO IELEM = 1 , NELEM
00632             W1(IELEM) = W1(IELEM) - XA21(IELEM) * Y(IKLE2(IELEM))
00633      &                            - XA31(IELEM) * Y(IKLE3(IELEM))
00634      &                            - XA41(IELEM) * Y(IKLE4(IELEM))
00635      &                            - XA51(IELEM) * Y(IKLE5(IELEM))
00636      &                            - XA61(IELEM) * Y(IKLE6(IELEM))
00637             W2(IELEM) = W2(IELEM) - XA12(IELEM) * Y(IKLE1(IELEM))
00638      &                            - XA32(IELEM) * Y(IKLE3(IELEM))
00639      &                            - XA42(IELEM) * Y(IKLE4(IELEM))
00640      &                            - XA52(IELEM) * Y(IKLE5(IELEM))
00641      &                            - XA62(IELEM) * Y(IKLE6(IELEM))
00642             W3(IELEM) = W3(IELEM) - XA13(IELEM) * Y(IKLE1(IELEM))
00643      &                            - XA23(IELEM) * Y(IKLE2(IELEM))
00644      &                            - XA43(IELEM) * Y(IKLE4(IELEM))
00645      &                            - XA53(IELEM) * Y(IKLE5(IELEM))
00646      &                            - XA63(IELEM) * Y(IKLE6(IELEM))
00647           ENDDO ! IELEM
00648 !
00649         ELSEIF(TYPEXT(1:1).NE.'0') THEN
00650 !
00651           IF (LNG.EQ.1) WRITE(LU,1000) TYPEXT
00652           IF (LNG.EQ.2) WRITE(LU,1001) TYPEXT
00653           CALL PLANTE(1)
00654           STOP
00655 !
00656         ENDIF
00657 !
00658 !   CONTRIBUTION OF THE DIAGONAL
00659 !
00660         IF(TYPDIA(1:1).EQ.'Q') THEN
00661           CALL OV ('X=X-YZ  ', X , Y , DA , C , NPOIN )
00662         ELSEIF(TYPDIA(1:1).EQ.'I') THEN
00663           CALL OV ('X=X-Y   ', X , Y , Z  , C  , NPOIN )
00664         ELSEIF(TYPDIA(1:1).NE.'0') THEN
00665           IF (LNG.EQ.1) WRITE(LU,2000) TYPDIA
00666           IF (LNG.EQ.2) WRITE(LU,2001) TYPDIA
00667           CALL PLANTE(1)
00668           STOP
00669         ENDIF
00670 !
00671 !-----------------------------------------------------------------------
00672 !
00673       ELSEIF(OP(1:8).EQ.'X=X+CTAY') THEN
00674 !
00675 !   CONTRIBUTION OF EXTRADIAGONAL TERMS:
00676 !
00677         IF(TYPEXT(1:1).EQ.'Q') THEN
00678 !
00679           DO IELEM = 1 , NELEM
00680             W1(IELEM) = W1(IELEM)
00681      &                + C * (    + XA21(IELEM) * Y(IKLE2(IELEM))
00682      &                           + XA31(IELEM) * Y(IKLE3(IELEM))
00683      &                           + XA41(IELEM) * Y(IKLE4(IELEM))
00684      &                           + XA51(IELEM) * Y(IKLE5(IELEM))
00685      &                           + XA61(IELEM) * Y(IKLE6(IELEM)) )
00686             W2(IELEM) = W2(IELEM)
00687      &                + C * (    + XA12(IELEM) * Y(IKLE1(IELEM))
00688      &                           + XA32(IELEM) * Y(IKLE3(IELEM))
00689      &                           + XA42(IELEM) * Y(IKLE4(IELEM))
00690      &                           + XA52(IELEM) * Y(IKLE5(IELEM))
00691      &                           + XA62(IELEM) * Y(IKLE6(IELEM)) )
00692             W3(IELEM) = W3(IELEM)
00693      &                + C * (    + XA13(IELEM) * Y(IKLE1(IELEM))
00694      &                           + XA23(IELEM) * Y(IKLE2(IELEM))
00695      &                           + XA43(IELEM) * Y(IKLE4(IELEM))
00696      &                           + XA53(IELEM) * Y(IKLE5(IELEM))
00697      &                           + XA63(IELEM) * Y(IKLE6(IELEM)))
00698           ENDDO ! IELEM
00699 !
00700         ELSEIF(TYPEXT(1:1).NE.'0') THEN
00701 !
00702           IF (LNG.EQ.1) WRITE(LU,1000) TYPEXT
00703           IF (LNG.EQ.2) WRITE(LU,1001) TYPEXT
00704           CALL PLANTE(1)
00705           STOP
00706 !
00707         ENDIF
00708 !
00709 !   CONTRIBUTION OF THE DIAGONAL
00710 !
00711         IF(TYPDIA(1:1).EQ.'Q') THEN
00712           CALL OV ('X=X+CYZ ', X , Y , DA , C , NPOIN )
00713         ELSEIF(TYPDIA(1:1).EQ.'I') THEN
00714           CALL OV ('X=X+CY  ', X , Y , Z  , C  , NPOIN )
00715         ELSEIF(TYPDIA(1:1).NE.'0') THEN
00716           IF (LNG.EQ.1) WRITE(LU,2000) TYPDIA
00717           IF (LNG.EQ.2) WRITE(LU,2001) TYPDIA
00718           CALL PLANTE(1)
00719           STOP
00720         ENDIF
00721 !
00722 !-----------------------------------------------------------------------
00723 !
00724       ELSE
00725 !
00726         IF (LNG.EQ.1) WRITE(LU,3000) OP
00727         IF (LNG.EQ.2) WRITE(LU,3001) OP
00728         CALL PLANTE(1)
00729         STOP
00730 !
00731 !-----------------------------------------------------------------------
00732 !
00733       ENDIF
00734 !
00735 !-----------------------------------------------------------------------
00736 !
00737       RETURN
00738 !
00739 1000  FORMAT(1X,'MV0603 (BIEF) : TERMES EXTRADIAG. TYPE INCONNU: ',A1)
00740 1001  FORMAT(1X,'MV0603 (BIEF) : EXTRADIAG. TERMS  UNKNOWN TYPE : ',A1)
00741 2000  FORMAT(1X,'MV0603 (BIEF) : DIAGONALE : TYPE INCONNU: ',A1)
00742 2001  FORMAT(1X,'MV0603 (BIEF) : DIAGONAL : UNKNOWN TYPE : ',A1)
00743 3000  FORMAT(1X,'MV0603 (BIEF) : OPERATION INCONNUE : ',A8)
00744 3001  FORMAT(1X,'MV0603 (BIEF) : UNKNOWN OPERATION : ',A8)
00745 !
00746 !-----------------------------------------------------------------------
00747 !
00748       END

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