dynain_size.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/.
!||====================================================================
!||    dynain_size_c     ../engine/source/output/dynain/dynain_size.f
!||--- called by ------------------------------------------------------
!||    gendynain         ../engine/source/output/dynain/gendynain.F
!||--- calls      -----------------------------------------------------
!||    spmd_glob_isum9   ../engine/source/mpi/interfaces/spmd_th.F
!||--- uses       -----------------------------------------------------
!||    elbufdef_mod      ../common_source/modules/mat_elem/elbufdef_mod.F90
!||    state_mod         ../common_source/modules/state_mod.F
!||====================================================================
      SUBROUTINE dynain_size_c(IPARG ,ELBUF_TAB, P0ARS   ,WASZ  ,DYNAIN_DATA)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE elbufdef_mod  
      USE state_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      "scr16_c.inc"
#include      "param_c.inc"
#include      "task_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IPARG(NPARG,*),
     .        WASZ,P0ARS
      TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
      TYPE (DYNAIN_DATABASE), INTENT(INOUT) :: DYNAIN_DATA
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER JJ,NN,ITY,IAD,NFT,LFT,LLT,NPT,IHBE,
     .        MLW,NG,NEL,I,NPG,MPT,NLAY,NPTR,NPTS,
     .        NPTT,IGTYP,IL,NPT_ALL,
     .        RWASZ,WASZ2,P0ARSZ2,RWASZ2      
C======================================================================|
      p0ars = 0
      wasz = 0
C
      p0arsz2 = 0
      wasz2   = 0
      igtyp = 0
C
      IF (dynain_data%DYNAIN_C(4) == 1) THEN
C------------------------------
C       4: *INITIAL_STRESS_SHELL
C------------------------------
        DO ng=1,ngroup
          ity   = iparg(5,ng)
          nel   = iparg(2,ng)
          igtyp = iparg(38,ng)
          IF (ity == 3 .OR. ity == 7) THEN
            npt =iparg(6,ng)
            mpt =iabs(npt)
            mlw =iparg(1,ng)
            ihbe  = iparg(23,ng)
            nlay  = elbuf_tab(ng)%NLAY
            nptr  = elbuf_tab(ng)%NPTR    
            npts  = elbuf_tab(ng)%NPTS    
c            NPTT  = ELBUF_TAB(NG)%NPTT    
            npg   = nptr*npts
            IF (ity==3.AND.ihbe==23) npg=4
C
C pre counting of all NPTT (especially for PID_51)
C
            IF (igtyp == 51 .OR. igtyp == 52) THEN
              npt_all = 0
              DO il=1,nlay
                npt_all = npt_all + elbuf_tab(ng)%BUFLY(il)%NPTT
              ENDDO
              mpt = max(1,npt_all)
            ENDIF
            IF (mlw == 1 .OR. mlw == 3 .OR. mlw == 23) mpt=0
            IF(mpt == 0) mpt = 3
C
            wasz2 = wasz2 + 5*nel
            IF (mpt == 0) THEN
              wasz2 = wasz2 + 8*npg*nel
            ELSE
              wasz2 = wasz2 + 8*npg*mpt*nel
            ENDIF
          ENDIF
        ENDDO
C
        rwasz2= wasz2
        IF (nspmd > 1) CALL spmd_glob_isum9(rwasz2,1)
        IF (ispmd == 0) p0arsz2 = rwasz2
      ENDIF  !  IF (STAT_C(4) == 1)
C
      p0ars= max(p0ars,p0arsz2)+6
      wasz = max(wasz,wasz2)
C
      p0arsz2 = 0
      wasz2   = 0
C
      IF (dynain_data%DYNAIN_C(5) == 1) THEN
C------------------------------
C       5: *INITIAL_STRAIN_SHELL
C------------------------------
        DO ng=1,ngroup
         ity = iparg(5,ng)
         nel = iparg(2,ng)
         IF (ity == 3.OR.ity == 7) THEN
            npt =iparg(6,ng)
            mpt =iabs(npt)
            mlw =iparg(1,ng)
            ihbe  = iparg(23,ng)
            nlay  = elbuf_tab(ng)%NLAY
            nptr  = elbuf_tab(ng)%NPTR    
            npts  = elbuf_tab(ng)%NPTS    
c            NPTT  = ELBUF_TAB(NG)%NPTT    
            npg   = nptr*npts
            IF (ity==3.AND.ihbe==23) npg=4
C
C pre counting of all NPTT (especially for PID_51)
C
            IF (igtyp == 51 .OR. igtyp == 52) THEN
              npt_all = 0
              DO il=1,nlay
                npt_all = npt_all + elbuf_tab(ng)%BUFLY(il)%NPTT
              ENDDO
              mpt = max(1,npt_all)
            ENDIF
            IF (mlw == 1 .OR. mlw == 3 .OR. mlw == 23) mpt=0
 
            IF(mpt == 0) mpt = 3
C
            wasz2 = wasz2 + 5*nel
            IF (mpt == 0) THEN
              wasz2 = wasz2 + 7*npg*nel
            ELSE
              wasz2 = wasz2 + 7*npg*mpt*nel
            ENDIF
         ENDIF
        ENDDO
cC
        rwasz2= wasz2
        IF (nspmd > 1) CALL spmd_glob_isum9(rwasz2,1)
        IF (ispmd == 0) p0arsz2 = rwasz2
      ENDIF
C
      p0ars= max(p0ars,p0arsz2)+6
      wasz = max(wasz,wasz2)
C
!-----------
      RETURN
      END