OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
section_fio.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!|| section_fio ../engine/source/tools/sect/section_fio.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||--- calls -----------------------------------------------------
28!|| section_read ../engine/source/tools/sect/section_read.F
29!|| section_readp ../engine/source/tools/sect/section_readp.F
30!||====================================================================
31 SUBROUTINE section_fio(NSTRF ,V ,VR ,
32 2 A ,AR ,SECBUF,MS ,IN ,
33 3 WEIGHT ,IAD_CUT,FR_CUT,WFEXT)
34C-----------------------------------------------
35C I m p l i c i t T y p e s
36C-----------------------------------------------
37#include "implicit_f.inc"
38C-----------------------------------------------
39C C o m m o n B l o c k s
40C-----------------------------------------------
41#include "comlock.inc"
42#include "com01_c.inc"
43#include "com04_c.inc"
44!#include "com06_c.inc"
45#include "com08_c.inc"
46#include "param_c.inc"
47#include "task_c.inc"
48C-----------------------------------------------
49C D u m m y A r g u m e n t s
50C-----------------------------------------------
51 INTEGER NSTRF(*),WEIGHT(*), IAD_CUT(NSPMD+2,*), FR_CUT(*)
52 my_real V(3,*), VR(3,*), A(3,*), AR(3,*), MS(*),SECBUF(*), IN(*)
53 DOUBLE PRECISION,INTENT(INOUT) :: WFEXT
54C-----------------------------------------------
55C L o c a l V a r i a b l e s
56C-----------------------------------------------
57 integer
58 . j, i, k, ii, i1, i2, n, kr1,kr2,kr3,k0,kr0,k1,k2,
59 . ifrl1, ifrl2, l,TYPE, nnod,kr11,kr12,
60 . kr21,kr22,nbinter,len,NNODT
61 my_real
62 . dw, tt1, tt2, tt3, vi, dd, d1, d2,wfextl,
63 . tnext, deltat,err(8), ff, fold, alpha,aa,dtinv
64C
65 IF(nsect==0)RETURN
66 IF(nstrf(2)==0)RETURN
67C-----------------------------------------------
68C READ FILE dans l'ordre des sections lues sur le fichier
69C T = TT
70C-----------------------------------------------
71 IF(nspmd==1) THEN
72 CALL section_read (tt ,nstrf ,secbuf)
73 ELSE
74 nnodt = 0
75 IF(ispmd==0) THEN
76 k0 = nstrf(25)
77 DO i = 1, nsect
78 IF(nstrf(k0)>=100) nnodt = nnodt + iad_cut(nspmd+2,i)
79 k0 = nstrf(k0+24)
80 END DO
81 END IF
82C
83C SPMD SPECIFIC : MAJ MODIF NSTRF et SECBUF dans SECT_READP
84C
85 CALL section_readp(tt,nstrf,secbuf,nnodt,iad_cut,fr_cut)
86 END IF
87C-----------------------------------------------
88C IMPOSED FORCES
89C-----------------------------------------------
90 tt1 = secbuf(2)
91 tt2 = secbuf(3)
92 tt3 = secbuf(4)
93 dtinv=zero
94 IF(dt1>zero)dtinv=one/dt1
95 IF(nstrf(2)>=1)THEN
96 ifrl1=nstrf(7)
97 ifrl2=mod(ifrl1+1,2)
98 k0 = nstrf(25)
99 kr0 = nstrf(26)
100 DO n=1,nsect
101 nnod = nstrf(k0+6)
102 TYPE=nstrf(k0)
103 nbinter = nstrf(k0+14)
104 alpha = secbuf(kr0+2)
105 IF(type>=101.AND.alpha/=0.0)THEN
106 k2 = k0 + 30 + nbinter
107 kr1 = kr0 + 10
108 kr2 = kr1 + 12*nnod
109 kr3 = kr2 + 12*nnod
110 kr11 = kr1 + ifrl2*6*nnod
111 kr12 = kr1 + ifrl1*6*nnod
112 kr21 = kr2 + ifrl2*6*nnod
113 kr22 = kr2 + ifrl1*6*nnod
114 dw = secbuf(kr0+3)
115 IF(ispmd==0) THEN
116 wfextl=dw*dt1
117 ELSE
118 wfextl=zero
119 ENDIF
120 wfext = wfext + wfextl
121 dw=0.
122 DO k=1,3
123 DO i=1,nnod
124 ii = nstrf(k2+i-1)
125 d2 = secbuf(kr22+6*i-7+k)
126 d1 = secbuf(kr21+6*i-7+k)
127 aa = (tt*(d2-d1)+tt2*d1-tt1*d2) / (tt2-tt1)
128 d2 = secbuf(kr12+6*i-7+k)
129 d1 = secbuf(kr11+6*i-7+k)
130 dd = ms(ii)*(d2-d1) / (tt2-tt1)
131 aa = dd*dtinv + aa
132 a(k,ii) = a(k,ii) + aa
133 IF(weight(ii)==1) THEN
134 dw = dw + half*v(k,ii)*aa
135 ENDIF
136 ENDDO
137 IF(iroddl/=0)THEN
138 DO i=1,nnod
139 ii = nstrf(k2+i-1)
140 d2 = secbuf(kr22+6*i-4+k)
141 d1 = secbuf(kr21+6*i-4+k)
142 aa = (tt*(d2-d1)+tt2*d1-tt1*d2) / (tt2-tt1)
143 d2 = secbuf(kr12+6*i-4+k)
144 d1 = secbuf(kr11+6*i-4+k)
145 dd = in(ii)*(d2-d1) / (tt2-tt1)
146 aa = dd*dtinv + aa
147 ar(k,ii) = ar(k,ii) + aa
148 IF(weight(ii)==1) THEN
149 dw = dw + half*vr(k,ii)*aa
150 ENDIF
151 ENDDO
152 ENDIF
153 ENDDO
154 wfextl = wfextl + dt1*dw
155 wfext = wfext + dt1*dw
156 secbuf(kr0+3) = dw
157 secbuf(kr0+4) = wfextl
158 ENDIF
159 kr0 = nstrf(k0+25)
160 k0 = nstrf(k0+24)
161 ENDDO
162 ENDIF
163C---------------------------------------------------------
164 RETURN
165 END
alpha
#define alpha
Definition eval.h:35
section_fio
subroutine section_fio(nstrf, v, vr, a, ar, secbuf, ms, in, weight, iad_cut, fr_cut, wfext)
Definition section_fio.F:34
section_read
subroutine section_read(ttt, nstrf, secbuf)
Definition section_read.F:41
section_readp
subroutine section_readp(ttt, nstrf, secbuf, nnodt, iad_cut, fr_cut)
Definition section_readp.F:43