!------------------------------------------------------------------------------
!
! read_netcdf_var.setup.f90 -- Generic setup routine for the specific readers.
!
! This is a component include file for module read_netcdf_var.f90.
! For internal use only.  See main module file for documentation.
!
! 2022-apr-02	Original version.  By Dave Allured, NOAA/PSL/CIRES.
!		Split off from read_netcdf_var.f90.
! 2022-apr-19	Minor.  Adjust verbosity levels.
!
! Note: The generic support routines use several module variables
! for status exchange, in addition to their calling arguments.
!
!------------------------------------------------------------------------------

function read_setup (infile, varname, diag, prev_alloc, var_shape, status, &
      str_flag) result (error_flag)
   implicit none

! Input arguments.

   character(*),     intent (in ) :: infile	  ! input file name
   character(*),     intent (in ) :: varname	  ! requested var name
   integer,          intent (in ) :: diag	  ! diag verbosity level, 0-N
   logical,          intent (in ) :: prev_alloc	  ! previous allocation status
   integer,          intent (in ) :: var_shape(:) ! caller's array dimensions;
						  ! undefined if not allocated;
   						  ! char dim #1 = string length
   logical, optional,intent (in ) :: str_flag	  ! *PRESENT* for string reads

! Output arguments.

   integer,          intent (out) :: status	  ! final status for main caller

! Function result.

   logical error_flag			! false = success,
					! true = soft error & return to main
! Local variables.

   character fmt1*50
   integer i, file_rank, ddim1, status_nc
   logical ex

! Initialize.

   if (diag >= 5) print *, 'read_netcdf_var: Start.'
   if (diag >= 4) print *, '   Read ', trim (varname)

! Determine expected dimensions.

! For character variables, dim #1 is the string length dimension.
! For character, "rank" is the rank of the file var, not caller's array rank.

   dims(:)      = -99			! init memory and trap errors
   rank = size (var_shape)		! expected rank of file variable

! Default both return codes to operation failed, until all operations
! complete.  Support multiple error return points.

   status     = fail			! status code to main caller (stdlit)
   error_flag = .true.			! abort flag to specific interfaces

! Check for input file already open.

file_check: &
   if (infile == previous_file) then
      if (diag >= 5) print '(2a)', '   File already open: ', trim (infile)

! Check for file not found, for best message.

   else
      inquire (file=infile, exist=ex)

      if (.not. ex) then
         if (diag >= 1) print '(2a)', ' *** File not found: ', trim (infile)
         return
      end if

! File exists and is different.  Close previous Netcdf file.

      if (ncidi /= 0) then				! zero = no open file
         if (diag >= 5) print *, '  Close previous Netcdf file.'

         if (check_nc (nf90_close (ncidi), 'nf90_close')) then
            print *, '*** Serious error.  Abort.'
            call exit (1)
         end if

         ncidi = 0					! remember file closed
      end if

! Open the requested Netcdf input file.

      if (diag >= 5 .and. previous_file == ' ') &	! first time only
         print *, 'Netcdf library version = ' // trim (nf90_inq_libvers())

      if (diag >= 3) print '(2a)', ' Open input file: ', trim (infile)

      status_nc = nf90_open (infile, nf90_nowrite, ncidi)

      if (check_nc (status_nc, 'nf90_open')) then
         previous_file = 'xxx xxx'		! prevent filename match
         ncidi = 0				! mark as file closed, even if
         					!   in strange semi-open state
         return					! soft error, return
      end if

      previous_file = infile				! remember open file

      if (diag >= 5) print *, '  ncidi = ', ncidi

   end if file_check

! Look up the var name in the input file.

   if (diag >= 5) print *, '  Look up var name in file: ' // trim (varname)

   status_nc = nf90_inq_varid (ncidi, varname, varidi)

   if (check_nc (status_nc, 'nf90_inq_varid')) return	! soft error, return

   if (diag >= 5) print *, '    Var ID for ' // trim (varname) // ' = ', varidi

! Get number of dimensions for current variable.

   if (diag >= 5) print *, '  Get number of dimensions for this variable.'

   status_nc = nf90_inquire_variable (ncidi, varidi, ndims=file_rank)

   if (check_nc (status_nc, 'nf90_inquire_variable')) return	! soft error

   if (diag >= 5) print *, '    Number of dimensions = ', file_rank

! Consistency check for number of dimensions.

   if (file_rank /= rank) then
      print *, '*** read_netcdf_var: Incorrect number of dimensions for "' &
         // trim (varname) // '" in file.'
      print '(a,i0)', ' *** Number of dimensions in file  = ', file_rank
      print '(a,i0)', ' *** Number of dimensions expected = ', rank
      return						! soft error, return
   end if

! Read dimension ID's for current variable.

   if (diag >= 5) print *, '  Get dimension ID''s.'

   status_nc = nf90_inquire_variable (ncidi, varidi, dimids=dimids(1:file_rank))

   if (check_nc (status_nc, 'nf90_inquire_variable')) return	! soft error

! Read dimension sizes for current variable.

   if (diag >= 5) print *, '  Read dimension sizes.'

   do i = 1, file_rank
      status_nc = nf90_inquire_dimension (ncidi, dimids(i), len=dims(i))

      if (check_nc (status_nc, 'nf90_inquire_dimension')) return   ! soft error
   end do

   if (diag >= 5) print '(a,999(2x,i0))', '     Var dimensions in file =', &
      dims(1:file_rank)

! Set up for main array allocate statement.
! Check for conforming array dimensions.  Special test for robustness.
! May need to be optionable in a later version.

   need_allocate = .not. prev_alloc	! enable caller's allocate

   ddim1 = 1				! for character reads...
   if (present (str_flag)) ddim1 = 2	! ignore differences in length dimension

   if (prev_alloc) then
      if (any (dims(ddim1:rank) /= var_shape(ddim1:rank))) then
         print *, '*** read_netcdf_var: Inconsistent dimensions between files.'
         fmt1 = '(a,999(2x,i0))'
         print fmt1, ' *** Previous dimension sizes    = ', var_shape(1:rank)
         print fmt1, ' *** Current file var dimensions = ', dims(1:rank)
         if (present (str_flag)) print *, &
            '***   (Difference in string length dimension #1 is ignored.)'
         print *, '*** Ignore current variable, and continue running.'
         return						! soft error, return
      end if

      if (diag >= 5) print *, '  Allocate data array.'
   end if

! Setup for main allocate is now complete.  Return continue status.
! The specific routine will next allocate the main data array.

   error_flag = .false.

! Note that the user status "status" remains set to the abort status,
! because the whole read operation is not yet finished.

end function read_setup