OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
imp_solv.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!|| imp_solv ../engine/source/implicit/imp_solv.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||--- calls -----------------------------------------------------
28!|| arret ../engine/source/system/arret.F
29!|| bfgs_ini ../engine/source/implicit/imp_bfgs.F
30!|| cfield_imp ../engine/source/loads/general/load_centri/cfield_imp.F
31!|| condens_b ../engine/source/implicit/upd_glob_k.F
32!|| cp_impbuf ../engine/source/implicit/produt_v.F
33!|| cp_int_hp ../engine/source/implicit/produt_v.F
34!|| cp_real_hp ../engine/source/implicit/produt_v.F
35!|| crit_llim ../engine/source/implicit/imp_solv.F
36!|| deallocm ../engine/source/implicit/imp_solv.F
37!|| dim_int_k ../engine/source/implicit/ind_glob_k.F
38!|| dis_cp ../engine/source/implicit/imp_solv.F
39!|| du_ini_hp ../engine/source/implicit/imp_solv.F
40!|| dyna_cpk0 ../engine/source/implicit/imp_dyna.F
41!|| dyna_cpr0 ../engine/source/implicit/imp_dyna.F
42!|| dyna_ina ../engine/source/implicit/imp_dyna.F
43!|| dyna_wex ../engine/source/implicit/imp_dyna.F
44!|| etfac_ini ../engine/source/implicit/imp_init.F
45!|| fil_span1 ../engine/source/implicit/ind_glob_k.F
46!|| force_imp ../engine/source/loads/general/force_imp.F
47!|| fv_dd0 ../engine/source/constraints/general/impvel/fv_imp0.F
48!|| fv_fint0 ../engine/source/constraints/general/impvel/fv_imp0.F
49!|| fv_imp ../engine/source/constraints/general/impvel/fv_imp0.F
50!|| fv_imp1 ../engine/source/constraints/general/impvel/fv_imp0.F
51!|| fv_rw ../engine/source/constraints/general/impvel/fv_imp0.F
52!|| fvbc_impl1 ../engine/source/constraints/general/impvel/fv_imp0.F
53!|| get_fext ../engine/source/implicit/imp_solv.F
54!|| get_nspc ../engine/source/constraints/general/bcs/bc_imp0.F
55!|| getnddli_g ../engine/source/mpi/implicit/imp_fri.F
56!|| gravit_imp ../engine/source/loads/general/grav/gravit_imp.F
57!|| iddl2nod ../engine/source/implicit/recudis.F
58!|| idel_int ../engine/source/implicit/ind_glob_k.F
59!|| imp_b2a ../engine/source/implicit/imp_solv.F
60!|| imp_check ../engine/source/implicit/imp_solv.F
61!|| imp_checm ../engine/source/implicit/imp_solv.F
62!|| imp_dtkin ../engine/source/implicit/imp_int_k.F
63!|| imp_dtn ../engine/source/implicit/imp_dt.F
64!|| imp_dykv ../engine/source/implicit/imp_dyna.F
65!|| imp_dykv0 ../engine/source/implicit/imp_dyna.F
66!|| imp_dynam ../engine/source/implicit/imp_dyna.F
67!|| imp_fr7i ../engine/source/mpi/implicit/imp_fri.F
68!|| imp_glob_khp ../engine/source/implicit/imp_glob_k.F
69!|| imp_int_k ../engine/source/implicit/imp_int_k.F
70!|| imp_intfr ../engine/source/implicit/imp_solv.F
71!|| imp_inttd0 ../engine/source/implicit/imp_int_k.F
72!|| imp_kpres ../engine/source/implicit/imp_glob_k.F
73!|| imp_mumps1 ../engine/source/implicit/imp_mumps.F
74!|| imp_qifam ../engine/source/implicit/imp_dyna.F
75!|| imp_setb ../engine/source/implicit/imp_setb.F
76!|| imp_stop ../engine/source/implicit/imp_solv.F
77!|| ind_frkd ../engine/source/mpi/implicit/imp_fri.F
78!|| ind_glob_k ../engine/source/implicit/ind_glob_k.F
79!|| ind_int_k ../engine/source/implicit/ind_glob_k.F
80!|| ini_bminma_imp ../engine/source/implicit/imp_solv.f
81!|| ini_k0h ../engine/source/implicit/imp_solv.F
82!|| ini_kic ../engine/source/implicit/imp_solv.F
83!|| ini_kif ../engine/source/implicit/imp_solv.F
84!|| int5_diverg ../engine/source/implicit/imp_solv.F
85!|| integrator1_hp ../engine/source/implicit/integrator.F
86!|| integrator_hp ../engine/source/implicit/integrator.F
87!|| integratorl_hp ../engine/source/implicit/integrator.F
88!|| k_band ../engine/source/implicit/imp_solv.F
89!|| kin_knl ../engine/source/implicit/imp_int_k.F
90!|| lin_solv ../engine/source/implicit/lin_solv.f
91!|| m_lnz ../engine/source/implicit/imp_solv.F
92!|| monv_imp ../engine/source/airbag/monv_imp0.F
93!|| my_barrier ../engine/source/system/machine.F
94!|| nl_solv ../engine/source/implicit/nl_solv.F
95!|| pr_infok ../engine/source/implicit/imp_solv.F
96!|| pr_solnfo ../engine/source/implicit/imp_solv.f
97!|| produt_hp ../engine/source/implicit/produt_v.F
98!|| produt_uhp0 ../engine/source/implicit/produt_v.F
99!|| put_nspc ../engine/source/constraints/general/bcs/bc_imp0.F
100!|| qstat_ini ../engine/source/implicit/imp_dyna.F
101!|| recukin ../engine/source/implicit/recudis.F
102!|| rer02 ../engine/source/implicit/upd_glob_k.F
103!|| rgwal0_imp ../engine/source/constraints/general/rwall/rgwal0.F
104!|| sav_inttd ../engine/source/implicit/imp_int_k.F
105!|| save_kif ../engine/source/implicit/imp_solv.F
106!|| spb_rm_rig ../engine/source/implicit/imp_solv.F
107!|| spbrm_pre ../engine/source/implicit/imp_solv.F
108!|| spmd_max_i ../engine/source/mpi/implicit/imp_spmd.F
109!|| spmd_min_i ../engine/source/mpi/implicit/imp_spmd.F
110!|| spmd_min_s ../engine/source/mpi/implicit/imp_spmd.F
111!|| spmd_sumf_a ../engine/source/mpi/implicit/imp_spmd.F
112!|| startime ../engine/source/system/timer_mod.F90
113!|| stoptime ../engine/source/system/timer_mod.F90
114!|| upd_fr_k ../engine/source/mpi/implicit/imp_fri.F
115!|| upd_glob_k ../engine/source/implicit/upd_glob_k.F
116!|| upd_rhs ../engine/source/implicit/upd_glob_k.F
117!|| vaxpy_hp ../engine/source/implicit/produt_v.F
118!|| vscaly_hp ../engine/source/implicit/produt_v.F
119!|| weightddl ../engine/source/implicit/recudis.F
120!|| zero1 ../engine/source/system/zero.f
121!|| zeror_hp ../engine/source/implicit/produt_v.F
122!||--- uses -----------------------------------------------------
123!|| drape_mod ../engine/share/modules/drape_mod.F
124!|| dsgraph_mod ../engine/share/modules/dsgraph_mod.F
125!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
126!|| glob_therm_mod ../common_source/modules/mat_elem/glob_therm_mod.F90
127!|| groupdef_mod ../common_source/modules/groupdef_mod.F
128!|| h3d_mod ../engine/share/modules/h3d_mod.F
129!|| imp_lintf ../engine/share/modules/impbufdef_mod.F
130!|| imp_pcg_proj ../engine/share/modules/impbufdef_mod.F
131!|| imp_worki ../engine/share/modules/impbufdef_mod.F
132!|| impbufdef_mod ../engine/share/modules/impbufdef_mod.F
133!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.f90
134!|| interfaces_mod ../common_source/modules/interfaces/interfaces_mod.f90
135!|| message_mod ../engine/share/message_module/message_mod.F
136!|| multi_fvm_mod ../common_source/modules/ale/multi_fvm_mod.F90
137!|| python_funct_mod ../common_source/modules/python_mod.F90
138!|| sensor_mod ../common_source/modules/sensor_mod.F90
139!|| skew_mod ../common_source/modules/skew_mod.F90
140!|| stack_mod ../engine/share/modules/stack_mod.f
141!|| th_surf_mod ../common_source/modules/interfaces/th_surf_mod.F
142!|| timer_mod ../engine/source/system/timer_mod.F90
143!||====================================================================
144 SUBROUTINE imp_solv(TIMERS,PYTHON,
145 1 ICODE ,ISKEW ,ISKWN ,IPART ,IXTG ,IXS ,IXQ ,
146 2 IXC ,IXT ,IXP ,IXR ,IXTG1 ,ITAB ,ITABM1 ,
147 3 NPC ,IBCL ,IBFV ,SENSOR_TAB,NNLINK ,LNLINK ,IPARG ,IGRV ,
148 4 IPARI ,INTBUF_TAB,NPRW ,ICONX ,NPBY ,LPBY ,LRIVET ,
149 5 NSTRF ,LJOINT ,ICODT ,ICODR ,ISKY ,ADSKY ,IADS_F ,
150 6 ILINK ,LLINK ,WEIGHT ,ITASK ,IBVEL ,LBVEL ,FBVEL ,
151 7 X ,D ,V ,VR ,DR ,THKE ,DAMP ,MS ,
152 8 IN ,PM ,SKEWS ,GEO ,EANI ,BUFMAT ,BUFGEO ,BUFSF ,
153 9 TF ,FORC ,VEL ,FSAV ,AGRV ,FR_WAVE,PARTS0 ,
154 A ELBUF ,RBY ,RIVET ,FR_ELEM,IAD_ELEM,
155 B WA ,A ,AR ,STIFN ,STIFR ,PARTSAV,FSKY ,
156 C FSKYI ,IFRAME ,XFRAME ,W16 ,IACTIV ,FSKYM ,IGEO ,IPM ,
157 D WFEXT ,NODFT ,NODLT ,NINT7 ,NUM_IMP,NS_IMP ,NE_IMP ,IND_IMP,
158 L IT ,RWBUF ,LPRW ,FR_WALL,NBINTC ,INTLIST,FOPT ,RWSAV ,
159 M FSAVD ,GRAPHE ,FAC_K ,IPIV_K ,NKCOND ,NSENSOR,
160 N MONVOL ,IGRSURF,FR_MV ,VOLMON ,DIRUL ,
161 O NODGLOB,MUMPS_PAR,CDDLP,ISENDTO,IRECVFROM,NEWFRONT,IMSCH ,
162 P I2MSCH ,ISIZXV,ILENXV ,ISLEN7 ,IRLEN7 ,ISLEN11,IRLEN11,ISLEN17,
163 Q IRLEN17,IRLEN7T,ISLEN7T,KINET ,NUM_IMP1,TEMP ,DT2PREV,WAINT ,
164 R LGRAV ,SH4TREE ,SH3TREE,IRLEN20,ISLEN20,IRLEN20T,ISLEN20T ,
165 S IRLEN20E,ISLEN20E,IRBE3,LRBE3 ,FRBE3 ,FR_I2M,IAD_I2M,FR_RBE3M,
166 T IAD_RBE3M,FRWL6,IRBE2 ,LRBE2 ,INTBUF_TAB_C,IKINE ,DIAG_SMS,
167 V ICFIELD,LCFIELD,CFIELD,COUNT_REMSLV,COUNT_REMSLVE,
168 X ELBUF_TAB,ELBUF_IMP,XDP,WEIGHT_MD , STACK ,
169 Y DIMFB ,FBSAV6 ,STABSEN,TABSENSOR,DRAPE_SH4N, DRAPE_SH3N,
170 Z H3D_DATA,MULTI_FVM,IGRBRIC,IGRSH4N,IGRSH3N,IGRBEAM,FORNEQS,MAXDGAP,
171 A NDDL0 ,NNZK0 ,IT_T ,IMPBUF_TAB,CPTREAC,FTHREAC,NODREAC, DRAPEG,
172 B INTERFACES,TH_SURF,DPL0CLD,VEL0CLD,SNPC,STF,GLOB_THERM, WFEXT_MD)
173C-----------------------------------------------
174C M o d u l e s
175C-----------------------------------------------
176 USE timer_mod
177 USE dsgraph_mod
178 USE imp_lintf
179 USE imp_worki
180 USE imp_pcg_proj
181 USE message_mod
182 USE elbufdef_mod
183 USE intbufdef_mod
184 USE stack_mod
185 USE h3d_mod
186 USE multi_fvm_mod
187 USE groupdef_mod
188 USE drape_mod
189 USE impbufdef_mod
190 USE sensor_mod
191 USE interfaces_mod
192 USE th_surf_mod , ONLY : th_surf_
193 USE skew_mod
194 use glob_therm_mod
195 use python_funct_mod, only: python_
196C-----------------------------------------------
197C I m p l i c i t T y p e s
198C-----------------------------------------------
199#include "implicit_f.inc"
200C-----------------------------------------------
201C C o m m o n B l o c k s
202C-----------------------------------------------
203#include "comlock.inc"
204#if defined(MUMPS5)
205#include "dmumps_struc.h"
206#endif
207#include "param_c.inc"
208#include "com01_c.inc"
209#include "com04_c.inc"
210#include "com08_c.inc"
211#include "impl1_c.inc"
212#include "impl2_c.inc"
213#include "scr03_c.inc"
214#include "scr06_c.inc"
215#include "scr16_c.inc"
216#include "timeri_c.inc"
217#include "units_c.inc"
218#include "task_c.inc"
219C-----------------------------------------------
220C D u m m y A r g u m e n t s
221C-----------------------------------------------
222 TYPE(timer_) :: TIMERS
223 TYPE(python_) :: PYTHON
224 INTEGER ,INTENT(IN) :: NSENSOR
225 INTEGER ,INTENT(IN) :: SNPC
226 INTEGER ,INTENT(IN) :: STF
227 INTEGER ITASK,ICODE(*), ISKEW(*), ISKWN(LISKN,*),ITABM1(*),
228 . IPART(*),IXS(*),IXQ(NIXQ,*),IXC(NIXC,*), IXT(NIXT,*),
229 . IXP(NIXP,*),IXR(NIXR,*), IXTG(NIXTG,*), IXTG1(4,*),
230 . ITAB(*),NPC(*), IBCL(*), IBFV(*),IPARG(NPARG,*),IPARI(NPARI,*),
231 . NPRW(*), NPBY(NNPBY,*), LPBY(*),IADS_F(*),
232 . LRIVET(*), NSTRF(*), LJOINT(*), ICODT(*), ICODR(*), ILINK(*),
233 . LLINK(*),ISKY(*),ADSKY(*),
234 . NNLINK(10,*),LNLINK(*),IGRV(*),IKINE(*),
235 . WEIGHT(*),IFRAME(LISKN,*),IBVEL(NBVELP,*),LBVEL(*),
236 . IACTIV(*),IGEO(*),IPM(*),ICONX(*),NODFT ,NODLT,IT,
237 . WEIGHT_MD(*),DIMFB,STABSEN,TABSENSOR(*),CPTREAC,NODREAC(*)
238 INTEGER LPRW(*), FR_WALL(NSPMD+2,*),FR_ELEM(*),
239 . IAD_ELEM(2,*),NBINTC ,INTLIST(*), IPIV_K(*), NKCOND,
240 . NODGLOB(*), CDDLP(*),LGRAV(*)
241 INTEGER NDDL0,NNZK0,IT_T,MONVOL(*),FR_MV(*),
242 . DIRUL(*),SH4TREE(*), SH3TREE(*),
243 . FR_I2M(*),IAD_I2M(*),FR_RBE3M(*),IAD_RBE3M(*),
244 . ICFIELD(*),LCFIELD(*),COUNT_REMSLV(*),COUNT_REMSLVE(*)
245 my_real
246 . X(3,*) ,D(3,*) ,V(3,*) ,VR(3,*),DAMP(*),
247 . MS(*) ,IN(*) ,PM(NPROPM,*),GEO(NPROPG,*),
248 . BUFMAT(*) ,TF(*) ,FORC(*) ,VEL(*),FSAV(NTHVKI,*) ,ELBUF(*) ,
249 . RWBUF(NRWLP,*),RWSAV(*),RBY(NRBY,*),
250 . rivet(*),wa(*), a(3,*) ,ar(3,*),partsav(*) ,
251 . stifn(*) ,stifr(*),fsky(*),fskyi(*),dr(3,*),
252 . eani(*),agrv(*), thke(*),fr_wave(*),parts0(*),bufgeo(*),
253 . xframe(nxframe,*),w16(*),fbvel(*),fskym(*),bufsf(*),
254 . fopt(6,*),fsavd(nthvki,*), fac_k(*), diag_sms(*),
255 . cfield(*),forneqs(*),maxdgap(ninter),fthreac(6,*)
256 INTEGER NUM_IMP(*),NS_IMP(*),NE_IMP(*),IND_IMP(*),NINT7
257 INTEGER NEWFRONT(*),ISENDTO(*),IRECVFROM(*),IMSCH ,
258 . I2MSCH ,ISIZXV,ILENXV ,ISLEN7 ,IRLEN7 ,ISLEN11,IRLEN11,
259 . ISLEN17,IRLEN17,IRLEN7T,ISLEN7T,
260 . IRLEN20,ISLEN20,IRLEN20T,ISLEN20T,IRLEN20E,ISLEN20E,
261 . KINET(*),NUM_IMP1(*),IRBE3(*),LRBE3(*),IRBE2(*),LRBE2(*)
262 my_real, INTENT(IN) :: DPL0CLD(6,NCONLD),VEL0CLD(6,NCONLD)
263 my_real DT2PREV,VOLMON(*) ,TEMP(*), WAINT(*),FRBE3(*)
264 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB, ELBUF_IMP
265 DOUBLE PRECISION FRWL6(*), XDP(3,*)
266 DOUBLE PRECISION FBSAV6(12,6,DIMFB)
267C
268 TYPE(PRGRAPH) :: GRAPHE(*)
269C
270#ifdef MUMPS5
271 TYPE(dmumps_struc) MUMPS_PAR
272#else
273 ! Fake declaration as DMUMPS_STRUC is shipped with MUMPS
274 INTEGER MUMPS_PAR
275#endif
276 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*), INTBUF_TAB_C
277 TYPE (STACK_PLY) :: STACK
278 TYPE(H3D_DATABASE) :: H3D_DATA
279 TYPE(MULTI_FVM_STRUCT), INTENT(INOUT) :: MULTI_FVM
280!
281 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
282 TYPE (GROUP_) , DIMENSION(NGRSHEL) :: IGRSH4N
283 TYPE (GROUP_) , DIMENSION(NGRSH3N) :: IGRSH3N
284 TYPE (GROUP_) , DIMENSION(NGRBEAM) :: IGRBEAM
285 TYPE (GROUP_) , DIMENSION(NSURF) :: IGRSURF
286 TYPE (DRAPE_) :: DRAPE_SH4N(NUMELC_DRAPE), DRAPE_SH3N(NUMELTG_DRAPE)
287 TYPE (IMPBUF_STRUCT_) ,TARGET :: IMPBUF_TAB
288 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) :: SENSOR_TAB
289 TYPE (DRAPEG_) :: DRAPEG
290 TYPE (INTERFACES_) ,INTENT(IN) :: INTERFACES
291 TYPE (TH_SURF_) , INTENT(INOUT) :: TH_SURF
292 TYPE(skew_),INTENT(INOUT) :: SKEWS
293 type (glob_therm_) , INTENT(INOUT) :: GLOB_THERM
294 DOUBLE PRECISION,INTENT(INOUT) :: WFEXT, WFEXT_MD
295C
296C---D_IMP: dUn+1,i,DD : ddU,i+1
297C---R_IMP[1:R02,2:RRR(R_OLD),3:RU0,4:E02,5:DE_OLD,6:EIMP,7,8,9:pour line-search]
298C---R_IMP[10: BFAC,DTFAC,11:U2,12:RFAC,13:|FEXT|;14,16:new line-search;17:actual R02;18:GAP;19:TSTART;
299C---R_IMP[21:rel res disp.,22:rel res force,23:rel res energy,24:cumul arc length]
300C---------20-25:libre
301C---I_IMP[1:IT(TOTAL),2:ITC,3:IT0(IT_OLD),4:IWAIT,5:IDIV,6:NDDLI0,7:1ercontact(used only w/ IREFI=4),
302C---8:num. of diverging, 9:ICONT_OLD 10:Isign (Riks);11: Ichang(solver);12: IDIV_OLD;13: NDDLI(SMP) or NDDLI_G(SPMD)
303#if defined(MUMPS5)
304C----------------------------------------------
305C L o c a l V a r i a b l e s
306C-----------------------------------------------
307 INTEGER NNMAX,NKMAX,N_IMPN,N_IMPM,LNSS,LNSS2,NDT,NDS,NT_RW
308 INTEGER I,J,NTMP,L1,L2,L3,NNDL,INPRINT,ISTOP,LI10,LI11,
309 . li1,li2,li3,li4,li5,li6,li7,li8,li9,lif,ic,isetp,
310 . li12,nddl_ini0,li13,li14,li15,lnss3,lnsb2,lnsrb2
311 INTEGER, DIMENSION(:),ALLOCATABLE :: IADI0,JDII0
312C
313 INTEGER, DIMENSION(:),ALLOCATABLE :: NSS,ISS,NSS2,ISS2,NSS3,ISS3
314 INTEGER, DIMENSION(:),ALLOCATABLE :: NSB2,ISB2,IAINT2
315C ---INEGA is defined now in impl1_c.inc---
316 INTEGER NNOD,IFDIS,NODFTSK ,NODLTSK,N1,N2,N3
317C
318 INTEGER LBAND,NCL_MAX,IRFLAG,IPRINT0,IPRJ_S
319C
320 INTEGER IBID,IFIF,F_DDL,L_DDL,NSPC_OLD,NSPC,NFXV_G
321C
322 my_real rbid,efac,lbb(nddl0),dummy_fext(3,1)
323 my_real tfexc,tmp,tmp1,tmp2,r2,bfac,faci,r02,gap,bid,we_imp
324 my_real,DIMENSION(:),ALLOCATABLE :: diag_i0,lt_i0
325C
326 INTEGER, POINTER :: NDDL,NNZK,NRBYAC,NINT2,NMC,NMC2,NMONV
327 INTEGER, DIMENSION(:) ,POINTER :: IADK,JDIK,IADM,JDIM
328 INTEGER, DIMENSION(:) ,POINTER :: IDDL,NDOF,INLOC,LSIZE,I_IMP,IKC,
329 . IRBYAC,NSC,IINT2,NKUD,IMONV,
330 . IKINW,W_DDL,IKUDN,NDOFI,IDDLI,IKUD
331 my_real, DIMENSION(:) ,POINTER :: DIAG_K,LT_K,DIAG_M,LT_M,LB,
332 . LB0,BKUD,D_IMP,ELBUF_C,BUFMAT_C,
333 . DR_IMP,X_C,DD,DDR,X_A,R_IMP
334 my_real, DIMENSION(:) ,POINTER :: FEXT,DG,DGR,DG0,DGR0,BUFIN_C,AC,ACR
335c sb
336 character*1 anew_stif
337
338C-----------------------------------------------
339 anew_stif = ' '
340 dummy_fext = zero
341 rbid = zero
342c
343C-----------------------------------------------
344C---IMCONV : 0 iteration; 1 converge; -1 line-search, -2 change dt during iteration-----
345C--- -3 only reset iteration with Dn-1=0-----
346C-----------------------------------------------
347 nddl => impbuf_tab%NDDL
348 nnzk => impbuf_tab%NNZK
349 nrbyac => impbuf_tab%NRBYAC
350 nint2 => impbuf_tab%NINT2
351 nmc => impbuf_tab%NMC
352 nmc2 => impbuf_tab%NMC2
353 nmonv => impbuf_tab%NMONV
354 iadk => impbuf_tab%IADK
355 jdik => impbuf_tab%JDIK
356 iadm => impbuf_tab%IADM
357 jdim => impbuf_tab%JDIM
358 iddl => impbuf_tab%IDDL
359 ndof => impbuf_tab%NDOF
360 inloc => impbuf_tab%INLOC
361 lsize => impbuf_tab%LSIZE
362 i_imp => impbuf_tab%I_IMP
363 irbyac => impbuf_tab%IRBYAC
364 nsc => impbuf_tab%NSC
365 iint2 => impbuf_tab%IINT2
366 nkud => impbuf_tab%NKUD
367 imonv => impbuf_tab%IMONV
368 ikinw => impbuf_tab%IKINW
369 ikc => impbuf_tab%IKC
370 w_ddl => impbuf_tab%W_DDL
371 ikud => impbuf_tab%IKUD
372 ndofi=> impbuf_tab%NDOFI
373 iddli=> impbuf_tab%IDDLI
374C
375 diag_k =>impbuf_tab%DIAG_K
376 lt_k =>impbuf_tab%LT_K
377 diag_m =>impbuf_tab%DIAG_M
378 lt_m =>impbuf_tab%LT_M
379 lb =>impbuf_tab%LB
380 lb0 =>impbuf_tab%LB0
381 bkud =>impbuf_tab%BKUD
382 d_imp =>impbuf_tab%D_IMP
383 dr_imp =>impbuf_tab%DR_IMP
384 elbuf_c =>impbuf_tab%ELBUF_C
385 bufmat_c=>impbuf_tab%BUFMAT_C
386 x_c =>impbuf_tab%X_C
387 x_a =>impbuf_tab%X_A
388 dd =>impbuf_tab%DD
389 ddr =>impbuf_tab%DDR
390 fext =>impbuf_tab%FEXT
391 dg =>impbuf_tab%DG
392 dgr =>impbuf_tab%DGR
393 dg0 =>impbuf_tab%DG0
394 dgr0 =>impbuf_tab%DGR0
395 ac=>impbuf_tab%AC
396 acr=>impbuf_tab%ACR
397 r_imp => impbuf_tab%R_IMP
398 ALLOCATE(iaint2(nint2))
399C--------explicite iteration only-------------
400C-------smp // first for IMP_GLOB_K, PCG solver, Nonlinear drivers,
401 ndt=nexp
402 IF (i_imp(4)>0) THEN
403 CALL integrator_hp(ndt ,d_imp ,dr_imp,
404 1 x ,v ,vr ,a ,ar )
405C /---------------/
406 i_imp(4)=i_imp(4)-1
407 IF (imconv==1) imconv=2
408 RETURN
409 ENDIF
410C------------------------------
411C Initialization
412C------------------------------
413 iprint0=0
414 IF (ispmd==0) THEN
415 IF(ncycle==1.AND.imconv==1.AND.i_imp(5)==0) iprint0=1
416 IF (iline/=1) inprint=nprint
417 ELSE
418 inprint=0
419 ENDIF
420C
421 IF (irref>0.AND.imconv==1.AND.iline/=1) THEN
422 irflag=irref
423 ELSE
424 irflag=0
425 ENDIF
426C
427 isetp=isetk
428 nddli=0
429 nddli_g=0
430 IF (nint7==0) THEN
431 DO i=1,numnod
432 ndofi(i)=0
433 ENDDO
434 ENDIF
435 istop=0
436 IF (imconv==2) imconv=1
437 nndl = 3*numnod
438C
439 nsrem=0
440 nsl=0
441 iconta = 0
442C
443 we_imp = wfext
444 IF (imconv==1) THEN
445 iter_nl=0
446 ELSE
447 iter_nl=it+1
448 END IF
449 IF(ncycle==1.AND.imconv==1.AND.i_imp(5)==0) THEN
450 r_imp(19)=tt-dt2
451C---------for interface sorting
452 IF(ninter>0) CALL ini_bminma_imp(intbuf_tab)
453 END IF
454c
455C-----------------------------
456 IF (imconv==3) CALL cp_real_hp(nndl,x_c,x)
457 nfxv_g = nfxvel
458 IF (nspmd>1) CALL spmd_max_i(nfxv_g)
459C
460 IF (ilintf>0) THEN
461 ALLOCATE(xi_c(nndl))
462 IF (ncycle==1) THEN
463 CALL cp_impbuf(
464 . 1 ,elbuf,elbuf_c,bufmat ,bufmat_c,
465 . fsav ,volmon ,partsav ,intbuf_tab ,
466 . intbuf_tab_c,ipari ,islen7 ,irlen7 ,
467 . islen11,irlen11,islen17 ,irlen17,irlen7t ,
468 . islen7t,irlen20,islen20 ,irlen20t,islen20t,
469 . irlen20e,islen20e,newfront,elbuf_tab,elbuf_imp,
470 . iparg )
471 CALL cp_real_hp(nndl,x,x_c)
472 CALL imp_setb(a ,ar ,iddl ,ndof ,lb0 )
473 CALL ini_kif
474 i_imp(2)=lprint
475 lprint = 0
476 CALL cp_real_hp(nndl,x,xi_c)
477 ELSE
478 CALL cp_impbuf(
479 . 2 ,elbuf,elbuf_c,bufmat ,bufmat_c,
480 . fsav ,volmon ,partsav ,intbuf_tab ,
481 . intbuf_tab_c,ipari ,islen7 ,irlen7 ,
482 . islen11,irlen11,islen17 ,irlen17,irlen7t ,
483 . islen7t,irlen20,islen20 ,irlen20t,islen20t,
484 . irlen20e,islen20e,newfront,elbuf_tab,elbuf_imp,
485 . iparg )
486 CALL cp_real_hp(nndl,x_c,x)
487 CALL cp_real_hp(nndl,x_c,xi_c)
488 CALL integrator1_hp(d_imp ,xi_c )
489 CALL imp_b2a(a ,ar ,iddl ,ndof ,lb0 )
490 IF (ncycle==ilintf) THEN
491 lprint = i_imp(2)
492 ELSE
493 lprint = 0
494 ENDIF
495C----------otherwise, X_A is accumulated---
496 CALL cp_real_hp(nndl,x,x_a)
497 ENDIF
498 ENDIF
499C
500 IF (imconv==1 ) THEN
501 r_imp(16)=zero
502C R_IMP(6)=ZERO
503C---------initialise D,DD-----
504 IF (ncycle>1.AND.iline/=1) THEN
505C-----------------Dn,0=Dn-1--------
506c CALL CP_REAL(NNDL,D_IMP,DD)
507c IF (IRODDL/=0) CALL CP_REAL(NNDL,DR_IMP,DDR)
508C----------for the case where the run diverges due to the first contact(Gravity)->
509C----------use reduced Dn_1 instead of resolution:
510 CALL du_ini_hp(d_imp ,dr_imp,dd ,
511 1 ddr ,i_imp(5),i_imp(7))
512 ENDIF
513 CALL zeror_hp(d_imp,numnod)
514 IF (iroddl/=0) CALL zeror_hp(dr_imp,numnod)
515C permet aussi de faire linear avec 'initial state'
516 CALL zeror_hp(ac,numnod)
517 IF (iroddl/=0) CALL zeror_hp(acr,numnod)
518C
519 IF (isigini==1.AND.ncycle==1) THEN
520 CALL imp_setb(a ,ar ,iddl ,ndof ,lb0 )
521 ENDIF
522C
523 IF (ncycle==1.AND.idyna>0)
524 . CALL dyna_ina(ibcl ,forc ,snpc ,npc ,tf ,a ,
525 2 v ,x ,skews ,ar ,vr ,
526 3 sensor_tab ,weight ,tfexc ,iads_f ,
527 4 fsky ,igrv ,agrv ,ms ,in ,
528 5 lgrav ,itask ,nrbyac ,irbyac ,npby ,
529 6 rby ,fr_elem ,iad_elem ,nddl0 ,nnzk0 ,
530 7 i_imp(5) ,h3d_data ,cptreac ,fthreac ,nodreac,
531 8 nsensor ,th_surf ,dpl0cld ,
532 9 vel0cld ,d ,dr ,numnod ,nsurf ,
533 a nfunct ,nconld ,ngrav ,ninvel ,stf ,numskw,
534 b wfext,python)
535C
536C----------------------------------
537C EXTERNAL FORCES A=Fext-Fint
538C----------------------------------
539C
540 ncl_max=0
541 IF(nconld/=0) THEN
542 IF (imon>0) CALL startime(timers,4)
543C --spmd : force treated like elements ---
544 CALL force_imp( ibcl ,forc ,snpc ,npc ,tf ,
545 2 ac ,v ,x ,skews ,
546 3 acr ,vr ,nsensor ,sensor_tab ,tfexc ,
547 4 iads_f ,fsky ,dummy_fext ,h3d_data ,cptreac ,
548 5 fthreac ,nodreac ,th_surf ,
549 6 dpl0cld ,vel0cld ,d ,dr ,nconld ,
550 7 numnod ,nfunct ,stf ,wfext)
551C
552 IF (nspmd>1) THEN
553 DO i=iad_elem(1,1),iad_elem(1,nspmd+1)-1
554 j = fr_elem(i)
555 n1 = 3*(j-1)+1
556 n2 = 3*(j-1)+2
557 n3 = 3*(j-1)+3
558 tmp = abs(ac(n1))+abs(ac(n2))+abs(ac(n3))
559 IF (iroddl/=0) tmp = tmp + abs(acr(n1))+abs(acr(n2))+abs(acr(n3))
560 IF (tmp>zero) ncl_max = ncl_max + 1
561 ENDDO
562 ENDIF
563C
564 IF (imon>0) CALL stoptime(timers,4)
565 ENDIF
566C
567 IF (nspmd>1) THEN
568 CALL spmd_max_i(ncl_max)
569 IF (ncl_max>0) THEN
570 lband = iad_elem(1,nspmd+1)-iad_elem(1,1)
571 IF (iroddl/=0) THEN
572 ntmp = 6
573 ELSE
574 ntmp = 3
575 ENDIF
576 CALL spmd_sumf_a(ac,acr,iad_elem,fr_elem,ntmp,lband)
577 ENDIF
578 ENDIF
579C---------no //SMP for the moment, add it after----
580 IF(ngrav/=0) THEN
581 IF (imon>0) CALL startime(timers,4)
582 CALL gravit_imp(igrv ,agrv ,npc ,tf ,ac,
583 2 v ,x ,skews%SKEW ,ms,tfexc,
584 3 nsensor,sensor_tab,weight,
585 4 lgrav ,itask,
586 5 nrbyac,irbyac,npby ,rby, python)
587 IF (imon>0) CALL stoptime(timers,4)
588 ENDIF
589C---------no //SMP for the moment, add it after----
590 IF(nloadc/=0) THEN
591 IF (imon>0) CALL startime(timers,4)
592 CALL cfield_imp(icfield ,cfield,npc ,tf ,ac,
593 2 v ,x ,xframe ,ms,tfexc,
594 3 nsensor,sensor_tab,weight,iframe,
595 4 lcfield ,itask,
596 5 nrbyac,irbyac,npby ,rby,iskew,python )
597 IF (imon>0) CALL stoptime(timers,4)
598 ENDIF
599
600
601 wfext = we_imp
602C END IF (IMCONV==1)
603 ENDIF
604C-------------dU_d---------------------------------
605 IF(nfxvel/=0.AND.(imconv==1.OR.imconv==3)) THEN
606 IF (imon>0) CALL startime(timers,4)
607 CALL fv_imp(ibfv ,npc ,tf ,vel ,sensor_tab,
608 1 d_imp ,dr_imp ,ikc ,iddl ,nsensor ,
609 2 skews%SKEW ,iframe ,xframe ,v ,vr ,
610 3 x ,dirul ,ndof ,a ,ar )
611 IF (imon>0) CALL stoptime(timers,4)
612 ENDIF
613C-------------RGWAL0_IMP peut suivre-ISETK=1, mais il faut changer-FV_IMP1
614C-------------(IKC(I)=4->IMCONV=1 pour eviter le rebond-------
615 nt_rw=0
616 IF (nrwall>0) THEN
617 IF (imon>0) CALL startime(timers,4)
618 DO i=1,nddl0
619 IF (ikc(i)==3.OR.ikc(i)==10) ikc(i)=0
620 ENDDO
621 IF (imconv==1) THEN
622 DO i=1,nddl0
623 IF (ikc(i)==4.OR.ikc(i)==11) ikc(i)=0
624 ENDDO
625 ENDIF
626
627 IF (ismdisp > 0 .AND. iline == 0) THEN
628 CALL rgwal0_imp(
629 1 x_a ,d_imp ,v ,rwbuf ,lprw ,
630 2 nprw ,ms ,fsav(1,ninter+1),fr_wall ,
631 3 fopt ,rwsav ,weight ,fsavd(1,ninter+1),
632 4 nt_rw ,iddl ,ikc ,imconv ,ndof , frwl6,
633 5 weight_md ,dimfb ,fbsav6 ,stabsen ,tabsensor, wfext, wfext_md)
634 ELSE
635 CALL rgwal0_imp(
636 1 x ,d_imp ,v ,rwbuf ,lprw ,
637 2 nprw ,ms ,fsav(1,ninter+1),fr_wall ,
638 3 fopt ,rwsav ,weight ,fsavd(1,ninter+1),
639 4 nt_rw ,iddl ,ikc ,imconv ,ndof , frwl6,
640 5 weight_md ,dimfb ,fbsav6 ,stabsen ,tabsensor, wfext, wfext_md)
641 ENDIF
642C
643 IF(nt_rw>0) THEN
644 CALL fv_rw(iddl ,ikc ,ndof ,d_imp ,v )
645 ENDIF
646 IF (imon>0) CALL stoptime(timers,4)
647 ENDIF
648C
649 ifdis=nt_rw+nfxv_g
650 IF(ifdis>0.AND.imconv==1) THEN
651 IF (ncycle>1.AND.iline/=1)
652C--------------Dn,0=Dn-1--------
653 . CALL fv_dd0(iddl ,ikc ,ndof ,dd ,ddr ,d_imp)
654 IF(nt_rw>0) THEN
655 DO i=1,nddl0
656 IF (ikc(i)==3) ikc(i)=4
657C
658 IF (ikc(i)==10) ikc(i)=11
659 ENDDO
660 ENDIF
661 ENDIF
662C
663 irwall = nt_rw
664 IF (nspmd>1) CALL spmd_max_i(irwall)
665C-------!!!should stop line-search if Rwall activates!!!
666 IF(irwall>0.AND.imconv>=0) THEN
667 IF(ispmd==0) THEN
668 WRITE(iout,*)' *--------- RIGID WALL IMPACT---------*'
669 WRITE(istdo,*)' *--------- RIGID WALL IMPACT---------*'
670 ENDIF
671 isetk = 1
672 ENDIF
673C
674C----------------------------------
675C LB=Fext ;
676C----------------------------------
677C---------
678 CALL imp_setb(ac ,acr ,iddl ,ndof ,lb )
679C-----------------------
680citask0 END IF !(ITASK == 0) THEN
681C----------------------
682c CALL MY_BARRIER
683C---------------------
684C-----------------------
685 IF (isolv==5.OR.isolv==6.AND.imconv>=0) THEN
686 IF (idsc==0) THEN
687C-----------one update per increment
688 IF (ipupd==0.AND.i_imp(2)==0.AND.it==0) THEN
689 idsc=max(idsc,isetk)
690 ENDIF
691C-----------NDDL could be changed by RWALL impact
692 IF(irwall > 0 ) idsc = 1
693 ENDIF
694 ELSE
695 idsc=max(idsc,isetk)
696 END IF
697C /---------------/
698c CALL MY_BARRIER
699C /---------------/
700C----------------------------------
701C MATRICE DE RIGIDITE
702C----------------------------------
703 IF (isetk ==1 ) THEN
704 IF (imon>0 .AND. itask ==0) CALL startime(timers,31)
705 l1 = 1+nixs*numels
706 l2 = l1+6*numels10
707 l3 = l2+12*numels20
708C----------------------------------
709Citask0 IF (ITASK == 0) THEN
710C----------------------------------
711 nddl = nddl0
712 nnzk = nnzk0
713 nnmax=lsize(9)
714 nkmax=lsize(10)
715 nmc2=lsize(11)
716 CALL zero1(diag_k,nddl)
717 CALL zero1(lt_k,nnzk)
718 li1 =1
719 li2 = li1+lsize(4)
720 li3 = li2+lsize(5)
721 li4 = li3+lsize(1)
722 li5 = li4+lsize(3)
723 li6 = li5+lsize(7)
724 li7 = li6+lsize(2)
725 li8 = li7+lsize(6)
726 li9 = li8+nint2
727 li10 = li9+lsize(8)
728C
729 li11 = li10+(lsize(8)-lcokm)*lsize(9)
730 li12 = li11+lcokm*lsize(10)
731 li13 = li12+4*lsize(11)
732 li14 = li13+lsize(14)
733 li15 = li14+lsize(15)
734 lif = li15+lsize(16)
735C---------attention si rigid body reactive(deactive) pendant un restart il faut relancer aussi dim
736 IF (iline/=1) THEN
737 ntmp=0
738 IF (i_imp(11)==1) THEN
739 ntmp=1
740 i_imp(11)=-1
741 ENDIF
742 CALL ind_glob_k(npby ,lpby ,
743 1 itab ,nrbyac ,irbyac ,nsc ,ikinw(li1),
744 2 nmc ,ikinw(li2),ikinw(li3),ikinw(li4),nint2 ,
745 3 iint2 ,ipari ,intbuf_tab,ikinw(li8),ikinw(li5),
746 4 ikinw(li6),ikinw(li7),iparg ,elbuf ,elbuf_tab ,
747 5 ixs ,ixq ,ixc ,ixt ,ixp ,
748 6 ixr ,ixtg ,ixtg1 ,ixs(l1) ,ixs(l2) ,
749 7 ixs(l3) ,iddl ,ndof ,iadk ,
750 8 jdik ,nddl ,nnzk ,nnmax ,lsize(8) ,
751 9 inloc ,nkmax ,ikinw(li9),ikinw(li10),ikinw(li11),
752 a nmc2 ,ikinw(li12),ntmp ,lsize(12) ,lsize(13) ,
753 b fr_elem ,iad_elem ,ipm ,igeo ,irbe3 ,
754 c lrbe3 ,ikinw(li13),fr_i2m ,iad_i2m ,fr_rbe3m ,
755 d iad_rbe3m ,irbe2 ,lrbe2 ,ikinw(li14),ikinw(li15))
756C-------------important is no buffer overflow
757C NDDL0 = NDDL
758C NNZK0 = NNZK
759 ENDIF
760C----------------------------------
761citask0 END IF !IF (ITASK == 0) THEN
762C----------------------------------
763C /---------------/
764c CALL MY_BARRIER
765C /---------------/
766c NGDONE = 1
767 CALL imp_glob_khp(
768 1 pm ,geo ,ipm ,igeo ,elbuf ,
769 2 ixs ,ixq ,ixc ,ixt ,ixp ,
770 3 ixr ,ixtg ,ixtg1 ,ixs(l1) ,
771 4 ixs(l2) ,ixs(l3) ,iparg ,tf ,npc ,
772 5 fr_wave ,w16 ,bufmat ,thke ,bufgeo ,
773 6 rby ,skews%SKEW ,x ,
774 7 wa ,iddl ,ndof ,diag_k ,lt_k ,
775 8 iadk ,jdik ,ikg ,ibid ,itask ,
776 9 elbuf_tab ,stack ,drape_sh4n, drape_sh3n ,drapeg )
777C
778C /---------------/
779c CALL MY_BARRIER
780C /---------------/
781 nddl_l = nddl
782C-----------------------------
783citask0 IF (ITASK == 0) THEN
784C-----------------------------
785 IF (idyna>0.AND.idy_damp>0) THEN
786 CALL dyna_cpk0(nddl ,nnzk ,iadk ,jdik ,diag_k ,
787 . lt_k )
788 END IF
789C-------estimation of A(t+dt) w/ initial velocity----
790 IF (ncycle==1.AND.imconv==1.AND.i_imp(5)==0
791 . .AND.idyna>0.AND.ninvel>0) THEN
792 CALL imp_dykv0(nodft ,nodlt ,iddl ,ndof ,ikc ,
793 . diag_k ,iadk ,jdik ,lt_k ,weight ,
794 1 rby ,x ,skews%SKEW ,lpby ,npby ,
795 2 nrbyac ,irbyac ,nint2 ,iint2 ,ipari ,
796 3 intbuf_tab ,irbe3 ,lrbe3 ,frbe3 ,
797 4 irbe2 ,lrbe2 ,v ,vr ,nddl0 ,
798 5 fr_elem,iad_elem,ms ,in )
799 END IF
800 IF (idyna>0.OR.iqstat>0)
801 . CALL imp_dynam(nodft ,nodlt ,iddl ,ndof ,diag_k ,
802 . ms ,in ,hht_a ,weight ,iadk ,
803 . lt_k )
804C
805 IF (ikpres>0.AND.nbuck==0)
806 1 CALL imp_kpres(ibcl ,forc ,npc ,tf ,x ,
807 2 skews%SKEW ,nsensor,sensor_tab,weight,iads_f,
808 3 iddl ,ndof ,iadk ,jdik ,diag_k,
809 4 lt_k )
810 IF(iautspc>0) THEN
811 IF(ncycle==1.AND.imconv==1.AND.i_imp(5)==0) THEN
812 ELSE
813 CALL get_nspc(nspc_old)
814 IF (nspmd > 1) CALL spmd_max_i(nspc_old)
815 END IF
816 ENDIF
817 CALL upd_glob_k(
818 1 icodt ,icodr ,iskew ,ibfv ,npc ,
819 2 tf ,vel ,xframe ,
820 3 rby ,x ,skews%SKEW ,lpby ,npby ,
821 4 itab ,weight ,ms ,in ,nrbyac ,
822 5 irbyac ,nsc ,ikinw(li1),nmc ,ikinw(li2),
823 6 ikinw(li3),ikinw(li4),nint2 ,iint2 ,ikinw(li8),
824 7 ikinw(li5),ikinw(li6),ikinw(li7),ipari ,intbuf_tab,
825 8 nddl ,nnzk ,iadk ,jdik ,
826 9 diag_k ,lt_k ,ndof ,iddl ,ikc ,
827 a d_imp ,lb ,nkud ,ikud ,bkud ,
828 b nmc2 ,ikinw(li12),nt_rw ,dr_imp ,dirul ,
829 c irbe3 ,lrbe3 ,frbe3 ,ikinw(li13),irbe2 ,
830 d lrbe2 ,ikinw(li14),ikinw(li15))
831C
832 anew_stif = 'Y'
833c
834 IF (nspmd>1) THEN
835 CALL upd_fr_k(
836 1 iadk ,jdik ,ndof ,ikc ,iddl ,
837 2 inloc ,fr_elem ,iad_elem ,nddl )
838C
839 CALL weightddl(iddl ,ndof ,ikc ,weight ,w_ddl ,inloc )
840 ENDIF
841C--------case autospc---------
842 IF(iautspc>0) THEN
843 IF(ncycle==1.AND.imconv==1.AND.i_imp(5)==0) THEN
844 ELSE
845 CALL get_nspc(nspc)
846 IF (nspmd > 1) CALL spmd_max_i(nspc)
847 IF (nspc/=nspc_old) THEN
848 imconv=-2
849 IF (ispmd==0) THEN
850 WRITE(iout,1012)nspc_old,nspc
851 WRITE(istdo,1012)nspc_old,nspc
852 ENDIF
853 CALL put_nspc(nspc_old)
854 ENDIF
855 END IF
856 ENDIF
857C
858 IF (n_pat>1) THEN
859 CALL fil_span1(nrbyac,irbyac,npby,iddl,nddl,ikc,ndof,inloc)
860 ENDIF
861C
862 IF(ncycle==1.AND.imconv==1.AND.i_imp(5)==0) THEN
863C--------case mono-domain, Multi-domain NDDL_G is set inside PR_INFOK
864 nddl_g = nddl
865 CALL pr_infok(nddl0,nnzk0,nddl,nnzk,max(nnmax,nkmax))
866C
867 IF (iprec>4) THEN
868 CALL k_band(nddl,iadk,jdik,ibid)
869 maxb = min(maxb,ibid)
870 IF (maxb>10000) THEN
871 CALL m_lnz(nddl,iadk,jdik,maxb,max_l)
872 ENDIF
873 ENDIF
874C
875 ntmp = (tstop-tt)/dt2
876 IF (ntmp>=2) THEN
877 idsgap = 1
878 ELSE
879 idsgap = 0
880 ENDIF
881C
882 IF (isolv==7) THEN
883 CALL crit_llim(nddl,nnzk)
884 END IF
885C
886 IF (nspmd == 1) THEN
887 DO i=1,nddl
888 w_ddl(i)=1
889 ENDDO
890 ENDIF
891 IF (imconv/=-2)CALL ini_k0h(nddl,nnzk,nnzk,iadk,jdik)
892C
893 ENDIF
894C
895 IF (nint7<=0.AND.imconv==1.AND.nspmd==1)
896 . CALL imp_check(itab ,nddl ,iddl ,diag_k ,ndof ,
897 . ikc ,inloc ,nddl0 )
898C
899 IF (imon>0) CALL stoptime(timers,31)
900C
901 IF (isolv==4.OR.isolv==6) THEN
902 CALL arret(5)
903 ENDIF
904C-----------------------------
905citask0 END IF !(ITASK == 0) THEN
906C-----------------------------
907c CALL MY_BARRIER
908C ---------------
909 IF (imconv==-2.AND.iline==0) THEN
910 IF (nint7 > 0) nint7=0
911 GOTO 100
912 END IF
913 ENDIF !IF (ISETK ==1 )
914C-----------------------------
915citask0 IF (ITASK == 0) THEN
916C-----------------------------
917 IF (iqstat>0) THEN
918 CALL qstat_ini(nddl ,inloc ,iddl ,ndof ,ikc ,
919 . ms ,in )
920 ENDIF
921C----------------------------------
922C MATRICE DE RIGIDITE D'INTERFACE
923C----------------------------------
924 gap=ep20
925 IF (nint7>0) THEN
926 l1=lsize(1)
927 l2=lsize(2)
928 lnss2=0
929 lnss=0
930 IF (imon>0) CALL startime(timers,31)
931 CALL sav_inttd(nint7,num_imp,ns_imp(1+nt_imp5),
932 1 ne_imp(1+nt_imp5),ind_imp,num_imp1)
933C
934 IF (imp_int==1) CALL idel_int(
935 1 ipari ,intbuf_tab,num_imp ,ns_imp ,ne_imp ,
936 2 ind_imp ,ndof ,nint7 )
937C
938 CALL dim_int_k(
939 1 ipari ,intbuf_tab,num_imp ,ns_imp ,ne_imp ,
940 2 npby ,lpby ,itab ,nrbyac ,irbyac ,
941 3 lnss ,nint2 ,iint2 ,iaint2 ,lnss2 ,
942 4 nddli ,nnzi ,iddli ,ndofi ,n_impn ,
943 5 n_impm ,nnmax ,nkmax ,ndof ,nsrem ,
944 6 irbe3 ,lrbe3 ,lnss3 ,irbe2 ,lrbe2 ,
945 7 lnsb2 ,lnsrb2 ,ind_imp )
946 ALLOCATE(iadi0(nddli+1))
947 ALLOCATE(itok(nddli))
948 ALLOCATE(jdii0(nnzi))
949 ALLOCATE(nss2(l2),nss3(nrbe3),nsb2(lnsrb2))
950 nsb2=0
951 ALLOCATE(iss2(lnss2),iss3(lnss3),isb2(lnsb2))
952 ALLOCATE(nss(l1))
953 ALLOCATE(iss(lnss))
954C
955 DO i=1,l1
956 nss(i)=0
957 ENDDO
958C
959 CALL ind_int_k(
960 1 ipari ,intbuf_tab,num_imp ,ns_imp ,ne_imp ,
961 2 npby ,lpby ,itab ,nrbyac ,irbyac ,
962 3 nss ,iss ,nint2 ,iint2 ,nss2 ,
963 4 iss2 ,nddli ,nnzi ,iadi0 ,jdii0 ,
964 5 iddli ,ndofi ,n_impn ,itok ,iddl ,
965 6 nnmax ,nkmax ,n_impm ,ndof ,iaint2 ,
966 7 irbe3 ,lrbe3 ,nss3 ,iss3 ,irbe2 ,
967 8 lrbe2 ,nsb2 ,isb2 ,ind_imp )
968 ALLOCATE(diag_i0(nddli))
969 ALLOCATE(lt_i0(nnzi))
970 CALL zero1(diag_i0,nddli)
971 CALL zero1(lt_i0,nnzi)
972C
973 IF (nsrem>0) THEN
974 CALL imp_fr7i(ipari ,intbuf_tab,num_imp ,ns_imp ,nsrem ,
975 1 nbintc,intlist)
976 IF (intp_c>0)
977 1 CALL ind_frkd(
978 2 ipari ,intbuf_tab,num_imp ,ns_imp ,ne_imp ,
979 3 iddli ,ikc ,ndof ,nsrem ,ind_imp )
980 ENDIF
981C
982 nddl_l = nddli
983Ctmp-------A n'est pas modifie ici -------------------
984 IF (ilintf>0) THEN
985 CALL imp_int_k(a ,v ,
986 1 icodt ,icodr ,iskew ,ibfv ,npc ,
987 2 tf ,vel ,nsensor ,sensor_tab,xframe ,
988 3 rby ,xi_c ,skews%SKEW ,lpby ,npby ,
989 4 itab ,weight ,ms ,in ,nrbyac ,
990 5 irbyac ,nss ,iss ,ipari ,intbuf_tab,
991 6 nint2 ,iint2 ,iaint2 ,nss2 ,
992 7 iss2 ,nddli ,nnzi ,iadi0 ,jdii0 ,
993 8 diag_i0 ,lt_i0 ,iddli ,nddl0 ,iadk ,
994 9 jdik ,ikc ,diag_k ,lt_k ,iddl ,
995 a num_imp ,ns_imp ,ne_imp ,ind_imp ,ndofi ,
996 b itok ,d_imp ,lb ,gap ,dirul ,
997 c nt_rw ,num_imp1 ,irbe3 ,lrbe3 ,frbe3 ,
998 d nss3 ,iss3 ,irbe2 ,lrbe2 ,nsb2 ,
999 e isb2 )
1000 ELSEIF (ismdisp>0.AND.iline==0) THEN
1001 CALL imp_int_k(a ,v ,
1002 1 icodt ,icodr ,iskew ,ibfv ,npc ,
1003 2 tf ,vel ,nsensor ,sensor_tab,xframe ,
1004 3 rby ,x_a ,skews%SKEW ,lpby ,npby ,
1005 4 itab ,weight ,ms ,in ,nrbyac ,
1006 5 irbyac ,nss ,iss ,ipari ,intbuf_tab,
1007 6 nint2 ,iint2 ,iaint2 ,nss2 ,
1008 7 iss2 ,nddli ,nnzi ,iadi0 ,jdii0 ,
1009 8 diag_i0 ,lt_i0 ,iddli ,nddl0 ,iadk ,
1010 9 jdik ,ikc ,diag_k ,lt_k ,iddl ,
1011 a num_imp ,ns_imp ,ne_imp ,ind_imp ,ndofi ,
1012 b itok ,d_imp ,lb ,gap ,dirul ,
1013 c nt_rw ,num_imp1 ,irbe3 ,lrbe3 ,frbe3 ,
1014 d nss3 ,iss3 ,irbe2 ,lrbe2 ,nsb2 ,
1015 e isb2 )
1016 ELSE
1017 CALL imp_int_k(a ,v ,
1018 1 icodt ,icodr ,iskew ,ibfv ,npc ,
1019 2 tf ,vel ,nsensor ,sensor_tab,xframe ,
1020 3 rby ,x ,skews%SKEW ,lpby ,npby ,
1021 4 itab ,weight ,ms ,in ,nrbyac ,
1022 5 irbyac ,nss ,iss ,ipari ,intbuf_tab,
1023 6 nint2 ,iint2 ,iaint2 ,nss2 ,
1024 7 iss2 ,nddli ,nnzi ,iadi0 ,jdii0 ,
1025 8 diag_i0 ,lt_i0 ,iddli ,nddl0 ,iadk ,
1026 9 jdik ,ikc ,diag_k ,lt_k ,iddl ,
1027 a num_imp ,ns_imp ,ne_imp ,ind_imp ,ndofi ,
1028 b itok ,d_imp ,lb ,gap ,dirul ,
1029 c nt_rw ,num_imp1 ,irbe3 ,lrbe3 ,frbe3 ,
1030 d nss3 ,iss3 ,irbe2 ,lrbe2 ,nsb2 ,
1031 e isb2 )
1032 ENDIF
1033 IF (imon>0) CALL stoptime(timers,31)
1034C
1035 DEALLOCATE(nss2,nss3,nsb2)
1036 DEALLOCATE(iss2,iss3,isb2)
1037 DEALLOCATE(nss)
1038 DEALLOCATE(iss)
1039C
1040 IF (nddli>0) THEN
1041C
1042 ifif = 0
1043 IF (ilintf>0) THEN
1044 ifif = nddlif
1045 CALL save_kif(nddli ,iadi0 ,jdii0 ,diag_i0,lt_i0 ,
1046 1 itok ,nddl)
1047 ENDIF
1048 IF (ifif>0) THEN
1049 nddli = nddlif
1050 ALLOCATE(iadi(nddli+1))
1051 nnzi = iadif(nddli+1)-iadif(1)
1052 ALLOCATE(jdii(nnzi))
1053 DEALLOCATE(itok)
1054 ALLOCATE(itok(nddli))
1055 CALL cp_int_hp(nddli+1,iadif,iadi)
1056 CALL cp_int_hp(nddli,iftok,itok)
1057 CALL cp_int_hp(nnzi,jdiif,jdii)
1058 ALLOCATE(diag_i(nddli))
1059 ALLOCATE(lt_i(nnzi))
1060 CALL cp_real_hp(nddli,diag_if,diag_i)
1061 CALL cp_real_hp(nnzi,lt_if,lt_i)
1062 ELSE
1063C
1064 ALLOCATE(iadi(nddli+1))
1065 ALLOCATE(jdii(nnzi))
1066 CALL cp_int_hp(nddli+1,iadi0,iadi)
1067 CALL cp_int_hp(nnzi,jdii0,jdii)
1068 ALLOCATE(diag_i(nddli))
1069 ALLOCATE(lt_i(nnzi))
1070 CALL cp_real_hp(nddli,diag_i0,diag_i)
1071 CALL cp_real_hp(nnzi,lt_i0,lt_i)
1072C
1073 ENDIF
1074 DEALLOCATE(iadi0)
1075 DEALLOCATE(jdii0)
1076 DEALLOCATE(diag_i0)
1077 DEALLOCATE(lt_i0)
1078C
1079 IF (isolv==4.OR.isolv==6) THEN
1080 CALL arret(5)
1081 ENDIF
1082C
1083 ELSE
1084 ALLOCATE(iadi(1))
1085 ALLOCATE(jdii(1))
1086 DEALLOCATE(iadi0)
1087 DEALLOCATE(jdii0)
1088 ALLOCATE(diag_i(1))
1089 ALLOCATE(lt_i(1))
1090 DEALLOCATE(diag_i0)
1091 DEALLOCATE(lt_i0)
1092 ENDIF
1093C
1094C Store the size of the contact stifness matrix for nonlinear solver outputs
1095 IF ((nspmd==1.OR.nbintc==0).AND.imconv>=0) i_imp(13) = nddli
1096 IF ((nspmd==1.OR.nbintc==0).AND.imconv>=0.AND.
1097 . (lprint/=0.OR.nprint/=0)) THEN
1098 WRITE(iout,1006)
1099 WRITE(istdo,1006)
1100 WRITE(iout,1007)nddli,nnzi !,NNMAX
1101 WRITE(istdo,1007)nddli,nnzi !,NNMAX
1102c WRITE(IOUT,*)
1103c WRITE(ISTDO,*)
1104 ENDIF
1105 ENDIF
1106C----------------------------------
1107 IF (nfxvel/=0.AND.imconv==1) THEN
1108 CALL fv_imp1(nkud ,ikud ,bkud ,lb )
1109 CALL fvbc_impl1(ibfv ,skews%SKEW ,xframe ,dirul ,iddl ,
1110 1 ikc ,ndof ,d_imp ,dr_imp,icodt ,
1111 3 icodr ,iskew )
1112 ENDIF
1113C-------------initialization of Fext---for Riks-->approximation for follower load
1114C IF (NCYCLE==1.AND.IDTC==3.AND.IMCONV==1.AND.
1115 IF (idtc==3.AND.imconv==1.AND.
1116 . i_imp(5)==0) THEN
1117 CALL get_fext(nddl0 ,nddl ,iddl ,ndof ,ikc ,
1118 1 inloc ,lb ,fext ,ac ,acr )
1119 r_imp(13) = tstop-tt+dt2
1120C R_IMP(13) = SQRT(R2)
1121 END IF
1122 IF (idyna>0.AND.idy_damp>0) THEN
1123 CALL imp_dykv(nodft ,nodlt ,iddl ,ndof ,ikc ,
1124 . diag_k ,iadk ,jdik ,lt_k ,weight ,
1125 1 rby ,x ,skews%SKEW ,lpby ,npby ,
1126 2 nrbyac ,irbyac ,nint2 ,iint2 ,ipari ,
1127 3 intbuf_tab ,irbe3 ,lrbe3 ,frbe3 ,
1128 4 irbe2 ,lrbe2 ,v ,vr ,nddl0 ,
1129 5 fr_elem,iad_elem,ms ,in )
1130 END IF
1131C-------------LB,A,AR devient Fext-Fint---------------------
1132
1133 CALL upd_rhs(icodt ,icodr ,iskew ,ibfv ,xframe ,
1134 1 rby ,x ,skews%SKEW ,lpby ,npby ,
1135 2 nrbyac,irbyac,nint2 ,iint2 ,ipari ,
1136 3 intbuf_tab ,ndof ,iddl ,ikc ,
1137 4 nddl0 ,lb ,isetk ,inloc ,dirul ,
1138 5 a ,ar ,ac ,acr ,nt_rw ,
1139 6 irflag,w_ddl ,nddl ,r_imp(1),idyna ,
1140 7 v ,vr ,ms ,in ,irbe3 ,
1141 8 lrbe3 ,frbe3 ,weight ,irbe2 ,lrbe2 )
1142C
1143 IF (nspmd>1) THEN
1144 iconta = nddli + nsrem
1145 CALL spmd_max_i(iconta)
1146 IF (nbintc>0.) THEN
1147 CALL spmd_min_s(gap)
1148 IF (iconta> 0.AND.gap>zero) THEN
1149C
1150 CALL spmd_max_i(ifdis)
1151 IF (ilintf>0) THEN
1152 CALL imp_intfr(
1153 1 num_imp ,ns_imp ,ne_imp ,ipari ,intbuf_tab,
1154 2 npby ,lpby ,itab ,nrbyac ,
1155 3 irbyac ,nint2 ,iint2 ,iddl ,ikc ,
1156 4 ndof ,inloc ,nsrem ,nsl ,nbintc ,
1157 5 intlist ,xi_c ,ibfv ,dirul ,skews%SKEW ,
1158 6 xframe ,iskew ,icodt ,r_imp(16) ,d_imp ,
1159 7 lb ,ifdis ,nddl ,dr_imp ,iddli ,
1160 8 irbe3 ,lrbe3 ,frbe3 ,irbe2 ,lrbe2 ,
1161 9 dd ,ddr ,a ,ar ,ac ,
1162 a acr ,ms ,v ,nddl0 ,r_imp(1) ,
1163 b rby ,icodr ,nt_rw ,w_ddl ,weight ,
1164 c irflag )
1165 ELSEIF (ismdisp>0.AND.iline==0) THEN
1166 CALL imp_intfr(
1167 1 num_imp ,ns_imp ,ne_imp ,ipari ,intbuf_tab,
1168 2 npby ,lpby ,itab ,nrbyac ,
1169 3 irbyac ,nint2 ,iint2 ,iddl ,ikc ,
1170 4 ndof ,inloc ,nsrem ,nsl ,nbintc ,
1171 5 intlist ,x_a ,ibfv ,dirul ,skews%SKEW ,
1172 6 xframe ,iskew ,icodt ,r_imp(16) ,d_imp ,
1173 7 lb ,ifdis ,nddl ,dr_imp ,iddli ,
1174 8 irbe3 ,lrbe3 ,frbe3 ,irbe2 ,lrbe2 ,
1175 9 dd ,ddr ,a ,ar ,ac ,
1176 a acr ,ms ,v ,nddl0 ,r_imp(1) ,
1177 b rby ,icodr ,nt_rw ,w_ddl ,weight ,
1178 c irflag )
1179 ELSE
1180 CALL imp_intfr(
1181 1 num_imp ,ns_imp ,ne_imp ,ipari ,intbuf_tab,
1182 2 npby ,lpby ,itab ,nrbyac ,
1183 3 irbyac ,nint2 ,iint2 ,iddl ,ikc ,
1184 4 ndof ,inloc ,nsrem ,nsl ,nbintc ,
1185 5 intlist ,x ,ibfv ,dirul ,skews%SKEW,
1186 6 xframe ,iskew ,icodt ,r_imp(16) ,d_imp ,
1187 7 lb ,ifdis ,nddl ,dr_imp ,iddli ,
1188 8 irbe3 ,lrbe3 ,frbe3 ,irbe2 ,lrbe2 ,
1189 9 dd ,ddr ,a ,ar ,ac ,
1190 a acr ,ms ,v ,nddl0 ,r_imp(1) ,
1191 b rby ,icodr ,nt_rw ,w_ddl ,weight ,
1192 c irflag )
1193 END IF !(ILINTF>0) THEN
1194C
1195 CALL getnddli_g(
1196 1 npby ,lpby ,itab ,nrbyac ,irbyac ,
1197 2 nint2 ,iint2 ,ipari ,intbuf_tab,ndofi ,
1198 3 ndof ,ikc ,iddl ,fr_elem ,iad_elem ,
1199 4 nddli ,nsl ,nddli_g ,irbe3 ,lrbe3 ,
1200 5 irbe2 ,lrbe2 )
1201C Store the size of the contact stifness matrix for nonlinear solver outputs
1202 IF (ispmd==0.AND.imconv>=0) i_imp(13) = nddli_g
1203 IF (ispmd==0.AND.imconv>=0.AND.
1204 . (lprint/=0.OR.nprint/=0)) THEN
1205 WRITE(iout,1006)
1206 WRITE(istdo,1006)
1207 WRITE(iout,1011)nddli_g
1208 WRITE(istdo,1011)nddli_g
1209 WRITE(iout,*)
1210 WRITE(istdo,*)
1211 ENDIF
1212 ENDIF
1213 ENDIF
1214 ENDIF
1215C
1216 IF (intp_c<0) THEN
1217 CALL kin_knl(
1218 1 ipari ,intbuf_tab,num_imp ,ns_imp ,ne_imp ,
1219 2 npby ,lpby ,itab ,nrbyac ,irbyac ,
1220 3 nint2 ,iint2 ,ibfv ,dirul ,iskew ,
1221 6 icodt ,ndofi ,iddl ,ikc ,ndof ,
1222 5 inloc ,irbe3 ,lrbe3 ,frbe3 ,x ,
1223 6 skews%SKEW,irbe2 ,lrbe2)
1224 ENDIF
1225C
1226 IF (nmonv>0.AND.isetk==1) CALL monv_imp(
1227 . monvol ,volmon ,x ,igrsurf ,
1228 1 nmonv ,imonv ,ipari ,intbuf_tab ,
1229 2 a ,ar ,ndof ,iddl ,ikc ,
1230 3 inloc ,iline ,ibfv ,skews%SKEW,xframe ,
1231 4 dirul ,iskew ,icodt ,irbe3 ,lrbe3 ,
1232 5 frbe3 ,irbe2 ,lrbe2 ,nsurf)
1233C
1234 IF (gap<zero) THEN
1235 imconv = -2
1236 IF (ispmd==0) THEN
1237 WRITE(iout,1009)int(-gap)
1238 WRITE(istdo,1009)int(-gap)
1239 ENDIF
1240 ENDIF
1241C------------
1242 IF (isprb==1.AND.imconv==1) THEN
1243 DO i=1,nddl
1244 lb0(i) = lb(i)
1245 ENDDO
1246 ENDIF
1247C
1248 IF (isigini==1.AND.ncycle==1.AND.imconv==1) THEN
1249 CALL condens_b(nddl0 ,ikc ,lb0 )
1250 ENDIF
1251C---------for mono
1252 nddli_g=max(nddli_g,nddli)
1253 iconta = max(iconta,nddli_g)
1254 IF (iconta>0) THEN
1255 IF (isolv<5) idsc = 1
1256 ENDIF
1257C
1258 IF (ilintf>2.AND.ncycle<ilintf) THEN
1259 nsrem = 0
1260 nsl = 0
1261 ENDIF
1262C
1263 IF (ilintf>0.AND.nddli==0) THEN
1264 IF (nddlif>0) THEN
1265 nddli = nddlif
1266 IF (ALLOCATED(iadi)) DEALLOCATE(iadi)
1267 ALLOCATE(iadi(nddli+1))
1268 nnzi = iadif(nddli+1)-iadif(1)
1269 IF (ALLOCATED(jdii)) DEALLOCATE(jdii)
1270 ALLOCATE(jdii(nnzi))
1271 IF (ALLOCATED(itok)) DEALLOCATE(itok)
1272 ALLOCATE(itok(nddli))
1273 CALL cp_int_hp(nddli,iftok,itok)
1274 CALL cp_int_hp(nddli+1,iadif,iadi)
1275 CALL cp_int_hp(nnzi,jdiif,jdii)
1276 IF (ALLOCATED(diag_i)) DEALLOCATE(diag_i)
1277 ALLOCATE(diag_i(nddli))
1278 IF (ALLOCATED(lt_i)) DEALLOCATE(lt_i)
1279 ALLOCATE(lt_i(nnzi))
1280 CALL cp_real_hp(nddli,diag_if,diag_i)
1281 CALL cp_real_hp(nnzi,lt_if,lt_i)
1282 ENDIF
1283 ENDIF
1284C
1285 r_imp(18)=gap
1286C
1287 IF (iqstat>0.AND.ilintf>0.AND.ilintf==ncycle)
1288 . CALL imp_qifam(nodft ,nodlt ,iddl ,ndof ,inloc ,
1289 . ikc ,diag_k ,ms ,in ,weight)
1290C
1291C WRITE(6,*) IMUMPSV,IDSC,IMCONV
1292#if defined(MUMPS5)
1293 IF (imumpsv >0 .AND.idsc==1.AND.imconv>=0)
1294 . CALL imp_mumps1(nddl0, nnzk0, nddl, nnzk, nnmax,
1295 . nodglob, iddl, ndof, inloc, ikc,
1296 . iadk, jdik, diag_k, lt_k, iad_elem,
1297 . fr_elem, mumps_par, cddlp, iadi, jdii,
1298 . itok, diag_i, lt_i, nddli, nnzi ,
1299 . iprint0, it )
1300#else
1301 WRITE(6,*) "Fatal error: MUMPS is required"
1302 CALL flush(6)
1303 CALL arret(5)
1304#endif
1305 CALL cp_real_hp(nddl,lb,lbb)
1306C--------PCG w/ Projection----
1307 IF(ncycle==1.AND.imconv==1.AND.i_imp(5)==0) THEN
1308 IF (m_vs> 0) THEN
1309C-------------Case smll model---
1310 npcgpv=nddl
1311 IF (nspmd>1)CALL spmd_min_i(npcgpv)
1312 m_vs=min(m_vs,npcgpv)
1313 IF (m_vs> 0) npcgpv=-1
1314 END IF
1315C---------for free rigi motion for springback(generalization later)
1316 IF(irig_m>0) THEN
1317 CALL spbrm_pre(itab ,
1318 1 x ,iparg ,ixc ,ixtg ,partsav ,
1319 2 elbuf_tab ,pm ,ndof ,iddl ,ikc )
1320 END IF
1321 END IF
1322C-----------------------------
1323 IF (iconta>0) isetp = 1
1324C----------------------------------
1325C IMPLICIT RESOLVE
1326C----------------------------------
1327 100 CONTINUE
1328C
1329 IF (iline==1) THEN
1330 IF (ncycle==1.AND.ispmd==0.AND.itask==0) THEN
1331 IF (iqstat>0) THEN
1332 WRITE(iout,*)
1333 WRITE(iout,*)' ** BEGIN LINEAR QUASI-STATIC IMPLICIT COMPUTATION **'
1334 WRITE(istdo,*)
1335 WRITE(istdo,*)' ** BEGIN LINEAR QUASI-STATIC IMPLICIT COMPUTATION **'
1336 WRITE(iout,*)
1337 WRITE(istdo,*)
1338 ELSE
1339 WRITE(iout,*)
1340 WRITE(iout,*)' ** BEGIN LINEAR STATIC IMPLICIT COMPUTATION **'
1341 WRITE(istdo,*)
1342 WRITE(istdo,*)' ** BEGIN LINEAR STATIC IMPLICIT COMPUTATION **'
1343 WRITE(iout,*)
1344 WRITE(istdo,*)
1345 END IF !(IQSTAT>0) THEN
1346 ENDIF
1347C
1348 ntmp=0
1349C
1350c R2=ZERO
1351 CALL produt_hp(nddl,lb,lb,w_ddl,r2)
1352C
1353 IF (r2>zero.AND.r2<ep30) THEN
1354 ELSEIF(iqstat==0.AND.itask==0.AND.nddl>0) THEN
1355 CALL imp_stop(0)
1356 ENDIF
1357C
1358 CALL lin_solv(nddl ,iddl ,ndof ,ikc ,d_imp ,
1359 1 dr_imp,l_tol ,nnzk ,iadk ,jdik ,
1360 2 diag_k,lt_k ,nddli ,iadi ,jdii ,
1361 3 diag_i,lt_i ,itok ,iadm ,jdim ,
1362 4 diag_m,lt_m ,lb ,r_imp(6),inloc ,
1363 5 fr_elem,iad_elem,w_ddl,itask ,isetp ,
1364 6 istop ,a ,ar ,v ,
1365 7 ms ,x ,ipari ,intbuf_tab ,
1366 8 num_imp,ns_imp,ne_imp,nsrem ,nsl ,
1367 9 ntmp ,graphe, itab ,rbid ,ibid ,
1368 a ibid ,nmonv ,imonv ,monvol,igrsurf,
1369 b fr_mv ,volmon,ibfv ,skews%SKEW ,
1370 c xframe,mumps_par,cddlp,ind_imp,xi_c,
1371 d irbe3 ,lrbe3 ,irbe2 ,lrbe2 )
1372
1373C-----------------------------
1374citask0 IF (ITASK == 0) THEN
1375C-----------------------------
1376 IF (inega>0) THEN
1377 CALL iddl2nod(nddl ,iddl ,ndof ,ikc ,inloc ,
1378 . inega ,nnod )
1379 IF (nnod>0) THEN
1380 WRITE(iout,1008)itab(nnod)
1381 WRITE(istdo,1008)itab(nnod)
1382 ENDIF
1383C
1384 ELSEIF(iprec>1.AND.isolv<=2) THEN
1385 CALL imp_checm(itab ,nddl ,iddl ,diag_m ,ndof ,
1386 . ikc ,inloc ,nddl0 )
1387C
1388 ENDIF
1389 IF(nfxv_g/=0.AND.(nsrem+nsl-intp_c)>0) THEN
1390 CALL fv_imp(ibfv ,npc ,tf ,vel ,sensor_tab,
1391 1 d_imp ,dr_imp ,ikc ,iddl ,nsensor ,
1392 2 skews%SKEW ,iframe ,xframe ,v ,vr ,
1393 3 x ,dirul ,ndof ,a ,ar )
1394 ENDIF
1395 CALL recukin(rby ,lpby ,npby ,skews%SKEW ,iskew ,
1396 1 itab ,weight,ms ,in ,
1397 2 ibfv ,vel ,icodt,icodr ,
1398 3 nrbyac,irbyac,nint2 ,iint2 ,ipari ,
1399 4 intbuf_tab ,ndof ,d_imp ,dr_imp,
1400 5 x ,xframe,dirul ,ixr ,ixc ,
1401 6 ixtg ,sh4tree,sh3tree,irbe3 ,lrbe3,
1402 7 frbe3 ,irbe2 ,lrbe2 )
1403 IF (istop>0) CALL imp_stop(-1)
1404 CALL integratorl_hp(d_imp ,dr_imp,
1405 1 x ,v ,vr ,a ,ar )
1406C
1407c IF (IMPDEB>0) THEN
1408c CALL PR_DEB(NDDL ,IDDL ,NDOF ,IKC ,ITAB ,
1409c 1 DIAG_K,DIAG_M,INLOC ,FR_ELEM,IAD_ELEM,
1410c 2 IADK ,JDIK ,LT_K ,LT_M ,NDDLI ,
1411c 3 IADI ,JDII ,ITOK ,DIAG_I ,LT_I ,
1412c 4 LBB ,LBB ,0 ,NSREM ,NSL ,
1413c 5 D_IMP ,DR_IMP,1 ,W_DDL ,AC ,
1414c 6 ACR ,A ,AR ,R2 ,0 ,NODGLOB)
1415c END IF
1416 IF (ilintf>0.AND.ncycle<ilintf) THEN
1417 CALL imp_inttd0(timers,
1418 1 ipari ,intbuf_tab ,x_a ,d ,
1419 2 ms ,itab ,in ,d_imp ,dr_imp ,
1420 3 imsch ,i2msch ,isizxv,ilenxv ,igrbric ,
1421 4 islen7,irlen7 ,islen11,irlen11,islen17 ,
1422 5 irlen17,irlen7t,islen7t,iad_elem,fr_elem ,
1423 6 nbintc,intlist,itask ,kinet ,newfront,
1424 7 num_imp,ns_imp,ne_imp,ind_imp ,isendto ,
1425 8 irecvfrom,weight ,ixs ,temp ,
1426 9 dt2prev,waint ,num_imp1,irlen20,islen20,
1427 a irlen20t,islen20t,irlen20e,islen20e,
1428 b ikine,diag_sms,count_remslv,count_remslve,
1429 c nsensor,sensor_tab,xdp,h3d_data,multi_fvm,
1430 d forneqs,maxdgap,interfaces,glob_therm)
1431
1432 tt=max(zero,tt-dt2)
1433 isetk =0
1434C-------save Fint par AC,ACR---------
1435 ELSE
1436 IF (ilintf>0) THEN
1437 nt_imp1 = 0
1438 DO i = 1,ninter
1439 num_imp1(i) = 0
1440 END DO
1441 ENDIF
1442C
1443 CALL integrator1_hp(d_imp ,d )
1444 IF ((isecut>0 .OR. iisrot>0 .OR. impose_dr/=0 .OR. idrot==1) .AND. iroddl/=0) THEN
1445 CALL integrator1_hp(dr_imp,dr)
1446 ENDIF
1447C
1448 IF (iscau>0)CALL integrator1_hp(d_imp ,x )
1449 ENDIF
1450 CALL integrator1_hp(d_imp ,x_a )
1451C-----------------------------
1452citask0 END IF !(ITASK == 0) THEN
1453C-----------------------------
1454 ELSE ! nonlinear
1455C-------------------------
1456C IF (GAP<ZERO) GOTO 300
1457 IF (r_imp(18)<zero.OR.imconv==-2) GOTO 300
1458 IF (imconv==1) THEN
1459C--------valeur au debut d'increament--sauf diverge----
1460citask0 IF (ITASK == 0) THEN
1461 IF(ncy_max>0.AND.ncycle>ncy_max) CALL imp_stop(-3)
1462 IF (inconv==1) THEN
1463 CALL cp_impbuf(1 ,elbuf ,elbuf_c ,bufmat ,bufmat_c ,
1464 . fsav ,volmon ,partsav ,intbuf_tab ,
1465 . intbuf_tab_c,ipari ,islen7 ,irlen7 ,
1466 . islen11,irlen11,islen17 ,irlen17,irlen7t ,
1467 . islen7t,irlen20,islen20 ,irlen20t,islen20t,
1468 . irlen20e,islen20e,newfront,elbuf_tab,elbuf_imp,
1469 . iparg )
1470 END IF
1471 IF (ncycle==1) THEN
1472 IF (isprb==1.AND.i_imp(5)==0) r_imp(1) = zero
1473 r_imp(1) = max(r_imp(1),rf_min*rf_min)
1474 r_imp(1) = min(r_imp(1),rf_max*rf_max)
1475 IF (inconv==1) i_imp(12)=1
1476 END IF
1477C--------case of converge with 0 iteration-------
1478 IF (ismdisp>0) THEN
1479 CALL cp_real_hp(nndl,x_a,x_c)
1480 ELSE
1481 CALL cp_real_hp(nndl,x,x_c)
1482 END IF
1483 i_imp(2)=0
1484 i_imp(6)=iconta
1485 it=0
1486citask0 END IF !(ITASK == 0) THEN
1487C
1488 IF (isigini==1) THEN
1489C TMP1 = DT2*NCYCLE
1490C TMP2 = TSTOP-TT+TMP1-DT2
1491C BFAC =TMP1/MAX(DT2,TMP2)
1492C------strickly proportional
1493 bfac= (tt-r_imp(19))/(tstop-r_imp(19))
1494 r_imp(10)=bfac-one
1495 IF (r_imp(10)<zero)CALL vaxpy_hp(nddl ,lb ,lb0 ,r_imp(10))
1496 ENDIF
1497C
1498C----------------------
1499c CALL MY_BARRIER
1500C---------------------
1501c R2=ZERO
1502 CALL produt_hp(nddl,lb,lb,w_ddl,r2)
1503C----------------------
1504c CALL MY_BARRIER
1505C---------------------
1506 IF (r2>=zero.AND.r2<ep30) THEN
1507 ELSEIF(idyna==0.AND.iqstat==0) THEN
1508 CALL imp_stop(0)
1509 ENDIF
1510C
1511 IF (inconv == 1) r_imp(1)=max(r_imp(1),r2)
1512!sb
1513 IF(n_lim == 1 .AND. isprb == 0) r_imp(1)=r2
1514!fin sb
1515 IF (isprb==1) THEN
1516 IF (sqrt(r2/r_imp(1))<=n_tol) THEN
1517c IF (ITASK == 0) THEN
1518 dt_imp=tstop-tt+dt2
1519 CALL zeror_hp(d_imp,numnod)
1520 IF (iroddl/=0) CALL zeror_hp(dr_imp,numnod)
1521c END IF !(ITASK == 0) THEN
1522 GOTO 200
1523 ENDIF
1524 END IF !(ISPRB==1) THEN
1525C
1526citask0 IF (ITASK == 0) THEN
1527C
1528 IF (isprb==1) THEN
1529 tmp1 = dt2*ncycle
1530 tmp2 = tstop-tt+tmp1-dt2
1531 bfac =tmp1/max(dt2,tmp2)
1532 r_imp(10)=bfac-one
1533 r_imp(2)=r2*bfac*bfac
1534 IF (ncycle==1) THEN
1535 r_imp(12)=em01
1536C
1537 IF (iconta>0) r_imp(12)=zep9
1538 ELSE
1539 tmp = dt12/max(dt12,tstop-tt)+n_tol/sqrt(r2/r_imp(1))
1540 tmp = min(half*tmp,one)
1541 r_imp(12)=r_imp(12)*(one-tmp)+tmp
1542 ENDIF
1543 ELSE
1544 r_imp(2)=r2
1545 ENDIF
1546 r_imp(3)=one
1547 r_imp(4)=r_imp(6)
1548C
1549citask0 END IF !(ITASK == 0) THEN
1550C----------------------
1551c CALL MY_BARRIER
1552C---------------------
1553 IF (isprb==1) THEN
1554 tmp = r_imp(10)+one
1555 CALL vscaly_hp(nddl ,lb ,lb0 ,tmp )
1556 END IF
1557 ELSEIF (imconv==-1) THEN
1558C--------line-search------
1559 IF (isprb==1.OR.isigini==1) THEN
1560 IF (r_imp(10)<zero) THEN
1561 CALL vaxpy_hp(nddl ,lb ,lb0 ,r_imp(10))
1562 ENDIF
1563 ENDIF
1564 ELSE
1565citask0 IF (ITASK == 0) THEN
1566 it=it+1
1567 i_imp(2)=i_imp(2)+1
1568citask0 END IF !(ITASK == 0) THEN
1569 IF (isprb==1.OR.isigini==1) THEN
1570 IF (r_imp(10)<zero) THEN
1571 CALL vaxpy_hp(nddl ,lb ,lb0 ,r_imp(10))
1572 ENDIF
1573 ENDIF
1574 ENDIF ! IF (IMCONV==1) THEN
1575C----------------------
1576c CALL MY_BARRIER
1577C---------------------
1578citask0 IF (ITASK == 0) THEN
1579C-----------------------------
1580 IF (isprb==1) THEN
1581 faci=min(one,r_imp(12))
1582 r02=faci*faci*r_imp(1)
1583 ELSE
1584 r02=r_imp(1)
1585 ENDIF
1586 IF (it==1.AND.irefi==5) THEN
1587 r02 = max(r02,em20)
1588 r_imp(6) = max(em20,r_imp(6))
1589 ENDIF
1590 IF (it==1.AND.iconta>i_imp(6)) THEN
1591C re-evoluer Rref-------
1592 IF (irefi==5.AND.nfxv_g>0.AND.imconv>=0) THEN
1593 CALL rer02(rby ,lpby ,npby ,skews%SKEW ,iskew ,
1594 1 itab ,weight,ms ,in ,
1595 2 ibfv ,vel ,icodt,icodr ,
1596 3 nrbyac,irbyac,nint2 ,iint2 ,ipari ,
1597 4 intbuf_tab ,ndof ,d_imp ,dr_imp,
1598 5 x ,xframe,dirul ,ixr ,ixc ,
1599 6 ixtg ,sh4tree,sh3tree,irbe3 ,lrbe3,
1600 7 frbe3 ,iadk ,jdik ,diag_k,lt_k ,
1601 8 iddl ,ikc ,inloc ,num_imp,ns_imp,
1602 9 ne_imp,ind_imp,nddl ,w_ddl ,a ,
1603 a ar ,r02 ,irbe2 ,lrbe2 ,x_c )
1604 r_imp(1) = max(r02,r_imp(1))
1605 ENDIF
1606 IF (i_imp(7)==0.AND.irefi==4) irefi= -4
1607 ENDIF
1608 IF (imconv>0.AND.isprb/=1) THEN
1609 r02 = max(r02,rf_min*rf_min)
1610 r02 = min(r02,rf_max*rf_max)
1611 END IF
1612C
1613 IF (ncycle==1.AND.insolv>=2.AND.it==0.AND.imconv>=0)
1614 . CALL bfgs_ini(nddl,n_lim)
1615 r_imp(17) = r02
1616C-----------------------------
1617citask0 END IF !(ITASK == 0) THEN
1618C-----------------------------
1619C----------------------
1620c CALL MY_BARRIER
1621C---------------------
1622c-------particular case .AND.NFXVEL==0
1623 IF (nddl_g==0.AND.nfxvel > 0) THEN
1624 IF (it==0) THEN
1625C----add 3 to enforce at least one iteration in case of IMPDISP dependent (moving skew or frame)
1626 imconv=3
1627 isetk=0
1628 ELSE
1629 imconv=1
1630 END IF
1631C----------------------
1632c CALL MY_BARRIER
1633C---------------------
1634 ELSE
1635 CALL nl_solv(nddl ,iddl ,ndof ,ikc ,d_imp ,
1636 1 dr_imp,nnzk ,iadk ,jdik ,diag_k,
1637 2 lt_k ,lb ,nddli ,iadi ,jdii ,
1638 3 diag_i,lt_i ,itok ,iadm ,jdim ,
1639 4 diag_m,lt_m ,r_imp(17),dd ,ddr ,
1640 5 itask ,it ,i_imp(2),r_imp(3),r_imp(2),
1641 6 i_imp(5) ,inprint,isetp ,istop ,r_imp(4),
1642 7 r_imp(5),r_imp(6),inloc ,nddl0 ,r_imp(7),
1643 8 r_imp(11),r_imp(18),itab ,fr_elem,iad_elem,
1644 9 w_ddl ,a ,ar ,v ,ms ,
1645 a x ,ipari ,intbuf_tab ,num_imp,
1646 b ns_imp ,ne_imp,nsrem ,nsl ,iconta ,
1647 c graphe ,fac_k ,ipiv_k, nkcond,nmonv ,
1648 d imonv ,monvol ,igrsurf,fr_mv ,
1649 e volmon,ibfv ,skews%SKEW ,xframe,mumps_par,
1650 f cddlp ,ind_imp,nbintc,intlist,newfront,
1651 g isendto,irecvfrom,irbe3,lrbe3,i_imp(8),
1652 h i_imp(9),i_imp(10),fext ,dg ,dgr ,
1653 i dg0 ,dgr0 ,r_imp(13),r_imp(14),
1654 j nodftsk,nodltsk,irbe2,lrbe2,i_imp(12),
1655 k r_imp(20),anew_stif)
1656 END IF !(NDDL==0.AND.NFXVEL > 0) THEN
1657
1658C---------------------------------
1659citask0 IF (ITASK == 0) THEN
1660C---------------------------------
1661 IF(nfxvel/=0) THEN
1662C-----for FV_local
1663 ntmp=0
1664 DO i=1,nfxvel
1665 ntmp=ntmp+iabs(dirul(i))
1666 END DO
1667 IF (ntmp>0)
1668 . CALL fv_imp(ibfv ,npc ,tf ,vel ,sensor_tab,
1669 1 d_imp ,dr_imp ,ikc ,iddl ,nsensor ,
1670 2 skews%SKEW ,iframe ,xframe ,v ,vr ,
1671 3 x ,dirul ,ndof ,a ,ar )
1672 END IF
1673C--------Rigid motions elimination----
1674 IF(irig_m>0.AND.imconv==1) THEN
1675 CALL spb_rm_rig(
1676 1 x ,ixc ,ixtg ,ndof ,iddl ,
1677 2 ikc ,d_imp ,dr_imp ,icodt ,icodr ,
1678 3 skews%SKEW,iskew ,itab )
1679 END IF
1680 IF(imp_lr > 0)THEN
1681 CALL recukin(rby ,lpby ,npby ,skews%SKEW ,iskew ,
1682 1 itab ,weight,ms ,in ,
1683 2 ibfv ,vel ,icodt,icodr ,
1684 3 nrbyac,irbyac,nint2 ,iint2 ,ipari ,
1685 4 intbuf_tab,ndof ,d_imp ,dr_imp,
1686 5 x_c ,xframe,dirul ,ixr ,ixc ,
1687 6 ixtg ,sh4tree,sh3tree,irbe3 ,lrbe3,
1688 7 frbe3 ,irbe2 ,lrbe2 )
1689 ELSE
1690 CALL recukin(rby ,lpby ,npby ,skews%SKEW ,iskew ,
1691 1 itab ,weight,ms ,in ,
1692 2 ibfv ,vel ,icodt,icodr ,
1693 3 nrbyac,irbyac,nint2 ,iint2 ,ipari ,
1694 4 intbuf_tab ,ndof ,d_imp ,dr_imp,
1695 5 x ,xframe,dirul ,ixr ,ixc ,
1696 6 ixtg ,sh4tree,sh3tree,irbe3 ,lrbe3,
1697 7 frbe3 ,irbe2 ,lrbe2 )
1698 END IF
1699c Print information of non-linear solver
1700 IF (solvnfo > zero) THEN
1701 IF (imconv /= -1) THEN
1702 CALL pr_solnfo(nddl ,iddl ,ndof ,ikc ,itab ,
1703 1 diag_k,diag_m,inloc ,fr_elem,iad_elem,
1704 2 iadk ,jdik ,lt_k ,lt_m ,nddli ,
1705 3 iadi ,jdii ,itok ,diag_i ,lt_i ,
1706 4 lbb ,lbb ,it ,nsrem ,nsl ,
1707 5 d_imp ,dr_imp,1 ,w_ddl ,ac ,
1708 6 acr ,a ,ar ,r2 ,ndeb0 ,
1709 7 r_imp ,i_imp ,dd ,ddr)
1710 ENDIF
1711 ENDIF
1712c
1713c IF (IMPDEB>0) THEN
1714c IF (NCYCLE>=NDEB0.AND.NCYCLE<=NDEB1) THEN
1715c CALL PRODUT_HP(NDDL,LB,LB,W_DDL,R2)
1716c CALL PR_DEB(NDDL ,IDDL ,NDOF ,IKC ,ITAB ,
1717c 1 DIAG_K,DIAG_M,INLOC ,FR_ELEM,IAD_ELEM,
1718c 2 IADK ,JDIK ,LT_K ,LT_M ,NDDLI ,
1719c 3 IADI ,JDII ,ITOK ,DIAG_I ,LT_I ,
1720c 4 LBB ,LBB ,IT ,NSREM ,NSL ,
1721c 5 D_IMP ,DR_IMP,1 ,W_DDL ,AC ,
1722c 6 ACR ,A ,AR ,R2 ,NDEB0 )
1723c END IF
1724c END IF
1725c
1726 IF (nbintc>0) THEN
1727 IF (ismdisp>0) THEN
1728 CALL imp_dtkin(
1729 1 ipari ,intbuf_tab ,x_a ,v ,
1730 2 vr ,itab ,d_imp ,dr_imp ,nbintc ,
1731 3 intlist,itask ,newfront,isendto ,irecvfrom,
1732 4 iddl ,ndof ,ikc ,tmp ,ms ,
1733 5 nsensor,sensor_tab,maxdgap)
1734 ELSE
1735 CALL imp_dtkin(
1736 1 ipari ,intbuf_tab ,x ,v ,
1737 2 vr ,itab ,d_imp ,dr_imp ,nbintc ,
1738 3 intlist,itask ,newfront,isendto ,irecvfrom,
1739 4 iddl ,ndof ,ikc ,tmp ,ms ,
1740 5 nsensor,sensor_tab,maxdgap)
1741 IF(nfxv_g/=0.AND.tmp<one)
1742 . CALL fv_imp(ibfv ,npc ,tf ,vel ,sensor_tab,
1743 1 d_imp ,dr_imp ,ikc ,iddl ,nsensor ,
1744 2 skews%SKEW ,iframe ,xframe ,v ,vr ,
1745 3 x ,dirul ,ndof ,a ,ar )
1746 END IF !(ISMDISP>0) THEN
1747 END IF
1748C
1749C---------------------------------
1750citask0 END IF !(ITASK == 0) THEN
1751C---------------------------------
1752 300 CONTINUE
1753C---------------------------------
1754citask0 IF (ITASK == 0) THEN
1755C---------------------------------
1756 IF (ismdisp>0) THEN
1757 CALL cp_real_hp(nndl,x_c,x_a)
1758 ELSE
1759 CALL cp_real_hp(nndl,x_c,x)
1760 END IF
1761 CALL cp_impbuf(2 ,elbuf ,elbuf_c ,bufmat ,bufmat_c ,
1762 . fsav ,volmon ,partsav ,intbuf_tab ,
1763 . intbuf_tab_c ,ipari ,islen7 ,irlen7 ,
1764 . islen11,irlen11,islen17 ,irlen17,irlen7t ,
1765 . islen7t,irlen20,islen20 ,irlen20t,islen20t,
1766 . irlen20e,islen20e,newfront,elbuf_tab,elbuf_imp,
1767 . iparg )
1768
1769 IF (ncycle == 1 .AND. istop == 0 .AND.isolv == 7) THEN
1770 IF (it == 1 .AND. i_imp(5) == 0 ) THEN
1771 WRITE (iout, *)
1772 . " **PCG SOLVER HAS BEEN SELECTED FIRSTLY FOR THIS RUN**"
1773 WRITE (istdo, *)
1774 . " **PCG SOLVER HAS BEEN SELECTED FIRSTLY FOR THIS RUN**"
1775 END IF
1776 END IF
1777
1778 IF (istop>0) THEN
1779 IF (istop == 3 .AND.isolv == 7) THEN
1780
1781 isolv = 3
1782 isetk = 1
1783 ikpat = 0
1784 i_imp(11)=1
1785 istop = 0
1786 iprec = 1
1787 IF (nspmd > 1 ) THEN
1788 IF (imumpsd == 0) imumpsd = 1
1789 IF (imumpsv == 0) imumpsv = 1
1790 END IF
1791 IF (ncycle == 1 ) THEN
1792 IF (ispmd == 0) THEN
1793 WRITE (iout, *)
1794 . " **DIRECT SOLVER HAS BEEN SELECTED FOR THIS RUN**"
1795 WRITE (istdo, *)
1796 . " **DIRECT SOLVER HAS BEEN SELECTED FOR THIS RUN**"
1797 END IF !(NSPMD == 0) THEN
1798 ELSE
1799 IF (ispmd == 0) THEN
1800 WRITE (iout, *)
1801 . " **PCG SOLVER HAS BEEN CHANGED TO DIRECT SOLVER **"
1802 WRITE (istdo, *)
1803 . " **PCG SOLVER HAS BEEN CHANGED TO DIRECT SOLVER **"
1804 END IF !(NSPMD == 0) THEN
1805 END IF
1806
1807 ENDIF
1808 imconv=-2
1809 CALL iddl2nod(nddl ,iddl ,ndof ,ikc ,inloc ,
1810 . istop ,nnod )
1811 IF (nnod>0) THEN
1812 WRITE(iout,1008)itab(nnod)
1813 WRITE(istdo,1008)itab(nnod)
1814 ENDIF
1815 ENDIF
1816 inconv = min(1,imconv)
1817 IF (imconv<=-2) THEN
1818 CALL zeror_hp(d_imp,numnod)
1819 IF (iroddl/=0) CALL zeror_hp(dr_imp,numnod)
1820 r_imp(6)=r_imp(4)
1821 i_imp(5)=-2
1822 IF (isprb==1.AND.imconv==-3.AND.iconta==0) THEN
1823 DO i=1,nddl
1824 lb(i) = lb0(i)
1825 ENDDO
1826 imconv=1
1827 GOTO 100
1828 ENDIF
1829 tt=max(zero,tt-dt2)
1830 ncycle=ncycle-1
1831 IF (ncycle==0) dt1=zero
1832 CALL int5_diverg(ipari )
1833 IF (imconv==-2.AND.i_imp(11)/=1) THEN
1834C-----------change dt------
1835 CALL imp_dtn(it,r_imp(11),r_imp(10),r_imp(24))
1836C CALL NUL_ETFAC_A
1837 CALL etfac_ini(iparg )
1838 IF (dt_imp==dt_min) THEN
1839 CALL imp_stop(imconv)
1840 ENDIF
1841 ENDIF
1842 ENDIF
1843C
1844 IF (imconv<=-2.OR.imconv==0) THEN
1845 IF (it==1.AND.iconta>i_imp(6)) THEN
1846 r02 =r_imp(17)
1847 IF (irefi==1) THEN
1848 r02 = min(r02,ten*r_imp(1))
1849 ELSEIF (irefi==2) THEN
1850 r02 = min(r02,onep2*r_imp(1))
1851 ELSEIF (irefi==3.OR.irefi==4.OR.irefi==5) THEN
1852 r02 = min(r02,r_imp(1))
1853 ELSEIF (irefi==-4) THEN
1854 i_imp(7) = 1
1855 irefi = 4
1856 END IF
1857C----Used for gravity case
1858 IF (ncycle > 1) i_imp(7) = 1
1859 r_imp(1)=max(r_imp(1),r02)
1860 ENDIF
1861 ENDIF !IF (IMCONV<=-2.OR.IMCONV==0)
1862C------------for restart---
1863 IF (imconv>0) THEN
1864 r_imp(1) = max(r_imp(1),rf_min*rf_min)
1865 r_imp(1) = min(r_imp(1),rf_max*rf_max)
1866 ENDIF
1867C
1868 IF (imconv==2) dt2=dt2/i_imp(2)
1869C---------------------------------
1870 200 CONTINUE
1871C /---------------/
1872c CALL MY_BARRIER
1873C /---------------/
1874C---------------------------------
1875citask0 IF (ITASK == 0) THEN
1876C---------------------------------
1877 IF (imconv==1.OR.imconv==2.OR.imconv==3) THEN
1878 IF(idyna>0.AND.nfxvel/=0) THEN
1879 CALL fv_fint0(ibfv ,npc ,tf ,vel ,sensor_tab,
1880 1 d_imp ,dr_imp,ikc ,iddl ,nsensor ,
1881 2 skews%SKEW ,iframe ,xframe,a ,ar ,
1882 3 x ,ndof ,ms ,in ,weight ,
1883 4 rby )
1884 END IF
1885 IF (imconv/=3) CALL integrator1_hp(d_imp ,d )
1886 IF (r_imp(11)<em10)
1887 . CALL produt_uhp0(d_imp ,dr_imp,r_imp(11),weight)
1888 CALL imp_dtn(it,r_imp(11),r_imp(10),r_imp(24))
1889 IF ( iqstat>0) CALL dis_cp(nndl,d_imp,dr_imp,0 )
1890 ENDIF
1891 IF (inconv==1 .AND. (isecut>0.OR.iisrot>0
1892 . .OR. impose_dr/=0 .OR. idrot==1)
1893 . .AND. iroddl/=0) THEN
1894 IF (imconv/=3) CALL integrator1_hp(dr_imp,dr)
1895 ENDIF
1896 IF (ismdisp>0) THEN
1897 CALL integrator_hp(ndt ,d_imp ,dr_imp,
1898 1 x_a ,v ,vr ,a ,ar )
1899 ELSE
1900C
1901 CALL integrator_hp(ndt ,d_imp ,dr_imp,
1902 1 x ,v ,vr ,a ,ar )
1903 ENDIF
1904C
1905 IF(idyna>0.AND.imconv==1) THEN
1906 CALL dyna_wex(ibcl ,forc ,snpc,npc ,tf ,ac ,
1907 2 v ,x ,skews ,acr ,vr ,
1908 3 sensor_tab,weight,wfext ,iads_f,
1909 4 fsky ,igrv ,agrv ,ms ,in ,
1910 5 lgrav ,itask ,nrbyac,irbyac ,
1911 6 npby ,rby ,ibfv ,vel ,d_imp ,
1912 7 dr_imp,ikc ,iddl ,iframe,xframe ,
1913 8 ndof ,h3d_data,cptreac,fthreac,nodreac,nsensor,
1914 9 th_surf ,dpl0cld,
1915 a vel0cld, numnod,nsurf,nfunct,nconld,
1916 b ngrav,nfxvel,stf,numskw,python)
1917 CALL dyna_cpr0(nddl0 )
1918 END IF
1919C----------D_imp taking D_n-1 :exception for case with Gravity-----
1920 IF (imconv<=-2 .AND.iqstat>0 .AND. i_imp(7) >0) THEN
1921 CALL dis_cp(nndl,d_imp,dr_imp,1 )
1922 END IF
1923C
1924 IF (imconv == 3 ) inconv = 0
1925 IF (imconv<=-2) imconv=1
1926 IF (imconv==1) i_imp(1)=i_imp(1)+it+1
1927 IF (imconv==1) i_imp(12)=inconv
1928 i_imp(4)=ndt-1
1929 it_t = i_imp(1)
1930C--------
1931citask0 END IF !(ITASK == 0) THEN
1932C
1933 ENDIF !IF (ILINE==1) THEN
1934C----------------------
1935 CALL my_barrier
1936C---------------------
1937citask0 IF (ITASK == 0) THEN
1938 IF (nint7>0) THEN
1939 DEALLOCATE(iadi)
1940 DEALLOCATE(itok)
1941 DEALLOCATE(jdii)
1942 DEALLOCATE(diag_i)
1943 DEALLOCATE(lt_i)
1944 ENDIF
1945C
1946 IF ((nsrem+nsl)>0) CALL ini_kic
1947 IF (ilintf>0) DEALLOCATE(xi_c)
1948 IF (intp_c<0) CALL deallocm
1949 IF (nint2>0) DEALLOCATE(iaint2)
1950
1951citask0 END IF !(ITASK == 0) THEN
1952c
1953 1001 FORMAT(' SYMBOLIC DIM : NDDL =',i8,1x,'NNZ =',i8,1x,'NB_MAX =',i8)
1954 1002 FORMAT(' FINAL DIM : NDDL =',i8,1x,'NNZ =',i8,1x,'NB_MAX =',i8)
1955 1003 FORMAT(/,5x,'--STIFFNESS MATRIX IS REFORMED --')
1956 1004 FORMAT(3x,'LINE. SOLVER : ISOLV =',i4,2x,'PREC. Meth. =',i4,2x,
1957 . 'TOL =',e11.4)
1958 1005 FORMAT(5x,'--STIFFNESS MATRIX WILL BE REFORMED AFTER EACH ',i4,
1959 . 2x,'ITERATIONS--')
1960 1006 FORMAT(5x,'--SUPPLEMENTARY CONTACT STIFFNESS MATRIX',
1961 . 1x, 'IS CREATED--')
1962 1007 FORMAT(5x,' WITH DIM. : ND =',i8,1x,'NZ =',i8) !,1X,'NB_MAX =',I8)
1963 1008 FORMAT(3x,'**WARNING: STIFFNESS MATRIX IS NOT DEFINITE**'/,
1964 . 3x,'**LOOK AT NODE: ',i8)
1965 1009 FORMAT(3x,'**TIMESTEP WILL BE REDUCED TO AVOID DE-ACTIVATION ',
1966 . 'IN INTERFACE:**',i8)
1967 1010 FORMAT(/,5x,'--STIFFNESS MATRIX IS REFORMED',1x,
1968 . 'DUE TO RIGID WALL IMPACT--'/,5x,'WITH IMPACT NUM. =',i8)
1969 1011 FORMAT(5x,' WITH DIM. : ND =',i8)
1970 1012 FORMAT(3x,'**TIMESTEP WILL BE REDUCED DUE TO ',
1971 . 'DIM.(ND) CHANGE W/AUTOSPC::**',2i8)
1972 RETURN
1973C endif MUMPS defined
1974#endif
1975 END
1976!||====================================================================
1977!|| imp_stop ../engine/source/implicit/imp_solv.F
1978!||--- called by ------------------------------------------------------
1979!|| imp_check ../engine/source/implicit/imp_solv.F
1980!|| imp_errmumps ../engine/source/implicit/imp_solv.F
1981!|| imp_solv ../engine/source/implicit/imp_solv.F
1982!|| m36iter_imp ../engine/source/materials/mat/mat036/m36iter_imp.F
1983!|| nl_solv ../engine/source/implicit/nl_solv.F
1984!||--- calls -----------------------------------------------------
1985!|| ancmsg ../engine/source/output/message/message.F
1986!|| arret ../engine/source/system/arret.F
1987!|| my_flush ../engine/source/system/machine.F
1988!||--- uses -----------------------------------------------------
1989!|| message_mod ../engine/share/message_module/message_mod.F
1990!||====================================================================
1991 SUBROUTINE imp_stop(ISTOP)
1992C-----------------------------------------------
1993C M o d u l e s
1994C-----------------------------------------------
1995 USE message_mod
1996C-----------------------------------------------
1997C I m p l i c i t T y p e s
1998C-----------------------------------------------
1999#include "implicit_f.inc"
2000#include "comlock.inc"
2001C-----------------------------------------------
2002C C o m m o n B l o c k s
2003C-----------------------------------------------
2004#include "units_c.inc"
2005#include "task_c.inc"
2006C-----------------------------------------------
2007C D u m m y A r g u m e n t s
2008C-----------------------------------------------
2009C REAL
2010 integer
2011 . istop,img
2012 CHARACTER*60 MSG(-4:2)
2013 DATA MSG
2014 . / 'STOPPED DUE TO SOLVER ERROR **',
2015 . 'STOPPED DUE TO NCYCLE LIMIT **',
2016 . 'STOPPED DUE TO TIMESTEP LIMIT **',
2017 . 'STOPPED DUE TO MODELLING DATA **',
2018 . 'STOPPED DUE TO LOADING DATA **' ,
2019 . 'STOPPED DUE TO DIVERGENCE **' ,
2020 . 'STOP WITH CHECKING **' /
2021C-----------------------------------------------
2022C L o c a l V a r i a b l e s
2023C-----------------------------------------------
2024 IF (ispmd==0) THEN
2025 img=istop
2026 IF (istop>2) img=1
2027 CALL ancmsg(msgid=79,anmode=aninfo,
2028 . c1=msg(img),i1=istop)
2029 CALL my_flush(iout)
2030 ENDIF
2031 CALL arret(2)
2032C------------------------------------------
2033 RETURN
2034 END
2035C------------------------------------------
2036!||====================================================================
2037!|| imp_check ../engine/source/implicit/imp_solv.F
2038!||--- called by ------------------------------------------------------
2039!|| imp_solv ../engine/source/implicit/imp_solv.F
2040!||--- calls -----------------------------------------------------
2041!|| imp_stop ../engine/source/implicit/imp_solv.F
2042!||====================================================================
2043 SUBROUTINE imp_check(ITAB ,NDDL ,IDDL ,DIAG_K ,NDOF ,
2044 . IKC ,INLOC ,NDDL0 )
2045C-----------------------------------------------
2046C I m p l i c i t T y p e s
2047C-----------------------------------------------
2048#include "implicit_f.inc"
2049C-----------------------------------------------
2050C C o m m o n B l o c k s
2051C-----------------------------------------------
2052#include "com04_c.inc"
2053#include "units_c.inc"
2054#include "impl1_c.inc"
2055C-----------------------------------------------
2056C D u m m y A r g u m e n t s
2057C-----------------------------------------------
2058C REAL
2059 INTEGER NDDL,NDDL0,NDOF(*),IDDL(*),IKC(*),INLOC(*),ITAB(*)
2060 my_real
2061 . diag_k(*)
2062C-----------------------------------------------
2063C L o c a l V a r i a b l e s
2064C-----------------------------------------------
2065 INTEGER NLIM,NID,NN,NKC,NFT,II,IDI,ND,ID,ISTOP
2066 PARAMETER (NLIM=6)
2067 integer i,j,k,n,inod(nlim),idl(6*nlim),nfix(nddl0)
2068C------------------------------------------
2069 nid=0
2070 DO i=1,nddl
2071 IF (diag_k(i)<em10) THEN
2072 nid=nid+1
2073 idl(nid)=i
2074 IF (nid==6*nlim) GOTO 100
2075 ENDIF
2076 ENDDO
2077 100 CONTINUE
2078 IF (nid>0) THEN
2079c write(*,*)'nid=',nid
2080 nkc=0
2081 DO n = 1,numnod
2082 i=inloc(n)
2083 DO j=1,ndof(i)
2084 nd = iddl(i)+j
2085 IF (ikc(nd)>0) nkc=nkc+1
2086 nfix(nd)=nkc
2087 ENDDO
2088 ENDDO
2089 nn=0
2090 nft=1
2091 DO 400 k = 1,nid
2092 DO n = nft,numnod
2093 i=inloc(n)
2094 idi=iddl(i)
2095 id=idi-nfix(idi)
2096C IF (ID>IDL(K)) GOTO 400
2097 DO j=1,ndof(i)
2098 nd = idi+j
2099 id = nd-nfix(nd)
2100 IF (idl(k)==id) THEN
2101 nn=nn+1
2102 inod(nn)=itab(i)
2103c write(*,*)'id,i,n,j=',id,i,n,j
2104 IF (nn==nlim) GOTO 200
2105 nft=n+1
2106 GOTO 400
2107 ENDIF
2108 ENDDO
2109 ENDDO
2110 400 CONTINUE
2111 200 CONTINUE
2112 IF (nn>0) THEN
2113 istop=1
2114 WRITE(iout,*)
2115 . ' **ERROR: STIFFNESS MATRIX IS NOT DEFINITE** '
2116 WRITE(iout,*)'--- LOOK AT NODES:---'
2117 WRITE(iout,*)(inod(i),i=1,nn)
2118 WRITE(istdo,*)
2119 . ' **ERROR: STIFFNESS MATRIX IS NOT DEFINITE** '
2120 WRITE(istdo,*)'--- LOOK AT NODES:---'
2121 WRITE(istdo,*)(inod(i),i=1,nn)
2122 IF (nrbe2>0.AND.iline==0) istop = 0
2123 IF (istop>0) CALL imp_stop(-1)
2124 ENDIF
2125 ENDIF
2126C
2127C------------------------------------------
2128 RETURN
2129 END
2130!||====================================================================
2131!|| pr_infok ../engine/source/implicit/imp_solv.F
2132!||--- called by ------------------------------------------------------
2133!|| imp_chkm ../engine/source/implicit/imp_solv.F
2134!|| imp_k_eig ../engine/stub/imp_k_eig.F
2135!|| imp_solv ../engine/source/implicit/imp_solv.F
2136!||--- calls -----------------------------------------------------
2137!|| spmd_inf_g ../engine/source/mpi/implicit/imp_spmd.F
2138!||====================================================================
2139 SUBROUTINE pr_infok(NDDL0,NNZK0,NDDL,NNZK,NNMAX)
2140C-----------------------------------------------
2141C I m p l i c i t T y p e s
2142C-----------------------------------------------
2143#include "implicit_f.inc"
2144C-----------------------------------------------
2145C C o m m o n B l o c k s
2146C-----------------------------------------------
2147#include "com01_c.inc"
2148#include "units_c.inc"
2149#include "task_c.inc"
2150#include "impl1_c.inc"
2151C-----------------------------------------------
2152C D u m m y A r g u m e n t s
2153C-----------------------------------------------
2154C REAL
2155 INTEGER NDDL0,NNZK0,NDDL,NNZK,NNMAX
2156C-----------------------------------------------
2157C L o c a l V a r i a b l e s
2158C-----------------------------------------------
2159 INTEGER NDDLG0,NNZKG0,NDDLG,NNZKG,NNMAXG,NNMAX0
2160 INTEGER NDDL0P(NSPMD),NNZK0P(NSPMD),NDDLP(NSPMD) ,
2161 . NNZKP(NSPMD),NNMAXP(NSPMD),I
2162C------------------------------------------
2163 IF (NSPMD>1) THEN
2164 NDDLG0 = nddl0
2165 nnzkg0 = nnzk0
2166 nddlg = nddl
2167 nnzkg = nnzk
2168 nnmaxg = nnmax
2169 CALL spmd_inf_g(
2170 1 nddlg0 ,nnzkg0 ,nddlg ,nnzkg ,nnmaxg ,
2171 2 nddl0p ,nnzk0p ,nddlp ,nnzkp ,nnmaxp )
2172 IF (ispmd==0) THEN
2173 IF (imp_chk>0) THEN
2174 WRITE(iout,*)
2175 WRITE(iout,*)' *--------- STIFFNESS MATRIX INFO. ---------*'
2176 WRITE(iout,1001)nddlg0,nnzkg0,nnmaxg
2177 WRITE(iout,*)
2178 DO i=1,nspmd
2179 WRITE(iout,1003)i,nddl0p(i),nnzk0p(i),nnmaxp(i)
2180 ENDDO
2181 WRITE(iout,*)
2182 WRITE(iout,1002)nddlg,nnzkg,nnmaxg
2183 WRITE(iout,*)
2184 DO i=1,nspmd
2185 WRITE(iout,1003)i,nddlp(i),nnzkp(i),nnmaxp(i)
2186 ENDDO
2187 ELSE
2188 WRITE(iout,*)
2189 WRITE(istdo,*)
2190 WRITE(iout,*)' *--------- STIFFNESS MATRIX SETUP ---------*'
2191 WRITE(istdo,*)' *--------- STIFFNESS MATRIX SETUP ---------*'
2192 WRITE(iout,1001)nddlg0,nnzkg0,nnmaxg
2193 WRITE(istdo,1001)nddlg0,nnzkg0,nnmaxg
2194 WRITE(iout,*)
2195 WRITE(istdo,*)
2196 DO i=1,nspmd
2197 WRITE(iout,1003)i,nddl0p(i),nnzk0p(i),nnmaxp(i)
2198 WRITE(istdo,1003)i,nddl0p(i),nnzk0p(i),nnmaxp(i)
2199 ENDDO
2200 WRITE(iout,*)
2201 WRITE(istdo,*)
2202 WRITE(iout,1002)nddlg,nnzkg,nnmaxg
2203 WRITE(istdo,1002)nddlg,nnzkg,nnmaxg
2204 WRITE(iout,*)
2205 WRITE(istdo,*)
2206 DO i=1,nspmd
2207 WRITE(iout,1003)i,nddlp(i),nnzkp(i),nnmaxp(i)
2208 WRITE(istdo,1003)i,nddlp(i),nnzkp(i),nnmaxp(i)
2209 ENDDO
2210C IF (L_LIM==0) L_LIM=NDDLG
2211 ENDIF
2212 ENDIF
2213 ELSE
2214 IF (imp_chk>0) THEN
2215 WRITE(iout,*)
2216 WRITE(iout,*)' *--------- STIFFNESS MATRIX INFO. ---------*'
2217 WRITE(iout,1001)nddl0,nnzk0,nnmax
2218 WRITE(iout,1002)nddl,nnzk,nnmax
2219 WRITE(iout,*)
2220 ELSE
2221 WRITE(iout,*)
2222 WRITE(istdo,*)
2223 WRITE(iout,*)' *--------- STIFFNESS MATRIX SETUP ---------*'
2224 WRITE(istdo,*)' *--------- STIFFNESS MATRIX SETUP ---------*'
2225 WRITE(iout,1001)nddl0,nnzk0,nnmax
2226 WRITE(istdo,1001)nddl0,nnzk0,nnmax
2227 WRITE(iout,1002)nddl,nnzk,nnmax
2228 WRITE(istdo,1002)nddl,nnzk,nnmax
2229 WRITE(iout,*)
2230 WRITE(istdo,*)
2231 ENDIF
2232 IF (l_lim==0) l_lim=nddl
2233 ENDIF
2234 1001 FORMAT(' SYMBOLIC DIM : ND =',i8,1x,'NZ =',i10,1x,'NB_MAX =',i8)
2235 1002 FORMAT(' FINAL DIM : ND =',i8,1x,'NZ =',i10,1x,'NB_MAX =',i8)
2236 1003 FORMAT(' PROC=',i5,5x,'ND =',i8,1x,'NZ =',i10,1x,'NB_MAX =',i8)
2237C------------------------------------------
2238 RETURN
2239 END
2240!||====================================================================
2241!|| k_band ../engine/source/implicit/imp_solv.F
2242!||--- called by ------------------------------------------------------
2243!|| imp_chkm ../engine/source/implicit/imp_solv.F
2244!|| imp_solv ../engine/source/implicit/imp_solv.F
2245!|| ind_spa2 ../engine/source/implicit/ind_glob_k.F
2246!|| ind_span ../engine/source/implicit/ind_glob_k.F
2247!||====================================================================
2248 SUBROUTINE k_band(NDDL,IADK,JDIK,NDMAX)
2249C-----------------------------------------------
2250C I m p l i c i t T y p e s
2251C-----------------------------------------------
2252#include "implicit_f.inc"
2253C-----------------------------------------------
2254C D u m m y A r g u m e n t s
2255C-----------------------------------------------
2256C REAL
2257 INTEGER NDDL,IADK(*),JDIK(*),NDMAX
2258C-----------------------------------------------
2259C L o c a l V a r i a b l e s
2260C-----------------------------------------------
2261 INTEGER I,J,JD,ND(NDDL)
2262C------------------------------------------
2263 DO i = 1, nddl
2264 nd(i) = 1 + iadk(i+1) - iadk(i)
2265 DO j = iadk(i),iadk(i+1)-1
2266 jd = jdik(j)
2267 nd(jd) = nd(jd) + 1
2268 ENDDO
2269 ENDDO
2270C
2271 ndmax = 0
2272 DO i = 1, nddl
2273 ndmax = max(ndmax,nd(i))
2274 ENDDO
2275C------------------------------------------
2276 RETURN
2277 END
2278!||====================================================================
2279!|| m_lnz ../engine/source/implicit/imp_solv.F
2280!||--- called by ------------------------------------------------------
2281!|| imp_chkm ../engine/source/implicit/imp_solv.F
2282!|| imp_solv ../engine/source/implicit/imp_solv.F
2283!||--- calls -----------------------------------------------------
2284!|| dim_subnz ../engine/source/implicit/imp_solv.F
2285!|| sp_stat0 ../engine/source/implicit/imp_fsa_inv.F
2286!||====================================================================
2287 SUBROUTINE m_lnz(NDDL,IADK,JDIK,NDMAX,NLMAX)
2288C-----------------------------------------------
2289C I m p l i c i t T y p e s
2290C-----------------------------------------------
2291#include "implicit_f.inc"
2292C-----------------------------------------------
2293C D u m m y A r g u m e n t s
2294C-----------------------------------------------
2295C REAL
2296 INTEGER NDDL,IADK(*),JDIK(*),NDMAX,NLMAX
2297C-----------------------------------------------
2298C L o c a l V a r i a b l e s
2299C-----------------------------------------------
2300 INTEGER I,J,JD,JM(NDMAX+1),NC,NNZ
2301C------------------------------------------
2302 DO i=1,nddl
2303 CALL sp_stat0(i ,iadk ,jdik ,nc ,jm )
2304 CALL dim_subnz(iadk ,jdik ,nc ,jm ,nnz )
2305 nlmax = max(nlmax,nnz)
2306 ENDDO
2307C------------------------------------------
2308 RETURN
2309 END
2310!||====================================================================
2311!|| dim_subnz ../engine/source/implicit/imp_solv.F
2312!||--- called by ------------------------------------------------------
2313!|| m_lnz ../engine/source/implicit/imp_solv.F
2314!||--- calls -----------------------------------------------------
2315!|| intab0 ../engine/source/implicit/imp_fsa_inv.f
2316!||====================================================================
2317 SUBROUTINE dim_subnz(IADK ,JDIK ,NC ,JM , NNZA )
2318C-----------------------------------------------
2319C I m p l i c i t T y p e s
2320C-----------------------------------------------
2321#include "implicit_f.inc"
2322C-----------------------------------------------
2323C D u m m y A r g u m e n t s
2324C-----------------------------------------------
2325 INTEGER IADK(*) ,JDIK(*),NC ,JM(*),NNZA
2326C REAL
2327C-----------------------------------------------
2328C External function
2329C-----------------------------------------------
2330 INTEGER INTAB0
2331 EXTERNAL intab0
2332C-----------------------------------------------
2333C L o c a l V a r i a b l e s
2334C-----------------------------------------------
2335 INTEGER I,J,K,JJ,N
2336C--------------------------------------------
2337 nnza=0
2338 DO i=1,nc
2339 j=jm(i)
2340 DO k=iadk(j),iadk(j+1)-1
2341 jj=jdik(k)
2342 n=intab0(nc,jm,jj)
2343 IF (n>0) nnza=nnza+1
2344 ENDDO
2345 ENDDO
2346C
2347 RETURN
2348 END
2349!||====================================================================
2350!|| imp_checm ../engine/source/implicit/imp_solv.F
2351!||--- called by ------------------------------------------------------
2352!|| imp_solv ../engine/source/implicit/imp_solv.F
2353!||====================================================================
2354 SUBROUTINE imp_checm(ITAB ,NDDL ,IDDL ,DIAG_M ,NDOF ,
2355 . IKC ,INLOC ,NDDL0 )
2356C-----------------------------------------------
2357C I m p l i c i t T y p e s
2358C-----------------------------------------------
2359#include "implicit_f.inc"
2360C-----------------------------------------------
2361C C o m m o n B l o c k s
2362C-----------------------------------------------
2363#include "com04_c.inc"
2364#include "units_c.inc"
2365C-----------------------------------------------
2366C D u m m y A r g u m e n t s
2367C-----------------------------------------------
2368C REAL
2369 INTEGER NDDL,NDDL0,NDOF(*),IDDL(*),IKC(*),INLOC(*),ITAB(*)
2370 my_real
2371 . diag_m(*)
2372C-----------------------------------------------
2373C L o c a l V a r i a b l e s
2374C-----------------------------------------------
2375 INTEGER NLIM,NID,NN,NKC,NFT,II,IDI,ND,ID
2376 PARAMETER (NLIM=6)
2377 INTEGER I,J,K,N,INOD(NLIM),IDL(6*NLIM),NFIX(NDDL0)
2378C------------------------------------------
2379 nid=0
2380 DO i=1,nddl
2381 IF (diag_m(i)>ep10) THEN
2382 nid=nid+1
2383 idl(nid)=i
2384 IF (nid==6*nlim) GOTO 100
2385 ENDIF
2386 ENDDO
2387 100 CONTINUE
2388 IF (nid>0) THEN
2389 nkc=0
2390 DO n = 1,numnod
2391 i=inloc(n)
2392 DO j=1,ndof(i)
2393 nd = iddl(i)+j
2394 IF (ikc(nd)>0) nkc=nkc+1
2395 nfix(nd)=nkc
2396 ENDDO
2397 ENDDO
2398 nn=0
2399 nft=1
2400 DO 400 k = 1,nid
2401 DO n = nft,numnod
2402 i=inloc(n)
2403 idi=iddl(i)
2404 id=idi-nfix(idi)
2405 DO j=1,ndof(i)
2406 nd = idi+j
2407 id = nd-nfix(nd)
2408 IF (idl(k)==id) THEN
2409 nn=nn+1
2410 inod(nn)=itab(i)
2411 IF (nn==nlim) GOTO 200
2412 nft=n+1
2413 GOTO 400
2414 ENDIF
2415 ENDDO
2416 ENDDO
2417 400 CONTINUE
2418 200 CONTINUE
2419 IF (nn>0) THEN
2420 WRITE(iout,*)
2421 . ' **WARNING : POSSIBLE NOT DEFINITE STIFFNESS MATRIX ** '
2422 WRITE(iout,*)'--- look at nodes:---'
2423 WRITE(IOUT,*)(INOD(I),I=1,NN)
2424 WRITE(ISTDO,*)
2425 . ' **warning : possible not definite stiffness matrix ** '
2426 WRITE(ISTDO,*)'--- look at nodes:---'
2427 WRITE(ISTDO,*)(INOD(I),I=1,NN)
2428 ENDIF
2429 ENDIF
2430C
2431C------------------------------------------
2432 RETURN
2433 END
2434!||====================================================================
2435!|| imp_b2a ../engine/source/implicit/imp_solv.F
2436!||--- called by ------------------------------------------------------
2437!|| imp_solv ../engine/source/implicit/imp_solv.F
2438!||====================================================================
2439 SUBROUTINE IMP_B2A(F ,M ,IDDL ,NDOF ,B )
2440C-----------------------------------------------
2441C I m p l i c i t T y p e s
2442C-----------------------------------------------
2443#include "implicit_f.inc"
2444C-----------------------------------------------
2445C C o m m o n B l o c k s
2446C-----------------------------------------------
2447#include "com04_c.inc"
2448C-----------------------------------------------
2449C D u m m y A r g u m e n t s
2450C-----------------------------------------------
2451 INTEGER IDDL(*),NDOF(*)
2452C REAL
2453 my_real
2454 . F(3,*),M(3,*),B(*)
2455C-----------------------------------------------
2456C L o c a l V a r i a b l e s
2457C-----------------------------------------------
2458 INTEGER I,J,ID
2459C------------------------------------------
2460 DO I = 1,NUMNOD
2461 DO J =1,NDOF(I)
2462 ID = IDDL(I) + J
2463 IF (J>3) THEN
2464 M(J-3,I) = B(ID)
2465 ELSE
2466 F(J,I) = B(ID)
2467 ENDIF
2468 ENDDO
2469 ENDDO
2470C------------------------------------------
2471 RETURN
2472 END
2473!||====================================================================
2474!|| ini_kif ../engine/source/implicit/imp_solv.F
2475!||--- called by ------------------------------------------------------
2476!|| imp_solv ../engine/source/implicit/imp_solv.F
2477!||--- uses -----------------------------------------------------
2478!|| imp_lintf ../engine/share/modules/impbufdef_mod.F
2479!||====================================================================
2480 SUBROUTINE INI_KIF
2481C-----------------------------------------------
2482C M o d u l e s
2483C-----------------------------------------------
2484 USE IMP_LINTF
2485C-----------------------------------------------
2486C I m p l i c i t T y p e s
2487C-----------------------------------------------
2488#include "implicit_f.inc"
2489C-----------------------------------------------
2490C L o c a l V a r i a b l e s
2491C-----------------------------------------------
2492 NDDLIF = 0
2493 NZIF = 0
2494C------------------------------------------
2495 RETURN
2496 END
2497!||====================================================================
2498!|| save_kif ../engine/source/implicit/imp_solv.F
2499!||--- called by ------------------------------------------------------
2500!|| imp_solv ../engine/source/implicit/imp_solv.F
2501!||--- calls -----------------------------------------------------
2502!|| cp_int ../engine/source/implicit/produt_v.F
2503!|| cp_real ../engine/source/implicit/produt_v.F
2504!||--- uses -----------------------------------------------------
2505!|| imp_lintf ../engine/share/modules/impbufdef_mod.F
2506!||====================================================================
2507 SUBROUTINE SAVE_KIF(NDDL ,IADK ,JDIK ,DIAG_K,LT_K ,
2508 1 ITOK ,NDDLG)
2509C-----------------------------------------------
2510C M o d u l e s
2511C-----------------------------------------------
2512 USE IMP_LINTF
2513C-----------------------------------------------
2514C I m p l i c i t T y p e s
2515C-----------------------------------------------
2516#include "implicit_f.inc"
2517C-----------------------------------------------
2518C D u m m y A r g u m e n t s
2519C-----------------------------------------------
2520 INTEGER NDDL,IADK(*),JDIK(*),ITOK(*),NDDLG
2521C REAL
2522 my_real
2523 . DIAG_K(*),LT_K(*)
2524C-----------------------------------------------
2525C L o c a l V a r i a b l e s
2526C-----------------------------------------------
2527 INTEGER IADCP(NDDLIF+1),JDICP(NZIF),ITOCP(NDDLIF)
2528 INTEGER NDDLI0,NZI0,NZK,IERR1,IERR2,ITAG(NDDLG),
2529 . I,J,II,NL,NR,ITON(NDDL)
2530 my_real
2531 . DIAG_CP(NDDLIF),LT_CP(NZIF)
2532C------------------------------------------
2533 IF (NDDL==0) RETURN
2534 IF (NDDLIF==0) THEN
2535 NDDLIF = NDDL
2536 NZIF =IADK(NDDL+1)-IADK(1)
2537 IF(ALLOCATED(IADIF)) DEALLOCATE(IADIF)
2538 IF(ALLOCATED(JDIIF)) DEALLOCATE(JDIIF)
2539 IF(ALLOCATED(IFTOK)) DEALLOCATE(IFTOK)
2540 ALLOCATE(IADIF(NDDLIF+1),IFTOK(NDDLIF),JDIIF(NZIF),STAT=IERR1)
2541 CALL CP_INT((NDDLIF+1),IADK,IADIF)
2542 CALL CP_INT(NDDLIF,ITOK,IFTOK)
2543 CALL CP_INT(NZIF,JDIK,JDIIF)
2544 IF(ALLOCATED(DIAG_IF)) DEALLOCATE(DIAG_IF)
2545 IF(ALLOCATED(LT_IF)) DEALLOCATE(LT_IF)
2546 ALLOCATE(DIAG_IF(NDDLIF),LT_IF(NZIF),STAT=IERR2)
2547 CALL CP_REAL(NDDLIF,DIAG_K,DIAG_IF)
2548 CALL CP_REAL(NZIF,LT_K,LT_IF)
2549 ELSE
2550 CALL CP_INT((NDDLIF+1),IADIF,IADCP)
2551 CALL CP_INT(NDDLIF,IFTOK,ITOCP)
2552 CALL CP_REAL(NDDLIF,DIAG_IF,DIAG_CP)
2553 CALL CP_INT(NZIF,JDIIF,JDICP)
2554 CALL CP_REAL(NZIF,LT_IF,LT_CP)
2555 NDDLI0 = NDDLIF
2556 NZI0 = NZIF
2557 DO I = 1,NDDLG
2558 ITAG(I) = 0
2559 ENDDO
2560 DO I = 1,NDDLI0
2561 ITAG(IFTOK(I)) = I
2562 ENDDO
2563 DO I = 1,NDDL
2564 J = ITOK(I)
2565 IF (ITAG(J)==0) THEN
2566 NDDLIF = NDDLIF+1
2567 NZIF = NZIF+IADK(I+1)-IADK(I)
2568 ITON(I) = NDDLIF
2569 ELSE
2570 ITON(I) = ITAG(J)
2571 ENDIF
2572 ENDDO
2573 IF(ALLOCATED(IADIF)) DEALLOCATE(IADIF)
2574 IF(ALLOCATED(JDIIF)) DEALLOCATE(JDIIF)
2575 IF(ALLOCATED(IFTOK)) DEALLOCATE(IFTOK)
2576 ALLOCATE(IADIF(NDDLIF+1),IFTOK(NDDLIF),JDIIF(NZIF),STAT=IERR1)
2577 IF(ALLOCATED(DIAG_IF)) DEALLOCATE(DIAG_IF)
2578 IF(ALLOCATED(LT_IF)) DEALLOCATE(LT_IF)
2579 ALLOCATE(DIAG_IF(NDDLIF),LT_IF(NZIF),STAT=IERR2)
2580C---------copy old-----
2581 CALL CP_INT((NDDLI0+1),IADCP,IADIF)
2582 CALL CP_INT(NDDLI0,ITOCP,IFTOK)
2583 CALL CP_REAL(NDDLI0,DIAG_CP,DIAG_IF)
2584 CALL CP_INT(NZI0,JDICP,JDIIF)
2585 CALL CP_REAL(NZI0,LT_CP,LT_IF)
2586C---------add [k]-----
2587 NL = NDDLI0
2588 NZIF = NZI0
2589 DO I = 1,NDDL
2590 J = ITOK(I)
2591 IF (ITAG(J)==0) THEN
2592 NL = NL + 1
2593 NR = IADK(I+1)-IADK(I)
2594 IFTOK(NL) = J
2595 DIAG_IF(NL)=DIAG_K(I)
2596 DO II = IADK(I),IADK(I+1)-1
2597 NZIF = NZIF + 1
2598 JDIIF(NZIF) = ITON(JDIK(II))
2599 LT_IF(NZIF) = LT_K(II)
2600 ENDDO
2601 IADIF(NL+1) = NZIF + 1
2602 ENDIF
2603 ENDDO
2604C
2605 IF (NL/=NDDLIF)
2606 . print *,'--memery problem [k]if--:',NL,NDDLIF
2607 ENDIF
2608C------------------------------------------
2609 RETURN
2610 END
2611!||====================================================================
2612!|| diag_kif ../engine/source/implicit/imp_solv.F
2613!||--- called by ------------------------------------------------------
2614!|| lin_solv ../engine/source/implicit/lin_solv.F
2615!||--- uses -----------------------------------------------------
2616!|| imp_lintf ../engine/share/modules/impbufdef_mod.F
2617!||====================================================================
2618 SUBROUTINE DIAG_KIF(DIAG_K)
2619C-----------------------------------------------
2620C M o d u l e s
2621C-----------------------------------------------
2622 USE IMP_LINTF
2623C-----------------------------------------------
2624C I m p l i c i t T y p e s
2625C-----------------------------------------------
2626#include "implicit_f.inc"
2627C-----------------------------------------------
2628C D u m m y A r g u m e n t s
2629C-----------------------------------------------
2630C REAL
2631 my_real
2632 . DIAG_K(*)
2633C-----------------------------------------------
2634C L o c a l V a r i a b l e s
2635C-----------------------------------------------
2636 INTEGER I,II
2637C-----------------------------
2638 RETURN
2639 DO I=1,NDDLIF
2640 II = IFTOK(I)
2641 DIAG_K(II) = DIAG_K(II) +DIAG_IF(I)
2642 ENDDO
2643C-----------------------------
2644 RETURN
2645 END
2646!||====================================================================
2647!|| matv_kif ../engine/source/implicit/imp_solv.F
2648!||--- called by ------------------------------------------------------
2649!|| mav_lt2 ../engine/source/implicit/produt_v.F
2650!|| mav_lth ../engine/source/implicit/produt_v.F
2651!|| mav_lth0 ../engine/source/implicit/produt_v.F
2652!|| mav_ltp ../engine/source/implicit/produt_v.F
2653!||--- uses -----------------------------------------------------
2654!|| imp_lintf ../engine/share/modules/impbufdef_mod.F
2655!||====================================================================
2656 SUBROUTINE MATV_KIF(V,W)
2657C-----------------------------------------------
2658C M o d u l e s
2659C-----------------------------------------------
2660 USE IMP_LINTF
2661C-----------------------------------------------
2662C I m p l i c i t T y p e s
2663C-----------------------------------------------
2664#include "implicit_f.inc"
2665C-----------------------------------------------
2666C D u m m y A r g u m e n t s
2667C-----------------------------------------------
2668C REAL
2669 my_real
2670 . W(*), V(*)
2671C-----------------------------------------------
2672C L o c a l V a r i a b l e s
2673C-----------------------------------------------
2674 INTEGER I,J,K,II,KK
2675 my_real
2676 . L_K
2677C-----------------------------
2678 RETURN
2679 DO I=1,NDDLIF
2680 II = IFTOK(I)
2681c W(II) = W(II) +DIAG_IF(I)*V(II)
2682 DO J =IADIF(I),IADIF(I+1)-1
2683 K =JDIIF(J)
2684 KK = IFTOK(K)
2685 L_K = LT_IF(J)
2686 W(II) = W(II) + L_K*V(KK)
2687 W(KK) = W(KK) + L_K*V(II)
2688 ENDDO
2689 ENDDO
2690C-----------------------------
2691 RETURN
2692 END
2693!||====================================================================
2694!|| imp_cpre ../engine/source/implicit/imp_solv.F
2695!||--- calls -----------------------------------------------------
2696!|| buf_dim ../engine/source/implicit/produt_v.F
2697!|| cp_real ../engine/source/implicit/produt_v.F
2698!||====================================================================
2699 SUBROUTINE IMP_CPRE(IFLAG,NNDL ,
2700 1 ELBUF ,ELBUF_C,BUFMAT ,FSAV ,VOLMON ,BUFMAT_C,X ,X_C ,
2701 2 PARTSAV,R_IMP )
2702C-----------------------------------------------
2703C I m p l i c i t T y p e s
2704C-----------------------------------------------
2705#include "implicit_f.inc"
2706C-----------------------------------------------
2707C C o m m o n B l o c k s
2708C-----------------------------------------------
2709#include "com04_c.inc"
2710#include "param_c.inc"
2711#include "scr11_c.inc"
2712C-----------------------------------------------
2713C D u m m y A r g u m e n t s
2714C-----------------------------------------------
2715 INTEGER IFLAG,NNDL
2716C REAL
2717 my_real
2718 . ELBUF(*) ,ELBUF_C(*),BUFMAT(*) ,FSAV(*),VOLMON(*) ,BUFMAT_C(*),
2719 . X(*) ,X_C(*) ,PARTSAV(*),R_IMP(*)
2720C-----------------------------------------------
2721C L o c a l V a r i a b l e s
2722C-----------------------------------------------
2723 INTEGER LI1,LI2,LI3,LI4,LI5
2724C--------------Iflag= 1->copy; 2 ->restore---------------
2725 CALL BUF_DIM(LI1,LI2,LI3,LI4)
2726 IF (IFLAG==1) THEN
2727 CALL CP_REAL(LI1,ELBUF,ELBUF_C)
2728 CALL CP_REAL(LI2,BUFMAT,BUFMAT_C)
2729 CALL CP_REAL(LI3,FSAV,BUFMAT_C(LI2+1))
2730 CALL CP_REAL(LI4,VOLMON,BUFMAT_C(LI2+LI3+1))
2731 CALL CP_REAL(NNDL,X,X_C)
2732 CALL CP_REAL(NPSAV*NPART,PARTSAV,R_IMP(16))
2733 R_IMP(14) = ENCIN
2734 R_IMP(15) = ENROT
2735 ELSEIF (IFLAG==2) THEN
2736 CALL CP_REAL(LI1,ELBUF_C,ELBUF)
2737 CALL CP_REAL(LI2,BUFMAT_C,BUFMAT)
2738 CALL CP_REAL(LI3,BUFMAT_C(LI2+1),FSAV)
2739 CALL CP_REAL(LI4,BUFMAT_C(LI2+LI3+1),VOLMON)
2740 CALL CP_REAL(NNDL,X_C,X)
2741 CALL CP_REAL(NPSAV*NPART,R_IMP(16),PARTSAV)
2742 ENCIN = R_IMP(14)
2743 ENROT = R_IMP(15)
2744 ENDIF
2745C-----------------------------
2746 RETURN
2747 END
2748!||====================================================================
2749!|| imp_check0 ../engine/source/implicit/imp_solv.F
2750!||--- called by ------------------------------------------------------
2751!|| imp_chkm ../engine/source/implicit/imp_solv.F
2752!||--- calls -----------------------------------------------------
2753!|| spmd_max_i ../engine/source/mpi/implicit/imp_spmd.F
2754!|| spmd_send_vr ../engine/source/mpi/implicit/imp_spmd.F
2755!|| spmd_sum_s ../engine/source/mpi/implicit/imp_spmd.F
2756!|| spmd_sumf_v ../engine/source/mpi/implicit/imp_spmd.F
2757!||====================================================================
2758 SUBROUTINE IMP_CHECK0(ITAB ,NDDL ,IDDL ,DIAG_K ,DIAG_M ,
2759 . NDOF ,IKC ,INLOC ,NDDL0 ,NIR ,
2760 . NDDLI ,ITOK ,DIAG_I,IWAR ,IERR )
2761C-----------------------------------------------
2762C I m p l i c i t T y p e s
2763C-----------------------------------------------
2764#include "implicit_f.inc"
2765C-----------------------------------------------
2766C C o m m o n B l o c k s
2767C-----------------------------------------------
2768#include "com04_c.inc"
2769#include "units_c.inc"
2770#include "task_c.inc"
2771#include "com01_c.inc"
2772C-----------------------------------------------
2773C D u m m y A r g u m e n t s
2774C-----------------------------------------------
2775C REAL
2776 INTEGER NDDL,NDDL0,NDOF(*),IDDL(*),IKC(*),INLOC(*),ITAB(*),
2777 . NIR,IWAR ,IERR, NDDLI ,ITOK(*)
2778 my_real
2779 . DIAG_K(*),DIAG_M(*),DIAG_I(*)
2780C-----------------------------------------------
2781C L o c a l V a r i a b l e s
2782C-----------------------------------------------
2783 INTEGER NLIM,NN,NKC,NFT,II,IDI,ND,ID,NID,NDMAX
2784 INTEGER I,J,K,N,IDDLM(NUMNOD)
2785 CHARACTER DIR(3)
2786 DATA DIR/'x','y','z'/
2787 my_real
2788 . S
2789 my_real,
2790 . DIMENSION(:,:),ALLOCATABLE :: SR
2791C------------------------------------------
2792 IF (ISPMD==0) THEN
2793 WRITE(IOUT,*)
2794 WRITE(IOUT,*)' ** zero stiffness checking **'
2795 WRITE(IOUT,*)
2796 WRITE(ISTDO,*)' * zero stiffness checking '
2797 ENDIF
2798 NID=0
2799 NIR=0
2800 DO I=1,NDDL
2801 DIAG_M(I) = DIAG_K(I)
2802 ENDDO
2803 DO I=1,NDDLI
2804 J=ITOK(I)
2805 DIAG_M(J)=DIAG_M(J)+DIAG_I(I)
2806 ENDDO
2807 IF (NSPMD>1)CALL SPMD_SUMF_V(DIAG_M)
2808 DO I=1,NDDL
2809 IF (DIAG_M(I)<EM10) THEN
2810 IF (DIAG_M(I)<=EM20) NIR =NIR +1
2811 NID = NID + 1
2812 ENDIF
2813 ENDDO
2814C
2815 IF (NSPMD>1) THEN
2816 S = NID
2817 CALL SPMD_SUM_S(S)
2818 NN = INT(S)
2819 IF (NN>0) THEN
2820 S = NIR
2821 CALL SPMD_SUM_S(S)
2822 NIR = INT(S)
2823 ENDIF
2824 ELSE
2825 NN = NID
2826 ENDIF
2827C
2828 IERR = IERR + NIR
2829 IWAR = IWAR + NN-NIR
2830 IF (ISPMD==0) WRITE(IOUT,1000)NN
2831 IF (NID>0) THEN
2832 NKC=0
2833 DO N = 1,NUMNOD
2834 I=INLOC(N)
2835 IDDLM(I)=IDDL(I)-NKC
2836 DO J=1,NDOF(I)
2837 ND = IDDL(I)+J
2838 IF (IKC(ND)>0) NKC=NKC+1
2839 ENDDO
2840 ENDDO
2841 ENDIF
2842 IF (NSPMD>1) THEN
2843 NDMAX = NID
2844 CALL SPMD_MAX_I(NDMAX)
2845 IF (NID>0) THEN
2846 II = 0
2847 ALLOCATE(SR(3,NID))
2848 DO N = 1,NUMNOD
2849 I=INLOC(N)
2850 IDI=IDDLM(I)
2851 NKC = 0
2852 DO J=1,NDOF(I)
2853 ND = IDDL(I)+J
2854 IF (IKC(ND)==0) THEN
2855 NKC=NKC+1
2856 ID = IDI+NKC
2857 IF (DIAG_M(ID)<EM10) THEN
2858 II = II + 1
2859 SR(1,II)=ITAB(I)
2860 SR(2,II)=J
2861 SR(3,II)=DIAG_M(ID)
2862 ENDIF
2863 ENDIF
2864 ENDDO
2865 ENDDO
2866 CALL SPMD_SEND_VR(
2867 1 NID ,3 ,SR ,NDMAX ,IOUT )
2868 DEALLOCATE(SR)
2869 ENDIF
2870 ELSE
2871C
2872 IF (NID>0) THEN
2873 DO N = 1,NUMNOD
2874 I=INLOC(N)
2875 IDI=IDDLM(I)
2876 NKC = 0
2877 DO J=1,NDOF(I)
2878 ND = IDDL(I)+J
2879 IF (IKC(ND)==0) THEN
2880 NKC=NKC+1
2881 ID = IDI+NKC
2882 IF (DIAG_M(ID)<EM10) THEN
2883 IF (J<=3) THEN
2884 WRITE(IOUT,1001)ITAB(I),DIR(J),DIAG_M(ID)
2885 ELSE
2886 WRITE(IOUT,1002)ITAB(I),DIR(J-3),DIAG_M(ID)
2887 ENDIF
2888 ENDIF
2889 ENDIF
2890 ENDDO
2891 ENDDO
2892 ENDIF
2893 ENDIF
2894C------------------------------------------
2895 RETURN
2896 1000 FORMAT(' nd. =',i8,5x,'WITH POSSIBLE FREE STIFFNESS CHECKED',/)
2897 1001 FORMAT(' NODE NUM. =',i10,5x,'TRA_DIR = ',1a,5x,'VAL.= ',g14.7)
2898 1002 FORMAT(' NODE NUM. =',i10,5x,'ROT_DIR = ',1a,5x,'VAL.= ',g14.7)
2899 END
2900!||====================================================================
2901!|| imp_checm0 ../engine/source/implicit/imp_solv.F
2902!||--- called by ------------------------------------------------------
2903!|| imp_chkm ../engine/source/implicit/imp_solv.F
2904!||--- calls -----------------------------------------------------
2905!|| fr_dlft ../engine/source/mpi/implicit/imp_fri.F
2906!|| spmd_max_i ../engine/source/mpi/implicit/imp_spmd.F
2907!|| spmd_send_vr ../engine/source/mpi/implicit/imp_spmd.F
2908!|| spmd_sum_s ../engine/source/mpi/implicit/imp_spmd.F
2909!||====================================================================
2910 SUBROUTINE imp_checm0(ITAB ,NDDL ,IDDL ,DIAG_M ,NDOF ,
2911 . IKC ,INLOC ,NDDL0 ,IWAR ,IERR )
2912C-----------------------------------------------
2913C I m p l i c i t T y p e s
2914C-----------------------------------------------
2915#include "implicit_f.inc"
2916C-----------------------------------------------
2917C C o m m o n B l o c k s
2918C-----------------------------------------------
2919#include "com04_c.inc"
2920#include "units_c.inc"
2921#include "task_c.inc"
2922#include "com01_c.inc"
2923C-----------------------------------------------
2924C D u m m y A r g u m e n t s
2925C-----------------------------------------------
2926C REAL
2927 INTEGER NDDL,NDDL0,NDOF(*),IDDL(*),IKC(*),INLOC(*),ITAB(*),
2928 . iddiv,iwar,ierr
2929 my_real
2930 . diag_m(*)
2931C-----------------------------------------------
2932C L o c a l V a r i a b l e s
2933C-----------------------------------------------
2934 INTEGER NLIM,NID,NN,NKC,NFT,II,IDI,ND,ID,IW,IR,NDMAX
2935 INTEGER I,J,K,N,IDDLM(NUMNOD),IDLFT0,IDLFT1
2936 CHARACTER DIR(3)
2937 DATA DIR/'X','Y','Z'/
2938 my_real
2939 . S
2940 my_real,
2941 . DIMENSION(:,:),ALLOCATABLE :: sr
2942C------------------------------------------
2943 IF (ispmd==0) THEN
2944 WRITE(iout,*)
2945 WRITE(iout,*)' ** POSITIVE DEFINITE MATRIX CHECKING **'
2946 WRITE(iout,*)
2947 WRITE(istdo,*)' * POSITIVE DEFINITE MATRIX CHECKING '
2948 ENDIF
2949 nid=0
2950 idlft0=0
2951 ir=0
2952 IF (nspmd>1)
2953 . CALL fr_dlft(nddl,idlft0,idlft1)
2954 DO i=1+idlft0,nddl
2955 IF (diag_m(i)<em12.OR.diag_m(i)>ep10) THEN
2956 IF (diag_m(i)<=em20) ir =ir +1
2957 nid = nid+ 1
2958 ENDIF
2959 ENDDO
2960C
2961 IF (nspmd>1) THEN
2962 s = nid
2963 CALL spmd_sum_s(s)
2964 nn = int(s)
2965 IF (nn>0) THEN
2966 s = ir
2967 CALL spmd_sum_s(s)
2968 ir = int(s)
2969 ENDIF
2970 ELSE
2971 nn = nid
2972 ENDIF
2973 ierr = ierr + ir
2974 iwar = iwar + nn-ir
2975 IF (ispmd==0) WRITE(iout,1000)nn
2976 IF (nid>0) THEN
2977 nkc=0
2978 DO n = 1,numnod
2979 i=inloc(n)
2980 iddlm(i)=iddl(i)-nkc
2981 DO j=1,ndof(i)
2982 nd = iddl(i)+j
2983 IF (ikc(nd)>0) nkc=nkc+1
2984 ENDDO
2985 ENDDO
2986 ENDIF
2987C
2988 IF (nspmd>1) THEN
2989 ndmax = nid
2990 CALL spmd_max_i(ndmax)
2991 ALLOCATE(sr(3,nid))
2992 IF (nid>0) THEN
2993 ii = 0
2994 DO n = 1,numnod
2995 i=inloc(n)
2996 idi=iddlm(i)
2997 IF (ndof(i)>0.AND.idi>=idlft0) THEN
2998 nkc = 0
2999 DO j=1,ndof(i)
3000 nd = iddl(i)+j
3001 IF (ikc(nd)==0) THEN
3002 nkc=nkc+1
3003 id = idi+nkc
3004 IF (diag_m(id)<em12.OR.diag_m(id)>ep10) THEN
3005 ii = ii + 1
3006 sr(1,ii)=itab(i)
3007 sr(2,ii)=j
3008 sr(3,ii)=diag_m(id)
3009 ENDIF
3010 ENDIF
3011 ENDDO
3012 ENDIF
3013 ENDDO
3014 ENDIF
3015 CALL spmd_send_vr(
3016 1 nid ,3 ,sr ,ndmax ,iout )
3017 DEALLOCATE(sr)
3018 ELSE
3019C
3020 IF (nid>0) THEN
3021 DO n = 1,numnod
3022 i=inloc(n)
3023 idi=iddlm(i)
3024 IF (ndof(i)>0.AND.idi>=idlft0) THEN
3025 nkc = 0
3026 DO j=1,ndof(i)
3027 nd = iddl(i)+j
3028 IF (ikc(nd)==0) THEN
3029 nkc=nkc+1
3030 id = idi+nkc
3031 IF (diag_m(id)<em12.OR.diag_m(id)>ep10) THEN
3032 IF (j<=3) THEN
3033 WRITE(iout,1001)itab(i),dir(j),diag_m(id)
3034 ELSE
3035 WRITE(iout,1002)itab(i),dir(j-3),diag_m(id)
3036 ENDIF
3037 ENDIF
3038 ENDIF
3039 ENDDO
3040 ENDIF
3041 ENDDO
3042 ENDIF
3043 ENDIF
3044C------------------------------------------
3045 RETURN
3046 1000 FORMAT(' ND. =',i8,5x,'WITH POSSIBLE FREE CONNECTION CHECKED',/)
3047 1001 FORMAT(' NODE NUM. =',i10,5x,'TRA_DIR = ',1a,5x,'VAL.= ',g14.7)
3048 1002 FORMAT(' NODE NUM. =',i10,5x,'ROT_DIR = ',1a,5x,'VAL.= ',g14.7)
3049 1003 FORMAT(/,' LOOK AT CONNECTIVITY FOR NODE NUM. =',i10)
3050 END
3051!||====================================================================
3052!|| imp_chkm ../engine/source/implicit/imp_solv.F
3053!||--- called by ------------------------------------------------------
3054!|| resol ../engine/source/engine/resol.F
3055!||--- calls -----------------------------------------------------
3056!|| cfield_imp ../engine/source/loads/general/load_centri/cfield_imp.F
3057!|| dim_int_k ../engine/source/implicit/ind_glob_k.F
3058!|| force_imp ../engine/source/loads/general/force_imp.F
3059!|| fv_imp ../engine/source/constraints/general/impvel/fv_imp0.F
3060!|| fv_imp1 ../engine/source/constraints/general/impvel/fv_imp0.F
3061!|| fv_rw ../engine/source/constraints/general/impvel/fv_imp0.F
3062!|| gravit_imp ../engine/source/loads/general/grav/gravit_imp.F
3063!|| idel_int ../engine/source/implicit/ind_glob_k.F
3064!|| imp_check0 ../engine/source/implicit/imp_solv.F
3065!|| imp_checm0 ../engine/source/implicit/imp_solv.F
3066!|| imp_compab ../engine/source/implicit/imp_solv.F
3067!|| imp_compabp ../engine/source/implicit/imp_solv.F
3068!|| imp_dynam ../engine/source/implicit/imp_dyna.F
3069!|| imp_fr7i ../engine/source/mpi/implicit/imp_fri.F
3070!|| imp_frfv ../engine/source/mpi/implicit/imp_fri.F
3071!|| imp_fri ../engine/source/mpi/implicit/imp_fri.F
3072!|| imp_glob_khp ../engine/source/implicit/imp_glob_k.F
3073!|| imp_int_k ../engine/source/implicit/imp_int_k.F
3074!|| imp_setb ../engine/source/implicit/imp_setb.F
3075!|| ind_int_k ../engine/source/implicit/ind_glob_k.F
3076!|| ini_k0h ../engine/source/implicit/imp_solv.F
3077!|| k_band ../engine/source/implicit/imp_solv.F
3078!|| lin_solv ../engine/source/implicit/lin_solv.F
3079!|| m_lnz ../engine/source/implicit/imp_solv.F
3080!|| my_barrier ../engine/source/system/machine.F
3081!|| pr_infok ../engine/source/implicit/imp_solv.F
3082!|| produt_w ../engine/source/implicit/produt_v.F
3083!|| pvp_k ../engine/source/implicit/imp_solv.F
3084!|| rgwal0_imp ../engine/source/constraints/general/rwall/rgwal0.F
3085!|| spmd_max_i ../engine/source/mpi/implicit/imp_spmd.F
3086!|| spmd_min_s ../engine/source/mpi/implicit/imp_spmd.F
3087!|| spmd_sumf_a ../engine/source/mpi/implicit/imp_spmd.F
3088!|| startime ../engine/source/system/timer_mod.F90
3089!|| stoptime ../engine/source/system/timer_mod.F90
3090!|| upd_fr_k ../engine/source/mpi/implicit/imp_fri.F
3091!|| upd_glob_k ../engine/source/implicit/upd_glob_k.F
3092!|| upd_rhs ../engine/source/implicit/upd_glob_k.F
3093!|| weightddl ../engine/source/implicit/recudis.F
3094!|| zero1 ../engine/source/system/zero.F
3095!|| zeror ../engine/source/system/zero.F
3096!||--- uses -----------------------------------------------------
3097!|| drape_mod ../engine/share/modules/drape_mod.F
3098!|| dsgraph_mod ../engine/share/modules/dsgraph_mod.F
3099!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
3100!|| groupdef_mod ../common_source/modules/groupdef_mod.F
3101!|| h3d_mod ../engine/share/modules/h3d_mod.F
3102!|| imp_worki ../engine/share/modules/impbufdef_mod.F
3103!|| impbufdef_mod ../engine/share/modules/impbufdef_mod.F
3104!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
3105!|| python_funct_mod ../common_source/modules/python_mod.F90
3106!|| sensor_mod ../common_source/modules/sensor_mod.F90
3107!|| skew_mod ../common_source/modules/skew_mod.F90
3108!|| stack_mod ../engine/share/modules/stack_mod.F
3109!|| th_surf_mod ../common_source/modules/interfaces/th_surf_mod.F
3110!|| timer_mod ../engine/source/system/timer_mod.F90
3111!||====================================================================
3112 SUBROUTINE imp_chkm(TIMERS,PYTHON,
3113 1 ICODE ,ISKEW ,ISKWN ,IPART ,IXTG ,IXS ,IXQ ,
3114 2 IXC ,IXT ,IXP ,IXR ,IXTG1 ,ITAB ,ITABM1 ,
3115 3 NPC ,IBCL ,IBFV ,SENSOR_TAB,NNLINK ,LNLINK ,IPARG ,IGRV ,
3116 4 IPARI ,INTBUF_TAB,NPRW ,ICONX ,NPBY ,LPBY ,LRIVET ,
3117 5 NSTRF ,LJOINT ,ICODT ,ICODR ,ISKY ,ADSKY ,IADS_F ,
3118 6 ILINK ,LLINK ,WEIGHT ,ITASK ,IBVEL ,LBVEL ,FBVEL ,
3119 7 X ,D ,V ,VR ,DR ,THKE ,DAMP ,MS ,
3120 8 IN ,PM ,SKEWS ,GEO ,EANI ,BUFMAT ,BUFGEO ,BUFSF ,
3121 9 TF ,FORC ,VEL ,FSAV ,AGRV ,FR_WAVE,PARTS0 ,
3122 A ELBUF ,RBY ,RIVET ,FR_ELEM,IAD_ELEM,NSENSOR,
3123 B WA ,A ,AR ,STIFN ,STIFR ,PARTSAV,FSKY ,
3124 C FSKYI ,IFRAME ,XFRAME ,W16 ,IACTIV ,FSKYM ,IGEO ,IPM ,
3125 D WFEXT ,NODFT ,NODLT ,NINT7 ,NUM_IMP,NS_IMP ,NE_IMP ,IND_IMP,
3126 L IT ,RWBUF ,LPRW ,FR_WALL,NBINTC ,INTLIST,FOPT ,RWSAV ,
3127 M FSAVD ,DIRUL ,LGRAV ,IRBE3 ,LRBE3 ,FRBE3 ,
3128 N FRWL6 ,IRBE2 ,LRBE2 ,ICFIELD,LCFIELD,CFIELD,ELBUF_TAB,WEIGHT_MD,
3129 O STACK ,DIMFB ,FBSAV6 ,STABSEN,TABSENSOR,DRAPE_SH4N,DRAPE_SH3N,H3D_DATA,
3130 P NDDL0 ,NNZK0 ,IMPBUF_TAB,CPTREAC,FTHREAC,NODREAC,DRAPEG,TH_SURF ,
3131 Q DPL0CLD,VEL0CLD,SNPC,STF, WFEXT_MD,IGRSURF)
3132C-----------------------------------------------
3133C M o d u l e s
3134C-----------------------------------------------
3135 USE timer_mod
3136 USE python_funct_mod, only: python_
3137 USE dsgraph_mod
3138 USE imp_worki
3139 USE elbufdef_mod
3140 USE intbufdef_mod
3141 USE stack_mod
3142 USE h3d_mod
3143 USE impbufdef_mod
3144 USE sensor_mod
3145 USE drape_mod
3146 USE th_surf_mod , ONLY : th_surf_
3147 USE skew_mod , ONLY : skew_
3148 USE groupdef_mod
3149C-----------------------------------------------
3150C I m p l i c i t T y p e s
3151C-----------------------------------------------
3152#include "implicit_f.inc"
3153C-----------------------------------------------
3154C C o m m o n B l o c k s
3155C-----------------------------------------------
3156#if defined(MUMPS5)
3157#include "dmumps_struc.h"
3158#endif
3159#include "timeri_c.inc"
3160#include "impl1_c.inc"
3161#include "impl2_c.inc"
3162#include "param_c.inc"
3163#include "com01_c.inc"
3164#include "com04_c.inc"
3165#include "units_c.inc"
3166#include "task_c.inc"
3167C-----------------------------------------------
3168C D u m m y A r g u m e n t s
3169C-----------------------------------------------
3170 TYPE(timer_), INTENT(INOUT) :: TIMERS
3171 TYPE(PYTHON_), INTENT(INOUT) :: PYTHON
3172 INTEGER ,INTENT(IN) :: SNPC !< size of NPC
3173 INTEGER ,INTENT(IN) :: STF !< size of TF / Tabulated function array
3174 INTEGER ,INTENT(IN) :: NSENSOR
3175 INTEGER ITASK,ICODE(*), ISKEW(*), ISKWN(LISKN,*),ITABM1(*),
3176 . IPART(*),IXS(*),IXQ(NIXQ,*),IXC(NIXC,*), IXT(NIXT,*),
3177 . IXP(NIXP,*),IXR(NIXR,*), IXTG(NIXTG,*), IXTG1(4,*),
3178 . ITAB(*),NPC(*), IBCL(*), IBFV(*),IPARG(NPARG,*),IPARI(NPARI,*),
3179 . NPRW(*), NPBY(NNPBY,*), LPBY(*),IADS_F(*),
3180 . LRIVET(*), NSTRF(*), LJOINT(*), ICODT(*), ICODR(*), ILINK(*),
3181 . LLINK(*),ISKY(*),ADSKY(*),
3182 . NNLINK(10,*),LNLINK(*),IGRV(*),LGRAV(*),
3183 . WEIGHT(*),IFRAME(LISKN,*),IBVEL(NBVELP,*),LBVEL(*),
3184 . IACTIV(*),IGEO(*),IPM(*),ICONX(*),NODFT ,NODLT,IT,
3185 . icfield(*),lcfield(*),weight_md(*),
3186 . dimfb,stabsen,tabsensor(*),cptreac,nodreac(*)
3187 INTEGER LPRW(*), FR_WALL(NSPMD+2,*), FR_ELEM(*), IAD_ELEM(2,*),NBINTC ,INTLIST(*),DIRUL(*)
3188 my_real x(3,*) ,d(3,*) ,v(3,*) ,vr(3,*),damp(*),
3189 . ms(*) ,in(*) ,pm(npropm,*),geo(npropg,*),
3190 . bufmat(*) ,tf(*) ,forc(*) ,vel(*),fsav(nthvki,*) ,elbuf(*) ,
3191 . rwbuf(nrwlp,*),rwsav(*),rby(nrby,*),
3192 . rivet(*),wa(*), a(3,*) ,ar(3,*),partsav(*) ,
3193 . stifn(*) ,stifr(*),fsky(*),fskyi(*),dr(3,*),
3194 . eani(*),agrv(*), thke(*),fr_wave(*),parts0(*),bufgeo(*),
3195 . xframe(nxframe,*),w16(*),fbvel(*),fskym(*),bufsf(*),
3196 . fopt(6,*),fsavd(nthvki,*),cfield(*),frbe3(*),
3197 . fthreac(6,*)
3198 INTEGER NDDL0,NNZK0,NINT7
3199 INTEGER NUM_IMP(*),NS_IMP(*),NE_IMP(*),IND_IMP(*),IRBE3(*),LRBE3(*),IRBE2(*),LRBE2(*)
3200 TYPE (DRAPE_) :: DRAPE_SH4N(NUMELC_DRAPE), DRAPE_SH3N(NUMELTG_DRAPE)
3201 TYPE (DRAPEG_) :: DRAPEG
3202 my_real, INTENT(IN) :: DPL0CLD(6,NCONLD),VEL0CLD(6,NCONLD)
3203 DOUBLE PRECISION FRWL6(*)
3204 DOUBLE PRECISION FBSAV6(12,6,DIMFB)
3205 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
3206 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
3207 TYPE (STACK_PLY) :: STACK
3208 TYPE(H3D_DATABASE) :: H3D_DATA
3209 TYPE (IMPBUF_STRUCT_) ,TARGET :: IMPBUF_TAB
3210 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) :: SENSOR_TAB
3211 TYPE (TH_SURF_) , INTENT(INOUT) :: TH_SURF
3212 TYPE(SKEW_),INTENT(INOUT) :: SKEWS
3213 DOUBLE PRECISION,INTENT(INOUT) :: WFEXT, WFEXT_MD
3214 TYPE (GROUP_) , DIMENSION(NSURF) :: IGRSURF
3215C----------------------------------------------
3216C L o c a l V a r i a b l e s
3217C-----------------------------------------------
3218 INTEGER NNMAX,NKMAX,N_IMPN,N_IMPM,LNSS,LNSS2,NDT,NDS,NT_RW
3219 INTEGER I,J,NTMP,L1,L2,L3,NNDL,INPRINT,ISTOP,LI10,LI11,
3220 . li1,li2,li3,li4,li5,li6,li7,li8,li9,lif,ic,isetp,
3221 . li12,lnss3,li13,li14,li15,lnsb2,lnsrb2
3222 INTEGER, DIMENSION(:),ALLOCATABLE :: NSS,ISS,NSS2,ISS2,NSS3,ISS3
3223 INTEGER, DIMENSION(:),ALLOCATABLE :: NSB2,ISB2,IAINT2
3224 INTEGER NNOD,IFDIS,N1,N2,N3
3225 INTEGER LBAND,NCL_MAX,IRFLAG,IBID
3226 my_real TFEXC,TMP,TMP1,TMP2,R2,BFAC,FACI,R02,GAP,RBID,WE_IMP,LAMDA,DUMMY_FEXT(3,1)
3227 INTEGER, POINTER :: NDDL,NNZK,NRBYAC,NINT2,NMC,NMC2,NMONV
3228 INTEGER, DIMENSION(:) ,POINTER :: IADK,JDIK,IADM,JDIM
3229 INTEGER, DIMENSION(:) ,POINTER :: IDDL,NDOF,INLOC,LSIZE,I_IMP,IKC,
3230 . IRBYAC,NSC,IINT2,NKUD,IMONV,
3231 . IKINW,W_DDL,IKUD,NDOFI,IDDLI
3232 my_real, DIMENSION(:) ,POINTER :: DIAG_K,LT_K,DIAG_M,LT_M,LB,
3233 . LB0,BKUD,D_IMP,ELBUF_C,BUFMAT_C,
3234 . DR_IMP,X_C,DD,DDR,X_A,R_IMP
3235 my_real, DIMENSION(:) ,POINTER :: FEXT,DG,DGR,DG0,DGR0,BUFIN_C,AC,ACR
3236 TYPE(PRGRAPH) :: GRAPHE(1)
3237#ifdef MUMPS5
3238 TYPE(dmumps_struc) MUMPS_PAR
3239#else
3240 ! Fake declaration as DMUMPS_STRUC is shipped with MUMPS
3241 INTEGER MUMPS_PAR
3242#endif
3243
3244C------------------------------
3245C Initialisation
3246C-----------------------------------------------
3247 DUMMY_FEXT = zero
3248 nddl => impbuf_tab%NDDL
3249 nnzk => impbuf_tab%NNZK
3250 nrbyac => impbuf_tab%NRBYAC
3251 nint2 => impbuf_tab%NINT2
3252 nmc => impbuf_tab%NMC
3253 nmc2 => impbuf_tab%NMC2
3254 nmonv => impbuf_tab%NMONV
3255 iadk => impbuf_tab%IADK
3256 jdik => impbuf_tab%JDIK
3257 iddl => impbuf_tab%IDDL
3258 ndof => impbuf_tab%NDOF
3259 inloc => impbuf_tab%INLOC
3260 lsize => impbuf_tab%LSIZE
3261 i_imp => impbuf_tab%I_IMP
3262 irbyac => impbuf_tab%IRBYAC
3263 nsc => impbuf_tab%NSC
3264 iint2 => impbuf_tab%IINT2
3265 nkud => impbuf_tab%NKUD
3266 imonv => impbuf_tab%IMONV
3267 ikinw => impbuf_tab%IKINW
3268 ikc => impbuf_tab%IKC
3269 w_ddl => impbuf_tab%W_DDL
3270 ikud => impbuf_tab%IKUD
3271 iadm => impbuf_tab%IADM
3272 jdim => impbuf_tab%JDIM
3273 iddli => impbuf_tab%IDDLI
3274 ndofi => impbuf_tab%NDOFI
3275 diag_k =>impbuf_tab%DIAG_K
3276 lt_k =>impbuf_tab%LT_K
3277 diag_m =>impbuf_tab%DIAG_M
3278 lt_m =>impbuf_tab%LT_M
3279 lb =>impbuf_tab%LB
3280 lb0 =>impbuf_tab%LB0
3281 bkud =>impbuf_tab%BKUD
3282 d_imp =>impbuf_tab%D_IMP
3283 elbuf_c =>impbuf_tab%ELBUF_C
3284 bufmat_c=>impbuf_tab%BUFMAT_C
3285 x_c =>impbuf_tab%X_C
3286 dd =>impbuf_tab%DD
3287 ddr =>impbuf_tab%DDR
3288 fext =>impbuf_tab%FEXT
3289 dg =>impbuf_tab%DG
3290 dgr =>impbuf_tab%DGR
3291 dg0 =>impbuf_tab%DG0
3292 dgr0 =>impbuf_tab%DGR0
3293 dr_imp=>impbuf_tab%DR_IMP
3294 ac=>impbuf_tab%AC
3295 acr=>impbuf_tab%ACR
3296 r_imp => impbuf_tab%R_IMP
3297 ALLOCATE(iaint2(nint2))
3298 nddli=0
3299 istop=0
3300 inega=0
3301 nndl = 3*numnod
3302 nsrem=0
3303 nsl=0
3304 isetp = 1
3305 imp_iw = 0
3306 imp_ir = 0
3307 rbid=zero
3308 ibid= 0
3309C
3310 IF (irref>0.AND.imconv==1.AND.iline/=1) THEN
3311 irflag=irref
3312 ELSE
3313 irflag=0
3314 ENDIF
3315C
3316 CALL zeror(d_imp,numnod)
3317 IF (iroddl/=0) CALL zeror(dr_imp,numnod)
3318 CALL zeror(ac,numnod)
3319 IF (iroddl/=0) CALL zeror(acr,numnod)
3320C----------------------------------
3321C FORCES EXTERNES A=Fext-Fint
3322C----------------------------------
3323 ncl_max=0
3324 r_imp(16)=zero
3325 IF(nconld/=0) THEN
3326 CALL force_imp(ibcl ,forc ,snpc ,npc ,tf ,
3327 2 ac ,v ,x ,skews ,
3328 3 acr ,vr ,nsensor ,sensor_tab ,tfexc ,
3329 4 iads_f ,fsky ,dummy_fext ,h3d_data ,cptreac ,
3330 5 fthreac ,nodreac ,th_surf ,
3331 6 dpl0cld ,vel0cld ,d ,dr ,nconld ,
3332 7 numnod ,nfunct ,stf ,wfext)
3333 IF (nspmd>1) THEN
3334 DO i=iad_elem(1,1),iad_elem(1,nspmd+1)-1
3335 j = fr_elem(i)
3336 n1 = 3*(j-1)+1
3337 n2 = 3*(j-1)+2
3338 n3 = 3*(j-1)+3
3339 tmp = abs(ac(n1))+abs(ac(n2))+abs(ac(n3))
3340 IF (iroddl/=0) tmp = tmp + abs(acr(n1))+abs(acr(n2))+abs(acr(n3))
3341 IF (tmp>zero) ncl_max = ncl_max + 1
3342 ENDDO
3343 ENDIF
3344 ENDIF
3345 IF (nspmd>1) THEN
3346 CALL spmd_max_i(ncl_max)
3347 IF (ncl_max>0) THEN
3348 lband = iad_elem(1,nspmd+1)-iad_elem(1,1)
3349 IF (iroddl/=0) THEN
3350 ntmp = 6
3351 ELSE
3352 ntmp = 3
3353 ENDIF
3354 CALL spmd_sumf_a(ac,acr,iad_elem,fr_elem,ntmp,lband)
3355 ENDIF
3356 ENDIF
3357 IF(ngrav/=0) THEN
3358 CALL gravit_imp(igrv ,agrv ,npc ,tf ,ac,
3359 2 v ,x ,skews%SKEW ,ms,tfexc,
3360 3 nsensor,sensor_tab ,weight,
3361 4 lgrav ,itask ,
3362 5 nrbyac ,irbyac ,npby ,rby , python)
3363 ENDIF
3364 IF(nloadc/=0) THEN
3365 CALL cfield_imp(icfield ,cfield,npc ,tf ,ac,
3366 2 v ,x ,xframe ,ms,tfexc,
3367 3 nsensor,sensor_tab,weight,iframe,
3368 4 lcfield ,itask,
3369 5 nrbyac,irbyac,npby ,rby,iskwn, python )
3370 ENDIF
3371C-------------dU_d---------------------------------
3372 IF(nfxvel/=0.AND.imconv==1) THEN
3373 CALL fv_imp(ibfv ,npc ,tf ,vel ,sensor_tab,
3374 1 d_imp ,dr_imp ,ikc ,iddl ,nsensor ,
3375 2 skews%SKEW ,iframe ,xframe ,v ,vr ,
3376 3 x ,dirul ,ndof ,a ,vr )
3377 ENDIF
3378C-------------U_d--> rigid wall-------------------------------
3379 nt_rw=0
3380 IF (nrwall > 0) THEN
3381 CALL rgwal0_imp(
3382 1 x ,d_imp ,v ,rwbuf , lprw ,
3383 2 nprw ,ms ,fsav(1 ,ninter+1) , fr_wall ,
3384 3 fopt ,rwsav ,weight ,fsavd(1,ninter+1),
3385 4 nt_rw ,iddl ,ikc ,imconv , ndof , frwl6,
3386 5 weight_md ,dimfb ,fbsav6 ,stabsen , tabsensor, wfext, wfext_md)
3387 IF(nt_rw > 0) THEN
3388 CALL fv_rw(iddl ,ikc ,ndof ,d_imp ,v )
3389 ENDIF
3390 ENDIF
3391 ifdis=nt_rw+nfxvel
3392 IF(ifdis>0.AND.imconv==1) THEN
3393 IF(nt_rw>0) THEN
3394 DO i=1,nddl0
3395 IF (ikc(i)==3) ikc(i)=4
3396 IF (ikc(i)==10) ikc(i)=11
3397 ENDDO
3398 ENDIF
3399 ENDIF
3400 ntmp = nt_rw
3401 IF (nspmd>1) CALL spmd_max_i(ntmp)
3402 IF(ntmp>0) THEN
3403 IF(ispmd==0) THEN
3404 WRITE(iout,*)' *--------- RIGID WALL IMPACT---------*'
3405 ENDIF
3406 ENDIF
3407C----------------------------------
3408 CALL imp_setb(ac ,acr ,iddl ,ndof ,lb )
3409C----------------------------------
3410C CHECKING
3411C----------------------------------
3412 IF (ispmd==0) THEN
3413 WRITE(istdo,*)
3414 WRITE(istdo,*)' ** BEGIN IMPLICIT MODEL CHECKING **'
3415 WRITE(iout,*)
3416 WRITE(iout,*)' ** BEGIN IMPLICIT MODEL CHECKING **'
3417 WRITE(iout,*)
3418 ENDIF
3419 IF (nspmd>1) THEN
3420 CALL imp_compabp(
3421 1 icodt ,icodr ,iskew ,ibfv ,npc ,
3422 2 tf ,vel ,nsensor ,sensor_tab,xframe ,
3423 3 rby ,x ,skews%SKEW,lpby ,npby ,
3424 4 itab ,nrbyac ,irbyac ,nint2 ,iint2 ,
3425 5 ipari ,intbuf_tab,nt_rw ,nddl ,
3426 6 ndof ,ikc ,inloc ,iddl ,nddl0 ,
3427 7 imp_iw ,imp_ir )
3428 ELSE
3429 CALL imp_compab(
3430 1 icodt ,icodr ,iskew ,ibfv ,npc ,
3431 2 tf ,vel ,nsensor ,sensor_tab,xframe ,
3432 3 rby ,x ,skews%SKEW ,lpby ,npby ,
3433 4 itab ,nrbyac ,irbyac ,nint2 ,iint2 ,
3434 5 ipari ,intbuf_tab,nt_rw ,nddl ,
3435 6 ndof ,ikc ,inloc ,iddl ,nddl0 ,
3436 7 imp_iw ,imp_ir )
3437 ENDIF
3438
3439
3440C----------------------------------
3441C MATRICE DE RIGIDITE
3442C----------------------------------
3443 IF (isetk==1) THEN
3444 IF (ispmd==0) THEN
3445 WRITE(istdo,*)' * FINIT ELEMENT CHECKING '
3446 WRITE(iout,*)' ** FINIT ELEMENT CHECKING **'
3447 WRITE(iout,*)
3448 ENDIF
3449 IF (imon>0 .AND. itask ==0) CALL startime(timers,31)
3450 nddl = nddl0
3451 nnzk = nnzk0
3452 nnmax=lsize(9)
3453 nkmax=lsize(10)
3454 nmc2=lsize(11)
3455
3456 CALL zero1(diag_k,nddl)
3457 CALL zero1(lt_k,nnzk)
3458
3459 l1 = 1+nixs*numels
3460 l2 = l1+6*numels10
3461 l3 = l2+12*numels20
3462 li1 =1
3463 li2 = li1+lsize(4)
3464 li3 = li2+lsize(5)
3465 li4 = li3+lsize(1)
3466 li5 = li4+lsize(3)
3467 li6 = li5+lsize(7)
3468 li7 = li6+lsize(2)
3469 li8 = li7+lsize(6)
3470 li9 = li8+nint2
3471 li10 = li9+lsize(8)
3472 li11 = li10+(lsize(8)-lcokm)*lsize(9)
3473 li12 = li11+lcokm*lsize(10)
3474 li13 = li12+4*lsize(11)
3475 li14 = li13+lsize(14)
3476 li15 = li14+lsize(15)
3477 lif = li15+lsize(16)
3478C /---------------/
3479c CALL MY_BARRIER
3480C /---------------/
3481 CALL imp_glob_khp(
3482 1 pm ,geo ,ipm ,igeo ,elbuf ,
3483 2 ixs ,ixq ,ixc ,ixt ,ixp ,
3484 3 ixr ,ixtg ,ixtg1 ,ixs(l1) ,
3485 4 ixs(l2) ,ixs(l3) ,iparg ,tf ,npc ,
3486 5 fr_wave ,w16 ,bufmat ,thke ,bufgeo ,
3487 6 rby ,skews%SKEW ,x ,
3488 7 wa ,iddl ,ndof ,diag_k ,lt_k ,
3489 8 iadk ,jdik ,ikg ,ibid ,itask ,
3490 9 elbuf_tab ,stack ,drape_sh4n, drape_sh3n ,drapeg )
3491 nddl_l = nddl
3492C /---------------/
3493c CALL MY_BARRIER
3494C /---------------/
3495
3496C------ 1er VP: for dt check
3497 IF (impdeb>0.AND.nddl<1000) THEN
3498 CALL pvp_k(nddl,iadk,jdik,iddl ,inloc,ndof,itab,diag_k,lt_k ,lamda, j , ms )
3499 tmp = two*sqrt(one/lamda)
3500 write(iout,*) 'critical DT =',tmp
3501 END IF
3502 IF (idyna>0.OR.iqstat>0)
3503 . CALL imp_dynam(nodft ,nodlt ,iddl ,ndof ,diag_k ,
3504 . ms ,in ,hht_a ,weight ,iadk ,
3505 . lt_k )
3506 CALL upd_glob_k(
3507 1 icodt ,icodr ,iskew ,ibfv ,npc ,
3508 2 tf ,vel ,xframe ,
3509 3 rby ,x ,skews%SKEW ,lpby ,npby ,
3510 4 itab ,weight ,ms ,in ,nrbyac ,
3511 5 irbyac ,nsc ,ikinw(li1) ,nmc ,ikinw(li2),
3512 6 ikinw(li3),ikinw(li4),nint2 ,iint2 ,ikinw(li8),
3513 7 ikinw(li5),ikinw(li6),ikinw(li7) ,ipari ,intbuf_tab,
3514 8 nddl ,nnzk ,iadk ,jdik ,
3515 9 diag_k ,lt_k ,ndof ,iddl ,ikc ,
3516 a d_imp ,lb ,nkud ,ikud ,bkud ,
3517 b nmc2 ,ikinw(li12),nt_rw ,dr_imp ,dirul ,
3518 c irbe3 ,lrbe3 ,frbe3 ,ikinw(li13),irbe2 ,
3519 d lrbe2 ,ikinw(li14),ikinw(li15))
3520
3521 IF (nspmd>1) THEN
3522 CALL upd_fr_k(
3523 1 iadk ,jdik ,ndof ,ikc ,iddl ,
3524 2 inloc ,fr_elem ,iad_elem ,nddl )
3525
3526 CALL weightddl(iddl ,ndof ,ikc ,weight ,w_ddl ,inloc )
3527 ENDIF
3528 CALL pr_infok(nddl0,nnzk0,nddl,nnzk,max(nnmax,nkmax))
3529 IF (iprec>4.AND.nkmax>200) THEN
3530 CALL k_band(nddl,iadk,jdik,ibid)
3531 maxb = min(maxb,ibid)
3532 IF (maxb>10000) THEN
3533 CALL m_lnz(nddl,iadk,jdik,maxb,max_l)
3534 ENDIF
3535 ENDIF
3536
3537 CALL ini_k0h(nddl,nnzk,nnzk,iadk,jdik)
3538 IF (imon>0) CALL stoptime(timers,31)
3539 ENDIF
3540
3541C----------------------------------
3542C MATRICE DE RIGIDITE D'INTERFACE
3543C----------------------------------
3544 gap=ep20
3545 IF (nint7>0) THEN
3546 l1=lsize(1)
3547 l2=lsize(2)
3548 lnss2=0
3549 lnss=0
3550 IF (imon>0) CALL startime(timers,31)
3551 IF (imp_int==1) CALL idel_int(
3552 1 ipari ,intbuf_tab,num_imp ,ns_imp ,ne_imp ,
3553 2 ind_imp ,ndof ,nint7 )
3554 CALL dim_int_k(
3555 1 ipari ,intbuf_tab,num_imp ,ns_imp ,ne_imp ,
3556 2 npby ,lpby ,itab ,nrbyac ,irbyac ,
3557 3 lnss ,nint2 ,iint2 ,iaint2 ,lnss2 ,
3558 4 nddli ,nnzi ,iddli ,ndofi ,n_impn ,
3559 5 n_impm ,nnmax ,nkmax ,ndof ,nsrem ,
3560 6 irbe3 ,lrbe3 ,lnss3 ,irbe2 ,lrbe2 ,
3561 7 lnsb2 ,lnsrb2 ,ind_imp )
3562 ALLOCATE(iadi(nddli+1))
3563 ALLOCATE(itok(nddli))
3564 ALLOCATE(jdii(nnzi))
3565 ALLOCATE(nss2(l2),nss3(nrbe3),nsb2(lnsrb2))
3566 nsb2=0
3567 ALLOCATE(iss2(lnss2),iss3(lnss3),isb2(lnsb2))
3568 ALLOCATE(nss(l1))
3569 ALLOCATE(iss(lnss))
3570 DO i=1,l1
3571 nss(i)=0
3572 ENDDO
3573 CALL ind_int_k(
3574 1 ipari ,intbuf_tab,num_imp ,ns_imp ,ne_imp ,
3575 2 npby ,lpby ,itab ,nrbyac ,irbyac ,
3576 3 nss ,iss ,nint2 ,iint2 ,nss2 ,
3577 4 iss2 ,nddli ,nnzi ,iadi ,jdii ,
3578 5 iddli ,ndofi ,n_impn ,itok ,iddl ,
3579 6 nnmax ,nkmax ,n_impm ,ndof ,iaint2 ,
3580 7 irbe3 ,lrbe3 ,nss3 ,iss3 ,irbe2 ,
3581 8 lrbe2 ,nsb2 ,isb2 ,ind_imp )
3582 ALLOCATE(diag_i(nddli))
3583 ALLOCATE(lt_i(nnzi))
3584 CALL zero1(diag_i,nddli)
3585 CALL zero1(lt_i,nnzi)
3586 IF (nsrem>0)
3587 1 CALL imp_fr7i(ipari ,intbuf_tab ,num_imp ,ns_imp ,nsrem ,
3588 2 nbintc,intlist)
3589 !-------A is not updated here -------------------
3590 CALL imp_int_k(a ,v ,
3591 1 icodt ,icodr ,iskew ,ibfv ,npc ,
3592 2 tf ,vel ,nsensor ,sensor_tab,xframe ,
3593 3 rby ,x ,skews%SKEW ,lpby ,npby ,
3594 4 itab ,weight ,ms ,in ,nrbyac ,
3595 5 irbyac ,nss ,iss ,ipari ,intbuf_tab,
3596 6 nint2 ,iint2 ,iaint2 ,nss2 ,
3597 7 iss2 ,nddli ,nnzi ,iadi ,jdii ,
3598 8 diag_i ,lt_i ,iddli ,nddl0 ,iadk ,
3599 9 jdik ,ikc ,diag_k ,lt_k ,iddl ,
3600 a num_imp ,ns_imp ,ne_imp ,ind_imp ,ndofi ,
3601 b itok ,d_imp ,lb ,gap ,dirul ,
3602 c nt_rw ,ibid ,irbe3 ,lrbe3 ,frbe3 ,
3603 d nss3 ,iss3 ,irbe2 ,lrbe2 ,nsb2 ,
3604 e isb2 )
3605C
3606 DEALLOCATE(nss2,nss3,nsb2)
3607 DEALLOCATE(iss2,iss3,isb2)
3608 DEALLOCATE(nss)
3609 DEALLOCATE(iss)
3610 IF (nspmd==1.AND.imconv>=0.AND.(lprint/=0.OR.nprint/=0)) THEN
3611 WRITE(iout,1006)
3612 WRITE(iout,1007)nddli,nnzi,nnmax
3613 WRITE(iout,*)
3614 ENDIF
3615 IF (imon>0) CALL stoptime(timers,31)
3616 ENDIF
3617C----------------------------------
3618 IF (nfxvel/=0.AND.imconv==1) THEN
3619 CALL fv_imp1(nkud ,ikud ,bkud ,lb )
3620 ENDIF
3621C-------------LB,A,AR becomes Fext-Fint---------------------
3622 CALL upd_rhs(icodt ,icodr ,iskew ,ibfv ,xframe ,
3623 1 rby ,x ,skews%SKEW ,lpby ,npby ,
3624 2 nrbyac,irbyac,nint2 ,iint2 ,ipari ,
3625 3 intbuf_tab ,ndof ,iddl ,ikc ,
3626 4 nddl0 ,lb ,isetk ,inloc ,dirul ,
3627 5 a ,ar ,ac ,acr ,nt_rw ,
3628 6 irflag,w_ddl ,nddl ,r_imp(1),idyna ,
3629 7 v ,vr ,ms ,in ,irbe3 ,
3630 8 lrbe3 ,frbe3 ,weight ,irbe2 ,lrbe2 )
3631
3632 IF (nspmd>1) THEN
3633 IF (nbintc>0.) THEN
3634 iconta = nddli + nsrem
3635 CALL spmd_max_i(iconta)
3636 IF (iconta> 0) THEN
3637 CALL imp_fri(
3638 1 num_imp ,ns_imp ,ne_imp ,ipari ,intbuf_tab,
3639 2 npby ,lpby ,itab ,nrbyac ,
3640 3 irbyac ,nint2 ,iint2 ,iddl ,ikc ,
3641 4 ndof ,inloc ,nsrem ,nsl ,nbintc ,
3642 5 intlist ,x ,ibfv ,dirul ,skews%SKEW,
3643 6 xframe ,iskew ,icodt ,a ,d_imp ,
3644 7 lb ,ifdis ,nddl ,dr_imp ,iddli ,
3645 8 irbe3 ,lrbe3 ,frbe3 ,irbe2 ,lrbe2 )
3646 CALL spmd_min_s(gap)
3647 CALL spmd_max_i(ifdis)
3648 IF ((nsrem+nsl)>0.AND.ifdis>0)
3649 . CALL imp_frfv(
3650 1 num_imp ,ns_imp ,ne_imp ,ipari ,intbuf_tab,
3651 2 iddl ,ikc ,ndof ,nsrem ,
3652 3 nsl ,d_imp ,dd ,dr_imp ,ddr ,
3653 4 a ,ar ,ms ,v ,x ,
3654 5 lb ,nddl ,ibfv ,skews%SKEW,xframe ,
3655 6 irbe3 ,lrbe3 ,irbe2 ,lrbe2 ,r_imp(16) ,
3656 7 nddl0 ,w_ddl )
3657 ENDIF
3658 ENDIF
3659 ENDIF
3660 IF (gap<zero) THEN
3661 imconv = -2
3662 IF (ispmd==0) THEN
3663 WRITE(iout,1009)int(-gap)
3664 WRITE(istdo,1009)int(-gap)
3665 ENDIF
3666 ENDIF
3667C----------------------------------
3668C IMPLICIT [K] CHECK
3669C----------------------------------
3670 CALL imp_check0(itab ,nddl ,iddl ,diag_k ,diag_m ,
3671 . ndof ,ikc ,inloc ,nddl0 ,inega ,
3672 . nddli ,itok ,diag_i,imp_iw ,imp_ir )
3673 IF (inega>0) GOTO 100
3674 ntmp=0
3675 CALL produt_w(nddl,lb,lb,w_ddl,r2)
3676 IF (r2>zero.AND.r2<ep30) THEN
3677 ELSEIF(iqstat>0) THEN
3678 WRITE(iout,*)
3679 WRITE(iout,*)' ** WARNING :IMPLICIT LOADING DATA **'
3680 imp_iw = imp_iw + 1
3681 ELSE
3682 WRITE(iout,*)
3683 WRITE(iout,*)' ** ERROR :IMPLICIT LOADING DATA **'
3684 imp_ir = imp_ir + 1
3685 ENDIF
3686
3687C
3688C /---------------/
3689c CALL MY_BARRIER
3690C /---------------/
3691 CALL lin_solv(nddl ,iddl ,ndof ,ikc ,d_imp ,
3692 1 dr_imp,l_tol ,nnzk ,iadk ,jdik ,
3693 2 diag_k,lt_k ,nddli ,iadi ,jdii ,
3694 3 diag_i,lt_i ,itok ,iadm ,jdim ,
3695 4 diag_m,lt_m ,lb ,r_imp(6),inloc ,
3696 5 fr_elem,iad_elem,w_ddl,itask ,isetp ,
3697 6 istop ,a ,ar ,v ,
3698 7 ms ,x ,ipari ,intbuf_tab ,
3699 8 num_imp,ns_imp,ne_imp,nsrem ,nsl ,
3700 9 ntmp ,graphe, itab ,rbid ,ibid ,
3701 a ibid ,ntmp ,ibid ,ibid ,igrsurf ,
3702 b ibid ,rbid ,ibfv ,skews%SKEW ,
3703 c xframe,mumps_par,ibid,ibid ,rbid ,
3704 d irbe3 ,lrbe3 ,irbe2 ,lrbe2 )
3705 CALL imp_checm0(itab ,nddl ,iddl ,diag_m ,ndof ,ikc ,inloc ,nddl0 ,imp_iw ,imp_ir)
3706 IF (nint7>0) THEN
3707 DEALLOCATE(iadi)
3708 DEALLOCATE(itok)
3709 DEALLOCATE(jdii)
3710 DEALLOCATE(diag_i)
3711 DEALLOCATE(lt_i)
3712 ENDIF
3713
3714 100 CONTINUE
3715C /---------------/
3716 CALL my_barrier
3717C /---------------/
3718 IF (ispmd == 0 .AND. itask == 0) THEN
3719 WRITE(istdo,1011)imp_ir,imp_iw
3720 ENDIF
3721
3722 1001 FORMAT(' SYMBOLIC DIM : NDDL =',i8,1x,'NNZ =',i8,1x,'NB_MAX =',i8)
3723 1002 FORMAT(' FINAL DIM : NDDL =',i8,1x,'NNZ =',i8,1x,'NB_MAX =',i8)
3724 1006 FORMAT(5x,'--SUPPLEMENTARY STIFFNESS MATRIX',1x, 'DUE TO INTERFACE IS CREATED --')
3725 1007 FORMAT(5x,' WITH DIM. : ND =',i8,1x,'NZ =',i8,1x,'nb_max =',I8)
3726 1009 FORMAT(3X,'**timestep will be reduced to avoid de-activation ','in INTERFACE :**',I8)
3727 1011 FORMAT(/,2X,'** end IMPLICIT model checking **'/,
3728 . 5X,'termination with '/,I8,' errors '/,i8,' WARNINGS'/
3729 . 5x,'** DETAILS REPORTED IN LISTING FILE **'/)
3730 RETURN
3731 END
3732!||====================================================================
3733!|| imp_compab ../engine/source/implicit/imp_solv.f
3734!||--- called by ------------------------------------------------------
3735!|| imp_chkm ../engine/source/implicit/imp_solv.F
3736!||--- uses -----------------------------------------------------
3737!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
3738!|| sensor_mod ../common_source/modules/sensor_mod.F90
3739!||====================================================================
3740 SUBROUTINE imp_compab(
3741 1 ICODT ,ICODR ,ISKEW ,IBFV ,NPC ,
3742 2 TF ,VEL ,NSENSOR ,SENSOR_TAB,XFRAME ,
3743 3 RBY ,X ,SKEW ,LPBY ,NPBY ,
3744 4 ITAB ,NRBYAC ,IRBYAC ,NINT2 ,IINT2 ,
3745 5 IPARI ,INTBUF_TAB,NT_RW ,NDDL ,
3746 6 NDOF ,IKC ,INLOC ,IDDL ,NDDL0 ,
3747 7 IWAR ,IERR )
3748C-----------------------------------------------
3749C M o d u l e s
3750C-----------------------------------------------
3751 USE intbufdef_mod
3752 USE sensor_mod
3753C-----------------------------------------------
3754C I m p l i c i t T y p e s
3755C-----------------------------------------------
3756#include "implicit_f.inc"
3757C-----------------------------------------------
3758C C o m m o n B l o c k s
3759C-----------------------------------------------
3760#include "tabsiz_c.inc"
3761#include "com01_c.inc"
3762#include "com04_c.inc"
3763#include "com08_c.inc"
3764#include "param_c.inc"
3765#if defined(MUMPS5)
3766#include "dmumps_struc.h"
3767#endif
3768#include "sphcom.inc"
3769#include "units_c.inc"
3770C-----------------------------------------------
3771C D u m m y A r g u m e n t s
3772C-----------------------------------------------
3773 INTEGER ,INTENT(IN) :: NSENSOR
3774 INTEGER NPC(*),IBFV(NIFV,*),
3775 . icodt(*),icodr(*),iskew(*),nint2 ,iint2(*),nt_rw
3776 INTEGER LPBY(*),NPBY(NNPBY,*),ITAB(*),IPARI(NPARI,*),
3777 . nrbyac,irbyac(*),nddl,ndof(*),
3778 . iddl(*),ikc(*),inloc(*) ,nddl0,ierr,iwar
3779 my_real rby(nrby,*) ,x(3,*) ,skew(*)
3780 my_real tf(*),vel(lfxvelr,*),xframe(nxframe,*)
3781 TYPE(intbuf_struct_) INTBUF_TAB(*)
3782 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) :: SENSOR_TAB
3783#if defined(MUMPS5)
3784C-----------------------------------------------
3785C L o c a l V a r i a b l e s
3786C-----------------------------------------------
3787 INTEGER NSN,I,J,K,N,M,JI,NS,NN,IRW,ID
3788 INTEGER NKINE,IKIN(NUMNOD),IOF(NUMNOD)
3789 INTEGER ISENS,II,IDEB,IT,ICOMP,NTY,IR,IW
3790 my_real STARTT, STOPT, TS,SS
3791 CHARACTER*25 MSG_TYPE(2)
3792 CHARACTER*25 CSP
3793 DATA MSG_TYPE/ '** WARNING **', '!! ERROR !!'/
3794C--------implicit imcompability--
3795 ICOMP = 0
3796 it = 1
3797 WRITE(iout,*)
3798 WRITE(iout,*)' ** INCOMBABILITY CHECKING **'
3799 WRITE(iout,*)
3800 WRITE(istdo,*)
3801 WRITE(istdo,*)' * INCOMBABILITY CHECKING '
3802C-----------
3803 IF (nlaser>0) THEN
3804 icomp = icomp + nlaser
3805 iwar = iwar +1
3806 WRITE(iout,1100)msg_type(it),'impact laser'
3807 ENDIF
3808 DO N =1,NINTER
3809 NTY =IPARI(7,N)
3810.OR..OR..OR. IF (NTY==2NTY==7NTY==10NTY==11
3811.OR..OR. . NTY==5NTY==24) THEN
3812.AND. IF(NTY==7IPARI(33,N)/=0)THEN
3813 ICOMP = ICOMP + IPARI(33,N)
3814 IWAR = IWAR +1
3815 WRITE(IOUT,1100)MSG_TYPE(IT),'lagrange multiplier interface'
3816 ENDIF
3817 ELSEIF (NTY>0) THEN
3818 IWAR = IWAR +1
3819 ICOMP = ICOMP + 1
3820 WRITE(CSP,'(a,i2.2)')'INTERFACE type ',NTY
3821 WRITE(IOUT,1100)MSG_TYPE(IT),CSP
3822 ENDIF
3823 ENDDO
3824 IF (NRIVET>0) THEN
3825 ICOMP = ICOMP + NRIVET
3826 IWAR = IWAR +1
3827 WRITE(IOUT,1100)MSG_TYPE(IT),'rivet'
3828 ENDIF
3829 IF (NGJOINT>0) THEN
3830 ICOMP = ICOMP + NGJOINT
3831 IWAR = IWAR +1
3832 WRITE(IOUT,1100)MSG_TYPE(IT),'joint TYPE springs'
3833 ENDIF
3834 IF (NJOINT>0) THEN
3835 ICOMP = ICOMP + NJOINT
3836 IWAR = IWAR +1
3837 WRITE(IOUT,1100)MSG_TYPE(IT),'cylindric joint'
3838 ENDIF
3839 IF (NUMMPC>0) THEN
3840 ICOMP = ICOMP + NUMMPC
3841 IWAR = IWAR +1
3842 WRITE(IOUT,1100)MSG_TYPE(IT),'multi-point constraints'
3843 ENDIF
3844 IF (NLINK>0) THEN
3845 ICOMP = ICOMP + NLINK
3846 IWAR = IWAR +1
3847 WRITE(IOUT,1100)MSG_TYPE(IT),'rigid link'
3848 ENDIF
3849 IF (NUMELX>0) THEN
3850 ICOMP = ICOMP + NUMELX
3851 IWAR = IWAR +1
3852 WRITE(IOUT,1100)MSG_TYPE(IT),'multi-purpose elements'
3853 ENDIF
3854 IF (NUMELS16>0) THEN
3855 ICOMP = ICOMP + NUMELS16
3856 IWAR = IWAR +1
3857 WRITE(IOUT,1100)MSG_TYPE(IT),'solid 16n. elements'
3858 ENDIF
3859 IF (NUMELS20>0) THEN
3860 ICOMP = ICOMP + NUMELS20
3861 IWAR = IWAR +1
3862 WRITE(IOUT,1100)MSG_TYPE(IT),'solid 20n. elements'
3863 ENDIF
3864 IF (NUMELTG6>0) THEN
3865 ICOMP = ICOMP + NUMELTG6
3866 IWAR = IWAR +1
3867 WRITE(IOUT,1100)MSG_TYPE(IT),'shell s3n6 elements'
3868 ENDIF
3869 IF (NUMSPH>0) THEN
3870 ICOMP = ICOMP + NUMSPH
3871 IWAR = IWAR +1
3872 WRITE(IOUT,1100)MSG_TYPE(IT),'sph elements'
3873 ENDIF
3874C
3875 IF (ICOMP>0) WRITE(IOUT,1101) ICOMP
3876C--------IKIN: 1 MAIN node of rb, 2 s.n. of int2--,3 s.n. of rb,
3877C------------: 4 bcs, 5 imposed Dis. ,6 sn of rwall, 7 ns of joint,8 ns os rlink
3878 DO N =1,NUMNOD
3879 IKIN(N)=0
3880 IF (NDOF(N)>0) THEN
3881 IOF(N)=2
3882 ELSE
3883 IOF(N)=1
3884 ENDIF
3885 ENDDO
3886C----- MAIN of rigid body first------
3887 IR =0
3888 DO I=1,NRBYAC
3889 N=IRBYAC(I)
3890 M=NPBY(1,N)
3891 IF (IKIN(M)==0) THEN
3892 IKIN(M)=1
3893 ELSE
3894 WRITE(IOUT,1001)MSG_TYPE(2),ITAB(M)
3895 IR = IR + 1
3896 ENDIF
3897 ENDDO
3898 IERR = IERR +IR
3899C------interface 2--------------
3900 IW =0
3901 IR =0
3902 DO I=1,NINT2
3903 N=IINT2(I)
3904 NSN = IPARI(5,N)
3905 DO J=1,NSN
3906 NS=INTBUF_TAB(N)%NSV(J)
3907 IF (IKIN(NS)==0) THEN
3908 IKIN(NS)=2
3909 ELSEIF(IKIN(NS)==1) THEN
3910 WRITE(IOUT,1002)MSG_TYPE(1),ITAB(NS)
3911 IW =IW + 1
3912 ELSEIF(IKIN(NS)==2) THEN
3913 WRITE(IOUT,1003)MSG_TYPE(2),ITAB(NS)
3914 IR =IR + 1
3915 ENDIF
3916 ENDDO
3917 ENDDO
3918C----- rigid body ------
3919 DO I=1,NRBYAC
3920 N=IRBYAC(I)
3921 K=IRBYAC(I+NRBYKIN)
3922 M=NPBY(1,N)
3923 NSN =NPBY(2,N)
3924 DO J=1,NSN
3925 NS=LPBY(K+J)
3926 IF (IKIN(NS)==0) THEN
3927 IKIN(NS)=3
3928 ELSEIF(IKIN(NS)==1) THEN
3929 WRITE(IOUT,1004)MSG_TYPE(1),ITAB(NS)
3930 IW =IW + 1
3931 ELSEIF(IKIN(NS)==2) THEN
3932 IT = MIN(IOF(NS),2)
3933 WRITE(IOUT,1005)MSG_TYPE(IT),ITAB(NS)
3934 IF (IT==1) THEN
3935 IW =IW + 1
3936 ELSEIF (IT==2) THEN
3937 IR =IR + 1
3938 ENDIF
3939 ELSEIF(IKIN(NS)==3) THEN
3940 IT = MIN(IOF(NS),2)
3941 WRITE(IOUT,1006)MSG_TYPE(IT),ITAB(NS)
3942 IF (IT==1) THEN
3943 IW =IW + 1
3944 ELSEIF (IT==2) THEN
3945 IR =IR + 1
3946 ENDIF
3947 ENDIF
3948 ENDDO
3949 ENDDO
3950C--------bcs---------
3951 IF (IRODDL==0) THEN
3952 DO N = 1,NUMNOD
3953 IF (ICODT(N) > 0) THEN
3954 IF (IKIN(N)==0) THEN
3955 IKIN(N)=4
3956 ELSEIF(IKIN(N)==2) THEN
3957 IT = MIN(IOF(N),2)
3958 WRITE(IOUT,1007)MSG_TYPE(IT),ITAB(N)
3959 IF (IT==1) THEN
3960 IW =IW + 1
3961 ELSEIF (IT==2) THEN
3962 IR =IR + 1
3963 ENDIF
3964 ELSEIF(IKIN(N)==3) THEN
3965 IT = MIN(IOF(N),2)
3966 WRITE(IOUT,1008)MSG_TYPE(IT),ITAB(N)
3967 IF (IT==1) THEN
3968 IW =IW + 1
3969 ELSEIF (IT==2) THEN
3970 IR =IR + 1
3971 ENDIF
3972 ENDIF
3973 ENDIF
3974 ENDDO
3975 ELSE
3976 DO N = 1,NUMNOD
3977 IF ((ICODT(N)+ICODR(N))>0 ) THEN
3978 IF (IKIN(N)==0) THEN
3979 IKIN(N)=4
3980 ELSEIF(IKIN(N)==2) THEN
3981 IT = MIN(IOF(N),2)
3982 WRITE(IOUT,1007)MSG_TYPE(IT),ITAB(N)
3983 IF (IT==1) THEN
3984 IW =IW + 1
3985 ELSEIF (IT==2) THEN
3986 IR =IR + 1
3987 ENDIF
3988 ELSEIF(IKIN(N)==3) THEN
3989 IT = MIN(IOF(N),2)
3990 WRITE(IOUT,1008)MSG_TYPE(IT),ITAB(N)
3991 IF (IT==1) THEN
3992 IW =IW + 1
3993 ELSEIF (IT==2) THEN
3994 IR =IR + 1
3995 ENDIF
3996 ENDIF
3997 ENDIF
3998 ENDDO
3999 ENDIF
4000C--------fxv---------
4001 DO NN=1,NFXVEL,NVSIZ
4002 IF (IBFV(8,NN)==1) GOTO 100
4003 IF (NSENSOR>0) THEN
4004 DO 10 II = 1, MIN(NFXVEL-IDEB,NVSIZ)
4005 N = II+IDEB
4006 STARTT = VEL(2,N)
4007 STOPT = VEL(3,N)
4008 IF(TT<STARTT)GOTO 10
4009 IF(TT>STOPT) GOTO 10
4010 I=IABS(IBFV(1,N))
4011 ISENS=0
4012 DO K=1,NSENSOR
4013 IF(IBFV(4,N)==SENSOR_TAB(K)%SENS_ID) ISENS=K
4014 ENDDO
4015 IF(ISENS==0)THEN
4016 TS=TT
4017 ELSE
4018 TS = TT-SENSOR_TAB(ISENS)%TSTART
4019 IF(TS<ZERO)GOTO 10
4020 ENDIF
4021 IF (IKIN(I)==0) THEN
4022 IKIN(I)=5
4023 ELSEIF(IKIN(I)==2) THEN
4024 WRITE(IOUT,1009)MSG_TYPE(2),ITAB(I)
4025 IR =IR + 1
4026 ELSEIF(IKIN(I)==3) THEN
4027 WRITE(IOUT,1010)MSG_TYPE(2),ITAB(I)
4028 IR =IR + 1
4029 ELSEIF(IKIN(I)==4) THEN
4030 WRITE(IOUT,1011)MSG_TYPE(2),ITAB(I)
4031 IR =IR + 1
4032 ENDIF
4033 10 CONTINUE
4034 ELSE
4035 DO 20 II = 1, MIN(NFXVEL-IDEB,NVSIZ)
4036 N = II+IDEB
4037 STARTT = VEL(2,N)
4038 STOPT = VEL(3,N)
4039 IF(TT<STARTT)GOTO 20
4040 IF(TT>STOPT) GOTO 20
4041 I=IABS(IBFV(1,N))
4042 IF (IKIN(I)==0) THEN
4043 IKIN(I)=5
4044 ELSEIF(IKIN(I)==2) THEN
4045 WRITE(IOUT,1009)MSG_TYPE(2),ITAB(I)
4046 IR =IR + 1
4047 ELSEIF(IKIN(I)==3) THEN
4048 WRITE(IOUT,1010)MSG_TYPE(2),ITAB(I)
4049 IR =IR + 1
4050 ELSEIF(IKIN(I)==4) THEN
4051 WRITE(IOUT,1011)MSG_TYPE(2),ITAB(I)
4052 IR =IR + 1
4053 ENDIF
4054 20 CONTINUE
4055 ENDIF
4056C
4057 IDEB = IDEB + MIN(NFXVEL-IDEB,NVSIZ)
4058 100 CONTINUE
4059 ENDDO
4060C--------rwall---------
4061 IF (NT_RW>0) THEN
4062 DO I = 1,NUMNOD
4063 K = MIN(3,NDOF(I))
4064 IRW = 0
4065 DO J =1,K
4066 ID = IDDL(I) + J
4067.OR. IF (IKC(ID)==4IKC(ID)==11) IRW = 1
4068 ENDDO
4069 IF (IRW>0) THEN
4070 IF (IKIN(I)==0) THEN
4071 IKIN(I)=6
4072 ELSEIF(IKIN(I)==2) THEN
4073 WRITE(IOUT,1012)MSG_TYPE(2),ITAB(I)
4074 IR =IR + 1
4075 ELSEIF(IKIN(I)==3) THEN
4076 WRITE(IOUT,1013)MSG_TYPE(2),ITAB(I)
4077 IR =IR + 1
4078 ELSEIF(IKIN(I)==4) THEN
4079 WRITE(IOUT,1014)MSG_TYPE(2),ITAB(I)
4080 IR =IR + 1
4081 ELSEIF(IKIN(I)==5) THEN
4082 WRITE(IOUT,1015)MSG_TYPE(1),ITAB(I)
4083 IW =IW + 1
4084 ENDIF
4085 ENDIF
4086 ENDDO
4087 ENDIF
4088 IERR = IERR +IR
4089 IWAR = IWAR +IW
4090 RETURN
4091 1001 FORMAT(A,' node used for diff. rbody main=',I8)
4092 1002 FORMAT(A,' incompability node between ',/
4093 . 'rbody main and interf. type2 secondary =',I8)
4094 1003 FORMAT(A,' incompability node between ',/
4095 . 'interf. type2 secondary and interf. type2 secondary=',I8)
4096 1004 FORMAT(A,' incompability node between ',/
4097 . ' rbody main and rbody secondary=',I8)
4098 1005 FORMAT(A,' incompability node between ',/
4099 . ' interf. type2 secondary and rbody secondary=',I8)
4100 1006 FORMAT(A,' incompability node between ',/
4101 . ' rbody secondary and rbody secondary=',I8)
4102 1007 FORMAT(A,' incompability node between ',/
4103 . ' boundary conditions and interf. type2 secondary=',I8)
4104 1008 FORMAT(A,' incompability node between ',/
4105 . ' boundary conditions and rbody secondary=',I8)
4106 1009 FORMAT(A,' incompability node between ',/
4107 . ' imposed disp. and interf. type2 secondary=',I8)
4108 1010 FORMAT(A,' incompability node between ',/
4109 . ' imposed disp. and rbody secondary=',I8)
4110 1011 FORMAT(A,' incompability node between ',/
4111 . ' imposed disp. and boundary conditions=',I8)
4112 1012 FORMAT(A,' incompability node between ',/
4113 . ' rwall contact and interf. type2 secondary=',I8)
4114 1013 FORMAT(A,' incompability node between ',/
4115 . ' rwall contact and rbody secondary=',I8)
4116 1014 FORMAT(A,' incompability node between ',/
4117 . ' rwall contact and boundary conditions=',I8)
4118 1015 FORMAT(A,' incompability node between ',/
4119 . ' rwall contact and imposed disp.=',I8)
4120 1100 FORMAT(A,' IMPLICIT is incompable with :',A/)
4121 1101 FORMAT(/'**stiffness will be ignored with',1X,I8,
4122 . ' incompable options**'/)
4123#endif
4124 END
4125!||====================================================================
4126!|| imp_compabp ../engine/source/implicit/imp_solv.F
4127!||--- called by ------------------------------------------------------
4128!|| imp_chkm ../engine/source/implicit/imp_solv.F
4129!||--- calls -----------------------------------------------------
4130!|| spmd_max_i ../engine/source/mpi/implicit/imp_spmd.F
4131!|| spmd_send_vi ../engine/source/mpi/implicit/imp_spmd.F
4132!|| spmd_sum_s ../engine/source/mpi/implicit/imp_spmd.F
4133!||--- uses -----------------------------------------------------
4134!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
4135!|| sensor_mod ../common_source/modules/sensor_mod.F90
4136!||====================================================================
4137 SUBROUTINE IMP_COMPABP(
4138 1 ICODT ,ICODR ,ISKEW ,IBFV ,NPC ,
4139 2 TF ,VEL ,NSENSOR ,SENSOR_TAB,XFRAME ,
4140 3 RBY ,X ,SKEW ,LPBY ,NPBY ,
4141 4 ITAB ,NRBYAC ,IRBYAC ,NINT2 ,IINT2 ,
4142 5 IPARI ,INTBUF_TAB,NT_RW ,NDDL ,
4143 6 NDOF ,IKC ,INLOC ,IDDL ,NDDL0 ,
4144 7 IWAR ,IERR )
4145C-----------------------------------------------
4146C M o d u l e s
4147C-----------------------------------------------
4148 USE INTBUFDEF_MOD
4149 USE SENSOR_MOD
4150C-----------------------------------------------
4151C I m p l i c i t T y p e s
4152C-----------------------------------------------
4153#include "implicit_f.inc"
4154C-----------------------------------------------
4155C C o m m o n B l o c k s
4156C-----------------------------------------------
4157#include "com01_c.inc"
4158#include "com04_c.inc"
4159#include "com08_c.inc"
4160#include "param_c.inc"
4161#include "task_c.inc"
4162#include "sphcom.inc"
4163#include "units_c.inc"
4164C-----------------------------------------------
4165C D u m m y A r g u m e n t s
4166C-----------------------------------------------
4167 INTEGER ,INTENT(IN) :: NSENSOR
4168 INTEGER NPC(*),IBFV(NIFV,*),
4169 . ICODT(*),ICODR(*),ISKEW(*),NINT2 ,IINT2(*),NT_RW
4170 INTEGER LPBY(*),NPBY(NNPBY,*),ITAB(*),IPARI(NPARI,*),
4171 . NRBYAC,IRBYAC(*),NDDL,NDOF(*),
4172 . IDDL(*),IKC(*),INLOC(*) ,NDDL0,IERR,IWAR
4173 my_real RBY(NRBY,*) ,X(3,*) ,SKEW(*)
4174 my_real TF(*),VEL(LFXVELR,*),XFRAME(NXFRAME,*)
4175 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
4176 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) :: SENSOR_TAB
4177#if defined(MUMPS5)
4178C-----------------------------------------------
4179C L o c a l V a r i a b l e s
4180C-----------------------------------------------
4181 INTEGER NSN,I,J,K,N,M,JI,K10,K11,K12,NS,NN,IRW,ID,IV
4182 INTEGER NKINE,IKIN(NUMNOD),IOF(NUMNOD),VI(3,NUMNOD)
4183 INTEGER ISENS,II,IDEB,IT,ICOMP,NTY,IR,IW,NVMAX,NSIZ
4184 my_real STARTT, STOPT, TS,SS
4185 CHARACTER*25 MSG_TYPE(2)
4186 DATA MSG_TYPE / '** warning **', '!! ERROR !!'/
4187C--------implicit imcompability--
4188 icomp = 0
4189 it = 1
4190 IF (ispmd==0) THEN
4191 WRITE(iout,*)
4192 WRITE(iout,*)' ** INCOMBABILITY CHECKING **'
4193 WRITE(iout,*)
4194 WRITE(istdo,*)
4195 WRITE(istdo,*)' * INCOMBABILITY CHECKING '
4196 ENDIF
4197C
4198 nn = nlaser
4199 CALL spmd_max_i(nn)
4200 IF (nn>0.AND.ispmd==0) THEN
4201 icomp = icomp + nn
4202 iwar = iwar +1
4203 WRITE(iout,1100)msg_type(it),'IMPACT LASER'
4204 ENDIF
4205 iv = 0
4206 DO n =1,ninter
4207 nty =ipari(7,n)
4208 IF (nty==2.OR.nty==7.OR.nty==10.OR.nty==11
4209 . .OR.nty==5.OR.nty==24) THEN
4210 IF(nty==7.AND.ipari(33,n)/=0)THEN
4211 icomp = icomp + ipari(33,n)
4212 iwar = iwar +1
4213 WRITE(iout,1100)msg_type(it),'LAGRANGE MULTIPLIER INTERFACE'
4214 ENDIF
4215 ELSEIF (nty>0) THEN
4216 iwar = iwar +1
4217 icomp = icomp + 1
4218C---------------- espere que ca ne arrive pas le contraire -----
4219 IF (iv<=numnod) THEN
4220 iv = iv + 1
4221 vi(1,iv) = nty
4222 ENDIF
4223 ENDIF
4224 ENDDO
4225 nvmax = iv
4226 CALL spmd_max_i(nvmax)
4227 IF (nvmax>0) THEN
4228 CALL spmd_send_vi(
4229 1 iv ,1 ,vi ,nvmax ,iout )
4230 ENDIF
4231 nn = nrivet
4232 CALL spmd_max_i(nn)
4233 IF (nn>0.AND.ispmd==0) THEN
4234 icomp = icomp + nn
4235 iwar = iwar +1
4236 WRITE(iout,1100)msg_type(it),'RIVET'
4237 ENDIF
4238 nn = ngjoint
4239 CALL spmd_max_i(nn)
4240 IF (nn>0.AND.ispmd==0) THEN
4241 icomp = icomp + nn
4242 iwar = iwar +1
4243 WRITE(iout,1100)msg_type(it),'JOINT TYPE SPRINGS'
4244 ENDIF
4245 nn = njoint
4246 CALL spmd_max_i(nn)
4247 IF (nn>0.AND.ispmd==0) THEN
4248 icomp = icomp + nn
4249 iwar = iwar +1
4250 WRITE(iout,1100)msg_type(it),'CYLINDRIC JOINT'
4251 ENDIF
4252 nn = nummpc
4253 CALL spmd_max_i(nn)
4254 IF (nn>0.AND.ispmd==0) THEN
4255 icomp = icomp + nn
4256 iwar = iwar +1
4257 WRITE(iout,1100)msg_type(it),'MULTI-POINT CONSTRAINTS'
4258 ENDIF
4259 nn = nlink
4260 CALL spmd_max_i(nn)
4261 IF (nn>0.AND.ispmd==0) THEN
4262 icomp = icomp + nn
4263 iwar = iwar +1
4264 WRITE(iout,1100)msg_type(it),'RIGID LINK'
4265 ENDIF
4266 nn = numelx
4267 CALL spmd_max_i(nn)
4268 IF (nn>0.AND.ispmd==0) THEN
4269 icomp = icomp + nn
4270 iwar = iwar +1
4271 WRITE(iout,1100)msg_type(it),'MULTI-PURPOSE ELEMENTS'
4272 ENDIF
4273 nn = numels16
4274 CALL spmd_max_i(nn)
4275 IF (nn>0.AND.ispmd==0) THEN
4276 icomp = icomp + nn
4277 iwar = iwar +1
4278 WRITE(iout,1100)msg_type(it),'SOLID 16n. ELEMENTS'
4279 ENDIF
4280 nn = numels20
4281 CALL spmd_max_i(nn)
4282 IF (nn>0.AND.ispmd==0) THEN
4283 icomp = icomp + nn
4284 iwar = iwar +1
4285 WRITE(iout,1100)msg_type(it),'SOLID 20n. ELEMENTS'
4286 ENDIF
4287 nn = numeltg6
4288 CALL spmd_max_i(nn)
4289 IF (nn>0.AND.ispmd==0) THEN
4290 icomp = icomp + nn
4291 iwar = iwar +1
4292 WRITE(iout,1100)msg_type(it),'SHELL S3N6 ELEMENTS'
4293 ENDIF
4294 nn = numsph
4295 CALL spmd_max_i(nn)
4296 IF (nn>0.AND.ispmd==0) THEN
4297 icomp = icomp + nn
4298 iwar = iwar +1
4299 WRITE(iout,1100)msg_type(it),'SPH ELEMENTS'
4300 ENDIF
4301C-----------
4302 IF (icomp>0.AND.ispmd==0) THEN
4303 WRITE(iout,1101) icomp
4304 ENDIF
4305C--------IKIN: 1 MAIN node of rb, 2 s.n. of int2--,3 s.n. of rb,
4306C------------: 4 bcs, 5 imposed Dis. ,6 sn of rwall, 7 ns of joint,8 ns os rlink
4307 nsiz = 3
4308 DO n =1,numnod
4309 ikin(n)=0
4310 IF (ndof(n)>0) THEN
4311 iof(n)=2
4312 ELSE
4313 iof(n)=1
4314 ENDIF
4315 ENDDO
4316C----- MAIN of rigid body first------
4317 ir =0
4318 DO i=1,nrbyac
4319 n=irbyac(i)
4320 m=npby(1,n)
4321 IF (ikin(m)==0) THEN
4322 ikin(m)=1
4323 ELSE
4324c WRITE(IOUT,1001)MSG_TYPE(2),ITAB(M)
4325 ir = ir + 1
4326 vi(1,ir) = 1
4327 vi(2,ir) = 2
4328 vi(3,ir) = itab(m)
4329 ENDIF
4330 ENDDO
4331 ss = ir
4332 CALL spmd_sum_s(ss)
4333 nvmax = ir
4334 CALL spmd_max_i(nvmax)
4335 ierr = ierr +int(ss)
4336 IF (nvmax>0) THEN
4337 CALL spmd_send_vi(
4338 1 ir ,nsiz ,vi ,nvmax ,iout )
4339 ENDIF
4340C------interface 2--------------
4341 iw =0
4342 ir =0
4343 iv =0
4344 DO i=1,nint2
4345 n=iint2(i)
4346 nsn = ipari(5,n)
4347 ji=ipari(1,n)
4348 k10=ji-1
4349 k11=k10+4*ipari(3,n)
4350C------IRECT(4,NSN)-----
4351 k12=k11+4*ipari(4,n)
4352C------NSV(NSN)--node number---
4353 DO j=1,nsn
4354 ns=intbuf_tab(n)%NSV(j)
4355 IF (ikin(ns)==0) THEN
4356 ikin(ns)=2
4357 ELSEIF(ikin(ns)==1) THEN
4358c WRITE(IOUT,1002)MSG_TYPE(1),ITAB(NS)
4359 iw =iw + 1
4360 iv =iv + 1
4361 vi(1,iv) = 2
4362 vi(2,iv) = 1
4363 vi(3,iv) = itab(ns)
4364 ELSEIF(ikin(ns)==2) THEN
4365c WRITE(IOUT,1003)MSG_TYPE(2),ITAB(NS)
4366 ir =ir + 1
4367 iv =iv + 1
4368 vi(1,iv) = 3
4369 vi(2,iv) = 2
4370 vi(3,iv) = itab(ns)
4371 ENDIF
4372 ENDDO
4373 ENDDO
4374 nvmax = iv
4375 CALL spmd_max_i(nvmax)
4376 IF (nvmax>0) THEN
4377 CALL spmd_send_vi(
4378 1 iv ,nsiz ,vi ,nvmax ,iout )
4379 ENDIF
4380C----- rigid body ------
4381 iv =0
4382 DO i=1,nrbyac
4383 n=irbyac(i)
4384 k=irbyac(i+nrbykin)
4385 m=npby(1,n)
4386 nsn =npby(2,n)
4387 DO j=1,nsn
4388 ns=lpby(k+j)
4389 IF (ikin(ns)==0) THEN
4390 ikin(ns)=3
4391 ELSEIF(ikin(ns)==1) THEN
4392c WRITE(IOUT,1004)MSG_TYPE(1),ITAB(NS)
4393 iw =iw + 1
4394 iv =iv + 1
4395 vi(1,iv) = 4
4396 vi(2,iv) = 1
4397 vi(3,iv) = itab(ns)
4398 ELSEIF(ikin(ns)==2) THEN
4399 it = min(iof(ns),2)
4400c WRITE(IOUT,1005)MSG_TYPE(IT),ITAB(NS)
4401 iv =iv + 1
4402 vi(1,iv) = 5
4403 vi(2,iv) = it
4404 vi(3,iv) = itab(ns)
4405 IF (it==1) THEN
4406 iw =iw + 1
4407 ELSEIF (it==2) THEN
4408 ir =ir + 1
4409 ENDIF
4410 ELSEIF(ikin(ns)==3) THEN
4411 it = min(iof(ns),2)
4412c WRITE(IOUT,1006)MSG_TYPE(IT),ITAB(NS)
4413 iv =iv + 1
4414 vi(1,iv) = 6
4415 vi(2,iv) = it
4416 vi(3,iv) = itab(ns)
4417 IF (it==1) THEN
4418 iw =iw + 1
4419 ELSEIF (it==2) THEN
4420 ir =ir + 1
4421 ENDIF
4422 ENDIF
4423 ENDDO
4424 ENDDO
4425 nvmax = iv
4426 CALL spmd_max_i(nvmax)
4427 IF (nvmax>0) THEN
4428 CALL spmd_send_vi(
4429 1 iv ,nsiz ,vi ,nvmax ,iout )
4430 ENDIF
4431C--------bcs---------
4432 iv =0
4433 IF (iroddl==0) THEN
4434 DO n = 1,numnod
4435 IF (icodt(n) > 0) THEN
4436 IF (ikin(n)==0) THEN
4437 ikin(n)=4
4438 ELSEIF(ikin(n)==2) THEN
4439 it = min(iof(n),2)
4440c WRITE(IOUT,1007)MSG_TYPE(IT),ITAB(N)
4441 iv =iv + 1
4442 vi(1,iv) = 7
4443 vi(2,iv) = it
4444 vi(3,iv) = itab(n)
4445 IF (it==1) THEN
4446 iw =iw + 1
4447 ELSEIF (it==2) THEN
4448 ir =ir + 1
4449 ENDIF
4450 ELSEIF(ikin(n)==3) THEN
4451 it = 1
4452C IT = MIN(IOF(N),2)
4453c WRITE(IOUT,1008)MSG_TYPE(IT),ITAB(N)
4454 iv =iv + 1
4455 vi(1,iv) = 8
4456 vi(2,iv) = it
4457 vi(3,iv) = itab(n)
4458 IF (it==1) THEN
4459 iw =iw + 1
4460 ELSEIF (it==2) THEN
4461 ir =ir + 1
4462 ENDIF
4463 ENDIF
4464 ENDIF
4465 ENDDO
4466 ELSE
4467 DO n = 1,numnod
4468 IF ((icodt(n)+icodr(n))>0 ) THEN
4469 IF (ikin(n)==0) THEN
4470 ikin(n)=4
4471 ELSEIF(ikin(n)==2) THEN
4472 it = min(iof(n),2)
4473c WRITE(IOUT,1007)MSG_TYPE(IT),ITAB(N)
4474 iv =iv + 1
4475 vi(1,iv) = 7
4476 vi(2,iv) = it
4477 vi(3,iv) = itab(n)
4478 IF (it==1) THEN
4479 iw =iw + 1
4480 ELSEIF (it==2) THEN
4481 ir =ir + 1
4482 ENDIF
4483 ELSEIF(ikin(n)==3) THEN
4484 it = 1
4485C IT = MIN(IOF(N),2)
4486c WRITE(IOUT,1008)MSG_TYPE(IT),ITAB(N)
4487 iv =iv + 1
4488 vi(1,iv) = 8
4489 vi(2,iv) = it
4490 vi(3,iv) = itab(n)
4491 IF (it==1) THEN
4492 iw =iw + 1
4493 ELSEIF (it==2) THEN
4494 ir =ir + 1
4495 ENDIF
4496 ENDIF
4497 ENDIF
4498 ENDDO
4499 ENDIF
4500 nvmax = iv
4501 CALL spmd_max_i(nvmax)
4502 IF (nvmax>0) THEN
4503 CALL spmd_send_vi(
4504 1 iv ,nsiz ,vi ,nvmax ,iout )
4505 ENDIF
4506C--------fxv---------
4507 iv =0
4508 DO nn=1,nfxvel,nvsiz
4509 IF (ibfv(8,nn)==1) GOTO 100
4510 IF (nsensor>0) THEN
4511 DO 10 ii = 1, min(nfxvel-ideb,nvsiz)
4512 n = ii+ideb
4513 startt = vel(2,n)
4514 stopt = vel(3,n)
4515 IF(tt<startt)GOTO 10
4516 IF(tt>stopt) GOTO 10
4517 i=iabs(ibfv(1,n))
4518 isens=0
4519 DO k=1,nsensor
4520 IF(ibfv(4,n)==sensor_tab(k)%SENS_ID) isens=k
4521 ENDDO
4522 IF(isens==0)THEN
4523 ts=tt
4524 ELSE
4525 ts = tt-sensor_tab(isens)%TSTART
4526 IF(ts<zero)GOTO 10
4527 ENDIF
4528 IF (ikin(i)==0) THEN
4529 ikin(i)=5
4530 ELSEIF(ikin(i)==2) THEN
4531c WRITE(IOUT,1009)MSG_TYPE(2),ITAB(I)
4532 iv =iv + 1
4533 vi(1,iv) = 9
4534 vi(2,iv) = 2
4535 vi(3,iv) = itab(i)
4536 ir =ir + 1
4537 ELSEIF(ikin(i)==3) THEN
4538c WRITE(IOUT,1010)MSG_TYPE(2),ITAB(I)
4539 iv =iv + 1
4540 vi(1,iv) = 10
4541 vi(2,iv) = 1
4542 vi(3,iv) = itab(i)
4543 iw =iw + 1
4544 ELSEIF(ikin(i)==4) THEN
4545c WRITE(IOUT,1011)MSG_TYPE(2),ITAB(I)
4546 iv =iv + 1
4547 vi(1,iv) = 11
4548 vi(2,iv) = 2
4549 vi(3,iv) = itab(i)
4550 ir =ir + 1
4551 ENDIF
4552 10 CONTINUE
4553 ELSE
4554 DO 20 ii = 1, min(nfxvel-ideb,nvsiz)
4555 n = ii+ideb
4556 startt = vel(2,n)
4557 stopt = vel(3,n)
4558 IF(tt<startt)GOTO 20
4559 IF(tt>stopt) GOTO 20
4560 i=iabs(ibfv(1,n))
4561 IF (ikin(i)==0) THEN
4562 ikin(i)=5
4563 ELSEIF(ikin(i)==2) THEN
4564c WRITE(IOUT,1009)MSG_TYPE(2),ITAB(I)
4565 iv =iv + 1
4566 vi(1,iv) = 9
4567 vi(2,iv) = 2
4568 vi(3,iv) = itab(i)
4569 ir =ir + 1
4570 ELSEIF(ikin(i)==3) THEN
4571c WRITE(IOUT,1010)MSG_TYPE(2),ITAB(I)
4572 iv =iv + 1
4573 vi(1,iv) = 10
4574 vi(2,iv) = 1
4575 vi(3,iv) = itab(i)
4576 iw =iw + 1
4577 ELSEIF(ikin(i)==4) THEN
4578c WRITE(IOUT,1011)MSG_TYPE(2),ITAB(I)
4579 iv =iv + 1
4580 vi(1,iv) = 11
4581 vi(2,iv) = 2
4582 vi(3,iv) = itab(i)
4583 ir =ir + 1
4584 ENDIF
4585 20 CONTINUE
4586 ENDIF
4587C
4588 ideb = ideb + min(nfxvel-ideb,nvsiz)
4589 100 CONTINUE
4590 ENDDO
4591 nvmax = iv
4592 CALL spmd_max_i(nvmax)
4593 IF (nvmax>0) THEN
4594 CALL spmd_send_vi(
4595 1 iv ,nsiz ,vi ,nvmax ,iout )
4596 ENDIF
4597C--------rwall---------
4598 iv =0
4599 IF (nt_rw>0) THEN
4600 DO i = 1,numnod
4601 k = min(3,ndof(i))
4602 irw = 0
4603 DO j =1,k
4604 id = iddl(i) + j
4605 IF (ikc(id)==4.OR.ikc(id)==11) irw = 1
4606 ENDDO
4607 IF (irw>0) THEN
4608 IF (ikin(i)==0) THEN
4609 ikin(i)=6
4610 ELSEIF(ikin(i)==2) THEN
4611c WRITE(IOUT,1012)MSG_TYPE(2),ITAB(I)
4612 iv =iv + 1
4613 vi(1,iv) = 12
4614 vi(2,iv) = 2
4615 vi(3,iv) = itab(i)
4616 ir =ir + 1
4617 ELSEIF(ikin(i)==3) THEN
4618c WRITE(IOUT,1013)MSG_TYPE(2),ITAB(I)
4619 iv =iv + 1
4620 vi(1,iv) = 13
4621 vi(2,iv) = 1
4622 vi(3,iv) = itab(i)
4623 iw =iw + 1
4624 ELSEIF(ikin(i)==4) THEN
4625c WRITE(IOUT,1014)MSG_TYPE(2),ITAB(I)
4626 iv =iv + 1
4627 vi(1,iv) = 14
4628 vi(2,iv) = 2
4629 vi(3,iv) = itab(i)
4630 ir =ir + 1
4631 ELSEIF(ikin(i)==5) THEN
4632c WRITE(IOUT,1015)MSG_TYPE(1),ITAB(I)
4633 iv =iv + 1
4634 vi(1,iv) = 15
4635 vi(2,iv) = 1
4636 vi(3,iv) = itab(i)
4637 iw =iw + 1
4638 ENDIF
4639 ENDIF
4640 ENDDO
4641 ENDIF
4642C
4643 nvmax = iv
4644 CALL spmd_max_i(nvmax)
4645 IF (nvmax>0) THEN
4646 CALL spmd_send_vi(
4647 1 iv ,nsiz ,vi ,nvmax ,iout )
4648 ENDIF
4649 ss = ir
4650 CALL spmd_sum_s(ss)
4651 ir = int(ss)
4652 ss = iw
4653 CALL spmd_sum_s(ss)
4654 iw = int(ss)
4655 ierr = ierr +ir
4656 iwar = iwar +iw
4657 RETURN
4658 1100 FORMAT(a,' IMPLICIT IS INCOMPABLE WITH :',a/)
4659 1101 FORMAT(/'**STIFFNESS WILL BE IGNORED WITH',1x,i8,
4660 . ' INCOMPABLE OPTIONS**'/)
4661C endif MUMPS defined
4662#endif
4663 END
4664
4665!||====================================================================
4666!|| imp_fout ../engine/source/implicit/imp_solv.F
4667!||--- called by ------------------------------------------------------
4668!|| resol ../engine/source/engine/resol.F
4669!||--- uses -----------------------------------------------------
4670!|| h3d_mod ../engine/share/modules/h3d_mod.F
4671!|| impbufdef_mod ../engine/share/modules/impbufdef_mod.F
4672!||====================================================================
4673 SUBROUTINE imp_fout(
4674 1 FANI ,A ,AR ,NFIA ,NFEA ,
4675 2 NODFT ,NODLT ,H3D_DATA ,IMPBUF_TAB)
4676C-----------------------------------------------
4677C M o d u l e s
4678C-----------------------------------------------
4679 USE h3d_mod
4680 USE impbufdef_mod
4681C-----------------------------------------------
4682C I m p l i c i t T y p e s
4683C-----------------------------------------------
4684#include "implicit_f.inc"
4685C-----------------------------------------------
4686C C o m m o n B l o c k s
4687C-----------------------------------------------
4688#include "scr14_c.inc"
4689#include "scr16_c.inc"
4690C-----------------------------------------------
4691C D u m m y A r g u m e n t s
4692C-----------------------------------------------
4693 INTEGER NFIA,NFEA,NODFT,NODLT
4694C REAL
4695 my_real
4696 . a(3,*) ,ar(3,*) ,fani(3,*)
4697 TYPE(h3d_database) :: H3D_DATA
4698 TYPE (IMPBUF_STRUCT_) ,TARGET :: IMPBUF_TAB
4699C-----------------------------------------------
4700C L o c a l V a r i a b l e s
4701C-----------------------------------------------
4702 INTEGER N,I,J,K,ND
4703 INTEGER, DIMENSION(:) ,POINTER :: IDDL,NDOF,IKC
4704C-------------mis zero Fint des noeuds dependants------------
4705 iddl => impbuf_tab%IDDL
4706 ndof => impbuf_tab%NDOF
4707 ikc => impbuf_tab%IKC
4708 IF(anim_v(5)+outp_v(5)+h3d_data%N_VECT_FINT>0) THEN
4709 DO i = nodft,nodlt
4710 DO j=1,min(3,ndof(i))
4711 nd = iddl(i)+j
4712 IF (ikc(nd)/=0) fani(j,i+nfia)= zero
4713 ENDDO
4714 IF (ndof(i)==0) THEN
4715 fani(1,i+nfia)= zero
4716 fani(2,i+nfia)= zero
4717 fani(3,i+nfia)= zero
4718 ENDIF
4719 ENDDO
4720 ENDIF
4721C
4722 RETURN
4723 END
4724!||====================================================================
4725!|| imp_fanii ../engine/source/implicit/imp_solv.F
4726!||--- called by ------------------------------------------------------
4727!|| resol ../engine/source/engine/resol.F
4728!||--- uses -----------------------------------------------------
4729!|| h3d_mod ../engine/share/modules/h3d_mod.F
4730!||====================================================================
4731 SUBROUTINE imp_fanii(
4732 1 FANI ,FINT ,NFIA ,NODFT ,NODLT ,
4733 2 H3D_DATA )
4734C-----------------------------------------------
4735C M o d u l e s
4736C-----------------------------------------------
4737 USE h3d_mod
4738C-----------------------------------------------
4739C I m p l i c i t T y p e s
4740C-----------------------------------------------
4741#include "implicit_f.inc"
4742C-----------------------------------------------
4743C C o m m o n B l o c k s
4744C-----------------------------------------------
4745#include "scr14_c.inc"
4746#include "scr16_c.inc"
4747C-----------------------------------------------
4748C D u m m y A r g u m e n t s
4749C-----------------------------------------------
4750 INTEGER NFIA,NODFT,NODLT
4751C REAL
4752 my_real
4753 . FINT(3,*) ,FANI(3,*)
4754 TYPE(h3d_database) :: H3D_DATA
4755C-----------------------------------------------
4756C L o c a l V a r i a b l e s
4757C-----------------------------------------------
4758 INTEGER N,I,J,K,ND
4759C---
4760 IF(anim_v(5)+outp_v(5)+h3d_data%N_VECT_FINT>0) THEN
4761#include "vectorize.inc"
4762 DO n=nodft,nodlt
4763 fani(1,n+nfia)= fint(1,n)
4764 fani(2,n+nfia)= fint(2,n)
4765 fani(3,n+nfia)= fint(3,n)
4766 ENDDO
4767 ENDIF
4768C
4769 RETURN
4770 END
4771!||====================================================================
4772!|| imp_fanie ../engine/source/implicit/imp_solv.F
4773!||--- called by ------------------------------------------------------
4774!|| resol ../engine/source/engine/resol.F
4775!||--- uses -----------------------------------------------------
4776!|| h3d_mod ../engine/share/modules/h3d_mod.F
4777!||====================================================================
4778 SUBROUTINE imp_fanie(
4779 1 FANI ,FEXT ,NFIA ,NFEA ,NODFT ,NODLT ,
4780 2 H3D_DATA )
4781C-----------------------------------------------
4782C M o d u l e s
4783C-----------------------------------------------
4784 USE h3d_mod
4785C-----------------------------------------------
4786C I m p l i c i t T y p e s
4787C-----------------------------------------------
4788#include "implicit_f.inc"
4789C-----------------------------------------------
4790C C o m m o n B l o c k s
4791C-----------------------------------------------
4792#include "scr14_c.inc"
4793#include "scr16_c.inc"
4794C-----------------------------------------------
4795C D u m m y A r g u m e n t s
4796C-----------------------------------------------
4797 INTEGER NFIA,NFEA,NODFT,NODLT
4798C REAL
4799 my_real
4800 . fext(3,*) ,fani(3,*)
4801 TYPE(h3d_database) :: H3D_DATA
4802C-----------------------------------------------
4803C L o c a l V a r i a b l e s
4804C-----------------------------------------------
4805 INTEGER N,I,J,K,ND
4806C---
4807 IF(ANIM_V(5)+OUTP_V(5)+H3D_DATA%N_VECT_FINT>0) THEN
4808#include "vectorize.inc"
4809 DO N=nodft,nodlt
4810 fani(1,n+nfia)= -fext(1,n)
4811 fani(2,n+nfia)= -fext(2,n)
4812 fani(3,n+nfia)= -fext(3,n)
4813 ENDDO
4814 ENDIF
4815 IF(anim_v(6)+outp_v(6)+h3d_data%N_VECT_FEXT>0) THEN
4816#include "vectorize.inc"
4817 DO n=nodft,nodlt
4818 fani(1,n+nfea)= fext(1,n)
4819 fani(2,n+nfea)= fext(2,n)
4820 fani(3,n+nfea)= fext(3,n)
4821 ENDDO
4822 ENDIF
4823 RETURN
4824 END
4825!||====================================================================
4826!|| ini_kic ../engine/source/implicit/imp_solv.F
4827!||--- called by ------------------------------------------------------
4828!|| imp_buck ../engine/source/implicit/imp_buck.F
4829!|| imp_solv ../engine/source/implicit/imp_solv.F
4830!||--- uses -----------------------------------------------------
4831!|| imp_intm ../engine/share/modules/imp_intm.F
4832!||====================================================================
4833 SUBROUTINE ini_kic
4834C-----------------------------------------------
4835C M o d u l e s
4836C-----------------------------------------------
4837 USE imp_intm
4838C-----------------------------------------------
4839C I m p l i c i t T y p e s
4840C-----------------------------------------------
4841#include "implicit_f.inc"
4842C-----------------------------------------------
4843C L o c a l V a r i a b l e s
4844C-----------------------------------------------
4845 nddl_si = 0
4846 nddl_sl = 0
4847 nz_si = 0
4848 nz_sl = 0
4849C------------------------------------------
4850 RETURN
4851 END
4852!||====================================================================
4853!|| deallocm ../engine/source/implicit/imp_solv.F
4854!||--- called by ------------------------------------------------------
4855!|| imp_solv ../engine/source/implicit/imp_solv.F
4856!||--- uses -----------------------------------------------------
4857!|| imp_knon ../engine/share/modules/impbufdef_mod.F
4858!||====================================================================
4859 SUBROUTINE deallocm
4860C-----------------------------------------------
4861C M o d u l e s
4862C-----------------------------------------------
4863 USE imp_knon
4864C-----------------------------------------------
4865C I m p l i c i t T y p e s
4866C-----------------------------------------------
4867#include "implicit_f.inc"
4868C-----------------------------------------------
4869C L o c a l V a r i a b l e s
4870C-----------------------------------------------
4871 IF(ALLOCATED(in_kn)) DEALLOCATE(in_kn)
4872 IF(ALLOCATED(id_kn)) DEALLOCATE(id_kn)
4873 IF (numn_kn>0) THEN
4874 IF(ALLOCATED(id_knm)) DEALLOCATE(id_knm)
4875 IF(ALLOCATED(id_knm2)) DEALLOCATE(id_knm2)
4876 IF(ALLOCATED(id_knm3)) DEALLOCATE(id_knm3)
4877 IF(ALLOCATED(ii2_kn)) DEALLOCATE(ii2_kn)
4878 IF(ALLOCATED(irb_kn)) DEALLOCATE(irb_kn)
4879 IF(ALLOCATED(ibc_kn)) DEALLOCATE(ibc_kn)
4880 IF(ALLOCATED(ifx_kn)) DEALLOCATE(ifx_kn)
4881 IF(ALLOCATED(irw_kn)) DEALLOCATE(irw_kn)
4882 IF(ALLOCATED(irbe3_kn)) DEALLOCATE(irbe3_kn)
4883 IF(ALLOCATED(fcdi_kn)) DEALLOCATE(fcdi_kn)
4884 IF(ALLOCATED(mcdi_kn)) DEALLOCATE(mcdi_kn)
4885 ENDIF
4886C------------------------------------------
4887 RETURN
4888 END
4889
4890!||====================================================================
4891!|| deallocm_imp ../engine/source/implicit/imp_solv.F
4892!||--- called by ------------------------------------------------------
4893!|| resol ../engine/source/engine/resol.f
4894!||--- calls -----------------------------------------------------
4895!|| fvbc_deallo ../engine/source/constraints/general/impvel/fv_imp0.F
4896!|| spmd_mumps_deal ../engine/source/mpi/implicit/imp_spmd.F
4897!||--- uses -----------------------------------------------------
4898!|| imp_bfgs ../engine/share/modules/impbufdef_mod.F
4899!|| imp_dyna ../engine/share/modules/impbufdef_mod.f
4900!|| imp_intbuf ../engine/share/modules/imp_mod_def.F90
4901!|| imp_kbcs ../engine/share/modules/impbufdef_mod.F
4902!|| imp_pcg_proj ../engine/share/modules/impbufdef_mod.F
4903!|| imp_qstat ../engine/share/modules/impbufdef_mod.F
4904!|| imp_spbrm ../engine/share/modules/impbufdef_mod.F
4905!|| imp_workh ../engine/share/modules/impbufdef_mod.F
4906!||====================================================================
4907 SUBROUTINE deallocm_imp(MUMPS_PAR)
4908C-----------------------------------------------
4909C M o d u l e s
4910C-----------------------------------------------
4911 USE imp_kbcs
4912 USE imp_bfgs
4913 USE imp_dyna
4914 USE imp_workh
4915 USE imp_pcg_proj
4916 USE imp_qstat
4917 USE imp_spbrm
4918 USE imp_intbuf
4919C-----------------------------------------------
4920C I m p l i c i t T y p e s
4921C-----------------------------------------------
4922#include "implicit_f.inc"
4923C-----------------------------------------------
4924C C o m m o n B l o c k s
4925C-----------------------------------------------
4926#include "com01_c.inc"
4927#include "impl1_c.inc"
4928#include "impl2_c.inc"
4929#if defined(MUMPS5)
4930#include "dmumps_struc.h"
4931#endif
4932C-----------------------------------------------
4933C D u m m y A r g u m e n t s
4934C-----------------------------------------------
4935#ifdef MUMPS5
4936 TYPE(dmumps_struc) MUMPS_PAR
4937#else
4938 ! Fake declaration as DMUMPS_STRUC is shipped with MUMPS
4939 INTEGER MUMPS_PAR
4940#endif
4941#if defined(MUMPS5)
4942C-----------------------------------------------
4943C L o c a l V a r i a b l e s
4944C-----------------------------------------------
4945 IF(imumpsv > 0 ) CALL spmd_mumps_deal(mumps_par)
4946 IF (isolv>2) THEN
4947 IF(ALLOCATED(hold)) DEALLOCATE(hold)
4948 ENDIF
4949 IF (insolv>1) THEN
4950 IF(ALLOCATED(bfgs_v)) DEALLOCATE(bfgs_v)
4951 IF(ALLOCATED(bfgs_w)) DEALLOCATE(bfgs_w)
4952 ENDIF
4953 IF (idyna>0) THEN
4954 IF(ALLOCATED(dy_d)) DEALLOCATE(dy_d)
4955 IF(ALLOCATED(dy_dr)) DEALLOCATE(dy_dr)
4956 IF(ALLOCATED(dy_v)) DEALLOCATE(dy_v)
4957 IF(ALLOCATED(dy_vr)) DEALLOCATE(dy_vr)
4958c IF(ALLOCATED(DY_A)) DEALLOCATE(DY_A)
4959c IF(ALLOCATED(DY_AR)) DEALLOCATE(DY_AR)
4960 IF (idy_damp>0) THEN
4961 DEALLOCATE(dy_diak0,dy_ltk0)
4962 DEALLOCATE(dy_iadk0,dy_jdik0)
4963 ENDIF
4964 IF (hht_a/=zero)DEALLOCATE(dy_r0,dy_r1)
4965 ENDIF
4966C---------------lin_solv--------
4967 IF(ALLOCATED(l_u)) DEALLOCATE(l_u)
4968 IF(ALLOCATED(diag_t)) DEALLOCATE(diag_t)
4969 IF(ALLOCATED(l_f0)) DEALLOCATE(l_f0)
4970 IF (isolv==1.OR.isolv>4) THEN
4971 IF(ALLOCATED(iadk0)) DEALLOCATE(iadk0)
4972 IF(ALLOCATED(jdik0)) DEALLOCATE(jdik0)
4973 IF(ALLOCATED(lt_k0)) DEALLOCATE(lt_k0)
4974 IF(ALLOCATED(pcg_w1)) DEALLOCATE(pcg_w1)
4975 IF(ALLOCATED(pcg_w2)) DEALLOCATE(pcg_w2)
4976 IF(ALLOCATED(pcg_w3)) DEALLOCATE(pcg_w3)
4977 IF (iprec==5) THEN
4978 IF(ALLOCATED(iadm0)) DEALLOCATE(iadm0)
4979 IF(ALLOCATED(jdim0)) DEALLOCATE(jdim0)
4980 IF(ALLOCATED(lt_m0)) DEALLOCATE(lt_m0)
4981 ENDIF
4982 IF (m_vs>0) THEN
4983 IF(ALLOCATED(proj_s)) DEALLOCATE(proj_s)
4984 IF(ALLOCATED(proj_t)) DEALLOCATE(proj_t)
4985 IF(ALLOCATED(proj_la_1)) DEALLOCATE(proj_la_1)
4986 IF(ALLOCATED(proj_v)) DEALLOCATE(proj_v)
4987 IF(ALLOCATED(proj_w)) DEALLOCATE(proj_w)
4988 IF(ALLOCATED(proj_k)) DEALLOCATE(proj_k)
4989 ENDIF
4990 ENDIF
4991 IF(iqstat==1 .AND. iline==0) THEN
4992 DEALLOCATE(d_n_1)
4993 IF (iroddl/=0) DEALLOCATE(dr_n_1)
4994 END IF
4995 CALL fvbc_deallo
4996 IF (irig_m>0) THEN
4997 IF(ALLOCATED(ibc_b)) DEALLOCATE(ibc_b)
4998 IF(ALLOCATED(ie_bc4)) DEALLOCATE(ie_bc4)
4999 IF(ALLOCATED(ie_bc3)) DEALLOCATE(ie_bc3)
5000 END IF
5001C------ faire---
5002c IF (NINTER>0) THEN
5003c IF(ALLOCATED(INTBUF_TAB_CP)) DEALLOCATE(INTBUF_TAB_CP)
5004c IF(ALLOCATED(INTBUF_TAB_IMP)) DEALLOCATE(INTBUF_TAB_IMP)
5005c IF(ALLOCATED(BMINMA_IMP)) DEALLOCATE(BMINMA_IMP)
5006c END IF
5007C------------------------------------------
5008 RETURN
5009#endif
5010 END
5011!||====================================================================
5012!|| crit_llim ../engine/source/implicit/imp_solv.F
5013!||--- called by ------------------------------------------------------
5014!|| imp_solv ../engine/source/implicit/imp_solv.F
5015!||====================================================================
5016 SUBROUTINE crit_llim(NDDL,NNZK)
5017C-----------------------------------------------
5018C I m p l i c i t T y p e s
5019C-----------------------------------------------
5020#include "implicit_f.inc"
5021C-----------------------------------------------
5022C C o m m o n B l o c k s
5023C-----------------------------------------------
5024#include "com01_c.inc"
5025#include "task_c.inc"
5026#include "impl1_c.inc"
5027C-----------------------------------------------
5028C D u m m y A r g u m e n t s
5029C-----------------------------------------------
5030C REAL
5031 INTEGER NDDL,NNZK
5032C-----------------------------------------------
5033C L o c a l V a r i a b l e s
5034C-----------------------------------------------
5035 INTEGER I,J,JD,NP
5036 my_real
5037 . pfac,critl,s1,s2
5038C------compute auto seclect solver by L_LIM--------------
5039C--------take into account to parallel capacities of PCG---
5040 IF (nspmd == 1) THEN
5041 nddl_g = nddl
5042 nnzk_g = nnzk
5043 END IF
5044 np=nspmd/2
5045 pfac= two_third*nthread*max(1,np)
5046 pfac=max(one,pfac)
5047 s1=nddl_g*five*em03
5048 s2=nnzk_g*twop8*em04
5049 critl=half*(s1+s2)
5050 l_lim=critl*pfac
5051C------------------------------------------
5052 RETURN
5053 END
5054!||====================================================================
5055!|| ini_k0h ../engine/source/implicit/imp_solv.F
5056!||--- called by ------------------------------------------------------
5057!|| imp_chkm ../engine/source/implicit/imp_solv.F
5058!|| imp_solv ../engine/source/implicit/imp_solv.F
5059!||--- calls -----------------------------------------------------
5060!|| ancmsg ../engine/source/output/message/message.F
5061!|| arret ../engine/source/system/arret.F
5062!|| dim_span ../engine/source/implicit/ind_glob_k.F
5063!||--- uses -----------------------------------------------------
5064!|| imp_pcg_proj ../engine/share/modules/impbufdef_mod.F
5065!|| imp_workh ../engine/share/modules/impbufdef_mod.F
5066!|| message_mod ../engine/share/message_module/message_mod.F
5067!||====================================================================
5068 SUBROUTINE ini_k0h(NDDL,NNZ,NNZM,IADK,JDIK)
5069C-----------------------------------------------
5070C M o d u l e s
5071C-----------------------------------------------
5072 USE imp_workh
5073 USE imp_pcg_proj
5074 USE message_mod
5075C-----------------------------------------------
5076C I m p l i c i t T y p e s
5077C-----------------------------------------------
5078#include "implicit_f.inc"
5079C-----------------------------------------------
5080C C o m m o n B l o c k s
5081C-----------------------------------------------
5082#include "impl1_c.inc"
5083C-----------------------------------------------
5084C D u m m y A r g u m e n t s
5085C-----------------------------------------------
5086 INTEGER NDDL,NNZ,NNZM,IADK(*),JDIK(*)
5087C-----------------------------------------------
5088C L o c a l V a r i a b l e s
5089C-----------------------------------------------
5090 INTEGER IERR,LNZM
5091C------------------for lin_solv---------------
5092 ALLOCATE(L_U(NDDL),DIAG_T(NDDL),L_F0(NDDL),STAT=ierr)
5093 IF (ierr/=0) THEN
5094 CALL ancmsg(msgid=19,anmode=aninfo,
5095 . c1='FOR IMPLICIT SOLVER')
5096 CALL arret(2)
5097 ENDIF
5098 IF (isolv==1.OR.isolv>4) THEN
5099 ALLOCATE(pcg_w1(nddl),pcg_w2(nddl),pcg_w3(nddl),stat=ierr)
5100 ALLOCATE(iadk0(nddl+1),jdik0(nnz),lt_k0(nnz),stat=ierr)
5101 IF (ierr/=0) THEN
5102 CALL ancmsg(msgid=19,anmode=aninfo,
5103 . c1='FOR PCG SOLVER')
5104 CALL arret(2)
5105 ENDIF
5106 lt_k0=zero
5107 IF (iprec==5) THEN
5108 lnzm = nnzm
5109 IF (n_pat>1) CALL dim_span(n_pat,nddl,iadk,jdik,lnzm,ierr)
5110 ALLOCATE(iadm0(nddl+1),jdim0(lnzm),lt_m0(lnzm),stat=ierr)
5111 IF (ierr/=0) THEN
5112 CALL ancmsg(msgid=19,anmode=aninfo,
5113 . c1='FOR PCG(IPREC=5) SOLVER')
5114 CALL arret(2)
5115 ENDIF
5116 lt_m0=zero
5117 END IF !(IPREC==5) THEN
5118 END IF !(ISOLV==1.OR.ISOLV>4) THEN
5119C
5120 IF (m_vs>0) THEN
5121 lnzm=m_vs+1
5122 ALLOCATE(proj_s(nddl,lnzm),proj_t(nddl,lnzm),proj_la_1(lnzm),
5123 . proj_v(nddl),proj_w(lnzm),proj_k(lnzm,lnzm),
5124 . stat=ierr)
5125 IF (ierr/=0) THEN
5126 CALL ancmsg(msgid=19,anmode=aninfo,
5127 . c1='FOR PCG SOLVER')
5128 CALL arret(2)
5129 ENDIF
5130 ncg_run = 0
5131 proj_v = zero
5132 END IF
5133C------------------------------------------
5134 RETURN
5135 END
5136!||====================================================================
5137!|| set_ksym ../engine/source/implicit/imp_solv.F
5138!||--- called by ------------------------------------------------------
5139!|| lin_solv ../engine/source/implicit/lin_solv.F
5140!|| lin_solvh0 ../engine/source/implicit/lin_solv.F
5141!|| lin_solvh1 ../engine/source/implicit/lin_solv.F
5142!|| lin_solvhm ../engine/source/implicit/lin_solv.F
5143!|| lin_solvih2 ../engine/source/implicit/lin_solv.F
5144!||====================================================================
5145 SUBROUTINE set_ksym(NDDL,IADK,JDIK,LT_K,IADK0,JDIK0,LT_K0)
5146C-----------------------------------------------
5147C I m p l i c i t T y p e s
5148C-----------------------------------------------
5149#include "implicit_f.inc"
5150C-----------------------------------------------
5151C D u m m y A r g u m e n t s
5152C-----------------------------------------------
5153 INTEGER NDDL,IADK(*),JDIK(*),IADK0(*),JDIK0(*)
5154 my_real
5155 . lt_k(*),lt_k0(*)
5156C-----------------------------------------------
5157C L o c a l V a r i a b l e s
5158C-----------------------------------------------
5159 INTEGER I,J,K,JD,ICOL(NDDL),NRI,NR0
5160C----6--K0:matrice complete(non triang)
5161 DO i = 1, nddl
5162 icol(i) = iadk(i+1) - iadk(i)
5163 ENDDO
5164 DO i = 1, nddl
5165 DO j = iadk(i),iadk(i+1)-1
5166 jd = jdik(j)
5167 icol(jd) = icol(jd) + 1
5168 ENDDO
5169 ENDDO
5170 iadk0(1) = 1
5171 DO i = 1,nddl
5172 iadk0(i+1) = iadk0(i)+icol(i)-iadk(i+1)+iadk(i)
5173 icol(i) = 0
5174 ENDDO
5175 DO i = 1,nddl
5176 DO j=iadk(i),iadk(i+1)-1
5177 jd = jdik(j)
5178 k = iadk0(jd) + icol(jd)
5179 jdik0(k) = i
5180 lt_k0(k) = lt_k(j)
5181 icol(jd) = icol(jd) + 1
5182 ENDDO
5183 ENDDO
5184C
5185 RETURN
5186 END
5187
5188!||====================================================================
5189!|| get_fext ../engine/source/implicit/imp_solv.F
5190!||--- called by ------------------------------------------------------
5191!|| imp_solv ../engine/source/implicit/imp_solv.F
5192!||--- calls -----------------------------------------------------
5193!|| condens_b ../engine/source/implicit/upd_glob_k.F
5194!|| imp_setba ../engine/source/implicit/imp_setb.F
5195!|| imp_setbp ../engine/source/implicit/imp_setb.F
5196!|| spmd_sumf_v ../engine/source/mpi/implicit/imp_spmd.f
5197!||====================================================================
5198 SUBROUTINE get_fext(NDDL0 ,NDDL ,IDDL ,NDOF ,IKC ,
5199 1 INLOC ,LB ,FEXT ,AC ,ACR )
5200C-----------------------------------------------
5201C I m p l i c i t T y p e s
5202C-----------------------------------------------
5203#include "implicit_f.inc"
5204C-----------------------------------------------
5205C C o m m o n B l o c k s
5206C-----------------------------------------------
5207#include "com01_c.inc"
5208#include "com08_c.inc"
5209C-----------------------------------------------
5210C D u m m y A r g u m e n t s
5211C-----------------------------------------------
5212 INTEGER NDDL0 ,NDDL ,IDDL(*),NDOF(*),IKC(*),INLOC(*)
5213 my_real
5214 . LB(*),FEXT(*),AC(*),ACR(*)
5215C-----------------------------------------------
5216C L o c a l V a r i a b l e s
5217C-----------------------------------------------
5218 INTEGER I,J
5219 my_real
5220 . BFAC,NTMP
5221C-----------------------------------------------
5222 IF (ABS(TT)<EM20) RETURN
5223 bfac=tstop/tt
5224 IF (nspmd>1) THEN
5225C -------------------------------
5226 ntmp = 0
5227 DO i=1,nddl0
5228 fext(i)=lb(i)
5229 ENDDO
5230 CALL imp_setba(ac ,acr ,iddl ,ndof ,fext ,
5231 1 ntmp )
5232 CALL condens_b(nddl0 ,ikc ,fext)
5233 CALL spmd_sumf_v(fext)
5234 CALL imp_setbp(ac ,acr ,iddl ,ndof ,ikc ,
5235 . inloc ,fext )
5236 DO i=1,nddl
5237 fext(i)=bfac*fext(i)
5238 ENDDO
5239 ELSE
5240 DO i=1,nddl0
5241 fext(i)=bfac*lb(i)
5242 ENDDO
5243 CALL condens_b(nddl0 ,ikc ,fext )
5244 END IF
5245C------------------------------------------
5246 RETURN
5247 END
5248!||====================================================================
5249!|| re2int5 ../engine/source/implicit/imp_solv.F
5250!||--- called by ------------------------------------------------------
5251!|| resol ../engine/source/engine/resol.F
5252!||====================================================================
5253 SUBROUTINE re2int5(NT_IMP,NUMIMP,NS_IMP,NE_IMP,NUMIMPL,
5254 1 IPARI ,NT_IMP0)
5255C-----------------------------------------------
5256C I m p l i c i t T y p e s
5257C-----------------------------------------------
5258#include "implicit_f.inc"
5259C-----------------------------------------------
5260C C o m m o n B l o c k s
5261C-----------------------------------------------
5262#include "com04_c.inc"
5263#include "task_c.inc"
5264#include "param_c.inc"
5265C-----------------------------------------------
5266C D u m m y A r g u m e n t s
5267C-----------------------------------------------
5268 INTEGER NT_IMP,NUMIMP(*),NS_IMP(*),NE_IMP(*),
5269 . NUMIMPL(NINTER,*),IPARI(NPARI,*),NT_IMP0
5270C-----------------------------------------------
5271C L o c a l V a r i a b l e s
5272C-----------------------------------------------
5273 INTEGER I,J,K,L,N,IAD,IAD1,IADT,ITY,L_CP,L_CPJ,NIMPJ,
5274 . IADN(NTHREAD)
5275 INTEGER, DIMENSION(:),ALLOCATABLE :: NS_CP,NE_CP
5276 INTEGER IER1
5277C-----------------------------------------------
5278C S o u r c e L i n e s
5279C-----------------------------------------------
5280C-----------------------------------------
5281 nt_imp = 0
5282 iadt = 0
5283 l_cpj = 0
5284 DO j = 1,nthread
5285 nimpj = iadt
5286 DO n = 1,ninter
5287 ity =ipari(7,n)
5288 IF (ity==3.OR.ity==4.OR.ity==5) THEN
5289 numimp(n)=0
5290 iadt =iadt + numimpl(n,j)
5291 END IF
5292 END DO
5293 nimpj = -nimpj+iadt
5294 l_cpj = max(l_cpj,nimpj)
5295 END DO
5296 IF (iadt==0) RETURN
5297C
5298 IF (nthread==1) THEN
5299 DO n = 1,ninter
5300 numimp(n) =numimpl(n,1)
5301 END DO
5302 ELSE
5303 l_cp = l_cpj*nthread
5304 ALLOCATE(ns_cp(l_cp),ne_cp(l_cp),stat=ier1)
5305C
5306 iad=0
5307 DO j = 1,nthread
5308 iad1=(j-1)*nt_imp0
5309 DO i = 1,l_cpj
5310 ns_cp(iad+i) = ns_imp(iad1+i)
5311 ne_cp(iad+i) = ne_imp(iad1+i)
5312 END DO
5313 iad =iad + l_cpj
5314 iadn(j) =0
5315 END DO
5316C
5317 iad = 0
5318 DO n = 1,ninter
5319 ity =ipari(7,n)
5320 numimp(n)=0
5321 IF (ity==3.OR.ity==4.OR.ity==5) THEN
5322 DO j = 1,nthread
5323 iad1=(j-1)*l_cp/ nthread + iadn(j)
5324 DO i = 1,numimpl(n,j)
5325 ns_imp(iad+i) = ns_cp(iad1+i)
5326 ne_imp(iad+i) = ne_cp(iad1+i)
5327 END DO
5328 iad =iad + numimpl(n,j)
5329 numimp(n) = numimp(n)+numimpl(n,j)
5330 iadn(j) = iadn(j) + numimpl(n,j)
5331C-------reput zero
5332 numimpl(n,j)=0
5333 END DO
5334 END IF
5335 END DO
5336 DEALLOCATE(ns_cp,ne_cp)
5337 END IF !(NTHREAD==1) THEN
5338C
5339 nt_imp = nt_imp + iadt
5340C
5341 RETURN
5342 END
5343!||====================================================================
5344!|| re2int7 ../engine/source/implicit/imp_solv.F
5345!||--- called by ------------------------------------------------------
5346!|| resol ../engine/source/engine/resol.F
5347!||--- calls -----------------------------------------------------
5348!|| imp_stif24 ../engine/source/implicit/imp_solv.F
5349!||====================================================================
5350 SUBROUTINE re2int7(NT_IMP,NUMIMP,NS_IMP,NE_IMP,IND_IMP,
5351 1 NUMIMPL,IPARI,NT_IMP0)
5352C-----------------------------------------------
5353C I m p l i c i t T y p e s
5354C-----------------------------------------------
5355#include "implicit_f.inc"
5356C-----------------------------------------------
5357C C o m m o n B l o c k s
5358C-----------------------------------------------
5359#include "com04_c.inc"
5360#include "task_c.inc"
5361#include "param_c.inc"
5362C-----------------------------------------------
5363C D u m m y A r g u m e n t s
5364C-----------------------------------------------
5365 INTEGER NT_IMP,NUMIMP(*),NS_IMP(*),NE_IMP(*),IND_IMP(*),
5366 . numimpl(ninter,*),ipari(npari,*),nt_imp0
5367C-----------------------------------------------
5368C L o c a l V a r i a b l e s
5369C-----------------------------------------------
5370 INTEGER I,J,K,L,N,IAD,IAD1,IADT,ITY,IAD0,L_CP,L_CPJ,NIMPJ,
5371 . NT_IMP7,IADN(NTHREAD)
5372 INTEGER, DIMENSION(:),ALLOCATABLE :: NS_CP,NE_CP,IND_CP
5373 INTEGER IER1
5374C-----------------------------------------------
5375C S o u r c e L i n e s
5376C-----------------------------------------------
5377 iadt = 0
5378 l_cpj = 0
5379 DO j = 1,nthread
5380 nimpj = iadt
5381 DO n = 1,ninter
5382 ity =ipari(7,n)
5383 IF (ity==7.OR.ity==10.OR.ity==11.OR.ity==24) THEN
5384 numimp(n)=0
5385 iadt =iadt + numimpl(n,j)
5386 END IF
5387 END DO
5388 nimpj = -nimpj+iadt
5389 l_cpj = max(l_cpj,nimpj)
5390 END DO
5391 IF (iadt==0) GOTO 100
5392
5393 IF (nthread==1) THEN
5394 DO n = 1,ninter
5395 numimp(n) =numimpl(n,1)
5396 END DO
5397 ELSE
5398 l_cp = l_cpj*nthread
5399 ALLOCATE(ns_cp(l_cp),ne_cp(l_cp),ind_cp(l_cp),stat=ier1)
5400
5401 iad0=nt_imp
5402 nt_imp7=nt_imp0-nt_imp
5403 iad =0
5404 DO j = 1,nthread
5405 iad1=iad0+(j-1)*nt_imp7
5406 DO i = 1,l_cpj
5407 ns_cp(iad+i) = ns_imp(iad1+i)
5408 ne_cp(iad+i) = ne_imp(iad1+i)
5409 ind_cp(iad+i) = ind_imp(iad1+i)
5410 END DO
5411 iad =iad + l_cpj
5412 iadn(j) =0
5413 END DO
5414
5415 iad = iad0
5416 DO n = 1,ninter
5417 ity =ipari(7,n)
5418 IF (ity==7.OR.ity==10.OR.ity==11.OR.ity==24) THEN
5419 DO j = 1,nthread
5420 iad1=(j-1)*l_cp/ nthread + iadn(j)
5421 DO i = 1,numimpl(n,j)
5422 ns_imp(iad+i) = ns_cp(iad1+i)
5423 ne_imp(iad+i) = ne_cp(iad1+i)
5424 ind_imp(iad+i) = ind_cp(iad1+i)
5425 END DO
5426 iad =iad + numimpl(n,j)
5427 numimp(n) = numimp(n)+numimpl(n,j)
5428 iadn(j) = iadn(j) + numimpl(n,j)
5429C ----reput zero
5430 numimpl(n,j)=0
5431 END DO
5432 END IF
5433 END DO
5434 DEALLOCATE(ns_cp,ne_cp,ind_cp)
5435 END IF !(NTHREAD==1) THEN
5436C
5437 nt_imp = nt_imp + iadt
5438C-------int24, Istif=6
5439 100 CONTINUE
5440 CALL imp_stif24(numimp ,ipari )
5441 RETURN
5442 END
5443!||====================================================================
5444!|| du_ini ../engine/source/implicit/imp_solv.F
5445!||--- uses -----------------------------------------------------
5446!|| imp_dyna ../engine/share/modules/impbufdef_mod.F
5447!||====================================================================
5448 SUBROUTINE du_ini(NODFT ,NODLT ,DN ,DNR ,DD ,
5449 1 DDR ,IDIV ,ICONT0 )
5450C-----------------------------------------------
5451C M o d u l e s
5452C-----------------------------------------------
5453 USE imp_dyna
5454C-----------------------------------------------
5455C I m p l i c i t T y p e s
5456C-----------------------------------------------
5457#include "implicit_f.inc"
5458C-----------------------------------------------
5459C C o m m o n B l o c k s
5460C-----------------------------------------------
5461#include "impl1_c.inc"
5462#include "impl2_c.inc"
5463#include "com01_c.inc"
5464C-----------------------------------------------
5465C D u m m y A r g u m e n t s
5466C-----------------------------------------------
5467 INTEGER NODFT ,NODLT,IDIV ,ICONT0
5468 my_real
5469 . dn(3,*),dnr(3,*),dd(3,*),ddr(3,*)
5470C-----------------------------------------------
5471C L o c a l V a r i a b l e s
5472C-----------------------------------------------
5473 INTEGER I,J,IRES
5474 my_real
5475 . bfac,bdt
5476C--------------Dn,0=Dn-1--------
5477C--------special case with /QSTAT diverge by contact, restart w/o resolution
5478 ires = 1
5479 IF (iqstat >0 .AND. idiv==-2 .AND. icont0 >0 ) THEN
5480 idiv=-1
5481 ires=0
5482 END IF
5483C
5484 bfac=dt1_imp/dt0_imp
5485 IF (idyna==0) THEN
5486 IF (ismdisp>0.OR.ires==0) THEN
5487 DO i = nodft ,nodlt
5488 dd(1,i) = bfac*dn(1,i)
5489 dd(2,i) = bfac*dn(2,i)
5490 dd(3,i) = bfac*dn(3,i)
5491 END DO
5492 IF (iroddl/=0) THEN
5493 DO i = nodft ,nodlt
5494 ddr(1,i) = bfac*dnr(1,i)
5495 ddr(2,i) = bfac*dnr(2,i)
5496 ddr(3,i) = bfac*dnr(3,i)
5497 END DO
5498 END IF
5499 ELSE
5500 DO i = nodft ,nodlt
5501 dd(1,i) = dn(1,i)
5502 dd(2,i) = dn(2,i)
5503 dd(3,i) = dn(3,i)
5504 ENDDO
5505 IF (iroddl/=0) THEN
5506 DO i = nodft ,nodlt
5507 ddr(1,i) = dnr(1,i)
5508 ddr(2,i) = dnr(2,i)
5509 ddr(3,i) = dnr(3,i)
5510 ENDDO
5511 END IF
5512 END IF
5513 ELSE
5514 bdt = half*dt0_imp*dt0_imp*(one-two*dy_b)
5515 bdt = zero
5516 DO i = nodft ,nodlt
5517 dd(1,i) = bfac*dn(1,i)+bdt*dy_a(1,i)
5518 dd(2,i) = bfac*dn(2,i)+bdt*dy_a(2,i)
5519 dd(3,i) = bfac*dn(3,i)+bdt*dy_a(3,i)
5520 END DO
5521 IF (iroddl/=0) THEN
5522 DO i = nodft ,nodlt
5523 ddr(1,i) = bfac*dnr(1,i)+bdt*dy_ar(1,i)
5524 ddr(2,i) = bfac*dnr(2,i)+bdt*dy_ar(2,i)
5525 ddr(3,i) = bfac*dnr(3,i)+bdt*dy_ar(3,i)
5526 END DO
5527 END IF
5528 END IF
5529C------------------------------------------
5530 RETURN
5531 END
5532!||====================================================================
5533!|| pr_deb ../engine/source/implicit/imp_solv.F
5534!||--- uses -----------------------------------------------------
5535!|| imp_frk ../engine/share/modules/impbufdef_mod.F
5536!|| imp_intm ../engine/share/modules/imp_intm.F
5537!||====================================================================
5538 SUBROUTINE pr_deb(NDDL ,IDDL ,NDOF ,IKC ,ITAB ,
5539 1 DIAG_K,DIAG_M,INLOC ,FR_ELEM,IAD_ELEM,
5540 2 IADK ,JDIK ,LT_K ,LT_M ,NDDLI ,
5541 3 IADI ,JDII ,ITOK ,DIAG_I ,LT_I ,
5542 4 U ,F ,IT ,NSREM ,NSL ,
5543 5 D ,DR ,IFLAG ,W_DDL ,FEXT ,
5544 6 MEXT ,FINT ,MINT ,R01 ,NDEB ,NODGLOB)
5545C-----------------------------------------------
5546C M o d u l e s
5547C-----------------------------------------------
5548 USE imp_frk
5549 USE imp_intm
5550C-----------------------------------------------
5551C I m p l i c i t T y p e s
5552C-----------------------------------------------
5553#include "implicit_f.inc"
5554C-----------------------------------------------
5555C C o m m o n B l o c k s
5556C-----------------------------------------------
5557#include "com01_c.inc"
5558#include "com04_c.inc"
5559#include "task_c.inc"
5560#include "impl1_c.inc"
5561C-----------------------------------------------
5562C D u m m y A r g u m e n t s
5563C-----------------------------------------------
5564C REAL
5565 INTEGER NDDL ,IDDL(*) ,NDOF(*) ,IKC(*) ,ITAB(*),IFLAG,
5566 . fr_elem(*),iad_elem(2,*),inloc(*),iadk(*),jdik(*),nodglob(*),
5567 . nddli,iadi(*),jdii(*),itok(*),it,nsrem ,nsl,w_ddl(*),ndeb
5568 my_real
5569 . diag_k(*),diag_m(*),lt_k(*),lt_m(*) ,diag_i(*),lt_i(*),
5570 . u(*),f(*),d(3,*),dr(3,*),fext(3,*),mext(3,*),fint(3,*),
5571 . r01 ,mint(3,*),vq(3,3)
5572C-----------------------------------------------
5573c FUNCTION: print-out selected values in function of Ifalg
5574c
5575c Note:
5576c ARGUMENTS: (I: input, O: output, IO: input * output, W: workspace)
5577c
5578c TYPE NAME FUNCTION
5579c I NDDL,NDOF(N) - num. of total DOF after condensation; Num of DOF of node N
5580c I IDDL(N) - ID of DOF (before condensation) num of node N: IDDL(N)+1,NDOF(N)
5581c I IKC(NDDL0) - different independent dof, IKC()=0-> independent dof
5582c I ITAB(N) - user's node id
5583c I IADK(NDDL+1),JDIK(NNZ)-indices of assemblaged [K] of compressed format
5584c I DIAG_K(NDDL),LT_K(NNZ)-diag_[K] and compressed non zero strick trianluar [K]
5585c I IADM(NDDL+1),JDIM(NNZ)-same than [K], [M]: preconditioner matrix used for PCG only
5586c I DIAG_M(NDDL),LT_M(NNZ)-
5587c I IADI(NDDLI+1),JDII(NNZI)-indices of local [K_i] of contact spring
5588c I ITOK(NDDLI),DIAG_I(NDDL),LT_I(NNZ)- indice from local to glocal [K]
5589c I NSREM ,NSL -remote SECONDARY and local communated SECONDARY node number (due to // contact)
5590c I U(NDDL),F(NDDL) - U not available, F-> force Residual {Fext}-{Fint}
5591c I IT -nonlinear iteration number
5592c I D,DR(3,NUMNOD) -nodal displacement and rotation
5593c I IFLAG -print-out options ,see below
5594c I W_DDL -flag of physical presence of the boundary dof of diff. domains //
5595c I FEXT,MEXT(3,NUMNOD)- external nodal forces and moments
5596c I FINT,MINT(3,NUMNOD)- internal nodal forces and moments
5597c I R01 -force residual norm
5598c I Ndeb begin of debugging No of cycle.
5599C-----------------------------------------------
5600C L o c a l V a r i a b l e s
5601C-----------------------------------------------
5602Ctmp +3
5603 INTEGER i,j,N,ID,ND,IDDLM(NUMNOD),NKC,IDF,nnod,nk,iad,iad2,id2,
5604 . iddl_front(nddl),id2n(numnod),nkfront,inod,k,nn,ii,
5605 . iddl_front1(nspmd,nddl),itag(2,nspmd),index,iloc,jj,kk
5606 CHARACTER CHIF
5607 CHARACTER*9 FILNAME
5608 my_real
5609 . s_max,xl,yl,zl
5610C------iflag=1 ->U,F;iflag=2 ->+ [ki];iflag=3 ->+ [k];--iflag=4 ->+[m];
5611 idf = ispmd+11
5612 WRITE(chif,'(I1)')ispmd
5613 filname='DEB'//chif//'.TMP'
5614 OPEN(unit=idf,file=filname,status='UNKNOWN',form='FORMATTED')
5615 write(idf,*)'NCYCLE,IT,NUMNOD,NDDL=',ncycle,it,numnod,nddl
5616 write(idf,*)'NDDLI,NSREM,NSL,IMCONV,NDEB=', nddli,nsrem ,nsl,
5617 . imconv,ndeb
5618 if (imconv==-1.and.(nsrem +nsl)==0) then
5619 return
5620 end if
5621 write(idf,*)'R01=',r01
5622c write(IDF,*)'nddlfr=',nddlfr
5623 if (ncycle==(ndeb+1).AND.it==0.AND.imconv>=0) then
5624 nkc=0
5625 DO n =1,numnod
5626 i=inloc(n)
5627 iddlm(i)=iddl(i)-nkc
5628 DO j=1,ndof(i)
5629 nd = iddl(i)+j
5630 IF (ikc(nd)/=0) nkc = nkc + 1
5631 ENDDO
5632c if (NDOF(I)/=0)
5633 write(idf,*)'I,ITAB,NDOF,IDDLM=',i,itab(i),ndof(i),
5634 . iddlm(i),nodglob(i)
5635 ENDDO
5636 endif
5637c if (NSPMD==1) then
5638c I = 849965
5639 ii=0
5640 s_max=zero
5641 nn =0
5642 k=0
5643 nkc=0
5644 DO n =1,numnod
5645 i=inloc(n)
5646 iddlm(i)=iddl(i)-nkc
5647 jj=0
5648 DO j=1,ndof(i)
5649 nd = iddl(i)+j
5650 IF (ikc(nd)/=0) THEN
5651 nkc = nkc + 1
5652 ELSE
5653 jj = jj + 1
5654 id =iddlm(i) + jj
5655 id2n(id)=i
5656 write(idf,*)'DIAG_K,F,N,id=',diag_k(id),f(id),itab(i),id
5657 if (abs(f(id))>s_max) THEN
5658 s_max= abs(f(id))
5659 ii = id
5660 nn = i
5661 k=j
5662 endif
5663 END IF
5664 ENDDO
5665 ENDDO
5666 if (nn>0) write(idf,*)'MAX_F,N,J=',f(ii),itab(nn),k
5667c DO N =1,NDDL
5668c I = ITOK(N)
5669c I = N
5670c write(IDF,*),'NC,DIAG_k,DIAG_M=',
5671c . IADK(I+1)-IADK(I),DIAG_K(I),DIAG_M(I)
5672c write(IDF,*)'DIAG_K,F(I)=',DIAG_K(I),F(I),I
5673c if (abs(f(i))>S_MAX) THEN
5674c S_MAX= abs(f(i))
5675c II = I
5676c endif
5677c ENDDO
5678c write(IDF,*)'MAX_F=',F(II),II
5679 if (iflag>1) then
5680 DO n =1,numnod
5681 i=inloc(n)
5682 write(idf,*)'FEXT,MEXT,I,ITAB=',i,itab(i)
5683 write(idf,*)fext(1,i),fext(2,i),fext(3,i)
5684 IF (iroddl/=0)write(idf,*)mext(1,i),mext(2,i),mext(3,i)
5685 ENDDO
5686 DO n =1,numnod
5687 i=inloc(n)
5688 write(idf,*)'FINT,MINT,I,ITAB=',i,itab(i)
5689 write(idf,*)fint(1,i),fint(2,i),fint(3,i)
5690c IF (IRODDL/=0)write(IDF,*)MINT(1,I),MINT(2,I),MINT(3,I)
5691c XL = VQ(1,1)*FINT(1,I)+ VQ(1,2)*FINT(2,I)+VQ(1,3)*FINT(3,I)
5692c YL = VQ(2,1)*FINT(1,I)+ VQ(2,2)*FINT(2,I)+VQ(2,3)*FINT(3,I)
5693c ZL = VQ(3,1)*FINT(1,I)+ VQ(3,2)*FINT(2,I)+VQ(3,3)*FINT(3,I)
5694c write(IDF,*)'FINT,local=',I,ITAB(I)
5695c write(IDF,*)XL,YL,ZL
5696 ENDDO
5697 endif
5698 if (iflag>=1) then
5699 DO n =1,numnod
5700 i=inloc(n)
5701c if (NDOF(I)/=0) then
5702 write(idf,*)'D,DR,I,ITAB=',i,itab(i)
5703 write(idf,*)d(1,i),d(2,i),d(3,i)
5704 IF (iroddl/=0)write(idf,*)dr(1,i),dr(2,i),dr(3,i)
5705c end if !(NDOF(I)/=0) then
5706 ENDDO
5707 endif
5708 if (nspmd>1) then
5709C
5710 IF (intp_d>0) THEN
5711 write(idf,*)'NDDL_SL,NDDL_SI=',nddl_sl,nddl_si
5712 DO i=1,nsl
5713 n=isl(i)
5714 write (idf,*)'NS,I=',n,itab(n),i
5715 END DO
5716 DO i=1,nddl_sl
5717 id=iddl_sl(i)
5718 write(idf,*)'ID,DIAG_SL=',id,diag_sl(i)
5719 END DO
5720 DO i=1,nddl_sl
5721 DO j = iad_ss(i), iad_ss(i+1)-1
5722 write(idf,*)'LT_SL,NJ,J=',lt_sl(j),jdi_sl(j),j
5723 END DO
5724 END DO
5725 write (idf,*)'NDDL_SI=',nddl_si
5726 DO i=1,nddl_si
5727 DO j = iad_si(i), iad_si(i+1)-1
5728 write(idf,*)'LT_SI,NJ,J=',lt_si(j),jdi_si(j),j
5729 END DO
5730 END DO
5731 ELSE
5732 DO i=1,nsl
5733 n=isl(i)
5734 DO j=1,min(3,ndof(n))
5735 id = iddsl(j,i)
5736 IF (id>0) write(idf,*)'ID,DIAG_SL=',id,diag_s(j,i)
5737 END DO
5738 write (idf,*)'NS,I=',n,i
5739 END DO
5740 END IF
5741 iad = 0
5742 iad2 = 0
5743 write(idf,*)'LEN_K,LEN_V=',len_k,len_v
5744 DO i =1,nspmd
5745 nkc=0
5746 DO nk=iad_elem(1,i),iad_elem(1,i+1)-1
5747 n=fr_elem(nk)
5748 nd=0
5749 write(idf,*)'N,ITAB,IDDLFR,IP=',n,itab(n),iddlfr(nk),i
5750 DO j=1,ndof(n)
5751 IF (ikc(iddl(n)+j)<1) THEN
5752c ND=ND+1
5753 id=iddlfr(nk)+iad-nkc+j
5754 id2=iddlfr(nk)+iad2-nkc+j
5755 write(idf,*)
5756 . 'FR_ID,id2,id2k,NC=',id,id2,ifr2k(id2),iadfr(id+1)-iadfr(id)
5757 IF (iadfr(id+1)<iadfr(id)) write(idf,*)iadfr(id+1),iadfr(id)
5758 ELSE
5759 nkc=nkc+1
5760 ENDIF
5761 ENDDO
5762 ENDDO
5763 iad = iad + nd_fr(i) + 1
5764 iad2 = iad2 + nd_fr(i)
5765 ENDDO
5766 endif
5767 if (iflag>=1) then
5768 write(idf,*)'[Ki]=',nddli
5769 DO i =1,nddli
5770 n=id2n(itok(i))
5771 write(idf,*)'DIAG_I,itok,N=',diag_i(i),itok(i),itab(n)
5772 ENDDO
5773 DO i =1,nddli
5774 n=id2n(itok(i))
5775 write(idf,*)'NR,I(itok),N=',iadi(i+1)-iadi(i),itok(i),itab(n)
5776 DO j=iadi(i),iadi(i+1)-1
5777 n=id2n(itok(jdii(j)))
5778 write(idf,*)'LT_I,_id_NJ,NJ,J=',lt_i(j),itok(jdii(j)),itab(n),j
5779 ENDDO
5780 ENDDO
5781 endif
5782 if (iflag>1) then
5783 write(idf,*)'LT_[K]=',nddl
5784 DO i =1,nddl
5785 write(idf,*)'NR,I=',iadk(i+1)-iadk(i),i
5786 DO j=iadk(i),iadk(i+1)-1
5787 write(idf,*)'LT_K,NJ,J=',lt_k(j),jdik(j),j
5788 ENDDO
5789 ENDDO
5790 endif
5791C------------------------------------------
5792 RETURN
5793 END
5794!||====================================================================
5795!|| pr_matrix ../engine/source/implicit/imp_solv.F
5796!||--- uses -----------------------------------------------------
5797!|| imp_frk ../engine/share/modules/impbufdef_mod.F
5798!||====================================================================
5799 SUBROUTINE pr_matrix(NDDL ,IDDL ,NDOF ,IKC ,ITAB ,
5800 1 DIAG_K,DIAG_M,INLOC ,FR_ELEM,IAD_ELEM,
5801 2 IADK ,JDIK ,LT_K ,LT_M ,NDDLI ,
5802 3 IADI ,JDII ,ITOK ,DIAG_I ,LT_I ,
5803 4 IFLAG ,it )
5804C-----------------------------------------------
5805C M o d u l e s
5806C-----------------------------------------------
5807 USE imp_frk
5808C-----------------------------------------------
5809C I m p l i c i t T y p e s
5810C-----------------------------------------------
5811#include "implicit_f.inc"
5812C-----------------------------------------------
5813C C o m m o n B l o c k s
5814C-----------------------------------------------
5815#include "com01_c.inc"
5816#include "com04_c.inc"
5817#include "task_c.inc"
5818#include "impl1_c.inc"
5819C-----------------------------------------------
5820C D u m m y A r g u m e n t s
5821C-----------------------------------------------
5822C REAL
5823 INTEGER NDDL ,IDDL(*) ,NDOF(*) ,IKC(*) ,ITAB(*),IFLAG,
5824 . fr_elem(*),iad_elem(2,*),inloc(*),iadk(*),jdik(*),
5825 . nddli,iadi(*),jdii(*),itok(*),it
5826 my_real
5827 . diag_k(*),diag_m(*),lt_k(*),lt_m(*) ,diag_i(*),lt_i(*)
5828C-----------------------------------------------
5829C L o c a l V a r i a b l e s
5830C-----------------------------------------------
5831Ctmp +3
5832 INTEGER i,j,N,ID,ND,IDDLM(NUMNOD),NKC,IDF,nnod,nk,iad,iad2,id2,
5833 . NKFRONT,INOD,K,NN,II,INDEX,ILOC,JJ,KK
5834 CHARACTER CHIF
5835 CHARACTER*9 FILNAME
5836 my_real
5837 . s_max,xl,yl,zl
5838C------
5839 idf = ispmd+15
5840 WRITE(chif,'(I1)')ispmd
5841 filname='MAT'//chif//'.TMP'
5842 OPEN(unit=idf,file=filname,status='UNKNOWN',form='FORMATTED')
5843 write(idf,*)'NCYCLE,NUMNOD,NDDL,NDI=',ncycle,numnod,nddl,nddli
5844 if (imconv<0) return
5845c write(IDF,*)'nddlfr=',nddlfr
5846 if (ncycle==1) then
5847 nkc=0
5848 DO n =1,numnod
5849 i=inloc(n)
5850 iddlm(i)=iddl(i)-nkc
5851 DO j=1,ndof(i)
5852 nd = iddl(i)+j
5853 IF (ikc(nd)/=0) nkc = nkc + 1
5854 ENDDO
5855 if (ndof(i)/=0)
5856 . write(idf,*)'I,ITAB,NDOF,IDDL=',i,itab(i),ndof(i),
5857 . iddl(i)
5858 ENDDO
5859 endif
5860 DO n =1,nddl
5861 i = n
5862c write(IDF,*),'NC,DIAG_k,DIAG_M=',
5863c . IADK(I+1)-IADK(I),DIAG_K(I),DIAG_M(I)
5864 write(idf,*)'DIAG_K,DIAG_M=',diag_k(i),diag_m(i),i
5865 ENDDO
5866 if (nspmd>1) then
5867C
5868 iad = 0
5869 iad2 = 0
5870 write(idf,*)'LEN_K,LEN_V=',len_k,len_v
5871 DO i =1,nspmd
5872 nkc=0
5873 DO nk=iad_elem(1,i),iad_elem(1,i+1)-1
5874 n=fr_elem(nk)
5875 nd=0
5876 write(idf,*)'N,ITAB,IDDLFR,IP=',n,itab(n),iddlfr(nk),i
5877 DO j=1,ndof(n)
5878 IF (ikc(iddl(n)+j)<1) THEN
5879c ND=ND+1
5880 id=iddlfr(nk)+iad-nkc+j
5881 id2=iddlfr(nk)+iad2-nkc+j
5882 write(idf,*)
5883 . 'FR_ID,id2,id2k,NC=',id,id2,ifr2k(id2),iadfr(id+1)-iadfr(id)
5884 IF (iadfr(id+1)<iadfr(id)) write(idf,*)iadfr(id+1),iadfr(id)
5885 ELSE
5886 nkc=nkc+1
5887 ENDIF
5888 ENDDO
5889 ENDDO
5890 iad = iad + nd_fr(i) + 1
5891 iad2 = iad2 + nd_fr(i)
5892 ENDDO
5893 endif
5894 if (nddli>0.AND.iflag>0) then
5895 write(idf,*)'[Ki]=',nddli
5896 DO i =1,nddli
5897 write(idf,*)'DIAG_I,itok=',diag_i(i),itok(i)
5898 ENDDO
5899 DO i =1,nddli
5900 write(idf,*)'NR,I=',iadi(i+1)-iadi(i),i
5901 DO j=iadi(i),iadi(i+1)-1
5902 write(idf,*)'LT_I,NJ,J=',lt_i(j),itok(jdii(j)),j
5903 ENDDO
5904 ENDDO
5905 endif
5906 if (nddl>1.and.iflag>1) then
5907 write(idf,*)'LT_[K]=',nddl
5908 DO i =1,nddl
5909 write(idf,*)'NR,I=',iadk(i+1)-iadk(i),i
5910 DO j=iadk(i),iadk(i+1)-1
5911 write(idf,*)'LT_K,NJ,J=',lt_k(j),jdik(j),j
5912 ENDDO
5913 ENDDO
5914 if (iflag>1) then
5915 write(idf,*)'LT_[M]=',nddl
5916 DO i =1,nddl
5917 write(idf,*)'NR,I=',iadk(i+1)-iadk(i),i
5918 DO j=iadk(i),iadk(i+1)-1
5919 write(idf,*)'LT_M,NJ,J=',lt_m(j),jdik(j),j
5920 ENDDO
5921 ENDDO
5922 endif !(IFLAG>1) then
5923 endif
5924C------------------------------------------
5925 RETURN
5926 END
5927!||====================================================================
5928!|| pr_solnfo ../engine/source/implicit/imp_solv.F
5929!||--- called by ------------------------------------------------------
5930!|| imp_solv ../engine/source/implicit/imp_solv.F
5931!||--- calls -----------------------------------------------------
5932!|| spmd_max_f ../engine/source/mpi/implicit/imp_spmd.F
5933!||--- uses -----------------------------------------------------
5934!|| imp_frk ../engine/share/modules/impbufdef_mod.F
5935!|| imp_intm ../engine/share/modules/imp_intm.F
5936!||====================================================================
5937 SUBROUTINE pr_solnfo(NDDL ,IDDL ,NDOF ,IKC ,ITAB ,
5938 1 DIAG_K,DIAG_M,INLOC ,FR_ELEM,IAD_ELEM,
5939 2 IADK ,JDIK ,LT_K ,LT_M ,NDDLI ,
5940 3 IADI ,JDII ,ITOK ,DIAG_I ,LT_I ,
5941 4 U ,F ,IT ,NSREM ,NSL ,
5942 5 D ,DR ,IFLAG ,W_DDL ,FEXT ,
5943 6 MEXT ,FINT ,MINT ,R01 ,NDEB ,
5944 7 R_IMP ,I_IMP ,DD ,DDR)
5945C-----------------------------------------------
5946C M o d u l e s
5947C-----------------------------------------------
5948 USE imp_frk
5949 USE imp_intm
5950C-----------------------------------------------
5951C I m p l i c i t T y p e s
5952C-----------------------------------------------
5953#include "implicit_f.inc"
5954C-----------------------------------------------
5955C C o m m o n B l o c k s
5956C-----------------------------------------------
5957#include "com01_c.inc"
5958#include "com04_c.inc"
5959#include "com08_c.inc"
5960#include "task_c.inc"
5961#include "impl1_c.inc"
5962#include "impl2_c.inc"
5963C-----------------------------------------------
5964C D u m m y A r g u m e n t s
5965C-----------------------------------------------
5966C REAL
5967 INTEGER NDDL ,IDDL(*) ,NDOF(*) ,IKC(*) ,ITAB(*),IFLAG,
5968 . fr_elem(*),iad_elem(2,*),inloc(*),iadk(*),jdik(*),
5969 . nddli,iadi(*),jdii(*),itok(*),it,nsrem ,nsl,w_ddl(*),
5970 . ndeb,i_imp(*)
5971 my_real
5972 . diag_k(*),diag_m(*),lt_k(*),lt_m(*) ,diag_i(*),lt_i(*),
5973 . u(*),f(*),d(3,*),dr(3,*),fext(3,*),mext(3,*),fint(3,*),
5974 . r01 ,mint(3,*),vq(3,3),r_imp(*),dd(3,*),ddr(3,*)
5975C-----------------------------------------------
5976c FUNCTION: print-out solver info such as maximum residual, relative residuals, line-search coeff, tolerance
5977C-----------------------------------------------
5978C L o c a l V a r i a b l e s
5979C-----------------------------------------------
5980 INTEGER I,J,N,ID,ND,IDDLM(NUMNOD),NKC,IDF,NNOD,NK,IAD,IAD2,
5981 . iddl_front(nddl),id2n(numnod),nkfront,inod,id2,cumul_it,
5982 . iddl_front1(nspmd,nddl),itag(2,nspmd),index,iloc,jj,kk,
5983 . k,k2,k3,kr,k2r,k3r,nn,nn2,nn3,nnr,nn2r,nn3r,ii,iir,ii2,
5984 . itabmax,irtabmax,itabmax2,irtabmax2,itabmax3,irtabmax3
5985 my_real
5986 . f_max,fr_max,d_max,dr_max,dd_max,ddr_max,
5987 . fmax,frmax,dmax,drmax,ddmax,ddrmax,tole,tolf,tolu
5988 CHARACTER NODEID*10,FILNAM*100
5989c if (IMCONV==-1.and.(NSREM +NSL)==0) then
5990c return
5991c end if
5992c if (NCYCLE==(NDEB+1).AND.IT==0.AND.IMCONV>=0) then
5993c NKC=0
5994c DO N =1,NUMNOD
5995c I=INLOC(N)
5996c IDDLM(I)=IDDL(I)-NKC
5997c DO J=1,NDOF(I)
5998c ND = IDDL(I)+J
5999c IF (IKC(ND)/=0) NKC = NKC + 1
6000c ENDDO
6001c ENDDO
6002c endif
6003 ii=0
6004 iir=0
6005 f_max=zero
6006 fr_max=zero
6007 d_max=zero
6008 dr_max=zero
6009 dd_max=zero
6010 ddr_max=zero
6011 fmax=zero
6012 frmax=zero
6013 dmax=zero
6014 drmax=zero
6015 ddmax=zero
6016 ddrmax=zero
6017 nn=0
6018 nn2=0
6019 nn3=0
6020 k=0
6021 k2=0
6022 k3=0
6023 nnr=0
6024 nn2r=0
6025 nn3r=0
6026 kr=0
6027 k2r=0
6028 k3r=0
6029 nkc=0
6030 DO n =1,numnod
6031 i=inloc(n)
6032 iddlm(i)=iddl(i)-nkc
6033 jj=0
6034 DO j=1,ndof(i)
6035 nd = iddl(i)+j
6036 IF (ikc(nd)/=0) THEN
6037 nkc = nkc + 1
6038 ELSE
6039 jj = jj + 1
6040 id =iddlm(i) + jj
6041 id2 = iddlm(i)
6042c ID2N(ID)=I
6043 IF (j < 4) THEN
6044 IF (abs(f(id))>f_max) THEN
6045 f_max= abs(f(id))
6046 ii = id
6047 nn = i
6048 k = j
6049 ENDIF
6050 IF (abs(d(j,i))>d_max) THEN
6051 d_max= abs(d(j,i))
6052 nn2 = i
6053 k2 = j
6054 ENDIF
6055 IF (abs(dd(j,i))>dd_max) THEN
6056 dd_max= abs(dd(j,i))
6057 nn3 = i
6058 k3 = j
6059 ENDIF
6060 ELSE
6061 IF (abs(f(id))>fr_max) THEN
6062 fr_max= abs(f(id))
6063 iir = id
6064 nnr = i
6065 kr = j
6066 ENDIF
6067 IF (abs(dr(j-3,i))>dr_max) THEN
6068 dr_max= abs(dr(j-3,i))
6069 nn2r = i
6070 k2r = j
6071 ENDIF
6072 IF (abs(ddr(j-3,i))>ddr_max) THEN
6073 ddr_max= abs(ddr(j-3,i))
6074 nn3r = i
6075 k3r = j
6076 ENDIF
6077 ENDIF
6078 ENDIF
6079 ENDDO
6080 ENDDO
6081 IF (ii /= 0) fmax = f(ii)
6082 itabmax = itab(nn)
6083 IF (iir /= 0) frmax = f(iir)
6084 irtabmax = itab(nnr)
6085 IF (nn2 /= 0) dmax = d(k2,nn2)
6086 itabmax2 = itab(nn2)
6087 IF (nn2r /= 0) drmax = dr(k2r-3,nn2r)
6088 irtabmax2 = itab(nn2r)
6089 IF (nn3 /= 0) ddmax = dd(k3,nn3)
6090 itabmax3 = itab(nn3)
6091 IF (nn3r /= 0) ddrmax = ddr(k3r-3,nn3r)
6092 irtabmax3 = itab(nn3r)
6093c Compute maximum value F(II) with several processes in SPMD
6094 IF (nspmd>1) THEN
6095 CALL spmd_max_f(fmax,itabmax,k)
6096 CALL spmd_max_f(dmax,itabmax2,k2)
6097 CALL spmd_max_f(ddmax,itabmax3,k3)
6098 CALL spmd_max_f(frmax,irtabmax,kr)
6099 CALL spmd_max_f(drmax,irtabmax2,k2r)
6100 CALL spmd_max_f(ddrmax,irtabmax3,k3r)
6101 END IF
6102c Write solver information
6103 IF (ispmd==0) THEN
6104 IF (it == zero) THEN
6105 WRITE(isolinfo,1667) ncycle
6106 ENDIF
6107 WRITE(isolinfo,1060) it
6108 WRITE(isolinfo,1066) fmax,itabmax,k
6109 WRITE(isolinfo,1064) dmax,itabmax2,k2
6110 WRITE(isolinfo,1062) ddmax,itabmax3,k3
6111 WRITE(isolinfo,1065) frmax,irtabmax,kr
6112 WRITE(isolinfo,1063) drmax,irtabmax2,k2r
6113 WRITE(isolinfo,1061) ddrmax,irtabmax3,k3r
6114 WRITE (nodeid,'(I10)') itabmax
6115 cumul_it = i_imp(1)+it
6116c Write monitor file
6117 IF (k==0) THEN
6118 WRITE(isolmntr,1160) cumul_it,0,' MaxResidualForce ',nodeid//' ',fmax
6119 ELSEIF (k==1) THEN
6120 WRITE(isolmntr,1160) cumul_it,0,' MaxResidualForce ',nodeid//'_X',fmax
6121 ELSEIF (k==2) THEN
6122 WRITE(isolmntr,1160) cumul_it,0,' MaxResidualForce ',nodeid//'_Y',fmax
6123 ELSEIF (k==3) THEN
6124 WRITE(isolmntr,1160) cumul_it,0,' MaxResidualForce ',nodeid//'_Z',fmax
6125 ENDIF
6126c WRITE (NODEID,'(I10)') ITABMAX2
6127c IF (K2==0) THEN
6128c WRITE(ISOLMNTR,1160) CUMUL_IT,0,' MaxIncrementDisp ',NODEID//' ',DMAX
6129c ELSEIF (K2==1) THEN
6130c WRITE(ISOLMNTR,1160) CUMUL_IT,0,' MaxIncrementDisp ',NODEID//'_X',DMAX
6131c ELSEIF (K2==2) THEN
6132c WRITE(ISOLMNTR,1160) CUMUL_IT,0,' MaxIncrementDisp ',NODEID//'_Y',DMAX
6133c ELSEIF (K2==3) THEN
6134c WRITE(ISOLMNTR,1160) CUMUL_IT,0,' MaxIncrementDisp ',NODEID//'_Z',DMAX
6135c ENDIF
6136 WRITE (nodeid,'(I10)') itabmax3
6137 IF (k3==0) THEN
6138 WRITE(isolmntr,1160) cumul_it,0,' MaxCorrectionDisp ',nodeid//' ',ddmax
6139 ELSEIF (k3==1) THEN
6140 WRITE(isolmntr,1160) cumul_it,0,' MaxCorrectionDisp ',nodeid//'_X',ddmax
6141 ELSEIF (k3==2) THEN
6142 WRITE(isolmntr,1160) cumul_it,0,' MaxCorrectionDisp ',nodeid//'_Y',ddmax
6143 ELSEIF (k3==3) THEN
6144 WRITE(isolmntr,1160) cumul_it,0,' MaxCorrectionDisp ',nodeid//'_Z',ddmax
6145 ENDIF
6146 WRITE (nodeid,'(I10)') irtabmax
6147 IF (kr==0) THEN
6148 WRITE(isolmntr,1160) cumul_it,0,' MaxResidualMoment ',nodeid//' ',frmax
6149 ELSEIF (kr==4) THEN
6150 WRITE(isolmntr,1160) cumul_it,0,' MaxResidualMoment ',nodeid//'_X',frmax
6151 ELSEIF (kr==5) THEN
6152 WRITE(isolmntr,1160) cumul_it,0,' MaxResidualMoment ',nodeid//'_Y',frmax
6153 ELSEIF (kr==6) THEN
6154 WRITE(isolmntr,1160) cumul_it,0,' MaxResidualMoment ',nodeid//'_Z',frmax
6155 ENDIF
6156c WRITE (NODEID,'(I10)') IRTABMAX2
6157c IF (K2R==0) THEN
6158c WRITE(ISOLMNTR,1160) CUMUL_IT,0,' MaxIncrementRota ',NODEID//' ',DRMAX
6159c ELSEIF (K2R==4) THEN
6160c WRITE(ISOLMNTR,1160) CUMUL_IT,0,' MaxIncrementRota ',NODEID//'_X',DRMAX
6161c ELSEIF (K2R==5) THEN
6162c WRITE(ISOLMNTR,1160) CUMUL_IT,0,' MaxIncrementRota ',NODEID//'_Y',DRMAX
6163c ELSEIF (K2R==6) THEN
6164c WRITE(ISOLMNTR,1160) CUMUL_IT,0,' MaxIncrementRota ',NODEID//'_Z',DRMAX
6165c ENDIF
6166 WRITE (nodeid,'(I10)') irtabmax3
6167 IF (k3r==0) THEN
6168 WRITE(isolmntr,1160) cumul_it,0,' MaxCorrectionRota ',nodeid//' ',ddrmax
6169 ELSEIF (k3r==4) THEN
6170 WRITE(isolmntr,1160) cumul_it,0,' MaxCorrectionRota ',nodeid//'_X',ddrmax
6171 ELSEIF (k3r==5) THEN
6172 WRITE(isolmntr,1160) cumul_it,0,' MaxCorrectionRota ',nodeid//'_Y',ddrmax
6173 ELSEIF (k3r==6) THEN
6174 WRITE(isolmntr,1160) cumul_it,0,' MaxCorrectionRota ',nodeid//'_Z',ddrmax
6175 ENDIF
6176 WRITE(nodeid,'(I10)') 0
6177 WRITE(isolmntr,1160) cumul_it,0,' NormResidualDisp ',nodeid//' ',r_imp(20)
6178 WRITE(isolmntr,1160) cumul_it,0,' NormResidualForce ',nodeid//' ',r_imp(21)
6179 WRITE(isolmntr,1160) cumul_it,0,' NormResidualEnergy',nodeid//' ',r_imp(22)
6180 WRITE(isolmntr,1160) cumul_it,0,' DimContactMatrix ',nodeid//' ',float(i_imp(13))
6181 WRITE(isolmntr,1160) cumul_it,0,' TimeStep ',nodeid//' ',dt2
6182C CALL MY_FLUSH(ISOLMNTR)
6183 CALL flush(isolmntr)
6184 IF (imconv == 1) THEN
6185 IF (nitol == 1) THEN
6186 WRITE(isolinfo,1067)
6187 ELSE IF (nitol == 2) THEN
6188 WRITE(isolinfo,1069)
6189 ELSE IF (nitol == 3) THEN
6190 WRITE(isolinfo,1071)
6191 ELSE IF (nitol == 12) THEN
6192 WRITE(isolinfo,1073)
6193 ELSE IF (nitol == 13) THEN
6194 WRITE(isolinfo,1075)
6195 ELSE IF (nitol == 23) THEN
6196 WRITE(isolinfo,1077)
6197 ELSE IF (nitol == 123) THEN
6198 WRITE(isolinfo,1079)
6199 END IF
6200 ELSE IF (imconv == -2) THEN
6201 IF (nitol == 1) THEN
6202 WRITE(isolinfo,1068)
6203 ELSE IF (nitol == 2) THEN
6204 WRITE(isolinfo,1070)
6205 ELSE IF (nitol == 3) THEN
6206 WRITE(isolinfo,1072)
6207 ELSE IF (nitol == 12) THEN
6208 WRITE(isolinfo,1074)
6209 ELSE IF (nitol == 13) THEN
6210 WRITE(isolinfo,1076)
6211 ELSE IF (nitol == 23) THEN
6212 WRITE(isolinfo,1078)
6213 ELSE IF (nitol == 123) THEN
6214 WRITE(isolinfo,1080)
6215 END IF
6216 ENDIF
6217 IF (nitol == 1) THEN
6218 tole = n_tol
6219 tolf = em02
6220 tolu = em02
6221 ELSE IF (nitol == 2) THEN
6222 tole = em03
6223 tolf = n_tol
6224 tolu = em02
6225 ELSE IF (nitol == 3) THEN
6226 tole = em03
6227 tolf = em02
6228 tolu = n_tol
6229 ELSE IF (nitol == 12) THEN
6230 tole = n_tole
6231 tolf = n_tolf
6232 tolu = em02
6233 ELSE IF (nitol == 13) THEN
6234 tole = n_tole
6235 tolf = em02
6236 tolu = n_tolu
6237 ELSE IF (nitol == 23) THEN
6238 tole = em03
6239 tolf = n_tolf
6240 tolu = n_tolu
6241 ELSE IF (nitol == 123) THEN
6242 tole = n_tole
6243 tolf = n_tolf
6244 tolu = n_tolu
6245 END IF
6246 IF (imconv == -1) THEN
6247c Nothing since line search not ended
6248 ELSEIF (imconv == 0) THEN
6249 WRITE(isolhist,1666)cumul_it+1,ncycle,it,r_imp(20),
6250 . r_imp(21),r_imp(22),tole,tolf,tolu,
6251 . zero,zero,tt,r_imp(9)
6252 ELSEIF (imconv == 1) THEN
6253c Converged step
6254 IF (idtc==3) THEN
6255 WRITE(isolhist,1668)cumul_it+1,ncycle,it,r_imp(20),
6256 . r_imp(21),r_imp(22),tole,tolf,tolu,
6257 . zero,zero,tt,r_imp(9),tt,r_imp(24)
6258 WRITE(isolhist,1668)cumul_it+1,ncycle,it,r_imp(20),
6259 . r_imp(21),r_imp(22),tole,tolf,tolu,
6260 . one,zero,tt,r_imp(9),tt,r_imp(24)
6261 WRITE(isolhist,1668)cumul_it+1,ncycle,it,r_imp(20),
6262 . r_imp(21),r_imp(22),tole,tolf,tolu,
6263 . zero,zero,tt,r_imp(9),tt,r_imp(24)
6264 ELSE
6265 WRITE(isolhist,1666)cumul_it+1,ncycle,it,r_imp(20),
6266 . r_imp(21),r_imp(22),tole,tolf,tolu,
6267 . zero,zero,tt,r_imp(9)
6268 WRITE(isolhist,1666)cumul_it+1,ncycle,it,r_imp(20),
6269 . r_imp(21),r_imp(22),tole,tolf,tolu,
6270 . one,zero,tt,r_imp(9)
6271 WRITE(isolhist,1666)cumul_it+1,ncycle,it,r_imp(20),
6272 . r_imp(21),r_imp(22),tole,tolf,tolu,
6273 . zero,zero,tt,r_imp(9)
6274 ENDIF
6275c Write .progress file
6276 rewind(isolpgrs)
6277 WRITE(isolpgrs,'(I4)') cumul_it
6278 WRITE(isolpgrs,'(E11.4)') tt
6279 WRITE(isolpgrs,'(I4)') nint(tt/tstop*hundred)
6280 WRITE(isolpgrs,'(I4)') 0
6281 WRITE(isolpgrs,'(I4)') 0
6282 CALL flush(isolpgrs)
6283 ELSEIF (imconv == -2) THEN
6284c Diverged step
6285 WRITE(isolhist,1666)cumul_it+1,ncycle,it,r_imp(20),
6286 . r_imp(21),r_imp(22),tole,tolf,tolu,
6287 . zero,zero,tt,r_imp(9)
6288 WRITE(isolhist,1666)cumul_it+1,ncycle,it,r_imp(20),
6289 . r_imp(21),r_imp(22),tole,tolf,tolu,
6290 . zero,one,tt,r_imp(9)
6291 WRITE(isolhist,1666)cumul_it+1,ncycle,it,r_imp(20),
6292 . r_imp(21),r_imp(22),tole,tolf,tolu,
6293 . zero,zero,tt,r_imp(9)
6294 ENDIF
6295 ENDIF
62961060 FORMAT(' ITERATION',i4)
62971061 FORMAT(' LARGEST CORRECTION ROTA. ',e11.4,
6298 . ' AT NODE ',i10,' DOF ',i4)
62991062 FORMAT(' LARGEST CORRECTION DISP. ',e11.4,
6300 . ' AT NODE ',i10,' DOF ',i4)
63011063 FORMAT(' LARGEST INCREMENT ROTA. ',e11.4,
6302 . ' AT NODE ',i10,' DOF ',i4)
63031064 FORMAT(' LARGEST INCREMENT DISP. ',e11.4,
6304 . ' AT NODE ',i10,' DOF ',i4)
63051065 FORMAT(' LARGEST RESIDUAL MOMENT ',e11.4,
6306 . ' AT NODE ',i10,' DOF ',i4)
63071066 FORMAT(' LARGEST RESIDUAL FORCE ',e11.4,
6308 . ' AT NODE ',i10,' DOF ',i4)
63091067 FORMAT(' ACCEPTED EQUILIBRIUM BASED ON SMALL RESIDUAL ENERGY')
63101068 FORMAT(' REJECTED EQUILIBRIUM BASED ON SMALL RESIDUAL ENERGY')
63111069 FORMAT(' ACCEPTED EQUILIBRIUM BASED ON SMALL RESIDUAL FORCE')
63121070 FORMAT(' REJECTED EQUILIBRIUM BASED ON SMALL RESIDUAL FORCE')
63131071 FORMAT(' ACCEPTED EQUILIBRIUM BASED ON SMALL RESIDUAL DISP.')
63141072 FORMAT(' REJECTED EQUILIBRIUM BASED ON SMALL RESIDUAL DISP.')
63151073 FORMAT(' ACCEPTED EQUILIBRIUM BASED ON SMALL RESIDUAL ENERGY AND FORCE')
63161074 FORMAT(' REJECTED EQUILIBRIUM BASED ON SMALL RESIDUAL ENERGY AND FORCE')
63171075 FORMAT(' ACCEPTED EQUILIBRIUM BASED ON SMALL RESIDUAL ENERGY AND DISP.')
63181076 FORMAT(' REJECTED EQUILIBRIUM BASED ON SMALL RESIDUAL ENERGY AND DISP.')
63191077 FORMAT(' ACCEPTED EQUILIBRIUM BASED ON SMALL RESIDUAL FORCE AND DISP.')
63201078 FORMAT(' REJECTED EQUILIBRIUM BASED ON SMALL RESIDUAL FORCE AND DISP.')
63211079 FORMAT(' ACCEPTED EQUILIBRIUM BASED ON SMALL RESIDUAL ENERGY, FORCE AND DISP.')
63221080 FORMAT(' REJECTED EQUILIBRIUM BASED ON SMALL RESIDUAL ENERGY, FORCE AND DISP.')
63231666 FORMAT(i10,',',i10,',',i10,',',e10.2,',',e10.2,',',e10.2,',',e10.2,',',e10.2,',',e10.2,',',e10.2,
6324 . ',',e10.2,',',e10.2,',',e10.2)
63251667 FORMAT(' * CYCLE',i6)
63261668 FORMAT(i10,',',i10,',',i10,',',e10.2,',',e10.2,',',e10.2,',',e10.2,',',e10.2,',',e10.2,',',e10.2,
6327 . ',',e10.2,',',e10.2,',',e10.2,',',e10.2,',',e10.2)
63281160 FORMAT(i6,i6,a19,a12,e12.4)
6329C------------------------------------------
6330 RETURN
6331 END
6332
6333!||====================================================================
6334!|| write_tpl_file ../engine/source/implicit/imp_solv.F
6335!||--- called by ------------------------------------------------------
6336!|| radioss2 ../engine/source/engine/radioss2.F
6337!||====================================================================
6338 SUBROUTINE write_tpl_file(FILNAM,IOFF1,IOFF2,IOFF3)
6339C-----------------------------------------------
6340C M o d u l e s
6341C-----------------------------------------------
6342
6343C-----------------------------------------------
6344C I m p l i c i t T y p e s
6345C-----------------------------------------------
6346#include "implicit_f.inc"
6347C-----------------------------------------------
6348C C o m m o n B l o c k s
6349C-----------------------------------------------
6350#include "impl1_c.inc"
6351C-----------------------------------------------
6352C D u m m y A r g u m e n t s
6353C-----------------------------------------------
6354C REAL
6355 CHARACTER(*) FILNAM,IOFF1,IOFF2,IOFF3
6356 my_real
6357 . R01
6358C-----------------------------------------------
6359c FUNCTION: print-out tcp file
6360C-----------------------------------------------
6361C L o c a l V a r i a b l e s
6362C-----------------------------------------------
6363 INTEGER I,J
6364 my_real
6365 . f_max
6366C-----------------------------------------------
6367 WRITE(isoltpl,1000) filnam
6368 WRITE(isoltpl,1001)
6369 WRITE(isoltpl,1002) ioff2,1,4,1,3,4,1,'Residual force',1
6370 . ,'Residual force','Residual force','Residual force'
6371 . ,'Residual force','Residual force','Residual force'
6372 WRITE(isoltpl,1002) ioff2,1,4,1,0,4,1,'Tolerance force',1
6373 . ,'Tolerance force','Tolerance force','Tolerance force'
6374 . ,'Tolerance force','Tolerance force','Tolerance force'
6375 WRITE(isoltpl,1002) ioff3,1,46,1,3,46,1,'Residual disp.',1
6376 . ,'Residual disp.','Residual disp.','Residual disp.'
6377 . ,'Residual disp.','Residual disp.','Residual disp.'
6378 WRITE(isoltpl,1002) ioff3,1,46,1,0,4,1,'Tolerance disp.',1
6379 . ,'Tolerance disp.','Tolerance disp.','Tolerance disp.'
6380 . ,'Tolerance disp.','Tolerance disp.','Tolerance disp.'
6381 WRITE(isoltpl,1002) ioff1,1,0,1,3,0,1,'Residual energy',1
6382 . ,'Residual energy','Residual energy','Residual energy'
6383 . ,'Residual energy','Residual energy','Residual energy'
6384 WRITE(isoltpl,1002) ioff1,1,0,1,0,4,1,'Tolerance energy',1
6385 . ,'Tolerance energy','Tolerance energy','Tolerance energy'
6386 . ,'Tolerance energy','Tolerance energy','Tolerance energy'
6387 WRITE(isoltpl,1002) 'On',1,55,1,0,55,1,'Converged step',2
6388 . ,'Converged step','Converged step','Converged step'
6389 . ,'Converged step','Converged step','Converged step'
6390 WRITE(isoltpl,1002) 'On',1,2,1,0,2,1,'Diverged step',2
6391 . ,'Diverged step','Diverged step','Diverged step'
6392 . ,'Diverged step','Diverged step','Diverged step'
6393 WRITE(isoltpl,1003)
6394 WRITE(isoltpl,1004) 2,2,2,'Cumulative iterations','Line search coeff'
6395 WRITE(isoltpl,1002) 'On',1,50,1,3,50,1,'Line search coefficient',1
6396 . ,'Line search coefficient','Line search coefficient','Line search coefficient'
6397 . ,'Line search coefficient','Line search coefficient','Line search coefficient'
6398 WRITE(isoltpl,1003)
6399 IF (idtc==3) THEN
6400 WRITE(isoltpl,1004) 3,3,3,'Arc length','load factor'
6401 WRITE(ISOLTPL,1006) 'on',1,27,1,3,27,1,'load factor',1
6402 . ,'load factor','load factor','load factor'
6403 . ,'load factor','load factor','load factor'
6404 ELSE
6405 WRITE(ISOLTPL,1004) 3,3,3,'cumulative iterations','time(s)'
6406 WRITE(ISOLTPL,1002) 'on',1,27,1,3,27,1,'time',1
6407 . ,'time','time','time'
6408 . ,'time','time','time'
6409 ENDIF
6410 WRITE(ISOLTPL,1005)
64111000 FORMAT(' *beginpage() // page 1'/
6412 . ' *title("',A,'", on)'/
6413 . ' *titlefont("Arial", 1, 0, 12)'/
6414 . ' *layout(9)'/
6415c . ' *BeginAnimator(Transient)'/
6416c . ' *CurrentTime(Undeformed)'/
6417c . ' *StartTime(0,0000000)'/
6418c . ' *EndTime(1,0000000)'/
6419c . ' *Increment(Forward, Frame, 1, BounceOff)'/
6420c . ' *EndAnimator()'/
6421 . ' *windowids(191, 192, 193)'
6422 . )
64231001 FORMAT(' *exportformat("PNG")'/
6424 . ' *beginplot()'/
6425 . ' *plottype(0)'/
6426 . ' *beginplotheader(on)'/
6427 . ' *primaryfont("Arial", 0, 0, 14)'/
6428 . ' *secondaryfont("Arial", 0, 0, 10)'/
6429 . ' *tertiaryfont("Arial", 0, 0, 10)'/
6430 . ' *color(0)'/
6431 . ' *text("Relative residuals")'/
6432 . ' *headeralignment(2)'/
6433 . ' *endplotheader()'/
6434 . ' *beginplotfooter(off)'/
6435 . ' *primaryfont("Arial", 0, 0, 10)'/
6436 . ' *secondaryfont("Arial", 0, 0, 10)'/
6437 . ' *tertiaryfont("Arial", 0, 0, 10)'/
6438 . ' *color(0)'/
6439 . ' *text("{p1w1c1.y.HWRequest} - {p1w1c1.y.HWComponent}")'/
6440 . ' *footeralignment(2)'/
6441 . ' *endplotfooter()'/
6442 . ' *beginlegend(on)'/
6443 . ' *font("Arial", 0, 0, 8)'/
6444 . ' *borderwidth(1)'/
6445 . ' *color(0)'/
6446 . ' *leader(left)'/
6447 . ' *location(below)'/
6448 . ' *autoposition(false)'/
6449 . ' *reversed(no)'/
6450 . ' *endlegend()'/
6451 . ' *UniformAspectRatio(0)'/
6452 . ' *FrameColor(66)'/
6453 . ' *BackgroundColor(1)'/
6454 . ' *GridLineColor(9)'/
6455 . ' *ZeroLineColor(0)'/
6456 . ' *BeginAxis(X, "Primary", on)'/
6457 . ' *Label("Cumulative iterations")'/
6458 . ' *Scale(Linear)'/
6459 . ' *TicMethod(Increment)'/
6460 . ' *Min(0)'/
6461 . ' *Max(1)'/
6462 . ' *Format(Auto)'/
6463 . ' *Precision(5)'/
6464 . ' *Increment(10)'/
6465 . ' *Grids(1)'/
6466 . ' *Color(67)'/
6467 . ' *AutoFit(TRUE)'/
6468 . ' *LabelFont("Arial", 0, 0, 10)'/
6469 . ' *TicsFont("Arial", 0, 0, 8)'/
6470 . ' *FitRange(FALSE)'/
6471 . ' *EndAxis()'/
6472 . ' *BeginAxis(Y, "Primary", on)'/
6473 . ' *Label("Relative residual")'/
6474 . ' *Scale(Log)'/
6475 . ' *TicMethod(PerAxis)'/
6476 . ' *Min(0)'/
6477 . ' *Max(1)'/
6478 . ' *Format(Auto)'/
6479 . ' *Precision(4)'/
6480 . ' *TicsPerDecade(1)'/
6481 . ' *GridsPerDecade(1)'/
6482 . ' *Color(67)'/
6483 . ' *AutoFit(TRUE)'/
6484 . ' *LabelFont("Arial", 0, 0, 10)'/
6485 . ' *TicsFont("Arial", 0, 0, 8)'/
6486 . ' *FitRange(FALSE)'/
6487 . ' *EndAxis()'/
6488 . ' *BeginAxis(Y, "Y1", on)'/
6489 . ' *Label("")'/
6490 . ' *Scale(Linear)'/
6491 . ' *TicMethod(PerAxis)'/
6492 . ' *Min(0)'/
6493 . ' *Max(1)'/
6494 . ' *Format(Auto)'/
6495 . ' *Precision(0)'/
6496 . ' *Tics(2)'/
6497 . ' *Grids(2)'/
6498 . ' *Color(67)'/
6499 . ' *AutoFit(TRUE)'/
6500 . ' *LabelFont("Arial", 0, 0, 8)'/
6501 . ' *TicsFont("Arial", 0, 0, 8)'/
6502 . ' *FitRange(FALSE)'/
6503 . ' *EndAxis()'
6504 . )
65051002 FORMAT(' *BeginCurve(',a,', "{y.HWComponent}")'/
6506 . ' *Line(',i2,',',i2,',',i2,')'/
6507 . ' *Symbol(',i2,',',i2,',',i2,')'/
6508 . ' *Shade(False)'/
6509 . ' *Bar(0, 0, 2)'/
6510 . ' *ShowInLegend(True)'/
6511 . ' *LayerNumber(31)'/
6512 . ' *BeginVector(Y, File)'/
6513 . ' *Filename(PLOT_FILE_1)'/
6514 . ' *Datatype("Unknown")'/
6515 . ' *Request("Block 1")'/
6516 . ' *Component("',a,'")'/
6517 . ' *ScaleFactor("1")'/
6518 . ' *Offset("0")'/
6519 . ' *AxisIndex(',i1,')'/
6520 . ' *Attribute("HWReaderHints", "HWReaderHints", "String", "(USE_RXRESULT_READER_FOR_DSY)")'/
6521 . ' *Attribute("HWFile", "File", "String", PLOT_FILE_1)'/
6522 . ' *Attribute("HWSolver", "Solver", "String", "Unknown")'/
6523 . ' *Attribute("HWDatatype", "Datatype", "String", "Unknown")'/
6524 . ' *Attribute("HWRequest", "Request", "String", "Block 1")'/
6525 . ' *Attribute("HWComponent", "Component", "String", "',a,'")'/
6526 . ' *Attribute("HWComplexComponent", "ComplexComponent", "String", "',a,'")'/
6527 . ' *Attribute("HWReader", "Reader", "String", "hgtextcolumn.exe")'/
6528 . ' *Attribute("HWWordSize", "WordSize", "String", "8")'/
6529 . ' *EndVector()'/
6530 . ' *BeginVector(X, File)'/
6531 . ' *Filename(PLOT_FILE_1)'/
6532 . ' *Datatype("Unknown")'/
6533 . ' *Request("Block 1")'/
6534 . ' *Component("Cumulative iterations")'/
6535 . ' *ScaleFactor("1")'/
6536 . ' *Offset("0")'/
6537 . ' *AxisIndex(1)'/
6538 . ' *Attribute("HWReaderHints", "HWReaderHints", "String", "(USE_RXRESULT_READER_FOR_DSY)")'/
6539 . ' *Attribute("HWFile", "File", "String", PLOT_FILE_1)'/
6540 . ' *Attribute("HWSolver", "Solver", "String", "Unknown")'/
6541 . ' *Attribute("HWDatatype", "Datatype", "String", "Unknown")'/
6542 . ' *Attribute("HWRequest", "Request", "String", "Block 1")'/
6543 . ' *Attribute("HWComponent", "Component", "String", "Cumulative iterations")'/
6544 . ' *Attribute("HWComplexComponent", "ComplexComponent", "String", "Cumulative iterations")'/
6545 . ' *Attribute("HWReader", "Reader", "String", "hgtextcolumn.exe")'/
6546 . ' *Attribute("HWWordSize", "WordSize", "String", "8")'/
6547 . ' *endvector()'/
6548 . ' *beginvector(time, file)'/
6549 . ' *filename(plot_file_1)'/
6550 . ' *datatype("Time")'/
6551 . ' *scalefactor("1")'/
6552 . ' *offset("0")'/
6553 . ' *attribute("HWReaderHints", "HWReaderHints", "String", "(USE_RXRESULT_READER_FOR_DSY)")'/
6554 . ' *attribute("HWFile", "File", "String", plot_file_1)'/
6555 . ' *attribute("HWSolver", "Solver", "String", "Unknown")'/
6556 . ' *attribute("HWDatatype", "Datatype", "String", "Time")'/
6557 . ' *attribute("HWRequest", "Request", "String", "Time")'/
6558 . ' *attribute("HWComponent", "Component", "String", "Time")'/
6559 . ' *attribute("HWComplexComponent", "ComplexComponent", "string", "time")'/
6560 . ' *Attribute("hwreader", "reader", "string", "hgtextcolumn.exe")'/
6561 . ' *Attribute("hwwordsize", "wordsize", "string", "8")'/
6562 . ' *EndVector()'/
6563 . ' *BeginVector(U, File)'/
6564 . ' *Filename(PLOT_FILE_1)'/
6565 . ' *Datatype("unknown")'/
6566 . ' *Request("block 1")'/
6567 . ' *Component("cumulative iterations")'/
6568 . ' *scalefactor("1")'/
6569 . ' *offset("0")'/
6570 . ' *axisindex(1)'/
6571 . ' *attribute("HWReaderHints", "HWReaderHints", "String", "(USE_RXRESULT_READER_FOR_DSY)")'/
6572 . ' *attribute("HWFile", "File", "String", plot_file_1)'/
6573 . ' *attribute("HWSolver", "Solver", "String", "Unknown")'/
6574 . ' *attribute("HWDatatype", "Datatype", "String", "Unknown")'/
6575 . ' *attribute("HWRequest", "Request", "String", "Block 1")'/
6576 . ' *attribute("HWComponent", "Component", "String", "Cumulative iterations")'/
6577 . ' *attribute("HWComplexComponent", "ComplexComponent", "String", "Cumulative iterations")'/
6578 . ' *attribute("HWReader", "Reader", "String", "hgtextcolumn.exe")'/
6579 . ' *attribute("HWWordSize", "WordSize", "String", "8")'/
6580 . ' *EndVector()'/
6581 . ' *BeginVector(V, File)'/
6582 . ' *Filename(PLOT_FILE_1)'/
6583 . ' *Datatype("unknown")'/
6584 . ' *Request("block 1")'/
6585 . ' *Component("',A,'")'/
6586 . ' *ScaleFactor("1")'/
6587 . ' *Offset("0")'/
6588 . ' *AxisIndex(1)'/
6589 . ' *Attribute("hwreaderhints", "hwreaderhints", "string", "(use_rxresult_reader_for_dsy)")'/
6590 . ' *Attribute("hwfile", "file", "string", PLOT_FILE_1)'/
6591 . ' *Attribute("hwsolver", "solver", "string", "unknown")'/
6592 . ' *Attribute("hwdatatype", "datatype", "string", "unknown")'/
6593 . ' *Attribute("hwrequest", "request", "string", "block 1")'/
6594 . ' *Attribute("hwcomponent", "component", "string", "',A,'")'/
6595 . ' *Attribute("hwcomplexcomponent", "complexcomponent", "string", "',A,'")'/
6596 . ' *Attribute("hwreader", "reader", "string", "hgtextcolumn.exe")'/
6597 . ' *Attribute("hwwordsize", "wordsize", "string", "8")'/
6598 . ' *EndVector()'/
6599 . ' *Attribute("hwlastgoodcurvename", "hwlastgoodcurvename", "string", "',A,'")'/
6600 . ' *EndCurve()'
6601 . )
66021003 FORMAT(' *EndPlot()')
66031004 FORMAT(' *ExportFormat("png")'/
6604 . ' *BeginPlot()'/
6605 . ' *PlotType(0)'/
6606 . ' *BeginPlotHeader(On)'/
6607 . ' *PrimaryFont("arial", 0, 0, 14)'/
6608 . ' *SecondaryFont("arial", 0, 0, 10)'/
6609 . ' *TertiaryFont("arial", 0, 0, 10)'/
6610 . ' *Color(0)'/
6611 . ' *Text("{p1w',I1,'c1.y.hwcomponent}")'/
6612 . ' *HeaderAlignment(2)'/
6613 . ' *EndPlotHeader()'/
6614 . ' *BeginPlotFooter(Off)'/
6615 . ' *PrimaryFont("arial", 0, 0, 10)'/
6616 . ' *SecondaryFont("arial", 0, 0, 10)'/
6617 . ' *TertiaryFont("arial", 0, 0, 10)'/
6618 . ' *Color(0)'/
6619 . ' *Text("{p1w',I1,'c1.y.hwrequest} - {p1w',I1,'c1.y.hwcomponent}")'/
6620 . ' *FooterAlignment(2)'/
6621 . ' *EndPlotFooter()'/
6622 . ' *BeginLegend(On)'/
6623 . ' *Font("arial", 0, 0, 8)'/
6624 . ' *BorderWidth(1)'/
6625 . ' *Color(0)'/
6626 . ' *Leader(Left)'/
6627 . ' *Location(BELOW)'/
6628 . ' *AutoPosition(False)'/
6629 . ' *Reversed(no)'/
6630 . ' *EndLegend()'/
6631 . ' *UniformAspectRatio(0)'/
6632 . ' *FrameColor(66)'/
6633 . ' *BackgroundColor(1)'/
6634 . ' *GridLineColor(9)'/
6635 . ' *ZeroLineColor(0)'/
6636 . ' *BeginAxis(X, "primary", on)'/
6637 . ' *Label("',A,'")'/
6638 . ' *Scale(Linear)'/
6639 . ' *TicMethod(Increment)'/
6640 . ' *Min(0)'/
6641 . ' *Max(1)'/
6642 . ' *Format(Auto)'/
6643 . ' *Precision(5)'/
6644 . ' *Increment(10)'/
6645 . ' *Grids(1)'/
6646 . ' *Color(67)'/
6647 . ' *AutoFit(TRUE)'/
6648 . ' *LabelFont("arial", 0, 0, 10)'/
6649 . ' *TicsFont("arial", 0, 0, 8)'/
6650 . ' *FitRange(FALSE)'/
6651 . ' *EndAxis()'/
6652 . ' *BeginAxis(Y, "primary", on)'/
6653 . ' *Label("',A,'")'/
6654 . ' *Scale(Linear)'/
6655 . ' *TicMethod(PerAxis)'/
6656 . ' *Min(0)'/
6657 . ' *Max(1)'/
6658 . ' *Format(Auto)'/
6659 . ' *Precision(5)'/
6660 . ' *Tics(11)'/
6661 . ' *Grids(1)'/
6662 . ' *Color(67)'/
6663 . ' *AutoFit(TRUE)'/
6664 . ' *LabelFont("arial", 0, 0, 10)'/
6665 . ' *TicsFont("arial", 0, 0, 8)'/
6666 . ' *FitRange(FALSE)'/
6667 . ' *EndAxis()'
6668 . )
66691005 FORMAT(' *EndPlot()'/
6670 . ' *TimeScales(1, 1, 1)'/
6671 . ' *TimeDelays(0, 0, 0)'/
6672 . ' *AnimationEnable(1, 1, 1)'/
6673 . ' *SyncTolerance(2e-008)'/
6674 . ' *SyncTableGenerationPolicy(ALL_BLOCKS)'/
6675 . ' *EndPage()'/
6676 . '*EndDefine()'
6677 . )
66781006 FORMAT(' *BeginCurve(',A,', "{y.hwcomponent}")'/
6679 . ' *Line(',I2,',',I2,',',I2,')'/
6680 . ' *Symbol(',I2,',',I2,',',I2,')'/
6681 . ' *Shade(False)'/
6682 . ' *Bar(0, 0, 2)'/
6683 . ' *ShowInLegend(True)'/
6684 . ' *LayerNumber(31)'/
6685 . ' *BeginVector(Y, File)'/
6686 . ' *Filename(PLOT_FILE_1)'/
6687 . ' *Datatype("unknown")'/
6688 . ' *Request("block 1")'/
6689 . ' *Component("',A,'")'/
6690 . ' *ScaleFactor("1")'/
6691 . ' *Offset("0")'/
6692 . ' *AxisIndex(',I1,')'/
6693 . ' *Attribute("hwreaderhints", "hwreaderhints", "string", "(use_rxresult_reader_for_dsy)")'/
6694 . ' *Attribute("hwfile", "file", "string", PLOT_FILE_1)'/
6695 . ' *Attribute("hwsolver", "solver", "string", "unknown")'/
6696 . ' *Attribute("hwdatatype", "datatype", "string", "unknown")'/
6697 . ' *Attribute("hwrequest", "request", "string", "block 1")'/
6698 . ' *attribute("HWComponent", "Component", "String", "',A,'")'/
6699 . ' *attribute("HWComplexComponent", "ComplexComponent", "String", "',A,'")'/
6700 . ' *attribute("HWReader", "Reader", "String", "hgtextcolumn.exe")'/
6701 . ' *attribute("HWWordSize", "WordSize", "String", "8")'/
6702 . ' *endvector()'/
6703 . ' *beginvector(x, file)'/
6704 . ' *filename(plot_file_1)'/
6705 . ' *datatype("Unknown")'/
6706 . ' *request("Block 1")'/
6707 . ' *component("Arc length")'/
6708 . ' *scalefactor("1")'/
6709 . ' *offset("0")'/
6710 . ' *axisindex(1)'/
6711 . ' *attribute("HWReaderHints", "HWReaderHints", "String", "(USE_RXRESULT_READER_FOR_DSY)")'/
6712 . ' *attribute("HWFile", "File", "String", plot_file_1)'/
6713 . ' *attribute("HWSolver", "Solver", "String", "Unknown")'/
6714 . ' *attribute("HWDatatype", "Datatype", "String", "Unknown")'/
6715 . ' *attribute("HWRequest", "Request", "String", "Block 1")'/
6716 . ' *attribute("HWComponent", "Component", "String", "Arc length")'/
6717 . ' *attribute("HWComplexComponent", "ComplexComponent", "String", "Arc length")'/
6718 . ' *attribute("HWReader", "Reader", "String", "hgtextcolumn.exe")'/
6719 . ' *attribute("HWWordSize", "WordSize", "String", "8")'/
6720 . ' *endvector()'/
6721 . ' *beginvector(time, file)'/
6722 . ' *filename(plot_file_1)'/
6723 . ' *datatype("Time")'/
6724 . ' *scalefactor("1")'/
6725 . ' *offset("0")'/
6726 . ' *attribute("hwreaderhints", "hwreaderhints", "string", "(use_rxresult_reader_for_dsy)")'/
6727 . ' *Attribute("hwfile", "file", "string", PLOT_FILE_1)'/
6728 . ' *Attribute("hwsolver", "solver", "string", "unknown")'/
6729 . ' *Attribute("hwdatatype", "datatype", "string", "time")'/
6730 . ' *Attribute("hwrequest", "request", "string", "time")'/
6731 . ' *Attribute("hwcomponent", "component", "string", "time")'/
6732 . ' *Attribute("hwcomplexcomponent", "complexcomponent", "String", "Time")'/
6733 . ' *attribute("HWReader", "Reader", "String", "hgtextcolumn.exe")'/
6734 . ' *attribute("HWWordSize", "WordSize", "String", "8")'/
6735 . ' *endvector()'/
6736 . ' *beginvector(u, file)'/
6737 . ' *filename(plot_file_1)'/
6738 . ' *datatype("Unknown")'/
6739 . ' *request("Block 1")'/
6740 . ' *component("Arc length")'/
6741 . ' *scalefactor("1")'/
6742 . ' *offset("0")'/
6743 . ' *axisindex(1)'/
6744 . ' *attribute("HWReaderHints", "HWReaderHints", "String", "(USE_RXRESULT_READER_FOR_DSY)")'/
6745 . ' *attribute("HWFile", "File", "String", plot_file_1)'/
6746 . ' *attribute("HWSolver", "Solver", "String", "Unknown")'/
6747 . ' *attribute("HWDatatype", "Datatype", "String", "Unknown")'/
6748 . ' *attribute("HWRequest", "Request", "String", "Block 1")'/
6749 . ' *attribute("HWComponent", "Component", "String", "Arc length")'/
6750 . ' *attribute("HWComplexComponent", "ComplexComponent", "String", "Arc length")'/
6751 . ' *attribute("HWReader", "Reader", "String", "hgtextcolumn.exe")'/
6752 . ' *attribute("HWWordSize", "WordSize", "String", "8")'/
6753 . ' *endvector()'/
6754 . ' *beginvector(v, file)'/
6755 . ' *filename(plot_file_1)'/
6756 . ' *datatype("Unknown")'/
6757 . ' *request("Block 1")'/
6758 . ' *component("',A,'")'/
6759 . ' *scalefactor("1")'/
6760 . ' *offset("0")'/
6761 . ' *axisindex(1)'/
6762 . ' *attribute("HWReaderHints", "HWReaderHints", "String", "(USE_RXRESULT_READER_FOR_DSY)")'/
6763 . ' *attribute("HWFile", "File", "String", plot_file_1)'/
6764 . ' *attribute("HWSolver", "Solver", "String", "Unknown")'/
6765 . ' *attribute("HWDatatype", "Datatype", "String", "Unknown")'/
6766 . ' *attribute("HWRequest", "Request", "String", "Block 1")'/
6767 . ' *attribute("HWComponent", "Component", "String", "',A,'")'/
6768 . ' *attribute("HWComplexComponent", "ComplexComponent", "String", "',A,'")'/
6769 . ' *attribute("HWReader", "Reader", "String", "hgtextcolumn.exe")'/
6770 . ' *attribute("HWWordSize", "WordSize", "String", "8")'/
6771 . ' *endvector()'/
6772 . ' *attribute("HWLastGoodCurveName", "HWLastGoodCurveName", "String", "',A,'")'/
6773 . ' *endcurve()'
6774 . )
6775C------------------------------------------
6776 RETURN
6777 END
6778c
6779!||====================================================================
6780!|| int5_diverg ../engine/source/implicit/imp_solv.F
6781!||--- called by ------------------------------------------------------
6782!|| imp_solv ../engine/source/implicit/imp_solv.F
6783!||====================================================================
6784 SUBROUTINE INT5_DIVERG(IPARI )
6785C-----------------------------------------------
6786C I m p l i c i t T y p e s
6787C-----------------------------------------------
6788#include "implicit_f.inc"
6789C-----------------------------------------------
6790C C o m m o n B l o c k s
6791C-----------------------------------------------
6792#include "com04_c.inc"
6793#include "param_c.inc"
6794C-----------------------------------------------
6795C D u m m y A r g u m e n t s
6796C-----------------------------------------------
6797 INTEGER IPARI(NPARI,*)
6798C REAL
6799C-----------------------------------------------
6800C L o c a l V a r i a b l e s
6801C-----------------------------------------------
6802 INTEGER N, NTY
6803C--------------------------------------------
6804 DO N=1,NINTER
6805 NTY =IPARI(7,N)
6806C-----------------------------------------------------------------------
6807 IF(NTY == 5 ) THEN
6808C-----------------------------------------------------------------------
6809 IPARI(16,N)=IPARI(16,N)-1
6810C-----------------------------------------------------------------------
6811 ELSEIF(NTY == 10)THEN
6812C-----------------------------------------------------------------------
6813C-----------------------------------------------------------------------
6814 ELSEIF(NTY == 11)THEN
6815C-----------------------------------------------------------------------
6816C-----------------------------------------------------------------------
6817 ELSEIF(NTY == 24 ) THEN
6818C-----------------------------------------------------------------------
6819C-----------------------------------------------------------------------
6820 ENDIF
6821 END DO
6822C-----------------------------------------------------------------------
6823 RETURN
6824 END
6825!||====================================================================
6826!|| dis_cp ../engine/source/implicit/imp_solv.F
6827!||--- called by ------------------------------------------------------
6828!|| imp_solv ../engine/source/implicit/imp_solv.F
6829!||--- calls -----------------------------------------------------
6830!|| cp_real ../engine/source/implicit/produt_v.F
6831!||--- uses -----------------------------------------------------
6832!|| imp_qstat ../engine/share/modules/impbufdef_mod.F
6833!||====================================================================
6834 SUBROUTINE DIS_CP(N ,D ,DR ,IFLAG )
6835C-----------------------------------------------
6836C M o d u l e s
6837C-----------------------------------------------
6838 USE IMP_QSTAT
6839C-----------------------------------------------
6840C I m p l i c i t T y p e s
6841C-----------------------------------------------
6842#include "implicit_f.inc"
6843C-----------------------------------------------
6844C C o m m o n B l o c k s
6845C-----------------------------------------------
6846#include "com01_c.inc"
6847C-----------------------------------------------
6848C D u m m y A r g u m e n t s
6849C-----------------------------------------------
6850 INTEGER N,IFLAG
6851C REAL
6852 my_real
6853 . D(*),DR(*)
6854C-----------------------------------------------
6855C L o c a l V a r i a b l e s
6856C-----------------------------------------------
6857 INTEGER I,ND
6858C------------------------------------------
6859 IF (IFLAG ==0 ) THEN
6860 CALL CP_REAL(N,D, D_N_1)
6861 IF (IRODDL/=0) CALL CP_REAL(N,DR, DR_N_1)
6862 ELSE
6863 CALL CP_REAL(N,D_N_1 ,D )
6864 IF (IRODDL/=0) CALL CP_REAL(N,DR_N_1,DR )
6865 END IF
6866C------------------------------------------
6867 RETURN
6868 END
6869!||====================================================================
6870!|| imp_smpini ../engine/source/implicit/imp_solv.F
6871!||--- called by ------------------------------------------------------
6872!|| b_correct_hp ../engine/source/implicit/nl_solv.F
6873!|| cp_int_hp ../engine/source/implicit/produt_v.F
6874!|| cp_real_hp ../engine/source/implicit/produt_v.F
6875!|| du_ini_hp ../engine/source/implicit/imp_solv.F
6876!|| frac_d_hp ../engine/source/implicit/integrator.F
6877!|| frac_dd_hp ../engine/source/implicit/integrator.F
6878!|| integrator1_hp ../engine/source/implicit/integrator.F
6879!|| integrator2_hp ../engine/source/implicit/integrator.F
6880!|| integrator_hp ../engine/source/implicit/integrator.F
6881!|| integratorl_hp ../engine/source/implicit/integrator.F
6882!|| lin_solv ../engine/source/implicit/lin_solv.F
6883!|| mumpslb_hp ../engine/source/implicit/lin_solv.F
6884!|| produt_hp ../engine/source/implicit/produt_v.F
6885!|| produt_uhp0 ../engine/source/implicit/produt_v.F
6886!|| vaxpy_hp ../engine/source/implicit/produt_v.F
6887!|| vscal_hp ../engine/source/implicit/produt_v.F
6888!|| vscaly_hp ../engine/source/implicit/produt_v.F
6889!|| zeror_hp ../engine/source/implicit/produt_v.F
6890!||--- calls -----------------------------------------------------
6891!|| omp_get_thread_num ../engine/source/engine/openmp_stub.F90
6892!||====================================================================
6893 SUBROUTINE IMP_SMPINI(
6894 1 ITSK ,N1FTSK ,N1LTSK ,N1 )
6895C-----------------------------------------------
6896C I m p l i c i t T y p e s
6897C-----------------------------------------------
6898#include "implicit_f.inc"
6899C-----------------------------------------------
6900C C o m m o n B l o c k s
6901C-----------------------------------------------
6902#include "task_c.inc"
6903C-----------------------------------------------
6904C D u m m y A r g u m e n t s
6905C-----------------------------------------------
6906 INTEGER ITSK ,N1FTSK ,N1LTSK ,N1
6907C-----------------------------------------------
6908C L o c a l V a r i a b l e s
6909C-----------------------------------------------
6910 INTEGER OMP_GET_THREAD_NUM
6911 EXTERNAL OMP_GET_THREAD_NUM
6912C-----------------------------------------------
6913C S o u r c e L i n e s
6914C-----------------------------------------------
6915C
6916C Initialisation des variables pour // SMP
6917C
6918 ITSK = OMP_GET_THREAD_NUM()
6919 N1FTSK = 1+ITSK*N1/ NTHREAD
6920 N1LTSK = (ITSK+1)*N1/ NTHREAD
6921C
6922 RETURN
6923 END
6924!||====================================================================
6925!|| du_ini_hp ../engine/source/implicit/imp_solv.F
6926!||--- called by ------------------------------------------------------
6927!|| imp_solv ../engine/source/implicit/imp_solv.F
6928!||--- calls -----------------------------------------------------
6929!|| imp_smpini ../engine/source/implicit/imp_solv.F
6930!||--- uses -----------------------------------------------------
6931!|| imp_dyna ../engine/share/modules/impbufdef_mod.F
6932!||====================================================================
6933 SUBROUTINE DU_INI_HP(DN ,DNR ,DD ,
6934 1 DDR ,IDIV ,ICONT0 )
6935C-----------------------------------------------
6936C M o d u l e s
6937C-----------------------------------------------
6938 USE IMP_DYNA
6939C-----------------------------------------------
6940C I m p l i c i t T y p e s
6941C-----------------------------------------------
6942#include "implicit_f.inc"
6943C-----------------------------------------------
6944C C o m m o n B l o c k s
6945C-----------------------------------------------
6946#include "impl1_c.inc"
6947#include "impl2_c.inc"
6948#include "com01_c.inc"
6949#include "com04_c.inc"
6950C-----------------------------------------------
6951C D u m m y A r g u m e n t s
6952C-----------------------------------------------
6953 INTEGER IDIV ,ICONT0
6954 my_real
6955 . DN(3,*),DNR(3,*),DD(3,*),DDR(3,*)
6956C-----------------------------------------------
6957C L o c a l V a r i a b l e s
6958C-----------------------------------------------
6959 INTEGER NODFT ,NODLT,ITSK
6960 INTEGER I,J,IRES
6961 my_real
6962 . BFAC,BDT
6963C--------------Dn,0=Dn-1--------
6964C--------special case with /QSTAT diverge by contact, restart w/o resolution
6965 IRES = 1
6966.AND..AND. IF (IQSTAT >0 IDIV==-2 ICONT0 >0 ) THEN
6967 IDIV=-1
6968 IRES=0
6969 END IF
6970C
6971 BFAC=DT1_IMP/DT0_IMP
6972!$OMP PARALLEL PRIVATE(ITSK,NODFT ,NODLT,I,BDT)
6973 CALL IMP_SMPINI(ITSK ,NODFT ,NODLT,NUMNOD )
6974 IF (IDYNA==0) THEN
6975.OR. IF (ISMDISP>0IRES==0) THEN
6976 DO I = NODFT ,NODLT
6977 DD(1,I) = BFAC*DN(1,I)
6978 DD(2,I) = BFAC*DN(2,I)
6979 DD(3,I) = BFAC*DN(3,I)
6980 END DO
6981 IF (IRODDL/=0) THEN
6982 DO I = NODFT ,NODLT
6983 DDR(1,I) = BFAC*DNR(1,I)
6984 DDR(2,I) = BFAC*DNR(2,I)
6985 DDR(3,I) = BFAC*DNR(3,I)
6986 END DO
6987 END IF
6988 ELSE
6989 DO I = NODFT ,NODLT
6990 DD(1,I) = DN(1,I)
6991 DD(2,I) = DN(2,I)
6992 DD(3,I) = DN(3,I)
6993 ENDDO
6994 IF (IRODDL/=0) THEN
6995 DO I = NODFT ,NODLT
6996 DDR(1,I) = DNR(1,I)
6997 DDR(2,I) = DNR(2,I)
6998 DDR(3,I) = DNR(3,I)
6999 ENDDO
7000 END IF
7001 END IF
7002 ELSE
7003 BDT = HALF*DT0_IMP*DT0_IMP*(ONE-TWO*DY_B)
7004 BDT = ZERO
7005 DO I = NODFT ,NODLT
7006 DD(1,I) = BFAC*DN(1,I)+BDT*DY_A(1,I)
7007 DD(2,I) = BFAC*DN(2,I)+BDT*DY_A(2,I)
7008 DD(3,I) = BFAC*DN(3,I)+BDT*DY_A(3,I)
7009 END DO
7010 IF (IRODDL/=0) THEN
7011 DO I = NODFT ,NODLT
7012 DDR(1,I) = BFAC*DNR(1,I)+BDT*DY_AR(1,I)
7013 DDR(2,I) = BFAC*DNR(2,I)+BDT*DY_AR(2,I)
7014 DDR(3,I) = BFAC*DNR(3,I)+BDT*DY_AR(3,I)
7015 END DO
7016 END IF
7017 END IF
7018!$OMP END PARALLEL
7019C------------------------------------------
7020 RETURN
7021 END
7022!||====================================================================
7023!|| print_stif ../engine/source/implicit/imp_solv.F
7024!||--- uses -----------------------------------------------------
7025!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
7026!|| tri7box ../engine/share/modules/tri7box.F
7027!||====================================================================
7028 SUBROUTINE PRINT_STIF(IPARI,INTBUF_TAB,IFLAG,NN ,JG )
7029C-----------------------------------------------
7030C M o d u l e s
7031C-----------------------------------------------
7032 USE TRI7BOX
7033 USE INTBUFDEF_MOD
7034C-----------------------------------------------
7035C I m p l i c i t T y p e s
7036C-----------------------------------------------
7037#include "implicit_f.inc"
7038C-----------------------------------------------
7039C C o m m o n B l o c k s
7040C-----------------------------------------------
7041#include "com01_c.inc"
7042#include "com04_c.inc"
7043#include "units_c.inc"
7044#include "param_c.inc"
7045#include "task_c.inc"
7046C-----------------------------------------------
7047C D u m m y A r g u m e n t s
7048C-----------------------------------------------
7049 INTEGER IPARI(NPARI,NINTER)
7050 INTEGER IFLAG, NN ,JG
7051 INTEGER LENS, LENR,P,N
7052 INTEGER IEDGE,NSN
7053
7054 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
7055C------------------------------------------
7056 return
7057 IF (NSPMD==1) THEN
7058 NSN =IPARI(5,NN)
7059 N = 21
7060.and. if (NCYCLE>=81NCYCLE<=81) then
7061c write(iout,*)'IFLAG,ISPMD=',IFLAG,ISPMD
7062c write(iout,*)'IRTLM(1,)=',INBUF(K1)
7063c call my_flush(6)
7064 end if
7065 ELSE
7066 LENS = 0
7067 LENR = 0
7068 DO P = 1, NSPMD
7069 LENS = LENS + NSNSI(NN)%P(P)
7070 LENR = LENR + NSNFI(NN)%P(P)
7071 END DO
7072.and..AND. if (NCYCLE>=80NCYCLE<=81LENR >0) then
7073 write(iout,*)'iflag,ispmd=',IFLAG,ISPMD
7074 write(iout,*)'stif_oldfi()%P(1=',STIF_OLDFI(NN)%P(1,JG)
7075 end if
7076c if (NCYCLE>=78.and.NCYCLE<=79.AND.LENS >0) then
7077c N = 55
7078c K1 = KD(16)+ 2*(N -1)
7079c write(iout,*)'IFLAG,ISPMD=',IFLAG,ISPMD
7080c write(iout,*)'IRTLM(1,N)=',INBUF(K1)
7081c end if
7082 END IF !(NSPMD==1) THEN
7083 RETURN
7084 END
7085!||====================================================================
7086!|| imp_stif24 ../engine/source/implicit/imp_solv.F
7087!||--- called by ------------------------------------------------------
7088!|| re2int7 ../engine/source/implicit/imp_solv.F
7089!||--- calls -----------------------------------------------------
7090!|| spmd_allglob_isum9 ../engine/source/mpi/generic/spmd_allglob_isum9.F
7091!||--- uses -----------------------------------------------------
7092!|| imp_i7cp ../engine/share/modules/imp_intm.F
7093!|| tri7box ../engine/share/modules/tri7box.F
7094!||====================================================================
7095 SUBROUTINE IMP_STIF24(NUMIMP ,IPARI )
7096C-----------------------------------------------
7097 USE TRI7BOX
7098 USE IMP_I7CP
7099C-----------------------------------------------
7100C I m p l i c i t T y p e s
7101C-----------------------------------------------
7102#include "implicit_f.inc"
7103C-----------------------------------------------
7104C C o m m o n B l o c k s
7105C-----------------------------------------------
7106#include "com01_c.inc"
7107#include "com04_c.inc"
7108#include "com08_c.inc"
7109#include "impl1_c.inc"
7110#include "param_c.inc"
7111C-----------------------------------------------
7112C D u m m y A r g u m e n t s
7113C-----------------------------------------------
7114 INTEGER NUMIMP(*),IPARI(NPARI,*)
7115C-----------------------------------------------
7116C L o c a l V a r i a b l e s
7117C-----------------------------------------------
7118 INTEGER I,J,K,L,N,IAD,N_MAX(NINTER),IFLAG,P,
7119 . ITY,NSN,IGSTI,IBIT,RID,INTTH,
7120 . IGAP,INACTI,IN1CON,NCONT0,NREBOU
7121C-----------------------------------------------
7122C S o u r c e L i n e s
7123C-----------------------------------------------
7124C-----Calcul NCONT0, Communication is necessary
7125.AND. IF (TT == ZEROINCONV==1) THEN
7126 DO N = 1,NINTER
7127 ITY =IPARI(7,N)
7128 IF (ITY==24) THEN
7129 IPARI(26,N)= 0
7130 IPARI(53,N)= 0
7131 END IF
7132 END DO
7133 END IF
7134 IFLAG=0
7135 DO N = 1,NINTER
7136 ITY =IPARI(7,N)
7137 IGSTI =IPARI(34,N)
7138 N_MAX(N)=0
7139.AND. IF (ITY == 24IGSTI==6) THEN
7140 N_MAX(N) =NUMIMP(N)
7141 IFLAG=1
7142 END IF
7143 END DO
7144.OR. IF (IFLAG==0IMCONV<0) RETURN
7145C
7146 IF (NSPMD>1) CALL SPMD_ALLGLOB_ISUM9(N_MAX,NINTER)
7147
7148 DO N = 1,NINTER
7149 ITY =IPARI(7,N)
7150 IGSTI =IPARI(34,N)
7151.AND. IF (ITY /= 24IGSTI/=6) CYCLE
7152 IN1CON =IPARI(26,N)
7153 NCONT0 =IPARI(27,N)
7154 NREBOU =IPARI(53,N)
7155.AND. IF (N_MAX(N)>0 IN1CON==0) THEN
7156 IF (INCONV==1) THEN
7157 IN1CON = NCYCLE+1
7158 ELSE
7159 IN1CON = NCYCLE
7160 END IF
7161 END IF
7162C---------rebound----
7163.AND. IF (NCONT0>0 N_MAX(N)==0) THEN
7164C------first one will keep negative IN1CON till converging
7165 IF (NCYCLE == IN1CON) THEN
7166 NREBOU=1
7167 ELSE
7168C--------rebound nb >2
7169 NREBOU=2
7170 END IF
7171c write(iout,*)'NREBOU,NIN,imconv,ispmd=',
7172c + NREBOU,N,imconv,ispmd
7173C---------negative :rebound active
7174 IPARI(53,N)=-NREBOU
7175 END IF
7176 IPARI(26,N)=IN1CON
7177 IPARI(27,N)=N_MAX(N)
7178 END DO
7179C
7180 RETURN
7181 END
7182!||====================================================================
7183!|| upd_rhs_fr ../engine/source/implicit/imp_solv.F
7184!||--- called by ------------------------------------------------------
7185!|| imp_intfr ../engine/source/implicit/imp_solv.F
7186!||--- calls -----------------------------------------------------
7187!|| ext_rhs ../engine/source/implicit/upd_glob_k.F
7188!|| i2_impr1 ../engine/source/interfaces/interf/i2_imp1.F
7189!|| i2_impr2 ../engine/source/interfaces/interf/i2_imp1.F
7190!|| rbe2_impr1 ../engine/source/constraints/general/rbe2/rbe2_imp0.F
7191!|| rbe3_impr1 ../engine/source/constraints/general/rbe3/rbe3_imp0.F
7192!|| rbe3_impr2 ../engine/source/constraints/general/rbe3/rbe3_imp0.F
7193!|| rby_impr1 ../engine/source/constraints/general/rbody/rby_imp0.F
7194!|| rby_impr2 ../engine/source/constraints/general/rbody/rby_imp0.F
7195!||--- uses -----------------------------------------------------
7196!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
7197!||====================================================================
7198 SUBROUTINE UPD_RHS_FR(ICODT ,ICODR ,ISKEW ,IBFV ,XFRAME ,
7199 1 RBY ,X ,SKEW ,LPBY ,NPBY ,
7200 2 NRBYAC,IRBYAC,NINT2 ,IINT2 ,IPARI ,
7201 3 INTBUF_TAB ,NDOF ,IDDL ,IKC ,
7202 4 NDDL0 ,B ,IUPD ,INLOC ,LJ ,
7203 5 AC ,ACR ,NT_RW ,W_DDL ,NDDL ,
7204 6 R02 ,IRBE3 ,LRBE3 ,FRBE3 ,WEIGHT ,
7205 8 IRBE2 ,LRBE2 )
7206C-----------------------------------------------
7207C M o d u l e s
7208C-----------------------------------------------
7209 USE INTBUFDEF_MOD
7210C-----------------------------------------------
7211C I m p l i c i t T y p e s
7212C-----------------------------------------------
7213#include "implicit_f.inc"
7214C-----------------------------------------------
7215C C o m m o n B l o c k s
7216C-----------------------------------------------
7217#include "com04_c.inc"
7218#include "param_c.inc"
7219C-----------------------------------------------
7220C D u m m y A r g u m e n t s
7221C-----------------------------------------------
7222 INTEGER IBFV(NIFV,*),ICODT(*),ICODR(*),ISKEW(*),
7223 . NINT2 ,IINT2(*),LJ(*),NDDL0,IUPD,
7224 . INLOC(*),NT_RW,W_DDL(*) ,NDDL
7225 INTEGER LPBY(*),NPBY(NNPBY,*),NDOF(*),IDDL(*),IKC(*),
7226 . IPARI(NPARI,*), NRBYAC,IRBYAC(*)
7227 INTEGER WEIGHT(*),IRBE3(*),LRBE3(*),IRBE2(*),LRBE2(*)
7228 my_real
7229 . RBY(NRBY,*) ,X(3,*) ,SKEW(*),R02
7230 my_real
7231 . B(*) ,XFRAME(NXFRAME,*),AC(3,*),ACR(3,*),FRBE3(*)
7232
7233 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
7234C-----------------------------------------------
7235C L o c a l V a r i a b l e s
7236C-----------------------------------------------
7237 INTEGER I,J,K,N,JI,JB,K1,IFLAG
7238C-------R02 correction due the fact that IMP_FRI is done after [K],{LB}condensation----------
7239C-------only Fext is re-computed, others don't change-------
7240C-------int2,RBE3,rby speciale (Fext seulement)----------
7241 IF (IUPD==0) THEN
7242 DO I=1,NINT2
7243 N=IINT2(I)
7244 CALL I2_IMPR1(IPARI(1,N),INTBUF_TAB(N),
7245 . X ,NDOF ,IDDL ,B )
7246 ENDDO
7247 IF (NRBE2>0) THEN
7248 CALL RBE2_IMPR1(
7249 1 IRBE2 ,LRBE2 ,X ,SKEW ,NDOF ,
7250 2 IDDL ,B ,WEIGHT)
7251 ENDIF
7252 IF (NRBE3>0) THEN
7253 CALL RBE3_IMPR1(
7254 1 IRBE3 ,LRBE3 ,FRBE3 ,X ,SKEW ,
7255 2 NDOF ,IDDL ,B ,WEIGHT)
7256 ENDIF
7257 DO I=1,NRBYAC
7258 N=IRBYAC(I)
7259 K1=IRBYAC(I+NRBYKIN)+1
7260 CALL RBY_IMPR1(X, RBY(1,N),LPBY(K1),NPBY(1,N),
7261 1 NDOF ,IDDL ,B )
7262 ENDDO
7263 ENDIF
7264C-------int2,rby speciale (elems deleted)----------
7265 DO I=1,NINT2
7266 N=IINT2(I)
7267 CALL I2_IMPR2(IPARI(1,N),INTBUF_TAB(N) ,AC ,ACR ,
7268 . X ,NDOF ,IDDL ,B )
7269 ENDDO
7270 IF (NRBE3>0) THEN
7271 CALL RBE3_IMPR2(
7272 1 IRBE3 ,LRBE3 ,FRBE3 ,X ,SKEW ,
7273 2 NDOF ,IDDL ,B ,WEIGHT,AC ,
7274 3 ACR )
7275 ENDIF
7276 DO I=1,NRBYAC
7277 N=IRBYAC(I)
7278 K1=IRBYAC(I+NRBYKIN)+1
7279 CALL RBY_IMPR2(X, RBY(1,N),LPBY(K1),NPBY(1,N),
7280 1 NDOF ,IDDL ,B ,AC ,ACR )
7281 ENDDO
7282C-------------
7283 CALL EXT_RHS(ICODT ,ICODR ,ISKEW ,IBFV ,XFRAME ,
7284 1 X ,SKEW ,NDOF ,IDDL ,IKC ,
7285 2 NDDL0 ,B ,INLOC ,LJ ,AC ,
7286 3 ACR ,NT_RW ,W_DDL ,NDDL ,R02 )
7287C
7288 RETURN
7289 END
7290!||====================================================================
7291!|| imp_intfr ../engine/source/implicit/imp_solv.F
7292!||--- called by ------------------------------------------------------
7293!|| imp_solv ../engine/source/implicit/imp_solv.F
7294!||--- calls -----------------------------------------------------
7295!|| cp_real_hp ../engine/source/implicit/produt_v.F
7296!|| imp_frfv ../engine/source/mpi/implicit/imp_fri.F
7297!|| imp_fri ../engine/source/mpi/implicit/imp_fri.F
7298!|| imp_setba ../engine/source/implicit/imp_setb.F
7299!|| upd_rhs_fr ../engine/source/implicit/imp_solv.F
7300!||--- uses -----------------------------------------------------
7301!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
7302!||====================================================================
7303 SUBROUTINE IMP_INTFR(
7304 1 NUM_IMP ,NS_IMP ,NE_IMP ,IPARI ,INTBUF_TAB,
7305 2 NPBY ,LPBY ,ITAB ,NRBYAC ,
7306 3 IRBYAC ,NINT2 ,IINT2 ,IDDL ,IKC ,
7307 4 NDOF ,INLOC ,NSREM ,NSL ,NBINTC ,
7308 5 INTLIST ,X ,IBFV ,DIRUL ,SKEW ,
7309 6 XFRAME ,ISKEW ,ICODT ,DE ,D_IMP ,
7310 7 LB ,IFDIS ,NDDL ,DR_IMP ,IDDLI ,
7311 8 IRBE3 ,LRBE3 ,FRBE3 ,IRBE2 ,LRBE2 ,
7312 9 DD ,DDR ,A ,AR ,AC ,
7313 A ACR ,MS ,V ,NDDL0 ,R02 ,
7314 B RBY ,ICODR ,NT_RW ,W_DDL ,WEIGHT ,
7315 C IRFLAG )
7316C-----------------------------------------------
7317C M o d u l e s
7318C-----------------------------------------------
7319 USE INTBUFDEF_MOD
7320C----6---------------------------------------------------------------7---------8
7321C I m p l i c i t T y p e s
7322C-----------------------------------------------
7323#include "implicit_f.inc"
7324C-----------------------------------------------
7325C C o m m o n B l o c k s
7326C-----------------------------------------------
7327#include "com04_c.inc"
7328#include "param_c.inc"
7329#include "impl1_c.inc"
7330C-----------------------------------------------------------------
7331C D u m m y A r g u m e n t s
7332C-----------------------------------------------
7333 INTEGER IPARI(NPARI,*),NUM_IMP(*),NS_IMP(*),
7334 . NE_IMP(*),NSREM ,NSL,NBINTC,INTLIST(*),IRFLAG,
7335 . IRBE3(*),LRBE3(*),IRBE2(*),LRBE2(*),NDDL0,W_DDL(*),
7336 . WEIGHT(*),ICODR(*),NT_RW
7337 INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*),
7338 . NINT2,IINT2(*),IDDL(*),IKC(*),NDOF(*),INLOC(*),
7339 . IBFV(*),DIRUL(*),ISKEW(*),ICODT(*),IFDIS,NDDL,IDDLI(*)
7340C REAL
7341 my_real
7342 . X(3,*),SKEW(*) ,XFRAME(*),
7343 . A(3,*),D_IMP(3,*),LB(*),DR_IMP(3,*),FRBE3(*),
7344 . DD(3,*),DDR(3,*),AR(3,*),MS(*) ,V(3,*),DE,
7345 . AC(3,*),ACR(3,*),R02,RBY(NRBY,*)
7346
7347 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
7348C-----------------------------------------------
7349C L o c a l V a r i a b l e s
7350C-----------------------------------------------
7351 INTEGER I,J,N,NKC,ND,NDM
7352 INTEGER, DIMENSION(NDDL0) :: IDM
7353 my_real, DIMENSION(NDDL0) :: LB0
7354C
7355 CALL CP_REAL_HP(NDDL,LB,LB0)
7356 CALL IMP_FRI(
7357 1 NUM_IMP ,NS_IMP ,NE_IMP ,IPARI ,INTBUF_TAB,
7358 2 NPBY ,LPBY ,ITAB ,NRBYAC ,
7359 3 IRBYAC ,NINT2 ,IINT2 ,IDDL ,IKC ,
7360 4 NDOF ,INLOC ,NSREM ,NSL ,NBINTC ,
7361 5 INTLIST ,X ,IBFV ,DIRUL ,SKEW ,
7362 6 XFRAME ,ISKEW ,ICODT ,A ,D_IMP ,
7363 7 LB ,IFDIS ,NDDL ,DR_IMP ,IDDLI ,
7364 8 IRBE3 ,LRBE3 ,FRBE3 ,IRBE2 ,LRBE2 )
7365.AND. IF ( IFDIS>0 INTP_C <= 0)
7366 . CALL IMP_FRFV(
7367 1 NUM_IMP ,NS_IMP ,NE_IMP ,IPARI ,INTBUF_TAB,
7368 2 IDDL ,IKC ,NDOF ,NSREM ,
7369 3 NSL ,D_IMP ,DD ,DR_IMP ,DDR ,
7370 4 A ,AR ,MS ,V ,X ,
7371 5 LB ,NDDL ,IBFV ,SKEW ,XFRAME ,
7372 6 IRBE3 ,LRBE3 ,IRBE2 ,LRBE2 ,DE ,
7373 7 NDDL0 ,W_DDL )
7374C--------Fext change (U_d) w/ remot to re-evalue R02
7375 IF (IRFLAG>0) THEN
7376 DO I =1,NDDL
7377 LB0(I) =LB(I)-LB0(I)
7378 END DO
7379 DO I =NDDL+1,NDDL0
7380 LB0(I) =ZERO
7381 END DO
7382 NKC=0
7383C------LB0 condensed -> LB0 original
7384 DO N =1,NUMNOD
7385 I=INLOC(N)
7386 NDM=IDDL(I)-NKC
7387 DO J=1,NDOF(I)
7388 ND = IDDL(I)+J
7389 IF (IKC(ND)/=0) THEN
7390 NKC = NKC + 1
7391 IDM(ND)=0
7392 ELSE
7393 NDM=NDM+1
7394 IDM(ND)=NDM
7395 END IF
7396 ENDDO
7397 ENDDO
7398 DO I =NDDL0,1,-1
7399 ND = IDM(I)
7400 IF (ND>0) LB0(I) =LB0(ND)
7401 END DO
7402 CALL IMP_SETBA(AC ,ACR ,IDDL ,NDOF ,LB0 ,1 )
7403 CALL UPD_RHS_FR(ICODT ,ICODR ,ISKEW ,IBFV ,XFRAME ,
7404 1 RBY ,X ,SKEW ,LPBY ,NPBY ,
7405 2 NRBYAC,IRBYAC,NINT2 ,IINT2 ,IPARI ,
7406 3 INTBUF_TAB ,NDOF ,IDDL ,IKC ,
7407 4 NDDL0 ,LB0 ,ISETK ,INLOC ,DIRUL ,
7408 5 AC ,ACR ,NT_RW ,W_DDL ,NDDL ,
7409 6 R02 ,IRBE3 ,LRBE3 ,FRBE3 ,WEIGHT ,
7410 8 IRBE2 ,LRBE2 )
7411 ENDIF
7412C----6---------------------------------------------------------------7---------8
7413 RETURN
7414 END
7415!||====================================================================
7416!|| ini_bminma_imp ../engine/source/implicit/imp_solv.F
7417!||--- called by ------------------------------------------------------
7418!|| imp_solv ../engine/source/implicit/imp_solv.F
7419!||--- uses -----------------------------------------------------
7420!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
7421!||====================================================================
7422 SUBROUTINE INI_BMINMA_IMP(INTBUF_TAB)
7423C-----------------------------------------------
7424C M o d u l e s
7425C-----------------------------------------------
7426 USE INTBUFDEF_MOD
7427C-----------------------------------------------
7428C I m p l i c i t T y p e s
7429C-----------------------------------------------
7430#include "implicit_f.inc"
7431C-----------------------------------------------
7432C C o m m o n B l o c k s
7433C-----------------------------------------------
7434#include "com04_c.inc"
7435C-----------------------------------------------
7436 TYPE(INTBUF_STRUCT_):: INTBUF_TAB(NINTER)
7437C-----------------------------------------------
7438C L o c a l V a r i a b l e s
7439C-----------------------------------------------
7440 INTEGER N
7441C-----------------------------------------------
7442 DO N = 1,NINTER
7443 INTBUF_TAB(N)%BMINMA_IMP(1)=-EP30
7444 INTBUF_TAB(N)%BMINMA_IMP(2)=-EP30
7445 INTBUF_TAB(N)%BMINMA_IMP(3)=-EP30
7446 INTBUF_TAB(N)%BMINMA_IMP(4)=EP30
7447 INTBUF_TAB(N)%BMINMA_IMP(5)=EP30
7448 INTBUF_TAB(N)%BMINMA_IMP(6)=EP30
7449 END DO
7450C------------------------------------------
7451 RETURN
7452 END
7453!||====================================================================
7454!|| spbrm_pre ../engine/source/implicit/imp_solv.F
7455!||--- called by ------------------------------------------------------
7456!|| imp_solv ../engine/source/implicit/imp_solv.F
7457!||--- calls -----------------------------------------------------
7458!|| cgshell3 ../engine/source/implicit/cgshell.F
7459!|| cgshell4 ../engine/source/implicit/cgshell.F
7460!|| spb_refsh3id ../engine/source/implicit/imp_solv.F
7461!|| spb_refsh4id ../engine/source/implicit/imp_solv.F
7462!|| spmd_max_i ../engine/source/mpi/implicit/imp_spmd.F
7463!|| spmd_min_s ../engine/source/mpi/implicit/imp_spmd.F
7464!|| spmd_sum_s ../engine/source/mpi/implicit/imp_spmd.F
7465!||--- uses -----------------------------------------------------
7466!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
7467!|| imp_spbrm ../engine/share/modules/impbufdef_mod.F
7468!||====================================================================
7469 SUBROUTINE SPBRM_PRE(ITAB ,
7470 1 X ,IPARG ,IXC ,IXTG ,PARTSAV ,
7471 2 ELBUF_TAB ,PM ,NDOF ,IDDL ,IKC )
7472C-----------------------------------------------
7473C M o d u l e s
7474C-----------------------------------------------
7475 USE ELBUFDEF_MOD
7476 USE IMP_SPBRM
7477C-----------------------------------------------
7478C I m p l i c i t T y p e s
7479C-----------------------------------------------
7480#include "implicit_f.inc"
7481C-----------------------------------------------
7482C C o m m o n B l o c k s
7483C-----------------------------------------------
7484#include "com01_c.inc"
7485#include "com04_c.inc"
7486#include "param_c.inc"
7487#include "impl1_c.inc"
7488C-----------------------------------------------
7489C D u m m y A r g u m e n t s
7490C-----------------------------------------------
7491 INTEGER
7492 . IXC(NIXC,*), IXTG(NIXTG,*), IPARG(NPARG,*),
7493 . NDOF(*),IDDL(*),IKC(*),ITAB(*)
7494C REAL
7495 my_real
7496 . X(3,*) ,PARTSAV(NPSAV,*) ,PM(*)
7497 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
7498C-----------------------------------------------
7499C L o c a l V a r i a b l e s
7500C-----------------------------------------------
7501 INTEGER N4,N3,I,II,J,N, NG,MLW, NF1,NKC,ND,IP4,IP3,IG,
7502 + JFT,JLT,NBC,ITY,NEL,NFT,NBCS,E_ID,N1,N2,K
7503 INTEGER, DIMENSION(:),ALLOCATABLE :: ITAG
7504C REAL
7505 my_real
7506 . XC,YC,ZC,MAS,MAS3,DMIN,XMIN,YMIN,ZMIN,MAST,
7507 . DMING,XMING,YMING,ZMING
7508C---limitations : only the blank is deformable(shell only), all tools(part)are rigids---
7509C------------blank could be composed w/ 4N,3N and in diff parts
7510C------ IRIG_M>1 -> input E_REF id
7511C---IF there id BC (symmetry) in the blank----
7512C----- put N1,N2,N3 (sys_id) in E_REF(1:3), E_REF(4)=E_REF(3)
7513 RLSKEW(1:9) = ZERO
7514 IF (IRIG_M>1 ) THEN
7515 NBC_B = 0
7516 ILSKEW = 0
7517 LSKEW_G = 0
7518 IKCE(1:6) = 0
7519 N1=0
7520 N2=0
7521 N3=0
7522 DO I = 1, NUMNOD
7523 IF(ITAB(I)==E_REF(1)) N1=I
7524 IF(ITAB(I)==E_REF(2)) N2=I
7525 IF(ITAB(I)==E_REF(3)) N3=I
7526 END DO
7527 E_REF(1)= N1
7528 E_REF(2)= N2
7529 E_REF(3)= N3
7530 DO J = 1, 3
7531 N = E_REF(J)
7532 IF (N==0) CYCLE
7533 DO K= 1,NDOF(N)
7534 ND = IDDL(N)+K
7535.AND. IF (IKC(ND)>0IKCE(K)==0) IKCE(K) = 1
7536 IF (IKC(ND)==8) ILSKEW = N
7537 END DO
7538 END DO
7539 IF (ILSKEW >0) LSKEW_G=1
7540C---- end routine
7541 RETURN
7542 END IF
7543 NBC = 0
7544 DO I =1,NUMNOD
7545 NKC=0
7546 DO J=1,MIN(3,NDOF(I))
7547 ND = IDDL(I)+J
7548 IF (IKC(ND)/=0) NKC = NKC + 1
7549 ENDDO
7550C--------exclude fixing all translational
7551.AND. IF (NKC>0NKC<3) NBC = NBC +1
7552 ENDDO
7553 IF (NBC >0) THEN
7554C----------pense deallocate
7555 AllOCATE(IBC_B(NBC))
7556 NBC = 0
7557 DO I =1,NUMNOD
7558 NKC=0
7559 DO J=1,MIN(3,NDOF(I))
7560 ND = IDDL(I)+J
7561 IF (IKC(ND)/=0) NKC = NKC + 1
7562 ENDDO
7563.AND. IF (NKC>0NKC<3) THEN
7564 NBC = NBC +1
7565 IBC_B(NBC) = I
7566 END IF
7567 ENDDO
7568 END IF
7569C------global NBC---
7570 NBC_B = NBC
7571 IF (NSPMD>1) CALL SPMD_MAX_I(NBC_B)
7572C---get reference elem (shell for the moment) for rigid motion compute
7573C---- E_id : nearest the gravity center if no BC,
7574C-----E_REF(4) saved 4 nodes which are Xmin, Ymin,Zmin,Dmin, will be updated by v,vr
7575 IF (NBC >0) THEN
7576 ALLOCATE(ITAG(NUMNOD))
7577 ITAG = 0
7578 DO I =1,NBC
7579 N = IBC_B(I)
7580 ITAG(N) =1
7581 END DO
7582 NE_BC4 = 0
7583 NE_BC3 = 0
7584 DO NG = 1, NGROUP
7585 IF(IPARG(8,NG)==1) CYCLE
7586 ITY =IPARG(5,NG)
7587.AND. IF (ITY /= 3 ITY /= 7) CYCLE
7588 MLW =IPARG(1,NG)
7589C
7590.OR. IF (MLW == 0 MLW == 13) CYCLE
7591 NEL =IPARG(2,NG)
7592 JFT =IPARG(3,NG) + 1
7593 JLT = IPARG(3,NG) + NEL
7594 IF (ITY==7) THEN
7595 DO I = JFT,JLT
7596 NBCS = 0
7597 DO J=1,3
7598 N= IXTG(J+1,I)
7599 NBCS = NBCS + ITAG(N)
7600 END DO
7601 IF (NBCS >0) NE_BC3 =NE_BC3 + 1
7602 END DO
7603 ELSEIF (ITY==3) THEN
7604 DO I = JFT,JLT
7605 NBCS = 0
7606 DO J=1,4
7607 N= IXC(J+1,I)
7608 NBCS = NBCS + ITAG(N)
7609 END DO
7610 IF (NBCS >0) NE_BC4 =NE_BC4 + 1
7611 END DO
7612 END IF
7613 END DO !NG = 1, NGROUP
7614 IF (NE_BC3 >0) ALLOCATE(IE_BC3(NE_BC3))
7615 IF (NE_BC4 >0) ALLOCATE(IE_BC4(NE_BC4))
7616 NE_BC4 = 0
7617 NE_BC3 = 0
7618 DO NG = 1, NGROUP
7619 IF(IPARG(8,NG)==1) CYCLE
7620 ITY =IPARG(5,NG)
7621.AND. IF (ITY /= 3 ITY /= 7) CYCLE
7622 MLW =IPARG(1,NG)
7623C
7624.OR. IF (MLW == 0 MLW == 13) CYCLE
7625 NEL =IPARG(2,NG)
7626 JFT =IPARG(3,NG) + 1
7627 JLT = IPARG(3,NG) + NEL
7628 IF (ITY==7) THEN
7629 DO I = JFT,JLT
7630 NBCS = 0
7631 DO J=1,3
7632 N= IXTG(J+1,I)
7633 NBCS = NBCS + ITAG(N)
7634 END DO
7635 IF (NBCS >0) THEN
7636 NE_BC3 =NE_BC3 + 1
7637 IE_BC3(NE_BC3) = I
7638 END IF
7639 END DO
7640 ELSEIF (ITY==3) THEN
7641 DO I = JFT,JLT
7642 NBCS = 0
7643 DO J=1,4
7644 N= IXC(J+1,I)
7645 NBCS = NBCS + ITAG(N)
7646 END DO
7647 IF (NBCS >0) THEN
7648 NE_BC4 =NE_BC4 + 1
7649 IE_BC4(NE_BC4) = I
7650 END IF
7651 END DO
7652 END IF
7653 END DO !NG =
7654C-------NBC = 0
7655 ELSEIF (NBC_B == 0) THEN
7656 N3=0
7657 N4=0
7658 MAS =ZERO
7659 XC = ZERO
7660 YC = ZERO
7661 ZC = ZERO
7662 DO NG = 1, NGROUP
7663 IF(IPARG(8,NG)==1) CYCLE
7664 ITY =IPARG(5,NG)
7665.AND. IF (ITY /= 3 ITY /= 7) CYCLE
7666 MLW =IPARG(1,NG)
7667C MLW= 0 ----> void; MLW = 13 ----> rigid material
7668.OR. IF (MLW == 0 MLW == 13) CYCLE
7669 NEL =IPARG(2,NG)
7670 JFT=1
7671 JLT=MIN(NVSIZ,NEL)
7672 NF1 = IPARG(3,NG)+1
7673 IF (ITY==7) THEN
7674 N3 =N3 +1
7675 CALL CGSHELL3(ELBUF_TAB(NG),JFT,JLT ,PM ,IXTG(1,NF1),
7676 + X ,MAS,XC ,YC ,ZC )
7677 ELSEIF (ITY==3) THEN
7678 N4 =N4 +1
7679 CALL CGSHELL4(ELBUF_TAB(NG),JFT,JLT ,PM ,IXC(1,NF1),
7680 + X ,MAS,XC ,YC ,ZC )
7681 END IF
7682 END DO !IG = 1, NGROUC
7683C
7684.AND. IF (N3==0N4==0) THEN
7685C-------warning out--
7686 ELSE
7687 IF (NSPMD>1) THEN
7688 MAST = MAS
7689 CALL SPMD_SUM_S(MAST)
7690 CALL SPMD_SUM_S(XC)
7691 CALL SPMD_SUM_S(YC)
7692 CALL SPMD_SUM_S(ZC)
7693 MAS = MAST
7694 END IF
7695 XC = XC/MAS
7696 YC = YC/MAS
7697 ZC = ZC/MAS
7698C
7699 XMIN=EP30
7700 YMIN=EP30
7701 ZMIN=EP30
7702 DMIN=EP30
7703 DO NG = 1, NGROUP
7704 IF(IPARG(8,NG)==1) CYCLE
7705 ITY =IPARG(5,NG)
7706.AND. IF (ITY /= 3 ITY /= 7) CYCLE
7707 MLW =IPARG(1,NG)
7708C
7709.OR. IF (MLW == 0 MLW == 13) CYCLE
7710 NEL =IPARG(2,NG)
7711 JFT =IPARG(3,NG) + 1
7712 JLT = IPARG(3,NG) + NEL
7713 IF (ITY==7) THEN
7714 CALL SPB_REFSH3ID(JFT,JLT,NEL,IXTG,X,XC,YC,ZC,
7715 + E_REF,XMIN,YMIN,ZMIN,DMIN)
7716 ELSEIF (ITY==3) THEN
7717 CALL SPB_REFSH4ID(JFT,JLT,NEL,IXC,X,XC,YC,ZC,
7718 + E_REF,XMIN,YMIN,ZMIN,DMIN)
7719 END IF
7720 END DO !IG = 1, NGROUC
7721C-------to get unique ref-element
7722 IF (NSPMD>1) THEN
7723 XMING = XMIN
7724 CALL SPMD_MIN_S(XMING)
7725 IF (XMING<XMIN) E_REF(1)=0
7726 YMING = YMIN
7727 CALL SPMD_MIN_S(YMING)
7728 IF (YMING<YMIN) E_REF(2)=0
7729 ZMING = ZMIN
7730 CALL SPMD_MIN_S(ZMING)
7731 IF (ZMING<ZMIN) E_REF(3)=0
7732 DMING = DMIN
7733 CALL SPMD_MIN_S(DMING)
7734 IF (DMING<DMIN) E_REF(4)=0
7735 END IF
7736.AND..OR..OR. END IF !((N3==0N4==0)N3>1 N4>1)
7737 END IF !(NBC>0) THEN
7738 IF (NBC >0) DEALLOCATE(ITAG)
7739C
7740 RETURN
7741 END
7742!||====================================================================
7743!|| spb_refsh4id ../engine/source/implicit/imp_solv.F
7744!||--- called by ------------------------------------------------------
7745!|| spbrm_pre ../engine/source/implicit/imp_solv.F
7746!||====================================================================
7747 SUBROUTINE SPB_REFSH4ID(JFT,JLT,NEL,IXC,X,XC,YC,ZC,IE,
7748 + XMIN0,YMIN0,ZMIN0,DMIN)
7749C-----------------------------------------------
7750C I m p l i c i t T y p e s
7751C-----------------------------------------------
7752#include "implicit_f.inc"
7753C-----------------------------------------------
7754C D u m m y A r g u m e n t s
7755C-----------------------------------------------
7756 INTEGER IXC(NIXC,*),JFT, JLT,IE(4),NEL
7757C REAL
7758 my_real
7759 . X(3,*),XC,YC,ZC,DMIN,XMIN0,YMIN0,ZMIN0
7760C-----------------------------------------------
7761C L o c a l V a r i a b l e s
7762C-----------------------------------------------
7763 INTEGER N,I,II,ND,INDEX(NEL),IEL,J
7764 my_real
7765 . XMIN,XMAX,YMIN,YMAX,ZMIN,ZMAX,D,XM,YM,ZM,DMINL,
7766 . XMINL,YMINL,ZMINL
7767C---get reference ele (shell for the moment) for rigid motion compute
7768C---- E_id : nearest the gravity center----
7769 ND =0
7770 DO I = JFT,JLT
7771 XMIN=EP30
7772 XMAX=-EP30
7773 YMIN=EP30
7774 YMAX=-EP30
7775 ZMIN=EP30
7776 ZMAX=-EP30
7777 DO J=1,4
7778 N= IXC(J+1,I)
7779 XMIN=MIN(XMIN,X(1,N))
7780 XMAX=MAX(XMAX,X(1,N))
7781 YMIN=MIN(YMIN,X(2,N))
7782 YMAX=MAX(YMAX,X(2,N))
7783 ZMIN=MIN(ZMIN,X(3,N))
7784 ZMAX=MAX(ZMAX,X(3,N))
7785 END DO
7786.OR..AND..OR. IF((XC < XMINXC > XMAX)(YC < YMINYC > YMAX)
7787.AND..OR. + (ZC < ZMINZC > ZMAX)) CYCLE
7788 ND = ND +1
7789 INDEX(ND) = I
7790 END DO
7791 IF (ND ==0) THEN
7792 IEL =0
7793 ELSE
7794 DO II = 1,ND
7795 I = INDEX(II)
7796 XM = ZERO
7797 YM = ZERO
7798 ZM = ZERO
7799 DO J=1,4
7800 N= IXC(J+1,I)
7801 XM=XM+X(1,N)
7802 YM=YM+X(2,N)
7803 ZM=ZM+X(3,N)
7804 END DO
7805 XM = FOURTH*XM- XC
7806 YM = FOURTH*YM- YC
7807 ZM = FOURTH*ZM- ZC
7808 XMINL=ABS(XM)
7809 YMINL=ABS(YM)
7810 ZMINL=ABS(ZM)
7811C-------- Z direction is removed
7812 IF (XMINL<XMIN0) THEN
7813 IE(1) = I
7814 XMIN0 = XMINL
7815 END IF
7816 IF (YMINL<YMIN0) THEN
7817 IE(2) = I
7818 YMIN0 = YMINL
7819 END IF
7820c IF (ZMINL<ZMIN0) THEN
7821c IE(3) = I
7822c ZMIN0 = ZMINL
7823c END IF
7824 D=XM*XM+YM*YM
7825c D=XM*XM+YM*YM+ZM*ZM
7826 IF (D < DMIN) THEN
7827 DMIN = D
7828C---------first node-----
7829 IE(4) = I
7830 END IF
7831 END DO
7832 ENDIF
7833c IF (IEL>0 .AND.DMINL<DMIN) THEN
7834c IE(1:4) = IXC(2:5,IEL)
7835c DMIN= DMINL
7836c END IF
7837C
7838 RETURN
7839 END
7840!||====================================================================
7841!|| spb_refsh3id ../engine/source/implicit/imp_solv.F
7842!||--- called by ------------------------------------------------------
7843!|| spbrm_pre ../engine/source/implicit/imp_solv.F
7844!||====================================================================
7845 SUBROUTINE SPB_REFSH3ID(JFT,JLT,NEL,IXTG,X,XC,YC,ZC,IE,
7846 + XMIN0,YMIN0,ZMIN0,DMIN)
7847C-----------------------------------------------
7848C I m p l i c i t T y p e s
7849C-----------------------------------------------
7850#include "implicit_f.inc"
7851C-----------------------------------------------
7852C D u m m y A r g u m e n t s
7853C-----------------------------------------------
7854 INTEGER IXTG(NIXTG,*),JFT, JLT,IE(4),NEL
7855C REAL
7856 my_real
7857 . X(3,*),XC,YC,ZC,XMIN0,YMIN0,ZMIN0,DMIN
7858C-----------------------------------------------
7859C L o c a l V a r i a b l e s
7860C-----------------------------------------------
7861 INTEGER N,I,II,ND,INDEX(NEL),IEL,J
7862 my_real
7863 . XMIN,XMAX,YMIN,YMAX,ZMIN,ZMAX,D,XM,YM,ZM,DMINL,
7864 . XMINL,YMINL,ZMINL
7865C---get reference ele (shell for the moment) for rigid motion compute
7866C---- E_id : nearest the gravity center----
7867 ND =0
7868 DO I = JFT,JLT
7869 XMIN=EP30
7870 XMAX=-EP30
7871 YMIN=EP30
7872 YMAX=-EP30
7873 ZMIN=EP30
7874 ZMAX=-EP30
7875 DO J=1,3
7876 N= IXTG(J+1,I)
7877 XMIN=MIN(XMIN,X(1,N))
7878 XMAX=MAX(XMAX,X(1,N))
7879 YMIN=MIN(YMIN,X(2,N))
7880 YMAX=MAX(YMAX,X(2,N))
7881 ZMIN=MIN(ZMIN,X(3,N))
7882 ZMAX=MAX(ZMAX,X(3,N))
7883 END DO
7884.OR..AND..OR. IF((XC < XMINXC > XMAX)(YC < YMINYC > YMAX)
7885.AND..OR. + (ZC < ZMINZC > ZMAX)) CYCLE
7886 ND = ND +1
7887 INDEX(ND) = I
7888 END DO
7889 IF (ND ==0) THEN
7890 IEL =0
7891 ELSE
7892 DO II = 1,ND
7893 I = INDEX(II)
7894 XM = ZERO
7895 YM = ZERO
7896 ZM = ZERO
7897 DO J=1,3
7898 N= IXTG(J+1,I)
7899 XM=XM+X(1,N)
7900 YM=YM+X(2,N)
7901 ZM=ZM+X(3,N)
7902 END DO
7903 XM = THIRD*XM - XC
7904 YM = THIRD*YM - YC
7905 ZM = THIRD*ZM - ZC
7906 XMINL=ABS(XM)
7907 YMINL=ABS(YM)
7908 ZMINL=ABS(ZM)
7909 IF (XMINL<XMIN0) THEN
7910 IE(1) = I
7911 XMIN0 = XMINL
7912 END IF
7913 IF (YMINL<YMIN0) THEN
7914 IE(2) = I
7915 YMIN0 = YMINL
7916 END IF
7917 IF (ZMINL<ZMIN0) THEN
7918 IE(3) = I
7919 ZMIN0 = ZMINL
7920 END IF
7921 D=XM*XM+YM*YM
7922c D=XM*XM+YM*YM+ZM*ZM
7923 IF (D < DMIN) THEN
7924 DMIN = D
7925C------------- tag tria w/ negative
7926 IE(4) = -I
7927 END IF
7928 END DO
7929 ENDIF
7930c IF (IEL>0 .AND.DMINL<DMIN) THEN
7931c IE(1:3) = IXTG(2:4,IEL)
7932c IE(4) = IE(3)
7933c DMIN= DMINL
7934c END IF
7935C
7936 RETURN
7937 END
7938!||====================================================================
7939!|| spb_rm_rig ../engine/source/implicit/imp_solv.F
7940!||--- called by ------------------------------------------------------
7941!|| imp_solv ../engine/source/implicit/imp_solv.F
7942!||--- calls -----------------------------------------------------
7943!|| getikce ../engine/source/implicit/imp_solv.F
7944!|| spb_ieref3 ../engine/source/implicit/imp_solv.F
7945!|| spb_ieref_bc ../engine/source/implicit/imp_solv.F
7946!|| spb_ref_nds ../engine/source/implicit/imp_solv.F
7947!|| spb_rgmod ../engine/source/implicit/imp_solv.F
7948!|| spmd_e_ref ../engine/source/mpi/implicit/imp_spmd.F
7949!|| spmd_n_ref ../engine/source/mpi/implicit/imp_spmd.F
7950!|| transvg2l ../engine/source/implicit/imp_solv.F
7951!|| transvl2g ../engine/source/implicit/imp_solv.F
7952!|| velrot ../engine/source/constraints/general/rbe2/rbe2v.F
7953!||--- uses -----------------------------------------------------
7954!|| imp_spbrm ../engine/share/modules/impbufdef_mod.F
7955!||====================================================================
7956 SUBROUTINE SPB_RM_RIG(
7957 1 X ,IXC ,IXTG ,NDOF ,IDDL ,
7958 2 IKC ,D_IMP ,DR_IMP ,ICODT ,ICODR ,
7959 3 SKEW ,ISKEW ,itab )
7960C-----------------------------------------------
7961C M o d u l e s
7962C-----------------------------------------------
7963 USE IMP_SPBRM
7964C-----------------------------------------------
7965C I m p l i c i t T y p e s
7966C-----------------------------------------------
7967#include "implicit_f.inc"
7968C-----------------------------------------------
7969C C o m m o n B l o c k s
7970C-----------------------------------------------
7971#include "com01_c.inc"
7972#include "com04_c.inc"
7973#include "param_c.inc"
7974#include "units_c.inc"
7975#include "task_c.inc"
7976#include "impl1_c.inc"
7977C-----------------------------------------------
7978C D u m m y A r g u m e n t s
7979C-----------------------------------------------
7980 INTEGER ICODT(*),ICODR(*),ISKEW(*)
7981 INTEGER
7982 . IXC(NIXC,*), IXTG(NIXTG,*), NDOF(*),IDDL(*),IKC(*),itab(*)
7983C REAL
7984 my_real
7985 . X(3,*) ,D_IMP(3,*) ,DR_IMP(3,*) ,SKEW(LSKEW,*)
7986C-----------------------------------------------
7987C L o c a l V a r i a b l e s
7988C-----------------------------------------------
7989 INTEGER N,I,J,ND,NN,IE,IEM,NKC,K,ILOC,ISK,IKCL(6)
7990 my_real
7991 . DMIN,D,XC,YC,ZC,DTRA(3),DROT(3),DRS(3),LSM(3),
7992 . X0,Y0,Z0,DTRAL(3),DROTL(3),LSML(3),DRS1(3),DROT1(3),DROTL1(3)
7993C------remove rigid motion of springback (increment)
7994C----- find reference element: IF BCS the one of smallest Disp w/ BCS (doing ech time)
7995C------------------------------else nearest the GC of blank (done only once)
7996C------should update X_REF,D_REF each cycle---
7997C------case input 3N---
7998 IF (IRIG_M>1) THEN
7999 CALL SPB_REF_NDS(
8000 1 X ,D_IMP ,NDOF ,IDDL ,IKC ,
8001 2 ICODT ,ICODR ,ISKEW ,SKEW )
8002 IF (ILSKEW>0) THEN
8003C----get ISK(from E_REF)set [Q],transfert DTRA,DROT to local reset IKCE(6) put (j)=0 for fixing dir
8004 NN = ILSKEW
8005 ISK = ISKEW(NN)
8006C---------local IKC
8007 RLSKEW(1:9) = SKEW(1:9,ISK)
8008 CALL GETIKCE(ICODT(NN),ICODR(NN),NDOF(NN),IKCE)
8009 END IF
8010 IF (NSPMD>1) CALL SPMD_N_REF()
8011 ELSE
8012 IF (NBC_B>0) THEN
8013 CALL SPB_IEREF_BC(
8014 1 X ,IXC ,IXTG ,D_IMP ,DMIN ,
8015 2 NDOF ,IDDL ,IKC )
8016 IF (ILSKEW>0) THEN
8017C----get ISK(from E_REF)set [Q],transfert DTRA,DROT to local reset IKCE(6) put (j)=0 for fixing dir
8018 NN = ILSKEW
8019 ISK = ISKEW(NN)
8020C---------local IKC
8021 RLSKEW(1:9) = SKEW(1:9,ISK)
8022 CALL GETIKCE(ICODT(NN),ICODR(NN),NDOF(NN),IKCE)
8023 END IF
8024 ELSE
8025 CALL SPB_IEREF3(
8026 1 X ,IXC ,IXTG ,NDOF ,IDDL ,
8027 2 IKC ,D_IMP ,DR_IMP ,DMIN )
8028 END IF
8029C--------communication IKCE,X_REF,D_REF,RLSKEW,N_SEG, LSKEW_G
8030 IF (NSPMD>1) CALL SPMD_E_REF(DMIN)
8031 END IF !(IRIG_M>1) THEN
8032C
8033 IF (N_SEG==0) RETURN
8034C-----IKCE : only local BCS nodes are initialized-----
8035 CALL SPB_RGMOD(N_SEG ,X_REF ,D_REF ,X ,D_IMP ,
8036 + X0 ,Y0 ,Z0 ,DTRA,DROT )
8037.OR. IF (NBC_B>0LSKEW_G>0) THEN
8038 DO J=1,3
8039 IF (IKCE(J)==1) DTRA(J)= ZERO
8040 ENDDO
8041c IF (IRODDL/=0) THEN
8042 DO J=1,3
8043 IF (IKCE(J+3)==1) DROT(J)=ZERO
8044 ENDDO
8045c END IF
8046 END IF
8047 IF (LSKEW_G>0) THEN
8048 CALL TRANSVG2L(RLSKEW,DTRA,DTRAL)
8049 CALL TRANSVG2L(RLSKEW,DROT,DROTL)
8050 DO J=1,3
8051 IF (IKCE(J)==1) DTRAL(J)= ZERO
8052 IF (IKCE(J+3)==1) DROTL(J)=ZERO
8053 ENDDO
8054 IF (IRODDL/=0) CALL TRANSVL2G(RLSKEW,DROTL,DROT)
8055 DO I =1,NUMNOD
8056 NKC=0
8057 DO J=1,MIN(3,NDOF(I))
8058 ND = IDDL(I)+J
8059 IF (IKC(ND)/=0) NKC = NKC + 1
8060 ENDDO
8061 DROT1(1:3) = DROT(1:3)
8062C--------exclude the node w/all translational fixed
8063.AND. IF (NKC<3NDOF(I)>0) THEN
8064 LSM(1)=X(1,I)-X0
8065 LSM(2)=X(2,I)-Y0
8066 LSM(3)=X(3,I)-Z0
8067C----transfert LSM to local
8068c CALL TRANSVG2L(RLSKEW,LSM,LSML)
8069 CALL VELROT(DROTL,LSML,DRS)
8070C------otherwise DL(1:3)= DRS+ DTRAL if fixing put DL(j)=0
8071 DRS(1:3) = DRS(1:3) + DTRAL(1:3)
8072 IF (NKC>0) THEN
8073C----------suppose the same ISK w/ reference one
8074 CALL GETIKCE(ICODT(I),ICODR(I),NDOF(I),IKCL)
8075 DO J=1,3
8076 DROTL1(J) = DROTL(J)
8077 IF (IKCL(J)==1) DRS(J)= ZERO
8078 IF (IKCL(J+3)==1) DROTL1(J)= ZERO
8079 ENDDO
8080 CALL TRANSVL2G(RLSKEW,DROTL1,DROT1)
8081 END IF !(NKC>0) THEN
8082 CALL TRANSVL2G(RLSKEW,DRS,DRS1)
8083C----transfert DL DROT,to global
8084 DO K=1,3
8085 D_IMP(K,I)=D_IMP(K,I)- DRS1(K)
8086 ENDDO
8087 IF (IRODDL/=0) THEN
8088 DO K=1,3
8089 DR_IMP(K,I)=DR_IMP(K,I)- DROT1(K)
8090 ENDDO
8091 END IF
8092 END IF
8093 ENDDO
8094 ELSE
8095 DO I =1,NUMNOD
8096 NKC=0
8097 DO J=1,MIN(3,NDOF(I))
8098 ND = IDDL(I)+J
8099 IF (IKC(ND)/=0) NKC = NKC + 1
8100 ENDDO
8101C--------exclude the node w/all translational fixed
8102.AND. IF (NKC<3NDOF(I)>0) THEN
8103 LSM(1)=X(1,I)-X0
8104 LSM(2)=X(2,I)-Y0
8105 LSM(3)=X(3,I)-Z0
8106 CALL VELROT(DROT,LSM,DRS)
8107 DO K=1,3
8108 ND = IDDL(I)+K
8109 IF (IKC(ND)==0)D_IMP(K,I)=D_IMP(K,I)- DRS(K)- DTRA(K)
8110 ENDDO
8111 IF (IRODDL/=0) THEN
8112 DO K=1,3
8113 ND = IDDL(I)+K+3
8114 IF (IKC(ND)==0) DR_IMP(K,I)=DR_IMP(K,I)- DROT(K)
8115 ENDDO
8116 END IF
8117 END IF
8118 ENDDO
8119 END IF
8120.AND. IF (ITTOFF>0 NCYCLE==1) THEN
8121 write(iout,*)
8122 write(iout,*)'segment served as reference are the following nodes:'
8123 if (IRIG_M>1) THEN
8124 if (E_REF(1)>0) write(iout,*) 'node_ref 1 :',itab(E_REF(1))
8125 if (E_REF(2)>0) write(iout,*) 'node_ref 2 :',itab(E_REF(2))
8126 if (E_REF(3)>0) write(iout,*) 'node_ref 3 :',itab(E_REF(3))
8127 else
8128.AND..AND. if (E_REF(1)>0E_REF(2)>0E_REF(3)>0) then
8129 write(iout,*) (itab(E_REF(i)),i=1,N_SEG)
8130 else
8131 write(iout,*) (E_REF(i),i=1,N_SEG)
8132 end if
8133 end if
8134 write(iout,*)'reference point at this moment:'
8135 write(iout,*)X0 ,Y0 ,Z0
8136 write(iout,*)'dtra,drot,n_seg,ncycle=',N_SEG,ncycle
8137 write(iout,*)DTRA(1),DTRA(2),DTRA(3)
8138 write(iout,*)DROT(1),DROT(2),DROT(3)
8139 write(iout,*)'ilskew,lskew_g,ispmd=',ILSKEW,LSKEW_G,ISPMD
8140 write(iout,*)RLSKEW(1),RLSKEW(2),RLSKEW(3)
8141 write(iout,*)
8142 END IF
8143c IF (ITTOFF>0.AND.NCYCLE>1) THEN
8144c write(iout,*)
8145c write(iout,*)'DTRA,DROT,N_SEG,ILOC,ncycle=',N_SEG,ILOC,ncycle
8146c write(iout,*)DTRA(1),DTRA(2),DTRA(3)
8147c write(iout,*)DROT(1),DROT(2),DROT(3)
8148c write(iout,*)'LSKEW_G,ISPMD=',LSKEW_G,ISPMD
8149c write(iout,*)RLSKEW(1),RLSKEW(2),RLSKEW(3)
8150c write(iout,*)
8151c END IF
8152c write(iout,*)'E_REF(i)=',(itab(E_REF(i)),i=1,4)
8153c IF (ISPMD==0) THEN
8154c write(iout,*)'X0,DTRA,DROT,N_SEG,ncycle=',N_SEG,ncycle
8155c write(iout,*)X0 ,Y0 ,Z0
8156c write(iout,*)DTRA(1),DTRA(2),DTRA(3)
8157c write(iout,*)DROT(1),DROT(2),DROT(3)
8158c END IF
8159C------------------------------------------
8160 RETURN
8161 END
8162!||====================================================================
8163!|| spb_ieref_bc ../engine/source/implicit/imp_solv.F
8164!||--- called by ------------------------------------------------------
8165!|| spb_rm_rig ../engine/source/implicit/imp_solv.F
8166!||--- calls -----------------------------------------------------
8167!|| spmd_min_s ../engine/source/mpi/implicit/imp_spmd.F
8168!||--- uses -----------------------------------------------------
8169!|| imp_spbrm ../engine/share/modules/impbufdef_mod.F
8170!||====================================================================
8171 SUBROUTINE SPB_IEREF_BC(
8172 1 X ,IXC ,IXTG ,D_IMP ,DMIN ,
8173 2 NDOF ,IDDL ,IKC )
8174C-----------------------------------------------
8175C M o d u l e s
8176C-----------------------------------------------
8177 USE IMP_SPBRM
8178C-----------------------------------------------
8179C I m p l i c i t T y p e s
8180C-----------------------------------------------
8181#include "implicit_f.inc"
8182C-----------------------------------------------
8183C C o m m o n B l o c k s
8184C-----------------------------------------------
8185#include "com01_c.inc"
8186C-----------------------------------------------
8187C D u m m y A r g u m e n t s
8188C-----------------------------------------------
8189 INTEGER
8190 . NDOF(*),IDDL(*),IKC(*),IXC(NIXC,*), IXTG(NIXTG,*)
8191C REAL
8192 my_real
8193 . DMIN,X(3,*) ,D_IMP(3,*)
8194C-----------------------------------------------
8195C L o c a l V a r i a b l e s
8196C-----------------------------------------------
8197 INTEGER N,I,J,ND,NN,IE,IEM,K
8198 my_real
8199 . D(3),DD,DMINT
8200C------remove rigid motion of springback (incremental)
8201C----- find reference element: IF BCS the smallest Disp(at element center)) w/BCS C-------
8202C------doing once: NCYCLE=1
8203 DMIN=EP30
8204 IF (NCYCLE==1 )THEN
8205 ILSKEW = 0
8206 LSKEW_G = 0
8207 IKCE(1:6) = 0
8208 E_REF(1:4) = 0
8209 DO I = 1, NE_BC4
8210 IE =IE_BC4(I)
8211 DO K = 1,3
8212 D(K) = ZERO
8213 DO J= 1,4
8214 N = IXC(J+1,IE)
8215 D(K) = D(K) + D_IMP(K,N)
8216 END DO
8217 END DO
8218 DD = MIN(ABS(D(1)),ABS(D(2)),ABS(D(3)))
8219 IF (DD < DMIN) THEN
8220 DMIN = DD
8221 E_REF(1:4) = IXC(2:5,IE)
8222 END IF
8223 END DO
8224C
8225 DO I = 1, NE_BC3
8226 IE =IE_BC3(I)
8227 DO K = 1,3
8228 D(K) = ZERO
8229 DO J= 1,3
8230 N = IXTG(J+1,IE)
8231 D(K) = D(K) + D_IMP(K,N)
8232 END DO
8233 END DO
8234 DD = MIN(ABS(D(1)),ABS(D(2)),ABS(D(3)))
8235 IF (DD < DMIN) THEN
8236 DMIN = DD
8237 E_REF(1:3) = IXTG(2:4,IE)
8238 E_REF(4) = E_REF(3)
8239 END IF
8240 END DO
8241C-----not to use allow BCS (global only IKC=1) dof direction
8242C----- add BCS w/ SKEW (ILSKEW=1 w/ ref); Ud (IKC=2,9) could also be added--
8243 DO J = 1, 4
8244 N = E_REF(J)
8245 IF (N==0) CYCLE
8246 DO K= 1,NDOF(N)
8247 ND = IDDL(N)+K
8248.AND. IF (IKC(ND)>0IKCE(K)==0) IKCE(K) = 1
8249 END DO
8250 END DO
8251C--------to limit change during the iteration and dependant of np
8252 IF (NSPMD>1) THEN
8253 DMINT = DMIN
8254 CALL SPMD_MIN_S(DMINT)
8255C------not in this domain-----
8256 IF (DMINT<DMIN) THEN
8257 E_REF(1:4) = 0
8258 END IF
8259 END IF
8260 IF ((E_REF(1)+E_REF(2)+E_REF(3)+E_REF(4))==0) THEN
8261 N_SEG = 0
8262 ELSEIF(E_REF(4) == E_REF(3)) THEN
8263 N_SEG = 3
8264 ELSE
8265 N_SEG = 4
8266 END IF
8267 IF (N_SEG>0) THEN
8268 DO J = 1, 4
8269 N = E_REF(J)
8270 IF (N==0) CYCLE
8271 DO K= 1,NDOF(N)
8272 ND = IDDL(N)+K
8273 IF (IKC(ND)==8) ILSKEW = N
8274 END DO
8275 END DO
8276 IF (ILSKEW >0) LSKEW_G=1
8277 END IF
8278C-------Ncycle>1
8279 ELSEIF ((E_REF(1)+E_REF(2)+E_REF(3)+E_REF(4)) >0) THEN
8280 DO K = 1, 3
8281 D(K) = ZERO
8282 DO J= 1,3
8283 N = E_REF(J)
8284 D(K) = D(K) + D_IMP(K,N)
8285 END DO
8286 IF (E_REF(4) /= E_REF(3)) THEN
8287 N = E_REF(4)
8288 D(K) = D(K) + D_IMP(K,N)
8289 END IF
8290 END DO
8291 DMIN = MIN(ABS(D(1)),ABS(D(2)),ABS(D(3)))
8292 END IF !(NCYCLE==1 )THEN
8293 X_REF(1:3,1:4) = ZERO
8294 D_REF(1:3,1:4) = ZERO
8295 IF (N_SEG > 0) THEN
8296 DO J= 1,4
8297 N = E_REF(J)
8298 X_REF(1:3,J)= X(1:3,N)
8299 D_REF(1:3,J)= D_IMP(1:3,N)
8300 END DO
8301 END IF
8302C------------------------------------------
8303 RETURN
8304 END
8305!||====================================================================
8306!|| spb_rgmod ../engine/source/implicit/imp_solv.F
8307!||--- called by ------------------------------------------------------
8308!|| spb_rm_rig ../engine/source/implicit/imp_solv.F
8309!||====================================================================
8310 SUBROUTINE SPB_RGMOD(N_SEG,X_REF ,D_REF ,X ,D ,
8311 1 X0 ,Y0 ,Z0 ,DTRA ,DROT )
8312C-----------------------------------------------
8313C I m p l i c i t T y p e s
8314C-----------------------------------------------
8315#include "implicit_f.inc"
8316C-----------------------------------------------
8317C D u m m y A r g u m e n t s
8318C-----------------------------------------------
8319 INTEGER N_SEG
8320C REAL
8321 my_real
8322 . X_REF(3,4),D_REF(3,4),X(3,*),D(3,*),DTRA(3),DROT(3),
8323 . X0 ,Y0 ,Z0
8324C-----------------------------------------------
8325C L o c a l V a r i a b l e s
8326C-----------------------------------------------
8327 INTEGER I, J, II, L, JJ,NJ,K,NIR
8328C REAL
8329 my_real
8330 . XX,YY,ZZ,XXX,YYY,ZZZ,XY,YZ,ZX,XY2,YZ2,ZX2,
8331 . B1,B2,B3,C1,C2,C3,FACM,RJ(3,3,4),
8332 . X22,Y22,Z22,DET,XM(4),YM(4),ZM(4)
8333 my_real
8334 . XS,YS,ZS
8335C------------------------------------
8336C MATRICE DE JACOBIEN [C]
8337C------------------------------------
8338 NIR=N_SEG
8339 DO J=1,NIR
8340C NJ=IRECT(J)
8341 XM(J)=X_REF(1,J)
8342 YM(J)=X_REF(2,J)
8343 ZM(J)=X_REF(3,J)
8344 ENDDO
8345 IF(NIR==3) THEN
8346 XM(4)=ZERO
8347 YM(4)=ZERO
8348 ZM(4)=ZERO
8349 ENDIF
8350 FACM = ONE / NIR
8351C----------------------------------------------------
8352C VITESSE DE ROTATION MOYENNE DU SEGMENT MAIN
8353C----------------------------------------------------
8354 X0=FACM*(XM(1)+XM(2)+XM(3)+XM(4))
8355 Y0=FACM*(YM(1)+YM(2)+YM(3)+YM(4))
8356 Z0=FACM*(ZM(1)+ZM(2)+ZM(3)+ZM(4))
8357 DO J=1,NIR
8358 XM(J)=XM(J)-X0
8359 YM(J)=YM(J)-Y0
8360 ZM(J)=ZM(J)-Z0
8361 ENDDO
8362C-------
8363 XX=0
8364 YY=0
8365 ZZ=0
8366 XY=0
8367 YZ=0
8368 ZX=0
8369 DO J=1,NIR
8370 XX=XX+ XM(J)*XM(J)
8371 YY=YY+ YM(J)*YM(J)
8372 ZZ=ZZ+ ZM(J)*ZM(J)
8373 XY=XY+ XM(J)*YM(J)
8374 YZ=YZ+ YM(J)*ZM(J)
8375 ZX=ZX+ ZM(J)*XM(J)
8376 ENDDO
8377 ZZZ=XX+YY
8378 XXX=YY+ZZ
8379 YYY=ZZ+XX
8380 XY2=XY*XY
8381 YZ2=YZ*YZ
8382 ZX2=ZX*ZX
8383 DET= XXX*YYY*ZZZ -XXX*YZ2 -YYY*ZX2 -ZZZ*XY2 -TWO*XY*YZ*ZX
8384 DET=ONE/DET
8385 B1=(ZZZ*YYY-YZ2)*DET
8386 B2=(XXX*ZZZ-ZX2)*DET
8387 B3=(YYY*XXX-XY2)*DET
8388 C3=(ZZZ*XY+YZ*ZX)*DET
8389 C1=(XXX*YZ+ZX*XY)*DET
8390 C2=(YYY*ZX+XY*YZ)*DET
8391 DO J=1,NIR
8392 X22 = C1*XM(J)
8393 Y22 = C2*YM(J)
8394 Z22 = C3*ZM(J)
8395C-------RJ=(R^tR)^-1Rj^t-(j=1,ndir)---
8396 RJ(1,1,J)=Z22-Y22
8397 RJ(2,1,J)=B2*ZM(J)-C1*YM(J)
8398 RJ(3,1,J)=C1*ZM(J)-B3*YM(J)
8399 RJ(1,2,J)=-B1*ZM(J)+C2*XM(J)
8400 RJ(2,2,J)=-Z22+X22
8401 RJ(3,2,J)=-C2*ZM(J)+B3*XM(J)
8402 RJ(1,3,J)=B1*YM(J)-C3*XM(J)
8403 RJ(2,3,J)=C3*YM(J)-B2*XM(J)
8404 RJ(3,3,J)=Y22-X22
8405 ENDDO
8406C
8407 DO I=1,3
8408 DTRA(I)= ZERO
8409 DROT(I) = ZERO
8410 DO J=1,NIR
8411C NJ=IRECT(J)
8412 DROT(I)=DROT(I)+RJ(I,1,J)*D_REF(1,J)+
8413 . RJ(I,2,J)*D_REF(2,J)+RJ(I,3,J)*D_REF(3,J)
8414 DTRA(I)=DTRA(I)+FACM*D_REF(I,J)
8415 END DO
8416 END DO
8417C
8418 RETURN
8419 END
8420!||====================================================================
8421!|| spb_ieref3 ../engine/source/implicit/imp_solv.F
8422!||--- called by ------------------------------------------------------
8423!|| spb_rm_rig ../engine/source/implicit/imp_solv.F
8424!||--- calls -----------------------------------------------------
8425!|| spmd_min_s ../engine/source/mpi/implicit/imp_spmd.F
8426!||--- uses -----------------------------------------------------
8427!|| imp_spbrm ../engine/share/modules/impbufdef_mod.F
8428!||====================================================================
8429 SUBROUTINE SPB_IEREF3(
8430 1 X ,IXC ,IXTG ,NDOF ,IDDL ,
8431 2 IKC ,D_IMP ,DR_IMP ,DMIN )
8432C-----------------------------------------------
8433C M o d u l e s
8434C-----------------------------------------------
8435 USE IMP_SPBRM
8436C-----------------------------------------------
8437C I m p l i c i t T y p e s
8438C-----------------------------------------------
8439#include "implicit_f.inc"
8440C-----------------------------------------------
8441C C o m m o n B l o c k s
8442C-----------------------------------------------
8443#include "com01_c.inc"
8444C-----------------------------------------------
8445C D u m m y A r g u m e n t s
8446C-----------------------------------------------
8447 INTEGER
8448 . IXC(NIXC,*), IXTG(NIXTG,*), NDOF(*),IDDL(*),IKC(*)
8449C REAL
8450 my_real
8451 . DMIN,X(3,*) ,D_IMP(3,*) ,DR_IMP(3,*)
8452C-----------------------------------------------
8453C L o c a l V a r i a b l e s
8454C-----------------------------------------------
8455 INTEGER N,I,J,ND,NN,IE,IEM,K,NSAVE(4)
8456 my_real
8457 . D(3),DD,DR(3),DDR,DMINT
8458C----- find reference element: around element center))
8459C--------NSAVE(1) : XMIN, 2 : YMIN, 3 : ZMIN, 4 : DMIN
8460 DMIN=EP30
8461 IF (NCYCLE==1 )THEN
8462 NSAVE(1:4) = E_REF(1:4)
8463 E_REF(1:4) = 0
8464 DO I = 1,4
8465 IE =IABS(NSAVE(I))
8466 IF (IE==0) CYCLE
8467 DO K = 1,3
8468 D(K) = ZERO
8469 DR(K) = ZERO
8470 IF (NSAVE(4)<0) THEN
8471 DO J= 1,3
8472 N = IXTG(J+1,IE)
8473 D(K) = D(K) + D_IMP(K,N)
8474 DR(K) = DR(K) + DR_IMP(K,N)
8475 END DO
8476 ELSE
8477 DO J= 1,4
8478 N = IXC(J+1,IE)
8479 D(K) = D(K) + D_IMP(K,N)
8480 DR(K) = DR(K) + DR_IMP(K,N)
8481 END DO
8482 END IF
8483 END DO
8484 DD = MIN(ABS(D(1)),ABS(D(2)),ABS(D(3)))
8485 DDR = MAX(ABS(DR(1)),ABS(DR(2)),ABS(DR(3)))
8486C -------min(max(DR(j))) (1:4)------
8487 IF (DDR < DMIN) THEN
8488 DMIN = DDR
8489 IF (NSAVE(4)<0) THEN
8490 E_REF(1:3) = IXTG(2:4,IE)
8491 E_REF(4) = E_REF(3)
8492 ELSE
8493 E_REF(1:4) = IXC(2:5,IE)
8494 END IF
8495 END IF
8496 END DO
8497C
8498 IF (NSPMD>1) THEN
8499 DMINT = DMIN
8500 CALL SPMD_MIN_S(DMINT)
8501C------not in this domain-----
8502 IF (DMINT<DMIN) THEN
8503 E_REF(1:4) = 0
8504 END IF
8505 END IF
8506 IF ((E_REF(1)+E_REF(2)+E_REF(3)+E_REF(4))==0) THEN
8507 N_SEG = 0
8508 ELSEIF(E_REF(4) == E_REF(3)) THEN
8509 N_SEG = 3
8510 ELSE
8511 N_SEG = 4
8512 END IF
8513C---- Ncycle>1
8514 ELSE
8515 IF ((E_REF(1)+E_REF(2)+E_REF(3)+E_REF(4))==0) N_SEG = 0
8516 IF (N_SEG>0) THEN
8517 DO K = 1, 3
8518 DR(K) = ZERO
8519 DO J= 1,3
8520 N = E_REF(J)
8521 DR(K) = DR(K) + DR_IMP(K,N)
8522 END DO
8523 IF (E_REF(4) /= E_REF(3)) THEN
8524 N = E_REF(4)
8525 DR(K) = DR(K) + DR_IMP(K,N)
8526 END IF
8527 END DO
8528 DMIN = MAX(ABS(DR(1)),ABS(DR(2)),ABS(DR(3)))
8529 END IF !(N_SEG>0) THEN
8530 END IF !(NCYCLE==1 )THEN
8531 X_REF(1:3,1:4) = ZERO
8532 D_REF(1:3,1:4) = ZERO
8533 IF (N_SEG > 0) THEN
8534 DO J= 1,4
8535 N = E_REF(J)
8536 X_REF(1:3,J)= X(1:3,N)
8537 D_REF(1:3,J)= D_IMP(1:3,N)
8538 END DO
8539 END IF
8540C------------------------------------------
8541 RETURN
8542 END
8543!||====================================================================
8544!|| imp_intbuf_ini ../engine/source/implicit/imp_solv.F
8545!||--- called by ------------------------------------------------------
8546!|| dim_int7 ../engine/source/implicit/ind_glob_k.F
8547!||--- uses -----------------------------------------------------
8548!|| imp_intbufdef ../engine/share/modules/imp_mod_def.F90
8549!||====================================================================
8550 SUBROUTINE IMP_INTBUF_INI(IMP_INTBUF_TAB,NIMP)
8551C-----------------------------------------------
8552C M o d u l e s
8553C-----------------------------------------------
8554 USE IMP_INTBUFDEF
8555C-----------------------------------------------
8556C I m p l i c i t T y p e s
8557C-----------------------------------------------
8558#include "implicit_f.inc"
8559C-----------------------------------------------
8560C C o m m o n B l o c k s
8561C-----------------------------------------------
8562#include "com04_c.inc"
8563C-----------------------------------------------
8564C D u m m y A r g u m e n t s
8565C-----------------------------------------------
8566 TYPE(IMP_INTBUF_STRUCT_) IMP_INTBUF_TAB(*)
8567 INTEGER NIMP(*)
8568C-----------------------------------------------
8569C L o c a l V a r i a b l e s
8570C-----------------------------------------------
8571 INTEGER I,N,NI,SIZ,I_CONT
8572C=======================================================================
8573
8574 DO NI= 1, NINTER
8575 I_CONT = NIMP(NI)
8576 IMP_INTBUF_TAB(NI)%S_I_STOK = 1
8577 IMP_INTBUF_TAB(NI)%S_CAND_N = 0
8578 IMP_INTBUF_TAB(NI)%S_CAND_E = 0
8579 IMP_INTBUF_TAB(NI)%S_INDSUBT = 0
8580 IMP_INTBUF_TAB(NI)%S_HJ = 0
8581 IMP_INTBUF_TAB(NI)%S_NJ = 0
8582 IMP_INTBUF_TAB(NI)%S_STIF = 0
8583 ALLOCATE(IMP_INTBUF_TAB(NI)%I_STOK(IMP_INTBUF_TAB(NI)%S_I_STOK))
8584 IMP_INTBUF_TAB(NI)%I_STOK(1:IMP_INTBUF_TAB(NI)%S_I_STOK) = 0
8585 IF (I_CONT > 0) THEN
8586 IMP_INTBUF_TAB(NI)%S_CAND_N = I_CONT
8587 IMP_INTBUF_TAB(NI)%S_CAND_E = I_CONT
8588 IMP_INTBUF_TAB(NI)%S_INDSUBT = I_CONT
8589 IMP_INTBUF_TAB(NI)%S_HJ = 4*I_CONT
8590 IMP_INTBUF_TAB(NI)%S_NJ = 3*I_CONT
8591 IMP_INTBUF_TAB(NI)%S_STIF = I_CONT
8592C------Allocate, ini to zero
8593 ALLOCATE(IMP_INTBUF_TAB(NI)%CAND_N(IMP_INTBUF_TAB(NI)%S_CAND_N))
8594 IMP_INTBUF_TAB(NI)%CAND_N(1:IMP_INTBUF_TAB(NI)%S_CAND_N) = 0
8595 ALLOCATE(IMP_INTBUF_TAB(NI)%CAND_E(IMP_INTBUF_TAB(NI)%S_CAND_E))
8596 IMP_INTBUF_TAB(NI)%CAND_E(1:IMP_INTBUF_TAB(NI)%S_CAND_E) = 0
8597 ALLOCATE(IMP_INTBUF_TAB(NI)%INDSUBT(IMP_INTBUF_TAB(NI)%S_INDSUBT))
8598 IMP_INTBUF_TAB(NI)%INDSUBT(1:IMP_INTBUF_TAB(NI)%S_INDSUBT) = 0
8599C
8600 ALLOCATE(IMP_INTBUF_TAB(NI)%HJ(IMP_INTBUF_TAB(NI)%S_HJ))
8601 IMP_INTBUF_TAB(NI)%HJ(1:IMP_INTBUF_TAB(NI)%S_HJ) = ZERO
8602 ALLOCATE(IMP_INTBUF_TAB(NI)%NJ(IMP_INTBUF_TAB(NI)%S_NJ))
8603 IMP_INTBUF_TAB(NI)%NJ(1:IMP_INTBUF_TAB(NI)%S_NJ) = ZERO
8604 ALLOCATE(IMP_INTBUF_TAB(NI)%STIF(IMP_INTBUF_TAB(NI)%S_STIF))
8605 IMP_INTBUF_TAB(NI)%STIF(1:IMP_INTBUF_TAB(NI)%S_STIF) = ZERO
8606 END IF
8607
8608 ENDDO !NI=1,NINTER
8609
8610C-----
8611 RETURN
8612
8613 END SUBROUTINE IMP_INTBUF_INI
8614!||====================================================================
8615!|| imp_errmumps ../engine/source/implicit/imp_solv.F
8616!||--- called by ------------------------------------------------------
8617!|| spmd_mumps_exec ../engine/source/mpi/implicit/imp_spmd.F
8618!||--- calls -----------------------------------------------------
8619!|| imp_stop ../engine/source/implicit/imp_solv.F
8620!||====================================================================
8621 SUBROUTINE IMP_ERRMUMPS(IERR)
8622C-----------------------------------------------
8623C I m p l i c i t T y p e s
8624C-----------------------------------------------
8625#include "implicit_f.inc"
8626C-----------------------------------------------
8627C C o m m o n B l o c k s
8628C-----------------------------------------------
8629#include "units_c.inc"
8630C-----------------------------------------------
8631C D u m m y A r g u m e n t s
8632C-----------------------------------------------
8633 INTEGER IERR,ISTOP
8634C-----------------------------------------------
8635C L o c a l V a r i a b l e s
8636C-----------------------------------------------
8637 WRITE(ISTDO,1000)IERR
8638 WRITE(IOUT,1000)IERR
8639 SELECT CASE (-IERR)
8640 CASE(7,8,9,11,13,14,15,17)
8641 WRITE(ISTDO,1030)
8642 WRITE(IOUT,1010)
8643 CASE(6,10)
8644 WRITE(ISTDO,2000)
8645 WRITE(IOUT,2010)
8646 END SELECT
8647 IF(IERR<0)THEN
8648 ISTOP=-4
8649 CALL IMP_STOP(ISTOP)
8650 END IF
8651C
8652 RETURN
8653 1000 FORMAT(/
8654 . ' ** linear solver mumps error code: ',I6/)
8655 1030 FORMAT(/
8656 . ' ** error memory issue ' /)
8657 1010 FORMAT(/
8658 . ' ** error memory issue. possible solutions:' /,
8659 . ' *run on a computer with more memory ;' /,
8660 . ' *TRY LESS THREADS AND LESS PROCS PER COMPUTER NODE ;' /,
8661 . ' *CLOSE OTHER APPLICATIONS ; ' /)
8662 2000 FORMAT(/
8663 . ' ** ERROR OF SINGULAR MATRIX ' /)
8664 2010 FORMAT(/
8665 . ' ** ERROR OF SINGULAR MATRIX. POSSIBLE SOLUTIONS:' /,
8666 . ' *CHECK IF THE MODEL IS WELL CONDITIONED ;' /,
8667 . ' *TRYING QUASI-STATIC SOLUTION ; ' /)
8668 END
8669
8670
8671
8672!||====================================================================
8673!|| pvp_k ../engine/source/implicit/imp_solv.F
8674!||--- called by ------------------------------------------------------
8675!|| imp_chkm ../engine/source/implicit/imp_solv.F
8676!||--- calls -----------------------------------------------------
8677!|| jacobien ../engine/source/implicit/imp_glob_k.F
8678!|| minv_k ../engine/source/implicit/imp_solv.F
8679!||--- uses -----------------------------------------------------
8680!|| ecnd_mod ../engine/share/modules/ecdn_mod.F
8681!||====================================================================
8682 SUBROUTINE pvp_k(ND ,IADK,JDIK,IDDL ,INLOC,
8683 . NDOF,ITAB,K_DIAG,K_LT ,LAMDA, NODE,MS )
8684C----6---------------------------------------------------------------7---------8
8685 USE ecnd_mod
8686C----6---------------------------------------------------------------7---------8
8687C I m p l i c i t T y p e s
8688C-----------------------------------------------
8689#include "implicit_f.inc"
8690C-----------------------------------------------
8691C C o m m o n B l o c k s
8692C-----------------------------------------------
8693#include "com04_c.inc"
8694#include "units_c.inc"
8695C-----------------------------------------------
8696C D u m m y A r g u m e n t s
8697C-----------------------------------------------
8698 INTEGER ND,NODE
8699 INTEGER JDIK(*) ,IADK(*),IDDL(*),INLOC(*),NDOF(*),ITAB(*)
8700C REAL
8701 my_real
8702 . K_DIAG(*) ,K_LT(*) ,LAMDA,MS(*)
8703C-----------------------------------------------
8704C L o c a l V a r i a b l e s
8705C-----------------------------------------------
8706 INTEGER I,K,J,IK,ID,JD,L,N,NN,JJ,IDT
8707 my_real
8708 . KE(ND,ND) ,EV(ND,ND),EW(ND),LA,TOL,MSD(ND),MSIJ,TOL1
8709C----6----------------------------------
8710 TOL=em5
8711 tol1=em10
8712 ke(1:nd,1:nd)=zero
8713 node = 0
8714 lamda = zero
8715 IF (ns10e==0) THEN
8716C-----taking into account to M-1
8717 DO n =1,numnod
8718 i=inloc(n)
8719 DO j=1,ndof(i)
8720 ik = iddl(i)+j
8721 msd(ik)=ms(i)
8722C----free node
8723 IF (msd(ik)<em20) msd(ik)=one
8724 ENDDO
8725 ENDDO
8726 DO k=1,nd
8727 ke(k,k) = k_diag(k)/msd(k)
8728 DO j = iadk(k),iadk(k+1)-1
8729 jd = jdik(j)
8730 msij=one/sqrt(msd(k))/sqrt(msd(jd))
8731 ke(k,jd) = k_lt(j)*msij
8732 ke(jd,k) = ke(k,jd)
8733 ENDDO
8734 ENDDO
8735 ELSE
8736C-------itet=2 (not dumped [M]), should not mix w/ other elements
8737 DO k=1,nd
8738 ke(k,k) = k_diag(k)
8739 DO j = iadk(k),iadk(k+1)-1
8740 jd = jdik(j)
8741 ke(k,jd) = k_lt(j)
8742 ke(jd,k) = ke(k,jd)
8743 ENDDO
8744 ENDDO
8745 CALL minv_k(nd ,icnds10,iddl ,inloc,ndof,
8746 . ms ,tol ,ke )
8747 END IF !(NS10E==0) THEN
8748 CALL jacobien(ke,nd,ew,ev,tol1,lamda)
8749C---Node:N direction:J
8750 id = 0
8751 DO k=1,nd
8752 IF (ew(k)>=lamda) id = k
8753 IF (id > 0 ) cycle
8754 ENDDO
8755 DO n =1,numnod
8756 i=inloc(n)
8757 jj = 0
8758 DO j=1,ndof(i)
8759 ik = iddl(i)+j
8760 IF (ik==id) jj= j
8761 ENDDO
8762 IF (jj > 0) THEN
8763 node= n
8764 WRITE(iout,*)'1er EIGENVALUE(K/M) OF NODE+DIR:',lamda,itab(n),jj
8765 cycle
8766 END IF
8767 ENDDO
8768C
8769 RETURN
8770 END
8771!||====================================================================
8772!|| minv_k ../engine/source/implicit/imp_solv.f
8773!||--- called by ------------------------------------------------------
8774!|| pvp_k ../engine/source/implicit/imp_solv.F
8775!||--- calls -----------------------------------------------------
8776!|| jacobien ../engine/source/implicit/imp_glob_k.F
8777!||====================================================================
8778 SUBROUTINE minv_k(ND ,ICNDS10,IDDL ,INLOC,NDOF,
8779 . MS ,TOL ,KE )
8780C----6---------------------------------------------------------------7---------8
8781C I m p l i c i t T y p e s
8782C-----------------------------------------------
8783#include "implicit_f.inc"
8784C-----------------------------------------------
8785C C o m m o n B l o c k s
8786C-----------------------------------------------
8787#include "com04_c.inc"
8788C-----------------------------------------------
8789C D u m m y A r g u m e n t s
8790C-----------------------------------------------
8791 INTEGER ND
8792 INTEGER ICNDS10(3,*),IDDL(*),INLOC(*),NDOF(*)
8793C REAL
8794 my_real
8795 . ke(nd,nd) ,ms(*),tol
8796C-----------------------------------------------
8797C L o c a l V a r i a b l e s
8798C-----------------------------------------------
8799 INTEGER I,K,J,IK,ID,JD,L,N,NN,N1,N2,II,JJ,JK
8800 my_real
8801 . ev(nd,nd),ew(nd),
8802 . la,msd(nd),msij,lamda,me(nd,nd),msnd,msii
8803C----6----------------------------------
8804 lamda = zero
8805 me(1:nd,1:nd) = zero
8806 DO i =1,ns10e
8807 nn = iabs(icnds10(1,i))
8808 n1 = icnds10(2,i)
8809 n2 = icnds10(3,i)
8810 id=inloc(nn)
8811 msnd = ms(id)
8812 DO j=1,ndof(id)
8813 ik = iddl(id)+j
8814 me(ik,ik)=me(ik,ik)+msnd
8815 END DO
8816 ii=inloc(n1)
8817 msii = third*ms(ii) + fourth*msnd
8818 DO j=1,ndof(ii)
8819 ik = iddl(ii)+j
8820 me(ik,ik)=me(ik,ik)+msii
8821 END DO
8822 jj=inloc(n2)
8823 msii = third*ms(jj) + fourth*msnd
8824 DO j=1,ndof(jj)
8825 ik = iddl(jj)+j
8826 me(ik,ik)=me(ik,ik)+msii
8827 END DO
8828C--------- m12
8829 msii = fourth*msnd
8830C--------suppose NDOF(II)= NDOF(JJ) = NDOF(ID)
8831 DO j=1,ndof(ii)
8832 ik = iddl(ii)+j
8833 jk = iddl(jj)+j
8834 me(ik,jk)=me(ik,jk)+msii
8835 me(jk,ik)=me(jk,ik)+msii
8836 END DO
8837C--------- m13,m23
8838 msii = -half*msnd
8839 DO j=1,ndof(ii)
8840 ik = iddl(ii)+j
8841 jk = iddl(id)+j
8842 me(ik,jk)=me(ik,jk)+msii
8843 me(jk,ik)=me(jk,ik)+msii
8844 END DO
8845 DO j=1,ndof(jj)
8846 ik = iddl(jj)+j
8847 jk = iddl(id)+j
8848 me(ik,jk)=me(ik,jk)+msii
8849 me(jk,ik)=me(jk,ik)+msii
8850 END DO
8851 END DO !I =1,NS10E
8852 DO i =1,nd
8853 DO j =i,nd
8854 me(j,i)=me(i,j)
8855 END DO
8856 END DO
8857 CALL jacobien(me,nd,ew,ev,tol,lamda)
8858C-------[EV]'-> [EV]*EW^-1/2
8859 DO i =1,nd
8860c print *,'M, ME(I,I),I=',ME(I,I),I
8861 ew(i)=one/sqrt(ew(i))
8862 END DO
8863 DO i =1,nd
8864 DO j =1,nd
8865 ev(i,j)=ev(i,j)*ew(j)
8866 END DO
8867 END DO
8868C-------[K]-> [EV]^t*[K]*[EV]
8869 me(1:nd,1:nd) = zero
8870 DO i=1,nd
8871 DO j=1,nd
8872 DO k = 1,nd
8873 me(i,j)=me(i,j)+ke(i,k)*ev(k,j)
8874 ENDDO
8875 ENDDO
8876 ENDDO
8877 ke(1:nd,1:nd) = zero
8878 DO i=1,nd
8879 DO j=1,nd
8880 DO k = 1,nd
8881 ke(i,j)=ke(i,j)+ev(k,i)*me(k,j)
8882 ENDDO
8883 ENDDO
8884 ENDDO
8885C
8886 RETURN
8887 END
8888!||====================================================================
8889!|| getikce ../engine/source/implicit/imp_solv.F
8890!||--- called by ------------------------------------------------------
8891!|| spb_ref_nds ../engine/source/implicit/imp_solv.F
8892!|| spb_rm_rig ../engine/source/implicit/imp_solv.F
8893!||====================================================================
8894 SUBROUTINE getikce(ICT ,ICR,K,IFIX )
8895C-----------------------------------------------
8896C I m p l i c i t T y p e s
8897C-----------------------------------------------
8898#include "implicit_f.inc"
8899C-----------------------------------------------
8900C D u m m y A r g u m e n t s
8901C-----------------------------------------------
8902 INTEGER ICT,ICR,IFIX(6),K
8903C-----------------------------------------------
8904C L o c a l V a r i a b l e s
8905C-----------------------------------------------
8906 INTEGER ND
8907C----------------BC-------------------------
8908 ifix(1:6) = 0
8909 nd = 0
8910 IF (ict > 0 .AND. k> 0) THEN
8911 IF (ict == 4 .AND. k>2) THEN
8912 ifix(nd +1) = 1
8913 ELSEIF (ict == 2) THEN
8914 ifix(nd +2) = 1
8915 ELSEIF (ict == 1) THEN
8916 ifix(nd +3) = 1
8917 ELSEIF (ict == 3) THEN
8918 ifix(nd +2) = 1
8919 ifix(nd +3) = 1
8920 ELSEIF (ict == 5) THEN
8921 IF (k>2) ifix(nd +1) = 1
8922 ifix(nd +3) = 1
8923 ELSEIF (ict == 6) THEN
8924 IF (k>2) ifix(nd +1) = 1
8925 ifix(nd +2) = 1
8926 ELSEIF (ict == 7) THEN
8927 IF (k>2) ifix(nd +1) = 1
8928 ifix(nd +2) = 1
8929 ifix(nd +3) = 1
8930 ENDIF
8931 ENDIF
8932C
8933 IF (icr > 0 .AND. k==6) THEN
8934 IF (icr == 1) THEN
8935 ifix(nd +6) = 1
8936 ELSEIF (icr == 2) THEN
8937 ifix(nd +5) = 1
8938 ELSEIF (icr == 3) THEN
8939 ifix(nd +5) = 1
8940 ifix(nd +6) = 1
8941 ELSEIF (icr == 4) THEN
8942 ifix(nd +4) = 1
8943 ELSEIF (icr == 5) THEN
8944 ifix(nd +4) = 1
8945 ifix(nd +6) = 1
8946 ELSEIF (icr == 6) THEN
8947 ifix(nd +4) = 1
8948 ifix(nd +5) = 1
8949 ELSEIF (icr == 7) THEN
8950 ifix(nd +4) = 1
8951 ifix(nd +5) = 1
8952 ifix(nd +6) = 1
8953 ENDIF
8954 ENDIF
8955C
8956 RETURN
8957 END
8958!||====================================================================
8959!|| transvg2l ../engine/source/implicit/imp_solv.F
8960!||--- called by ------------------------------------------------------
8961!|| spb_rm_rig ../engine/source/implicit/imp_solv.F
8962!||====================================================================
8963 SUBROUTINE transvg2l(SKEW ,VG ,VL )
8964C-----------------------------------------------
8965C I m p l i c i t T y p e s
8966C-----------------------------------------------
8967#include "implicit_f.inc"
8968C-----------------------------------------------
8969C D u m m y A r g u m e n t s
8970C-----------------------------------------------
8971 my_real
8972 . skew(*),vg(*),vl(*)
8973C-----------------------------------------------
8974C L o c a l V a r i a b l e s
8975C-----------------------------------------------
8976 INTEGER J
8977C----------------------------------------
8978 VL(1)=skew(1)*vg(1)+skew(2)*vg(2)+skew(3)*vg(3)
8979 vl(2)=skew(4)*vg(1)+skew(5)*vg(2)+skew(6)*vg(3)
8980 vl(3)=skew(7)*vg(1)+skew(8)*vg(2)+skew(9)*vg(3)
8981C
8982 RETURN
8983 END
8984!||====================================================================
8985!|| transvl2g ../engine/source/implicit/imp_solv.F
8986!||--- called by ------------------------------------------------------
8987!|| spb_rm_rig ../engine/source/implicit/imp_solv.F
8988!||====================================================================
8989 SUBROUTINE transvl2g(SKEW ,VL ,VG )
8990C-----------------------------------------------
8991C I m p l i c i t T y p e s
8992C-----------------------------------------------
8993#include "implicit_f.inc"
8994C-----------------------------------------------
8995C D u m m y A r g u m e n t s
8996C-----------------------------------------------
8997 my_real
8998 . skew(*),vg(*),vl(*)
8999C-----------------------------------------------
9000C L o c a l V a r i a b l e s
9001C-----------------------------------------------
9002 INTEGER J
9003C----------------------------------------
9004 vg(1)=skew(1)*vl(1)+skew(4)*vl(2)+skew(7)*vl(3)
9005 vg(2)=skew(2)*vl(1)+skew(5)*vl(2)+skew(8)*vl(3)
9006 vl(3)=skew(3)*vl(1)+skew(6)*vl(2)+skew(9)*vl(3)
9007C
9008 RETURN
9009 END
9010!||====================================================================
9011!|| spb_ref_nds ../engine/source/implicit/imp_solv.F
9012!||--- called by ------------------------------------------------------
9013!|| spb_rm_rig ../engine/source/implicit/imp_solv.F
9014!||--- calls -----------------------------------------------------
9015!|| getikce ../engine/source/implicit/imp_solv.f
9016!||--- uses -----------------------------------------------------
9017!|| imp_spbrm ../engine/share/modules/impbufdef_mod.F
9018!||====================================================================
9019 SUBROUTINE spb_ref_nds(
9020 1 X ,D_IMP ,NDOF ,IDDL ,IKC ,
9021 2 ICODT ,ICODR ,ISKEW ,SKEW )
9022C-----------------------------------------------
9023C M o d u l e s
9024C-----------------------------------------------
9025 USE imp_spbrm
9026C-----------------------------------------------
9027C I m p l i c i t T y p e s
9028C-----------------------------------------------
9029#include "implicit_f.inc"
9030C-----------------------------------------------
9031C C o m m o n B l o c k s
9032C-----------------------------------------------
9033#include "param_c.inc"
9034C-----------------------------------------------
9035C D u m m y A r g u m e n t s
9036C-----------------------------------------------
9037 integer
9038 . ndof(*),iddl(*),ikc(*),icodt(*),icodr(*),iskew(*)
9039C REAL
9040 my_real
9041 . x(3,*) ,d_imp(3,*) ,skew(lskew,*)
9042C-----------------------------------------------
9043C L o c a l V a r i a b l e s
9044C-----------------------------------------------
9045 INTEGER N,I,J,ND,NN,IE,IEM,K,ISK
9046 my_real
9047 . D(3),DD,DMINT
9048C------case input 3 ref_nodes
9049 X_REF(1:3,1:4) = zero
9050 d_ref(1:3,1:4) = zero
9051 n_seg = 3
9052 DO j= 1,n_seg
9053 n = e_ref(j)
9054 IF (n==0) cycle
9055 x_ref(1:3,j)= x(1:3,n)
9056 d_ref(1:3,j)= d_imp(1:3,n)
9057 END DO
9058 IF (ilskew>0) THEN
9059C----get ISK(from E_REF)set [Q],transfert DTRA,DROT to local reset IKCE(6) put (j)=0 for fixing dir
9060 nn = ilskew
9061 isk = iskew(nn)
9062C---------local IKC
9063 rlskew(1:9) = skew(1:9,isk)
9064 CALL getikce(icodt(nn),icodr(nn),ndof(nn),ikce)
9065 END IF
9066C------------------------------------------
9067 RETURN
9068 END
9069C
9070!||====================================================================
9071!|| dealloc_impbuf ../engine/source/implicit/imp_solv.F
9072!||--- called by ------------------------------------------------------
9073!|| resol ../engine/source/engine/resol.F
9074!||--- uses -----------------------------------------------------
9075!|| impbufdef_mod ../engine/share/modules/impbufdef_mod.f
9076!||====================================================================
9077 SUBROUTINE dealloc_impbuf(IMPBUF_TAB)
9078C-----------------------------------------------
9079 USE impbufdef_mod
9080C-----------------------------------------------
9081C I m p l i c i t T y p e s
9082C-----------------------------------------------
9083#include "implicit_f.inc"
9084C-----------------------------------------------
9085C D u m m y A r g u m e n t s
9086C-----------------------------------------------
9087 TYPE (IMPBUF_STRUCT_) IMPBUF_TAB
9088C-----------------------------------------------
9089C L o c a l V a r i a b l e s
9090C-----------------------------------------------
9091C
9092 IF (ALLOCATED(impbuf_tab%IDDL)) DEALLOCATE(impbuf_tab%IDDL)
9093 IF (ALLOCATED(impbuf_tab%NDOF)) DEALLOCATE(impbuf_tab%NDOF)
9094 IF (ALLOCATED(impbuf_tab%INLOC)) DEALLOCATE(impbuf_tab%INLOC)
9095 IF (ALLOCATED(impbuf_tab%IRBYAC))DEALLOCATE(impbuf_tab%IRBYAC)
9096 IF (ALLOCATED(impbuf_tab%NSC)) DEALLOCATE(impbuf_tab%NSC)
9097 IF (ALLOCATED(impbuf_tab%IINT2)) DEALLOCATE(impbuf_tab%IINT2)
9098 IF (ALLOCATED(impbuf_tab%NKUD)) DEALLOCATE(impbuf_tab%NKUD)
9099 IF (ALLOCATED(impbuf_tab%IMONV)) DEALLOCATE(impbuf_tab%IMONV)
9100 IF (ALLOCATED(impbuf_tab%IADK)) DEALLOCATE(impbuf_tab%IADK)
9101 IF (ALLOCATED(impbuf_tab%JDIK)) DEALLOCATE(impbuf_tab%JDIK)
9102 IF (ALLOCATED(impbuf_tab%IKINW)) DEALLOCATE(impbuf_tab%IKINW)
9103 IF (ALLOCATED(impbuf_tab%IKC)) DEALLOCATE(impbuf_tab%IKC)
9104 IF (ALLOCATED(impbuf_tab%IKUD)) DEALLOCATE(impbuf_tab%IKUD)
9105 IF (ALLOCATED(impbuf_tab%W_DDL)) DEALLOCATE(impbuf_tab%W_DDL)
9106 IF (ALLOCATED(impbuf_tab%IADM)) DEALLOCATE(impbuf_tab%IADM)
9107 IF (ALLOCATED(impbuf_tab%JDIM)) DEALLOCATE(impbuf_tab%JDIM)
9108 IF (ALLOCATED(impbuf_tab%CAND_N)) DEALLOCATE(impbuf_tab%CAND_N)
9109 IF (ALLOCATED(impbuf_tab%CAND_E)) DEALLOCATE(impbuf_tab%CAND_E)
9110 IF (ALLOCATED(impbuf_tab%INDSUBT)) DEALLOCATE(impbuf_tab%INDSUBT)
9111 IF (ALLOCATED(impbuf_tab%NDOFI)) DEALLOCATE(impbuf_tab%NDOFI)
9112 IF (ALLOCATED(impbuf_tab%IDDLI)) DEALLOCATE(impbuf_tab%IDDLI)
9113 IF (ALLOCATED(impbuf_tab%INBUF_C)) DEALLOCATE(impbuf_tab%INBUF_C)
9114 IF (ALLOCATED(impbuf_tab%DIAG_K)) DEALLOCATE(impbuf_tab%DIAG_K)
9115 IF (ALLOCATED(impbuf_tab%LT_K)) DEALLOCATE(impbuf_tab%LT_K)
9116 IF (ALLOCATED(impbuf_tab%DIAG_M)) DEALLOCATE(impbuf_tab%DIAG_M)
9117 IF (ALLOCATED(impbuf_tab%LT_M)) DEALLOCATE(impbuf_tab%LT_M)
9118 IF (ALLOCATED(impbuf_tab%LB)) DEALLOCATE(impbuf_tab%LB)
9119 IF (ALLOCATED(impbuf_tab%LB0)) DEALLOCATE(impbuf_tab%LB0)
9120 IF (ALLOCATED(impbuf_tab%BKUD)) DEALLOCATE(impbuf_tab%BKUD)
9121 IF (ALLOCATED(impbuf_tab%D_IMP)) DEALLOCATE(impbuf_tab%D_IMP)
9122 IF (ALLOCATED(impbuf_tab%DR_IMP)) DEALLOCATE(impbuf_tab%DR_IMP)
9123 IF (ALLOCATED(impbuf_tab%ELBUF_C)) DEALLOCATE(impbuf_tab%ELBUF_C)
9124 IF (ALLOCATED(impbuf_tab%BUFMAT_C))DEALLOCATE(impbuf_tab%BUFMAT_C)
9125 IF (ALLOCATED(impbuf_tab%X_C)) DEALLOCATE(impbuf_tab%X_C)
9126 IF (ALLOCATED(impbuf_tab%DD)) DEALLOCATE(impbuf_tab%DD)
9127 IF (ALLOCATED(impbuf_tab%DDR)) DEALLOCATE(impbuf_tab%DDR)
9128 IF (ALLOCATED(impbuf_tab%X_A)) DEALLOCATE(impbuf_tab%X_A)
9129 IF (ALLOCATED(impbuf_tab%FEXT)) DEALLOCATE(impbuf_tab%FEXT)
9130 IF (ALLOCATED(impbuf_tab%DG)) DEALLOCATE(impbuf_tab%DG)
9131 IF (ALLOCATED(impbuf_tab%DGR)) DEALLOCATE(impbuf_tab%DGR)
9132 IF (ALLOCATED(impbuf_tab%DG0)) DEALLOCATE(impbuf_tab%DG0)
9133 IF (ALLOCATED(impbuf_tab%DGR0)) DEALLOCATE(impbuf_tab%DGR0)
9134 IF (ALLOCATED(impbuf_tab%BUFIN_C)) DEALLOCATE(impbuf_tab%BUFIN_C)
9135 IF (ALLOCATED(impbuf_tab%AC)) DEALLOCATE(impbuf_tab%AC)
9136 IF (ALLOCATED(impbuf_tab%ACR)) DEALLOCATE(impbuf_tab%ACR)
9137C
9138 RETURN
9139 END
9140
9141
put_nspc
subroutine put_nspc(nspc)
Definition bc_imp0.F:2708
get_nspc
subroutine get_nspc(nspc)
Definition bc_imp0.F:2683
cfield_imp
subroutine cfield_imp(icfield, fac, npc, tf, a, v, x, xframe, ms, wfextt, nsensor, sensor_tab, weight, iframe, ib, itask, nrbyac, irbyac, npby, rby, iskn, python)
Definition cfield_imp.F:41
my_real
#define my_real
Definition cppsort.cpp:32
if
if(complex_arithmetic) id
the
end diagonal values have been computed in the(sparse) matrix id.SOL
force_imp
subroutine force_imp(ib, fac, snpc, npc, tf, a, v, x, skews, ar, vr, nsensor, sensor_tab, wfexc, iadc, fsky, fext, h3d_data, cptreac, fthreac, nodreac, th_surf, dpl0cld, vel0cld, d, dr, nconld, numnod, nfunct, stf, wfext)
Definition force_imp.F:50
fv_fint0
subroutine fv_fint0(ibfv, npc, tf, vel, sensor_tab, ud, rd, ifix, iddl, nsensor, skew, iframe, xframe, a, ar, x, ndof, ms, in, weight, rby)
Definition fv_imp0.F:2137
fvbc_impl1
subroutine fvbc_impl1(ibfv, skew, xframe, lj, iddl, ifix, ndof, ud, rd, icodt, icodr, iskew)
Definition fv_imp0.F:3302
fv_rw
subroutine fv_rw(iddl, ikc, ndof, ud, v)
Definition fv_imp0.F:503
fvbc_deallo
subroutine fvbc_deallo
Definition fv_imp0.F:3248
fv_imp1
subroutine fv_imp1(nbk, iab, bk, b)
Definition fv_imp0.F:155
fv_dd0
subroutine fv_dd0(iddl, ikc, ndof, dd, ddr, d)
Definition fv_imp0.F:598
fv_imp
subroutine fv_imp(ibfv, npc, tf, vel, sensor_tab, ud, rd, ifix, iddl, nsensor, skew, iframe, xframe, v, vr, x, lj, ndof, a, ar)
Definition fv_imp0.F:213
gravit_imp
subroutine gravit_imp(igrv, agrv, npc, tf, a, v, x, skew, ms, wfextt, nsensor, sensor_tab, weight, ib, itask, nrbyac, irbyac, npby, rby, python)
Definition gravit_imp.F:42
drot
subroutine drot(n, dx, incx, dy, incy, c, s)
DROT
Definition drot.f:92
zero1
subroutine zero1(r, n)
Definition hm_read_rbe3.F:1481
bfgs_ini
subroutine bfgs_ini(nddl, max_bfgs)
Definition imp_bfgs.F:31
imp_dtn
subroutine imp_dtn(it, ul2, fac, cumul_alen)
Definition imp_dt.F:78
dyna_ina
subroutine dyna_ina(ibcl, forc, snpc, npc, tf, a, v, x, skews, ar, vr, sensor_tab, weight, wfexc, iads_f, fsky, igrv, agrv, ms, in, lgrav, itask, nrbyac, irbyac, npby, rby, fr_elem, iad_elem, nddl, nnzk, idiv, h3d_data, cptreac, fthreac, nodreac, nsensor, th_surf, dpl0cld, vel0cld, d, dr, numnod, nsurf, nfunct, nconld, ngrav, ninvel, stf, numskw, wfext, python)
Definition imp_dyna.F:744
dyna_cpk0
subroutine dyna_cpk0(nddl, nnzk, iadk, jdik, diag_k, lt_k)
Definition imp_dyna.F:1698
qstat_ini
subroutine qstat_ini(nddl, inloc, iddl, ndof, ikc, ms, in)
Definition imp_dyna.F:548
imp_qifam
subroutine imp_qifam(nodft, nodlt, iddl, ndof, inloc, ikc, diag_k, ms, in, weight)
Definition imp_dyna.F:1126
imp_dykv
subroutine imp_dykv(nodft, nodlt, iddl, ndof, ikc, diag_k, iadk, jdik, lt_k, weight, rby, x, skew, lpby, npby, nrbyac, irbyac, nint2, iint2, ipari, intbuf_tab, irbe3, lrbe3, frbe3, irbe2, lrbe2, v, vr, nddl, fr_elem, iad_elem, ms, in)
Definition imp_dyna.F:1758
dyna_wex
subroutine dyna_wex(ibcl, forc, snpc, npc, tf, a, v, x, skews, ar, vr, sensor_tab, weight, wfext, iads_f, fsky, igrv, agrv, ms, in, lgrav, itask, nrbyac, irbyac, npby, rby, ibfv, vel, d, dr, ikc, iddl, iframe, xframe, ndof, h3d_data, cptreac, fthreac, nodreac, nsensor, th_surf, dpl0cld, vel0cld, numnod, nsurf, nfunct, nconld, ngrav, nfxvel, stf, numskw, python)
Definition imp_dyna.F:1001
imp_dykv0
subroutine imp_dykv0(nodft, nodlt, iddl, ndof, ikc, diag_k, iadk, jdik, lt_k, weight, rby, x, skew, lpby, npby, nrbyac, irbyac, nint2, iint2, ipari, intbuf_tab, irbe3, lrbe3, frbe3, irbe2, lrbe2, v, vr, nddl, fr_elem, iad_elem, ms, in)
Definition imp_dyna.F:1963
imp_dynam
subroutine imp_dynam(nodft, nodlt, iddl, ndof, diag_k, ms, in, d_al, weight, iadk, lt_k)
Definition imp_dyna.F:302
dyna_cpr0
subroutine dyna_cpr0(nddl)
Definition imp_dyna.F:507
upd_fr_k
subroutine upd_fr_k(iadk, jdik, ndof, ikc, iddl, inloc, fr_elem, iad_elem, nddl)
Definition imp_fri.F:4091
ind_frkd
subroutine ind_frkd(ipari, intbuf_tab, num_imp, ns_imp, ne_imp, iddl, ikc, ndof, nsrem, ind_imp)
Definition imp_fri.F:4721
getnddli_g
subroutine getnddli_g(npby, lpby, itab, nrbyac, irbyac, nint2, iint2, ipari, intbuf_tab, ndofi, ndof, ikc, iddl, fr_elem, iad_elem, nddli, nsl, nddlig, irbe3, lrbe3, irbe2, lrbe2)
Definition imp_fri.F:9977
imp_frfv
subroutine imp_frfv(num_imp, ns_imp, ne_imp, ipari, intbuf_tab, iddl, ikc, ndof, nsrem, nsl, d_imp, dd, dr_imp, ddr, a, ar, ms, v, x, lb, nddl, ibfv, skew, xframe, irbe3, lrbe3, irbe2, lrbe2, de, nddl0, w_ddl)
Definition imp_fri.F:143
imp_fr7i
subroutine imp_fr7i(ipari, intbuf_tab, num_imp, ns_imp, nsrem, nbintc, intlist)
Definition imp_fri.F:506
imp_fri
subroutine imp_fri(num_imp, ns_imp, ne_imp, ipari, intbuf_tab, npby, lpby, itab, nrbyac, irbyac, nint2, iint2, iddl, ikc, ndof, inloc, nsrem, nsl, nbintc, intlist, x, ibfv, lj, skew, xframe, iskew, icodt, a, ud, lb, ifdis, nddl, urd, iddli, irbe3, lrbe3, frbe3, irbe2, lrbe2)
Definition imp_fri.F:45
fr_dlft
subroutine fr_dlft(nddl, idlft0, idlft1)
Definition imp_fri.F:4349
sp_stat0
subroutine sp_stat0(il, iadk, jdik, nc, jm)
Definition imp_fsa_inv.F:35
intab0
integer function intab0(nic, ic, n)
Definition imp_fsa_inv.F:509
imp_glob_khp
subroutine imp_glob_khp(pm, geo, ipm, igeo, elbuf, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ixtg1, ixs10, ixs20, ixs16, iparg, tf, npc, fr_wave, w16, bufmat, thke, bufgeo, rby, skew, x, wa, iddl, ndof, k_diag, k_lt, iadk, jdik, ikgeo, etag, itask0, elbuf_tab, stack, drape_sh4n, drape_sh3n, drapeg)
Definition imp_glob_k.F:2867
jacobien
subroutine jacobien(a, n, ew, ev, tol, lamda)
Definition imp_glob_k.F:1780
imp_kpres
subroutine imp_kpres(ib, fac, npc, tf, x, skew, nsensor, sensor_tab, weight, iadc, iddl, ndof, iadk, jdik, k_diag, k_lt)
Definition imp_glob_k.F:1971
etfac_ini
subroutine etfac_ini(iparg)
Definition imp_init.F:388
sav_inttd
subroutine sav_inttd(nt_imp, numimp, ns_imp, ne_imp, ind_imp, numimp1)
Definition imp_int_k.F:1435
kin_knl
subroutine kin_knl(ipari, intbuf_tab, num_imp, ns_imp, ne_imp, npby, lpby, itab, nrbyac, irbyac, nint2, iint2, ibfv, lj, iskew, icodt, ndofi, iddl, ikc, ndof, inloc, irbe3, lrbe3, frbe3, x, skew, irbe2, lrbe2)
Definition imp_int_k.F:1695
imp_inttd0
subroutine imp_inttd0(timers, ipari, intbuf_tab, x, d, ms, itab, in, d_imp, dr_imp, imsch, i2msch, isizxv, ilenxv, igrbric, islen7, irlen7, islen11, irlen11, islen17, irlen17, irlen7t, islen7t, iad_elem, fr_elem, nbintc, intlist, itask, kinet, newfront, num_imp, ns_imp, ne_imp, ind_imp, isendto, irecvfrom, weight, ixs, temp, dt2prev, wa, num_imp1, irlen20, islen20, irlen20t, islen20t, irlen20e, islen20e, ikine, diag_sms, count_remslv, count_remslve, nsensor, sensor_tab, xdp, h3d_data, multi_fvm, forneqs, maxdgap, interfaces, glob_therm)
Definition imp_int_k.F:731
imp_dtkin
subroutine imp_dtkin(ipari, intbuf_tab, x, v, vr, itab, d_imp, dr_imp, nbintc, intlist, itask, newfront, isendto, irecvfrom, iddl, ndof, ikc, scal, ms, nsensor, sensor_tab, maxdgap)
Definition imp_int_k.F:1588
imp_int_k
subroutine imp_int_k(a, v, icodt, icodr, iskew, ibfv, npc, tf, vel, nsensor, sensor_tab, xframe, rby, x, skew, lpby, npby, itab, weight, ms, in, nrbyac, irbyac, nss, iss, ipari, intbuf_tab, nint2, iint2, iaint2, nss2, iss2, nddli, nnzi, iadi, jdii, diag_i, lt_i, iddli, nddl, iadk, jdik, ikc, diag_k, lt_k, iddl, num_imp, ns_imp, ne_imp, index2, ndofi, itok, ud, lb, gapmin, dirul, nt_rw, num_imp1, irbe3, lrbe3, frbe3, nss3, iss3, irbe2, lrbe2, nsb2, isb2)
Definition imp_int_k.F:56
imp_mumps1
subroutine imp_mumps1(nddl0, nnzk0, nddl, nnzk, nnmax, nodglob, iddl, ndof, inloc, ikc, iadk, jdik, diag_k, lt_k, iad_elem, fr_elem, mumps_par, cddlp, iadi, jdii, itok, diag_i, lt_i, nddli, nnzi, imprint, it)
Definition imp_mumps.F:49
imp_setba
subroutine imp_setba(f, m, iddl, ndof, b, iflag)
Definition imp_setb.F:135
imp_setb
subroutine imp_setb(f, m, iddl, ndof, b)
Definition imp_setb.F:40
imp_setbp
subroutine imp_setbp(f, m, iddl, ndof, ikc, inloc, b)
Definition imp_setb.F:85
getikce
subroutine getikce(ict, icr, k, ifix)
Definition imp_solv.F:8895
imp_fanie
subroutine imp_fanie(fani, fext, nfia, nfea, nodft, nodlt, h3d_data)
Definition imp_solv.F:4781
du_ini
subroutine du_ini(nodft, nodlt, dn, dnr, dd, ddr, idiv, icont0)
Definition imp_solv.F:5450
imp_compab
subroutine imp_compab(icodt, icodr, iskew, ibfv, npc, tf, vel, nsensor, sensor_tab, xframe, rby, x, skew, lpby, npby, itab, nrbyac, irbyac, nint2, iint2, ipari, intbuf_tab, nt_rw, nddl, ndof, ikc, inloc, iddl, nddl0, iwar, ierr)
Definition imp_solv.F:3748
imp_solv
subroutine imp_solv(timers, python, icode, iskew, iskwn, ipart, ixtg, ixs, ixq, ixc, ixt, ixp, ixr, ixtg1, itab, itabm1, npc, ibcl, ibfv, sensor_tab, nnlink, lnlink, iparg, igrv, ipari, intbuf_tab, nprw, iconx, npby, lpby, lrivet, nstrf, ljoint, icodt, icodr, isky, adsky, iads_f, ilink, llink, weight, itask, ibvel, lbvel, fbvel, x, d, v, vr, dr, thke, damp, ms, in, pm, skews, geo, eani, bufmat, bufgeo, bufsf, tf, forc, vel, fsav, agrv, fr_wave, parts0, elbuf, rby, rivet, fr_elem, iad_elem, wa, a, ar, stifn, stifr, partsav, fsky, fskyi, iframe, xframe, w16, iactiv, fskym, igeo, ipm, wfext, nodft, nodlt, nint7, num_imp, ns_imp, ne_imp, ind_imp, it, rwbuf, lprw, fr_wall, nbintc, intlist, fopt, rwsav, fsavd, graphe, fac_k, ipiv_k, nkcond, nsensor, monvol, igrsurf, fr_mv, volmon, dirul, nodglob, mumps_par, cddlp, isendto, irecvfrom, newfront, imsch, i2msch, isizxv, ilenxv, islen7, irlen7, islen11, irlen11, islen17, irlen17, irlen7t, islen7t, kinet, num_imp1, temp, dt2prev, waint, lgrav, sh4tree, sh3tree, irlen20, islen20, irlen20t, islen20t, irlen20e, islen20e, irbe3, lrbe3, frbe3, fr_i2m, iad_i2m, fr_rbe3m, iad_rbe3m, frwl6, irbe2, lrbe2, intbuf_tab_c, ikine, diag_sms, icfield, lcfield, cfield, count_remslv, count_remslve, elbuf_tab, elbuf_imp, xdp, weight_md, stack, dimfb, fbsav6, stabsen, tabsensor, drape_sh4n, drape_sh3n, h3d_data, multi_fvm, igrbric, igrsh4n, igrsh3n, igrbeam, forneqs, maxdgap, nddl0, nnzk0, it_t, impbuf_tab, cptreac, fthreac, nodreac, drapeg, interfaces, th_surf, dpl0cld, vel0cld, snpc, stf, glob_therm, wfext_md)
Definition imp_solv.F:173
pr_infok
subroutine pr_infok(nddl0, nnzk0, nddl, nnzk, nnmax)
Definition imp_solv.F:2140
imp_fanii
subroutine imp_fanii(fani, fint, nfia, nodft, nodlt, h3d_data)
Definition imp_solv.F:4734
imp_stop
subroutine imp_stop(istop)
Definition imp_solv.F:1992
dis_cp
subroutine dis_cp(n, d, dr, iflag)
Definition imp_solv.F:6835
ini_k0h
subroutine ini_k0h(nddl, nnz, nnzm, iadk, jdik)
Definition imp_solv.F:5069
dim_subnz
subroutine dim_subnz(iadk, jdik, nc, jm, nnza)
Definition imp_solv.F:2318
minv_k
subroutine minv_k(nd, icnds10, iddl, inloc, ndof, ms, tol, ke)
Definition imp_solv.F:8780
imp_stif24
subroutine imp_stif24(numimp, ipari)
Definition imp_solv.F:7096
pr_matrix
subroutine pr_matrix(nddl, iddl, ndof, ikc, itab, diag_k, diag_m, inloc, fr_elem, iad_elem, iadk, jdik, lt_k, lt_m, nddli, iadi, jdii, itok, diag_i, lt_i, iflag, it)
Definition imp_solv.F:5804
ini_kic
subroutine ini_kic
Definition imp_solv.F:4834
spbrm_pre
subroutine spbrm_pre(itab, x, iparg, ixc, ixtg, partsav, elbuf_tab, pm, ndof, iddl, ikc)
Definition imp_solv.F:7472
int5_diverg
subroutine int5_diverg(ipari)
Definition imp_solv.F:6785
ini_bminma_imp
subroutine ini_bminma_imp(intbuf_tab)
Definition imp_solv.F:7423
pr_solnfo
subroutine pr_solnfo(nddl, iddl, ndof, ikc, itab, diag_k, diag_m, inloc, fr_elem, iad_elem, iadk, jdik, lt_k, lt_m, nddli, iadi, jdii, itok, diag_i, lt_i, u, f, it, nsrem, nsl, d, dr, iflag, w_ddl, fext, mext, fint, mint, r01, ndeb, r_imp, i_imp, dd, ddr)
Definition imp_solv.F:5945
get_fext
subroutine get_fext(nddl0, nddl, iddl, ndof, ikc, inloc, lb, fext, ac, acr)
Definition imp_solv.F:5200
transvg2l
subroutine transvg2l(skew, vg, vl)
Definition imp_solv.F:8964
spb_rm_rig
subroutine spb_rm_rig(x, ixc, ixtg, ndof, iddl, ikc, d_imp, dr_imp, icodt, icodr, skew, iskew, itab)
Definition imp_solv.F:7960
deallocm_imp
subroutine deallocm_imp(mumps_par)
Definition imp_solv.F:4908
dealloc_impbuf
subroutine dealloc_impbuf(impbuf_tab)
Definition imp_solv.F:9078
spb_ref_nds
subroutine spb_ref_nds(x, d_imp, ndof, iddl, ikc, icodt, icodr, iskew, skew)
Definition imp_solv.F:9022
re2int5
subroutine re2int5(nt_imp, numimp, ns_imp, ne_imp, numimpl, ipari, nt_imp0)
Definition imp_solv.F:5255
imp_chkm
subroutine imp_chkm(timers, python, icode, iskew, iskwn, ipart, ixtg, ixs, ixq, ixc, ixt, ixp, ixr, ixtg1, itab, itabm1, npc, ibcl, ibfv, sensor_tab, nnlink, lnlink, iparg, igrv, ipari, intbuf_tab, nprw, iconx, npby, lpby, lrivet, nstrf, ljoint, icodt, icodr, isky, adsky, iads_f, ilink, llink, weight, itask, ibvel, lbvel, fbvel, x, d, v, vr, dr, thke, damp, ms, in, pm, skews, geo, eani, bufmat, bufgeo, bufsf, tf, forc, vel, fsav, agrv, fr_wave, parts0, elbuf, rby, rivet, fr_elem, iad_elem, nsensor, wa, a, ar, stifn, stifr, partsav, fsky, fskyi, iframe, xframe, w16, iactiv, fskym, igeo, ipm, wfext, nodft, nodlt, nint7, num_imp, ns_imp, ne_imp, ind_imp, it, rwbuf, lprw, fr_wall, nbintc, intlist, fopt, rwsav, fsavd, dirul, lgrav, irbe3, lrbe3, frbe3, frwl6, irbe2, lrbe2, icfield, lcfield, cfield, elbuf_tab, weight_md, stack, dimfb, fbsav6, stabsen, tabsensor, drape_sh4n, drape_sh3n, h3d_data, nddl0, nnzk0, impbuf_tab, cptreac, fthreac, nodreac, drapeg, th_surf, dpl0cld, vel0cld, snpc, stf, wfext_md, igrsurf)
Definition imp_solv.F:3132
save_kif
subroutine save_kif(nddl, iadk, jdik, diag_k, lt_k, itok, nddlg)
Definition imp_solv.F:2509
m_lnz
subroutine m_lnz(nddl, iadk, jdik, ndmax, nlmax)
Definition imp_solv.F:2288
re2int7
subroutine re2int7(nt_imp, numimp, ns_imp, ne_imp, ind_imp, numimpl, ipari, nt_imp0)
Definition imp_solv.F:5352
deallocm
subroutine deallocm
Definition imp_solv.F:4860
write_tpl_file
subroutine write_tpl_file(filnam, ioff1, ioff2, ioff3)
Definition imp_solv.F:6339
imp_fout
subroutine imp_fout(fani, a, ar, nfia, nfea, nodft, nodlt, h3d_data, impbuf_tab)
Definition imp_solv.F:4676
pvp_k
subroutine pvp_k(nd, iadk, jdik, iddl, inloc, ndof, itab, k_diag, k_lt, lamda, node, ms)
Definition imp_solv.F:8684
transvl2g
subroutine transvl2g(skew, vl, vg)
Definition imp_solv.F:8990
imp_compabp
subroutine imp_compabp(icodt, icodr, iskew, ibfv, npc, tf, vel, nsensor, sensor_tab, xframe, rby, x, skew, lpby, npby, itab, nrbyac, irbyac, nint2, iint2, ipari, intbuf_tab, nt_rw, nddl, ndof, ikc, inloc, iddl, nddl0, iwar, ierr)
Definition imp_solv.F:4145
imp_checm
subroutine imp_checm(itab, nddl, iddl, diag_m, ndof, ikc, inloc, nddl0)
Definition imp_solv.F:2356
imp_check
subroutine imp_check(itab, nddl, iddl, diag_k, ndof, ikc, inloc, nddl0)
Definition imp_solv.F:2045
k_band
subroutine k_band(nddl, iadk, jdik, ndmax)
Definition imp_solv.F:2249
ini_kif
subroutine ini_kif
Definition imp_solv.F:2481
imp_intfr
subroutine imp_intfr(num_imp, ns_imp, ne_imp, ipari, intbuf_tab, npby, lpby, itab, nrbyac, irbyac, nint2, iint2, iddl, ikc, ndof, inloc, nsrem, nsl, nbintc, intlist, x, ibfv, dirul, skew, xframe, iskew, icodt, de, d_imp, lb, ifdis, nddl, dr_imp, iddli, irbe3, lrbe3, frbe3, irbe2, lrbe2, dd, ddr, a, ar, ac, acr, ms, v, nddl0, r02, rby, icodr, nt_rw, w_ddl, weight, irflag)
Definition imp_solv.F:7316
imp_check0
subroutine imp_check0(itab, nddl, iddl, diag_k, diag_m, ndof, ikc, inloc, nddl0, nir, nddli, itok, diag_i, iwar, ierr)
Definition imp_solv.F:2761
du_ini_hp
subroutine du_ini_hp(dn, dnr, dd, ddr, idiv, icont0)
Definition imp_solv.F:6935
pr_deb
subroutine pr_deb(nddl, iddl, ndof, ikc, itab, diag_k, diag_m, inloc, fr_elem, iad_elem, iadk, jdik, lt_k, lt_m, nddli, iadi, jdii, itok, diag_i, lt_i, u, f, it, nsrem, nsl, d, dr, iflag, w_ddl, fext, mext, fint, mint, r01, ndeb, nodglob)
Definition imp_solv.F:5545
imp_checm0
subroutine imp_checm0(itab, nddl, iddl, diag_m, ndof, ikc, inloc, nddl0, iwar, ierr)
Definition imp_solv.F:2912
set_ksym
subroutine set_ksym(nddl, iadk, jdik, lt_k, iadk0, jdik0, lt_k0)
Definition imp_solv.F:5146
imp_b2a
subroutine imp_b2a(f, m, iddl, ndof, b)
Definition imp_solv.F:2440
crit_llim
subroutine crit_llim(nddl, nnzk)
Definition imp_solv.F:5017
spmd_min_s
subroutine spmd_min_s(s)
Definition imp_spmd.F:1273
spmd_max_f
subroutine spmd_max_f(f, itab, k)
Definition imp_spmd.F:4907
spmd_min_i
subroutine spmd_min_i(n)
Definition imp_spmd.F:1436
spmd_mumps_deal
subroutine spmd_mumps_deal(mumps_par)
Definition imp_spmd.F:558
spmd_sumf_v
subroutine spmd_sumf_v(v)
Definition imp_spmd.F:1650
spmd_inf_g
subroutine spmd_inf_g(nddl0, nzzk0, nddl, nzzk, nnmax, nddl0p, nzzk0p, nddlp, nzzkp, nnmaxp)
Definition imp_spmd.F:1514
spmd_send_vr
subroutine spmd_send_vr(nv, nsiz, vr, nvmax, iout)
Definition imp_spmd.F:4606
spmd_send_vi
subroutine spmd_send_vi(nv, nsiz, vi, nvmax, iout)
Definition imp_spmd.F:4376
spmd_sumf_a
subroutine spmd_sumf_a(a, ar, iad_elem, fr_elem, size, lr)
Definition imp_spmd.F:2897
spmd_sum_s
subroutine spmd_sum_s(s)
Definition imp_spmd.F:1037
spmd_max_i
subroutine spmd_max_i(n)
Definition imp_spmd.F:1362
fil_span1
subroutine fil_span1(nrbyac, irbyac, npby, iddl, nddl, ikc, ndof, inloc)
Definition ind_glob_k.F:7458
ind_int_k
subroutine ind_int_k(ipari, intbuf_tab, num_imp, ns_imp, ne_imp, npby, lpby, itab, nrbyac, irbyac, nss, iss, nint2, iint2, nss2, iss2, nddli, nnzi, iadi, jdii, iddli, iloci, n_impn, itok, iddl, nnmax, nkmax, n_impm, ndof, iaint2, irbe3, lrbe3, nss3, iss3, irbe2, lrbe2, nsb2, isb2, ind_subt)
Definition ind_glob_k.F:4829
dim_span
subroutine dim_span(nn, nddl, iadk, jdik, l_nz, ndmax)
Definition ind_glob_k.F:6997
dim_int_k
subroutine dim_int_k(ipari, intbuf_tab, num_imp, ns_imp, ne_imp, npby, lpby, itab, nrbyac, irbyac, lnss, nint2, iint2, iaint2, lnss2, nddl, nnzk, iddl, iloci, n_impn, n_impm, nnmax, nkmax, ndof, nsrem, irbe3, lrbe3, lnss3, irbe2, lrbe2, lnsb2, lnsrb2, ind_subt)
Definition ind_glob_k.F:4652
idel_int
subroutine idel_int(ipari, intbuf_tab, num_imp, ns_imp, ne_imp, ind_imp, ndof, nt_imp)
Definition ind_glob_k.F:6627
ind_glob_k
subroutine ind_glob_k(npby, lpby, itab, nrbyac, irbyac, nsc, isij, nmc, imij, nss, iss, nint2, iint2, ipari, intbuf_tab, nsc2, isij2, nss2, iss2, iparg, elbuf, elbuf_tab, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ixtg1, ixs10, ixs20, ixs16, iddl, ndof, iadk, jdik, nddl, nnzk, nnmax, nkine, inloc, nkmax, nrowk, icok, icokm, nmc2, imij2, irk, npn, npp, fr_elem, iad_elem, ipm, igeo, irbe3, lrbe3, iss3, fr_i2m, iad_i2m, fr_rbe3m, iad_rbe3m, irbe2, lrbe2, isb2, nsrb2)
Definition ind_glob_k.F:3731
integratorl_hp
subroutine integratorl_hp(d, dr, x, v, vr, a, ar)
Definition integrator.F:344
integrator1_hp
subroutine integrator1_hp(d, x)
Definition integrator.F:473
integrator_hp
subroutine integrator_hp(ndt, d, dr, x, v, vr, a, ar)
Definition integrator.F:404
lin_solv
subroutine lin_solv(nddl, iddl, ndof, ikc, d, dr, tol, nnz, iadk, jdik, diag_k, lt_k, nddli, iadi, jdii, diag_i, lt_i, itok, iadm, jdim, diag_m, lt_m, f, f_u, inloc, fr_elem, iad_elem, w_ddl, itask, icprec, istop, a, ar, ve, ms, xe, ipari, intbuf_tab, num_imp, ns_imp, ne_imp, nsrem, nsl, it, graphe, itab, fac_k, ipiv_k, nk, nmonv, imonv, monvol, igrsurf, fr_mv, volmon, ibfv, skew, xframe, mumps_par, cddlp, ind_imp, xi_c, irbe3, lrbe3, irbe2, lrbe2)
Definition lin_solv.F:74
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
monv_imp
subroutine monv_imp(monvol, volmon, x, igrsurf, nmonv, imonv, ipari, intbuf_tab, a_mv, ar_mv, ndof, iddl, ikc, inloc, iprec, ibfv, skew, xframe, lj, iskew, icodt, irbe3, lrbe3, frbe3, irbe2, lrbe2, nsurf)
Definition monv_imp0.F:565
for
for(i8=*sizetab-1;i8 >=0;i8--)
Definition mumps_common.c:91
drape_mod
Definition drape_mod.F:54
dsgraph_mod
Definition dsgraph_mod.F:31
ecnd_mod
Definition ecdn_mod.F:34
ecnd_mod::icnds10
integer, dimension(:), pointer icnds10
Definition ecdn_mod.F:42
groupdef_mod
Definition groupdef_mod.F:662
h3d_mod
Definition h3d_mod.F:308
imp_bfgs
Definition impbufdef_mod.F:269
imp_dyna
Definition impbufdef_mod.F:314
imp_dyna::dy_iadk0
integer, dimension(:), allocatable dy_iadk0
Definition impbufdef_mod.F:327
imp_dyna::dy_jdik0
integer, dimension(:), allocatable dy_jdik0
Definition impbufdef_mod.F:327
imp_frk
Definition impbufdef_mod.F:740
imp_frk::ifr2k
integer, dimension(:), allocatable ifr2k
Definition impbufdef_mod.F:758
imp_frk::len_v
integer len_v
Definition impbufdef_mod.F:742
imp_frk::iadfr
integer, dimension(:), allocatable iadfr
Definition impbufdef_mod.F:754
imp_frk::iddlfr
integer, dimension(:), allocatable iddlfr
Definition impbufdef_mod.F:754
imp_frk::len_k
integer len_k
Definition impbufdef_mod.F:742
imp_frk::nd_fr
integer, dimension(:), allocatable nd_fr
Definition impbufdef_mod.F:754
imp_intm
Definition imp_intm.F:118
imp_intm::jdi_si
integer, dimension(:), allocatable jdi_si
Definition imp_intm.F:174
imp_intm::iddl_sl
integer, dimension(:), allocatable iddl_sl
Definition imp_intm.F:178
imp_intm::iad_ss
integer, dimension(:), allocatable iad_ss
Definition imp_intm.F:175
imp_intm::nz_sl
integer nz_sl
Definition imp_intm.F:173
imp_intm::iddsl
integer, dimension(:,:), allocatable iddsl
Definition imp_intm.F:156
imp_intm::iad_si
integer, dimension(:), allocatable iad_si
Definition imp_intm.F:174
imp_intm::jdi_sl
integer, dimension(:), allocatable jdi_sl
Definition imp_intm.F:175
imp_intm::intp_d
integer intp_d
Definition imp_intm.F:173
imp_intm::nddl_si
integer nddl_si
Definition imp_intm.F:173
imp_intm::nddl_sl
integer nddl_sl
Definition imp_intm.F:173
imp_intm::nz_si
integer nz_si
Definition imp_intm.F:173
imp_intm::isl
integer, dimension(:), allocatable isl
Definition imp_intm.F:138
imp_kbcs
Definition impbufdef_mod.F:471
imp_knon
Definition impbufdef_mod.F:488
imp_knon::numn_kn
integer numn_kn
Definition impbufdef_mod.F:490
imp_knon::irb_kn
integer, dimension(:,:), allocatable irb_kn
Definition impbufdef_mod.F:495
imp_knon::id_knm2
integer, dimension(:,:,:), allocatable id_knm2
Definition impbufdef_mod.F:494
imp_knon::irw_kn
integer, dimension(:), allocatable irw_kn
Definition impbufdef_mod.F:497
imp_knon::id_kn
integer, dimension(:,:), allocatable id_kn
Definition impbufdef_mod.F:493
imp_knon::in_kn
integer, dimension(:), allocatable in_kn
Definition impbufdef_mod.F:492
imp_knon::ibc_kn
integer, dimension(:,:), allocatable ibc_kn
Definition impbufdef_mod.F:496
imp_knon::ii2_kn
integer, dimension(:,:), allocatable ii2_kn
Definition impbufdef_mod.F:495
imp_knon::id_knm
integer, dimension(:,:), allocatable id_knm
Definition impbufdef_mod.F:493
imp_knon::id_knm3
integer, dimension(:,:,:), allocatable id_knm3
Definition impbufdef_mod.F:494
imp_knon::ifx_kn
integer, dimension(:,:), allocatable ifx_kn
Definition impbufdef_mod.F:496
imp_knon::irbe3_kn
integer, dimension(:), allocatable irbe3_kn
Definition impbufdef_mod.F:497
imp_lintf
Definition impbufdef_mod.F:405
imp_lintf::jdiif
integer, dimension(:), allocatable jdiif
Definition impbufdef_mod.F:409
imp_lintf::nddlif
integer nddlif
Definition impbufdef_mod.F:407
imp_lintf::iadif
integer, dimension(:), allocatable iadif
Definition impbufdef_mod.F:409
imp_lintf::iftok
integer, dimension(:), allocatable iftok
Definition impbufdef_mod.F:409
imp_pcg_proj
Definition impbufdef_mod.F:646
imp_pcg_proj::m_vs
integer m_vs
Definition impbufdef_mod.F:648
imp_pcg_proj::ncg_run
integer ncg_run
Definition impbufdef_mod.F:648
imp_qstat
Definition impbufdef_mod.F:451
imp_spbrm
Definition impbufdef_mod.F:696
imp_spbrm::ilskew
integer ilskew
Definition impbufdef_mod.F:698
imp_spbrm::ikce
integer, dimension(6) ikce
Definition impbufdef_mod.F:698
imp_spbrm::ie_bc4
integer, dimension(:), allocatable ie_bc4
Definition impbufdef_mod.F:700
imp_spbrm::ibc_b
integer, dimension(:), allocatable ibc_b
Definition impbufdef_mod.F:699
imp_spbrm::n_seg
integer n_seg
Definition impbufdef_mod.F:698
imp_spbrm::e_ref
integer, dimension(4) e_ref
Definition impbufdef_mod.F:698
imp_spbrm::ie_bc3
integer, dimension(:), allocatable ie_bc3
Definition impbufdef_mod.F:700
imp_workh
Definition impbufdef_mod.F:571
imp_workh::jdik0
integer, dimension(:), allocatable jdik0
Definition impbufdef_mod.F:584
imp_workh::jdim0
integer, dimension(:), allocatable jdim0
Definition impbufdef_mod.F:584
imp_workh::iadk0
integer, dimension(:), allocatable iadk0
Definition impbufdef_mod.F:584
imp_workh::iadm0
integer, dimension(:), allocatable iadm0
Definition impbufdef_mod.F:584
imp_worki
Definition impbufdef_mod.F:540
imp_worki::nddli
integer nddli
Definition impbufdef_mod.F:543
imp_worki::iadi
integer, dimension(:), allocatable iadi
Definition impbufdef_mod.F:542
imp_worki::itok
integer, dimension(:), allocatable itok
Definition impbufdef_mod.F:542
imp_worki::nsl
integer nsl
Definition impbufdef_mod.F:543
imp_worki::nnzi
integer nnzi
Definition impbufdef_mod.F:543
imp_worki::nsrem
integer nsrem
Definition impbufdef_mod.F:543
imp_worki::jdii
integer, dimension(:), allocatable jdii
Definition impbufdef_mod.F:542
imp_worki::iconta
integer iconta
Definition impbufdef_mod.F:543
impbufdef_mod
Definition impbufdef_mod.F:36
message_mod
Definition message_mod.F:1249
stack_mod
Definition stack_mod.F:72
th_surf_mod
OPTION /TH/SURF outputs of Pressure and Area needed Tabs.
Definition th_surf_mod.F:60
nl_solv
subroutine nl_solv(nddl, iddl, ndof, ikc, d, dr, nnz, iadk, jdik, diag_k, lt_k, f, nddli, iadi, jdii, diag_i, lt_i, itok, iadm, jdim, diag_m, lt_m, r02, dd, ddr, itask0, it, itc, ru0, rold, idiv, inprint, icprec, istop, e02, de0, eimp, inloc, nddl0, ls, u02, gap, itab, fr_elem, iad_elem, w_ddl, a, ar, v, ms, x, ipari, intbuf_tab, num_imp, ns_imp, ne_imp, nsrem, nsl, icont, graphe, fac_k, ipiv_k, nk, nmonv, imonv, monvol, igrsurf, fr_mv, volmon, ibfv, skew, xframe, mumps_par, cddlp, ind_imp, nbintc, intlist, newfront, isendto, irecvfrom, irbe3, lrbe3, ndiv, icont0, isign, fext, dg, dgr, dg0, dgr0, rfext, ls1, nodft, nodlt, irbe2, lrbe2, idiv0, relres, anew_stif)
Definition nl_solv.F:74
cp_int_hp
subroutine cp_int_hp(n, x, xc)
Definition produt_v.F:3657
produt_w
subroutine produt_w(nddl, x, y, w, r)
Definition produt_v.F:106
cp_real_hp
subroutine cp_real_hp(n, x, xc)
Definition produt_v.F:3624
zeror_hp
subroutine zeror_hp(x, n)
Definition produt_v.F:3688
produt_uhp0
subroutine produt_uhp0(dd, ddr, norm2, weight)
Definition produt_v.F:3435
produt_hp
subroutine produt_hp(nddl, x, y, w, r)
Definition produt_v.F:3252
vscaly_hp
subroutine vscaly_hp(n, v, y, s)
Definition produt_v.F:3536
vaxpy_hp
subroutine vaxpy_hp(n, v, y, s)
Definition produt_v.F:3580
cp_impbuf
subroutine cp_impbuf(iflag, elbuf, elbuf_c, bufmat, bufmat_c, fsav, volmon, partsav, intbuf_tab, intbuf_tab_c, ipari, islen7, irlen7, islen11, irlen11, islen17, irlen17, irlen7t, islen7t, irlen20, islen20, irlen20t, islen20t, irlen20e, islen20e, newfront, elbuf_tab, elbuf_imp, iparg)
Definition produt_v.F:1025
iddl2nod
subroutine iddl2nod(nddl, iddl, ndof, ikc, inloc, iid, nn)
Definition recudis.F:187
recukin
subroutine recukin(rby, lpby, npby, skew, iskew, itab, weight, ms, in, ibfv, vel, icodt, icodr, nrbyac, irbyac, nint2, iint2, ipari, intbuf_tab, ndof, d, dr, x, xframe, lj, ixr, ixc, ixtg, sh4tree, sh3tree, irbe3, lrbe3, frbe3, irbe2, lrbe2)
Definition recudis.F:103
weightddl
subroutine weightddl(iddl, ndof, ikc, weight, w_imp, inloc)
Definition recudis.F:232
resol
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
rgwal0_imp
subroutine rgwal0_imp(x, d, v, rwbuf, lprw, nprw, ms, fsav, fr_wall, fopt, rwsav, weight, fsavd, nt_rw, iddl, ikc, icomv, ndof, frwl6, weight_md, dimfb, fbsav6, stabsen, tabsensor, wfext, wfext_md)
Definition rgwal0.F:211
main
int main(int argc, char *argv[])
Definition CMakeCCompilerId.c:841
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889
arret
subroutine arret(nn)
Definition arret.F:87
my_barrier
subroutine my_barrier
Definition machine.F:31
my_flush
subroutine my_flush(iunit)
Definition machine.F:147
startime
subroutine startime(event, itask)
Definition timer.F:93
stoptime
subroutine stoptime(event, itask)
Definition timer.F:135
h3d_mod::h3d_database
Definition h3d_mod.F:435
th_surf_mod::th_surf_
Definition th_surf_mod.F:75
upd_rhs
subroutine upd_rhs(icodt, icodr, iskew, ibfv, xframe, rby, x, skew, lpby, npby, nrbyac, irbyac, nint2, iint2, ipari, intbuf_tab, ndof, iddl, ikc, nddl0, b, iupd, inloc, lj, a, ar, ac, acr, nt_rw, irflag, w_ddl, nddl, r02, idyna, v, vr, ms, in, irbe3, lrbe3, frbe3, weight, irbe2, lrbe2)
Definition upd_glob_k.F:664
rer02
subroutine rer02(rby, lpby, npby, skew, iskew, itab, weight, ms, in, ibfv, vel, icodt, icodr, nrbyac, irbyac, nint2, iint2, ipari, intbuf_tab, ndof, d, dr, x, xframe, lj, ixr, ixc, ixtg, sh4tree, sh3tree, irbe3, lrbe3, frbe3, iadk, jdik, diag_k, lt_k, iddl, ikc, inloc, num_imp, ns_imp, ne_imp, index2, nddl, w_ddl, a, ar, r02, irbe2, lrbe2, x_c)
Definition upd_glob_k.F:940
condens_b
subroutine condens_b(nddl, ikc, b)
Definition upd_glob_k.F:400
upd_glob_k
subroutine upd_glob_k(icodt, icodr, iskew, ibfv, npc, tf, vel, xframe, rby, x, skew, lpby, npby, itab, weight, ms, in, nrbyac, irbyac, nsc, isij, nmc, imij, nss, iss, nint2, iint2, nsc2, isij2, nss2, iss2, ipari, intbuf_tab, nddl, nnz, iadk, jdik, diag_k, lt_k, ndof, iddl, ikc, ud, b, nkud, ikud, bkud, nmc2, imij2, nt_rw, rd, lj, irbe3, lrbe3, frbe3, iss3, irbe2, lrbe2, isb2, nsrb2)
Definition upd_glob_k.F:66
zeror
subroutine zeror(a, n)
Definition zero.F:39