!####################################################################### ! SUBROUTINE --- sub_output --- ### !####################################################################### ! ### ! Subroutine for Outputting Data ### ! ### ! Input Arguments ### ! n_out : Output Count ### ! time : Time [s] ### ! ### ! 2010/08/31 ### ! 2011/06/27 ### !####################################################################### subroutine sub_output(n_out,time) use mod_parameter use mod_variable implicit none !==== Input Arguments ================================================== integer(4), intent(IN) :: n_out real(8), intent(IN) :: time !==== Variables Used in This Subroutine ================================ character(18) :: data_file integer(4) :: i !======================================================================= !==== Open Data File =================================================== data_file='DATA_PTCL/nnnn.dat' write(data_file(11:14),'(i4.4)') n_out open (10,file=data_file) !---- Output Status ---------------------------------------------------- if (n_out .eq. OUTP_NUM) then write(10,'(a3)') 'END' else write(10,'(a3)') 'CNT' end if !---- Output Time ------------------------------------------------------ write(10,'(e15.7)') time write(10,'(i9)') np !---- Output Data of SPH Particles ------------------------------------- if (FLAG_5PHASE_EOS == 1) then do i=1,np write(10,'(i9,i2,14e15.7)') & & i,imat(i),m(i),x(1,i),x(2,i),x(3,i), & & v(1,i),v(2,i),v(3,i), & & h(i),d(i),p(i),e(i),sv(i),t(i),s(i) end do else do i=1,np write(10,'(i9,i2,14e15.7)') & & i,imat(i),m(i),x(1,i),x(2,i),x(3,i), & & v(1,i),v(2,i),v(3,i), & & h(i),d(i),p(i),e(i),t(i),p_pk(i),t_pk(i) end do endif close (10) !==== Output Final Data ================================================ if (n_out .eq. OUTP_NUM) then open (10,file='final.dat') write(10,'(a3)') 'END' write(10,'(e15.7)') time write(10,'(i9)') np do i=1,np write(10,'(i9,i2,11e15.7)') & & i,imat(i),m(i),x(1,i),x(2,i),x(3,i), & & v(1,i),v(2,i),v(3,i), & & h(i),d(i),p(i),e(i) end do close (10) end if !======================================================================= return end subroutine sub_output !####################################################################### ! SUBROUTINE --- sub_output_CPU --- ### !####################################################################### ! ### ! Subroutine for Analyzing and Outputting CPU Time ### ! ### ! Input Arguments ### ! sys_time : System time [sec] (Total) ### ! cpu_tot : CPU time [sec] (Total) ### ! cpu_tree : CPU time [sec] (Making Tree) ### ! cpu_h : CPU time [sec] (Calculating Smoothing Length) ### ! cpu_d : CPU time [sec] (Calculating Density) ### ! cpu_p : CPU time [sec] (Calculating Pressure) ### ! cpu_a : CPU time [sec] (Calculating P Gradient Term) ### ! cpu_g : CPU time [sec] (Calculating Gravity Term) ### ! cpu_t : CPU time [sec] (Calculating Time Step) ### ! ### ! 2010/08/31 ### ! 2011/06/27 ### ! 2011/09/21 ### !####################################################################### subroutine sub_output_CPU(sys_time,cpu_tot,cpu_tree,cpu_h,cpu_d, & & cpu_p,cpu_a,cpu_g,cpu_t) implicit none !==== Input Arguments ================================================== real(8), intent(IN) :: sys_time real(8), intent(IN) :: cpu_tot real(8), intent(IN) :: cpu_tree real(8), intent(IN) :: cpu_h real(8), intent(IN) :: cpu_d real(8), intent(IN) :: cpu_p real(8), intent(IN) :: cpu_a real(8), intent(IN) :: cpu_g real(8), intent(IN) :: cpu_t !==== Variables Used in This Subroutine ================================ real(8) :: cpu_other integer(4) :: sys_time_int integer(4) :: sys_time_sec integer(4) :: sys_time_min integer(4) :: sys_time_hor integer(4) :: sys_time_day integer(4) :: cpu_tot_int integer(4) :: cpu_tot_sec integer(4) :: cpu_tot_min integer(4) :: cpu_tot_hor integer(4) :: cpu_tot_day integer(4) :: ndev !======================================================================= !---- Calculating Other CPU Time --------------------------------------- cpu_other=cpu_tot-cpu_tree-cpu_h-cpu_d & & -cpu_p-cpu_a-cpu_g-cpu_t !---- Convert [sec] to [dhms] ------------------------------------------ sys_time_int=int(sys_time) sys_time_day=sys_time_int/(60*60*24) sys_time_hor=sys_time_int/(60*60) & & -sys_time_day*24 sys_time_min=sys_time_int/60 & & -sys_time_day*24*60 & & -sys_time_hor*60 sys_time_sec=sys_time_int & & -sys_time_day*24*60*60 & & -sys_time_hor*60*60 & & -sys_time_min*60 cpu_tot_int=int(cpu_tot) cpu_tot_day=cpu_tot_int/(60*60*24) cpu_tot_hor=cpu_tot_int/(60*60) & & -cpu_tot_day*24 cpu_tot_min=cpu_tot_int/60 & & -cpu_tot_day*24*60 & & -cpu_tot_hor*60 cpu_tot_sec=cpu_tot_int & & -cpu_tot_day*24*60*60 & & -cpu_tot_hor*60*60 & & -cpu_tot_min*60 !---- Device Number ----------------- ndev=6 !------------------------------------ 555 continue !==== Output =========================================================== write(ndev,'(a40)') '============= CPU ANALYSIS =============' write(ndev,'(a40)') '------------ TOTAL SYSTEM TIME ---------' write(ndev,'(i4,a8)') sys_time_day,' day ' write(ndev,'(i4,a8)') sys_time_hor,' hour ' write(ndev,'(i4,a8)') sys_time_min,' minute' write(ndev,'(i4,a8)') sys_time_sec,' second' write(ndev,'(a40)') '------------ TOTAL CPU TIME ------------' write(ndev,'(i4,a8)') cpu_tot_day,' day ' write(ndev,'(i4,a8)') cpu_tot_hor,' hour ' write(ndev,'(i4,a8)') cpu_tot_min,' minute' write(ndev,'(i4,a8)') cpu_tot_sec,' second' write(ndev,'(a40)') '----------------- ITEM -----------------' write(ndev,'(a15,f8.1,f7.2,a2)') ' Tree List ', & & cpu_tree,cpu_tree/cpu_tot*100.0d0,' %' write(ndev,'(a15,f8.1,f7.2,a2)') ' Sm Length ', & & cpu_h,cpu_h/cpu_tot*100.0d0,' %' write(ndev,'(a15,f8.1,f7.2,a2)') ' Density ', & & cpu_d,cpu_d/cpu_tot*100.0d0,' %' write(ndev,'(a15,f8.1,f7.2,a2)') ' Pressure ', & & cpu_p,cpu_p/cpu_tot*100.0d0,' %' write(ndev,'(a15,f8.1,f7.2,a2)') ' Acc (Pres) ', & & cpu_a,cpu_a/cpu_tot*100.0d0,' %' write(ndev,'(a15,f8.1,f7.2,a2)') ' Acc (Grav) ', & & cpu_g,cpu_g/cpu_tot*100.0d0,' %' write(ndev,'(a15,f8.1,f7.2,a2)') ' Time Step ', & & cpu_t,cpu_t/cpu_tot*100.0d0,' %' write(ndev,'(a15,f8.1,f7.2,a2)') ' Others ', & & cpu_other,cpu_other/cpu_tot*100.0d0,' %' write(ndev,'(a40)') '========================================' !======================================================================= !---- Output in File -------------------- if(ndev .eq. 6) then ndev=99 open(ndev,file='CPU_TIME.dat') go to 555 endif !---------------------------------------- close(ndev) return end subroutine sub_output_CPU