lecstat.F

Go to the documentation of this file.

Copyright>        OpenRadioss
Copyright>        Copyright (C) 1986-2025 Altair Engineering Inc.
Copyright>
Copyright>        This program is free software: you can redistribute it and/or modify
Copyright>        it under the terms of the GNU Affero General Public License as published by
Copyright>        the Free Software Foundation, either version 3 of the License, or
Copyright>        (at your option) any later version.
Copyright>
Copyright>        This program is distributed in the hope that it will be useful,
Copyright>        but WITHOUT ANY WARRANTY; without even the implied warranty of
Copyright>        MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
Copyright>        GNU Affero General Public License for more details.
Copyright>
Copyright>        You should have received a copy of the GNU Affero General Public License
Copyright>        along with this program.  If not, see <https://www.gnu.org/licenses/>.
Copyright>
Copyright>
Copyright>        Commercial Alternative: Altair Radioss Software
Copyright>
Copyright>        As an alternative to this open-source version, Altair also offers Altair Radioss
Copyright>        software under a commercial license.  Contact Altair to discuss further if the
Copyright>        commercial version may interest you: https://www.altair.com/radioss/.
!||====================================================================
!||    lecstat        ../engine/source/input/lecstat.F
!||--- called by ------------------------------------------------------
!||    lectur         ../engine/source/input/lectur.F
!||--- calls      -----------------------------------------------------
!||    ancmsg         ../engine/source/output/message/message.F
!||    arret          ../engine/source/system/arret.F
!||--- uses       -----------------------------------------------------
!||    elbufdef_mod   ../common_source/modules/mat_elem/elbufdef_mod.f90
!||    mat_elem_mod   ../common_source/modules/mat_elem/mat_elem_mod.F90
!||    message_mod    ../engine/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE lecstat(IPART ,IPART_STATE,ELBUF_TAB,IPM,IPARG,
     .                   IPARTS,IPARTC     ,IPARTG,MAT_PARAM)
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
      END