i10optcd.F File Reference

#include "implicit_f.inc"
#include "comlock.inc"
#include "mvsiz_p.inc"
#include "task_c.inc"
#include "param_c.inc"
#include "com01_c.inc"
#include "parit_c.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	i10optcd (nsv, cand_e, cand_n, x, i_stok, irect, gap, gap_s, gap_m, igap, itask, nin, nsn, stfn, stf, count_remslv, lskyi_sms_new)

Function/Subroutine Documentation

i10optcd()

subroutine i10optcd	(	integer, dimension(*)	nsv,
		integer, dimension(*)	cand_e,
		integer, dimension(*)	cand_n,
			x,
		integer	i_stok,
		integer, dimension(4,*)	irect,
			gap,
			gap_s,
			gap_m,
		integer	igap,
		integer	itask,
		integer	nin,
		integer	nsn,
			stfn,
			stf,
		integer, dimension(*)	count_remslv,
		integer, intent(inout)	lskyi_sms_new )

Definition at line 32 of file i10optcd.F.

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