incomp-flame-post/code/post.f90
ignis 962704e5f7
All checks were successful
CI Test Suite / run-tests (push) Successful in 1m14s
Deploy Documentation / build-and-deploy (push) Successful in 53s
refactor: resolve code smells ranked 1 to 6 (unused variables, local imports, wildcard imports, empty routines, pointer warning)
2026-06-02 17:27:48 +00:00

276 lines
8.6 KiB
Fortran

MODULE post
use, intrinsic :: iso_fortran_env, only: real64
USE Compact
USE m_parameters
USE m_calculate
USE m_arrays
USE m_terms
IMPLICIT NONE
PRIVATE
INTEGER :: countnum
INTEGER :: nprogress
INTEGER :: ipass
INTEGER :: num_ ! hybrid
real(real64) :: tnow
real(real64), DIMENSION(:,:,:,:), ALLOCATABLE :: old_scalar, new_scalar
PUBLIC :: main
CONTAINS
SUBROUTINE main
INTEGER :: fread,i
INTEGER, PARAMETER :: eofread = -1
ipass=0
CALL READ_INTRO
CALL ALLOCATE_ARRAYS
if (iammaster) CALL PRINT_BANNER
! PASS 1
ipass=1
nprogress=0
countnum=0
if (numprocs.eq.1) then
firstloop_serial: DO fread=startnum,endnum,skipnum
IF ( to_omit(fread) ) THEN
CALL PRINT_SKIP_LOG(fread)
ELSE
countnum=countnum+1
nprogress = nprogress + 1
CALL READ_FILE(fread)
CALL m_terms_calculate_pass1(fread)
END IF
END DO firstloop_serial
else
tag = 1
if (iammaster) then
dispatchloop1: DO fread=startnum,endnum,skipnum
IF ( to_omit(fread) ) THEN
CALL PRINT_SKIP_LOG(fread)
ELSE
countnum=countnum+1
CALL MPI_RECV(id_to, 1, MPI_INTEGER, MPI_ANY_SOURCE, tag, MPI_COMM_TASK, mpi_status, mpi_err)
CALL MPI_SEND(fread, 1, MPI_INTEGER8, id_to, tag, MPI_COMM_TASK, mpi_err)
ENDIF
END DO dispatchloop1
end_of_dispatch1: DO i=1,numprocs-1
CALL MPI_RECV(id_to, 1, MPI_INTEGER, MPI_ANY_SOURCE, tag, MPI_COMM_TASK, mpi_status, mpi_err)
CALL MPI_SEND(eofread, 1, MPI_INTEGER8, id_to, tag, MPI_COMM_TASK, mpi_err)
END DO end_of_dispatch1
else
fetchloop1: do
CALL MPI_SEND(myid, 1, MPI_INTEGER, master, tag, MPI_COMM_TASK, mpi_err)
CALL MPI_RECV(fread, 1, MPI_INTEGER8, master, tag, MPI_COMM_TASK, mpi_status, mpi_err)
if (fread < 0) exit
nprogress = nprogress + 1
CALL READ_FILE(fread)
CALL m_terms_calculate_pass1(fread)
end do fetchloop1
end if
CALL MPI_BCAST(countnum, 1, MPI_INTEGER8, master, MPI_COMM_TASK, mpi_err)
end if
CALL m_terms_average_pass1(countnum)
if (iammaster) write(*,*) '1st loop finished'
! PASS 2
optional_pass2: IF ( pass2_required ) THEN
ipass=2
nprogress=0
if (numprocs.eq.1) then
secondloop_serial: DO fread=startnum,endnum,skipnum
IF ( to_omit(fread) ) THEN
CALL PRINT_SKIP_LOG(fread)
ELSE
nprogress = nprogress + 1
CALL READ_FILE(fread)
CALL m_terms_calculate_pass2(fread)
END IF
END DO secondloop_serial
else
tag = 2
if (iammaster) then
dispatchloop2: DO fread=startnum,endnum,skipnum
IF ( to_omit(fread) ) THEN
CALL PRINT_SKIP_LOG(fread)
ELSE
CALL MPI_RECV(id_to, 1, MPI_INTEGER, MPI_ANY_SOURCE, tag, MPI_COMM_TASK, mpi_status, mpi_err)
CALL MPI_SEND(fread, 1, MPI_INTEGER8, id_to, tag, MPI_COMM_TASK, mpi_err)
ENDIF
END DO dispatchloop2
end_of_dispatch2: DO i=1,numprocs-1
CALL MPI_RECV(id_to, 1, MPI_INTEGER, MPI_ANY_SOURCE, tag, MPI_COMM_TASK, mpi_status, mpi_err)
CALL MPI_SEND(eofread, 1, MPI_INTEGER8, id_to, tag, MPI_COMM_TASK, mpi_err)
END DO end_of_dispatch2
else
fetchloop2: do
CALL MPI_SEND(myid, 1, MPI_INTEGER, master, tag, MPI_COMM_TASK, mpi_err)
CALL MPI_RECV(fread, 1, MPI_INTEGER8, master, tag, MPI_COMM_TASK, mpi_status, mpi_err)
if (fread < 0) exit
nprogress = nprogress + 1
CALL READ_FILE(fread)
CALL m_terms_calculate_pass2(fread)
end do fetchloop2
end if
end if
CALL m_terms_average_pass2(countnum)
ENDIF optional_pass2
if (iammaster) then
CALL m_terms_write_result
WRITE(*,*) ' Avergaing RAW data is FINISHED'
WRITE(*,*) 'qEdge_X.dat is generated'
end if
CALL DEALLOCATES_CLOSE
END SUBROUTINE main
SUBROUTINE PRINT_SKIP_LOG(fread)
INTEGER, INTENT(IN) :: fread
INTEGER :: idx
WRITE(*,'(a47,i7,a4,i5,a3,i5)') &
' Current fullsavenum = ', fread, ' || ', (fread-startnum+1), ' / ', (endnum-startnum+1)
DO idx=1,omitnum
IF (fread.ge.omit_t(idx,1) .and. fread.le.omit_t(idx,2)) THEN
WRITE(*,'(a12,i6,a20,i6)') &
' Skip. ', omit_t(idx,1), ' <= fullsavenum <= ', omit_t(idx,2)
EXIT
END IF
END DO
END SUBROUTINE PRINT_SKIP_LOG
!========================================================================================
! End of main routine
!========================================================================================
SUBROUTINE PRINT_BANNER
WRITE(*,*) ' This program, x-edge-cold-bc-5-hybrid, is written by D. Kim, 2018'
WRITE(*,*) ' It is to study the statistics of the flame parameters at the leading edge'
WRITE(*,*) ' in turbulent premixed flames.'
WRITE(*,'(a40,i5,a11,i5,a1)') ' Postprocess will be done from "FORT.',startnum,'" to "FORT.',endnum,'"'
END SUBROUTINE PRINT_BANNER
SUBROUTINE READ_FILE(num)
INTEGER, INTENT(IN) :: num
real(real64), DIMENSION(2) :: tmpr
INTEGER :: nx, ny, nz
real(real64) :: tmp1,tmp2
real(real64) :: dt,dummyu
INTEGER :: ncyc
integer(8) :: ctime_i
character(len=30) :: date
REAL*4 :: e, t(2)
REAL*4 :: e0, t0(2)
REAL*4 :: e1, t1(2)
e0 = etime(t0)
OPEN(num,FORM='unformatted',STATUS='unknown')
READ (num) tnow,nx,ny,nz,tmp1,tmp2
IF ((nx .ne. nxp) .or. (ny .ne. nyp) .or. (nz .ne. nzp)) THEN
WRITE(0,*) "Array dimension mismatch", nx, ny, nz, " != ", nxp, nyp, nzp
STOP -1
ENDIF
READ (num) ncyc,dt,dummyu
READ (num) tmpr(1:2)
READ (num) tmpr(1:2)
READ (num) tmpr(1:2)
num_=num
IF(num.le.shiftnum) THEN
! WRITE(*,*) ' with an old fort data from Nueman-0X'
READ (num) u,v,w,old_scalar
y(:,:,:) = old_scalar(2,:,:,:)
ELSE
! WRITE(*,*) ' with a new fort data from Comb-Cluster'
READ (num) u,v,w,new_scalar
u = u + dummyu
y = new_scalar(:,:,:,2)
ENDIF
CLOSE (num)
e = etime(t)
ctime_i = time8()
call ctime(ctime_i,date)
WRITE(*,'(a,a,i2,a,i1,a,i4,a,i4,a,i4)') &
date, "PID", myid, "|PASS", ipass, "|fort.", num, &
"|", nprogress, "/", endnum-startnum+1
END SUBROUTINE READ_FILE
SUBROUTINE ALLOCATE_ARRAYS
INTEGER :: ierr
CALL m_arrays_init
CALL m_calculate_init
CALL m_terms_init
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'
! CALL ludcmp(nxp,nyp,nzp,1,0,0) ! 1,1,0
WRITE(*,'(a22,i3,a3,i3,a4,i3)') ' Grid number range : ',syp,' ~ ',eyp,' of ',nyp
WRITE(*,*)
END SUBROUTINE ALLOCATE_ARRAYS
SUBROUTINE DEALLOCATES_CLOSE
CALL m_arrays_finalize
CALL m_calculate_finalize
CALL m_terms_finalize
DEALLOCATE(old_scalar)
DEALLOCATE(new_scalar)
IF(omitnum.gt.0) DEALLOCATE(omit_t)
DEALLOCATE(file_dist)
DEALLOCATE(export_offset)
END SUBROUTINE DEALLOCATES_CLOSE
END MODULE post