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