OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i25main_opt_tri.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| i25main_opt_tri ../engine/source/interfaces/intsort/i25main_opt_tri.F
25!||--- called by ------------------------------------------------------
26!|| inttri ../engine/source/interfaces/intsort/inttri.F
27!||--- calls -----------------------------------------------------
28!|| i25irtlm ../engine/source/interfaces/int25/i25irtlm.F
29!|| i25optcd ../engine/source/interfaces/intsort/i25optcd.F
30!|| i25optcd_e2s ../engine/source/interfaces/intsort/i25optcd_e2s.F
31!|| i25optcd_edg ../engine/source/interfaces/intsort/i25optcd_edg.F
32!|| my_barrier ../engine/source/system/machine.F
33!|| upgrade_cand_opt ../common_source/interf/upgrade_multimp.F
34!||--- uses -----------------------------------------------------
35!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
36!|| tri7box ../engine/share/modules/tri7box.F
37!||====================================================================
38 SUBROUTINE i25main_opt_tri(
39 1 NIN ,IPARI ,INTBUF_TAB,X ,V ,
40 2 ITASK ,ITAB ,KINET ,COUNT_REMSLV,
41 3 COUNT_REMSLVE, NB_CANDT, I_OPT_STOK )
42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE intbufdef_mod
46 USE tri7box
47C-----------------------------------------------
48C I m p l i c i t T y p e s
49C-----------------------------------------------
50#include "implicit_f.inc"
51#include "comlock.inc"
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "com04_c.inc"
56#include "com08_c.inc"
57#include "param_c.inc"
58#include "warn_c.inc"
59#include "task_c.inc"
60C-----------------------------------------------
61C D u m m y A r g u m e n t s
62C-----------------------------------------------
63 INTEGER IPARI(NPARI,NINTER),ITASK, NIN, ITAB(*), KINET(*),
64 . COUNT_REMSLV(*), NB_CANDT, I_OPT_STOK
65 INTEGER :: COUNT_REMSLVE(*)
66C REAL
67 my_real
68 . x(*), v(3,*)
69 TYPE(intbuf_struct_) INTBUF_TAB
70C-----------------------------------------------
71C L o c a l V a r i a b l e s
72C-----------------------------------------------
73 INTEGER NSNR, IGAP, I_STOK_GLO, SIZOPT, IEDGE, NEDGE, IGAP0, I_STOK, L_STOK
74 INTEGER N, NSNF, NSNL, NSNRF, NSNRL ,IFQ
75 INTEGER :: NRTM, NSN
76C REAL
77 my_real
78 . startt, stopt, drad, dgapload
79C-----------------------------------------------------------
80C Prepare IRTLM
81C - IRTLM/=0 <=> at the beginning of CAND_OPT
82C-----------------------------------------------------------
83!$OMP SINGLE
84 CALL i25irtlm(
85 1 ipari ,intbuf_tab ,itab ,nin )
86!$OMP END SINGLE
87C-----------------------------------------------------------
88 startt=intbuf_tab%VARIABLES(3)
89 stopt =intbuf_tab%VARIABLES(11)
90 IF(startt>tt.OR.tt>stopt) RETURN
91C-----------------------------------------------------------
92 nrtm =ipari(4,nin)
93 nsn =ipari(5,nin)
94 nsnr =ipari(24,nin)
95 igap =ipari(21,nin)
96 ifq = ipari(31,nin)
97 drad = zero
98 IF(ipari(47,nin) > 0) drad =intbuf_tab%VARIABLES(32)
99 dgapload =intbuf_tab%VARIABLES(46)
100C-----------------------------------------------------------
101C Filtrage des candidats a l'impact
102C (si candidat retenu, cand_n(i) = - cand_n(i))
103C-----------------------------------------------------------
104 i_stok_glo = intbuf_tab%I_STOK(1)
105 IF (debug(3)>=1) THEN
106 IF(itask==0) nb_candt = nb_candt + i_stok_glo
107 ENDIF
108 sizopt = intbuf_tab%S_CAND_OPT_N
109C
110C I_OPT_STOK modifie ds i25optcd, apres barriere !
111!$OMP SINGLE
112 i_opt_stok = intbuf_tab%I_STOK(2)
113!$OMP END SINGLE NOWAIT
114 CALL i25optcd(
115 1 intbuf_tab%NSV,intbuf_tab%CAND_E,intbuf_tab%CAND_N,x,i_stok_glo ,
116 2 intbuf_tab%IRECTM,intbuf_tab%GAP_S,intbuf_tab%GAP_M,v,ipari(39,nin),
117 3 intbuf_tab%STFNS,itask ,intbuf_tab%STFM,nin ,ipari(5,nin) ,
118 4 intbuf_tab%IRTLM,intbuf_tab%TIME_S,intbuf_tab%MSEGLO,count_remslv,itab,
119 5 intbuf_tab%SECND_FR,nsnr ,intbuf_tab%PENE_OLD,intbuf_tab%STIF_OLD,
120 . intbuf_tab%MSEGTYP24,
121 6 nrtm ,intbuf_tab%VARIABLES(23),i_opt_stok,intbuf_tab%CAND_OPT_E,
122 . intbuf_tab%CAND_OPT_N,
123 7 sizopt,igap ,intbuf_tab%GAP_SL,intbuf_tab%GAP_ML,drad,
124 8 dgapload,intbuf_tab%ICONT_I)
125C
126C I_OPT_STOK modifie ds i25optcd, avant barriere
127 IF(i_opt_stok > sizopt)THEN
128C
129 IF(itask==0)THEN
130 CALL upgrade_cand_opt(nin,i_opt_stok-intbuf_tab%I_STOK(2),intbuf_tab)
131 END IF
132C
133 CALL my_barrier
134C
135C I_OPT_STOK modifie ds i25optcd, apres barriere !
136 sizopt = intbuf_tab%S_CAND_OPT_N
137 i_opt_stok = intbuf_tab%I_STOK(2)
138 CALL i25optcd(
139 1 intbuf_tab%NSV,intbuf_tab%CAND_E,intbuf_tab%CAND_N,x,i_stok_glo ,
140 2 intbuf_tab%IRECTM,intbuf_tab%GAP_S,intbuf_tab%GAP_M,v,ipari(39,nin),
141 3 intbuf_tab%STFNS,itask ,intbuf_tab%STFM,nin ,ipari(5,nin) ,
142 4 intbuf_tab%IRTLM,intbuf_tab%TIME_S,intbuf_tab%MSEGLO,count_remslv,itab,
143 5 intbuf_tab%SECND_FR,nsnr ,intbuf_tab%PENE_OLD,intbuf_tab%STIF_OLD,
144 . intbuf_tab%MSEGTYP24,
145 6 nrtm ,intbuf_tab%VARIABLES(23),i_opt_stok,intbuf_tab%CAND_OPT_E,
146 . intbuf_tab%CAND_OPT_N,
147 7 sizopt,igap ,intbuf_tab%GAP_SL,intbuf_tab%GAP_ML ,drad ,
148 8 dgapload,intbuf_tab%ICONT_I)
149 END IF
150C
151C I_OPT_STOK modifie ds i25optcd, avant barriere
152!$OMP SINGLE
153 intbuf_tab%I_STOK(2)=i_opt_stok
154 ! nowait is ok, because there is a barrier in INTTRI
155!$OMP END SINGLE NOWAIT
156C
157Cf barrier at the end of i25optcd
158 nsnf = 1 + itask*nsn / nthread
159 nsnl = (itask+1)*nsn / nthread
160 DO n = nsnf,nsnl
161C release node for future impact (at next cycles)
162 IF(intbuf_tab%IRTLM(4*(n-1)+3) < 0) intbuf_tab%IRTLM(4*(n-1)+3)=0
163 ENDDO
164C
165 nsnrf = 1 + itask*nsnr / nthread
166 nsnrl = (itask+1)*nsnr / nthread
167 DO n=nsnrf,nsnrl
168 IF(irtlm_fi(nin)%P(3,n) < 0) irtlm_fi(nin)%P(3,n)=0
169 ENDDO
170C
171 iedge = ipari(58,nin)
172 igap0 = ipari(53,nin)
173 IF(iedge/=0)THEN
174 nedge = ipari(68,nin)
175 drad = zero
176 CALL i25optcd_edg(intbuf_tab%CANDM_E2E,intbuf_tab%CANDS_E2E,
177 . x ,intbuf_tab%I_STOK_E(1),intbuf_tab%IRECTM ,
178 2 nin ,v ,intbuf_tab%GAPE ,igap ,itask ,
179 3 intbuf_tab%STFM,intbuf_tab%GAP_E_L,count_remslve,drad ,
180 4 iedge ,nedge ,intbuf_tab%LEDGE ,intbuf_tab%MVOISIN ,
181 . intbuf_tab%NSV ,
182 5 igap0 ,intbuf_tab%STFE,
183 6 intbuf_tab%S_STFM, intbuf_tab%S_STFE,ifq,intbuf_tab%IFPEN_E,
184 7 intbuf_tab%FTSAVX_E,intbuf_tab%FTSAVY_E, intbuf_tab%FTSAVZ_E,dgapload )
185
186
187
188 CALL i25optcd_e2s(intbuf_tab%CANDM_E2S,intbuf_tab%CANDS_E2S,
189 . x ,intbuf_tab%I_STOK_E(2),intbuf_tab%IRECTM ,
190 2 nin ,v ,intbuf_tab%GAP_M ,igap ,itask ,
191 3 intbuf_tab%STFM,intbuf_tab%GAP_ML,count_remslve,drad ,
192 4 iedge ,nedge ,intbuf_tab%LEDGE ,intbuf_tab%MVOISIN ,
193 . intbuf_tab%NSV ,
194 5 nrtm,intbuf_tab%GAPE ,intbuf_tab%GAP_E_L ,igap0,
195 6 intbuf_tab%STFE,intbuf_tab%S_STFE,ifq,intbuf_tab%IFPEN_E2S,
196 7 intbuf_tab%FTSAVX_E2S,intbuf_tab%FTSAVY_E2S, intbuf_tab%FTSAVZ_E2S,dgapload)
197 END IF
198
199
200C-----------------------------------------------------------------------
201 RETURN
202 END
my_real
#define my_real
Definition cppsort.cpp:32
i25irtlm
subroutine i25irtlm(ipari, intbuf_tab, itab, nin)
Definition i25irtlm.F:33
i25main_opt_tri
subroutine i25main_opt_tri(nin, ipari, intbuf_tab, x, v, itask, itab, kinet, count_remslv, count_remslve, nb_candt, i_opt_stok)
Definition i25main_opt_tri.F:42
i25optcd
subroutine i25optcd(nsv, cand_e, cand_n, x, i_stok, irect, gap_s, gap_m, v, icurv, stfn, itask, stf, nin, nsn, irtlm, time_s, mseglo, count_remslv, itab, secnd_fr, nsnr, pene_old, stif_old, msegtyp, nrtm, pmax_gap, i_opt_stok, cand_opt_e, cand_opt_n, sizopt, igap, gap_s_l, gap_m_l, drad, dgapload, icont_i)
Definition i25optcd.F:42
i25optcd_e2s
subroutine i25optcd_e2s(cand_m, cand_s, x, i_stok, irect, nin, v, gap_m, igap, itask, stf, gap_m_l, count_remslve, drad, iedge, nedge, ledge, mvoisin, nsv, nrtm, gape, gap_e_l, igap0, stfe, s_stfe, ifq, ifpen, cand_fx, cand_fy, cand_fz, dgapload)
Definition i25optcd_e2s.F:43
i25optcd_edg
subroutine i25optcd_edg(cand_m, cand_s, x, i_stok, irect, nin, v, gape, igap, itask, stf, gap_e_l, count_remslve, drad, iedge, nedge, ledge, mvoisin, nsv, igap0, stfe, s_stfm, s_stfe, ifq, ifpen, cand_fx, cand_fy, cand_fz, dgapload)
Definition i25optcd_edg.F:40
tri7box::irtlm_fi
type(int_pointer2), dimension(:), allocatable irtlm_fi
Definition tri7box.F:533
my_barrier
subroutine my_barrier
Definition machine.F:31
upgrade_cand_opt
subroutine upgrade_cand_opt(ni, k_stok, intbuf_tab)
Definition upgrade_multimp.F:1124