mw0303.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\mw0303.f
00002 !
00088                      SUBROUTINE MW0303
00089 !                    *****************
00090 !
00091      &(OP, X , DA,TYPDIA,XAS,TYPEXT, Y,C,
00092      & IKLEM1,DIMIKM,LIMVOI,MXPTVS,NPMAX,NPOIN,TRAV)
00093 !
00094 !***********************************************************************
00095 ! BIEF   V6P3                                   21/08/2010
00096 !***********************************************************************
00097 !
00098 !
00099 !
00100 !
00101 !
00102 !
00103 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00104 !| C              |-->| A GIVEN CONSTANT
00105 !| DA             |-->| MATRIX DIAGONAL
00106 !| DIMIKM         |-->| FIRST DIMENSION OF IKLEM1
00107 !| IKLEM1         |-->| DATA STRUCTURE FOR MATRIX-VECTOR PRODUCT
00108 !|                |   | GIVES THE ADRESSES OF OFF-DIAGONAL TERMS
00109 !|                |   | IN XAS AND NEIGHBOUR POINTS IN Y.
00110 !|                |   | IKLEM1(*,*,1) : NON SYMMETRIC MATRIX
00111 !|                |   | IKLEM1(*,*,2) : SYMMETRIC MATRIX
00112 !|                |   | FIRST DIMENSION: NPMAX
00113 !|                |   | 2ND DIM.: 1 : DIRECT PRODUCT, ADDRESS IN XAS
00114 !|                |   |           2 : DIRECT PRODUCT, ADDRESS IN Y
00115 !|                |   |           3 : TRANSPOSED PRODUCT, ADDRESS IN XAS
00116 !|                |   |           4 : TRANSPOSED PRODUCT, ADDRESS IN Y
00117 !| LIMVOI         |-->|
00118 !| MXPTVS         |-->| MAXIMUM NUMBER OF NEIGHBOURS OF A POINT
00119 !| NPMAX          |-->| MAXIMUM NUMBER OF POINTS.
00120 !| NPOIN          |-->| NUMBER OF POINTS
00121 !| OP             |-->| OPERATION TO BE DONE (SEE ABOVE)
00122 !| TRAV           |-->| WORK ARRAY
00123 !| TYPDIA         |-->| TYPE OF DIAGONAL:
00124 !|                |   | TYPDIA = 'Q' : ANY VALUE
00125 !|                |   | TYPDIA = 'I' : IDENTITY
00126 !|                |   | TYPDIA = '0' : ZERO
00127 !| TYPEXT         |-->| TYPE OF OFF-DIAGONAL TERMS
00128 !|                |   | TYPEXT = 'Q' : ANY VALUE
00129 !|                |   | TYPEXT = 'S' : SYMMETRIC
00130 !|                |   | TYPEXT = '0' : ZERO
00131 !| X              |<->| RESULT IN ASSEMBLED FORM
00132 !| XAS            |-->| OFF-DIAGONAL TERMS OF MATRIX
00133 !| Y              |-->| VECTOR USED IN THE OPERATION
00134 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00135 !
00136       USE BIEF, EX_MW0303 => MW0303
00137 !
00138       IMPLICIT NONE
00139       INTEGER LNG,LU
00140       COMMON/INFO/LNG,LU
00141 !
00142 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00143 !
00144       INTEGER, INTENT(IN) :: DIMIKM,MXPTVS,NPMAX,NPOIN
00145 !                                                      11: SEE ALMESH
00146 !                                                          AND OPTASS
00147       INTEGER, INTENT(IN) :: IKLEM1(DIMIKM,4,2),LIMVOI(11,2)
00148 !
00149       DOUBLE PRECISION, INTENT(INOUT) :: X(*),TRAV(*)
00150       DOUBLE PRECISION, INTENT(IN)    :: DA(*),Y(*)
00151       DOUBLE PRECISION, INTENT(IN)    :: XAS(*),C
00152 !
00153       CHARACTER(LEN=8), INTENT(IN)    :: OP
00154       CHARACTER(LEN=1), INTENT(IN)    :: TYPDIA,TYPEXT
00155 !
00156 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00157 !
00158       INTEGER I
00159       DOUBLE PRECISION Z(1)
00160 !
00161 !-----------------------------------------------------------------------
00162 !
00163 !   TREATMENT SPECIFIC TO THE TRANSPOSITION:
00164 !
00165       I = 1
00166       IF(OP(3:3).EQ.'T'.OR.OP(4:4).EQ.'T'.OR.
00167      &   OP(5:5).EQ.'T'.OR.OP(6:6).EQ.'T') I = 3
00168 !
00169 !-----------------------------------------------------------------------
00170 !
00171 !   MATRIX VECTOR PRODUCT, SIMPLE FUNCTION OF THE SHAPE OF THE MATRIX:
00172 !
00173       IF(TYPEXT(1:1).EQ.'S'.OR.TYPEXT(1:1).EQ.'Q') THEN
00174 !
00175         IF(TYPEXT(1:1).EQ.'Q') THEN
00176         CALL OPASS('X=WY    ',TRAV,XAS,IKLEM1(1,I,1),
00177      &             Y,IKLEM1(1,I+1,1),LIMVOI,MXPTVS,NPMAX)
00178         ELSEIF(TYPEXT(1:1).EQ.'S') THEN
00179         CALL OPASS('X=WY    ',TRAV,XAS,IKLEM1(1,I,2),
00180      &             Y,IKLEM1(1,I+1,2),LIMVOI,MXPTVS,NPMAX)
00181         ENDIF
00182 !
00183         IF(TYPDIA(1:1).EQ.'Q') THEN
00184           CALL OV ('X=X+YZ  ', TRAV , Y , DA , C , NPOIN )
00185         ELSEIF(TYPDIA(1:1).EQ.'I') THEN
00186           CALL OV ('X=X+Y   ', TRAV , Y , Z , C , NPOIN )
00187         ELSEIF(TYPDIA(1:1).NE.'0') THEN
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       ELSEIF(TYPEXT(1:1).EQ.'0') THEN
00195 !
00196         IF(TYPDIA(1:1).EQ.'Q') THEN
00197           CALL OV ('X=YZ    ', TRAV , Y , DA , C , NPOIN )
00198         ELSEIF(TYPDIA(1:1).EQ.'I') THEN
00199           CALL OV ('X=Y     ', TRAV , Y , Z , C , NPOIN )
00200         ELSEIF(TYPDIA(1:1).EQ.'0') THEN
00201           CALL OV ('X=C     ', TRAV , Y , Z , 0.D0 , NPOIN )
00202         ELSE
00203           IF (LNG.EQ.1) WRITE(LU,2000) TYPDIA
00204           IF (LNG.EQ.2) WRITE(LU,2001) TYPDIA
00205           CALL PLANTE(1)
00206           STOP
00207         ENDIF
00208 !
00209       ELSE
00210 !
00211         IF (LNG.EQ.1) WRITE(LU,1000) TYPEXT
00212         IF (LNG.EQ.2) WRITE(LU,1001) TYPEXT
00213         CALL PLANTE(1)
00214         STOP
00215 !
00216       ENDIF
00217 !
00218 !-----------------------------------------------------------------------
00219 !
00220 !   IMPLEMENTED OPERATIONS:
00221 !
00222       IF(OP(1:8).EQ.'X=AY    '.OR.OP(1:8).EQ.'X=TAY   ') THEN
00223         CALL OV ('X=Y     ', X , TRAV , Z , C , NPOIN )
00224       ELSEIF(OP(1:8).EQ.'X=-AY   '.OR.OP(1:8).EQ.'X=-TAY  ') THEN
00225         CALL OV ('X=-Y    ', X , TRAV , Z , C , NPOIN )
00226       ELSEIF(OP(1:8).EQ.'X=X+AY  '.OR.OP(1:8).EQ.'X=X+TAY ') THEN
00227         CALL OV ('X=X+Y   ', X , TRAV , Z , C , NPOIN )
00228       ELSEIF(OP(1:8).EQ.'X=X-AY  '.OR.OP(1:8).EQ.'X=X-TAY ') THEN
00229         CALL OV ('X=X-Y   ', X , TRAV , Z , C , NPOIN )
00230       ELSEIF(OP(1:8).EQ.'X=X+CAY '.OR.OP(1:8).EQ.'X=X+CTAY') THEN
00231         CALL OV ('X=X+CY  ', X , TRAV , Z , C , NPOIN )
00232       ELSEIF(OP(1:8).EQ.'X=CAY   ') THEN
00233         CALL OV ('X=CY    ', X , TRAV , Z , C , NPOIN )
00234       ELSE
00235         IF (LNG.EQ.1) WRITE(LU,3000) OP
00236         IF (LNG.EQ.2) WRITE(LU,3001) OP
00237         CALL PLANTE(1)
00238         STOP
00239       ENDIF
00240 !
00241 !-----------------------------------------------------------------------
00242 !
00243       RETURN
00244 !
00245 1000  FORMAT(1X,'MW0303 (BIEF) : TERMES EXTRADIAG. TYPE INCONNU: ',A1)
00246 1001  FORMAT(1X,'MW0303 (BIEF) : EXTRADIAG. TERMS  UNKNOWN TYPE : ',A1)
00247 2000  FORMAT(1X,'MW0303 (BIEF) : DIAGONALE : TYPE INCONNU: ',A1)
00248 2001  FORMAT(1X,'MW0303 (BIEF) : DIAGONAL : UNKNOWN TYPE : ',A1)
00249 3000  FORMAT(1X,'MW0303 (BIEF) : OPERATION INCONNUE : ',A8)
00250 3001  FORMAT(1X,'MW0303 (BIEF) : UNKNOWN OPERATION : ',A8)
00251 !
00252 !-----------------------------------------------------------------------
00253 !
00254       END

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