elegror_seatbelt.F File Reference

#include "implicit_f.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines
integer function	elegror_seatbelt (igu, igrele, ngrele, ibuf, nib, sibuf, nfram, tagelems, istyp, seatbelt_shell_to_spring)

Function/Subroutine Documentation

elegror_seatbelt()

integer function elegror_seatbelt	(	integer, intent(in)	igu,
		type (group_), dimension(ngrele), intent(in)	igrele,
		integer, intent(in)	ngrele,
		integer, dimension(nib,sibuf), intent(inout)	ibuf,
		integer, intent(in)	nib,
		integer, intent(in)	sibuf,
		integer, intent(in)	nfram,
		integer, dimension(numelc), intent(in)	tagelems,
		integer, intent(in)	istyp,
		integer, dimension(numelc,2), intent(in)	seatbelt_shell_to_spring )

Definition at line 30 of file elegror_seatbelt.F.

C-----------------------------------------------
C   ROUTINE DESCRIPTION :
C   ===================
C   FUNCTION TO COUNT & FOUND SPRING ELEMENTS CREATED FROM 2D SEATBELT FOR SECTION
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
      USE groupdef_mod
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      "com04_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER,INTENT(IN)::IGU,NIB,NGRELE,NFRAM,SIBUF,
     .        TAGELEMS(NUMELC),ISTYP
      INTEGER,INTENT(INOUT)::IBUF(NIB,SIBUF)
      INTEGER,INTENT(IN)::SEATBELT_SHELL_TO_SPRING(NUMELC,2)
      TYPE (GROUP_) ,DIMENSION(NGRELE) ,INTENT(IN)::IGRELE
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,J,K,IG,L,IE,IADV
C-----------------------------------------------
      elegror_seatbelt=0
      IF(igu /= 0)THEN
C
        ig=0
        DO i=1,ngrele
          IF(igrele(i)%ID==igu)ig=i
        ENDDO
C
        IF(ig /= 0)THEN
          IF (nfram > 0 .OR. istyp >= 1) THEN
            DO l=1,igrele(ig)%NENTITY
              ie=igrele(ig)%ENTITY(l)
              IF ( tagelems(ie) /= 0 ) THEN
                IF(seatbelt_shell_to_spring(ie,1) /= 0)
     .                  elegror_seatbelt = elegror_seatbelt + 1
                IF(seatbelt_shell_to_spring(ie,2) /= 0)
     .                  elegror_seatbelt = elegror_seatbelt + 1
              ENDIF
            ENDDO
          ELSE
            DO j=1,igrele(ig)%NENTITY
              ie=igrele(ig)%ENTITY(j)
              IF(seatbelt_shell_to_spring(ie,1) /= 0)
     .                  elegror_seatbelt = elegror_seatbelt + 1
              IF(seatbelt_shell_to_spring(ie,2) /= 0)
     .                  elegror_seatbelt = elegror_seatbelt + 1
            ENDDO
          ENDIF
 
          j = 0
          IF (nfram > 0 .OR. istyp >= 1) THEN
            DO i=1,igrele(ig)%NENTITY
              IF (tagelems(igrele(ig)%ENTITY(i)) == 1 ) THEN
                ie=igrele(ig)%ENTITY(i)
                IF(seatbelt_shell_to_spring(ie,1) /= 0) THEN
                  j = j + 1
                  ibuf(1,j) = seatbelt_shell_to_spring(ie,1)
                ENDIF
                IF(seatbelt_shell_to_spring(ie,2) /= 0) THEN
                  j = j + 1
                  ibuf(1,j) = seatbelt_shell_to_spring(ie,2)
                ENDIF
              ENDIF
            ENDDO
          ELSE
            DO i=1,igrele(ig)%NENTITY
              ie=igrele(ig)%ENTITY(i)
              IF(seatbelt_shell_to_spring(ie,1) /= 0) THEN
                j = j + 1
                ibuf(1,j) = seatbelt_shell_to_spring(ie,1)
              ENDIF
              IF(seatbelt_shell_to_spring(ie,2) /= 0) THEN
                j = j + 1
                ibuf(1,j) = seatbelt_shell_to_spring(ie,2)
              ENDIF
            ENDDO
          ENDIF
        ENDIF
      ENDIF
C
      RETURN