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

Go to the source code of this file.

Functions/Subroutines

subroutine hm_read_cload (ibcl, forc, num, itab, itabm1, igrnod, nwork, unitab, iskn, lsubmodel, loads)

Function/Subroutine Documentation

◆ hm_read_cload()

subroutine hm_read_cload ( integer, dimension(nibcld,*) ibcl,
forc,
integer num,
integer, dimension(*) itab,
integer, dimension(*) itabm1,
type (group_), dimension(ngrnod) igrnod,
integer, dimension(*) nwork,
type (unit_type_), intent(in) unitab,
integer, dimension(liskn,*) iskn,
type(submodel_data), dimension(*), intent(in) lsubmodel,
type (loads_), intent(inout) loads )

Definition at line 43 of file hm_read_cload.F.

46C-----------------------------------------------
47C M o d u l e s
48C-----------------------------------------------
49 USE unitab_mod
50 USE r2r_mod
51 USE message_mod
52 USE groupdef_mod
53 USE submodel_mod
54 USE hm_option_read_mod
55 USE loads_mod
56 USE names_and_titles_mod , ONLY : nchartitle, ncharfield
57C-----------------------------------------------
58C I m p l i c i t T y p e s
59C-----------------------------------------------
60#include "implicit_f.inc"
61C-----------------------------------------------
62C C o m m o n B l o c k s
63C-----------------------------------------------
64#include "param_c.inc"
65#include "com01_c.inc"
66#include "com04_c.inc"
67#include "units_c.inc"
68#include "r2r_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 NUM
75 INTEGER IBCL(NIBCLD,*), ITAB(*), ITABM1(*),NWORK(*),
76 . ISKN(LISKN,*)
77 my_real forc(lfaccld,*)
78 TYPE(SUBMODEL_DATA),INTENT(IN)::LSUBMODEL(*)
79 TYPE (LOADS_),INTENT(INOUT) :: LOADS
80C-----------------------------------------------
81 TYPE (GROUP_) ,DIMENSION(NGRNOD) :: IGRNOD
82C-----------------------------------------------
83C L o c a l V a r i a b l e s
84C-----------------------------------------------
85 my_real
86 . fcx,fcy,fac_fcx,fac_fcy
87 INTEGER I,J,K,K1,K2,NOD, NCUR, NOSKEW, ISENS,NLD0,NN,IGU,IGS,
88 . UID,IAD,NS,IWA,ID,NUM0,IFLAGUNIT,COMPT,SUB_INDEX,IDIR,IFUNCTYPE
89 INTEGER NNB
90 CHARACTER MESS*40,X*1, Y*1, Z*1, XX*2, YY*2, ZZ*2
91 CHARACTER(LEN=NCHARFIELD) :: XYZ
92 CHARACTER(LEN=NCHARTITLE) :: TITR
93 LOGICAL IS_AVAILABLE
94C-----------------------------------------------
95C E x t e r n a l F u n c t i o n s
96C-----------------------------------------------
97 INTEGER NODGRNR5,NODGR_R2R
98 EXTERNAL nodgrnr5,nodgr_r2r
99C-----------------------------------------------
100C IBCL(NIBCLD,NUMCLD+NUMPRES), NUMCLD = Total nb of (cloads * nodes)
101C NUMPRES = Total nb of (ploads * segments)
102C IBCL(1:NIBCLD,1:NUMCLD) IPRES = IBCL(1:NIBCLD,NUMCCLD+1,NUMCLD+NUMPRES)
103C 1: Node Number 1st node number of the segment
104C 2: NS = 10*Noskew+Idir 2nd node number of the segment
105C 3: Function internal number 3rd node number of the segment
106C 4: -1 <=> CLOAD 4th node number of the segment
107C 5: UNUSED Function internal number
108C 6: ISENS Sensor User ID ISENS Sensor User ID
109C 7: User ID User ID
110C 9: Itypfun Function type
111C-----------------------------------------------
112C FORC(LFACCLD,NUMCLD+NUMPRES)
113C FORC(LFACCLD,NUMCLD) PRES = FORC(LFACCLD,NUMCLD+1:NUMCLD+NUMPRES)
114C 1: Fscale_y Fscale_y
115C 2: 1/Ascale_x 1/Ascale_x
116C 3 : UNUSED /=0 <=> Pinching pressure
117C=======================================================================
118 DATA x/'X'/
119 DATA y/'Y'/
120 DATA z/'Z'/
121 DATA xx/'XX'/
122 DATA yy/'YY'/
123 DATA zz/'ZZ'/
124 DATA mess/'CONCENTRATED LOADS DEFINITION '/
125C=======================================================================
126 is_available = .false.
127C
128 WRITE (iout,2000)
129 nld0=num
130 num=0
131 i=0
132 ifunctype=0
133C--------------------------------------------------
134C START BROWSING MODEL CLOAD
135C--------------------------------------------------
136 CALL hm_option_start('/CLOAD')
137C--------------------------------------------------
138C BROWSING MODEL PARTS 1->NLD0 (=NCONLD)
139C--------------------------------------------------
140 DO k=1,nld0
141 IF(nsubdom>0)THEN
142 IF(nncl(k)==0)cycle
143 END IF
144 titr = ''
145C--------------------------------------------------
146C EXTRACT DATAS OF /CLOAD/... LINE
147C--------------------------------------------------
148 CALL hm_option_read_key(lsubmodel,
149 . option_id = id,
150 . unit_id = uid,
151 . submodel_index = sub_index,
152 . option_titr = titr)
153C--------------------------------------------------
154C EXTRACT DATAS (STRING VALUES)
155C--------------------------------------------------
156 xyz = ''
157 CALL hm_get_string('rad_dir',xyz,ncharfield,is_available)
158C--------------------------------------------------
159C EXTRACT DATAS (INTEGER VALUES)
160C--------------------------------------------------
161 CALL hm_get_intv('curveid',ncur,is_available,lsubmodel)
162 CALL hm_get_intv('inputsystem',noskew,is_available,lsubmodel)
163 IF(noskew == 0 .AND. sub_index /= 0 ) noskew = lsubmodel(sub_index)%SKEW
164 CALL hm_get_intv('rad_sensor_id',isens,is_available,lsubmodel)
165 CALL hm_get_intv('entityid',igu,is_available,lsubmodel)
166 CALL hm_get_intv('Itypfun',ifunctype,is_available,lsubmodel)
167C--------------------------------------------------
168C EXTRACT DATAS (REAL VALUES)
169C--------------------------------------------------
170 CALL hm_get_floatv('xscale',fcx,is_available,lsubmodel,unitab)
171 CALL hm_get_floatv_dim('xscale',fac_fcx,is_available,lsubmodel,unitab)
172 CALL hm_get_floatv('magnitude',fcy,is_available,lsubmodel,unitab)
173 CALL hm_get_floatv_dim('magnitude',fac_fcy,is_available,lsubmodel,unitab)
174C--------------------------------------------------
175 iflagunit = 0
176 DO j=1,unitab%NUNITS
177 IF (unitab%UNIT_ID(j) == uid) THEN
178 iflagunit = 1
179 EXIT
180 ENDIF
181 ENDDO
182c
183 IF (uid/=0.AND.iflagunit==0) THEN
184 CALL ancmsg(msgid=659,anmode=aninfo,msgtype=msgerror,
185 . i2=uid,i1=id,c1='CONCENTRED LOAD',
186 . c2='CONCENTRED LOAD',
187 . c3=titr)
188 ENDIF
189 DO j=0,numskw+min(1,nspcond)*numsph+nsubmod
190 IF(noskew == iskn(4,j+1)) THEN
191 noskew=j+1
192 GO TO 100
193 ENDIF
194 ENDDO
195 CALL ancmsg(msgid=137,anmode=aninfo,msgtype=msgerror,
196 . c1='CONCENTRED LOAD',
197 . c2='CONCENTRED LOAD',
198 . i2=noskew,i1=id,c3=titr)
199 100 CONTINUE
200C
201 IF (fcx == zero) fcx = fac_fcx
202 IF (fcy == zero) fcy = fac_fcy
203 noskew=10*noskew
204 ns=0
205
206 idir = 0
207 IF(xyz(1:1)==x) idir=1
208 IF(xyz(1:1)==y) idir=2
209 IF(xyz(1:1)==z) idir=3
210 IF(xyz(1:2)==xx) idir=4
211 IF(xyz(1:2)==yy) idir=5
212 IF(xyz(1:2)==zz) idir=6
213
214 IF(idir == 1) ns=1+noskew
215 IF(idir == 2) ns=2+noskew
216 IF(idir == 3) ns=3+noskew
217 IF(idir == 4) ns=4+noskew
218 IF(idir == 5) ns=5+noskew
219 IF(idir == 6) ns=6+noskew
220
221
222 IF(idir == 0) THEN
223 CALL ancmsg(msgid=149,anmode=aninfo,msgtype=msgerror,
224 . c2=xyz,i1=id,c1=titr)
225 ENDIF
226 IF(idir >= 4) THEN
227 IF (iroddl==0) THEN
228 CALL ancmsg(msgid=845,anmode=aninfo,msgtype=msgerror,
229 . c2=xyz,i1=id,c1=titr)
230 END IF
231 END IF
232C !! IBCL ET NWORK ONT LA MEME ADRESSE
233 num0=num
234C-----------
235 IF (iddom==0) THEN
236 nn = nodgrnr5(igu ,igs ,nwork(1+nibcld*num0),igrnod ,
237 . itabm1 ,mess )
238 ELSE
239C-----------Multidomaines : on enleve les noeuds communs qui sont deja trait s dans le fomain full-------------
240 nn = nodgr_r2r(igu ,igs ,nwork(1+nibcld*num0),igrnod ,
241 . itabm1 ,mess )
242 ENDIF
243C-----------
244 IF (nn==0) THEN
245 CALL ancmsg(msgid=3026,
246 . anmode=aninfo,
247 . msgtype=msgerror,
248 . i1=id,
249 . c1=titr)
250 ENDIF
251 num=num+nn
252 DO j=nn,1,-1
253C !! IBCL ET NWORK ONT LA MEME ADRESSE
254C IBCL(1,I+J)=NWORK(J+6*NUM0)
255 nwork(1+nibcld*(j+i-1))=nwork(j+nibcld*num0)
256 ENDDO
257
258 IF(ifunctype == 0) ifunctype = 1 ! Abscissa function is time (by default)
259 ! IFUNCTYPE = 2 ! Abscissa function is nodal displacement
260 ! IFUNCTYPE = 3 ! Abscissa function is nodal velocity
261
262 DO j=1,nn
263 i=i+1
264 ibcl(2,i) = ns
265 ibcl(3,i) = ncur
266 ibcl(4,i) = -1
267 ibcl(6,i) = isens
268 ibcl(7,i) = 0
269 ibcl(8,i) = 0
270 ibcl(9,i) = ifunctype
271 forc(1,i) = fcy
272 forc(2,i) = one/fcx
273 IF (idir <= 3) THEN
274 WRITE (iout,'(I10,2X,I10,5X,A,2X,I10,2X,I10,2X,
275 . 1PG20.13,2X,1PG20.13)')
276 . itab(ibcl(1,i)),iskn(4,noskew/10),xyz(1:1),
277 . ibcl(3,i),isens,fcx,fcy
278 ELSEIF (idir <= 6) THEN
279 WRITE (iout,'(I10,2X,I10,4X,A2,2X,I10,2X,I10,2X,
280 . 1PG20.13,2X,1PG20.13)')
281 . itab(ibcl(1,i)),iskn(4,noskew/10),xyz(1:2),
282 . ibcl(3,i),isens,fcx,fcy
283 ENDIF
284 ENDDO
285 ENDDO
286C----
287 loads%NLOAD_CLOAD = num
288C----
289 2000 FORMAT(//
290 .' CONCENTRATED LOADS '/
291 .' ------------------ '/
292 .' NODE SKEW DIR LOAD_CURVE SENSOR',
293 .' SCALE_X SCALE_Y')
294 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_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_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:410
min
#define min(a, b)
Definition macros.h:20
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::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
r2r_mod
Definition r2r_mod.F:125
r2r_mod::nncl
integer, dimension(:), allocatable nncl
Definition r2r_mod.F:131
submodel_mod
Definition submodel_mod.F:712
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:720
unitab_mod
Definition unitab_mod.F:513
nodgr_r2r
integer function nodgr_r2r(igu, igs, ibuf, igrnod, itabm1, mess)
Definition routines_r2r.F:174
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
nodgrnr5
integer function nodgrnr5(igu, igs, ibuf, igrnod, itabm1, mess)
Definition freform.F:303