i10sto.F File Reference

#include "implicit_f.inc"
#include "comlock.inc"
#include "mvsiz_p.inc"
#include "lockon.inc"
#include "lockoff.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	i10sto (j_stok, irect, x, nsv, ii_stok, cand_n, cand_e, nsn4, noint, marge, i_mem, prov_n, prov_e, cand_a, eshift, nsn, oldnum, nsnrold, igap, gap, gap_s, gap_m, gapmin, gapmax, nin)

Function/Subroutine Documentation

i10sto()

subroutine i10sto	(	integer	j_stok,
		integer, dimension(4,*)	irect,
			x,
		integer, dimension(*)	nsv,
		integer	ii_stok,
		integer, dimension(*)	cand_n,
		integer, dimension(*)	cand_e,
		integer	nsn4,
		integer	noint,
			marge,
		integer	i_mem,
		integer, dimension(mvsiz)	prov_n,
		integer, dimension(mvsiz)	prov_e,
		integer, dimension(*)	cand_a,
		integer	eshift,
		integer	nsn,
		integer, dimension(*)	oldnum,
		integer	nsnrold,
		integer	igap,
			gap,
			gap_s,
			gap_m,
			gapmin,
			gapmax,
		integer	nin )

Definition at line 31 of file i10sto.F.

C============================================================================
C  cette routine est appelee par : I10TRI(/int10/i10tri.F)
C----------------------------------------------------------------------------
C  cette routine appelle : I7COR3T(/int7/i7cor3.F)
C                          I7PEN3(/int7/i7pen3.F)
C                          MY_LOCK(/spe/machine.F)
C                          MY_FREE
C============================================================================
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 I_MEM,J_STOK,NSN4,NOINT,ESHIFT,NSN,NSNROLD,IGAP,NIN
      INTEGER IRECT(4,*),NSV(*),CAND_N(*),CAND_E(*),CAND_A(*)
      INTEGER PROV_N(MVSIZ),PROV_E(MVSIZ), OLDNUM(*),II_STOK
C     REAL
      my_real
     .   x(3,*), gap_s(*), gap_m(*),
     .   marge, gap, gapmin, gapmax, bid
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,K_STOK,I_STOK,N,NE,NN,IBID
      INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
     .        NSVG(MVSIZ)
C     REAL
      my_real
     .   x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz),
     .   y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
     .   z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
     .   xi(mvsiz), yi(mvsiz), zi(mvsiz), stif(mvsiz), 
     .   pene(mvsiz), gapv(mvsiz), rbid
C-----------------------------------------------
       ibid = 0
       rbid = zero
        CALL i7cor3t(j_stok  ,x     ,irect ,nsv   ,prov_e  ,
     1               prov_n  ,igap  ,gap   ,x1    ,x2     ,
     2               x3      ,x4    ,y1    ,y2    ,y3     ,
     3               y4      ,z1    ,z2    ,z3    ,z4     ,
     4               xi      ,yi    ,zi    ,stif  ,ix1    ,
     5               ix2     ,ix3   ,ix4   ,nsn   ,gap_s  ,
     6               gap_m   ,gapv  ,gapmax,gapmin,bid    ,
     7               10      ,nin   ,rbid  ,rbid  ,ibid   ,
     8               rbid    ,rbid  )
C-----------------------------------------------
        CALL i7pen3(j_stok ,marge ,x1    ,x2     ,x3   ,
     .               x4    ,y1    ,y2    ,y3     ,y4   ,
     .               z1    ,z2    ,z3    ,z4     ,xi   ,
     .               yi    ,zi    ,pene  ,ix1    ,ix2  ,
     .               ix3   ,ix4   ,igap  ,gap    ,gapv )
C-----------------------------------------------
        k_stok = 0
        DO i=1,j_stok
          IF (pene(i)/=zero) THEN
            n  = prov_n(i)
            IF(n>nsn) THEN
C numerotation tris precedent pour les noeuds non locaux (SPMD)
              n = oldnum(n-nsn)+nsn
              IF(n==nsn) n = nsn+nsnrold+1
            END IF
C   attention au shift
            ne = prov_e(i)+eshift
            DO j = cand_a(n),cand_a(n+1)-1
              IF (cand_e(j)==ne) GOTO 100
            ENDDO
            k_stok = k_stok + 1
 100        CONTINUE
          ENDIF                        
        ENDDO
C
        IF(k_stok==0)RETURN
C
#include "lockon.inc"
          i_stok = ii_stok
          IF(i_stok+k_stok>nsn4) THEN
            i_mem = 2
#include "lockoff.inc"
            RETURN
          ENDIF
          ii_stok   = i_stok + k_stok
#include "lockoff.inc"
C-----------------------------------------------
        DO i=1,j_stok
          IF (pene(i)/=zero) THEN
            n  = prov_n(i)
            nn = n
            IF(n>nsn) THEN
C numerotation tris precedent pour les noeuds non locaux (SPMD)
              n = oldnum(n-nsn)+nsn
              IF(n==nsn) n = nsn+nsnrold+1
            END IF
C   attention au shift
            ne = prov_e(i)+eshift
            DO j = cand_a(n),cand_a(n+1)-1
              IF (cand_e(j)==ne) GOTO 200
            ENDDO 
            i_stok = i_stok + 1
            cand_n(i_stok) = nn
            cand_e(i_stok) = ne
 200        CONTINUE
          ENDIF
        ENDDO
C-----------------------------------------------
      RETURN