OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
radiatoff.F File Reference
#include "implicit_f.inc"
#include "param_c.inc"
#include "com01_c.inc"
#include "com04_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine radiatoff (ibcr, fradia, iparg, igroups, ixs, elbuf_tab, glob_therm)

Function/Subroutine Documentation

◆ radiatoff()

subroutine radiatoff ( integer, dimension(glob_therm%niradia,*) ibcr,
fradia,
integer, dimension(nparg,*) iparg,
integer, dimension(numels) igroups,
integer, dimension(nixs,*) ixs,
type(elbuf_struct_), dimension(ngroup), target elbuf_tab,
type (glob_therm_), intent(inout) glob_therm )

Definition at line 31 of file radiatoff.F.

32C-----------------------------------------------
33C M o d u l e s
34C-----------------------------------------------
35 USE elbufdef_mod
36 use glob_therm_mod
37C-----------------------------------------------
38C I m p l i c i t T y p e s
39C-----------------------------------------------
40#include "implicit_f.inc"
41C-----------------------------------------------
42C C o m m o n B l o c k s
43C-----------------------------------------------
44#include "param_c.inc"
45#include "com01_c.inc"
46#include "com04_c.inc"
47C-----------------------------------------------
48C D u m m y A r g u m e n t s
49C-----------------------------------------------
50 type (glob_therm_) ,intent(inout) :: glob_therm
51 INTEGER :: IBCR(GLOB_THERM%NIRADIA,*)
52 INTEGER :: IPARG(NPARG,*), IGROUPS(NUMELS), IXS(NIXS,*)
53C
54 my_real fradia(glob_therm%LFACTHER,*)
55 TYPE(ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_TAB
56C-----------------------------------------------
57C L o c a l V a r i a b l e s
58C-----------------------------------------------
59 INTEGER N, JJ, NG, NEL, MLW
60 my_real, DIMENSION(:), POINTER :: offg
61C======================================================================|
62C ACTIVATION/DESACTIVATION DE LA RADIATION
63C------------------------------------------------
64 DO n=1,glob_therm%NUMRADIA
65 IF(ibcr(7,n) == 1) THEN
66C ELEMENTS SOLIDES
67 jj = ibcr(8,n)
68 ng = igroups(jj)
69 mlw= iparg(1,ng)
70 IF (mlw == 0 .OR. mlw == 13) cycle
71 offg => elbuf_tab(ng)%GBUF%OFF
72 fradia(6,n) = offg(ibcr(glob_therm%NIRADIA,n))
73 ENDIF
74 ENDDO
75!-----------
76 RETURN
#define my_real
Definition cppsort.cpp:32