add_mass_stat.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/.
!||====================================================================
!||    add_mass_stat    ../starter/source/tools/admas/add_mass_stat.F
!||--- called by ------------------------------------------------------
!||    lectur           ../starter/source/starter/lectur.F
!||--- calls      -----------------------------------------------------
!||--- uses       -----------------------------------------------------
!||    message_mod      ../starter/share/message_module/message_mod.f
!||====================================================================
      SUBROUTINE add_mass_stat(MS,IN,STIFN,STIFR,ITAB,TOTMAS)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE my_alloc_mod
      USE plot_curve_mod
      USE message_mod
C-----------------------------------------------
C     TRI DES DT NODAUX ET IMPRESSIONS
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 ITAB(*)
      my_real
     .   ms(numnod),in(numnod),stifn(numnod),stifr(numnod),totmas
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com04_c.inc"
#include      "units_c.inc"
#include      "scr18_c.inc"
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER I,N,COMPT,K,NVAL
      INTEGER :: IERROR
      INTEGER, DIMENSION(:), ALLOCATABLE :: PERM
      my_real, DIMENSION(:), ALLOCATABLE,TARGET ::
     .   dt
      my_real, DIMENSION(:),POINTER ::
     .   tmp
      my_real dtsca,target_dt_tab(20),per_adm_tab(20),target_dt_tab2(20),summ,sumk
C=======================================================================
C
C--------------------------------------------------------------------------------------
C     DUPLICATED FROM OUTRIN - STATS ON ADDED MASS + TARGET NODAL TIME STEP ESTIMATION
C--------------------------------------------------------------------------------------
C
      ALLOCATE(dt(2*numnod))
      CALL my_alloc(perm,numnod)
      mass0_start = totmas
      dtsca = zep9
C
      tmp => dt(numnod+1:numnod*2)
C 
      DO i=1,numnod
        IF((ms(i)/=zero).AND.(stifn(i)>em20))THEN
          dt(i)=ms(i)/stifn(i)
        ELSE
          dt(i)=ep30       ! -1- free nodes dt=1e30 instead of dt=1416=sqrt(1e6).
                           ! -2- nodal time step from VOID elem (stifn<em20) is dt=EP30 too.
        ENDIF
      ENDDO
C
C  --- Sorting
C
      summ = zero
      sumk = zero
 
      DO i=1,numnod
        tmp(i)=i
        perm(i) = i
        IF (dt(i) < ep30) THEN
          summ = summ + ms(i)
          sumk = sumk + stifn(i)
        ENDIF
      ENDDO
C
      CALL myqsort(numnod,dt,perm,ierror)
      tmp(1:numnod) = perm(1:numnod)
 
      DEALLOCATE( perm )
C
      nval = 20
      DO i=1,20
        per_adm_tab(i) = 0.005*i
      ENDDO
C
C----- Step 1 - determination target time step for targeted added mass (from 1% to 10%) - dtsca = 0.9
C
      dtsca = zep9
      CALL find_dt_target(ms,stifn,target_dt_tab,per_adm_tab,dt,tmp,dtsca,totmas,nval,numnod)
C
C----- Step 2 - determination target time step for targeted added mass (from 1% to 10%) - dtsca = 0.67
C
      dtsca = zep67
      CALL find_dt_target(ms,stifn,target_dt_tab2,per_adm_tab,dt,tmp,dtsca,totmas,nval,numnod)
C
C  -------------------------------------------------------------------------------------------------------------------------
C
      IF (dt(1) < ep20) THEN       
C
C----- Visual output of added mass estimation - only if nodal time step is significant
C
        WRITE(iout,2001)
        WRITE(iout,2002)
        CALL plot_curve(target_dt_tab, per_adm_tab, 20, input_size_x=60, input_size_y=24,
     .                  input_txt_x="TARGET TIME STEP",input_txt_y="DM/M - at first cycle - scaling factor = 0.9",input_symbol="*")
C
        WRITE(iout,3000) '            DM/M at first cycle        ','Target time step - scaling factor = 0.9',
     .                   'Target time step - scaling factor = 0.67'
        WRITE(IOUT,3000) '  -------------------------------------','---------------------------------------',
     .                   '---------------------------------------'
C
        DO I=1,5
          K = 2*I
          WRITE(IOUT,3001) PER_ADM_TAB(K),TARGET_DT_TAB(K),TARGET_DT_TAB2(K)
        ENDDO
C
        WRITE(IOUT,4001)
        WRITE(IOUT,4002)
C
      ENDIF
 
C-----------
      DEALLOCATE( DT)
 
C-----------
 2001 FORMAT(//,'     initial added mass estimation for /dt/noda/cst')
 2002 FORMAT(   '     ----------------------------------------------',//)
C
 3000 FORMAT(2X,A,2X,'|',2x,a,2x,'|',2x,a)
 3001 FORMAT(17x,1pg9.3,17x,'|',17x,1pg9.3,17x,'|',17x,1pg9.3)
C
 4001 FORMAT(//,'    WARNING : These added mass estimations are valid at first cycle only.')
 4002 FORMAT('    Because of element deformation or contacts the added mass can increase during the run',//)
C----------
 
      RETURN
      END