eleb3dt.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\eleb3dt.f
00002 !
00080                      SUBROUTINE ELEB3DT
00081 !                    ******************
00082 !
00083      &(IKLE3,NBOR,NELBOR,NELBOR2D,IKLBOR,NELEB,NELEBX,NULONE,
00084      & NELEM2,NPOIN2,NPLAN,NETAGE,NPTFR,IKLBOR2D,NELEB2D,NELEBX2D)
00085 !
00086 !***********************************************************************
00087 ! BIEF   V7P0                                   19/03/2014
00088 !***********************************************************************
00089 !
00090 !
00091 !
00092 !
00093 !
00094 !
00095 !
00096 !
00097 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00098 !| IKLBOR         |<--| CONNECTIVITY TABLE FOR BOUNDARY ELEMENTS
00099 !|                |   | HERE DECLARED AS IKLBOR(NELEBX,3)
00100 !|                |   | BUT FILLED AS IKLBOR(NELEB2D,2,NETAGE,3)
00101 !|                |   | 2 IS THE NUMBER OF TETRAHEDRONS FORMING A
00102 !|                |   | VERTICAL RECTANGLE IN THE BORDER.
00103 !|                |   | 3 IS THE NUMBER OF POINTS IN EVERY TRIANGLE
00104 !|                |   | FORMING THIS RECTANGLE
00105 !| IKLBOR2D       |<--| CONNECTIVITY TABLE FOR BOUNDARY ELEMENTS IN 2D
00106 !| IKLE3          |<--| CONNECTIVITY TABLE IN 3D, FOR TETRAHEDRONS
00107 !|                |   | HERE DECLARED AS IKLE3(NELEM2,3,NETAGE,4)
00108 !|                |   | 3 IS THE NUMBER OF TETRAHEDRONS PER PRISM
00109 !|                |   | (TETRAHEDRONS ARE NUMBERED ACCORDINGLY)
00110 !|                |   | 4 IS THE NUMBER OF POINTS IN A TETRAHEDRA.
00111 !| NBOR           |-->| GLOBAL NUMBER OF BOUNDARY POINTS IN 2D
00112 !| NELBOR         |-->| FOR THE KTH BOUNDARY EDGE, GIVES THE CORRESPONDING
00113 !|                |   | ELEMENT (FROM MESH3D).
00114 !| NELBOR2D       |-->| FOR THE KTH BOUNDARY EDGE, GIVES THE CORRESPONDING
00115 !|                |   | ELEMENT (FROM MESH2D).
00116 !| NELEB          |-->| NUMBER OF BOUNDARY ELEMENTS
00117 !| NELEB2D        |-->| NUMBER OF BOUNDARY ELEMENTS OF 2D MESH
00118 !| NELEBX         |-->| MAXIMUM NUMBER OF BOUNDARY ELEMENTS
00119 !|                |   | USED AS FIRST DIMENSION OF IKLBOR
00120 !| NELEBX2D       |-->| MAXIMUM NUMBER OF BOUNDARY ELEMENTS IN 2D MESH
00121 !| NELEM2         |-->| NUMBER OF ELEMENTS IN 2D
00122 !| NETAGE         |-->| NUMBER OF PLANES - 1
00123 !| NPLAN          |-->| NUMBER OF PLANES
00124 !| NPOIN2         |-->| NUMBER OF POINTS IN 2D
00125 !| NPTFR          |-->| NUMBER OF BOUNDARY POINTS
00126 !| NULONE         |-->| GOES WITH ARRAY NELBOR. NELBOR GIVES THE
00127 !|                |   | ADJACENT ELEMENT, NULONE GIVES THE LOCAL
00128 !|                |   | NUMBER OF THE FIRST NODE OF THE BOUNDARY EDGE
00129 !|                |   | I.E. 1, 2 OR 3 FOR TRIANGLES.
00130 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00131 !
00132       USE BIEF, EX_ELEB3DT => ELEB3DT
00133 !
00134       IMPLICIT NONE
00135       INTEGER LNG,LU
00136       COMMON/INFO/LNG,LU
00137 !
00138 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00139 !
00140       INTEGER, INTENT(IN)    :: NELEM2,NPOIN2,NPLAN,NETAGE,NPTFR
00141       INTEGER, INTENT(IN)    :: NELEBX,NELEB2D,NELEBX2D
00142       INTEGER, INTENT(INOUT) :: NELEB
00143       INTEGER, INTENT(INOUT) :: IKLE3(NELEM2,3,NETAGE,4)
00144       INTEGER, INTENT(INOUT) :: IKLBOR(NELEBX,3)
00145       INTEGER, INTENT(IN)    :: IKLBOR2D(NELEBX2D,2),NELBOR2D(NELEBX2D)
00146       INTEGER, INTENT(INOUT) :: NULONE(NELEBX,3),NELBOR(NELEBX)
00147       INTEGER, INTENT(INOUT) :: NBOR(NPTFR*NPLAN)
00148 !
00149 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00150 !
00151       LOGICAL OK(2)
00152 !
00153       INTEGER IELEM,IPOIN,T(3),IELEB,IELEB3,IPTFR2
00154       INTEGER IETAGE,IPTFR,IL1,IL2,IL3,IL4,IG(2,2,3),IL(2,2,3),IPLAN
00155       INTEGER IG1,IG2,IG3,IG4,NUM1(12),NUM2(12),NUM3(12),K,L,M,N
00156 !
00157       DATA NUM1 / 1 , 2 , 4 , 1 , 3 , 2 , 2 , 3 , 4 , 3 , 1 , 4 /
00158       DATA NUM2 / 2 , 4 , 1 , 3 , 2 , 1 , 3 , 4 , 2 , 1 , 4 , 3 /
00159       DATA NUM3 / 4 , 1 , 2 , 2 , 1 , 3 , 4 , 2 , 3 , 4 , 3 , 1 /
00160 !
00161 !***********************************************************************
00162 !
00163 ! CONNECTIVITY TABLES FOR BOUNDARY FACES --> IKLBOR , NBOR3 ,
00164 ! CORRESPONDENCE BETWEEN LOCAL BOUNDARY NUMBERS AND 3D LOCAL NUMBERS --> NULONE
00165 !
00166 !     COMPLETING NBOR
00167 !
00168       DO IPTFR = 1,NPTFR
00169         IPOIN = NBOR(IPTFR)
00170         DO IPLAN = 2,NPLAN
00171           NBOR(IPTFR +(IPLAN-1)*NPTFR)=IPOIN+(IPLAN-1)*NPOIN2
00172         ENDDO
00173       ENDDO
00174 !
00175 !     LATERAL BOUNDARIES :
00176 !     FOR EACH RECTANGULAR FACE SPLIT IN TWO TRIANGLES
00177 !     THE LOWER TRIANGLE IS NUMBER 1, THE HIGHER IS NUMBER 2
00178 !
00179       DO IELEB = 1,NELEB2D
00180 !
00181         IPTFR =IKLBOR2D(IELEB,1)
00182         IPTFR2=IKLBOR2D(IELEB,2)
00183 !
00184 !       TRIANGLE TOUCHING THE BOUNDARY IN 2D
00185         IELEM = NELBOR2D(IELEB)
00186 !
00187         DO IETAGE = 1,NETAGE
00188 !
00189 !         3D BOUNDARY NUMBERING OF THE 4 POINTS OF THE RECTANGULAR FACE
00190 !
00191           IL1 = IPTFR  + (IETAGE-1)*NPTFR
00192           IL2 = IPTFR2 + (IETAGE-1)*NPTFR
00193           IL3 = IL2 + NPTFR
00194           IL4 = IL1 + NPTFR
00195 !
00196 !         3D GLOBAL NUMBERING OF THE 4 POINTS OF THE RECTANGULAR FACE
00197 !
00198           IG1 = NBOR(IPTFR)  + (IETAGE-1)*NPOIN2
00199           IG2 = NBOR(IPTFR2) + (IETAGE-1)*NPOIN2
00200           IG3 = IG2 + NPOIN2
00201           IG4 = IG1 + NPOIN2
00202 !
00203 !         NUMBERS OF THE 3 TETRAHEDRONS POSSIBLY TOUCHING THE FACE
00204 !
00205           T(1) = (IETAGE-1)*3*NELEM2+IELEM
00206           T(2) = T(1) + NELEM2
00207           T(3) = T(2) + NELEM2
00208 !
00209 !         LOOKS FOR THE LOWER TRIANGLE (CAN BE 1-2-4 OR 1-2-3)
00210 !
00211 !         2 POSSIBLE FORMS OF THE LOWER TRIANGLE (GLOBAL AND BOUNDARY)
00212           IG(1,1,1)=IG1
00213           IG(1,1,2)=IG2
00214           IG(1,1,3)=IG4
00215           IG(1,2,1)=IG1
00216           IG(1,2,2)=IG2
00217           IG(1,2,3)=IG3
00218           IL(1,1,1)=IL1
00219           IL(1,1,2)=IL2
00220           IL(1,1,3)=IL4
00221           IL(1,2,1)=IL1
00222           IL(1,2,2)=IL2
00223           IL(1,2,3)=IL3
00224 !         2 POSSIBLE FORMS OF THE HIGHER TRIANGLE (GLOBAL AND BOUNDARY)
00225           IG(2,1,1)=IG1
00226           IG(2,1,2)=IG3
00227           IG(2,1,3)=IG4
00228           IG(2,2,1)=IG2
00229           IG(2,2,2)=IG3
00230           IG(2,2,3)=IG4
00231           IL(2,1,1)=IL1
00232           IL(2,1,2)=IL3
00233           IL(2,1,3)=IL4
00234           IL(2,2,1)=IL2
00235           IL(2,2,2)=IL3
00236           IL(2,2,3)=IL4
00237 !
00238           OK(1)=.FALSE.
00239           OK(2)=.FALSE.
00240 !
00241 !         K=1 LOWER TRIANGLE   K=2 HIGHER TRIANGLE
00242           DO K=1,2
00243 !           2 POSSIBLE SPLITS
00244             DO L=1,2
00245 !             12 WAYS FOR A TETRAHEDRON OF PRESENTING ITS FACES
00246               DO M=1,12
00247 !               3 POSSIBLE TETRAHEDRONS
00248                 DO N=1,3
00249                   IF(IG(K,L,1).EQ.IKLE3(IELEM,N,IETAGE,NUM1(M)).AND.
00250      &               IG(K,L,2).EQ.IKLE3(IELEM,N,IETAGE,NUM2(M)).AND.
00251      &               IG(K,L,3).EQ.IKLE3(IELEM,N,IETAGE,NUM3(M))) THEN
00252 !                   STORAGE LIKE IKLBOR(NELEB2D,2,NETAGE,3)
00253                     IELEB3=(2*IETAGE+K-3)*NELEB2D+IELEB
00254                     IKLBOR(IELEB3,1) = IL(K,L,1)
00255                     IKLBOR(IELEB3,2) = IL(K,L,2)
00256                     IKLBOR(IELEB3,3) = IL(K,L,3)
00257                     NELBOR(IELEB3)   = T(N)
00258                     NULONE(IELEB3,1) = NUM1(M)
00259                     NULONE(IELEB3,2) = NUM2(M)
00260                     NULONE(IELEB3,3) = NUM3(M)
00261                     OK(K) = .TRUE.
00262                   ENDIF
00263                 ENDDO
00264               ENDDO
00265             ENDDO
00266           ENDDO
00267           IF(.NOT.OK(1).OR..NOT.OK(2)) THEN
00268             WRITE(LU,*) 'PB IN ELEB3DT IELEM=',IELEM,' IPTFR=',IPTFR
00269             CALL PLANTE(1)
00270             STOP
00271           ENDIF
00272 !
00273         ENDDO
00274 !
00275       ENDDO
00276 !
00277 !-----------------------------------------------------------------------
00278 !
00279 !     NELEB IS THE 3D VALUE
00280 !
00281       NELEB=2*NELEB2D*NETAGE
00282 !
00283 !-----------------------------------------------------------------------
00284 !
00285       RETURN
00286       END

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