i11optcd.F

Go to the documentation of this file.

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/.
!||====================================================================
!||    i11optcd          ../engine/source/interfaces/intsort/i11optcd.F
!||--- called by ------------------------------------------------------
!||    i11main_opt_tri   ../engine/source/interfaces/intsort/i11main_opt_tri.F
!||--- calls      -----------------------------------------------------
!||    sync_data         ../engine/source/system/machine.F
!||--- uses       -----------------------------------------------------
!||    tri7box           ../engine/share/modules/tri7box.F
!||====================================================================
      SUBROUTINE i11optcd(CAND_M,CAND_S,X   ,I_STOK,IRECTS  ,
     2                    IRECTM,GAP   ,NIN ,V     ,GAP_S   ,
     3                    GAP_M ,IGAP  ,STFS,ITASK ,NRTS    ,
     4                    STFM  ,GAP_S_L,GAP_M_L,COUNT_REMSLV,
     5                    IFPEN ,CAND_FX,CAND_FY,CAND_FZ,IFORM,
     6                    DRAD  ,DGAPLOAD,LSKYI_SMS_NEW)
C============================================================================
C   M o d u l e s
C-----------------------------------------------
      USE tri7box
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   G l o b a l   P a r a m e t e r s
C-----------------------------------------------
#include      "mvsiz_p.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IRECTS(2,*),IRECTM(2,*), CAND_M(*), CAND_S(*),
     .        I_STOK, NIN,IGAP ,ITASK, NRTS,COUNT_REMSLV(*), 
     .        IFPEN(*),IFORM
      my_real
     .        X(3,*),GAP,GAP_S(*),GAP_M(*),V(3,*),STFS(*), STFM(*),
     .        gap_s_l(*),gap_m_l(*),cand_fx(*),cand_fy(*),cand_fz(*)
      my_real , INTENT(IN) :: dgapload,drad
      INTEGER,INTENT(INOUT) :: LSKYI_SMS_NEW
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "task_c.inc"
#include      "com01_c.inc"
#include      "param_c.inc"
#include      "parit_c.inc"
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I , L, NN1, NN2
      my_real
     .        XI,X1,X2,X3,X4,YI,Y1,Y2,Y3,Y4,ZI,Z1,Z2,Z3,Z4,
     .        XMINS,XMAXS,YMINS,YMAXS,ZMINS,ZMAXS,
     .        XMINM,XMAXM,YMINM,YMAXM,ZMINM,ZMAXM,
     .        v12,v22,v32,v42,vv,gapvd
      INTEGER MSEG,CT
      my_real
     .        GAPV(MVSIZ),DTTI(MVSIZ)
      INTEGER LIST(MVSIZ), LISTI(MVSIZ)
      INTEGER IS,JS,LS,NLS,NLT,NSEG,NLF,II,NLS2
      INTEGER N1(MVSIZ),N2(MVSIZ),M1(MVSIZ),M2(MVSIZ)
      INTEGER SG, FIRST, LAST,COUNT_CAND
C-----------------------------------------------
      count_cand = 0
      ct = 0
      mseg = nvsiz
      first = 1 + i_stok*itask / nthread
      last = i_stok*(itask+1) / nthread
      js = first-1
      DO sg = first,last,mseg
       nseg = min(mseg,last-js)
       nls=0
       IF(nspmd>1) THEN
C
C Partage cand_n local / frontiere
C
         nls = 0
         nls2 = nseg+1
         DO is = 1, nseg
           i=js+is
           IF(cand_s(i)<=nrts)THEN
             nls=nls+1
             listi(nls)=is
           ELSE
             nls2=nls2-1
             listi(nls2) = is
           ENDIF
         ENDDO
         IF(igap==0)THEN
           DO ls = 1, nls
             is = listi(ls)
             gapv(is)=gap
           ENDDO
         ELSE
           DO ls = 1, nls
             is = listi(ls)
             i=js+is
             gapv(is)=gap_s(cand_s(i))+gap_m(cand_m(i))
             IF(igap==3)
     .         gapv(is)=min(gapv(is),
     .            gap_s_l(cand_s(i))+gap_m_l(cand_m(i)))
             gapv(is)=max(gapv(is),gap)
           ENDDO
         ENDIF
       ELSE
         nls = nseg
         IF(igap==0)THEN
          DO is=1,nseg
            gapv(is)=gap
            listi(is)=is
          ENDDO
         ELSE
          DO is=1,nseg
            i=js+is
            gapv(is)=gap_s(cand_s(i))+gap_m(cand_m(i))
             IF(igap==3)
     .         gapv(is)=min(gapv(is),
     .            gap_s_l(cand_s(i))+gap_m_l(cand_m(i)))
            gapv(is)=max(gapv(is),gap)
            listi(is)=is
          ENDDO
         ENDIF
       ENDIF
C
       nlf = 1
       nlt = nls
       nls=0
       DO ls = nlf, nlt
         is = listi(ls)
         i=js+is
         l  = cand_s(i)
         IF (stfs(l)/=zero) THEN
           n1(is)=irects(1,l)
           z1=x(3,n1(is))
           n2(is)=irects(2,l)
           z2=x(3,n2(is))
           l  = cand_m(i)
           IF (stfm(l)/=zero) THEN
 
            m1(is)=irectm(1,l)
            z3=x(3,m1(is))
            m2(is)=irectm(2,l)
            z4=x(3,m2(is))
            gapvd = max(gapv(is)+dgapload,drad)
            zmins = min(z1,z2)-gapvd
            zmaxs = max(z1,z2)+gapvd
            zminm = min(z3,z4)-gapvd
            zmaxm = max(z3,z4)+gapvd
            IF (zmaxs>=zminm.AND.zmaxm>=zmins) THEN
             nls=nls+1
             list(nls)=is
            ENDIF
           ENDIF
         ENDIF
       ENDDO
C
       nlt=nls
       nls=0
       DO ls=nlf,nlt
          is=list(ls)
          i=js+is
          l  = cand_s(i)
          n1(is)=irects(1,l)
          y1=x(2,n1(is))
          n2(is)=irects(2,l)
          y2=x(2,n2(is))
          l  = cand_m(i)
          m1(is)=irectm(1,l)
          y3=x(2,m1(is))
          m2(is)=irectm(2,l)
          y4=x(2,m2(is))
          gapvd = max(gapv(is)+dgapload,drad)
          ymins = min(y1,y2)-gapvd
          ymaxs = max(y1,y2)+gapvd
          yminm = min(y3,y4)-gapvd
          ymaxm = max(y3,y4)+gapvd
          IF (ymaxs>=yminm.AND.ymaxm>=ymins) THEN
            nls=nls+1
            list(nls)=is
          ENDIF
       ENDDO
C
       DO ls=nlf,nls
          is=list(ls)
          i=js+is
          l  = cand_s(i)
          n1(is)=irects(1,l)
          x1=x(1,n1(is))
          n2(is)=irects(2,l)
          x2=x(1,n2(is))
          l  = cand_m(i)
          m1(is)=irectm(1,l)
          x3=x(1,m1(is))
          m2(is)=irectm(2,l)
          x4=x(1,m2(is))
          gapvd = max(gapv(is)+dgapload,drad)
          xmins = min(x1,x2)-gapvd
          xmaxs = max(x1,x2)+gapvd
          xminm = min(x3,x4)-gapvd
          xmaxm = max(x3,x4)+gapvd
          IF (xmaxs>=xminm.AND.xmaxm>=xmins) THEN
            cand_s(i) = -cand_s(i)
            count_cand = count_cand+1
          ENDIF
       ENDDO
C
       IF(nspmd>1)THEN
         nlf = nls2
         nlt = nseg
         IF(igap==0)THEN
          DO ls=nlf, nlt
            is = listi(ls)
            gapv(is)=gap
          ENDDO
         ELSE
          DO ls = nlf, nlt
            is = listi(ls)
            i=js+is
            gapv(is)=gapfi(nin)%P(cand_s(i)-nrts)+gap_m(cand_m(i))
            IF(igap==3)
     .        gapv(is)=min(gapv(is),
     .        gap_lfi(nin)%P(cand_s(i)-nrts)+
     .        max(gap_m(cand_m(i)),gap_m_l(cand_m(i))))
            gapv(is)=max(gapv(is),gap)
          ENDDO
         ENDIF
C
         nls=0
         DO ls = nlf, nlt
C   conserver LISTI et LIST pour optimiser le code genere (IA64)
          is = listi(ls)
          i=js+is
          ii = cand_s(i)-nrts
          IF (stifi(nin)%P(ii)/=zero) THEN
           nn1 = 2*(ii-1)+1
           nn2 = 2*ii
           z1=xfi(nin)%P(3,nn1)
           z2=xfi(nin)%P(3,nn2)
           l  = cand_m(i)
           IF (stfm(l)/=zero) THEN
            m1(is)=irectm(1,l)
            z3=x(3,m1(is))
            m2(is)=irectm(2,l)
            z4=x(3,m2(is))
            gapvd = max(gapv(is)+dgapload,drad)
            zmins = min(z1,z2)-gapvd
            zmaxs = max(z1,z2)+gapvd
            zminm = min(z3,z4)-gapvd
            zmaxm = max(z3,z4)+gapvd
            IF (zmaxs>=zminm.AND.zmaxm>=zmins) THEN
             nls=nls+1
             list(nls)=is
            ENDIF
           ENDIF
          ENDIF
        ENDDO
C
        nlf=1
        nlt=nls
        nls=0
        DO ls=nlf,nlt
          is=list(ls)
          i=js+is
          ii = cand_s(i)-nrts
          nn1 = 2*(ii-1)+1
          nn2 = 2*ii
          y1=xfi(nin)%P(2,nn1)
          y2=xfi(nin)%P(2,nn2)
          l  = cand_m(i)
          m1(is)=irectm(1,l)
          y3=x(2,m1(is))
          m2(is)=irectm(2,l)
          y4=x(2,m2(is))
          gapvd = max(gapv(is)+dgapload,drad)
          ymins = min(y1,y2)-gapvd
          ymaxs = max(y1,y2)+gapvd
          yminm = min(y3,y4)-gapvd
          ymaxm = max(y3,y4)+gapvd
          IF (ymaxs>=yminm.AND.ymaxm>=ymins) THEN
            nls=nls+1
            list(nls)=is
          ENDIF
        ENDDO
C
        DO ls=nlf,nls
          is=list(ls)
          i=js+is
          ii = cand_s(i)-nrts
          nn1 = 2*(ii-1)+1
          nn2 = 2*ii
          x1=xfi(nin)%P(1,nn1)
          x2=xfi(nin)%P(1,nn2)
          l  = cand_m(i)
          m1(is)=irectm(1,l)
          x3=x(1,m1(is))
          m2(is)=irectm(2,l)
          x4=x(1,m2(is))
          gapvd = max(gapv(is)+dgapload,drad)
          xmins = min(x1,x2)-gapvd
          xmaxs = max(x1,x2)+gapvd
          xminm = min(x3,x4)-gapvd
          xmaxm = max(x3,x4)+gapvd
          IF (xmaxs>=xminm.AND.xmaxm>=xmins) THEN
            cand_s(i) = -cand_s(i)
            count_cand = count_cand+1
            ct = ct+1
          ENDIF
        ENDDO
        CALL sync_data(nls2)
       END IF
       js = js + nseg
      ENDDO
      IF (itask == 0 .AND. iform == 2) THEN
        DO i=1,i_stok
          IF (ifpen(i) == 0 ) THEN
            cand_fx(i) = zero
            cand_fy(i) = zero
            cand_fz(i) = zero
          ENDIF
          ifpen(i) = 0
        ENDDO
      ENDIF
C
#include "lockon.inc"
      lskyi_count=lskyi_count+count_cand*5
      count_remslv(nin)=count_remslv(nin)+ct
      lskyi_sms_new = lskyi_sms_new + count_cand
#include "lockoff.inc"
 
C
      RETURN
      END