Sources Esope | Cast3M

crbar1
C CRBAR1    SOURCE    CB215821  24/04/12    21:15:32     11897          
      subroutine crbar1(iwrk3,ipmodl,ideb,ifin,xmultl,icle
     +           ,d,pt1,pt2,jconl,ihg1,ihg2,xmn,ymn,zmn
     +           ,xmx,ymx,zmx,hmxt,ihg,ith,ixlong,xlong2,xlg2m)
C
C
C  entree :
C  iwrk3 donne les adresses des vecteurs a passer a doxe
C  ipmodl le modele associe
C  ideb ifin zone a traiter par le thread ith
C  xmultl 1.5
C  icle = 1 normal 2 translation 3 sym // un point 4 // droite 5 // un plan
C  d distance au plan de l origine (icle=5)
C  pt1 icle = 5 vect normal au plan
C      icle = 2 vect de la translation
c      icle = 3 coordonnees du centre de symetrie
c      icle = 4 point de la droite pt2 vect directeur normee 
c ixlong numero chamelem de longueur s'il y a lieu
c xlong2 longueur de recherche
c
c  sorties :
c  jconl segment 1 elements gardes 0 elements exclus (cas symetries)
C  ihg1 ihg2 coordonnees des barycentres des elements
c  xmn ymn zmn min des coordonnees pour le tri
C  xmx ymx zmx max des coordonnes pour le tri
C  hmxt max de dist bary noeuds
c  ihg voir description du segment dans conne1
c
c routine appelee par conne1
 
      implicit integer(i-n)
      implicit real*8(a-h,o-z)
-INC PPARAM
-INC CCOPTIO
-INC SMMODEL
-INC CCREEL
-INC SMELEME
-INC SMCOORD
-INC SMCHAML
C
      SEGMENT,WRK3
         INTEGER IWRK1(NSOUS,nbthr), IWRK2(NSOUS,nbthr),imptv(nsous)
C iwrk1 pointe vers les wrk1 et iwrk2 pointe sur les wrk2         
      ENDSEGMENT
      segment wrk1
        real*8 xe(3,nbno1)
      endsegment
      segment hg
        integer ielh(nbpb,2)
        real*8 hmax(nbpb)
        real*8 xll(nbpb)
        integer inoa(nbpb,nsous+1)
      endsegment
      segment conl
         integer iconl(nbpb)
      endsegment
      segment hg1
        real*8 hcoor(3*nbpb)
      endsegment
      pointeur hg2.hg1
      real*8 xmn(*),ymn(*),zmn(*)
      real*8 xmx(*),ymx(*),zmx(*),hmxt(*),xlg2m(*)
      real*8  pt1(*),pt2(*)
c
      i1 = 0
      ik1 = 0
      mmodel = ipmodl
      wrk3 = iwrk3
      hg1 = ihg1
      hg2 = ihg2
      hg = ihg
c
      xmin=xgrand
      ymin=xgrand
      zmin=xgrand
      xmax=-xgrand
      ymax=-xgrand
      zmax=-xgrand
      conl = jconl
      hmaxt = 0d0
      xlong2m = 0d0
      do ib = ideb, ifin
         iel = ielh(ib,1)
         izo = ielh(ib,2)
         imodel = kmodel(izo)
         wrk1 = iwrk1(izo,ith)
         meleme = imamod
         nbel = num(/2)
         nbno = num(/1)
         usnbno = 1d0 / nbno
         call doxe(xcoor,idim,nbno,num,iel,xe)
         xm = xe(1,1)
         ym = xe(2,1)
         zm = xe(3,1)
         do ino = 2, nbno
            xm = xm + xe(1,ino)
            ym = ym + xe(2,ino)
            zm = zm + xe(3,ino)
         enddo
         xm = xm * usnbno
         ym = ym * usnbno
         zm = zm * usnbno
         xm1 = xm
         ym1 = ym
         zm1 = zm
         xma = 0d0
         do ino = 1, nbno
            xma = max(xma,sqrt((xe(1,ino)-xm)**2
     +          +(xe(2,ino)-ym)**2+(xe(3,ino)-zm)**2))
         enddo
         hmax(ib) = xma
         hmaxt = max (hmaxt,xma)
         if (ixlong.ne.0) then
            melval = imptv(izo)
            xlongm = 0d0
            nbglar = velche(/1)
            do igau = 1, nbglar
               xlongm = max(xlongm,velche(igau,min(ib,velche(/2))))
            enddo
            xlong2 = xlongm * xmultl
            xll(ib) = xlong2
            xlong2m = max(xlong2m,xlong2)
         endif
C 
         if (icle.eq.5) then
C on garde les eles a moins de xlong de l ele de sym
            B1 = D + xm*PT1(1)+ym*pt1(2)+zm*pt1(3)
            IF ((abs(B1)-xma).LE.XLONG2) THEN          
               b1 = 2. * b1
               xm1 = xm - b1*pt1(1)
               ym1 = ym - b1*pt1(2)
               zm1 = zm - b1*pt1(3)
               hg2.HCOOR((Ib -1)*3+1) = xm1
               hg2.HCOOR((Ib -1)*3+2) = ym1     
               hg2.HCOOR((Ib -1)*3+3) = zm1
                   HCOOR((Ib -1)*3+1) = xm
                   HCOOR((Ib -1)*3+2) = ym     
                   HCOOR((Ib -1)*3+3) = zm
            else 
               iconl(ib)=0           
            ENDIF                  
         elseif (icle.eq.4) then
C
C on garde les eles a moins de xlong de l ele de sym
C
               B1 = (xm-PT1(1))*pt2(1)
     +            + (ym-pt1(2))*pt2(2)
     +            + (zm-pt1(3))*PT2(3)
               C1 = (PT1(1)-xm+(b1*pt2(1)))**2
     +            + (pt1(2)-ym+(b1*pt2(2)))**2
     +            + (pt1(3)-zm+(b1*PT2(3)))**2
               C1 = sqrt(C1)
               IF ((C1-xma).LE.XLONG2) THEN          
                  xm1 = xm + 2. *(pt1(1)-xm+b1*pt2(1))
                  ym1 = ym + 2. *(pt1(2)-ym+b1*pt2(2))
                  zm1 = zm + 2. *(pt1(3)-zm+b1*pt2(3))
                  hg2.HCOOR((Ib -1)*3+1) = xm1
                  hg2.HCOOR((Ib -1)*3+2) = ym1     
                  hg2.HCOOR((Ib -1)*3+3) = zm1
                      HCOOR((Ib -1)*3+1) = xm
                      HCOOR((Ib -1)*3+2) = ym     
                      HCOOR((Ib -1)*3+3) = zm
               else 
                  iconl(ib)=0           
               ENDIF
         elseif (icle.eq.3) then
C
C on garde les eles a moins de xlong de l ele de sym
C
               B1 = (xm-PT1(1))**2 + (ym-pt1(2))**2
     +          + (zm-pt1(3))**2
               B1 = sqrt(B1)
               IF ((B1-xma).LE.XLONG2) THEN          
                  xm1 = xm + 2. *(PT1(1)-xm)
                  ym1 = ym + 2. *(PT1(2)-ym)
                  zm1 = zm + 2. *(PT1(3)-zm)
                  hg2.HCOOR((Ib -1)*3+1) = xm1
                  hg2.HCOOR((Ib -1)*3+2) = ym1     
                  hg2.HCOOR((Ib -1)*3+3) = zm1
                      HCOOR((Ib -1)*3+1) = xm
                      HCOOR((Ib -1)*3+2) = ym     
                      HCOOR((Ib -1)*3+3) = zm
               else  
                  iconl(ib)=0  
               endif
         elseif (icle.eq.2) then
               xm1 = xm + PT1(1)
               ym1 = ym + PT1(2)
               zm1 = zm + PT1(3)
               hg2.HCOOR((Ib-1)*3+1) = xm1
               hg2.HCOOR((Ib-1)*3+2) = ym1     
               hg2.HCOOR((Ib-1)*3+3) = zm1
                   HCOOR((Ib-1)*3+1) = xm
                   HCOOR((Ib-1)*3+2) = ym     
                   HCOOR((Ib-1)*3+3) = zm
         else
               HCOOR((IB-1)*3+1) = xm
               HCOOR((IB-1)*3+2) = ym     
               HCOOR((IB-1)*3+3) = zm
         endif
         xmax = max(xmax,xm1)
         ymax = max(ymax,ym1)
         zmax = max(zmax,zm1)
         xmin = min(xmin,xm1)
         ymin = min(ymin,ym1)
         zmin = min(zmin,zm1)             
      enddo
      xmx(ith) = xmax
      ymx(ith) = ymax
      zmx(ith) = zmax
      xmn(ith) = xmin
      ymn(ith) = ymin
      zmn(ith) = zmin
      hmxt(ith)= hmaxt 
      xlg2m(ith) = xlong2m
      return
      end