lecstat.F File Reference

#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "param_c.inc"
#include "units_c.inc"
#include "scr16_c.inc"
#include "scr17_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	lecstat (ipart, ipart_state, elbuf_tab, ipm, iparg, iparts, ipartc, ipartg, mat_param)

Function/Subroutine Documentation

lecstat()

subroutine lecstat	(	integer, dimension(lipart1,*)	ipart,
		integer, dimension(*)	ipart_state,
		type (elbuf_struct_), dimension(ngroup), target	elbuf_tab,
		integer, dimension(npropmi,nummat), intent(inout)	ipm,
		integer, dimension(nparg,*), intent(inout)	iparg,
		integer, dimension(*)	iparts,
		integer, dimension(*)	ipartc,
		integer, dimension(*)	ipartg,
		type (matparam_struct_), dimension(nummat), intent(inout)	mat_param )

Definition at line 35 of file lecstat.F.

C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE message_mod
      USE mat_elem_mod
      USE elbufdef_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      "com01_c.inc"
#include      "com04_c.inc"
#include      "param_c.inc"
#include      "units_c.inc"
#include      "scr16_c.inc"
#include      "scr17_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IPART(LIPART1,*),IPART_STATE(*),IPARTS(*),IPARTC(*),IPARTG(*)
      INTEGER,INTENT(INOUT) :: IPM(NPROPMI,NUMMAT),IPARG(NPARG,*)
C     REAL
      TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
      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 I,IDPRT,K_STAT,J,IP,IPID,IGTYP,
     .        IFAIL,NLAY,FAIL_ID,MAT_ID,IL,IMAT,
     .        NFAIL,NG,ITY,NFT,IPRT
      INTEGER MAT_CHECKED(NUMMAT)
C-----------------------------------------------
      iprt = 0
      IF (nstatprt /= 0) THEN
        mat_checked = 0
        DO i=1,nstatprt
          READ(iin,'(I10)') idprt
          ip=0
          DO j=1,npart
            IF (ipart(4,j) == idprt)ip=j
          ENDDO
          IF (ip == 0) THEN
            CALL ancmsg(msgid=119,anmode=aninfo,i1=idprt)
            CALL arret(2)
          ENDIF ! IF (IP==0)
          ipart_state(ip)=1
          !-------------
          ! for /INISHE/FAIL, fail_ID in /FAIL card is mandatory
          ! check if fail_ID is defined in failure model
          !-------------
          IF ( stat_c(8) == 1) THEN
!---
            DO ng=1,ngroup
              ity = iparg(5,ng)
              nft = iparg(3,ng)
              ipid=ipart(2,ip) ! internal
              IF (ity == 1 .or. ity == 3 .or. ity == 7) THEN
                IF (ity == 1) iprt=iparts(1+nft)
                IF (ity == 3) iprt=ipartc(1+nft)
                IF (ity == 7) iprt=ipartg(1+nft)
                IF ( iprt /= ip ) cycle
!
                nlay = elbuf_tab(ng)%NLAY
!
                DO il = 1,nlay
                  imat  = elbuf_tab(ng)%BUFLY(il)%IMAT
                  nfail = elbuf_tab(ng)%BUFLY(il)%NFAIL
                  mat_id = ipm(1,imat)  ! user mat ID
                  IF (mat_checked(imat) == 0 ) THEN
                    mat_checked(imat) = 1
                    DO ifail = 1,nfail 
                      fail_id = mat_param(imat)%FAIL(ifail)%FAIL_ID  
                      IF (fail_id == 0)
     .                  CALL ancmsg(msgid=297,anmode=aninfo,i1=mat_id)
                    ENDDO ! DO IFAIL
                  ENDIF ! IF (MAT_CHECKED(IMAT) == 0 )
                ENDDO ! DO IL = 1,NLAY
              ENDIF ! IF (ITY == 1 .or. ITY == 3 .or. ITY == 7)
            ENDDO ! DO NG=1,NGROUP
C---
          ENDIF ! IF ( part de coque & STAT_C(8) = 1) THEN
        END DO ! DO I=1,NSTATPRT
      ELSEIF (nstatall /= 0) THEN
        DO j=1,npart
          ipart_state(j) = 1
        END DO
      ENDIF ! IF (NSTATPRT /= 0)
C
      RETURN