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!|| element_mod ../common_source/modules/elements/element_mod.F90
127!|| glob_therm_mod ../common_source/modules/mat_elem/glob_therm_mod.F90
128!|| groupdef_mod ../common_source/modules/groupdef_mod.F
129!|| h3d_mod ../engine/share/modules/h3d_mod.F
130!|| imp_lintf ../engine/share/modules/impbufdef_mod.F
131!|| imp_pcg_proj ../engine/share/modules/impbufdef_mod.F
132!|| imp_worki ../engine/share/modules/impbufdef_mod.F
133!|| impbufdef_mod ../engine/share/modules/impbufdef_mod.F
134!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
135!|| interfaces_mod ../common_source/modules/interfaces/interfaces_mod.F90
136!|| message_mod ../engine/share/message_module/message_mod.F
137!|| multi_fvm_mod ../common_source/modules/ale/multi_fvm_mod.F90
138!|| output_mod ../common_source/modules/output/output_mod.F90
139!|| python_funct_mod ../common_source/modules/python_mod.F90
140!|| sensor_mod ../common_source/modules/sensor_mod.F90
141!|| skew_mod ../common_source/modules/skew_mod.f90
142!|| stack_mod ../engine/share/modules/stack_mod.F
143!|| th_surf_mod ../common_source/modules/interfaces/th_surf_mod.F
144!|| timer_mod ../engine/source/system/timer_mod.F90
145!||====================================================================
146 SUBROUTINE imp_solv(OUTPUT, TIMERS,PYTHON,
147 1 ICODE ,ISKEW ,ISKWN ,IPART ,IXTG ,IXS ,IXQ ,
148 2 IXC ,IXT ,IXP ,IXR ,IXTG1 ,ITAB ,ITABM1 ,
149 3 NPC ,IBCL ,IBFV ,SENSOR_TAB,NNLINK ,LNLINK ,IPARG ,IGRV ,
150 4 IPARI ,INTBUF_TAB,NPRW ,ICONX ,NPBY ,LPBY ,LRIVET ,
151 5 NSTRF ,LJOINT ,ICODT ,ICODR ,ISKY ,ADSKY ,IADS_F ,
152 6 ILINK ,LLINK ,WEIGHT ,ITASK ,IBVEL ,LBVEL ,FBVEL ,
153 7 X ,D ,V ,VR ,DR ,THKE ,DAMP ,MS ,
154 8 IN ,PM ,SKEWS ,GEO ,EANI ,BUFMAT ,BUFGEO ,BUFSF ,
155 9 TF ,FORC ,VEL ,FSAV ,AGRV ,FR_WAVE,PARTS0 ,
156 A ELBUF ,RBY ,RIVET ,FR_ELEM,IAD_ELEM,
157 B WA ,A ,AR ,STIFN ,STIFR ,PARTSAV,FSKY ,
158 C FSKYI ,IFRAME ,XFRAME ,W16 ,IACTIV ,FSKYM ,IGEO ,IPM ,
159 D WFEXT ,NODFT ,NODLT ,NINT7 ,NUM_IMP,NS_IMP ,NE_IMP ,IND_IMP,
160 L IT ,RWBUF ,LPRW ,FR_WALL,NBINTC ,INTLIST,FOPT ,RWSAV ,
161 M FSAVD ,GRAPHE ,FAC_K ,IPIV_K ,NKCOND ,NSENSOR,
162 N MONVOL ,IGRSURF,FR_MV ,VOLMON ,DIRUL ,
163 O NODGLOB,MUMPS_PAR,CDDLP,ISENDTO,IRECVFROM,NEWFRONT,IMSCH ,
164 P I2MSCH ,ISIZXV,ILENXV ,ISLEN7 ,IRLEN7 ,ISLEN11,IRLEN11,ISLEN17,
165 Q IRLEN17,IRLEN7T,ISLEN7T,KINET ,NUM_IMP1,TEMP ,DT2PREV,WAINT ,
166 R LGRAV ,SH4TREE ,SH3TREE,IRLEN20,ISLEN20,IRLEN20T,ISLEN20T ,
167 S IRLEN20E,ISLEN20E,IRBE3,LRBE3 ,FRBE3 ,FR_I2M,IAD_I2M,FR_RBE3M,
168 T IAD_RBE3M,FRWL6,IRBE2 ,LRBE2 ,INTBUF_TAB_C,IKINE ,DIAG_SMS,
169 V ICFIELD,LCFIELD,CFIELD,COUNT_REMSLV,COUNT_REMSLVE,
170 X ELBUF_TAB,ELBUF_IMP,XDP,WEIGHT_MD , STACK ,
171 Y DIMFB ,FBSAV6 ,STABSEN,TABSENSOR,DRAPE_SH4N, DRAPE_SH3N,
172 Z H3D_DATA,MULTI_FVM,IGRBRIC,IGRSH4N,IGRSH3N,IGRBEAM,FORNEQS,MAXDGAP,
173 A NDDL0 ,NNZK0 ,IT_T ,IMPBUF_TAB,CPTREAC,FTHREAC,NODREAC, DRAPEG,
174 B INTERFACES,TH_SURF,DPL0CLD,VEL0CLD,SNPC,STF,GLOB_THERM, WFEXT_MD)
175C-----------------------------------------------
176C M o d u l e s
177C-----------------------------------------------
178 USE output_mod
179 USE timer_mod
180 USE dsgraph_mod
181 USE imp_lintf
182 USE imp_worki
183 USE imp_pcg_proj
184 USE message_mod
185 USE elbufdef_mod
186 USE intbufdef_mod
187 USE stack_mod
188 USE h3d_mod
189 USE multi_fvm_mod
190 USE groupdef_mod
191 USE drape_mod
192 USE impbufdef_mod
193 USE sensor_mod
194 USE interfaces_mod
195 USE th_surf_mod , ONLY : th_surf_
196 USE skew_mod
197 use glob_therm_mod
198 use python_funct_mod, only: python_
199 use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg
200C-----------------------------------------------
201C I m p l i c i t T y p e s
202C-----------------------------------------------
203#include "implicit_f.inc"
204C-----------------------------------------------
205C C o m m o n B l o c k s
206C-----------------------------------------------
207#include "comlock.inc"
208#if defined(MUMPS5)
209#include "dmumps_struc.h"
210#endif
211#include "param_c.inc"
212#include "com01_c.inc"
213#include "com04_c.inc"
214#include "com08_c.inc"
215#include "impl1_c.inc"
216#include "impl2_c.inc"
217#include "scr03_c.inc"
218#include "scr06_c.inc"
219#include "scr16_c.inc"
220#include "timeri_c.inc"
221#include "units_c.inc"
222#include "task_c.inc"
223C-----------------------------------------------
224C D u m m y A r g u m e n t s
225C-----------------------------------------------
226 TYPE (OUTPUT_) , INTENT(INOUT) :: OUTPUT
227 TYPE(timer_) :: TIMERS
228 TYPE(PYTHON_) :: PYTHON
229 INTEGER ,INTENT(IN) :: NSENSOR
230 INTEGER ,INTENT(IN) :: SNPC
231 INTEGER ,INTENT(IN) :: STF
232 INTEGER ITASK,ICODE(*), ISKEW(*), ISKWN(LISKN,*),ITABM1(*),
233 . IPART(*),IXS(*),IXQ(NIXQ,*),IXC(NIXC,*), IXT(NIXT,*),
234 . IXP(NIXP,*),IXR(NIXR,*), IXTG(NIXTG,*), IXTG1(4,*),
235 . ITAB(*),NPC(*), IBCL(*), IBFV(*),IPARG(NPARG,*),IPARI(NPARI,*),
236 . NPRW(*), NPBY(NNPBY,*), LPBY(*),IADS_F(*),
237 . LRIVET(*), NSTRF(*), LJOINT(*), ICODT(*), ICODR(*), ILINK(*),
238 . LLINK(*),ISKY(*),ADSKY(*),
239 . NNLINK(10,*),LNLINK(*),IGRV(*),IKINE(*),
240 . WEIGHT(*),IFRAME(LISKN,*),IBVEL(NBVELP,*),LBVEL(*),
241 . IACTIV(*),IGEO(*),IPM(*),ICONX(*),NODFT ,NODLT,IT,
242 . WEIGHT_MD(*),DIMFB,STABSEN,TABSENSOR(*),CPTREAC,NODREAC(*)
243 INTEGER LPRW(*), FR_WALL(NSPMD+2,*),FR_ELEM(*),
244 . IAD_ELEM(2,*),NBINTC ,INTLIST(*), IPIV_K(*), NKCOND,
245 . NODGLOB(*), CDDLP(*),LGRAV(*)
246 INTEGER NDDL0,NNZK0,IT_T,MONVOL(*),FR_MV(*),
247 . DIRUL(*),SH4TREE(*), SH3TREE(*),
248 . FR_I2M(*),IAD_I2M(*),FR_RBE3M(*),IAD_RBE3M(*),
249 . ICFIELD(*),LCFIELD(*),COUNT_REMSLV(*),COUNT_REMSLVE(*)
250 my_real
251 . X(3,*) ,D(3,*) ,V(3,*) ,VR(3,*),DAMP(*),
252 . MS(*) ,IN(*) ,PM(NPROPM,*),GEO(NPROPG,*),
253 . BUFMAT(*) ,TF(*) ,FORC(*) ,VEL(*),FSAV(NTHVKI,*) ,ELBUF(*) ,
254 . rwbuf(nrwlp,*),rwsav(*),rby(nrby,*),
255 . rivet(*),wa(*), a(3,*) ,ar(3,*),partsav(*) ,
256 . stifn(*) ,stifr(*),fsky(*),fskyi(*),dr(3,*),
257 . eani(*),agrv(*), thke(*),fr_wave(*),parts0(*),bufgeo(*),
258 . xframe(nxframe,*),w16(*),fbvel(*),fskym(*),bufsf(*),
259 . fopt(6,*),fsavd(nthvki,*), fac_k(*), diag_sms(*),
260 . cfield(*),forneqs(*),maxdgap(ninter),fthreac(6,*)
261 INTEGER NUM_IMP(*),NS_IMP(*),NE_IMP(*),IND_IMP(*),NINT7
262 INTEGER NEWFRONT(*),ISENDTO(*),IRECVFROM(*),IMSCH ,
263 . I2MSCH ,ISIZXV,ILENXV ,ISLEN7 ,IRLEN7 ,ISLEN11,IRLEN11,
264 . ISLEN17,IRLEN17,IRLEN7T,ISLEN7T,
265 . IRLEN20,ISLEN20,IRLEN20T,ISLEN20T,IRLEN20E,ISLEN20E,
266 . KINET(*),NUM_IMP1(*),IRBE3(*),LRBE3(*),IRBE2(*),LRBE2(*)
267 my_real, INTENT(IN) :: DPL0CLD(6,NCONLD),VEL0CLD(6,NCONLD)
268 my_real DT2PREV,VOLMON(*) ,TEMP(*), WAINT(*),FRBE3(*)
269 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB, ELBUF_IMP
270 DOUBLE PRECISION FRWL6(*), XDP(3,*)
271 DOUBLE PRECISION FBSAV6(12,6,DIMFB)
272C
273 TYPE(PRGRAPH) :: GRAPHE(*)
274C
275#ifdef MUMPS5
276 TYPE(dmumps_struc) MUMPS_PAR
277#else
278 ! Fake declaration as DMUMPS_STRUC is shipped with MUMPS
279 INTEGER MUMPS_PAR
280#endif
281 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*), INTBUF_TAB_C
282 TYPE (STACK_PLY) :: STACK
283 TYPE(H3D_DATABASE) :: H3D_DATA
284 TYPE(MULTI_FVM_STRUCT), INTENT(INOUT) :: MULTI_FVM
285!
286 TYPE (GROUP_) , DIMENSION(NGRBRIC) :: IGRBRIC
287 TYPE (GROUP_) , DIMENSION(NGRSHEL) :: IGRSH4N
288 TYPE (GROUP_) , DIMENSION(NGRSH3N) :: IGRSH3N
289 TYPE (GROUP_) , DIMENSION(NGRBEAM) :: IGRBEAM
290 TYPE (GROUP_) , DIMENSION(NSURF) :: IGRSURF
291 TYPE (DRAPE_) :: DRAPE_SH4N(NUMELC_DRAPE), DRAPE_SH3N(NUMELTG_DRAPE)
292 TYPE (IMPBUF_STRUCT_) ,TARGET :: IMPBUF_TAB
293 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) :: SENSOR_TAB
294 TYPE (DRAPEG_) :: DRAPEG
295 TYPE (INTERFACES_) ,INTENT(IN) :: INTERFACES
296 TYPE (TH_SURF_) , INTENT(INOUT) :: TH_SURF
297 TYPE(skew_),INTENT(INOUT) :: SKEWS
298 type (glob_therm_) , INTENT(INOUT) :: GLOB_THERM
299 DOUBLE PRECISION,INTENT(INOUT) :: WFEXT, WFEXT_MD
300C
301C---D_IMP: dUn+1,i,DD : ddU,i+1
302C---R_IMP[1:R02,2:RRR(R_OLD),3:RU0,4:E02,5:DE_OLD,6:EIMP,7,8,9:for line-search]
303C---R_IMP[10: BFAC,DTFAC,11:U2,12:RFAC,13:|FEXT|;14,16:new line-search;17:actual R02;18:GAP;19:TSTART;
304C---R_IMP[21:rel res disp.,22:relative residual \1,23:relative residual \1,24:cumulative arc length]
305C---------20-25:libre
306C---I_IMP[1:IT(TOTAL),2:ITC,3:IT0(IT_OLD),4:IWAIT,5:IDIV,6:NDDLI0,7:1ercontact(used only w/ IREFI=4),
307C---8:num. of diverging, 9:ICONT_OLD 10:Isign (Riks);11: Ichang(solver);12: IDIV_OLD;13: NDDLI(SMP) or NDDLI_G(SPMD)
308#if defined(MUMPS5)
309C----------------------------------------------
310C L o c a l V a r i a b l e s
311C-----------------------------------------------
312 INTEGER NNMAX,NKMAX,N_IMPN,N_IMPM,LNSS,LNSS2,NDT,NDS,NT_RW
313 INTEGER I,J,NTMP,L1,L2,L3,NNDL,INPRINT,ISTOP,LI10,LI11,
314 . li1,li2,li3,li4,li5,li6,li7,li8,li9,lif,ic,isetp,
315 . li12,nddl_ini0,li13,li14,li15,lnss3,lnsb2,lnsrb2
316 INTEGER, DIMENSION(:),ALLOCATABLE :: IADI0,JDII0
317C
318 INTEGER, DIMENSION(:),ALLOCATABLE :: NSS,ISS,NSS2,ISS2,NSS3,ISS3
319 INTEGER, DIMENSION(:),ALLOCATABLE :: NSB2,ISB2,IAINT2
320C ---INEGA is defined now in impl1_c.inc---
321 INTEGER NNOD,IFDIS,NODFTSK ,NODLTSK,N1,N2,N3
322C
323 INTEGER LBAND,NCL_MAX,IRFLAG,IPRINT0,IPRJ_S
324C
325 INTEGER IBID,IFIF,F_DDL,L_DDL,NSPC_OLD,NSPC,NFXV_G
326C
327 my_real rbid,efac,lbb(nddl0),dummy_fext(3,1)
328 my_real tfexc,tmp,tmp1,tmp2,r2,bfac,faci,r02,gap,bid,we_imp
329 my_real,DIMENSION(:),ALLOCATABLE :: diag_i0,lt_i0
330C
331 INTEGER, POINTER :: NDDL,NNZK,NRBYAC,NINT2,NMC,NMC2,NMONV
332 INTEGER, DIMENSION(:) ,POINTER :: IADK,JDIK,IADM,JDIM
333 INTEGER, DIMENSION(:) ,POINTER :: IDDL,NDOF,INLOC,LSIZE,I_IMP,IKC,
334 . IRBYAC,NSC,IINT2,NKUD,IMONV,
335 . IKINW,W_DDL,IKUDN,NDOFI,IDDLI,IKUD
336 my_real, DIMENSION(:) ,POINTER :: DIAG_K,LT_K,DIAG_M,LT_M,LB,
337 . LB0,BKUD,D_IMP,ELBUF_C,BUFMAT_C,
338 . DR_IMP,X_C,DD,DDR,X_A,R_IMP
339 my_real, DIMENSION(:) ,POINTER :: FEXT,DG,DGR,DG0,DGR0,BUFIN_C,AC,ACR
340c sb
341 character*1 anew_stif
342
343C-----------------------------------------------
344 anew_stif = ' '
345 dummy_fext = zero
346 rbid = zero
347c
348C-----------------------------------------------
349C---IMCONV : 0 iteration; 1 converge; -1 line-search, -2 change dt during iteration-----
350C--- -3 only reset iteration with Dn-1=0-----
351C-----------------------------------------------
352 nddl => impbuf_tab%NDDL
353 nnzk => impbuf_tab%NNZK
354 nrbyac => impbuf_tab%NRBYAC
355 nint2 => impbuf_tab%NINT2
356 nmc => impbuf_tab%NMC
357 nmc2 => impbuf_tab%NMC2
358 nmonv => impbuf_tab%NMONV
359 iadk => impbuf_tab%IADK
360 jdik => impbuf_tab%JDIK
361 iadm => impbuf_tab%IADM
362 jdim => impbuf_tab%JDIM
363 iddl => impbuf_tab%IDDL
364 ndof => impbuf_tab%NDOF
365 inloc => impbuf_tab%INLOC
366 lsize => impbuf_tab%LSIZE
367 i_imp => impbuf_tab%I_IMP
368 irbyac => impbuf_tab%IRBYAC
369 nsc => impbuf_tab%NSC
370 iint2 => impbuf_tab%IINT2
371 nkud => impbuf_tab%NKUD
372 imonv => impbuf_tab%IMONV
373 ikinw => impbuf_tab%IKINW
374 ikc => impbuf_tab%IKC
375 w_ddl => impbuf_tab%W_DDL
376 ikud => impbuf_tab%IKUD
377 ndofi=> impbuf_tab%NDOFI
378 iddli=> impbuf_tab%IDDLI
379C
380 diag_k =>impbuf_tab%DIAG_K
381 lt_k =>impbuf_tab%LT_K
382 diag_m =>impbuf_tab%DIAG_M
383 lt_m =>impbuf_tab%LT_M
384 lb =>impbuf_tab%LB
385 lb0 =>impbuf_tab%LB0
386 bkud =>impbuf_tab%BKUD
387 d_imp =>impbuf_tab%D_IMP
388 dr_imp =>impbuf_tab%DR_IMP
389 elbuf_c =>impbuf_tab%ELBUF_C
390 bufmat_c=>impbuf_tab%BUFMAT_C
391 x_c =>impbuf_tab%X_C
392 x_a =>impbuf_tab%X_A
393 dd =>impbuf_tab%DD
394 ddr =>impbuf_tab%DDR
395 fext =>impbuf_tab%FEXT
396 dg =>impbuf_tab%DG
397 dgr =>impbuf_tab%DGR
398 dg0 =>impbuf_tab%DG0
399 dgr0 =>impbuf_tab%DGR0
400 ac=>impbuf_tab%AC
401 acr=>impbuf_tab%ACR
402 r_imp => impbuf_tab%R_IMP
403 ALLOCATE(iaint2(nint2))
404C--------explicite iteration only-------------
405C-------smp // first for IMP_GLOB_K, PCG solver, Nonlinear drivers,
406 ndt=nexp
407 IF (i_imp(4)>0) THEN
408 CALL integrator_hp(ndt ,d_imp ,dr_imp,
409 1 x ,v ,vr ,a ,ar )
410C /---------------/
411 i_imp(4)=i_imp(4)-1
412 IF (imconv==1) imconv=2
413 RETURN
414 ENDIF
415C------------------------------
416C Initialization
417C------------------------------
418 iprint0=0
419 IF (ispmd==0) THEN
420 IF(ncycle==1.AND.imconv==1.AND.i_imp(5)==0) iprint0=1
421 IF (iline/=1) inprint=nprint
422 ELSE
423 inprint=0
424 ENDIF
425C
426 IF (irref>0.AND.imconv==1.AND.iline/=1) THEN
427 irflag=irref
428 ELSE
429 irflag=0
430 ENDIF
431C
432 isetp=isetk
433 nddli=0
434 nddli_g=0
435 IF (nint7==0) THEN
436 DO i=1,numnod
437 ndofi(i)=0
438 ENDDO
439 ENDIF
440 istop=0
441 IF (imconv==2) imconv=1
442 nndl = 3*numnod
443C
444 nsrem=0
445 nsl=0
446 iconta = 0
447C
448 we_imp = wfext
449 IF (imconv==1) THEN
450 iter_nl=0
451 ELSE
452 iter_nl=it+1
453 END IF
454 IF(ncycle==1.AND.imconv==1.AND.i_imp(5)==0) THEN
455 r_imp(19)=tt-dt2
456C---------for interface sorting
457 IF(ninter>0) CALL ini_bminma_imp(intbuf_tab)
458 END IF
459c
460C-----------------------------
461 IF (imconv==3) CALL cp_real_hp(nndl,x_c,x)
462 nfxv_g = nfxvel
463 IF (nspmd>1) CALL spmd_max_i(nfxv_g)
464C
465 IF (ilintf>0) THEN
466 ALLOCATE(xi_c(nndl))
467 IF (ncycle==1) THEN
468 CALL cp_impbuf(
469 . 1 ,elbuf,elbuf_c,bufmat ,bufmat_c,
470 . fsav ,volmon ,partsav ,intbuf_tab ,
471 . intbuf_tab_c,ipari ,islen7 ,irlen7 ,
472 . islen11,irlen11,islen17 ,irlen17,irlen7t ,
473 . islen7t,irlen20,islen20 ,irlen20t,islen20t,
474 . irlen20e,islen20e,newfront,elbuf_tab,elbuf_imp,
475 . iparg )
476 CALL cp_real_hp(nndl,x,x_c)
477 CALL imp_setb(a ,ar ,iddl ,ndof ,lb0 )
478 CALL ini_kif
479 i_imp(2)=lprint
480 lprint = 0
481 CALL cp_real_hp(nndl,x,xi_c)
482 ELSE
483 CALL cp_impbuf(
484 . 2 ,elbuf,elbuf_c,bufmat ,bufmat_c,
485 . fsav ,volmon ,partsav ,intbuf_tab ,
486 . intbuf_tab_c,ipari ,islen7 ,irlen7 ,
487 . islen11,irlen11,islen17 ,irlen17,irlen7t ,
488 . islen7t,irlen20,islen20 ,irlen20t,islen20t,
489 . irlen20e,islen20e,newfront,elbuf_tab,elbuf_imp,
490 . iparg )
491 CALL cp_real_hp(nndl,x_c,x)
492 CALL cp_real_hp(nndl,x_c,xi_c)
493 CALL integrator1_hp(d_imp ,xi_c )
494 CALL imp_b2a(a ,ar ,iddl ,ndof ,lb0 )
495 IF (ncycle==ilintf) THEN
496 lprint = i_imp(2)
497 ELSE
498 lprint = 0
499 ENDIF
500C----------otherwise, X_A is accumulated---
501 CALL cp_real_hp(nndl,x,x_a)
502 ENDIF
503 ENDIF
504C
505 IF (imconv==1 ) THEN
506 r_imp(16)=zero
507C R_IMP(6)=ZERO
508C---------initialise D,DD-----
509 IF (ncycle>1.AND.iline/=1) THEN
510C-----------------Dn,0=Dn-1--------
511c CALL CP_REAL(NNDL,D_IMP,DD)
512c IF (IRODDL/=0) CALL CP_REAL(NNDL,DR_IMP,DDR)
513C----------for the case where the run diverges due to the first contact(Gravity)->
514C----------use reduced Dn_1 instead of resolution:
515 CALL du_ini_hp(d_imp ,dr_imp,dd ,
516 1 ddr ,i_imp(5),i_imp(7))
517 ENDIF
518 CALL zeror_hp(d_imp,numnod)
519 IF (iroddl/=0) CALL zeror_hp(dr_imp,numnod)
520C also allows linear with 'initial state'
521 CALL zeror_hp(ac,numnod)
522 IF (iroddl/=0) CALL zeror_hp(acr,numnod)
523C
524 IF (isigini==1.AND.ncycle==1) THEN
525 CALL imp_setb(a ,ar ,iddl ,ndof ,lb0 )
526 ENDIF
527C
528 IF (ncycle==1.AND.idyna>0)
529 . CALL dyna_ina(ibcl ,forc ,snpc ,npc ,tf ,a ,
530 2 v ,x ,skews ,ar ,vr ,
531 3 sensor_tab ,weight ,tfexc ,iads_f ,
532 4 fsky ,igrv ,agrv ,ms ,in ,
533 5 lgrav ,itask ,nrbyac ,irbyac ,npby ,
534 6 rby ,fr_elem ,iad_elem ,nddl0 ,nnzk0 ,
535 7 i_imp(5) ,h3d_data ,cptreac ,fthreac ,nodreac,
536 8 nsensor ,th_surf ,dpl0cld ,
537 9 vel0cld ,d ,dr ,numnod ,nsurf ,
538 a nfunct ,nconld ,ngrav ,ninvel ,stf ,numskw,
539 b wfext,python)
540C
541C----------------------------------
542C EXTERNAL FORCES A=Fext-Fint
543C----------------------------------
544C
545 ncl_max=0
546 IF(nconld/=0) THEN
547 IF (imon>0) CALL startime(timers,4)
548C --spmd : force treated like elements ---
549 CALL force_imp( ibcl ,forc ,snpc ,npc ,tf ,
550 2 ac ,v ,x ,skews ,
551 3 acr ,vr ,nsensor ,sensor_tab ,tfexc ,
552 4 iads_f ,fsky ,dummy_fext ,h3d_data ,cptreac ,
553 5 fthreac ,nodreac ,th_surf ,
554 6 dpl0cld ,vel0cld ,d ,dr ,nconld ,
555 7 numnod ,nfunct ,stf ,wfext)
556C
557 IF (nspmd>1) THEN
558 DO i=iad_elem(1,1),iad_elem(1,nspmd+1)-1
559 j = fr_elem(i)
560 n1 = 3*(j-1)+1
561 n2 = 3*(j-1)+2
562 n3 = 3*(j-1)+3
563 tmp = abs(ac(n1))+abs(ac(n2))+abs(ac(n3))
564 IF (iroddl/=0) tmp = tmp + abs(acr(n1))+abs(acr(n2))+abs(acr(n3))
565 IF (tmp>zero) ncl_max = ncl_max + 1
566 ENDDO
567 ENDIF
568C
569 IF (imon>0) CALL stoptime(timers,4)
570 ENDIF
571C
572 IF (nspmd>1) THEN
573 CALL spmd_max_i(ncl_max)
574 IF (ncl_max>0) THEN
575 lband = iad_elem(1,nspmd+1)-iad_elem(1,1)
576 IF (iroddl/=0) THEN
577 ntmp = 6
578 ELSE
579 ntmp = 3
580 ENDIF
581 CALL spmd_sumf_a(ac,acr,iad_elem,fr_elem,ntmp,lband)
582 ENDIF
583 ENDIF
584C---------no //SMP for the moment, add it after----
585 IF(ngrav/=0) THEN
586 IF (imon>0) CALL startime(timers,4)
587 CALL gravit_imp(igrv ,agrv ,npc ,tf ,ac,
588 2 v ,x ,skews%SKEW ,ms,tfexc,
589 3 nsensor,sensor_tab,weight,
590 4 lgrav ,itask,
591 5 nrbyac,irbyac,npby ,rby, python)
592 IF (imon>0) CALL stoptime(timers,4)
593 ENDIF
594C---------no //SMP for the moment, add it after----
595 IF(nloadc/=0) THEN
596 IF (imon>0) CALL startime(timers,4)
597 CALL cfield_imp(icfield ,cfield,npc ,tf ,ac,
598 2 v ,x ,xframe ,ms,tfexc,
599 3 nsensor,sensor_tab,weight,iframe,
600 4 lcfield ,itask,
601 5 nrbyac,irbyac,npby ,rby,iskew,python )
602 IF (imon>0) CALL stoptime(timers,4)
603 ENDIF
604
605
606 wfext = we_imp
607C END IF (IMCONV==1)
608 ENDIF
609C-------------dU_d---------------------------------
610 IF(nfxvel/=0.AND.(imconv==1.OR.imconv==3)) THEN
611 IF (imon>0) CALL startime(timers,4)
612 CALL fv_imp(ibfv ,npc ,tf ,vel ,sensor_tab,
613 1 d_imp ,dr_imp ,ikc ,iddl ,nsensor ,
614 2 skews%SKEW ,iframe ,xframe ,v ,vr ,
615 3 x ,dirul ,ndof ,a ,ar )
616 IF (imon>0) CALL stoptime(timers,4)
617 ENDIF
618C------------- rgwal0_imp can follow-aSetk = 1, but you have to change-fv_imp1
619C-------------(IKC(I)=4->IMCONV=1 to avoid rebound-------
620 nt_rw=0
621 IF (nrwall>0) THEN
622 IF (imon>0) CALL startime(timers,4)
623 DO i=1,nddl0
624 IF (ikc(i)==3.OR.ikc(i)==10) ikc(i)=0
625 ENDDO
626 IF (imconv==1) THEN
627 DO i=1,nddl0
628 IF (ikc(i)==4.OR.ikc(i)==11) ikc(i)=0
629 ENDDO
630 ENDIF
631
632 IF (ismdisp > 0 .AND. iline == 0) THEN
633 CALL rgwal0_imp(
634 1 x_a ,d_imp ,v ,rwbuf ,lprw ,
635 2 nprw ,ms ,fsav(1,ninter+1),fr_wall ,
636 3 fopt ,rwsav ,weight ,fsavd(1,ninter+1),
637 4 nt_rw ,iddl ,ikc ,imconv ,ndof , frwl6,
638 5 weight_md ,dimfb ,fbsav6 ,stabsen ,tabsensor, wfext, wfext_md)
639 ELSE
640 CALL rgwal0_imp(
641 1 x ,d_imp ,v ,rwbuf ,lprw ,
642 2 nprw ,ms ,fsav(1,ninter+1),fr_wall ,
643 3 fopt ,rwsav ,weight ,fsavd(1,ninter+1),
644 4 nt_rw ,iddl ,ikc ,imconv ,ndof , frwl6,
645 5 weight_md ,dimfb ,fbsav6 ,stabsen ,tabsensor, wfext, wfext_md)
646 ENDIF
647C
648 IF(nt_rw>0) THEN
649 CALL fv_rw(iddl ,ikc ,ndof ,d_imp ,v )
650 ENDIF
651 IF (imon>0) CALL stoptime(timers,4)
652 ENDIF
653C
654 ifdis=nt_rw+nfxv_g
655 IF(ifdis>0.AND.imconv==1) THEN
656 IF (ncycle>1.AND.iline/=1)
657C--------------Dn,0=Dn-1--------
658 . CALL fv_dd0(iddl ,ikc ,ndof ,dd ,ddr ,d_imp)
659 IF(nt_rw>0) THEN
660 DO i=1,nddl0
661 IF (ikc(i)==3) ikc(i)=4
662C
663 IF (ikc(i)==10) ikc(i)=11
664 ENDDO
665 ENDIF
666 ENDIF
667C
668 irwall = nt_rw
669 IF (nspmd>1) CALL spmd_max_i(irwall)
670C-------!!!should stop line-search if Rwall activates!!!
671 IF(irwall>0.AND.imconv>=0) THEN
672 IF(ispmd==0) THEN
673 WRITE(iout,*)' *--------- RIGID WALL IMPACT---------*'
674 WRITE(istdo,*)' *--------- RIGID WALL IMPACT---------*'
675 ENDIF
676 isetk = 1
677 ENDIF
678C
679C----------------------------------
680C LB=Fext ;
681C----------------------------------
682C---------
683 CALL imp_setb(ac ,acr ,iddl ,ndof ,lb )
684C-----------------------
685citask0 END IF !(ITASK == 0) THEN
686C----------------------
687c CALL MY_BARRIER
688C---------------------
689C-----------------------
690 IF (isolv==5.OR.isolv==6.AND.imconv>=0) THEN
691 IF (idsc==0) THEN
692C-----------one update per increment
693 IF (ipupd==0.AND.i_imp(2)==0.AND.it==0) THEN
694 idsc=max(idsc,isetk)
695 ENDIF
696C-----------NDDL could be changed by RWALL impact
697 IF(irwall > 0 ) idsc = 1
698 ENDIF
699 ELSE
700 idsc=max(idsc,isetk)
701 END IF
702C /---------------/
703c CALL MY_BARRIER
704C /---------------/
705C----------------------------------
706C STIFFNESS MATRIX
707C----------------------------------
708 IF (isetk ==1 ) THEN
709 IF (imon>0 .AND. itask ==0) CALL startime(timers,31)
710 l1 = 1+nixs*numels
711 l2 = l1+6*numels10
712 l3 = l2+12*numels20
713C----------------------------------
714Citask0 IF (ITASK == 0) THEN
715C----------------------------------
716 nddl = nddl0
717 nnzk = nnzk0
718 nnmax=lsize(9)
719 nkmax=lsize(10)
720 nmc2=lsize(11)
721 CALL zero1(diag_k,nddl)
722 CALL zero1(lt_k,nnzk)
723 li1 =1
724 li2 = li1+lsize(4)
725 li3 = li2+lsize(5)
726 li4 = li3+lsize(1)
727 li5 = li4+lsize(3)
728 li6 = li5+lsize(7)
729 li7 = li6+lsize(2)
730 li8 = li7+lsize(6)
731 li9 = li8+nint2
732 li10 = li9+lsize(8)
733C
734 li11 = li10+(lsize(8)-lcokm)*lsize(9)
735 li12 = li11+lcokm*lsize(10)
736 li13 = li12+4*lsize(11)
737 li14 = li13+lsize(14)
738 li15 = li14+lsize(15)
739 lif = li15+lsize(16)
740C--------- Caution if Rigid Body Reactive (deactive) during a restart it is necessary to revive also DIM
741 IF (iline/=1) THEN
742 ntmp=0
743 IF (i_imp(11)==1) THEN
744 ntmp=1
745 i_imp(11)=-1
746 ENDIF
747 CALL ind_glob_k(npby ,lpby ,
748 1 itab ,nrbyac ,irbyac ,nsc ,ikinw(li1),
749 2 nmc ,ikinw(li2),ikinw(li3),ikinw(li4),nint2 ,
750 3 iint2 ,ipari ,intbuf_tab,ikinw(li8),ikinw(li5),
751 4 ikinw(li6),ikinw(li7),iparg ,elbuf ,elbuf_tab ,
752 5 ixs ,ixq ,ixc ,ixt ,ixp ,
753 6 ixr ,ixtg ,ixtg1 ,ixs(l1) ,ixs(l2) ,
754 7 ixs(l3) ,iddl ,ndof ,iadk ,
755 8 jdik ,nddl ,nnzk ,nnmax ,lsize(8) ,
756 9 inloc ,nkmax ,ikinw(li9),ikinw(li10),ikinw(li11),
757 a nmc2 ,ikinw(li12),ntmp ,lsize(12) ,lsize(13) ,
758 b fr_elem ,iad_elem ,ipm ,igeo ,irbe3 ,
759 c lrbe3 ,ikinw(li13),fr_i2m ,iad_i2m ,fr_rbe3m ,
760 d iad_rbe3m ,irbe2 ,lrbe2 ,ikinw(li14),ikinw(li15))
761C-------------important is no buffer overflow
762C NDDL0 = NDDL
763C NNZK0 = NNZK
764 ENDIF
765C----------------------------------
766citask0 END IF !IF (ITASK == 0) THEN
767C----------------------------------
768C /---------------/
769c CALL MY_BARRIER
770C /---------------/
771c NGDONE = 1
772 CALL imp_glob_khp(
773 1 pm ,geo ,ipm ,igeo ,elbuf ,
774 2 ixs ,ixq ,ixc ,ixt ,ixp ,
775 3 ixr ,ixtg ,ixtg1 ,ixs(l1) ,
776 4 ixs(l2) ,ixs(l3) ,iparg ,tf ,npc ,
777 5 fr_wave ,w16 ,bufmat ,thke ,bufgeo ,
778 6 rby ,skews%SKEW ,x ,
779 7 wa ,iddl ,ndof ,diag_k ,lt_k ,
780 8 iadk ,jdik ,ikg ,ibid ,itask ,
781 9 elbuf_tab ,stack ,drape_sh4n, drape_sh3n ,drapeg )
782C
783C /---------------/
784c CALL MY_BARRIER
785C /---------------/
786 nddl_l = nddl
787C-----------------------------
788citask0 IF (ITASK == 0) THEN
789C-----------------------------
790 IF (idyna>0.AND.idy_damp>0) THEN
791 CALL dyna_cpk0(nddl ,nnzk ,iadk ,jdik ,diag_k ,
792 . lt_k )
793 END IF
794C-------estimation of A(t+dt) w/ initial velocity----
795 IF (ncycle==1.AND.imconv==1.AND.i_imp(5)==0
796 . .AND.idyna>0.AND.ninvel>0) THEN
797 CALL imp_dykv0(nodft ,nodlt ,iddl ,ndof ,ikc ,
798 . diag_k ,iadk ,jdik ,lt_k ,weight ,
799 1 rby ,x ,skews%SKEW ,lpby ,npby ,
800 2 nrbyac ,irbyac ,nint2 ,iint2 ,ipari ,
801 3 intbuf_tab ,irbe3 ,lrbe3 ,frbe3 ,
802 4 irbe2 ,lrbe2 ,v ,vr ,nddl0 ,
803 5 fr_elem,iad_elem,ms ,in )
804 END IF
805 IF (idyna>0.OR.iqstat>0)
806 . CALL imp_dynam(nodft ,nodlt ,iddl ,ndof ,diag_k ,
807 . ms ,in ,hht_a ,weight ,iadk ,
808 . lt_k )
809C
810 IF (ikpres>0.AND.nbuck==0)
811 1 CALL imp_kpres(ibcl ,forc ,npc ,tf ,x ,
812 2 skews%SKEW ,nsensor,sensor_tab,weight,iads_f,
813 3 iddl ,ndof ,iadk ,jdik ,diag_k,
814 4 lt_k )
815 IF(iautspc>0) THEN
816 IF(ncycle==1.AND.imconv==1.AND.i_imp(5)==0) THEN
817 ELSE
818 CALL get_nspc(nspc_old)
819 IF (nspmd > 1) CALL spmd_max_i(nspc_old)
820 END IF
821 ENDIF
822 CALL upd_glob_k(
823 1 icodt ,icodr ,iskew ,ibfv ,npc ,
824 2 tf ,vel ,xframe ,
825 3 rby ,x ,skews%SKEW ,lpby ,npby ,
826 4 itab ,weight ,ms ,in ,nrbyac ,
827 5 irbyac ,nsc ,ikinw(li1),nmc ,ikinw(li2),
828 6 ikinw(li3),ikinw(li4),nint2 ,iint2 ,ikinw(li8),
829 7 ikinw(li5),ikinw(li6),ikinw(li7),ipari ,intbuf_tab,
830 8 nddl ,nnzk ,iadk ,jdik ,
831 9 diag_k ,lt_k ,ndof ,iddl ,ikc ,
832 a d_imp ,lb ,nkud ,ikud ,bkud ,
833 b nmc2 ,ikinw(li12),nt_rw ,dr_imp ,dirul ,
834 c irbe3 ,lrbe3 ,frbe3 ,ikinw(li13),irbe2 ,
835 d lrbe2 ,ikinw(li14),ikinw(li15))
836C
837 anew_stif = 'Y'
838c
839 IF (nspmd>1) THEN
840 CALL upd_fr_k(
841 1 iadk ,jdik ,ndof ,ikc ,iddl ,
842 2 inloc ,fr_elem ,iad_elem ,nddl )
843C
844 CALL weightddl(iddl ,ndof ,ikc ,weight ,w_ddl ,inloc )
845 ENDIF
846C--------case autospc---------
847 IF(iautspc>0) THEN
848 IF(ncycle==1.AND.imconv==1.AND.i_imp(5)==0) THEN
849 ELSE
850 CALL get_nspc(nspc)
851 IF (nspmd > 1) CALL spmd_max_i(nspc)
852 IF (nspc/=nspc_old) THEN
853 imconv=-2
854 IF (ispmd==0) THEN
855 WRITE(iout,1012)nspc_old,nspc
856 WRITE(istdo,1012)nspc_old,nspc
857 ENDIF
858 CALL put_nspc(nspc_old)
859 ENDIF
860 END IF
861 ENDIF
862C
863 IF (n_pat>1) THEN
864 CALL fil_span1(nrbyac,irbyac,npby,iddl,nddl,ikc,ndof,inloc)
865 ENDIF
866C
867 IF(ncycle==1.AND.imconv==1.AND.i_imp(5)==0) THEN
868C--------case mono-domain, Multi-domain NDDL_G is set inside PR_INFOK
869 nddl_g = nddl
870 CALL pr_infok(nddl0,nnzk0,nddl,nnzk,max(nnmax,nkmax))
871C
872 IF (iprec>4) THEN
873 CALL k_band(nddl,iadk,jdik,ibid)
874 maxb = min(maxb,ibid)
875 IF (maxb>10000) THEN
876 CALL m_lnz(nddl,iadk,jdik,maxb,max_l)
877 ENDIF
878 ENDIF
879C
880 ntmp = (tstop-tt)/dt2
881 IF (ntmp>=2) THEN
882 idsgap = 1
883 ELSE
884 idsgap = 0
885 ENDIF
886C
887 IF (isolv==7) THEN
888 CALL crit_llim(nddl,nnzk)
889 END IF
890C
891 IF (nspmd == 1) THEN
892 DO i=1,nddl
893 w_ddl(i)=1
894 ENDDO
895 ENDIF
896 IF (imconv/=-2)CALL ini_k0h(nddl,nnzk,nnzk,iadk,jdik)
897C
898 ENDIF
899C
900 IF (nint7<=0.AND.imconv==1.AND.nspmd==1)
901 . CALL imp_check(itab ,nddl ,iddl ,diag_k ,ndof ,
902 . ikc ,inloc ,nddl0 )
903C
904 IF (imon>0) CALL stoptime(timers,31)
905C
906 IF (isolv==4.OR.isolv==6) THEN
907 CALL arret(5)
908 ENDIF
909C-----------------------------
910citask0 END IF !(ITASK == 0) THEN
911C-----------------------------
912c CALL MY_BARRIER
913C ---------------
914 IF (imconv==-2.AND.iline==0) THEN
915 IF (nint7 > 0) nint7=0
916 GOTO 100
917 END IF
918 ENDIF !IF (ISETK ==1 )
919C-----------------------------
920citask0 IF (ITASK == 0) THEN
921C-----------------------------
922 IF (iqstat>0) THEN
923 CALL qstat_ini(nddl ,inloc ,iddl ,ndof ,ikc ,
924 . ms ,in )
925 ENDIF
926C----------------------------------
927C MATRICE DE RIGIDITE D'INTERFACE
928C----------------------------------
929 gap=ep20
930 IF (nint7>0) THEN
931 l1=lsize(1)
932 l2=lsize(2)
933 lnss2=0
934 lnss=0
935 IF (imon>0) CALL startime(timers,31)
936 CALL sav_inttd(nint7,num_imp,ns_imp(1+nt_imp5),
937 1 ne_imp(1+nt_imp5),ind_imp,num_imp1)
938C
939 IF (imp_int==1) CALL idel_int(
940 1 ipari ,intbuf_tab,num_imp ,ns_imp ,ne_imp ,
941 2 ind_imp ,ndof ,nint7 )
942C
943 CALL dim_int_k(
944 1 ipari ,intbuf_tab,num_imp ,ns_imp ,ne_imp ,
945 2 npby ,lpby ,itab ,nrbyac ,irbyac ,
946 3 lnss ,nint2 ,iint2 ,iaint2 ,lnss2 ,
947 4 nddli ,nnzi ,iddli ,ndofi ,n_impn ,
948 5 n_impm ,nnmax ,nkmax ,ndof ,nsrem ,
949 6 irbe3 ,lrbe3 ,lnss3 ,irbe2 ,lrbe2 ,
950 7 lnsb2 ,lnsrb2 ,ind_imp )
951 ALLOCATE(iadi0(nddli+1))
952 ALLOCATE(itok(nddli))
953 ALLOCATE(jdii0(nnzi))
954 ALLOCATE(nss2(l2),nss3(nrbe3),nsb2(lnsrb2))
955 nsb2=0
956 ALLOCATE(iss2(lnss2),iss3(lnss3),isb2(lnsb2))
957 ALLOCATE(nss(l1))
958 ALLOCATE(iss(lnss))
959C
960 DO i=1,l1
961 nss(i)=0
962 ENDDO
963C
964 CALL ind_int_k(
965 1 ipari ,intbuf_tab,num_imp ,ns_imp ,ne_imp ,
966 2 npby ,lpby ,itab ,nrbyac ,irbyac ,
967 3 nss ,iss ,nint2 ,iint2 ,nss2 ,
968 4 iss2 ,nddli ,nnzi ,iadi0 ,jdii0 ,
969 5 iddli ,ndofi ,n_impn ,itok ,iddl ,
970 6 nnmax ,nkmax ,n_impm ,ndof ,iaint2 ,
971 7 irbe3 ,lrbe3 ,nss3 ,iss3 ,irbe2 ,
972 8 lrbe2 ,nsb2 ,isb2 ,ind_imp )
973 ALLOCATE(diag_i0(nddli))
974 ALLOCATE(lt_i0(nnzi))
975 CALL zero1(diag_i0,nddli)
976 CALL zero1(lt_i0,nnzi)
977C
978 IF (nsrem>0) THEN
979 CALL imp_fr7i(ipari ,intbuf_tab,num_imp ,ns_imp ,nsrem ,
980 1 nbintc,intlist)
981 IF (intp_c>0)
982 1 CALL ind_frkd(
983 2 ipari ,intbuf_tab,num_imp ,ns_imp ,ne_imp ,
984 3 iddli ,ikc ,ndof ,nsrem ,ind_imp )
985 ENDIF
986C
987 nddl_l = nddli
988Ctmp-------A n'est pas modifie ici -------------------
989 IF (ilintf>0) THEN
990 CALL imp_int_k(a ,v ,
991 1 icodt ,icodr ,iskew ,ibfv ,npc ,
992 2 tf ,vel ,nsensor ,sensor_tab,xframe ,
993 3 rby ,xi_c ,skews%SKEW ,lpby ,npby ,
994 4 itab ,weight ,ms ,in ,nrbyac ,
995 5 irbyac ,nss ,iss ,ipari ,intbuf_tab,
996 6 nint2 ,iint2 ,iaint2 ,nss2 ,
997 7 iss2 ,nddli ,nnzi ,iadi0 ,jdii0 ,
998 8 diag_i0 ,lt_i0 ,iddli ,nddl0 ,iadk ,
999 9 jdik ,ikc ,diag_k ,lt_k ,iddl ,
1000 a num_imp ,ns_imp ,ne_imp ,ind_imp ,ndofi ,
1001 b itok ,d_imp ,lb ,gap ,dirul ,
1002 c nt_rw ,num_imp1 ,irbe3 ,lrbe3 ,frbe3 ,
1003 d nss3 ,iss3 ,irbe2 ,lrbe2 ,nsb2 ,
1004 e isb2 )
1005 ELSEIF (ismdisp>0.AND.iline==0) THEN
1006 CALL imp_int_k(a ,v ,
1007 1 icodt ,icodr ,iskew ,ibfv ,npc ,
1008 2 tf ,vel ,nsensor ,sensor_tab,xframe ,
1009 3 rby ,x_a ,skews%SKEW ,lpby ,npby ,
1010 4 itab ,weight ,ms ,in ,nrbyac ,
1011 5 irbyac ,nss ,iss ,ipari ,intbuf_tab,
1012 6 nint2 ,iint2 ,iaint2 ,nss2 ,
1013 7 iss2 ,nddli ,nnzi ,iadi0 ,jdii0 ,
1014 8 diag_i0 ,lt_i0 ,iddli ,nddl0 ,iadk ,
1015 9 jdik ,ikc ,diag_k ,lt_k ,iddl ,
1016 a num_imp ,ns_imp ,ne_imp ,ind_imp ,ndofi ,
1017 b itok ,d_imp ,lb ,gap ,dirul ,
1018 c nt_rw ,num_imp1 ,irbe3 ,lrbe3 ,frbe3 ,
1019 d nss3 ,iss3 ,irbe2 ,lrbe2 ,nsb2 ,
1020 e isb2 )
1021 ELSE
1022 CALL imp_int_k(a ,v ,
1023 1 icodt ,icodr ,iskew ,ibfv ,npc ,
1024 2 tf ,vel ,nsensor ,sensor_tab,xframe ,
1025 3 rby ,x ,skews%SKEW ,lpby ,npby ,
1026 4 itab ,weight ,ms ,in ,nrbyac ,
1027 5 irbyac ,nss ,iss ,ipari ,intbuf_tab,
1028 6 nint2 ,iint2 ,iaint2 ,nss2 ,
1029 7 iss2 ,nddli ,nnzi ,iadi0 ,jdii0 ,
1030 8 diag_i0 ,lt_i0 ,iddli ,nddl0 ,iadk ,
1031 9 jdik ,ikc ,diag_k ,lt_k ,iddl ,
1032 a num_imp ,ns_imp ,ne_imp ,ind_imp ,ndofi ,
1033 b itok ,d_imp ,lb ,gap ,dirul ,
1034 c nt_rw ,num_imp1 ,irbe3 ,lrbe3 ,frbe3 ,
1035 d nss3 ,iss3 ,irbe2 ,lrbe2 ,nsb2 ,
1036 e isb2 )
1037 ENDIF
1038 IF (imon>0) CALL stoptime(timers,31)
1039C
1040 DEALLOCATE(nss2,nss3,nsb2)
1041 DEALLOCATE(iss2,iss3,isb2)
1042 DEALLOCATE(nss)
1043 DEALLOCATE(iss)
1044C
1045 IF (nddli>0) THEN
1046C
1047 ifif = 0
1048 IF (ilintf>0) THEN
1049 ifif = nddlif
1050 CALL save_kif(nddli ,iadi0 ,jdii0 ,diag_i0,lt_i0 ,
1051 1 itok ,nddl)
1052 ENDIF
1053 IF (ifif>0) THEN
1054 nddli = nddlif
1055 ALLOCATE(iadi(nddli+1))
1056 nnzi = iadif(nddli+1)-iadif(1)
1057 ALLOCATE(jdii(nnzi))
1058 DEALLOCATE(itok)
1059 ALLOCATE(itok(nddli))
1060 CALL cp_int_hp(nddli+1,iadif,iadi)
1061 CALL cp_int_hp(nddli,iftok,itok)
1062 CALL cp_int_hp(nnzi,jdiif,jdii)
1063 ALLOCATE(diag_i(nddli))
1064 ALLOCATE(lt_i(nnzi))
1065 CALL cp_real_hp(nddli,diag_if,diag_i)
1066 CALL cp_real_hp(nnzi,lt_if,lt_i)
1067 ELSE
1068C
1069 ALLOCATE(iadi(nddli+1))
1070 ALLOCATE(jdii(nnzi))
1071 CALL cp_int_hp(nddli+1,iadi0,iadi)
1072 CALL cp_int_hp(nnzi,jdii0,jdii)
1073 ALLOCATE(diag_i(nddli))
1074 ALLOCATE(lt_i(nnzi))
1075 CALL cp_real_hp(nddli,diag_i0,diag_i)
1076 CALL cp_real_hp(nnzi,lt_i0,lt_i)
1077C
1078 ENDIF
1079 DEALLOCATE(iadi0)
1080 DEALLOCATE(jdii0)
1081 DEALLOCATE(diag_i0)
1082 DEALLOCATE(lt_i0)
1083C
1084 IF (isolv==4.OR.isolv==6) THEN
1085 CALL arret(5)
1086 ENDIF
1087C
1088 ELSE
1089 ALLOCATE(iadi(1))
1090 ALLOCATE(jdii(1))
1091 DEALLOCATE(iadi0)
1092 DEALLOCATE(jdii0)
1093 ALLOCATE(diag_i(1))
1094 ALLOCATE(lt_i(1))
1095 DEALLOCATE(diag_i0)
1096 DEALLOCATE(lt_i0)
1097 ENDIF
1098C
1099C Store the size of the contact stifness matrix for nonlinear solver outputs
1100 IF ((nspmd==1.OR.nbintc==0).AND.imconv>=0) i_imp(13) = nddli
1101 IF ((nspmd==1.OR.nbintc==0).AND.imconv>=0.AND.
1102 . (lprint/=0.OR.nprint/=0)) THEN
1103 WRITE(iout,1006)
1104 WRITE(istdo,1006)
1105 WRITE(iout,1007)nddli,nnzi !,NNMAX
1106 WRITE(istdo,1007)nddli,nnzi !,NNMAX
1107c WRITE(IOUT,*)
1108c WRITE(ISTDO,*)
1109 ENDIF
1110 ENDIF
1111C----------------------------------
1112 IF (nfxvel/=0.AND.imconv==1) THEN
1113 CALL fv_imp1(nkud ,ikud ,bkud ,lb )
1114 CALL fvbc_impl1(ibfv ,skews%SKEW ,xframe ,dirul ,iddl ,
1115 1 ikc ,ndof ,d_imp ,dr_imp,icodt ,
1116 3 icodr ,iskew )
1117 ENDIF
1118C-------------initialization of Fext---for Riks-->approximation for follower load
1119C IF (NCYCLE==1.AND.IDTC==3.AND.IMCONV==1.AND.
1120 IF (idtc==3.AND.imconv==1.AND.
1121 . i_imp(5)==0) THEN
1122 CALL get_fext(nddl0 ,nddl ,iddl ,ndof ,ikc ,
1123 1 inloc ,lb ,fext ,ac ,acr )
1124 r_imp(13) = tstop-tt+dt2
1125C R_IMP(13) = SQRT(R2)
1126 END IF
1127 IF (idyna>0.AND.idy_damp>0) THEN
1128 CALL imp_dykv(nodft ,nodlt ,iddl ,ndof ,ikc ,
1129 . diag_k ,iadk ,jdik ,lt_k ,weight ,
1130 1 rby ,x ,skews%SKEW ,lpby ,npby ,
1131 2 nrbyac ,irbyac ,nint2 ,iint2 ,ipari ,
1132 3 intbuf_tab ,irbe3 ,lrbe3 ,frbe3 ,
1133 4 irbe2 ,lrbe2 ,v ,vr ,nddl0 ,
1134 5 fr_elem,iad_elem,ms ,in )
1135 END IF
1136C------------- LB, A, AR becomes fext-fint ---------------------------------------------------------
1137
1138 CALL upd_rhs(icodt ,icodr ,iskew ,ibfv ,xframe ,
1139 1 rby ,x ,skews%SKEW ,lpby ,npby ,
1140 2 nrbyac,irbyac,nint2 ,iint2 ,ipari ,
1141 3 intbuf_tab ,ndof ,iddl ,ikc ,
1142 4 nddl0 ,lb ,isetk ,inloc ,dirul ,
1143 5 a ,ar ,ac ,acr ,nt_rw ,
1144 6 irflag,w_ddl ,nddl ,r_imp(1),idyna ,
1145 7 v ,vr ,ms ,in ,irbe3 ,
1146 8 lrbe3 ,frbe3 ,weight ,irbe2 ,lrbe2 )
1147C
1148 IF (nspmd>1) THEN
1149 iconta = nddli + nsrem
1150 CALL spmd_max_i(iconta)
1151 IF (nbintc>0.) THEN
1152 CALL spmd_min_s(gap)
1153 IF (iconta> 0.AND.gap>zero) THEN
1154C
1155 CALL spmd_max_i(ifdis)
1156 IF (ilintf>0) THEN
1157 CALL imp_intfr(
1158 1 num_imp ,ns_imp ,ne_imp ,ipari ,intbuf_tab,
1159 2 npby ,lpby ,itab ,nrbyac ,
1160 3 irbyac ,nint2 ,iint2 ,iddl ,ikc ,
1161 4 ndof ,inloc ,nsrem ,nsl ,nbintc ,
1162 5 intlist ,xi_c ,ibfv ,dirul ,skews%SKEW ,
1163 6 xframe ,iskew ,icodt ,r_imp(16) ,d_imp ,
1164 7 lb ,ifdis ,nddl ,dr_imp ,iddli ,
1165 8 irbe3 ,lrbe3 ,frbe3 ,irbe2 ,lrbe2 ,
1166 9 dd ,ddr ,a ,ar ,ac ,
1167 a acr ,ms ,v ,nddl0 ,r_imp(1) ,
1168 b rby ,icodr ,nt_rw ,w_ddl ,weight ,
1169 c irflag )
1170 ELSEIF (ismdisp>0.AND.iline==0) THEN
1171 CALL imp_intfr(
1172 1 num_imp ,ns_imp ,ne_imp ,ipari ,intbuf_tab,
1173 2 npby ,lpby ,itab ,nrbyac ,
1174 3 irbyac ,nint2 ,iint2 ,iddl ,ikc ,
1175 4 ndof ,inloc ,nsrem ,nsl ,nbintc ,
1176 5 intlist ,x_a ,ibfv ,dirul ,skews%SKEW ,
1177 6 xframe ,iskew ,icodt ,r_imp(16) ,d_imp ,
1178 7 lb ,ifdis ,nddl ,dr_imp ,iddli ,
1179 8 irbe3 ,lrbe3 ,frbe3 ,irbe2 ,lrbe2 ,
1180 9 dd ,ddr ,a ,ar ,ac ,
1181 a acr ,ms ,v ,nddl0 ,r_imp(1) ,
1182 b rby ,icodr ,nt_rw ,w_ddl ,weight ,
1183 c irflag )
1184 ELSE
1185 CALL imp_intfr(
1186 1 num_imp ,ns_imp ,ne_imp ,ipari ,intbuf_tab,
1187 2 npby ,lpby ,itab ,nrbyac ,
1188 3 irbyac ,nint2 ,iint2 ,iddl ,ikc ,
1189 4 ndof ,inloc ,nsrem ,nsl ,nbintc ,
1190 5 intlist ,x ,ibfv ,dirul ,skews%SKEW,
1191 6 xframe ,iskew ,icodt ,r_imp(16) ,d_imp ,
1192 7 lb ,ifdis ,nddl ,dr_imp ,iddli ,
1193 8 irbe3 ,lrbe3 ,frbe3 ,irbe2 ,lrbe2 ,
1194 9 dd ,ddr ,a ,ar ,ac ,
1195 a acr ,ms ,v ,nddl0 ,r_imp(1) ,
1196 b rby ,icodr ,nt_rw ,w_ddl ,weight ,
1197 c irflag )
1198 END IF !(ILINTF>0) THEN
1199C
1200 CALL getnddli_g(
1201 1 npby ,lpby ,itab ,nrbyac ,irbyac ,
1202 2 nint2 ,iint2 ,ipari ,intbuf_tab,ndofi ,
1203 3 ndof ,ikc ,iddl ,fr_elem ,iad_elem ,
1204 4 nddli ,nsl ,nddli_g ,irbe3 ,lrbe3 ,
1205 5 irbe2 ,lrbe2 )
1206C Store the size of the contact stifness matrix for nonlinear solver outputs
1207 IF (ispmd==0.AND.imconv>=0) i_imp(13) = nddli_g
1208 IF (ispmd==0.AND.imconv>=0.AND.
1209 . (lprint/=0.OR.nprint/=0)) THEN
1210 WRITE(iout,1006)
1211 WRITE(istdo,1006)
1212 WRITE(iout,1011)nddli_g
1213 WRITE(istdo,1011)nddli_g
1214 WRITE(iout,*)
1215 WRITE(istdo,*)
1216 ENDIF
1217 ENDIF
1218 ENDIF
1219 ENDIF
1220C
1221 IF (intp_c<0) THEN
1222 CALL kin_knl(
1223 1 ipari ,intbuf_tab,num_imp ,ns_imp ,ne_imp ,
1224 2 npby ,lpby ,itab ,nrbyac ,irbyac ,
1225 3 nint2 ,iint2 ,ibfv ,dirul ,iskew ,
1226 6 icodt ,ndofi ,iddl ,ikc ,ndof ,
1227 5 inloc ,irbe3 ,lrbe3 ,frbe3 ,x ,
1228 6 skews%SKEW,irbe2 ,lrbe2)
1229 ENDIF
1230C
1231 IF (nmonv>0.AND.isetk==1) CALL monv_imp(
1232 . monvol ,volmon ,x ,igrsurf ,
1233 1 nmonv ,imonv ,ipari ,intbuf_tab ,
1234 2 a ,ar ,ndof ,iddl ,ikc ,
1235 3 inloc ,iline ,ibfv ,skews%SKEW,xframe ,
1236 4 dirul ,iskew ,icodt ,irbe3 ,lrbe3 ,
1237 5 frbe3 ,irbe2 ,lrbe2 ,nsurf)
1238C
1239 IF (gap<zero) THEN
1240 imconv = -2
1241 IF (ispmd==0) THEN
1242 WRITE(iout,1009)int(-gap)
1243 WRITE(istdo,1009)int(-gap)
1244 ENDIF
1245 ENDIF
1246C------------
1247 IF (isprb==1.AND.imconv==1) THEN
1248 DO i=1,nddl
1249 lb0(i) = lb(i)
1250 ENDDO
1251 ENDIF
1252C
1253 IF (isigini==1.AND.ncycle==1.AND.imconv==1) THEN
1254 CALL condens_b(nddl0 ,ikc ,lb0 )
1255 ENDIF
1256C---------for mono
1257 nddli_g=max(nddli_g,nddli)
1258 iconta = max(iconta,nddli_g)
1259 IF (iconta>0) THEN
1260 IF (isolv<5) idsc = 1
1261 ENDIF
1262C
1263 IF (ilintf>2.AND.ncycle<ilintf) THEN
1264 nsrem = 0
1265 nsl = 0
1266 ENDIF
1267C
1268 IF (ilintf>0.AND.nddli==0) THEN
1269 IF (nddlif>0) THEN
1270 nddli = nddlif
1271 IF (ALLOCATED(iadi)) DEALLOCATE(iadi)
1272 ALLOCATE(iadi(nddli+1))
1273 nnzi = iadif(nddli+1)-iadif(1)
1274 IF (ALLOCATED(jdii)) DEALLOCATE(jdii)
1275 ALLOCATE(jdii(nnzi))
1276 IF (ALLOCATED(itok)) DEALLOCATE(itok)
1277 ALLOCATE(itok(nddli))
1278 CALL cp_int_hp(nddli,iftok,itok)
1279 CALL cp_int_hp(nddli+1,iadif,iadi)
1280 CALL cp_int_hp(nnzi,jdiif,jdii)
1281 IF (ALLOCATED(diag_i)) DEALLOCATE(diag_i)
1282 ALLOCATE(diag_i(nddli))
1283 IF (ALLOCATED(lt_i)) DEALLOCATE(lt_i)
1284 ALLOCATE(lt_i(nnzi))
1285 CALL cp_real_hp(nddli,diag_if,diag_i)
1286 CALL cp_real_hp(nnzi,lt_if,lt_i)
1287 ENDIF
1288 ENDIF
1289C
1290 r_imp(18)=gap
1291C
1292 IF (iqstat>0.AND.ilintf>0.AND.ilintf==ncycle)
1293 . CALL imp_qifam(nodft ,nodlt ,iddl ,ndof ,inloc ,
1294 . ikc ,diag_k ,ms ,in ,weight)
1295C
1296C WRITE(6,*) IMUMPSV,IDSC,IMCONV
1297#if defined(MUMPS5)
1298 IF (imumpsv >0 .AND.idsc==1.AND.imconv>=0)
1299 . CALL imp_mumps1(nddl0, nnzk0, nddl, nnzk, nnmax,
1300 . nodglob, iddl, ndof, inloc, ikc,
1301 . iadk, jdik, diag_k, lt_k, iad_elem,
1302 . fr_elem, mumps_par, cddlp, iadi, jdii,
1303 . itok, diag_i, lt_i, nddli, nnzi ,
1304 . iprint0, it )
1305#else
1306 WRITE(6,*) "Fatal error: MUMPS is required"
1307 CALL flush(6)
1308 CALL arret(5)
1309#endif
1310 CALL cp_real_hp(nddl,lb,lbb)
1311C--------PCG w/ Projection----
1312 IF(ncycle==1.AND.imconv==1.AND.i_imp(5)==0) THEN
1313 IF (m_vs> 0) THEN
1314C-------------Case smll model---
1315 npcgpv=nddl
1316 IF (nspmd>1)CALL spmd_min_i(npcgpv)
1317 m_vs=min(m_vs,npcgpv)
1318 IF (m_vs> 0) npcgpv=-1
1319 END IF
1320C---------for free rigi motion for springback(generalization later)
1321 IF(irig_m>0) THEN
1322 CALL spbrm_pre(itab ,
1323 1 x ,iparg ,ixc ,ixtg ,partsav ,
1324 2 elbuf_tab ,pm ,ndof ,iddl ,ikc )
1325 END IF
1326 END IF
1327C-----------------------------
1328 IF (iconta>0) isetp = 1
1329C----------------------------------
1330C IMPLICIT RESOLVE
1331C----------------------------------
1332 100 CONTINUE
1333C
1334 IF (iline==1) THEN
1335 IF (ncycle==1.AND.ispmd==0.AND.itask==0) THEN
1336 IF (iqstat>0) THEN
1337 WRITE(iout,*)
1338 WRITE(iout,*)' ** BEGIN LINEAR QUASI-STATIC IMPLICIT COMPUTATION **'
1339 WRITE(istdo,*)
1340 WRITE(istdo,*)' ** BEGIN LINEAR QUASI-STATIC IMPLICIT COMPUTATION **'
1341 WRITE(iout,*)
1342 WRITE(istdo,*)
1343 ELSE
1344 WRITE(iout,*)
1345 WRITE(iout,*)' ** BEGIN LINEAR STATIC IMPLICIT COMPUTATION **'
1346 WRITE(istdo,*)
1347 WRITE(istdo,*)' ** BEGIN LINEAR STATIC IMPLICIT COMPUTATION **'
1348 WRITE(iout,*)
1349 WRITE(istdo,*)
1350 END IF !(IQSTAT>0) THEN
1351 ENDIF
1352C
1353 ntmp=0
1354C
1355c R2=ZERO
1356 CALL produt_hp(nddl,lb,lb,w_ddl,r2)
1357C
1358 IF (r2>zero.AND.r2<ep30) THEN
1359 ELSEIF(iqstat==0.AND.itask==0.AND.nddl>0) THEN
1360 CALL imp_stop(0)
1361 ENDIF
1362C
1363 CALL lin_solv(nddl ,iddl ,ndof ,ikc ,d_imp ,
1364 1 dr_imp,l_tol ,nnzk ,iadk ,jdik ,
1365 2 diag_k,lt_k ,nddli ,iadi ,jdii ,
1366 3 diag_i,lt_i ,itok ,iadm ,jdim ,
1367 4 diag_m,lt_m ,lb ,r_imp(6),inloc ,
1368 5 fr_elem,iad_elem,w_ddl,itask ,isetp ,
1369 6 istop ,a ,ar ,v ,
1370 7 ms ,x ,ipari ,intbuf_tab ,
1371 8 num_imp,ns_imp,ne_imp,nsrem ,nsl ,
1372 9 ntmp ,graphe, itab ,rbid ,ibid ,
1373 a ibid ,nmonv ,imonv ,monvol,igrsurf,
1374 b fr_mv ,volmon,ibfv ,skews%SKEW ,
1375 c xframe,mumps_par,cddlp,ind_imp,xi_c,
1376 d irbe3 ,lrbe3 ,irbe2 ,lrbe2 )
1377
1378C-----------------------------
1379citask0 IF (ITASK == 0) THEN
1380C-----------------------------
1381 IF (inega>0) THEN
1382 CALL iddl2nod(nddl ,iddl ,ndof ,ikc ,inloc ,
1383 . inega ,nnod )
1384 IF (nnod>0) THEN
1385 WRITE(iout,1008)itab(nnod)
1386 WRITE(istdo,1008)itab(nnod)
1387 ENDIF
1388C
1389 ELSEIF(iprec>1.AND.isolv<=2) THEN
1390 CALL imp_checm(itab ,nddl ,iddl ,diag_m ,ndof ,
1391 . ikc ,inloc ,nddl0 )
1392C
1393 ENDIF
1394 IF(nfxv_g/=0.AND.(nsrem+nsl-intp_c)>0) THEN
1395 CALL fv_imp(ibfv ,npc ,tf ,vel ,sensor_tab,
1396 1 d_imp ,dr_imp ,ikc ,iddl ,nsensor ,
1397 2 skews%SKEW ,iframe ,xframe ,v ,vr ,
1398 3 x ,dirul ,ndof ,a ,ar )
1399 ENDIF
1400 CALL recukin(rby ,lpby ,npby ,skews%SKEW ,iskew ,
1401 1 itab ,weight,ms ,in ,
1402 2 ibfv ,vel ,icodt,icodr ,
1403 3 nrbyac,irbyac,nint2 ,iint2 ,ipari ,
1404 4 intbuf_tab ,ndof ,d_imp ,dr_imp,
1405 5 x ,xframe,dirul ,ixr ,ixc ,
1406 6 ixtg ,sh4tree,sh3tree,irbe3 ,lrbe3,
1407 7 frbe3 ,irbe2 ,lrbe2 )
1408 IF (istop>0) CALL imp_stop(-1)
1409 CALL integratorl_hp(d_imp ,dr_imp,
1410 1 x ,v ,vr ,a ,ar )
1411C
1412c IF (IMPDEB>0) THEN
1413c CALL PR_DEB(NDDL ,IDDL ,NDOF ,IKC ,ITAB ,
1414c 1 DIAG_K,DIAG_M,INLOC ,FR_ELEM,IAD_ELEM,
1415c 2 IADK ,JDIK ,LT_K ,LT_M ,NDDLI ,
1416c 3 IADI ,JDII ,ITOK ,DIAG_I ,LT_I ,
1417c 4 LBB ,LBB ,0 ,NSREM ,NSL ,
1418c 5 D_IMP ,DR_IMP,1 ,W_DDL ,AC ,
1419c 6 ACR ,A ,AR ,R2 ,0 ,NODGLOB)
1420c END IF
1421 IF (ilintf>0.AND.ncycle<ilintf) THEN
1422 CALL imp_inttd0(output,timers,
1423 1 ipari ,intbuf_tab ,x_a ,d ,
1424 2 ms ,itab ,in ,d_imp ,dr_imp ,
1425 3 imsch ,i2msch ,isizxv,ilenxv ,igrbric ,
1426 4 islen7,irlen7 ,islen11,irlen11,islen17 ,
1427 5 irlen17,irlen7t,islen7t,iad_elem,fr_elem ,
1428 6 nbintc,intlist,itask ,kinet ,newfront,
1429 7 num_imp,ns_imp,ne_imp,ind_imp ,isendto ,
1430 8 irecvfrom,weight ,ixs ,temp ,
1431 9 dt2prev,waint ,num_imp1,irlen20,islen20,
1432 a irlen20t,islen20t,irlen20e,islen20e,
1433 b ikine,diag_sms,count_remslv,count_remslve,
1434 c nsensor,sensor_tab,xdp,h3d_data,multi_fvm,
1435 d forneqs,maxdgap,interfaces,glob_therm)
1436
1437 tt=max(zero,tt-dt2)
1438 isetk =0
1439C------- Save FIN by AC, ACR ----------
1440 ELSE
1441 IF (ilintf>0) THEN
1442 nt_imp1 = 0
1443 DO i = 1,ninter
1444 num_imp1(i) = 0
1445 END DO
1446 ENDIF
1447C
1448 CALL integrator1_hp(d_imp ,d )
1449 IF ((isecut>0 .OR. iisrot>0 .OR. impose_dr/=0 .OR. idrot==1) .AND. iroddl/=0) THEN
1450 CALL integrator1_hp(dr_imp,dr)
1451 ENDIF
1452C
1453 IF (iscau>0)CALL integrator1_hp(d_imp ,x )
1454 ENDIF
1455 CALL integrator1_hp(d_imp ,x_a )
1456C-----------------------------
1457citask0 END IF !(ITASK == 0) THEN
1458C-----------------------------
1459 ELSE ! nonlinear
1460C-------------------------
1461C IF (GAP<ZERO) GOTO 300
1462 IF (r_imp(18)<zero.OR.imconv==-2) GOTO 300
1463 IF (imconv==1) THEN
1464C-------- value at the beginning of Increament-Sauf diverges -----
1465citask0 IF (ITASK == 0) THEN
1466 IF(ncy_max>0.AND.ncycle>ncy_max) CALL imp_stop(-3)
1467 IF (inconv==1) THEN
1468 CALL cp_impbuf(1 ,elbuf ,elbuf_c ,bufmat ,bufmat_c ,
1469 . fsav ,volmon ,partsav ,intbuf_tab ,
1470 . intbuf_tab_c,ipari ,islen7 ,irlen7 ,
1471 . islen11,irlen11,islen17 ,irlen17,irlen7t ,
1472 . islen7t,irlen20,islen20 ,irlen20t,islen20t,
1473 . irlen20e,islen20e,newfront,elbuf_tab,elbuf_imp,
1474 . iparg )
1475 END IF
1476 IF (ncycle==1) THEN
1477 IF (isprb==1.AND.i_imp(5)==0) r_imp(1) = zero
1478 r_imp(1) = max(r_imp(1),rf_min*rf_min)
1479 r_imp(1) = min(r_imp(1),rf_max*rf_max)
1480 IF (inconv==1) i_imp(12)=1
1481 END IF
1482C--------case of converge with 0 iterations-------
1483 IF (ismdisp>0) THEN
1484 CALL cp_real_hp(nndl,x_a,x_c)
1485 ELSE
1486 CALL cp_real_hp(nndl,x,x_c)
1487 END IF
1488 i_imp(2)=0
1489 i_imp(6)=iconta
1490 it=0
1491citask0 END IF !(ITASK == 0) THEN
1492C
1493 IF (isigini==1) THEN
1494C TMP1 = DT2*NCYCLE
1495C TMP2 = TSTOP-TT+TMP1-DT2
1496C BFAC =TMP1/MAX(DT2,TMP2)
1497C------strickly proportional
1498 bfac= (tt-r_imp(19))/(tstop-r_imp(19))
1499 r_imp(10)=bfac-one
1500 IF (r_imp(10)<zero)CALL vaxpy_hp(nddl ,lb ,lb0 ,r_imp(10))
1501 ENDIF
1502C
1503C----------------------
1504c CALL MY_BARRIER
1505C---------------------
1506c R2=ZERO
1507 CALL produt_hp(nddl,lb,lb,w_ddl,r2)
1508C----------------------
1509c CALL MY_BARRIER
1510C---------------------
1511 IF (r2>=zero.AND.r2<ep30) THEN
1512 ELSEIF(idyna==0.AND.iqstat==0) THEN
1513 CALL imp_stop(0)
1514 ENDIF
1515C
1516 IF (inconv == 1) r_imp(1)=max(r_imp(1),r2)
1517!sb
1518 IF(n_lim == 1 .AND. isprb == 0) r_imp(1)=r2
1519!fin sb
1520 IF (isprb==1) THEN
1521 IF (sqrt(r2/r_imp(1))<=n_tol) THEN
1522c IF (ITASK == 0) THEN
1523 dt_imp=tstop-tt+dt2
1524 CALL zeror_hp(d_imp,numnod)
1525 IF (iroddl/=0) CALL zeror_hp(dr_imp,numnod)
1526c END IF !(ITASK == 0) THEN
1527 GOTO 200
1528 ENDIF
1529 END IF !(ISPRB==1) THEN
1530C
1531citask0 IF (ITASK == 0) THEN
1532C
1533 IF (isprb==1) THEN
1534 tmp1 = dt2*ncycle
1535 tmp2 = tstop-tt+tmp1-dt2
1536 bfac =tmp1/max(dt2,tmp2)
1537 r_imp(10)=bfac-one
1538 r_imp(2)=r2*bfac*bfac
1539 IF (ncycle==1) THEN
1540 r_imp(12)=em01
1541C
1542 IF (iconta>0) r_imp(12)=zep9
1543 ELSE
1544 tmp = dt12/max(dt12,tstop-tt)+n_tol/sqrt(r2/r_imp(1))
1545 tmp = min(half*tmp,one)
1546 r_imp(12)=r_imp(12)*(one-tmp)+tmp
1547 ENDIF
1548 ELSE
1549 r_imp(2)=r2
1550 ENDIF
1551 r_imp(3)=one
1552 r_imp(4)=r_imp(6)
1553C
1554citask0 END IF !(ITASK == 0) THEN
1555C----------------------
1556c CALL MY_BARRIER
1557C---------------------
1558 IF (isprb==1) THEN
1559 tmp = r_imp(10)+one
1560 CALL vscaly_hp(nddl ,lb ,lb0 ,tmp )
1561 END IF
1562 ELSEIF (imconv==-1) THEN
1563C--------line-search------
1564 IF (isprb==1.OR.isigini==1) THEN
1565 IF (r_imp(10)<zero) THEN
1566 CALL vaxpy_hp(nddl ,lb ,lb0 ,r_imp(10))
1567 ENDIF
1568 ENDIF
1569 ELSE
1570citask0 IF (ITASK == 0) THEN
1571 it=it+1
1572 i_imp(2)=i_imp(2)+1
1573citask0 END IF !(ITASK == 0) THEN
1574 IF (isprb==1.OR.isigini==1) THEN
1575 IF (r_imp(10)<zero) THEN
1576 CALL vaxpy_hp(nddl ,lb ,lb0 ,r_imp(10))
1577 ENDIF
1578 ENDIF
1579 ENDIF ! IF (IMCONV==1) THEN
1580C----------------------
1581c CALL MY_BARRIER
1582C---------------------
1583citask0 IF (ITASK == 0) THEN
1584C-----------------------------
1585 IF (isprb==1) THEN
1586 faci=min(one,r_imp(12))
1587 r02=faci*faci*r_imp(1)
1588 ELSE
1589 r02=r_imp(1)
1590 ENDIF
1591 IF (it==1.AND.irefi==5) THEN
1592 r02 = max(r02,em20)
1593 r_imp(6) = max(em20,r_imp(6))
1594 ENDIF
1595 IF (it==1.AND.iconta>i_imp(6)) THEN
1596C re-evoluer Rref-------
1597 IF (irefi==5.AND.nfxv_g>0.AND.imconv>=0) THEN
1598 CALL rer02(rby ,lpby ,npby ,skews%SKEW ,iskew ,
1599 1 itab ,weight,ms ,in ,
1600 2 ibfv ,vel ,icodt,icodr ,
1601 3 nrbyac,irbyac,nint2 ,iint2 ,ipari ,
1602 4 intbuf_tab ,ndof ,d_imp ,dr_imp,
1603 5 x ,xframe,dirul ,ixr ,ixc ,
1604 6 ixtg ,sh4tree,sh3tree,irbe3 ,lrbe3,
1605 7 frbe3 ,iadk ,jdik ,diag_k,lt_k ,
1606 8 iddl ,ikc ,inloc ,num_imp,ns_imp,
1607 9 ne_imp,ind_imp,nddl ,w_ddl ,a ,
1608 a ar ,r02 ,irbe2 ,lrbe2 ,x_c )
1609 r_imp(1) = max(r02,r_imp(1))
1610 ENDIF
1611 IF (i_imp(7)==0.AND.irefi==4) irefi= -4
1612 ENDIF
1613 IF (imconv>0.AND.isprb/=1) THEN
1614 r02 = max(r02,rf_min*rf_min)
1615 r02 = min(r02,rf_max*rf_max)
1616 END IF
1617C
1618 IF (ncycle==1.AND.insolv>=2.AND.it==0.AND.imconv>=0)
1619 . CALL bfgs_ini(nddl,n_lim)
1620 r_imp(17) = r02
1621C-----------------------------
1622citask0 END IF !(ITASK == 0) THEN
1623C-----------------------------
1624C----------------------
1625c CALL MY_BARRIER
1626C---------------------
1627c-------particular case .AND.NFXVEL==0
1628 IF (nddl_g==0.AND.nfxvel > 0) THEN
1629 IF (it==0) THEN
1630C----add 3 to enforce at least one iteration in case of IMPDISP dependent (moving skew or frame)
1631 imconv=3
1632 isetk=0
1633 ELSE
1634 imconv=1
1635 END IF
1636C----------------------
1637c CALL MY_BARRIER
1638C---------------------
1639 ELSE
1640 CALL nl_solv(nddl ,iddl ,ndof ,ikc ,d_imp ,
1641 1 dr_imp,nnzk ,iadk ,jdik ,diag_k,
1642 2 lt_k ,lb ,nddli ,iadi ,jdii ,
1643 3 diag_i,lt_i ,itok ,iadm ,jdim ,
1644 4 diag_m,lt_m ,r_imp(17),dd ,ddr ,
1645 5 itask ,it ,i_imp(2),r_imp(3),r_imp(2),
1646 6 i_imp(5) ,inprint,isetp ,istop ,r_imp(4),
1647 7 r_imp(5),r_imp(6),inloc ,nddl0 ,r_imp(7),
1648 8 r_imp(11),r_imp(18),itab ,fr_elem,iad_elem,
1649 9 w_ddl ,a ,ar ,v ,ms ,
1650 a x ,ipari ,intbuf_tab ,num_imp,
1651 b ns_imp ,ne_imp,nsrem ,nsl ,iconta ,
1652 c graphe ,fac_k ,ipiv_k, nkcond,nmonv ,
1653 d imonv ,monvol ,igrsurf,fr_mv ,
1654 e volmon,ibfv ,skews%SKEW ,xframe,mumps_par,
1655 f cddlp ,ind_imp,nbintc,intlist,newfront,
1656 g isendto,irecvfrom,irbe3,lrbe3,i_imp(8),
1657 h i_imp(9),i_imp(10),fext ,dg ,dgr ,
1658 i dg0 ,dgr0 ,r_imp(13),r_imp(14),
1659 j nodftsk,nodltsk,irbe2,lrbe2,i_imp(12),
1660 k r_imp(20),anew_stif)
1661 END IF !(NDDL==0.AND.NFXVEL > 0) THEN
1662
1663C---------------------------------
1664citask0 IF (ITASK == 0) THEN
1665C---------------------------------
1666 IF(nfxvel/=0) THEN
1667C-----for FV_local
1668 ntmp=0
1669 DO i=1,nfxvel
1670 ntmp=ntmp+iabs(dirul(i))
1671 END DO
1672 IF (ntmp>0)
1673 . CALL fv_imp(ibfv ,npc ,tf ,vel ,sensor_tab,
1674 1 d_imp ,dr_imp ,ikc ,iddl ,nsensor ,
1675 2 skews%SKEW ,iframe ,xframe ,v ,vr ,
1676 3 x ,dirul ,ndof ,a ,ar )
1677 END IF
1678C--------Rigid motions elimination----
1679 IF(irig_m>0.AND.imconv==1) THEN
1680 CALL spb_rm_rig(
1681 1 x ,ixc ,ixtg ,ndof ,iddl ,
1682 2 ikc ,d_imp ,dr_imp ,icodt ,icodr ,
1683 3 skews%SKEW,iskew ,itab )
1684 END IF
1685 IF(imp_lr > 0)THEN
1686 CALL recukin(rby ,lpby ,npby ,skews%SKEW ,iskew ,
1687 1 itab ,weight,ms ,in ,
1688 2 ibfv ,vel ,icodt,icodr ,
1689 3 nrbyac,irbyac,nint2 ,iint2 ,ipari ,
1690 4 intbuf_tab,ndof ,d_imp ,dr_imp,
1691 5 x_c ,xframe,dirul ,ixr ,ixc ,
1692 6 ixtg ,sh4tree,sh3tree,irbe3 ,lrbe3,
1693 7 frbe3 ,irbe2 ,lrbe2 )
1694 ELSE
1695 CALL recukin(rby ,lpby ,npby ,skews%SKEW ,iskew ,
1696 1 itab ,weight,ms ,in ,
1697 2 ibfv ,vel ,icodt,icodr ,
1698 3 nrbyac,irbyac,nint2 ,iint2 ,ipari ,
1699 4 intbuf_tab ,ndof ,d_imp ,dr_imp,
1700 5 x ,xframe,dirul ,ixr ,ixc ,
1701 6 ixtg ,sh4tree,sh3tree,irbe3 ,lrbe3,
1702 7 frbe3 ,irbe2 ,lrbe2 )
1703 END IF
1704c Print information of non-linear solver
1705 IF (solvnfo > zero) THEN
1706 IF (imconv /= -1) THEN
1707 CALL pr_solnfo(nddl ,iddl ,ndof ,ikc ,itab ,
1708 1 diag_k,diag_m,inloc ,fr_elem,iad_elem,
1709 2 iadk ,jdik ,lt_k ,lt_m ,nddli ,
1710 3 iadi ,jdii ,itok ,diag_i ,lt_i ,
1711 4 lbb ,lbb ,it ,nsrem ,nsl ,
1712 5 d_imp ,dr_imp,1 ,w_ddl ,ac ,
1713 6 acr ,a ,ar ,r2 ,ndeb0 ,
1714 7 r_imp ,i_imp ,dd ,ddr)
1715 ENDIF
1716 ENDIF
1717c
1718c IF (IMPDEB>0) THEN
1719c IF (NCYCLE>=NDEB0.AND.NCYCLE<=NDEB1) THEN
1720c CALL PRODUT_HP(NDDL,LB,LB,W_DDL,R2)
1721c CALL PR_DEB(NDDL ,IDDL ,NDOF ,IKC ,ITAB ,
1722c 1 DIAG_K,DIAG_M,INLOC ,FR_ELEM,IAD_ELEM,
1723c 2 IADK ,JDIK ,LT_K ,LT_M ,NDDLI ,
1724c 3 IADI ,JDII ,ITOK ,DIAG_I ,LT_I ,
1725c 4 LBB ,LBB ,IT ,NSREM ,NSL ,
1726c 5 D_IMP ,DR_IMP,1 ,W_DDL ,AC ,
1727c 6 ACR ,A ,AR ,R2 ,NDEB0 )
1728c END IF
1729c END IF
1730c
1731 IF (nbintc>0) THEN
1732 IF (ismdisp>0) THEN
1733 CALL imp_dtkin(
1734 1 ipari ,intbuf_tab ,x_a ,v ,
1735 2 vr ,itab ,d_imp ,dr_imp ,nbintc ,
1736 3 intlist,itask ,newfront,isendto ,irecvfrom,
1737 4 iddl ,ndof ,ikc ,tmp ,ms ,
1738 5 nsensor,sensor_tab,maxdgap)
1739 ELSE
1740 CALL imp_dtkin(
1741 1 ipari ,intbuf_tab ,x ,v ,
1742 2 vr ,itab ,d_imp ,dr_imp ,nbintc ,
1743 3 intlist,itask ,newfront,isendto ,irecvfrom,
1744 4 iddl ,ndof ,ikc ,tmp ,ms ,
1745 5 nsensor,sensor_tab,maxdgap)
1746 IF(nfxv_g/=0.AND.tmp<one)
1747 . CALL fv_imp(ibfv ,npc ,tf ,vel ,sensor_tab,
1748 1 d_imp ,dr_imp ,ikc ,iddl ,nsensor ,
1749 2 skews%SKEW ,iframe ,xframe ,v ,vr ,
1750 3 x ,dirul ,ndof ,a ,ar )
1751 END IF !(ismdisp>0) THEN
1752 END IF
1753C
1754C---------------------------------
1755citask0 END IF !(ITASK == 0) THEN
1756C---------------------------------
1757 300 CONTINUE
1758C---------------------------------
1759citask0 IF (ITASK == 0) THEN
1760C---------------------------------
1761 IF (ismdisp>0) THEN
1762 CALL cp_real_hp(nndl,x_c,x_a)
1763 ELSE
1764 CALL cp_real_hp(nndl,x_c,x)
1765 END IF
1766 CALL cp_impbuf(2 ,elbuf ,elbuf_c ,bufmat ,bufmat_c ,
1767 . fsav ,volmon ,partsav ,intbuf_tab ,
1768 . intbuf_tab_c ,ipari ,islen7 ,irlen7 ,
1769 . islen11,irlen11,islen17 ,irlen17,irlen7t ,
1770 . islen7t,irlen20,islen20 ,irlen20t,islen20t,
1771 . irlen20e,islen20e,newfront,elbuf_tab,elbuf_imp,
1772 . iparg )
1773
1774 IF (ncycle == 1 .AND. istop == 0 .AND.isolv == 7) THEN
1775 IF (it == 1 .AND. i_imp(5) == 0 ) THEN
1776 WRITE (iout, *)
1777 . " **PCG SOLVER HAS BEEN SELECTED FIRSTLY FOR THIS RUN**"
1778 WRITE (istdo, *)
1779 . " **PCG SOLVER HAS BEEN SELECTED FIRSTLY FOR THIS RUN**"
1780 END IF
1781 END IF
1782
1783 IF (istop>0) THEN
1784 IF (istop == 3 .AND.isolv == 7) THEN
1785
1786 isolv = 3
1787 isetk = 1
1788 ikpat = 0
1789 i_imp(11)=1
1790 istop = 0
1791 iprec = 1
1792 IF (nspmd > 1 ) THEN
1793 IF (imumpsd == 0) imumpsd = 1
1794 IF (imumpsv == 0) imumpsv = 1
1795 END IF
1796 IF (ncycle == 1 ) THEN
1797 IF (ispmd == 0) THEN
1798 WRITE (iout, *)
1799 . " **DIRECT SOLVER HAS BEEN SELECTED FOR THIS RUN**"
1800 WRITE (istdo, *)
1801 . " **DIRECT SOLVER HAS BEEN SELECTED FOR THIS RUN**"
1802 END IF !(NSPMD == 0) THEN
1803 ELSE
1804 IF (ispmd == 0) THEN
1805 WRITE (iout, *)
1806 . " **PCG SOLVER HAS BEEN CHANGED TO DIRECT SOLVER **"
1807 WRITE (istdo, *)
1808 . " **PCG SOLVER HAS BEEN CHANGED TO DIRECT SOLVER **"
1809 END IF !(NSPMD == 0) THEN
1810 END IF
1811
1812 ENDIF
1813 imconv=-2
1814 CALL iddl2nod(nddl ,iddl ,ndof ,ikc ,inloc ,
1815 . istop ,nnod )
1816 IF (nnod>0) THEN
1817 WRITE(iout,1008)itab(nnod)
1818 WRITE(istdo,1008)itab(nnod)
1819 ENDIF
1820 ENDIF
1821 inconv = min(1,imconv)
1822 IF (imconv<=-2) THEN
1823 CALL zeror_hp(d_imp,numnod)
1824 IF (iroddl/=0) CALL zeror_hp(dr_imp,numnod)
1825 r_imp(6)=r_imp(4)
1826 i_imp(5)=-2
1827 IF (isprb==1.AND.imconv==-3.AND.iconta==0) THEN
1828 DO i=1,nddl
1829 lb(i) = lb0(i)
1830 ENDDO
1831 imconv=1
1832 GOTO 100
1833 ENDIF
1834 tt=max(zero,tt-dt2)
1835 ncycle=ncycle-1
1836 IF (ncycle==0) dt1=zero
1837 CALL int5_diverg(ipari )
1838 IF (imconv==-2.AND.i_imp(11)/=1) THEN
1839C-----------change dt------
1840 CALL imp_dtn(it,r_imp(11),r_imp(10),r_imp(24))
1841C CALL NUL_ETFAC_A
1842 CALL etfac_ini(iparg )
1843 IF (dt_imp==dt_min) THEN
1844 CALL imp_stop(imconv)
1845 ENDIF
1846 ENDIF
1847 ENDIF
1848C
1849 IF (imconv<=-2.OR.imconv==0) THEN
1850 IF (it==1.AND.iconta>i_imp(6)) THEN
1851 r02 =r_imp(17)
1852 IF (irefi==1) THEN
1853 r02 = min(r02,ten*r_imp(1))
1854 ELSEIF (irefi==2) THEN
1855 r02 = min(r02,onep2*r_imp(1))
1856 ELSEIF (irefi==3.OR.irefi==4.OR.irefi==5) THEN
1857 r02 = min(r02,r_imp(1))
1858 ELSEIF (irefi==-4) THEN
1859 i_imp(7) = 1
1860 irefi = 4
1861 END IF
1862C----Used for gravity case
1863 IF (ncycle > 1) i_imp(7) = 1
1864 r_imp(1)=max(r_imp(1),r02)
1865 ENDIF
1866 ENDIF !IF (IMCONV<=-2.OR.IMCONV==0)
1867C------------for restart---
1868 IF (imconv>0) THEN
1869 r_imp(1) = max(r_imp(1),rf_min*rf_min)
1870 r_imp(1) = min(r_imp(1),rf_max*rf_max)
1871 ENDIF
1872C
1873 IF (imconv==2) dt2=dt2/i_imp(2)
1874C---------------------------------
1875 200 CONTINUE
1876C /---------------/
1877c CALL MY_BARRIER
1878C /---------------/
1879C---------------------------------
1880citask0 IF (ITASK == 0) THEN
1881C---------------------------------
1882 IF (imconv==1.OR.imconv==2.OR.imconv==3) THEN
1883 IF(idyna>0.AND.nfxvel/=0) THEN
1884 CALL fv_fint0(ibfv ,npc ,tf ,vel ,sensor_tab,
1885 1 d_imp ,dr_imp,ikc ,iddl ,nsensor ,
1886 2 skews%SKEW ,iframe ,xframe,a ,ar ,
1887 3 x ,ndof ,ms ,in ,weight ,
1888 4 rby )
1889 END IF
1890 IF (imconv/=3) CALL integrator1_hp(d_imp ,d )
1891 IF (r_imp(11)<em10)
1892 . CALL produt_uhp0(d_imp ,dr_imp,r_imp(11),weight)
1893 CALL imp_dtn(it,r_imp(11),r_imp(10),r_imp(24))
1894 IF ( iqstat>0) CALL dis_cp(nndl,d_imp,dr_imp,0 )
1895 ENDIF
1896 IF (inconv==1 .AND. (isecut>0.OR.iisrot>0
1897 . .OR. impose_dr/=0 .OR. idrot==1)
1898 . .AND. iroddl/=0) THEN
1899 IF (imconv/=3) CALL integrator1_hp(dr_imp,dr)
1900 ENDIF
1901 IF (ismdisp>0) THEN
1902 CALL integrator_hp(ndt ,d_imp ,dr_imp,
1903 1 x_a ,v ,vr ,a ,ar )
1904 ELSE
1905C
1906 CALL integrator_hp(ndt ,d_imp ,dr_imp,
1907 1 x ,v ,vr ,a ,ar )
1908 ENDIF
1909C
1910 IF(idyna>0.AND.imconv==1) THEN
1911 CALL dyna_wex(ibcl ,forc ,snpc,npc ,tf ,ac ,
1912 2 v ,x ,skews ,acr ,vr ,
1913 3 sensor_tab,weight,wfext ,iads_f,
1914 4 fsky ,igrv ,agrv ,ms ,in ,
1915 5 lgrav ,itask ,nrbyac,irbyac ,
1916 6 npby ,rby ,ibfv ,vel ,d_imp ,
1917 7 dr_imp,ikc ,iddl ,iframe,xframe ,
1918 8 ndof ,h3d_data,cptreac,fthreac,nodreac,nsensor,
1919 9 th_surf ,dpl0cld,
1920 a vel0cld, numnod,nsurf,nfunct,nconld,
1921 b ngrav,nfxvel,stf,numskw,python)
1922 CALL dyna_cpr0(nddl0 )
1923 END IF
1924C----------D_imp taking D_n-1 :exception for case with Gravity-----
1925 IF (imconv<=-2 .AND.iqstat>0 .AND. i_imp(7) >0) THEN
1926 CALL dis_cp(nndl,d_imp,dr_imp,1 )
1927 END IF
1928C
1929 IF (imconv == 3 ) inconv = 0
1930 IF (imconv<=-2) imconv=1
1931 IF (imconv==1) i_imp(1)=i_imp(1)+it+1
1932 IF (imconv==1) i_imp(12)=inconv
1933 i_imp(4)=ndt-1
1934 it_t = i_imp(1)
1935C--------
1936citask0 END IF !(ITASK == 0) THEN
1937C
1938 ENDIF !IF (ILINE==1) THEN
1939C----------------------
1940 CALL my_barrier
1941C---------------------
1942citask0 IF (ITASK == 0) THEN
1943 IF (nint7>0) THEN
1944 DEALLOCATE(iadi)
1945 DEALLOCATE(itok)
1946 DEALLOCATE(jdii)
1947 DEALLOCATE(diag_i)
1948 DEALLOCATE(lt_i)
1949 ENDIF
1950C
1951 IF ((nsrem+nsl)>0) CALL ini_kic
1952 IF (ilintf>0) DEALLOCATE(xi_c)
1953 IF (intp_c<0) CALL deallocm
1954 IF (nint2>0) DEALLOCATE(iaint2)
1955
1956citask0 END IF !(ITASK == 0) THEN
1957c
1958 1001 FORMAT(' SYMBOLIC DIM : NDDL =',i8,1x,'NNZ =',i8,1x,'NB_MAX =',i8)
1959 1002 FORMAT(' FINAL DIM : NDDL =',i8,1x,'NNZ =',i8,1x,'NB_MAX =',i8)
1960 1003 FORMAT(/,5x,'--STIFFNESS MATRIX IS REFORMED --')
1961 1004 FORMAT(3x,'LINE. SOLVER : ISOLV =',i4,2x,'PREC. Meth. =',i4,2x,
1962 . 'TOL =',e11.4)
1963 1005 FORMAT(5x,'--STIFFNESS MATRIX WILL BE REFORMED AFTER EACH ',i4,
1964 . 2x,'ITERATIONS--')
1965 1006 FORMAT(5x,'--SUPPLEMENTARY CONTACT STIFFNESS MATRIX',
1966 . 1x, 'IS CREATED--')
1967 1007 FORMAT(5x,' WITH DIM. : ND =',i8,1x,'NZ =',i8) !,1X,'NB_MAX =',I8)
1968 1008 FORMAT(3x,'**WARNING: STIFFNESS MATRIX IS NOT DEFINITE**'/,
1969 . 3x,'**LOOK AT NODE: ',i8)
1970 1009 FORMAT(3x,'**TIMESTEP WILL BE REDUCED TO AVOID DE-ACTIVATION ',
1971 . 'IN INTERFACE:**',i8)
1972 1010 FORMAT(/,5x,'--STIFFNESS MATRIX IS REFORMED',1x,
1973 . 'DUE TO RIGID WALL IMPACT--'/,5x,'WITH IMPACT NUM. =',i8)
1974 1011 FORMAT(5x,' WITH DIM. : ND =',i8)
1975 1012 FORMAT(3x,'**TIMESTEP WILL BE REDUCED DUE TO ',
1976 . 'DIM.(ND) CHANGE W/AUTOSPC::**',2i8)
1977 RETURN
1978C endif MUMPS defined
1979#endif
1980 END
1981!||====================================================================
1982!|| imp_stop ../engine/source/implicit/imp_solv.F
1983!||--- called by ------------------------------------------------------
1984!|| imp_check ../engine/source/implicit/imp_solv.F
1985!|| imp_errmumps ../engine/source/implicit/imp_solv.F
1986!|| imp_solv ../engine/source/implicit/imp_solv.F
1987!|| m36iter_imp ../engine/source/materials/mat/mat036/m36iter_imp.F
1988!|| nl_solv ../engine/source/implicit/nl_solv.F
1989!||--- calls -----------------------------------------------------
1990!|| ancmsg ../engine/source/output/message/message.F
1991!|| arret ../engine/source/system/arret.F
1992!|| my_flush ../engine/source/system/machine.F
1993!||--- uses -----------------------------------------------------
1994!|| message_mod ../engine/share/message_module/message_mod.f
1995!||====================================================================
1996 SUBROUTINE imp_stop(ISTOP)
1997C-----------------------------------------------
1998C M o d u l e s
1999C-----------------------------------------------
2000 USE message_mod
2001C-----------------------------------------------
2002C I m p l i c i t T y p e s
2003C-----------------------------------------------
2004#include "implicit_f.inc"
2005#include "comlock.inc"
2006C-----------------------------------------------
2007C C o m m o n B l o c k s
2008C-----------------------------------------------
2009#include "units_c.inc"
2010#include "task_c.inc"
2011C-----------------------------------------------
2012C D u m m y A r g u m e n t s
2013C-----------------------------------------------
2014C REAL
2015 integer
2016 . istop,img
2017 CHARACTER*60 MSG(-4:2)
2018 DATA MSG
2019 . / 'STOPPED DUE TO SOLVER ERROR **',
2020 . 'STOPPED DUE TO NCYCLE LIMIT **',
2021 . 'STOPPED DUE TO TIMESTEP LIMIT **',
2022 . 'STOPPED DUE TO MODELLING DATA **',
2023 . 'STOPPED DUE TO LOADING DATA **' ,
2024 . 'STOPPED DUE TO DIVERGENCE **' ,
2025 . 'STOP WITH CHECKING **' /
2026C-----------------------------------------------
2027C L o c a l V a r i a b l e s
2028C-----------------------------------------------
2029 IF (ispmd==0) THEN
2030 img=istop
2031 IF (istop>2) img=1
2032 CALL ancmsg(msgid=79,anmode=aninfo,
2033 . c1=msg(img),i1=istop)
2034 CALL my_flush(iout)
2035 ENDIF
2036 CALL arret(2)
2037C------------------------------------------
2038 RETURN
2039 END
2040C------------------------------------------
2041!||====================================================================
2042!|| imp_check ../engine/source/implicit/imp_solv.f
2043!||--- called by ------------------------------------------------------
2044!|| imp_solv ../engine/source/implicit/imp_solv.F
2045!||--- calls -----------------------------------------------------
2046!|| imp_stop ../engine/source/implicit/imp_solv.F
2047!||====================================================================
2048 SUBROUTINE imp_check(ITAB ,NDDL ,IDDL ,DIAG_K ,NDOF ,
2049 . IKC ,INLOC ,NDDL0 )
2050C-----------------------------------------------
2051C I m p l i c i t T y p e s
2052C-----------------------------------------------
2053#include "implicit_f.inc"
2054C-----------------------------------------------
2055C C o m m o n B l o c k s
2056C-----------------------------------------------
2057#include "com04_c.inc"
2058#include "units_c.inc"
2059#include "impl1_c.inc"
2060C-----------------------------------------------
2061C D u m m y A r g u m e n t s
2062C-----------------------------------------------
2063C REAL
2064 INTEGER NDDL,NDDL0,NDOF(*),IDDL(*),IKC(*),INLOC(*),ITAB(*)
2065 my_real
2066 . diag_k(*)
2067C-----------------------------------------------
2068C L o c a l V a r i a b l e s
2069C-----------------------------------------------
2070 INTEGER NLIM,NID,NN,NKC,NFT,II,IDI,ND,ID,ISTOP
2071 PARAMETER (NLIM=6)
2072 integer i,j,k,n,inod(nlim),idl(6*nlim),nfix(nddl0)
2073C------------------------------------------
2074 nid=0
2075 DO i=1,nddl
2076 IF (diag_k(i)<em10) THEN
2077 nid=nid+1
2078 idl(nid)=i
2079 IF (nid==6*nlim) GOTO 100
2080 ENDIF
2081 ENDDO
2082 100 CONTINUE
2083 IF (nid>0) THEN
2084c write(*,*)'nid=',nid
2085 nkc=0
2086 DO n = 1,numnod
2087 i=inloc(n)
2088 DO j=1,ndof(i)
2089 nd = iddl(i)+j
2090 IF (ikc(nd)>0) nkc=nkc+1
2091 nfix(nd)=nkc
2092 ENDDO
2093 ENDDO
2094 nn=0
2095 nft=1
2096 DO 400 k = 1,nid
2097 DO n = nft,numnod
2098 i=inloc(n)
2099 idi=iddl(i)
2100 id=idi-nfix(idi)
2101C IF (ID>IDL(K)) GOTO 400
2102 DO j=1,ndof(i)
2103 nd = idi+j
2104 id = nd-nfix(nd)
2105 IF (idl(k)==id) THEN
2106 nn=nn+1
2107 inod(nn)=itab(i)
2108c write(*,*)'id,i,n,j=',id,i,n,j
2109 IF (nn==nlim) GOTO 200
2110 nft=n+1
2111 GOTO 400
2112 ENDIF
2113 ENDDO
2114 ENDDO
2115 400 CONTINUE
2116 200 CONTINUE
2117 IF (nn>0) THEN
2118 istop=1
2119 WRITE(iout,*)
2120 . ' **ERROR: STIFFNESS MATRIX IS NOT DEFINITE** '
2121 WRITE(iout,*)'--- LOOK AT NODES:---'
2122 WRITE(iout,*)(inod(i),i=1,nn)
2123 WRITE(istdo,*)
2124 . ' **ERROR: STIFFNESS MATRIX IS NOT DEFINITE** '
2125 WRITE(istdo,*)'--- LOOK AT NODES:---'
2126 WRITE(istdo,*)(inod(i),i=1,nn)
2127 IF (nrbe2>0.AND.iline==0) istop = 0
2128 IF (istop>0) CALL imp_stop(-1)
2129 ENDIF
2130 ENDIF
2131C
2132C------------------------------------------
2133 RETURN
2134 END
2135!||====================================================================
2136!|| pr_infok ../engine/source/implicit/imp_solv.f
2137!||--- called by ------------------------------------------------------
2138!|| imp_chkm ../engine/source/implicit/imp_solv.F
2139!|| imp_k_eig ../engine/stub/imp_k_eig.F
2140!|| imp_solv ../engine/source/implicit/imp_solv.F
2141!||--- calls -----------------------------------------------------
2142!|| spmd_inf_g ../engine/source/mpi/implicit/imp_spmd.F
2143!||====================================================================
2144 SUBROUTINE pr_infok(NDDL0,NNZK0,NDDL,NNZK,NNMAX)
2145C-----------------------------------------------
2146C I m p l i c i t T y p e s
2147C-----------------------------------------------
2148#include "implicit_f.inc"
2149C-----------------------------------------------
2150C C o m m o n B l o c k s
2151C-----------------------------------------------
2152#include "com01_c.inc"
2153#include "units_c.inc"
2154#include "task_c.inc"
2155#include "impl1_c.inc"
2156C-----------------------------------------------
2157C D u m m y A r g u m e n t s
2158C-----------------------------------------------
2159C REAL
2160 INTEGER NDDL0,NNZK0,NDDL,NNZK,NNMAX
2161C-----------------------------------------------
2162C L o c a l V a r i a b l e s
2163C-----------------------------------------------
2164 INTEGER NDDLG0,NNZKG0,NDDLG,NNZKG,NNMAXG,NNMAX0
2165 INTEGER NDDL0P(NSPMD),NNZK0P(NSPMD),NDDLP(NSPMD) ,
2166 . NNZKP(NSPMD),NNMAXP(NSPMD),I
2167C------------------------------------------
2168 IF (NSPMD>1) THEN
2169 NDDLG0 = nddl0
2170 nnzkg0 = nnzk0
2171 nddlg = nddl
2172 nnzkg = nnzk
2173 nnmaxg = nnmax
2174 CALL spmd_inf_g(
2175 1 nddlg0 ,nnzkg0 ,nddlg ,nnzkg ,nnmaxg ,
2176 2 nddl0p ,nnzk0p ,nddlp ,nnzkp ,nnmaxp )
2177 IF (ispmd==0) THEN
2178 IF (imp_chk>0) THEN
2179 WRITE(iout,*)
2180 WRITE(iout,*)' *--------- STIFFNESS MATRIX INFO. ---------*'
2181 WRITE(iout,1001)nddlg0,nnzkg0,nnmaxg
2182 WRITE(iout,*)
2183 DO i=1,nspmd
2184 WRITE(iout,1003)i,nddl0p(i),nnzk0p(i),nnmaxp(i)
2185 ENDDO
2186 WRITE(iout,*)
2187 WRITE(iout,1002)nddlg,nnzkg,nnmaxg
2188 WRITE(iout,*)
2189 DO i=1,nspmd
2190 WRITE(iout,1003)i,nddlp(i),nnzkp(i),nnmaxp(i)
2191 ENDDO
2192 ELSE
2193 WRITE(iout,*)
2194 WRITE(istdo,*)
2195 WRITE(iout,*)' *--------- STIFFNESS MATRIX SETUP ---------*'
2196 WRITE(istdo,*)' *--------- STIFFNESS MATRIX SETUP ---------*'
2197 WRITE(iout,1001)nddlg0,nnzkg0,nnmaxg
2198 WRITE(istdo,1001)nddlg0,nnzkg0,nnmaxg
2199 WRITE(iout,*)
2200 WRITE(istdo,*)
2201 DO i=1,nspmd
2202 WRITE(iout,1003)i,nddl0p(i),nnzk0p(i),nnmaxp(i)
2203 WRITE(istdo,1003)i,nddl0p(i),nnzk0p(i),nnmaxp(i)
2204 ENDDO
2205 WRITE(iout,*)
2206 WRITE(istdo,*)
2207 WRITE(iout,1002)nddlg,nnzkg,nnmaxg
2208 WRITE(istdo,1002)nddlg,nnzkg,nnmaxg
2209 WRITE(iout,*)
2210 WRITE(istdo,*)
2211 DO i=1,nspmd
2212 WRITE(iout,1003)i,nddlp(i),nnzkp(i),nnmaxp(i)
2213 WRITE(istdo,1003)i,nddlp(i),nnzkp(i),nnmaxp(i)
2214 ENDDO
2215C IF (L_LIM==0) L_LIM=NDDLG
2216 ENDIF
2217 ENDIF
2218 ELSE
2219 IF (imp_chk>0) THEN
2220 WRITE(iout,*)
2221 WRITE(iout,*)' *--------- STIFFNESS MATRIX INFO. ---------*'
2222 WRITE(iout,1001)nddl0,nnzk0,nnmax
2223 WRITE(iout,1002)nddl,nnzk,nnmax
2224 WRITE(iout,*)
2225 ELSE
2226 WRITE(iout,*)
2227 WRITE(istdo,*)
2228 WRITE(iout,*)' *--------- STIFFNESS MATRIX SETUP ---------*'
2229 WRITE(istdo,*)' *--------- STIFFNESS MATRIX SETUP ---------*'
2230 WRITE(iout,1001)nddl0,nnzk0,nnmax
2231 WRITE(istdo,1001)nddl0,nnzk0,nnmax
2232 WRITE(iout,1002)nddl,nnzk,nnmax
2233 WRITE(istdo,1002)nddl,nnzk,nnmax
2234 WRITE(iout,*)
2235 WRITE(istdo,*)
2236 ENDIF
2237 IF (l_lim==0) l_lim=nddl
2238 ENDIF
2239 1001 FORMAT(' SYMBOLIC DIM : ND =',i8,1x,'NZ =',i10,1x,'NB_MAX =',i8)
2240 1002 FORMAT(' FINAL DIM : ND =',i8,1x,'NZ =',i10,1x,'NB_MAX =',i8)
2241 1003 FORMAT(' PROC=',i5,5x,'ND =',i8,1x,'NZ =',i10,1x,'NB_MAX =',i8)
2242C------------------------------------------
2243 RETURN
2244 END
2245!||====================================================================
2246!|| k_band ../engine/source/implicit/imp_solv.F
2247!||--- called by ------------------------------------------------------
2248!|| imp_chkm ../engine/source/implicit/imp_solv.F
2249!|| imp_solv ../engine/source/implicit/imp_solv.F
2250!|| ind_spa2 ../engine/source/implicit/ind_glob_k.F
2251!|| ind_span ../engine/source/implicit/ind_glob_k.F
2252!||====================================================================
2253 SUBROUTINE k_band(NDDL,IADK,JDIK,NDMAX)
2254C-----------------------------------------------
2255C I m p l i c i t T y p e s
2256C-----------------------------------------------
2257#include "implicit_f.inc"
2258C-----------------------------------------------
2259C D u m m y A r g u m e n t s
2260C-----------------------------------------------
2261C REAL
2262 INTEGER NDDL,IADK(*),JDIK(*),NDMAX
2263C-----------------------------------------------
2264C L o c a l V a r i a b l e s
2265C-----------------------------------------------
2266 INTEGER I,J,JD,ND(NDDL)
2267C------------------------------------------
2268 DO i = 1, nddl
2269 nd(i) = 1 + iadk(i+1) - iadk(i)
2270 DO j = iadk(i),iadk(i+1)-1
2271 jd = jdik(j)
2272 nd(jd) = nd(jd) + 1
2273 ENDDO
2274 ENDDO
2275C
2276 ndmax = 0
2277 DO i = 1, nddl
2278 ndmax = max(ndmax,nd(i))
2279 ENDDO
2280C------------------------------------------
2281 RETURN
2282 END
2283!||====================================================================
2284!|| m_lnz ../engine/source/implicit/imp_solv.F
2285!||--- called by ------------------------------------------------------
2286!|| imp_chkm ../engine/source/implicit/imp_solv.F
2287!|| imp_solv ../engine/source/implicit/imp_solv.F
2288!||--- calls -----------------------------------------------------
2289!|| dim_subnz ../engine/source/implicit/imp_solv.F
2290!|| sp_stat0 ../engine/source/implicit/imp_fsa_inv.F
2291!||====================================================================
2292 SUBROUTINE m_lnz(NDDL,IADK,JDIK,NDMAX,NLMAX)
2293C-----------------------------------------------
2294C I m p l i c i t T y p e s
2295C-----------------------------------------------
2296#include "implicit_f.inc"
2297C-----------------------------------------------
2298C D u m m y A r g u m e n t s
2299C-----------------------------------------------
2300C REAL
2301 INTEGER NDDL,IADK(*),JDIK(*),NDMAX,NLMAX
2302C-----------------------------------------------
2303C L o c a l V a r i a b l e s
2304C-----------------------------------------------
2305 INTEGER I,J,JD,JM(NDMAX+1),NC,NNZ
2306C------------------------------------------
2307 DO i=1,nddl
2308 CALL sp_stat0(i ,iadk ,jdik ,nc ,jm )
2309 CALL dim_subnz(iadk ,jdik ,nc ,jm ,nnz )
2310 nlmax = max(nlmax,nnz)
2311 ENDDO
2312C------------------------------------------
2313 RETURN
2314 END
2315!||====================================================================
2316!|| dim_subnz ../engine/source/implicit/imp_solv.F
2317!||--- called by ------------------------------------------------------
2318!|| m_lnz ../engine/source/implicit/imp_solv.F
2319!||--- calls -----------------------------------------------------
2320!|| intab0 ../engine/source/implicit/imp_fsa_inv.F
2321!||====================================================================
2322 SUBROUTINE dim_subnz(IADK ,JDIK ,NC ,JM , NNZA )
2323C-----------------------------------------------
2324C I m p l i c i t T y p e s
2325C-----------------------------------------------
2326#include "implicit_f.inc"
2327C-----------------------------------------------
2328C D u m m y A r g u m e n t s
2329C-----------------------------------------------
2330 INTEGER IADK(*) ,JDIK(*),NC ,JM(*),NNZA
2331C REAL
2332C-----------------------------------------------
2333C External function
2334C-----------------------------------------------
2335 INTEGER INTAB0
2336 EXTERNAL intab0
2337C-----------------------------------------------
2338C L o c a l V a r i a b l e s
2339C-----------------------------------------------
2340 INTEGER I,J,K,JJ,N
2341C--------------------------------------------
2342 nnza=0
2343 DO i=1,nc
2344 j=jm(i)
2345 DO k=iadk(j),iadk(j+1)-1
2346 jj=jdik(k)
2347 n=intab0(nc,jm,jj)
2348 IF (n>0) nnza=nnza+1
2349 ENDDO
2350 ENDDO
2351C
2352 RETURN
2353 END
2354!||====================================================================
2355!|| imp_checm ../engine/source/implicit/imp_solv.F
2356!||--- called by ------------------------------------------------------
2357!|| imp_solv ../engine/source/implicit/imp_solv.F
2358!||====================================================================
2359 SUBROUTINE imp_checm(ITAB ,NDDL ,IDDL ,DIAG_M ,NDOF ,
2360 . IKC ,INLOC ,NDDL0 )
2361C-----------------------------------------------
2362C I m p l i c i t T y p e s
2363C-----------------------------------------------
2364#include "implicit_f.inc"
2365C-----------------------------------------------
2366C C o m m o n B l o c k s
2367C-----------------------------------------------
2368#include "com04_c.inc"
2369#include "units_c.inc"
2370C-----------------------------------------------
2371C D u m m y A r g u m e n t s
2372C-----------------------------------------------
2373C REAL
2374 INTEGER NDDL,NDDL0,NDOF(*),IDDL(*),IKC(*),INLOC(*),ITAB(*)
2375 my_real
2376 . diag_m(*)
2377C-----------------------------------------------
2378C L o c a l V a r i a b l e s
2379C-----------------------------------------------
2380 INTEGER NLIM,NID,NN,NKC,NFT,II,IDI,ND,ID
2381 PARAMETER (NLIM=6)
2382 INTEGER I,J,K,N,INOD(NLIM),IDL(6*NLIM),NFIX(NDDL0)
2383C------------------------------------------
2384 nid=0
2385 DO i=1,nddl
2386 IF (diag_m(i)>ep10) THEN
2387 nid=nid+1
2388 idl(nid)=i
2389 IF (nid==6*nlim) GOTO 100
2390 ENDIF
2391 ENDDO
2392 100 CONTINUE
2393 IF (nid>0) THEN
2394 nkc=0
2395 DO n = 1,numnod
2396 i=inloc(n)
2397 DO j=1,ndof(i)
2398 nd = iddl(i)+j
2399 IF (ikc(nd)>0) nkc=nkc+1
2400 nfix(nd)=nkc
2401 ENDDO
2402 ENDDO
2403 nn=0
2404 nft=1
2405 DO 400 k = 1,nid
2406 DO n = nft,numnod
2407 i=inloc(n)
2408 idi=iddl(i)
2409 id=idi-nfix(idi)
2410 DO j=1,ndof(i)
2411 nd = idi+j
2412 id = nd-nfix(nd)
2413 IF (idl(k)==id) THEN
2414 nn=nn+1
2415 inod(nn)=itab(i)
2416 IF (nn==nlim) GOTO 200
2417 nft=n+1
2418 GOTO 400
2419 ENDIF
2420 ENDDO
2421 ENDDO
2422 400 CONTINUE
2423 200 CONTINUE
2424 IF (nn>0) THEN
2425 WRITE(iout,*)
2426 . ' **WARNING : POSSIBLE NOT DEFINITE STIFFNESS MATRIX ** '
2427 WRITE(iout,*)'--- LOOK AT NODES:---'
2428 WRITE(iout,*)(inod(i),i=1,nn)
2429 WRITE(istdo,*)
2430 . ' **WARNING : POSSIBLE NOT DEFINITE STIFFNESS MATRIX ** '
2431 WRITE(istdo,*)'--- LOOK AT NODES:---'
2432 WRITE(istdo,*)(inod(i),i=1,nn)
2433 ENDIF
2434 ENDIF
2435C
2436C------------------------------------------
2437 RETURN
2438 END
2439!||====================================================================
2440!|| imp_b2a ../engine/source/implicit/imp_solv.F
2441!||--- called by ------------------------------------------------------
2442!|| imp_solv ../engine/source/implicit/imp_solv.F
2443!||====================================================================
2444 SUBROUTINE imp_b2a(F ,M ,IDDL ,NDOF ,B )
2445C-----------------------------------------------
2446C I m p l i c i t T y p e s
2447C-----------------------------------------------
2448#include "implicit_f.inc"
2449C-----------------------------------------------
2450C C o m m o n B l o c k s
2451C-----------------------------------------------
2452#include "com04_c.inc"
2453C-----------------------------------------------
2454C D u m m y A r g u m e n t s
2455C-----------------------------------------------
2456 INTEGER IDDL(*),NDOF(*)
2457C REAL
2458 my_real
2459 . f(3,*),m(3,*),b(*)
2460C-----------------------------------------------
2461C L o c a l V a r i a b l e s
2462C-----------------------------------------------
2463 INTEGER I,J,ID
2464C------------------------------------------
2465 DO i = 1,numnod
2466 DO j =1,ndof(i)
2467 id = iddl(i) + j
2468 IF (j>3) THEN
2469 m(j-3,i) = b(id)
2470 ELSE
2471 f(j,i) = b(id)
2472 ENDIF
2473 ENDDO
2474 ENDDO
2475C------------------------------------------
2476 RETURN
2477 END
2478!||====================================================================
2479!|| ini_kif ../engine/source/implicit/imp_solv.F
2480!||--- called by ------------------------------------------------------
2481!|| imp_solv ../engine/source/implicit/imp_solv.F
2482!||--- uses -----------------------------------------------------
2483!|| imp_lintf ../engine/share/modules/impbufdef_mod.F
2484!||====================================================================
2485 SUBROUTINE ini_kif
2486C-----------------------------------------------
2487C M o d u l e s
2488C-----------------------------------------------
2489 USE imp_lintf
2490C-----------------------------------------------
2491C I m p l i c i t T y p e s
2492C-----------------------------------------------
2493#include "implicit_f.inc"
2494C-----------------------------------------------
2495C L o c a l V a r i a b l e s
2496C-----------------------------------------------
2497 nddlif = 0
2498 nzif = 0
2499C------------------------------------------
2500 RETURN
2501 END
2502!||====================================================================
2503!|| save_kif ../engine/source/implicit/imp_solv.F
2504!||--- called by ------------------------------------------------------
2505!|| imp_solv ../engine/source/implicit/imp_solv.F
2506!||--- calls -----------------------------------------------------
2507!|| cp_int ../engine/source/implicit/produt_v.F
2508!|| cp_real ../engine/source/implicit/produt_v.F
2509!||--- uses -----------------------------------------------------
2510!|| imp_lintf ../engine/share/modules/impbufdef_mod.F
2511!||====================================================================
2512 SUBROUTINE save_kif(NDDL ,IADK ,JDIK ,DIAG_K,LT_K ,
2513 1 ITOK ,NDDLG)
2514C-----------------------------------------------
2515C M o d u l e s
2516C-----------------------------------------------
2517 USE imp_lintf
2518C-----------------------------------------------
2519C I m p l i c i t T y p e s
2520C-----------------------------------------------
2521#include "implicit_f.inc"
2522C-----------------------------------------------
2523C D u m m y A r g u m e n t s
2524C-----------------------------------------------
2525 INTEGER NDDL,IADK(*),JDIK(*),ITOK(*),NDDLG
2526C REAL
2527 my_real
2528 . diag_k(*),lt_k(*)
2529C-----------------------------------------------
2530C L o c a l V a r i a b l e s
2531C-----------------------------------------------
2532 INTEGER IADCP(NDDLIF+1),JDICP(NZIF),ITOCP(NDDLIF)
2533 INTEGER NDDLI0,NZI0,NZK,IERR1,IERR2,ITAG(NDDLG),
2534 . I,J,II,NL,NR,ITON(NDDL)
2535 my_real
2536 . DIAG_CP(NDDLIF),LT_CP(NZIF)
2537C------------------------------------------
2538 IF (NDDL==0) return
2539 IF (nddlif==0) THEN
2540 nddlif = nddl
2541 nzif =iadk(nddl+1)-iadk(1)
2542 IF(ALLOCATED(iadif)) DEALLOCATE(iadif)
2543 IF(ALLOCATED(jdiif)) DEALLOCATE(jdiif)
2544 IF(ALLOCATED(iftok)) DEALLOCATE(iftok)
2545 ALLOCATE(iadif(nddlif+1),iftok(nddlif),jdiif(nzif),stat=ierr1)
2546 CALL cp_int((nddlif+1),iadk,iadif)
2547 CALL cp_int(nddlif,itok,iftok)
2548 CALL cp_int(nzif,jdik,jdiif)
2549 IF(ALLOCATED(diag_if)) DEALLOCATE(diag_if)
2550 IF(ALLOCATED(lt_if)) DEALLOCATE(lt_if)
2551 ALLOCATE(diag_if(nddlif),lt_if(nzif),stat=ierr2)
2552 CALL cp_real(nddlif,diag_k,diag_if)
2553 CALL cp_real(nzif,lt_k,lt_if)
2554 ELSE
2555 CALL cp_int((nddlif+1),iadif,iadcp)
2556 CALL cp_int(nddlif,iftok,itocp)
2557 CALL cp_real(nddlif,diag_if,diag_cp)
2558 CALL cp_int(nzif,jdiif,jdicp)
2559 CALL cp_real(nzif,lt_if,lt_cp)
2560 nddli0 = nddlif
2561 nzi0 = nzif
2562 DO i = 1,nddlg
2563 itag(i) = 0
2564 ENDDO
2565 DO i = 1,nddli0
2566 itag(iftok(i)) = i
2567 ENDDO
2568 DO i = 1,nddl
2569 j = itok(i)
2570 IF (itag(j)==0) THEN
2571 nddlif = nddlif+1
2572 nzif = nzif+iadk(i+1)-iadk(i)
2573 iton(i) = nddlif
2574 ELSE
2575 iton(i) = itag(j)
2576 ENDIF
2577 ENDDO
2578 IF(ALLOCATED(iadif)) DEALLOCATE(iadif)
2579 IF(ALLOCATED(jdiif)) DEALLOCATE(jdiif)
2580 IF(ALLOCATED(iftok)) DEALLOCATE(iftok)
2581 ALLOCATE(iadif(nddlif+1),iftok(nddlif),jdiif(nzif),stat=ierr1)
2582 IF(ALLOCATED(diag_if)) DEALLOCATE(diag_if)
2583 IF(ALLOCATED(lt_if)) DEALLOCATE(lt_if)
2584 ALLOCATE(diag_if(nddlif),lt_if(nzif),stat=ierr2)
2585C---------copy old-----
2586 CALL cp_int((nddli0+1),iadcp,iadif)
2587 CALL cp_int(nddli0,itocp,iftok)
2588 CALL cp_real(nddli0,diag_cp,diag_if)
2589 CALL cp_int(nzi0,jdicp,jdiif)
2590 CALL cp_real(nzi0,lt_cp,lt_if)
2591C---------add [k]-----
2592 nl = nddli0
2593 nzif = nzi0
2594 DO i = 1,nddl
2595 j = itok(i)
2596 IF (itag(j)==0) THEN
2597 nl = nl + 1
2598 nr = iadk(i+1)-iadk(i)
2599 iftok(nl) = j
2600 diag_if(nl)=diag_k(i)
2601 DO ii = iadk(i),iadk(i+1)-1
2602 nzif = nzif + 1
2603 jdiif(nzif) = iton(jdik(ii))
2604 lt_if(nzif) = lt_k(ii)
2605 ENDDO
2606 iadif(nl+1) = nzif + 1
2607 ENDIF
2608 ENDDO
2609C
2610 IF (nl/=nddlif)
2611 . print *,'--MEMERY PROBLEM [K]if--:',nl,nddlif
2612 ENDIF
2613C------------------------------------------
2614 RETURN
2615 END
2616!||====================================================================
2617!|| diag_kif ../engine/source/implicit/imp_solv.F
2618!||--- called by ------------------------------------------------------
2619!|| lin_solv ../engine/source/implicit/lin_solv.F
2620!||--- uses -----------------------------------------------------
2621!|| imp_lintf ../engine/share/modules/impbufdef_mod.F
2622!||====================================================================
2623 SUBROUTINE diag_kif(DIAG_K)
2624C-----------------------------------------------
2625C M o d u l e s
2626C-----------------------------------------------
2627 USE imp_lintf
2628C-----------------------------------------------
2629C I m p l i c i t T y p e s
2630C-----------------------------------------------
2631#include "implicit_f.inc"
2632C-----------------------------------------------
2633C D u m m y A r g u m e n t s
2634C-----------------------------------------------
2635C REAL
2636 my_real
2637 . diag_k(*)
2638C-----------------------------------------------
2639C L o c a l V a r i a b l e s
2640C-----------------------------------------------
2641 INTEGER I,II
2642C-----------------------------
2643 RETURN
2644 DO i=1,nddlif
2645 ii = iftok(i)
2646 diag_k(ii) = diag_k(ii) +diag_if(i)
2647 ENDDO
2648C-----------------------------
2649 RETURN
2650 END
2651!||====================================================================
2652!|| matv_kif ../engine/source/implicit/imp_solv.F
2653!||--- called by ------------------------------------------------------
2654!|| mav_lt2 ../engine/source/implicit/produt_v.F
2655!|| mav_lth ../engine/source/implicit/produt_v.F
2656!|| mav_lth0 ../engine/source/implicit/produt_v.F
2657!|| mav_ltp ../engine/source/implicit/produt_v.F
2658!||--- uses -----------------------------------------------------
2659!|| imp_lintf ../engine/share/modules/impbufdef_mod.F
2660!||====================================================================
2661 SUBROUTINE matv_kif(V,W)
2662C-----------------------------------------------
2663C M o d u l e s
2664C-----------------------------------------------
2665 USE imp_lintf
2666C-----------------------------------------------
2667C I m p l i c i t T y p e s
2668C-----------------------------------------------
2669#include "implicit_f.inc"
2670C-----------------------------------------------
2671C D u m m y A r g u m e n t s
2672C-----------------------------------------------
2673C REAL
2674 my_real
2675 . w(*), v(*)
2676C-----------------------------------------------
2677C L o c a l V a r i a b l e s
2678C-----------------------------------------------
2679 INTEGER I,J,K,II,KK
2680 my_real
2681 . l_k
2682C-----------------------------
2683 RETURN
2684 DO i=1,nddlif
2685 ii = iftok(i)
2686c W(II) = W(II) +DIAG_IF(I)*V(II)
2687 DO j =iadif(i),iadif(i+1)-1
2688 k =jdiif(j)
2689 kk = iftok(k)
2690 l_k = lt_if(j)
2691 w(ii) = w(ii) + l_k*v(kk)
2692 w(kk) = w(kk) + l_k*v(ii)
2693 ENDDO
2694 ENDDO
2695C-----------------------------
2696 RETURN
2697 END
2698!||====================================================================
2699!|| imp_cpre ../engine/source/implicit/imp_solv.F
2700!||--- calls -----------------------------------------------------
2701!|| buf_dim ../engine/source/implicit/produt_v.F
2702!|| cp_real ../engine/source/implicit/produt_v.F
2703!||====================================================================
2704 SUBROUTINE imp_cpre(IFLAG,NNDL ,
2705 1 ELBUF ,ELBUF_C,BUFMAT ,FSAV ,VOLMON ,BUFMAT_C,X ,X_C ,
2706 2 PARTSAV,R_IMP )
2707C-----------------------------------------------
2708C I m p l i c i t T y p e s
2709C-----------------------------------------------
2710#include "implicit_f.inc"
2711C-----------------------------------------------
2712C C o m m o n B l o c k s
2713C-----------------------------------------------
2714#include "com04_c.inc"
2715#include "param_c.inc"
2716#include "scr11_c.inc"
2717C-----------------------------------------------
2718C D u m m y A r g u m e n t s
2719C-----------------------------------------------
2720 INTEGER IFLAG,NNDL
2721C REAL
2722 my_real
2723 . elbuf(*) ,elbuf_c(*),bufmat(*) ,fsav(*),volmon(*) ,bufmat_c(*),
2724 . x(*) ,x_c(*) ,partsav(*),r_imp(*)
2725C-----------------------------------------------
2726C L o c a l V a r i a b l e s
2727C-----------------------------------------------
2728 INTEGER LI1,LI2,LI3,LI4,LI5
2729C--------------Iflag= 1->copy; 2 ->restore---------------
2730 CALL buf_dim(li1,li2,li3,li4)
2731 IF (iflag==1) THEN
2732 CALL cp_real(li1,elbuf,elbuf_c)
2733 CALL cp_real(li2,bufmat,bufmat_c)
2734 CALL cp_real(li3,fsav,bufmat_c(li2+1))
2735 CALL cp_real(li4,volmon,bufmat_c(li2+li3+1))
2736 CALL cp_real(nndl,x,x_c)
2737 CALL cp_real(npsav*npart,partsav,r_imp(16))
2738 r_imp(14) = encin
2739 r_imp(15) = enrot
2740 ELSEIF (iflag==2) THEN
2741 CALL cp_real(li1,elbuf_c,elbuf)
2742 CALL cp_real(li2,bufmat_c,bufmat)
2743 CALL cp_real(li3,bufmat_c(li2+1),fsav)
2744 CALL cp_real(li4,bufmat_c(li2+li3+1),volmon)
2745 CALL cp_real(nndl,x_c,x)
2746 CALL cp_real(npsav*npart,r_imp(16),partsav)
2747 encin = r_imp(14)
2748 enrot = r_imp(15)
2749 ENDIF
2750C-----------------------------
2751 RETURN
2752 END
2753!||====================================================================
2754!|| imp_check0 ../engine/source/implicit/imp_solv.F
2755!||--- called by ------------------------------------------------------
2756!|| imp_chkm ../engine/source/implicit/imp_solv.f
2757!||--- calls -----------------------------------------------------
2758!|| spmd_max_i ../engine/source/mpi/implicit/imp_spmd.F
2759!|| spmd_send_vr ../engine/source/mpi/implicit/imp_spmd.F
2760!|| spmd_sum_s ../engine/source/mpi/implicit/imp_spmd.F
2761!|| spmd_sumf_v ../engine/source/mpi/implicit/imp_spmd.F
2762!||====================================================================
2763 SUBROUTINE imp_check0(ITAB ,NDDL ,IDDL ,DIAG_K ,DIAG_M ,
2764 . NDOF ,IKC ,INLOC ,NDDL0 ,NIR ,
2765 . NDDLI ,ITOK ,DIAG_I,IWAR ,IERR )
2766C-----------------------------------------------
2767C I m p l i c i t T y p e s
2768C-----------------------------------------------
2769#include "implicit_f.inc"
2770C-----------------------------------------------
2771C C o m m o n B l o c k s
2772C-----------------------------------------------
2773#include "com04_c.inc"
2774#include "units_c.inc"
2775#include "task_c.inc"
2776#include "com01_c.inc"
2777C-----------------------------------------------
2778C D u m m y A r g u m e n t s
2779C-----------------------------------------------
2780C REAL
2781 INTEGER NDDL,NDDL0,NDOF(*),IDDL(*),IKC(*),INLOC(*),ITAB(*),
2782 . nir,iwar ,ierr, nddli ,itok(*)
2783 my_real
2784 . diag_k(*),diag_m(*),diag_i(*)
2785C-----------------------------------------------
2786C L o c a l V a r i a b l e s
2787C-----------------------------------------------
2788 INTEGER NLIM,NN,NKC,NFT,II,IDI,ND,ID,NID,NDMAX
2789 INTEGER I,J,K,N,IDDLM(NUMNOD)
2790 CHARACTER DIR(3)
2791 DATA DIR/'X','Y','Z'/
2792 my_real
2793 . S
2794 my_real,
2795 . DIMENSION(:,:),ALLOCATABLE :: SR
2796C------------------------------------------
2797 IF (ISPMD==0) then
2798 WRITE(iout,*)
2799 WRITE(iout,*)' ** ZERO STIFFNESS CHECKING **'
2800 WRITE(iout,*)
2801 WRITE(istdo,*)' * ZERO STIFFNESS CHECKING '
2802 ENDIF
2803 nid=0
2804 nir=0
2805 DO i=1,nddl
2806 diag_m(i) = diag_k(i)
2807 ENDDO
2808 DO i=1,nddli
2809 j=itok(i)
2810 diag_m(j)=diag_m(j)+diag_i(i)
2811 ENDDO
2812 IF (nspmd>1)CALL spmd_sumf_v(diag_m)
2813 DO i=1,nddl
2814 IF (diag_m(i)<em10) THEN
2815 IF (diag_m(i)<=em20) nir =nir +1
2816 nid = nid + 1
2817 ENDIF
2818 ENDDO
2819C
2820 IF (nspmd>1) THEN
2821 s = nid
2822 CALL spmd_sum_s(s)
2823 nn = int(s)
2824 IF (nn>0) THEN
2825 s = nir
2826 CALL spmd_sum_s(s)
2827 nir = int(s)
2828 ENDIF
2829 ELSE
2830 nn = nid
2831 ENDIF
2832C
2833 ierr = ierr + nir
2834 iwar = iwar + nn-nir
2835 IF (ispmd==0) WRITE(iout,1000)nn
2836 IF (nid>0) THEN
2837 nkc=0
2838 DO n = 1,numnod
2839 i=inloc(n)
2840 iddlm(i)=iddl(i)-nkc
2841 DO j=1,ndof(i)
2842 nd = iddl(i)+j
2843 IF (ikc(nd)>0) nkc=nkc+1
2844 ENDDO
2845 ENDDO
2846 ENDIF
2847 IF (nspmd>1) THEN
2848 ndmax = nid
2849 CALL spmd_max_i(ndmax)
2850 IF (nid>0) THEN
2851 ii = 0
2852 ALLOCATE(sr(3,nid))
2853 DO n = 1,numnod
2854 i=inloc(n)
2855 idi=iddlm(i)
2856 nkc = 0
2857 DO j=1,ndof(i)
2858 nd = iddl(i)+j
2859 IF (ikc(nd)==0) THEN
2860 nkc=nkc+1
2861 id = idi+nkc
2862 IF (diag_m(id)<em10) THEN
2863 ii = ii + 1
2864 sr(1,ii)=itab(i)
2865 sr(2,ii)=j
2866 sr(3,ii)=diag_m(id)
2867 ENDIF
2868 ENDIF
2869 ENDDO
2870 ENDDO
2871 CALL spmd_send_vr(
2872 1 nid ,3 ,sr ,ndmax ,iout )
2873 DEALLOCATE(sr)
2874 ENDIF
2875 ELSE
2876C
2877 IF (nid>0) THEN
2878 DO n = 1,numnod
2879 i=inloc(n)
2880 idi=iddlm(i)
2881 nkc = 0
2882 DO j=1,ndof(i)
2883 nd = iddl(i)+j
2884 IF (ikc(nd)==0) THEN
2885 nkc=nkc+1
2886 id = idi+nkc
2887 IF (diag_m(id)<em10) THEN
2888 IF (j<=3) THEN
2889 WRITE(iout,1001)itab(i),dir(j),diag_m(id)
2890 ELSE
2891 WRITE(iout,1002)itab(i),dir(j-3),diag_m(id)
2892 ENDIF
2893 ENDIF
2894 ENDIF
2895 ENDDO
2896 ENDDO
2897 ENDIF
2898 ENDIF
2899C------------------------------------------
2900 RETURN
2901 1000 FORMAT(' ND. =',i8,5x,'WITH POSSIBLE FREE STIFFNESS CHECKED',/)
2902 1001 FORMAT(' NODE NUM. =',i10,5x,'TRA_DIR = ',1a,5x,'VAL.= ',g14.7)
2903 1002 FORMAT(' NODE NUM. =',i10,5x,'ROT_DIR = ',1a,5x,'VAL.= ',g14.7)
2904 END
2905!||====================================================================
2906!|| imp_checm0 ../engine/source/implicit/imp_solv.F
2907!||--- called by ------------------------------------------------------
2908!|| imp_chkm ../engine/source/implicit/imp_solv.f
2909!||--- calls -----------------------------------------------------
2910!|| fr_dlft ../engine/source/mpi/implicit/imp_fri.F
2911!|| spmd_max_i ../engine/source/mpi/implicit/imp_spmd.F
2912!|| spmd_send_vr ../engine/source/mpi/implicit/imp_spmd.F
2913!|| spmd_sum_s ../engine/source/mpi/implicit/imp_spmd.F
2914!||====================================================================
2915 SUBROUTINE imp_checm0(ITAB ,NDDL ,IDDL ,DIAG_M ,NDOF ,
2916 . IKC ,INLOC ,NDDL0 ,IWAR ,IERR )
2917C-----------------------------------------------
2918C I m p l i c i t T y p e s
2919C-----------------------------------------------
2920#include "implicit_f.inc"
2921C-----------------------------------------------
2922C C o m m o n B l o c k s
2923C-----------------------------------------------
2924#include "com04_c.inc"
2925#include "units_c.inc"
2926#include "task_c.inc"
2927#include "com01_c.inc"
2928C-----------------------------------------------
2929C D u m m y A r g u m e n t s
2930C-----------------------------------------------
2931C REAL
2932 INTEGER NDDL,NDDL0,NDOF(*),IDDL(*),IKC(*),INLOC(*),ITAB(*),
2933 . iddiv,iwar,ierr
2934 my_real
2935 . diag_m(*)
2936C-----------------------------------------------
2937C L o c a l V a r i a b l e s
2938C-----------------------------------------------
2939 INTEGER NLIM,NID,NN,NKC,NFT,II,IDI,ND,ID,IW,IR,NDMAX
2940 INTEGER I,J,K,N,IDDLM(NUMNOD),IDLFT0,IDLFT1
2941 CHARACTER DIR(3)
2942 DATA DIR/'X','Y','Z'/
2943 my_real
2944 . S
2945 my_real,
2946 . DIMENSION(:,:),ALLOCATABLE :: SR
2947C------------------------------------------
2948 IF (ISPMD==0) THEN
2949 WRITE(IOUT,*)
2950 WRITE(IOUT,*)' ** POSITIVE DEFINITE MATRIX CHECKING **'
2951 WRITE(IOUT,*)
2952 WRITE(ISTDO,*)' * POSITIVE DEFINITE MATRIX CHECKING '
2953 ENDIF
2954 NID=0
2955 IDLFT0=0
2956 IR=0
2957 IF (NSPMD>1)
2958 . CALL FR_DLFT(NDDL,IDLFT0,IDLFT1)
2959 DO I=1+IDLFT0,NDDL
2960.OR. IF (DIAG_M(I)<EM12DIAG_M(I)>EP10) THEN
2961 IF (DIAG_M(I)<=EM20) IR =IR +1
2962 NID = NID+ 1
2963 ENDIF
2964 ENDDO
2965C
2966 IF (NSPMD>1) THEN
2967 S = NID
2968 CALL SPMD_SUM_S(S)
2969 NN = INT(S)
2970 IF (NN>0) THEN
2971 S = IR
2972 CALL SPMD_SUM_S(S)
2973 IR = INT(S)
2974 ENDIF
2975 ELSE
2976 NN = NID
2977 ENDIF
2978 IERR = IERR + IR
2979 IWAR = IWAR + NN-IR
2980 IF (ISPMD==0) WRITE(IOUT,1000)NN
2981 IF (NID>0) THEN
2982 NKC=0
2983 DO N = 1,NUMNOD
2984 I=INLOC(N)
2985 IDDLM(I)=IDDL(I)-NKC
2986 DO J=1,NDOF(I)
2987 ND = IDDL(I)+J
2988 IF (IKC(ND)>0) NKC=NKC+1
2989 ENDDO
2990 ENDDO
2991 ENDIF
2992C
2993 IF (NSPMD>1) THEN
2994 NDMAX = NID
2995 CALL SPMD_MAX_I(NDMAX)
2996 ALLOCATE(SR(3,NID))
2997 IF (NID>0) THEN
2998 II = 0
2999 DO N = 1,NUMNOD
3000 I=INLOC(N)
3001 IDI=IDDLM(I)
3002.AND. IF (NDOF(I)>0IDI>=IDLFT0) THEN
3003 NKC = 0
3004 DO J=1,NDOF(I)
3005 ND = IDDL(I)+J
3006 IF (IKC(ND)==0) THEN
3007 NKC=NKC+1
3008 ID = IDI+NKC
3009.OR. IF (DIAG_M(ID)<EM12DIAG_M(ID)>EP10) THEN
3010 II = II + 1
3011 SR(1,II)=ITAB(I)
3012 SR(2,II)=J
3013 SR(3,II)=DIAG_M(ID)
3014 ENDIF
3015 ENDIF
3016 ENDDO
3017 ENDIF
3018 ENDDO
3019 ENDIF
3020 CALL SPMD_SEND_VR(
3021 1 NID ,3 ,SR ,NDMAX ,IOUT )
3022 DEALLOCATE(SR)
3023 ELSE
3024C
3025 IF (NID>0) THEN
3026 DO N = 1,NUMNOD
3027 I=INLOC(N)
3028 IDI=IDDLM(I)
3029.AND. IF (NDOF(I)>0IDI>=IDLFT0) THEN
3030 NKC = 0
3031 DO J=1,NDOF(I)
3032 ND = IDDL(I)+J
3033 IF (IKC(ND)==0) THEN
3034 NKC=NKC+1
3035 ID = IDI+NKC
3036.OR. IF (DIAG_M(ID)<EM12DIAG_M(ID)>EP10) THEN
3037 IF (J<=3) THEN
3038 WRITE(IOUT,1001)ITAB(I),DIR(J),DIAG_M(ID)
3039 ELSE
3040 WRITE(IOUT,1002)ITAB(I),DIR(J-3),DIAG_M(ID)
3041 ENDIF
3042 ENDIF
3043 ENDIF
3044 ENDDO
3045 ENDIF
3046 ENDDO
3047 ENDIF
3048 ENDIF
3049C------------------------------------------
3050 RETURN
3051 1000 FORMAT(' ND. =',I8,5X,'with possible free connection checked',/)
3052 1001 FORMAT(' node num. =',I10,5X,'tra_dir = ',1A,5X,'val.= ',G14.7)
3053 1002 FORMAT(' node num. =',I10,5X,'rot_dir = ',1A,5X,'val.= ',G14.7)
3054 END
3055!||====================================================================
3056!|| imp_chkm ../engine/source/implicit/imp_solv.F
3057!||--- called by ------------------------------------------------------
3058!|| resol ../engine/source/engine/resol.F
3059!||--- calls -----------------------------------------------------
3060!|| cfield_imp ../engine/source/loads/general/load_centri/cfield_imp.F
3061!|| dim_int_k ../engine/source/implicit/ind_glob_k.F
3062!|| force_imp ../engine/source/loads/general/force_imp.F
3063!|| fv_imp ../engine/source/constraints/general/impvel/fv_imp0.F
3064!|| fv_imp1 ../engine/source/constraints/general/impvel/fv_imp0.F
3065!|| fv_rw ../engine/source/constraints/general/impvel/fv_imp0.F
3066!|| gravit_imp ../engine/source/loads/general/grav/gravit_imp.F
3067!|| idel_int ../engine/source/implicit/ind_glob_k.F
3068!|| imp_check0 ../engine/source/implicit/imp_solv.F
3069!|| imp_checm0 ../engine/source/implicit/imp_solv.F
3070!|| imp_compab ../engine/source/implicit/imp_solv.F
3071!|| imp_compabp ../engine/source/implicit/imp_solv.F
3072!|| imp_dynam ../engine/source/implicit/imp_dyna.F
3073!|| imp_fr7i ../engine/source/mpi/implicit/imp_fri.F
3074!|| imp_frfv ../engine/source/mpi/implicit/imp_fri.F
3075!|| imp_fri ../engine/source/mpi/implicit/imp_fri.F
3076!|| imp_glob_khp ../engine/source/implicit/imp_glob_k.F
3077!|| imp_int_k ../engine/source/implicit/imp_int_k.F
3078!|| imp_setb ../engine/source/implicit/imp_setb.F
3079!|| ind_int_k ../engine/source/implicit/ind_glob_k.F
3080!|| ini_k0h ../engine/source/implicit/imp_solv.F
3081!|| k_band ../engine/source/implicit/imp_solv.F
3082!|| lin_solv ../engine/source/implicit/lin_solv.F
3083!|| m_lnz ../engine/source/implicit/imp_solv.F
3084!|| my_barrier ../engine/source/system/machine.F
3085!|| pr_infok ../engine/source/implicit/imp_solv.F
3086!|| produt_w ../engine/source/implicit/produt_v.F
3087!|| pvp_k ../engine/source/implicit/imp_solv.F
3088!|| rgwal0_imp ../engine/source/constraints/general/rwall/rgwal0.F
3089!|| spmd_max_i ../engine/source/mpi/implicit/imp_spmd.F
3090!|| spmd_min_s ../engine/source/mpi/implicit/imp_spmd.F
3091!|| spmd_sumf_a ../engine/source/mpi/implicit/imp_spmd.F
3092!|| startime ../engine/source/system/timer_mod.F90
3093!|| stoptime ../engine/source/system/timer_mod.F90
3094!|| upd_fr_k ../engine/source/mpi/implicit/imp_fri.F
3095!|| upd_glob_k ../engine/source/implicit/upd_glob_k.F
3096!|| upd_rhs ../engine/source/implicit/upd_glob_k.F
3097!|| weightddl ../engine/source/implicit/recudis.F
3098!|| zero1 ../engine/source/system/zero.F
3099!|| zeror ../engine/source/system/zero.F
3100!||--- uses -----------------------------------------------------
3101!|| drape_mod ../engine/share/modules/drape_mod.F
3102!|| dsgraph_mod ../engine/share/modules/dsgraph_mod.F
3103!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
3104!|| element_mod ../common_source/modules/elements/element_mod.F90
3105!|| groupdef_mod ../common_source/modules/groupdef_mod.F
3106!|| h3d_mod ../engine/share/modules/h3d_mod.F
3107!|| imp_worki ../engine/share/modules/impbufdef_mod.F
3108!|| impbufdef_mod ../engine/share/modules/impbufdef_mod.F
3109!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
3110!|| python_funct_mod ../common_source/modules/python_mod.F90
3111!|| sensor_mod ../common_source/modules/sensor_mod.F90
3112!|| skew_mod ../common_source/modules/skew_mod.F90
3113!|| stack_mod ../engine/share/modules/stack_mod.F
3114!|| th_surf_mod ../common_source/modules/interfaces/th_surf_mod.F
3115!|| timer_mod ../engine/source/system/timer_mod.F90
3116!||====================================================================
3117 SUBROUTINE IMP_CHKM(TIMERS,PYTHON,
3118 1 ICODE ,ISKEW ,ISKWN ,IPART ,IXTG ,IXS ,IXQ ,
3119 2 IXC ,IXT ,IXP ,IXR ,IXTG1 ,ITAB ,ITABM1 ,
3120 3 NPC ,IBCL ,IBFV ,SENSOR_TAB,NNLINK ,LNLINK ,IPARG ,IGRV ,
3121 4 IPARI ,INTBUF_TAB,NPRW ,ICONX ,NPBY ,LPBY ,LRIVET ,
3122 5 NSTRF ,LJOINT ,ICODT ,ICODR ,ISKY ,ADSKY ,IADS_F ,
3123 6 ILINK ,LLINK ,WEIGHT ,ITASK ,IBVEL ,LBVEL ,FBVEL ,
3124 7 X ,D ,V ,VR ,DR ,THKE ,DAMP ,MS ,
3125 8 IN ,PM ,SKEWS ,GEO ,EANI ,BUFMAT ,BUFGEO ,BUFSF ,
3126 9 TF ,FORC ,VEL ,FSAV ,AGRV ,FR_WAVE,PARTS0 ,
3127 A ELBUF ,RBY ,RIVET ,FR_ELEM,IAD_ELEM,NSENSOR,
3128 B WA ,A ,AR ,STIFN ,STIFR ,PARTSAV,FSKY ,
3129 C FSKYI ,IFRAME ,XFRAME ,W16 ,IACTIV ,FSKYM ,IGEO ,IPM ,
3130 D WFEXT ,NODFT ,NODLT ,NINT7 ,NUM_IMP,NS_IMP ,NE_IMP ,IND_IMP,
3131 L IT ,RWBUF ,LPRW ,FR_WALL,NBINTC ,INTLIST,FOPT ,RWSAV ,
3132 M FSAVD ,DIRUL ,LGRAV ,IRBE3 ,LRBE3 ,FRBE3 ,
3133 N FRWL6 ,IRBE2 ,LRBE2 ,ICFIELD,LCFIELD,CFIELD,ELBUF_TAB,WEIGHT_MD,
3134 O STACK ,DIMFB ,FBSAV6 ,STABSEN,TABSENSOR,DRAPE_SH4N,DRAPE_SH3N,H3D_DATA,
3135 P NDDL0 ,NNZK0 ,IMPBUF_TAB,CPTREAC,FTHREAC,NODREAC,DRAPEG,TH_SURF ,
3136 Q DPL0CLD,VEL0CLD,SNPC,STF, WFEXT_MD,IGRSURF)
3137C-----------------------------------------------
3138C M o d u l e s
3139C-----------------------------------------------
3140 USE TIMER_MOD
3141 USE python_funct_mod, only: PYTHON_
3142 USE DSGRAPH_MOD
3143 USE IMP_WORKI
3144 USE ELBUFDEF_MOD
3145 USE INTBUFDEF_MOD
3146 USE STACK_MOD
3147 USE H3D_MOD
3148 USE IMPBUFDEF_MOD
3149 USE SENSOR_MOD
3150 USE DRAPE_MOD
3151 USE TH_SURF_MOD , ONLY : TH_SURF_
3152 USE SKEW_MOD , ONLY : SKEW_
3153 USE GROUPDEF_MOD
3154 use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg
3155C-----------------------------------------------
3156C I m p l i c i t T y p e s
3157C-----------------------------------------------
3158#include "implicit_f.inc"
3159C-----------------------------------------------
3160C C o m m o n B l o c k s
3161C-----------------------------------------------
3162#if defined(MUMPS5)
3163#include "dmumps_struc.h"
3164#endif
3165#include "timeri_c.inc"
3166#include "impl1_c.inc"
3167#include "impl2_c.inc"
3168#include "param_c.inc"
3169#include "com01_c.inc"
3170#include "com04_c.inc"
3171#include "units_c.inc"
3172#include "task_c.inc"
3173C-----------------------------------------------
3174C D u m m y A r g u m e n t s
3175C-----------------------------------------------
3176 TYPE(TIMER_), INTENT(INOUT) :: TIMERS
3177 TYPE(PYTHON_), INTENT(INOUT) :: PYTHON
3178 INTEGER ,INTENT(IN) :: SNPC !< size of NPC
3179 INTEGER ,INTENT(IN) :: STF !< size of TF / Tabulated function array
3180 INTEGER ,INTENT(IN) :: NSENSOR
3181 INTEGER ITASK,ICODE(*), ISKEW(*), ISKWN(LISKN,*),ITABM1(*),
3182 . IPART(*),IXS(*),IXQ(NIXQ,*),IXC(NIXC,*), IXT(NIXT,*),
3183 . IXP(NIXP,*),IXR(NIXR,*), IXTG(NIXTG,*), IXTG1(4,*),
3184 . ITAB(*),NPC(*), IBCL(*), IBFV(*),IPARG(NPARG,*),IPARI(NPARI,*),
3185 . NPRW(*), NPBY(NNPBY,*), LPBY(*),IADS_F(*),
3186 . LRIVET(*), NSTRF(*), LJOINT(*), ICODT(*), ICODR(*), ILINK(*),
3187 . LLINK(*),ISKY(*),ADSKY(*),
3188 . NNLINK(10,*),LNLINK(*),IGRV(*),LGRAV(*),
3189 . WEIGHT(*),IFRAME(LISKN,*),IBVEL(NBVELP,*),LBVEL(*),
3190 . IACTIV(*),IGEO(*),IPM(*),ICONX(*),NODFT ,NODLT,IT,
3191 . ICFIELD(*),LCFIELD(*),WEIGHT_MD(*),
3192 . DIMFB,STABSEN,TABSENSOR(*),CPTREAC,NODREAC(*)
3193 INTEGER LPRW(*), FR_WALL(NSPMD+2,*), FR_ELEM(*), IAD_ELEM(2,*),NBINTC ,INTLIST(*),DIRUL(*)
3194 my_real X(3,*) ,D(3,*) ,V(3,*) ,VR(3,*),DAMP(*),
3195 . MS(*) ,IN(*) ,PM(NPROPM,*),GEO(NPROPG,*),
3196 . BUFMAT(*) ,TF(*) ,FORC(*) ,VEL(*),FSAV(NTHVKI,*) ,ELBUF(*) ,
3197 . RWBUF(NRWLP,*),RWSAV(*),RBY(NRBY,*),
3198 . RIVET(*),WA(*), A(3,*) ,AR(3,*),PARTSAV(*) ,
3199 . STIFN(*) ,STIFR(*),FSKY(*),FSKYI(*),DR(3,*),
3200 . EANI(*),AGRV(*), THKE(*),FR_WAVE(*),PARTS0(*),BUFGEO(*),
3201 . XFRAME(NXFRAME,*),W16(*),FBVEL(*),FSKYM(*),BUFSF(*),
3202 . FOPT(6,*),FSAVD(NTHVKI,*),CFIELD(*),FRBE3(*),
3203 . FTHREAC(6,*)
3204 INTEGER NDDL0,NNZK0,NINT7
3205 INTEGER NUM_IMP(*),NS_IMP(*),NE_IMP(*),IND_IMP(*),IRBE3(*),LRBE3(*),IRBE2(*),LRBE2(*)
3206 TYPE (DRAPE_) :: DRAPE_SH4N(NUMELC_DRAPE), DRAPE_SH3N(NUMELTG_DRAPE)
3207 TYPE (DRAPEG_) :: DRAPEG
3208 my_real, INTENT(IN) :: DPL0CLD(6,NCONLD),VEL0CLD(6,NCONLD)
3209 DOUBLE PRECISION FRWL6(*)
3210 DOUBLE PRECISION FBSAV6(12,6,DIMFB)
3211 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
3212 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
3213 TYPE (STACK_PLY) :: STACK
3214 TYPE(H3D_DATABASE) :: H3D_DATA
3215 TYPE (IMPBUF_STRUCT_) ,TARGET :: IMPBUF_TAB
3216 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) :: SENSOR_TAB
3217 TYPE (TH_SURF_) , INTENT(INOUT) :: TH_SURF
3218 TYPE(SKEW_),INTENT(INOUT) :: SKEWS
3219 DOUBLE PRECISION,INTENT(INOUT) :: WFEXT, WFEXT_MD
3220 TYPE (GROUP_) , DIMENSION(NSURF) :: IGRSURF
3221C----------------------------------------------
3222C L o c a l V a r i a b l e s
3223C-----------------------------------------------
3224 INTEGER NNMAX,NKMAX,N_IMPN,N_IMPM,LNSS,LNSS2,NDT,NDS,NT_RW
3225 INTEGER I,J,NTMP,L1,L2,L3,NNDL,INPRINT,ISTOP,LI10,LI11,
3226 . LI1,LI2,LI3,LI4,LI5,LI6,LI7,LI8,LI9,LIF,IC,ISETP,
3227 . LI12,LNSS3,LI13,LI14,LI15,LNSB2,LNSRB2
3228 INTEGER, DIMENSION(:),ALLOCATABLE :: NSS,ISS,NSS2,ISS2,NSS3,ISS3
3229 INTEGER, DIMENSION(:),ALLOCATABLE :: NSB2,ISB2,IAINT2
3230 INTEGER NNOD,IFDIS,N1,N2,N3
3231 INTEGER LBAND,NCL_MAX,IRFLAG,IBID
3232 my_real TFEXC,TMP,TMP1,TMP2,R2,BFAC,FACI,R02,GAP,RBID,WE_IMP,LAMDA,DUMMY_FEXT(3,1)
3233 INTEGER, POINTER :: NDDL,NNZK,NRBYAC,NINT2,NMC,NMC2,NMONV
3234 INTEGER, DIMENSION(:) ,POINTER :: IADK,JDIK,IADM,JDIM
3235 INTEGER, DIMENSION(:) ,POINTER :: IDDL,NDOF,INLOC,LSIZE,I_IMP,IKC,
3236 . IRBYAC,NSC,IINT2,NKUD,IMONV,
3237 . IKINW,W_DDL,IKUD,NDOFI,IDDLI
3238 my_real, DIMENSION(:) ,POINTER :: DIAG_K,LT_K,DIAG_M,LT_M,LB,
3239 . LB0,BKUD,D_IMP,ELBUF_C,BUFMAT_C,
3240 . DR_IMP,X_C,DD,DDR,X_A,R_IMP
3241 my_real, DIMENSION(:) ,POINTER :: FEXT,DG,DGR,DG0,DGR0,BUFIN_C,AC,ACR
3242 TYPE(PRGRAPH) :: GRAPHE(1)
3243#ifdef MUMPS5
3244 TYPE(DMUMPS_STRUC) MUMPS_PAR
3245#else
3246 ! Fake declaration as DMUMPS_STRUC is shipped with MUMPS
3247 INTEGER MUMPS_PAR
3248#endif
3249
3250C------------------------------
3251C Initialisation
3252C-----------------------------------------------
3253 DUMMY_FEXT = ZERO
3254 NDDL => IMPBUF_TAB%NDDL
3255 NNZK => IMPBUF_TAB%NNZK
3256 NRBYAC => IMPBUF_TAB%NRBYAC
3257 NINT2 => IMPBUF_TAB%NINT2
3258 NMC => IMPBUF_TAB%NMC
3259 NMC2 => IMPBUF_TAB%NMC2
3260 NMONV => IMPBUF_TAB%NMONV
3261 IADK => IMPBUF_TAB%IADK
3262 JDIK => IMPBUF_TAB%JDIK
3263 IDDL => IMPBUF_TAB%IDDL
3264 NDOF => IMPBUF_TAB%NDOF
3265 INLOC => IMPBUF_TAB%INLOC
3266 LSIZE => IMPBUF_TAB%LSIZE
3267 I_IMP => IMPBUF_TAB%I_IMP
3268 IRBYAC => IMPBUF_TAB%IRBYAC
3269 NSC => IMPBUF_TAB%NSC
3270 IINT2 => IMPBUF_TAB%IINT2
3271 NKUD => IMPBUF_TAB%NKUD
3272 IMONV => IMPBUF_TAB%IMONV
3273 IKINW => IMPBUF_TAB%IKINW
3274 IKC => IMPBUF_TAB%IKC
3275 W_DDL => IMPBUF_TAB%W_DDL
3276 IKUD => IMPBUF_TAB%IKUD
3277 IADM => IMPBUF_TAB%IADM
3278 JDIM => IMPBUF_TAB%JDIM
3279 IDDLI => IMPBUF_TAB%IDDLI
3280 NDOFI => IMPBUF_TAB%NDOFI
3281 DIAG_K =>IMPBUF_TAB%DIAG_K
3282 LT_K =>IMPBUF_TAB%LT_K
3283 DIAG_M =>IMPBUF_TAB%DIAG_M
3284 LT_M =>IMPBUF_TAB%LT_M
3285 LB =>IMPBUF_TAB%LB
3286 LB0 =>IMPBUF_TAB%LB0
3287 BKUD =>IMPBUF_TAB%BKUD
3288 D_IMP =>IMPBUF_TAB%D_IMP
3289 ELBUF_C =>IMPBUF_TAB%ELBUF_C
3290 BUFMAT_C=>IMPBUF_TAB%BUFMAT_C
3291 X_C =>IMPBUF_TAB%X_C
3292 DD =>IMPBUF_TAB%DD
3293 DDR =>IMPBUF_TAB%DDR
3294 FEXT =>IMPBUF_TAB%FEXT
3295 DG =>IMPBUF_TAB%DG
3296 DGR =>IMPBUF_TAB%DGR
3297 DG0 =>IMPBUF_TAB%DG0
3298 DGR0 =>IMPBUF_TAB%DGR0
3299 DR_IMP=>IMPBUF_TAB%DR_IMP
3300 AC=>IMPBUF_TAB%AC
3301 ACR=>IMPBUF_TAB%ACR
3302 R_IMP => IMPBUF_TAB%R_IMP
3303 ALLOCATE(IAINT2(NINT2))
3304 NDDLI=0
3305 ISTOP=0
3306 INEGA=0
3307 NNDL = 3*NUMNOD
3308 NSREM=0
3309 NSL=0
3310 ISETP = 1
3311 IMP_IW = 0
3312 IMP_IR = 0
3313 RBID=ZERO
3314 IBID= 0
3315C
3316.AND..AND. IF (IRREF>0IMCONV==1ILINE/=1) THEN
3317 IRFLAG=IRREF
3318 ELSE
3319 IRFLAG=0
3320 ENDIF
3321C
3322 CALL ZEROR(D_IMP,NUMNOD)
3323 IF (IRODDL/=0) CALL ZEROR(DR_IMP,NUMNOD)
3324 CALL ZEROR(AC,NUMNOD)
3325 IF (IRODDL/=0) CALL ZEROR(ACR,NUMNOD)
3326C----------------------------------
3327C FORCES EXTERNES A=Fext-Fint
3328C----------------------------------
3329 NCL_MAX=0
3330 R_IMP(16)=ZERO
3331 IF(NCONLD/=0) THEN
3332 CALL FORCE_IMP(IBCL ,FORC ,SNPC ,NPC ,TF ,
3333 2 AC ,V ,X ,SKEWS ,
3334 3 ACR ,VR ,NSENSOR ,SENSOR_TAB ,TFEXC ,
3335 4 IADS_F ,FSKY ,DUMMY_FEXT ,H3D_DATA ,CPTREAC ,
3336 5 FTHREAC ,NODREAC ,TH_SURF ,
3337 6 DPL0CLD ,VEL0CLD ,D ,DR ,NCONLD ,
3338 7 NUMNOD ,NFUNCT ,STF ,WFEXT)
3339 IF (NSPMD>1) THEN
3340 DO I=IAD_ELEM(1,1),IAD_ELEM(1,NSPMD+1)-1
3341 J = FR_ELEM(I)
3342 N1 = 3*(J-1)+1
3343 N2 = 3*(J-1)+2
3344 N3 = 3*(J-1)+3
3345 TMP = ABS(AC(N1))+ABS(AC(N2))+ABS(AC(N3))
3346 IF (IRODDL/=0) TMP = TMP + ABS(ACR(N1))+ABS(ACR(N2))+ABS(ACR(N3))
3347 IF (TMP>ZERO) NCL_MAX = NCL_MAX + 1
3348 ENDDO
3349 ENDIF
3350 ENDIF
3351 IF (NSPMD>1) THEN
3352 CALL SPMD_MAX_I(NCL_MAX)
3353 IF (NCL_MAX>0) THEN
3354 LBAND = IAD_ELEM(1,NSPMD+1)-IAD_ELEM(1,1)
3355 IF (IRODDL/=0) THEN
3356 NTMP = 6
3357 ELSE
3358 NTMP = 3
3359 ENDIF
3360 CALL SPMD_SUMF_A(AC,ACR,IAD_ELEM,FR_ELEM,NTMP,LBAND)
3361 ENDIF
3362 ENDIF
3363 IF(NGRAV/=0) THEN
3364 CALL GRAVIT_IMP(IGRV ,AGRV ,NPC ,TF ,AC,
3365 2 V ,X ,SKEWS%SKEW ,MS,TFEXC,
3366 3 NSENSOR,SENSOR_TAB ,WEIGHT,
3367 4 LGRAV ,ITASK ,
3368 5 NRBYAC ,IRBYAC ,NPBY ,RBY , PYTHON)
3369 ENDIF
3370 IF(NLOADC/=0) THEN
3371 CALL CFIELD_IMP(ICFIELD ,CFIELD,NPC ,TF ,AC,
3372 2 V ,X ,XFRAME ,MS,TFEXC,
3373 3 NSENSOR,SENSOR_TAB,WEIGHT,IFRAME,
3374 4 LCFIELD ,ITASK,
3375 5 NRBYAC,IRBYAC,NPBY ,RBY,ISKWN, PYTHON )
3376 ENDIF
3377C-------------dU_d---------------------------------
3378.AND. IF(NFXVEL/=0IMCONV==1) THEN
3379 CALL FV_IMP(IBFV ,NPC ,TF ,VEL ,SENSOR_TAB,
3380 1 D_IMP ,DR_IMP ,IKC ,IDDL ,NSENSOR ,
3381 2 SKEWS%SKEW ,IFRAME ,XFRAME ,V ,VR ,
3382 3 X ,DIRUL ,NDOF ,A ,VR )
3383 ENDIF
3384C-------------U_d--> rigid wall-------------------------------
3385 NT_RW=0
3386 IF (NRWALL > 0) THEN
3387 CALL RGWAL0_IMP(
3388 1 X ,D_IMP ,V ,RWBUF , LPRW ,
3389 2 NPRW ,MS ,FSAV(1 ,NINTER+1) , FR_WALL ,
3390 3 FOPT ,RWSAV ,WEIGHT ,FSAVD(1,NINTER+1),
3391 4 NT_RW ,IDDL ,IKC ,IMCONV , NDOF , FRWL6,
3392 5 WEIGHT_MD ,DIMFB ,FBSAV6 ,STABSEN , TABSENSOR, WFEXT, WFEXT_MD)
3393 IF(NT_RW > 0) THEN
3394 CALL FV_RW(IDDL ,IKC ,NDOF ,D_IMP ,V )
3395 ENDIF
3396 ENDIF
3397 IFDIS=NT_RW+NFXVEL
3398.AND. IF(IFDIS>0IMCONV==1) THEN
3399 IF(NT_RW>0) THEN
3400 DO I=1,NDDL0
3401 IF (IKC(I)==3) IKC(I)=4
3402 IF (IKC(I)==10) IKC(I)=11
3403 ENDDO
3404 ENDIF
3405 ENDIF
3406 NTMP = NT_RW
3407 IF (NSPMD>1) CALL SPMD_MAX_I(NTMP)
3408 IF(NTMP>0) THEN
3409 IF(ISPMD==0) THEN
3410 WRITE(IOUT,*)' *--------- rigid wall impact---------*'
3411 ENDIF
3412 ENDIF
3413C----------------------------------
3414 CALL IMP_SETB(AC ,ACR ,IDDL ,NDOF ,LB )
3415C----------------------------------
3416C CHECKING
3417C----------------------------------
3418 IF (ISPMD==0) THEN
3419 WRITE(ISTDO,*)
3420 WRITE(ISTDO,*)' ** begin IMPLICIT model checking **'
3421 WRITE(IOUT,*)
3422 WRITE(IOUT,*)' ** begin IMPLICIT model checking **'
3423 WRITE(IOUT,*)
3424 ENDIF
3425 IF (NSPMD>1) THEN
3426 CALL IMP_COMPABP(
3427 1 ICODT ,ICODR ,ISKEW ,IBFV ,NPC ,
3428 2 TF ,VEL ,NSENSOR ,SENSOR_TAB,XFRAME ,
3429 3 RBY ,X ,SKEWS%SKEW,LPBY ,NPBY ,
3430 4 ITAB ,NRBYAC ,IRBYAC ,NINT2 ,IINT2 ,
3431 5 IPARI ,INTBUF_TAB,NT_RW ,NDDL ,
3432 6 NDOF ,IKC ,INLOC ,IDDL ,NDDL0 ,
3433 7 IMP_IW ,IMP_IR )
3434 ELSE
3435 CALL IMP_COMPAB(
3436 1 ICODT ,ICODR ,ISKEW ,IBFV ,NPC ,
3437 2 TF ,VEL ,NSENSOR ,SENSOR_TAB,XFRAME ,
3438 3 RBY ,X ,SKEWS%SKEW ,LPBY ,NPBY ,
3439 4 ITAB ,NRBYAC ,IRBYAC ,NINT2 ,IINT2 ,
3440 5 IPARI ,INTBUF_TAB,NT_RW ,NDDL ,
3441 6 NDOF ,IKC ,INLOC ,IDDL ,NDDL0 ,
3442 7 IMP_IW ,IMP_IR )
3443 ENDIF
3444
3445
3446C----------------------------------
3447C STIFFNESS MATRIX
3448C----------------------------------
3449 IF (ISETK==1) THEN
3450 IF (ISPMD==0) THEN
3451 WRITE(ISTDO,*)' * finit element checking '
3452 WRITE(IOUT,*)' ** finit element checking **'
3453 WRITE(IOUT,*)
3454 ENDIF
3455.AND. IF (IMON>0 ITASK ==0) CALL STARTIME(TIMERS,31)
3456 NDDL = NDDL0
3457 NNZK = NNZK0
3458 NNMAX=LSIZE(9)
3459 NKMAX=LSIZE(10)
3460 NMC2=LSIZE(11)
3461
3462 CALL ZERO1(DIAG_K,NDDL)
3463 CALL ZERO1(LT_K,NNZK)
3464
3465 L1 = 1+NIXS*NUMELS
3466 L2 = L1+6*NUMELS10
3467 L3 = L2+12*NUMELS20
3468 LI1 =1
3469 LI2 = LI1+LSIZE(4)
3470 LI3 = LI2+LSIZE(5)
3471 LI4 = LI3+LSIZE(1)
3472 LI5 = LI4+LSIZE(3)
3473 LI6 = LI5+LSIZE(7)
3474 LI7 = LI6+LSIZE(2)
3475 LI8 = LI7+LSIZE(6)
3476 LI9 = LI8+NINT2
3477 LI10 = LI9+LSIZE(8)
3478 LI11 = LI10+(LSIZE(8)-LCOKM)*LSIZE(9)
3479 LI12 = LI11+LCOKM*LSIZE(10)
3480 LI13 = LI12+4*LSIZE(11)
3481 LI14 = LI13+LSIZE(14)
3482 LI15 = LI14+LSIZE(15)
3483 LIF = LI15+LSIZE(16)
3484C /---------------/
3485c CALL MY_BARRIER
3486C /---------------/
3487 CALL IMP_GLOB_KHP(
3488 1 PM ,GEO ,IPM ,IGEO ,ELBUF ,
3489 2 IXS ,IXQ ,IXC ,IXT ,IXP ,
3490 3 IXR ,IXTG ,IXTG1 ,IXS(L1) ,
3491 4 IXS(L2) ,IXS(L3) ,IPARG ,TF ,NPC ,
3492 5 FR_WAVE ,W16 ,BUFMAT ,THKE ,BUFGEO ,
3493 6 RBY ,SKEWS%SKEW ,X ,
3494 7 WA ,IDDL ,NDOF ,DIAG_K ,LT_K ,
3495 8 IADK ,JDIK ,IKG ,IBID ,ITASK ,
3496 9 ELBUF_TAB ,STACK ,DRAPE_SH4N, DRAPE_SH3N ,DRAPEG )
3497 NDDL_L = NDDL
3498C /---------------/
3499c CALL MY_BARRIER
3500C /---------------/
3501
3502C------ 1er VP: for dt check
3503.AND. IF (IMPDEB>0NDDL<1000) THEN
3504 CALL PVP_K(NDDL,IADK,JDIK,IDDL ,INLOC,NDOF,ITAB,DIAG_K,LT_K ,LAMDA, J , MS )
3505 tmp = TWO*sqrt(ONE/LAMDA)
3506 write(iout,*) 'critical dt =',tmp
3507 END IF
3508.OR. IF (IDYNA>0IQSTAT>0)
3509 . CALL IMP_DYNAM(NODFT ,NODLT ,IDDL ,NDOF ,DIAG_K ,
3510 . MS ,IN ,HHT_A ,WEIGHT ,IADK ,
3511 . LT_K )
3512 CALL UPD_GLOB_K(
3513 1 ICODT ,ICODR ,ISKEW ,IBFV ,NPC ,
3514 2 TF ,VEL ,XFRAME ,
3515 3 RBY ,X ,SKEWS%SKEW ,LPBY ,NPBY ,
3516 4 ITAB ,WEIGHT ,MS ,IN ,NRBYAC ,
3517 5 IRBYAC ,NSC ,IKINW(LI1) ,NMC ,IKINW(LI2),
3518 6 IKINW(LI3),IKINW(LI4),NINT2 ,IINT2 ,IKINW(LI8),
3519 7 IKINW(LI5),IKINW(LI6),IKINW(LI7) ,IPARI ,INTBUF_TAB,
3520 8 NDDL ,NNZK ,IADK ,JDIK ,
3521 9 DIAG_K ,LT_K ,NDOF ,IDDL ,IKC ,
3522 A D_IMP ,LB ,NKUD ,IKUD ,BKUD ,
3523 B NMC2 ,IKINW(LI12),NT_RW ,DR_IMP ,DIRUL ,
3524 C IRBE3 ,LRBE3 ,FRBE3 ,IKINW(LI13),IRBE2 ,
3525 D LRBE2 ,IKINW(LI14),IKINW(LI15))
3526
3527 IF (NSPMD>1) THEN
3528 CALL UPD_FR_K(
3529 1 IADK ,JDIK ,NDOF ,IKC ,IDDL ,
3530 2 INLOC ,FR_ELEM ,IAD_ELEM ,NDDL )
3531
3532 CALL WEIGHTDDL(IDDL ,NDOF ,IKC ,WEIGHT ,W_DDL ,INLOC )
3533 ENDIF
3534 CALL PR_INFOK(NDDL0,NNZK0,NDDL,NNZK,MAX(NNMAX,NKMAX))
3535.AND. IF (IPREC>4NKMAX>200) THEN
3536 CALL K_BAND(NDDL,IADK,JDIK,IBID)
3537 MAXB = MIN(MAXB,IBID)
3538 IF (MAXB>10000) THEN
3539 CALL M_LNZ(NDDL,IADK,JDIK,MAXB,MAX_L)
3540 ENDIF
3541 ENDIF
3542
3543 CALL INI_K0H(NDDL,NNZK,NNZK,IADK,JDIK)
3544 IF (IMON>0) CALL STOPTIME(TIMERS,31)
3545 ENDIF
3546
3547C----------------------------------
3548C MATRICE DE RIGIDITE D'INTERFACE
3549C----------------------------------
3550 GAP=EP20
3551 IF (NINT7>0) THEN
3552 L1=LSIZE(1)
3553 L2=LSIZE(2)
3554 LNSS2=0
3555 LNSS=0
3556 IF (IMON>0) CALL STARTIME(TIMERS,31)
3557 IF (IMP_INT==1) CALL IDEL_INT(
3558 1 IPARI ,INTBUF_TAB,NUM_IMP ,NS_IMP ,NE_IMP ,
3559 2 IND_IMP ,NDOF ,NINT7 )
3560 CALL DIM_INT_K(
3561 1 IPARI ,INTBUF_TAB,NUM_IMP ,NS_IMP ,NE_IMP ,
3562 2 NPBY ,LPBY ,ITAB ,NRBYAC ,IRBYAC ,
3563 3 LNSS ,NINT2 ,IINT2 ,IAINT2 ,LNSS2 ,
3564 4 NDDLI ,NNZI ,IDDLI ,NDOFI ,N_IMPN ,
3565 5 N_IMPM ,NNMAX ,NKMAX ,NDOF ,NSREM ,
3566 6 IRBE3 ,LRBE3 ,LNSS3 ,IRBE2 ,LRBE2 ,
3567 7 LNSB2 ,LNSRB2 ,IND_IMP )
3568 ALLOCATE(IADI(NDDLI+1))
3569 ALLOCATE(ITOK(NDDLI))
3570 ALLOCATE(JDII(NNZI))
3571 ALLOCATE(NSS2(L2),NSS3(NRBE3),NSB2(LNSRB2))
3572 NSB2=0
3573 ALLOCATE(ISS2(LNSS2),ISS3(LNSS3),ISB2(LNSB2))
3574 ALLOCATE(NSS(L1))
3575 ALLOCATE(ISS(LNSS))
3576 DO I=1,L1
3577 NSS(I)=0
3578 ENDDO
3579 CALL IND_INT_K(
3580 1 IPARI ,INTBUF_TAB,NUM_IMP ,NS_IMP ,NE_IMP ,
3581 2 NPBY ,LPBY ,ITAB ,NRBYAC ,IRBYAC ,
3582 3 NSS ,ISS ,NINT2 ,IINT2 ,NSS2 ,
3583 4 ISS2 ,NDDLI ,NNZI ,IADI ,JDII ,
3584 5 IDDLI ,NDOFI ,N_IMPN ,ITOK ,IDDL ,
3585 6 NNMAX ,NKMAX ,N_IMPM ,NDOF ,IAINT2 ,
3586 7 IRBE3 ,LRBE3 ,NSS3 ,ISS3 ,IRBE2 ,
3587 8 LRBE2 ,NSB2 ,ISB2 ,IND_IMP )
3588 ALLOCATE(DIAG_I(NDDLI))
3589 ALLOCATE(LT_I(NNZI))
3590 CALL ZERO1(DIAG_I,NDDLI)
3591 CALL ZERO1(LT_I,NNZI)
3592 IF (NSREM>0)
3593 1 CALL IMP_FR7I(IPARI ,INTBUF_TAB ,NUM_IMP ,NS_IMP ,NSREM ,
3594 2 NBINTC,INTLIST)
3595 !-------A is not updated here -------------------
3596 CALL IMP_INT_K(A ,V ,
3597 1 ICODT ,ICODR ,ISKEW ,IBFV ,NPC ,
3598 2 TF ,VEL ,NSENSOR ,SENSOR_TAB,XFRAME ,
3599 3 RBY ,X ,SKEWS%SKEW ,LPBY ,NPBY ,
3600 4 ITAB ,WEIGHT ,MS ,IN ,NRBYAC ,
3601 5 IRBYAC ,NSS ,ISS ,IPARI ,INTBUF_TAB,
3602 6 NINT2 ,IINT2 ,IAINT2 ,NSS2 ,
3603 7 ISS2 ,NDDLI ,NNZI ,IADI ,JDII ,
3604 8 DIAG_I ,LT_I ,IDDLI ,NDDL0 ,IADK ,
3605 9 JDIK ,IKC ,DIAG_K ,LT_K ,IDDL ,
3606 A NUM_IMP ,NS_IMP ,NE_IMP ,IND_IMP ,NDOFI ,
3607 B ITOK ,D_IMP ,LB ,GAP ,DIRUL ,
3608 C NT_RW ,IBID ,IRBE3 ,LRBE3 ,FRBE3 ,
3609 D NSS3 ,ISS3 ,IRBE2 ,LRBE2 ,NSB2 ,
3610 E ISB2 )
3611C
3612 DEALLOCATE(NSS2,NSS3,NSB2)
3613 DEALLOCATE(ISS2,ISS3,ISB2)
3614 DEALLOCATE(NSS)
3615 DEALLOCATE(ISS)
3616.AND..AND..OR. IF (NSPMD==1IMCONV>=0(LPRINT/=0NPRINT/=0)) THEN
3617 WRITE(IOUT,1006)
3618 WRITE(IOUT,1007)NDDLI,NNZI,NNMAX
3619 WRITE(IOUT,*)
3620 ENDIF
3621 IF (IMON>0) CALL STOPTIME(TIMERS,31)
3622 ENDIF
3623C----------------------------------
3624.AND. IF (NFXVEL/=0IMCONV==1) THEN
3625 CALL FV_IMP1(NKUD ,IKUD ,BKUD ,LB )
3626 ENDIF
3627C-------------LB,A,AR becomes Fext-Fint---------------------
3628 CALL UPD_RHS(ICODT ,ICODR ,ISKEW ,IBFV ,XFRAME ,
3629 1 RBY ,X ,SKEWS%SKEW ,LPBY ,NPBY ,
3630 2 NRBYAC,IRBYAC,NINT2 ,IINT2 ,IPARI ,
3631 3 INTBUF_TAB ,NDOF ,IDDL ,IKC ,
3632 4 NDDL0 ,LB ,ISETK ,INLOC ,DIRUL ,
3633 5 A ,AR ,AC ,ACR ,NT_RW ,
3634 6 IRFLAG,W_DDL ,NDDL ,R_IMP(1),IDYNA ,
3635 7 V ,VR ,MS ,IN ,IRBE3 ,
3636 8 LRBE3 ,FRBE3 ,WEIGHT ,IRBE2 ,LRBE2 )
3637
3638 IF (NSPMD>1) THEN
3639 IF (NBINTC>0.) THEN
3640 ICONTA = NDDLI + NSREM
3641 CALL SPMD_MAX_I(ICONTA)
3642 IF (ICONTA> 0) THEN
3643 CALL IMP_FRI(
3644 1 NUM_IMP ,NS_IMP ,NE_IMP ,IPARI ,INTBUF_TAB,
3645 2 NPBY ,LPBY ,ITAB ,NRBYAC ,
3646 3 IRBYAC ,NINT2 ,IINT2 ,IDDL ,IKC ,
3647 4 NDOF ,INLOC ,NSREM ,NSL ,NBINTC ,
3648 5 INTLIST ,X ,IBFV ,DIRUL ,SKEWS%SKEW,
3649 6 XFRAME ,ISKEW ,ICODT ,A ,D_IMP ,
3650 7 LB ,IFDIS ,NDDL ,DR_IMP ,IDDLI ,
3651 8 IRBE3 ,LRBE3 ,FRBE3 ,IRBE2 ,LRBE2 )
3652 CALL SPMD_MIN_S(GAP)
3653 CALL SPMD_MAX_I(IFDIS)
3654.AND. IF ((NSREM+NSL)>0IFDIS>0)
3655 . CALL IMP_FRFV(
3656 1 NUM_IMP ,NS_IMP ,NE_IMP ,IPARI ,INTBUF_TAB,
3657 2 IDDL ,IKC ,NDOF ,NSREM ,
3658 3 NSL ,D_IMP ,DD ,DR_IMP ,DDR ,
3659 4 A ,AR ,MS ,V ,X ,
3660 5 LB ,NDDL ,IBFV ,SKEWS%SKEW,XFRAME ,
3661 6 IRBE3 ,LRBE3 ,IRBE2 ,LRBE2 ,R_IMP(16) ,
3662 7 NDDL0 ,W_DDL )
3663 ENDIF
3664 ENDIF
3665 ENDIF
3666 IF (GAP<ZERO) THEN
3667 IMCONV = -2
3668 IF (ISPMD==0) THEN
3669 WRITE(IOUT,1009)INT(-GAP)
3670 WRITE(ISTDO,1009)INT(-GAP)
3671 ENDIF
3672 ENDIF
3673C----------------------------------
3674C IMPLICIT [K] CHECK
3675C----------------------------------
3676 CALL IMP_CHECK0(ITAB ,NDDL ,IDDL ,DIAG_K ,DIAG_M ,
3677 . NDOF ,IKC ,INLOC ,NDDL0 ,INEGA ,
3678 . NDDLI ,ITOK ,DIAG_I,IMP_IW ,IMP_IR )
3679 IF (INEGA>0) GOTO 100
3680 NTMP=0
3681 CALL PRODUT_W(NDDL,LB,LB,W_DDL,R2)
3682.AND. IF (R2>ZEROR2<EP30) THEN
3683 ELSEIF(IQSTAT>0) THEN
3684 WRITE(IOUT,*)
3685 WRITE(IOUT,*)' ** warning :IMPLICIT loading DATA **'
3686 IMP_IW = IMP_IW + 1
3687 ELSE
3688 WRITE(IOUT,*)
3689 WRITE(IOUT,*)' ** error :IMPLICIT loading DATA **'
3690 IMP_IR = IMP_IR + 1
3691 ENDIF
3692
3693C
3694C /---------------/
3695c CALL MY_BARRIER
3696C /---------------/
3697 CALL LIN_SOLV(NDDL ,IDDL ,NDOF ,IKC ,D_IMP ,
3698 1 DR_IMP,L_TOL ,NNZK ,IADK ,JDIK ,
3699 2 DIAG_K,LT_K ,NDDLI ,IADI ,JDII ,
3700 3 DIAG_I,LT_I ,ITOK ,IADM ,JDIM ,
3701 4 DIAG_M,LT_M ,LB ,R_IMP(6),INLOC ,
3702 5 FR_ELEM,IAD_ELEM,W_DDL,ITASK ,ISETP ,
3703 6 ISTOP ,A ,AR ,V ,
3704 7 MS ,X ,IPARI ,INTBUF_TAB ,
3705 8 NUM_IMP,NS_IMP,NE_IMP,NSREM ,NSL ,
3706 9 NTMP ,GRAPHE, ITAB ,RBID ,IBID ,
3707 A IBID ,NTMP ,IBID ,IBID ,IGRSURF ,
3708 B IBID ,RBID ,IBFV ,SKEWS%SKEW ,
3709 C XFRAME,MUMPS_PAR,IBID,IBID ,RBID ,
3710 D IRBE3 ,LRBE3 ,IRBE2 ,LRBE2 )
3711 CALL IMP_CHECM0(ITAB ,NDDL ,IDDL ,DIAG_M ,NDOF ,IKC ,INLOC ,NDDL0 ,IMP_IW ,IMP_IR)
3712 IF (NINT7>0) THEN
3713 DEALLOCATE(IADI)
3714 DEALLOCATE(ITOK)
3715 DEALLOCATE(JDII)
3716 DEALLOCATE(DIAG_I)
3717 DEALLOCATE(LT_I)
3718 ENDIF
3719
3720 100 CONTINUE
3721C /---------------/
3722 CALL MY_BARRIER
3723C /---------------/
3724.AND. IF (ISPMD == 0 ITASK == 0) THEN
3725 WRITE(ISTDO,1011)IMP_IR,IMP_IW
3726 ENDIF
3727
3728 1001 FORMAT(' symbolic dim : nddl =',I8,1X,'nnz =',I8,1X,'nb_max =',I8)
3729 1002 FORMAT(' final dim : nddl =',I8,1X,'nnz =',I8,1X,'nb_max =',I8)
3730 1006 FORMAT(5X,'--supplementary stiffness matrix',1X, 'due to INTERFACE is created --')
3731 1007 FORMAT(5X,' with dim. : nd =',I8,1X,'nz =',I8,1X,'nb_max =',I8)
3732 1009 FORMAT(3X,'**timestep will be reduced to avoid de-activation ','in INTERFACE :**',I8)
3733 1011 FORMAT(/,2X,'** end IMPLICIT model checking **'/,
3734 . 5X,'termination with '/,I8,' errors '/,I8,' warnings'/
3735 . 5X,'** details reported in listing file **'/)
3736 RETURN
3737 END
3738!||====================================================================
3739!|| imp_compab ../engine/source/implicit/imp_solv.F
3740!||--- called by ------------------------------------------------------
3741!|| imp_chkm ../engine/source/implicit/imp_solv.F
3742!||--- uses -----------------------------------------------------
3743!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
3744!|| sensor_mod ../common_source/modules/sensor_mod.F90
3745!||====================================================================
3746 SUBROUTINE IMP_COMPAB(
3747 1 ICODT ,ICODR ,ISKEW ,IBFV ,NPC ,
3748 2 TF ,VEL ,NSENSOR ,SENSOR_TAB,XFRAME ,
3749 3 RBY ,X ,SKEW ,LPBY ,NPBY ,
3750 4 ITAB ,NRBYAC ,IRBYAC ,NINT2 ,IINT2 ,
3751 5 IPARI ,INTBUF_TAB,NT_RW ,NDDL ,
3752 6 NDOF ,IKC ,INLOC ,IDDL ,NDDL0 ,
3753 7 IWAR ,IERR )
3754C-----------------------------------------------
3755C M o d u l e s
3756C-----------------------------------------------
3757 USE INTBUFDEF_MOD
3758 USE SENSOR_MOD
3759C-----------------------------------------------
3760C I m p l i c i t T y p e s
3761C-----------------------------------------------
3762#include "implicit_f.inc"
3763C-----------------------------------------------
3764C C o m m o n B l o c k s
3765C-----------------------------------------------
3766#include "tabsiz_c.inc"
3767#include "com01_c.inc"
3768#include "com04_c.inc"
3769#include "com08_c.inc"
3770#include "param_c.inc"
3771#if defined(MUMPS5)
3772#include "dmumps_struc.h"
3773#endif
3774#include "sphcom.inc"
3775#include "units_c.inc"
3776C-----------------------------------------------
3777C D u m m y A r g u m e n t s
3778C-----------------------------------------------
3779 INTEGER ,INTENT(IN) :: NSENSOR
3780 INTEGER NPC(*),IBFV(NIFV,*),
3781 . ICODT(*),ICODR(*),ISKEW(*),NINT2 ,IINT2(*),NT_RW
3782 INTEGER LPBY(*),NPBY(NNPBY,*),ITAB(*),IPARI(NPARI,*),
3783 . NRBYAC,IRBYAC(*),NDDL,NDOF(*),
3784 . IDDL(*),IKC(*),INLOC(*) ,NDDL0,IERR,IWAR
3785 my_real RBY(NRBY,*) ,X(3,*) ,SKEW(*)
3786 my_real TF(*),VEL(LFXVELR,*),XFRAME(NXFRAME,*)
3787 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
3788 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) :: SENSOR_TAB
3789#if defined(MUMPS5)
3790C-----------------------------------------------
3791C L o c a l V a r i a b l e s
3792C-----------------------------------------------
3793 INTEGER NSN,I,J,K,N,M,JI,NS,NN,IRW,ID
3794 INTEGER NKINE,IKIN(NUMNOD),IOF(NUMNOD)
3795 INTEGER ISENS,II,IDEB,IT,ICOMP,NTY,IR,IW
3796 my_real STARTT, STOPT, TS,SS
3797 CHARACTER*25 MSG_TYPE(2)
3798 CHARACTER*25 CSP
3799 DATA MSG_TYPE/ '** warning **', '!! ERROR !!'/
3800C--------implicit imcompability--
3801 icomp = 0
3802 it = 1
3803 WRITE(iout,*)
3804 WRITE(iout,*)' ** INCOMBABILITY CHECKING **'
3805 WRITE(iout,*)
3806 WRITE(istdo,*)
3807 WRITE(istdo,*)' * INCOMBABILITY CHECKING '
3808C-----------
3809 IF (nlaser>0) THEN
3810 icomp = icomp + nlaser
3811 iwar = iwar +1
3812 WRITE(iout,1100)msg_type(it),'IMPACT LASER'
3813 ENDIF
3814 DO n =1,ninter
3815 nty =ipari(7,n)
3816 IF (nty==2.OR.nty==7.OR.nty==10.OR.nty==11
3817 . .OR.nty==5.OR.nty==24) THEN
3818 IF(nty==7.AND.ipari(33,n)/=0)THEN
3819 icomp = icomp + ipari(33,n)
3820 iwar = iwar +1
3821 WRITE(iout,1100)msg_type(it),'LAGRANGE MULTIPLIER INTERFACE'
3822 ENDIF
3823 ELSEIF (nty>0) THEN
3824 iwar = iwar +1
3825 icomp = icomp + 1
3826 WRITE(csp,'(A,I2.2)')'INTERFACE TYPE ',nty
3827 WRITE(iout,1100)msg_type(it),csp
3828 ENDIF
3829 ENDDO
3830 IF (nrivet>0) THEN
3831 icomp = icomp + nrivet
3832 iwar = iwar +1
3833 WRITE(iout,1100)msg_type(it),'RIVET'
3834 ENDIF
3835 IF (ngjoint>0) THEN
3836 icomp = icomp + ngjoint
3837 iwar = iwar +1
3838 WRITE(iout,1100)msg_type(it),'JOINT TYPE SPRINGS'
3839 ENDIF
3840 IF (njoint>0) THEN
3841 icomp = icomp + njoint
3842 iwar = iwar +1
3843 WRITE(iout,1100)msg_type(it),'CYLINDRIC JOINT'
3844 ENDIF
3845 IF (nummpc>0) THEN
3846 icomp = icomp + nummpc
3847 iwar = iwar +1
3848 WRITE(iout,1100)msg_type(it),'MULTI-POINT CONSTRAINTS'
3849 ENDIF
3850 IF (nlink>0) THEN
3851 icomp = icomp + nlink
3852 iwar = iwar +1
3853 WRITE(iout,1100)msg_type(it),'RIGID LINK'
3854 ENDIF
3855 IF (numelx>0) THEN
3856 icomp = icomp + numelx
3857 iwar = iwar +1
3858 WRITE(iout,1100)msg_type(it),'MULTI-PURPOSE ELEMENTS'
3859 ENDIF
3860 IF (numels16>0) THEN
3861 icomp = icomp + numels16
3862 iwar = iwar +1
3863 WRITE(iout,1100)msg_type(it),'SOLID 16n. ELEMENTS'
3864 ENDIF
3865 IF (numels20>0) THEN
3866 icomp = icomp + numels20
3867 iwar = iwar +1
3868 WRITE(iout,1100)msg_type(it),'SOLID 20n. ELEMENTS'
3869 ENDIF
3870 IF (numeltg6>0) THEN
3871 icomp = icomp + numeltg6
3872 iwar = iwar +1
3873 WRITE(iout,1100)msg_type(it),'SHELL S3N6 ELEMENTS'
3874 ENDIF
3875 IF (numsph>0) THEN
3876 icomp = icomp + numsph
3877 iwar = iwar +1
3878 WRITE(iout,1100)msg_type(it),'SPH ELEMENTS'
3879 ENDIF
3880C
3881 IF (icomp>0) WRITE(iout,1101) icomp
3882C--------IKIN: 1 MAIN node of rb, 2 s.n. of int2--,3 s.n. of rb,
3883C------------: 4 bcs, 5 imposed Dis. ,6 sn of rwall, 7 ns of joint,8 ns os rlink
3884 DO n =1,numnod
3885 ikin(n)=0
3886 IF (ndof(n)>0) THEN
3887 iof(n)=2
3888 ELSE
3889 iof(n)=1
3890 ENDIF
3891 ENDDO
3892C----- MAIN of rigid body first------
3893 ir =0
3894 DO i=1,nrbyac
3895 n=irbyac(i)
3896 m=npby(1,n)
3897 IF (ikin(m)==0) THEN
3898 ikin(m)=1
3899 ELSE
3900 WRITE(iout,1001)msg_type(2),itab(m)
3901 ir = ir + 1
3902 ENDIF
3903 ENDDO
3904 ierr = ierr +ir
3905C------interface 2--------------
3906 iw =0
3907 ir =0
3908 DO i=1,nint2
3909 n=iint2(i)
3910 nsn = ipari(5,n)
3911 DO j=1,nsn
3912 ns=intbuf_tab(n)%NSV(j)
3913 IF (ikin(ns)==0) THEN
3914 ikin(ns)=2
3915 ELSEIF(ikin(ns)==1) THEN
3916 WRITE(iout,1002)msg_type(1),itab(ns)
3917 iw =iw + 1
3918 ELSEIF(ikin(ns)==2) THEN
3919 WRITE(iout,1003)msg_type(2),itab(ns)
3920 ir =ir + 1
3921 ENDIF
3922 ENDDO
3923 ENDDO
3924C----- rigid body ------
3925 DO i=1,nrbyac
3926 n=irbyac(i)
3927 k=irbyac(i+nrbykin)
3928 m=npby(1,n)
3929 nsn =npby(2,n)
3930 DO j=1,nsn
3931 ns=lpby(k+j)
3932 IF (ikin(ns)==0) THEN
3933 ikin(ns)=3
3934 ELSEIF(ikin(ns)==1) THEN
3935 WRITE(iout,1004)msg_type(1),itab(ns)
3936 iw =iw + 1
3937 ELSEIF(ikin(ns)==2) THEN
3938 it = min(iof(ns),2)
3939 WRITE(iout,1005)msg_type(it),itab(ns)
3940 IF (it==1) THEN
3941 iw =iw + 1
3942 ELSEIF (it==2) THEN
3943 ir =ir + 1
3944 ENDIF
3945 ELSEIF(ikin(ns)==3) THEN
3946 it = min(iof(ns),2)
3947 WRITE(iout,1006)msg_type(it),itab(ns)
3948 IF (it==1) THEN
3949 iw =iw + 1
3950 ELSEIF (it==2) THEN
3951 ir =ir + 1
3952 ENDIF
3953 ENDIF
3954 ENDDO
3955 ENDDO
3956C--------bcs---------
3957 IF (iroddl==0) THEN
3958 DO n = 1,numnod
3959 IF (icodt(n) > 0) THEN
3960 IF (ikin(n)==0) THEN
3961 ikin(n)=4
3962 ELSEIF(ikin(n)==2) THEN
3963 it = min(iof(n),2)
3964 WRITE(iout,1007)msg_type(it),itab(n)
3965 IF (it==1) THEN
3966 iw =iw + 1
3967 ELSEIF (it==2) THEN
3968 ir =ir + 1
3969 ENDIF
3970 ELSEIF(ikin(n)==3) THEN
3971 it = min(iof(n),2)
3972 WRITE(iout,1008)msg_type(it),itab(n)
3973 IF (it==1) THEN
3974 iw =iw + 1
3975 ELSEIF (it==2) THEN
3976 ir =ir + 1
3977 ENDIF
3978 ENDIF
3979 ENDIF
3980 ENDDO
3981 ELSE
3982 DO n = 1,numnod
3983 IF ((icodt(n)+icodr(n))>0 ) THEN
3984 IF (ikin(n)==0) THEN
3985 ikin(n)=4
3986 ELSEIF(ikin(n)==2) THEN
3987 it = min(iof(n),2)
3988 WRITE(iout,1007)msg_type(it),itab(n)
3989 IF (it==1) THEN
3990 iw =iw + 1
3991 ELSEIF (it==2) THEN
3992 ir =ir + 1
3993 ENDIF
3994 ELSEIF(ikin(n)==3) THEN
3995 it = min(iof(n),2)
3996 WRITE(iout,1008)msg_type(it),itab(n)
3997 IF (it==1) THEN
3998 iw =iw + 1
3999 ELSEIF (it==2) THEN
4000 ir =ir + 1
4001 ENDIF
4002 ENDIF
4003 ENDIF
4004 ENDDO
4005 ENDIF
4006C--------fxv---------
4007 DO nn=1,nfxvel,nvsiz
4008 IF (ibfv(8,nn)==1) GOTO 100
4009 IF (nsensor>0) THEN
4010 DO 10 ii = 1, min(nfxvel-ideb,nvsiz)
4011 n = ii+ideb
4012 startt = vel(2,n)
4013 stopt = vel(3,n)
4014 IF(tt<startt)GOTO 10
4015 IF(tt>stopt) GOTO 10
4016 i=iabs(ibfv(1,n))
4017 isens=0
4018 DO k=1,nsensor
4019 IF(ibfv(4,n)==sensor_tab(k)%SENS_ID) isens=k
4020 ENDDO
4021 IF(isens==0)THEN
4022 ts=tt
4023 ELSE
4024 ts = tt-sensor_tab(isens)%TSTART
4025 IF(ts<zero)GOTO 10
4026 ENDIF
4027 IF (ikin(i)==0) THEN
4028 ikin(i)=5
4029 ELSEIF(ikin(i)==2) THEN
4030 WRITE(iout,1009)msg_type(2),itab(i)
4031 ir =ir + 1
4032 ELSEIF(ikin(i)==3) THEN
4033 WRITE(iout,1010)msg_type(2),itab(i)
4034 ir =ir + 1
4035 ELSEIF(ikin(i)==4) THEN
4036 WRITE(iout,1011)msg_type(2),itab(i)
4037 ir =ir + 1
4038 ENDIF
4039 10 CONTINUE
4040 ELSE
4041 DO 20 ii = 1, min(nfxvel-ideb,nvsiz)
4042 n = ii+ideb
4043 startt = vel(2,n)
4044 stopt = vel(3,n)
4045 IF(tt<startt)GOTO 20
4046 IF(tt>stopt) GOTO 20
4047 i=iabs(ibfv(1,n))
4048 IF (ikin(i)==0) THEN
4049 ikin(i)=5
4050 ELSEIF(ikin(i)==2) THEN
4051 WRITE(iout,1009)msg_type(2),itab(i)
4052 ir =ir + 1
4053 ELSEIF(ikin(i)==3) THEN
4054 WRITE(iout,1010)msg_type(2),itab(i)
4055 ir =ir + 1
4056 ELSEIF(ikin(i)==4) THEN
4057 WRITE(iout,1011)msg_type(2),itab(i)
4058 ir =ir + 1
4059 ENDIF
4060 20 CONTINUE
4061 ENDIF
4062C
4063 ideb = ideb + min(nfxvel-ideb,nvsiz)
4064 100 CONTINUE
4065 ENDDO
4066C--------rwall---------
4067 IF (nt_rw>0) THEN
4068 DO i = 1,numnod
4069 k = min(3,ndof(i))
4070 irw = 0
4071 DO j =1,k
4072 id = iddl(i) + j
4073 IF (ikc(id)==4.OR.ikc(id)==11) irw = 1
4074 ENDDO
4075 IF (irw>0) THEN
4076 IF (ikin(i)==0) THEN
4077 ikin(i)=6
4078 ELSEIF(ikin(i)==2) THEN
4079 WRITE(iout,1012)msg_type(2),itab(i)
4080 ir =ir + 1
4081 ELSEIF(ikin(i)==3) THEN
4082 WRITE(iout,1013)msg_type(2),itab(i)
4083 ir =ir + 1
4084 ELSEIF(ikin(i)==4) THEN
4085 WRITE(iout,1014)msg_type(2),itab(i)
4086 ir =ir + 1
4087 ELSEIF(ikin(i)==5) THEN
4088 WRITE(iout,1015)msg_type(1),itab(i)
4089 iw =iw + 1
4090 ENDIF
4091 ENDIF
4092 ENDDO
4093 ENDIF
4094 ierr = ierr +ir
4095 iwar = iwar +iw
4096 RETURN
4097 1001 FORMAT(a,' NODE USED FOR DIFF. RBODY MAIN=',i8)
4098 1002 FORMAT(a,' INCOMPABILITY NODE BETWEEN ',/
4099 . 'RBODY MAIN AND INTERF. TYPE2 SECONDARY =',i8)
4100 1003 FORMAT(a,' INCOMPABILITY NODE BETWEEN ',/
4101 . 'INTERF. TYPE2 SECONDARY AND INTERF. TYPE2 SECONDARY=',i8)
4102 1004 FORMAT(a,' INCOMPABILITY NODE BETWEEN ',/
4103 . ' RBODY MAIN AND RBODY SECONDARY=',i8)
4104 1005 FORMAT(a,' INCOMPABILITY NODE BETWEEN ',/
4105 . ' INTERF. TYPE2 SECONDARY AND RBODY SECONDARY=',i8)
4106 1006 FORMAT(a,' INCOMPABILITY NODE BETWEEN ',/
4107 . ' RBODY SECONDARY AND RBODY SECONDARY=',i8)
4108 1007 FORMAT(a,' INCOMPABILITY NODE BETWEEN ',/
4109 . ' BOUNDARY CONDITIONS AND INTERF. TYPE2 SECONDARY=',i8)
4110 1008 FORMAT(a,' INCOMPABILITY NODE BETWEEN ',/
4111 . ' BOUNDARY CONDITIONS AND RBODY SECONDARY=',i8)
4112 1009 FORMAT(a,' INCOMPABILITY NODE BETWEEN ',/
4113 . ' imposed disp. and interf. type2 secondary=',I8)
4114 1010 FORMAT(A,' incompability node between ',/
4115 . ' imposed disp. and rbody secondary=',I8)
4116 1011 FORMAT(A,' incompability node between ',/
4117 . ' imposed disp. and boundary conditions=',I8)
4118 1012 FORMAT(A,' incompability node between ',/
4119 . ' rwall contact and interf. type2 secondary=',I8)
4120 1013 FORMAT(A,' incompability node between ',/
4121 . ' rwall contact and rbody secondary=',I8)
4122 1014 FORMAT(A,' incompability node between ',/
4123 . ' rwall contact and boundary conditions=',I8)
4124 1015 FORMAT(A,' incompability node between ',/
4125 . ' rwall contact and imposed disp.=',I8)
4126 1100 FORMAT(A,' IMPLICIT is incompable with :',A/)
4127 1101 FORMAT(/'**stiffness will be ignored with',1X,I8,
4128 . ' incompable options**'/)
4129#endif
4130 END
4131!||====================================================================
4132!|| imp_compabp ../engine/source/implicit/imp_solv.F
4133!||--- called by ------------------------------------------------------
4134!|| imp_chkm ../engine/source/implicit/imp_solv.F
4135!||--- calls -----------------------------------------------------
4136!|| spmd_max_i ../engine/source/mpi/implicit/imp_spmd.F
4137!|| spmd_send_vi ../engine/source/mpi/implicit/imp_spmd.F
4138!|| spmd_sum_s ../engine/source/mpi/implicit/imp_spmd.F
4139!||--- uses -----------------------------------------------------
4140!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
4141!|| sensor_mod ../common_source/modules/sensor_mod.F90
4142!||====================================================================
4143 SUBROUTINE IMP_COMPABP(
4144 1 ICODT ,ICODR ,ISKEW ,IBFV ,NPC ,
4145 2 TF ,VEL ,NSENSOR ,SENSOR_TAB,XFRAME ,
4146 3 RBY ,X ,SKEW ,LPBY ,NPBY ,
4147 4 ITAB ,NRBYAC ,IRBYAC ,NINT2 ,IINT2 ,
4148 5 IPARI ,INTBUF_TAB,NT_RW ,NDDL ,
4149 6 NDOF ,IKC ,INLOC ,IDDL ,NDDL0 ,
4150 7 IWAR ,IERR )
4151C-----------------------------------------------
4152C M o d u l e s
4153C-----------------------------------------------
4154 USE INTBUFDEF_MOD
4155 USE SENSOR_MOD
4156C-----------------------------------------------
4157C I m p l i c i t T y p e s
4158C-----------------------------------------------
4159#include "implicit_f.inc"
4160C-----------------------------------------------
4161C C o m m o n B l o c k s
4162C-----------------------------------------------
4163#include "com01_c.inc"
4164#include "com04_c.inc"
4165#include "com08_c.inc"
4166#include "param_c.inc"
4167#include "task_c.inc"
4168#include "sphcom.inc"
4169#include "units_c.inc"
4170C-----------------------------------------------
4171C D u m m y A r g u m e n t s
4172C-----------------------------------------------
4173 INTEGER ,INTENT(IN) :: NSENSOR
4174 INTEGER NPC(*),IBFV(NIFV,*),
4175 . ICODT(*),ICODR(*),ISKEW(*),NINT2 ,IINT2(*),NT_RW
4176 INTEGER LPBY(*),NPBY(NNPBY,*),ITAB(*),IPARI(NPARI,*),
4177 . NRBYAC,IRBYAC(*),NDDL,NDOF(*),
4178 . IDDL(*),IKC(*),INLOC(*) ,NDDL0,IERR,IWAR
4179 my_real RBY(NRBY,*) ,X(3,*) ,SKEW(*)
4180 my_real TF(*),VEL(LFXVELR,*),XFRAME(NXFRAME,*)
4181 TYPE(INTBUF_STRUCT_) INTBUF_TAB(*)
4182 TYPE (SENSOR_STR_) ,DIMENSION(NSENSOR) :: SENSOR_TAB
4183#if defined(MUMPS5)
4184C-----------------------------------------------
4185C L o c a l V a r i a b l e s
4186C-----------------------------------------------
4187 INTEGER NSN,I,J,K,N,M,JI,K10,K11,K12,NS,NN,IRW,ID,IV
4188 INTEGER NKINE,IKIN(NUMNOD),IOF(NUMNOD),VI(3,NUMNOD)
4189 INTEGER ISENS,II,IDEB,IT,ICOMP,NTY,IR,IW,NVMAX,NSIZ
4190 my_real STARTT, STOPT, TS,SS
4191 CHARACTER*25 MSG_TYPE(2)
4192 DATA MSG_TYPE / '** warning **', '!! ERROR !!'/
4193C--------implicit imcompability--
4194 icomp = 0
4195 it = 1
4196 IF (ispmd==0) THEN
4197 WRITE(iout,*)
4198 WRITE(iout,*)' ** INCOMBABILITY CHECKING **'
4199 WRITE(iout,*)
4200 WRITE(istdo,*)
4201 WRITE(istdo,*)' * INCOMBABILITY CHECKING '
4202 ENDIF
4203C
4204 nn = nlaser
4205 CALL spmd_max_i(nn)
4206 IF (nn>0.AND.ispmd==0) THEN
4207 icomp = icomp + nn
4208 iwar = iwar +1
4209 WRITE(iout,1100)msg_type(it),'IMPACT LASER'
4210 ENDIF
4211 iv = 0
4212 DO n =1,ninter
4213 nty =ipari(7,n)
4214 IF (nty==2.OR.nty==7.OR.nty==10.OR.nty==11
4215 . .OR.nty==5.OR.nty==24) THEN
4216 IF(nty==7.AND.ipari(33,n)/=0)THEN
4217 icomp = icomp + ipari(33,n)
4218 iwar = iwar +1
4219 WRITE(iout,1100)msg_type(it),'LAGRANGE MULTIPLIER INTERFACE'
4220 ENDIF
4221 ELSEIF (nty>0) THEN
4222 iwar = iwar +1
4223 icomp = icomp + 1
4224C---------------- hopes that the opposite does not happen -----
4225 IF (iv<=numnod) THEN
4226 iv = iv + 1
4227 vi(1,iv) = nty
4228 ENDIF
4229 ENDIF
4230 ENDDO
4231 nvmax = iv
4232 CALL spmd_max_i(nvmax)
4233 IF (nvmax>0) THEN
4234 CALL spmd_send_vi(
4235 1 iv ,1 ,vi ,nvmax ,iout )
4236 ENDIF
4237 nn = nrivet
4238 CALL spmd_max_i(nn)
4239 IF (nn>0.AND.ispmd==0) THEN
4240 icomp = icomp + nn
4241 iwar = iwar +1
4242 WRITE(iout,1100)msg_type(it),'RIVET'
4243 ENDIF
4244 nn = ngjoint
4245 CALL spmd_max_i(nn)
4246 IF (nn>0.AND.ispmd==0) THEN
4247 icomp = icomp + nn
4248 iwar = iwar +1
4249 WRITE(iout,1100)msg_type(it),'JOINT TYPE SPRINGS'
4250 ENDIF
4251 nn = njoint
4252 CALL spmd_max_i(nn)
4253 IF (nn>0.AND.ispmd==0) THEN
4254 icomp = icomp + nn
4255 iwar = iwar +1
4256 WRITE(iout,1100)msg_type(it),'CYLINDRIC JOINT'
4257 ENDIF
4258 nn = nummpc
4259 CALL spmd_max_i(nn)
4260 IF (nn>0.AND.ispmd==0) THEN
4261 icomp = icomp + nn
4262 iwar = iwar +1
4263 WRITE(iout,1100)msg_type(it),'MULTI-POINT CONSTRAINTS'
4264 ENDIF
4265 nn = nlink
4266 CALL spmd_max_i(nn)
4267 IF (nn>0.AND.ispmd==0) THEN
4268 icomp = icomp + nn
4269 iwar = iwar +1
4270 WRITE(iout,1100)msg_type(it),'RIGID LINK'
4271 ENDIF
4272 nn = numelx
4273 CALL spmd_max_i(nn)
4274 IF (nn>0.AND.ispmd==0) THEN
4275 icomp = icomp + nn
4276 iwar = iwar +1
4277 WRITE(iout,1100)msg_type(it),'MULTI-PURPOSE ELEMENTS'
4278 ENDIF
4279 nn = numels16
4280 CALL spmd_max_i(nn)
4281 IF (nn>0.AND.ispmd==0) THEN
4282 icomp = icomp + nn
4283 iwar = iwar +1
4284 WRITE(iout,1100)msg_type(it),'SOLID 16n. ELEMENTS'
4285 ENDIF
4286 nn = numels20
4287 CALL spmd_max_i(nn)
4288 IF (nn>0.AND.ispmd==0) THEN
4289 icomp = icomp + nn
4290 iwar = iwar +1
4291 WRITE(iout,1100)msg_type(it),'SOLID 20n. ELEMENTS'
4292 ENDIF
4293 nn = numeltg6
4294 CALL spmd_max_i(nn)
4295 IF (nn>0.AND.ispmd==0) THEN
4296 icomp = icomp + nn
4297 iwar = iwar +1
4298 WRITE(iout,1100)msg_type(it),'SHELL S3N6 ELEMENTS'
4299 ENDIF
4300 nn = numsph
4301 CALL spmd_max_i(nn)
4302 IF (nn>0.AND.ispmd==0) THEN
4303 icomp = icomp + nn
4304 iwar = iwar +1
4305 WRITE(iout,1100)msg_type(it),'SPH ELEMENTS'
4306 ENDIF
4307C-----------
4308 IF (icomp>0.AND.ispmd==0) THEN
4309 WRITE(iout,1101) icomp
4310 ENDIF
4311C--------IKIN: 1 MAIN node of rb, 2 s.n. of int2--,3 s.n. of rb,
4312C------------: 4 bcs, 5 imposed Dis. ,6 sn of rwall, 7 ns of joint,8 ns os rlink
4313 nsiz = 3
4314 DO n =1,numnod
4315 ikin(n)=0
4316 IF (ndof(n)>0) THEN
4317 iof(n)=2
4318 ELSE
4319 iof(n)=1
4320 ENDIF
4321 ENDDO
4322C----- MAIN of rigid body first------
4323 ir =0
4324 DO i=1,nrbyac
4325 n=irbyac(i)
4326 m=npby(1,n)
4327 IF (ikin(m)==0) THEN
4328 ikin(m)=1
4329 ELSE
4330c WRITE(IOUT,1001)MSG_TYPE(2),ITAB(M)
4331 ir = ir + 1
4332 vi(1,ir) = 1
4333 vi(2,ir) = 2
4334 vi(3,ir) = itab(m)
4335 ENDIF
4336 ENDDO
4337 ss = ir
4338 CALL spmd_sum_s(ss)
4339 nvmax = ir
4340 CALL spmd_max_i(nvmax)
4341 ierr = ierr +int(ss)
4342 IF (nvmax>0) THEN
4343 CALL spmd_send_vi(
4344 1 ir ,nsiz ,vi ,nvmax ,iout )
4345 ENDIF
4346C------interface 2--------------
4347 iw =0
4348 ir =0
4349 iv =0
4350 DO i=1,nint2
4351 n=iint2(i)
4352 nsn = ipari(5,n)
4353 ji=ipari(1,n)
4354 k10=ji-1
4355 k11=k10+4*ipari(3,n)
4356C------IRECT(4,NSN)-----
4357 k12=k11+4*ipari(4,n)
4358C------NSV(NSN)--node number---
4359 DO j=1,nsn
4360 ns=intbuf_tab(n)%NSV(j)
4361 IF (ikin(ns)==0) THEN
4362 ikin(ns)=2
4363 ELSEIF(ikin(ns)==1) THEN
4364c WRITE(IOUT,1002)MSG_TYPE(1),ITAB(NS)
4365 iw =iw + 1
4366 iv =iv + 1
4367 vi(1,iv) = 2
4368 vi(2,iv) = 1
4369 vi(3,iv) = itab(ns)
4370 ELSEIF(ikin(ns)==2) THEN
4371c WRITE(IOUT,1003)MSG_TYPE(2),ITAB(NS)
4372 ir =ir + 1
4373 iv =iv + 1
4374 vi(1,iv) = 3
4375 vi(2,iv) = 2
4376 vi(3,iv) = itab(ns)
4377 ENDIF
4378 ENDDO
4379 ENDDO
4380 nvmax = iv
4381 CALL spmd_max_i(nvmax)
4382 IF (nvmax>0) THEN
4383 CALL spmd_send_vi(
4384 1 iv ,nsiz ,vi ,nvmax ,iout )
4385 ENDIF
4386C----- rigid body ------
4387 iv =0
4388 DO i=1,nrbyac
4389 n=irbyac(i)
4390 k=irbyac(i+nrbykin)
4391 m=npby(1,n)
4392 nsn =npby(2,n)
4393 DO j=1,nsn
4394 ns=lpby(k+j)
4395 IF (ikin(ns)==0) THEN
4396 ikin(ns)=3
4397 ELSEIF(ikin(ns)==1) THEN
4398c WRITE(IOUT,1004)MSG_TYPE(1),ITAB(NS)
4399 iw =iw + 1
4400 iv =iv + 1
4401 vi(1,iv) = 4
4402 vi(2,iv) = 1
4403 vi(3,iv) = itab(ns)
4404 ELSEIF(ikin(ns)==2) THEN
4405 it = min(iof(ns),2)
4406c WRITE(IOUT,1005)MSG_TYPE(IT),ITAB(NS)
4407 iv =iv + 1
4408 vi(1,iv) = 5
4409 vi(2,iv) = it
4410 vi(3,iv) = itab(ns)
4411 IF (it==1) THEN
4412 iw =iw + 1
4413 ELSEIF (it==2) THEN
4414 ir =ir + 1
4415 ENDIF
4416 ELSEIF(ikin(ns)==3) THEN
4417 it = min(iof(ns),2)
4418c WRITE(IOUT,1006)MSG_TYPE(IT),ITAB(NS)
4419 iv =iv + 1
4420 vi(1,iv) = 6
4421 vi(2,iv) = it
4422 vi(3,iv) = itab(ns)
4423 IF (it==1) THEN
4424 iw =iw + 1
4425 ELSEIF (it==2) THEN
4426 ir =ir + 1
4427 ENDIF
4428 ENDIF
4429 ENDDO
4430 ENDDO
4431 nvmax = iv
4432 CALL spmd_max_i(nvmax)
4433 IF (nvmax>0) THEN
4434 CALL spmd_send_vi(
4435 1 iv ,nsiz ,vi ,nvmax ,iout )
4436 ENDIF
4437C--------bcs---------
4438 iv =0
4439 IF (iroddl==0) THEN
4440 DO n = 1,numnod
4441 IF (icodt(n) > 0) THEN
4442 IF (ikin(n)==0) THEN
4443 ikin(n)=4
4444 ELSEIF(ikin(n)==2) THEN
4445 it = min(iof(n),2)
4446c WRITE(IOUT,1007)MSG_TYPE(IT),ITAB(N)
4447 iv =iv + 1
4448 vi(1,iv) = 7
4449 vi(2,iv) = it
4450 vi(3,iv) = itab(n)
4451 IF (it==1) THEN
4452 iw =iw + 1
4453 ELSEIF (it==2) THEN
4454 ir =ir + 1
4455 ENDIF
4456 ELSEIF(ikin(n)==3) THEN
4457 it = 1
4458C IT = MIN(IOF(N),2)
4459c WRITE(IOUT,1008)MSG_TYPE(IT),ITAB(N)
4460 iv =iv + 1
4461 vi(1,iv) = 8
4462 vi(2,iv) = it
4463 vi(3,iv) = itab(n)
4464 IF (it==1) THEN
4465 iw =iw + 1
4466 ELSEIF (it==2) THEN
4467 ir =ir + 1
4468 ENDIF
4469 ENDIF
4470 ENDIF
4471 ENDDO
4472 ELSE
4473 DO n = 1,numnod
4474 IF ((icodt(n)+icodr(n))>0 ) THEN
4475 IF (ikin(n)==0) THEN
4476 ikin(n)=4
4477 ELSEIF(ikin(n)==2) THEN
4478 it = min(iof(n),2)
4479c WRITE(IOUT,1007)MSG_TYPE(IT),ITAB(N)
4480 iv =iv + 1
4481 vi(1,iv) = 7
4482 vi(2,iv) = it
4483 vi(3,iv) = itab(n)
4484 IF (it==1) THEN
4485 iw =iw + 1
4486 ELSEIF (it==2) THEN
4487 ir =ir + 1
4488 ENDIF
4489 ELSEIF(ikin(n)==3) THEN
4490 it = 1
4491C IT = MIN(IOF(N),2)
4492c WRITE(IOUT,1008)MSG_TYPE(IT),ITAB(N)
4493 iv =iv + 1
4494 vi(1,iv) = 8
4495 vi(2,iv) = it
4496 vi(3,iv) = itab(n)
4497 IF (it==1) THEN
4498 iw =iw + 1
4499 ELSEIF (it==2) THEN
4500 ir =ir + 1
4501 ENDIF
4502 ENDIF
4503 ENDIF
4504 ENDDO
4505 ENDIF
4506 nvmax = iv
4507 CALL spmd_max_i(nvmax)
4508 IF (nvmax>0) THEN
4509 CALL spmd_send_vi(
4510 1 iv ,nsiz ,vi ,nvmax ,iout )
4511 ENDIF
4512C--------fxv---------
4513 iv =0
4514 DO nn=1,nfxvel,nvsiz
4515 IF (ibfv(8,nn)==1) GOTO 100
4516 IF (nsensor>0) THEN
4517 DO 10 ii = 1, min(nfxvel-ideb,nvsiz)
4518 n = ii+ideb
4519 startt = vel(2,n)
4520 stopt = vel(3,n)
4521 IF(tt<startt)GOTO 10
4522 IF(tt>stopt) GOTO 10
4523 i=iabs(ibfv(1,n))
4524 isens=0
4525 DO k=1,nsensor
4526 IF(ibfv(4,n)==sensor_tab(k)%SENS_ID) isens=k
4527 ENDDO
4528 IF(isens==0)THEN
4529 ts=tt
4530 ELSE
4531 ts = tt-sensor_tab(isens)%TSTART
4532 IF(ts<zero)GOTO 10
4533 ENDIF
4534 IF (ikin(i)==0) THEN
4535 ikin(i)=5
4536 ELSEIF(ikin(i)==2) THEN
4537c WRITE(IOUT,1009)MSG_TYPE(2),ITAB(I)
4538 iv =iv + 1
4539 vi(1,iv) = 9
4540 vi(2,iv) = 2
4541 vi(3,iv) = itab(i)
4542 ir =ir + 1
4543 ELSEIF(ikin(i)==3) THEN
4544c WRITE(IOUT,1010)MSG_TYPE(2),ITAB(I)
4545 iv =iv + 1
4546 vi(1,iv) = 10
4547 vi(2,iv) = 1
4548 vi(3,iv) = itab(i)
4549 iw =iw + 1
4550 ELSEIF(ikin(i)==4) THEN
4551c WRITE(IOUT,1011)MSG_TYPE(2),ITAB(I)
4552 iv =iv + 1
4553 vi(1,iv) = 11
4554 vi(2,iv) = 2
4555 vi(3,iv) = itab(i)
4556 ir =ir + 1
4557 ENDIF
4558 10 CONTINUE
4559 ELSE
4560 DO 20 ii = 1, min(nfxvel-ideb,nvsiz)
4561 n = ii+ideb
4562 startt = vel(2,n)
4563 stopt = vel(3,n)
4564 IF(tt<startt)GOTO 20
4565 IF(tt>stopt) GOTO 20
4566 i=iabs(ibfv(1,n))
4567 IF (ikin(i)==0) THEN
4568 ikin(i)=5
4569 ELSEIF(ikin(i)==2) THEN
4570c WRITE(IOUT,1009)MSG_TYPE(2),ITAB(I)
4571 iv =iv + 1
4572 vi(1,iv) = 9
4573 vi(2,iv) = 2
4574 vi(3,iv) = itab(i)
4575 ir =ir + 1
4576 ELSEIF(ikin(i)==3) THEN
4577c WRITE(IOUT,1010)MSG_TYPE(2),ITAB(I)
4578 iv =iv + 1
4579 vi(1,iv) = 10
4580 vi(2,iv) = 1
4581 vi(3,iv) = itab(i)
4582 iw =iw + 1
4583 ELSEIF(ikin(i)==4) THEN
4584c WRITE(IOUT,1011)MSG_TYPE(2),ITAB(I)
4585 iv =iv + 1
4586 vi(1,iv) = 11
4587 vi(2,iv) = 2
4588 vi(3,iv) = itab(i)
4589 ir =ir + 1
4590 ENDIF
4591 20 CONTINUE
4592 ENDIF
4593C
4594 ideb = ideb + min(nfxvel-ideb,nvsiz)
4595 100 CONTINUE
4596 ENDDO
4597 nvmax = iv
4598 CALL spmd_max_i(nvmax)
4599 IF (nvmax>0) THEN
4600 CALL spmd_send_vi(
4601 1 iv ,nsiz ,vi ,nvmax ,iout )
4602 ENDIF
4603C--------rwall---------
4604 iv =0
4605 IF (nt_rw>0) THEN
4606 DO i = 1,numnod
4607 k = min(3,ndof(i))
4608 irw = 0
4609 DO j =1,k
4610 id = iddl(i) + j
4611 IF (ikc(id)==4.OR.ikc(id)==11) irw = 1
4612 ENDDO
4613 IF (irw>0) THEN
4614 IF (ikin(i)==0) THEN
4615 ikin(i)=6
4616 ELSEIF(ikin(i)==2) THEN
4617c WRITE(IOUT,1012)MSG_TYPE(2),ITAB(I)
4618 iv =iv + 1
4619 vi(1,iv) = 12
4620 vi(2,iv) = 2
4621 vi(3,iv) = itab(i)
4622 ir =ir + 1
4623 ELSEIF(ikin(i)==3) THEN
4624c WRITE(IOUT,1013)MSG_TYPE(2),ITAB(I)
4625 iv =iv + 1
4626 vi(1,iv) = 13
4627 vi(2,iv) = 1
4628 vi(3,iv) = itab(i)
4629 iw =iw + 1
4630 ELSEIF(ikin(i)==4) THEN
4631c WRITE(IOUT,1014)MSG_TYPE(2),ITAB(I)
4632 iv =iv + 1
4633 vi(1,iv) = 14
4634 vi(2,iv) = 2
4635 vi(3,iv) = itab(i)
4636 ir =ir + 1
4637 ELSEIF(ikin(i)==5) THEN
4638c WRITE(IOUT,1015)MSG_TYPE(1),ITAB(I)
4639 iv =iv + 1
4640 vi(1,iv) = 15
4641 vi(2,iv) = 1
4642 vi(3,iv) = itab(i)
4643 iw =iw + 1
4644 ENDIF
4645 ENDIF
4646 ENDDO
4647 ENDIF
4648C
4649 nvmax = iv
4650 CALL spmd_max_i(nvmax)
4651 IF (nvmax>0) THEN
4652 CALL spmd_send_vi(
4653 1 iv ,nsiz ,vi ,nvmax ,iout )
4654 ENDIF
4655 ss = ir
4656 CALL spmd_sum_s(ss)
4657 ir = int(ss)
4658 ss = iw
4659 CALL spmd_sum_s(ss)
4660 iw = int(ss)
4661 ierr = ierr +ir
4662 iwar = iwar +iw
4663 RETURN
4664 1100 FORMAT(a,' IMPLICIT IS INCOMPABLE WITH :',a/)
4665 1101 FORMAT(/'**STIFFNESS WILL BE IGNORED WITH',1x,i8,
4666 . ' INCOMPABLE OPTIONS**'/)
4667C endif MUMPS defined
4668#endif
4669 END
4670
4671!||====================================================================
4672!|| imp_fout ../engine/source/implicit/imp_solv.F
4673!||--- called by ------------------------------------------------------
4674!|| resol ../engine/source/engine/resol.F
4675!||--- uses -----------------------------------------------------
4676!|| h3d_mod ../engine/share/modules/h3d_mod.F
4677!|| impbufdef_mod ../engine/share/modules/impbufdef_mod.F
4678!|| output_mod ../common_source/modules/output/output_mod.F90
4679!||====================================================================
4680 SUBROUTINE imp_fout(
4681 1 OUTPUT ,A ,AR ,NFIA ,NFEA ,
4682 2 NODFT ,NODLT ,H3D_DATA ,IMPBUF_TAB)
4683C-----------------------------------------------
4684C M o d u l e s
4685C-----------------------------------------------
4686 USE h3d_mod
4687 USE output_mod, ONLY : output_
4688 USE impbufdef_mod
4689C-----------------------------------------------
4690C I m p l i c i t T y p e s
4691C-----------------------------------------------
4692#include "implicit_f.inc"
4693C-----------------------------------------------
4694C C o m m o n B l o c k s
4695C-----------------------------------------------
4696#include "scr14_c.inc"
4697#include "scr16_c.inc"
4698C-----------------------------------------------
4699C D u m m y A r g u m e n t s
4700C-----------------------------------------------
4701 TYPE(output_) :: OUTPUT
4702 INTEGER NFIA,NFEA,NODFT,NODLT
4703C REAL
4704 my_real
4705 . a(3,*) ,ar(3,*)
4706 TYPE(h3d_database) :: H3D_DATA
4707 TYPE (IMPBUF_STRUCT_) ,TARGET :: IMPBUF_TAB
4708C-----------------------------------------------
4709C L o c a l V a r i a b l e s
4710C-----------------------------------------------
4711 INTEGER N,I,J,K,ND
4712 INTEGER, DIMENSION(:) ,POINTER :: IDDL,NDOF,IKC
4713C-------------mis zero Fint des nodes dependants------------
4714 IDDL => impbuf_tab%IDDL
4715 ndof => impbuf_tab%NDOF
4716 ikc => impbuf_tab%IKC
4717 IF(anim_v(5)+outp_v(5)+h3d_data%N_VECT_FINT>0) THEN
4718 DO i = nodft,nodlt
4719 DO j=1,min(3,ndof(i))
4720 nd = iddl(i)+j
4721 IF (ikc(nd)/=0) output%DATA%VECT_FINT(j,i)= zero
4722 ENDDO
4723 IF (ndof(i)==0) THEN
4724 output%DATA%VECT_FINT(1,i)= zero
4725 output%DATA%VECT_FINT(2,i)= zero
4726 output%DATA%VECT_FINT(3,i)= zero
4727 ENDIF
4728 ENDDO
4729 ENDIF
4730C
4731 RETURN
4732 END
4733!||====================================================================
4734!|| imp_fanii ../engine/source/implicit/imp_solv.f
4735!||--- called by ------------------------------------------------------
4736!|| resol ../engine/source/engine/resol.F
4737!||--- uses -----------------------------------------------------
4738!|| h3d_mod ../engine/share/modules/h3d_mod.F
4739!|| output_mod ../common_source/modules/output/output_mod.F90
4740!||====================================================================
4741 SUBROUTINE imp_fanii(
4742 1 OUTPUT,FINT ,NFIA ,NODFT ,NODLT ,
4743 2 H3D_DATA )
4744C-----------------------------------------------
4745C M o d u l e s
4746C-----------------------------------------------
4747 USE h3d_mod
4748 USE output_mod, ONLY : output_
4749C-----------------------------------------------
4750C I m p l i c i t T y p e s
4751C-----------------------------------------------
4752#include "implicit_f.inc"
4753C-----------------------------------------------
4754C C o m m o n B l o c k s
4755C-----------------------------------------------
4756#include "scr14_c.inc"
4757#include "scr16_c.inc"
4758C-----------------------------------------------
4759C D u m m y A r g u m e n t s
4760C-----------------------------------------------
4761 TYPE(output_) :: OUTPUT
4762 INTEGER NFIA,NODFT,NODLT
4763C REAL
4764 my_real
4765 . fint(3,*)
4766 TYPE(h3d_database) :: H3D_DATA
4767C-----------------------------------------------
4768C L o c a l V a r i a b l e s
4769C-----------------------------------------------
4770 INTEGER N,I,J,K,ND
4771C---
4772 IF(anim_v(5)+outp_v(5)+h3d_data%N_VECT_FINT>0) THEN
4773#include "vectorize.inc"
4774 DO n=nodft,nodlt
4775 output%DATA%VECT_FINT(1,n)= fint(1,n)
4776 output%DATA%VECT_FINT(2,n)= fint(2,n)
4777 output%DATA%VECT_FINT(3,n)= fint(3,n)
4778 ENDDO
4779 ENDIF
4780C
4781 RETURN
4782 END
4783!||====================================================================
4784!|| imp_fanie ../engine/source/implicit/imp_solv.F
4785!||--- called by ------------------------------------------------------
4786!|| resol ../engine/source/engine/resol.F
4787!||--- uses -----------------------------------------------------
4788!|| h3d_mod ../engine/share/modules/h3d_mod.F
4789!|| output_mod ../common_source/modules/output/output_mod.F90
4790!||====================================================================
4791 SUBROUTINE imp_fanie(
4792 1 OUTPUT ,FEXT ,NFIA ,NFEA ,NODFT ,NODLT ,
4793 2 H3D_DATA )
4794C-----------------------------------------------
4795C M o d u l e s
4796C-----------------------------------------------
4797 USE h3d_mod
4798 USE output_mod, ONLY : output_
4799C-----------------------------------------------
4800C I m p l i c i t T y p e s
4801C-----------------------------------------------
4802#include "implicit_f.inc"
4803C-----------------------------------------------
4804C C o m m o n B l o c k s
4805C-----------------------------------------------
4806#include "scr14_c.inc"
4807#include "scr16_c.inc"
4808C-----------------------------------------------
4809C D u m m y A r g u m e n t s
4810C-----------------------------------------------
4811 TYPE(output_) :: OUTPUT
4812 INTEGER NFIA,NFEA,NODFT,NODLT
4813C REAL
4814 my_real
4815 . fext(3,*)
4816 TYPE(h3d_database) :: H3D_DATA
4817C-----------------------------------------------
4818C L o c a l V a r i a b l e s
4819C-----------------------------------------------
4820 INTEGER N,I,J,K,ND
4821C---
4822 IF(anim_v(5)+outp_v(5)+h3d_data%N_VECT_FINT>0) THEN
4823#include "vectorize.inc"
4824 DO n=nodft,nodlt
4825 output%DATA%VECT_FINT(1,n)= -fext(1,n)
4826 output%DATA%VECT_FINT(2,n)= -fext(2,n)
4827 output%DATA%VECT_FINT(3,n)= -fext(3,n)
4828 ENDDO
4829 ENDIF
4830 IF(anim_v(6)+outp_v(6)+h3d_data%N_VECT_FEXT>0) THEN
4831#include "vectorize.inc"
4832 DO n=nodft,nodlt
4833 output%DATA%VECT_FEXT(1,n)= fext(1,n)
4834 output%DATA%VECT_FEXT(2,n)= fext(2,n)
4835 output%DATA%VECT_FEXT(3,n)= fext(3,n)
4836 ENDDO
4837 ENDIF
4838 RETURN
4839 END
4840!||====================================================================
4841!|| ini_kic ../engine/source/implicit/imp_solv.F
4842!||--- called by ------------------------------------------------------
4843!|| imp_buck ../engine/source/implicit/imp_buck.F
4844!|| imp_solv ../engine/source/implicit/imp_solv.F
4845!||--- uses -----------------------------------------------------
4846!|| imp_intm ../engine/share/modules/imp_intm.F
4847!||====================================================================
4848 SUBROUTINE ini_kic
4849C-----------------------------------------------
4850C M o d u l e s
4851C-----------------------------------------------
4852 USE imp_intm
4853C-----------------------------------------------
4854C I m p l i c i t T y p e s
4855C-----------------------------------------------
4856#include "implicit_f.inc"
4857C-----------------------------------------------
4858C L o c a l V a r i a b l e s
4859C-----------------------------------------------
4860 nddl_si = 0
4861 nddl_sl = 0
4862 nz_si = 0
4863 nz_sl = 0
4864C------------------------------------------
4865 RETURN
4866 END
4867!||====================================================================
4868!|| deallocm ../engine/source/implicit/imp_solv.F
4869!||--- called by ------------------------------------------------------
4870!|| imp_solv ../engine/source/implicit/imp_solv.F
4871!||--- uses -----------------------------------------------------
4872!|| imp_knon ../engine/share/modules/impbufdef_mod.F
4873!||====================================================================
4874 SUBROUTINE deallocm
4875C-----------------------------------------------
4876C M o d u l e s
4877C-----------------------------------------------
4878 USE imp_knon
4879C-----------------------------------------------
4880C I m p l i c i t T y p e s
4881C-----------------------------------------------
4882#include "implicit_f.inc"
4883C-----------------------------------------------
4884C L o c a l V a r i a b l e s
4885C-----------------------------------------------
4886 IF(ALLOCATED(in_kn)) DEALLOCATE(in_kn)
4887 IF(ALLOCATED(id_kn)) DEALLOCATE(id_kn)
4888 IF (numn_kn>0) THEN
4889 IF(ALLOCATED(id_knm)) DEALLOCATE(id_knm)
4890 IF(ALLOCATED(id_knm2)) DEALLOCATE(id_knm2)
4891 IF(ALLOCATED(id_knm3)) DEALLOCATE(id_knm3)
4892 IF(ALLOCATED(ii2_kn)) DEALLOCATE(ii2_kn)
4893 IF(ALLOCATED(irb_kn)) DEALLOCATE(irb_kn)
4894 IF(ALLOCATED(ibc_kn)) DEALLOCATE(ibc_kn)
4895 IF(ALLOCATED(ifx_kn)) DEALLOCATE(ifx_kn)
4896 IF(ALLOCATED(irw_kn)) DEALLOCATE(irw_kn)
4897 IF(ALLOCATED(irbe3_kn)) DEALLOCATE(irbe3_kn)
4898 IF(ALLOCATED(fcdi_kn)) DEALLOCATE(fcdi_kn)
4899 IF(ALLOCATED(mcdi_kn)) DEALLOCATE(mcdi_kn)
4900 ENDIF
4901C------------------------------------------
4902 RETURN
4903 END
4904
4905!||====================================================================
4906!|| deallocm_imp ../engine/source/implicit/imp_solv.F
4907!||--- called by ------------------------------------------------------
4908!|| resol ../engine/source/engine/resol.F
4909!||--- calls -----------------------------------------------------
4910!|| fvbc_deallo ../engine/source/constraints/general/impvel/fv_imp0.F
4911!|| spmd_mumps_deal ../engine/source/mpi/implicit/imp_spmd.F
4912!||--- uses -----------------------------------------------------
4913!|| imp_bfgs ../engine/share/modules/impbufdef_mod.F
4914!|| imp_dyna ../engine/share/modules/impbufdef_mod.F
4915!|| imp_intbuf ../engine/share/modules/imp_mod_def.F90
4916!|| imp_kbcs ../engine/share/modules/impbufdef_mod.F
4917!|| imp_pcg_proj ../engine/share/modules/impbufdef_mod.F
4918!|| imp_qstat ../engine/share/modules/impbufdef_mod.F
4919!|| imp_spbrm ../engine/share/modules/impbufdef_mod.F
4920!|| imp_workh ../engine/share/modules/impbufdef_mod.F
4921!||====================================================================
4922 SUBROUTINE deallocm_imp(MUMPS_PAR)
4923C-----------------------------------------------
4924C M o d u l e s
4925C-----------------------------------------------
4926 USE imp_kbcs
4927 USE imp_bfgs
4928 USE imp_dyna
4929 USE imp_workh
4930 USE imp_pcg_proj
4931 USE imp_qstat
4932 USE imp_spbrm
4933 USE imp_intbuf
4934C-----------------------------------------------
4935C I m p l i c i t T y p e s
4936C-----------------------------------------------
4937#include "implicit_f.inc"
4938C-----------------------------------------------
4939C C o m m o n B l o c k s
4940C-----------------------------------------------
4941#include "com01_c.inc"
4942#include "impl1_c.inc"
4943#include "impl2_c.inc"
4944#if defined(MUMPS5)
4945#include "dmumps_struc.h"
4946#endif
4947C-----------------------------------------------
4948C D u m m y A r g u m e n t s
4949C-----------------------------------------------
4950#ifdef MUMPS5
4951 TYPE(dmumps_struc) MUMPS_PAR
4952#else
4953 ! Fake declaration as DMUMPS_STRUC is shipped with MUMPS
4954 INTEGER MUMPS_PAR
4955#endif
4956#if defined(MUMPS5)
4957C-----------------------------------------------
4958C L o c a l V a r i a b l e s
4959C-----------------------------------------------
4960 IF(IMUMPSV > 0 ) CALL SPMD_MUMPS_DEAL(MUMPS_PAR)
4961 IF (ISOLV>2) THEN
4962 IF(ALLOCATED(HOLD)) DEALLOCATE(HOLD)
4963 ENDIF
4964 IF (insolv>1) THEN
4965 IF(ALLOCATED(bfgs_v)) DEALLOCATE(bfgs_v)
4966 IF(ALLOCATED(bfgs_w)) DEALLOCATE(bfgs_w)
4967 ENDIF
4968 IF (idyna>0) THEN
4969 IF(ALLOCATED(dy_d)) DEALLOCATE(dy_d)
4970 IF(ALLOCATED(dy_dr)) DEALLOCATE(dy_dr)
4971 IF(ALLOCATED(dy_v)) DEALLOCATE(dy_v)
4972 IF(ALLOCATED(dy_vr)) DEALLOCATE(dy_vr)
4973c IF(ALLOCATED(DY_A)) DEALLOCATE(DY_A)
4974c IF(ALLOCATED(DY_AR)) DEALLOCATE(DY_AR)
4975 IF (idy_damp>0) THEN
4976 DEALLOCATE(dy_diak0,dy_ltk0)
4977 DEALLOCATE(dy_iadk0,dy_jdik0)
4978 ENDIF
4979 IF (hht_a/=zero)DEALLOCATE(dy_r0,dy_r1)
4980 ENDIF
4981C---------------lin_solv--------
4982 IF(ALLOCATED(l_u)) DEALLOCATE(l_u)
4983 IF(ALLOCATED(diag_t)) DEALLOCATE(diag_t)
4984 IF(ALLOCATED(l_f0)) DEALLOCATE(l_f0)
4985 IF (isolv==1.OR.isolv>4) THEN
4986 IF(ALLOCATED(iadk0)) DEALLOCATE(iadk0)
4987 IF(ALLOCATED(jdik0)) DEALLOCATE(jdik0)
4988 IF(ALLOCATED(lt_k0)) DEALLOCATE(lt_k0)
4989 IF(ALLOCATED(pcg_w1)) DEALLOCATE(pcg_w1)
4990 IF(ALLOCATED(pcg_w2)) DEALLOCATE(pcg_w2)
4991 IF(ALLOCATED(pcg_w3)) DEALLOCATE(pcg_w3)
4992 IF (iprec==5) THEN
4993 IF(ALLOCATED(iadm0)) DEALLOCATE(iadm0)
4994 IF(ALLOCATED(jdim0)) DEALLOCATE(jdim0)
4995 IF(ALLOCATED(lt_m0)) DEALLOCATE(lt_m0)
4996 ENDIF
4997 IF (m_vs>0) THEN
4998 IF(ALLOCATED(proj_s)) DEALLOCATE(proj_s)
4999 IF(ALLOCATED(proj_t)) DEALLOCATE(proj_t)
5000 IF(ALLOCATED(proj_la_1)) DEALLOCATE(proj_la_1)
5001 IF(ALLOCATED(proj_v)) DEALLOCATE(proj_v)
5002 IF(ALLOCATED(proj_w)) DEALLOCATE(proj_w)
5003 IF(ALLOCATED(proj_k)) DEALLOCATE(proj_k)
5004 ENDIF
5005 ENDIF
5006 IF(iqstat==1 .AND. iline==0) THEN
5007 DEALLOCATE(d_n_1)
5008 IF (iroddl/=0) DEALLOCATE(dr_n_1)
5009 END IF
5010 CALL fvbc_deallo
5011 IF (irig_m>0) THEN
5012 IF(ALLOCATED(ibc_b)) DEALLOCATE(ibc_b)
5013 IF(ALLOCATED(ie_bc4)) DEALLOCATE(ie_bc4)
5014 IF(ALLOCATED(ie_bc3)) DEALLOCATE(ie_bc3)
5015 END IF
5016C------ to perform---
5017c IF (NINTER>0) THEN
5018c IF(ALLOCATED(INTBUF_TAB_CP)) DEALLOCATE(INTBUF_TAB_CP)
5019c IF(ALLOCATED(INTBUF_TAB_IMP)) DEALLOCATE(INTBUF_TAB_IMP)
5020c IF(ALLOCATED(BMINMA_IMP)) DEALLOCATE(BMINMA_IMP)
5021c END IF
5022C------------------------------------------
5023 RETURN
5024#endif
5025 END
5026!||====================================================================
5027!|| crit_llim ../engine/source/implicit/imp_solv.F
5028!||--- called by ------------------------------------------------------
5029!|| imp_solv ../engine/source/implicit/imp_solv.F
5030!||====================================================================
5031 SUBROUTINE crit_llim(NDDL,NNZK)
5032C-----------------------------------------------
5033C I m p l i c i t T y p e s
5034C-----------------------------------------------
5035#include "implicit_f.inc"
5036C-----------------------------------------------
5037C C o m m o n B l o c k s
5038C-----------------------------------------------
5039#include "com01_c.inc"
5040#include "task_c.inc"
5041#include "impl1_c.inc"
5042C-----------------------------------------------
5043C D u m m y A r g u m e n t s
5044C-----------------------------------------------
5045C REAL
5046 INTEGER NDDL,NNZK
5047C-----------------------------------------------
5048C L o c a l V a r i a b l e s
5049C-----------------------------------------------
5050 INTEGER I,J,JD,NP
5051 my_real
5052 . pfac,critl,s1,s2
5053C------compute auto seclect solver by L_LIM--------------
5054C--------take into account to parallel capacities of PCG---
5055 IF (nspmd == 1) THEN
5056 nddl_g = nddl
5057 nnzk_g = nnzk
5058 END IF
5059 np=nspmd/2
5060 pfac= two_third*nthread*max(1,np)
5061 pfac=max(one,pfac)
5062 s1=nddl_g*five*em03
5063 s2=nnzk_g*twop8*em04
5064 critl=half*(s1+s2)
5065 l_lim=critl*pfac
5066C------------------------------------------
5067 RETURN
5068 END
5069!||====================================================================
5070!|| ini_k0h ../engine/source/implicit/imp_solv.F
5071!||--- called by ------------------------------------------------------
5072!|| imp_chkm ../engine/source/implicit/imp_solv.F
5073!|| imp_solv ../engine/source/implicit/imp_solv.F
5074!||--- calls -----------------------------------------------------
5075!|| ancmsg ../engine/source/output/message/message.F
5076!|| arret ../engine/source/system/arret.F
5077!|| dim_span ../engine/source/implicit/ind_glob_k.F
5078!||--- uses -----------------------------------------------------
5079!|| imp_pcg_proj ../engine/share/modules/impbufdef_mod.F
5080!|| imp_workh ../engine/share/modules/impbufdef_mod.F
5081!|| message_mod ../engine/share/message_module/message_mod.F
5082!||====================================================================
5083 SUBROUTINE ini_k0h(NDDL,NNZ,NNZM,IADK,JDIK)
5084C-----------------------------------------------
5085C M o d u l e s
5086C-----------------------------------------------
5087 USE imp_workh
5088 USE imp_pcg_proj
5089 USE message_mod
5090C-----------------------------------------------
5091C I m p l i c i t T y p e s
5092C-----------------------------------------------
5093#include "implicit_f.inc"
5094C-----------------------------------------------
5095C C o m m o n B l o c k s
5096C-----------------------------------------------
5097#include "impl1_c.inc"
5098C-----------------------------------------------
5099C D u m m y A r g u m e n t s
5100C-----------------------------------------------
5101 INTEGER NDDL,NNZ,NNZM,IADK(*),JDIK(*)
5102C-----------------------------------------------
5103C L o c a l V a r i a b l e s
5104C-----------------------------------------------
5105 INTEGER IERR,LNZM
5106C------------------for lin_solv---------------
5107 ALLOCATE(l_u(nddl),diag_t(nddl),l_f0(nddl),stat=ierr)
5108 IF (ierr/=0) THEN
5109 CALL ancmsg(msgid=19,anmode=aninfo,
5110 . c1='FOR IMPLICIT SOLVER')
5111 CALL arret(2)
5112 ENDIF
5113 IF (isolv==1.OR.isolv>4) THEN
5114 ALLOCATE(pcg_w1(nddl),pcg_w2(nddl),pcg_w3(nddl),stat=ierr)
5115 ALLOCATE(iadk0(nddl+1),jdik0(nnz),lt_k0(nnz),stat=ierr)
5116 IF (ierr/=0) THEN
5117 CALL ancmsg(msgid=19,anmode=aninfo,
5118 . c1='FOR PCG SOLVER')
5119 CALL arret(2)
5120 ENDIF
5121 lt_k0=zero
5122 IF (iprec==5) THEN
5123 lnzm = nnzm
5124 IF (n_pat>1) CALL dim_span(n_pat,nddl,iadk,jdik,lnzm,ierr)
5125 ALLOCATE(iadm0(nddl+1),jdim0(lnzm),lt_m0(lnzm),stat=ierr)
5126 IF (ierr/=0) THEN
5127 CALL ancmsg(msgid=19,anmode=aninfo,
5128 . c1='FOR PCG(IPREC=5) SOLVER')
5129 CALL arret(2)
5130 ENDIF
5131 lt_m0=zero
5132 END IF !(IPREC==5) THEN
5133 END IF !(ISOLV==1.OR.ISOLV>4) THEN
5134C
5135 IF (m_vs>0) THEN
5136 lnzm=m_vs+1
5137 ALLOCATE(proj_s(nddl,lnzm),proj_t(nddl,lnzm),proj_la_1(lnzm),
5138 . proj_v(nddl),proj_w(lnzm),proj_k(lnzm,lnzm),
5139 . stat=ierr)
5140 IF (ierr/=0) THEN
5141 CALL ancmsg(msgid=19,anmode=aninfo,
5142 . c1='FOR PCG SOLVER')
5143 CALL arret(2)
5144 ENDIF
5145 ncg_run = 0
5146 proj_v = zero
5147 END IF
5148C------------------------------------------
5149 RETURN
5150 END
5151!||====================================================================
5152!|| set_ksym ../engine/source/implicit/imp_solv.F
5153!||--- called by ------------------------------------------------------
5154!|| lin_solv ../engine/source/implicit/lin_solv.F
5155!|| lin_solvh0 ../engine/source/implicit/lin_solv.F
5156!|| lin_solvh1 ../engine/source/implicit/lin_solv.F
5157!|| lin_solvhm ../engine/source/implicit/lin_solv.F
5158!|| lin_solvih2 ../engine/source/implicit/lin_solv.F
5159!||====================================================================
5160 SUBROUTINE set_ksym(NDDL,IADK,JDIK,LT_K,IADK0,JDIK0,LT_K0)
5161C-----------------------------------------------
5162C I m p l i c i t T y p e s
5163C-----------------------------------------------
5164#include "implicit_f.inc"
5165C-----------------------------------------------
5166C D u m m y A r g u m e n t s
5167C-----------------------------------------------
5168 INTEGER NDDL,IADK(*),JDIK(*),IADK0(*),JDIK0(*)
5169 my_real
5170 . lt_k(*),lt_k0(*)
5171C-----------------------------------------------
5172C L o c a l V a r i a b l e s
5173C-----------------------------------------------
5174 INTEGER I,J,K,JD,ICOL(NDDL),NRI,NR0
5175C----6--K0:matrice complete(non triang)
5176 DO i = 1, nddl
5177 icol(i) = iadk(i+1) - iadk(i)
5178 ENDDO
5179 DO i = 1, nddl
5180 DO j = iadk(i),iadk(i+1)-1
5181 jd = jdik(j)
5182 icol(jd) = icol(jd) + 1
5183 ENDDO
5184 ENDDO
5185 iadk0(1) = 1
5186 DO i = 1,nddl
5187 iadk0(i+1) = iadk0(i)+icol(i)-iadk(i+1)+iadk(i)
5188 icol(i) = 0
5189 ENDDO
5190 DO i = 1,nddl
5191 DO j=iadk(i),iadk(i+1)-1
5192 jd = jdik(j)
5193 k = iadk0(jd) + icol(jd)
5194 jdik0(k) = i
5195 lt_k0(k) = lt_k(j)
5196 icol(jd) = icol(jd) + 1
5197 ENDDO
5198 ENDDO
5199C
5200 RETURN
5201 END
5202
5203!||====================================================================
5204!|| get_fext ../engine/source/implicit/imp_solv.F
5205!||--- called by ------------------------------------------------------
5206!|| imp_solv ../engine/source/implicit/imp_solv.F
5207!||--- calls -----------------------------------------------------
5208!|| condens_b ../engine/source/implicit/upd_glob_k.F
5209!|| imp_setba ../engine/source/implicit/imp_setb.F
5210!|| imp_setbp ../engine/source/implicit/imp_setb.F
5211!|| spmd_sumf_v ../engine/source/mpi/implicit/imp_spmd.F
5212!||====================================================================
5213 SUBROUTINE get_fext(NDDL0 ,NDDL ,IDDL ,NDOF ,IKC ,
5214 1 INLOC ,LB ,FEXT ,AC ,ACR )
5215C-----------------------------------------------
5216C I m p l i c i t T y p e s
5217C-----------------------------------------------
5218#include "implicit_f.inc"
5219C-----------------------------------------------
5220C C o m m o n B l o c k s
5221C-----------------------------------------------
5222#include "com01_c.inc"
5223#include "com08_c.inc"
5224C-----------------------------------------------
5225C D u m m y A r g u m e n t s
5226C-----------------------------------------------
5227 INTEGER NDDL0 ,NDDL ,IDDL(*),NDOF(*),IKC(*),INLOC(*)
5228 my_real
5229 . lb(*),fext(*),ac(*),acr(*)
5230C-----------------------------------------------
5231C L o c a l V a r i a b l e s
5232C-----------------------------------------------
5233 INTEGER I,J
5234 my_real
5235 . bfac,ntmp
5236C-----------------------------------------------
5237 IF (abs(tt)<em20) RETURN
5238 bfac=tstop/tt
5239 IF (nspmd>1) THEN
5240C -------------------------------
5241 ntmp = 0
5242 DO i=1,nddl0
5243 fext(i)=lb(i)
5244 ENDDO
5245 CALL imp_setba(ac ,acr ,iddl ,ndof ,fext ,
5246 1 ntmp )
5247 CALL condens_b(nddl0 ,ikc ,fext)
5248 CALL spmd_sumf_v(fext)
5249 CALL imp_setbp(ac ,acr ,iddl ,ndof ,ikc ,
5250 . inloc ,fext )
5251 DO i=1,nddl
5252 fext(i)=bfac*fext(i)
5253 ENDDO
5254 ELSE
5255 DO i=1,nddl0
5256 fext(i)=bfac*lb(i)
5257 ENDDO
5258 CALL condens_b(nddl0 ,ikc ,fext )
5259 END IF
5260C------------------------------------------
5261 RETURN
5262 END
5263!||====================================================================
5264!|| re2int5 ../engine/source/implicit/imp_solv.F
5265!||--- called by ------------------------------------------------------
5266!|| resol ../engine/source/engine/resol.F
5267!||====================================================================
5268 SUBROUTINE re2int5(NT_IMP,NUMIMP,NS_IMP,NE_IMP,NUMIMPL,
5269 1 IPARI ,NT_IMP0)
5270C-----------------------------------------------
5271C I m p l i c i t T y p e s
5272C-----------------------------------------------
5273#include "implicit_f.inc"
5274C-----------------------------------------------
5275C C o m m o n B l o c k s
5276C-----------------------------------------------
5277#include "com04_c.inc"
5278#include "task_c.inc"
5279#include "param_c.inc"
5280C-----------------------------------------------
5281C D u m m y A r g u m e n t s
5282C-----------------------------------------------
5283 INTEGER NT_IMP,NUMIMP(*),NS_IMP(*),NE_IMP(*),
5284 . NUMIMPL(NINTER,*),IPARI(NPARI,*),NT_IMP0
5285C-----------------------------------------------
5286C L o c a l V a r i a b l e s
5287C-----------------------------------------------
5288 INTEGER I,J,K,L,N,IAD,IAD1,IADT,ITY,L_CP,L_CPJ,NIMPJ,
5289 . iadn(nthread)
5290 INTEGER, DIMENSION(:),ALLOCATABLE :: NS_CP,NE_CP
5291 INTEGER IER1
5292C-----------------------------------------------
5293C S o u r c e L i n e s
5294C-----------------------------------------------
5295C-----------------------------------------
5296 nt_imp = 0
5297 iadt = 0
5298 l_cpj = 0
5299 DO j = 1,nthread
5300 nimpj = iadt
5301 DO n = 1,ninter
5302 ity =ipari(7,n)
5303 IF (ity==3.OR.ity==4.OR.ity==5) THEN
5304 numimp(n)=0
5305 iadt =iadt + numimpl(n,j)
5306 END IF
5307 END DO
5308 nimpj = -nimpj+iadt
5309 l_cpj = max(l_cpj,nimpj)
5310 END DO
5311 IF (iadt==0) RETURN
5312C
5313 IF (nthread==1) THEN
5314 DO n = 1,ninter
5315 numimp(n) =numimpl(n,1)
5316 END DO
5317 ELSE
5318 l_cp = l_cpj*nthread
5319 ALLOCATE(ns_cp(l_cp),ne_cp(l_cp),stat=ier1)
5320C
5321 iad=0
5322 DO j = 1,nthread
5323 iad1=(j-1)*nt_imp0
5324 DO i = 1,l_cpj
5325 ns_cp(iad+i) = ns_imp(iad1+i)
5326 ne_cp(iad+i) = ne_imp(iad1+i)
5327 END DO
5328 iad =iad + l_cpj
5329 iadn(j) =0
5330 END DO
5331C
5332 iad = 0
5333 DO n = 1,ninter
5334 ity =ipari(7,n)
5335 numimp(n)=0
5336 IF (ity==3.OR.ity==4.OR.ity==5) THEN
5337 DO j = 1,nthread
5338 iad1=(j-1)*l_cp/ nthread + iadn(j)
5339 DO i = 1,numimpl(n,j)
5340 ns_imp(iad+i) = ns_cp(iad1+i)
5341 ne_imp(iad+i) = ne_cp(iad1+i)
5342 END DO
5343 iad =iad + numimpl(n,j)
5344 numimp(n) = numimp(n)+numimpl(n,j)
5345 iadn(j) = iadn(j) + numimpl(n,j)
5346C-------reput zero
5347 numimpl(n,j)=0
5348 END DO
5349 END IF
5350 END DO
5351 DEALLOCATE(ns_cp,ne_cp)
5352 END IF !(NTHREAD==1) THEN
5353C
5354 nt_imp = nt_imp + iadt
5355C
5356 RETURN
5357 END
5358!||====================================================================
5359!|| re2int7 ../engine/source/implicit/imp_solv.F
5360!||--- called by ------------------------------------------------------
5361!|| resol ../engine/source/engine/resol.F
5362!||--- calls -----------------------------------------------------
5363!|| imp_stif24 ../engine/source/implicit/imp_solv.F
5364!||====================================================================
5365 SUBROUTINE re2int7(NT_IMP,NUMIMP,NS_IMP,NE_IMP,IND_IMP,
5366 1 NUMIMPL,IPARI,NT_IMP0)
5367C-----------------------------------------------
5368C I m p l i c i t T y p e s
5369C-----------------------------------------------
5370#include "implicit_f.inc"
5371C-----------------------------------------------
5372C C o m m o n B l o c k s
5373C-----------------------------------------------
5374#include "com04_c.inc"
5375#include "task_c.inc"
5376#include "param_c.inc"
5377C-----------------------------------------------
5378C D u m m y A r g u m e n t s
5379C-----------------------------------------------
5380 INTEGER NT_IMP,NUMIMP(*),NS_IMP(*),NE_IMP(*),IND_IMP(*),
5381 . numimpl(ninter,*),ipari(npari,*),nt_imp0
5382C-----------------------------------------------
5383C L o c a l V a r i a b l e s
5384C-----------------------------------------------
5385 INTEGER I,J,K,L,N,IAD,IAD1,IADT,ITY,IAD0,L_CP,L_CPJ,NIMPJ,
5386 . nt_imp7,iadn(nthread)
5387 INTEGER, DIMENSION(:),ALLOCATABLE :: NS_CP,NE_CP,IND_CP
5388 INTEGER IER1
5389C-----------------------------------------------
5390C S o u r c e L i n e s
5391C-----------------------------------------------
5392 iadt = 0
5393 l_cpj = 0
5394 DO j = 1,nthread
5395 nimpj = iadt
5396 DO n = 1,ninter
5397 ity =ipari(7,n)
5398 IF (ity==7.OR.ity==10.OR.ity==11.OR.ity==24) THEN
5399 numimp(n)=0
5400 iadt =iadt + numimpl(n,j)
5401 END IF
5402 END DO
5403 nimpj = -nimpj+iadt
5404 l_cpj = max(l_cpj,nimpj)
5405 END DO
5406 IF (iadt==0) GOTO 100
5407
5408 IF (nthread==1) THEN
5409 DO n = 1,ninter
5410 numimp(n) =numimpl(n,1)
5411 END DO
5412 ELSE
5413 l_cp = l_cpj*nthread
5414 ALLOCATE(ns_cp(l_cp),ne_cp(l_cp),ind_cp(l_cp),stat=ier1)
5415
5416 iad0=nt_imp
5417 nt_imp7=nt_imp0-nt_imp
5418 iad =0
5419 DO j = 1,nthread
5420 iad1=iad0+(j-1)*nt_imp7
5421 DO i = 1,l_cpj
5422 ns_cp(iad+i) = ns_imp(iad1+i)
5423 ne_cp(iad+i) = ne_imp(iad1+i)
5424 ind_cp(iad+i) = ind_imp(iad1+i)
5425 END DO
5426 iad =iad + l_cpj
5427 iadn(j) =0
5428 END DO
5429
5430 iad = iad0
5431 DO n = 1,ninter
5432 ity =ipari(7,n)
5433 IF (ity==7.OR.ity==10.OR.ity==11.OR.ity==24) THEN
5434 DO j = 1,nthread
5435 iad1=(j-1)*l_cp/ nthread + iadn(j)
5436 DO i = 1,numimpl(n,j)
5437 ns_imp(iad+i) = ns_cp(iad1+i)
5438 ne_imp(iad+i) = ne_cp(iad1+i)
5439 ind_imp(iad+i) = ind_cp(iad1+i)
5440 END DO
5441 iad =iad + numimpl(n,j)
5442 numimp(n) = numimp(n)+numimpl(n,j)
5443 iadn(j) = iadn(j) + numimpl(n,j)
5444C ----reput zero
5445 numimpl(n,j)=0
5446 END DO
5447 END IF
5448 END DO
5449 DEALLOCATE(ns_cp,ne_cp,ind_cp)
5450 END IF !(NTHREAD==1) THEN
5451C
5452 nt_imp = nt_imp + iadt
5453C-------int24, Istif=6
5454 100 CONTINUE
5455 CALL imp_stif24(numimp ,ipari )
5456 RETURN
5457 END
5458!||====================================================================
5459!|| du_ini ../engine/source/implicit/imp_solv.F
5460!||--- uses -----------------------------------------------------
5461!|| imp_dyna ../engine/share/modules/impbufdef_mod.F
5462!||====================================================================
5463 SUBROUTINE du_ini(NODFT ,NODLT ,DN ,DNR ,DD ,
5464 1 DDR ,IDIV ,ICONT0 )
5465C-----------------------------------------------
5466C M o d u l e s
5467C-----------------------------------------------
5468 USE imp_dyna
5469C-----------------------------------------------
5470C I m p l i c i t T y p e s
5471C-----------------------------------------------
5472#include "implicit_f.inc"
5473C-----------------------------------------------
5474C C o m m o n B l o c k s
5475C-----------------------------------------------
5476#include "impl1_c.inc"
5477#include "impl2_c.inc"
5478#include "com01_c.inc"
5479C-----------------------------------------------
5480C D u m m y A r g u m e n t s
5481C-----------------------------------------------
5482 INTEGER NODFT ,NODLT,IDIV ,ICONT0
5483 my_real
5484 . dn(3,*),dnr(3,*),dd(3,*),ddr(3,*)
5485C-----------------------------------------------
5486C L o c a l V a r i a b l e s
5487C-----------------------------------------------
5488 INTEGER I,J,IRES
5489 my_real
5490 . bfac,bdt
5491C--------------Dn,0=Dn-1--------
5492C--------special case with /QSTAT diverge by contact, restart w/o resolution
5493 ires = 1
5494 IF (iqstat >0 .AND. idiv==-2 .AND. icont0 >0 ) THEN
5495 idiv=-1
5496 ires=0
5497 END IF
5498C
5499 bfac=dt1_imp/dt0_imp
5500 IF (idyna==0) THEN
5501 IF (ismdisp>0.OR.ires==0) THEN
5502 DO i = nodft ,nodlt
5503 dd(1,i) = bfac*dn(1,i)
5504 dd(2,i) = bfac*dn(2,i)
5505 dd(3,i) = bfac*dn(3,i)
5506 END DO
5507 IF (iroddl/=0) THEN
5508 DO i = nodft ,nodlt
5509 ddr(1,i) = bfac*dnr(1,i)
5510 ddr(2,i) = bfac*dnr(2,i)
5511 ddr(3,i) = bfac*dnr(3,i)
5512 END DO
5513 END IF
5514 ELSE
5515 DO i = nodft ,nodlt
5516 dd(1,i) = dn(1,i)
5517 dd(2,i) = dn(2,i)
5518 dd(3,i) = dn(3,i)
5519 ENDDO
5520 IF (iroddl/=0) THEN
5521 DO i = nodft ,nodlt
5522 ddr(1,i) = dnr(1,i)
5523 ddr(2,i) = dnr(2,i)
5524 ddr(3,i) = dnr(3,i)
5525 ENDDO
5526 END IF
5527 END IF
5528 ELSE
5529 bdt = half*dt0_imp*dt0_imp*(one-two*dy_b)
5530 bdt = zero
5531 DO i = nodft ,nodlt
5532 dd(1,i) = bfac*dn(1,i)+bdt*dy_a(1,i)
5533 dd(2,i) = bfac*dn(2,i)+bdt*dy_a(2,i)
5534 dd(3,i) = bfac*dn(3,i)+bdt*dy_a(3,i)
5535 END DO
5536 IF (iroddl/=0) THEN
5537 DO i = nodft ,nodlt
5538 ddr(1,i) = bfac*dnr(1,i)+bdt*dy_ar(1,i)
5539 ddr(2,i) = bfac*dnr(2,i)+bdt*dy_ar(2,i)
5540 ddr(3,i) = bfac*dnr(3,i)+bdt*dy_ar(3,i)
5541 END DO
5542 END IF
5543 END IF
5544C------------------------------------------
5545 RETURN
5546 END
5547!||====================================================================
5548!|| pr_deb ../engine/source/implicit/imp_solv.F
5549!||--- uses -----------------------------------------------------
5550!|| imp_frk ../engine/share/modules/impbufdef_mod.f
5551!|| imp_intm ../engine/share/modules/imp_intm.F
5552!||====================================================================
5553 SUBROUTINE pr_deb(NDDL ,IDDL ,NDOF ,IKC ,ITAB ,
5554 1 DIAG_K,DIAG_M,INLOC ,FR_ELEM,IAD_ELEM,
5555 2 IADK ,JDIK ,LT_K ,LT_M ,NDDLI ,
5556 3 IADI ,JDII ,ITOK ,DIAG_I ,LT_I ,
5557 4 U ,F ,IT ,NSREM ,NSL ,
5558 5 D ,DR ,IFLAG ,W_DDL ,FEXT ,
5559 6 MEXT ,FINT ,MINT ,R01 ,NDEB ,NODGLOB)
5560C-----------------------------------------------
5561C M o d u l e s
5562C-----------------------------------------------
5563 USE imp_frk
5564 USE imp_intm
5565C-----------------------------------------------
5566C I m p l i c i t T y p e s
5567C-----------------------------------------------
5568#include "implicit_f.inc"
5569C-----------------------------------------------
5570C C o m m o n B l o c k s
5571C-----------------------------------------------
5572#include "com01_c.inc"
5573#include "com04_c.inc"
5574#include "task_c.inc"
5575#include "impl1_c.inc"
5576C-----------------------------------------------
5577C D u m m y A r g u m e n t s
5578C-----------------------------------------------
5579C REAL
5580 INTEGER NDDL ,IDDL(*) ,NDOF(*) ,IKC(*) ,ITAB(*),IFLAG,
5581 . fr_elem(*),iad_elem(2,*),inloc(*),iadk(*),jdik(*),nodglob(*),
5582 . nddli,iadi(*),jdii(*),itok(*),it,nsrem ,nsl,w_ddl(*),ndeb
5583 my_real
5584 . diag_k(*),diag_m(*),lt_k(*),lt_m(*) ,diag_i(*),lt_i(*),
5585 . u(*),f(*),d(3,*),dr(3,*),fext(3,*),mext(3,*),fint(3,*),
5586 . r01 ,mint(3,*),vq(3,3)
5587C-----------------------------------------------
5588c FUNCTION: print-out selected values in function of Ifalg
5589c
5590c Note:
5591c ARGUMENTS: (I: input, O: output, IO: input * output, W: workspace)
5592c
5593c TYPE NAME FUNCTION
5594c I NDDL,NDOF(N) - num. of total DOF after condensation; Num of DOF of node N
5595c I IDDL(N) - ID of DOF (before condensation) num of node N: IDDL(N)+1,NDOF(N)
5596c I IKC(NDDL0) - different independent dof, IKC()=0-> independent dof
5597c I ITAB(N) - user's node id
5598c I IADK(NDDL+1),JDIK(NNZ)-indices of assemblaged [K] of compressed format
5599c I DIAG_K(NDDL),LT_K(NNZ)-diag_[K] and compressed non zero strick trianluar [K]
5600c I IADM(NDDL+1),JDIM(NNZ)-same than [K], [M]: preconditioner matrix used for PCG only
5601c I DIAG_M(NDDL),LT_M(NNZ)-
5602c I IADI(NDDLI+1),JDII(NNZI)-indices of local [K_i] of contact spring
5603c I ITOK(NDDLI),DIAG_I(NDDL),LT_I(NNZ)- indice from local to glocal [K]
5604c I NSREM ,NSL -remote SECONDARY and local communated SECONDARY node number (due to // contact)
5605c I U(NDDL),F(NDDL) - U not available, F-> force Residual {Fext}-{Fint}
5606c I IT -nonlinear iteration number
5607c I D,DR(3,NUMNOD) -nodal displacement and rotation
5608c I IFLAG -print-out options ,see below
5609c I W_DDL -flag of physical presence of the boundary dof of diff. domains //
5610c I FEXT,MEXT(3,NUMNOD)- external nodal forces and moments
5611c I FINT,MINT(3,NUMNOD)- internal nodal forces and moments
5612c I R01 -force residual norm
5613c I Ndeb begin of debugging No of cycle.
5614C-----------------------------------------------
5615C L o c a l V a r i a b l e s
5616C-----------------------------------------------
5617Ctmp +3
5618 INTEGER i,j,N,ID,ND,IDDLM(NUMNOD),NKC,IDF,nnod,nk,iad,iad2,id2,
5619 . IDDL_FRONT(NDDL),ID2N(NUMNOD),NKFRONT,INOD,K,NN,II,
5620 . IDDL_FRONT1(NSPMD,NDDL),ITAG(2,NSPMD),INDEX,ILOC,JJ,KK
5621 CHARACTER CHIF
5622 CHARACTER*9 FILNAME
5623 my_real
5624 . s_max,xl,yl,zl
5625C------iflag=1 ->U,F;iflag=2 ->+ [ki];iflag=3 ->+ [k];--iflag=4 ->+[m];
5626 IDF = ispmd+11
5627 WRITE(chif,'(I1)')ispmd
5628 filname='DEB'//chif//'.TMP'
5629 OPEN(unit=idf,file=filname,status='UNKNOWN',form='FORMATTED')
5630 write(idf,*)'NCYCLE,IT,NUMNOD,NDDL=',ncycle,it,numnod,nddl
5631 write(idf,*)'NDDLI,NSREM,NSL,IMCONV,NDEB=', nddli,nsrem ,nsl,
5632 . imconv,ndeb
5633 if (imconv==-1.and.(nsrem +nsl)==0) then
5634 return
5635 end if
5636 write(idf,*)'R01=',r01
5637c write(IDF,*)'nddlfr=',nddlfr
5638 if (ncycle==(ndeb+1).AND.it==0.AND.imconv>=0) then
5639 nkc=0
5640 DO n =1,numnod
5641 i=inloc(n)
5642 iddlm(i)=iddl(i)-nkc
5643 DO j=1,ndof(i)
5644 nd = iddl(i)+j
5645 IF (ikc(nd)/=0) nkc = nkc + 1
5646 ENDDO
5647c if (NDOF(I)/=0)
5648 write(idf,*)'I,ITAB,NDOF,IDDLM=',i,itab(i),ndof(i),
5649 . iddlm(i),nodglob(i)
5650 ENDDO
5651 endif
5652c if (NSPMD==1) then
5653c I = 849965
5654 ii=0
5655 s_max=zero
5656 nn =0
5657 k=0
5658 nkc=0
5659 DO n =1,numnod
5660 i=inloc(n)
5661 iddlm(i)=iddl(i)-nkc
5662 jj=0
5663 DO j=1,ndof(i)
5664 nd = iddl(i)+j
5665 IF (ikc(nd)/=0) THEN
5666 nkc = nkc + 1
5667 ELSE
5668 jj = jj + 1
5669 id =iddlm(i) + jj
5670 id2n(id)=i
5671 write(idf,*)'DIAG_K,F,N,id=',diag_k(id),f(id),itab(i),id
5672 if (abs(f(id))>s_max) THEN
5673 s_max= abs(f(id))
5674 ii = id
5675 nn = i
5676 k=j
5677 endif
5678 END IF
5679 ENDDO
5680 ENDDO
5681 if (nn>0) write(idf,*)'MAX_F,N,J=',f(ii),itab(nn),k
5682c DO N =1,NDDL
5683c I = ITOK(N)
5684c I = N
5685c write(IDF,*),'NC,DIAG_k,DIAG_M=',
5686c . IADK(I+1)-IADK(I),DIAG_K(I),DIAG_M(I)
5687c write(IDF,*)'DIAG_K,F(I)=',DIAG_K(I),F(I),I
5688c if (abs(f(i))>S_MAX) THEN
5689c S_MAX= abs(f(i))
5690c II = I
5691c endif
5692c ENDDO
5693c write(IDF,*)'MAX_F=',F(II),II
5694 if (iflag>1) then
5695 DO n =1,numnod
5696 i=inloc(n)
5697 write(idf,*)'FEXT,MEXT,I,ITAB=',i,itab(i)
5698 write(idf,*)fext(1,i),fext(2,i),fext(3,i)
5699 IF (iroddl/=0)write(idf,*)mext(1,i),mext(2,i),mext(3,i)
5700 ENDDO
5701 DO n =1,numnod
5702 i=inloc(n)
5703 write(idf,*)'FINT,MINT,I,ITAB=',i,itab(i)
5704 write(idf,*)fint(1,i),fint(2,i),fint(3,i)
5705c IF (IRODDL/=0)write(IDF,*)MINT(1,I),MINT(2,I),MINT(3,I)
5706c XL = VQ(1,1)*FINT(1,I)+ VQ(1,2)*FINT(2,I)+VQ(1,3)*FINT(3,I)
5707c YL = VQ(2,1)*FINT(1,I)+ VQ(2,2)*FINT(2,I)+VQ(2,3)*FINT(3,I)
5708c ZL = VQ(3,1)*FINT(1,I)+ VQ(3,2)*FINT(2,I)+VQ(3,3)*FINT(3,I)
5709c write(IDF,*)'FINT,local=',I,ITAB(I)
5710c write(IDF,*)XL,YL,ZL
5711 ENDDO
5712 endif
5713 if (iflag>=1) then
5714 DO n =1,numnod
5715 i=inloc(n)
5716c if (NDOF(I)/=0) then
5717 write(idf,*)'D,DR,I,ITAB=',i,itab(i)
5718 write(idf,*)d(1,i),d(2,i),d(3,i)
5719 IF (iroddl/=0)write(idf,*)dr(1,i),dr(2,i),dr(3,i)
5720c end if !(NDOF(I)/=0) then
5721 ENDDO
5722 endif
5723 if (nspmd>1) then
5724C
5725 IF (intp_d>0) THEN
5726 write(idf,*)'NDDL_SL,NDDL_SI=',nddl_sl,nddl_si
5727 DO i=1,nsl
5728 n=isl(i)
5729 write (idf,*)'ns,i=',N,ITAB(N),I
5730 END DO
5731 DO I=1,NDDL_SL
5732 ID=IDDL_SL(I)
5733 write(IDF,*)'id,diag_sl=',ID,DIAG_SL(I)
5734 END DO
5735 DO I=1,NDDL_SL
5736 DO J = IAD_SS(I), IAD_SS(I+1)-1
5737 write(IDF,*)'lt_sl,nj,j=',LT_SL(J),JDI_SL(J),J
5738 END DO
5739 END DO
5740 write (IDF,*)'nddl_si=',NDDL_SI
5741 DO I=1,NDDL_SI
5742 DO J = IAD_SI(I), IAD_SI(I+1)-1
5743 write(IDF,*)'lt_si,nj,j=',LT_SI(J),JDI_SI(J),J
5744 END DO
5745 END DO
5746 ELSE
5747 DO I=1,NSL
5748 N=ISL(I)
5749 DO J=1,MIN(3,NDOF(N))
5750 ID = IDDSL(J,I)
5751 IF (ID>0) write(IDF,*)'id,diag_sl=',ID,DIAG_S(J,I)
5752 END DO
5753 write (IDF,*)'ns,i=',N,I
5754 END DO
5755 END IF
5756 IAD = 0
5757 IAD2 = 0
5758 write(IDF,*)'len_k,len_v=',LEN_K,LEN_V
5759 DO I =1,NSPMD
5760 NKC=0
5761 DO NK=IAD_ELEM(1,I),IAD_ELEM(1,I+1)-1
5762 N=FR_ELEM(NK)
5763 ND=0
5764 write(IDF,*)'n,itab,iddlfr,ip=',N,ITAB(N),IDDLFR(NK),I
5765 DO J=1,NDOF(N)
5766 IF (IKC(IDDL(N)+J)<1) THEN
5767c ND=ND+1
5768 ID=IDDLFR(NK)+IAD-NKC+J
5769 ID2=IDDLFR(NK)+IAD2-NKC+J
5770 write(IDF,*)
5771 . 'fr_id,id2,id2k,nc=',ID,id2,IFR2K(id2),IADFR(ID+1)-IADFR(ID)
5772 IF (IADFR(ID+1)<IADFR(ID)) write(IDF,*)IADFR(ID+1),IADFR(ID)
5773 ELSE
5774 NKC=NKC+1
5775 ENDIF
5776 ENDDO
5777 ENDDO
5778 IAD = IAD + ND_FR(I) + 1
5779 IAD2 = IAD2 + ND_FR(I)
5780 ENDDO
5781 endif
5782 if (iflag>=1) then
5783 write(IDF,*)'[ki]=',NDDLI
5784 DO I =1,NDDLI
5785 N=ID2N(ITOK(I))
5786 write(IDF,*)'diag_i,itok,n=',DIAG_I(I),ITOK(I),ITAB(N)
5787 ENDDO
5788 DO I =1,NDDLI
5789 N=ID2N(ITOK(I))
5790 write(IDF,*)'nr,i(itok),n=',IADI(I+1)-IADI(I),ITOK(I),ITAB(N)
5791 DO J=IADI(I),IADI(I+1)-1
5792 N=ID2N(ITOK(JDII(J)))
5793 write(IDF,*)'lt_i,_id_nj,nj,j=',LT_I(J),ITOK(JDII(J)),ITAB(N),J
5794 ENDDO
5795 ENDDO
5796 endif
5797 if (iflag>1) then
5798 write(IDF,*)'lt_[k]=',NDDL
5799 DO I =1,NDDL
5800 write(IDF,*)'nr,i=',IADK(I+1)-IADK(I),I
5801 DO J=IADK(I),IADK(I+1)-1
5802 write(IDF,*)'lt_k,nj,j=',LT_K(J),JDIK(J),J
5803 ENDDO
5804 ENDDO
5805 endif
5806C------------------------------------------
5807 RETURN
5808 END
5809!||====================================================================
5810!|| pr_matrix ../engine/source/implicit/imp_solv.F
5811!||--- uses -----------------------------------------------------
5812!|| imp_frk ../engine/share/modules/impbufdef_mod.F
5813!||====================================================================
5814 SUBROUTINE PR_MATRIX(NDDL ,IDDL ,NDOF ,IKC ,ITAB ,
5815 1 DIAG_K,DIAG_M,INLOC ,FR_ELEM,IAD_ELEM,
5816 2 IADK ,JDIK ,LT_K ,LT_M ,NDDLI ,
5817 3 IADI ,JDII ,ITOK ,DIAG_I ,LT_I ,
5818 4 IFLAG ,it )
5819C-----------------------------------------------
5820C M o d u l e s
5821C-----------------------------------------------
5822 USE IMP_FRK
5823C-----------------------------------------------
5824C I m p l i c i t T y p e s
5825C-----------------------------------------------
5826#include "implicit_f.inc"
5827C-----------------------------------------------
5828C C o m m o n B l o c k s
5829C-----------------------------------------------
5830#include "com01_c.inc"
5831#include "com04_c.inc"
5832#include "task_c.inc"
5833#include "impl1_c.inc"
5834C-----------------------------------------------
5835C D u m m y A r g u m e n t s
5836C-----------------------------------------------
5837C REAL
5838 INTEGER NDDL ,IDDL(*) ,NDOF(*) ,IKC(*) ,ITAB(*),IFLAG,
5839 . FR_ELEM(*),IAD_ELEM(2,*),INLOC(*),IADK(*),JDIK(*),
5840 . NDDLI,IADI(*),JDII(*),ITOK(*),it
5841 my_real
5842 . DIAG_K(*),DIAG_M(*),LT_K(*),LT_M(*) ,DIAG_I(*),LT_I(*)
5843C-----------------------------------------------
5844C L o c a l V a r i a b l e s
5845C-----------------------------------------------
5846Ctmp +3
5847 INTEGER i,j,N,ID,ND,IDDLM(NUMNOD),NKC,IDF,nnod,nk,iad,iad2,id2,
5848 . NKFRONT,INOD,K,NN,II,INDEX,ILOC,JJ,KK
5849 CHARACTER CHIF
5850 CHARACTER*9 FILNAME
5851 my_real
5852 . s_max,xl,yl,zl
5853C------
5854 IDF = ispmd+15
5855 WRITE(CHIF,'(i1)')ispmd
5856 FILNAME='mat'//CHIF//'.tmp'
5857 OPEN(UNIT=IDF,FILE=FILNAME,STATUS='unknown',FORM='formatted')
5858 write(IDF,*)'ncycle,numnod,nddl,ndi=',NCYCLE,NUMNOD,NDDL,NDDLI
5859 if (IMCONV<0) return
5860c write(IDF,*)'nddlfr=',nddlfr
5861 if (NCYCLE==1) then
5862 NKC=0
5863 DO N =1,NUMNOD
5864 I=INLOC(N)
5865 IDDLM(I)=IDDL(I)-NKC
5866 DO J=1,NDOF(I)
5867 ND = IDDL(I)+J
5868 IF (IKC(ND)/=0) NKC = NKC + 1
5869 ENDDO
5870 if (NDOF(I)/=0)
5871 . write(IDF,*)'i,itab,ndof,iddl=',I,ITAB(I),NDOF(I),
5872 . IDDL(I)
5873 ENDDO
5874 endif
5875 DO N =1,NDDL
5876 I = N
5877c write(IDF,*),'NC,DIAG_k,DIAG_M=',
5878c . IADK(I+1)-IADK(I),DIAG_K(I),DIAG_M(I)
5879 write(IDF,*)'diag_k,diag_m=',DIAG_K(I),DIAG_M(I),I
5880 ENDDO
5881 if (NSPMD>1) then
5882C
5883 IAD = 0
5884 IAD2 = 0
5885 write(IDF,*)'len_k,len_v=',LEN_K,LEN_V
5886 DO I =1,NSPMD
5887 NKC=0
5888 DO NK=IAD_ELEM(1,I),IAD_ELEM(1,I+1)-1
5889 N=FR_ELEM(NK)
5890 ND=0
5891 write(IDF,*)'n,itab,iddlfr,ip=',N,ITAB(N),IDDLFR(NK),I
5892 DO J=1,NDOF(N)
5893 IF (IKC(IDDL(N)+J)<1) THEN
5894c ND=ND+1
5895 ID=IDDLFR(NK)+IAD-NKC+J
5896 ID2=IDDLFR(NK)+IAD2-NKC+J
5897 write(IDF,*)
5898 . 'fr_id,id2,id2k,nc=',ID,id2,IFR2K(id2),IADFR(ID+1)-IADFR(ID)
5899 IF (IADFR(ID+1)<IADFR(ID)) write(IDF,*)IADFR(ID+1),IADFR(ID)
5900 ELSE
5901 NKC=NKC+1
5902 ENDIF
5903 ENDDO
5904 ENDDO
5905 IAD = IAD + ND_FR(I) + 1
5906 IAD2 = IAD2 + ND_FR(I)
5907 ENDDO
5908 endif
5909.AND. if (NDDLI>0IFLAG>0) then
5910 write(IDF,*)'[ki]=',nddli
5911 DO i =1,nddli
5912 write(idf,*)'DIAG_I,itok=',diag_i(i),itok(i)
5913 ENDDO
5914 DO i =1,nddli
5915 write(idf,*)'NR,I=',iadi(i+1)-iadi(i),i
5916 DO j=iadi(i),iadi(i+1)-1
5917 write(idf,*)'LT_I,NJ,J=',lt_i(j),itok(jdii(j)),j
5918 ENDDO
5919 ENDDO
5920 endif
5921 if (nddl>1.and.iflag>1) then
5922 write(idf,*)'LT_[K]=',nddl
5923 DO i =1,nddl
5924 write(idf,*)'NR,I=',iadk(i+1)-iadk(i),i
5925 DO j=iadk(i),iadk(i+1)-1
5926 write(idf,*)'LT_K,NJ,J=',lt_k(j),jdik(j),j
5927 ENDDO
5928 ENDDO
5929 if (iflag>1) then
5930 write(idf,*)'LT_[M]=',nddl
5931 DO i =1,nddl
5932 write(idf,*)'NR,I=',iadk(i+1)-iadk(i),i
5933 DO j=iadk(i),iadk(i+1)-1
5934 write(idf,*)'LT_M,NJ,J=',lt_m(j),jdik(j),j
5935 ENDDO
5936 ENDDO
5937 endif !(IFLAG>1) then
5938 endif
5939C------------------------------------------
5940 RETURN
5941 END
5942!||====================================================================
5943!|| pr_solnfo ../engine/source/implicit/imp_solv.F
5944!||--- called by ------------------------------------------------------
5945!|| imp_solv ../engine/source/implicit/imp_solv.F
5946!||--- calls -----------------------------------------------------
5947!|| spmd_max_f ../engine/source/mpi/implicit/imp_spmd.F
5948!||--- uses -----------------------------------------------------
5949!|| imp_frk ../engine/share/modules/impbufdef_mod.F
5950!|| imp_intm ../engine/share/modules/imp_intm.F
5951!||====================================================================
5952 SUBROUTINE pr_solnfo(NDDL ,IDDL ,NDOF ,IKC ,ITAB ,
5953 1 DIAG_K,DIAG_M,INLOC ,FR_ELEM,IAD_ELEM,
5954 2 IADK ,JDIK ,LT_K ,LT_M ,NDDLI ,
5955 3 IADI ,JDII ,ITOK ,DIAG_I ,LT_I ,
5956 4 U ,F ,IT ,NSREM ,NSL ,
5957 5 D ,DR ,IFLAG ,W_DDL ,FEXT ,
5958 6 MEXT ,FINT ,MINT ,R01 ,NDEB ,
5959 7 R_IMP ,I_IMP ,DD ,DDR)
5960C-----------------------------------------------
5961C M o d u l e s
5962C-----------------------------------------------
5963 USE imp_frk
5964 USE imp_intm
5965C-----------------------------------------------
5966C I m p l i c i t T y p e s
5967C-----------------------------------------------
5968#include "implicit_f.inc"
5969C-----------------------------------------------
5970C C o m m o n B l o c k s
5971C-----------------------------------------------
5972#include "com01_c.inc"
5973#include "com04_c.inc"
5974#include "com08_c.inc"
5975#include "task_c.inc"
5976#include "impl1_c.inc"
5977#include "impl2_c.inc"
5978C-----------------------------------------------
5979C D u m m y A r g u m e n t s
5980C-----------------------------------------------
5981C REAL
5982 INTEGER NDDL ,IDDL(*) ,NDOF(*) ,IKC(*) ,ITAB(*),IFLAG,
5983 . fr_elem(*),iad_elem(2,*),inloc(*),iadk(*),jdik(*),
5984 . nddli,iadi(*),jdii(*),itok(*),it,nsrem ,nsl,w_ddl(*),
5985 . ndeb,i_imp(*)
5986 my_real
5987 . diag_k(*),diag_m(*),lt_k(*),lt_m(*) ,diag_i(*),lt_i(*),
5988 . u(*),f(*),d(3,*),dr(3,*),fext(3,*),mext(3,*),fint(3,*),
5989 . r01 ,mint(3,*),vq(3,3),r_imp(*),dd(3,*),ddr(3,*)
5990C-----------------------------------------------
5991c FUNCTION: print-out solver info such as maximum residual, relative residuals, line-search coefficient, tolerance
5992C-----------------------------------------------
5993C L o c a l V a r i a b l e s
5994C-----------------------------------------------
5995 INTEGER I,J,N,ID,ND,IDDLM(NUMNOD),NKC,IDF,NNOD,NK,IAD,IAD2,
5996 . iddl_front(nddl),id2n(numnod),nkfront,inod,id2,cumul_it,
5997 . iddl_front1(nspmd,nddl),itag(2,nspmd),index,iloc,jj,kk,
5998 . k,k2,k3,kr,k2r,k3r,nn,nn2,nn3,nnr,nn2r,nn3r,ii,iir,ii2,
5999 . itabmax,irtabmax,itabmax2,irtabmax2,itabmax3,irtabmax3
6000 my_real
6001 . f_max,fr_max,d_max,dr_max,dd_max,ddr_max,
6002 . fmax,frmax,dmax,drmax,ddmax,ddrmax,tole,tolf,tolu
6003 CHARACTER NODEID*10,FILNAM*100
6004c if (IMCONV==-1.and.(NSREM +NSL)==0) then
6005c return
6006c end if
6007c if (NCYCLE==(NDEB+1).AND.IT==0.AND.IMCONV>=0) then
6008c NKC=0
6009c DO N =1,NUMNOD
6010c I=INLOC(N)
6011c IDDLM(I)=IDDL(I)-NKC
6012c DO J=1,NDOF(I)
6013c ND = IDDL(I)+J
6014c IF (IKC(ND)/=0) NKC = NKC + 1
6015c ENDDO
6016c ENDDO
6017c endif
6018 ii=0
6019 iir=0
6020 f_max=zero
6021 fr_max=zero
6022 d_max=zero
6023 dr_max=zero
6024 dd_max=zero
6025 ddr_max=zero
6026 fmax=zero
6027 frmax=zero
6028 dmax=zero
6029 drmax=zero
6030 ddmax=zero
6031 ddrmax=zero
6032 nn=0
6033 nn2=0
6034 nn3=0
6035 k=0
6036 k2=0
6037 k3=0
6038 nnr=0
6039 nn2r=0
6040 nn3r=0
6041 kr=0
6042 k2r=0
6043 k3r=0
6044 nkc=0
6045 DO n =1,numnod
6046 i=inloc(n)
6047 iddlm(i)=iddl(i)-nkc
6048 jj=0
6049 DO j=1,ndof(i)
6050 nd = iddl(i)+j
6051 IF (ikc(nd)/=0) THEN
6052 nkc = nkc + 1
6053 ELSE
6054 jj = jj + 1
6055 id =iddlm(i) + jj
6056 id2 = iddlm(i)
6057c ID2N(ID)=I
6058 IF (j < 4) THEN
6059 IF (abs(f(id))>f_max) THEN
6060 f_max= abs(f(id))
6061 ii = id
6062 nn = i
6063 k = j
6064 ENDIF
6065 IF (abs(d(j,i))>d_max) THEN
6066 d_max= abs(d(j,i))
6067 nn2 = i
6068 k2 = j
6069 ENDIF
6070 IF (abs(dd(j,i))>dd_max) THEN
6071 dd_max= abs(dd(j,i))
6072 nn3 = i
6073 k3 = j
6074 ENDIF
6075 ELSE
6076 IF (abs(f(id))>fr_max) THEN
6077 fr_max= abs(f(id))
6078 iir = id
6079 nnr = i
6080 kr = j
6081 ENDIF
6082 IF (abs(dr(j-3,i))>dr_max) THEN
6083 dr_max= abs(dr(j-3,i))
6084 nn2r = i
6085 k2r = j
6086 ENDIF
6087 IF (abs(ddr(j-3,i))>ddr_max) THEN
6088 ddr_max= abs(ddr(j-3,i))
6089 nn3r = i
6090 k3r = j
6091 ENDIF
6092 ENDIF
6093 ENDIF
6094 ENDDO
6095 ENDDO
6096 IF (ii /= 0) fmax = f(ii)
6097 itabmax = itab(nn)
6098 IF (iir /= 0) frmax = f(iir)
6099 irtabmax = itab(nnr)
6100 IF (nn2 /= 0) dmax = d(k2,nn2)
6101 itabmax2 = itab(nn2)
6102 IF (nn2r /= 0) drmax = dr(k2r-3,nn2r)
6103 irtabmax2 = itab(nn2r)
6104 IF (nn3 /= 0) ddmax = dd(k3,nn3)
6105 itabmax3 = itab(nn3)
6106 IF (nn3r /= 0) ddrmax = ddr(k3r-3,nn3r)
6107 irtabmax3 = itab(nn3r)
6108c Compute maximum value F(II) with several processes in SPMD
6109 IF (nspmd>1) THEN
6110 CALL spmd_max_f(fmax,itabmax,k)
6111 CALL spmd_max_f(dmax,itabmax2,k2)
6112 CALL spmd_max_f(ddmax,itabmax3,k3)
6113 CALL spmd_max_f(frmax,irtabmax,kr)
6114 CALL spmd_max_f(drmax,irtabmax2,k2r)
6115 CALL spmd_max_f(ddrmax,irtabmax3,k3r)
6116 END IF
6117c Write solver information
6118 IF (ispmd==0) THEN
6119 IF (it == zero) THEN
6120 WRITE(isolinfo,1667) ncycle
6121 ENDIF
6122 WRITE(isolinfo,1060) it
6123 WRITE(isolinfo,1066) fmax,itabmax,k
6124 WRITE(isolinfo,1064) dmax,itabmax2,k2
6125 WRITE(isolinfo,1062) ddmax,itabmax3,k3
6126 WRITE(isolinfo,1065) frmax,irtabmax,kr
6127 WRITE(isolinfo,1063) drmax,irtabmax2,k2r
6128 WRITE(isolinfo,1061) ddrmax,irtabmax3,k3r
6129 WRITE (nodeid,'(I10)') itabmax
6130 cumul_it = i_imp(1)+it
6131c Write monitor file
6132 IF (k==0) THEN
6133 WRITE(isolmntr,1160) cumul_it,0,' MaxResidualForce ',nodeid//' ',fmax
6134 ELSEIF (k==1) THEN
6135 WRITE(isolmntr,1160) cumul_it,0,' MaxResidualForce ',nodeid//'_X',fmax
6136 ELSEIF (k==2) THEN
6137 WRITE(isolmntr,1160) cumul_it,0,' MaxResidualForce ',nodeid//'_Y',fmax
6138 ELSEIF (k==3) THEN
6139 WRITE(isolmntr,1160) cumul_it,0,' MaxResidualForce ',nodeid//'_Z',fmax
6140 ENDIF
6141c WRITE (NODEID,'(I10)') ITABMAX2
6142c IF (K2==0) THEN
6143c WRITE(ISOLMNTR,1160) CUMUL_IT,0,' MaxIncrementDisp ',NODEID//' ',DMAX
6144c ELSEIF (K2==1) THEN
6145c WRITE(ISOLMNTR,1160) CUMUL_IT,0,' MaxIncrementDisp ',NODEID//'_X',DMAX
6146c ELSEIF (K2==2) THEN
6147c WRITE(ISOLMNTR,1160) CUMUL_IT,0,' MaxIncrementDisp ',NODEID//'_Y',DMAX
6148c ELSEIF (K2==3) THEN
6149c WRITE(ISOLMNTR,1160) CUMUL_IT,0,' MaxIncrementDisp ',NODEID//'_Z',DMAX
6150c ENDIF
6151 WRITE (nodeid,'(I10)') itabmax3
6152 IF (k3==0) THEN
6153 WRITE(isolmntr,1160) cumul_it,0,' MaxCorrectionDisp ',nodeid//' ',ddmax
6154 ELSEIF (k3==1) THEN
6155 WRITE(isolmntr,1160) cumul_it,0,' MaxCorrectionDisp ',nodeid//'_X',ddmax
6156 ELSEIF (k3==2) THEN
6157 WRITE(isolmntr,1160) cumul_it,0,' MaxCorrectionDisp ',nodeid//'_Y',ddmax
6158 ELSEIF (k3==3) THEN
6159 WRITE(isolmntr,1160) cumul_it,0,' MaxCorrectionDisp ',nodeid//'_Z',ddmax
6160 ENDIF
6161 WRITE (nodeid,'(I10)') irtabmax
6162 IF (kr==0) THEN
6163 WRITE(isolmntr,1160) cumul_it,0,' MaxResidualMoment ',nodeid//' ',frmax
6164 ELSEIF (kr==4) THEN
6165 WRITE(isolmntr,1160) cumul_it,0,' MaxResidualMoment ',nodeid//'_X',frmax
6166 ELSEIF (kr==5) THEN
6167 WRITE(isolmntr,1160) cumul_it,0,' MaxResidualMoment ',nodeid//'_Y',frmax
6168 ELSEIF (kr==6) THEN
6169 WRITE(isolmntr,1160) cumul_it,0,' MaxResidualMoment ',nodeid//'_Z',frmax
6170 ENDIF
6171c WRITE (NODEID,'(I10)') IRTABMAX2
6172c IF (K2R==0) THEN
6173c WRITE(ISOLMNTR,1160) CUMUL_IT,0,' MaxIncrementRota ',NODEID//' ',DRMAX
6174c ELSEIF (K2R==4) THEN
6175c WRITE(ISOLMNTR,1160) CUMUL_IT,0,' MaxIncrementRota ',NODEID//'_X',DRMAX
6176c ELSEIF (K2R==5) THEN
6177c WRITE(ISOLMNTR,1160) CUMUL_IT,0,' MaxIncrementRota ',NODEID//'_Y',DRMAX
6178c ELSEIF (K2R==6) THEN
6179c WRITE(ISOLMNTR,1160) CUMUL_IT,0,' MaxIncrementRota ',NODEID//'_Z',DRMAX
6180c ENDIF
6181 WRITE (nodeid,'(I10)') irtabmax3
6182 IF (k3r==0) THEN
6183 WRITE(isolmntr,1160) cumul_it,0,' MaxCorrectionRota ',nodeid//' ',ddrmax
6184 ELSEIF (k3r==4) THEN
6185 WRITE(isolmntr,1160) cumul_it,0,' MaxCorrectionRota ',nodeid//'_X',ddrmax
6186 ELSEIF (k3r==5) THEN
6187 WRITE(isolmntr,1160) cumul_it,0,' MaxCorrectionRota ',nodeid//'_Y',ddrmax
6188 ELSEIF (k3r==6) THEN
6189 WRITE(isolmntr,1160) cumul_it,0,' MaxCorrectionRota ',nodeid//'_Z',ddrmax
6190 ENDIF
6191 WRITE(nodeid,'(I10)') 0
6192 WRITE(isolmntr,1160) cumul_it,0,' NormResidualDisp ',nodeid//' ',r_imp(20)
6193 WRITE(isolmntr,1160) cumul_it,0,' NormResidualForce ',nodeid//' ',r_imp(21)
6194 WRITE(isolmntr,1160) cumul_it,0,' NormResidualEnergy',nodeid//' ',r_imp(22)
6195 WRITE(isolmntr,1160) cumul_it,0,' DimContactMatrix ',nodeid//' ',float(i_imp(13))
6196 WRITE(isolmntr,1160) cumul_it,0,' TimeStep ',nodeid//' ',dt2
6197C CALL MY_FLUSH(ISOLMNTR)
6198 CALL flush(isolmntr)
6199 IF (imconv == 1) THEN
6200 IF (nitol == 1) THEN
6201 WRITE(isolinfo,1067)
6202 ELSE IF (nitol == 2) THEN
6203 WRITE(isolinfo,1069)
6204 ELSE IF (nitol == 3) THEN
6205 WRITE(isolinfo,1071)
6206 ELSE IF (nitol == 12) THEN
6207 WRITE(isolinfo,1073)
6208 ELSE IF (nitol == 13) THEN
6209 WRITE(isolinfo,1075)
6210 ELSE IF (nitol == 23) THEN
6211 WRITE(isolinfo,1077)
6212 ELSE IF (nitol == 123) THEN
6213 WRITE(isolinfo,1079)
6214 END IF
6215 ELSE IF (imconv == -2) THEN
6216 IF (nitol == 1) THEN
6217 WRITE(isolinfo,1068)
6218 ELSE IF (nitol == 2) THEN
6219 WRITE(isolinfo,1070)
6220 ELSE IF (nitol == 3) THEN
6221 WRITE(isolinfo,1072)
6222 ELSE IF (nitol == 12) THEN
6223 WRITE(isolinfo,1074)
6224 ELSE IF (nitol == 13) THEN
6225 WRITE(isolinfo,1076)
6226 ELSE IF (nitol == 23) THEN
6227 WRITE(isolinfo,1078)
6228 ELSE IF (nitol == 123) THEN
6229 WRITE(isolinfo,1080)
6230 END IF
6231 ENDIF
6232 IF (nitol == 1) THEN
6233 tole = n_tol
6234 tolf = em02
6235 tolu = em02
6236 ELSE IF (nitol == 2) THEN
6237 tole = em03
6238 tolf = n_tol
6239 tolu = em02
6240 ELSE IF (nitol == 3) THEN
6241 tole = em03
6242 tolf = em02
6243 tolu = n_tol
6244 ELSE IF (nitol == 12) THEN
6245 tole = n_tole
6246 tolf = n_tolf
6247 tolu = em02
6248 ELSE IF (nitol == 13) THEN
6249 tole = n_tole
6250 tolf = em02
6251 tolu = n_tolu
6252 ELSE IF (nitol == 23) THEN
6253 tole = em03
6254 tolf = n_tolf
6255 tolu = n_tolu
6256 ELSE IF (nitol == 123) THEN
6257 tole = n_tole
6258 tolf = n_tolf
6259 tolu = n_tolu
6260 END IF
6261 IF (imconv == -1) THEN
6262c Nothing since line search not ended
6263 ELSEIF (imconv == 0) THEN
6264 WRITE(isolhist,1666)cumul_it+1,ncycle,it,r_imp(20),
6265 . r_imp(21),r_imp(22),tole,tolf,tolu,
6266 . zero,zero,tt,r_imp(9)
6267 ELSEIF (imconv == 1) THEN
6268c Converged step
6269 IF (idtc==3) THEN
6270 WRITE(isolhist,1668)cumul_it+1,ncycle,it,r_imp(20),
6271 . r_imp(21),r_imp(22),tole,tolf,tolu,
6272 . zero,zero,tt,r_imp(9),tt,r_imp(24)
6273 WRITE(isolhist,1668)cumul_it+1,ncycle,it,r_imp(20),
6274 . r_imp(21),r_imp(22),tole,tolf,tolu,
6275 . one,zero,tt,r_imp(9),tt,r_imp(24)
6276 WRITE(isolhist,1668)cumul_it+1,ncycle,it,r_imp(20),
6277 . r_imp(21),r_imp(22),tole,tolf,tolu,
6278 . zero,zero,tt,r_imp(9),tt,r_imp(24)
6279 ELSE
6280 WRITE(isolhist,1666)cumul_it+1,ncycle,it,r_imp(20),
6281 . r_imp(21),r_imp(22),tole,tolf,tolu,
6282 . zero,zero,tt,r_imp(9)
6283 WRITE(isolhist,1666)cumul_it+1,ncycle,it,r_imp(20),
6284 . r_imp(21),r_imp(22),tole,tolf,tolu,
6285 . one,zero,tt,r_imp(9)
6286 WRITE(isolhist,1666)cumul_it+1,ncycle,it,r_imp(20),
6287 . r_imp(21),r_imp(22),tole,tolf,tolu,
6288 . zero,zero,tt,r_imp(9)
6289 ENDIF
6290c Write .progress file
6291 rewind(isolpgrs)
6292 WRITE(isolpgrs,'(I4)') cumul_it
6293 WRITE(isolpgrs,'(E11.4)') tt
6294 WRITE(isolpgrs,'(I4)') nint(tt/tstop*hundred)
6295 WRITE(isolpgrs,'(I4)') 0
6296 WRITE(isolpgrs,'(I4)') 0
6297 CALL flush(isolpgrs)
6298 ELSEIF (imconv == -2) THEN
6299c Diverged step
6300 WRITE(isolhist,1666)cumul_it+1,ncycle,it,r_imp(20),
6301 . r_imp(21),r_imp(22),tole,tolf,tolu,
6302 . zero,zero,tt,r_imp(9)
6303 WRITE(isolhist,1666)cumul_it+1,ncycle,it,r_imp(20),
6304 . r_imp(21),r_imp(22),tole,tolf,tolu,
6305 . zero,one,tt,r_imp(9)
6306 WRITE(isolhist,1666)cumul_it+1,ncycle,it,r_imp(20),
6307 . r_imp(21),r_imp(22),tole,tolf,tolu,
6308 . zero,zero,tt,r_imp(9)
6309 ENDIF
6310 ENDIF
63111060 FORMAT(' ITERATION',i4)
63121061 FORMAT(' LARGEST CORRECTION ROTA. ',e11.4,
6313 . ' AT NODE ',i10,' DOF ',i4)
63141062 FORMAT(' LARGEST CORRECTION DISP. ',e11.4,
6315 . ' AT NODE ',i10,' DOF ',i4)
63161063 FORMAT(' LARGEST INCREMENT ROTA. ',e11.4,
6317 . ' AT NODE ',i10,' DOF ',i4)
63181064 FORMAT(' LARGEST INCREMENT DISP. ',e11.4,
6319 . ' AT NODE ',i10,' DOF ',i4)
63201065 FORMAT(' LARGEST RESIDUAL MOMENT ',e11.4,
6321 . ' AT NODE ',i10,' DOF ',i4)
63221066 FORMAT(' LARGEST RESIDUAL FORCE ',e11.4,
6323 . ' AT NODE ',i10,' DOF ',i4)
63241067 FORMAT(' ACCEPTED EQUILIBRIUM BASED ON SMALL RESIDUAL ENERGY')
63251068 FORMAT(' REJECTED EQUILIBRIUM BASED ON SMALL RESIDUAL ENERGY')
63261069 FORMAT(' ACCEPTED EQUILIBRIUM BASED ON SMALL RESIDUAL FORCE')
63271070 FORMAT(' REJECTED EQUILIBRIUM BASED ON SMALL RESIDUAL FORCE')
63281071 FORMAT(' ACCEPTED EQUILIBRIUM BASED ON SMALL RESIDUAL DISP.')
63291072 FORMAT(' REJECTED EQUILIBRIUM BASED ON SMALL RESIDUAL DISP.')
63301073 FORMAT(' ACCEPTED EQUILIBRIUM BASED ON SMALL RESIDUAL ENERGY AND FORCE')
63311074 FORMAT(' REJECTED EQUILIBRIUM BASED ON SMALL RESIDUAL ENERGY AND FORCE')
63321075 FORMAT(' ACCEPTED EQUILIBRIUM BASED ON SMALL RESIDUAL ENERGY AND DISP.')
63331076 FORMAT(' REJECTED EQUILIBRIUM BASED ON SMALL RESIDUAL ENERGY AND DISP.')
63341077 FORMAT(' ACCEPTED EQUILIBRIUM BASED ON SMALL RESIDUAL FORCE AND DISP.')
63351078 FORMAT(' REJECTED EQUILIBRIUM BASED ON SMALL RESIDUAL FORCE AND DISP.')
63361079 FORMAT(' ACCEPTED EQUILIBRIUM BASED ON SMALL RESIDUAL ENERGY, FORCE AND DISP.')
63371080 FORMAT(' REJECTED EQUILIBRIUM BASED ON SMALL RESIDUAL ENERGY, FORCE AND DISP.')
63381666 FORMAT(i10,',',i10,',',i10,',',e10.2,',',e10.2,',',e10.2,',',e10.2,',',e10.2,',',e10.2,',',e10.2,
6339 . ',',e10.2,',',e10.2,',',e10.2)
63401667 FORMAT(' * CYCLE',i6)
63411668 FORMAT(i10,',',i10,',',i10,',',e10.2,',',e10.2,',',e10.2,',',e10.2,',',e10.2,',',e10.2,',',e10.2,
6342 . ',',e10.2,',',e10.2,',',e10.2,',',e10.2,',',e10.2)
63431160 FORMAT(i6,i6,a19,a12,e12.4)
6344C------------------------------------------
6345 RETURN
6346 END
6347
6348!||====================================================================
6349!|| write_tpl_file ../engine/source/implicit/imp_solv.F
6350!||--- called by ------------------------------------------------------
6351!|| radioss2 ../engine/source/engine/radioss2.f
6352!||====================================================================
6353 SUBROUTINE write_tpl_file(FILNAM,IOFF1,IOFF2,IOFF3)
6354C-----------------------------------------------
6355C M o d u l e s
6356C-----------------------------------------------
6357
6358C-----------------------------------------------
6359C I m p l i c i t T y p e s
6360C-----------------------------------------------
6361#include "implicit_f.inc"
6362C-----------------------------------------------
6363C C o m m o n B l o c k s
6364C-----------------------------------------------
6365#include "impl1_c.inc"
6366C-----------------------------------------------
6367C D u m m y A r g u m e n t s
6368C-----------------------------------------------
6369C REAL
6370 CHARACTER(*) FILNAM,IOFF1,IOFF2,IOFF3
6371 my_real
6372 . r01
6373C-----------------------------------------------
6374c FUNCTION: print-out tcp file
6375C-----------------------------------------------
6376C L o c a l V a r i a b l e s
6377C-----------------------------------------------
6378 INTEGER I,J
6379 my_real
6380 . f_max
6381C-----------------------------------------------
6382 WRITE(isoltpl,1000) filnam
6383 WRITE(isoltpl,1001)
6384 WRITE(isoltpl,1002) ioff2,1,4,1,3,4,1,'Residual force',1
6385 . ,'Residual force','Residual force','Residual force'
6386 . ,'Residual force','Residual force','Residual force'
6387 WRITE(isoltpl,1002) ioff2,1,4,1,0,4,1,'Tolerance force',1
6388 . ,'Tolerance force','Tolerance force','Tolerance force'
6389 . ,'Tolerance force','Tolerance force','Tolerance force'
6390 WRITE(isoltpl,1002) ioff3,1,46,1,3,46,1,'Residual disp.',1
6391 . ,'Residual disp.','Residual disp.','Residual disp.'
6392 . ,'Residual disp.','Residual disp.','Residual disp.'
6393 WRITE(isoltpl,1002) ioff3,1,46,1,0,4,1,'Tolerance disp.',1
6394 . ,'Tolerance disp.','Tolerance disp.','Tolerance disp.'
6395 . ,'Tolerance disp.','tolerance disp.','tolerance disp.'
6396 WRITE(ISOLTPL,1002) IOFF1,1,0,1,3,0,1,'residual energy',1
6397 . ,'residual energy','residual energy','residual energy'
6398 . ,'residual energy','residual energy','Residual energy'
6399 WRITE(isoltpl,1002) ioff1,1,0,1,0,4,1,'Tolerance energy',1
6400 . ,'Tolerance energy','Tolerance energy','Tolerance energy'
6401 . ,'Tolerance energy','Tolerance energy','Tolerance energy'
6402 WRITE(isoltpl,1002) 'On',1,55,1,0,55,1,'Converged step',2
6403 . ,'Converged step','Converged step','Converged step'
6404 . ,'Converged step','Converged step','Converged step'
6405 WRITE(isoltpl,1002) 'On',1,2,1,0,2,1,'Diverged step',2
6406 . ,'Diverged step','Diverged step','Diverged step'
6407 . ,'Diverged step','Diverged step','Diverged step'
6408 WRITE(isoltpl,1003)
6409 WRITE(isoltpl,1004) 2,2,2,'Cumulative iterations','Line search coefficient'
6410 WRITE(isoltpl,1002) 'On',1,50,1,3,50,1,'Line search coefficient',1
6411 . ,'Line search coefficient','Line search coefficient','Line search coefficient'
6412 . ,'Line search coefficient','Line search coefficient','Line search coefficient'
6413 WRITE(isoltpl,1003)
6414 IF (idtc==3) THEN
6415 WRITE(isoltpl,1004) 3,3,3,'Arc length','Load factor'
6416 WRITE(isoltpl,1006) 'On',1,27,1,3,27,1,'Load factor',1
6417 . ,'Load factor','Load factor','Load factor'
6418 . ,'Load factor','Load factor','Load factor'
6419 ELSE
6420 WRITE(isoltpl,1004) 3,3,3,'Cumulative iterations','Time (s)'
6421 WRITE(isoltpl,1002) 'On',1,27,1,3,27,1,'Time',1
6422 . ,'Time','Time','Time'
6423 . ,'Time','Time','Time'
6424 ENDIF
6425 WRITE(isoltpl,1005)
64261000 FORMAT(' *BeginPage() // Page 1'/
6427 . ' *title("',A,'", on)'/
6428 . ' *titlefont("Arial", 1, 0, 12)'/
6429 . ' *layout(9)'/
6430c . ' *BeginAnimator(Transient)'/
6431c . ' *CurrentTime(Undeformed)'/
6432c . ' *StartTime(0,0000000)'/
6433c . ' *EndTime(1,0000000)'/
6434c . ' *Increment(Forward, Frame, 1, BounceOff)'/
6435c . ' *EndAnimator()'/
6436 . ' *windowids(191, 192, 193)'
6437 . )
64381001 FORMAT(' *exportformat("PNG")'/
6439 . ' *beginplot()'/
6440 . ' *plottype(0)'/
6441 . ' *beginplotheader(on)'/
6442 . ' *primaryfont("Arial", 0, 0, 14)'/
6443 . ' *secondaryfont("Arial", 0, 0, 10)'/
6444 . ' *tertiaryfont("Arial", 0, 0, 10)'/
6445 . ' *color(0)'/
6446 . ' *text("Relative residuals")'/
6447 . ' *headeralignment(2)'/
6448 . ' *endplotheader()'/
6449 . ' *beginplotfooter(off)'/
6450 . ' *primaryfont("Arial", 0, 0, 10)'/
6451 . ' *secondaryfont("Arial", 0, 0, 10)'/
6452 . ' *tertiaryfont("Arial", 0, 0, 10)'/
6453 . ' *color(0)'/
6454 . ' *text("{p1w1c1.y.HWRequest} - {p1w1c1.y.HWComponent}")'/
6455 . ' *footeralignment(2)'/
6456 . ' *endplotfooter()'/
6457 . ' *beginlegend(on)'/
6458 . ' *font("Arial", 0, 0, 8)'/
6459 . ' *borderwidth(1)'/
6460 . ' *color(0)'/
6461 . ' *leader(left)'/
6462 . ' *location(below)'/
6463 . ' *autoposition(false)'/
6464 . ' *reversed(no)'/
6465 . ' *endlegend()'/
6466 . ' *uniformaspectratio(0)'/
6467 . ' *framecolor(66)'/
6468 . ' *backgroundcolor(1)'/
6469 . ' *gridlinecolor(9)'/
6470 . ' *zerolinecolor(0)'/
6471 . ' *beginaxis(x, "Primary", on)'/
6472 . ' *label("Cumulative iterations")'/
6473 . ' *scale(linear)'/
6474 . ' *ticmethod(increment)'/
6475 . ' *min(0)'/
6476 . ' *max(1)'/
6477 . ' *Format(auto)'/
6478 . ' *precision(5)'/
6479 . ' *increment(10)'/
6480 . ' *grids(1)'/
6481 . ' *Color(67)'/
6482 . ' *AutoFit(TRUE)'/
6483 . ' *LabelFont("Arial", 0, 0, 10)'/
6484 . ' *TicsFont("Arial", 0, 0, 8)'/
6485 . ' *FitRange(FALSE)'/
6486 . ' *EndAxis()'/
6487 . ' *BeginAxis(Y, "Primary", on)'/
6488 . ' *Label("Relative residual")'/
6489 . ' *Scale(Log)'/
6490 . ' *TicMethod(PerAxis)'/
6491 . ' *Min(0)'/
6492 . ' *Max(1)'/
6493 . ' *Format(Auto)'/
6494 . ' *Precision(4)'/
6495 . ' *TicsPerDecade(1)'/
6496 . ' *GridsPerDecade(1)'/
6497 . ' *Color(67)'/
6498 . ' *AutoFit(TRUE)'/
6499 . ' *LabelFont("Arial", 0, 0, 10)'/
6500 . ' *TicsFont("Arial", 0, 0, 8)'/
6501 . ' *FitRange(FALSE)'/
6502 . ' *EndAxis()'/
6503 . ' *BeginAxis(Y, "Y1", on)'/
6504 . ' *Label("")'/
6505 . ' *Scale(Linear)'/
6506 . ' *TicMethod(PerAxis)'/
6507 . ' *Min(0)'/
6508 . ' *Max(1)'/
6509 . ' *Format(Auto)'/
6510 . ' *Precision(0)'/
6511 . ' *Tics(2)'/
6512 . ' *Grids(2)'/
6513 . ' *Color(67)'/
6514 . ' *AutoFit(TRUE)'/
6515 . ' *LabelFont("Arial", 0, 0, 8)'/
6516 . ' *TicsFont("Arial", 0, 0, 8)'/
6517 . ' *FitRange(FALSE)'/
6518 . ' *endaxis()'
6519 . )
65201002 FORMAT(' *begincurve(',A,', "{y.HWComponent}")'/
6521 . ' *line(',I2,',',I2,',',I2,')'/
6522 . ' *symbol(',I2,',',I2,',',I2,')'/
6523 . ' *shade(false)'/
6524 . ' *bar(0, 0, 2)'/
6525 . ' *showinlegend(true)'/
6526 . ' *layernumber(31)'/
6527 . ' *beginvector(y, file)'/
6528 . ' *filename(plot_file_1)'/
6529 . ' *datatype("Unknown")'/
6530 . ' *request("Block 1")'/
6531 . ' *component("',A,'")'/
6532 . ' *scalefactor("1")'/
6533 . ' *offset("0")'/
6534 . ' *axisindex(',I1,')'/
6535 . ' *attribute("HWReaderHints", "HWReaderHints", "String", "(USE_RXRESULT_READER_FOR_DSY)")'/
6536 . ' *attribute("HWFile", "File", "String", plot_file_1)'/
6537 . ' *attribute("HWSolver", "Solver", "String", "Unknown")'/
6538 . ' *attribute("HWDatatype", "Datatype", "String", "Unknown")'/
6539 . ' *attribute("HWRequest", "Request", "String", "Block 1")'/
6540 . ' *attribute("HWComponent", "Component", "String", "',A,'")'/
6541 . ' *attribute("HWComplexComponent", "ComplexComponent", "String", "',A,'")'/
6542 . ' *attribute("HWReader", "Reader", "String", "hgtextcolumn.exe")'/
6543 . ' *attribute("HWWordSize", "WordSize", "String", "8")'/
6544 . ' *endvector()'/
6545 . ' *beginvector(x, file)'/
6546 . ' *filename(plot_file_1)'/
6547 . ' *datatype("Unknown")'/
6548 . ' *request("Block 1")'/
6549 . ' *component("Cumulative iterations")'/
6550 . ' *scalefactor("1")'/
6551 . ' *offset("0")'/
6552 . ' *axisindex(1)'/
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", "Unknown")'/
6557 . ' *attribute("HWRequest", "Request", "String", "Block 1")'/
6558 . ' *attribute("HWComponent", "Component", "String", "Cumulative iterations")'/
6559 . ' *attribute("HWComplexComponent", "ComplexComponent", "String", "Cumulative iterations")'/
6560 . ' *attribute("HWReader", "Reader", "String", "hgtextcolumn.exe")'/
6561 . ' *attribute("HWWordSize", "WordSize", "String", "8")'/
6562 . ' *endvector()'/
6563 . ' *beginvector(time, file)'/
6564 . ' *filename(plot_file_1)'/
6565 . ' *datatype("Time")'/
6566 . ' *scalefactor("1")'/
6567 . ' *offset("0")'/
6568 . ' *attribute("HWReaderHints", "HWReaderHints", "String", "(USE_RXRESULT_READER_FOR_DSY)")'/
6569 . ' *attribute("HWFile", "File", "String", plot_file_1)'/
6570 . ' *attribute("HWSolver", "Solver", "String", "Unknown")'/
6571 . ' *attribute("HWDatatype", "Datatype", "String", "Time")'/
6572 . ' *attribute("HWRequest", "Request", "String", "Time")'/
6573 . ' *attribute("HWComponent", "Component", "String", "Time")'/
6574 . ' *attribute("HWComplexComponent", "ComplexComponent", "String", "Time")'/
6575 . ' *attribute("HWReader", "Reader", "String", "hgtextcolumn.exe")'/
6576 . ' *attribute("HWWordSize", "WordSize", "String", "8")'/
6577 . ' *endvector()'/
6578 . ' *beginvector(u, file)'/
6579 . ' *filename(plot_file_1)'/
6580 . ' *datatype("Unknown")'/
6581 . ' *request("Block 1")'/
6582 . ' *component("Cumulative iterations")'/
6583 . ' *scalefactor("1")'/
6584 . ' *offset("0")'/
6585 . ' *axisindex(1)'/
6586 . ' *attribute("HWReaderHints", "HWReaderHints", "String", "(USE_RXRESULT_READER_FOR_DSY)")'/
6587 . ' *attribute("HWFile", "File", "String", plot_file_1)'/
6588 . ' *attribute("HWSolver", "Solver", "String", "Unknown")'/
6589 . ' *attribute("HWDatatype", "Datatype", "String", "Unknown")'/
6590 . ' *attribute("HWRequest", "Request", "String", "Block 1")'/
6591 . ' *attribute("HWComponent", "Component", "String", "Cumulative iterations")'/
6592 . ' *attribute("HWComplexComponent", "ComplexComponent", "String", "Cumulative iterations")'/
6593 . ' *attribute("HWReader", "Reader", "String", "hgtextcolumn.exe")'/
6594 . ' *attribute("HWWordSize", "WordSize", "String", "8")'/
6595 . ' *endvector()'/
6596 . ' *beginvector(v, file)'/
6597 . ' *filename(plot_file_1)'/
6598 . ' *datatype("Unknown")'/
6599 . ' *request("Block 1")'/
6600 . ' *component("',A,'")'/
6601 . ' *scalefactor("1")'/
6602 . ' *offset("0")'/
6603 . ' *axisindex(1)'/
6604 . ' *attribute("HWReaderHints", "HWReaderHints", "String", "(USE_RXRESULT_READER_FOR_DSY)")'/
6605 . ' *attribute("HWFile", "File", "String", plot_file_1)'/
6606 . ' *attribute("HWSolver", "Solver", "String", "Unknown")'/
6607 . ' *attribute("HWDatatype", "Datatype", "String", "Unknown")'/
6608 . ' *attribute("HWRequest", "Request", "String", "Block 1")'/
6609 . ' *attribute("HWComponent", "Component", "String", "',A,'")'/
6610 . ' *attribute("HWComplexComponent", "ComplexComponent", "String", "',A,'")'/
6611 . ' *attribute("HWReader", "Reader", "String", "hgtextcolumn.exe")'/
6612 . ' *Attribute("hwwordsize", "wordsize", "string", "8")'/
6613 . ' *EndVector()'/
6614 . ' *Attribute("hwlastgoodcurvename", "hwlastgoodcurvename", "string", "',A,'")'/
6615 . ' *EndCurve()'
6616 . )
66171003 FORMAT(' *EndPlot()')
66181004 FORMAT(' *ExportFormat("png")'/
6619 . ' *BeginPlot()'/
6620 . ' *PlotType(0)'/
6621 . ' *BeginPlotHeader(On)'/
6622 . ' *PrimaryFont("arial", 0, 0, 14)'/
6623 . ' *SecondaryFont("arial", 0, 0, 10)'/
6624 . ' *TertiaryFont("arial", 0, 0, 10)'/
6625 . ' *Color(0)'/
6626 . ' *Text("{p1w',I1,'c1.y.hwcomponent}")'/
6627 . ' *HeaderAlignment(2)'/
6628 . ' *EndPlotHeader()'/
6629 . ' *BeginPlotFooter(Off)'/
6630 . ' *PrimaryFont("arial", 0, 0, 10)'/
6631 . ' *SecondaryFont("arial", 0, 0, 10)'/
6632 . ' *TertiaryFont("arial", 0, 0, 10)'/
6633 . ' *Color(0)'/
6634 . ' *Text("{p1w',I1,'c1.y.hwrequest} - {p1w',I1,'c1.y.hwcomponent}")'/
6635 . ' *FooterAlignment(2)'/
6636 . ' *EndPlotFooter()'/
6637 . ' *BeginLegend(On)'/
6638 . ' *Font("arial", 0, 0, 8)'/
6639 . ' *BorderWidth(1)'/
6640 . ' *Color(0)'/
6641 . ' *Leader(Left)'/
6642 . ' *Location(BELOW)'/
6643 . ' *AutoPosition(False)'/
6644 . ' *Reversed(no)'/
6645 . ' *EndLegend()'/
6646 . ' *UniformAspectRatio(0)'/
6647 . ' *FrameColor(66)'/
6648 . ' *BackgroundColor(1)'/
6649 . ' *GridLineColor(9)'/
6650 . ' *ZeroLineColor(0)'/
6651 . ' *BeginAxis(X, "primary", on)'/
6652 . ' *Label("',A,'")'/
6653 . ' *Scale(Linear)'/
6654 . ' *TicMethod(Increment)'/
6655 . ' *Min(0)'/
6656 . ' *Max(1)'/
6657 . ' *Format(Auto)'/
6658 . ' *Precision(5)'/
6659 . ' *Increment(10)'/
6660 . ' *Grids(1)'/
6661 . ' *Color(67)'/
6662 . ' *AutoFit(TRUE)'/
6663 . ' *LabelFont("arial", 0, 0, 10)'/
6664 . ' *TicsFont("arial", 0, 0, 8)'/
6665 . ' *FitRange(FALSE)'/
6666 . ' *EndAxis()'/
6667 . ' *BeginAxis(Y, "primary", on)'/
6668 . ' *Label("',A,'")'/
6669 . ' *Scale(Linear)'/
6670 . ' *TicMethod(PerAxis)'/
6671 . ' *Min(0)'/
6672 . ' *Max(1)'/
6673 . ' *Format(Auto)'/
6674 . ' *Precision(5)'/
6675 . ' *Tics(11)'/
6676 . ' *Grids(1)'/
6677 . ' *Color(67)'/
6678 . ' *AutoFit(TRUE)'/
6679 . ' *LabelFont("arial", 0, 0, 10)'/
6680 . ' *TicsFont("arial", 0, 0, 8)'/
6681 . ' *FitRange(FALSE)'/
6682 . ' *EndAxis()'
6683 . )
66841005 FORMAT(' *EndPlot()'/
6685 . ' *TimeScales(1, 1, 1)'/
6686 . ' *TimeDelays(0, 0, 0)'/
6687 . ' *AnimationEnable(1, 1, 1)'/
6688 . ' *SyncTolerance(2e-008)'/
6689 . ' *SyncTableGenerationPolicy(ALL_BLOCKS)'/
6690 . ' *EndPage()'/
6691 . '*EndDefine()'
6692 . )
66931006 FORMAT(' *BeginCurve(',A,', "{y.hwcomponent}")'/
6694 . ' *Line(',I2,',',I2,',',I2,')'/
6695 . ' *Symbol(',I2,',',I2,',',I2,')'/
6696 . ' *Shade(False)'/
6697 . ' *Bar(0, 0, 2)'/
6698 . ' *ShowInLegend(True)'/
6699 . ' *LayerNumber(31)'/
6700 . ' *BeginVector(Y, File)'/
6701 . ' *Filename(PLOT_FILE_1)'/
6702 . ' *Datatype("unknown")'/
6703 . ' *Request("block 1")'/
6704 . ' *Component("',A,'")'/
6705 . ' *ScaleFactor("1")'/
6706 . ' *Offset("0")'/
6707 . ' *AxisIndex(',I1,')'/
6708 . ' *Attribute("hwreaderhints", "hwreaderhints", "string", "(use_rxresult_reader_for_dsy)")'/
6709 . ' *Attribute("hwfile", "file", "string", PLOT_FILE_1)'/
6710 . ' *Attribute("hwsolver", "solver", "string", "unknown")'/
6711 . ' *Attribute("hwdatatype", "datatype", "string", "unknown")'/
6712 . ' *Attribute("hwrequest", "request", "string", "block 1")'/
6713 . ' *Attribute("hwcomponent", "component", "string", "',A,'")'/
6714 . ' *Attribute("hwcomplexcomponent", "complexcomponent", "string", "',A,'")'/
6715 . ' *Attribute("hwreader", "reader", "string", "hgtextcolumn.exe")'/
6716 . ' *Attribute("hwwordsize", "wordsize", "string", "8")'/
6717 . ' *EndVector()'/
6718 . ' *BeginVector(X, File)'/
6719 . ' *Filename(PLOT_FILE_1)'/
6720 . ' *Datatype("unknown")'/
6721 . ' *Request("block 1")'/
6722 . ' *Component("arc length")'/
6723 . ' *ScaleFactor("1")'/
6724 . ' *Offset("0")'/
6725 . ' *AxisIndex(1)'/
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", "unknown")'/
6730 . ' *Attribute("hwrequest", "request", "string", "block 1")'/
6731 . ' *Attribute("hwcomponent", "component", "string", "arc length")'/
6732 . ' *Attribute("hwcomplexcomponent", "complexcomponent", "string", "arc length")'/
6733 . ' *Attribute("hwreader", "reader", "string", "hgtextcolumn.exe")'/
6734 . ' *Attribute("hwwordsize", "wordsize", "string", "8")'/
6735 . ' *EndVector()'/
6736 . ' *BeginVector(Time, File)'/
6737 . ' *Filename(PLOT_FILE_1)'/
6738 . ' *Datatype("time")'/
6739 . ' *ScaleFactor("1")'/
6740 . ' *Offset("0")'/
6741 . ' *Attribute("hwreaderhints", "hwreaderhints", "string", "(use_rxresult_reader_for_dsy)")'/
6742 . ' *Attribute("hwfile", "File", "String", plot_file_1)'/
6743 . ' *attribute("HWSolver", "Solver", "String", "Unknown")'/
6744 . ' *attribute("HWDatatype", "Datatype", "String", "Time")'/
6745 . ' *attribute("HWRequest", "Request", "String", "Time")'/
6746 . ' *attribute("HWComponent", "Component", "String", "Time")'/
6747 . ' *attribute("HWComplexComponent", "ComplexComponent", "String", "Time")'/
6748 . ' *attribute("HWReader", "Reader", "String", "hgtextcolumn.exe")'/
6749 . ' *attribute("HWWordSize", "WordSize", "String", "8")'/
6750 . ' *endvector()'/
6751 . ' *beginvector(u, file)'/
6752 . ' *filename(plot_file_1)'/
6753 . ' *datatype("Unknown")'/
6754 . ' *request("Block 1")'/
6755 . ' *component("Arc length")'/
6756 . ' *scalefactor("1")'/
6757 . ' *Offset("0")'/
6758 . ' *AxisIndex(1)'/
6759 . ' *Attribute("HWReaderHints", "HWReaderHints", "String", "(USE_RXRESULT_READER_FOR_DSY)")'/
6760 . ' *Attribute("HWFile", "File", "String", PLOT_FILE_1)'/
6761 . ' *Attribute("HWSolver", "Solver", "String", "Unknown")'/
6762 . ' *Attribute("HWDatatype", "Datatype", "String", "Unknown")'/
6763 . ' *Attribute("HWRequest", "Request", "String", "Block 1")'/
6764 . ' *Attribute("HWComponent", "Component", "String", "Arc length")'/
6765 . ' *Attribute("HWComplexComponent", "ComplexComponent", "String", "Arc length")'/
6766 . ' *Attribute("HWReader", "Reader", "String", "hgtextcolumn.exe")'/
6767 . ' *Attribute("HWWordSize", "WordSize", "String", "8")'/
6768 . ' *EndVector()'/
6769 . ' *BeginVector(V, File)'/
6770 . ' *Filename(PLOT_FILE_1)'/
6771 . ' *Datatype("Unknown")'/
6772 . ' *Request("Block 1")'/
6773 . ' *Component("',a,'")'/
6774 . ' *ScaleFactor("1")'/
6775 . ' *Offset("0")'/
6776 . ' *AxisIndex(1)'/
6777 . ' *Attribute("HWReaderHints", "HWReaderHints", "String", "(USE_RXRESULT_READER_FOR_DSY)")'/
6778 . ' *Attribute("HWFile", "File", "String", PLOT_FILE_1)'/
6779 . ' *Attribute("HWSolver", "Solver", "String", "Unknown")'/
6780 . ' *Attribute("HWDatatype", "Datatype", "String", "Unknown")'/
6781 . ' *Attribute("HWRequest", "Request", "String", "Block 1")'/
6782 . ' *Attribute("HWComponent", "Component", "String", "',a,'")'/
6783 . ' *Attribute("HWComplexComponent", "ComplexComponent", "String", "',a,'")'/
6784 . ' *Attribute("HWReader", "Reader", "String", "hgtextcolumn.exe")'/
6785 . ' *Attribute("HWWordSize", "WordSize", "String", "8")'/
6786 . ' *EndVector()'/
6787 . ' *Attribute("HWLastGoodCurveName", "HWLastGoodCurveName", "String", "',a,'")'/
6788 . ' *EndCurve()'
6789 . )
6790C------------------------------------------
6791 RETURN
6792 END
6793c
6794!||====================================================================
6795!|| int5_diverg ../engine/source/implicit/imp_solv.F
6796!||--- called by ------------------------------------------------------
6797!|| imp_solv ../engine/source/implicit/imp_solv.F
6798!||====================================================================
6799 SUBROUTINE int5_diverg(IPARI )
6800C-----------------------------------------------
6801C I m p l i c i t T y p e s
6802C-----------------------------------------------
6803#include "implicit_f.inc"
6804C-----------------------------------------------
6805C C o m m o n B l o c k s
6806C-----------------------------------------------
6807#include "com04_c.inc"
6808#include "param_c.inc"
6809C-----------------------------------------------
6810C D u m m y A r g u m e n t s
6811C-----------------------------------------------
6812 INTEGER IPARI(NPARI,*)
6813C REAL
6814C-----------------------------------------------
6815C L o c a l V a r i a b l e s
6816C-----------------------------------------------
6817 INTEGER N, NTY
6818C--------------------------------------------
6819 DO N=1,ninter
6820 nty =ipari(7,n)
6821C-----------------------------------------------------------------------
6822 IF(nty == 5 ) THEN
6823C-----------------------------------------------------------------------
6824 ipari(16,n)=ipari(16,n)-1
6825C-----------------------------------------------------------------------
6826 ELSEIF(nty == 10)THEN
6827C-----------------------------------------------------------------------
6828C-----------------------------------------------------------------------
6829 ELSEIF(nty == 11)THEN
6830C-----------------------------------------------------------------------
6831C-----------------------------------------------------------------------
6832 ELSEIF(nty == 24 ) THEN
6833C-----------------------------------------------------------------------
6834C-----------------------------------------------------------------------
6835 ENDIF
6836 END DO
6837C-----------------------------------------------------------------------
6838 RETURN
6839 END
6840!||====================================================================
6841!|| dis_cp ../engine/source/implicit/imp_solv.f
6842!||--- called by ------------------------------------------------------
6843!|| imp_solv ../engine/source/implicit/imp_solv.F
6844!||--- calls -----------------------------------------------------
6845!|| cp_real ../engine/source/implicit/produt_v.F
6846!||--- uses -----------------------------------------------------
6847!|| imp_qstat ../engine/share/modules/impbufdef_mod.F
6848!||====================================================================
6849 SUBROUTINE dis_cp(N ,D ,DR ,IFLAG )
6850C-----------------------------------------------
6851C M o d u l e s
6852C-----------------------------------------------
6853 USE imp_qstat
6854C-----------------------------------------------
6855C I m p l i c i t T y p e s
6856C-----------------------------------------------
6857#include "implicit_f.inc"
6858C-----------------------------------------------
6859C C o m m o n B l o c k s
6860C-----------------------------------------------
6861#include "com01_c.inc"
6862C-----------------------------------------------
6863C D u m m y A r g u m e n t s
6864C-----------------------------------------------
6865 INTEGER N,IFLAG
6866C REAL
6867 my_real
6868 . D(*),DR(*)
6869C-----------------------------------------------
6870C L o c a l V a r i a b l e s
6871C-----------------------------------------------
6872 INTEGER I,ND
6873C------------------------------------------
6874 IF (IFLAG ==0 ) then
6875 CALL cp_real(n,d, d_n_1)
6876 IF (iroddl/=0) CALL cp_real(n,dr, dr_n_1)
6877 ELSE
6878 CALL cp_real(n,d_n_1 ,d )
6879 IF (iroddl/=0) CALL cp_real(n,dr_n_1,dr )
6880 END IF
6881C------------------------------------------
6882 RETURN
6883 END
6884!||====================================================================
6885!|| imp_smpini ../engine/source/implicit/imp_solv.F
6886!||--- called by ------------------------------------------------------
6887!|| b_correct_hp ../engine/source/implicit/nl_solv.F
6888!|| cp_int_hp ../engine/source/implicit/produt_v.F
6889!|| cp_real_hp ../engine/source/implicit/produt_v.F
6890!|| du_ini_hp ../engine/source/implicit/imp_solv.F
6891!|| frac_d_hp ../engine/source/implicit/integrator.F
6892!|| frac_dd_hp ../engine/source/implicit/integrator.F
6893!|| integrator1_hp ../engine/source/implicit/integrator.F
6894!|| integrator2_hp ../engine/source/implicit/integrator.F
6895!|| integrator_hp ../engine/source/implicit/integrator.F
6896!|| integratorl_hp ../engine/source/implicit/integrator.F
6897!|| lin_solv ../engine/source/implicit/lin_solv.F
6898!|| mumpslb_hp ../engine/source/implicit/lin_solv.F
6899!|| produt_hp ../engine/source/implicit/produt_v.F
6900!|| produt_uhp0 ../engine/source/implicit/produt_v.F
6901!|| vaxpy_hp ../engine/source/implicit/produt_v.F
6902!|| vscal_hp ../engine/source/implicit/produt_v.F
6903!|| vscaly_hp ../engine/source/implicit/produt_v.F
6904!|| zeror_hp ../engine/source/implicit/produt_v.F
6905!||--- calls -----------------------------------------------------
6906!|| omp_get_thread_num ../engine/source/engine/openmp_stub.F90
6907!||====================================================================
6908 SUBROUTINE imp_smpini(
6909 1 ITSK ,N1FTSK ,N1LTSK ,N1 )
6910C-----------------------------------------------
6911C I m p l i c i t T y p e s
6912C-----------------------------------------------
6913#include "implicit_f.inc"
6914C-----------------------------------------------
6915C C o m m o n B l o c k s
6916C-----------------------------------------------
6917#include "task_c.inc"
6918C-----------------------------------------------
6919C D u m m y A r g u m e n t s
6920C-----------------------------------------------
6921 INTEGER ITSK ,N1FTSK ,N1LTSK ,N1
6922C-----------------------------------------------
6923C L o c a l V a r i a b l e s
6924C-----------------------------------------------
6925 INTEGER OMP_GET_THREAD_NUM
6926 EXTERNAL OMP_GET_THREAD_NUM
6927C-----------------------------------------------
6928C S o u r c e L i n e s
6929C-----------------------------------------------
6930C
6931C Initialization of variables for // SMP
6932C
6933 itsk = omp_get_thread_num()
6934 n1ftsk = 1+itsk*n1/ nthread
6935 n1ltsk = (itsk+1)*n1/ nthread
6936C
6937 RETURN
6938 END
6939!||====================================================================
6940!|| du_ini_hp ../engine/source/implicit/imp_solv.F
6941!||--- called by ------------------------------------------------------
6942!|| imp_solv ../engine/source/implicit/imp_solv.F
6943!||--- calls -----------------------------------------------------
6944!|| imp_smpini ../engine/source/implicit/imp_solv.F
6945!||--- uses -----------------------------------------------------
6946!|| imp_dyna ../engine/share/modules/impbufdef_mod.F
6947!||====================================================================
6948 SUBROUTINE du_ini_hp(DN ,DNR ,DD ,
6949 1 DDR ,IDIV ,ICONT0 )
6950C-----------------------------------------------
6951C M o d u l e s
6952C-----------------------------------------------
6953 USE imp_dyna
6954C-----------------------------------------------
6955C I m p l i c i t T y p e s
6956C-----------------------------------------------
6957#include "implicit_f.inc"
6958C-----------------------------------------------
6959C C o m m o n B l o c k s
6960C-----------------------------------------------
6961#include "impl1_c.inc"
6962#include "impl2_c.inc"
6963#include "com01_c.inc"
6964#include "com04_c.inc"
6965C-----------------------------------------------
6966C D u m m y A r g u m e n t s
6967C-----------------------------------------------
6968 INTEGER IDIV ,ICONT0
6969 my_real
6970 . dn(3,*),dnr(3,*),dd(3,*),ddr(3,*)
6971C-----------------------------------------------
6972C L o c a l V a r i a b l e s
6973C-----------------------------------------------
6974 INTEGER NODFT ,NODLT,ITSK
6975 INTEGER I,J,IRES
6976 my_real
6977 . BFAC,BDT
6978C--------------Dn,0=Dn-1--------
6979C--------special case with /QSTAT diverge by contact, restart w/o resolution
6980 IRES = 1
6981 if (iqstat >0 .AND. idiv==-2 .AND. icont0 >0 ) THEN
6982 idiv=-1
6983 ires=0
6984 END IF
6985C
6986 bfac=dt1_imp/dt0_imp
6987!$omp parallel private(itsk,nodft ,nodlt,i,bdt)
6988 CALL imp_smpini(itsk ,nodft ,nodlt,numnod )
6989 IF (idyna==0) THEN
6990 IF (ismdisp>0.OR.ires==0) THEN
6991 DO i = nodft ,nodlt
6992 dd(1,i) = bfac*dn(1,i)
6993 dd(2,i) = bfac*dn(2,i)
6994 dd(3,i) = bfac*dn(3,i)
6995 END DO
6996 IF (iroddl/=0) THEN
6997 DO i = nodft ,nodlt
6998 ddr(1,i) = bfac*dnr(1,i)
6999 ddr(2,i) = bfac*dnr(2,i)
7000 ddr(3,i) = bfac*dnr(3,i)
7001 END DO
7002 END IF
7003 ELSE
7004 DO i = nodft ,nodlt
7005 dd(1,i) = dn(1,i)
7006 dd(2,i) = dn(2,i)
7007 dd(3,i) = dn(3,i)
7008 ENDDO
7009 IF (iroddl/=0) THEN
7010 DO i = nodft ,nodlt
7011 ddr(1,i) = dnr(1,i)
7012 ddr(2,i) = dnr(2,i)
7013 ddr(3,i) = dnr(3,i)
7014 ENDDO
7015 END IF
7016 END IF
7017 ELSE
7018 bdt = half*dt0_imp*dt0_imp*(one-two*dy_b)
7019 bdt = zero
7020 DO i = nodft ,nodlt
7021 dd(1,i) = bfac*dn(1,i)+bdt*dy_a(1,i)
7022 dd(2,i) = bfac*dn(2,i)+bdt*dy_a(2,i)
7023 dd(3,i) = bfac*dn(3,i)+bdt*dy_a(3,i)
7024 END DO
7025 IF (iroddl/=0) THEN
7026 DO i = nodft ,nodlt
7027 ddr(1,i) = bfac*dnr(1,i)+bdt*dy_ar(1,i)
7028 ddr(2,i) = bfac*dnr(2,i)+bdt*dy_ar(2,i)
7029 ddr(3,i) = bfac*dnr(3,i)+bdt*dy_ar(3,i)
7030 END DO
7031 END IF
7032 END IF
7033!$OMP END PARALLEL
7034C------------------------------------------
7035 RETURN
7036 END
7037!||====================================================================
7038!|| print_stif ../engine/source/implicit/imp_solv.F
7039!||--- uses -----------------------------------------------------
7040!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
7041!|| tri7box ../engine/share/modules/tri7box.F
7042!||====================================================================
7043 SUBROUTINE print_stif(IPARI,INTBUF_TAB,IFLAG,NN ,JG )
7044C-----------------------------------------------
7045C M o d u l e s
7046C-----------------------------------------------
7047 USE tri7box
7048 USE intbufdef_mod
7049C-----------------------------------------------
7050C I m p l i c i t T y p e s
7051C-----------------------------------------------
7052#include "implicit_f.inc"
7053C-----------------------------------------------
7054C C o m m o n B l o c k s
7055C-----------------------------------------------
7056#include "com01_c.inc"
7057#include "com04_c.inc"
7058#include "units_c.inc"
7059#include "param_c.inc"
7060#include "task_c.inc"
7061C-----------------------------------------------
7062C D u m m y A r g u m e n t s
7063C-----------------------------------------------
7064 INTEGER IPARI(NPARI,NINTER)
7065 INTEGER IFLAG, NN ,JG
7066 INTEGER LENS, LENR,P,N
7067 INTEGER IEDGE,NSN
7068
7069 TYPE(intbuf_struct_) INTBUF_TAB(*)
7070C------------------------------------------
7071 return
7072 IF (nspmd==1) THEN
7073 nsn =ipari(5,nn)
7074 n = 21
7075 if (ncycle>=81.and.ncycle<=81) then
7076c write(iout,*)'IFLAG,ISPMD=',IFLAG,ISPMD
7077c write(iout,*)'IRTLM(1,)=',INBUF(K1)
7078c call my_flush(6)
7079 end if
7080 ELSE
7081 lens = 0
7082 lenr = 0
7083 DO p = 1, nspmd
7084 lens = lens + nsnsi(nn)%P(p)
7085 lenr = lenr + nsnfi(nn)%P(p)
7086 END DO
7087 if (ncycle>=80.and.ncycle<=81.AND.lenr >0) then
7088 write(iout,*)'IFLAG,ISPMD=',iflag,ispmd
7089 write(iout,*)'STIF_OLDFI()%P(1=',stif_oldfi(nn)%P(1,jg)
7090 end if
7091c if (NCYCLE>=78.and.NCYCLE<=79.AND.LENS >0) then
7092c N = 55
7093c K1 = KD(16)+ 2*(N -1)
7094c write(iout,*)'IFLAG,ISPMD=',IFLAG,ISPMD
7095c write(iout,*)'IRTLM(1,N)=',INBUF(K1)
7096c end if
7097 END IF !(NSPMD==1) THEN
7098 RETURN
7099 END
7100!||====================================================================
7101!|| imp_stif24 ../engine/source/implicit/imp_solv.F
7102!||--- called by ------------------------------------------------------
7103!|| re2int7 ../engine/source/implicit/imp_solv.F
7104!||--- calls -----------------------------------------------------
7105!|| spmd_allglob_isum9 ../engine/source/mpi/generic/spmd_allglob_isum9.F
7106!||--- uses -----------------------------------------------------
7107!|| imp_i7cp ../engine/share/modules/imp_intm.F
7108!|| tri7box ../engine/share/modules/tri7box.F
7109!||====================================================================
7110 SUBROUTINE imp_stif24(NUMIMP ,IPARI )
7111C-----------------------------------------------
7112 USE tri7box
7113 USE imp_i7cp
7114C-----------------------------------------------
7115C I m p l i c i t T y p e s
7116C-----------------------------------------------
7117#include "implicit_f.inc"
7118C-----------------------------------------------
7119C C o m m o n B l o c k s
7120C-----------------------------------------------
7121#include "com01_c.inc"
7122#include "com04_c.inc"
7123#include "com08_c.inc"
7124#include "impl1_c.inc"
7125#include "param_c.inc"
7126C-----------------------------------------------
7127C D u m m y A r g u m e n t s
7128C-----------------------------------------------
7129 INTEGER NUMIMP(*),IPARI(NPARI,*)
7130C-----------------------------------------------
7131C L o c a l V a r i a b l e s
7132C-----------------------------------------------
7133 INTEGER I,J,K,L,N,IAD,N_MAX(NINTER),IFLAG,P,
7134 . ity,nsn,igsti,ibit,rid,intth,
7135 . igap,inacti,in1con,ncont0,nrebou
7136C-----------------------------------------------
7137C S o u r c e L i n e s
7138C-----------------------------------------------
7139C-----Calculation NCONT0, Communication is necessary
7140 IF (tt == zero.AND.inconv==1) THEN
7141 DO n = 1,ninter
7142 ity =ipari(7,n)
7143 IF (ity==24) THEN
7144 ipari(26,n)= 0
7145 ipari(53,n)= 0
7146 END IF
7147 END DO
7148 END IF
7149 iflag=0
7150 DO n = 1,ninter
7151 ity =ipari(7,n)
7152 igsti =ipari(34,n)
7153 n_max(n)=0
7154 IF (ity == 24.AND.igsti==6) THEN
7155 n_max(n) =numimp(n)
7156 iflag=1
7157 END IF
7158 END DO
7159 IF (iflag==0.OR.imconv<0) RETURN
7160C
7161 IF (nspmd>1) CALL spmd_allglob_isum9(n_max,ninter)
7162
7163 DO n = 1,ninter
7164 ity =ipari(7,n)
7165 igsti =ipari(34,n)
7166 IF (ity /= 24.AND.igsti/=6) cycle
7167 in1con =ipari(26,n)
7168 ncont0 =ipari(27,n)
7169 nrebou =ipari(53,n)
7170 IF (n_max(n)>0 .AND. in1con==0) THEN
7171 IF (inconv==1) THEN
7172 in1con = ncycle+1
7173 ELSE
7174 in1con = ncycle
7175 END IF
7176 END IF
7177C---------rebound----
7178 IF (ncont0>0 .AND.n_max(n)==0) THEN
7179C------first one will keep negative IN1CON till converging
7180 IF (ncycle == in1con) THEN
7181 nrebou=1
7182 ELSE
7183C--------rebound nb >2
7184 nrebou=2
7185 END IF
7186c write(iout,*)'NREBOU,NIN,imconv,ispmd=',
7187c + NREBOU,N,imconv,ispmd
7188C---------negative :rebound active
7189 ipari(53,n)=-nrebou
7190 END IF
7191 ipari(26,n)=in1con
7192 ipari(27,n)=n_max(n)
7193 END DO
7194C
7195 RETURN
7196 END
7197!||====================================================================
7198!|| upd_rhs_fr ../engine/source/implicit/imp_solv.f
7199!||--- called by ------------------------------------------------------
7200!|| imp_intfr ../engine/source/implicit/imp_solv.F
7201!||--- calls -----------------------------------------------------
7202!|| ext_rhs ../engine/source/implicit/upd_glob_k.F
7203!|| i2_impr1 ../engine/source/interfaces/interf/i2_imp1.F
7204!|| i2_impr2 ../engine/source/interfaces/interf/i2_imp1.F
7205!|| rbe2_impr1 ../engine/source/constraints/general/rbe2/rbe2_imp0.F
7206!|| rbe3_impr1 ../engine/source/constraints/general/rbe3/rbe3_imp0.F
7207!|| rbe3_impr2 ../engine/source/constraints/general/rbe3/rbe3_imp0.F
7208!|| rby_impr1 ../engine/source/constraints/general/rbody/rby_imp0.F
7209!|| rby_impr2 ../engine/source/constraints/general/rbody/rby_imp0.F
7210!||--- uses -----------------------------------------------------
7211!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
7212!||====================================================================
7213 SUBROUTINE upd_rhs_fr(ICODT ,ICODR ,ISKEW ,IBFV ,XFRAME ,
7214 1 RBY ,X ,SKEW ,LPBY ,NPBY ,
7215 2 NRBYAC,IRBYAC,NINT2 ,IINT2 ,IPARI ,
7216 3 INTBUF_TAB ,NDOF ,IDDL ,IKC ,
7217 4 NDDL0 ,B ,IUPD ,INLOC ,LJ ,
7218 5 AC ,ACR ,NT_RW ,W_DDL ,NDDL ,
7219 6 R02 ,IRBE3 ,LRBE3 ,FRBE3 ,WEIGHT ,
7220 8 IRBE2 ,LRBE2 )
7221C-----------------------------------------------
7222C M o d u l e s
7223C-----------------------------------------------
7224 USE intbufdef_mod
7225C-----------------------------------------------
7226C I m p l i c i t T y p e s
7227C-----------------------------------------------
7228#include "implicit_f.inc"
7229C-----------------------------------------------
7230C C o m m o n B l o c k s
7231C-----------------------------------------------
7232#include "com04_c.inc"
7233#include "param_c.inc"
7234C-----------------------------------------------
7235C D u m m y A r g u m e n t s
7236C-----------------------------------------------
7237 INTEGER IBFV(NIFV,*),ICODT(*),ICODR(*),ISKEW(*),
7238 . nint2 ,iint2(*),lj(*),nddl0,iupd,
7239 . inloc(*),nt_rw,w_ddl(*) ,nddl
7240 INTEGER LPBY(*),NPBY(NNPBY,*),NDOF(*),IDDL(*),IKC(*),
7241 . ipari(npari,*), nrbyac,irbyac(*)
7242 INTEGER WEIGHT(*),IRBE3(*),LRBE3(*),IRBE2(*),LRBE2(*)
7243 my_real
7244 . rby(nrby,*) ,x(3,*) ,skew(*),r02
7245 my_real
7246 . b(*) ,xframe(nxframe,*),ac(3,*),acr(3,*),frbe3(*)
7247
7248 TYPE(intbuf_struct_) INTBUF_TAB(*)
7249C-----------------------------------------------
7250C L o c a l V a r i a b l e s
7251C-----------------------------------------------
7252 INTEGER I,J,K,N,JI,JB,K1,IFLAG
7253C-------R02 correction due the fact that IMP_FRI is done after [K],{LB}condensation----------
7254C-------only Fext is re-computed, others don't change-------
7255C-------int2,RBE3,rby speciale (Fext seulement)----------
7256 IF (iupd==0) THEN
7257 DO i=1,nint2
7258 n=iint2(i)
7259 CALL i2_impr1(ipari(1,n),intbuf_tab(n),
7260 . x ,ndof ,iddl ,b )
7261 ENDDO
7262 IF (nrbe2>0) THEN
7263 CALL rbe2_impr1(
7264 1 irbe2 ,lrbe2 ,x ,skew ,ndof ,
7265 2 iddl ,b ,weight)
7266 ENDIF
7267 IF (nrbe3>0) THEN
7268 CALL rbe3_impr1(
7269 1 irbe3 ,lrbe3 ,frbe3 ,x ,skew ,
7270 2 ndof ,iddl ,b ,weight)
7271 ENDIF
7272 DO i=1,nrbyac
7273 n=irbyac(i)
7274 k1=irbyac(i+nrbykin)+1
7275 CALL rby_impr1(x, rby(1,n),lpby(k1),npby(1,n),
7276 1 ndof ,iddl ,b )
7277 ENDDO
7278 ENDIF
7279C-------int2,rby speciale (elements deleted)----------
7280 DO i=1,nint2
7281 n=iint2(i)
7282 CALL i2_impr2(ipari(1,n),intbuf_tab(n) ,ac ,acr ,
7283 . x ,ndof ,iddl ,b )
7284 ENDDO
7285 IF (nrbe3>0) THEN
7286 CALL rbe3_impr2(
7287 1 irbe3 ,lrbe3 ,frbe3 ,x ,skew ,
7288 2 ndof ,iddl ,b ,weight,ac ,
7289 3 acr )
7290 ENDIF
7291 DO i=1,nrbyac
7292 n=irbyac(i)
7293 k1=irbyac(i+nrbykin)+1
7294 CALL rby_impr2(x, rby(1,n),lpby(k1),npby(1,n),
7295 1 ndof ,iddl ,b ,ac ,acr )
7296 ENDDO
7297C-------------
7298 CALL ext_rhs(icodt ,icodr ,iskew ,ibfv ,xframe ,
7299 1 x ,skew ,ndof ,iddl ,ikc ,
7300 2 nddl0 ,b ,inloc ,lj ,ac ,
7301 3 acr ,nt_rw ,w_ddl ,nddl ,r02 )
7302C
7303 RETURN
7304 END
7305!||====================================================================
7306!|| imp_intfr ../engine/source/implicit/imp_solv.F
7307!||--- called by ------------------------------------------------------
7308!|| imp_solv ../engine/source/implicit/imp_solv.F
7309!||--- calls -----------------------------------------------------
7310!|| cp_real_hp ../engine/source/implicit/produt_v.F
7311!|| imp_frfv ../engine/source/mpi/implicit/imp_fri.F
7312!|| imp_fri ../engine/source/mpi/implicit/imp_fri.F
7313!|| imp_setba ../engine/source/implicit/imp_setb.F
7314!|| upd_rhs_fr ../engine/source/implicit/imp_solv.F
7315!||--- uses -----------------------------------------------------
7316!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
7317!||====================================================================
7318 SUBROUTINE imp_intfr(
7319 1 NUM_IMP ,NS_IMP ,NE_IMP ,IPARI ,INTBUF_TAB,
7320 2 NPBY ,LPBY ,ITAB ,NRBYAC ,
7321 3 IRBYAC ,NINT2 ,IINT2 ,IDDL ,IKC ,
7322 4 NDOF ,INLOC ,NSREM ,NSL ,NBINTC ,
7323 5 INTLIST ,X ,IBFV ,DIRUL ,SKEW ,
7324 6 XFRAME ,ISKEW ,ICODT ,DE ,D_IMP ,
7325 7 LB ,IFDIS ,NDDL ,DR_IMP ,IDDLI ,
7326 8 IRBE3 ,LRBE3 ,FRBE3 ,IRBE2 ,LRBE2 ,
7327 9 DD ,DDR ,A ,AR ,AC ,
7328 A ACR ,MS ,V ,NDDL0 ,R02 ,
7329 B RBY ,ICODR ,NT_RW ,W_DDL ,WEIGHT ,
7330 C IRFLAG )
7331C-----------------------------------------------
7332C M o d u l e s
7333C-----------------------------------------------
7334 USE intbufdef_mod
7335C----6---------------------------------------------------------------7---------8
7336C I m p l i c i t T y p e s
7337C-----------------------------------------------
7338#include "implicit_f.inc"
7339C-----------------------------------------------
7340C C o m m o n B l o c k s
7341C-----------------------------------------------
7342#include "com04_c.inc"
7343#include "param_c.inc"
7344#include "impl1_c.inc"
7345C-----------------------------------------------------------------
7346C D u m m y A r g u m e n t s
7347C-----------------------------------------------
7348 INTEGER IPARI(NPARI,*),NUM_IMP(*),NS_IMP(*),
7349 . NE_IMP(*),NSREM ,NSL,NBINTC,INTLIST(*),IRFLAG,
7350 . IRBE3(*),LRBE3(*),IRBE2(*),LRBE2(*),NDDL0,W_DDL(*),
7351 . weight(*),icodr(*),nt_rw
7352 INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*),NRBYAC,IRBYAC(*),
7353 . nint2,iint2(*),iddl(*),ikc(*),ndof(*),inloc(*),
7354 . ibfv(*),dirul(*),iskew(*),icodt(*),ifdis,nddl,iddli(*)
7355C REAL
7356 my_real
7357 . x(3,*),skew(*) ,xframe(*),
7358 . a(3,*),d_imp(3,*),lb(*),dr_imp(3,*),frbe3(*),
7359 . dd(3,*),ddr(3,*),ar(3,*),ms(*) ,v(3,*),de,
7360 . ac(3,*),acr(3,*),r02,rby(nrby,*)
7361
7362 TYPE(intbuf_struct_) INTBUF_TAB(*)
7363C-----------------------------------------------
7364C L o c a l V a r i a b l e s
7365C-----------------------------------------------
7366 INTEGER I,J,N,NKC,ND,NDM
7367 INTEGER, DIMENSION(NDDL0) :: IDM
7368 my_real, DIMENSION(NDDL0) :: LB0
7369C
7370 CALL cp_real_hp(nddl,lb,lb0)
7371 CALL imp_fri(
7372 1 num_imp ,ns_imp ,ne_imp ,ipari ,intbuf_tab,
7373 2 npby ,lpby ,itab ,nrbyac ,
7374 3 irbyac ,nint2 ,iint2 ,iddl ,ikc ,
7375 4 ndof ,inloc ,nsrem ,nsl ,nbintc ,
7376 5 intlist ,x ,ibfv ,dirul ,skew ,
7377 6 xframe ,iskew ,icodt ,a ,d_imp ,
7378 7 lb ,ifdis ,nddl ,dr_imp ,iddli ,
7379 8 irbe3 ,lrbe3 ,frbe3 ,irbe2 ,lrbe2 )
7380 IF ( ifdis>0 .AND. intp_c <= 0)
7381 . CALL imp_frfv(
7382 1 num_imp ,ns_imp ,ne_imp ,ipari ,intbuf_tab,
7383 2 iddl ,ikc ,ndof ,nsrem ,
7384 3 nsl ,d_imp ,dd ,dr_imp ,ddr ,
7385 4 a ,ar ,ms ,v ,x ,
7386 5 lb ,nddl ,ibfv ,skew ,xframe ,
7387 6 irbe3 ,lrbe3 ,irbe2 ,lrbe2 ,de ,
7388 7 nddl0 ,w_ddl )
7389C--------Fext change (U_d) w/ remot to re-evalue R02
7390 IF (irflag>0) THEN
7391 DO i =1,nddl
7392 lb0(i) =lb(i)-lb0(i)
7393 END DO
7394 DO i =nddl+1,nddl0
7395 lb0(i) =zero
7396 END DO
7397 nkc=0
7398C------LB0 condensed -> LB0 original
7399 DO n =1,numnod
7400 i=inloc(n)
7401 ndm=iddl(i)-nkc
7402 DO j=1,ndof(i)
7403 nd = iddl(i)+j
7404 IF (ikc(nd)/=0) THEN
7405 nkc = nkc + 1
7406 idm(nd)=0
7407 ELSE
7408 ndm=ndm+1
7409 idm(nd)=ndm
7410 END IF
7411 ENDDO
7412 ENDDO
7413 DO i =nddl0,1,-1
7414 nd = idm(i)
7415 IF (nd>0) lb0(i) =lb0(nd)
7416 END DO
7417 CALL imp_setba(ac ,acr ,iddl ,ndof ,lb0 ,1 )
7418 CALL upd_rhs_fr(icodt ,icodr ,iskew ,ibfv ,xframe ,
7419 1 rby ,x ,skew ,lpby ,npby ,
7420 2 nrbyac,irbyac,nint2 ,iint2 ,ipari ,
7421 3 intbuf_tab ,ndof ,iddl ,ikc ,
7422 4 nddl0 ,lb0 ,isetk ,inloc ,dirul ,
7423 5 ac ,acr ,nt_rw ,w_ddl ,nddl ,
7424 6 r02 ,irbe3 ,lrbe3 ,frbe3 ,weight ,
7425 8 irbe2 ,lrbe2 )
7426 ENDIF
7427C----6---------------------------------------------------------------7---------8
7428 RETURN
7429 END
7430!||====================================================================
7431!|| ini_bminma_imp ../engine/source/implicit/imp_solv.f
7432!||--- called by ------------------------------------------------------
7433!|| imp_solv ../engine/source/implicit/imp_solv.F
7434!||--- uses -----------------------------------------------------
7435!|| intbufdef_mod ../common_source/modules/interfaces/intbufdef_mod.F90
7436!||====================================================================
7437 SUBROUTINE ini_bminma_imp(INTBUF_TAB)
7438C-----------------------------------------------
7439C M o d u l e s
7440C-----------------------------------------------
7441 USE intbufdef_mod
7442C-----------------------------------------------
7443C I m p l i c i t T y p e s
7444C-----------------------------------------------
7445#include "implicit_f.inc"
7446C-----------------------------------------------
7447C C o m m o n B l o c k s
7448C-----------------------------------------------
7449#include "com04_c.inc"
7450C-----------------------------------------------
7451 TYPE(intbuf_struct_):: INTBUF_TAB(NINTER)
7452C-----------------------------------------------
7453C L o c a l V a r i a b l e s
7454C-----------------------------------------------
7455 INTEGER N
7456C-----------------------------------------------
7457 DO N = 1,ninter
7458 intbuf_tab(n)%BMINMA_IMP(1)=-ep30
7459 intbuf_tab(n)%BMINMA_IMP(2)=-ep30
7460 intbuf_tab(n)%BMINMA_IMP(3)=-ep30
7461 intbuf_tab(n)%BMINMA_IMP(4)=ep30
7462 intbuf_tab(n)%BMINMA_IMP(5)=ep30
7463 intbuf_tab(n)%BMINMA_IMP(6)=ep30
7464 END DO
7465C------------------------------------------
7466 RETURN
7467 END
7468!||====================================================================
7469!|| spbrm_pre ../engine/source/implicit/imp_solv.F
7470!||--- called by ------------------------------------------------------
7471!|| imp_solv ../engine/source/implicit/imp_solv.F
7472!||--- calls -----------------------------------------------------
7473!|| cgshell3 ../engine/source/implicit/cgshell.F
7474!|| cgshell4 ../engine/source/implicit/cgshell.F
7475!|| spb_refsh3id ../engine/source/implicit/imp_solv.F
7476!|| spb_refsh4id ../engine/source/implicit/imp_solv.F
7477!|| spmd_max_i ../engine/source/mpi/implicit/imp_spmd.F
7478!|| spmd_min_s ../engine/source/mpi/implicit/imp_spmd.F
7479!|| spmd_sum_s ../engine/source/mpi/implicit/imp_spmd.F
7480!||--- uses -----------------------------------------------------
7481!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.F90
7482!|| element_mod ../common_source/modules/elements/element_mod.f90
7483!|| imp_spbrm ../engine/share/modules/impbufdef_mod.F
7484!||====================================================================
7485 SUBROUTINE spbrm_pre(ITAB ,
7486 1 X ,IPARG ,IXC ,IXTG ,PARTSAV ,
7487 2 ELBUF_TAB ,PM ,NDOF ,IDDL ,IKC )
7488C-----------------------------------------------
7489C M o d u l e s
7490C-----------------------------------------------
7491 USE elbufdef_mod
7492 USE imp_spbrm
7493 use element_mod , only : nixc,nixtg
7494C-----------------------------------------------
7495C I m p l i c i t T y p e s
7496C-----------------------------------------------
7497#include "implicit_f.inc"
7498C-----------------------------------------------
7499C C o m m o n B l o c k s
7500C-----------------------------------------------
7501#include "com01_c.inc"
7502#include "com04_c.inc"
7503#include "param_c.inc"
7504#include "impl1_c.inc"
7505C-----------------------------------------------
7506C D u m m y A r g u m e n t s
7507C-----------------------------------------------
7508 integer
7509 . ixc(nixc,*), ixtg(nixtg,*), iparg(nparg,*),
7510 . ndof(*),iddl(*),ikc(*),itab(*)
7511C REAL
7512 my_real
7513 . x(3,*) ,partsav(npsav,*) ,pm(*)
7514 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
7515C-----------------------------------------------
7516C L o c a l V a r i a b l e s
7517C-----------------------------------------------
7518 INTEGER N4,N3,I,II,J,N, NG,MLW, NF1,NKC,ND,IP4,IP3,IG,
7519 + jft,jlt,nbc,ity,nel,nft,nbcs,e_id,n1,n2,k
7520 INTEGER, DIMENSION(:),ALLOCATABLE :: ITAG
7521C REAL
7522 my_real
7523 . xc,yc,zc,mas,mas3,dmin,xmin,ymin,zmin,mast,
7524 . dming,xming,yming,zming
7525C---limitations : only the blank is deformable(shell only), all tools(part)are rigids---
7526C------------blank could be composed w/ 4N,3N and in diff parts
7527C------ IRIG_M>1 -> input E_REF id
7528C---IF there id BC (symmetry) in the blank----
7529C----- put N1,N2,N3 (sys_id) in E_REF(1:3), E_REF(4)=E_REF(3)
7530 rlskew(1:9) = zero
7531 IF (irig_m>1 ) THEN
7532 nbc_b = 0
7533 ilskew = 0
7534 lskew_g = 0
7535 ikce(1:6) = 0
7536 n1=0
7537 n2=0
7538 n3=0
7539 DO i = 1, numnod
7540 IF(itab(i)==e_ref(1)) n1=i
7541 IF(itab(i)==e_ref(2)) n2=i
7542 IF(itab(i)==e_ref(3)) n3=i
7543 END DO
7544 e_ref(1)= n1
7545 e_ref(2)= n2
7546 e_ref(3)= n3
7547 DO j = 1, 3
7548 n = e_ref(j)
7549 IF (n==0) cycle
7550 DO k= 1,ndof(n)
7551 nd = iddl(n)+k
7552 IF (ikc(nd)>0.AND.ikce(k)==0) ikce(k) = 1
7553 IF (ikc(nd)==8) ilskew = n
7554 END DO
7555 END DO
7556 IF (ilskew >0) lskew_g=1
7557C--- ending routine
7558 RETURN
7559 END IF
7560 nbc = 0
7561 DO i =1,numnod
7562 nkc=0
7563 DO j=1,min(3,ndof(i))
7564 nd = iddl(i)+j
7565 IF (ikc(nd)/=0) nkc = nkc + 1
7566 ENDDO
7567C--------exclude fixing all translational
7568 IF (nkc>0.AND.nkc<3) nbc = nbc +1
7569 ENDDO
7570 IF (nbc >0) THEN
7571C----------pense deallocate
7572 AllOCATE(ibc_b(nbc))
7573 nbc = 0
7574 DO i =1,numnod
7575 nkc=0
7576 DO j=1,min(3,ndof(i))
7577 nd = iddl(i)+j
7578 IF (ikc(nd)/=0) nkc = nkc + 1
7579 ENDDO
7580 IF (nkc>0.AND.nkc<3) THEN
7581 nbc = nbc +1
7582 ibc_b(nbc) = i
7583 END IF
7584 ENDDO
7585 END IF
7586C------global NBC---
7587 nbc_b = nbc
7588 IF (nspmd>1) CALL spmd_max_i(nbc_b)
7589C---get reference elem (shell for the moment) for rigid motion compute
7590C---- E_id : nearest the gravity center if no BC,
7591C-----E_REF(4) saved 4 nodes which are Xmin, Ymin,Zmin,Dmin, will be updated by v,vr
7592 IF (nbc >0) THEN
7593 ALLOCATE(itag(numnod))
7594 itag = 0
7595 DO i =1,nbc
7596 n = ibc_b(i)
7597 itag(n) =1
7598 END DO
7599 ne_bc4 = 0
7600 ne_bc3 = 0
7601 DO ng = 1, ngroup
7602 IF(iparg(8,ng)==1) cycle
7603 ity =iparg(5,ng)
7604 IF (ity /= 3 .AND. ity /= 7) cycle
7605 mlw =iparg(1,ng)
7606C
7607 IF (mlw == 0 .OR. mlw == 13) cycle
7608 nel =iparg(2,ng)
7609 jft =iparg(3,ng) + 1
7610 jlt = iparg(3,ng) + nel
7611 IF (ity==7) THEN
7612 DO i = jft,jlt
7613 nbcs = 0
7614 DO j=1,3
7615 n= ixtg(j+1,i)
7616 nbcs = nbcs + itag(n)
7617 END DO
7618 IF (nbcs >0) ne_bc3 =ne_bc3 + 1
7619 END DO
7620 ELSEIF (ity==3) THEN
7621 DO i = jft,jlt
7622 nbcs = 0
7623 DO j=1,4
7624 n= ixc(j+1,i)
7625 nbcs = nbcs + itag(n)
7626 END DO
7627 IF (nbcs >0) ne_bc4 =ne_bc4 + 1
7628 END DO
7629 END IF
7630 END DO !NG = 1, NGROUP
7631 IF (ne_bc3 >0) ALLOCATE(ie_bc3(ne_bc3))
7632 IF (ne_bc4 >0) ALLOCATE(ie_bc4(ne_bc4))
7633 ne_bc4 = 0
7634 ne_bc3 = 0
7635 DO ng = 1, ngroup
7636 IF(iparg(8,ng)==1) cycle
7637 ity =iparg(5,ng)
7638 IF (ity /= 3 .AND. ity /= 7) cycle
7639 mlw =iparg(1,ng)
7640C
7641 IF (mlw == 0 .OR. mlw == 13) cycle
7642 nel =iparg(2,ng)
7643 jft =iparg(3,ng) + 1
7644 jlt = iparg(3,ng) + nel
7645 IF (ity==7) THEN
7646 DO i = jft,jlt
7647 nbcs = 0
7648 DO j=1,3
7649 n= ixtg(j+1,i)
7650 nbcs = nbcs + itag(n)
7651 END DO
7652 IF (nbcs >0) THEN
7653 ne_bc3 =ne_bc3 + 1
7654 ie_bc3(ne_bc3) = i
7655 END IF
7656 END DO
7657 ELSEIF (ity==3) THEN
7658 DO i = jft,jlt
7659 nbcs = 0
7660 DO j=1,4
7661 n= ixc(j+1,i)
7662 nbcs = nbcs + itag(n)
7663 END DO
7664 IF (nbcs >0) THEN
7665 ne_bc4 =ne_bc4 + 1
7666 ie_bc4(ne_bc4) = i
7667 END IF
7668 END DO
7669 END IF
7670 END DO !NG =
7671C-------NBC = 0
7672 ELSEIF (nbc_b == 0) THEN
7673 n3=0
7674 n4=0
7675 mas =zero
7676 xc = zero
7677 yc = zero
7678 zc = zero
7679 DO ng = 1, ngroup
7680 IF(iparg(8,ng)==1) cycle
7681 ity =iparg(5,ng)
7682 IF (ity /= 3 .AND. ity /= 7) cycle
7683 mlw =iparg(1,ng)
7684C MLW= 0 ----> void; MLW = 13 ----> rigid material
7685 IF (mlw == 0 .OR. mlw == 13) cycle
7686 nel =iparg(2,ng)
7687 jft=1
7688 jlt=min(nvsiz,nel)
7689 nf1 = iparg(3,ng)+1
7690 IF (ity==7) THEN
7691 n3 =n3 +1
7692 CALL cgshell3(elbuf_tab(ng),jft,jlt ,pm ,ixtg(1,nf1),
7693 + x ,mas,xc ,yc ,zc )
7694 ELSEIF (ity==3) THEN
7695 n4 =n4 +1
7696 CALL cgshell4(elbuf_tab(ng),jft,jlt ,pm ,ixc(1,nf1),
7697 + x ,mas,xc ,yc ,zc )
7698 END IF
7699 END DO !IG = 1, NGROUC
7700C
7701 IF (n3==0.AND.n4==0) THEN
7702C-------warning out--
7703 ELSE
7704 IF (nspmd>1) THEN
7705 mast = mas
7706 CALL spmd_sum_s(mast)
7707 CALL spmd_sum_s(xc)
7708 CALL spmd_sum_s(yc)
7709 CALL spmd_sum_s(zc)
7710 mas = mast
7711 END IF
7712 xc = xc/mas
7713 yc = yc/mas
7714 zc = zc/mas
7715C
7716 xmin=ep30
7717 ymin=ep30
7718 zmin=ep30
7719 dmin=ep30
7720 DO ng = 1, ngroup
7721 IF(iparg(8,ng)==1) cycle
7722 ity =iparg(5,ng)
7723 IF (ity /= 3 .AND. ity /= 7) cycle
7724 mlw =iparg(1,ng)
7725C
7726 IF (mlw == 0 .OR. mlw == 13) cycle
7727 nel =iparg(2,ng)
7728 jft =iparg(3,ng) + 1
7729 jlt = iparg(3,ng) + nel
7730 IF (ity==7) THEN
7731 CALL spb_refsh3id(jft,jlt,nel,ixtg,x,xc,yc,zc,
7732 + e_ref,xmin,ymin,zmin,dmin)
7733 ELSEIF (ity==3) THEN
7734 CALL spb_refsh4id(jft,jlt,nel,ixc,x,xc,yc,zc,
7735 + e_ref,xmin,ymin,zmin,dmin)
7736 END IF
7737 END DO !IG = 1, NGROUC
7738C------- To get unique ref-element
7739 IF (nspmd>1) THEN
7740 xming = xmin
7741 CALL spmd_min_s(xming)
7742 IF (xming<xmin) e_ref(1)=0
7743 yming = ymin
7744 CALL spmd_min_s(yming)
7745 IF (yming<ymin) e_ref(2)=0
7746 zming = zmin
7747 CALL spmd_min_s(zming)
7748 IF (zming<zmin) e_ref(3)=0
7749 dming = dmin
7750 CALL spmd_min_s(dming)
7751 IF (dming<dmin) e_ref(4)=0
7752 END IF
7753 END IF !((N3==0.AND.N4==0).OR.N3>1 .OR. N4>1)
7754 END IF !(NBC>0) THEN
7755 IF (nbc >0) DEALLOCATE(itag)
7756C
7757 RETURN
7758 END
7759!||====================================================================
7760!|| spb_refsh4id ../engine/source/implicit/imp_solv.F
7761!||--- called by ------------------------------------------------------
7762!|| spbrm_pre ../engine/source/implicit/imp_solv.F
7763!||--- uses -----------------------------------------------------
7764!|| element_mod ../common_source/modules/elements/element_mod.F90
7765!||====================================================================
7766 SUBROUTINE spb_refsh4id(JFT,JLT,NEL,IXC,X,XC,YC,ZC,IE,
7767 + XMIN0,YMIN0,ZMIN0,DMIN)
7768 use element_mod , only : nixc
7769C-----------------------------------------------
7770C I m p l i c i t T y p e s
7771C-----------------------------------------------
7772#include "implicit_f.inc"
7773C-----------------------------------------------
7774C D u m m y A r g u m e n t s
7775C-----------------------------------------------
7776 INTEGER IXC(NIXC,*),JFT, JLT,IE(4),NEL
7777C REAL
7778 my_real
7779 . x(3,*),xc,yc,zc,dmin,xmin0,ymin0,zmin0
7780C-----------------------------------------------
7781C L o c a l V a r i a b l e s
7782C-----------------------------------------------
7783 INTEGER N,I,II,ND,INDEX(NEL),IEL,J
7784 my_real
7785 . xmin,xmax,ymin,ymax,zmin,zmax,d,xm,ym,zm,dminl,
7786 . xminl,yminl,zminl
7787C---get reference ele (shell for the moment) for rigid motion compute
7788C---- E_id : nearest the gravity center----
7789 nd =0
7790 DO i = jft,jlt
7791 xmin=ep30
7792 xmax=-ep30
7793 ymin=ep30
7794 ymax=-ep30
7795 zmin=ep30
7796 zmax=-ep30
7797 DO j=1,4
7798 n= ixc(j+1,i)
7799 xmin=min(xmin,x(1,n))
7800 xmax=max(xmax,x(1,n))
7801 ymin=min(ymin,x(2,n))
7802 ymax=max(ymax,x(2,n))
7803 zmin=min(zmin,x(3,n))
7804 zmax=max(zmax,x(3,n))
7805 END DO
7806 IF((xc < xmin.OR.xc > xmax).AND.(yc < ymin.OR.yc > ymax)
7807 + .AND.(zc < zmin.OR.zc > zmax)) cycle
7808 nd = nd +1
7809 index(nd) = i
7810 END DO
7811 IF (nd ==0) THEN
7812 iel =0
7813 ELSE
7814 DO ii = 1,nd
7815 i = index(ii)
7816 xm = zero
7817 ym = zero
7818 zm = zero
7819 DO j=1,4
7820 n= ixc(j+1,i)
7821 xm=xm+x(1,n)
7822 ym=ym+x(2,n)
7823 zm=zm+x(3,n)
7824 END DO
7825 xm = fourth*xm- xc
7826 ym = fourth*ym- yc
7827 zm = fourth*zm- zc
7828 xminl=abs(xm)
7829 yminl=abs(ym)
7830 zminl=abs(zm)
7831C-------- Z direction is removed
7832 IF (xminl<xmin0) THEN
7833 ie(1) = i
7834 xmin0 = xminl
7835 END IF
7836 IF (yminl<ymin0) THEN
7837 ie(2) = i
7838 ymin0 = yminl
7839 END IF
7840c IF (ZMINL<ZMIN0) THEN
7841c IE(3) = I
7842c ZMIN0 = ZMINL
7843c END IF
7844 d=xm*xm+ym*ym
7845c D=XM*XM+YM*YM+ZM*ZM
7846 IF (d < dmin) THEN
7847 dmin = d
7848C---------first node-----
7849 ie(4) = i
7850 END IF
7851 END DO
7852 ENDIF
7853c IF (IEL>0 .AND.DMINL<DMIN) THEN
7854c IE(1:4) = IXC(2:5,IEL)
7855c DMIN= DMINL
7856c END IF
7857C
7858 RETURN
7859 END
7860!||====================================================================
7861!|| spb_refsh3id ../engine/source/implicit/imp_solv.F
7862!||--- called by ------------------------------------------------------
7863!|| spbrm_pre ../engine/source/implicit/imp_solv.F
7864!||--- uses -----------------------------------------------------
7865!|| element_mod ../common_source/modules/elements/element_mod.F90
7866!||====================================================================
7867 SUBROUTINE spb_refsh3id(JFT,JLT,NEL,IXTG,X,XC,YC,ZC,IE,
7868 + XMIN0,YMIN0,ZMIN0,DMIN)
7869 use element_mod , only : nixtg
7870C-----------------------------------------------
7871C I m p l i c i t T y p e s
7872C-----------------------------------------------
7873#include "implicit_f.inc"
7874C-----------------------------------------------
7875C D u m m y A r g u m e n t s
7876C-----------------------------------------------
7877 INTEGER IXTG(NIXTG,*),JFT, JLT,IE(4),NEL
7878C REAL
7879 my_real
7880 . x(3,*),xc,yc,zc,xmin0,ymin0,zmin0,dmin
7881C-----------------------------------------------
7882C L o c a l V a r i a b l e s
7883C-----------------------------------------------
7884 INTEGER N,I,II,ND,INDEX(NEL),IEL,J
7885 my_real
7886 . xmin,xmax,ymin,ymax,zmin,zmax,d,xm,ym,zm,dminl,
7887 . xminl,yminl,zminl
7888C---get reference ele (shell for the moment) for rigid motion compute
7889C---- E_id : nearest the gravity center----
7890 nd =0
7891 DO i = jft,jlt
7892 xmin=ep30
7893 xmax=-ep30
7894 ymin=ep30
7895 ymax=-ep30
7896 zmin=ep30
7897 zmax=-ep30
7898 DO j=1,3
7899 n= ixtg(j+1,i)
7900 xmin=min(xmin,x(1,n))
7901 xmax=max(xmax,x(1,n))
7902 ymin=min(ymin,x(2,n))
7903 ymax=max(ymax,x(2,n))
7904 zmin=min(zmin,x(3,n))
7905 zmax=max(zmax,x(3,n))
7906 END DO
7907 IF((xc < xmin.OR.xc > xmax).AND.(yc < ymin.OR.yc > ymax)
7908 + .AND.(zc < zmin.OR.zc > zmax)) cycle
7909 nd = nd +1
7910 index(nd) = i
7911 END DO
7912 IF (nd ==0) THEN
7913 iel =0
7914 ELSE
7915 DO ii = 1,nd
7916 i = index(ii)
7917 xm = zero
7918 ym = zero
7919 zm = zero
7920 DO j=1,3
7921 n= ixtg(j+1,i)
7922 xm=xm+x(1,n)
7923 ym=ym+x(2,n)
7924 zm=zm+x(3,n)
7925 END DO
7926 xm = third*xm - xc
7927 ym = third*ym - yc
7928 zm = third*zm - zc
7929 xminl=abs(xm)
7930 yminl=abs(ym)
7931 zminl=abs(zm)
7932 IF (xminl<xmin0) THEN
7933 ie(1) = i
7934 xmin0 = xminl
7935 END IF
7936 IF (yminl<ymin0) THEN
7937 ie(2) = i
7938 ymin0 = yminl
7939 END IF
7940 IF (zminl<zmin0) THEN
7941 ie(3) = i
7942 zmin0 = zminl
7943 END IF
7944 d=xm*xm+ym*ym
7945c D=XM*XM+YM*YM+ZM*ZM
7946 IF (d < dmin) THEN
7947 dmin = d
7948C------------- tag tria w/ negative
7949 ie(4) = -i
7950 END IF
7951 END DO
7952 ENDIF
7953c IF (IEL>0 .AND.DMINL<DMIN) THEN
7954c IE(1:3) = IXTG(2:4,IEL)
7955c IE(4) = IE(3)
7956c DMIN= DMINL
7957c END IF
7958C
7959 RETURN
7960 END
7961!||====================================================================
7962!|| spb_rm_rig ../engine/source/implicit/imp_solv.F
7963!||--- called by ------------------------------------------------------
7964!|| imp_solv ../engine/source/implicit/imp_solv.F
7965!||--- calls -----------------------------------------------------
7966!|| getikce ../engine/source/implicit/imp_solv.F
7967!|| spb_ieref3 ../engine/source/implicit/imp_solv.F
7968!|| spb_ieref_bc ../engine/source/implicit/imp_solv.F
7969!|| spb_ref_nds ../engine/source/implicit/imp_solv.F
7970!|| spb_rgmod ../engine/source/implicit/imp_solv.F
7971!|| spmd_e_ref ../engine/source/mpi/implicit/imp_spmd.F
7972!|| spmd_n_ref ../engine/source/mpi/implicit/imp_spmd.F
7973!|| transvg2l ../engine/source/implicit/imp_solv.F
7974!|| transvl2g ../engine/source/implicit/imp_solv.F
7975!|| velrot ../engine/source/constraints/general/rbe2/rbe2v.F
7976!||--- uses -----------------------------------------------------
7977!|| element_mod ../common_source/modules/elements/element_mod.F90
7978!|| imp_spbrm ../engine/share/modules/impbufdef_mod.F
7979!||====================================================================
7980 SUBROUTINE spb_rm_rig(
7981 1 X ,IXC ,IXTG ,NDOF ,IDDL ,
7982 2 IKC ,D_IMP ,DR_IMP ,ICODT ,ICODR ,
7983 3 SKEW ,ISKEW ,itab )
7984C-----------------------------------------------
7985C M o d u l e s
7986C-----------------------------------------------
7987 USE imp_spbrm
7988 use element_mod , only : nixc,nixtg
7989C-----------------------------------------------
7990C I m p l i c i t T y p e s
7991C-----------------------------------------------
7992#include "implicit_f.inc"
7993C-----------------------------------------------
7994C C o m m o n B l o c k s
7995C-----------------------------------------------
7996#include "com01_c.inc"
7997#include "com04_c.inc"
7998#include "param_c.inc"
7999#include "units_c.inc"
8000#include "task_c.inc"
8001#include "impl1_c.inc"
8002C-----------------------------------------------
8003C D u m m y A r g u m e n t s
8004C-----------------------------------------------
8005 INTEGER ICODT(*),ICODR(*),ISKEW(*)
8006 integer
8007 . ixc(nixc,*), ixtg(nixtg,*), ndof(*),iddl(*),ikc(*),itab(*)
8008C REAL
8009 my_real
8010 . x(3,*) ,d_imp(3,*) ,dr_imp(3,*) ,skew(lskew,*)
8011C-----------------------------------------------
8012C L o c a l V a r i a b l e s
8013C-----------------------------------------------
8014 INTEGER N,I,J,ND,NN,IE,IEM,NKC,K,ILOC,ISK,IKCL(6)
8015 my_real
8016 . dmin,d,xc,yc,zc,dtra(3),drot(3),drs(3),lsm(3),
8017 . x0,y0,z0,dtral(3),drotl(3),lsml(3),drs1(3),drot1(3),drotl1(3)
8018C------remove rigid motion of springback (increment)
8019C----- find reference element: IF BCS the one of smallest Disp w/ BCS (doing ech time)
8020C------------------------------else nearest the GC of blank (done only once)
8021C------should update X_REF,D_REF each cycle---
8022C------case input 3N---
8023 IF (irig_m>1) THEN
8024 CALL spb_ref_nds(
8025 1 x ,d_imp ,ndof ,iddl ,ikc ,
8026 2 icodt ,icodr ,iskew ,skew )
8027 IF (ilskew>0) THEN
8028C----get ISK(from E_REF)set [Q],transfert DTRA,DROT to local reset IKCE(6) put (j)=0 for fixing dir
8029 nn = ilskew
8030 isk = iskew(nn)
8031C---------local IKC
8032 rlskew(1:9) = skew(1:9,isk)
8033 CALL getikce(icodt(nn),icodr(nn),ndof(nn),ikce)
8034 END IF
8035 IF (nspmd>1) CALL spmd_n_ref()
8036 ELSE
8037 IF (nbc_b>0) THEN
8038 CALL spb_ieref_bc(
8039 1 x ,ixc ,ixtg ,d_imp ,dmin ,
8040 2 ndof ,iddl ,ikc )
8041 IF (ilskew>0) THEN
8042C----get ISK(from E_REF)set [Q],transfert DTRA,DROT to local reset IKCE(6) put (j)=0 for fixing dir
8043 nn = ilskew
8044 isk = iskew(nn)
8045C---------local IKC
8046 rlskew(1:9) = skew(1:9,isk)
8047 CALL getikce(icodt(nn),icodr(nn),ndof(nn),ikce)
8048 END IF
8049 ELSE
8050 CALL spb_ieref3(
8051 1 x ,ixc ,ixtg ,ndof ,iddl ,
8052 2 ikc ,d_imp ,dr_imp ,dmin )
8053 END IF
8054C--------communication IKCE,X_REF,D_REF,RLSKEW,N_SEG, LSKEW_G
8055 IF (nspmd>1) CALL spmd_e_ref(dmin)
8056 END IF !(IRIG_M>1) THEN
8057C
8058 IF (n_seg==0) RETURN
8059C-----IKCE : only local BCS nodes are initialized-----
8060 CALL spb_rgmod(n_seg ,x_ref ,d_ref ,x ,d_imp ,
8061 + x0 ,y0 ,z0 ,dtra,drot )
8062 IF (nbc_b>0.OR.lskew_g>0) THEN
8063 DO j=1,3
8064 IF (ikce(j)==1) dtra(j)= zero
8065 ENDDO
8066c IF (IRODDL/=0) THEN
8067 DO j=1,3
8068 IF (ikce(j+3)==1) drot(j)=zero
8069 ENDDO
8070c END IF
8071 END IF
8072 IF (lskew_g>0) THEN
8073 CALL transvg2l(rlskew,dtra,dtral)
8074 CALL transvg2l(rlskew,drot,drotl)
8075 DO j=1,3
8076 IF (ikce(j)==1) dtral(j)= zero
8077 IF (ikce(j+3)==1) drotl(j)=zero
8078 ENDDO
8079 IF (iroddl/=0) CALL transvl2g(rlskew,drotl,drot)
8080 DO i =1,numnod
8081 nkc=0
8082 DO j=1,min(3,ndof(i))
8083 nd = iddl(i)+j
8084 IF (ikc(nd)/=0) nkc = nkc + 1
8085 ENDDO
8086 drot1(1:3) = drot(1:3)
8087C--------exclude the node w/all translational fixed
8088 IF (nkc<3.AND.ndof(i)>0) THEN
8089 lsm(1)=x(1,i)-x0
8090 lsm(2)=x(2,i)-y0
8091 lsm(3)=x(3,i)-z0
8092C----transfert LSM to local
8093c CALL TRANSVG2L(RLSKEW,LSM,LSML)
8094 CALL velrot(drotl,lsml,drs)
8095C------otherwise DL(1:3)= DRS+ DTRAL if fixing put DL(j)=0
8096 drs(1:3) = drs(1:3) + dtral(1:3)
8097 IF (nkc>0) THEN
8098C----------suppose the same ISK w/ reference one
8099 CALL getikce(icodt(i),icodr(i),ndof(i),ikcl)
8100 DO j=1,3
8101 drotl1(j) = drotl(j)
8102 IF (ikcl(j)==1) drs(j)= zero
8103 IF (ikcl(j+3)==1) drotl1(j)= zero
8104 ENDDO
8105 CALL transvl2g(rlskew,drotl1,drot1)
8106 END IF !(NKC>0) THEN
8107 CALL transvl2g(rlskew,drs,drs1)
8108C----transfert DL DROT,to global
8109 DO k=1,3
8110 d_imp(k,i)=d_imp(k,i)- drs1(k)
8111 ENDDO
8112 IF (iroddl/=0) THEN
8113 DO k=1,3
8114 dr_imp(k,i)=dr_imp(k,i)- drot1(k)
8115 ENDDO
8116 END IF
8117 END IF
8118 ENDDO
8119 ELSE
8120 DO i =1,numnod
8121 nkc=0
8122 DO j=1,min(3,ndof(i))
8123 nd = iddl(i)+j
8124 IF (ikc(nd)/=0) nkc = nkc + 1
8125 ENDDO
8126C--------exclude the node w/all translational fixed
8127 IF (nkc<3.AND.ndof(i)>0) THEN
8128 lsm(1)=x(1,i)-x0
8129 lsm(2)=x(2,i)-y0
8130 lsm(3)=x(3,i)-z0
8131 CALL velrot(drot,lsm,drs)
8132 DO k=1,3
8133 nd = iddl(i)+k
8134 IF (ikc(nd)==0)d_imp(k,i)=d_imp(k,i)- drs(k)- dtra(k)
8135 ENDDO
8136 IF (iroddl/=0) THEN
8137 DO k=1,3
8138 nd = iddl(i)+k+3
8139 IF (ikc(nd)==0) dr_imp(k,i)=dr_imp(k,i)- drot(k)
8140 ENDDO
8141 END IF
8142 END IF
8143 ENDDO
8144 END IF
8145 IF (ittoff>0 .AND.ncycle==1) THEN
8146 write(iout,*)
8147 write(iout,*)'Segment served as Reference are the following nodes:'
8148 if (irig_m>1) THEN
8149 if (e_ref(1)>0) write(iout,*) 'NODE_ref 1 :',itab(e_ref(1))
8150 if (e_ref(2)>0) write(iout,*) 'NODE_ref 2 :',itab(e_ref(2))
8151 if (e_ref(3)>0) write(iout,*) 'NODE_ref 3 :',itab(e_ref(3))
8152 else
8153 if (e_ref(1)>0.AND.e_ref(2)>0.AND.e_ref(3)>0) then
8154 write(iout,*) (itab(e_ref(i)),i=1,n_seg)
8155 else
8156 write(iout,*) (e_ref(i),i=1,n_seg)
8157 end if
8158 end if
8159 write(iout,*)'Reference point at this moment:'
8160 write(iout,*)x0 ,y0 ,z0
8161 write(iout,*)'DTRA,DROT,N_SEG,ncycle=',n_seg,ncycle
8162 write(iout,*)dtra(1),dtra(2),dtra(3)
8163 write(iout,*)drot(1),drot(2),drot(3)
8164 write(iout,*)'ILSKEW,LSKEW_G,ISPMD=',ilskew,lskew_g,ispmd
8165 write(iout,*)rlskew(1),rlskew(2),rlskew(3)
8166 write(iout,*)
8167 END IF
8168c IF (ITTOFF>0.AND.NCYCLE>1) THEN
8169c write(iout,*)
8170c write(iout,*)'DTRA,DROT,N_SEG,ILOC,ncycle=',N_SEG,ILOC,ncycle
8171c write(iout,*)DTRA(1),DTRA(2),DTRA(3)
8172c write(iout,*)DROT(1),DROT(2),DROT(3)
8173c write(iout,*)'LSKEW_G,ISPMD=',LSKEW_G,ISPMD
8174c write(iout,*)RLSKEW(1),RLSKEW(2),RLSKEW(3)
8175c write(iout,*)
8176c END IF
8177c write(iout,*)'E_REF(i)=',(itab(E_REF(i)),i=1,4)
8178c IF (ISPMD==0) THEN
8179c write(iout,*)'X0,DTRA,DROT,N_SEG,ncycle=',N_SEG,ncycle
8180c write(iout,*)X0 ,Y0 ,Z0
8181c write(iout,*)DTRA(1),DTRA(2),DTRA(3)
8182c write(iout,*)DROT(1),DROT(2),DROT(3)
8183c END IF
8184C------------------------------------------
8185 RETURN
8186 END
8187!||====================================================================
8188!|| spb_ieref_bc ../engine/source/implicit/imp_solv.F
8189!||--- called by ------------------------------------------------------
8190!|| spb_rm_rig ../engine/source/implicit/imp_solv.F
8191!||--- calls -----------------------------------------------------
8192!|| spmd_min_s ../engine/source/mpi/implicit/imp_spmd.F
8193!||--- uses -----------------------------------------------------
8194!|| element_mod ../common_source/modules/elements/element_mod.F90
8195!|| imp_spbrm ../engine/share/modules/impbufdef_mod.F
8196!||====================================================================
8197 SUBROUTINE spb_ieref_bc(
8198 1 X ,IXC ,IXTG ,D_IMP ,DMIN ,
8199 2 NDOF ,IDDL ,IKC )
8200C-----------------------------------------------
8201C M o d u l e s
8202C-----------------------------------------------
8203 USE imp_spbrm
8204 use element_mod , only : nixc,nixtg
8205C-----------------------------------------------
8206C I m p l i c i t T y p e s
8207C-----------------------------------------------
8208#include "implicit_f.inc"
8209C-----------------------------------------------
8210C C o m m o n B l o c k s
8211C-----------------------------------------------
8212#include "com01_c.inc"
8213C-----------------------------------------------
8214C D u m m y A r g u m e n t s
8215C-----------------------------------------------
8216 integer
8217 . ndof(*),iddl(*),ikc(*),ixc(nixc,*), ixtg(nixtg,*)
8218C REAL
8219 my_real
8220 . dmin,x(3,*) ,d_imp(3,*)
8221C-----------------------------------------------
8222C L o c a l V a r i a b l e s
8223C-----------------------------------------------
8224 INTEGER N,I,J,ND,NN,IE,IEM,K
8225 my_real
8226 . d(3),dd,dmint
8227C------remove rigid motion of springback (incremental)
8228C----- find reference element: IF BCS the smallest Disp(at element center)) w/BCS C-------
8229C------doing once: NCYCLE=1
8230 dmin=ep30
8231 IF (ncycle==1 )THEN
8232 ilskew = 0
8233 lskew_g = 0
8234 ikce(1:6) = 0
8235 e_ref(1:4) = 0
8236 DO i = 1, ne_bc4
8237 ie =ie_bc4(i)
8238 DO k = 1,3
8239 d(k) = zero
8240 DO j= 1,4
8241 n = ixc(j+1,ie)
8242 d(k) = d(k) + d_imp(k,n)
8243 END DO
8244 END DO
8245 dd = min(abs(d(1)),abs(d(2)),abs(d(3)))
8246 IF (dd < dmin) THEN
8247 dmin = dd
8248 e_ref(1:4) = ixc(2:5,ie)
8249 END IF
8250 END DO
8251C
8252 DO i = 1, ne_bc3
8253 ie =ie_bc3(i)
8254 DO k = 1,3
8255 d(k) = zero
8256 DO j= 1,3
8257 n = ixtg(j+1,ie)
8258 d(k) = d(k) + d_imp(k,n)
8259 END DO
8260 END DO
8261 dd = min(abs(d(1)),abs(d(2)),abs(d(3)))
8262 IF (dd < dmin) THEN
8263 dmin = dd
8264 e_ref(1:3) = ixtg(2:4,ie)
8265 e_ref(4) = e_ref(3)
8266 END IF
8267 END DO
8268C-----not to use allow BCS (global only IKC=1) dof direction
8269C----- add BCS w/ SKEW (ILSKEW=1 w/ ref); Ud (IKC=2,9) could also be added--
8270 DO j = 1, 4
8271 n = e_ref(j)
8272 IF (n==0) cycle
8273 DO k= 1,ndof(n)
8274 nd = iddl(n)+k
8275 IF (ikc(nd)>0.AND.ikce(k)==0) ikce(k) = 1
8276 END DO
8277 END DO
8278C--------to limit change during the iteration and dependant of np
8279 IF (nspmd>1) THEN
8280 dmint = dmin
8281 CALL spmd_min_s(dmint)
8282C------not in this domain-----
8283 IF (dmint<dmin) THEN
8284 e_ref(1:4) = 0
8285 END IF
8286 END IF
8287 IF ((e_ref(1)+e_ref(2)+e_ref(3)+e_ref(4))==0) THEN
8288 n_seg = 0
8289 ELSEIF(e_ref(4) == e_ref(3)) THEN
8290 n_seg = 3
8291 ELSE
8292 n_seg = 4
8293 END IF
8294 IF (n_seg>0) THEN
8295 DO j = 1, 4
8296 n = e_ref(j)
8297 IF (n==0) cycle
8298 DO k= 1,ndof(n)
8299 nd = iddl(n)+k
8300 IF (ikc(nd)==8) ilskew = n
8301 END DO
8302 END DO
8303 IF (ilskew >0) lskew_g=1
8304 END IF
8305C-------Ncycle>1
8306 ELSEIF ((e_ref(1)+e_ref(2)+e_ref(3)+e_ref(4)) >0) THEN
8307 DO k = 1, 3
8308 d(k) = zero
8309 DO j= 1,3
8310 n = e_ref(j)
8311 d(k) = d(k) + d_imp(k,n)
8312 END DO
8313 IF (e_ref(4) /= e_ref(3)) THEN
8314 n = e_ref(4)
8315 d(k) = d(k) + d_imp(k,n)
8316 END IF
8317 END DO
8318 dmin = min(abs(d(1)),abs(d(2)),abs(d(3)))
8319 END IF !(NCYCLE==1 )THEN
8320 x_ref(1:3,1:4) = zero
8321 d_ref(1:3,1:4) = zero
8322 IF (n_seg > 0) THEN
8323 DO j= 1,4
8324 n = e_ref(j)
8325 x_ref(1:3,j)= x(1:3,n)
8326 d_ref(1:3,j)= d_imp(1:3,n)
8327 END DO
8328 END IF
8329C------------------------------------------
8330 RETURN
8331 END
8332!||====================================================================
8333!|| spb_rgmod ../engine/source/implicit/imp_solv.F
8334!||--- called by ------------------------------------------------------
8335!|| spb_rm_rig ../engine/source/implicit/imp_solv.F
8336!||====================================================================
8337 SUBROUTINE spb_rgmod(N_SEG,X_REF ,D_REF ,X ,D ,
8338 1 X0 ,Y0 ,Z0 ,DTRA ,DROT )
8339C-----------------------------------------------
8340C I m p l i c i t T y p e s
8341C-----------------------------------------------
8342#include "implicit_f.inc"
8343C-----------------------------------------------
8344C D u m m y A r g u m e n t s
8345C-----------------------------------------------
8346 INTEGER N_SEG
8347C REAL
8348 my_real
8349 . x_ref(3,4),d_ref(3,4),x(3,*),d(3,*),dtra(3),drot(3),
8350 . x0 ,y0 ,z0
8351C-----------------------------------------------
8352C L o c a l V a r i a b l e s
8353C-----------------------------------------------
8354 INTEGER I, J, II, L, JJ,NJ,K,NIR
8355C REAL
8356 my_real
8357 . xx,yy,zz,xxx,yyy,zzz,xy,yz,zx,xy2,yz2,zx2,
8358 . b1,b2,b3,c1,c2,c3,facm,rj(3,3,4),
8359 . x22,y22,z22,det,xm(4),ym(4),zm(4)
8360 my_real
8361 . xs,ys,zs
8362C------------------------------------
8363C JACOBIAN MATRIX [C]
8364C------------------------------------
8365 nir=n_seg
8366 DO j=1,nir
8367C NJ=IRECT(J)
8368 xm(j)=x_ref(1,j)
8369 ym(j)=x_ref(2,j)
8370 zm(j)=x_ref(3,j)
8371 ENDDO
8372 IF(nir==3) THEN
8373 xm(4)=zero
8374 ym(4)=zero
8375 zm(4)=zero
8376 ENDIF
8377 facm = one / nir
8378C----------------------------------------------------
8379C AVERAGE ROTATION SPEED OF THE MAIN SEGMENT
8380C----------------------------------------------------
8381 x0=facm*(xm(1)+xm(2)+xm(3)+xm(4))
8382 y0=facm*(ym(1)+ym(2)+ym(3)+ym(4))
8383 z0=facm*(zm(1)+zm(2)+zm(3)+zm(4))
8384 DO j=1,nir
8385 xm(j)=xm(j)-x0
8386 ym(j)=ym(j)-y0
8387 zm(j)=zm(j)-z0
8388 ENDDO
8389C-------
8390 xx=0
8391 yy=0
8392 zz=0
8393 xy=0
8394 yz=0
8395 zx=0
8396 DO j=1,nir
8397 xx=xx+ xm(j)*xm(j)
8398 yy=yy+ ym(j)*ym(j)
8399 zz=zz+ zm(j)*zm(j)
8400 xy=xy+ xm(j)*ym(j)
8401 yz=yz+ ym(j)*zm(j)
8402 zx=zx+ zm(j)*xm(j)
8403 ENDDO
8404 zzz=xx+yy
8405 xxx=yy+zz
8406 yyy=zz+xx
8407 xy2=xy*xy
8408 yz2=yz*yz
8409 zx2=zx*zx
8410 det= xxx*yyy*zzz -xxx*yz2 -yyy*zx2 -zzz*xy2 -two*xy*yz*zx
8411 det=one/det
8412 b1=(zzz*yyy-yz2)*det
8413 b2=(xxx*zzz-zx2)*det
8414 b3=(yyy*xxx-xy2)*det
8415 c3=(zzz*xy+yz*zx)*det
8416 c1=(xxx*yz+zx*xy)*det
8417 c2=(yyy*zx+xy*yz)*det
8418 DO j=1,nir
8419 x22 = c1*xm(j)
8420 y22 = c2*ym(j)
8421 z22 = c3*zm(j)
8422C-------RJ=(R^tR)^-1Rj^t-(j=1,ndir)---
8423 rj(1,1,j)=z22-y22
8424 rj(2,1,j)=b2*zm(j)-c1*ym(j)
8425 rj(3,1,j)=c1*zm(j)-b3*ym(j)
8426 rj(1,2,j)=-b1*zm(j)+c2*xm(j)
8427 rj(2,2,j)=-z22+x22
8428 rj(3,2,j)=-c2*zm(j)+b3*xm(j)
8429 rj(1,3,j)=b1*ym(j)-c3*xm(j)
8430 rj(2,3,j)=c3*ym(j)-b2*xm(j)
8431 rj(3,3,j)=y22-x22
8432 ENDDO
8433C
8434 DO i=1,3
8435 dtra(i)= zero
8436 drot(i) = zero
8437 DO j=1,nir
8438C NJ=IRECT(J)
8439 drot(i)=drot(i)+rj(i,1,j)*d_ref(1,j)+
8440 . rj(i,2,j)*d_ref(2,j)+rj(i,3,j)*d_ref(3,j)
8441 dtra(i)=dtra(i)+facm*d_ref(i,j)
8442 END DO
8443 END DO
8444C
8445 RETURN
8446 END
8447!||====================================================================
8448!|| spb_ieref3 ../engine/source/implicit/imp_solv.F
8449!||--- called by ------------------------------------------------------
8450!|| spb_rm_rig ../engine/source/implicit/imp_solv.F
8451!||--- calls -----------------------------------------------------
8452!|| spmd_min_s ../engine/source/mpi/implicit/imp_spmd.F
8453!||--- uses -----------------------------------------------------
8454!|| element_mod ../common_source/modules/elements/element_mod.F90
8455!|| imp_spbrm ../engine/share/modules/impbufdef_mod.f
8456!||====================================================================
8457 SUBROUTINE spb_ieref3(
8458 1 X ,IXC ,IXTG ,NDOF ,IDDL ,
8459 2 IKC ,D_IMP ,DR_IMP ,DMIN )
8460C-----------------------------------------------
8461C M o d u l e s
8462C-----------------------------------------------
8463 USE imp_spbrm
8464 use element_mod , only : nixc,nixtg
8465C-----------------------------------------------
8466C I m p l i c i t T y p e s
8467C-----------------------------------------------
8468#include "implicit_f.inc"
8469C-----------------------------------------------
8470C C o m m o n B l o c k s
8471C-----------------------------------------------
8472#include "com01_c.inc"
8473C-----------------------------------------------
8474C D u m m y A r g u m e n t s
8475C-----------------------------------------------
8476 integer
8477 . ixc(nixc,*), ixtg(nixtg,*), ndof(*),iddl(*),ikc(*)
8478C REAL
8479 my_real
8480 . dmin,x(3,*) ,d_imp(3,*) ,dr_imp(3,*)
8481C-----------------------------------------------
8482C L o c a l V a r i a b l e s
8483C-----------------------------------------------
8484 INTEGER N,I,J,ND,NN,IE,IEM,K,NSAVE(4)
8485 my_real
8486 . d(3),dd,dr(3),ddr,dmint
8487C----- find reference element: around element center))
8488C--------NSAVE(1) : XMIN, 2 : YMIN, 3 : ZMIN, 4 : DMIN
8489 dmin=ep30
8490 IF (ncycle==1 )THEN
8491 nsave(1:4) = e_ref(1:4)
8492 e_ref(1:4) = 0
8493 DO i = 1,4
8494 ie =iabs(nsave(i))
8495 IF (ie==0) cycle
8496 DO k = 1,3
8497 d(k) = zero
8498 dr(k) = zero
8499 IF (nsave(4)<0) THEN
8500 DO j= 1,3
8501 n = ixtg(j+1,ie)
8502 d(k) = d(k) + d_imp(k,n)
8503 dr(k) = dr(k) + dr_imp(k,n)
8504 END DO
8505 ELSE
8506 DO j= 1,4
8507 n = ixc(j+1,ie)
8508 d(k) = d(k) + d_imp(k,n)
8509 dr(k) = dr(k) + dr_imp(k,n)
8510 END DO
8511 END IF
8512 END DO
8513 dd = min(abs(d(1)),abs(d(2)),abs(d(3)))
8514 ddr = max(abs(dr(1)),abs(dr(2)),abs(dr(3)))
8515C -------min(max(DR(j))) (1:4)------
8516 IF (ddr < dmin) THEN
8517 dmin = ddr
8518 IF (nsave(4)<0) THEN
8519 e_ref(1:3) = ixtg(2:4,ie)
8520 e_ref(4) = e_ref(3)
8521 ELSE
8522 e_ref(1:4) = ixc(2:5,ie)
8523 END IF
8524 END IF
8525 END DO
8526C
8527 IF (nspmd>1) THEN
8528 dmint = dmin
8529 CALL spmd_min_s(dmint)
8530C------not in this domain-----
8531 IF (dmint<dmin) THEN
8532 e_ref(1:4) = 0
8533 END IF
8534 END IF
8535 IF ((e_ref(1)+e_ref(2)+e_ref(3)+e_ref(4))==0) THEN
8536 n_seg = 0
8537 ELSEIF(e_ref(4) == e_ref(3)) THEN
8538 n_seg = 3
8539 ELSE
8540 n_seg = 4
8541 END IF
8542C---- Ncycle>1
8543 ELSE
8544 IF ((e_ref(1)+e_ref(2)+e_ref(3)+e_ref(4))==0) n_seg = 0
8545 IF (n_seg>0) THEN
8546 DO k = 1, 3
8547 dr(k) = zero
8548 DO j= 1,3
8549 n = e_ref(j)
8550 dr(k) = dr(k) + dr_imp(k,n)
8551 END DO
8552 IF (e_ref(4) /= e_ref(3)) THEN
8553 n = e_ref(4)
8554 dr(k) = dr(k) + dr_imp(k,n)
8555 END IF
8556 END DO
8557 dmin = max(abs(dr(1)),abs(dr(2)),abs(dr(3)))
8558 END IF !(N_SEG>0) THEN
8559 END IF !(NCYCLE==1 )THEN
8560 x_ref(1:3,1:4) = zero
8561 d_ref(1:3,1:4) = zero
8562 IF (n_seg > 0) THEN
8563 DO j= 1,4
8564 n = e_ref(j)
8565 x_ref(1:3,j)= x(1:3,n)
8566 d_ref(1:3,j)= d_imp(1:3,n)
8567 END DO
8568 END IF
8569C------------------------------------------
8570 RETURN
8571 END
8572!||====================================================================
8573!|| imp_intbuf_ini ../engine/source/implicit/imp_solv.F
8574!||--- called by ------------------------------------------------------
8575!|| dim_int7 ../engine/source/implicit/ind_glob_k.F
8576!||--- uses -----------------------------------------------------
8577!|| imp_intbufdef ../engine/share/modules/imp_mod_def.F90
8578!||====================================================================
8579 SUBROUTINE imp_intbuf_ini(IMP_INTBUF_TAB,NIMP)
8580C-----------------------------------------------
8581C M o d u l e s
8582C-----------------------------------------------
8583 USE imp_intbufdef
8584C-----------------------------------------------
8585C I m p l i c i t T y p e s
8586C-----------------------------------------------
8587#include "implicit_f.inc"
8588C-----------------------------------------------
8589C C o m m o n B l o c k s
8590C-----------------------------------------------
8591#include "com04_c.inc"
8592C-----------------------------------------------
8593C D u m m y A r g u m e n t s
8594C-----------------------------------------------
8595 TYPE(imp_intbuf_struct_) IMP_INTBUF_TAB(*)
8596 INTEGER NIMP(*)
8597C-----------------------------------------------
8598C L o c a l V a r i a b l e s
8599C-----------------------------------------------
8600 INTEGER I,N,NI,SIZ,I_CONT
8601C=======================================================================
8602
8603 DO ni= 1, ninter
8604 i_cont = nimp(ni)
8605 imp_intbuf_tab(ni)%S_I_STOK = 1
8606 imp_intbuf_tab(ni)%S_CAND_N = 0
8607 imp_intbuf_tab(ni)%S_CAND_E = 0
8608 imp_intbuf_tab(ni)%S_INDSUBT = 0
8609 imp_intbuf_tab(ni)%S_HJ = 0
8610 imp_intbuf_tab(ni)%S_NJ = 0
8611 imp_intbuf_tab(ni)%S_STIF = 0
8612 ALLOCATE(imp_intbuf_tab(ni)%I_STOK(imp_intbuf_tab(ni)%S_I_STOK))
8613 imp_intbuf_tab(ni)%I_STOK(1:imp_intbuf_tab(ni)%S_I_STOK) = 0
8614 IF (i_cont > 0) THEN
8615 imp_intbuf_tab(ni)%S_CAND_N = i_cont
8616 imp_intbuf_tab(ni)%S_CAND_E = i_cont
8617 imp_intbuf_tab(ni)%S_INDSUBT = i_cont
8618 imp_intbuf_tab(ni)%S_HJ = 4*i_cont
8619 imp_intbuf_tab(ni)%S_NJ = 3*i_cont
8620 imp_intbuf_tab(ni)%S_STIF = i_cont
8621C------Allocate, ini to zero
8622 ALLOCATE(imp_intbuf_tab(ni)%CAND_N(imp_intbuf_tab(ni)%S_CAND_N))
8623 imp_intbuf_tab(ni)%CAND_N(1:imp_intbuf_tab(ni)%S_CAND_N) = 0
8624 ALLOCATE(imp_intbuf_tab(ni)%CAND_E(imp_intbuf_tab(ni)%S_CAND_E))
8625 imp_intbuf_tab(ni)%CAND_E(1:imp_intbuf_tab(ni)%S_CAND_E) = 0
8626 ALLOCATE(imp_intbuf_tab(ni)%INDSUBT(imp_intbuf_tab(ni)%S_INDSUBT))
8627 imp_intbuf_tab(ni)%INDSUBT(1:imp_intbuf_tab(ni)%S_INDSUBT) = 0
8628C
8629 ALLOCATE(imp_intbuf_tab(ni)%HJ(imp_intbuf_tab(ni)%S_HJ))
8630 imp_intbuf_tab(ni)%HJ(1:imp_intbuf_tab(ni)%S_HJ) = zero
8631 ALLOCATE(imp_intbuf_tab(ni)%NJ(imp_intbuf_tab(ni)%S_NJ))
8632 imp_intbuf_tab(ni)%NJ(1:imp_intbuf_tab(ni)%S_NJ) = zero
8633 ALLOCATE(imp_intbuf_tab(ni)%STIF(imp_intbuf_tab(ni)%S_STIF))
8634 imp_intbuf_tab(ni)%STIF(1:imp_intbuf_tab(ni)%S_STIF) = zero
8635 END IF
8636
8637 ENDDO !NI=1,NINTER
8638
8639C-----
8640 RETURN
8641
8642 END SUBROUTINE imp_intbuf_ini
8643!||====================================================================
8644!|| imp_errmumps ../engine/source/implicit/imp_solv.F
8645!||--- called by ------------------------------------------------------
8646!|| spmd_mumps_exec ../engine/source/mpi/implicit/imp_spmd.F
8647!||--- calls -----------------------------------------------------
8648!|| imp_stop ../engine/source/implicit/imp_solv.F
8649!||====================================================================
8650 SUBROUTINE imp_errmumps(IERR)
8651C-----------------------------------------------
8652C I m p l i c i t T y p e s
8653C-----------------------------------------------
8654#include "implicit_f.inc"
8655C-----------------------------------------------
8656C C o m m o n B l o c k s
8657C-----------------------------------------------
8658#include "units_c.inc"
8659C-----------------------------------------------
8660C D u m m y A r g u m e n t s
8661C-----------------------------------------------
8662 INTEGER IERR,ISTOP
8663C-----------------------------------------------
8664C L o c a l V a r i a b l e s
8665C-----------------------------------------------
8666 WRITE(istdo,1000)ierr
8667 WRITE(iout,1000)ierr
8668 SELECT CASE (-ierr)
8669 CASE(7,8,9,11,13,14,15,17)
8670 WRITE(istdo,1030)
8671 WRITE(iout,1010)
8672 CASE(6,10)
8673 WRITE(istdo,2000)
8674 WRITE(iout,2010)
8675 END SELECT
8676 IF(ierr<0)THEN
8677 istop=-4
8678 CALL imp_stop(istop)
8679 END IF
8680C
8681 RETURN
8682 1000 FORMAT(/
8683 . ' ** linear solver mumps error code: ',I6/)
8684 1030 FORMAT(/
8685 . ' ** error memory issue ' /)
8686 1010 FORMAT(/
8687 . ' ** error memory issue. possible solutions:' /,
8688 . ' *run on a computer with more memory ;' /,
8689 . ' *try less threads and less procs per computer node ;' /,
8690 . ' *CLOSE other applications ; ' /)
8691 2000 FORMAT(/
8692 . ' ** error of singular matrix ' /)
8693 2010 FORMAT(/
8694 . ' ** error of singular matrix. possible solutions:' /,
8695 . ' *check IF the model is well conditioned ;' /,
8696 . ' *trying quasi-static solution ; ' /)
8697 END
8698
8699
8700
8701!||====================================================================
8702!|| pvp_k ../engine/source/implicit/imp_solv.F
8703!||--- called by ------------------------------------------------------
8704!|| imp_chkm ../engine/source/implicit/imp_solv.F
8705!||--- calls -----------------------------------------------------
8706!|| jacobien ../engine/source/implicit/imp_glob_k.F
8707!|| minv_k ../engine/source/implicit/imp_solv.F
8708!||--- uses -----------------------------------------------------
8709!|| ecnd_mod ../engine/share/modules/ecdn_mod.F
8710!||====================================================================
8711 SUBROUTINE PVP_K(ND ,IADK,JDIK,IDDL ,INLOC,
8712 . NDOF,ITAB,K_DIAG,K_LT ,LAMDA, NODE,MS )
8713C----6---------------------------------------------------------------7---------8
8714 USE ECND_MOD
8715C----6---------------------------------------------------------------7---------8
8716C I m p l i c i t T y p e s
8717C-----------------------------------------------
8718#include "implicit_f.inc"
8719C-----------------------------------------------
8720C C o m m o n B l o c k s
8721C-----------------------------------------------
8722#include "com04_c.inc"
8723#include "units_c.inc"
8724C-----------------------------------------------
8725C D u m m y A r g u m e n t s
8726C-----------------------------------------------
8727 INTEGER ND,NODE
8728 INTEGER JDIK(*) ,IADK(*),IDDL(*),INLOC(*),NDOF(*),ITAB(*)
8729C REAL
8730 my_real
8731 . K_DIAG(*) ,K_LT(*) ,LAMDA,MS(*)
8732C-----------------------------------------------
8733C L o c a l V a r i a b l e s
8734C-----------------------------------------------
8735 INTEGER I,K,J,IK,ID,JD,L,N,NN,JJ,IDT
8736 my_real
8737 . KE(ND,ND) ,EV(ND,ND),EW(ND),LA,TOL,MSD(ND),MSIJ,TOL1
8738C----6----------------------------------
8739 TOL=EM5
8740 TOL1=EM10
8741 KE(1:ND,1:ND)=ZERO
8742 NODE = 0
8743 LAMDA = ZERO
8744 IF (NS10E==0) THEN
8745C-----taking into account to M-1
8746 DO N =1,NUMNOD
8747 I=INLOC(N)
8748 DO J=1,NDOF(I)
8749 IK = IDDL(I)+J
8750 MSD(IK)=MS(I)
8751C----free node
8752 IF (MSD(IK)<EM20) MSD(IK)=ONE
8753 ENDDO
8754 ENDDO
8755 DO K=1,ND
8756 KE(K,K) = K_DIAG(K)/MSD(K)
8757 DO J = IADK(K),IADK(K+1)-1
8758 JD = JDIK(J)
8759 MSIJ=ONE/SQRT(MSD(K))/SQRT(MSD(JD))
8760 KE(K,JD) = K_LT(J)*MSIJ
8761 KE(JD,K) = KE(K,JD)
8762 ENDDO
8763 ENDDO
8764 ELSE
8765C-------itet=2 (not dumped [M]), should not mix w/ other elements
8766 DO K=1,ND
8767 KE(K,K) = K_DIAG(K)
8768 DO J = IADK(K),IADK(K+1)-1
8769 JD = JDIK(J)
8770 KE(K,JD) = K_LT(J)
8771 KE(JD,K) = KE(K,JD)
8772 ENDDO
8773 ENDDO
8774 CALL MINV_K(ND ,ICNDS10,IDDL ,INLOC,NDOF,
8775 . MS ,TOL ,KE )
8776 END IF !(NS10E==0) THEN
8777 CALL JACOBIEN(KE,ND,EW,EV,TOL1,LAMDA)
8778C--- Node: N'Direction: J
8779 ID = 0
8780 DO K=1,ND
8781 IF (EW(K)>=LAMDA) ID = K
8782 IF (ID > 0 ) CYCLE
8783 ENDDO
8784 DO N =1,NUMNOD
8785 I=INLOC(N)
8786 JJ = 0
8787 DO J=1,NDOF(I)
8788 IK = IDDL(I)+J
8789 IF (IK==ID) JJ= J
8790 ENDDO
8791 IF (JJ > 0) THEN
8792 NODE= N
8793 WRITE(IOUT,*)'1er eigenvalue(k/m) of node+dir:',LAMDA,ITAB(N),JJ
8794 CYCLE
8795 END IF
8796 ENDDO
8797C
8798 RETURN
8799 END
8800!||====================================================================
8801!|| minv_k ../engine/source/implicit/imp_solv.F
8802!||--- called by ------------------------------------------------------
8803!|| pvp_k ../engine/source/implicit/imp_solv.F
8804!||--- calls -----------------------------------------------------
8805!|| jacobien ../engine/source/implicit/imp_glob_k.F
8806!||====================================================================
8807 SUBROUTINE MINV_K(ND ,ICNDS10,IDDL ,INLOC,NDOF,
8808 . MS ,TOL ,KE )
8809C----6---------------------------------------------------------------7---------8
8810C I m p l i c i t T y p e s
8811C-----------------------------------------------
8812#include "implicit_f.inc"
8813C-----------------------------------------------
8814C C o m m o n B l o c k s
8815C-----------------------------------------------
8816#include "com04_c.inc"
8817C-----------------------------------------------
8818C D u m m y A r g u m e n t s
8819C-----------------------------------------------
8820 INTEGER ND
8821 INTEGER ICNDS10(3,*),IDDL(*),INLOC(*),NDOF(*)
8822C REAL
8823 my_real
8824 . KE(ND,ND) ,MS(*),TOL
8825C-----------------------------------------------
8826C L o c a l V a r i a b l e s
8827C-----------------------------------------------
8828 INTEGER I,K,J,IK,ID,JD,L,N,NN,N1,N2,II,JJ,JK
8829 my_real
8830 . EV(ND,ND),EW(ND),
8831 . LA,MSD(ND),MSIJ,LAMDA,ME(ND,ND),MSND,MSII
8832C----6----------------------------------
8833 LAMDA = ZERO
8834 ME(1:ND,1:ND) = ZERO
8835 DO I =1,NS10E
8836 NN = IABS(ICNDS10(1,I))
8837 N1 = ICNDS10(2,I)
8838 N2 = ICNDS10(3,I)
8839 ID=INLOC(NN)
8840 MSND = MS(ID)
8841 DO J=1,NDOF(ID)
8842 IK = IDDL(ID)+J
8843 ME(IK,IK)=ME(IK,IK)+MSND
8844 END DO
8845 II=INLOC(N1)
8846 MSII = THIRD*MS(II) + FOURTH*MSND
8847 DO J=1,NDOF(II)
8848 IK = IDDL(II)+J
8849 ME(IK,IK)=ME(IK,IK)+MSII
8850 END DO
8851 JJ=INLOC(N2)
8852 MSII = THIRD*MS(JJ) + FOURTH*MSND
8853 DO J=1,NDOF(JJ)
8854 IK = IDDL(JJ)+J
8855 ME(IK,IK)=ME(IK,IK)+MSII
8856 END DO
8857C--------- m12
8858 MSII = FOURTH*MSND
8859C--------suppose NDOF(II)= NDOF(JJ) = NDOF(ID)
8860 DO J=1,NDOF(II)
8861 IK = IDDL(II)+J
8862 JK = IDDL(JJ)+J
8863 ME(IK,JK)=ME(IK,JK)+MSII
8864 ME(JK,IK)=ME(JK,IK)+MSII
8865 END DO
8866C--------- m13,m23
8867 MSII = -HALF*MSND
8868 DO J=1,NDOF(II)
8869 IK = IDDL(II)+J
8870 JK = IDDL(ID)+J
8871 ME(IK,JK)=ME(IK,JK)+MSII
8872 ME(JK,IK)=ME(JK,IK)+MSII
8873 END DO
8874 DO J=1,NDOF(JJ)
8875 IK = IDDL(JJ)+J
8876 JK = IDDL(ID)+J
8877 ME(IK,JK)=ME(IK,JK)+MSII
8878 ME(JK,IK)=ME(JK,IK)+MSII
8879 END DO
8880 END DO !I =1,NS10E
8881 DO I =1,ND
8882 DO J =I,ND
8883 ME(J,I)=ME(I,J)
8884 END DO
8885 END DO
8886 CALL JACOBIEN(ME,ND,EW,EV,TOL,LAMDA)
8887C-------[EV]'-> [EV]*EW^-1/2
8888 DO I =1,ND
8889c print *,'M, ME(I,I),I=',ME(I,I),I
8890 EW(I)=ONE/SQRT(EW(I))
8891 END DO
8892 DO I =1,ND
8893 DO J =1,ND
8894 EV(I,J)=EV(I,J)*EW(J)
8895 END DO
8896 END DO
8897C-------[K]-> [EV]^t*[K]*[EV]
8898 ME(1:ND,1:ND) = ZERO
8899 DO I=1,ND
8900 DO J=1,ND
8901 DO K = 1,ND
8902 ME(I,J)=ME(I,J)+KE(I,K)*EV(K,J)
8903 ENDDO
8904 ENDDO
8905 ENDDO
8906 KE(1:ND,1:ND) = ZERO
8907 DO I=1,ND
8908 DO J=1,ND
8909 DO K = 1,ND
8910 KE(I,J)=KE(I,J)+EV(K,I)*ME(K,J)
8911 ENDDO
8912 ENDDO
8913 ENDDO
8914C
8915 RETURN
8916 END
8917!||====================================================================
8918!|| getikce ../engine/source/implicit/imp_solv.F
8919!||--- called by ------------------------------------------------------
8920!|| spb_ref_nds ../engine/source/implicit/imp_solv.F
8921!|| spb_rm_rig ../engine/source/implicit/imp_solv.F
8922!||====================================================================
8923 SUBROUTINE GETIKCE(ICT ,ICR,K,IFIX )
8924C-----------------------------------------------
8925C I m p l i c i t T y p e s
8926C-----------------------------------------------
8927#include "implicit_f.inc"
8928C-----------------------------------------------
8929C D u m m y A r g u m e n t s
8930C-----------------------------------------------
8931 INTEGER ICT,ICR,IFIX(6),K
8932C-----------------------------------------------
8933C L o c a l V a r i a b l e s
8934C-----------------------------------------------
8935 INTEGER ND
8936C----------------BC-------------------------
8937 IFIX(1:6) = 0
8938 ND = 0
8939.AND. IF (ICT > 0 K> 0) THEN
8940.AND. IF (ICT == 4 K>2) THEN
8941 IFIX(ND +1) = 1
8942 ELSEIF (ICT == 2) THEN
8943 IFIX(ND +2) = 1
8944 ELSEIF (ICT == 1) THEN
8945 IFIX(ND +3) = 1
8946 ELSEIF (ICT == 3) THEN
8947 IFIX(ND +2) = 1
8948 IFIX(ND +3) = 1
8949 ELSEIF (ICT == 5) THEN
8950 IF (K>2) IFIX(ND +1) = 1
8951 IFIX(ND +3) = 1
8952 ELSEIF (ICT == 6) THEN
8953 IF (K>2) IFIX(ND +1) = 1
8954 IFIX(ND +2) = 1
8955 ELSEIF (ICT == 7) THEN
8956 IF (K>2) IFIX(ND +1) = 1
8957 IFIX(ND +2) = 1
8958 IFIX(ND +3) = 1
8959 ENDIF
8960 ENDIF
8961C
8962.AND. IF (ICR > 0 K==6) THEN
8963 IF (ICR == 1) THEN
8964 IFIX(ND +6) = 1
8965 ELSEIF (ICR == 2) THEN
8966 IFIX(ND +5) = 1
8967 ELSEIF (ICR == 3) THEN
8968 IFIX(ND +5) = 1
8969 IFIX(ND +6) = 1
8970 ELSEIF (ICR == 4) THEN
8971 IFIX(ND +4) = 1
8972 ELSEIF (ICR == 5) THEN
8973 IFIX(ND +4) = 1
8974 IFIX(ND +6) = 1
8975 ELSEIF (ICR == 6) THEN
8976 IFIX(ND +4) = 1
8977 IFIX(ND +5) = 1
8978 ELSEIF (ICR == 7) THEN
8979 IFIX(ND +4) = 1
8980 IFIX(ND +5) = 1
8981 IFIX(ND +6) = 1
8982 ENDIF
8983 ENDIF
8984C
8985 RETURN
8986 END
8987!||====================================================================
8988!|| transvg2l ../engine/source/implicit/imp_solv.F
8989!||--- called by ------------------------------------------------------
8990!|| spb_rm_rig ../engine/source/implicit/imp_solv.F
8991!||====================================================================
8992 SUBROUTINE TRANSVG2L(SKEW ,VG ,VL )
8993C-----------------------------------------------
8994C I m p l i c i t T y p e s
8995C-----------------------------------------------
8996#include "implicit_f.inc"
8997C-----------------------------------------------
8998C D u m m y A r g u m e n t s
8999C-----------------------------------------------
9000 my_real
9001 . SKEW(*),VG(*),VL(*)
9002C-----------------------------------------------
9003C L o c a l V a r i a b l e s
9004C-----------------------------------------------
9005 INTEGER J
9006C----------------------------------------
9007 VL(1)=SKEW(1)*VG(1)+SKEW(2)*VG(2)+SKEW(3)*VG(3)
9008 VL(2)=SKEW(4)*VG(1)+SKEW(5)*VG(2)+SKEW(6)*VG(3)
9009 VL(3)=SKEW(7)*VG(1)+SKEW(8)*VG(2)+SKEW(9)*VG(3)
9010C
9011 RETURN
9012 END
9013!||====================================================================
9014!|| transvl2g ../engine/source/implicit/imp_solv.F
9015!||--- called by ------------------------------------------------------
9016!|| spb_rm_rig ../engine/source/implicit/imp_solv.F
9017!||====================================================================
9018 SUBROUTINE TRANSVL2G(SKEW ,VL ,VG )
9019C-----------------------------------------------
9020C I m p l i c i t T y p e s
9021C-----------------------------------------------
9022#include "implicit_f.inc"
9023C-----------------------------------------------
9024C D u m m y A r g u m e n t s
9025C-----------------------------------------------
9026 my_real
9027 . SKEW(*),VG(*),VL(*)
9028C-----------------------------------------------
9029C L o c a l V a r i a b l e s
9030C-----------------------------------------------
9031 INTEGER J
9032C----------------------------------------
9033 VG(1)=SKEW(1)*VL(1)+SKEW(4)*VL(2)+SKEW(7)*VL(3)
9034 VG(2)=SKEW(2)*VL(1)+SKEW(5)*VL(2)+SKEW(8)*VL(3)
9035 VL(3)=SKEW(3)*VL(1)+SKEW(6)*VL(2)+SKEW(9)*VL(3)
9036C
9037 RETURN
9038 END
9039!||====================================================================
9040!|| spb_ref_nds ../engine/source/implicit/imp_solv.F
9041!||--- called by ------------------------------------------------------
9042!|| spb_rm_rig ../engine/source/implicit/imp_solv.F
9043!||--- calls -----------------------------------------------------
9044!|| getikce ../engine/source/implicit/imp_solv.F
9045!||--- uses -----------------------------------------------------
9046!|| imp_spbrm ../engine/share/modules/impbufdef_mod.F
9047!||====================================================================
9048 SUBROUTINE SPB_REF_NDS(
9049 1 X ,D_IMP ,NDOF ,IDDL ,IKC ,
9050 2 ICODT ,ICODR ,ISKEW ,SKEW )
9051C-----------------------------------------------
9052C M o d u l e s
9053C-----------------------------------------------
9054 USE IMP_SPBRM
9055C-----------------------------------------------
9056C I m p l i c i t T y p e s
9057C-----------------------------------------------
9058#include "implicit_f.inc"
9059C-----------------------------------------------
9060C C o m m o n B l o c k s
9061C-----------------------------------------------
9062#include "param_c.inc"
9063C-----------------------------------------------
9064C D u m m y A r g u m e n t s
9065C-----------------------------------------------
9066 INTEGER
9067 . NDOF(*),IDDL(*),IKC(*),ICODT(*),ICODR(*),ISKEW(*)
9068C REAL
9069 my_real
9070 . X(3,*) ,D_IMP(3,*) ,SKEW(LSKEW,*)
9071C-----------------------------------------------
9072C L o c a l V a r i a b l e s
9073C-----------------------------------------------
9074 INTEGER N,I,J,ND,NN,IE,IEM,K,ISK
9075 my_real
9076 . D(3),DD,DMINT
9077C------case input 3 ref_nodes
9078 X_REF(1:3,1:4) = ZERO
9079 D_REF(1:3,1:4) = ZERO
9080 N_SEG = 3
9081 DO J= 1,N_SEG
9082 N = E_REF(J)
9083 IF (N==0) CYCLE
9084 X_REF(1:3,J)= X(1:3,N)
9085 D_REF(1:3,J)= D_IMP(1:3,N)
9086 END DO
9087 IF (ILSKEW>0) THEN
9088C----get ISK(from E_REF)set [Q],transfert DTRA,DROT to local reset IKCE(6) put (j)=0 for fixing dir
9089 NN = ILSKEW
9090 ISK = ISKEW(NN)
9091C---------local IKC
9092 RLSKEW(1:9) = SKEW(1:9,ISK)
9093 CALL GETIKCE(ICODT(NN),ICODR(NN),NDOF(NN),IKCE)
9094 END IF
9095C------------------------------------------
9096 RETURN
9097 END
9098C
9099!||====================================================================
9100!|| dealloc_impbuf ../engine/source/implicit/imp_solv.F
9101!||--- called by ------------------------------------------------------
9102!|| resol ../engine/source/engine/resol.F
9103!||--- uses -----------------------------------------------------
9104!|| impbufdef_mod ../engine/share/modules/impbufdef_mod.F
9105!||====================================================================
9106 SUBROUTINE DEALLOC_IMPBUF(IMPBUF_TAB)
9107C-----------------------------------------------
9108 USE IMPBUFDEF_MOD
9109C-----------------------------------------------
9110C I m p l i c i t T y p e s
9111C-----------------------------------------------
9112#include "implicit_f.inc"
9113C-----------------------------------------------
9114C D u m m y A r g u m e n t s
9115C-----------------------------------------------
9116 TYPE (IMPBUF_STRUCT_) IMPBUF_TAB
9117C-----------------------------------------------
9118C L o c a l V a r i a b l e s
9119C-----------------------------------------------
9120C
9121 IF (ALLOCATED(IMPBUF_TAB%IDDL)) DEALLOCATE(IMPBUF_TAB%IDDL)
9122 IF (ALLOCATED(IMPBUF_TAB%NDOF)) DEALLOCATE(IMPBUF_TAB%NDOF)
9123 IF (ALLOCATED(IMPBUF_TAB%INLOC)) DEALLOCATE(IMPBUF_TAB%INLOC)
9124 IF (ALLOCATED(IMPBUF_TAB%IRBYAC))DEALLOCATE(IMPBUF_TAB%IRBYAC)
9125 IF (ALLOCATED(IMPBUF_TAB%NSC)) DEALLOCATE(IMPBUF_TAB%NSC)
9126 IF (ALLOCATED(IMPBUF_TAB%IINT2)) DEALLOCATE(IMPBUF_TAB%IINT2)
9127 IF (ALLOCATED(IMPBUF_TAB%NKUD)) DEALLOCATE(IMPBUF_TAB%NKUD)
9128 IF (ALLOCATED(IMPBUF_TAB%IMONV)) DEALLOCATE(IMPBUF_TAB%IMONV)
9129 IF (ALLOCATED(IMPBUF_TAB%IADK)) DEALLOCATE(IMPBUF_TAB%IADK)
9130 IF (ALLOCATED(IMPBUF_TAB%JDIK)) DEALLOCATE(IMPBUF_TAB%JDIK)
9131 IF (ALLOCATED(IMPBUF_TAB%IKINW)) DEALLOCATE(IMPBUF_TAB%IKINW)
9132 IF (ALLOCATED(IMPBUF_TAB%IKC)) DEALLOCATE(IMPBUF_TAB%IKC)
9133 IF (ALLOCATED(IMPBUF_TAB%IKUD)) DEALLOCATE(IMPBUF_TAB%IKUD)
9134 IF (ALLOCATED(IMPBUF_TAB%W_DDL)) DEALLOCATE(IMPBUF_TAB%W_DDL)
9135 IF (ALLOCATED(IMPBUF_TAB%IADM)) DEALLOCATE(IMPBUF_TAB%IADM)
9136 IF (ALLOCATED(IMPBUF_TAB%JDIM)) DEALLOCATE(IMPBUF_TAB%JDIM)
9137 IF (ALLOCATED(IMPBUF_TAB%CAND_N)) DEALLOCATE(IMPBUF_TAB%CAND_N)
9138 IF (ALLOCATED(IMPBUF_TAB%CAND_E)) DEALLOCATE(IMPBUF_TAB%CAND_E)
9139 IF (ALLOCATED(IMPBUF_TAB%INDSUBT)) DEALLOCATE(IMPBUF_TAB%INDSUBT)
9140 IF (ALLOCATED(IMPBUF_TAB%NDOFI)) DEALLOCATE(IMPBUF_TAB%NDOFI)
9141 IF (ALLOCATED(IMPBUF_TAB%IDDLI)) DEALLOCATE(IMPBUF_TAB%IDDLI)
9142 IF (ALLOCATED(IMPBUF_TAB%INBUF_C)) DEALLOCATE(IMPBUF_TAB%INBUF_C)
9143 IF (ALLOCATED(IMPBUF_TAB%DIAG_K)) DEALLOCATE(IMPBUF_TAB%DIAG_K)
9144 IF (ALLOCATED(IMPBUF_TAB%LT_K)) DEALLOCATE(IMPBUF_TAB%LT_K)
9145 IF (ALLOCATED(IMPBUF_TAB%DIAG_M)) DEALLOCATE(IMPBUF_TAB%DIAG_M)
9146 IF (ALLOCATED(IMPBUF_TAB%LT_M)) DEALLOCATE(IMPBUF_TAB%LT_M)
9147 IF (ALLOCATED(IMPBUF_TAB%LB)) DEALLOCATE(IMPBUF_TAB%LB)
9148 IF (ALLOCATED(IMPBUF_TAB%LB0)) DEALLOCATE(IMPBUF_TAB%LB0)
9149 IF (ALLOCATED(IMPBUF_TAB%BKUD)) DEALLOCATE(IMPBUF_TAB%BKUD)
9150 IF (ALLOCATED(IMPBUF_TAB%D_IMP)) DEALLOCATE(IMPBUF_TAB%D_IMP)
9151 IF (ALLOCATED(IMPBUF_TAB%DR_IMP)) DEALLOCATE(IMPBUF_TAB%DR_IMP)
9152 IF (ALLOCATED(IMPBUF_TAB%ELBUF_C)) DEALLOCATE(IMPBUF_TAB%ELBUF_C)
9153 IF (ALLOCATED(IMPBUF_TAB%BUFMAT_C))DEALLOCATE(IMPBUF_TAB%BUFMAT_C)
9154 IF (ALLOCATED(IMPBUF_TAB%X_C)) DEALLOCATE(IMPBUF_TAB%X_C)
9155 IF (ALLOCATED(IMPBUF_TAB%DD)) DEALLOCATE(IMPBUF_TAB%DD)
9156 IF (ALLOCATED(IMPBUF_TAB%DDR)) DEALLOCATE(IMPBUF_TAB%DDR)
9157 IF (ALLOCATED(IMPBUF_TAB%X_A)) DEALLOCATE(IMPBUF_TAB%X_A)
9158 IF (ALLOCATED(IMPBUF_TAB%FEXT)) DEALLOCATE(IMPBUF_TAB%FEXT)
9159 IF (ALLOCATED(IMPBUF_TAB%DG)) DEALLOCATE(IMPBUF_TAB%DG)
9160 IF (ALLOCATED(IMPBUF_TAB%DGR)) DEALLOCATE(IMPBUF_TAB%DGR)
9161 IF (ALLOCATED(IMPBUF_TAB%DG0)) DEALLOCATE(IMPBUF_TAB%DG0)
9162 IF (ALLOCATED(IMPBUF_TAB%DGR0)) DEALLOCATE(IMPBUF_TAB%DGR0)
9163 IF (ALLOCATED(IMPBUF_TAB%BUFIN_C)) DEALLOCATE(IMPBUF_TAB%BUFIN_C)
9164 IF (ALLOCATED(IMPBUF_TAB%AC)) DEALLOCATE(IMPBUF_TAB%AC)
9165 IF (ALLOCATED(IMPBUF_TAB%ACR)) DEALLOCATE(IMPBUF_TAB%ACR)
9166C
9167 RETURN
9168 END
9169
9170
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
cgshell4
subroutine cgshell4(elbuf_str, jft, jlt, pm, ixc, x, mas, xc, yc, zc)
Definition cgshell.F:33
cgshell3
subroutine cgshell3(elbuf_str, jft, jlt, pm, ixtg, x, mas, xc, yc, zc)
Definition cgshell.F:106
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:1495
i2_impr1
subroutine i2_impr1(ipari, intbuf_tab, x, ndof, iddl, b)
Definition i2_imp1.F:1901
i2_impr2
subroutine i2_impr2(ipari, intbuf_tab, a, ar, x, ndof, iddl, b)
Definition i2_imp1.F:2183
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:4097
ind_frkd
subroutine ind_frkd(ipari, intbuf_tab, num_imp, ns_imp, ne_imp, iddl, ikc, ndof, nsrem, ind_imp)
Definition imp_fri.F:4727
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:9983
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
sp_stat0
subroutine sp_stat0(il, iadk, jdik, nc, jm)
Definition imp_fsa_inv.F:35
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:2876
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:1979
etfac_ini
subroutine etfac_ini(iparg)
Definition imp_init.F:388
imp_inttd0
subroutine imp_inttd0(output, 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:732
sav_inttd
subroutine sav_inttd(nt_imp, numimp, ns_imp, ne_imp, ind_imp, numimp1)
Definition imp_int_k.F:1443
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:1703
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:1596
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
spb_refsh4id
subroutine spb_refsh4id(jft, jlt, nel, ixc, x, xc, yc, zc, ie, xmin0, ymin0, zmin0, dmin)
Definition imp_solv.F:7768
print_stif
subroutine print_stif(ipari, intbuf_tab, iflag, nn, jg)
Definition imp_solv.F:7044
getikce
subroutine getikce(ict, icr, k, ifix)
Definition imp_solv.F:8924
du_ini
subroutine du_ini(nodft, nodlt, dn, dnr, dd, ddr, idiv, icont0)
Definition imp_solv.F:5465
pr_infok
subroutine pr_infok(nddl0, nnzk0, nddl, nnzk, nnmax)
Definition imp_solv.F:2145
imp_stop
subroutine imp_stop(istop)
Definition imp_solv.F:1997
imp_errmumps
subroutine imp_errmumps(ierr)
Definition imp_solv.F:8651
dis_cp
subroutine dis_cp(n, d, dr, iflag)
Definition imp_solv.F:6850
ini_k0h
subroutine ini_k0h(nddl, nnz, nnzm, iadk, jdik)
Definition imp_solv.F:5084
dim_subnz
subroutine dim_subnz(iadk, jdik, nc, jm, nnza)
Definition imp_solv.F:2323
imp_solv
subroutine imp_solv(output, 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:175
imp_fanie
subroutine imp_fanie(output, fext, nfia, nfea, nodft, nodlt, h3d_data)
Definition imp_solv.F:4794
imp_stif24
subroutine imp_stif24(numimp, ipari)
Definition imp_solv.F:7111
spb_refsh3id
subroutine spb_refsh3id(jft, jlt, nel, ixtg, x, xc, yc, zc, ie, xmin0, ymin0, zmin0, dmin)
Definition imp_solv.F:7869
imp_fanii
subroutine imp_fanii(output, fint, nfia, nodft, nodlt, h3d_data)
Definition imp_solv.F:4744
imp_fout
subroutine imp_fout(output, a, ar, nfia, nfea, nodft, nodlt, h3d_data, impbuf_tab)
Definition imp_solv.F:4683
ini_kic
subroutine ini_kic
Definition imp_solv.F:4849
spbrm_pre
subroutine spbrm_pre(itab, x, iparg, ixc, ixtg, partsav, elbuf_tab, pm, ndof, iddl, ikc)
Definition imp_solv.F:7488
int5_diverg
subroutine int5_diverg(ipari)
Definition imp_solv.F:6800
spb_rgmod
subroutine spb_rgmod(n_seg, x_ref, d_ref, x, d, x0, y0, z0, dtra, drot)
Definition imp_solv.F:8339
ini_bminma_imp
subroutine ini_bminma_imp(intbuf_tab)
Definition imp_solv.F:7438
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:5960
get_fext
subroutine get_fext(nddl0, nddl, iddl, ndof, ikc, inloc, lb, fext, ac, acr)
Definition imp_solv.F:5215
spb_ieref_bc
subroutine spb_ieref_bc(x, ixc, ixtg, d_imp, dmin, ndof, iddl, ikc)
Definition imp_solv.F:8200
transvg2l
subroutine transvg2l(skew, vg, vl)
Definition imp_solv.F:8993
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:7984
deallocm_imp
subroutine deallocm_imp(mumps_par)
Definition imp_solv.F:4923
diag_kif
subroutine diag_kif(diag_k)
Definition imp_solv.F:2624
imp_cpre
subroutine imp_cpre(iflag, nndl, elbuf, elbuf_c, bufmat, fsav, volmon, bufmat_c, x, x_c, partsav, r_imp)
Definition imp_solv.F:2707
spb_ref_nds
subroutine spb_ref_nds(x, d_imp, ndof, iddl, ikc, icodt, icodr, iskew, skew)
Definition imp_solv.F:9051
re2int5
subroutine re2int5(nt_imp, numimp, ns_imp, ne_imp, numimpl, ipari, nt_imp0)
Definition imp_solv.F:5270
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:3137
spb_ieref3
subroutine spb_ieref3(x, ixc, ixtg, ndof, iddl, ikc, d_imp, dr_imp, dmin)
Definition imp_solv.F:8460
imp_intbuf_ini
subroutine imp_intbuf_ini(imp_intbuf_tab, nimp)
Definition imp_solv.F:8580
save_kif
subroutine save_kif(nddl, iadk, jdik, diag_k, lt_k, itok, nddlg)
Definition imp_solv.F:2514
m_lnz
subroutine m_lnz(nddl, iadk, jdik, ndmax, nlmax)
Definition imp_solv.F:2293
re2int7
subroutine re2int7(nt_imp, numimp, ns_imp, ne_imp, ind_imp, numimpl, ipari, nt_imp0)
Definition imp_solv.F:5367
deallocm
subroutine deallocm
Definition imp_solv.F:4875
matv_kif
subroutine matv_kif(v, w)
Definition imp_solv.F:2662
write_tpl_file
subroutine write_tpl_file(filnam, ioff1, ioff2, ioff3)
Definition imp_solv.F:6354
upd_rhs_fr
subroutine upd_rhs_fr(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, ac, acr, nt_rw, w_ddl, nddl, r02, irbe3, lrbe3, frbe3, weight, irbe2, lrbe2)
Definition imp_solv.F:7221
transvl2g
subroutine transvl2g(skew, vl, vg)
Definition imp_solv.F:9019
imp_checm
subroutine imp_checm(itab, nddl, iddl, diag_m, ndof, ikc, inloc, nddl0)
Definition imp_solv.F:2361
imp_check
subroutine imp_check(itab, nddl, iddl, diag_k, ndof, ikc, inloc, nddl0)
Definition imp_solv.F:2050
imp_smpini
subroutine imp_smpini(itsk, n1ftsk, n1ltsk, n1)
Definition imp_solv.F:6910
k_band
subroutine k_band(nddl, iadk, jdik, ndmax)
Definition imp_solv.F:2254
ini_kif
subroutine ini_kif
Definition imp_solv.F:2486
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:7331
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:2766
du_ini_hp
subroutine du_ini_hp(dn, dnr, dd, ddr, idiv, icont0)
Definition imp_solv.F:6950
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:5560
imp_checm0
subroutine imp_checm0(itab, nddl, iddl, diag_m, ndof, ikc, inloc, nddl0, iwar, ierr)
Definition imp_solv.F:2917
set_ksym
subroutine set_ksym(nddl, iadk, jdik, lt_k, iadk0, jdik0, lt_k0)
Definition imp_solv.F:5161
imp_b2a
subroutine imp_b2a(f, m, iddl, ndof, b)
Definition imp_solv.F:2445
crit_llim
subroutine crit_llim(nddl, nnzk)
Definition imp_solv.F:5032
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_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_e_ref
subroutine spmd_e_ref(dmin)
Definition imp_spmd.F:5175
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_n_ref
subroutine spmd_n_ref
Definition imp_spmd.F:5323
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:7476
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:4847
dim_span
subroutine dim_span(nn, nddl, iadk, jdik, l_nz, ndmax)
Definition ind_glob_k.F:7015
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:4670
idel_int
subroutine idel_int(ipari, intbuf_tab, num_imp, ns_imp, ne_imp, ind_imp, ndof, nt_imp)
Definition ind_glob_k.F:6645
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:3748
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
ymax
subroutine ymax(idn, fac, npc, pld, stiffmin, stiffmax, stiffini, stiffavg)
Definition law100_upd.F:274
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
drape_mod
Definition drape_mod.F:54
dsgraph_mod
Definition dsgraph_mod.F:31
groupdef_mod
Definition groupdef_mod.F:668
h3d_mod
Definition h3d_mod.F:311
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::len_v
integer len_v
Definition impbufdef_mod.F:742
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_i7cp
Definition imp_intm.F:192
imp_intm
Definition imp_intm.F:118
imp_intm::nz_sl
integer nz_sl
Definition imp_intm.F:173
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::nzif
integer nzif
Definition impbufdef_mod.F:407
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::ne_bc3
integer ne_bc3
Definition impbufdef_mod.F:698
imp_spbrm::lskew_g
integer lskew_g
Definition impbufdef_mod.F:698
imp_spbrm::ne_bc4
integer ne_bc4
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::nbc_b
integer nbc_b
Definition impbufdef_mod.F:698
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:1257
stack_mod
Definition stack_mod.F:75
th_surf_mod
OPTION /TH/SURF outputs of Pressure and Area needed Tabs.
Definition th_surf_mod.F:61
tri7box::stif_oldfi
type(real_pointer2), dimension(:), allocatable stif_oldfi
Definition tri7box.F:545
tri7box::nsnsi
type(int_pointer), dimension(:), allocatable nsnsi
Definition tri7box.F:491
tri7box::nsnfi
type(int_pointer), dimension(:), allocatable nsnfi
Definition tri7box.F:440
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
cp_real
subroutine cp_real(n, x, xc)
Definition produt_v.F:871
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
buf_dim
subroutine buf_dim(l1, l2, l3, l4)
Definition produt_v.F:818
produt_uhp0
subroutine produt_uhp0(dd, ddr, norm2, weight)
Definition produt_v.F:3435
produt_v
subroutine produt_v(nddl, x, y, r)
Definition produt_v.F:33
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_int
subroutine cp_int(n, x, xc)
Definition produt_v.F:916
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
listing
void listing(mapping_t *, PORD_INT, PORD_INT, PORD_INT, FLOAT *, FLOAT *)
radioss2
subroutine radioss2(idata, midata, rdata, mrdata)
Definition radioss2.F:145
rbe2_impr1
subroutine rbe2_impr1(irbe2, lrbe2, x, skew, ndof, iddl, b, weight)
Definition rbe2_imp0.F:464
velrot
subroutine velrot(vrm, lsm, vs)
Definition rbe2v.F:1119
rbe3_impr2
subroutine rbe3_impr2(irbe3, lrbe3, frbe3, x, skew, ndof, iddl, b, weight, a, ar)
Definition rbe3_imp0.F:445
rbe3_impr1
subroutine rbe3_impr1(irbe3, lrbe3, frbe3, x, skew, ndof, iddl, b, weight)
Definition rbe3_imp0.F:318
rby_impr1
subroutine rby_impr1(x, rby, nod, nby, ndof, iddl, b)
Definition rby_imp0.F:707
rby_impr2
subroutine rby_impr2(x, rby, nod, nby, ndof, iddl, b, ac, acr)
Definition rby_imp0.F:820
recudis
subroutine recudis(nddl, iddl, ndof, ikc, lx, d, dr, inloc)
Definition recudis.F:31
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
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:213
spmd_allglob_isum9
subroutine spmd_allglob_isum9(v, len)
Definition spmd_allglob_isum9.F:46
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:895
arret
subroutine arret(nn)
Definition arret.F:86
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
static
subroutine static(v, vr, a, ar, ms, in, igrnod, weight_md, wfext)
Definition static.F:33
h3d_mod::h3d_database
Definition h3d_mod.F:438
th_surf_mod::th_surf_
Definition th_surf_mod.F:76
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
ext_rhs
subroutine ext_rhs(icodt, icodr, iskew, ibfv, xframe, x, skew, ndof, iddl, ikc, nddl0, b, inloc, lj, ac, acr, nt_rw, w_ddl, nddl, r02)
Definition upd_glob_k.F:862
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