Line data Source code
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 : ! **************************************************************************************************
14 : MODULE 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 :
29 : CONTAINS
30 :
31 : ! **************************************************************************************************
32 : !> \brief ...
33 : !> \param iw ...
34 : ! **************************************************************************************************
35 0 : SUBROUTINE xm_write_defaults(iw)
36 : INTEGER, INTENT(IN) :: iw
37 :
38 : CHARACTER(len=20) :: date
39 :
40 0 : IF (iw > 0) THEN
41 0 : WRITE (iw, '(A)') '# CP2K Grace file', '#', '@version 50125', '@page size 792, 612', &
42 0 : '@page scroll 5%', '@page inout 5%', '@link page off'
43 0 : WRITE (iw, '(A)') '@map font 0 to "Times-Roman", "Times-Roman"', &
44 0 : '@map font 1 to "Times-Italic", "Times-Italic"', &
45 0 : '@map font 2 to "Times-Bold", "Times-Bold"', &
46 0 : '@map font 3 to "Times-BoldItalic", "Times-BoldItalic"', &
47 0 : '@map font 4 to "Helvetica", "Helvetica"', &
48 0 : '@map font 5 to "Helvetica-Oblique", "Helvetica-Oblique"', &
49 0 : '@map font 6 to "Helvetica-Bold", "Helvetica-Bold"', &
50 0 : '@map font 7 to "Helvetica-BoldOblique", "Helvetica-BoldOblique"', &
51 0 : '@map font 8 to "Courier", "Courier"', &
52 0 : '@map font 9 to "Courier-Oblique", "Courier-Oblique"', &
53 0 : '@map font 10 to "Courier-Bold", "Courier-Bold"', &
54 0 : '@map font 11 to "Courier-BoldOblique", "Courier-BoldOblique"', &
55 0 : '@map font 12 to "Symbol", "Symbol"', &
56 0 : '@map font 13 to "ZapfDingbats", "ZapfDingbats"'
57 0 : WRITE (iw, '(A)') '@map color 0 to (255, 255, 255), "white"', &
58 0 : '@map color 1 to (0, 0, 0), "black"', &
59 0 : '@map color 2 to (255, 0, 0), "red"', &
60 0 : '@map color 3 to (0, 255, 0), "green"', &
61 0 : '@map color 4 to (0, 0, 255), "blue"', &
62 0 : '@map color 5 to (255, 255, 0), "yellow"', &
63 0 : '@map color 6 to (188, 143, 143), "brown"', &
64 0 : '@map color 7 to (220, 220, 220), "grey"', &
65 0 : '@map color 8 to (148, 0, 211), "violet"', &
66 0 : '@map color 9 to (0, 255, 255), "cyan"', &
67 0 : '@map color 10 to (255, 0, 255), "magenta"', &
68 0 : '@map color 11 to (255, 165, 0), "orange"', &
69 0 : '@map color 12 to (114, 33, 188), "indigo"', &
70 0 : '@map color 13 to (103, 7, 72), "maroon"', &
71 0 : '@map color 14 to (64, 224, 208), "turquoise"', &
72 0 : '@map color 15 to (0, 139, 0), "green4"'
73 0 : WRITE (iw, '(A)') '@reference date 0', '@date wrap off', '@date wrap year 1950'
74 0 : WRITE (iw, '(A)') '@default linewidth 1.0', '@default linestyle 1', &
75 0 : '@default color 1', '@default pattern 1', '@default font 0', &
76 0 : '@default char size 1.000000', '@default symbol size 1.000000', &
77 0 : '@default sformat "%.8g"', '@background color 0', '@page background fill on'
78 0 : WRITE (iw, '(A)') '@timestamp off', '@timestamp 0.03, 0.03', '@timestamp color 1', &
79 0 : '@timestamp rot 0', '@timestamp font 0', '@timestamp char size 1.000000'
80 0 : CALL m_datum(date)
81 :
82 0 : WRITE (iw, '(A)') '@timestamp def '//TRIM(date)
83 :
84 : END IF
85 :
86 0 : END SUBROUTINE xm_write_defaults
87 :
88 : ! **************************************************************************************************
89 : !> \brief ...
90 : !> \param iw ...
91 : ! **************************************************************************************************
92 0 : SUBROUTINE xm_write_frameport(iw)
93 : INTEGER, INTENT(IN) :: iw
94 :
95 0 : IF (iw > 0) THEN
96 0 : WRITE (iw, '(A)') '@r0 off', '@link r0 to g0', '@r0 type above', '@r0 linestyle 1', &
97 0 : '@r0 linewidth 1.0', '@r0 color 1', '@r0 line 0, 0, 0, 0'
98 0 : WRITE (iw, '(A)') '@r1 off', '@link r1 to g0', '@r1 type above', '@r1 linestyle 1', &
99 0 : '@r1 linewidth 1.0', '@r1 color 1', '@r1 line 0, 0, 0, 0'
100 0 : WRITE (iw, '(A)') '@r2 off', '@link r2 to g0', '@r2 type above', '@r2 linestyle 1', &
101 0 : '@r2 linewidth 1.0', '@r2 color 1', '@r2 line 0, 0, 0, 0'
102 0 : WRITE (iw, '(A)') '@r3 off', '@link r3 to g0', '@r3 type above', '@r3 linestyle 1', &
103 0 : '@r3 linewidth 1.0', '@r3 color 1', '@r3 line 0, 0, 0, 0'
104 :
105 0 : WRITE (iw, '(A)') '@g0 on', '@g0 hidden false', '@g0 type XY', '@g0 stacked false', &
106 0 : '@g0 bar hgap 0.000000', '@g0 fixedpoint off', '@g0 fixedpoint type 0', &
107 0 : '@g0 fixedpoint xy 0.000000, 0.000000', '@g0 fixedpoint format general general', &
108 0 : '@g0 fixedpoint prec 6, 6'
109 : END IF
110 0 : 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 0 : 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 0 : x1 = wcoord(1)
129 0 : y1 = wcoord(2)
130 0 : x2 = wcoord(3)
131 0 : y2 = wcoord(4)
132 0 : IF (iw > 0) THEN
133 0 : WRITE (iw, '(A)') '@with g0'
134 0 : WRITE (iw, FMT='(A)', ADVANCE='NO') '@ world '
135 0 : WRITE (iw, FMT='(4(F8.1,A))') x1, ',', y1, ',', x2, ',', y2
136 0 : WRITE (iw, '(A)') '@ stack world 0, 0, 0, 0'
137 0 : WRITE (iw, '(A)') '@ znorm 1', &
138 0 : '@ view 0.150000, 0.150000, 1.150000, 0.850000'
139 0 : WRITE (iw, '(A)') '@ title "'//title//'"'
140 0 : WRITE (iw, '(A)') '@ title font 0', &
141 0 : '@ title size 1.500000', &
142 0 : '@ title color 1'
143 0 : WRITE (iw, '(A)') '@ subtitle "'//subtitle//'"'
144 0 : WRITE (iw, '(A)') '@ title font 0', &
145 0 : '@ title size 1.000000', &
146 0 : '@ title color 1'
147 : !
148 0 : WRITE (iw, '(A)') '@ xaxes scale Normal'
149 0 : WRITE (iw, '(A)') '@ yaxes scale Normal'
150 0 : WRITE (iw, '(A)') '@ xaxes invert off'
151 0 : WRITE (iw, '(A)') '@ yaxes invert off'
152 : ! xaxis
153 0 : WRITE (iw, '(A)') '@ xaxis on', &
154 0 : '@ xaxis type zero false', &
155 0 : '@ xaxis offset 0.000000 , 0.000000', &
156 0 : '@ xaxis bar on', &
157 0 : '@ xaxis bar color 1', &
158 0 : '@ xaxis bar linestyle 1', &
159 0 : '@ xaxis bar linewidth 1.0'
160 0 : WRITE (iw, '(A)') '@ xaxis label "'//xlabel//'"'
161 0 : WRITE (iw, '(A)') '@ xaxis label layout para', &
162 0 : '@ xaxis label place auto', &
163 0 : '@ xaxis label char size 1.480000', &
164 0 : '@ xaxis label font 0', &
165 0 : '@ xaxis label color 1', &
166 0 : '@ xaxis label place normal'
167 0 : WRITE (iw, '(A)') '@ xaxis tick on', '@ xaxis tick major 2', '@ xaxis tick minor ticks 1', &
168 0 : '@ xaxis tick default 6', '@ xaxis tick place rounded true', '@ xaxis tick in', &
169 0 : '@ xaxis tick major size 1.000000', '@ xaxis tick major color 1', &
170 0 : '@ xaxis tick major linewidth 3.0', '@ xaxis tick major linestyle 1', &
171 0 : '@ xaxis tick major grid off', '@ xaxis tick minor color 1', &
172 0 : '@ xaxis tick minor linewidth 3.0', '@ xaxis tick minor linestyle 1', &
173 0 : '@ xaxis tick minor grid off', '@ xaxis tick minor size 0.500000'
174 0 : WRITE (iw, '(A)') '@ xaxis ticklabel on', '@ xaxis ticklabel format general', &
175 0 : '@ xaxis ticklabel prec 5', '@ xaxis ticklabel formula ""', '@ xaxis ticklabel append ""', &
176 0 : '@ xaxis ticklabel prepend ""', '@ xaxis ticklabel angle 0', '@ xaxis ticklabel skip 0', &
177 0 : '@ xaxis ticklabel stagger 0', '@ xaxis ticklabel place normal', &
178 0 : '@ xaxis ticklabel offset auto', &
179 0 : '@ xaxis ticklabel offset 0.000000 , 0.010000', '@ xaxis ticklabel start type auto', &
180 0 : '@ xaxis ticklabel start 0.000000', '@ xaxis ticklabel stop type auto', &
181 0 : '@ xaxis ticklabel stop 0.000000', '@ xaxis ticklabel char size 1.480000', &
182 0 : '@ xaxis ticklabel font 0', '@ xaxis ticklabel color 1', &
183 0 : '@ xaxis tick place both', '@ xaxis tick spec type none'
184 : ! yaxis
185 0 : WRITE (iw, '(A)') '@ yaxis on', &
186 0 : '@ yaxis type zero false', &
187 0 : '@ yaxis offset 0.000000 , 0.000000', &
188 0 : '@ yaxis bar on', &
189 0 : '@ yaxis bar color 1', &
190 0 : '@ yaxis bar linestyle 1', &
191 0 : '@ yaxis bar linewidth 1.0'
192 0 : WRITE (iw, '(A)') '@ yaxis label "'//ylabel//'"'
193 0 : WRITE (iw, '(A)') '@ yaxis label layout para', &
194 0 : '@ yaxis label place auto', &
195 0 : '@ yaxis label char size 1.000000', &
196 0 : '@ yaxis label font 0', &
197 0 : '@ yaxis label color 1', &
198 0 : '@ yaxis label place normal'
199 0 : WRITE (iw, '(A)') '@ yaxis tick on', '@ yaxis tick major 0.5', '@ yaxis tick minor ticks 1', &
200 0 : '@ yaxis tick default 6', '@ yaxis tick place rounded true', '@ yaxis tick in', &
201 0 : '@ yaxis tick major size 1.480000', '@ yaxis tick major color 1', &
202 0 : '@ yaxis tick major linewidth 3.0', '@ yaxis tick major linestyle 1', &
203 0 : '@ yaxis tick major grid off', '@ yaxis tick minor color 1', &
204 0 : '@ yaxis tick minor linewidth 3.0', '@ yaxis tick minor linestyle 1', &
205 0 : '@ yaxis tick minor grid off', '@ yaxis tick minor size 0.500000'
206 0 : WRITE (iw, '(A)') '@ yaxis ticklabel on', '@ yaxis ticklabel format general', &
207 0 : '@ yaxis ticklabel prec 5', '@ yaxis ticklabel formula ""', '@ yaxis ticklabel append ""', &
208 0 : '@ yaxis ticklabel prepend ""', '@ yaxis ticklabel angle 0', '@ yaxis ticklabel skip 0', &
209 0 : '@ yaxis ticklabel stagger 0', '@ yaxis ticklabel place normal', &
210 0 : '@ yaxis ticklabel offset auto', &
211 0 : '@ yaxis ticklabel offset 0.000000 , 0.010000', '@ yaxis ticklabel start type auto', &
212 0 : '@ yaxis ticklabel start 0.000000', '@ yaxis ticklabel stop type auto', &
213 0 : '@ yaxis ticklabel stop 0.000000', '@ yaxis ticklabel char size 1.480000', &
214 0 : '@ yaxis ticklabel font 0', '@ yaxis ticklabel color 1', &
215 0 : '@ yaxis tick place both', '@ yaxis tick spec type none'
216 0 : WRITE (iw, '(A)') '@ altxaxis off', '@ altyaxis off'
217 : ! Legend
218 0 : WRITE (iw, '(A)') '@ legend on', &
219 0 : '@ legend loctype view', &
220 0 : '@ legend 0.8, 0.4', &
221 0 : '@ legend box color 1', &
222 0 : '@ legend box pattern 1', &
223 0 : '@ legend box linewidth 2.0', &
224 0 : '@ legend box linestyle 1', &
225 0 : '@ legend box fill color 0', &
226 0 : '@ legend box fill pattern 1', &
227 0 : '@ legend font 0', &
228 0 : '@ legend char size 1.000000', &
229 0 : '@ legend color 1', &
230 0 : '@ legend length 4', &
231 0 : '@ legend vgap 1', &
232 0 : '@ legend hgap 1', &
233 0 : '@ legend invert false'
234 : ! Frame
235 0 : WRITE (iw, '(A)') '@ frame type 0', &
236 0 : '@ frame linestyle 1', &
237 0 : '@ frame linewidth 3.0', &
238 0 : '@ frame color 1', &
239 0 : '@ frame pattern 1', &
240 0 : '@ frame background color 0', &
241 0 : '@ frame background pattern 0'
242 : END IF
243 0 : END SUBROUTINE xm_write_frame
244 :
245 : ! **************************************************************************************************
246 : !> \brief ...
247 : !> \param iw ...
248 : !> \param gnum ...
249 : !> \param linewidth ...
250 : !> \param legend ...
251 : ! **************************************************************************************************
252 0 : 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 0 : IF (iw > 0) THEN
260 0 : WRITE (cnum, '(I2)') gnum
261 0 : WRITE (cval, '(F3.1)') linewidth
262 0 : cin = "@ s"//TRIM(ADJUSTL(cnum))
263 0 : WRITE (cnum, '(I2)') gnum + 1
264 0 : WRITE (iw, '(A)') TRIM(cin)//' hidden false'
265 0 : WRITE (iw, '(A)') TRIM(cin)//' type xy'
266 0 : WRITE (iw, '(A)') TRIM(cin)//' symbol 0 '
267 0 : WRITE (iw, '(A)') TRIM(cin)//' symbol size 1.000000'
268 0 : WRITE (iw, '(A)') TRIM(cin)//' symbol color '//TRIM(ADJUSTL(cnum))
269 0 : WRITE (iw, '(A)') TRIM(cin)//' symbol pattern 1'
270 0 : WRITE (iw, '(A)') TRIM(cin)//' symbol fill color 1'
271 0 : WRITE (iw, '(A)') TRIM(cin)//' symbol fill pattern 0'
272 0 : WRITE (iw, '(A)') TRIM(cin)//' symbol linewidth 1.0'
273 0 : WRITE (iw, '(A)') TRIM(cin)//' symbol linestyle 1'
274 0 : WRITE (iw, '(A)') TRIM(cin)//' symbol char 65 '
275 0 : WRITE (iw, '(A)') TRIM(cin)//' symbol char font 0'
276 0 : WRITE (iw, '(A)') TRIM(cin)//' symbol skip 0'
277 0 : WRITE (iw, '(A)') TRIM(cin)//' line type 1'
278 0 : WRITE (iw, '(A)') TRIM(cin)//' line linestyle 1'
279 0 : WRITE (iw, '(A)') TRIM(cin)//' line linewidth '//TRIM(cval)
280 0 : WRITE (iw, '(A)') TRIM(cin)//' line color '//TRIM(ADJUSTL(cnum))
281 0 : WRITE (iw, '(A)') TRIM(cin)//' line pattern 1'
282 0 : WRITE (iw, '(A)') TRIM(cin)//' baseline type 0'
283 0 : WRITE (iw, '(A)') TRIM(cin)//' baseline off'
284 0 : WRITE (iw, '(A)') TRIM(cin)//' dropline off'
285 0 : WRITE (iw, '(A)') TRIM(cin)//' fill type 0'
286 0 : WRITE (iw, '(A)') TRIM(cin)//' fill rule 0'
287 0 : WRITE (iw, '(A)') TRIM(cin)//' fill color '//TRIM(ADJUSTL(cnum))
288 0 : WRITE (iw, '(A)') TRIM(cin)//' fill pattern 1'
289 0 : WRITE (iw, '(A)') TRIM(cin)//' avalue off'
290 0 : WRITE (iw, '(A)') TRIM(cin)//' avalue type 2'
291 0 : WRITE (iw, '(A)') TRIM(cin)//' avalue char size 1.000000'
292 0 : WRITE (iw, '(A)') TRIM(cin)//' avalue font 0'
293 0 : WRITE (iw, '(A)') TRIM(cin)//' avalue color '//TRIM(ADJUSTL(cnum))
294 0 : WRITE (iw, '(A)') TRIM(cin)//' avalue rot 0'
295 0 : WRITE (iw, '(A)') TRIM(cin)//' avalue format general'
296 0 : WRITE (iw, '(A)') TRIM(cin)//' avalue prec 3'
297 0 : WRITE (iw, '(A)') TRIM(cin)//' avalue prepend ""'
298 0 : WRITE (iw, '(A)') TRIM(cin)//' avalue append ""'
299 0 : WRITE (iw, '(A)') TRIM(cin)//' avalue offset 0.000000 , 0.000000'
300 0 : WRITE (iw, '(A)') TRIM(cin)//' errorbar on'
301 0 : WRITE (iw, '(A)') TRIM(cin)//' errorbar place both'
302 0 : WRITE (iw, '(A)') TRIM(cin)//' errorbar color '//TRIM(ADJUSTL(cnum))
303 0 : WRITE (iw, '(A)') TRIM(cin)//' errorbar pattern 1'
304 0 : WRITE (iw, '(A)') TRIM(cin)//' errorbar size 1.000000'
305 0 : WRITE (iw, '(A)') TRIM(cin)//' errorbar linewidth 1.0'
306 0 : WRITE (iw, '(A)') TRIM(cin)//' errorbar linestyle 1'
307 0 : WRITE (iw, '(A)') TRIM(cin)//' errorbar riser linewidth 1.0'
308 0 : WRITE (iw, '(A)') TRIM(cin)//' errorbar riser linestyle 1'
309 0 : WRITE (iw, '(A)') TRIM(cin)//' errorbar riser clip off'
310 0 : WRITE (iw, '(A)') TRIM(cin)//' errorbar riser clip length 0.100000'
311 0 : WRITE (iw, '(A)') TRIM(cin)//' comment "Cols 1:2"'
312 0 : WRITE (iw, '(A)') TRIM(cin)//' legend "'//TRIM(legend)//'"'
313 : END IF
314 0 : END SUBROUTINE xm_graph_info
315 :
316 : ! **************************************************************************************************
317 : !> \brief ...
318 : !> \param iw ...
319 : !> \param gnum ...
320 : !> \param gdata ...
321 : ! **************************************************************************************************
322 0 : 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 0 : IF (iw > 0) THEN
330 0 : WRITE (cnum, '(I2)') gnum
331 0 : cin = "@@target G0.S"//TRIM(ADJUSTL(cnum))
332 0 : WRITE (iw, '(A)') TRIM(cin)
333 0 : WRITE (iw, '(A)') '@type xy'
334 0 : m = SIZE(gdata, 1)
335 0 : DO i = 1, m
336 0 : WRITE (iw, '(2G18.7)') gdata(i, 1), gdata(i, 2)
337 : END DO
338 0 : WRITE (iw, '(A)') '&'
339 : END IF
340 0 : END SUBROUTINE xm_graph_data
341 :
342 : END MODULE xmgrace
343 :
|
