4 SUBROUTINE backup_suite(type_fic, filename, n_it, rank, is_sequential)
7 CHARACTER(len=3),
INTENT(IN) :: type_fic
8 CHARACTER(len=200),
INTENT(IN) :: filename
9 INTEGER,
INTENT(IN) :: n_it, rank
10 LOGICAL,
INTENT(IN) :: is_sequential
12 CHARACTER(len=3) :: tit_s, tit
13 CHARACTER(len=5) :: name_it, name_dom
15 CHARACTER(len=200) :: cmd, dir_out
17 WRITE(tit_s,
'(i3)') rank
22 IF (is_sequential)
THEN
24 dir_out=
'NON_PETSC_OUT/'
29 WRITE(tit,
'(i3)') n_it
35 IF (type_fic==
'mxw')
THEN
36 cmd =
'mv suite_maxwell'
37 ELSE IF (type_fic==
'nst')
THEN
40 WRITE(*,*)
'WARNING: exit without doing anything (backup_suite)'
44 cmd = trim(adjustl(cmd))//trim(adjustl(name_dom))//name_it//
'.'//trim(adjustl(filename))
45 WRITE(*,*)
'('//trim(adjustl(cmd))//
')'
47 IF (is_sequential)
THEN
48 IF (rank==0) CALL system(trim(adjustl(cmd))//
' '//trim(adjustl(dir_out)))
50 CALL system(trim(adjustl(cmd))//
' '//trim(adjustl(dir_out)))
57 INTEGER,
DIMENSION(:) :: cont
58 INTEGER,
DIMENSION(:),
ALLOCATABLE :: tmp
60 #include "petsc/finclude/petsc.h"
62 petscerrorcode :: ierr
67 CALL mpi_allreduce(cont, tmp, np, mpi_integer, mpi_sum, comm, ierr)
75 REAL(KIND=8),
DIMENSION(:,:,:) :: field
76 REAL(KIND=8),
DIMENSION(:,:,:),
ALLOCATABLE :: tmp
77 INTEGER :: np, i, j, n2, n3
78 INTEGER,
DIMENSION(:),
OPTIONAL :: cont
79 #include "petsc/finclude/petsc.h"
81 petscerrorcode :: ierr
87 ALLOCATE(tmp(np, n2, n3))
92 CALL mpi_allreduce(field(:,i,j), tmp(:,i,j), np, mpi_double_precision, mpi_sum, comm, ierr)
95 IF (present(cont))
THEN
98 field(:,i,j) = tmp(:,i,j)/cont(:)
115 REAL(KIND=8),
DIMENSION(:,:,:) :: in_field, out_field
116 INTEGER,
DIMENSION(:) :: l_t_g
118 INTEGER :: i2, i3, n1, n2, n3, m1, n
122 n1 =
SIZE(in_field,1)
123 m1 =
SIZE(out_field, 1)
124 n2 =
SIZE(in_field, 2)
125 n3 =
SIZE(in_field, 3)
130 out_field(l_t_g(1:mesh_in%dom_np),i2,i3) = in_field(1:mesh_in%dom_np,i2,i3)
137 out_field(1:m1,i2,i3) = in_field(l_t_g(1:m1),i2,i3)
149 INTEGER,
DIMENSION(mesh_loc%np) :: l_t_g
151 REAL(KIND=8) :: epsilon = 1.d-10
153 REAL(KIND=8),
DIMENSION(2) :: r_loc, r_glob
156 r_loc = mesh_loc%rr(:,i)
158 r_glob = mesh_glob%rr(:,j)
159 IF (sum((r_loc-r_glob)**2) < epsilon)
THEN
166 IF (minval(l_t_g)==0)
WRITE(*,*)
'BUG in loc_to_glob', mesh_loc%rr(:,minloc(l_t_g))
172 SUBROUTINE interp_mesh(mesh_in, mesh_out, in_field, out_field, controle, type_fe)
177 REAL(KIND=8),
DIMENSION(:,:,:) :: in_field, out_field
178 INTEGER,
DIMENSION(mesh_out%np) :: controle
181 INTEGER :: m, i, j, k, ni, l
182 REAL(KIND=8),
DIMENSION(mesh_in%gauss%n_w) :: ff
183 REAL(KIND=8),
DIMENSION(mesh_in%gauss%n_ws) :: ffe
184 REAL(KIND=8),
DIMENSION(3) :: abc
185 REAL(KIND=8),
DIMENSION(2) :: ab
190 DO i = 1, mesh_out%np
191 CALL
find_elem(mesh_in, mesh_out%rr(:,i), abc, m)
196 DO j = 1,
SIZE(in_field,2)
197 DO k = 1,
SIZE(in_field,3)
198 out_field(i,j,k) = sum(ff*in_field(mesh_in%jj(:,m),j,k))
204 DO j = 1, mesh_out%mes
205 DO ni = 1,
SIZE(mesh_out%jjs,1)
206 i = mesh_out%jjs(ni,j)
207 IF (controle(i)>0) cycle
208 CALL
find_edge(mesh_in, mesh_out%rr(:,i), m, ab)
212 DO l = 1,
SIZE(in_field, 2)
213 DO k = 1,
SIZE(in_field, 3)
214 out_field(i,l,k) = sum(ffe*in_field(mesh_in%jjs(:,m),l,k))
220 IF (maxval(controle) > 1)
WRITE(*,*)
'BUG in interp_mesh'
226 REAL(KIND=8),
DIMENSION(3) :: abc
227 INTEGER,
INTENT(IN) :: type_fe
228 REAL(KIND=8),
DIMENSION(3*type_fe):: ff
230 IF (abs(1.d0-sum(abc)) > 1.d-12)
THEN
231 WRITE(*,*)
'bug in gauss_ff'
235 IF (type_fe == 1)
THEN
238 ff(1:3) = abc*(2*abc - 1)
239 ff(4) = 4*abc(2)*abc(3)
240 ff(5) = 4*abc(3)*abc(1)
241 ff(6) = 4*abc(1)*abc(2)
249 REAL(KIND=8),
DIMENSION(2) :: rr
250 REAL(KIND=8),
DIMENSION(3) :: abc
252 REAL(KIND=8),
DIMENSION(2) :: x1, x2, x3, y12, y23, y31, r1, r2, r3
257 x1 = mesh%rr(:,mesh%jj(1,n)) - rr
258 x2 = mesh%rr(:,mesh%jj(2,n)) - rr
259 x3 = mesh%rr(:,mesh%jj(3,n)) - rr
260 y23 = mesh%rr(:,mesh%jj(3,n))-mesh%rr(:,mesh%jj(2,n))
261 y31 = mesh%rr(:,mesh%jj(1,n))-mesh%rr(:,mesh%jj(3,n))
262 y12 = mesh%rr(:,mesh%jj(2,n))-mesh%rr(:,mesh%jj(1,n))
270 IF (minval(abc) < -1.d-12) cycle
282 REAL(KIND=8),
DIMENSION(2) :: ab
283 INTEGER,
INTENT(IN) :: type_fe
284 REAL(KIND=8),
DIMENSION(1+type_fe):: ff
286 IF (abs(1.d0-sum(ab)) > 1.d-12)
THEN
287 WRITE(*,*)
'bug in gauss_ff_edge'
291 IF (type_fe == 1)
THEN
294 ff(1) = ab(1)*(ab(1)-ab(2))
295 ff(2) = ab(2)*(ab(2)-ab(1))
296 ff(3) = 4*ab(1)*ab(2)
306 REAL(KIND=8),
DIMENSION(2) :: rr, ab, abt
308 REAL(KIND=8) :: x, y, h, hr
314 h = sum((mesh%rr(:,mesh%jjs(1,ms))-mesh%rr(:,mesh%jjs(2,ms)))**2)
316 CALL
dist(rr, mesh%rr(:,mesh%jjs(1,ms)), mesh%rr(:,mesh%jjs(2,ms)), y, abt)
332 SUBROUTINE dist(rr, rr1, rr2, y, abt)
335 REAL(KIND=8),
DIMENSION(2) :: rr, rr1, rr2, abt
337 REAL(KIND=8),
DIMENSION(2) :: y12, x1, x2, r
348 IF (abt(1)*abt(2) < -1.d-12)
THEN
363 REAl(KIND=8),
DIMENSION(2) :: x, y
371 REAL(KIND=8),
DIMENSION(:) :: x,y
integer function eval_blank(len_str, string)