mv0306.f

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

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