OpenRadioss 2025.1.11
OpenRadioss project
Loading...
Searching...
No Matches
zmumps_save_restore_files.F
Go to the documentation of this file.
1C
2C This file is part of MUMPS 5.5.1, released
3C on Tue Jul 12 13:17:24 UTC 2022
4C
5C
6C Copyright 1991-2022 CERFACS, CNRS, ENS Lyon, INP Toulouse, Inria,
7C Mumps Technologies, University of Bordeaux.
8C
9C This version of MUMPS is provided to you free of charge. It is
10C released under the CeCILL-C license
11C (see doc/CeCILL-C_V1-en.txt, doc/CeCILL-C_V1-fr.txt, and
12C https://cecill.info/licences/Licence_CeCILL-C_V1-en.html)
13C
14 MODULE zmumps_save_restore_files
15 USE zmumps_struc_def
16 IMPLICIT NONE
17 INTEGER :: len_save_file
18 parameter( len_save_file = 550)
19 CONTAINS
20 SUBROUTINE mumps_read_header(fileunit, ierr, size_read, SIZE_INT
21 & ,SIZE_INT8, TOTAL_FILE_SIZE, TOTAL_STRUC_SIZE
22 & ,READ_ARITH, READ_INT_TYPE_64
23 & ,READ_OOC_FILE_NAME_LENGTH, READ_OOC_FIRST_FILE_NAME
24 & ,READ_HASH,READ_SYM,READ_PAR,READ_NPROCS
25 & ,FORTRAN_VERSION_OK)
26 INTEGER,intent(in) :: fileunit
27 INTEGER,intent(out) :: ierr
28 INTEGER(8), intent(inout) :: size_read
29 INTEGER,intent(in) :: SIZE_INT, SIZE_INT8
30 INTEGER(8), intent(out) :: TOTAL_FILE_SIZE,TOTAL_STRUC_SIZE
31 CHARACTER, intent(out) :: READ_ARITH
32 LOGICAL, intent(out) :: READ_INT_TYPE_64
33 INTEGER, intent(out) :: READ_OOC_FILE_NAME_LENGTH
34 CHARACTER(len=LEN_SAVE_FILE),intent(out)::READ_OOC_FIRST_FILE_NAME
35 CHARACTER(len=23), intent(out) :: READ_HASH
36 INTEGER, intent(out) :: READ_SYM,READ_PAR,READ_NPROCS
37 LOGICAL, intent(out) :: FORTRAN_VERSION_OK
38 CHARACTER(len=5) :: READ_FORTRAN_VERSION
39 INTEGER :: SIZE_CHARACTER, SIZE_LOGICAL
40 INTEGER :: dummy
41 size_character = 1
42 size_logical = 4
43 fortran_version_ok = .true.
44 read(fileunit,iostat=ierr) read_fortran_version
45 if(ierr.ne.0) GOTO 100
46 if (read_fortran_version.NE."MUMPS") THEN
47 ierr = 0
48 fortran_version_ok = .false.
49 GOTO 100
50 endif
51 size_read=size_read+int(5*size_character,kind=8)
52#if !defined(MUMPS_F2003)
53 size_read=size_read
54 & +int(2*size_int*1,kind=8)
55#endif
56 read(fileunit,iostat=ierr) read_hash
57 if(ierr.ne.0) GOTO 100
58 size_read=size_read+int(23*size_character,kind=8)
59#if !defined(MUMPS_F2003)
60 size_read=size_read
61 & +int(2*size_int*1,kind=8)
62#endif
63 read(fileunit,iostat=ierr) total_file_size,total_struc_size
64 if(ierr.ne.0) GOTO 100
65 size_read=size_read+int(2*size_int8,kind=8)
66#if !defined(MUMPS_F2003)
67 size_read=size_read
68 & +int(2*size_int*1,kind=8)
69#endif
70 read(fileunit,iostat=ierr) read_arith
71 if(ierr.ne.0) GOTO 100
72 size_read=size_read+int(1,kind=8)
73#if !defined(MUMPS_F2003)
74 size_read=size_read
75 & +int(2*size_int*1,kind=8)
76#endif
77 read(fileunit,iostat=ierr) read_sym,read_par,read_nprocs
78 if(ierr.ne.0) GOTO 100
79 size_read=size_read+int(3*size_int,kind=8)
80#if !defined(MUMPS_F2003)
81 size_read=size_read
82 & +int(2*size_int*1,kind=8)
83#endif
84 read(fileunit,iostat=ierr) read_int_type_64
85 if(ierr.ne.0) GOTO 100
86 size_read=size_read+int(size_logical,kind=8)
87#if !defined(MUMPS_F2003)
88 size_read=size_read
89 & +int(2*size_int*1,kind=8)
90#endif
91 read(fileunit,iostat=ierr) read_ooc_file_name_length
92 if(ierr.ne.0) GOTO 100
93 size_read=size_read+int(size_int,kind=8)
94#if !defined(MUMPS_F2003)
95 size_read=size_read
96 & +int(2*size_int*1,kind=8)
97#endif
98 IF(read_ooc_file_name_length.EQ.-999) THEN
99 read(fileunit,iostat=ierr) dummy
100 if(ierr.ne.0) GOTO 100
101 size_read=size_read+int(size_int,kind=8)
102#if !defined(MUMPS_F2003)
103 size_read=size_read
104 & +int(2*size_int*1,kind=8)
105#endif
106 ELSE
107 read(fileunit,iostat=ierr)
108 & read_ooc_first_file_name(1:read_ooc_file_name_length)
109 if(ierr.ne.0) GOTO 100
110 size_read=size_read+int(
111 & read_ooc_file_name_length*size_character,kind=8)
112#if !defined(MUMPS_F2003)
113 size_read=size_read
114 & +int(2*size_int*1,kind=8)
115#endif
116#if defined(OOC_VERBOSE)
117 write(*,*) 'First ooc file: ',
118 & read_ooc_first_file_name(1:read_ooc_file_name_length-2)
119#endif
120 ENDIF
121 100 continue
122 RETURN
123 END SUBROUTINE mumps_read_header
124 SUBROUTINE zmumps_check_header(id, BASIC_CHECK, READ_INT_TYPE_64,
125 & READ_HASH, READ_NPROCS,
126 & READ_ARITH, READ_SYM, READ_PAR)
127 include 'mpif.h'
128 TYPE (ZMUMPS_STRUC),intent(inout) :: id
129 LOGICAL, intent(in) :: BASIC_CHECK
130 LOGICAL, intent(in) :: READ_INT_TYPE_64
131 CHARACTER(len=23), intent(in) :: READ_HASH
132 INTEGER, intent(in) :: READ_NPROCS
133 CHARACTER, intent(in) :: READ_ARITH
134 INTEGER, intent(in) :: READ_SYM,READ_PAR
135 LOGICAL :: INT_TYPE_64
136 CHARACTER(len=23) :: HASH_MASTER
137 CHARACTER :: ARITH
138 INTEGER :: IERR
139 IF(id%KEEP(10).EQ.1) THEN
140 int_type_64=.true.
141 ELSE
142 int_type_64=.false.
143 ENDIF
144 if(int_type_64.neqv.read_int_type_64) THEN
145 id%INFO(1) = -73
146 id%INFO(2) = 2
147 endif
148 CALL mumps_propinfo( id%ICNTL(1), id%INFO(1),
149 & id%COMM, id%MYID )
150 IF ( id%INFO(1) .LT. 0 ) GOTO 100
151 if(id%MYID.EQ.0) THEN
152 hash_master=read_hash
153 ENDIF
154 call mpi_bcast(hash_master,23,mpi_character,0,id%COMM,ierr)
155 if(hash_master.ne.read_hash) THEN
156 id%INFO(1) = -73
157 id%INFO(2) = 3
158 endif
159 CALL mumps_propinfo( id%ICNTL(1), id%INFO(1),
160 & id%COMM, id%MYID )
161 IF ( id%INFO(1) .LT. 0 ) GOTO 100
162 if(id%NPROCS.ne.read_nprocs) THEN
163 id%INFO(1) = -73
164 id%INFO(2) = 4
165 endif
166 CALL mumps_propinfo( id%ICNTL(1), id%INFO(1),
167 & id%COMM, id%MYID )
168 IF ( id%INFO(1) .LT. 0 ) GOTO 100
169 IF (.NOT.basic_check) THEN
170 arith="ZMUMPS"(1:1)
171 if(arith.ne.read_arith) THEN
172 id%INFO(1) = -73
173 id%INFO(2) = 5
174 endif
175 CALL mumps_propinfo( id%ICNTL(1), id%INFO(1),
176 & id%COMM, id%MYID )
177 IF ( id%INFO(1) .LT. 0 ) GOTO 100
178 if((id%MYID.EQ.0).AND.(id%SYM.ne.read_sym)) THEN
179 id%INFO(1) = -73
180 id%INFO(2) = 6
181 endif
182 CALL mumps_propinfo( id%ICNTL(1), id%INFO(1),
183 & id%COMM, id%MYID )
184 IF ( id%INFO(1) .LT. 0 ) GOTO 100
185 if((id%MYID.EQ.0).AND.(id%PAR.ne.read_par)) THEN
186 write (*,*) id%MYID, 'PAR ',id%PAR, 'READ_PAR ', read_par
187 id%INFO(1) = -73
188 id%INFO(2) = 7
189 endif
190 CALL mumps_propinfo( id%ICNTL(1), id%INFO(1),
191 & id%COMM, id%MYID )
192 IF ( id%INFO(1) .LT. 0 ) GOTO 100
193 ENDIF
194 100 continue
195 RETURN
196 END SUBROUTINE zmumps_check_header
197 SUBROUTINE mumps_clean_saved_data(MYID,ierr,SUPPFILE,INFOFILE)
198 include 'mpif.h'
199 INTEGER,intent(in) :: MYID
200 INTEGER,intent(out) :: ierr
201 CHARACTER(len=LEN_SAVE_FILE),intent(in):: SUPPFILE,INFOFILE
202 INTEGER::supp,tmp_err
203 ierr = 0
204 tmp_err = 0
205 supp=200+myid
206 open(unit=supp,file=suppfile,status='old',
207 & form='unformatted',iostat=tmp_err)
208 if (tmp_err.eq.0) THEN
209 close(unit=supp,status='delete',iostat=tmp_err)
210 if(tmp_err.ne.0) then
211 ierr = 1
212 tmp_err = 0
213 endif
214 endif
215 if (ierr .eq. 0) then
216 if (tmp_err.ne.0) then
217 ierr = 1
218 tmp_err = 0
219 endif
220 open(unit=supp,file=infofile,status='old',iostat=tmp_err)
221 if (tmp_err.eq.0) THEN
222 close(unit=supp,status='delete',iostat=tmp_err)
223 endif
224 if (tmp_err.ne.0) THEN
225 ierr = ierr + 2
226 tmp_err = 0
227 endif
228 endif
229 END SUBROUTINE mumps_clean_saved_data
230 SUBROUTINE zmumps_get_save_files(id,SAVE_FILE,INFO_FILE)
231 include 'mpif.h'
232 TYPE (ZMUMPS_STRUC),intent(inout) :: id
233 CHARACTER(len=LEN_SAVE_FILE),intent(out):: SAVE_FILE, INFO_FILE
234 INTEGER::len_save_dir,len_save_prefix
235 CHARACTER(len=255):: tmp_savedir,savedir
236 CHARACTER(len=255):: tmp_saveprefix,saveprefix
237 CHARACTER(len=10):: STRING_MYID
238 CHARACTER:: LAST_CHAR_DIR
239 info_file=''
240 save_file=''
241 tmp_savedir=''
242 tmp_saveprefix=''
243 IF(id%SAVE_DIR.EQ."NAME_NOT_INITIALIZED") THEN
244 call mumps_get_save_dir_c(len_save_dir,tmp_savedir)
245 if(tmp_savedir(1:len_save_dir).EQ."NAME_NOT_INITIALIZED") then
246 id%INFO(1) = -77
247 id%INFO(2) = 0
248 else
249 savedir=trim(adjustl(tmp_savedir(1:len_save_dir)))
250 len_save_dir=len_trim(savedir(1:len_save_dir))
251 endif
252 ELSE
253 savedir=trim(adjustl(id%SAVE_DIR))
254 len_save_dir=len_trim(savedir)
255 ENDIF
256 CALL mumps_propinfo( id%ICNTL(1), id%INFO(1),
257 & id%COMM, id%MYID )
258 IF ( id%INFO(1) .LT. 0 ) GOTO 100
259 IF(id%SAVE_PREFIX.EQ."name_not_initialized") THEN
260 call mumps_get_save_prefix_C(len_save_prefix,tmp_saveprefix)
261.EQ. if(tmp_saveprefix(1:len_save_prefix)"name_not_initialized")
262 & then
263 saveprefix="save"
264 len_save_prefix=len_trim(saveprefix)
265 else
266 saveprefix=
267 & trim(adjustl(tmp_saveprefix(1:len_save_prefix)))
268 len_save_prefix=len_trim(saveprefix(1:len_save_prefix))
269 endif
270 ELSE
271 saveprefix=trim(adjustl(id%SAVE_PREFIX))
272 len_save_prefix=len_trim(saveprefix)
273 ENDIF
274 write(STRING_MYID,'(I10)') id%MYID
275 LAST_CHAR_DIR=savedir(len_save_dir:len_save_dir)
276.NE. if(LAST_CHAR_DIR"/") then
277 SAVE_FILE=trim(adjustl(savedir))//"/"
278 else
279 SAVE_FILE=trim(adjustl(savedir))
280 endif
281 INFO_FILE=trim(adjustl(SAVE_FILE))
282 SAVE_FILE=trim(adjustl(SAVE_FILE))
283 & //trim(adjustl(saveprefix))
284 & //"_"
285 & //trim(adjustl(STRING_MYID))
286 & //".mumps"
287 INFO_FILE=trim(adjustl(INFO_FILE))
288 & //trim(adjustl(saveprefix))
289 & //"_"
290 & //trim(adjustl(STRING_MYID))
291 & //".info"
292 100 continue
293 RETURN
294 END SUBROUTINE ZMUMPS_GET_SAVE_FILES
295 SUBROUTINE ZMUMPS_CHECK_FILE_NAME(id,NAME_LENGTH,FILE_NAME,CHECK)
296 TYPE (ZMUMPS_STRUC),intent(in) :: id
297 INTEGER,intent(in) :: NAME_LENGTH
298 CHARACTER(len=LEN_SAVE_FILE),intent(in) :: FILE_NAME
299 LOGICAL,intent(out) :: CHECK
300 INTEGER :: I
301 CHECK = .false.
302.NE. IF (NAME_LENGTH-999) THEN
303.AND. IF (associated(id%OOC_FILE_NAME_LENGTH)
304 & associated(id%OOC_FILE_NAMES)) THEN
305.EQ. IF (NAME_LENGTH id%OOC_FILE_NAME_LENGTH(1)) THEN
306 CHECK = .true.
307 I = 1
308.LE. DO WHILE(INAME_LENGTH)
309.NE. IF (FILE_NAME(I:I)id%OOC_FILE_NAMES(1,I)) THEN
310 CHECK = .false.
311 I = NAME_LENGTH + 1
312 ELSE
313 I = I + 1
314 ENDIF
315 END DO
316 ENDIF
317 ENDIF
318 ENDIF
319 END SUBROUTINE ZMUMPS_CHECK_FILE_NAME
320 END MODULE ZMUMPS_SAVE_RESTORE_FILES
321 SUBROUTINE ZMUMPS_SAVE_FILES_RETURN()
322 RETURN
323 END SUBROUTINE ZMUMPS_SAVE_FILES_RETURN
mumps_propinfo
subroutine mumps_propinfo(icntl, info, comm, id)
Definition bcast_errors.F:15
mpi_bcast
subroutine mpi_bcast(buffer, cnt, datatype, root, comm, ierr)
Definition mpi.f:205
zmumps_save_restore_files
Definition zmumps_save_restore_files.F:14
zmumps_save_restore_files::mumps_read_header
subroutine mumps_read_header(fileunit, ierr, size_read, size_int, size_int8, total_file_size, total_struc_size, read_arith, read_int_type_64, read_ooc_file_name_length, read_ooc_first_file_name, read_hash, read_sym, read_par, read_nprocs, fortran_version_ok)
Definition zmumps_save_restore_files.F:26
zmumps_save_restore_files::mumps_clean_saved_data
subroutine mumps_clean_saved_data(myid, ierr, suppfile, infofile)
Definition zmumps_save_restore_files.F:198
zmumps_save_restore_files::zmumps_check_header
subroutine zmumps_check_header(id, basic_check, read_int_type_64, read_hash, read_nprocs, read_arith, read_sym, read_par)
Definition zmumps_save_restore_files.F:127
zmumps_save_restore_files::len_save_file
integer len_save_file
Definition zmumps_save_restore_files.F:17
zmumps_save_restore_files::zmumps_get_save_files
subroutine zmumps_get_save_files(id, save_file, info_file)
Definition zmumps_save_restore_files.F:231
zmumps_struc_def
Definition zmumps_struc_def.F:14