init_th0.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/.
!||====================================================================
!||    init_th0           ../engine/source/output/th/init_th0.F
!||--- called by ------------------------------------------------------
!||    radioss2           ../engine/source/engine/radioss2.F
!||--- calls      -----------------------------------------------------
!||    init_th            ../engine/source/output/th/init_th.F
!||--- uses       -----------------------------------------------------
!||    cluster_mod        ../engine/share/modules/cluster_mod.F
!||    elbufdef_mod       ../common_source/modules/mat_elem/elbufdef_mod.F90
!||    element_mod        ../common_source/modules/elements/element_mod.F90
!||    groupdef_mod       ../common_source/modules/groupdef_mod.F
!||    stack_mod          ../engine/share/modules/stack_mod.F
!||    th_mod             ../engine/share/modules/th_mod.F
!||    time_history_mod   ../common_source/modules/output/time_history_mod.F
!||====================================================================
        SUBROUTINE init_th0( IPARG,ELBUF_TAB,IGEO,IXR,TH,
     .                       WEIGHT)
C-----------------------------------------------
C   M o d u l e s
C-----------------------------------------------
      USE elbufdef_mod         
      USE cluster_mod        
      USE stack_mod
      USE groupdef_mod
      USE th_mod
      USE time_history_mod
      use element_mod , only : nixr
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      "com04_c.inc"
#include      "com10_c.inc"
#include      "param_c.inc"
#include      "tabsiz_c.inc"
C-----------------------------------------------
C   D u m m y   A r g u m e n t s
C-----------------------------------------------
      INTEGER IPARG(NPARG,*),IGEO(NPROPGI,*),IXR(NIXR,*)
      INTEGER, DIMENSION(NUMNOD), INTENT(in) :: WEIGHT
C     REAL
      TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
      TYPE (TH_), INTENT(IN),TARGET :: TH
C-----------------------------------------------
C   L o c a l   V a r i a b l e s
C-----------------------------------------------
      LOGICAL :: BOOL
      INTEGER :: ID,LOCAL_ID      
      INTEGER, POINTER :: ITHGR,ITHB
      INTEGER, DIMENSION(10) :: ALREADY_DONE
      INTEGER :: SITHBUF
 
C=======================================================================
 
C-------------------------------------------------------
C    TH GROUP
C-------------------------------------------------------
        already_done(1:10) = 0
 
        DO id=1,9
            IF(nthgrp01(id)/=0) THEN
                IF(id==1) THEN
                    ithgr => th%ITHGRPA(1)
                    ithb=> th%ITHBUFA(1)
                    sithbuf = th%SITHBUFA
                ENDIF
                IF(id==2) THEN
                    ithgr => th%ITHGRPB(1)
                    ithb=> th%ITHBUFB(1)
                    sithbuf = th%SITHBUFB
                ENDIF
                IF(id==3) THEN
                    ithgr => th%ITHGRPC(1)
                    ithb  =>th%ITHBUFC(1)
                    sithbuf = th%SITHBUFC
                ENDIF
                IF(id==4) THEN
                    ithgr => th%ITHGRPD(1)
                    ithb  => th%ITHBUFD(1)
                    sithbuf = th%SITHBUFD
                ENDIF
                IF(id==5) THEN
                    ithgr => th%ITHGRPE(1)
                    ithb  => th%ITHBUFE(1)
                    sithbuf = th%SITHBUFE
                ENDIF
                IF(id==6) THEN
                    ithgr => th%ITHGRPF(1)
                    ithb  => th%ITHBUFF(1)
                    sithbuf = th%SITHBUFF
                ENDIF
                IF(id==7) THEN
                    ithgr => th%ITHGRPG(1)
                    ithb  => th%ITHBUFG(1)
                    sithbuf = th%SITHBUFG
                ENDIF
                IF(id==8) THEN
                    ithgr => th%ITHGRPH(1)
                    ithb  => th%ITHBUFH(1)
                    sithbuf = th%SITHBUFH
                ENDIF
                IF(id==9) THEN
                    ithgr => th%ITHGRPI(1)
                    ithb  => th%ITHBUFI(1)
                    sithbuf = th%SITHBUFI
                ENDIF
                already_done(id) = 1
                CALL init_th(iparg,ithb,elbuf_tab,igeo,ixr,
     .                       ithgr,nthgrp1(id),id,weight,sithbuf)
            ENDIF
        ENDDO
 
        id = 10
        already_done(id) = 1
        CALL init_th(iparg,th%ITHBUF,elbuf_tab,igeo,ixr,
     .               th%ITHGRP,nthgrp,id,weight,th%SITHBUF)
 
        DO id=1,9
            bool=.false.
            IF(abfile(id)/=0) THEN
                IF(id==2.OR.id==4.OR.id==5.OR.id==6.OR.id==7.OR.id==8.OR.id==9) THEN
                    local_id = 1
                    IF(already_done(local_id)==0) THEN
                        ithgr => th%ITHGRPA(1)
                        ithb=> th%ITHBUFA(1)  
                        bool=.true.
                    ENDIF
                
                ELSEIF(id==3) THEN
                    local_id = 2
                    IF(already_done(local_id)==0) THEN
                        ithgr => th%ITHGRPB(1)
                        ithb=> th%ITHBUFB(1)  
                        bool=.true.
                    ENDIF
                ENDIF
            ENDIF
            IF(bool.EQV..true.) THEN
                already_done(local_id)=1
                CALL init_th(iparg,ithb,elbuf_tab,igeo,ixr,
     .                       ithgr,nthgrp1(id),id,weight,th%SITHBUF)
            ENDIF
        ENDDO
                        
 
        RETURN
        END SUBROUTINE init_th0