OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
lecfvbag.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!|| lecfvbag ../engine/source/input/lecfvbag.F
25!||--- called by ------------------------------------------------------
26!|| lectur ../engine/source/input/lectur.F
27!||--- calls -----------------------------------------------------
28!|| arret ../engine/source/system/arret.F
29!|| spmd_fvb_gath ../engine/source/mpi/airbags/spmd_fvb_gath.F
30!||--- uses -----------------------------------------------------
31!|| fvbag_mod ../engine/share/modules/fvbag_mod.F
32!||====================================================================
33 SUBROUTINE lecfvbag(NFVMESH, MONVOL, VOLMON, X)
34C-----------------------------------------------
35C M o d u l e s
36C-----------------------------------------------
37 USE fvbag_mod
38C-----------------------------------------------
39C I m p l i c i t T y p e s
40C-----------------------------------------------
41#include "implicit_f.inc"
42C-----------------------------------------------
43C C o m m o n B l o c k s
44C-----------------------------------------------
45#include "com01_c.inc"
46#include "com04_c.inc"
47#include "param_c.inc"
48#include "units_c.inc"
49#include "task_c.inc"
50C-----------------------------------------------
51C D u m m y A r g u m e n t s
52C-----------------------------------------------
53 INTEGER NFVMESH, MONVOL(*)
54 my_real
55 . volmon(*), x(3,*)
56C-----------------------------------------------
57C L o c a l V a r i a b l e s
58C-----------------------------------------------
59 INTEGER I, ID, NBX, NBY, K1, K2, KIBJET, KIBHOL, KIBALE, KK1, N,
60 . ITYP, NN, KI1, J, NSTEP, IFVI, NBZ, IFV
61 my_real
62 . vx3, vy3, vz3, vx1, vy1, vz1, dx0, dy0, dz0, lx, ly, norm,
63 . vvx3, vvy3, vvz3, norm2, ss, vvx1, vvy1, vvz1, vvx2,
64 . vvy2, vvz2, lxmax, lymax, xx, yy, zz, xl, yl, x0, y0, z0,
65 . lz, lzmax, zl, rbid
66 my_real
67 . , DIMENSION(:,:), ALLOCATABLE :: xxx
68C
69 DO i=1,nfvmesh
70 READ(iin,'(I10)') ifvi
71 IF (ifvi==1) THEN
72 READ(iin,'(2I10)') id, nstep
73 IF (nstep==0) nstep=20
74 READ(iin,'(3F20.0)') vx3, vy3, vz3
75 READ(iin,'(3F20.0)') vx1, vy1, vz1
76 READ(iin,'(3F20.0)') dx0, dy0, dz0
77 READ(iin,'(3F20.0)') lx, ly, lz
78 READ(iin,'(3I10)') nbx, nby, nbz
79C
80 k1=1
81 k2=1+nimv*nvolu
82 kibjet=k2+licbag
83 kibhol=kibjet+libagjet
84 kibale=kibhol+libaghol
85 kk1=1
86 DO n=1,nvolu
87 IF (monvol(k1)==id) THEN
88 ityp=monvol(k1-1+2)
89 IF (ityp/=6) THEN
90 WRITE(iout,'(A33,I8,A38)')
91 . ' /FVMBAG/REMESH : MON. VOLUME ID ',id,' IS NOT OF TYPE FVMBAG'//
92 . ' - IT IS IGNORED'
93 GOTO 100
94 ENDIF
95C
96 norm=sqrt(vx3**2+vy3**2+vz3**2)
97 IF (norm==zero) THEN
98 vx3=volmon(kk1-1+35)
99 vy3=volmon(kk1-1+36)
100 vz3=volmon(kk1-1+37)
101 norm=sqrt(vx3**2+vy3**2+vz3**2)
102 ENDIF
103 vvx3=vx3/norm
104 vvy3=vy3/norm
105 vvz3=vz3/norm
106 norm2=vx1**2+vy1**2+vz1**2
107 IF (norm2==zero) THEN
108 vx1=volmon(kk1-1+38)
109 vy1=volmon(kk1-1+39)
110 vz1=volmon(kk1-1+40)
111 ENDIF
112 x0=volmon(kk1-1+41)+dx0
113 y0=volmon(kk1-1+42)+dy0
114 z0=volmon(kk1-1+43)+dz0
115 IF (lx==zero) lx=volmon(kk1-1+44)
116 IF (ly==zero) ly=volmon(kk1-1+45)
117 IF (lz==zero) lz=volmon(kk1-1+53)
118 IF (nbx==0) nbx=monvol(k1-1+54)
119 IF (nby==0) nby=monvol(k1-1+55)
120 IF (nbz==0) nbz=monvol(k1-1+65)
121C Verifications
122 ss=vx1*vvx3+vy1*vvy3+vz1*vvz3
123 vvx1=vx1-ss*vvx3
124 vvy1=vy1-ss*vvy3
125 vvz1=vz1-ss*vvz3
126 norm=sqrt(vvx1**2+vvy1**2+vvz1**2)
127 IF (norm==zero) THEN
128 WRITE(istdo,'(A)')
129 . ' ** ERROR IN FVMBAG MESHING DATA '
130 WRITE(iout,'(A)')
131 . ' ** ERROR IN FVMBAG MESHING DATA '
132 WRITE(iout,'(A14,I8)') ' MONVOL ID ',id
133 WRITE(iout,'(A)')
134 . ' NEW CUT DIRECTIONS ARE COLINEAR'
135 CALL arret(2)
136 ENDIF
137 vvx1=vvx1/norm
138 vvy1=vvy1/norm
139 vvz1=vvz1/norm
140 vvx2=vvy3*vvz1-vvz3*vvy1
141 vvy2=vvz3*vvx1-vvx3*vvz1
142 vvz2=vvx3*vvy1-vvy3*vvx1
143C
144 lxmax=zero
145 lymax=zero
146 lzmax=zero
147 nn=monvol(k1-1+32)
148 ki1=kibale+monvol(k1-1+31)
149C
150 ifv=monvol(k1-1+45)
151 ALLOCATE(xxx(3,nn))
152 CALL spmd_fvb_gath(ifv, x, xxx, rbid, rbid,
153 . 1 )
154 IF (ispmd==fvspmd(ifv)%PMAIN-1) THEN
155 DO j=1,nn
156 xx=xxx(1,j)
157 yy=xxx(2,j)
158 zz=xxx(3,j)
159 xl=(xx-x0)*vvx1+(yy-y0)*vvy1+(zz-z0)*vvz1
160 yl=(xx-x0)*vvx2+(yy-y0)*vvy2+(zz-z0)*vvz2
161 zl=(xx-x0)*vvx3+(yy-y0)*vvy3+(zz-z0)*vvz3
162 lxmax=max(lxmax,abs(xl))
163 lymax=max(lymax,abs(yl))
164 lzmax=max(lzmax,abs(zl))
165 ENDDO
166 ENDIF
167 DEALLOCATE(xxx)
168C
169 IF (lxmax>lx) THEN
170 WRITE(iout,'(a14,i8,a9)')
171 . ' ** monvol id ',ID,' (fvmbag)'
172 WRITE(IOUT,'(a)') ' in local frame direction 1'
173 WRITE(IOUT,'(a18,g11.4,a33,g11.4,g11.4)')
174 . ' given length ',LX,
175 . ' is smaller than bounding length ',LXMAX
176 LX=LXMAX*ONEP01
177 WRITE(IOUT,'(a20,g11.4)') ' it is reset to ',LX
178 ENDIF
179 IF (LYMAX>LY) THEN
180 WRITE(IOUT,'(a14,i8,a9)')
181 . ' ** monvol id ',ID,' (fvmbag)'
182 WRITE(IOUT,'(a)') ' in local frame direction 2'
183 WRITE(IOUT,'(a18,g11.4,a33,g11.4,g11.4)')
184 . ' given length ',LY,
185 . ' is smaller than bounding length ',LYMAX
186 LY=LYMAX*ONEP01
187 WRITE(IOUT,'(a20,g11.4)') ' it is reset to ',LY
188 ENDIF
189C only horizontal splitting of a mesh band is allowed
190C IF (LZMAX>LZ) THEN
191C WRITE(IOUT,'(A14,I8,A9)')
192C . ' ** MONVOL ID ',ID,' (ALEBAG)'
193C WRITE(IOUT,'(A)') ' IN LOCAL FRAME DIRECTION 3'
194C WRITE(IOUT,'(A18,G11.4,A33,G11.4,G11.4)')
195C . ' GIVEN LENGTH ',LZ,
196C . ' IS SMALLER THAN BOUNDING LENGTH ',LZMAX
197C Lz = Lzmax*ONEP01
198C WRITE(IOUT,'(A20,G11.4)') ' IT IS RESET TO ',LZ
199C ENDIF
200C
201 VOLMON(KK1-1+35)=VX3
202 VOLMON(KK1-1+36)=VY3
203 VOLMON(KK1-1+37)=VZ3
204 VOLMON(KK1-1+38)=VX1
205 VOLMON(KK1-1+39)=VY1
206 VOLMON(KK1-1+40)=VZ1
207 VOLMON(KK1-1+41)=X0
208 VOLMON(KK1-1+42)=Y0
209 VOLMON(KK1-1+43)=Z0
210 VOLMON(KK1-1+44)=LX
211 VOLMON(KK1-1+45)=LY
212 VOLMON(KK1-1+53)=LZ
213 MONVOL(K1-1+54)=NBX
214 MONVOL(K1-1+55)=NBY
215 MONVOL(K1-1+65)=NBZ
216C
217 MONVOL(K1-1+56)=1
218 MONVOL(K1-1+58)=NSTEP
219 ENDIF
220 K1=K1+NIMV
221 KK1=KK1+NRVOLU
222 ENDDO
223 ENDIF
224 100 ENDDO
225C
226 RETURN
227 END
228
my_real
#define my_real
Definition cppsort.cpp:32
norm
norm(diag(diag(diag(inv(mat))) -id.SOL), 2) % destroy mumps instance id.JOB
lecfvbag
subroutine lecfvbag(nfvmesh, monvol, volmon, x)
Definition lecfvbag.F:34
max
#define max(a, b)
Definition macros.h:21
fvbag_mod
Definition fvbag_mod.F:44
fvbag_mod::fvspmd
type(fvbag_spmd), dimension(:), allocatable fvspmd
Definition fvbag_mod.F:129
spmd_fvb_gath
subroutine spmd_fvb_gath(ifv, x, xxx, xxxa, xxxsa, ido)
Definition spmd_fvb_gath.F:40
arret
subroutine arret(nn)
Definition arret.F:86