156
157
158
167
168
169
170#include "implicit_f.inc"
171
172
173
174#include "com01_c.inc"
175#include "com04_c.inc"
176#include "units_c.inc"
177#include "eigcom.inc"
178
179
180
181 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
182 INTEGER EIGIPM(*), EIGIBUF(*),ITABM1(*)
184 . eigrpm(*)
185
186 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
187 TYPE (SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(*)
188
189
190
191 INTEGER ID,SUB_INDEX,UID
192 LOGICAL IS_AVAILABLE
193 INTEGER I, ITAG(NUMNOD), IAD, IADF, IE, IGU1, IGU2, NN, IG, NNI,
194 . ICT, ICR, NEV, NBLFR, INCV
195
196
197
198 . cutfreq, shiftini, tol, fac_t,fac_fre
199 CHARACTER(LEN=NCHARTITLE)::TITR
200 CHARACTER(LEN=NCHARFIELD)::STRING
201 CHARACTER :: CODE*7,
202 . CTYPE*33, CPRE*17, NWLINE*100, MESS*40, MODFILE*2148,
203 . CIMLS*3 ,CPRSP*4,MODFILE_TMP*2148
204 INTEGER, ALLOCATABLE :: NODES(:)
206 . ALLOCATABLE :: modes(:,:,:)
207
208
209
210 INTEGER USR2SYS
211 DATA mess/'ADDITIONAL MODES FILE : NODES '/
212
213 iad=1
214 iadb=1
215 iadf=1
217 ircm = 0
218 DO ie=1,neig
219 itag(1:numnod)=0
222 . unit_id = uid,
223 . submodel_index = sub_index,
224 . option_titr = titr)
225 CALL hm_get_intv(
'grnd_ID',igu1,is_available,lsubmodel)
226 CALL hm_get_intv(
'grnd_bc',igu2,is_available,lsubmodel)
227 CALL hm_get_intv(
'Tx',j6(1),is_available,lsubmodel)
228 CALL hm_get_intv(
'Ty',j6(2),is_available,lsubmodel)
229 CALL hm_get_intv(
'Tz',j6(3),is_available,lsubmodel)
230 CALL hm_get_intv(
'OmegaX',j6(4),is_available,lsubmodel)
231 CALL hm_get_intv(
'OmegaY',j6(5),is_available,lsubmodel)
232 CALL hm_get_intv(
'OmegaZ',j6(6),is_available,lsubmodel)
233 CALL hm_get_intv(
'Ifile',ifile,is_available,lsubmodel)
234 CALL hm_get_intv('nmod
',NEV,IS_AVAILABLE,LSUBMODEL)
235 CALL HM_GET_INTV('inorm',IPRSP,IS_AVAILABLE,LSUBMODEL)
236 CALL HM_GET_FLOATV('cutfreq',CUTFREQ,IS_AVAILABLE,LSUBMODEL,UNITAB)
237 CALL HM_GET_FLOATV('freqmin',SHIFTINI,IS_AVAILABLE,LSUBMODEL,UNITAB)
238 CALL HM_GET_INTV('nbloc',NBLFR,IS_AVAILABLE,LSUBMODEL)
239 CALL HM_GET_INTV('incv',INCV,IS_AVAILABLE,LSUBMODEL)
240 CALL HM_GET_INTV('niter',NITER,IS_AVAILABLE,LSUBMODEL)
241 CALL HM_GET_INTV('ipri',IPRI,IS_AVAILABLE,LSUBMODEL)
242 CALL HM_GET_FLOATV('tol',TOL,IS_AVAILABLE,LSUBMODEL,UNITAB)
243
244 IFLAGUNIT = 0
245 DO J=1,UNITAB%NUNITS
246 IF (UNITAB%UNIT_ID(J) == UID) THEN
247 FAC_T = UNITAB%FAC_T(J)
248 IFLAGUNIT = 1
249 EXIT
250 ENDIF
251 ENDDO
252.AND. IF (UID/=0IFLAGUNIT==0) THEN
253 CALL ANCMSG(MSGID=659,ANMODE=ANINFO,MSGTYPE=MSGERROR,
254 . I2=UID,I1=ID,C1='eig',
256 . C3=TITR)
257 ENDIF
258 EIGIPM(IAD)=ID
259
260 IF (IFILE==2) THEN
261
262 WRITE(ISTDO,'(a)
') ' ** warning -
eig option:
'
263 WRITE(ISTDO,'(a)')
264 . ' ** USE of nastran output file not yet implemented'
265 WRITE(IOUT,'(a)
') ' ** warning -
eig option:
'
266 WRITE(IOUT,'(a)')
267 . ' ** use of nastran output file not yet implemented'
268 IFILE=0
269 ENDIF
270
271.AND. IF (IFILE==1IGU2/=0) THEN
272 CALL ANCMSG(MSGID=588,
273 . MSGTYPE=MSGWARNING,
274 . ANMODE=ANINFO_BLIND_1,
275 . I1=ID,
276 . C1=TITR,
277 . I2=IGU2)
278 IGU2=0
279 ENDIF
280
281.AND. IF (NSPMD>1IFILE==1) THEN
282 CALL ANCMSG(MSGID=628,
283 . MSGTYPE=MSGWARNING,
284 . ANMODE=ANINFO,
285 . I1=ID,
286 . C1=TITR)
287 IFILE=0
288 ENDIF
289
290 IMLS=0
291 IF (IGU1==0) THEN
292 DO I=1,NUMNOD
293 EIGIBUF(IADB+I-1)=I
294 ENDDO
295 NN=NUMNOD
296 ELSE
297 IG=0
298 DO I=1,NGRNOD
299 IF(IGRNOD(I)%ID==IGU1)THEN
300 IG=I
301 ENDIF
302 ENDDO
303
304 NN=IGRNOD(IG)%NENTITY
305 DO I=1,NN
306 EIGIBUF(IADB+I-1)=IGRNOD(IG)%ENTITY(I)
307 ITAG(IGRNOD(IG)%ENTITY(I))=1
308 ENDDO
309 ENDIF
310 EIGIPM(IAD+9)=NN
311.AND. IF (NSPMD>1NN/=NUMNOD) THEN
312 CALL ANCMSG(MSGID=629,
313 . MSGTYPE=MSGERROR,
314 . ANMODE=ANINFO_BLIND_1,
315 . I1=ID,
316 . C1=TITR,
317 . I2=NN,
318 . I3=NUMNOD)
319 ENDIF
320 NNI=0
321 ICT=0
322 ICR=0
323 IF (IGU2==0) THEN
324 ITYP=1
325 EIGIPM(IAD+1)=ITYP
326 ELSE
327 ITYP=2
328 EIGIPM(IAD+1)=ITYP
329 ICT=J6(1)*4 +J6(2)*2 +J6(3)
330 ICR=J6(4)*4 +J6(5)*2 +J6(6)
331
332 IG=0
333 DO I=1,NGRNOD
334 IF(IGRNOD(I)%ID==IGU2)THEN
335 IG=I
336 ENDIF
337 ENDDO
338
339 DO I=1,IGRNOD(IG)%NENTITY
340 IF (ITAG(IGRNOD(IG)%ENTITY(I))==1) THEN
341 NNI=NNI+1
342 EIGIBUF(IADB+NN+NNI-1)=IGRNOD(IG)%ENTITY(I)
343 ENDIF
344 ENDDO
345 ENDIF
346 EIGIPM(IAD+10)=NNI
347 EIGIPM(IAD+2)=ICT
348 EIGIPM(IAD+3)=ICR
349
350 EIGIPM(IAD+16)=IMLS
351
352 IF (IPRSP>1) IPRSP=0
353 CALL HM_GET_FLOATV_DIM('freqmin',FAC_FRE,IS_AVAILABLE,LSUBMODEL,UNITAB)
354 IF (SHIFTINI==ZERO) SHIFTINI=EM03*FAC_FRE
355
356
357
358 IF (NEV==0) NEV=100
359 EIGIPM(IAD+4)=NEV
360 EIGRPM(IADF+1)=ZERO
361 EIGRPM(IADF+2)=(SHIFTINI*TWO*PI)**2
362 EIGRPM(IADF+3)=CUTFREQ
363
364 IF (NBLFR==0) NBLFR=NEV
365 IF (INCV==0) INCV=2
366 IF (NITER==0) NITER=300
367
368 EIGIPM(IAD+8)=NBLFR
369 EIGIPM(IAD+5)=INCV
370 EIGIPM(IAD+6)=NITER
371 EIGIPM(IAD+7)=IPRI
372
373 EIGIPM(IAD+14)=IPRSP
374
375 EIGIPM(IAD+15)=0
376
377 EIGRPM(IADF)=TOL
378
379 EIGIPM(IAD+13)=0
380 IF (IFILE==1) THEN
381 MAXL = 100
382 CALL HM_GET_STRING('filename', MODFILE, MAXL, IS_AVAILABLE)
383 LEN_MODFILE = LEN_TRIM(MODFILE)
384 MODFILE_TMP = INFILE_NAME(1:INFILE_NAME_LEN)//MODFILE(1:LEN_MODFILE)
385 LEN_MODFILE = LEN_MODFILE + INFILE_NAME_LEN
386 OPEN(UNIT=IFICM,FILE=MODFILE_TMP(1:LEN_MODFILE),
387 . ACCESS='sequential',FORM='formatted',
388 . STATUS='old',ERR=999)
389 CALL EIGRLINE(IFICM,NWLINE,ID,TITR)
390 READ(NWLINE,FMT='(2i8)',ERR=9999) NBNO, NBMO
391
392 IF (NEV>NBMO) THEN
393 CALL ANCMSG(MSGID=589,
394 . MSGTYPE=MSGWARNING,
395 . ANMODE=ANINFO_BLIND_1,
396 . I1=ID,
397 . C1=TITR,
398 . I3=NEV,
399 . I2=NBMO)
400 NEV=NBMO
401 EIGIPM(IAD+4)=NEV
402 ENDIF
403 NBLFR=MIN(NBMO-2,NBLFR)
404 EIGIPM(IAD+8)=NBLFR
405
406 ALLOCATE(NODES(NBNO), MODES(NBMO,6,NN))
407 NLIG=NBNO/10
408 NRES=NBNO-NLIG*10
409 IADN=0
410 DO I=1,NLIG
411 CALL EIGRLINE(IFICM,NWLINE,ID,TITR)
412 READ(NWLINE,FMT='(10i8)',ERR=9999) (NODES(IADN+J),J=1,10)
413 DO J=1,10
414 NODES(IADN+J)=USR2SYS(NODES(IADN+J),ITABM1,MESS,ID)
415 ENDDO
416 IADN=IADN+10
417 ENDDO
418 IF (NRES>0) THEN
419 CALL EIGRLINE(IFICM,NWLINE,ID,TITR)
420 READ(NWLINE,FMT='(10i8)',ERR=9999)
421 . (NODES(IADN+J),J=1,NRES)
422 DO J=1,NRES
423 NODES(IADN+J)=USR2SYS(NODES(IADN+J),ITABM1,MESS,ID)
424 ENDDO
425 ENDIF
426
427 DO I=1,NUMNOD
428 ITAG(I)=0
429 ENDDO
430 DO I=1,NN
431 II=EIGIBUF(IADB+I-1)
432 ITAG(II)=I
433 ENDDO
434 DO I=1,NBNO
435 II=NODES(I)
436 NODES(I)=ITAG(II)
437 ITAG(II)=-1
438 ENDDO
439 DO I=1,NN
440 II=EIGIBUF(IADB+I-1)
441 IF (ITAG(II)/=-1) THEN
442 J=ITABM1(II)
443 CALL ANCMSG(MSGID=586,
444 . MSGTYPE=MSGERROR,
445 . ANMODE=ANINFO_BLIND_1,
446 . I1=ID,
447 . C1=TITR,
448 . I2=J)
449 ENDIF
450 ENDDO
451
452 DO I=1,NBMO
453 DO J=1,NBNO
454 JJ=NODES(J)
455 CALL EIGRLINE(IFICM,NWLINE,ID,TITR)
456 READ(NWLINE,FMT='(5f16.0)',ERR=9999)
457 . (MODES(I,K,JJ),K=1,5)
458 CALL EIGRLINE(IFICM,NWLINE,ID,TITR)
459 READ(NWLINE,FMT='(f16.0)',ERR=9999) MODES(I,6,JJ)
460 ENDDO
461 ENDDO
462
463 EIGIPM(IAD+12)=IRCM
464 EIGIPM(IAD+13)=NBMO
465 DO I=1,NBMO
466 DO J=1,NBNO
467 IRCM=IRCM+1
468 WRITE(IEIGM,REC=IRCM) (MODES(I,K,J),K=1,6)
469 ENDDO
470 ENDDO
471
472 DEALLOCATE(NODES, MODES)
473 CLOSE(IFICM)
474 ENDIF
475
476 NDOF=0
477 IF(ICT==1)THEN
478 NDOF=1
479 ELSEIF(ICT==2)THEN
480 NDOF=1
481 ELSEIF(ICT==3)THEN
482 NDOF=2
483 ELSEIF(ICT==4)THEN
484 NDOF=1
485 ELSEIF(ICT==5)THEN
486 NDOF=2
487 ELSEIF(ICT==6)THEN
488 NDOF=2
489 ELSEIF(ICT==7)THEN
490 NDOF=3
491 ENDIF
492 IF(ICR==1)THEN
493 NDOF=NDOF+1
494 ELSEIF(ICR==2)THEN
495 NDOF=NDOF+1
496 ELSEIF(ICR==3)THEN
497 NDOF=NDOF+2
498 ELSEIF(ICR==4)THEN
499 NDOF=NDOF+1
500 ELSEIF(ICR==5)THEN
501 NDOF=NDOF+2
502 ELSEIF(ICR==6)THEN
503 NDOF=NDOF+2
504 ELSEIF(ICR==7)THEN
505 NDOF=NDOF+3
506 ENDIF
507 NMS=NNI*NDOF
508 IF (ITYP==1) THEN
509 CTYPE=' free eigenmodes'
510 ELSEIF (ITYP==2) THEN
511 CTYPE='clamped eigenmodes +
static modes
'
512 ENDIF
513 IF (TOL>ZERO) THEN
514 WRITE(CPRE,FMT='(7x,1pe10.3)') TOL
515 ELSE
516 CPRE='machine precision'
517 ENDIF
518
519 CIMLS=' no'
520 IF (IMLS==1) CIMLS='yes'
521 CPRSP='mass'
522 IF (IPRSP==1) CPRSP='max '
523 WRITE(IOUT,2100) ID,TRIM(TITR),CTYPE, NEV, NBLFR, INCV, NITER, CPRE,CIMLS,CPRSP
524 IF (ITYP==2) WRITE(IOUT,2105) NMS
525 WRITE(IOUT,2109)
526 WRITE(IOUT,2110) (EIGIBUF(IADB+I-1),I=1,NN)
527 IF (ITYP==2) THEN
528 WRITE(IOUT,2111)
529 WRITE(IOUT,2110) (EIGIBUF(IADB+NN+I-1),I=1,NNI)
530 ENDIF
531
532 EIGIPM(IAD+11)=IADB
533 IAD=IAD+NEIPM
534 IADB=IADB+NN+NNI
535 IADF=IADF+NERPM
536 ENDDO
537
538 RETURN
539 999 CALL FREERR(3)
540 RETURN
5419999 CALL ANCMSG(MSGID=587,
542 . MSGTYPE=MSGERROR,
543 . ANMODE=ANINFO,
544 . I1=ID,
545 . C1=TITR,
546 . C2=NWLINE)
547 RETURN
548
5492100 FORMAT( /5X,'eigenproblem
id ',I10,1X,A
550 . /10X,'type ',A33
551 . /10X,'number of eigenmodes ',I10
552 . /10X,'number of frequencies per block ',I10
553 . /10X,'factor
for number of lanczos vectors
',I10
554 . /10X,'max number of arnoldi iterations
',I10
555 . /10X,'precision ',A17
556 . /10X,'use of multi-level condensation ',7X,A3,
557 . /10X,'output eigenvectors normalization ',6X,A4)
5582105 FORMAT( 10X,'number of
static modes
',I10)
5592109 FORMAT( 10X,'nodes ')
5602110 FORMAT( 9X,10I9)
5612111 FORMAT( 10X,'interface nodes ')
subroutine eig(k_diag, k_lt, iadk, jdik, ms, in, nddl, ndof, nnzl, x, d, v, a, bufel, ixs, ixq, ixc, ixt, ixp, ixr, ixtg, pm, geo, cont, icut, skew, xcut, fint, itab, fext, fopt, anin, lpby, npby, nstrf, rwbuf, nprw, tani, elbuf_tab, matparam_tab, dd_iad, fr_iad, dd_front, cluster, weight, eani, ipart, rby, nom_opt, igrsurf, bufsf, idata, rdata, bufmat, bufgeo, kxx, ixx, kxsp, ixsp, nod2sp, spbuf, ixs10, ixs20, ixs16, vr, monvol, volmon, ipm, igeo, iparg, eigipm, eigibuf, eigrpm, ldiag, ljdik, ljdik2, ikc, maxncv, thke, nms, nint2, iint2, ipari, intbuf_tab, nodglob, iad_elem, fr_elem, fr_sec, fr_rby2, iad_rby2, fr_wall, inloc, iddl, partsav, fncont, ftcont, temp, err_thk_sh4, err_thk_sh3, irbe2, irbe3, lrbe2, lrbe3, fr_rbe2, fr_rbe3m, iad_rbe2, weight_md, fcluster, mcluster, xfem_tab, w, nv46, nercvois, nesdvois, lercvois, lesdvois, crkedge, indx_crk, xedge4n, xedge3n, stack, sph2sol, stifn, stifr, drape_q4, drape_t3, h3d_data, subset, igrnod, fcont_max, fncontp2, ftcontp2, ale_connectivity, glob_therm)
for(i8=*sizetab-1;i8 >=0;i8--)
integer, parameter ncharfield
subroutine static(v, vr, a, ar, ms, in, igrnod, weight_md, wfext)