bsigini.F File Reference

#include "implicit_f.inc"
#include "vect01_c.inc"
#include "param_c.inc"
#include "scr17_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	bsigini (elbuf_str, igtyp, nel, nsigbeam, sigbeam, ptbeam, ixp, igeo)

Function/Subroutine Documentation

bsigini()

subroutine bsigini	(	type (elbuf_struct_), target	elbuf_str,
		integer	igtyp,
		integer	nel,
		integer	nsigbeam,
			sigbeam,
		integer, dimension(*)	ptbeam,
		integer, dimension(nixp,*)	ixp,
		integer, dimension(npropgi,*)	igeo )

Definition at line 33 of file bsigini.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE elbufdef_mod
      USE message_mod
      USE names_and_titles_mod , ONLY : nchartitle
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      "param_c.inc"
#include      "scr17_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER :: IGTYP,NEL,NSIGBEAM
      INTEGER :: PTBEAM(*),IXP(NIXP,*),IGEO(NPROPGI,*)
      my_real :: sigbeam(nsigbeam,*)
      TYPE (ELBUF_STRUCT_), TARGET :: ELBUF_STR
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER :: I,II,JJ,IPT,IR,IS,PT,KK(3),ILAY,NPTI,PID,IPID
      CHARACTER(LEN=NCHARTITLE) :: TITR1
      TYPE(G_BUFEL_),POINTER :: GBUF
      TYPE(L_BUFEL_),POINTER :: LBUF
C----------------------------------------------------------------------- 
      gbuf => elbuf_str%GBUF
!---
!     INITIAL STRESS
!---
      DO i=1,3
        kk(i) = nel*(i-1)
      ENDDO
!
      DO i=lft,llt
        ii = i+nft
        jj = ptbeam(ii)
        IF (jj > 0) THEN
!---
          npti = nint(sigbeam(2,jj))
!---
          gbuf%EINT(kk(1)+i) = sigbeam(4,jj)
          gbuf%EINT(kk(2)+i) = sigbeam(5,jj)
!
          gbuf%FOR(kk(1)+i) = sigbeam(6,jj)
          gbuf%FOR(kk(2)+i) = sigbeam(7,jj)
          gbuf%FOR(kk(3)+i) = sigbeam(8,jj)
!
          gbuf%MOM(kk(1)+i) = sigbeam(9,jj)
          gbuf%MOM(kk(2)+i) = sigbeam(10,jj)
          gbuf%MOM(kk(3)+i) = sigbeam(11,jj)
!---
          IF (igtyp == 3) THEN
            IF(gbuf%G_PLA > 0) gbuf%PLA(i) = sigbeam(12,jj)
! check NPT /= NPTI
            IF (npt /= npti  .and . npti /= 0) THEN
              ipid=ixp(5,i)
              pid=igeo(1,ixp(5,i))
              CALL fretitl2(titr1,igeo(npropgi-ltitr+1,ipid),ltitr)
              CALL ancmsg(msgid=1233,anmode=aninfo,msgtype=msgerror,i1=pid,i2=ixp(nixp,i),c1=titr1)
            ENDIF
!
          ELSEIF (igtyp == 18) THEN
            pt = 11
! check NPT /= NPTI
            IF (npt /= npti  .AND. npti /= 0) THEN
              ipid=ixp(5,i)
              pid=igeo(1,ixp(5,i))            
              CALL fretitl2(titr1,igeo(npropgi-ltitr+1,ipid),ltitr)
              CALL ancmsg(msgid=1233,anmode=aninfo,msgtype=msgerror,i1=pid,i2=ixp(nixp,i),c1=titr1)
            ENDIF
!
            DO ipt=1,npt
              ilay=1
              ir = 1
              is = 1
              lbuf => elbuf_str%BUFLY(ilay)%LBUF(ir,is,ipt)
              lbuf%SIG(kk(1)+i) = sigbeam(pt+1,jj)
              lbuf%SIG(kk(2)+i) = sigbeam(pt+2,jj)
              lbuf%SIG(kk(3)+i) = sigbeam(pt+3,jj)
              IF(elbuf_str%BUFLY(ilay)%L_PLA > 0) lbuf%PLA(i) = sigbeam(pt+4,jj)
              pt = pt + 4
            ENDDO ! DO IPT=1,NPT
          ENDIF ! IF (IGTYP == 5)
!---
        ENDIF ! IF (JJ > 0)
      ENDDO ! DO I=LFT,LLT
!---
      RETURN