OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_rand.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"
#include "scr03_c.inc"
#include "random_c.inc"
#include "units_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_rand (x, igrnod, itab, irand, alea, xseed, unitab, lsubmodel)

Function/Subroutine Documentation

◆ hm_read_rand()

subroutine hm_read_rand ( x,
type (group_), dimension(ngrnod), target igrnod,
integer, dimension(*) itab,
integer, dimension(*) irand,
alea,
xseed,
type (unit_type_), intent(in) unitab,
type (submodel_data), dimension(*), intent(in) lsubmodel )

Definition at line 40 of file hm_read_rand.F.

42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE message_mod
46 USE groupdef_mod
47 USE submodel_mod
48 USE hm_option_read_mod
49 USE unitab_mod
50 USE random_mod
51 USE names_and_titles_mod , ONLY : ncharkey
52C-----------------------------------------------
53C I m p l i c i t T y p e s
54C-----------------------------------------------
55#include "implicit_f.inc"
56C-----------------------------------------------
57C C o m m o n B l o c k s
58C-----------------------------------------------
59#include "com04_c.inc"
60#include "scr03_c.inc"
61#include "random_c.inc"
62#include "units_c.inc"
63C-----------------------------------------------
64C D u m m y A r g u m e n t s
65C-----------------------------------------------
66 INTEGER ITAB(*),IRAND(*)
67 my_real
68 . x(3,*),alea(*),xseed(*)
69C-----------------------------------------------
70 TYPE (GROUP_) ,TARGET, DIMENSION(NGRNOD) :: IGRNOD
71 TYPE (SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(*)
72 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
73C-----------------------------------------------
74C E x t e r n a l F u n c t i o n s
75C-----------------------------------------------
76 INTEGER NGR2USR
77 my_real
78 . aleat
79 EXTERNAL ngr2usr,aleat
80C-----------------------------------------------
81C L o c a l V a r i a b l e s
82C-----------------------------------------------
83 INTEGER I,J,ID,IS,IGRS,IALL,NRANDG,SUB_ID
84 CHARACTER(LEN=NCHARKEY) :: KEY
85!
86 INTEGER, DIMENSION(:), POINTER :: INGR2USR
87 LOGICAL IS_AVAILABLE
88C======================================================================|
89 iall = 0
90 nrandg = 0
91 seed =zero
92 xalea =zero
93C--------------------------------------------------
94C START BROWSING MODEL RBODY
95C--------------------------------------------------
96 is_available = .false.
97 CALL hm_option_start('/RANDOM')
98C-----------------------------
99 DO i=1,nrand
100 irand(i) = 0
101 alea(i) = zero
102 xseed(i) = zero
103 ! --------------------------------
104 ! check if -rxalea or -rseed command line option are used
105 IF(.NOT.rand_struct%CMD) THEN
106C--------------------------------------------------
107C EXTRACT DATAS OF /RANDOM
108C--------------------------------------------------
109 CALL hm_option_read_key(lsubmodel,
110 . keyword2 = key,
111 . submodel_id = sub_id)
112C
113 IF(sub_id == 0) THEN
114 CALL hm_get_floatv('XALEA',alea(i),is_available,lsubmodel,unitab)
115 CALL hm_get_floatv('SEED',xseed(i),is_available,lsubmodel,unitab)
116 CALL hm_get_intv('GRNOD_ID',id,is_available,lsubmodel)
117C
118 irand(i) = id
119 IF (alea(i) > zero) THEN
120 seed = xseed(i)
121 IF(key(1:5) == 'GRNOD') THEN
122 nrandg = nrandg+1
123 ingr2usr => igrnod(1:ngrnod)%ID
124 irand(nrandg) = ngr2usr(id,ingr2usr,ngrnod)
125 IF (irand(nrandg) == 0) THEN
126 CALL ancmsg(msgid=173,
127 . msgtype=msgerror,
128 . anmode=aninfo,
129 . c1='RANDOM NOISE',
130 . c2='NODE',
131 . i1=id)
132 nrandg = nrandg-1
133 ENDIF
134 ELSE
135 iall = iall+1
136 xalea = alea(i)
137 ENDIF
138 ENDIF
139 ENDIF
140 ! --------------------------------
141 ELSE
142 ! -rxalea or -rseed command line option are used
143 iall = iall+1
144 irand(i) = 0
145 alea(i) = rand_struct%ALEA_NBR
146 xseed(i) = rand_struct%SEED_NBR
147 seed = xseed(i)
148 xalea = alea(i)
149 ENDIF
150 ! --------------------------------
151 ENDDO
152 IF ((nrandg == 0 .AND. xalea > zero).OR.(nrandg > 0 .AND. iall == 0) ) THEN
153 IF(.NOT.rand_struct%CMD) WRITE(iout,1000)
154 ENDIF
155C---
156 IF (nrandg == 0 .AND. xalea > zero) THEN
157C-----------------------
158C All nodes
159C-----------------------
160 DO i=1,numnod
161 x(1,i)=x(1,i)+xalea*aleat()
162 x(2,i)=x(2,i)+xalea*aleat()
163 x(3,i)=x(3,i)+xalea*aleat()
164 ENDDO
165C
166 WRITE (iout,'(8X,A)')'NODE GROUP : ALL NODES'
167 WRITE (iout,1100) xalea
168 IF (seed /= zero) WRITE (iout,1200) seed
169 IF (ipri >= 4) THEN
170 WRITE (iout,1400)
171 DO i=1,numnod
172 WRITE(iout,1500)itab(i),x(1,i),x(2,i),x(3,i)
173 ENDDO
174 ENDIF
175 ELSEIF (nrandg > 0 .AND. iall == 0) THEN
176C-----------------------
177C Node groups only
178C-----------------------
179 DO i=1,nrandg
180 igrs = irand(i)
181 seed = xseed(i)
182 DO j=1,igrnod(igrs)%NENTITY
183 is=igrnod(igrs)%ENTITY(j)
184 x(1,is)=x(1,is)+alea(i)*aleat()
185 x(2,is)=x(2,is)+alea(i)*aleat()
186 x(3,is)=x(3,is)+alea(i)*aleat()
187 ENDDO
188 WRITE (iout,1050) igrnod(igrs)%ID
189 WRITE (iout,1100) alea(i)
190 IF (seed /= zero) WRITE (iout,1200) seed
191 ENDDO
192 IF (ipri >= 4) THEN
193 WRITE (iout,1400)
194 DO i=1,nrandg
195 igrs = irand(i)
196 DO j=1,igrnod(igrs)%NENTITY
197 is=igrnod(igrs)%ENTITY(j)
198 WRITE(iout,1500) itab(is),x(1,is),x(2,is),x(3,is)
199 ENDDO
200 ENDDO
201 ENDIF
202 ENDIF
203C-----------------------
204 RETURN
205 1000 FORMAT(//
206 .' RANDOM NOISE '/
207 .' ------------ ')
208 1050 FORMAT(/8x,'NODE GROUP : ID = ',i10)
209 1100 FORMAT( 8x,'MAXIMUM RANDOM NOISE : XALEA = ',1pg20.13)
210 1200 FORMAT( 8x,'RANDOM SEQUENCE : SEED = ',1pg20.13)
211 1400 FORMAT(/8x,'NEW NODE COORDINATES',20x,'X',24x,'Y',24x,'Z')
212 1500 FORMAT( 7x,i10,3(5x,e20.13))
213C---
214 RETURN
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_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
seed
#define seed()
Definition macros.h:43
id
initmumps id
Definition multiplerhs_example.m:4
groupdef_mod
Definition groupdef_mod.F:662
hm_option_read_mod
Definition hm_option_read_mod.F:408
message_mod
Definition message_mod.F:1249
names_and_titles_mod
Definition names_and_titles_mod.F:997
names_and_titles_mod::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1000
random_mod
Definition random_mod.F:33
random_mod::rand_struct
type(random_struct) rand_struct
Definition random_mod.F:52
submodel_mod
Definition submodel_mod.F:712
unitab_mod
Definition unitab_mod.F:513
ngr2usr
integer function ngr2usr(iu, igr, ngr)
Definition nintrr.F:325
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