sms_auto_dt.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/.
!||====================================================================
!||    sms_auto_dt      ../starter/source/ams/sms_auto_dt.F
!||--- called by ------------------------------------------------------
!||    initia           ../starter/source/elements/initia/initia.F
!||--- calls      -----------------------------------------------------
!||    nod_sms_dt       ../starter/source/ams/sms_auto_dt.F
!||    nod_sms_dt_sol   ../starter/source/ams/sms_auto_dt.F
!||--- uses       -----------------------------------------------------
!||====================================================================
      SUBROUTINE sms_auto_dt(DTELEM,NATIV_SMS,
     1  IXS     ,IXQ      ,IXC     ,IXT     ,IXP       ,
     2  IXR     ,IXTG     ,IXS10   ,IXS16   ,IXS20     ,
     3  IPARTS  ,IPARTQ   ,IPARTC  ,IPARTT  ,IPARTP    ,
     4  IPARTR  ,IPARTG  ,IPARTX  ,IPART     ,
     5  IPARG   ,ELBUF_TAB,IGEO    ,IDDLEVEL,TAGPRT_SMS)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------                     
      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      "scr17_c.inc"
#include      "sphcom.inc"
#include      "units_c.inc"
#include      "sms_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER NATIV_SMS(*),IPART(LIPART1,*),
     .   IXS(NIXS,*),IXS10(6,*) ,IXS16(8,*) ,IXS20(12,*),
     .   IXQ(NIXQ,*),IXC(NIXC,*), IXT(NIXT,*), IXP(NIXP,*),
     .   IXR(NIXR,*),IXTG(NIXTG,*),IPARTS(*),IPARTQ(*),IPARTC(*),
     .   IPARTT(*),IPARTP(*),IPARTR(*),IPARTG(*),IPARTX(*),
     .   iparg(nparg,ngroup),igeo(npropgi,*),iddlevel, tagprt_sms(*)
      my_real
     .   dtelem(*)
C
      TYPE(elbuf_struct_), TARGET, DIMENSION(NGROUP) :: ELBUF_TAB
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,NEL,IAD,NFT,ITY,ISOL,NG,NUMEL,
     .   compt_part(npart),compt_tot_part(npart),compt(7),compt_tot,
     .   nume(7),dt_index(7)
      CHARACTER FILNAM*109, KEYA*80, KEYA2*80
      CHARACTER*12 :: TYPE_ELEM(7)
      my_real
     .   ratio
C-----------------------------------------------
C   D e r i v e d   T y p e   D e f i n i t i o n s
C-----------------------------------------------
      TYPE(g_bufel_)  ,POINTER :: GBUF
C-----------------------------------------------
C
C     Selection of elements for AMS based on time step
C     must be launched 2 times (iddlevel = 0/1) 
C     because GBUF%ISMS is cleared after the end of first pass
C
C-----------------------------------------------
C
C-----------------------------------------------
C     Remplissage de ISMS pour les elements selectionnes par PART
C-----------------------------------------------
C
      IF(isms_selec==1 .OR. isms_selec==2 .OR. isms_selec==4)THEN
 
        DO ng=1,ngroup
C
          nel = iparg(2,ng) 
          nft = iparg(3,ng)
          iad = iparg(4,ng) 
          ity = iparg(5,ng)
          isol = iparg(28,ng)
          gbuf => elbuf_tab(ng)%GBUF
C
          IF(ity==1)THEN
            DO i=1,nel
              IF(tagprt_sms(iparts(nft+i))/=0) gbuf%ISMS(i)=1
            END DO
          ELSEIF(ity==3)THEN
            DO i=1,nel
              IF(tagprt_sms(ipartc(nft+i))/=0) gbuf%ISMS(i)=1
            END DO
          ELSEIF(ity==7)THEN
            DO i=1,nel
              IF(tagprt_sms(ipartg(nft+i))/=0) gbuf%ISMS(i)=1
            END DO
          ELSEIF(ity==4)THEN
            DO i=1,nel
              IF(tagprt_sms(ipartt(nft+i))/=0) gbuf%ISMS(i)=1
            END DO
          ELSEIF(ity==5)THEN
            DO i=1,nel
              IF(tagprt_sms(ipartp(nft+i))/=0) gbuf%ISMS(i)=1
            END DO
          ELSEIF(ity==6)THEN
            DO i=1,nel
              IF(tagprt_sms(ipartr(nft+i))/=0) gbuf%ISMS(i)=1
            END DO
          END IF
        END DO
C                  
        IF(isms_selec==1 .OR. isms_selec==2) RETURN
C     
      END IF
C
C-----------------------------------------------
C     Calcul des index dans dtelem pour chaque type d'element
C-----------------------------------------------
C
      numel= numelc+numels+numelt+numelq+numelp+numelr+numeltg
     .      +numelx+numsph+numelig3d
C
      nume(1) = numels
      nume(2) = numelq
      nume(3) = numelc
      nume(4) = numelt
      nume(5) = numelp
      nume(6) = numelr
      nume(7) = numeltg    
      dt_index(1)  = 0
      DO i=2,7
        dt_index(i)  = dt_index(i-1)  + nume(i-1)
      END DO
C
      compt(1:7) = 0
      compt_part(1:npart) = 0
      compt_tot_part(1:npart) = 0
C
      type_elem(1)='SOLID'
      type_elem(3)='SHELL-4NODES'
      type_elem(4)='TRUSS'
      type_elem(5)='BEAM'
      type_elem(6)='SPRING'
      type_elem(7)='SHELL-3NODES'
C
C--------------------------------------------------
C     Identification des elements a switcher en AMS
C--------------------------------------------------
C
      DO ng=1,ngroup
C
        nel = iparg(2,ng) 
        nft = iparg(3,ng)
        iad = iparg(4,ng) 
        ity = iparg(5,ng)
        isol = iparg(28,ng)
        gbuf => elbuf_tab(ng)%GBUF
C
        IF (ity == 1) THEN
C
          CALL nod_sms_dt(numnod,gbuf%ISMS,nel,nft,nixs ,1 ,8 ,
     .        ixs ,nativ_sms,dtelem,ity,dt_index(ity),
     .        iparts,compt(ity),compt_part,compt_tot_part,igeo,ipart,tagprt_sms)
C
C    Tag of additional nodes for solides with more than 8 nodes
C
          IF (isol==10) CALL nod_sms_dt_sol(numnod,gbuf%ISMS,nel,nft,6 ,numels8,
     .        ixs10 ,nativ_sms)
          IF (isol==20) CALL nod_sms_dt_sol(numnod,gbuf%ISMS,nel,nft,12,numels8+numels10,
     .        ixs20 ,nativ_sms)
          IF (isol==16) CALL nod_sms_dt_sol(numnod,gbuf%ISMS,nel,nft,8 ,numels8+numels10+numels20,
     .        ixs16 ,nativ_sms)
C
        ELSEIF (ity==3) THEN
C                                        
          CALL nod_sms_dt(numnod,gbuf%ISMS,nel,nft,nixc ,1 ,4 ,
     .        ixc ,nativ_sms,dtelem,ity,dt_index(ity),
     .        ipartc,compt(ity),compt_part,compt_tot_part,igeo,ipart,tagprt_sms)
C
        ELSEIF (ity==7) THEN
C
          CALL nod_sms_dt(numnod,gbuf%ISMS,nel,nft,nixtg,1 ,3 ,
     .        ixtg,nativ_sms,dtelem,ity,dt_index(ity),
     .        ipartg,compt(ity),compt_part,compt_tot_part,igeo,ipart,tagprt_sms)
C
        ELSEIF (ity==4) THEN
C
          CALL nod_sms_dt(numnod,gbuf%ISMS,nel,nft,nixt ,1 ,2 ,
     .        ixt ,nativ_sms,dtelem,ity,dt_index(ity),
     .        ipartt,compt(ity),compt_part,compt_tot_part,igeo,ipart,tagprt_sms)
C
        ELSEIF (ity==5) THEN
C
          CALL nod_sms_dt(numnod,gbuf%ISMS,nel,nft,nixp ,1 ,2 ,
     .        ixp ,nativ_sms,dtelem,ity,dt_index(ity),
     .        ipartp,compt(ity),compt_part,compt_tot_part,igeo,ipart,tagprt_sms)
C
        ELSEIF (ity==6) THEN
C
          CALL nod_sms_dt(numnod,gbuf%ISMS,nel,nft,nixr ,1 ,2 ,
     .        ixr ,nativ_sms,dtelem,ity,dt_index(ity),
     .        ipartr,compt(ity),compt_part,compt_tot_part,igeo,ipart,tagprt_sms)
C
        ENDIF
C
      ENDDO
C
      compt_tot = 0
      DO i=1,7
        compt_tot = compt_tot + compt(i)
      ENDDO
C
C------------------------------------------------------------------
C     Printout of selected elements - only at first call of initia
C------------------------------------------------------------------
C
      IF (iddlevel == 0) THEN
C
        WRITE(iout,1000)
        WRITE(iout,1001)
        IF (compt_tot>0) THEN
          WRITE(iout,2000) compt_tot
          ratio = 100*real(compt_tot)/real(max(1,numel))
          WRITE(iout,2001) ratio
          WRITE(iout,2010)
          WRITE(iout,2011)
          DO i=1,7
            IF (compt(i)>0) WRITE(iout,'(7X,A12,I10)') type_elem(i),compt(i)
          END DO
          WRITE(iout,2020)
          WRITE(iout,2011)
          WRITE(iout,2021)
          DO i=1,npart
            IF ((compt_part(i)>0).AND.(compt_tot_part(i)>0)) THEN
              ratio = 100*real(compt_part(i))/real(compt_tot_part(i))
              WRITE(iout,'(4X,I10,19X,I10,12X,F16.1)') ipart(4,i),compt_part(i),ratio
            ENDIF
          ENDDO
        ELSE
          WRITE(iout,3000)
        ENDIF
C
      ENDIF
C                  
C------------------------------------------- 
      RETURN
C
 1000 FORMAT(//,9x,'AUTOMATIC SELECTION OF ELEMENTS FOR AMS')
 1001 FORMAT(9x,'---------------------------------------',/)
 
 2000 FORMAT(3x,'TOTAL NUMBER OF ELEMENTS SELECTED ',i10)
 2001 FORMAT(3x,'% OF ELEMENTS SELECTED IN THE MODEL',f16.1)
 2010 FORMAT(/,3x,'REPARTITION OF SELECTED ELEMENTS BY TYPES')
 2011 FORMAT(3x,'-----------------------------------------')
 2020 FORMAT(/,3x,'REPARTITION OF SELECTED ELEMENTS BY PARTS')
 2021 FORMAT(7x,'PART ID',6x,'NB OF ELEMENTS SELECTED',6x,'% OF ELEMENTS SELECTED')
 
 3000 FORMAT(2x,'no elements selected for ams activation')
 
      END
 
!||====================================================================
!||    nod_sms_dt    ../starter/source/ams/sms_auto_dt.F
!||--- called by ------------------------------------------------------
!||    sms_auto_dt   ../starter/source/ams/sms_auto_dt.F
!||====================================================================
      SUBROUTINE nod_sms_dt(
     1 NUMNOD  ,TAGEL_SMS,NEL,NFT,NIX ,MIX ,LIX_INPUT,
     2 IX      ,TAGN_SMS,DTELEM,ITY,DT_INDEX,
     3 IPART   ,COMPT,COMPT_PART,COMPT_TOT_PART,IGEO,IPARTG,TAGPRT_SMS)
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
#include      "sms_c.inc"
#include      "scr17_c.inc"
#include      "param_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER  NUMNOD   , NIX  ,MIX, LIX_INPUT,
     .         IX(NIX,*), TAGN_SMS(*),NEL,
     .         IPART(*),COMPT_PART(*),COMPT_TOT_PART(*),COMPT,ID_PART,
     .         TAGEL_SMS(*),NFT,ITY,DT_INDEX,IGEO(NPROPGI,*),IPARTG(LIPART1,*),TAGPRT_SMS(*)
      my_real
     .   DTELEM(*)
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J, K, TAG(NUMNOD), ID_ELT, IGTYP, IGG, LIX
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
C   
      DO j=1,nel
        id_elt = nft + j
        id_part = ipart(id_elt)
        igg = ipartg(2,id_part)
        igtyp =  igeo(11,igg)
        IF (tagprt_sms(id_part)==0) compt_tot_part(id_part) = compt_tot_part(id_part) + 1
C
        IF(dtelem(dt_index+id_elt)>dt_sms_switch) cycle
C
C---   Third node must be taken into account for spring pulley
        lix = lix_input
        IF ((ity==6).AND.(igtyp==12)) lix = 3
C
        DO k=1,lix                               
          i = ix(mix+k,id_elt) 
          IF(i/=0) tag(i)=0
        ENDDO                                    
        DO k=1,lix                               
          i = ix(mix+k,id_elt) 
          IF(i/=0)THEN
            IF(tag(i)==0)THEN
              tagn_sms(i)=1
              tag(i)=1
            END IF        
          END IF        
        ENDDO
        IF (tagprt_sms(id_part)==0) THEN
          compt = compt + 1
          compt_part(id_part) = compt_part(id_part) + 1
        ENDIF
 
C---   Tag per element
        tagel_sms(j) = 1
C                          
      ENDDO 
C
      RETURN
      END
 
!||====================================================================
!||    nod_sms_dt_sol   ../starter/source/ams/sms_auto_dt.F
!||--- called by ------------------------------------------------------
!||    sms_auto_dt      ../starter/source/ams/sms_auto_dt.F
!||--- uses       -----------------------------------------------------
!||    sms_mod          ../starter/share/modules1/sms_mod.F
!||====================================================================
      SUBROUTINE nod_sms_dt_sol(
     1 NUMNOD  ,TAGEL_SMS ,NEL  ,NFT     ,NIX ,OFFSET,
     2 IXS  ,TAGN_SMS)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE sms_mod
C-----------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER  NUMNOD   , NIX, OFFSET,
     .         IXS(NIX,*), TAGN_SMS(*),NEL,TAGEL_SMS(*),NFT
C-----------------------------------------------
C   L o c a l  V a r i a b l e s
C-----------------------------------------------
      INTEGER I, J, K, TAG(NUMNOD), ID_ELT, ID_ELT_B
C-----------------------------------------------
C   S o u r c e  L i n e s
C-----------------------------------------------
C   
      DO j=1,nel
        id_elt = nft + j
        id_elt_b = nft + j - offset
C
        IF (tagel_sms(j) == 1) THEN
C
C-- > Tag of additional nodes for selected solides with more than 8 nodes      
C
          DO k=1,nix                               
            i = ixs(k,id_elt_b) 
            IF(i/=0) tag(i)=0
          ENDDO                                    
          DO k=1,nix                               
            i = ixs(k,id_elt_b) 
            IF(i/=0)THEN
              IF(tag(i)==0)THEN
                tagn_sms(i)=1
                tag(i)=1
              END IF        
            END IF        
          ENDDO
C
        ENDIF
C                          
      ENDDO 
C
      RETURN
      END