OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
smumps_lr_data_m Module Reference

Data Types

type  blr_panel_type
type  diag_block_type
type  blr_struc_t
type  blr_array_t

Functions/Subroutines

subroutine, public smumps_blr_init_module (initial_size, info)
subroutine, public smumps_blr_end_module (info1, keep8, k34, lrsolve_act_opt)
subroutine, public smumps_blr_mod_to_struc (id_blrarray_encoding)
subroutine, public smumps_blr_struc_to_mod (id_blrarray_encoding)
subroutine, public smumps_blr_init_front (iwhandler, info, mtk405)
subroutine, public smumps_blr_save_init (iwhandler, issym, ist2, isslave, nb_panels, begs_blr_l, begs_blr_col, nb_accesses_init, info)
subroutine, public smumps_blr_end_front (iwhandler, info1, keep8, k34, lrsolve_act_opt, mtk405)
subroutine, public smumps_blr_save_panel_loru (iwhandler, loru, ipanel, lrb_panel)
subroutine, public smumps_blr_save_cb_lrb (iwhandler, cb_lrb)
subroutine, public smumps_blr_save_diag_block (iwhandler, ipanel, d)
subroutine, public smumps_blr_save_begs_blr_c (iwhandler, begs_blr_col, info)
subroutine, public smumps_blr_save_begs_blr_dyn (iwhandler, begs_blr_dynamic)
subroutine, public smumps_blr_retrieve_begs_blr_l (iwhandler, begs_blr_l)
subroutine, public smumps_blr_retrieve_begsblr_sta (iwhandler, begs_blr_static)
subroutine, public smumps_blr_retrieve_begsblr_dyn (iwhandler, begs_blr_dynamic)
subroutine, public smumps_blr_retrieve_begs_blr_c (iwhandler, begs_blr_col, nb_panels)
subroutine, public smumps_blr_retrieve_nb_panels (iwhandler, nb_panels)
subroutine, public smumps_blr_dec_and_retrieve_l (iwhandler, ipanel, begs_blr_l, thelrbpanel)
logical function, public smumps_blr_empty_panel_loru (iwhandler, loru, ipanel)
subroutine, public smumps_blr_retrieve_panel_loru (iwhandler, loru, ipanel, thelrbpanel)
subroutine, public smumps_blr_retrieve_diag_block (iwhandler, ipanel, theblock)
subroutine, public smumps_blr_retrieve_cb_lrb (iwhandler, thecb)
subroutine, public smumps_blr_save_nfs4father (iwhandler, nfs4father)
subroutine, public smumps_blr_retrieve_nfs4father (iwhandler, nfs4father)
subroutine, public smumps_blr_save_m_array (iwhandler, m_array, info)
subroutine, public smumps_blr_retrieve_m_array (iwhandler, m_array)
subroutine, public smumps_blr_free_m_array (iwhandler)
subroutine, public smumps_blr_dec_and_tryfree_l (iwhandler, ipanel, keep8, k34)
subroutine, public smumps_blr_try_free_panel (iwhandler, ipanel, keep8, k34)
subroutine, public smumps_blr_free_cb_lrb (iwhandler, free_only_struct, keep8, k34)
subroutine, public smumps_blr_free_all_panels (iwhandler, loru, keep8, k34)
subroutine, public smumps_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)
subroutine smumps_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)
subroutine smumps_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)
subroutine smumps_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)
subroutine smumps_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)

Variables

type(blr_struc_t), dimension(:), pointer, save, public blr_array
integer blr_array_free
integer panels_notused
integer panels_freed
integer nb_panels_notinit
integer nfs4father_notinit

Function/Subroutine Documentation

◆ smumps_blr_dec_and_retrieve_l()

subroutine, public smumps_lr_data_m::smumps_blr_dec_and_retrieve_l ( integer, intent(in) iwhandler,
integer, intent(in) ipanel,
integer, dimension(:), pointer begs_blr_l,
type(lrb_type), dimension(:), pointer thelrbpanel )

Definition at line 682 of file smumps_lr_data_m.F.

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 SMUMPS_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 SMUMPS_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 SMUMPS_BLR_DEC_AND_RETRIEVE_L",
707 & "IPANEL=", ipanel
708 CALL mumps_abort()
709 ENDIF
710 CALL smumps_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
mumps_abort
#define mumps_abort
Definition VE_Metis.h:25

◆ smumps_blr_dec_and_tryfree_l()

subroutine, public smumps_lr_data_m::smumps_blr_dec_and_tryfree_l ( integer, intent(in) iwhandler,
integer, intent(in) ipanel,
integer(8), dimension(150) keep8,
integer, intent(in) k34 )

Definition at line 930 of file smumps_lr_data_m.F.

932 IMPLICIT NONE
933 INTEGER, INTENT(IN) :: IWHANDLER, IPANEL, K34
934 INTEGER(8) :: KEEP8(150)
935 IF (iwhandler.LE.0) RETURN
936 IF ( blr_array(iwhandler)%NB_ACCESSES_INIT.LT.0)
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 smumps_blr_try_free_panel (iwhandler, ipanel,
941 & keep8, k34)
942 RETURN

◆ smumps_blr_empty_panel_loru()

logical function, public smumps_lr_data_m::smumps_blr_empty_panel_loru ( integer, intent(in) iwhandler,
integer, intent(in) loru,
integer, intent(in) ipanel )

Definition at line 717 of file smumps_lr_data_m.F.

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 SMUMPS_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 SMUMPS_BLR_EMPTY_PANEL_LORU, ",
730 & "IWHANDLER=", iwhandler
731 CALL mumps_abort()
732 ENDIF
733 smumps_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 SMUMPS_BLR_EMPTY_PANEL_LORU, ",
739 & "IWHANDLER=", iwhandler
740 CALL mumps_abort()
741 ENDIF
742 smumps_blr_empty_panel_loru = .NOT.
743 & associated(blr_array(iwhandler)%PANELS_U(ipanel)%LRB_PANEL)
744 ENDIF
745 RETURN

◆ smumps_blr_end_front()

subroutine, public smumps_lr_data_m::smumps_blr_end_front ( integer, intent(inout) iwhandler,
integer, intent(in) info1,
integer(8), dimension(150) keep8,
integer, intent(in) k34,
logical, intent(in), optional lrsolve_act_opt,
integer, intent(in), optional mtk405 )

Definition at line 340 of file smumps_lr_data_m.F.

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
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_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

◆ smumps_blr_end_module()

subroutine, public smumps_lr_data_m::smumps_blr_end_module ( integer, intent(in) info1,
integer(8), dimension(150) keep8,
integer, intent(in) k34,
logical, intent(in), optional lrsolve_act_opt )

Definition at line 98 of file smumps_lr_data_m.F.

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 SMUMPS_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 smumps_blr_end_front(iloop, info1, keep8, k34
120 & , lrsolve_act_opt
121 & )
122 ELSE
123 CALL smumps_blr_end_front(iloop, info1, keep8, k34 )
124 ENDIF
125 ENDIF
126 ENDDO
127 DEALLOCATE(blr_array)
128 NULLIFY(blr_array)
129 RETURN

◆ smumps_blr_free_all_panels()

subroutine, public smumps_lr_data_m::smumps_blr_free_all_panels ( integer, intent(in) iwhandler,
integer, intent(in) loru,
integer(8), dimension(150) keep8,
integer, intent(in) k34 )

Definition at line 1001 of file smumps_lr_data_m.F.

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 IF (iwhandler.LE.0) RETURN
1012 IF (blr_array(iwhandler)%NB_ACCESSES_INIT.EQ.
1013 & panels_notused) RETURN
1014 IF (loru.EQ.0.OR.loru.EQ.2) 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 IF (size(thepanel%LRB_PANEL) .GT.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 IF (loru.GE.1.AND..NOT.blr_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 IF (size(thepanel%LRB_PANEL) .GT.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 IF (.NOT.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 IF (mem_freed .GT. 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

◆ smumps_blr_free_cb_lrb()

subroutine, public smumps_lr_data_m::smumps_blr_free_cb_lrb ( integer, intent(in) iwhandler,
logical, intent(in) free_only_struct,
integer(8), dimension(150) keep8,
integer, intent(in) k34 )

Definition at line 968 of file smumps_lr_data_m.F.

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 IF (blr_array(iwhandler)%IsT2.AND.
978 & .NOT.blr_array(iwhandler)%IsSLAVE) THEN
979 write(*,*) 'Internal error 1 in SMUMPS_BLR_FREE_CB_LRB'
980 CALL mumps_abort()
981 ENDIF
982 cb_lrb => blr_array(iwhandler)%CB_LRB
983 IF (.NOT.associated(cb_lrb)) THEN
984 write(*,*) 'Internal error 2 in SMUMPS_BLR_FREE_CB_LRB'
985 CALL mumps_abort()
986 ENDIF
987 IF (.NOT.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

◆ smumps_blr_free_m_array()

subroutine, public smumps_lr_data_m::smumps_blr_free_m_array ( integer, intent(in) iwhandler)

Definition at line 916 of file smumps_lr_data_m.F.

917 IMPLICIT NONE
918 INTEGER, INTENT(IN) :: IWHANDLER
919 IF ( iwhandler .GT. size(blr_array) .OR. iwhandler .LE. 0 ) THEN
920 WRITE(*,*) "Internal error 1 in SMUMPS_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

◆ smumps_blr_init_front()

subroutine, public smumps_lr_data_m::smumps_blr_init_front ( integer, intent(inout) iwhandler,
integer, dimension(2), intent(inout) info,
integer, intent(in), optional mtk405 )

Definition at line 173 of file smumps_lr_data_m.F.

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
max
#define max(a, b)
Definition macros.h:21
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

◆ smumps_blr_init_module()

subroutine, public smumps_lr_data_m::smumps_blr_init_module ( integer, intent(in) initial_size,
integer, dimension(2), intent(inout) info )

Definition at line 72 of file smumps_lr_data_m.F.

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

◆ smumps_blr_mod_to_struc()

subroutine, public smumps_lr_data_m::smumps_blr_mod_to_struc ( character, dimension(:), pointer id_blrarray_encoding)

Definition at line 131 of file smumps_lr_data_m.F.

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

◆ smumps_blr_retrieve_begs_blr_c()

subroutine, public smumps_lr_data_m::smumps_blr_retrieve_begs_blr_c ( integer, intent(in) iwhandler,
integer, dimension(:), pointer begs_blr_col,
integer, intent(out) nb_panels )

Definition at line 652 of file smumps_lr_data_m.F.

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 SMUMPS_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

◆ smumps_blr_retrieve_begs_blr_l()

subroutine, public smumps_lr_data_m::smumps_blr_retrieve_begs_blr_l ( integer, intent(in) iwhandler,
integer, dimension(:), pointer begs_blr_l )

Definition at line 604 of file smumps_lr_data_m.F.

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 SMUMPS_BLR_RETRIEVE_BEGS_BLR_L"
615 CALL mumps_abort()
616 ENDIF
617 begs_blr_l => blr_array(iwhandler)%BEGS_BLR_L
618 RETURN

◆ smumps_blr_retrieve_begsblr_dyn()

subroutine, public smumps_lr_data_m::smumps_blr_retrieve_begsblr_dyn ( integer, intent(in) iwhandler,
integer, dimension(:), pointer begs_blr_dynamic )

Definition at line 636 of file smumps_lr_data_m.F.

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 SMUMPS_BLR_RETRIEVE_BEGSBLR_DYN"
647 CALL mumps_abort()
648 ENDIF
649 begs_blr_dynamic => blr_array(iwhandler)%BEGS_BLR_DYNAMIC
650 RETURN

◆ smumps_blr_retrieve_begsblr_sta()

subroutine, public smumps_lr_data_m::smumps_blr_retrieve_begsblr_sta ( integer, intent(in) iwhandler,
integer, dimension(:), pointer begs_blr_static )

Definition at line 620 of file smumps_lr_data_m.F.

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 SMUMPS_BLR_RETRIEVE_BEGSBLR_STA"
631 CALL mumps_abort()
632 ENDIF
633 begs_blr_static => blr_array(iwhandler)%BEGS_BLR_STATIC
634 RETURN

◆ smumps_blr_retrieve_cb_lrb()

subroutine, public smumps_lr_data_m::smumps_blr_retrieve_cb_lrb ( integer, intent(in) iwhandler,
type(lrb_type), dimension(:,:), pointer thecb )

Definition at line 835 of file smumps_lr_data_m.F.

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 SMUMPS_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 SMUMPS_BLR_RETRIEVE_CB_LRB"
849 CALL mumps_abort()
850 ENDIF
851 thecb => blr_array(iwhandler)%CB_LRB
852 RETURN

◆ smumps_blr_retrieve_diag_block()

subroutine, public smumps_lr_data_m::smumps_blr_retrieve_diag_block ( integer, intent(in) iwhandler,
integer, intent(in) ipanel,
real, dimension(:), pointer theblock )

Definition at line 801 of file smumps_lr_data_m.F.

804 INTEGER, INTENT(IN) :: IWHANDLER
805 INTEGER, INTENT(IN) :: IPANEL
806#if defined(MUMPS_F2003)
807 REAL, POINTER, INTENT(OUT) :: THEBLOCK(:)
808#else
809 REAL, POINTER :: THEBLOCK(:)
810#endif
811 IF ( iwhandler .GT. size(blr_array) .OR. iwhandler .LE. 0 ) THEN
812 WRITE(*,*)
813 & "Internal error 1 in SMUMPS_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 SMUMPS_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 SMUMPS_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

◆ smumps_blr_retrieve_m_array()

subroutine, public smumps_lr_data_m::smumps_blr_retrieve_m_array ( integer, intent(in) iwhandler,
real, dimension(:), pointer m_array )

Definition at line 901 of file smumps_lr_data_m.F.

902 IMPLICIT NONE
903 INTEGER, INTENT(IN) :: IWHANDLER
904#if defined(MUMPS_F2003)
905 REAL, DIMENSION(:), POINTER, INTENT(OUT) :: M_ARRAY
906#else
907 REAL, DIMENSION(:), POINTER :: M_ARRAY
908#endif
909 IF ( iwhandler .GT. size(blr_array) .OR. iwhandler .LE. 0 ) THEN
910 WRITE(*,*) "Internal error 1 in SMUMPS_BLR_RETRIEVE_M_ARRAY"
911 CALL mumps_abort()
912 ENDIF
913 m_array => blr_array(iwhandler)%M_ARRAY
914 RETURN

◆ smumps_blr_retrieve_nb_panels()

subroutine, public smumps_lr_data_m::smumps_blr_retrieve_nb_panels ( integer, intent(in) iwhandler,
integer, intent(out) nb_panels )

Definition at line 670 of file smumps_lr_data_m.F.

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 SMUMPS_BLR_RETRIEVE_NB_PANELS"
677 CALL mumps_abort()
678 ENDIF
679 nb_panels = blr_array(iwhandler)%NB_PANELS
680 RETURN

◆ smumps_blr_retrieve_nfs4father()

subroutine, public smumps_lr_data_m::smumps_blr_retrieve_nfs4father ( integer, intent(in) iwhandler,
integer, intent(out) nfs4father )

Definition at line 866 of file smumps_lr_data_m.F.

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 SMUMPS_BLR_RETRIEVE_NFS4FATHER"
873 CALL mumps_abort()
874 ENDIF
875 nfs4father = blr_array(iwhandler)%NFS4FATHER
876 RETURN

◆ smumps_blr_retrieve_panel_loru()

subroutine, public smumps_lr_data_m::smumps_blr_retrieve_panel_loru ( integer, intent(in) iwhandler,
integer, intent(in) loru,
integer, intent(in) ipanel,
type(lrb_type), dimension(:), pointer thelrbpanel )

Definition at line 747 of file smumps_lr_data_m.F.

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 SMUMPS_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 SMUMPS_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 SMUMPS_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 SMUMPS_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 SMUMPS_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

◆ smumps_blr_save_begs_blr_c()

subroutine, public smumps_lr_data_m::smumps_blr_save_begs_blr_c ( integer, intent(in) iwhandler,
integer, dimension(:), pointer begs_blr_col,
integer, dimension(2), intent(inout) info )

Definition at line 560 of file smumps_lr_data_m.F.

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 SMUMPS_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 SMUMPS_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

◆ smumps_blr_save_begs_blr_dyn()

subroutine, public smumps_lr_data_m::smumps_blr_save_begs_blr_dyn ( integer, intent(in) iwhandler,
integer, dimension(:), pointer begs_blr_dynamic )

Definition at line 586 of file smumps_lr_data_m.F.

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 SMUMPS_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 SMUMPS_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

◆ smumps_blr_save_cb_lrb()

subroutine, public smumps_lr_data_m::smumps_blr_save_cb_lrb ( integer, intent(in) iwhandler,
type(lrb_type), dimension(:,:), pointer cb_lrb )

Definition at line 530 of file smumps_lr_data_m.F.

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 SMUMPS_BLR_SAVE_CB_LRB"
540 CALL mumps_abort()
541 ENDIF
542 blr_array(iwhandler)%CB_LRB => cb_lrb
543 RETURN

◆ smumps_blr_save_diag_block()

subroutine, public smumps_lr_data_m::smumps_blr_save_diag_block ( integer, intent(in) iwhandler,
integer, intent(in) ipanel,
real, dimension(:), pointer d )

Definition at line 545 of file smumps_lr_data_m.F.

547 REAL,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 SMUMPS_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 SMUMPS_BLR_SAVE_DIAG_BLOCK"
555 CALL mumps_abort()
556 ENDIF
557 blr_array(iwhandler)%DIAG_BLOCKS(ipanel)%DIAG_BLOCK => d
558 RETURN

◆ smumps_blr_save_init()

subroutine, public smumps_lr_data_m::smumps_blr_save_init ( integer, intent(in) iwhandler,
logical, intent(in) issym,
logical, intent(in) ist2,
logical, intent(in) isslave,
integer, intent(in) nb_panels,
integer, dimension(:), intent(in) begs_blr_l,
integer, dimension(:), pointer begs_blr_col,
integer, intent(in) nb_accesses_init,
integer, dimension(2), intent(inout) info )

Definition at line 230 of file smumps_lr_data_m.F.

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 SMUMPS_BLR_SAVE_INIT ",
245 & nb_panels
246 ENDIF
247 IF (iwhandler .LE.0 ) THEN
248 WRITE(6,*) " Internal error 2 in SMUMPS_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

◆ smumps_blr_save_m_array()

subroutine, public smumps_lr_data_m::smumps_blr_save_m_array ( integer, intent(in) iwhandler,
real, dimension(:), intent(in) m_array,
integer, dimension(2), intent(inout) info )

Definition at line 878 of file smumps_lr_data_m.F.

880 REAL, 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 SMUMPS_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

◆ smumps_blr_save_nfs4father()

subroutine, public smumps_lr_data_m::smumps_blr_save_nfs4father ( integer, intent(in) iwhandler,
integer, intent(in) nfs4father )

Definition at line 854 of file smumps_lr_data_m.F.

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 SMUMPS_BLR_RETRIEVE_NFS4FATHER"
861 CALL mumps_abort()
862 ENDIF
863 blr_array(iwhandler)%NFS4FATHER = nfs4father
864 RETURN

◆ smumps_blr_save_panel_loru()

subroutine, public smumps_lr_data_m::smumps_blr_save_panel_loru ( integer, intent(in) iwhandler,
integer, intent(in) loru,
integer, intent(in) ipanel,
type(lrb_type), dimension(:), pointer lrb_panel )

Definition at line 510 of file smumps_lr_data_m.F.

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 SMUMPS_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

◆ smumps_blr_struc_to_mod()

subroutine, public smumps_lr_data_m::smumps_blr_struc_to_mod ( character, dimension(:), pointer id_blrarray_encoding)

Definition at line 156 of file smumps_lr_data_m.F.

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 SMUMPS_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

◆ smumps_blr_try_free_panel()

subroutine, public smumps_lr_data_m::smumps_blr_try_free_panel ( integer, intent(in) iwhandler,
integer, intent(in) ipanel,
integer(8), dimension(150) keep8,
integer, intent(in) k34 )

Definition at line 944 of file smumps_lr_data_m.F.

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 IF (iwhandler.LE.0) RETURN
952 IF ( blr_array(iwhandler)%NB_ACCESSES_INIT.LT.0)
953 & RETURN
954 thepanel => blr_array(iwhandler)%PANELS_L(ipanel)
955 IF ( thepanel%NB_ACCESSES_LEFT .EQ. 0 ) THEN
956 IF (associated(thepanel%LRB_PANEL)) THEN
957 IF (size(thepanel%LRB_PANEL) .GT.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

◆ smumps_save_restore_blr()

subroutine, public smumps_lr_data_m::smumps_save_restore_blr ( character, dimension(:), pointer id_blrarray_encoding,
integer, intent(in) unit,
integer, intent(in) myid,
character(len=*), intent(in) mode,
integer, intent(out) size_gest,
integer(8), intent(out) size_variables,
integer, intent(in) size_int,
integer, intent(in) size_arith_dep,
integer, intent(in) size_logical,
integer(8), intent(in) total_file_size,
integer(8), intent(in) total_struc_size,
integer(8), intent(inout) size_read,
integer(8), intent(inout) size_allocated,
integer(8), intent(inout) size_written,
integer, dimension(2), intent(inout) info )

Definition at line 1067 of file smumps_lr_data_m.F.

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 if((trim(mode).EQ."memory_save").OR.(trim(mode).EQ."save")) then
1096 call smumps_blr_struc_to_mod(id_blrarray_encoding)
1097 endif
1098 if(trim(mode).EQ."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 smumps_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 elseif(trim(mode).EQ."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 if(err.ne.0) then
1130 info(1) = -72
1131 CALL mumps_seti8toi4(total_file_size-size_written,
1132 & info(2))
1133 endif
1134 IF ( info(1) .LT. 0 ) GOTO 100
1135 DO j1=1,size(blr_array,1)
1136 CALL smumps_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 IF ( info(1) .LT. 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 if(err.ne.0) then
1153 info(1) = -72
1154 CALL mumps_seti8toi4(total_file_size-size_written,
1155 & info(2))
1156 endif
1157 IF ( info(1) .LT. 0 ) GOTO 100
1158 write(unit,iostat=err) -999
1159 if(err.ne.0) then
1160 info(1) = -72
1161 CALL mumps_seti8toi4(total_file_size-size_written,
1162 & info(2))
1163 endif
1164 IF ( info(1) .LT. 0 ) GOTO 100
1165 ENDIF
1166 elseif(trim(mode).EQ."restore") then
1167 nullify(blr_array)
1168 read(unit,iostat=err) size_array1
1169 if(err.ne.0) THEN
1170 info(1) = -75
1171 CALL mumps_seti8toi4(total_file_size-size_read
1172 & ,info(2))
1173 endif
1174 IF ( info(1) .LT. 0 ) GOTO 100
1175 if(size_array1.EQ.-999) then
1176 nbrecords=2
1177 size_gest=size_int*2
1178 size_variables=0
1179 read(unit,iostat=err) dummy
1180 if(err.ne.0) THEN
1181 info(1) = -75
1182 CALL mumps_seti8toi4(total_file_size-size_read
1183 & ,info(2))
1184 endif
1185 IF ( info(1) .LT. 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 if (allocok .GT. 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 smumps_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 if(trim(mode).EQ."memory_save") then
1215 nbsubrecords=int(size_variables/huge(i4))
1216 IF(nbsubrecords.GT.0) then
1217 nbrecords=nbrecords+nbsubrecords
1218 ENDIF
1219 elseif(trim(mode).EQ."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 elseif(trim(mode).EQ."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 if(trim(mode).EQ."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 smumps_blr_mod_to_struc(id_blrarray_encoding)
1243 100 continue
1244 RETURN
mumps_seti8toi4
subroutine mumps_seti8toi4(i8, i)
Definition tools_common.F:843

◆ smumps_save_restore_blr_panel()

subroutine smumps_lr_data_m::smumps_save_restore_blr_panel ( type(blr_panel_type) blr_panel_t,
integer, intent(in) unit,
integer, intent(in) myid,
character(len=*), intent(in) mode,
integer, intent(out) local_size_gest,
integer(8), intent(out) local_size_variables,
integer, intent(in) size_int,
integer, intent(in) size_arith_dep,
integer, intent(in) size_logical,
integer(8), intent(in) total_file_size,
integer(8), intent(in) total_struc_size,
integer(8), intent(inout) size_read,
integer(8), intent(inout) size_allocated,
integer(8), intent(inout) size_written,
integer, dimension(2), intent(inout) info )
private

Definition at line 2627 of file smumps_lr_data_m.F.

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 smumps_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 smumps_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 smumps_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

◆ smumps_save_restore_blr_struc()

subroutine smumps_lr_data_m::smumps_save_restore_blr_struc ( type(blr_struc_t) blr_struc,
integer, intent(in) unit,
integer, intent(in) myid,
character(len=*), intent(in) mode,
integer, intent(out) local_size_gest,
integer(8), intent(out) local_size_variables,
integer, intent(in) size_int,
integer, intent(in) size_arith_dep,
integer, intent(in) size_logical,
integer(8), intent(in) total_file_size,
integer(8), intent(in) total_struc_size,
integer(8), intent(inout) size_read,
integer(8), intent(inout) size_allocated,
integer(8), intent(inout) size_written,
integer, dimension(2), intent(inout) info )
private

Definition at line 1246 of file smumps_lr_data_m.F.

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 if(trim(mode).EQ."memory_save") then
1324 size_variables_blr_struc_t(i1)=size_logical
1325 elseif(trim(mode).EQ."save") then
1326 size_variables_blr_struc_t(i1)=size_logical
1327 write(unit,iostat=err) blr_struc%IsSYM
1328 if(err.ne.0) then
1329 info(1) = -72
1330 CALL mumps_seti8toi4(total_file_size-size_written,
1331 & info(2))
1332 endif
1333 IF ( info(1) .LT. 0 ) GOTO 100
1334 elseif(trim(mode).EQ."restore") then
1335 size_variables_blr_struc_t(i1)=size_logical
1336 read(unit,iostat=err) blr_struc%IsSYM
1337 if(err.ne.0) THEN
1338 info(1) = -75
1339 CALL mumps_seti8toi4(total_file_size-size_read
1340 & ,info(2))
1341 endif
1342 IF (info(1) .LT. 0 ) GOTO 100
1343 endif
1344 CASE("IsT2")
1345 nbrecords_blr_struc_t(i1)=1
1346 if(trim(mode).EQ."memory_save") then
1347 size_variables_blr_struc_t(i1)=size_logical
1348 elseif(trim(mode).EQ."save") then
1349 size_variables_blr_struc_t(i1)=size_logical
1350 write(unit,iostat=err) blr_struc%IsT2
1351 if(err.ne.0) then
1352 info(1) = -72
1353 CALL mumps_seti8toi4(total_file_size-size_written,
1354 & info(2))
1355 endif
1356 IF ( info(1) .LT. 0 ) GOTO 100
1357 elseif(trim(mode).EQ."restore") then
1358 size_variables_blr_struc_t(i1)=size_logical
1359 read(unit,iostat=err) blr_struc%IsT2
1360 if(err.ne.0) THEN
1361 info(1) = -75
1362 CALL mumps_seti8toi4(total_file_size-size_read
1363 & ,info(2))
1364 endif
1365 IF (info(1) .LT. 0 ) GOTO 100
1366 endif
1367 CASE("IsSLAVE")
1368 nbrecords_blr_struc_t(i1)=1
1369 if(trim(mode).EQ."memory_save") then
1370 size_variables_blr_struc_t(i1)=size_logical
1371 elseif(trim(mode).EQ."save") then
1372 size_variables_blr_struc_t(i1)=size_logical
1373 write(unit,iostat=err) blr_struc%IsSLAVE
1374 if(err.ne.0) then
1375 info(1) = -72
1376 CALL mumps_seti8toi4(total_file_size-size_written,
1377 & info(2))
1378 endif
1379 IF ( info(1) .LT. 0 ) GOTO 100
1380 elseif(trim(mode).EQ."restore") then
1381 size_variables_blr_struc_t(i1)=size_logical
1382 read(unit,iostat=err) blr_struc%IsSLAVE
1383 if(err.ne.0) THEN
1384 info(1) = -75
1385 CALL mumps_seti8toi4(total_file_size-size_read
1386 & ,info(2))
1387 endif
1388 IF (info(1) .LT. 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 if(err.ne.0) THEN
1437 info(1) = -75
1438 CALL mumps_seti8toi4(total_file_size-size_read
1439 & ,info(2))
1440 endif
1441 IF ( info(1) .LT. 0 ) GOTO 100
1442 if(size_array1.EQ.-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 if (allocok .GT. 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 IF ( info(1) .LT. 0 ) GOTO 100
1460 if(err.ne.0) THEN
1461 info(1) = -75
1462 CALL mumps_seti8toi4(total_file_size-size_read
1463 & ,info(2))
1464 endif
1465 IF ( info(1) .LT. 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 smumps_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 smumps_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 smumps_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 smumps_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 smumps_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 smumps_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 smumps_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 smumps_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 smumps_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 smumps_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 smumps_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 smumps_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

◆ smumps_save_restore_diag_block()

subroutine smumps_lr_data_m::smumps_save_restore_diag_block ( type(diag_block_type) diag_block_t,
integer, intent(in) unit,
integer, intent(in) myid,
character(len=*), intent(in) mode,
integer, intent(out) local_size_gest,
integer(8), intent(out) local_size_variables,
integer, intent(in) size_int,
integer, intent(in) size_arith_dep,
integer(8), intent(in) total_file_size,
integer(8), intent(in) total_struc_size,
integer(8), intent(inout) size_read,
integer(8), intent(inout) size_allocated,
integer(8), intent(inout) size_written,
integer, dimension(2), intent(inout) info )
private

Definition at line 2853 of file smumps_lr_data_m.F.

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

◆ smumps_save_restore_lrb()

subroutine smumps_lr_data_m::smumps_save_restore_lrb ( type(lrb_type) lrb_t,
integer, intent(in) unit,
integer, intent(in) myid,
character(len=*), intent(in) mode,
integer, intent(out) local_size_gest,
integer(8), intent(out) local_size_variables,
integer, intent(in) size_int,
integer, intent(in) size_arith_dep,
integer, intent(in) size_logical,
integer(8), intent(in) total_file_size,
integer(8), intent(in) total_struc_size,
integer(8), intent(inout) size_read,
integer(8), intent(inout) size_allocated,
integer(8), intent(inout) size_written,
integer, dimension(2), intent(inout) info )
private

Definition at line 2296 of file smumps_lr_data_m.F.

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

Variable Documentation

◆ blr_array

type(blr_struc_t), dimension(:), pointer, save, public smumps_lr_data_m::blr_array

Definition at line 61 of file smumps_lr_data_m.F.

61 type(BLR_STRUC_T), POINTER, DIMENSION(:), SAVE :: BLR_ARRAY

◆ blr_array_free

integer smumps_lr_data_m::blr_array_free

Definition at line 65 of file smumps_lr_data_m.F.

65 INTEGER BLR_ARRAY_FREE, PANELS_NOTUSED, PANELS_FREED,
66 & NB_PANELS_NOTINIT, NFS4FATHER_NOTINIT

◆ nb_panels_notinit

integer smumps_lr_data_m::nb_panels_notinit
private

Definition at line 65 of file smumps_lr_data_m.F.

◆ nfs4father_notinit

integer smumps_lr_data_m::nfs4father_notinit
private

Definition at line 65 of file smumps_lr_data_m.F.

◆ panels_freed

integer smumps_lr_data_m::panels_freed
private

Definition at line 65 of file smumps_lr_data_m.F.

◆ panels_notused

integer smumps_lr_data_m::panels_notused
private

Definition at line 65 of file smumps_lr_data_m.F.