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

Data Types

type  fdm_struc_t

Functions/Subroutines

subroutine, public mumps_fdm_init (what, initial_size, info)
subroutine, public mumps_fdm_end (what)
subroutine, public mumps_fdm_mod_to_struc (what, id_fdm_encoding, info)
subroutine, public mumps_fdm_struc_to_mod (what, id_fdm_encoding)
subroutine, public mumps_fdm_start_idx (what, from, iwhandler, info)
subroutine, public mumps_fdm_end_idx (what, from, iwhandler)
subroutine mumps_fdm_set_ptr (what, fdm_ptr)
subroutine mumps_fdm_set_all_free (fdm_ptr)
subroutine, public mumps_save_restore_front_data (id_fdm_f_encoding, unit, myid, mode, size_gest, size_variables, size_int, total_file_size, total_struc_size, size_read, size_allocated, size_written, info)
subroutine mumps_save_restore_fdm_struc (fdm_struc, unit, myid, mode, local_size_gest, local_size_variables, size_int, total_file_size, total_struc_size, size_read, size_allocated, size_written, info)

Variables

type(fdm_struc_t), target, save fdm_a
type(fdm_struc_t), target, save fdm_f

Function/Subroutine Documentation

◆ mumps_fdm_end()

subroutine, public mumps_front_data_mgt_m::mumps_fdm_end ( character, intent(in) what)

Definition at line 103 of file front_data_mgt_m.F.

104C
105C Purpose:
106C =======
107C Free module datastructures associated to "WHAT" at
108C the end of a phase (typically factorization).
109C
110 CHARACTER, INTENT(IN) :: WHAT
111C
112C Local variables
113C ===============
114C
115 TYPE (FDM_STRUC_T), POINTER :: FDM_PTR
116C
117 CALL mumps_fdm_set_ptr(what, fdm_ptr)
118 IF (associated(fdm_ptr%STACK_FREE_IDX)) THEN
119 DEALLOCATE(fdm_ptr%STACK_FREE_IDX)
120 NULLIFY(fdm_ptr%STACK_FREE_IDX)
121 fdm_ptr%NB_FREE_IDX=0
122 ELSE
123C Should not be called twice or when array is unassociated
124 WRITE(*,*) "Internal error 1 in MUMPS_FDM_END", what
125 CALL mumps_abort()
126 ENDIF
127 IF (associated(fdm_ptr%COUNT_ACCESS)) THEN
128 DEALLOCATE(fdm_ptr%COUNT_ACCESS)
129 NULLIFY(fdm_ptr%COUNT_ACCESS)
130 ELSE
131C Should not be called twice or when array is unassociated
132 WRITE(*,*) "Internal error 2 in MUMPS_FDM_END", what
133 CALL mumps_abort()
134 ENDIF
135 RETURN
mumps_abort
#define mumps_abort
Definition VE_Metis.h:25

◆ mumps_fdm_end_idx()

subroutine, public mumps_front_data_mgt_m::mumps_fdm_end_idx ( character, intent(in) what,
character(len=*), intent(in) from,
integer, intent(inout) iwhandler )

Definition at line 297 of file front_data_mgt_m.F.

298C
299C Purpose:
300C =======
301C
302C Notify than an index/handler has been freed.
303C Mark it free for future reuse.
304C
305 CHARACTER, INTENT(IN) :: WHAT
306 CHARACTER(LEN=*), INTENT(IN) :: FROM ! for debug purposes only
307 INTEGER, INTENT(INOUT) :: IWHANDLER
308 TYPE(FDM_STRUC_T), POINTER :: FDM_PTR
309C
310 CALL mumps_fdm_set_ptr(what, fdm_ptr)
311 IF (iwhandler .LE.0) THEN
312C Already ended
313 WRITE(*,*) "Internal error 1 in MUMPS_FDM_END_IDX",iwhandler
314 CALL mumps_abort()
315 ENDIF
316 fdm_ptr%COUNT_ACCESS(iwhandler)=fdm_ptr%COUNT_ACCESS(iwhandler)-1
317 IF (fdm_ptr%COUNT_ACCESS(iwhandler) .LT. 0) THEN
318C Negative counter!
319 WRITE(*,*) "Internal error 2 in MUMPS_FDM_END_IDX",
320 & iwhandler, fdm_ptr%COUNT_ACCESS(iwhandler)
321 CALL mumps_abort()
322 ENDIF
323 IF (fdm_ptr%COUNT_ACCESS(iwhandler) .EQ.0 ) THEN
324 IF (fdm_ptr%NB_FREE_IDX .GE. size(fdm_ptr%STACK_FREE_IDX)) THEN
325 WRITE(*,*) "Internal error 3 in MUMPS_FDM_END_IDX"
326 CALL mumps_abort()
327 ENDIF
328 fdm_ptr%NB_FREE_IDX = fdm_ptr%NB_FREE_IDX + 1
329C Having incremented the nb of free handlers we
330C store the index (IWHANDLER) that has been
331C effectively released for future reuse.
332 fdm_ptr%STACK_FREE_IDX(fdm_ptr%NB_FREE_IDX) = iwhandler
333 iwhandler = -8888 ! has been used and is now free
334 ENDIF
335C
336 RETURN

◆ mumps_fdm_init()

subroutine, public mumps_front_data_mgt_m::mumps_fdm_init ( character, intent(in) what,
integer, intent(in) initial_size,
integer, dimension(2), intent(inout) info )

Definition at line 71 of file front_data_mgt_m.F.

72C
73C Purpose:
74C =======
75C
76C Initialize handler data ('A' or 'F')
77C
78C Arguments:
79C =========
80C
81 INTEGER, INTENT(IN) :: INITIAL_SIZE
82 CHARACTER, INTENT(IN) :: WHAT ! 'A' or 'F'
83 INTEGER, INTENT(INOUT) :: INFO(2)
84C
85C Local variables:
86C ===============
87C
88 INTEGER :: IERR
89 TYPE (FDM_STRUC_T), POINTER :: FDM_PTR
90C
91 CALL mumps_fdm_set_ptr(what, fdm_ptr)
92 ALLOCATE( fdm_ptr%STACK_FREE_IDX(initial_size),
93 & fdm_ptr%COUNT_ACCESS (initial_size), stat=ierr )
94 IF (ierr < 0) THEN
95 info(1) = -13
96 info(2) = initial_size * 2
97 RETURN
98 ENDIF
99 CALL mumps_fdm_set_all_free(fdm_ptr)
100 RETURN

◆ mumps_fdm_mod_to_struc()

subroutine, public mumps_front_data_mgt_m::mumps_fdm_mod_to_struc ( character, intent(in) what,
character, dimension(:), pointer id_fdm_encoding,
integer, dimension(2), intent(inout) info )

Definition at line 138 of file front_data_mgt_m.F.

139C
140C Purpose:
141C =======
142C
143C Save module information in struture.
144C id_FDM_ENCODING corresponds to id%FDM_F_ENCODING
145C This version requires that WHAT is equal to 'F'.
146C
147C id_FDM_ENDODING takes responsibility of pointing to module
148C FDM_F information. This typically allows data from the module
149C to be passed from factorization to solve through the instance
150C and manage multiple instances.
151C
152 CHARACTER, INTENT(IN) :: WHAT
153 INTEGER, INTENT(INOUT) :: INFO(2)
154#if defined(MUMPS_F2003)
155 CHARACTER, DIMENSION(:), POINTER, intent(inout) ::
156 & id_FDM_ENCODING
157#else
158 CHARACTER, DIMENSION(:), POINTER :: id_FDM_ENCODING
159#endif
160C
161C Local variables
162C ===============
163C
164C Character array of arbitrary dimension 1
165 CHARACTER :: CHAR_ARRAY(1)
166 INTEGER :: CHAR_LENGTH, IERR
167C
168 IF (what .NE. 'F') THEN
169 WRITE(*,*) "Internal error 1 in MUMPS_FDM_MOD_TO_STRUC"
170 CALL mumps_abort()
171 ENDIF
172 IF (associated(id_fdm_encoding)) THEN
173C Should be unassociated for this to work
174 WRITE(*,*) "Internal error 2 in MUMPS_FDM_MOD_TO_STRUC"
175 CALL mumps_abort()
176 ENDIF
177 char_length=size(transfer(fdm_f,char_array))
178 ALLOCATE(id_fdm_encoding(char_length), stat=ierr )
179 IF (ierr < 0) THEN
180 info(1) = -13
181 info(2) = char_length
182 RETURN
183 ENDIF
184C ------------------------------
185C Fill contents of pointer array
186C with FDM_F derived datatype
187C ------------------------------
188 id_fdm_encoding = transfer(fdm_f,char_array)
189C ----------------------------------------------
190C FDM_F is not to be used again before a call to
191C MUMPS_FDM_STRUC_TO_MOD, invalidate its content
192C ----------------------------------------------
193 fdm_f%NB_FREE_IDX=-9999999
194 NULLIFY(fdm_f%STACK_FREE_IDX)
195 NULLIFY(fdm_f%COUNT_ACCESS)
196 RETURN

◆ mumps_fdm_set_all_free()

subroutine mumps_front_data_mgt_m::mumps_fdm_set_all_free ( type(fdm_struc_t), pointer fdm_ptr)
private

Definition at line 360 of file front_data_mgt_m.F.

361C
362C Purpose:
363C =======
364C Initialize the stack of free elements for the first time
365C
366 TYPE(FDM_STRUC_T), POINTER :: FDM_PTR
367 INTEGER :: I
368 fdm_ptr%NB_FREE_IDX = size(fdm_ptr%STACK_FREE_IDX)
369 DO i = 1, fdm_ptr%NB_FREE_IDX
370 fdm_ptr%STACK_FREE_IDX(i)=fdm_ptr%NB_FREE_IDX-i+1
371 fdm_ptr%COUNT_ACCESS (i)=0
372 ENDDO
373 RETURN

◆ mumps_fdm_set_ptr()

subroutine mumps_front_data_mgt_m::mumps_fdm_set_ptr ( character, intent(in) what,
type(fdm_struc_t), pointer fdm_ptr )
private

Definition at line 341 of file front_data_mgt_m.F.

342 CHARACTER, INTENT(IN) :: WHAT
343#if defined(MUMPS_F2003)
344 TYPE(FDM_STRUC_T), POINTER, INTENT(OUT) :: FDM_PTR
345#else
346 TYPE(FDM_STRUC_T), POINTER :: FDM_PTR
347#endif
348c
349 IF ( what .EQ. 'A' ) THEN
350 fdm_ptr => fdm_a
351 ELSE IF ( what .EQ. 'F' ) THEN
352 fdm_ptr => fdm_f
353 ELSE
354c should be called with either a or f
355 WRITE(*,*) "Internal error 1 in MUMPS_FDM_INIT"
356 WRITE(*,*) "Allowed arguments for WHAT are A or F"
357 CALL mumps_abort()
358 ENDIF

◆ mumps_fdm_start_idx()

subroutine, public mumps_front_data_mgt_m::mumps_fdm_start_idx ( character, intent(in) what,
character(len=*), intent(in) from,
integer, intent(inout) iwhandler,
integer, dimension(2), intent(inout) info )

Definition at line 230 of file front_data_mgt_m.F.

231C
232C Purpose:
233C =======
234C
235C Return a new free index/handler
236C (typically stored in IW)
237C
238 CHARACTER, INTENT(IN) :: WHAT
239 CHARACTER(LEN=*), INTENT(IN) :: FROM !For debugging purposes only
240 INTEGER, INTENT(INOUT) :: IWHANDLER
241 INTEGER, INTENT(INOUT) :: INFO(2)
242C
243C Local variables
244C ===============
245C
246 INTEGER :: OLD_SIZE, NEW_SIZE, IERR
247 INTEGER :: I
248 INTEGER, DIMENSION(:), POINTER :: TMP_COUNT_ACCESS
249 TYPE(FDM_STRUC_T), POINTER :: FDM_PTR
250 CALL mumps_fdm_set_ptr(what, fdm_ptr)
251C
252 IF (iwhandler .GT. 0) THEN
253C Already started, counter should at least be 1
254 IF (fdm_ptr%COUNT_ACCESS(iwhandler) .LT. 1) THEN
255 WRITE(*,*) "Internal error 1 in MUMPS_FDM_START_IDX",
256 & fdm_ptr%COUNT_ACCESS(iwhandler)
257 CALL mumps_abort()
258 ENDIF
259 GOTO 100
260 ENDIF
261C
262 IF (fdm_ptr%NB_FREE_IDX .EQ. 0) THEN
263 old_size = size(fdm_ptr%STACK_FREE_IDX)
264 new_size = (old_size * 3) / 2 + 1 ! or something else
265 fdm_ptr%NB_FREE_IDX = new_size - old_size
266 DEALLOCATE(fdm_ptr%STACK_FREE_IDX)
267 ALLOCATE(fdm_ptr%STACK_FREE_IDX(new_size),
268 & tmp_count_access(new_size), stat=ierr)
269 IF (ierr < 0) THEN
270 info(1) = -13
271 info(2) = new_size
272 RETURN
273 ENDIF
274C All new handlers indices are created
275 DO i=1, fdm_ptr%NB_FREE_IDX
276 fdm_ptr%STACK_FREE_IDX(i)=new_size-i+1
277 ENDDO
278C Count access: copy old ones
279 DO i=1, old_size
280 tmp_count_access(i)=fdm_ptr%COUNT_ACCESS(i)
281 ENDDO
282 DO i=old_size+1, new_size
283 tmp_count_access(i)=0
284 ENDDO
285 DEALLOCATE(fdm_ptr%COUNT_ACCESS)
286 fdm_ptr%COUNT_ACCESS=>tmp_count_access
287 ENDIF
288C
289 iwhandler = fdm_ptr%STACK_FREE_IDX(fdm_ptr%NB_FREE_IDX)
290 fdm_ptr%NB_FREE_IDX = fdm_ptr%NB_FREE_IDX - 1
291 100 CONTINUE
292C Number of modules accessing this handler
293 fdm_ptr%COUNT_ACCESS(iwhandler)=fdm_ptr%COUNT_ACCESS(iwhandler)+1
294 RETURN

◆ mumps_fdm_struc_to_mod()

subroutine, public mumps_front_data_mgt_m::mumps_fdm_struc_to_mod ( character, intent(in) what,
character, dimension(:), pointer id_fdm_encoding )

Definition at line 199 of file front_data_mgt_m.F.

200C
201C Purpose:
202C =======
203C
204C Set module pointer information from id_FDM_ENCODING) typically
205C at beginning of solve. Suppress from structure since
206C responsibility of pointing to module data is now inside
207C the module.
208C
209 CHARACTER, INTENT(IN) :: WHAT
210#if defined(MUMPS_F2003)
211 CHARACTER, DIMENSION(:), POINTER, INTENT(INOUT)
212 & :: id_FDM_ENCODING
213#else
214 CHARACTER, DIMENSION(:), POINTER :: id_FDM_ENCODING
215#endif
216C
217C Local variables
218C ===============
219C
220 IF (.NOT.associated(id_fdm_encoding)) THEN
221 WRITE(*,*) "Internal error 1 in MUMPS_FDM_STRUC_TO_MOD"
222 ENDIF
223 fdm_f=transfer(id_fdm_encoding,fdm_f)
224C Module is now responsible for accessing data.
225 DEALLOCATE(id_fdm_encoding)
226 NULLIFY(id_fdm_encoding)
227 RETURN

◆ mumps_save_restore_fdm_struc()

subroutine mumps_front_data_mgt_m::mumps_save_restore_fdm_struc ( type(fdm_struc_t) fdm_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(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 501 of file front_data_mgt_m.F.

507 IMPLICIT NONE
508C =======
509C Purpose
510C =======
511C
512C This routine is designed to manage a BLR_STRUC_T structure (save, restore, compute memory)
513C
514C ==========
515C Parameters
516C ==========
517C
518C BLR_STRUC : TYPE (BLR_STRUC_T) : the main structure
519C
520C unit : The unit of the file to be written or read
521C
522C mode : the type of operation to be performed by the routine
523C memory_save = compute the size of the save file and of the structure
524C save = save the instace
525C restore = restore the instace
526C
527C TOTAL_FILE_SIZE : size of the file to be written or read
528C
529C TOTAL_STRUC_SIZE : size of the structure to be saved or restored
530C
531C SIZE_INT : size of an integer
532C
533C INFO1/INFO2 : copies of of INFO(1) and INFO(2) to allow save/restore of failled instaces
534C
535 TYPE(FDM_STRUC_T) :: FDM_STRUC
536 INTEGER,intent(IN)::unit,MYID
537 CHARACTER(len=*),intent(IN) :: mode
538 INTEGER,INTENT(OUT) :: Local_SIZE_GEST
539 INTEGER(8),intent(OUT) :: Local_SIZE_VARIABLES
540 INTEGER,intent(INOUT):: INFO(2)
541 INTEGER,intent(IN):: SIZE_INT
542 INTEGER(8),intent(IN) :: TOTAL_FILE_SIZE,TOTAL_STRUC_SIZE
543 INTEGER(8),intent(INOUT):: size_read,size_allocated,size_written
544 INTEGER :: NBVARIABLES_FDM_STRUC_T
545 parameter(nbvariables_fdm_struc_t = 3)
546 CHARACTER(len=30), dimension(NBVARIABLES_FDM_STRUC_T)::
547 & VARIABLES_FDM_STRUC_T
548 CHARACTER(len=30) :: TMP_STRING
549 INTEGER(8),dimension(NBVARIABLES_FDM_STRUC_T)::
550 & SIZE_VARIABLES_FDM_STRUC_T
551 INTEGER,dimension(NBVARIABLES_FDM_STRUC_T)::SIZE_GEST_FDM_STRUC_T
552 INTEGER,dimension(NBVARIABLES_FDM_STRUC_T)::NbRecords_FDM_STRUC_T
553 INTEGER:: size_array1,dummy,allocok
554 INTEGER:: err,i1,NbSubRecords,Local_NbRecords
555 INTEGER(4) :: I4
556 variables_fdm_struc_t(1)="NB_FREE_IDX"
557 variables_fdm_struc_t(2)="STACK_FREE_IDX"
558 variables_fdm_struc_t(3)="COUNT_ACCESS"
559 size_variables_fdm_struc_t(:)=0_8
560 size_gest_fdm_struc_t(:)=0
561 nbrecords_fdm_struc_t(:)=0
562C
563C BEGINNING OF THE MAIN LOOP ON ALL VARIABLES OF THE STRUCTURE
564C
565 DO i1=1,nbvariables_fdm_struc_t
566 tmp_string = variables_fdm_struc_t(i1)
567 SELECT CASE(tmp_string)
568 CASE("NB_FREE_IDX")
569 nbrecords_fdm_struc_t(i1)=1
570 if(trim(mode).EQ."memory_save") then
571 size_variables_fdm_struc_t(i1)=size_int
572 elseif(trim(mode).EQ."save") then
573 size_variables_fdm_struc_t(i1)=size_int
574 write(unit,iostat=err) fdm_struc%NB_FREE_IDX
575 if(err.ne.0) then
576 info(1) = -72
577 CALL mumps_seti8toi4(total_file_size-size_written,
578 & info(2))
579 endif
580 IF ( info(1) .LT. 0 ) GOTO 100
581 elseif(trim(mode).EQ."restore") then
582 size_variables_fdm_struc_t(i1)=size_int
583 read(unit,iostat=err) fdm_struc%NB_FREE_IDX
584 if(err.ne.0) THEN
585 info(1) = -75
586 CALL mumps_seti8toi4(total_file_size-size_read
587 & ,info(2))
588 endif
589 IF ( info(1) .LT. 0 ) GOTO 100
590 endif
591 CASE("STACK_FREE_IDX")
592 nbrecords_fdm_struc_t(i1)=2
593 if(trim(mode).EQ."memory_save") then
594 IF(associated(fdm_struc%STACK_FREE_IDX)) THEN
595 size_gest_fdm_struc_t(i1)=size_int
596 size_variables_fdm_struc_t(i1)=
597 & size(fdm_struc%STACK_FREE_IDX,1)*size_int
598 ELSE
599 size_gest_fdm_struc_t(i1)=size_int*2
600 size_variables_fdm_struc_t(i1)=0_8
601 ENDIF
602 elseif(trim(mode).EQ."save") then
603 IF(associated(fdm_struc%STACK_FREE_IDX)) THEN
604 size_gest_fdm_struc_t(i1)=size_int
605 size_variables_fdm_struc_t(i1)=
606 & size(fdm_struc%STACK_FREE_IDX,1)*size_int
607 write(unit,iostat=err)
608 & size(fdm_struc%STACK_FREE_IDX,1)
609 if(err.ne.0) then
610 info(1) = -72
611 CALL mumps_seti8toi4(total_file_size-size_written,
612 & info(2))
613 endif
614 IF ( info(1) .LT. 0 ) GOTO 100
615 write(unit,iostat=err) fdm_struc%STACK_FREE_IDX
616 ELSE
617 size_gest_fdm_struc_t(i1)=size_int*2
618 size_variables_fdm_struc_t(i1)=0_8
619 write(unit,iostat=err) -999
620 if(err.ne.0) then
621 info(1) = -72
622 CALL mumps_seti8toi4(total_file_size-size_written,
623 & info(2))
624 endif
625 IF ( info(1) .LT. 0 ) GOTO 100
626 write(unit,iostat=err) -999
627 ENDIF
628 if(err.ne.0) then
629 info(1) = -72
630 CALL mumps_seti8toi4(total_file_size-size_written,
631 & info(2))
632 endif
633 IF ( info(1) .LT. 0 ) GOTO 100
634 elseif(trim(mode).EQ."restore") then
635 nullify(fdm_struc%STACK_FREE_IDX)
636 read(unit,iostat=err) size_array1
637 if(err.ne.0) THEN
638 info(1) = -75
639 CALL mumps_seti8toi4(total_file_size-size_read
640 & ,info(2))
641 endif
642 IF ( info(1) .LT. 0 ) GOTO 100
643 if(size_array1.EQ.-999) then
644 size_gest_fdm_struc_t(i1)=size_int*2
645 size_variables_fdm_struc_t(i1)=0_8
646 read(unit,iostat=err) dummy
647 else
648 size_gest_fdm_struc_t(i1)=size_int
649 size_variables_fdm_struc_t(i1)=size_array1*size_int
650 allocate(fdm_struc%STACK_FREE_IDX(size_array1),
651 & stat=allocok)
652 if (allocok .GT. 0) THEN
653 info(1) = -78
654 CALL mumps_seti8toi4(
655 & total_struc_size-size_allocated
656 & ,info(2))
657 endif
658 read(unit,iostat=err) fdm_struc%STACK_FREE_IDX
659 endif
660 IF ( info(1) .LT. 0 ) GOTO 100
661 if(err.ne.0) THEN
662 info(1) = -75
663 CALL mumps_seti8toi4(total_file_size-size_read
664 & ,info(2))
665 endif
666 IF ( info(1) .LT. 0 ) GOTO 100
667 endif
668 CASE("COUNT_ACCESS")
669 nbrecords_fdm_struc_t(i1)=2
670 if(trim(mode).EQ."memory_save") then
671 IF(associated(fdm_struc%COUNT_ACCESS)) THEN
672 size_gest_fdm_struc_t(i1)=size_int
673 size_variables_fdm_struc_t(i1)=
674 & size(fdm_struc%COUNT_ACCESS,1)*size_int
675 ELSE
676 size_gest_fdm_struc_t(i1)=size_int*2
677 size_variables_fdm_struc_t(i1)=0_8
678 ENDIF
679 elseif(trim(mode).EQ."save") then
680 IF(associated(fdm_struc%COUNT_ACCESS)) THEN
681 size_gest_fdm_struc_t(i1)=size_int
682 size_variables_fdm_struc_t(i1)=
683 & size(fdm_struc%COUNT_ACCESS,1)*size_int
684 write(unit,iostat=err)
685 & size(fdm_struc%COUNT_ACCESS,1)
686 if(err.ne.0) then
687 info(1) = -72
688 CALL mumps_seti8toi4(total_file_size-size_written,
689 & info(2))
690 endif
691 IF ( info(1) .LT. 0 ) GOTO 100
692 write(unit,iostat=err) fdm_struc%COUNT_ACCESS
693 ELSE
694 size_gest_fdm_struc_t(i1)=size_int*2
695 size_variables_fdm_struc_t(i1)=0_8
696 write(unit,iostat=err) -999
697 if(err.ne.0) then
698 info(1) = -72
699 CALL mumps_seti8toi4(total_file_size-size_written,
700 & info(2))
701 endif
702 IF ( info(1) .LT. 0 ) GOTO 100
703 write(unit,iostat=err) -999
704 ENDIF
705 if(err.ne.0) then
706 info(1) = -72
707 CALL mumps_seti8toi4(total_file_size-size_written,
708 & info(2))
709 endif
710 IF ( info(1) .LT. 0 ) GOTO 100
711 elseif(trim(mode).EQ."restore") then
712 nullify(fdm_struc%COUNT_ACCESS)
713 read(unit,iostat=err) size_array1
714 if(err.ne.0) THEN
715 info(1) = -75
716 CALL mumps_seti8toi4(total_file_size-size_read
717 & ,info(2))
718 endif
719 IF ( info(1) .LT. 0 ) GOTO 100
720 if(size_array1.EQ.-999) then
721 size_gest_fdm_struc_t(i1)=size_int*2
722 size_variables_fdm_struc_t(i1)=0_8
723 read(unit,iostat=err) dummy
724 else
725 size_gest_fdm_struc_t(i1)=size_int
726 size_variables_fdm_struc_t(i1)=size_array1*size_int
727 allocate(fdm_struc%COUNT_ACCESS(size_array1),
728 & stat=allocok)
729 if (allocok .GT. 0) THEN
730 info(1) = -78
731 CALL mumps_seti8toi4(
732 & total_struc_size-size_allocated
733 & ,info(2))
734 endif
735 read(unit,iostat=err) fdm_struc%COUNT_ACCESS
736 endif
737 IF ( info(1) .LT. 0 ) GOTO 100
738 if(err.ne.0) THEN
739 info(1) = -75
740 CALL mumps_seti8toi4(total_file_size-size_read
741 & ,info(2))
742 endif
743 IF ( info(1) .LT. 0 ) GOTO 100
744 endif
745 CASE DEFAULT
746 END SELECT
747 if(trim(mode).EQ."memory_save") then
748C If the size to write (SIZE_VARIABLES_FDM_STRUC_T(i1)) is greater than 2^31
749C Subrecords are created which need to be taken into account in
750C the file size computation
751 nbsubrecords=int(size_variables_fdm_struc_t(i1)/huge(i4))
752 IF(nbsubrecords.GT.0) then
753 nbrecords_fdm_struc_t(i1)=nbrecords_fdm_struc_t(i1)
754 & +nbsubrecords
755 ENDIF
756 elseif(trim(mode).EQ."save") then
757 size_written=size_written+size_variables_fdm_struc_t(i1)
758 & +int(size_gest_fdm_struc_t(i1),kind=8)
759#if !defined(MUMPS_F2003)
760 size_written=size_written
761 & +int(2*size_int*nbrecords_fdm_struc_t(i1),kind=8)
762#endif
763 elseif(trim(mode).EQ."restore") then
764 size_allocated=size_allocated+
765 & size_variables_fdm_struc_t(i1)
766 size_read=size_read+size_variables_fdm_struc_t(i1)
767 & +int(size_gest_fdm_struc_t(i1),kind=8)
768#if !defined(MUMPS_F2003)
769 size_read=size_read
770 & +int(2*size_int*nbrecords_fdm_struc_t(i1),kind=8)
771#endif
772 endif
773 ENDDO
774 if(trim(mode).EQ."memory_save") then
775 local_size_variables=sum(size_variables_fdm_struc_t)
776 local_size_gest=sum(size_gest_fdm_struc_t)
777#if !defined(MUMPS_F2003)
778 local_nbrecords=sum(nbrecords_fdm_struc_t)
779 local_size_gest=local_size_gest+2*size_int*local_nbrecords
780#endif
781 endif
782 100 continue
783 RETURN
mumps_seti8toi4
subroutine mumps_seti8toi4(i8, i)
Definition tools_common.F:843

◆ mumps_save_restore_front_data()

subroutine, public mumps_front_data_mgt_m::mumps_save_restore_front_data ( character, dimension(:), pointer id_fdm_f_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(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 377 of file front_data_mgt_m.F.

383 IMPLICIT NONE
384C =======
385C Purpose
386C =======
387C
388C This routine is designed to manage a FDM_STRUC_T structure (save, restore, compute memory)
389C
390C ==========
391C Parameters
392C ==========
393C
394C FDM_STRUC : TYPE (FDM_STRUC_T) : the main structure
395C
396C unit : The unit of the file to be written or read
397C
398C mode : the type of operation to be performed by the routine
399C memory_save = compute the size of the save file and of the structure
400C save = save the instace
401C restore = restore the instace
402C
403C TOTAL_FILE_SIZE : size of the file to be written or read
404C
405C TOTAL_STRUC_SIZE : size of the structure to be saved or restored
406C
407C SIZE_INT : size of an integer
408C
409C INFO : copies of of INFO(1) and INFO(2) to allow save/restore of failled instaces
410C
411 CHARACTER, DIMENSION(:), POINTER :: id_FDM_F_ENCODING
412 INTEGER,intent(IN)::unit,MYID
413 CHARACTER(len=*),intent(IN) :: mode
414 INTEGER,INTENT(OUT) :: SIZE_GEST
415 INTEGER(8),intent(OUT) :: SIZE_VARIABLES
416 INTEGER(8),intent(IN) :: TOTAL_FILE_SIZE,TOTAL_STRUC_SIZE
417 INTEGER,intent(INOUT):: INFO(2)
418 INTEGER,intent(IN):: SIZE_INT
419 INTEGER(8),intent(INOUT):: size_read,size_allocated,size_written
420 INTEGER:: NbRecords,NbSubRecords
421 INTEGER:: SIZE_GEST_FDM_F
422 INTEGER(8):: SIZE_VARIABLES_FDM_F
423 INTEGER(4) :: I4
424 nbrecords=0
425 size_gest_fdm_f=0
426 size_variables_fdm_f=0_8
427 size_gest=0
428 size_variables=0_8
429 if((trim(mode).EQ."memory_save").OR.(trim(mode).EQ."save")) then
430 call mumps_fdm_struc_to_mod("F",id_fdm_f_encoding)
431 endif
432 if(trim(mode).EQ."memory_save") then
433 CALL mumps_save_restore_fdm_struc(
434 & fdm_f
435 & ,unit,myid,"memory_save"
436 & ,size_gest_fdm_f
437 & ,size_variables_fdm_f
438 & ,size_int,total_file_size,total_struc_size
439 & ,size_read,size_allocated,size_written
440 & ,info)
441 elseif(trim(mode).EQ."save") then
442 CALL mumps_save_restore_fdm_struc(
443 & fdm_f
444 & ,unit,myid,"save"
445 & ,size_gest_fdm_f
446 & ,size_variables_fdm_f
447 & ,size_int,total_file_size,total_struc_size
448 & ,size_read,size_allocated,size_written
449 & ,info)
450 IF ( info(1) .LT. 0 ) GOTO 100
451 elseif(trim(mode).EQ."restore") then
452 CALL mumps_save_restore_fdm_struc(
453 & fdm_f
454 & ,unit,myid,"restore"
455 & ,size_gest_fdm_f
456 & ,size_variables_fdm_f
457 & ,size_int, total_file_size,total_struc_size
458 & ,size_read,size_allocated,size_written
459 & ,info)
460 IF ( info(1) .LT. 0 ) GOTO 100
461 endif
462 if(trim(mode).EQ."memory_save") then
463C If the size to write (SIZE_VARIABLES) is greater than 2^31
464C Subrecords are created which need to be taken into account in
465C the file size computation
466 nbsubrecords=int(size_variables/huge(i4))
467 IF(nbsubrecords.GT.0) then
468 nbrecords=nbrecords+nbsubrecords
469 ENDIF
470 elseif(trim(mode).EQ."save") then
471 size_written=size_written+size_variables
472 & +int(size_gest,kind=8)
473#if !defined(MUMPS_F2003)
474 size_written=size_written
475 & +int(2*size_int*nbrecords,kind=8)
476#endif
477 elseif(trim(mode).EQ."restore") then
478 size_allocated=size_allocated+size_variables
479 size_read=size_read+size_variables
480 & +int(size_gest,kind=8)
481#if !defined(MUMPS_F2003)
482 size_read=size_read
483 & +int(2*size_int*nbrecords,kind=8)
484#endif
485 endif
486 if(trim(mode).EQ."memory_save") then
487 size_variables=size_variables+size_variables_fdm_f
488 size_gest=size_gest+size_gest_fdm_f
489#if !defined(MUMPS_F2003)
490C If the file is not written with access="stream", which is only done in MUMPS_F2003,
491C the record length's is written at the beginning and at the end of each record
492C This is done using 2 INTEGERs so we use 2*SIZE_INT more space for each record
493 size_gest=size_gest+2*size_int*nbrecords
494#endif
495 endif
496 call mumps_fdm_mod_to_struc("F",id_fdm_f_encoding,info(1))
497 100 continue
498 RETURN

Variable Documentation

◆ fdm_a

type (fdm_struc_t), target, save mumps_front_data_mgt_m::fdm_a

Definition at line 68 of file front_data_mgt_m.F.

68 TYPE (FDM_STRUC_T), TARGET, SAVE :: FDM_A, FDM_F

◆ fdm_f

type (fdm_struc_t), target, save mumps_front_data_mgt_m::fdm_f
private

Definition at line 68 of file front_data_mgt_m.F.