HPC post-processing safety & precision unification: added MPI_Abort for allocation error checks and completed real(real64) precision unification across source files and code generator templates
This commit is contained in:
ignis
parent
3f92049c6c
commit
313e454349
6 changed files with 118 additions and 46 deletions
|
|
@ -1,4 +1,5 @@
|
|||
MODULE Compact
|
||||
use, intrinsic :: iso_fortran_env, only: real64
|
||||
IMPLICIT NONE
|
||||
|
||||
REAL(KIND=8), DIMENSION(:), ALLOCATABLE :: lxf,lxs,wxf,wxs, &
|
||||
|
|
|
|||
|
|
@ -271,6 +271,17 @@ class ExpToCode(Transformer):
|
|||
|
||||
|
||||
|
||||
def make_allocate(name, shape, init_zero=True):
|
||||
alloc_str = f"allocate({name}({shape}), stat=ierr)\n"
|
||||
alloc_str += f"if (ierr /= 0) then\n"
|
||||
alloc_str += f" write(0,*) 'Error: allocation of {name} failed on process', myid\n"
|
||||
alloc_str += f" call MPI_ABORT(MPI_COMM_TASK, 1, mpi_err)\n"
|
||||
alloc_str += f"end if"
|
||||
if init_zero:
|
||||
alloc_str += f"\n{name} = 0."
|
||||
return alloc_str
|
||||
|
||||
|
||||
class FieldBase (object):
|
||||
def __init__ (self, name, fdict):
|
||||
self.name = name
|
||||
|
|
@ -323,12 +334,11 @@ class FieldBase (object):
|
|||
|
||||
|
||||
def code_decl (self):
|
||||
real_array_decl = "real*8, allocatable, dimension({1}) :: {0}"
|
||||
real_array_decl = "real(real64), allocatable, dimension({1}) :: {0}"
|
||||
return real_array_decl.format(self.name, self.dim)
|
||||
|
||||
def code_alloc (self):
|
||||
real_array_alloc = "allocate({0}({1}), stat=ierr) ; {0} = 0."
|
||||
return real_array_alloc.format(self.name, self.shape)
|
||||
return make_allocate(self.name, self.shape)
|
||||
|
||||
def code_free (self):
|
||||
real_array_free = "deallocate({})"
|
||||
|
|
@ -385,7 +395,7 @@ integer(kind=MPI_INTEGER_KIND) :: {field_name}_fh
|
|||
integer(kind=MPI_INTEGER_KIND) :: {field_name}_info
|
||||
|
||||
! - buffer
|
||||
real*8, allocatable, dimension(:,:,:) :: {field_name}_export_array
|
||||
real(real64), allocatable, dimension(:,:,:) :: {field_name}_export_array
|
||||
integer, allocatable, dimension(:) :: {field_name}_xpts
|
||||
'''
|
||||
|
||||
|
|
@ -393,8 +403,17 @@ integer, allocatable, dimension(:) :: {field_name}_xpts
|
|||
! init
|
||||
call MPI_INFO_CREATE({field_name}_info, mpi_err)
|
||||
call MPI_FILE_OPEN(MPI_COMM_TASK,'export-{field_name}.dat',MPI_MODE_WRONLY+MPI_MODE_CREATE,{field_name}_info,{field_name}_fh,mpi_err)
|
||||
allocate({field_name}_export_array(1:{len_xpts},{ys}:{ye},{zs}:{ze}), stat=ierr) ; {field_name}_export_array = 0.
|
||||
allocate({field_name}_export_array(1:{len_xpts},{ys}:{ye},{zs}:{ze}), stat=ierr)
|
||||
if (ierr /= 0) then
|
||||
write(0,*) 'Error: allocation of {field_name}_export_array failed on process', myid
|
||||
call MPI_ABORT(MPI_COMM_TASK, 1, mpi_err)
|
||||
end if
|
||||
{field_name}_export_array = 0.
|
||||
allocate({field_name}_xpts(1:{len_xpts}), stat=ierr)
|
||||
if (ierr /= 0) then
|
||||
write(0,*) 'Error: allocation of {field_name}_xpts failed on process', myid
|
||||
call MPI_ABORT(MPI_COMM_TASK, 1, mpi_err)
|
||||
end if
|
||||
{xpts_init}
|
||||
'''
|
||||
|
||||
|
|
@ -991,13 +1010,10 @@ class Stage4():
|
|||
|
||||
array_names = [self.array_name.format(i) for i in range(self.narr)]
|
||||
|
||||
real_array_decl = "real*8, allocatable, dimension(:,:,:) :: {0}"
|
||||
real_array_alloc = "allocate({0}(nxp,nyp,nzp), stat=ierr) ; {0} = 0."
|
||||
real_array_free = "deallocate({})"
|
||||
|
||||
real_array_decl = "real(real64), allocatable, dimension(:,:,:) :: {0}"
|
||||
decl = "\n".join([real_array_decl.format(v) for v in array_names])
|
||||
alloc = "\n".join([real_array_alloc.format(v) for v in array_names])
|
||||
free = "\n".join([real_array_free.format(v) for v in array_names])
|
||||
alloc = "\n".join([make_allocate(v, "nxp,nyp,nzp") for v in array_names])
|
||||
free = "\n".join(["deallocate({})".format(v) for v in array_names])
|
||||
|
||||
return decl, alloc, free
|
||||
|
||||
|
|
@ -1005,7 +1021,7 @@ class Stage4():
|
|||
def write_avg_codes (self, avglist):
|
||||
|
||||
avg_array_write = '''
|
||||
real*8, dimension(nxp) :: xbuffer
|
||||
real(real64), dimension(nxp) :: xbuffer
|
||||
integer :: i
|
||||
|
||||
open (200, file="qEdge_X.dat")
|
||||
|
|
|
|||
|
|
@ -1,5 +1,6 @@
|
|||
mod_form='''module m_{0[module_name]}
|
||||
|
||||
use, intrinsic :: iso_fortran_env, only: real64
|
||||
use m_openmpi
|
||||
use m_parameters
|
||||
use m_arrays
|
||||
|
|
|
|||
|
|
@ -1,10 +1,11 @@
|
|||
module m_arrays
|
||||
|
||||
use, intrinsic :: iso_fortran_env, only: real64
|
||||
use m_parameters
|
||||
|
||||
implicit none
|
||||
|
||||
real*8, allocatable, dimension(:,:,:) :: u,v,w,y
|
||||
real(real64), allocatable, dimension(:,:,:) :: u,v,w,y
|
||||
|
||||
contains
|
||||
|
||||
|
|
@ -12,11 +13,33 @@ subroutine m_arrays_init
|
|||
|
||||
integer :: ierr
|
||||
|
||||
ALLOCATE(u(nxp,nyp,nzp),STAT=ierr) ; u=0. ! Main variables
|
||||
ALLOCATE(v(nxp,nyp,nzp),STAT=ierr) ; v=0. ! Main variables
|
||||
ALLOCATE(w(nxp,nyp,nzp),STAT=ierr) ; w=0. ! Main variables
|
||||
ALLOCATE(u(nxp,nyp,nzp),STAT=ierr)
|
||||
if (ierr /= 0) then
|
||||
write(0,*) "Error: allocation of u failed on process", myid
|
||||
call MPI_ABORT(MPI_COMM_TASK, 1, mpi_err)
|
||||
end if
|
||||
u=0.
|
||||
|
||||
ALLOCATE(y(nxp,nyp,nzp),STAT=ierr) ; y=0.
|
||||
ALLOCATE(v(nxp,nyp,nzp),STAT=ierr)
|
||||
if (ierr /= 0) then
|
||||
write(0,*) "Error: allocation of v failed on process", myid
|
||||
call MPI_ABORT(MPI_COMM_TASK, 1, mpi_err)
|
||||
end if
|
||||
v=0.
|
||||
|
||||
ALLOCATE(w(nxp,nyp,nzp),STAT=ierr)
|
||||
if (ierr /= 0) then
|
||||
write(0,*) "Error: allocation of w failed on process", myid
|
||||
call MPI_ABORT(MPI_COMM_TASK, 1, mpi_err)
|
||||
end if
|
||||
w=0.
|
||||
|
||||
ALLOCATE(y(nxp,nyp,nzp),STAT=ierr)
|
||||
if (ierr /= 0) then
|
||||
write(0,*) "Error: allocation of y failed on process", myid
|
||||
call MPI_ABORT(MPI_COMM_TASK, 1, mpi_err)
|
||||
end if
|
||||
y=0.
|
||||
|
||||
end subroutine m_arrays_init
|
||||
|
||||
|
|
|
|||
|
|
@ -1,15 +1,16 @@
|
|||
module m_calculate
|
||||
|
||||
use, intrinsic :: iso_fortran_env, only: real64
|
||||
use Compact
|
||||
use m_parameters
|
||||
|
||||
implicit none
|
||||
|
||||
real*8, allocatable, dimension(:,:) :: xsrc
|
||||
real*8, allocatable, dimension(:,:) :: xdst
|
||||
real(real64), allocatable, dimension(:,:) :: xsrc
|
||||
real(real64), allocatable, dimension(:,:) :: xdst
|
||||
|
||||
real*8, allocatable, dimension(:,:) :: rsrc
|
||||
real*8, allocatable, dimension(:,:) :: rdst
|
||||
real(real64), allocatable, dimension(:,:) :: rsrc
|
||||
real(real64), allocatable, dimension(:,:) :: rdst
|
||||
|
||||
integer, parameter :: nb = BLOCKSIZE
|
||||
|
||||
|
|
@ -25,10 +26,28 @@ contains
|
|||
call ludcmp(nxp,nyp,nzp,1,0,0) ! 1,1,0
|
||||
|
||||
allocate(xsrc(nb, nxp), stat=ierr)
|
||||
if (ierr /= 0) then
|
||||
write(0,*) "Error: allocation of xsrc failed on process", myid
|
||||
call MPI_ABORT(MPI_COMM_TASK, 1, mpi_err)
|
||||
end if
|
||||
|
||||
allocate(xdst(nb, nxp), stat=ierr)
|
||||
if (ierr /= 0) then
|
||||
write(0,*) "Error: allocation of xdst failed on process", myid
|
||||
call MPI_ABORT(MPI_COMM_TASK, 1, mpi_err)
|
||||
end if
|
||||
|
||||
allocate(rsrc(nxp, nzp), stat=ierr)
|
||||
if (ierr /= 0) then
|
||||
write(0,*) "Error: allocation of rsrc failed on process", myid
|
||||
call MPI_ABORT(MPI_COMM_TASK, 1, mpi_err)
|
||||
end if
|
||||
|
||||
allocate(rdst(nxp, nzp), stat=ierr)
|
||||
if (ierr /= 0) then
|
||||
write(0,*) "Error: allocation of rdst failed on process", myid
|
||||
call MPI_ABORT(MPI_COMM_TASK, 1, mpi_err)
|
||||
end if
|
||||
|
||||
end subroutine m_calculate_init
|
||||
|
||||
|
|
@ -240,12 +259,12 @@ contains
|
|||
|
||||
end subroutine tp2
|
||||
|
||||
real function rxn_rate (c)
|
||||
real(real64) function rxn_rate (c)
|
||||
|
||||
real :: c
|
||||
real(real64) :: c
|
||||
|
||||
if(c.lt.0.) c=0.
|
||||
if(c.gt.1.) c=1.
|
||||
if(c.lt.0._real64) c=0._real64
|
||||
if(c.gt.1._real64) c=1._real64
|
||||
|
||||
if (c.le.c_cut) then
|
||||
|
||||
|
|
@ -265,39 +284,39 @@ contains
|
|||
|
||||
end function rxn_rate
|
||||
|
||||
real function threshold_min_max (c, minc, maxc)
|
||||
real(real64) function threshold_min_max (c, minc, maxc)
|
||||
|
||||
real :: c
|
||||
real :: minc, maxc
|
||||
real(real64) :: c
|
||||
real(real64) :: minc, maxc
|
||||
|
||||
if ((c.lt.minc) .or. (c.gt.maxc)) then
|
||||
threshold_min_max = 0.
|
||||
threshold_min_max = 0._real64
|
||||
else
|
||||
threshold_min_max = 1.0
|
||||
threshold_min_max = 1.0_real64
|
||||
end if
|
||||
|
||||
end function threshold_min_max
|
||||
|
||||
real function positive (c)
|
||||
real(real64) function positive (c)
|
||||
|
||||
real :: c
|
||||
real(real64) :: c
|
||||
|
||||
if (c > 0.0d0) then
|
||||
if (c > 0.0_real64) then
|
||||
positive = c
|
||||
else
|
||||
positive = 0.
|
||||
positive = 0._real64
|
||||
end if
|
||||
|
||||
end function positive
|
||||
|
||||
real function negative (c)
|
||||
real(real64) function negative (c)
|
||||
|
||||
real :: c
|
||||
real(real64) :: c
|
||||
|
||||
if (c < 0.0d0) then
|
||||
if (c < 0.0_real64) then
|
||||
negative = c
|
||||
else
|
||||
negative = 0.
|
||||
negative = 0._real64
|
||||
end if
|
||||
|
||||
end function negative
|
||||
|
|
|
|||
|
|
@ -1,4 +1,5 @@
|
|||
MODULE post
|
||||
use, intrinsic :: iso_fortran_env, only: real64
|
||||
USE Compact
|
||||
USE m_parameters
|
||||
USE m_calculate
|
||||
|
|
@ -11,9 +12,9 @@
|
|||
INTEGER :: nprogress
|
||||
INTEGER :: ipass
|
||||
INTEGER :: num_, dummyu_ ! hybrid
|
||||
REAL :: tnow
|
||||
real(real64) :: tnow
|
||||
|
||||
REAL, DIMENSION(:,:,:,:), ALLOCATABLE :: old_scalar, new_scalar
|
||||
real(real64), DIMENSION(:,:,:,:), ALLOCATABLE :: old_scalar, new_scalar
|
||||
|
||||
PUBLIC :: main, main_lb
|
||||
CONTAINS
|
||||
|
|
@ -273,10 +274,10 @@
|
|||
|
||||
SUBROUTINE READ_FILE(num)
|
||||
INTEGER, INTENT(IN) :: num
|
||||
REAL, DIMENSION(2) :: tmpr
|
||||
real(real64), DIMENSION(2) :: tmpr
|
||||
INTEGER :: nx, ny, nz
|
||||
REAL :: tmp1,tmp2
|
||||
REAL :: dt,dummyu
|
||||
real(real64) :: tmp1,tmp2
|
||||
real(real64) :: dt,dummyu
|
||||
INTEGER :: ncyc
|
||||
|
||||
integer(8) :: ctime_i
|
||||
|
|
@ -340,8 +341,19 @@
|
|||
CALL m_calculate_init
|
||||
CALL m_terms_init
|
||||
|
||||
ALLOCATE(old_scalar(2,nxp,nyp,nzp),STAT=ierr) ; old_scalar=0. ! Main variables
|
||||
ALLOCATE(new_scalar(nxp,nyp,nzp,2),STAT=ierr) ; new_scalar=0.
|
||||
ALLOCATE(old_scalar(2,nxp,nyp,nzp),STAT=ierr)
|
||||
if (ierr /= 0) then
|
||||
write(0,*) "Error: allocation of old_scalar failed on process", myid
|
||||
call MPI_ABORT(MPI_COMM_TASK, 1, mpi_err)
|
||||
end if
|
||||
old_scalar=0. ! Main variables
|
||||
|
||||
ALLOCATE(new_scalar(nxp,nyp,nzp,2),STAT=ierr)
|
||||
if (ierr /= 0) then
|
||||
write(0,*) "Error: allocation of new_scalar failed on process", myid
|
||||
call MPI_ABORT(MPI_COMM_TASK, 1, mpi_err)
|
||||
end if
|
||||
new_scalar=0.
|
||||
|
||||
WRITE(*,'(a6,i3,a8,i3,a8,i3)') ' NX = ',nxp,' / NY = ',nyp,' / NZ = ',nzp
|
||||
WRITE(*,*) ' Preparing memory space for COMPACT SCHEME'
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue