inbief.f

Go to the documentation of this file.
00001 C:\opentelemac\v7p0\sources\utils\bief\inbief.f
00002 !
00098                      SUBROUTINE INBIEF
00099 !                    *****************
00100 !
00101      &(LIHBOR,KLOG,IT1,IT2,IT3,LVMAC,IELMX,
00102      & LAMBD0,SPHERI,MESH,T1,T2,OPTASS,PRODUC,EQUA,MESH2D)
00103 !
00104 !***********************************************************************
00105 ! BIEF   V7P0                                   28/03/2014
00106 !***********************************************************************
00107 !
00108 !
00109 !
00110 !
00111 !
00112 !
00113 !
00114 !
00115 !
00116 !
00117 !
00118 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00119 !| EQUA           |-->| IDENTIFICATION OF PROGRAM OR EQUATIONS SOLVED
00120 !| IELMX          |-->| THE MORE COMPLEX ELEMENT USED (FOR MEMORY)
00121 !| IT1            |<->| INTEGER WORK ARRAY IN A BIEF_OBJ STRUCTURE
00122 !| IT2            |<->| INTEGER WORK ARRAY IN A BIEF_OBJ STRUCTURE
00123 !| IT3            |<->| INTEGER WORK ARRAY IN A BIEF_OBJ STRUCTURE
00124 !| KLOG           |-->| CONVENTION FOR SOLID BOUNDARY
00125 !| LAMBD0         |-->| LATITUDE OF ORIGIN POINT (SPHERICAL COORDINATES)
00126 !| LIHBOR         |-->| TYPES OF BOUNDARY CONDITIONS ON DEPTH
00127 !| LVMAC          |-->| VECTOR LENGTH (IF VECTOR MACHINE)
00128 !| MESH           |-->| MESH STRUCTURE
00129 !| MESH2D         |-->| UNDERLYING 2D MESH (FOR PRISMS AND PRISMS SPLIT
00130 !|                |   | INTO TETRAHEDRONS)
00131 !| OPTASS         |-->| OPTION FOR MATRIX STORAGE.
00132 !| PRODUC         |-->| OPTION FOR MATRIX x VECTOR PRODUCT.
00133 !| SPHERI         |-->| LOGICAL, IF YES : SPHERICAL COORDINATES.
00134 !| T1             |<->| WORK BIEF_OBJ STRUCTURE
00135 !| T2             |<->| WORK BIEF_OBJ STRUCTURE
00136 !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
00137 !
00138       USE BIEF, EX_INBIEF => INBIEF
00139       USE DECLARATIONS_TELEMAC, ONLY : MODASS
00140 !
00141       IMPLICIT NONE
00142       INTEGER LNG,LU
00143       COMMON/INFO/LNG,LU
00144 !
00145 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00146 !
00147       INTEGER, INTENT(IN)            :: IELMX,OPTASS,PRODUC,KLOG,LVMAC
00148       INTEGER, INTENT(IN)            :: LIHBOR(*)
00149       DOUBLE PRECISION, INTENT(IN)   :: LAMBD0
00150       LOGICAL, INTENT(IN)            :: SPHERI
00151       CHARACTER(LEN=20)              :: EQUA
00152       TYPE(BIEF_MESH), INTENT(INOUT) :: MESH
00153       TYPE(BIEF_OBJ), INTENT(INOUT)  :: T1,T2,IT1,IT2,IT3
00154       TYPE(BIEF_MESH), INTENT(INOUT), OPTIONAL :: MESH2D
00155 !
00156 !+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+-+
00157 !
00158       INTEGER I,IELEM,NELEM,NELMAX,NPTFR,NPOIN,IELM,IPLAN,I3D
00159       INTEGER MXPTVS,NPLAN
00160       INTEGER LV,NDP,IDP,I1,I2,I3,NPOIN2
00161       INTEGER NPTFR2,NELEM2,NELMAX2,NELEB2,NELEB
00162 !
00163       DOUBLE PRECISION Z(1),X2,X3,Y2,Y3
00164 !
00165 !-----------------------------------------------------------------------
00166 !     FOR CALL TO VOISIN31
00167       INTEGER IKLESTR(1,3)
00168 !
00169 !     DEPLOYMENT OF THE DATA STRUCTURE
00170 !
00171       NELEM = MESH%NELEM
00172       NELMAX= MESH%NELMAX
00173       NPOIN = MESH%NPOIN
00174       IELM  = MESH%X%ELM
00175       NDP   = BIEF_NBPEL(IELM,MESH)
00176       NPTFR = MESH%NPTFR
00177       NELEB = MESH%NELEB
00178 !
00179 !     WITH PRISMS, DIFFERENT FROM 2D VALUES, OTHERWISE
00180 !
00181       IF(IELM.EQ.41.OR.IELM.EQ.51) THEN
00182         NPOIN2  =BIEF_NBPTS(11,MESH)
00183         NELEM2  =BIEF_NBPTS(10,MESH)
00184         NELMAX2 =BIEF_NBMPTS(10,MESH)
00185         NPTFR2  =BIEF_NBPTS(1,MESH)
00186         NPLAN   =NPOIN/NPOIN2
00187       ELSEIF(IELM.EQ.11.OR.IELM.EQ.31) THEN
00188         NPOIN2  =NPOIN
00189         NELEM2  =NELEM
00190         NELMAX2 =NELMAX
00191         NPTFR2  =NPTFR
00192         NELEB2  =NELEB
00193         NPLAN   =1
00194       ELSE
00195         WRITE(LU,*) 'UNEXPECTED ELEMENT IN INBIEF:',IELM
00196         CALL PLANTE(1)
00197         STOP
00198       ENDIF
00199 !
00200 !     FINITE ELEMENT ASSEMBLY WITH I8 INTEGERS
00201 !
00202       IF(MODASS.EQ.2) THEN
00203         ALLOCATE(MESH%WI8(NELMAX*NDP))
00204         ALLOCATE(MESH%TI8(NPOIN))
00205       ENDIF
00206 !
00207 !     PARALLEL MODE : INITIALISES THE ARRAYS NHP,NHM
00208 !                        INDPU,FAC, ETC.
00209 !
00210 !
00211       IF(NCSIZE.GT.1) THEN
00212 !
00213         CALL PARINI(MESH%NHP%I,MESH%NHM%I,MESH%INDPU%I,MESH%FAC,
00214      &              NPOIN2,MESH%NACHB%I,NPLAN,MESH,
00215      &              MESH%NB_NEIGHB,MESH%NB_NEIGHB_SEG,
00216      &              NELEM2,MESH%IFAPAR%I)
00217 !
00218 !       PRISMS: COMPLEMENTS FAC
00219         IF(IELM.EQ.41.OR.IELM.EQ.51) THEN
00220           DO I = 2,NPLAN
00221             CALL OV_2('X=Y     ',MESH%FAC%R,I,MESH%FAC%R,1,
00222      &                           MESH%FAC%R,1,0.D0,NPOIN2,NPOIN2)
00223           ENDDO
00224         ENDIF
00225 !
00226       ELSE
00227 !       THESE STUCTURES ARE ALLOCATED IN PARINI
00228         CALL BIEF_ALLVEC(2,MESH%NB_NEIGHB_PT,'NBNGPT',0,1,0,MESH)
00229         CALL BIEF_ALLVEC(2,MESH%LIST_SEND   ,'LSSEND',0,1,0,MESH)
00230         CALL BIEF_ALLVEC(2,MESH%NH_COM      ,'NH_COM',0,1,0,MESH)
00231         CALL BIEF_ALLVEC(2,MESH%NB_NEIGHB_PT_SEG,'NBNGSG',0,1,0,MESH)
00232         CALL BIEF_ALLVEC(2,MESH%LIST_SEND_SEG,'LSSESG',0,1,0,MESH)
00233         CALL BIEF_ALLVEC(2,MESH%NH_COM_SEG  ,'NH_CSG',0,1,0,MESH)
00234         CALL BIEF_ALLVEC(1,MESH%BUF_SEND    ,'BUSEND',0,1,0,MESH)
00235         CALL BIEF_ALLVEC(1,MESH%BUF_RECV    ,'BURECV',0,1,0,MESH)
00236 !
00237       ENDIF
00238 !
00239 !-----------------------------------------------------------------------
00240 !
00241 !     COMPUTES THE NEIGHBOURS OF THE BOUNDARY FACES (TRIANGULAR MESH)
00242 !
00243 !     NOTE: SEE CPIKLE2 AND CPIKLE3 IN 3D. IKLE CAN HERE BE 3D BECAUSE
00244 !           THE BEGINNING OF IKLE IN 3D IS THE SAME AS THAT IN 2D (THE
00245 !           FIRST 3 POINTS OF THE PRISMS OR TETRAHEDRONS CORRESPOND
00246 !           TO THE 3 POINTS OF THE BOTTOM TRIANGLES)
00247 !
00248 !
00249       IF(IELM.EQ.11.OR.IELM.EQ.41.OR.IELM.EQ.51) THEN
00250         CALL VOISIN(MESH%IFABOR%I,NELEM2,NELMAX2,IELM,MESH%IKLE%I,
00251      &              MESH%IKLE%DIM1,
00252      &              NPOIN2,MESH%NACHB%I,MESH%NBOR%I,NPTFR2,IT1%I,IT2%I)
00253 !
00254       ELSEIF(IELM.NE.31) THEN
00255         WRITE(LU,*) 'UNEXPECTED ELEMENT IN INBIEF:',IELM
00256         CALL PLANTE(1)
00257         STOP
00258       ENDIF
00259 !
00260 !-----------------------------------------------------------------------
00261 !
00262       IF(IELM.EQ.11.OR.IELM.EQ.41.OR.IELM.EQ.51) THEN
00263 !
00264 !       CASES WITH A FIRST CALL IN 2D
00265 !
00266         MXPTVS = MESH%MXPTVS
00267 !       HERE IFABOR FOR IELM=51 MUST STILL BE 2D
00268 !       SO VOISIN31 CALLED LATER
00269 !
00270 !       NOTE: IN 3D IKLBOR BUILT HERE WITH NELEB 2D AND NELEBX 3D.
00271 !
00272         CALL ELEBD(MESH%NELBOR%I,MESH%NULONE%I,MESH%KP1BOR%I,
00273      &             MESH%IFABOR%I,MESH%NBOR%I,MESH%IKLE%I,MESH%IKLE%DIM1,
00274      &             MESH%IKLBOR%I,NELEM2,NELMAX2,NPOIN2,NPTFR2,IELM,
00275      &             LIHBOR,KLOG,MESH%IFANUM%I,OPTASS,MESH%ISEG%I,
00276      &             IT1%I,IT2%I,IT3%I,MESH%NELEBX,MESH%NELEB)
00277 !
00278       ENDIF
00279 !
00280 !     3D CASES
00281 !
00282       IF(IELM.EQ.31) THEN
00283 !
00284 !       BUILDING ARRAYS FOR TETRAHEDRONS
00285 !
00286         CALL VOISIN31(MESH%IFABOR%I,NELEM,NELMAX,IELM,MESH%IKLE%I,
00287      &                MESH%IKLE%DIM1,NPOIN,MESH%NBOR%I,NPTFR,
00288      &                LIHBOR,KLOG,MESH%INDPU%I,IKLESTR,NELEB2)
00289 !
00290         CALL ELEBD31(MESH%NELBOR%I,MESH%NULONE%I,MESH%IKLBOR%I,
00291      &               MESH%IFABOR%I,MESH%NBOR%I,MESH%IKLE%I,
00292      &               NELEM,NELEB,NELMAX,NPOIN,NPTFR,IELM)
00293 !
00294       ELSEIF(IELM.EQ.41) THEN
00295 !
00296 !       COMPLETES ARRAYS FOR PRISMS
00297 !
00298         CALL ELEB3D(MESH%IKLE%I,MESH%NBOR%I,
00299      &              MESH%NELBOR%I,MESH%IKLBOR%I,
00300      &              MESH%NELEB,MESH%NELEBX,
00301      &              MESH%NULONE%I,NELEM2,NPOIN2,NPLAN,NPLAN-1,NPTFR2)
00302 !
00303       ELSEIF(IELM.EQ.51) THEN
00304 !
00305 !       COMPLETES ARRAYS FOR PRISMS SPLIT INTO TETRAHEDRONS
00306 !
00307         IF(PRESENT(MESH2D)) THEN
00308 !         NOTE THE USE OF MESH2D FOR NELBOR AND NULONE
00309 !         THIS IS FOR CALLING STOSEG
00310           CALL ELEB3DT(MESH%IKLE%I,MESH%NBOR%I,MESH%NELBOR%I,
00311      &                 MESH2D%NELBOR%I,MESH%IKLBOR%I,
00312      &                 MESH%NELEB,MESH%NELEBX,MESH%NULONE%I,NELEM2,
00313      &                 NPOIN2,NPLAN,NPLAN-1,NPTFR2,
00314      &                 MESH2D%IKLBOR%I,MESH2D%NELEB,MESH2D%NELEBX)
00315         ELSE
00316           WRITE(LU,*) 'ARGUMENT MESH2D SHOULD BE ADDED TO INBIEF'
00317           WRITE(LU,*) 'FOR A CALL WITH IELM=51'
00318           CALL PLANTE(1)
00319           STOP
00320         ENDIF
00321 !
00322       ELSEIF(IELM.NE.11) THEN
00323 !
00324         WRITE(LU,*) 'INBIEF UNEXPECTED ELEMENT: ',IELM
00325         CALL PLANTE(1)
00326         STOP
00327 !
00328       ENDIF
00329 !
00330 !-----------------------------------------------------------------------
00331 !
00332 ! LOOKS FOR VECTORISATION POSSIBILITIES
00333 !
00334       IF(IELM.EQ.11) THEN
00335 !
00336       IF(LVMAC.NE.1) THEN
00337         IF(LNG.EQ.1) WRITE(LU,200) LVMAC
00338         IF(LNG.EQ.2) WRITE(LU,201) LVMAC
00339 200     FORMAT(1X,'INBIEF (BIEF) : MACHINE VECTORIELLE',/,1X,
00340      &  'AVEC LONGUEUR DE VECTEUR :',1I6,
00341      &  ' (SELON VOS DONNEES OU DANS LE DICTIONNAIRE DES MOTS-CLES)')
00342 201     FORMAT(1X,'INBIEF (BIEF): VECTOR MACHINE',/,1X,
00343      &  'WITH VECTOR LENGTH :',1I6,
00344      &  ' (ACCORDING TO YOUR DATA OR IN THE DICTIONNARY OF KEY-WORDS)')
00345         CALL VECLEN(LV,NDP,MESH%IKLE%I,NELEM,NELMAX,NPOIN,T1%R)
00346         IF(LV.LT.LVMAC) THEN
00347           IF(LNG.EQ.1) WRITE(LU,300) LV
00348           IF(LNG.EQ.2) WRITE(LU,301) LV
00349 300       FORMAT(1X,'LONGUEUR LIMITEE A ',1I4,
00350 ' PAR LA NUMEROTATION DES     &ELEMENTS (VOIR LA DOCUMENTATION DE STBTEL)')
00351 301       FORMAT(1X,'THIS LENGTH IS REDUCED TO ',1I4,
00352 ' BY THE NUMBERING     &OF THE ELEMENTS (SEE STBTEL DOCUMENTATION)')
00353         ENDIF
00354       ELSE
00355         LV = 1
00356         IF(LNG.EQ.1) WRITE(LU,400)
00357         IF(LNG.EQ.2) WRITE(LU,401)
00358 400     FORMAT(1X,'INBIEF (BIEF) : MACHINE NON VECTORIELLE',
00359      &                                           ' (SELON VOS DONNEES)')
00360 401     FORMAT(1X,'INBIEF (BIEF): NOT A VECTOR MACHINE',
00361      &                                      ' (ACCORDING TO YOUR DATA)')
00362       ENDIF
00363 !
00364       MESH%LV = LV
00365 !
00366       ENDIF
00367 !
00368 !-----------------------------------------------------------------------
00369 !
00370 !     MERCATOR PROJECTION (TRIANGLES AND PRISMS ONLY)
00371 !
00372       IF(SPHERI.AND.IELM.NE.11.AND.IELM.NE.41) THEN
00373         IF(LNG.EQ.1) WRITE(LU,398)
00374         IF(LNG.EQ.2) WRITE(LU,399)
00375 398     FORMAT(1X,'INBIEF (BIEF) : ELEMENT NON PROGRAMME',/,1X,
00376      &            'EN PROJECTION DE MERCATOR : ',1I3)
00377 399     FORMAT(1X,'INBIEF (BIEF) : ELEMENT NOT IMPLEMENTED WITH',/,1X,
00378      &            'MERCATOR PROJECTION:',1I3)
00379         CALL PLANTE(1)
00380         STOP
00381       ENDIF
00382 !
00383       IF(SPHERI) THEN
00384 !
00385         CALL LATITU(MESH%COSLAT%R,MESH%SINLAT%R,LAMBD0,MESH%Y%R,NPOIN2)
00386         CALL CORLAT
00387         CALL CPSTVC(MESH%X,T1)
00388         CALL CPSTVC(MESH%Y,T2)
00389 !
00390         IF(IELM.EQ.11.OR.IELM.EQ.41) THEN
00391           DO I=1,NPOIN2
00392             T1%R(I)=MESH%X%R(I)*MESH%COSLAT%R(I)
00393             T2%R(I)=MESH%Y%R(I)*MESH%COSLAT%R(I)
00394           ENDDO
00395         ENDIF
00396 !       COMPLETING UPPER LAYERS FOR 3D MESHES
00397         IF(IELM.EQ.41) THEN
00398           DO IPLAN=2,NPLAN
00399             DO I=1,NPOIN2
00400               I3D=(IPLAN-1)*NPOIN2+I
00401               T1%R(I3D)=MESH%X%R(I3D)*MESH%COSLAT%R(I)
00402               T2%R(I3D)=MESH%Y%R(I3D)*MESH%COSLAT%R(I)
00403             ENDDO
00404           ENDDO
00405         ENDIF
00406 !
00407 !       CONVERTS TO COORDINATES BY ELEMENTS (STARTING WITH X AND Y)
00408         CALL PTTOEL(MESH%XEL,T1,MESH)
00409         CALL PTTOEL(MESH%YEL,T2,MESH)
00410 !
00411       ELSE
00412 !
00413 !       NOTE: IN 3D MESH%X AND MESH%Y FULLY BUILT IN ALMESH
00414 !
00415 !       CONVERTS TO COORDINATES BY ELEMENTS (STARTING WITH X AND Y)
00416 !
00417         CALL PTTOEL(MESH%XEL,MESH%X,MESH)
00418         CALL PTTOEL(MESH%YEL,MESH%Y,MESH)
00419 !
00420       ENDIF
00421 !
00422 !-----------------------------------------------------------------------
00423 !
00424 !     CONVERTS TO A LOCAL SYSTEM IN X AND Y, WITH POINT 1 AT ORIGIN
00425 !
00426       DO IDP=2,NDP
00427         CALL OV_2('X=X-Y   ',MESH%XEL%R,IDP,
00428      &                       MESH%XEL%R,1  ,
00429      &                       MESH%XEL%R,1  , 0.D0 , NELMAX , NELEM )
00430         CALL OV_2('X=X-Y   ',MESH%YEL%R,IDP,
00431      &                       MESH%YEL%R,1  ,
00432      &                       MESH%YEL%R,1  , 0.D0 , NELMAX , NELEM )
00433       ENDDO
00434 !
00435       CALL OV('X=C     ', MESH%XEL%R , Z , Z , 0.D0 , NELEM )
00436       CALL OV('X=C     ', MESH%YEL%R , Z , Z , 0.D0 , NELEM )
00437 !
00438 !     IF DONE FOR Z (BUT IN MOVING MESHES SHOULD NOT BE USED !!!!)
00439 !
00440 !     IF(MESH%DIM.EQ.3) THEN
00441 !       CALL PTTOEL(MESH%ZEL,MESH%Z,MESH)
00442 !       DO IDP=2,NDP
00443 !         CALL OV_2('X=X-Y   ',MESH%ZEL%R,IDP,
00444 !    &                         MESH%ZEL%R,1  ,
00445 !    &                         MESH%ZEL%R,1  , 0.D0 , NELMAX , NELEM )
00446 !       ENDDO
00447 !       CALL OV('X=C     ', MESH%ZEL%R , Z , Z , 0.D0 , NELEM )
00448 !     ENDIF
00449 !
00450 !-----------------------------------------------------------------------
00451 !
00452 ! COMPUTES THE GEOMETRICAL COEFFICIENTS FOR EACH ELEMENT
00453 !
00454       IF(IELM.EQ.11) THEN
00455 !
00456         CALL GEOELT(MESH%SURDET%R,MESH%SURFAC%R,
00457      &              MESH%XEL%R   ,MESH%YEL%R   ,NELEM,NELMAX,IELM)
00458 !
00459 ! FOR THE TIME BEING, SURDET IS ONLY USED BY CARACT, WHICH DOES NOT
00460 ! WORK ON THE MESH IN SPHERICAL COORDINATES.
00461 ! ERASES SURDET COMPUTED BY GEOELE FROM XEL AND YEL
00462 !
00463         IF(SPHERI) THEN
00464 !
00465           DO IELEM = 1 , NELEM
00466             I1 = MESH%IKLE%I(IELEM)
00467             I2 = MESH%IKLE%I(IELEM+NELMAX)
00468             I3 = MESH%IKLE%I(IELEM+2*NELMAX)
00469             X2 = - MESH%X%R(I1) + MESH%X%R(I2)
00470             X3 = - MESH%X%R(I1) + MESH%X%R(I3)
00471             Y2 = - MESH%Y%R(I1) + MESH%Y%R(I2)
00472             Y3 = - MESH%Y%R(I1) + MESH%Y%R(I3)
00473             MESH%SURDET%R(IELEM) = 1.D0 / (X2*Y3 - X3*Y2)
00474           ENDDO
00475 !
00476         ENDIF
00477 !
00478       ELSEIF(IELM.EQ.41.OR.IELM.EQ.51.OR.IELM.EQ.31) THEN
00479 !
00480 !       FOR PRISMS, SURFAC IS THE SURFACE OF THE TRIANGLES
00481 !       FOR ELEMENTS 51 AND 31 ???????? SHOULD NOT BE USED...
00482 !
00483         DO IELEM = 1 , NELEM
00484           X2 = MESH%XEL%R(IELEM+NELMAX)
00485           X3 = MESH%XEL%R(IELEM+2*NELMAX)
00486           Y2 = MESH%YEL%R(IELEM+NELMAX)
00487           Y3 = MESH%YEL%R(IELEM+2*NELMAX)
00488           MESH%SURFAC%R(IELEM) = 0.5D0 * (X2*Y3 - X3*Y2)
00489         ENDDO
00490 !
00491       ELSE
00492         WRITE(LU,*) 'UNEXPECTED ELEMENT IN INBIEF:',IELM
00493         CALL PLANTE(1)
00494         STOP
00495       ENDIF
00496 !
00497 !-----------------------------------------------------------------------
00498 !
00499 ! DEFINES THE OUTGOING NORMALS AT THE BOUNDARIES
00500 !         AND THE DISTANCES TO THE BOUNDARY
00501 !
00502       IF(IELM.EQ.11) THEN
00503 !
00504       CALL NORMAB(MESH%XNEBOR%R,MESH%YNEBOR%R,
00505      &            MESH%XSGBOR%R,MESH%YSGBOR%R,
00506      &            MESH%DISBOR%R,MESH%SURFAC%R,NELMAX,MESH%NELBOR%I,
00507      &            MESH%NULONE%I,MESH%LGSEG%R,NPTFR,MESH,T1,
00508      &            MESH%XEL%R,MESH%YEL%R,MESH%IKLBOR%I,
00509      &            MESH%NELEBX,MESH%NELEB)
00510 !
00511       ENDIF
00512 !
00513 !-----------------------------------------------------------------------
00514 !
00515 !  DATA STRUCTURE FOR EDGE-BASED STORAGE (FROM 5.9 ON ALWAYS DONE IN 2D)
00516 !                                        (FROM 6.2 ON ALWAYS DONE IN 3D)
00517 !  SEE CALL TO COMP_SEG BELOW TO COMPLETE THE STRUCTURE
00518 !
00519       IF(IELM.EQ.11) THEN
00520 !
00521       CALL STOSEG(MESH%IFABOR%I,NELEM,NELMAX,NELMAX,IELMX,MESH%IKLE%I,
00522      &            MESH%NBOR%I,NPTFR,MESH%GLOSEG%I,MESH%GLOSEG%MAXDIM1,
00523      &            MESH%ELTSEG%I,MESH%ORISEG%I,MESH%NSEG,
00524      &            MESH%NELBOR%I,MESH%NULONE%I,
00525      &            MESH%KNOLG%I,MESH%IKLBOR%I,MESH%NELEBX,MESH%NELEB)
00526 !
00527       ELSEIF(IELM.EQ.41) THEN
00528 !
00529       CALL STOSEG41(MESH%IFABOR%I,NELMAX,IELMX,MESH%IKLE%I,MESH%NBOR%I,
00530      &              MESH%GLOSEG%I,MESH%GLOSEG%MAXDIM1,
00531      &              MESH%ELTSEG%I,MESH%ORISEG%I,
00532      &              MESH%NELBOR%I,MESH%NULONE%I,
00533      &              NELMAX2,NELEM2,NPTFR2,NPOIN2,NPLAN,MESH%KNOLG%I,
00534      &              BIEF_NBSEG(11,MESH),
00535      &              MESH%IKLBOR%I,MESH%NELEBX,MESH%NELEB)
00536 !
00537       ELSEIF(IELM.EQ.51) THEN
00538 !
00539       IF(PRESENT(MESH2D)) THEN
00540 !       NOTE THE USE OF MESH2D FOR NELBOR AND NULONE
00541 !       THIS IS FOR CALLING STOSEG
00542         CALL STOSEG51(MESH%IFABOR%I,NELMAX,IELMX,
00543      &                MESH%IKLE%I,MESH%NBOR%I,
00544      &                MESH%GLOSEG%I,MESH%GLOSEG%MAXDIM1,
00545      &                MESH%ELTSEG%I,MESH%ORISEG%I,
00546      &                MESH2D%NELBOR%I,MESH2D%NULONE%I,
00547      &                NELMAX2,NELEM2,NPTFR2,NPOIN2,NPLAN,MESH%KNOLG%I,
00548      &                MESH2D%NSEG,MESH2D%IKLBOR%I,MESH2D%NELEB,
00549      &                MESH2D%NELEBX)
00550       ELSE
00551         WRITE(LU,*) 'ARGUMENT MESH2D SHOULD BE ADDED TO INBIEF'
00552         WRITE(LU,*) 'FOR A CALL WITH IELM=51'
00553         CALL PLANTE(1)
00554         STOP
00555       ENDIF
00556 !
00557       ELSE
00558 !
00559         WRITE(LU,*) 'ELEMENT ',IELM,' NOT IMPLEMENTED FOR SEGMENTS'
00560         CALL PLANTE(1)
00561         STOP
00562 !
00563       ENDIF
00564 !
00565 !     NOW THE 3D VALUE OF IFABOR IS BUILT FOR PRISMS CUT INTO
00566 !     TETRAHEDRA (UP TO STOSEG51 A 2D VALUE WAS USED)
00567 !
00568       IF(IELM.EQ.51) THEN
00569         CALL VOISIN31(MESH%IFABOR%I,NELEM,NELMAX,IELM,MESH%IKLE%I,
00570      &                MESH%IKLE%DIM1,NPOIN,MESH%NBOR%I,NPTFR,
00571      &                LIHBOR,KLOG,MESH%INDPU%I,IKLESTR,1)
00572       ENDIF
00573 !
00574 !-----------------------------------------------------------------------
00575 !
00576       IF(NCSIZE.GT.1.AND.IELM.EQ.11) THEN
00577 !
00578 !       COMPLETES NH_COM_SEG WITH SEGMENT NUMBERS ONCE ELTSEG IS KNOWN
00579 !
00580         CALL COMP_NH_COM_SEG(MESH%ELTSEG%I,NELEM,MESH%NH_COM_SEG%I,
00581      &                       MESH%NH_COM_SEG%DIM1,MESH%NB_NEIGHB_SEG,
00582      &                       MESH%NB_NEIGHB_PT_SEG%I,
00583      &                       MESH%GLOSEG%I,MESH%GLOSEG%DIM1,
00584      &                       MESH%KNOLG%I,NPOIN)
00585 !
00586 !       COMPLETES FAC ONCE IFABOR AND ELTSEG ARE KNOWN
00587 !
00588         IF(IELM.EQ.11.AND.IELMX.EQ.13) THEN
00589           CALL COMP_FAC(MESH%ELTSEG%I,MESH%IFABOR%I,NELEM,
00590      &                  NPOIN,MESH%FAC)
00591         ENDIF
00592 !
00593       ENDIF
00594 !
00595 !-----------------------------------------------------------------------
00596 !
00597 !  DATA STRUCTURE FOR EDGE-BASED STORAGE
00598 !
00599       IF(IELM.EQ.11.AND.PRODUC.EQ.2) THEN
00600 !
00601       CALL FROPRO(MESH%NBOR%I,MESH%IKLE%I,
00602      &            NELEM,NELMAX,NPOIN,MESH%NPMAX,NPTFR,IELM,
00603      &            MESH%IKLEM1%I,MESH%LIMVOI%I,OPTASS,PRODUC,MXPTVS,
00604      &            IT1%I,MESH%GLOSEG%I,MESH%GLOSEG%DIM1,MESH%NSEG)
00605 !
00606       ENDIF
00607 !
00608 !-----------------------------------------------------------------------
00609 !
00610 !  COMPLEMENTS IKLE AND NBOR BEYOND LINEAR ELEMENTS
00611 !
00612       IF(IELM.EQ.11.AND.IELM.NE.IELMX) THEN
00613         IF(MESH%IKLE%DIM2.NE.BIEF_NBPEL(IELMX,MESH)) THEN
00614           IF(LNG.EQ.1) WRITE(LU,100) IELMX
00615           IF(LNG.EQ.2) WRITE(LU,101) IELMX
00616 100       FORMAT(1X,'INBIEF (BIEF) : IKLE MAL DIMENSIONNE',/,1X,
00617      &              'POUR UN ELEMENT DE TYPE :',1I6)
00618 101       FORMAT(1X,'INBIEF (BIEF): WRONG DIMENSION OF IKLE',/,1X,
00619      &              'FOR AN ELEMENT WITH TYPE :',1I6)
00620           CALL PLANTE(1)
00621           STOP
00622         ENDIF
00623         CALL COMP_IKLE(MESH%IKLE%I,MESH%IKLBOR%I,
00624      &                 MESH%ELTSEG%I,MESH%NBOR%I,MESH%NELBOR%I,
00625      &                 MESH%NULONE%I,IELMX,NELEM,NELMAX,NPOIN,NPTFR,
00626      &                 MESH%NELEB,MESH%NELEBX)
00627       ENDIF
00628 !
00629 !-----------------------------------------------------------------------
00630 !
00631 ! COMPLEMENTS THE SEGMENT STRUCTURE BEYOND THE LINEAR ELEMENTS
00632 !
00633       IF(IELM.NE.IELMX) THEN
00634         CALL COMP_SEG(NELEM,NELMAX,IELMX,MESH%IKLE%I,MESH%GLOSEG%I,
00635      &                MESH%GLOSEG%MAXDIM1,MESH%ELTSEG%I,MESH%ORISEG%I,
00636      &                MESH%NSEG)
00637       ENDIF
00638 !
00639 !-----------------------------------------------------------------------
00640 !
00641 !     V6P3 FOR NEW DATA STRUCTURE OF FINITE VOLUMES
00642 !     COMPUTE THE COORDINATES OF CENTRE OF GRAVITY FOR ELEMENTS RIGHT AND
00643 !     LEFT OF EDGES
00644 !
00645       IF(EQUA(1:15).EQ.'SAINT-VENANT VF') THEN
00646 !
00647         CALL CENTRE_MASS_SEG(MESH%X%R,MESH%Y%R,MESH%COORDG%R,
00648      &                       MESH%IKLE%I,NPOIN,MESH%ELTSEG%I,
00649      &                       MESH%ORISEG%I,NELEM,MESH%NSEG,
00650      &                       MESH%JMI%I,MESH%CMI%R,MESH%GLOSEG%I,
00651      &                       MESH%IFABOR%I,MESH)
00652 !
00653       ENDIF
00654 !
00655 !-----------------------------------------------------------------------
00656 !
00657 ! COMPLEMENTS THE DATA STRUCTURE FOR FINITE VOLUMES
00658 !
00659       IF(EQUA(1:15).EQ.'SAINT-VENANT VF') THEN
00660 !
00661         CALL INFCEL(MESH%X%R,MESH%Y%R,
00662      &              MESH%NUBO%I,MESH%VNOIN%R,NPOIN,
00663      &              NELEM,MESH%NSEG,MESH%CMI%R,
00664      &              MESH%AIRST%R,MESH%GLOSEG%I,
00665      &              MESH%COORDG%R,MESH%ELTSEG%I,
00666      &              MESH%ORISEG%I,MESH%IFABOR%I)
00667 !
00668 !       COMPUTES THE SURFACE OF THE CELLS
00669 !
00670         CALL VECTOR(T1,'=','MASBAS          ',11,
00671      &              1.D0,T2,T2,T2,T2,T2,T2,MESH,.FALSE.,T2)
00672         IF(NCSIZE.GT.1) CALL PARCOM(T1,2,MESH)
00673 !
00674 !       COMPUTES THE LOCAL SPACE STEP PER CELL
00675 !
00676         CALL HLOC(NPOIN,MESH%NSEG,NELEM,MESH%NUBO%I,MESH%VNOIN%R,T1%R,
00677      &            MESH%DTHAUT%R,MESH,MESH%ELTSEG%I,MESH%IFABOR%I)
00678 !
00679 !       COMPUTES THE GRADIENTS OF THE BASE FUNCTIONS
00680 !
00681         CALL GRADP(NPOIN,MESH%NELMAX,MESH%IKLE%I,MESH%SURFAC%R,
00682      &               MESH%X%R,MESH%Y%R,MESH%DPX%R,MESH%DPY%R)
00683 !
00684       ENDIF
00685 !
00686 !-----------------------------------------------------------------------
00687 !
00688 ! COMPUTES THE STARTING ELEMENT FOR THE METHOD OF CHARACTERISTICS
00689 !
00690       CALL MAKE_ELTCAR(MESH%ELTCAR%I,MESH%IKLE%I,NPOIN2,NELEM2,
00691      &                 NELMAX,MESH%KNOLG%I,IT1%I,MESH,NPLAN,IELMX)
00692 !
00693 !-----------------------------------------------------------------------
00694 !
00695       RETURN
00696       END

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