make_eltcar.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\make_eltcar.f
00002 !
00084                      SUBROUTINE MAKE_ELTCAR
00085 !                    **********************
00086 !
00087      &(ELTCAR,IKLE,NPOIN2,NELEM2,NELMAX,KNOLG,ISCORE,MESH,NPLAN,IELM)
00088 !
00089 !***********************************************************************
00090 ! BIEF   V7P0                                       21/08/2010
00091 !***********************************************************************
00092 !
00093 !
00094 !
00095 !
00096 !
00097 !
00098 !
00099 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00100 !| ELTCAR         |<--| ELEMENT CHOSEN FOR EVERY POINT
00101 !| IELM           |-->| TYPE OF ELEMENT (11: TRIANGLE, 41: PRISM...)
00102 !| IKLE           |-->| CONNECTIVITY TABLE
00103 !| ISCORE         |<->| INTEGER WORK ARRAY
00104 !| KNOLG          |-->| GLOBAL NUMBER OF POINTS IN ORIGINAL MESH
00105 !| MESH           |-->| MESH STRUCTURE
00106 !| NELEM2         |-->| NUMBER OF ELEMENTS IN 2D MESH
00107 !| NELMAX         |-->| MAXIMUM NUMBER OF ELEMENTS
00108 !| NPLAN          |-->| NUMBER OF PLANES (CASE OF A 3D MESH, OR 1 IN 2D)
00109 !| NPOIN2         |-->| NUMBER OF POINTS IN 2D MESH
00110 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00111 !
00112       USE BIEF_DEF
00113       IMPLICIT NONE
00114       INTEGER LNG,LU
00115       COMMON/INFO/LNG,LU
00116 !
00117 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00118 !
00119       INTEGER, INTENT(IN)             :: NPOIN2,NELEM2,NELMAX,NPLAN,IELM
00120       INTEGER, INTENT(IN)             :: IKLE(NELMAX,*),KNOLG(NPOIN2)
00121       INTEGER, INTENT(INOUT)          :: ELTCAR(*)
00122       INTEGER, INTENT(INOUT)          :: ISCORE(*)
00123       TYPE(BIEF_MESH), INTENT(INOUT)  :: MESH
00124 !
00125 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00126 !
00127       INTEGER I,IELEM,N1,N2,N3,N4,N5,N6,IPLAN,NP,I3D,K,IELEM3D
00128 !
00129       IF(IELM.EQ.11.OR.IELM.EQ.12.OR.IELM.EQ.41.OR.IELM.EQ.51) THEN
00130         NP=NPOIN2
00131       ELSEIF(IELM.EQ.13) THEN
00132         NP=NPOIN2+MESH%NSEG
00133       ELSE
00134         WRITE(LU,*) 'MAKE_ELTCAR NOT PROGRAMMED FOR IELM=',IELM
00135         CALL PLANTE(1)
00136         STOP
00137         RETURN
00138       ENDIF
00139 !
00140       DO I=1,NP
00141         ISCORE(I)=0
00142       ENDDO
00143 !
00144       IF(NCSIZE.LE.1) THEN
00145 !
00146 !       SIMPLE CASE: SCALAR MODE
00147 !
00148         IF(IELM.EQ.11.OR.IELM.EQ.12.OR.IELM.EQ.41.OR.IELM.EQ.51) THEN
00149 !
00150           DO IELEM = 1,NELEM2
00151             N1=IKLE(IELEM,1)
00152             N2=IKLE(IELEM,2)
00153             N3=IKLE(IELEM,3)
00154             IF(ISCORE(N1).LT.N2) THEN
00155               ISCORE(N1)=N2
00156               ELTCAR(N1)=IELEM
00157             ENDIF
00158             IF(ISCORE(N2).LT.N3) THEN
00159               ISCORE(N2)=N3
00160               ELTCAR(N2)=IELEM
00161             ENDIF
00162             IF(ISCORE(N3).LT.N1) THEN
00163               ISCORE(N3)=N1
00164               ELTCAR(N3)=IELEM
00165             ENDIF
00166           ENDDO
00167 !
00168         ELSEIF(IELM.EQ.13) THEN
00169 !
00170           DO IELEM = 1,NELEM2
00171             N1=IKLE(IELEM,1)
00172             N2=IKLE(IELEM,2)
00173             N3=IKLE(IELEM,3)
00174             N4=IKLE(IELEM,4)
00175             N5=IKLE(IELEM,5)
00176             N6=IKLE(IELEM,6)
00177             IF(ISCORE(N1).LT.N2) THEN
00178               ISCORE(N1)=N2
00179               ELTCAR(N1)=IELEM
00180             ENDIF
00181             IF(ISCORE(N2).LT.N3) THEN
00182               ISCORE(N2)=N3
00183               ELTCAR(N2)=IELEM
00184             ENDIF
00185             IF(ISCORE(N3).LT.N1) THEN
00186               ISCORE(N3)=N1
00187               ELTCAR(N3)=IELEM
00188             ENDIF
00189             IF(ISCORE(N4).LT.N2) THEN
00190               ISCORE(N4)=N2
00191               ELTCAR(N4)=IELEM
00192             ENDIF
00193             IF(ISCORE(N5).LT.N3) THEN
00194               ISCORE(N5)=N3
00195               ELTCAR(N5)=IELEM
00196             ENDIF
00197             IF(ISCORE(N6).LT.N1) THEN
00198               ISCORE(N6)=N1
00199               ELTCAR(N6)=IELEM
00200             ENDIF
00201           ENDDO
00202 !
00203         ENDIF
00204 !
00205       ELSE
00206 !
00207 !       NOW IN PARALLEL, FIRST LIKE IN SCALAR BUT WITH GLOBAL NUMBERS
00208 !
00209         IF(IELM.EQ.11.OR.IELM.EQ.12.OR.IELM.EQ.41.OR.IELM.EQ.51) THEN
00210 !
00211           DO IELEM = 1,NELEM2
00212             N1=IKLE(IELEM,1)
00213             N2=IKLE(IELEM,2)
00214             N3=IKLE(IELEM,3)
00215             IF(ISCORE(N1).LT.KNOLG(N2)) THEN
00216               ISCORE(N1)=KNOLG(N2)
00217               ELTCAR(N1)=IELEM
00218             ENDIF
00219             IF(ISCORE(N2).LT.KNOLG(N3)) THEN
00220               ISCORE(N2)=KNOLG(N3)
00221               ELTCAR(N2)=IELEM
00222             ENDIF
00223             IF(ISCORE(N3).LT.KNOLG(N1)) THEN
00224               ISCORE(N3)=KNOLG(N1)
00225               ELTCAR(N3)=IELEM
00226             ENDIF
00227           ENDDO
00228 !
00229         ELSEIF(IELM.EQ.13) THEN
00230 !
00231           DO IELEM = 1,NELEM2
00232             N1=IKLE(IELEM,1)
00233             N2=IKLE(IELEM,2)
00234             N3=IKLE(IELEM,3)
00235             N4=IKLE(IELEM,4)
00236             N5=IKLE(IELEM,5)
00237             N6=IKLE(IELEM,6)
00238             IF(ISCORE(N1).LT.KNOLG(N2)) THEN
00239               ISCORE(N1)=KNOLG(N2)
00240               ELTCAR(N1)=IELEM
00241             ENDIF
00242             IF(ISCORE(N2).LT.KNOLG(N3)) THEN
00243               ISCORE(N2)=KNOLG(N3)
00244               ELTCAR(N2)=IELEM
00245             ENDIF
00246             IF(ISCORE(N3).LT.KNOLG(N1)) THEN
00247               ISCORE(N3)=KNOLG(N1)
00248               ELTCAR(N3)=IELEM
00249             ENDIF
00250             IF(ISCORE(N4).LT.KNOLG(N2)) THEN
00251               ISCORE(N4)=KNOLG(N2)
00252               ELTCAR(N4)=IELEM
00253             ENDIF
00254             IF(ISCORE(N5).LT.KNOLG(N3)) THEN
00255               ISCORE(N5)=KNOLG(N3)
00256               ELTCAR(N5)=IELEM
00257             ENDIF
00258             IF(ISCORE(N6).LT.KNOLG(N1)) THEN
00259               ISCORE(N6)=KNOLG(N1)
00260               ELTCAR(N6)=IELEM
00261             ENDIF
00262           ENDDO
00263 !
00264         ENDIF
00265 !
00266 !       LARGEST VALUE BETWEEN NEIGHBOURING SUB-DOMAINS TAKEN
00267         CALL PARCOM2I(ISCORE,ISCORE,ISCORE,NPOIN2,1,1,1,MESH)
00268         IF(IELM.EQ.13) THEN
00269           CALL PARCOM2I_SEG(ISCORE(NPOIN2+1:NP),
00270      &                      ISCORE(NPOIN2+1:NP),
00271      &                      ISCORE(NPOIN2+1:NP),
00272      &                      MESH%NSEG,1,1,1,MESH,1,11)
00273         ENDIF
00274 !
00275         IF(IELM.EQ.11.OR.IELM.EQ.12.OR.IELM.EQ.41.OR.IELM.EQ.51) THEN
00276 !
00277           DO IELEM = 1,NELEM2
00278             N1=IKLE(IELEM,1)
00279             N2=IKLE(IELEM,2)
00280             N3=IKLE(IELEM,3)
00281             IF(ISCORE(N1).EQ.KNOLG(N2)) THEN
00282 !             THERE IS NO BETTER ELEMENT IN ANOTHER SUB-DOMAIN
00283               ISCORE(N1)=0
00284             ENDIF
00285             IF(ISCORE(N2).EQ.KNOLG(N3)) THEN
00286 !             THERE IS NO BETTER ELEMENT IN ANOTHER SUB-DOMAIN
00287               ISCORE(N2)=0
00288             ENDIF
00289             IF(ISCORE(N3).EQ.KNOLG(N1)) THEN
00290 !             THERE IS NO BETTER ELEMENT IN ANOTHER SUB-DOMAIN
00291               ISCORE(N3)=0
00292             ENDIF
00293           ENDDO
00294 !
00295         ELSEIF(IELM.EQ.13) THEN
00296 !
00297           DO IELEM = 1,NELEM2
00298             N1=IKLE(IELEM,1)
00299             N2=IKLE(IELEM,2)
00300             N3=IKLE(IELEM,3)
00301             N4=IKLE(IELEM,4)
00302             N5=IKLE(IELEM,5)
00303             N6=IKLE(IELEM,6)
00304             IF(ISCORE(N1).EQ.KNOLG(N2)) THEN
00305 !             THERE IS NO BETTER ELEMENT IN ANOTHER SUB-DOMAIN
00306               ISCORE(N1)=0
00307             ENDIF
00308             IF(ISCORE(N2).EQ.KNOLG(N3)) THEN
00309 !             THERE IS NO BETTER ELEMENT IN ANOTHER SUB-DOMAIN
00310               ISCORE(N2)=0
00311             ENDIF
00312             IF(ISCORE(N3).EQ.KNOLG(N1)) THEN
00313 !             THERE IS NO BETTER ELEMENT IN ANOTHER SUB-DOMAIN
00314               ISCORE(N3)=0
00315             ENDIF
00316             IF(ISCORE(N4).EQ.KNOLG(N2)) THEN
00317 !             THERE IS NO BETTER ELEMENT IN ANOTHER SUB-DOMAIN
00318               ISCORE(N4)=0
00319             ENDIF
00320             IF(ISCORE(N5).EQ.KNOLG(N3)) THEN
00321 !             THERE IS NO BETTER ELEMENT IN ANOTHER SUB-DOMAIN
00322               ISCORE(N5)=0
00323             ENDIF
00324             IF(ISCORE(N6).EQ.KNOLG(N1)) THEN
00325 !             THERE IS NO BETTER ELEMENT IN ANOTHER SUB-DOMAIN
00326               ISCORE(N6)=0
00327             ENDIF
00328           ENDDO
00329 !
00330         ENDIF
00331 !
00332 !       IF A POINT HAS A BETTER ELEMENT IN ANOTHER SUB-DOMAIN
00333         DO I=1,NP
00334           IF(ISCORE(I).NE.0) THEN
00335             ELTCAR(I)=0
00336           ENDIF
00337         ENDDO
00338 !
00339       ENDIF
00340 !
00341 !-----------------------------------------------------------------------
00342 !
00343 !     COMPLETING FOR QUASI-BUBBLE
00344 !
00345       IF(IELM.EQ.12) THEN
00346         DO IELEM=1,NELEM2
00347           ELTCAR(NPOIN2+IELEM)=IELEM
00348         ENDDO
00349       ENDIF
00350 !
00351 !     COMPLETING FOR 3D PRISMS
00352 !
00353       IF(NPLAN.GT.1) THEN
00354         IF(IELM.EQ.41) THEN
00355           DO IPLAN=2,NPLAN
00356             DO I=1,NPOIN2
00357 !             ACCORDING TO POINT AND ELEMENT NUMBERING IN PRISMS
00358               I3D=I+(IPLAN-1)*NPOIN2
00359               IF(ELTCAR(I).GT.0) THEN
00360                 ELTCAR(I3D)=ELTCAR(I)+(IPLAN-1)*NELEM2
00361               ELSE
00362                 ELTCAR(I3D)=0
00363               ENDIF
00364             ENDDO
00365           ENDDO
00366         ELSEIF(IELM.EQ.51) THEN
00367           DO IPLAN=2,NPLAN
00368             DO I=1,NPOIN2
00369               I3D=I+(IPLAN-1)*NPOIN2
00370               IF(ELTCAR(I).GT.0) THEN
00371 !               3 TETRAHEDRA POSSIBLE CANDIDATES
00372                 DO K=1,3
00373 !                 SEE ELEMENT NUMBERING IN PRISMS CUT INTO TETRAHEDRA
00374                   IELEM3D=(IPLAN-2)*3*NELEM2+(K-1)*NELEM2+ELTCAR(I)
00375 !                 THIS MAY HIT SEVERAL TIMES AS A POINT MAY BELONG
00376 !                 TO MORE THAN ONE TETRAHEDRON AT THIS LEVEL,
00377 !                 THE LAST HIT IS KEPT, SAME BEHAVIOUR IN SCALAR OR
00378 !                 PARALLEL. NOT VERY ELEGANT, BETTER IDEA ?
00379                   IF(IKLE(IELEM3D,1).EQ.I3D) THEN
00380                     ELTCAR(I3D)=IELEM3D
00381                   ELSEIF(IKLE(IELEM3D,2).EQ.I3D) THEN
00382                     ELTCAR(I3D)=IELEM3D
00383                   ELSEIF(IKLE(IELEM3D,3).EQ.I3D) THEN
00384                     ELTCAR(I3D)=IELEM3D
00385                   ELSEIF(IKLE(IELEM3D,4).EQ.I3D) THEN
00386                     ELTCAR(I3D)=IELEM3D
00387                   ENDIF
00388                 ENDDO
00389               ELSE
00390                 ELTCAR(I3D)=0
00391               ENDIF
00392             ENDDO
00393           ENDDO
00394         ENDIF
00395       ENDIF
00396 !
00397 !-----------------------------------------------------------------------
00398 !
00399       RETURN
00400       END

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