i25sto.F File Reference

#include "implicit_f.inc"
#include "mvsiz_p.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	i25sto (j_stok, irect, x, nsv, local_i_stok, local_cand_n, local_cand_e, marge, prov_n, prov_e, eshift, nsn, nrtm, gap_s, gap_m, nbinflg, mbinflg, ilev, msegtyp, igap, gap_s_l, gap_m_l, edge_l2, icode, iskew, drad, dgapload, nrtmt)
subroutine	i25s1s2 (j_stok, prov_n, prov_e, nbinflg, mbinflg, pene)

Function/Subroutine Documentation

i25s1s2()

subroutine i25s1s2	(	integer	j_stok,
		integer, dimension(*)	prov_n,
		integer, dimension(*)	prov_e,
		integer, dimension(*)	nbinflg,
		integer, dimension(*)	mbinflg,
			pene )

Definition at line 147 of file i25sto.F.

C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.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 J_STOK,PROV_N(*),PROV_E(*),NBINFLG(*),MBINFLG(*)
      my_real
     .   pene(mvsiz)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,N,NE,IMS1,IMS2,ISS1,ISS2
C-----------------------------------------------
C
      INTEGER BITGET
      EXTERNAL bitget
C=======================================================================
         DO i=1,j_stok
           n  = prov_n(i)
           ne = prov_e(i)
           ims1 = bitget(mbinflg(ne),0)
           ims2 = bitget(mbinflg(ne),1)
           iss1 = bitget(nbinflg(n),0)
           iss2 = bitget(nbinflg(n),1)
           IF(.NOT.((ims1 == 1 .and. iss2==1).or.
     .              (ims2 == 1 .and. iss1==1)))THEN
             pene(i)=zero
           ENDIF
         ENDDO
C
      RETURN

i25sto()

subroutine i25sto	(	integer	j_stok,
		integer, dimension(4,*)	irect,
			x,
		integer, dimension(*)	nsv,
		integer	local_i_stok,
		type(array_type_int_1d)	local_cand_n,
		type(array_type_int_1d)	local_cand_e,
			marge,
		integer, dimension(mvsiz)	prov_n,
		integer, dimension(mvsiz)	prov_e,
		integer	eshift,
		integer	nsn,
		integer	nrtm,
			gap_s,
			gap_m,
		integer, dimension(*)	nbinflg,
		integer, dimension(*)	mbinflg,
		integer	ilev,
		integer, dimension(*)	msegtyp,
		integer	igap,
			gap_s_l,
			gap_m_l,
			edge_l2,
		integer, dimension(*)	icode,
		integer, dimension(*)	iskew,
		intent(in)	drad,
		intent(in)	dgapload,
		integer, intent(in)	nrtmt )

Definition at line 34 of file i25sto.F.

C============================================================================
      USE tri7box
      use array_mod 
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.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 NSN, NRTM, NBINFLG(*),MBINFLG(*),ILEV, IGAP
      INTEGER J_STOK,ESHIFT
      INTEGER IRECT(4,*),NSV(*)
      INTEGER PROV_N(MVSIZ),PROV_E(MVSIZ),local_i_stok,MSEGTYP(*),ICODE(*),ISKEW(*)
C     REAL
      my_real
     .        x(3,*), gap_s(*), gap_m(*),
     .        marge, 
     .        gap_s_l(*), gap_m_l(*), edge_l2(*)
      my_real , INTENT(IN) :: dgapload ,drad
      INTEGER , INTENT(IN) :: NRTMT
 
      type(array_type_int_1d) :: local_cand_n
      type(array_type_int_1d) :: local_cand_e
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,K_STOK,ITYPE
      INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
     .        ETYP(MVSIZ), IBC(MVSIZ)
      integer :: my_old_size,my_size
      integer, dimension(:), allocatable :: tmp_array_1,tmp_array_2
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)
      DATA itype/25/
C-----------------------------------------------
      CALL i25cor3t( j_stok  ,x    ,irect   ,nsv   ,prov_e  ,
     1               prov_n  ,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   ,nrtm    ,
     6               marge   ,gap_s,gap_m   ,gapv  ,itype   ,
     7               igap ,gap_s_l ,gap_m_l ,edge_l2,msegtyp,
     8               etyp ,icode   ,iskew    ,ibc   ,drad   ,
     9               dgapload ,nrtmt)
C-----------------------------------------------
      CALL i25pen3a( j_stok ,x1    ,x2     ,x3   ,x4    ,
     .                y1    ,y2    ,y3     ,y4   ,
     .                z1    ,z2    ,z3    ,z4     ,xi   ,
     .                yi    ,zi    ,pene  ,ix1    ,ix2  ,
     .                ix3   ,ix4   ,gapv  ,nrtm   ,etyp ,
     .                ibc   ,nrtmt )
C-----------------------------------------------
      IF (ilev==2) 
     .  CALL i25s1s2(j_stok,prov_n,prov_e,nbinflg,mbinflg,pene)
C-----------------------------------------------
      k_stok = 0
      DO i=1,j_stok
          IF(pene(i)/=zero) THEN
            k_stok = k_stok + 1
          END IF 
      ENDDO
      IF(k_stok==0)RETURN
C
      if(local_i_stok+k_stok>local_cand_n%size_int_array_1d) then
        my_old_size = local_cand_n%size_int_array_1d
        my_size = (my_old_size+k_stok) * 1.25
        allocate( tmp_array_1( my_size ) )
        allocate( tmp_array_2( my_size ) )
        tmp_array_1(1:my_old_size) = local_cand_n%int_array_1d(1:my_old_size)
        tmp_array_2(1:my_old_size) = local_cand_e%int_array_1d(1:my_old_size)
        call dealloc_1d_array(local_cand_n)
        call dealloc_1d_array(local_cand_e)
        call move_alloc(tmp_array_1,local_cand_n%int_array_1d)
        call move_alloc(tmp_array_2,local_cand_e%int_array_1d)
        local_cand_n%size_int_array_1d = my_size
        local_cand_e%size_int_array_1d = my_size
      endif
      DO i=1,j_stok
         IF(pene(i)/=zero)THEN
           local_i_stok = local_i_stok + 1
           local_cand_n%int_array_1d(local_i_stok) = prov_n(i)
           local_cand_e%int_array_1d(local_i_stok) = prov_e(i)+eshift
         ENDIF
       ENDDO
C-----------------------------------------------
      RETURN