i21optcd.F File Reference

#include "implicit_f.inc"
#include "comlock.inc"
#include "mvsiz_p.inc"
#include "param_c.inc"
#include "task_c.inc"
#include "parit_c.inc"
#include "warn_c.inc"
#include "timeri_c.inc"
#include "vectorize.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	i21optcd (timers, cand_e, cand_n, xloc, i_stok, irect, gap, gap_s, igap, nsn, stfn, itask, stf, inacti, ifpen, ftxsav, ftysav, ftzsav, peni, nin, gapmax, icurv, irtlm, csts, depth, nod_normal, xm0, drad, nb_stok_n, nb_jlt, dgapload)

Function/Subroutine Documentation

i21optcd()

subroutine i21optcd	(	type(timer_)	timers,
		integer, dimension(*)	cand_e,
		integer, dimension(*)	cand_n,
			xloc,
		integer	i_stok,
		integer, dimension(4,*)	irect,
			gap,
			gap_s,
		integer	igap,
		integer	nsn,
			stfn,
		integer	itask,
			stf,
		integer	inacti,
		integer, dimension(*)	ifpen,
			ftxsav,
			ftysav,
			ftzsav,
			peni,
		integer	nin,
			gapmax,
		integer	icurv,
		integer, dimension(2,*)	irtlm,
			csts,
			depth,
			nod_normal,
			xm0,
		intent(in)	drad,
		integer, dimension(*)	nb_stok_n,
		integer, dimension(*)	nb_jlt,
		intent(in)	dgapload )

Definition at line 34 of file i21optcd.F.

          USE timer_mod
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   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "param_c.inc"
#include      "task_c.inc"
#include      "parit_c.inc"
#include      "warn_c.inc"
#include      "timeri_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      TYPE(TIMER_) :: TIMERS
      INTEGER IRECT(4,*), CAND_E(*), CAND_N(*), IFPEN(*),
     .        I_STOK,NIN,IGAP ,ITASK, NSN, INACTI,ICURV,
     .        IRTLM(2,*),NB_STOK_N(*),NB_JLT(*)
      my_real
     .        xloc(3,*),gap,gap_s(*),stfn(*),stf(*),
     .        ftxsav(*), ftysav(*), ftzsav(*), peni(*),
     .        gapmax, csts(2,*), depth, nod_normal(3,*),
     .        xm0(3,*)
      my_real , INTENT(IN) :: dgapload,drad
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,L,IS,JS,LS,NLS,NLT,NSEG,SG,FIRST,LAST,MSEG,NLF,II,J
      INTEGER LIST(MVSIZ),IG(MVSIZ),IX1(MVSIZ),IX2(MVSIZ),IX3(MVSIZ),
     .        IX4(MVSIZ), LISTI(MVSIZ),COUNT_CAND,
     .        IX1_L(MVSIZ), IX2_L(MVSIZ), IX3_L(MVSIZ),IX4_L(MVSIZ)
      my_real
     .        xi,x1,x2,x3,x4,yi,y1,y2,y3,y4,zi,z1,z2,z3,z4,
     .        xmin,xmax,ymin,ymax,zmin,zmax,v12,v22,v32,v42
      my_real
     .        gapv(mvsiz),nod_normal_l(12,mvsiz),xe_l(12,mvsiz),
     .        xi_l(mvsiz), yi_l(mvsiz), zi_l(mvsiz),
     .        x1_l(mvsiz), x2_l(mvsiz), x3_l(mvsiz), x4_l(mvsiz),
     .        y1_l(mvsiz), y2_l(mvsiz), y3_l(mvsiz), y4_l(mvsiz),
     .        z1_l(mvsiz), z2_l(mvsiz), z3_l(mvsiz), z4_l(mvsiz),
     .        nnx1(mvsiz), nnx2(mvsiz), nnx3(mvsiz), nnx4(mvsiz),
     .        nny1(mvsiz), nny2(mvsiz), nny3(mvsiz), nny4(mvsiz),
     .        nnz1(mvsiz), nnz2(mvsiz), nnz3(mvsiz), nnz4(mvsiz)
      my_real
     .        x0,y0,z0,xxx,yyy,zzz,curv_max,depth2,drad2,
     .        xx1 ,xx2 ,xx3 ,xx4 ,xx5 ,xx6 ,xx7 ,xx8 ,
     .        yy1 ,yy2 ,yy3 ,yy4 ,yy5 ,yy6 ,yy7 ,yy8 ,
     .        zz1 ,zz2 ,zz3 ,zz4 ,zz5 ,zz6 ,zz7 ,zz8 ,
     .        nx1 ,nx2 ,nx3 ,nx4 , ny1 ,ny2 ,ny3 ,ny4 ,
     .        nz1 ,nz2 ,nz3 ,nz4 ,gapf, marj
C-----------------------------------------------
      count_cand=0
C-----------------------------------------------
      depth2=depth*depth
      drad2 =drad*drad
C-----------------------------------------------
      DO j=itask+1,nsn,nthread
        irtlm(1,j)=0
      ENDDO
C
      call my_barrier
C
C-----------------------------------------------
      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 = 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_n(i))
          IF(gapmax/=zero)gapv(is)=min(gapv(is),gapmax)
          gapv(is)=max(gapv(is),gap)
          listi(is)=is
        ENDDO
       ENDIF
C
       IF (debug(3)>=1) nb_jlt(itask+1) = nb_jlt(itask+1) + nls
C
       nlf = 1
       nlt = nls
       nls=0
       IF(icurv==3)THEN
        DO ls = nlf, nlt
          is = listi(ls)
          i=js+is
          l  = cand_e(i)
          IF(stf(l)/=zero.AND.stfn(cand_n(i))/=zero) THEN 
           ig(is) = cand_n(i)
           xi = xloc(1,ig(is))
           yi = xloc(2,ig(is))
           zi = xloc(3,ig(is))
           ix1(is)=irect(1,l)
           ix2(is)=irect(2,l)
           ix3(is)=irect(3,l)
           ix4(is)=irect(4,l)
           x1=xm0(1,ix1(is))
           x2=xm0(1,ix2(is))
           x3=xm0(1,ix3(is))
           x4=xm0(1,ix4(is))
           y1=xm0(2,ix1(is))
           y2=xm0(2,ix2(is))
           y3=xm0(2,ix3(is))
           y4=xm0(2,ix4(is))
           z1=xm0(3,ix1(is))
           z2=xm0(3,ix2(is))
           z3=xm0(3,ix3(is))
           z4=xm0(3,ix4(is))
           x0 = fourth*(x1+x2+x3+x4)
           y0 = fourth*(y1+y2+y3+y4)
           z0 = fourth*(z1+z2+z3+z4)
           xxx=max(x1,x2,x3,x4)-min(x1,x2,x3,x4)
           yyy=max(y1,y2,y3,y4)-min(y1,y2,y3,y4)
           zzz=max(z1,z2,z3,z4)-min(z1,z2,z3,z4)
           curv_max = half * max(xxx,yyy,zzz)
           xmin = x0-curv_max-gapv(is)
           ymin = y0-curv_max-gapv(is)
           zmin = z0-curv_max-gapv(is)
           xmax = x0+curv_max+gapv(is)
           ymax = y0+curv_max+gapv(is)
           zmax = z0+curv_max+gapv(is)
           IF (xmin <= xi.AND.xmax >= xi.AND.
     .         ymin <= yi.AND.ymax >= yi.AND.
     .         zmin <= zi.AND.zmax >= zi) THEN
                 cand_n(i) = -cand_n(i)
                 count_cand = count_cand+1
           ENDIF
          ENDIF
        ENDDO
       ELSE
#include      "vectorize.inc"
        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 ! Contact sorting optimization
           ig(is) = cand_n(i)
           gapf = max(gapv(is)+dgapload,drad)
C          
           xi = xloc(1,ig(is)) ! Secnd node
           yi = xloc(2,ig(is))
           zi = xloc(3,ig(is))
C
           ix1(is)=irect(1,l) ! Main Segment
           ix2(is)=irect(2,l)
           ix3(is)=irect(3,l)
           ix4(is)=irect(4,l)
C
           x1=xm0(1,ix1(is))
           x2=xm0(1,ix2(is))
           x3=xm0(1,ix3(is))
           x4=xm0(1,ix4(is))
C
           y1=xm0(2,ix1(is))
           y2=xm0(2,ix2(is))
           y3=xm0(2,ix3(is))
           y4=xm0(2,ix4(is))
C
           z1=xm0(3,ix1(is))
           z2=xm0(3,ix2(is))
           z3=xm0(3,ix3(is))
           z4=xm0(3,ix4(is))
C
           nx1 = nod_normal(1,ix1(is))
           ny1 = nod_normal(2,ix1(is))
           nz1 = nod_normal(3,ix1(is))
C
           nx2 = nod_normal(1,ix2(is))
           ny2 = nod_normal(2,ix2(is))
           nz2 = nod_normal(3,ix2(is))
C
           nx3 = nod_normal(1,ix3(is))
           ny3 = nod_normal(2,ix3(is))
           nz3 = nod_normal(3,ix3(is))
C
           nx4 = nod_normal(1,ix4(is))
           ny4 = nod_normal(2,ix4(is))
           nz4 = nod_normal(3,ix4(is))
C
           xx1 = x1 + gapf*nx1
           xx2 = x2 + gapf*nx2
           xx3 = x3 - depth*nx3
           xx4 = x4 - depth*nx4
           xx5 = x1 - depth*nx1
           xx6 = x2 - depth*nx2
           xx7 = x3 + gapf*nx3
           xx8 = x4 + gapf*nx4
C
           yy1 = y1 + gapf*ny1
           yy2 = y2 + gapf*ny2
           yy3 = y3 - depth*ny3
           yy4 = y4 - depth*ny4
           yy5 = y1 - depth*ny1
           yy6 = y2 - depth*ny2
           yy7 = y3 + gapf*ny3
           yy8 = y4 + gapf*ny4
C
           zz1 = z1 + gapf*nz1
           zz2 = z2 + gapf*nz2
           zz3 = z3 - depth*nz3
           zz4 = z4 - depth*nz4
           zz5 = z1 - depth*nz1
           zz6 = z2 - depth*nz2
           zz7 = z3 + gapf*nz3
           zz8 = z4 + gapf*nz4
C
           xmin = min(xx1,xx2,xx3,xx4,xx5,xx6,xx7,xx8)
           ymin = min(yy1,yy2,yy3,yy4,yy5,yy6,yy7,yy8)
           zmin = min(zz1,zz2,zz3,zz4,zz5,zz6,zz7,zz8)
           xmax = max(xx1,xx2,xx3,xx4,xx5,xx6,xx7,xx8)
           ymax = max(yy1,yy2,yy3,yy4,yy5,yy6,yy7,yy8)
           zmax = max(zz1,zz2,zz3,zz4,zz5,zz6,zz7,zz8)
C
           marj = em02*(xmax-xmin)
           xmin = xmin - marj
           xmax = xmax + marj
           marj = em02*(ymax-ymin)
           ymin = ymin - marj
           ymax = ymax + marj
           marj = em02*(zmax-zmin)
           zmin = zmin - marj
           zmax = zmax + marj
C
           IF (xmin <= xi.AND.xmax >= xi.AND.   ! If a node is in the box limited by GAP and DEPTH
     .         ymin <= yi.AND.ymax >= yi.AND.   ! it is selected
     .         zmin <= zi.AND.zmax >= zi) THEN  
             nls=nls+1
             list(nls)=is
C
             xi_l(nls) = xi
             yi_l(nls) = yi
             zi_l(nls) = zi
C 
             ix1_l(nls) = ix1(is)
             ix2_l(nls) = ix2(is)
             ix3_l(nls) = ix3(is)
             ix4_l(nls) = ix4(is)
C
             x1_l(nls) = x1
             y1_l(nls) = y1
             z1_l(nls) = z1
             x2_l(nls) = x2
             y2_l(nls) = y2
             z2_l(nls) = z2
             x3_l(nls) = x3
             y3_l(nls) = y3
             z3_l(nls) = z3
             x4_l(nls) = x4
             y4_l(nls) = y4
             z4_l(nls) = z4
C       
             nnx1(nls) = nx1
             nny1(nls) = ny1
             nnz1(nls) = nz1
             nnx2(nls) = nx2
             nny2(nls) = ny2
             nnz2(nls) = nz2
             nnx3(nls) = nx3
             nny3(nls) = ny3
             nnz3(nls) = nz3
             nnx4(nls) = nx4
             nny4(nls) = ny4
             nnz4(nls) = nz4
C
           ENDIF
          ENDIF
        ENDDO
C        
        IF (debug(3)>=1) nb_stok_n(itask+1) = nb_stok_n(itask+1) + nls
C
        IF (imonm > 0 .AND. itask+1 == 1) CALL startime(timers,77) ! Counting DST time
C
        nlt=nls
        nls=0
        CALL i21dst3(
     .       nlt     ,list    ,cand_n(js+1) ,cand_e(js+1) , ix1_l ,
     .       ix2_l   ,ix3_l   ,ix4_l        ,gapv         ,xi_l   , 
     .       yi_l    ,zi_l    ,irtlm        ,csts         ,depth2 ,
     .       nnx1    ,nny1    ,nnz1         ,nnx2         ,nny2   , 
     .       nnz2    ,nnx3    ,nny3         ,nnz3         ,nnx4   ,
     .       nny4    ,nnz4    ,x1_l         ,y1_l         ,z1_l   ,
     .       x2_l    ,y2_l    ,z2_l         ,x3_l         ,y3_l   ,
     .       z3_l    ,x4_l    ,y4_l         ,z4_l         ,drad2  ,
     .       dgapload)
       ENDIF
       js = js + nseg
      ENDDO
      
C-----------------------------------------------
C
      call my_barrier
C
      DO j=itask+1,nsn,nthread
        IF(irtlm(1,j) > 0)THEN
ccc        irtlm < 0 if gap < dist < dradiation
ccc        impact=impact+1
           ifpen(j)=ifpen(j)+1
        ELSEIF(ifpen(j)/=0)THEN
           ftxsav(j)=zero
           ftysav(j)=zero
           ftzsav(j)=zero
           peni(j)  =zero
           ifpen(j) =0
        END IF
      ENDDO
C
#include "lockon.inc"
      lskyi_count=lskyi_count+count_cand*5
#include "lockoff.inc"
      call my_barrier
C
C-----------------------------------------------
      RETURN