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

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_grav (igrv, lgrav, grav, itab, itabm1, igrnod, npc, sensors, unitab, iskn, itagnd, lsubmodel)

Function/Subroutine Documentation

◆ hm_read_grav()

subroutine hm_read_grav ( integer, dimension(nigrv,ngrav) igrv,
integer, dimension(*) lgrav,
grav,
integer, dimension(*) itab,
integer, dimension(*) itabm1,
type (group_), dimension(ngrnod) igrnod,
integer, dimension(*) npc,
type (sensors_), intent(in) sensors,
type (unit_type_), intent(in) unitab,
integer, dimension(liskn,*) iskn,
integer, dimension(*) itagnd,
type(submodel_data), dimension(nsubmod), intent(in) lsubmodel )

Definition at line 44 of file hm_read_grav.F.

47C-----------------------------------------------
48C M o d u l e s
49C-----------------------------------------------
50 USE unitab_mod
51 USE message_mod
52 USE groupdef_mod
55 USE sensor_mod
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(*)
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.AND. IF(NOSKEW == 0 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.AND. IF (UID/=0IFLAGUNIT==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.AND. IF((TSENS==0)(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
#define my_real
Definition cppsort.cpp:32
integer, parameter nchartitle
integer, parameter ncharfield
integer nsubmod
integer function nodgrnr5(igu, igs, ibuf, igrnod, itabm1, mess)
Definition freform.F:298
integer function usr2sys(iu, itabm1, mess, id)
Definition sysfus.F:146