OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
int18_alloc.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!|| int18_alloc ../engine/source/interfaces/int18/int18_alloc.f
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.f
27!||--- uses -----------------------------------------------------
28!|| array_mod ../common_source/modules/array_mod.F
29!|| groupdef_mod ../common_source/modules/groupdef_mod.F
30!|| multi_fvm_mod ../common_source/modules/ale/multi_fvm_mod.F90
31!|| tri7box ../engine/share/modules/tri7box.F
32!||====================================================================
33 SUBROUTINE int18_alloc(NUMBER_INTER18,INTER18_LIST,MULTI_FVM,IPARI,XCELL_REMOTE, NSPMD)
34!$COMMENT
35! INT18_ALLOC description
36! allocation of array for interface 18 & interface 18 combined
37! with law151
38!
39! INT18_ALLOC organization :
40! - check if /INT18 is used
41! - check if /INT18 + /LAW151 is used
42! - allocate the arrays
43!$ENDCOMMENT
44C-----------------------------------------------
45C M o d u l e s
46C-----------------------------------------------
47 USE multi_fvm_mod
48 USE groupdef_mod
49 USE tri7box
50 USE array_mod
51C-----------------------------------------------
52C I m p l i c i t T y p e s
53C-----------------------------------------------
54#include "implicit_f.inc"
55#include "comlock.inc"
56#include "com04_c.inc"
57#include "param_c.inc"
58#include "task_c.inc"
59#include "parit_c.inc"
60C-----------------------------------------------
61C D u m m y A r g u m e n t s
62C-----------------------------------------------
63 INTEGER, INTENT(in) :: NSPMD !< number of spmd
64 INTEGER, INTENT(inout) :: NUMBER_INTER18 !< number of interface 18
65 INTEGER, DIMENSION(NINTER), INTENT(inout) :: INTER18_LIST !< list of interface 18
66 INTEGER, DIMENSION(NPARI,NINTER), INTENT(in) :: IPARI
67 TYPE(multi_fvm_struct) :: MULTI_FVM
68 TYPE(array_type), DIMENSION(NINTER), INTENT(inout) :: XCELL_REMOTE !< remote data structure for interface 18
69C-----------------------------------------------
70C L o c a l V a r i a b l e s
71C-----------------------------------------------
72 INTEGER :: N,NN,II,JJ,MY_SIZE,MY_SIZE_2,MY_SIZE_3
73 INTEGER :: ISU1,NBRIC,NSN,NTY,INACTI,NODE_ID,IBRIC,NODFI
74 INTEGER :: P
75C-----------------------------------------------
76 ! check if int18 + law151 is used in the model
77 ! and create a list of int18
78 multi_fvm%IS_INT18_LAW151 = .false.
79 my_size = 0
80 my_size_2 = 0
81 number_inter18 = 0
82
83 DO n=1,ninter
84 nty =ipari(7,n)
85 inacti = ipari(22,n)
86 xcell_remote(n)%SIZE_MY_REAL_ARRAY_1D = 0
87 ! int18 = int7 + inacti=7 (7+7=18)
88 IF( (nty==7).AND.(inacti ==7)) THEN
89 IF(multi_fvm%IS_USED) THEN
90 multi_fvm%IS_INT18_LAW151 = .true.
91 my_size = numnod + numels
92 my_size_2 = numels
93 ENDIF
94 number_inter18 = number_inter18 + 1
95 inter18_list(number_inter18) = n ! list of interface int18
96 ENDIF
97 ENDDO
98 ! number & list of interface 18 for MULTI_FVM solve
99 multi_fvm%NUMBER_INT18 = 0
100 IF(multi_fvm%IS_INT18_LAW151) multi_fvm%NUMBER_INT18 = number_inter18
101 ALLOCATE( multi_fvm%INT18_LIST(multi_fvm%NUMBER_INT18) )
102 ! allocation of X/V/MASS extended to NUMNOD+NUMELS
103 ! 1:NUMNOD --> classical x/v/mass
104 ! NUMNOD+1:NUMNOD+NUMELS --> x/v/mass of phantom nodes (located to the center of
105 ! the ALE elements)
106 ALLOCATE( multi_fvm%X_APPEND(3*my_size) )
107 ALLOCATE( multi_fvm%V_APPEND(3*my_size) )
108 ALLOCATE( multi_fvm%MASS_APPEND(my_size) )
109 ALLOCATE( multi_fvm%KINET_APPEND(my_size) )
110 ! allocation of force array : size = NUMELS
111 my_size_2 = my_size_2 * nthread
112
113 IF(iparit/=0) THEN
114 my_size_3 = 0
115 ELSE
116 my_size_3 = my_size_2
117 ENDIF
118
119 multi_fvm%SIZE_FORCE_INT_1 = 3
120 multi_fvm%SIZE_FORCE_INT_2 = my_size_3
121 ALLOCATE( multi_fvm%FORCE_INT(3,my_size_3) )
122 ! allocation of INT18_GLOBAL_LIST : marker for the interface /INT18+LAW151
123 ALLOCATE( multi_fvm%INT18_GLOBAL_LIST(ninter) )
124
125 ! --------------------------
126 ! allocation of remote array for parith/on
127 IF(multi_fvm%IS_USED) THEN
128 ALLOCATE( multi_fvm%R_AFI(ninter) )
129 DO ii=1,multi_fvm%NUMBER_INT18
130 n = inter18_list(ii) ! list of interface 18 + law151
131 IF( ALLOCATED( multi_fvm%R_AFI(n)%R_FORCE_INT ) ) DEALLOCATE( multi_fvm%R_AFI(n)%R_FORCE_INT )
132 nodfi = 0
133 DO p = 1,nspmd
134 nodfi = nodfi + nsnfi(n)%P(p)
135 ENDDO
136 multi_fvm%R_AFI(n)%NODFI = nodfi
137 ALLOCATE( multi_fvm%R_AFI(n)%R_FORCE_INT(3,6,nodfi*nthread) )
138 multi_fvm%R_AFI(n)%R_FORCE_INT(1:3,1:6,1:nodfi*nthread) = 0d+00
139 ENDDO
140 ELSE
141 ALLOCATE( multi_fvm%R_AFI(0) )
142 ENDIF
143 ! allocation of local array for parith/on
144 IF(iparit/=0) THEN
145 ALLOCATE( multi_fvm%FORCE_INT_PON(3,6,my_size_2) )
146 multi_fvm%SIZE_FORCE_INT_PON = my_size_2
147 ELSE
148 ALLOCATE( multi_fvm%FORCE_INT_PON(0,0,0) )
149 multi_fvm%SIZE_FORCE_INT_PON = 0
150 ENDIF
151 ! --------------------------
152
153 IF( multi_fvm%IS_INT18_LAW151 ) THEN
154 multi_fvm%INT18_LIST(1:multi_fvm%NUMBER_INT18) = inter18_list(1:multi_fvm%NUMBER_INT18)
155 ENDIF
156
157 RETURN
158 END SUBROUTINE int18_alloc
159C===============================================================================
subroutine int18_alloc(number_inter18, inter18_list, multi_fvm, ipari, xcell_remote, nspmd)
Definition int18_alloc.F:34
type(int_pointer), dimension(:), allocatable nsnfi
Definition tri7box.F:440
subroutine resol(timers, element, nodes, coupling, af, iaf, iskwn, neth, ipart, nom_opt, kxx, ixx, ixtg, ixs, ixq, ixt, ixp, ixr, ifill, mat_elem, ims, npc, ibcl, ibfv, idum, las, laccelm, nnlink, lnlink, iparg, dd_iad, igrv, iexlnk, kinet, ipari, nprw, iconx, npby, lpby, lrivet, nstrf, ljoint, nodpor, monvol, ilink, llink, linale, neflsw, nnflsw, icut, cluster, itask, inoise, thke, damp, pm, skews, geo, eani, bufmat, bufgeo, bufsf, w, veul, fill, dfill, alph, wb, dsave, asave, msnf, tf, forc, vel, fsav, fzero, xlas, accelm, agrv, fr_wave, failwave, parts0, elbuf, rwbuf, sensors, rwsav, rby, rivet, secbuf, volmon, lambda, wa, fv, partsav, uwa, val2, phi, segvar, r, crflsw, flsw, fani, xcut, anin, tani, secfcum, bufnois, idata, rdata, iframe, kxsp, ixsp, nod2sp, ispsym, ispcond, xframe, spbuf, xspsym, vspsym, pv, fsavd, ibvel, lbvel, wasph, w16, isphio, lprtsph, lonfsph, vsphio, fbvel, lagbuf, ibcslag, iactiv, dampr, gjbufi, gjbufr, rbmpc, ibmpc, sphveln, nbrcvois, nbsdvois, lnrcvois, lnsdvois, nercvois, nesdvois, lercvois, lesdvois, npsegcom, lsegcom, nporgeo, ixtg1, npbyl, lpbyl, rbyl, igeo, ipm, madprt, madsh4, madsh3, madsol, madnod, madfail, iad_rby, fr_rby, fr_wall, iad_rby2, fr_rby2, iad_i2m, fr_i2m, addcni2, procni2, iadi2, fr_mv, iadmv2, fr_ll, fr_rl, iadcj, fr_cj, fr_sec, iad_sec, iad_cut, fr_cut, rg_cut, newfront, fr_mad, fxbipm, fxbrpm, fxbnod, fxbmod, fxbglm, fxbcpm, fxbcps, fxblm, fxbfls, fxbdls, fxbdep, fxbvit, fxbacc, fxbelm, fxbsig, fxbgrvi, fxbgrvr, eigipm, eigibuf, eigrpm, lnodpor, fr_i18, graphe, iflow, rflow, lgrav, dd_r2r, fasolfr, fr_lagf, llagf, lprw, icontact, rcontact, sh4tree, sh3tree, ipadmesh, padmesh, msc, mstg, inc, intg, ptg, iskwp, nskwp, isensp, nsensp, iaccp, naccp, ipart_state, acontact, pcontact, factiv, sh4trim, sh3trim, mscnd, incnd, ibfflux, fbfflux, rbym, irbym, lnrbym, icodrbym, ibcv, fconv, ibftemp, fbftemp, iad_rbym, fr_rbym, weight_rm, ms_ply, zi_ply, inod_pxfem, iel_pxfem, iadc_pxfem, adsky_pxfem, icode_ply, icodt_ply, iskew_ply, admsms, madclnod, nom_sect, mcpc, mcptg, dmelc, dmeltg, mssa, dmels, mstr, dmeltr, msp, dmelp, msrt, dmelrt, ibcr, fradia, res_sms, table, irbe2, lrbe2, iad_rbe2, fr_rbe2, phie, msf, procne_pxfem, iadsdp_pxfem, iadrcp_pxfem, icfield, lcfield, cfield, msz2, diag_sms, iloadp, lloadp, loadp, inod_crk, iel_crk, iadc_crk, adsky_crk, cne_crk, procne_crk, iadsdp_crk, iadrcp_crk, ibufssg_io, ibc_ply, dmint2, ibordnode, elbuf_tab, por, nodedge, iad_edge, fr_edge, fr_nbedge, crknodiad, lgauge, gauge, igaup, ngaup, nodlevxf, dd_r2r_elem, nodglobxfe, sph2sol, sol2sph, irst, dmsph, wagap, xfem_tab, elcutc, nodenr, kxfenod2elc, enrtag, rthbu f, kxig3d, ixig3d, knot, wige, wsmcomp, stack, cputime_mp_glob, cputime_mp, tab_ump, poin_ump, sol2sph_typ, irunn_bis, addcsrect, iad_frnor, fr_nor, procnor, iad_fredg, fr_edg, drape_sh4n, drape_sh3n, tab_mat, nativ0_sms, multi_fvm, segquadfr, ms_2d, h3d_data, subsets, igrnod, igrbric, igrquad, igrsh4n, igrsh3n, igrtruss, igrbeam, igrspring, igrpart, igrsurf, forneqs, nloc_dmg, iskwp_l, knotlocpc, knotlocel, pinch_data, tag_skins6, ale_connectivity, xcell, xface, ne_nercvois, ne_nesdvois, ne_lercvois, ne_lesdvois, ibcscyc, lbcscyc, t_monvol, id_global_vois, face_vois, dynain_data, fcont_max, ebcs_tab, diffusion, kloadpinter, loadpinter, dgaploadint, drapeg, user_windows, output, interfaces, dt, loads, python, dpl0cld, vel0cld, ndamp_vrel, id_damp_vrel, fr_damp_vrel, ndamp_vrel_rbyg, names_and_titles, unitab, liflow, lrflow, glob_therm, pblast, rbe3)
Definition resol.F:633