diraux.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\diraux.f
00002 !
00092                      SUBROUTINE DIRAUX
00093 !                    *****************
00094 !
00095      & ( X , Y , Z , W , F , INDIC , CRITER , MESH )
00096 !
00097 !***********************************************************************
00098 ! BIEF   V6P1                                   21/08/2010
00099 !***********************************************************************
00100 !
00101 !
00102 !
00103 !
00104 !
00105 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00106 !| CRITER         |-->| INTEGER, CONVENTION FOR DIRICHLET
00107 !| F              |-->| VARIABLE THAT WILL BE GIVEN ITS DIRICHLET VALUE
00108 !|                |   | TAKEN IN Z
00109 !| INDIC          |-->| BOUNDARY CONDITIONS AT VALUE CRITER OR NOT
00110 !| MESH           |-->| MESH STRUCTURE
00111 !| W              |<->| WORK ARRAY
00112 !| X              |<--| Y MULTIPLIED BY Z IF INDIC(K) = CRITER
00113 !| Y              |-->| VECTOR, A DATA
00114 !| Z              |-->| DIRICHLET VALUES
00115 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00116 !
00117       USE BIEF, EX_DIRAUX => DIRAUX
00118 !
00119       IMPLICIT NONE
00120       INTEGER LNG,LU
00121       COMMON/INFO/LNG,LU
00122 !
00123 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00124 !
00125       TYPE(BIEF_OBJ) , INTENT(INOUT) :: X,W,F
00126       TYPE(BIEF_OBJ) , INTENT(IN)    :: Y,Z
00127       INTEGER        , INTENT(IN)    :: INDIC(*),CRITER
00128       TYPE(BIEF_MESH), INTENT(IN)    :: MESH
00129 !
00130 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00131 !
00132       INTEGER K,NPOIN,IELMX,IELMZ,N
00133 !
00134 !-----------------------------------------------------------------------
00135 !
00136       NPOIN = Z%DIM1
00137 !
00138 !-----------------------------------------------------------------------
00139 !
00140 !  W SET TO 1
00141 !
00142       CALL OS( 'X=C     ' , X=W , C=1.D0 )
00143 !
00144 !-----------------------------------------------------------------------
00145 !
00146       IELMX=X%ELM
00147       IELMZ=Z%ELM
00148 !
00149       IF(IELMX.NE.IELMZ) THEN
00150 !
00151         DO K=1,NPOIN
00152           IF(INDIC(K).EQ.CRITER) THEN
00153             N = MESH%NBOR%I(K)
00154             X%R(N) = Y%R(N) * Z%R(K)
00155             W%R(N) = 0.D0
00156             F%R(N) = Z%R(K)
00157           ENDIF
00158         ENDDO
00159 !
00160       ELSE
00161 !
00162         DO K=1,NPOIN
00163           IF(INDIC(K).EQ.CRITER) THEN
00164             X%R(K) = Y%R(K) * Z%R(K)
00165             W%R(K) = 0.D0
00166             F%R(K) = Z%R(K)
00167           ENDIF
00168         ENDDO
00169 !
00170       ENDIF
00171 !
00172 !-----------------------------------------------------------------------
00173 !
00174       RETURN
00175       END

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