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 :: u_num CHARACTER(len=64) :: filename character(len=30) :: date integer :: date_values(8) WRITE(filename, '(A,I0)') 'fort.', num OPEN(newunit=u_num, FILE=trim(filename), FORM='unformatted', STATUS='unknown') READ (u_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 (u_num) ncyc,dt,dummyu READ (u_num) tmpr(1:2) READ (u_num) tmpr(1:2) READ (u_num) tmpr(1:2) num_=num IF(num.le.shiftnum) THEN ! WRITE(*,*) ' with an old fort data from Nueman-0X' READ (u_num) u,v,w,old_scalar y(:,:,:) = old_scalar(2,:,:,:) ELSE ! WRITE(*,*) ' with a new fort data from Comb-Cluster' READ (u_num) u,v,w,new_scalar u = u + dummyu y = new_scalar(:,:,:,2) ENDIF CLOSE (u_num) call date_and_time(values=date_values) write(date, '(I4.4,"-",I2.2,"-",I2.2," ",I2.2,":",I2.2,":",I2.2)') & date_values(1), date_values(2), date_values(3), & date_values(5), date_values(6), date_values(7) 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