63
64
65
66 USE elbufdef_mod
67 USE intbufdef_mod
71 use element_mod , only : nixs,nixq,nixc,nixt,nixp,nixr,nixtg
72
73
74
75#include "implicit_f.inc"
76
77
78
79#include "com01_c.inc"
80#include "com04_c.inc"
81#include "com08_c.inc"
82#include "param_c.inc"
83#include "scr05_c.inc"
84#include "impl1_c.inc"
85#include "task_c.inc"
86#include "buckcom.inc"
87#include "units_c.inc"
88
89
90
91 INTEGER NDDL0,NNZK0,IPARG(NPARG,*),FR_ELEM(*) ,IAD_ELEM(2,*)
92 INTEGER NPBY(NNPBY,*),LPBY(*),ITAB(*)
93 INTEGER NINT7,NBINTC,IPARI(NPARI,*),
94 . FR_I2M(*),IAD_I2M(*),FR_RBY(*),IAD_RBY(*)
95 INTEGER MONVOL(*),
96 . FR_MV(NSPMD+2,NVOLU),NPRW(*),FR_RBE3M(*),IAD_RBE3M(*)
97 INTEGER IPM(NPROPMI,*),IGEO(NPROPGI,*),IFRAME(LISKN,*)
98 INTEGER
99 . IXS(NIXS,*),IXQ(NIXQ,*),IXC(NIXC,*), IXT(NIXT,*), IXP(NIXP,*),
100 . IXR(NIXR,*), IXTG(NIXTG,*),IXS10(6,*),(12,*),
101 . IXS16(8,*),IXTG1(4,*),IRBE3(*),LRBE3(*),
102 . SH4TREE(*), SH3TREE(*),
103 . IRBE2(*),LRBE2(*),IBFV(*),NUM_IMP1(*),NUM_IMPL(NINTER,NTHREAD)
104
106 . geo(npropg,*),elbuf(*),vel(*),x(*),dmcp(*)
107 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP) :: ELBUF_TAB
108 TYPE (INTBUF_STRUCT_) INTBUF_TAB(*)
109 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
110 TYPE (IMPBUF_STRUCT_) ,TARGET :: IMPBUF_TAB
111
112
113
114 INTEGER I,J,K,N,M,L,NDOFI,NDOFJ,NKINE,NMIJ2,IP,NPN,NPP,IER1,
115 . LI1,LI2,LI3,LI4,LI5,LI6,LI7,LI8,LI9,LI10,LI11,LI12,
116 . LIF,LI13,LI14,LI15,LI16,LI17,IER2
117 INTEGER NTMP,L1,NNDLNKINE,NNMAX,NKMAX,NNDL
118 INTEGER, POINTER :: NDDL,NNZK,NRBYAC,NINT2,NMC,NMC2,NMONV
119 INTEGER, DIMENSION(:) ,POINTER :: IADK,JDIK,IDDL,NDOF,INLOC,LSIZE,I_IMP,
120 . IRBYAC,NSC,IINT2,NKUD,IMONV,IKINW
121 my_real,
DIMENSION(:) ,
POINTER :: diag_k,lt_k,diag_m,lt_m,lb,
122 . lb0,bkud,d_imp,elbuf_c,bufmat_c,
123 . x_c,dd,ddr
124
125 IF (n2d>0) THEN
126 IF(ispmd==0)THEN
127 CALL ancmsg(msgid=161,anmode=aninfo)
128 ENDIF
129
130 ENDIF
131 IF (iresp==1) THEN
132 IF(ispmd==0)THEN
133 CALL ancmsg(msgid=162,anmode=aninfo)
134 ENDIF
136 ENDIF
137#ifndef MPI
138 IF (neig>0) THEN
139 IF(ispmd==0)THEN
140 CALL ancmsg(msgid=294,anmode=aninfo)
141 ENDIF
143 END IF
144 IF (nbuck>0) THEN
145 IF(ispmd==0)THEN
146 CALL ancmsg(msgid=295,anmode=aninfo)
147 ENDIF
149 END IF
150#endif
151
152 ALLOCATE(impbuf_tab%IDDL(numnod))
153 ALLOCATE(impbuf_tab%NDOF(numnod))
154 ALLOCATE(impbuf_tab%INLOC(numnod))
155 ALLOCATE(impbuf_tab%IRBYAC(2*nrbykin))
156 ALLOCATE(impbuf_tab%NSC(nrbykin))
157 ALLOCATE(impbuf_tab%IINT2(ninter))
158 ALLOCATE(impbuf_tab%NKUD(nfxvel))
159 ALLOCATE(impbuf_tab%IMONV(nvolu))
160 nddl => impbuf_tab%NDDL
161 nnzk => impbuf_tab%NNZK
162 nrbyac => impbuf_tab%NRBYAC
163 nint2 => impbuf_tab%NINT2
164 nmc => impbuf_tab%NMC
165 nmc2 => impbuf_tab%NMC2
166 nmonv => impbuf_tab%NMONV
167 iddl => impbuf_tab%IDDL
168 ndof => impbuf_tab%NDOF
169 inloc => impbuf_tab%INLOC
170 lsize => impbuf_tab%LSIZE
171 i_imp => impbuf_tab%I_IMP
172 irbyac => impbuf_tab%IRBYAC
173 nsc => impbuf_tab%NSC
174 nsc = 0
175 iint2 => impbuf_tab%IINT2
176 nkud => impbuf_tab%NKUD
177 imonv => impbuf_tab%IMONV
179 1 geo ,npby ,lpby ,itab ,nrbyac ,
180 2 irbyac ,nint2 ,iint2 ,ipari ,
181 3 ixs ,ixq ,ixc ,ixt ,
182 4 ixp ,ixr ,ixtg ,ixtg1 ,ixs10 ,
183 5 ixs20 ,ixs16 ,iparg ,ndof ,
184 6 iddl ,nddl ,nnzk ,elbuf ,inloc ,
185 7 lsize ,fr_elem ,iad_elem ,fr_i2m ,iad_i2m ,
186 8 nprw ,nmonv ,imonv ,monvol ,igrsurf ,
187 9 fr_mv ,ipm ,igeo ,iad_rby ,
188 a fr_rby ,sh4tree ,sh3tree ,irbe3 ,lrbe3 ,
189 b fr_rbe3m ,iad_rbe3m ,irbe2 ,lrbe2 ,ibfv ,
190 c vel ,elbuf_tab ,iframe ,intbuf_tab )
193 nddl0 = nddl
194 nnzk0 = nnzk
195 ALLOCATE(impbuf_tab%IADK(
s_iadk))
196 ALLOCATE(impbuf_tab%JDIK(
s_jdik))
197 iadk => impbuf_tab%IADK
198 jdik => impbuf_tab%JDIK
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215 nkine = lsize(8)
216 nnmax = lsize(9)
217 nkmax = lsize(10)
218 nmij2 = lsize(11)
219 npn = lsize(12)
220 npp = lsize(13)
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238 li1 =1
239 li2 = li1+lsize(4)
240 li3 = li2+lsize(5)
241 li4 = li3+lsize(1)
242 li5 = li4+lsize(3)
243 li6 = li5+lsize(7)
244 li7 = li6+lsize(2)
245 li8 = li7+lsize(6)
246 li9 = li8+nint2
247 li10 = li9+lsize(8)
248 li11 = li10+(lsize(8)-lcokm)*lsize(9)
249 li12 = li11+lcokm*lsize(10)
250 li13 = li12+4*lsize(11)
251 li14 = li13+lsize(14)
252 li15 = li14+lsize(15)
253 lif = li15+lsize(16)
255 ALLOCATE(impbuf_tab%IKINW(
s_ikinw))
256 ikinw => impbuf_tab%IKINW
258 1 itab ,nrbyac ,irbyac ,nsc ,ikinw(li1),
259 2 nmc ,ikinw(li2),ikinw(li3),ikinw(li4),nint2 ,
260 3 iint2 ,ipari ,intbuf_tab,ikinw(li8),ikinw(li5),
261 4 ikinw(li6),ikinw(li7),iparg ,elbuf ,elbuf_tab ,
262 5 ixs ,ixq ,ixc ,ixt ,ixp ,
263 6 ixr ,ixtg ,ixtg1 ,ixs10 ,ixs20 ,
264 7 ixs16 ,iddl ,ndof ,iadk ,
265 8 jdik ,nddl ,nnzk ,lsize(9) ,lsize(8) ,
266 9 inloc ,lsize(10),ikinw(li9),ikinw(li10),ikinw(li11),
267 a lsize(11) ,ikinw(li12),li1 ,lsize(12) ,lsize(13) ,
268 b fr_elem ,iad_elem ,ipm ,igeo ,irbe3 ,
269 c lrbe3 ,ikinw(li13),fr_i2m ,iad_i2m ,fr_rbe3m ,
270 d iad_rbe3m ,irbe2 ,lrbe2 ,ikinw(li14),ikinw(li15))
271 ntmp=
max(nkmax,nnmax)
272 IF (iroddl/=0) THEN
273 maxb =
min(6*(ntmp+1),nddl)
274 maxb1 =
min(6*(nnmax+1),nddl)
275 ELSE
276 maxb =
min(3*(ntmp+1),nddl)
277 maxb1 =
min(3*(nnmax+1),nddl)
278 ENDIF
279 maxb0 = maxb
280 nndl=3*numnod
281
282 IF(ispmd==0)THEN
283 WRITE(istdo,*)
284 WRITE(istdo,*)' **************************'
285 WRITE(istdo,*)' ** IMPLICIT OPTION USED **'
286 WRITE(istdo,*)' **************************'
287 WRITE(istdo,*)
288 ENDIF
289
290 IF(nfxvel>0.AND.neig==0)THEN
291 l1=nfxvel*
max(3,maxb)
292 ELSE
293 l1=0
294 ENDIF
297
299 max_l = 0
300 IF (nmonv>0.AND.isolv>=3.AND.neig==0) THEN
301 IF(ispmd==0)THEN
302 CALL ancmsg(msgid=163,anmode=aninfo)
303 ENDIF
305 ENDIF
306
307 IF ((isolv==1.OR.isolv>4).AND.n_pat>1) THEN
308 CALL fil_span0(nrbyac,irbyac,npby,iddl,ndof,nddl)
309 CALL dim_span(n_pat,nddl,iadk,jdik,max_l,maxb1)
311 ELSE
313 ENDIF
315 ALLOCATE(impbuf_tab%IKC(
s_ikc))
316 ALLOCATE(impbuf_tab%IKUD(
s_ikud))
317 ALLOCATE(impbuf_tab%W_DDL(
s_w_ddl))
318 ALLOCATE(impbuf_tab%IADM(
s_iadm))
319 ALLOCATE(impbuf_tab%JDIM(
s_jdim))
322 nint7 = 0
326 IF (ninter/=0.AND.neig==0) THEN
327 CALL dim_int7(ninter,ipari ,intbuf_tab ,nint7)
328 IF (nint7>0) THEN
329 IF (isolv==4) THEN
330 CALL ancmsg(msgid=214,anmode=aninfo)
332 ENDIF
337 ENDIF
338 ENDIF
339 ALLOCATE(impbuf_tab%CAND_N(
s_cand_n))
340 ALLOCATE(impbuf_tab%CAND_E(
s_cand_e))
341 ALLOCATE(impbuf_tab%INDSUBT(
s_indsubt),stat=ier1)
343 ALLOCATE(impbuf_tab%NDOFI(
s_ndofi))
344 ALLOCATE(impbuf_tab%IDDLI(
s_iddli))
346 IF (nspmd>1.AND.nbintc>0)
CALL imp_frii(ninter)
347
348
349
350
356 IF (iline/=1.AND.tt==zero.AND.isprb==0) THEN
357 IF (nmonv>0) isigini=1
358 ELSE
359 isigini=0
360 ENDIF
361 IF ((isprb==1.OR.isigini==1.OR.ilintf>0)
362 . .AND.neig==0) THEN
364 ELSE
366 ENDIF
369 IF (iroddl/=0.AND.neig==0) THEN
371 ELSE
373 ENDIF
374 IF (iline/=1) THEN
378 IF (iroddl/=0) THEN
380 ELSE
382 ENDIF
383 ELSEIF (ilintf>0) THEN
388 ELSE
394 ENDIF
396 IF (neig==0) THEN
397 IF (ismdisp>0)
s_x_a=nndl
398 ENDIF
399
405 IF (idtc==3) THEN
407 IF (iroddl/=0) THEN
412 ELSE
415 ENDIF
416 ENDIF
420 IF (neig==0) THEN
422 IF (iroddl/=0)
s_acr=nndl
423 ENDIF
424
425 ALLOCATE(impbuf_tab%DIAG_K(
s_diag_k))
426 ALLOCATE(impbuf_tab%LT_K(
s_lt_k))
427 ALLOCATE(impbuf_tab%DIAG_M(
s_diag_m))
428 ALLOCATE(impbuf_tab%LT_M(
s_lt_m))
429 ALLOCATE(impbuf_tab%LB(
s_lb))
430 ALLOCATE(impbuf_tab%LB0(
s_lb0))
431 ALLOCATE(impbuf_tab%BKUD(
s_bkud))
432 ALLOCATE(impbuf_tab%D_IMP(
s_d_imp))
433 ALLOCATE(impbuf_tab%DR_IMP(
s_dr_imp))
436 ALLOCATE(impbuf_tab%X_C(
s_x_c))
437 ALLOCATE(impbuf_tab%DD(
s_dd))
438 ALLOCATE(impbuf_tab%DDR(
s_ddr))
439 ALLOCATE(impbuf_tab%X_A(
s_x_a))
440 ALLOCATE(impbuf_tab%FEXT(
s_fext))
441 ALLOCATE(impbuf_tab%DG(
s_dg))
442 ALLOCATE(impbuf_tab%DGR(
s_dgr))
443 ALLOCATE(impbuf_tab%DG0(
s_dg0))
444 ALLOCATE(impbuf_tab%DGR0(
s_dgr0))
446 ALLOCATE(impbuf_tab%AC(
s_ac))
447 ALLOCATE(impbuf_tab%ACR(
s_acr),stat=ier2)
448
449 IF (ier1/=0.OR.ier2/=0) THEN
450 CALL ancmsg(msgid=19,anmode=aninfo,
451 . c1='FOR IMPLICIT')
453 ENDIF
454
455 impbuf_tab%D_IMP=zero
456 impbuf_tab%IKC=0
457 nddl0 = nddl
458 nnzk0 = nnzk
459 isetk=1
460 idsc=1
461
462 i_imp=0
463 it_bcs = 0
464 it_pcg = 0
465 impbuf_tab%R_IMP(1:25)=zero
466
467 IF (neig==0) THEN
469 IF (idyna==0)
CALL cp_dm(numgeo,geo,igeo,dmcp,1)
470 END IF
471
472 IF (ninter/=0.AND.neig==0) THEN
473 nt_imp1=0
474 DO i=1,ninter
475 num_imp1(i)=0
476 ENDDO
477 DO j=1,nthread
478 DO i=1,ninter
479 num_impl(i,j)=0
480 ENDDO
481 ENDDO
482 ENDIF
484 IF (iline/=1)
CALL zero1(impbuf_tab%DD,nndl)
485
486 IF (nbuck>0.AND.bisolv==2) THEN
487 WRITE(istdo,'(A)')
488 .' !! BISOLV =2 REQUIRES OPTION /IMPL/GRAPH IN RADIOSS STARTER'
489 WRITE(iout,'(A)')
490 .' !! BISOLV =2 REQUIRES OPTION /IMPL/GRAPH IN RADIOSS STARTER'
492 RETURN
493 ENDIF
494
495 RETURN
subroutine imp_trans0(r_imp, nr)
subroutine imp_frii(ninter)
subroutine fil_span0(nrbyac, irbyac, npby, iddl, ndof, nddl)
subroutine dim_span(nn, nddl, iadk, jdik, l_nz, ndmax)
subroutine dim_int7(ninter, ipari, intbuf_tab, nnmax)
subroutine dim_glob_k(geo, npby, lpby, itab, nrbyac, irbyac, nint2, iint2, ipari, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, ixtg1, ixs10, ixs20, ixs16, iparg, ndof, iddl, nddl, nnzk, elbuf, inloc, lsize, fr_elem, iad_elem, fr_i2m, iad_i2m, nprw, nmonv, imonv, monvol, igrsurf, fr_mv, ipm, igeo, iad_rby, fr_rby, sh4tree, sh3tree, irbe3, lrbe3, fr_rbe3m, iad_rbe3m, irbe2, lrbe2, ibfv, vel, elbuf_tab, iframe, intbuf_tab)
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)
subroutine buf_dim1(l1, lt)
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)