OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
user_windows_tools.F File Reference
#include "implicit_f.inc"

Go to the source code of this file.

Functions/Subroutines

subroutine set_user_window_nodes (usernods, number_usernods)
subroutine userwis_front (usernods, nusernods)
subroutine spmd_userwi_rest (user_windows, nodlocal, numnod, numnod_l, p, nspmd)

Function/Subroutine Documentation

◆ set_user_window_nodes()

subroutine set_user_window_nodes ( integer, dimension(number_usernods), intent(in) usernods,
integer, intent(in) number_usernods )

Definition at line 33 of file user_windows_tools.F.

34!$COMMENT
35 ! -----------------------------------------------
36 ! ROUTINE DESCRIPTION :
37 ! ===================
38 ! Callback routine for User Windows
39 ! Grabs the Nodes from the UserWindows for Storing
40 ! and Sets them to Domain 1
41 ! ------------------------------------------------
42 ! DUMMY ARGUMENTS DESCRIPTION:
43 ! ===================
44 !
45 ! NAME DESCRIPTION
46 !
47 ! usernods array with user nodes
48 ! NUMBER_USERNODS Array size
49 !------------------------------------------------------------------
50!$ENDCOMMENT
51C-----------------------------------------------
52C M o d u l e s
53C-----------------------------------------------
54 USE my_alloc_mod
55 USE message_mod
57 USE user_interface_mod
58 USE restmod
59C-----------------------------------------------
60C I m p l i c i t T y p e s
61C-----------------------------------------------
62#include "implicit_f.inc"
63C-----------------------------------------------
64C D u m m y A r g u m e n t s
65C-----------------------------------------------
66 INTEGER, INTENT(IN) :: NUMBER_USERNODS
67 INTEGER, INTENT(IN),DIMENSION(NUMBER_USERNODS) :: USERNODS
68C-----------------------------------------------
69C L o c a l V a r i a b l e s
70C-----------------------------------------------
71 INTEGER I,NOD,INTERNAL_NOD,USERWI_ID
72 INTEGER,DIMENSION(:),ALLOCATABLE::WORK,USER_NDS,IDX,SORT
73 CHARACTER(len=40) :: MESS
74 DATA mess/'USER WINDOWS '/
75C-----------------------------------------------
76 INTEGER USR2SYS
77 EXTERNAL usr2sys
78
79 userwi_id = user_windows%USER_WINDOWS_ID
80 user_windows%N_USERNODS = number_usernods
81
82 CALL my_alloc(user_nds,number_usernods)
83 CALL my_alloc(user_windows%USERNODS,number_usernods)
84
85 !print*,'NUMBER_USERNODS=',NUMBER_USERNODS
86 !print*,'USERNDS=',USERNODS(1:NUMBER_USERNODS)
87
88 DO i=1,number_usernods
89 nod = usernods(i)
90 internal_nod = usr2sys(nod,itabm1,mess,userwi_id )
91 user_nds(i) = internal_nod
92 ENDDO
93
94 ! Sort Nodes
95 CALL my_alloc(work,70000)
96 CALL my_alloc(idx,2*number_usernods)
97 CALL my_alloc(sort,number_usernods)
98 DO i=1,number_usernods
99 idx(i)=i
100 sort(i)=user_nds(i)
101 ENDDO
102 CALL my_orders(0,work,sort,idx,number_usernods,1)
103 DO i=1,number_usernods
104 user_windows%USERNODS(i) = sort(idx(i))
105 ENDDO
106
107 CALL userwis_front(user_windows%USERNODS,number_usernods)
108
109 DEALLOCATE(work)
110 DEALLOCATE(idx)
111 DEALLOCATE(sort)
112 DEALLOCATE(user_nds)
113
void my_orders(int *mode, int *iwork, int *data, int *index, int *n, int *irecl)
Definition my_orders.c:82
integer, dimension(:), allocatable, target itabm1
Definition restart_mod.F:60
integer function usr2sys(iu, itabm1, mess, id)
Definition sysfus.F:160
subroutine userwis_front(usernods, nusernods)

◆ spmd_userwi_rest()

subroutine spmd_userwi_rest ( type(user_windows_), intent(in) user_windows,
integer, dimension(1:numnod), intent(in) nodlocal,
integer, intent(in) numnod,
integer, intent(in) numnod_l,
integer, intent(in) p,
integer, intent(in) nspmd )

Definition at line 178 of file user_windows_tools.F.

180!$COMMENT
181 ! -----------------------------------------------
182 ! ROUTINE DESCRIPTION :
183 ! ===================
184 ! Split & Write UserWindows on disk
185 ! ------------------------------------------------
186 ! dummy arguments description:
187 ! ===================
188 !
189 ! NAME DESCRIPTION
190 !
191 ! USER_WINDOWS USER Windows type
192 ! NODLOCAL NODLOCAL ARRAY - Starter to Engine Node numbering
193 ! NUMNOD Total number of nodes
194 ! P Current SPMD Domain to write
195 ! NSPMD Total number of SPMD domains
196 !------------------------------------------------------------------
197!$ENDCOMMENT
198C-----------------------------------------------
199C M o d u l e s
200C-----------------------------------------------
201 USE my_alloc_mod
202 USE message_mod
204C-----------------------------------------------
205C I m p l i c i t T y p e s
206C-----------------------------------------------
207#include "implicit_f.inc"
208C-----------------------------------------------
209C D u m m y A r g u m e n t s
210C-----------------------------------------------
211 TYPE(USER_WINDOWS_),INTENT(IN) :: USER_WINDOWS
212 INTEGER,DIMENSION(1:NUMNOD),INTENT(IN) :: NODLOCAL
213 INTEGER ,INTENT(IN) :: P,NSPMD,NUMNOD,NUMNOD_L
214C-----------------------------------------------
215C L o c a l V a r i a b l e s
216C-----------------------------------------------
217 INTEGER,DIMENSION(:),ALLOCATABLE::FR_USERWI_L
218 INTEGER,DIMENSION(:),ALLOCATABLE::IAD_USERW,IAD_USERW2,USERNODS_L
219 INTEGER,DIMENSION(:),ALLOCATABLE::PLIST
220 INTEGER I,II,J
221 INTEGER SFR_USERWI_L,SPLIST,NP,K
222 my_real, DIMENSION(:),ALLOCATABLE :: dum_sav
223C-----------------------------------------------
224C F u n c t i o n
225C-----------------------------------------------
226 INTEGER NLOCAL
227 EXTERNAL nlocal
228C======================================================================|
229 CALL write_i_c(user_windows%HAS_USER_WINDOW,1)
230 IF(user_windows%HAS_USER_WINDOW /= 0 ) THEN
231
232 IF (p == 1)THEN
233
234 ! Send Index & Buffer
235 ! ---------------------
236 CALL my_alloc(iad_userw,nspmd+1)
237 CALL my_alloc(plist,nspmd)
238 iad_userw(1:nspmd+1)=0
239
240 DO ii=1,user_windows%N_USERNODS
241 i = user_windows%USERNODS(ii)
242 CALL plist_ifront(plist,i,splist)
243 DO j=1,splist
244 np = plist(j)
245 IF(np /= 1)THEN
246 iad_userw(np+1)=iad_userw(np+1)+1
247 ENDIF
248 ENDDO
249 ENDDO
250
251 iad_userw(1)=1
252 DO np=2,nspmd+1
253 iad_userw(np)=iad_userw(np) + iad_userw(np-1)
254 ENDDO
255 sfr_userwi_l = iad_userw(nspmd+1)-1
256 CALL my_alloc(fr_userwi_l,sfr_userwi_l)
257 CALL my_alloc(iad_userw2,nspmd+1)
258 iad_userw2(1:nspmd+1) = iad_userw(1:nspmd+1)
259
260 DO ii=1,user_windows%N_USERNODS
261 i = user_windows%USERNODS(ii)
262 CALL plist_ifront(plist,i,splist)
263 DO j=1,splist
264 np = plist(j)
265 k = iad_userw2(np)
266 fr_userwi_l(k) = nodlocal(k)
267 iad_userw2(np) = iad_userw2(np) + 1
268 ENDDO
269 ENDDO
270
271 ! UserNode LIST Transform
272 ! -----------------------
273 CALL my_alloc(usernods_l,user_windows%N_USERNODS)
274 DO i=1,user_windows%N_USERNODS
275 usernods_l(i) = nodlocal(user_windows%USERNODS(i))
276 ENDDO
277
278 ! WRITE IN RESTART FILE
279 ! -----------------------
280 ! UserWindows Structure
281 CALL write_i_c(user_windows%NUVAR,1)
282 CALL write_i_c(user_windows%NUVARI,1)
283 CALL write_i_c(user_windows%S_IUSER,1)
284 CALL write_i_c(user_windows%S_USER,1)
285 CALL write_i_c(user_windows%N_USERNODS,1)
286 CALL write_i_c(user_windows%IUSER,user_windows%S_IUSER)
287 CALL write_db(user_windows%USREINT,1)
288 CALL write_db(user_windows%USER,user_windows%S_USER)
289 CALL write_i_c(usernods_l,user_windows%N_USERNODS)
290 !SPMD Structures
291 CALL write_i_c(sfr_userwi_l,1)
292 CALL write_i_c(iad_userw,nspmd+1)
293 CALL write_i_c(fr_userwi_l,sfr_userwi_l)
294
295 IF(ALLOCATED(usernods_l)) DEALLOCATE(usernods_l)
296 IF(ALLOCATED(iad_userw)) DEALLOCATE(iad_userw)
297 IF(ALLOCATED(fr_userwi_l)) DEALLOCATE(fr_userwi_l)
298
299 ! WRITE A_SAV & AR_SAV only on ispmd==0
300 ALLOCATE(dum_sav(3*numnod_l))
301 dum_sav(1:3*numnod_l)=zero
302 CALL write_db(dum_sav,3*numnod_l)
303 CALL write_db(dum_sav,3*numnod_l)
304 DEALLOCATE(dum_sav)
305
306 ELSE ! Receive buffer from P=1
307 CALL my_alloc(fr_userwi_l,user_windows%N_USERNODS)
308 fr_userwi_l(1:user_windows%N_USERNODS)=0
309 sfr_userwi_l = 0
310 DO ii=1,user_windows%N_USERNODS
311
312 i = user_windows%USERNODS(ii)
313 IF(nlocal(i,p)==1)THEN
314 sfr_userwi_l = sfr_userwi_l +1
315 fr_userwi_l(sfr_userwi_l) = nodlocal(i)
316 ENDIF
317
318 ENDDO
319
320 ! WRITE IN RESTART FILE
321 ! -----------------------
322
323 CALL write_i_c(sfr_userwi_l,1)
324 CALL write_i_c(fr_userwi_l,sfr_userwi_l)
325 IF(ALLOCATED(fr_userwi_l)) DEALLOCATE(fr_userwi_l)
326
327 ENDIF
328 ENDIF
329
330
#define my_real
Definition cppsort.cpp:32
subroutine plist_ifront(tab, n, cpt)
Definition ddtools.F:153
integer function nlocal(n, p)
Definition ddtools.F:349
subroutine write_db(a, n)
Definition write_db.F:140
void write_i_c(int *w, int *len)

◆ userwis_front()

subroutine userwis_front ( integer, dimension(1:nusernods), intent(in) usernods,
integer, intent(in) nusernods )

Definition at line 123 of file user_windows_tools.F.

124!$COMMENT
125 ! -----------------------------------------------
126 ! ROUTINE DESCRIPTION :
127 ! ===================
128 ! Set User Windows Node to Proc 1
129 ! ------------------------------------------------
130 ! DUMMY ARGUMENTS DESCRIPTION:
131 ! ===================
132 !
133 ! NAME DESCRIPTION
134 !
135 ! USERNODS Array with User nodes
136 ! NUSERNODS Array size
137 !------------------------------------------------------------------
138!$ENDCOMMENT
139C-----------------------------------------------
140C M o d u l e s
141C-----------------------------------------------
142 USE my_alloc_mod
143C-----------------------------------------------
144C I m p l i c i t T y p e s
145C-----------------------------------------------
146#include "implicit_f.inc"
147C-----------------------------------------------
148C C o m m o n B l o c k s
149C-----------------------------------------------
150C-----------------------------------------------
151C D u m m y A r g u m e n t s
152C-----------------------------------------------
153 INTEGER, INTENT(IN) :: NUSERNODS
154 INTEGER, DIMENSION(1:NUSERNODS),INTENT(IN) :: USERNODS
155C-----------------------------------------------
156C L o c a l V a r i a b l e s
157C-----------------------------------------------
158 INTEGER I,NOD
159C======================================================================|
160 DO i=1,nusernods
161 nod = usernods(i)
162 IF (nod/=0)THEN
163 CALL ifrontplus(nod,1)
164 ENDIF
165 ENDDO
166
subroutine ifrontplus(n, p)
Definition frontplus.F:100