find_dt_for_targeted_added_mass.F File Reference

#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "task_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	find_dt_for_targeted_added_mass (ms, stifn, dtsca, igrp_usr, target_dt, percent_addmass, percent_addmass_old, totmas, weight, igrnod, icnds10)

Function/Subroutine Documentation

find_dt_for_targeted_added_mass()

subroutine find_dt_for_targeted_added_mass	(		ms,
			stifn,
			dtsca,
		integer	igrp_usr,
			target_dt,
			percent_addmass,
			percent_addmass_old,
			totmas,
		integer, dimension(*)	weight,
		type (group_), dimension(ngrnod)	igrnod,
		integer, dimension(3,*)	icnds10 )

Definition at line 38 of file find_dt_for_targeted_added_mass.F.

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