dynain_size.F File Reference

#include "implicit_f.inc"
#include "com01_c.inc"
#include "scr16_c.inc"
#include "param_c.inc"
#include "task_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	dynain_size_c (iparg, elbuf_tab, p0ars, wasz, dynain_data)

Function/Subroutine Documentation

dynain_size_c()

subroutine dynain_size_c	(	integer, dimension(nparg,*)	iparg,
		type (elbuf_struct_), dimension(ngroup), target	elbuf_tab,
		integer	p0ars,
		integer	wasz,
		type (dynain_database), intent(inout)	dynain_data )

Definition at line 33 of file dynain_size.F.

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