OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
sfac_sol_l0omp_m.F
Go to the documentation of this file.
1C
2C This file is part of MUMPS 5.5.1, released
3C on Tue Jul 12 13:17:24 UTC 2022
4C
5C
6C Copyright 1991-2022 CERFACS, CNRS, ENS Lyon, INP Toulouse, Inria,
7C Mumps Technologies, University of Bordeaux.
8C
9C This version of MUMPS is provided to you free of charge. It is
10C released under the CeCILL-C license
11C (see doc/CeCILL-C_V1-en.txt, doc/CeCILL-C_V1-fr.txt, and
12C https://cecill.info/licences/Licence_CeCILL-C_V1-en.html)
13C
14 MODULE smumps_facsol_l0omp_m
15 PRIVATE
16 PUBLIC :: smumps_init_l0_omp_factors
17 & , smumps_free_l0_omp_factors
18 & , smumps_save_restore_l0facarray
19 CONTAINS
20 SUBROUTINE smumps_init_l0_omp_factors(id_L0_OMP_FACTORS)
21 USE smumps_struc_def, ONLY : smumps_l0ompfac_t
22 IMPLICIT NONE
23 TYPE (SMUMPS_L0OMPFAC_T), DIMENSION(:), POINTER ::
24 & id_l0_omp_factors
25 INTEGER i
26 IF (associated(id_l0_omp_factors)) THEN
27 DO i=1, size(id_l0_omp_factors)
28 NULLIFY(id_l0_omp_factors(i)%A)
29 ENDDO
30 ENDIF
31 RETURN
32 END SUBROUTINE smumps_init_l0_omp_factors
33 SUBROUTINE smumps_free_l0_omp_factors(id_L0_OMP_FACTORS)
34 USE smumps_struc_def, ONLY : smumps_l0ompfac_t
35 IMPLICIT NONE
36 TYPE (smumps_l0ompfac_t), DIMENSION(:), POINTER ::
37 & id_l0_omp_factors
38 INTEGER i
39 IF (associated(id_l0_omp_factors)) THEN
40 DO i=1, size(id_l0_omp_factors)
41 IF (associated(id_l0_omp_factors(i)%A)) THEN
42 DEALLOCATE(id_l0_omp_factors(i)%A)
43 NULLIFY(id_l0_omp_factors(i)%A)
44 ENDIF
45 ENDDO
46 DEALLOCATE(id_l0_omp_factors)
47 NULLIFY(id_l0_omp_factors)
48 ENDIF
49 RETURN
50 END SUBROUTINE smumps_free_l0_omp_factors
51 SUBROUTINE smumps_save_restore_l0facarray(L0_OMP_FACTORS
52 & ,unit,MYID,mode
53 & ,SIZE_GEST,SIZE_VARIABLES
54 & ,SIZE_INT,SIZE_INT8,SIZE_ARITH_DEP
55 & ,TOTAL_FILE_SIZE,TOTAL_STRUC_SIZE
56 & ,size_read,size_allocated,size_written
57 & ,INFO)
58 USE smumps_struc_def, ONLY : smumps_l0ompfac_t
59 IMPLICIT NONE
60 TYPE (smumps_l0ompfac_t), DIMENSION(:), POINTER :: l0_omp_factors
61 INTEGER,intent(IN)::unit,myid
62 CHARACTER(len=*),intent(IN) :: mode
63 INTEGER,INTENT(OUT) :: size_gest
64 INTEGER(8),intent(OUT) :: size_variables
65 INTEGER,intent(INOUT):: info(2)
66 INTEGER,intent(IN):: size_int, size_int8, size_arith_dep
67 INTEGER(8),intent(IN) :: total_file_size,total_struc_size
68 INTEGER(8),intent(INOUT):: size_read,size_allocated,size_written
69 INTEGER:: j1,nbrecords,nbsubrecords,size_array1,dummy,allocok,err
70 INTEGER:: size_gest_l0fac_array,
71 & size_gest_l0fac_array_j1
72 INTEGER(4) :: i4
73 INTEGER(8):: size_variables_l0fac_array,
74 & size_variables_l0fac_array_j1
75 size_gest = 0
76 size_variables = 0_8
77 size_gest_l0fac_array=0
78 size_variables_l0fac_array=0
79 size_gest_l0fac_array_j1=0
80 size_variables_l0fac_array_j1=0
81 nbrecords = 0
82 IF (trim(mode).EQ."memory_save") THEN
83 IF (associated(l0_omp_factors)) THEN
84 nbrecords = 1
85 size_gest = size_int
86 size_variables = 0
87 DO j1=1,size(l0_omp_factors)
88 CALL smumps_save_restore_l0fac(
89 & l0_omp_factors(j1)
90 & ,unit,myid,"memory_save"
91 & ,size_gest_l0fac_array_j1
92 & ,size_variables_l0fac_array_j1
93 & ,size_int,size_int8,size_arith_dep
94 & ,total_file_size,total_struc_size
95 & ,size_read,size_allocated,size_written
96 & ,info)
97 size_gest_l0fac_array=size_gest_l0fac_array+
98 & size_gest_l0fac_array_j1
99 size_variables_l0fac_array=size_variables_l0fac_array+
100 & size_variables_l0fac_array_j1
101 IF ( info(1) .LT. 0 ) GOTO 100
102 ENDDO
103 ELSE
104 nbrecords = 2
105 size_gest = 2*size_int
106 size_variables = 0
107 ENDIF
108 ELSEIF (trim(mode).EQ."save") THEN
109 IF (associated(l0_omp_factors)) THEN
110 nbrecords = 1
111 size_gest = size_int
112 size_variables = 0
113 write(unit,iostat=err) size(l0_omp_factors)
114 if(err.ne.0) then
115 info(1) = -72
116 CALL mumps_seti8toi4(total_file_size-size_written,
117 & info(2))
118 endif
119 IF ( info(1) .LT. 0 ) GOTO 100
120 DO j1=1,size(l0_omp_factors)
121 CALL smumps_save_restore_l0fac(
122 & l0_omp_factors(j1)
123 & ,unit,myid,"save"
124 & ,size_gest_l0fac_array_j1
125 & ,size_variables_l0fac_array_j1
126 & ,size_int,size_int8,size_arith_dep
127 & ,total_file_size,total_struc_size
128 & ,size_read,size_allocated,size_written
129 & ,info)
130 ENDDO
131 ELSE
132 nbrecords=2
133 size_gest=size_int*2
134 size_variables=0
135 write(unit,iostat=err) -999
136 if(err.ne.0) then
137 info(1) = -72
138 CALL mumps_seti8toi4(total_file_size-size_written,
139 & info(2))
140 endif
141 IF ( info(1) .LT. 0 ) GOTO 100
142 write(unit,iostat=err) -999
143 if(err.ne.0) then
144 info(1) = -72
145 CALL mumps_seti8toi4(total_file_size-size_written,
146 & info(2))
147 endif
148 IF ( info(1) .LT. 0 ) GOTO 100
149 ENDIF
150 ELSE IF (trim(mode).EQ."restore") THEN
151 NULLIFY(L0_OMP_FACTORS)
152 read(unit,iostat=err) size_array1
153.ne. if(err0) THEN
154 INFO(1) = -75
155 CALL MUMPS_SETI8TOI4(TOTAL_FILE_SIZE-size_read
156 & ,INFO(2))
157 endif
158.LT. IF ( INFO(1) 0 ) GOTO 100
159.EQ. if(size_array1-999) then
160 NbRecords=2
161 SIZE_GEST=SIZE_INT*2
162 SIZE_VARIABLES=0
163 read(unit,iostat=err) dummy
164.ne. if(err0) THEN
165 INFO(1) = -75
166 CALL MUMPS_SETI8TOI4(TOTAL_FILE_SIZE-size_read
167 & ,INFO(2))
168 endif
169.LT. IF ( INFO(1) 0 ) GOTO 100
170 else
171 NbRecords=1
172 SIZE_GEST=SIZE_INT
173 SIZE_VARIABLES=0
174 allocate(L0_OMP_FACTORS(size_array1), stat=allocok)
175.GT. if (allocok 0) THEN
176 INFO(1) = -78
177 CALL MUMPS_SETI8TOI4(
178 & TOTAL_STRUC_SIZE-size_allocated
179 & ,INFO(2))
180 endif
181 DO j1=1,size(L0_OMP_FACTORS)
182 CALL SMUMPS_SAVE_RESTORE_L0FAC(
183 & L0_OMP_FACTORS(j1)
184 & ,unit,MYID,"restore"
185 & ,size_gest_l0fac_array_j1
186 & ,size_variables_l0fac_array_j1
187 & ,size_int, size_int8, size_arith_dep
188 & ,total_file_size,total_struc_size
189 & ,size_read,size_allocated,size_written
190 & ,info)
191 size_gest_l0fac_array=size_gest_l0fac_array+
192 & size_gest_l0fac_array_j1
193 size_variables_l0fac_array=size_variables_l0fac_array+
194 & size_variables_l0fac_array_j1
195 IF ( info(1) .LT. 0 ) GOTO 100
196 ENDDO
197 endif
198 ENDIF
199 if(trim(mode).EQ."memory_save") then
200 nbsubrecords=int(size_variables/huge(i4))
201 IF(nbsubrecords.GT.0) then
202 nbrecords=nbrecords+nbsubrecords
203 ENDIF
204 elseif(trim(mode).EQ."save") then
205 size_written=size_written+size_variables
206 & +int(size_gest,kind=8)
207#if !defined(MUMPS_F2003)
208 size_written=size_written
209 & +int(2*size_int*nbrecords,kind=8)
210#endif
211 elseif(trim(mode).EQ."restore") then
212 size_allocated=size_allocated+size_variables
213 size_read=size_read+size_variables
214 & +int(size_gest,kind=8)
215#if !defined(MUMPS_F2003)
216 size_read=size_read
217 & +int(2*size_int*nbrecords,kind=8)
218#endif
219 endif
220 if(trim(mode).EQ."memory_save") then
221 size_variables=size_variables+size_variables_l0fac_array
222 size_gest=size_gest+size_gest_l0fac_array
223#if !defined(MUMPS_F2003)
224 size_gest=size_gest+2*size_int*nbrecords
225#endif
226 endif
227 100 continue
228 RETURN
229 END SUBROUTINE smumps_save_restore_l0facarray
230 SUBROUTINE smumps_save_restore_l0fac(
231 & L0_OMP_FACTORS_1THREAD
232 & ,unit,MYID,mode
233 & ,Local_SIZE_GEST, Local_SIZE_VARIABLES
234 & ,SIZE_INT, SIZE_INT8, SIZE_ARITH_DEP
235 & ,TOTAL_FILE_SIZE,TOTAL_STRUC_SIZE
236 & ,size_read,size_allocated,size_written
237 & ,INFO)
238 USE smumps_struc_def, ONLY : smumps_l0ompfac_t
239 IMPLICIT NONE
240 TYPE (SMUMPS_L0OMPFAC_T) :: L0_OMP_FACTORS_1THREAD
241 INTEGER,intent(IN)::unit,MYID
242 CHARACTER(len=*),intent(IN) :: mode
243 INTEGER,INTENT(OUT) :: Local_SIZE_GEST
244 INTEGER(8),intent(OUT) :: Local_SIZE_VARIABLES
245 INTEGER,intent(INOUT):: INFO(2)
246 INTEGER,intent(IN):: SIZE_INT, SIZE_INT8, SIZE_ARITH_DEP
247 INTEGER(8),intent(IN) :: TOTAL_FILE_SIZE,TOTAL_STRUC_SIZE
248 INTEGER(8),intent(INOUT):: size_read,size_allocated,size_written
249 INTEGER:: Local_NbRecords, allocok, err
250 INTEGER(8) :: itmp
251 local_nbrecords = 0
252 local_size_gest = 0
253 local_size_variables = 0_8
254 local_nbrecords = local_nbrecords+1
255 IF (trim(mode) .EQ. "memory_save") THEN
256 local_size_variables = local_size_variables + size_int8
257 ELSE IF (trim(mode) .EQ. "save") THEN
258 local_size_variables = local_size_variables + size_int8
259 WRITE(unit,iostat=err) l0_omp_factors_1thread%LA
260 IF (err .NE. 0) THEN
261 info(1)=-72
262 CALL mumps_seti8toi4(total_file_size-size_written,
263 & info(2))
264 GOTO 100
265 ENDIF
266 size_written=size_written+size_int8
267 ELSE IF (trim(mode) .EQ. "restore") THEN
268 local_size_variables = local_size_variables + size_int8
269 READ(unit,iostat=err) l0_omp_factors_1thread%LA
270 IF (err .NE. 0) THEN
271 info(1) = -75
272 CALL mumps_seti8toi4(total_file_size-size_read,
273 & info(2))
274 GOTO 100
275 ENDIF
276 size_read=size_read+size_int8
277 ENDIF
278 IF (trim(mode).EQ."memory_save") THEN
279 IF (associated(l0_omp_factors_1thread%A)) THEN
280 local_nbrecords = local_nbrecords + 2
281 local_size_gest = local_size_gest + size_int8
282 local_size_variables = local_size_variables +
283 & max(1_8,l0_omp_factors_1thread%LA)*size_arith_dep
284 ELSE
285 local_nbrecords = local_nbrecords + 1
286 local_size_gest = local_size_gest + size_int8
287 local_size_variables = local_size_variables + 0
288 ENDIF
289 ELSEIF (trim(mode).EQ."save") THEN
290 IF (associated(l0_omp_factors_1thread%A)) THEN
291 local_nbrecords = local_nbrecords + 2
292 write(unit,iostat=err) int(0,8)
293 if(err.ne.0) then
294 info(1) = -72
295 CALL mumps_seti8toi4(total_file_size-size_written,
296 & info(2))
297 GOTO 100
298 endif
299 size_written=size_written+size_int8
300 write(unit,iostat=err) l0_omp_factors_1thread%A
301 if(err.ne.0) then
302 info(1) = -72
303 CALL mumps_seti8toi4(total_file_size-size_written,
304 & info(2))
305 GOTO 100
306 endif
307 size_written = size_written +
308 & max(l0_omp_factors_1thread%LA,1_8)*size_arith_dep
309 ELSE
310 local_nbrecords = local_nbrecords + 1
311 write(unit,iostat=err) int(-999,8)
312 if(err.ne.0) then
313 info(1) = -72
314 CALL mumps_seti8toi4(total_file_size-size_written,
315 & info(2))
316 GOTO 100
317 endif
318 size_written=size_written+size_int8
319 ENDIF
320 ELSEIF (trim(mode).EQ."restore") THEN
321 NULLIFY(l0_omp_factors_1thread%A)
322 READ(unit,iostat=err) itmp
323 if(err.ne.0) THEN
324 info(1) = -75
325 CALL mumps_seti8toi4(total_file_size-size_read
326 & ,info(2))
327 GOTO 100
328 endif
329 size_read = size_read + size_int8
330 size_allocated = size_allocated + size_int8
331 IF (itmp .eq. -999) THEN
332 local_nbrecords = local_nbrecords + 1
333 ELSE
334 local_nbrecords = local_nbrecords + 2
335 ALLOCATE(l0_omp_factors_1thread%A(
336 & max(l0_omp_factors_1thread%LA,1_8)),
337 & stat=allocok)
338 IF (allocok .GT. 0) THEN
339 info(1) = -78
340 CALL mumps_seti8toi4(
341 & total_struc_size-size_allocated
342 & ,info(2))
343 GOTO 100
344 ENDIF
345 READ(unit,iostat=err) l0_omp_factors_1thread%A
346 if(err.ne.0) THEN
347 info(1) = -75
348 CALL mumps_seti8toi4(total_file_size-size_read
349 & ,info(2))
350 GOTO 100
351 endif
352 size_read = size_read +
353 & max(1_8,l0_omp_factors_1thread%LA)*size_arith_dep
354 size_allocated = size_allocated+
355 & max(1_8,l0_omp_factors_1thread%LA)*size_arith_dep
356 ENDIF
357 ENDIF
358#if !defined(MUMPS_F2003)
359 IF (trim(mode).EQ."memory_save") THEN
360 local_size_gest = local_size_gest+2*size_int*local_nbrecords
361 ELSE IF (trim(mode).EQ."save") THEN
362 size_written = size_written+2*size_int*local_nbrecords
363 ELSE IF (trim(mode).EQ."restore") THEN
364 size_read = size_read+2*size_int*local_nbrecords
365 ENDIF
366#endif
367 100 CONTINUE
368 RETURN
369 END SUBROUTINE smumps_save_restore_l0fac
370 END MODULE smumps_facsol_l0omp_m
max
#define max(a, b)
Definition macros.h:21
smumps_facsol_l0omp_m
Definition sfac_sol_l0omp_m.F:14
smumps_facsol_l0omp_m::smumps_save_restore_l0fac
subroutine smumps_save_restore_l0fac(l0_omp_factors_1thread, unit, myid, mode, local_size_gest, local_size_variables, size_int, size_int8, size_arith_dep, total_file_size, total_struc_size, size_read, size_allocated, size_written, info)
Definition sfac_sol_l0omp_m.F:238
smumps_facsol_l0omp_m::smumps_init_l0_omp_factors
subroutine, public smumps_init_l0_omp_factors(id_l0_omp_factors)
Definition sfac_sol_l0omp_m.F:21
smumps_facsol_l0omp_m::smumps_free_l0_omp_factors
subroutine, public smumps_free_l0_omp_factors(id_l0_omp_factors)
Definition sfac_sol_l0omp_m.F:34
smumps_facsol_l0omp_m::smumps_save_restore_l0facarray
subroutine, public smumps_save_restore_l0facarray(l0_omp_factors, unit, myid, mode, size_gest, size_variables, size_int, size_int8, size_arith_dep, total_file_size, total_struc_size, size_read, size_allocated, size_written, info)
Definition sfac_sol_l0omp_m.F:58
smumps_struc_def
Definition smumps_struc_def.F:14
mumps_seti8toi4
subroutine mumps_seti8toi4(i8, i)
Definition tools_common.F:843