OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_eig.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"
#include "com01_c.inc"
#include "units_c.inc"
#include "eigcom.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_preread_eig (igrnod, nnt, lsubmodel)
subroutine hm_read_eig (eigipm, eigibuf, eigrpm, igrnod, itabm1, unitab, lsubmodel)
subroutine eigrline (ific, nwline, id, titr)

Function/Subroutine Documentation

◆ eigrline()

subroutine eigrline ( integer ific,
character nwline,
integer id,
character(len=nchartitle) titr )

Definition at line 574 of file hm_read_eig.F.

575C-----------------------------------------------
576C M o d u l e s
577C-----------------------------------------------
578 USE message_mod
579 USE names_and_titles_mod , ONLY : nchartitle
580C-----------------------------------------------
581C I m p l i c i t T y p e s
582C-----------------------------------------------
583#include "implicit_f.inc"
584C-----------------------------------------------
585C D u m m y A r g u m e n t s
586C-----------------------------------------------
587 INTEGER IFIC, ID
588 CHARACTER NWLINE*100
589 CHARACTER(LEN=NCHARTITLE)::TITR
590C-----------------------------------------------
591C L o c a l V a r i a b l e s
592C-----------------------------------------------
593 INTEGER ISTOP
594C
595 istop=0
596 DO WHILE (istop==0)
597 READ(ific,'(A)',END=999) nwline
598 IF (nwline(1:1)/='#') istop=1
599 ENDDO
600C
601 RETURN
602 999 CALL ancmsg(msgid=585,
603 . msgtype=msgerror,
604 . anmode=aninfo,
605 . i1=id,
606 . c1=titr)
607 RETURN
608C
id
initmumps id
Definition multiplerhs_example.m:4
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1003
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:889

◆ hm_preread_eig()

subroutine hm_preread_eig ( type (group_), dimension(ngrnod) igrnod,
integer nnt,
type (submodel_data), dimension(*), intent(in) lsubmodel )

Definition at line 38 of file hm_read_eig.F.

39C-----------------------------------------------
40C M o d u l e s
41C-----------------------------------------------
42 USE message_mod
43 USE groupdef_mod
44 USE submodel_mod
45 USE hm_option_read_mod
46 USE unitab_mod
47 USE random_mod
48 USE names_and_titles_mod , ONLY : nchartitle, ncharkey
49C-----------------------------------------------
50C I m p l i c i t T y p e s
51C-----------------------------------------------
52#include "implicit_f.inc"
53C-----------------------------------------------
54C C o m m o n B l o c k s
55C-----------------------------------------------
56#include "com04_c.inc"
57C-----------------------------------------------
58C D u m m y A r g u m e n t s
59C-----------------------------------------------
60 INTEGER NNT
61C-----------------------------------------------
62 TYPE (GROUP_), DIMENSION(NGRNOD) :: IGRNOD
63 TYPE (SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(*)
64C-----------------------------------------------
65C L o c a l V a r i a b l e s
66C-----------------------------------------------
67 INTEGER I, IE,N, IG, IGU1, IGU2, NNI, ID, NM,M, SUB_INDEX
68 CHARACTER(LEN=NCHARTITLE)::TITR
69 CHARACTER(LEN=NCHARKEY)::KEY
70 CHARACTER :: MESS*40
71 LOGICAL IS_AVAILABLE
72C
73 DATA mess/'EIGEN AND STATIC MODES COMPUTATION '/
74C=====================================================================
75C
76 nnt=0
77 CALL hm_option_start('/EIG')
78 DO ie=1,neig
79 CALL hm_option_read_key(lsubmodel,
80 . option_id = id,
81 . submodel_index = sub_index,
82 . option_titr = titr)
83 CALL hm_get_intv('grnd_ID',igu1,is_available,lsubmodel)
84 CALL hm_get_intv('grnd_bc',igu2,is_available,lsubmodel)
85C
86 IF (igu1==0) THEN
87 nnt=nnt+numnod
88 ELSE
89 ig=0
90 DO i=1,ngrnod
91 IF(igrnod(i)%ID==igu1)THEN
92 ig=i
93 ENDIF
94 ENDDO
95C
96 IF(ig==0)THEN
97 CALL ancmsg(msgid=53,
98 . msgtype=msgerror,
99 . anmode=aninfo,
100 . c1= mess,
101 . i1=igu1)
102 RETURN
103 ENDIF
104C
105 nnt=nnt+igrnod(ig)%NENTITY
106 ENDIF
107C
108 nni=0
109 IF (igu2/=0) THEN
110 ig=0
111 DO i=1,ngrnod
112 IF(igrnod(i)%ID==igu2)THEN
113 ig=i
114 ENDIF
115 ENDDO
116C
117 IF(ig==0)THEN
118 CALL ancmsg(msgid=53,
119 . msgtype=msgerror,
120 . anmode=aninfo,
121 . c1= mess,
122 . i1=igu2)
123 RETURN
124 ENDIF
125C
126 nni=igrnod(ig)%NENTITY
127C
128 ENDIF
129 nnt=nnt+nni
130 ENDDO
131C-----------------------
132 RETURN
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:251
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:410
groupdef_mod
Definition groupdef_mod.F:662
hm_option_read_mod
Definition hm_option_read_mod.F:408
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1000
random_mod
Definition random_mod.F:33
submodel_mod
Definition submodel_mod.F:712
unitab_mod
Definition unitab_mod.F:513

◆ hm_read_eig()

subroutine hm_read_eig ( integer, dimension(*) eigipm,
integer, dimension(*) eigibuf,
eigrpm,
type (group_), dimension(ngrnod) igrnod,
integer, dimension(*) itabm1,
type (unit_type_), intent(in) unitab,
type (submodel_data), dimension(*), intent(in) lsubmodel )

Definition at line 154 of file hm_read_eig.F.

156C-----------------------------------------------
157C M o d u l e s
158C-----------------------------------------------
159 USE message_mod
160 USE groupdef_mod
161 USE submodel_mod
162 USE hm_option_read_mod
163 USE unitab_mod
164 USE random_mod
165 USE inoutfile_mod
166 USE names_and_titles_mod , ONLY : nchartitle, ncharfield
167C-----------------------------------------------
168C I m p l i c i t T y p e s
169C-----------------------------------------------
170#include "implicit_f.inc"
171C-----------------------------------------------
172C C o m m o n B l o c k s
173C-----------------------------------------------
174#include "com01_c.inc"
175#include "com04_c.inc"
176#include "units_c.inc"
177#include "eigcom.inc"
178C-----------------------------------------------
179C D u m m y A r g u m e n t s
180C-----------------------------------------------
181 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
182 INTEGER EIGIPM(*), EIGIBUF(*),ITABM1(*)
183 my_real
184 . eigrpm(*)
185C-----------------------------------------------
186 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
187 TYPE (SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(*)
188C-----------------------------------------------
189C L o c a l V a r i a b l e s
190C-----------------------------------------------
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, NITER, IPRI, NDOF, NMS, IFILE,
195 . J6(6), ITYP, IADB, IRCM, J, JJ, K, NLIG, NRES, IADN,
196 . NBNO, NBMO, II, IPRSP, IMLS, IFLAGUNIT,LEN_MODFILE,MAXL
197 my_real
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(:)
205 my_real,
206 . ALLOCATABLE :: modes(:,:,:)
207C-----------------------------------------------
208C E x t e r n a l F u n c t i o n s
209C-----------------------------------------------
210 INTEGER USR2SYS
211 DATA mess/'ADDITIONAL MODES FILE : NODES '/
212C=====================================================================
213 iad=1
214 iadb=1
215 iadf=1
216 CALL hm_option_start('/EIG')
217 ircm = 0
218 DO ie=1,neig
219 itag(1:numnod)=0
220 CALL hm_option_read_key(lsubmodel,
221 . option_id = id,
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)
243C
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 IF (uid/=0.AND.iflagunit==0) THEN
253 CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,
254 . i2=uid,i1=id,c1='EIG',
255 . c2='EIG',
256 . c3=titr)
257 ENDIF
258 eigipm(iad)=id
259C
260 IF (ifile==2) THEN
261C--- add generic message
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
270C
271 IF (ifile==1.AND.igu2/=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
280C
281 IF (nspmd>1.AND.ifile==1) THEN
282 CALL ancmsg(msgid=628,
283 . msgtype=msgwarning,
284 . anmode=aninfo,
285 . i1=id,
286 . c1=titr)
287 ifile=0
288 ENDIF
289C
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
303C
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 IF (nspmd>1.AND.nn/=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)
331C
332 ig=0
333 DO i=1,ngrnod
334 IF(igrnod(i)%ID==igu2)THEN
335 ig=i
336 ENDIF
337 ENDDO
338C
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
349C
350 eigipm(iad+16)=imls
351C
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
355C CUTFREQ = CUTFREQ / FAC_T
356C SHIFTINI = SHIFTINI / FAC_T
357C
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
363C
364 IF (nblfr==0) nblfr=nev
365 IF (incv==0) incv=2
366 IF (niter==0) niter=300
367C
368 eigipm(iad+8)=nblfr
369 eigipm(iad+5)=incv
370 eigipm(iad+6)=niter
371 eigipm(iad+7)=ipri
372C
373 eigipm(iad+14)=iprsp
374C
375 eigipm(iad+15)=0
376C
377 eigrpm(iadf)=tol
378C
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
391C
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
405C
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
426C
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
451C
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
462C
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
471C
472 DEALLOCATE(nodes, modes)
473 CLOSE(ificm)
474 ENDIF
475C PRINTOUTS
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
518C
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
531C
532 eigipm(iad+11)=iadb
533 iad=iad+neipm
534 iadb=iadb+nn+nni
535 iadf=iadf+nerpm
536 ENDDO
537C-----------------------
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
548C
5492000 FORMAT(/
550 . /
551 . ' EIGEN AND STATIC MODES COMPUTATION '/
552 . ' ---------------------------------- '/)
5532100 FORMAT( /5x,'EIGENPROBLEM ID ',i10,1x,a
554 . /10x,'TYPE ',a33
555 . /10x,'NUMBER OF EIGENMODES ',i10
556 . /10x,'NUMBER OF FREQUENCIES PER BLOCK ',i10
557 . /10x,'FACTOR FOR NUMBER OF LANCZOS VECTORS ',i10
558 . /10x,'max number of arnoldi iterations ',I10
559 . /10X,'precision ',A17
560 . /10X,'USE of multi-level condensation ',7X,A3,
561 . /10X,'output eigenvectors normalization ',6X,A4)
5622105 FORMAT( 10X,'number of static modes ',I10)
5632109 FORMAT( 10X,'nodes ')
5642110 FORMAT( 9X,10I9)
5652111 FORMAT( 10X,'interface nodes ')
my_real
#define my_real
Definition cppsort.cpp:32
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:415
hm_get_floatv_dim
subroutine hm_get_floatv_dim(name, dim_fac, is_available, lsubmodel, unitab)
Definition hm_get_floatv_dim.F:159
hm_get_string
subroutine hm_get_string(name, sval, size, is_available)
Definition hm_get_string.F:76
eigrline
subroutine eigrline(ific, nwline, id, titr)
Definition hm_read_eig.F:575
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
inoutfile_mod
Definition inoutfile_mod.F:96
inoutfile_mod::infile_name_len
integer infile_name_len
Definition inoutfile_mod.F:114
inoutfile_mod::infile_name
character(len=infile_char_len) infile_name
Definition inoutfile_mod.F:116
names_and_titles_mod::ncharfield
integer, parameter ncharfield
Definition names_and_titles_mod.F:1005
freerr
subroutine freerr(it)
Definition freform.F:506
usr2sys
integer function usr2sys(iu, itabm1, mess, id)
Definition sysfus.F:160
static
subroutine static(v, vr, a, ar, ms, in, igrnod, weight_md, wfext)
Definition static.F:33