170#include "implicit_f.inc"
174#include "com01_c.inc"
175#include "com04_c.inc"
176#include "units_c.inc"
181 TYPE (UNIT_TYPE_),
INTENT(IN) ::UNITAB
182 INTEGER EIGIPM(*), EIGIBUF(*),ITABM1(*)
186 TYPE (GROUP_) ,
DIMENSION(NGRNOD) :: IGRNOD
187 TYPE (SUBMODEL_DATA),
INTENT(IN)::LSUBMODEL(*)
191 INTEGER ID,SUB_INDEX,UID
193 INTEGER I, (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
198 . cutfreq, shiftini, tol, fac_t,fac_fre
199 CHARACTER(LEN=NCHARTITLE)::TITR
200 CHARACTER(LEN=NCHARFIELD)::STRING
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(:,:,:)
211 DATA mess/
'ADDITIONAL MODES FILE : NODES '/
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)
246 IF (unitab%UNIT_ID(j) == uid)
THEN
247 fac_t = unitab%FAC_T(j)
252 IF (uid/=0.AND.iflagunit==0)
THEN
253 CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,
254 . i2=uid,i1=id,c1=
'EIG',
262 WRITE(istdo,
'(A)')
' ** WARNING - EIG OPTION:'
264 .
' ** USE OF NASTRAN OUTPUT FILE NOT YET IMPLEMENTED'
265 WRITE(iout,
'(A)')
' ** WARNING - EIG OPTION:'
267 .
' ** USE OF NASTRAN OUTPUT FILE NOT YET IMPLEMENTED'
271 IF (ifile==1.AND.igu2/=0)
THEN
273 . msgtype=msgwarning,
274 . anmode=aninfo_blind_1,
281 IF (nspmd>1.AND.ifile==1)
THEN
283 . msgtype=msgwarning,
299 IF(igrnod(i)%ID==igu1)
THEN
304 nn=igrnod(ig)%NENTITY
306 eigibuf(iadb+i-1)=igrnod(ig)%ENTITY(i)
307 itag(igrnod(ig)%ENTITY(i))=1
311 IF (nspmd>1.AND.nn/=numnod)
THEN
314 . anmode=aninfo_blind_1,
329 ict=j6(1)*4 +j6(2)*2 +j6(3)
330 icr=j6(4)*4 +j6(5)*2 +j6(6)
334 IF(igrnod(i)%ID==igu2)
THEN
339 DO i=1,igrnod(ig)%NENTITY
340 IF (itag(igrnod(ig)%ENTITY(i))==1)
THEN
342 eigibuf(iadb+nn+nni-1)=igrnod(ig)%ENTITY(i)
354 IF (shiftini==zero) shiftini=em03*fac_fre
361 eigrpm(iadf+2)=(shiftini*two*pi)**2
362 eigrpm(iadf+3)=cutfreq
364 IF (nblfr==0) nblfr=nev
366 IF (niter==0) niter=300
383 len_modfile = len_trim(modfile)
386 OPEN(unit=ificm,file=modfile_tmp(1:len_modfile),
387 . access=
'SEQUENTIAL',form=
'FORMATTED',
388 . status=
'OLD',err=999)
390 READ(nwline,fmt=
'(2I8)',err=9999) nbno, nbmo
394 . msgtype=msgwarning,
395 . anmode=aninfo_blind_1,
403 nblfr=
min(nbmo-2,nblfr)
406 ALLOCATE(nodes(nbno), modes(nbmo,6,nn))
412 READ(nwline,fmt=
'(10I8)',err=9999) (nodes(iadn+j),j=1,10)
414 nodes(iadn+j)=usr2sys(nodes(iadn+j),itabm1,mess,id)
420 READ(nwline,fmt=
'(10I8)',err=9999)
421 . (nodes(iadn+j),j=1,nres)
423 nodes(iadn+j)=usr2sys(nodes(iadn+j),itabm1,mess,id)
441 IF (itag(ii)/=-1)
THEN
445 . anmode=aninfo_blind_1,
456 READ(nwline,fmt=
'(5F16.0)',err=9999)
457 . (modes(i,k,jj),k=1,5)
459 READ(nwline,fmt=
'(F16.0)',err=9999) modes(i,6,jj)
468 WRITE(ieigm,rec=ircm) (modes(i,k,j),k=1,6)
472 DEALLOCATE(nodes, modes)
509 ctype=
' FREE EIGENMODES'
510 ELSEIF (ityp==2)
THEN
511 ctype=
'CLAMPED EIGENMODES + STATIC MODES'
514 WRITE(cpre,fmt=
'(7X,1PE10.3)') tol
516 cpre=
'MACHINE PRECISION'
520 IF (imls==1) cimls=
'YES'
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
526 WRITE(iout,2110) (eigibuf(iadb+i-1),i=1,nn)
529 WRITE(iout,2110) (eigibuf(iadb+nn+i-1),i=1,nni)
5419999
CALL ancmsg(msgid=587,
551 .
' EIGEN AND STATIC MODES COMPUTATION '/
552 .
' ---------------------------------- '/)
5532100
FORMAT( /5x,
'EIGENPROBLEM ID ',i10,1x,a
555 . /10x,
'NUMBER OF EIGENMODES ',i10
556 . /10x,
'NUMBER OF FREQUENCIES PER BLOCK '
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 ')
5652111
FORMAT( 10x,
'INTERFACE NODES ')
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)