diri01.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\diri01.f
00002 !
00066                      SUBROUTINE DIRI01
00067 !                    *****************
00068 !
00069      &(F, S, SM ,FBOR,LIMDIR,WORK1,WORK2,MESH,KDIR,MSK,MASKPT)
00070 !
00071 !***********************************************************************
00072 ! BIEF   V6P1                                   21/08/2010
00073 !***********************************************************************
00074 !
00075 !
00076 !
00077 !
00078 !
00079 !
00080 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00081 !| F              |<->| VALUES AT TIME N+1 AND INITIALISATION
00082 !| FBOR           |-->| DIRICHLET BOUNDARY CONDITIONS
00083 !| KDIR           |-->| CONVENTION FOR DIRICHLET BOUNDARY CONDITIONS
00084 !| LIMDIR         |-->| TYPES OF BOUNDARY CONDITIONS
00085 !|                |   | IF LIMDIR(K) = KDIR LE KTH BOUNDARY POINT
00086 !|                |   | IS OF DIRICHLET TYPE.
00087 !| MASKPT         |-->| MASKING PER POINT.
00088 !|                |   | =1. : NORMAL   =0. : MASKED
00089 !| MESH           |-->| MESH STRUCTURE
00090 !| MSK            |-->| IF YES, THERE IS MASKED ELEMENTS.
00091 !| S              |<->| MATRIX OF THE LINEAR SYSTEM
00092 !| SM             |-->| RIGHT HAND SIDE
00093 !| WORK1          |<->| WORK ARRAY
00094 !| WORK2          |<->| WORK ARRAY
00095 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00096 !
00097       USE BIEF, EX_DIRI01 => DIRI01
00098 !
00099       IMPLICIT NONE
00100       INTEGER LNG,LU
00101       COMMON/INFO/LNG,LU
00102 !
00103 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00104 !
00105       TYPE(BIEF_OBJ), INTENT(INOUT) :: F,S,SM,WORK1,WORK2
00106       TYPE(BIEF_OBJ), INTENT(IN)    :: FBOR,MASKPT
00107       INTEGER, INTENT(IN) :: LIMDIR(*), KDIR
00108       TYPE(BIEF_MESH), INTENT(INOUT) :: MESH
00109       LOGICAL, INTENT(IN) :: MSK
00110 !
00111 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00112 !
00113       DOUBLE PRECISION C,Z(1)
00114 !
00115       INTEGER IELMSM,IELMFB
00116 !
00117       CHARACTER*1 OLDDIA
00118 !
00119 !----------------------------------------------------------------------
00120 !
00121 !     DEPLOYS THE MESH STRUCTURE
00122 !
00123 !----------------------------------------------------------------------
00124 !
00125 !     BUILDS AN ARRAY WITH 0S EVERYWHERE EXCEPT AT DIRICHLET POINTS
00126 !     FOR WHICH THE VALUE IS TAKEN FROM FBOR
00127 !     FBOR MUST BE 0 WHEN THE POINT IS NOT OF TYPE DIRICHLET
00128 !
00129       CALL CPSTVC(SM,WORK1)
00130 !
00131       IELMSM=SM%ELM
00132       IELMFB=FBOR%ELM
00133       IF(IELMSM.EQ.IELMFB) THEN
00134         CALL MATVEC( 'X=AY    ' ,WORK2,S,FBOR,C, MESH )
00135       ELSE
00136         CALL OS( 'X=0     ' , X=WORK1 )
00137         CALL OSDBIF( 'X=Y     ' ,WORK1,FBOR,LIMDIR,KDIR,MESH)
00138         CALL MATVEC( 'X=AY    ' ,WORK2,S,WORK1,C, MESH )
00139       ENDIF
00140 !
00141 !----------------------------------------------------------------------
00142 !
00143 !     THE PRODUCT S WORK1 IS DEDUCTED FROM THE SECOND MEMBER.
00144 !     IT MEANS THAT THE VALUES AT DIRICHLET POINTS ARE NO LONGER
00145 !     UNKNOWNS IN THE EQUATIONS FOR THE OTHER POINTS.
00146 !
00147       CALL OS( 'X=X-Y   ' , X=SM , Y=WORK2 )
00148 !
00149 !----------------------------------------------------------------------
00150 !
00151 !     BUILDS AN ARRAY WITH 1S EVERYWHERE EXCEPT AT DIRICHLET POINTS
00152 !     FOR WHICH IT'S 0
00153 !
00154 !     WHAT'S MORE, AN EQUATION OF THE FORM DS(N) * X = DS(N) * FBOR
00155 !     (WILL GIVE X=FBOR) IS SET IN THE MATRIX FOR DIRICHLET POINTS;
00156 !     AND F IS INITIALISED TO ITS KNOWN VALUE.
00157 !     THIS ASSUMES THAT DS(N) IS NOT 0
00158 !
00159       CALL DIRAUX(SM,S%D,FBOR,WORK2,F,LIMDIR,KDIR,MESH )
00160 !
00161 !     MASKING : FOR THE POINTS OF MASKED ELEMENTS THE EQUATION X=0
00162 !               IS SET FOR THE DIAGONAL COEFFICIENT PRES
00163 !
00164       IF(MSK) THEN
00165         CALL OV( 'X=XY    ', SM%R   ,MASKPT%R ,Z,C,   SM%DIM1)
00166         CALL OV( 'X=XY    ', F%R    ,MASKPT%R ,Z,C,    F%DIM1)
00167         CALL OV( 'X=XY    ', WORK2%R,MASKPT%R ,Z,C,WORK2%DIM1)
00168       ENDIF
00169 !
00170 !----------------------------------------------------------------------
00171 !
00172 !     WORK2 * S * WORK2 :
00173 !     ERASES THE LINES AND COLUMNS IN S WHICH CORRESPOND TO DIRICHLET
00174 !     POINTS
00175 !     DOES NOT ALTER THE DIAGONAL BY DECLARING IT 0 HERE
00176 !
00177       OLDDIA=S%TYPDIA
00178       S%TYPDIA='0'
00179       CALL OM( 'M=DMD   ' , S , S , WORK2 , C , MESH )
00180       S%TYPDIA=OLDDIA
00181 !
00182 !----------------------------------------------------------------------
00183 !
00184       RETURN
00185       END

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