om4141.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\om4141.f
00002 !
00122                      SUBROUTINE OM4141
00123 !                    *****************
00124 !
00125      &(OP ,  DM,TYPDIM,XM,TYPEXM,   DN,TYPDIN,XN,TYPEXN,   D,C,
00126      & IKLE,NELEM,NELMAX,NDIAG)
00127 !
00128 !***********************************************************************
00129 ! BIEF   V6P1                                   21/08/2010
00130 !***********************************************************************
00131 !
00132 !
00133 !
00134 !
00135 !
00136 !
00137 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00138 !| C              |-->| A GIVEN CONSTANT USED IN OPERATION OP
00139 !| D              |-->| A DIAGONAL MATRIX
00140 !| DM             |<->| DIAGONAL OF M
00141 !| DN             |-->| DIAGONAL OF N
00142 !| IKLE           |-->| CONNECTIVITY TABLE.
00143 !| NDIAG          |-->| NUMBER OF TERMS IN THE DIAGONAL
00144 !| NELEM          |-->| NUMBER OF ELEMENTS
00145 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00146 !| OP             |-->| OPERATION TO BE DONE (SEE ABOVE)
00147 !| TYPDIM         |<->| TYPE OF DIAGONAL OF M:
00148 !|                |   | TYPDIM = 'Q' : ANY VALUE
00149 !|                |   | TYPDIM = 'I' : IDENTITY
00150 !|                |   | TYPDIM = '0' : ZERO
00151 !| TYPDIN         |<->| TYPE OF DIAGONAL OF N:
00152 !|                |   | TYPDIN = 'Q' : ANY VALUE
00153 !|                |   | TYPDIN = 'I' : IDENTITY
00154 !|                |   | TYPDIN = '0' : ZERO
00155 !| TYPEXM         |-->| TYPE OF OFF-DIAGONAL TERMS OF M:
00156 !|                |   | TYPEXM = 'Q' : ANY VALUE
00157 !|                |   | TYPEXM = 'S' : SYMMETRIC
00158 !|                |   | TYPEXM = '0' : ZERO
00159 !| TYPEXN         |-->| TYPE OF OFF-DIAGONAL TERMS OF N:
00160 !|                |   | TYPEXN = 'Q' : ANY VALUE
00161 !|                |   | TYPEXN = 'S' : SYMMETRIC
00162 !|                |   | TYPEXN = '0' : ZERO
00163 !| XM             |-->| OFF-DIAGONAL TERMS OF M
00164 !| XN             |-->| OFF-DIAGONAL TERMS OF N
00165 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00166 !
00167       USE BIEF, EX_OM4141 => OM4141
00168 !
00169       IMPLICIT NONE
00170       INTEGER LNG,LU
00171       COMMON/INFO/LNG,LU
00172 !
00173 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00174 !
00175       INTEGER, INTENT(IN) :: NELEM,NELMAX,NDIAG
00176       INTEGER, INTENT(IN) :: IKLE(NELMAX,6)
00177       CHARACTER(LEN=8), INTENT(IN)    :: OP
00178       DOUBLE PRECISION, INTENT(IN)    :: DN(*),D(*),XN(NELMAX,*)
00179       DOUBLE PRECISION, INTENT(INOUT) :: DM(*),XM(NELMAX,*)
00180       CHARACTER(LEN=1), INTENT(INOUT) :: TYPDIM,TYPEXM,TYPDIN,TYPEXN
00181       DOUBLE PRECISION, INTENT(IN)    :: C
00182 !
00183 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00184 !
00185       INTEGER I,J,IELEM,I1,I2,I3,I4,I5,I6
00186 !
00187       DOUBLE PRECISION Z(1),Y(1)
00188 !
00189 !-----------------------------------------------------------------------
00190 !
00191       IF(OP(3:8).EQ.'N     ') THEN
00192 !
00193         IF(TYPDIN(1:1).EQ.'Q') THEN
00194           CALL OV( 'X=Y     ' , DM , DN , Z , C , NDIAG )
00195         ELSEIF(TYPDIN(1:1).EQ.'I'.OR.TYPDIN(1:1).EQ.'0') THEN
00196 !         NOTHING TO DO, ONLY NEEDS TO COPY TYPDIN
00197         ELSE
00198            IF (LNG.EQ.1) WRITE(LU,5) TYPDIN(1:1)
00199            IF (LNG.EQ.2) WRITE(LU,6) TYPDIN(1:1)
00200 5          FORMAT(1X,'OM4141 (BIEF) : TYPDIN INCONNU :',A1)
00201 6          FORMAT(1X,'OM4141 (BIEF) : TYPDIN UNKNOWN :',A1)
00202            CALL PLANTE(1)
00203            STOP
00204         ENDIF
00205         TYPDIM(1:1)=TYPDIN(1:1)
00206 !
00207         IF(TYPEXN(1:1).EQ.'S') THEN
00208           DO I=1,15
00209             CALL OV( 'X=Y     ' , XM(1,I) , XN(1,I) , Z , C , NELEM )
00210           ENDDO ! I
00211         ELSEIF(TYPEXN(1:1).EQ.'Q') THEN
00212           DO I=1,30
00213             CALL OV( 'X=Y     ' , XM(1,I) , XN(1,I) , Z , C , NELEM )
00214           ENDDO ! I
00215         ELSEIF(TYPEXN(1:1).NE.'0') THEN
00216           IF (LNG.EQ.1) WRITE(LU,10) TYPEXN(1:1)
00217           IF (LNG.EQ.2) WRITE(LU,11) TYPEXN(1:1)
00218 10        FORMAT(1X,'OM4141 (BIEF) : TYPEXN INCONNU :',A1)
00219 11        FORMAT(1X,'OM4141 (BIEF) : TYPEXN UNKNOWN :',A1)
00220           CALL PLANTE(1)
00221           STOP
00222         ENDIF
00223 !
00224         TYPEXM(1:1)=TYPEXN(1:1)
00225 !
00226 !-----------------------------------------------------------------------
00227 !
00228       ELSEIF(OP(3:8).EQ.'TN    ') THEN
00229 !
00230         CALL OV( 'X=Y     ' , DM       , DN       , Z , C , NDIAG )
00231 !
00232         IF(TYPEXN(1:1).EQ.'S') THEN
00233           DO I=1,15
00234             CALL OV( 'X=Y     ' , XM(1,I) , XN(1,I) , Z , C , NELEM )
00235           ENDDO
00236         ELSEIF(TYPEXN(1:1).EQ.'Q') THEN
00237           DO I=1,15
00238             CALL OV( 'X=Y     ' , XM(1,I) , XN(1,I+15) , Z , C , NELEM )
00239             CALL OV( 'X=Y     ' , XM(1,I+15) , XN(1,I) , Z , C , NELEM )
00240           ENDDO
00241         ELSEIF(TYPEXN(1:1).NE.'0') THEN
00242           IF (LNG.EQ.1) WRITE(LU,10) TYPEXN(1:1)
00243           IF (LNG.EQ.2) WRITE(LU,11) TYPEXN(1:1)
00244           CALL PLANTE(1)
00245           STOP
00246         ENDIF
00247 !
00248         TYPDIM(1:1)=TYPDIN(1:1)
00249         TYPEXM(1:1)=TYPEXN(1:1)
00250 !
00251 !-----------------------------------------------------------------------
00252 !
00253       ELSEIF(OP(3:8).EQ.'CN    ') THEN
00254 !
00255         CALL OV( 'X=CY    ' , DM       , DN       , Z , C , NDIAG )
00256 !
00257         IF(TYPEXN(1:1).EQ.'S') THEN
00258           DO I=1,15
00259             CALL OV( 'X=CY    ' , XM(1,I) , XN(1,I) , Z , C , NELEM )
00260           ENDDO ! I
00261         ELSEIF(TYPEXN(1:1).EQ.'Q') THEN
00262           DO I=1,30
00263             CALL OV( 'X=CY    ' , XM(1,I) , XN(1,I) , Z , C , NELEM )
00264           ENDDO ! I
00265         ELSEIF(TYPEXN(1:1).NE.'0') THEN
00266           IF (LNG.EQ.1) WRITE(LU,10) TYPEXN(1:1)
00267           IF (LNG.EQ.2) WRITE(LU,11) TYPEXN(1:1)
00268           CALL PLANTE(1)
00269           STOP
00270         ENDIF
00271 !
00272         TYPDIM(1:1)=TYPDIN(1:1)
00273         TYPEXM(1:1)=TYPEXN(1:1)
00274 !
00275 !-----------------------------------------------------------------------
00276 !
00277       ELSEIF(OP(3:8).EQ.'M+CN  ') THEN
00278 !
00279         IF(TYPDIN(1:1).EQ.'I') THEN
00280           CALL OV( 'X=X+C   ' , DM , DN , Z , C , NDIAG )
00281         ELSEIF(TYPDIN(1:1).NE.'0') THEN
00282           CALL OV( 'X=X+CY  ' , DM , DN , Z , C , NDIAG )
00283         ENDIF
00284 !
00285         IF(TYPEXN(1:1).EQ.'S') THEN
00286           DO I=1,15
00287             CALL OV( 'X=X+CY  ' , XM(1,I) , XN(1,I) , Z , C , NELEM )
00288           ENDDO ! I
00289           IF(TYPEXM(1:1).EQ.'Q') THEN
00290           DO I=1,15
00291             CALL OV( 'X=X+CY  ' , XM(1,I+15) , XN(1,I) , Z , C , NELEM )
00292           ENDDO ! I
00293           ENDIF
00294         ELSEIF(TYPEXN(1:1).EQ.'Q') THEN
00295           IF(TYPEXM(1:1).NE.'Q') THEN
00296             IF (LNG.EQ.1) WRITE(LU,99) TYPEXM(1:1),OP(1:8),TYPEXN(1:1)
00297             IF (LNG.EQ.2) WRITE(LU,98) TYPEXM(1:1),OP(1:8),TYPEXN(1:1)
00298 99          FORMAT(1X,'OM4141 (BIEF) : TYPEXM = ',A1,' NE CONVIENT PAS',
00299      &      /,1X,'POUR L''OPERATION : ',A8,' AVEC TYPEXN = ',A1)
00300 98          FORMAT(1X,'OM4141 (BIEF) : TYPEXM = ',A1,' DOES NOT GO',
00301      &      /,1X,'FOR THE OPERATION : ',A8,' WITH TYPEXN = ',A1)
00302             CALL PLANTE(1)
00303             STOP
00304           ENDIF
00305           DO I=1,30
00306             CALL OV( 'X=X+CY  ' , XM(1,I) , XN(1,I) , Z , C , NELEM )
00307           ENDDO ! I
00308         ELSEIF(TYPEXN(1:1).NE.'0') THEN
00309           IF (LNG.EQ.1) WRITE(LU,10) TYPEXN(1:1)
00310           IF (LNG.EQ.2) WRITE(LU,11) TYPEXN(1:1)
00311           CALL PLANTE(1)
00312           STOP
00313         ENDIF
00314 !
00315 !-----------------------------------------------------------------------
00316 !
00317       ELSEIF(OP(3:8).EQ.'M+N   '.OR.
00318      &      (OP(3:8).EQ.'M+TN  ').AND.TYPEXN(1:1).NE.'Q') THEN
00319 !
00320         CALL OV( 'X=X+Y   ' , DM       , DN       , Z , C , NDIAG )
00321 !
00322         IF(TYPEXN(1:1).EQ.'S') THEN
00323           DO I=1,15
00324             CALL OV( 'X=X+Y   ' , XM(1,I) , XN(1,I) , Z , C , NELEM )
00325           ENDDO ! I
00326           IF(TYPEXM(1:1).EQ.'Q') THEN
00327           DO I=1,15
00328            CALL OV( 'X=X+Y   ' , XM(1,I+15) , XN(1,I) , Z , C , NELEM )
00329           ENDDO ! I
00330           ENDIF
00331         ELSEIF(TYPEXN(1:1).EQ.'Q') THEN
00332           IF(TYPEXM(1:1).NE.'Q') THEN
00333             IF (LNG.EQ.1) WRITE(LU,99) TYPEXM(1:1),OP(1:8),TYPEXN(1:1)
00334             IF (LNG.EQ.2) WRITE(LU,98) TYPEXM(1:1),OP(1:8),TYPEXN(1:1)
00335             CALL PLANTE(1)
00336             STOP
00337           ENDIF
00338           DO I=1,30
00339             CALL OV( 'X=X+Y   ' , XM(1,I) , XN(1,I) , Z , C , NELEM )
00340           ENDDO ! I
00341         ELSEIF(TYPEXN(1:1).NE.'0') THEN
00342           IF (LNG.EQ.1) WRITE(LU,10) TYPEXN(1:1)
00343           IF (LNG.EQ.2) WRITE(LU,11) TYPEXN(1:1)
00344           CALL PLANTE(1)
00345           STOP
00346         ENDIF
00347 !
00348 !-----------------------------------------------------------------------
00349 !
00350       ELSEIF(OP(3:8).EQ.'MD    ') THEN
00351 !
00352 !   DIAGONAL TERMS
00353 !
00354         IF(TYPDIM(1:1).EQ.'Q') THEN
00355           CALL OV( 'X=XY    ' , DM , D , Z , C , NDIAG )
00356         ELSEIF(TYPDIM(1:1).EQ.'I') THEN
00357           CALL OV( 'X=Y     ' , DM , D , Z , C , NDIAG )
00358           TYPDIM(1:1)='Q'
00359         ELSEIF(TYPDIM(1:1).NE.'0') THEN
00360           IF (LNG.EQ.1) WRITE(LU,12) TYPDIM(1:1)
00361           IF (LNG.EQ.2) WRITE(LU,13) TYPDIM(1:1)
00362           CALL PLANTE(1)
00363           STOP
00364         ENDIF
00365 !
00366 !   EXTRADIAGONAL TERMS
00367 !
00368         IF(TYPEXM(1:1).EQ.'Q') THEN
00369 !
00370         DO IELEM = 1 , NELEM
00371 !
00372           XM(IELEM, 1) = XM(IELEM, 1) * D(IKLE(IELEM,2))
00373           XM(IELEM, 2) = XM(IELEM, 2) * D(IKLE(IELEM,3))
00374           XM(IELEM, 3) = XM(IELEM, 3) * D(IKLE(IELEM,4))
00375           XM(IELEM, 4) = XM(IELEM, 4) * D(IKLE(IELEM,5))
00376           XM(IELEM, 5) = XM(IELEM, 5) * D(IKLE(IELEM,6))
00377           XM(IELEM, 6) = XM(IELEM, 6) * D(IKLE(IELEM,3))
00378           XM(IELEM, 7) = XM(IELEM, 7) * D(IKLE(IELEM,4))
00379           XM(IELEM, 8) = XM(IELEM, 8) * D(IKLE(IELEM,5))
00380           XM(IELEM, 9) = XM(IELEM, 9) * D(IKLE(IELEM,6))
00381           XM(IELEM,10) = XM(IELEM,10) * D(IKLE(IELEM,4))
00382           XM(IELEM,11) = XM(IELEM,11) * D(IKLE(IELEM,5))
00383           XM(IELEM,12) = XM(IELEM,12) * D(IKLE(IELEM,6))
00384           XM(IELEM,13) = XM(IELEM,13) * D(IKLE(IELEM,5))
00385           XM(IELEM,14) = XM(IELEM,14) * D(IKLE(IELEM,6))
00386           XM(IELEM,15) = XM(IELEM,15) * D(IKLE(IELEM,6))
00387 !
00388           XM(IELEM,16) = XM(IELEM,16) * D(IKLE(IELEM,1))
00389           XM(IELEM,17) = XM(IELEM,17) * D(IKLE(IELEM,1))
00390           XM(IELEM,18) = XM(IELEM,18) * D(IKLE(IELEM,1))
00391           XM(IELEM,19) = XM(IELEM,19) * D(IKLE(IELEM,1))
00392           XM(IELEM,20) = XM(IELEM,20) * D(IKLE(IELEM,1))
00393           XM(IELEM,21) = XM(IELEM,21) * D(IKLE(IELEM,2))
00394           XM(IELEM,22) = XM(IELEM,22) * D(IKLE(IELEM,2))
00395           XM(IELEM,23) = XM(IELEM,23) * D(IKLE(IELEM,2))
00396           XM(IELEM,24) = XM(IELEM,24) * D(IKLE(IELEM,2))
00397           XM(IELEM,25) = XM(IELEM,25) * D(IKLE(IELEM,3))
00398           XM(IELEM,26) = XM(IELEM,26) * D(IKLE(IELEM,3))
00399           XM(IELEM,27) = XM(IELEM,27) * D(IKLE(IELEM,3))
00400           XM(IELEM,28) = XM(IELEM,28) * D(IKLE(IELEM,4))
00401           XM(IELEM,29) = XM(IELEM,29) * D(IKLE(IELEM,4))
00402           XM(IELEM,30) = XM(IELEM,30) * D(IKLE(IELEM,5))
00403 !
00404         ENDDO ! IELEM
00405 !
00406         ELSEIF(TYPEXM(1:1).EQ.'S') THEN
00407           IF (LNG.EQ.1) WRITE(LU,150)
00408           IF (LNG.EQ.2) WRITE(LU,151)
00409 150       FORMAT(1X,'OM4141 (BIEF) : M=MD A ECRIRE SI M SYMETRIQUE')
00410 151       FORMAT(1X,
00411      &    'OM4141 (BIEF) : M=MD NOT AVAILABLE IF M SYMMETRIC')
00412           CALL PLANTE(1)
00413           STOP
00414         ELSEIF(TYPEXM(1:1).NE.'0') THEN
00415           IF (LNG.EQ.1) WRITE(LU,190)
00416           IF (LNG.EQ.2) WRITE(LU,200)
00417           CALL PLANTE(1)
00418           STOP
00419         ENDIF
00420 !
00421 !-----------------------------------------------------------------------
00422 !
00423       ELSEIF(OP(3:8).EQ.'DM    ') THEN
00424 !
00425 !   DIAGONAL TERMS
00426 !
00427         IF(TYPDIM(1:1).EQ.'Q') THEN
00428           CALL OV( 'X=XY    ' , DM , D , Z , C , NDIAG )
00429         ELSEIF(TYPDIM(1:1).EQ.'I') THEN
00430           CALL OV( 'X=Y     ' , DM , D , Z , C , NDIAG )
00431           TYPDIM(1:1)='Q'
00432         ELSEIF(TYPDIM(1:1).NE.'0') THEN
00433           IF (LNG.EQ.1) WRITE(LU,12) TYPDIM(1:1)
00434           IF (LNG.EQ.2) WRITE(LU,13) TYPDIM(1:1)
00435           CALL PLANTE(1)
00436           STOP
00437         ENDIF
00438 !
00439 !   EXTRADIAGONAL TERMS
00440 !
00441         IF(TYPEXM(1:1).EQ.'Q') THEN
00442 !
00443         DO IELEM = 1 , NELEM
00444 !
00445           XM(IELEM, 1) = XM(IELEM, 1) * D(IKLE(IELEM,1))
00446           XM(IELEM, 2) = XM(IELEM, 2) * D(IKLE(IELEM,1))
00447           XM(IELEM, 3) = XM(IELEM, 3) * D(IKLE(IELEM,1))
00448           XM(IELEM, 4) = XM(IELEM, 4) * D(IKLE(IELEM,1))
00449           XM(IELEM, 5) = XM(IELEM, 5) * D(IKLE(IELEM,1))
00450           XM(IELEM, 6) = XM(IELEM, 6) * D(IKLE(IELEM,2))
00451           XM(IELEM, 7) = XM(IELEM, 7) * D(IKLE(IELEM,2))
00452           XM(IELEM, 8) = XM(IELEM, 8) * D(IKLE(IELEM,2))
00453           XM(IELEM, 9) = XM(IELEM, 9) * D(IKLE(IELEM,2))
00454           XM(IELEM,10) = XM(IELEM,10) * D(IKLE(IELEM,3))
00455           XM(IELEM,11) = XM(IELEM,11) * D(IKLE(IELEM,3))
00456           XM(IELEM,12) = XM(IELEM,12) * D(IKLE(IELEM,3))
00457           XM(IELEM,13) = XM(IELEM,13) * D(IKLE(IELEM,4))
00458           XM(IELEM,14) = XM(IELEM,14) * D(IKLE(IELEM,4))
00459           XM(IELEM,15) = XM(IELEM,15) * D(IKLE(IELEM,5))
00460 !
00461           XM(IELEM,16) = XM(IELEM,16) * D(IKLE(IELEM,2))
00462           XM(IELEM,17) = XM(IELEM,17) * D(IKLE(IELEM,3))
00463           XM(IELEM,18) = XM(IELEM,18) * D(IKLE(IELEM,4))
00464           XM(IELEM,19) = XM(IELEM,19) * D(IKLE(IELEM,5))
00465           XM(IELEM,20) = XM(IELEM,20) * D(IKLE(IELEM,6))
00466           XM(IELEM,21) = XM(IELEM,21) * D(IKLE(IELEM,3))
00467           XM(IELEM,22) = XM(IELEM,22) * D(IKLE(IELEM,4))
00468           XM(IELEM,23) = XM(IELEM,23) * D(IKLE(IELEM,5))
00469           XM(IELEM,24) = XM(IELEM,24) * D(IKLE(IELEM,6))
00470           XM(IELEM,25) = XM(IELEM,25) * D(IKLE(IELEM,4))
00471           XM(IELEM,26) = XM(IELEM,26) * D(IKLE(IELEM,5))
00472           XM(IELEM,27) = XM(IELEM,27) * D(IKLE(IELEM,6))
00473           XM(IELEM,28) = XM(IELEM,28) * D(IKLE(IELEM,5))
00474           XM(IELEM,29) = XM(IELEM,29) * D(IKLE(IELEM,6))
00475           XM(IELEM,30) = XM(IELEM,30) * D(IKLE(IELEM,6))
00476 !
00477         ENDDO ! IELEM
00478 !
00479         ELSEIF(TYPEXM(1:1).EQ.'S') THEN
00480           IF (LNG.EQ.1) WRITE(LU,160)
00481           IF (LNG.EQ.2) WRITE(LU,161)
00482 160       FORMAT(1X,'OM4141 (BIEF) : M=DM A ECRIRE SI M SYMETRIQUE')
00483 161       FORMAT(1X,
00484      &    'OM4141 (BIEF) : M=MD NOT AVAILABLE IF M SYMMETRIC')
00485           CALL PLANTE(1)
00486           STOP
00487         ELSEIF(TYPEXM(1:1).NE.'0') THEN
00488           IF (LNG.EQ.1) WRITE(LU,190)
00489           IF (LNG.EQ.2) WRITE(LU,200)
00490 190       FORMAT(1X,'OM4141 (BIEF) : TYPEXM NON PREVU : ',A1)
00491 200       FORMAT(1X,'OM4141 (BIEF) : TYPEXM NOT AVAILABLE : ',A1)
00492           CALL PLANTE(1)
00493           STOP
00494         ENDIF
00495 !
00496 !-----------------------------------------------------------------------
00497 !
00498       ELSEIF(OP(3:8).EQ.'DMD   ') THEN
00499 !
00500 !   DIAGONAL TERMS
00501 !
00502         IF(TYPDIM(1:1).EQ.'Q') THEN
00503            CALL OV( 'X=XY    ' , DM , D , Z , C , NDIAG )
00504            CALL OV( 'X=XY    ' , DM , D , Z , C , NDIAG )
00505         ELSEIF(TYPDIM(1:1).EQ.'I') THEN
00506            CALL OV( 'X=YZ    ' , DM , D , D , C , NDIAG )
00507            TYPDIM(1:1)='Q'
00508         ELSEIF(TYPDIM(1:1).NE.'0') THEN
00509            IF (LNG.EQ.1) WRITE(LU,12) TYPDIM(1:1)
00510            IF (LNG.EQ.2) WRITE(LU,13) TYPDIM(1:1)
00511 12         FORMAT(1X,'OM4141 (BIEF) : TYPDIM INCONNU :',A1)
00512 13         FORMAT(1X,'OM4141 (BIEF) : TYPDIM UNKNOWN :',A1)
00513            CALL PLANTE(1)
00514            STOP
00515         ENDIF
00516 !
00517 !   EXTRADIAGONAL TERMS
00518 !
00519         IF(TYPEXM(1:1).EQ.'S') THEN
00520 !
00521           DO IELEM = 1 , NELEM
00522 !
00523             I1 = IKLE(IELEM,1)
00524             I2 = IKLE(IELEM,2)
00525             I3 = IKLE(IELEM,3)
00526             I4 = IKLE(IELEM,4)
00527             I5 = IKLE(IELEM,5)
00528             I6 = IKLE(IELEM,6)
00529 !
00530             XM(IELEM, 1) =  XM(IELEM, 1) * D(I2) * D(I1)
00531             XM(IELEM, 2) =  XM(IELEM, 2) * D(I3) * D(I1)
00532             XM(IELEM, 3) =  XM(IELEM, 3) * D(I4) * D(I1)
00533             XM(IELEM, 4) =  XM(IELEM, 4) * D(I5) * D(I1)
00534             XM(IELEM, 5) =  XM(IELEM, 5) * D(I6) * D(I1)
00535             XM(IELEM, 6) =  XM(IELEM, 6) * D(I3) * D(I2)
00536             XM(IELEM, 7) =  XM(IELEM, 7) * D(I4) * D(I2)
00537             XM(IELEM, 8) =  XM(IELEM, 8) * D(I5) * D(I2)
00538             XM(IELEM, 9) =  XM(IELEM, 9) * D(I6) * D(I2)
00539             XM(IELEM,10) =  XM(IELEM,10) * D(I4) * D(I3)
00540             XM(IELEM,11) =  XM(IELEM,11) * D(I5) * D(I3)
00541             XM(IELEM,12) =  XM(IELEM,12) * D(I6) * D(I3)
00542             XM(IELEM,13) =  XM(IELEM,13) * D(I5) * D(I4)
00543             XM(IELEM,14) =  XM(IELEM,14) * D(I6) * D(I4)
00544             XM(IELEM,15) =  XM(IELEM,15) * D(I6) * D(I5)
00545 !
00546           ENDDO ! IELEM
00547 !
00548         ELSEIF(TYPEXM(1:1).EQ.'Q') THEN
00549 !
00550           DO IELEM = 1 , NELEM
00551 !
00552             I1 = IKLE(IELEM,1)
00553             I2 = IKLE(IELEM,2)
00554             I3 = IKLE(IELEM,3)
00555             I4 = IKLE(IELEM,4)
00556             I5 = IKLE(IELEM,5)
00557             I6 = IKLE(IELEM,6)
00558 !
00559             XM(IELEM, 1) =  XM(IELEM, 1) * D(I2) * D(I1)
00560             XM(IELEM, 2) =  XM(IELEM, 2) * D(I3) * D(I1)
00561             XM(IELEM, 3) =  XM(IELEM, 3) * D(I4) * D(I1)
00562             XM(IELEM, 4) =  XM(IELEM, 4) * D(I5) * D(I1)
00563             XM(IELEM, 5) =  XM(IELEM, 5) * D(I6) * D(I1)
00564             XM(IELEM, 6) =  XM(IELEM, 6) * D(I3) * D(I2)
00565             XM(IELEM, 7) =  XM(IELEM, 7) * D(I4) * D(I2)
00566             XM(IELEM, 8) =  XM(IELEM, 8) * D(I5) * D(I2)
00567             XM(IELEM, 9) =  XM(IELEM, 9) * D(I6) * D(I2)
00568             XM(IELEM,10) =  XM(IELEM,10) * D(I4) * D(I3)
00569             XM(IELEM,11) =  XM(IELEM,11) * D(I5) * D(I3)
00570             XM(IELEM,12) =  XM(IELEM,12) * D(I6) * D(I3)
00571             XM(IELEM,13) =  XM(IELEM,13) * D(I5) * D(I4)
00572             XM(IELEM,14) =  XM(IELEM,14) * D(I6) * D(I4)
00573             XM(IELEM,15) =  XM(IELEM,15) * D(I6) * D(I5)
00574             XM(IELEM,16) =  XM(IELEM,16) * D(I2) * D(I1)
00575             XM(IELEM,17) =  XM(IELEM,17) * D(I3) * D(I1)
00576             XM(IELEM,18) =  XM(IELEM,18) * D(I4) * D(I1)
00577             XM(IELEM,19) =  XM(IELEM,19) * D(I5) * D(I1)
00578             XM(IELEM,20) =  XM(IELEM,20) * D(I6) * D(I1)
00579             XM(IELEM,21) =  XM(IELEM,21) * D(I3) * D(I2)
00580             XM(IELEM,22) =  XM(IELEM,22) * D(I4) * D(I2)
00581             XM(IELEM,23) =  XM(IELEM,23) * D(I5) * D(I2)
00582             XM(IELEM,24) =  XM(IELEM,24) * D(I6) * D(I2)
00583             XM(IELEM,25) =  XM(IELEM,25) * D(I4) * D(I3)
00584             XM(IELEM,26) =  XM(IELEM,26) * D(I5) * D(I3)
00585             XM(IELEM,27) =  XM(IELEM,27) * D(I6) * D(I3)
00586             XM(IELEM,28) =  XM(IELEM,28) * D(I5) * D(I4)
00587             XM(IELEM,29) =  XM(IELEM,29) * D(I6) * D(I4)
00588             XM(IELEM,30) =  XM(IELEM,30) * D(I6) * D(I5)
00589 !
00590           ENDDO ! IELEM
00591 !
00592         ELSEIF(TYPEXM(1:1).NE.'0') THEN
00593           IF (LNG.EQ.1) WRITE(LU,20) TYPEXM(1:1)
00594           IF (LNG.EQ.2) WRITE(LU,21) TYPEXM(1:1)
00595 20        FORMAT(1X,'OM4141 (BIEF) : TYPEXM INCONNU :',A1)
00596 21        FORMAT(1X,'OM4141 (BIEF) : TYPEXM UNKNOWN :',A1)
00597           CALL PLANTE(1)
00598           STOP
00599         ENDIF
00600 !
00601 !-----------------------------------------------------------------------
00602 !
00603       ELSEIF(OP(3:8).EQ.'0     ') THEN
00604 !
00605         PRINT*,'OM4141 M=0'
00606         CALL OV( 'X=C     ' , DM , Y , Z , 0.D0 , NDIAG )
00607 !
00608         IF(TYPEXM(1:1).EQ.'S') THEN
00609           CALL OV( 'X=C     ' , XM(1,1 ) , Y , Z , 0.D0 , NELEM )
00610           CALL OV( 'X=C     ' , XM(1,2 ) , Y , Z , 0.D0 , NELEM )
00611           CALL OV( 'X=C     ' , XM(1,3 ) , Y , Z , 0.D0 , NELEM )
00612           CALL OV( 'X=C     ' , XM(1,4 ) , Y , Z , 0.D0 , NELEM )
00613           CALL OV( 'X=C     ' , XM(1,5 ) , Y , Z , 0.D0 , NELEM )
00614           CALL OV( 'X=C     ' , XM(1,6 ) , Y , Z , 0.D0 , NELEM )
00615           CALL OV( 'X=C     ' , XM(1,7 ) , Y , Z , 0.D0 , NELEM )
00616           CALL OV( 'X=C     ' , XM(1,8 ) , Y , Z , 0.D0 , NELEM )
00617           CALL OV( 'X=C     ' , XM(1,9 ) , Y , Z , 0.D0 , NELEM )
00618           CALL OV( 'X=C     ' , XM(1,10) , Y , Z , 0.D0 , NELEM )
00619           CALL OV( 'X=C     ' , XM(1,11) , Y , Z , 0.D0 , NELEM )
00620           CALL OV( 'X=C     ' , XM(1,12) , Y , Z , 0.D0 , NELEM )
00621           CALL OV( 'X=C     ' , XM(1,13) , Y , Z , 0.D0 , NELEM )
00622           CALL OV( 'X=C     ' , XM(1,14) , Y , Z , 0.D0 , NELEM )
00623           CALL OV( 'X=C     ' , XM(1,15) , Y , Z , 0.D0 , NELEM )
00624         ELSEIF(TYPEXM(1:1).EQ.'Q') THEN
00625           CALL OV( 'X=C     ' , XM(1,1 ) , Y , Z , 0.D0 , NELEM )
00626           CALL OV( 'X=C     ' , XM(1,2 ) , Y , Z , 0.D0 , NELEM )
00627           CALL OV( 'X=C     ' , XM(1,3 ) , Y , Z , 0.D0 , NELEM )
00628           CALL OV( 'X=C     ' , XM(1,4 ) , Y , Z , 0.D0 , NELEM )
00629           CALL OV( 'X=C     ' , XM(1,5 ) , Y , Z , 0.D0 , NELEM )
00630           CALL OV( 'X=C     ' , XM(1,6 ) , Y , Z , 0.D0 , NELEM )
00631           CALL OV( 'X=C     ' , XM(1,7 ) , Y , Z , 0.D0 , NELEM )
00632           CALL OV( 'X=C     ' , XM(1,8 ) , Y , Z , 0.D0 , NELEM )
00633           CALL OV( 'X=C     ' , XM(1,9 ) , Y , Z , 0.D0 , NELEM )
00634           CALL OV( 'X=C     ' , XM(1,10) , Y , Z , 0.D0 , NELEM )
00635           CALL OV( 'X=C     ' , XM(1,11) , Y , Z , 0.D0 , NELEM )
00636           CALL OV( 'X=C     ' , XM(1,12) , Y , Z , 0.D0 , NELEM )
00637           CALL OV( 'X=C     ' , XM(1,13) , Y , Z , 0.D0 , NELEM )
00638           CALL OV( 'X=C     ' , XM(1,14) , Y , Z , 0.D0 , NELEM )
00639           CALL OV( 'X=C     ' , XM(1,15) , Y , Z , 0.D0 , NELEM )
00640           CALL OV( 'X=C     ' , XM(1,16) , Y , Z , 0.D0 , NELEM )
00641           CALL OV( 'X=C     ' , XM(1,17) , Y , Z , 0.D0 , NELEM )
00642           CALL OV( 'X=C     ' , XM(1,18) , Y , Z , 0.D0 , NELEM )
00643           CALL OV( 'X=C     ' , XM(1,19) , Y , Z , 0.D0 , NELEM )
00644           CALL OV( 'X=C     ' , XM(1,20) , Y , Z , 0.D0 , NELEM )
00645           CALL OV( 'X=C     ' , XM(1,21) , Y , Z , 0.D0 , NELEM )
00646           CALL OV( 'X=C     ' , XM(1,22) , Y , Z , 0.D0 , NELEM )
00647           CALL OV( 'X=C     ' , XM(1,23) , Y , Z , 0.D0 , NELEM )
00648           CALL OV( 'X=C     ' , XM(1,24) , Y , Z , 0.D0 , NELEM )
00649           CALL OV( 'X=C     ' , XM(1,25) , Y , Z , 0.D0 , NELEM )
00650           CALL OV( 'X=C     ' , XM(1,26) , Y , Z , 0.D0 , NELEM )
00651           CALL OV( 'X=C     ' , XM(1,27) , Y , Z , 0.D0 , NELEM )
00652           CALL OV( 'X=C     ' , XM(1,28) , Y , Z , 0.D0 , NELEM )
00653           CALL OV( 'X=C     ' , XM(1,29) , Y , Z , 0.D0 , NELEM )
00654           CALL OV( 'X=C     ' , XM(1,30) , Y , Z , 0.D0 , NELEM )
00655         ELSEIF(TYPEXM(1:1).NE.'0') THEN
00656           IF (LNG.EQ.1) WRITE(LU,710) TYPEXM(1:1)
00657           IF (LNG.EQ.2) WRITE(LU,711) TYPEXM(1:1)
00658 710       FORMAT(1X,'OM4141 (BIEF) : TYPEXM INCONNU :',A1)
00659 711       FORMAT(1X,'OM4141 (BIEF) : TYPEXM UNKNOWN :',A1)
00660           CALL PLANTE(1)
00661           STOP
00662         ENDIF
00663 !       TYPDIM IS NOT CHANGED
00664 !        TYPDIM(1:1)='0'
00665 !       TYPEXM IS NOT CHANGED
00666 !        TYPEXM(1:1)='0'
00667 !-----------------------------------------------------------------------
00668 !
00669       ELSEIF(OP(3:8).EQ.'X(M)  ') THEN
00670 !
00671         IF(TYPEXM(1:1).EQ.'S') THEN
00672           CALL OV( 'X=Y     ' , XM(1,16) , XM(1, 1) , Z , C , NELEM )
00673           CALL OV( 'X=Y     ' , XM(1,17) , XM(1, 2) , Z , C , NELEM )
00674           CALL OV( 'X=Y     ' , XM(1,18) , XM(1, 3) , Z , C , NELEM )
00675           CALL OV( 'X=Y     ' , XM(1,19) , XM(1, 4) , Z , C , NELEM )
00676           CALL OV( 'X=Y     ' , XM(1,20) , XM(1, 5) , Z , C , NELEM )
00677           CALL OV( 'X=Y     ' , XM(1,21) , XM(1, 6) , Z , C , NELEM )
00678           CALL OV( 'X=Y     ' , XM(1,22) , XM(1, 7) , Z , C , NELEM )
00679           CALL OV( 'X=Y     ' , XM(1,23) , XM(1, 8) , Z , C , NELEM )
00680           CALL OV( 'X=Y     ' , XM(1,24) , XM(1, 9) , Z , C , NELEM )
00681           CALL OV( 'X=Y     ' , XM(1,25) , XM(1,10) , Z , C , NELEM )
00682           CALL OV( 'X=Y     ' , XM(1,26) , XM(1,11) , Z , C , NELEM )
00683           CALL OV( 'X=Y     ' , XM(1,27) , XM(1,12) , Z , C , NELEM )
00684           CALL OV( 'X=Y     ' , XM(1,28) , XM(1,13) , Z , C , NELEM )
00685           CALL OV( 'X=Y     ' , XM(1,29) , XM(1,14) , Z , C , NELEM )
00686           CALL OV( 'X=Y     ' , XM(1,30) , XM(1,15) , Z , C , NELEM )
00687         ELSEIF(TYPEXM(1:1).NE.'0') THEN
00688           IF (LNG.EQ.1) WRITE(LU,810) TYPEXM(1:1)
00689           IF (LNG.EQ.2) WRITE(LU,811) TYPEXM(1:1)
00690 810       FORMAT(1X,'OM4141 (BIEF) : MATRICE DEJA NON SYMETRIQUE : ',A1)
00691 811       FORMAT(1X,'OM4141 (BIEF) : MATRIX ALREADY NON SYMMETRICAL: ',
00692      &           A1)
00693           CALL PLANTE(1)
00694           STOP
00695         ENDIF
00696         TYPEXM(1:1)='Q'
00697 !
00698 !-----------------------------------------------------------------------
00699 !
00700       ELSEIF(OP(3:8).EQ.'MSK(M)') THEN
00701 !
00702       IF(TYPEXM(1:1).EQ.'S') THEN
00703         J = 15
00704       ELSEIF(TYPEXM(1:1).EQ.'Q') THEN
00705         J = 30
00706       ELSEIF(TYPEXM(1:1).EQ.'0') THEN
00707         J = 0
00708       ELSE
00709         IF(LNG.EQ.1) WRITE(LU,190) TYPEXM
00710         IF(LNG.EQ.2) WRITE(LU,200) TYPEXM
00711         J = 0
00712         CALL PLANTE(1)
00713         STOP
00714       ENDIF
00715 !
00716       IF(J.GT.0) THEN
00717         DO I = 1,J
00718           CALL OV ( 'X=XY    ' , XM(1,I) , D , Z , C , NELEM )
00719         ENDDO ! I
00720       ENDIF
00721 !
00722 !-----------------------------------------------------------------------
00723 !
00724       ELSEIF(OP(3:8).EQ.'M+D   ') THEN
00725 !
00726         CALL OV( 'X=X+Y   ' , DM , D , Z , C , NDIAG )
00727 !       HERE THERE IS A DOUBT ABOUT TYPDIM
00728         TYPDIM(1:1)='Q'
00729 !
00730 !-----------------------------------------------------------------------
00731 !
00732       ELSE
00733 !
00734         IF (LNG.EQ.1) WRITE(LU,40) OP
00735         IF (LNG.EQ.2) WRITE(LU,41) OP
00736 40      FORMAT(1X,'OM4141 (BIEF) : OPERATION INCONNUE : ',A8)
00737 41      FORMAT(1X,'OM4141 (BIEF) : UNKNOWN OPERATION : ',A8)
00738         CALL PLANTE(1)
00739         STOP
00740 !
00741       ENDIF
00742 !
00743 !-----------------------------------------------------------------------
00744 !
00745       RETURN
00746       END

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