qinit2.F File Reference

#include "implicit_f.inc"
#include "mvsiz_p.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "scry_c.inc"
#include "vect01_c.inc"
#include "scr17_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	qinit2 (elbuf_str, ms, ixq, pm, x, detonators, geo, veul, ale_connectivity, iparg, dtelem, sigi, igeo, nel, skew, msq, ipart, ipartq, ipm, nsigs, wma, ptquad, bufmat, npf, tf, ipargg, iloadp, facload, partsav, v, mat_param)

Function/Subroutine Documentation

qinit2()

subroutine qinit2	(	type(elbuf_struct_), target	elbuf_str,
			ms,
		integer, dimension(nixq,*)	ixq,
			pm,
			x,
		type(detonators_struct_)	detonators,
			geo,
			veul,
		type(t_ale_connectivity), intent(inout)	ale_connectivity,
		integer, dimension(*)	iparg,
			dtelem,
			sigi,
		integer, dimension(npropgi,*)	igeo,
		integer	nel,
			skew,
			msq,
		integer, dimension(lipart1,*)	ipart,
		integer, dimension(*)	ipartq,
		integer, dimension(npropmi,*)	ipm,
		integer	nsigs,
			wma,
		integer, dimension(*)	ptquad,
			bufmat,
		integer, dimension(*)	npf,
			tf,
		integer, dimension(*)	ipargg,
		integer, dimension(sizloadp,*), intent(in)	iloadp,
		dimension(lfacload,*), intent(in)	facload,
			partsav,
			v,
		type (matparam_struct_), dimension(nummat), intent(inout)	mat_param )

Definition at line 45 of file qinit2.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE elbufdef_mod            
      USE message_mod
      USE detonators_mod
      USE ale_connectivity_mod
      USE names_and_titles_mod , ONLY : nchartitle
      USE matparam_def_mod
      use element_mod , only : nixq
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   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
#include      "param_c.inc"
#include      "scry_c.inc"
#include      "vect01_c.inc"
#include      "scr17_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IXQ(NIXQ,*), IPARG(*),IGEO(NPROPGI,*),
     .        NEL,IPART(LIPART1,*),IPARTQ(*),IPM(NPROPMI,*), PTQUAD(*),
     .        NSIGS, NPF(*),IPARGG(*)
      my_real
     .   ms(*), pm(npropm,*), x(*),  geo(npropg,*),
     .   veul(10,*), dtelem(*),sigi(nsigs,*),skew(lskew,*),
     .   msq(*), bufmat(*), tf(*),wma(*),partsav(20,*),v(*)
      TYPE(ELBUF_STRUCT_), TARGET :: ELBUF_STR
      INTEGER,INTENT(IN) :: ILOADP(SIZLOADP,*)
      my_real,INTENT(IN) :: facload(lfacload,*)
      TYPE(DETONATORS_STRUCT_)::DETONATORS
      TYPE(t_ale_connectivity), INTENT(INOUT) :: ALE_CONNECTIVITY
      TYPE (MATPARAM_STRUCT_) ,DIMENSION(NUMMAT) ,INTENT(INOUT) :: MAT_PARAM
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER MAT(MVSIZ), PID(MVSIZ), NGL(MVSIZ)
      INTEGER NF1, I, IGTYP, IP, IBID, IPID1
      my_real e1y(mvsiz),e1z(mvsiz),e2y(mvsiz),e2z(mvsiz),
     .        bid(1), dtx(mvsiz),
     .        sy(mvsiz) ,sz(mvsiz) ,ty(mvsiz) ,tz(mvsiz)
      my_real fv
      CHARACTER(LEN=NCHARTITLE)::TITR
      TYPE(G_BUFEL_) ,POINTER :: GBUF     
      TYPE(L_BUFEL_), POINTER :: LBUF     
      TYPE(BUF_MAT_) ,POINTER :: MBUF
      my_real y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
     .        z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
     .        aire(mvsiz), deltax(mvsiz)
      my_real :: tempel(nel)
      INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ)
C-----------------------------------------------
C   S o u r c e  L i n e s
C=======================================================================
      gbuf => elbuf_str%GBUF
      lbuf => elbuf_str%BUFLY(1)%LBUF(1,1,1)
      mbuf  => elbuf_str%BUFLY(1)%MAT(1,1,1)
c
      igtyp = iparg(38)
      jcvt  = iparg(37)
      ibid = 0
      bid = zero
      tempel(:) = zero
      nf1 = nft+1
c
      IF(jcvt == 0)THEN
        CALL qcoor2(x,ixq(1,nf1),ngl,mat, 
     .        pid, ix1, ix2, ix3, ix4, 
     .        y1, y2, y3, y4, 
     .        z1, z2, z3, z4,
     .        sy, sz, ty, tz)
      ELSE
        CALL qrcoor2(x   ,ixq(1,nf1),ngl  ,mat    ,
     .         pid, ix1, ix2, ix3, ix4, 
     .         y1, y2, y3, y4, 
     .         z1, z2, z3, z4, 
     .         sy, sz, ty, tz,
     .         e1y, e1z, e2y, e2z)
      END IF
      IF (igtyp == 6) CALL qmorth2(pid  ,geo  ,igeo ,gbuf%GAMA, nel,
     .                             sy   ,sz   ,ty   ,tz ,
     .                             e1y  ,e1z  , e2y, e2z)
      CALL qvoli2(gbuf%VOL,ixq(1,nf1), 
     .     ngl, aire, 
     .     y1, y2, y3, y4, 
     .     z1, z2, z3 ,z4)
      CALL qdlen2(iparg(63),
     .     aire, deltax, 
     .     y1, y2, y3, y4, 
     .     z1, z2, z3, z4)
      IF(jeul/=0) CALL edlen2(veul(1,nf1), aire, deltax)
C
      ip=0
      CALL matini(pm      ,ixq     ,nixq      ,x         ,
     .            geo     ,ale_connectivity   ,detonators,iparg     ,
     .            sigi    ,nel     ,skew      ,igeo      ,
     .            ipart   ,ipartq  ,
     .            mat     ,ipm     ,nsigs     ,numquad   ,ptquad  ,
     .            ip      ,ngl     ,npf       ,tf        ,bufmat  ,
     .            gbuf    ,lbuf    ,mbuf      ,elbuf_str ,iloadp  ,
     .            facload, deltax  ,tempel    ,mat_param )
C----------------------------------------
C     initialization of thermal and turbulence
C----------------------------------------
      IF (jthe/=0) CALL atheri(mat,pm,gbuf%TEMP)
      IF (jtur/=0) CALL aturi2(ipargg ,gbuf%RHO,pm,ixq,x,
     .                        gbuf%RK,gbuf%RE, aire)
C------------------------------------------
C     initialization of the mass matrix
C------------------------------------------
      IF (jlag+jale+jeul/=0)
     .  CALL qmasi2(pm,mat,ms,gbuf%VOL,msq(nf1),wma,ipartq(nft+1),partsav,
     .     ix1, ix2, ix3, ix4 ,x ,v)
C-------------------------------------------
C      calculation of elementary timesteps (dt)
C-------------------------------------------
      CALL dtmain(geo       ,pm        ,ipm         ,pid     ,mat     ,fv    ,
     .     gbuf%EINT ,gbuf%TEMP ,gbuf%DELTAX ,gbuf%RK ,gbuf%RE ,bufmat, deltax, aire, 
     .     gbuf%VOL, dtx, igeo,igtyp)
c
       DO i=lft,llt
        IF(ixq(6,i+nft)/=0) THEN
          IF (igtyp/=0 .AND. igtyp/=6 .AND.
     .        igtyp/=14.AND.igtyp/=15)THEN
             ipid1=ixq(nixq-1,i+nft)
             CALL fretitl2(titr,igeo(npropgi-ltitr+1,ipid1),ltitr)
             CALL ancmsg(msgid=226,
     .                   msgtype=msgerror,
     .                   anmode=aninfo_blind_1,
     .                   i1=igeo(1,ipid1),
     .                   c1=titr,
     .                   i2=igtyp)
          ENDIF
        ENDIF
        dtelem(nft+i)=dtx(i)
      ENDDO
C-----------
      RETURN