(git:d18deda)
Loading...
Searching...
No Matches
xmgrace.F
Go to the documentation of this file.
1!--------------------------------------------------------------------------------------------------!
2! CP2K: A general program to perform molecular dynamics simulations !
3! Copyright 2000-2025 CP2K developers group <https://cp2k.org> !
4! !
5! SPDX-License-Identifier: GPL-2.0-or-later !
6!--------------------------------------------------------------------------------------------------!
7
8! **************************************************************************************************
9!> \brief Routines to facilitate writing XMGRACE files
10!> \par History
11!> none
12!> \author JGH (10.02.2025)
13! **************************************************************************************************
14MODULE xmgrace
15
16 USE kinds, ONLY: dp
17 USE machine, ONLY: m_datum
18#include "../base/base_uses.f90"
19
20 IMPLICIT NONE
21
22 PRIVATE
23
24 CHARACTER(len=*), PARAMETER, PRIVATE :: moduleN = 'xmgrace'
25
26 PUBLIC :: xm_write_defaults, xm_write_frameport, xm_write_frame, xm_graph_info, &
27 xm_graph_data
28
29CONTAINS
30
31! **************************************************************************************************
32!> \brief ...
33!> \param iw ...
34! **************************************************************************************************
35 SUBROUTINE xm_write_defaults(iw)
36 INTEGER, INTENT(IN) :: iw
37
38 CHARACTER(len=20) :: date
39
40 IF (iw > 0) THEN
41 WRITE (iw, '(A)') '# CP2K Grace file', '#', '@version 50125', '@page size 792, 612', &
42 '@page scroll 5%', '@page inout 5%', '@link page off'
43 WRITE (iw, '(A)') '@map font 0 to "Times-Roman", "Times-Roman"', &
44 '@map font 1 to "Times-Italic", "Times-Italic"', &
45 '@map font 2 to "Times-Bold", "Times-Bold"', &
46 '@map font 3 to "Times-BoldItalic", "Times-BoldItalic"', &
47 '@map font 4 to "Helvetica", "Helvetica"', &
48 '@map font 5 to "Helvetica-Oblique", "Helvetica-Oblique"', &
49 '@map font 6 to "Helvetica-Bold", "Helvetica-Bold"', &
50 '@map font 7 to "Helvetica-BoldOblique", "Helvetica-BoldOblique"', &
51 '@map font 8 to "Courier", "Courier"', &
52 '@map font 9 to "Courier-Oblique", "Courier-Oblique"', &
53 '@map font 10 to "Courier-Bold", "Courier-Bold"', &
54 '@map font 11 to "Courier-BoldOblique", "Courier-BoldOblique"', &
55 '@map font 12 to "Symbol", "Symbol"', &
56 '@map font 13 to "ZapfDingbats", "ZapfDingbats"'
57 WRITE (iw, '(A)') '@map color 0 to (255, 255, 255), "white"', &
58 '@map color 1 to (0, 0, 0), "black"', &
59 '@map color 2 to (255, 0, 0), "red"', &
60 '@map color 3 to (0, 255, 0), "green"', &
61 '@map color 4 to (0, 0, 255), "blue"', &
62 '@map color 5 to (255, 255, 0), "yellow"', &
63 '@map color 6 to (188, 143, 143), "brown"', &
64 '@map color 7 to (220, 220, 220), "grey"', &
65 '@map color 8 to (148, 0, 211), "violet"', &
66 '@map color 9 to (0, 255, 255), "cyan"', &
67 '@map color 10 to (255, 0, 255), "magenta"', &
68 '@map color 11 to (255, 165, 0), "orange"', &
69 '@map color 12 to (114, 33, 188), "indigo"', &
70 '@map color 13 to (103, 7, 72), "maroon"', &
71 '@map color 14 to (64, 224, 208), "turquoise"', &
72 '@map color 15 to (0, 139, 0), "green4"'
73 WRITE (iw, '(A)') '@reference date 0', '@date wrap off', '@date wrap year 1950'
74 WRITE (iw, '(A)') '@default linewidth 1.0', '@default linestyle 1', &
75 '@default color 1', '@default pattern 1', '@default font 0', &
76 '@default char size 1.000000', '@default symbol size 1.000000', &
77 '@default sformat "%.8g"', '@background color 0', '@page background fill on'
78 WRITE (iw, '(A)') '@timestamp off', '@timestamp 0.03, 0.03', '@timestamp color 1', &
79 '@timestamp rot 0', '@timestamp font 0', '@timestamp char size 1.000000'
80 CALL m_datum(date)
81
82 WRITE (iw, '(A)') '@timestamp def '//trim(date)
83
84 END IF
85
86 END SUBROUTINE xm_write_defaults
87
88! **************************************************************************************************
89!> \brief ...
90!> \param iw ...
91! **************************************************************************************************
92 SUBROUTINE xm_write_frameport(iw)
93 INTEGER, INTENT(IN) :: iw
94
95 IF (iw > 0) THEN
96 WRITE (iw, '(A)') '@r0 off', '@link r0 to g0', '@r0 type above', '@r0 linestyle 1', &
97 '@r0 linewidth 1.0', '@r0 color 1', '@r0 line 0, 0, 0, 0'
98 WRITE (iw, '(A)') '@r1 off', '@link r1 to g0', '@r1 type above', '@r1 linestyle 1', &
99 '@r1 linewidth 1.0', '@r1 color 1', '@r1 line 0, 0, 0, 0'
100 WRITE (iw, '(A)') '@r2 off', '@link r2 to g0', '@r2 type above', '@r2 linestyle 1', &
101 '@r2 linewidth 1.0', '@r2 color 1', '@r2 line 0, 0, 0, 0'
102 WRITE (iw, '(A)') '@r3 off', '@link r3 to g0', '@r3 type above', '@r3 linestyle 1', &
103 '@r3 linewidth 1.0', '@r3 color 1', '@r3 line 0, 0, 0, 0'
104
105 WRITE (iw, '(A)') '@g0 on', '@g0 hidden false', '@g0 type XY', '@g0 stacked false', &
106 '@g0 bar hgap 0.000000', '@g0 fixedpoint off', '@g0 fixedpoint type 0', &
107 '@g0 fixedpoint xy 0.000000, 0.000000', '@g0 fixedpoint format general general', &
108 '@g0 fixedpoint prec 6, 6'
109 END IF
110 END SUBROUTINE xm_write_frameport
111
112! **************************************************************************************************
113!> \brief ...
114!> \param iw ...
115!> \param wcoord ...
116!> \param title ...
117!> \param subtitle ...
118!> \param xlabel ...
119!> \param ylabel ...
120! **************************************************************************************************
121 SUBROUTINE xm_write_frame(iw, wcoord, title, subtitle, xlabel, ylabel)
122 INTEGER, INTENT(IN) :: iw
123 REAL(kind=dp), DIMENSION(:) :: wcoord
124 CHARACTER(len=*) :: title, subtitle, xlabel, ylabel
125
126 REAL(kind=dp) :: x1, x2, y1, y2
127
128 x1 = wcoord(1)
129 y1 = wcoord(2)
130 x2 = wcoord(3)
131 y2 = wcoord(4)
132 IF (iw > 0) THEN
133 WRITE (iw, '(A)') '@with g0'
134 WRITE (iw, fmt='(A)', advance='NO') '@ world '
135 WRITE (iw, fmt='(4(F8.1,A))') x1, ',', y1, ',', x2, ',', y2
136 WRITE (iw, '(A)') '@ stack world 0, 0, 0, 0'
137 WRITE (iw, '(A)') '@ znorm 1', &
138 '@ view 0.150000, 0.150000, 1.150000, 0.850000'
139 WRITE (iw, '(A)') '@ title "'//title//'"'
140 WRITE (iw, '(A)') '@ title font 0', &
141 '@ title size 1.500000', &
142 '@ title color 1'
143 WRITE (iw, '(A)') '@ subtitle "'//subtitle//'"'
144 WRITE (iw, '(A)') '@ title font 0', &
145 '@ title size 1.000000', &
146 '@ title color 1'
147 !
148 WRITE (iw, '(A)') '@ xaxes scale Normal'
149 WRITE (iw, '(A)') '@ yaxes scale Normal'
150 WRITE (iw, '(A)') '@ xaxes invert off'
151 WRITE (iw, '(A)') '@ yaxes invert off'
152 ! xaxis
153 WRITE (iw, '(A)') '@ xaxis on', &
154 '@ xaxis type zero false', &
155 '@ xaxis offset 0.000000 , 0.000000', &
156 '@ xaxis bar on', &
157 '@ xaxis bar color 1', &
158 '@ xaxis bar linestyle 1', &
159 '@ xaxis bar linewidth 1.0'
160 WRITE (iw, '(A)') '@ xaxis label "'//xlabel//'"'
161 WRITE (iw, '(A)') '@ xaxis label layout para', &
162 '@ xaxis label place auto', &
163 '@ xaxis label char size 1.480000', &
164 '@ xaxis label font 0', &
165 '@ xaxis label color 1', &
166 '@ xaxis label place normal'
167 WRITE (iw, '(A)') '@ xaxis tick on', '@ xaxis tick major 2', '@ xaxis tick minor ticks 1', &
168 '@ xaxis tick default 6', '@ xaxis tick place rounded true', '@ xaxis tick in', &
169 '@ xaxis tick major size 1.000000', '@ xaxis tick major color 1', &
170 '@ xaxis tick major linewidth 3.0', '@ xaxis tick major linestyle 1', &
171 '@ xaxis tick major grid off', '@ xaxis tick minor color 1', &
172 '@ xaxis tick minor linewidth 3.0', '@ xaxis tick minor linestyle 1', &
173 '@ xaxis tick minor grid off', '@ xaxis tick minor size 0.500000'
174 WRITE (iw, '(A)') '@ xaxis ticklabel on', '@ xaxis ticklabel format general', &
175 '@ xaxis ticklabel prec 5', '@ xaxis ticklabel formula ""', '@ xaxis ticklabel append ""', &
176 '@ xaxis ticklabel prepend ""', '@ xaxis ticklabel angle 0', '@ xaxis ticklabel skip 0', &
177 '@ xaxis ticklabel stagger 0', '@ xaxis ticklabel place normal', &
178 '@ xaxis ticklabel offset auto', &
179 '@ xaxis ticklabel offset 0.000000 , 0.010000', '@ xaxis ticklabel start type auto', &
180 '@ xaxis ticklabel start 0.000000', '@ xaxis ticklabel stop type auto', &
181 '@ xaxis ticklabel stop 0.000000', '@ xaxis ticklabel char size 1.480000', &
182 '@ xaxis ticklabel font 0', '@ xaxis ticklabel color 1', &
183 '@ xaxis tick place both', '@ xaxis tick spec type none'
184 ! yaxis
185 WRITE (iw, '(A)') '@ yaxis on', &
186 '@ yaxis type zero false', &
187 '@ yaxis offset 0.000000 , 0.000000', &
188 '@ yaxis bar on', &
189 '@ yaxis bar color 1', &
190 '@ yaxis bar linestyle 1', &
191 '@ yaxis bar linewidth 1.0'
192 WRITE (iw, '(A)') '@ yaxis label "'//ylabel//'"'
193 WRITE (iw, '(A)') '@ yaxis label layout para', &
194 '@ yaxis label place auto', &
195 '@ yaxis label char size 1.000000', &
196 '@ yaxis label font 0', &
197 '@ yaxis label color 1', &
198 '@ yaxis label place normal'
199 WRITE (iw, '(A)') '@ yaxis tick on', '@ yaxis tick major 0.5', '@ yaxis tick minor ticks 1', &
200 '@ yaxis tick default 6', '@ yaxis tick place rounded true', '@ yaxis tick in', &
201 '@ yaxis tick major size 1.480000', '@ yaxis tick major color 1', &
202 '@ yaxis tick major linewidth 3.0', '@ yaxis tick major linestyle 1', &
203 '@ yaxis tick major grid off', '@ yaxis tick minor color 1', &
204 '@ yaxis tick minor linewidth 3.0', '@ yaxis tick minor linestyle 1', &
205 '@ yaxis tick minor grid off', '@ yaxis tick minor size 0.500000'
206 WRITE (iw, '(A)') '@ yaxis ticklabel on', '@ yaxis ticklabel format general', &
207 '@ yaxis ticklabel prec 5', '@ yaxis ticklabel formula ""', '@ yaxis ticklabel append ""', &
208 '@ yaxis ticklabel prepend ""', '@ yaxis ticklabel angle 0', '@ yaxis ticklabel skip 0', &
209 '@ yaxis ticklabel stagger 0', '@ yaxis ticklabel place normal', &
210 '@ yaxis ticklabel offset auto', &
211 '@ yaxis ticklabel offset 0.000000 , 0.010000', '@ yaxis ticklabel start type auto', &
212 '@ yaxis ticklabel start 0.000000', '@ yaxis ticklabel stop type auto', &
213 '@ yaxis ticklabel stop 0.000000', '@ yaxis ticklabel char size 1.480000', &
214 '@ yaxis ticklabel font 0', '@ yaxis ticklabel color 1', &
215 '@ yaxis tick place both', '@ yaxis tick spec type none'
216 WRITE (iw, '(A)') '@ altxaxis off', '@ altyaxis off'
217 ! Legend
218 WRITE (iw, '(A)') '@ legend on', &
219 '@ legend loctype view', &
220 '@ legend 0.8, 0.4', &
221 '@ legend box color 1', &
222 '@ legend box pattern 1', &
223 '@ legend box linewidth 2.0', &
224 '@ legend box linestyle 1', &
225 '@ legend box fill color 0', &
226 '@ legend box fill pattern 1', &
227 '@ legend font 0', &
228 '@ legend char size 1.000000', &
229 '@ legend color 1', &
230 '@ legend length 4', &
231 '@ legend vgap 1', &
232 '@ legend hgap 1', &
233 '@ legend invert false'
234 ! Frame
235 WRITE (iw, '(A)') '@ frame type 0', &
236 '@ frame linestyle 1', &
237 '@ frame linewidth 3.0', &
238 '@ frame color 1', &
239 '@ frame pattern 1', &
240 '@ frame background color 0', &
241 '@ frame background pattern 0'
242 END IF
243 END SUBROUTINE xm_write_frame
244
245! **************************************************************************************************
246!> \brief ...
247!> \param iw ...
248!> \param gnum ...
249!> \param linewidth ...
250!> \param legend ...
251! **************************************************************************************************
252 SUBROUTINE xm_graph_info(iw, gnum, linewidth, legend)
253 INTEGER, INTENT(IN) :: iw, gnum
254 REAL(kind=dp), INTENT(IN) :: linewidth
255 CHARACTER(LEN=*) :: legend
256
257 CHARACTER(LEN=8) :: cin, cnum, cval
258
259 IF (iw > 0) THEN
260 WRITE (cnum, '(I2)') gnum
261 WRITE (cval, '(F3.1)') linewidth
262 cin = "@ s"//trim(adjustl(cnum))
263 WRITE (cnum, '(I2)') gnum + 1
264 WRITE (iw, '(A)') trim(cin)//' hidden false'
265 WRITE (iw, '(A)') trim(cin)//' type xy'
266 WRITE (iw, '(A)') trim(cin)//' symbol 0 '
267 WRITE (iw, '(A)') trim(cin)//' symbol size 1.000000'
268 WRITE (iw, '(A)') trim(cin)//' symbol color '//trim(adjustl(cnum))
269 WRITE (iw, '(A)') trim(cin)//' symbol pattern 1'
270 WRITE (iw, '(A)') trim(cin)//' symbol fill color 1'
271 WRITE (iw, '(A)') trim(cin)//' symbol fill pattern 0'
272 WRITE (iw, '(A)') trim(cin)//' symbol linewidth 1.0'
273 WRITE (iw, '(A)') trim(cin)//' symbol linestyle 1'
274 WRITE (iw, '(A)') trim(cin)//' symbol char 65 '
275 WRITE (iw, '(A)') trim(cin)//' symbol char font 0'
276 WRITE (iw, '(A)') trim(cin)//' symbol skip 0'
277 WRITE (iw, '(A)') trim(cin)//' line type 1'
278 WRITE (iw, '(A)') trim(cin)//' line linestyle 1'
279 WRITE (iw, '(A)') trim(cin)//' line linewidth '//trim(cval)
280 WRITE (iw, '(A)') trim(cin)//' line color '//trim(adjustl(cnum))
281 WRITE (iw, '(A)') trim(cin)//' line pattern 1'
282 WRITE (iw, '(A)') trim(cin)//' baseline type 0'
283 WRITE (iw, '(A)') trim(cin)//' baseline off'
284 WRITE (iw, '(A)') trim(cin)//' dropline off'
285 WRITE (iw, '(A)') trim(cin)//' fill type 0'
286 WRITE (iw, '(A)') trim(cin)//' fill rule 0'
287 WRITE (iw, '(A)') trim(cin)//' fill color '//trim(adjustl(cnum))
288 WRITE (iw, '(A)') trim(cin)//' fill pattern 1'
289 WRITE (iw, '(A)') trim(cin)//' avalue off'
290 WRITE (iw, '(A)') trim(cin)//' avalue type 2'
291 WRITE (iw, '(A)') trim(cin)//' avalue char size 1.000000'
292 WRITE (iw, '(A)') trim(cin)//' avalue font 0'
293 WRITE (iw, '(A)') trim(cin)//' avalue color '//trim(adjustl(cnum))
294 WRITE (iw, '(A)') trim(cin)//' avalue rot 0'
295 WRITE (iw, '(A)') trim(cin)//' avalue format general'
296 WRITE (iw, '(A)') trim(cin)//' avalue prec 3'
297 WRITE (iw, '(A)') trim(cin)//' avalue prepend ""'
298 WRITE (iw, '(A)') trim(cin)//' avalue append ""'
299 WRITE (iw, '(A)') trim(cin)//' avalue offset 0.000000 , 0.000000'
300 WRITE (iw, '(A)') trim(cin)//' errorbar on'
301 WRITE (iw, '(A)') trim(cin)//' errorbar place both'
302 WRITE (iw, '(A)') trim(cin)//' errorbar color '//trim(adjustl(cnum))
303 WRITE (iw, '(A)') trim(cin)//' errorbar pattern 1'
304 WRITE (iw, '(A)') trim(cin)//' errorbar size 1.000000'
305 WRITE (iw, '(A)') trim(cin)//' errorbar linewidth 1.0'
306 WRITE (iw, '(A)') trim(cin)//' errorbar linestyle 1'
307 WRITE (iw, '(A)') trim(cin)//' errorbar riser linewidth 1.0'
308 WRITE (iw, '(A)') trim(cin)//' errorbar riser linestyle 1'
309 WRITE (iw, '(A)') trim(cin)//' errorbar riser clip off'
310 WRITE (iw, '(A)') trim(cin)//' errorbar riser clip length 0.100000'
311 WRITE (iw, '(A)') trim(cin)//' comment "Cols 1:2"'
312 WRITE (iw, '(A)') trim(cin)//' legend "'//trim(legend)//'"'
313 END IF
314 END SUBROUTINE xm_graph_info
315
316! **************************************************************************************************
317!> \brief ...
318!> \param iw ...
319!> \param gnum ...
320!> \param gdata ...
321! **************************************************************************************************
322 SUBROUTINE xm_graph_data(iw, gnum, gdata)
323 INTEGER, INTENT(IN) :: iw, gnum
324 REAL(kind=dp), DIMENSION(:, :) :: gdata
325
326 CHARACTER(LEN=8) :: cin, cnum
327 INTEGER :: i, m
328
329 IF (iw > 0) THEN
330 WRITE (cnum, '(I2)') gnum
331 cin = "@@target G0.S"//trim(adjustl(cnum))
332 WRITE (iw, '(A)') trim(cin)
333 WRITE (iw, '(A)') '@type xy'
334 m = SIZE(gdata, 1)
335 DO i = 1, m
336 WRITE (iw, '(2G18.7)') gdata(i, 1), gdata(i, 2)
337 END DO
338 WRITE (iw, '(A)') '&'
339 END IF
340 END SUBROUTINE xm_graph_data
341
342END MODULE xmgrace
343
kinds
Defines the basic variable types.
Definition kinds.F:23
kinds::dp
integer, parameter, public dp
Definition kinds.F:34
machine
Machine interface based on Fortran 2003 and POSIX.
Definition machine.F:17
machine::m_datum
subroutine, public m_datum(cal_date)
returns a datum in human readable format using a standard Fortran routine
Definition machine.F:378
xmgrace
Routines to facilitate writing XMGRACE files.
Definition xmgrace.F:14
xmgrace::xm_graph_data
subroutine, public xm_graph_data(iw, gnum, gdata)
...
Definition xmgrace.F:323
xmgrace::xm_write_frameport
subroutine, public xm_write_frameport(iw)
...
Definition xmgrace.F:93
xmgrace::xm_write_frame
subroutine, public xm_write_frame(iw, wcoord, title, subtitle, xlabel, ylabel)
...
Definition xmgrace.F:122
xmgrace::xm_write_defaults
subroutine, public xm_write_defaults(iw)
...
Definition xmgrace.F:36
xmgrace::xm_graph_info
subroutine, public xm_graph_info(iw, gnum, linewidth, legend)
...
Definition xmgrace.F:253