init_th0.F File Reference

#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com10_c.inc"
#include "param_c.inc"
#include "tabsiz_c.inc"

Go to the source code of this file.

Functions/Subroutines
subroutine	init_th0 (iparg, elbuf_tab, igeo, ixr, th, weight)

Function/Subroutine Documentation

init_th0()

subroutine init_th0	(	integer, dimension(nparg,*)	iparg,
		type (elbuf_struct_), dimension(ngroup)	elbuf_tab,
		integer, dimension(npropgi,*)	igeo,
		integer, dimension(nixr,*)	ixr,
		type (th_), intent(in), target	th,
		integer, dimension(numnod), intent(in)	weight )

Definition at line 37 of file init_th0.F.

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
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 MBUFFER, NPARTL
      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,SITHGRP
 
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