historyclose.f90 File Reference

Go to the source code of this file.

Functions/Subroutines

subroutine historyclose (history, quiet, err)
 

Function/Subroutine Documentation

◆ historyclose()

subroutine historyclose ( type(gt_history), intent(inout), optional, target  history,
logical, intent(in), optional  quiet,
logical, intent(out), optional  err 
)

Definition at line 11 of file historyclose.f90.

References dc_trace::beginsub(), dc_trace::dbgmessage(), dc_error::dc_enotinit, dc_error::dc_noerr, gtool_history_internal::default, dc_types::dp, dc_trace::endsub(), dc_present::present_and_true(), dc_error::storeerror(), dc_types::string, and dc_date_types::unit_symbol_err.

Referenced by historyautoclose1(), historyautoputdouble0(), historyautoputdouble1(), historyautoputdouble2(), historyautoputdouble3(), historyautoputdouble4(), historyautoputdouble5(), historyautoputdouble6(), historyautoputdouble7(), historyautoputint0(), historyautoputint1(), historyautoputint2(), historyautoputint3(), historyautoputint4(), historyautoputint5(), historyautoputint6(), historyautoputint7(), historyautoputreal0(), historyautoputreal1(), historyautoputreal2(), historyautoputreal3(), historyautoputreal4(), historyautoputreal5(), historyautoputreal6(), historyautoputreal7(), hsclse(), and gtool_historyauto_internal::hstvarsoutputcheck().

11  !
12  !== gtool4 データの終了処理
13  !
14  ! HistoryCreate で始まったデータ出力の終了処理をおこなうものです.
15  ! プログラム内で HistoryCreate を用いた場合, プログラムを終了する
16  ! 前に必ずこのサブルーチンを呼んで下さい.
17  !
21  use gtdata_generic, only: close, inquire
22  use gtdata_types, only: gt_variable
23  use dc_message, only: messagenotify
24  use dc_url, only: urlsplit
25  use dc_present, only: present_and_true
27  use dc_types, only: string, dp
29  use dc_trace, only: beginsub, endsub, dbgmessage
30  implicit none
31  type(gt_history), intent(inout), optional, target:: history
32  ! 出力ファイルの設定に関する情報を
33  ! 格納した構造体
34  !
35  ! ここに指定するものは,
36  ! HistoryCreate によって初期設定
37  ! されていなければなりません.
38  !
39  logical, intent(in), optional:: quiet
40  ! .true. を与えた場合,
41  ! メッセージ出力が抑制されます.
42  !
43  ! If ".true." is given,
44  ! messages are suppressed.
45  !
46  logical, intent(out), optional:: err
47  ! 例外処理用フラグ.
48  ! デフォルトでは, この手続き内でエラーが
49  ! 生じた場合, プログラムは強制終了します.
50  ! 引数 *err* が与えられる場合,
51  ! プログラムは強制終了せず, 代わりに
52  ! *err* に .true. が代入されます.
53  !
54  ! Exception handling flag.
55  ! By default, when error occur in
56  ! this procedure, the program aborts.
57  ! If this *err* argument is given,
58  ! .true. is substituted to *err* and
59  ! the program does not abort.
60  type(gt_history), pointer:: hst =>null()
61  character(STRING):: url, file
62  integer:: i, v_size
63  integer:: stat
64  character(STRING):: cause_c
65  character(len = *), parameter:: subname = "HistoryClose"
66  continue
67  call beginsub(subname)
68  stat = dc_noerr
69  cause_c = ""
70 
71  if (present(history)) then
72  hst => history
73  else
74  hst => default
75  endif
76 
77  !-----------------------------------------------------------------
78  ! 初期設定のチェック
79  ! Check initialization
80  !-----------------------------------------------------------------
81  if ( .not. hst % initialized ) then
82  stat = dc_enotinit
83  cause_c = 'GT_HISTORY'
84  goto 999
85  end if
86 
87  !-----------------------------------------------------------------
88  ! メッセージ出力用にファイル名取得
89  ! Get filename for output messages
90  !-----------------------------------------------------------------
91 
92 
93 
94 
95 
96  if ( .not. present_and_true(quiet) ) then
97  call inquire( hst % dimvars(1), & ! (in)
98  & url = url ) ! (out)
99  call urlsplit( fullname = url, & ! (in)
100  & file = file ) ! (out)
101  end if
102 
103 
104 
105 
106 
107  !-----------------------------------------------------------------
108  ! 変数のクローズ
109  ! Close variables
110  !-----------------------------------------------------------------
111 
112 
113 
114 
115 
116  v_size = size(hst % dimvars)
117  do, i = 1, v_size
118  if (.not. hst % dim_value_written(i)) &
119  call set_fake_dim_value(hst, i)
120  call close(hst % dimvars(i))
121  enddo
122  v_size = size(hst % vars)
123  do, i = 1, v_size
124  call close(hst % vars(i))
125  enddo
126 
127 
128 
129 
130 
131  deallocate(hst % dimvars)
132  v_size = size(hst % vars)
133 
134  !-----------------------------------------------------------------
135  ! 設定のクリア
136  ! Clear configurations
137  !-----------------------------------------------------------------
138  hst % unlimited_index = 0
139  hst % unlimited_units = ''
140  hst % unlimited_units_symbol = unit_symbol_err
141  if (associated(hst % dim_value_written)) deallocate(hst % dim_value_written)
142  if (associated(hst % vars)) deallocate(hst % vars)
143  if (associated(hst % growable_indices)) deallocate(hst % growable_indices)
144  if (associated(hst % count)) deallocate(hst % count)
145  if (associated(hst % var_avr_count)) deallocate(hst % var_avr_count)
146  do, i = 1, v_size
147  if (associated(hst % var_avr_data(i) % a_DataAvr)) deallocate(hst % var_avr_data(i) % a_DataAvr)
148  enddo
149  if (associated(hst % var_avr_data)) deallocate(hst % var_avr_data)
150  if (associated(hst % var_avr_firstput)) deallocate(hst % var_avr_firstput)
151  if (associated(hst % var_avr_coefsum)) deallocate(hst % var_avr_coefsum)
152  if (associated(hst % var_avr_baseint)) deallocate(hst % var_avr_baseint)
153  if (associated(hst % var_avr_prevtime)) deallocate(hst % var_avr_prevtime)
154  hst % time_bnds = 0.0_dp
155  hst % time_bnds_output_count = 0
156  hst % time_nv_index = 0
157  hst % origin_setting = .false.
158 
159 
160  !-----------------------------------------------------------------
161  ! メッセージ出力
162  ! Output messages
163  !-----------------------------------------------------------------
164 
165 
166 
167 
168 
169  if ( .not. present_and_true(quiet) ) then
170  call messagenotify('M', subname, &
171  & '"%c" is closed', &
172  & c1 = trim( file ), rank_mpi = -1 )
173  end if
174 
175 
176 
177  !-----------------------------------------------------------------
178  ! 終了処理, 例外処理
179  ! Termination and Exception handling
180  !-----------------------------------------------------------------
181  hst % initialized = .false.
182 999 continue
183  call storeerror( stat, subname, err, cause_c )
184  call endsub( subname )
type(gt_history), target, save, public default
integer, parameter, public dc_enotinit
Definition: dc_error.f90:557
integer, parameter, public unit_symbol_err
logical function, public present_and_true(arg)
Definition: dc_present.f90:80
subroutine, public storeerror(number, where, err, cause_c, cause_i)
Definition: dc_error.f90:830
integer, parameter, public dc_noerr
Definition: dc_error.f90:509
integer, parameter, public dp
倍精度実数型変数
Definition: dc_types.f90:83
subroutine, public dbgmessage(fmt, i, r, d, L, n, c1, c2, c3, ca)
Definition: dc_trace.f90:509
subroutine, public beginsub(name, fmt, i, r, d, L, n, c1, c2, c3, ca, version)
Definition: dc_trace.f90:351
種別型パラメタを提供します。
Definition: dc_types.f90:49
subroutine, public endsub(name, fmt, i, r, d, L, n, c1, c2, c3, ca)
Definition: dc_trace.f90:446
integer, parameter, public string
文字列を保持する 文字型変数の種別型パラメタ
Definition: dc_types.f90:118
Here is the call graph for this function:
Here is the caller graph for this function: