OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
i25sto.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!|| i25sto ../starter/source/interfaces/inter3d1/i25sto.F
25!||--- called by ------------------------------------------------------
26!|| i25trivox1 ../starter/source/interfaces/inter3d1/i25trivox1.f
27!||--- calls -----------------------------------------------------
28!|| i25cor3t ../starter/source/interfaces/inter3d1/i25cor3t.F
29!|| i25pen3a ../starter/source/interfaces/inter3d1/i25pen3a.F
30!|| i25s1s2 ../starter/source/interfaces/inter3d1/i25sto.F
31!||--- uses -----------------------------------------------------
32!|| tri7box ../starter/share/modules1/tri7box.f
33!||====================================================================
34 SUBROUTINE i25sto(
35 1 J_STOK,IRECT ,X ,NSV ,local_i_stok,
36 2 local_cand_n,local_cand_e ,MARGE ,
37 3 PROV_N ,PROV_E,ESHIFT,NSN ,
38 4 NRTM ,GAP_S ,GAP_M ,NBINFLG,MBINFLG,
39 5 ILEV ,MSEGTYP,IGAP,GAP_S_L,
40 6 GAP_M_L,EDGE_L2,ICODE,ISKEW,DRAD,
41 7 DGAPLOAD,NRTMT)
42C============================================================================
43 USE tri7box
44 use array_mod
45C-----------------------------------------------
46C I m p l i c i t T y p e s
47C-----------------------------------------------
48#include "implicit_f.inc"
49C-----------------------------------------------
50C G l o b a l P a r a m e t e r s
51C-----------------------------------------------
52#include "mvsiz_p.inc"
53C-----------------------------------------------
54C D u m m y A r g u m e n t s
55C-----------------------------------------------
56 INTEGER NSN, NRTM, NBINFLG(*),MBINFLG(*),ILEV, IGAP
57 INTEGER J_STOK,ESHIFT
58 INTEGER IRECT(4,*),NSV(*)
59 INTEGER PROV_N(MVSIZ),PROV_E(MVSIZ),local_i_stok,MSEGTYP(*),ICODE(*),ISKEW(*)
60C REAL
61 my_real
62 . X(3,*), GAP_S(*), GAP_M(*),
63 . marge,
64 . gap_s_l(*), gap_m_l(*), edge_l2(*)
65 my_real , INTENT(IN) :: dgapload ,drad
66 INTEGER , INTENT(IN) :: NRTMT
67
68 type(array_type_int_1d) :: local_cand_n
69 type(array_type_int_1d) :: local_cand_e
70C-----------------------------------------------
71C L o c a l V a r i a b l e s
72C-----------------------------------------------
73 INTEGER I,K_STOK,ITYPE
74 INTEGER IX1(MVSIZ), IX2(MVSIZ), IX3(MVSIZ), IX4(MVSIZ),
75 . etyp(mvsiz), ibc(mvsiz)
76 integer :: my_old_size,my_size
77 integer, dimension(:), allocatable :: tmp_array_1,tmp_array_2
78C REAL
79 my_real
80 . x1(mvsiz), x2(mvsiz), x3(mvsiz), x4(mvsiz),
81 . y1(mvsiz), y2(mvsiz), y3(mvsiz), y4(mvsiz),
82 . z1(mvsiz), z2(mvsiz), z3(mvsiz), z4(mvsiz),
83 . xi(mvsiz), yi(mvsiz), zi(mvsiz), stif(mvsiz),
84 . pene(mvsiz), gapv(mvsiz)
85 DATA itype/25/
86C-----------------------------------------------
87 CALL i25cor3t( j_stok ,x ,irect ,nsv ,prov_e ,
88 1 prov_n ,x1 ,x2 ,
89 2 x3 ,x4 ,y1 ,y2 ,y3 ,
90 3 y4 ,z1 ,z2 ,z3 ,z4 ,
91 4 xi ,yi ,zi ,stif ,ix1 ,
92 5 ix2 ,ix3 ,ix4 ,nsn ,nrtm ,
93 6 marge ,gap_s,gap_m ,gapv ,itype ,
94 7 igap ,gap_s_l ,gap_m_l ,edge_l2,msegtyp,
95 8 etyp ,icode ,iskew ,ibc ,drad ,
96 9 dgapload ,nrtmt)
97C-----------------------------------------------
98 CALL i25pen3a( j_stok ,x1 ,x2 ,x3 ,x4 ,
99 . y1 ,y2 ,y3 ,y4 ,
100 . z1 ,z2 ,z3 ,z4 ,xi ,
101 . yi ,zi ,pene ,ix1 ,ix2 ,
102 . ix3 ,ix4 ,gapv ,nrtm ,etyp ,
103 . ibc ,nrtmt )
104C-----------------------------------------------
105 IF (ilev==2)
106 . CALL i25s1s2(j_stok,prov_n,prov_e,nbinflg,mbinflg,pene)
107C-----------------------------------------------
108 k_stok = 0
109 DO i=1,j_stok
110 IF(pene(i)/=zero) THEN
111 k_stok = k_stok + 1
112 END IF
113 ENDDO
114 IF(k_stok==0)RETURN
115C
116 if(local_i_stok+k_stok>local_cand_n%size_int_array_1d) then
117 my_old_size = local_cand_n%size_int_array_1d
118 my_size = (my_old_size+k_stok) * 1.25
119 allocate( tmp_array_1( my_size ) )
120 allocate( tmp_array_2( my_size ) )
121 tmp_array_1(1:my_old_size) = local_cand_n%int_array_1d(1:my_old_size)
122 tmp_array_2(1:my_old_size) = local_cand_e%int_array_1d(1:my_old_size)
123 call dealloc_1d_array(local_cand_n)
124 call dealloc_1d_array(local_cand_e)
125 call move_alloc(tmp_array_1,local_cand_n%int_array_1d)
126 call move_alloc(tmp_array_2,local_cand_e%int_array_1d)
127 local_cand_n%size_int_array_1d = my_size
128 local_cand_e%size_int_array_1d = my_size
129 endif
130 DO i=1,j_stok
131 IF(pene(i)/=zero)THEN
132 local_i_stok = local_i_stok + 1
133 local_cand_n%int_array_1d(local_i_stok) = prov_n(i)
134 local_cand_e%int_array_1d(local_i_stok) = prov_e(i)+eshift
135 ENDIF
136 ENDDO
137C-----------------------------------------------
138 RETURN
139 END
140!||====================================================================
141!|| i25s1s2 ../starter/source/interfaces/inter3d1/i25sto.F
142!||--- called by ------------------------------------------------------
143!|| i25sto ../starter/source/interfaces/inter3d1/i25sto.F
144!||--- calls -----------------------------------------------------
145!|| bitget ../starter/source/interfaces/inter3d1/bitget.F
146!||====================================================================
147 SUBROUTINE i25s1s2(J_STOK,PROV_N,PROV_E,NBINFLG,MBINFLG,PENE)
148C-----------------------------------------------
149C I m p l i c i t T y p e s
150C-----------------------------------------------
151#include "implicit_f.inc"
152C-----------------------------------------------
153C G l o b a l P a r a m e t e r s
154C-----------------------------------------------
155#include "mvsiz_p.inc"
156C-----------------------------------------------
157C D u m m y A r g u m e n t s
158C-----------------------------------------------
159 INTEGER J_STOK,PROV_N(*),PROV_E(*),NBINFLG(*),MBINFLG(*)
160 my_real
161 . PENE(MVSIZ)
162C-----------------------------------------------
163C L o c a l V a r i a b l e s
164C-----------------------------------------------
165 INTEGER I,N,NE,IMS1,IMS2,ISS1,ISS2
166C-----------------------------------------------
167C
168 INTEGER BITGET
169 EXTERNAL BITGET
170C=======================================================================
171 DO I=1,j_stok
172 n = prov_n(i)
173 ne = prov_e(i)
174 ims1 = bitget(mbinflg(ne),0)
175 ims2 = bitget(mbinflg(ne),1)
176 iss1 = bitget(nbinflg(n),0)
177 iss2 = bitget(nbinflg(n),1)
178 IF(.NOT.((ims1 == 1 .and. iss2==1).or.
179 . (ims2 == 1 .and. iss1==1)))THEN
180 pene(i)=zero
181 ENDIF
182 ENDDO
183C
184 RETURN
185 END
i25pen3a
subroutine i25pen3a(jlt, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, pene, ix1, ix2, ix3, ix4, gapv, nrtm, etyp, ibc, nrtmt)
Definition i25pen3a.F:34
i25trivox1
subroutine i25trivox1(nsn, irect, x, stfn, xyzm, nsv, ii_stok, eshift, bgapsmx, voxel, nbx, nby, nbz, nrtm, gap_s, gap_m, marge, nbinflg, mbinflg, ilev, msegtyp, igap, gap_s_l, gap_m_l, edge_l2, ledgmax, kremnode, remnode, iparts, npartns, lpartns, ielem, icode, iskew, drad, is_large_node, large_node, nb_large_nodes, dgapload, nrtmt, flag_removed_node, ielem_m, local_next_nod, iix, iiy, iiz, intbuf_tab, ipari, nin)
Definition i25trivox1.F:46
array_mod::dealloc_1d_array
Definition array_mod.F:99
array_mod
Definition array_mod.F:51
i25cor3t
subroutine i25cor3t(jlt, x, irect, nsv, cand_e, cand_n, x1, x2, x3, x4, y1, y2, y3, y4, z1, z2, z3, z4, xi, yi, zi, stif, ix1, ix2, ix3, ix4, nsn, nrtm, marge, gap_s, gap_m, gapv, ityp, igap, gap_s_l, gap_m_l, edge_l2, msegtyp, etyp, icode, iskew, ibc, drad, dgapload, nrtmt)
Definition i25cor3t.F:40
i25s1s2
subroutine i25s1s2(j_stok, prov_n, prov_e, nbinflg, mbinflg, pene)
Definition i25sto.F:148
i25sto
subroutine i25sto(j_stok, irect, x, nsv, local_i_stok, local_cand_n, local_cand_e, marge, prov_n, prov_e, eshift, nsn, nrtm, gap_s, gap_m, nbinflg, mbinflg, ilev, msegtyp, igap, gap_s_l, gap_m_l, edge_l2, icode, iskew, drad, dgapload, nrtmt)
Definition i25sto.F:42
starter
program starter
Definition starter.F:39
array_mod::array_type_int_1d
Definition array_mod.F:90