buserini.F File Reference

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

Go to the source code of this file.

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

Function/Subroutine Documentation

buserini()

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

Definition at line 33 of file buserini.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      "com01_c.inc"
#include      "param_c.inc"
#include      "scr17_c.inc"
#include      "vect01_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NEL,NSIGBEAM
      INTEGER IXP(NIXP,*),PTBEAM(*),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,NPTI,NU,NUVAR,NVARS,IPT,ILAY,IR,IS,PID,IPID,IGTYP
      CHARACTER(LEN=NCHARTITLE)::TITR1
      my_real, DIMENSION(:), POINTER :: uvar
C=======================================================================
!     INITIAL USER VARIABLES
      DO i=lft,llt
        ii = nft+i
        jj = ptbeam(ii)
        IF (jj > 0) THEN
          npti  = nint(sigbeam(nvbeam + 2,jj))
          igtyp = nint(sigbeam(nvbeam + 3,jj))
          nvars = nint(sigbeam(nvbeam + 4,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=1237,anmode=aninfo,msgtype=msgerror,i1=pid,i2=ixp(nixp,i),c1=titr1)
          ENDIF
 
          DO ipt=1,npt
            ilay=1
            ir = 1
            is = 1
            nuvar = elbuf_str%BUFLY(ilay)%NVAR_MAT
            uvar => elbuf_str%BUFLY(ilay)%MAT(ir,is,ipt)%VAR
            DO nu = 1,min(nvars,nuvar)
              uvar((nu-1)*nel + i) =  sigbeam(nvbeam + 4  + nu + (ipt -1)*nvars,jj)
            ENDDO
          ENDDO  !  DO ILAY=1,NPT
        ENDIF ! IF (JJ > 0)
      ENDDO ! DO I=JFT,JLT
C-----------
      RETURN