# diri09.f

Go to the documentation of this file.
```00001 C:\opentelemac\v7p0\sources\utils\bief\diri09.f
00002 !
00076                      SUBROUTINE DIRI09
00077 !                    *****************
00078 !
00079      &(X1,X2,X3,
00080      & A11,A12,A13,A21,A22,A23,A31,A32,A33,
00081      & SM1,SM2,SM3,T1,T2,T3,T4,T5,T6,
00082      & XBOR1,XBOR2,XBOR3,LIDIR1,LIDIR2,LIDIR3,
00084 !
00085 !***********************************************************************
00086 ! BIEF   V6P1                                   21/08/2010
00087 !***********************************************************************
00088 !
00089 !
00090 !
00091 !
00092 !
00093 !
00094 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00095 !| A12            |<->| MATRIX IN THE 3x3 LINEAR SYSTEM
00096 !| A13            |<->| MATRIX IN THE 3x3 LINEAR SYSTEM
00097 !| A21            |<->| MATRIX IN THE 3x3 LINEAR SYSTEM
00098 !| A22            |<->| MATRIX IN THE 3x3 LINEAR SYSTEM
00099 !| A23            |<->| MATRIX IN THE 3x3 LINEAR SYSTEM
00100 !| A31            |<->| MATRIX IN THE 3x3 LINEAR SYSTEM
00101 !| A32            |<->| MATRIX IN THE 3x3 LINEAR SYSTEM
00102 !| A33            |<->| MATRIX IN THE 3x3 LINEAR SYSTEM
00103 !| KDIR           |-->| CONVENTION FOR DIRICHLET BOUNDARY CONDITIONS
00104 !| LIDIR1         |-->| TYPES OF BOUNDARY CONDITIONS FOR VARIABLE 1
00105 !|                |   | IF LIMDIR(K) = KDIR LE KTH BOUNDARY POINT
00106 !|                |   | IS OF DIRICHLET TYPE.
00107 !| LIDIR2         |-->| TYPES OF BOUNDARY CONDITIONS FOR VARIABLE 2
00108 !|                |   | IF LIMDIR(K) = KDIR THE KTH BOUNDARY POINT
00109 !|                |   | IS OF DIRICHLET TYPE.
00110 !| LIDIR2         |-->| TYPES OF BOUNDARY CONDITIONS FOR VARIABLE 2
00111 !|                |   | IF LIMDIR(K) = KDIR THE KTH BOUNDARY POINT
00112 !|                |   | IS OF DIRICHLET TYPE.
00113 !| LIDIR3         |-->| TYPES OF BOUNDARY CONDITIONS FOR VARIABLE 3
00114 !|                |   | IF LIMDIR(K) = KDIR THE KTH BOUNDARY POINT
00115 !|                |   | IS OF DIRICHLET TYPE.
00117 !|                |   | =1. : NORMAL   =0. : MASKED
00118 !| MESH           |-->| MESH STRUCTURE
00119 !| MSK            |-->| IF YES, THERE IS MASKED ELEMENTS.
00120 !| SM1            |-->| FIRST RIGHT-HAND SIDE OF THE SYSTEM.
00121 !| SM2            |-->| SECOND RIGHT-HAND SIDE OF THE SYSTEM.
00122 !| SM3            |-->| THIRD RIGHT-HAND SIDE OF THE SYSTEM.
00123 !| T1             |<->| WORK DOUBLE PRECISION ARRAY IN A BIEF_OBJ
00124 !| T2             |<->| WORK DOUBLE PRECISION ARRAY IN A BIEF_OBJ
00125 !| T3             |<->| WORK DOUBLE PRECISION ARRAY IN A BIEF_OBJ
00126 !| T4             |<->| WORK DOUBLE PRECISION ARRAY IN A BIEF_OBJ
00127 !| T5             |<->| WORK DOUBLE PRECISION ARRAY IN A BIEF_OBJ
00128 !| T6             |<->| WORK DOUBLE PRECISION ARRAY IN A BIEF_OBJ
00129 !| XBOR1          |-->| DIRICHLET BOUNDARY CONDITIONS OF VARIABLE 1
00130 !| XBOR2          |-->| DIRICHLET BOUNDARY CONDITIONS OF VARIABLE 2
00131 !| XBOR3          |-->| DIRICHLET BOUNDARY CONDITIONS OF VARIABLE 3
00132 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00133 !
00134       USE BIEF, EX_DIRI09 => DIRI09
00135 !
00136       IMPLICIT NONE
00137       INTEGER LNG,LU
00138       COMMON/INFO/LNG,LU
00139 !
00140 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00141 !
00142       TYPE(BIEF_OBJ), INTENT(INOUT) :: X1,X2,X3,SM1,SM2,SM3
00143       TYPE(BIEF_OBJ), INTENT(INOUT) :: T1,T2,T3,T4,T5,T6
00144       TYPE(BIEF_OBJ), INTENT(INOUT) :: A11,A12,A13,A21,A22
00145       TYPE(BIEF_OBJ), INTENT(INOUT) :: A23,A31,A32,A33
00147       INTEGER, INTENT(IN)           :: LIDIR1(*),LIDIR2(*),LIDIR3(*)
00148       INTEGER, INTENT(IN)           :: KDIR
00149       TYPE(BIEF_MESH), INTENT(INOUT):: MESH
00150       LOGICAL, INTENT(IN)           :: MSK
00151 !
00152 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00153 !
00154       DOUBLE PRECISION C,Z(1)
00155 !
00156       CHARACTER*1 STODIA
00157 !
00158 !-----------------------------------------------------------------------
00159 !
00160 ! 1) BUILDS ARRAYS T1,T2,T3 CONTAINING:
00161 !    THE X1, X2 AND X3 IMPOSED VALUES IF THE POINT IS OF TYPE DIRICHLET
00162 !    0 OTHERWISE
00163 !
00164 !    X1,X2,X3 TAKE THEIR DIRICHLET VALUE
00165 !
00166 !=======================================================================
00167 !
00168 !   BOUNDARY CONDITION FOR X1 : "XBOR1" IMPOSED
00169 !
00170       CALL CPSTVC(X1,T1)
00171       CALL OS  ( 'X=C     ' , T1 , T1 , T1 , 0.D0 )
00172       CALL OSDBIF ( 'X=Y     ',T1,XBOR1,LIDIR1,KDIR,MESH)
00173 !
00174 !-----------------------------------------------------------------------
00175 !
00176 !   BOUNDARY CONDITION FOR X2 : "XBOR2" IMPOSED
00177 !
00178       CALL CPSTVC(X2,T2)
00179       CALL OS  ( 'X=C     ' , T2 , T2 , T2 , 0.D0 )
00180       CALL OSDBIF ( 'X=Y     ',T2,XBOR2,LIDIR2,KDIR,MESH)
00181 !
00182 !-----------------------------------------------------------------------
00183 !
00184 !   BOUNDARY CONDITION FOR X3 : "XBOR3" IMPOSED
00185 !
00186       CALL CPSTVC(X3,T3)
00187       CALL OS  ( 'X=C     ' , T3 , T3 , T3 , 0.D0 )
00188       CALL OSDBIF ( 'X=Y     ',T3,XBOR3,LIDIR3,KDIR,MESH)
00189 !
00190 !=======================================================================
00191 !
00192 !   2) COMPUTES THE PRODUCT OF THE MATRIX FOR THE SYSTEM TO SOLVE
00193 !      AND T1,T2,T3
00194 !      THE RESULT IS DEDUCTED FROM THE SECOND MEMBERS
00195 !
00196       CALL MATVEC('X=AY    ',T4,A11,T1,C,MESH,LEGO=.FALSE.)
00197       CALL MATVEC('X=X+AY  ',T4,A12,T2,C,MESH,LEGO=.FALSE.)
00198       CALL MATVEC('X=X+AY  ',T4,A13,T3,C,MESH,LEGO=.TRUE. )
00199       CALL MATVEC('X=AY    ',T5,A21,T1,C,MESH,LEGO=.FALSE.)
00200       CALL MATVEC('X=X+AY  ',T5,A22,T2,C,MESH,LEGO=.FALSE.)
00201       CALL MATVEC('X=X+AY  ',T5,A23,T3,C,MESH,LEGO=.TRUE. )
00202       CALL MATVEC('X=AY    ',T6,A31,T1,C,MESH,LEGO=.FALSE.)
00203       CALL MATVEC('X=X+AY  ',T6,A32,T2,C,MESH,LEGO=.FALSE.)
00204       CALL MATVEC('X=X+AY  ',T6,A33,T3,C,MESH,LEGO=.TRUE. )
00205 !
00206       CALL CPSTVC(X1,SM1)
00207       CALL CPSTVC(X2,SM2)
00208       CALL CPSTVC(X3,SM3)
00209       CALL OS( 'X=X-Y   ' , SM1 , T4 , T4 , C )
00210       CALL OS( 'X=X-Y   ' , SM2 , T5 , T5 , C )
00211       CALL OS( 'X=X-Y   ' , SM3 , T6 , T6 , C )
00212 !
00213 !=======================================================================
00214 !
00215 !  SECOND MEMBERS OF THE EQUATIONS FOR DIRICHLET POINTS
00216 !  PREPARES THE LINEAR SYSTEM
00217 !
00218       CALL DIRAUX(SM1,A11%D,XBOR1,T1,X1,LIDIR1,KDIR,MESH)
00219       CALL DIRAUX(SM2,A22%D,XBOR2,T2,X2,LIDIR2,KDIR,MESH)
00220       CALL DIRAUX(SM3,A33%D,XBOR3,T3,X3,LIDIR3,KDIR,MESH)
00221 !
00222 ! CALLS OV RATHER THAN OS BECAUSE SM1 AND MASKPT DON'T ALWAYS
00223 ! HAVE THE SAME LENGTH
00224 !
00225       IF(MSK) THEN
00227         CALL OV( 'X=XY    ', X1%R,MASKPT%R,Z,C,X1%DIM1)
00228         CALL OV( 'X=XY    ', T1%R,MASKPT%R,Z,C,T1%DIM1)
00230         CALL OV( 'X=XY    ', X2%R,MASKPT%R,Z,C,X2%DIM1)
00231         CALL OV( 'X=XY    ', T2%R,MASKPT%R,Z,C,T2%DIM1)
00233         CALL OV( 'X=XY    ', X3%R,MASKPT%R,Z,C,X3%DIM1)
00234         CALL OV( 'X=XY    ', T3%R,MASKPT%R,Z,C,T3%DIM1)
00235       ENDIF
00236 !
00237 !=======================================================================
00238 !
00239 !   ERASES THE LINES AND COLUMNS FOR DIRICHLET POINTS
00240 !
00241 !   IT'S EQUIVALENT TO A DIAGONAL PRECONDITIONING WITH ARRAYS
00242 !   T1,T2,T3
00243 !
00244 !   DOES NOT ALTER A11,A22,A33 DIAGONALS
00245 !   BY GIVING THEM A DUMMY TYPE : '0'
00246 !
00247 !
00248 !=======================================================================
00249 ! A11 PRECONDITIONING :
00250 !=======================================================================
00251 !
00252       STODIA = A11%TYPDIA
00253       A11%TYPDIA='0'
00254       CALL OM( 'M=DMD   ' , A11,A11 ,T1,C,MESH)
00255       A11%TYPDIA=STODIA
00256 !
00257 !=======================================================================
00258 ! A12 PRECONDITIONING :
00259 !=======================================================================
00260 !
00261       CALL OM( 'M=DM    ' , A12,A12 ,T1,C,MESH)
00262       CALL OM( 'M=MD    ' , A12,A12 ,T2,C,MESH)
00263 !
00264 !=======================================================================
00265 ! A13 PRECONDITIONING :
00266 !=======================================================================
00267 !
00268       CALL OM( 'M=DM    ' , A13,A13 ,T1,C,MESH)
00269       CALL OM( 'M=MD    ' , A13,A13 ,T3,C,MESH)
00270 !
00271 !=======================================================================
00272 ! A21 PRECONDITIONING :
00273 !=======================================================================
00274 !
00275       CALL OM( 'M=DM    ' , A21,A21 ,T2,C,MESH)
00276       CALL OM( 'M=MD    ' , A21,A21 ,T1,C,MESH)
00277 !
00278 !=======================================================================
00279 ! A22 PRECONDITIONING :
00280 !=======================================================================
00281 !
00282       STODIA = A22%TYPDIA
00283       A22%TYPDIA='0'
00284       CALL OM( 'M=DMD   ' , A22,A22 ,T2,C,MESH)
00285       A22%TYPDIA=STODIA
00286 !
00287 !=======================================================================
00288 ! A23 PRECONDITIONING :
00289 !=======================================================================
00290 !
00291       CALL OM( 'M=DM    ' , A23,A23 ,T2,C,MESH)
00292       CALL OM( 'M=MD    ' , A23,A23 ,T3,C,MESH)
00293 !
00294 !=======================================================================
00295 ! A31 PRECONDITIONING :
00296 !=======================================================================
00297 !
00298       CALL OM( 'M=DM    ' , A31,A31 ,T3,C,MESH)
00299       CALL OM( 'M=MD    ' , A31,A31 ,T1,C,MESH)
00300 !
00301 !=======================================================================
00302 ! A32 PRECONDITIONING :
00303 !=======================================================================
00304 !
00305       CALL OM( 'M=DM    ' , A32,A32 ,T3,C,MESH)
00306       CALL OM( 'M=MD    ' , A32,A32 ,T2,C,MESH)
00307 !
00308 !=======================================================================
00309 ! A33 PRECONDITIONING :
00310 !=======================================================================
00311 !
00312       STODIA = A33%TYPDIA
00313       A33%TYPDIA='0'
00314       CALL OM( 'M=DMD   ' , A33,A33 ,T3,C,MESH)
00315       A33%TYPDIA=STODIA
00316 !
00317 !-----------------------------------------------------------------------
00318 !
00319       RETURN
00320       END
```