mod_nctools.f90

Go to the documentation of this file.

!/===========================================================================/
! Copyright (c) 2007, The University of Massachusetts Dartmouth 
! Produced at the School of Marine Science & Technology 
! Marine Ecosystem Dynamics Modeling group
! All rights reserved.
!
! FVCOM has been developed by the joint UMASSD-WHOI research team. For 
! details of authorship and attribution of credit please see the FVCOM
! technical manual or contact the MEDM group.
!
! 
! This file is part of FVCOM. For details, see http://fvcom.smast.umassd.edu 
! The full copyright notice is contained in the file COPYRIGHT located in the 
! root directory of the FVCOM code. This original header must be maintained
! in all distributed versions.
!
! THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" 
! AND ANY EXPRESS OR  IMPLIED WARRANTIES, INCLUDING,  BUT NOT  LIMITED TO,
! THE IMPLIED WARRANTIES OF MERCHANTABILITY AND  FITNESS FOR A PARTICULAR
! PURPOSE ARE DISCLAIMED.  
!
!/---------------------------------------------------------------------------/
! CVS VERSION INFORMATION
! $Id$
! $Name$
! $Revision$
!/===========================================================================/

MODULE mod_nctools
  USE mod_ncll
  USE lims
  USE mod_par
  USE control, only: ipt, use_real_world_time,timeprec,datestrlen !, MSR, USE_MPI_IO_MODE, PAR, SERIAL, IOPROC
  implicit none
  save


  ! AT PRESENT THIS LIBRARY DOES NOT PROPERLY SUPPORT UDUNITS TIME
  ! CONVENTIONS. THE FOLLOWING ARE THE UNDERSTOOD UNITS ATTRIBUTES
  character(len=80), parameter :: seconds_units  ='seconds'
  character(len=80), parameter :: days_units  ='days since 0.0'
  character(len=80), parameter :: mjd_units  ='days since 1858-11-17 00:00:00'
  character(len=80), parameter :: msec_units ='msec since 00:00:00'
  character(len=80), parameter :: fmat ='modified julian day (MJD)'
  character(len=80), parameter :: rfmat ='defined reference date'


  INTERFACE nc_get_att
     MODULE PROCEDURE nc_get_vatt
     MODULE PROCEDURE nc_get_gatt
  END INTERFACE

  INTERFACE nc_make_runtime_att_chr
     MODULE PROCEDURE nc_make_runtime_att_chr_scl
     MODULE PROCEDURE nc_make_runtime_att_chr_vec
  END INTERFACE

  INTERFACE nc_make_att
     MODULE PROCEDURE nc_make_att_chr_scl
     MODULE PROCEDURE nc_make_att_chr_vec
     MODULE PROCEDURE nc_make_att_int
     MODULE PROCEDURE nc_make_att_int_vec
     MODULE PROCEDURE nc_make_att_flt
     MODULE PROCEDURE nc_make_att_flt_vec
     MODULE PROCEDURE nc_make_att_dbl
     MODULE PROCEDURE nc_make_att_dbl_vec
  END INTERFACE

  INTERFACE nc_make_avar
     MODULE PROCEDURE nc_make_avar_scl_chr
     MODULE PROCEDURE nc_make_avar_vec_chr

     MODULE PROCEDURE nc_make_avar_scl_dbl
     MODULE PROCEDURE nc_make_avar_vec_dbl
     MODULE PROCEDURE nc_make_avar_arr_dbl
     MODULE PROCEDURE nc_make_avar_cub_dbl
     MODULE PROCEDURE nc_make_avar_fda_dbl

     MODULE PROCEDURE nc_make_avar_scl_flt
     MODULE PROCEDURE nc_make_avar_vec_flt
     MODULE PROCEDURE nc_make_avar_arr_flt
     MODULE PROCEDURE nc_make_avar_cub_flt
     MODULE PROCEDURE nc_make_avar_fda_flt

     MODULE PROCEDURE nc_make_avar_scl_int
     MODULE PROCEDURE nc_make_avar_vec_int
     MODULE PROCEDURE nc_make_avar_arr_int
     MODULE PROCEDURE nc_make_avar_cub_int
     MODULE PROCEDURE nc_make_avar_fda_int
  END INTERFACE

  INTERFACE nc_make_pvar
     MODULE PROCEDURE nc_make_pvar_scl_chr
     MODULE PROCEDURE nc_make_pvar_vec_chr

     MODULE PROCEDURE nc_make_pvar_scl_dbl
     MODULE PROCEDURE nc_make_pvar_vec_dbl
     MODULE PROCEDURE nc_make_pvar_arr_dbl
     MODULE PROCEDURE nc_make_pvar_cub_dbl
     MODULE PROCEDURE nc_make_pvar_fda_dbl

     MODULE PROCEDURE nc_make_pvar_scl_flt
     MODULE PROCEDURE nc_make_pvar_vec_flt
     MODULE PROCEDURE nc_make_pvar_arr_flt
     MODULE PROCEDURE nc_make_pvar_cub_flt
     MODULE PROCEDURE nc_make_pvar_fda_flt

     MODULE PROCEDURE nc_make_pvar_scl_int
     MODULE PROCEDURE nc_make_pvar_vec_int
     MODULE PROCEDURE nc_make_pvar_arr_int
     MODULE PROCEDURE nc_make_pvar_cub_int
     MODULE PROCEDURE nc_make_pvar_fda_int
  END INTERFACE

  ! NC_DISCONNECT
  INTERFACE nc_connect_avar
     MODULE PROCEDURE nc_connect_var_scl_chr
     MODULE PROCEDURE nc_connect_avar_vec_chr

     MODULE PROCEDURE nc_connect_avar_scl_dbl
     MODULE PROCEDURE nc_connect_avar_vec_dbl
     MODULE PROCEDURE nc_connect_avar_arr_dbl
     MODULE PROCEDURE nc_connect_avar_cub_dbl
     MODULE PROCEDURE nc_connect_avar_fda_dbl

     MODULE PROCEDURE nc_connect_avar_scl_flt
     MODULE PROCEDURE nc_connect_avar_vec_flt
     MODULE PROCEDURE nc_connect_avar_arr_flt
     MODULE PROCEDURE nc_connect_avar_cub_flt
     MODULE PROCEDURE nc_connect_avar_fda_flt

     MODULE PROCEDURE nc_connect_avar_scl_int
     MODULE PROCEDURE nc_connect_avar_vec_int
     MODULE PROCEDURE nc_connect_avar_arr_int
     MODULE PROCEDURE nc_connect_avar_cub_int
     MODULE PROCEDURE nc_connect_avar_fda_int
  END INTERFACE

  INTERFACE nc_connect_pvar
     MODULE PROCEDURE nc_connect_pvar_scl_chr
     MODULE PROCEDURE nc_connect_pvar_vec_chr

     MODULE PROCEDURE nc_connect_pvar_scl_dbl
     MODULE PROCEDURE nc_connect_pvar_vec_dbl
     MODULE PROCEDURE nc_connect_pvar_arr_dbl
     MODULE PROCEDURE nc_connect_pvar_cub_dbl
     MODULE PROCEDURE nc_connect_pvar_fda_dbl

     MODULE PROCEDURE nc_connect_pvar_scl_flt
     MODULE PROCEDURE nc_connect_pvar_vec_flt
     MODULE PROCEDURE nc_connect_pvar_arr_flt
     MODULE PROCEDURE nc_connect_pvar_cub_flt
     MODULE PROCEDURE nc_connect_pvar_fda_flt

     MODULE PROCEDURE nc_connect_pvar_scl_int
     MODULE PROCEDURE nc_connect_pvar_vec_int
     MODULE PROCEDURE nc_connect_pvar_arr_int
     MODULE PROCEDURE nc_connect_pvar_cub_int
     MODULE PROCEDURE nc_connect_pvar_fda_int
  END INTERFACE

  INTERFACE nc_point_var
     MODULE PROCEDURE nc_point_var_scl_chr
     MODULE PROCEDURE nc_point_var_vec_chr

     MODULE PROCEDURE nc_point_var_scl_dbl
     MODULE PROCEDURE nc_point_var_vec_dbl
     MODULE PROCEDURE nc_point_var_arr_dbl
     MODULE PROCEDURE nc_point_var_cub_dbl
     MODULE PROCEDURE nc_point_var_fda_dbl

     MODULE PROCEDURE nc_point_var_scl_flt
     MODULE PROCEDURE nc_point_var_vec_flt
     MODULE PROCEDURE nc_point_var_arr_flt
     MODULE PROCEDURE nc_point_var_cub_flt
     MODULE PROCEDURE nc_point_var_fda_flt

     MODULE PROCEDURE nc_point_var_scl_int
     MODULE PROCEDURE nc_point_var_vec_int
     MODULE PROCEDURE nc_point_var_arr_int
     MODULE PROCEDURE nc_point_var_cub_int
     MODULE PROCEDURE nc_point_var_fda_int
  END INTERFACE


  INTERFACE get_file_time
     MODULE PROCEDURE get_file_time_ncf
     MODULE PROCEDURE get_file_time_ncftime
  END INTERFACE
  
  ! DECLARE A HEAD FILE FOR INIT_NCF SO WE CAN KEEP TRACK OF OPEN FILES
  TYPE(ncfilelist), POINTER, SAVE :: filehead

  
CONTAINS
!====================================================================
!====================================================================
SUBROUTINE handle_ncerr(status,programer_msg)
  IMPLICIT NONE
  INTEGER,            intent(in) :: status
  CHARACTER(len=*),   intent(in) :: programer_msg
  CHARACTER(len=150)               :: msg
  LOGICAL :: ERROR=.false.
  if(status /=nf90_noerr)&
       & CALL fatal_error(trim(programer_msg),"NF90ERROR::"//trim(nf90_strerror(status)))
END SUBROUTINE handle_ncerr
!====================================================================
!====================================================================
SUBROUTINE nc_init(NCF,NAME)
  IMPLICIT NONE
  TYPE(ncfile),       POINTER   :: NCF
  CHARACTER(LEN=*), INTENT(IN):: NAME
  LOGICAL FOUND

  IF (.NOT. ASSOCIATED(filehead))THEN
     filehead => new_filehead()
  END IF

  ncf => find_file(filehead,trim(name),found)
  IF (found) RETURN

  ncf => new_file()
  ncf%FNAME=trim(name)

END SUBROUTINE nc_init
!====================================================================
!====================================================================
SUBROUTINE nc_open(NCF)
  IMPLICIT NONE
  TYPE(ncfile), intent(inout) :: NCF
  CHARACTER(LEN=120)          :: errmsg
  integer :: status
  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "STARTING NC_OPEN"

  if (ncf%WRITABLE) then
     errmsg="File named: "//ncf%fname//"; Can not be opend by nf90_open"
     status = nf90_open(trim(ncf%fname), nf90_write, ncf%ncid)
     CALL handle_ncerr(status,trim(errmsg))
     
  else  ! default is open with nf90_nowrite
     errmsg="File: "//trim(ncf%fname)//"; Can not be opend by nf90_open"
     status = nf90_open(trim(ncf%fname), nf90_nowrite, ncf%ncid)
     CALL handle_ncerr(status,trim(errmsg))
  end if

  ncf%OPEN = .true.

  if(dbg_set(dbg_io))  &
         & write(ipt,*) "Opened File: ",trim(ncf%FNAME)

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_OPEN"
END SUBROUTINE nc_open
!====================================================================
!====================================================================
SUBROUTINE nc_create(NCF)
  IMPLICIT NONE
  TYPE(ncfile), intent(inout) :: NCF
  CHARACTER(LEN=120)          :: errmsg
  integer :: status
  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "STARTING NC_CREATE"

  errmsg="File named: "//ncf%fname//"; Can not be created by nf90_create"
  status = nf90_create(trim(ncf%fname),nf90_64bit_offset,ncf%ncid)
  if(status/= nf90_eexist)then
     CALL handle_ncerr(status,trim(errmsg))
  else
     CALL fatal_error("The file: "//trim(ncf%fname)//"; already exists",&
          & "FVCOM will not overwrite old output files. You must move&
          & or delete them first")
  end if
  ncf%writable = .true.
  ncf%OPEN = .true.
  ncf%INDEFMODE = .true.
  ncf%CONNECTED=.false.

  IF (ASSOCIATED(ncf%FTIME) ) THEN
     ncf%FTIME%NEXT_STKCNT = 0
     ncf%FTIME%STK_LEN=0
  END IF


  if(dbg_set(dbg_io))  &
       & write(ipt,*) "Created File: ",trim(ncf%FNAME)
  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_CREATE"
END SUBROUTINE nc_create
!====================================================================
!====================================================================
SUBROUTINE nc_close(NCF)
  IMPLICIT NONE
  TYPE(ncfile), intent(INOUT)    :: NCF
  CHARACTER(LEN=120)             :: errmsg
  integer :: status
  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "STARTING NC_CLOSE"
  errmsg="File:"//trim(ncf%fname)//"; Not open or Already closed file"
  status = nf90_close(ncf%ncid)
  CALL handle_ncerr(status,trim(errmsg))
  ncf%ncid=-1
  ncf%OPEN=.false.
  ncf%INDEFMODE = .false.
  if(dbg_set(dbg_io))  &
         & write(ipt,*) "Closed File: ",trim(ncf%FNAME)
  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_CLOSE"
END SUBROUTINE nc_close
!====================================================================
!====================================================================
SUBROUTINE nc_refresh(NCF)
  use control
  IMPLICIT NONE
  TYPE(ncfile), POINTER :: NCF
  TYPE(ncdim), pointer  :: DIM
  integer :: status
  LOGICAL :: FOUND
  CHARACTER(LEN=120)     :: errmsg

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "STARTING NC_REFRESH"

  IF(.NOT.ASSOCIATED(ncf)) CALL fatal_error&
       ("NC_REFRESH: NCF NOT ASSICATED!")

  IF(dbg_set(dbg_io)) write(ipt,*) "====== REFRESHING FILE NAME: "//trim(ncf%FNAME)
  

  IF(ncf%OPEN) CALL nc_close(ncf)
  CALL nc_open(ncf)
  dim => find_unlimited(ncf,found)
  IF(.not. found) RETURN

  status = nf90_inquire_dimension(ncf%NCID,dim%DIMID,dim%DIMNAME, dim%DIM)
  errmsg="Can not get dimensions: "//trim(ncf%FNAME)
  call handle_ncerr(status,errmsg)

  IF(ASSOCIATED(ncf%FTIME)) THEN
     ncf%FTIME%STK_LEN = dim%DIM
  ELSE
     CALL fatal_error("NC_REFRESH: FTIME NOT ASSOCIATED FOR FILE:"//&
          & trim(ncf%FNAME))
  END IF


  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_REFRESH"

END SUBROUTINE nc_refresh
!====================================================================
!====================================================================
SUBROUTINE nc_load(NCF)
  use control
  IMPLICIT NONE
  TYPE(ncfile), POINTER :: NCF
  TYPE(ncvar), pointer  :: VAR
  TYPE(ncatt), pointer  :: ATT
  TYPE(ncdim), pointer  :: DIM
  CHARACTER(LEN=120)             :: errmsg
  integer :: status,i,j, len, nvars, ndims, natts, unlimDimid
  integer, dimension(NF90_MAX_VAR_DIMS):: dimids
  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "STARTING NC_LOAD"

  IF(dbg_set(dbg_io)) write(ipt,*) "====== LOADING FILE NAME: "//trim(ncf%FNAME)

  IF(ncf%CONNECTED) CALL fatal_error("CAN NOT LOAD A FILE WHEN ALREADY&
       & CONNECTED!", "FILE NAME: "//trim(ncf%FNAME))

! BASIC FILE INFO
  status = nf90_inquire(ncf%NCID, ndims, nvars, natts, unlimdimid)
  errmsg="Can not get file contents: "//trim(ncf%FNAME)
  call handle_ncerr(status,errmsg)
  

! DIMENSIONS
  if(dbg_set(dbg_io)) write(ipt,*) "====== READING FILE DIMENSIONS:"
  do i=1,ndims
     dim => nc_get_dim(ncf,i)
     IF(dim%DIMID .EQ. unlimdimid) dim%UNLIMITED = .true.
     if(dbg_set(dbg_io)) write(ipt,*) "      "//trim(dim%DIMNAME)
     ncf => add(ncf,dim)
  end do

  if(unlimdimid .NE. ncf%UNLIMDIMID) then
     CALL print_file(ncf)
     CALL print_dim_list(ncf)
     CALL fatal_error &
       &("NC_LOAD: UNLIMITED DIMENSION ID FROM nf90_inquire does not m&
       &atch the file objects UNLIMDIMID?")
  end if

  if(ndims /= count_dim_list(ncf) ) then
     if(dbg_set(dbg_log)) call print_dim_list(ncf)
     call fatal_error("The number of dimensions in the file does not m&
          &atch the number loaded in the file object.")
  end if

! call print_dim_list(NCF)

! ATTRIBUTES
  if(dbg_set(dbg_io)) write(ipt,*) "====== READING FILE ATTRIBUTES:"
  do i=1,natts
     att => nc_get_att(ncf,i)
     if(dbg_set(dbg_io)) write(ipt,*) "      "//trim(att%ATTNAME)
     ncf => add(ncf,att)
  end do

  if(natts /= count_att_list(ncf)) then
     if(dbg_set(dbg_log)) call print_att_list(ncf)
     call fatal_error("The number of attributes in the file does not m&
          &atch the number loaded in the file object.")
  end if

! call print_att_list(NCF)


! VARIABLES
  if(dbg_set(dbg_io)) write(ipt,*) "====== READING FILE VARIABLES:"
  do i=1,nvars
     var => nc_get_var(ncf,i)
!      call print_dim_list(VAR)
!      call print_att_list(VAR)
     ncf => add(ncf,var)
  end do

  if(nvars /= count_var_list(ncf)) then
     if(dbg_set(dbg_log)) call print_var_list(ncf)
     call fatal_error("The number of variables in the file does not m&
          &atch the number loaded in the file object.")
  end if

! call print_var_list(NCF)


  status = set_file_time_type(ncf)
  ! SEE 'set_file_time_type' for possible results
  !  Since this is a generic routine, take no action based on status...

  ncf%CONNECTED = .true.

 if(dbg_set(dbg_io)) write(ipt,*) "====== FINISHED LOADING FILE NAME: "//trim(ncf%FNAME)

 if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_LOAD"
END SUBROUTINE nc_load
!====================================================================
!====================================================================
SUBROUTINE nc_save(NCF)
  IMPLICIT NONE
  TYPE(ncfile)         :: NCF
  TYPE(ncvar), pointer :: VAR
  TYPE(ncatt), pointer :: ATT
  TYPE(ncdim), pointer :: DIM
  integer              :: attid, dimid, varid
  CHARACTER(LEN=120)             :: errmsg
  integer :: status,i,j, len
  LOGICAL :: FOUND

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "STARTING NC_SAVE"

  IF(ncf%CONNECTED) CALL fatal_error("CAN NOT SAVE A FILE WHEN ALREADY&
       & CONNECTED!", "FILE NAME: "//trim(ncf%FNAME))

  IF(.not. ncf%WRITABLE) CALL fatal_error("CAN NOT SAVE A FILE WHEN ALREADY&
       & CONNECTED!", "FILE NAME: "//trim(ncf%FNAME))

  IF (.NOT. ncf%INDEFMODE) THEN ! FILE MAY COME FROM CREATE OR OPEN...
     status = nf90_redef(ncf%ncid)
     if(status /= nf90_noerr) &
          & CALL fatal_error("EXPECTED FILE: "//trim(ncf%FNAME)//"; to be available &
          &for REDEF from an open statement.")
     ncf%INDEFMODE = .true.
  END IF


! DIMENSIONS
  if(dbg_set(dbg_io)) write(ipt,*) "====== WRITING FILE DIMENSIONS:"
  do i=1,count_dim_list(ncf)
     CALL nc_def_dim(ncf,i)
  end do


  if(dbg_set(dbg_io)) write(ipt,*) "====== WRITING FILE GLOBAL ATTRIBUTES:"
  Do i = 1,count_att_list(ncf)
     att => find_att(ncf,i,found)
     IF (.NOT. found) THEN
        if (dbg_set(dbg_log)) call print_att_list(ncf)
        CALL fatal_error&
             &("NC_SAVE: COULD NOT FIND THE GLOBAL ATTRIBUTE WITH CORRECT ATTID W&
             &HILE PUTTING THE ATTRIBUTE IN THE FILE")
     END IF
     
     CALL write_att_type(ncf%NCID,nf90_global,att)
  End Do

  
  if(dbg_set(dbg_io)) write(ipt,*) "====== DEFINE FILE VARIABLES:"
  do i=1,count_var_list(ncf)
      CALL nc_def_var(ncf,i)
  end do

  status = nf90_enddef(ncf%NCID)
  errmsg="Can not ENDDEF MODE for file: "//trim(ncf%FNAME)
  call handle_ncerr(status,errmsg)

  ncf%INDEFMODE = .false.
  ncf%CONNECTED = .true.

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_SAVE"
END SUBROUTINE nc_save
!====================================================================
!====================================================================
FUNCTION nc_get_dim(NCF,dimid) RESULT(DIM)
  implicit none
  TYPE(ncfile), INTENT(IN) :: ncf
  TYPE(ncdim),  POINTER    :: dim
  INTEGER,      intent(in) :: dimid
  integer :: status
  CHARACTER(LEN=120)     :: errmsg

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "START NC_GET_DIM"
  nullify(dim)

  dim => new_dim()
  dim%DIMID=dimid
  status = nf90_inquire_dimension(ncf%NCID,dimid,dim%DIMNAME, dim%DIM)
  errmsg="Can not get dimensions: "//trim(ncf%FNAME)
  call handle_ncerr(status,errmsg)
  
!  if(dimid == NCF%UNLIMDIMID) DIM%UNLIMITED = .TRUE.

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_GET_DIM"

END FUNCTION nc_get_dim
!====================================================================
!====================================================================
FUNCTION nc_make_dim(NAME,LEN) RESULT(DIM)
  IMPLICIT NONE
  TYPE(ncdim), POINTER :: dim
  INTEGER, INTENT(IN)  :: len
!  logical, intent(in) :: UNLIMITED
  character(len=*), intent(in) :: name
  dim => new_dim()
  dim%dimid=-1
  dim%dimname=name
  dim%dim=len
  IF(len == nf90_unlimited) dim%UNLIMITED=.true.
END FUNCTION nc_make_dim
!====================================================================
!====================================================================
FUNCTION nc_make_runtime_dim(NAME,LEN) RESULT(DIM)
  USE control
  IMPLICIT NONE
  TYPE(ncdim), POINTER :: dim
  INTEGER, INTENT(IN)  :: len
!  logical, intent(in) :: UNLIMITED
  INTEGER, PARAMETER :: tag = 40003
  INTEGER :: source, dest, ierr

  character(len=*), intent(in) :: name
  dim => new_dim()
  dim%dimid=-1
  dim%dimname=name

  IF (.NOT. ioproc) THEN
     dim%dim=len
     IF(len == nf90_unlimited) dim%UNLIMITED=.true.
  END IF

  IF (use_mpi_io_mode) THEN
  END IF

END FUNCTION nc_make_runtime_dim
!====================================================================
!====================================================================
SUBROUTINE nc_def_dim(NCF,DIMID)
  implicit none
  INTEGER,      INTENT(IN)   :: DIMID
  TYPE(ncfile), INTENT(INOUT):: NCF ! MUST BE ALLOWED TO SET UNLIMDIMID
  TYPE(ncdim),  POINTER      :: DIM
  INTEGER                    :: status, tmp
  LOGICAL FOUND
  
  dim => find_dim(ncf,dimid,found)

  IF (.NOT. found) THEN
     if (dbg_set(dbg_log)) call print_dim_list(ncf)
     CALL fatal_error&
          &("NC_DEF_DIM: COULD NOT FIND THE FILE DIMENSION WITH CORRECT DIMID W&
          &HILE DEFINING THE DIMENSION IN THE FILE")
  END IF

  IF(dim%UNLIMITED) THEN
     status =  nf90_def_dim(ncf%ncid,dim%dimname, nf90_unlimited,tmp)
  ELSE
     status =  nf90_def_dim(ncf%ncid,dim%dimname, dim%dim, tmp)
  END IF

  CALL handle_ncerr(status,"ERROR DURING DEF_DIM, DIMNAME:"//trim(dim%DIMNAME))

  if (tmp .NE. dim%dimid) CALL fatal_error &
       &("NC_DEF_DIM: NF90_DEF_DIM returned a dimension id which",&
       & "is different from that set in the dimension object!",&
          & trim(ncf%FNAME)//" : "//trim(dim%DIMNAME))

END SUBROUTINE nc_def_dim
!====================================================================
!====================================================================
FUNCTION nc_make_att_chr_scl(NAME,VALUES) RESULT(ATT)
  IMPLICIT NONE
  TYPE(ncatt), POINTER :: att
  character(len=*), intent(in) :: name
  character(len=*), intent(in) :: values

  att => new_att()

  att%attid   = -1
  att%ATTname = trim(name)
  att%xtype   = nf90_char
  att%LEN     = len_trim(values)
  ALLOCATE(att%CHR(1))
  att%CHR(1)     = values

END FUNCTION nc_make_att_chr_scl
!====================================================================
!====================================================================
FUNCTION nc_make_att_chr_vec(NAME,VALUES) RESULT(ATT)
  IMPLICIT NONE
  TYPE(ncatt), POINTER :: att
  character(len=*), intent(in) :: name
  character(len=*),ALLOCATABLE, intent(in) :: values(:)

  att => new_att()

  att%attid   = -1
  att%ATTname = trim(name)
  att%xtype   = nf90_char
  att%LEN     = -1
  ALLOCATE(att%CHR(size(values)))
  att%CHR     = values
END FUNCTION nc_make_att_chr_vec
!====================================================================
!====================================================================
FUNCTION nc_make_runtime_att_chr_scl(NAME,VALUES) RESULT(ATT)
  ! NAME IS FIXED, BUT VALUES ARE SENT BY MPI IF NEEDED
  USE control
  IMPLICIT NONE
  TYPE(ncatt), POINTER :: att
  character(len=*), intent(in) :: name
  character(len=*), intent(in) :: values
  integer :: ierr, len, dest,source
  integer, parameter :: tag = 40004

  att => new_att()

  att%attid   = -1
  att%ATTname = trim(name)
  att%xtype   = nf90_char

  IF (.NOT. ioproc) THEN
     ALLOCATE(att%CHR(1))
     att%CHR = trim(values)
     att%LEN     = len_trim(values)
  END IF

  IF (use_mpi_io_mode) THEN
  END IF

  IF(att%len==0) CALL kill_att(att)

  
END FUNCTION nc_make_runtime_att_chr_scl
!====================================================================
!====================================================================
FUNCTION nc_make_runtime_att_chr_vec(NAME,VALUES) RESULT(ATT)
  ! NAME IS FIXED, BUT VALUES ARE SENT BY MPI IF NEEDED
  USE control
  IMPLICIT NONE
  TYPE(ncatt), POINTER :: att
  character(len=*), intent(in) :: name
  character(len=*),ALLOCATABLE, intent(in) :: values(:)
  integer :: ierr, len, dest,source,i,csize
  integer, parameter :: tag = 40004

!  if(len_trim(VALUES) .GT. Char_max_attlen) & 
!       & Call fatal_error("Can not make attribute: "//trim(NAME),&
!       &"attribute string is too long. Increase 'char_max_attlen' in mod_ncll.F")
  att => new_att()

  att%attid   = -1
  att%ATTname = trim(name)
  att%xtype   = nf90_char

  IF (.NOT. ioproc .and. allocated(values)) THEN
     ALLOCATE(att%CHR(SIZE(values)))
     att%CHR = values
     att%LEN     = -1
  END IF

  IF (use_mpi_io_mode) THEN
  END IF

  IF(.not.allocated(att%chr)) call kill_att(att)

  
END FUNCTION nc_make_runtime_att_chr_vec
!====================================================================
!====================================================================
FUNCTION nc_make_att_int_vec(NAME,values) RESULT(ATT)
  IMPLICIT NONE
  TYPE(ncatt), POINTER :: att
  character(len=*), intent(in) :: name
  INTEGER, allocatable, intent(in) :: values(:)

  if(.not. allocated(values)) & 
       & Call fatal_error("Can not make attribute: "//trim(name),&
       &"argument 'values' passed must be allocated and contain data")

  att => new_att()

  att%attid   = -1
  att%ATTname = trim(name)
  att%xtype   = nf90_int
  att%LEN     = size(values)
  allocate(att%int(att%len))
  att%int     = values

END FUNCTION nc_make_att_int_vec
!====================================================================
!====================================================================
FUNCTION nc_make_att_int(NAME,values) RESULT(ATT)
  IMPLICIT NONE
  TYPE(ncatt), POINTER :: att
  character(len=*), intent(in) :: name
  INTEGER, intent(in) :: values

  att => new_att()

  att%attid   = -1
  att%ATTname = trim(name)
  att%xtype   = nf90_int
  att%LEN     = 1
  allocate(att%int(att%len))
  att%int     = values

END FUNCTION nc_make_att_int
!====================================================================
!====================================================================
FUNCTION nc_make_att_flt(NAME,values) RESULT(ATT)
  IMPLICIT NONE
  TYPE(ncatt), POINTER :: att
  character(len=*), intent(in) :: name
  REAL(spa), intent(in) :: values

  att => new_att()

  att%attid   = -1
  att%ATTname = trim(name)
  att%xtype   = nf90_float
  att%LEN     = 1
  allocate(att%flt(att%len))
  att%flt     = values
  
END FUNCTION nc_make_att_flt
!====================================================================
!====================================================================
FUNCTION nc_make_att_flt_vec(NAME,values) RESULT(ATT)
  IMPLICIT NONE
  TYPE(ncatt), POINTER :: att
  character(len=*), intent(in) :: name
  REAL(spa), allocatable, intent(in) :: values(:)

  if(.not. allocated(values)) & 
       & Call fatal_error("Can not make attribute: "//trim(name),&
       &"argument 'values' passed must be allocated and contain data")

  att => new_att()

  att%attid   = -1
  att%ATTname = trim(name)
  att%xtype   = nf90_float
  att%LEN     = size(values)
  allocate(att%flt(att%len))
  att%flt     = values
  
END FUNCTION nc_make_att_flt_vec
!====================================================================
!====================================================================
FUNCTION nc_make_att_dbl(NAME,values) RESULT(ATT)
  IMPLICIT NONE
  TYPE(ncatt), POINTER :: att
  character(len=*), intent(in) :: name
  REAL(dp), intent(in) :: values

  att => new_att()

  att%attid   = -1
  att%ATTname = trim(name)
  att%xtype   = nf90_double
  att%LEN     = 1
  allocate(att%dbl(att%len))
  att%dbl     = values
  
END FUNCTION nc_make_att_dbl
!====================================================================
!====================================================================
FUNCTION nc_make_att_dbl_vec(NAME,values) RESULT(ATT)
  IMPLICIT NONE
  TYPE(ncatt), POINTER :: att
  character(len=*), intent(in) :: name
  REAL(dp), allocatable, intent(in) :: values(:)

  if(.not. allocated(values)) & 
       & Call fatal_error("Can not make attribute: "//trim(name),&
       &"argument 'values' passed must be allocated and contain data")

  att => new_att()

  att%attid   = -1
  att%ATTname = trim(name)
  att%xtype   = nf90_double
  att%LEN     = size(values)
  allocate(att%dbl(att%len))
  att%dbl     = values
  
END FUNCTION nc_make_att_dbl_vec
!====================================================================
!====================================================================
FUNCTION nc_get_gatt(NCF,attid) RESULT(ATT)
  implicit none
  TYPE(ncfile), INTENT(IN) :: ncf
  TYPE(ncatt),  pointer    :: att
  integer,      intent(in) :: attid
  integer                  :: status
  CHARACTER(LEN=120)       :: errmsg
  CHARACTER(LEN=NF90_MAX_NAME+1)   :: name

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "START NC_GET_GATT"

  status=nf90_inq_attname(ncf%NCID,nf90_global,attid,name)
  errmsg="Can not get a file's global attribute name: "//trim(ncf%FNAME)
  call handle_ncerr(status,errmsg)

  att => new_att()
  att%attname=trim(name)
  att%attID=attid
  
  status = nf90_inquire_attribute &
       & (ncf%NCID,nf90_global,trim(att%ATTNAME),att%XTYPE,att%LEN)

  call read_att_type(ncf%NCID,nf90_global,att)

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_GET_GATT"
END FUNCTION nc_get_gatt
!====================================================================
!====================================================================
FUNCTION nc_get_vatt(VAR,attid) RESULT(ATT)
  implicit none
  TYPE(ncvar),  INTENT(IN) :: var
  TYPE(ncatt),  pointer    :: att
  integer,      intent(in) :: attid
  integer                  :: status
  CHARACTER(LEN=120)       :: errmsg
  CHARACTER(LEN=NF90_MAX_NAME+1) :: name

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "START NC_GET_VATT"

  status=nf90_inq_attname(var%NCID,var%VARID,attid,name)
  errmsg="Can not get variable attribute name: "//trim(var%VARNAME)
  call handle_ncerr(status,errmsg)

  att => new_att()
  att%attname=trim(name)
  att%attID=attid

  status = nf90_inquire_attribute &
       & (var%NCID,var%VARID,trim(att%ATTNAME),att%XTYPE,att%LEN)

  call read_att_type(var%NCID,var%VARID,att)

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_GET_VATT"
END FUNCTION nc_get_vatt
!====================================================================
!====================================================================
SUBROUTINE read_att_type(NCID,VARID,ATT)
  implicit none
  integer, intent(in) :: ncid
  integer, intent(in) :: varid
  type(ncatt),pointer :: ATT
  integer len, status
  CHARACTER(LEN=120)     :: errmsg
  CHARACTER(LEN=4)     :: clen

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "START READ_ATT_TYPE"

  len=att%LEN
  write(clen,'(I4.4)') len
  status = 1
  select case(att%XTYPE)
  case(nf90_byte)
     allocate(att%int(len),stat=status)
     if(status/=0) CALL fatal_error("READ_ATT_TYPE could not allocate integer("//clen//")")
     status = nf90_get_att(ncid,varid,&
          & att%ATTNAME, &
          & att%int )
     errmsg="Can not get variable attribute (byte):"&
          & //trim(att%ATTNAME)
     call handle_ncerr(status,errmsg)
     
  case(nf90_short)
     allocate(att%int(len),stat=status)
     if(status/=0) CALL fatal_error("READ_ATT_TYPE could not allocate integer("//clen//")")
     status = nf90_get_att(ncid,varid,&
          & att%ATTNAME, &
          & att%int )
     errmsg="Can not get variable attribute&
          & (short):"//trim(att%ATTNAME)
     call handle_ncerr(status,errmsg)
     
  case(nf90_int)
     allocate(att%int(len),stat=status)
     if(status/=0) CALL fatal_error("READ_ATT_TYPE could not allocate integer("//clen//")")
     status = nf90_get_att(ncid,varid,&
          & att%ATTNAME, &
          & att%int )
     errmsg="Can not get variable attribute (int):"&
          & //trim(att%ATTNAME)
     call handle_ncerr(status,errmsg)
     
  case(nf90_float)
     allocate(att%flt(len),stat=status)
     if(status/=0) CALL fatal_error("READ_ATT_TYPE could not allocate float("//clen//")")
     status = nf90_get_att(ncid,varid,&
          & att%ATTNAME, &
          & att%flt )
     errmsg="Can not get variable attribute&
          & (float):"//trim(att%ATTNAME)
     call handle_ncerr(status,errmsg)
     
  case(nf90_double)
     allocate(att%DBL(len),stat=status)
     if(status/=0) CALL fatal_error("READ_ATT_TYPE could not allocate double("//clen//")")
     status = nf90_get_att(ncid,varid,&
          & att%ATTNAME, &
          & att%dbl )
     errmsg="Can not get variable attribute (double):"&
          & //trim(att%ATTNAME)
     call handle_ncerr(status,errmsg)
     
  case(nf90_char)

     CALL char_att_read_helper(ncid,varid,att%ATTNAME,att%chr,len)
     
  case default
     if(status/=0) CALL fatal_error("READ_ATT_TYPE hit default case: b&
          &ad att type")
  end select  

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END READ_ATT_TYPE"

END SUBROUTINE read_att_type
!====================================================================
!====================================================================
SUBROUTINE char_att_read_helper(NCID,VARID,ATTNAME,CHR,LEN)
  IMPLICIT NONE
  INTEGER, INTENT(IN):: NCID, VARID, LEN
  CHARACTER(LEN=*), INTENT(IN) :: ATTNAME
!  CHARACTER(LEN=LEN+1) :: TEMP
  CHARACTER(LEN=LEN) :: TEMP
  CHARACTER(LEN=*), ALLOCATABLE :: CHR(:)
  CHARACTER(LEN=120)     :: errmsg
  INTEGER :: STATUS

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "START CHAR_ATT_READ_HELPER"

  status = nf90_get_att(ncid,varid,attname, temp )
  errmsg="Can not get variable attribute (char):" &
       & //trim(attname)
  call handle_ncerr(status,errmsg)

  ! ACHAR(10) is a carage return!
  CALL split_string(temp,achar(10), chr)

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END CHAR_ATT_READ_HELPER"

END SUBROUTINE char_att_read_helper
!====================================================================
!====================================================================
SUBROUTINE write_att_type(ncid,varid,ATT)
  implicit none
  integer, intent(in) :: ncid
  integer, intent(in) :: varid
  TYPE(ncatt), intent(in) :: ATT
  integer len, status, I,slen
  CHARACTER(LEN=120)     :: errmsg

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "START WRITE_ATT_TYPE"

  len=att%LEN
  status=1
  select case(att%XTYPE)
  case(nf90_byte)
     status = nf90_put_att(ncid,varid,&
          & att%ATTNAME, &
          & att%int )
     errmsg="Can not set variable attribute (byte):"&
          & //trim(att%ATTNAME)
     call handle_ncerr(status,errmsg)
     
  case(nf90_short)
     status = nf90_put_att(ncid,varid,&
          & att%ATTNAME, &
          & att%int )
     errmsg="Can not set variable attribute&
          & (short):"//trim(att%ATTNAME)
     call handle_ncerr(status,errmsg)
     
  case(nf90_int)
     status = nf90_put_att(ncid,varid,&
          & att%ATTNAME, &
          & att%int )
     errmsg="Can not set variable attribute (int):"&
          & //trim(att%ATTNAME)
     call handle_ncerr(status,errmsg)
     
  case(nf90_float)
     status = nf90_put_att(ncid,varid,&
          & att%ATTNAME, &
          & att%flt )
     errmsg="Can not set variable attribute&
          & (float):"//trim(att%ATTNAME)
     call handle_ncerr(status,errmsg)
     
  case(nf90_double)
     status = nf90_put_att(ncid,varid,&
          & att%ATTNAME, &
          & att%dbl )
     errmsg="Can not set variable attribute (double):"&
          & //trim(att%ATTNAME)
     call handle_ncerr(status,errmsg)
     
  case(nf90_char)

     slen = 0
     DO i = 1,size(att%chr)
        slen = slen + len_trim(adjustl(att%chr(i))) + 1
     END DO

     CALL char_att_write_helper(ncid,varid, att%ATTNAME,att%chr,slen)
     
  case default
     if(status/=0) CALL fatal_error("WRITE_ATT_TYPE hit default case: b&
          &ad att type")
  end select  

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END WRITE_ATT_TYPE"

END SUBROUTINE write_att_type
!====================================================================
!====================================================================
SUBROUTINE char_att_write_helper(NCID,VARID,ATTNAME,CHR,LEN)
  IMPLICIT NONE
  INTEGER, INTENT(IN):: NCID, VARID, LEN
  CHARACTER(LEN=*), INTENT(IN) :: ATTNAME
  CHARACTER(LEN=LEN) :: TEMP
  CHARACTER(LEN=*), ALLOCATABLE :: CHR(:)
  CHARACTER(LEN=120)     :: errmsg
  INTEGER :: STATUS, I, csize

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "START CHAR_ATT_WRITE_HELPER"
  temp=""

  csize =size(chr) 
  DO i = 1,size(chr)
     temp = trim(temp)//trim(adjustl(chr(i)))
     
     ! DO not att charage return to last string
     IF(i<csize) temp = trim(temp)//achar(10)
  END DO
  
  status = nf90_put_att(ncid,varid,attname, trim(temp) )
  errmsg="Can not put variable attribute (char):" &
       & //trim(attname)
  call handle_ncerr(status,errmsg)

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END CHAR_ATT_WRITE_HELPER"

END SUBROUTINE char_att_write_helper
!====================================================================
!====================================================================
FUNCTION nc_make_avar_scl_chr(NAME,VALUES,DIM1,DIM2) RESULT(VAR)
  IMPLICIT NONE
  TYPE(ncvar), POINTER :: var
  TYPE(ncdim),  POINTER :: dim1 ! MUST BE STR LENGTH
  TYPE(ncdim), OPTIONAL, POINTER :: dim2 ! IF PRESENT THIS MUST BE UNLIMITED
  character(len=*), intent(in) :: name
  character(len=80), target, intent(in) :: values
  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "START NC_MAKE_AVAR_SCL_CHR"

  if(.NOT. ASSOCIATED(dim1)) CALL fatal_error &
       & ("NC_MAKE_AVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
 

  if(dim1%UNLIMITED) CALL fatal_error &
    & ("NC_MAKE_AVAR: WHEN MAKING CHARACTER DATA, THE FIRST DIMENSION",&
       & "MUST BE THE STING LENGTH. THE LAST DIMENSION (IF PRESENT) MUST BE UNLIMITED",&
       &"VARIABLE NAME: "//trim(name))

  var => new_var()
  
  var%VARID   = -1
  var%VARNAME = trim(name)
  var%xtype   = nf90_char
  var%scl_chr => values
  var => add(var,copy_dim(dim1))
  IF(present(dim2)) THEN
     if(.NOT. ASSOCIATED(dim2)) CALL fatal_error &
          & ("NC_MAKE_AVAR: OPTIONAL DIMENSION ARGUMENT MUST BE ASSOCIATED",&
          &"ERROR MAKING VARIABLE: "//trim(name))

     IF(.NOT. dim2%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_AVAR: WHEN MAKING CHARACTER DATA, THE LAST DIMENSION",&
          & "MUST BE THE UNLIMITED DIMENSION",&
          & "VARIABLE NAME: "//trim(name))

      var => add(var,copy_dim(dim2))
  END IF

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_MAKE_AVAR_SCL_CHR"
END FUNCTION nc_make_avar_scl_chr
!====================================================================
!====================================================================
FUNCTION nc_make_avar_vec_chr(NAME,VALUES,DIM1,DIM2,DIM3) RESULT(VAR)
  IMPLICIT NONE
  TYPE(ncvar), POINTER :: var
  TYPE(ncdim),  POINTER :: dim1 ! MUST BE STR LENGTH
  TYPE(ncdim),  POINTER :: dim2 ! Number of strings
  TYPE(ncdim), OPTIONAL, POINTER :: dim3 ! IF PRESENT THIS MUST BE UNLIMITED
  character(len=*), intent(in) :: name
  character(len=80), target,allocatable, intent(in) :: values(:)
  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "START NC_MAKE_AVAR_VEC_CHR"

  IF(.NOT. ALLOCATED(values)) CALL fatal_error &
       & ("NC_MAKE_AVAR: VALUES ARGUMENT MUST ALREADY BE ALLOCATED!",&
       & "ERROR MAKING VARIABLE: "//trim(name))

  if(.NOT. ASSOCIATED(dim1)) CALL fatal_error &
       & ("NC_MAKE_AVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))

  if(dim1%UNLIMITED) CALL fatal_error &
       & ("NC_MAKE_AVAR: WHEN MAKING CHARACTER DATA, THE FIRST DIMENSION",&
       & "MUST BE THE STRING LENGTH. THE LAST DIMENSION (IF PRESENT) MUST BE UNLIMITED",&
       &"VARIABLE NAME: "//trim(name))
  

  if(.NOT. ASSOCIATED(dim2)) CALL fatal_error &
       & ("NC_MAKE_AVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))

!  if(DIM2%UNLIMITED) CALL FATAL_ERROR &
!       & ("NC_MAKE_AVAR: WHEN MAKING CHARACTER DATA, THE FIRST DIMENSION",&
!       & "MUST BE THE STRING LENGTH. THE LAST DIMENSION (IF PRESENT) MUST BE UNLIMITED",&
!       &"VARIABLE NAME: "//TRIM(NAME))

  var => new_var()
  
  var%VARID   = -1
  var%VARNAME = trim(name)
  var%xtype   = nf90_char
  var%vec_chr => values
  var => add(var,copy_dim(dim1))
  var => add(var,copy_dim(dim2))
  IF(present(dim3)) THEN
     if(.NOT. ASSOCIATED(dim3)) CALL fatal_error &
          & ("NC_MAKE_AVAR: OPTIONAL DIMENSION ARGUMENT MUST BE ASSOCIATED",&
          &"ERROR MAKING VARIABLE: "//trim(name))

     IF(.NOT. dim3%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_AVAR: WHEN MAKING CHARACTER DATA, THE LAST DIMENSION",&
          & "MUST BE THE UNLIMITED DIMENSION",&
          & "VARIABLE NAME: "//trim(name))

      var => add(var,copy_dim(dim3))
  END IF

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_MAKE_AVAR_VEC_CHR"
END FUNCTION nc_make_avar_vec_chr
!====================================================================
!====================================================================
FUNCTION nc_make_avar_scl_dbl(NAME,VALUES,DIM1) RESULT(VAR)
  IMPLICIT NONE
  TYPE(ncvar), POINTER :: var
  TYPE(ncdim), OPTIONAL, POINTER :: dim1
  character(len=*), intent(in) :: name
  REAL(dp), target, intent(in) :: values
  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "START NC_MAKE_AVAR_SCL_DBL"

  var => new_var()

  var%VARID   = -1
  var%VARNAME = trim(name)
  var%xtype   = nf90_double
  var%scl_dbl => values
  IF(present(dim1)) THEN
     if(.NOT. ASSOCIATED(dim1)) CALL fatal_error &
          & ("NC_MAKE_AVAR: OPTIONAL DIMENSION ARGUMENT MUST BE ASSOCIATED",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     if(.NOT. dim1%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_AVAR: OPTIONAL DIMENSION ARGUMENT MUST BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     var => add(var,copy_dim(dim1))
  END IF

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_MAKE_AVAR_SCL_DBL"
END FUNCTION nc_make_avar_scl_dbl
!====================================================================
!====================================================================
FUNCTION nc_make_avar_vec_dbl(NAME,VALUES,DIM1,DIM2) RESULT(VAR)
  IMPLICIT NONE
  TYPE(ncvar), POINTER :: var
  TYPE(ncdim), POINTER :: dim1
  TYPE(ncdim), OPTIONAL, POINTER :: dim2
  character(len=*), intent(in) :: name
  REAL(dp), allocatable, target, intent(in) :: values(:)
  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "START NC_MAKE_AVAR_VEC_DBL"

  IF(.NOT. ALLOCATED(values)) CALL fatal_error &
       & ("NC_MAKE_AVAR: VALUES ARGUMENT MUST ALREADY BE ALLOCATED!",&
       & "ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim1)) CALL fatal_error &
       & ("NC_MAKE_AVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
!  if(DIM1%UNLIMITED) CALL FATAL_ERROR &
!          & ("NC_MAKE_AVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
!          &"ERROR MAKING VARIABLE: "//TRIM(NAME))
  var => new_var()

  var%VARID   = -1
  var%VARNAME = trim(name)
  var%xtype   = nf90_double
  var%vec_dbl => values
  var => add(var,copy_dim(dim1))
  if(present(dim2)) then
     if(.NOT. ASSOCIATED(dim2)) CALL fatal_error &
          & ("NC_MAKE_AVAR: OPTIONAL DIMENSION ARGUMENT MUST BE ASSOCIATED",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     if(.NOT. dim2%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_AVAR: OPTIONAL DIMENSION ARGUMENT MUST BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     var => add(var,copy_dim(dim2))
  end if

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_MAKE_AVAR_VEC_DBL"
END FUNCTION nc_make_avar_vec_dbl
!====================================================================
!====================================================================
FUNCTION nc_make_avar_arr_dbl(NAME,VALUES,DIM1,DIM2,DIM3) RESULT(VAR)
  IMPLICIT NONE
  TYPE(ncvar), POINTER :: var
  TYPE(ncdim), POINTER :: dim1
  TYPE(ncdim), POINTER :: dim2
  TYPE(ncdim), OPTIONAL, POINTER :: dim3
  character(len=*), intent(in) :: name
  REAL(dp), allocatable, target, intent(in) :: values(:,:)
  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "START NC_MAKE_AVAR_ARR_DBL"

  IF(.NOT. ALLOCATED(values)) CALL fatal_error &
       & ("NC_MAKE_AVAR: VALUES ARGUMENT MUST ALREADY BE ALLOCATED!",&
       & "ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim1)) CALL fatal_error &
       & ("NC_MAKE_AVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
  if(dim1%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_AVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim2)) CALL fatal_error &
       & ("NC_MAKE_AVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
!  if(DIM2%UNLIMITED) CALL FATAL_ERROR &
!          & ("NC_MAKE_AVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
!          &"ERROR MAKING VARIABLE: "//TRIM(NAME))
  var => new_var()

  var%VARID   = -1
  var%VARNAME = trim(name)
  var%xtype   = nf90_double
  var%arr_dbl => values
  var => add(var,copy_dim(dim1))
  var => add(var,copy_dim(dim2))
  if(present(dim3)) then
     if(.NOT. ASSOCIATED(dim3)) CALL fatal_error &
          & ("NC_MAKE_AVAR: OPTIONAL DIMENSION ARGUMENT MUST BE ASSOCIATED",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     if(.NOT. dim3%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_AVAR: OPTIONAL DIMENSION ARGUMENT MUST BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     var => add(var,copy_dim(dim3))
  end if

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_MAKE_AVAR_ARR_DBL"
END FUNCTION nc_make_avar_arr_dbl
!====================================================================
!====================================================================
FUNCTION nc_make_avar_cub_dbl(NAME,VALUES,DIM1,DIM2,DIM3,DIM4) RESULT(VAR)
  IMPLICIT NONE
  TYPE(ncvar), POINTER :: var
  TYPE(ncdim), POINTER :: dim1
  TYPE(ncdim), POINTER :: dim2
  TYPE(ncdim), POINTER :: dim3
  TYPE(ncdim), OPTIONAL, POINTER :: dim4
  character(len=*), intent(in) :: name
  REAL(dp), allocatable, target, intent(in) :: values(:,:,:)
  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "START NC_MAKE_AVAR_CUB_DBL"

  IF(.NOT. ALLOCATED(values)) CALL fatal_error &
       & ("NC_MAKE_AVAR: VALUES ARGUMENT MUST ALREADY BE ALLOCATED!",&
       & "ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim1)) CALL fatal_error &
       & ("NC_MAKE_AVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
  if(dim1%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_AVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim2)) CALL fatal_error &
       & ("NC_MAKE_AVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
  if(dim2%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_AVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim3)) CALL fatal_error &
       & ("NC_MAKE_AVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
!  if(DIM3%UNLIMITED) CALL FATAL_ERROR &
!          & ("NC_MAKE_AVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
!          &"ERROR MAKING VARIABLE: "//TRIM(NAME))
  var => new_var()

  var%VARID   = -1
  var%VARNAME = trim(name)
  var%xtype   = nf90_double
  var%cub_dbl => values
  var => add(var,copy_dim(dim1))
  var => add(var,copy_dim(dim2))
  var => add(var,copy_dim(dim3))
  if(present(dim4)) then
     if(.NOT. ASSOCIATED(dim4)) CALL fatal_error &
          & ("NC_MAKE_AVAR: OPTIONAL DIMENSION ARGUMENT MUST BE ASSOCIATED",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     if(.NOT. dim4%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_AVAR: OPTIONAL DIMENSION ARGUMENT MUST BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     var => add(var,copy_dim(dim4))
  end if

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_MAKE_AVAR_CUB_DBL"
END FUNCTION nc_make_avar_cub_dbl
!====================================================================
!====================================================================
FUNCTION nc_make_avar_fda_dbl(NAME,VALUES,DIM1,DIM2,DIM3,DIM4,DIM5) RESULT(VAR)
  IMPLICIT NONE
  TYPE(ncvar), POINTER :: var
  TYPE(ncdim), POINTER :: dim1
  TYPE(ncdim), POINTER :: dim2
  TYPE(ncdim), POINTER :: dim3
  TYPE(ncdim), POINTER :: dim4
  TYPE(ncdim), OPTIONAL, POINTER :: dim5
  character(len=*), intent(in) :: name
  REAL(dp), allocatable, target, intent(in) :: values(:,:,:,:)
  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "START NC_MAKE_AVAR_FDA_DBL"

  IF(.NOT. ALLOCATED(values)) CALL fatal_error &
       & ("NC_MAKE_AVAR: VALUES ARGUMENT MUST ALREADY BE ALLOCATED!",&
       & "ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim1)) CALL fatal_error &
       & ("NC_MAKE_AVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
  if(dim1%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_AVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim2)) CALL fatal_error &
       & ("NC_MAKE_AVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
  if(dim2%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_AVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim3)) CALL fatal_error &
       & ("NC_MAKE_AVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
  if(dim3%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_AVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim4)) CALL fatal_error &
       & ("NC_MAKE_AVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
!  if(DIM4%UNLIMITED) CALL FATAL_ERROR &
!          & ("NC_MAKE_AVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
!          &"ERROR MAKING VARIABLE: "//TRIM(NAME))
  var => new_var()

  var%VARID   = -1
  var%VARNAME = trim(name)
  var%xtype   = nf90_double
  var%fda_dbl => values
  var => add(var,copy_dim(dim1))
  var => add(var,copy_dim(dim2))
  var => add(var,copy_dim(dim3))
  var => add(var,copy_dim(dim4))
  if(present(dim5)) then
     if(.NOT. ASSOCIATED(dim5)) CALL fatal_error &
          & ("NC_MAKE_AVAR: OPTIONAL DIMENSION ARGUMENT MUST BE ASSOCIATED",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     if(.NOT. dim5%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_AVAR: OPTIONAL DIMENSION ARGUMENT MUST BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     var => add(var,copy_dim(dim5))
  end if

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_MAKE_AVAR_FDA_DBL"
END FUNCTION nc_make_avar_fda_dbl
!====================================================================
!====================================================================
FUNCTION nc_make_avar_scl_flt(NAME,VALUES,DIM1) RESULT(VAR)
  IMPLICIT NONE
  TYPE(ncvar), POINTER :: var
  TYPE(ncdim), OPTIONAL, POINTER :: dim1
  character(len=*), intent(in) :: name
  REAL(spa), target, intent(in) :: values
  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "START NC_MAKE_AVAR_SCL_FLT"

  var => new_var()

  var%VARID   = -1
  var%VARNAME = trim(name)
  var%xtype   = nf90_float
  var%scl_flt => values
  IF(present(dim1)) THEN
     if(.NOT. ASSOCIATED(dim1)) CALL fatal_error &
          & ("NC_MAKE_AVAR: OPTIONAL DIMENSION ARGUMENT MUST BE ASSOCIATED",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     if(.NOT. dim1%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_AVAR: OPTIONAL DIMENSION ARGUMENT MUST BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     var => add(var,copy_dim(dim1))
  END IF

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_MAKE_AVAR_SCL_FLT"
END FUNCTION nc_make_avar_scl_flt
!====================================================================
!====================================================================
FUNCTION nc_make_avar_vec_flt(NAME,VALUES,DIM1,DIM2) RESULT(VAR)
  IMPLICIT NONE
  TYPE(ncvar), POINTER :: var
  TYPE(ncdim), POINTER :: dim1
  TYPE(ncdim), OPTIONAL, POINTER :: dim2
  character(len=*), intent(in) :: name
  REAL(spa), allocatable, target, intent(in) :: values(:)
  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "START NC_MAKE_AVAR_VEC_FLT"

  IF(.NOT. ALLOCATED(values)) CALL fatal_error &
       & ("NC_MAKE_AVAR: VALUES ARGUMENT MUST ALREADY BE ALLOCATED!",&
       & "ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim1)) CALL fatal_error &
       & ("NC_MAKE_AVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
!  if(DIM1%UNLIMITED) CALL FATAL_ERROR &
!          & ("NC_MAKE_AVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
!          &"ERROR MAKING VARIABLE: "//TRIM(NAME))
  var => new_var()

  var%VARID   = -1
  var%VARNAME = trim(name)
  var%xtype   = nf90_float
  var%vec_flt => values(1:)
  var => add(var,copy_dim(dim1))
  if(present(dim2)) then
     if(.NOT. ASSOCIATED(dim2)) CALL fatal_error &
          & ("NC_MAKE_AVAR: OPTIONAL DIMENSION ARGUMENT MUST BE ASSOCIATED",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     if(.NOT. dim2%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_AVAR: OPTIONAL DIMENSION ARGUMENT MUST BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     var => add(var,copy_dim(dim2))
  end if

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_MAKE_AVAR_VEC_FLT"
END FUNCTION nc_make_avar_vec_flt
!====================================================================
!====================================================================
FUNCTION nc_make_avar_arr_flt(NAME,VALUES,DIM1,DIM2,DIM3) RESULT(VAR)
  IMPLICIT NONE
  TYPE(ncvar), POINTER :: var
  TYPE(ncdim), POINTER :: dim1
  TYPE(ncdim), POINTER :: dim2
  TYPE(ncdim), OPTIONAL, POINTER :: dim3
  character(len=*), intent(in) :: name
  REAL(spa), allocatable, target, intent(in) :: values(:,:)
  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "START NC_MAKE_AVAR_ARR_FLT"

  IF(.NOT. ALLOCATED(values)) CALL fatal_error &
       & ("NC_MAKE_AVAR: VALUES ARGUMENT MUST ALREADY BE ALLOCATED!",&
       & "ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim1)) CALL fatal_error &
       & ("NC_MAKE_AVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
  if(dim1%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_AVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim2)) CALL fatal_error &
       & ("NC_MAKE_AVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
!  if(DIM2%UNLIMITED) CALL FATAL_ERROR &
!          & ("NC_MAKE_AVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
!          &"ERROR MAKING VARIABLE: "//TRIM(NAME))
  var => new_var()

  var%VARID   = -1
  var%VARNAME = trim(name)
  var%xtype   = nf90_float
  var%arr_flt => values
  var => add(var,copy_dim(dim1))
  var => add(var,copy_dim(dim2))
  if(present(dim3)) then
     if(.NOT. ASSOCIATED(dim3)) CALL fatal_error &
          & ("NC_MAKE_AVAR: OPTIONAL DIMENSION ARGUMENT MUST BE ASSOCIATED",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     if(.NOT. dim3%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_AVAR: OPTIONAL DIMENSION ARGUMENT MUST BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     var => add(var,copy_dim(dim3))
  end if

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_MAKE_AVAR_ARR_FLT"
END FUNCTION nc_make_avar_arr_flt
!====================================================================
!====================================================================
FUNCTION nc_make_avar_cub_flt(NAME,VALUES,DIM1,DIM2,DIM3,DIM4) RESULT(VAR)
  IMPLICIT NONE
  TYPE(ncvar), POINTER :: var
  TYPE(ncdim), POINTER :: dim1
  TYPE(ncdim), POINTER :: dim2
  TYPE(ncdim), POINTER :: dim3
  TYPE(ncdim), OPTIONAL, POINTER :: dim4
  character(len=*), intent(in) :: name
  REAL(spa), allocatable, target, intent(in) :: values(:,:,:)
  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "START NC_MAKE_AVAR_CUB_FLT"

  IF(.NOT. ALLOCATED(values)) CALL fatal_error &
       & ("NC_MAKE_AVAR: VALUES ARGUMENT MUST ALREADY BE ALLOCATED!",&
       & "ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim1)) CALL fatal_error &
       & ("NC_MAKE_AVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
  if(dim1%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_AVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim2)) CALL fatal_error &
       & ("NC_MAKE_AVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
  if(dim2%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_AVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim3)) CALL fatal_error &
       & ("NC_MAKE_AVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
!  if(DIM3%UNLIMITED) CALL FATAL_ERROR &
!          & ("NC_MAKE_AVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
!          &"ERROR MAKING VARIABLE: "//TRIM(NAME))
  var => new_var()

  var%VARID   = -1
  var%VARNAME = trim(name)
  var%xtype   = nf90_float
  var%cub_flt => values
  var => add(var,copy_dim(dim1))
  var => add(var,copy_dim(dim2))
  var => add(var,copy_dim(dim3))
  if(present(dim4)) then
     if(.NOT. ASSOCIATED(dim4)) CALL fatal_error &
          & ("NC_MAKE_AVAR: OPTIONAL DIMENSION ARGUMENT MUST BE ASSOCIATED",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     if(.NOT. dim4%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_AVAR: OPTIONAL DIMENSION ARGUMENT MUST BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     var => add(var,copy_dim(dim4))
  end if

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_MAKE_AVAR_CUB_FLT"
END FUNCTION nc_make_avar_cub_flt
!====================================================================
!====================================================================
FUNCTION nc_make_avar_fda_flt(NAME,VALUES,DIM1,DIM2,DIM3,DIM4,DIM5) RESULT(VAR)
  IMPLICIT NONE
  TYPE(ncvar), POINTER :: var
  TYPE(ncdim), POINTER :: dim1
  TYPE(ncdim), POINTER :: dim2
  TYPE(ncdim), POINTER :: dim3
  TYPE(ncdim), POINTER :: dim4
  TYPE(ncdim), OPTIONAL, POINTER :: dim5
  character(len=*), intent(in) :: name
  REAL(spa), allocatable, target, intent(in) :: values(:,:,:,:)
  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "START NC_MAKE_AVAR_FDA_FLT"

  IF(.NOT. ALLOCATED(values)) CALL fatal_error &
       & ("NC_MAKE_AVAR: VALUES ARGUMENT MUST ALREADY BE ALLOCATED!",&
       & "ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim1)) CALL fatal_error &
       & ("NC_MAKE_AVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
  if(dim1%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_AVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim2)) CALL fatal_error &
       & ("NC_MAKE_AVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
  if(dim2%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_AVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim3)) CALL fatal_error &
       & ("NC_MAKE_AVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
  if(dim3%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_AVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim4)) CALL fatal_error &
       & ("NC_MAKE_AVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
!  if(DIM4%UNLIMITED) CALL FATAL_ERROR &
!          & ("NC_MAKE_AVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
!          &"ERROR MAKING VARIABLE: "//TRIM(NAME))
  var => new_var()

  var%VARID   = -1
  var%VARNAME = trim(name)
  var%xtype   = nf90_float
  var%fda_flt => values
  var => add(var,copy_dim(dim1))
  var => add(var,copy_dim(dim2))
  var => add(var,copy_dim(dim3))
  var => add(var,copy_dim(dim4))
  if(present(dim5)) then
     if(.NOT. ASSOCIATED(dim5)) CALL fatal_error &
          & ("NC_MAKE_AVAR: OPTIONAL DIMENSION ARGUMENT MUST BE ASSOCIATED",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     if(.NOT. dim5%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_AVAR: OPTIONAL DIMENSION ARGUMENT MUST BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     var => add(var,copy_dim(dim5))
  end if

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_MAKE_AVAR_FDA_FLT"
END FUNCTION nc_make_avar_fda_flt
!====================================================================
!====================================================================
FUNCTION nc_make_avar_scl_int(NAME,VALUES,DIM1) RESULT(VAR)
  IMPLICIT NONE
  TYPE(ncvar), POINTER :: var
  TYPE(ncdim), OPTIONAL, POINTER :: dim1
  character(len=*), intent(in) :: name
  INTEGER, target, intent(in) :: values
  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "START NC_MAKE_AVAR_SCL_INT"

  var => new_var()

  var%VARID   = -1
  var%VARNAME = trim(name)
  var%xtype   = nf90_int
  var%scl_int => values
  IF(present(dim1)) THEN
     if(.NOT. ASSOCIATED(dim1)) CALL fatal_error &
          & ("NC_MAKE_AVAR: OPTIONAL DIMENSION ARGUMENT MUST BE ASSOCIATED",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     if(.NOT. dim1%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_AVAR: OPTIONAL DIMENSION ARGUMENT MUST BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     var => add(var,copy_dim(dim1))
  END IF

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_MAKE_AVAR_SCL_INT"
END FUNCTION nc_make_avar_scl_int
!====================================================================
!====================================================================
FUNCTION nc_make_avar_vec_int(NAME,VALUES,DIM1,DIM2) RESULT(VAR)
  IMPLICIT NONE
  TYPE(ncvar), POINTER :: var
  TYPE(ncdim), POINTER :: dim1
  TYPE(ncdim), OPTIONAL, POINTER :: dim2
  character(len=*), intent(in) :: name
  INTEGER, allocatable, target, intent(in) :: values(:)
  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "START NC_MAKE_AVAR_VEC_INT"

  IF(.NOT. ALLOCATED(values)) CALL fatal_error &
       & ("NC_MAKE_AVAR: VALUES ARGUMENT MUST ALREADY BE ALLOCATED!",&
       & "ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim1)) CALL fatal_error &
       & ("NC_MAKE_AVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
!  if(DIM1%UNLIMITED) CALL FATAL_ERROR &
!          & ("NC_MAKE_AVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
!          &"ERROR MAKING VARIABLE: "//TRIM(NAME))
  var => new_var()

  var%VARID   = -1
  var%VARNAME = trim(name)
  var%xtype   = nf90_int
  var%vec_int => values
  var => add(var,copy_dim(dim1))
  if(present(dim2)) then
     if(.NOT. ASSOCIATED(dim2)) CALL fatal_error &
          & ("NC_MAKE_AVAR: OPTIONAL DIMENSION ARGUMENT MUST BE ASSOCIATED",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     if(.NOT. dim2%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_AVAR: OPTIONAL DIMENSION ARGUMENT MUST BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     var => add(var,copy_dim(dim2))
  end if

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_MAKE_AVAR_VEC_INT"
END FUNCTION nc_make_avar_vec_int
!====================================================================
!====================================================================
FUNCTION nc_make_avar_arr_int(NAME,VALUES,DIM1,DIM2,DIM3) RESULT(VAR)
  IMPLICIT NONE
  TYPE(ncvar), POINTER :: var
  TYPE(ncdim), POINTER :: dim1
  TYPE(ncdim), POINTER :: dim2
  TYPE(ncdim), OPTIONAL, POINTER :: dim3
  character(len=*), intent(in) :: name
  INTEGER, allocatable, target, intent(in) :: values(:,:)
  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "START NC_MAKE_AVAR_ARR_INT"

  IF(.NOT. ALLOCATED(values)) CALL fatal_error &
       & ("NC_MAKE_AVAR: VALUES ARGUMENT MUST ALREADY BE ALLOCATED!",&
       & "ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim1)) CALL fatal_error &
       & ("NC_MAKE_AVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
  if(dim1%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_AVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim2)) CALL fatal_error &
       & ("NC_MAKE_AVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
!  if(DIM2%UNLIMITED) CALL FATAL_ERROR &
!          & ("NC_MAKE_AVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
!          &"ERROR MAKING VARIABLE: "//TRIM(NAME))
  var => new_var()

  var%VARID   = -1
  var%VARNAME = trim(name)
  var%xtype   = nf90_int
  var%arr_int => values
  var => add(var,copy_dim(dim1))
  var => add(var,copy_dim(dim2))
  if(present(dim3)) then
     if(.NOT. ASSOCIATED(dim3)) CALL fatal_error &
          & ("NC_MAKE_AVAR: OPTIONAL DIMENSION ARGUMENT MUST BE ASSOCIATED",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     if(.NOT. dim3%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_AVAR: OPTIONAL DIMENSION ARGUMENT MUST BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     var => add(var,copy_dim(dim3))
  end if

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_MAKE_AVAR_ARR_INT"
END FUNCTION nc_make_avar_arr_int
!====================================================================
!====================================================================
FUNCTION nc_make_avar_cub_int(NAME,VALUES,DIM1,DIM2,DIM3,DIM4) RESULT(VAR)
  IMPLICIT NONE
  TYPE(ncvar), POINTER :: var
  TYPE(ncdim), POINTER :: dim1
  TYPE(ncdim), POINTER :: dim2
  TYPE(ncdim), POINTER :: dim3
  TYPE(ncdim), OPTIONAL, POINTER :: dim4
  character(len=*), intent(in) :: name
  INTEGER, allocatable, target, intent(in) :: values(:,:,:)
  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "START NC_MAKE_AVAR_CUB_INT"

  IF(.NOT. ALLOCATED(values)) CALL fatal_error &
       & ("NC_MAKE_AVAR: VALUES ARGUMENT MUST ALREADY BE ALLOCATED!",&
       & "ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim1)) CALL fatal_error &
       & ("NC_MAKE_AVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
  if(dim1%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_AVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim2)) CALL fatal_error &
       & ("NC_MAKE_AVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
  if(dim2%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_AVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim3)) CALL fatal_error &
       & ("NC_MAKE_AVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
!  if(DIM3%UNLIMITED) CALL FATAL_ERROR &
!          & ("NC_MAKE_AVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
!          &"ERROR MAKING VARIABLE: "//TRIM(NAME))
  var => new_var()

  var%VARID   = -1
  var%VARNAME = trim(name)
  var%xtype   = nf90_int
  var%cub_int => values
  var => add(var,copy_dim(dim1))
  var => add(var,copy_dim(dim2))
  var => add(var,copy_dim(dim3))
  if(present(dim4)) then
     if(.NOT. ASSOCIATED(dim4)) CALL fatal_error &
          & ("NC_MAKE_AVAR: OPTIONAL DIMENSION ARGUMENT MUST BE ASSOCIATED",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     if(.NOT. dim4%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_AVAR: OPTIONAL DIMENSION ARGUMENT MUST BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     var => add(var,copy_dim(dim4))
  end if

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_MAKE_AVAR_CUB_INT"
END FUNCTION nc_make_avar_cub_int
!====================================================================
!====================================================================
FUNCTION nc_make_avar_fda_int(NAME,VALUES,DIM1,DIM2,DIM3,DIM4,DIM5) RESULT(VAR)
  IMPLICIT NONE
  TYPE(ncvar), POINTER :: var
  TYPE(ncdim), POINTER :: dim1
  TYPE(ncdim), POINTER :: dim2
  TYPE(ncdim), POINTER :: dim3
  TYPE(ncdim), POINTER :: dim4
  TYPE(ncdim), OPTIONAL, POINTER :: dim5
  character(len=*), intent(in) :: name
  INTEGER, allocatable, target, intent(in) :: values(:,:,:,:)
  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "START NC_MAKE_AVAR_FDA_INT"

  IF(.NOT. ALLOCATED(values)) CALL fatal_error &
       & ("NC_MAKE_AVAR: VALUES ARGUMENT MUST ALREADY BE ALLOCATED!",&
       & "ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim1)) CALL fatal_error &
       & ("NC_MAKE_AVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
  if(dim1%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_AVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim2)) CALL fatal_error &
       & ("NC_MAKE_AVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
  if(dim2%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_AVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim3)) CALL fatal_error &
       & ("NC_MAKE_AVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
  if(dim3%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_AVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim4)) CALL fatal_error &
       & ("NC_MAKE_AVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
!  if(DIM4%UNLIMITED) CALL FATAL_ERROR &
!          & ("NC_MAKE_AVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
!          &"ERROR MAKING VARIABLE: "//TRIM(NAME))
  var => new_var()

  var%VARID   = -1
  var%VARNAME = trim(name)
  var%xtype   = nf90_int
  var%fda_int => values
  var => add(var,copy_dim(dim1))
  var => add(var,copy_dim(dim2))
  var => add(var,copy_dim(dim3))
  var => add(var,copy_dim(dim4))
  if(present(dim5)) then
     if(.NOT. ASSOCIATED(dim5)) CALL fatal_error &
          & ("NC_MAKE_AVAR: OPTIONAL DIMENSION ARGUMENT MUST BE ASSOCIATED",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     if(.NOT. dim5%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_AVAR: OPTIONAL DIMENSION ARGUMENT MUST BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     var => add(var,copy_dim(dim5))
  end if

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_MAKE_AVAR_FDA_INT"
END FUNCTION nc_make_avar_fda_int
!====================================================================
!====================================================================
FUNCTION nc_make_pvar_scl_chr(NAME,VALUES,DIM1,DIM2) RESULT(VAR)
  IMPLICIT NONE
  TYPE(ncvar), POINTER :: var
  TYPE(ncdim),  POINTER :: dim1 ! MUST BE STR LENGTH
  TYPE(ncdim), OPTIONAL, POINTER :: dim2 ! IF PRESENT THIS MUST BE UNLIMITED
  character(len=*), intent(in) :: name
  character(len=80), POINTER, intent(in) :: values
  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "START NC_MAKE_PVAR_SCL_CHR"

  IF(.NOT. ASSOCIATED(values)) CALL fatal_error &
       & ("NC_MAKE_PVAR: VALUES ARGUMENT MUST ALREADY BE ASSOCIATED!",&
       & "ERROR MAKING VARIABLE: "//trim(name))

  if(.NOT. ASSOCIATED(dim1)) CALL fatal_error &
       & ("NC_MAKE_PVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
 

  if(dim1%UNLIMITED) CALL fatal_error &
    & ("NC_MAKE_PVAR: WHEN MAKING CHARACTER DATA, THE FIRST DIMENSION",&
       & "MUST BE THE STING LENGTH. THE LAST DIMENSION (IF PRESENT) MUST BE UNLIMITED",&
       &"VARIABLE NAME: "//trim(name))

  var => new_var()
  
  var%VARID   = -1
  var%VARNAME = trim(name)
  var%xtype   = nf90_char
  var%scl_chr => values
  var => add(var,copy_dim(dim1))
  IF(present(dim2)) THEN
     if(.NOT. ASSOCIATED(dim2)) CALL fatal_error &
          & ("NC_MAKE_PVAR: OPTIONAL DIMENSION ARGUMENT MUST BE ASSOCIATED",&
          &"ERROR MAKING VARIABLE: "//trim(name))

     IF(.NOT. dim2%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_PVAR: WHEN MAKING CHARACTER DATA, THE LAST DIMENSION",&
          & "MUST BE THE UNLIMITED DIMENSION",&
          & "VARIABLE NAME: "//trim(name))

      var => add(var,copy_dim(dim2))
  END IF

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_MAKE_PVAR_SCL_CHR"
END FUNCTION nc_make_pvar_scl_chr
!====================================================================
!====================================================================
FUNCTION nc_make_pvar_vec_chr(NAME,VALUES,DIM1,DIM2,DIM3) RESULT(VAR)
  IMPLICIT NONE
  TYPE(ncvar), POINTER :: var
  TYPE(ncdim),  POINTER :: dim1 ! MUST BE STR LENGTH
  TYPE(ncdim),  POINTER :: dim2 ! Number of strings
  TYPE(ncdim), OPTIONAL, POINTER :: dim3 ! IF PRESENT THIS MUST BE UNLIMITED
  character(len=*), intent(in) :: name
  character(len=80), POINTER, intent(in) :: values(:)
  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "START NC_MAKE_PVAR_VEC_CHR"

  IF(.NOT. ASSOCIATED(values)) CALL fatal_error &
       & ("NC_MAKE_PVAR: VALUES ARGUMENT MUST ALREADY BE ASSOCIATED!",&
       & "ERROR MAKING VARIABLE: "//trim(name))

  if(.NOT. ASSOCIATED(dim1)) CALL fatal_error &
       & ("NC_MAKE_PVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))

  if(dim1%UNLIMITED) CALL fatal_error &
       & ("NC_MAKE_PVAR: WHEN MAKING CHARACTER DATA, THE FIRST DIMENSION",&
       & "MUST BE THE STRING LENGTH. THE LAST DIMENSION (IF PRESENT) MUST BE UNLIMITED",&
       &"VARIABLE NAME: "//trim(name))
  
  if(.NOT. ASSOCIATED(dim2)) CALL fatal_error &
       & ("NC_MAKE_PVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))

!  if(DIM2%UNLIMITED) CALL WARNING &
!       & ("NC_MAKE_PVAR: WHEN MAKING CHARACTER DATA, THE FIRST DIMENSION",&
!       & "MUST BE THE STRING LENGTH. THE LAST DIMENSION (IF PRESENT) MUST BE UNLIMITED",&
!       &"VARIABLE NAME: "//TRIM(NAME))

  var => new_var()
  
  var%VARID   = -1
  var%VARNAME = trim(name)
  var%xtype   = nf90_char
  var%vec_chr => values
  var => add(var,copy_dim(dim1))
  var => add(var,copy_dim(dim2))
  IF(present(dim3)) THEN
     if(.NOT. ASSOCIATED(dim3)) CALL fatal_error &
          & ("NC_MAKE_PVAR: OPTIONAL DIMENSION ARGUMENT MUST BE ASSOCIATED",&
          &"ERROR MAKING VARIABLE: "//trim(name))

     IF(.NOT. dim3%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_PVAR: WHEN MAKING CHARACTER DATA, THE LAST DIMENSION",&
          & "MUST BE THE UNLIMITED DIMENSION",&
          & "VARIABLE NAME: "//trim(name))

      var => add(var,copy_dim(dim3))
  END IF

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_MAKE_PVAR_VEC_CHR"
END FUNCTION nc_make_pvar_vec_chr
!====================================================================
!====================================================================
FUNCTION nc_make_pvar_scl_dbl(NAME,VALUES,DIM1) RESULT(VAR)
  IMPLICIT NONE
  TYPE(ncvar), POINTER :: var
  TYPE(ncdim), OPTIONAL, POINTER :: dim1
  character(len=*), intent(in) :: name
  REAL(dp), POINTER, intent(in) :: values
  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "START NC_MAKE_PVAR_SCL_DBL"

  IF(.NOT. ASSOCIATED(values)) CALL fatal_error &
       & ("NC_MAKE_PVAR: VALUES ARGUMENT MUST ALREADY BE ASSOCIATED!",&
       & "ERROR MAKING VARIABLE: "//trim(name))
  
  var => new_var()

  var%VARID   = -1
  var%VARNAME = trim(name)
  var%xtype   = nf90_double
  var%scl_dbl => values
  IF(present(dim1)) THEN
     if(.NOT. ASSOCIATED(dim1)) CALL fatal_error &
          & ("NC_MAKE_PVAR: OPTIONAL DIMENSION ARGUMENT MUST BE ASSOCIATED",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     if(.NOT. dim1%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_PVAR: OPTIONAL DIMENSION ARGUMENT MUST BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     var => add(var,copy_dim(dim1))
  END IF

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_MAKE_PVAR_SCL_DBL"
END FUNCTION nc_make_pvar_scl_dbl
!====================================================================
!====================================================================
FUNCTION nc_make_pvar_vec_dbl(NAME,VALUES,DIM1,DIM2) RESULT(VAR)
  IMPLICIT NONE
  TYPE(ncvar), POINTER :: var
  TYPE(ncdim), POINTER :: dim1
  TYPE(ncdim), OPTIONAL, POINTER :: dim2
  character(len=*), intent(in) :: name
  REAL(dp), POINTER, intent(in) :: values(:)
  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "START NC_MAKE_PVAR_VEC_DBL"

  IF(.NOT. ASSOCIATED(values)) CALL fatal_error &
       & ("NC_MAKE_PVAR: VALUES ARGUMENT MUST ALREADY BE ASSOCIATED!",&
       & "ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim1)) CALL fatal_error &
       & ("NC_MAKE_PVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
!  if(DIM1%UNLIMITED) CALL FATAL_ERROR &
!       & ("NC_MAKE_PVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
!       &"ERROR MAKING VARIABLE: "//TRIM(NAME))
  

  var => new_var()

  var%VARID   = -1
  var%VARNAME = trim(name)
  var%xtype   = nf90_double
  var%vec_dbl => values
  var => add(var,copy_dim(dim1))
  if(present(dim2)) then
     if(.NOT. ASSOCIATED(dim2)) CALL fatal_error &
          & ("NC_MAKE_PVAR: OPTIONAL DIMENSION ARGUMENT MUST BE ASSOCIATED",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     if(.NOT. dim2%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_PVAR: OPTIONAL DIMENSION ARGUMENT MUST BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     var => add(var,copy_dim(dim2))
  end if

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_MAKE_PVAR_VEC_DBL"
END FUNCTION nc_make_pvar_vec_dbl
!====================================================================
!====================================================================
FUNCTION nc_make_pvar_arr_dbl(NAME,VALUES,DIM1,DIM2,DIM3) RESULT(VAR)
  IMPLICIT NONE
  TYPE(ncvar), POINTER :: var
  TYPE(ncdim), POINTER :: dim1
  TYPE(ncdim), POINTER :: dim2
  TYPE(ncdim), OPTIONAL, POINTER :: dim3
  character(len=*), intent(in) :: name
  REAL(dp), POINTER, intent(in) :: values(:,:)
  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "START NC_MAKE_PVAR_ARR_DBL"

  IF(.NOT. ASSOCIATED(values)) CALL fatal_error &
       & ("NC_MAKE_PVAR: VALUES ARGUMENT MUST ALREADY BE ASSOCIATED!",&
       & "ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim1)) CALL fatal_error &
       & ("NC_MAKE_PVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
  if(dim1%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_PVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim2)) CALL fatal_error &
       & ("NC_MAKE_PVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
!  if(DIM2%UNLIMITED) CALL FATAL_ERROR &
!          & ("NC_MAKE_PVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
!          &"ERROR MAKING VARIABLE: "//TRIM(NAME))
  var => new_var()

  var%VARID   = -1
  var%VARNAME = trim(name)
  var%xtype   = nf90_double
  var%arr_dbl => values
  var => add(var,copy_dim(dim1))
  var => add(var,copy_dim(dim2))
  if(present(dim3)) then
     if(.NOT. ASSOCIATED(dim3)) CALL fatal_error &
          & ("NC_MAKE_PVAR: OPTIONAL DIMENSION ARGUMENT MUST BE ASSOCIATED",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     if(.NOT. dim3%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_PVAR: OPTIONAL DIMENSION ARGUMENT MUST BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     var => add(var,copy_dim(dim3))
  end if

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_MAKE_PVAR_ARR_DBL"
END FUNCTION nc_make_pvar_arr_dbl
!====================================================================
!====================================================================
FUNCTION nc_make_pvar_cub_dbl(NAME,VALUES,DIM1,DIM2,DIM3,DIM4) RESULT(VAR)
  IMPLICIT NONE
  TYPE(ncvar), POINTER :: var
  TYPE(ncdim), POINTER :: dim1
  TYPE(ncdim), POINTER :: dim2
  TYPE(ncdim), POINTER :: dim3
  TYPE(ncdim), OPTIONAL, POINTER :: dim4
  character(len=*), intent(in) :: name
  REAL(dp), POINTER, intent(in) :: values(:,:,:)
  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "START NC_MAKE_PVAR_CUB_DBL"

  IF(.NOT. ASSOCIATED(values)) CALL fatal_error &
       & ("NC_MAKE_PVAR: VALUES ARGUMENT MUST ALREADY BE ASSOCIATED!",&
       & "ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim1)) CALL fatal_error &
       & ("NC_MAKE_PVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
  if(dim1%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_PVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim2)) CALL fatal_error &
       & ("NC_MAKE_PVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
  if(dim2%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_PVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim3)) CALL fatal_error &
       & ("NC_MAKE_PVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
!  if(DIM3%UNLIMITED) CALL FATAL_ERROR &
!          & ("NC_MAKE_PVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
!          &"ERROR MAKING VARIABLE: "//TRIM(NAME))
  var => new_var()

  var%VARID   = -1
  var%VARNAME = trim(name)
  var%xtype   = nf90_double
  var%cub_dbl => values
  var => add(var,copy_dim(dim1))
  var => add(var,copy_dim(dim2))
  var => add(var,copy_dim(dim3))
  if(present(dim4)) then
     if(.NOT. ASSOCIATED(dim4)) CALL fatal_error &
          & ("NC_MAKE_PVAR: OPTIONAL DIMENSION ARGUMENT MUST BE ASSOCIATED",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     if(.NOT. dim4%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_PVAR: OPTIONAL DIMENSION ARGUMENT MUST BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     var => add(var,copy_dim(dim4))
  end if

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_MAKE_PVAR_CUB_DBL"
END FUNCTION nc_make_pvar_cub_dbl
!====================================================================
!====================================================================
FUNCTION nc_make_pvar_fda_dbl(NAME,VALUES,DIM1,DIM2,DIM3,DIM4,DIM5) RESULT(VAR)
  IMPLICIT NONE
  TYPE(ncvar), POINTER :: var
  TYPE(ncdim), POINTER :: dim1
  TYPE(ncdim), POINTER :: dim2
  TYPE(ncdim), POINTER :: dim3
  TYPE(ncdim), POINTER :: dim4
  TYPE(ncdim), OPTIONAL, POINTER :: dim5
  character(len=*), intent(in) :: name
  REAL(dp), POINTER, intent(in) :: values(:,:,:,:)
  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "START NC_MAKE_PVAR_FDA_DBL"

  IF(.NOT. ASSOCIATED(values)) CALL fatal_error &
       & ("NC_MAKE_PVAR: VALUES ARGUMENT MUST ALREADY BE ASSOCIATED!",&
       & "ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim1)) CALL fatal_error &
       & ("NC_MAKE_PVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
  if(dim1%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_PVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim2)) CALL fatal_error &
       & ("NC_MAKE_PVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
  if(dim2%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_PVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim3)) CALL fatal_error &
       & ("NC_MAKE_PVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
  if(dim3%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_PVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim4)) CALL fatal_error &
       & ("NC_MAKE_PVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
!  if(DIM4%UNLIMITED) CALL FATAL_ERROR &
!          & ("NC_MAKE_PVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
!          &"ERROR MAKING VARIABLE: "//TRIM(NAME))
  var => new_var()

  var%VARID   = -1
  var%VARNAME = trim(name)
  var%xtype   = nf90_double
  var%fda_dbl => values
  var => add(var,copy_dim(dim1))
  var => add(var,copy_dim(dim2))
  var => add(var,copy_dim(dim3))
  var => add(var,copy_dim(dim4))
  if(present(dim5)) then
     if(.NOT. ASSOCIATED(dim5)) CALL fatal_error &
          & ("NC_MAKE_PVAR: OPTIONAL DIMENSION ARGUMENT MUST BE ASSOCIATED",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     if(.NOT. dim5%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_PVAR: OPTIONAL DIMENSION ARGUMENT MUST BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     var => add(var,copy_dim(dim5))
  end if

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_MAKE_PVAR_FDA_DBL"
END FUNCTION nc_make_pvar_fda_dbl
!====================================================================
!====================================================================
FUNCTION nc_make_pvar_scl_flt(NAME,VALUES,DIM1) RESULT(VAR)
  IMPLICIT NONE
  TYPE(ncvar), POINTER :: var
  TYPE(ncdim), OPTIONAL, POINTER :: dim1
  character(len=*), intent(in) :: name
  REAL(spa), POINTER, intent(in) :: values
  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "START NC_MAKE_PVAR_SCL_FLT"

  IF(.NOT. ASSOCIATED(values)) CALL fatal_error &
       & ("NC_MAKE_PVAR: VALUES ARGUMENT MUST ALREADY BE ASSOCIATED!",&
       & "ERROR MAKING VARIABLE: "//trim(name))

  var => new_var()

  var%VARID   = -1
  var%VARNAME = trim(name)
  var%xtype   = nf90_float
  var%scl_flt => values
  IF(present(dim1)) THEN
     if(.NOT. ASSOCIATED(dim1)) CALL fatal_error &
          & ("NC_MAKE_PVAR: OPTIONAL DIMENSION ARGUMENT MUST BE ASSOCIATED",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     if(.NOT. dim1%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_PVAR: OPTIONAL DIMENSION ARGUMENT MUST BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     var => add(var,copy_dim(dim1))
  END IF

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_MAKE_PVAR_SCL_FLT"
END FUNCTION nc_make_pvar_scl_flt
!====================================================================
!====================================================================
FUNCTION nc_make_pvar_vec_flt(NAME,VALUES,DIM1,DIM2) RESULT(VAR)
  IMPLICIT NONE
  TYPE(ncvar), POINTER :: var
  TYPE(ncdim), POINTER :: dim1
  TYPE(ncdim), OPTIONAL, POINTER :: dim2
  character(len=*), intent(in) :: name
  REAL(spa), POINTER, intent(in) :: values(:)
  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "START NC_MAKE_PVAR_VEC_FLT"

  IF(.NOT. ASSOCIATED(values)) CALL fatal_error &
       & ("NC_MAKE_PVAR: VALUES ARGUMENT MUST ALREADY BE ASSOCIATED!",&
       & "ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim1)) CALL fatal_error &
       & ("NC_MAKE_PVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
!  if(DIM1%UNLIMITED) CALL WARNING &
!          & ("NC_MAKE_PVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
!          &"ERROR MAKING VARIABLE: "//TRIM(NAME))
  var => new_var()

  var%VARID   = -1
  var%VARNAME = trim(name)
  var%xtype   = nf90_float
  var%vec_flt => values(1:)
  var => add(var,copy_dim(dim1))
  if(present(dim2)) then
     if(.NOT. ASSOCIATED(dim2)) CALL fatal_error &
          & ("NC_MAKE_PVAR: OPTIONAL DIMENSION ARGUMENT MUST BE ASSOCIATED",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     if(.NOT. dim2%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_PVAR: OPTIONAL DIMENSION ARGUMENT MUST BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     var => add(var,copy_dim(dim2))
  end if

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_MAKE_PVAR_VEC_FLT"
END FUNCTION nc_make_pvar_vec_flt
!====================================================================
!====================================================================
FUNCTION nc_make_pvar_arr_flt(NAME,VALUES,DIM1,DIM2,DIM3) RESULT(VAR)
  IMPLICIT NONE
  TYPE(ncvar), POINTER :: var
  TYPE(ncdim), POINTER :: dim1
  TYPE(ncdim), POINTER :: dim2
  TYPE(ncdim), OPTIONAL, POINTER :: dim3
  character(len=*), intent(in) :: name
  REAL(spa), POINTER, intent(in) :: values(:,:)
  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "START NC_MAKE_PVAR_ARR_FLT"

  IF(.NOT. ASSOCIATED(values)) CALL fatal_error &
       & ("NC_MAKE_PVAR: VALUES ARGUMENT MUST ALREADY BE ASSOCIATED!",&
       & "ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim1)) CALL fatal_error &
       & ("NC_MAKE_PVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
  if(dim1%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_PVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim2)) CALL fatal_error &
       & ("NC_MAKE_PVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
!  if(DIM2%UNLIMITED) CALL FATAL_ERROR &
!          & ("NC_MAKE_PVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
!          &"ERROR MAKING VARIABLE: "//TRIM(NAME))
  var => new_var()

  var%VARID   = -1
  var%VARNAME = trim(name)
  var%xtype   = nf90_float
  var%arr_flt => values
  var => add(var,copy_dim(dim1))
  var => add(var,copy_dim(dim2))
  if(present(dim3)) then
     if(.NOT. ASSOCIATED(dim3)) CALL fatal_error &
          & ("NC_MAKE_PVAR: OPTIONAL DIMENSION ARGUMENT MUST BE ASSOCIATED",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     if(.NOT. dim3%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_PVAR: OPTIONAL DIMENSION ARGUMENT MUST BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     var => add(var,copy_dim(dim3))
  end if

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_MAKE_PVAR_ARR_FLT"
END FUNCTION nc_make_pvar_arr_flt
!====================================================================
!====================================================================
FUNCTION nc_make_pvar_cub_flt(NAME,VALUES,DIM1,DIM2,DIM3,DIM4) RESULT(VAR)
  IMPLICIT NONE
  TYPE(ncvar), POINTER :: var
  TYPE(ncdim), POINTER :: dim1
  TYPE(ncdim), POINTER :: dim2
  TYPE(ncdim), POINTER :: dim3
  TYPE(ncdim), OPTIONAL, POINTER :: dim4
  character(len=*), intent(in) :: name
  REAL(spa), POINTER, intent(in) :: values(:,:,:)
  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "START NC_MAKE_PVAR_CUB_FLT"

  IF(.NOT. ASSOCIATED(values)) CALL fatal_error &
       & ("NC_MAKE_PVAR: VALUES ARGUMENT MUST ALREADY BE ASSOCIATED!",&
       & "ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim1)) CALL fatal_error &
       & ("NC_MAKE_PVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
  if(dim1%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_PVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim2)) CALL fatal_error &
       & ("NC_MAKE_PVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
  if(dim2%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_PVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim3)) CALL fatal_error &
       & ("NC_MAKE_PVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
!  if(DIM3%UNLIMITED) CALL FATAL_ERROR &
!          & ("NC_MAKE_PVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
!          &"ERROR MAKING VARIABLE: "//TRIM(NAME))
  var => new_var()

  var%VARID   = -1
  var%VARNAME = trim(name)
  var%xtype   = nf90_float
  var%cub_flt => values
  var => add(var,copy_dim(dim1))
  var => add(var,copy_dim(dim2))
  var => add(var,copy_dim(dim3))
  if(present(dim4)) then
     if(.NOT. ASSOCIATED(dim4)) CALL fatal_error &
          & ("NC_MAKE_PVAR: OPTIONAL DIMENSION ARGUMENT MUST BE ASSOCIATED",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     if(.NOT. dim4%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_PVAR: OPTIONAL DIMENSION ARGUMENT MUST BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     var => add(var,copy_dim(dim4))
  end if

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_MAKE_PVAR_CUB_FLT"
END FUNCTION nc_make_pvar_cub_flt
!====================================================================
!====================================================================
FUNCTION nc_make_pvar_fda_flt(NAME,VALUES,DIM1,DIM2,DIM3,DIM4,DIM5) RESULT(VAR)
  IMPLICIT NONE
  TYPE(ncvar), POINTER :: var
  TYPE(ncdim), POINTER :: dim1
  TYPE(ncdim), POINTER :: dim2
  TYPE(ncdim), POINTER :: dim3
  TYPE(ncdim), POINTER :: dim4
  TYPE(ncdim), OPTIONAL, POINTER :: dim5
  character(len=*), intent(in) :: name
  REAL(spa), POINTER, intent(in) :: values(:,:,:,:)
  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "START NC_MAKE_PVAR_FDA_FLT"

  IF(.NOT. ASSOCIATED(values)) CALL fatal_error &
       & ("NC_MAKE_PVAR: VALUES ARGUMENT MUST ALREADY BE ASSOCIATED!",&
       & "ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim1)) CALL fatal_error &
       & ("NC_MAKE_PVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
  if(dim1%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_PVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim2)) CALL fatal_error &
       & ("NC_MAKE_PVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
  if(dim2%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_PVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim3)) CALL fatal_error &
       & ("NC_MAKE_PVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
  if(dim3%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_PVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim4)) CALL fatal_error &
       & ("NC_MAKE_PVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
!  if(DIM4%UNLIMITED) CALL FATAL_ERROR &
!          & ("NC_MAKE_PVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
!          &"ERROR MAKING VARIABLE: "//TRIM(NAME))
  var => new_var()

  var%VARID   = -1
  var%VARNAME = trim(name)
  var%xtype   = nf90_float
  var%fda_flt => values
  var => add(var,copy_dim(dim1))
  var => add(var,copy_dim(dim2))
  var => add(var,copy_dim(dim3))
  var => add(var,copy_dim(dim4))
  if(present(dim5)) then
     if(.NOT. ASSOCIATED(dim5)) CALL fatal_error &
          & ("NC_MAKE_PVAR: OPTIONAL DIMENSION ARGUMENT MUST BE ASSOCIATED",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     if(.NOT. dim5%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_PVAR: OPTIONAL DIMENSION ARGUMENT MUST BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     var => add(var,copy_dim(dim5))
  end if

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_MAKE_PVAR_FDA_FLT"
END FUNCTION nc_make_pvar_fda_flt
!====================================================================
!====================================================================
FUNCTION nc_make_pvar_scl_int(NAME,VALUES,DIM1) RESULT(VAR)
  IMPLICIT NONE
  TYPE(ncvar), POINTER :: var
  TYPE(ncdim), OPTIONAL, POINTER :: dim1
  character(len=*), intent(in) :: name
  INTEGER, POINTER, intent(in) :: values
  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "START NC_MAKE_PVAR_SCL_INT"

  IF(.NOT. ASSOCIATED(values)) CALL fatal_error &
       & ("NC_MAKE_PVAR: VALUES ARGUMENT MUST ALREADY BE ASSOCIATED!",&
       & "ERROR MAKING VARIABLE: "//trim(name))

  var => new_var()

  var%VARID   = -1
  var%VARNAME = trim(name)
  var%xtype   = nf90_int
  var%scl_int => values
  IF(present(dim1)) THEN
     if(.NOT. ASSOCIATED(dim1)) CALL fatal_error &
          & ("NC_MAKE_PVAR: OPTIONAL DIMENSION ARGUMENT MUST BE ASSOCIATED",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     if(.NOT. dim1%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_PVAR: OPTIONAL DIMENSION ARGUMENT MUST BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     var => add(var,copy_dim(dim1))
  END IF

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_MAKE_PVAR_SCL_INT"
END FUNCTION nc_make_pvar_scl_int
!====================================================================
!====================================================================
FUNCTION nc_make_pvar_vec_int(NAME,VALUES,DIM1,DIM2) RESULT(VAR)
  IMPLICIT NONE
  TYPE(ncvar), POINTER :: var
  TYPE(ncdim), POINTER :: dim1
  TYPE(ncdim), OPTIONAL, POINTER :: dim2
  character(len=*), intent(in) :: name
  INTEGER, POINTER, intent(in) :: values(:)
  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "START NC_MAKE_PVAR_VEC_INT"

  IF(.NOT. ASSOCIATED(values)) CALL fatal_error &
       & ("NC_MAKE_PVAR: VALUES ARGUMENT MUST ALREADY BE ASSOCIATED!",&
       & "ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim1)) CALL fatal_error &
       & ("NC_MAKE_PVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
!  if(DIM1%UNLIMITED) CALL WARNING &
!          & ("NC_MAKE_PVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
!          &"ERROR MAKING VARIABLE: "//TRIM(NAME))
  var => new_var()

  var%VARID   = -1
  var%VARNAME = trim(name)
  var%xtype   = nf90_int
  var%vec_int => values
  var => add(var,copy_dim(dim1))
  if(present(dim2)) then
     if(.NOT. ASSOCIATED(dim2)) CALL fatal_error &
          & ("NC_MAKE_PVAR: OPTIONAL DIMENSION ARGUMENT MUST BE ASSOCIATED",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     if(.NOT. dim2%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_PVAR: OPTIONAL DIMENSION ARGUMENT MUST BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     var => add(var,copy_dim(dim2))
  end if

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_MAKE_PVAR_VEC_INT"
END FUNCTION nc_make_pvar_vec_int
!====================================================================
!====================================================================
FUNCTION nc_make_pvar_arr_int(NAME,VALUES,DIM1,DIM2,DIM3) RESULT(VAR)
  IMPLICIT NONE
  TYPE(ncvar), POINTER :: var
  TYPE(ncdim), POINTER :: dim1
  TYPE(ncdim), POINTER :: dim2
  TYPE(ncdim), OPTIONAL, POINTER :: dim3
  character(len=*), intent(in) :: name
  INTEGER, POINTER, intent(in) :: values(:,:)
  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "START NC_MAKE_PVAR_ARR_INT"

  IF(.NOT. ASSOCIATED(values)) CALL fatal_error &
       & ("NC_MAKE_PVAR: VALUES ARGUMENT MUST ALREADY BE ASSOCIATED!",&
       & "ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim1)) CALL fatal_error &
       & ("NC_MAKE_PVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
  if(dim1%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_PVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim2)) CALL fatal_error &
       & ("NC_MAKE_PVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
!  if(DIM2%UNLIMITED) CALL FATAL_ERROR &
!          & ("NC_MAKE_PVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
!          &"ERROR MAKING VARIABLE: "//TRIM(NAME))
  var => new_var()

  var%VARID   = -1
  var%VARNAME = trim(name)
  var%xtype   = nf90_int
  var%arr_int => values
  var => add(var,copy_dim(dim1))
  var => add(var,copy_dim(dim2))
  if(present(dim3)) then
     if(.NOT. ASSOCIATED(dim3)) CALL fatal_error &
          & ("NC_MAKE_PVAR: OPTIONAL DIMENSION ARGUMENT MUST BE ASSOCIATED",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     if(.NOT. dim3%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_PVAR: OPTIONAL DIMENSION ARGUMENT MUST BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     var => add(var,copy_dim(dim3))
  end if

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_MAKE_PVAR_ARR_INT"
END FUNCTION nc_make_pvar_arr_int
!====================================================================
!====================================================================
FUNCTION nc_make_pvar_cub_int(NAME,VALUES,DIM1,DIM2,DIM3,DIM4) RESULT(VAR)
  IMPLICIT NONE
  TYPE(ncvar), POINTER :: var
  TYPE(ncdim), POINTER :: dim1
  TYPE(ncdim), POINTER :: dim2
  TYPE(ncdim), POINTER :: dim3
  TYPE(ncdim), OPTIONAL, POINTER :: dim4
  character(len=*), intent(in) :: name
  INTEGER, POINTER, intent(in) :: values(:,:,:)
  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "START NC_MAKE_PVAR_CUB_INT"

  IF(.NOT. ASSOCIATED(values)) CALL fatal_error &
       & ("NC_MAKE_PVAR: VALUES ARGUMENT MUST ALREADY BE ASSOCIATED!",&
       & "ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim1)) CALL fatal_error &
       & ("NC_MAKE_PVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
  if(dim1%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_PVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim2)) CALL fatal_error &
       & ("NC_MAKE_PVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
  if(dim2%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_PVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim3)) CALL fatal_error &
       & ("NC_MAKE_PVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
!  if(DIM3%UNLIMITED) CALL FATAL_ERROR &
!          & ("NC_MAKE_PVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
!          &"ERROR MAKING VARIABLE: "//TRIM(NAME))
  var => new_var()

  var%VARID   = -1
  var%VARNAME = trim(name)
  var%xtype   = nf90_int
  var%cub_int => values
  var => add(var,copy_dim(dim1))
  var => add(var,copy_dim(dim2))
  var => add(var,copy_dim(dim3))
  if(present(dim4)) then
     if(.NOT. ASSOCIATED(dim4)) CALL fatal_error &
          & ("NC_MAKE_PVAR: OPTIONAL DIMENSION ARGUMENT MUST BE ASSOCIATED",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     if(.NOT. dim4%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_PVAR: OPTIONAL DIMENSION ARGUMENT MUST BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     var => add(var,copy_dim(dim4))
  end if

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_MAKE_PVAR_CUB_INT"
END FUNCTION nc_make_pvar_cub_int
!====================================================================
!====================================================================
FUNCTION nc_make_pvar_fda_int(NAME,VALUES,DIM1,DIM2,DIM3,DIM4,DIM5) RESULT(VAR)
  IMPLICIT NONE
  TYPE(ncvar), POINTER :: var
  TYPE(ncdim), POINTER :: dim1
  TYPE(ncdim), POINTER :: dim2
  TYPE(ncdim), POINTER :: dim3
  TYPE(ncdim), POINTER :: dim4
  TYPE(ncdim), OPTIONAL, POINTER :: dim5
  character(len=*), intent(in) :: name
  INTEGER, POINTER, intent(in) :: values(:,:,:,:)
  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "START NC_MAKE_PVAR_FDA_INT"

  IF(.NOT. ASSOCIATED(values)) CALL fatal_error &
       & ("NC_MAKE_PVAR: VALUES ARGUMENT MUST ALREADY BE ASSOCIATED!",&
       & "ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim1)) CALL fatal_error &
       & ("NC_MAKE_PVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
  if(dim1%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_PVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim2)) CALL fatal_error &
       & ("NC_MAKE_PVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
  if(dim2%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_PVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim3)) CALL fatal_error &
       & ("NC_MAKE_PVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
  if(dim3%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_PVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
  if(.NOT. ASSOCIATED(dim4)) CALL fatal_error &
       & ("NC_MAKE_PVAR: THE DIMENSION ARGUMENT MUST BE ASSOCIATED",&
       &"ERROR MAKING VARIABLE: "//trim(name))
!  if(DIM4%UNLIMITED) CALL FATAL_ERROR &
!          & ("NC_MAKE_PVAR: NON-OPTIONAL DIMENSION ARGUMENT MUST BE NOT BE UNLIMITED (TIME)",&
!          &"ERROR MAKING VARIABLE: "//TRIM(NAME))
  var => new_var()

  var%VARID   = -1
  var%VARNAME = trim(name)
  var%xtype   = nf90_int
  var%fda_int => values
  var => add(var,copy_dim(dim1))
  var => add(var,copy_dim(dim2))
  var => add(var,copy_dim(dim3))
  var => add(var,copy_dim(dim4))
  if(present(dim5)) then
     if(.NOT. ASSOCIATED(dim5)) CALL fatal_error &
          & ("NC_MAKE_PVAR: OPTIONAL DIMENSION ARGUMENT MUST BE ASSOCIATED",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     if(.NOT. dim5%UNLIMITED) CALL fatal_error &
          & ("NC_MAKE_PVAR: OPTIONAL DIMENSION ARGUMENT MUST BE UNLIMITED (TIME)",&
          &"ERROR MAKING VARIABLE: "//trim(name))
     var => add(var,copy_dim(dim5))
  end if

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_MAKE_PVAR_FDA_INT"
END FUNCTION nc_make_pvar_fda_int
!====================================================================
!====================================================================
SUBROUTINE nc_disconnect(VAR)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(INOUT) :: VAR
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_DISCONNECT: THE VARIABLE ARGUMENT MUST BE ASSOCIATED")

    nullify(var%scl_int)
    nullify(var%vec_int)
    nullify(var%arr_int)
    nullify(var%cub_int)
    nullify(var%fda_int)

    nullify(var%scl_flt)
    nullify(var%vec_flt)
    nullify(var%arr_flt)
    nullify(var%cub_flt)
    nullify(var%fda_flt)

    nullify(var%scl_dbl)
    nullify(var%vec_dbl)
    nullify(var%arr_dbl)
    nullify(var%cub_dbl)
    nullify(var%fda_dbl)

    nullify(var%scl_chr)
    nullify(var%vec_chr)

END SUBROUTINE nc_disconnect
!====================================================================
!====================================================================
SUBROUTINE nc_connect_avar_scl_flt(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(INOUT) :: VAR
  REAL(SPA), target, intent(in) :: values
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_CONNECT_AVAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (SCL_FLT)")
  
  var%SCL_FLT => values

END SUBROUTINE nc_connect_avar_scl_flt
!====================================================================
!====================================================================
SUBROUTINE nc_connect_avar_vec_flt(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(INOUT) :: VAR
  REAL(SPA), allocatable, target, intent(in) :: values(:)
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_CONNECT_AVAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (VEC_FLT)")

  IF(.NOT. ALLOCATED(values)) CALL fatal_error &
       & ("NC_CONNECT_AVAR: VALUES ARGUMENT MUST ALREADY BE ALLOCATED!",&
       & "ERROR CONNECTING VARIABLE: "//trim(var%VARNAME))
    
  
  var%VEC_FLT => values

END SUBROUTINE nc_connect_avar_vec_flt
!====================================================================
!====================================================================
SUBROUTINE nc_connect_avar_arr_flt(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(INOUT) :: VAR
  REAL(SPA), allocatable, target, intent(in) :: values(:,:)
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_CONNECT_AVAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (ARR_FLT)")

  IF(.NOT. ALLOCATED(values)) CALL fatal_error &
       & ("NC_CONNECT_AVAR: VALUES ARGUMENT MUST ALREADY BE ALLOCATED!",&
       & "ERROR CONNECTING VARIABLE: "//trim(var%VARNAME))
    
  var%ARR_FLT => values

END SUBROUTINE nc_connect_avar_arr_flt
!====================================================================
!====================================================================
SUBROUTINE nc_connect_avar_cub_flt(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(INOUT) :: VAR
  REAL(SPA), allocatable, target, intent(in) :: values(:,:,:)
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_CONNECT_AVAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (CUB_FLT)")

  IF(.NOT. ALLOCATED(values)) CALL fatal_error &
       & ("NC_CONNECT_AVAR: VALUES ARGUMENT MUST ALREADY BE ALLOCATED!",&
       & "ERROR CONNECTING VARIABLE: "//trim(var%VARNAME))
    
  var%CUB_FLT => values

END SUBROUTINE nc_connect_avar_cub_flt
!====================================================================
!====================================================================
SUBROUTINE nc_connect_avar_fda_flt(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(INOUT) :: VAR
  REAL(SPA), allocatable, target, intent(in) :: values(:,:,:,:)
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_CONNECT_AVAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (FDA_FLT)")

  IF(.NOT. ALLOCATED(values)) CALL fatal_error &
       & ("NC_CONNECT_AVAR: VALUES ARGUMENT MUST ALREADY BE ALLOCATED!",&
       & "ERROR CONNECTING VARIABLE: "//trim(var%VARNAME))
    
  var%FDA_FLT => values

END SUBROUTINE nc_connect_avar_fda_flt
!====================================================================
!====================================================================
SUBROUTINE nc_connect_avar_scl_int(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(INOUT) :: VAR
  INTEGER, target, intent(in) :: values
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_CONNECT_AVAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (SCL_INT)")
  
  var%SCL_INT => values

END SUBROUTINE nc_connect_avar_scl_int
!====================================================================
!====================================================================
SUBROUTINE nc_connect_avar_vec_int(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(INOUT) :: VAR
  INTEGER, allocatable, target, intent(in) :: values(:)
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_CONNECT_AVAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (VEC_INT)")

  IF(.NOT. ALLOCATED(values)) CALL fatal_error &
       & ("NC_CONNECT_AVAR: VALUES ARGUMENT MUST ALREADY BE ALLOCATED!",&
       & "ERROR CONNECTING VARIABLE: "//trim(var%VARNAME))
    
  var%VEC_INT => values

END SUBROUTINE nc_connect_avar_vec_int
!====================================================================
!====================================================================
SUBROUTINE nc_connect_avar_arr_int(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(INOUT) :: VAR
  INTEGER, allocatable, target, intent(in) :: values(:,:)
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_CONNECT_AVAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (ARR_INT)")

  IF(.NOT. ALLOCATED(values)) CALL fatal_error &
       & ("NC_CONNECT_AVAR: VALUES ARGUMENT MUST ALREADY BE ALLOCATED!",&
       & "ERROR CONNECTING VARIABLE: "//trim(var%VARNAME))
  
  var%ARR_INT => values

END SUBROUTINE nc_connect_avar_arr_int
!====================================================================
!====================================================================
SUBROUTINE nc_connect_avar_cub_int(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(INOUT) :: VAR
  INTEGER, allocatable, target, intent(in) :: values(:,:,:)
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_CONNECT_AVAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (CUB_INT)")

  IF(.NOT. ALLOCATED(values)) CALL fatal_error &
       & ("NC_CONNECT_AVAR: VALUES ARGUMENT MUST ALREADY BE ALLOCATED!",&
       & "ERROR CONNECTING VARIABLE: "//trim(var%VARNAME))
  
  var%CUB_INT => values

END SUBROUTINE nc_connect_avar_cub_int
!====================================================================
!====================================================================
SUBROUTINE nc_connect_avar_fda_int(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(INOUT) :: VAR
  INTEGER, allocatable, target, intent(in) :: values(:,:,:,:)
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_CONNECT_AVAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (FDA_INT)")

  IF(.NOT. ALLOCATED(values)) CALL fatal_error &
       & ("NC_CONNECT_AVAR: VALUES ARGUMENT MUST ALREADY BE ALLOCATED!",&
       & "ERROR CONNECTING VARIABLE: "//trim(var%VARNAME))
  
  var%FDA_INT => values

END SUBROUTINE nc_connect_avar_fda_int
!====================================================================
!====================================================================
SUBROUTINE nc_connect_avar_scl_dbl(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(INOUT) :: VAR
  REAL(DP), target, intent(in) :: values
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_CONNECT_AVAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (SCL_DBL)")
  
  var%SCL_DBL => values

END SUBROUTINE nc_connect_avar_scl_dbl
!====================================================================
!====================================================================
SUBROUTINE nc_connect_avar_vec_dbl(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(INOUT) :: VAR
  real(DP), allocatable, target, intent(in) :: values(:)
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_CONNECT_AVAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (VEC_DBL)")

  IF(.NOT. ALLOCATED(values)) CALL fatal_error &
       & ("NC_CONNECT_AVAR: VALUES ARGUMENT MUST ALREADY BE ALLOCATED!",&
       & "ERROR CONNECTING VARIABLE: "//trim(var%VARNAME))
    
  var%VEC_DBL => values

END SUBROUTINE nc_connect_avar_vec_dbl
!====================================================================
!====================================================================
SUBROUTINE nc_connect_avar_arr_dbl(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(INOUT) :: VAR
  real(DP), allocatable, target, intent(in) :: values(:,:)
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_CONNECT_AVAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (ARR_DBL)")

  IF(.NOT. ALLOCATED(values)) CALL fatal_error &
       & ("NC_CONNECT_AVAR: VALUES ARGUMENT MUST ALREADY BE ALLOCATED!",&
       & "ERROR CONNECTING VARIABLE: "//trim(var%VARNAME))
  
  var%ARR_DBL => values

END SUBROUTINE nc_connect_avar_arr_dbl
!====================================================================
!====================================================================
SUBROUTINE nc_connect_avar_cub_dbl(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(INOUT) :: VAR
  real(DP), allocatable, target, intent(in) :: values(:,:,:)
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_CONNECT_AVAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (CUB_DBL)")

  IF(.NOT. ALLOCATED(values)) CALL fatal_error &
       & ("NC_CONNECT_AVAR: VALUES ARGUMENT MUST ALREADY BE ALLOCATED!",&
       & "ERROR CONNECTING VARIABLE: "//trim(var%VARNAME))
  
  var%CUB_DBL => values

END SUBROUTINE nc_connect_avar_cub_dbl
!====================================================================
!====================================================================
SUBROUTINE nc_connect_avar_fda_dbl(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(INOUT) :: VAR
  real(DP), allocatable, target, intent(in) :: values(:,:,:,:)
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_CONNECT_AVAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (FDA_DBL)")

  IF(.NOT. ALLOCATED(values)) CALL fatal_error &
       & ("NC_CONNECT_AVAR: VALUES ARGUMENT MUST ALREADY BE ALLOCATED!",&
       & "ERROR CONNECTING VARIABLE: "//trim(var%VARNAME))
  
  var%FDA_DBL => values

END SUBROUTINE nc_connect_avar_fda_dbl
!====================================================================
!====================================================================
SUBROUTINE nc_connect_pvar_scl_flt(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(INOUT) :: VAR
  REAL(SPA), POINTER :: values
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_CONNECT_PVAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (SCL_FLT)")

  IF(.NOT. ASSOCIATED(values)) CALL fatal_error &
       & ("NC_CONNECT_PVAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (SCL_FLT)")
  
  var%SCL_FLT => values

END SUBROUTINE nc_connect_pvar_scl_flt
!====================================================================
!====================================================================
SUBROUTINE nc_connect_pvar_vec_flt(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(INOUT) :: VAR
  REAL(SPA), POINTER :: values(:)
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_CONNECT_PVAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (VEC_FLT)")

  IF(.NOT. ASSOCIATED(values)) CALL fatal_error &
       & ("NC_CONNECT_PVAR: VALUES ARGUMENT MUST ALREADY BE ALLOCATED!",&
       & "ERROR CONNECTING VARIABLE: "//trim(var%VARNAME))
    
  
  var%VEC_FLT => values

END SUBROUTINE nc_connect_pvar_vec_flt
!====================================================================
!====================================================================
SUBROUTINE nc_connect_pvar_arr_flt(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(INOUT) :: VAR
  REAL(SPA),POINTER  :: values(:,:)
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_CONNECT_PVAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (ARR_FLT)")

  IF(.NOT. ASSOCIATED(values)) CALL fatal_error &
       & ("NC_CONNECT_PVAR: VALUES ARGUMENT MUST ALREADY BE ALLOCATED!",&
       & "ERROR CONNECTING VARIABLE: "//trim(var%VARNAME))
    
  var%ARR_FLT => values

END SUBROUTINE nc_connect_pvar_arr_flt
!====================================================================
!====================================================================
SUBROUTINE nc_connect_pvar_cub_flt(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(INOUT) :: VAR
  REAL(SPA),POINTER  :: values(:,:,:)
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_CONNECT_PVAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (CUB_FLT)")

  IF(.NOT. ASSOCIATED(values)) CALL fatal_error &
       & ("NC_CONNECT_PVAR: VALUES ARGUMENT MUST ALREADY BE ALLOCATED!",&
       & "ERROR CONNECTING VARIABLE: "//trim(var%VARNAME))
    
  var%CUB_FLT => values

END SUBROUTINE nc_connect_pvar_cub_flt
!====================================================================
!====================================================================
SUBROUTINE nc_connect_pvar_fda_flt(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(INOUT) :: VAR
  REAL(SPA),POINTER  :: values(:,:,:,:)
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_CONNECT_PVAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (FDA_FLT)")

  IF(.NOT. ASSOCIATED(values)) CALL fatal_error &
       & ("NC_CONNECT_PVAR: VALUES ARGUMENT MUST ALREADY BE ALLOCATED!",&
       & "ERROR CONNECTING VARIABLE: "//trim(var%VARNAME))
    
  var%FDA_FLT => values

END SUBROUTINE nc_connect_pvar_fda_flt
!====================================================================
!====================================================================
SUBROUTINE nc_connect_pvar_scl_int(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(INOUT) :: VAR
  INTEGER, POINTER :: values
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_CONNECT_PVAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (SCL_INT)")

  IF(.NOT. ASSOCIATED(values)) CALL fatal_error &
       & ("NC_CONNECT_PVAR: VALUES ARGUMENT MUST ALREADY BE ALLOCATED!",&
       & "ERROR CONNECTING VARIABLE: "//trim(var%VARNAME))

  var%SCL_INT => values

END SUBROUTINE nc_connect_pvar_scl_int
!====================================================================
!====================================================================
SUBROUTINE nc_connect_pvar_vec_int(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(INOUT) :: VAR
  INTEGER,POINTER :: values(:)
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_CONNECT_PVAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (VEC_INT)")

  IF(.NOT. ASSOCIATED(values)) CALL fatal_error &
       & ("NC_CONNECT_PVAR: VALUES ARGUMENT MUST ALREADY BE ALLOCATED!",&
       & "ERROR CONNECTING VARIABLE: "//trim(var%VARNAME))
    
  var%VEC_INT => values

END SUBROUTINE nc_connect_pvar_vec_int
!====================================================================
!====================================================================
SUBROUTINE nc_connect_pvar_arr_int(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(INOUT) :: VAR
  INTEGER, POINTER :: values(:,:)
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_CONNECT_PVAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (ARR_INT)")

  IF(.NOT. ASSOCIATED(values)) CALL fatal_error &
       & ("NC_CONNECT_PVAR: VALUES ARGUMENT MUST ALREADY BE ALLOCATED!",&
       & "ERROR CONNECTING VARIABLE: "//trim(var%VARNAME))
  
  var%ARR_INT => values

END SUBROUTINE nc_connect_pvar_arr_int
!====================================================================
!====================================================================
SUBROUTINE nc_connect_pvar_cub_int(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(INOUT) :: VAR
  INTEGER, POINTER :: values(:,:,:)
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_CONNECT_PVAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (CUB_INT)")

  IF(.NOT. ASSOCIATED(values)) CALL fatal_error &
       & ("NC_CONNECT_PVAR: VALUES ARGUMENT MUST ALREADY BE ALLOCATED!",&
       & "ERROR CONNECTING VARIABLE: "//trim(var%VARNAME))
  
  var%CUB_INT => values

END SUBROUTINE nc_connect_pvar_cub_int
!====================================================================
!====================================================================
SUBROUTINE nc_connect_pvar_fda_int(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(INOUT) :: VAR
  INTEGER, POINTER :: values(:,:,:,:)
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_CONNECT_PVAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (FDA_INT)")

  IF(.NOT. ASSOCIATED(values)) CALL fatal_error &
       & ("NC_CONNECT_PVAR: VALUES ARGUMENT MUST ALREADY BE ALLOCATED!",&
       & "ERROR CONNECTING VARIABLE: "//trim(var%VARNAME))
  
  var%FDA_INT => values

END SUBROUTINE nc_connect_pvar_fda_int
!====================================================================
!====================================================================
SUBROUTINE nc_connect_pvar_scl_dbl(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(INOUT) :: VAR
  REAL(DP), POINTER :: values
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_CONNECT_PVAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (SCL_DBL)")

  IF(.NOT. ASSOCIATED(values)) CALL fatal_error &
       & ("NC_CONNECT_PVAR: VALUES ARGUMENT MUST ALREADY BE ALLOCATED!",&
       & "ERROR CONNECTING VARIABLE: "//trim(var%VARNAME))

  var%SCL_DBL => values

END SUBROUTINE nc_connect_pvar_scl_dbl
!====================================================================
!====================================================================
SUBROUTINE nc_connect_pvar_vec_dbl(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(INOUT) :: VAR
  real(DP), POINTER :: values(:)
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_CONNECT_PVAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (VEC_DBL)")

  IF(.NOT. ASSOCIATED(values)) CALL fatal_error &
       & ("NC_CONNECT_PVAR: VALUES ARGUMENT MUST ALREADY BE ALLOCATED!",&
       & "ERROR CONNECTING VARIABLE: "//trim(var%VARNAME))
    
  var%VEC_DBL => values

END SUBROUTINE nc_connect_pvar_vec_dbl
!====================================================================
!====================================================================
SUBROUTINE nc_connect_pvar_arr_dbl(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(INOUT) :: VAR
  real(DP), POINTER :: values(:,:)
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_CONNECT_PVAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (ARR_DBL)")

  IF(.NOT. ASSOCIATED(values)) CALL fatal_error &
       & ("NC_CONNECT_PVAR: VALUES ARGUMENT MUST ALREADY BE ALLOCATED!",&
       & "ERROR CONNECTING VARIABLE: "//trim(var%VARNAME))
  
  var%ARR_DBL => values

END SUBROUTINE nc_connect_pvar_arr_dbl
!====================================================================
!====================================================================
SUBROUTINE nc_connect_pvar_cub_dbl(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(INOUT) :: VAR
  real(DP), POINTER :: values(:,:,:)
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_CONNECT_PVAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (CUB_DBL)")

  IF(.NOT. ASSOCIATED(values)) CALL fatal_error &
       & ("NC_CONNECT_PVAR: VALUES ARGUMENT MUST ALREADY BE ALLOCATED!",&
       & "ERROR CONNECTING VARIABLE: "//trim(var%VARNAME))
  
  var%CUB_DBL => values

END SUBROUTINE nc_connect_pvar_cub_dbl
!====================================================================
!====================================================================
SUBROUTINE nc_connect_pvar_fda_dbl(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(INOUT) :: VAR
  real(DP), POINTER :: values(:,:,:,:)
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_CONNECT_PVAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (FDA_DBL)")

  IF(.NOT. ASSOCIATED(values)) CALL fatal_error &
       & ("NC_CONNECT_PVAR: VALUES ARGUMENT MUST ALREADY BE ALLOCATED!",&
       & "ERROR CONNECTING VARIABLE: "//trim(var%VARNAME))
  
  var%FDA_DBL => values

END SUBROUTINE nc_connect_pvar_fda_dbl
!====================================================================
!====================================================================
SUBROUTINE nc_connect_var_scl_chr(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(INOUT) :: VAR
  CHARACTER(LEN=80), target, intent(in) :: values
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_CONNECT_VAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (SCL_CHR)")

  ! DO NO TYPE OR DIMENSION MATCHING HERE... TO COMPLICATED
  
  var%SCL_CHR => values


END SUBROUTINE nc_connect_var_scl_chr
!====================================================================
!====================================================================
SUBROUTINE nc_connect_avar_vec_chr(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(INOUT) :: VAR
  CHARACTER(LEN=80), target,ALLOCATABLE, intent(in) :: values(:)
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_CONNECT_AVAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (SCL_CHR)")

  IF(.NOT. ALLOCATED(values)) CALL fatal_error &
       & ("THE CHARACTER ALLOCATABLE MUST BE ALLOCATED BEFORE BEING PASSE&
       &D TO NC_CONNECT_VAR:", var%VARNAME)

  ! DO NO TYPE OR DIMENSION MATCHING HERE... TO COMPLICATED
  
  var%VEC_CHR => values


END SUBROUTINE nc_connect_avar_vec_chr
!====================================================================
!====================================================================
SUBROUTINE nc_connect_pvar_scl_chr(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(INOUT) :: VAR
  CHARACTER(LEN=80), pointer, intent(in) :: values

  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_CONNECT_AVAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (VEC_CHR)")

  IF(.NOT. ASSOCIATED(values)) CALL fatal_error &
       & ("THE CHARACTER POINTER MUST BE ASSOCIATED BEFORE BEING PASSE&
       &D TO NC_CONNECT_VAR:", var%VARNAME)

  ! DO NO TYPE OR DIMENSION MATCHING HERE... TO COMPLICATED
  
  var%SCL_CHR => values


END SUBROUTINE nc_connect_pvar_scl_chr
!====================================================================
!====================================================================
SUBROUTINE nc_connect_pvar_vec_chr(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(INOUT) :: VAR
  CHARACTER(LEN=80), pointer, intent(in) :: values(:)

  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_CONNECT_AVAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (VEC_CHR)")

  IF(.NOT. ASSOCIATED(values)) CALL fatal_error &
       & ("THE CHARACTER POINTER MUST BE ASSOCIATED BEFORE BEING PASSE&
       &D TO NC_CONNECT_VAR:", var%VARNAME)

  ! DO NO TYPE OR DIMENSION MATCHING HERE... TO COMPLICATED
  
  var%VEC_CHR => values


END SUBROUTINE nc_connect_pvar_vec_chr
!====================================================================
!====================================================================
SUBROUTINE nc_point_var_scl_flt(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(IN) :: VAR
  REAL(SPA), POINTER :: values
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_POINT_VAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (SCL_FLT)")

  IF(.NOT. ASSOCIATED(var%SCL_FLT)) THEN
     call print_var(var)
     CALL fatal_error &
          & ("NC_POINT_VAR: THE VARIABLE DATA MUST BE ASSOCIATED (SCL_FLT)")
  END IF

  values => var%SCL_FLT

END SUBROUTINE nc_point_var_scl_flt
!====================================================================
!====================================================================
SUBROUTINE nc_point_var_vec_flt(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(IN) :: VAR
  REAL(SPA), POINTER :: values(:)
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_POINT_VAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (VEC_FLT)")
  
  IF(.NOT. ASSOCIATED(var%VEC_FLT)) THEN
     call print_var(var)
     CALL fatal_error &
          & ("NC_POINT_VAR: THE VARIABLE DATA MUST BE ASSOCIATED (VEC_FLT)")
  END IF

 values =>  var%VEC_FLT

END SUBROUTINE nc_point_var_vec_flt
!====================================================================
!====================================================================
SUBROUTINE nc_point_var_arr_flt(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(IN) :: VAR
  REAL(SPA), POINTER :: values(:,:)
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_POINT_VAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (ARR_FLT)")
  
  IF(.NOT. ASSOCIATED(var%ARR_FLT)) THEN
     call print_var(var)
     CALL fatal_error &
          & ("NC_POINT_VAR: THE VARIABLE DATA MUST BE ASSOCIATED (ARR_FLT)")
  END IF

  values =>  var%ARR_FLT

END SUBROUTINE nc_point_var_arr_flt
!====================================================================
!====================================================================
SUBROUTINE nc_point_var_cub_flt(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(IN) :: VAR
  REAL(SPA), POINTER :: values(:,:,:)
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_POINT_VAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (CUB_FLT)")
  
  IF(.NOT. ASSOCIATED(var%CUB_FLT)) THEN
     call print_var(var)
     CALL fatal_error &
          & ("NC_POINT_VAR: THE VARIABLE DATA MUST BE ASSOCIATED (CUB_FLT)")
  END IF

  values =>  var%CUB_FLT

END SUBROUTINE nc_point_var_cub_flt
!====================================================================
!====================================================================
SUBROUTINE nc_point_var_fda_flt(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(IN) :: VAR
  REAL(SPA), POINTER :: values(:,:,:,:)
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_POINT_VAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (FDA_FLT)")
  
  IF(.NOT. ASSOCIATED(var%FDA_FLT)) THEN
     call print_var(var)
     CALL fatal_error &
          & ("NC_POINT_VAR: THE VARIABLE DATA MUST BE ASSOCIATED (FDA_FLT)")
  END IF

  values =>  var%FDA_FLT

END SUBROUTINE nc_point_var_fda_flt
!====================================================================
!====================================================================
SUBROUTINE nc_point_var_scl_dbl(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(IN) :: VAR
  REAL(DP), POINTER :: values
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_POINT_VAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (SCL_DBL)")

  IF(.NOT. ASSOCIATED(var%SCL_DBL)) THEN
     call print_var(var)
     CALL fatal_error &
          & ("NC_POINT_VAR: THE VARIABLE DATA MUST BE ASSOCIATED (SCL_DBL)")
  END IF

  values => var%SCL_DBL

END SUBROUTINE nc_point_var_scl_dbl
!====================================================================
!====================================================================
SUBROUTINE nc_point_var_vec_dbl(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(IN) :: VAR
  REAL(DP), POINTER :: values(:)
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_POINT_VAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (VEC_DBL)")

  IF(.NOT. ASSOCIATED(var%VEC_DBL)) THEN
     call print_var(var)
     CALL fatal_error &
          & ("NC_POINT_VAR: THE VARIABLE DATA MUST BE ASSOCIATED (VEC_DBL)")
  END IF

  values =>  var%VEC_DBL
  
END SUBROUTINE nc_point_var_vec_dbl
!====================================================================
!====================================================================
SUBROUTINE nc_point_var_arr_dbl(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(IN) :: VAR
  REAL(DP), POINTER :: values(:,:)
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_POINT_VAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (ARR_DBL)")
  
  IF(.NOT. ASSOCIATED(var%ARR_DBL)) THEN
     call print_var(var)
     CALL fatal_error &
          & ("NC_POINT_VAR: THE VARIABLE DATA MUST BE ASSOCIATED (ARR_DBL)")
  END IF

  values =>  var%ARR_DBL
  
END SUBROUTINE nc_point_var_arr_dbl
!====================================================================
!====================================================================
SUBROUTINE nc_point_var_cub_dbl(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(IN) :: VAR
  REAL(DP), POINTER :: values(:,:,:)
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_POINT_VAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (CUB_DBL)")
  
    IF(.NOT. ASSOCIATED(var%CUB_DBL)) THEN
     call print_var(var)
     CALL fatal_error &
          & ("NC_POINT_VAR: THE VARIABLE DATA MUST BE ASSOCIATED (CUB_DBL)")
  END IF

  values =>  var%CUB_DBL
  
END SUBROUTINE nc_point_var_cub_dbl
!====================================================================
!====================================================================
SUBROUTINE nc_point_var_fda_dbl(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(IN) :: VAR
  REAL(DP), POINTER :: values(:,:,:,:)
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_POINT_VAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (FDA_DBL)")
  
    IF(.NOT. ASSOCIATED(var%FDA_DBL)) THEN
     call print_var(var)
     CALL fatal_error &
          & ("NC_POINT_VAR: THE VARIABLE DATA MUST BE ASSOCIATED (FDA_DBL)")
  END IF

  values =>  var%FDA_DBL
  
END SUBROUTINE nc_point_var_fda_dbl
!====================================================================
!====================================================================
SUBROUTINE nc_point_var_scl_int(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(IN) :: VAR
  INTEGER, POINTER :: values
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_POINT_VAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (SCL_INT)")
  
  IF(.NOT. ASSOCIATED(var%SCL_INT)) THEN
     call print_var(var)
     CALL fatal_error &
          & ("NC_POINT_VAR: THE VARIABLE DATA MUST BE ASSOCIATED (SCL_INT)")
  END IF

  values => var%SCL_INT

END SUBROUTINE nc_point_var_scl_int
!====================================================================
!====================================================================
SUBROUTINE nc_point_var_vec_int(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(IN) :: VAR
  INTEGER, POINTER :: values(:)
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_POINT_VAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (VEC_INT)")
 
  IF(.NOT. ASSOCIATED(var%VEC_INT)) THEN
     call print_var(var)
     CALL fatal_error &
          & ("NC_POINT_VAR: THE VARIABLE DATA MUST BE ASSOCIATED (VEC_INT)")
  END IF
  
  values =>  var%VEC_INT
  
END SUBROUTINE nc_point_var_vec_int
!====================================================================
!====================================================================
SUBROUTINE nc_point_var_arr_int(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(IN) :: VAR
  INTEGER, POINTER :: values(:,:)
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_POINT_VAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (ARR_INT)")
  
  IF(.NOT. ASSOCIATED(var%ARR_INT)) THEN
     call print_var(var)
     CALL fatal_error &
          & ("NC_POINT_VAR: THE VARIABLE DATA MUST BE ASSOCIATED (ARR_INT)")
  END IF
  
  values =>  var%ARR_INT
  
END SUBROUTINE nc_point_var_arr_int
!====================================================================
!====================================================================
SUBROUTINE nc_point_var_cub_int(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(IN) :: VAR
  INTEGER, POINTER :: values(:,:,:)
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_POINT_VAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (CUB_INT)")
  
  IF(.NOT. ASSOCIATED(var%CUB_INT)) THEN
     call print_var(var)
     CALL fatal_error &
          & ("NC_POINT_VAR: THE VARIABLE DATA MUST BE ASSOCIATED (CUB_INT)")
  END IF

  values =>  var%CUB_INT
  
END SUBROUTINE nc_point_var_cub_int
!====================================================================
!====================================================================
SUBROUTINE nc_point_var_fda_int(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(IN) :: VAR
  INTEGER, POINTER :: values(:,:,:,:)
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_POINT_VAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (FDA_INT)")
  
  IF(.NOT. ASSOCIATED(var%FDA_INT)) THEN
     call print_var(var)
     CALL fatal_error &
          & ("NC_POINT_VAR: THE VARIABLE DATA MUST BE ASSOCIATED (FDA_INT)")
  END IF

  values =>  var%FDA_INT
  
END SUBROUTINE nc_point_var_fda_int
!====================================================================
!====================================================================
SUBROUTINE nc_point_var_scl_chr(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(INOUT) :: VAR
  CHARACTER(LEN=80), POINTER :: values
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_POINT_VAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (SCL_CHR)")

  IF(.NOT. ASSOCIATED(var%SCL_CHR)) THEN
     call print_var(var)
     CALL fatal_error &
          & ("NC_POINT_VAR: THE VARIABLE DATA MUST BE ASSOCIATED (SCL_CHR)")
  END IF

   values => var%SCL_CHR

 END SUBROUTINE nc_point_var_scl_chr
!====================================================================
!====================================================================
SUBROUTINE nc_point_var_vec_chr(VAR,VALUES)
  IMPLICIT NONE
  TYPE(ncvar), POINTER, INTENT(INOUT) :: VAR
  CHARACTER(LEN=80), POINTER :: values(:)
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_POINT_VAR: THE VARIABLE ARGUMENT MUST BE ASSOCIATED (VEC_CHR)")

  IF(.NOT. ASSOCIATED(var%VEC_CHR)) THEN
     call print_var(var)
     CALL fatal_error &
          & ("NC_POINT_VAR: THE VARIABLE DATA MUST BE ASSOCIATED (VEC_CHR)")
  END IF

   values => var%VEC_CHR

 END SUBROUTINE nc_point_var_vec_chr
!====================================================================
!====================================================================
FUNCTION nc_get_var(NCF,varid) RESULT(VAR)
  implicit none
  TYPE(ncfile), intent(in) :: ncf
  integer, intent(in) :: varid
  TYPE(ncvar),pointer :: var
  TYPE(ncatt),pointer :: att
  TYPE(ncdim),pointer :: dim
  integer :: ndims, natts, xtype
  integer, allocatable :: dimids(:)
  integer :: status,i
  CHARACTER(LEN=120)     :: errmsg
  LOGICAL found
  CHARACTER(Len=NF90_MAX_NAME+1) :: name

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "START NC_GET_VAR"

  status=nf90_inquire_variable(ncf%NCID,varid,& 
       & name = name,&
       & xtype = xtype, &
       & ndims= ndims, &
       & natts= natts )
  errmsg="Can not get variable info: "//trim(ncf%FNAME)
  call handle_ncerr(status,errmsg)


  var => new_var()
  var%varname=trim(name)
  var%varid=varid
  var%NCID => ncf%NCID
  var%XTYPE=xtype
  

  if(dbg_set(dbg_io)) write(ipt,*)"====== ADDING VARIABLE ATTRIBUTES: "//trim(var%VARNAME)


  allocate(dimids(ndims),stat=status)
  if(status /= 0) CALL fatal_error("NC_GET_VAR: Can not allocate DIMIDS")

  status=nf90_inquire_variable(ncf%NCID,var%VARID, dimids = dimids)
  errmsg="Can not get variable dimids: "//trim(ncf%FNAME)//":"//trim(var%VARNAME)
  call handle_ncerr(status,errmsg)

  ! ADD THE VARIABLES DIMENSIONS TO ITS LINKED LIST FROM THE FILES DIMENSIONS
  if(dbg_set(dbg_io)) write(ipt,*) "====== ADDING VARIABLE DIMENSIONS:"
  do i=1,ndims
     dim => find_dim(ncf,dimids(i),found)
     IF(.not. found) THEN
        CALL print_dim_list(ncf)
        CALL fatal_error("NC_GET_VAR: COULD NOT FIND ONE &
          &OF THE FILE DIMENSION OBJECTS FOR THE VARIABLE: "//trim(var&
          &%VARNAME), "IN THE FILE: "//trim(ncf%FNAME))
     END IF
 
     if(dbg_set(dbg_io)) write(ipt,*) "      "//trim(dim%DIMNAME)
     var => add(var,dim)
  end do
  DEALLOCATE(dimids)

  if(ndims /= count_dim_list(var)) then
     if(dbg_set(dbg_log)) call print_dim_list(ncf)
     if(dbg_set(dbg_log)) call print_dim_list(var)
     call fatal_error("The number of dimensions in the variable does not m&
          &atch the number loaded in the variable object list.")
  end if


  if(dbg_set(dbg_io)) write(ipt,*) "====== ADDING VARIABLE ATTRIBUTES:"
  do i=1,natts
     att => nc_get_att(var,i)
     if(dbg_set(dbg_io)) write(ipt,*) "      "//trim(att%ATTNAME)
     var => add(var,att)
  end do

  if(natts /= count_att_list(var)) then
     if(dbg_set(dbg_log)) call print_att_list(var)
     call fatal_error("The number of attributes in the file does not m&
          &atch the number loaded in the file object.")
  end if

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_GET_VAR"
     
END FUNCTION nc_get_var
!====================================================================
!====================================================================
SUBROUTINE nc_def_var(NCF,varid)
  implicit none
  TYPE(ncfile), target,intent(in) :: NCF
  integer, intent(in) :: varid
  TYPE(ncvar),pointer :: VAR
  TYPE(ncatt),pointer :: ATT
  TYPE(ncfile), pointer :: NCFP

  integer, POINTER :: dimids(:)
  integer :: status,i
  CHARACTER(LEN=120)     :: errmsg
  LOGICAL FOUND

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "START NC_DEF_VAR"

  var => find_var(ncf,varid,found)
  IF (.NOT. found) THEN
     if (dbg_set(dbg_log)) call print_var_list(ncf)
     CALL fatal_error&
          &("NC_DEF_VAR: COULD NOT FIND THE FILE VARIABLE WITH CORRECT VARID W&
          &HILE DEFINING THE VARIABLE IN THE FILE")
  END IF

  ! MAKE AN ARRAY TO HOLD THE DIMIDS  
  dimids => var_dimids(var)

     status = nf90_def_var(ncf%ncid, trim(var%varname), var%xtype,&
          & dimids, i)


  errmsg="NF90_DEF_VAR: ERROR"
  CALL handle_ncerr(status,trim(errmsg))

  DEALLOCATE(dimids)
  NULLIFY(dimids)

  IF (varid .NE. i) THEN
     CALL print_var(var)
     CALL fatal_error&
       &("NC_DEF_VAR: THE VARID RETURNED BY NF90_DEF_VAR DOES NOT MATC&
       &H THE VARID FOR THE VARIABLE OBJECT")
  END IF


  Do i = 1,count_att_list(var)
     att => find_att(var,i,found)
     IF (.NOT. found) THEN
        if (dbg_set(dbg_log)) call print_att_list(var)
        CALL fatal_error&
             &("NC_DEF_VAR: COULD NOT FIND THE VARIABLE ATTRIBUTE WITH CORRECT ATTID W&
             &HILE PUTTING THE ATTRIBUTE IN THE FILE")
     END IF
     
     CALL write_att_type(ncf%NCID,varid,att)
  End Do

  if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "END NC_DEF_VAR"

END SUBROUTINE nc_def_var
!====================================================================
!====================================================================
SUBROUTINE nc_write_file(NCF,LOCAL_ONLY,STKCNT,STKRNG)
  USE control
  implicit none
  
  LOGICAL, OPTIONAL :: LOCAL_ONLY
  INTEGER, OPTIONAL :: STKCNT   ! TO SPECIFY THE STACK TO WRITE
  INTEGER, OPTIONAL :: STKRNG(2)! TO SPECIFY THE STACK RANGE TO WRITE

  LOGICAL :: MY_LOCAL
  TYPE(ncfile), pointer :: NCF

  CHARACTER(LEN=80) :: FNAME,PATH,EXTENSION
  INTEGER :: FCNT,I

  TYPE(ncvar), pointer :: VAR
  TYPE(ncdim), pointer :: DIM
  type(ncvarp), POINTER       :: CURRENT
  TYPE(ncftime), POINTER :: FTM

  LOGICAL :: COLLECTDATA = .false.
  INTEGER :: COLLECTOR
  INTEGER :: NEXT_STKCNT
  LOGICAL :: DUMP = .false.
  LOGICAL :: FOUND = .false.

 if(dbg_set(dbg_sbr)) &
       & write(ipt,*) "STARTING NC_WRITE_FILE"

 if(dbg_set(dbg_sbrio)) CALL print_file(ncf)


 my_local = .false.
 IF(PRESENT(local_only)) my_local = local_only

  IF(serial .or. my_local) THEN
     collectdata = .false.
     dump    = .true.
     collector = msrid
     
  ELSE ! (IF PARALLEL)
     
     collectdata = .true.
     
     IF (use_mpi_io_mode) then
        collector = ioprocid
        dump = .false.
     ELSE
        collector = msrid ! MASTER
        IF(msr)THEN
           dump = .true.
        ELSE
           dump = .false.
        END IF
     END IF
     
  END IF

  IF(PRESENT(stkcnt) .AND. PRESENT(stkrng)) CALL fatal_error&
       &("NC_WRITE_FILE: CAN NOT CALL WITH BOTH IDX AND RNG!")


  if(dbg_set(dbg_sbrio)) then
     write(ipt,*)"==========================================="
     write(ipt,*)"= NC_WRITE_FILE:         CONTROL STATE"
     write(ipt,*)"= NC_WRITE_FILE:   COLLECT DATA:",collectdata
     write(ipt,*)"= NC_WRITE_FILE:           DUMP:",dump
     write(ipt,*)"= NC_WRITE_FILE:      COLLECTOR:",collector
     write(ipt,*)"= NC_WRITE_FILE:           MYID:",myid
     write(ipt,*)"= NC_WRITE_FILE:         IOPROC:",ioproc
     write(ipt,*)"= NC_WRITE_FILE:USE_MPI_IO_MODE:",use_mpi_io_mode
     IF(PRESENT(local_only))THEN
        write(ipt,*)"= NC_WRITE_FILE:     LOCAL_ONLY:",local_only
     END IF
     IF(PRESENT(stkcnt))THEN
        write(ipt,*)"= NC_WRITE_FILE:         STKCNT:",stkcnt
     END IF
     IF(PRESENT(stkrng))THEN
        write(ipt,*)"= NC_WRITE_FILE:         STKRNG:",stkrng
     END IF

     write(ipt,*)"==========================================="
  end if

  IF(len_trim(ncf%FNAME) == 0) THEN
     CALL print_file(ncf)
     CALL fatal_error("NC_WRITE_FILE: CALLED WRITE WITH NO FILE NAME!")
  END IF
  
  CALL path_split(ncf%FNAME,path,fname,extension)

  IF (collector .EQ. myid) THEN
     
     IF(ncf%CONNECTED) THEN
        
        CALL nc_open(ncf)

        ! ADD CHECK FOR STK_LEN VS FILE UNLIMDIM?
     ELSE        
       
        IF(dbg_set(dbg_log)) WRITE(ipt,*) "! CREATING FILE: "//trim(ncf%FNAME)

        CALL nc_create(ncf)
        CALL nc_save(ncf)
     END IF
  ELSE

     ncf%CONNECTED = .true.

  END IF

  IF(ASSOCIATED(ncf%FTIME)) THEN
     ftm => ncf%FTIME
     
     IF(PRESENT(stkcnt) )THEN

        next_stkcnt = stkcnt
        ftm%NEXT_STKCNT = stkcnt+1
        ftm%PREV_STKCNT =stkcnt

     ELSEIF(PRESENT(stkrng))THEN
        next_stkcnt = stkrng(2)
        ftm%NEXT_STKCNT = stkrng(2)
        ftm%PREV_STKCNT = stkrng(1)

     ELSE ! DEFAULT CASE - NO SPECIFED FILE STACK, USE FTM%NEXT_STKCNT
        
        next_stkcnt = ftm%NEXT_STKCNT

     END IF

     IF(ftm%NEXT_STKCNT .LT. 0) CALL fatal_error &
          &("NC_WRITE_FILE: FILE OBJECT STKCNT LESS THAN ZERO",&
          &"FILE NAME: "//trim(ncf%FNAME))

        
     ! IF WE ARE MAKING THE FILE LONGER INCRIMENT THE STK_LEN
     ftm%STK_LEN = max(ftm%NEXT_STKCNT,ftm%STK_LEN)
  ELSE

     IF(PRESENT(stkcnt) .OR. PRESENT(stkrng)) CALL fatal_error&
          &("IT IS NONSENSE TO PASS A STK OR RNG TO NC_WRITE_FILE",&
          & "WITH A FILE THAT DOES NOT HAVE AN ASSOCIATED FILETIME!")

     ! NOT A TIME VARRYING FILE... WRITE IT ANYWAY!
     next_stkcnt = 0


!     CALL PRINT_FILE(NCF)
!     CALL FATAL_ERROR ("NC_WRITE_FILE: FILE OBJECT FTIME IS NOT ALLOCATED ")

  END IF


  IF (next_stkcnt == 0) THEN
     IF(dbg_set(dbg_log)) WRITE(ipt,*) "! DUMPING STATIC DATA TO FILE: "&
          &//trim(fname)
  ELSE
     
     IF(PRESENT(stkrng)) THEN
        
        IF(dbg_set(dbg_log)) WRITE(ipt,*) "! DUMPING DATA TO FILE: "&
             &//trim(fname)//"; Records#",stkrng
     ELSE
        IF(dbg_set(dbg_log)) WRITE(ipt,*) "! DUMPING DATA TO FILE: "&
             &//trim(fname)//"; Record#",next_stkcnt
     END IF
  END IF
  

  current => ncf%VARS%NEXT

  IF(.NOT. ASSOCIATED(current)) &
       & CALL fatal_error("NC_WRITE_FILE: FILE OBJECT HAS NO VARIABLES",&
       &"FILE NAME: "//trim(ncf%FNAME))


! LOOP THROUGH VARIABLES AND WRITE THE DATA
! ===================================================================== 
  DO
     IF(.NOT. ASSOCIATED(current)) THEN

        IF (ioproc .AND. collectdata) THEN
           ! JUST FINISHED COLLECTING - NOW DUMP
           collectdata = .false.
           dump    = .true.
           !START LOOP OVER AND DUMP THE DATA
           current => ncf%VARS%NEXT        
        ELSE
!            YOUR DONE!
!                FVCOM GROUP ALWAYS GOES THROUGH THE LIST ONCE
!                IOPROC GOES THROUGH TWICE - COLLECT ONCE
!                                          - DUMP ONCE
           IF (collector .EQ. myid) CALL nc_close(ncf)

           if(dbg_set(dbg_sbr)) &
                & write(ipt,*) "END NC_WRITE_FILE"

           RETURN
        END IF
        
     END IF

     IF(.NOT. ASSOCIATED(current%VAR)) CALL fatal_error &
          &("NC_WRITE_FILE:",&
          & "FILE OBJECT HAS UNASSOCIATED VARIBLE OBJECT IN LINK LIST",&
          &"FILE NAME: "//trim(ncf%FNAME))

     var => current%VAR
        

     ! DECIDE WHETHER THIS IS A DYNAMIC OR STATIC VARIABLE     
     found = has_unlimited(var)

     IF (found .AND. (next_stkcnt .GT. 0) ) THEN 
        ! THIS IS A TIME STEP OUT PUT - WRITE THE VARIABLE
        IF(PRESENT(stkrng)) THEN
           CALL nc_write_var(var,dump,collectdata,collector,stkrng=stkrng)
        ELSE
           CALL nc_write_var(var,dump,collectdata,collector,stkcnt=next_stkcnt)
        END IF
     ELSEIF (.NOT. found .AND. (next_stkcnt .EQ. 0) ) THEN 
        ! STKCNT == 0 - JUST WROTE NEW FILE ADD STATIC VARIABLES
        CALL nc_write_var(var,dump,collectdata,collector)
     END IF

     current => current%NEXT
  END DO

  CALL fatal_error("NC_WRITE_FILE REACHED AN IMPOSSIBLE STATE",&
       &"PLEASE SET YOUR COMPUTER ON FIRE AND EXIT THE BUILDING QUICKLY")

END SUBROUTINE nc_write_file
!====================================================================
!====================================================================
! Watch out - pointing to part of an array is tricky. The index may be reset
SUBROUTINE nc_write_var(VAR,DUMP,COLLECTDATA,COLLECTOR,STKCNT,STKRNG,IOSTART,IOCOUNT,IOSTRIDE)
! DUMP - If T, write the data to the disk
! COLLECTDATA - If T, Collect data to the processor specified by COLLECTOR
! COLLECTOR - The Processor which does write/collect

  USE control, only:msr,ioproc,use_mpi_io_mode,serial
  implicit none
  TYPE(ncvar), POINTER :: VAR
  INTEGER, OPTIONAL :: STKCNT
  INTEGER, OPTIONAL :: STKRNG(2)
  INTEGER, ALLOCATABLE,TARGET, OPTIONAL :: IOSTART(:), IOCOUNT(:), IOSTRIDE(:)
  LOGICAL, INTENT(IN) ::DUMP
  LOGICAL, INTENT(IN) :: COLLECTDATA
  INTEGER, INTENT(IN) :: COLLECTOR

  INTEGER :: CODE
  INTEGER :: XTYPE
  INTEGER :: CNT,DIMCNT
  INTEGER :: NSIZE
!  integer :: dim1,dim2,dim3,dim4

 ! NF90 SUBSET VARIABLES
  INTEGER, POINTER :: NSTART(:), NCOUNT(:), NSTRIDE(:)
  ! The size of the data returned by nf90_get/put_var
  INTEGER, POINTER :: RDIMS(:)
  ! TEMPORARY VARIABLES ONLY USED FOR VEC_CHR
  INTEGER, POINTER :: NSTRT(:), NCNT(:), NSTRD(:)

  ! POINTERS AND SUCH
  TYPE(ncdim), POINTER :: DIM
  TYPE(ncdimp), POINTER :: DIMLINK
  LOGICAL :: FOUND


  INTEGER, PARAMETER :: case_scl_int = 1
  INTEGER, PARAMETER :: case_vec_int = 2
  INTEGER, PARAMETER :: case_arr_int = 3
  INTEGER, PARAMETER :: case_cub_int = 4
  INTEGER, PARAMETER :: case_fda_int = 5

  INTEGER, PARAMETER :: case_scl_flt = 6
  INTEGER, PARAMETER :: case_vec_flt = 7
  INTEGER, PARAMETER :: case_arr_flt = 8
  INTEGER, PARAMETER :: case_cub_flt = 9
  INTEGER, PARAMETER :: case_fda_flt = 10

  INTEGER, PARAMETER :: case_scl_dbl = 11
  INTEGER, PARAMETER :: case_vec_dbl = 12
  INTEGER, PARAMETER :: case_arr_dbl = 13
  INTEGER, PARAMETER :: case_cub_dbl = 14
  INTEGER, PARAMETER :: case_fda_dbl = 15

  INTEGER, PARAMETER :: case_scl_chr = 16
  INTEGER, PARAMETER :: case_vec_chr = 17

  ! TEMPORARY STORAGE FOR DATA IF COLLECTED TO MASTER PROC
  INTEGER, POINTER                :: SCL_INT
  INTEGER, POINTER,DIMENSION(:)   :: GVEC_INT
  INTEGER, POINTER,DIMENSION(:,:) :: GARR_INT
  INTEGER, POINTER,DIMENSION(:,:,:) :: GCUB_INT
  INTEGER, POINTER,DIMENSION(:,:,:,:) :: GFDA_INT

  INTEGER, POINTER,DIMENSION(:)   :: LVEC_INT
  INTEGER, POINTER,DIMENSION(:,:) :: LARR_INT
  INTEGER, POINTER,DIMENSION(:,:,:) :: LCUB_INT
  INTEGER, POINTER,DIMENSION(:,:,:,:) :: LFDA_INT
  
  REAL(SPA), POINTER                :: SCL_FLT
  REAL(SPA), POINTER,DIMENSION(:)   :: LVEC_FLT
  REAL(SPA), POINTER,DIMENSION(:,:) :: LARR_FLT
  REAL(SPA), POINTER,DIMENSION(:,:,:) :: LCUB_FLT
  REAL(SPA), POINTER,DIMENSION(:,:,:,:) :: LFDA_FLT

  REAL(SPA), POINTER,DIMENSION(:)   :: GVEC_FLT
  REAL(SPA), POINTER,DIMENSION(:,:) :: GARR_FLT
  REAL(SPA), POINTER,DIMENSION(:,:,:) :: GCUB_FLT
  REAL(SPA), POINTER,DIMENSION(:,:,:,:) :: GFDA_FLT
  
  REAL(DP), POINTER                :: SCL_DBL
  REAL(DP), POINTER,DIMENSION(:)   :: GVEC_DBL
  REAL(DP), POINTER,DIMENSION(:,:) :: GARR_DBL
  REAL(DP), POINTER,DIMENSION(:,:,:) :: GCUB_DBL
  REAL(DP), POINTER,DIMENSION(:,:,:,:) :: GFDA_DBL

  REAL(DP), POINTER,DIMENSION(:)   :: LVEC_DBL
  REAL(DP), POINTER,DIMENSION(:,:) :: LARR_DBL
  REAL(DP), POINTER,DIMENSION(:,:,:) :: LCUB_DBL
  REAL(DP), POINTER,DIMENSION(:,:,:,:) :: LFDA_DBL

  CHARACTER(LEN=80), POINTER              :: SCL_CHR
  CHARACTER(LEN=80), POINTER,DIMENSION(:) :: VEC_CHR

  CHARACTER(len=3) :: char1,char2,char3
  ! DATA FOR PUT VAR COMMANDS:
  INTEGER :: STATUS, I
  CHARACTER(LEN=120)          :: errmsg

  IF(dbg_set(dbg_sbr)) WRITE(ipt,*) "START NC_WRITE_VAR:"

  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_WRITE_VAR: Variable object argument is not assocaited!")

  ! INITIALIZE SOME MEMORY
  status=0
  i=0
  
  code=0
  xtype=0
  cnt=0
  dimcnt=0
  nsize=0
  found=.false.
  
  !NULLIFY POINTERS
  NULLIFY(nstart,ncount,nstride)
  NULLIFY(rdims,nstrt,ncnt,nstrd)
  NULLIFY(dim,dimlink)
  NULLIFY(scl_int,gvec_int,garr_int,gcub_int,gfda_int,lvec_int,larr_int,lcub_int,lfda_int)
  
  NULLIFY(scl_flt,gvec_flt,garr_flt,gcub_flt,gfda_flt,lvec_flt,larr_flt,lcub_flt,lfda_flt)
  NULLIFY(scl_dbl,gvec_dbl,garr_dbl,gcub_dbl,gfda_dbl,lvec_dbl,larr_dbl,lcub_dbl,lfda_dbl)
  NULLIFY(scl_chr,vec_chr)
  

  ! COUNT THE NUMBER OF DIMENSIONS IN THE VARIABLE
  dimcnt = count_dim_list(var)


  IF (serial .and. (collector .NE. myid .OR. collectdata)) THEN
     CALL print_var(var)
     CALL fatal_error("NC_WRITE_VAR: SERIAL JOB CALLED A PARALLEL WRITE?")
  END IF

  IF (.NOT. dump .and. .NOT. collectdata) THEN
     CALL print_var(var)
     CALL fatal_error("NC_WRITE_VAR: CALLED WITH BAD ARGUMENTS;",&
          & "DUMP or COLLECTDATA or both must be true?")
  END IF

  IF(dbg_set(dbg_sbrio)) THEN

        write(char2,'(I3.3)')collector
        write(char3,'(I3.3)')myid
        WRITE(ipt,*)"NC_WRITE_VAR Arguments:"
        call print_var(var)
        WRITE(ipt,*)"DUMP=",dump,"; COLLECTDATA=",collectdata,"; COLLECTOR="//char2//"; MYID="//char3
        IF(PRESENT(stkcnt)) THEN
           WRITE(ipt,*) "STKCNT=",stkcnt
        ELSE
           WRITE(ipt,*) "STKCNT= NONE"
        END IF

        IF(PRESENT(stkrng)) THEN
           WRITE(ipt,*) "STKRNG=",stkrng
        ELSE
           WRITE(ipt,*) "STKRNG= NONE"
        END IF

        IF(PRESENT(iostart)) THEN
           WRITE(ipt,*) "IOSTART=",iostart
        ELSE
           WRITE(ipt,*) "IOSTART= NONE"
        END IF

        IF(PRESENT(iocount)) THEN
           WRITE(ipt,*) "IOCOUNT=",iocount
        ELSE
           WRITE(ipt,*) "IOCOUNT= NONE"
        END IF

        IF(PRESENT(iostride)) THEN
           WRITE(ipt,*) "IOSTRIDE=",iostride
        ELSE
           WRITE(ipt,*) "IOSTRIDE= NONE"
        END IF
        
  END IF


  IF(var%NCID == -1 .and. dump) THEN
     CALL print_var(var)
     CALL fatal_error("NC_WRITE_VAR: CAN NOT WRITE TO FILE, IT IS NOT OPEN!")
  END IF


  IF ( PRESENT(stkcnt) ) THEN

     IF ( PRESENT(stkrng) .or. PRESENT(iostart) .or. PRESENT(iocount) .or. PRESENT(iostride))THEN
        CALL print_var(var)
        CALL fatal_error("NC_WRITE_VAR: You can not pass both STKCNT and STKRNG/START/COUNT/STRIDE !",&
             &"Set STKCNT to write a time slice filling all other dimensions. OR",&
             &"Set IOSTART/IOCOUNT/(IOSTRIDE) to read a specific range.")
     END IF

     dim => find_unlimited(var,found)
     IF(.NOT.found) THEN
        CALL print_var(var)
        CALL fatal_error&
             &("NC_WRITE_VAR: CALLED WITH STKCNT ARGUMENT BUT VARIABLE IS NOT UNLIMITED?")
     END IF
     NULLIFY(dim)
     
     ALLOCATE(nstart(dimcnt),ncount(dimcnt),nstride(dimcnt))
     
     
     ! SET THE VARIABLES CURRENT STACK COUNT
     var%CURR_STKCNT = stkcnt
     
     ! SET THE NF90_PUT_VAR DIMENSIONS
     nstart=1 ! START AT ONE, EXCEPT FOR THE TIME VARIABLE
     nstart(dimcnt) = stkcnt

     
     dimlink => var%DIMS%NEXT
     DO i = 1,dimcnt ! GET THE OUTPUT VARIABLE DIMENSIONS
        dim => dimlink%DIM  
        ncount(i)= dim%DIM
        dimlink => dimlink%NEXT
     END DO
     ncount(dimcnt)=1 ! SET THE TIME OUTPUT DIMENSION TO 1
     
     nstride=1 ! ALWAYS USE STRIDE 1 FOR STKCNT INPUT

     ! FOR TIME DEPENDANT DATA THE RANK OF THE ALLOCATED MEMORY IS
     ! ONE LESS THAN THE RANK OF THE FILE's VARIALBE!
     dimcnt = dimcnt -1

     ! THE DIMENSIONS WRITTEN WILL BE THE VALUES OF NCOUNT, NOT
     ! INCLUDING TIME
     IF(dimcnt > 0)THEN
        ALLOCATE(rdims(dimcnt))
        rdims(1:dimcnt)=ncount(1:dimcnt)
     ELSE IF (dimcnt == 0) THEN
         ALLOCATE(rdims(1))
        rdims(1)=ncount(1)
     ELSE
        nullify(rdims)
     END IF

     ELSEIF ( PRESENT(stkrng) ) THEN

     IF ( PRESENT(stkcnt) .or. PRESENT(iostart) .or. PRESENT(iocount) .or. PRESENT(iostride))THEN
        CALL print_var(var)
        CALL fatal_error("NC_WRITE_VAR: You can not pass both STKRNG and STKCNT/START/COUNT/STRIDE !",&
             &"Set STKRNG to write a time range filling all other dimensions. OR",&
             &"Set IOSTART/IOCOUNT/(IOSTRIDE) to read a specific range.")
     END IF

     dim => find_unlimited(var,found)
     IF(.NOT.found) THEN
        CALL print_var(var)
        CALL fatal_error&
             &("NC_WRITE_VAR: CALLED WITH STKRNG ARGUMENT BUT VARIABLE IS NOT UNLIMITED?")
     END IF
     NULLIFY(dim)
     
     ALLOCATE(nstart(dimcnt),ncount(dimcnt),nstride(dimcnt))
     
     
     ! SET THE VARIABLES CURRENT STACK COUNT
     var%CURR_STKCNT = -1
     
     ! SET THE NF90_PUT_VAR DIMENSIONS
     nstart=1 ! START AT ONE, EXCEPT FOR THE TIME VARIABLE
     nstart(dimcnt) = stkrng(1)

     
     dimlink => var%DIMS%NEXT
     DO i = 1,dimcnt ! GET THE OUTPUT VARIABLE DIMENSIONS
        dim => dimlink%DIM  
        ncount(i)= dim%DIM
        dimlink => dimlink%NEXT
     END DO
     ncount(dimcnt)=stkrng(2) - stkrng(1)+1 ! SET THE TIME OUTPUT
     ! DIMENSION TO NUMBER OF STATES IN THE RANGE
     
     nstride=1 ! ALWAYS USE STRIDE 1 FOR STKCNT INPUT

     ! THE DIMENSIONS WRITTEN WILL BE THE VALUES OF NCOUNT, NOT
     ! INCLUDING TIME
     rdims=>ncount

  ELSE IF( PRESENT(iostart) .and. PRESENT(iocount)) THEN
     
     nstart=>iostart
     ncount=>iocount
     
     IF(.not. PRESENT(iostride)) THEN
        ALLOCATE(nstride(dimcnt))
        nstride=1
     ELSE
        nstride=>iostride
     END IF

     IF(dimcnt /= size(nstart) .or. &
          & dimcnt /= size(ncount) .or. &
          & dimcnt /= size(nstride) ) THEN
        CALL print_var(var)
        CALL fatal_error&
        & ("NC_WRITE_VAR: Variable's # of file dimensions does not matach size(NSTART/NCOUNT/NSTRIDE) arugments?")
     END IF

     ! SET THE VARIABLES CURRENT STACK COUNT: not defined for this
     ! kind of read/write
     var%CURR_STKCNT = -1

     ! ONLY COUNT THE NONE SINGLETON DIMENSIONS OF A VARIABLE. 
     cnt = 0
     DO i = 1,dimcnt
        IF(ncount(i)>1) cnt=cnt+1
     END DO     
     ! NOW RECORD THE DIMENSIONS OF THE DATA THAT WILL BE READ INTO MEMORY
     IF (cnt > 0) THEN
        
        ALLOCATE(rdims(cnt))
        cnt = 0
        DO i = 1,dimcnt
           IF(ncount(i)>1) THEN
              cnt=cnt+1
              rdims(cnt)=ncount(i)
           END IF
        END DO

     ELSE
        ALLOCATE(rdims(1)) 
        rdims(1) = 1
     END IF

     
     ! NOW SET THE DIMENSION OF THE DATA VARIABLE IN MEMORY     
     dimcnt=cnt

  ELSE IF( .not. (PRESENT(iostart) .or. PRESENT(iocount) .or.&
       & PRESENT(stkcnt) .or. PRESENT(stkrng) .or. PRESENT(iostride))) THEN
     
     ALLOCATE(nstart(dimcnt),ncount(dimcnt),nstride(dimcnt))
     
     ! SET THE VARIABLES CURRENT STACK COUNT
     var%CURR_STKCNT = 0
     
     ! SET THE NF90_PUT_VAR DIMENSIONS
     nstart=1 ! START AT ONE, EXCEPT FOR THE TIME VARIABLE
     
     dimlink => var%DIMS%NEXT
     DO i = 1,dimcnt ! GET THE OUTPUT VARIABLE DIMENSIONS
        dim => dimlink%DIM  
        ncount(i)= dim%DIM
        dimlink => dimlink%NEXT
     END DO
     
     nstride=1 ! ALWAYS USE STRIDE 1 IF NO ARGUMENTS ARE PASSED

     ! ONLY COUNT THE NONE SINGLETON DIMENSIONS OF A VARIABLE. 
     cnt = 0
     DO i = 1,dimcnt
        IF(ncount(i)>1) cnt=cnt+1
     END DO     
     ! NOW RECORD THE DIMENSIONS OF THE DATA THAT WILL BE READ INTO MEMORY
     IF (cnt > 0) THEN
        
        ALLOCATE(rdims(cnt))
        cnt = 0
        DO i = 1,dimcnt
           IF(ncount(i)>1) THEN
              cnt=cnt+1
              rdims(cnt)=ncount(i)
           END IF
        END DO

     ELSE
        ALLOCATE(rdims(1)) 
        rdims(1) = 1
     END IF

     
     ! NOW SET THE DIMENSION OF THE DATA VARIABLE IN MEMORY     
     dimcnt=cnt

  ELSE
     
     IF(dbg_set(dbg_log)) THEN
        write(ipt,*) "# IOSTART  ::",PRESENT(iostart)
        write(ipt,*) "# IOCOUNT  ::",PRESENT(iocount)
        write(ipt,*) "# IOSTRIDE ::",PRESENT(iostride)
        write(ipt,*) "# STKCNT   ::",PRESENT(stkcnt)
        write(ipt,*) "# STKRNG   ::",PRESENT(stkrng)
     END IF
     
     CALL fatal_error("NC_WRITE_VAR: YOU SPECIFIED AN ILLEGAL COMBINATION OF AGUMENTS?",&
          & "Valid choices are STKCNT or STKRNG or NSTART,NCOUNT,(NSTRIDE) or none")
  END IF

  IF(dbg_set(dbg_sbrio)) THEN
     write(ipt,*) "FILE DIMENSION COUNT IS::", count_dim_list(var)
     write(ipt,*) "MEMORY DIMENSION COUNT IS::",dimcnt
  END IF

  !DETERMIN WHICH CASE WE ARE WRITING DATA FOR
  code = -1

  select case(var%XTYPE)
  case(nf90_byte)
     call fatal_error("NC_WRITE_VAR: NOT SET UP TO WRITE BYTE DATA")
  case(nf90_short)
     call fatal_error("NC_WRITE_VAR: NOT SET UP TO WRITE SHORT DATA")
  case(nf90_int)
     if (dimcnt == 0) code = case_scl_int
     if (dimcnt == 1) code = case_vec_int
     if (dimcnt == 2) code = case_arr_int
     if (dimcnt == 3) code = case_cub_int
     if (dimcnt == 4) code = case_fda_int
  case(nf90_float)
     if (dimcnt == 0) code = case_scl_flt
     if (dimcnt == 1) code = case_vec_flt
     if (dimcnt == 2) code = case_arr_flt
     if (dimcnt == 3) code = case_cub_flt
     if (dimcnt == 4) code = case_fda_flt
  case(nf90_double)
     if (dimcnt == 0) code = case_scl_dbl
     if (dimcnt == 1) code = case_vec_dbl
     if (dimcnt == 2) code = case_arr_dbl
     if (dimcnt == 3) code = case_cub_dbl
     if (dimcnt == 4) code = case_fda_dbl
  case(nf90_char)
     
     IF(ncount(1) == 1) THEN
        WRITE(ipt,*) "SINGLETON CHARACTER DATA!"
        IF(.not. ASSOCIATED(rdims,ncount)) THEN
           DEALLOCATE(rdims)
        ELSE
           NULLIFY(rdims)
        END IF

        dimcnt = dimcnt+1

        ALLOCATE(rdims(dimcnt))
        cnt = 1
        rdims(1) = ncount(1)
        DO i = 2,size(ncount)
           IF(ncount(i)>1) THEN
              cnt=cnt+1
              rdims(cnt)=ncount(i)
           END IF
        END DO
     END IF

     if (dimcnt == 1) code = case_scl_chr
     if (dimcnt == 2) code = case_vec_chr
     ! First dim is length of string
     ! Second dim is time
  case default
     call fatal_error("NC_WRITE_VAR: Unkown data type?")
  end select

  ! BASED ON CODE WRITE THE DATA
  errmsg="NC_WRITE_VAR: VARIABLE: "//var%varname//"; Can not be writen by nf90_put_var!"

  SELECT CASE(code)
!********************************************************************
! =====   SCALAR INTEGER DATA
!********************************************************************
  CASE(case_scl_int)

     IF(.NOT. ASSOCIATED(var%SCL_INT))THEN 

        IF(ASSOCIATED(var%VEC_INT))THEN
           IF(size(var%VEC_INT)==1) var%SCL_INT=>var%VEC_INT(1)
        ELSE IF(ASSOCIATED(var%ARR_INT))THEN
           IF(size(var%ARR_INT)==1) var%SCL_INT=>var%ARR_INT(1,1)
        ELSE IF(ASSOCIATED(var%CUB_INT))THEN
           IF(size(var%CUB_INT)==1) var%SCL_INT=>var%CUB_INT(1,1,1)
        ELSE IF(ASSOCIATED(var%FDA_INT))THEN
           IF(size(var%FDA_INT)==1) var%SCL_INT=>var%FDA_INT(1,1,1,1)
        ELSE        

           CALL print_var(var)
           CALL fatal_error("NC_WRITE_VAR: Variable objects SCL_INT data is NOT assocaited!")
        END IF
     END IF

     scl_int => var%SCL_INT

     ! ONLY COLLECT SCLs IF USING IOPROC: MSR SHOULD ALREADY HAVE THE DATA...
     IF(collectdata .AND. use_mpi_io_mode) THEN
        CALL fatal_error("NC_WRITE_VAR: COLLECT DATA FLAG IS T&
             &RUE BUT THIS IS NOT A MULTIPROCESSOR CASE?")
     END IF

     IF (dump) THEN

        IF (SIZE(nstart) .GT. 0) THEN
            
           if (product(ncount) .NE. 1) CALL fatal_error&
                & ("NC_WRITE_VAR: NCOUNT dimension invalid while reading scl_int?")

           ! ARGUMENT TO NF90_PUT_VAR MUST BE A VECTOR
           allocate(gvec_int(1)); gvec_int(1) = scl_int

           status = nf90_put_var(var%NCID,var%VARID,gvec_int,nstart,ncount,nstride)
           CALL handle_ncerr(status,trim(errmsg))
           
           deallocate(gvec_int)
        ELSE
           status = nf90_put_var(var%NCID,var%VARID,scl_int)
           CALL handle_ncerr(status,trim(errmsg))
        END IF

     END IF
     
     NULLIFY(scl_int)

!********************************************************************
! =====   VECTOR INTEGER DATA
!********************************************************************
  CASE(case_vec_int)

    IF(.NOT. ASSOCIATED(var%VEC_INT))THEN 

        IF(ASSOCIATED(var%ARR_INT))THEN
           IF(size(var%ARR_INT,1)==1) var%VEC_INT=>var%ARR_INT(1,1:)
           IF(size(var%ARR_INT,2)==1) var%VEC_INT=>var%ARR_INT(1:,1)
        ELSE IF(ASSOCIATED(var%CUB_INT))THEN
           IF(size(var%CUB_INT,1)==1) THEN
              IF(size(var%CUB_INT,2)==1) var%VEC_INT=>var%CUB_INT(1,1,1:)
              IF(size(var%CUB_INT,3)==1) var%VEC_INT=>var%CUB_INT(1,1:,1)
           END IF
           IF(size(var%CUB_INT,1)==2) THEN
              IF(size(var%CUB_INT,3)==1) var%VEC_INT=>var%CUB_INT(1:,1,1)
           END IF           
!        ELSE IF(ASSOCIATED(VAR%FDA_INT))THEN
!           IF(size(VAR%FDA_INT,1)==1) THEN
!              IF(size(VAR%FDA_INT,2)==1) VAR%VEC_INT=>VAR%FDA_INT(1,1,1,1:)
!              IF(size(VAR%FDA_INT,3)==1) VAR%VEC_INT=>VAR%FDA_INT(1,1,1:,1)
!              IF(size(VAR%FDA_INT,4)==1) VAR%VEC_INT=>VAR%FDA_INT(1,1:,1,1)
!           END IF
!           IF(size(VAR%FDA_INT,1)==2) THEN
!              IF(size(VAR%FDA_INT,4)==1) VAR%VEC_INT=>VAR%FDA_INT(1:,1,1,1)
!           END IF           
        ELSE        

           CALL print_var(var)
           CALL fatal_error("NC_WRITE_VAR: Variable objects VEC_FLT data is NOT assocaited!")
        END IF
     END IF

     nsize=ubound(var%VEC_INT,1)

     ! ONLY COLLECT SCLs IF USING IOPROC: MSR SHOULD ALREADY HAVE THE DATA...
     IF(collectdata) THEN
        CALL fatal_error("NC_WRITE_VAR: COLLECT DATA FLAG IS T&
             &RUE BUT THIS IS NOT A MULTIPROCESSOR CASE?")
     END IF

 
     IF (dump) THEN

        ! IF YOU ARE THE IOPROC REASSIGN THE POINTER 
        If(.NOT. collectdata) gvec_int => var%VEC_INT(1:rdims(1)) 

        status = nf90_put_var(var%NCID,var%VARID,gvec_int,nstart,ncount,nstride)
        CALL handle_ncerr(status,trim(errmsg))

        ! IF YOU ARE COLLECTING AN DUMPING IN THE SAME PASS
        ! DEALLOCATE THE MEMORY YOU COLLECTED INTO
        IF (collectdata) deallocate(gvec_int)
        

     END IF

     nullify(gvec_int)
     nullify(lvec_int)
     
 
!********************************************************************
! =====   ARRAY INTEGER DATA
!********************************************************************
  CASE(case_arr_int)

    IF(.NOT. ASSOCIATED(var%ARR_INT))THEN 

        IF(ASSOCIATED(var%CUB_INT))THEN
           IF(size(var%CUB_INT,1)==1) var%ARR_INT=>var%CUB_INT(1,1:,1:)
           IF(size(var%CUB_INT,2)==1) var%ARR_INT=>var%CUB_INT(1:,1,1:)
           IF(size(var%CUB_INT,3)==1) var%ARR_INT=>var%CUB_INT(1:,1:,1)
        ELSE        
           
           CALL print_var(var)
           CALL fatal_error("NC_WRITE_VAR: Variable objects ARR_INT data is NOT assocaited!")
        END IF
     END IF
     nsize=ubound(var%ARR_INT,1)

     ! ONLY COLLECT SCLs IF USING IOPROC: MSR SHOULD ALREADY HAVE THE DATA...
     IF(collectdata) THEN
        CALL fatal_error("NC_WRITE_VAR: COLLECT DATA FLAG IS T&
             &RUE BUT THIS IS NOT A MULTIPROCESSOR CASE?")
     END IF

 
     IF (dump) THEN

        ! IF YOU ARE THE IOPROC REASSIGN THE POINTER 
        If(.NOT. collectdata) garr_int => var%ARR_INT(1:rdims(1),1:rdims(2))
!        write(ipt,*)VAR%ARR_INT(1:DIM1,1:DIM2)

        status = nf90_put_var(var%NCID,var%VARID,garr_int,nstart,ncount,nstride)
        CALL handle_ncerr(status,trim(errmsg))

        ! IF YOU ARE COLLECTING AN DUMPING IN THE SAME PASS
        ! DEALLOCATE THE MEMORY YOU COLLECTED INTO
        IF (collectdata) deallocate(garr_int)
        
     END IF

     nullify(garr_int)
     nullify(larr_int)


!********************************************************************
! =====   CUBE INTEGER DATA
!********************************************************************
  CASE(case_cub_int)

    IF(.NOT. ASSOCIATED(var%cub_INT))THEN 
        CALL print_var(var)
        CALL fatal_error("NC_WRITE_VAR: Variable objects CUB_INT data is NOT assocaited!")
     END IF

     nsize=ubound(var%CUB_INT,1)

     ! ONLY COLLECT SCLs IF USING IOPROC: MSR SHOULD ALREADY HAVE THE DATA...
     IF(collectdata) THEN
        CALL fatal_error("NC_WRITE_VAR: COLLECT DATA FLAG IS T&
             &RUE BUT THIS IS NOT A MULTIPROCESSOR CASE?")
     END IF

 
     IF (dump) THEN

       ! IF YOU ARE THE IOPROC REASSIGN THE POINTER 
        If(.NOT. collectdata) gcub_int => var%CUB_INT(1:rdims(1),1:rdims(2),1:rdims(3))

        status = nf90_put_var(var%NCID,var%VARID,gcub_int,nstart,ncount,nstride)
        CALL handle_ncerr(status,trim(errmsg))

        ! IF YOU ARE COLLECTING AN DUMPING IN THE SAME PASS
        ! DEALLOCATE THE MEMORY YOU COLLECTED INTO
        IF (collectdata) deallocate(gcub_int)
        

     END IF

     
     nullify(gcub_int)
     nullify(lcub_int)

!********************************************************************
! =====   FOUR DIMENSION ARRAY INTEGER DATA
!********************************************************************
  CASE(case_fda_int)

    IF(.NOT. ASSOCIATED(var%fda_INT))THEN 
        CALL print_var(var)
        CALL fatal_error("NC_WRITE_VAR: Variable objects FDA_INT data is NOT assocaited!")
     END IF

     nsize=ubound(var%FDA_INT,1)

     ! ONLY COLLECT SCLs IF USING IOPROC: MSR SHOULD ALREADY HAVE THE DATA...
     IF(collectdata) THEN
        CALL fatal_error("NC_WRITE_VAR: COLLECT DATA FLAG IS T&
             &RUE BUT THIS IS NOT A MULTIPROCESSOR CASE?")
     END IF

 
     IF (dump) THEN

       ! IF YOU ARE THE IOPROC REASSIGN THE POINTER 
        If(.NOT. collectdata) gfda_int => var%FDA_INT(1:rdims(1),1:rdims(2),1:rdims(3),1:rdims(4))

        status = nf90_put_var(var%NCID,var%VARID,gfda_int,nstart,ncount,nstride)
        CALL handle_ncerr(status,trim(errmsg))

        ! IF YOU ARE COLLECTING AN DUMPING IN THE SAME PASS
        ! DEALLOCATE THE MEMORY YOU COLLECTED INTO
        IF (collectdata) deallocate(gfda_int)
        

     END IF

     
     nullify(gfda_int)
     nullify(lfda_int)

!********************************************************************
! =====   SCALAR FLOATING POINT DATA
!********************************************************************
  CASE(case_scl_flt)

     IF(.NOT. ASSOCIATED(var%SCL_FLT))THEN 

        IF(ASSOCIATED(var%VEC_FLT))THEN
           IF(size(var%VEC_FLT)==1) var%SCL_FLT=>var%VEC_FLT(1)
        ELSE IF(ASSOCIATED(var%ARR_FLT))THEN
           IF(size(var%ARR_FLT)==1) var%SCL_FLT=>var%ARR_FLT(1,1)
        ELSE IF(ASSOCIATED(var%CUB_FLT))THEN
           IF(size(var%CUB_FLT)==1) var%SCL_FLT=>var%CUB_FLT(1,1,1)
        ELSE        

           CALL print_var(var)
           CALL fatal_error("NC_WRITE_VAR: Variable objects SCL_FLT data is NOT assocaited!")
        END IF
     END IF

     scl_flt => var%SCL_FLT

     ! ONLY COLLECT SCLs IF USING IOPROC: MSR SHOULD ALREADY HAVE THE DATA...
     IF(collectdata .AND. use_mpi_io_mode) THEN
        CALL fatal_error("NC_WRITE_VAR: COLLECT DATA FLAG IS T&
             &RUE BUT THIS IS NOT A MULTIPROCESSOR CASE?")
     END IF

     IF (dump) THEN

        IF (SIZE(nstart) .GT. 0) THEN

           if (product(ncount) .NE. 1) CALL fatal_error&
                & ("NC_WRITE_VAR: NCOUNT dimension invalid while reading scl_flt?")

           ! ARGUMENT TO NF90_PUT_VAR MUST BE A VECTOR
           allocate(gvec_flt(1)); gvec_flt(1) = scl_flt        
           status = nf90_put_var(var%NCID,var%VARID,gvec_flt,nstart,ncount,nstride)
           CALL handle_ncerr(status,trim(errmsg))
           
           deallocate(gvec_flt)
        ELSE
           status = nf90_put_var(var%NCID,var%VARID,scl_flt)
           CALL handle_ncerr(status,trim(errmsg))
        END IF
     END IF
     
     NULLIFY(scl_flt)

!********************************************************************
! =====   VECTOR FLOATING POINT DATA
!********************************************************************
  CASE(case_vec_flt)

    IF(.NOT. ASSOCIATED(var%VEC_FLT))THEN 
       
       IF(ASSOCIATED(var%ARR_FLT))THEN
          IF(size(var%ARR_FLT,1)==1) var%VEC_FLT=>var%ARR_FLT(1,1:)
          IF(size(var%ARR_FLT,2)==1) var%VEC_FLT=>var%ARR_FLT(1:,1)
       ELSE IF(ASSOCIATED(var%CUB_FLT))THEN
          IF(size(var%CUB_FLT,1)==1) THEN
             IF(size(var%CUB_FLT,2)==1) var%VEC_FLT=>var%CUB_FLT(1,1,1:)
             IF(size(var%CUB_FLT,3)==1) var%VEC_FLT=>var%CUB_FLT(1,1:,1)
          END IF
          IF(size(var%CUB_FLT,1)==2) THEN
             IF(size(var%CUB_FLT,3)==1) var%VEC_FLT=>var%CUB_FLT(1:,1,1)
          END IF
       ELSE        
          
          CALL print_var(var)
          CALL fatal_error("NC_WRITE_VAR: Variable objects VEC_FLT data is NOT assocaited!")
       END IF
    END IF

    nsize=ubound(var%VEC_FLT,1)

     ! ONLY COLLECT SCLs IF USING IOPROC: MSR SHOULD ALREADY HAVE THE DATA...
     IF(collectdata) THEN
        CALL fatal_error("NC_WRITE_VAR: COLLECT DATA FLAG IS T&
             &RUE BUT THIS IS NOT A MULTIPROCESSOR CASE?")
     END IF

 
     IF (dump) THEN

        ! IF YOU ARE THE IOPROC REASSIGN THE POINTER 
        If(.NOT. collectdata) gvec_flt => var%VEC_FLT(1:rdims(1))


        status = nf90_put_var(var%NCID,var%VARID,gvec_flt,nstart,ncount,nstride)
        CALL handle_ncerr(status,trim(errmsg))

        ! IF YOU ARE COLLECTING AN DUMPING IN THE SAME PASS
        ! DEALLOCATE THE MEMORY YOU COLLECTED INTO
        IF (collectdata) deallocate(gvec_flt)
        
     END IF

     nullify(gvec_flt)
     nullify(lvec_flt)
     

!********************************************************************
! =====   ARRAY FLOATING POINT DATA
!********************************************************************
  CASE(case_arr_flt)

    IF(.NOT. ASSOCIATED(var%ARR_FLT))THEN 

        IF(ASSOCIATED(var%CUB_FLT))THEN
           IF(size(var%CUB_FLT,1)==1) var%ARR_FLT=>var%CUB_FLT(1,1:,1:)
           IF(size(var%CUB_FLT,2)==1) var%ARR_FLT=>var%CUB_FLT(1:,1,1:)
           IF(size(var%CUB_FLT,3)==1) var%ARR_FLT=>var%CUB_FLT(1:,1:,1)
        ELSE        

           CALL print_var(var)
           CALL fatal_error("NC_WRITE_VAR: Variable objects ARR_FLT data is NOT assocaited!")
        END IF
     END IF

     nsize=ubound(var%ARR_FLT,1)

     ! ONLY COLLECT SCLs IF USING IOPROC: MSR SHOULD ALREADY HAVE THE DATA...
     IF(collectdata) THEN
        CALL fatal_error("NC_WRITE_VAR: COLLECT DATA FLAG IS T&
             &RUE BUT THIS IS NOT A MULTIPROCESSOR CASE?")
     END IF

 
     IF (dump) THEN

        ! IF YOU ARE THE IOPROC REASSIGN THE POINTER 
        If(.NOT. collectdata) garr_flt => var%ARR_FLT(1:rdims(1),1:rdims(2))

        status = nf90_put_var(var%NCID,var%VARID,garr_flt,nstart,ncount,nstride)
        CALL handle_ncerr(status,trim(errmsg))


        ! IF YOU ARE COLLECTING AN DUMPING IN THE SAME PASS
        ! DEALLOCATE THE MEMORY YOU COLLECTED INTO
        IF (collectdata) deallocate(garr_flt)
        

     END IF
     
     nullify(larr_flt)
     nullify(garr_flt)
     

!********************************************************************
! =====   CUBE FLOATING POINT DATA
!********************************************************************
  CASE(case_cub_flt)

    IF(.NOT. ASSOCIATED(var%cub_FLT))THEN 
        CALL print_var(var)
        CALL fatal_error("NC_WRITE_VAR: Variable objects CUB_FLT data is NOT assocaited!")
     END IF

     nsize=ubound(var%CUB_FLT,1)

     ! ONLY COLLECT SCLs IF USING IOPROC: MSR SHOULD ALREADY HAVE THE DATA...
     IF(collectdata) THEN
        CALL fatal_error("NC_WRITE_VAR: COLLECT DATA FLAG IS T&
             &RUE BUT THIS IS NOT A MULTIPROCESSOR CASE?")
     END IF

 
     IF (dump) THEN
        
        ! IF YOU ARE THE IOPROC REASSIGN THE POINTER 
        If(.NOT. collectdata) gcub_flt => var%CUB_FLT(1:rdims(1),1:rdims(2),1:rdims(3))

        status = nf90_put_var(var%NCID,var%VARID,gcub_flt,nstart,ncount,nstride)
        CALL handle_ncerr(status,trim(errmsg))

        ! IF YOU ARE COLLECTING AN DUMPING IN THE SAME PASS
        ! DEALLOCATE THE MEMORY YOU COLLECTED INTO
        IF (collectdata) deallocate(gcub_flt)
        
     END IF

     nullify(lcub_flt)
     nullify(gcub_flt)
     

!********************************************************************
! =====   FOUR DIMENSION ARRAY FLOATING POINT DATA
!********************************************************************
  CASE(case_fda_flt)

    IF(.NOT. ASSOCIATED(var%fda_FLT))THEN 
        CALL print_var(var)
        CALL fatal_error("NC_WRITE_VAR: Variable objects FDA_FLT data is NOT assocaited!")
     END IF

     nsize=ubound(var%FDA_FLT,1)

     ! ONLY COLLECT SCLs IF USING IOPROC: MSR SHOULD ALREADY HAVE THE DATA...
     IF(collectdata) THEN
        CALL fatal_error("NC_WRITE_VAR: COLLECT DATA FLAG IS T&
             &RUE BUT THIS IS NOT A MULTIPROCESSOR CASE?")
     END IF

 
     IF (dump) THEN
        
        ! IF YOU ARE THE IOPROC REASSIGN THE POINTER 
        If(.NOT. collectdata) gfda_flt => var%FDA_FLT(1:rdims(1),1:rdims(2),1:rdims(3),1:rdims(4))

        status = nf90_put_var(var%NCID,var%VARID,gfda_flt,nstart,ncount,nstride)
        CALL handle_ncerr(status,trim(errmsg))

        ! IF YOU ARE COLLECTING AN DUMPING IN THE SAME PASS
        ! DEALLOCATE THE MEMORY YOU COLLECTED INTO
        IF (collectdata) deallocate(gfda_flt)
        
     END IF

     nullify(lfda_flt)
     nullify(gfda_flt)
     

!********************************************************************
! =====   SCALAR DOUBLE DATA
!********************************************************************
  CASE(case_scl_dbl)

     IF(.NOT. ASSOCIATED(var%SCL_DBL))THEN 

        IF(ASSOCIATED(var%VEC_DBL))THEN
           IF(size(var%VEC_DBL)==1) var%SCL_DBL=>var%VEC_DBL(1)
        ELSE IF(ASSOCIATED(var%ARR_DBL))THEN
           IF(size(var%ARR_DBL)==1) var%SCL_DBL=>var%ARR_DBL(1,1)
        ELSE IF(ASSOCIATED(var%CUB_DBL))THEN
           IF(size(var%CUB_DBL)==1) var%SCL_DBL=>var%CUB_DBL(1,1,1)
        ELSE        
           
           CALL print_var(var)
           CALL fatal_error("NC_WRITE_VAR: Variable objects SCL_DBL data is NOT assocaited!")
        END IF
     END IF

     scl_dbl => var%SCL_DBL

     ! ONLY COLLECT SCLs IF USING IOPROC: MSR SHOULD ALREADY HAVE THE DATA...
     IF(collectdata .AND. use_mpi_io_mode) THEN
        CALL fatal_error("NC_WRITE_VAR: COLLECT DATA FLAG IS T&
             &RUE BUT THIS IS NOT A MULTIPROCESSOR CASE?")
     END IF

     IF (dump) THEN
        IF (SIZE(nstart) .GT. 0) THEN

            if (product(ncount) .NE. 1) CALL fatal_error&
                & ("NC_WRITE_VAR: NCOUNT dimension invalid while reading scl_dbl?")

           ! ARGUMENT TO NF90_PUT_VAR MUST BE A VECTOR
           allocate(gvec_dbl(1)); gvec_dbl(1) = scl_dbl
           status = nf90_put_var(var%NCID,var%VARID,gvec_dbl,nstart,ncount,nstride)
           CALL handle_ncerr(status,trim(errmsg))
           
           deallocate(gvec_dbl)
        ELSE
           status = nf90_put_var(var%NCID,var%VARID,scl_dbl)
           CALL handle_ncerr(status,trim(errmsg))
        END IF
     END IF
     
     NULLIFY(scl_dbl)

!********************************************************************
! =====   VECTOR DOUBLE DATA
!********************************************************************
  CASE(case_vec_dbl)


    IF(.NOT. ASSOCIATED(var%VEC_DBL))THEN 

       IF(ASSOCIATED(var%ARR_DBL))THEN
          IF(size(var%ARR_DBL,1)==1) var%VEC_DBL=>var%ARR_DBL(1,1:)
          IF(size(var%ARR_DBL,2)==1) var%VEC_DBL=>var%ARR_DBL(1:,1)
       ELSE IF(ASSOCIATED(var%CUB_DBL))THEN
          IF(size(var%CUB_DBL,1)==1) THEN
             IF(size(var%CUB_DBL,2)==1) var%VEC_DBL=>var%CUB_DBL(1,1,1:)
             IF(size(var%CUB_DBL,3)==1) var%VEC_DBL=>var%CUB_DBL(1,1:,1)
          END IF
          IF(size(var%CUB_DBL,1)==2) THEN
             IF(size(var%CUB_DBL,3)==1) var%VEC_DBL=>var%CUB_DBL(1:,1,1)
          END IF
       ELSE        
          
          CALL print_var(var)
          CALL fatal_error("NC_WRITE_VAR: Variable objects VEC_DBL data is NOT assocaited!")
       END IF
    END IF

    nsize=ubound(var%VEC_DBL,1)

     IF(collectdata) THEN
        CALL fatal_error("NC_WRITE_VAR: COLLECT DATA FLAG IS T&
             &RUE BUT THIS IS NOT A MULTIPROCESSOR CASE?")
     END IF

 
     IF (dump) THEN


        ! IF YOU ARE THE IOPROC REASSIGN THE POINTER 
        If(.NOT. collectdata) gvec_dbl => var%VEC_DBL(1:rdims(1))

        status = nf90_put_var(var%NCID,var%VARID,gvec_dbl,nstart,ncount,nstride)
        CALL handle_ncerr(status,trim(errmsg))

        ! IF YOU ARE COLLECTING AN DUMPING IN THE SAME PASS
        ! DEALLOCATE THE MEMORY YOU COLLECTED INTO
        IF (collectdata) deallocate(gvec_dbl)
        
     END IF

     nullify(gvec_dbl)
     nullify(lvec_dbl)
     

!********************************************************************
! =====   ARRAY DOUBLE DATA
!********************************************************************
  CASE(case_arr_dbl)

     IF(.NOT. ASSOCIATED(var%ARR_DBL))THEN 
        
        IF(ASSOCIATED(var%CUB_DBL))THEN
           IF(size(var%CUB_DBL,1)==1) var%ARR_DBL=>var%CUB_DBL(1,1:,1:)
           IF(size(var%CUB_DBL,2)==1) var%ARR_DBL=>var%CUB_DBL(1:,1,1:)
           IF(size(var%CUB_DBL,3)==1) var%ARR_DBL=>var%CUB_DBL(1:,1:,1)
        ELSE        
           
           CALL print_var(var)
           CALL fatal_error("NC_WRITE_VAR: Variable objects ARR_DBL data is NOT assocaited!")
        END IF
     END IF
     
     nsize=ubound(var%ARR_DBL,1)

     ! ONLY COLLECT SCLs IF USING IOPROC: MSR SHOULD ALREADY HAVE THE DATA...
     IF(collectdata) THEN
        CALL fatal_error("NC_WRITE_VAR: COLLECT DATA FLAG IS T&
             &RUE BUT THIS IS NOT A MULTIPROCESSOR CASE?")
     END IF

 
     IF (dump) THEN

        ! IF YOU ARE THE IOPROC REASSIGN THE POINTER 
        If(.NOT. collectdata) garr_dbl => var%ARR_DBL(1:rdims(1),1:rdims(2))

        status = nf90_put_var(var%NCID,var%VARID,garr_dbl,nstart,ncount,nstride)
        CALL handle_ncerr(status,trim(errmsg))

        ! IF YOU ARE COLLECTING AN DUMPING IN THE SAME PASS
        ! DEALLOCATE THE MEMORY YOU COLLECTED INTO
        IF (collectdata) deallocate(garr_dbl)
        
     END IF

     nullify(larr_dbl)
     nullify(garr_dbl)

!********************************************************************
! =====   CUBE DOUBLE DATA
!********************************************************************
  CASE(case_cub_dbl)

    IF(.NOT. ASSOCIATED(var%CUB_DBL))THEN 
        CALL print_var(var)
        CALL fatal_error("NC_WRITE_VAR: Variable objects CUB_DBL data is NOT assocaited!")
     END IF

     nsize=ubound(var%CUB_DBL,1)

     IF(collectdata) THEN
        CALL fatal_error("NC_WRITE_VAR: COLLECT DATA FLAG IS T&
             &RUE BUT THIS IS NOT A MULTIPROCESSOR CASE?")
     END IF

 
     IF (dump) THEN
        
        ! IF YOU ARE THE IOPROC REASSIGN THE POINTER 
        If(.NOT. collectdata) gcub_dbl => var%CUB_DBL(1:rdims(1),1:rdims(2),1:rdims(3))

        status = nf90_put_var(var%NCID,var%VARID,gcub_dbl,nstart,ncount,nstride)
        CALL handle_ncerr(status,trim(errmsg))

        ! IF YOU ARE COLLECTING AN DUMPING IN THE SAME PASS
        ! DEALLOCATE THE MEMORY YOU COLLECTED INTO
        IF (collectdata) deallocate(gcub_dbl)
        
     END IF

     nullify(lcub_dbl)
     nullify(gcub_dbl)
 
!********************************************************************
! =====   FOUR DIMENSION ARRAY DOUBLE DATA
!********************************************************************
  CASE(case_fda_dbl)

    IF(.NOT. ASSOCIATED(var%FDA_DBL))THEN 
        CALL print_var(var)
        CALL fatal_error("NC_WRITE_VAR: Variable objects FDA_DBL data is NOT assocaited!")
     END IF

     nsize=ubound(var%FDA_DBL,1)

     IF(collectdata) THEN
        CALL fatal_error("NC_WRITE_VAR: COLLECT DATA FLAG IS T&
             &RUE BUT THIS IS NOT A MULTIPROCESSOR CASE?")
     END IF

 
     IF (dump) THEN
        
        ! IF YOU ARE THE IOPROC REASSIGN THE POINTER 
        If(.NOT. collectdata) gfda_dbl => var%FDA_DBL(1:rdims(1),1:rdims(2),1:rdims(3),1:rdims(4))

        status = nf90_put_var(var%NCID,var%VARID,gfda_dbl,nstart,ncount,nstride)
        CALL handle_ncerr(status,trim(errmsg))

        ! IF YOU ARE COLLECTING AN DUMPING IN THE SAME PASS
        ! DEALLOCATE THE MEMORY YOU COLLECTED INTO
        IF (collectdata) deallocate(gfda_dbl)
        
     END IF

     nullify(lfda_dbl)
     nullify(gfda_dbl)
 
!********************************************************************
! =====   SCALAR CHARACTER STRING DATA
!********************************************************************
  CASE(case_scl_chr)

     IF(.NOT. ASSOCIATED(var%SCL_CHR))THEN 

        IF (ASSOCIATED(var%vec_chr))THEN 
           IF(SIZE(var%vec_chr)==1) var%scl_chr => var%vec_chr(1)
        ELSE
           
           CALL print_var(var)
           CALL fatal_error("NC_WRITE_VAR: Variable objects SCL_CHR data is NOT assocaited!")
        END IF
     END IF
     
     scl_chr => var%SCL_CHR

     ! ONLY COLLECT SCLs IF USING IOPROC: MSR SHOULD ALREADY HAVE THE DATA...
     IF(collectdata .AND. use_mpi_io_mode) THEN
        CALL fatal_error("NC_WRITE_VAR: COLLECT DATA FLAG IS T&
             &RUE BUT THIS IS NOT A MULTIPROCESSOR CASE?")
     END IF

     IF (dump) THEN
        ! IF THE STRING IS SMALLER THAN THE DIMENSION
        ! AND NCOUNT IS TOO BIG
        nsize = len_trim(scl_chr)
        IF(nsize < rdims(1)) ncount(1)=nsize

        status = nf90_put_var(var%NCID,var%VARID,scl_chr,nstart,ncount,nstride)
        CALL handle_ncerr(status,trim(errmsg))

     END IF
     
     NULLIFY(scl_chr)
!********************************************************************
! =====   VECTOR CHARACTER STRING DATA
!********************************************************************
  CASE(case_vec_chr)

     IF(.NOT. ASSOCIATED(var%VEC_CHR))THEN 
        CALL print_var(var)
        CALL fatal_error("NC_WRITE_VAR: Variable objects VEC_CH&
             &R data is NOT assocaited!")
     END IF

     vec_chr => var%VEC_CHR

     ! ONLY COLLECT SCLs IF USING IOPROC: MSR SHOULD ALREADY HAVE THE DATA...
     IF(collectdata .AND. use_mpi_io_mode) THEN
        CALL fatal_error("NC_WRITE_VAR: COLLECT DATA FLAG IS T&
             &RUE BUT THIS IS NOT A MULTIPROCESSOR CASE?")
     END IF

     ! WRITING CHARACTER VECTORS IS A PROBLEM
     ! THE LENGTH HAS TO BE SET FOR EACH WRITE IN A DO LOOP
     ! POINT THE SCL_CHR TO EACH STRING AND DO A SEPERATE WRITE...
     IF (dump) THEN

        cnt=SIZE(ncount)
        allocate(nstrt(cnt),ncnt(cnt),nstrd(cnt))
        nstrt=nstart
        ncnt=ncount
        nstrd=nstride
        
        
        DO i = 1,rdims(2)
           
           scl_chr => vec_chr(i)

           ! IF THE STRING IS SMALLER THAN THE DIMENSION
           ! AND NCOUNT IS TOO BIG 
           nsize = len_trim(scl_chr)
           IF(nsize < rdims(1))THEN
              ncnt(1)=nsize
           ELSE
              ncnt(1)= rdims(1)
           END IF
           
           ! WRITE THE I'th Entry (one entry)
           nstrt(2)=i
           ncnt(2)=1

           status = nf90_put_var(var%NCID,var%VARID,scl_chr,nstrt,ncnt,nstrd)
           CALL handle_ncerr(status,trim(errmsg))

           nullify(scl_chr)

        END DO
        deallocate(nstrt,ncnt,nstrd)

     END IF
     
     NULLIFY(vec_chr)
     
  CASE default
     call print_var(var)
     call fatal_error("NC_WRITE_VAR: UNKNOWN CASE")
  END SELECT

  IF(dump) THEN
     status = nf90_sync(var%ncid)
     CALL handle_ncerr(status,trim(errmsg))
  END IF

  !Only deallocate if it is not pointing to Ncount
  IF(.not.ASSOCIATED(rdims,ncount)) THEN
     IF(ASSOCIATED(rdims)) DEALLOCATE(rdims)
  ELSE
     NULLIFY(rdims)
  END IF


  IF(PRESENT(iostart)) THEN
     nullify(nstart)
  ELSE
     deallocate(nstart)
  END IF

  IF(PRESENT(iocount)) THEN
     nullify(ncount)
  ELSE
     deallocate(ncount)
  END IF

  IF(PRESENT(iostride)) THEN
     nullify(nstride)
  ELSE
     deallocate(nstride)
  END IF



  IF(dbg_set(dbg_sbr)) WRITE(ipt,*) "END NC_WRITE_VAR:"

END SUBROUTINE nc_write_var
!====================================================================
!====================================================================
! Watch out - pointing to part of an array is tricky. The index may be reset
SUBROUTINE nc_read_var(VAR,STKCNT,STKRNG,IOSTART,IOCOUNT,IOSTRIDE,DEALERID,PARALLEL)
  USE control
  implicit none
  TYPE(ncvar), POINTER :: VAR
  INTEGER, INTENT(IN), OPTIONAL :: STKCNT
  INTEGER, INTENT(IN), OPTIONAL :: STKRNG(2)
  INTEGER, INTENT(IN), OPTIONAL :: DEALERID
  LOGICAL, INTENT(IN), OPTIONAL :: PARALLEL
  INTEGER, ALLOCATABLE,TARGET, OPTIONAL :: IOSTART(:), IOCOUNT(:), IOSTRIDE(:)

  ! LOCAL CONTROL VARIALBES
  INTEGER :: DEALER
  LOGICAL :: PAR_READ
  LOGICAL :: SER_READ

  ! NF90 SUBSET VARIABLES
  INTEGER, POINTER :: NSTART(:), NCOUNT(:), NSTRIDE(:)

  ! The size of the data returned by nf90_get/put_var
  INTEGER, POINTER :: RDIMS(:)
  ! For use in put/get_var for vector character data
  INTEGER, POINTER :: NSTRT(:), NCNT(:), NSTRD(:)

  INTEGER :: CODE
  INTEGER :: XTYPE
  INTEGER :: CNT,DIMCNT
  INTEGER :: NSIZE, MYSIZE
!  integer :: dim1,dim2,dim3,dim4

  ! POINTERS AND SUCH
  TYPE(ncdim), POINTER :: DIM
  TYPE(ncdimp), POINTER :: DIMLINK
  TYPE(ncfile), POINTER :: NCF
  LOGICAL FOUND


  INTEGER, PARAMETER :: case_scl_int = 1
  INTEGER, PARAMETER :: case_vec_int = 2
  INTEGER, PARAMETER :: case_arr_int = 3
  INTEGER, PARAMETER :: case_cub_int = 4
  INTEGER, PARAMETER :: case_fda_int = 5

  INTEGER, PARAMETER :: case_scl_flt = 6
  INTEGER, PARAMETER :: case_vec_flt = 7
  INTEGER, PARAMETER :: case_arr_flt = 8
  INTEGER, PARAMETER :: case_cub_flt = 9
  INTEGER, PARAMETER :: case_fda_flt = 10

  INTEGER, PARAMETER :: case_scl_dbl = 11
  INTEGER, PARAMETER :: case_vec_dbl = 12
  INTEGER, PARAMETER :: case_arr_dbl = 13
  INTEGER, PARAMETER :: case_cub_dbl = 14
  INTEGER, PARAMETER :: case_fda_dbl = 15

  INTEGER, PARAMETER :: case_scl_chr = 16
  INTEGER, PARAMETER :: case_vec_chr = 17

  ! TEMPORARY STORAGE FOR DATA IF COLLECTED TO MASTER PROC
  INTEGER, POINTER                :: SCL_INT
  INTEGER, POINTER,DIMENSION(:)   :: GVEC_INT
  INTEGER, POINTER,DIMENSION(:,:) :: GARR_INT
  INTEGER, POINTER,DIMENSION(:,:,:) :: GCUB_INT
  INTEGER, POINTER,DIMENSION(:,:,:,:) :: GFDA_INT

  INTEGER, POINTER,DIMENSION(:)   :: LVEC_INT
  INTEGER, POINTER,DIMENSION(:,:) :: LARR_INT
  INTEGER, POINTER,DIMENSION(:,:,:) :: LCUB_INT
  INTEGER, POINTER,DIMENSION(:,:,:,:) :: LFDA_INT

  REAL(SPA), POINTER                :: SCL_FLT
  REAL(SPA), POINTER,DIMENSION(:)   :: LVEC_FLT
  REAL(SPA), POINTER,DIMENSION(:,:) :: LARR_FLT
  REAL(SPA), POINTER,DIMENSION(:,:,:) :: LCUB_FLT
  REAL(SPA), POINTER,DIMENSION(:,:,:,:) :: LFDA_FLT

  REAL(SPA), POINTER,DIMENSION(:)   :: GVEC_FLT
  REAL(SPA), POINTER,DIMENSION(:,:) :: GARR_FLT
  REAL(SPA), POINTER,DIMENSION(:,:,:) :: GCUB_FLT
  REAL(SPA), POINTER,DIMENSION(:,:,:,:) :: GFDA_FLT
  
  REAL(DP), POINTER                :: SCL_DBL
  REAL(DP), POINTER,DIMENSION(:)   :: GVEC_DBL
  REAL(DP), POINTER,DIMENSION(:,:) :: GARR_DBL
  REAL(DP), POINTER,DIMENSION(:,:,:) :: GCUB_DBL
  REAL(DP), POINTER,DIMENSION(:,:,:,:) :: GFDA_DBL

  REAL(DP), POINTER,DIMENSION(:)   :: LVEC_DBL
  REAL(DP), POINTER,DIMENSION(:,:) :: LARR_DBL
  REAL(DP), POINTER,DIMENSION(:,:,:) :: LCUB_DBL
  REAL(DP), POINTER,DIMENSION(:,:,:,:) :: LFDA_DBL

  CHARACTER(LEN=80), POINTER        :: SCL_CHR
  CHARACTER(LEN=80), POINTER        :: VEC_CHR(:)
  INTEGER :: nlen

  CHARACTER(len=3) :: char1,char2,char3
  ! DATA FOR PUT VAR COMMANDS:
  INTEGER :: STATUS, I
  CHARACTER(LEN=120)          :: errmsg

  IF(dbg_set(dbg_sbr)) WRITE(ipt,*) "START NC_READ_VAR:"

  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("NC_READ_VAR: Variable object argument is not assocaited!")

  ! INITIALIZE SOME MEMORY
  nlen=0
  status=0
  i=0
  code=0
  xtype=0
  cnt=0
  dimcnt=0
  nsize=0
  mysize=0
  dealer=0
  par_read=.false.
  ser_read=.false.
  found=.false.



  !NULLIFY POINTERS
  NULLIFY(nstart,ncount,nstride)
  NULLIFY(rdims,nstrt,ncnt,nstrd)
  NULLIFY(dim,dimlink,ncf)
  NULLIFY(scl_int,gvec_int,garr_int,gcub_int,gfda_int,lvec_int,larr_int,lcub_int,lfda_int)

  NULLIFY(scl_flt,gvec_flt,garr_flt,gcub_flt,gfda_flt,lvec_flt,larr_flt,lcub_flt,lfda_flt)
  NULLIFY(scl_dbl,gvec_dbl,garr_dbl,gcub_dbl,gfda_dbl,lvec_dbl,larr_dbl,lcub_dbl,lfda_dbl)
  NULLIFY(scl_chr,vec_chr)

  ! CHECK TO SEE IF A DEALER ID WAS SPECIFIED?
  IF (PRESENT(dealerid)) THEN
     dealer = dealerid
  ELSE
     dealer = msrid ! FOR SERIAL CASE DEALER MUST BE MASTER, 
  END IF


! THIS IS HARD TO DO - YOU CAN'T RELIABLE GET THE NCF POINTER?
! NOT ALL FILES ARE ADDED TO THE FILEHEAD BEFORE CALLING READ/WRITE
!!$  ! MAKE SURE THE FILE IS OPEN 
!!$  IF(DEALER == MYID) THEN
!!$     IF(.NOT. Associated(VAR%NCID)) THEN
!!$        Call Print_var(VAR)
!!$        Call Fatal_error&
!!$          &("NC_READ_VAR: VARIABLE NCID NOT ASSOCIATED?")
!!$     END IF
!!$
!!$     NCF => FIND_FILE_BYNCID(FILEHEAD ,VAR%NCID,FOUND)
!!$     IF (.NOT. FOUND)THEN
!!$        CALL PRINT_FILE_LIST(FILEHEAD)
!!$        Call Print_var(VAR)
!!$        Call Fatal_error&
!!$          &(" NC_READ_VAR: FILE NOT FOUND IN FILE THE FILEHEAD?")
!!$     END IF
!!$
!!$     IF(.NOT. NCF%OPEN) CALL NC_OPEN(NCF)
!!$
!!$     IF(.NOT. NCF%CONNECTED) THEN
!!$        CALL PRINT_FILE(NCF)
!!$        CALL FATAL_ERROR("NC_READ_VAR: Attempt to read variable from file which is not connected?",& 
!!$             & "You must call 'nc_save' or 'nc_load' before trying to read data!")
!!$     END IF
!!$
!!$  END IF


  ! CHECK TO SEE IF GLOBAL PAR/SERIAL IS OVER-RIDDEN FOR THIS READ?
  IF (PRESENT(parallel)) THEN
     IF(serial .and. parallel)THEN
        CALL print_var(var)
        CALL fatal_error("NC_READ_VAR: PARALLEL ERROR!",&
             & "The model is running on a single processor,",&
             & "but asked to do a parallel NC_READ_VAR operation!")
     END IF
     par_read= parallel ! SET THE LOCAL PASSED OPTION
  ELSE
     par_read= par ! SET THE GLOBAL
  END IF
  ser_read=.NOT. par_read

  ! COUNT THE NUMBER OF DIMENSIONS IN THE VARIABLE
  dimcnt = count_dim_list(var)

  IF(dbg_set(dbg_sbrio)) THEN

     write(char2,'(I3.3)')dealer
     write(char3,'(I3.3)')myid
     WRITE(ipt,*)"NC_READ_VAR Arguments:"
     call print_var(var)
     WRITE(ipt,*)"; DEALER="//char2//"; MYID="//char3//"; PAR_READ=",par_read
     
     
     IF(PRESENT(stkcnt)) THEN
        WRITE(ipt,*) "STKCNT=",stkcnt
     ELSE
        WRITE(ipt,*) "STKCNT= NONE"
     END IF

     IF(PRESENT(stkrng)) THEN
        WRITE(ipt,*) "STKRNG=",stkrng
     ELSE
        WRITE(ipt,*) "STKRNG= NONE"
     END IF
     
     IF(PRESENT(iostart)) THEN
        WRITE(ipt,*) "IOSTART=",iostart
     ELSE
        WRITE(ipt,*) "IOSTART= NONE"
     END IF
     
     IF(PRESENT(iocount)) THEN
        WRITE(ipt,*) "IOCOUNT=",iocount
     ELSE
        WRITE(ipt,*) "IOCOUNT= NONE"
     END IF
     
     IF(PRESENT(iostride)) THEN
        WRITE(ipt,*) "IOSTRIDE=",iostride
     ELSE
        WRITE(ipt,*) "IOSTRIDE= NONE"
     END IF
     
  END IF

  IF(var%NCID == -1 .and. dealer == myid) THEN
     CALL print_var(var)
     CALL fatal_error("NC_READ_VAR: CAN NOT READ FILE, IT IS NOT OPEN!")
  END IF
  


  IF ( PRESENT(stkcnt) ) THEN

     IF (PRESENT(stkrng) .or. PRESENT(iostart) .or. PRESENT(iocount) .or. PRESENT(iostride))THEN
        CALL print_var(var)
        CALL fatal_error("NC_READ_VAR: You can not pass both STKCNT and STKRNG/START/COUNT/STRIDE !",&
             &"Set STKCNT to read a time slice filling all other dimensions. OR",&
             &"Set IOSTART/IOCOUNT/(IOSTRIDE) to read a specific range.")
     END IF

     dim => find_unlimited(var,found)
     IF(.NOT.found) THEN
        CALL print_var(var)
        CALL fatal_error&
             &("NC_READ_VAR: CALLED WITH STKCNT ARGUMENT BUT VARIABLE IS NOT UNLIMITED?")
     END IF
     NULLIFY(dim)


     ALLOCATE(nstart(dimcnt),ncount(dimcnt),nstride(dimcnt))


     ! SET THE VARIABLES CURRENT STACK COUNT
     var%CURR_STKCNT = stkcnt
     
     ! SET THE NF90_PUT_VAR DIMENSIONS
     nstart=1 ! START AT ONE, EXCEPT FOR THE TIME VARIABLE
     nstart(dimcnt) = stkcnt

     
     dimlink => var%DIMS%NEXT
     DO i = 1,dimcnt ! GET THE OUTPUT VARIABLE DIMENSIONS
        dim => dimlink%DIM  
        ncount(i)= dim%DIM
        dimlink => dimlink%NEXT
     END DO
     ncount(dimcnt)=1 ! SET THE TIME OUTPUT DIMENSION TO 1
     
     nstride=1 ! ALWAYS USE STRIDE 1 FOR STKCNT INPUT

     ! FOR TIME DEPENDANT DATA THE RANK OF THE ALLOCATED MEMORY IS
     ! ONE LESS THAN THE RANK OF THE FILE's VARIALBE!
     dimcnt = dimcnt -1

     ! THE DIMENSIONS READ WILL BE THE VALUES OF NCOUNT, NOT
     ! INCLUDING TIME
     IF(dimcnt > 0)THEN
        ALLOCATE(rdims(dimcnt))
        rdims(1:dimcnt)=ncount(1:dimcnt)
     ELSE IF (dimcnt == 0) THEN
         ALLOCATE(rdims(1))
        rdims(1)=ncount(1)
     ELSE
        nullify(rdims)
     END IF

  ELSEIF ( PRESENT(stkrng) ) THEN

     IF (PRESENT(stkcnt) .or. PRESENT(iostart) .or. PRESENT(iocount) .or. PRESENT(iostride))THEN
        CALL print_var(var)
        CALL fatal_error("NC_READ_VAR: You can not pass both STKRNG and STKCNT/START/COUNT/STRIDE !",&
             &"Set STKRNG to read a time range filling all other dimensions. OR",&
             &"Set IOSTART/IOCOUNT/(IOSTRIDE) to read a specific range.")
     END IF

     dim => find_unlimited(var,found)
     IF(.NOT.found) THEN
        CALL print_var(var)
        CALL fatal_error&
             &("NC_READ_VAR: CALLED WITH STKRNG ARGUMENT BUT VARIABLE IS NOT UNLIMITED?")
     END IF
     NULLIFY(dim)


     ALLOCATE(nstart(dimcnt),ncount(dimcnt),nstride(dimcnt))


     ! SET THE VARIABLES CURRENT STACK COUNT
     var%CURR_STKCNT = -1
     
     ! SET THE NF90_PUT_VAR DIMENSIONS
     nstart=1 ! START AT ONE, EXCEPT FOR THE TIME VARIABLE
     nstart(dimcnt) = stkrng(1)

     
     dimlink => var%DIMS%NEXT
     DO i = 1,dimcnt ! GET THE OUTPUT VARIABLE DIMENSIONS
        dim => dimlink%DIM  
        ncount(i)= dim%DIM
        dimlink => dimlink%NEXT
     END DO
     ncount(dimcnt)=stkrng(2)-stkrng(1)+1 ! SET THE TIME RANGE
     
     nstride=1 ! ALWAYS USE STRIDE 1 FOR STKRNG INPUT

     ! FOR A TIME RANGE THE RANK OF THE ALLOCATED MEMORY IS
     ! THE SAME AS THE RANK OF THE FILE's VARIALBE!
!     DIMCNT = DIMCNT

     ! THE DIMENSIONS READ WILL BE THE VALUES OF NCOUNT, NOT
     ! INCLUDING TIME
     rdims=>ncount

  ELSE IF( PRESENT(iostart) .and. PRESENT(iocount)) THEN

     nstart=>iostart
     ncount=>iocount

     IF(.not. PRESENT(iostride)) THEN
        ALLOCATE(nstride(dimcnt))
        nstride=1
     ELSE
        nstride=>iostride
     END IF

     IF(dimcnt /= size(nstart) .or. &
          & dimcnt /= size(ncount) .or. &
          & dimcnt /= size(nstride) ) THEN
        CALL print_var(var)
        CALL fatal_error&
        & ("NC_READ_VAR: Variable's # of file dimensions does not matach size(NSTART/NCOUNT/NSTRIDE) arugments?")
     END IF

     ! SET THE VARIABLES CURRENT STACK COUNT: not defined for this
     ! kind of read/write
     var%CURR_STKCNT = -1

     ! ONLY COUNT THE NONE SINGLETON DIMENSIONS OF A VARIABLE. 
     cnt = 0
     DO i = 1,dimcnt
        IF(ncount(i)>1) cnt=cnt+1
     END DO

     ! NOW RECORD THE DIMENSIONS OF THE DATA THAT WILL BE READ INTO MEMORY
     IF (cnt > 0) THEN
        
        ALLOCATE(rdims(cnt))
        cnt = 0
        DO i = 1,dimcnt
           IF(ncount(i)>1) THEN
              cnt=cnt+1
              rdims(cnt)=ncount(i)
           END IF
        END DO

     ELSE
        ALLOCATE(rdims(1)) 
        rdims(1) = 1
     END IF

     
     ! NOW SET THE DIMENSION OF THE DATA VARIABLE IN MEMORY
     dimcnt=cnt

  ELSE IF( .not. (PRESENT(iostart) .or. PRESENT(iocount) .or.&
       & PRESENT(stkcnt) .or. PRESENT(iostride))) THEN

     ALLOCATE(nstart(dimcnt),ncount(dimcnt),nstride(dimcnt))

     ! SET THE VARIABLES CURRENT STACK COUNT
     var%CURR_STKCNT = -1
     
     ! SET THE NF90_PUT_VAR DIMENSIONS
     nstart=1 ! START AT ONE, EXCEPT FOR THE TIME VARIABLE
     
     dimlink => var%DIMS%NEXT
     DO i = 1,dimcnt ! GET THE OUTPUT VARIABLE DIMENSIONS
        dim => dimlink%DIM  
        ncount(i)= dim%DIM
        dimlink => dimlink%NEXT
     END DO
     
     nstride=1 ! ALWAYS USE STRIDE 1 IF NO ARGUMENTS ARE PASSED

     ! ONLY COUNT THE NONE SINGLETON DIMENSIONS OF A VARIABLE. 
     cnt = 0
     DO i = 1,dimcnt
        IF(ncount(i)>1) cnt=cnt+1
     END DO

     ! NOW RECORD THE DIMENSIONS OF THE DATA THAT WILL BE READ INTO MEMORY
     IF (cnt > 0) THEN
        
        ALLOCATE(rdims(cnt))
        cnt = 0
        DO i = 1,dimcnt
           IF(ncount(i)>1) THEN
              cnt=cnt+1
              rdims(cnt)=ncount(i)
           END IF
        END DO

     ELSE
        ALLOCATE(rdims(1)) 
        rdims(1) = 1
     END IF

     
     ! NOW SET THE DIMENSION OF THE DATA VARIABLE IN MEMORY
     dimcnt=cnt

  ELSE

     IF(dbg_set(dbg_log)) THEN
        write(ipt,*) "# IOSTART  ::",PRESENT(iostart)
        write(ipt,*) "# IOCOUNT  ::",PRESENT(iocount)
        write(ipt,*) "# IOSTRIDE ::",PRESENT(iostride)
        write(ipt,*) "# STKCNT   ::",PRESENT(stkcnt)
        write(ipt,*) "# STKRNG   ::",PRESENT(stkrng)
     END IF
     
     CALL fatal_error("NC_READ_VAR: YOU SPECIFIED AN ILLEGAL COMBINATION OF AGUMENTS?",&
          & "Valid choices are STKCNT or STKRNG or NSTART,NCOUNT,(NSTRIDE) or none")
  END IF

  IF(dbg_set(dbg_sbrio)) THEN
     write(ipt,*) "FILE DIMENSION COUNT IS   ::", count_dim_list(var)
     write(ipt,*) "MEMORY DIMENSION COUNT IS ::",dimcnt
  END IF



  !DETERMIN WHICH CASE WE ARE WRITING DATA FOR
  code = -1

  select case(var%XTYPE)
  case(nf90_byte)
     call fatal_error("NC_READ_VAR: NOT SET UP TO WRITE BYTE DATA")
  case(nf90_short)
     call fatal_error("NC_READ_VAR: NOT SET UP TO WRITE SHORT DATA")
  case(nf90_int)
     if (dimcnt == 0) code = case_scl_int
     if (dimcnt == 1) code = case_vec_int
     if (dimcnt == 2) code = case_arr_int
     if (dimcnt == 3) code = case_cub_int
     if (dimcnt == 4) code = case_fda_int
  case(nf90_float)
!--Single Precision Coding------------------------------------------------------!
     ! READ SINGLE VARIABLES INTO SINGLE MEMORY POINTERS
     if (dimcnt == 0) code = case_scl_flt
     if (dimcnt == 1) code = case_vec_flt
     if (dimcnt == 2) code = case_arr_flt
     if (dimcnt == 3) code = case_cub_flt
     if (dimcnt == 4) code = case_fda_flt

  case(nf90_double)
     ! ALWAYS READ DOUBLE VARIABLES INTO DOUBLE MEMORY POINTERS
     if (dimcnt == 0) code = case_scl_dbl
     if (dimcnt == 1) code = case_vec_dbl
     if (dimcnt == 2) code = case_arr_dbl
     if (dimcnt == 3) code = case_cub_dbl
     if (dimcnt == 4) code = case_fda_dbl
  case(nf90_char)

     IF(ncount(1) == 1) THEN
        WRITE(ipt,*) "SINGLETON CHARACTER DATA!"
        IF(.not. ASSOCIATED(rdims,ncount)) THEN
           DEALLOCATE(rdims)
        ELSE
           NULLIFY(rdims)
        END IF

        dimcnt = dimcnt+1

        ALLOCATE(rdims(dimcnt))
        cnt = 1
        rdims(1) = ncount(1)
        DO i = 2,size(ncount)
           IF(ncount(i)>1) THEN
              cnt=cnt+1
              rdims(cnt)=ncount(i)
           END IF
        END DO
     END IF


     if (dimcnt == 1) code = case_scl_chr
     if (dimcnt == 2) code = case_vec_chr
     ! First dim is length of string
     ! Second dim is time
  case default
     call fatal_error("NC_READ_VAR: Unkown data type?")
  end select

  ! BASED ON CODE WRITE THE DATA
  errmsg="NC_READ_VAR: VARIABLE: "//var%varname//"; Can not be read by nf90_get_var!"

  SELECT CASE(code)
!********************************************************************
! =====   SCALAR FLOATING POINT DATA
!********************************************************************
  CASE(case_scl_flt)
     
     IF(.NOT. ASSOCIATED(var%SCL_FLT))THEN 

        IF(ASSOCIATED(var%VEC_FLT))THEN
           IF(size(var%VEC_FLT)==1) var%SCL_FLT=>var%VEC_FLT(1)
        ELSE IF(ASSOCIATED(var%ARR_FLT))THEN
           IF(size(var%ARR_FLT)==1) var%SCL_FLT=>var%ARR_FLT(1,1)
        ELSE IF(ASSOCIATED(var%CUB_FLT))THEN
           IF(size(var%CUB_FLT)==1) var%SCL_FLT=>var%CUB_FLT(1,1,1)
        ELSE IF(ASSOCIATED(var%FDA_FLT))THEN
           IF(size(var%FDA_FLT)==1) var%SCL_FLT=>var%FDA_FLT(1,1,1,1)
        ELSE        
           CALL print_var(var)
           CALL fatal_error("NC_READ_VAR: Variable objects SCL_FLT data is NOT assocaited!")
        END IF

     END IF
  
     IF (ser_read .OR. dealer .EQ. myid) THEN
        
        
        IF (SIZE(nstart) .GT. 0) THEN
           
           if (product(ncount) .NE. 1) CALL fatal_error&
                & ("NC_READ_VAR: NCOUNT dimension invalid while reading scl_flt?")
           
           allocate(gvec_flt(1))
           status = nf90_get_var(var%NCID,var%VARID,gvec_flt,nstart,ncount,nstride)
           CALL handle_ncerr(status,trim(errmsg))
           
           var%SCL_FLT = gvec_flt(1)
           deallocate(gvec_flt)
        ELSE
           
           status = nf90_get_var(var%NCID,var%VARID,var%SCL_FLT)
           CALL handle_ncerr(status,trim(errmsg))
           
        END IF
     END IF
     
     IF (par_read) THEN
        CALL fatal_error("NC_READ_VAR: TRIED TO ENTER PARALLEL OPTION IN SERIAL CODING!")
       
     END IF     

     nullify(gvec_flt)

!********************************************************************
! =====   VECTOR FLOATING POINT DATA
!********************************************************************
  CASE(case_vec_flt)

    IF(.NOT. ASSOCIATED(var%VEC_FLT))THEN 

        IF(ASSOCIATED(var%ARR_FLT))THEN
           IF(size(var%ARR_FLT,1)==1) var%VEC_FLT=>var%ARR_FLT(1,1:)
           IF(size(var%ARR_FLT,2)==1) var%VEC_FLT=>var%ARR_FLT(1:,1)
        ELSE IF(ASSOCIATED(var%CUB_FLT))THEN
           IF(size(var%CUB_FLT,1)==1) THEN
              IF(size(var%CUB_FLT,2)==1) var%VEC_FLT=>var%CUB_FLT(1,1,1:)
              IF(size(var%CUB_FLT,3)==1) var%VEC_FLT=>var%CUB_FLT(1,1:,1)
           END IF
           IF(size(var%CUB_FLT,1)==2) THEN
              IF(size(var%CUB_FLT,3)==1) var%VEC_FLT=>var%CUB_FLT(1:,1,1)
           END IF           
        ELSE        

           CALL print_var(var)
           CALL fatal_error("NC_READ_VAR: Variable objects VEC_FLT data is NOT assocaited!")
        END IF
     END IF


     IF (ser_read) THEN
        
        IF (ubound(var%VEC_FLT,1) .NE. rdims(1)) CALL fatal_error &
             & ("NC_READ_VAR: FILE OBJECT ALLOCATED SPACE DOES NOT MATCH&
             & THE DIMENSIONS OF THE FILE DATA IN SERIAL CASE",& 
             & "varname: "//trim(var%VARNAME))
        
        gvec_flt => var%VEC_FLT(1:rdims(1))
        
        status = nf90_get_var(var%NCID,var%VARID,gvec_flt,nstart,ncount,nstride)
        CALL handle_ncerr(status,trim(errmsg))
        
     ELSE ! PAR CASE 
        
        CALL fatal_error("NC_READ_VAR: TRIED TO ENTER PARALLEL OPTION IN SERIAL CODING!")
     END IF

     nullify(gvec_flt)
     nullify(lvec_flt)

!********************************************************************
! =====   ARRAY FLOATING POINT DATA
!********************************************************************
  CASE(case_arr_flt)

    IF(.NOT. ASSOCIATED(var%ARR_FLT))THEN 

        IF(ASSOCIATED(var%CUB_FLT))THEN
           IF(size(var%CUB_FLT,1)==1) var%ARR_FLT=>var%CUB_FLT(1,1:,1:)
           IF(size(var%CUB_FLT,2)==1) var%ARR_FLT=>var%CUB_FLT(1:,1,1:)
           IF(size(var%CUB_FLT,3)==1) var%ARR_FLT=>var%CUB_FLT(1:,1:,1)
        ELSE        

           CALL print_var(var)
           CALL fatal_error("NC_READ_VAR: Variable objects ARR_FLT data is NOT assocaited!")
        END IF
     END IF
     

     IF (ser_read) THEN
        
        IF (ubound(var%ARR_FLT,1) .NE. rdims(1)) CALL fatal_error &
             & ("NC_READ_VAR: FILE OBJECT ALLOCATED SPACE DOES NOT MATCH&
             & THE DIMENSIONS OF THE FILE DATA IN SERIAL CASE",& 
             & "varname: "//trim(var%VARNAME),&
             & "DIM1 does not match!")

      
        IF (ubound(var%ARR_FLT,2) .LT. rdims(2)) CALL fatal_error &
             & ("NC_READ_VAR: FILE OBJECT ALLOCATED SPACE DOES NOT MATCH&
             & THE DIMENSIONS OF THE FILE DATA IN SERIAL CASE",& 
             & "varname: "//trim(var%VARNAME),&
             & "DIM2 does not match!")
        
        garr_flt => var%ARR_FLT(1:rdims(1),1:rdims(2))
        
        
        status = nf90_get_var(var%NCID,var%VARID,garr_flt,nstart,ncount,nstride)
        CALL handle_ncerr(status,trim(errmsg))

        
     ELSE ! PAR CASE 
        
        CALL fatal_error("NC_READ_VAR: TRIED TO ENTER PARALLEL OPTION IN SERIAL CODING!")
     END IF

     nullify(garr_flt)
     nullify(larr_flt)

!********************************************************************
! =====   CUBE FLOATING POINT DATA
!********************************************************************
  CASE(case_cub_flt)

    IF(.NOT. ASSOCIATED(var%CUB_FLT))THEN 
        CALL print_var(var)
        CALL fatal_error("NC_READ_VAR: Variable objects CUB_FLT data is NOT assocaited!")
     END IF
     

     IF (ser_read) THEN
        
        IF (ubound(var%CUB_FLT,1) .NE. rdims(1)) CALL fatal_error &
             & ("NC_READ_VAR: FILE OBJECT ALLOCATED SPACE DOES NOT MATCH&
             & THE DIMENSIONS OF THE FILE DATA IN SERIAL CASE",& 
             & "varname: "//trim(var%VARNAME),&
             & "DIM1 does not match!")

        IF (ubound(var%CUB_FLT,2) .LT. rdims(2)) CALL fatal_error &
             & ("NC_READ_VAR: FILE OBJECT ALLOCATED SPACE DOES NOT MATCH&
             & THE DIMENSIONS OF THE FILE DATA IN SERIAL CASE",& 
             & "varname: "//trim(var%VARNAME),&
             & "DIM2 does not match!")

        IF (ubound(var%CUB_FLT,3) .LT. rdims(3)) CALL fatal_error &
             & ("NC_READ_VAR: FILE OBJECT ALLOCATED SPACE DOES NOT MATCH&
             & THE DIMENSIONS OF THE FILE DATA IN SERIAL CASE",& 
             & "varname: "//trim(var%VARNAME),&
             & "DIM3 does not match!")
        
        gcub_flt => var%CUB_FLT(1:rdims(1),1:rdims(2),1:rdims(3))
        
        
        status = nf90_get_var(var%NCID,var%VARID,gcub_flt,nstart,ncount,nstride)
        CALL handle_ncerr(status,trim(errmsg))

        
     ELSE ! PAR CASE 
        
        CALL fatal_error("NC_READ_VAR: TRIED TO ENTER PARALLEL OPTION IN SERIAL CODING!")
     END IF

     nullify(gcub_flt)
     nullify(lcub_flt)

!********************************************************************
! =====   FOUR DIMENSION ARRAY FLOATING POINT DATA
!********************************************************************
  CASE(case_fda_flt)

    IF(.NOT. ASSOCIATED(var%FDA_FLT))THEN 
        CALL print_var(var)
        CALL fatal_error("NC_READ_VAR: Variable objects FDA_FLT data is NOT assocaited!")
     END IF
     

     IF (ser_read) THEN
        
        IF (ubound(var%FDA_FLT,1) .NE. rdims(1)) CALL fatal_error &
             & ("NC_READ_VAR: FILE OBJECT ALLOCATED SPACE DOES NOT MATCH&
             & THE DIMENSIONS OF THE FILE DATA IN SERIAL CASE",& 
             & "varname: "//trim(var%VARNAME),&
             & "DIM1 does not match!")

        IF (ubound(var%FDA_FLT,2) .LT. rdims(2)) CALL fatal_error &
             & ("NC_READ_VAR: FILE OBJECT ALLOCATED SPACE DOES NOT MATCH&
             & THE DIMENSIONS OF THE FILE DATA IN SERIAL CASE",& 
             & "varname: "//trim(var%VARNAME),&
             & "DIM2 does not match!")

        IF (ubound(var%FDA_FLT,3) .LT. rdims(3)) CALL fatal_error &
             & ("NC_READ_VAR: FILE OBJECT ALLOCATED SPACE DOES NOT MATCH&
             & THE DIMENSIONS OF THE FILE DATA IN SERIAL CASE",& 
             & "varname: "//trim(var%VARNAME),&
             & "DIM3 does not match!")
        
        IF (ubound(var%FDA_FLT,4) .LT. rdims(4)) CALL fatal_error &
             & ("NC_READ_VAR: FILE OBJECT ALLOCATED SPACE DOES NOT MATCH&
             & THE DIMENSIONS OF THE FILE DATA IN SERIAL CASE",& 
             & "varname: "//trim(var%VARNAME),&
             & "DIM4 does not match!")
        
        gfda_flt => var%FDA_FLT(1:rdims(1),1:rdims(2),1:rdims(3),1:rdims(4))
        
        
        status = nf90_get_var(var%NCID,var%VARID,gfda_flt,nstart,ncount,nstride)
        CALL handle_ncerr(status,trim(errmsg))

        
     ELSE ! PAR CASE 
        
        CALL fatal_error("NC_READ_VAR: TRIED TO ENTER PARALLEL OPTION IN SERIAL CODING!")
     END IF

     nullify(gfda_flt)
     nullify(lfda_flt)

!********************************************************************
! =====   SCALAR DOUBLE DATA
!********************************************************************
  CASE(case_scl_dbl)
     
     IF(.NOT. ASSOCIATED(var%SCL_DBL))THEN 

        IF(ASSOCIATED(var%VEC_DBL))THEN
           IF(size(var%VEC_DBL)==1) var%SCL_DBL=>var%VEC_DBL(1)
        ELSE IF(ASSOCIATED(var%ARR_DBL))THEN
           IF(size(var%ARR_DBL)==1) var%SCL_DBL=>var%ARR_DBL(1,1)
        ELSE IF(ASSOCIATED(var%CUB_DBL))THEN
           IF(size(var%CUB_DBL)==1) var%SCL_DBL=>var%CUB_DBL(1,1,1)
        ELSE        
           
           CALL print_var(var)
           CALL fatal_error("NC_READ_VAR: Variable objects SCL_DBL data is NOT assocaited!")
        END IF

     END IF
  
     IF (ser_read .OR. dealer .EQ. myid) THEN
        
        
        IF (SIZE(nstart).GT.0) THEN

            if (product(ncount) .NE. 1) CALL fatal_error&
                & ("NC_READ_VAR: NCOUNT dimension size invalid while reading scl_dbl?")

           allocate(gvec_dbl(1))
           !gvec_flt = VAR%SCL_FLT ! Was this here for a reason?
           status = nf90_get_var(var%NCID,var%VARID,gvec_dbl,nstart,ncount,nstride)
           CALL handle_ncerr(status,trim(errmsg))
           
           var%SCL_DBL = gvec_dbl(1)
           deallocate(gvec_dbl)
           
        ELSE
           
           status = nf90_get_var(var%NCID,var%VARID,var%SCL_DBL)
           CALL handle_ncerr(status,trim(errmsg))
           
        END IF
     END IF
     
     IF (par_read) THEN
        CALL fatal_error("NC_READ_VAR: TRIED TO ENTER PARALLEL OPTION IN SERIAL CODING!")
        
     END IF     

     nullify(gvec_dbl)

!********************************************************************
! =====   VECTOR DOUBLE DATA
!********************************************************************
  CASE(case_vec_dbl)

    IF(.NOT. ASSOCIATED(var%VEC_DBL))THEN 

        IF(ASSOCIATED(var%ARR_DBL))THEN
           IF(size(var%ARR_DBL,1)==1) var%VEC_DBL=>var%ARR_DBL(1,1:)
           IF(size(var%ARR_DBL,2)==1) var%VEC_DBL=>var%ARR_DBL(1:,1)
        ELSE IF(ASSOCIATED(var%CUB_DBL))THEN
           IF(size(var%CUB_DBL,1)==1) THEN
              IF(size(var%CUB_DBL,2)==1) var%VEC_DBL=>var%CUB_DBL(1,1,1:)
              IF(size(var%CUB_DBL,3)==1) var%VEC_DBL=>var%CUB_DBL(1,1:,1)
           END IF
           IF(size(var%CUB_DBL,1)==2) THEN
              IF(size(var%CUB_DBL,3)==1) var%VEC_DBL=>var%CUB_DBL(1:,1,1)
           END IF           
        ELSE        
           
           CALL print_var(var)
           CALL fatal_error("NC_READ_VAR: Variable objects VEC_DBL data is NOT assocaited!")
        END IF
     END IF

     IF (ser_read) THEN
        
        IF (ubound(var%VEC_DBL,1) .NE. rdims(1)) CALL fatal_error &
             & ("NC_READ_VAR: FILE OBJECT ALLOCATED SPACE DOES NOT MATCH&
             & THE DIMENSIONS OF THE FILE DATA IN SERIAL CASE",& 
             & "varname: "//trim(var%VARNAME))
        
        gvec_dbl => var%VEC_DBL(1:rdims(1))
          
        status = nf90_get_var(var%NCID,var%VARID,gvec_dbl,nstart,ncount,nstride)
        CALL handle_ncerr(status,trim(errmsg))
          
     ELSE ! PAR CASE 
        
        CALL fatal_error("NC_READ_VAR: TRIED TO ENTER PARALLEL OPTION IN SERIAL CODING!")
     END IF

     nullify(gvec_dbl)
     nullify(lvec_dbl)


!********************************************************************
! =====   ARRAY DOUBLE DATA
!********************************************************************
  CASE(case_arr_dbl)

    IF(.NOT. ASSOCIATED(var%ARR_DBL))THEN 

        IF(ASSOCIATED(var%CUB_DBL))THEN
           IF(size(var%CUB_DBL,1)==1) var%ARR_DBL=>var%CUB_DBL(1,1:,1:)
           IF(size(var%CUB_DBL,2)==1) var%ARR_DBL=>var%CUB_DBL(1:,1,1:)
           IF(size(var%CUB_DBL,3)==1) var%ARR_DBL=>var%CUB_DBL(1:,1:,1)
        ELSE        

           CALL print_var(var)
           CALL fatal_error("NC_READ_VAR: Variable objects ARR_DBL data is NOT assocaited!")
        END IF
     END IF
     
     IF (ser_read) THEN
        
        IF (ubound(var%ARR_DBL,1) .NE. rdims(1)) CALL fatal_error &
             & ("NC_READ_VAR: FILE OBJECT ALLOCATED SPACE DOES NOT MATCH&
             & THE DIMENSIONS OF THE FILE DATA IN SERIAL CASE",& 
             & "varname: "//trim(var%VARNAME),&
             & "DIM1 does not match!")

        IF (ubound(var%ARR_DBL,2) .LT. rdims(2)) CALL fatal_error &
             & ("NC_READ_VAR: FILE OBJECT ALLOCATED SPACE DOES NOT MATCH&
             & THE DIMENSIONS OF THE FILE DATA IN SERIAL CASE",& 
             & "varname: "//trim(var%VARNAME),&
             & "DIM2 does not match!")

        garr_dbl => var%ARR_DBL(1:rdims(1),1:rdims(2))
        
        status = nf90_get_var(var%NCID,var%VARID,garr_dbl,nstart,ncount,nstride)
        CALL handle_ncerr(status,trim(errmsg))
                
     ELSE ! PAR CASE 
        
        CALL fatal_error("NC_READ_VAR: TRIED TO ENTER PARALLEL OPTION IN SERIAL CODING!")
     END IF

  NULLIFY(garr_dbl)
  NULLIFY(larr_dbl)


!********************************************************************
! =====   CUBE DOUBLE DATA
!********************************************************************
  CASE(case_cub_dbl)

    IF(.NOT. ASSOCIATED(var%CUB_DBL))THEN 
        CALL print_var(var)
        CALL fatal_error("NC_READ_VAR: Variable objects CUB_DBL data is NOT assocaited!")
     END IF
     
     IF (ser_read) THEN
        
        IF (ubound(var%CUB_DBL,1) .NE.  rdims(1)) CALL fatal_error &
             & ("NC_READ_VAR: FILE OBJECT ALLOCATED SPACE DOES NOT MATCH&
             & THE DIMENSIONS OF THE FILE DATA IN SERIAL CASE",& 
             & "varname: "//trim(var%VARNAME),&
             & "DIM1 does not match!")
        
        IF (ubound(var%CUB_DBL,2) .LT. rdims(2)) CALL fatal_error &
             & ("NC_READ_VAR: FILE OBJECT ALLOCATED SPACE DOES NOT MATCH&
             & THE DIMENSIONS OF THE FILE DATA IN SERIAL CASE",& 
             & "varname: "//trim(var%VARNAME),&
             & "DIM2 does not match!")

        IF (ubound(var%CUB_DBL,3) .LT. rdims(3)) CALL fatal_error &
             & ("NC_READ_VAR: FILE OBJECT ALLOCATED SPACE DOES NOT MATCH&
             & THE DIMENSIONS OF THE FILE DATA IN SERIAL CASE",& 
             & "varname: "//trim(var%VARNAME),&
             & "DIM3 does not match!")
   
        gcub_dbl => var%CUB_DBL(1:rdims(1),1:rdims(2),1:rdims(3))
        
        status = nf90_get_var(var%NCID,var%VARID,gcub_dbl,nstart,ncount,nstride)
        CALL handle_ncerr(status,trim(errmsg))
                
     ELSE ! PAR CASE 
        
        CALL fatal_error("NC_READ_VAR: TRIED TO ENTER PARALLEL OPTION IN SERIAL CODING!")
     END IF

     nullify(gcub_dbl)
     nullify(lcub_dbl)

!********************************************************************
! =====   FOUR DIMENSION ARRAY DOUBLE DATA
!********************************************************************
  CASE(case_fda_dbl)

    IF(.NOT. ASSOCIATED(var%FDA_DBL))THEN 
        CALL print_var(var)
        CALL fatal_error("NC_READ_VAR: Variable objects FDA_DBL data is NOT assocaited!")
     END IF
     
     IF (ser_read) THEN
        
        IF (ubound(var%FDA_DBL,1) .NE.  rdims(1)) CALL fatal_error &
             & ("NC_READ_VAR: FILE OBJECT ALLOCATED SPACE DOES NOT MATCH&
             & THE DIMENSIONS OF THE FILE DATA IN SERIAL CASE",& 
             & "varname: "//trim(var%VARNAME),&
             & "DIM1 does not match!")
        
        IF (ubound(var%FDA_DBL,2) .LT. rdims(2)) CALL fatal_error &
             & ("NC_READ_VAR: FILE OBJECT ALLOCATED SPACE DOES NOT MATCH&
             & THE DIMENSIONS OF THE FILE DATA IN SERIAL CASE",& 
             & "varname: "//trim(var%VARNAME),&
             & "DIM2 does not match!")

        IF (ubound(var%FDA_DBL,3) .LT. rdims(3)) CALL fatal_error &
             & ("NC_READ_VAR: FILE OBJECT ALLOCATED SPACE DOES NOT MATCH&
             & THE DIMENSIONS OF THE FILE DATA IN SERIAL CASE",& 
             & "varname: "//trim(var%VARNAME),&
             & "DIM3 does not match!")
   
        IF (ubound(var%FDA_DBL,4) .LT. rdims(4)) CALL fatal_error &
             & ("NC_READ_VAR: FILE OBJECT ALLOCATED SPACE DOES NOT MATCH&
             & THE DIMENSIONS OF THE FILE DATA IN SERIAL CASE",& 
             & "varname: "//trim(var%VARNAME),&
             & "DIM4 does not match!")
   
        gfda_dbl => var%FDA_DBL(1:rdims(1),1:rdims(2),1:rdims(3),1:rdims(4))
        
        status = nf90_get_var(var%NCID,var%VARID,gfda_dbl,nstart,ncount,nstride)
        CALL handle_ncerr(status,trim(errmsg))
                
     ELSE ! PAR CASE 
        
        CALL fatal_error("NC_READ_VAR: TRIED TO ENTER PARALLEL OPTION IN SERIAL CODING!")
     END IF

     nullify(gfda_dbl)
     nullify(lfda_dbl)

!********************************************************************
! =====   SCALAR INTEGER DATA
!********************************************************************
  CASE(case_scl_int)
     
     IF(.NOT. ASSOCIATED(var%SCL_INT))THEN 

        IF(ASSOCIATED(var%VEC_INT))THEN
           IF(size(var%VEC_INT)==1) var%SCL_INT=>var%VEC_INT(1)
        ELSE IF(ASSOCIATED(var%ARR_INT))THEN
           IF(size(var%ARR_INT)==1) var%SCL_INT=>var%ARR_INT(1,1)
        ELSE IF(ASSOCIATED(var%CUB_INT))THEN
           IF(size(var%CUB_INT)==1) var%SCL_INT=>var%CUB_INT(1,1,1)
        ELSE        
           
           CALL print_var(var)
           CALL fatal_error("NC_READ_VAR: Variable objects SCL_INT data is NOT assocaited!")
        END IF
     END IF
     
     IF (ser_read .OR. dealer .EQ. myid) THEN
        
        
        IF (SIZE(nstart).GT.0) THEN
           
           if (product(ncount) .NE. 1) CALL fatal_error&
                & ("NC_READ_VAR: NCOUNT dimension invalid while reading scl_int?")
 
           allocate(gvec_int(1))
           gvec_int = var%SCL_INT
           status = nf90_get_var(var%NCID,var%VARID,gvec_int,nstart,ncount,nstride)
           CALL handle_ncerr(status,trim(errmsg))

           var%SCL_INT = gvec_int(1)
           deallocate(gvec_int)
           
        ELSE
           status = nf90_get_var(var%NCID,var%VARID,var%SCL_INT)
           CALL handle_ncerr(status,trim(errmsg))
           
        END IF
     END IF
     
     IF (par_read) THEN
        CALL fatal_error("NC_READ_VAR: TRIED TO ENTER PARALLEL OPTION IN SERIAL CODING!")
        
     END IF    
     nullify(gvec_int)
 
!********************************************************************
! =====   VECTOR INTEGER DATA
!********************************************************************
  CASE(case_vec_int)

    IF(.NOT. ASSOCIATED(var%VEC_INT))THEN 

        IF(ASSOCIATED(var%ARR_INT))THEN
           IF(size(var%ARR_INT,1)==1) var%VEC_INT=>var%ARR_INT(1,1:)
           IF(size(var%ARR_INT,2)==1) var%VEC_INT=>var%ARR_INT(1:,1)
        ELSE IF(ASSOCIATED(var%CUB_INT))THEN
           IF(size(var%CUB_INT,1)==1) THEN
              IF(size(var%CUB_INT,2)==1) var%VEC_INT=>var%CUB_INT(1,1,1:)
              IF(size(var%CUB_INT,3)==1) var%VEC_INT=>var%CUB_INT(1,1:,1)
           END IF
           IF(size(var%CUB_INT,1)==2) THEN
              IF(size(var%CUB_INT,3)==1) var%VEC_INT=>var%CUB_INT(1:,1,1)
           END IF           
        ELSE        
           
           CALL print_var(var)
           CALL fatal_error("NC_READ_VAR: Variable objects VEC_INT data is NOT assocaited!")
        END IF
     END IF

     IF (ser_read) THEN

        IF (ubound(var%VEC_INT,1) .NE. rdims(1)) CALL fatal_error &
             & ("NC_READ_VAR: FILE OBJECT ALLOCATED SPACE DOES NOT MATCH&
             & THE DIMENSIONS OF THE FILE DATA IN SERIAL CASE",& 
             & "varname: "//trim(var%VARNAME))
        
        gvec_int => var%VEC_INT(1:rdims(1))
        
        status = nf90_get_var(var%NCID,var%VARID,gvec_int,nstart,ncount,nstride)
        CALL handle_ncerr(status,trim(errmsg))
        
     ELSE ! PAR CASE 
        
        CALL fatal_error("NC_READ_VAR: TRIED TO ENTER PARALLEL OPTION IN SERIAL CODING!")
     END IF

     nullify(lvec_int)
     nullify(gvec_int)
!********************************************************************
! =====   ARRAY INTEGER DATA
!********************************************************************
  CASE(case_arr_int)

    IF(.NOT. ASSOCIATED(var%ARR_INT))THEN 

        IF(ASSOCIATED(var%CUB_INT))THEN
           IF(size(var%CUB_INT,1)==1) var%ARR_INT=>var%CUB_INT(1,1:,1:)
           IF(size(var%CUB_INT,2)==1) var%ARR_INT=>var%CUB_INT(1:,1,1:)
           IF(size(var%CUB_INT,3)==1) var%ARR_INT=>var%CUB_INT(1:,1:,1)
        ELSE        
           
           CALL print_var(var)
           CALL fatal_error("NC_READ_VAR: Variable objects ARR_INT data is NOT assocaited!")
        END IF
     END IF

     IF (ser_read) THEN
        
        IF (ubound(var%ARR_INT,1) .NE. rdims(1)) CALL fatal_error &
             & ("NC_READ_VAR: FILE OBJECT ALLOCATED SPACE DOES NOT MATCH&
             & THE DIMENSIONS OF THE FILE DATA IN SERIAL CASE",& 
             & "varname: "//trim(var%VARNAME),&
             & "DIM1 does not match!")
        
        IF (ubound(var%ARR_INT,2) .LT. rdims(2)) CALL fatal_error &
             & ("NC_READ_VAR: FILE OBJECT ALLOCATED SPACE DOES NOT MATCH&
             & THE DIMENSIONS OF THE FILE DATA IN SERIAL CASE",& 
             & "varname: "//trim(var%VARNAME),&
             & "DIM2 does not match!")

        garr_int => var%ARR_INT(1:rdims(1),1:rdims(2))
        
        status = nf90_get_var(var%NCID,var%VARID,garr_int,nstart,ncount,nstride)
        CALL handle_ncerr(status,trim(errmsg))
        
     ELSE ! PAR CASE 
        
        CALL fatal_error("NC_READ_VAR: TRIED TO ENTER PARALLEL OPTION IN SERIAL CODING!")
     END IF

     nullify(larr_int)
     nullify(garr_int)

!********************************************************************
! =====   CUBE INTEGER DATA
!********************************************************************
  CASE(case_cub_int)

    IF(.NOT. ASSOCIATED(var%CUB_INT))THEN 
        CALL print_var(var)
        CALL fatal_error("NC_READ_VAR: Variable objects CUB_INT data is NOT assocaited!")
     END IF
     
     IF (ser_read) THEN
        
        IF (ubound(var%CUB_INT,1) .NE. rdims(1)) CALL fatal_error &
             & ("NC_READ_VAR: FILE OBJECT ALLOCATED SPACE DOES NOT MATCH&
             & THE DIMENSIONS OF THE FILE DATA IN SERIAL CASE",& 
             & "varname: "//trim(var%VARNAME),&
             & "DIM1 does not match!")
        
        IF (ubound(var%CUB_INT,2) .LT. rdims(2)) CALL fatal_error &
             & ("NC_READ_VAR: FILE OBJECT ALLOCATED SPACE DOES NOT MATCH&
             & THE DIMENSIONS OF THE FILE DATA IN SERIAL CASE",& 
             & "varname: "//trim(var%VARNAME),&
             & "DIM2 does not match!")

        IF (ubound(var%CUB_INT,3) .LT. rdims(3)) CALL fatal_error &
             & ("NC_READ_VAR: FILE OBJECT ALLOCATED SPACE DOES NOT MATCH&
             & THE DIMENSIONS OF THE FILE DATA IN SERIAL CASE",& 
             & "varname: "//trim(var%VARNAME),&
             & "DIM3 does not match!")

        gcub_int => var%CUB_INT(1:rdims(1),1:rdims(2),1:rdims(3))
        
        status = nf90_get_var(var%NCID,var%VARID,gcub_int,nstart,ncount,nstride)
        CALL handle_ncerr(status,trim(errmsg))
        
     ELSE ! PAR CASE 
        
        CALL fatal_error("NC_READ_VAR: TRIED TO ENTER PARALLEL OPTION IN SERIAL CODING!")
     END IF

     nullify(lcub_int)
     nullify(gcub_int)

!********************************************************************
! =====   FOUR DIMENSION ARRAY INTEGER DATA
!********************************************************************
  CASE(case_fda_int)

    IF(.NOT. ASSOCIATED(var%FDA_INT))THEN 
        CALL print_var(var)
        CALL fatal_error("NC_READ_VAR: Variable objects FDA_INT data is NOT assocaited!")
     END IF
     
     IF (ser_read) THEN
        
        IF (ubound(var%FDA_INT,1) .NE. rdims(1)) CALL fatal_error &
             & ("NC_READ_VAR: FILE OBJECT ALLOCATED SPACE DOES NOT MATCH&
             & THE DIMENSIONS OF THE FILE DATA IN SERIAL CASE",& 
             & "varname: "//trim(var%VARNAME),&
             & "DIM1 does not match!")
        
        IF (ubound(var%FDA_INT,2) .LT. rdims(2)) CALL fatal_error &
             & ("NC_READ_VAR: FILE OBJECT ALLOCATED SPACE DOES NOT MATCH&
             & THE DIMENSIONS OF THE FILE DATA IN SERIAL CASE",& 
             & "varname: "//trim(var%VARNAME),&
             & "DIM2 does not match!")

        IF (ubound(var%FDA_INT,3) .LT. rdims(3)) CALL fatal_error &
             & ("NC_READ_VAR: FILE OBJECT ALLOCATED SPACE DOES NOT MATCH&
             & THE DIMENSIONS OF THE FILE DATA IN SERIAL CASE",& 
             & "varname: "//trim(var%VARNAME),&
             & "DIM3 does not match!")

        IF (ubound(var%FDA_INT,4) .LT. rdims(4)) CALL fatal_error &
             & ("NC_READ_VAR: FILE OBJECT ALLOCATED SPACE DOES NOT MATCH&
             & THE DIMENSIONS OF THE FILE DATA IN SERIAL CASE",& 
             & "varname: "//trim(var%VARNAME),&
             & "DIM4 does not match!")

        gfda_int => var%FDA_INT(1:rdims(1),1:rdims(2),1:rdims(3),1:rdims(4))
        
        status = nf90_get_var(var%NCID,var%VARID,gfda_int,nstart,ncount,nstride)
        CALL handle_ncerr(status,trim(errmsg))
        
     ELSE ! PAR CASE 
        
        CALL fatal_error("NC_READ_VAR: TRIED TO ENTER PARALLEL OPTION IN SERIAL CODING!")
     END IF

     nullify(lfda_int)
     nullify(gfda_int)

!********************************************************************
! =====   SCALAR STRING DATA
!********************************************************************
  CASE(case_scl_chr)

    IF(.NOT. ASSOCIATED(var%scl_chr))THEN 

       IF (ASSOCIATED(var%vec_chr))THEN 
          IF(SIZE(var%vec_chr)==1) var%scl_chr => var%vec_chr(1)
       ELSE
          CALL print_var(var)
          CALL fatal_error("NC_READ_VAR: Variable objects scl_chr&
               & data is NOT assocaited!")
       END IF

     END IF
     

     IF (ser_read .OR. dealer .EQ. myid) THEN
        
        IF (len(var%SCL_CHR) .LT. rdims(1)) CALL fatal_error &
             & ("NC_READ_VAR: FILE OBJECT ALLOCATED SPACE DOES NOT MATCH&
             & THE DIMENSIONS OF THE FILE CHARACTER DATA",& 
             & "varname: "//trim(var%VARNAME))

        var%scl_chr = achar(0) ! INITIALIZE with null char
!        scl_chr => var%scl_chr(1:RDIMS(1))
        scl_chr => var%scl_chr

! NOTE: TO PRINT POINTER CHARACTER YOU MUST USE TRIM(chr) OR chr(:) !         
!        scl_chr = "testing"
!        write(ipt,*) "a test: '"//scl_chr(:)//"'"

        status = nf90_get_var(var%NCID,var%VARID,scl_chr,nstart,ncount,nstride)
        CALL handle_ncerr(status,trim(errmsg))

        nlen = index(scl_chr,achar(0))
        ! If no null byte is found use the whole string
        if (nlen == 0) then
           nlen = rdims(1) 
        else
           nlen = nlen -1
           scl_chr = scl_chr(1:nlen)
        end if

     END IF
        
     IF(par_read) THEN
        CALL fatal_error("NC_READ_VAR: TRIED TO ENTER PARALLEL OPTION IN SERIAL CODING!")
     END IF
     nullify(scl_chr)

!********************************************************************
! =====   VECTOR STRING DATA
!********************************************************************
  CASE(case_vec_chr)

    IF(.NOT. ASSOCIATED(var%vec_chr))THEN 
        CALL print_var(var)
        CALL fatal_error("NC_READ_VAR: Variable objects vec_chr&
             & data is NOT assocaited!")
     END IF

     IF (ser_read .OR. dealer .EQ. myid) THEN
        
        IF (SIZE(var%VEC_CHR) .NE. rdims(2)) CALL fatal_error &
             & ("NC_READ_VAR: FILE OBJECT ALLOCATED Character array DOES NOT MATCH&
             & THE DIMENSIONS OF THE FILE CHARACTER DATA",& 
             & "varname: "//trim(var%VARNAME))

        IF (len(var%VEC_CHR(1)) .LT. rdims(1)) CALL fatal_error &
             & ("NC_READ_VAR: FILE OBJECT ALLOCATED SPACE DOES NOT MATCH&
             & THE DIMENSIONS OF THE FILE CHARACTER DATA",& 
             & "varname: "//trim(var%VARNAME))
        
        cnt=SIZE(ncount)
        allocate(nstrt(cnt),ncnt(cnt),nstrd(cnt))
        nstrt=nstart
        ncnt=ncount
        nstrd=nstride

        Do i = 1,rdims(2)
           
           
           var%vec_chr(i) = achar(0) ! INITIALIZE with null char
           scl_chr => var%vec_chr(i)
         
           ! READ THE I'th Entry (one entry)
           nstrt(2)=i
           ncnt(2)=1
           
           status = nf90_get_var(var%NCID,var%VARID,scl_chr,nstrt,ncnt,nstrd)
           CALL handle_ncerr(status,trim(errmsg))

           nlen = index(scl_chr,achar(0))
           ! If no null byte is found use the whole string
           if (nlen == 0) then
              nlen = rdims(1) 
           else
              nlen = nlen -1
              scl_chr = scl_chr(1:nlen)
           end if
           
           nullify(scl_chr)
           
        END DO
        deallocate(nstrt,ncnt,nstrd)

     END IF
        
     IF(par) THEN
        CALL fatal_error("NC_READ_VAR: TRIED TO ENTER PARALLEL OPTION IN SERIAL CODING!")
     END IF
     
     nullify(scl_chr)
     
  CASE default
     call print_var(var)
     call fatal_error("NC_WRITE_VAR: UNKNOWN CASE")
     
  END SELECT


  !Only deallocate if it is not pointing to Ncount
  IF(.not.ASSOCIATED(rdims,ncount)) THEN
     IF(ASSOCIATED(rdims)) DEALLOCATE(rdims)
  ELSE
     NULLIFY(rdims)
  END IF


  IF(PRESENT(iostart)) THEN
     nullify(nstart)
  ELSE
     deallocate(nstart)
  END IF

  IF(PRESENT(iocount)) THEN
     nullify(ncount)
  ELSE
     deallocate(ncount)
  END IF

  IF(PRESENT(iostride)) THEN
     nullify(nstride)
  ELSE
     deallocate(nstride)
  END IF


  IF(dbg_set(dbg_sbr)) WRITE(ipt,*) "END NC_READ_VAR:"


END SUBROUTINE nc_read_var
!====================================================================
!====================================================================
FUNCTION is_valid_datetime(VAR,tzone) RESULT(RES)
  IMPLICIT NONE
  TYPE(ncatt), POINTER :: att
  TYPE(ncvar), POINTER :: var
  TYPE(ncdim), POINTER :: dim
  logical :: found, res
  character(len=80), intent(out) :: tzone
  
  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("IS_VALID_DATETIME: Variable object argument is not assocai&
       &ted!")


  res = .false.

  IF (var%XTYPE /= nf90_char) RETURN

  att => find_att(var,'description',found)
  IF (found) THEN
     IF (att%CHR(1) == "GMT time")THEN
        res =.true.
        tzone="UTC"
        RETURN
     END IF
  END IF
  
  att => find_att(var,'time_zone',found)
  IF (found) THEN
     IF (.not. is_valid_timezone(att%chr(1))) return
     tzone=att%chr(1)
     res=.true.
  END IF
  

  RETURN
 
END FUNCTION is_valid_datetime
!====================================================================
!====================================================================
 FUNCTION datetime_object(DIMSTR,DIMTIME,timezone,size) RESULT(VAR)
    IMPLICIT NONE
    TYPE(ncvar),  POINTER :: var
    TYPE(ncdim),  POINTER:: dimstr
    TYPE(ncdim),  POINTER, OPTIONAL :: dimtime
    INTEGER, OPTIONAL :: size
    TYPE(ncatt), POINTER :: att
    CHARACTER(LEN=80),pointer :: data_vec(:)
    CHARACTER(LEN=80),pointer :: data_scl
    CHARACTER(LEN=*), optional :: timezone

    IF(PRESENT(size)) THEN
       ALLOCATE(data_vec(size))
    ELSE
       ALLOCATE(data_vec(1))
       data_scl =>data_vec(1)
    END IF

    IF (PRESENT(dimtime)) THEN
       var  => nc_make_pvar(name='Times', values=data_vec, dim1= dimstr, dim2= dimtime)
       var%SCL_CHR => var%VEC_CHR(1)
    ELSE
       var  => nc_make_pvar(name='Times', values=data_scl, dim1= dimstr)
    END IF

    IF (PRESENT(timezone))THEN
       att  => nc_make_att(name='time_zone',values=trim(timezone)) 
       var  => add(var,att)
    ELSE
       att  => nc_make_att(name='time_zone',values='UTC') 
       var  => add(var,att)
    END IF

    
  END FUNCTION datetime_object
!====================================================================
!====================================================================
  SUBROUTINE update_datetime(VAR,NOW)
    IMPLICIT NONE
    TYPE(ncvar),  POINTER :: VAR
    TYPE(ncatt), POINTER :: ATT
    TYPE(time), INTENT(in) :: NOW
    CHARACTER(len=80), POINTER :: Data
    LOGICAL :: TEST
    CHARACTER(len=80):: TZONE
    CHARACTER(len=80):: TEMP
    

    test = is_valid_datetime(var,tzone)
    IF(.not. test) THEN
       CALL print_var(var)
       CALL fatal_error &
            ("CAN NOT UPDATE TIME FOR INVALID DATE TIME VARIABLE")
    END IF

    CALL nc_point_var(var,data)

     temp = write_datetime(now,timeprec,tzone)
     Data = trim(temp)

  END SUBROUTINE update_datetime
!====================================================================
!====================================================================
FUNCTION is_valid_itime(VAR1,VAR2,tzone) RESULT(RES)
  IMPLICIT NONE
  character(len=80), intent(out) :: tzone
  TYPE(ncatt), POINTER :: att
  TYPE(ncvar), POINTER :: var1,var2
  TYPE(ncdim), POINTER :: dim
  logical :: found, res

  IF(.NOT. ASSOCIATED(var1)) CALL fatal_error &
       & ("IS_VALID_INT2_MJD: Variable object argument is not assocaited!")

  IF(.NOT. ASSOCIATED(var2)) CALL fatal_error &
       & ("IS_VALID_INT2_MJD: Variable object argument is not assocaited!")

  res = .false.

  IF (var1%XTYPE /= nf90_int) RETURN
  IF (var2%XTYPE /= nf90_int) RETURN

!!$  ! CHECK ATTS FOR THE DAYS VARIABLE  
!!$  DIM => FIND_DIM(VAR1,'time',FOUND)
!!$  IF (.not. FOUND) CALL WARNING &
!!$       & ("IS_VALID_INT2_MJD: VARIABLE PASSED DOES NOT HAVE DIMENSION&
!!$       & 'time'", "VARNAME: "//TRIM(VAR1%VARNAME))
!!$
!!$  IF (.NOT. DIM%UNLIMITED) CALL WARNING &
!!$       & ("IS_VALID_INT2_MJD: VARIABLE PASSED HAS DIMENSION&
!!$       & 'time' BUT IT IS NOT AN 'UNLIMITED' DIMENSION", "VARNAME: "//TRIM(VAR1%VARNAME))


  att => find_att(var1,'units',found)
  IF(.not. found) return

  IF(mjd_units .eq. att%chr(1)(1:len_trim(mjd_units)) .or.     &
     'days since '//trim(date_reference) .eq. att%chr(1)(1:len_trim(mjd_units))) THEN
!JQI  IF(mjd_units .eq. ATT%chr(1)(1:len_trim(mjd_units))) THEN
     
     att => find_att(var1,'format',found)
     IF(.not. found) return
     
     IF (att%chr(1)(1:len_trim(fmat)) .NE. fmat .and.       &
         att%chr(1)(1:len_trim(rfmat)) .NE. rfmat) return
!JQI     IF (ATT%chr(1)(1:len_trim(fmat)) .NE. fmat ) return
     
     att => find_att(var1,'time_zone',found)
     IF(.not. found) return
     tzone=att%chr(1)
     
  ELSE IF(days_units .eq. att%chr(1)(1:len_trim(days_units))) THEN

     att => find_att(var1,'time_zone',found)
     IF(.not. found) return
     tzone = trim(att%chr(1))
     IF (tzone /= 'none') return
  ELSE
     RETURN

  END IF
     


  
!!$  ! CHECK ATTS FOR THE Mili Seconds VARIABLE  
!!$  DIM => FIND_DIM(VAR2,'time',FOUND)
!!$  IF (.not. FOUND) CALL WARNING &
!!$       & ("IS_VALID_INT2_MJD: VARIABLE PASSED DOES NOT HAVE DIMENSION&
!!$       & 'time'", "VARNAME: "//TRIM(VAR2%VARNAME))
!!$
!!$  IF (.NOT. DIM%UNLIMITED) CALL WARNING &
!!$       & ("IS_VALID_INT2_MJD: VARIABLE PASSED HAS DIMENSION&
!!$       & 'time' BUT IT IS NOT AN 'UNLIMITED' DIMENSION", "VARNAME: "//TRIM(VAR2%VARNAME))

  att => find_att(var2,'units',found)
  IF(.not. found) return
  
  IF(att%chr(1)(1:len_trim(msec_units)) .NE. msec_units) RETURN


  att => find_att(var2,'time_zone',found)
  IF(.not. found) return


  ! TIME ZONE MUST BE THE SAME FOR BOTH ITEME'S
  IF (trim(att%chr(1)) /= trim(tzone)) RETURN


  res = .true.
  return
  

END FUNCTION is_valid_itime
!====================================================================
!====================================================================
 FUNCTION itime_object(use_mjd,DIM,size) RESULT(VAR)
    IMPLICIT NONE
    TYPE(ncvar),  POINTER :: var
    logical, intent(in) :: use_mjd
    TYPE(ncdim),  POINTER, OPTIONAL :: dim
    INTEGER, OPTIONAL :: size
    TYPE(ncatt), POINTER :: att
    INTEGER,POINTER :: data_vec(:)
    INTEGER,POINTER :: data_scl

    IF(PRESENT(size)) THEN
       ALLOCATE(data_vec(size))
    ELSE
       ALLOCATE(data_vec(1))
       data_scl =>data_vec(1)
    END IF
    
        ! Itime
    IF (PRESENT(dim)) THEN
        var  => nc_make_pvar(name='Itime', values=data_vec, dim1= dim)
        var%SCL_INT => var%VEC_INT(1)
    ELSE
       var  => nc_make_pvar(name='Itime', values=data_scl)
    END IF

    IF (use_mjd) THEN
      IF(date_reference == 'default')THEN

       att  => nc_make_att(name='units',values=mjd_units)
       var  => add(var,att)

       att  => nc_make_att(name='format',values=fmat)
       var  => add(var,att)

      ELSE

       att  => nc_make_att(name='units',values='days since '//trim(date_reference))
       var  => add(var,att)
       
       att  => nc_make_att(name='format',values=rfmat)
       var  => add(var,att)

      END IF
       
       att  => nc_make_att(name='time_zone',values='UTC') 
       var  => add(var,att)
    ELSE
       att  => nc_make_att(name='units',values=days_units)
       var  => add(var,att)
              
       att  => nc_make_att(name='time_zone',values='none') 
       var  => add(var,att)
    END IF

  END FUNCTION itime_object
!====================================================================
!====================================================================
 FUNCTION itime2_object(use_mjd,DIM,size) RESULT(VAR)
    IMPLICIT NONE
    TYPE(ncvar),  POINTER :: var
    logical, intent(in) :: use_mjd
    TYPE(ncdim),  POINTER, OPTIONAL :: dim
    INTEGER, OPTIONAL :: size
    TYPE(ncatt), POINTER :: att
    INTEGER,POINTER :: data_vec(:)
    INTEGER,POINTER :: data_scl

    IF(PRESENT(size)) THEN
       ALLOCATE(data_vec(size))
    ELSE
       ALLOCATE(data_vec(1))
       data_scl =>data_vec(1)
    END IF

    IF (PRESENT(dim)) THEN
       
       var  => nc_make_pvar(name='Itime2', values=data_vec, dim1= dim)
       var%SCL_INT => var%VEC_INT(1)
    ELSE
       var  => nc_make_pvar(name='Itime2', values=data_scl)
    END IF

    IF (use_mjd) THEN
       att  => nc_make_att(name='units',values=msec_units) 
       var  => add(var,att)
       
       att  => nc_make_att(name='time_zone',values='UTC') 
       var  => add(var,att)
    ELSE
       att  => nc_make_att(name='units',values=msec_units) 
       var  => add(var,att)
       
       att  => nc_make_att(name='time_zone',values='none') 
       var  => add(var,att)
    END IF


  END FUNCTION itime2_object
!====================================================================
!====================================================================
  SUBROUTINE update_itime(VAR1,VAR2,NOW)
    IMPLICIT NONE
    TYPE(ncvar),  POINTER :: VAR1
    TYPE(ncvar),  POINTER :: VAR2
    TYPE(ncatt), POINTER :: ATT
    TYPE(time), INTENT(in) :: NOW
    INTEGER, POINTER :: D1,D2
    LOGICAL :: TEST2
    INTEGER :: TEST
    CHARACTER(len=80):: TZONE

    test2 = is_valid_itime(var1,var2,tzone)
    IF(.not. test2) THEN
       CALL print_var(var1)
       CALL print_var(var2)
       CALL fatal_error &
            ("CAN NOT UPDATE TIME FOR INVALID INTEGER TIME VARIABLES")
    END IF

    CALL nc_point_var(var1,d1)

    CALL nc_point_var(var2,d2)

    test = time2ncitime(now,referencedate,d1,d2)

!    if(.not. TEST) call fatal_error("That is bad times man!") 
    if(test==0) call fatal_error("That is bad times man!")
    ! THIS SHOULD NEVER HAPPEN?
    
  END SUBROUTINE update_itime
!====================================================================
!====================================================================
FUNCTION is_valid_float_days(VAR,tzone) RESULT(RES)
  IMPLICIT NONE
  character(len=80), intent(out) :: tzone
  TYPE(ncatt), POINTER :: att
  TYPE(ncvar), POINTER :: var
  TYPE(ncdim), POINTER :: dim
  logical :: found, res

  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("IS_VALID_FLOAT_MJD: Variable object argument is not assocaited!")
  
  res = .false.

!!$  DIM => FIND_DIM(VAR,'time',FOUND)
!!$  IF (.not. FOUND) CALL WARNING &
!!$       & ("IS_VALID_FLOAT_MJD: VARIABLE PASSED DOES NOT HAVE DIMENSION&
!!$       & 'time'", "VARNAME: "//TRIM(VAR%VARNAME))
!!$
!!$  IF (.NOT. DIM%UNLIMITED) CALL WARNING &
!!$       & ("IS_VALID_FLOAT_MJD: VARIABLE PASSED HAS DIMENSION&
!!$       & 'time' BUT IT IS NOT AN 'UNLIMITED' DIMENSION", "VARNAME: "//TRIM(VAR%VARNAME))


  ! CHECK ATTS FOR THE TIME VARIABLE  
  att => find_att(var,'units',found)
  IF(.not. found) return
  
  IF(mjd_units .eq. att%chr(1)(1:len_trim(mjd_units)) .or.     &
     'days since '//trim(date_reference) .eq. att%chr(1)(1:len_trim(mjd_units))) THEN
!JQI  IF(mjd_units .eq. ATT%chr(1)(1:len_trim(mjd_units)) ) THEN
       
     att => find_att(var,'format',found)
     IF(.not. found) return
     
     IF (att%chr(1)(1:len_trim(fmat)) .NE. fmat .and.      &
         att%chr(1)(1:len_trim(rfmat)) .NE. rfmat) return
!JQI     IF (ATT%chr(1)(1:len_trim(fmat)) .NE. fmat ) return
     
     att => find_att(var,'time_zone',found)
     IF(.not. found) return
     
     IF (.not. is_valid_timezone(att%chr(1))) return
     tzone=trim(att%chr(1))
     
  ELSE IF(days_units .eq. att%chr(1)(1:len_trim(days_units))) THEN
     
     att => find_att(var,'time_zone',found)
     IF(.not. found) return
     tzone = trim(att%chr(1))
     IF (tzone /= 'none') return
     
  ELSE
     return
  END IF

  res = .true.
  return
END FUNCTION is_valid_float_days
!====================================================================
!====================================================================
FUNCTION is_valid_float_seconds(VAR,tzone) RESULT(RES)
  IMPLICIT NONE
  character(len=80), intent(out) :: tzone
  TYPE(ncatt), POINTER :: att
  TYPE(ncvar), POINTER :: var
  TYPE(ncdim), POINTER :: dim
  logical :: found, res

  IF(.NOT. ASSOCIATED(var)) CALL fatal_error &
       & ("IS_VALID_FLOAT_MJD: Variable object argument is not assocaited!")
  
  res = .false.

!!$  DIM => FIND_DIM(VAR,'time',FOUND)
!!$  IF (.not. FOUND) CALL WARNING &
!!$       & ("IS_VALID_FLOAT_MJD: VARIABLE PASSED DOES NOT HAVE DIMENSION&
!!$       & 'time'", "VARNAME: "//TRIM(VAR%VARNAME))
!!$
!!$  IF (.NOT. DIM%UNLIMITED) CALL WARNING &
!!$       & ("IS_VALID_FLOAT_MJD: VARIABLE PASSED HAS DIMENSION&
!!$       & 'time' BUT IT IS NOT AN 'UNLIMITED' DIMENSION", "VARNAME: "//TRIM(VAR%VARNAME))


  ! CHECK ATTS FOR THE TIME VARIABLE  
  att => find_att(var,'units',found)
  IF(.not. found) return
  
  IF(seconds_units .eq. att%chr(1)(1:len_trim(seconds_units))) THEN
       
     att => find_att(var,'time_zone',found)
     IF(.not. found) THEN
        tzone = 'none'
     Else
        tzone = trim(att%chr(1))
     END IF
  ELSE
     return
  END IF

  res = .true.
  return
END FUNCTION is_valid_float_seconds
!====================================================================
!====================================================================
 FUNCTION float_time_object(use_mjd,DIM,size) RESULT(VAR)
    IMPLICIT NONE
    TYPE(ncvar),  POINTER :: var
    logical, intent(in) :: use_mjd
    TYPE(ncdim),  POINTER, OPTIONAL :: dim
    INTEGER, OPTIONAL :: size
    TYPE(ncatt), POINTER :: att
    REAL(sp),pointer :: data_vec(:)
    REAL(sp),pointer :: data_scl

    IF(PRESENT(size)) THEN
       ALLOCATE(data_vec(size))
    ELSE
       ALLOCATE(data_vec(1))
       data_scl =>data_vec(1)
    END IF

    IF (PRESENT(dim)) THEN
       var  => nc_make_pvar(name='time', values=data_vec, dim1= dim)
       if(associated(var%vec_flt))then
         var%scl_flt => var%vec_flt(1)
       else
         var%scl_dbl => var%vec_dbl(1)
       endif
    ELSE
       var  => nc_make_pvar(name='time', values=data_scl)
    END IF
    
    att  => nc_make_att(name='long_name',values='time')
    var  => add(var,att)
    
    IF (use_mjd) THEN
      IF(date_reference == 'default')THEN

       att  => nc_make_att(name='units',values=mjd_units)
       var  => add(var,att)
       
       att  => nc_make_att(name='format',values=fmat)
       var  => add(var,att)

      ELSE

       att  => nc_make_att(name='units',values='days since '//trim(date_reference))
       var  => add(var,att)
       
       att  => nc_make_att(name='format',values=rfmat)
       var  => add(var,att)

      END IF
       
       att  => nc_make_att(name='time_zone',values='UTC') 
       var  => add(var,att)
       
    ELSE
       att  => nc_make_att(name='units',values=days_units)
       var  => add(var,att)       
       
       att  => nc_make_att(name='time_zone',values='none') 
       var  => add(var,att)
    END IF
    

  END FUNCTION float_time_object
!====================================================================
!====================================================================
  SUBROUTINE update_float_time(VAR,NOW)
    IMPLICIT NONE
    TYPE(ncvar),  POINTER :: VAR
    TYPE(time), INTENT(in) :: NOW
    REAL(SP), POINTER :: Data
    LOGICAL :: TEST
    CHARACTER(len=80):: TZONE

    test = is_valid_float_days(var,tzone)
    IF(.not. test) THEN
       CALL print_var(var)
       call print_att_list(var)
       CALL fatal_error &
            ("CAN NOT UPDATE TIME FOR INVALID FLOATING POINT TIME VARIABLE")
    END IF

    CALL nc_point_var(var,data)
    
    Data = days(now) - days(referencedate)

  END SUBROUTINE update_float_time
!====================================================================
!====================================================================
 FUNCTION iint_object(DIM,size) RESULT(VAR)
    IMPLICIT NONE
    TYPE(ncvar),  POINTER :: var
    TYPE(ncdim),  POINTER, OPTIONAL :: dim
    INTEGER, OPTIONAL :: size
    TYPE(ncatt), POINTER :: att
    INTEGER,POINTER :: data_vec(:)
    INTEGER,POINTER :: data_scl

    IF(PRESENT(size)) THEN
       ALLOCATE(data_vec(size))
    ELSE
       ALLOCATE(data_vec(1))
       data_scl =>data_vec(1)
    END IF
    
    ! IINT
    IF (PRESENT(dim)) THEN
        var  => nc_make_pvar(name='iint', values=data_vec, dim1= dim)
        var%SCL_INT => var%VEC_INT(1)
    ELSE
       var  => nc_make_pvar(name='iint', values=data_scl)
    END IF
    
    att  => nc_make_att(name='long_name',values='internal mode iteration number') 
    var  => add(var,att)

  END FUNCTION iint_object
!====================================================================
!====================================================================
 RECURSIVE SUBROUTINE recursive_file_bracket(FTM,NOW,status)
  IMPLICIT NONE
  TYPE(ncftime), POINTER :: ftm
  TYPE(time)   :: now
  INTEGER :: status

  REAL(sp) :: df
  INTEGER ::  frame
  TYPE(time) :: ctime

  IF (dbg_set(dbg_sbrio))THEN
     WRITE(ipt,*) "%%%%%%%%%%%% RECURSIVE_FILE_BRACK INPUT %%%%%%%%%%%%%%" 
     CALL print_ftime(ftm)
     WRITE(ipt,*) "%%%%%%%%%%%%"
     CALL print_real_time(now,ipt,"NOW")
     WRITE(ipt,*) "%%%%%%%%%%%% ========================== %%%%%%%%%%%%%%" 
     
  END IF

  ! DO SOME ERROR CHECKING FOR BAD VALUES
  IF (ftm%NEXT_STKCNT == ftm%PREV_STKCNT) THEN
     
     CALL fatal_error("PREVIOUS STKCNT  IS EQUAL TO NEXT!")

  ELSE IF (ftm%NEXT_STKCNT < ftm%PREV_STKCNT) THEN
     
     CALL fatal_error("PREVIOUS STKCNT IS GREATER THAN NEXT!")
     
  END IF

  IF ( ftm%PREV_IO == ftm%NEXT_IO ) THEN
     
     CALL fatal_error("IT SEEMS YOUR FILE HAS DUPLICATE TIME VALUES!")
  
  ELSEIF ( ftm%PREV_IO > ftm%NEXT_IO ) THEN
     
     CALL fatal_error("IT SEEMS YOUR FILE HAS NONE MONOTONIC TIME!")
     
  END IF
  

  ! DECIDE WHAT TO DO BASED ON THE CURRENT BRACKET!

  ! IF PREV AND NEXT BRACK THE CURRENT VALUE
  IF( ftm%PREV_IO < now .AND. now < ftm%NEXT_IO ) THEN

!     IF (dbg_set(dbg_log)) write(IPT,*) "PREVIOUS AND NEXT BRACKET NOW"

     IF(ftm%NEXT_STKCNT == ftm%PREV_STKCNT+1) THEN
!        IF (dbg_set(dbg_log)) write(IPT,*) "PREVIOUS AND NEXT ARE CONTIGUOUS FRAMES"

        status = 0
        RETURN ! WE FOUND IT
     END IF

     ! CUT THE FRAME DIFFERENCE IN HALF AND TRY AGAIN
     df = ftm%NEXT_STKCNT - ftm%PREV_STKCNT
     ! NOTE: DF WILL ALWAYS BE GREATER THAN OR EQUAL TO 2
     frame  = ftm%PREV_STKCNT + ceiling(df/2.0_sp)
     ctime = get_file_time(ftm,frame)
     
     IF( ctime < now) THEN
        ftm%PREV_STKCNT = frame
        ftm%PREV_IO = ctime
        
        CALL recursive_file_bracket(ftm,now,status)
     ELSE IF (ctime > now) THEN
        ftm%NEXT_STKCNT = frame
        ftm%NEXT_IO = ctime

        CALL recursive_file_bracket(ftm,now,status)
     ELSE IF (ctime == now) THEN

        ! FRAM CAN NEVER BE EQUAL TO ONE
        ! NO NEED TO CHECK
        
        ftm%PREV_STKCNT = frame-1
        ftm%PREV_IO = get_file_time(ftm,frame-1)
        
        ftm%NEXT_STKCNT = frame
        ftm%NEXT_IO = ctime
        
        status = 0
        RETURN
                
     ELSE
        CALL fatal_error("YOU SHOULD NOT BE HERE - I MEAN IT!")
     END IF
     
  ELSE IF( ftm%PREV_IO == now ) THEN

!     IF (dbg_set(dbg_log)) write(IPT,*) "PREVIOUS EQUAL TO NOW"
     ! WE HAVE THE ANSWER
     ftm%NEXT_STKCNT = ftm%PREV_STKCNT + 1
     ftm%NEXT_IO = get_file_time(ftm,ftm%NEXT_STKCNT)
     
     status = 0
     RETURN
     
  ELSE IF( ftm%NEXT_IO == now ) THEN
     
!     IF (dbg_set(dbg_log)) write(IPT,*) "NEXT EQUAL TO NOW"
     ! WE HAVE THE ANSWER
     ftm%PREV_STKCNT = ftm%NEXT_STKCNT - 1
     ftm%PREV_IO = get_file_time(ftm,ftm%PREV_STKCNT)
     
     status = 0
     RETURN
     
  ELSE IF( now > ftm%NEXT_IO ) THEN

!     IF (dbg_set(dbg_log)) write(IPT,*) "NOW GREATER THAN NEXT"
  
     IF (ftm%NEXT_STKCNT .GE. ftm%STK_LEN) THEN
        ! THE TIME EXCEEDS THE FILE TIME
        status = 1
        return
     END IF
 
     df = (ftm%STK_LEN - ftm%NEXT_STKCNT)
     frame  = ftm%NEXT_STKCNT + ceiling(df/2.0_sp)
     ctime = get_file_time(ftm,frame)

     ! IS THE RESULTANT TIME LESS THAN EQUAL TO OR GREATER THAN NOW?
     IF( ctime < now) THEN
        ftm%PREV_STKCNT = frame
        ftm%PREV_IO = ctime

        ftm%NEXT_STKCNT = ftm%STK_LEN
        ftm%NEXT_IO = get_file_time(ftm,ftm%STK_LEN)
        CALL recursive_file_bracket(ftm,now,status)

     ELSE IF (ctime > now) THEN

        ftm%PREV_STKCNT = ftm%NEXT_STKCNT
        ftm%PREV_IO = ftm%NEXT_IO

        ftm%NEXT_STKCNT = frame
        ftm%NEXT_IO = ctime
        
        CALL recursive_file_bracket(ftm,now,status)

     ELSE IF (ctime == now) THEN
       ! WE HAVE THE ANSWER
        
        ftm%PREV_STKCNT = frame-1
        ftm%PREV_IO = get_file_time(ftm,frame-1)
        
        ftm%NEXT_STKCNT = frame
        ftm%NEXT_IO = ctime
        
        status = 0
        RETURN
        
        
     ELSE
        CALL fatal_error("YOU SHOULD NOT BE HERE - YOU DON'T LIKE ME, DO YOU!")
     END IF

     
      
  ELSE IF ( ftm%PREV_IO > now) THEN

!     IF (dbg_set(dbg_log)) write(IPT,*) "PREVIOUS GREATER THAN NOW"

     IF (ftm%PREV_STKCNT .LE. 1) THEN
        ! THE TIME PRECEEDS THE FILE TIME
        status = -1
        return
     END IF

     df = (ftm%PREV_STKCNT)
     frame  = ceiling(df/2.0_sp)
     ctime = get_file_time(ftm,frame)

     ! IS THE RESULTANT TIME LESS THAN EQUAL TO OR GREATER THAN NOW?
     IF( ctime < now) THEN

        ftm%NEXT_STKCNT = ftm%PREV_STKCNT
        ftm%NEXT_IO = ftm%PREV_IO

        ftm%PREV_STKCNT = frame
        ftm%PREV_IO = ctime
        CALL recursive_file_bracket(ftm,now,status)

     ELSE IF (ctime > now) THEN

        ftm%PREV_STKCNT = 1
        ftm%PREV_IO = get_file_time(ftm,1)

        ftm%NEXT_STKCNT = frame
        ftm%NEXT_IO = ctime
        
        CALL recursive_file_bracket(ftm,now,status)

     ELSE IF (ctime == now) THEN
        ! WE HAVE THE ANSWER
        ftm%PREV_STKCNT = frame
        ftm%PREV_IO = ctime
        
        ftm%NEXT_STKCNT = frame+1
        ftm%NEXT_IO = get_file_time(ftm,frame+1)
        
        status = 0
        RETURN
     
     ELSE

        CALL fatal_error("YOU SHOULD NOT BE HERE - WHY OH WHY")
     END IF

  ELSE

     CALL fatal_error("YOU SHOULD NOT BE HERE - THIS ONE IS NOT GOOD EITHER!")
  END IF
  


END SUBROUTINE recursive_file_bracket
!====================================================================
!====================================================================
SUBROUTINE update_file_bracket(NCF,NOW,status)
  IMPLICIT NONE
  TYPE(ncfile), POINTER:: NCF
  TYPE(ncftime), POINTER :: FTM
  TYPE(time)   :: NOW

  TYPE(time)   :: TIMETEST,dtime
  REAL(DP)     :: denom, numer
  INTEGER      :: STATUS

  IF(.NOT. ASSOCIATED(ncf)) CALL fatal_error &
       & ("UPDATE_FILE_BRACKET: FILE object argument is not assocaited!")

  IF (.NOT. ASSOCIATED(ncf%FTIME)) THEN
     CALL print_file(ncf)
     CALL fatal_error("UPDATE_FILE_BRACKET: FILE object's FTIME is not assocaited!")
  END IF

  ftm => ncf%FTIME

  IF (ftm%STK_LEN == 1) THEN
     CALL print_file(ncf)
     CALL fatal_error ("FILE BRACKET DOES NOT WORK IF THE TIME DIMENSI&
          &ON LENGTH IS ONE!")
  END IF

  IF (ftm%NEXT_STKCNT == ftm%PREV_STKCNT .or. &
       & ftm%PREV_IO == ftm%NEXT_IO ) THEN

     ftm%NEXT_STKCNT = ftm%STK_LEN
     ftm%NEXT_IO = get_file_time(ftm,ftm%STK_LEN)


     ftm%PREV_STKCNT = 1
     ftm%PREV_IO = get_file_time(ftm,1)

     IF(now >  ftm%NEXT_IO) THEN
        status = 1
        RETURN
     END IF


     IF( now < ftm%PREV_IO) THEN
        status = -1
        RETURN
     END IF

     CALL recursive_file_bracket(ftm,now,status)

  END IF


  ! SET STATUS BASED ON FINDING THE CORRECT FILE TIMES 
  IF( ftm%PREV_IO < now .AND. now <= ftm%NEXT_IO .AND. &
       & ftm%NEXT_STKCNT .EQ. ftm%PREV_STKCNT+1 ) THEN

     status = 0
     ! UPDATE THE WEIGHTS AND EXIT

  ELSE IF( ftm%PREV_IO <= now .AND. now < ftm%NEXT_IO .AND. &
       & ftm%NEXT_STKCNT .EQ. ftm%PREV_STKCNT+1 ) THEN

     status = 0
     ! UPDATE THE WEIGHTS AND EXIT

  ELSE IF( now > ftm%NEXT_IO ) THEN

     !TRY ADVANCING STACK COUNT ONE FIRST

     IF (ftm%NEXT_STKCNT == ftm%STK_LEN) THEN
        status =1
        RETURN
     END IF

     timetest = get_file_time(ftm,ftm%NEXT_STKCNT+1)
     IF (timetest >= now) THEN
        ftm%PREV_STKCNT = ftm%NEXT_STKCNT
        ftm%PREV_IO = ftm%NEXT_IO

        ftm%NEXT_STKCNT = ftm%NEXT_STKCNT +1
        ftm%NEXT_IO = timetest

        status = 0

     ELSE
        CALL recursive_file_bracket(ftm,now,status)
        if (status /= 0) return

     END IF

  ELSE IF ( ftm%PREV_IO > now) THEN

     IF (ftm%PREV_STKCNT == 1) THEN
        status = -1
        RETURN
     END IF

     timetest = get_file_time(ftm,ftm%PREV_STKCNT-1)
     IF (timetest <= now) THEN
        ftm%NEXT_STKCNT = ftm%PREV_STKCNT
        ftm%NEXT_IO = ftm%PREV_IO

        ftm%PREV_STKCNT = ftm%PREV_STKCNT-1
        ftm%PREV_IO = timetest

        status = 0

     ELSE

        CALL recursive_file_bracket(ftm,now,status)
        if (status /= 0) return

     END IF

  ELSE
     CALL fatal_error &
          & ("And you may ask yourself", &
          & "How do I work this?", &
          & "And you may ask yourself" , &
          & "Where is that fvcom manual? - The Talking Heads")
  END IF

  ! NOW SET THE WGHT VALUES

  ! CALCULATE THE TIME DIFFERENCE IN MICROSECONDS AND CONVERT TO
  ! DOUBLE THEN DIVIDE BY ONE MILLION 
  !  dtime = NOW - FTM%PREV_IO
  !  NUMER = REAL((dtime%MuSod + MUSPD * dtime%MJD), DP)/1000000.0_DP

  !  NUMER = REAL_TIME_DIFF(NOW,FTM%PREV_IO)
  numer = seconds(now - ftm%PREV_IO)

  !  dtime = FTM%NEXT_IO - FTM%PREV_IO
  !  DENOM = REAL((dtime%MuSod + MUSPD * dtime%MJD), DP)/1000000.0_DP

  !  DENOM = REAL_TIME_DIFF(FTM%NEXT_IO,FTM%PREV_IO)
  denom = seconds(ftm%NEXT_IO - ftm%PREV_IO)


  ! TAKE THE RATIO IN DOUBLE PRECISION AND CONVERT IF MODEL IS NOT DOUBLE
  ftm%NEXT_WGHT = numer/denom

  ftm%PREV_WGHT = 1.0_dp - numer/denom


END SUBROUTINE update_file_bracket
  !==============================================================================|
  !==============================================================================|
  SUBROUTINE update_var_bracket(NCF,VPREV,VNEXT,NOW,status,INTERP)
    !
    !  RETURN STATUS VALUES:
    !     -1   NOW is before the first forcing time
    !      0   The data is current
    !      1   NOW is after the last forcing time
    !
    !
    IMPLICIT NONE
    TYPE(ncvar), POINTER :: VNEXT,VPREV, VTMP
    TYPE(time) :: NOW
    TYPE(ncfile), POINTER :: NCF
    INTEGER :: STATUS
    TYPE(interp_weights),POINTER, OPTIONAL :: INTERP

    REAL(SP), POINTER :: VARRP(:,:),VVECP(:)
    TYPE(ncftime),POINTER :: FTM

    LOGICAL :: FOUND


    IF(.not. ASSOCIATED(ncf)) CALL fatal_error&
         & ("UPDATE_VAR_BRACKET: FILE OBJECT ARGUMENT IS NOT ASSOCIATED!")

    IF(.not. ASSOCIATED(vnext)) CALL fatal_error&
         & ("UPDATE_VAR_BRACKET: FIRST VARIABLE ARGUMENT IS NOT ASSOCIATED!")

    IF(.not. ASSOCIATED(vprev)) CALL fatal_error&
         & ("UPDATE_VAR_BRACKET: SECOND VARIABLE ARGUMENT IS NOT ASSOCIATED!")

    IF(PRESENT(interp)) THEN
       IF (.not. ASSOCIATED(interp)) CALL fatal_error&
            & ("UPDATE_VAR_BRACKET: THE INTERP ARGUMENT IS NOT ASSOCIATED!")
    END IF

    NULLIFY(vtmp)


    IF(.not.ASSOCIATED(vprev%ncid, target = vnext%ncid)) THEN
       call print_var(vprev)
       call print_var(vnext)
       CALL fatal_error ("UPDATE_VAR_BRACKET: ", &
            &" VARIABLE ARGUMENTS DO NOT POINT TO THE SAME NETCDF FILE!")
    END IF

    IF(.not.ASSOCIATED(vprev%ncid, target = ncf%ncid)) THEN
       call print_var(vprev)
       call print_file(ncf)
       CALL fatal_error ("UPDATE_VAR_BRACKET: ", &
            &" VARIABLE ARGUMENTS DOES NOT POINT TO THE NETCDF FILE!")
    END IF




    CALL update_file_bracket(ncf,now,status)
    if (status /= 0) RETURN


    ftm => ncf%FTIME

    IF(ftm%NEXT_STKCNT .EQ. vnext%CURR_STKCNT) THEN

       IF(ftm%PREV_STKCNT .NE. vprev%CURR_STKCNT) THEN
          CALL nc_read_var(vprev,ftm%PREV_STKCNT)

          IF(PRESENT(interp)) THEN
             CALL nc_point_var(vprev,vvecp)
             CALL nc_point_var(vprev,varrp)              
             CALL interp_bilinear_p(varrp,interp,vvecp)
          END IF

          !        status = -2
       END IF

    ELSE IF (ftm%PREV_STKCNT .EQ. vprev%CURR_STKCNT) THEN
       ! NEXT MUST NEED UPDATE
       CALL nc_read_var(vnext,ftm%NEXT_STKCNT)
       IF(PRESENT(interp)) THEN
          CALL nc_point_var(vnext,vvecp)
          CALL nc_point_var(vnext,varrp)              
          CALL interp_bilinear_p(varrp,interp,vvecp)
       END IF
       !     status = 2

    ELSE  ! IF THEY ARE BOTH WRONG: SEE IF WE CAN JUST INCRIMENT BY ONE CNT?

       IF(ftm%PREV_STKCNT .EQ. vnext%CURR_STKCNT) THEN
          vtmp => vprev
          vprev => vnext
          vnext => vtmp
          CALL nc_read_var(vnext,ftm%NEXT_STKCNT)
          IF(PRESENT(interp)) THEN
             CALL nc_point_var(vnext,vvecp)
             CALL nc_point_var(vnext,varrp)              
             CALL interp_bilinear_p(varrp,interp,vvecp)
          END IF
          !        status = 2
       ELSE IF ( ftm%NEXT_STKCNT .EQ. vprev%CURR_STKCNT) THEN
          vtmp => vnext
          vnext => vprev
          vprev => vtmp
          CALL nc_read_var(vprev,ftm%PREV_STKCNT)
          IF(PRESENT(interp)) THEN
             CALL nc_point_var(vprev,vvecp)
             CALL nc_point_var(vprev,varrp) 
             CALL interp_bilinear_p(varrp,interp,vvecp)
          END IF
       ELSE ! MUST LOAD BOTH FROM THE FILE

          CALL nc_read_var(vnext,ftm%NEXT_STKCNT)

          IF(PRESENT(interp)) THEN
             CALL nc_point_var(vnext,vvecp)
             CALL nc_point_var(vnext,varrp)              
             CALL interp_bilinear_p(varrp,interp,vvecp)
          END IF

          CALL nc_read_var(vprev,ftm%PREV_STKCNT)

          IF(PRESENT(interp)) THEN
             CALL nc_point_var(vprev,vvecp)
             CALL nc_point_var(vprev,varrp) 
             CALL interp_bilinear_p(varrp,interp,vvecp)
          END IF

       END IF
    END IF

  END SUBROUTINE update_var_bracket
!====================================================================
!====================================================================
FUNCTION set_file_time_type(NCF) RESULT(RES)
! RETURN VALUES:
!  -1 UNKNOWN TIME VARIABLE TYPE
!  -2 NOT AN IDENTIFABLE TIME VARIABLE FILE
!  0 SUCESSES!
  IMPLICIT NONE
  TYPE(ncfile), pointer :: ncf
  TYPE(ncftime), POINTER :: ftm
  INTEGER :: res
  
  type(time) :: test
  Character(len=80) :: tzone
  TYPE(ncdim), pointer :: dim
  TYPE(ncatt), pointer :: att
  TYPE(ncvar), pointer :: var1, var2
  LOGICAL :: found, valid
  
  IF(.NOT. ASSOCIATED(ncf)) CALL fatal_error &
       & ("SET_FILE_TIME_TYPE: FILE object argument is not assocaited!")
  
  res = -1
  

  IF(ASSOCIATED(ncf%FTIME))THEN
     IF(ncf%FTIME%TMTYPE /= tmtype_unknown) THEN
        res = 0
        RETURN
     END IF
  END IF

  ! LOOK FOR CHARACTER STRING DATE
  var1  => find_var(ncf,'Times',found)
  IF (found) THEN

     valid = is_valid_datetime(var1,tzone)
     IF (valid) THEN

        ! WE HAVE AN IDENTIFIED TIME VARIABLE FILE 
        IF(.NOT. ASSOCIATED(ncf%FTIME)) ncf%FTIME=>new_ftime()


        ! SET THE LEGNTH OF THE TIME DIMENSION
        dim => find_dim(var1,'Time',found)
        IF (.not. found) dim => find_dim(var1,'time',found)
        
        IF (.not. found) THEN
           CALL print_file(ncf)
           CALL print_dim_list(ncf)
           CALL fatal_error("SET_FILE_TIME_TYPE: CAN NOT FIND THE TIME DIMENSION")
        END IF
        
        ncf%FTIME%STK_LEN = dim%DIM
        
        ! COPY THE TIME VARIABLE FOR SPACE TO LOAD IT
        ncf%FTIME%TM1 => reference_var(var1)
        
        ! SET THE TYPE
        ncf%FTIME%TMTYPE = tmtype_char_date
        ncf%FTIME%TimeZone=tzone

        res = 0
        
        IF (dim%DIM == 0) THEN
           CALL warning("THE NETCDF FILE"//trim(ncf%FNAME),&
                & "Has a Time variable but the dimension is zero!")
           RETURN
        END IF

        if(dbg_set(dbg_io)) write(ipt,*) "Testing get time for file:"//trim(ncf%FNAME)
        test=get_file_time(ncf,1)
        if(dbg_set(dbg_io)) write(ipt,*) "Test Passed!"
        RETURN
     ELSE
        CALL warning ("SET_FILE_TIME_TYPE: FOUND VARIABLE NAMED: 'Times'&
             & BUT IT IS NOT VALID ACCORDING TO IS_VALID_DATETIME")
     END IF
  END IF

  
  ! LOOK FOR 2 INTEGER MODIFIED JULIAN DAY SECOND
  var1  => find_var(ncf,'Itime',found)
  IF (found) THEN
     var2 => find_var(ncf,'Itime2',found)
     
     IF (found) THEN
        valid = is_valid_itime( var1, var2,tzone)

        IF (valid) THEN
           ! WE HAVE A TIME VARIABLE FILE 
           IF(.NOT. ASSOCIATED(ncf%FTIME)) ncf%FTIME=>new_ftime()
    
           ! SET THE LEGNTH OF THE TIME DIMENSION
           dim => find_dim(var1,'time',found)           
           IF (found) THEN
              dim => find_dim(var2,'time',found) ! CHECK BOTH VARIABLES
              IF (.not. found) THEN
                 CALL print_file(ncf)
                 CALL print_dim_list(ncf)
                 CALL fatal_error("SET_FILE_TIME_TYPE: CAN NOT FIND THE TIME DIMENSION")
              END IF
           END IF
           ncf%FTIME%STK_LEN = dim%DIM

           ! COPY THE TIME VARIABLE FOR SPACE TO LOAD IT
           ncf%FTIME%TM1 => reference_var(var1)
           ncf%FTIME%TM2 => reference_var(var2)

           ! SET THE TYPE
           ncf%FTIME%TMTYPE = tmtype_int2_mjd 

           ncf%FTIME%TimeZone=tzone

           res = 0

           IF (dim%DIM == 0) THEN
              CALL warning("THE NETCDF FILE"//trim(ncf%FNAME),&
                   & "Has a Time variable but the dimension is zero!")
              RETURN
           END IF

           if(dbg_set(dbg_io)) write(ipt,*) "Testing get time for file:"//trim(ncf%FNAME)
           test=get_file_time(ncf,1)
           if(dbg_set(dbg_io)) write(ipt,*) "Test Passed!"
           RETURN
        ELSE
           CALL warning ("SET_FILE_TIME_TYPE: FOUND VARIABLE NAMES: Itime&
                & and Itime2 BUT THEY ARE NOT VALID ACCORDING TO IS_VALID_ITIME")
        END IF

     ELSE 
        CALL warning ("SET_FILE_TIME_TYPE: FOUND ONLY ONE OF TWO INTEGER TIME VARIABLES?")
     END IF
  END IF
       
  ! LOOK FOR FLOATING POINT MODIFIED JULIAN DAY
  var1 => find_var(ncf,'time',found)
  IF (found) THEN
     
     IF (is_valid_float_days( var1, tzone) ) THEN
        ! WE HAVE A TIME VARIABLE FILE 
        IF(.NOT. ASSOCIATED(ncf%FTIME)) ncf%FTIME=>new_ftime()

        ! SET THE LEGNTH OF THE TIME DIMENSION
        dim => find_dim(var1,'time',found)           
        IF (.NOT.found) THEN
           CALL print_file(ncf)
           CALL print_dim_list(ncf)
           CALL fatal_error("SET_FILE_TIME_TYPE: CAN NOT FIND THE TIME DIMENSION")
        END IF
        ncf%FTIME%STK_LEN = dim%DIM
        
        ! COPY THE TIME VARIABLE FOR SPACE TO LOAD IT
        ncf%FTIME%TM1 => reference_var(var1)
        
        ncf%FTIME%TMTYPE = tmtype_float_days

        ncf%FTIME%TimeZone=tzone

        res = 0

        IF (dim%DIM == 0) THEN
           CALL warning("THE NETCDF FILE"//trim(ncf%FNAME),&
                & "Has a Time variable but the dimension is zero!")
           RETURN
        END IF

        if(dbg_set(dbg_io)) write(ipt,*) "Testing get time for file:"//trim(ncf%FNAME)
        test=get_file_time(ncf,1)
        if(dbg_set(dbg_io)) write(ipt,*) "Test Passed!"
        RETURN

     ELSE IF(is_valid_float_seconds( var1, tzone) ) THEN
        
        ! WE HAVE A TIME VARIABLE FILE 
        IF(.NOT. ASSOCIATED(ncf%FTIME)) ncf%FTIME=>new_ftime()
        
        ! SET THE LEGNTH OF THE TIME DIMENSION
        dim => find_dim(var1,'time',found)           
        IF (.NOT.found) THEN
           CALL print_file(ncf)
           CALL print_dim_list(ncf)
           CALL fatal_error("SET_FILE_TIME_TYPE: CAN NOT FIND THE TIME DIMENSION")
        END IF
        ncf%FTIME%STK_LEN = dim%DIM
        
        !COPY THE TIME VARIABLE FOR SPACE TO LOAD IT
        ncf%FTIME%TM1 => reference_var(var1)
        
        ncf%FTIME%TMTYPE = tmtype_float_seconds

        ncf%FTIME%TimeZone=tzone

        res = 0
        IF (dim%DIM == 0) THEN
           CALL warning("THE NETCDF FILE"//trim(ncf%FNAME),&
                & "Has a Time variable but the dimension is zero!")
           RETURN
        END IF


        if(dbg_set(dbg_io)) write(ipt,*) "Testing get time for file:"//trim(ncf%FNAME)
        test=get_file_time(ncf,1)
        if(dbg_set(dbg_io)) write(ipt,*) "Test Passed!"
        RETURN
     ELSE
        CALL warning ("SET_FILE_TIME_TYPE: FOUND VARIABLE NAMEd: 'time'&
             & BUT IT IS NOT VALID ACCORDING TO IS_VALID_FLOAT_DAYS/SECONDS")
     END IF
  END IF


END FUNCTION set_file_time_type

FUNCTION get_file_time_ncf(NCF,STKCNT) RESULT(THETIME)
  IMPLICIT NONE
  TYPE(time)   :: thetime
  TYPE(ncfile),POINTER :: ncf
  INTEGER, intent(in) :: stkcnt
  TYPE(ncftime), POINTER :: ftm

   IF(.NOT. ASSOCIATED(ncf)) CALL fatal_error &
       & ("GET_FILE_TIME_NCF: FILE object argument is not assocaited!")
  

   IF(.NOT. ASSOCIATED(ncf%FTIME)) THEN
      CALL print_file(ncf)
      CALL fatal_error("GET_FILE_TIME_NCF: FILE object's FTIME is not assocaited!")
   END IF

   ftm =>ncf%FTIME

   thetime = get_file_time(ftm,stkcnt)

 END FUNCTION get_file_time_ncf


FUNCTION get_file_time_ncftime(FTM,STKCNT) RESULT(THETIME)
  IMPLICIT NONE
  TYPE(time)   :: thetime
  TYPE(ncftime),POINTER :: ftm
  TYPE(ncvar), POINTER :: var1, var2
  TYPE(ncatt), POINTER :: att
  INTEGER, intent(in) :: stkcnt
  REAL(sp),target :: float_time
  INTEGER, target :: mjd,msec
  Character(len=80), target :: dstring
  INTEGER :: status
  Character(len=80) :: dformat
  LOGICAL found

   IF(.NOT. ASSOCIATED(ftm)) THEN
      CALL fatal_error("GET_FILE_TIME_NCFTIME: THE ARGUMENT FTM is not assocaited!")
   END IF


   IF(stkcnt .LE. 0) CALL fatal_error&
        &('GET_FILE_TIME: YOU CAN NOT GET TIME FOR A STACK COUNT LESS THAN ONE!')

   SELECT CASE(ftm%TMTYPE)
   CASE(tmtype_float_days)

      var1 => ftm%TM1
      
      CALL nc_connect_avar(var1,float_time)
      CALL nc_read_var(var1,stkcnt)

      thetime = days2time(float_time) - time_zone(ftm%TIMEZONE,status)

   CASE(tmtype_float_seconds)

      var1 => ftm%TM1
      
      CALL nc_connect_avar(var1,float_time)
      CALL nc_read_var(var1,stkcnt)

      thetime = seconds2time(float_time) - time_zone(ftm%TIMEZONE,status)

   CASE(tmtype_int2_mjd)

      var1 => ftm%TM1
      
      CALL nc_connect_avar(var1,mjd)
      CALL nc_read_var(var1,stkcnt)

      var2 => ftm%TM2

      CALL nc_connect_avar(var2,msec)
      CALL nc_read_var(var2,stkcnt)

      thetime%MJD= mjd
      thetime%MuSod= int(msec,itime)* int(1000,itime)
 
      thetime = thetime - time_zone(ftm%TIMEZONE,status)

   CASE(tmtype_char_date)

      dformat = "ymd"

      var1 => ftm%TM1
      
      CALL nc_connect_avar(var1,dstring)
      CALL nc_read_var(var1,stkcnt)

      thetime = read_datetime(dstring,dformat,ftm%TIMEZONE,status)
      if(status == 0) THEN
         CALL print_ftime(ftm)
         CALL fatal_error("GET_FILE_TIME: COULD NOT TRANSLATE TIME STRING",&
              "FILE RETURNED: "//trim(dstring))
      END if


   CASE DEFAULT
      CALL print_ftime(ftm)
      CALL fatal_error("GET_FILE_TIME: FILE object's FTIME is an unrecognized type")
   END SELECT

  

 END FUNCTION get_file_time_ncftime
 
 !========================================================================!
 !
 !========================================================================!
 SUBROUTINE set_file_stack(NCF_IN,NOW,INTERVAL)
   ! THIS IS A STRICT FILE TIME MATCHING PROGRAM. IT WILL MATCH A
   ! TIME IN A EXISTING FILE TO THE NCF WITH THE SAME FILE NAME.
   ! IF THE EXACT TIME PASSED DOES NOT EXIST IN THE FILE, IT RETURNS
   ! AN ERROR.
   IMPLICIT NONE
   TYPE(ncfile), POINTER :: NCF_IN,NCF_TMP
   TYPE(time) :: Ttest,NOW,INTERVAL
   INTEGER :: IDX
   
   ncf_tmp => new_file()
   ncf_tmp%FNAME = ncf_in%FNAME
   
   Call nc_open(ncf_tmp)
   CALL nc_load(ncf_tmp)
   
   idx = ncf_tmp%FTIME%STK_LEN
   
   IF(idx == 0) CALL fatal_error&
        &("THERE IS NO DATA IN THE FILE:"//trim(ncf_in%FNAME),&
        & "(STK_LEN == 0) WHEN THE MODEL CRASHED, SO HOTSTART IS IMPOSSIBLE.",&
        & "BETTER LUCK NEXT TIME!")
   
   ttest = get_file_time(ncf_tmp,idx)
   
   DO WHILE(ttest > now)
      
      idx = idx -1
      IF(idx ==0) THEN
         CALL print_time(now,ipt,"NOW")
         CALL print_time(ttest,ipt,"EARLIEST FILE TIME")
         
         CALL fatal_error&
              &("SET_FILE_STACK: SEARCHING FOR TIME IN FILE NAME:",&
              & trim(ncf_in%FNAME),&
              & "ALL TIMES IN FILE ARE GREATER THAN NOW?")
      END IF
      
      ttest = get_file_time(ncf_tmp,idx)
      
   END DO
   
   IF(ttest /= now) THEN
      CALL print_time(now,ipt,"NOW")
      CALL print_time(ttest,ipt,"NEAREST TIME IN FILE")
      
      CALL fatal_error&
           &("SET_FILE_STACK: SEARCHING FOR TIME IN FILE NAME:",&
           & trim(ncf_in%FNAME),&
           & "CAN'T FIND EXACT MATCHING TIME IN FILE")
   END IF
   
   CALL kill_file(ncf_tmp)
   
   ncf_in%FTIME%PREV_STKCNT=idx
   ncf_in%FTIME%NEXT_STKCNT=idx+1
   ncf_in%FTIME%PREV_IO=ttest
   ncf_in%FTIME%NEXT_IO=ttest+interval
   
   
 END SUBROUTINE set_file_stack
 
 

END MODULE mod_nctools