OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
hm_read_mpc.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_mpc ../starter/source/constraints/general/mpc/hm_read_mpc.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../starter/source/starter/lectur.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../starter/source/output/message/message.F
29!|| fretitl ../starter/source/starter/freform.f
30!|| hm_get_float_array_index ../starter/source/devtools/hm_reader/hm_get_float_array_index.f
31!|| hm_get_int_array_index ../starter/source/devtools/hm_reader/hm_get_int_array_index.F
32!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.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!|| hm_sz_r2r ../starter/source/coupling/rad2rad/routines_r2r.F
36!|| ifrontplus ../starter/source/spmd/node/frontplus.F
37!|| kinset ../starter/source/constraints/general/kinset.F
38!|| usr2sys ../starter/source/system/sysfus.F
39!||--- uses -----------------------------------------------------
40!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
41!|| message_mod ../starter/share/message_module/message_mod.F
42!|| r2r_mod ../starter/share/modules1/r2r_mod.F
43!|| submodel_mod ../starter/share/modules1/submodel_mod.F
44!||====================================================================
45 SUBROUTINE hm_read_mpc(RBUF ,IBUFNC ,IBUFNN ,IBUFDL ,IBUFSK ,
46 2 ISKN ,ITAB ,ITABM ,LAG_NCF ,LAG_NKF ,
47 3 LAG_NHF,IKINE ,IKINE1LAG,NOM_OPT,ITAGND ,
48 4 LSUBMODEL,UNITAB)
49C-----------------------------------------------
50 USE r2r_mod
51 USE message_mod
52 USE submodel_mod
53 USE hm_option_read_mod
54 USE unitab_mod
55 USE names_and_titles_mod , ONLY : nchartitle, ncharkey
56C-----------------------------------------------
57C I m p l i c i t T y p e s
58C-----------------------------------------------
59#include "implicit_f.inc"
60C-----------------------------------------------
61C C o m m o n B l o c k s
62C-----------------------------------------------
63#include "scr17_c.inc"
64#include "com04_c.inc"
65#include "sphcom.inc"
66#include "param_c.inc"
67#include "units_c.inc"
68#include "r2r_c.inc"
69C-----------------------------------------------
70C D u m m y A r g u m e n t s
71C-----------------------------------------------
72 INTEGER LAG_NCF, LAG_NKF, LAG_NHF, ITAB(*), ITABM(*),
73 . ISKN(LISKN,*),IBUFNC(*),IBUFNN(*),IBUFDL(*),IBUFSK(*),
74 . IKINE(*),IKINE1LAG(*),ITAGND(*)
75 my_real :: rbuf(*)
76 INTEGER NOM_OPT(LNOPT1,*)
77 TYPE(UNIT_TYPE_),INTENT(IN) ::UNITAB
78 TYPE(submodel_data), DIMENSION(*),INTENT(IN) :: LSUBMODEL
79C-----------------------------------------------
80C L o c a l V a r i a b l e s
81C-----------------------------------------------
82 INTEGER I, II, J, ID, NOD, IDDL, ISKW, NUMC, KF, NOSYS, NMP
83 my_real COEF
84 CHARACTER(LEN=NCHARTITLE) :: TITR
85 CHARACTER(LEN=NCHARKEY) :: KEY
86 CHARACTER :: MESS*40
87 DATA mess/'MULTI-POINT CONSTRAINTS '/
88 LOGICAL IS_AVAILABLE
89C-----------------------------------------------
90C E x t e r n a l F u n c t i o n s
91C-----------------------------------------------
92 INTEGER USR2SYS
93C======================================================================|
94 WRITE(IOUT,1000)
95
96 is_available = .false.
97C
98 CALL hm_option_start('/MPC')
99C
100 kf = 0
101 nmp = 0
102 DO i=1,nummpc
103 nmp=nmp+1
104C----------Multidomaines --> on ignore les mpc non tages----------
105 IF(nsubdom>0)THEN
106 IF(tagmpc(nmp)==0)CALL hm_sz_r2r(tagmpc,nmp,lsubmodel)
107 END IF
108C-----------------------------------------------------------------
109 CALL hm_option_read_key(lsubmodel,
110 . option_id = id,
111 . option_titr = titr,
112 . keyword2 = key)
113
114 nom_opt(1,i)=id
115 CALL fretitl(titr,nom_opt(lnopt1-ltitr+1,i),ltitr)
116C
117 CALL hm_get_intv('number_of_nodes',numc,is_available,lsubmodel)
118 DO ii=1,numc
119 CALL hm_get_int_array_index('node_ID',nod,ii,is_available,lsubmodel)
120 CALL hm_get_int_array_index('Idof',iddl,ii,is_available,lsubmodel)
121 CALL hm_get_int_array_index('skew_ID',iskw,ii,is_available,lsubmodel)
122 CALL hm_get_float_array_index('alpha',coef,ii,is_available,lsubmodel,unitab)
123 kf = kf + 1
124 IF (coef==zero) coef = one
125 rbuf(kf) = coef
126 nosys = usr2sys(nod,itabm,mess,id)
127 IF (ns10e>0) THEN
128 IF(itagnd(nosys)/=0) THEN
129C------- error out
130 CALL ancmsg(msgid=1208,
131 . msgtype=msgerror,
132 . anmode=aninfo_blind_1,
133 . i1=itab(nosys),
134 . c1='MPC ',
135 . i2=id,
136 . c2='MPC ')
137 ENDIF
138 END IF
139 CALL kinset(512,itab(nosys),ikine(nosys),7,0,ikine1lag(nosys))
140 ibufnn(kf) = nosys
141 CALL ifrontplus(nosys,1)
142 ibufdl(kf) = iddl
143 ibufsk(kf) = 0
144 DO j=0,numskw+min(1,nspcond)*numsph+nsubmod
145 IF(iskw==iskn(4,j+1)) THEN
146 ibufsk(kf) = j+1
147 GO TO 10
148 ENDIF
149 ENDDO
150 CALL ancmsg(msgid=137,anmode=aninfo,msgtype=msgerror,
151 . c1='MPC',
152 . c2='MPC',
153 . i1=id,i2=iskw,c3=titr)
154 10 CONTINUE
155 IF (iskw==0) THEN
156 lag_nkf = lag_nkf + 1
157 ELSE
158 lag_nkf = lag_nkf + 3
159 ENDIF
160 ENDDO
161 ibufnc(i) = numc
162 WRITE(iout,1101) id,numc
163 WRITE(iout,1102) (itab(ibufnn(j)),ibufdl(j),iskn(4,ibufsk(j)),rbuf(j),
164 . j=kf-numc+1,kf)
165 ENDDO
166C---
167 lag_nhf = lag_nhf + nummpc*(nummpc-1)
168 lag_ncf = lag_ncf + nummpc
169C---
170 RETURN
171 1000 FORMAT(//
172 .' MULTI-POINT CONSTRAINTS '/
173 . ' ---------------------- ')
174 1101 FORMAT( 10x,'MPC ID. . . . . . . . . . . . . .',i10
175 . /10x,'NUMBER OF POINTS. . . . . . . . .',i10
176 . /10x,'constraint list :'
177 . /5X, ' node ddl skew coefficient'/)
178 1102 FORMAT( 3I10,1PG20.13/)
179C---
180 RETURN
181 END
182
183
184!||====================================================================
185!|| hm_read_mpc0 ../starter/source/constraints/general/mpc/hm_read_mpc.F
186!||--- called by ------------------------------------------------------
187!|| lectur ../starter/source/starter/lectur.F
188!||--- calls -----------------------------------------------------
189!|| hm_get_intv ../starter/source/devtools/hm_reader/hm_get_intv.F
190!|| hm_option_read_key ../starter/source/devtools/hm_reader/hm_option_read_key.F
191!|| hm_option_start ../starter/source/devtools/hm_reader/hm_option_start.F
192!||--- uses -----------------------------------------------------
193!|| hm_option_read_mod ../starter/share/modules1/hm_option_read_mod.F
194!|| submodel_mod ../starter/share/modules1/submodel_mod.F
195!||====================================================================
196 SUBROUTINE HM_READ_MPC0 (LEN, LSUBMODEL)
197C-----------------------------------------------
198 USE SUBMODEL_MOD
199 USE HM_OPTION_READ_MOD
200 USE NAMES_AND_TITLES_MOD , ONLY : NCHARTITLE
201C-----------------------------------------------
202C I m p l i c i t T y p e s
203C-----------------------------------------------
204#include "implicit_f.inc"
205C-----------------------------------------------
206C C o m m o n B l o c k s
207C-----------------------------------------------
208#include "param_c.inc"
209C-----------------------------------------------
210C D u m m y A r g u m e n t s
211C-----------------------------------------------
212 INTEGER LEN
213 TYPE(SUBMODEL_DATA), DIMENSION(*) ,INTENT(IN) :: LSUBMODEL
214C-----------------------------------------------
215C L o c a l V a r i a b l e s
216C-----------------------------------------------
217 INTEGER I, ID, NUMC
218 CHARACTER(LEN=NCHARTITLE) :: TITR
219 LOGICAL IS_AVAILABLE
220C======================================================================|
221 IS_AVAILABLE = .FALSE.
222C
223 ! Start reading /MPC card
224 CALL HM_OPTION_START('/mpc')
225
226 LEN = 0
227 DO I=1,NUMMPC
228 CALL HM_OPTION_READ_KEY(LSUBMODEL,
229 . OPTION_ID = ID,
230 . OPTION_TITR = TITR)
231C
232 CALL HM_GET_INTV('number_of_nodes',NUMC,IS_AVAILABLE,LSUBMODEL)
233 LEN = LEN+NUMC
234 ENDDO
235C---
236 RETURN
237 END
my_real
#define my_real
Definition cppsort.cpp:32
freform
subroutine freform(irunn, irfl, irfe, h3d_data, flag_cst_ams, dynain_data, sensors, dt, output, glob_therm)
Definition freform.F:88
ifrontplus
subroutine ifrontplus(n, p)
Definition frontplus.F:100
hm_get_float_array_index
subroutine hm_get_float_array_index(name, rval, index, is_available, lsubmodel, unitab)
Definition hm_get_float_array_index.F:105
hm_get_int_array_index
subroutine hm_get_int_array_index(name, ival, index, is_available, lsubmodel)
Definition hm_get_int_array_index.F:164
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_read_mpc
subroutine hm_read_mpc(rbuf, ibufnc, ibufnn, ibufdl, ibufsk, iskn, itab, itabm, lag_ncf, lag_nkf, lag_nhf, ikine, ikine1lag, nom_opt, itagnd, lsubmodel, unitab)
Definition hm_read_mpc.F:49
hm_option_read_mod::hm_option_read_key
Definition hm_option_read_mod.F:410
kinset
subroutine kinset(ik, node, ikine, idir, isk, ikine1)
Definition kinset.F:57
min
#define min(a, b)
Definition macros.h:20
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::ncharkey
integer, parameter ncharkey
Definition names_and_titles_mod.F:1000
r2r_mod
Definition r2r_mod.F:125
r2r_mod::tagmpc
integer, dimension(:), allocatable tagmpc
Definition r2r_mod.F:140
submodel_mod
Definition submodel_mod.F:712
submodel_mod::nsubmod
integer nsubmod
Definition submodel_mod.F:720
unitab_mod
Definition unitab_mod.F:513
hm_sz_r2r
subroutine hm_sz_r2r(tag, val, lsubmodel)
Definition routines_r2r.F:300
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
fretitl
subroutine fretitl(titr, iasc, l)
Definition freform.F:620
starter
program starter
Definition starter.F:39
submodel_mod::submodel_data
Definition submodel_mod.F:723