cmatini4.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/.
!||====================================================================
!||    cmatini4               ../starter/source/materials/mat_share/cmatini4.F
!||--- called by ------------------------------------------------------
!||    cbainit3               ../starter/source/elements/shell/coqueba/cbainit3.F
!||    cdkinit3               ../starter/source/elements/sh3n/coquedk/cdkinit3.F
!||--- calls      -----------------------------------------------------
!||    ancmsg                 ../starter/source/output/message/message.F
!||    fretitl2               ../starter/source/starter/freform.F
!||--- uses       -----------------------------------------------------
!||    message_mod            ../starter/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE cmatini4(ELBUF_STR,
     1           JFT    ,JLT    ,NFT   ,NEL    ,ISTRAIN ,
     2           SIGSH  ,NSIGSH ,NUMEL ,IX     ,NIX     ,
     3           NUMSH  ,PTSH   ,IR    ,IS     ,NPT     ,
     4           IGTYP  ,IGEO   ,NLAY  ,NPG    ,IPG     )
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      "param_c.inc"
#include      "com01_c.inc"
#include      "scr17_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER JFT,JLT,NFT,NEL,IR,IS,NPT,NUMEL,NIX,ISTRAIN,NSIGSH,NUMSH,IGTYP,IGEO(NPROPGI,*),NLAY,NPG,IPG
      INTEGER IX(NIX,*),PTSH(*)
      my_real SIGSH(NSIGSH,*)
      TYPE(ELBUF_STRUCT_), TARGET :: ELBUF_STR
C------------------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      CHARACTER(LEN=NCHARTITLE) :: TITR
      INTEGER I,II,J,JJ,N,NPTI,I1,I2,PT,NPGI,NU,NUVAR,NVARS,IPT,NPI,
     .  IPID1,PID1,C1,IPT_ALL,IT,ILAY,NPTT
      TYPE(L_BUFEL_) ,POINTER :: LBUF     
C--------------------------------------------------------------
      DO i=jft,jlt
        IF (abs(isigi)/=3 .AND. abs(isigi)/=4 .AND. abs(isigi)/=5)THEN
          ii = i+nft
          n = nint(sigsh(nvshell + 1,ii))
          IF (n/=ix(nix,ii)) THEN
            jj = ii
            DO j = 1,numel
              ii= j
              n = nint(sigsh(nvshell + 1,ii))
              IF (n == 0) GOTO 200
              IF (n == ix(nix,jj)) GOTO 60
            ENDDO
 60         CONTINUE
          ENDIF
        ELSE
          jj=nft+i
          n =ix(nix,jj)
          ii=ptsh(jj)
          IF (ii == 0) GOTO 200
        ENDIF
C
        npi   = nint(sigsh(nvshell +  2,ii))
        npgi  = nint(sigsh(nvshell +  3,ii))
!!        PT=NVSHELL+3  ! wrong position, overwriting FAIL
        pt = nvshell+nushell+nortshel+nvshell1+3
C
C for IGTYP == 51, usually NPT <= NPTI (NPTI = NTPP --> for all layers)
        IF ((npgi /= npg.OR.npi /= npt) .AND. igtyp /= 51 
     .                                  .AND. igtyp /=52) THEN
          ipid1=ix(nix-1,nft+i)
          pid1=igeo(1,ipid1)
          CALL fretitl2(titr,igeo(npropgi-ltitr+1,ipid1),ltitr)
          CALL ancmsg(msgid=1215, anmode=aninfo, msgtype=msgerror, c1=titr, i1=pid1, i2=n)
C
        ELSE
          IF (npgi > 0) THEN
            IF (npi > 0) THEN
c
              ipt_all = 0
              DO ilay=1,nlay
                nptt  = elbuf_str%BUFLY(ilay)%NPTT
                DO it=1,nptt
                  ipt = ipt_all + it
 
                  lbuf => elbuf_str%BUFLY(ilay)%LBUF(ir,is,it)
                  lbuf%FAC_YLD(i) = sigsh(pt+(ipg-1)*npi+ipt,ii)
                ENDDO
                ipt_all = ipt_all + nptt
              ENDDO  !  DO ILAY=1,NPT
c
            ELSE
!----------------------------------------------------------
!!  ILAY --> not initialised here
!!  SIGSH(PT, II) --> not filled within initia for NIP = 0
!----------------------------------------------------------
!!             LBUF => ELBUF_STR%BUFLY(ILAY)%LBUF(IR,IS,IT)                         
!!             LBUF%FAC_YLD(I) = SIGSH(PT+IPG, II)                                          
            ENDIF ! IF (NPI > 0)
          ELSE
          ENDIF ! IF (NPGI > 0)
        ENDIF ! IF ((NPGI /= NPG.OR.NPI /= NPT) .AND. IGTYP /= 51)
C
200    CONTINUE
C
      ENDDO ! DO I=JFT,JLT
C---
      RETURN
      END