imp_init.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/.
!||====================================================================
!||    imp_init       ../engine/source/implicit/imp_init.F
!||--- called by ------------------------------------------------------
!||    resol_init     ../engine/source/engine/resol_init.F
!||--- calls      -----------------------------------------------------
!||    dyna_ini       ../engine/source/implicit/imp_dyna.F
!||    ktbuf_ini      ../engine/source/implicit/imp_init.F
!||    zeror          ../engine/source/system/zero.F
!||--- uses       -----------------------------------------------------
!||    elbufdef_mod   ../common_source/modules/mat_elem/elbufdef_mod.F90
!||    imp_aspc       ../engine/share/modules/impbufdef_mod.F
!||    imp_intm       ../engine/share/modules/imp_intm.F
!||    imp_kbcs       ../engine/share/modules/impbufdef_mod.F
!||====================================================================
      SUBROUTINE imp_init(V,VR,IPARG,IPM,IGEO,ELBUF_TAB)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_aspc
      USE imp_kbcs
      USE imp_intm
      USE elbufdef_mod            
C----6------------------------------------------
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      "com08_c.inc"
#include      "impl1_c.inc"
#include      "impl2_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IPARG(NPARG,NGROUP),IPM(NPROPMI,*),IGEO(*)
      my_real
     .    v(3,*),vr(3,*)
      TYPE(elbuf_struct_), DIMENSION(NGROUP) :: ELBUF_TAB
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER K0,IDEFKZ,IER1,IER2,IFSTRUN
      my_real
     .    trest,cs1(2)
      REAL FLMIN
C----------------------------------------------------------
C   INIT IMPLICIT 
C----------------------------------------------------------
      imconv=1
      inconv =1
C ADD FOR SOLVER AUTO SELECTION
      ifstrun = 1
 
      IF(impl_s==1.OR.neig>0)THEN
       idefkz=0
       IF (neig>0.AND.kz_tol==zero) idefkz=1
       nnsiz=1024
       ikpat=0
       trest=tstop-tt
       IF (d_tol==zero.AND.n_pat>1) d_tol=-one
       IF (d_tol==zero) d_tol=three*em5
       IF (iprec==5)ikpat=1
       IF (iprec==6) THEN
        iprec=5
        ikpat=2
       ENDIF
       IF (sk_int==zero) sk_int=onep01
C--------direct-----
       IF (dt_imp==zero.OR.dt_imp>=trest) dt_imp=trest
       IF (iline==1) THEN
        dt_imp=trest
        IF (kz_tol==zero) kz_tol=two*em4
       ELSE
C--------non-linear-----
        IF (kz_tol==zero) kz_tol=five*em4
       ENDIF
       IF (isprb==1.AND.idyna==0) THEN
         CALL zeror(v,numnod)
         IF (iroddl/=0) CALL zeror(vr,numnod)    
       ENDIF
       IF (nexp==0.OR.idyna==1) nexp=1
       IF (intp_c>=0)THEN
        IF (nspmd>1)THEN
         IF (isolv>=2) intp_c = 1
        ELSE
         intp_c = 0
        ENDIF
       ENDIF
      ENDIF
      IF (neig>0) THEN
         IF (idefkz==1) kz_tol=ten
C         IKG=0
         ikpat=0
         ikpat=1
         IF (iautspc==1) iautspc=0
      ENDIF
 
      IF (idyna>0)CALL dyna_ini(1 ,numnod ,hht_a ,newm_a,newm_b,v,vr)
C
       nspcl = 0
       IF (b_mcore<0) THEN
        lmemn=1000000
       ELSE
        lmemn = 2*lmemv/3
       ENDIF
C       
C      IF(INTP_C<0) IRREF = MAX(2,IRREF)
C      IF(IRREF==1.AND.IDYNA>0) IRREF = 4
C      
      nddl_si = 0
      nddl_sl = 0
      nz_si = 0
      nz_sl = 0
C 
      ihelas=0     
      IF (ikt > 0 .OR.isprb==1) CALL ktbuf_ini(elbuf_tab,iparg ,ipm ,igeo)
C
      idtfix=0     
      IF (nitol==123) THEN
       n_tol=max(n_tole,n_tolf,n_tolu)
      ELSEIF (nitol==12) THEN
       n_tol=max(n_tole,n_tolf)
      ELSEIF (nitol==23) THEN
       n_tol=max(n_tolf,n_tolu)
      ELSEIF (nitol==13) THEN
       n_tol=max(n_tole,n_tolu)
      ENDIF
C
       RETURN
       END
C-----------------------------------------------
!||====================================================================
!||    ktbuf_ini      ../engine/source/implicit/imp_init.F
!||--- called by ------------------------------------------------------
!||    imp_init       ../engine/source/implicit/imp_init.F
!||--- calls      -----------------------------------------------------
!||    ancmsg         ../engine/source/output/message/message.F
!||    arret          ../engine/source/system/arret.F
!||    grpreorder     ../engine/source/implicit/imp_glob_k.F
!||--- uses       -----------------------------------------------------
!||    elbufdef_mod   ../common_source/modules/mat_elem/elbufdef_mod.f90
!||    imp_ktan       ../engine/share/modules/impbufdef_mod.F
!||    imp_ktan_def   ../engine/share/modules/impbufdef_mod.F
!||    message_mod    ../engine/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE ktbuf_ini(ELBUF_TAB, IPARG ,IPM ,IGEO)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_ktan
      USE message_mod
      USE imp_ktan_def
      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      "param_c.inc"
#include      "scr19_c.inc"
#include      "units_c.inc"
#include      "impl1_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IPARG(NPARG,NGROUP),IPM(NPROPMI,*),IGEO(*)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,IFA,IR,IS,IT,NG,BUFLEN,ERR,
     .   NEL,NPT,NPG,MLW,ISORTH,ISRATE,ISROT,IREP,ISIGV,IGTYP,
     .   ISTRA,IFAIL,NFAIL,IEOS,IXFEM,NLAY,NPTR,NPTS,NPTT,NVAR,
     .   NFT,NFT0,KFTS,ITY,JALE,OFF,ISS,ICPRE,NSG,ICNOD,ISNOD,JEUL,
     .   JHBE,JIVF,JPOR,IPLA,L_ETFAC,L_SIGE,L_A_KT,L_SUBKT,LENF,
     .   IGROUC(NGROUP),IG
      TYPE(ktbuf_struct_) , POINTER :: KTBUF
      TYPE(l_ktbufep_)    , POINTER :: LBUF
      TYPE(mlaw_tag_)     , POINTER :: MTAG
      TYPE(elbuf_struct_) , DIMENSION(NGROUP) :: ELBUF_TAB
C=======================================================================
c      Element KT Buffer ini Routine (Solid,Shell)
c------
c      1) allocation of KTBUF_STR
C=======================================================================
      ALLOCATE (ktbuf_str(ngroup), stat=err)
c-------------------------------------------------
       lenf =0
      CALL  grpreorder(iparg, igrouc)
      DO ig = 1,ngroup
        ng = igrouc(ig)
        mlw     = iparg(1,ng)     ! type of material law
        nel     = iparg(2,ng)
        nft     = iparg(3,ng)
        npt     = iparg(6,ng)
        off     = iparg(8,ng)
        ity     = iparg(5,ng)
        jhbe    = iparg(23,ng)
        npg     = iparg(48,ng)
        nlay    = 1
        nptr    = 1
        npts    = 1
        nptt    = 1
c
        IF (mlw == 0 .OR. mlw == 13 .OR. off==1) cycle
c-------------------------------------------------
        l_etfac   = 0
        l_sige   = 0
        l_a_kt  = 0
        l_subkt  = 0
c----------------------------------------------------
       IF (ity == 1) THEN   ! solides
 
        nlay    = elbuf_tab(ng)%NLAY   
        nptr    = elbuf_tab(ng)%NPTR   
        npts    = elbuf_tab(ng)%NPTS   
        nptt    = elbuf_tab(ng)%NPTT   
c       Compatibility :S8(HA8,HC8),S4,S10,S20,SC6
        isnod   = iparg(28,ng)
        ipla    = iparg(29,ng)
        isrot   = iparg(41,ng)
C  create a int table law type-----
        IF (isnod==8 .AND. jhbe/=14 .AND. jhbe/=17) THEN
          WRITE(iout,*)' **WARNING : ONLY ISOLID=14,17 ARE AVAILABLE',
     1             ' WITH CONSISTING TANGENT MATRIX, OPTION IGNORED. '
          WRITE(istdo,*)' **WARNING : ONLY ISOLID=14,17 ARE AVAILABLE',
     1              ' WITH CONSISTING TANGENT MATRIX, OPTION IGNORED. '
C--------add warning for HEPH-HSEPH-S8--
        ELSE
         IF (mlw==42.OR.mlw==62.OR.mlw==69.OR.mlw==82) THEN
          l_etfac=1
          IF (ihelas ==0 ) ihelas=1
         ELSEIF (mlw==2.OR.mlw==36) THEN
          l_etfac=1
          l_sige   = 6
          l_a_kt  = 1
         ENDIF
        END IF
C---- shell 3n,4n
       ELSEIF(ity==3.OR.ity==7) THEN
c       Compatibility :QEPH,QBAT,C3
        IF (jhbe==11) THEN
C-------for the case when DKT18 was available for implicit
          nptr = 1
          npts = npg
          nptt = npt
        ELSE
          nptr  = 1
          npts  = 1
          nptt  = npt
        ENDIF
        IF (nptt == 0 .AND. mlw /= 1) THEN
             CALL ancmsg(msgid=227,anmode=aninfo,
     .            c1='FOR IMPLICIT NONLINEAR')
             CALL arret(2)
        ENDIF
C  create a int table law type-----
         IF (mlw==78) THEN
          l_etfac=1
         ELSEIF (mlw==2.OR.mlw==36) THEN
C------resulting model is not available
          l_etfac=1
          l_sige   = 5  ! (4 : HK, 5: HH)
          l_a_kt  = 1
         END IF !(MLW==2.OR.MLW==36) THEN
       ENDIF   ! el type
c -------------------------------------------------
c       allocation of sub-structures of the element buffer
c-------------------------------------------------
        IF (ity /=1 .AND.ity /=3 .AND.ity /=7 ) cycle
        ALLOCATE (ktbuf_str(ng)%MLAW_TAG(0:maxlaw) ,stat=err)
        ALLOCATE (ktbuf_str(ng)%ETFAC(nel*l_etfac) ,stat=err)
        ALLOCATE (ktbuf_str(ng)%KTBUFEP(nptr,npts,nptt) ,stat=err)
 
        IF (l_etfac>0) ktbuf_str(ng)%ETFAC = one
        mtag => ktbuf_str(ng)%MLAW_TAG(mlw)
        mtag%L_ETFAC=l_etfac
        mtag%L_A_KT =l_a_kt
        mtag%L_SIGE =l_sige
        mtag%L_SUBKT=l_subkt
C        Lenf = lenf + 4
c-------------------------------------------------
c       Local variables per integration point
c-------------------------------------------------
        DO ir = 1,nptr
          DO is = 1,npts
            DO it = 1,nptt
c              GBUF => KTBUF_STR(NG)%KTBUFG(IR,IS,IT)
c              ALLOCATE(GBUF%ETFAC(NEL*L_ETFAC), STAT=ERR)
c              GBUF%ETFAC = ONE
              lbuf => ktbuf_str(ng)%KTBUFEP(ir,is,it)
              ALLOCATE(lbuf%A_KT(nel*l_a_kt), stat=err)
              lbuf%A_KT = zero
              ALLOCATE(lbuf%SIGE(nel*l_sige), stat=err)
              lbuf%SIGE = zero
             lenf = lenf + nel*(l_etfac+l_a_kt+l_sige)
            ENDDO
          ENDDO
        ENDDO
c-------------------------------------------------
        IF (err /= 0) THEN
             CALL ancmsg(msgid=19,anmode=aninfo,
     .            c1='FOR IMPLICIT NONLINEAR')
             CALL arret(2)
        ENDIF
      ENDDO
C      IF (LENF==0 .AND. IKT > 0 ) IKT=0
C-----
      RETURN
      END SUBROUTINE ktbuf_ini
!||====================================================================
!||    iktmat_ini     ../engine/source/implicit/imp_init.F
!||--- called by ------------------------------------------------------
!||    get_etfac_s    ../engine/source/elements/solid/solide8z/get_etfac_s.F
!||    put_etfac      ../engine/source/elements/solid/solide8z/put_etfac.F
!||--- uses       -----------------------------------------------------
!||    imp_ktan       ../engine/share/modules/impbufdef_mod.F
!||    imp_ktan_def   ../engine/share/modules/impbufdef_mod.F
!||====================================================================
      SUBROUTINE iktmat_ini(MTN,IKTMAT)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_ktan
      USE imp_ktan_def
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      "impl1_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER MTN,IKTMAT
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
       IF (ikt == 0 .AND. mtn /=78 ) THEN
        iktmat = 0
       ELSE
        iktmat = ihelas+ktbuf_str(ng_imp)%MLAW_TAG(mtn)%L_ETFAC
       END IF
C       
      RETURN
      END SUBROUTINE iktmat_ini
!||====================================================================
!||    etfac_ini      ../engine/source/implicit/imp_init.F
!||--- called by ------------------------------------------------------
!||    imp_solv       ../engine/source/implicit/imp_solv.F
!||--- calls      -----------------------------------------------------
!||    grpreorder     ../engine/source/implicit/imp_glob_k.F
!||--- uses       -----------------------------------------------------
!||    imp_ktan       ../engine/share/modules/impbufdef_mod.F
!||    imp_ktan_def   ../engine/share/modules/impbufdef_mod.F
!||====================================================================
      SUBROUTINE etfac_ini(IPARG )
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE imp_ktan
      USE imp_ktan_def
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      "impl1_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IPARG(NPARG,NGROUP)
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,IFA,IR,IS,IT,NG,NEL,MLW,JHBE,L_ETFAC,ISNOD,
     .        ITY,OFF,IGROUC(NGROUP),IG
C=======================================================================
      IF (ikt == 0) RETURN
      CALL  grpreorder(iparg, igrouc)
      DO ig = 1,ngroup
        ng = igrouc(ig)
        mlw     = iparg(1,ng)     ! type of material law
        nel     = iparg(2,ng)
        off     = iparg(8,ng)
        ity     = iparg(5,ng)
        jhbe    = iparg(23,ng)
        IF (mlw == 0 .OR. mlw == 13 .OR. off==1) cycle
c-------------------------------------------------
        l_etfac   = 0
c----------------------------------------------------
       IF (ity == 1) THEN   ! solides
        isnod   = iparg(28,ng)
        IF (isnod==8 .AND. jhbe/=14 .AND. jhbe/=17) cycle
        IF (mlw==42.OR.mlw==62.OR.mlw==69.OR.mlw==82) THEN
         l_etfac=1
        ELSEIF (mlw==2.OR.mlw==36) THEN
         l_etfac=1
        ENDIF   ! el type
C---- shell 3n,4n
       ELSEIF(ity==3.OR.ity==7) THEN
        IF (mlw==2.OR.mlw==36.OR.mlw==78) l_etfac=1
       ENDIF   ! el type
c -------------------------------------------------
c       allocation of sub-structures of the element buffer
c-------------------------------------------------
        IF (ity /=1 .AND.ity /=3 .AND.ity /=7 ) cycle
        IF (l_etfac>0) THEN
         DO i=1,nel
          ktbuf_str(ng)%ETFAC(i) = one
         END DO
        END IF
      END DO !IG = 1,NGROUP
C-----
      RETURN
      END SUBROUTINE etfac_ini