SFEMaNS  version 5.3
Reference documentation for SFEMaNS
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, opt_dt)
11 
12  USE def_type_mesh
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, opt_dt
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 (PRESENT(opt_dt)) THEN
68  IF (mono) THEN
69  WRITE(10) time, vv_mesh%np , pp_mesh%np , nb_procs_f, SIZE(list_mode), opt_dt
70  ELSE
71  WRITE(10) time, nb_procs_s, nb_procs_f, SIZE(list_mode), opt_dt
72  END IF
73  ELSE
74  IF (mono) THEN
75  WRITE(10) time, vv_mesh%np , pp_mesh%np , nb_procs_f, SIZE(list_mode)
76  ELSE
77  WRITE(10) time, nb_procs_s, nb_procs_f, SIZE(list_mode)
78  END IF
79  END IF
80  ELSE
81  OPEN(unit = 10, file = out_name, position='append', &
82  form = 'unformatted', status = 'unknown')
83  END IF
84 
85  DO i= 1, SIZE(list_mode)
86  WRITE(10) list_mode(i)
87  WRITE(10) un(:,:,i)
88  WRITE(10) un_m1(:,:,i)
89  WRITE(10) pn(:,:,i)
90  WRITE(10) pn_m1(:,:,i)
91  WRITE(10) incpn(:,:,i)
92  WRITE(10) incpn_m1(:,:,i)
93  IF (PRESENT(opt_level_set) .AND. PRESENT(opt_level_set_m1)) THEN
94  WRITE(10) opt_level_set(:,:,:,i)
95  WRITE(10) opt_level_set_m1(:,:,:,i)
96  WRITE(10) opt_max_vel
97  END IF
98  END DO
99  CLOSE(10)
100  END IF
101  CALL mpi_barrier(communicator(2),code)
102  END DO
103 
104  END SUBROUTINE write_restart_ns
105 
106  SUBROUTINE read_restart_ns(communicator, time, list_mode, &
107  un, un_m1, pn, pn_m1, incpn, incpn_m1, filename, val_init, interpol, &
108  opt_level_set, opt_level_set_m1, opt_max_vel, opt_mono &
109  , opt_it, opt_dt) !===HF may 2020
111  USE def_type_mesh
112  USE chaine_caractere
113  USE my_util
114 !===HF may 2020
115  USE user_data
116 !===HF may 2020
117  IMPLICIT NONE
118  include 'mpif.h'
119  REAL(KIND=8), INTENT(OUT):: time
120  INTEGER, DIMENSION(:), INTENT(IN) :: communicator
121  INTEGER, DIMENSION(:) :: list_mode
122  REAL(KIND=8), DIMENSION(:,:,:), INTENT(OUT):: un, un_m1
123  REAL(KIND=8), DIMENSION(:,:,:), INTENT(OUT):: pn, pn_m1, incpn, incpn_m1
124  REAL(KIND=8), DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT):: opt_level_set, opt_level_set_m1
125  REAL(KIND=8), OPTIONAL, INTENT(OUT):: opt_max_vel
126  CHARACTER(len=200), INTENT(IN) :: filename
127  REAL(KIND=8), OPTIONAL, INTENT(IN) :: val_init
128  LOGICAL , OPTIONAL, INTENT(IN) :: interpol
129  LOGICAL , OPTIONAL, INTENT(IN) :: opt_mono
130  INTEGER , OPTIONAL, INTENT(IN) :: opt_it
131  REAL(KIND=8), OPTIONAL, INTENT(IN) :: opt_dt
132  REAL(KIND=8) :: max_vel_loc, dt_read, dt_ratio
133  INTEGER :: code, n, i, mode, j, rang_S, nb_procs_S, rang_F, nb_procs_F, nlignes, rank
134  INTEGER :: m_max_cr, nb_procs_r, nb_procs_Sr
135  INTEGER :: m_max_c, nb_mode_r, mode_cherche
136  LOGICAL :: trouve, okay
137  INTEGER :: npv, npp
138  INTEGER :: l, lblank
139  CHARACTER(len=3) :: tit_S
140 !===HF may 2020
141  CHARACTER(len=3) :: tit
142 !===HF may 2020
143  LOGICAL :: mono=.false.
144  CHARACTER(len=250):: in_name
145  CALL mpi_comm_rank(communicator(2),rang_f,code)
146  CALL mpi_comm_size(communicator(2),nb_procs_f,code)
147  CALL mpi_comm_rank(communicator(1),rang_s,code)
148  CALL mpi_comm_size(communicator(1),nb_procs_s,code)
149  CALL mpi_comm_rank(mpi_comm_world,rank,code)
150 
151  max_vel_loc = 0.d0
152 
153  nlignes = 6
154  IF (PRESENT(opt_level_set) .AND. PRESENT(opt_level_set_m1)) THEN
155  nlignes = nlignes + 3
156  END IF
157 
158 !=== HF may 2020
159  IF (PRESENT(opt_it)) THEN
160  WRITE(tit,'(i3)') opt_it
161  lblank = eval_blank(3,tit)
162  DO l = 1, lblank - 1
163  tit(l:l) = '0'
164  END DO
165  END IF
166 !=== HF may 2020
167 
168  WRITE(tit_s,'(i3)') rang_s
169  lblank = eval_blank(3,tit_s)
170  DO l = 1, lblank - 1
171  tit_s(l:l) = '0'
172  END DO
173 
174  IF (PRESENT(opt_mono)) THEN
175  mono = opt_mono
176  END IF
177 
178  IF (mono) THEN
179 !=== HF may 2020
180  IF (PRESENT(opt_it)) THEN
181  in_name = 'suite_ns_I'//tit//'.'//filename
182  ELSE
183  in_name = 'suite_ns.'//filename
184  END IF
185  ELSE
186  IF (PRESENT(opt_it)) THEN
187  in_name = 'suite_ns_S'//tit_s//'_I'//tit//'.'//filename
188  ELSE
189  in_name = 'suite_ns_S'//tit_s//'.'//filename
190  END IF
191 !=== HF may 2020
192  END IF
193 
194 !=== HF may 2020
195  IF (PRESENT(opt_it)) THEN
196  WRITE(*,*) 'restart Navier-Stokes for it', opt_it
197  ELSE
198  WRITE(*,*) 'restart Navier-Stokes'
199  END IF
200 !=== HF may 2020
201  OPEN(unit = 10, file = in_name, form = 'unformatted', status = 'unknown')
202 
203  IF (PRESENT(opt_dt)) THEN
204  IF (mono) THEN
205  READ(10) time, npv, npp, nb_procs_r, m_max_cr, dt_read
206  nb_procs_sr = -1
207  ELSE
208  READ(10) time, nb_procs_sr, nb_procs_r, m_max_cr, dt_read
209  END IF
210  ELSE
211  IF (mono) THEN
212  READ(10) time, npv, npp, nb_procs_r, m_max_cr
213  nb_procs_sr = -1
214  ELSE
215  READ(10) time, nb_procs_sr, nb_procs_r, m_max_cr
216  END IF
217  END IF
218 
219  CLOSE(10)
220 
221  IF ((nb_procs_sr /= nb_procs_s) .AND. (.NOT. mono)) THEN
222  CALL error_petsc('BUG in read_restart: nb_procs_Sr /= nb_procs_S')
223  !STOP
224  END IF
225 
226  IF (rang_f == 0) THEN
227  WRITE(*,*) 'File name', trim(adjustl(in_name))
228  WRITE(*,*) 'Time = ', time
229  WRITE(*,*) 'Number of processors from restart file = ',nb_procs_r
230  WRITE(*,*) 'Number of modes per processor from restart file = ',m_max_cr
231  ENDIF
232 
233  m_max_c = SIZE(list_mode) !nombre de modes par proc pour le calcul
234  nb_mode_r = nb_procs_r*m_max_cr !nombre total de modes contenus dans le suite
235 
236  !June 7 2007, JLG
237  IF (nb_procs_f*m_max_c /= nb_mode_r) THEN
238  !CALL error_petsc('Bug in read_restart_ns: nb_procs_F*m_max_c /= nb_mode_r')
239  WRITE(*,*) 'Warning in read_restart_ns: nb_procs_F*m_max_c /= nb_mode_r'
240  !STOP
241  END IF
242 
243  okay = .false.
244  IF (PRESENT(interpol)) THEN
245  IF (interpol) THEN
246  okay =.true.
247  END IF
248  END IF
249  !June 7 2007, JLG
250 
251  IF (rank==0) THEN
252  WRITE(*,*) 'Reading Navier-Stokes modes ...'
253  END IF
254  DO i=1, m_max_c !pour tout les modes du processeur courant
255  !ouverture du fichier
256  OPEN(unit = 10, file = in_name, form = 'unformatted', status = 'unknown')
257  !on saute la premiere ligne du fichier qui contient des donnees
258  READ(10)
259  mode_cherche = list_mode(i)
260  !recherche du bon mode
261  trouve = .false.
262  DO j=1, nb_mode_r !pour tout les modes ecris dans le suite.
263  !lecture du mode
264  READ(10) mode
265  !June 7 2007, JLG
266  IF (okay) THEN
267  IF (j/=rang_f*m_max_c+i) THEN
268  DO n=1, nlignes
269  READ(10)
270  ENDDO
271  cycle
272  ELSE
273  list_mode(i) = mode
274  mode_cherche = mode
275  END IF
276  END IF
277  !June 7 2007, JLG
278  IF (mode == mode_cherche) THEN !on a trouve le bon mode
279  READ(10) un(:,:,i)
280  READ(10) un_m1(:,:,i)
281  READ(10) pn(:,:,i)
282  READ(10) pn_m1(:,:,i)
283  READ(10) incpn(:,:,i)
284  READ(10) incpn_m1(:,:,i)
285  IF (PRESENT(opt_level_set) .AND. PRESENT(opt_level_set_m1)) THEN
286  READ(10) opt_level_set(:,:,:,i)
287  READ(10) opt_level_set_m1(:,:,:,i)
288  READ(10) max_vel_loc
289  END IF
290  WRITE(*,'(A,i4,A)') 'mode ns ', mode_cherche,' found '
291  trouve = .true.
292  EXIT !car on a trouve le bon mode
293  ELSE !on passe au mode suivant en sautant 6 lignes
294  DO n=1, nlignes
295  READ(10)
296  ENDDO
297  ENDIF
298  ENDDO
299 
300  IF (.NOT.trouve) THEN !mode_cherche non trouve
301  IF (PRESENT(val_init)) THEN ! not implemented yet
302  un(:,:,i) = val_init ; un_m1(:,:,i) = val_init
303  pn(:,:,i) = val_init ; pn_m1(:,:,i) = val_init
304  incpn(:,:,i) = val_init ; incpn_m1(:,:,i) = val_init
305  IF (PRESENT(opt_level_set) .AND. PRESENT(opt_level_set_m1)) THEN
306  opt_level_set(:,:,:,i) = val_init
307  opt_level_set_m1(:,:,:,i) = val_init
308  max_vel_loc = val_init
309  END IF
310  WRITE(*,'(A,i4,A)') 'mode ns', mode_cherche,' not found'
311  ELSE
312  un(:,:,i) = 0.d0 ; un_m1(:,:,i) = 0.d0
313  pn(:,:,i) = 0.d0 ; pn_m1(:,:,i) = 0.d0
314  incpn(:,:,i) = 0.d0 ; incpn_m1(:,:,i) = 0.d0
315  IF (PRESENT(opt_level_set) .AND. PRESENT(opt_level_set_m1)) THEN
316  opt_level_set(:,:,:,i)=0.d0
317  opt_level_set_m1(:,:,:,i)=0.d0
318  END IF
319  WRITE(*,*) 'mode ns', mode_cherche, ' not found'
320  ENDIF
321  ENDIF
322  CLOSE(10) !fermeture du fichier suite
323  ENDDO
324 
325  IF (PRESENT(opt_max_vel)) THEN
326  CALL mpi_allreduce(max_vel_loc, opt_max_vel, 1, mpi_double_precision, &
327  mpi_max, communicator(2), code)
328  END IF
329 
330 !
331  IF (PRESENT(opt_dt)) THEN
332  IF (abs((opt_dt - dt_read)/opt_dt).GT.1d-4) THEN
333  dt_ratio = opt_dt/dt_read
334  IF (rank==0) THEN
335  WRITE(*,*) 'In Navier-Stokes restart, suite_time_step different from inputs%dt ...'
336  WRITE(*,*) ' opt_dt, dt_read =', opt_dt, dt_read
337  END IF
338  un_m1 = dt_ratio * un_m1 +(1.d0 - dt_ratio)* un
339  pn_m1 = dt_ratio * pn_m1 +(1.d0 - dt_ratio)* pn
340  incpn_m1 = dt_ratio * incpn_m1 +(1.d0 - dt_ratio)* incpn
341  IF (PRESENT(opt_level_set) .AND. PRESENT(opt_level_set_m1)) THEN
342  opt_level_set_m1 = dt_ratio * opt_level_set_m1 +(1.d0 - dt_ratio)* opt_level_set
343  END IF
344  END IF
345  END IF
346 
347  END SUBROUTINE read_restart_ns
348 
349  SUBROUTINE write_restart_ns_taylor(communicator, vv_mesh, pp_mesh, time, list_mode, &
350  un, der_un, pn, der_pn, filename, it, freq_restart, &
351  opt_level_set, opt_level_set_m1, opt_max_vel, opt_mono)
353  USE def_type_mesh
354  USE chaine_caractere
355  IMPLICIT NONE
356  include 'mpif.h'
357  TYPE(mesh_type), TARGET :: vv_mesh,pp_mesh
358  REAL(KIND=8), INTENT(IN) :: time
359  INTEGER, DIMENSION(:), INTENT(IN) :: communicator
360  INTEGER, DIMENSION(:), INTENT(IN) :: list_mode
361  TYPE(dyn_real_array_three), DIMENSION(:), INTENT(IN) :: der_un
362  TYPE(dyn_real_array_three), DIMENSION(:), INTENT(IN) :: der_pn
363  REAL(KIND=8), DIMENSION(:,:,:), INTENT(IN) :: un
364  REAL(KIND=8), DIMENSION(:,:,:), INTENT(IN) :: pn
365  REAL(KIND=8), DIMENSION(:,:,:,:), OPTIONAL, INTENT(IN) :: opt_level_set, opt_level_set_m1
366  REAL(KIND=8), OPTIONAL, INTENT(IN) :: opt_max_vel
367  LOGICAL, OPTIONAL, INTENT(IN) :: opt_mono
368  CHARACTER(len=200), INTENT(IN) :: filename
369  INTEGER, INTENT(IN) :: it, freq_restart
370  INTEGER :: code, n, i, rang_S, rang_F, nb_procs_S, nb_procs_F
371  INTEGER :: l, lblank, kp
372  CHARACTER(len=3) :: tit, tit_S
373  LOGICAL :: mono=.false.
374  LOGICAL :: skip
375  CHARACTER(len=250) :: out_name
376 
377  CALL mpi_comm_size(communicator(1),nb_procs_s,code)
378  CALL mpi_comm_size(communicator(2),nb_procs_f,code)
379  CALL mpi_comm_rank(communicator(1),rang_s,code)
380  CALL mpi_comm_rank(communicator(2),rang_f,code)
381 
382  WRITE(tit,'(i3)') it/freq_restart
383  lblank = eval_blank(3,tit)
384  DO l = 1, lblank - 1
385  tit(l:l) = '0'
386  END DO
387  WRITE(tit_s,'(i3)') rang_s
388  lblank = eval_blank(3,tit_s)
389  DO l = 1, lblank - 1
390  tit_s(l:l) = '0'
391  END DO
392 
393  IF (PRESENT(opt_mono)) THEN
394  mono = opt_mono
395  END IF
396 
397  IF (mono) THEN
398  out_name = 'suite_ns_I'//tit//'.'//filename
399  ELSE
400  out_name = 'suite_ns_S'//tit_s//'_I'//tit//'.'//filename
401  END IF
402 
403  skip = (mono .AND. rang_s /= 0)
404 
405  DO n = 1, nb_procs_f
406  IF ( (rang_f == n-1) .AND. (.NOT. skip) ) THEN
407  IF (rang_f == 0) THEN
408  OPEN(unit = 10, file = out_name, position='append', &
409  form = 'unformatted', status = 'replace')
410  IF (mono) THEN
411  WRITE(10) time, vv_mesh%np , pp_mesh%np , nb_procs_f, SIZE(list_mode), inputs%taylor_order
412  ELSE
413  WRITE(10) time, nb_procs_s, nb_procs_f, SIZE(list_mode), inputs%taylor_order
414  END IF
415  ELSE
416  OPEN(unit = 10, file = out_name, position='append', &
417  form = 'unformatted', status = 'unknown')
418  END IF
419  DO i= 1, SIZE(list_mode)
420  WRITE(10) list_mode(i)
421  WRITE(10) un(:,:,i)
422  DO kp = 1, inputs%taylor_order-1
423  WRITE(10) der_un(kp)%DRT(:,:,i)
424  END DO
425  WRITE(10) pn(:,:,i)
426  DO kp = 1, inputs%taylor_order-1
427  WRITE(10) der_pn(kp)%DRT(:,:,i)
428  END DO
429  IF (PRESENT(opt_level_set) .AND. PRESENT(opt_level_set_m1)) THEN
430  WRITE(10) opt_level_set(:,:,:,i)
431  WRITE(10) opt_level_set_m1(:,:,:,i)
432  WRITE(10) opt_max_vel
433  END IF
434  END DO
435  CLOSE(10)
436  END IF
437  CALL mpi_barrier(communicator(2),code)
438  END DO
439 
440  END SUBROUTINE write_restart_ns_taylor
441 
442  SUBROUTINE read_restart_ns_taylor(communicator, time, list_mode, &
443  un, der_un, pn, der_pn, filename, val_init, interpol, &
444  opt_level_set, opt_level_set_m1, opt_max_vel, opt_mono, &
445  opt_it) !===HF may 2020
447  USE def_type_mesh
448  USE chaine_caractere
449  USE my_util
450 !===HF may 2020
451  USE user_data
452 !===HF may 2020
453  IMPLICIT NONE
454  include 'mpif.h'
455  REAL(KIND=8), INTENT(OUT):: time
456  INTEGER, DIMENSION(:), INTENT(IN) :: communicator
457  INTEGER, DIMENSION(:) :: list_mode
458  REAL(KIND=8), DIMENSION(:,:,:), INTENT(OUT):: un
459  REAL(KIND=8), DIMENSION(:,:,:), INTENT(OUT):: pn
460  TYPE(dyn_real_array_three), DIMENSION(:), INTENT(OUT):: der_un
461  TYPE(dyn_real_array_three), DIMENSION(:), INTENT(OUT):: der_pn
462  REAL(KIND=8), DIMENSION(:,:,:,:), OPTIONAL, INTENT(OUT):: opt_level_set, opt_level_set_m1
463  REAL(KIND=8), OPTIONAL, INTENT(OUT):: opt_max_vel
464  CHARACTER(len=200), INTENT(IN) :: filename
465  REAL(KIND=8), OPTIONAL, INTENT(IN) :: val_init
466  LOGICAL , OPTIONAL, INTENT(IN) :: interpol
467  LOGICAL , OPTIONAL, INTENT(IN) :: opt_mono
468  INTEGER , OPTIONAL, INTENT(IN) :: opt_it
469  REAL(KIND=8) :: max_vel_loc
470  INTEGER :: code, n, i, mode, j, rang_S, nb_procs_S, rang_F, nb_procs_F, nlignes, rank
471  INTEGER :: m_max_cr, nb_procs_r, nb_procs_Sr
472  INTEGER :: m_max_c, nb_mode_r, mode_cherche, taylor_order, taylor_order_min
473  LOGICAL :: trouve, okay
474  INTEGER :: npv, npp, kp
475  INTEGER :: l, lblank
476  CHARACTER(len=3) :: tit_S
477 !===HF may 2020
478  CHARACTER(len=3) :: tit
479 !===HF may 2020
480  LOGICAL :: mono=.false.
481  CHARACTER(len=250):: in_name
482  CALL mpi_comm_rank(communicator(2),rang_f,code)
483  CALL mpi_comm_size(communicator(2),nb_procs_f,code)
484  CALL mpi_comm_rank(communicator(1),rang_s,code)
485  CALL mpi_comm_size(communicator(1),nb_procs_s,code)
486  CALL mpi_comm_rank(mpi_comm_world,rank,code)
487 
488  max_vel_loc = 0.d0
489 
490  WRITE(tit_s,'(i3)') rang_s
491  lblank = eval_blank(3,tit_s)
492  DO l = 1, lblank - 1
493  tit_s(l:l) = '0'
494  END DO
495 
496 !=== HF may 2020
497  IF (PRESENT(opt_it)) THEN
498  WRITE(tit,'(i3)') opt_it
499  lblank = eval_blank(3,tit)
500  DO l = 1, lblank - 1
501  tit(l:l) = '0'
502  END DO
503  END IF
504 !=== HF may 2020
505 
506  IF (PRESENT(opt_mono)) THEN
507  mono = opt_mono
508  END IF
509 
510  IF (mono) THEN
511 !===HF may 2020
512  IF (PRESENT(opt_it)) THEN
513  in_name = 'suite_ns_I'//tit//'.'//filename
514  ELSE
515  in_name = 'suite_ns.'//filename
516  END IF
517  ELSE
518  IF (PRESENT(opt_it)) THEN
519  in_name = 'suite_ns_S'//tit_s//'_I'//tit//'.'//filename
520  ELSE
521  in_name = 'suite_ns_S'//tit_s//'.'//filename
522  END IF
523 !===HF may 2020
524  END IF
525 
526 !=== HF may 2020
527  IF (PRESENT(opt_it)) THEN
528  WRITE(*,*) 'restart Navier-Stokes for it', opt_it
529  ELSE
530  WRITE(*,*) 'restart Navier-Stokes'
531  END IF
532 !=== HF may 2020
533 
534  OPEN(unit = 10, file = in_name, form = 'unformatted', status = 'unknown')
535 
536  IF (mono) THEN
537  READ(10) time, npv, npp, nb_procs_r, m_max_cr, taylor_order
538  nb_procs_sr = -1
539  ELSE
540  READ(10) time, nb_procs_sr, nb_procs_r, m_max_cr, taylor_order
541  END IF
542  CLOSE(10)
543  taylor_order_min = min(inputs%taylor_order,taylor_order)
544 
545  nlignes = 2*taylor_order
546  IF (PRESENT(opt_level_set) .AND. PRESENT(opt_level_set_m1)) THEN
547  nlignes = nlignes + 3
548  END IF
549 
550  IF ((nb_procs_sr /= nb_procs_s) .AND. (.NOT. mono)) THEN
551  CALL error_petsc('BUG in read_restart: nb_procs_Sr /= nb_procs_S')
552  !STOP
553  END IF
554 
555  IF (rang_f == 0) THEN
556  WRITE(*,*) 'File name', trim(adjustl(in_name))
557  WRITE(*,*) 'Time = ', time
558  WRITE(*,*) 'Number of processors from restart file = ',nb_procs_r
559  WRITE(*,*) 'Number of modes per processor from restart file = ',m_max_cr
560  ENDIF
561 
562  m_max_c = SIZE(list_mode) !nombre de modes par proc pour le calcul
563  nb_mode_r = nb_procs_r*m_max_cr !nombre total de modes contenus dans le suite
564 
565  !June 7 2007, JLG
566  IF (nb_procs_f*m_max_c /= nb_mode_r) THEN
567  !CALL error_petsc('Bug in read_restart_ns: nb_procs_F*m_max_c /= nb_mode_r')
568  WRITE(*,*) 'Warning in read_restart_ns: nb_procs_F*m_max_c /= nb_mode_r'
569  !STOP
570  END IF
571 
572  okay = .false.
573  IF (PRESENT(interpol)) THEN
574  IF (interpol) THEN
575  okay =.true.
576  END IF
577  END IF
578  !June 7 2007, JLG
579 
580  IF (rank==0) THEN
581  WRITE(*,*) 'Reading Navier-Stokes modes ...'
582  END IF
583  DO i=1, m_max_c !pour tout les modes du processeur courant
584  !ouverture du fichier
585  OPEN(unit = 10, file = in_name, form = 'unformatted', status = 'unknown')
586  !on saute la premiere ligne du fichier qui contient des donnees
587  READ(10)
588  mode_cherche = list_mode(i)
589  !recherche du bon mode
590  trouve = .false.
591  DO j=1, nb_mode_r !pour tout les modes ecris dans le suite.
592  !lecture du mode
593  READ(10) mode
594  !June 7 2007, JLG
595  IF (okay) THEN
596  IF (j/=rang_f*m_max_c+i) THEN
597  DO n=1, nlignes
598  READ(10)
599  ENDDO
600  cycle
601  ELSE
602  list_mode(i) = mode
603  mode_cherche = mode
604  END IF
605  END IF
606  !June 7 2007, JLG
607  IF (mode == mode_cherche) THEN !on a trouve le bon mode
608  READ(10) un(:,:,i)
609  DO kp = 1, taylor_order_min-1
610  READ(10) der_un(kp)%DRT(:,:,i)
611  END DO
612  DO kp = taylor_order_min, taylor_order-1 !===inputs%taylor_order<taylor_order
613  READ(10) !===Read empty stuff
614  END DO
615  READ(10) pn(:,:,i)
616  DO kp = 1, taylor_order_min-1
617  READ(10) der_pn(kp)%DRT(:,:,i)
618  END DO
619  DO kp = taylor_order_min, taylor_order-1!===inputs%taylor_order<taylor_order
620  READ(10) !===Read empty stuff
621  END DO
622  DO kp = taylor_order_min , inputs%taylor_order-1 !===if taylor_order<inputs%taylor_order
623  der_un(kp)%DRT(:,:,i) = 0.d0
624  der_pn(kp)%DRT(:,:,i) = 0.d0
625  END DO
626  IF (PRESENT(opt_level_set) .AND. PRESENT(opt_level_set_m1)) THEN
627  READ(10) opt_level_set(:,:,:,i)
628  READ(10) opt_level_set_m1(:,:,:,i)
629  READ(10) max_vel_loc
630  END IF
631  WRITE(*,'(A,i4,A)') 'mode ns ', mode_cherche,' found '
632  trouve = .true.
633  EXIT !car on a trouve le bon mode
634  ELSE !on passe au mode suivant en sautant 6 lignes
635  DO n=1, nlignes
636  READ(10)
637  ENDDO
638  ENDIF
639  ENDDO
640 
641  IF (.NOT.trouve) THEN !mode_cherche non trouve
642  DO kp = 1, inputs%taylor_order-1
643  der_un(kp)%DRT(:,:,i) = 0.d0
644  der_pn(kp)%DRT(:,:,i) = 0.d0
645  END DO
646  IF (PRESENT(val_init)) THEN ! not implemented yet
647  un(:,:,i) = val_init
648  pn(:,:,i) = val_init
649  IF (PRESENT(opt_level_set) .AND. PRESENT(opt_level_set_m1)) THEN
650  opt_level_set(:,:,:,i) = val_init
651  opt_level_set_m1(:,:,:,i) = val_init
652  max_vel_loc = val_init
653  END IF
654  WRITE(*,'(A,i4,A)') 'mode ns', mode_cherche,' not found'
655  ELSE
656  un(:,:,i) = 0.d0
657  pn(:,:,i) = 0.d0
658  IF (PRESENT(opt_level_set) .AND. PRESENT(opt_level_set_m1)) THEN
659  opt_level_set(:,:,:,i)=0.d0
660  opt_level_set_m1(:,:,:,i)=0.d0
661  END IF
662  WRITE(*,*) 'mode ns', mode_cherche, ' not found'
663  ENDIF
664  ENDIF
665  CLOSE(10) !fermeture du fichier suite
666  ENDDO
667 
668  IF (PRESENT(opt_max_vel)) THEN
669  CALL mpi_allreduce(max_vel_loc, opt_max_vel, 1, mpi_double_precision, &
670  mpi_max, communicator(2), code)
671  END IF
672 
673  END SUBROUTINE read_restart_ns_taylor
674 
675  SUBROUTINE write_restart_maxwell(communicator, H_mesh, phi_mesh, time, list_mode, Hn, Hn1, Bn, Bn1, phin, phin1, &
676  filename, it, freq_restart, opt_mono, opt_dt)
678  USE def_type_mesh
679  USE chaine_caractere
680  IMPLICIT NONE
681  include 'mpif.h'
682  TYPE(mesh_type), TARGET :: H_mesh,phi_mesh
683  INTEGER, DIMENSION(:), INTENT(IN) :: communicator
684  REAL(KIND=8), INTENT(IN) :: time
685  INTEGER, DIMENSION(:), INTENT(IN) :: list_mode
686  REAL(KIND=8), DIMENSION(:,:,:), INTENT(IN) :: Hn, Hn1, Bn, Bn1
687  REAL(KIND=8), DIMENSION(:,:,:), INTENT(IN) :: phin, phin1
688  CHARACTER(len=200), INTENT(IN) :: filename
689  INTEGER, INTENT(IN) :: it, freq_restart
690  LOGICAL, OPTIONAL, INTENT(IN) :: opt_mono
691  REAL(KIND=8), OPTIONAL, INTENT(IN) :: opt_dt
692 
693  INTEGER :: rang_S, rang_F, code, nb_procs_S, nb_procs_F, n, i
694  INTEGER :: l, lblank
695  CHARACTER(len=3) :: tit, tit_S
696  CHARACTER(len=250) :: out_name
697  LOGICAL :: mono=.false.
698  LOGICAL :: skip
699 
700  CALL mpi_comm_size(communicator(1),nb_procs_s,code)
701  CALL mpi_comm_size(communicator(2),nb_procs_f,code)
702  CALL mpi_comm_rank(communicator(1),rang_s,code)
703  CALL mpi_comm_rank(communicator(2),rang_f,code)
704 
705  WRITE(tit,'(i3)') it/freq_restart
706  lblank = eval_blank(3,tit)
707  DO l = 1, lblank - 1
708  tit(l:l) = '0'
709  END DO
710  WRITE(tit_s,'(i3)') rang_s
711  lblank = eval_blank(3,tit_s)
712  DO l = 1, lblank - 1
713  tit_s(l:l) = '0'
714  END DO
715 
716  IF (PRESENT(opt_mono)) THEN
717  mono = opt_mono
718  END IF
719 
720  IF (mono) THEN
721  out_name = 'suite_maxwell_I'//tit//'.'//filename
722  ELSE
723  out_name = 'suite_maxwell_S'//tit_s//'_I'//tit//'.'//filename
724  END IF
725  skip = (mono .AND. rang_s /= 0)
726 
727  DO n = 1, nb_procs_f
728  IF ( (rang_f == n-1) .AND. (.NOT. skip) ) THEN
729  IF (rang_f == 0) THEN
730  OPEN(unit = 10, file = out_name, position='append', &
731  form = 'unformatted', status = 'replace')
732  IF (PRESENT(opt_dt)) THEN
733  IF (mono) THEN
734  WRITE(10) time, h_mesh%np , phi_mesh%np , nb_procs_f, SIZE(list_mode), opt_dt
735  ELSE
736  WRITE(10) time, nb_procs_s, nb_procs_f, SIZE(list_mode), opt_dt
737  END IF
738  ELSE
739  IF (mono) THEN
740  WRITE(10) time, h_mesh%np , phi_mesh%np , nb_procs_f, SIZE(list_mode)
741  ELSE
742  WRITE(10) time, nb_procs_s, nb_procs_f, SIZE(list_mode)
743  END IF
744  END IF
745  ELSE
746  OPEN(unit = 10, file = out_name, position='append', &
747  form = 'unformatted', status = 'unknown')
748  END IF
749  DO i= 1, SIZE(list_mode)
750  WRITE(10) list_mode(i)
751  IF (h_mesh%me /=0) THEN
752  WRITE(10) hn(:,:,i)
753  WRITE(10) hn1(:,:,i)
754  WRITE(10) bn(:,:,i)
755  WRITE(10) bn1(:,:,i)
756  ELSE
757  WRITE(10) 1
758  WRITE(10) 1
759  WRITE(10) 1
760  WRITE(10) 1
761  END IF
762  IF (phi_mesh%me /=0) THEN
763  WRITE(10) phin(:,:,i)
764  WRITE(10) phin1(:,:,i)
765  ELSE
766  WRITE(10) 1
767  WRITE(10) 1
768  END IF
769  END DO
770  CLOSE(10)
771  END IF
772  CALL mpi_barrier(communicator(2),code)
773  END DO
774 
775  END SUBROUTINE write_restart_maxwell
776 
777 
778  SUBROUTINE read_restart_maxwell(communicator, H_mesh, phi_mesh, time, list_mode, Hn, Hn1, Bn, Bn1, phin, phin1, &
779  filename, val_init, interpol, opt_mono &
780  , opt_it, opt_dt) !===HF may 2020
782  USE def_type_mesh
783  USE chaine_caractere
784  USE my_util
785 !===HF may 2020
786  USE user_data
787 !===HF may 2020
788 
789  IMPLICIT NONE
790 
791  include 'mpif.h'
792  TYPE(mesh_type), TARGET :: H_mesh,phi_mesh
793  INTEGER, DIMENSION(:), INTENT(IN) :: communicator
794  REAL(KIND=8), INTENT(OUT):: time
795  INTEGER, DIMENSION(:) :: list_mode
796  REAL(KIND=8), DIMENSION(:,:,:), INTENT(OUT):: Hn, Hn1, Bn, Bn1
797  REAL(KIND=8), DIMENSION(:,:,:), INTENT(OUT):: phin, phin1
798  CHARACTER(len=200), INTENT(IN):: filename
799  REAL(KIND=8), OPTIONAL, INTENT(IN) :: val_init
800  LOGICAL , OPTIONAL, INTENT(IN) :: interpol
801  LOGICAL , OPTIONAL, INTENT(IN) :: opt_mono
802 !===HF may 2020
803  INTEGER , OPTIONAL, INTENT(IN) :: opt_it
804 !===HF may 2020
805  REAL(KIND=8), OPTIONAL, INTENT(IN) :: opt_dt
806  REAL(KIND=8) :: dt_read, dt_ratio
807 
808  INTEGER :: code, n, i, mode, j, rang_S, rang_F, nb_procs_F, nb_procs_S, rank
809  INTEGER :: m_max_cr, nb_procs_r, nb_procs_Sr
810  INTEGER :: m_max_c, nb_mode_r, mode_cherche
811  LOGICAL :: trouve, okay
812  INTEGER :: nph, npp
813  INTEGER :: l, lblank
814  CHARACTER(len=3) :: tit_S
815 !===HF may 2020
816  CHARACTER(len=3) :: tit
817 !===HF may 2020
818  CHARACTER(len=250):: in_name
819  LOGICAL :: mono=.false.
820 
821  CALL mpi_comm_rank(communicator(2),rang_f,code)
822  CALL mpi_comm_size(communicator(2),nb_procs_f,code)
823  CALL mpi_comm_rank(communicator(1),rang_s,code)
824  CALL mpi_comm_size(communicator(1),nb_procs_s,code)
825  CALL mpi_comm_rank(mpi_comm_world,rank,code)
826 
827 !=== HF may 2020
828  IF (PRESENT(opt_it)) THEN
829  WRITE(tit,'(i3)') opt_it
830  lblank = eval_blank(3,tit)
831  DO l = 1, lblank - 1
832  tit(l:l) = '0'
833  END DO
834  END IF
835 !=== HF may 2020
836 
837  WRITE(tit_s,'(i3)') rang_s
838  lblank = eval_blank(3,tit_s)
839  DO l = 1, lblank - 1
840  tit_s(l:l) = '0'
841  END DO
842  IF (PRESENT(opt_mono)) THEN
843  mono = opt_mono
844  END IF
845 
846  IF (mono) THEN
847 !=== HF may 2020
848  IF (PRESENT(opt_it)) THEN
849  in_name = 'suite_maxwell_I'//tit//'.'//filename
850  ELSE
851  in_name = 'suite_maxwell.'//filename
852  END IF
853  ELSE
854  IF (PRESENT(opt_it)) THEN
855  in_name = 'suite_maxwell_S'//tit_s//'_I'//tit//'.'//filename
856  ELSE
857  in_name = 'suite_maxwell_S'//tit_s//'.'//filename
858  END IF
859 !=== HF may 2020
860  END IF
861 
862 !=== HF may 2020
863  IF (PRESENT(opt_it)) THEN
864  WRITE(*,*) 'restart Maxwell for it', opt_it
865  ELSE
866  WRITE(*,*) 'restart Maxwell'
867  END IF
868 !=== HF may 2020
869 
870  OPEN(unit = 10, file = in_name, form = 'unformatted', status = 'unknown')
871  IF (PRESENT(opt_dt)) THEN
872  IF (mono) THEN
873  READ(10) time, nph, npp, nb_procs_r, m_max_cr, dt_read
874  ELSE
875  READ(10) time, nb_procs_sr, nb_procs_r, m_max_cr, dt_read
876  END IF
877  ELSE
878  IF (mono) THEN
879  READ(10) time, nph, npp, nb_procs_r, m_max_cr
880  ELSE
881  READ(10) time, nb_procs_sr, nb_procs_r, m_max_cr
882  END IF
883  END IF
884 
885  IF ((nb_procs_sr /= nb_procs_s) .AND. (.NOT. mono)) THEN
886  CALL error_petsc('BUG in read_restart: nb_procs_Sr /= nb_procs_S')
887  !STOP
888  END IF
889 
890  CLOSE(10)
891 
892  IF (rang_f == 0) THEN
893  WRITE(*,*) 'proprietes fichier ', in_name
894  WRITE(*,*) 'time =',time
895  WRITE(*,*) 'nombre de processeurs = ',nb_procs_r
896  WRITE(*,*) 'nombre de modes par processeur = ',m_max_cr
897  ENDIF
898 
899  m_max_c = SIZE(list_mode) !nombre de modes par proc pour le calcul
900  nb_mode_r = nb_procs_r*m_max_cr !nombre total de modes contenus dans le suite
901 
902  !June 7 2007, JLG
903  IF (nb_procs_f*m_max_c /= nb_mode_r) THEN
904  WRITE(*,*) 'Warning in read_restart_maxwell: nb_procs_F*m_max_c /= nb_mode_r'
905  !STOP
906  END IF
907 
908  okay = .false.
909  IF (PRESENT(interpol)) THEN
910  IF (interpol) THEN
911  okay =.true.
912  END IF
913  END IF
914  !June 7 2007, JLG
915 
916  IF (rank==0) THEN
917  WRITE(*,*) 'Reading Maxwell modes ...'
918  END IF
919  DO i=1, m_max_c !pour tout les modes du processeur courant
920  !ouverture du fichier
921  OPEN(unit = 10, file = in_name, form = 'unformatted', status = 'unknown')
922  !on saute la premier ligne du fichier qui contient des donnes
923  READ(10)
924  mode_cherche = list_mode(i)
925  !recherche du bon mode
926  trouve = .false.
927  DO j=1, nb_mode_r !pour tout les modes ecris dans le suite.
928  !lecture du mode
929  READ(10) mode
930  !June 7 2007, JLG
931  IF (okay) THEN
932  IF (j/=rang_f*m_max_c+i) THEN
933  DO n=1, 6
934  READ(10)
935  ENDDO
936  cycle
937  ELSE
938  list_mode(i) = mode
939  mode_cherche = mode
940  END IF
941  END IF
942  !June 7 2007, JLG
943  IF (mode == mode_cherche) THEN !on a trouve le bon mode
944  IF (h_mesh%me /=0) THEN
945  READ(10) hn(:,:,i)
946  READ(10) hn1(:,:,i)
947  READ(10) bn(:,:,i)
948  READ(10) bn1(:,:,i)
949  ELSE
950  READ(10)
951  READ(10)
952  READ(10)
953  READ(10)
954  END IF
955  IF (phi_mesh%me /=0) THEN
956  READ(10) phin(:,:,i)
957  READ(10) phin1(:,:,i)
958  ELSE
959  READ(10)
960  READ(10)
961  END IF
962  WRITE(*,*) 'mode maxwell',mode_cherche,' trouve '
963  trouve = .true.
964  EXIT !car on a trouve le bon mode
965  ELSE !on passe au mode suivant en sautant 4 lignes
966  DO n=1, 6
967  READ(10)
968  ENDDO
969  ENDIF
970  ENDDO
971  IF (.NOT.trouve) THEN !mode_cherche non trouve
972  IF (PRESENT(val_init)) THEN
973  hn(:,:,i) = val_init ; hn1(:,:,i) = val_init
974  bn(:,:,i) = val_init ; bn1(:,:,i) = val_init
975  phin(:,:,i) = val_init ; phin1(:,:,i) = val_init
976  WRITE(*,*) 'mode maxwell',mode_cherche,' non trouve'
977  ELSE
978  hn(:,:,i) = 0.d0 ; hn1(:,:,i) = 0.d0
979  bn(:,:,i) = 0.d0 ; bn1(:,:,i) = 0.d0
980  phin(:,:,i) = 0.d0 ; phin1(:,:,i) = 0.d0
981  WRITE(*,*) 'mode maxwell',mode_cherche,' non trouve'
982  ENDIF
983  ENDIF
984  CLOSE(10) !fermeture du fichier suite
985  ENDDO
986 !
987  IF (PRESENT(opt_dt)) THEN
988  IF (abs((opt_dt - dt_read)/opt_dt).GT.1d-4) THEN
989  dt_ratio = opt_dt/dt_read
990  IF (rank==0) THEN
991  WRITE(*,*) 'In Maxwell restart, suite_time_step different from inputs%dt ...'
992  WRITE(*,*) ' opt_dt, dt_read =', opt_dt, dt_read
993  END IF
994  hn1 = dt_ratio * hn1 +(1.d0 - dt_ratio)* hn
995  bn1 = dt_ratio * bn1 +(1.d0 - dt_ratio)* bn
996  phin1 = dt_ratio * phin1 +(1.d0 - dt_ratio)* phin
997  END IF
998  END IF
999  END SUBROUTINE read_restart_maxwell
1000 
1001 
1002  SUBROUTINE write_restart_temp(communicator, temp_mesh, time, list_mode, &
1003  tempn, tempn_m1, filename, it, freq_restart, opt_mono)
1005  USE def_type_mesh
1006  USE chaine_caractere
1007  IMPLICIT NONE
1008  include 'mpif.h'
1009  TYPE(mesh_type), TARGET :: temp_mesh
1010  REAL(KIND=8), INTENT(IN) :: time
1011  INTEGER, DIMENSION(:), INTENT(IN) :: communicator
1012  INTEGER, DIMENSION(:), INTENT(IN) :: list_mode
1013  REAL(KIND=8), DIMENSION(:,:,:), INTENT(IN) :: tempn, tempn_m1
1014  LOGICAL, OPTIONAL, INTENT(IN) :: opt_mono
1015  CHARACTER(len=200), INTENT(IN) :: filename
1016  INTEGER, INTENT(IN) :: it, freq_restart
1017  INTEGER :: code, n, i, rang_S, rang_F, nb_procs_S, nb_procs_F
1018  INTEGER :: l, lblank
1019  CHARACTER(len=3) :: tit, tit_S
1020  LOGICAL :: mono=.false.
1021  LOGICAL :: skip
1022  CHARACTER(len=250) :: out_name
1023 
1024  CALL mpi_comm_size(communicator(1),nb_procs_s,code)
1025  CALL mpi_comm_size(communicator(2),nb_procs_f,code)
1026  CALL mpi_comm_rank(communicator(1),rang_s,code)
1027  CALL mpi_comm_rank(communicator(2),rang_f,code)
1028 
1029  WRITE(tit,'(i3)') it/freq_restart
1030  lblank = eval_blank(3,tit)
1031  DO l = 1, lblank - 1
1032  tit(l:l) = '0'
1033  END DO
1034  WRITE(tit_s,'(i3)') rang_s
1035  lblank = eval_blank(3,tit_s)
1036  DO l = 1, lblank - 1
1037  tit_s(l:l) = '0'
1038  END DO
1039 
1040  IF (PRESENT(opt_mono)) THEN
1041  mono = opt_mono
1042  END IF
1043 
1044  IF (mono) THEN
1045  out_name = 'suite_temp_I'//tit//'.'//filename
1046  ELSE
1047  out_name = 'suite_temp_S'//tit_s//'_I'//tit//'.'//filename
1048  END IF
1049 
1050  skip = (mono .AND. rang_s /= 0)
1051 
1052  DO n = 1, nb_procs_f
1053  IF ( (rang_f == n-1) .AND. (.NOT. skip) ) THEN
1054  IF (rang_f == 0) THEN
1055  OPEN(unit = 10, file = out_name, position='append', &
1056  form = 'unformatted', status = 'replace')
1057  IF (mono) THEN
1058  WRITE(10) time, temp_mesh%np , nb_procs_f, SIZE(list_mode)
1059  ELSE
1060  WRITE(10) time, nb_procs_s, nb_procs_f, SIZE(list_mode)
1061  END IF
1062  ELSE
1063  OPEN(unit = 10, file = out_name, position='append', &
1064  form = 'unformatted', status = 'unknown')
1065  END IF
1066 
1067  DO i= 1, SIZE(list_mode)
1068  WRITE(10) list_mode(i)
1069  WRITE(10) tempn(:,:,i)
1070  WRITE(10) tempn_m1(:,:,i)
1071  END DO
1072  CLOSE(10)
1073  END IF
1074  CALL mpi_barrier(communicator(2),code)
1075  END DO
1076 
1077  END SUBROUTINE write_restart_temp
1078 
1079  SUBROUTINE read_restart_temp(communicator, time, list_mode, &
1080  tempn, tempn_m1, filename, val_init, interpol, opt_mono)
1082  USE def_type_mesh
1083  USE chaine_caractere
1084  USE my_util
1085  IMPLICIT NONE
1086  include 'mpif.h'
1087  REAL(KIND=8), INTENT(OUT):: time
1088  INTEGER, DIMENSION(:), INTENT(IN) :: communicator
1089  INTEGER, DIMENSION(:) :: list_mode
1090  REAL(KIND=8), DIMENSION(:,:,:), INTENT(OUT):: tempn, tempn_m1
1091  CHARACTER(len=200), INTENT(IN) :: filename
1092  REAL(KIND=8), OPTIONAL, INTENT(IN) :: val_init
1093  LOGICAL , OPTIONAL, INTENT(IN) :: interpol
1094  LOGICAL , OPTIONAL, INTENT(IN) :: opt_mono
1095  INTEGER :: code, n, i, mode, j, rang_S, nb_procs_S, rang_F, nb_procs_F, nlignes, rank
1096  INTEGER :: m_max_cr, nb_procs_r, nb_procs_Sr
1097  INTEGER :: m_max_c, nb_mode_r, mode_cherche
1098  LOGICAL :: trouve, okay
1099  INTEGER :: np
1100  INTEGER :: l, lblank
1101  CHARACTER(len=3) :: tit_S
1102  LOGICAL :: mono=.false.
1103  CHARACTER(len=250):: in_name
1104  CALL mpi_comm_rank(communicator(2),rang_f,code)
1105  CALL mpi_comm_size(communicator(2),nb_procs_f,code)
1106  CALL mpi_comm_rank(communicator(1),rang_s,code)
1107  CALL mpi_comm_size(communicator(1),nb_procs_s,code)
1108  CALL mpi_comm_rank(mpi_comm_world,rank,code)
1109 
1110  nlignes = 2
1111 
1112  WRITE(tit_s,'(i3)') rang_s
1113  lblank = eval_blank(3,tit_s)
1114  DO l = 1, lblank - 1
1115  tit_s(l:l) = '0'
1116  END DO
1117 
1118  IF (PRESENT(opt_mono)) THEN
1119  mono = opt_mono
1120  END IF
1121 
1122  IF (mono) THEN
1123  in_name = 'suite_temp.'//filename
1124  ELSE
1125  in_name = 'suite_temp_S'//tit_s//'.'//filename
1126  END IF
1127 
1128  WRITE(*,*) 'restart temperature'
1129  OPEN(unit = 10, file = in_name, form = 'unformatted', status = 'unknown')
1130 
1131  IF (mono) THEN
1132  READ(10) time, np, nb_procs_r, m_max_cr
1133  nb_procs_sr = -1
1134  ELSE
1135  READ(10) time, nb_procs_sr, nb_procs_r, m_max_cr
1136  END IF
1137  CLOSE(10)
1138 
1139  IF ((nb_procs_sr /= nb_procs_s) .AND. (.NOT. mono)) THEN
1140  CALL error_petsc('BUG in read_restart: nb_procs_Sr /= nb_procs_S')
1141  !STOP
1142  END IF
1143 
1144  IF (rang_f == 0) THEN
1145  WRITE(*,*) 'File name', trim(adjustl(in_name))
1146  WRITE(*,*) 'Time = ', time
1147  WRITE(*,*) 'Number of processors from restart file = ',nb_procs_r
1148  WRITE(*,*) 'Number of modes per processor from restart file = ',m_max_cr
1149  ENDIF
1150 
1151  m_max_c = SIZE(list_mode) !nombre de modes par proc pour le calcul
1152  nb_mode_r = nb_procs_r*m_max_cr !nombre total de modes contenus dans le suite
1153 
1154  !June 7 2007, JLG
1155  IF (nb_procs_f*m_max_c /= nb_mode_r) THEN
1156  !CALL error_petsc('Bug in read_restart_ns: nb_procs_F*m_max_c /= nb_mode_r')
1157  WRITE(*,*) 'Warning in read_restart_temp: nb_procs_F*m_max_c /= nb_mode_r'
1158  !STOP
1159  END IF
1160 
1161  okay = .false.
1162  IF (PRESENT(interpol)) THEN
1163  IF (interpol) THEN
1164  okay =.true.
1165  END IF
1166  END IF
1167  !June 7 2007, JLG
1168 
1169  IF (rank==0) THEN
1170  WRITE(*,*) 'Reading temperature modes ...'
1171  END IF
1172  DO i=1, m_max_c !pour tout les modes du processeur courant
1173  !ouverture du fichier
1174  OPEN(unit = 10, file = in_name, form = 'unformatted', status = 'unknown')
1175  !on saute la premiere ligne du fichier qui contient des donnees
1176  READ(10)
1177  mode_cherche = list_mode(i)
1178  !recherche du bon mode
1179  trouve = .false.
1180  DO j=1, nb_mode_r !pour tout les modes ecris dans le suite.
1181  !lecture du mode
1182  READ(10) mode
1183  !June 7 2007, JLG
1184  IF (okay) THEN
1185  IF (j/=rang_f*m_max_c+i) THEN
1186  DO n=1, nlignes
1187  READ(10)
1188  ENDDO
1189  cycle
1190  ELSE
1191  list_mode(i) = mode
1192  mode_cherche = mode
1193  END IF
1194  END IF
1195  !June 7 2007, JLG
1196  IF (mode == mode_cherche) THEN !on a trouve le bon mode
1197  READ(10) tempn(:,:,i)
1198  READ(10) tempn_m1(:,:,i)
1199  WRITE(*,'(A,i4,A)') 'mode temp ', mode_cherche,' found '
1200  trouve = .true.
1201  EXIT !car on a trouve le bon mode
1202  ELSE !on passe au mode suivant en sautant 6 lignes
1203  DO n=1, nlignes
1204  READ(10)
1205  ENDDO
1206  ENDIF
1207  ENDDO
1208 
1209  IF (.NOT.trouve) THEN !mode_cherche non trouve
1210  IF (PRESENT(val_init)) THEN ! not implemented yet
1211  tempn(:,:,i) = val_init ; tempn_m1(:,:,i) = val_init
1212  WRITE(*,'(A,i4,A)') 'mode temp', mode_cherche,' not found'
1213  ELSE
1214  tempn(:,:,i) = 0.d0 ; tempn_m1(:,:,i) = 0.d0
1215  WRITE(*,*) 'mode ns', mode_cherche, ' not found'
1216  ENDIF
1217  ENDIF
1218  CLOSE(10) !fermeture du fichier suite
1219  ENDDO
1220 
1221  END SUBROUTINE read_restart_temp
1222 
1223 
1224 END MODULE restart
1225 
subroutine write_restart_ns_taylor(communicator, vv_mesh, pp_mesh, time, list_mode, un, der_un, pn, der_pn, filename, it, freq_restart, opt_level_set, opt_level_set_m1, opt_max_vel, opt_mono)
Definition: restart.f90:352
subroutine write_restart_temp(communicator, temp_mesh, time, list_mode, tempn, tempn_m1, filename, it, freq_restart, opt_mono)
Definition: restart.f90:1004
subroutine read_restart_ns_taylor(communicator, time, list_mode, un, der_un, pn, der_pn, filename, val_init, interpol, opt_level_set, opt_level_set_m1, opt_max_vel, opt_mono, opt_it)
Definition: restart.f90:446
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, opt_it, opt_dt)
Definition: restart.f90:110
subroutine error_petsc(string)
Definition: my_util.f90:16
type(my_data), public inputs
subroutine read_restart_maxwell(communicator, H_mesh, phi_mesh, time, list_mode, Hn, Hn1, Bn, Bn1, phin, phin1, filename, val_init, interpol, opt_mono, opt_it, opt_dt)
Definition: restart.f90:781
integer function eval_blank(len_str, string)
subroutine write_restart_maxwell(communicator, H_mesh, phi_mesh, time, list_mode, Hn, Hn1, Bn, Bn1, phin, phin1, filename, it, freq_restart, opt_mono, opt_dt)
Definition: restart.f90:677
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, opt_dt)
Definition: restart.f90:11
subroutine read_restart_temp(communicator, time, list_mode, tempn, tempn_m1, filename, val_init, interpol, opt_mono)
Definition: restart.f90:1081
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:190