e4d_run.F90 coverage: 100.00 %func 86.99 %block
1) module e4d_run
2)
3) use vars
4) integer :: pf_com
5) logical :: first_sol = .true.
6) logical :: sim_e4d = .false.
7) integer :: mcomm
8) !real*8 :: pf_time
9) contains
10)
11) !_____________________________________________________________________
12) subroutine run_e4d
13)
14) implicit none
15) logical :: first_flag = .true.
16)
17) if (my_rank>0) then
18) call slave_run
19) call cleanup
20) return
21) end if
22)
23) if (.not. allocated(pf_porosity)) allocate(pf_porosity(pflotran_vec_size))
24) if (.not. allocated(pf_tracer)) allocate(pf_tracer(pflotran_vec_size))
25) if (.not. allocated(pf_saturation)) &
26) allocate(pf_saturation(pflotran_vec_size))
27) if (.not. allocated(pf_saturation_0)) &
28) allocate(pf_saturation_0(pflotran_vec_size))
29) ! if energy is being modeled, pflotran_temperature_vec_mpi will be non-zero
30) if (pflotran_temperature_vec_mpi /= 0 .and. &
31) .not. allocated(pf_temperature)) &
32) allocate(pf_temperature(pflotran_vec_size))
33) if (.not. allocated(sigma)) allocate(sigma(nelem))
34)
35)
36) call get_mcomm
37) call cpu_time(Cbeg)
38) call get_pf_porosity !!get the pflotran porosity
39) do while (mcomm==1)
40)
41) call get_pf_time !!get the pflotran solution time
42) call get_pf_sol !!get the pflotran solution
43)
44) call elog(36,mcomm,mcomm)
45)
46) call check_e4d_sim !!see if we should do an e4d sim for this time
47)
48) if (sim_e4d) then
49)
50)
51)
52) if (first_flag) then
53) pf_saturation_0 = pf_saturation
54) !call compute_FF
55) first_flag = .false.
56) end if
57)
58) call map_pf_e4d !!map/transform the solution to the E4D mesh
59) call send_sigma !!send the transformed solution to the slaves
60) call send_command(3) !!instruct slaves to build A matrix
61) call send_command(5) !!instruct slaves to build KSP solver
62) call send_command(6) !!instruct slaves to solve
63) call get_dpred !!assemble the simulated data
64) call cpu_time(Cbeg)
65) end if
66)
67) call get_mcomm
68)
69) end do
70)
71) call send_command(0) !!instruct slaves to exit
72) call cleanup
73) return
74)
75)
76) end subroutine run_e4d
77) !____________________________________________________________________
78)
79) !____________________________________________________________________
80) subroutine check_e4d_sim
81) implicit none
82) integer :: tmp,i,ios,j,junk,a,b,m,n
83)
84)
85) open(13,file=trim(log_file),status='old',action='write',position='append')
86) write(13,*) "Min/Max Tracer Value: ",minval(pf_tracer),maxval(pf_tracer)
87) close(13)
88) sim_e4d = .false.
89)
90) open(10,file=trim(list_file),status='old',action='read')
91) read(10,*) tmp
92) do i=1,ntime
93) read(10,*) e4d_time,csrv_file,ccond_file
94) if (e4d_time .eq. pf_time) then
95) call elog(35,i,tmp)
96) close(10)
97)
98) open(10,file=trim(ccond_file),status='old',action='read')
99) read(10,*,IOSTAT=ios) nsig
100) if (ios .ne. 0) call elog(31,ios,tmp)
101) if (nsig .ne. nelem) call elog(32,nsig,nelem)
102) if (.not.allocated(sigma)) allocate(sigma(nelem))
103) do j=1,nelem
104) read(10,*) sigma(j)
105) end do
106) close(10)
107)
108) open(10,file=trim(csrv_file),status='old',action='read')
109) read(10,*,IOSTAT=ios) tmp
110) call elog(27,ios,tmp)
111) do j=1,tmp
112) read(10,*) junk
113) end do
114) read(10,*,IOSTAT=ios) tmp
115) call elog(29,ios,tmp)
116) if (.not. allocated(dobs)) allocate(dobs(nm))
117) if (.not. allocated(sd)) allocate(sd(nm))
118) do j=1,nm
119) read(10,*,IOSTAT=ios) tmp,a,b,m,n,dobs(j),sd(j)
120) end do
121) close(10)
122) sim_e4d = .true.
123) return
124) end if
125) end do
126)
127) close(10)
128) open(13,file=trim(log_file),status='old',action='write',position='append')
129) write(13,*) "No E4D survey found for pflotran time: ",pf_time
130) close(13)
131) end subroutine check_e4d_sim
132) !____________________________________________________________________
133)
134) !____________________________________________________________________
135) subroutine get_mcomm
136) implicit none
137) !geh call MPI_BCAST(mcomm,1,MPI_INTEGER,0,PFE4D_COMM,ierr)
138) call MPI_BCAST(mcomm,1,MPI_INTEGER,0,PFE4D_MASTER_COMM,ierr)
139) end subroutine get_mcomm
140) !____________________________________________________________________
141)
142) !____________________________________________________________________
143) subroutine get_pf_time
144) implicit none
145) call MPI_BCAST(pf_time,1,MPI_DOUBLE_PRECISION,0,PFE4D_MASTER_COMM, &
146) ierr)
147)
148) end subroutine get_pf_time
149) !____________________________________________________________________
150)
151) !____________________________________________________________________
152) subroutine get_pf_porosity
153) implicit none
154) #include "petsc/finclude/petscvec.h"
155) #include "petsc/finclude/petscvec.h90"
156) integer :: status(MPI_STATUS_SIZE)
157) PetscReal, pointer :: vec_ptr(:)
158)
159)
160) ! porosity
161) ! we actually hijack the tracer vec to transfer porosity
162) call VecScatterBegin(pflotran_scatter,pflotran_tracer_vec_mpi, &
163) pflotran_tracer_vec_seq, &
164) INSERT_VALUES,SCATTER_FORWARD,perr);CHKERRQ(perr)
165) call VecScatterEnd(pflotran_scatter,pflotran_tracer_vec_mpi, &
166) pflotran_tracer_vec_seq, &
167) INSERT_VALUES,SCATTER_FORWARD,perr);CHKERRQ(perr)
168) call VecGetArrayF90(pflotran_tracer_vec_seq,vec_ptr,perr);CHKERRQ(perr)
169) pf_porosity = real(vec_ptr)
170)
171) call VecRestoreArrayF90(pflotran_tracer_vec_seq,vec_ptr, &
172) perr);CHKERRQ(perr)
173)
174) end subroutine get_pf_porosity
175) !____________________________________________________________________
176)
177) !____________________________________________________________________
178) subroutine get_pf_sol
179) implicit none
180) #include "petsc/finclude/petscvec.h"
181) #include "petsc/finclude/petscvec.h90"
182) integer :: status(MPI_STATUS_SIZE)
183) PetscReal, pointer :: vec_ptr(:)
184)
185)
186) ! tracer
187) call VecScatterBegin(pflotran_scatter,pflotran_tracer_vec_mpi, &
188) pflotran_tracer_vec_seq, &
189) INSERT_VALUES,SCATTER_FORWARD,perr);CHKERRQ(perr)
190) call VecScatterEnd(pflotran_scatter,pflotran_tracer_vec_mpi, &
191) pflotran_tracer_vec_seq, &
192) INSERT_VALUES,SCATTER_FORWARD,perr);CHKERRQ(perr)
193) call VecGetArrayF90(pflotran_tracer_vec_seq,vec_ptr,perr);CHKERRQ(perr)
194) pf_tracer = real(vec_ptr)
195)
196) call VecRestoreArrayF90(pflotran_tracer_vec_seq,vec_ptr, &
197) perr);CHKERRQ(perr)
198)
199) ! saturation
200) call VecScatterBegin(pflotran_scatter,pflotran_saturation_vec_mpi, &
201) pflotran_saturation_vec_seq, &
202) INSERT_VALUES,SCATTER_FORWARD,perr);CHKERRQ(perr)
203) call VecScatterEnd(pflotran_scatter,pflotran_saturation_vec_mpi, &
204) pflotran_saturation_vec_seq, &
205) INSERT_VALUES,SCATTER_FORWARD,perr);CHKERRQ(perr)
206) call VecGetArrayF90(pflotran_saturation_vec_seq,vec_ptr,perr);CHKERRQ(perr)
207) pf_saturation = real(vec_ptr)
208) call VecRestoreArrayF90(pflotran_saturation_vec_seq,vec_ptr, &
209) perr);CHKERRQ(perr)
210)
211) ! temperature (only modeled when energy is simulated)
212) if (pflotran_temperature_vec_mpi /= 0) then
213) call VecScatterBegin(pflotran_scatter,pflotran_temperature_vec_mpi, &
214) pflotran_temperature_vec_seq, &
215) INSERT_VALUES,SCATTER_FORWARD,perr);CHKERRQ(perr)
216) call VecScatterEnd(pflotran_scatter,pflotran_temperature_vec_mpi, &
217) pflotran_temperature_vec_seq, &
218) INSERT_VALUES,SCATTER_FORWARD,perr);CHKERRQ(perr)
219) call VecGetArrayF90(pflotran_temperature_vec_seq,vec_ptr, &
220) perr);CHKERRQ(perr)
221) pf_temperature = real(vec_ptr)
222) call VecRestoreArrayF90(pflotran_temperature_vec_seq,vec_ptr, &
223) perr);CHKERRQ(perr)
224) endif
225)
226) end subroutine get_pf_sol
227) !____________________________________________________________________
228)
229) !____________________________________________________________________
230) subroutine map_pf_e4d
231)
232) implicit none
233) integer :: i,cnt
234) character*40 :: filename, word
235) real :: K,St,C,parSat,delSigb,Sigf,delSigb_min
236) real, parameter :: m=2.0 !!m is the saturation exponent ... assumed to be 2
237) !real, dimension(nelem) :: pftrac
238) !pftrac=0
239) !sigma=0.001 !sigma_base
240) !do i=1,nmap
241) ! sigma(map_inds(i,1)) = sigma(map_inds(i,1))+map(i)*pf_tracer(map_inds(i,2))
242) ! pftrac(map_inds(i,1))= pftrac(map_inds(i,1)) +map(i)*pf_tracer(map_inds(i,2))
243) !end do
244)
245) do i=1,nmap
246)
247) Sigf = gw_sig + (sw_sig-gw_sig)*pf_tracer(map_inds(i,2)) !pore water conductivity
248) delSigb = (Sigf*pf_saturation(map_inds(i,2))**(m))/FF-sigma(map_inds(i,1))
249) sigma(map_inds(i,1)) = sigma(map_inds(i,1)) + map(i)*delSigb
250)
251) end do
252)
253) do i=1,nelem
254) if (sigma(i)<1e-6) sigma(i)=1e-6
255) end do
256)
257) !write(*,*) pf_time
258) write(word,'(i15.15)') int(pf_time)
259) filename = 'sigma_' // &
260) trim(adjustl(pflotran_group_prefix)) // &
261) '_' // &
262) trim(adjustl(word)) // &
263) '.txt'
264) !write(*,*) filename
265) open(unit=86,file=trim(filename),status='replace',action='write')
266) write(86,*) nelem, "1", minval(sigma),maxval(sigma)
267) do i = 1, nelem
268) write(86,*) sigma(i)
269) enddo
270) close(86)
271)
272) end subroutine map_pf_e4d
273) !____________________________________________________________________
274)
275) !____________________________________________________________________
276) !subroutine compute_FF
277) ! implicit none
278) ! integer :: i
279) ! real, parameter :: m = 2
280) ! allocate(ffac(nelem))
281) ! ffac = 0
282) ! do i=1,nmap
283) ! ffac(map_inds(i,1)) = ffac(map_inds(i,1)) + map(i)*(gw_sig*pf_saturation_0(map_inds(i,2))**(m))/sigma(map_inds(i,1))
284) ! end do
285) ! open(13,file='FF_Derived.txt',status='replace',action='write')
286) ! write(13,*) nelem
287) ! do i=1,nelem
288) ! write(13,*) ffac(i)
289) ! end do
290) ! close(13)
291) !end subroutine compute_FF
292) !____________________________________________________________________
293)
294) !____________________________________________________________________
295) subroutine send_sigma
296) implicit none
297)
298) call send_command(4)
299) call MPI_BCAST(sigma, nelem,MPI_REAL,0,E4D_COMM,ierr)
300)
301) end subroutine send_sigma
302) !____________________________________________________________________
303)
304) !____________________________________________________________________
305) subroutine get_dpred
306) implicit none
307) integer :: opt
308) integer :: i,j
309) integer :: nadd
310) integer :: nbuff
311) integer, dimension(nm*2) :: ibuff
312) real, dimension(nm) :: rbuff
313) integer :: status(MPI_STATUS_SIZE)
314) character*40 :: filename, word
315)
316)
317) !instruct slave to assemble and send the prediceted data
318) call send_command(8)
319)
320) !allocate dpred if not already done and zero
321) if (.not. allocated(dpred)) then
322) allocate(dpred(nm))
323) end if
324) dpred = 0
325) rbuff = 0
326) ibuff = 1
327) do i=1,n_rank-1
328) call MPI_RECV(nbuff,1,MPI_INTEGER,i,0,E4D_COMM,status,ierr)
329) call MPI_RECV(ibuff(1:nbuff),nbuff,MPI_INTEGER,i,0,E4D_COMM,status,ierr)
330) call MPI_RECV(rbuff(1:nbuff),nbuff,MPI_REAL,i,0,E4D_COMM,status,ierr)
331)
332) do j=1,nbuff
333) dpred(ibuff(j))=dpred(ibuff(j))+rbuff(j)
334) end do
335)
336) end do
337)
338)
339)
340) write(word,'(i15.15)') int(pf_time)
341) filename = 'e4d_' // &
342) trim(adjustl(pflotran_group_prefix)) // &
343) '_' // &
344) trim(adjustl(word)) // &
345) '.dpd'
346) write(*,*) filename
347) open(unit=86,file=trim(filename),status='replace',action='write')
348) write(86,*) nm
349) do i = 1, nm
350) write(86,'(I6,4I6,4F15.8)') i,s_conf(i,1:4),dpred(i),dobs(i),dpred(i)/sd(i),dobs(i)/sd(i)
351) enddo
352) close(86)
353)
354) !!output the predicted data to file
355) !call output_dpred
356) end subroutine get_dpred
357) !____________________________________________________________________
358)
359)
360) !______________________________________________________________
361) subroutine send_command(com)
362) !!Send a general command to the slaves
363) integer :: com
364) call MPI_BCAST(com,1,MPI_INTEGER,0,E4D_COMM,ierr)
365) end subroutine send_command
366) !________________________________________________________________
367)
368)
369)
370)
371) !___________SLAVE SUBROUTINES________________________________________
372)
373) !____________________________________________________________________
374) subroutine slave_run
375) implicit none
376) integer :: command
377)
378) 100 continue
379) !Recieve a command from master
380) call MPI_BCAST(command,1,MPI_INTEGER,0,E4D_COMM,ierr)
381)
382) !return to main
383) if (command == 0) then
384) return
385)
386) else if (command == 3) then
387) call build_A
388) goto 100
389)
390) else if (command == 4) then
391) call receive_sigma
392) goto 100
393)
394) else if (command == 5) then
395) call build_ksp
396) goto 100
397)
398) else if (command == 6) then
399) call forward_run
400) goto 100
401)
402) else if (command == 8) then
403) call send_dpred
404) goto 100
405)
406) else
407) goto 100
408)
409) end if
410)
411) end subroutine slave_run
412) !____________________________________________________________________
413) !__________________________________________________________________
414) subroutine receive_sigma
415)
416) implicit none
417) character(len=32) :: filename, word
418) integer :: i
419) integer, save :: num_calls = 0
420) call MPI_BCAST(sigma, nelem,MPI_REAL,0,E4D_COMM,ierr)
421) !geh
422)
423) !write(filename,*) num_calls
424) !write(word,*) my_rank
425) !filename = 'sigma_' // trim(adjustl(word)) // '_' // &
426) ! trim(adjustl(filename)) // '.txt'
427) !open(unit=86,file=filename,status='replace',action='write')
428) !do i = 1, nelem
429) ! write(86,*) sigma(i)
430) !enddo
431) !close(86)
432)
433) !num_calls = num_calls + 1
434) ! print *, 'sigma received by slave', sigma(16)
435) end subroutine receive_sigma
436) !__________________________________________________________________
437)
438) !__________________________________________________________________
439) subroutine build_A
440) implicit none
441)
442) integer, dimension(nnodes) :: ncolss
443) integer, dimension(50) :: colss
444)
445) integer :: i,lrnl,lrnu,row,col,rbv,cbv,j,ifn
446) logical :: ilow,iup
447)
448) integer :: rw
449) integer :: ncls
450) integer :: cls(50)
451)
452)
453) !zero A
454) call MatZeroEntries(A,perr);CHKERRQ(perr)
455)
456) do i=1,10*nelem
457) row=rows(A_map(i))
458) col=cols(A_map(i))
459) rbv=nbounds(row)
460) cbv=nbounds(col)
461)
462) !lower triangle
463) if ((rbv>=2 .and. rbv<=6) .or. (cbv>=2 .and. cbv<=6)) then
464) !one or both nodes are on a boundary so set to zero for bc's
465) val(1) = 1e-30
466) else
467)
468) val(1) = sigma(S_map(i))*delA(i)
469)
470) end if
471)
472) prn(1) = row-1
473) pcn(1) = col-1
474)
475) call MatSetValues(A,1,prn,1,pcn,val,ADD_VALUES,perr);CHKERRQ(perr)
476) !upper triangle
477) if (row .ne. col) then
478) call MatSetValues(A,1,pcn,1,prn,val,ADD_VALUES,perr);CHKERRQ(perr)
479) end if
480)
481) end do
482)
483) call MatAssemblyBegin(A,MAT_FINAL_ASSEMBLY,perr);CHKERRQ(perr)
484) call MatAssemblyEnd(A,MAT_FINAL_ASSEMBLY,perr);CHKERRQ(perr)
485)
486)
487)
488) end subroutine build_A
489) !__________________________________________________________________
490)
491) !__________________________________________________________________
492) subroutine build_ksp
493) implicit none
494) #include "petsc/finclude/petscksp.h"
495) #include "petsc/finclude/petscksp.h90"
496) real*8 :: rtol = 1e-6
497) real*8 :: atol = 1e-35
498) real*8 :: dtol = 500
499) integer :: maxints = 10000
500) !KSPSetTolerances(KSP ksp,double rtol,double atol,double dtol,int maxits);
501)
502) !Set up the KSP context
503) call KSPCreate(PETSC_COMM_SELF,KS,perr);CHKERRQ(perr)
504) ! call KSPSetOperators(KS,A,A,SAME_PRECONDITIONER,perr)
505) call KSPSetOperators(KS,A,A,perr);CHKERRQ(perr)
506) call KSPGetPC(KS,P,perr);CHKERRQ(perr)
507) !geh - begin
508) call KSPSetErrorIfNotConverged(KS,PETSC_TRUE,perr);CHKERRQ(perr)
509) !geh - end
510) !call KSPSetType(KS,KSPGMRES,perr) !use default
511) !call KSPGMRESSetRestart(KS,1000,perr);
512) !call KSPGetTolerances(KS,rtol,atol,dtol,maxints,perr);CHKERRQ(perr)
513) call KSPSetTolerances(KS,rtol,atol,dtol,maxints,perr);CHKERRQ(perr)
514) call KSPSetFromOptions(KS,perr);CHKERRQ(perr)
515) !geh - begin
516) ! this must come after KSPSetFromOptions (or PCSetFromOptions) as it is
517) ! overwritten by the defaults otherwise.
518) call PCFactorSetZeroPivot(P,1.d-40,perr);CHKERRQ(perr)
519) !geh - end
520)
521) end subroutine build_ksp
522) !__________________________________________________________________
523) !____________________________________________________________________
524) subroutine forward_run
525) implicit none
526) integer :: i,m,n,niter,j,enum
527) integer, dimension(1) :: eindx
528) real, dimension(2) :: pck
529) PetscScalar :: val
530) real :: tstart, tend
531)
532) do i=1,my_ne
533) !call cpu_time(tstart)
534)
535) call VecGetArrayF90(psol,vloc,perr);CHKERRQ(perr)
536) vloc(1:nnodes)=dble(poles(:,i))
537) call VecRestoreArrayF90(psol,vloc,perr);CHKERRQ(perr)
538) enum=eind(my_rank,1)+i-1
539)
540) val=0.0
541) call VecSet(B,val,perr);CHKERRQ(perr)
542)
543) !if (i_flg) then
544) ! call Add_Jpp(i)
545) !end if
546)
547) eindx(1)=e_nods(enum)
548) val=1.0
549) call VecSetValues(B,1,eindx-1,val,ADD_VALUES,perr);CHKERRQ(perr)
550)
551) !if (tank_flag) call VecSetValues(B,1,i_zpot-1,-val,ADD_VALUES,perr);CHKERRQ(perr)
552)
553) call VecAssemblyBegin(B,perr);CHKERRQ(perr)
554) call VecAssemblyEnd(B,perr);CHKERRQ(perr)
555)
556) call KSPSolve(KS,B,psol,perr);CHKERRQ(perr)
557) !call KSPView(KS,PETSC_VIEWER_STDOUT_SELF,perr);CHKERRQ(perr)
558)
559) call VecGetArrayF90(psol,vloc,perr);CHKERRQ(perr)
560) poles(:,i)= real(vloc(1:nnodes))
561) call VecRestoreArrayF90(psol,vloc,perr);CHKERRQ(perr)
562)
563) call KSPGetIterationNumber(KS,niter,perr);CHKERRQ(perr)
564) !write(*,*) my_rank,niter
565) !call cpu_time(tend)
566) !pck(1)=tend-tstart
567) !pck(2)=real(niter)
568) !call MPI_SEND(pck,2,MPI_REAL,0,1,MPI_COMM_WORLD,perr)
569) !write(*,*) "Slave ",my_rank," solved for pole ",eind(my_rank,1)+i-1,'in ',tend-tstart,' seconds and ',niter,' iters'
570)
571) end do
572)
573) if (first_sol) then
574) call KSPSetInitialGuessNonzero(KS,PETSC_TRUE,perr);CHKERRQ(perr)
575) first_sol=.false.
576) end if
577)
578) call KSPDestroy(KS,perr);CHKERRQ(perr)
579)
580)
581) end subroutine forward_run
582) !_________________________________________________________________________________________________
583)
584)
585) !__________________________________________________________________
586) subroutine send_dpred
587) implicit none
588) integer :: flg,i
589)
590) call assemble_data
591) call MPI_SEND(nmy_drows,1,MPI_INTEGER,0,0,E4D_COMM, ierr)
592) call MPI_SEND(my_drows,nmy_drows,MPI_INTEGER,0,0,E4D_COMM,ierr)
593) call MPI_SEND(my_dvals,nmy_drows,MPI_REAL,0,0,E4D_COMM,ierr)
594)
595) end subroutine send_dpred
596) !__________________________________________________________________
597)
598) !___________________________________________________________
599) subroutine assemble_data
600) implicit none
601) integer :: i,a,b,m,n,e1,e2,indx,p
602)
603)
604) e1=eind(my_rank,1)
605) e2=eind(my_rank,2)
606) if (.not.allocated(my_drows)) then
607) nmy_drows=0
608) do i=1,nm
609) a=s_conf(i,1)
610) b=s_conf(i,2)
611) if ((a>=e1 .and. a<=e2) .or. (b>=e1.and. b<=e2)) then
612) nmy_drows=nmy_drows+1
613) end if
614) end do
615) allocate(my_drows(nmy_drows),my_dvals(nmy_drows))
616) end if
617)
618) indx=0
619) my_dvals=0
620)
621)
622) do i=1,nm
623) a = s_conf(i,1)
624) b = s_conf(i,2)
625) m = s_conf(i,3)
626) n = s_conf(i,4)
627)
628) if ((a>=e1 .and. a<=e2) .or. (b>=e1.and. b<=e2)) then
629) indx=indx+1
630) my_drows(indx)=i
631)
632) do p=e1,e2
633) if (p==a) then
634) if (m.ne.0) my_dvals(indx)=my_dvals(indx) + real(poles(e_nods(m),a-e1+1))
635) if (n.ne.0) my_dvals(indx)=my_dvals(indx) - real(poles(e_nods(n),a-e1+1))
636) end if
637) if (p==b) then
638) if (m.ne.0) my_dvals(indx)=my_dvals(indx) - real(poles(e_nods(m),b-e1+1))
639) if (n.ne.0) my_dvals(indx)=my_dvals(indx) + real(poles(e_nods(n),b-e1+1))
640) end if
641) end do
642) end if
643) end do
644)
645) end subroutine assemble_data
646) !___________________________________________________________
647) !___________________________________________________________
648) subroutine cleanup
649)
650) if(allocated(e4d_ranks)) deallocate(e4d_ranks)
651) if(allocated(pf_e4d_ranks)) deallocate(pf_e4d_ranks)
652) if(allocated(map_inds)) deallocate(map_inds)
653) if(allocated(s_conf)) deallocate(s_conf)
654) if(allocated(eind)) deallocate(eind)
655) if(allocated(jind)) deallocate(jind)
656) if(allocated(nbounds)) deallocate(nbounds)
657) if(allocated(zones)) deallocate(zones)
658) if(allocated(elements)) deallocate(elements)
659) if(allocated(faces)) deallocate(faces)
660) if(allocated(e_nods)) deallocate(e_nods)
661) if(allocated(rows)) deallocate(rows)
662) if(allocated(cols)) deallocate(cols)
663) if(allocated(trows)) deallocate(trows)
664) if(allocated(tcols)) deallocate(tcols)
665) if(allocated(A_map)) deallocate(A_map)
666) if(allocated(S_map)) deallocate(S_map)
667) if(allocated(my_drows)) deallocate(my_drows)
668) if(allocated(e_pos)) deallocate(e_pos)
669) if(allocated(nodes)) deallocate(nodes)
670) if(allocated(poles)) deallocate(poles)
671) if(allocated(pf_tracer)) deallocate(pf_tracer)
672) if(allocated(pf_saturation)) deallocate(pf_saturation)
673) if(allocated(pf_saturation_0)) deallocate(pf_saturation_0)
674) if(allocated(sigma)) deallocate(sigma)
675) if(allocated(dpred)) deallocate(dpred)
676) if(allocated(dobs)) deallocate(dobs)
677) if(allocated(sd)) deallocate(sd)
678) if(allocated(my_dvals)) deallocate(my_dvals)
679) if(allocated(map)) deallocate(map)
680) if(allocated(base_sigma)) deallocate(base_sigma)
681) if(allocated(ffac)) deallocate(ffac)
682) if(allocated(pfxcb)) deallocate(pfxcb)
683) if(allocated(pfycb)) deallocate(pfycb)
684) if(allocated(pfzcb)) deallocate(pfzcb)
685) if(allocated(d_nnz)) deallocate(d_nnz)
686) if(allocated(delA)) deallocate(delA)
687) end subroutine cleanup
688) !___________________________________________________________
689) end module e4d_run