OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
user_windows.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!|| user_windows_routine ../engine/source/user_interface/user_windows.F
25!||--- called by ------------------------------------------------------
26!|| resol ../engine/source/engine/resol.F
27!||--- calls -----------------------------------------------------
28!|| ancmsg ../engine/source/output/message/message.F
29!|| arret ../engine/source/system/arret.F
30!|| spmd_exch_userwi ../engine/source/mpi/user_interface/spmd_exch_userwi.F
31!||--- uses -----------------------------------------------------
32!|| message_mod ../engine/share/message_module/message_mod.F
33!|| user_windows_mod ../common_source/modules/user_windows_mod.F
34!||====================================================================
35 SUBROUTINE user_windows_routine( ISPMD ,NSPMD ,USERL_AVAIL ,
36 1 USER_WINDOWS ,RAD_INPUTNAME ,LEN_RAD_INPUTNAME,
37 2 NUMNOD ,NCYCLE ,ITAB ,
38 3 TT ,DT1 ,WFEXT ,
39 4 D ,X ,V ,
40 5 VR ,MS ,IN ,
41 6 STIFN ,STIFR ,A ,
42 7 AR ,DT2 )
43C-----------------------------------------------
44C M o d u l e s
45C-----------------------------------------------
46 USE user_windows_mod
47 USE message_mod
48C-----------------------------------------------
49C I m p l i c i t T y p e s
50C-----------------------------------------------
51#include "implicit_f.inc"
52C-----------------------------------------------
53C D u m m y A r g u m e n t s
54C-----------------------------------------------
55 INTEGER, INTENT(IN) :: ISPMD,NSPMD
56 INTEGER, INTENT(IN) :: USERL_AVAIL
57 TYPE(USER_WINDOWS_),INTENT(INOUT) :: USER_WINDOWS
58 INTEGER, INTENT(IN) :: LEN_RAD_INPUTNAME
59 CHARACTER(LEN=LEN_RAD_INPUTNAME),INTENT(IN) :: RAD_INPUTNAME
60 INTEGER, INTENT(IN) :: NUMNOD,NCYCLE
61 INTEGER, DIMENSION(NUMNOD),INTENT(IN) :: ITAB
62 my_real, INTENT(IN) :: tt,dt1
63 my_real, INTENT(INOUT) :: wfext
64 my_real, DIMENSION(3*NUMNOD), INTENT(IN) :: d,x,v,vr
65 my_real, DIMENSION(NUMNOD), INTENT(IN) :: ms,in,stifn,stifr
66 my_real, DIMENSION(3*NUMNOD), INTENT(INOUT) :: a,ar
67 my_real, INTENT(INOUT) :: dt2
68C-----------------------------------------------
69C Local Variables
70C-----------------------------------------------
71 INTEGER I,ND,SIZE_OPT,NUVARI
72 CHARACTER(LEN=256) :: OPTION
73 INTEGER, DIMENSION(:) ,ALLOCATABLE :: USER_ITAB
74 my_real, DIMENSION(:) ,ALLOCATABLE :: user_d,user_x,user_v,user_vr
75 my_real, DIMENSION(:) ,ALLOCATABLE :: user_ms,user_in,user_stifn,user_stifr
76 my_real, DIMENSION(:) ,ALLOCATABLE :: user_a,user_ar
77 my_real dtu
78C-----------------------------------------------
79 IF(ispmd == 0) THEN
80 IF (userl_avail == 1) THEN
81 dtu = ep30
82 nuvari = user_windows%NUVARI - 100
83
84 ALLOCATE(user_itab(user_windows%N_USERNODS))
85 ALLOCATE(user_d( 3*user_windows%N_USERNODS))
86 ALLOCATE(user_x( 3*user_windows%N_USERNODS))
87 ALLOCATE(user_v( 3*user_windows%N_USERNODS))
88 ALLOCATE(user_vr(3*user_windows%N_USERNODS))
89 ALLOCATE(user_ms(user_windows%N_USERNODS))
90 ALLOCATE(user_in(user_windows%N_USERNODS))
91 ALLOCATE(user_stifn(user_windows%N_USERNODS))
92 ALLOCATE(user_stifr(user_windows%N_USERNODS))
93 ALLOCATE(user_a(3*user_windows%N_USERNODS))
94 ALLOCATE(user_ar(3*user_windows%N_USERNODS))
95
96 ! -----------------------------------------------------
97 ! User Windows will only receive the nodes it defined
98 ! -----------------------------------------------------
99 DO i=1,user_windows%N_USERNODS
100 nd = user_windows%USERNODS(i)
101 ! recopy ITAB
102 user_itab(i) = itab(nd)
103 ! recopy D
104 user_d(3*(i-1)+1) = d(3*(nd-1)+1)
105 user_d(3*(i-1)+2) = d(3*(nd-1)+2)
106 user_d(3*(i-1)+3) = d(3*(nd-1)+3)
107 ! recopy X
108 user_x(3*(i-1)+1) = x(3*(nd-1)+1)
109 user_x(3*(i-1)+2) = x(3*(nd-1)+2)
110 user_x(3*(i-1)+3) = x(3*(nd-1)+3)
111 ! recopy V
112 user_v(3*(i-1)+1) = v(3*(nd-1)+1)
113 user_v(3*(i-1)+2) = v(3*(nd-1)+2)
114 user_v(3*(i-1)+3) = v(3*(nd-1)+3)
115 ! Recopy VR
116 user_vr(3*(i-1)+1) = vr(3*(nd-1)+1)
117 user_vr(3*(i-1)+2) = vr(3*(nd-1)+2)
118 user_vr(3*(i-1)+3) = vr(3*(nd-1)+3)
119 ! Recopy MS,IN,STIFN,STIFR
120 user_ms(i) = ms(nd)
121 user_in(i) = in(nd)
122 user_stifn(i) = stifn(nd)
123 user_stifr(i) = stifr(nd)
124 ! Recopy A, just in case
125 user_a(3*(i-1)+1) = a(3*(nd-1)+1)
126 user_a(3*(i-1)+2) = a(3*(nd-1)+2)
127 user_a(3*(i-1)+3) = a(3*(nd-1)+3)
128 ! Recopy AR, just in case
129 user_ar(3*(i-1)+1) = ar(3*(nd-1)+1)
130 user_ar(3*(i-1)+2) = ar(3*(nd-1)+2)
131 user_ar(3*(i-1)+3) = ar(3*(nd-1)+3)
132 ENDDO
133
134 CALL eng_userlib_userwi(
135 1 rad_inputname ,len_rad_inputname ,
136 2 user_windows%NUVAR ,nuvari ,user_windows%N_USERNODS ,
137 3 ncycle ,user_windows%S_WA ,user_windows%IUSER ,user_itab ,tt ,
138 4 dt1 ,dtu ,user_windows%USREINT ,wfext ,user_windows%USER,
139 5 user_d ,user_x ,user_v ,user_vr ,user_ms ,
140 6 user_in ,user_stifn ,user_stifr ,user_a ,user_ar ,
141 7 user_windows%WA )
142
143 DO i=1,user_windows%N_USERNODS
144 nd = user_windows%USERNODS(i)
145 ! Recopy back A
146 a(3*(nd-1)+1) = user_a(3*(i-1)+1)
147 a(3*(nd-1)+2) = user_a(3*(i-1)+2)
148 a(3*(nd-1)+3) = user_a(3*(i-1)+3)
149 ! Recopy back AR
150 ar(3*(nd-1)+1) = user_ar(3*(i-1)+1)
151 ar(3*(nd-1)+2) = user_ar(3*(i-1)+2)
152 ar(3*(nd-1)+3) = user_ar(3*(i-1)+3)
153 ENDDO
154
155 DEALLOCATE(user_itab)
156 DEALLOCATE(user_d)
157 DEALLOCATE(user_x)
158 DEALLOCATE(user_v)
159 DEALLOCATE(user_vr)
160 DEALLOCATE(user_ms)
161 DEALLOCATE(user_in)
162 DEALLOCATE(user_stifn)
163 DEALLOCATE(user_stifr)
164 DEALLOCATE(user_a)
165 DEALLOCATE(user_ar)
166
167
168 dt2 = min(dt2,dtu)
169 ELSE
170 ! ----------------
171 ! ERROR to be printed & exit
172 option='USER WINDOWS'
173 size_opt=len_trim(option)
174 CALL ancmsg(msgid=257,c1=option(1:size_opt),anmode=aninfo)
175 CALL arret(2)
176 ! ----------------
177 ENDIF
178 ENDIF
179
180 IF(nspmd> 1)THEN
181 CALL spmd_exch_userwi(a,ar,user_windows)
182 ENDIF
183C-----------------------------------------------
184 END
185C-----------------------------------------------
186
my_real
#define my_real
Definition cppsort.cpp:32
min
#define min(a, b)
Definition macros.h:20
message_mod
Definition message_mod.F:1257
user_windows_mod
Definition user_windows_mod.F:48
spmd_exch_userwi
subroutine spmd_exch_userwi(a, ar, user_windows)
Definition spmd_exch_userwi.F:33
ancmsg
subroutine ancmsg(msgid, msgtype, anmode, i1, i2, i3, i4, i5, i6, i7, i8, i9, i10, i11, i12, i13, i14, i15, i16, i17, i18, i19, i20, r1, r2, r3, r4, r5, r6, r7, r8, r9, c1, c2, c3, c4, c5, c6, c7, c8, c9, prmode)
Definition message.F:895
arret
subroutine arret(nn)
Definition arret.F:86
user_windows_routine
subroutine user_windows_routine(ispmd, nspmd, userl_avail, user_windows, rad_inputname, len_rad_inputname, numnod, ncycle, itab, tt, dt1, wfext, d, x, v, vr, ms, in, stifn, stifr, a, ar, dt2)
Definition user_windows.F:43