dirich.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\dirich.f
00002 !
00066                      SUBROUTINE DIRICH
00067 !                    *****************
00068 !
00069      &(F, S, SM , FBOR,LIMDIR,WORK,MESH,KDIR,MSK,MASKPT)
00070 !
00071 !***********************************************************************
00072 ! BIEF   V6P1                                   21/08/2010
00073 !***********************************************************************
00074 !
00075 !
00076 !
00077 !
00078 !
00079 !
00080 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00081 !| F              |-->| VARIABLE THAT WILL BE GIVEN ITS DIRICHLET VALUE
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 !| WORK           |-->| BLOCK OF WORK ARRAYS
00094 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00095 !
00096       USE BIEF, EX_DIRICH => DIRICH
00097 !
00098       IMPLICIT NONE
00099       INTEGER LNG,LU
00100       COMMON/INFO/LNG,LU
00101 !
00102 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00103 !
00104       TYPE(BIEF_MESH), INTENT(INOUT) :: MESH
00105 !                                                   DIMLIM,6
00106       INTEGER        , INTENT(IN)    :: KDIR,LIMDIR(*)
00107       LOGICAL        , INTENT(IN)    :: MSK
00108       TYPE(BIEF_OBJ) , INTENT(INOUT) :: WORK
00109       TYPE(BIEF_OBJ) , INTENT(INOUT) :: F,SM,S
00110       TYPE(BIEF_OBJ) , INTENT(IN)    :: FBOR,MASKPT
00111 !
00112 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00113 !
00114       INTEGER DIMLIM
00115 !
00116 !----------------------------------------------------------------------
00117 !
00118 !  IF S IS A MATRIX
00119 !
00120       IF(S%TYPE.EQ.3) THEN
00121 !
00122       CALL DIRI01(F, S, SM , FBOR,LIMDIR,WORK%ADR(1)%P,WORK%ADR(2)%P,
00123      &            MESH,KDIR,MSK,MASKPT)
00124 !
00125 !  IF S IS A BLOCK OF 4 MATRICES
00126 !
00127       ELSEIF(S%TYPE.EQ.4.AND.S%N.EQ.4) THEN
00128 !
00129       DIMLIM=MAX(FBOR%ADR(1)%P%DIM1,
00130      &           FBOR%ADR(2)%P%DIM1)
00131 !
00132       CALL DIRI04(F%ADR(1)%P,F%ADR(2)%P,
00133      &     S%ADR(1)%P,S%ADR(2)%P,S%ADR(3)%P,S%ADR(4)%P,
00134      &     SM%ADR(1)%P,SM%ADR(2)%P,
00135      &     WORK%ADR(1)%P,WORK%ADR(2)%P,WORK%ADR(3)%P,WORK%ADR(4)%P,
00136      &     FBOR%ADR(1)%P,FBOR%ADR(2)%P,
00137      &     LIMDIR(1:DIMLIM),LIMDIR(DIMLIM+1:2*DIMLIM),
00138      &     MESH,KDIR,MSK,MASKPT)
00139 !
00140 !  IF S IS A BLOCK OF 9 MATRICES
00141 !
00142       ELSEIF(S%TYPE.EQ.4.AND.S%N.EQ.9) THEN
00143 !
00144       DIMLIM=MAX(FBOR%ADR(1)%P%DIM1,
00145      &           FBOR%ADR(2)%P%DIM1,
00146      &           FBOR%ADR(3)%P%DIM1)
00147 !
00148       CALL DIRI09(F%ADR(1)%P,F%ADR(2)%P,F%ADR(3)%P,
00149      &            S%ADR(1)%P,S%ADR(2)%P,S%ADR(3)%P,
00150      &            S%ADR(4)%P,S%ADR(5)%P,S%ADR(6)%P,
00151      &            S%ADR(7)%P,S%ADR(8)%P,S%ADR(9)%P,
00152      &            SM%ADR(1)%P,SM%ADR(2)%P,SM%ADR(3)%P,
00153      &            WORK%ADR(1)%P,WORK%ADR(2)%P,WORK%ADR(3)%P,
00154      &            WORK%ADR(4)%P,WORK%ADR(5)%P,WORK%ADR(6)%P,
00155      &            FBOR%ADR(1)%P,FBOR%ADR(2)%P,FBOR%ADR(3)%P,
00156      &            LIMDIR(         1:  DIMLIM),
00157      &            LIMDIR(  DIMLIM+1:2*DIMLIM),
00158      &            LIMDIR(2*DIMLIM+1:3*DIMLIM),
00159      &            MESH,KDIR,MSK,MASKPT)
00160 !
00161 !  ERROR
00162 !
00163       ELSE
00164 !
00165         IF (LNG.EQ.1) WRITE(LU,1000) S%TYPE
00166         IF (LNG.EQ.2) WRITE(LU,1001) S%TYPE
00167 1000    FORMAT(1X,'DIRICH (BIEF) : MAUVAIS TYPE POUR S :',1I6)
00168 1001    FORMAT(1X,'DIRICH (BIEF): WRONG TYPE FOR S:',1I6)
00169         CALL PLANTE(1)
00170         STOP
00171 !
00172       ENDIF
00173 !
00174 !----------------------------------------------------------------------
00175 !
00176       RETURN
00177       END

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