cpikle3.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\cpikle3.f
00002 !
00202                      SUBROUTINE CPIKLE3
00203 !                    ******************
00204 !
00205      &(IKLE3,IKLES,NELEM2,NELMAX2,NPOIN2,NPLAN,KNOLG)
00206 !
00207 !***********************************************************************
00208 ! BIEF   V6P2                                   21/08/2010
00209 !***********************************************************************
00210 !
00211 !
00212 !
00213 !
00214 !
00215 !
00216 !
00217 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00218 !| IKLE3          |<->| 3D CONNECTIVITY TABLE
00219 !| IKLES          |-->| 2D CONNECTIVITY TABLE WITH DIMENSION (3,NELEM2)
00220 !| KNOLG          |-->| GIVES THE ORIGINAL GLOBAL NUMBER OF POINTS
00221 !| NELEM2         |-->| NUMBER OF ELEMENTS IN 2D
00222 !| NELMAX2        |-->| MAXIMUM NUMBER OF ELEMENTS IN 2D
00223 !| NPLAN          |-->| NUMBER OF PLANES
00224 !| NPOIN2         |-->| NUMBER OF POINTS IN 2D
00225 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00226 !
00227       USE BIEF, ONLY : NCSIZE
00228       USE DECLARATIONS_TELEMAC, ONLY : TETRA
00229 !
00230       IMPLICIT NONE
00231       INTEGER LNG,LU
00232       COMMON/INFO/LNG,LU
00233 !
00234 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00235 !
00236       INTEGER, INTENT(IN)    :: NELEM2,NELMAX2,NPOIN2,NPLAN
00237 !                                     NPOIN3 BUT ONLY FILLED TO NPOIN2
00238       INTEGER, INTENT(IN)    :: KNOLG(NPOIN2)
00239       INTEGER, INTENT(INOUT) :: IKLES(3,NELEM2)
00240       INTEGER, INTENT(INOUT) :: IKLE3(NELMAX2,3,NPLAN-1,4)
00241 !
00242 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00243 !
00244       INTEGER IELEM,I,K,L,IGLOB(6),S1,S2,S3,I1,I2,I3
00245 !
00246 !     TETRA : SEE EXPLANATIONS ABOVE, THE 0 CORRESPOND TO SITUATIONS
00247 !             THAT NEVER HAPPEN (TETRA(1,1,1,... OR TETRA(2,2,2,...)
00248 !     INTEGER TETRA(2,2,2,3,4)
00249 !     DATA TETRA / 0,1,1,1,1,1,1,0,0,4,4,4,4,4,4,0,0,6,4,5,5,4,6,0,
00250 !    &             0,2,2,2,2,2,2,0,0,6,6,6,6,6,6,0,0,3,1,2,2,1,3,0,
00251 !    &             0,3,3,3,3,3,3,0,0,5,5,5,5,5,5,0,0,2,3,4,1,6,5,0,
00252 !    &             0,4,5,4,6,6,5,0,0,2,3,3,1,2,1,0,0,4,5,3,6,2,1,0 /
00253 !
00254 !-----------------------------------------------------------------------
00255 !
00256 !     BOTTOM AND TOP OF ALL LAYERS
00257 !
00258       IF(NPLAN.GE.2) THEN
00259 !
00260 !       LOOP ON THE TRIANGLES
00261 !
00262         DO IELEM = 1,NELEM2
00263 !
00264           I1=IKLES(1,IELEM)
00265           I2=IKLES(2,IELEM)
00266           I3=IKLES(3,IELEM)
00267 !
00268 !         IN PARALLEL, IT IS NOT SURE THAT THE MESH PARTITIONER KEEPS
00269 !         THE SAME RANK BETWEEN POINTS, SO WE USE HERE THE ORIGINAL
00270 !         GLOBAL NUMBERS
00271 !
00272           IF(NCSIZE.GT.1) THEN
00273             I1=KNOLG(I1)
00274             I2=KNOLG(I2)
00275             I3=KNOLG(I3)
00276           ENDIF
00277 !
00278           IF(I1.GT.I2) THEN
00279             S1=1
00280           ELSE
00281             S1=2
00282           ENDIF
00283           IF(I2.GT.I3) THEN
00284             S2=1
00285           ELSE
00286             S2=2
00287           ENDIF
00288           IF(I3.GT.I1) THEN
00289             S3=1
00290           ELSE
00291             S3=2
00292           ENDIF
00293 !
00294 !         LOOP ON THE PLANES
00295 !
00296           DO I = 1,NPLAN-1
00297 !
00298 !           GLOBAL NUMBERS OF THE 6 POINTS OF THE PRISM
00299 !
00300             IGLOB(1) = IKLES(1,IELEM) + (I-1)*NPOIN2
00301             IGLOB(2) = IKLES(2,IELEM) + (I-1)*NPOIN2
00302             IGLOB(3) = IKLES(3,IELEM) + (I-1)*NPOIN2
00303             IGLOB(4) = IKLES(1,IELEM) +  I   *NPOIN2
00304             IGLOB(5) = IKLES(2,IELEM) +  I   *NPOIN2
00305             IGLOB(6) = IKLES(3,IELEM) +  I   *NPOIN2
00306 !
00307             DO K=1,3
00308             DO L=1,4
00309               IKLE3(IELEM,K,I,L) = IGLOB(TETRA(S1,S2,S3,K,L))
00310             ENDDO
00311             ENDDO
00312 !
00313           ENDDO
00314         ENDDO
00315       ELSE
00316         IF(LNG.EQ.1) WRITE(LU,*) 'CPIKLE3 : IL FAUT AU MOINS 2 PLANS'
00317         IF(LNG.EQ.2) WRITE(LU,*) 'CPIKLE3 : MINIMUM OF 2 PLANES NEEDED'
00318         CALL PLANTE(1)
00319         STOP
00320       ENDIF
00321 !
00322 !-----------------------------------------------------------------------
00323 !
00324       RETURN
00325       END

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