OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_inigrav.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"
#include "units_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_inigrav (igrv, ibuf, agrv, itab, itabm1, igrpart, npc, unitab, iskn, itagnd, igrsurf, pld, bufsf, lsubmodel)

Function/Subroutine Documentation

◆ hm_read_inigrav()

subroutine hm_read_inigrav ( integer, dimension(nigrv,*) igrv,
integer, dimension(*) ibuf,
agrv,
integer, dimension(*) itab,
integer, dimension(*) itabm1,
type (group_), dimension(ngrpart) igrpart,
integer, dimension(*) npc,
type (unit_type_), intent(in) unitab,
integer, dimension(liskn,*) iskn,
integer, dimension(*) itagnd,
type (surf_), dimension(nsurf) igrsurf,
pld,
bufsf,
type(submodel_data), dimension(*) lsubmodel )

Definition at line 39 of file hm_read_inigrav.F.

42C-----------------------------------------------
43C M o d u l e s
44C-----------------------------------------------
45 USE unitab_mod
46 USE message_mod
47 USE inigrav
48 USE groupdef_mod
49 USE submodel_mod
50 USE hm_option_read_mod
51 USE names_and_titles_mod , ONLY : nchartitle, ncharfield
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 "units_c.inc"
61#include "param_c.inc"
62C-----------------------------------------------
63C D u m m y A r g u m e n t s
64C-----------------------------------------------
65 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
66 INTEGER IGRV(NIGRV,*), IBUF(*), ITAB(*), ITABM1(*),NPC(*),
67 . ISKN(LISKN,*),ITAGND(*)
68 my_real
69 . agrv(lfacgrv,*)
70 my_real pld(*), bufsf(*)
71 TYPE(SUBMODEL_DATA) LSUBMODEL(*)
72C-----------------------------------------------
73 TYPE (GROUP_) , DIMENSION(NGRPART) :: IGRPART
74 TYPE (SURF_) , DIMENSION(NSURF) :: IGRSURF
75C-----------------------------------------------
76C L o c a l V a r i a b l e s
77C-----------------------------------------------
78 my_real
79 . fcx,fcy,fac_m,fac_l,fac_t,ngx,ngy,ngz,dotprod
80 INTEGER I, NOD, NCUR, NOSKEW,NSKW,NN,IGS,UID,
81 . IAD,NS,IWA,J,K,ID,K1,K2,NCURS,N1,N2,NC,L,
82 . ITAG, IFLAGUNIT,FLAG_FMT,FLAG_FMT_TMP,IFIX_TMP,IADPL
83 CHARACTER(LEN=NCHARFIELD) :: XYZ
84 CHARACTER X*1, Y*1, Z*1, XX*2, YY*2, ZZ*2, MESS*40
85 CHARACTER(LEN=NCHARTITLE)::TITR
86
87 INTEGER :: IGU,ISU,IGRAV,IBID, IG, IS, IDIR, PN1, ICURS, IIGRAV,IIG,IIS
88 my_real :: bx_,by_,bz_, grav0,nx,ny,nz,norm,psurf,bid
89 LOGICAL :: lFOUND, lPLANAR_SURF, lUSER_SURF, lOUTP, lGRAV, lUNIQUE, IS_AVAILABLE
90 CHARACTER*2 :: CDIR
91
92 INTEGER :: M,ID_LIST(NINIGRAV)
93C-----------------------------------------------
94 DATA x/'X'/
95 DATA y/'Y'/
96 DATA z/'Z'/
97 DATA xx/'XX'/
98 DATA yy/'YY'/
99 DATA zz/'ZZ'/
100 DATA mess/'INITIAL GRAVITY LOADING DEFINITION '/
101C=======================================================================
102C
103 ! Initialization of variable
104 lplanar_surf = .false.
105 luser_surf = .false.
106 lgrav = .true.
107 loutp = .true.
108 is_available = .false.
109 ngx = zero
110 ngy = zero
111 ngz = zero
112C
113 ! Start reading /INIGRAV card
114 CALL hm_option_start('/INIGRAV')
115C
116 ! Loop over /INIGRAV
117 DO k=1,ninigrav
118C
119 ! Read title, ID and Unit ID
120 titr = ''
121 CALL hm_option_read_key(lsubmodel,
122 . option_id = id,
123 . unit_id = uid,
124 . option_titr = titr)
125C
126 ! Checking unit ID
127 iflagunit = 0
128 DO j=1,unitab%NUNITS
129 IF (unitab%UNIT_ID(j) == uid) THEN
130 iflagunit = 1
131 EXIT
132 ENDIF
133 ENDDO
134C
135 id_list(k)=id
136 lunique = .true.
137 DO m=1,k-1
138 IF(id==id_list(m))THEN
139 lunique=.false.
140 EXIT
141 ENDIF
142 ENDDO
143C
144 IF (uid /= 0 .AND. iflagunit == 0) THEN
145 CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,
146 . i2=uid,i1=id,
147 . c1='INITIAL GRAVITY LOADING',
148 . c2='INITIAL GRAVITY LOADING',
149 . c3= titr)
150 loutp = .false.
151 ENDIF
152C
153 ! Reading 1st card : ids
154 CALL hm_get_intv('grpart_ID',igu,is_available,lsubmodel)
155 CALL hm_get_intv('surf_ID' ,isu,is_available,lsubmodel)
156 CALL hm_get_intv('grav_ID' ,igrav,is_available,lsubmodel)
157C
158 ! Reading 2nd card : pressure, etc
159 CALL hm_get_floatv('Pref' ,psurf,is_available, lsubmodel, unitab)
160 ! Only if ISU == 0
161 IF (isu == 0) THEN
162 CALL hm_get_floatv('Bx',bx_,is_available, lsubmodel, unitab)
163 CALL hm_get_floatv('By',by_,is_available, lsubmodel, unitab)
164 CALL hm_get_floatv('Bz',bz_,is_available, lsubmodel, unitab)
165 ENDIF
166C
167 ! Checking Gravity ID
168 lfound = .false.
169 iigrav = 0
170 grav0 = zero
171 DO ig=1,ngrav
172 IF (igrav == igrv(5,ig)) THEN
173 lfound = .true.
174 iigrav = ig
175 icurs = igrv(3,ig)
176 IF (icurs > 0) THEN
177 pn1 = npc(icurs)
178 grav0 = agrv(1,ig)*pld(pn1+1)
179 ELSE
180 grav0 = agrv(1,ig)
181 ENDIF
182 idir = mod(igrv(2,ig),10)
183 ngx = zero
184 ngy = zero
185 ngz = zero
186 SELECT CASE (idir)
187 CASE(1)
188 cdir(1:2) =' X'
189 ngx = one
190 CASE(2)
191 cdir(1:2) =' Y'
192 ngy = one
193 CASE(3)
194 cdir(1:2) =' Z'
195 ngz = one
196 END SELECT
197 cdir(1:1)="+"
198 IF (grav0 < zero) THEN
199 cdir(1:1)="-"
200 ngx = -ngx
201 ngy = -ngy
202 ngz = -ngz
203 ENDIF
204 EXIT
205 ENDIF
206 ENDDO
207 ! Wrong gravity ID
208 IF (.NOT.lfound) THEN
209 CALL ancmsg(msgid=73,anmode=aninfo,msgtype=msgerror,
210 . i1=id,
211 . c1=titr,
212 . i2= igrav,
213 . c2='DOES NOT REFER TO A VALID /GRAV ID')
214 loutp = .false.
215 lgrav = .false.
216 ENDIF
217 ! Inigrav ID duplicated
218 IF (.NOT.lunique) THEN
219 CALL ancmsg(msgid=73,anmode=aninfo,msgtype=msgerror,
220 . i1=id,
221 . c1=titr,
222 . i2= id,
223 . c2='IDENTIFIER IS DUPLICATED')
224 ENDIF
225C
226 ! Checking surface ID
227 iis = 0
228 IF (isu > 0) THEN
229 lfound = .false.
230 DO is=1,nsurf
231 IF (isu == igrsurf(is)%ID)THEN
232 SELECT CASE(igrsurf(is)%TYPE)
233 CASE(0)
234 iis = is
235 luser_surf=.true.
236 iadpl = igrsurf(is)%IAD_BUFR
237 lfound = .true.
238 bx_ = zero
239 by_ = zero
240 bz_ = zero
241 nx = zero
242 ny = zero
243 nz = zero
244 nx = zero
245 ny = zero
246 nz = zero
247 EXIT
248 CASE(200)
249 iis = is
250 lplanar_surf=.true.
251 iadpl = igrsurf(is)%IAD_BUFR
252 lfound = .true.
253 bx_ = bufsf(iadpl+1)
254 by_ = bufsf(iadpl+2)
255 bz_ = bufsf(iadpl+3)
256 nx = bufsf(iadpl+4)- bufsf(iadpl+1)
257 ny = bufsf(iadpl+5)- bufsf(iadpl+2)
258 nz = bufsf(iadpl+6)- bufsf(iadpl+3)
259 norm = sqrt(nx*nx+ny*ny+nz*nz)
260 nx = nx / norm
261 ny = ny / norm
262 nz = nz / norm
263 EXIT
264 END SELECT
265 ENDIF
266 ENDDO
267 ! Wrong surface ID
268 IF (.NOT.lfound) THEN
269 CALL ancmsg(msgid=73,anmode=aninfo,msgtype=msgerror,
270 . i1=id,
271 . c1=titr,
272 . i2= isu,
273 . c2='DOES NOT REFER TO A VALID /SURF ID')
274 loutp = .false.
275 ENDIF
276 ELSE
277 nx = ngx
278 ny = ngy
279 nz = ngz
280 ENDIF
281C
282 ! Checking GRPART ID
283 lfound = .false.
284 iig = 0
285 iad = ngrnod+ngrbric+ngrquad+ngrshel+ngrsh3n+ngrtrus+ngrbeam+ngrspri
286 IF (igu > 0) THEN
287 DO ig=1,ngrpart
288 IF (igu == igrpart(ig)%ID) THEN
289 iig = ig
290 lfound = .true.
291 EXIT
292 ENDIF
293 ENDDO
294 ! Wrong GRPART ID
295 IF (.NOT.lfound) THEN
296 CALL ancmsg(msgid=73,anmode=aninfo,msgtype=msgerror,
297 . i1=id,
298 . c1=titr,
299 . i2= igu,
300 . c2='DOES NOT REFER TO A VALID GRPART ')
301 loutp = .false.
302 ENDIF
303 ENDIF
304C
305 ! Checking the normal
306 IF (lplanar_surf .AND. lgrav) THEN
307 dotprod = nx*ngx+ny*ngy+nz*ngz
308 IF(abs(dotprod)<=em20)THEN
309 CALL ancmsg(msgid=73,anmode=aninfo,msgtype=msgerror,
310 . i1=id,
311 . c1=titr,
312 . i2= igrav,
313 . c2='REFER TO A GRAVITY DIRECTION COLINEAR TO THE INPUT SURFACE')
314 loutp = .false.
315 ENDIF
316 ENDIF
317C
318 ! Storing IDs in INIGRV table
319 inigrv(1,k) = iig
320 inigrv(2,k) = iis
321 inigrv(3,k) = iigrav
322 inigrv(4,k) = id
323C
324 ! Storing real data in LINIGRAV table
325 linigrav(01,k) = bx_
326 linigrav(02,k) = by_
327 linigrav(03,k) = bz_
328 linigrav(04,k) = nx
329 linigrav(05,k) = ny
330 linigrav(06,k) = nz
331 linigrav(07,k) = grav0
332 linigrav(08,k) = ngx
333 linigrav(09,k) = ngy
334 linigrav(10,k) = ngz
335 linigrav(11,k) = psurf
336C
337 ! Printout data
338 IF (lplanar_surf) THEN
339 WRITE (iout,2000)
340 WRITE (iout,fmt='(A)') ''
341 WRITE (iout,3000) igu,isu,igrav,bx_,by_,bz_, psurf
342 WRITE (iout,3001) cdir(2:2)
343 WRITE (iout,3002) grav0
344 IF(lplanar_surf) WRITE (iout,3003) nx,ny,nz
345 ELSEIF(luser_surf)THEN
346 WRITE (iout,2001)
347 WRITE (iout,fmt='(A)') ''
348 WRITE (iout,3005) igu,isu,igrav, psurf
349 WRITE (iout,3001) cdir(2:2)
350 WRITE (iout,3002) grav0
351 IF(luser_surf)WRITE (iout,3004)
352 ENDIF
353 ENDDO !next K
354C-----------
355 RETURN
356C-----------
357 2000 FORMAT(//
358 .' INITIAL GRAVITY LOADING '/
359 .' ----------------------- '/
360 .' GRPART_ID SURF_ID GRAV_ID BX BY BZ PSURF ')
361
362 2001 FORMAT(//
363 .' INITIAL GRAVITY LOADING '/
364 .' ----------------------- '/
365 .' GRPART_ID SURF_ID GRAV_ID PSURF ')
366
367 3000 FORMAT(2x,i10,2x,i10,2x,i10,2x,e12.4,2x,e12.4,2x,e12.4,2x,e12.4)
368 3005 FORMAT(2x,i10,2x,i10,2x,i10,3x,e12.4)
369
370 3001 FORMAT(' GRAVITY ORIENTATION : ',1x,a2)
371 3002 FORMAT(' GRAVITY VALUE : ',2x,e12.4)
372 3003 FORMAT(' SURFACE ORIENTATION : ',2x,e12.4,2x,e12.4,2x,e12.4)
373 3004 FORMAT(' USER DEFINED SURFACE')
374C-----------
375 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
norm
norm(diag(diag(diag(inv(mat))) -id.SOL), 2) % destroy mumps instance id.JOB
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
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
inigrav::inigrv
integer, dimension(:,:), allocatable inigrv
Definition inigrav_mod.F:38
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
names_and_titles_mod::ncharfield
integer, parameter ncharfield
Definition names_and_titles_mod.F:1005
submodel_mod
Definition submodel_mod.F:712
unitab_mod
Definition unitab_mod.F:513
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