94 public::
operator(+),
operator(-)
116 character(STRING):: name
117 real(
dp):: start_time
119 real(
dp):: elapsed_time
121 logical:: initialized = .false.
124 module procedure dcclockcreate0
127 module procedure dcclockclose0
130 module procedure dcclockstart0
133 module procedure dcclockstop0
136 module procedure dcclockputline0
139 module procedure dcclockgetr
140 module procedure dcclockgetd
143 module procedure dcclockevalsecd
146 module procedure dcclocktochar0
149 module procedure dcclockresult0
151 interface operator(+)
152 module procedure dcclockadd
154 interface operator(-)
155 module procedure dcclocksubtract
158 module procedure dcclocksetname0
161 module procedure dcclockpredict0
167 module procedure dcclockcreate0
170 module procedure dcclockclose0
173 module procedure dcclockstart0
176 module procedure dcclockstop0
179 module procedure dcclockputline0
182 module procedure dcclockgetr
183 module procedure dcclockgetd
186 module procedure dcclockevalsecd
189 module procedure dcclocktochar0
192 module procedure dcclockresult0
195 module procedure dcclocksetname0
198 module procedure dcclockpredict0
200 character(*),
parameter:: version = &
202 &
'$Id: dc_clock.F90,v 1.1 2009-03-20 09:09:53 morikawa Exp $'
223 subroutine dcclockcreate0(clk, name)
225 use dc_date,
only: dcdatetimecreate
227 type(
clock),
intent(out):: clk
228 character(*),
intent(in):: name
229 character(*),
parameter:: subname =
'DCClockCreate'
231 call beginsub(subname,
'name=%c', c1=trim(name), version=version)
232 if (clk % initialized)
then
233 call messagenotify(
'W', subname,
'This argument (type CLOCK) is already initialized.')
238 clk % elapsed_time = 0.0
239 clk % start_time = - 1.0
240 clk % initialized = .true.
241 call dcdatetimecreate(clk % start_date)
245 end subroutine dcclockcreate0
261 subroutine dcclockclose0(clk)
263 type(
clock),
intent(inout):: clk
264 character(*),
parameter:: subname =
'DCClockClose'
267 if (clk % initialized)
then
268 clk % initialized = .false.
272 end subroutine dcclockclose0
297 subroutine dcclockstart0(clk, err)
304 type(
clock),
intent(inout):: clk
305 logical,
intent(out),
optional:: err
306 character(STRING):: cause_c
308 character(*),
parameter:: subname =
'DCClockStart'
313 if (.not. clk % initialized)
then
314 call messagenotify(
'W', subname,
'Call Create before Start in dc_clock.')
315 call dbgmessage(
'Ignored because input argument was not initialized.')
319 call cpu_time(clk % start_time)
322 & c1=trim(clk % name), d=(/clk % start_time/) )
326 end subroutine dcclockstart0
351 subroutine dcclockstop0(clk, err)
360 type(
clock),
intent(inout):: clk
361 logical,
intent(out),
optional:: err
362 character(STRING):: cause_c
365 character(*),
parameter:: subname =
'DCClockStop'
370 if (.not. clk % initialized)
then
371 call messagenotify(
'W', subname,
'Call Create before Stop in dc_clock.')
372 call dbgmessage(
'Ignored because input argument was not initialized.')
375 elseif (clk % start_time < 0.0_dp)
then
376 call messagenotify(
'W', subname,
'Call Start before Stop in dc_clock.')
377 call dbgmessage(
'Ignored because input argument was not started.')
380 call cpu_time(stop_time)
382 clk % elapsed_time = clk % elapsed_time + stop_time - clk % start_time
383 clk % start_time = - 1.0
384 call dbgmessage(
'name=%c, cpu_time=%f, elapsed_time=%f', &
385 & c1=trim(clk % name), d=(/stop_time, clk % elapsed_time/))
389 end subroutine dcclockstop0
416 subroutine dcclockgetr(clk, sec, err)
422 type(
clock),
intent(in):: clk
423 real,
intent(out):: sec
424 logical,
intent(out),
optional:: err
425 character(STRING):: cause_c
427 character(*),
parameter:: subname =
'DCClockGetR'
432 if (.not. clk % initialized)
then
433 call messagenotify(
'W', subname,
'Call Create before Get in dc_clock.')
434 call dbgmessage(
'Ignored because input argument was not initialized.')
438 sec = real(clk % elapsed_time, kind=kind(sec))
440 & c1=trim(clk % name), r=(/sec/))
444 end subroutine dcclockgetr
471 subroutine dcclockgetd(clk, sec, err)
478 type(
clock),
intent(in):: clk
479 real(DP),
intent(out):: sec
480 logical,
intent(out),
optional:: err
481 character(STRING):: cause_c
483 character(*),
parameter:: subname =
'DCClockGetD'
488 if (.not. clk % initialized)
then
489 call messagenotify(
'W', subname,
'Call Create before Get in dc_clock.')
490 call dbgmessage(
'Ignored because input argument was not initialized.')
494 sec = clk % elapsed_time
496 & c1=trim(clk % name), d=(/sec/))
500 end subroutine dcclockgetd
521 function dcclockevalsecd(clk)
result(result)
524 type(
clock),
intent(in):: clk
528 call dcclockgetd(clk,
result, err)
530 end function dcclockevalsecd
551 function dcclocktochar0(clk)
result(result)
555 type(
clock),
intent(in):: clk
556 character(STRING)::
result
557 character(20):: clk_name
561 name_len = min(len(clk_name), len_trim(clk % name))
562 if (name_len > 0)
then
563 clk_name(1:name_len) = clk % name(1:name_len)
565 if (clk % initialized)
then
567 & c2=trim(result_value_form(clk % elapsed_time)), &
568 & c3=trim(fit_unit_value(clk % elapsed_time)))
572 end function dcclocktochar0
604 subroutine dcclockputline0(clk, unit, indent, err)
612 type(
clock),
intent(in):: clk
613 integer,
intent(in),
optional:: unit
614 character(*),
intent(in),
optional:: indent
615 logical,
intent(out),
optional:: err
617 character(STRING):: cause_c
620 character(STRING):: indent_str
621 character(*),
parameter:: subname =
'DCClockPutLine'
626 if (.not. clk % initialized)
then
627 call messagenotify(
'W', subname,
'Call Create before PutLine in dc_clock.')
628 call dbgmessage(
'Ignored because input argument was not initialized.')
632 if (
present(unit))
then
639 if (
present(indent))
then
640 if (len(indent) /= 0)
then
641 indent_len = len(indent)
642 indent_str(1:indent_len) = indent
646 & indent_str(1:indent_len) // &
647 &
'#<CLOCK:: @name=%c @clocking=%y @elapsed_time=%f sec. %c @start_date=%c>', &
648 & c1=trim(clk % name), l=(/clk % start_time > 0.0_dp/), &
649 & d=(/clk % elapsed_time/), &
650 & c2=trim(fit_unit_value(clk % elapsed_time)), &
651 & c3=trim(
tochar(clk % start_date)))
652 call dbgmessage(
'name=%c, output to device number %d', &
653 & c1=trim(clk % name), i=(/out_unit/))
657 end subroutine dcclockputline0
712 subroutine dcclockresult0(clks, unit, total_auto, clk_total, total_name, err)
719 type(
clock),
intent(in):: clks(:)
720 integer,
intent(in),
optional:: unit
721 logical,
intent(in),
optional:: total_auto
722 type(
clock),
intent(in),
optional:: clk_total
723 logical,
intent(out),
optional:: err
724 character(*),
intent(in),
optional:: total_name
725 integer:: out_unit, i, clks_size, ra
726 character(20):: clk_name
728 character(STRING):: cause_c
729 character(STRING):: total_name_work
730 type(
clock):: clk_auto_total
731 logical:: total_print_complete
732 real(DP):: elapsed_time_val_cor
734 character(*),
parameter:: total_time_mes =
' TOTAL TIME = '
735 integer:: myrank_mpi, nprocs_mpi
736 character(*),
parameter:: subname =
'DCClockResult'
741 clks_size =
size(clks)
743 if (.not. clks(i) % initialized)
then
744 call messagenotify(
'W', subname,
'Call Create before Result in dc_clock.')
745 call dbgmessage(
'Ignored because input argument was not initialized.')
750 if (
present(unit))
then
755 if (
present(total_name))
then
756 total_name_work =
' (' // trim(total_name) //
')'
762 do ra = 0, nprocs_mpi - 1
764 if ( myrank_mpi < 0 )
then
766 &
' ############## CPU TIME SUMMARY%c################', &
767 & c1=trim(total_name_work) //
' ')
770 &
' ####### CPU TIME SUMMARY%c#### [rank=%06d] ####', &
771 & c1=trim(total_name_work) //
' ', &
772 & i = (/myrank_mpi/) )
776 name_len = min(len(clk_name), len_trim(clks(i) % name))
777 if (name_len > 0)
then
778 clk_name(1:name_len) = clks(i) % name(1:name_len)
780 elapsed_time_val_cor = clks(i) % elapsed_time
781 if (elapsed_time_val_cor < 0.0_dp) elapsed_time_val_cor = 0.0_dp
783 &
' %c%c %c', c1=clk_name, &
784 & c2=trim(result_value_form(elapsed_time_val_cor)), &
785 & c3=trim(fit_unit_value(clks(i) % elapsed_time)))
787 total_print_complete = .false.
788 if (
present(clk_total))
then
789 if (clk_total % initialized)
then
791 &
' ------------------------------------------------')
792 elapsed_time_val_cor = clk_total % elapsed_time
793 if (elapsed_time_val_cor < 0.0_dp) elapsed_time_val_cor = 0.0_dp
795 &
' %c%c %c', c1=total_time_mes, &
796 & c2=trim(result_value_form(elapsed_time_val_cor)), &
797 & c3=trim(fit_unit_value(clk_total % elapsed_time)))
798 total_print_complete = .true.
801 if (
present(total_auto) .and. .not. total_print_complete)
then
803 clk_auto_total = clks(1)
804 if (clks_size > 1)
then
806 clk_auto_total = clk_auto_total + clks(i)
810 &
' ------------------------------------------------')
811 elapsed_time_val_cor = clk_auto_total % elapsed_time
812 if (elapsed_time_val_cor < 0.0_dp) elapsed_time_val_cor = 0.0_dp
814 &
' %c%c %c', c1=total_time_mes, &
815 & c2=trim(result_value_form(elapsed_time_val_cor)), &
816 & c3=trim(fit_unit_value(clk_auto_total % elapsed_time)))
819 call dbgmessage(
'total results, output to device number %d', &
825 end subroutine dcclockresult0
829 function result_value_form(value)
result(result)
832 character(TOKEN):: result
833 real(DP),
intent(in):: value
835 write(
result,
"(e15.6)")
value
836 end function result_value_form
845 function fit_unit_value(sec, diff)
result(result)
848 use dc_date,
only: dcdifftimecreate, evalday, evalhour, evalmin,
evalsec
850 character(TOKEN):: result
851 real(DP),
intent(in):: sec
854 character(TOKEN):: unit
856 character(TOKEN):: cval
858 if (
present(diff) )
then
861 call dcdifftimecreate( diffw, sec = sec )
863 if (evalday(diffw) > 1.0_dp)
then
865 value = evalday(diffw)
866 elseif (evalhour(diffw) > 1.0_dp)
then
868 value = evalhour(diffw)
869 elseif (evalmin(diffw) > 1.0_dp)
then
871 value = evalmin(diffw)
876 cval = printf_g5_2(
value)
877 result =
'(' // trim(adjustl(cval)) // trim(unit) //
')'
878 end function fit_unit_value
884 function printf_g5_2(value)
result(result)
888 character(TOKEN):: result
889 real(DP),
intent(in):: value
890 character(TOKEN):: int_part, dem_part
893 write(int_part,
"(i20)") int(
value)
894 dem_int = nint((
value - int(
value)) * 100)
895 if (dem_int < 0) dem_int = - dem_int
896 if (dem_int == 100)
then
898 write(int_part,
"(i20)") int(
value) + 1
900 dem_part =
cprintft(
'%02d', i=(/dem_int/))
901 result = trim(adjustl(int_part)) //
'.' // trim(dem_part)
902 end function printf_g5_2
927 function dcclockadd(clk1, clk2)
result(clk_total)
929 use dc_date,
only:
operator(+),
operator(<)
931 type(
clock),
intent(in):: clk1
932 type(
clock),
intent(in):: clk2
933 type(
clock):: clk_total
935 if (.not. clk1 % initialized .or. .not. clk2 % initialized)
then
936 clk_total % initialized = .false.
939 clk_total % name =
cprintf(
'%c+%c', &
940 & c1=trim(clk1 % name), c2=trim(clk2 % name))
941 clk_total % start_time = - 1.0
942 clk_total % initialized = .true.
943 clk_total % elapsed_time = 0.0
944 if (clk1 % start_date < clk2 % start_date)
then
945 clk_total % start_date = clk1 % start_date
947 clk_total % start_date = clk2 % start_date
949 clk_total % elapsed_time = &
950 & clk1 % elapsed_time + clk2 % elapsed_time
951 end function dcclockadd
976 function dcclocksubtract(clk1, clk2)
result(clk_total)
978 use dc_date,
only:
operator(-),
operator(<)
980 type(
clock),
intent(in):: clk1
981 type(
clock),
intent(in):: clk2
982 type(
clock):: clk_total
984 if (.not. clk1 % initialized .or. .not. clk2 % initialized)
then
985 clk_total % initialized = .false.
988 clk_total % name =
cprintf(
'%c-%c', &
989 & c1=trim(clk1 % name), c2=trim(clk2 % name))
990 clk_total % start_time = - 1.0
991 clk_total % initialized = .true.
992 clk_total % elapsed_time = 0.0
993 if (clk1 % start_date < clk2 % start_date)
then
994 clk_total % start_date = clk1 % start_date
996 clk_total % start_date = clk2 % start_date
998 clk_total % elapsed_time = &
999 & clk1 % elapsed_time - clk2 % elapsed_time
1000 end function dcclocksubtract
1029 subroutine dcclocksetname0(clk, name, err)
1034 type(
clock),
intent(inout):: clk
1035 character(*),
intent(in):: name
1036 logical,
intent(out),
optional:: err
1037 character(STRING):: cause_c
1039 character(*),
parameter:: subname =
'DCClockSetName'
1044 if (.not. clk % initialized)
then
1045 call messagenotify(
'W', subname,
'Call Create before Set_Name in dc_clock.')
1046 call dbgmessage(
'Ignored because input argument was not initialized.')
1051 call dbgmessage(
'set new name "%c"', c1=trim(clk % name))
1055 end subroutine dcclocksetname0
1124 subroutine dcclockpredict0(clk, progress, unit, err)
1133 type(
clock),
intent(in):: clk
1134 real,
intent(in):: progress
1135 integer,
intent(in),
optional:: unit
1136 logical,
intent(out),
optional:: err
1137 character(STRING):: cause_c
1138 integer:: stat, out_unit
1141 character(7):: prog_percent
1142 character(25):: prog_bar
1143 integer:: prog_bar_ptr
1145 character(*),
parameter:: subname =
'DCClockPredict'
1150 if (.not. clk % initialized)
then
1151 call messagenotify(
'W', subname,
'Call Create before Predict in dc_clock.')
1152 call dbgmessage(
'Ignored because input argument was not initialized.')
1156 if (progress <= 0.0)
then
1157 call messagenotify(
'W', subname,
'Specify 0.0 -- 1.0 value to "progress"')
1159 elseif (progress > 1.0)
then
1160 call messagenotify(
'W', subname,
'Over 1.0 value to "progress" was modified to 1.0')
1163 prog_valid = progress
1165 if (
present(unit))
then
1170 call dcdifftimecreate( remain_diff, &
1171 & sec = real(nint(
evalsec(clk) / prog_valid * (1.0 - prog_valid)),
dp) )
1172 call dcdatetimecreate(cur_date)
1173 comp_date = cur_date + remain_diff
1175 prog_percent = adjustr(trim(printf_g5_2(real(prog_valid * 100,
dp))) //
'%')
1177 prog_bar_ptr = int(prog_valid * 25)
1178 if (prog_bar_ptr > 0) prog_bar(1:prog_bar_ptr) =
'*************************'
1179 call printf(out_unit,
'')
1181 &
' ########## PREDICTION OF CALCULATION ###########')
1183 &
' Start Date %c', c1=trim(
tochar(clk % start_date)))
1185 &
' Current Date %c', c1=trim(
tochar(cur_date)))
1187 &
' Progress %c [%c]', c1=prog_percent, c2=prog_bar)
1189 &
' Remaining CPU TIME %c %c', &
1190 & c1=trim(result_value_form(
evalsec(remain_diff))), &
1191 & c2=trim(fit_unit_value(0.0_dp, remain_diff)))
1193 &
' Completion Date %c', c1=trim(
tochar(comp_date)))
1197 end subroutine dcclockpredict0
subroutine, public storeerror(number, where, err, cause_c, cause_i)
integer, parameter, public dc_enotinit
-400 以下: dc ユーティリティのエラー
integer, parameter, public dc_noerr
エラー等を保持
subroutine, public dbgmessage(fmt, i, r, d, l, n, c1, c2, c3, ca)
subroutine, public beginsub(name, fmt, i, r, d, l, n, c1, c2, c3, ca, version)
subroutine, public endsub(name, fmt, i, r, d, l, n, c1, c2, c3, ca)
integer, parameter, public token
単語やキーワードを保持する文字型変数の種別型パラメタ
integer, parameter, public string
文字列を保持する 文字型変数の種別型パラメタ
integer, parameter, public stdout
標準出力の装置番号
integer, parameter, public dp
倍精度実数型変数