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