OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
alesub2.F File Reference
#include "implicit_f.inc"
#include "com01_c.inc"
#include "com04_c.inc"
#include "com06_c.inc"
#include "com08_c.inc"
#include "scr06_c.inc"
#include "units_c.inc"
#include "task_c.inc"
#include "parit_c.inc"
#include "param_c.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine alesub2 (nale, v, dsave, icodt, iskew, skew, asave, a, d, neltst, ityptst, itask, nodft, nodlt, dt2save, dt2t, neltsa, ityptsa, nelts, weight, fsky, fskyv)

Function/Subroutine Documentation

◆ alesub2()

subroutine alesub2 ( integer, dimension(*) nale,
v,
dsave,
integer, dimension(*) icodt,
integer, dimension(*) iskew,
skew,
asave,
a,
d,
integer neltst,
integer ityptst,
integer itask,
integer nodft,
integer nodlt,
dt2save,
dt2t,
integer neltsa,
integer ityptsa,
integer nelts,
integer, dimension(*) weight,
fsky,
fskyv )

Definition at line 33 of file alesub2.F.

39C-----------------------------------------------
40C M o d u l e s
41C-----------------------------------------------
42 USE ale_mod
43C-----------------------------------------------
44C I m p l i c i t T y p e s
45C-----------------------------------------------
46C /ALESUB is an obsolete option
47C Multidomain computation (/SUBDOMAIN) is now used instead.
48C-----------------------------------------------
49C I m p l i c i t T y p e s
50C-----------------------------------------------
51#include "implicit_f.inc"
52C-----------------------------------------------
53C C o m m o n B l o c k s
54C-----------------------------------------------
55#include "com01_c.inc"
56#include "com04_c.inc"
57#include "com06_c.inc"
58#include "com08_c.inc"
59#include "scr06_c.inc"
60#include "units_c.inc"
61#include "task_c.inc"
62#include "parit_c.inc"
63#include "param_c.inc"
64C-----------------------------------------------
65C D u m m y A r g u m e n t s
66C-----------------------------------------------
67 INTEGER NALE(*),ICODT(*),ISKEW(*), WEIGHT(*), NELTST ,ITYPTST,
68 . ITASK,NODFT,NODLT,NELTSA ,ITYPTSA, NELTS
69 my_real v(3,numnod),dsave(3,*),skew(lskew,*),asave(3,*),a(3,numnod),d(3,numnod),
70 . dt2save,dt2t,fsky(8,lsky),fskyv(lsky,8)
71C-----------------------------------------------
72C L o c a l V a r i a b l e s
73C-----------------------------------------------
74 INTEGER N,LCOD, INDX2(1024), I,IPRI,NINDX2, K, NISKFT, NISKLT
75C-----------------------------------------------
76C S o u r c e L i n e s
77C-----------------------------------------------
78C
79C--------------------------------------------------------
80C ALE SUB-CYCLING (PART 2)
81C--------------------------------------------------------
82 IF(itask == 0) THEN
83 dt2=dt2*ale%SUB%DTFSUB
84 IF(dt2s /= zero)dt2=min(dt2,onep1*dt2s)
85 IF(tt > zero)THEN
86 dt12s=half*(dt1+int(dt2/ale%SUB%DT1SAVE)*ale%SUB%DT1SAVE)
87 ELSE
88 dt12s=half*dt2
89 ENDIF
90 dt2s=dt2
91 dt1=ale%SUB%DT1SAVE
92 ipri=mod(ncycle,iabs(ncpri))
93 IF(ipri == 0.AND.ispmd == 0)THEN
94 WRITE(iout,1000) ' FLUID TIME STEP ',dt2s,' SOLID',nelts
95 IF(ncpri < 0)
96 & WRITE(istdo,1000)' FLUID TIME STEP ',dt2s
97 1000 FORMAT(a,1pe11.4,a,i10)
98 ENDIF
99 ENDIF
100C
101 CALL my_barrier
102C
103 dt2t=min(dt2,dt2save)
104 neltst =neltsa
105 ityptst=ityptsa
106C RESET LAGRANGIAN VELOCITIES
107 DO n=nodft,nodlt
108 IF(nale(n) == 0)THEN
109 v(1,n)=dsave(1,n)
110 v(2,n)=dsave(2,n)
111 v(3,n)=dsave(3,n)
112 ENDIF
113 ENDDO
114 DO i=nodft,nodlt,1024
115 nindx2 = 0
116 DO n = i,min(nodlt,i+1023)
117 lcod=icodt(n+numnod+numnod)
118 IF(nale(n)*lcod /= 0)THEN
119 nindx2 = nindx2 + 1
120 indx2(nindx2) = n
121 ENDIF
122 ENDDO
123 IF (nindx2 /= 0)THEN
124 CALL bcs3v(nindx2,indx2,iskew,icodt(2*numnod+1),v,dsave ,skew)
125 ENDIF
126 ENDDO
127C
128C DISPLACEMENT BACKUP
129C
130 DO n=nodft,nodlt
131 dsave(1,n)=d(1,n)
132 dsave(2,n)=d(2,n)
133 dsave(3,n)=d(3,n)
134 ENDDO
135
136 IF(iparit > 0)THEN
137C forces from solid elements are stored in fsky
138C they are reused in subcycles
139C + same strategy as P/off => use of ASAVE
140 DO n=nodft,nodlt
141 asave(1,n)=a(1,n)
142 asave(2,n)=a(2,n)
143 asave(3,n)=a(3,n)
144 ENDDO
145 niskft = 1+itask*lsky/nthread
146 nisklt = (itask+1)*lsky/nthread
147 IF(ivector == 1) THEN
148 DO k=1,8
149 DO i=niskft,nisklt
150 fskyv(i,k)=zero
151 ENDDO
152 ENDDO
153 ELSE
154 DO k=1,8
155 DO i=niskft,nisklt
156 fsky(k,i)=zero
157 ENDDO
158 ENDDO
159 ENDIF
160C Parith/OFF
161 ELSE
162 DO n=nodft,nodlt
163 a(1,n)=a(1,n)*weight(n)
164 a(2,n)=a(2,n)*weight(n)
165 a(3,n)=a(3,n)*weight(n)
166 asave(1,n)=a(1,n)
167 asave(2,n)=a(2,n)
168 asave(3,n)=a(3,n)
169 ENDDO
170 ENDIF
171C
172 RETURN
subroutine bcs3v(nindx, indx, iskew, icodt, w, v, b)
Definition bcs3v.F:31
#define my_real
Definition cppsort.cpp:32
#define min(a, b)
Definition macros.h:20
type(ale_) ale
Definition ale_mod.F:249
subroutine my_barrier
Definition machine.F:31