read_namelist.f

Go to the documentation of this file.

!vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
!                                                                      !
!     Module name: READ_NAMELIST(POST)                                 !
!     Author: P. Nicoletti                            Date: 25-NOV-91  !
!                                                                      !
!     Purpose: Read in the NAMELIST variables                          !
!                                                                      !
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
      SUBROUTINE read_namelist(READ_ACTION, FILENAME)

      USE bc
      USE cdist
      USE compar
      USE constant
      USE cutcell
      USE dashboard
      USE des_bc
      USE des_rxns
      USE des_thermo
      USE discretelement
      USE error_manager
      USE fldvar
      USE funits
      USE geometry
      USE ic
      USE indices
      USE is
      USE iterate, only: max_nit
      USE leqsol
      USE main, only: cmd_line_args, cmd_line_args_count
      USE mfix_pic
      USE output
      USE parallel
      USE param1, only: undefined
      USE particle_filter
      USE physprop
      USE pic_bc
      USE polygon
      USE ps
      USE qmom_kinetic_equation
      USE quadric
      USE residual
      USE run
      USE rxns
      USE scalars
      USE scales
      USE stiff_chem
      USE toleranc
      USE ur_facs
      USE usr
      USE utilities
      USE vtk
      Use stl
      use usr_prop, only: usr_fgs, usr_fss, usr_gama
      use usr_prop, only: usr_rog, usr_cpg, usr_mug, usr_kg, usr_difg
      use usr_prop, only: usr_ros, usr_cps, usr_mus, usr_ks, usr_difs
      use usr_src, only: call_usr_source
      IMPLICIT NONE

! Dummy Arguments:
!------------------------------------------------------------------------//
! Specify how much of the input to process.
      INTEGER, INTENT(IN) :: READ_ACTION

! Filename of the input file
      CHARACTER(LEN=*), INTENT(IN) :: FILENAME

! Local Variables:
!------------------------------------------------------------------------//
! LINE_STRING(1:MAXCOL) has valid input data
      INTEGER, PARAMETER :: MAXCOL = 80
! Holds one line in the input file
      CHARACTER(LEN=512) :: LINE_STRING
! Length of noncomment string
      INTEGER :: LINE_LEN
! Line number
      INTEGER :: LINE_NO
! Coefficient of restitution (old symbol)
      DOUBLE PRECISION   e
! Indicates whether currently reading rxns or rate
      LOGICAL :: RXN_FLAG
! Indicate whether to do a namelist read on the line
      LOGICAL :: READ_FLAG
! Logical to check if file exits.
      LOGICAL :: lEXISTS
! Error flag
      LOGICAL :: ERROR

      CHARACTER(len=256) :: STRING
      INTEGER :: IOS, II

! Flags restricting what data from the mfix.dat to process
      LOGICAL :: READ_LOCKED, READ_FULL

! Local Parameters:
!---------------------------------------------------------------------//
      INTEGER, PARAMETER :: READ_MFIX = 0
      INTEGER, PARAMETER :: READ_POST = 1
      INTEGER, PARAMETER :: READ_INIT = 2

! External Functions
!---------------------------------------------------------------------//
! Returns integer if data past column MAXCOL.
!      INTEGER, EXTERNAL :: LINE_TOO_BIG
! Integer function which returns COMMENT_INDEX
!      INTEGER, EXTERNAL :: SEEK_COMMENT
! Blank line function
!      LOGICAL, EXTERNAL :: BLANK_LINE

      e = undefined
      rxn_flag = .false.
      read_flag = .true.
      no_of_rxns = 0
      line_no = 0

      SELECT CASE(read_action)
      CASE(read_mfix)
         read_locked = .true.
         read_full = .true.
      CASE(read_post)
         read_locked = .true.
         read_full = .false.
      CASE(read_init)
         read_locked = .false.
         read_full = .true.
      END SELECT

! Open the mfix.dat file. Report errors if the file is not located or
! there is difficulties opening it.
      inquire(file=filename,exist=lexists)
      IF(.NOT.lexists) THEN
         IF(mype == pe_io) WRITE(*,1000)
         CALL mfix_exit(mype)

 1000 FORMAT(2/,1x,70('*')/' From: READ_NAMELIST',/' Error 1000: ',    &
         'The input data file, mfix.dat, is missing. Aborting.',/1x,   &
         70('*'),2/)

      ELSE
         OPEN(unit=unit_dat, file=filename, status='OLD', iostat=ios)
         IF(ios /= 0) THEN
            IF(mype == pe_io) WRITE (*,1001)
            CALL mfix_exit(mype)
         ENDIF

 1001 FORMAT(2/,1x,70('*')/' From: READ_NAMELIST',/' Error 1001: ',    &
         'Unable to open the mfix.dat file. Aborting.',/1x,70('*'),2/)
      ENDIF


! Loop through the mfix.dat file and process the input data.
      read_lp: DO
         READ (unit_dat,"(A)",iostat=ios) line_string
         IF(ios < 0) EXIT read_lp

         line_no = line_no + 1

         line_len = seek_comment(line_string,len(line_string)) - 1
         CALL remove_comment(line_string, line_len+1, len(line_string))

         IF(line_len <= 0) cycle read_lp           ! comment line
         IF(blank_line(line_string)) cycle read_lp ! blank line

         IF(line_too_big(line_string,line_len,maxcol) > 0) THEN
            WRITE (*, 1100) trim(ival(line_no)), trim(ival(maxcol)), &
               line_string(1:maxcol)
            CALL mfix_exit(mype)
         ENDIF

 1100 FORMAT(//1x,70('*')/1x,'From: READ_NAMELIST',/1x,'Error 1100: ', &
         'Line ',a,' in mfix.dat has is too long. Input lines should', &
         /1x,'not pass column ',a,'.',2/3x,a,2/1x,'Please correct ',   &
         'the mfix.dat file.',/1x,70('*'),2/)

! All subsequent lines are thermochemical data
         IF(line_string(1:11) == 'THERMO DATA') EXIT read_lp

         CALL set_keyword(error)
         IF (error) THEN
! At this point, the keyword was not identified therefore it is
! either deprecated or unknown.
            CALL deprecated_or_unknown(line_no, line_string(1:line_len))
         ENDIF

      ENDDO read_lp

      DO ii=1, cmd_line_args_count
         line_string = cmd_line_args(ii)
         line_len = len(line_string)
         CALL set_keyword(error)
         IF (error) THEN
            CALL deprecated_or_unknown(line_no, line_string(1:line_len))
         ENDIF
      ENDDO

      CLOSE(unit=unit_dat)
      IF (e /= undefined) c_e = e

      RETURN

      CONTAINS

!vvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvvv!
!                                                                      !
! Subroutine: SET_KEYWORD(ERROR)                                       !
! Author: P. Nicoletti                                Date: 25-NOV-91  !
!                                                                      !
! Purpose: Process LINE_STRING for MFIX keyword data.                  !
!                                                                      !
!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^!
      SUBROUTINE set_keyword(ERROR)

      IMPLICIT NONE

      LOGICAL, INTENT(OUT) ::ERROR



! External namelist files:
!---------------------------------------------------------------------//
      include 'run_control.inc'
      include 'physical_params.inc'
      include 'numerical_params.inc'
      include 'geometry.inc'
      include 'gas_phase.inc'
      include 'solids_phase.inc'
      include 'tfm_solids.inc'
      include 'initial_conditions.inc'
      include 'boundary_conditions.inc'
      include 'internal_surfaces.inc'
      include 'point_sources.inc'
      include 'output_control.inc'
      include 'usr_hooks.inc'
      include 'chem_equations.inc'
      include 'dmp_batch_control.inc'
      include 'desnamelist.inc'
      include 'cartesian_grid_namelist.inc'
      include 'qmomknamelist.inc'
      include 'legacy.inc'
      include 'usrnlst.inc'

      error = .false.

! Make upper case all except species names
      if(index(line_string,'SPECIES_NAME') == 0 .AND. &
         index(line_string,'species_name') == 0 .AND. &
         index(line_string,'Species_Name') == 0 .AND. &
         index(line_string,'SPECIES_g') == 0 .AND.    &
         index(line_string,'Species_g') == 0 .AND.    &
         index(line_string,'species_g') == 0 .AND.    &
         index(line_string,'SPECIES_s') == 0 .AND.    &
         index(line_string,'Species_s') == 0 .AND.    &
         index(line_string,'species_s') == 0)         &
         CALL make_upper_case (line_string, line_len)

      CALL replace_tab (line_string, line_len)
      CALL remove_par_blanks(line_string)

! Complete arithmetic operations and expand line
      CALL parse_line (line_string, line_len, rxn_flag, read_flag)

! Write the current line to a scratch file
! and read the scratch file in NAMELIST format
      IF(.NOT.read_flag) RETURN


! Run control keywords
      IF(read_locked) THEN
         string=''; string = '&RUN_CONTROL_LOCKED '//&
            trim(adjustl(line_string(1:line_len)))//'/'
         READ(string, nml=run_control_locked,  iostat=ios)
         IF(ios == 0)  RETURN
      ENDIF

      string=''; string = '&RUN_CONTROL_UNLOCKED '//&
         trim(adjustl(line_string(1:line_len)))//'/'
      READ(string, nml=run_control_unlocked, iostat=ios)
      IF(ios == 0)  RETURN


! Physical parameter keywords
      IF(read_locked) THEN
         string=''; string = '&PHYSICAL_PARAM_LOCKED '//&
            trim(adjustl(line_string(1:line_len)))//'/'
         READ(string, nml=physical_param_locked, iostat=ios)
         IF(ios == 0)  RETURN
      ENDIF

      string=''; string = '&PHYSICAL_PARAM_UNLOCKED '//&
         trim(adjustl(line_string(1:line_len)))//'/'
      READ(string, nml=physical_param_unlocked, iostat=ios)
      IF(ios == 0)  RETURN


! Numerical parameter keywords
      IF(read_locked) THEN
         string=''; string = '&NUMERICAL_PARAM_LOCKED '//&
            trim(adjustl(line_string(1:line_len)))//'/'
         READ(string, nml=numerical_param_locked, iostat=ios)
         IF(ios == 0)  RETURN
      ENDIF

      string=''; string = '&NUMERICAL_PARAM_UNLOCKED '//&
         trim(adjustl(line_string(1:line_len)))//'/'
      READ(string, nml=numerical_param_unlocked, iostat=ios)
      IF(ios == 0)  RETURN


! Geometry and discretization keywords
      IF(read_locked) THEN
         string=''; string = '&GEOMETRY_LOCKED '//&
            trim(adjustl(line_string(1:line_len)))//'/'
         READ(string, nml=geometry_locked, iostat=ios)
         IF(ios == 0)  RETURN
      ENDIF

      string=''; string = '&GEOMETRY_UNLOCKED '//&
         trim(adjustl(line_string(1:line_len)))//'/'
      READ(string, nml=geometry_unlocked, iostat=ios)
      IF(ios == 0)  RETURN


! Gas phase keywords
      IF(read_locked) THEN
         string=''; string = '&GAS_PHASE_LOCKED '//&
            trim(adjustl(line_string(1:line_len)))//'/'
         READ(string, nml=gas_phase_locked, iostat=ios)
         IF(ios == 0)  RETURN
      ENDIF

      string=''; string = '&GAS_PHASE_UNLOCKED '//&
         trim(adjustl(line_string(1:line_len)))//'/'
      READ(string, nml=gas_phase_unlocked, iostat=ios)
      IF(ios == 0)  RETURN


! Solidss phase keywords
      IF(read_locked) THEN
         string=''; string = '&SOLIDS_PHASE_LOCKED '//&
            trim(adjustl(line_string(1:line_len)))//'/'
         READ(string, nml=solids_phase_locked, iostat=ios)
         IF(ios == 0)  RETURN
      ENDIF

      string=''; string = '&SOLIDS_PHASE_UNLOCKED '//&
         trim(adjustl(line_string(1:line_len)))//'/'
      READ(string, nml=solids_phase_unlocked, iostat=ios)
      IF(ios == 0)  RETURN


! Two-fluid solids keywords
      string=''; string = '&TFM_SOLIDS_UNLOCKED '//&
         trim(adjustl(line_string(1:line_len)))//'/'
      READ(string, nml=tfm_solids_unlocked, iostat=ios)
      IF(ios == 0)  RETURN


! Initial condtion keywords
      IF(read_locked) THEN
         string=''; string = '&INITIAL_CONDITIONS_LOCKED '//&
            trim(adjustl(line_string(1:line_len)))//'/'
         READ(string, nml=initial_conditions_locked, iostat=ios)
         IF(ios == 0)  RETURN
      ENDIF

      string=''; string = '&INITIAL_CONDITIONS_UNLOCKED '//&
         trim(adjustl(line_string(1:line_len)))//'/'
      READ(string, nml=initial_conditions_unlocked, iostat=ios)
      IF(ios == 0)  RETURN


! Boundary condition keywords
      IF(read_locked) THEN
         string=''; string = '&BOUNDARY_CONDITIONS_LOCKED '//&
            trim(adjustl(line_string(1:line_len)))//'/'
         READ(string, nml=boundary_conditions_locked, iostat=ios)
         IF(ios == 0)  RETURN
      ENDIF

      string=''; string = '&BOUNDARY_CONDITIONS_UNLOCKED '//&
         trim(adjustl(line_string(1:line_len)))//'/'
      READ(string, nml=boundary_conditions_unlocked, iostat=ios)
      IF(ios == 0)  RETURN


! Internal surface keywords
      IF(read_locked) THEN
         string=''; string = '&INTERNAL_SURFACES_LOCKED '//&
            trim(adjustl(line_string(1:line_len)))//'/'
         READ(string, nml=internal_surfaces_locked, iostat=ios)
         IF(ios == 0)  RETURN
      ENDIF

      string=''; string = '&INTERNAL_SURFACES_UNLOCKED '//&
         trim(adjustl(line_string(1:line_len)))//'/'
      READ(string, nml=internal_surfaces_unlocked, iostat=ios)
      IF(ios == 0)  RETURN


! Point source keywords
      string=''; string = '&POINT_SOURCES_UNLOCKED '//&
         trim(adjustl(line_string(1:line_len)))//'/'
      READ(string, nml=point_sources_unlocked, iostat=ios)
      IF(ios == 0)  RETURN


! Output control keywords
      IF(read_locked) THEN
         string=''; string = '&OUTPUT_CONTROL_LOCKED '//&
            trim(adjustl(line_string(1:line_len)))//'/'
         READ(string, nml=output_control_locked, iostat=ios)
         IF(ios == 0)  RETURN
      ENDIF

      string=''; string = '&OUTPUT_CONTROL_UNLOCKED '//&
         trim(adjustl(line_string(1:line_len)))//'/'
      READ(string, nml=output_control_unlocked, iostat=ios)
      IF(ios == 0)  RETURN


! User hook keywords
      string=''; string = '&USER_HOOKS_UNLOCKED '//&
         trim(adjustl(line_string(1:line_len)))//'/'
      READ(string, nml=user_hooks_unlocked, iostat=ios)
      IF(ios == 0)  RETURN


! Chemical equation keywords
      string=''; string = '&CHEM_EQUATIONS_UNLOCKED '//&
         trim(adjustl(line_string(1:line_len)))//'/'
      READ(string, nml=chem_equations_unlocked, iostat=ios)
      IF(ios == 0)  RETURN


! DMP and Batch Queue control keywords
      IF(read_locked) THEN
         string=''; string = '&DMP_BATCH_CONTROL_LOCKED '//&
            trim(adjustl(line_string(1:line_len)))//'/'
         READ(string, nml=dmp_batch_control_locked, iostat=ios)
         IF(ios == 0)  RETURN
      ENDIF

      string=''; string = '&DMP_BATCH_CONTROL_UNLOCKED '//&
         trim(adjustl(line_string(1:line_len)))//'/'
      READ(string, nml=dmp_batch_control_unlocked, iostat=ios)
      IF(ios == 0)  RETURN


! Legacy keywords
      IF(read_locked) THEN
         string=''; string = '&LEGACY_LOCKED '//&
            trim(adjustl(line_string(1:line_len)))//'/'
         READ(string, nml=legacy_locked, iostat=ios)
         IF(ios == 0)  RETURN

      ENDIF

! Stop processing keyword inputs if runing POST_MFIX
       IF(.NOT.read_full) RETURN


      IF(read_locked) THEN

! Discrete Element model input parameters.
         string=''; string = '&DES_INPUT_DATA '//&
            trim(adjustl(line_string(1:line_len)))//'/'
         READ(string, nml=des_input_data, iostat=ios)
         IF(ios == 0)  RETURN


! User defined input parameters.
         string=''; string = '&USR_INPUT_DATA '//&
            trim(adjustl(line_string(1:line_len)))//'/'
         READ(string, nml=usr_input_data, iostat=ios)
         IF(ios == 0)  RETURN


! Cartesian grid cut-cell input parameters.
         string=''; string = '&CARTESIAN_GRID_INPUT_DATA '//&
            trim(adjustl(line_string(1:line_len)))//'/'
         READ(string, nml=cartesian_grid_input_data, iostat=ios)
         IF(ios == 0)  RETURN


! QMOMK input parameters.
         string=''; string = '&QMOMK_INPUT_DATA '//&
            trim(adjustl(line_string(1:line_len)))//'/'
         READ(string, nml=qmomk_input_data, iostat=ios)
         IF(ios == 0)  RETURN
      ENDIF

      IF(read_locked) error = .true.

      RETURN
      END SUBROUTINE set_keyword

END SUBROUTINE read_namelist