変数の出力情報を削除します.
49 implicit none
50 type(GTHST_NMLINFO), intent(inout):: gthstnml
51 character(*), intent(in):: name
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66 logical, intent(out), optional:: err
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84 type(GTHST_NMLINFO_ENTRY), pointer:: hptr =>null()
85 type(GTHST_NMLINFO_ENTRY), pointer:: hptr_prev =>null()
86 type(GTHST_NMLINFO_ENTRY), pointer:: hptr_next =>null()
87 character(TOKEN), pointer:: varnames_array(:) =>null()
88 integer:: i, vnmax
89 integer:: stat
90 character(STRING):: cause_c
91 character(*), parameter:: subname = 'HstNmlInfoDelete'
92 continue
94 & fmt = '@name=%c', &
95 & c1 = trim( name ) )
97 cause_c = ''
98
99
100
101
102
103 if ( .not. gthstnml % initialized ) then
105 cause_c = 'GTHST_NMLINFO'
106 goto 999
107 end if
108
109 if ( .not. gthstnml % define_mode ) then
111 cause_c = 'Delete'
112 goto 999
113 end if
114
115
116
117
118
121 call dbgmessage(
'multiple entries (%c) will be deleted', c1 = trim(name) )
123 & carray = varnames_array )
124 vnmax = size( varnames_array )
125
126 do i = 1, vnmax
128 & gthstnml = gthstnml, &
129 & name = varnames_array(i), &
130 & err = err )
132 deallocate( varnames_array )
134 goto 999
135 end if
136 end do
137 deallocate( varnames_array )
138 goto 999
139 end if
140 end if
141
142
143
144
145
146 hptr => gthstnml % gthstnml_list
148 & name = name, &
149 & previous = hptr_prev, &
150 & next = hptr_next )
151
152 if ( .not. associated( hptr ) ) goto 999
153 if ( ( trim(hptr % name) /= '' ) .and. associated( hptr_prev ) ) then
154 call dbgmessage(
'entry (%c) is deleted', c1 = trim( adjustl( name ) ) )
155 hptr_prev % next => hptr_next
156 deallocate( hptr )
157 end if
158
159
160
161
162
163999 continue
164 call storeerror( stat, subname, err, cause_c )
recursive subroutine hstnmlinfodelete(gthstnml, name, err)
subroutine, public storeerror(number, where, err, cause_c, cause_i)
integer, parameter, public usr_errno
-1000 以下: ユーザー定義
integer, parameter, public dc_noerr
エラー等を保持
integer, parameter, public dc_enotinit
-400 以下: dc ユーティリティのエラー
integer, parameter, public hst_enotindefine
-500 以下: データ入出力層のエラー
logical function, public present_and_not_empty(arg)
logical function, public present_and_true(arg)
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
文字列を保持する 文字型変数の種別型パラメタ
character(1), parameter, public name_delimiter