find_dt_for_targeted_added_mass.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/.
!||====================================================================
!||    find_dt_for_targeted_added_mass   ../engine/source/time_step/find_dt_for_targeted_added_mass.F
!||--- called by ------------------------------------------------------
!||    resol                             ../engine/source/engine/resol.F
!||--- calls      -----------------------------------------------------
!||    find_dt_target                    ../common_source/tools/time_step/find_dt_target.F
!||    myqsort                           ../common_source/tools/sort/myqsort.F
!||    spmd_gather_dtnoda                ../engine/source/mpi/generic/spmd_gather_dtnoda.F
!||    spmd_glob_imax9                   ../engine/source/mpi/generic/spmd_glob_imax9.F
!||    spmd_glob_isum9                   ../engine/source/mpi/interfaces/spmd_th.F
!||    spmd_rbcast                       ../engine/source/mpi/generic/spmd_rbcast.F
!||--- uses       -----------------------------------------------------
!||    groupdef_mod                      ../common_source/modules/groupdef_mod.F
!||    message_mod                       ../engine/share/message_module/message_mod.F
!||====================================================================
      SUBROUTINE find_dt_for_targeted_added_mass(MS,STIFN,DTSCA,IGRP_USR,TARGET_DT,
     .                                           PERCENT_ADDMASS,PERCENT_ADDMASS_OLD,TOTMAS,WEIGHT,IGRNOD,
     .                                           ICNDS10)
C-----------------------------------------------
C   A n a l y s e   M o d u l e
C-----------------------------------------------
      USE groupdef_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   D u m m y   A r g u m e n t s
C----------------------------------------------- 
      INTEGER WEIGHT(*),IGRP_USR,ICNDS10(3,*)
      my_real
     .   ms(*),stifn(*),target_dt,dtsca,percent_addmass,percent_addmass_old,totmas
C-----------------------------------------------
      TYPE (GROUP_)  , DIMENSION(NGRNOD) :: IGRNOD
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
#include      "com04_c.inc"
#include      "task_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,SIZ,SIZG,SIZ_MAX,ND,IGROUP
      INTEGER, DIMENSION(:),ALLOCATABLE :: TAGN
      my_real, DIMENSION(:),ALLOCATABLE,TARGET :: 
     .   dt2_l
      my_real, DIMENSION(:),ALLOCATABLE :: 
     .   stf_l,ms_l
      my_real, DIMENSION(:),POINTER ::
     .   tmp
      my_real sumk,summ,target_percent
      INTEGER :: IERROR
      INTEGER, DIMENSION(:), ALLOCATABLE :: PERM
C=======================================================================
C
C--------------------------------------------------------------------------------------
C     DERIVED FROM ADD_MS_L_STAT in starter - computation of time step according to requested % of added mass
C--------------------------------------------------------------------------------------
C 
      siz = 0
      ALLOCATE(tagn(numnod))
      tagn(1:numnod) = 0
C
C---  Condensed nodes of TETRA10 are excluded
      DO i=1,ns10e
        nd = iabs(icnds10(1,i))
        tagn(nd) = -1
      ENDDO 
C
      igroup = 0
      IF (igrp_usr < 0) THEN
        DO i=1,ngrnod
          IF (-igrp_usr==igrnod(i)%ID) igroup = i
        ENDDO
      ELSE
        igroup = igrp_usr
      ENDIF     
C
C---  Count and tag nodes to be taken into account for target_dt computation
      IF (igroup > 0) THEN
        DO i=1,igrnod(igroup)%NENTITY
          n = igrnod(igroup)%ENTITY(i)
          IF ((weight(n)==1).AND.(ms(n)/=zero).AND.(stifn(n)>em20).AND.(tagn(n)==0)) THEN
            tagn(n) = 1
            siz = siz + 1
          ENDIF
        ENDDO
      ELSE
        DO i=1,numnod
          IF ((weight(i)==1).AND.(ms(i)/=zero).AND.(stifn(i)>em20).AND.(tagn(i)==0)) THEN
            tagn(i) = 1
            siz = siz + 1
          ENDIF
        ENDDO
      ENDIF
      sizg = siz
      siz_max = siz
C
C---  Counstruction of arrays
      IF (nspmd > 1) THEN
        CALL spmd_glob_imax9(siz_max,1)
        CALL spmd_glob_isum9(sizg,1)
        IF (ispmd == 0) THEN
          ALLOCATE(dt2_l(2*sizg),stf_l(sizg),ms_l(sizg))
          siz = siz_max
        ENDIF
        CALL spmd_gather_dtnoda(tagn,stifn,ms,weight,siz,dt2_l,stf_l,ms_l)
      ELSE
        ALLOCATE(dt2_l(2*sizg),stf_l(sizg),ms_l(sizg))
        compt = 0
        DO i=1,numnod
          IF (tagn(i) > 0) THEN
            compt = compt + 1
            dt2_l(compt) = ms(i)/stifn(i)
            ms_l(compt) = ms(i)
            stf_l(compt) = stifn(i)
          ENDIF
        ENDDO
      ENDIF
C
      DEALLOCATE(tagn)
C
      IF (ispmd == 0) THEN     
C
        tmp => dt2_l(sizg+1:sizg*2)
        ALLOCATE( perm(sizg ))
C
C  --- Sorting
C
        summ = zero
        sumk = zero
        DO i=1,sizg
          tmp(i)=i
          perm(i) = i
          summ = summ + ms_l(i)
          sumk = sumk + stf_l(i)
        ENDDO
 
        CALL myqsort(sizg,dt2_l,perm,ierror)
        tmp(1:sizg) = perm(1:sizg)
 
        DEALLOCATE( perm )
C
C----- determination of target time step
C
C       in case of rst
C
C       /MASS/RESET -> PERCENT_ADDMASS_OLD has to be reset          
        IF (imassi==1) percent_addmass_old = zero
C
        target_percent = max(zero,percent_addmass - percent_addmass_old)
        percent_addmass_old = percent_addmass
C
        nval = 1
        CALL find_dt_target(ms_l,stf_l,target_dt,target_percent,dt2_l,tmp,dtsca,totmas,nval,sizg)
C
        DEALLOCATE(dt2_l,stf_l,ms_l)  
C
      ENDIF
C
      IF (nspmd > 1) CALL spmd_rbcast(target_dt,target_dt,1,1,0,2)
C
      RETURN
      END