OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sms_rgwal0.F File Reference
#include "implicit_f.inc"
#include "comlock.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "impl1_c.inc"
#include "param_c.inc"
#include "task_c.inc"
#include "sms_c.inc"
#include "com08_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine sms_rgwal_0 (iflag, x, v, rwbuf, lprw, nprw, ms, fsav, fr_wall, fopt, rwsav, weight, irwl_work, nrwl_sms, frwl6, a, res, r, frea, wfext)
subroutine sms_rgwalt (msr, rwl, frwl6, pmain, fsav, fopt)

Function/Subroutine Documentation

◆ sms_rgwal_0()

subroutine sms_rgwal_0 ( integer iflag,
x,
v,
rwbuf,
integer, dimension(*) lprw,
integer, dimension(*) nprw,
ms,
fsav,
integer, dimension(nspmd+2,*) fr_wall,
fopt,
rwsav,
integer, dimension(*) weight,
integer, dimension(*) irwl_work,
integer, dimension(*) nrwl_sms,
double precision, dimension(7,6,nrwall) frwl6,
a,
res,
r,
frea,
double precision, intent(inout) wfext )

Definition at line 53 of file sms_rgwal0.F.

57C-----------------------------------------------
58C I m p l i c i t T y p e s
59C-----------------------------------------------
60#include "implicit_f.inc"
61#include "comlock.inc"
62C-----------------------------------------------
63C C o m m o n B l o c k s
64C-----------------------------------------------
65#include "com01_c.inc"
66#include "com04_c.inc"
67#include "impl1_c.inc"
68#include "param_c.inc"
69#include "task_c.inc"
70#include "sms_c.inc"
71C-----------------------------------------------
72C D u m m y A r g u m e n t s
73C-----------------------------------------------
74 INTEGER LPRW(*), NPRW(*), FR_WALL(NSPMD+2,*), WEIGHT(*),IRWL_WORK(*), NRWL_SMS(*), IFLAG
75 my_real x(3,*), v(3,*),rwbuf(nrwlp,*),rwsav(*),ms(*),fsav(nthvki,*), fopt(6,*),a(3,*), res(3,*), r(3,*), frea(3,*)
76 DOUBLE PRECISION FRWL6(7,6,NRWALL)
77 DOUBLE PRECISION,INTENT(INOUT) :: WFEXT
78C-----------------------------------------------
79C L o c a l V a r i a b l e s
80C-----------------------------------------------
81 INTEGER K, N, ITYP, ISL, IFQ, N2, N3, N4, N5, N6, N7, N8, L, M,PMAIN, NSMS, KIND(NRWALL), ISLIND(NRWALL)
82C-----------------------------------------------
83 isl = 1
84 k=1
85C
86C Pre calcul index
87C
88 DO n = 1, nrwall
89 kind(n) = k
90 islind(n) = isl
91C
92 n2=n +nrwall
93 n3=n2+nrwall
94 n4=n3+nrwall
95 n5=n4+nrwall
96 n6=n5+nrwall
97C
98 k=k+nprw(n)
99 ifq = nint(rwbuf(15,n))
100 IF (ifq>0) isl=isl+nprw(n)*3
101 IF(nprw(n4)==-1)k=k+nint(rwbuf(8,n))
102 END DO
103C
104
105 SELECT CASE (iflag)
106
107 CASE(0)
108 ifricw=0
109C
110 CALL my_barrier
111C
112!$OMP DO SCHEDULE(DYNAMIC,1)
113 DO n=1,nrwall
114 k = kind(n)
115 isl = islind(n)
116C
117 n2=n +nrwall
118 n3=n2+nrwall
119 n4=n3+nrwall
120 n5=n4+nrwall
121 n6=n5+nrwall
122 n7=n6+nrwall
123 n8=n7+nrwall
124C
125 ityp= nprw(n4)
126C
127 nsms= nprw(n7)
128 IF(ityp==1.AND.nsms/=0)THEN
129 CALL sms_rgwall_impact(
130 + x ,a ,v ,rwbuf(1,n),lprw(k),
131 + nprw(n) ,nprw(n2) ,nprw(n3) ,ms ,weight ,
132 + rwsav(isl),nprw(n8),irwl_work(k),nsms ,nrwl_sms(k))
133 ELSEIF(ityp==2.AND.nsms/=0)THEN
134 CALL sms_rgwalc_impact(
135 + x ,a ,v ,rwbuf(1,n),lprw(k),
136 + nprw(n) ,nprw(n2) ,nprw(n3) ,ms ,weight ,
137 + nprw(n8),irwl_work(k),nsms ,nrwl_sms(k))
138 ELSEIF(ityp==3.AND.nsms/=0)THEN
139 CALL sms_rgwals_impact(
140 + x ,a ,v ,rwbuf(1,n),lprw(k),
141 + nprw(n) ,nprw(n2) ,nprw(n3) ,ms ,weight ,
142 + nprw(n8),irwl_work(k),nsms ,nrwl_sms(k))
143 ELSEIF(ityp==4.AND.nsms/=0)THEN
144 CALL sms_rgwalp_impact(
145 + x ,a ,v ,rwbuf(1,n),lprw(k),
146 + nprw(n) ,nprw(n2) ,nprw(n3) ,ms ,weight ,
147 + nprw(n8),irwl_work(k),nsms ,nrwl_sms(k))
148 ENDIF
149 END DO
150!$OMP END DO
151!$OMP SINGLE
152 IF(nspmd > 1) CALL spmd_allglob_isum9(ifricw,1)
153!$OMP END SINGLE
154C
155C set A=-V/dt (A is an acceleration)
156 CASE(1)
157!$OMP DO SCHEDULE(DYNAMIC,1)
158 DO n=1,nrwall
159 k = kind(n)
160 isl = islind(n)
161C
162 n2=n +nrwall
163 n3=n2+nrwall
164 n4=n3+nrwall
165 n5=n4+nrwall
166 n6=n5+nrwall
167 n7=n6+nrwall
168 n8=n7+nrwall
169C
170 ityp= nprw(n4)
171C
172 nsms= nprw(n7)
173 IF(ityp==1.AND.nsms/=0)THEN
174 CALL sms_rgwall_bcs_0(
175 + x ,a ,v ,rwbuf(1,n),lprw(k),
176 + nprw(n) ,nprw(n2) ,nprw(n3) ,ms ,weight ,
177 + rwsav(isl),nprw(n8),irwl_work(k),nsms ,nrwl_sms(k))
178 ELSEIF(ityp==2.AND.nsms/=0)THEN
179 CALL sms_rgwalc_bcs_0(
180 + x ,a ,v ,rwbuf(1,n),lprw(k),
181 + nprw(n) ,nprw(n2) ,nprw(n3) ,ms ,weight ,
182 + nprw(n8),irwl_work(k),nsms ,nrwl_sms(k) )
183 ELSEIF(ityp==3.AND.nsms/=0)THEN
184 CALL sms_rgwals_bcs_0(
185 + x ,a ,v ,rwbuf(1,n),lprw(k),
186 + nprw(n) ,nprw(n2) ,nprw(n3) ,ms ,weight ,
187 + nprw(n8),irwl_work(k),nsms ,nrwl_sms(k))
188 ELSEIF(ityp==4.AND.nsms/=0)THEN
189 CALL sms_rgwalp_bcs_0(
190 + x ,a ,v ,rwbuf(1,n),lprw(k),
191 + nprw(n) ,nprw(n2) ,nprw(n3) ,ms ,weight ,
192 + nprw(n8),irwl_work(k),nsms ,nrwl_sms(k))
193 ENDIF
194 END DO
195!$OMP END DO
196C
197C set RES=0
198 CASE(2)
199!$OMP DO SCHEDULE(DYNAMIC,1)
200 DO n=1,nrwall
201 k = kind(n)
202 isl = islind(n)
203C
204 n2=n +nrwall
205 n3=n2+nrwall
206 n4=n3+nrwall
207 n5=n4+nrwall
208 n6=n5+nrwall
209 n7=n6+nrwall
210 n8=n7+nrwall
211C
212 ityp= nprw(n4)
213C
214 nsms= nprw(n7)
215 IF(ityp==1.AND.nsms/=0)THEN
216 CALL sms_rgwall_bcs_1(
217 + x ,res ,v ,rwbuf(1,n),lprw(k),
218 + nprw(n) ,nprw(n2) ,nprw(n3) ,ms ,weight ,
219 + rwsav(isl),nprw(n8),irwl_work(k),nsms ,nrwl_sms(k))
220 ELSEIF(ityp==2.AND.nsms/=0)THEN
221 CALL sms_rgwalc_bcs_1(
222 + x ,res ,v ,rwbuf(1,n),lprw(k),
223 + nprw(n) ,nprw(n2) ,nprw(n3) ,ms ,weight ,
224 + nprw(n8),irwl_work(k),nsms ,nrwl_sms(k))
225 ELSEIF(ityp==3.AND.nsms/=0)THEN
226 CALL sms_rgwals_bcs_1(
227 + x ,res ,v ,rwbuf(1,n),lprw(k),
228 + nprw(n) ,nprw(n2) ,nprw(n3) ,ms ,weight ,
229 + nprw(n8),irwl_work(k),nsms , nrwl_sms(k))
230 ELSEIF(ityp==4.AND.nsms/=0)THEN
231 CALL sms_rgwalp_bcs_1(
232 + x ,res ,v ,rwbuf(1,n),lprw(k),
233 + nprw(n) ,nprw(n2) ,nprw(n3) ,ms ,weight ,
234 + nprw(n8),irwl_work(k),nsms ,nrwl_sms(k))
235 ENDIF
236 END DO
237!$OMP END DO
238C
239C friction force
240 CASE(3)
241!$OMP DO SCHEDULE(DYNAMIC,1)
242 DO n=1,nrwall
243 k = kind(n)
244 isl = islind(n)
245C
246 n2=n +nrwall
247 n3=n2+nrwall
248 n4=n3+nrwall
249 n5=n4+nrwall
250 n6=n5+nrwall
251 n7=n6+nrwall
252 n8=n7+nrwall
253C
254 ityp= nprw(n4)
255C
256 nsms= nprw(n7)
257 IF(ityp==1.AND.nsms/=0)THEN
258 CALL sms_rgwall_fric(
259 + x ,a ,v ,rwbuf(1,n),lprw(k),
260 + nprw(n) ,nprw(n2) ,nprw(n3) ,ms ,weight ,
261 + rwsav(isl),nprw(n8),irwl_work(k),nsms ,nrwl_sms(k),
262 + fsav(1,n),fopt(1,n),res ,r ,frea )
263 ELSEIF(ityp==2.AND.nsms/=0)THEN
264 CALL sms_rgwalc_fric(
265 + x ,a ,v ,rwbuf(1,n),lprw(k),
266 + nprw(n) ,nprw(n2) ,nprw(n3) ,ms ,weight ,
267 + nprw(n8),irwl_work(k),nsms ,nrwl_sms(k),fsav(1,n),
268 + fopt(1,n),res ,r ,frea )
269 ELSEIF(ityp==3.AND.nsms/=0)THEN
270 CALL sms_rgwals_fric(
271 + x ,a ,v ,rwbuf(1,n),lprw(k),
272 + nprw(n) ,nprw(n2) ,nprw(n3) ,ms ,weight ,
273 + nprw(n8),irwl_work(k),nsms ,nrwl_sms(k),fsav(1,n),
274 + fopt(1,n),res ,r ,frea )
275 ELSEIF(ityp==4.AND.nsms/=0)THEN
276 CALL sms_rgwalp_fric(
277 + x ,a ,v ,rwbuf(1,n),lprw(k),
278 + nprw(n) ,nprw(n2) ,nprw(n3) ,ms ,weight ,
279 + nprw(n8),irwl_work(k),nsms ,nrwl_sms(k),fsav(1,n),
280 + fopt(1,n),res ,r ,frea )
281 ENDIF
282 END DO
283!$OMP END DO
284C
285C save reaction force
286 CASE(4)
287!$OMP DO SCHEDULE(DYNAMIC,1)
288 DO n=1,nrwall
289 k = kind(n)
290 isl = islind(n)
291C
292 n2=n +nrwall
293 n3=n2+nrwall
294 n4=n3+nrwall
295 n5=n4+nrwall
296 n6=n5+nrwall
297 n7=n6+nrwall
298 n8=n7+nrwall
299C
300 ityp= nprw(n4)
301C
302 DO m = 1, 6
303 DO l = 1, 7
304 frwl6(l,m,n) = zero
305 END DO
306 END DO
307C
308 nsms= nprw(n7)
309 IF(ityp==1.AND.nsms/=0)THEN
310 CALL sms_rgwall_bilan(
311 + x ,frea ,v ,rwbuf(1,n),lprw(k),
312 + nprw(n) ,nprw(n2) ,nprw(n3) ,ms ,weight ,
313 + rwsav(isl),nprw(n8),irwl_work(k),nsms ,nrwl_sms(k),
314 + fsav(1,n),fopt(1,n),frwl6(1,1,n),a ,wfext)
315 ELSEIF(ityp==2.AND.nsms/=0)THEN
316 CALL sms_rgwalc_bilan(
317 + x ,frea ,v ,rwbuf(1,n),lprw(k),
318 + nprw(n) ,nprw(n2) ,nprw(n3) ,ms ,weight ,
319 + nprw(n8),irwl_work(k),nsms ,nrwl_sms(k),fsav(1,n),
320 + fopt(1,n),frwl6(1,1,n),a ,wfext)
321 ELSEIF(ityp==3.AND.nsms/=0)THEN
322 CALL sms_rgwals_bilan(
323 + x ,frea ,v ,rwbuf(1,n),lprw(k),
324 + nprw(n) ,nprw(n2) ,nprw(n3) ,ms ,weight ,
325 + nprw(n8),irwl_work(k),nsms ,nrwl_sms(k),fsav(1,n),
326 + fopt(1,n),frwl6(1,1,n),a ,wfext)
327 ELSEIF(ityp==4.AND.nsms/=0)THEN
328 CALL sms_rgwalp_bilan(
329 + x ,frea ,v ,rwbuf(1,n),lprw(k),
330 + nprw(n) ,nprw(n2) ,nprw(n3) ,ms ,weight ,
331 + nprw(n8),irwl_work(k),nsms ,nrwl_sms(k),fsav(1,n),
332 + fopt(1,n),frwl6(1,1,n),a ,wfext)
333 ENDIF
334 END DO
335!$OMP END DO
336
337!$OMP SINGLE
338C
339C Traitements Speciaux : Communications SPMD si moving present
340C + Sauvegarde Force et Impultion main
341C
342 IF(imconv == 1) THEN
343 DO n=1,nrwall
344 n2=n +nrwall
345 n3=n2+nrwall
346 n4=n3+nrwall
347 n5=n4+nrwall
348 n6=n5+nrwall
349 IF(nprw(n3) /= 0) THEN
350 IF(nspmd > 1) THEN
351C si proc concerne par le rgwall
352 IF(fr_wall(ispmd+1,n)/=0) THEN
353 CALL spmd_exch_fr6(fr_wall(1,n),frwl6(1,1,n),7*6)
354 ENDIF
355 pmain = fr_wall(nspmd+2,n)
356 ELSE
357 pmain = 1
358 ENDIF
359 ELSE
360 pmain = 1
361 END IF
362C
363 CALL sms_rgwalt(
364 1 nprw(n3),rwbuf(1,n),frwl6(1,1,n),pmain,fsav(1,n),
365 2 fopt(1,n))
366 END DO
367 END IF
368
369!$OMP END SINGLE
370
371 END SELECT
372
373 RETURN
my_real
#define my_real
Definition cppsort.cpp:32
sms_rgwalt
subroutine sms_rgwalt(msr, rwl, frwl6, pmain, fsav, fopt)
Definition sms_rgwal0.F:382
sms_rgwalc_impact
subroutine sms_rgwalc_impact(x, a, v, rwl, nsw, nsn, itied, msr, ms, weight, nimpact, impact, nsms, nrwl_sms)
Definition sms_rgwalc.F:31
sms_rgwalc_bilan
subroutine sms_rgwalc_bilan(x, frea, v, rwl, nsw, nsn, itied, msr, ms, weight, nimpact, impact, nsms, nrwl_sms, fsav, fopt, frwl6, a, wfext)
Definition sms_rgwalc.F:564
sms_rgwalc_fric
subroutine sms_rgwalc_fric(x, a, v, rwl, nsw, nsn, itied, msr, ms, weight, nimpact, impact, nsms, nrwl_sms, fsav, fopt, res, r, frea)
Definition sms_rgwalc.F:125
sms_rgwalc_bcs_0
subroutine sms_rgwalc_bcs_0(x, a, v, rwl, nsw, nsn, itied, msr, ms, weight, nimpact, impact, nsms, nrwl_sms)
Definition sms_rgwalc.F:260
sms_rgwalc_bcs_1
subroutine sms_rgwalc_bcs_1(x, a, v, rwl, nsw, nsn, itied, msr, ms, weight, nimpact, impact, nsms, nrwl_sms)
Definition sms_rgwalc.F:413
sms_rgwall_bcs_0
subroutine sms_rgwall_bcs_0(x, a, v, rwl, nsw, nsn, itied, msr, diag_sms, weight, rwsav, nimpact, impact, nsms, nrwl_sms)
Definition sms_rgwall.F:338
sms_rgwall_bcs_1
subroutine sms_rgwall_bcs_1(x, a, v, rwl, nsw, nsn, itied, msr, ms, weight, rwsav, nimpact, impact, nsms, nrwl_sms)
Definition sms_rgwall.F:448
sms_rgwall_fric
subroutine sms_rgwall_fric(x, a, v, rwl, nsw, nsn, itied, msr, ms, weight, rwsav, nimpact, impact, nsms, nrwl_sms, fsav, fopt, res, r, frea)
Definition sms_rgwall.F:155
sms_rgwall_bilan
subroutine sms_rgwall_bilan(x, frea, v, rwl, nsw, nsn, itied, msr, ms, weight, rwsav, nimpact, impact, nsms, nrwl_sms, fsav, fopt, frwl6, a, wfext)
Definition sms_rgwall.F:540
sms_rgwall_impact
subroutine sms_rgwall_impact(x, a, v, rwl, nsw, nsn, itied, msr, ms, weight, rwsav, nimpact, impact, nsms, nrwl_sms)
Definition sms_rgwall.F:32
sms_rgwalp_fric
subroutine sms_rgwalp_fric(x, a, v, rwl, nsw, nsn, itied, msr, ms, weight, nimpact, impact, nsms, nrwl_sms, fsav, fopt, res, r, frea)
Definition sms_rgwalp.F:191
sms_rgwalp_bcs_0
subroutine sms_rgwalp_bcs_0(x, a, v, rwl, nsw, nsn, itied, msr, ms, weight, nimpact, impact, nsms, nrwl_sms)
Definition sms_rgwalp.F:315
sms_rgwalp_impact
subroutine sms_rgwalp_impact(x, a, v, rwl, nsw, nsn, itied, msr, ms, weight, nimpact, impact, nsms, nrwl_sms)
Definition sms_rgwalp.F:31
sms_rgwalp_bilan
subroutine sms_rgwalp_bilan(x, frea, v, rwl, nsw, nsn, itied, msr, ms, weight, nimpact, impact, nsms, nrwl_sms, fsav, fopt, frwl6, a, wfext)
Definition sms_rgwalp.F:556
sms_rgwalp_bcs_1
subroutine sms_rgwalp_bcs_1(x, a, v, rwl, nsw, nsn, itied, msr, ms, weight, nimpact, impact, nsms, nrwl_sms)
Definition sms_rgwalp.F:464
sms_rgwals_bcs_0
subroutine sms_rgwals_bcs_0(x, a, v, rwl, nsw, nsn, itied, msr, ms, weight, nimpact, impact, nsms, nrwl_sms)
Definition sms_rgwals.F:245
sms_rgwals_impact
subroutine sms_rgwals_impact(x, a, v, rwl, nsw, nsn, itied, msr, ms, weight, nimpact, impact, nsms, nrwl_sms)
Definition sms_rgwals.F:31
sms_rgwals_fric
subroutine sms_rgwals_fric(x, a, v, rwl, nsw, nsn, itied, msr, ms, weight, nimpact, impact, nsms, nrwl_sms, fsav, fopt, res, r, frea)
Definition sms_rgwals.F:121
sms_rgwals_bcs_1
subroutine sms_rgwals_bcs_1(x, a, v, rwl, nsw, nsn, itied, msr, ms, weight, nimpact, impact, nsms, nrwl_sms)
Definition sms_rgwals.F:385
sms_rgwals_bilan
subroutine sms_rgwals_bilan(x, frea, v, rwl, nsw, nsn, itied, msr, ms, weight, nimpact, impact, nsms, nrwl_sms, fsav, fopt, frwl6, a, wfext)
Definition sms_rgwals.F:523
spmd_allglob_isum9
subroutine spmd_allglob_isum9(v, len)
Definition spmd_allglob_isum9.F:46
spmd_exch_fr6
subroutine spmd_exch_fr6(fr, fs6, len)
Definition spmd_exch_fr6.F:51
my_barrier
subroutine my_barrier
Definition machine.F:31

◆ sms_rgwalt()

subroutine sms_rgwalt ( integer msr,
rwl,
double precision, dimension(7,6) frwl6,
integer pmain,
fsav,
fopt )

Definition at line 380 of file sms_rgwal0.F.

382C-----------------------------------------------
383C I m p l i c i t T y p e s
384C-----------------------------------------------
385#include "implicit_f.inc"
386#include "comlock.inc"
387C-----------------------------------------------
388C C o m m o n B l o c k s
389C-----------------------------------------------
390#include "com08_c.inc"
391#include "task_c.inc"
392C-----------------------------------------------
393C D u m m y A r g u m e n t s
394C-----------------------------------------------
395 INTEGER MSR, PMAIN
396C REAL
397 my_real
398 . rwl(*), fsav(*),fopt(6)
399 double precision
400 . frwl6(7,6)
401C-----------------------------------------------
402C L o c a l V a r i a b l e s
403C-----------------------------------------------
404C REAL
405 my_real
406 . fxn, fyn, fzn, fxt, fyt, fzt, xmt, dt15, dt25
407C-----------------------------------------------
408 fxn = frwl6(1,1)+frwl6(1,2)+frwl6(1,3)+
409 . frwl6(1,4)+frwl6(1,5)+frwl6(1,6)
410 fyn = frwl6(2,1)+frwl6(2,2)+frwl6(2,3)+
411 . frwl6(2,4)+frwl6(2,5)+frwl6(2,6)
412 fzn = frwl6(3,1)+frwl6(3,2)+frwl6(3,3)+
413 . frwl6(3,4)+frwl6(3,5)+frwl6(3,6)
414 xmt = frwl6(4,1)+frwl6(4,2)+frwl6(4,3)+
415 . frwl6(4,4)+frwl6(4,5)+frwl6(4,6)
416 fxt = frwl6(5,1)+frwl6(5,2)+frwl6(5,3)+
417 . frwl6(5,4)+frwl6(5,5)+frwl6(5,6)
418 fyt = frwl6(6,1)+frwl6(6,2)+frwl6(6,3)+
419 . frwl6(6,4)+frwl6(6,5)+frwl6(6,6)
420 fzt = frwl6(7,1)+frwl6(7,2)+frwl6(7,3)+
421 . frwl6(7,4)+frwl6(7,5)+frwl6(7,6)
422C F et XMT stockoques dans RWL et appliques debut cycle suivant
423 rwl(17)=fxn+fxt
424 rwl(18)=fyn+fyt
425 rwl(19)=fzn+fzt
426 rwl(20)=xmt
427C test pour ne cummuler qu'une fois en multiprocessors dans le cas moving
428 IF(ispmd+1 == pmain.OR. msr == 0) THEN
429 dt15=half*dt1
430 dt25=half*dt2
431 fsav(1)=fsav(1)+rwl(21)+dt15*fxn
432 fsav(2)=fsav(2)+rwl(22)+dt15*fyn
433 fsav(3)=fsav(3)+rwl(23)+dt15*fzn
434 fsav(4)=fsav(4)+rwl(24)+dt15*fxt
435 fsav(5)=fsav(5)+rwl(25)+dt15*fyt
436 fsav(6)=fsav(6)+rwl(26)+dt15*fzt
437 rwl(21)=dt25*fxn
438 rwl(22)=dt25*fyn
439 rwl(23)=dt25*fzn
440 rwl(24)=dt25*fxt
441 rwl(25)=dt25*fyt
442 rwl(26)=dt25*fzt
443 fopt(1)=fopt(1)+rwl(17)
444 fopt(2)=fopt(2)+rwl(18)
445 fopt(3)=fopt(3)+rwl(19)
446 END IF
447C
448 RETURN