SFEMaNS  version 4.1 (work in progress)
Reference documentation for SFEMaNS
 All Classes Files Functions Variables Groups Pages
restart.f90
Go to the documentation of this file.
1 !
2 !Authors Jean-Luc Guermond, Raphael Laguerre, Caroline Nore, Copyrights 2005
3 !
4 MODULE restart
5 
6 CONTAINS
7 
8  SUBROUTINE write_restart_ns(communicator, vv_mesh, pp_mesh, time, list_mode, &
9  un, un_m1, pn, pn_m1, incpn, incpn_m1, filename, it, freq_restart, &
10  opt_level_set, opt_level_set_m1, opt_max_vel, opt_mono)
11 
12  USE def_type_mesh
13  USE chaine_caractere
14  IMPLICIT NONE
15  include 'mpif.h'
16  TYPE(mesh_type), TARGET :: vv_mesh,pp_mesh
17  REAL(KIND=8), INTENT(IN) :: time
18  INTEGER, DIMENSION(:), INTENT(IN) :: communicator
19  INTEGER, DIMENSION(:), INTENT(IN) :: list_mode
20  REAL(KIND=8), DIMENSION(:,:,:), INTENT(IN) :: un, un_m1
21  REAL(KIND=8), DIMENSION(:,:,:), INTENT(IN) :: pn, pn_m1, incpn, incpn_m1
22  REAL(KIND=8), DIMENSION(:,:,:,:), OPTIONAL, INTENT(IN) :: opt_level_set, opt_level_set_m1
23  REAL(KIND=8), OPTIONAL, INTENT(IN) :: opt_max_vel
24  LOGICAL, OPTIONAL, INTENT(IN) :: opt_mono
25  CHARACTER(len=200), INTENT(IN) :: filename
26  INTEGER, INTENT(IN) :: it, freq_restart
27  INTEGER :: code, n, i, rang_s, rang_f, nb_procs_s, nb_procs_f
28  INTEGER :: l, lblank
29  CHARACTER(len=3) :: tit, tit_s
30  LOGICAL :: mono=.false.
31  LOGICAL :: skip
32  CHARACTER(len=250) :: out_name
33 
34  CALL mpi_comm_size(communicator(1),nb_procs_s,code)
35  CALL mpi_comm_size(communicator(2),nb_procs_f,code)
36  CALL mpi_comm_rank(communicator(1),rang_s,code)
37  CALL mpi_comm_rank(communicator(2),rang_f,code)
38 
39  WRITE(tit,'(i3)') it/freq_restart
40  lblank = eval_blank(3,tit)
41  DO l = 1, lblank - 1
42  tit(l:l) = '0'
43  END DO
44  WRITE(tit_s,'(i3)') rang_s
45  lblank = eval_blank(3,tit_s)
46  DO l = 1, lblank - 1
47  tit_s(l:l) = '0'
48  END DO
49 
50  IF (present(opt_mono)) THEN
51  mono = opt_mono
52  END IF
53 
54  IF (mono) THEN
55  out_name = 'suite_ns_I'//tit//'.'//filename
56  ELSE
57  out_name = 'suite_ns_S'//tit_s//'_I'//tit//'.'//filename
58  END IF
59 
60  skip = (mono .AND. rang_s /= 0)
61 
62  DO n = 1, nb_procs_f
63  IF ( (rang_f == n-1) .AND. (.NOT. skip) ) THEN
64  IF (rang_f == 0) THEN
65  OPEN(unit = 10, file = out_name, position='append', &
66  form = 'unformatted', status = 'replace')
67  IF (mono) THEN
68  WRITE(10) time, vv_mesh%np , pp_mesh%np , nb_procs_f, SIZE(list_mode)
69  ELSE
70  WRITE(10) time, nb_procs_s, nb_procs_f, SIZE(list_mode)
71  END IF
72  ELSE
73  OPEN(unit = 10, file = out_name, position='append', &
74  form = 'unformatted', status = 'unknown')
75  END IF
76 
77  DO i= 1, SIZE(list_mode)
78  WRITE(10) list_mode(i)
79  WRITE(10) un(:,:,i)
80  WRITE(10) un_m1(:,:,i)
81  WRITE(10) pn(:,:,i)
82  WRITE(10) pn_m1(:,:,i)
83  WRITE(10) incpn(:,:,i)
84  WRITE(10) incpn_m1(:,:,i)
85  IF (present(opt_level_set) .AND. present(opt_level_set_m1)) THEN
86  WRITE(10) opt_level_set(:,:,:,i)
87  WRITE(10) opt_level_set_m1(:,:,:,i)
88  WRITE(10) opt_max_vel
89  END IF
90  END DO
91  CLOSE(10)
92  END IF
93  CALL mpi_barrier(communicator(2),code)
94  END DO
95 
96  END SUBROUTINE write_restart_ns
97 
98 
99  SUBROUTINE read_restart_ns(communicator, time, list_mode, &
100  un, un_m1, pn, pn_m1, incpn, incpn_m1, filename, val_init, interpol, &
101  opt_level_set, opt_level_set_m1, opt_max_vel, opt_mono)
102 
103  USE def_type_mesh
104  USE chaine_caractere
105  USE my_util
106  IMPLICIT NONE
107  include 'mpif.h'
108  REAL(KIND=8), INTENT(OUT):: time
109  INTEGER, DIMENSION(:), INTENT(IN) :: communicator
110  INTEGER, DIMENSION(:) :: list_mode
111  REAL(KIND=8), DIMENSION(:,:,:), INTENT(OUT):: un, un_m1
112  REAL(KIND=8), DIMENSION(:,:,:), INTENT(OUT):: pn, pn_m1, incpn, incpn_m1
113  REAL(KIND=8), DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT):: opt_level_set, opt_level_set_m1
114  REAL(KIND=8), OPTIONAL, INTENT(OUT):: opt_max_vel
115  CHARACTER(len=200), INTENT(IN) :: filename
116  REAL(KIND=8), OPTIONAL, INTENT(IN) :: val_init
117  LOGICAL , OPTIONAL, INTENT(IN) :: interpol
118  LOGICAL , OPTIONAL, INTENT(IN) :: opt_mono
119  REAL(KIND=8) :: max_vel_loc
120  INTEGER :: code, n, i, mode, j, rang_s, nb_procs_s, rang_f, nb_procs_f, nlignes, rank
121  INTEGER :: m_max_cr, nb_procs_r, nb_procs_sr
122  INTEGER :: m_max_c, nb_mode_r, mode_cherche
123  LOGICAL :: trouve, okay
124  INTEGER :: npv, npp
125  INTEGER :: l, lblank
126  CHARACTER(len=3) :: tit_s
127  LOGICAL :: mono=.false.
128  CHARACTER(len=250):: in_name
129  CALL mpi_comm_rank(communicator(2),rang_f,code)
130  CALL mpi_comm_size(communicator(2),nb_procs_f,code)
131  CALL mpi_comm_rank(communicator(1),rang_s,code)
132  CALL mpi_comm_size(communicator(1),nb_procs_s,code)
133  CALL mpi_comm_rank(mpi_comm_world,rank,code)
134 
135  max_vel_loc = 0.d0
136 
137  nlignes = 6
138  IF (present(opt_level_set) .AND. present(opt_level_set_m1)) THEN
139  nlignes = nlignes + 3
140  END IF
141 
142  WRITE(tit_s,'(i3)') rang_s
143  lblank = eval_blank(3,tit_s)
144  DO l = 1, lblank - 1
145  tit_s(l:l) = '0'
146  END DO
147 
148  IF (present(opt_mono)) THEN
149  mono = opt_mono
150  END IF
151 
152  IF (mono) THEN
153  in_name = 'suite_ns.'//filename
154  ELSE
155  in_name = 'suite_ns_S'//tit_s//'.'//filename
156  END IF
157 
158  WRITE(*,*) 'restart Navier-Stokes'
159  OPEN(unit = 10, file = in_name, form = 'unformatted', status = 'unknown')
160 
161  IF (mono) THEN
162  READ(10) time, npv, npp, nb_procs_r, m_max_cr
163  nb_procs_sr = -1
164  ELSE
165  READ(10) time, nb_procs_sr, nb_procs_r, m_max_cr
166  END IF
167  CLOSE(10)
168 
169  IF ((nb_procs_sr /= nb_procs_s) .AND. (.NOT. mono)) THEN
170  CALL error_petsc('BUG in read_restart: nb_procs_Sr /= nb_procs_S')
171  !STOP
172  END IF
173 
174  IF (rang_f == 0) THEN
175  WRITE(*,*) 'File name', trim(adjustl(in_name))
176  WRITE(*,*) 'Time = ', time
177  WRITE(*,*) 'Number of processors from restart file = ',nb_procs_r
178  WRITE(*,*) 'Number of modes per processor from restart file = ',m_max_cr
179  ENDIF
180 
181  m_max_c = SIZE(list_mode) !nombre de modes par proc pour le calcul
182  nb_mode_r = nb_procs_r*m_max_cr !nombre total de modes contenus dans le suite
183 
184  !June 7 2007, JLG
185  IF (nb_procs_f*m_max_c /= nb_mode_r) THEN
186  !CALL error_petsc('Bug in read_restart_ns: nb_procs_F*m_max_c /= nb_mode_r')
187  WRITE(*,*) 'Warning in read_restart_ns: nb_procs_F*m_max_c /= nb_mode_r'
188  !STOP
189  END IF
190 
191  okay = .false.
192  IF (present(interpol)) THEN
193  IF (interpol) THEN
194  okay =.true.
195  END IF
196  END IF
197  !June 7 2007, JLG
198 
199  IF (rank==0) THEN
200  WRITE(*,*) 'Reading Navier-Stokes modes ...'
201  END IF
202  DO i=1, m_max_c !pour tout les modes du processeur courant
203  !ouverture du fichier
204  OPEN(unit = 10, file = in_name, form = 'unformatted', status = 'unknown')
205  !on saute la premiere ligne du fichier qui contient des donnees
206  READ(10)
207  mode_cherche = list_mode(i)
208  !recherche du bon mode
209  trouve = .false.
210  DO j=1, nb_mode_r !pour tout les modes ecris dans le suite.
211  !lecture du mode
212  READ(10) mode
213  !June 7 2007, JLG
214  IF (okay) THEN
215  IF (j/=rang_f*m_max_c+i) THEN
216  DO n=1, nlignes
217  READ(10)
218  ENDDO
219  cycle
220  ELSE
221  list_mode(i) = mode
222  mode_cherche = mode
223  END IF
224  END IF
225  !June 7 2007, JLG
226  IF (mode == mode_cherche) THEN !on a trouve le bon mode
227  READ(10) un(:,:,i)
228  READ(10) un_m1(:,:,i)
229  READ(10) pn(:,:,i)
230  READ(10) pn_m1(:,:,i)
231  READ(10) incpn(:,:,i)
232  READ(10) incpn_m1(:,:,i)
233  IF (present(opt_level_set) .AND. present(opt_level_set_m1)) THEN
234  READ(10) opt_level_set(:,:,:,i)
235  READ(10) opt_level_set_m1(:,:,:,i)
236  READ(10) max_vel_loc
237  END IF
238  WRITE(*,'(A,i4,A)') 'mode ns ', mode_cherche,' found '
239  trouve = .true.
240  EXIT !car on a trouve le bon mode
241  ELSE !on passe au mode suivant en sautant 6 lignes
242  DO n=1, nlignes
243  READ(10)
244  ENDDO
245  ENDIF
246  ENDDO
247 
248  IF (.NOT.trouve) THEN !mode_cherche non trouve
249  IF (present(val_init)) THEN ! not implemented yet
250  un(:,:,i) = val_init ; un_m1(:,:,i) = val_init
251  pn(:,:,i) = val_init ; pn_m1(:,:,i) = val_init
252  incpn(:,:,i) = val_init ; incpn_m1(:,:,i) = val_init
253  IF (present(opt_level_set) .AND. present(opt_level_set_m1)) THEN
254  opt_level_set(:,:,:,i) = val_init
255  opt_level_set_m1(:,:,:,i) = val_init
256  max_vel_loc = val_init
257  END IF
258  WRITE(*,'(A,i4,A)') 'mode ns', mode_cherche,' not found'
259  ELSE
260  un(:,:,i) = 0.d0 ; un_m1(:,:,i) = 0.d0
261  pn(:,:,i) = 0.d0 ; pn_m1(:,:,i) = 0.d0
262  incpn(:,:,i) = 0.d0 ; incpn_m1(:,:,i) = 0.d0
263  IF (present(opt_level_set) .AND. present(opt_level_set_m1)) THEN
264  opt_level_set(:,:,:,i)=0.d0
265  opt_level_set_m1(:,:,:,i)=0.d0
266  END IF
267  WRITE(*,*) 'mode ns', mode_cherche, ' not found'
268  ENDIF
269  ENDIF
270  CLOSE(10) !fermeture du fichier suite
271  ENDDO
272 
273  IF (present(opt_max_vel)) THEN
274  CALL mpi_allreduce(max_vel_loc, opt_max_vel, 1, mpi_double_precision, &
275  mpi_max, communicator(2), code)
276  END IF
277 
278  END SUBROUTINE read_restart_ns
279 
280  SUBROUTINE write_restart_maxwell(communicator, H_mesh, phi_mesh, time, list_mode, Hn, Hn1, Bn, Bn1, phin, phin1, &
281  filename, it, freq_restart, opt_mono)
282 
283  USE def_type_mesh
284  USE chaine_caractere
285  IMPLICIT NONE
286  include 'mpif.h'
287  TYPE(mesh_type), TARGET :: h_mesh,phi_mesh
288  INTEGER, DIMENSION(:), INTENT(IN) :: communicator
289  REAL(KIND=8), INTENT(IN) :: time
290  INTEGER, DIMENSION(:), INTENT(IN) :: list_mode
291  REAL(KIND=8), DIMENSION(:,:,:), INTENT(IN) :: hn, hn1, bn, bn1
292  REAL(KIND=8), DIMENSION(:,:,:), INTENT(IN) :: phin, phin1
293  CHARACTER(len=200), INTENT(IN) :: filename
294  INTEGER, INTENT(IN) :: it, freq_restart
295  LOGICAL, OPTIONAL, INTENT(IN) :: opt_mono
296 
297  INTEGER :: rang_s, rang_f, code, nb_procs_s, nb_procs_f, n, i
298  INTEGER :: l, lblank
299  CHARACTER(len=3) :: tit, tit_s
300  CHARACTER(len=250) :: out_name
301  LOGICAL :: mono=.false.
302  LOGICAL :: skip
303 
304  CALL mpi_comm_size(communicator(1),nb_procs_s,code)
305  CALL mpi_comm_size(communicator(2),nb_procs_f,code)
306  CALL mpi_comm_rank(communicator(1),rang_s,code)
307  CALL mpi_comm_rank(communicator(2),rang_f,code)
308 
309  WRITE(tit,'(i3)') it/freq_restart
310  lblank = eval_blank(3,tit)
311  DO l = 1, lblank - 1
312  tit(l:l) = '0'
313  END DO
314  WRITE(tit_s,'(i3)') rang_s
315  lblank = eval_blank(3,tit_s)
316  DO l = 1, lblank - 1
317  tit_s(l:l) = '0'
318  END DO
319 
320  IF (present(opt_mono)) THEN
321  mono = opt_mono
322  END IF
323 
324  IF (mono) THEN
325  out_name = 'suite_maxwell_I'//tit//'.'//filename
326  ELSE
327  out_name = 'suite_maxwell_S'//tit_s//'_I'//tit//'.'//filename
328  END IF
329  skip = (mono .AND. rang_s /= 0)
330 
331  DO n = 1, nb_procs_f
332  IF ( (rang_f == n-1) .AND. (.NOT. skip) ) THEN
333  IF (rang_f == 0) THEN
334  OPEN(unit = 10, file = out_name, position='append', &
335  form = 'unformatted', status = 'replace')
336  IF (mono) THEN
337  WRITE(10) time, h_mesh%np , phi_mesh%np , nb_procs_f, SIZE(list_mode)
338  ELSE
339  WRITE(10) time, nb_procs_s, nb_procs_f, SIZE(list_mode)
340  END IF
341  ELSE
342  OPEN(unit = 10, file = out_name, position='append', &
343  form = 'unformatted', status = 'unknown')
344  END IF
345  DO i= 1, SIZE(list_mode)
346  WRITE(10) list_mode(i)
347  IF (h_mesh%me /=0) THEN
348  WRITE(10) hn(:,:,i)
349  WRITE(10) hn1(:,:,i)
350  WRITE(10) bn(:,:,i)
351  WRITE(10) bn1(:,:,i)
352  ELSE
353  WRITE(10) 1
354  WRITE(10) 1
355  WRITE(10) 1
356  WRITE(10) 1
357  END IF
358  IF (phi_mesh%me /=0) THEN
359  WRITE(10) phin(:,:,i)
360  WRITE(10) phin1(:,:,i)
361  ELSE
362  WRITE(10) 1
363  WRITE(10) 1
364  END IF
365  END DO
366  CLOSE(10)
367  END IF
368  CALL mpi_barrier(communicator(2),code)
369  END DO
370 
371  END SUBROUTINE write_restart_maxwell
372 
373 
374  SUBROUTINE read_restart_maxwell(communicator, H_mesh, phi_mesh, time, list_mode, Hn, Hn1, Bn, Bn1, phin, phin1, &
375  filename, val_init, interpol, opt_mono)
376 
377  USE def_type_mesh
378  USE chaine_caractere
379  USE my_util
380 
381  IMPLICIT NONE
382 
383  include 'mpif.h'
384  TYPE(mesh_type), TARGET :: h_mesh,phi_mesh
385  INTEGER, DIMENSION(:), INTENT(IN) :: communicator
386  REAL(KIND=8), INTENT(OUT):: time
387  INTEGER, DIMENSION(:) :: list_mode
388  REAL(KIND=8), DIMENSION(:,:,:), INTENT(OUT):: hn, hn1, bn, bn1
389  REAL(KIND=8), DIMENSION(:,:,:), INTENT(OUT):: phin, phin1
390  CHARACTER(len=200), INTENT(IN) :: filename
391  REAL(KIND=8), OPTIONAL, INTENT(IN) :: val_init
392  LOGICAL , OPTIONAL, INTENT(IN) :: interpol
393  LOGICAL , OPTIONAL, INTENT(IN) :: opt_mono
394 
395  INTEGER :: code, n, i, mode, j, rang_s, rang_f, nb_procs_f, nb_procs_s
396  INTEGER :: m_max_cr, nb_procs_r, nb_procs_sr
397  INTEGER :: m_max_c, nb_mode_r, mode_cherche
398  LOGICAL :: trouve, okay
399  INTEGER :: nph, npp
400  INTEGER :: l, lblank
401  CHARACTER(len=3) :: tit_s
402  CHARACTER(len=250):: in_name
403  LOGICAL :: mono=.false.
404 
405  CALL mpi_comm_rank(communicator(2),rang_f,code)
406  CALL mpi_comm_size(communicator(2),nb_procs_f,code)
407  CALL mpi_comm_rank(communicator(1),rang_s,code)
408  CALL mpi_comm_size(communicator(1),nb_procs_s,code)
409 
410  WRITE(tit_s,'(i3)') rang_s
411  lblank = eval_blank(3,tit_s)
412  DO l = 1, lblank - 1
413  tit_s(l:l) = '0'
414  END DO
415  IF (present(opt_mono)) THEN
416  mono = opt_mono
417  END IF
418 
419  IF (mono) THEN
420  in_name = 'suite_maxwell.'//filename
421  ELSE
422  in_name = 'suite_maxwell_S'//tit_s//'.'//filename
423  END IF
424 
425  WRITE(*,*) 'restart Maxwell'
426  OPEN(unit = 10, file = in_name, form = 'unformatted', status = 'unknown')
427  IF (mono) THEN
428  READ(10) time, nph, npp, nb_procs_r, m_max_cr
429  ELSE
430  READ(10) time, nb_procs_sr, nb_procs_r, m_max_cr
431  END IF
432 
433  IF ((nb_procs_sr /= nb_procs_s) .AND. (.NOT. mono)) THEN
434  CALL error_petsc('BUG in read_restart: nb_procs_Sr /= nb_procs_S')
435  !STOP
436  END IF
437 
438  CLOSE(10)
439 
440  IF (rang_f == 0) THEN
441  WRITE(*,*) 'proprietes fichier ', in_name
442  WRITE(*,*) 'time =',time
443  WRITE(*,*) 'nombre de processeurs = ',nb_procs_r
444  WRITE(*,*) 'nombre de modes par processeur = ',m_max_cr
445  ENDIF
446 
447  m_max_c = SIZE(list_mode) !nombre de modes par proc pour le calcul
448  nb_mode_r = nb_procs_r*m_max_cr !nombre total de modes contenus dans le suite
449 
450  !June 7 2007, JLG
451  IF (nb_procs_f*m_max_c /= nb_mode_r) THEN
452  WRITE(*,*) ' BUG '
453  !STOP
454  END IF
455 
456  okay = .false.
457  IF (present(interpol)) THEN
458  IF (interpol) THEN
459  okay =.true.
460  END IF
461  END IF
462  !June 7 2007, JLG
463 
464  WRITE(*,*) 'Reading Maxwell modes ...'
465  DO i=1, m_max_c !pour tout les modes du processeur courant
466  !ouverture du fichier
467  OPEN(unit = 10, file = in_name, form = 'unformatted', status = 'unknown')
468  !on saute la premier ligne du fichier qui contient des donnes
469  READ(10)
470  mode_cherche = list_mode(i)
471  !recherche du bon mode
472  trouve = .false.
473  DO j=1, nb_mode_r !pour tout les modes ecris dans le suite.
474  !lecture du mode
475  READ(10) mode
476  !June 7 2007, JLG
477  IF (okay) THEN
478  IF (j/=rang_f*m_max_c+i) THEN
479  DO n=1, 6
480  READ(10)
481  ENDDO
482  cycle
483  ELSE
484  list_mode(i) = mode
485  mode_cherche = mode
486  END IF
487  END IF
488  !June 7 2007, JLG
489  IF (mode == mode_cherche) THEN !on a trouve le bon mode
490  IF (h_mesh%me /=0) THEN
491  READ(10) hn(:,:,i)
492  READ(10) hn1(:,:,i)
493  READ(10) bn(:,:,i)
494  READ(10) bn1(:,:,i)
495  ELSE
496  READ(10)
497  READ(10)
498  READ(10)
499  READ(10)
500  END IF
501  IF (phi_mesh%me /=0) THEN
502  READ(10) phin(:,:,i)
503  READ(10) phin1(:,:,i)
504  ELSE
505  READ(10)
506  READ(10)
507  END IF
508  WRITE(*,*) 'mode maxwell',mode_cherche,' trouve '
509  trouve = .true.
510  EXIT !car on a trouve le bon mode
511  ELSE !on passe au mode suivant en sautant 4 lignes
512  DO n=1, 6
513  READ(10)
514  ENDDO
515  ENDIF
516  ENDDO
517  IF (.NOT.trouve) THEN !mode_cherche non trouve
518  IF (present(val_init)) THEN
519  hn(:,:,i) = val_init ; hn1(:,:,i) = val_init
520  phin(:,:,i) = val_init ; phin1(:,:,i) = val_init
521  WRITE(*,*) 'mode maxwell',mode_cherche,' non trouve'
522  ELSE
523  hn(:,:,i) = 0.d0 ; hn1(:,:,i) = 0.d0
524  phin(:,:,i) = 0.d0 ; phin1(:,:,i) = 0.d0
525  WRITE(*,*) 'mode maxwell',mode_cherche,' non trouve'
526  ENDIF
527  ENDIF
528  CLOSE(10) !fermeture du fichier suite
529  ENDDO
530 
531  END SUBROUTINE read_restart_maxwell
532 
533 
534  SUBROUTINE write_restart_temp(communicator, temp_mesh, time, list_mode, &
535  tempn, tempn_m1, filename, it, freq_restart, opt_mono)
536 
537  USE def_type_mesh
538  USE chaine_caractere
539  IMPLICIT NONE
540  include 'mpif.h'
541  TYPE(mesh_type), TARGET :: temp_mesh
542  REAL(KIND=8), INTENT(IN) :: time
543  INTEGER, DIMENSION(:), INTENT(IN) :: communicator
544  INTEGER, DIMENSION(:), INTENT(IN) :: list_mode
545  REAL(KIND=8), DIMENSION(:,:,:), INTENT(IN) :: tempn, tempn_m1
546  LOGICAL, OPTIONAL, INTENT(IN) :: opt_mono
547  CHARACTER(len=200), INTENT(IN) :: filename
548  INTEGER, INTENT(IN) :: it, freq_restart
549  INTEGER :: code, n, i, rang_s, rang_f, nb_procs_s, nb_procs_f
550  INTEGER :: l, lblank
551  CHARACTER(len=3) :: tit, tit_s
552  LOGICAL :: mono=.false.
553  LOGICAL :: skip
554  CHARACTER(len=250) :: out_name
555 
556  CALL mpi_comm_size(communicator(1),nb_procs_s,code)
557  CALL mpi_comm_size(communicator(2),nb_procs_f,code)
558  CALL mpi_comm_rank(communicator(1),rang_s,code)
559  CALL mpi_comm_rank(communicator(2),rang_f,code)
560 
561  WRITE(tit,'(i3)') it/freq_restart
562  lblank = eval_blank(3,tit)
563  DO l = 1, lblank - 1
564  tit(l:l) = '0'
565  END DO
566  WRITE(tit_s,'(i3)') rang_s
567  lblank = eval_blank(3,tit_s)
568  DO l = 1, lblank - 1
569  tit_s(l:l) = '0'
570  END DO
571 
572  IF (present(opt_mono)) THEN
573  mono = opt_mono
574  END IF
575 
576  IF (mono) THEN
577  out_name = 'suite_temp_I'//tit//'.'//filename
578  ELSE
579  out_name = 'suite_temp_S'//tit_s//'_I'//tit//'.'//filename
580  END IF
581 
582  skip = (mono .AND. rang_s /= 0)
583 
584  DO n = 1, nb_procs_f
585  IF ( (rang_f == n-1) .AND. (.NOT. skip) ) THEN
586  IF (rang_f == 0) THEN
587  OPEN(unit = 10, file = out_name, position='append', &
588  form = 'unformatted', status = 'replace')
589  IF (mono) THEN
590  WRITE(10) time, temp_mesh%np , nb_procs_f, SIZE(list_mode)
591  ELSE
592  WRITE(10) time, nb_procs_s, nb_procs_f, SIZE(list_mode)
593  END IF
594  ELSE
595  OPEN(unit = 10, file = out_name, position='append', &
596  form = 'unformatted', status = 'unknown')
597  END IF
598 
599  DO i= 1, SIZE(list_mode)
600  WRITE(10) list_mode(i)
601  WRITE(10) tempn(:,:,i)
602  WRITE(10) tempn_m1(:,:,i)
603  END DO
604  CLOSE(10)
605  END IF
606  CALL mpi_barrier(communicator(2),code)
607  END DO
608 
609  END SUBROUTINE write_restart_temp
610 
611  SUBROUTINE read_restart_temp(communicator, time, list_mode, &
612  tempn, tempn_m1, filename, val_init, interpol, opt_mono)
613 
614  USE def_type_mesh
615  USE chaine_caractere
616  USE my_util
617  IMPLICIT NONE
618  include 'mpif.h'
619  REAL(KIND=8), INTENT(OUT):: time
620  INTEGER, DIMENSION(:), INTENT(IN) :: communicator
621  INTEGER, DIMENSION(:) :: list_mode
622  REAL(KIND=8), DIMENSION(:,:,:), INTENT(OUT):: tempn, tempn_m1
623  CHARACTER(len=200), INTENT(IN) :: filename
624  REAL(KIND=8), OPTIONAL, INTENT(IN) :: val_init
625  LOGICAL , OPTIONAL, INTENT(IN) :: interpol
626  LOGICAL , OPTIONAL, INTENT(IN) :: opt_mono
627  INTEGER :: code, n, i, mode, j, rang_s, nb_procs_s, rang_f, nb_procs_f, nlignes, rank
628  INTEGER :: m_max_cr, nb_procs_r, nb_procs_sr
629  INTEGER :: m_max_c, nb_mode_r, mode_cherche
630  LOGICAL :: trouve, okay
631  INTEGER :: np
632  INTEGER :: l, lblank
633  CHARACTER(len=3) :: tit_s
634  LOGICAL :: mono=.false.
635  CHARACTER(len=250):: in_name
636  CALL mpi_comm_rank(communicator(2),rang_f,code)
637  CALL mpi_comm_size(communicator(2),nb_procs_f,code)
638  CALL mpi_comm_rank(communicator(1),rang_s,code)
639  CALL mpi_comm_size(communicator(1),nb_procs_s,code)
640  CALL mpi_comm_rank(mpi_comm_world,rank,code)
641 
642  nlignes = 2
643 
644  WRITE(tit_s,'(i3)') rang_s
645  lblank = eval_blank(3,tit_s)
646  DO l = 1, lblank - 1
647  tit_s(l:l) = '0'
648  END DO
649 
650  IF (present(opt_mono)) THEN
651  mono = opt_mono
652  END IF
653 
654  IF (mono) THEN
655  in_name = 'suite_temp.'//filename
656  ELSE
657  in_name = 'suite_temp_S'//tit_s//'.'//filename
658  END IF
659 
660  WRITE(*,*) 'restart temperature'
661  OPEN(unit = 10, file = in_name, form = 'unformatted', status = 'unknown')
662 
663  IF (mono) THEN
664  READ(10) time, np, nb_procs_r, m_max_cr
665  nb_procs_sr = -1
666  ELSE
667  READ(10) time, nb_procs_sr, nb_procs_r, m_max_cr
668  END IF
669  CLOSE(10)
670 
671  IF ((nb_procs_sr /= nb_procs_s) .AND. (.NOT. mono)) THEN
672  CALL error_petsc('BUG in read_restart: nb_procs_Sr /= nb_procs_S')
673  !STOP
674  END IF
675 
676  IF (rang_f == 0) THEN
677  WRITE(*,*) 'File name', trim(adjustl(in_name))
678  WRITE(*,*) 'Time = ', time
679  WRITE(*,*) 'Number of processors from restart file = ',nb_procs_r
680  WRITE(*,*) 'Number of modes per processor from restart file = ',m_max_cr
681  ENDIF
682 
683  m_max_c = SIZE(list_mode) !nombre de modes par proc pour le calcul
684  nb_mode_r = nb_procs_r*m_max_cr !nombre total de modes contenus dans le suite
685 
686  !June 7 2007, JLG
687  IF (nb_procs_f*m_max_c /= nb_mode_r) THEN
688  !CALL error_petsc('Bug in read_restart_ns: nb_procs_F*m_max_c /= nb_mode_r')
689  WRITE(*,*) 'Warning in read_restart_temp: nb_procs_F*m_max_c /= nb_mode_r'
690  !STOP
691  END IF
692 
693  okay = .false.
694  IF (present(interpol)) THEN
695  IF (interpol) THEN
696  okay =.true.
697  END IF
698  END IF
699  !June 7 2007, JLG
700 
701  IF (rank==0) THEN
702  WRITE(*,*) 'Reading temperature modes ...'
703  END IF
704  DO i=1, m_max_c !pour tout les modes du processeur courant
705  !ouverture du fichier
706  OPEN(unit = 10, file = in_name, form = 'unformatted', status = 'unknown')
707  !on saute la premiere ligne du fichier qui contient des donnees
708  READ(10)
709  mode_cherche = list_mode(i)
710  !recherche du bon mode
711  trouve = .false.
712  DO j=1, nb_mode_r !pour tout les modes ecris dans le suite.
713  !lecture du mode
714  READ(10) mode
715  !June 7 2007, JLG
716  IF (okay) THEN
717  IF (j/=rang_f*m_max_c+i) THEN
718  DO n=1, nlignes
719  READ(10)
720  ENDDO
721  cycle
722  ELSE
723  list_mode(i) = mode
724  mode_cherche = mode
725  END IF
726  END IF
727  !June 7 2007, JLG
728  IF (mode == mode_cherche) THEN !on a trouve le bon mode
729  READ(10) tempn(:,:,i)
730  READ(10) tempn_m1(:,:,i)
731  WRITE(*,'(A,i4,A)') 'mode temp ', mode_cherche,' found '
732  trouve = .true.
733  EXIT !car on a trouve le bon mode
734  ELSE !on passe au mode suivant en sautant 6 lignes
735  DO n=1, nlignes
736  READ(10)
737  ENDDO
738  ENDIF
739  ENDDO
740 
741  IF (.NOT.trouve) THEN !mode_cherche non trouve
742  IF (present(val_init)) THEN ! not implemented yet
743  tempn(:,:,i) = val_init ; tempn_m1(:,:,i) = val_init
744  WRITE(*,'(A,i4,A)') 'mode temp', mode_cherche,' not found'
745  ELSE
746  tempn(:,:,i) = 0.d0 ; tempn_m1(:,:,i) = 0.d0
747  WRITE(*,*) 'mode ns', mode_cherche, ' not found'
748  ENDIF
749  ENDIF
750  CLOSE(10) !fermeture du fichier suite
751  ENDDO
752 
753  END SUBROUTINE read_restart_temp
754 
755 
756 END MODULE restart
757 
chaine_caractere::eval_blank
integer function eval_blank(len_str, string)
Definition: chaine_caractere_par.f90:32
restart::write_restart_maxwell
subroutine write_restart_maxwell(communicator, H_mesh, phi_mesh, time, list_mode, Hn, Hn1, Bn, Bn1, phin, phin1, filename, it, freq_restart, opt_mono)
Definition: restart.f90:280
restart::write_restart_ns
subroutine write_restart_ns(communicator, vv_mesh, pp_mesh, time, list_mode, un, un_m1, pn, pn_m1, incpn, incpn_m1, filename, it, freq_restart, opt_level_set, opt_level_set_m1, opt_max_vel, opt_mono)
Definition: restart.f90:8
def_type_mesh::mesh_type
Definition: def_type_mesh.f90:73
restart::write_restart_temp
subroutine write_restart_temp(communicator, temp_mesh, time, list_mode, tempn, tempn_m1, filename, it, freq_restart, opt_mono)
Definition: restart.f90:534
def_type_mesh
Definition: def_type_mesh.f90:4
my_util
Definition: my_util.f90:1
restart::read_restart_temp
subroutine read_restart_temp(communicator, time, list_mode, tempn, tempn_m1, filename, val_init, interpol, opt_mono)
Definition: restart.f90:611
restart::read_restart_ns
subroutine read_restart_ns(communicator, time, list_mode, un, un_m1, pn, pn_m1, incpn, incpn_m1, filename, val_init, interpol, opt_level_set, opt_level_set_m1, opt_max_vel, opt_mono)
Definition: restart.f90:99
chaine_caractere
Definition: chaine_caractere_par.f90:4
my_util::error_petsc
subroutine error_petsc(string)
Definition: my_util.f90:15
restart::read_restart_maxwell
subroutine read_restart_maxwell(communicator, H_mesh, phi_mesh, time, list_mode, Hn, Hn1, Bn, Bn1, phin, phin1, filename, val_init, interpol, opt_mono)
Definition: restart.f90:374
form
section doc_intro_frame_work_num_app Numerical approximation subsection doc_intro_fram_work_num_app_Fourier_FEM Fourier Finite element representation The SFEMaNS code uses a hybrid Fourier Finite element formulation The Fourier decomposition allows to approximate the problem’s solutions for each Fourier mode modulo nonlinear terms that are made explicit The variables are then approximated on a meridian section of the domain with a finite element method The numerical approximation of a function f $f f is written in the following generic form
Definition: doc_intro.h:193