i11buce__crit_8F_source.html

Copyright>        OpenRadioss

Copyright>        Copyright (C) 1986-2025 Altair Engineering Inc.

Copyright>

Copyright>        This program is free software: you can redistribute it and/or modify

Copyright>        it under the terms of the GNU Affero General Public License as published by

Copyright>        the Free Software Foundation, either version 3 of the License, or

Copyright>        (at your option) any later version.

Copyright>

Copyright>        This program is distributed in the hope that it will be useful,

Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of

Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the

Copyright>        GNU Affero General Public License for more details.

Copyright>

Copyright>        You should have received a copy of the GNU Affero General Public License

Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.

Copyright>

Copyright>

Copyright>        Commercial Alternative: Altair Radioss Software

Copyright>

Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss

Copyright>        software under a commercial license.  Contact Altair to discuss further if the

Copyright>        commercial version may interest you: https://www.altair.com/radioss/.

!||====================================================================

!||    i11buce_crit       ../engine/source/interfaces/intsort/i11buce_crit.F

!||--- called by ------------------------------------------------------

!||    i11main_crit_tri   ../engine/source/interfaces/intsort/i11main_crit_tri.F

!||--- calls      -----------------------------------------------------

!||    spmd_get_penis     ../engine/source/mpi/interfaces/send_cand.F

!||====================================================================


       SUBROUTINE i11buce_crit(

     1    X     ,NSV   ,MSR   ,NSN   ,NMN   ,

     2    ITASK ,XSAV  ,PENIS ,PENIM ,INACTI,

     3    NRTS  ,NRTM  ,STFS  ,CAND_S,V     ,

     6    XSLV_G,XMSR_G,VSLV_G,VMSR_G,NIN   )

C-----------------------------------------------

C   I m p l i c i t   T y p e s

C-----------------------------------------------

#include      "implicit_f.inc"

#include      "comlock.inc"

C-----------------------------------------------

C   C o m m o n   B l o c k s

C-----------------------------------------------

#include      "com01_c.inc"

#include      "com04_c.inc"

#include      "com08_c.inc"

#include      "task_c.inc"

C-----------------------------------------------

C   D u m m y   A r g u m e n t s

C-----------------------------------------------

      INTEGER NSN,NMN,ITASK,NSV(*),MSR(*),INACTI,CAND_S(*),

     .        NRTM,NRTS,NIN

      my_real

     .   X(3,*),XSAV(3,*),PENIS(2,*),PENIM(2,*),

     .   xslv_g(*),xmsr_g(*),stfs(*), v(3,*),

     .   vslv_g(*), vmsr_g(*)

C-----------------------------------------------

C   L o c a l   V a r i a b l e s

C-----------------------------------------------

      INTEGER NSNF,NMNF,NSNL,NMNL,I,J,II,

     .        NRTSF, NRTSL, NRTMF, NRTML

      my_real

     .        XSLV(6),XMSR(6), VSLV(6), VMSR(6)

C-----------------------------------------------

C   S o u r c e  L i n e s

C-----------------------------------------------

C

C     maj pene

C

      nrtsf = 1 + itask * nrts / nthread

      nrtsl = (itask+1) * nrts / nthread

      IF(inacti==5.OR.inacti==6)THEN

        nrtmf = 1 + itask * nrtm / nthread

        nrtml = (itask+1) * nrtm / nthread


C-----------------------------------------------

C  maj PENIS sur partie non locale

C-----------------------------------------------

        IF(nspmd>1 .AND. tt > zero) THEN ! frontieres partiellement baties a tt=0

C

C Partie non parallele smt

C

!$OMP SINGLE


          CALL spmd_get_penis(penis,nin)


C Fin Partie non parallele smt

!$OMP END SINGLE


        END IF

C-----------------------------------------------

!$OMP DO SCHEDULE(guided)

        DO i=1,nrts

          penis(1,i)=min(penis(1,i),penis(2,i))

          penis(2,i)=zero

        ENDDO

!$OMP END DO NOWAIT

!$OMP DO SCHEDULE(guided)

        DO i=1,nrtm

          penim(1,i)=min(penim(1,i),penim(2,i))

          penim(2,i)=zero

        ENDDO

!$OMP END DO NOWAIT

      ENDIF

C

C si NSPMD > 1 traitement effectue dans SPMD_GET_STIF11

C car reperage comm sur stfs < ZERO

C

      IF (nspmd==1) THEN

!$OMP DO SCHEDULE(guided)

        DO i=1,nrts

          stfs(i)=max(stfs(i),zero)

        ENDDO

!$OMP END DO NOWAIT

      END IF

C

C     0- CALCUL DU CRITERE POUR SAVOIR SI ON DOIT TRIER OU NON

C

      xslv(1) = -ep30

      xslv(2) = -ep30

      xslv(3) = -ep30

      xslv(4) =  ep30

      xslv(5) =  ep30

      xslv(6) =  ep30

      xmsr(1) = -ep30

      xmsr(2) = -ep30

      xmsr(3) = -ep30

      xmsr(4) =  ep30

      xmsr(5) =  ep30

      xmsr(6) =  ep30

C

      vslv(1) = -ep30

      vslv(2) = -ep30

      vslv(3) = -ep30

      vslv(4) =  ep30

      vslv(5) =  ep30

      vslv(6) =  ep30

      vmsr(1) = -ep30

      vmsr(2) = -ep30

      vmsr(3) = -ep30

      vmsr(4) =  ep30

      vmsr(5) =  ep30

      vmsr(6) =  ep30

C

      nsnf = 1 + itask*nsn / nthread

      nsnl = (itask+1)*nsn / nthread

      nmnf = 1 + itask*nmn / nthread

      nmnl = (itask+1)*nmn / nthread

C

      IF(nsn+nmn<numnod)THEN

C

!$OMP DO SCHEDULE(guided)

        DO i=1,nsn

         j=nsv(i)

C shooting nodes

         IF(j>0) THEN

          xslv(1)=max(xslv(1),x(1,j)-xsav(1,i))

          xslv(2)=max(xslv(2),x(2,j)-xsav(2,i))

          xslv(3)=max(xslv(3),x(3,j)-xsav(3,i))

          xslv(4)=min(xslv(4),x(1,j)-xsav(1,i))

          xslv(5)=min(xslv(5),x(2,j)-xsav(2,i))

          xslv(6)=min(xslv(6),x(3,j)-xsav(3,i))

C

          vslv(1)=max(vslv(1),v(1,j))

          vslv(2)=max(vslv(2),v(2,j))

          vslv(3)=max(vslv(3),v(3,j))

          vslv(4)=min(vslv(4),v(1,j))

          vslv(5)=min(vslv(5),v(2,j))

          vslv(6)=min(vslv(6),v(3,j))

         ENDIF

        END DO

!$OMP END DO NOWAIT


!$OMP DO SCHEDULE(guided)

        DO i=1,nmn

         ii = i+nsn

         j=msr(i)

C shooting nodes

         IF(j>0) THEN

          xmsr(1)=max(xmsr(1),x(1,j)-xsav(1,ii))

          xmsr(2)=max(xmsr(2),x(2,j)-xsav(2,ii))

          xmsr(3)=max(xmsr(3),x(3,j)-xsav(3,ii))

          xmsr(4)=min(xmsr(4),x(1,j)-xsav(1,ii))

          xmsr(5)=min(xmsr(5),x(2,j)-xsav(2,ii))

          xmsr(6)=min(xmsr(6),x(3,j)-xsav(3,ii))

C

          vmsr(1)=max(vmsr(1),v(1,j))

          vmsr(2)=max(vmsr(2),v(2,j))

          vmsr(3)=max(vmsr(3),v(3,j))

          vmsr(4)=min(vmsr(4),v(1,j))

          vmsr(5)=min(vmsr(5),v(2,j))

          vmsr(6)=min(vmsr(6),v(3,j))

C

         ENDIF

        END DO

!$OMP END DO NOWAIT

      ELSE

C

!$OMP DO SCHEDULE(guided)

        DO i=1,nsn

         j=nsv(i)

C shooting nodes

         IF(j>0) THEN

          xslv(1)=max(xslv(1),x(1,j)-xsav(1,j))

          xslv(2)=max(xslv(2),x(2,j)-xsav(2,j))

          xslv(3)=max(xslv(3),x(3,j)-xsav(3,j))

          xslv(4)=min(xslv(4),x(1,j)-xsav(1,j))

          xslv(5)=min(xslv(5),x(2,j)-xsav(2,j))

          xslv(6)=min(xslv(6),x(3,j)-xsav(3,j))

C

          vslv(1)=max(vslv(1),v(1,j))

          vslv(2)=max(vslv(2),v(2,j))

          vslv(3)=max(vslv(3),v(3,j))

          vslv(4)=min(vslv(4),v(1,j))

          vslv(5)=min(vslv(5),v(2,j))

          vslv(6)=min(vslv(6),v(3,j))

         ENDIF

        END DO

!$OMP END DO NOWAIT

C

!$OMP DO SCHEDULE(guided)

        DO i=1,nmn

         j=msr(i)

C shooting nodes

         IF(j>0) THEN

          xmsr(1)=max(xmsr(1),x(1,j)-xsav(1,j))

          xmsr(2)=max(xmsr(2),x(2,j)-xsav(2,j))

          xmsr(3)=max(xmsr(3),x(3,j)-xsav(3,j))

          xmsr(4)=min(xmsr(4),x(1,j)-xsav(1,j))

          xmsr(5)=min(xmsr(5),x(2,j)-xsav(2,j))

          xmsr(6)=min(xmsr(6),x(3,j)-xsav(3,j))

C

          vmsr(1)=max(vmsr(1),v(1,j))

          vmsr(2)=max(vmsr(2),v(2,j))

          vmsr(3)=max(vmsr(3),v(3,j))

          vmsr(4)=min(vmsr(4),v(1,j))

          vmsr(5)=min(vmsr(5),v(2,j))

          vmsr(6)=min(vmsr(6),v(3,j))

C

         ENDIF

        END DO

!$OMP END DO NOWAIT

      ENDIF

C

#include "lockon.inc"

      xslv_g(1)=max(xslv_g(1),xslv(1))

      xslv_g(2)=max(xslv_g(2),xslv(2))

      xslv_g(3)=max(xslv_g(3),xslv(3))

      xslv_g(4)=min(xslv_g(4),xslv(4))

      xslv_g(5)=min(xslv_g(5),xslv(5))

      xslv_g(6)=min(xslv_g(6),xslv(6))

      xmsr_g(1)=max(xmsr_g(1),xmsr(1))

      xmsr_g(2)=max(xmsr_g(2),xmsr(2))

      xmsr_g(3)=max(xmsr_g(3),xmsr(3))

      xmsr_g(4)=min(xmsr_g(4),xmsr(4))

      xmsr_g(5)=min(xmsr_g(5),xmsr(5))

      xmsr_g(6)=min(xmsr_g(6),xmsr(6))

C

      vslv_g(1)=max(vslv_g(1),vslv(1))

      vslv_g(2)=max(vslv_g(2),vslv(2))

      vslv_g(3)=max(vslv_g(3),vslv(3))

      vslv_g(4)=min(vslv_g(4),vslv(4))

      vslv_g(5)=min(vslv_g(5),vslv(5))

      vslv_g(6)=min(vslv_g(6),vslv(6))

      vmsr_g(1)=max(vmsr_g(1),vmsr(1))

      vmsr_g(2)=max(vmsr_g(2),vmsr(2))

      vmsr_g(3)=max(vmsr_g(3),vmsr(3))

      vmsr_g(4)=min(vmsr_g(4),vmsr(4))

      vmsr_g(5)=min(vmsr_g(5),vmsr(5))

      vmsr_g(6)=min(vmsr_g(6),vmsr(6))

#include "lockoff.inc"

C

      RETURN


      END

i11buce_crit
subroutine i11buce_crit(x, nsv, msr, nsn, nmn, itask, xsav, penis, penim, inacti, nrts, nrtm, stfs, cand_s, v, xslv_g, xmsr_g, vslv_g, vmsr_g, nin)
Definition i11buce_crit.F:35

min
#define min(a, b)
Definition macros.h:20

max
#define max(a, b)
Definition macros.h:21

spmd_get_penis
subroutine spmd_get_penis(penis, nin)
Definition send_cand.F:2657