OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
inter_dcod_function.F File Reference
#include "implicit_f.inc"
#include "com04_c.inc"
#include "scr17_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine inter_dcod_function (ntyp, ni, ipari, npc1, nom_opt, npc, pld)

Function/Subroutine Documentation

◆ inter_dcod_function()

subroutine inter_dcod_function ( integer ntyp,
integer ni,
integer, dimension(*) ipari,
integer, dimension(*) npc1,
integer, dimension(lnopt1,*) nom_opt,
integer, dimension(*) npc,
pld )

Definition at line 37 of file inter_dcod_function.F.

38C-----------------------------------------------
39C DECODE USER NUMBERS
40C-----------------------------------------------
41C M o d u l e s
42C-----------------------------------------------
43 USE message_mod
44 USE intstamp_mod
45 USE table_mod
46 USE names_and_titles_mod , ONLY : nchartitle
47C-----------------------------------------------
48C I m p l i c i t T y p e s
49C-----------------------------------------------
50#include "implicit_f.inc"
51C-----------------------------------------------
52C C o m m o n B l o c k s
53C-----------------------------------------------
54#include "com04_c.inc"
55#include "scr17_c.inc"
56C-----------------------------------------------
57C D u m m y A r g u m e n t s
58C-----------------------------------------------
59 INTEGER NTYP, NI
60 INTEGER NPC1(*),IPARI(*),NOM_OPT(LNOPT1,*),NPC(*)
61 my_real pld(*)
62
63C-----------------------------------------------
64C L o c a l V a r i a b l e s
65C-----------------------------------------------
66 INTEGER I,J,ID,OK,FCOND,FCOND0,PN1,PN2,JJ
67 my_real cmax,cmin
68 CHARACTER(LEN=NCHARTITLE) :: TITR
69C DATA IUN/1/
70C
71C=======================================================================
72C
73 id = nom_opt(1,ni)
74 CALL fretitl2(titr,nom_opt(lnopt1-ltitr+1,ni),ltitr)
75C
76C---------------------------------------------------------
77C FUNCTIONS IN INTERFACES
78C---------------------------------------------------------
79
80c
81C---------------------------------------------------------
82 IF (ntyp == 7.OR.ntyp==21) THEN
83
84C Inter type 7 , 21 : function friction/temperature
85C---------------------------------------------------------
86 ok = 0
87 IF (ipari(50) > 0) THEN
88 DO j=1,nfunct
89 IF(ipari(50) == npc1(j)) THEN
90 ipari(50)=j
91 ok = 1
92 EXIT
93 ENDIF
94 ENDDO
95 IF (ok == 0) THEN
96 CALL ancmsg(msgid=127,
97 . msgtype=msgerror,
98 . anmode=aninfo_blind_1,
99 . i1=id,
100 . c1=titr,
101 . i2=ipari(50))
102 ENDIF
103 ENDIF
104
105C Inter type 7 , 21 : function conduvity/Pressure
106C---------------------------------------------------------
107 ok = 0
108 IF (ipari(42) > 0) THEN
109 DO j=1,nfunct
110 IF(ipari(42) == npc1(j)) THEN
111 ipari(42)=j
112 ok = 1
113 EXIT
114 ENDIF
115 ENDDO
116 IF (ok == 0) THEN
117 CALL ancmsg(msgid=127,
118 . msgtype=msgerror,
119 . anmode=aninfo_blind_1,
120 . i1=id,
121 . c1=titr,
122 . i2=ipari(42))
123 ENDIF
124 ENDIF
125
126C Inter type 21 : function conduvity/Distance
127C---------------------------------------------------------
128 ok = 0
129 fcond0 = ipari(53)
130 IF (ipari(53) > 0) THEN
131 DO j=1,nfunct
132 IF(ipari(53) == npc1(j)) THEN
133 ipari(53)=j
134 ok = 1
135 EXIT
136 ENDIF
137 ENDDO
138 IF (ok == 0) THEN
139 CALL ancmsg(msgid=127,
140 . msgtype=msgerror,
141 . anmode=aninfo_blind_1,
142 . i1=id,
143 . c1=titr,
144 . i2=ipari(53))
145 ENDIF
146C
147 fcond = ipari(53)
148
149 pn1 = npc(fcond)
150 pn2 = npc(fcond+1)
151 cmax = pld(pn1+1)
152 cmin = pld(pn1+1)
153 DO jj = pn1+2,pn2-2,2
154 IF(pld(jj+1) > cmax.AND.pld(jj)<=one.AND.pld(jj)>=zero) THEN
155 cmax=pld(jj+1)
156 ENDIF
157 IF(pld(jj+1) < cmin.AND.pld(jj)<=one.AND.pld(jj)>=zero) THEN
158 cmin=pld(jj+1)
159 ENDIF
160
161 ENDDO
162 IF(cmin < zero.OR.cmax > one) THEN
163 CALL ancmsg(msgid=1811,
164 . msgtype=msgerror,
165 . anmode=aninfo_blind_1,
166 . i1=id,
167 . c1=titr,
168 . i2=fcond0)
169 ENDIF
170
171
172 ENDIF
173 ENDIF
174
175c
176C---------------------------------------------------------
177 IF (ntyp == 25.AND.ipari(47) > 0) THEN
178
179
180C Function conduvity/Pressure
181C---------------------------------------------------------
182 ok = 0
183 IF (ipari(92) > 0) THEN
184 DO j=1,nfunct
185 IF(ipari(92) == npc1(j)) THEN
186 ipari(92)=j
187 ok = 1
188 EXIT
189 ENDIF
190 ENDDO
191 IF (ok == 0) THEN
192 CALL ancmsg(msgid=127,
193 . msgtype=msgerror,
194 . anmode=aninfo_blind_1,
195 . i1=id,
196 . c1=titr,
197 . i2=ipari(92))
198 ENDIF
199 ENDIF
200
201C function friction/temperature
202C---------------------------------------------------------
203 ok = 0
204 IF (ipari(50) > 0) THEN
205 DO j=1,nfunct
206 IF(ipari(50) == npc1(j)) THEN
207 ipari(50)=j
208 ok = 1
209 EXIT
210 ENDIF
211 ENDDO
212 IF (ok == 0) THEN
213 CALL ancmsg(msgid=127,
214 . msgtype=msgerror,
215 . anmode=aninfo_blind_1,
216 . i1=id,
217 . c1=titr,
218 . i2=ipari(50))
219 ENDIF
220 ENDIF
221
222
223C Inter type 25 : function conduvity/Distance
224C---------------------------------------------------------
225 ok = 0
226 fcond0 = ipari(93)
227 IF (ipari(93) > 0) THEN
228 DO j=1,nfunct
229 IF(ipari(93) == npc1(j)) THEN
230 ipari(93)=j
231 ok = 1
232 EXIT
233 ENDIF
234 ENDDO
235 IF (ok == 0) THEN
236 CALL ancmsg(msgid=127,
237 . msgtype=msgerror,
238 . anmode=aninfo_blind_1,
239 . i1=id,
240 . c1=titr,
241 . i2=ipari(93))
242 ENDIF
243C
244 fcond = ipari(93)
245
246 pn1 = npc(fcond)
247 pn2 = npc(fcond+1)
248 cmax = pld(pn1+1)
249 cmin = pld(pn1+1)
250 DO jj = pn1+2,pn2-2,2
251 IF(pld(jj+1) > cmax.AND.pld(jj)<=one.AND.pld(jj)>=zero) THEN
252 cmax=pld(jj+1)
253 ENDIF
254 IF(pld(jj+1) < cmin.AND.pld(jj)<=one.AND.pld(jj)>=zero) THEN
255 cmin=pld(jj+1)
256 ENDIF
257
258 ENDDO
259 IF(cmin < zero.OR.cmax > one) THEN
260 CALL ancmsg(msgid=1811,
261 . msgtype=msgerror,
262 . anmode=aninfo_blind_1,
263 . i1=id,
264 . c1=titr,
265 . i2=fcond0)
266 ENDIF
267
268
269 ENDIF
270 ENDIF
271
272 RETURN
273C-----
my_real
#define my_real
Definition cppsort.cpp:32
id
initmumps id
Definition multiplerhs_example.m:4
intstamp_mod
Definition intstamp_mod.F:38
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
table_mod
Definition table_mod.F:112
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
fretitl2
subroutine fretitl2(titr, iasc, l)
Definition freform.F:804