OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_fxb.F
Go to the documentation of this file.
1Copyright> OpenRadioss
2Copyright> Copyright (C) 1986-2025 Altair Engineering Inc.
3Copyright>
4Copyright> This program is free software: you can redistribute it and/or modify
5Copyright> it under the terms of the GNU Affero General Public License as published by
6Copyright> the Free Software Foundation, either version 3 of the License, or
7Copyright> (at your option) any later version.
8Copyright>
9Copyright> This program is distributed in the hope that it will be useful,
10Copyright> but WITHOUT ANY WARRANTY; without even the implied warranty of
11Copyright> MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12Copyright> GNU Affero General Public License for more details.
13Copyright>
14Copyright> You should have received a copy of the GNU Affero General Public License
15Copyright> along with this program. If not, see <https://www.gnu.org/licenses/>.
16Copyright>
17Copyright>
18Copyright> Commercial Alternative: Altair Radioss Software
19Copyright>
20Copyright> As an alternative to this open-source version, Altair also offers Altair Radioss
21Copyright> software under a commercial license. Contact Altair to discuss further if the
22Copyright> commercial version may interest you: https://www.altair.com/radioss/.
23!||====================================================================
24!|| hm_read_fxb1 ../starter/source/constraints/fxbody/hm_read_fxb.f
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| fretitl ../starter/source/starter/freform.F
30!|| fretitl2 ../starter/source/starter/freform.F
31!|| fxrline ../starter/source/constraints/fxbody/hm_read_fxb.F
32!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
33!|| hm_get_string ../starter/source/devtools/hm_reader/hm_get_string.F
34!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
35!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
36!|| newdbl ../starter/source/system/sysfus.F
37!|| read_pch_file ../starter/source/constraints/fxbody/read_pch_file.F
38!|| udouble ../starter/source/system/sysfus.F
39!|| usr2sys ../starter/source/system/sysfus.f
40!||--- uses -----------------------------------------------------
41!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
42!|| message_mod ../starter/share/message_module/message_mod.F
43!|| submodel_mod ../starter/share/modules1/submodel_mod.F
44!||====================================================================
45 SUBROUTINE hm_read_fxb1(NOM_OPT,FXBNOD,FXBIPM,FXB_MATRIX,FXB_MATRIX_ADD,
46 . NMANIM,ITAB,ITABM1,FXBFILE_TAB,LSUBMODEL)
47C-----------------------------------------------
48C M o d u l e s
49C-----------------------------------------------
50 USE message_mod
51 USE inoutfile_mod
52 USE hm_option_read_mod
53 USE submodel_mod , ONLY : nsubmod, submodel_data
54 USE names_and_titles_mod , ONLY : nchartitle
55C-----------------------------------------------
56C I m p l i c i t T y p e s
57C-----------------------------------------------
58#include "implicit_f.inc"
59C-----------------------------------------------
60C C o m m o n B l o c k s
61C-----------------------------------------------
62#include "com04_c.inc"
63#include "units_c.inc"
64#include "scr17_c.inc"
65#include "fxbcom.inc"
66C-----------------------------------------------
67C D u m m y A r g u m e n t s
68C-----------------------------------------------
69 INTEGER NOM_OPT(LNOPT1,*),FXBIPM(NBIPM,*),FXBNOD(*),FXB_MATRIX_ADD(4,*),NMANIM,ITAB(*),ITABM1(*)
70 my_real fxb_matrix(*)
71 CHARACTER, DIMENSION(NFXBODY) :: FXBFILE_TAB*2148
72 TYPE(submodel_data) LSUBMODEL(NSUBMOD)
73C-----------------------------------------------
74C L o c a l V a r i a b l e s
75C-----------------------------------------------
76 INTEGER ID,I,J,L,NFX,NMOD,NMST,NBNO,NTR,NME,IDAMP,
77 . ishell,iblo,ifile,idmast,ianim,imin,imax,adrnod,nlig,nres,ilig,
78 . numno(10),bid,iflagi1,ic,iold,iflagdbl,irb,flag,idum1,idum2,idum3,
79 . size_max,size_mat,i1,i2,idof1,idof2,adr_mat,adr_mass,adr_mass0,adrnod0,
80 . il1,il2,adr_stiff,adr_stiff0,size_mass,size_stiff
81 INTEGER IWORK(70000)
82 CHARACTER FXBFILE*2148, NWLINE*100, STRERR*29
83 CHARACTER(LEN=NCHARTITLE) :: TITR
84 CHARACTER :: MESS*40,MESS1*40,EXTENSION*3
85 INTEGER, DIMENSION(:,:), ALLOCATABLE :: TABSL,ITAG_DOF
86 INTEGER, DIMENSION(:), ALLOCATABLE :: INDEX,ITAG
87
88 INTEGER :: LEN_TMP_NAME
89 CHARACTER(len=2148) :: TMP_NAME
90 LOGICAL :: IS_AVAILABLE
91
92C-----------------------------------------------
93C E x t e r n a l F u n c t i o n s
94C-----------------------------------------------
95 INTEGER USR2SYS
96 DATA mess/'FLEXIBLE BODY : NODES '/
97 DATA mess1/'FLEXIBLE BODY DEFINITION '/
98C=======================================================================
99C
100 WRITE(iout,2000)
101C
102 size_max = 0
103 DO nfx=1,nfxbody
104 size_max = max(size_max,fxbipm(3,nfx))
105 ENDDO
106C
107 IF (lennod > 0) THEN
108 ALLOCATE(tabsl(2,lennod))
109 ALLOCATE(index(3*lennod))
110 ALLOCATE(itag_dof(6,size_max))
111 ALLOCATE(itag(numnod))
112 itag(1:numnod) = 0
113 itag_dof(1:6,1:size_max) = 0
114 tabsl = 0
115 index = 0
116 END IF
117C
118 adrnod = 1
119 adr_mat = 1
120 is_available = .false.
121C
122 CALL hm_option_start('/FXBODY')
123C
124 ! Loop over FXBODY
125 DO nfx = 1,nfxbody
126C
127 ! Title and ID
128 titr = ''
129 CALL hm_option_read_key(lsubmodel,
130 . option_id = id,
131 . option_titr = titr)
132C
133 nom_opt(1,nfx) = id
134 CALL fretitl(titr,nom_opt(lnopt1-ltitr+1,nfx),ltitr)
135C
136 ! Integer data card
137 CALL hm_get_intv('node_IDm',idmast,is_available,lsubmodel)
138 CALL hm_get_intv('Ianim' ,ianim ,is_available,lsubmodel)
139 CALL hm_get_intv('Imin' ,imin ,is_available,lsubmodel)
140 CALL hm_get_intv('Imax' ,imax ,is_available,lsubmodel)
141C
142 ! File name
143 CALL hm_get_string('Filename',fxbfile ,2148 ,is_available)
144 fxbfile_tab(nfx) = fxbfile
145C
146 IF (fxbipm(41,nfx) == 2) THEN
147C
148 nbno = fxbipm(3,nfx)
149 fxbipm(6,nfx) = adrnod
150C
151 size_stiff = fxbipm(42,nfx)
152 size_mass = fxbipm(43,nfx)
153 adr_stiff = adr_mat
154 adr_mass = adr_mat + size_stiff
155 fxbipm(44,nfx) = adr_stiff
156 fxbipm(45,nfx) = adr_mass
157 adr_stiff0 = adr_stiff
158 adr_mass0 = adr_mass
159 adrnod0 = adrnod
160C
161C-- Pre-reading of pch file for dimensions
162 flag = 1
163 CALL read_pch_file(flag,fxb_matrix,itag,fxb_matrix_add,adr_stiff,
164 . adr_mass,itabm1,fxbfile,id,titr)
165C
166 adr_mat = adr_mat + size_stiff + size_mass
167C
168C -- Storage of nodes
169 DO i=1,numnod
170 IF (itag(i) > 0) THEN
171 fxbnod(adrnod) = i
172 tabsl(1,adrnod) = fxbnod(adrnod)
173 tabsl(2,adrnod) = nfx
174 adrnod = adrnod+1
175C-- Local id is stored in ITAG
176 itag(i) = adrnod-adrnod0
177 ENDIF
178 ENDDO
179C
180 nmod = 0
181 ishell = 0
182C
183 DO i=1,size_stiff
184 i1 = fxb_matrix_add(1,adr_stiff0+i-1)
185 i2 = fxb_matrix_add(2,adr_stiff0+i-1)
186 idof1 = fxb_matrix_add(3,adr_stiff0+i-1)
187 idof2 = fxb_matrix_add(4,adr_stiff0+i-1)
188C
189C In FXB_MATRIX_ADD -> local id in FXBNOD us used instead on internal id
190 il1 = itag(i1)
191 il2 = itag(i2)
192 fxb_matrix_add(1,adr_stiff0+i-1) = il1
193 fxb_matrix_add(2,adr_stiff0+i-1) = il2
194C
195C -- Craig-bampton with only boundary nodes - one static mode per dof in connected
196C -- oversizing - number of modes can be lower
197 IF (itag_dof(idof1,il1)==0) THEN
198 nmod = nmod + 1
199 IF (idof1 > 3) ishell = 1
200 itag_dof(idof1,il1) = 1
201 ENDIF
202 IF (itag_dof(idof2,il2)==0) THEN
203 nmod = nmod + 1
204 IF (idof2 > 3) ishell = 1
205 itag_dof(idof2,il2) = 1
206 ENDIF
207 ENDDO
208C
209 DO i=1,size_mass
210 i1 = fxb_matrix_add(1,adr_mass0+i-1)
211 i2 = fxb_matrix_add(2,adr_mass0+i-1)
212C
213C In FXB_MATRIX_ADD -> local id in FXBNOD us used instead on internal id
214 il1 = itag(i1)
215 il2 = itag(i2)
216 fxb_matrix_add(1,adr_mass0+i-1) = il1
217 fxb_matrix_add(2,adr_mass0+i-1) = il2
218 ENDDO
219
220C-- RAZ of ITAG arrays
221 itag_dof(1:6,1:nbno) = 0
222 DO i=1,nbno
223 itag(fxbnod(adrnod0+i-1)) = 0
224 ENDDO
225 itag(1:numnod) = 0
226C
227C-- Craig-bampton static modes only
228 nmst = nmod
229 iblo = 0
230 ifile = 0
231C
232 IF (size_mass > 0) THEN
233 WRITE(iout,1200) id,trim(titr),idmast,nbno
234 ELSE
235 WRITE(iout,1100) id,trim(titr),idmast,nbno
236 ENDIF
237C
238 ELSE
239C
240 tmp_name = infile_name(1:infile_name_len)//fxbfile(1:len_trim(fxbfile))
241 len_tmp_name = infile_name_len + len_trim(fxbfile)
242 OPEN(unit=ificm,file=tmp_name(1:len_tmp_name),
243 . access='SEQUENTIAL',form='FORMATTED',
244 . status='OLD',err=1000)
245C
246C-------------------------------------
247C Reading of first lines
248C-------------------------------------
249C
250 CALL fxrline(ificm,nwline,id,titr)
251 READ(nwline,fmt='(7I8)',err=9999)
252 . nmod, nmst, nbno, ishell, idamp, iblo, ifile
253C Print-out of errors
254 IF (nmod < 0) THEN
255 strerr='NEGATIVE MODE NUMBER'
256 CALL ancmsg(msgid=582,
257 . msgtype=msgerror,
258 . anmode=aninfo,
259 . c1=fxbfile,
260 . c2=strerr)
261 ENDIF
262 IF (nmst < 0) THEN
263 strerr='NEGATIVE STATIC MODE NUMBER'
264 CALL ancmsg(msgid=582,
265 . msgtype=msgerror,
266 . anmode=aninfo,
267 . c1=fxbfile,
268 . c2=strerr)
269 ENDIF
270 IF (nbno < 0) THEN
271 strerr='NEGATIVE NODE NUMBER'
272 CALL ancmsg(msgid=582,
273 . msgtype=msgerror,
274 . anmode=aninfo,
275 . c1=fxbfile,
276 . c2=strerr)
277 ENDIF
278 IF (ishell /= 0.AND.ishell /= 1) THEN
279 strerr='INVALID VALUE FOR FLAG IROT'
280 CALL ancmsg(msgid=582,
281 . msgtype=msgerror,
282 . anmode=aninfo,
283 . c1=fxbfile,
284 . c2=strerr)
285 ENDIF
286 IF (idamp /= 0.AND.idamp /= 1) THEN
287 strerr='INVALID VALUE FOR FLAG IDAMP'
288 CALL ancmsg(msgid=582,
289 . msgtype=msgerror,
290 . anmode=aninfo_blind_1,
291 . c1=fxbfile,
292 . c2=strerr)
293 ENDIF
294 IF (iblo /= 0.AND.iblo /= 1) THEN
295 strerr='INVALID VALUE FOR FLAG IBLO'
296 CALL ancmsg(msgid=582,
297 . msgtype=msgerror,
298 . anmode=aninfo_blind_1,
299 . c1=fxbfile,
300 . c2=strerr)
301 ENDIF
302 IF (ifile /= 0.AND.ifile /= 1) THEN
303 strerr='INVALID VALUE FOR FLAG IFILE'
304 CALL ancmsg(msgid=582,
305 . msgtype=msgerror,
306 . anmode=aninfo_blind_1,
307 . c1=fxbfile,
308 . c2=strerr)
309 ENDIF
310C
311C-------------------------------------
312C Reading of FXB nodes
313C-------------------------------------
314C
315 fxbipm(6,nfx) = adrnod
316C
317 nlig = nbno/10
318 nres = nbno-nlig*10
319 DO ilig = 1,nlig
320 CALL fxrline(ificm,nwline,id,titr)
321 READ(nwline,'(10I8)',err=9999)
322 . (numno(i),i=1,10)
323 DO i=1,10
324 fxbnod(adrnod) = usr2sys(numno(i),itabm1,mess,id)
325 tabsl(1,adrnod) = fxbnod(adrnod)
326 tabsl(2,adrnod) = nfx
327 adrnod = adrnod+1
328 ENDDO
329 ENDDO
330 IF (nres > 0) THEN
331 CALL fxrline(ificm,nwline,id,titr)
332 READ(nwline,'(10I8)',err=9999)
333 . (numno(i),i=1,nres)
334 DO i = 1,nres
335 fxbnod(adrnod)=usr2sys(numno(i),itabm1,mess,id)
336 adrnod=adrnod+1
337 ENDDO
338 ENDIF
339C
340 ENDIF
341C
342 ntr = 9
343 IF (ishell == 0) THEN
344 nme = 12
345 ELSE
346 nme = 15
347 ENDIF
348C
349 lenglm = lenglm+nme*(nme+1)/2
350 lencp = lencp +ntr*nmod*nme
351 lenlm = lenlm +nmod
352 lenfls = lenfls+nmst*(2*nmod-nmst+1)/2
353 lendls = lendls+nmod-nmst
354 lenvar = lenvar+nmod+nme
355 lenrpm = lenrpm+ntr+7
356 lenmcd = lenmcd+nme*nme
357C
358 fxbipm(1,nfx) = id
359 fxbipm(2,nfx) = usr2sys(idmast,itabm1,mess,id)
360 fxbipm(4,nfx) = nmod
361 fxbipm(5,nfx) = nmst
362 fxbipm(16,nfx) = ishell
363 fxbipm(17,nfx) = nme
364 fxbipm(28,nfx) = iblo
365 fxbipm(29,nfx) = ifile
366 fxbipm(36,nfx) = ianim
367C
368 IF (imax == 0) imax = nmod
369 imin = max(1,imin)
370 imax = min(nmod,imax)
371 fxbipm(37,nfx) = imin
372 fxbipm(38,nfx) = imax
373 IF (ianim == 1) THEN
374 DO i = imin,imax
375 nmanim = nmanim+1
376 ENDDO
377 ENDIF
378C
379 CLOSE(ificm)
380C
381 ENDDO
382C
383C-------------------------------------
384C Search nodes with same ID
385C-------------------------------------
386 CALL udouble(fxbipm(1,1),nbipm,nfxbody,mess1,0,bid)
387C-------------------------------------
388C Search main nodes with same ID
389C-------------------------------------
390 ic = 567
391 i = 0
392c CALL ANCNTS(IC, I)
393 CALL newdbl(fxbipm(2,1),nbipm,nfxbody,itab,567,aninfo_blind_1,
394 . nom_opt)
395c CALL ANCNTG(IC, I, J)
396c CALL ANCHECK(67)
397C-------------------------------------
398C Secondary nodes with same ID
399C-------------------------------------
400 IF (nfxbody > 1) THEN
401 iwork=0
402 iflagdbl=0
403 DO i=1,lennod
404 index(i)=i
405 END DO
406 CALL my_orders(0,iwork,tabsl,index,lennod,2)
407 IF (lennod > 0) THEN
408 iold=-1
409 DO i=1,lennod
410 IF(index(i) /=0 )THEN
411 IF (tabsl(1,index(i))==iold) THEN
412 IF (iflagdbl==0) THEN
413 iflagi1=i-1
414 END IF
415 iflagdbl=1
416 ELSE
417 IF (iflagdbl/=0) THEN
418 DO j=iflagi1,i-1
419 irb=tabsl(2,index(j))
420 !ID=NOM_OPT(1,IRB)
421 CALL fretitl2(titr,nom_opt(lnopt1-ltitr+1,irb),ltitr)
422 CALL ancmsg(msgid=1026,
423 . msgtype=msgwarning,
424 . anmode=aninfo_blind_2,
425 . i1=id,
426 . c1=titr,
427 . prmod=msg_cumu)
428 END DO
429 CALL ancmsg(msgid=1026,
430 . msgtype=msgwarning,
431 . anmode=aninfo_blind_1,
432 . i1=tabsl(1,index(iflagi1)),
433 . prmod=msg_print)
434 iflagdbl=0
435 END IF
436 END IF
437 iold=tabsl(1,index(i))
438 ENDIF
439 END DO
440 END IF
441 END IF
442C
443C
444 DEALLOCATE(tabsl,index,itag_dof,itag)
445C
446 RETURN
4471000 CALL ancmsg(msgid=565,
448 . msgtype=msgerror,
449 . anmode=aninfo,
450 . i1=id,
451 . c1=titr,
452 . c2=fxbfile)
4539999 CALL ancmsg(msgid=566,
454 . msgtype=msgerror,
455 . anmode=aninfo,
456 . i1=id,
457 . c1=titr,
458 . c2=fxbfile,
459 . c3=nwline)
460 RETURN
461C
4622000 FORMAT(/
463 . ' FLEXIBLE BODY DEFINITIONS '/
464 . ' ---------------------- '/)
465C
4661100 FORMAT( /5x,'FLEXIBLE BODY ID ',i10,1x,a
467 . /10x,'MAIN NODE ID ',i10
468 . /10x,'NUMBER OF NODES ',i10
469 . /10x,'INITIALIZED FROM PCH FILE ',
470 . /10x,' --> STIFFNESS MATRIX ')
471C
4721200 FORMAT( /5x,'FLEXIBLE BODY ID ',i10,1x,a
473 . /10x,'MAIN NODE ID ',i10
474 . /10x,'NUMBER OF NODES ',i10
475 . /10x,'INITIALIZED FROM PCH FILE ',
476 . /10x,' --> STIFFNESS MATRIX ',
477 . /10x,' --> MASS MATRIX ')
478C
479 END SUBROUTINE hm_read_fxb1
480c=================================================================================
481!||====================================================================
482!|| hm_read_fxb2 ../starter/source/constraints/fxbody/hm_read_fxb.F
483!||--- called by ------------------------------------------------------
484!|| lectur ../starter/source/starter/lectur.F
485!||--- calls -----------------------------------------------------
486!|| fxrline ../starter/source/constraints/fxbody/hm_read_fxb.F
487!|| hm_get_string ../starter/source/devtools/hm_reader/hm_get_string.F
488!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
489!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.f
490!||--- uses -----------------------------------------------------
491!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
492!|| message_mod ../starter/share/message_module/message_mod.F
493!|| submodel_mod ../starter/share/modules1/submodel_mod.F
494!||====================================================================
495 SUBROUTINE hm_read_fxb2(FXBIPM, FXBRPM, FXBNOD, FXBGLM,
496 . FXBCPM , FXBCPS, FXBLM , FXBFLS, FXBDLS,
497 . FXBMOD , ITAB , ITABM1, NOM_OPT,FXB_LAST_ADRESS,
498 . LSUBMODEL)
499C-----------------------------------------------
500C M o d u l e s
501C-----------------------------------------------
502 USE message_mod
503 USE inoutfile_mod
504 USE submodel_mod
505 USE hm_option_read_mod
506 USE names_and_titles_mod , ONLY : nchartitle
507C-----------------------------------------------
508C I m p l i c i t T y p e s
509C-----------------------------------------------
510#include "implicit_f.inc"
511C-----------------------------------------------
512C C o m m o n B l o c k s
513C-----------------------------------------------
514#include "com04_c.inc"
515#include "units_c.inc"
516#include "scr17_c.inc"
517#include "fxbcom.inc"
518C-----------------------------------------------
519C D u m m y A r g u m e n t s
520C-----------------------------------------------
521 INTEGER FXBIPM(NBIPM,*), FXBNOD(*),
522 . ITAB(*),ITABM1(*),FXB_LAST_ADRESS(*)
523 my_real
524 . FXBRPM(*), FXBGLM(*), FXBCPM(*), FXBCPS(*),
525 . fxblm(*), fxbfls(*), fxbdls(*), fxbmod(*)
526 INTEGER NOM_OPT(LNOPT1,*)
527 TYPE(submodel_data) LSUBMODEL(*)
528C-----------------------------------------------
529C L o c a l V a r i a b l e s
530C-----------------------------------------------
531 INTEGER NFX,ID,IDMAST,NMOD,NMST,NBNO,NME,NTR,ADRGLM,
532 . ADRCP,ADRLM,ADRFLS,ADRDLS,ADRVAR,ADRRPM,IMOD,INO,I,LEN,
533 . NLIG,NRES,ILIG,ADRCP2,IR,ADRNOD,IDAMP,ISHELL,
534 . ADRMCD,J,INFO,IBLO,IFILE, IANIM, IMIN, IMAX, ADRMOD,IRCM,
535 . ntag,adrm1,adrm2,adrn1,adrn2,cnod(numnod)
536 my_real freq,beta,omega,dtc1,dtc2,vv(6)
537 CHARACTER(LEN=NCHARTITLE) :: TITR
538 CHARACTER :: NWLINE*100,FXBFILE*100
539
540 INTEGER :: LEN_TMP_NAME
541 CHARACTER(len=2148) :: TMP_NAME
542 LOGICAL :: IS_AVAILABLE
543C=====================================================================
544C
545 adrmod = 1
546 ircm = 0
547 adrglm = 1
548 adrcp = 1
549 adrlm = 1
550 adrfls = 1
551 adrdls = 1
552 adrvar = 1
553 adrrpm = 1
554 adrmcd = 1
555 is_available = .false.
556C
557 CALL hm_option_start('/FXBODY')
558C
559 ! Loop over FXBODY
560 DO nfx = 1,nfxbody
561C
562 !For PCH FXBodies modes are automatically computed in INITIA
563 IF (fxbipm(41,nfx) == 2) cycle
564C
565 ! Title and ID
566 titr = ''
567 CALL hm_option_read_key(lsubmodel,
568 . option_id = id,
569 . option_titr = titr)
570C
571 ! Read file name
572 CALL hm_get_string('Filename',fxbfile ,100 ,is_available)
573 tmp_name = infile_name(1:infile_name_len)//fxbfile(1:len_trim(fxbfile))
574 len_tmp_name = infile_name_len + len_trim(fxbfile)
575 OPEN(unit=ificm,file=tmp_name(1:len_tmp_name),
576 . access='SEQUENTIAL',form='FORMATTED',
577 . status='OLD',err=999)
578C
579 CALL fxrline(ificm,nwline,id,titr)
580 READ(nwline,fmt='(7I8)',err=9999)
581 . nmod, nmst, nbno, ishell, idamp, iblo, ifile
582C
583 fxbipm(7,nfx) = adrmod
584 fxbipm(8,nfx) = adrglm
585 fxbipm(9,nfx) = adrcp
586 fxbipm(10,nfx) = adrlm
587 fxbipm(11,nfx) = adrfls
588 fxbipm(12,nfx) = adrdls
589 fxbipm(13,nfx) = adrvar
590 fxbipm(14,nfx) = adrrpm
591 fxbipm(15,nfx) = adrmcd
592 fxbipm(30,nfx) = ircm
593C
594 adrnod = fxbipm(6,nfx)
595 ntag = fxbipm(18,nfx)
596 nme = fxbipm(17,nfx)
597C
598 adrmcd = adrmcd+nme*nme
599C
600 nlig = nbno/10
601 nres = nbno-nlig*10
602 DO ilig = 1,nlig
603 CALL fxrline(ificm,nwline,id,titr)
604 ENDDO
605 IF (nres > 0) THEN
606 CALL fxrline(ificm,nwline,id,titr)
607 ENDIF
608C
609 ntr = 9
610C
611C-------------------------------------
612C Reading of Skew + Freq
613C-------------------------------------
614C
615 CALL fxrline(ificm,nwline,id,titr)
616 READ(nwline,'(5F16.0)',err=9999)
617 . (fxbrpm(adrrpm+i-1),i=2,6)
618 CALL fxrline(ificm,nwline,id,titr)
619 READ(nwline,'(5F16.0)',err=9999)
620 . (fxbrpm(adrrpm+i-1),i=7,10),freq
621 adrrpm=adrrpm+12
622C
623C-------------------------------------
624C Reading of Damping
625C-------------------------------------
626C
627 IF (idamp > 0) THEN
628 CALL fxrline(ificm,nwline,id,titr)
629 READ(nwline,'(2F16.0)',err=9999)
630 . (fxbrpm(adrrpm+i-1),i=1,2)
631 beta=fxbrpm(adrrpm+1)
632 IF (beta > zero) THEN
633 omega = two*pi*freq
634 dtc1 = (-beta*omega+
635 . sqrt(beta*beta*omega*omega+four))/omega
636 dtc2 = two/(beta*omega*omega)
637 fxbrpm(adrrpm-12)=min(dtc1,dtc2)
638 ELSE
639 omega = two*pi*freq
640 fxbrpm(adrrpm-12) = two/omega
641 ENDIF
642 adrrpm = adrrpm+2
643 ELSE
644 fxbrpm(adrrpm) = zero
645 fxbrpm(adrrpm+1) = zero
646 fxbrpm(adrrpm-12) = one/(pi*freq)
647 adrrpm = adrrpm+2
648 ENDIF
649 fxbrpm(adrrpm) = zero
650 fxbrpm(adrrpm+1) = zero
651 adrrpm = adrrpm+2
652C
653C-------------------------------------
654C Reading of modes
655C-------------------------------------
656C
657 IF (ifile == 0) THEN
658C
659C Store modes in memory
660 IF (iblo == 0) THEN
661 DO imod = 1,nme
662 adrm1 = adrmod
663 adrm2 = adrmod+ntag*6
664 DO ino = 1,nbno
665 IF (fxbnod(adrnod+ino-1) < 0) THEN
666 CALL fxrline(ificm,nwline,id,titr)
667 READ(nwline,'(5F16.0)',err=9999)
668 . (fxbmod(adrm1+i-1),i=1,5)
669 CALL fxrline(ificm,nwline,id,titr)
670 READ(nwline,'(F16.0)',err=9999)
671 . fxbmod(adrm1+5)
672 adrm1=adrm1+6
673 ELSEIF (fxbnod(adrnod+ino-1) > 0) THEN
674 CALL fxrline(ificm,nwline,id,titr)
675 READ(nwline,'(5F16.0)',err=9999)
676 . (fxbmod(adrm2+i-1),i=1,5)
677 CALL fxrline(ificm,nwline,id,titr)
678 READ(nwline,'(F16.0)',err=9999)
679 . fxbmod(adrm2+5)
680 adrm2=adrm2+6
681 ENDIF
682 ENDDO
683 adrmod = adrm2
684 ENDDO
685 ELSEIF (iblo == 1) THEN
686 DO imod = 1,nme
687 adrm1 = adrmod
688 adrm2 = adrmod+ntag*6
689 DO ino = 1,nbno
690 IF (fxbnod(adrnod+ino-1) < 0) THEN
691 DO i = 1,6
692 fxbmod(adrm1+i-1) = zero
693 ENDDO
694 adrm1 = adrm1+6
695 ELSEIF (fxbnod(adrnod+ino-1) > 0) THEN
696 DO i = 1,6
697 fxbmod(adrm2+i-1) = zero
698 ENDDO
699 adrm2 = adrm2+6
700 ENDIF
701 ENDDO
702 adrmod = adrm2
703 ENDDO
704 ENDIF
705 DO imod = 1,nmod
706 adrm1 = adrmod
707 adrm2 = adrmod+ntag*6
708 DO ino = 1,nbno
709 IF (fxbnod(adrnod+ino-1) < 0) THEN
710 CALL fxrline(ificm,nwline,id,titr)
711 READ(nwline,'(5F16.0)',err=9999)
712 . (fxbmod(adrm1+i-1),i=1,5)
713 CALL fxrline(ificm,nwline,id,titr)
714 READ(nwline,'(F16.0)',err=9999)
715 . fxbmod(adrm1+5)
716 adrm1 = adrm1+6
717 ELSEIF (fxbnod(adrnod+ino-1) > 0) THEN
718 CALL fxrline(ificm,nwline,id,titr)
719 READ(nwline,'(5F16.0)',err=9999)
720 . (fxbmod(adrm2+i-1),i=1,5)
721 CALL fxrline(ificm,nwline,id,titr)
722 READ(nwline,'(F16.0)',err=9999)
723 . fxbmod(adrm2+5)
724 adrm2 = adrm2+6
725 ENDIF
726 ENDDO
727 adrmod = adrm2
728 ENDDO
729 ELSEIF (ifile == 1) THEN
730C
731C Store modes on interface nodes in memory and modes on other nodes on disk
732C
733 IF (iblo == 0) THEN
734 DO imod = 1,nme
735 adrm1 = adrmod
736 DO ino = 1,nbno
737 IF (fxbnod(adrnod+ino-1) < 0) THEN
738 CALL fxrline(ificm,nwline,id,titr)
739 READ(nwline,'(5F16.0)',err=9999)
740 . (fxbmod(adrm1+i-1),i=1,5)
741 CALL fxrline(ificm,nwline,id,titr)
742 READ(nwline,'(F16.0)',err=9999)
743 . fxbmod(adrm1+5)
744 adrm1 = adrm1+6
745 ELSEIF (fxbnod(adrnod+ino-1) > 0) THEN
746 CALL fxrline(ificm,nwline,id,titr)
747 READ(nwline,'(5F16.0)',err=9999) (vv(i),i=1,5)
748 CALL fxrline(ificm,nwline,id,titr)
749 READ(nwline,'(F16.0)',err=9999) vv(6)
750 ircm = ircm+1
751 WRITE(ifxm,rec=ircm) (vv(i),i=1,6)
752 ENDIF
753 ENDDO
754 adrmod = adrm1
755 ENDDO
756 ELSEIF (iblo == 1) THEN
757 DO imod = 1,nme
758 adrm1 = adrmod
759 DO ino = 1,nbno
760 IF (fxbnod(adrnod+ino-1) < 0) THEN
761 DO i = 1,6
762 fxbmod(adrm1+i-1) = zero
763 ENDDO
764 adrm1 = adrm1+6
765 ELSEIF (fxbnod(adrnod+ino-1) > 0) THEN
766 DO i = 1,6
767 vv(i) = zero
768 ENDDO
769 ircm = ircm+1
770 WRITE(ifxm,rec=ircm) (vv(i),i=1,6)
771 ENDIF
772 ENDDO
773 adrmod = adrm1
774 ENDDO
775 ENDIF
776 DO imod = 1,nmod
777 adrm1 = adrmod
778 DO ino = 1,nbno
779 IF (fxbnod(adrnod+ino-1) < 0) THEN
780 CALL fxrline(ificm,nwline,id,titr)
781 READ(nwline,'(5F16.0)',err=9999)
782 . (fxbmod(adrm1+i-1),i=1,5)
783 CALL fxrline(ificm,nwline,id,titr)
784 READ(nwline,'(F16.0)',err=9999)
785 . fxbmod(adrm1+5)
786 adrm1 = adrm1+6
787 ELSEIF (fxbnod(adrnod+ino-1) > 0) THEN
788 CALL fxrline(ificm,nwline,id,titr)
789 READ(nwline,'(5F16.0)',err=9999) (vv(i),i=1,5)
790 CALL fxrline(ificm,nwline,id,titr)
791 READ(nwline,'(F16.0)',err=9999) vv(6)
792 ircm = ircm+1
793 WRITE(ifxm,rec=ircm) (vv(i),i=1,6)
794 ENDIF
795 ENDDO
796 adrmod = adrm1
797 ENDDO
798 ENDIF
799C
800 fxbipm(32,nfx)=ircm
801C
802C-------------------------------------
803C Reading of Diag Mass Matrix
804C-------------------------------------
805C
806 IF (nmod > 0) THEN
807 len = nmod
808 nlig = len/5
809 nres = len-nlig*5
810 DO ilig = 1,nlig
811 CALL fxrline(ificm,nwline,id,titr)
812 READ(nwline,'(5F16.0)',err=9999)
813 . (fxblm(adrlm+i-1),i=1,5)
814 adrlm = adrlm+5
815 ENDDO
816 IF (nres > 0) THEN
817 CALL fxrline(ificm,nwline,id,titr)
818 READ(nwline,'(5F16.0)',err=9999)
819 . (fxblm(adrlm+i-1),i=1,nres)
820 adrlm = adrlm+nres
821 ENDIF
822 ENDIF
823C
824C-------------------------------------
825C Reading of Stiff full part matrix
826C-------------------------------------
827C
828 IF (nmst > 0) THEN
829 len = nmst*(2*nmod-nmst+1)/2
830 nlig = len/5
831 nres = len-nlig*5
832 DO ilig = 1,nlig
833 CALL fxrline(ificm,nwline,id,titr)
834 READ(nwline,'(5F16.0)',err=9999)
835 . (fxbfls(adrfls+i-1),i=1,5)
836 adrfls = adrfls+5
837 ENDDO
838 IF (nres > 0) THEN
839 CALL fxrline(ificm,nwline,id,titr)
840 READ(nwline,'(5F16.0)',err=9999)
841 . (fxbfls(adrfls+i-1),i=1,nres)
842 adrfls = adrfls+nres
843 ENDIF
844 ENDIF
845C
846C-------------------------------------
847C Reading of Stiff diag part matrix
848C-------------------------------------
849C
850 IF ((nmod-nmst) > 0) THEN
851 len = nmod-nmst
852 nlig = len/5
853 nres = len-nlig*5
854 DO ilig = 1,nlig
855 CALL fxrline(ificm,nwline,id,titr)
856 READ(nwline,'(5F16.0)',err=9999)
857 . (fxbdls(adrdls+i-1),i=1,5)
858 adrdls = adrdls+5
859 ENDDO
860 IF (nres > 0) THEN
861 CALL fxrline(ificm,nwline,id,titr)
862 READ(nwline,'(5F16.0)',err=9999)
863 . (fxbdls(adrdls+i-1),i=1,nres)
864 adrdls = adrdls+nres
865 ENDIF
866 ENDIF
867C
868 IF (iblo == 1) THEN
869 len = nme*(nme+1)/2
870 DO i = 1,len
871 fxbglm(adrglm) = zero
872 adrglm = adrglm+1
873 ENDDO
874 len = nme*nmod
875 DO i = 1,ntr
876 DO j = 1,len
877 fxbcpm(adrcp) = zero
878 fxbcps(adrcp) = zero
879 adrcp = adrcp+1
880 ENDDO
881 ENDDO
882 GOTO 100
883 ENDIF
884C
885C-------------------------------------
886C Reading of Mass Matrix projected on RB modes
887C-------------------------------------
888C
889 len = nme*(nme+1)/2
890 nlig = len/5
891 nres = len-nlig*5
892 DO ilig = 1,nlig
893 CALL fxrline(ificm,nwline,id,titr)
894 READ(nwline,'(5F16.0)',err=9999)
895 . (fxbglm(adrglm+i-1),i=1,5)
896 adrglm = adrglm+5
897 ENDDO
898 IF (nres > 0) THEN
899 CALL fxrline(ificm,nwline,id,titr)
900 READ(nwline,'(5F16.0)',err=9999)
901 . (fxbglm(adrglm+i-1),i=1,nres)
902 adrglm = adrglm+nres
903 ENDIF
904C
905C-------------------------------------
906C Reading of Coupled Mass Matrix
907C-------------------------------------
908C
909 IF (nmod > 0) THEN
910 adrcp2 = adrcp
911 DO ir = 1,ntr
912 len = nme*nmod
913 nlig = len/5
914 nres = len-nlig*5
915 DO ilig = 1,nlig
916 CALL fxrline(ificm,nwline,id,titr)
917 READ(nwline,'(5F16.0)',err=9999)
918 . (fxbcpm(adrcp+i-1),i=1,5)
919 adrcp = adrcp+5
920 ENDDO
921 IF (nres > 0) THEN
922 CALL fxrline(ificm,nwline,id,titr)
923 READ(nwline,'(5F16.0)',err=9999)
924 . (fxbcpm(adrcp+i-1),i=1,nres)
925 adrcp = adrcp+nres
926 ENDIF
927 ENDDO
928C
929C-------------------------------------
930C Reading of Coupled Stiff Matrix
931C-------------------------------------
932C
933 DO ir = 1,ntr
934 len = nme*nmod
935 nlig = len/5
936 nres = len-nlig*5
937 DO ilig = 1,nlig
938 CALL fxrline(ificm,nwline,id,titr)
939 READ(nwline,'(5F16.0)',err=9999)
940 . (fxbcps(adrcp2+i-1),i=1,5)
941 adrcp2 = adrcp2+5
942 ENDDO
943 IF (nres > 0) THEN
944 CALL fxrline(ificm,nwline,id,titr)
945 READ(nwline,'(5F16.0)',err=9999)
946 . (fxbcps(adrcp2+i-1),i=1,nres)
947 adrcp2 = adrcp2+nres
948 ENDIF
949 ENDDO
950 ENDIF
951C
952 100 CLOSE(ificm)
953C
954C Re-arrange nodes table
955 DO i = 1,nbno
956 cnod(i)=fxbnod(adrnod+i-1)
957 ENDDO
958 adrn1 = adrnod-1
959 adrn2 = adrnod-1+ntag
960 DO i = 1,nbno
961 IF (cnod(i) < 0) THEN
962 adrn1 = adrn1+1
963 fxbnod(adrn1) = -cnod(i)
964 ELSEIF (cnod(i) > 0) THEN
965 adrn2 = adrn2+1
966 fxbnod(adrn2)=cnod(i)
967 ENDIF
968 ENDDO
969C
970 adrvar=adrvar+nmod+nme
971C
972 WRITE(iout,1100) id,trim(titr),itab(fxbipm(2,nfx)),nbno,nme,nmod,
973 . nmst,(fxbrpm(fxbipm(14,nfx)+i),i=1,ntr),
974 . fxbrpm(fxbipm(14,nfx))
975 ENDDO
976C
977C -- Last addresses are stored for storage of other fxbodies in initia
978C
979 fxb_last_adress(1) = adrmod
980 fxb_last_adress(2) = adrglm
981 fxb_last_adress(3) = adrcp
982 fxb_last_adress(4) = adrlm
983 fxb_last_adress(5) = adrfls
984 fxb_last_adress(6) = adrdls
985 fxb_last_adress(7) = adrvar
986 fxb_last_adress(8) = adrrpm
987 fxb_last_adress(9) = adrmcd
988C
989 RETURN
990 999 CALL freerr(3)
991 RETURN
9929999 CALL ancmsg(msgid=566,
993 . msgtype=msgerror,
994 . anmode=aninfo,
995 . i1=id,
996 . c1=titr,
997 . c2=fxbfile,
998 . c3=nwline)
999 RETURN
1000C
10011100 FORMAT( /5x,'FLEXIBLE BODY ID ',i10,1x,a
1002 . /10x,'MAIN NODE ID ',i10
1003 . /10x,'NUMBER OF NODES ',i10
1004 . /10x,'NUMBER OF GLOBAL MODES ',i10
1005 . /10x,'NUMBER OF LOCAL MODES ',i10
1006 . /10x,'NUMBER OF LOCAL STATIC MODES ',i10
1007 . /10x,'INITIAL ROTATION MATRIX ',
1008 . /10x,(9(1pe10.3))
1009 . /10x,'STABILITY TIME-STEP ',1pe10.3)
1010C
1011 END SUBROUTINE hm_read_fxb2
1012!||====================================================================
1013!|| fxrline ../starter/source/constraints/fxbody/hm_read_fxb.F
1014!||--- called by ------------------------------------------------------
1015!|| hm_read_fxb1 ../starter/source/constraints/fxbody/hm_read_fxb.F
1016!|| hm_read_fxb2 ../starter/source/constraints/fxbody/hm_read_fxb.F
1017!|| hm_setfxrbyon ../starter/source/constraints/fxbody/hm_setfxrbyon.F
1018!|| read_pch_file ../starter/source/constraints/fxbody/read_pch_file.F
1019!||--- uses -----------------------------------------------------
1020!|| message_mod ../starter/share/message_module/message_mod.F
1021!||====================================================================
1022 SUBROUTINE fxrline(IFIC, NWLINE, ID,TITR)
1023C-----------------------------------------------
1024C M o d u l e s
1025C-----------------------------------------------
1026 USE message_mod
1027 USE names_and_titles_mod , ONLY : nchartitle
1028C-----------------------------------------------
1029C I m p l i c i t T y p e s
1030C-----------------------------------------------
1031#include "implicit_f.inc"
1032C-----------------------------------------------
1033C D u m m y A r g u m e n t s
1034C-----------------------------------------------
1035 INTEGER IFIC, ID
1036 CHARACTER NWLINE*100
1037 CHARACTER(LEN=NCHARTITLE) :: TITR
1038C-----------------------------------------------
1039C L o c a l V a r i a b l e s
1040C-----------------------------------------------
1041 INTEGER ISTOP
1042C
1043 ISTOP=0
1044 do WHILE (istop==0)
1045 READ(ific,'(A)',END=999) nwline
1046 IF ((nwline(1:1)/='#').AND.((nwline(1:1)/='$')).AND.((len_trim(nwline)/=0))) istop=1
1047 ENDDO
1048C
1049 RETURN
1050 999 CALL ancmsg(msgid=569,
1051 . msgtype=msgerror,
1052 . anmode=aninfo,
1053 . i1=id,
1054 . c1=titr)
1055 RETURN
1056C
1057 END SUBROUTINE fxrline
my_real
#define my_real
Definition cppsort.cpp:32
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:523
hm_get_string
subroutine hm_get_string(name, sval, size, is_available)
Definition hm_get_string.F:76
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:251
hm_read_fxb1
subroutine hm_read_fxb1(nom_opt, fxbnod, fxbipm, fxb_matrix, fxb_matrix_add, nmanim, itab, itabm1, fxbfile_tab, lsubmodel)
Definition hm_read_fxb.F:47
fxrline
subroutine fxrline(ific, nwline, id, titr)
Definition hm_read_fxb.F:1023
hm_read_fxb2
subroutine hm_read_fxb2(fxbipm, fxbrpm, fxbnod, fxbglm, fxbcpm, fxbcps, fxblm, fxbfls, fxbdls, fxbmod, itab, itabm1, nom_opt, fxb_last_adress, lsubmodel)
Definition hm_read_fxb.F:499
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:410
min
#define min(a, b)
Definition macros.h:20
max
#define max(a, b)
Definition macros.h:21
id
initmumps id
Definition multiplerhs_example.m:4
my_orders
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
hm_option_read_mod
Definition hm_option_read_mod.F:408
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
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
submodel_mod
Definition submodel_mod.F:712
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:720
read_pch_file
subroutine read_pch_file(flag, matrix, itag, matrix_add, cpt_stiff, cpt_mass, itabm1, pch_file, id, titr)
Definition read_pch_file.F:37
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
freerr
subroutine freerr(it)
Definition freform.F:506
fretitl
subroutine fretitl(titr, iasc, l)
Definition freform.F:620
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:804
newdbl
subroutine newdbl(list, ilist, nlist, tab, errid, status, nom_opt)
Definition sysfus.F:758
usr2sys
integer function usr2sys(iu, itabm1, mess, id)
Definition sysfus.F:160
udouble
subroutine udouble(list, ilist, nlist, mess, ir, rlist)
Definition sysfus.F:589
starter
program starter
Definition starter.F:39
submodel_mod::submodel_data
Definition submodel_mod.F:723