i10optcd.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/.
!||====================================================================
!||    i10optcd          ../engine/source/interfaces/intsort/i10optcd.F
!||--- called by ------------------------------------------------------
!||    i10main_opt_tri   ../engine/source/interfaces/intsort/i10opt_opt_tri.F
!||--- calls      -----------------------------------------------------
!||    sync_data         ../engine/source/system/machine.F
!||--- uses       -----------------------------------------------------
!||    tri7box           ../engine/share/modules/tri7box.F
!||====================================================================
      SUBROUTINE i10optcd(NSV  ,CAND_E,CAND_N,X     ,I_STOK,
     1                    IRECT,GAP   ,GAP_S ,GAP_M ,IGAP  ,
     2                    ITASK,NIN   ,NSN   ,STFN  ,STF   ,
     3                    COUNT_REMSLV, 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 IRECT(4,*), NSV(*), CAND_E(*), CAND_N(*),
     .        I_STOK, IGAP, ITASK, NSN, NIN,COUNT_REMSLV(*)
      my_real
     .        x(3,*),gap,gap_s(*),gap_m(*),stfn(*),stf(*)
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "task_c.inc"
#include      "param_c.inc"
#include      "com01_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
      my_real
     .        XI,X1,X2,X3,X4,YI,Y1,Y2,Y3,Y4,ZI,Z1,Z2,Z3,Z4,
     .        xmin,xmax,ymin,ymax,zmin,zmax
      INTEGER MSEG
      INTEGER LIST(MVSIZ), LISTI(MVSIZ)
      INTEGER IS,JS,LS,NLS,NLT,NSEG, II, NLF, NLS2
      INTEGER IG(MVSIZ),IX1(MVSIZ),IX2(MVSIZ),IX3(MVSIZ),IX4(MVSIZ)
      INTEGER SG, FIRST, LAST,COUNT_CAND,CT
      my_real
     .        gapv(mvsiz)
      INTEGER,INTENT(INOUT) :: LSKYI_SMS_NEW
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_n(i)<=nsn)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_n(i))+gap_m(cand_e(i))
             gapv(is)=max(gapv(is),gap)
           ENDDO
         ENDIF
       ELSE
         nls = nseg
C
         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_n(i))+gap_m(cand_e(i))
            gapv(is)=max(gapv(is),gap)
          ENDDO
         ENDIF
       ENDIF
C
       nlf = 1
       nlt = nls
       nls=0
        DO ls = nlf, nlt
C   conserver LISTI et LIST pour optimiser le code genere (IA64)
         is = listi(ls)
         i=js+is
         l  = cand_e(i)
         IF(stf(l)/=zero.AND.stfn(cand_n(i))/=zero) THEN 
          ig(is) = nsv(cand_n(i))
          zi = x(3,ig(is))
          ix1(is)=irect(1,l)
          z1=x(3,ix1(is))
          ix2(is)=irect(2,l)
          z2=x(3,ix2(is))
          ix3(is)=irect(3,l)
          z3=x(3,ix3(is))
          ix4(is)=irect(4,l)
          z4=x(3,ix4(is))
          zmin = min(z1,z2,z3,z4)-gapv(is)
          zmax = max(z1,z2,z3,z4)+gapv(is)
          IF (zmin<=zi.AND.zmax>=zi) THEN
            nls=nls+1
            list(nls)=is
          ENDIF
         END IF
        ENDDO
C
        nlt=nls
        nls=0
        DO ls=nlf,nlt
          is=list(ls)
          yi=x(2,ig(is))
          y1=x(2,ix1(is))
          y2=x(2,ix2(is))
          y3=x(2,ix3(is))
          y4=x(2,ix4(is))
          ymin = min(y1,y2,y3,y4)-gapv(is)
          ymax = max(y1,y2,y3,y4)+gapv(is)
          IF (ymin<=yi.AND.ymax>=yi) THEN
            nls=nls+1
            list(nls)=is
          ENDIF
        ENDDO
C
        DO ls=nlf,nls
          is=list(ls)
          xi=x(1,ig(is))
          x1=x(1,ix1(is))
          x2=x(1,ix2(is))
          x3=x(1,ix3(is))
          x4=x(1,ix4(is))
          xmin = min(x1,x2,x3,x4)-gapv(is)
          xmax = max(x1,x2,x3,x4)+gapv(is)
          IF (xmin<=xi.AND.xmax>=xi) THEN
            i=js+is
            cand_n(i) = -cand_n(i)
            count_cand = count_cand+1
          ENDIF
        ENDDO
        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_n(i)-nsn)+gap_m(cand_e(i))
              gapv(is)=max(gapv(is),gap)
            ENDDO
          ENDIF
          nls=0
          DO ls = nlf, nlt
           is = listi(ls)
           i=js+is
           ii = cand_n(i)-nsn
           l  = cand_e(i)
           IF(stf(l)/=zero.AND.stifi(nin)%P(ii)/=zero) THEN 
            zi = xfi(nin)%P(3,ii)
            ix1(is)=irect(1,l)
            z1=x(3,ix1(is))
            ix2(is)=irect(2,l)
            z2=x(3,ix2(is))
            ix3(is)=irect(3,l)
            z3=x(3,ix3(is))
            ix4(is)=irect(4,l)
            z4=x(3,ix4(is))
            zmin = min(z1,z2,z3,z4)-gapv(is)
            zmax = max(z1,z2,z3,z4)+gapv(is)
            IF (zmin<=zi.AND.zmax>=zi) THEN
              nls=nls+1
              list(nls)=is
            ENDIF
           END IF
          ENDDO
C
          nlf=1
          nlt=nls
          nls=0
          DO ls=nlf,nlt
            is=list(ls)
            i=js+is
            ii=cand_n(i)-nsn
            yi=xfi(nin)%P(2,ii)
            y1=x(2,ix1(is))
            y2=x(2,ix2(is))
            y3=x(2,ix3(is))
            y4=x(2,ix4(is))
            ymin = min(y1,y2,y3,y4)-gapv(is)
            ymax = max(y1,y2,y3,y4)+gapv(is)
            IF (ymin<=yi.AND.ymax>=yi) THEN
              nls=nls+1
              list(nls)=is
            ENDIF
          ENDDO
C
          DO ls=nlf,nls
            is=list(ls)
            i=js+is
            ii = cand_n(i)-nsn
            xi = xfi(nin)%P(1,ii)
            x1=x(1,ix1(is))
            x2=x(1,ix2(is))
            x3=x(1,ix3(is))
            x4=x(1,ix4(is))
            xmin = min(x1,x2,x3,x4)-gapv(is)
            xmax = max(x1,x2,x3,x4)+gapv(is)
            IF (xmin<=xi.AND.xmax>=xi) THEN
              cand_n(i) = -cand_n(i)
              count_cand = count_cand+1
              ct = ct + 1
            ENDIF
          ENDDO
        ELSE
          CALL sync_data(nls2)
        ENDIF
        js = js + nseg
      ENDDO
C
      IF (count_cand > 0)THEN
#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"
      ENDIF
 
      RETURN
      END