OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_rbody.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_rbody ../starter/source/constraints/general/rbody/hm_read_rbody.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| anodset ../starter/source/output/analyse/analyse_node.c
30!|| fretitl ../starter/source/starter/freform.F
31!|| fretitl2 ../starter/source/starter/freform.F
32!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
33!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.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!|| hm_sz_r2r ../starter/source/coupling/rad2rad/routines_r2r.f
37!|| newdbl ../starter/source/system/sysfus.F
38!|| ngr2usr ../starter/source/system/nintrr.F
39!|| nodgrnr6 ../starter/source/starter/freform.f
40!|| rigmodif_nd ../starter/source/elements/solid/solide10/dim_s10edg.F
41!|| spmdset ../starter/source/constraints/general/rbody/spmdset.F
42!|| udouble ../starter/source/system/sysfus.F
43!|| usr2sys ../starter/source/system/sysfus.F
44!||--- uses -----------------------------------------------------
45!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
46!|| message_mod ../starter/share/message_module/message_mod.F
47!|| r2r_mod ../starter/share/modules1/r2r_mod.F
48!|| submodel_mod ../starter/share/modules1/submodel_mod.F
49!||====================================================================
50 SUBROUTINE hm_read_rbody(RBY ,NPBY ,LPBY ,ITAB ,ITABM1 ,
51 2 IGRNOD ,IGRSURF ,IBFV ,IGRV ,IBGR ,
52 3 SENSORS ,IMERGE ,UNITAB ,ISKN ,NOM_OPT ,
53 4 NUMSL ,KNOD2ELS,KNOD2ELC,KNOD2ELTG,KNOD2EL1D,
54 5 KNOD2ELQ ,ITAGND ,ICDNS10 ,LSUBMODEL,ICFIELD ,
55 6 LCFIELD )
56C-------------------------------------
57C READING STRUCTURE RIGIDES
58C-----------------------------------------------
59C M o d u l e s
60C-----------------------------------------------
61 USE my_alloc_mod
62 USE unitab_mod
63 USE r2r_mod
64 USE message_mod
65 USE groupdef_mod
66 USE submodel_mod
67 USE hm_option_read_mod
68 USE sensor_mod
69 USE names_and_titles_mod , ONLY : nchartitle, ncharkey
70C-----------------------------------------------
71C I m p l i c i t T y p e s
72C-----------------------------------------------
73#include "implicit_f.inc"
74C-----------------------------------------------
75C A n a l y s e M o d u l e
76C-----------------------------------------------
77#include "analyse_name.inc"
78C-----------------------------------------------
79C C o m m o n B l o c k s
80C-----------------------------------------------
81#include "com04_c.inc"
82#include "units_c.inc"
83#include "scr17_c.inc"
84#include "scr03_c.inc"
85#include "param_c.inc"
86#include "r2r_c.inc"
87#include "sphcom.inc"
88#include "sms_c.inc"
89C-----------------------------------------------
90C D u m m y A r g u m e n t s
91C-----------------------------------------------
92 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
93 INTEGER NPBY(NNPBY,*), LPBY(*), ITAB(*), ITABM1(*)
94 INTEGER IBFV(NIFV,*)
95 INTEGER IGRV(NIGRV,*),IBGR(*),IMERGE(*),
96 . ISKN(LISKN,*),NUMSL,
97 . knod2els(*),knod2elc(*),knod2eltg(*),knod2el1d(*),knod2elq(*),
98 . itagnd(*),icdns10(*), icfield(sizfield,*), lcfield(*)
99 my_real rby(nrby,*)
100 INTEGER NOM_OPT(LNOPT1,*)
101C-----------------------------------------------
102 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
103 TYPE (SURF_) ,TARGET, DIMENSION(NSURF) :: IGRSURF
104 TYPE (SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(*)
105 TYPE (SENSORS_) ,INTENT(IN) :: SENSORS
106C-----------------------------------------------
107C L o c a l V a r i a b l e s
108C-----------------------------------------------
109 INTEGER I, J, K, N, NSL, NSL0, NSKEW, IC,
110 . ispher, igu,igs,isens,id,icdg,
111 . jc,uid,iflagunit,sub_index,nrb,
112 . ifail,nrb_r2r
113 INTEGER IDSURF, ISU, NN, IAD, M, IOPT, IEXPAMS, NEL
114 CHARACTER MESS*40
115 CHARACTER(LEN=NCHARTITLE)::TITR,TITR1
116 CHARACTER(LEN=NCHARKEY)::KEY
117 my_real BID, MASS, I1, I2, I3, I12, I23, I13, FN, FT, EXPN, EXPT
118 INTEGER, DIMENSION(:), ALLOCATABLE :: ITAG
119 INTEGER, DIMENSION(:,:), ALLOCATABLE :: TABSL
120 INTEGER, DIMENSION(:), POINTER :: INGR2USR
121 LOGICAL IS_AVAILABLE
122C-----------------------------------------------
123C E x t e r n a l F u n c t i o n s
124C-----------------------------------------------
125 INTEGER USR2SYS,NGR2USR,NODGRNR6
126C-----------------------------------------------
127C NPBY(NNPBY,NRBYKIN), NNPBY=17
128C 1 : main NODE
129C 2 : NUMBER OF SECONDARY NODES
130C 3 : ICOG
131C 4 : ISENS
132C 5 : FLAG SPHERICAL INERTIA
133C 6 : IDENTIFIER
134C 7 : 1 ON(1) OFF(0)
135C 8 : ISU
136C 9 : NSKEW
137C 10 : IEXPAMS (AMS - Hidden)
138C = 1 (default) : AMS expansion ; = 2 (Hidden) : No expansion
139C 11 : IAD => SECONDARY nodes LPBY(IAD+1:IAD+NSN)
140C 12 : RIGID BODY LEVEL (IN MERGE RELATIONS)
141C 13 : MERGING FLAG FOR THE main RIGID BODY
142C 14 : NUMBER OF SECONDARY NODES WITH MERGING FLAG = 1
143C 15 : NUMBER OF SECONDARY NODES WITH MERGING FLAG = 2
144C 16 : NUMBER OF SECONDARY NODES WITH MERGING FLAG = 3
145C 17 : IKREM
146C 18 : IFAIL
147C 19 : INITIAL NUMBER OF SECONDARY NODES (NSN_G)
148C-----------------------------------------------
149C RBY(NRBY,NRBYKIN), NRBY=25
150C LOADED DURING READING AFTER INITIALIZATION (including in RD ENGINE)
151C 1 : Added Mass 1..9 : Principal directions
152C 2..4: IXX, IYY, IZZ 10..12: Principal inertia I1, I2, I3
153C 5..7: IXY, IYZ, IXZ 13: Initial inertia of Main Node (cf deactivation of rbody)
154C 14: Rigid body mass
155C 15: Initial mass of main node (cf deactivation of rbody)
156C 17..25: Inertia matrix in global system
157C 26: FN : Normal force at failure (Ifail=1)
158C 27: FT : Shear force at failure (Ifail=1)
159C 28: EXPN (Ifail=1)
160C 29: EXPT (Ifail=1)
161C 30: CRIT (computed at each cycle in RD Engine)
162C=======================================================================
163 DATA mess/'RIGID BODY DEFINITION '/
164C=======================================================================
165 IF (numsl > 0) THEN
166 CALL my_alloc(tabsl,2,numsl)
167 tabsl=0
168 END IF
169
170 WRITE(iout,1000)
171C--------------------------------------------------
172C START BROWSING MODEL RBODY
173C--------------------------------------------------
174 is_available = .false.
175 CALL hm_option_start('/RBODY')
176C
177 CALL my_alloc(itag,numnod)
178 itag(1:numnod) = 0
179C
180 k=0
181 nrb=0
182 nrb_r2r=0
183C
184 DO n=1,nrbody
185C
186C--------------------------------------------------
187C EXTRACT DATAS OF /RBODY/... LINE
188C--------------------------------------------------
189C
190 nrb_r2r = nrb_r2r + 1
191 IF (nsubdom > 0) THEN
192 IF(tagrby(nrb_r2r) == 0) CALL hm_sz_r2r(tagrby,nrb_r2r,lsubmodel)
193 ENDIF
194C
195 key=''
196 CALL hm_option_read_key(lsubmodel,
197 . option_id = id,
198 . unit_id = uid,
199 . option_titr = titr,
200 . keyword2 = key,
201 . submodel_index = sub_index)
202 IF(key=='')THEN ! not a /RBODY/LAGMUL
203 nrb = nrb + 1
204C-------
205 iflagunit = 0
206 DO j=1,unitab%NUNITS
207 IF (unitab%UNIT_ID(j) == uid) THEN
208 iflagunit = 1
209 EXIT
210 ENDIF
211 ENDDO
212 IF (uid/=0.AND.iflagunit == 0) THEN
213 CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,
214 . i2=uid,i1=id,c1='RIGID BODY',
215 . c2='RIGID BODY',
216 . c3=titr)
217 ENDIF
218C
219 nom_opt(1,nrb)=id
220 CALL fretitl(titr,nom_opt(lnopt1-ltitr+1,nrb),ltitr)
221C
222 CALL hm_get_intv('node_ID',npby(1,nrb),is_available,lsubmodel)
223 CALL hm_get_intv('sens_ID',isens,is_available,lsubmodel)
224 CALL hm_get_intv('Skew_ID',nskew,is_available,lsubmodel)
225 CALL hm_get_intv('Ispher',ispher,is_available,lsubmodel)
226 CALL hm_get_intv('grnd_ID',igu,is_available,lsubmodel)
227 CALL hm_get_intv('Ikrem',ikrem,is_available,lsubmodel)
228 CALL hm_get_intv('ICoG',icdg,is_available,lsubmodel)
229 CALL hm_get_intv('surf_ID',idsurf,is_available,lsubmodel)
230 CALL hm_get_floatv('Mass',mass,is_available,lsubmodel,unitab)
231C
232 IF(ispher == 0) ispher=2
233 IF(icdg == 0)icdg=1
234c
235 IF(nskew == 0 .AND. sub_index /= 0 ) nskew = lsubmodel(sub_index)%SKEW
236 DO j=0,numskw+min(1,nspcond)*numsph+nsubmod
237 IF(nskew == iskn(4,j+1)) THEN
238 nskew=j+1
239 GO TO 100
240 ENDIF
241 ENDDO
242 CALL ancmsg(msgid=137,anmode=aninfo,msgtype=msgerror,
243 . c1='RIGID BODY',
244 . c2='RIGID BODY',
245 . i2=nskew,i1=id,c3=titr)
246 100 CONTINUE
247C
248 rby(1,nrb) = mass
249C
250 isu=0
251 IF (idsurf/=0) THEN
252 ingr2usr => igrsurf(1:nsurf)%ID
253 isu=ngr2usr(idsurf,ingr2usr,nsurf)
254 IF (isu == 0) THEN
255 CALL ancmsg(msgid=158,anmode=aninfo,msgtype=msgerror,
256 . i2=idsurf,i1=id,c1=titr)
257 ELSEIF (igrsurf(isu)%TYPE/=101) THEN
258 titr1 = igrsurf(igs)%TITLE
259 CALL ancmsg(msgid=159,anmode=aninfo,msgtype=msgerror,
260 . i2=idsurf,c2=titr1,i1=id,c1=titr)
261 ENDIF
262 ENDIF
263 npby(8,nrb)=isu
264C
265 CALL hm_get_floatv('Jxx',i1,is_available,lsubmodel,unitab)
266 CALL hm_get_floatv('Jyy',i2,is_available,lsubmodel,unitab)
267 CALL hm_get_floatv('Jzz',i3,is_available,lsubmodel,unitab)
268 rby(2,nrb) = i1
269 rby(3,nrb) = i2
270 rby(4,nrb) = i3
271 CALL hm_get_floatv('Jxy',i12,is_available,lsubmodel,unitab)
272 CALL hm_get_floatv('Jyz',i23,is_available,lsubmodel,unitab)
273 CALL hm_get_floatv('Jxz',i13,is_available,lsubmodel,unitab)
274C
275 CALL hm_get_intv('Ioptoff',iopt,is_available,lsubmodel)
276 CALL hm_get_intv('Iexpams',iexpams,is_available,lsubmodel)
277C
278 CALL hm_get_intv('Ifail',ifail,is_available,lsubmodel)
279 npby(18,nrb)=ifail
280 IF(ifail==1)THEN
281 CALL hm_get_floatv('FN',fn,is_available,lsubmodel,unitab)
282 CALL hm_get_floatv('FT',ft,is_available,lsubmodel,unitab)
283 CALL hm_get_floatv('expN',expn,is_available,lsubmodel,unitab)
284 CALL hm_get_floatv('expT',expt,is_available,lsubmodel,unitab)
285 IF(fn==zero)fn=ep20
286 IF(ft==zero)ft=ep20
287 IF(expn==zero) expn=two
288 IF(expt==zero) expt=two
289 rby(26,nrb)=fn
290 rby(27,nrb)=ft
291 rby(28,nrb)=expn
292 rby(29,nrb)=expt
293 END IF
294C
295 rby(5,nrb) = i12
296 rby(6,nrb) = i23
297 rby(7,nrb) = i13
298 npby(1,nrb)= usr2sys(npby(1,nrb),itabm1,mess,id)
299!
300 DO jc=1,nmerged
301 IF (npby(1,nrb) == imerge(jc)) npby(1,nrb)=imerge(numcnod+jc)
302 ENDDO
303 CALL anodset(npby(1,nrb), check_rb_m)
304C
305 npby(11,nrb)=k
306 m = npby(1,nrb)
307 nsl = nodgrnr6(m,igu,igs,lpby(k+1),igrnod,itabm1,mess,id)
308c
309 DO i=1,nsl
310 itag(lpby(k+i)) = 1
311 ENDDO
312c
313 IF (ns10e > 0 ) THEN
314 CALL rigmodif_nd(nsl,lpby(k+1),itagnd,icdns10,id,titr,itab)
315 m = npby(1,nrb)
316 IF (itagnd(m)/=0) THEN
317 CALL ancmsg(msgid=1211,
318 . msgtype=msgerror,
319 . anmode=aninfo,
320 . i1=itab(m),
321 . c1='RBODY',
322 . i2=id,
323 . c2='RBODY')
324 END IF
325 END IF
326 npby(2,nrb)=nsl
327 npby(19,nrb)=nsl
328 DO j=1, nsl
329 CALL anodset(lpby(j+k), check_rb_s)
330 tabsl(1,j+k)=itab(lpby(j+k))
331 tabsl(2,j+k)=n
332 ENDDO
333C
334 IF(isens > 0)THEN
335 DO i=1,sensors%NSENSOR
336 IF (isens == sensors%SENSOR_TAB(i)%SENS_ID) npby(4,nrb)=i
337 ENDDO
338 IF(npby(4,nrb) == 0)THEN
339 titr1 = igrsurf(igs)%TITLE
340 CALL ancmsg(msgid=159,anmode=aninfo,msgtype=msgerror,
341 . i2=isens,c2=titr1,i1=id,c1=titr)
342 ENDIF
343 rby(1,nrb)=zero
344 rby(2,nrb)=zero
345 rby(3,nrb)=zero
346 rby(4,nrb)=zero
347 rby(5,nrb)=zero
348 rby(6,nrb)=zero
349 rby(7,nrb)=zero
350 nskew=0
351 icdg =0
352 ikrem=1
353 ENDIF
354 npby(5,nrb)=ispher
355 npby(6,nrb)=id
356 npby(17,nrb)=ikrem
357 IF(isens == 0)THEN
358 npby(7,nrb)=1
359 ELSE
360 npby(7,nrb)=0
361 ENDIF
362 npby(3,nrb) =icdg
363 npby(9,nrb) =nskew
364 IF(iexpams==0)THEN
365 iexpams=1
366 ELSEIF(iexpams==2)THEN
367 iexpams=0
368 END IF
369 npby(10,nrb)=iexpams
370 nsl0 = nsl
371 IF (nsubdom > 0) nsl0 = igrnod(igs)%R2R_ALL
372 IF (nsl0 == 0) THEN
373 CALL ancmsg(msgid=352,
374 . msgtype=msgwarning,
375 . anmode=aninfo_blind_2,
376 . i1=id,
377 . c1=titr)
378 ENDIF
379C
380 CALL spmdset(nrb,npby,nnpby,lpby,nsl,k)
381C
382 IF(isms==0)THEN
383 IF (isens/=0) THEN
384 WRITE(iout,1100) id,trim(titr),isens,itab(npby(1,nrb)),nsl,
385 . idsurf,ispher
386 ELSE
387 WRITE(iout,1111) id,trim(titr),itab(npby(1,nrb)),nsl,
388 . idsurf,iskn(4,nskew),ispher,ikrem,icdg,
389 . (rby(j,nrb),j=1,7)
390 ENDIF
391 ELSE
392 IF (isens/=0) THEN
393 WRITE(iout,1102) id,trim(titr),isens,itab(npby(1,nrb)),nsl,
394 . idsurf,ispher
395 ELSE
396 WRITE(iout,1112) id,trim(titr),itab(npby(1,nrb)),nsl,
397 . idsurf,iskn(4,nskew),ispher,ikrem,icdg,
398 . (rby(j,nrb),j=1,7)
399 ENDIF
400 WRITE(iout,1103)
401 END IF
402 IF(ifail==1)THEN
403 WRITE(iout,1151)
404 WRITE(iout,1152) fn, expn, ft, expt
405 END IF
406 WRITE(iout,1201)
407 WRITE(iout,1202) (itab(lpby(i+k)),i=1,nsl)
408 k=k+nsl
409C-------------------------------
410C VELOCITY FIXE SUR main EN ROT
411C-------------------------------
412 DO j=1,nfxvel
413 IF(iabs(ibfv(1,j)) == npby(1,nrb).AND.
414 . ibfv(2,j)-10*(ibfv(2,j)/10)>=4)THEN
415 ibfv(6,j)=n
416 ENDIF
417 ENDDO
418C-------------------------------
419C main BELONGS TO MESH
420C-------------------------------
421 nel=knod2els(npby(1,nrb)+1) -knod2els(npby(1,nrb))
422 . +knod2elc(npby(1,nrb)+1) -knod2elc(npby(1,nrb))
423 . +knod2eltg(npby(1,nrb)+1)-knod2eltg(npby(1,nrb))
424 . +knod2el1d(npby(1,nrb)+1)-knod2el1d(npby(1,nrb))
425 . +knod2elq(npby(1,nrb)+1)-knod2elq(npby(1,nrb))
426 IF(nel/=0)THEN
427 IF(isms==0)THEN
428 id=nom_opt(1,nrb)
429 CALL fretitl2(titr,nom_opt(lnopt1-ltitr+1,nrb),ltitr)
430 CALL ancmsg(msgid=448,
431 . msgtype=msgwarning,
432 . anmode=aninfo_blind_2,
433 . i1=itab(npby(1,nrb)),
434 . i2=id,
435 . c1=titr)
436 ELSE
437 id=nom_opt(1,nrb)
438 CALL fretitl2(titr,nom_opt(lnopt1-ltitr+1,nrb),ltitr)
439 CALL ancmsg(msgid=1066,
440 . msgtype=msgerror,
441 . anmode=aninfo_blind_1,
442 . i1=itab(npby(1,nrb)),
443 . i2=id,
444 . c1=titr)
445 END IF
446 END IF
447 END IF ! IF(KEY=='')THEN
448 ENDDO
449C-------------------------------------
450C Recherche des Rigid Body ID doubles
451C-------------------------------------
452 CALL udouble(npby(6,1),nnpby,nrbykin,mess,0,bid)
453C-------------------------------------
454C Recherche des Main Node ID doubles
455C-------------------------------------
456 ic = 442
457 i = 0
458 CALL newdbl(npby(1,1),nnpby,nrbykin,itab,442,aninfo_blind_1,
459 . nom_opt)
460C------------------------------------
461C Tagging of the secondary nodes of RBY with gravity or load/centroid
462C For calculating the work of external forces
463C-------------------------------------
464 DO i=1,numnod
465 itag(i)=0
466 ENDDO
467 k=0
468 DO n=1,nrbykin
469 nsl=npby(2,n)
470 IF(npby(7,n)/=0)THEN
471 DO i=1,nsl
472 itag(lpby(i+k))=1
473 ENDDO
474 ENDIF
475 k=k+nsl
476 ENDDO
477C
478 DO k=1,ngrav
479 nn =igrv(1,k)
480 iad=igrv(4,k)
481 DO i=1,nn
482 n=ibgr(i+iad-1)
483 IF(itag(n) == 1)ibgr(i+iad-1) = -n
484 ENDDO
485 ENDDO
486C
487 DO k=1,nloadc
488 nn = icfield(1,k)
489 iad = icfield(4,k)
490 DO i=1,nn
491 n=lcfield(iad+i-1)
492 IF(itag(n) == 1)lcfield(iad+i-1) = -n
493 END DO
494 ENDDO
495C------------------------------------
496 IF(ALLOCATED(itag)) DEALLOCATE(itag)
497 IF(ALLOCATED(tabsl))DEALLOCATE(tabsl)
498C------------------------------------
499 RETURN
500C
5011000 FORMAT(/
502 . ' RIGID BODY DEFINITIONS '/
503 . ' ---------------------- '/)
5041100 FORMAT( /5x,'RIGID BODY ID ',i10,1x,a
505 . /10x,'SENSOR ',i10
506 . /10x,'PRIMARY NODE ',i10
507 . /10x,'NUMBER OF NODES ',i10
508 . /10x,'SURFACE LINKED TO BODY ',i10
509 . /10x,'SPHERICAL INERTIA FLAG ',i10)
5101102 FORMAT( /5x,'RIGID BODY ID ',i10,1x,a
511 . /10x,'SENSOR ',i10
512 . /10x,'PRIMARY NODE ',i10
513 . /10x,'NUMBER OF NODES ',i10
514 . /10x,'SURFACE LINKED TO BODY ',i10
515 . /10x,'SPHERICAL INERTIA FLAG ',i10)
5161103 FORMAT( /10x,'NO AMS EXPANSION OVERALL THE RBODY ')
5171111 FORMAT( /5x,'RIGID BODY ID ',i10,1x,a
518 . /10x,'PRIMARY NODE ',i10
519 . /10x,'NUMBER OF NODES ',i10
520 . /10x,'SURFACE LINKED TO BODY ',i10
521 . /10x,'SKEW NUMBER ',i10
522 . /10x,'SPHERICAL INERTIA FLAG ',i10
523 . /10x,'REMOVE SECONDARY NODES FROM RIGID WALL(IF=0)',i10
524 . /10x,'CENTER OF MASS FLAG ',i10
525 . /10x,'ADDED MASS ',1pg20.4
526 . /10x,'ADDED INERTIA ',1p6g20.4)
5271112 FORMAT( /5x,'RIGID BODY ID ',i10,1x,a
528 . /10x,'PRIMARY NODE ',i10
529 . /10x,'NUMBER OF NODES ',i10
530 . /10x,'SURFACE LINKED TO BODY ',i10
531 . /10x,'SKEW NUMBER ',i10
532 . /10x,'SPHERICAL INERTIA FLAG ',i10
533 . /10x,'REMOVE SECONDARY NODES FROM RIGID WALL(IF=0)',i10
534 . /10x,'CENTER OF MASS FLAG ',i10
535 . /10x,'ADDED MASS ',1pg20.4
536 . /10x,'ADDED INERTIA ',1p6g20.4)
5371151 FORMAT(/10x,'FAILURE CRITERIA : ')
5381152 FORMAT(/10x,'NORMAL FORCE AT FAILURE. . . . . . . . . . . . .',1pg20.4
539 . /10x,'FAILURE EXPONENT PARAMETER IN NORMAL DIRECTION ',1pg20.4
540 . /10x,'SHEAR FORCE AT FAILURE . . . . . . . . . . . . .',1pg20.4
541 . /10x,'FAILURE EXPONENT PARAMETER IN SHEAR DIRECTION ',1pg20.4)
5421201 FORMAT(/10x,'SECONDARY NODES ')
5431202 FORMAT( 10x,10i10)
544 END SUBROUTINE hm_read_rbody
545C
546!||====================================================================
547!|| setrbyon ../starter/source/constraints/general/rbody/hm_read_rbody.F
548!||--- called by ------------------------------------------------------
549!|| lectur ../starter/source/starter/lectur.F
550!||--- calls -----------------------------------------------------
551!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
552!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
553!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
554!|| hm_sz_r2r ../starter/source/coupling/rad2rad/routines_r2r.F
555!||--- uses -----------------------------------------------------
556!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
557!|| message_mod ../starter/share/message_module/message_mod.F
558!|| r2r_mod ../starter/share/modules1/r2r_mod.F
559!|| submodel_mod ../starter/share/modules1/submodel_mod.F
560!||====================================================================
561 SUBROUTINE setrbyon(IXS ,IXC ,IXTG ,IGRNOD ,IGRNRBY ,
562 2 ISOLOFF ,ISHEOFF ,ITRIOFF,KNOD2ELS,KNOD2ELC,
563 3 KNOD2ELTG,NOD2ELS ,NOD2ELC,NOD2ELTG,IXQ ,
564 4 IQUAOFF ,KNOD2ELQ,NOD2ELQ,LSUBMODEL)
565C-------------------------------------
566C PRE-READ RIGID STRUCTURE FOR OPTIMIZATION
567C-----------------------------------------------
568C M o d u l e s
569C-----------------------------------------------
570 USE my_alloc_mod
571 USE message_mod
572 USE r2r_mod
573 USE groupdef_mod
574 USE submodel_mod
575 USE hm_option_read_mod
576 USE names_and_titles_mod , ONLY : nchartitle
577 use element_mod , only : nixs,nixc,nixtg,nixq
578C-----------------------------------------------
579C I m p l i c i t T y p e s
580C-----------------------------------------------
581#include "implicit_f.inc"
582C-----------------------------------------------
583C C o m m o n B l o c k s
584C-----------------------------------------------
585#include "com01_c.inc"
586#include "com04_c.inc"
587#include "r2r_c.inc"
588C-----------------------------------------------
589C D u m m y A r g u m e n t s
590C-----------------------------------------------
591 INTEGER IGRNRBY(*),ISOLOFF(*),ISHEOFF(*),ITRIOFF(*),
592 . IXS(NIXS,*), IXC(NIXC,*), IXTG(NIXTG,*),
593 . KNOD2ELC(*), KNOD2ELTG(*), NOD2ELC(*), NOD2ELTG(*),
594 . KNOD2ELS(*), NOD2ELS(*),KNOD2ELQ(*),IQUAOFF(*),
595 . NOD2ELQ(*) ,IXQ(NIXQ,*)
596C-----------------------------------------------
597 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
598 TYPE(SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(*)
599C-----------------------------------------------
600C L o c a l V a r i a b l e s
601C-----------------------------------------------
602 INTEGER I, ISENS, IG, NSN, II, NALL, IGU, N, ID, IRBYON, IOPT, NN, JJ, NRB
603 INTEGER, DIMENSION(:), ALLOCATABLE :: ITAG
604 CHARACTER(LEN=NCHARTITLE) :: TITR
605 LOGICAL IS_AVAILABLE
606C-----------------------------------
607C
608 DO i = 1, numels
609 isoloff(i) = 0
610 END DO
611 DO i = 1, numelc
612 isheoff(i) = 0
613 END DO
614 DO i = 1, numeltg
615 itrioff(i) = 0
616 END DO
617 DO i = 1, numelq
618 iquaoff(i) = 0
619 END DO
620C
621C init a 0 de itag
622 CALL my_alloc(itag,numnod)
623 DO i=1,numnod
624 itag(i)=0
625 ENDDO
626C--------------------------------------------------
627C START BROWSING MODEL RBODY
628C--------------------------------------------------
629 is_available = .false.
630 CALL hm_option_start('/RBODY')
631C
632 nrb=0
633C
634 DO n=1,nrbykin
635 nrb = nrb + 1
636 IF (nsubdom > 0)THEN ! TAGRBY is allocated only if NSUBDOM>0
637 IF(tagrby(nrb) == 0) CALL hm_sz_r2r(tagrby,nrb,lsubmodel)
638 ENDIF
639C-----------------------------------------------------------------
640 igrnrby(n)=0
641C--------------------------------------------------
642C EXTRACT DATAS OF /RBODY/... LINE
643C--------------------------------------------------
644 CALL hm_option_read_key(lsubmodel,
645 . option_id = id,
646 . option_titr = titr)
647C
648 CALL hm_get_intv('sens_ID',isens,is_available,lsubmodel)
649 CALL hm_get_intv('grnd_ID',igu,is_available,lsubmodel)
650 CALL hm_get_intv('Ioptoff',iopt,is_available,lsubmodel)
651C
652 IF (iopt == 1) THEN
653 irbyon=2
654 ELSE
655C By default, RBODY is deactivated
656 irbyon=1
657 END IF
658C if sensor rbody active
659 IF(isens/=0) irbyon=0
660C if Imls used rbody temporarily active
661 IF(ndsolv == 1) irbyon=0
662 IF(irbyon>=1)THEN
663C
664 IF(igu/=0)THEN
665 ig = 0
666 DO i=1,ngrnod
667 IF(igrnod(i)%ID == igu)THEN
668 ig=i
669 GOTO 100
670 END IF
671 END DO
672 100 CONTINUE
673C
674 IF(ig/=0) THEN
675 igrnrby(n)=ig
676 nsn = igrnod(ig)%NENTITY
677 DO i=1,nsn
678 itag(igrnod(ig)%ENTITY(i)) = 1
679 END DO
680C
681cc DO II = 1, NUMELS
682 DO i=1,nsn
683 nn = igrnod(ig)%ENTITY(i)
684 DO jj = knod2els(nn)+1,knod2els(nn+1)
685 ii = nod2els(jj)
686 nall = itag(ixs(2,ii)) * itag(ixs(3,ii)) *
687 + itag(ixs(4,ii)) * itag(ixs(5,ii)) *
688 + itag(ixs(6,ii)) * itag(ixs(7,ii)) *
689 + itag(ixs(8,ii)) * itag(ixs(9,ii))
690 IF(nall/=0)THEN
691 isoloff(ii) = irbyon
692 END IF
693 END DO
694C
695cc DO II = 1, NUMELC
696 DO jj = knod2elc(nn)+1,knod2elc(nn+1)
697 ii = nod2elc(jj)
698 nall = itag(ixc(2,ii)) * itag(ixc(3,ii)) *
699 + itag(ixc(4,ii)) * itag(ixc(5,ii))
700 IF(nall/=0)THEN
701 isheoff(ii) = irbyon
702 END IF
703 END DO
704C
705cc DO II = 1, NUMELTG
706 DO jj = knod2eltg(nn)+1,knod2eltg(nn+1)
707 ii = nod2eltg(jj)
708 nall = itag(ixtg(2,ii)) * itag(ixtg(3,ii)) *
709 + itag(ixtg(4,ii))
710 IF(nall/=0)THEN
711 itrioff(ii) = irbyon
712 END IF
713 END DO
714C
715 DO jj = knod2elq(nn)+1,knod2elq(nn+1)
716 ii = nod2elq(jj)
717 nall = itag(ixq(2,ii)) * itag(ixq(3,ii)) *
718 + itag(ixq(4,ii)) * itag(ixq(5,ii))
719 IF(nall/=0)THEN
720 iquaoff(ii) = irbyon
721 END IF
722 END DO
723C
724 END DO
725C Reinitialize to 0 on the concerned part
726 DO i=1,nsn
727 itag(igrnod(ig)%ENTITY(i))=0
728 END DO
729 END IF
730 END IF
731 END IF
732C
733 END DO
734C
735 IF(ALLOCATED(itag)) DEALLOCATE(itag)
736C
737 RETURN
738 END SUBROUTINE setrbyon
739C
740!||====================================================================
741!|| seteloff ../starter/source/constraints/general/rbody/hm_read_rbody.F
742!||--- called by ------------------------------------------------------
743!|| lectur ../starter/source/starter/lectur.F
744!||--- calls -----------------------------------------------------
745!||--- uses -----------------------------------------------------
746!|| message_mod ../starter/share/message_module/message_mod.F
747!||====================================================================
748 SUBROUTINE seteloff(IXS ,IXC ,IXT ,IXP ,IXR ,
749 2 IXTG ,IPARG , ISOLOFF,ISHEOFF,
750 3 ITRUOFF,IPOUOFF,IRESOFF,ITRIOFF,IGRNRBY,
751 4 IGRNOD ,ELBUF_STR,IQUAOFF,IXQ )
752C-----------------------------------------------
753C M o d u l e s
754C-----------------------------------------------
755 USE my_alloc_mod
756 USE message_mod
757 USE elbufdef_mod
758 USE groupdef_mod
759 use element_mod , only : nixs,nixc,nixtg,nixq,nixt,nixp,nixr
760C-------------------------------------
761C PRE-READ RIGID STRUCTURE FOR OPTIMIZATION
762C-----------------------------------------------
763C I m p l i c i t T y p e s
764C-----------------------------------------------
765#include "implicit_f.inc"
766C-----------------------------------------------
767C C o m m o n B l o c k s
768C-----------------------------------------------
769#include "com01_c.inc"
770#include "com04_c.inc"
771#include "units_c.inc"
772#include "scr03_c.inc"
773#include "param_c.inc"
774C-----------------------------------------------
775C D u m m y A r g u m e n t s
776C-----------------------------------------------
777 INTEGER ISOLOFF(*), ISHEOFF(*), ITRIOFF(*),ITRUOFF(*),
778 . IPOUOFF(*), IRESOFF(*),
779 . IXS(NIXS,*), IXC(NIXC,*), IXTG(NIXTG,*), IXT(NIXT,*),
780 . IXP(NIXP,*), IXR(NIXR,*),
781 . IPARG(NPARG,*),IGRNRBY(*),
782 . IQUAOFF(*),IXQ(NIXQ,*)
783 TYPE (ELBUF_STRUCT_), DIMENSION(NGROUP), TARGET :: ELBUF_STR
784C-----------------------------------------------
785 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
786C-----------------------------------------------
787C L o c a l V a r i a b l e s
788C-----------------------------------------------
789 INTEGER NG, MLW, ITY, NEL, NFT, IAD, I, II, IGOF, NR, IG,
790 . NSN, NALL, ISHFT, IOK, IRBYON
791 TYPE(G_BUFEL_) ,POINTER :: GBUF
792 INTEGER, DIMENSION(:), ALLOCATABLE :: ITAG
793C-----------------------
794C MISE DE OFF A -OFF
795C======================================================================|
796 IF(ipri>=5) THEN
797 WRITE(iout,*)' '
798
799 WRITE(iout,*)' LIST OF DEACTIVATED ELEMENTS FROM RIGID BODIES'
800 WRITE(iout,*)' ----------------------------------------------'
801 END IF
802C
803 irbyon = 1
804C
805 CALL my_alloc(itag,numnod)
806C Initial initialization on NUMNOD
807 DO i=1,numnod
808 itag(i)=0
809 ENDDO
810C
811 DO nr = 1, nrbody
812 ig = igrnrby(nr)
813 IF(ig > 0)THEN
814 nsn = igrnod(ig)%NENTITY
815 DO i=1,nsn
816 itag(igrnod(ig)%ENTITY(i))=1
817 END DO
818C
819 DO ii = 1, numelt
820 nall = itag(ixt(2,ii)) * itag(ixt(3,ii))
821 IF(nall/=0)THEN
822 itruoff(ii) = irbyon
823 END IF
824 END DO
825C
826 DO ii = 1, numelp
827 nall = itag(ixp(2,ii)) * itag(ixp(3,ii))
828 IF(nall/=0)THEN
829 ipouoff(ii) = irbyon
830 END IF
831 END DO
832C
833 DO ii = 1, numelr
834 nall = itag(ixr(2,ii)) * itag(ixr(3,ii))
835 IF(nall/=0)THEN
836 iresoff(ii) = irbyon
837 END IF
838 END DO
839C
840C Reinitialize to 0 only on the concerned part
841 DO i=1,nsn
842 itag(igrnod(ig)%ENTITY(i))=0
843 END DO
844 END IF
845 END DO
846C
847C IF COND
848 DO ng=1,ngroup
849 gbuf => elbuf_str(ng)%GBUF
850 mlw=iparg(1,ng)
851 ity=iparg(5,ng)
852 nel=iparg(2,ng)
853 nft=iparg(3,ng)
854 iad=iparg(4,ng) - 1
855C-----------------------
856C 1. ELEMENTS SOLIDES
857C-----------------------
858 IF(ity == 1.AND.mlw/=0)THEN ! Law 0, no offset
859 iok = 0
860 DO i=1,nel
861 ii=i+nft
862 IF(isoloff(ii)/=0)THEN
863 gbuf%OFF(i)= -abs(gbuf%OFF(i))
864 IF(ipri>=5) WRITE(iout,*)' BRICK DEACTIVATION:',
865 . ixs(11,ii)
866 iok = 1
867 ENDIF
868 ENDDO
869C----------------------------------------
870C TEST FOR ELIMINATION OF A GROUP
871C----------------------------------------
872 IF(iok == 1)THEN
873 igof = 1
874 DO i = 1,nel
875 ii=i+nft
876 IF (gbuf%OFF(i) > zero) igof=0
877 ENDDO
878 iparg(8,ng) = igof
879 END IF
880C-----------------------
881C 2. ELEMENTS QUADS
882C-----------------------
883 ELSEIF(ity == 2.AND.mlw/=0)THEN ! Law 0, no offset
884 iok = 0
885 DO i=1,nel
886 ii=i+nft
887 IF(iquaoff(ii)/=0)THEN
888 gbuf%OFF(i)= -abs(gbuf%OFF(i))
889 IF(ipri>=5) WRITE(iout,*)' QUAD DEACTIVATION:',
890 . ixq(nixq,ii)
891 iok = 1
892 ENDIF
893 ENDDO
894C----------------------------------------
895C TEST FOR ELIMINATION OF A GROUP
896C----------------------------------------
897 IF(iok == 1)THEN
898 igof = 1
899 DO i = 1,nel
900 ii=i+nft
901 IF (gbuf%OFF(i) > zero) igof=0
902 ENDDO
903 iparg(8,ng) = igof
904 END IF
905C-----------------------
906C 3. ELEMENTS COQUES
907C-----------------------
908 ELSEIF(ity == 3.AND.mlw/=0)THEN ! Law 0, no offset
909 iok = 0
910 DO i=1,nel
911 ii=i+nft
912 IF(isheoff(ii)/=0)THEN
913 IF (gbuf%OFF(i) > zero)THEN
914 gbuf%OFF(i) = -gbuf%OFF(i)
915 IF(ipri>=5) WRITE(iout,*)' SHELL DEACTIVATION:',
916 . ixc(7,ii)
917 iok = 1
918 ENDIF
919 ENDIF
920 ENDDO
921C----------------------------------------
922C TEST FOR ELIMINATION OF A GROUP
923C----------------------------------------
924 IF(iok == 1)THEN
925 igof = 1
926 DO i = 1,nel
927 ii=i+nft
928 IF (gbuf%OFF(i) > zero) igof=0
929 ENDDO
930 iparg(8,ng) = igof
931 END IF
932C-----------------------
933C 4. ELEMENTS TRUSS
934C-----------------------
935 ELSEIF(ity == 4)THEN
936 iok = 0
937 DO i=1,nel
938 ii=i+nft
939 IF(itruoff(ii)/=0)THEN
940 gbuf%OFF(i)= -abs(gbuf%OFF(i))
941 IF(ipri>=5) WRITE(iout,*)' TRUSS DEACTIVATION:',
942 . ixt(5,ii)
943 iok = 1
944 ENDIF
945 ENDDO
946C----------------------------------------
947C TEST FOR ELIMINATION OF A GROUP
948C----------------------------------------
949C Incompatible with gap option in truss property
950C IGOF = 1
951C DO I = 1,NEL
952C IF(ELBUF(IAD + I)/=ZERO) IGOF=0
953C ENDDO
954C IPARG(8,NG) = IGOF
955C-----------------------
956C 5. ELEMENTS POUTRES
957C-----------------------
958 ELSEIF(ity == 5)THEN
959 iok = 0
960 DO i=1,nel
961 ii=i+nft
962 IF(ipouoff(ii)/=0)THEN
963 gbuf%OFF(i)= -abs(gbuf%OFF(i))
964 IF(ipri>=5) WRITE(iout,*)' BEAM DEACTIVATION:',
965 . ixp(6,ii)
966 iok = 1
967 ENDIF
968 ENDDO
969C----------------------------------------
970C TEST FOR ELIMINATION OF A GROUP
971C----------------------------------------
972 IF(iok == 1)THEN
973 igof = 1
974 DO i = 1,nel
975 IF(gbuf%OFF(i) > zero) igof=0
976 ENDDO
977 iparg(8,ng) = igof
978 END IF
979C-----------------------
980C 6. ELEMENTS RESSORTS
981C-----------------------
982 ELSEIF(ity == 6.AND.mlw/=3)THEN
983 iok = 0
984 DO i=1,nel
985 ii=i+nft
986 IF(iresoff(ii)/=0)THEN
987 IF (gbuf%OFF(i) /= -ten) gbuf%OFF(i) = -abs(gbuf%OFF(i))
988C spring is active
989 IF(ipri>=5) WRITE(iout,*)' SPRING DEACTIVATION:',
990 . ixr(6,ii)
991 iok = 1
992 ENDIF
993 ENDDO
994C----------------------------------------
995C TEST FOR ELIMINATION OF A GROUP
996C----------------------------------------
997 IF(iok == 1)THEN
998 igof = 1
999 DO i = 1,nel
1000 IF(gbuf%OFF(i)/=zero) igof=0
1001 ENDDO
1002 iparg(8,ng) = igof
1003 END IF
1004C-----------------------
1005C 7. ELEMENTS COQUES 3N
1006C-----------------------
1007 ELSEIF(ity == 7.AND.mlw/=0)THEN ! Law 0, no offset
1008 ishft=16
1009 iok = 0
1010 DO i=1,nel
1011 ii=i+nft
1012 IF(itrioff(ii)/=0)THEN
1013 gbuf%OFF(i)= -abs(gbuf%OFF(i))
1014 IF(ipri>=5) WRITE(iout,*)' SH_3N DEACTIVATION:',
1015 . ixtg(6,ii)
1016 iok = 1
1017 ENDIF
1018 ENDDO
1019C----------------------------------------
1020C TEST FOR ELIMINATION OF A GROUP
1021C----------------------------------------
1022 IF(iok == 1)THEN
1023 igof = 1
1024 DO i = 1,nel
1025 ii=i+nft
1026 IF (gbuf%OFF(i) > zero) igof=0
1027 ENDDO
1028 iparg(8,ng) = igof
1029 END IF
1030C----------------------------------------
1031 ENDIF
1032 ENDDO
1033C-----------
1034 IF(ALLOCATED(itag)) DEALLOCATE(itag)
1035C
1036 RETURN
1037 END SUBROUTINE seteloff
1038
anodset
void anodset(int *id, int *type)
Definition analyse_node.c:321
my_real
#define my_real
Definition cppsort.cpp:32
rigmodif_nd
subroutine rigmodif_nd(nn, inn, itagnd, icnds10, iu, titr, itab)
Definition dim_s10edg.F:294
freform
subroutine freform(irunn, irfl, irfe, h3d_data, flag_cst_ams, dynain_data, sensors, dt, output, glob_therm)
Definition freform.F:88
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:418
hm_get_intv
subroutine hm_get_intv(name, ival, is_available, lsubmodel)
Definition hm_get_intv.F:528
hm_option_start
subroutine hm_option_start(entity_type)
Definition hm_option_start.F:253
setrbyon
subroutine setrbyon(ixs, ixc, ixtg, igrnod, igrnrby, isoloff, isheoff, itrioff, knod2els, knod2elc, knod2eltg, nod2els, nod2elc, nod2eltg, ixq, iquaoff, knod2elq, nod2elq, lsubmodel)
Definition hm_read_rbody.F:565
seteloff
subroutine seteloff(ixs, ixc, ixt, ixp, ixr, ixtg, iparg, isoloff, isheoff, itruoff, ipouoff, iresoff, itrioff, igrnrby, igrnod, elbuf_str, iquaoff, ixq)
Definition hm_read_rbody.F:752
hm_read_rbody
subroutine hm_read_rbody(rby, npby, lpby, itab, itabm1, igrnod, igrsurf, ibfv, igrv, ibgr, sensors, imerge, unitab, iskn, nom_opt, numsl, knod2els, knod2elc, knod2eltg, knod2el1d, knod2elq, itagnd, icdns10, lsubmodel, icfield, lcfield)
Definition hm_read_rbody.F:56
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:414
min
#define min(a, b)
Definition macros.h:20
id
initmumps id
Definition multiplerhs_example.m:4
groupdef_mod
Definition groupdef_mod.F:668
hm_option_read_mod
Definition hm_option_read_mod.F:412
message_mod
Definition message_mod.F:1257
names_and_titles_mod
Definition names_and_titles_mod.F:1002
names_and_titles_mod::nchartitle
integer, parameter nchartitle
Definition names_and_titles_mod.F:1008
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1005
r2r_mod
Definition r2r_mod.F:125
r2r_mod::tagrby
integer, dimension(:), allocatable tagrby
Definition r2r_mod.F:132
submodel_mod
Definition submodel_mod.F:717
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:725
unitab_mod
Definition unitab_mod.F:517
hm_sz_r2r
subroutine hm_sz_r2r(tag, val, lsubmodel)
Definition routines_r2r.F:299
spmdset
subroutine spmdset(n, npby, nnpby, lpby, nsl, k)
Definition spmdset.F:34
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:895
nodgrnr6
integer function nodgrnr6(m, igu, igs, ibuf, igrnod, itabm1, mess, id)
Definition freform.F:359
fretitl
subroutine fretitl(titr, iasc, l)
Definition freform.F:615
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:799
newdbl
subroutine newdbl(list, ilist, nlist, tab, errid, status, nom_opt)
Definition sysfus.F:742
udouble
subroutine udouble(list, ilist, nlist, mess, ir, rlist)
Definition sysfus.F:573
starter
program starter
Definition starter.F:39