atomes 1.3.1
atomes: an atomic scale modeling tool box
Loading...
Searching...
No Matches
writedata.F90
Go to the documentation of this file.
1! This file is part of the 'atomes' software.
2!
3! 'atomes' is free software: you can redistribute it and/or modify it under the terms
4! of the GNU Affero General Public License as published by the Free Software Foundation,
5! either version 3 of the License, or (at your option) any later version.
6!
7! 'atomes' is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
8! without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
9! See the GNU General Public License for more details.
10!
11! You should have received a copy of the GNU Affero General Public License along with 'atomes'.
12! If not, see <https://www.gnu.org/licenses/>
13!
14! Copyright (C) 2022-2026 by CNRS and University of Strasbourg
15!
16!>
17!! @file writedata.F90
18!! @short Export curve data using data received from C
19!! @author Sébastien Le Roux <sebastien.leroux@ipcms.unistra.fr>
20
21CHARACTER (LEN=36) FUNCTION ylegend (job, nleg, idl, snp)
22
23USE parameters
24
25IMPLICIT NONE
26
27INTEGER, INTENT(IN) :: job, nleg, idl, snp
28INTEGER :: dal, dbl, dcl, ddl, del
29LOGICAL :: done
30
31ylegend = ''
32
33! Y axis legend if not spherical harmonics,
34
35if (job.eq.idgr .or. job.eq.idgrfft) then
36
37 if (nleg .eq. 0) then
38 if (idl .eq. 0) then
39 ylegend = """g(r) Neutrons"""
40 else
41 ylegend = "g(r) Neutrons"
42 endif
43 elseif (nleg .eq. 1) then
44 if (idl .eq. 0) then
45 ylegend = """g(r) Neutrons - smoothed"""
46 else
47 ylegend = "g(r) Neutrons - smoothed"
48 endif
49 elseif (nleg .eq. 2) then
50 if (idl .eq. 0) then
51 ylegend = """G(r) Neutrons"""
52 else
53 ylegend = "G(r) Neutrons"
54 endif
55 elseif (nleg .eq. 3) then
56 if (idl .eq. 0) then
57 ylegend = """G(r) Neutrons - smoothed"""
58 else
59 ylegend = "G(r) Neutrons - smoothed"
60 endif
61 elseif (nleg .eq. 4) then
62 if (idl .eq. 0) then
63 ylegend = """g(r) X-rays"""
64 else
65 ylegend = "g(r) X-rays"
66 endif
67 elseif (nleg .eq. 5) then
68 if (idl .eq. 0) then
69 ylegend = """g(r) X-rays - smoothed"""
70 else
71 ylegend = "g(r) X-rays - smoothed"
72 endif
73 elseif (nleg .eq. 6) then
74 if (idl .eq. 0) then
75 ylegend = """G(r) X-rays"""
76 else
77 ylegend = "G(r) X-rays"
78 endif
79 elseif (nleg .eq. 7) then
80 if (idl .eq. 0) then
81 ylegend = """G(r) X-rays - smoothed"""
82 else
83 ylegend = "G(r) X-rays - smoothed"
84 endif
85 elseif (nleg .ge. 8) then
86 dcl=8
87 done=.false.
88 do dal=1, snp
89 do dbl=1, snp
90 if (dcl.eq.nleg) then
91 if (idl .eq. 0) then
92 ylegend="""g\sij\N(r)["// &
93 tl(dal)(1:len_trim(tl(dal)))//","//tl(dbl)(1:len_trim(tl(dbl)))//"]"""
94 else
95 ylegend="g(r)["// &
96 tl(dal)(1:len_trim(tl(dal)))//","//tl(dbl)(1:len_trim(tl(dbl)))//"]"
97 endif
98 done=.true.
99 exit
100 endif
101 dcl=dcl+1
102 if (dcl.eq.nleg) then
103 if (idl .eq. 0) then
104 ylegend="""g\sij\N(r)["// &
105 tl(dal)(1:len_trim(tl(dal)))//","//tl(dbl)(1:len_trim(tl(dbl)))//"] - smoothed"""
106 else
107 ylegend="g(r)["// &
108 tl(dal)(1:len_trim(tl(dal)))//","//tl(dbl)(1:len_trim(tl(dbl)))//"] - smoothed"
109 endif
110 done=.true.
111 exit
112 endif
113 dcl=dcl+1
114 if (dcl.eq.nleg) then
115 if (idl .eq. 0) then
116 ylegend="""G\sij\N(r)["// &
117 tl(dal)(1:len_trim(tl(dal)))//","//tl(dbl)(1:len_trim(tl(dbl)))//"]"""
118 else
119 ylegend="G(r)["// &
120 tl(dal)(1:len_trim(tl(dal)))//","//tl(dbl)(1:len_trim(tl(dbl)))//"]"
121 endif
122 done=.true.
123 exit
124 endif
125 dcl=dcl+1
126 if (dcl.eq.nleg) then
127 if (idl .eq. 0) then
128 ylegend="""G\sij\N(r)["// &
129 tl(dal)(1:len_trim(tl(dal)))//","//tl(dbl)(1:len_trim(tl(dbl)))//"] - smoothed"""
130 else
131 ylegend="G(r)["// &
132 tl(dal)(1:len_trim(tl(dal)))//","//tl(dbl)(1:len_trim(tl(dbl)))//"] - smoothed"
133 endif
134 done=.true.
135 exit
136 endif
137 dcl=dcl+1
138 if (dcl.eq.nleg) then
139 if (idl .eq. 0) then
140 ylegend="""dn\sij\N(r)["// &
141 tl(dal)(1:len_trim(tl(dal)))//","//tl(dbl)(1:len_trim(tl(dbl)))//"]"""
142 else
143 ylegend="dn(r)["// &
144 tl(dal)(1:len_trim(tl(dal)))//","//tl(dbl)(1:len_trim(tl(dbl)))//"]"
145 endif
146 done=.true.
147 exit
148 endif
149 dcl=dcl+1
150 enddo
151 if(done) exit
152 enddo
153 if (snp .eq. 2) then
154 if (dcl.eq.nleg) then
155 if (idl .eq. 0) then
156 ylegend="""BT\sNN\N(r)"""
157 else
158 ylegend="BT[NN](r)"
159 endif
160 endif
161 dcl=dcl+1
162 if (dcl.eq.nleg) then
163 if (idl .eq. 0) then
164 ylegend="""BT\sNN\N(r) - smoothed"""
165 else
166 ylegend="BT[NN](r) - smoothed"
167 endif
168 endif
169 dcl=dcl+1
170 if (dcl.eq.nleg) then
171 if (idl .eq. 0) then
172 ylegend="""BT\sNC\N(r)"""
173 else
174 ylegend="BT[NC](r)"
175 endif
176 endif
177 dcl=dcl+1
178 if (dcl.eq.nleg) then
179 if (idl .eq. 0) then
180 ylegend="""BT\sNC\N(r) - smoothed"""
181 else
182 ylegend="BT[NC](r) - smoothed"
183 endif
184 endif
185 dcl=dcl+1
186 if (dcl.eq.nleg) then
187 if (idl .eq. 0) then
188 ylegend="""BT\sCC\N(r)"""
189 else
190 ylegend="BT[CC](r)"
191 endif
192 endif
193 dcl=dcl+1
194 if (dcl.eq.nleg) then
195 if (idl .eq. 0) then
196 ylegend="""BT\sCC\N(r) - smoothed"""
197 else
198 ylegend="BT[CC](r) - smoothed"
199 endif
200 endif
201 dcl=dcl+1
202 endif
203 endif
204
205else if (job.eq.idsq .or. job.eq.idsk) then
206
207 if (nleg .eq. 0) then
208 if (idl .eq. 0) then
209 ylegend = """S(q)[total] Neutrons"""
210 else
211 ylegend = "S(q)[total] Neutrons"
212 endif
213 elseif (nleg .eq. 1) then
214 if (idl .eq. 0) then
215 ylegend = """S(q) Neutrons - smoothed"""
216 else
217 ylegend = "S(q) Neutrons - smoothed"
218 endif
219 elseif (nleg .eq. 2) then
220 if (idl .eq. 0) then
221 ylegend = """Q(q)[total] Neutrons"""
222 else
223 ylegend = "Q(q)[total] Neutrons"
224 endif
225 elseif (nleg .eq. 3) then
226 if (idl .eq. 0) then
227 ylegend = """Q(q)[total] Neutrons - smoothed"""
228 else
229 ylegend = "Q(q)[total] Neutrons - smoothed"
230 endif
231 elseif (nleg .eq. 4) then
232 if (idl .eq. 0) then
233 ylegend = """S(q)[total] X-rays"""
234 else
235 ylegend = "S(q)[total] X-rays"
236 endif
237 elseif (nleg .eq. 5) then
238 if (idl .eq. 0) then
239 ylegend = """S(q) X-rays - smoothed"""
240 else
241 ylegend = "S(q) X-rays - smoothed"
242 endif
243 elseif (nleg .eq. 6) then
244 if (idl .eq. 0) then
245 ylegend = """Q(q)[total] X-rays"""
246 else
247 ylegend = "Q(q)[total] X-rays"
248 endif
249 elseif (nleg .eq. 7) then
250 if (idl .eq. 0) then
251 ylegend = """Q(q)[total] X-rays - smoothed"""
252 else
253 ylegend = "Q(q)[total] X-rays - smoothed"
254 endif
255 elseif (nleg .ge. 8) then
256 dcl=8
257 done=.false.
258 do dal=1, snp
259 do dbl=1, snp
260 if (dcl.eq.nleg) then
261 if (idl .eq. 0) then
262 ylegend="""AL\sij\N(q)["// &
263 tl(dal)(1:len_trim(tl(dal)))//","//tl(dbl)(1:len_trim(tl(dbl)))//"]"""
264 else
265 ylegend="AL (q)["// &
266 tl(dal)(1:len_trim(tl(dal)))//","//tl(dbl)(1:len_trim(tl(dbl)))//"]"
267 endif
268 done=.true.
269 exit
270 endif
271 dcl=dcl+1
272 if (dcl.eq.nleg) then
273 if (idl .eq. 0) then
274 ylegend="""AL\sij\N(q)["// &
275 tl(dal)(1:len_trim(tl(dal)))//","//tl(dbl)(1:len_trim(tl(dbl)))//"] - smoothed"""
276 else
277 ylegend="AL (q)["// &
278 tl(dal)(1:len_trim(tl(dal)))//","//tl(dbl)(1:len_trim(tl(dbl)))//"] - smoothed"
279 endif
280 done=.true.
281 exit
282 endif
283 dcl=dcl+1
284 enddo
285 if(done) exit
286 enddo
287 do dal=1, snp
288 do dbl=1, snp
289 if (dcl.eq.nleg) then
290 if (idl .eq. 0) then
291 ylegend="""FZ\sij\N(q)["// &
292 tl(dal)(1:len_trim(tl(dal)))//","//tl(dbl)(1:len_trim(tl(dbl)))//"]"""
293 else
294 ylegend="FZ N(q)["// &
295 tl(dal)(1:len_trim(tl(dal)))//","//tl(dbl)(1:len_trim(tl(dbl)))//"]"
296 endif
297 done=.true.
298 exit
299 endif
300 dcl=dcl+1
301 if (dcl.eq.nleg) then
302 if (idl .eq. 0) then
303 ylegend="""FZ\sij\N(q)["// &
304 tl(dal)(1:len_trim(tl(dal)))//","//tl(dbl)(1:len_trim(tl(dbl)))//"] - smoothed"""
305 else
306 ylegend="FZ N(q)["// &
307 tl(dal)(1:len_trim(tl(dal)))//","//tl(dbl)(1:len_trim(tl(dbl)))//"] - smoothed"
308 endif
309 done=.true.
310 exit
311 endif
312 dcl=dcl+1
313 enddo
314 if(done) exit
315 enddo
316 if (snp .eq. 2) then
317 if (dcl.eq.nleg) then
318 if (idl .eq. 0) then
319 ylegend="""BT\sNN\N(q)"""
320 else
321 ylegend="BT[NN](q)"
322 endif
323 endif
324 dcl=dcl+1
325 if (dcl.eq.nleg) then
326 if (idl .eq. 0) then
327 ylegend="""BT\sNN\N(q) - smoothed"""
328 else
329 ylegend="BT[NN](q) - smoothed"
330 endif
331 endif
332 dcl=dcl+1
333 if (dcl.eq.nleg) then
334 if (idl .eq. 0) then
335 ylegend="""BT\sNC\N(q)"""
336 else
337 ylegend="BT[NC](q)"
338 endif
339 endif
340 dcl=dcl+1
341 if (dcl.eq.nleg) then
342 if (idl .eq. 0) then
343 ylegend="""BT\sNC\N(q) - smoothed"""
344 else
345 ylegend="BT[NC](q) - smoothed"
346 endif
347 endif
348 dcl=dcl+1
349 if (dcl.eq.nleg) then
350 if (idl .eq. 0) then
351 ylegend="""BT\sCC\N(q)"""
352 else
353 ylegend="BT[CC](q)"
354 endif
355 endif
356 dcl=dcl+1
357 if (dcl.eq.nleg) then
358 if (idl .eq. 0) then
359 ylegend="""BT\sCC\N(q) - smoothed"""
360 else
361 ylegend="BT[CC](q) - smoothed"
362 endif
363 endif
364 dcl=dcl+1
365 if (dcl.eq.nleg) then
366 if (idl .eq. 0) then
367 ylegend="""BT\sZZ\N(q)"""
368 else
369 ylegend="BT[ZZ](q)"
370 endif
371 endif
372 dcl=dcl+1
373 if (dcl.eq.nleg) then
374 if (idl .eq. 0) then
375 ylegend="""BT\sZZ\N(q) - smoothed"""
376 else
377 ylegend="BT[ZZ](q) - smoothed"
378 endif
379 endif
380 dcl=dcl+1
381 endif
382 endif
383
384else if (job .eq. idbd) then
385
386 dcl = 0
387 do dal=1, snp
388 do dbl=1, snp
389 if (nleg .eq. dcl) then
390 if (idl .eq. 0) then
391 ylegend = """% Dij ["//tl(dal)(1:len_trim(tl(dal)))//"-" &
392 //tl(dbl)(1:len_trim(tl(dbl)))//"]"""
393 done=.true.
394 exit
395 else
396 ylegend = "% Dij ["//tl(dal)(1:len_trim(tl(dal)))//"-" &
397 //tl(dbl)(1:len_trim(tl(dbl)))//"]"
398 done=.true.
399 exit
400 endif
401 endif
402 dcl=dcl+1
403 enddo
404 enddo
405
406else if (job .eq. idan) then
407
408 ddl = 0
409 do dal=1, snp
410 do dbl=1, snp
411 do dcl=1, snp
412 if (nleg .eq. ddl) then
413 if (idl .eq. 0) then
414 ylegend = """% Angle ["//tl(dal)(1:len_trim(tl(dal)))//"-" &
415 //tl(dbl)(1:len_trim(tl(dbl)))//"-"//tl(dcl)(1:len_trim(tl(dcl)))//"]"""
416 else
417 ylegend = "% Angle ["//tl(dal)(1:len_trim(tl(dal)))//"-" &
418 //tl(dbl)(1:len_trim(tl(dbl)))//"-"//tl(dcl)(1:len_trim(tl(dcl)))//"]"
419 endif
420 endif
421 ddl=ddl+1
422 enddo
423 enddo
424 enddo
425 do dal=1, snp
426 do dbl=1, snp
427 do dcl=1, snp
428 do del=1, snp
429 if (nleg .eq. ddl) then
430 if (idl .eq. 0) then
431 ylegend = """% Dihedral ["// &
432 tl(dal)(1:len_trim(tl(dal)))//"-"//tl(dbl)(1:len_trim(tl(dbl)))// &
433 "-"//tl(dcl)(1:len_trim(tl(dcl)))//"-"//tl(del)(1:len_trim(tl(del)))//"]"""
434 else
435 ylegend = "% Dihedral ["// &
436 tl(dal)(1:len_trim(tl(dal)))//"-"//tl(dbl)(1:len_trim(tl(dbl)))// &
437 "-"//tl(dcl)(1:len_trim(tl(dcl)))//"-"//tl(del)(1:len_trim(tl(del)))//"]"
438 endif
439 endif
440 ddl=ddl+1
441 enddo
442 enddo
443 enddo
444 enddo
445
446else if (job .eq. idri) then
447
448 if (nleg.eq.0 .or. nleg.eq.4 .or. nleg.eq.8 .or. nleg.eq.12 .or. nleg.eq.16) then
449 if (idl .eq. 0) then
450 ylegend= """R\sc\N(\f{Times-Italic}n\f{})"""
451 else
452 ylegend= "Rc(n)"
453 endif
454 elseif (nleg.eq.1 .or. nleg.eq.5 .or. nleg.eq.9 .or. nleg.eq.13 .or. nleg.eq.17) then
455 if (idl .eq. 0) then
456 ylegend= """P\sn\N(\f{Times-Italic}n\f{})"""
457 else
458 ylegend= "Pn(n)"
459 endif
460 elseif (nleg.eq.2 .or. nleg.eq.6 .or. nleg.eq.10 .or. nleg.eq.14 .or. nleg.eq.18) then
461 if (idl .eq. 0) then
462 ylegend= """P\smax\N(\f{Times-Italic}n\f{})"""
463 else
464 ylegend= "Pmax(n)"
465 endif
466 elseif (nleg.eq.3 .or. nleg.eq.7 .or. nleg.eq.11 .or. nleg.eq.15 .or. nleg.eq.19) then
467 if (idl .eq. 0) then
468 ylegend= """P\smin\N(\f{Times-Italic}n\f{})"""
469 else
470 ylegend= "Pmin(n)"
471 endif
472 endif
473
474elseif (job .eq. idch) then
475
476 if (nleg.eq.0) then
477 if (idl .eq. 0) then
478 ylegend= """C\sc\N(\f{Times-Italic}n\f{})[All]"""
479 else
480 ylegend= "Cc(n)[All]"
481 endif
482 else
483 ddl = 1
484 do dal=1, snp
485 if (nleg .eq. ddl) then
486 if (idl .eq. 0) then
487 ylegend= """C\sc\N(\f{Times-Italic}n\f{})["//tl(dal)(1:len_trim(tl(dal)))//"]"""
488 else
489 ylegend= "Cc(n)["//tl(dal)(1:len_trim(tl(dal)))//"]"
490 endif
491 endif
492 ddl=ddl+1
493 enddo
494 endif
495elseif (job .eq. idsp) then
496
497 ! Nothing to be done here
498
499else
500
501 ddl = 0
502 do dal=1, snp
503 if (nleg .eq. ddl) then
504 if (idl .eq. 0) then
505 ylegend= """MSD ("//tl(dal)(1:len_trim(tl(dal)))//") [\cE\C\S2\N]"""
506 else
507 ylegend= "MSD ("//tl(dal)(1:len_trim(tl(dal)))//") [Ų]"
508 endif
509 endif
510 ddl=ddl+1
511 if (nleg .eq. ddl) then
512 if (idl .eq. 0) then
513 ylegend= """MSD nac ("//tl(dal)(1:len_trim(tl(dal)))//") [\cE\C\S2\N]"""
514 else
515 ylegend= "MSD nac ("//tl(dal)(1:len_trim(tl(dal)))//") [Ų]"
516 endif
517 endif
518 ddl=ddl+1
519 enddo
520 do dal=1, snp
521 if (nleg .eq. ddl) then
522 if (idl .eq. 0) then
523 ylegend= """MSD [x]("//tl(dal)(1:len_trim(tl(dal)))//") [\cE\C\S2\N]"""
524 else
525 ylegend= "MSD [x]("//tl(dal)(1:len_trim(tl(dal)))//") [Ų]"
526 endif
527 endif
528 ddl=ddl+1
529 if (nleg .eq. ddl) then
530 if (idl .eq. 0) then
531 ylegend= """MSD [y]("//tl(dal)(1:len_trim(tl(dal)))//") [\cE\C\S2\N]"""
532 else
533 ylegend= "MSD [y]("//tl(dal)(1:len_trim(tl(dal)))//") [Ų]"
534 endif
535 endif
536 ddl=ddl+1
537 if (nleg .eq. ddl) then
538 if (idl .eq. 0) then
539 ylegend= """MSD [z]("//tl(dal)(1:len_trim(tl(dal)))//") [\cE\C\S2\N]"""
540 else
541 ylegend= "MSD [z]("//tl(dal)(1:len_trim(tl(dal)))//") [Ų]"
542 endif
543 endif
544 ddl=ddl+1
545 if (nleg .eq. ddl) then
546 if (idl .eq. 0) then
547 ylegend= """MSD [xy]("//tl(dal)(1:len_trim(tl(dal)))//") [\cE\C\S2\N]"""
548 else
549 ylegend= "MSD [xy]("//tl(dal)(1:len_trim(tl(dal)))//") [Ų]"
550 endif
551 endif
552 ddl=ddl+1
553 if (nleg .eq. ddl) then
554 if (idl .eq. 0) then
555 ylegend= """MSD [xz]("//tl(dal)(1:len_trim(tl(dal)))//") [\cE\C\S2\N]"""
556 else
557 ylegend= "MSD [xz]("//tl(dal)(1:len_trim(tl(dal)))//") [Ų]"
558 endif
559 endif
560 ddl=ddl+1
561 if (nleg .eq. ddl) then
562 if (idl .eq. 0) then
563 ylegend= """MSD [yz]("//tl(dal)(1:len_trim(tl(dal)))//") [\cE\C\S2\N]"""
564 else
565 ylegend= "MSD [yz]("//tl(dal)(1:len_trim(tl(dal)))//") [Ų]"
566 endif
567 endif
568 ddl=ddl+1
569 enddo
570 do dal=1, snp
571 if (nleg .eq. ddl) then
572 if (idl .eq. 0) then
573 ylegend= """MSD [x/nac]("//tl(dal)(1:len_trim(tl(dal)))//") [\cE\C\S2\N]"""
574 else
575 ylegend= "MSD [x/nac]("//tl(dal)(1:len_trim(tl(dal)))//") [Ų]"
576 endif
577 endif
578 ddl=ddl+1
579 if (nleg .eq. ddl) then
580 if (idl .eq. 0) then
581 ylegend= """MSD [y/nac]("//tl(dal)(1:len_trim(tl(dal)))//") [\cE\C\S2\N]"""
582 else
583 ylegend= "MSD [y/nac]("//tl(dal)(1:len_trim(tl(dal)))//") [Ų]"
584 endif
585 endif
586 ddl=ddl+1
587 if (nleg .eq. ddl) then
588 if (idl .eq. 0) then
589 ylegend= """MSD [z/nac]("//tl(dal)(1:len_trim(tl(dal)))//") [\cE\C\S2\N]"""
590 else
591 ylegend= "MSD [z/nac]("//tl(dal)(1:len_trim(tl(dal)))//") [Ų]"
592 endif
593 endif
594 ddl=ddl+1
595 if (nleg .eq. ddl) then
596 if (idl .eq. 0) then
597 ylegend= """MSD [xy/nac]("//tl(dal)(1:len_trim(tl(dal)))//") [\cE\C\S2\N]"""
598 else
599 ylegend= "MSD [xy/nac]("//tl(dal)(1:len_trim(tl(dal)))//") [Ų]"
600 endif
601 endif
602 ddl=ddl+1
603 if (nleg .eq. ddl) then
604 if (idl .eq. 0) then
605 ylegend= """MSD [xz/nac]("//tl(dal)(1:len_trim(tl(dal)))//") [\cE\C\S2\N]"""
606 else
607 ylegend= "MSD [xz/nac]("//tl(dal)(1:len_trim(tl(dal)))//") [Ų]"
608 endif
609 endif
610 ddl=ddl+1
611 if (nleg .eq. ddl) then
612 if (idl .eq. 0) then
613 ylegend= """MSD [yz/nac]("//tl(dal)(1:len_trim(tl(dal)))//") [\cE\C\S2\N]"""
614 else
615 ylegend= "MSD [yz/nac]("//tl(dal)(1:len_trim(tl(dal)))//") [Ų]"
616 endif
617 endif
618 ddl=ddl+1
619 enddo
620 if (nleg .eq. ddl) then
621 if (idl .eq. 0) then
622 ylegend= """Correction (x) [\cE\C\S2\N]"""
623 else
624 ylegend= "Correction (x) [Ų]"
625 endif
626 endif
627 ddl=ddl+1
628 if (nleg .eq. ddl) then
629 if (idl .eq. 0) then
630 ylegend= """Correction (y) [\cE\C\S2\N]"""
631 else
632 ylegend= "Correction (y) [Ų]"
633 endif
634 endif
635 ddl=ddl+1
636 if (nleg .eq. ddl) then
637 if (idl .eq. 0) then
638 ylegend= """Correction (z) [\cE\C\S2\N]"""
639 else
640 ylegend= "Correction (z) [Ų]"
641 endif
642 endif
643 ddl=ddl+1
644 if (nleg .eq. ddl) then
645 if (idl .eq. 0) then
646 ylegend= """Drift (x) [ms\S-1\N]"""
647 else
648 ylegend= "Drift (x) m/s"
649 endif
650 endif
651 ddl=ddl+1
652 if (nleg .eq. ddl) then
653 if (idl .eq. 0) then
654 ylegend= """Drift (y) [ms\S-1\N]"""
655 else
656 ylegend= "Drift (y) (m/s)"
657 endif
658 endif
659 ddl=ddl+1
660 if (nleg .eq. ddl) then
661 if (idl .eq. 0) then
662 ylegend= """Drift (z) [ms\S-1\N]"""
663 else
664 ylegend= "Drift (z) (m/s)"
665 endif
666 endif
667
668endif
669
670END FUNCTION
671
672CHARACTER (LEN=65) FUNCTION xlegend (job, nleg, idl, cdc, snp)
673
674USE parameters
675
676IMPLICIT NONE
677
678INTEGER, INTENT(IN) :: job, nleg, idl, snp
679DOUBLE PRECISION, INTENT(IN) :: cdc
680INTEGER :: il
681CHARACTER (LEN=6), DIMENSION(5) :: tpsunit = (/'t [fs]', 't [ps]', 't [ns]', 't [us]', 't [ms]' /)
682INTERFACE
683 CHARACTER (LEN=7) FUNCTION getunit()
684 END FUNCTION
685END INTERFACE
686
687xlegend = ''
688if (idl .eq. 0) then
689 if (job.eq.idgr .or. job.eq.idgrfft) then
690 xlegend = "r[\cE\C]"""
691 elseif (job.eq.idsq .or. job.eq.idsk .or. job.eq.idskt) then
692 xlegend = "q[\cE\C\S-1\N]"""
693 elseif (job .eq. idbd) then
694 xlegend = "Dij[\cE\C\‍]"""
695 elseif (job .eq. idan) then
696 if (nleg .lt. snp*snp*snp) then
697 xlegend = "Angles[\c:\C]"""
698 else
699 xlegend = "Dihedrals[\c:\C]"""
700 endif
701 elseif (job .eq. idri) then
702 xlegend = "Size \f{Times-Italic}n\f{} of the ring [total number of nodes]"""
703 elseif (job .eq. idch) then
704 xlegend = "Size \f{Times-Italic}n\f{} of the chain [total number of nodes]"""
705 elseif (job .eq. idsp) then
706 xlegend = "Q\sl\N"""
707 else
708 il = anint(cdc)
709 if (il .eq. 4) then
710 xlegend = "\f{12}m\f{}"""
711 else
712 xlegend = tpsunit(il)//""""
713 endif
714 endif
715else
716 if (job.eq.idgr .or. job.eq.idgrfft) then
717 xlegend = "r[Å]"
718 elseif (job.eq.idsq .or. job.eq.idsk .or. job.eq.idskt) then
719 xlegend = "q[Å-1]"
720 elseif (job .eq. idbd) then
721 xlegend = "Dij[Å]"
722 elseif (job .eq. idan) then
723 if (nleg .lt. snp*snp*snp) then
724 xlegend = "Angles[°]"
725 else
726 xlegend = "Dihedrals[°]"
727 endif
728 elseif (job .eq. idri) then
729 xlegend = "Size n of the ring [total number of nodes]"
730 elseif (job .eq. idch) then
731 xlegend = "Size n of the chain [total number of nodes]"
732 elseif (job .eq. idsp) then
733 xlegend = "Ql"
734 else
735 il = anint(cdc)
736 xlegend = tpsunit(il)
737 endif
738endif
739
740END FUNCTION
741
742SUBROUTINE prep_file (scf, sfi, snp, tfile, &
743 scalex, scaley, mdc, rdc, idc) bind (C,NAME='prep_file_')
744
745USE parameters
746
747IMPLICIT NONE
748
749INTEGER (KIND=c_int), INTENT(IN) :: scf, rdc, snp, tfile, idc
750INTEGER (KIND=c_int), INTENT(IN) :: scalex, scaley
751CHARACTER (KIND=c_char), DIMENSION(*), INTENT(IN) :: sfi
752CHARACTER (LEN=scf) :: sfile
753real(kind=c_double), INTENT(IN) :: mdc
754CHARACTER (LEN=5) :: xaxis="xaxis", yaxis="yaxis"
755CHARACTER (LEN=65) :: xlabel
756
757INTERFACE
758 CHARACTER(LEN=65) FUNCTION xlegend (job, nleg, idl, cdc, snp)
759 INTEGER, INTENT(IN) :: job, nleg, idl, snp
760 DOUBLE PRECISION, INTENT(IN) :: cdc
761 END FUNCTION
762END INTERFACE
763
764xlabel = xlegend(rdc, idc, tfile, mdc, snp)
765
766do i=1, scf
767 sfile(i:i) = sfi(i)
768enddo
769
770open(unit=200, file=sfile, action="write", status='unknown')
771if (tfile .eq. 0) then
772 write (200, 001)
773 write (200, 002) xaxis, xlabel
774 write (200, 003) xaxis
775 if (scalex .eq. 1) write (200, 016)
776 write (200, 004) xaxis, 1.0
777 write (200, 005) xaxis, 0.5
778 write (200, 007) xaxis
779 write (200, 008) xaxis
780 write (200, 003) yaxis
781 if (scaley .eq. 1) write (200, 017)
782 write (200, 004) yaxis, 1.0
783 write (200, 005) yaxis, 0.5
784 write (200, 007) yaxis
785 write (200, 008) yaxis
786 write (200, 009)
787 write (200, 010)
788endif
789
790001 FORMAT ("@with g0")
791002 FORMAT ("@ ",a5," label """,a65)
792003 FORMAT ("@ ",a5," tick on")
793004 FORMAT ("@ ",a5," tick major size ",f8.6)
794005 FORMAT ("@ ",a5," tick minor size ",f8.6)
795007 FORMAT ("@ ",a5," ticklabel on")
796008 FORMAT ("@ ",a5," ticklabel char size 0.800000")
797009 FORMAT ("@ legend on")
798010 FORMAT ("@ legend box linestyle 0")
799016 FORMAT ("@ xaxes scale Logarithmic")
800017 FORMAT ("@ yaxes scale Logarithmic")
801
802END SUBROUTINE
803
804SUBROUTINE append_to_file (ndata, xdata, ydata, &
805 mdc, tdata, rdc, idc, snp, &
806 tfile, nfile, afile, lcname, cstring) bind (C,NAME='append_to_file_')
807
808USE parameters
809
810IMPLICIT NONE
811
812INTEGER (KIND=c_int), INTENT(IN) :: rdc, idc, snp
813INTEGER (KIND=c_int), INTENT(IN) :: ndata
814INTEGER (KIND=c_int), INTENT(IN) :: tfile, tdata
815INTEGER (KIND=c_int), INTENT(IN) :: nfile, afile, lcname
816CHARACTER (KIND=c_char), DIMENSION(*), INTENT(IN) :: cstring
817CHARACTER (LEN=lcname) :: cname
818INTEGER :: WA
819INTEGER :: start, step
820real(kind=c_double), INTENT(IN) :: mdc
821real(kind=c_double), DIMENSION(ndata), INTENT(IN) :: xdata, ydata
822CHARACTER (LEN=65) :: xlabel
823INTERFACE
824 CHARACTER(LEN=65) FUNCTION xlegend (job, nleg, idl, cdc, snp)
825 INTEGER, INTENT(IN) :: job, nleg, idl, snp
826 DOUBLE PRECISION, INTENT(IN) :: cdc
827 END FUNCTION
828END INTERFACE
829
830do i=1, lcname
831 cname(i:i) = cstring(i)
832enddo
833
834xlabel = xlegend(rdc, idc, tfile, mdc, snp)
835
836step=1
837start=1
838if (rdc .eq. idri) start=3
839if (rdc .eq. idch) start=2
840if (rdc .eq. idsp) then
841 start=2
842 step=1
843endif
844
845if (tfile .eq. 0) then
846 call charint(nom, nfile)
847 write (200, *) "@target G0.S",nom(2:len_trim(nom))
848 write (200, *) "@s",nom(2:len_trim(nom))," legend """, cname, """"
849 if (tdata .eq. 1) then
850 write (200, *) "@s",nom(2:len_trim(nom))," line linestyle 0"
851 write (200, 019)
852 else
853 write (200, 013)
854 endif
855else
856 write (200, 015) xlabel, cname
857endif
858do wa=start, ndata, step
859 write (200, 014) xdata(wa), ydata(wa)
860enddo
861write (200, *)
862
863if (nfile .eq. afile-1) close(200)
864
865013 FORMAT ("@type xy")
866014 FORMAT (f20.10,3x,f20.10)
867015 FORMAT ("# ",a65," ",a36)
868019 FORMAT ("@type bar")
869
870END SUBROUTINE
871
872SUBROUTINE save_to_file (scf, sfi, &
873 ndata, xdata, ydata, &
874 scalex, scaley, tdata, &
875 mdc, rdc, idc, snp, tfile, lcname, cstring) bind (C,NAME='save_to_file_')
876
877USE parameters
878
879IMPLICIT NONE
880
881INTEGER (KIND=c_int), INTENT(IN) :: scf, rdc, idc, snp, tfile
882INTEGER (KIND=c_int), INTENT(IN) :: ndata, scalex, scaley, tdata, lcname
883CHARACTER (KIND=c_char), DIMENSION(*), INTENT(IN) :: cstring
884CHARACTER (KIND=c_char), DIMENSION(*), INTENT(IN) :: sfi
885CHARACTER (LEN=scf) :: sfile
886CHARACTER (LEN=lcname) :: cname
887INTEGER :: step, start
888real(kind=c_double), INTENT(IN) :: mdc
889real(kind=c_double), DIMENSION(ndata), INTENT(IN) :: xdata, ydata
890INTEGER :: WA, WB
891CHARACTER (LEN=5) :: xaxis="xaxis", yaxis="yaxis"
892CHARACTER (LEN=65) :: xlabel
893CHARACTER (LEN=36) :: ylabel
894INTERFACE
895 CHARACTER(LEN=65) FUNCTION xlegend (job, nleg, idl, cdc, snp)
896 INTEGER, INTENT(IN) :: job, nleg, idl, snp
897 DOUBLE PRECISION, INTENT(IN) :: cdc
898 END FUNCTION
899 CHARACTER (LEN=36) FUNCTION ylegend (job, nleg, idl, snp)
900 INTEGER, INTENT(IN) :: job, nleg, idl, snp
901 END FUNCTION
902END INTERFACE
903
904ylabel = ylegend(rdc, idc, tfile, snp)
905do i=1, lcname
906 cname(i:i) = cstring(i)
907enddo
908xlabel = xlegend(rdc, idc, tfile, mdc, snp)
909
910start=1
911step=1
912if (rdc .eq. idri) start=3
913if (rdc .eq. idch) start=2
914if (rdc .eq. idsp) then
915 start=2
916 step=1
917endif
918
919do i=1, scf
920 sfile(i:i) = sfi(i)
921enddo
922
923open(unit=100, file=sfile, action="write", status='unknown')
924
925if (tfile .eq. 0) then
926 write (100, 001)
927 write (100, 002) xaxis, xlabel
928 write (100, 003) xaxis
929 if (scalex .eq. 1) write (100, 016)
930 write (100, 004) xaxis, 1.0
931 write (100, 005) xaxis, 0.5
932 write (100, 007) xaxis
933 write (100, 008) xaxis
934 write (100, 002) yaxis, ylabel
935 write (100, 006) yaxis, cname
936 write (100, 003) yaxis
937 if (scaley .eq. 1) write (100, 017)
938 write (100, 004) yaxis, 1.0
939 write (100, 005) yaxis, 0.5
940 write (100, 007) yaxis
941 write (100, 008) yaxis
942 write (100, 009)
943 write (100, 010)
944 if (rdc.eq.idri .or. rdc.eq.idch) then
945 if (tdata .eq. 1) then
946 wb=0
947 do wa=start, ndata
948 if (ydata(wa) .ne. 0) then
949 call charint(nom, wb)
950 call charint(nom2, wa)
951 write (100, *) "@ s",nom(2:len_trim(nom))," legend ""t",nom2(2:len_trim(nom2)),""""
952 write (100, *) "@ s",nom(2:len_trim(nom))," line linestyle 0"
953 write (100, *) "@ s",nom(2:len_trim(nom))," symbol fill pattern 14"
954 wb=wb+1
955 endif
956 enddo
957 wb=0
958 do wa=start, ndata
959 if (ydata(wa) .ne. 0) then
960 call charint(nom, wb)
961 write (100, *) "@target G0.S",nom(2:len_trim(nom))
962 write (100, 019)
963 write (100, 018) wa, ydata(wa)
964 wb=wb+1
965 endif
966 enddo
967 else
968 write (100, 011) cname
969 write (100, 012)
970 write (100, 013)
971 do wa=start, ndata
972 if (ydata(wa) .ne. 0.0) write (100, 018) wa, ydata(wa)
973 enddo
974 endif
975 elseif (rdc .eq. idsp) then
976 if (tdata .eq. 1) then
977 wb=0
978 do wa=start, ndata, step
979 if (ydata(wa) .ne. 0) then
980 call charint(nom, wb)
981 call charint(nom2, wa-1)
982 write (100, *) "@ s",nom(2:len_trim(nom))," legend ""t",nom2(2:len_trim(nom2)),""""
983 write (100, *) "@ s",nom(2:len_trim(nom))," line linestyle 0"
984 write (100, *) "@ s",nom(2:len_trim(nom))," symbol fill pattern 14"
985 wb=wb+1
986 endif
987 enddo
988 wb=0
989 do wa=start, ndata, step
990 if (ydata(wa) .ne. 0) then
991 call charint(nom, wb)
992 write (100, *) "@target G0.S",nom(2:len_trim(nom))
993 write (100, 019)
994 write (100, 018) wa, ydata(wa)
995 wb=wb+1
996 endif
997 enddo
998 else
999 write (100, 011) cname
1000 write (100, 012)
1001 write (100, 013)
1002 ! Check this
1003 do wa=start, ndata, 2
1004 write (100, 018) wa, ydata(wa)
1005 enddo
1006 endif
1007 elseif (rdc.eq.idsq .or. rdc.eq.idsk) then
1008 write (100, 011) cname
1009 write (100, 012)
1010 write (100, 013)
1011 do wa=start, ndata
1012 write (100, 014) xdata(wa), ydata(wa)
1013 enddo
1014 else
1015 if (tdata .eq. 0) then
1016 write (100, 011) cname
1017 write (100, 012)
1018 write (100, 013)
1019 else
1020 write (100, 011) cname
1021 write (100, 012)
1022 write (100, 019)
1023 endif
1024 do wa=start, ndata
1025 write (100, 014) xdata(wa), ydata(wa)
1026 enddo
1027 endif
1028else
1029 write (100, 015) xlabel, cname
1030 do wa=start, ndata, step
1031 write (100, 014) xdata(wa), ydata(wa)
1032 enddo
1033endif
1034close(100)
1035
1036001 FORMAT ("@with g0")
1037002 FORMAT ("@ ",a5," label """,a65)
1038003 FORMAT ("@ ",a5," tick on")
1039004 FORMAT ("@ ",a5," tick major size ",f8.6)
1040005 FORMAT ("@ ",a5," tick minor size ",f8.6)
1041006 FORMAT ("@ ",a5," label ",a36)
1042007 FORMAT ("@ ",a5," ticklabel on")
1043008 FORMAT ("@ ",a5," ticklabel char size 0.800000")
1044009 FORMAT ("@ legend on")
1045010 FORMAT ("@ legend box linestyle 0")
1046011 FORMAT ("@ s0 legend """,a50,"""")
1047012 FORMAT ("@target G0.S0")
1048013 FORMAT ("@type xy")
1049014 FORMAT (f20.10,3x,f20.10)
1050015 FORMAT ("# ",a65," ",a36)
1051016 FORMAT ("@ xaxes scale Logarithmic")
1052017 FORMAT ("@ yaxes scale Logarithmic")
1053018 FORMAT (i4,5x,f20.10)
1054019 FORMAT ("@type bar")
1055
1056END SUBROUTINE
action
action
Definition glview.h:198
parameters::x
double precision x
Definition parameters.F90:396
parameters::idan
integer idan
Definition parameters.F90:164
parameters::idsk
integer idsk
Definition parameters.F90:161
parameters::tl
character(len=2), dimension(:), allocatable tl
Definition parameters.F90:358
parameters::idsp
integer idsp
Definition parameters.F90:167
parameters::idbd
integer idbd
Definition parameters.F90:163
parameters::idskt
integer idskt
Definition parameters.F90:169
parameters::idsq
integer idsq
Definition parameters.F90:160
parameters::nom
character(len=15) nom
Definition parameters.F90:346
parameters::idgrfft
integer idgrfft
Definition parameters.F90:162
parameters::idri
integer idri
Definition parameters.F90:165
parameters::nom2
character(len=15) nom2
Definition parameters.F90:346
parameters::idch
integer idch
Definition parameters.F90:166
parameters::idgr
integer idgr
Definition parameters.F90:159
charint
subroutine charint(word, num)
Definition utils.F90:32
xlegend
character(len=65) function xlegend(job, nleg, idl, cdc, snp)
Definition writedata.F90:673
save_to_file
subroutine save_to_file(scf, sfi, ndata, xdata, ydata, scalex, scaley, tdata, mdc, rdc, idc, snp, tfile, lcname, cstring)
Definition writedata.F90:876
ylegend
character(len=36) function ylegend(job, nleg, idl, snp)
Definition writedata.F90:22
prep_file
subroutine prep_file(scf, sfi, snp, tfile, scalex, scaley, mdc, rdc, idc)
Definition writedata.F90:744
append_to_file
subroutine append_to_file(ndata, xdata, ydata, mdc, tdata, rdc, idc, snp, tfile, nfile, afile, lcname, cstring)
Definition writedata.F90:807