ifab3d.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\telemac3d\ifab3d.f
00002 !
00061                      SUBROUTINE IFAB3D
00062 !                    *****************
00063 !
00064      &(IFABOR,LIUBOF,LIUBOL,LIUBOS,KP1BOR,NELBOR,NULONE,
00065      & IKLE2,NELEM2,NPOIN2,NPTFR,NPLAN,NETAGE,KLOG,TRANSF)
00066 !
00067 !***********************************************************************
00068 ! TELEMAC3D   V6P1                                   21/08/2010
00069 !***********************************************************************
00070 !
00071 !
00072 !
00073 !
00074 !
00075 !
00076 !
00077 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00078 !| IFABOR         |<->| CORRESPONDENCE BOUNDARY FACE - 2D ELEMENT 2D
00079 !| IKLE2          |-->| GLOBAL NUMBERS OF POINTS IN 2D ELEMENTS FROM LOCAL
00080 !| KLOG           |-->| CONVENTION FOR SOLID BOUNDARY
00081 !| KP1BOR         |-->| GIVES THE NEXT BOUNDARY POINT IN A CONTOUR
00082 !| LIUBOF         |-->| TYPE OF BOUNDARY CONDITIONS ON U AT THE BOTTOM
00083 !| LIUBOL         |-->| TYPE OF BOUNDARY CONDITIONS ON U ON THE LATERAL WALLS
00084 !| LIUBOS         |-->| TYPE OF BOUNDARY CONDITIONS ON U AT THE SURFACE
00085 !| NELBOR         |-->| FOR THE KTH BOUNDARY EDGE, GIVES THE CORRESPONDING
00086 !|                |   | ELEMENT.
00087 !| NELEM2         |-->| NUMBER OF ELEMENTS IN 2D
00088 !| NETAGE         |-->| NUMBER OF PLANES - 1
00089 !| NPLAN          |-->| NUMBER OF PLANES IN THE 3D MESH OF PRISMS
00090 !| NPOIN2         |-->| NUMBER OF POINTS IN 2D
00091 !| NPTFR          |-->| NUMBER OF 2D BOUNDARY POINTS
00092 !| NULONE         |-->| GOES WITH ARRAY NELBOR. NELBOR GIVES THE
00093 !|                |   | ADJACENT ELEMENT, NULONE GIVES THE LOCAL
00094 !|                |   | NUMBER OF THE FIRST NODE OF THE BOUNDARY EDGE
00095 !|                |   | I.E. 1, 2 OR 3 FOR TRIANGLES.
00096 !|                |   | HERE IT IS MESH2D%NULONE%I  !!!!!!!!!!!!!!
00097 !| TRANSF         |-->| TRANSFORMATION
00098 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00099 !
00100       USE BIEF
00101 !
00102       IMPLICIT NONE
00103       INTEGER LNG,LU
00104       COMMON/INFO/LNG,LU
00105 !
00106 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00107 !
00108       INTEGER, INTENT(IN)          :: NELEM2,NPOIN2,NETAGE,NPLAN,TRANSF
00109       INTEGER, INTENT(IN)          :: NPTFR,KLOG
00110       INTEGER, INTENT(INOUT)       :: IFABOR(NELEM2,5,NETAGE)
00111       INTEGER, INTENT(IN)          :: LIUBOF(NPOIN2),LIUBOS(NPOIN2)
00112       INTEGER, INTENT(IN)          :: LIUBOL(NPTFR,NPLAN)
00113       INTEGER, INTENT(IN)          :: IKLE2(NELEM2,3)
00114       INTEGER, INTENT(IN)          :: NULONE(NPTFR,2)
00115       INTEGER, INTENT(IN)          :: KP1BOR(NPTFR), NELBOR(NPTFR)
00116 !
00117 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00118 !
00119       INTEGER IELEM2, IETAGE, IPTFR1, IPTFR2, IELBR, IFACE,LOC
00120       LOGICAL FLAG
00121 !
00122 !=======================================================================
00123 !  IFABOR ARRAYS
00124 !=======================================================================
00125 !
00126 !     SEE CHAR41 FOR THE MEANING OF LOC
00127 !     1 IS : DO NOT RECOMPUTE VELOCITIES WHEN CROSSING A MESH PLANE
00128 !     2 IS : RECOMPUTE VELOCITIES WHEN CROSSING A MESH PLANE
00129 !
00130 !     IF(TRANSF.EQ.1.OR.TRANSF.EQ.2.OR.TRANSF.EQ.3) THEN
00131 !
00132 !     JMH ON 18/02/2010: WITH A FIXED PLANE
00133 !                        THE VELOCITY MUST BE RECOMPUTED
00134       IF(TRANSF.EQ.1.OR.TRANSF.EQ.2) THEN
00135         LOC = 1
00136       ELSEIF(TRANSF.EQ.0.OR.TRANSF.EQ.3.OR.TRANSF.EQ.5) THEN
00137         LOC = 2
00138       ELSE
00139         WRITE(LU,*) 'WRONG VALUE OF TRANSF IN IFAB3D: ',TRANSF
00140         CALL PLANTE(1)
00141         STOP
00142       ENDIF
00143 !
00144 !  IFABOR ON THE VERTICAL FACES OF THE ELEMENTS OF THE FIRST LAYER
00145 !
00146       DO IELEM2 = 1,NELEM2
00147 !       ALREADY DONE BY 2D
00148 !       IFABOR(IELEM2,1,IETAGE) = IFABOR(IELEM2,1,1)
00149 !       IFABOR(IELEM2,2,IETAGE) = IFABOR(IELEM2,2,1)
00150 !       IFABOR(IELEM2,3,IETAGE) = IFABOR(IELEM2,3,1)
00151         IFABOR(IELEM2,4,1) = LOC
00152         IFABOR(IELEM2,5,1) = LOC
00153       ENDDO ! IELEM2
00154       IF(NETAGE.GE.2) THEN
00155         DO IETAGE = 2,NETAGE
00156           DO IELEM2 = 1,NELEM2
00157             IFABOR(IELEM2,1,IETAGE) = IFABOR(IELEM2,1,1)
00158             IFABOR(IELEM2,2,IETAGE) = IFABOR(IELEM2,2,1)
00159             IFABOR(IELEM2,3,IETAGE) = IFABOR(IELEM2,3,1)
00160             IFABOR(IELEM2,4,IETAGE) = LOC
00161             IFABOR(IELEM2,5,IETAGE) = LOC
00162           ENDDO
00163         ENDDO
00164       ENDIF
00165 !
00166 !=======================================================================
00167 !
00168 ! TYPES OF BOUNDARY CONDITIONS IMPOSED ON IFABOR
00169 !
00170 !=======================================================================
00171 !
00172 !  IFABOR ON THE LATERAL WALLS
00173 !
00174       DO IPTFR1 = 1,NPTFR
00175 !
00176         IPTFR2 = KP1BOR(IPTFR1)
00177 !       IF NEXT POINT IN THE SUBDOMAIN
00178         IF(IPTFR2.NE.IPTFR1) THEN
00179           IELBR = NELBOR(IPTFR1)
00180           IFACE = NULONE(IPTFR1,1)
00181           IF(IFABOR(IELBR,IFACE,1).NE.-2) THEN
00182             FLAG = .FALSE.
00183             IF(LIUBOL(IPTFR1,1).NE.KLOG .AND.
00184      &         LIUBOL(IPTFR2,1).NE.KLOG) FLAG = .TRUE.
00185             DO IETAGE = 1,NETAGE
00186               IFABOR(IELBR,IFACE,IETAGE) = -1
00187               IF(LIUBOL(IPTFR1,IETAGE+1).NE.KLOG .AND.
00188      &           LIUBOL(IPTFR2,IETAGE+1).NE.KLOG) THEN
00189                 IF(FLAG) IFABOR(IELBR,IFACE,IETAGE) = 0
00190                 FLAG = .TRUE.
00191               ELSE
00192                 FLAG = .FALSE.
00193               ENDIF
00194             ENDDO
00195           ELSE
00196             IF(NETAGE.GT.1) THEN
00197               DO IETAGE = 2,NETAGE
00198                 IFABOR(IELBR,IFACE,IETAGE) = -2
00199               ENDDO
00200             ENDIF
00201           ENDIF
00202         ENDIF
00203 !
00204       ENDDO
00205 !
00206 !-----------------------------------------------------------------------
00207 !
00208 !  IFABOR ON THE BOTTOM, SURFACE AND EITHER SIDE OF THE INTERMEDIATE PLANE
00209 !
00210       DO IELEM2 = 1,NELEM2
00211 !
00212         IFABOR(IELEM2,4,1) = -1
00213         IF(LIUBOF(IKLE2(IELEM2,1)).NE.KLOG .AND.
00214      &     LIUBOF(IKLE2(IELEM2,2)).NE.KLOG .AND.
00215      &     LIUBOF(IKLE2(IELEM2,3)).NE.KLOG) IFABOR(IELEM2,4,1)=0
00216 !
00217         IFABOR(IELEM2,5,NETAGE) = -1
00218         IF(LIUBOS(IKLE2(IELEM2,1)).NE.KLOG .OR.
00219      &     LIUBOS(IKLE2(IELEM2,2)).NE.KLOG .OR.
00220      &     LIUBOS(IKLE2(IELEM2,3)).NE.KLOG) IFABOR(IELEM2,5,NETAGE)=0
00221 !
00222       ENDDO
00223 !
00224 !-----------------------------------------------------------------------
00225 !
00226       RETURN
00227       END

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