prep.f90 Source File


Contents

Source Code


Source Code

!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
!  @(#)prep: Fortran preprocessor
!  Fortran preprocessor originally based on public-domain FPP preprocessor from Lahey Fortran Code Repository
!     http://www.lahey.com/code.htm
!  Extensively rewritten since under a MIT License.
!     2013-10-03,2020-12-19,2021-06-12 : John S. Urban
! ADD
! o line control  # linenumber "file"
! o looping
! CONSIDER
! o make $OUTPUT file nestable
! o allow multiple files on $INCLUDE?
! o undocument $BLOCK HELP|VERSION?
! o %,>>,<< operators
! o replace math parsing with M_calculator (but add logical operators to M_calculator)
! o cpp-like procedure macros
! o cpp or fpp compatibility mode
! o modularize and modernize calculator expression, if/else/endif
!
! REMOVED $REDEFINE and no longer produce warning message if redefine a variable, more like fpp(1) and cpp(1)
!
! some fpp versions allow integer intrinsics, not well documented but things like "#define AND char(34)"
!
! a PROCEDURE variable with current procedure name, maybe MODULE::PROCEDURE::CONTAINS format would be very handy in messages
!
! perhaps change to a more standard CLI syntax; but either way support multiple -D and maybe -D without a space before value
!
! extend $INCLUDE to call libcurl to access remote files
!
! case('ENDBLOCK');           call document(' ') ! BUG: '' instead of 'END' worked with kracken95, not with M_CLI2
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
module M_prep                                                             !@(#)M_prep(3f): module used by prep program
USE ISO_FORTRAN_ENV, ONLY : STDERR=>ERROR_UNIT, STDOUT=>OUTPUT_UNIT,STDIN=>INPUT_UNIT
use M_io,        only : get_tmp, dirname, uniq, fileopen, filedelete, get_env       ! Fortran file I/O routines
use M_CLI2,      only : set_args, SGET, lget, unnamed, specified !,print_dictionary ! load command argument parsing module
use M_strings,   only : nospace, v2s, substitute, upper, lower, isalpha, split, delim, str_replace=>replace, sep, atleast, unquote
use M_strings,   only : glob
use M_list,      only : dictionary
use M_expr,      only : expr, get_integer_from_string, table
implicit none

integer,parameter                    :: num=2048                       ! number of named values allowed
integer,public,parameter             :: G_line_length=4096             ! allowed length of input lines
integer,public,parameter             :: G_var_len=63                   ! allowed length of variable names

logical,public                       :: G_ident=.false.                ! whether to write IDENT as a comment or CHARACTER

character(len=G_line_length),public  :: G_source                       ! original source file line
character(len=G_line_length),public  :: G_outline                      ! message to build for writing to output

type(dictionary),save                :: macro

type file_stack
   integer                           ::  unit_number
   integer                           ::  line_number=0
   character(len=G_line_length)      ::  filename
end type
type(file_stack),public              ::  G_file_dictionary(250)

type parcel_stack
   integer                           ::  unit_number
   integer                           ::  line_number=0
   character(len=G_line_length)      ::  name
end type
type(parcel_stack),public            :: G_parcel_dictionary(500)

integer,save                         :: G_line_number=0
logical,save,public                  :: G_inparcel=.false.
integer,public                       :: G_iocount=0
integer,public                       :: G_parcelcount=0
integer,public                       :: G_io_total_lines=0
integer,public                       :: G_iwidth                       ! maximum width of line to write on output unit
logical,public                       :: G_noenv=.false.                ! ignore environment variables in $IFDEF and $IFNDEF

integer,public                       :: G_iout                         ! output unit
integer,save,public                  :: G_iout_init                    ! initial output unit
!integer,public                       :: G_ihelp=stderr                 ! output unit for help text
integer,public                       :: G_ihelp=stdout                 ! output unit for help text
character(len=10),public             :: G_outtype='asis'

integer,public                       :: G_inc_count=0
character(len=G_line_length),public  :: G_inc_files(50)
character(len=:),allocatable,save    :: G_MAN
logical,save                         :: G_MAN_COLLECT=.false.
logical,save                         :: G_MAN_PRINT=.false.
character(len=:),allocatable         :: G_MAN_FILE
character(len=10)                    :: G_MAN_FILE_POSITION='ASIS      '

integer,public                       :: G_nestl=0                      ! count of if/elseif/else/endif nesting level
integer,public,parameter             :: G_nestl_max=20                 ! maximum nesting level of conditionals

logical,save                         :: G_debug=.false.
logical,save,public                  :: G_verbose=.false.              ! verbose, including write strings after @(#) like what(1).
logical,save,public                  :: G_system_on=.false.            ! allow system commands or not on $SYSTEM

logical,public,save                  :: G_condop(0:G_nestl_max)        ! storage to keep track of previous write flags
data G_condop(0:G_nestl_max) /.true.,G_nestl_max*.false./
logical,public                       :: G_dc                           ! flag to determine write flag

logical,public                       :: G_write=.true.                 ! whether non-if/else/endif directives should be processed
logical,public                       :: G_llwrite=.true.               ! whether to write current line or skip it

integer,public                       :: G_comment_count=0
character(len=10),public             :: G_comment_style=' '
character(len=:),allocatable,public  :: G_comment
character(len=:),allocatable,save    :: G_scratch_file
integer,save                         :: G_scratch_lun=-1

character(len=:),allocatable,save    :: G_extract_start
character(len=:),allocatable,save    :: G_extract_stop
character(len=:),allocatable,save    :: G_extract_start0
character(len=:),allocatable,save    :: G_extract_stop0
logical,save                         :: G_extract=.false.
logical,save                         :: G_extract_auto=.true.
logical,save                         :: G_extract_flag=.false.
character(len=:),allocatable,save    :: G_cmd
character(len=:),allocatable,save    :: G_file
character(len=:),allocatable,save    :: G_lang

logical                              :: G_cpp

contains
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
subroutine cond()       !@(#)cond(3f): process conditional directive assumed to be in SOURCE '$verb...'
character(len=G_line_length) :: line                       ! directive line with leading prefix character (default is $) removed
character(len=G_line_length) :: verb                       ! first word of command converted to uppercase
character(len=G_line_length) :: options                    ! everything after first word of command till end of line or !
character(len=G_line_length) :: upopts                     ! directive line with leading prefix removed; uppercase; no spaces
logical,save                 :: eb=.false.
integer,save                 :: noelse=0
integer                      :: verblen
logical                      :: ifound
integer                      :: ierr
character(len=G_var_len)     :: value

   line=adjustl(G_source(2:))                              ! remove leading prefix and spaces from directive line

   if (index(line//' ',G_comment).ne.0) then               ! assume if directive contains G_comment comment is present
                                                           ! LIMITATION: EVEN MESSAGES CANNOT CONTAIN COMMENTS
      line=line(:index(line//' ',G_comment)-1)             ! trim trailing comment from directive
   endif
   if (line(1:1).eq.G_comment)line=''
   if(line(1:4).eq.'@(#)')then
      verblen=5
   else
      verblen=scan(line,' (')
   endif
   if(verblen.eq.0)then
      verblen=len(line)
      verb=line
      options=' '
   else
      verb=line(:verblen-1)
      options=adjustl(line(verblen:))
   endif
   verb=upper(verb)
   upopts=nospace(upper(options))                          ! remove spaces from directive

   if(G_debug.and.G_verbose)then                           ! if processing lines in a logically selected region
      write(stderr,*)'G_SOURCE='//trim(g_source)
      write(stderr,*)'LINE='//trim(line)
      write(stderr,*)'VERB='//trim(verb)
      write(stderr,*)'OPTIONS='//trim(options)
      write(stderr,*)'UPOPTS='//trim(upopts)
      call flushit()
   endif

   ifound=.true.
   if(G_write)then                                                    ! if processing lines in a logically selected region

      if(G_inparcel.and.(VERB.ne.'PARCEL'.and.VERB.ne.'ENDPARCEL') )then
         call write_out(trim(G_source))                               ! write data line
         return
      endif
                                                                      ! process the directive
      ierr=0
      select case(VERB)
      case('  ')                                                          ! entire line is a comment
      case('DEFINE','DEF','LET'); call expr(upopts,value,ierr,def=.true.) ! only process DEFINE if not skipping data lines
      case('REDEFINE','REDEF');   call expr(upopts,value,ierr,def=.true.) ! only process REDEFINE if not skipping data lines
      case('UNDEF','UNDEFINE','DELETE'); call undef(upper(options))       ! only process UNDEF if not skipping data lines

      case('INCLUDE','READ');     call include(options,50+G_iocount)      ! Filenames can be case sensitive
      case('OUTPUT','ENDOUTPUT','OPEN','CLOSE'); call output_cmd(options) ! Filenames can be case sensitive

      case('PARCEL');             call parcel_case(upopts)
      case('ENDPARCEL');          call parcel_case('')
      case('POST','CALL','DO');   call prepost(upper(options))

      case('BLOCK');              call document(options)
      case('ENDBLOCK');           call document(' ')

      case('SET','REPLACE','MACRO');      call set(options)
      case('UNSET');              call unset(upper(options))              ! only process UNSET if not skipping data lines

      case('IDENT','@(#)');       call ident(options)
      case('MESSAGE','WARNING');  call write_err(unquote(options))        ! trustingly trim MESSAGE from directive
      case('SHOW') ;              call show_state(upper(options),msg='')
      CASE('HELP','CRIB');        call crib_help(stderr)

      case('STOP');               call stop(options)
      case('QUIT');               call stop('0 '//options)
      case('ERROR');              call stop('1 '//options)

      CASE('GET_ARGUMENTS');      call write_get_arguments()

      case('DEBUG');            G_debug=.not.G_debug      ;write(stderr,*)'DEBUG:',G_debug
      case('VERBOSE');          G_verbose=.not.G_verbose  ;write(stderr,*)'VERBOSE:',G_verbose

      case('IMPORT','GET_ENVIRONMENT_VARIABLE');           call import(options)
      case('SYSTEM','EXECUTE_COMMAND_LINE');               call exe()

      case default
         ifound=.false.
      end select
      if(ierr.ne.0) call stop_prep(001,'expression invalid:',trim(G_source))
   endif

   select case(VERB)                                                  ! process logical flow control even if G_write is false
   case('ELSE','ELSEIF','ELIF');  call else(verb,upopts,noelse,eb)
   case('ENDIF','FI');            call endif(noelse,eb)
   case('IF');                    call if(upopts,noelse,eb)
   case('IFDEF','IFNDEF');        call def(verb,upopts,noelse,eb)
   case default
      if(.not.ifound)then
         call stop_prep(002,'unknown compiler directive:', '['//trim(verb)//']: '//trim(G_SOURCE) )
      endif
   end select

end subroutine cond
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
subroutine exe()                              !@(#)exe(3f): Execute the command line specified by the string COMMAND.
character(len=G_line_length)  :: command      ! directive line with leading prefix and directive name removed
character(len=G_line_length)  :: defineme     ! scratch string for writing a DEFINE directive in to return command status
integer                       :: icmd=0
integer                       :: cstat
integer                       :: ierr
character(len=256)            :: sstat
character(len=G_var_len)      :: value

   if(G_system_on)then
      command=adjustl(G_source(2:))                                                 ! remove $ from directive
      command=command(7:)                                                           ! trim SYSTEM from directive
      if(G_verbose)then
         call write_err('+ '//command)
      endif

      ! not returning command status on all platforms
      call execute_command_line (command, exitstat=icmd,cmdstat=cstat,cmdmsg=sstat) ! execute system command

      if(icmd.ne.0)then                                                             ! if system command failed exit program
         call stop_prep(003,'system command failed:',v2s(icmd))
      endif
   else
      call stop_prep(004,'system directive encountered but not enabled:',trim(G_SOURCE))
   endif

   write(defineme,'("CMD_STATUS=",i8)')icmd
   defineme=nospace(defineme)
   call expr(defineme,value,ierr)    ! only process DEFINE if not skipping data lines
   if(ierr.ne.0) call stop_prep(005,'expression invalid:',trim(G_source))

end subroutine exe
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
subroutine write_get_arguments()                !@(#)write_get_arguments(3f): write block for processing M_CLI command line parsing
integer :: i
character(len=132),parameter :: text(*)=[character(len=132) :: &
"function get_arguments()"                                                                              ,&
"character(len=255)           :: message ! use for I/O error messages"                                  ,&
"character(len=:),allocatable :: string  ! stores command line argument"                                ,&
"integer                      :: get_arguments"                                                         ,&
"integer :: command_line_length"                                                                        ,&
"   call get_command(length=command_line_length)   ! get length needed to hold command"                 ,&
"   allocate(character(len=command_line_length) :: string)"                                             ,&
"   call get_command(string)"                                                                           ,&
"   ! trim off command name and get command line arguments"                                             ,&
"   string=adjustl(string)//' '                    ! assuming command verb does not have spaces in it"  ,&
"   string=string(index(string,' '):)"                                                                  ,&
"   string='&cmd '//string//' /'                   ! add namelist prefix and terminator"                ,&
"   read(string,nml=cmd,iostat=get_arguments,iomsg=message) ! internal read of namelist"                ,&
"   if(get_arguments.ne.0)then"                                                                         ,&
"      write(*,'(''ERROR:'',i0,1x,a)')get_arguments, trim(message)"                                       ,&
"      write(*,*)'COMMAND OPTIONS ARE'"                                                                 ,&
"      write(*,nml=cmd)"                                                                                ,&
"      stop 1"                                                                                          ,&
"   endif"                                                                                              ,&
"end function get_arguments"                                                                            ,&
"" ]
do i=1,size(text)
   write(G_iout,'(a)')trim(text(i))
enddo
end subroutine write_get_arguments
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
subroutine output_cmd(opts)                                  !@(#)output_cmd(3f): process $OUTPUT directive
character(len=*)              :: opts
character(len=G_line_length)  :: filename                     ! filename on $OUTPUT command
character(len=20)             :: position
integer                       :: ios
   call dissect2('output','-oo --append .false.',opts)     ! parse options and inline comment on input line

   if(size(unnamed).gt.0.and.opts.ne.'')then
      filename=unnamed(1)
   else
      filename=' '
   endif

   select case(filename)
   case('@')
      G_iout=stdout
   case(' ')                                               ! reset back to initial output file
      if(G_iout.ne.stdout.and.G_iout.ne.G_iout_init)then   ! do not close current output if it is stdout or default output file
         close(G_iout,iostat=ios)
      endif
      G_iout=G_iout_init
   case default
      G_iout=61
      close(G_iout,iostat=ios)
      if(lget('append'))then; position='append'; else; position='asis'; endif
      open(unit=G_iout,file=filename,iostat=ios,action='write',position=position)
      if(ios.ne.0)then
         call stop_prep(006,'failed to open output file:',trim(filename))
      endif
   end select

   if(G_verbose)then
      call write_err( '+ output file changed to: '//trim(filename) )
   endif

end subroutine OUTPUT_CMD
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
subroutine parcel_case(opts)                          !@(#)parcel_case(3f): process $PARCEL directive
character(len=*)              :: opts
character(len=G_line_length)  :: name                 ! name on $PARCEL command
integer                       :: ios
integer                       :: lun
character(len=256)            :: message
   if(opts.eq.'')then
      G_inparcel=.false.
      G_iout=G_iout_init
   else
      call dissect2('parcel','-oo ',opts)             ! parse options and inline comment on input line
      if(size(unnamed).gt.0.and.opts.ne.'')then
         name=unnamed(1)
      else
         name=''
      endif
      open(newunit=lun,iostat=ios,action='readwrite',status='scratch',iomsg=message)
      if(ios.ne.0)then
         call stop_prep(007,'failed to open parcel scratch file:',trim(name)//' '//trim(message))
      else
         G_parcelcount=G_parcelcount+1
         G_parcel_dictionary(G_parcelcount)%name=name
         G_parcel_dictionary(G_parcelcount)%unit_number=lun
         G_inparcel=.true.
         G_iout=lun
      endif
   endif
end subroutine parcel_case
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
subroutine prepost(opts)                          !@(#)prepost(3f): process $POST directive
character(len=*)                          :: opts
character(len=:),allocatable              :: list
character(len=:),allocatable              :: names(:)        ! names on $POST command
character(len=:),allocatable              :: fors(:)         ! names on $POST --for
integer                                   :: i
integer                                   :: j,jsz
   call dissect2('PARCEL',' --FOR " " ',opts)                 ! parse options and inline comment on input line

   list=''
   if(size(unnamed).eq.0.and.opts.ne.'')then
      list=' '
   else
      do i=1,size(unnamed)
         list=list//' '//unnamed(i)
      enddo
   endif
   call split(list,names,delimiters=' ,')                    ! parse string to an array parsing on delimiters
   list=SGET('FOR')
   call split(list,fors,delimiters=' ,')                     ! parse string to an array parsing on delimiters
   jsz=size(fors)
   do i=size(names),1,-1
      if(jsz.eq.0)then
         call post(names(i))
      else
         do j=jsz,1,-1
            call post(names(i))
            call post(fors(j))
         enddo
      endif
   enddo
end subroutine prepost
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
subroutine post(parcel_name)  !@(#)post(3f): switch to scratch file defined by PARCEL
implicit none
character(len=*),intent(in)  :: parcel_name
integer                      :: ifound
integer                      :: ios
character(len=4096)          :: message
integer                      :: i
   ifound=-1
   do i=1,G_parcelcount
      if(G_parcel_dictionary(i)%name.eq.parcel_name)then
         ifound=G_parcel_dictionary(i)%unit_number
         exit
      endif
   enddo
   if(ifound.eq.-1)then
      call stop_prep(028,'parcel name not defined for',' PARCEL:'//trim(G_source))
   else
      inquire(unit=ifound,iostat=ios)
      rewind(unit=ifound,iostat=ios,iomsg=message)
      if(ios.ne.0)then
         call stop_prep(029,'error rewinding',' PARCEL:'//trim(G_source)//':'//trim(message))
      endif

      if(G_debug)then
         do
            read(ifound,'(a)',iostat=ios)message
            if(ios.ne.0)exit
            write(stdout,*)'>>>'//trim(message)
         enddo
         rewind(unit=ifound,iostat=ios,iomsg=message)
      endif

      G_iocount=G_iocount+1
      if(G_iocount.gt.size(G_file_dictionary))then
         call stop_prep(030,'input file nesting too deep:',trim(G_source))
      endif
      G_file_dictionary(G_iocount)%unit_number=ifound
      G_file_dictionary(G_iocount)%filename=parcel_name
      G_file_dictionary(G_iocount)%line_number=0
   endif
end subroutine post
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
subroutine ident(opts)                              !@(#)ident(3f): process $IDENT directive
character(len=*)              :: opts
character(len=G_line_length)  :: lang               ! language on $IDENT command
character(len=:),allocatable  :: text
integer,save                  :: ident_count=1
integer                       :: i

   call dissect2('ident',' --language fortran',opts)  ! parse options and inline comment on input line

   text=''
   do i=1,size(unnamed)
      text=text//' '//trim(unnamed(i))
   enddo

   lang=SGET('language')

   select case(lang)
   case('fortran')    !x! should make look for characters not allowed in metadata, continue over multiple lines, ...
      select case(len(text))
      case(:89)
         if(G_ident)then
            write(G_iout,'("character(len=*),parameter::ident_",i0,"=""@(#)",a,''"'')')ident_count,text
         else
            write(G_iout,'("! ident_",i0,"=""@(#)",a,''"'')')ident_count,text
         endif
         ident_count=ident_count+1
      case(90:126)
         if(G_ident)then
            write(G_iout,'("character(len=*),parameter::ident_",i0,"=""&")')ident_count
            write(G_iout,'(''&@(#)'',a,''"'')')text
         else
            write(G_iout,'("! ident_",i0,"=""@(#)",a,''"'')')ident_count,text
         endif
         ident_count=ident_count+1
      case default
         call stop_prep(008,'description too long:',trim(G_SOURCE))
      end select
   case('c')
         write(G_iout,'(a)')'#ident "@(#)'//text//'"'
   case default
         call stop_prep(009,'language unknown for',' $IDENT'//trim(G_SOURCE))
   end select

end subroutine ident
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
function getdate(name) result(s)      !@(#) getdate(3f): Function to write date and time into returned string in different styles
character(len=*),intent(in),optional :: name

character(len=*),parameter           :: month='JanFebMarAprMayJunJulAugSepOctNovDec'
character(len=*),parameter           :: fmt = '(I2.2,A1,I2.2,I3,1X,A3,1x,I4)'
character(len=*),parameter           :: cdate = '(A3,1X,I2.2,1X,I4.4)'
character(len=:),allocatable         :: s
character(len=80)                    :: line
integer                              :: v(8)
character(len=10)                    :: name_

   call date_and_time(values=v)
   name_='prep'
   if(present(name))name_=name
   select case(lower(name_))
   case('prep') ; write(line,fmt) v(5), ':', v(6), v(3), month(3*v(2)-2:3*v(2)), v(1) ! PREP_DATE="00:39  5 Nov 2013"
   case('date') ; write(line,'(i4.4,"-",i2.2,"-",i2.2)') v(1),v(2),v(3)
   case('cdate'); write(line,cdate) month(3*v(2)-2:3*v(2)), v(3), v(1)
   case('long') ; write(line,'(i4.4,"-",i2.2,"-",i2.2," ",i2.2,":",i2.2,":",i2.2," UTC",sp,i0)') v(1),v(2),v(3),v(5),v(6),v(7),v(4)
   case('time') ; write(line,'(i2.2,":",i2.2,":",i2.2)') v(5),v(6),v(7)
   case default ; write(line,'(i4.4,"-",i2.2,"-",i2.2," ",i2.2,":",i2.2,":",i2.2," UTC",sp,i0)') v(1),v(2),v(3),v(5),v(6),v(7),v(4)
   end select
   s=trim(line)
end function getdate
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
subroutine check_name(line)
! determine if a string is a valid Fortran name ignoring trailing spaces (but not leading spaces)
character(len=*),parameter   :: dig='0123456789'
character(len=*),parameter   :: lower='abcdefghijklmnopqrstuvwxyz'
character(len=*),parameter   :: upper='ABCDEFGHIJKLMNOPQRSTUVWXYZ'
character(len=*),parameter   :: allowed=upper//lower//dig//'_'
character(len=*),intent(in)  :: line
character(len=:),allocatable :: name
logical                      :: lout
   name=trim(line)
   if(len(name).ne.0)then
      lout = .true.                         &
      & .and. verify(name,allowed) == 0     &
      & .and. len(name) <= 63
   else
      call stop_prep(010,"null variable name:",trim(G_source))
      lout = .false.
   endif
   if(.not.lout)then
     call stop_prep(011,'name contains unallowed character(or general syntax error):',trim(G_source))
   endif
end subroutine check_name
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
subroutine unset(opts)                                     !@(#)unset(3f): process UNSET directive
character(len=*)             :: opts                       ! directive with no spaces, leading prefix removed, and all uppercase
character(len=:),allocatable :: names(:)
integer                      :: i
integer                      :: k
integer                      :: ibug

   ! REMOVE VARIABLE IF FOUND IN VARIABLE NAME DICTIONARY
   ! allow basic globbing where * is any string and ? is any character
   if (len_trim(opts).eq.0) then                           ! if no variable name
      call stop_prep(012,'missing targets for ',' $UNSET:'//trim(G_source))
   endif
   call split(opts,names,delimiters=' ;,')

   do k=1,size(names)
      if(G_verbose)then
         call write_err('+ $UNSET '//names(k))
      endif
      ! added UBOUND call because GFORTRAN returns size of 1 when undefined, OK with ifort and nvfortran
      ibug=minval([size(macro%key),ubound(macro%key)])   ! print variable dictionary
      do i=ibug,1,-1                           ! find defined variable to be undefined by searching dictionary
         if (glob(trim(macro%key(i)),trim(names(k))))then   ! found the requested variable name
            call  macro%del(macro%key(i))
         endif
      enddo
   enddo
end subroutine unset
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
subroutine if(opts,noelse,eb)                                 !@(#)if(3f): process IF and ELSEIF directives
character(len=*),intent(in)  :: opts
integer,intent(out)          :: noelse
logical                      :: eb
character(len=G_var_len)     :: value
integer                      :: ios
integer                      :: ierr
integer                      :: ithen
character(len=G_line_length) :: expression

   noelse=0
   G_write=.false.

   G_nestl=G_nestl+1                                          ! increment IF nest level
   if (G_nestl.gt.G_nestl_max) then
      call stop_prep(013,'"$IF" block nesting too deep, limited to '//v2s(G_nestl_max)//' levels,',trim(G_source))
   endif

   expression=opts
   ithen=len_trim(opts)                                       ! trim off ")THEN"
   if(ithen.gt.5)then
      if(expression(ithen-4:ithen).eq.')THEN'.and.expression(1:1).eq.'(')then
         expression=expression(2:ithen-5)
      endif
   endif

   if(G_debug.and.G_verbose) write(stderr,*)'*if* TOP:EXPRESSION:'//trim(expression)

   value=''
   call expr(expression,value,ierr,logical=.true.)
   if(ierr.eq.0)then
      read(value,'(l7)',iostat=ios)G_dc
   else
      G_dc=.false.
      call stop_prep(014,'"$IF" expression invalid:',trim(G_source))
   endif

   if (.not.G_dc.or..not.G_condop(G_nestl-1).or.eb)then
      if(G_debug.and.G_verbose) write(stderr,*)'*if* PREVIOUS:'
      return                                               ! check to make sure previous IF was true
   endif
   G_condop(G_nestl)=.true.
   G_write=G_condop(G_nestl)
   if(G_debug.and.G_verbose) write(stderr,*)'*if* BOT:'

end subroutine if
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
subroutine def(verb,opts,noelse,eb)                  !@(#)def(3f): process IFDEF and IFNDEF directives
character(len=*),intent(in)  :: verb
character(len=*),intent(in)  :: opts
integer,intent(out)          :: noelse
logical                      :: eb
character(len=G_var_len)     :: name
character(len=G_var_len)     :: value
character(len=:),allocatable :: varvalue

   noelse=0
   G_write=.false.
   G_nestl=G_nestl+1                                 ! increment IF nest level
   if (G_nestl.gt.G_nestl_max) then
      call stop_prep(015,'block nesting too deep, limited to '//v2s(G_nestl_max)//' levels in:',' $IF'//trim(G_source))
   endif
   call check_name(opts)                             ! check that opts contains only a legitimate variable name
   value=opts                                        ! set VALUE to variable name
   G_dc=.true.                                       ! initialize

   name=table%get(value)
   if (name.eq.'') then                              ! if failed to find variable name
      G_dc=.false.
   endif
   if((.not.G_noenv).and.(.not.G_dc))then            ! if not found in variable dictionary check environment variables if allowed
      varvalue=get_env(value)
      if(len_trim(varvalue).ne.0)then
         G_dc=.true.
      endif
   endif
   if(verb.eq.'IFNDEF')then
      G_dc=.not.G_dc
   endif
   if (.not.G_dc.or..not.G_condop(G_nestl-1).or.eb)then
      return                                               ! check to make sure previous IFDEF or IFNDEF was true
   endif
   G_condop(G_nestl)=.true.
   G_write=G_condop(G_nestl)
end subroutine def
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
subroutine else(verb,opts,noelse,eb)                       !@(#)else(3f): process else and elseif
character(len=*)              :: verb
character(len=*)              :: opts
integer                       :: noelse
logical                       :: eb
character(len=G_line_length)  :: expression
integer                       :: ithen

   expression=opts
   ithen=len_trim(opts)  ! trim off ")THEN"
   if(ithen.gt.5)then
      if(expression(ithen-4:ithen).eq.')THEN'.and.expression(1:1).eq.'(')then
         expression=expression(2:ithen-5)
      endif
   endif

   if(noelse.eq.1.or.G_nestl.eq.0) then                    ! test for else instead of elseif
      call stop_prep(016,'misplaced $ELSE or $ELSEIF directive:',trim(G_SOURCE))
      return
   endif
   if(verb.eq.'ELSE')then
      noelse=1
   endif
   if(.not.G_condop(G_nestl-1))return                      ! if was true so ignore else
   eb=.false.
   if(G_condop(G_nestl)) then
       eb=.true.
       G_write=.false.
   elseif(len_trim(expression).ne.0)then                   ! elseif detected
     G_nestl=G_nestl-1                                     ! decrease if level because it will be incremented in subroutine if
     call if(expression,noelse,eb)
   else                                                    ! else detected
     G_condop(G_nestl)=.true.
     G_write=.true.
   endif

end subroutine else
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
subroutine endif(noelse,eb)                             !@(#)endif(3f): process ENDIF directive
integer,intent(out)           :: noelse
logical,intent(out)           :: eb

   ! if no ELSE or ELSEIF present insert ELSE to simplify logic
   if(noelse.eq.0)then
      call else('ELSE',' ',noelse,eb)
   endif

   G_nestl=G_nestl-1                                           ! decrease if level

   if(G_nestl.lt.0)then
      call stop_prep(017,"misplaced $ENDIF directive:",trim(G_source))
   endif

   noelse=0                                                    ! reset else level
   eb=.not.G_condop(G_nestl+1)
   G_write=.not.eb
   G_condop(G_nestl+1)=.false.

   if(G_nestl.eq.0)then
      G_write=.true.
      eb=.false.
   endif

end subroutine endif
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
logical function true_or_false(line,ipos1,ipos2) !@(#)true_or_false(3f): convert variable name or .TRUE./.FALSE. to a logical value
character(len=G_line_length),intent(in) :: line              ! line containing string to interpret as a logical value
integer,intent(in)                      :: ipos1             ! starting column of substring in LINE
integer,intent(in)                      :: ipos2             ! ending column of substring in LINE

character(len=G_var_len)                :: value
character(len=G_var_len)                :: substring
integer                                 :: ios               ! error code returned by an internal READ

   true_or_false=.false.                                     ! initialize return value
   substring=line(ipos1:ipos2)                               ! extract substring from LINE to interpret

   select case (substring)                                   ! if string is not a logical string assume it is a variable name
   case ('.FALSE.','.F.')
      true_or_false=.false.                                  ! set appropriate return value
   case ('.TRUE.','.T.')
      true_or_false=.true.                                   ! set appropriate return value
   case default                                              ! assume this is a variable name, find name in dictionary
      value=table%get(substring)

      if (value.eq.'') then                                  ! if not a defined variable name stop program
         call stop_prep(018,'undefined variable.',' DIRECTIVE='//trim(G_source)//' VARIABLE='//trim(substring))
      else
         read(value,'(l4)',iostat=ios) true_or_false         ! try to read a logical from the value for the variable name
         if(ios.ne.0)then                                    ! not successful in reading string as a logical value
            call stop_prep(019,'constant logical expression required.',trim(G_source))
         endif
      endif

   end select

end function true_or_false
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
subroutine document(opts)                    !@(#)document(3f): process BLOCK command to start or stop special processing
character(len=*),intent(in)  :: opts
integer                      :: ierr
integer                      :: ios
character(len=G_line_length) :: options                 ! everything after first word of command till end of line or !
character(len=:),allocatable :: name

! CHECK COMMAND SYNTAX
   if(G_outtype.eq.'help')then  ! if in 'help' mode wrap up the routine
      write(G_iout,'(a)')"'']"
      write(G_iout,'(a)')"   WRITE(*,'(a)')(trim(help_text(i)),i=1,size(help_text))"
      write(G_iout,'(a)')"   stop ! if --help was specified, stop"
      write(G_iout,'(a)')"endif"
      write(G_iout,'(a)')"end subroutine help_usage"
      !x!write(G_iout,'("!",a)')repeat('-',131)
   elseif(G_outtype.eq.'variable')then     ! if in 'variable' mode wrap up the variable
      write(G_iout,'(a)')"'']"
   elseif(G_outtype.eq.'system')then
         close(unit=G_scratch_lun,iostat=ios)
         call execute_command_line( trim(G_cmd)//' < '//G_scratch_file//' > '//G_scratch_file//'.out')
         ierr=filedelete(G_scratch_file)
         options=G_scratch_file//'.out'
         call include(options,50+G_iocount)    ! Filenames can be case sensitive
   elseif(G_outtype.eq.'version')then  ! if in 'version' mode wrap up the routine
      write(G_iout,'("''@(#)COMPILED:       ",a,"'',&")') getdate('long')//'>'
      write(G_iout,'(a)')"'']"
      write(G_iout,'(a)')"   WRITE(*,'(a)')(trim(help_text(i)(5:len_trim(help_text(i))-1)),i=1,size(help_text))"
      !x!write(G_iout,'(a)')'   write(*,*)"COMPILER VERSION=",COMPILER_VERSION()'
      !x!write(G_iout,'(a)')'   write(*,*)"COMPILER OPTIONS=",COMPILER_OPTIONS()'
      write(G_iout,'(a)')"   stop ! if --version was specified, stop"
      write(G_iout,'(a)')"endif"
      write(G_iout,'(a)')"end subroutine help_version"
      !x!write(G_iout,'("!",a)')repeat('-',131)
   endif

   ! parse options on input line
   call dissect2('block','--file --cmd sh --varname textblock --style "#N#" --append .false.',opts)
   ! if a previous command has opened a --file FILENAME flush it, because a new one is being opened or this is an END command
   ! and if a --file FILENAME has been selected open it
   call print_comment_block()

   ! now can start new section
   G_MAN=''
   if(SGET('file').ne.'')then
      G_MAN_FILE=SGET('file')
      G_MAN_COLLECT=.true.
   else
      G_MAN_FILE=''
      G_MAN_COLLECT=.false.
   endif

   G_MAN_PRINT=.false.

   if(LGET('append'))then
      G_MAN_FILE_POSITION='APPEND'
   else
      G_MAN_FILE_POSITION='ASIS'
   endif

   if(size(unnamed).gt.0.and.opts.ne.'')then
      name=upper(unnamed(1))
   else
      name=' '
   endif

   select case(name)

   case('COMMENT')
      G_outtype='comment'
      G_MAN_PRINT=.true.
      G_MAN_COLLECT=.true.
      if(SGET('style').ne.'#N#')then
         G_comment_style=lower(SGET('style'))             ! allow formatting comments for particular post-processors
      endif
   case('NULL')
      G_outtype='null'

   case('SET','REPLACE')
      G_outtype='set'
      G_MAN_PRINT=.false.
      G_MAN_COLLECT=.false.
   case('DEFINE')
      G_outtype='define'
      G_MAN_PRINT=.false.
      G_MAN_COLLECT=.false.
   case('REDEFINE')
      G_outtype='redefine'
      G_MAN_PRINT=.false.
      G_MAN_COLLECT=.false.
   case('MESSAGE')
      G_outtype='message'
      G_MAN_PRINT=.false.
      G_MAN_COLLECT=.false.

   case('SHELL','SYSTEM')
      G_outtype='system'
      G_MAN_PRINT=.false.
      G_MAN_COLLECT=.false.
      if(G_system_on)then                             ! if allowing commands to be executed
         flush(unit=G_iout,iostat=ios)
         !!G_scratch_file=scratch('prep_scratch.'))
         G_scratch_file=trim(uniq(get_tmp()//'prep_scratch.'))  !! THIS HAS TO BE A UNIQUE NAME -- IMPROVE THIS
         G_scratch_lun=fileopen(G_scratch_file,'rw',ierr)
         if(ierr.lt.0)then
            call stop_prep(020,'filter command failed to open process:',trim(G_SOURCE))
         endif
      else
         call stop_prep(021,'filter command $BLOCK encountered but system commands not enabled:',trim(G_SOURCE))
      endif

   case('VARIABLE')
      G_outtype='variable'
      write(G_iout,'(a)')trim(SGET('varname'))//'=[ CHARACTER(LEN=128) :: &'
      G_MAN_PRINT=.false.

   case('HELP')
      G_outtype='help'
      write(G_iout,'(a)')'subroutine help_usage(l_help)'
      write(G_iout,'(a)')'implicit none'
      write(G_iout,'(a)')'character(len=*),parameter     :: ident="@(#)help_usage(3f): prints help information"'
      write(G_iout,'(a)')'logical,intent(in)             :: l_help'
      !write(G_iout,'(a)')'character(len=128),allocatable :: help_text(:)'
      write(G_iout,'(a)')'character(len=:),allocatable :: help_text(:)'
      write(G_iout,'(a)')'integer                        :: i'
      write(G_iout,'(a)')'logical                        :: stopit=.false.'
      write(G_iout,'(a)')'stopit=.false.'
      write(G_iout,'(a)')'if(l_help)then'
! NOTE: Without the type specification this constructor would have to specify all of the constants with the same character length.
      write(G_iout,'(a)')'help_text=[ CHARACTER(LEN=128) :: &'

         select case(G_comment_style)  ! duplicate help text as a comment for some code documentation utilities
         case('doxygen')               ! convert plain text to doxygen comment blocks with some automatic markdown highlights
            G_MAN_PRINT=.true.
         case('fort')                  ! convert plain text to ford  comment blocks with some automatic markdown highlights
            G_MAN_PRINT=.true.
         case('none')                  ! do not print comment lines from block
            G_MAN_PRINT=.false.
         case default
         end select

   case('VERSION')
      G_outtype='version'
      write(G_iout,'(a)')'subroutine help_version(l_version)'
      write(G_iout,'(a)')'implicit none'
      write(G_iout,'(a)')'character(len=*),parameter     :: ident="@(#)help_version(3f): prints version information"'
      write(G_iout,'(a)')'logical,intent(in)             :: l_version'
      !write(G_iout,'(a)')'character(len=128),allocatable :: help_text(:)'
      write(G_iout,'(a)')'character(len=:),allocatable   :: help_text(:)'
      write(G_iout,'(a)')'integer                        :: i'
      write(G_iout,'(a)')'logical                        :: stopit=.false.'
      write(G_iout,'(a)')'stopit=.false.'
      write(G_iout,'(a)')'if(l_version)then'
! NOTE: Without the type specification this constructor would have to specify all of the constants with the same character length.
      write(G_iout,'(a)')'help_text=[ CHARACTER(LEN=128) :: &'

   case('WRITE')
      G_outtype='write'
   case(' ','END')
      G_outtype='asis'
      G_MAN_COLLECT=.false.
   case('ASIS')
      G_outtype='asis'
   case default
      if(size(unnamed).gt.0)then
         call stop_prep(022,'unexpected "BLOCK" option. found:"',trim(unnamed(1))//'" in '//trim(G_source) )
      else
         call stop_prep(022,'unexpected "BLOCK" option. found:"',' " in '//trim(G_source) )
      endif
   end select

   G_comment_count=0
end subroutine document
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
subroutine print_comment_block() !@(#)print_comment_block(3f): format comment block to file in document directory and output
character(len=:),allocatable :: filename
character(len=:),allocatable :: varvalue
integer                      :: ios,iend,lun

   if(.not.allocated(G_MAN))then
      return
   endif

   varvalue=get_env('PREP_DOCUMENT_DIR')

   if(varvalue.ne.''.and.G_MAN.ne.''.and.G_MAN_FILE.ne.' ')then ! if $BLOCK --file FILE is present generate file in directory/doc

      iend=len_trim(varvalue)
      if(varvalue(iend:iend).ne.'/')then
         filename=trim(varvalue)//'/doc/'//trim(G_MAN_FILE)
      else
         filename=trim(varvalue)//'doc/'//trim(G_MAN_FILE)
      endif

      open(newunit=lun,file=filename,iostat=ios,action='write',position=G_MAN_FILE_POSITION)

      if(ios.ne.0)then
         call stop_prep(023,'failed to open document output file:',trim(filename))
      else
         if(len(G_MAN).gt.1)then                   ! the way the string is built it starts with a newline
            write(lun,'(a)',iostat=ios) G_MAN(2:)
         else
            write(lun,'(a)',iostat=ios) G_MAN
         endif
         if(ios.ne.0)then
            call write_err('G_MAN='//G_MAN)
            call stop_prep(024,'failed to write output file:',trim(filename))
         endif
      endif

      close(unit=lun,iostat=ios)

   endif

   ! now if $BLOCK COMMENT print comment block
   if(G_MAN_PRINT)then
      call format_G_MAN()
   endif

end subroutine print_comment_block
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
subroutine format_g_man()
character(len=:),allocatable   :: array1(:)   ! output array of tokens
character(len=:),allocatable   :: array(:)    ! output array of tokens
integer                        :: ios
integer                        :: i

   ALL: block
      WRITEIT: block

         select case(G_comment_style)

         case('doxygen')                 ! convert plain text to doxygen comment blocks with some automatic markdown highlights
            if(len(G_MAN).gt.1)then      ! the way the string is built it starts with a newline

               CALL split(G_MAN,array1,delimiters=new_line('N'),nulls='return') ! parse string to an array parsing on delimiters
               if(allocated(array))deallocate(array)
               allocate(character(len=len(array1)+6) :: array(size(array1)))  ! make room for !! and ##
               array(:)=array1
               deallocate(array1)

               do i=1,size(array)        ! lines starting with a letter and all uppercase letters is prefixed with "##"
                  if( upper(array(i)).eq.array(i) .and. isalpha(array(i)(1:1)).and.lower(array(i)).ne.array(i))then
                     array(i)='##'//trim(array(i))
                     select case(array(i))
                     case('##SYNOPSIS','##EXAMPLES','##EXAMPLE')
                        array(i)=trim(array(i))//new_line('N')//'!'//'!'
                     endselect
                  else
                     array(i)=' '//trim(array(i))
                  endif
               enddo

               if(size(array).gt.0)then
                  write(G_iout,'("!",">",a)')trim(array(1))
               endif

               do i=2,size(array)
                  write(G_iout,'("!","!",a)',iostat=ios)trim(array(i))
                  if(ios.ne.0)exit WRITEIT
               enddo

            endif
            !x!write(G_iout,'("!",131("="))')

         case('ford')                    ! convert plain text to doxygen comment blocks with some automatic markdown highlights
            if(len(G_MAN).gt.1)then      ! the way the string is built it starts with a newline
               CALL split(G_MAN,array1,delimiters=new_line('N'),nulls='return') ! parse string to an array parsing on delimiters
               !======================================================================================== nvfortran bug
               ! array=[character(len=(len(array1)+6)) :: array1] !! pad with trailing spaces

               if(allocated(array))deallocate(array)
               allocate(character(len=len(array1)+6) :: array(size(array1)))  ! make room for !! and ##
               array(:)=array1
               !========================================================================================
               deallocate(array1)

               do i=1,size(array)        ! lines starting with a letter and all uppercase letters is prefixed with "##"
                  if( upper(array(i)).eq.array(i) .and. isalpha(array(i)(1:1)).and.lower(array(i)).ne.array(i))then
                     array(i)='## '//trim(array(i))
                     select case(array(i))
                     case('## SYNOPSIS','## EXAMPLES','## EXAMPLE')
                        array(i)=trim(array(i))//new_line('N')//'!>'
                     endselect
                  else
                     array(i)=' '//trim(array(i))
                  endif
               enddo

               if(size(array).gt.0)then
                  write(G_iout,'("!>",a)')trim(array(1))
               endif

               do i=2,size(array)
                  write(G_iout,'("!>",a)',iostat=ios)trim(array(i))
                  if(ios.ne.0)exit WRITEIT
               enddo

            endif
            !x!write(G_iout,'("!>",131("="))')

         case('none')                    ! ignore comment block

         case default
            if(len(G_MAN).gt.1)then                       ! the way the string is built it starts with a newline
               G_MAN=G_MAN(2:)//repeat(' ',2*len(G_MAN))  ! make sure the white-space exists
               call substitute(G_MAN,NEW_LINE('A'),NEW_LINE('A')//'! ')
               G_MAN='! '//trim(G_MAN)
            endif
            write(G_iout,'(a)',iostat=ios) G_MAN
            if(ios.ne.0)exit WRITEIT
            !x!write(G_iout,'("!",131("="))')
         end select

         exit ALL
      endblock WRITEIT
      call write_err('G_MAN='//G_MAN)
      call stop_prep(025,'failed to write comment block','')
   endblock ALL
end subroutine format_g_man
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
subroutine show_state(list,msg)                        !@(#)debug(3f): process $SHOW command or state output when errors occur
character(len=*),intent(in),optional :: list
character(len=*),intent(in) :: msg
integer                     :: i
integer                     :: j
character(len=:),allocatable   :: array(:)    ! output array of tokens
character(len=*),parameter  :: fmt='(*(g0,1x))'
integer                     :: ibugm
integer                     :: ibugt
   if(present(list))then
      if(list.ne.'')then
         ! print variables:
         CALL split(list,array,delimiters=' ;,') ! parse string to an array parsing on delimiters
         ibugm=minval([size(macro%key),ubound(macro%key)])
         ibugt=minval([size(table%key),ubound(table%key)])
         do j=1,size(array)
            do i=1,ibugm                     ! size(macro%key) bug in gfortran
               if(glob(trim(macro%key(i)),trim(array(j))))then ! write variable and corresponding value
                  write(G_iout,fmt)"! MACRO: ",trim(macro%key(i)),' = ',adjustl(macro%value(i)(:macro%count(i)))
               endif
            enddo
            do i=1,ibugt                     ! size(table%key) bug in gfortran
               if(glob(trim(table%key(i)),trim(array(j))))then ! write variable and corresponding value
                  write(G_iout,fmt)"! VARIABLE: ",trim(table%key(i)),' = ',adjustl(table%value(i)(:table%count(i)))
               endif
            enddo
         enddo
         return
      endif
   endif
   write(G_iout,'(a)')'!==============================================================================='
   write(G_iout,'(a)')'! '//trim(msg)

   write(G_iout,'(a)')'! Current state of prep(1):('//getdate()//')'
   write(G_iout,'("! Total lines read ............... ",i0)')G_io_total_lines     ! write number of lines read
   write(G_iout,'("! Conditional nesting level....... ",i0)')G_nestl              ! write nesting level
   write(G_iout,'("! G_WRITE (general processing).... ",l1)')G_write              ! non-if/else/endif directives processed
   write(G_iout,'("! G_LLWRITE (write input lines)... ",l1)')G_llwrite            ! non-if/else/endif directives processed

   call write_arguments()

   write(G_iout,'(a)')'! Open files:'
   write(G_iout,'(a)')'!    unit ! line number ! filename'
   do i=1,G_iocount                                                               ! print file dictionary
      ! write table of files
      write(G_iout,'("!    ",i4," ! ",i11," ! ",a)') &
      &  G_file_dictionary(i)%unit_number,    &
      &  G_file_dictionary(i)%line_number,    &
      &  trim(G_file_dictionary(i)%filename )
   enddo

   write(G_iout,'(a)')'! INCLUDE directories:'
   do i=1,G_inc_count
      write(G_iout,'("!    ",a)') trim(G_inc_files(i))
   enddo

   ibugt=minval([size(table%key),ubound(table%key)])   ! print variable dictionary
   if(ibugt.gt.0)then
      write(G_iout,fmt)'! Variables:(There are',ibugt,'variables defined)'
      do i=1,ibugt                    ! size(table%key) bug in gfortran
         write(G_iout,fmt)"!    $DEFINE",trim(table%key(i)),' = ',adjustl(table%value(i)(:table%count(i)) )
      enddo
   endif

   if(G_parcelcount.gt.0)write(G_iout,'(a)')'! Parcels:'
   do i=1,G_parcelcount
      write(G_iout,fmt) '!   ',trim(G_parcel_dictionary(i)%name)
   enddo

   ibugm=minval([size(macro%key),ubound(macro%key)])   ! print variable dictionary
   if(ibugm.gt.0)then ! size(macro%key).gt.0)then
      write(G_iout,fmt)'! Macros:(There are',ibugm,'keywords defined)'
      do i=1,ibugm                    ! size(table%key) bug in gfortran
         write(G_iout,fmt)"! $SET   ",trim(macro%key(i)),' = ',adjustl(macro%value(i)(:macro%count(i)) )
      enddo
   endif

   write(G_iout,'(a)')'!-------------------------------------------------------------------------------'
end subroutine show_state
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
subroutine write_arguments() !@(#)write_arguments(3f): return all command arguments as a string

integer                      :: istatus          !  status (non-zero means error)
integer                      :: ilength          !  length of individual arguments
integer                      :: i                !  loop count
integer                      :: icount           !  count of number of arguments available
character(len=255)           :: value            !  store individual arguments one at a time

   write(G_iout,'(a)',advance='no')'! Arguments ...................... '
   icount=command_argument_count()               ! intrinsic gets number of arguments
   do i=1,icount
      call get_command_argument(i,value,ilength,istatus)
      write(G_iout,'(a,1x)',advance='no')value(:ilength)
   enddo
   write(G_iout,'(a)')
end subroutine write_arguments
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
subroutine include(line,iunit)  !@(#)include(3f): add file to input file list
implicit none
character(len=G_line_length),intent(in)  :: line
integer,intent(in)                       :: iunit
integer                                  :: ios
character(len=4096)                      :: message
character(len=G_line_length)             :: line_unquoted
integer                                  :: iend

   line_unquoted=adjustl(unquote(line))                   ! remove " from filename using Fortran list-directed I/O rules
   iend=len_trim(line_unquoted)
   if(len(line_unquoted).ge.2)then
      if(line_unquoted(1:1).eq.'<'.and.line_unquoted(iend:iend).eq.'>')then       ! remove < and > from filename
         line_unquoted=line_unquoted(2:iend-1)
      endif
   endif

   if(iunit.eq.5.or.line_unquoted.eq.'@')then                   ! assume this is stdin
      G_iocount=G_iocount+1
      G_file_dictionary(G_iocount)%unit_number=5
      G_file_dictionary(G_iocount)%filename=line_unquoted
      return
   endif

   call findit(line_unquoted)

   open(unit=iunit,file=trim(line_unquoted),iostat=ios,status='old',action='read',iomsg=message)
   if(ios.ne.0)then
      call show_state(msg='OPEN IN INCLUDE')
      call write_err(message)
      call stop_prep(026,'failed open of input file(',v2s(iunit)//"):"//trim(line_unquoted))
   else
      rewind(unit=iunit)
      G_iocount=G_iocount+1
      if(G_iocount.gt.size(G_file_dictionary))then
         call stop_prep(027,'input file nesting too deep:',trim(G_source))
      endif
      G_file_dictionary(G_iocount)%unit_number=iunit
      G_file_dictionary(G_iocount)%filename=line_unquoted
      G_file_dictionary(G_iocount)%line_number=0
   endif

end subroutine include
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
subroutine findit(line) !@(#)findit(3f): look for filename in search directories if name does not exist and return modified name
character(len=G_line_length)    :: line
character(len=G_line_length)    :: filename
logical                         :: file_exist
integer                         :: i
integer                         :: iend_dir

   inquire(file=trim(line), exist=file_exist)                    ! test if input filename exists
   if(file_exist)then                                            ! if file exits then return filename
      return
   endif

   if(G_inc_count.gt.0)then                                      ! if search directories have been specified search for file
      do i=1,G_inc_count
         iend_dir=len_trim(G_inc_files(i))
         if(G_inc_files(i)(iend_dir:iend_dir).ne.'/')then
            filename=G_inc_files(i)(:iend_dir)//'/'//trim(line)
         else
            filename=G_inc_files(i)(:iend_dir)//trim(line)
         endif
         inquire(file=trim(filename), exist=file_exist)
         if(file_exist)then                                      ! if find filename exit
            line=filename
            return
         endif
      enddo
   else                                                          ! file did not exist and no search directories have been specified
      filename=trim(line)
   endif

   call stop_prep(031,'missing input file:',trim(filename))

end subroutine findit
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
subroutine opens()                   !@(#)opens(3f): use expression on command line to  open input files

integer,parameter                     :: n=50                       ! maximum number of tokens to look for
character(len=G_line_length)          :: array(n)                   ! the array to fill with tokens
character(len=1)                      :: dlim=' '                   ! string of single characters to use as delimiters

integer                               :: icount                     ! how many tokens are found
integer                               :: ibegin(n)                  ! starting column numbers for the tokens in INLINE
integer                               :: iterm(n)                   ! ending column numbers for the tokens in INLINE
integer                               :: ilength                    ! is the position of last non‐blank character in INLINE
character(len=G_line_length)          :: in_filename2=''            ! input filename, default is stdin
integer                               :: i, ii
integer                               :: ivalue
character(len=G_line_length)          :: dir                        ! directory used by an input file

   if(.not.G_cpp)then
      in_filename2(:G_line_length)  = sget('i')                     ! get values from command line
      if(in_filename2.eq.'')then                                    ! read stdin if no -i on command line
         in_filename2  = '@'
      endif
   else
      if(size(unnamed).gt.0)then
         in_filename2  = unnamed(1)
      else
         in_filename2  = '@'
      endif
   endif

   ! break command argument "i" into single words
   call delim(adjustl(trim(in_filename2)),array,n,icount,ibegin,iterm,ilength,dlim)
   ivalue=50                                ! starting file unit to use
   do i=icount,1,-1
      G_source='$include '//trim(array(i))  ! for messages
      call include(array(i),ivalue)
      ivalue=ivalue+1

      ALREADY: block                 ! store directory path of input files as an implicit directory for reading $INCLUDE files
         dir=dirname(array(i))
         do ii=1,G_inc_count
            if(G_inc_files(ii).eq.dir)exit ALREADY
         enddo
         G_inc_count=G_inc_count+1
         G_inc_count=min(G_inc_count,size(G_inc_files)) ! guard against too many files; !x! should warn on overflow
         G_inc_files(G_inc_count)=dir
      endblock ALREADY

   enddo

! >>>
!   If ARRAY(N) fills before reaching the end of the line the routine stops.
!   Check "if(iend(icount) .eq. ilength)" to see if you got to the end to warn if not all files include

end subroutine opens
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
subroutine includes()         !@(#)includes(3f): use expression on command line to  get include directories

integer,parameter                     :: n=50                    ! maximum number of tokens to look for
character(len=1)                      :: dlim=' '                ! string of single characters to use as delimiters
integer                               :: ibegin(n)               ! starting column numbers for the tokens in G_inc_files
integer                               :: iterm(n)                ! ending column numbers for the tokens in G_inc_files
integer                               :: ilength                 ! is the position of last non‐blank character in G_inc_files

   ! G_inc_files is the array to fill with tokens
   ! G_inc_count is the number of tokens found

   ! break command argument "I" into single words
   call delim(adjustl(trim(SGET('I'))),G_inc_files,n,G_inc_count,ibegin,iterm,ilength,dlim)
end subroutine includes
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
subroutine defines()       !@(#)defines(3f): use expressions on command line to initialize dictionary and define variables
integer,parameter                     :: n=300                   ! maximum number of tokens to look for
character(len=G_line_length)          :: array(n)                ! the array to fill with tokens
character(len=1)                      :: dlim=' '                ! string of single characters to use as delimiters

integer                               :: icount                  ! how many tokens are found
integer                               :: ibegin(n)               ! starting column numbers for the tokens in INLINE
integer                               :: iterm(n)                ! ending column numbers for the tokens in INLINE
integer                               :: ilength                 ! is the position of last non‐blank character in INLINE
character(len=:),allocatable          :: in_define2              ! variable definition from command line
integer                               :: i

   in_define2=''

   if(.not.G_cpp)then
      do i=1,size(unnamed)
         in_define2=in_define2//' '//unnamed(i)
      enddo
   endif

   ! break command argument prep_oo into single words
   call delim(adjustl(trim(in_define2))//' '//trim(SGET('D')),array,n,icount,ibegin,iterm,ilength,dlim)
   do i=1,icount
      G_source='$redefine '//trim(array(i))
      call cond() ! convert variable name into a "$define variablename" directive and process it
   enddo

!   If ARRAY(N) fills before reaching the end of the line the routine stops.
!   Check "if(iend(icount) .eq. ilength)" to see if you got to the end.

end subroutine defines
!===================================================================================================================================
subroutine undef(opts)                                     !@(#)undef(3f): process UNDEFINE directive
character(len=*)             :: opts                       ! directive with no spaces, leading prefix removed, and all uppercase
character(len=:),allocatable :: names(:)
integer                      :: i
integer                      :: k

   ! REMOVE VARIABLE IF FOUND IN VARIABLE NAME DICTIONARY
   ! allow basic globbing where * is any string and ? is any character
   if (len_trim(opts).eq.0) then                           ! if no variable name
      call stop_prep(032,'missing targets in',' $UNDEFINE:'//trim(G_source))
   endif
   call split(opts,names,delimiters=' ;,')

   do k=1,size(names)
      if(G_verbose)then
         call write_err('+ $UNDEFINE '//names(k))
      endif
      do i=size(table%key),1,-1                           ! find defined variable to be undefined by searching dictionary
         if (glob(trim(table%key(i)),trim(names(k))))then   ! found the requested variable name
            call  table%del(table%key(i))
         endif
      enddo
   enddo

end subroutine undef
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
subroutine stop(opts)                    !@(#)stop(3f): process stop directive
character(len=*),intent(in)  :: opts
integer                      :: ivalue
character(len=:),allocatable :: message
integer                      :: iend

! CHECK COMMAND SYNTAX
   if(opts.eq.'')then
      call stop_prep(000,'','',stop_value=1)
   else
      iend=index(opts,' ')
      if(iend.eq.0)then
         iend=len_trim(opts)
         message=' '
      else
         message=unquote(trim(opts(iend:)))
         write(stderr,'(a)')message
         call flushit()
      endif

      ivalue=get_integer_from_string(opts(:iend))

      if(ivalue.eq.0)then
         if(.not.G_debug)stop
      elseif(message.eq.'')then
         call stop_prep(000,'','',stop_value=ivalue) ! UNEXPECTED "STOP" VALUE
      else
         if(.not.G_debug)stop ivalue
      endif

   endif
end subroutine stop
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
subroutine stop_prep(errnum,translate,message,stop_value) !@(#)stop_prep(3f): write MESSAGE to stderr and exit program
integer,intent(in)           :: errnum 
character(len=*),intent(in)  :: translate
character(len=*),intent(in)  :: message
character(len=1024)          :: toscreen
character(len=:),allocatable :: translated
integer,optional :: stop_value
integer :: stop_value_local
   stop_value_local=1
   if( present(stop_value) )stop_value_local=stop_value
   call write_err(trim(G_SOURCE))
   select case(G_lang)
   case('en')
    translated=en(errnum,translate)
   case default
    translated=trim(translate)
   end select
   write(toscreen,'("*prep* ERROR(",i3.3,") - ",a,1x,a)')errnum,translated,message
   call show_state(msg=trim(toscreen))
   if(.not.G_debug)stop stop_value_local

end subroutine stop_prep
!===================================================================================================================================
! skeleton for supporting alternate languages
function en(errnum,translate) result(english)
integer,intent(in)           :: errnum
character(len=*),intent(in)  :: translate
character(len=:),allocatable :: english
select case(errnum)
case(000);english=''
case(001);english='expression invalid:'
case(002);english='unknown compiler directive:'
case(003);english='system command failed:'
case(004);english='system directive encountered but not enabled:'
case(005);english='expression invalid:'
case(006);english='failed to open output file:'
case(007);english='failed to open parcel scratch file:'
case(028);english='parcel name not defined for'
case(029);english='error rewinding'
case(030);english='input file nesting too deep:'
case(008);english='description too long:'
case(009);english='language unknown for'
case(010);english='null variable name:'
case(011);english='name contains unallowed character(or general syntax error):'
case(012);english='missing targets for '
case(013);english='"IF" block nesting too deep, limited to '//v2s(G_nestl_max)//' levels,'
case(014);english='"IF" expression invalid:'
case(015);english='block nesting too deep, limited to '//v2s(G_nestl_max)//' levels in:'
case(016);english='misplaced $ELSE or $ELSEIF directive:'
case(017);english='misplaced $ENDIF directive:'
case(018);english='undefined variable.'
case(019);english='constant logical expression required.'
case(020);english='filter command failed to open process:'
case(021);english='filter command $BLOCK encountered but system commands not enabled:'
case(022);english='unexpected "BLOCK" option. found:'
case(023);english='failed to open document output file:'
case(024);english='failed to write output file:'
case(025);english='failed to write comment block'
case(026);english='failed open of input file('
case(027);english='input file nesting too deep:'
case(031);english='missing input file:'
case(032);english='missing targets in'
case(033);english='failed to write to process:'
case(034);english='unexpected "BLOCK" value. Found:'
case(035);english='unexpected "BLOCK" value. Found:'
case(036);english='expression invalid:'
case(037);english='incomplete set:'
case(038);english='expression invalid:'
case(039);english='failed to open output file:'
case(040);english='block not closed in'
case default; english=trim(translate)
end select
end function en
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
subroutine warn_prep(message)                   !@(#)warn_prep(3f): write MESSAGE to stderr and and continue program
character(len=*),intent(in)  :: message
   call write_err(message)
   call write_err(trim(G_SOURCE))
end subroutine warn_prep
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================

! This documentation is a combination of
!    o the original Lahey documentation of fpp(1) from "LAHEY FORTRAN REFERENCE MANUAL"; Revision C, 1992;
!    o documentation for the features subsequently added to the program.
!    o examination of the code.

subroutine setup(help_text,version_text) !@(#)help_usage(3f): prints help information
implicit none
character(len=:),allocatable,intent(out) :: help_text(:)
character(len=:),allocatable,intent(out) :: version_text(:)
!-------------------------------------------------------------------------------
help_text=[ CHARACTER(LEN=128) :: &
'NAME                                                                            ',&
'   prep(1) - [DEVELOPER] preprocess Fortran source files                        ',&
'   (LICENSE:MIT)                                                                ',&
'                                                                                ',&
'SYNOPSIS                                                                        ',&
'   prep [[-D] define_list]                                                      ',&
'        [-I include_directories]                                                ',&
'        [-i input_file(s)]                                                      ',&
'        [-o output_file]                                                        ',&
'        [--system]                                                              ',&
'        [--type FILE_TYPE | --start START_STRING --stop STOP_STRING]            ',&
'        [--prefix character|ADE]                                                ',&
'        [--keeptabs]                                                            ',&
'        [--noenv]                                                               ',&
'        [--width n]                                                             ',&
'        [-d ignore|remove|blank]                                                ',&
'        [--comment default|doxygen|ford|none]                                   ',&
'        [--ident]                                                               ',&
'        [--verbose]                                                             ',&
'        [--version]                                                             ',&
'                                                                                ',&
'   IMPORTANT                                                                    ',&
'   For compatibility with other utilities where cpp(1)-like syntax is required  ',&
'   if -i is not specified and the unnamed parameters are less than three the    ',&
'   unnamed parameters are assumed to be the input file and optional output      ',&
'   file instead of macro definitions if the first parameter matches an existing ',&
'   filename.                                                                    ',&
'                                                                                ',&
'DESCRIPTION                                                                     ',&
'                                                                                ',&
'   prep(1) is a Fortran source preprocessor.                                    ',&
'                                                                                ',&
'   A preprocessor performs operations on input files before they are passed to  ',&
'   a compiler, including conditional selection of lines based on directives     ',&
'   contained in the file. This makes it possible to use a single source file    ',&
'   even when different code is required for different programming environments. ',&
'                                                                                ',&
'   The prep(1) preprocessor has additional features that support free-format    ',&
'   documentation in the same file as the source and the generation of generic   ',&
'   code using a simple templating technique. The basic directives ....          ',&
'                                                                                ',&
'   * Conditionally output parts of the source file (controlled by expressions   ',&
'     on the directives $IF, $IFDEF, $IFNDEF, and $ENDIF. The expressions may    ',&
'     include variables defined on the command line or via the directives        ',&
'     $DEFINE, and $UNDEFINE).                                                   ',&
'                                                                                ',&
'   * Include other files (provided by directive $INCLUDE).                      ',&
'                                                                                ',&
'   * Define parcels of text that may be replayed multiple times with            ',&
'     expansion, allowing for basic templating (controlled by directives         ',&
'     $PARCEL/$ENDPARCEL and $POST). The mechanism supported is to replace       ',&
'     text of the form ${NAME} with user-supplied strings similar to the         ',&
'     POSIX shell (controlled by directives $SET, $UNSET and $IMPORT).           ',&
'                                                                                ',&
'   * Filter blocks of text and convert them to comments, a CHARACTER array,     ',&
'     Fortran WRITE statements, ... (provided by the $BLOCK directive.)          ',&
'                                                                                ',&
'     The blocks of text may also be written to a file and executed, with        ',&
'     stdout captured and included in the prep(1) output file.                   ',&
'                                                                                ',&
'     Blocked text may optionally be simultaneously written to a separate file,  ',&
'     typically for use as documentation.                                        ',&
'                                                                                ',&
'   * Call system commands (using the $SYSTEM directive).                        ',&
'                                                                                ',&
'   * Generate multiple output files from a single input file (using $OUTPUT).   ',&
'                                                                                ',&
'   * Record the parameters used and the date and time executed as Fortran       ',&
'     comments in the output (using $SHOW).                                      ',&
'                                                                                ',&
'   * Stop the preprocessing (controlled by directive $STOP, $QUIT or $ERROR)    ',&
'     and produce messages on stderr (using $MESSAGE).                           ',&
'                                                                                ',&
'OPTIONS                                                                         ',&
'   define_list, -D define_list  An optional space-delimited list of expressions ',&
'                                used to define variables before file processing ',&
'                                commences. These can subsequently be used in    ',&
'                                $IF/$ELSE/$ELSEIF and $DEFINE directives.       ',&
'                                                                                ',&
'   -i "input_files"             The default input file is stdin. Filenames are  ',&
'                                space-delimited. In a list, @ represents stdin. ',&
'                                                                                ',&
'   The suggested suffix for Fortran input files is ".ff" for code files unless  ',&
'   they contain $SYSTEM directives in which case ".FF" is preferred. $INCLUDE   ',&
'   files should use ".ffinc" and ".FFINC" if they include prep(1) directives.   ',&
'   This naming convention is not required.                                      ',&
'                                                                                ',&
'   Files may also end in supported suffixes such as ".md", as explained under   ',&
'   the --type option description.                                               ',&
'                                                                                ',&
'   -o output_file               The default output file is stdout.              ',&
'                                                                                ',&
'   -I "include_directories" The directories to search for files specified on    ',&
'                            $INCLUDE directives. May be repeated.               ',&
'                                                                                ',&
'   --system         Allow system commands on $SYSTEM directives to be executed. ',&
'                                                                                ',&
'   --type FILETYPE  This flag indicates to skip input lines until after a       ',&
'                    specific start string is encountered and to stop once a     ',&
'                    specific end string is found, left-justified on lines by    ',&
'                    themselves.                                                 ',&
'                                                                                ',&
'                        FileType  Start_String            Stop_String           ',&
'                        --------  ------------            -----------           ',&
'                        md        ```fortran              ```                   ',&
'                        html      <xmp>                   </xmp>                ',&
'                        tex       \begin{minted}{Fortran} \end{minted}          ',&
'                        auto                                                    ',&
'                        none                                                    ',&
'                                                                                ',&
'                    The default type is "auto", in which case files will be     ',&
'                    processed according to their file suffix.                   ',&
'                                                                                ',&
'                    This allows for easily extracting code from common document ',&
'                    formats. This is particularly useful with extended markdown ',&
'                    formats, allowing for code source to be easily documented   ',&
'                    and for tests in documents to be able to be extracted and   ',&
'                    tested. "auto" switches processing mode depending on input  ',&
'                    file suffix, treating supported file suffixes               ',&
'                    ("md","html","tex") appropriately.                          ',&
'                                                                                ',&
'   --start STRING   Same as --type except along with --stop allows for custom   ',&
'                    strings to be specified.                                    ',&
'                                                                                ',&
'   --stop STRING    Same as --type except along with --start allows for custom  ',&
'                    strings to be specified.                                    ',&
'                                                                                ',&
'   --comment        Try to style comments generated in $BLOCK COMMENT blocks    ',&
'                    for other utilities such as doxygen. Default is to          ',&
'                    prefix lines with ''! ''. Allowed keywords are              ',&
'                    currently "default", "doxygen","none","ford".               ',&
'                    THIS IS AN ALPHA FEATURE AND NOT FULLY IMPLEMENTED.         ',&
'                                                                                ',&
'   --prefix ADE|letter  The directive prefix character. The default is "$".     ',&
'                        If the value is numeric it is assumed to be an ASCII    ',&
'                        Decimal Equivalent (Common values are 37=% 42=* 35=#    ',&
'                        36=$ 64=@).                                             ',&
'                                                                                ',&
'   --noenv          The $IFDEF and $IFNDEF directives test for an internal      ',&
'                    prep(1) variable and then an environment variable by        ',&
'                    default. This option turns off testing for environment      ',&
'                    variables.                                                  ',&
'                                                                                ',&
'   --keeptabs       By default tab characters are expanded assuming a stop has  ',&
'                    been set every eight columns; and trailing carriage-return  ',&
'                    are removed. Use this flag to prevent this processing from  ',&
'                    from occurring.                                             ',&
'                                                                                ',&
'   --ident          The output of the $IDENT directive is in the form of a      ',&
'                    comment by default. If this flag is set the output is       ',&
'                    of the form described in the $IDENT documentation           ',&
'                    so executables and object code can contain the metadata     ',&
'                    for use with the what(1) command. Note this generates an    ',&
'                    unused variable which some compilers might optimize         ',&
'                    away depending on what compilation options are used.        ',&
'                                                                                ',&
'   -d ignore|remove|blank  Enable special treatment for lines beginning         ',&
'                           with "d" or "D". The letter will be left as-is       ',&
'                           (the default); removed; or replaced with a blank     ',&
'                           character. This non-standard syntax has been         ',&
'                           used to support the optional compilation of          ',&
'                           "debug" code by many Fortran compilers when          ',&
'                           compiling fixed-format Fortran source.               ',&
'                                                                                ',&
'   --width n   Maximum line length of the output file. The default is 1024.     ',&
'               The parameter is typically used to trim fixed-format Fortran     ',&
'               code that contains comments or "ident" labels past column 72     ',&
'               when compiling fixed-format Fortran code.                        ',&
'                                                                                ',&
'   --verbose   All commands on a $SYSTEM directive are echoed to stderr with a  ',&
'               "+" prefix. Text following the string "@(#)" is printed to stderr',&
'               similar to the Unix command what(1) but is otherwise treated as  ',&
'               other text input. Additional descriptive messages are produced.  ',&
'                                                                                ',&
'   --version   Display version and exit                                         ',&
'                                                                                ',&
'   --help      Display documentation and exit.                                  ',&
'                                                                                ',&
'INPUT FILE SYNTAX                                                               ',&
'                                                                                ',&
'   The prep(1) preprocessor directives begin with "$" (by default) in column    ',&
'   one, and prep(1) will output no such lines. Other input is conditionally     ',&
'   written to the output file(s) based on the case-insensitive command names.   ',&
'                                                                                ',&
'   An exclamation character FOLLOWED BY A SPACE on most directives              ',&
'   begins an in-line comment that is terminated by an end-of-line. The space    ',&
'   is required so comments are not confused with C-style logical operators such ',&
'   as "!", which may NOT be followed by a space.                                ',&
'                                                                                ',&
' VARIABLES AND EXPRESSIONS                                                      ',&
'                                                                                ',&
'   INTEGER or LOGICAL expressions are used to conditionally select              ',&
'   output lines. An expression is composed of INTEGER and LOGICAL               ',&
'   constants, variable names, and operators. Operators are processed            ',&
'   as in Fortran and/or C expressions. The supported operators are ...          ',&
'                                                                                ',&
'       #-----#-----#-----#-----#-----#                #-----#-----#             ',&
'       |  +  |  -  |  *  |  /  |  ** | Math Operators #  (  |  )  | Grouping    ',&
'       #-----#-----#-----#-----#-----#                #-----#-----#             ',&
'       Logical Operators                                                        ',&
'       #-----#-----#-----#-----#-----#-----#-----#-----#-----#-----#------#     ',&
'       | .EQ.| .NE.| .GE.| .GT.| .LE.| .LT.|.NOT.|.AND.| .OR.|.EQV.|.NEQV.|     ',&
'       |  == |  /= |  >= |  >  |  <= |  <  |  !  |  && |  || | ==  |  !=  |     ',&
'       #-----#  != #-----#-----#-----#-----#-----#-----#-----#-----#------#     ',&
'             #-----#                                                            ',&
'       C-style operators NOT supported:   %,  <<,  >>, &,  ~                    ',&
'                                                                                ',&
'DIRECTIVES                                                                      ',&
'                                                                                ',&
' The directives fall into the following categories:                             ',&
'                                                                                ',&
' VARIABLE DEFINITION FOR CONDITIONALS                                           ',&
'   Directives for defining variables ...                                        ',&
'                                                                                ',&
'      $DEFINE   variable_name[=expression] [;...]          [! comment ]         ',&
'      $UNDEFINE|$UNDEF variable_name [;...]                [! comment ]         ',&
'                                                                                ',&
'   Details ...                                                                  ',&
'                                                                                ',&
'      $DEFINE variable_name [=expression]; ... [! comment ]                     ',&
'                                                                                ',&
'   Defines a numeric or logical variable name and its value. The variable       ',&
'   names may subsequently be used in the expressions on the conditional output  ',&
'   selector directives $IF, $ELSEIF, $IFDEF, and $IFNDEF.                       ',&
'                                                                                ',&
'   If the result of the expression is ".TRUE." or ".FALSE." then the variable   ',&
'   will be of type LOGICAL, otherwise the variable is of type INTEGER (and the  ',&
'   expression must be an INTEGER expression or null). If no value is supplied   ',&
'   the variable is given the INTEGER value "1".                                 ',&
'                                                                                ',&
'   Variables are defined from the point they are declared in a $DEFINE          ',&
'   directive or the command line until program termination unless explicitly    ',&
'   undefined with a $UNDEFINE directive.                                        ',&
'                                                                                ',&
'   Example:                                                                     ',&
'                                                                                ',&
'    > $define A                        ! will have default value of "1"         ',&
'    > $define B = 10 - 2 * 2**3 / 3    ! integer expressions                    ',&
'    > $define C=1+1; D=(-40)/(-10)                                              ',&
'    > $define bigd= d .ge. a; bigb = ( (b >= c) && (b > 0) )  ! logical         ',&
'    > $if ( A + B ) / C .eq. 1                                                  ',&
'    >    (a+b)/c is one                                                         ',&
'    > $endif                                                                    ',&
'   Note expressions are not case-sensitive.                                     ',&
'                                                                                ',&
'       $UNDEFINE variable_name[; ...]                                           ',&
'                                                                                ',&
'   A symbol defined with $DEFINE can be removed with the $UNDEFINE directive.   ',&
'   Multiple names may be specified, preferably separated by semi-colons.        ',&
'                                                                                ',&
'   Basic globbing is supported, where "*" represents any string, and "?"        ',&
'   represents any single character.                                             ',&
'                                                                                ',&
'       DEFINED(variable_name[,...])                                             ',&
'                                                                                ',&
'   A special function called DEFINED() may appear only in a $IF or $ELSEIF.     ',&
'   If "variable_name" has been defined at that point in the source code,        ',&
'   then the function value is ".TRUE.", otherwise it is ".FALSE.". A name is    ',&
'   defined only if it has appeared in the source previously in a $DEFINE        ',&
'   directive or been declared on the command line.                              ',&
'   The names used in compiler directives are district from names in the         ',&
'   Fortran source, which means that "a" in a $DEFINE and "a" in a Fortran       ',&
'   source statement are totally unrelated.                                      ',&
'   The DEFINED() variable is NOT valid in a $DEFINE directive.                  ',&
'                                                                                ',&
'   Example:                                                                     ',&
'                                                                                ',&
'    >        Program test                                                       ',&
'    > $IF .NOT. DEFINED (inc)                                                   ',&
'    >        INCLUDE "comm.inc"                                                 ',&
'    > $ELSE                                                                     ',&
'    >        INCLUDE "comm2.inc"                                                ',&
'    > $ENDIF                                                                    ',&
'    >        END                                                                ',&
'                                                                                ',&
'   The file, "comm.inc" will be included in the source if the variable          ',&
'   "inc", has not been previously defined, while INCLUDE "comm2.inc" will       ',&
'   be included in the source if "inc" has been defined.                         ',&
'                                                                                ',&
'   Predefined variables are                                                     ',&
'                                                                                ',&
'    SYSTEMON = .TRUE. if --system was present on the command line, else .FALSE. ',&
'                                                                                ',&
'    UNKNOWN = 0 LINUX   = 1 MACOS   = 2 WINDOWS = 3                             ',&
'    CYGWIN  = 4 SOLARIS = 5 FREEBSD = 6 OPENBSD = 7                             ',&
'    In addition OS is set to what the program guesses the system type is.       ',&
'                                                                                ',&
'     > $if OS == LINUX                                                          ',&
'     >    write(*,*)"System type is Linux"                                      ',&
'     > $elseif OS == WINDOWS                                                    ',&
'     >    write(*,*)"System type is MSWindows"                                  ',&
'     > $else                                                                    ',&
'     >    write(*,*)"System type is unknown"                                    ',&
'     > $endif                                                                   ',&
'                                                                                ',&
' CONDITIONAL CODE SELECTION                                                     ',&
'   directives for conditionally selecting input lines ...                       ',&
'                                                                                ',&
'       $IF  logical_integer-based expression |                                  ',&
'       $IFDEF [variable_name|environment_variable] |                            ',&
'       $IFNDEF [variable_name|environment_variable]         [! comment ]        ',&
'               { sequence of source statements}                                 ',&
'       [$ELSEIF|$ELIF logical_integer-based expression      [! comment ]        ',&
'               { sequence of source statements}]                                ',&
'       [$ELSE                                               [! comment ]        ',&
'               { sequence of source statements}]                                ',&
'       $ENDIF                                               [! comment ]        ',&
'                                                                                ',&
'   Details ...                                                                  ',&
'                                                                                ',&
'       $IF/$ELSEIF/$ELSE/$ENDIF directives ...                                  ',&
'                                                                                ',&
'   Each of these control lines delineates a block of source lines. If the       ',&
'   expression following the $IF is ".TRUE.", then the following lines of        ',&
'   source following are output. If it is ".FALSE.", and an $ELSEIF              ',&
'   follows, the expression is evaluated and treated the same as the $IF. If     ',&
'   the $IF and all $ELSEIF expressions are ".FALSE.", then the lines of         ',&
'   source following the optional $ELSE are output. A matching $ENDIF ends the   ',&
'   conditional block.                                                           ',&
'                                                                                ',&
'       $IFDEF/$IFNDEF directives ...                                            ',&
'                                                                                ',&
'   $IFDEF and $IFNDEF are special forms of the $IF directive that simply test   ',&
'   if a variable name is defined or not.                                        ',&
'                                                                                ',&
'   The expressions may optionally be enclosed in parenthesis and followed by    ',&
'   the keyword "THEN", ie. they may use Fortran syntax. For example, the        ',&
'   previous example may also be written as:                                     ',&
'                                                                                ',&
'     > $IF(OS .EQ. LINUX)THEN                                                   ',&
'     >    write(*,*)"System type is Linux"                                      ',&
'     > $ELSEIF(OS .EQ. WINDOWS)THEN                                             ',&
'     >    write(*,*)"System type is MSWindows"                                  ',&
'     > $ELSE                                                                    ',&
'     >    write(*,*)"System type is unknown"                                    ',&
'     > $ENDIF                                                                   ',&
'                                                                                ',&
'   Essentially, these are equivalent:                                           ',&
'                                                                                ',&
'       $IFDEF varname  ==> $IF DEFINED(varname)                                 ',&
'       $IFNDEF varname ==> $IF .NOT. DEFINED(varname)                           ',&
'                                                                                ',&
'   except that environment variables are tested as well by $IFDEF and $IFNDEF   ',&
'   if the --noenv option is not specified, but never by the function DEFINED(), ',&
'   allowing for environment variables to be selectively used or ignored.        ',&
'   The --noenv switch is therefore only needed for compatibility with fpp(1).   ',&
'   For the purposes of prep(1) an environment variable is defined if it is      ',&
'   returned by the system and has a non-blank value.                            ',&
'                                                                                ',&
' MACRO STRING EXPANSION AND TEXT REPLAY                                         ',&
'   Directives for defining replayable text blocks ...                           ',&
'                                                                                ',&
'       $PARCEL blockname  / $ENDPARCEL                      [! comment ]        ',&
'       $POST     blockname(s)                               [! comment ]        ',&
'       $SET varname  string                                                     ',&
'       $UNSET varname(s)                                    [! comment ]        ',&
'       $IMPORT   envname[;...]                              [! comment ]        ',&
'                                                                                ',&
'   Details ...                                                                  ',&
'                                                                                ',&
'       $PARCEL blockname / $ENDPARCEL                       [! comment ]        ',&
'                                                                                ',&
'   The block of lines between a "$PARCEL name" and "$ENDPARCEL" directive are   ',&
'   written to a scratch file WITHOUT expanding directives. the scratch file can ',&
'   then be read in with the $POST directive much like a named file can be with  ',&
'   $INCLUDE except the file is automatically deleted at program termination.    ',&
'                                                                                ',&
'       $POST     blockname(s)                               [! comment ]        ',&
'                                                                                ',&
'   Read in a scratch file created by the $PARCEL directive. Combined with       ',&
'   $SET and $IMPORT directives this allows you to replay a section of input     ',&
'   and replace strings as a simple templating technique, or to repeat lines     ',&
'   like copyright information or definitions of (obsolescent) Fortran COMMON    ',&
'   blocks, but contained in source files without the need for separate          ',&
'   INCLUDE files or error-prone repetition of the declarations.                 ',&
'                                                                                ',&
'       $SET varname  string                                                     ',&
'                                                                                ',&
'   If a $SET or $IMPORT directive defines a name prep(1) enters expansion mode. ',&
'   In this mode anywhere the string "${NAME}" is encountered in subsequent      ',&
'   output it is replaced by "string".                                           ',&
'                                                                                ',&
'   o values are case-sensitive but variable names are not.                      ',&
'   o expansion of a line may cause it to be longer than allowed by some         ',&
'     compilers. Automatic breaking into continuation lines does not occur.      ',&
'   o comments are not supported on a $SET directive because everything past the ',&
'     variable name becomes part of the value.                                   ',&
'   o The pre-defined values $FILE, $LINE, $DATE, and $TIME ( for input file,    ',&
'     line in input file, date and time ) are NOT ACTIVE until at least one      ',&
'     one $SET or $IMPORT directive is processed. That is, unless a variable     ',&
'     is defined no ${NAME} expansion occurs.                                    ',&
'   o The time and date refers to the time of processing, not the time of        ',&
'     compilation or loading.                                                    ',&
'                                                                                ',&
'   Example:                                                                     ',&
'                                                                                ',&
'    > $set author  William Shakespeare                                          ',&
'    > write(*,*)''By ${AUTHOR}''                                                ',&
'    > write(*,*)''File ${FILE}''                                                ',&
'    > write(*,*)''Line ${LINE}''                                                ',&
'    > write(*,*)''Date ${DATE}''                                                ',&
'    > write(*,*)''Time ${TIME}''                                                ',&
'   ...                                                                          ',&
'                                                                                ',&
'       $UNSET varname(s)                                                        ',&
'                                                                                ',&
'   Unset variables set with the $SET directive.                                 ',&
'                                                                                ',&
'       $IMPORT   envname[;...]                              [! comment ]        ',&
'                                                                                ',&
'   The values of environment variables may be imported just like their names    ',&
'   and values were used on a $SET directive. The names of the variables are     ',&
'   case-sensitive in regards to obtaining the values, but the names become      ',&
'   case-insensitive in prep(). That is, "import home" gets the lowercase        ',&
'   environment variable "home" and then sets the associated value for the       ',&
'   variable "HOME" to the value.                                                ',&
'                                                                                ',&
'    > $import HOME USER                                                         ',&
'    > write(*,*)''HOME ${HOME}''                                                ',&
'    > write(*,*)''USER ${USER}''                                                ',&
'                                                                                ',&
' EXTERNAL FILES                                                                 ',&
'   Directives for reading and writing external files ...                        ',&
'                                                                                ',&
'       $OUTPUT   filename  [--append]                          [! comment ]     ',&
'       $ENDOUTPUT                                              [! comment ]     ',&
'       $INCLUDE filename                                                        ',&
'                                                                                ',&
'   Details ...                                                                  ',&
'                                                                                ',&
'       $OUTPUT   filename  [--append]                          [! comment ]     ',&
'                                                                                ',&
'   Specifies the output file to write to. This overrides the initial output file',&
'   specified with command line options. If no output filename is given          ',&
'   prep(1) reverts back to the initial output file. "@" is a synonym for stdout.',&
'                                                                                ',&
'   Files are open at the first line by default. Use the --append switch to      ',&
'   append to the end of an existing file instead of overwriting it.             ',&
'                                                                                ',&
'       $ENDOUTPUT                                              [! comment ]     ',&
'                                                                                ',&
'   Ends writing to an alternate output file begun by a $OUTPUT directive.       ',&
'                                                                                ',&
'       $INCLUDE filename                                                        ',&
'                                                                                ',&
'   Read in the specified input file. Fifty (50) nesting levels are allowed.     ',&
'   Following the tradition of cpp(1) if "<filename>" is specified the file is   ',&
'   only searched for relative to the search directories, otherwise it is        ',&
'   searched for as specified first. Double-quotes in the filename are treated   ',&
'   as in Fortran list-directed input.                                           ',&
'                                                                                ',&
' TEXT BLOCK FILTERS                                                             ',&
'   (--file is ignored unless $PREP_DOCUMENT_DIR is set)                         ',&
'                                                                                ',&
'      $BLOCK   [null|comment|write|variable [--varname NAME]|                   ',&
'               set|system|message|define                                        ',&
'               help|version] [--file NAME [--append]]      [! comment ]         ',&
'      $ENDBLOCK                                            [! comment ]         ',&
'                                                                                ',&
'   Details ...                                                                  ',&
'                                                                                ',&
'   $BLOCK has several forms but in all cases operates on a block of lines:      ',&
'                                                                                ',&
'     basic filtering:                                                           ',&
'      $BLOCK [comment|null|write                 [--file NAME [--append]]       ',&
'     creating a CHARACTER array:                                                ',&
'      $BLOCK VARIABLE --varname NAME             [--file NAME [--append]]       ',&
'     block versions of prep(1) commands:                                        ',&
'      $BLOCK set|system|message|define           [--file NAME [--append]]       ',&
'     specialized procedure construction:                                        ',&
'      $BLOCK help|version                        [--file NAME [--append]]       ',&
'                                                                                ',&
'      NULL:      Do not write into current output file                          ',&
'      COMMENT:   write text prefixed by an exclamation and a space or according ',&
'                 to the style selected by the --comment style selected on the   ',&
'                 command line.                                                  ',&
'      WRITE:     write text as Fortran WRITE(3f) statements                     ',&
'                 The Fortran generated is free-format. It is assumed the        ',&
'                 output will not generate lines over 132 columns.               ',&
'      VARIABLE:  write as a text variable. The name may be defined using        ',&
'                 the --varname switch. Default name is "textblock".             ',&
'      MESSAGE:   All the lines in the block are treated as options to $MESSAGE  ',&
'      SET:       All the lines in the block are treated as options to $SET      ',&
'      DEFINE:    All the lines in the block are treated as options to $DEFINE   ',&
'      SYSTEM:    The lines are gathered into a file and executed by the shell   ',&
'                 with the stdout being written to a scratch file and then read  ',&
'      END:       End block of specially processed text                          ',&
'                                                                                ',&
'   special-purpose modes primarily for use with the M_kracken module:           ',&
'                                                                                ',&
'      HELP:      write text as a subroutine called HELP_USAGE                   ',&
'      VERSION:   write text as a subroutine called HELP_VERSION prefixing       ',&
'                 lines with @(#) for use with the what(1) command.              ',&
'                                                                                ',&
'   If the "--file NAME" option is present the text is written to the            ',&
'   specified file unfiltered except for string expansion. This allows           ',&
'   documentation to easily be maintained in the source file. It can be          ',&
'   tex, html, markdown or any plain text. The filename will be prefixed         ',&
'   with $PREP_DOCUMENT_DIR/doc/ . If the environment variable                   ',&
'   $PREP_DOCUMENT_DIR is not set the option is ignored.                         ',&
'                                                                                ',&
'   The --file output can subsequently easily be processed by other utilities    ',&
'   such as markdown(1) or txt2man(1) to produce man(1) pages and HTML documents.',&
'   $SYSTEM commands may follow the $BLOCK block text to optionally post-process ',&
'   the doc files.                                                               ',&
'                                                                                ',&
'   $ENDBLOCK ends the block.                                                    ',&
!!!!$! which is preferred; but a blank value or "END" on a $BLOCK directive does as well.
'                                                                                ',&
' IDENTIFIERS                                                                    ',&
'   Directives for producing metadata ...                                        ',&
'                                                                                ',&
'       $IDENT|$@(#) metadata [--language fortran|c|shell]      [! comment ]     ',&
'                                                                                ',&
'   $IDENT is a special-purpose directive useful to users of SCCS-metadata.      ',&
'   The string generated can be used by the what(1) command,                     ',&
'                                                                                ',&
'   When the command line option "--ident [LANGUAGE]" is specified this directive',&
'   writes a line using SCCS-metadata format of one of the following forms:      ',&
'                                                                                ',&
'     language:                                                                  ',&
'     fortran   character(len=*),parameter::ident="@(#)metadata"                 ',&
'     c         #ident "@(#)metadata"                                            ',&
'     shell     #@(#) metadata                                                   ',&
'                                                                                ',&
'   The default language is "fortran".                                           ',&
'                                                                                ',&
'   Depending on your compiler and the optimization level used when compiling,   ',&
'   the output string may not remain in the object files and executables created.',&
'                                                                                ',&
'   If the -ident switch is not specified, a Fortran comment line is generated   ',&
'   of the form                                                                  ',&
'                                                                                ',&
'       ! ident_NNN="@(#)this is metadata"                                       ',&
'                                                                                ',&
'   "$@(#)" is an alias for "$IDENT" so the source file itself will contain      ',&
'   SCCS-metadata so the metadata can be displayed with what(1) even for the     ',&
'   unprocessed files.                                                           ',&
'                                                                                ',&
'   Do not use the characters double-quote, greater-than, backslash (ie. ">\)    ',&
'   in the metadata to remain compatible with SCCS metadata syntax.              ',&
'   Do not use strings starting with " -" either.                                ',&
'                                                                                ',&
' INFORMATION                                                                    ',&
'   Informative directives for writing messages to stderr or inserting           ',&
'   state information into the output file ...                                   ',&
'                                                                                ',&
'       $SHOW [variable_name[;...]]                          [! comment ]        ',&
'       $MESSAGE  message_to_stderr                                              ',&
'                                                                                ',&
'   Details ...                                                                  ',&
'                                                                                ',&
'       $MESSAGE  message_to_stderr                                              ',&
'                                                                                ',&
'   Write message to stderr.                                                     ',&
'   Note that messages for $MESSAGE do not treat "! " as starting a comment      ',&
'                                                                                ',&
'       $SHOW [variable_name[;...]]                          [! comment ]        ',&
'                                                                                ',&
'   Shows current state of prep(1); including variable names and values and      ',&
'   the name of the current input files. All output is preceded by an            ',&
'   exclamation character.                                                       ',&
'                                                                                ',&
'   If a list of defined variable names is present only those variables and      ',&
'   their values are shown.                                                      ',&
'                                                                                ',&
'   Basic globbing is supported, where "*" represents any string, and "?"        ',&
'   represents any single character.                                             ',&
'                                                                                ',&
'   Example:                                                                     ',&
'                                                                                ',&
'    > prep A=10 B C D -o paper                                                  ',&
'    > $define z=22                                                              ',&
'    > $show B Z                                                                 ',&
'    > $show                                                                     ',&
'    > $show H*;*H;*H*! show beginning with "H", ending with "H", containing "H" ',&
'    > $stop 0                                                                   ',&
'    >                                                                           ',&
'    > !  B  =  1                                                                ',&
'    > !  Z  =  22                                                               ',&
'    > !================================================================         ',&
'    > !                                                                         ',&
'    > ! Current state of prep(1):(18:39 20 Jun 2021)                            ',&
'    > ! Total lines read ............... 2                                      ',&
'    > ! Conditional nesting level....... 0                                      ',&
'    > ! G_WRITE (general processing).... T                                      ',&
'    > ! G_LLWRITE (write input lines)... T                                      ',&
'    > ! Arguments ...................... A=10 B C D -o paper                    ',&
'    > ! Open files:                                                             ',&
'    > !    unit ! line number ! filename                                        ',&
'    > !       5 !           2 ! @                                               ',&
'    > ! INCLUDE directories:                                                    ',&
'    > !    .                                                                    ',&
'    > ! Variables:                                                              ',&
'    > !    $DEFINE UNKNOWN  =  0                                                ',&
'    > !    $DEFINE LINUX  =  1                                                  ',&
'    > !    $DEFINE MACOS  =  2                                                  ',&
'    > !    $DEFINE WINDOWS  =  3                                                ',&
'    > !    $DEFINE CYGWIN  =  4                                                 ',&
'    > !    $DEFINE SOLARIS  =  5                                                ',&
'    > !    $DEFINE FREEBSD  =  6                                                ',&
'    > !    $DEFINE OPENBSD  =  7                                                ',&
'    > !    $DEFINE OS  =  1                                                     ',&
'    > !    $DEFINE A  =  10                                                     ',&
'    > !    $DEFINE B  =  1                                                      ',&
'    > !    $DEFINE C  =  1                                                      ',&
'    > !    $DEFINE D  =  1                                                      ',&
'    > !    $DEFINE Z  =  22                                                     ',&
'    > ! Parcels:                                                                ',&
'    > !================================================================         ',&
'                                                                                ',&
' SYSTEM COMMANDS                                                                ',&
'   Directives that execute system commands ...                                  ',&
'                                                                                ',&
'       $SYSTEM system_command                                                   ',&
'                                                                                ',&
'   If system command processing is enabled using the --system switch system     ',&
'   commands can be executed for such tasks as creating files to be read or to   ',&
'   further process documents created by $BLOCK. $SYSTEM directives are errors   ',&
'   by default; as you clearly need to ensure the input file is trusted before   ',&
'   before allowing commands to be executed. Commands that are system-specific   ',&
'   may need to be executed conditionally as well.                               ',&
'                                                                                ',&
'   Examples:                                                                    ',&
'                                                                                ',&
'    > $! build variable definitions using GNU/Linux commands                    ',&
'    > $SYSTEM echo system=`hostname` > compiled.h                               ',&
'    > $SYSTEM echo compile_time="`date`" >> compiled.h                          ',&
'    > $INCLUDE compiled.h                                                       ',&
'                                                                                ',&
'    > $if systemon      ! if --system switch is present on command line         ',&
'    > $!  obtain up-to-date copy of source file from HTTP server:               ',&
'    > $   SYSTEM wget http://repository.net/src/func.F90 -O - >_tmp.f90         ',&
'    > $   INCLUDE _tmp.f90                                                      ',&
'    > $   SYSTEM  rm _tmp.f90                                                   ',&
'    > $endif                                                                    ',&
'                                                                                ',&
'   System commands may also appear in a $BLOCK section. Combining several       ',&
'   features this uses the Linux getconf(1) command to write some lines          ',&
'   into a scratch file that are then read back in to define variables describing',&
'   the current platform.                                                        ',&
'                                                                                ',&
'    > $IF OS == LINUX                                                           ',&
'    > $                                                                         ',&
'    > $block system ! use getconf(1) command to get system values               ',&
'    > (                                                                         ',&
'    > echo LEVEL_2_CACHE_SIZE $(getconf LEVEL2_CACHE_SIZE)                      ',&
'    > echo LEVEL_3_CACHE_SIZE $(getconf LEVEL3_CACHE_SIZE)                      ',&
'    > ) >_getconf.inc                                                           ',&
'    > $endblock                                                                 ',&
'    > $block set                 ! read in output of getconf(1)                 ',&
'    > $include _getconf.inc                                                     ',&
'    > $endblock                                                                 ',&
'    > $system rm -f _getconf.inc ! cleanup                                      ',&
'    > $                                                                         ',&
'    > $ELSE                                                                     ',&
'    > $                                                                         ',&
'    > $error " ERROR: Not Linux. did not obtain system values"                  ',&
'    > $                                                                         ',&
'    > $ENDIF                                                                    ',&
'    > $! create code using values for this platform                             ',&
'    >    integer, parameter :: L2_CACHE_SZ=${LEVEL2_CACHE_SIZE}                 ',&
'    >    integer, parameter :: L3_CACHE_SZ=${LEVEL3_CACHE_SIZE}                 ',&
'                                                                                ',&
' PROGRAM TERMINATION                                                            ',&
'   Directives for stopping file processing (note there is no comment field):    ',&
'                                                                                ',&
'      $STOP     [stop_value ["message"]]                                        ',&
'      $QUIT     ["message"]                                                     ',&
'      $ERROR    ["message"]                                                     ',&
'                                                                                ',&
'   Details ...                                                                  ',&
'                                                                                ',&
'      $STOP     [stop_value ["message"]]                                        ',&
'                                                                                ',&
'   Stops the prep(1) program. The integer value will be returned as an exit     ',&
'   status value by the system where supported.                                  ',&
'                                                                                ',&
'   o A value of "0" causes normal program termination.                          ',&
'   o The default value is "1".                                                  ',&
'   o comments are not supported on these directives; the entire line following  ',&
'     the directive command becomes part of the message.                         ',&
'   o If a message is supplied it is displayed to stderr.                        ',&
'     If the value is not zero ("0") and no message is supplied the "$SHOW"      ',&
'     directive is called before stopping.                                       ',&
'   o "$QUIT" is an alias for "$STOP 0".                                         ',&
'   o "$ERROR" is a synonym for "$STOP 1"                                        ',&
'                                                                                ',&
'     >$IFNDEF TYPE                                                              ',&
'     >$STOP 10 "ERROR: ""TYPE"" not defined"                                    ',&
'     >$ENDIF                                                                    ',&
'                                                                                ',&
'LIMITATIONS                                                                     ',&
'                                                                                ',&
'   $IF constructs can be nested up to 20 levels deep. Note that using           ',&
'   more than two levels typically makes input files less readable.              ',&
'                                                                                ',&
'   $ENDBLOCK is required after a $BLOCK or --file FILENAME is not written.      ',&
'                                                                                ',&
'   Nesting of $BLOCK sections not allowed.                                      ',&
'   $INCLUDE may be nested fifty (50) levels.                                    ',&
'                                                                                ',&
'   Input files                                                                  ',&
'                                                                                ',&
'   o lines are limited to a maximum of 1024 columns. Text past the limit is     ',&
'     ignored.                                                                   ',&
'   o files cannot be concurrently opened multiple times                         ',&
'   o a maximum of 50 files can be nested by $INCLUDE                            ',&
'   o filenames cannot contain spaces on the command line.                       ',&
'                                                                                ',&
'   Variable names                                                               ',&
'                                                                                ',&
'   o are limited to 63 characters.                                              ',&
'   o must start with a letter (A-Z) or underscore(_).                           ',&
'   o are composed of the letters A-Z, digits 0-9 and _ and $.                   ',&
'   o 2048 variable names may be defined at a time.                              ',&
'                                                                                ',&
'EXAMPLES                                                                        ',&
'                                                                                ',&
'  Define variables on command line:                                             ',&
'                                                                                ',&
'  Typically, variables are defined on the command line when prep(1) is          ',&
'  invoked but can be grouped together into small files that are included        ',&
'  with a $INCLUDE or as input files.                                            ',&
'                                                                                ',&
'    > prep HP size=64 -i hp_directives.dirs test.F90 -o test_out.f90            ',&
'                                                                                ',&
'  defines variables HP and SIZE as if the expressions had been on a             ',&
'  $DEFINE and reads file "hp_directives.dirs" and then test.F90.                ',&
'  Output is directed to test_out.f90                                            ',&
'                                                                                ',&
'  Basic conditionals:                                                           ',&
'                                                                                ',&
'   > $! set variable "a" if not specified on the prep(1) command.               ',&
'   > $IF .NOT.DEFINED(A)                                                        ',&
'   > $   DEFINE a=1  ! so only define the first version of SUB(3f) below        ',&
'   > $ENDIF                                                                     ',&
'   >    program conditional_compile                                             ',&
'   >       call sub()                                                           ',&
'   >    end program conditional_compile                                         ',&
'   > $! select a version of SUB depending on the value of variable "a"          ',&
'   > $IF a .EQ. 1                                                               ',&
'   >    subroutine sub                                                          ',&
'   >       print*, "This is the first SUB"                                      ',&
'   >    end subroutine sub                                                      ',&
'   > $ELSEIF a .eq. 2                                                           ',&
'   >    subroutine sub                                                          ',&
'   >       print*, "This is the second SUB"                                     ',&
'   >    end subroutine sub                                                      ',&
'   > $ELSE                                                                      ',&
'   >    subroutine sub                                                          ',&
'   >       print*, "This is the third SUB"                                      ',&
'   >    end subroutine sub                                                      ',&
'   > $ENDIF                                                                     ',&
'                                                                                ',&
'  Common use of $BLOCK                                                          ',&
'                                                                                ',&
'   > $!                                                                         ',&
'   > $BLOCK NULL --file manual.tex                                              ',&
'   > This is a block of text that will be ignored except it is optionally       ',&
'   > written to a $PREP_DOCUMENT_DIR/doc/ file when $PREP_DOCUMENT_DIR is set.  ',&
'   > $ENDBLOCK                                                                  ',&
'   >                                                                            ',&
'                                                                                ',&
'  This is a block of text that will be converted to comments and optionally     ',&
'  appended to a $PREP_DOCUMENT_DIR/doc/ file when $PREP_DOCUMENT_DIR is set.    ',&
'                                                                                ',&
'   > $BLOCK COMMENT--file conditional_compile.man                               ',&
'   > NAME                                                                       ',&
'   >    conditional_compile - basic example for prep(1) preprocessor.           ',&
'   > SYNOPSIS                                                                   ',&
'   >    conditional_example [--help] [--version]                                ',&
'   > DESCRIPTION                                                                ',&
'   >    This is a basic example program showing how documentation can be        ',&
'   >    used to generate program help text                                      ',&
'   > OPTIONS                                                                    ',&
'   >    --help     display this help and exit                                   ',&
'   >    --version  output version information and exit                          ',&
'   > $ENDBLOCK                                                                  ',&
'                                                                                ',&
'GENERAL TEMPLATING                                                              ',&
'  A parcel can be posted multiple times, changing the value of variables        ',&
'  before each post.                                                             ',&
'                                                                                ',&
'   > $PARCEL mysub                                                              ',&
'   > subroutine mysub_${TYPE}(a,b)                                              ',&
'   > use, intrinsic :: iso_fortran_env, only : &                                ',&
'   > & real_kinds, real32,real64,real128                                        ',&
'   > implicit none                                                              ',&
'   > integer,parameter  :: wp=${TYPE}                                           ',&
'   > real(kind=wp) :: a,b                                                       ',&
'   >    write(*,*)10.0_wp                                                       ',&
'   >    write(*,*) "this is for type ${TYPE}"                                   ',&
'   > end subroutine mysub_${TYPE}                                               ',&
'   >                                                                            ',&
'   > $ENDPARCEL                                                                 ',&
'   > $set type real32                                                           ',&
'   > $post mysub                                                                ',&
'   > $set type real64                                                           ',&
'   > $post mysub                                                                ',&
'   > $set type real128                                                          ',&
'   > $post mysub                                                                ',&
'                                                                                ',&
'NOTE                                                                            ',&
'  Not documented elsewhere, note that there is a developer flag (--debug) that  ',&
'  can be useful when learning prep(1) usage (but it should not be used in       ',&
'  production). Among other things it deactivates the termination of the program ',&
'  upon detection of an error. This mode thus allows for simple interactive use. ',&
'  In addition, when in this mode entering "$HELP" produces a cribsheet, which   ',&
'  may also be displayed by "prep --crib".                                       ',&
'AUTHOR                                                                          ',&
'   John S. Urban                                                                ',&
'                                                                                ',&
'LICENSE                                                                         ',&
'   MIT                                                                          ',&
'']

version_text=[ CHARACTER(LEN=128) :: &
'@(#)PRODUCT:        GPF (General Purpose Fortran) utilities and examples>',&
'@(#)PROGRAM:        prep(1f)>',&
'@(#)DESCRIPTION:    Fortran Preprocessor>',&
!'@(#)VERSION:        4.0.0: 20170502>',&
!'@(#)VERSION:        5.0.0: 20201219>',&
!'@(#)VERSION:        8.1.1: 20220405>',&
!'@(#)VERSION:        9.0.0: 20220804>',&
!'@(#)VERSION:        9.1.0: 20220805>',&
'@(#)VERSION:        9.2.0: 20220814>',&
'@(#)AUTHOR:         John S. Urban>',&
'@(#)HOME PAGE       https://github.com/urbanjost/prep.git/>',&
'']
end subroutine setup
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
subroutine crib_help(lun) !@(#)crib_help(3f): prints abridged help information
implicit none
integer,intent(in) :: lun
character(len=:),allocatable :: help_text(:)
integer                        :: i
help_text=[ CHARACTER(LEN=128) :: &
"EXPRESSIONS                                                                     ",&
"  numeric operators are +,-,*,/,**, (). Logical operators are                   ",&
"   >  | .EQ.| .NE.| .GE.| .GT.| .LE.| .LT.|.NOT.|.AND.| .OR.| .EQV.|.NEQV.|     ",&
"   >  |  == |  /= |  >= |  >  |  <= |  <  |  !  |  && |  || |  ==  |  !=  |     ",&
"  $DEFINE variable_name[=expression][;...]                                      ",&
'   > Predefined values are "OS", which is set to a guess of the system type, and',&
"   > UNKNOWN=0 LINUX=1 MACOS=2 WINDOWS=3 CYGWIN=4 SOLARIS=5 FREEBSD=6 OPENBSD=7.",&
"   > SYSTEMON is .TRUE. if --system is present on the command line, else .FALSE.",&
"  $UNDEFINE|$UNDEF variable_name[;...]                                          ",&
"CONDITIONAL CODE SELECTION:                                                     ",&
"  $IF logical_integer-based_expression| [.NOT.] DEFINED(varname[,...])          ",&
"  $IFDEF|$IFNDEF variable_or_envname                                            ",&
"  $ELSEIF|$ELIF logical_integer-based_expression                                ",&
"  $ELSE                                                                         ",&
"  $ENDIF                                                                        ",&
"MACRO STRING EXPANSION AND TEXT REPLAY:                                         ",&
"   > Unless at least one variable name is defined no ${NAME} expansion occurs.  ",&
"  $SET varname string                                                           ",&
"  $$UNSET variable_name[;...]                                                   ",&
"  $IMPORT envname[;...]                                                         ",&
"   > $set author  William Shakespeare                                           ",&
"   > $import HOME                                                               ",&
"   > write(*,*)'${AUTHOR} ${DATE} ${TIME} File ${FILE} Line ${LINE} HOME ${HOME}",&
"  $PARCEL blockname ... $ENDPARCEL ! a reuseable parcel of expandable text      ",&
"  $POST   blockname(s)  ! insert a defined parcel of text                       ",&
"EXTERNAL FILES (see $BLOCK ... --file also)                                     ",&
"  $OUTPUT filename [--append]                                                   ",&
"  $INCLUDE filename                                                             ",&
"TEXT BLOCK FILTERS (--file writes to $PREP_DOCUMENT_DIR/doc/NAME)               ",&
"  $BLOCK [comment|null|write|variable [--varname NAME]|set|system|message|      ",&
"         define|help|version][--file NAME [--append]] ... $ENDBLOCK             ",&
"INFORMATION                                                                     ",&
"  $MESSAGE message_to_stderr                                                    ",&
"  $SHOW [defined_variable_name][;...]                                           ",&
"SYSTEM COMMANDS (see also: $BLOCK SYSTEM)                                       ",&
"  $SYSTEM command                                                               ",&
"  $STOP [stop_value[ ""message""]] | $QUIT [""message""]| $ERROR [""message""]        "]
   WRITE(lun,'(a)')(trim(help_text(i)),i=1,size(help_text))
end subroutine crib_help
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
subroutine write_out(line)  !@(#)writeout(3f):  write (most) source code lines to output file
character(len=*),intent(in)    :: line
integer                        :: istart

   if(G_verbose)then              ! echo "what" lines to stderr
      istart=index(line,'@(#)')
      if(istart.ne.0)then
         call write_err( '+ -->>'//trim(line(istart+4:)) )
      endif
   endif

   call www(line)
end subroutine write_out
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
subroutine www(line) !@(#)www(3f):  change line into a WRITE, HELP/VERSION, COMMENT output line
integer,parameter              :: linewidth=128
character(len=*),intent(in)    :: line
character(len=:),allocatable   :: buff
character(len=115)             :: chunk
integer                        :: ilength
integer                        :: ios
integer                        :: ierr
character(len=256)             :: message
character(len=G_var_len)       :: value

   ierr=0
   select case(trim(G_outtype))

   case('comment')                             ! write as a Fortran comment preceded by two explanations and a space
                                               ! will be written later at end of BLOCK section

   case('null')                                ! do not write

   case('set','replace')                       ! do not write
      call set(line)

   case('define')                              ! do not write
      call expr(nospace(upper(line)),value,ierr,def=.true.)    ! only process DEFINE if not skipping data lines

   case('redefine')                            ! do not write
      call expr(nospace(upper(line)),value,ierr,def=.true.)    ! only process DEFINE if not skipping data lines

   case('message')                             ! do not write
      call write_err(line)                     ! trustingly trim MESSAGE from directive

   case('system')
      write(G_scratch_lun,'(a)',iostat=ios,iomsg=message)trim(line)
      if(ios.lt.0)then
         call stop_prep(033,'failed to write to process:',trim(line)//':'//trim(message))
      endif

   case('variable')
      buff=trim(line)                                 ! do not make a line over 132 characters. Trim input line if needed
      buff=buff//repeat(' ',max(linewidth,len(buff))) ! ensure space in buffer for substitute
      call substitute(buff,"'","''")                  ! change single quotes in input to two adjacent single quotes
      ilength=min(len_trim(buff),linewidth)           ! make all lines have at least linewidth characters for a more legible output
      write(G_iout,'("''",a,"'',&")') buff(:ilength)

   case('help')
      buff=trim(line)                                    ! do not make a line over 132 characters. Trim input line if needed
      buff=buff//repeat(' ',max(linewidth,len(buff)))    ! ensure space in buffer for substitute
      call substitute(buff,"'","''")                     ! change single quotes in input to two adjacent single quotes
      ilength=max(len_trim(buff),linewidth)              ! make all lines have at least 80 characters for a more legible output
      write(G_iout,'("''",a,"'',&")') buff(:ilength)

   case('version')                             ! write version information with SCCS ID prefix for use with what(1) command
      write(G_iout,'("''@(#)",a,"'',&")')trim(line(:min(len_trim(line),128-1)))//'>'

                                               !x! should handle longer lines and split them
   case('write')                               ! convert string to a Fortran write statement to unit "IO"
      buff=trim(line)                          ! do not make a line over 132 characters. Trim input line if needed
      buff=buff//repeat(' ',max(linewidth,len(buff))) ! ensure space in buffer for substitute
      call substitute(buff,"'","''")
      write(G_iout,'(a)',advance='no')'write(io,''(a)'')'''
      chunk=buff
      write(G_iout,'(a)',advance='no')trim(chunk)
      write(G_iout,'(a)')''''

   case('','asis')
      write(G_iout,'(a)')trim(line(:min(len(line),G_iwidth)))

   case default
      call stop_prep(034,'unexpected "BLOCK" value. Found:',trim(G_source))
      call stop_prep(035,'unexpected "BLOCK" value. Found:',trim(G_outtype))

   end select

   if(ierr.ne.0) call stop_prep(036,'expression invalid:',trim(G_source))

   if(G_MAN_COLLECT)then
      G_MAN=G_MAN//new_line('N')//trim(line)
   endif

   G_comment_count=G_comment_count+1

end subroutine www
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
subroutine write_err(msg) !@(#)M_verify::write_err(3f): writes a message to standard error using a standard f2003 method
character(len=*),intent(in) :: msg
integer                     :: ios

   write(stderr,'(a)',iostat=ios) trim(msg)
   call flushit()
end subroutine write_err
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
subroutine dissect2(verb,init,pars,error_return) !@(#)dissect2(3f): convenient call to parse() -- define defaults, then process
!
character(len=*),intent(in)  :: verb             ! the name of the command to be reset/defined  and then set
character(len=*),intent(in)  :: init             ! used to define or reset command options; usually hard-set in the program.
character(len=*),intent(in)  :: pars             ! defines the command options to be set, usually from a user input file
integer,intent(out),optional :: error_return
   !call dissect(verb,init,pars,len(pars),error_return)
   call set_args(init,string=pars//'--')
   !call print_dictionary()
end subroutine dissect2
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
subroutine import(line)
character(len=*),intent(in)  :: line
character(len=:),allocatable :: names(:)
integer                      :: i
   names=sep(line,' ,;')
   do i=1,size(names)
      call set(names(i)//' '//get_env(names(i)))
   enddo
end subroutine import
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
subroutine set(line)
character(len=*),intent(in)  :: line
character(len=:),allocatable :: temp
character(len=:),allocatable :: name
character(len=:),allocatable :: val
integer                      :: iend
! create a dictionary with character keywords, values, and value lengths
! using the routines for maintaining a list

  temp=adjustl(line)
  iend=merge(len(temp),index(temp,' '),index(temp,' ').eq.0)
  name=adjustl(upper(temp(:iend)))

  if(name.ne.'')then
    if(len(temp).gt.iend)then
       val=temp(min(iend+1,len(temp)):)
       call check_name(name)
       if(val.eq.' ')val='1'
       call macro%set(name,val) ! insert and replace entries
    else
    endif
  else
       call stop_prep(037,'incomplete set:',trim(G_SOURCE))
  endif

end subroutine set
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
subroutine expand_variables(line)
!@(#) brute force variable substitution. maybe add something like wordexp(3c) with command expansion only if --system?
! this is just to try the concept. Either use wordexp or an equivalent to replicate "here document" processing.
! note no automatic continuation of the line if it extends past allowed length, which for Fortran is currently 132 for free-format
! the way this is written it would do recursive substitution and does not know when there is just not a match
character(len=*)              :: line
character(len=:),allocatable  :: temp,search
integer                       :: i
integer                       :: j
integer                       :: ibug
character(len=4096)           :: scratch

if(index(line,'${').ne.0)then
   write(scratch,'(i0)')G_file_dictionary(G_iocount)%line_number
   call set('LINE ' // scratch)
   call set('FILE ' // G_file_dictionary(G_iocount)%filename )
   call set('TIME ' // getdate('time'))
   call set('DATE ' // getdate('cdate'))
   call set('PROCEDURE ' // 'PROCNAME')
   temp=trim(line)
   ibug=minval([size(macro%key),ubound(macro%key)])   ! print variable dictionary
   INFINITE: do i=1,len_trim(line)
      do j=1,ibug
         if(index(temp,'${').ne.0)then
            search='${'//trim(macro%key(j))//'}'
            temp=str_replace(temp,search,macro%value(j)(:macro%count(j)),ignorecase=.true.)
         else
            exit INFINITE
         endif
      enddo
   enddo INFINITE
   line=temp
endif

end subroutine expand_variables
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
!> Determine the OS type by guessing
subroutine get_os_type()
!!
!! At first, the environment variable `OS` is checked, which is usually
!! found on Windows. Then, `OSTYPE` is read in and compared with common
!! names. If this fails too, check the existence of files that can be
!! found on specific system types only.
!!
!! Returns OS_UNKNOWN if the operating system cannot be determined.
!!
!! calling POSIX or C routines would be far better, M_system::like system_uname(3f)
!! but trying to use portable Fortran. If assume compiled by certain compilers could
!! use their extensions as well. Most have a uname(3f) function.
!!
integer, parameter :: OS_UNKNOWN = 0
integer, parameter :: OS_LINUX   = 1
integer, parameter :: OS_MACOS   = 2
integer, parameter :: OS_WINDOWS = 3
integer, parameter :: OS_CYGWIN  = 4
integer, parameter :: OS_SOLARIS = 5
integer, parameter :: OS_FREEBSD = 6
integer, parameter :: OS_OPENBSD = 7
character(len=G_var_len) :: val
integer           :: r
logical           :: file_exists
character(len=80) :: scratch

   call put( 'UNKNOWN=0' )
   call put( 'LINUX=1' )
   call put( 'MACOS=2' )
   call put( 'WINDOWS=3' )
   call put( 'CYGWIN=4' )
   call put( 'SOLARIS=5' )
   call put( 'FREEBSD=6' )
   call put( 'OPENBSD=7' )

   r = OS_UNKNOWN
   ! Check environment variable `OS`.
   val=get_env('OS')
   if ( index(val, 'Windows_NT') > 0) then
       r = OS_WINDOWS
   else
      ! Check environment variable `OSTYPE`.
      val=get_env('OSTYPE')
      if (val.ne.'') then
          if (index(val, 'linux') > 0) then      ! Linux
              r = OS_LINUX
          elseif (index(val, 'darwin') > 0) then ! macOS
              r = OS_MACOS
          elseif (index(val, 'win') > 0 .or. index(val, 'msys') > 0) then ! Windows, MSYS, MinGW, Git Bash
              r = OS_WINDOWS
          elseif (index(val, 'cygwin') > 0) then ! Cygwin
              r = OS_CYGWIN
          elseif (index(val, 'SunOS') > 0 .or. index(val, 'solaris') > 0) then ! Solaris, OpenIndiana, ...
              r = OS_SOLARIS
          elseif (index(val, 'FreeBSD') > 0 .or. index(val, 'freebsd') > 0) then ! FreeBSD
              r = OS_FREEBSD
          elseif (index(val, 'OpenBSD') > 0 .or. index(val, 'openbsd') > 0) then ! OpenBSD
              r = OS_OPENBSD
          endif
      endif
   endif
   if(r.eq.OS_UNKNOWN)then
      inquire (file='/etc/os-release', exist=file_exists) ! Linux
      if (file_exists) r = OS_LINUX
      inquire (file='/usr/bin/sw_vers', exist=file_exists) ! macOS
      if (file_exists) r = OS_MACOS
      inquire (file='/bin/freebsd-version', exist=file_exists) ! FreeBSD
      if (file_exists) r = OS_FREEBSD
   endif
   scratch=' '
   write(scratch,'("OS=",i0)')r
   call put(scratch)
end subroutine get_os_type
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
pure function ends_in(string) result(ending)
character(*), intent(in)  :: string
character(:), allocatable :: ending
integer                   :: n1
   n1=index(string,'.',back=.true.)
   if (n1 < 1 .or. n1.eq.len(string) ) then
       ending=''
   else
       ending=string(n1+1:)
   endif
end function ends_in
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
subroutine flushit()
integer :: ios
      flush(unit=stdout,iostat=ios)
      flush(unit=stderr,iostat=ios)
end subroutine flushit
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
subroutine put(opts)                                 !@(#)expr_short(3f): call expr with just an expression
character(len=*),intent(in)  :: opts
character(len=G_var_len)     :: value
integer                      :: ierr
character(len=G_line_length) :: expression
expression=upper(opts)
call expr(expression,value,ierr,def=.true.)
if(ierr.ne.0) call stop_prep(038,'expression invalid:',trim(G_source))
end subroutine put
end module M_prep
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
program prep                                                 !@(#)prep(1f): preprocessor for Fortran/Fortran source code
use M_CLI2, only : set_args, lget, rget, iget, SGET !JSU kracken_comment
use M_strings,   only : notabs, isdigit, switch, sep
use M_io, only : getname, basename
use M_prep
implicit none
character(len=G_line_length) :: out_filename=''           ! output filename, default is stdout
character(len=1)             :: prefix                    ! directive prefix character
character(len=1)             :: letterd                   !
character(len=G_line_length) :: line                      ! working copy of input line
logical                      :: keeptabs=.false.          ! flag whether to retain tabs and carriage returns or not
integer                      :: ilast
integer                      :: ios
character(len=:),allocatable :: help_text(:)
character(len=:),allocatable :: version_text(:)
character(len=:),allocatable :: string
character(len=:),allocatable :: cmd
logical                      :: isscratch
   cmd='&
   & -i " "              &
   & -D " "              &
   & -I " "              &
   & -o " "              &
   & --prefix 36         &
   & --keeptabs .false.  &
   & -d ignore           &
   & --help .false.      &
   & --verbose .false.   &
   & --system .false.    &
   & --version .false.   &
   & --crib .false.      &
   & --debug .false.     &
   & --noenv .false.     &
   & --comment "'//get_env('PREP_COMMENT_STYLE','default')//'" &
   & --ident .false.     &
   & --width 1024        &
   & --start " "         &
   & --stop " "          &
   & --special .false.   &
   & --type auto         &
   & --lang "'//get_env('PREP_LANGUAGE','en')//'" &
   & '
   ! allow formatting comments for particular post-processors
   G_comment='! '
   !JSUkracken_comment=G_comment
   call setup(help_text,version_text)
   call set_args(cmd,help_text,version_text)                ! define command arguments, default values and crack command line
!  cpp>=========================================================================
   ! decide whether to act like cpp or not
   if(specified('i').or.size(unnamed).gt.2)then
      G_cpp=.false.
   else
      if(size(unnamed).gt.0)then
         if(exists(unnamed(1)))then
            G_cpp=.true.
         else
            G_cpp=.false.
         endif
      else
         G_cpp=.true.
      endif
   endif
!  cpp<=========================================================================
   string=adjustl(trim(SGET('prefix')))
   if ( all( isdigit(switch(string)) ) ) then               ! if all characters are numeric digits
      prefix = char(iget('prefix'))                         ! assume this is an ADE
   else
      prefix(1:1) = trim(SGET('prefix'))                    ! not a digit so not an ADE so assume a literal character
   endif

   G_inc_files=' '

   G_lang=sget('lang')                                      ! preferred message language
   G_ident=lget('ident')                                    ! write IDENT as comment or CHARACTER variable
   G_iwidth                   = iget('width')
   G_iwidth=max(0,G_iwidth)
   letterd(1:1)               = trim(SGET('d'))
   G_noenv                    = lget('noenv')

   out_filename(:G_line_length) = SGET('o')

   if(G_cpp .and. out_filename == '' )then
      if(size(unnamed).eq.2) out_filename=unnamed(2)
   endif

   if(out_filename.eq.'')then                                    ! open output file
      G_iout=stdout
   elseif(out_filename.eq.'@')then
      G_iout=stdout
      G_IHELP=stdout
   else
      G_iout=60
      G_IHELP=60
      open(unit=60,file=out_filename,iostat=ios,action='write')
      if(ios.ne.0)then
         call stop_prep(039,'failed to open output file:',trim(out_filename))
      endif
   endif
   G_iout_init=G_iout

   if(lget('crib'))then
      call crib_help(stdout)
      stop
   endif
   G_debug=lget('debug')                              ! turn on debug mode for developer

   keeptabs=lget('keeptabs')
   G_verbose=lget('verbose')                          ! set flag for special mode where lines with @(#) are written to stderr
   if(G_verbose)then
      call write_err('+ verbose mode on ')
   endif
   G_comment_style=lower(SGET('comment'))             ! allow formatting comments for particular post-processors
   G_system_on = lget('system')                       ! allow system commands on $SYSTEM directives
   if(G_system_on)then
      call put('SYSTEMON=.TRUE.')
   else
      call put('SYSTEMON=.FALSE.')
   endif
   !TODO! have an auto mode where start and end are selected based on file suffix
   G_extract_start0=''
   G_extract_stop0=''
   select case(SGET('type'))
   case('md','.md')
      G_extract_start='```fortran'
      G_extract_stop='```'
   case('html','.html','htm','.htm')
      ! flaw is HTML is not case sensitive
      G_extract_start='<xmp>'
      G_extract_stop='</xmp>'
   case('tex')
      G_extract_start='\begin{minted}{Fortran}'
      G_extract_stop='\end{minted}'
   case('auto')
      G_extract_start=''
      G_extract_stop=''
      G_extract_auto=.true.
      G_extract=.true.
   case('none')
      G_extract_start=''
      G_extract_stop=''
      G_extract_auto=.false.
      G_extract=.false.
   case default
      G_extract_start=trim(SGET('start'))
      G_extract_stop=trim(SGET('stop'))
      G_extract_start0=G_extract_start
      G_extract_stop0=G_extract_stop
   end select
   if(G_extract_start.ne.''.or.G_extract_stop.ne.'')G_extract=.true.

   call get_os_type()
!cpp>==============================================================================
   call defines()                                          ! define named variables declared on the command line
!<cpp==============================================================================
   call includes()                                         ! define include directories supplies on command line
!cpp>==============================================================================
   call opens()                                            ! convert input filenames into $include directives
!<cpp==============================================================================
   call auto()

   READLINE: do                                            ! read loop to read input file
      read(G_file_dictionary(G_iocount)%unit_number,'(a)',end=7) line
      if(G_extract)then                                    ! in extract mode
         if(line.eq.G_extract_start)then                   ! start extracting
            G_extract_flag=.true.
            cycle READLINE
         elseif(line.eq.G_extract_stop.and.G_extract_flag)then        ! stop extracting
            G_extract_flag=.false.
            cycle READLINE
         elseif(.not.G_extract_flag)then                   ! skip if not extracting
            cycle READLINE
         endif
      endif
      !TODO! should line count include skipped lines?
      G_io_total_lines=G_io_total_lines+1
      G_file_dictionary(G_iocount)%line_number=G_file_dictionary(G_iocount)%line_number+1

      if(keeptabs)then
         G_source=line
      else
         call notabs(line,G_source,ilast)                  ! expand tab characters and trim trailing ctrl-M from DOS files
      endif

      if(G_inparcel)then                                   ! do not expand lines stored in a parcel
      elseif(size(macro%key).ne.0)then                     ! expand variables if any variable is defined, else skip for efficieny
         call expand_variables(G_source)                   ! expand ${NAME} strings
      endif

      select case (line(1:1))                              ! special processing for lines starting with 'd' or 'D'
      case ('d','D')
         select case(letterd(1:1))
         case('i')                                         ! ignore
         case('r')                                         ! remove
            cycle
         case('b',' ')                                     ! blank
            line(1:1)=' '
         case('c')                                         ! comment
            line(1:1)='C'
         case('e')                                         ! exclamation
            line(1:1)='!'
         end select
      end select

      if (line(1:1).eq.prefix.and.line(2:2).ne.'{') then   ! prefix must be in column 1 for conditional compile directive
         call cond()                                       ! process directive
      elseif (G_write) then                                ! if last conditional was true then write line
         call write_out(trim(G_source))                    ! write data line
      endif
      cycle

7     continue                                                      ! end of file encountered on input
      if(G_file_dictionary(G_iocount)%unit_number.ne.5)then
         inquire(unit=G_file_dictionary(G_iocount)%unit_number,iostat=ios,named=isscratch)
         if(.not.isscratch.and.(G_file_dictionary(G_iocount)%unit_number.gt.0))then
            close(G_file_dictionary(G_iocount)%unit_number,iostat=ios)
         elseif(isscratch.or.(G_file_dictionary(G_iocount)%unit_number.lt.-1))then
            rewind(unit=G_file_dictionary(G_iocount)%unit_number,iostat=ios)
         endif
      endif

      G_iocount=G_iocount-1
      if(G_scratch_lun.ne.-1)then
         ios=filedelete(G_scratch_file//'.out')
         G_scratch_lun=-1
      endif

      if(G_iocount.lt.1)exit
      call auto() ! if in auto mode determine strings for new file

   enddo READLINE

   if (G_nestl.ne.0) then                                           ! check to make sure all if blocks are closed
      call stop_prep(040,'block not closed in',' $IF')
   endif
   call print_comment_block()

   contains

subroutine auto()
   if(G_extract_auto)then
      select case(ends_in(G_file_dictionary(G_iocount)%filename) )
      case('md','.md')
         G_extract_start='```fortran'
         G_extract_stop='```'
      case('tex')
         G_extract_start='\begin{minted}{Fortran}'
         G_extract_stop='\end{minted}'
      case('html','.html','htm','.htm')
         G_extract_start='<xmp>'
         G_extract_stop='</xmp>'
      case default
         G_extract_start=G_extract_start0
         G_extract_stop=G_extract_stop0
      end select
      if(G_extract_start.eq.''.and.G_extract_stop.eq.'')then
         G_extract=.false.
      else
         G_extract=.true.
      endif
   endif
end subroutine auto

logical function exists(filename) result(r)
character(len=*), intent(in) :: filename
    inquire(file=filename, exist=r)
end function

!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================
end program prep
!===================================================================================================================================
!()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()()!
!===================================================================================================================================