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             :