OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_grav.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_grav ../starter/source/loads/general/grav/hm_read_grav.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| hm_get_floatv ../starter/source/devtools/hm_reader/hm_get_floatv.F
30!|| hm_get_floatv_dim ../starter/source/devtools/hm_reader/hm_get_floatv_dim.F
31!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
32!|| hm_get_string ../starter/source/devtools/hm_reader/hm_get_string.F
33!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
34!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
35!|| nodgrnr5 ../starter/source/starter/freform.F
36!|| remove_nd ../starter/source/elements/solid/solide10/dim_s10edg.F
37!|| usr2sys ../starter/source/system/sysfus.F
38!||--- uses -----------------------------------------------------
39!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
40!|| message_mod ../starter/share/message_module/message_mod.F
41!|| reader_old_mod ../starter/share/modules1/reader_old_mod.F90
42!|| submodel_mod ../starter/share/modules1/submodel_mod.F
43!||====================================================================
44 SUBROUTINE hm_read_grav(IGRV ,LGRAV ,GRAV ,ITAB ,ITABM1 ,
45 . IGRNOD ,NPC ,SENSORS ,UNITAB ,ISKN ,
46 . ITAGND ,LSUBMODEL)
47C-----------------------------------------------
48C M o d u l e s
49C-----------------------------------------------
50 USE unitab_mod
51 USE message_mod
52 USE groupdef_mod
53 USE submodel_mod , ONLY : nsubmod, submodel_data
54 USE hm_option_read_mod
55 USE sensor_mod
56 USE names_and_titles_mod , ONLY : nchartitle, ncharfield
57 USE reader_old_mod , ONLY : irec
58C-----------------------------------------------
59C I m p l i c i t T y p e s
60C-----------------------------------------------
61#include "implicit_f.inc"
62C-----------------------------------------------
63C C o m m o n B l o c k s
64C-----------------------------------------------
65#include "scr17_c.inc"
66#include "com04_c.inc"
67#include "units_c.inc"
68#include "param_c.inc"
69#include "sphcom.inc"
70C-----------------------------------------------
71C D u m m y A r g u m e n t s
72C-----------------------------------------------
73 TYPE (UNIT_TYPE_),INTENT(IN) ::UNITAB
74 INTEGER IGRV(NIGRV,NGRAV), LGRAV(*), ITAB(*), ITABM1(*),
75 . npc(*), iskn(liskn,*), itagnd(*)
76 my_real
77 . grav(lfacgrv,ngrav)
78 TYPE(submodel_data),INTENT(IN)::LSUBMODEL(NSUBMOD)
79 TYPE (SENSORS_) ,INTENT(IN) :: SENSORS
80C-----------------------------------------------
81C IGRV(LIBRV,NGRAV)
82C-----------------------------------------------
83C IGRV(1,K) : NN Nb of Nodes
84C IGRV(2,K) : NS=10*NOSKEW+IDIR, IDIR=1 (X),2 (Y),3 (Z)
85C IGRV(3,K) : Function (internal) number
86C IGRV(4,K) : IAD Address of nodes in skyline vector LGRAV(IAD:IAD+NN-1)
87C IGRV(5,K) : Option ID
88C IGRV(6,K) : Sensor (internal) number
89C-----------------------------------------------
90C LGRAV(1:SLGRAV) skyline vector of nodes numbers (one /GRAV option after the other)
91C-----------------------------------------------
92C GRAV(LFACGRV,NGRAV)
93C GRAV(1,K) : FCY
94C GRAV(2,K) : ONE/FCX
95C-----------------------------------------------
96 TYPE (GROUP_) , DIMENSION(NGRNOD) :: IGRNOD
97C-----------------------------------------------
98C L o c a l V a r i a b l e s
99C-----------------------------------------------
100 my_real fcx,fcy,fac_fcx,fac_fcy
101 INTEGER I, NCUR, NOSKEW,NSKW, ISENS,NN,IGU,IGS,UID,IAD,NS,J,K,ID,NCURS,TSENS, IFLAGUNIT, SUB_INDEX
102 CHARACTER(LEN=NCHARFIELD) :: XYZ
103 CHARACTER :: X*1, Y*1, Z*1, XX*2, YY*2, ZZ*2, MESS*40
104 CHARACTER(LEN=NCHARTITLE)::TITR
105 LOGICAL IS_AVAILABLE
106C-----------------------------------------------
107C E x t e r n a l F u n c t i o n s
108C-----------------------------------------------
109 INTEGER USR2SYS,NODGRNR5
110 EXTERNAL USR2SYS,NODGRNR5
111C-----------------------------------------------
112 DATA x/'X'/
113 DATA y/'Y'/
114 DATA z/'Z'/
115 DATA xx/'XX'/
116 DATA yy/'YY'/
117 DATA zz/'ZZ'/
118 DATA mess/'GRAVITY LOADS DEFINITION '/
119C=======================================================================
120 is_available = .false.
121c
122C
123 iad=1
124 IF(ngrav==0)RETURN
125C
126 WRITE (iout,2000)
127C--------------------------------------------------
128C START BROWSING MODEL GRAV
129C--------------------------------------------------
130 CALL hm_option_start('/GRAV')
131C--------------------------------------------------
132C BROWSING MODEL PARTS 1->NGRAV
133C--------------------------------------------------
134 DO k=1,ngrav
135 titr = ''
136C--------------------------------------------------
137C EXTRACT DATAS OF /PART/... LINE
138C--------------------------------------------------
139 CALL hm_option_read_key(lsubmodel,
140 . option_id = id,
141 . unit_id = uid,
142 . submodel_index = sub_index,
143 . option_titr = titr)
144C--------------------------------------------------
145C EXTRACT DATAS (STRING VALUES)
146C--------------------------------------------------
147 CALL hm_get_string('rad_dir',xyz,ncharfield,is_available)
148C--------------------------------------------------
149C EXTRACT DATAS (INTEGER VALUES)
150C--------------------------------------------------
151 CALL hm_get_intv('curveid',ncur,is_available,lsubmodel)
152 CALL hm_get_intv('inputsystem',noskew,is_available,lsubmodel)
153 IF(noskew == 0 .AND. sub_index /= 0 ) noskew = lsubmodel(sub_index)%SKEW
154 CALL hm_get_intv('rad_sensor_id',isens,is_available,lsubmodel)
155 CALL hm_get_intv('entityid',igu,is_available,lsubmodel)
156C--------------------------------------------------
157C EXTRACT DATAS (REAL VALUES)
158C--------------------------------------------------
159 CALL hm_get_floatv('xscale',fcx,is_available,lsubmodel,unitab)
160 CALL hm_get_floatv_dim('xscale',fac_fcx,is_available,lsubmodel,unitab)
161 CALL hm_get_floatv('magnitude',fcy,is_available,lsubmodel,unitab)
162 CALL hm_get_floatv_dim('magnitude',fac_fcy,is_available,lsubmodel,unitab)
163C--------------------------------------------------
164 iflagunit = 0
165 DO j=1,unitab%NUNITS
166 IF (unitab%UNIT_ID(j) == uid) THEN
167 iflagunit = 1
168 EXIT
169 ENDIF
170 ENDDO
171 IF (uid/=0.AND.iflagunit==0) THEN
172 CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,
173 . i2=uid,i1=id,c1='GRAVITY LOAD',
174 . c2='GRAVITY LOAD',
175 . c3=titr)
176 ENDIF
177 DO j=0,numskw+min(1,nspcond)*numsph+nsubmod
178 IF(noskew == iskn(4,j+1)) THEN
179 noskew=j+1
180 GO TO 100
181 ENDIF
182 ENDDO
183 CALL ancmsg(msgid=137,anmode=aninfo,msgtype=msgerror,
184 . c1='GRAVITY LOAD',
185 . c2='GRAVITY LOAD',
186 . i2=noskew,i1=id,c3=titr)
187 100 CONTINUE
188
189 IF (fcx == zero) fcx = fac_fcx
190 IF (fcy == zero) fcy = fac_fcy
191
192 nskw=10*noskew
193 ns=0
194 IF (xyz(1:1)==x) THEN
195 ns=1+nskw
196 ELSEIF(xyz(1:1)==y)THEN
197 ns=2+nskw
198 ELSEIF(xyz(1:1)==z)THEN
199 ns=3+nskw
200 ELSE
201 xyz='Z'
202 ns=3+nskw
203c CALL ANCMSG(MSGID=153,ANMODE=ANINFO,MSGTYPE=MSGERROR,
204c . C2=XYZ,I1=ID,C1=TITR)
205 ENDIF
206C
207 IF (igu /= 0) THEN
208 nn = nodgrnr5(igu,igs,lgrav(iad),igrnod,itabm1,mess)
209 ELSE
210 nn = numnod
211 DO i=1,numnod
212 lgrav(iad-1+i)=i
213 ENDDO
214 ENDIF
215 IF (ns10e > 0 ) CALL remove_nd(nn,lgrav(iad),itagnd)
216C
217 irec = irec + 1
218 igrv(1,k)=nn
219 igrv(2,k)=ns
220 ncurs=0
221 IF(ncur/=0) THEN
222 DO j=1,nfunct
223 IF(npc(nfunct+j+1)==ncur)ncurs=j
224 ENDDO
225 IF(ncurs==0)THEN
226 CALL ancmsg(msgid=154,anmode=aninfo,msgtype=msgerror,
227 . i2=ncur,i1=id,c1=titr)
228 ENDIF
229 ENDIF
230 igrv(3,k)=ncurs
231 igrv(4,k)=iad
232 igrv(5,k)=id
233 igrv(6,k)=isens
234 grav(1,k) = fcy
235 grav(2,k) = one/fcx
236 tsens=0
237 DO j=1,sensors%NSENSOR
238 IF(isens/=0) THEN
239 IF (igrv(6,k) == sensors%SENSOR_TAB(j)%SENS_ID) tsens=j
240 ENDIF
241 ENDDO
242 IF((tsens==0).AND.(igrv(6,k)/=0))THEN
243 CALL ancmsg(msgid=521,anmode=aninfo,msgtype=msgerror,
244 . i2=igrv(6,k),i1=id,c1=titr)
245 ENDIF
246 IF (noskew > 0) noskew = iskn(4,noskew)
247 WRITE (iout,3000) noskew,xyz(1:1),
248 . ncur,isens,fcx,fcy
249 WRITE (iout,'(10I10)') (itab(lgrav(j+iad-1)),j=1,nn)
250 iad=iad+nn
251 ENDDO
252C-----------
253 RETURN
254C-----------
255 2000 FORMAT(//
256 .' GRAVITY LOADS '/
257 .' ------------- '/
258 .' SKEW DIRECTION LOAD CURVE',
259 .' SENSOR SCALE_X SCALE_Y ')
260 3000 FORMAT(2x,i10,10x,a2,4x,i10,2x,i10,2x,1p2g20.13)
261C-----------
262 RETURN
263 END
my_real
#define my_real
Definition cppsort.cpp:32
remove_nd
subroutine remove_nd(nn, inn, itagnd)
Definition dim_s10edg.F:219
hm_get_floatv
subroutine hm_get_floatv(name, rval, is_available, lsubmodel, unitab)
Definition hm_get_floatv.F:415
hm_get_floatv_dim
subroutine hm_get_floatv_dim(name, dim_fac, is_available, lsubmodel, unitab)
Definition hm_get_floatv_dim.F:159
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_grav
subroutine hm_read_grav(igrv, lgrav, grav, itab, itabm1, igrnod, npc, sensors, unitab, iskn, itagnd, lsubmodel)
Definition hm_read_grav.F:47
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:410
min
#define min(a, b)
Definition macros.h:20
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::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
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:720
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
submodel_mod::submodel_data
Definition submodel_mod.F:723