diff --git a/GKCoulomb/curlyNpjmn/src/control.f90 b/GKCoulomb/curlyNpjmn/src/control.f90 index 821184e..d14eef5 100644 --- a/GKCoulomb/curlyNpjmn/src/control.f90 +++ b/GKCoulomb/curlyNpjmn/src/control.f90 @@ -1,52 +1,58 @@ subroutine control ! ! main routine ! use basic use prec_const use basis_transformation implicit none ! ! WRITE(*,*) 'Initialize MPI...' CALL ppinit ! CALL INIT_PREC_CONST ! ! 1. PROLOGUE IF(me .eq. 0) write(*,*) "======== GK moment vector =========" call daytim('Start at ') ! ! ! 2.1 READ INPUT IF(me .eq. 0) WRITE(*,*) 'Load basic data...' CALL basic_data IF(me .eq. 0) WRITE(*,*) '... done.' ! 3. Setup MPI topology IF(me .eq. 0) WRITE(*,*) 'Setup MPI topology...' CALL ppsetup IF(me .eq. 0) WRITE(*,*) '... done.' + CALL mpi_barrier(MPI_COMM_WORLD, ierr) + ! 3.2 Allocate memory IF(me .eq. 0) WRITE(*,*) 'Allocate memory...' CALL memory IF(me .eq. 0) WRITE(*,*) '... done.' ! 3.4 ! 4. Compute coefficient IF(me .eq. 0) WRITE(*,*) 'Compute GK moment vector.....' CALL clock(1) CALL numerics CALL clock(-1) + + + CALL mpi_barrier(MPI_COMM_WORLD, ierr) + IF(me .eq. 0) WRITE(*,*) '... DONE.' IF( me .eq. 0) WRITE(*,*) 'Terminte MPI...' CALL ppexit IF( me .eq. 0) WRITE(*,*) '... done' ! call daytim('End at ') IF( me .eq. 0) WRITE(*,*) 'WALL CLOCK [s]:',system_ellapsed_time end subroutine control diff --git a/GKCoulomb/curlyNpjmn/src/numerics.f90 b/GKCoulomb/curlyNpjmn/src/numerics.f90 index bb7b59c..f540834 100644 --- a/GKCoulomb/curlyNpjmn/src/numerics.f90 +++ b/GKCoulomb/curlyNpjmn/src/numerics.f90 @@ -1,125 +1,139 @@ subroutine numerics ! evlaute the GK moment vector use prec_const use array use basic use basis_transformation use FMZM ! implicit none ! ! local vars integer :: p,j,m,n,icol,i integer :: p_lst,j_lst,m_lst,n_lst,icol_lst integer :: idx,iNN,iNN_start,NN integer :: istart,ENDOF logical :: restartisfound ! integer,save :: fid character(len=14) :: filename_ ! integer, parameter :: CSZ = 100 ! size of the routine cache TYPE(FM),DIMENSION(CSZ,ColMAXX) :: XOUT integer :: idx_save(5,CSZ) ! indices array of XOUT ! CALL FM_ENTER_USER_ROUTINE ! + CALL mpi_barrier(MPI_COMM_WORLD, ierr) + ! filename_ = trim(adjustl(me_str))//'.csv' ! ! open file OPEN(fid,FILE = filename_) ! - NN = 1 + iNN_start =1 + p_lst = -1 + j_lst = -1 + m_lst = -1 + n_lst = -1 + icol_lst =-1 + + ! IF(restart) THEN ENDOF = 0 - NN = 1 + NN = -1 DO WHILE (ENDOF .eq. 0) - READ(fid,*,IOSTAT=ENDOF) p_lst,j_lst,m_lst,n_lst,icol_lst NN = NN +1 + READ(fid,*,IOSTAT=ENDOF) p_lst,j_lst,m_lst,n_lst,icol_lst ENDDO ! ! get last position in ! - restartisfound = .false. - istart = 1 - DO WHILE(.not. restartisfound) - IF(idxCoeffs(istart,1) .eq. p_lst .and. idxCoeffs(istart,2) .eq. j_lst .and. idxCoeffs(istart,3) .eq. m_lst .and. idxCoeffs(istart,4) .eq. n_lst) THEN - restartisfound = .true. - iNN_start = istart + 1 - ENDIF - istart = istart +1 - ENDDO - ! + IF( NN > 0) THEN + restartisfound = .false. + istart = 1 + DO WHILE(.not. restartisfound) + IF(idxCoeffs(istart,1) .eq. p_lst .and. idxCoeffs(istart,2) .eq. j_lst .and. idxCoeffs(istart,3) .eq. m_lst .and. idxCoeffs(istart,4) .eq. n_lst) THEN + restartisfound = .true. + iNN_start = istart + 1 + ENDIF + istart = istart +1 + ENDDO + ! + ELSE + iNN_start = 1; + ENDIF IF(iNN_start .le. nb_l) THEN write(*,*) me, ' restarts from ',iNN_start ELSE write(*,*) me, ' already finised !!' ENDIF ELSE iNN_start = 1; ENDIF ! + idx = 1 ! main loop DO iNN=iNN_start,nb_l ! ! Get indices of coefficients p = idxCoeffs(iNN,1) j = idxCoeffs(iNN,2) m = idxCoeffs(iNN,3) n = idxCoeffs(iNN,4) ! ! save indices idx_save(1,idx) = p idx_save(2,idx) = j idx_save(3,idx) = m idx_save(4,idx) = n ! ! Compute GK moment vector RowNpj(:) = TO_FM('0.0') CALL compute_curlyNpjmn(p,j,m,n) ! save it XOUT(idx,:) = RowNpj(:) ! idx = idx +1 ! If the cache is full, empty it to the output file if(idx > CSZ) then ! write to *.csv file DO idx =1, CSZ DO icol =1,ColMAXX !! IF(abs(XOUT(idx,icol)) .ge. TO_FM('1E-30')) THEN write(fid,"(5(I3,','),A)") idx_save(1:4,idx),icol,& trim(FM_FORMAT('E100.90',XOUT(idx,icol))) !! ENDIF ENDDO ENDDO ! ! Flush to ensure data is written flush(fid) ! ! Reset idx to the first cache element idx = 1 ! endif ENDDO ! ! If elements remain in the cache, flush it. if( idx>1 ) then do i = 1, idx-1 DO icol =1,ColMAXX !! IF(abs(XOUT(idx,icol)) .ge. TO_FM('1E-30')) THEN write(fid,"(5(I3,','),A)") idx_save(1:4,i),icol,& trim(FM_FORMAT('E100.90',XOUT(i,icol))) !! ENDIF ENDDO end do ! Again, ensure data is written by flushing flush(fid) end if ! ! close file CLOSE(fid) ! CALL FM_EXIT_USER_ROUTINE ! end subroutine numerics