34 SUBROUTINE assadd2(ADDCNE ,INDSKY ,FSKY ,FSKYM ,IAD_ELEM ,
35 2 FR_ELEM ,FR_NBCC ,PROCNE,NISKYFI ,ADDCNI2 ,
36 3 PROCNI2 ,IAD_I2M ,FR_I2M,FR_NBCCI2,INDSKYI2 ,
37 4 IADSDP ,IADRCP ,ISENDP,IRECVP ,FTHESKY ,
38 5 NISKYFIE,INOD_PXFEM,ADDCNE_PXFEM,PROCNE_PXFEM,
39 6 ISENDP_PXFEM,IRECVP_PXFEM ,IADSDP_PXFEM,IADRCP_PXFEM,
40 7 FR_NBCC1 ,INOD_CRKXFEM,ADDCNE_CRKXFEM,PROCNE_CRKXFEM,
41 8 ISENDP_CRKXFEM,IRECVP_CRKXFEM,IADSDP_CRKXFEM,IADRCP_CRKXFEM,
42 9 CONDNSKY,GLOB_THERM)
51#include "implicit_f.inc"
58#include "com_xfem1.inc"
64 INTEGER MAXBLOC,NBLOC,,NBCOL
65 PARAMETER (MAXBLOC=1000)
66 common/ptmparit/nbloc,nbval(1:maxbloc),nbcol(1:maxbloc)
67 INTEGER ,NBLOCI2,NBVALI2,NBCOLI2
69 common/ptmpari2/nbloci2,nbvali2(1:maxbloci2),nbcoli2(1:maxbloci2)
73 INTEGER INDSKY(*),ADDCNE(*),IAD_ELEM(2,*),FR_NBCC(2,*),
74 . procne(*),fr_elem(*), niskyfi(*), addcni2(*),niskyfie(*),
75 . procni2(*), iad_i2m(*), fr_i2m(*), fr_nbcci2(2,*),
76 . indskyi2(*), iadsdp(*), iadrcp(*), isendp(*), irecvp(*),
77 . procne_pxfem(*),isendp_pxfem(*),irecvp_pxfem(*),
78 . iadsdp_pxfem(*),iadrcp_pxfem(*),fr_nbcc1(2,*),
79 . addcne_pxfem(*),inod_pxfem(*),addcne_crkxfem(*),
80 . inod_crkxfem(*),procne_crkxfem(*),isendp_crkxfem(*),
81 . irecvp_crkxfem(*),iadsdp_crkxfem(*),iadrcp_crkxfem(*)
83 . fsky(8,lsky),fskym(lsky),fthesky(lsky),condnsky(lsky)
84 type (glob_therm_) ,
intent(inout) :: glob_therm
88 INTEGER I, J, N, K, L, NC1, NC, LOC_PROC, NOD, CC, lsd, lrc,
89 . WORK(70000), LSD1,LRC1,NOD1,
90 INTEGER,
DIMENSION(:),
ALLOCATABLE :: INDEX
92 CALL my_alloc(index,2*numnod)
108 IF (glob_therm%ITHERM_FE > 0 )
THEN
114 IF (glob_therm%NODADT_THERM > 0 )
THEN
120 IF (n2d == 0 .AND. iale+ieuler + glob_therm%ITHERM > 0)
THEN
136 IF(iplyxfem > 0 )
THEN
143 IF(icrack3d > 0 .AND. nspmd > 1)
THEN
157 IF(iplyxfem == 0 .AND. icrack3d == 0)
THEN
162 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
164 DO cc = addcne(nod),addcne(nod+1)-1
165 IF(procne(cc)==loc_proc)
THEN
166 fr_nbcc(1,i) = fr_nbcc(1,i)+1
169 ELSEIF(procne(cc)==i)
THEN
170 fr_nbcc(2,i) = fr_nbcc(2,i)+1
181 ELSE IF (iplyxfem > 0)
THEN
189 DO j=iad_elem(1,i),iad_elem(1,i+1)-1
191 DO cc = addcne(nod),addcne(nod+1)-1
192 IF(procne(cc)==loc_proc)
THEN
193 fr_nbcc(1,i) = fr_nbcc(1,i)+1
196 ELSEIF(procne(cc)==i)
THEN
197 fr_nbcc(2,i) = fr_nbcc(2,i)+1
202 nod1 = inod_pxfem(nod)
204 DO cc = addcne_pxfem(nod1),addcne_pxfem(nod1+1)-1
205 IF(procne_pxfem(cc)==loc_proc)
THEN
206 fr_nbcc1(1,i) = fr_nbcc1(1,i)+1
207 isendp_pxfem(lsd1) = cc
209 ELSEIF(procne_pxfem(cc)==i)
THEN
210 fr_nbcc1(2,i) = fr_nbcc1(2,i)+1
211 irecvp_pxfem(lrc1) = cc
222 iadsdp_pxfem(nspmd+1)=lsd1
223 iadrcp_pxfem(nspmd+1)=lrc1
225 ELSE IF (icrack3d > 0 .AND. nspmd > 1)
THEN
230 iadsdp_crkxfem(i)=lsd1
231 iadrcp_crkxfem(i)=lrc1
232 IF (i /= loc_proc)
THEN
233 DO j = iad_elem(1,i),iad_elem(1,i+1)-1
235 DO cc = addcne(nod),addcne(nod+1)-1
236 IF (procne(cc) == loc_proc)
THEN
237 fr_nbcc(1,i) = fr_nbcc(1,i)+1
240 ELSEIF (procne(cc) == i)
THEN
241 fr_nbcc(2,i) = fr_nbcc(2,i)+1
247 nod1 = inod_crkxfem(nod)
250 DO cc = addcne_crkxfem(nod1),addcne_crkxfem(nod1+1)-1
251 IF (procne_crkxfem(cc) == i) xfem_rem_count =
255 IF (xfem_rem_count /= 0)
THEN
256 DO cc = addcne_crkxfem(nod1),addcne_crkxfem(nod1+1)-1
257 IF (procne_crkxfem(cc)==loc_proc)
THEN
258 fr_nbcc1(1,i) = fr_nbcc1(1,i)+1
259 isendp_crkxfem(lsd1) = cc
261 ELSEIF (procne_crkxfem(cc)==i)
THEN
262 fr_nbcc1(2,i) = fr_nbcc1(2,i)+1
263 irecvp_crkxfem(lrc1) = cc
277 iadsdp_crkxfem(nspmd+1)=lsd1
278 iadrcp_crkxfem(nspmd+1)=lrc1
282 fr_nbcc(1,nspmd+1) = fr_nbcc(1,nspmd+1) + fr_nbcc(1,i)
283 fr_nbcc(2,nspmd+1) = fr_nbcc(2,nspmd+1) + fr_nbcc(2,i)
286 IF(iplyxfem > 0)
THEN
288 fr_nbcc1(1,nspmd+1) = fr_nbcc1(1,nspmd+1) + fr_nbcc1(1,i)
289 fr_nbcc1(2,nspmd+1) = fr_nbcc1(2,nspmd+1) + fr_nbcc1(2,i)
293 IF(icrack3d > 0 .AND. nspmd > 1)
THEN
295 fr_nbcc1(1,nspmd+1) = fr_nbcc1(1,nspmd+1) + fr_nbcc1(1,i)
296 fr_nbcc1(2,nspmd+1) = fr_nbcc1(2,nspmd+1) + fr_nbcc1(2,i)
306 indsky(n) = addcne(n+1) - addcne(n)
309 CALL my_orders(0,work,indsky,index,numnod,1)
321 nc = addcne(n+1)-addcne(n)
323 nbval(nbloc) = nbval(nbloc)+1
327 IF (nbloc>maxbloc)
THEN
329 .
' **ERROR**: MEMORY PROBLEM IN PARITH OPTION'
331 .
' **ERROR**: MEMORY PROBLEM IN PARITH OPTION'
358 DO j=iad_i2m(i),iad_i2m(i+1)-1
360 DO cc = addcni2(nod),addcni2(nod+1)-1
361 IF(procni2(cc)==loc_proc)
THEN
362 fr_nbcci2(1,i) = fr_nbcci2(1,i)+1
364 ELSEIF(procni2(cc)==i)
THEN
365 fr_nbcci2(2,i) = fr_nbcci2(2,i)+1
373 fr_nbcci2(1,nspmd+1) = fr_nbcci2(1,nspmd+1)+fr_nbcci2(1,i)
374 fr_nbcci2(2,nspmd+1) = fr_nbcci2(2,nspmd+1)+fr_nbcci2(2,i)
383 indskyi2(n) = addcni2(n+1) - addcni2(n)
388 indskyi2(n) = index(n)
398 nc = addcni2(n+1)-addcni2(n)
400 nbvali2(nbloci2) = nbvali2(nbloci2)+1
404 IF (nbloci2>maxbloc)
THEN
406 .
' **ERROR**: MEMORY PROBLEM IN PARITH OPTION'
408 .
' **ERROR**: MEMORY PROBLEM IN PARITH OPTION'
413 nbcoli2(nbloci2) = nc
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)