14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
39 use dc_trace, only: beginsub, endsub
40 use dc_string, only: putline, printf, split, strinclude, stoa, joinchar
41 use dc_present, only: present_and_not_empty, present_and_true
44 implicit none
45 type(GTHST_NMLINFO), intent(in):: gthstnml
46 logical, intent(out):: invalid
47
48
49
50
51
52
53 character(*), intent(out):: names
54
55
56
57 logical, intent(out), optional:: err
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75 type(GTHST_NMLINFO_ENTRY), pointer:: hptr =>null()
76 integer:: stat
77 character(STRING):: cause_c
78 character(*), parameter:: subname = 'HstNmlInfoAllNameValid'
79 continue
80 call beginsub( subname )
82 cause_c = ''
83
84 names = ''
85 invalid = .false.
86
87
88
89
90
91 if ( .not. gthstnml % initialized ) then
93 cause_c = 'GTHST_NMLINFO'
94 goto 999
95 end if
96
97
98
99
100
101 hptr => gthstnml % gthstnml_list
102 do while ( associated( hptr % next ) )
103 call listnext( gthstnml_list = hptr )
104
105 if ( hptr % name_invalid ) then
106 invalid = .true.
108 names = trim(names) // adjustl( hptr % name )
109 end if
110 end do
111
112
113
114
115
116999 continue
117 call storeerror( stat, subname, err, cause_c )
118 call endsub( subname, fmt = '@invalid=%y @names=%c', &
119 & l = (/ invalid /), c1 = trim(names) )
subroutine, public storeerror(number, where, err, cause_c, cause_i)
integer, parameter, public dc_enotinit
integer, parameter, public dc_earglack
integer, parameter, public dc_noerr
integer, parameter, public dc_enoentry
Provides kind type parameter values.
integer, parameter, public stdout
Unit number for Standard OUTPUT
integer, parameter, public token
Character length for word, token
integer, parameter, public dp
Double Precision Real number
integer, parameter, public string
Character length for string
character(1), parameter, public name_delimiter