OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
VE_Ana_orderings_interface.f90 File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine ve_fmumps_ana_h (totel, compute_perm, n, iwlen, pe, pfree, len, iw, nv, elen, last, ncmpa, degree, head, next, w, parent)
subroutine ve_fmumps_symqamd (thresh, ndense, n, totel, iwlen, pe, pfree, len, iw, nv, elen, last, ncmpa, degree, head, next, w, perm, listvar_schur, size_schur, agg6, parent)
subroutine ve_fmumps_wrap_ginp94 (n, ipe, iw, liw8, perm, sizeofblocks, keep60, listvar_schur, size_schur, colcount, parent, porder, iwtmp1, iwtmp2, iwtmp3, iwtmp4, iwtmp5, info)

Function/Subroutine Documentation

◆ ve_fmumps_ana_h()

subroutine ve_fmumps_ana_h ( integer(kind=c_int), intent(in) totel,
logical(kind=c_bool), intent(in) compute_perm,
integer(kind=c_int), intent(in) n,
integer(kind=c_int64_t), intent(in) iwlen,
integer(kind=c_int64_t), dimension(n), intent(inout) pe,
integer(kind=c_int64_t), dimension(1), intent(inout) pfree,
integer(kind=c_int), dimension(n), intent(inout) len,
integer(kind=c_int), dimension(iwlen), intent(inout) iw,
integer(kind=c_int), dimension(n), intent(inout) nv,
integer(kind=c_int), dimension(n), intent(out) elen,
integer(kind=c_int), dimension(n), intent(out) last,
integer(kind=c_int), dimension(1), intent(out) ncmpa,
integer(kind=c_int), dimension(n) degree,
integer(kind=c_int), dimension(totel) head,
integer(kind=c_int), dimension(n) next,
integer(kind=c_int), dimension(n) w,
integer(kind=c_int), dimension(n), intent(out) parent )

Definition at line 15 of file VE_Ana_orderings_interface.f90.

20 USE iso_c_binding, ONLY : c_int,c_bool,c_int64_t
21 IMPLICIT NONE
22 ! INTERFACE TO C ROUTINE
23 ! Input not modified
24 INTEGER(KIND=C_INT), INTENT(IN) :: TOTEL, N
25 INTEGER(KIND=C_INT64_T), INTENT(IN) :: IWLEN
26 LOGICAL(KIND=C_BOOL), INTENT(IN) :: COMPUTE_PERM
27 ! Input undefined on output
28 INTEGER(KIND=C_INT), INTENT(INOUT) :: LEN(N), IW(IWLEN)
29 !
30 ! Output only
31 INTEGER(KIND=C_INT), INTENT(OUT) :: NCMPA(1)
32 INTEGER(KIND=C_INT), INTENT(OUT) :: ELEN(N), LAST(N), PARENT(N)
33 !
34 ! Input/output
35 INTEGER(KIND=C_INT64_T), INTENT(INOUT) :: PFREE(1)
36 INTEGER(KIND=C_INT64_T), INTENT(INOUT) :: PE(N)
37 ! NV also meaningful as input to encode compressed graphs
38 INTEGER(KIND=C_INT), INTENT(INOUT) :: NV(N)
39 !
40 ! Internal Workspace only
41 INTEGER(KIND=C_INT) :: NEXT(N), DEGREE(N), HEAD(TOTEL), W(N)
42 INTERFACE
43 SUBROUTINE ve_mumps_ana_h( &
44 TOTEL , COMPUTE_PERM , N , IWLEN , PE , &
45 PFREE , LEN , IW , NV , ELEN , &
46 LAST , NCMPA , DEGREE , HEAD , NEXT , &
47 W , PARENT ) &
48 bind(c, name='VE_Mumps_ana_h')
49 USE iso_c_binding, ONLY : c_int,c_bool,c_int64_t
50 IMPLICIT NONE
51 ! Input not modified
52 INTEGER(KIND=C_INT) , VALUE, INTENT(IN) :: TOTEL, N
53 INTEGER(KIND=C_INT64_T), VALUE, INTENT(IN) :: IWLEN
54 LOGICAL(KIND=C_BOOL) , VALUE, INTENT(IN) :: COMPUTE_PERM
55 ! Input undefined on output
56 INTEGER(KIND=C_INT), INTENT(INOUT) :: LEN(N), IW(IWLEN)
57 !
58 ! Output only
59 INTEGER(KIND=C_INT), INTENT(OUT) :: NCMPA(1)
60 INTEGER(KIND=C_INT), INTENT(OUT) :: ELEN(N), LAST(N), PARENT(N)
61 !
62 ! Input/output
63 INTEGER(KIND=C_INT64_T), INTENT(INOUT) :: PFREE(1)
64 INTEGER(KIND=C_INT64_T), INTENT(INOUT) :: PE(N)
65 ! NV also meaningful as input to encode compressed graphs
66 INTEGER(KIND=C_INT), INTENT(INOUT) :: NV(N)
67 !
68 ! Internal Workspace only
69 INTEGER(KIND=C_INT) :: NEXT(N), DEGREE(N), HEAD(TOTEL), W(N)
70 END SUBROUTINE ve_mumps_ana_h
71 END INTERFACE
72
73 WRITE(6,'(A)')'-----------------> Performing VH call of MUMPS_ANA_H'
74 CALL ve_mumps_ana_h( &
75 totel , compute_perm , n , iwlen , pe , &
76 pfree , len , iw , nv , elen , &
77 last , ncmpa , degree , head , next , &
78 w , parent )

◆ ve_fmumps_symqamd()

subroutine ve_fmumps_symqamd ( integer(kind=c_int), intent(in) thresh,
integer(kind=c_int), dimension(n), intent(out) ndense,
integer(kind=c_int), intent(in) n,
integer(kind=c_int), intent(in) totel,
integer(kind=c_int64_t), intent(in) iwlen,
integer(kind=c_int64_t), dimension(n), intent(inout) pe,
integer(kind=c_int64_t), dimension(1), intent(inout) pfree,
integer, dimension(n), intent(inout) len,
integer, dimension(iwlen), intent(inout) iw,
integer(kind=c_int), dimension(n), intent(inout) nv,
integer(kind=c_int), dimension(n), intent(out) elen,
integer(kind=c_int), dimension(totel), intent(out) last,
integer(kind=c_int), dimension(1), intent(out) ncmpa,
integer(kind=c_int), dimension(n), intent(out) degree,
integer(kind=c_int), dimension(totel), intent(out) head,
integer(kind=c_int), dimension(n), intent(out) next,
integer(kind=c_int), dimension(n), intent(out) w,
integer(kind=c_int), dimension(n), intent(inout) perm,
integer(kind=c_int), dimension(max(1,size_schur)), intent(in) listvar_schur,
integer(kind=c_int), intent(in) size_schur,
logical(kind=c_bool), intent(in) agg6,
integer(kind=c_int), dimension(n), intent(out) parent )

Definition at line 87 of file VE_Ana_orderings_interface.f90.

93 USE iso_c_binding, ONLY : c_int,c_bool,c_int64_t
94 IMPLICIT NONE
95 ! INTERFACE TO C ROUTINE
96 ! Input not modified
97 INTEGER(KIND=C_INT) , INTENT(IN) :: N, TOTEL, SIZE_SCHUR
98 LOGICAL(KIND=C_BOOL) , INTENT(IN) :: AGG6
99 INTEGER(KIND=C_INT) , INTENT(IN) :: THRESH
100 INTEGER(KIND=C_INT64_T), INTENT(IN) :: IWLEN
101 INTEGER(KIND=C_INT) , INTENT(IN) :: LISTVAR_SCHUR(max(1,SIZE_SCHUR))
102 ! Input undefined on output
103 INTEGER, INTENT(INOUT) :: LEN(N), IW(IWLEN)
104 !
105 ! Output only
106 INTEGER(KIND=C_INT), INTENT(OUT) :: NCMPA(1)
107 INTEGER(KIND=C_INT), INTENT(OUT) :: ELEN(N), LAST(TOTEL), PARENT(N)
108 !
109 ! Input/output
110 INTEGER(KIND=C_INT), INTENT(INOUT) :: NV(N)
111 INTEGER(KIND=C_INT64_T), INTENT(INOUT) :: PFREE(1)
112 INTEGER(KIND=C_INT64_T), INTENT(INOUT) :: PE(N)
113 INTEGER(KIND=C_INT), INTENT(INOUT) :: PERM(N)
114 !
115 ! Internal Workspace only
116 INTEGER(KIND=C_INT), INTENT(OUT) :: NDENSE(N), DEGREE(N)
117 INTEGER(KIND=C_INT), INTENT(OUT) :: HEAD(TOTEL), NEXT(N), W(N)
118 INTERFACE
119 SUBROUTINE ve_mumps_symqamd( &
120 THRESH , NDENSE , N , TOTEL , IWLEN , &
121 PE , PFREE , LEN , IW , NV , &
122 ELEN , LAST , NCMPA , DEGREE , HEAD , &
123 NEXT , W , PERM , LISTVAR_SCHUR , SIZE_SCHUR , &
124 AGG6 , PARENT ) &
125 bind(c, name='VE_Mumps_symqamd')
126 USE iso_c_binding, ONLY : c_int,c_bool,c_int64_t
127 IMPLICIT NONE
128 ! Input not modified
129 INTEGER(KIND=C_INT) , VALUE , INTENT(IN) :: N, TOTEL, SIZE_SCHUR
130 LOGICAL(KIND=C_BOOL) , VALUE , INTENT(IN) :: AGG6
131 INTEGER(KIND=C_INT) , VALUE , INTENT(IN) :: THRESH
132 INTEGER(KIND=C_INT64_T), VALUE , INTENT(IN) :: IWLEN
133 INTEGER(KIND=C_INT) , INTENT(IN) :: LISTVAR_SCHUR(max(1,SIZE_SCHUR))
134 ! Input undefined on output
135 INTEGER, INTENT(INOUT) :: LEN(N), IW(IWLEN)
136 !
137 ! Output only
138 INTEGER(KIND=C_INT), INTENT(OUT) :: NCMPA(1)
139 INTEGER(KIND=C_INT), INTENT(OUT) :: ELEN(N), LAST(TOTEL), PARENT(N)
140 !
141 ! Input/output
142 INTEGER(KIND=C_INT), INTENT(INOUT) :: NV(N)
143 INTEGER(KIND=C_INT64_T), INTENT(INOUT) :: PFREE(1)
144 INTEGER(KIND=C_INT64_T), INTENT(INOUT) :: PE(N)
145 INTEGER(KIND=C_INT), INTENT(INOUT) :: PERM(N)
146 !
147 ! Internal Workspace only
148 INTEGER(KIND=C_INT), INTENT(OUT) :: NDENSE(N), DEGREE(N)
149 INTEGER(KIND=C_INT), INTENT(OUT) :: HEAD(TOTEL), NEXT(N), W(N)
150 END SUBROUTINE ve_mumps_symqamd
151 END INTERFACE
152
153 WRITE(6,'(A)')'-----------------> Performing VH call of MUMPS_SYMQAMD'
154 CALL ve_mumps_symqamd( &
155 thresh , ndense , n , totel , iwlen , &
156 pe , pfree , len , iw , nv , &
157 elen , last , ncmpa , degree , head , &
158 next , w , perm , listvar_schur , size_schur , &
159 agg6 , parent )

◆ ve_fmumps_wrap_ginp94()

subroutine ve_fmumps_wrap_ginp94 ( integer(kind=c_int), intent(in) n,
integer(kind=c_int64_t), dimension(n+1), intent(in) ipe,
integer(kind=c_int), dimension(liw8), intent(in) iw,
integer(kind=c_int64_t), intent(in) liw8,
integer(kind=c_int), dimension(n), intent(inout) perm,
integer(kind=c_int), dimension(n), intent(in) sizeofblocks,
integer(kind=c_int), intent(in) keep60,
integer(kind=c_int), dimension(size_schur), intent(in) listvar_schur,
integer(kind=c_int), intent(in) size_schur,
integer(kind=c_int), dimension(n), intent(out) colcount,
integer(kind=c_int), dimension(n), intent(out) parent,
integer(kind=c_int), dimension(n), intent(out) porder,
integer(kind=c_int), dimension(n), intent(out) iwtmp1,
integer(kind=c_int), dimension(n), intent(out) iwtmp2,
integer(kind=c_int), dimension(n), intent(out) iwtmp3,
integer(kind=c_int), dimension(n), intent(out) iwtmp4,
integer(kind=c_int), dimension(n), intent(out) iwtmp5,
integer(kind=c_int), dimension(2), intent(inout) info )

Definition at line 168 of file VE_Ana_orderings_interface.f90.

173 USE iso_c_binding, ONLY : c_int,c_int64_t
174 IMPLICIT NONE
175 ! INTERFACE TO C ROUTINE
176 ! Input not modified
177 INTEGER(KIND=C_INT) , INTENT(IN) :: N, KEEP60, SIZE_SCHUR
178 INTEGER(KIND=C_INT) , INTENT(IN) :: SizeOfBlocks(N)
179 INTEGER(KIND=C_INT) , INTENT(IN) :: LISTVAR_SCHUR(SIZE_SCHUR)
180 INTEGER(KIND=C_INT64_T), INTENT(IN) :: LIW8,IPE(N+1)
181 INTEGER(KIND=C_INT) , INTENT(IN) :: IW(LIW8)
182 !
183 ! Output only
184 INTEGER(KIND=C_INT), INTENT(OUT) :: COLCOUNT(N),PARENT(N)
185 INTEGER(KIND=C_INT), INTENT(OUT) :: PORDER(N), IWTMP1(N), IWTMP2(N)
186 INTEGER(KIND=C_INT), INTENT(OUT) :: IWTMP3(N), IWTMP4(N), IWTMP5(N)
187 !
188 ! Input/output
189 INTEGER(KIND=C_INT), INTENT(INOUT) :: PERM(N)
190 INTEGER(KIND=C_INT), INTENT(INOUT) :: INFO(2)
191 INTERFACE
192 SUBROUTINE ve_mumps_wrap_ginp94( &
193 N , IPE , IW , LIW8 , PERM , &
194 SizeOfBlocks , KEEP60 , LISTVAR_SCHUR , SIZE_SCHUR , COLCOUNT , &
195 PARENT , PORDER , IWTMP1 , IWTMP2 , IWTMP3 , &
196 IWTMP4 , IWTMP5 , INFO ) &
197 bind(c, name='VE_Mumps_wrap_ginp94')
198 USE iso_c_binding, ONLY : c_int,c_int64_t
199 IMPLICIT NONE
200 ! Input not modified
201 INTEGER(KIND=C_INT) , VALUE , INTENT(IN) :: N, KEEP60, SIZE_SCHUR
202 INTEGER(KIND=C_INT64_T), VALUE , INTENT(IN) :: LIW8
203 INTEGER(KIND=C_INT) , INTENT(IN) :: SizeOfBlocks(N)
204 INTEGER(KIND=C_INT) , INTENT(IN) :: LISTVAR_SCHUR(SIZE_SCHUR)
205 INTEGER(KIND=C_INT64_T) , INTENT(IN) :: IPE(N+1)
206 INTEGER(KIND=C_INT) , INTENT(IN) :: IW(LIW8)
207 !
208 ! Output only
209 INTEGER(KIND=C_INT), INTENT(OUT) :: COLCOUNT(N),PARENT(N)
210 INTEGER(KIND=C_INT), INTENT(OUT) :: PORDER(N), IWTMP1(N), IWTMP2(N)
211 INTEGER(KIND=C_INT), INTENT(OUT) :: IWTMP3(N), IWTMP4(N), IWTMP5(N)
212 !
213 ! Input/output
214 INTEGER(KIND=C_INT), INTENT(INOUT) :: PERM(N)
215 INTEGER(KIND=C_INT), INTENT(INOUT) :: INFO(2)
216 END SUBROUTINE ve_mumps_wrap_ginp94
217 END INTERFACE
218
219 WRITE(6,'(A)')'-----------------> Performing VH call of MUMPS_WRAP_GINP94'
220 CALL ve_mumps_wrap_ginp94( &
221 n , ipe , iw , liw8 , perm , &
222 sizeofblocks , keep60 , listvar_schur , size_schur , colcount , &
223 parent , porder , iwtmp1 , iwtmp2 , iwtmp3 , &
224 iwtmp4 , iwtmp5 , info )