OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
write_buf_law51.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!|| write_buf_law51 ../engine/source/materials/mat/mat051/write_buf_law51.F
25!||--- uses -----------------------------------------------------
26!|| elbufdef_mod ../common_source/modules/mat_elem/elbufdef_mod.f90
27!|| i22bufbric_mod ../common_source/modules/interfaces/cut-cell-search_mod.F
28!|| multimat_param_mod ../common_source/modules/multimat_param_mod.F90
29!||====================================================================
30 SUBROUTINE write_buf_law51 (
31 1 IXS , NFT , NUVAR , NEL , UVAR ,
32 2 I , UNEPHASE, DD , dbVOLD , dbVOLD_f,
33 3 VOLUME, VOLD , EPSPXX , EPSPYY , EPSPZZ,
34 4 TAG22 , BFRAC ,RHO01 ,RHO02 , RHO03 ,
35 5 RHO04)
36C-----------------------------------------------
37C M o d u l e s
38C-----------------------------------------------
39 USE elbufdef_mod
41 USE multimat_param_mod , ONLY : m51_n0phas, m51_nvphas
42C-----------------------------------------------
43C I m p l i c i t T y p e s
44C-----------------------------------------------
45#include "implicit_f.inc"
46#include "comlock.inc"
47C-----------------------------------------------
48C C o m m o n B l o c k s
49C-----------------------------------------------
50#include "com01_c.inc"
51#include "mvsiz_p.inc"
52#include "inter22.inc"
53C-----------------------------------------------
54C D u m m y A r g u m e n t s
55C-----------------------------------------------
56 INTEGER :: NEL, NUPARAM, NUVAR,IXS(NIXS,*)
57 INTEGER :: NFT, UNEPHASE
58 my_real :: UVAR(NEL,NUVAR), DD, dbVOLD(4),dbVOLD_f(4),TAG22(MVSIZ),VOLUME(MVSIZ),VOLD, VAR
59 my_real :: EPSPXX(MVSIZ), EPSPYY(MVSIZ), EPSPZZ(MVSIZ),BFRAC
60 my_real :: RHO01, RHO02, RHO03, RHO04, RHO0(4)
61
62C-----------------------------------------------
63C L o c a l V a r i a b l e s
64C-----------------------------------------------
65 INTEGER :: I,II, ITRIMAT, IPRESENT(4), Q, KK
66 my_real :: P
67C-----------------------------------------------
68C S o u r c e L i n e s
69C-----------------------------------------------
70
71 rho0 = ( / rho01, rho02, rho03, rho04 / )
72
73 ii = i+ nft
74 write (*,fmt='(A16,I10)' ) "LAW51- brick ID=",ixs(nixs,i+nft)
75
76 var=zero
77 DO itrimat = 1,trimat
78 kk = m51_n0phas + (itrimat-1)*m51_nvphas
79 var = var + uvar(i,11+kk)
80 ENDDO
81
82 IF(int22>0)THEN
83 IF(tag22(i)>zero)THEN
84 write (*,fmt='(A)')
85 ." +---------SuperCell-----------+---------ELEMENT-----------+-------SUM(submat)-----------+-------SUM(submat
86 .)+flux-----+"
87 write (*,fmt='(A16,4F30.16)') " vold=",BRICK_LIST(1,NINT(TAG22(I)))%Vold_SCell,VOLD ,SUM(dbVOLD(1:4)),
88 . SUM(dbVOLD_f(1:4))
89 write (*,FMT='(A16,3F30.16)') " vnew=",BRICK_LIST(1,NINT(TAG22(I)))%Vnew_SCell,VOLUME(I) ,VAR
90 ELSE
91 write (*,FMT='(A)')
92 ." +-----------element-----------+"
93 write (*,FMT='(A16,1F30.16)') " vold=",VOLD
94 write (*,FMT='(A16,1F30.16)') " vnew=",VOLUME(I)
95 ENDIF
96 ELSE
97 write (*,FMT='(A)')
98 ." +-----------element-----------+"
99 write (*,FMT='(A16,1F30.16)') " vold=",VOLD
100 write (*,FMT='(A16,1F30.16)') " vnew=",VOLUME(I)
101 ENDIF
102 write (*,FMT='(A16,3F30.16)') " epsii=",EPSPXX(I),EPSPYY(I), EPSPZZ(I)
103 write (*,FMT='(A16,1F30.16)') " dd=", DD
104 write (*,FMT='(A16,1F30.16)') " bfrac=", BFRAC
105
106 !submat4
107 Q = UNEPHASE / 8
108 IPRESENT(4) = Q
109 UNEPHASE = UNEPHASE - Q*8
110 !submat3
111 Q = UNEPHASE / 4
112 IPRESENT(3) = Q
113 UNEPHASE = UNEPHASE - Q*4
114 !submat2
115 Q = UNEPHASE / 2
116 IPRESENT(2) = Q
117 UNEPHASE = UNEPHASE - Q*2
118 !submat1
119 IPRESENT(1) = UNEPHASE
120
121 VAR = ZERO
122
123 DO ITRIMAT = 1,TRIMAT
124 !=====================!
125 ! submat_id = ITRIMAT !
126 !=====================!
127 KK = M51_N0PHAS + (ITRIMAT-1)*M51_NVPHAS
128 write (*,FMT='(A16,I1)') " +-----submat=",ITRIMAT
129 IF(IPRESENT(ITRIMAT)==0)THEN
130 write (*,FMT='(A16 )') " empty"
131 CYCLE
132 ENDIF
133 write (*,FMT='(A16,E30.16)') " 1. vfrac=", UVAR(I,1+KK)
134 write (*,FMT='(A16,E30.16)') " 2. sd_xx=", UVAR(I,2+KK)
135 write (*,FMT='(A16,E30.16)') " 3. sd_yy=", UVAR(I,3+KK)
136 write (*,FMT='(A16,E30.16)') " 4. sd_zz=", UVAR(I,4+KK)
137 write (*,FMT='(A16,E30.16)') " 5. sd_xy=", UVAR(I,5+KK)
138 write (*,FMT='(A16,E30.16)') " 6. sd_yz=", UVAR(I,6+KK)
139 write (*,FMT='(A16,E30.16)') " 7. sd_zx=", UVAR(I,7+KK)
140 write (*,FMT='(A16,E30.16)') " 8. e=", UVAR(I,8+KK)
141 write (*,FMT='(A16,E30.16)') " 9. rho=", UVAR(I,9+KK)
142 write (*,FMT='(A16,E30.16)') " 8*11 eint=", UVAR(I,8+KK)*UVAR(I,11+KK)
143 write (*,FMT='(A16,E30.16)') " 9*11 mass=", UVAR(I,9+KK)*UVAR(I,11+KK)
144 write (*,FMT='(A16,E30.16)') " 10. q=", UVAR(I,10+KK)
145 write (*,FMT='(A16,E30.16)') " 11. vnew=", UVAR(I,11+KK)
146 write (*,FMT='(A16,E30.16)') " vold=", dbVOLD(ITRIMAT)
147 write (*,FMT='(A16,E30.16)') " 12. rho=", UVAR(I,12+KK)
148 write (*,FMT='(A16,E30.16)') " 13. ddvol=", UVAR(I,13+KK)
149 write (*,FMT='(A16,E30.16)') " 14. ssp=", UVAR(I,14+KK)
150 write (*,FMT='(A16,E30.16)') " 15. plas=", UVAR(I,15+KK)
151 write (*,FMT='(A16,E30.16)') " 16. t=", UVAR(I,16+KK)
152 write (*,FMT='(A16,E30.16)') " 17. edif/v=", UVAR(I,17+KK)
153 write (*,FMT='(A16,E30.16)') " 18. p=", UVAR(I,18+KK)
154 write (*,FMT='(A16,E30.16)') " 19. epx=", UVAR(I,19+KK)
155 write (*,FMT='(A16,E30.16)') " . mu=", UVAR(I,9+KK)/RHO0(ITRIMAT) - ONE
156 VAR = VAR + UVAR(I,11+KK)
157 ENDDO
158
159 RETURN
160 END
161
162
subroutine write_buf_law51(ixs, nft, nuvar, nel, uvar, i, unephase, dd, dbvold, dbvold_f, volume, vold, epspxx, epspyy, epspzz, tag22, bfrac, rho01, rho02, rho03, rho04)