diri04.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\diri04.f
00002 !
00067                      SUBROUTINE DIRI04
00068 !                    *****************
00069 !
00070      &(X1,X2,A11,A12,A21,A22,SM1,SM2,T1,T2,T3,T4,
00071      & XBOR1,XBOR2,LIDIR1,LIDIR2,MESH,KDIR,MSK,MASKPT)
00072 !
00073 !***********************************************************************
00074 ! BIEF   V6P1                                   21/08/2010
00075 !***********************************************************************
00076 !
00077 !
00078 !
00079 !
00080 !
00081 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00082 !| A12            |<->| MATRIX IN THE 2x2 LINEAR SYSTEM
00083 !| A12            |<->| MATRIX IN THE 2x2 LINEAR SYSTEM
00084 !| A21            |<->| MATRIX IN THE 2x2 LINEAR SYSTEM
00085 !| A22            |<->| MATRIX IN THE 2x2 LINEAR SYSTEM
00086 !| KDIR           |-->| CONVENTION FOR DIRICHLET BOUNDARY CONDITIONS
00087 !| LIDIR1         |-->| TYPES OF BOUNDARY CONDITIONS FOR VARIABLE 1
00088 !|                |   | IF LIMDIR(K) = KDIR THE KTH BOUNDARY POINT
00089 !|                |   | IS OF DIRICHLET TYPE.
00090 !| LIDIR2         |-->| TYPES OF BOUNDARY CONDITIONS FOR VARIABLE 2
00091 !|                |   | IF LIMDIR(K) = KDIR THE KTH BOUNDARY POINT
00092 !|                |   | IS OF DIRICHLET TYPE.
00093 !| MASKPT         |-->| MASKING PER POINT.
00094 !|                |   | =1. : NORMAL   =0. : MASKED
00095 !| MESH           |-->| MESH STRUCTURE
00096 !| MSK            |-->| IF YES, THERE IS MASKED ELEMENTS.
00097 !| SM1            |-->| FIRST RIGHT-HAND SIDE OF THE SYSTEM.
00098 !| SM2            |-->| SECOND RIGHT-HAND SIDE OF THE SYSTEM.
00099 !| T1             |<->| WORK DOUBLE PRECISION ARRAY IN A BIEF_OBJ
00100 !| T2             |<->| WORK DOUBLE PRECISION ARRAY IN A BIEF_OBJ
00101 !| T3             |<->| WORK DOUBLE PRECISION ARRAY IN A BIEF_OBJ
00102 !| T4             |<->| WORK DOUBLE PRECISION ARRAY IN A BIEF_OBJ
00103 !| XBOR1          |-->| DIRICHLET BOUNDARY CONDITIONS OF VARIABLE 1
00104 !| XBOR2          |-->| DIRICHLET BOUNDARY CONDITIONS OF VARIABLE 2
00105 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00106 !
00107       USE BIEF, EX_DIRI04 => DIRI04
00108 !
00109       IMPLICIT NONE
00110       INTEGER LNG,LU
00111       COMMON/INFO/LNG,LU
00112 !
00113 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00114 !
00115       TYPE(BIEF_OBJ), INTENT(INOUT) :: X1,X2,SM1,SM2,T1,T2,T3,T4
00116       TYPE(BIEF_OBJ), INTENT(INOUT) :: A11,A12,A21,A22
00117       TYPE(BIEF_OBJ), INTENT(IN)    :: XBOR1,XBOR2,MASKPT
00118       INTEGER, INTENT(IN)           :: KDIR,LIDIR1(*),LIDIR2(*)
00119       TYPE(BIEF_MESH), INTENT(INOUT):: MESH
00120       LOGICAL, INTENT(IN)           :: MSK
00121 !
00122 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00123 !
00124       DOUBLE PRECISION C,Z(1)
00125 !
00126       CHARACTER*1 STODIA
00127 !
00128 !-----------------------------------------------------------------------
00129 !
00130 ! 1) BUILDS ARRAYS T1,T2 CONTAINING:
00131 !    THE X1 AND X2 IMPOSED VALUES IF THE POINT IS OF TYPE DIRICHLET
00132 !    0 OTHERWISE
00133 !
00134 !    X1,X2  3 TAKE THEIR DIRICHLET VALUE
00135 !
00136 !=======================================================================
00137 !
00138 !   BOUNDARY CONDITION FOR X1 : "XBOR1" IMPOSED
00139 !
00140       CALL CPSTVC(X1,T1)
00141       CALL OS ( 'X=C     ' , T1 , T1 , T1 , 0.D0 )
00142       CALL OSDBIF ( 'X=Y     ',T1,XBOR1,LIDIR1,KDIR,MESH)
00143 !
00144 !-----------------------------------------------------------------------
00145 !
00146 !   BOUNDARY CONDITIONS FOR X2 : "XBOR2" IMPOSED
00147 !
00148       CALL CPSTVC(X2,T2)
00149       CALL OS  ( 'X=C     ' , T2 , T2 , T2 , 0.D0 )
00150       CALL OSDBIF ( 'X=Y     ',T2,XBOR2,LIDIR2,KDIR,MESH)
00151 !
00152 !=======================================================================
00153 !
00154 !   2) COMPUTES THE PRODUCT OF THE MATRIX FOR THE SYSTEM TO SOLVE
00155 !      AND T1,T2
00156 !      THE RESULT IS DEDUCTED FROM THE SECOND MEMBERS
00157 !
00158       CALL MATVEC('X=AY    ',T3,A11,T1,C,MESH,LEGO=.FALSE.)
00159       CALL MATVEC('X=X+AY  ',T3,A12,T2,C,MESH,LEGO=.TRUE. )
00160       CALL MATVEC('X=AY    ',T4,A21,T1,C,MESH,LEGO=.FALSE.)
00161       CALL MATVEC('X=X+AY  ',T4,A22,T2,C,MESH,LEGO=.TRUE. )
00162 !
00163       CALL CPSTVC(X1,SM1)
00164       CALL CPSTVC(X2,SM2)
00165       CALL OS( 'X=X-Y   ' , SM1 , T3 , T3 , C )
00166       CALL OS( 'X=X-Y   ' , SM2 , T4 , T4 , C )
00167 !
00168 !=======================================================================
00169 !
00170 !  SECOND MEMBERS OF THE EQUATIONS FOR DIRICHLET POINTS
00171 !  PREPARES THE LINEAR SYSTEM
00172 !
00173       CALL DIRAUX(SM1,A11%D,XBOR1,T1,X1,LIDIR1,KDIR,MESH )
00174       CALL DIRAUX(SM2,A22%D,XBOR2,T2,X2,LIDIR2,KDIR,MESH )
00175 !
00176       IF(MSK) THEN
00177         CALL OV( 'X=XY    ',SM1%R,MASKPT%R,Z,C,SM1%DIM1)
00178         CALL OV( 'X=XY    ', X1%R,MASKPT%R,Z,C,X1%DIM1)
00179         CALL OV( 'X=XY    ', T1%R,MASKPT%R,Z,C,T1%DIM1)
00180         CALL OV( 'X=XY    ',SM2%R,MASKPT%R,Z,C,SM2%DIM1)
00181         CALL OV( 'X=XY    ', X2%R,MASKPT%R,Z,C,X2%DIM1)
00182         CALL OV( 'X=XY    ', T2%R,MASKPT%R,Z,C,T2%DIM1)
00183       ENDIF
00184 !
00185 !=======================================================================
00186 !
00187 !   ERASES THE LINES AND COLUMNS FOR DIRICHLET POINTS
00188 !
00189 !   IT'S EQUIVALENT TO A DIAGONAL PRECONDITIONING WITH ARRAYS
00190 !   T1,T2,T3
00191 !
00192 !   DOES NOT ALTER A11,A22,A33 DIAGONALS
00193 !   BY GIVING THEM A DUMMY TYPE : '0'
00194 !
00195 !
00196 !=======================================================================
00197 ! A11 PRECONDITIONING :
00198 !=======================================================================
00199 !
00200       STODIA = A11%TYPDIA
00201       A11%TYPDIA='0'
00202       CALL OM( 'M=DMD   ' , A11,A11 ,T1,C,MESH)
00203       A11%TYPDIA=STODIA
00204 !
00205 !=======================================================================
00206 ! A12 PRECONDITIONING :
00207 !=======================================================================
00208 !
00209       CALL OM( 'M=DM    ' , A12,A12 ,T1,C,MESH)
00210       CALL OM( 'M=MD    ' , A12,A12 ,T2,C,MESH)
00211 !
00212 !=======================================================================
00213 ! A21 PRECONDITIONING :
00214 !=======================================================================
00215 !
00216       CALL OM( 'M=DM    ' , A21,A21 ,T2,C,MESH)
00217       CALL OM( 'M=MD    ' , A21,A21 ,T1,C,MESH)
00218 !
00219 !=======================================================================
00220 ! A22 PRECONDITIONING :
00221 !=======================================================================
00222 !
00223       STODIA = A22%TYPDIA
00224       A22%TYPDIA='0'
00225       CALL OM( 'M=DMD   ' , A22,A22 ,T2,C,MESH)
00226       A22%TYPDIA=STODIA
00227 !
00228 !-----------------------------------------------------------------------
00229 !
00230       RETURN
00231       END

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