OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
dmumps_lr_data_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 dmumps_lr_data_m
15 USE dmumps_lr_type
16 IMPLICIT NONE
17 PRIVATE
18 PUBLIC :: dmumps_blr_end_front, dmumps_blr_init_module,
19 & dmumps_blr_end_module, dmumps_blr_init_front,
20 & dmumps_blr_save_init,
21 & dmumps_blr_save_panel_loru, dmumps_blr_retrieve_begs_blr_l,
22 & dmumps_blr_save_begs_blr_c, dmumps_blr_retrieve_begs_blr_c,
23 & dmumps_blr_dec_and_retrieve_l, dmumps_blr_retrieve_panel_loru,
24 & dmumps_blr_dec_and_tryfree_l, dmumps_blr_try_free_panel,
25 & dmumps_blr_free_cb_lrb, dmumps_blr_free_all_panels,
26 & dmumps_blr_save_cb_lrb,
27 & dmumps_blr_retrieve_cb_lrb, dmumps_blr_retrieve_begsblr_sta,
28 & dmumps_blr_save_begs_blr_dyn, dmumps_blr_retrieve_begsblr_dyn,
29 & dmumps_blr_retrieve_nb_panels, dmumps_blr_empty_panel_loru,
30 & dmumps_blr_save_nfs4father, dmumps_blr_retrieve_nfs4father,
31 & dmumps_blr_save_m_array, dmumps_blr_retrieve_m_array,
32 & dmumps_blr_free_m_array
33 & , dmumps_blr_struc_to_mod, dmumps_blr_mod_to_struc, blr_array
34#if ! defined(MUMPS_F2003)
35 & , blr_struc_t, blr_panel_type, diag_block_type
36#endif
37 & , dmumps_blr_save_diag_block, dmumps_blr_retrieve_diag_block
38 & , dmumps_save_restore_blr
39 TYPE blr_panel_type
40 integer :: nb_accesses_left
41 type(lrb_type), pointer :: lrb_panel(:)
42 END TYPE blr_panel_type
43 TYPE diag_block_type
44 DOUBLE PRECISION, POINTER :: diag_block(:)
45 END TYPE diag_block_type
46 TYPE blr_struc_t
47 LOGICAL :: issym, ist2, isslave
48 TYPE(blr_panel_type), DIMENSION (:), POINTER :: panels_l
49 TYPE(blr_panel_type), DIMENSION (:), POINTER :: panels_u
50 TYPE(lrb_type), pointer :: cb_lrb(:,:)
51 TYPE(diag_block_type), DIMENSION (:), POINTER :: diag_blocks
52 INTEGER, DIMENSION(:), POINTER :: begs_blr_static
53 INTEGER, DIMENSION(:), POINTER :: begs_blr_dynamic
54 INTEGER, DIMENSION(:), POINTER :: begs_blr_l
55 INTEGER, DIMENSION(:), POINTER :: begs_blr_col
56 INTEGER :: nb_accesses_init
57 INTEGER :: nb_panels
58 INTEGER :: nfs4father
59 DOUBLE PRECISION, DIMENSION(:), POINTER :: m_array
60 END TYPE blr_struc_t
61 type(blr_struc_t), POINTER, DIMENSION(:), SAVE :: blr_array
62 TYPE blr_array_t
63 type(blr_struc_t), POINTER, DIMENSION(:) :: blr_array
64 END TYPE blr_array_t
67 parameter(blr_array_free=-9999,
68 & panels_notused=-1111, panels_freed=-2222,
69 & nb_panels_notinit=-3333,
70 & nfs4father_notinit=-4444 )
71 CONTAINS
72 SUBROUTINE dmumps_blr_init_module(INITIAL_SIZE, INFO)
73 INTEGER, INTENT(IN) :: initial_size
74 INTEGER, INTENT(INOUT) :: info(2)
75 INTEGER :: i, ierr
76 ALLOCATE(blr_array( initial_size ), stat=ierr)
77 IF (ierr > 0 ) THEN
78 info(1)=-13
79 info(2)=initial_size
80 RETURN
81 ENDIF
82 DO i=1, initial_size
83 NULLIFY(blr_array(i)%PANELS_L)
84 NULLIFY(blr_array(i)%PANELS_U)
85 NULLIFY(blr_array(i)%CB_LRB)
86 NULLIFY(blr_array(i)%DIAG_BLOCKS)
87 NULLIFY(blr_array(i)%BEGS_BLR_STATIC)
88 NULLIFY(blr_array(i)%BEGS_BLR_DYNAMIC)
89 blr_array(i)%NB_ACCESSES_INIT = blr_array_free
90 blr_array(i)%NB_PANELS = nb_panels_notinit
91 NULLIFY(blr_array(i)%BEGS_BLR_L)
92 NULLIFY(blr_array(i)%BEGS_BLR_COL)
93 blr_array(i)%NFS4FATHER = nfs4father_notinit
94 NULLIFY(blr_array(i)%M_ARRAY)
95 ENDDO
96 RETURN
97 END SUBROUTINE dmumps_blr_init_module
98 SUBROUTINE dmumps_blr_end_module(INFO1, KEEP8, K34
99 & , LRSOLVE_ACT_OPT
100 & )
101 INTEGER, INTENT(IN) :: info1, k34
102 LOGICAL, OPTIONAL, INTENT(IN) :: lrsolve_act_opt
103 INTEGER(8) :: keep8(150)
104 INTEGER :: i, iloop
105 LOGICAL :: is_fixme_already_printed
106 is_fixme_already_printed = .false.
107 IF (.NOT. associated(blr_array)) THEN
108 WRITE(*,*) "Internal error 1 in DMUMPS_BLR_END_MODULE"
109 CALL mumps_abort()
110 ENDIF
111 DO i=1, size(blr_array)
112 iloop= i
113 IF (associated(blr_array(i)%PANELS_L).OR.
114 & associated(blr_array(i)%PANELS_U).OR.
115 & associated(blr_array(i)%CB_LRB).OR.
116 & associated(blr_array(i)%DIAG_BLOCKS)
117 & ) THEN
118 IF (present(lrsolve_act_opt)) THEN
119 CALL dmumps_blr_end_front(iloop, info1, keep8, k34
120 & , lrsolve_act_opt
121 & )
122 ELSE
123 CALL dmumps_blr_end_front(iloop, info1, keep8, k34 )
124 ENDIF
125 ENDIF
126 ENDDO
127 DEALLOCATE(blr_array)
128 NULLIFY(blr_array)
129 RETURN
130 END SUBROUTINE dmumps_blr_end_module
131 SUBROUTINE dmumps_blr_mod_to_struc(id_BLRARRAY_ENCODING)
132# if defined(MUMPS_F2003)
133 CHARACTER, DIMENSION(:), POINTER, intent(inout) ::
134 & id_blrarray_encoding
135# else
136 CHARACTER, DIMENSION(:), POINTER :: id_blrarray_encoding
137# endif
138 CHARACTER :: char_array(1)
139 INTEGER :: char_length, ierr
140 TYPE(blr_array_t) :: blr_array_var
141 IF (associated(id_blrarray_encoding)) THEN
142 WRITE(*,*) "Internal error 1 in MUMPS_BLR_MOD_TO_STRUC"
143 CALL mumps_abort()
144 ENDIF
145 blr_array_var%BLR_ARRAY => blr_array
146 char_length=size(transfer(blr_array_var,char_array))
147 ALLOCATE(id_blrarray_encoding(char_length), stat=ierr)
148 IF (ierr > 0 ) THEN
149 WRITE(*,*) "Allocation error in MUMPS_BLR_MOD_TO_STRUC"
150 CALL mumps_abort()
151 ENDIF
152 id_blrarray_encoding=transfer(blr_array_var,char_array)
153 NULLIFY(blr_array)
154 RETURN
155 END SUBROUTINE dmumps_blr_mod_to_struc
156 SUBROUTINE dmumps_blr_struc_to_mod(id_BLRARRAY_ENCODING)
157# if defined(MUMPS_F2003)
158 CHARACTER, DIMENSION(:), POINTER, intent(inout) ::
159 & id_blrarray_encoding
160# else
161 CHARACTER, DIMENSION(:), POINTER :: id_blrarray_encoding
162# endif
163 TYPE (blr_array_t) :: blr_array_var
164 if (.NOT.associated(id_BLRARRAY_ENCODING)) THEN
165 WRITE(*,*) "Internal error 1 in DMUMPS_BLR_STRUC_TO_MOD"
166 ENDIF
167 blr_array_var = transfer(id_blrarray_encoding,blr_array_var)
168 blr_array => blr_array_var%BLR_ARRAY
169 DEALLOCATE(id_blrarray_encoding)
170 NULLIFY(id_blrarray_encoding)
171 RETURN
172 END SUBROUTINE dmumps_blr_struc_to_mod
173 SUBROUTINE dmumps_blr_init_front(IWHANDLER,
174 & INFO, MTK405)
175 USE mumps_front_data_mgt_m, ONLY : mumps_fdm_start_idx
176!$ USE OMP_LIB
177 INTEGER, INTENT(INOUT) :: iwhandler, info(2)
178 INTEGER, INTENT(IN), OPTIONAL :: mtk405
179 TYPE(blr_struc_t), POINTER, DIMENSION(:) :: blr_array_tmp
180 INTEGER :: old_size, new_size
181 INTEGER :: i
182 INTEGER :: ierr
183 LOGICAL :: NEEDS_THREAD_SAFETY
184 needs_thread_safety = .false.
185 IF (present(mtk405)) THEN
186 IF (mtk405 .EQ. 1 ) THEN
187 needs_thread_safety = .true.
188 ENDIF
189 ENDIF
190 IF ( needs_thread_safety ) THEN
191!$OMP CRITICAL(critical_blr_idx)
192 CALL mumps_fdm_start_idx('F', 'INITF', iwhandler, info)
193!$OMP END CRITICAL(critical_blr_idx)
194 ELSE
195 CALL mumps_fdm_start_idx('F', 'INITF', iwhandler, info)
196 ENDIF
197 IF (iwhandler > size(blr_array)) THEN
198 old_size = size(blr_array)
199 new_size = max( (old_size * 3) / 2 + 1, iwhandler)
200 ALLOCATE(blr_array_tmp(new_size),stat=ierr)
201 IF (ierr.GT.0) THEN
202 info(1)=-13
203 info(2)=new_size
204 GOTO 500
205 ENDIF
206 DO i=1, old_size
207 blr_array_tmp(i)=blr_array(i)
208 ENDDO
209 DO i=old_size+1, new_size
210 NULLIFY(blr_array_tmp(i)%PANELS_L)
211 NULLIFY(blr_array_tmp(i)%PANELS_U)
212 NULLIFY(blr_array_tmp(i)%CB_LRB)
213 NULLIFY(blr_array_tmp(i)%DIAG_BLOCKS)
214 NULLIFY(blr_array_tmp(i)%BEGS_BLR_STATIC)
215 NULLIFY(blr_array_tmp(i)%BEGS_BLR_DYNAMIC)
216 blr_array_tmp(i)%NB_ACCESSES_INIT = blr_array_free
217 blr_array_tmp(i)%NB_PANELS = nb_panels_notinit
218 NULLIFY(blr_array_tmp(i)%BEGS_BLR_L)
219 NULLIFY(blr_array_tmp(i)%BEGS_BLR_COL)
220 blr_array_tmp(i)%NFS4FATHER = nfs4father_notinit
221 NULLIFY(blr_array_tmp(i)%M_ARRAY)
222 ENDDO
223 DEALLOCATE(blr_array)
224 blr_array => blr_array_tmp
225 NULLIFY(blr_array_tmp)
226 500 CONTINUE
227 ENDIF
228 RETURN
229 END SUBROUTINE dmumps_blr_init_front
230 SUBROUTINE dmumps_blr_save_init(IWHANDLER,
231 & IsSYM, IsT2, IsSLAVE,
232 & NB_PANELS,
233 & BEGS_BLR_L, BEGS_BLR_COL,
234 & NB_ACCESSES_INIT, INFO)
235 LOGICAL, INTENT(IN) :: issym, ist2, isslave
236 INTEGER, INTENT(IN) :: nb_panels, iwhandler
237 INTEGER, INTENT(INOUT) :: info(2)
238 INTEGER, INTENT(IN) :: NB_ACCESSES_INIT
239 INTEGER, INTENT(IN), DIMENSION(:) :: begs_blr_l
240 INTEGER, DIMENSION(:), POINTER :: begs_blr_col
241 INTEGER :: i
242 INTEGER :: ierr
243 IF (nb_panels.EQ.0) THEN
244 WRITE(6,*) " Internal error 1 in DMUMPS_BLR_SAVE_INIT ",
245 & nb_panels
246 ENDIF
247 IF (iwhandler .LE.0 ) THEN
248 WRITE(6,*) " Internal error 2 in DMUMPS_BLR_SAVE_INIT ",
249 & iwhandler
250 ENDIF
251 IF (associated(begs_blr_col)) THEN
252 ALLOCATE(
253 & blr_array(iwhandler)%BEGS_BLR_COL(size(begs_blr_col)),
254 & stat=ierr)
255 IF (ierr .GT. 0) THEN
256 info(1)=-13
257 info(2)=size(begs_blr_col)
258 RETURN
259 ENDIF
260 ENDIF
261 IF (nb_accesses_init.EQ.0) THEN
262 NULLIFY(blr_array(iwhandler)%PANELS_L)
263 NULLIFY(blr_array(iwhandler)%PANELS_U)
264 NULLIFY(blr_array(iwhandler)%CB_LRB)
265 NULLIFY(blr_array(iwhandler)%DIAG_BLOCKS)
266 ALLOCATE(
267 & blr_array(iwhandler)%BEGS_BLR_L(size(begs_blr_l)),
268 & blr_array(iwhandler)%BEGS_BLR_STATIC(size(begs_blr_l)),
269 & blr_array(iwhandler)%BEGS_BLR_DYNAMIC(size(begs_blr_l)),
270 & stat=ierr)
271 IF (ierr .GT. 0) THEN
272 info(1)=-13
273 info(2)=3*size(begs_blr_l)
274 RETURN
275 ENDIF
276 ELSE
277 IF (issym) THEN
278 ALLOCATE(blr_array(iwhandler)%PANELS_L(nb_panels),
279 & blr_array(iwhandler)%BEGS_BLR_L(size(begs_blr_l)),
280 & blr_array(iwhandler)%BEGS_BLR_STATIC(size(begs_blr_l)),
281 & blr_array(iwhandler)%BEGS_BLR_DYNAMIC(size(begs_blr_l)),
282 & stat=ierr)
283 ELSE
284 ALLOCATE(blr_array(iwhandler)%PANELS_L(nb_panels),
285 & blr_array(iwhandler)%PANELS_U(nb_panels),
286 & blr_array(iwhandler)%BEGS_BLR_STATIC(size(begs_blr_l)),
287 & blr_array(iwhandler)%BEGS_BLR_DYNAMIC(size(begs_blr_l)),
288 & blr_array(iwhandler)%BEGS_BLR_L(size(begs_blr_l)),
289 & stat=ierr)
290 ENDIF
291 IF (ierr .GT. 0) THEN
292 info(1)=-13
293 IF (issym) THEN
294 info(2)=nb_panels+3*size(begs_blr_l)
295 ELSE
296 info(2)=nb_panels+nb_panels+3*size(begs_blr_l)
297 ENDIF
298 RETURN
299 ENDIF
300 IF (.NOT.isslave) THEN
301 ALLOCATE(blr_array(iwhandler)%DIAG_BLOCKS(nb_panels),
302 & stat=ierr)
303 IF (ierr .GT. 0) THEN
304 info(1)=-13
305 info(2)=nb_panels
306 RETURN
307 ENDIF
308 ENDIF
309 DO i=1,nb_panels
310 NULLIFY(blr_array(iwhandler)%PANELS_L(i)%LRB_PANEL)
311 IF (.NOT.issym) THEN
312 NULLIFY(blr_array(iwhandler)%PANELS_U(i)%LRB_PANEL)
313 ENDIF
314 IF (.NOT.isslave) THEN
315 NULLIFY(blr_array(iwhandler)%DIAG_BLOCKS(i)%DIAG_BLOCK)
316 ENDIF
317 ENDDO
318 ENDIF
319 blr_array(iwhandler)%IsSYM = issym
320 blr_array(iwhandler)%IsT2 = ist2
321 blr_array(iwhandler)%IsSLAVE = isslave
322 blr_array(iwhandler)%NB_PANELS = nb_panels
323 blr_array(iwhandler)%BEGS_BLR_L = begs_blr_l
324 blr_array(iwhandler)%BEGS_BLR_STATIC = begs_blr_l
325 blr_array(iwhandler)%BEGS_BLR_DYNAMIC = -999991
326 IF (nb_accesses_init.EQ.0) THEN
327 blr_array(iwhandler)%NB_ACCESSES_INIT = panels_notused
328 ELSE
329 blr_array(iwhandler)%NB_ACCESSES_INIT = nb_accesses_init
330 ENDIF
331 IF (associated(begs_blr_col)) THEN
332 DO i=1,size(begs_blr_col)
333 blr_array(iwhandler)%BEGS_BLR_COL(i) = begs_blr_col(i)
334 ENDDO
335 ELSE
336 NULLIFY( blr_array(iwhandler)%BEGS_BLR_COL )
337 ENDIF
338 RETURN
339 END SUBROUTINE dmumps_blr_save_init
340 SUBROUTINE dmumps_blr_end_front(IWHANDLER, INFO1, KEEP8, K34
341 & , LRSOLVE_ACT_OPT, MTK405 )
342 USE mumps_front_data_mgt_m, ONLY : mumps_fdm_end_idx
343 INTEGER, INTENT(INOUT) :: iwhandler
344 INTEGER, INTENT(IN) :: info1
345 INTEGER(8) :: keep8(150)
346 INTEGER, INTENT(IN) :: k34
347 LOGICAL, OPTIONAL, INTENT(IN) :: lrsolve_act_opt
348 INTEGER, OPTIONAL, INTENT(IN) :: mtk405
349 INTEGER :: ipanel, jpanel
350 INTEGER(8) :: mem_freed
351 INTEGER :: idummy, jdummy
352 TYPE(blr_panel_type), POINTER :: thepanel
353 LOGICAL :: lrsolve_act, needs_thread_safety
354 TYPE(diag_block_type), POINTER :: theblock
355 lrsolve_act = .false.
356 IF (present(lrsolve_act_opt)) lrsolve_act = lrsolve_act_opt
357 IF (iwhandler.LE.0) THEN
358 RETURN
359 ENDIF
360 needs_thread_safety = .false.
361 IF (present(mtk405)) THEN
362 IF (mtk405 .EQ. 1 ) THEN
363 needs_thread_safety = .true.
364 ENDIF
365 ENDIF
366 IF (iwhandler .GT. size(blr_array)) THEN
367 RETURN
368 END IF
369 IF (blr_array(iwhandler)%NB_ACCESSES_INIT.EQ.blr_array_free)
370 & RETURN
371 IF (blr_array(iwhandler)%NB_ACCESSES_INIT.NE.
372 & panels_notused) THEN
373 DO ipanel = 1, size(blr_array(iwhandler)%PANELS_L)
374 thepanel => blr_array(iwhandler)%PANELS_L(ipanel)
375 IF (associated(thepanel%LRB_PANEL)) THEN
376 IF (info1 .GE. 0
377 & .AND..NOT.lrsolve_act
378 & ) THEN
379 WRITE(*,*) " Internal Error 2a in MUMPS_BLR_END_FRONT ",
380 & iwhandler, "NB_ACCESSES_INIT=",
381 & blr_array(iwhandler)%NB_ACCESSES_INIT,
382 & "Pointer to panel number ",ipanel," still associated",
383 & "NB_ACCESSES_LEFT= ",thepanel%NB_ACCESSES_LEFT
384 CALL mumps_abort()
385 ELSE
386 CALL dealloc_blr_panel(thepanel%LRB_PANEL,
387 & size(thepanel%LRB_PANEL), keep8, k34)
388 thepanel%NB_ACCESSES_LEFT = panels_freed
389 ENDIF
390 DEALLOCATE(thepanel%LRB_PANEL)
391 NULLIFY(thepanel%LRB_PANEL)
392 ENDIF
393 ENDDO
394 IF (associated(blr_array(iwhandler)%PANELS_L)) THEN
395 DEALLOCATE(blr_array(iwhandler)%PANELS_L)
396 NULLIFY(blr_array(iwhandler)%PANELS_L)
397 ENDIF
398 IF (.NOT.blr_array(iwhandler)%IsSYM) THEN
399 DO ipanel = 1, size(blr_array(iwhandler)%PANELS_U)
400 thepanel => blr_array(iwhandler)%PANELS_U(ipanel)
401 IF (associated(thepanel%LRB_PANEL)) THEN
402 IF (info1 .GE. 0
403 & .AND..NOT.lrsolve_act
404 & ) THEN
405 WRITE(*,*) " Internal Error 2b in MUMPS_BLR_END_FRONT ",
406 & iwhandler, "NB_ACCESSES_INIT=",
407 & blr_array(iwhandler)%NB_ACCESSES_INIT,
408 & "Pointer to panel number ",ipanel," still associated"
409 CALL mumps_abort()
410 ELSE
411 CALL dealloc_blr_panel(thepanel%LRB_PANEL,
412 & size(thepanel%LRB_PANEL), keep8, k34)
413 thepanel%NB_ACCESSES_LEFT = panels_freed
414 ENDIF
415 DEALLOCATE(thepanel%LRB_PANEL)
416 NULLIFY(thepanel%LRB_PANEL)
417 ENDIF
418 ENDDO
419 IF (associated(blr_array(iwhandler)%PANELS_U)) THEN
420 DEALLOCATE(blr_array(iwhandler)%PANELS_U)
421 NULLIFY(blr_array(iwhandler)%PANELS_U)
422 ENDIF
423 ENDIF
424 IF (.NOT.blr_array(iwhandler)%IsSLAVE) THEN
425 mem_freed = 0_8
426 DO ipanel = 1, size(blr_array(iwhandler)%DIAG_BLOCKS)
427 theblock => blr_array(iwhandler)%DIAG_BLOCKS(ipanel)
428 IF (associated(theblock%DIAG_BLOCK)) THEN
429 IF (info1 .GE. 0
430 & .AND..NOT.lrsolve_act
431 & ) THEN
432 WRITE(*,*) " Internal Error 3 in MUMPS_BLR_END_FRONT ",
433 & iwhandler, "NB_ACCESSES_INIT=",
434 & blr_array(iwhandler)%NB_ACCESSES_INIT,
435 & "Pointer to panel number ",ipanel," still associated"
436 CALL mumps_abort()
437 ELSE
438 DEALLOCATE (theblock%DIAG_BLOCK)
439 NULLIFY (theblock%DIAG_BLOCK)
440 mem_freed = mem_freed + int(size(theblock%DIAG_BLOCK),8)
441 ENDIF
442 ENDIF
443 ENDDO
444 IF ( mem_freed .GT. 0_8 ) THEN
445 CALL mumps_dm_fac_upd_dyn_memcnts(-mem_freed,
446 & needs_thread_safety, keep8,
447 & idummy, jdummy,
448 & .true., .true.)
449 ENDIF
450 IF (associated(blr_array(iwhandler)%DIAG_BLOCKS)) THEN
451 DEALLOCATE(blr_array(iwhandler)%DIAG_BLOCKS)
452 NULLIFY(blr_array(iwhandler)%DIAG_BLOCKS)
453 ENDIF
454 ENDIF
455 IF (.NOT.blr_array(iwhandler)%IsT2.OR.
456 & blr_array(iwhandler)%IsSLAVE) THEN
457 IF (associated(blr_array(iwhandler)%CB_LRB)) THEN
458 IF (info1 .GE. 0) THEN
459 WRITE(*,*) " Internal Error 4 in MUMPS_BLR_END_FRONT ",
460 & iwhandler, "CB block still associated",
461 & blr_array(iwhandler)%IsT2,
462 & blr_array(iwhandler)%IsSLAVE
463 CALL mumps_abort()
464 ELSE
465 DO ipanel = 1, size(blr_array(iwhandler)%CB_LRB,1)
466 DO jpanel = 1, size(blr_array(iwhandler)%CB_LRB,2)
467 CALL dealloc_lrb(
468 & blr_array(iwhandler)%CB_LRB(ipanel,jpanel),
469 & keep8, k34)
470 ENDDO
471 ENDDO
472 DEALLOCATE(blr_array(iwhandler)%CB_LRB)
473 NULLIFY(blr_array(iwhandler)%CB_LRB)
474 ENDIF
475 ENDIF
476 ENDIF
477 ENDIF
478 IF (associated(blr_array(iwhandler)%BEGS_BLR_STATIC)) THEN
479 DEALLOCATE(blr_array(iwhandler)%BEGS_BLR_STATIC)
480 NULLIFY(blr_array(iwhandler)%BEGS_BLR_STATIC)
481 ENDIF
482 IF (associated(blr_array(iwhandler)%BEGS_BLR_DYNAMIC)) THEN
483 DEALLOCATE(blr_array(iwhandler)%BEGS_BLR_DYNAMIC)
484 NULLIFY(blr_array(iwhandler)%BEGS_BLR_DYNAMIC)
485 ENDIF
486 IF (associated(blr_array(iwhandler)%BEGS_BLR_L)) THEN
487 DEALLOCATE(blr_array(iwhandler)%BEGS_BLR_L)
488 NULLIFY(blr_array(iwhandler)%BEGS_BLR_L)
489 ENDIF
490 IF (associated(blr_array(iwhandler)%BEGS_BLR_COL)) THEN
491 DEALLOCATE(blr_array(iwhandler)%BEGS_BLR_COL)
492 NULLIFY(blr_array(iwhandler)%BEGS_BLR_COL)
493 ENDIF
494 blr_array(iwhandler)%NB_ACCESSES_INIT = blr_array_free
495 blr_array(iwhandler)%NB_PANELS = nb_panels_notinit
496 blr_array(iwhandler)%NFS4FATHER = nfs4father_notinit
497 IF (associated(blr_array(iwhandler)%M_ARRAY)) THEN
498 DEALLOCATE(blr_array(iwhandler)%M_ARRAY)
499 NULLIFY(blr_array(iwhandler)%M_ARRAY)
500 ENDIF
501 IF (needs_thread_safety) THEN
502!$OMP CRITICAL(critical_blr_idx)
503 CALL mumps_fdm_end_idx('F', 'ENDF', iwhandler)
504!$OMP END CRITICAL(critical_blr_idx)
505 ELSE
506 CALL mumps_fdm_end_idx('F', 'ENDF', iwhandler)
507 ENDIF
508 RETURN
509 END SUBROUTINE dmumps_blr_end_front
510 SUBROUTINE dmumps_blr_save_panel_loru (
511 & IWHANDLER, LORU, IPANEL, LRB_PANEL )
512 type(lrb_type), DIMENSION(:), pointer :: lrb_panel
513 INTEGER, INTENT(IN) :: iwhandler, ipanel
514 INTEGER, INTENT(IN) :: loru
515 TYPE(blr_panel_type), POINTER :: thepanel
516 IF ( iwhandler .GT. size(blr_array) .OR. iwhandler .LE. 0 ) THEN
517 WRITE(*,*) "Internal error 1 in DMUMPS_BLR_SAVE_PANEL_LORU"
518 CALL mumps_abort()
519 ENDIF
520 IF (loru.EQ.0) THEN
521 thepanel => blr_array(iwhandler)%PANELS_L(ipanel)
522 ELSE
523 thepanel => blr_array(iwhandler)%PANELS_U(ipanel)
524 ENDIF
525 thepanel%NB_ACCESSES_LEFT =
526 & blr_array(iwhandler)%NB_ACCESSES_INIT
527 thepanel%LRB_PANEL => lrb_panel
528 RETURN
529 END SUBROUTINE dmumps_blr_save_panel_loru
530 SUBROUTINE dmumps_blr_save_cb_lrb (
531 & IWHANDLER, CB_LRB )
532#if defined(MUMPS_F2003)
533 TYPE(lrb_type), POINTER, INTENT(IN) :: cb_lrb(:,:)
534#else
535 TYPE(lrb_type), POINTER :: cb_lrb(:,:)
536#endif
537 INTEGER, INTENT(IN) :: iwhandler
538 IF ( iwhandler .GT. size(blr_array) .OR. iwhandler .LE. 0 ) THEN
539 WRITE(*,*) "Internal error 1 in DMUMPS_BLR_SAVE_CB_LRB"
540 CALL mumps_abort()
541 ENDIF
542 blr_array(iwhandler)%CB_LRB => cb_lrb
543 RETURN
544 END SUBROUTINE dmumps_blr_save_cb_lrb
545 SUBROUTINE dmumps_blr_save_diag_block (
546 & IWHANDLER, IPANEL, D )
547 DOUBLE PRECISION,POINTER :: d(:)
548 INTEGER, INTENT(IN) :: iwhandler, ipanel
549 IF ( iwhandler .GT. size(blr_array) .OR. iwhandler .LE. 0 ) THEN
550 WRITE(*,*) "Internal error 1 in DMUMPS_BLR_SAVE_DIAG_BLOCK"
551 CALL mumps_abort()
552 ENDIF
553 IF ( blr_array(iwhandler)%NB_ACCESSES_INIT.LT.0) THEN
554 WRITE(*,*) "Internal error 2 in DMUMPS_BLR_SAVE_DIAG_BLOCK"
555 CALL mumps_abort()
556 ENDIF
557 blr_array(iwhandler)%DIAG_BLOCKS(ipanel)%DIAG_BLOCK => d
558 RETURN
559 END SUBROUTINE dmumps_blr_save_diag_block
560 SUBROUTINE dmumps_blr_save_begs_blr_c (
561 & IWHANDLER, BEGS_BLR_COL, INFO)
562 INTEGER, DIMENSION(:), POINTER :: begs_blr_col
563 INTEGER, INTENT(IN) :: iwhandler
564 INTEGER, INTENT(INOUT) :: info(2)
565 INTEGER :: i, ierr
566 IF ( iwhandler .GT. size(blr_array) .OR. iwhandler .LE. 0 ) THEN
567 WRITE(*,*) "Internal error 1 in DMUMPS_BLR_SAVE_BEGS_BLR_C"
568 CALL mumps_abort()
569 ENDIF
570 IF ( blr_array(iwhandler)%NB_ACCESSES_INIT.LT.0) THEN
571 WRITE(*,*) "Internal error 2 in DMUMPS_BLR_SAVE_BEGS_BLR_C"
572 CALL mumps_abort()
573 ENDIF
574 ALLOCATE(blr_array(iwhandler)%BEGS_BLR_COL(size(begs_blr_col)),
575 & stat=ierr)
576 IF (ierr > 0 ) THEN
577 info(1)=-13
578 info(2)=size(begs_blr_col)
579 RETURN
580 ENDIF
581 DO i=1,size(begs_blr_col)
582 blr_array(iwhandler)%BEGS_BLR_COL(i) = begs_blr_col(i)
583 ENDDO
584 RETURN
585 END SUBROUTINE dmumps_blr_save_begs_blr_c
586 SUBROUTINE dmumps_blr_save_begs_blr_dyn (
587 & IWHANDLER, BEGS_BLR_DYNAMIC )
588 INTEGER, DIMENSION(:), POINTER :: begs_blr_dynamic
589 INTEGER, INTENT(IN) :: iwhandler
590 INTEGER :: i
591 IF ( iwhandler .GT. size(blr_array) .OR. iwhandler .LE. 0 ) THEN
592 WRITE(*,*) "Internal error 1 in DMUMPS_BLR_SAVE_BEGS_BLR_DYN"
593 CALL mumps_abort()
594 ENDIF
595 IF ( blr_array(iwhandler)%NB_ACCESSES_INIT.LT.0) THEN
596 WRITE(*,*) "Internal error 2 in DMUMPS_BLR_SAVE_BEGS_BLR_DYN"
597 CALL mumps_abort()
598 ENDIF
599 DO i=1,size(begs_blr_dynamic)
600 blr_array(iwhandler)%BEGS_BLR_DYNAMIC(i) = begs_blr_dynamic(i)
601 ENDDO
602 RETURN
603 END SUBROUTINE dmumps_blr_save_begs_blr_dyn
604 SUBROUTINE dmumps_blr_retrieve_begs_blr_l
605 & ( iwhandler, begs_blr_l )
606 INTEGER, INTENT(IN) :: iwhandler
607#if defined(MUMPS_F2003)
608 INTEGER, POINTER, DIMENSION(:), INTENT(OUT) :: begs_blr_l
609#else
610 INTEGER, POINTER, DIMENSION(:) :: begs_blr_l
611#endif
612 IF ( iwhandler .GT. size(blr_array) .OR. iwhandler .LE. 0 ) THEN
613 WRITE(*,*)
614 & "Internal error 1 in DMUMPS_BLR_RETRIEVE_BEGS_BLR_L"
615 CALL mumps_abort()
616 ENDIF
617 begs_blr_l => blr_array(iwhandler)%BEGS_BLR_L
618 RETURN
619 END SUBROUTINE dmumps_blr_retrieve_begs_blr_l
620 SUBROUTINE dmumps_blr_retrieve_begsblr_sta
621 & ( iwhandler, begs_blr_static )
622 INTEGER, INTENT(IN) :: iwhandler
623#if defined(MUMPS_F2003)
624 INTEGER, POINTER, DIMENSION(:), INTENT(OUT) :: begs_blr_static
625#else
626 INTEGER, POINTER, DIMENSION(:) :: begs_blr_static
627#endif
628 IF ( iwhandler .GT. size(blr_array) .OR. iwhandler .LE. 0 ) THEN
629 WRITE(*,*)
630 & "Internal error 1 in DMUMPS_BLR_RETRIEVE_BEGSBLR_STA"
631 CALL mumps_abort()
632 ENDIF
633 begs_blr_static => blr_array(iwhandler)%BEGS_BLR_STATIC
634 RETURN
635 END SUBROUTINE dmumps_blr_retrieve_begsblr_sta
636 SUBROUTINE dmumps_blr_retrieve_begsblr_dyn
637 & ( iwhandler, begs_blr_dynamic )
638 INTEGER, INTENT(IN) :: iwhandler
639#if defined(MUMPS_F2003)
640 INTEGER, POINTER, DIMENSION(:), INTENT(OUT) :: begs_blr_dynamic
641#else
642 INTEGER, POINTER, DIMENSION(:) :: begs_blr_dynamic
643#endif
644 IF ( iwhandler .GT. size(blr_array) .OR. iwhandler .LE. 0 ) THEN
645 WRITE(*,*)
646 & "Internal error 1 in DMUMPS_BLR_RETRIEVE_BEGSBLR_DYN"
647 CALL mumps_abort()
648 ENDIF
649 begs_blr_dynamic => blr_array(iwhandler)%BEGS_BLR_DYNAMIC
650 RETURN
651 END SUBROUTINE dmumps_blr_retrieve_begsblr_dyn
652 SUBROUTINE dmumps_blr_retrieve_begs_blr_c
653 & ( iwhandler, begs_blr_col, nb_panels )
654 INTEGER, INTENT(IN) :: iwhandler
655 INTEGER, INTENT(OUT) :: nb_panels
656#if defined(mumps_f2003)
657 INTEGER, POINTER, DIMENSION(:), INTENT(OUT) :: begs_blr_col
658#else
659 INTEGER, POINTER, DIMENSION(:) :: begs_blr_col
660#endif
661 IF ( iwhandler .GT. size(blr_array) .OR. iwhandler .LE. 0 ) THEN
662 WRITE(*,*)
663 & "Internal error 1 in DMUMPS_BLR_RETRIEVE_BEGS_BLR_C"
664 CALL mumps_abort()
665 ENDIF
666 begs_blr_col => blr_array(iwhandler)%BEGS_BLR_COL
667 nb_panels = blr_array(iwhandler)%NB_PANELS
668 RETURN
669 END SUBROUTINE dmumps_blr_retrieve_begs_blr_c
670 SUBROUTINE dmumps_blr_retrieve_nb_panels
671 & ( iwhandler, nb_panels )
672 INTEGER, INTENT(IN) :: iwhandler
673 INTEGER, INTENT(OUT) :: nb_panels
674 IF ( iwhandler .GT. size(blr_array) .OR. iwhandler .LE. 0 ) THEN
675 WRITE(*,*)
676 & "Internal error 1 in DMUMPS_BLR_RETRIEVE_NB_PANELS"
677 CALL mumps_abort()
678 ENDIF
679 nb_panels = blr_array(iwhandler)%NB_PANELS
680 RETURN
681 END SUBROUTINE dmumps_blr_retrieve_nb_panels
682 SUBROUTINE dmumps_blr_dec_and_retrieve_l(IWHANDLER, IPANEL,
683 & BEGS_BLR_L, THELRBPANEL)
684 INTEGER, INTENT(IN) :: iwhandler
685 INTEGER, INTENT(IN) :: ipanel
686#if defined(MUMPS_F2003)
687 INTEGER, POINTER, DIMENSION(:), INTENT(OUT) :: begs_blr_l
688 TYPE(lrb_type), INTENT(OUT), DIMENSION(:), POINTER :: THELRBPANEL
689#else
690 INTEGER, POINTER, DIMENSION(:) :: begs_blr_l
691 TYPE(lrb_type), POINTER, DIMENSION(:) :: thelrbpanel
692#endif
693 IF ( iwhandler .GT. size(blr_array) .OR. iwhandler .LE. 0 ) THEN
694 WRITE(*,*) "Internal error 1 in DMUMPS_BLR_DEC_AND_RETRIEVE_L",
695 & "IPANEL=", ipanel
696 CALL mumps_abort()
697 ENDIF
698 IF ( .NOT. associated(blr_array(iwhandler)%PANELS_L)) THEN
699 WRITE(*,*) "Internal error 2 in DMUMPS_BLR_DEC_AND_RETRIEVE_L",
700 & "IPANEL=", ipanel
701 CALL mumps_abort()
702 ENDIF
703 IF ( .NOT.
704 & associated(blr_array(iwhandler)%PANELS_L(ipanel)%LRB_PANEL) )
705 & THEN
706 WRITE(*,*) "Internal error 3 in DMUMPS_BLR_DEC_AND_RETRIEVE_L",
707 & "IPANEL=", ipanel
708 CALL mumps_abort()
709 ENDIF
710 CALL dmumps_blr_retrieve_begs_blr_l( iwhandler, begs_blr_l )
711 thelrbpanel =>
712 & blr_array(iwhandler)%PANELS_L(ipanel)%LRB_PANEL
713 blr_array(iwhandler)%PANELS_L(ipanel)%NB_ACCESSES_LEFT =
714 & blr_array(iwhandler)%PANELS_L(ipanel)%NB_ACCESSES_LEFT - 1
715 RETURN
716 END SUBROUTINE dmumps_blr_dec_and_retrieve_l
717 LOGICAL FUNCTION dmumps_blr_empty_panel_loru
718 & (iwhandler, loru, ipanel)
719 INTEGER, INTENT(IN) :: loru, ipanel, iwhandler
720 IF ( iwhandler .GT. size(blr_array) .OR. iwhandler .LE. 0 ) THEN
721 WRITE(*,*)
722 & "Internal error 1 in DMUMPS_BLR_EMPTY_PANEL_LORU, ",
723 & "IWHANDLER=", iwhandler
724 CALL mumps_abort()
725 ENDIF
726 IF (loru.EQ.0) THEN
727 IF ( .NOT. associated(blr_array(iwhandler)%PANELS_L)) THEN
728 WRITE(*,*)
729 & "Internal error 2 in DMUMPS_BLR_EMPTY_PANEL_LORU, ",
730 & "IWHANDLER=", iwhandler
731 CALL mumps_abort()
732 ENDIF
733 dmumps_blr_empty_panel_loru = .NOT.
734 & associated(blr_array(iwhandler)%PANELS_L(ipanel)%LRB_PANEL)
735 ELSE
736 IF ( .NOT. associated(blr_array(iwhandler)%PANELS_U)) THEN
737 WRITE(*,*)
738 & "Internal error 3 in DMUMPS_BLR_EMPTY_PANEL_LORU, ",
739 & "IWHANDLER=", iwhandler
740 CALL mumps_abort()
741 ENDIF
742 dmumps_blr_empty_panel_loru = .NOT.
743 & associated(blr_array(iwhandler)%PANELS_U(ipanel)%LRB_PANEL)
744 ENDIF
745 RETURN
746 END FUNCTION dmumps_blr_empty_panel_loru
747 SUBROUTINE dmumps_blr_retrieve_panel_loru
748 & (iwhandler, loru, ipanel,
749 & thelrbpanel)
750 INTEGER, INTENT(IN) :: iwhandler
751 INTEGER, INTENT(IN) :: loru
752 INTEGER, INTENT(IN) :: ipanel
753#if defined(mumps_f2003)
754 TYPE(lrb_type), INTENT(OUT), DIMENSION(:), POINTER :: thelrbpanel
755#else
756 TYPE(lrb_type), POINTER, DIMENSION(:) :: thelrbpanel
757#endif
758 IF ( iwhandler .GT. size(blr_array) .OR. iwhandler .LE. 0 ) THEN
759 WRITE(*,*)
760 & "Internal error 1 in DMUMPS_BLR_RETRIEVE_PANEL_LORU",
761 & "IWHANDLER=", iwhandler
762 CALL mumps_abort()
763 ENDIF
764 IF (loru.EQ.0) THEN
765 IF ( .NOT. associated(blr_array(iwhandler)%PANELS_L)) THEN
766 WRITE(*,*)
767 & "Internal error 2 in DMUMPS_BLR_RETRIEVE_PANEL_LORU",
768 & " IWHANDLER=", iwhandler
769 CALL mumps_abort()
770 ENDIF
771 IF ( .NOT.
772 & associated(blr_array(iwhandler)%PANELS_L(ipanel)%LRB_PANEL) )
773 & THEN
774 WRITE(*,*)
775 & "Internal error 3 in DMUMPS_BLR_RETRIEVE_PANEL_LORU",
776 & " IPANEL=", ipanel
777 CALL mumps_abort()
778 ENDIF
779 thelrbpanel =>
780 & blr_array(iwhandler)%PANELS_L(ipanel)%LRB_PANEL
781 ELSE
782 IF ( .NOT. associated(blr_array(iwhandler)%PANELS_U)) THEN
783 WRITE(*,*)
784 & "Internal error 4 in DMUMPS_BLR_RETRIEVE_PANEL_LORU",
785 & " IWHANDLER=", iwhandler
786 CALL mumps_abort()
787 ENDIF
788 IF ( .NOT.
789 & associated(blr_array(iwhandler)%PANELS_U(ipanel)%LRB_PANEL) )
790 & THEN
791 WRITE(*,*)
792 & "Internal error 5 in DMUMPS_BLR_RETRIEVE_PANEL_LORU",
793 & " IPANEL=", ipanel
794 CALL mumps_abort()
795 ENDIF
796 thelrbpanel =>
797 & blr_array(iwhandler)%PANELS_U(ipanel)%LRB_PANEL
798 ENDIF
799 RETURN
800 END SUBROUTINE dmumps_blr_retrieve_panel_loru
801 SUBROUTINE dmumps_blr_retrieve_diag_block
802 & (iwhandler, ipanel,
803 & theblock)
804 INTEGER, INTENT(IN) :: iwhandler
805 INTEGER, INTENT(IN) :: ipanel
806#if defined(mumps_f2003)
807 DOUBLE PRECISION, POINTER, INTENT(OUT) :: theblock(:)
808#else
809 DOUBLE PRECISION, POINTER :: theblock(:)
810#endif
811 IF ( iwhandler .GT. size(blr_array) .OR. iwhandler .LE. 0 ) THEN
812 WRITE(*,*)
813 & "Internal error 1 in DMUMPS_BLR_RETRIEVE_DIAG_BLOCK",
814 & "IPANEL=", ipanel
815 CALL mumps_abort()
816 ENDIF
817 IF ( .NOT. associated(blr_array(iwhandler)%DIAG_BLOCKS)) THEN
818 WRITE(*,*)
819 & "Internal error 2 in DMUMPS_BLR_RETRIEVE_DIAG_BLOCK",
820 & "IPANEL=", ipanel
821 CALL mumps_abort()
822 ENDIF
823 IF ( .NOT.
824 & associated(blr_array(iwhandler)%DIAG_BLOCKS(ipanel)%DIAG_BLOCK))
825 & THEN
826 WRITE(*,*)
827 & "Internal error 3 in DMUMPS_BLR_RETRIEVE_DIAG_BLOCK",
828 & "IPANEL=", ipanel
829 CALL mumps_abort()
830 ENDIF
831 theblock =>
832 & blr_array(iwhandler)%DIAG_BLOCKS(ipanel)%DIAG_BLOCK
833 RETURN
834 END SUBROUTINE dmumps_blr_retrieve_diag_block
835 SUBROUTINE dmumps_blr_retrieve_cb_lrb
836 & (iwhandler, thecb)
837 INTEGER, INTENT(IN) :: iwhandler
838#if defined(mumps_f2003)
839 TYPE(lrb_type), POINTER, INTENT(OUT) :: thecb(:,:)
840#else
841 TYPE(lrb_type), POINTER :: thecb(:,:)
842#endif
843 IF ( iwhandler .GT. size(blr_array) .OR. iwhandler .LE. 0 ) THEN
844 WRITE(*,*) "Internal error 1 in DMUMPS_BLR_RETRIEVE_CB_LRB"
845 CALL mumps_abort()
846 ENDIF
847 IF ( .NOT. associated(blr_array(iwhandler)%CB_LRB)) THEN
848 WRITE(*,*) "Internal error 2 in DMUMPS_BLR_RETRIEVE_CB_LRB"
849 CALL mumps_abort()
850 ENDIF
851 thecb => blr_array(iwhandler)%CB_LRB
852 RETURN
853 END SUBROUTINE dmumps_blr_retrieve_cb_lrb
854 SUBROUTINE dmumps_blr_save_nfs4father
855 & ( iwhandler, nfs4father )
856 INTEGER, INTENT(IN) :: iwhandler
857 INTEGER, INTENT(IN) :: nfs4father
858 IF ( iwhandler .GT. size(blr_array) .OR. iwhandler .LE. 0 ) THEN
859 WRITE(*,*)
860 & "Internal error 1 in DMUMPS_BLR_RETRIEVE_NFS4FATHER"
861 CALL mumps_abort()
862 ENDIF
863 blr_array(iwhandler)%NFS4FATHER = nfs4father
864 RETURN
865 END SUBROUTINE dmumps_blr_save_nfs4father
866 SUBROUTINE dmumps_blr_retrieve_nfs4father
867 & ( iwhandler, nfs4father )
868 INTEGER, INTENT(IN) :: iwhandler
869 INTEGER, INTENT(OUT) :: nfs4father
870 IF ( iwhandler .GT. size(blr_array) .OR. iwhandler .LE. 0 ) THEN
871 WRITE(*,*)
872 & "Internal error 1 in DMUMPS_BLR_RETRIEVE_NFS4FATHER"
873 CALL mumps_abort()
874 ENDIF
875 nfs4father = blr_array(iwhandler)%NFS4FATHER
876 RETURN
877 END SUBROUTINE dmumps_blr_retrieve_nfs4father
878 SUBROUTINE dmumps_blr_save_m_array (
879 & IWHANDLER, M_ARRAY, INFO)
880 DOUBLE PRECISION, DIMENSION(:), INTENT(IN) :: m_array
881 INTEGER, INTENT(IN) :: iwhandler
882 INTEGER, INTENT(INOUT) :: info(2)
883 INTEGER :: i, ierr
884 IF ( iwhandler .GT. size(blr_array) .OR. iwhandler .LE. 0 ) THEN
885 WRITE(*,*) "internal error 1 in dmumps_blr_save_m_array"
886 CALL MUMPS_ABORT()
887 ENDIF
888 ALLOCATE(BLR_ARRAY(IWHANDLER)%M_ARRAY(size(M_ARRAY)),
889 & stat=IERR)
890 IF (IERR > 0 ) THEN
891 INFO(1)=-13
892 INFO(2)=size(M_ARRAY)
893 RETURN
894 ENDIF
895 DO I=1,size(M_ARRAY)
896 BLR_ARRAY(IWHANDLER)%M_ARRAY(I) = M_ARRAY(I)
897 ENDDO
898 BLR_ARRAY(IWHANDLER)%NFS4FATHER = size(M_ARRAY)
899 RETURN
900 END SUBROUTINE DMUMPS_BLR_SAVE_M_ARRAY
901 SUBROUTINE DMUMPS_BLR_RETRIEVE_M_ARRAY ( IWHANDLER, M_ARRAY)
902 IMPLICIT NONE
903 INTEGER, INTENT(IN) :: IWHANDLER
904#if defined(MUMPS_F2003)
905 DOUBLE PRECISION, DIMENSION(:), POINTER, INTENT(OUT) :: M_ARRAY
906#else
907 DOUBLE PRECISION, DIMENSION(:), POINTER :: M_ARRAY
908#endif
909.GT..OR..LE. IF ( IWHANDLER size(BLR_ARRAY) IWHANDLER 0 ) THEN
910 WRITE(*,*) "internal error 1 in dmumps_blr_retrieve_m_array"
911 CALL MUMPS_ABORT()
912 ENDIF
913 M_ARRAY => BLR_ARRAY(IWHANDLER)%M_ARRAY
914 RETURN
915 END SUBROUTINE DMUMPS_BLR_RETRIEVE_M_ARRAY
916 SUBROUTINE DMUMPS_BLR_FREE_M_ARRAY ( IWHANDLER )
917 IMPLICIT NONE
918 INTEGER, INTENT(IN) :: IWHANDLER
919.GT..OR..LE. IF ( IWHANDLER size(BLR_ARRAY) IWHANDLER 0 ) THEN
920 WRITE(*,*) "internal error 1 in dmumps_blr_free_m_array"
921 CALL MUMPS_ABORT()
922 ENDIF
923 IF (associated(BLR_ARRAY(IWHANDLER)%M_ARRAY)) THEN
924 DEALLOCATE(BLR_ARRAY(IWHANDLER)%M_ARRAY)
925 NULLIFY(BLR_ARRAY(IWHANDLER)%M_ARRAY)
926 ENDIF
927 BLR_ARRAY(IWHANDLER)%NFS4FATHER = NFS4FATHER_NOTINIT
928 RETURN
929 END SUBROUTINE DMUMPS_BLR_FREE_M_ARRAY
930 SUBROUTINE DMUMPS_BLR_DEC_AND_TRYFREE_L( IWHANDLER, IPANEL,
931 & KEEP8, K34)
932 IMPLICIT NONE
933 INTEGER, INTENT(IN) :: IWHANDLER, IPANEL, K34
934 INTEGER(8) :: KEEP8(150)
935.LE. IF (IWHANDLER0) RETURN
936.LT. IF ( BLR_ARRAY(IWHANDLER)%NB_ACCESSES_INIT0)
937 & RETURN
938 BLR_ARRAY(IWHANDLER)%PANELS_L(IPANEL)%NB_ACCESSES_LEFT =
939 & BLR_ARRAY(IWHANDLER)%PANELS_L(IPANEL)%NB_ACCESSES_LEFT - 1
940 CALL DMUMPS_BLR_TRY_FREE_PANEL (IWHANDLER, IPANEL,
941 & KEEP8, K34)
942 RETURN
943 END SUBROUTINE DMUMPS_BLR_DEC_AND_TRYFREE_L
944 SUBROUTINE DMUMPS_BLR_TRY_FREE_PANEL( IWHANDLER, IPANEL,
945 & KEEP8, K34 )
946 IMPLICIT NONE
947 INTEGER, INTENT(IN) :: IWHANDLER, IPANEL
948 INTEGER(8) :: KEEP8(150)
949 INTEGER, INTENT(IN) :: K34
950 TYPE(blr_panel_type), POINTER :: THEPANEL
951.LE. IF (IWHANDLER0) RETURN
952.LT. IF ( BLR_ARRAY(IWHANDLER)%NB_ACCESSES_INIT0)
953 & RETURN
954 THEPANEL => BLR_ARRAY(IWHANDLER)%PANELS_L(IPANEL)
955.EQ. IF ( THEPANEL%NB_ACCESSES_LEFT 0 ) THEN
956 IF (associated(THEPANEL%LRB_PANEL)) THEN
957.GT. IF (size(THEPANEL%LRB_PANEL) 0) THEN
958 CALL DEALLOC_BLR_PANEL(THEPANEL%LRB_PANEL,
959 & size(THEPANEL%LRB_PANEL), KEEP8, K34)
960 ENDIF
961 DEALLOCATE(THEPANEL%LRB_PANEL)
962 NULLIFY(THEPANEL%LRB_PANEL)
963 ENDIF
964 THEPANEL%NB_ACCESSES_LEFT = PANELS_FREED
965 ENDIF
966 RETURN
967 END SUBROUTINE DMUMPS_BLR_TRY_FREE_PANEL
968 SUBROUTINE DMUMPS_BLR_FREE_CB_LRB ( IWHANDLER, FREE_ONLY_STRUCT,
969 & KEEP8, K34 )
970 IMPLICIT NONE
971 INTEGER, INTENT(IN) :: IWHANDLER, K34
972 LOGICAL, INTENT(IN) :: FREE_ONLY_STRUCT
973 INTEGER(8) :: KEEP8(150)
974 TYPE(LRB_TYPE), POINTER :: CB_LRB(:,:)
975 INTEGER :: IPANEL, JPANEL
976 TYPE(LRB_TYPE), POINTER :: THELRB
977.AND. IF (BLR_ARRAY(IWHANDLER)%IsT2
978.NOT. & BLR_ARRAY(IWHANDLER)%IsSLAVE) THEN
979 write(*,*) 'Internal error 1 in DMUMPS_BLR_FREE_CB_LRB'
980 CALL MUMPS_ABORT()
981 ENDIF
982 CB_LRB => BLR_ARRAY(IWHANDLER)%CB_LRB
983.NOT. IF (associated(CB_LRB)) THEN
984 write(*,*) 'Internal error 2 in DMUMPS_BLR_FREE_CB_LRB'
985 CALL MUMPS_ABORT()
986 ENDIF
987.NOT. IF (FREE_ONLY_STRUCT) THEN
988 DO IPANEL = 1,size(CB_LRB,1)
989 DO JPANEL = 1,size(CB_LRB,2)
990 THELRB => CB_LRB(IPANEL,JPANEL)
991 IF (associated(THELRB)) THEN
992 CALL DEALLOC_LRB(THELRB, KEEP8, K34)
993 ENDIF
994 ENDDO
995 ENDDO
996 ENDIF
997 DEALLOCATE(BLR_ARRAY(IWHANDLER)%CB_LRB)
998 NULLIFY(BLR_ARRAY(IWHANDLER)%CB_LRB)
999 RETURN
1000 END SUBROUTINE DMUMPS_BLR_FREE_CB_LRB
1001 SUBROUTINE DMUMPS_BLR_FREE_ALL_PANELS ( IWHANDLER,
1002 & LorU, KEEP8, K34)
1003 IMPLICIT NONE
1004 INTEGER, INTENT(IN) :: IWHANDLER, LorU, K34
1005 INTEGER(8) :: KEEP8(150)
1006 INTEGER :: IPANEL
1007 INTEGER :: IDUMMY, JDUMMY
1008 TYPE(blr_panel_type), POINTER :: THEPANEL
1009 TYPE(diag_block_type), POINTER :: THEBLOCK
1010 INTEGER(8) :: MEM_FREED
1011.LE. IF (IWHANDLER0) RETURN
1012.EQ. IF (BLR_ARRAY(IWHANDLER)%NB_ACCESSES_INIT
1013 & PANELS_NOTUSED) RETURN
1014.EQ..OR..EQ. IF (LorU0LorU2) THEN
1015 IF (associated(BLR_ARRAY(IWHANDLER)%PANELS_L)) THEN
1016 DO IPANEL = 1, size(BLR_ARRAY(IWHANDLER)%PANELS_L)
1017 THEPANEL => BLR_ARRAY(IWHANDLER)%PANELS_L(IPANEL)
1018 IF (associated(THEPANEL%LRB_PANEL)) THEN
1019.GT. IF (size(THEPANEL%LRB_PANEL) 0) THEN
1020 CALL DEALLOC_BLR_PANEL(THEPANEL%LRB_PANEL,
1021 & size(THEPANEL%LRB_PANEL), KEEP8, K34)
1022 ENDIF
1023 DEALLOCATE(THEPANEL%LRB_PANEL)
1024 NULLIFY(THEPANEL%LRB_PANEL)
1025 ENDIF
1026 THEPANEL%NB_ACCESSES_LEFT = PANELS_FREED
1027 ENDDO
1028 ENDIF
1029 ENDIF
1030.GE..AND..NOT. IF (LorU1BLR_ARRAY(IWHANDLER)%IsSYM) THEN
1031 IF (associated(BLR_ARRAY(IWHANDLER)%PANELS_U)) THEN
1032 DO IPANEL = 1, size(BLR_ARRAY(IWHANDLER)%PANELS_U)
1033 THEPANEL => BLR_ARRAY(IWHANDLER)%PANELS_U(IPANEL)
1034 IF (associated(THEPANEL%LRB_PANEL)) THEN
1035.GT. IF (size(THEPANEL%LRB_PANEL) 0) THEN
1036 CALL DEALLOC_BLR_PANEL(THEPANEL%LRB_PANEL,
1037 & size(THEPANEL%LRB_PANEL), KEEP8, K34)
1038 ENDIF
1039 DEALLOCATE(THEPANEL%LRB_PANEL)
1040 NULLIFY(THEPANEL%LRB_PANEL)
1041 ENDIF
1042 THEPANEL%NB_ACCESSES_LEFT = PANELS_FREED
1043 ENDDO
1044 ENDIF
1045 ENDIF
1046.NOT. IF (BLR_ARRAY(IWHANDLER)%IsSLAVE) THEN
1047 IF (associated(BLR_ARRAY(IWHANDLER)%DIAG_BLOCKS)) THEN
1048 MEM_FREED = 0_8
1049 DO IPANEL = 1, size(BLR_ARRAY(IWHANDLER)%DIAG_BLOCKS)
1050 THEBLOCK => BLR_ARRAY(IWHANDLER)%DIAG_BLOCKS(IPANEL)
1051 IF (associated(THEBLOCK%DIAG_BLOCK)) THEN
1052 DEALLOCATE(THEBLOCK%DIAG_BLOCK)
1053 NULLIFY (THEBLOCK%DIAG_BLOCK)
1054 MEM_FREED = MEM_FREED + int(size(THEBLOCK%DIAG_BLOCK),8)
1055 ENDIF
1056 ENDDO
1057.GT. IF (MEM_FREED 0 ) THEN
1058 CALL MUMPS_DM_FAC_UPD_DYN_MEMCNTS(-MEM_FREED,
1059 & .TRUE., KEEP8,
1060 & IDUMMY, JDUMMY,
1061 & .TRUE., .TRUE.)
1062 ENDIF
1063 ENDIF
1064 ENDIF
1065 RETURN
1066 END SUBROUTINE DMUMPS_BLR_FREE_ALL_PANELS
1067 SUBROUTINE DMUMPS_SAVE_RESTORE_BLR(id_BLRARRAY_ENCODING
1068 & ,unit,MYID,mode
1069 & ,SIZE_GEST,SIZE_VARIABLES
1070 & ,SIZE_INT, SIZE_ARITH_DEP, SIZE_LOGICAL
1071 & ,TOTAL_FILE_SIZE,TOTAL_STRUC_SIZE
1072 & ,size_read,size_allocated,size_written
1073 & ,INFO)
1074 INCLUDE 'mpif.h'
1075 CHARACTER, DIMENSION(:), POINTER :: id_BLRARRAY_ENCODING
1076 INTEGER,intent(IN)::unit,MYID
1077 CHARACTER(len=*),intent(IN) :: mode
1078 INTEGER,INTENT(OUT) :: SIZE_GEST
1079 INTEGER(8),intent(OUT) :: SIZE_VARIABLES
1080 INTEGER(8),intent(IN) :: TOTAL_FILE_SIZE,TOTAL_STRUC_SIZE
1081 INTEGER,intent(INOUT):: INFO(2)
1082 INTEGER,intent(IN):: SIZE_INT, SIZE_ARITH_DEP, SIZE_LOGICAL
1083 INTEGER(8),intent(INOUT):: size_read,size_allocated,size_written
1084 INTEGER:: j1,NbRecords,NbSubRecords,size_array1,dummy,allocok,err
1085 INTEGER:: SIZE_GEST_BLR_ARRAY,SIZE_GEST_BLR_ARRAY_j1
1086 INTEGER(8):: SIZE_VARIABLES_BLR_ARRAY,SIZE_VARIABLES_BLR_ARRAY_j1
1087 INTEGER(4) :: I4
1088 NbRecords=0
1089 SIZE_GEST_BLR_ARRAY=0
1090 SIZE_GEST_BLR_ARRAY_j1=0
1091 SIZE_VARIABLES_BLR_ARRAY=0_8
1092 SIZE_VARIABLES_BLR_ARRAY_j1=0_8
1093 SIZE_GEST=0
1094 SIZE_VARIABLES=0_8
1095.EQ. if((trim(mode)"memory_save.OR..EQ.")(trim(mode)"save")) then
1096 call DMUMPS_BLR_STRUC_TO_MOD(id_BLRARRAY_ENCODING)
1097 endif
1098.EQ. if(trim(mode)"memory_save") then
1099 IF(associated(BLR_ARRAY)) THEN
1100 NbRecords=1
1101 SIZE_GEST=SIZE_INT
1102 SIZE_VARIABLES=0
1103 DO j1=1,size(BLR_ARRAY,1)
1104 CALL DMUMPS_SAVE_RESTORE_BLR_STRUC(
1105 & BLR_ARRAY(j1)
1106 & ,unit,MYID,"memory_save"
1107 & ,SIZE_GEST_BLR_ARRAY_j1
1108 & ,SIZE_VARIABLES_BLR_ARRAY_j1
1109 & ,SIZE_INT, SIZE_ARITH_DEP, SIZE_LOGICAL
1110 & ,TOTAL_FILE_SIZE,TOTAL_STRUC_SIZE
1111 & ,size_read,size_allocated,size_written
1112 & ,INFO)
1113 SIZE_GEST_BLR_ARRAY=SIZE_GEST_BLR_ARRAY+
1114 & SIZE_GEST_BLR_ARRAY_j1
1115 SIZE_VARIABLES_BLR_ARRAY=SIZE_VARIABLES_BLR_ARRAY+
1116 & SIZE_VARIABLES_BLR_ARRAY_j1
1117 ENDDO
1118 ELSE
1119 NbRecords=2
1120 SIZE_GEST=SIZE_INT*2
1121 SIZE_VARIABLES=0
1122 ENDIF
1123.EQ. elseif(trim(mode)"save") then
1124 IF(associated(BLR_ARRAY)) THEN
1125 NbRecords=1
1126 SIZE_GEST=SIZE_INT
1127 SIZE_VARIABLES=0
1128 write(unit,iostat=err) size(BLR_ARRAY,1)
1129.ne. if(err0) then
1130 INFO(1) = -72
1131 CALL MUMPS_SETI8TOI4(TOTAL_FILE_SIZE-size_written,
1132 & INFO(2))
1133 endif
1134.LT. IF ( INFO(1) 0 ) GOTO 100
1135 DO j1=1,size(BLR_ARRAY,1)
1136 CALL DMUMPS_SAVE_RESTORE_BLR_STRUC(
1137 & BLR_ARRAY(j1)
1138 & ,unit,MYID,"save"
1139 & ,SIZE_GEST_BLR_ARRAY_j1
1140 & ,SIZE_VARIABLES_BLR_ARRAY_j1
1141 & ,SIZE_INT, SIZE_ARITH_DEP, SIZE_LOGICAL
1142 & ,TOTAL_FILE_SIZE,TOTAL_STRUC_SIZE
1143 & ,size_read,size_allocated,size_written
1144 & ,INFO)
1145.LT. IF ( INFO(1) 0 ) GOTO 100
1146 ENDDO
1147 ELSE
1148 NbRecords=2
1149 SIZE_GEST=SIZE_INT*2
1150 SIZE_VARIABLES=0
1151 write(unit,iostat=err) -999
1152.ne. if(err0) then
1153 INFO(1) = -72
1154 CALL MUMPS_SETI8TOI4(TOTAL_FILE_SIZE-size_written,
1155 & INFO(2))
1156 endif
1157.LT. IF ( INFO(1) 0 ) GOTO 100
1158 write(unit,iostat=err) -999
1159.ne. if(err0) then
1160 INFO(1) = -72
1161 CALL MUMPS_SETI8TOI4(TOTAL_FILE_SIZE-size_written,
1162 & INFO(2))
1163 endif
1164.LT. IF ( INFO(1) 0 ) GOTO 100
1165 ENDIF
1166.EQ. elseif(trim(mode)"restore") then
1167 nullify(BLR_ARRAY)
1168 read(unit,iostat=err) size_array1
1169.ne. if(err0) THEN
1170 INFO(1) = -75
1171 CALL MUMPS_SETI8TOI4(TOTAL_FILE_SIZE-size_read
1172 & ,INFO(2))
1173 endif
1174.LT. IF ( INFO(1) 0 ) GOTO 100
1175.EQ. if(size_array1-999) then
1176 NbRecords=2
1177 SIZE_GEST=SIZE_INT*2
1178 SIZE_VARIABLES=0
1179 read(unit,iostat=err) dummy
1180.ne. if(err0) THEN
1181 INFO(1) = -75
1182 CALL MUMPS_SETI8TOI4(TOTAL_FILE_SIZE-size_read
1183 & ,INFO(2))
1184 endif
1185.LT. IF ( INFO(1) 0 ) GOTO 100
1186 else
1187 NbRecords=1
1188 SIZE_GEST=SIZE_INT
1189 SIZE_VARIABLES=0
1190 allocate(BLR_ARRAY(size_array1), stat=allocok)
1191.GT. if (allocok 0) THEN
1192 INFO(1) = -78
1193 CALL MUMPS_SETI8TOI4(
1194 & TOTAL_STRUC_SIZE-size_allocated
1195 & ,INFO(2))
1196 endif
1197 DO j1=1,size_array1
1198 CALL DMUMPS_SAVE_RESTORE_BLR_STRUC(
1199 & BLR_ARRAY(j1)
1200 & ,unit,MYID,"restore"
1201 & ,SIZE_GEST_BLR_ARRAY_j1
1202 & ,SIZE_VARIABLES_BLR_ARRAY_j1
1203 & ,SIZE_INT, SIZE_ARITH_DEP, SIZE_LOGICAL
1204 & ,TOTAL_FILE_SIZE,TOTAL_STRUC_SIZE
1205 & ,size_read,size_allocated,size_written
1206 & ,INFO)
1207 SIZE_GEST_BLR_ARRAY=SIZE_GEST_BLR_ARRAY+
1208 & SIZE_GEST_BLR_ARRAY_j1
1209 SIZE_VARIABLES_BLR_ARRAY=SIZE_VARIABLES_BLR_ARRAY+
1210 & SIZE_VARIABLES_BLR_ARRAY_j1
1211 ENDDO
1212 endif
1213 endif
1214.EQ. if(trim(mode)"memory_save") then
1215 NbSubRecords=int(SIZE_VARIABLES/huge(I4))
1216.GT. IF(NbSubRecords0) then
1217 NbRecords=NbRecords+NbSubRecords
1218 ENDIF
1219.EQ. elseif(trim(mode)"save") then
1220 size_written=size_written+SIZE_VARIABLES
1221 & +int(SIZE_GEST,kind=8)
1222#if !defined(MUMPS_F2003)
1223 size_written=size_written
1224 & +int(2*SIZE_INT*NbRecords,kind=8)
1225#endif
1226.EQ. elseif(trim(mode)"restore") then
1227 size_allocated=size_allocated+SIZE_VARIABLES
1228 size_read=size_read+SIZE_VARIABLES
1229 & +int(SIZE_GEST,kind=8)
1230#if !defined(MUMPS_F2003)
1231 size_read=size_read
1232 & +int(2*SIZE_INT*NbRecords,kind=8)
1233#endif
1234 endif
1235.EQ. if(trim(mode)"memory_save") then
1236 SIZE_VARIABLES=SIZE_VARIABLES+SIZE_VARIABLES_BLR_ARRAY
1237 SIZE_GEST=SIZE_GEST+SIZE_GEST_BLR_ARRAY
1238#if !defined(MUMPS_F2003)
1239 SIZE_GEST=SIZE_GEST+2*SIZE_INT*NbRecords
1240#endif
1241 endif
1242 call DMUMPS_BLR_MOD_TO_STRUC(id_BLRARRAY_ENCODING)
1243 100 continue
1244 RETURN
1245 END SUBROUTINE DMUMPS_SAVE_RESTORE_BLR
1246 SUBROUTINE DMUMPS_SAVE_RESTORE_BLR_STRUC(BLR_STRUC
1247 & ,unit,MYID,mode
1248 & ,Local_SIZE_GEST,Local_SIZE_VARIABLES
1249 & ,SIZE_INT, SIZE_ARITH_DEP, SIZE_LOGICAL
1250 & ,TOTAL_FILE_SIZE,TOTAL_STRUC_SIZE
1251 & ,size_read,size_allocated,size_written
1252 & ,INFO)
1253 INCLUDE 'mpif.h'
1254 TYPE(BLR_STRUC_T) :: BLR_STRUC
1255 INTEGER,intent(IN)::unit,MYID
1256 CHARACTER(len=*),intent(IN) :: mode
1257 INTEGER,INTENT(OUT) :: Local_SIZE_GEST
1258 INTEGER(8),intent(OUT) :: Local_SIZE_VARIABLES
1259 INTEGER,intent(INOUT):: INFO(2)
1260 INTEGER,intent(IN):: SIZE_INT, SIZE_ARITH_DEP, SIZE_LOGICAL
1261 INTEGER(8),intent(IN) :: TOTAL_FILE_SIZE,TOTAL_STRUC_SIZE
1262 INTEGER(8),intent(INOUT):: size_read,size_allocated,size_written
1263 INTEGER :: NBVARIABLES_BLR_STRUC_T
1264 PARAMETER (NBVARIABLES_BLR_STRUC_T = 15)
1265 CHARACTER(len=30), dimension(NBVARIABLES_BLR_STRUC_T)::
1266 & VARIABLES_BLR_STRUC_T
1267 CHARACTER(len=30) :: TMP_STRING
1268 INTEGER(8),dimension(NBVARIABLES_BLR_STRUC_T)::
1269 & SIZE_VARIABLES_BLR_STRUC_T
1270 INTEGER,dimension(NBVARIABLES_BLR_STRUC_T)::SIZE_GEST_BLR_STRUC_T
1271 INTEGER,dimension(NBVARIABLES_BLR_STRUC_T)::NbRecords_BLR_STRUC_T
1272 INTEGER:: size_array1,size_array2,dummy,allocok
1273 INTEGER:: err,i1,j1,j2,NbSubRecords,Local_NbRecords
1274 INTEGER::SIZE_GEST_PANELS_L,SIZE_GEST_PANELS_L_j1
1275 INTEGER(8)::SIZE_VARIABLES_PANELS_L,SIZE_VARIABLES_PANELS_L_j1
1276 INTEGER::SIZE_GEST_PANELS_U,SIZE_GEST_PANELS_U_j1
1277 INTEGER(8)::SIZE_VARIABLES_PANELS_U,SIZE_VARIABLES_PANELS_U_j1
1278 INTEGER::SIZE_GEST_CB_LRB,SIZE_GEST_CB_LRB_j1j2
1279 INTEGER(8)::SIZE_VARIABLES_CB_LRB,SIZE_VARIABLES_CB_LRB_j1j2
1280 INTEGER::SIZE_GEST_DIAG_BLOCKS,SIZE_GEST_DIAG_BLOCKS_j1
1281 INTEGER(8)::SIZE_VARIABLES_DIAG_BLOCKS
1282 INTEGER(8)::SIZE_VARIABLES_DIAG_BLOCKS_j1
1283 INTEGER(4)::I4
1284 VARIABLES_BLR_STRUC_T(1)="issym"
1285 VARIABLES_BLR_STRUC_T(2)="ist2"
1286 VARIABLES_BLR_STRUC_T(3)="isslave"
1287 VARIABLES_BLR_STRUC_T(4)="panels_l"
1288 VARIABLES_BLR_STRUC_T(5)="panels_u"
1289 VARIABLES_BLR_STRUC_T(6)="cb_lrb"
1290 VARIABLES_BLR_STRUC_T(7)="begs_blr_static"
1291 VARIABLES_BLR_STRUC_T(8)="begs_blr_dynamic"
1292 VARIABLES_BLR_STRUC_T(9)="begs_blr_l"
1293 VARIABLES_BLR_STRUC_T(10)="begs_blr_col"
1294 VARIABLES_BLR_STRUC_T(11)="nb_accesses_init"
1295 VARIABLES_BLR_STRUC_T(12)="nb_panels"
1296 VARIABLES_BLR_STRUC_T(13)="diag_blocks"
1297 VARIABLES_BLR_STRUC_T(14)="nfs4father"
1298 VARIABLES_BLR_STRUC_T(15)="m_array"
1299 SIZE_VARIABLES_BLR_STRUC_T(:)=0_8
1300 SIZE_GEST_BLR_STRUC_T(:)=0
1301 NbRecords_BLR_STRUC_T(:)=0
1302 SIZE_GEST_PANELS_L=0
1303 SIZE_GEST_PANELS_L_j1=0
1304 SIZE_VARIABLES_PANELS_L=0_8
1305 SIZE_VARIABLES_PANELS_L_j1=0_8
1306 SIZE_GEST_PANELS_U=0
1307 SIZE_GEST_PANELS_U_j1=0
1308 SIZE_VARIABLES_PANELS_U=0_8
1309 SIZE_VARIABLES_PANELS_U_j1=0_8
1310 SIZE_GEST_CB_LRB=0
1311 SIZE_GEST_CB_LRB_j1j2=0
1312 SIZE_VARIABLES_CB_LRB=0_8
1313 SIZE_VARIABLES_CB_LRB_j1j2=0_8
1314 SIZE_GEST_DIAG_BLOCKS=0
1315 SIZE_GEST_DIAG_BLOCKS_j1=0
1316 SIZE_VARIABLES_DIAG_BLOCKS=0_8
1317 SIZE_VARIABLES_DIAG_BLOCKS_j1=0_8
1318 DO i1=1,NBVARIABLES_BLR_STRUC_T
1319 TMP_STRING = VARIABLES_BLR_STRUC_T(i1)
1320 SELECT CASE(TMP_STRING)
1321 CASE("issym")
1322 NbRecords_BLR_STRUC_T(i1)=1
1323.EQ. if(trim(mode)"memory_save") then
1324 SIZE_VARIABLES_BLR_STRUC_T(i1)=SIZE_LOGICAL
1325.EQ. elseif(trim(mode)"save") then
1326 SIZE_VARIABLES_BLR_STRUC_T(i1)=SIZE_LOGICAL
1327 write(unit,iostat=err) BLR_STRUC%IsSYM
1328.ne. if(err0) then
1329 INFO(1) = -72
1330 CALL MUMPS_SETI8TOI4(TOTAL_FILE_SIZE-size_written,
1331 & INFO(2))
1332 endif
1333.LT. IF ( INFO(1) 0 ) GOTO 100
1334.EQ. elseif(trim(mode)"restore") then
1335 SIZE_VARIABLES_BLR_STRUC_T(i1)=SIZE_LOGICAL
1336 read(unit,iostat=err) BLR_STRUC%IsSYM
1337.ne. if(err0) THEN
1338 INFO(1) = -75
1339 CALL MUMPS_SETI8TOI4(TOTAL_FILE_SIZE-size_read
1340 & ,INFO(2))
1341 endif
1342.LT. IF (INFO(1) 0 ) GOTO 100
1343 endif
1344 CASE("ist2")
1345 NbRecords_BLR_STRUC_T(i1)=1
1346.EQ. if(trim(mode)"memory_save") then
1347 SIZE_VARIABLES_BLR_STRUC_T(i1)=SIZE_LOGICAL
1348.EQ. elseif(trim(mode)"save") then
1349 SIZE_VARIABLES_BLR_STRUC_T(i1)=SIZE_LOGICAL
1350 write(unit,iostat=err) BLR_STRUC%IsT2
1351.ne. if(err0) then
1352 INFO(1) = -72
1353 CALL MUMPS_SETI8TOI4(TOTAL_FILE_SIZE-size_written,
1354 & INFO(2))
1355 endif
1356.LT. IF ( INFO(1) 0 ) GOTO 100
1357.EQ. elseif(trim(mode)"restore") then
1358 SIZE_VARIABLES_BLR_STRUC_T(i1)=SIZE_LOGICAL
1359 read(unit,iostat=err) BLR_STRUC%IsT2
1360.ne. if(err0) THEN
1361 INFO(1) = -75
1362 CALL MUMPS_SETI8TOI4(TOTAL_FILE_SIZE-size_read
1363 & ,INFO(2))
1364 endif
1365.LT. IF (INFO(1) 0 ) GOTO 100
1366 endif
1367 CASE("isslave")
1368 NbRecords_BLR_STRUC_T(i1)=1
1369.EQ. if(trim(mode)"memory_save") then
1370 SIZE_VARIABLES_BLR_STRUC_T(i1)=SIZE_LOGICAL
1371.EQ. elseif(trim(mode)"save") then
1372 SIZE_VARIABLES_BLR_STRUC_T(i1)=SIZE_LOGICAL
1373 write(unit,iostat=err) BLR_STRUC%IsSLAVE
1374.ne. if(err0) then
1375 INFO(1) = -72
1376 CALL MUMPS_SETI8TOI4(TOTAL_FILE_SIZE-size_written,
1377 & INFO(2))
1378 endif
1379.LT. IF ( INFO(1) 0 ) GOTO 100
1380.EQ. elseif(trim(mode)"restore") then
1381 SIZE_VARIABLES_BLR_STRUC_T(i1)=SIZE_LOGICAL
1382 read(unit,iostat=err) BLR_STRUC%IsSLAVE
1383.ne. if(err0) THEN
1384 INFO(1) = -75
1385 CALL MUMPS_SETI8TOI4(TOTAL_FILE_SIZE-size_read
1386 & ,INFO(2))
1387 endif
1388.LT. IF (INFO(1) 0 ) GOTO 100
1389 endif
1390 CASE("begs_blr_static")
1391 nbrecords_blr_struc_t(i1)=2
1392 if(trim(mode).EQ."memory_save") then
1393 IF(associated(blr_struc%BEGS_BLR_STATIC)) THEN
1394 size_gest_blr_struc_t(i1)=size_int
1395 size_variables_blr_struc_t(i1)=
1396 & size(blr_struc%BEGS_BLR_STATIC,1)*size_int
1397 ELSE
1398 size_gest_blr_struc_t(i1)=size_int*2
1399 size_variables_blr_struc_t(i1)=0
1400 ENDIF
1401 elseif(trim(mode).EQ."save") then
1402 IF(associated(blr_struc%BEGS_BLR_STATIC)) THEN
1403 size_gest_blr_struc_t(i1)=size_int
1404 size_variables_blr_struc_t(i1)=
1405 & size(blr_struc%BEGS_BLR_STATIC,1)*size_int
1406 write(unit,iostat=err)
1407 & size(blr_struc%BEGS_BLR_STATIC,1)
1408 if(err.ne.0) then
1409 info(1) = -72
1410 CALL mumps_seti8toi4(total_file_size-size_written,
1411 & info(2))
1412 endif
1413 IF ( info(1) .LT. 0 ) GOTO 100
1414 write(unit,iostat=err) blr_struc%BEGS_BLR_STATIC
1415 ELSE
1416 size_gest_blr_struc_t(i1)=size_int*2
1417 size_variables_blr_struc_t(i1)=0
1418 write(unit,iostat=err) -999
1419 if(err.ne.0) then
1420 info(1) = -72
1421 CALL mumps_seti8toi4(total_file_size-size_written,
1422 & info(2))
1423 endif
1424 IF ( info(1) .LT. 0 ) GOTO 100
1425 write(unit,iostat=err) -999
1426 ENDIF
1427 if(err.ne.0) then
1428 info(1) = -72
1429 CALL mumps_seti8toi4(total_file_size-size_written,
1430 & info(2))
1431 endif
1432 IF ( info(1) .LT. 0 ) GOTO 100
1433 elseif(trim(mode).EQ."restore") then
1434 nullify(BLR_STRUC%BEGS_BLR_STATIC)
1435 read(unit,iostat=err) size_array1
1436.ne. if(err0) THEN
1437 INFO(1) = -75
1438 CALL MUMPS_SETI8TOI4(TOTAL_FILE_SIZE-size_read
1439 & ,INFO(2))
1440 endif
1441.LT. IF ( INFO(1) 0 ) GOTO 100
1442.EQ. if(size_array1-999) then
1443 SIZE_GEST_BLR_STRUC_T(i1)=SIZE_INT*2
1444 SIZE_VARIABLES_BLR_STRUC_T(i1)=0
1445 read(unit,iostat=err) dummy
1446 else
1447 SIZE_GEST_BLR_STRUC_T(i1)=SIZE_INT
1448 SIZE_VARIABLES_BLR_STRUC_T(i1)=size_array1*SIZE_INT
1449 allocate(BLR_STRUC%BEGS_BLR_STATIC(size_array1)
1450 & , stat=allocok)
1451.GT. if (allocok 0) THEN
1452 INFO(1) = -78
1453 CALL MUMPS_SETI8TOI4(
1454 & TOTAL_STRUC_SIZE-size_allocated
1455 & ,INFO(2))
1456 endif
1457 read(unit,iostat=err) BLR_STRUC%BEGS_BLR_STATIC
1458 endif
1459.LT. IF ( INFO(1) 0 ) GOTO 100
1460.ne. if(err0) THEN
1461 INFO(1) = -75
1462 CALL MUMPS_SETI8TOI4(TOTAL_FILE_SIZE-size_read
1463 & ,INFO(2))
1464 endif
1465.LT. IF ( INFO(1) 0 ) GOTO 100
1466 endif
1467 CASE("begs_blr_dynamic")
1468 nbrecords_blr_struc_t(i1)=2
1469 if(trim(mode).EQ."memory_save") then
1470 IF(associated(blr_struc%BEGS_BLR_DYNAMIC)) THEN
1471 size_gest_blr_struc_t(i1)=size_int
1472 size_variables_blr_struc_t(i1)=
1473 & size(blr_struc%BEGS_BLR_DYNAMIC,1)*size_int
1474 ELSE
1475 size_gest_blr_struc_t(i1)=size_int*2
1476 size_variables_blr_struc_t(i1)=0
1477 ENDIF
1478 elseif(trim(mode).EQ."save") then
1479 IF(associated(blr_struc%BEGS_BLR_DYNAMIC)) THEN
1480 size_gest_blr_struc_t(i1)=size_int
1481 size_variables_blr_struc_t(i1)=
1482 & size(blr_struc%BEGS_BLR_DYNAMIC,1)*size_int
1483 write(unit,iostat=err)
1484 & size(blr_struc%BEGS_BLR_DYNAMIC,1)
1485 if(err.ne.0) then
1486 info(1) = -72
1487 CALL mumps_seti8toi4(total_file_size-size_written,
1488 & info(2))
1489 endif
1490 IF ( info(1) .LT. 0 ) GOTO 100
1491 write(unit,iostat=err) blr_struc%BEGS_BLR_DYNAMIC
1492 ELSE
1493 size_gest_blr_struc_t(i1)=size_int*2
1494 size_variables_blr_struc_t(i1)=0
1495 write(unit,iostat=err) -999
1496 if(err.ne.0) then
1497 info(1) = -72
1498 CALL mumps_seti8toi4(total_file_size-size_written,
1499 & info(2))
1500 endif
1501 IF ( info(1) .LT. 0 ) GOTO 100
1502 write(unit,iostat=err) -999
1503 ENDIF
1504 if(err.ne.0) then
1505 info(1) = -72
1506 CALL mumps_seti8toi4(total_file_size-size_written,
1507 & info(2))
1508 endif
1509 IF ( info(1) .LT. 0 ) GOTO 100
1510 elseif(trim(mode).EQ."restore") then
1511 nullify(blr_struc%BEGS_BLR_DYNAMIC)
1512 read(unit,iostat=err) size_array1
1513 if(err.ne.0) THEN
1514 info(1) = -75
1515 CALL mumps_seti8toi4(total_file_size-size_read
1516 & ,info(2))
1517 endif
1518 IF ( info(1) .LT. 0 ) GOTO 100
1519 if(size_array1.EQ.-999) then
1520 size_gest_blr_struc_t(i1)=size_int*2
1521 size_variables_blr_struc_t(i1)=0
1522 read(unit,iostat=err) dummy
1523 else
1524 size_gest_blr_struc_t(i1)=size_int
1525 size_variables_blr_struc_t(i1)=size_array1*size_int
1526 allocate(blr_struc%BEGS_BLR_DYNAMIC(size_array1)
1527 & , stat=allocok)
1528 if (allocok .GT. 0) THEN
1529 info(1) = -78
1530 CALL mumps_seti8toi4(
1531 & total_struc_size-size_allocated
1532 & ,info(2))
1533 endif
1534 read(unit,iostat=err) blr_struc%BEGS_BLR_DYNAMIC
1535 endif
1536 IF ( info(1) .LT. 0 ) GOTO 100
1537 if(err.ne.0) THEN
1538 info(1) = -75
1539 CALL mumps_seti8toi4(total_file_size-size_read
1540 & ,info(2))
1541 endif
1542 IF ( info(1) .LT. 0 ) GOTO 100
1543 endif
1544 CASE("BEGS_BLR_L")
1545 nbrecords_blr_struc_t(i1)=2
1546 if(trim(mode).EQ."memory_save") then
1547 IF(associated(blr_struc%BEGS_BLR_L)) THEN
1548 size_gest_blr_struc_t(i1)=size_int
1549 size_variables_blr_struc_t(i1)=
1550 & size(blr_struc%BEGS_BLR_L,1)*size_int
1551 ELSE
1552 size_gest_blr_struc_t(i1)=size_int*2
1553 size_variables_blr_struc_t(i1)=0
1554 ENDIF
1555 elseif(trim(mode).EQ."save") then
1556 IF(associated(blr_struc%BEGS_BLR_L)) THEN
1557 size_gest_blr_struc_t(i1)=size_int
1558 size_variables_blr_struc_t(i1)=
1559 & size(blr_struc%BEGS_BLR_L,1)*size_int
1560 write(unit,iostat=err)
1561 & size(blr_struc%BEGS_BLR_L,1)
1562 if(err.ne.0) then
1563 info(1) = -72
1564 CALL mumps_seti8toi4(total_file_size-size_written,
1565 & info(2))
1566 endif
1567 IF ( info(1) .LT. 0 ) GOTO 100
1568 write(unit,iostat=err) blr_struc%BEGS_BLR_L
1569 ELSE
1570 size_gest_blr_struc_t(i1)=size_int*2
1571 size_variables_blr_struc_t(i1)=0
1572 write(unit,iostat=err) -999
1573 if(err.ne.0) then
1574 info(1) = -72
1575 CALL mumps_seti8toi4(total_file_size-size_written,
1576 & info(2))
1577 endif
1578 IF ( info(1) .LT. 0 ) GOTO 100
1579 write(unit,iostat=err) -999
1580 ENDIF
1581 if(err.ne.0) then
1582 info(1) = -72
1583 CALL mumps_seti8toi4(total_file_size-size_written,
1584 & info(2))
1585 endif
1586 IF ( info(1) .LT. 0 ) GOTO 100
1587 elseif(trim(mode).EQ."restore") then
1588 nullify(blr_struc%BEGS_BLR_L)
1589 read(unit,iostat=err) size_array1
1590 if(err.ne.0) THEN
1591 info(1) = -75
1592 CALL mumps_seti8toi4(total_file_size-size_read
1593 & ,info(2))
1594 endif
1595 IF ( info(1) .LT. 0 ) GOTO 100
1596 if(size_array1.EQ.-999) then
1597 size_gest_blr_struc_t(i1)=size_int*2
1598 size_variables_blr_struc_t(i1)=0
1599 read(unit,iostat=err) dummy
1600 else
1601 size_gest_blr_struc_t(i1)=size_int
1602 size_variables_blr_struc_t(i1)=size_array1*size_int
1603 allocate(blr_struc%BEGS_BLR_L(size_array1)
1604 & , stat=allocok)
1605 if (allocok .GT. 0) THEN
1606 info(1) = -78
1607 CALL mumps_seti8toi4(
1608 & total_struc_size-size_allocated
1609 & ,info(2))
1610 endif
1611 read(unit,iostat=err) blr_struc%BEGS_BLR_L
1612 endif
1613 IF ( info(1) .LT. 0 ) GOTO 100
1614 if(err.ne.0) THEN
1615 info(1) = -75
1616 CALL mumps_seti8toi4(total_file_size-size_read
1617 & ,info(2))
1618 endif
1619 IF ( info(1) .LT. 0 ) GOTO 100
1620 endif
1621 CASE("BEGS_BLR_COL")
1622 nbrecords_blr_struc_t(i1)=2
1623 if(trim(mode).EQ."memory_save") then
1624 IF(associated(blr_struc%BEGS_BLR_COL)) THEN
1625 size_gest_blr_struc_t(i1)=size_int
1626 size_variables_blr_struc_t(i1)=
1627 & size(blr_struc%BEGS_BLR_COL,1)*size_int
1628 ELSE
1629 size_gest_blr_struc_t(i1)=size_int*2
1630 size_variables_blr_struc_t(i1)=0
1631 ENDIF
1632 elseif(trim(mode).EQ."save") then
1633 IF(associated(blr_struc%BEGS_BLR_COL)) THEN
1634 size_gest_blr_struc_t(i1)=size_int
1635 size_variables_blr_struc_t(i1)=
1636 & size(blr_struc%BEGS_BLR_COL,1)*size_int
1637 write(unit,iostat=err)
1638 & size(blr_struc%BEGS_BLR_COL,1)
1639 if(err.ne.0) then
1640 info(1) = -72
1641 CALL mumps_seti8toi4(total_file_size-size_written,
1642 & info(2))
1643 endif
1644 IF ( info(1) .LT. 0 ) GOTO 100
1645 write(unit,iostat=err) blr_struc%BEGS_BLR_COL
1646 ELSE
1647 size_gest_blr_struc_t(i1)=size_int*2
1648 size_variables_blr_struc_t(i1)=0
1649 write(unit,iostat=err) -999
1650 if(err.ne.0) then
1651 info(1) = -72
1652 CALL mumps_seti8toi4(total_file_size-size_written,
1653 & info(2))
1654 endif
1655 IF ( info(1) .LT. 0 ) GOTO 100
1656 write(unit,iostat=err) -999
1657 ENDIF
1658 if(err.ne.0) then
1659 info(1) = -72
1660 CALL mumps_seti8toi4(total_file_size-size_written,
1661 & info(2))
1662 endif
1663 IF ( info(1) .LT. 0 ) GOTO 100
1664 elseif(trim(mode).EQ."restore") then
1665 nullify(blr_struc%BEGS_BLR_COL)
1666 read(unit,iostat=err) size_array1
1667 if(err.ne.0) THEN
1668 info(1) = -75
1669 CALL mumps_seti8toi4(total_file_size-size_read
1670 & ,info(2))
1671 endif
1672 IF ( info(1) .LT. 0 ) GOTO 100
1673 if(size_array1.EQ.-999) then
1674 size_gest_blr_struc_t(i1)=size_int*2
1675 size_variables_blr_struc_t(i1)=0
1676 read(unit,iostat=err) dummy
1677 else
1678 size_gest_blr_struc_t(i1)=size_int
1679 size_variables_blr_struc_t(i1)=size_array1*size_int
1680 allocate(blr_struc%BEGS_BLR_COL(size_array1)
1681 & , stat=allocok)
1682 if (allocok .GT. 0) THEN
1683 info(1) = -78
1684 CALL mumps_seti8toi4(
1685 & total_struc_size-size_allocated
1686 & ,info(2))
1687 endif
1688 read(unit,iostat=err) blr_struc%BEGS_BLR_COL
1689 endif
1690 IF ( info(1) .LT. 0 ) GOTO 100
1691 if(err.ne.0) THEN
1692 info(1) = -75
1693 CALL mumps_seti8toi4(total_file_size-size_read
1694 & ,info(2))
1695 endif
1696 IF ( info(1) .LT. 0 ) GOTO 100
1697 endif
1698 CASE("NB_ACCESSES_INIT")
1699 nbrecords_blr_struc_t(i1)=1
1700 if(trim(mode).EQ."memory_save") then
1701 size_variables_blr_struc_t(i1)=size_int
1702 elseif(trim(mode).EQ."save") then
1703 size_variables_blr_struc_t(i1)=size_int
1704 write(unit,iostat=err) blr_struc%NB_ACCESSES_INIT
1705 if(err.ne.0) then
1706 info(1) = -72
1707 CALL mumps_seti8toi4(total_file_size-size_written,
1708 & info(2))
1709 endif
1710 IF ( info(1) .LT. 0 ) GOTO 100
1711 elseif(trim(mode).EQ."restore") then
1712 size_variables_blr_struc_t(i1)=size_int
1713 read(unit,iostat=err) blr_struc%NB_ACCESSES_INIT
1714 if(err.ne.0) THEN
1715 info(1) = -75
1716 CALL mumps_seti8toi4(total_file_size-size_read
1717 & ,info(2))
1718 endif
1719 IF (info(1) .LT. 0 ) GOTO 100
1720 endif
1721 CASE("NB_PANELS")
1722 nbrecords_blr_struc_t(i1)=1
1723 if(trim(mode).EQ."memory_save") then
1724 size_variables_blr_struc_t(i1)=size_int
1725 elseif(trim(mode).EQ."save") then
1726 size_variables_blr_struc_t(i1)=size_int
1727 write(unit,iostat=err) blr_struc%NB_PANELS
1728 if(err.ne.0) then
1729 info(1) = -72
1730 CALL mumps_seti8toi4(total_file_size-size_written,
1731 & info(2))
1732 endif
1733 IF ( info(1) .LT. 0 ) GOTO 100
1734 elseif(trim(mode).EQ."restore") then
1735 size_variables_blr_struc_t(i1)=size_int
1736 read(unit,iostat=err) blr_struc%NB_PANELS
1737 if(err.ne.0) THEN
1738 info(1) = -75
1739 CALL mumps_seti8toi4(total_file_size-size_read
1740 & ,info(2))
1741 endif
1742 IF (info(1) .LT. 0 ) GOTO 100
1743 endif
1744 CASE("PANELS_L")
1745 if(trim(mode).EQ."memory_save") then
1746 IF(associated(blr_struc%PANELS_L)) THEN
1747 nbrecords_blr_struc_t(i1)=1
1748 size_gest_blr_struc_t(i1)=size_int
1749 size_variables_blr_struc_t(i1)=0
1750 DO j1=1,size(blr_struc%PANELS_L,1)
1751 CALL dmumps_save_restore_blr_panel(
1752 & blr_struc%PANELS_L(j1)
1753 & ,unit,myid,"memory_save"
1754 & ,size_gest_panels_l_j1
1755 & ,size_variables_panels_l_j1
1756 & ,size_int, size_arith_dep, size_logical
1757 & ,total_file_size,total_struc_size
1758 & ,size_read,size_allocated,size_written
1759 & ,info)
1760 size_gest_panels_l=size_gest_panels_l+
1761 & size_gest_panels_l_j1
1762 size_variables_panels_l=size_variables_panels_l+
1763 & size_variables_panels_l_j1
1764 ENDDO
1765 ELSE
1766 nbrecords_blr_struc_t(i1)=2
1767 size_gest_blr_struc_t(i1)=size_int*2
1768 size_variables_blr_struc_t(i1)=0
1769 ENDIF
1770 elseif(trim(mode).EQ."save") then
1771 IF(associated(blr_struc%PANELS_L)) THEN
1772 nbrecords_blr_struc_t(i1)=1
1773 size_gest_blr_struc_t(i1)=size_int
1774 size_variables_blr_struc_t(i1)=0
1775 write(unit,iostat=err)
1776 & size(blr_struc%PANELS_L,1)
1777 if(err.ne.0) then
1778 info(1) = -72
1779 CALL mumps_seti8toi4(total_file_size-size_written,
1780 & info(2))
1781 endif
1782 DO j1=1,size(blr_struc%PANELS_L,1)
1783 CALL dmumps_save_restore_blr_panel(
1784 & blr_struc%PANELS_L(j1)
1785 & ,unit,myid,"save"
1786 & ,size_gest_panels_l_j1
1787 & ,size_variables_panels_l_j1
1788 & ,size_int, size_arith_dep, size_logical
1789 & ,total_file_size,total_struc_size
1790 & ,size_read,size_allocated,size_written
1791 & ,info)
1792 IF ( info(1) .LT. 0 ) GOTO 100
1793 ENDDO
1794 ELSE
1795 nbrecords_blr_struc_t(i1)=2
1796 size_gest_blr_struc_t(i1)=size_int*2
1797 size_variables_blr_struc_t(i1)=0
1798 write(unit,iostat=err) -999
1799 if(err.ne.0) then
1800 info(1) = -72
1801 CALL mumps_seti8toi4(total_file_size-size_written,
1802 & info(2))
1803 endif
1804 IF ( info(1) .LT. 0 ) GOTO 100
1805 write(unit,iostat=err) -999
1806 if(err.ne.0) then
1807 info(1) = -72
1808 CALL mumps_seti8toi4(total_file_size-size_written,
1809 & info(2))
1810 endif
1811 IF ( info(1) .LT. 0 ) GOTO 100
1812 ENDIF
1813 elseif(trim(mode).EQ."restore") then
1814 nullify(blr_struc%PANELS_L)
1815 read(unit,iostat=err) size_array1
1816 if(err.ne.0) THEN
1817 info(1) = -75
1818 CALL mumps_seti8toi4(total_file_size-size_read
1819 & ,info(2))
1820 endif
1821 IF ( info(1) .LT. 0 ) GOTO 100
1822 if(size_array1.EQ.-999) then
1823 nbrecords_blr_struc_t(i1)=2
1824 size_gest_blr_struc_t(i1)=size_int*2
1825 size_variables_blr_struc_t(i1)=0
1826 read(unit,iostat=err) dummy
1827 if(err.ne.0) THEN
1828 info(1) = -75
1829 CALL mumps_seti8toi4(total_file_size-size_read
1830 & ,info(2))
1831 endif
1832 IF ( info(1) .LT. 0 ) GOTO 100
1833 else
1834 nbrecords_blr_struc_t(i1)=1
1835 size_gest_blr_struc_t(i1)=size_int
1836 size_variables_blr_struc_t(i1)=0
1837 allocate(blr_struc%PANELS_L(size_array1)
1838 & , stat=allocok)
1839 if (allocok .GT. 0) THEN
1840 info(1) = -78
1841 CALL mumps_seti8toi4(
1842 & total_struc_size-size_allocated
1843 & ,info(2))
1844 endif
1845 DO j1=1,size_array1
1846 CALL dmumps_save_restore_blr_panel(
1847 & blr_struc%PANELS_L(j1)
1848 & ,unit,myid,"restore"
1849 & ,size_gest_panels_l_j1
1850 & ,size_variables_panels_l_j1
1851 & ,size_int, size_arith_dep, size_logical
1852 & ,total_file_size,total_struc_size
1853 & ,size_read,size_allocated,size_written
1854 & ,info)
1855 size_gest_panels_l=size_gest_panels_l+
1856 & size_gest_panels_l_j1
1857 size_variables_panels_l=size_variables_panels_l+
1858 & size_variables_panels_l_j1
1859 ENDDO
1860 endif
1861 endif
1862 CASE("PANELS_U")
1863 if(trim(mode).EQ."memory_save") then
1864 IF(associated(blr_struc%PANELS_U)) THEN
1865 nbrecords_blr_struc_t(i1)=1
1866 size_gest_blr_struc_t(i1)=size_int
1867 size_variables_blr_struc_t(i1)=0
1868 DO j1=1,size(blr_struc%PANELS_U,1)
1869 CALL dmumps_save_restore_blr_panel(
1870 & blr_struc%PANELS_U(j1)
1871 & ,unit,myid,"memory_save"
1872 & ,size_gest_panels_u_j1
1873 & ,size_variables_panels_u_j1
1874 & ,size_int, size_arith_dep, size_logical
1875 & ,total_file_size,total_struc_size
1876 & ,size_read,size_allocated,size_written
1877 & ,info)
1878 size_gest_panels_u=size_gest_panels_u+
1879 & size_gest_panels_u_j1
1880 size_variables_panels_u=size_variables_panels_u+
1881 & size_variables_panels_u_j1
1882 ENDDO
1883 ELSE
1884 nbrecords_blr_struc_t(i1)=2
1885 size_gest_blr_struc_t(i1)=size_int*2
1886 size_variables_blr_struc_t(i1)=0
1887 ENDIF
1888 elseif(trim(mode).EQ."save") then
1889 IF(associated(blr_struc%PANELS_U)) THEN
1890 nbrecords_blr_struc_t(i1)=1
1891 size_gest_blr_struc_t(i1)=size_int
1892 size_variables_blr_struc_t(i1)=0
1893 write(unit,iostat=err)
1894 & size(blr_struc%PANELS_U,1)
1895 if(err.ne.0) then
1896 info(1) = -72
1897 CALL mumps_seti8toi4(total_file_size-size_written,
1898 & info(2))
1899 endif
1900 DO j1=1,size(blr_struc%PANELS_U,1)
1901 CALL dmumps_save_restore_blr_panel(
1902 & blr_struc%PANELS_U(j1)
1903 & ,unit,myid,"save"
1904 & ,size_gest_panels_u_j1
1905 & ,size_variables_panels_u_j1
1906 & ,size_int, size_arith_dep, size_logical
1907 & ,total_file_size,total_struc_size
1908 & ,size_read,size_allocated,size_written
1909 & ,info)
1910 IF ( info(1) .LT. 0 ) GOTO 100
1911 ENDDO
1912 ELSE
1913 nbrecords_blr_struc_t(i1)=2
1914 size_gest_blr_struc_t(i1)=size_int*2
1915 size_variables_blr_struc_t(i1)=0
1916 write(unit,iostat=err) -999
1917 if(err.ne.0) then
1918 info(1) = -72
1919 CALL mumps_seti8toi4(total_file_size-size_written,
1920 & info(2))
1921 endif
1922 IF ( info(1) .LT. 0 ) GOTO 100
1923 write(unit,iostat=err) -999
1924 if(err.ne.0) then
1925 info(1) = -72
1926 CALL mumps_seti8toi4(total_file_size-size_written,
1927 & info(2))
1928 endif
1929 IF ( info(1) .LT. 0 ) GOTO 100
1930 ENDIF
1931 elseif(trim(mode).EQ."restore") then
1932 nullify(blr_struc%PANELS_U)
1933 read(unit,iostat=err) size_array1
1934 if(err.ne.0) THEN
1935 info(1) = -75
1936 CALL mumps_seti8toi4(total_file_size-size_read
1937 & ,info(2))
1938 endif
1939 IF ( info(1) .LT. 0 ) GOTO 100
1940 if(size_array1.EQ.-999) then
1941 nbrecords_blr_struc_t(i1)=2
1942 size_gest_blr_struc_t(i1)=size_int*2
1943 size_variables_blr_struc_t(i1)=0
1944 read(unit,iostat=err) dummy
1945 if(err.ne.0) THEN
1946 info(1) = -75
1947 CALL mumps_seti8toi4(total_file_size-size_read
1948 & ,info(2))
1949 endif
1950 IF ( info(1) .LT. 0 ) GOTO 100
1951 else
1952 nbrecords_blr_struc_t(i1)=1
1953 size_gest_blr_struc_t(i1)=size_int
1954 size_variables_blr_struc_t(i1)=0
1955 allocate(blr_struc%PANELS_U(size_array1)
1956 & , stat=allocok)
1957 if (allocok .GT. 0) THEN
1958 info(1) = -78
1959 CALL mumps_seti8toi4(
1960 & total_struc_size-size_allocated
1961 & ,info(2))
1962 endif
1963 DO j1=1,size_array1
1964 CALL dmumps_save_restore_blr_panel(
1965 & blr_struc%PANELS_U(j1)
1966 & ,unit,myid,"restore"
1967 & ,size_gest_panels_u_j1
1968 & ,size_variables_panels_u_j1
1969 & ,size_int, size_arith_dep, size_logical
1970 & ,total_file_size,total_struc_size
1971 & ,size_read,size_allocated,size_written
1972 & ,info)
1973 size_gest_panels_u=size_gest_panels_u+
1974 & size_gest_panels_u_j1
1975 size_variables_panels_u=size_variables_panels_u+
1976 & size_variables_panels_u_j1
1977 ENDDO
1978 endif
1979 endif
1980 CASE("CB_LRB")
1981 if(trim(mode).EQ."memory_save") then
1982 IF(associated(blr_struc%CB_LRB)) THEN
1983 nbrecords_blr_struc_t(i1)=1
1984 size_gest_blr_struc_t(i1)=size_int*2
1985 size_variables_blr_struc_t(i1)=0
1986 DO j1=1,size(blr_struc%CB_LRB,1)
1987 DO j2=1,size(blr_struc%CB_LRB,2)
1988 CALL dmumps_save_restore_lrb(
1989 & blr_struc%CB_LRB(j1,j2)
1990 & ,unit,myid,"memory_save"
1991 & ,size_gest_cb_lrb_j1j2
1992 & ,size_variables_cb_lrb_j1j2
1993 & ,size_int, size_arith_dep, size_logical
1994 & ,total_file_size,total_struc_size
1995 & ,size_read,size_allocated,size_written
1996 & ,info)
1997 size_gest_cb_lrb=size_gest_cb_lrb+
1998 & size_gest_cb_lrb_j1j2
1999 size_variables_cb_lrb=size_variables_cb_lrb+
2000 & size_variables_cb_lrb_j1j2
2001 ENDDO
2002 ENDDO
2003 ELSE
2004 nbrecords_blr_struc_t(i1)=2
2005 size_gest_blr_struc_t(i1)=size_int*3
2006 size_variables_blr_struc_t(i1)=0
2007 ENDIF
2008 elseif(trim(mode).EQ."save") then
2009 IF(associated(blr_struc%CB_LRB)) THEN
2010 nbrecords_blr_struc_t(i1)=1
2011 size_gest_blr_struc_t(i1)=size_int*2
2012 size_variables_blr_struc_t(i1)=0
2013 write(unit,iostat=err)
2014 & size(blr_struc%CB_LRB,1),size(blr_struc%CB_LRB,2)
2015 if(err.ne.0) then
2016 info(1) = -72
2017 CALL mumps_seti8toi4(total_file_size-size_written,
2018 & info(2))
2019 endif
2020 DO j1=1,size(blr_struc%CB_LRB,1)
2021 DO j2=1,size(blr_struc%CB_LRB,2)
2022 CALL dmumps_save_restore_lrb(
2023 & blr_struc%CB_LRB(j1,j2)
2024 & ,unit,myid,"save"
2025 & ,size_gest_cb_lrb_j1j2
2026 & ,size_variables_cb_lrb_j1j2
2027 & ,size_int, size_arith_dep, size_logical
2028 & ,total_file_size,total_struc_size
2029 & ,size_read,size_allocated,size_written
2030 & ,info)
2031 IF ( info(1) .LT. 0 ) GOTO 100
2032 ENDDO
2033 ENDDO
2034 ELSE
2035 nbrecords_blr_struc_t(i1)=2
2036 size_gest_blr_struc_t(i1)=size_int*3
2037 size_variables_blr_struc_t(i1)=0
2038 write(unit,iostat=err) -999,-998
2039 if(err.ne.0) then
2040 info(1) = -72
2041 CALL mumps_seti8toi4(total_file_size-size_written,
2042 & info(2))
2043 endif
2044 IF ( info(1) .LT. 0 ) GOTO 100
2045 write(unit,iostat=err) -999
2046 if(err.ne.0) then
2047 info(1) = -72
2048 CALL mumps_seti8toi4(total_file_size-size_written,
2049 & info(2))
2050 endif
2051 IF ( info(1) .LT. 0 ) GOTO 100
2052 ENDIF
2053 elseif(trim(mode).EQ."restore") then
2054 nullify(blr_struc%CB_LRB)
2055 read(unit,iostat=err) size_array1,size_array2
2056 if(err.ne.0) THEN
2057 info(1) = -75
2058 CALL mumps_seti8toi4(total_file_size-size_read
2059 & ,info(2))
2060 endif
2061 IF ( info(1) .LT. 0 ) GOTO 100
2062 if(size_array1.EQ.-999) then
2063 nbrecords_blr_struc_t(i1)=2
2064 size_gest_blr_struc_t(i1)=size_int*3
2065 size_variables_blr_struc_t(i1)=0
2066 read(unit,iostat=err) dummy
2067 if(err.ne.0) THEN
2068 info(1) = -75
2069 CALL mumps_seti8toi4(total_file_size-size_read
2070 & ,info(2))
2071 endif
2072 IF ( info(1) .LT. 0 ) GOTO 100
2073 else
2074 nbrecords_blr_struc_t(i1)=1
2075 size_gest_blr_struc_t(i1)=size_int*2
2076 size_variables_blr_struc_t(i1)=0
2077 allocate(blr_struc%CB_LRB(size_array1,size_array2)
2078 & , stat=allocok)
2079 if (allocok .GT. 0) THEN
2080 info(1) = -78
2081 CALL mumps_seti8toi4(
2082 & total_struc_size-size_allocated
2083 & ,info(2))
2084 endif
2085 DO j1=1,size_array1
2086 DO j2=1,size_array2
2087 CALL dmumps_save_restore_lrb(
2088 & blr_struc%CB_LRB(j1,j2)
2089 & ,unit,myid,"restore"
2090 & ,size_gest_cb_lrb_j1j2
2091 & ,size_variables_cb_lrb_j1j2
2092 & ,size_int, size_arith_dep, size_logical
2093 & ,total_file_size,total_struc_size
2094 & ,size_read,size_allocated,size_written
2095 & ,info)
2096 size_gest_cb_lrb=size_gest_cb_lrb+
2097 & size_gest_cb_lrb_j1j2
2098 size_variables_cb_lrb=size_variables_cb_lrb+
2099 & size_variables_cb_lrb_j1j2
2100 ENDDO
2101 ENDDO
2102 endif
2103 endif
2104 CASE("DIAG_BLOCKS")
2105 if(trim(mode).EQ."memory_save") then
2106 IF(associated(blr_struc%DIAG_BLOCKS)) THEN
2107 nbrecords_blr_struc_t(i1)=1
2108 size_gest_blr_struc_t(i1)=size_int
2109 size_variables_blr_struc_t(i1)=0
2110 DO j1=1,size(blr_struc%DIAG_BLOCKS,1)
2111 CALL dmumps_save_restore_diag_block(
2112 & blr_struc%DIAG_BLOCKS(j1)
2113 & ,unit,myid,"memory_save"
2114 & ,size_gest_diag_blocks_j1
2115 & ,size_variables_diag_blocks_j1
2116 & ,size_int, size_arith_dep
2117 & ,total_file_size,total_struc_size
2118 & ,size_read,size_allocated,size_written
2119 & ,info)
2120 size_gest_diag_blocks=size_gest_diag_blocks+
2121 & size_gest_diag_blocks_j1
2122 size_variables_diag_blocks=
2123 & size_variables_diag_blocks+
2124 & size_variables_diag_blocks_j1
2125 ENDDO
2126 ELSE
2127 nbrecords_blr_struc_t(i1)=2
2128 size_gest_blr_struc_t(i1)=size_int*2
2129 size_variables_blr_struc_t(i1)=0
2130 ENDIF
2131 elseif(trim(mode).EQ."save") then
2132 IF(associated(blr_struc%DIAG_BLOCKS)) THEN
2133 nbrecords_blr_struc_t(i1)=1
2134 size_gest_blr_struc_t(i1)=size_int
2135 size_variables_blr_struc_t(i1)=0
2136 write(unit,iostat=err)
2137 & size(blr_struc%DIAG_BLOCKS,1)
2138 if(err.ne.0) then
2139 info(1) = -72
2140 CALL mumps_seti8toi4(total_file_size-size_written,
2141 & info(2))
2142 endif
2143 DO j1=1,size(blr_struc%DIAG_BLOCKS,1)
2144 CALL dmumps_save_restore_diag_block(
2145 & blr_struc%DIAG_BLOCKS(j1)
2146 & ,unit,myid,"save"
2147 & ,size_gest_diag_blocks_j1
2148 & ,size_variables_diag_blocks_j1
2149 & ,size_int, size_arith_dep
2150 & ,total_file_size,total_struc_size
2151 & ,size_read,size_allocated,size_written
2152 & ,info)
2153 IF ( info(1) .LT. 0 ) GOTO 100
2154 ENDDO
2155 ELSE
2156 nbrecords_blr_struc_t(i1)=2
2157 size_gest_blr_struc_t(i1)=size_int*2
2158 size_variables_blr_struc_t(i1)=0
2159 write(unit,iostat=err) -999
2160 if(err.ne.0) then
2161 info(1) = -72
2162 CALL mumps_seti8toi4(total_file_size-size_written,
2163 & info(2))
2164 endif
2165 IF ( info(1) .LT. 0 ) GOTO 100
2166 write(unit,iostat=err) -999
2167 if(err.ne.0) then
2168 info(1) = -72
2169 CALL mumps_seti8toi4(total_file_size-size_written,
2170 & info(2))
2171 endif
2172 IF ( info(1) .LT. 0 ) GOTO 100
2173 ENDIF
2174 elseif(trim(mode).EQ."restore") then
2175 nullify(blr_struc%DIAG_BLOCKS)
2176 read(unit,iostat=err) size_array1
2177 if(err.ne.0) THEN
2178 info(1) = -75
2179 CALL mumps_seti8toi4(total_file_size-size_read
2180 & ,info(2))
2181 endif
2182 IF ( info(1) .LT. 0 ) GOTO 100
2183 if(size_array1.EQ.-999) then
2184 nbrecords_blr_struc_t(i1)=2
2185 size_gest_blr_struc_t(i1)=size_int*2
2186 size_variables_blr_struc_t(i1)=0
2187 read(unit,iostat=err) dummy
2188 if(err.ne.0) THEN
2189 info(1) = -75
2190 CALL mumps_seti8toi4(total_file_size-size_read
2191 & ,info(2))
2192 endif
2193 IF ( info(1) .LT. 0 ) GOTO 100
2194 else
2195 nbrecords_blr_struc_t(i1)=1
2196 size_gest_blr_struc_t(i1)=size_int
2197 size_variables_blr_struc_t(i1)=0
2198 allocate(blr_struc%DIAG_BLOCKS(size_array1)
2199 & , stat=allocok)
2200 if (allocok .GT. 0) THEN
2201 info(1) = -78
2202 CALL mumps_seti8toi4(
2203 & total_struc_size-size_allocated
2204 & ,info(2))
2205 endif
2206 DO j1=1,size_array1
2207 CALL dmumps_save_restore_diag_block(
2208 & blr_struc%DIAG_BLOCKS(j1)
2209 & ,unit,myid,"restore"
2210 & ,size_gest_diag_blocks_j1
2211 & ,size_variables_diag_blocks_j1
2212 & ,size_int, size_arith_dep
2213 & ,total_file_size,total_struc_size
2214 & ,size_read,size_allocated,size_written
2215 & ,info)
2216 size_gest_diag_blocks=size_gest_diag_blocks+
2217 & size_gest_diag_blocks_j1
2218 size_variables_diag_blocks=
2219 & size_variables_diag_blocks+
2220 & size_variables_diag_blocks_j1
2221 ENDDO
2222 endif
2223 endif
2224 CASE("NFS4FATHER")
2225 nbrecords_blr_struc_t(i1)=1
2226 if(trim(mode).EQ."memory_save") then
2227 size_variables_blr_struc_t(i1)=size_int
2228 elseif(trim(mode).EQ."save") then
2229 size_variables_blr_struc_t(i1)=size_int
2230 write(unit,iostat=err) blr_struc%NFS4FATHER
2231 if(err.ne.0) then
2232 info(1) = -72
2233 CALL mumps_seti8toi4(total_file_size-size_written,
2234 & info(2))
2235 endif
2236 IF ( info(1) .LT. 0 ) GOTO 100
2237 elseif(trim(mode).EQ."restore") then
2238 size_variables_blr_struc_t(i1)=size_int
2239 read(unit,iostat=err) blr_struc%NFS4FATHER
2240 if(err.ne.0) THEN
2241 info(1) = -75
2242 CALL mumps_seti8toi4(total_file_size-size_read
2243 & ,info(2))
2244 endif
2245 IF (info(1) .LT. 0 ) GOTO 100
2246 endif
2247 CASE("M_ARRAY")
2248 if(trim(mode).EQ."restore") then
2249 nullify(blr_struc%M_ARRAY)
2250 endif
2251 CASE DEFAULT
2252 END SELECT
2253 if(trim(mode).EQ."memory_save") then
2254 nbsubrecords=int(size_variables_blr_struc_t(i1)/huge(i4))
2255 IF(nbsubrecords.GT.0) then
2256 nbrecords_blr_struc_t(i1)=nbrecords_blr_struc_t(i1)
2257 & +nbsubrecords
2258 ENDIF
2259 elseif(trim(mode).EQ."save") then
2260 size_written=size_written+size_variables_blr_struc_t(i1)
2261 & +int(size_gest_blr_struc_t(i1),kind=8)
2262#if !defined(MUMPS_F2003)
2263 size_written=size_written
2264 & +int(2*size_int*nbrecords_blr_struc_t(i1),kind=8)
2265#endif
2266 elseif(trim(mode).EQ."restore") then
2267 size_allocated=size_allocated+
2268 & size_variables_blr_struc_t(i1)
2269 size_read=size_read+size_variables_blr_struc_t(i1)
2270 & +int(size_gest_blr_struc_t(i1),kind=8)
2271#if !defined(MUMPS_F2003)
2272 size_read=size_read
2273 & +int(2*size_int*nbrecords_blr_struc_t(i1),kind=8)
2274#endif
2275 endif
2276 ENDDO
2277 if(trim(mode).EQ."memory_save") then
2278 local_size_variables=sum(size_variables_blr_struc_t)
2279 & +size_variables_panels_l
2280 & +size_variables_panels_u
2281 & +size_variables_cb_lrb
2282 & +size_variables_diag_blocks
2283 local_size_gest=sum(size_gest_blr_struc_t)
2284 & +size_gest_panels_l
2285 & +size_gest_panels_u
2286 & +size_gest_cb_lrb
2287 & +size_gest_diag_blocks
2288#if !defined(MUMPS_F2003)
2289 local_nbrecords=sum(nbrecords_blr_struc_t)
2290 local_size_gest=local_size_gest+2*size_int*local_nbrecords
2291#endif
2292 endif
2293 100 continue
2294 RETURN
2295 END SUBROUTINE dmumps_save_restore_blr_struc
2296 SUBROUTINE dmumps_save_restore_lrb(LRB_T
2297 & ,unit,MYID,mode
2298 & ,Local_SIZE_GEST,Local_SIZE_VARIABLES
2299 & ,SIZE_INT, SIZE_ARITH_DEP, SIZE_LOGICAL
2300 & ,TOTAL_FILE_SIZE,TOTAL_STRUC_SIZE
2301 & ,size_read,size_allocated,size_written
2302 & ,INFO)
2303 include 'mpif.h'
2304 TYPE(lrb_type) :: LRB_T
2305 INTEGER,intent(IN)::unit,MYID
2306 CHARACTER(len=*),intent(IN) :: mode
2307 INTEGER,INTENT(OUT) :: Local_SIZE_GEST
2308 INTEGER(8),intent(OUT) :: Local_SIZE_VARIABLES
2309 INTEGER,intent(INOUT):: INFO(2)
2310 INTEGER,intent(IN):: SIZE_INT, SIZE_ARITH_DEP, SIZE_LOGICAL
2311 INTEGER(8),intent(IN) :: TOTAL_FILE_SIZE,TOTAL_STRUC_SIZE
2312 INTEGER(8),intent(INOUT):: size_read,size_allocated,size_written
2313 INTEGER :: NBVARIABLES_LRB_TYPE
2314 parameter(nbvariables_lrb_type = 6)
2315 CHARACTER(len=30), dimension(NBVARIABLES_LRB_TYPE)::
2316 & variables_lrb_type
2317 CHARACTER(len=30) :: TMP_STRING
2318 INTEGER(8),dimension(NBVARIABLES_LRB_TYPE)::
2319 & SIZE_VARIABLES_LRB_TYPE
2320 INTEGER,dimension(NBVARIABLES_LRB_TYPE)::
2321 & SIZE_GEST_LRB_TYPE
2322 INTEGER,dimension(NBVARIABLES_LRB_TYPE)::
2323 & NbRecords_LRB_TYPE
2324 INTEGER:: size_array1,size_array2,dummy,allocok
2325 INTEGER:: err,i1,NbSubRecords,Local_NbRecords
2326 INTEGER(4) ::I4
2327 variables_lrb_type(1)="Q"
2328 variables_lrb_type(2)="R"
2329 variables_lrb_type(3)="K"
2330 variables_lrb_type(4)="M"
2331 variables_lrb_type(5)="N"
2332 variables_lrb_type(6)="ISLR"
2333 size_variables_lrb_type(:)=0_8
2334 size_gest_lrb_type(:)=0
2335 nbrecords_lrb_type(:)=0
2336 DO i1=1,nbvariables_lrb_type
2337 tmp_string = variables_lrb_type(i1)
2338 SELECT CASE(tmp_string)
2339 CASE("Q")
2340 nbrecords_lrb_type(i1)=2
2341 if(trim(mode).EQ."memory_save") then
2342 IF(associated(lrb_t%Q)) THEN
2343 size_gest_lrb_type(i1)=size_int*2
2344 size_variables_lrb_type(i1)=
2345 & size(lrb_t%Q,1)*size(lrb_t%Q,2)
2346 & * size_arith_dep
2347 ELSE
2348 size_gest_lrb_type(i1)=size_int*3
2349 size_variables_lrb_type(i1)=0
2350 ENDIF
2351 elseif(trim(mode).EQ."save") then
2352 IF(associated(lrb_t%Q)) THEN
2353 size_gest_lrb_type(i1)=size_int*2
2354 size_variables_lrb_type(i1)=
2355 & size(lrb_t%Q,1)*size(lrb_t%Q,2)
2356 & * size_arith_dep
2357 write(unit,iostat=err) size(lrb_t%Q,1),size(lrb_t%Q,2)
2358 if(err.ne.0) then
2359 info(1) = -72
2360 CALL mumps_seti8toi4(total_file_size-size_written,
2361 & info(2))
2362 endif
2363 IF ( info(1) .LT. 0 ) GOTO 300
2364 write(unit,iostat=err) lrb_t%Q
2365 ELSE
2366 size_gest_lrb_type(i1)=size_int*3
2367 size_variables_lrb_type(i1)=0
2368 write(unit,iostat=err) -999,-998
2369 if(err.ne.0) then
2370 info(1) = -72
2371 CALL mumps_seti8toi4(total_file_size-size_written,
2372 & info(2))
2373 endif
2374 IF ( info(1) .LT. 0 ) GOTO 300
2375 write(unit,iostat=err) -999
2376 ENDIF
2377 if(err.ne.0) then
2378 info(1) = -72
2379 CALL mumps_seti8toi4(total_file_size-size_written,
2380 & info(2))
2381 endif
2382 IF ( info(1) .LT. 0 ) GOTO 300
2383 elseif(trim(mode).EQ."restore") then
2384 nullify(lrb_t%Q)
2385 read(unit,iostat=err) size_array1,size_array2
2386 if(err.ne.0) THEN
2387 info(1) = -75
2388 CALL mumps_seti8toi4(total_file_size-size_read
2389 & ,info(2))
2390 endif
2391 IF ( info(1) .LT. 0 ) GOTO 300
2392 if(size_array1.EQ.-999) then
2393 size_gest_lrb_type(i1)=size_int*3
2394 size_variables_lrb_type(i1)=0
2395 read(unit,iostat=err) dummy
2396 else
2397 size_gest_lrb_type(i1)=size_int*2
2398 size_variables_lrb_type(i1)=
2399 & size_array1*size_array2*size_arith_dep
2400 allocate(lrb_t%Q(size_array1,size_array2),
2401 & stat=allocok)
2402 if (allocok .GT. 0) THEN
2403 info(1) = -78
2404 CALL mumps_seti8toi4(
2405 & total_struc_size-size_allocated
2406 & ,info(2))
2407 endif
2408 read(unit,iostat=err) lrb_t%Q
2409 endif
2410 IF ( info(1) .LT. 0 ) GOTO 300
2411 if(err.ne.0) THEN
2412 info(1) = -75
2413 CALL mumps_seti8toi4(total_file_size-size_read
2414 & ,info(2))
2415 endif
2416 IF ( info(1) .LT. 0 ) GOTO 300
2417 endif
2418 CASE("R")
2419 nbrecords_lrb_type(i1)=2
2420 if(trim(mode).EQ."memory_save") then
2421 IF(associated(lrb_t%R)) THEN
2422 size_gest_lrb_type(i1)=size_int*2
2423 size_variables_lrb_type(i1)=
2424 & size(lrb_t%R,1)*size(lrb_t%R,2)
2425 & * size_arith_dep
2426 ELSE
2427 size_gest_lrb_type(i1)=size_int*3
2428 size_variables_lrb_type(i1)=0
2429 ENDIF
2430 elseif(trim(mode).EQ."save") then
2431 IF(associated(lrb_t%R)) THEN
2432 size_gest_lrb_type(i1)=size_int*2
2433 size_variables_lrb_type(i1)=
2434 & size(lrb_t%R,1)*size(lrb_t%R,2)
2435 & * size_arith_dep
2436 write(unit,iostat=err) size(lrb_t%R,1),size(lrb_t%R,2)
2437 if(err.ne.0) then
2438 info(1) = -72
2439 CALL mumps_seti8toi4(total_file_size-size_written,
2440 & info(2))
2441 endif
2442 IF ( info(1) .LT. 0 ) GOTO 300
2443 write(unit,iostat=err) lrb_t%R
2444 ELSE
2445 size_gest_lrb_type(i1)=size_int*3
2446 size_variables_lrb_type(i1)=0
2447 write(unit,iostat=err) -999,-998
2448 if(err.ne.0) then
2449 info(1) = -72
2450 CALL mumps_seti8toi4(total_file_size-size_written,
2451 & info(2))
2452 endif
2453 IF ( info(1) .LT. 0 ) GOTO 300
2454 write(unit,iostat=err) -999
2455 ENDIF
2456 if(err.ne.0) then
2457 info(1) = -72
2458 CALL mumps_seti8toi4(total_file_size-size_written,
2459 & info(2))
2460 endif
2461 IF ( info(1) .LT. 0 ) GOTO 300
2462 elseif(trim(mode).EQ."restore") then
2463 nullify(lrb_t%R)
2464 read(unit,iostat=err) size_array1,size_array2
2465 if(err.ne.0) THEN
2466 info(1) = -75
2467 CALL mumps_seti8toi4(total_file_size-size_read
2468 & ,info(2))
2469 endif
2470 IF ( info(1) .LT. 0 ) GOTO 300
2471 if(size_array1.EQ.-999) then
2472 size_gest_lrb_type(i1)=size_int*3
2473 size_variables_lrb_type(i1)=0
2474 read(unit,iostat=err) dummy
2475 else
2476 size_gest_lrb_type(i1)=size_int*2
2477 size_variables_lrb_type(i1)=
2478 & size_array1*size_array2*size_arith_dep
2479 allocate(lrb_t%R(size_array1,size_array2),
2480 & stat=allocok)
2481 if (allocok .GT. 0) THEN
2482 info(1) = -78
2483 CALL mumps_seti8toi4(
2484 & total_struc_size-size_allocated
2485 & ,info(2))
2486 endif
2487 read(unit,iostat=err) lrb_t%R
2488 endif
2489 IF ( info(1) .LT. 0 ) GOTO 300
2490 if(err.ne.0) THEN
2491 info(1) = -75
2492 CALL mumps_seti8toi4(total_file_size-size_read
2493 & ,info(2))
2494 endif
2495 IF ( info(1) .LT. 0 ) GOTO 300
2496 endif
2497 CASE("K")
2498 nbrecords_lrb_type(i1)=1
2499 if(trim(mode).EQ."memory_save") then
2500 size_variables_lrb_type(i1)=size_int
2501 elseif(trim(mode).EQ."save") then
2502 size_variables_lrb_type(i1)=size_int
2503 write(unit,iostat=err) lrb_t%K
2504 if(err.ne.0) then
2505 info(1) = -72
2506 CALL mumps_seti8toi4(total_file_size-size_written,
2507 & info(2))
2508 endif
2509 IF ( info(1) .LT. 0 ) GOTO 300
2510 elseif(trim(mode).EQ."restore") then
2511 size_variables_lrb_type(i1)=size_int
2512 read(unit,iostat=err) lrb_t%K
2513 if(err.ne.0) THEN
2514 info(1) = -75
2515 CALL mumps_seti8toi4(total_file_size-size_read
2516 & ,info(2))
2517 endif
2518 IF ( info(1) .LT. 0 ) GOTO 300
2519 endif
2520 CASE("M")
2521 nbrecords_lrb_type(i1)=1
2522 if(trim(mode).EQ."memory_save") then
2523 size_variables_lrb_type(i1)=size_int
2524 elseif(trim(mode).EQ."save") then
2525 size_variables_lrb_type(i1)=size_int
2526 write(unit,iostat=err) lrb_t%M
2527 if(err.ne.0) then
2528 info(1) = -72
2529 CALL mumps_seti8toi4(total_file_size-size_written,
2530 & info(2))
2531 endif
2532 IF ( info(1) .LT. 0 ) GOTO 300
2533 elseif(trim(mode).EQ."restore") then
2534 size_variables_lrb_type(i1)=size_int
2535 read(unit,iostat=err) lrb_t%M
2536 if(err.ne.0) THEN
2537 info(1) = -75
2538 CALL mumps_seti8toi4(total_file_size-size_read
2539 & ,info(2))
2540 endif
2541 IF ( info(1) .LT. 0 ) GOTO 300
2542 endif
2543 CASE("N")
2544 nbrecords_lrb_type(i1)=1
2545 if(trim(mode).EQ."memory_save") then
2546 size_variables_lrb_type(i1)=size_int
2547 elseif(trim(mode).EQ."save") then
2548 size_variables_lrb_type(i1)=size_int
2549 write(unit,iostat=err) lrb_t%N
2550 if(err.ne.0) then
2551 info(1) = -72
2552 CALL mumps_seti8toi4(total_file_size-size_written,
2553 & info(2))
2554 endif
2555 IF ( info(1) .LT. 0 ) GOTO 300
2556 elseif(trim(mode).EQ."restore") then
2557 size_variables_lrb_type(i1)=size_int
2558 read(unit,iostat=err) lrb_t%N
2559 if(err.ne.0) THEN
2560 info(1) = -75
2561 CALL mumps_seti8toi4(total_file_size-size_read
2562 & ,info(2))
2563 endif
2564 IF ( info(1) .LT. 0 ) GOTO 300
2565 endif
2566 CASE("ISLR")
2567 nbrecords_lrb_type(i1)=1
2568 if(trim(mode).EQ."memory_save") then
2569 size_variables_lrb_type(i1)=size_logical
2570 elseif(trim(mode).EQ."save") then
2571 size_variables_lrb_type(i1)=size_logical
2572 write(unit,iostat=err) lrb_t%ISLR
2573 if(err.ne.0) then
2574 info(1) = -72
2575 CALL mumps_seti8toi4(total_file_size-size_written,
2576 & info(2))
2577 endif
2578 IF ( info(1) .LT. 0 ) GOTO 300
2579 elseif(trim(mode).EQ."restore") then
2580 size_variables_lrb_type(i1)=size_logical
2581 read(unit,iostat=err) lrb_t%ISLR
2582 if(err.ne.0) THEN
2583 info(1) = -75
2584 CALL mumps_seti8toi4(total_file_size-size_read
2585 & ,info(2))
2586 endif
2587 IF ( info(1) .LT. 0 ) GOTO 300
2588 endif
2589 CASE DEFAULT
2590 END SELECT
2591 if(trim(mode).EQ."memory_save") then
2592 nbsubrecords=int(size_variables_lrb_type(i1)/huge(i4))
2593 IF(nbsubrecords.GT.0) then
2594 nbrecords_lrb_type(i1)=
2595 & nbrecords_lrb_type(i1)
2596 & +nbsubrecords
2597 ENDIF
2598 elseif(trim(mode).EQ."save") then
2599 size_written=size_written+size_variables_lrb_type(i1)
2600 & +int(size_gest_lrb_type(i1),kind=8)
2601#if !defined(MUMPS_F2003)
2602 size_written=size_written
2603 & +int(2*size_int*nbrecords_lrb_type(i1),kind=8)
2604#endif
2605 elseif(trim(mode).EQ."restore") then
2606 size_allocated=size_allocated+
2607 & size_variables_lrb_type(i1)
2608 size_read=size_read+size_variables_lrb_type(i1)
2609 & +int(size_gest_lrb_type(i1),kind=8)
2610#if !defined(MUMPS_F2003)
2611 size_read=size_read
2612 & +int(2*size_int*nbrecords_lrb_type(i1),kind=8)
2613#endif
2614 endif
2615 ENDDO
2616 if(trim(mode).EQ."memory_save") then
2617 local_size_variables=sum(size_variables_lrb_type)
2618 local_size_gest=sum(size_gest_lrb_type)
2619#if !defined(MUMPS_F2003)
2620 local_nbrecords=sum(nbrecords_lrb_type)
2621 local_size_gest=local_size_gest+2*size_int*local_nbrecords
2622#endif
2623 endif
2624 300 continue
2625 RETURN
2626 END SUBROUTINE dmumps_save_restore_lrb
2627 SUBROUTINE dmumps_save_restore_blr_panel(BLR_PANEL_T
2628 & ,unit,MYID,mode
2629 & ,Local_SIZE_GEST,Local_SIZE_VARIABLES
2630 & ,SIZE_INT, SIZE_ARITH_DEP, SIZE_LOGICAL
2631 & ,TOTAL_FILE_SIZE,TOTAL_STRUC_SIZE
2632 & ,size_read,size_allocated,size_written
2633 & ,INFO)
2634 include 'mpif.h'
2635 TYPE(blr_panel_type) :: BLR_PANEL_T
2636 INTEGER,intent(IN)::unit,MYID
2637 CHARACTER(len=*),intent(IN) :: mode
2638 INTEGER,INTENT(OUT) :: Local_SIZE_GEST
2639 INTEGER(8),intent(OUT) :: Local_SIZE_VARIABLES
2640 INTEGER,intent(INOUT):: INFO(2)
2641 INTEGER,intent(IN):: SIZE_INT, SIZE_ARITH_DEP, SIZE_LOGICAL
2642 INTEGER(8),intent(IN) :: TOTAL_FILE_SIZE,TOTAL_STRUC_SIZE
2643 INTEGER(8),intent(INOUT):: size_read,size_allocated,size_written
2644 INTEGER :: NBVARIABLES_BLR_PANEL_TYPE
2645 parameter(nbvariables_blr_panel_type = 2)
2646 CHARACTER(len=30), dimension(NBVARIABLES_BLR_PANEL_TYPE)::
2647 & variables_blr_panel_type
2648 CHARACTER(len=30) :: TMP_STRING
2649 INTEGER(8),dimension(NBVARIABLES_BLR_PANEL_TYPE)::
2650 & size_variables_blr_panel_type
2651 INTEGER,dimension(NBVARIABLES_BLR_PANEL_TYPE)::
2652 & size_gest_blr_panel_type
2653 INTEGER,dimension(NBVARIABLES_BLR_PANEL_TYPE)::
2654 & nbrecords_blr_panel_type
2655 INTEGER:: size_array1,dummy,allocok
2656 INTEGER:: err,i1,j1,NbSubRecords,Local_NbRecords
2657 INTEGER:: SIZE_GEST_LRB_PANEL_j1,SIZE_GEST_LRB_PANEL
2658 INTEGER(8)::SIZE_VARIABLES_LRB_PANEL_j1,SIZE_VARIABLES_LRB_PANEL
2659 INTEGER(4)::I4
2660 VARIABLES_BLR_PANEL_TYPE(1)="NB_ACCESSES_LEFT"
2661 variables_blr_panel_type(2)="LRB_PANEL"
2662 size_variables_blr_panel_type(:)=0_8
2663 size_gest_blr_panel_type(:)=0
2664 nbrecords_blr_panel_type(:)=0
2665 size_gest_lrb_panel_j1=0
2666 size_gest_lrb_panel=0
2667 size_variables_lrb_panel_j1=0_8
2668 size_variables_lrb_panel=0_8
2669 DO i1=1,nbvariables_blr_panel_type
2670 tmp_string = variables_blr_panel_type(i1)
2671 SELECT CASE(tmp_string)
2672 CASE("NB_ACCESSES_LEFT")
2673 nbrecords_blr_panel_type(i1)=1
2674 if(trim(mode).EQ."memory_save") then
2675 size_variables_blr_panel_type(i1)=size_int
2676 elseif(trim(mode).EQ."save") then
2677 size_variables_blr_panel_type(i1)=size_int
2678 write(unit,iostat=err) blr_panel_t%NB_ACCESSES_LEFT
2679 if(err.ne.0) then
2680 info(1) = -72
2681 CALL mumps_seti8toi4(total_file_size-size_written,
2682 & info(2))
2683 endif
2684 IF ( info(1) .LT. 0 ) GOTO 400
2685 elseif(trim(mode).EQ."restore") then
2686 size_variables_blr_panel_type(i1)=size_int
2687 read(unit,iostat=err) blr_panel_t%NB_ACCESSES_LEFT
2688 if(err.ne.0) THEN
2689 info(1) = -75
2690 CALL mumps_seti8toi4(total_file_size-size_read
2691 & ,info(2))
2692 endif
2693 IF ( info(1) .LT. 0 ) GOTO 400
2694 endif
2695 CASE("LRB_PANEL")
2696 if(trim(mode).EQ."memory_save") then
2697 IF(associated(blr_panel_t%LRB_PANEL)) THEN
2698 nbrecords_blr_panel_type(i1)=1
2699 size_gest_blr_panel_type(i1)=size_int
2700 size_variables_blr_panel_type(i1)=0
2701 DO j1=1,size(blr_panel_t%LRB_PANEL,1)
2702 CALL dmumps_save_restore_lrb(
2703 & blr_panel_t%LRB_PANEL(j1)
2704 & ,unit,myid,"memory_save"
2705 & ,size_gest_lrb_panel_j1
2706 & ,size_variables_lrb_panel_j1
2707 & ,size_int, size_arith_dep, size_logical
2708 & ,total_file_size,total_struc_size
2709 & ,size_read,size_allocated,size_written
2710 & ,info)
2711 size_gest_lrb_panel=size_gest_lrb_panel+
2712 & size_gest_lrb_panel_j1
2713 size_variables_lrb_panel=size_variables_lrb_panel+
2714 & size_variables_lrb_panel_j1
2715 ENDDO
2716 ELSE
2717 nbrecords_blr_panel_type(i1)=2
2718 size_gest_blr_panel_type(i1)=size_int*2
2719 size_variables_blr_panel_type(i1)=0
2720 ENDIF
2721 elseif(trim(mode).EQ."save") then
2722 IF(associated(blr_panel_t%LRB_PANEL)) THEN
2723 nbrecords_blr_panel_type(i1)=1
2724 size_gest_blr_panel_type(i1)=size_int
2725 size_variables_blr_panel_type(i1)=0
2726 write(unit,iostat=err) size(blr_panel_t%LRB_PANEL,1)
2727 if(err.ne.0) then
2728 info(1) = -72
2729 CALL mumps_seti8toi4(total_file_size-size_written,
2730 & info(2))
2731 endif
2732 IF ( info(1) .LT. 0 ) GOTO 400
2733 DO j1=1,size(blr_panel_t%LRB_PANEL,1)
2734 CALL dmumps_save_restore_lrb(
2735 & blr_panel_t%LRB_PANEL(j1)
2736 & ,unit,myid,"save"
2737 & ,size_gest_lrb_panel_j1
2738 & ,size_variables_lrb_panel_j1
2739 & ,size_int, size_arith_dep, size_logical
2740 & ,total_file_size,total_struc_size
2741 & ,size_read,size_allocated,size_written
2742 & ,info)
2743 IF ( info(1) .LT. 0 ) GOTO 400
2744 ENDDO
2745 ELSE
2746 nbrecords_blr_panel_type(i1)=2
2747 size_gest_blr_panel_type(i1)=size_int*2
2748 size_variables_blr_panel_type(i1)=0
2749 write(unit,iostat=err) -999
2750 if(err.ne.0) then
2751 info(1) = -72
2752 CALL mumps_seti8toi4(total_file_size-size_written,
2753 & info(2))
2754 endif
2755 IF ( info(1) .LT. 0 ) GOTO 400
2756 write(unit,iostat=err) -999
2757 if(err.ne.0) then
2758 info(1) = -72
2759 CALL mumps_seti8toi4(total_file_size-size_written,
2760 & info(2))
2761 endif
2762 IF ( info(1) .LT. 0 ) GOTO 400
2763 ENDIF
2764 elseif(trim(mode).EQ."restore") then
2765 nullify(blr_panel_t%LRB_PANEL)
2766 read(unit,iostat=err) size_array1
2767 if(err.ne.0) THEN
2768 info(1) = -75
2769 CALL mumps_seti8toi4(total_file_size-size_read
2770 & ,info(2))
2771 endif
2772 IF ( info(1) .LT. 0 ) GOTO 400
2773 if(size_array1.EQ.-999) then
2774 nbrecords_blr_panel_type(i1)=2
2775 size_gest_blr_panel_type(i1)=size_int*2
2776 size_variables_blr_panel_type(i1)=0
2777 read(unit,iostat=err) dummy
2778 if(err.ne.0) THEN
2779 info(1) = -75
2780 CALL mumps_seti8toi4(total_file_size-size_read
2781 & ,info(2))
2782 endif
2783 IF ( info(1) .LT. 0 ) GOTO 400
2784 else
2785 nbrecords_blr_panel_type(i1)=1
2786 size_gest_blr_panel_type(i1)=size_int
2787 size_variables_blr_panel_type(i1)=0
2788 allocate(blr_panel_t%LRB_PANEL(size_array1)
2789 & , stat=allocok)
2790 if (allocok .GT. 0) THEN
2791 info(1) = -78
2792 CALL mumps_seti8toi4(
2793 & total_struc_size-size_allocated
2794 & ,info(2))
2795 endif
2796 DO j1=1,size_array1
2797 CALL dmumps_save_restore_lrb(
2798 & blr_panel_t%LRB_PANEL(j1)
2799 & ,unit,myid,"restore"
2800 & ,size_gest_lrb_panel_j1
2801 & ,size_variables_lrb_panel_j1
2802 & ,size_int, size_arith_dep, size_logical
2803 & ,total_file_size,total_struc_size
2804 & ,size_read,size_allocated,size_written
2805 & ,info)
2806 size_gest_lrb_panel=size_gest_lrb_panel+
2807 & size_gest_lrb_panel_j1
2808 size_variables_lrb_panel=size_variables_lrb_panel+
2809 & size_variables_lrb_panel_j1
2810 ENDDO
2811 endif
2812 endif
2813 CASE DEFAULT
2814 END SELECT
2815 if(trim(mode).EQ."memory_save") then
2816 nbsubrecords=int(size_variables_blr_panel_type(i1)/huge(i4))
2817 IF(nbsubrecords.GT.0) then
2818 nbrecords_blr_panel_type(i1)=
2819 & nbrecords_blr_panel_type(i1)
2820 & +nbsubrecords
2821 ENDIF
2822 elseif(trim(mode).EQ."save") then
2823 size_written=size_written+size_variables_blr_panel_type(i1)
2824 & +int(size_gest_blr_panel_type(i1),kind=8)
2825#if !defined(MUMPS_F2003)
2826 size_written=size_written
2827 & +int(2*size_int*nbrecords_blr_panel_type(i1),kind=8)
2828#endif
2829 elseif(trim(mode).EQ."restore") then
2830 size_allocated=size_allocated+
2831 & size_variables_blr_panel_type(i1)
2832 size_read=size_read+size_variables_blr_panel_type(i1)
2833 & +int(size_gest_blr_panel_type(i1),kind=8)
2834#if !defined(MUMPS_F2003)
2835 size_read=size_read
2836 & +int(2*size_int*nbrecords_blr_panel_type(i1),kind=8)
2837#endif
2838 endif
2839 ENDDO
2840 if(trim(mode).EQ."memory_save") then
2841 local_size_variables=sum(size_variables_blr_panel_type)+
2842 & size_variables_lrb_panel
2843 local_size_gest=sum(size_gest_blr_panel_type)+
2844 & size_gest_lrb_panel
2845#if !defined(MUMPS_F2003)
2846 local_nbrecords=sum(nbrecords_blr_panel_type)
2847 local_size_gest=local_size_gest+2*size_int*local_nbrecords
2848#endif
2849 endif
2850 400 continue
2851 RETURN
2852 END SUBROUTINE dmumps_save_restore_blr_panel
2853 SUBROUTINE dmumps_save_restore_diag_block(DIAG_BLOCK_T
2854 & ,unit,MYID,mode
2855 & ,Local_SIZE_GEST,Local_SIZE_VARIABLES
2856 & ,SIZE_INT, SIZE_ARITH_DEP
2857 & ,TOTAL_FILE_SIZE,TOTAL_STRUC_SIZE
2858 & ,size_read,size_allocated,size_written
2859 & ,INFO)
2860 include 'mpif.h'
2861 TYPE(diag_block_type) :: DIAG_BLOCK_T
2862 INTEGER,intent(IN)::unit,MYID
2863 CHARACTER(len=*),intent(IN) :: mode
2864 INTEGER,INTENT(OUT) :: Local_SIZE_GEST
2865 INTEGER(8),intent(OUT) :: Local_SIZE_VARIABLES
2866 INTEGER,intent(INOUT):: INFO(2)
2867 INTEGER,intent(IN):: SIZE_INT, SIZE_ARITH_DEP
2868 INTEGER(8),intent(IN) :: TOTAL_FILE_SIZE,TOTAL_STRUC_SIZE
2869 INTEGER(8),intent(INOUT):: size_read,size_allocated,size_written
2870 INTEGER :: NBVARIABLES_DIAG_BLOCK_TYPE
2871 parameter(nbvariables_diag_block_type = 1)
2872 CHARACTER(len=30), dimension(NBVARIABLES_DIAG_BLOCK_TYPE)::
2873 & variables_diag_block_type
2874 CHARACTER(len=30) :: TMP_STRING
2875 INTEGER(8),dimension(NBVARIABLES_DIAG_BLOCK_TYPE)::
2876 & size_variables_diag_block_type
2877 INTEGER,dimension(NBVARIABLES_DIAG_BLOCK_TYPE)::
2878 & SIZE_GEST_DIAG_BLOCK_TYPE
2879 INTEGER,dimension(NBVARIABLES_DIAG_BLOCK_TYPE)::
2880 & nbrecords_diag_block_type
2881 INTEGER:: size_array1,dummy,allocok
2882 INTEGER:: err,i1,NbSubRecords,Local_NbRecords
2883 INTEGER(4) :: I4
2884 variables_diag_block_type(1)="DIAG_BLOCK"
2885 size_variables_diag_block_type(:)=0_8
2886 size_gest_diag_block_type(:)=0
2887 nbrecords_diag_block_type(:)=0
2888 DO i1=1,nbvariables_diag_block_type
2889 tmp_string = variables_diag_block_type(i1)
2890 SELECT CASE(tmp_string)
2891 CASE("DIAG_BLOCK")
2892 nbrecords_diag_block_type(i1)=2
2893 if(trim(mode).EQ."memory_save") then
2894 IF(associated(diag_block_t%DIAG_BLOCK)) THEN
2895 size_gest_diag_block_type(i1)=size_int
2896 size_variables_diag_block_type(i1)=
2897 & size(diag_block_t%DIAG_BLOCK,1)
2898 & * size_arith_dep
2899 ELSE
2900 size_gest_diag_block_type(i1)=size_int*2
2901 size_variables_diag_block_type(i1)=0
2902 ENDIF
2903 elseif(trim(mode).EQ."save") then
2904 IF(associated(diag_block_t%DIAG_BLOCK)) THEN
2905 size_gest_diag_block_type(i1)=size_int
2906 size_variables_diag_block_type(i1)=
2907 & size(diag_block_t%DIAG_BLOCK,1)
2908 & * size_arith_dep
2909 write(unit,iostat=err) size(diag_block_t%DIAG_BLOCK,1)
2910 if(err.ne.0) then
2911 info(1) = -72
2912 CALL mumps_seti8toi4(total_file_size-size_written,
2913 & info(2))
2914 endif
2915 IF ( info(1) .LT. 0 ) GOTO 200
2916 write(unit,iostat=err) diag_block_t%DIAG_BLOCK
2917 ELSE
2918 size_gest_diag_block_type(i1)=size_int*2
2919 size_variables_diag_block_type(i1)=0
2920 write(unit,iostat=err) -999
2921 if(err.ne.0) then
2922 info(1) = -72
2923 CALL mumps_seti8toi4(total_file_size-size_written,
2924 & info(2))
2925 endif
2926 IF ( info(1) .LT. 0 ) GOTO 200
2927 write(unit,iostat=err) -999
2928 ENDIF
2929 if(err.ne.0) then
2930 info(1) = -72
2931 CALL mumps_seti8toi4(total_file_size-size_written,
2932 & info(2))
2933 endif
2934 IF ( info(1) .LT. 0 ) GOTO 200
2935 elseif(trim(mode).EQ."restore") then
2936 nullify(diag_block_t%DIAG_BLOCK)
2937 read(unit,iostat=err) size_array1
2938 if(err.ne.0) THEN
2939 info(1) = -75
2940 CALL mumps_seti8toi4(total_file_size-size_read
2941 & ,info(2))
2942 endif
2943 IF ( info(1) .LT. 0 ) GOTO 200
2944 if(size_array1.EQ.-999) then
2945 size_gest_diag_block_type(i1)=size_int*2
2946 size_variables_diag_block_type(i1)=0
2947 read(unit,iostat=err) dummy
2948 else
2949 size_gest_diag_block_type(i1)=size_int
2950 size_variables_diag_block_type(i1)=
2951 & size_array1*size_arith_dep
2952 allocate(diag_block_t%DIAG_BLOCK(size_array1),
2953 & stat=allocok)
2954 if (allocok .GT. 0) THEN
2955 info(1) = -78
2956 CALL mumps_seti8toi4(
2957 & total_struc_size-size_allocated
2958 & ,info(2))
2959 GOTO 200
2960 endif
2961 read(unit,iostat=err) diag_block_t%DIAG_BLOCK
2962 endif
2963 if(err.ne.0) THEN
2964 info(1) = -75
2965 CALL mumps_seti8toi4(total_file_size-size_read
2966 & ,info(2))
2967 GOTO 200
2968 endif
2969 endif
2970 CASE DEFAULT
2971 END SELECT
2972 if(trim(mode).EQ."memory_save") then
2973 nbsubrecords=int(size_variables_diag_block_type(i1)/
2974 & huge(i4))
2975 IF(nbsubrecords.GT.0) then
2976 nbrecords_diag_block_type(i1)=
2977 & nbrecords_diag_block_type(i1)
2978 & +nbsubrecords
2979 ENDIF
2980 elseif(trim(mode).EQ."save") then
2981 size_written=size_written+size_variables_diag_block_type(i1)
2982 & +int(size_gest_diag_block_type(i1),kind=8)
2983#if !defined(MUMPS_F2003)
2984 size_written=size_written
2985 & +int(2*size_int*nbrecords_diag_block_type(i1),kind=8)
2986#endif
2987 elseif(trim(mode).EQ."restore") then
2988 size_allocated=size_allocated+
2989 & size_variables_diag_block_type(i1)
2990 size_read=size_read+size_variables_diag_block_type(i1)
2991 & +int(size_gest_diag_block_type(i1),kind=8)
2992#if !defined(MUMPS_F2003)
2993 size_read=size_read
2994 & +int(2*size_int*nbrecords_diag_block_type(i1),kind=8)
2995#endif
2996 endif
2997 ENDDO
2998 if(trim(mode).EQ."memory_save") then
2999 local_size_variables=sum(size_variables_diag_block_type)
3000 local_size_gest=sum(size_gest_diag_block_type)
3001#if !defined(MUMPS_F2003)
3002 local_nbrecords=sum(nbrecords_diag_block_type)
3003 local_size_gest=local_size_gest+2*size_int*local_nbrecords
3004#endif
3005 endif
3006 200 continue
3007 RETURN
3008 END SUBROUTINE dmumps_save_restore_diag_block
3009 END MODULE dmumps_lr_data_m
mumps_abort
#define mumps_abort
Definition VE_Metis.h:25
if
if(complex_arithmetic) id
max
#define max(a, b)
Definition macros.h:21
dmumps_lr_data_m
Definition dmumps_lr_data_m.F:14
dmumps_lr_data_m::dmumps_blr_retrieve_nfs4father
subroutine, public dmumps_blr_retrieve_nfs4father(iwhandler, nfs4father)
Definition dmumps_lr_data_m.F:868
dmumps_lr_data_m::dmumps_blr_free_m_array
subroutine, public dmumps_blr_free_m_array(iwhandler)
Definition dmumps_lr_data_m.F:917
dmumps_lr_data_m::dmumps_blr_init_front
subroutine, public dmumps_blr_init_front(iwhandler, info, mtk405)
Definition dmumps_lr_data_m.F:175
dmumps_lr_data_m::dmumps_blr_save_diag_block
subroutine, public dmumps_blr_save_diag_block(iwhandler, ipanel, d)
Definition dmumps_lr_data_m.F:547
dmumps_lr_data_m::dmumps_blr_retrieve_begs_blr_c
subroutine, public dmumps_blr_retrieve_begs_blr_c(iwhandler, begs_blr_col, nb_panels)
Definition dmumps_lr_data_m.F:654
dmumps_lr_data_m::dmumps_blr_dec_and_retrieve_l
subroutine, public dmumps_blr_dec_and_retrieve_l(iwhandler, ipanel, begs_blr_l, thelrbpanel)
Definition dmumps_lr_data_m.F:684
dmumps_lr_data_m::dmumps_blr_retrieve_nb_panels
subroutine, public dmumps_blr_retrieve_nb_panels(iwhandler, nb_panels)
Definition dmumps_lr_data_m.F:672
dmumps_lr_data_m::dmumps_save_restore_blr_panel
subroutine dmumps_save_restore_blr_panel(blr_panel_t, unit, myid, mode, local_size_gest, local_size_variables, size_int, size_arith_dep, size_logical, total_file_size, total_struc_size, size_read, size_allocated, size_written, info)
Definition dmumps_lr_data_m.F:2634
dmumps_lr_data_m::dmumps_blr_save_begs_blr_c
subroutine, public dmumps_blr_save_begs_blr_c(iwhandler, begs_blr_col, info)
Definition dmumps_lr_data_m.F:562
dmumps_lr_data_m::dmumps_blr_mod_to_struc
subroutine, public dmumps_blr_mod_to_struc(id_blrarray_encoding)
Definition dmumps_lr_data_m.F:132
dmumps_lr_data_m::blr_array_free
integer blr_array_free
Definition dmumps_lr_data_m.F:65
dmumps_lr_data_m::dmumps_blr_retrieve_diag_block
subroutine, public dmumps_blr_retrieve_diag_block(iwhandler, ipanel, theblock)
Definition dmumps_lr_data_m.F:804
dmumps_lr_data_m::dmumps_save_restore_diag_block
subroutine dmumps_save_restore_diag_block(diag_block_t, unit, myid, mode, local_size_gest, local_size_variables, size_int, size_arith_dep, total_file_size, total_struc_size, size_read, size_allocated, size_written, info)
Definition dmumps_lr_data_m.F:2860
dmumps_lr_data_m::dmumps_blr_struc_to_mod
subroutine, public dmumps_blr_struc_to_mod(id_blrarray_encoding)
Definition dmumps_lr_data_m.F:157
dmumps_lr_data_m::nb_panels_notinit
integer nb_panels_notinit
Definition dmumps_lr_data_m.F:65
dmumps_lr_data_m::dmumps_blr_empty_panel_loru
logical function, public dmumps_blr_empty_panel_loru(iwhandler, loru, ipanel)
Definition dmumps_lr_data_m.F:719
dmumps_lr_data_m::blr_array
type(blr_struc_t), dimension(:), pointer, save, public blr_array
Definition dmumps_lr_data_m.F:61
dmumps_lr_data_m::dmumps_blr_retrieve_begs_blr_l
subroutine, public dmumps_blr_retrieve_begs_blr_l(iwhandler, begs_blr_l)
Definition dmumps_lr_data_m.F:606
dmumps_lr_data_m::dmumps_blr_save_init
subroutine, public dmumps_blr_save_init(iwhandler, issym, ist2, isslave, nb_panels, begs_blr_l, begs_blr_col, nb_accesses_init, info)
Definition dmumps_lr_data_m.F:235
dmumps_lr_data_m::dmumps_blr_save_cb_lrb
subroutine, public dmumps_blr_save_cb_lrb(iwhandler, cb_lrb)
Definition dmumps_lr_data_m.F:532
dmumps_lr_data_m::nfs4father_notinit
integer nfs4father_notinit
Definition dmumps_lr_data_m.F:65
dmumps_lr_data_m::dmumps_blr_dec_and_tryfree_l
subroutine, public dmumps_blr_dec_and_tryfree_l(iwhandler, ipanel, keep8, k34)
Definition dmumps_lr_data_m.F:932
dmumps_lr_data_m::dmumps_save_restore_blr
subroutine, public dmumps_save_restore_blr(id_blrarray_encoding, unit, myid, mode, size_gest, size_variables, size_int, size_arith_dep, size_logical, total_file_size, total_struc_size, size_read, size_allocated, size_written, info)
Definition dmumps_lr_data_m.F:1074
dmumps_lr_data_m::dmumps_blr_retrieve_begsblr_dyn
subroutine, public dmumps_blr_retrieve_begsblr_dyn(iwhandler, begs_blr_dynamic)
Definition dmumps_lr_data_m.F:638
dmumps_lr_data_m::dmumps_blr_free_all_panels
subroutine, public dmumps_blr_free_all_panels(iwhandler, loru, keep8, k34)
Definition dmumps_lr_data_m.F:1003
dmumps_lr_data_m::dmumps_blr_retrieve_panel_loru
subroutine, public dmumps_blr_retrieve_panel_loru(iwhandler, loru, ipanel, thelrbpanel)
Definition dmumps_lr_data_m.F:750
dmumps_lr_data_m::dmumps_blr_end_front
subroutine, public dmumps_blr_end_front(iwhandler, info1, keep8, k34, lrsolve_act_opt, mtk405)
Definition dmumps_lr_data_m.F:342
dmumps_lr_data_m::dmumps_save_restore_blr_struc
subroutine dmumps_save_restore_blr_struc(blr_struc, unit, myid, mode, local_size_gest, local_size_variables, size_int, size_arith_dep, size_logical, total_file_size, total_struc_size, size_read, size_allocated, size_written, info)
Definition dmumps_lr_data_m.F:1253
dmumps_lr_data_m::dmumps_blr_save_m_array
subroutine, public dmumps_blr_save_m_array(iwhandler, m_array, info)
Definition dmumps_lr_data_m.F:880
dmumps_lr_data_m::panels_notused
integer panels_notused
Definition dmumps_lr_data_m.F:65
dmumps_lr_data_m::dmumps_blr_save_nfs4father
subroutine, public dmumps_blr_save_nfs4father(iwhandler, nfs4father)
Definition dmumps_lr_data_m.F:856
dmumps_lr_data_m::dmumps_blr_init_module
subroutine, public dmumps_blr_init_module(initial_size, info)
Definition dmumps_lr_data_m.F:73
dmumps_lr_data_m::panels_freed
integer panels_freed
Definition dmumps_lr_data_m.F:65
dmumps_lr_data_m::dmumps_blr_try_free_panel
subroutine, public dmumps_blr_try_free_panel(iwhandler, ipanel, keep8, k34)
Definition dmumps_lr_data_m.F:946
dmumps_lr_data_m::dmumps_save_restore_lrb
subroutine dmumps_save_restore_lrb(lrb_t, unit, myid, mode, local_size_gest, local_size_variables, size_int, size_arith_dep, size_logical, total_file_size, total_struc_size, size_read, size_allocated, size_written, info)
Definition dmumps_lr_data_m.F:2303
dmumps_lr_data_m::dmumps_blr_retrieve_begsblr_sta
subroutine, public dmumps_blr_retrieve_begsblr_sta(iwhandler, begs_blr_static)
Definition dmumps_lr_data_m.F:622
dmumps_lr_data_m::dmumps_blr_free_cb_lrb
subroutine, public dmumps_blr_free_cb_lrb(iwhandler, free_only_struct, keep8, k34)
Definition dmumps_lr_data_m.F:970
dmumps_lr_data_m::dmumps_blr_save_begs_blr_dyn
subroutine, public dmumps_blr_save_begs_blr_dyn(iwhandler, begs_blr_dynamic)
Definition dmumps_lr_data_m.F:588
dmumps_lr_data_m::dmumps_blr_retrieve_cb_lrb
subroutine, public dmumps_blr_retrieve_cb_lrb(iwhandler, thecb)
Definition dmumps_lr_data_m.F:837
dmumps_lr_data_m::dmumps_blr_retrieve_m_array
subroutine, public dmumps_blr_retrieve_m_array(iwhandler, m_array)
Definition dmumps_lr_data_m.F:902
dmumps_lr_data_m::dmumps_blr_end_module
subroutine, public dmumps_blr_end_module(info1, keep8, k34, lrsolve_act_opt)
Definition dmumps_lr_data_m.F:101
dmumps_lr_data_m::dmumps_blr_save_panel_loru
subroutine, public dmumps_blr_save_panel_loru(iwhandler, loru, ipanel, lrb_panel)
Definition dmumps_lr_data_m.F:512
dmumps_lr_type
Definition dlr_type.F:14
dmumps_lr_type::dealloc_lrb
subroutine dealloc_lrb(lrb_out, keep8, k34)
Definition dlr_type.F:25
dmumps_lr_type::dealloc_blr_panel
subroutine dealloc_blr_panel(blr_panel, iend, keep8, k34, ibeg_in)
Definition dlr_type.F:56
mumps_front_data_mgt_m
Definition front_data_mgt_m.F:14
mumps_front_data_mgt_m::mumps_fdm_end_idx
subroutine, public mumps_fdm_end_idx(what, from, iwhandler)
Definition front_data_mgt_m.F:298
mumps_front_data_mgt_m::mumps_fdm_start_idx
subroutine, public mumps_fdm_start_idx(what, from, iwhandler, info)
Definition front_data_mgt_m.F:231
dmumps_lr_data_m::blr_array_t
Definition dmumps_lr_data_m.F:62
dmumps_lr_data_m::blr_panel_type
Definition dmumps_lr_data_m.F:39
dmumps_lr_data_m::blr_struc_t
Definition dmumps_lr_data_m.F:46
dmumps_lr_data_m::diag_block_type
Definition dmumps_lr_data_m.F:43
dmumps_lr_type::lrb_type
Definition dlr_type.F:16
mumps_seti8toi4
subroutine mumps_seti8toi4(i8, i)
Definition tools_common.F:843
mumps_dm_fac_upd_dyn_memcnts
subroutine mumps_dm_fac_upd_dyn_memcnts(mem_count_allocated, atomic_updates, keep8, iflag, ierror, k69upd, k71upd)
Definition tools_common.F:1476