upd_outmax.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/.
!||====================================================================
!||    upd_tmax          ../engine/source/output/upd_outmax.F
!||--- called by ------------------------------------------------------
!||    ini_tmax          ../engine/source/output/ini_outmax.F
!||    resol             ../engine/source/engine/resol.F
!||--- calls      -----------------------------------------------------
!||    gps_solid         ../engine/source/output/outmaxsubr.F
!||    gpstra_solid      ../engine/source/output/outmaxsubr.F
!||    my_barrier        ../engine/source/system/machine.F
!||    sig3dpin2h        ../engine/source/output/outmaxsubr.F
!||    tm_dmg_shells     ../engine/source/output/outmaxsubr.F
!||    tm_dmg_solid      ../engine/source/output/outmaxsubr.F
!||    tm_dmgl25_shell   ../engine/source/output/outmaxsubr.F
!||    tm_seq_shell      ../engine/source/output/outmaxsubr.F
!||    tm_seq_solid      ../engine/source/output/outmaxsubr.F
!||    tm_sig_shell      ../engine/source/output/outmaxsubr.F
!||    tm_sig_solid      ../engine/source/output/outmaxsubr.F
!||    tm_stra_shell     ../engine/source/output/outmaxsubr.F
!||    tm_stra_solid     ../engine/source/output/outmaxsubr.F
!||    tm_vonm_shell     ../engine/source/output/outmaxsubr.F
!||    tm_vonm_solid     ../engine/source/output/outmaxsubr.F
!||    upd_tmnorm2       ../engine/source/output/outmaxsubr.F
!||    upd_tmtens        ../engine/source/output/outmaxsubr.F
!||--- uses       -----------------------------------------------------
!||    elbufdef_mod      ../common_source/modules/mat_elem/elbufdef_mod.F90
!||    element_mod       ../common_source/modules/elements/element_mod.F90
!||    outmax_mod        ../common_source/modules/outmax_mod.F
!||    stack_mod         ../engine/share/modules/stack_mod.F
!||====================================================================
      SUBROUTINE upd_tmax(ELBUF_TAB,IPARG   ,GEO     ,PM   ,
     .           IXS  ,IXS10   ,IXS16   ,IXS20   ,IXQ     ,
     .           IXC  ,IXTG   ,IXT    ,IXP     ,IXR     ,
     .           X  ,D       ,V       ,IAD_ELEM,FR_ELEM ,
     .             WEIGHT ,IPM   ,IGEO    ,STACK   ,ITASK   )
C-----------------------------------------------
C   M o d u l e s
C----------------------------------------------- 
      USE elbufdef_mod            
      USE outmax_mod
      USE stack_mod
      use element_mod , only : nixs,nixq,nixc,nixp,nixr,nixt,nixtg
C-----------------------------------------------------------------------
C   I m p l i c i t   T y p e s
C-----------------------------------------------
#include      "implicit_f.inc"
#include      "mvsiz_p.inc"
C-----------------------------------------------
C   C o m m o n   B l o c k s
C-----------------------------------------------
#include      "com01_c.inc"
#include      "com04_c.inc"
#include      "param_c.inc"
#include      "task_c.inc"
#include      "tabsiz_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER, INTENT(IN):: ITASK
      INTEGER, DIMENSION(NPARG,NGROUP) ,INTENT(IN):: IPARG
      INTEGER, DIMENSION(NIXC,NUMELC) ,INTENT(IN):: IXC
      INTEGER, DIMENSION(NIXTG,NUMELTG) ,INTENT(IN):: IXTG
      INTEGER, DIMENSION(NIXS,NUMELS) ,INTENT(IN):: IXS
      INTEGER, DIMENSION(NIXQ,NUMELQ) ,INTENT(IN):: IXQ
      INTEGER, DIMENSION(NIXT,NUMELT) ,INTENT(IN):: IXT
      INTEGER, DIMENSION(NIXP,NUMELP) ,INTENT(IN):: IXP
      INTEGER, DIMENSION(NIXR,NUMELR) ,INTENT(IN):: IXR
      INTEGER, DIMENSION(6,NUMELS10) ,INTENT(IN):: IXS10
      INTEGER, DIMENSION(8,NUMELS16) ,INTENT(IN):: IXS16
      INTEGER, DIMENSION(12,NUMELS20) ,INTENT(IN):: IXS20
      INTEGER, DIMENSION(2,NSPMD+1)   ,INTENT(IN):: IAD_ELEM
      INTEGER, DIMENSION(SFR_ELEM)     ,INTENT(IN):: FR_ELEM
      INTEGER, DIMENSION(NUMNOD)     ,INTENT(IN):: WEIGHT
      INTEGER, DIMENSION(NPROPMI,NUMMAT) ,INTENT(IN):: IPM
      INTEGER, DIMENSION(NPROPGI,NUMGEO) ,INTENT(IN):: IGEO
      my_real, DIMENSION(NPROPG,NUMGEO) ,INTENT(IN):: geo
      my_real, DIMENSION(NPROPM,NUMMAT) ,INTENT(IN):: pm
      my_real, DIMENSION(3,NUMNOD) ,INTENT(IN):: x,d,v
      TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
      TYPE (STACK_PLY) :: STACK
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      INTEGER N, I, NG, ITY, NEL, IVISC, NFT, IFLU, MX, TSHELL, 
     .         IGTYP,ISOLNOD,ISROT,NPTR,NPTS,NPTT,NLAY,NPT,
     .         JHBE,IMAT,IPID,MATLY(MVSIZ*100),IPMAT,IADR,
     .         ISUBSTACK,MTN
      INTEGER  NODFTSK,NODLTSK,NGFTSK,NGLTSK
      TYPE(G_BUFEL_)  ,POINTER :: GBUF     
      TYPE(L_BUFEL_)  ,POINTER :: LBUF  
 
      my_real
     . value(mvsiz),rho,
     . mass(mvsiz)
C-----------------------------------------------
C   S o u r c e   L i n e s
C-----------------------------------------------     
      IF (nmax_e > 0 )THEN   
        ngftsk   = 1+itask*ngroup/ nthread
        ngltsk   = (itask+1)*ngroup/nthread
       DO ng=ngftsk,ngltsk
         IF (iparg(8,ng)==1) cycle                                 
         ity=iparg(5,ng)
         IF (ity /= 1 .AND. ity /= 3 .AND. ity /= 7) cycle
         mtn=iparg(1,ng)
         nel=iparg(2,ng)
         nft=iparg(3,ng)
         ivisc = iparg(61,ng)
         iflu=iparg(7,ng)+iparg(11,ng)
         isolnod = iparg(28,ng)
         igtyp  = iparg(38,ng)
         isrot  = iparg(41,ng)
         jhbe   = iparg(23,ng)
         gbuf => elbuf_tab(ng)%GBUF
        SELECT CASE (ity)
          CASE(1)
            tshell = 0
            IF (igtyp==20 .OR. igtyp==21 .OR. igtyp==22) tshell = 1
            nlay = elbuf_tab(ng)%NLAY                
            nptr = elbuf_tab(ng)%NPTR                 
            npts = elbuf_tab(ng)%NPTS                 
            nptt = elbuf_tab(ng)%NPTT
            IF (tshell==1) THEN
              IF (jhbe==14 .OR. jhbe==15) nptt = 1
              IF (jhbe==16) npts = 1
            ELSE
              nlay = 1 
              IF (isolnod==10 .OR. (isolnod==4 .AND. isrot==1)) THEN
                npts = 1
                nptt = 1
              END IF 
            END IF
            npt  = nptt*npts*nptr*nlay
            IF (gbuf%G_TM_YIELD>0 ) THEN  !VONM main value
              value(1:nel) = zero            
              lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1) 
              CALL tm_vonm_solid(ivisc,gbuf%SIG,lbuf%VISC,VALUE,nel)
              gbuf%TM_YIELD(1:nel)= max(gbuf%TM_YIELD(1:nel),value(1:nel))
            END IF
            IF (gbuf%G_TM_EINT>0 ) THEN  
               value(1:nel) = zero            
               lbuf => elbuf_tab(ng)%BUFLY(1)%LBUF(1,1,1) 
               IF (mtn == 151) cycle
               IF(iflu == 0)THEN
                  mx=ixs(1,nft+1)
                  rho = pm(89,mx)
                  value(1:nel) = gbuf%EINT(1:nel)/max(em20,rho)   !
               ELSE
                  value(1:nel) = gbuf%EINT(1:nel)/max(em20,gbuf%RHO(1:nel))  !
               ENDIF
              gbuf%TM_EINT(1:nel)= max(gbuf%TM_EINT(1:nel),value(1:nel))
            END IF
            IF (gbuf%G_TM_SEQ>0 ) THEN  
              value(1:nel) = zero            
              CALL tm_seq_solid(elbuf_tab(ng),nlay,nptr,npts,nptt,ivisc,VALUE,nel) 
              gbuf%TM_SEQ(1:nel)= max(gbuf%TM_SEQ(1:nel),value(1:nel))
            END IF
            IF (gbuf%G_TM_DMG>0 ) THEN  
              value(1:nel) = zero            
              CALL tm_dmg_solid(elbuf_tab(ng),nlay,nptr,npts,nptt,VALUE,nel)
              gbuf%TM_DMG(1:nel)= max(gbuf%TM_DMG(1:nel),value(1:nel))
            END IF
            IF (gbuf%G_TM_SIG>0) THEN
              CALL tm_sig_solid(elbuf_tab(ng),nlay,nptr,npts,nptt,ivisc,
     .                          gbuf%TM_SIG1,gbuf%TM_SIG3,gbuf%TM_PSIG,nel)
            END IF
            IF (gbuf%G_TM_STRA>0) THEN
              CALL tm_stra_solid(elbuf_tab(ng),nlay,nptr,npts,nptt,
     .                          gbuf%TM_STRA1,gbuf%TM_STRA3,gbuf%TM_PSTRA,nel)
            END IF
          CASE(3,7)
            nlay = elbuf_tab(ng)%NLAY                
            nptr = elbuf_tab(ng)%NPTR                 
            npts = elbuf_tab(ng)%NPTS 
            npt =  elbuf_tab(ng)%BUFLY(1)%NPTT
            isubstack = iparg(71,ng)
            IF(ity == 3)THEN
              imat = ixc(1,nft+1)
              ipid = ixc(6,nft+1)
            ELSE
              imat = ixtg(1,nft+1)
              ipid = ixtg(5,nft+1)
            ENDIF
            IF (gbuf%G_TM_YIELD>0 ) THEN  !VONM main value
              value(1:nel) = zero            
              CALL tm_vonm_shell(gbuf%FOR,VALUE,nel)
              gbuf%TM_YIELD(1:nel)= max(gbuf%TM_YIELD(1:nel),value(1:nel))
            END IF
            IF (gbuf%G_TM_EINT>0 ) THEN  ! /ENER
               value(1:nel) = zero            
               IF (mtn == 151) cycle
               rho = pm(1,imat)
               DO i=1,nel
            mass(i) = rho*gbuf%VOL(i)
                  value(i) = (gbuf%EINT(i)+ gbuf%EINT(i+nel))/max(em20,mass(i))
               ENDDO
              gbuf%TM_EINT(1:nel)= max(gbuf%TM_EINT(1:nel),value(1:nel))
            END IF
            IF (gbuf%G_TM_SEQ>0 ) THEN  
              value(1:nel) = zero            
              CALL tm_seq_shell(elbuf_tab(ng),nlay,nptr,npts,VALUE,nel)
              gbuf%TM_SEQ(1:nel)= max(gbuf%TM_SEQ(1:nel),value(1:nel))
            END IF
            IF (gbuf%G_TM_DMG>0 ) THEN  
              value(1:nel) = zero            
              IF (mtn == 25) THEN
                SELECT CASE (igtyp)
                  CASE(10)
                    DO n=1,npt
                      iadr = (n-1)*nel
                      DO i=1,nel
                        matly(iadr+i)=imat
                      END DO
                    END DO 
                  CASE(11)
                    ipmat = 100            
                    DO n=1,npt
                      iadr = (n-1)*nel
                      DO i=1,nel
                        matly(iadr+i)=igeo(ipmat+n,ipid)
                      END DO
                    END DO 
                  CASE(17,51,52)
                    ipmat = 2 + nlay         
                    DO n=1,nlay
                      iadr = (n-1)*nel         
                      DO i=1,nel
                        matly(iadr+i) = stack%IGEO(ipmat+n,isubstack)
                      END DO          
                    END DO
                END SELECT
                CALL tm_dmgl25_shell(elbuf_tab(ng),nlay,nptr,npts,igtyp,
     .                               pm,matly,VALUE,nel)
              ELSE
                CALL tm_dmg_shells(elbuf_tab(ng),nlay,nptr,npts,VALUE,nel)
              END IF
              gbuf%TM_DMG(1:nel)= max(gbuf%TM_DMG(1:nel),value(1:nel))
            END IF
            IF (gbuf%G_TM_SIG>0) THEN
              CALL tm_sig_shell(elbuf_tab(ng),nlay,nptr,npts,
     .                          gbuf%TM_SIG1,gbuf%TM_SIG3,gbuf%TM_PSIG,nel)
            END IF
            IF (gbuf%G_TM_STRA>0) THEN
              CALL tm_stra_shell(elbuf_tab(ng),nptr,npts,
     .                       gbuf%TM_STRA1,gbuf%TM_STRA3,gbuf%TM_PSTRA,nel)
            END IF
        END SELECT
       END DO
      END IF !(NMAX_E > 0 )THEN   
      IF (nmax_n > 0 )THEN   
        nodftsk   = 1+itask*numnod/ nthread
        nodltsk   = (itask+1)*numnod/nthread
       IF (lmax_dis>0) CALL upd_tmnorm2(d,tm_dis,tm_pdis,nodftsk,nodltsk)
       IF (lmax_vel>0) CALL upd_tmnorm2(v,tm_vel,tm_pvel,nodftsk,nodltsk)
       IF (lmax_nsig>0 .AND.(ncycle <= 1 .OR. mod(ncycle,ncy_gps)==0)) THEN
!$OMP SINGLE
         CALL gps_solid(elbuf_tab,iparg   ,geo     ,pm   ,
     .          ixs  ,ixs10   ,ixs16   ,ixs20   ,ixq     ,
     .          ixc  ,ixtg   ,ixt    ,ixp     ,ixr     ,
     .          x  ,iad_elem,fr_elem ,weight  ,gpstmp  ,igpstag )
!$OMP END SINGLE
         CALL sig3dpin2h(gpstmp,p2tmp,nodftsk,nodltsk,igpstag)
         CALL upd_tmtens(gpstmp,p2tmp,tm_nsig1,tm_nsig3,tm_pnsig,nodftsk,nodltsk,igpstag)
       END IF
C-----------------         
         CALL my_barrier()
C-----------------         
       IF (lmax_nstra>0 .AND.(ncycle <= 1 .OR. mod(ncycle,ncy_gpstr)==0)) THEN
!$OMP SINGLE
           CALL gpstra_solid(elbuf_tab,iparg   ,geo     ,pm   ,
     .          ixs  ,ixs10   ,ixs16   ,ixs20   ,ixq     ,
     .          ixc  ,ixtg   ,ixt    ,ixp     ,ixr     ,
     .          x  ,iad_elem,fr_elem ,weight  ,gpstmp  ,igpstratag)
!$OMP END SINGLE
         CALL sig3dpin2h(gpstmp,p2tmp,nodftsk,nodltsk,igpstratag)
         CALL upd_tmtens(gpstmp,p2tmp,tm_nstra1,tm_nstra3,tm_pnstra,nodftsk,nodltsk,igpstratag)
       END IF
      END IF !(nmax_n > 0 )THEN   
C-----------------         
         CALL my_barrier()
C-----------------         
 
      RETURN
      END