OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_cload.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_cload ../starter/source/loads/general/cload/hm_read_cload.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!|| nodgr_r2r ../starter/source/coupling/rad2rad/routines_r2r.F
36!|| nodgrnr5 ../starter/source/starter/freform.F
37!||--- uses -----------------------------------------------------
38!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
39!|| message_mod ../starter/share/message_module/message_mod.F
40!|| r2r_mod ../starter/share/modules1/r2r_mod.F
41!|| submodel_mod ../starter/share/modules1/submodel_mod.F
42!||====================================================================
43 SUBROUTINE hm_read_cload(IBCL ,FORC ,NUM ,ITAB ,ITABM1 ,
44 . IGRNOD ,NWORK ,UNITAB ,ISKN ,LSUBMODEL,
45 . LOADS )
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.AND. IF(NOSKEW == 0 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.AND. IF (UID/=0IFLAGUNIT==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
295 END
my_real
#define my_real
Definition cppsort.cpp:32
hm_read_cload
subroutine hm_read_cload(ibcl, forc, num, itab, itabm1, igrnod, nwork, unitab, iskn, lsubmodel, loads)
Definition hm_read_cload.F:46
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
submodel_mod
Definition submodel_mod.F:712
unitab_mod
Definition unitab_mod.F:513
starter
program starter
Definition starter.F:39