The ParaMonte Documentation Website
Current view: top level - kernel - Decoration_mod@Routines_smod.f90 (source / functions) Hit Total Coverage
Test: ParaMonte 1.5.1 :: MPI Parallel Kernel - Code Coverage Report Lines: 253 266 95.1 %
Date: 2021-01-08 13:07:16 Functions: 8 8 100.0 %
Legend: Lines: hit not hit

          Line data    Source code
       1             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
       2             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
       3             : !!!!
       4             : !!!!   MIT License
       5             : !!!!
       6             : !!!!   ParaMonte: plain powerful parallel Monte Carlo library.
       7             : !!!!
       8             : !!!!   Copyright (C) 2012-present, The Computational Data Science Lab
       9             : !!!!
      10             : !!!!   This file is part of the ParaMonte library.
      11             : !!!!
      12             : !!!!   Permission is hereby granted, free of charge, to any person obtaining a 
      13             : !!!!   copy of this software and associated documentation files (the "Software"), 
      14             : !!!!   to deal in the Software without restriction, including without limitation 
      15             : !!!!   the rights to use, copy, modify, merge, publish, distribute, sublicense, 
      16             : !!!!   and/or sell copies of the Software, and to permit persons to whom the 
      17             : !!!!   Software is furnished to do so, subject to the following conditions:
      18             : !!!!
      19             : !!!!   The above copyright notice and this permission notice shall be 
      20             : !!!!   included in all copies or substantial portions of the Software.
      21             : !!!!
      22             : !!!!   THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, 
      23             : !!!!   EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF 
      24             : !!!!   MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. 
      25             : !!!!   IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, 
      26             : !!!!   DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR 
      27             : !!!!   OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE 
      28             : !!!!   OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
      29             : !!!!
      30             : !!!!   ACKNOWLEDGMENT
      31             : !!!!
      32             : !!!!   ParaMonte is an honor-ware and its currency is acknowledgment and citations.
      33             : !!!!   As per the ParaMonte library license agreement terms, if you use any parts of 
      34             : !!!!   this library for any purposes, kindly acknowledge the use of ParaMonte in your 
      35             : !!!!   work (education/research/industry/development/...) by citing the ParaMonte 
      36             : !!!!   library as described on this page:
      37             : !!!!
      38             : !!!!       https://github.com/cdslaborg/paramonte/blob/main/ACKNOWLEDGMENT.md
      39             : !!!!
      40             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      41             : !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
      42             : 
      43             : #if defined MEXPRINT_ENABLED
      44             : #include "fintrf.h"
      45             : #endif
      46             : 
      47             : !>  \brief This submodule contains module procedures for outputting text.
      48             : !>  \author Amir Shahmoradi
      49             : 
      50             : submodule (Decoration_mod) Routines_mod
      51             : 
      52             :     implicit none
      53             : 
      54             : contains
      55             : 
      56             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      57             : 
      58             :     !> \brief
      59             :     !> The constructor of the [Decoration_type](@ref decoration_type class.
      60             :     !> @param[in]   tabStr : The string representing the tab character (**optional**, default = `TAB`).
      61             :     !> @param[in]   symbol : The symbol with which the text is decorated (**optional**).
      62             :     !> @param[in]   text : The text to be decorated (**optional**).
      63             :     !> @param[in]   List : A list of lines to be decorated (**optional**).
      64             :     !>
      65             :     !> \return
      66             :     !> Decoration : An object of class [Decoration_type](@ref decoration_type).
      67        1053 :     module function constructDecoration(tabStr,symbol,text,List) result(Decoration)
      68             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
      69             :         !DEC$ ATTRIBUTES DLLEXPORT :: constructDecoration
      70             : #endif
      71             :         use JaggedArray_mod, only: CharVec_type
      72             :         implicit none
      73             :         character(*), intent(in), optional          :: tabStr, symbol, text
      74             :         type(CharVec_type), intent(in), optional    :: List
      75             :         type(Decoration_type) :: Decoration
      76        1053 :         if (present(tabStr)) then
      77           3 :             Decoration%tab = tabStr
      78             :         else
      79        1050 :             Decoration%tab = TAB
      80             :         end if
      81        1053 :         if (present(symbol)) then
      82           3 :             Decoration%symbol = symbol
      83             :         else
      84        1050 :             Decoration%symbol = STAR
      85             :         end if
      86        1053 :         if (present(text)) Decoration%text = text
      87        1053 :         if (present(List)) Decoration%List = List
      88        1053 :     end function constructDecoration 
      89             : 
      90             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
      91             : 
      92             :     !> \brief
      93             :     !> Given a text and the requested characteristics, this function wraps the text to within the maximum width specified.
      94             :     !> @param[in]   text            : The input text.
      95             :     !> @param[in]   symbol          : The decoration symbol added to beginning and ending of the wrapped line (**optional**).
      96             :     !> @param[in]   width           : The wrapping with (**optional**).
      97             :     !> @param[in]   thicknessHorz   : The horizontal thickness of the symbol that sandwiches the text (**optional**).
      98             :     !> @param[in]   thicknessVert   : The vertical thickness of the symbol that sandwiches the text from top and bottom (**optional**).
      99             :     !> @param[in]   marginTop       : The number of empty lines between the top symbol line and the text start (**optional**).
     100             :     !> @param[in]   marginBot       : The number of empty lines between the bottom symbol line and the text start (**optional**).
     101             :     !> @param[in]   outputUnit      : The file unit to which the wrapper text must be written (**optional**).
     102             :     !> @param[in]   newLine         : The string that represent the new line in the input text (**optional**).
     103        3543 :     module subroutine writeDecoratedText(text,symbol,width,thicknessHorz,thicknessVert,marginTop,marginBot,outputUnit,newLine)
     104             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     105             :         !DEC$ ATTRIBUTES DLLEXPORT :: writeDecoratedText
     106             : #endif
     107             :         use, intrinsic :: iso_fortran_env, only: output_unit
     108        1053 :         use Constants_mod, only: IK
     109             :         implicit none
     110             :         character(*), intent(in)            :: text
     111             :         character(*), intent(in), optional  :: symbol,newLine
     112             :         integer(IK) , intent(in), optional  :: width,thicknessHorz,thicknessVert,marginTop,marginBot
     113             :         integer(IK) , intent(in), optional  :: outputUnit
     114             :         integer(IK)                         :: thicknessVertDefault
     115        3543 :         if (present(thicknessVert)) then
     116        1798 :             thicknessVertDefault = thicknessVert
     117             :         else
     118        1745 :             thicknessVertDefault = DECORATION_THICKNESS_VERT
     119             :         end if
     120        3543 :         if (present(newLine)) then
     121       30334 :             call writeDecoratedList( getListOfLines(text,newLine), symbol, width, thicknessHorz, thicknessVert, marginTop, marginBot, outputUnit )
     122             :         else
     123           0 :             call write(outputUnit,marginTop,0,thicknessVertDefault, drawLine(symbol,width) )
     124           0 :             call write(outputUnit,0,0,1, sandwich(text,symbol,width,thicknessHorz) )
     125           0 :             call write(outputUnit,0,marginBot,thicknessVertDefault, drawLine(symbol,width) )
     126             :         end if
     127        7086 :     end subroutine writeDecoratedText
     128             : 
     129             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     130             : 
     131             :     !> \brief
     132             :     !> Given a list of lines and the requested characteristics, this function wraps the text to within the maximum width specified.
     133             :     !> @param[in]   List            : The input list of lines to decorate and write.
     134             :     !> @param[in]   symbol          : The decoration symbol added to beginning and ending of the wrapped line (**optional**).
     135             :     !> @param[in]   width           : The wrapping with (**optional**).
     136             :     !> @param[in]   thicknessHorz   : The horizontal thickness of the symbol that sandwiches the text (**optional**).
     137             :     !> @param[in]   thicknessVert   : The vertical thickness of the symbol that sandwiches the text from top and bottom (**optional**).
     138             :     !> @param[in]   marginTop       : The number of empty lines between the top symbol line and the text start (**optional**).
     139             :     !> @param[in]   marginBot       : The number of empty lines between the bottom symbol line and the text start (**optional**).
     140             :     !> @param[in]   outputUnit      : The file unit to which the wrapper text must be written (**optional**).
     141        3549 :     module subroutine writeDecoratedList(List,symbol,width,thicknessHorz,thicknessVert,marginTop,marginBot,outputUnit)
     142             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     143             :         !DEC$ ATTRIBUTES DLLEXPORT :: writeDecoratedList
     144             : #endif
     145             :         use, intrinsic :: iso_fortran_env, only: output_unit
     146        3543 :         use Constants_mod, only: IK
     147             :         implicit none
     148             :         type(CharVec_type), allocatable , intent(in)    :: List(:)
     149             :         character(*)        , intent(in), optional      :: symbol
     150             :         integer(IK)         , intent(in), optional      :: width,thicknessHorz,thicknessVert,marginTop,marginBot
     151             :         integer(IK)         , intent(in), optional      :: outputUnit
     152             :         integer(IK)                                     :: i
     153             :         integer(IK)                                     :: thicknessVertDefault
     154        3549 :         if (present(thicknessVert)) then
     155        1801 :             thicknessVertDefault = thicknessVert
     156             :         else
     157        1748 :             thicknessVertDefault = DECORATION_THICKNESS_VERT
     158             :         end if
     159        3549 :         call write(outputUnit,marginTop,0,thicknessVertDefault, drawLine(symbol,width) )
     160       26821 :         do i = 1,size(List)
     161       26821 :             call write(outputUnit,0,0,1, sandwich(List(i)%record,symbol,width,thicknessHorz) )
     162             :         end do
     163        3549 :         call write(outputUnit,0,marginBot,thicknessVertDefault, drawLine(symbol,width) )
     164        7098 :     end subroutine writeDecoratedList
     165             : 
     166             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     167             : 
     168             :     !> \brief
     169             :     !> Return a string which is a pattern repetition for the requested width.
     170             :     !> @param[in]   symbol  : The decoration symbol added to beginning and ending of the wrapped line (**optional**, default = `STAR`).
     171             :     !> @param[in]   width   : The width of the line (**optional**, default = `DECORATION_WIDTH`).
     172             :     !>
     173             :     !> \return
     174             :     !> `line` : A string of the requested pattern.
     175        7107 :     pure module function drawLine(symbol,width) result(line)
     176             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     177             :         !DEC$ ATTRIBUTES DLLEXPORT :: drawLine
     178             : #endif
     179        3549 :         use Constants_mod, only: IK
     180             :         implicit none
     181             :         character(*), intent(in), optional  :: symbol
     182             :         integer(IK), intent(in) , optional  :: width
     183             : 
     184             :         character(:), allocatable           :: line
     185             :         integer(IK)                         :: decorationWidth, symbolLen, symbolIndex, i
     186        7107 :         character(:), allocatable           :: decorationSymbol
     187             : 
     188        7107 :         if (present(symbol)) then
     189        3608 :             if (len(symbol)<1) then
     190           0 :                 decorationSymbol = " "
     191             :             else
     192        3608 :                 decorationSymbol = symbol
     193             :             end if
     194             :         else
     195        3499 :             decorationSymbol = STAR
     196             :         end if
     197        7107 :         symbolLen = len(decorationSymbol)
     198             : 
     199        7107 :         if (present(width)) then
     200        3605 :             decorationWidth = width
     201             :         else
     202        3502 :             decorationWidth = DECORATION_WIDTH
     203             :         end if
     204             : 
     205        7107 :         symbolIndex = 1
     206        7107 :         allocate(character(decorationWidth) :: line)
     207      944556 :         do i=1,decorationWidth
     208      937449 :             line(i:i) = decorationSymbol(symbolIndex:symbolIndex)
     209      937449 :             symbolIndex = symbolIndex + 1
     210      944556 :             if (symbolIndex>symbolLen) symbolIndex = 1
     211             :         end do
     212             : 
     213        7107 :     end function drawLine
     214             : 
     215             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     216             : 
     217             :     !> \brief
     218             :     !> Sandwich the input string with the input symbol for the requested thickness on both ends of the string.
     219             :     !> @param[in]   text            : The text to be sandwiched (**optional**).
     220             :     !> @param[in]   symbol          : The decoration symbol added to beginning and ending of the wrapped line (**optional**).
     221             :     !> @param[in]   width           : The width of the line (**optional**).
     222             :     !> @param[in]   thicknessHorz   : The width of the decoration to be added at the beginning and end of the string (**optional**).
     223             :     !>
     224             :     !> \return
     225             :     !> `sandwichedText` : A string of the requested pattern.
     226       23287 :     pure module function sandwich(text,symbol,width,thicknessHorz) result(sandwichedText)
     227             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     228             :         !DEC$ ATTRIBUTES DLLEXPORT :: sandwich
     229             : #endif
     230        7107 :         use Constants_mod, only: IK
     231             :         implicit none
     232             :         character(*), intent(in), optional  :: text, symbol
     233             :         integer(IK), intent(in) , optional  :: width,thicknessHorz
     234             :         character(:), allocatable           :: sandwichedText
     235             :         integer(IK)                         :: decorationWidth, decorationThicknessHorz
     236       23287 :         character(:), allocatable           :: decorationText, decorationSymbol
     237             :         integer(IK)                         :: i,decorationTextLen, symbolLen, symbolIndex, leftLimit, rightLimit
     238             :         integer(IK)                         :: sandwichedTextStart,decorationTextStart,decorationTextLenCounter
     239             : 
     240       23287 :         if (present(symbol)) then
     241       18007 :             decorationSymbol = symbol
     242             :         else
     243        5280 :             decorationSymbol = STAR
     244             :         end if
     245             : 
     246       23287 :         if (present(width)) then
     247       18004 :             decorationWidth = width
     248             :         else
     249        5283 :             decorationWidth = DECORATION_WIDTH
     250             :         end if
     251             : 
     252       23287 :         if (present(thicknessHorz)) then
     253       18001 :             decorationThicknessHorz = thicknessHorz
     254             :         else
     255        5286 :             decorationThicknessHorz = DECORATION_THICKNESS_HORZ
     256             :         end if
     257             : 
     258       23287 :         if (present(text)) then
     259       23284 :             decorationText = trim(adjustl(text))
     260             :         else
     261           3 :             decorationText = ""
     262             :         end if
     263             : 
     264       23287 :         if (decorationWidth<1) then
     265           0 :             sandwichedText = ""
     266           0 :             return
     267             :         end if
     268             : 
     269       23287 :         allocate( character(decorationWidth) :: sandwichedText )
     270       23287 :         decorationTextLen = len(decorationText)
     271             : 
     272       23287 :         symbolLen = len(symbol)
     273       23287 :         symbolIndex = 1
     274       23287 :         leftLimit   = decorationThicknessHorz + 1
     275       23287 :         rightLimit  = decorationWidth - decorationThicknessHorz + 1
     276             : 
     277       23287 :         if (decorationTextLen<1) then
     278     1518190 :             do i = 1, decorationWidth
     279     1518190 :                 if (i<leftLimit) then
     280       45732 :                     sandwichedText(i:i) = decorationSymbol(symbolIndex:symbolIndex)
     281       45732 :                     symbolIndex = symbolIndex + 1
     282       45732 :                     if (symbolIndex>symbolLen) symbolIndex = 1
     283     1461020 :                 elseif (i<rightLimit) then
     284     1415290 :                     sandwichedText(i:i) = " "
     285     1415290 :                     symbolIndex = symbolIndex + 1
     286     1415290 :                     if (symbolIndex>symbolLen) symbolIndex = 1
     287             :                 else
     288       45732 :                     sandwichedText(i:i) = decorationSymbol(symbolIndex:symbolIndex)
     289       45732 :                     symbolIndex = symbolIndex + 1
     290       45732 :                     if (symbolIndex>symbolLen) symbolIndex = 1
     291             :                 end if
     292             :             end do
     293       11433 :             return
     294             :         end if
     295             : 
     296       11854 :         sandwichedTextStart = max( leftLimit  , ( decorationWidth - decorationTextLen ) / 2 + 1 )
     297       11854 :         decorationTextStart = max( 1 , leftLimit - ( decorationWidth - decorationTextLen ) / 2 )
     298       11854 :         decorationTextLenCounter = decorationTextStart
     299             : 
     300     1575140 :         do i=1,decorationWidth
     301     1575140 :             if (i<leftLimit) then
     302       47383 :                 sandwichedText(i:i) = decorationSymbol(symbolIndex:symbolIndex)
     303       47383 :                 symbolIndex = symbolIndex + 1
     304       47383 :                 if (symbolIndex>symbolLen) symbolIndex = 1
     305     1515900 :             elseif (i<rightLimit) then
     306     1468520 :                 if (i<sandwichedTextStart) then
     307      534313 :                     sandwichedText(i:i) = " "
     308      934209 :                 else if ( decorationTextLenCounter<=decorationTextLen ) then
     309      392803 :                     sandwichedText(i:i) = decorationText(decorationTextLenCounter:decorationTextLenCounter)
     310      392803 :                     decorationTextLenCounter = decorationTextLenCounter + 1
     311             :                 else
     312      541406 :                     sandwichedText(i:i) = " "
     313             :                 end if
     314     1468520 :                 symbolIndex = symbolIndex + 1
     315     1468520 :                 if (symbolIndex>symbolLen) symbolIndex = 1
     316             :             else
     317       47383 :                 sandwichedText(i:i) = decorationSymbol(symbolIndex:symbolIndex)
     318       47383 :                 symbolIndex = symbolIndex + 1
     319       47383 :                 if (symbolIndex>symbolLen) symbolIndex = 1
     320             :             end if
     321             :         end do
     322             : 
     323             :         !! initialize empty container
     324             :         !do i=1,decorationWidth
     325             :         !    sandwichedText(i:i) = " "
     326             :         !end do
     327             : 
     328             :         !! add margin
     329             :         !do i=1,decorationThicknessHorz
     330             :         !    sandwichedText(i:i) = decorationSymbol
     331             :         !    sandwichedText(decorationWidth-i+1:decorationWidth-i+1) = decorationSymbol
     332             :         !end do
     333             : 
     334             :         !! add decorationText in between
     335             :         !sandwichedTextStart = max( decorationThicknessHorz , (decorationWidth-decorationTextLen)/2 )
     336             :         !sandwichedTextEnd   = min( decorationWidth , sandwichedTextStart + decorationTextLen - 1 )
     337             :         !decorationTextStart = 1 
     338             :         !decorationTextEnd   = sandwichedTextEnd - sandwichedTextStart + 1
     339             :         !sandwichedText(sandwichedTextStart:sandwichedTextEnd) = decorationText(decorationTextStart:decorationTextEnd)
     340             : 
     341       23287 :     end function sandwich
     342             : 
     343             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     344             : 
     345             :     !> \brief
     346             :     !> Write the decorated text to the output.
     347             :     !> @param[in]   outputUnit  : The output file unit (**optional**).
     348             :     !> @param[in]   marginTop   : The number of empty lines before writing the string (**optional**).
     349             :     !> @param[in]   marginBot   : The number of empty lines after writing the string (**optional**).
     350             :     !> @param[in]   count       : The number of times to write the string to the output (**optional**, default = 1).
     351             :     !> @param[in]   width       : The width of the line (**optional**).
     352             :     !> @param[in]   string      : The string to output (**optional**, default = "").
     353      332724 :     module subroutine write ( outputUnit    &
     354             :                             , marginTop     &
     355             :                             , marginBot     &
     356             :                             , count         &
     357             :                             , string        &
     358             : #if defined MEXPRINT_ENABLED
     359             :                             , advance       &
     360             : #endif
     361             :                             )
     362             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     363             :         !DEC$ ATTRIBUTES DLLEXPORT :: write
     364             : #endif
     365             :         use, intrinsic :: iso_fortran_env, only: output_unit
     366       23287 :         use Constants_mod, only: IK, NLC
     367             :         implicit none
     368             :         integer(IK) , intent(in), optional  :: outputUnit
     369             :         integer(IK) , intent(in), optional  :: marginTop, marginBot, count
     370             :         character(*), intent(in), optional  :: string
     371             :         integer(IK)                         :: i, logFileUnit, thisManyTimes
     372             : #if defined MEXPRINT_ENABLED
     373             :         logical     , intent(in), optional  :: advance
     374             :         logical                             :: isStdout, advanceEnabled
     375             :         advanceEnabled = .true.; if (present(advance)) advanceEnabled = advance
     376             : #endif
     377             : 
     378      332724 :         if (present(outputUnit)) then
     379             : #if defined MEXPRINT_ENABLED
     380             :             isStdout = output_unit == outputUnit
     381             : #endif
     382      332039 :             logFileUnit = outputUnit
     383             :         else
     384             : #if defined MEXPRINT_ENABLED
     385             :             isStdout = .true.
     386             : #endif
     387         685 :             logFileUnit = output_unit
     388             :         end if
     389             : 
     390      332724 :         if (present(marginTop)) then
     391      353513 :             do i = 1, marginTop
     392             : #if defined MEXPRINT_ENABLED
     393             :                 if (isStdout) then
     394             :                     call mexPrintf(NLC)
     395             :                 else
     396             :                     write(logFileUnit,*)
     397             :                 end if
     398             : #else
     399      353513 :                 write(logFileUnit,*)
     400             : #endif
     401             :             end do
     402             :         end if
     403             :     
     404      332724 :         if (present(count)) then
     405      310460 :             thisManyTimes = count
     406             :         else
     407       22264 :             thisManyTimes = 1
     408             :         end if
     409             : 
     410      332724 :         if (present(string)) then
     411      622566 :             do i = 1, thisManyTimes
     412             : #if defined MEXPRINT_ENABLED
     413             :                 if (isStdout) then
     414             :                     if (advanceEnabled) then
     415             :                         call mexPrintf(string//NLC)
     416             :                     else
     417             :                         call mexPrintf(string)
     418             :                     end if
     419             :                 else
     420             :                     write(logFileUnit,"(g0)") string
     421             :                 end if
     422             : #else
     423      622566 :                 write(logFileUnit,"(g0)") string
     424             : #endif
     425             :             end do
     426       21806 :         elseif (.not. ( present(marginBot) .and. present(marginTop) ) ) then
     427       41728 :             do i = 1, thisManyTimes
     428             : #if defined MEXPRINT_ENABLED
     429             :                 if (isStdout) then
     430             :                     call mexPrintf(NLC)
     431             :                 else
     432             :                     write(logFileUnit,*)
     433             :                 end if
     434             : #else
     435       41728 :                 write(logFileUnit,*)
     436             : #endif
     437             :             end do
     438             :         end if
     439             :     
     440      332724 :         if (present(marginBot)) then
     441      350885 :             do i = 1, marginBot
     442             : #if defined MEXPRINT_ENABLED
     443             :                 if (isStdout) then
     444             :                     call mexPrintf(NLC)
     445             :                 else
     446             :                     write(logFileUnit,*)
     447             :                 end if
     448             : #else
     449      350885 :                 write(logFileUnit,*)
     450             : #endif
     451             :             end do
     452             :         end if
     453             :   
     454      665448 :     end subroutine write
     455             : 
     456             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     457             : 
     458             :     !> \brief
     459             :     !> Wrap the input text to fit it within the requested line width.
     460             :     !> @param[in]   string  : The string to wrap.
     461             :     !> @param[in]   width   : The wrapping width.
     462             :     !> @param[in]   split   : The string at which the text can be broken and put on the next line, if needed (**optional**, default = "").
     463             :     !> @param[in]   pad     : The string to prepend each line (**optional**).
     464             :     !>
     465             :     !> \return
     466             :     !> ListOfLines : The list of lines that are wrapped to fit within the requested input width.
     467      142329 :     module function wrapText(string,width,split,pad) result(ListOfLines)
     468             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     469             :         !DEC$ ATTRIBUTES DLLEXPORT :: wrapText
     470             : #endif
     471             : 
     472             :         use, intrinsic :: iso_fortran_env, only: output_unit
     473      332724 :         use Constants_mod, only: IK
     474             : 
     475             :         implicit none
     476             : 
     477             :         character(*), parameter :: PROCEDURE_NAME = "@wrapText()"
     478             : 
     479             :         character(*), intent(in)            :: string
     480             :         integer(IK) , intent(in)            :: width
     481             :         character(*), intent(in), optional  :: split, pad
     482             :         type(CharVec_type), allocatable     :: ListOfLines(:)
     483             :         integer(IK)                         :: stringLen, splitLen, padLen, padLength, padLengthDynamic, newLineLen, oldLineLen
     484             :         integer(IK)                         :: istart, iend, numSplitEndLoc, counter, lineCount, indx, indxOld
     485             :         integer(IK), allocatable            :: IsEndOfSplitLoc(:), EndOfSplitLoc(:), EndOfLineLoc(:)
     486             :         logical                             :: isPadZone
     487             : 
     488      142329 :         padLen = len(pad)
     489      142329 :         splitLen = len(split)
     490      142329 :         stringLen = len(string)
     491      142329 :         if (stringLen==0) then
     492       85808 :             allocate( ListOfLines(1) )
     493       42904 :             ListOfLines(1)%record = ""
     494       42904 :             return
     495       99425 :         elseif (splitLen>=stringLen) then
     496           0 :             allocate( ListOfLines(1) )
     497           0 :             ListOfLines(1)%record = string
     498           0 :             return
     499       99425 :         elseif (splitLen==0) then ! enforce wrapping at any character as necessary
     500       12924 :             lineCount = stringLen / width + 1
     501       28720 :             allocate( ListOfLines(lineCount) )
     502       15796 :             do indx = 1, lineCount-1
     503       15796 :                 ListOfLines(indx)%record = string(width*(indx-1)+1:width*indx)
     504             :             end do
     505       12924 :             ListOfLines(lineCount)%record = string(width*(lineCount-1)+1:stringLen)
     506       12924 :             return
     507             :         end if
     508             : 
     509             :         ! get the initial pad size, and the locations of split ends.
     510             : 
     511       86501 :         allocate(IsEndOfSplitLoc(stringLen))
     512    19212100 :         IsEndOfSplitLoc = 0_IK
     513       86501 :         istart = 1_IK
     514       86501 :         iend = istart + splitLen - 1_IK
     515       86501 :         padLength = 0_IK
     516       86501 :         isPadZone = .true.
     517       86501 :         if (padLen==0_IK) isPadZone = .false.
     518    19039100 :         blockFindSplit: do
     519    19125600 :             if (iend==stringLen) then
     520       86501 :                 IsEndOfSplitLoc(stringLen) = 1_IK
     521       86501 :                 exit blockFindSplit
     522             :             end if
     523    19039100 :             if ( isPadZone .and. mod(iend,padLen)==0_IK .and. string(istart:iend)==pad ) then
     524      268668 :                 padLength = iend
     525             :             else
     526    18770400 :                 isPadZone = .false.
     527             :             end if
     528    19039100 :             if (string(istart:iend)==split) then
     529     2977370 :                 IsEndOfSplitLoc(iend) = 1_IK
     530             :             else
     531    16061700 :                 IsEndOfSplitLoc(iend) = 0_IK
     532             :             end if
     533    19039100 :             istart = istart + 1_IK
     534    19039100 :             iend = iend + 1_IK
     535             :         end do blockFindSplit
     536             : 
     537             :         ! create a vector of split-end indices
     538             : 
     539    19212100 :         numSplitEndLoc = sum(IsEndOfSplitLoc)
     540       86501 :         if (numSplitEndLoc==0_IK) then
     541           0 :             allocate( ListOfLines(1) )
     542           0 :             ListOfLines(1)%record = string
     543           0 :             return
     544             :         else
     545             :             ! xxx: here goes another GFortran 7.3 bug: EndOfSplitLoc is assumed already allocated, despite the first appearance here.
     546       86501 :             if (allocated(EndOfSplitLoc)) deallocate(EndOfSplitLoc)
     547       86501 :             allocate(EndOfSplitLoc(numSplitEndLoc))
     548       86501 :             counter = 0_IK
     549    19212100 :             do indx = 1,stringLen
     550    19212100 :                 if (IsEndOfSplitLoc(indx)==1_IK) then
     551     3063870 :                     counter = counter + 1_IK
     552     3063870 :                     EndOfSplitLoc(counter) = indx
     553             :                 end if
     554             :             end do
     555             :         end if
     556     6300740 :         EndOfSplitLoc = EndOfSplitLoc(1:counter)
     557       86501 :         deallocate(IsEndOfSplitLoc)
     558             : 
     559             :         ! compute the number wrappings to be done
     560             : 
     561             :         ! xxx: here goes another GFortran 7.3 bug: EndOfLineLoc is assumed already allocated, despite the first appearance here.
     562       86501 :         if (allocated(EndOfLineLoc)) deallocate(EndOfLineLoc)
     563       86501 :         allocate( EndOfLineLoc(0:numSplitEndLoc+1) ) ! consider the maximum possible number of lines
     564     3323370 :         EndOfLineLoc = 0_IK
     565       86501 :         lineCount = 0_IK
     566       86501 :         padLengthDynamic = 0_IK ! first wrap does not need padding
     567       86501 :         indxOld = 1_IK
     568       86501 :         indx = 0_IK
     569       86501 :         oldLineLen = -huge(oldLineLen)
     570     2998870 :         blockFindLine: do
     571     3085370 :             indx = indx + 1_IK
     572     3085370 :             if (indx>numSplitEndLoc) exit blockFindLine
     573     2998870 :             newLineLen = padLengthDynamic+EndOfSplitLoc(indx)-EndOfLineLoc(lineCount)
     574     2998870 :             if (newLineLen<=width) then
     575     2846500 :                 oldLineLen = newLineLen
     576     2846500 :                 cycle blockFindLine
     577             :             else
     578             :                 ! swap the commented block with the uncommented to switch from better to good wrapping style.
     579      152376 :                 lineCount = lineCount + 1_IK
     580      152376 :                 if (indx-1_IK>indxOld) then ! ensure there is at least one split before the wrapping point
     581             :                     ! comment the following line to keep the max line length, strictly less than width (if possible).
     582      151590 :                     if (width-oldLineLen>newLineLen-width) indx = indx + 1_IK ! removing the last token would make the line more beautiful
     583      151590 :                     EndOfLineLoc(lineCount) = EndOfSplitLoc(indx-1)
     584             :                 else
     585         786 :                     EndOfLineLoc(lineCount) = EndOfSplitLoc(indx)
     586             :                 end if
     587      152376 :                 indxOld = indx
     588      152376 :                 padLengthDynamic = padLength
     589             :             end if
     590             :         end do blockFindLine
     591             : 
     592             :         ! add the remaining end of the string as a separate line
     593             : 
     594       86501 :         if (EndOfLineLoc(lineCount)<stringLen .or. lineCount==0_IK) then
     595       84012 :             lineCount = lineCount + 1_IK
     596       84012 :             EndOfLineLoc(lineCount) = stringLen
     597             :         end if
     598     3796150 :         EndOfLineLoc = pack(EndOfLineLoc, mask=EndOfLineLoc/=0_IK)
     599             : 
     600             :         ! ensure the line count makes sense
     601             : 
     602       86501 :         if ( lineCount /= size(EndOfLineLoc) ) then
     603             :             ! LCOV_EXCL_START
     604             :             write(output_unit,"(*(g0,:,' '))")  MODULE_NAME // PROCEDURE_NAME // &
     605             :                                                 ": Internal error occurred. lineCount /= size(EndOfLineLoc):", &
     606             :                                                 lineCount, "/=", size(EndOfLineLoc), EndOfLineLoc
     607             :             write(output_unit,"(*(g0,:,' '))")  EndOfSplitLoc
     608             :             error stop
     609             :             ! LCOV_EXCL_STOP
     610             :         end if
     611             : 
     612             :         ! construct the wrappings
     613             :         
     614      322889 :         allocate( ListOfLines(lineCount) )
     615       86501 :         indx = 1_IK
     616       86501 :         ListOfLines(indx)%record = string(1:EndOfLineLoc(indx))
     617      236388 :         do indx = 2, lineCount
     618      149887 :             if ( padLength==0 .and. EndOfLineLoc(indx-1)+1>EndOfLineLoc(indx) ) then
     619             :                 ! LCOV_EXCL_START
     620             :                 write(output_unit,"(*(g0,:,' '))")  MODULE_NAME // PROCEDURE_NAME // &
     621             :                                                     ": Fatal error occurred. " // &
     622             :                                                     "padLength==0 .and. EndOfLineLoc(indx-1)+1>EndOfLineLoc(indx) " // &
     623             :                                                     "for string: "
     624             :                 write(output_unit,"(A)")            string
     625             :                 error stop
     626             :                 ! LCOV_EXCL_STOP
     627             :             end if
     628      236388 :             ListOfLines(indx)%record = string(1:padLength) // string(EndOfLineLoc(indx-1)+1:EndOfLineLoc(indx))
     629             :         end do
     630             : 
     631      142329 :     end function wrapText
     632             : 
     633             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     634             : 
     635             :     !> \brief
     636             :     !> Convert a string to a list of lines.
     637             :     !> @param[in]   string      : The string.
     638             :     !> @param[in]   delimiter   : The substring at which the string will be split to form multiple lines (**optional**, default = "").
     639             :     !>
     640             :     !> \return
     641             :     !> ListOfLines : The list of lines generated from the input string.
     642             :     !>
     643             :     !> \remark
     644             :     !> The escape sequence "\n" can be passed as the input value of `delimiter` to separate the lines.
     645       39093 :     module function getListOfLines(string,delimiter) result(ListOfLines)
     646             : #if INTEL_COMPILER_ENABLED && defined DLL_ENABLED && (OS_IS_WINDOWS || defined OS_IS_DARWIN)
     647             :         !DEC$ ATTRIBUTES DLLEXPORT :: getListOfLines
     648             : #endif
     649      142329 :         use Constants_mod, only: IK
     650             :         implicit none
     651             :         character(len=*)  , intent(in)              :: string
     652             :         character(len=*)  , intent(in), optional    :: delimiter
     653             :         type(CharVec_type), allocatable             :: ListOfLines(:)
     654       39093 :         character(len=:)  , allocatable             :: dumstr
     655             :         integer(IK)                                 :: stringLen, delimLen, delimLenMinusOne
     656             :         integer(IK)                                 :: maxNumSplit, counterString, counterLine, counterRecord
     657             :         logical                                     :: delimIsCStyle
     658             : 
     659       39093 :         if (.not.present(delimiter)) then
     660        1120 :             allocate(ListOfLines(1))
     661         560 :             ListOfLines(1)%record = string
     662         560 :             return
     663             :         end if
     664             : 
     665       38533 :         stringLen = len(string)
     666       38533 :         delimLen  = len(delimiter)
     667       38533 :         delimLenMinusOne = delimLen - 1
     668             : 
     669       38533 :         if (delimLen==0 .or. stringLen==0 .or. stringLen<delimLen) then
     670           4 :             allocate(ListOfLines(1))
     671           2 :             ListOfLines(1)%record = string
     672           2 :             return
     673             :         end if
     674             : 
     675       38531 :         delimIsCStyle = delimLen==2 .and. delimiter=="\n"
     676             : 
     677       38531 :         maxNumSplit = 1 + stringLen / delimLen
     678    11385800 :         allocate(ListOfLines(maxNumSplit))
     679       38531 :         allocate( character(len=stringLen) :: dumstr )
     680       38531 :         counterLine = 0
     681       38531 :         counterRecord = 0
     682       38531 :         counterString = 1
     683    19529700 :         loopParseString: do
     684    19568200 :             if (counterString+delimLenMinusOne>stringLen) then
     685       34988 :                 counterLine = counterLine + 1
     686       34988 :                 if (counterRecord==0) then
     687           0 :                     ListOfLines(counterLine)%record = string(counterString:stringLen)
     688             :                 else
     689       34988 :                     ListOfLines(counterLine)%record = dumstr(1:counterRecord) // string(counterString:stringLen)
     690             :                 end if
     691       34988 :                 exit loopParseString
     692             :             end if
     693    19533300 :             if (string(counterString:counterString+delimLenMinusOne)==delimiter) then
     694      113557 :                 counterLine = counterLine + 1
     695      113557 :                 if (counterRecord==0) then
     696       50789 :                     ListOfLines(counterLine)%record = ""
     697             :                 else
     698       62768 :                     ListOfLines(counterLine)%record = dumstr(1:counterRecord)
     699       62768 :                     counterRecord = 0
     700             :                 end if
     701      113557 :                 counterString = counterString + delimLen
     702      113557 :                 if (counterString>stringLen) then
     703        3543 :                     counterLine = counterLine + 1
     704        3543 :                     ListOfLines(counterLine)%record = ""
     705        3543 :                     exit loopParseString
     706             :                 end if
     707    19419700 :             elseif (delimIsCStyle .and. string(counterString:counterString)=="\") then
     708        4667 :                 counterString = counterString + 1
     709        4667 :                 counterRecord = counterRecord + 1
     710        4667 :                 dumstr(counterRecord:counterRecord) = "\"
     711        4667 :                 if (string(counterString:counterString)=="\") counterString = counterString + 1
     712             :             else
     713    19415000 :                 counterRecord = counterRecord + 1
     714    19415000 :                 dumstr(counterRecord:counterRecord) = string(counterString:counterString)
     715    19415000 :                 counterString = counterString + 1
     716             :             end if
     717             :         end do loopParseString
     718             : 
     719    11919100 :         ListOfLines = ListOfLines(1:counterLine)
     720             : 
     721       78186 :     end function getListOfLines
     722             : 
     723             : !%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
     724             : 
     725             : end submodule Routines_mod

ParaMonte: Plain Powerful Parallel Monte Carlo Library 
The Computational Data Science Lab
© Copyright 2012 - 2021