cnloc_matini.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/.
!||====================================================================
!||    cnloc_matini       ../starter/source/materials/mat_share/cnloc_matini.F
!||--- called by ------------------------------------------------------
!||    c3fint_reg_ini     ../starter/source/elements/sh3n/coque3n/c3fint_reg_ini.F
!||    cbafint_reg_ini    ../starter/source/elements/shell/coqueba/cbafint_reg_ini.F
!||    cdkfint_reg_ini    ../starter/source/elements/sh3n/coquedk/cdkfint_reg_ini.F
!||    cfint_reg_ini      ../starter/source/elements/shell/coque/cfint_reg_ini.F
!||--- calls      -----------------------------------------------------
!||    cnloc_mat104_ini   ../starter/source/materials/mat/mat104/cnloc_mat104_ini.F
!||--- uses       -----------------------------------------------------
!||    message_mod        ../starter/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE cnloc_matini(ELBUF_STR,NEL      ,IPM      ,
     .                        BUFMAT   ,TIME     ,VARNL    ,
     .                        FAILURE  )
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE elbufdef_mod      
      USE message_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      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NEL
      TYPE(ELBUF_STRUCT_), TARGET :: ELBUF_STR
      my_real
     .        varnl(nel,*),bufmat(*),time
      TARGET :: bufmat
      INTEGER IPM(NPROPMI,*)
      LOGICAL :: FAILURE
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,K,IR,IS,IT,IADBUF,NPTT,NPTR,NPTS,
     .        IJ(5),IJ1,IJ2,IJ3,IJ4,IJ5,IPG,
     .        ilaw,imat,nuvar,nuparam
      TYPE(buf_lay_), POINTER :: BUFLY
      TYPE(L_BUFEL_), POINTER :: LBUF     
      TYPE(buf_mat_), POINTER :: MBUF
      TYPE(g_bufel_), POINTER :: GBUF
      my_real, 
     .  DIMENSION(:), POINTER :: uparam,uvar,thkn
C=======================================================================
      ! buffer of the first layer
      bufly => elbuf_str%BUFLY(1)
      ! General buffer of the elements of the group
      gbuf  => elbuf_str%GBUF
      ! Global thickness of the shell
      thkn  => gbuf%THK(1:nel)
C
      ! Number of integration points in the thickness
      nptr  = elbuf_str%NPTR
      npts  = elbuf_str%NPTS
      nptt  = bufly%NPTT
      ilaw  = bufly%ILAW
      imat  = bufly%IMAT
      nuvar = bufly%NVAR_MAT
C
      ! Material properties and parameters
      iadbuf  = max(1,ipm(7,imat))
      nuparam = ipm(9,imat) 
      uparam  => bufmat(iadbuf:iadbuf+nuparam)       
C
      DO k=1,5
        ij(k) = nel*(k-1)
      ENDDO
      ij1 = ij(1) + 1
      ij2 = ij(2) + 1
      ij3 = ij(3) + 1
      ij4 = ij(4) + 1
      ij5 = ij(5) + 1
C
      ! Loop over integration points in the plane
      DO ir = 1,nptr
        DO is = 1,npts
          ! Current Gauss point
          ipg  = (is-1)*elbuf_str%NPTR + ir
          ! Loop over thickness integration points
          DO it = 1,nptt       
            ! Integration point buffer
            lbuf => bufly%LBUF(ir,is,it)
            ! Interval variable buffer
            uvar => bufly%MAT(ir,is,it)%VAR
            ! Non-local plastic strain update
            IF (gbuf%G_PLANL > 0) THEN 
              DO i = 1,nel 
                varnl(i,it)   = max(varnl(i,it),zero)
                lbuf%PLANL(i) = lbuf%PLANL(i) + varnl(i,it)
              ENDDO 
            ENDIF
            ! Select the material initialization routine
            SELECT CASE (ilaw)
              CASE(104)
                CALL cnloc_mat104_ini(nel      ,ipg      ,it       ,nuparam  ,nuvar    ,uparam   ,
     .                                uvar     ,lbuf%PLA ,lbuf%OFF ,lbuf%THK ,gbuf%OFF ,lbuf%SIG(ij1),
     .                                lbuf%SIG(ij2),lbuf%SIG(ij3)  ,lbuf%SIG(ij4)      ,lbuf%SIG(ij5),
     .                                thkn     ,lbuf%DMG ,nptr     ,npts     ,nptt     ,bufly        ,
     .                                time     ,varnl(1,it),failure)                  
            END SELECT
            ! Plastic strain to regularize
            IF (gbuf%G_PLANL > 0) THEN 
              DO i = 1,nel 
                varnl(i,it) = lbuf%PLA(i)
              ENDDO
            ENDIF
          ENDDO
        ENDDO
      ENDDO
C-----------
      END