h3d_quad_vector.F File Reference

#include "implicit_f.inc"
#include "vect01_c.inc"
#include "mvsiz_p.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine

h3d_quad_vector (elbuf_tab, quad_vector, ifunc, iparg, geo, ixq, ixc, ixtg, pm, el2fa, nbf, iadp, nbf_l, ehour, anim, nbpart, iadg, ipm, igeo, thke, err_thk_sh4, err_thk_sh3, invert, x, v, w, nv46, nercvois, nesdvois, lercvois, lesdvois, stack, id_elem, info1, info2, is_written_quad, ipartq, iparttg, layer_input, ipt_input, ply_input, gauss_input, iuvar_input, h3d_part, keyword, bufmat, multi_fvm, ir_input, is_input, it_input)

Function/Subroutine Documentation

h3d_quad_vector()

subroutine h3d_quad_vector	(	type (elbuf_struct_), dimension(ngroup), target	elbuf_tab,
			quad_vector,
		integer	ifunc,
		integer, dimension(nparg,ngroup)	iparg,
			geo,
		integer, dimension(nixq,numelq)	ixq,
		integer, dimension(nixc,numelc)	ixc,
		integer, dimension(nixtg,numeltg)	ixtg,
			pm,
		integer, dimension(*)	el2fa,
		integer	nbf,
		integer, dimension(*)	iadp,
		integer	nbf_l,
			ehour,
			anim,
		integer	nbpart,
		integer, dimension(nspmd,*)	iadg,
		integer, dimension(npropmi,nummat)	ipm,
		integer, dimension(npropgi,numgeo)	igeo,
			thke,
			err_thk_sh4,
			err_thk_sh3,
		integer, dimension(*)	invert,
			x,
			v,
			w,
		integer	nv46,
		integer, dimension(*)	nercvois,
		integer, dimension(*)	nesdvois,
		integer, dimension(*)	lercvois,
		integer, dimension(*)	lesdvois,
		type (stack_ply)	stack,
		integer, dimension(*)	id_elem,
		integer	info1,
		integer	info2,
		integer, dimension(*)	is_written_quad,
		integer, dimension(*)	ipartq,
		integer, dimension(*)	iparttg,
		integer	layer_input,
		integer	ipt_input,
		integer	ply_input,
		integer	gauss_input,
		integer	iuvar_input,
		integer, dimension(*)	h3d_part,
		character(len=ncharline100)	keyword,
		target	bufmat,
		type (multi_fvm_struct), intent(in)	multi_fvm,
		integer	ir_input,
		integer	is_input,
		integer	it_input )

Definition at line 40 of file h3d_quad_vector.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE initbuf_mod
      USE elbufdef_mod    
      USE schlieren_mod 
      USE stack_mod 
      USE multi_fvm_mod              
      USE alefvm_mod
      USE names_and_titles_mod, ONLY: ncharline100
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "vect01_c.inc"
#include      "mvsiz_p.inc"
#include      "com01_c.inc"
#include      "com04_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      my_real
     .   quad_vector(3,*),x(3,numnod),v(3,numnod),w(3,numnod),thke(*),ehour(*),geo(npropg,numgeo),
     .   anim(*),pm(npropm,*),err_thk_sh4(*), err_thk_sh3(*)
      INTEGER IPARG(NPARG,NGROUP),IXC(NIXC,NUMELC),IXTG(NIXTG,NUMELTG),EL2FA(*),
     .   IXQ(NIXQ,NUMELQ),IFUNC,NBF,
     .   IADP(*),NBF_L, NBPART,IADG(NSPMD,*),IPM(NPROPMI,NUMMAT),
     .   IGEO(NPROPGI,NUMGEO),INVERT(*),  NV46,ID_ELEM(*),
     .   INFO1,INFO2,IS_WRITTEN_QUAD(*),IPARTQ(*),IPARTTG(*),H3D_PART(*),
     .   LAYER_INPUT ,IPT_INPUT,GAUSS_INPUT,PLY_INPUT,IUVAR_INPUT,
     .   IR_INPUT,IS_INPUT,IT_INPUT,IS_WRITTEN_VECTOR(MVSIZ)
      TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
      TYPE (STACK_PLY) :: STACK
      CHARACTER(LEN=NCHARLINE100) :: KEYWORD
      TYPE (MULTI_FVM_STRUCT), INTENT(IN) :: MULTI_FVM
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      my_real
     .   dam1(mvsiz),dam2(mvsiz),
     .   wpla(mvsiz),dmax(mvsiz),wpmax(mvsiz),fail(mvsiz),
     .   epst1(mvsiz),epst2(mvsiz),epsf1(mvsiz),epsf2(mvsiz),
     .   value(3),ff0,gg0,hh0,ll0,mm0,nn0,mass(mvsiz)
      my_real
     .   off, p,vonm2,s1,s2,s12,s3,dmgmx,fac,
     .   dir1_1,dir1_2,dir2_1,dir2_2,aa,bb,v1,v2,v3,x21,x32,x34,
     .   x41,y21,y32,y34,y41,z21,z32,z34,z41,suma,vr,vs,x31,y31,
     .   z31,e11,e12,e13,e21,e22,e23,sum,area,x2l,var,
     .   e1x,e1y,e1z,e2x,e2y,e2z,e3x,e3y,e3z,rx,ry,rz,sx,sy,sz,
     .   vg(5),vly(5),ve(5),bufmat(*),
     .   s11,s22,s33,s4,s5,s6,crit,value1,value2
      my_real
     .   evar(3,mvsiz)
      INTEGER I,I1,II,J,NG,NEL,NPTR,NPTS,NPTT,NLAY,L,IFAIL,ILAY,
     .        IR,IS,IT,IL,MLW, NUVAR,IUS,LENF,PTF,PTM,PTS,NFAIL,
     .        N,NN,K,K1,K2,JTURB,MT,IMID,IALEL,IPID,ISH3N,NNI,
     .        NN1,NN2,NN3,NN4,NN5,NN6,NN9,NF,BUF,NVARF,
     .        OFFSET,IHBE,NPTM,NPG, MPT,IPT,IADD,IADR,IPMAT,IFAILT,
     .        IIGEO,IADI,ISUBSTACK,ITHK,NERCVOIS(*),NESDVOIS(*),
     .        LERCVOIS(*),LESDVOIS(*),ID_PLY,NB_PLYOFF,IOK,IADBUF,NUPARAM,
     .        IMAT,IVISC,IPOS,ITRIMAT
      INTEGER PID(MVSIZ),MAT(MVSIZ),MATLY(MVSIZ*100),FAILG(100,MVSIZ),
     .        PTE(4),PTP(4),PTMAT(4),PTVAR(4),NPT_ALL,IPLY,
     .        ID_ELEM_TMP(MVSIZ),NIX,IOK_PART(MVSIZ),JJ(6),NPGT,IUVAR,
     .        IS_WRITTEN_VALUE(MVSIZ)
      CHARACTER*5 BUFF
      REAL R4
      TYPE(G_BUFEL_)  ,POINTER :: GBUF     
      TYPE(L_BUFEL_)  ,POINTER :: LBUF     
      TYPE(BUF_LAY_)  ,POINTER :: BUFLY     
      TYPE(BUF_FAIL_) ,POINTER :: FBUF 
      my_real,
     .  DIMENSION(:), POINTER  :: uvar
      TYPE(L_BUFEL_) ,POINTER  :: LBUF1,LBUF2,LBUF3,LBUF4
      TYPE(BUF_MAT_)  ,POINTER :: MBUF 
      my_real, DIMENSION(:) ,POINTER  :: uparam
      TARGET :: bufmat
C-----------------------------------------------
      ilay = layer_input
      iuvar = iuvar_input
      ir = ir_input
      is = is_input
      it = it_input
C
      DO i=1,numelq
         is_written_quad(i) = 0
      ENDDO
C-----------
      DO 900 ng=1,ngroup
       CALL initbuf(iparg    ,ng      ,                    
     2          mlw     ,nel     ,nft     ,iad     ,ity     ,  
     3          npt     ,jale    ,ismstr  ,jeul    ,jturb   ,  
     4          jthe    ,jlag    ,jmult   ,jhbe    ,jivf    ,  
     5          nvaux   ,jpor    ,jcvt    ,jclose  ,jplasol ,  
     6          irep    ,iint    ,igtyp   ,israt   ,isrot   ,  
     7          icsen   ,isorth  ,isorthg ,ifailure,jsms    )
       IF(mlw /= 13) THEN
          nft   =iparg(3,ng)
          iad   =iparg(4,ng)
          isubstack = iparg(71,ng)
          ivisc = iparg(61,ng)
          iok_part(1:nel) = 0 
          lft=1
          llt=nel
!
          DO i=1,6
            jj(i) = nel*(i-1)
          ENDDO  
c
          value(1:3) = zero
          DO i=1,nel
            is_written_value(i) = 0
          ENDDO       
          evar(1:3,1:nel) = zero
          is_written_vector(1:nel) = 0
C-----------------------------------------------
C           QUAD
C-----------------------------------------------
         IF (ity == 2) THEN
 
            gbuf => elbuf_tab(ng)%GBUF
            lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1)
            uvar => elbuf_tab(ng)%BUFLY(1)%MAT(1,1,1)%VAR
            jale=(iparg(7,ng)+iparg(11,ng))
            jturb=iparg(12,ng)*jale
            nptr  = elbuf_tab(ng)%NPTR
            npts  = elbuf_tab(ng)%NPTS
            nptt  = elbuf_tab(ng)%NPTT
            nlay  = elbuf_tab(ng)%NLAY
            nuvar = elbuf_tab(ng)%BUFLY(1)%NVAR_MAT
c
            DO  i=1,nel 
              id_elem(nft+i) = ixq(nixq,nft+i)
              IF( h3d_part(ipartq(nft+i)) == 1) iok_part(i) = 1
            ENDDO
C---------------------    
            DO i=1,nel
              quad_vector(1:3,nft+i) = zero   ! Default = zero in all cases !
            ENDDO
c
            iuvar = iuvar_input
C--------------------------------------------------
            IF (keyword == 'VECT/VEL') THEN 
C--------------------------------------------------
               IF (mlw == 151) THEN
                  DO i = 1, nel
                     evar(1,i) = multi_fvm%VEL(1, i + nft)
                     evar(2,i) = multi_fvm%VEL(2, i + nft)
                     evar(3,i) = multi_fvm%VEL(3, i + nft)
                     is_written_vector(i) = 1
                  ENDDO
               ELSE
                  DO i=1,nel
                     IF(gbuf%G_MOM>0 .AND. alefvm_param%IEnabled > 0)THEN
                        evar(1,i) = gbuf%MOM(jj(1) + i) / gbuf%RHO(i) 
                        evar(2,i) = gbuf%MOM(jj(2) + i) / gbuf%RHO(i)
                        evar(3,i) = gbuf%MOM(jj(3) + i) / gbuf%RHO(i)
                        is_written_vector(i) = 1
                     ENDIF
                  ENDDO
               ENDIF
               IF (jcvt == 0 .OR. isorth /= 0) THEN
C                OUTPUT TENSOR STORED IN GLOBAL SYSTEM TO BE TRANSFERRED IN THE ELEMENT LOCAL ONE
                 CALL qrota_vect(x,ixq(1,nft+1),jcvt,evar,gbuf%GAMA,nel)
               ENDIF
C--------------------------------------------------
            ELSEIF (keyword == 'vect/acc') THEN
C--------------------------------------------------
.AND.               IF (MLW == 151  ALLOCATED(MULTI_FVM%ACC)) THEN
                  DO I = 1, NEL
                     EVAR(1,I) = MULTI_FVM%ACC(1, I + NFT)
                     EVAR(2,I) = MULTI_FVM%ACC(2, I + NFT)
                     EVAR(3,I) = MULTI_FVM%ACC(3, I + NFT)
                     IS_WRITTEN_VECTOR(I) = 1
                  ENDDO
               ENDIF
C--------------------------------------------------
            ENDIF  ! KEYWORD
C-----------------------------------------------
          CALL H3D_WRITE_VECTORS(IOK_PART,IS_WRITTEN_QUAD,QUAD_VECTOR,NEL,0,NFT,EVAR,IS_WRITTEN_VECTOR)
C-----------------------------------------------
          ENDIF  ! ITY
 
C-----------------------------------------------
       ENDIF     ! MLW /= 13
 900  CONTINUE   ! NG 
C-----------------------------------------------
      RETURN