i24_save_sub.F File Reference

#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	i24_save_sub (numnod, mvsiz, nisub, s_addsubm, s_lisubm, s_typsub, nisubmax, i_stok, ie, itypsub, nin, i, nn, nft, addsubm, lisubm, typsub, intarean, intcarea, isensint, fxi, fyi, fzi, fni, dt12, fsavsub1, fsavparit, nrtse, irtse, nsne, is2se, is2pt, nsnr)

Function/Subroutine Documentation

i24_save_sub()

subroutine i24_save_sub	(	integer	numnod,
		integer	mvsiz,
		integer	nisub,
		integer	s_addsubm,
		integer	s_lisubm,
		integer	s_typsub,
		integer	nisubmax,
		integer	i_stok,
		integer	ie,
		integer	itypsub,
		integer	nin,
		integer	i,
		integer	nn,
		integer	nft,
		integer, dimension(s_addsubm)	addsubm,
		integer, dimension(s_lisubm)	lisubm,
		integer, dimension(s_typsub)	typsub,
			intarean,
		integer	intcarea,
		integer, dimension(nisubmax+1)	isensint,
			fxi,
			fyi,
			fzi,
			fni,
			dt12,
			fsavsub1,
			fsavparit,
		integer, intent(in)	nrtse,
		integer, dimension(5,nrtse), intent(in)	irtse,
		integer, intent(in)	nsne,
		integer, dimension(2,nsne), intent(in)	is2se,
		integer, dimension(nsne), intent(in)	is2pt,
		integer, intent(in)	nsnr )

Parameters

numnod	NUMBER of nodes in Model
mvsiz	Vector size
s_addsubm	Size of ADDSUBM (computed in Starter)
s_lisubm	Size of LISUBM (computed in Starter)
s_typsub	Size of TYPSUB (computed in Starter)
nisubmax	Size of ISENSINT
nisub	Number of Sub interfaces
i_stok	Number of contact pair / Dimension for FSAVPARIT
i	Iterator over Impact : Main Surface/Sec Node from caller routine
nft	Current pinter to FSAVSUB1

Definition at line 33 of file i24_save_sub.F.

!! \brief Routine to save values for type24 Sub interface for output
!! \details moved from i24for3.F to secondary subroutine due to compiler issue.
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE tri7box
      USE i24intarea_fic_mod  , ONLY : i24intarea_fic  
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-----------------------------------------------
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NUMNOD       !< NUMBER of nodes in Model
      INTEGER MVSIZ        !< Vector size
      INTEGER S_ADDSUBM    !< Size of ADDSUBM (computed in Starter)
      INTEGER S_LISUBM     !< Size of LISUBM (computed in Starter)
      INTEGER S_TYPSUB     !< Size of TYPSUB (computed in Starter)
      INTEGER NISUBMAX     !< Size of ISENSINT
      INTEGER NISUB        !< Number of Sub interfaces
      INTEGER I_STOK       !< Number of contact pair / Dimension for FSAVPARIT
      INTEGER IE
      INTEGER ITYPSUB
      INTEGER NIN
      INTEGER NN
      INTEGER I            !< Iterator over Impact : Main Surface/Sec Node from caller routine
      INTEGER NFT          !< Current pinter to FSAVSUB1
      INTEGER ADDSUBM(S_ADDSUBM)
      INTEGER LISUBM(S_LISUBM)
      INTEGER TYPSUB(S_TYPSUB)
      INTEGER ISENSINT(NISUBMAX+1)
      my_real fxi(mvsiz)
      my_real fyi(mvsiz)
      my_real fzi(mvsiz)
      my_real fni(mvsiz)
      my_real dt12
      my_real intarean(numnod)
      INTEGER INTCAREA
      my_real fsavsub1(25,nisub)
      my_real fsavparit(nisub+1,11,i_stok)
      INTEGER, INTENT(IN) :: NSNE,NRTSE,NSNR
      INTEGER, DIMENSION(5,NRTSE),INTENT(IN) :: IRTSE
      INTEGER, DIMENSION(2,NSNE),INTENT(IN) :: IS2SE
      INTEGER, DIMENSION(NSNE),INTENT(IN) :: IS2PT
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER KK,ISUB,IG
      my_real impx,impy,impz,arean_fic
C-----------------------------------------------
      DO kk=addsubm(ie),addsubm(ie+1)-1
            isub=lisubm(kk)
            itypsub = typsub(isub)
 
            IF(itypsub == 2 ) THEN   ! Inter =0 : collecting forces from all inter with only 1 surface : main side
 
              impx=-fxi(i)*dt12
              impy=-fyi(i)*dt12
              impz=-fzi(i)*dt12
 
              fsavsub1(1,isub)=fsavsub1(1,isub)+impx
              fsavsub1(2,isub)=fsavsub1(2,isub)+impy
              fsavsub1(3,isub)=fsavsub1(3,isub)+impz
 
              fsavsub1(8,isub) =fsavsub1(8,isub) +abs(impx)
              fsavsub1(9,isub) =fsavsub1(9,isub) +abs(impy)
              fsavsub1(10,isub)=fsavsub1(10,isub)+abs(impz)
 
              fsavsub1(11,isub)=fsavsub1(11,isub)-fni(i)*dt12
 
              IF(isensint(isub+1)/=0) THEN
                fsavparit(isub+1,1,i+nft) =  -fxi(i)
                fsavparit(isub+1,2,i+nft) =  -fyi(i)
                fsavparit(isub+1,3,i+nft) =  -fzi(i)
              ENDIF
 
              IF(intcarea > 0)  THEN
                 IF(nn > 0) THEN
                     IF(nn <=numnod) THEN
                        fsavsub1(25,isub) = fsavsub1(25,isub) + intarean(nn) 
                     ELSE
                        ig = nn - numnod
                        CALL i24intarea_fic(irtse   ,nsne    ,is2se   ,is2pt   ,ig      , 
     +                                    nrtse , numnod     ,intarean,  arean_fic )
                        fsavsub1(25,isub) = fsavsub1(25,isub) + arean_fic
                    ENDIF
                 ELSE
                    IF(isedge_fi(nin)%P(nn)==1)THEN
                       CALL i24intarea_fic(irtse_fi(nin)%P    ,nsnr    ,is2se_fi(nin)%P  ,is2pt_fi(nin)%P   ,nn      , 
     +                                        nsnr , nsnr     , intareanfi(nin)%P, arean_fic)
                          fsavsub1(25,isub) = fsavsub1(25,isub) + arean_fic 
                    ELSE ! cas noeud remote en SPMD non edge
                          fsavsub1(25,isub) = fsavsub1(25,isub) + intareanfi(nin)%P(nn)
                    ENDIF
                 ENDIF
              ENDIF
 
            ENDIF
 
      ENDDO