bmw_commandline_parser.f

Go to the documentation of this file.

!-------------------------------------------------------------------------------
!  The @header2, @begin_table, @item3 and @end_table commands are custom defined
!  commands in Doxygen.in. They are defined under ALIASES. For the page created
!  here, the 80 column limit is exceeded. Arguments of aliases are separated by
!  ','. If you intended ',' to be a string you must use an escaped comma '\,'.
!
!-------------------------------------------------------------------------------
!*******************************************************************************
!
!  Note separating the Doxygen comment block here so detailed decription is
!  found in the Module not the file.
!
!*******************************************************************************
 
      MODULE bmw_commandline_parser
      USE stel_kinds
      USE file_opts, only: path_length
      USE profiler
      USE bmw_parallel_context
 
      IMPLICIT NONE
 
!*******************************************************************************
!  bmw_commandline parser module parameters
!*******************************************************************************
      INTEGER, PARAMETER, PRIVATE :: max_arg_length = 8
      INTEGER, PARAMETER, PRIVATE :: max_length = path_length                  &
     &                                          + max_arg_length + 1
 
!  Commandline parser error codes.
      INTEGER, PARAMETER :: bmw_commandline_parser_no_error      = 0
      INTEGER, PARAMETER :: bmw_commandline_parser_arg_not_found = -1
 
!*******************************************************************************
!  DERIVED-TYPE DECLARATIONS
!  1) bmw_commandline parser base class
!
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      TYPE bmw_commandline_parser_class
         CHARACTER (len=max_length) :: command
         CHARACTER (len=max_arg_length), DIMENSION(:), POINTER ::              &
     &      arg => null()
         CHARACTER (len=path_length), DIMENSION(:), POINTER ::                 &
     &      value => null()
      END TYPE
 
      CONTAINS
!*******************************************************************************
!  CONSTRUCTION SUBROUTINES
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION bmw_commandline_parser_construct(parallel)
 
      IMPLICIT NONE
 
!  Declare Arguments
      TYPE (bmw_commandline_parser_class), POINTER  ::                         &
     &   bmw_commandline_parser_construct
      TYPE (bmw_parallel_context_class), INTENT(in) :: parallel
 
!  local variables
      CHARACTER (len=max_length) :: temp
      INTEGER                    :: num_args, i, value_index
      REAL (rprec)               :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      temp = ''
      num_args = 0
      value_index = 0
      ALLOCATE(bmw_commandline_parser_construct)
 
!  Read the zeroith arg to get the number of arguments. This should also be the
!  command name.
      CALL getcarg(0, bmw_commandline_parser_construct%command,                &
     &             num_args)
 
      IF (num_args .le. 0 .and. parallel%offset .eq. 0) THEN
         CALL bmw_commandline_parser_print_help
      END IF
 
!  Allocate the arrays and
      ALLOCATE(bmw_commandline_parser_construct%arg(num_args))
      ALLOCATE(bmw_commandline_parser_construct%value(num_args))
 
!  Loop through the command line arguments, and setup the argument and value
!  arrays
      DO i = 1, num_args
         CALL getcarg(i, temp, num_args)
 
!  Check for a - as the first character.
         IF (temp(1:1) .eq. '-') THEN
            value_index = index(temp, '=')
            IF (value_index .eq. 0) THEN
!  Check for help command.
               IF (trim(temp) .eq. '-h' .and.                                  &
     &             parallel%offset .eq. 0) THEN
                  CALL bmw_commandline_parser_print_help
               END IF
 
               bmw_commandline_parser_construct%arg(i) = trim(temp)
               bmw_commandline_parser_construct%value(i) = ''
            ELSE
               bmw_commandline_parser_construct%arg(i) =                       &
     &            temp(1:value_index - 1)
               bmw_commandline_parser_construct%value(i) =                     &
     &            temp(value_index + 1:len_trim(temp))
            END IF
          END IF
 
          CALL bmw_commandline_parser_flag_requires_value(                     &
     &            bmw_commandline_parser_construct, i)
      END DO
 
      CALL profiler_set_stop_time('bmw_commandline_parser_construct',          &
     &                            start_time)
 
      END FUNCTION
 
!*******************************************************************************
!  DESTRUCTION SUBROUTINES
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      SUBROUTINE bmw_commandline_parser_destruct(this)
 
      IMPLICIT NONE
 
!  Declare Arguments
      TYPE (bmw_commandline_parser_class), POINTER :: this
 
!  Start of executable code
      IF (ASSOCIATED(this%arg)) THEN
         DEALLOCATE(this%arg)
         this%arg => null()
      END IF
 
      IF (ASSOCIATED(this%value)) THEN
         DEALLOCATE(this%value)
         this%value => null()
      END IF
 
      DEALLOCATE(this)
 
      END SUBROUTINE
 
!*******************************************************************************
!  GETTER SUBROUTINES
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION bmw_commandline_parser_get_string(this, arg)
 
      IMPLICIT NONE
 
!  Declare Arguments
      CHARACTER (len=path_length) :: bmw_commandline_parser_get_string
      TYPE (bmw_commandline_parser_class), INTENT(in) :: this
      CHARACTER (len=*), INTENT(in)                   :: arg
 
!  Local arguments
      INTEGER                                         :: i
      REAL (rprec)                                    :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
!  Loop through the arguments until the correct arg is found.
      bmw_commandline_parser_get_string = ''
 
      IF (ASSOCIATED(this%arg)) THEN
         DO i = 1, SIZE(this%arg)
            IF (trim(this%arg(i)) .eq. trim(arg)) THEN
               bmw_commandline_parser_get_string = this%value(i)
 
               CALL profiler_set_stop_time(                                    &
     &                 'bmw_commandline_parser_get_string', start_time)
 
               RETURN
            END IF
         END DO
      END IF
 
      CALL profiler_set_stop_time('bmw_commandline_parser_get_string',         &
     &                            start_time)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION bmw_commandline_parser_get_integer(this, arg,                   &
     &                                        default_value)
 
      IMPLICIT NONE
 
!  Declare Arguments
      INTEGER :: bmw_commandline_parser_get_integer
      TYPE (bmw_commandline_parser_class), INTENT(in) :: this
      CHARACTER (len=*), INTENT(in)                   :: arg
      INTEGER, INTENT(in)                             :: default_value
 
!  Local arguments
      CHARACTER (len=path_length)                     :: value
      INTEGER                                         :: status
      REAL (rprec)                                    :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      value = bmw_commandline_parser_get_string(this, arg)
 
      IF (trim(value) .eq. '') THEN
         bmw_commandline_parser_get_integer = default_value
 
         CALL profiler_set_stop_time(                                          &
     &           'bmw_commandline_parser_get_integer', start_time)
 
         RETURN
      END IF
 
      READ (value,1000,iostat=status) bmw_commandline_parser_get_integer
 
      IF (status .ne. 0) THEN
         bmw_commandline_parser_get_integer = default_value
      END IF
 
      CALL profiler_set_stop_time('bmw_commandline_parser_get_integer',        &
     &                            start_time)
 
1000  FORMAT(i20)
 
      END FUNCTION
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION bmw_commandline_parser_get_real(this, arg, default_value)
 
      IMPLICIT NONE
 
!  Declare Arguments
      REAL (rprec) :: bmw_commandline_parser_get_real
      TYPE (bmw_commandline_parser_class), INTENT(in) :: this
      CHARACTER (len=*), INTENT(in)                   :: arg
      REAL (rprec), INTENT(in)                        :: default_value
 
!  Local arguments
      CHARACTER (len=path_length)                     :: value
      INTEGER                                         :: status
      REAL (rprec)                                    :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      value = bmw_commandline_parser_get_string(this, arg)
 
      IF (trim(value) .eq. '') THEN
         bmw_commandline_parser_get_real = default_value
 
         CALL profiler_set_stop_time('bmw_commandline_parser_get_real',        &
     &                               start_time)
 
         RETURN
      END IF
 
      READ (value,*,iostat=status) bmw_commandline_parser_get_real
 
      IF (status .ne. 0) THEN
         bmw_commandline_parser_get_real = default_value
      END IF
 
      CALL profiler_set_stop_time('bmw_commandline_parser_get_real',           &
     &                            start_time)
 
      END FUNCTION
 
!*******************************************************************************
!  QUERY SUBROUTINES
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      FUNCTION bmw_commandline_parser_is_flag_set(this, arg)
 
      IMPLICIT NONE
 
!  Declare Arguments
      LOGICAL :: bmw_commandline_parser_is_flag_set
      TYPE (bmw_commandline_parser_class), INTENT(in) :: this
      CHARACTER (len=*), INTENT(in)                   :: arg
 
!  Local arguments
      INTEGER                                         :: i
      REAL (rprec)                                    :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
!  Loop through the arguments until the correct arg is found.
      bmw_commandline_parser_is_flag_set = .false.
 
      IF (ASSOCIATED(this%arg)) THEN
         DO i = 1, SIZE(this%arg)
            IF (trim(this%arg(i)) .eq. trim(arg)) THEN
               bmw_commandline_parser_is_flag_set = .true.
 
               CALL profiler_set_stop_time(                                    &
     &                 'bmw_commandline_parser_is_flag_set', start_time)
 
               RETURN
            END IF
         END DO
      END IF
 
      CALL profiler_set_stop_time('bmw_commandline_parser_is_flag_set',        &
     &                            start_time)
 
      END FUNCTION
 
!*******************************************************************************
!  UTILITY SUBROUTINES
!*******************************************************************************
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      SUBROUTINE bmw_commandline_parser_flag_requires_value(this, index)
 
      IMPLICIT NONE
 
!  Declare Arguments
      TYPE (bmw_commandline_parser_class), INTENT(in) :: this
      INTEGER, INTENT(in)                             :: index
 
!  Local arguments
      REAL (rprec)                                    :: start_time
 
!  Start of executable code
      start_time = profiler_get_start_time()
 
      SELECT CASE (trim(this%arg(index)))
 
         CASE ('-mgridf','-woutf','-siestaf','-outf','-logf')
            IF (trim(this%value(index)) .eq. '') THEN
               WRITE (*,1000) trim(this%arg(index)),                           &
     &                        trim(this%arg(index))
 
               CALL bmw_commandline_parser_print_help
            END IF
 
      END SELECT
 
      CALL profiler_set_stop_time(                                             &
     &        'bmw_commandline_parser_flag_requires_value', start_time)
 
1000  FORMAT(a,' flag requires value. Usage: ',a,'=value')
 
      END SUBROUTINE
 
!-------------------------------------------------------------------------------
!-------------------------------------------------------------------------------
      SUBROUTINE bmw_commandline_parser_print_help
 
      IMPLICIT NONE
 
!  Start of executable code
!  All command line messages need to fit within this width.
!                '           s              c                          '
      WRITE(*,*) '                                                     '
      WRITE(*,*) '                         BMW                         '
      WRITE(*,*) '                                                     '
      WRITE(*,*) 'Usage: xbmw [-arg][=option] ...                      '
      WRITE(*,*) '                                                     '
      WRITE(*,*) 'Options:                                             '
      WRITE(*,*) 'All options are displayed as [arg][takesoption][text]'
      WRITE(*,*) '  -h       N Display this information                '
      WRITE(*,*) '                                                     '
      WRITE(*,*) '  -mgridf  Y Specify the mgrid file name.            '
      WRITE(*,*) '                                                     '
      WRITE(*,*) '  -woutf   Y Specify the wout file name.             '
      WRITE(*,*) '                                                     '
      WRITE(*,*) '  -siestaf Y Specify the siesta restart file name.   '
      WRITE(*,*) '             When this flag is used, plasma currents '
      WRITE(*,*) '             are computed from siesta fields instead '
      WRITE(*,*) '             instead of vmec fields. Overrides the   '
      WRITE(*,*) '             -ju and -jv flags.                      '
      WRITE(*,*) '                                                     '
      WRITE(*,*) '  -outf    Y Specify the output file name.           '
      WRITE(*,*) '                                                     '
      WRITE(*,*) '  -logf    Y Write screen output to a log file.      '
      WRITE(*,*) '                                                     '
      WRITE(*,*) '  -jv      N Force balance j^v from curl derived j^u.'
      WRITE(*,*) '             Overrdes the -ju flag.                  '
      WRITE(*,*) '                                                     '
      WRITE(*,*) '  -ju      N Force balance j^u from curl derived j^v.'
      WRITE(*,*) '                                                     '
!     WRITE(*,*) '  -p_start Y Starting phi index to compute fields. If'
!     WRITE(*,*) '             this flag is not set, default to index  '
!     WRITE(*,*) '             1.                                      '
!     WRITE(*,*) '                                                     '
!     WRITE(*,*) '  -p_end   Y Ending phi index to compute fields. If  '
!     WRITE(*,*) '             this flag is not set, default to the    '
!     WRITE(*,*) '             last index.                             '
!     WRITE(*,*) '                                                     '
!$    WRITE(*,*) '  -para    Y Determines number of threads threads to '
!$    WRITE(*,*) '             run with. A value of -1 means use the   '
!$    WRITE(*,*) '             default number of threads.              '
!$    WRITE(*,*) '                                                     '
!     WRITE(*,*) '                                                     '
!     WRITE(*,*) '  -force   N Force override of error conditions. To  '
!     WRITE(*,*) '             prevent loss of valid data, BMW will    '
!     WRITE(*,*) '             terminate if an error condition is      '
!     WRITE(*,*) '             triggerd. This flag overrides that error'
!     WRITE(*,*) '             potential overwritting valid data.      '
!     WRITE(*,*) '                                                     '
 
      CALL bmw_parallel_context_abort(0)
 
      END SUBROUTINE
 
      END MODULE