ifab3dt.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac3d\ifab3dt.f
00002 !
00041                      SUBROUTINE IFAB3DT
00042 !                    ******************
00043 !
00044      &(IFABOR,IFABOR2D,LIUBOF,LIUBOL,LIUBOS,KP1BOR,NELBOR,NULONE,
00045      & IKLE2,IKLE,NELEM2,NELMAX,
00046      & NPOIN2,NPTFR,NPLAN,NETAGE,KLOG,TRANSF)
00047 !
00048 !***********************************************************************
00049 ! TELEMAC3D   V6P3                                   10/09/2012
00050 !***********************************************************************
00051 !
00052 !
00053 !
00054 !
00055 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00056 !| IFABOR         |<->| THE ELEMENT BEHIND A FACE OF AN ELEMENT (IN 3D)
00057 !| IFABOR2D       |-->| THE ELEMENT BEHIND A FACE OF AN ELEMENT (IN 2D)
00058 !| IKLE           |-->| GLOBAL NUMBERS OF POINTS IN 3D ELEMENTS
00059 !| IKLE2          |-->| GLOBAL NUMBERS OF POINTS IN 2D ELEMENTS
00060 !| KLOG           |-->| CONVENTION FOR SOLID BOUNDARY
00061 !| KP1BOR         |-->| GIVES THE NEXT BOUNDARY POINT IN A CONTOUR
00062 !| LIUBOF         |-->| TYPE OF BOUNDARY CONDITIONS ON U AT THE BOTTOM
00063 !| LIUBOL         |-->| TYPE OF BOUNDARY CONDITIONS ON U ON THE LATERAL WALLS
00064 !| LIUBOS         |-->| TYPE OF BOUNDARY CONDITIONS ON U AT THE SURFACE
00065 !| NELBOR         |-->| FOR THE KTH BOUNDARY EDGE, GIVES THE CORRESPONDING
00066 !|                |   | ELEMENT.
00067 !| NELEM2         |-->| NUMBER OF ELEMENTS IN 2D
00068 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS IN 3D
00069 !| NETAGE         |-->| NUMBER OF PLANES - 1
00070 !| NPLAN          |-->| NUMBER OF PLANES IN THE 3D MESH OF PRISMS
00071 !| NPOIN2         |-->| NUMBER OF POINTS IN 2D
00072 !| NPTFR          |-->| NUMBER OF 2D BOUNDARY POINTS
00073 !| NULONE         |-->| GOES WITH ARRAY NELBOR. NELBOR GIVES THE
00074 !|                |   | ADJACENT ELEMENT, NULONE GIVES THE LOCAL
00075 !|                |   | NUMBER OF THE FIRST NODE OF THE BOUNDARY EDGE
00076 !|                |   | I.E. 1, 2 OR 3 FOR TRIANGLES.
00077 !|                |   | HERE IT IS MESH2D%NULONE%I  !!!!!!!!!!!!!!
00078 !| TRANSF         |-->| TRANSFORMATION
00079 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00080 !
00081       USE BIEF
00082 !
00083       IMPLICIT NONE
00084       INTEGER LNG,LU
00085       COMMON/INFO/LNG,LU
00086 !
00087 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00088 !
00089       INTEGER, INTENT(IN)          :: NELEM2,NPOIN2,NETAGE,NPLAN,TRANSF
00090       INTEGER, INTENT(IN)          :: NPTFR,KLOG,NELMAX
00091       INTEGER, INTENT(INOUT)       :: IFABOR(NELMAX,4)
00092       INTEGER, INTENT(IN)          :: IFABOR2D(NELEM2,3)
00093       INTEGER, INTENT(IN)          :: LIUBOF(NPOIN2),LIUBOS(NPOIN2)
00094       INTEGER, INTENT(IN)          :: LIUBOL(NPTFR,NPLAN)
00095       INTEGER, INTENT(IN)          :: IKLE2(NELEM2,3),IKLE(NELMAX,4)
00096       INTEGER, INTENT(IN)          :: NULONE(NPTFR,2)
00097       INTEGER, INTENT(IN)          :: KP1BOR(NPTFR), NELBOR(NPTFR)
00098 !
00099 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00100 !
00101       INTEGER IELEM2,IETAGE,IFACE,IT1,IT2,IT3,IT
00102       INTEGER I1,I2,ITET,IFAC
00103       LOGICAL OK
00104 !
00105       INTEGER ISUI(3)
00106       DATA ISUI/2,3,1/
00107 !
00108 !     DEFINES THE FOUR TRIANGLES OF THE TETRAHEDRON: THE FIRST
00109 !     DIMENSION IS THE NUMBER OF THE TRIANGLE, THE SECOND GIVES
00110 !     THE NODE NUMBERS OF THE NODES OF TETRAHEDRONS WHICH DEFINE IT.
00111 !
00112       INTEGER SOMFAC(3,4)
00113       DATA SOMFAC /  1,2,3 , 1,4,2 , 2,4,3 , 1,3,4   /
00114 !
00115 !=======================================================================
00116 !
00117 !     IFABOR ON THE LATERAL WALLS, ALREADY INITIALISED AT -1
00118 !     NOW LOOKING AT LIQUID BOUNDARIES WITH THE HELP OF IFABOR2D
00119 !
00120 !=======================================================================
00121 !
00122       DO IELEM2 = 1,NELEM2
00123         DO IFACE=1,3
00124 !
00125           IF(IFABOR(IELEM2,IFACE).EQ.0) THEN
00126 !           ONE LIQUID BOUNDARY DETECTED
00127 !           ALL CORRESPONDING VERTICAL FACES MUST BE SET TO 0
00128 !           LOOP OVER ALL TETRAHEDRA IN THE COLUMN OF PRISMS OVER
00129 !           TRIANGLE IELEM2
00130             DO IETAGE=1,NETAGE
00131               DO IT=1,3
00132                 ITET=3*NELEM2*(IETAGE-1)+(IT-1)*NELEM2+IELEM2
00133 !               NOW LOOKING ALL FACES WITH IFABOR=-1
00134                 DO IFAC=1,4
00135                   IF(IFABOR(ITET,IFAC).EQ.-1) THEN
00136 !                   THE TWO POINTS OF THE 2D SEGMENT
00137                     I1=IKLE2(IELEM2,IFACE)
00138                     I2=IKLE2(IELEM2,ISUI(IFACE))
00139                     OK=.FALSE.
00140 !                   TO BE TAKEN INTO ACCOUNT
00141 !                   THIS FACE MUST HAVE ALL POINTS ABOVE I1 OR I2
00142 !                   THE 3 POINTS OF THE TETRAHEDRON
00143                     IT1=IKLE(ITET,SOMFAC(1,IFAC))
00144                     IT2=IKLE(ITET,SOMFAC(2,IFAC))
00145                     IT3=IKLE(ITET,SOMFAC(3,IFAC))
00146                     IF( (MOD(IT1-1,NPOIN2)+1.EQ.I1.OR.
00147      &                   MOD(IT1-1,NPOIN2)+1.EQ.I2    ).AND.
00148      &                  (MOD(IT2-1,NPOIN2)+1.EQ.I1.OR.
00149      &                   MOD(IT2-1,NPOIN2)+1.EQ.I2    ).AND.
00150      &                  (MOD(IT3-1,NPOIN2)+1.EQ.I1.OR.
00151      &                   MOD(IT3-1,NPOIN2)+1.EQ.I2    ) ) THEN
00152                       IFABOR(ITET,IFAC)=0
00153                     ENDIF
00154                   ENDIF
00155                 ENDDO
00156               ENDDO
00157             ENDDO
00158           ENDIF
00159 !
00160         ENDDO
00161       ENDDO
00162 !
00163 !-----------------------------------------------------------------------
00164 !
00165 !     IFABOR ON HORIZONTAL FACES OF THE BOTTOM AND FREE SURFACE
00166 !     ALSO INITIALISED AT -1 IN VOISIN31, BUT REDONE HERE
00167 !
00168       DO IELEM2 = 1,NELEM2
00169 !
00170 !       ADDRESS OF FIRST TETRAHEDRON OF THE BOTTOM LAYER
00171 !       ITS FIRST FACE IS THE BOTTOM FACE
00172         ITET=IELEM2
00173         IFABOR(ITET,1) = -1
00174         IF(LIUBOF(IKLE2(IELEM2,1)).NE.KLOG .AND.
00175      &     LIUBOF(IKLE2(IELEM2,2)).NE.KLOG .AND.
00176      &     LIUBOF(IKLE2(IELEM2,3)).NE.KLOG) IFABOR(ITET,1)=0
00177 !
00178 !       ADDRESS OF SECOND TETRAHEDRON OF THE TOP LAYER
00179 !       ITS FIRST FACE IS THE FREE SURFACE FACE
00180         ITET=(NETAGE-1)*NELEM2*3+NELEM2+IELEM2
00181         IFABOR(ITET,1) = -1
00182         IF(LIUBOS(IKLE2(IELEM2,1)).NE.KLOG .OR.
00183      &     LIUBOS(IKLE2(IELEM2,2)).NE.KLOG .OR.
00184      &     LIUBOS(IKLE2(IELEM2,3)).NE.KLOG) IFABOR(ITET,1)=0
00185 !
00186       ENDDO
00187 !
00188 !-----------------------------------------------------------------------
00189 !
00190       RETURN
00191       END

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