CESM_Driver: shr_ncio_mod.F90 Source File

00001 !===============================================================================
00002 ! SVN $Id: shr_alarm_mod.F90 239 2006-02-08 19:02:33Z kauff $
00003 ! SVN $URL: https://svn-ccsm-models.cgd.ucar.edu/csm_share/trunk/shr/shr_alarm_mod.F90 $
00004 !===============================================================================
00005 !BOP ===========================================================================
00006 !
00007 ! !MODULE: shr_ncio_mod.F90 --- Module to handle reading and writing of NetCDF data
00008 !
00009 ! !DESCRIPTION:
00010 !
00011 !     A module to handle the reading and writing of scalar data to NetCDF files for the
00012 !  purpose of storing scalar netCDF data in either: integer, character, or logical format.
00013 !
00014 ! Typical usage:
00015 !
00016 ! ! Initialize a descripVar
00017 ! call shr_ncio_descripInit( DescripVar(n), Name="T", LongName=                   &
00018 !                            "Globally averaged Temperature of surface",       &
00019 !                            Units="K",   RealR8Data=.true., RealR8Fill=1.e+36 )
00020 ! ! Read in the file
00021 ! FileType="glob avg T file"
00022 ! call shr_ncio_open( NCFileName, MasterTask, FileType, ncId, exists )
00023 ! call shr_ncio_descripRead( ncId, nVars, mpicom, MasterTask, DescripVar )
00024 ! ! Do any other NetCDF reading on ncID....
00025 !...
00026 ! call shr_ncio_close( ncId, MasterTask, NCFilename, type=FileType )
00027 ! ! Return the name of the descripVar
00028 ! name = shr_ncio_descripName( DescripVar(n) )
00029 ! ! Get the data inside the variable
00030 ! glob_t = shr_ncio_descripGetRealR8( DescripVar(n) )
00031 ! ! Now set the scalar data of the variable
00032 ! call shr_ncio_descripSet( DescriptVar(n), Name="T", RealR8Data=glob_avg_t )
00033 ! ! Write the scalar data to a file
00034 ! FileType="glob avg T file"
00035 ! call shr_ncio_open( NCFileName, MasterTask, FileType, ncId, exists )
00036 ! call shr_ncio_descripWrite( ncId, nVars, mpicom, MasterTask, exists, DescripVar )
00037 ! ! Do any other NetCDF writing on ncID....
00038 !...
00039 ! call shr_ncio_close( ncId, MasterTask, NCFilename, FileType )
00040 !
00041 ! !REMARKS:
00042 !
00043 ! !REVISION HISTORY:
00044 !     2005-Dec-20 - E. Kluzek - creation
00045 !
00046 ! !INTERFACE: ------------------------------------------------------------------
00047 
00048 MODULE shr_ncio_mod
00049 
00050 ! !USES:
00051 
00052    use shr_kind_mod,      only: SHR_KIND_CS, SHR_KIND_CL, SHR_KIND_IN, &
00053                                 SHR_KIND_R8, SHR_KIND_I8, &
00054                                 SHR_KIND_R8
00055    use shr_sys_mod,       only: shr_sys_flush
00056    use shr_const_mod,     only: shr_const_spval
00057    use shr_log_mod,       only: s_loglev  => shr_log_Level
00058    use shr_log_mod,       only: s_logunit => shr_log_Unit
00059    use netcdf
00060 
00061    implicit none
00062 
00063    private  ! default private
00064 
00065 ! !PUBLIC TYPES:
00066 
00067    public :: shr_ncio_descripType     ! NetCDF data description type
00068 
00069 ! !PUBLIC MEMBER FUNCTIONS
00070 
00071    public :: shr_ncio_descripSetDefault ! Set list of descrip variables to default settings
00072    public :: shr_ncio_descripInit       ! Setup variable and variable Names and types
00073    public :: shr_ncio_descripPutData    ! Set a variable with data
00074    public :: shr_ncio_descripName       ! Get the Name from the ncio variable
00075    public :: shr_ncio_descripGetString  ! Get the string value from the ncio variable
00076    public :: shr_ncio_descripGetInteger ! Get the integer value from the ncio variable
00077    public :: shr_ncio_descripGetLogical ! Get the logical value from the ncio variable
00078    public :: shr_ncio_descripGetRealR8  ! Get the real value from the ncio variable
00079    public :: shr_ncio_descripRead       ! Read in file
00080    public :: shr_ncio_descripWrite      ! Write out to file
00081    public :: shr_ncio_open              ! Open NetCDF file for reading/writing/appending
00082    public :: shr_ncio_close             ! Close a NetCDF file
00083    public :: shr_ncio_setDebug          ! Set debug level of printing
00084    public :: shr_ncio_setAbort          ! Set flag if should abort on error or not
00085 
00086 ! !PUBLIC DATA MEMBERS:
00087 
00088    ! no public data members
00089 
00090 !EOP
00091 
00092 ! Private member functions:
00093 
00094    private :: shr_ncio_logical2Int ! Convert logical into an integer
00095    private :: shr_ncio_int2Logical ! Convert integer back into a logical
00096    private :: shr_ncio_abort       ! Local abort method
00097 
00098    !--- Private data to use for data that is not specified yet ---
00099    integer,           parameter :: shr_ncio_integerFill = -99999
00100    character(len=*),  parameter :: shr_ncio_stringFill  = '----NOTSET----'
00101    real(SHR_KIND_R8), parameter :: shr_ncio_realR8Fill  = shr_const_spval
00102    integer,           parameter :: maxDims              = 1
00103 
00104    !--- Public NetCDF description type ---
00105    type shr_ncio_descripType
00106        private    ! Opaque type
00107        character(SHR_KIND_CS) :: Name = shr_ncio_stringFill        ! Variable Name
00108        integer                :: XType = shr_ncio_integerFill      ! Variable type
00109        integer                :: id = shr_ncio_integerFill         ! variable id number
00110        integer                :: nDims                             ! number of dimensions
00111        integer                :: DimSizes(maxDims)                 ! Sizes of dimensions
00112        character(SHR_KIND_CS) :: DimNames(maxDims)                 ! Names of dimensions
00113        character(SHR_KIND_CS) :: Units = shr_ncio_stringFill       ! Units of variable
00114        character(SHR_KIND_CL) :: StringData = shr_ncio_stringFill  ! String scalar to write
00115        character(SHR_KIND_CL) :: ListDescrips = shr_ncio_stringFill! List of descriptions
00116        integer                :: IntegerData = shr_ncio_integerFill! Integer scalar to write
00117        real(SHR_KIND_R8)      :: RealR8Data  = shr_ncio_realR8Fill ! Real scalar to write
00118        integer                :: IntegerFill = shr_ncio_integerFill! Integer Fill-value
00119        real(SHR_KIND_R8)      :: RealR8Fill  = shr_ncio_realR8Fill ! Real Fill-value
00120        logical                :: LogicalData                       ! Logical scalar to write
00121        integer, pointer       :: ListValues(:)                     ! List values
00122        character(SHR_KIND_CL) :: LongName = shr_ncio_stringFill    ! Long Name of variable
00123    end type shr_ncio_descripType
00124 
00125    !--- Private data to signify which type of data will be written ---
00126    integer, parameter :: shr_ncio_integerDataValue = 1   ! Data is integer
00127    integer, parameter :: shr_ncio_stringDataValue  = 2   ! Data is string
00128    integer, parameter :: shr_ncio_logicalDataValue = 3   ! Data is logical
00129    integer, parameter :: shr_ncio_realR8DataValue  = 4   ! Data is real r8
00130    logical, save :: doAbort = .true.                     ! If abort on error or not
00131    integer, save :: debugLevel = 1                       ! Debug level
00132    character(len=*), parameter :: shrCharacterDimName = "shr_character"
00133 
00134 !===============================================================================
00135 CONTAINS
00136 !===============================================================================
00137 
00138 !===============================================================================
00139 !BOP ===========================================================================
00140 !
00141 ! !IROUTINE: shr_ncio_descripSetDefault -- Set ncio_descrip variables to defaults
00142 !
00143 ! !DESCRIPTION:
00144 !
00145 ! Set an array of shr_ncio_descrip variables to the default settings. This
00146 ! allows you to re-initialize them to different values if you so choose, It's
00147 ! also important on compilers that do NOT recognize structure initialization
00148 ! (as above) such as on PGI.
00149 !
00150 ! !INTERFACE: ------------------------------------------------------------------
00151 
00152 SUBROUTINE shr_ncio_descripSetDefault( NVars, DescripVars )
00153 
00154 ! !USES:
00155 
00156   implicit none
00157 
00158 ! !INPUT/OUTPUT PARAMETERS:
00159 
00160   integer,                    intent(IN)    :: nVars              ! Number of variables
00161   type(shr_ncio_descripType), intent(INOUT) :: DescripVars(nVars) ! Output description variables
00162 
00163 !EOP
00164 
00165    !----- local -----
00166    character(len=*), parameter :: subName = '(shr_ncio_descripSetDefault) '
00167    integer                     :: i      ! index
00168 
00169 !-------------------------------------------------------------------------------
00170 ! Notes:
00171 !-------------------------------------------------------------------------------
00172 
00173    do i = 1, NVars
00174        DescripVars(i)%Name         = shr_ncio_stringFill    ! Variable Name
00175        DescripVars(i)%XType        = shr_ncio_integerFill   ! Variable type
00176        DescripVars(i)%id           = shr_ncio_integerFill   ! variable id number
00177        DescripVars(i)%Units        = shr_ncio_stringFill    ! Units of variable
00178        DescripVars(i)%StringData   = shr_ncio_stringFill    ! String scalar to write
00179        DescripVars(i)%ListDescrips = shr_ncio_stringFill    ! List of descriptions
00180        DescripVars(i)%IntegerData  = shr_ncio_integerFill   ! Integer scalar to write
00181        DescripVars(i)%RealR8Data   = shr_ncio_realR8Fill    ! Real scalar to write
00182        DescripVars(i)%IntegerFill  = shr_ncio_integerFill   ! Integer Fill-value
00183        DescripVars(i)%RealR8Fill   = shr_ncio_realR8Fill    ! Real Fill-value
00184        DescripVars(i)%LongName     = shr_ncio_stringFill    ! Long Name of variable
00185    end do
00186 
00187 END SUBROUTINE shr_ncio_descripSetDefault
00188 
00189 !===============================================================================
00190 !BOP ===========================================================================
00191 !
00192 ! !IROUTINE: shr_ncio_descripInit -- Set ncio_descrip variable Names
00193 !
00194 ! !DESCRIPTION:
00195 !
00196 ! Initial setup of a ncio descrip variable. Set logical data flags either to: 
00197 !   StringData, ! IntegerData, LogicalData, or RealR8Data. Can optionally set 
00198 ! the LongName, Units, and fillvalue (only for RealR8 or Integer data). Note, 
00199 ! if you select IntegerData for the data-type, you can only set the IntergerFill 
00200 ! value, NOT the RealR8Fill value and vica-versa. If you pick IntegerData
00201 ! as the data-type you can also select ListDescrips and ListIntValues with 
00202 ! the list of valid values and a description for the meaning of each of those 
00203 ! values. In this case, attributes giving the values and the matching 
00204 ! description of that value will be added to the output NetCDF file.
00205 ! For example, if you have integer data to describe the vegetation type, with 
00206 ! a list of 12 different vegetation types, you give a colen delimited list to 
00207 ! describe each type, as well as ListIntValues to give the corresponding value 
00208 ! that goes with each description in the list.
00209 !
00210 ! !INTERFACE: ------------------------------------------------------------------
00211 
00212 SUBROUTINE shr_ncio_descripInit( DescripVar, Name, LongName, Units,    &
00213                                  StringData, IntegerData, LogicalData, &
00214                                  RealR8Data, IntegerFill,              &
00215                                  RealR8Fill, ListDescrips,             &
00216                                  ListIntValues, nDims, dimSizes )
00217 
00218 ! !USES:
00219 
00220   use shr_string_mod,    only: shr_string_listIsValid, shr_string_listGetNum
00221 
00222   implicit none
00223 
00224 ! !INPUT/OUTPUT PARAMETERS:
00225 
00226   type(shr_ncio_descripType), intent(INOUT) :: DescripVar! Output description variable
00227   character(len=*), intent(IN) :: Name                   ! Short name of data
00228   character(len=*), intent(IN), optional :: LongName     ! Longname of data
00229   character(len=*), intent(IN), optional :: Units        ! Physical units of data
00230   logical, intent(IN), optional, target :: StringData    ! Flag if data is string-type
00231   logical, intent(IN), optional, target :: IntegerData   ! Flag if data is integer-type
00232   logical, intent(IN), optional, target :: LogicalData   ! Flag if data is logical-type
00233   logical, intent(IN), optional, target :: RealR8Data    ! Flag if data is string-type
00234   real(SHR_KIND_R8), intent(IN), optional :: RealR8Fill  ! Fill value for real-R8 data
00235   integer, intent(IN), optional, target :: IntegerFill   ! Fill value for integer data
00236   ! --- For integer-list, description of each value as colen delimited list ---
00237   character(len=*), intent(IN), optional :: ListDescrips 
00238   ! --- For integer-list, integer values that go with each description ----
00239   integer, intent(IN), optional :: ListIntValues(:)      
00240   integer, intent(IN), optional :: nDims                 ! Number of dimensions of variable
00241   integer, intent(IN), optional :: dimSizes(:)           ! Sizes of each dimension
00242 
00243 !EOP
00244 
00245    !----- local -----
00246    character(len=*), parameter :: subName = '(shr_ncio_descripInit) '
00247    logical :: NotSet        ! Type not set yet or not
00248    integer :: nList         ! Number of values in list
00249 
00250 !-------------------------------------------------------------------------------
00251 ! Notes:
00252 !
00253 ! Currently only implemented for scalar data, nDims and dimSizes are not fully 
00254 ! tested.
00255 !-------------------------------------------------------------------------------
00256 
00257   ! --- Check if setting more than one data-type ------
00258   if ( (PRESENT(StringData)  .and. PRESENT(IntegerData)) .or. &
00259        (PRESENT(StringData)  .and. PRESENT(LogicalData)) .or. &
00260        (PRESENT(StringData)  .and. PRESENT(RealR8Data )) .or. &
00261        (PRESENT(IntegerData) .and. PRESENT(LogicalData)) .or. &
00262        (PRESENT(IntegerData) .and. PRESENT(RealR8Data )) .or. &
00263        (PRESENT(LogicalData) .and. PRESENT(RealR8Data )) )then
00264      call shr_ncio_abort( subName//': can not set more than one variable type' )
00265   end if
00266   if ( PRESENT(nDims) .or. PRESENT(dimSizes) )then
00267      call shr_ncio_abort( subName//': currently nDims and dimSizes are NOT implemented' )
00268   end if
00269   if (  PRESENT(nDims) .and. .not. PRESENT(dimSizes)  &
00270   .or.  (.not. PRESENT(nDims) .and. PRESENT(dimSizes) ) )then
00271      call shr_ncio_abort( subName//': if nDims set so must also dimSizes' )
00272   else if ( PRESENT(nDims) .and. PRESENT(dimSizes) )then
00273      if ( nDims /= size(dimSizes) )then
00274         call shr_ncio_abort( subName//': if nDims NOT set to same dimensionality as dimSizes' )
00275      end if
00276      if ( nDims > maxDims )then
00277         call shr_ncio_abort( subName//': nDims > size of max dimensions' )
00278      end if
00279      DescripVar%nDims       = nDims
00280      DescripVar%dimSizes(:) = dimSizes(:nDims)
00281   end if
00282 
00283   ! --- Name, check if name already defined ------
00284   if ( DescripVar%Name == shr_ncio_stringFill )then
00285      DescripVar%Name = Name
00286   ! --- If name already defined, but you are asking for a different name -- abort
00287   else if ( trim(Name) /= trim(DescripVar%Name) )then
00288      call shr_ncio_abort( subName//': bad Name: '//trim(Name)// &
00289                          ' sent to variable already defined as:'// &
00290                          trim(DescripVar%Name) )
00291   ! --- If name is the same, as previously defined name -- silently continue ------
00292   end if
00293   ! --- Long-name and units attributes ------
00294   if ( PRESENT(LongName) ) DescripVar%LongName = LongName
00295   if ( PRESENT(Units)     ) DescripVar%Units   = Units
00296   NotSet = .true.
00297   ! --- For String Data type ------
00298   if ( PRESENT(StringData) )then
00299      NotSet = .false.
00300      DescripVar%XType      = shr_ncio_stringDataValue
00301      if ( .not. PRESENT(nDims) )then
00302         DescripVar%nDims       = 1
00303         DescripVar%dimSizes(1) = len(DescripVar%StringData)
00304      end if
00305      DescripVar%dimNames(1) = shrCharacterDimName
00306      if ( .not. PRESENT(Units) ) DescripVar%Units = "string"
00307   end if
00308   ! --- For Integer Data type ------
00309   if ( PRESENT(IntegerData) )then
00310      if ( .not. NotSet ) call shr_ncio_abort( subName//': trying to define '// &
00311                                              'to more than one data-type' )
00312      NotSet = .false.
00313      DescripVar%XType       = shr_ncio_integerDataValue
00314      if ( .not. PRESENT(nDims) )then
00315         DescripVar%nDims       = 0
00316      end if
00317      if ( PRESENT(IntegerFill) )then
00318         DescripVar%IntegerFill = IntegerFill
00319         DescripVar%IntegerData = IntegerFill
00320      end if
00321      ! --- For an integer list ------
00322      if ( PRESENT(ListDescrips) )then
00323         if ( .not. PRESENT(ListIntValues) )then
00324            call shr_ncio_abort( subName//': setting ListDescrips without '// &
00325                                'setting ListIntValues' )
00326         end if
00327         if ( .not. shr_string_listIsValid( ListDescrips ) )then
00328            call shr_ncio_abort( subName//': ListDescrips is not a valid '// &
00329                                'list of descriptions' )
00330         end if
00331         nList = shr_string_listGetNum( ListDescrips )
00332         if ( size(ListIntValues) /= nList )then
00333            call shr_ncio_abort( subName//': number of list descriptions '// &
00334                       'inconsistent with number of list integer values' )
00335         end if
00336         allocate( DescripVar%ListValues(nList) )
00337         DescripVar%ListDescrips  = ListDescrips
00338         DescripVar%ListValues(:) = ListIntValues(:)
00339      else
00340         if ( PRESENT(ListIntValues) )then
00341            call shr_ncio_abort( subName//': setting ListIntValues '// &
00342                                'without setting ListDescrips' )
00343         end if
00344      end if
00345   else
00346      if ( PRESENT(IntegerFill) )then
00347         call shr_ncio_abort( subName//': setting integer FillValue '// &
00348                             'without setting IntegerData' )
00349      end if
00350      if ( PRESENT(ListDescrips) .or. PRESENT(ListIntValues) )then
00351         call shr_ncio_abort( subName//': setting ListDescrips or '// &
00352                      'ListIntValues without setting IntegerData' )
00353      end if
00354   end if
00355   ! --- Logical data ------
00356   if ( PRESENT(LogicalData) )then
00357      if ( .not. NotSet ) call shr_ncio_abort( subName//': trying '// &
00358                             'to define to more than one data-type' )
00359      NotSet = .false.
00360      DescripVar%XType       = shr_ncio_logicalDataValue
00361      if ( .not. PRESENT(nDims) )then
00362         DescripVar%nDims       = 0
00363      end if
00364      if ( .not. PRESENT(Units) ) DescripVar%Units = &
00365                                     "logical flag (0=false)"
00366   end if
00367   ! --- Real-R8 data ------
00368   if ( PRESENT(RealR8Data) )then
00369      if ( .not. NotSet ) call shr_ncio_abort( &
00370          subName//': trying to define to more than one data-type' )
00371      NotSet = .false.
00372      DescripVar%XType      = shr_ncio_realR8DataValue
00373      if ( .not. PRESENT(nDims) )then
00374         DescripVar%nDims       = 0
00375      end if
00376      if ( PRESENT(RealR8Fill) )then
00377         DescripVar%RealR8Fill = RealR8Fill
00378         DescripVar%RealR8Data = RealR8Fill
00379      end if
00380   else
00381      if ( PRESENT(RealR8Fill) )then
00382         call shr_ncio_abort( subName//': setting realr8 FillValue '// &
00383                             'without setting RealR8Data' )
00384      end if
00385   end if
00386   if ( NotSet ) call shr_ncio_abort( subName//': called without giving '// &
00387                                     'a value to set' )
00388 
00389 END SUBROUTINE shr_ncio_descripInit
00390 
00391 !===============================================================================
00392 !BOP ===========================================================================
00393 !
00394 ! !IROUTINE: shr_ncio_descripPutData -- Set a ncio_descrip variable type
00395 !
00396 ! !DESCRIPTION:
00397 !
00398 ! Set the data of a ncio descrip variable. Data is set to either the string, 
00399 ! integer, logical or Real-R8 data value input. Can NOT specify more than one 
00400 ! data-type. Check that name agrees with name on variable type, or else abort.
00401 !
00402 ! !INTERFACE: ------------------------------------------------------------------
00403 
00404 SUBROUTINE shr_ncio_descripPutData( DescripVar, Name, StringData, &
00405                                     IntegerData, LogicalData, RealR8Data )
00406 
00407   implicit none
00408 
00409 ! !INPUT/OUTPUT PARAMETERS:
00410 
00411   type(shr_ncio_descripType), intent(INOUT) :: DescripVar      ! descrip variable to set
00412   character(len=*),           intent(IN)    :: Name            ! Name of this variable
00413   character(len=*), optional, intent(IN), target :: StringData ! String-data value
00414   integer, target,  optional, intent(IN)    :: IntegerData     ! Integer-data value
00415   logical, target,  optional, intent(IN)    :: LogicalData     ! Logical-data value
00416   real(SHR_KIND_R8), optional,intent(IN), target :: RealR8Data ! Real-R8-data value
00417 
00418 !EOP
00419 
00420   !----- local -----
00421    character(len=*), parameter :: subName = '(shr_ncio_descripPutData) '
00422    logical :: NotSet      ! Flag if data is not set yet
00423 
00424 !-------------------------------------------------------------------------------
00425 ! Notes:
00426 !-------------------------------------------------------------------------------
00427 
00428   ! --- Check if too many data values are set (can only be one!) ----- 
00429   if ( (PRESENT(StringData)  .and. PRESENT(IntegerData)) .or. &
00430        (PRESENT(StringData)  .and. PRESENT(LogicalData)) .or. &
00431        (PRESENT(StringData)  .and. PRESENT(RealR8Data )) .or. &
00432        (PRESENT(IntegerData) .and. PRESENT(LogicalData)) .or. &
00433        (PRESENT(IntegerData) .and. PRESENT(RealR8Data )) .or. &
00434        (PRESENT(LogicalData) .and. PRESENT(RealR8Data )) )then
00435      call shr_ncio_abort( subName//': can not set more than one variable type' )
00436   end if
00437   ! --- Make sure name is set and agrees with the input ----- 
00438   if ( DescripVar%Name == shr_ncio_stringFill )then
00439      call shr_ncio_abort( subName//': descrip variable has not been defined '// &
00440                          'yet with shr_ncio_descripInit' )
00441   else if ( trim(Name) /= trim(DescripVar%Name) )then
00442      call shr_ncio_abort( subName//': bad Name: '//trim(Name)// &
00443                          ' sent to variable already defined as:'// &
00444                          trim(DescripVar%Name) )
00445   end if
00446   NotSet = .true.
00447   !-----------------------------------------------------------------------------
00448   ! ----------- Test for each type of data ------------
00449   ! Make sure data sent in is consistent with expected type
00450   ! And track if data was set, so can abort if no data was set
00451   !-----------------------------------------------------------------------------
00452   ! --- If string data -------
00453   if ( PRESENT(StringData) )then
00454      NotSet = .false.
00455      if ( DescripVar%XType /= shr_ncio_stringDataValue )then
00456         call shr_ncio_abort( subName//': Setting descrip variable to string '// &
00457                             'which is wrong variable type' )
00458      end if
00459      if ( len_trim(StringData) > len(DescripVar%StringData) )then
00460         call shr_ncio_abort( subName//': Length of input string data longer '// &
00461                             'than storage size of DescripVar type' )
00462      end if
00463      DescripVar%StringData(1:len(DescripVar%StringData)) = ' '
00464      DescripVar%StringData(:len_trim(StringData)) = trim(StringData)
00465   end if
00466   ! --- If integer data -------
00467   if ( PRESENT(IntegerData) )then
00468      NotSet = .false.
00469      if ( DescripVar%XType /= shr_ncio_integerDataValue )then
00470         call shr_ncio_abort( subName//': Setting descrip variable to integer '// &
00471                             'which is wrong variable type' )
00472      end if
00473      DescripVar%IntegerData = IntegerData
00474   end if
00475   ! --- If logical data -------
00476   if ( PRESENT(LogicalData) )then
00477      NotSet = .false.
00478      if ( DescripVar%XType /= shr_ncio_logicalDataValue )then
00479         call shr_ncio_abort( subName//': Setting descrip variable to logical '// &
00480                             'which is wrong variable type' )
00481      end if
00482      DescripVar%LogicalData = LogicalData
00483   end if
00484   ! --- If real R8 data -------
00485   if ( PRESENT(RealR8Data) )then
00486      NotSet = .false.
00487      if ( DescripVar%XType /= shr_ncio_realR8DataValue )then
00488         call shr_ncio_abort( subName//': Setting descrip variable to realr8 '// &
00489                             'which is wrong variable type' )
00490      end if
00491      DescripVar%RealR8Data = RealR8Data
00492   end if
00493   ! --- If no data was set abort with an error -------
00494   if ( NotSet ) call shr_ncio_abort( subName//': called without giving a '// &
00495                                     'value to set' )
00496 
00497 END SUBROUTINE shr_ncio_descripPutData
00498 
00499 !===============================================================================
00500 !BOP ===========================================================================
00501 !
00502 ! !IROUTINE: shr_ncio_descripName -- Return the Name of this ncio variable
00503 !
00504 ! !DESCRIPTION:
00505 !
00506 ! Returns Name of the variable
00507 !
00508 ! !INTERFACE: ------------------------------------------------------------------
00509 
00510 FUNCTION shr_ncio_descripName( DescripVar )
00511 
00512   implicit none
00513 
00514 ! !INPUT/OUTPUT PARAMETERS:
00515 
00516   type(shr_ncio_descripType), intent(IN) :: DescripVar
00517   character(len=SHR_KIND_CS) :: shr_ncio_descripName
00518 
00519 !EOP
00520 
00521 !-------------------------------------------------------------------------------
00522 ! Notes:
00523 !-------------------------------------------------------------------------------
00524 
00525   shr_ncio_descripName = trim(DescripVar%Name)
00526 
00527 END FUNCTION shr_ncio_descripName
00528 
00529 !===============================================================================
00530 !BOP ===========================================================================
00531 !
00532 ! !IROUTINE: shr_ncio_descripGetString -- Return the string value of this ncio variable
00533 !
00534 ! !DESCRIPTION:
00535 !
00536 ! Returns the string value from this variable
00537 !
00538 ! !INTERFACE: ------------------------------------------------------------------
00539 
00540 FUNCTION shr_ncio_descripGetString( DescripVar )
00541 
00542   implicit none
00543 
00544 ! !INPUT/OUTPUT PARAMETERS:
00545 
00546   type(shr_ncio_descripType), intent(IN) :: DescripVar    ! NetCDF description variable
00547   character(len=SHR_KIND_CL) :: shr_ncio_descripGetString ! Returned string value of data
00548 
00549 !EOP
00550 
00551   !----- local -----
00552   character(len=*), parameter :: subName = '(shr_ncio_descripGetString) '
00553 
00554 !-------------------------------------------------------------------------------
00555 ! Notes:
00556 !-------------------------------------------------------------------------------
00557 
00558   ! --- If this structure hasn't been initialized yet -- abort with an error -------
00559   if ( DescripVar%Name == shr_ncio_stringFill )then
00560      call shr_ncio_abort( subName//': input shr_ncio description variable '// &
00561                          'has not been initializated yet: ' )
00562   end if
00563   ! --- If this isn't a string type of variable -- abort with an error -------
00564   if ( DescripVar%XType /= shr_ncio_stringDataValue )then
00565      call shr_ncio_abort( subName//': trying to get a string from a '// &
00566                          'different variable type' )
00567   end if
00568   shr_ncio_descripGetString(:) = ' '
00569   shr_ncio_descripGetString(1:len_trim(DescripVar%StringData)) = &
00570                       trim(DescripVar%StringData)
00571   ! --- If data not set yet abort with an error -------
00572   if ( shr_ncio_descripGetString== shr_ncio_stringFill )then
00573      call shr_ncio_abort( subName//': Returned string has not been set yet' )
00574   end if
00575 
00576 END FUNCTION shr_ncio_descripGetString
00577 
00578 !===============================================================================
00579 !BOP ===========================================================================
00580 !
00581 ! !IROUTINE: shr_ncio_descripGetInteger -- Return the integer value of this ncio variable
00582 !
00583 ! !DESCRIPTION:
00584 !
00585 ! Returns the integer value from this variable
00586 !
00587 ! !INTERFACE: ------------------------------------------------------------------
00588 
00589 integer FUNCTION shr_ncio_descripGetInteger( DescripVar )
00590 
00591   implicit none
00592 
00593 ! !INPUT/OUTPUT PARAMETERS:
00594 
00595   type(shr_ncio_descripType), intent(IN) :: DescripVar ! Input NetCDF description variable
00596 
00597 !EOP
00598 
00599    !----- local -----
00600   character(len=*), parameter :: subName = '(shr_ncio_descripGetInteger) '
00601 
00602 !-------------------------------------------------------------------------------
00603 ! Notes:
00604 !-------------------------------------------------------------------------------
00605 
00606   ! --- If this structure hasn't been initialized yet -- abort with an error -------
00607   if ( DescripVar%Name == shr_ncio_stringFill )then
00608      call shr_ncio_abort( subName//': input shr_ncio description '// &
00609                          'variable has not been initializated yet: ' )
00610   end if
00611   ! --- If this isn't a integer  type of variable -- abort with an error -------
00612   if ( DescripVar%XType /= shr_ncio_integerDataValue )then
00613      call shr_ncio_abort( subName//': trying to get an integer from a '// &
00614                          'different variable type' )
00615   end if
00616   ! --- If data not set yet abort with an error -------
00617   shr_ncio_descripGetInteger = DescripVar%IntegerData
00618   if ( shr_ncio_descripGetInteger == shr_ncio_integerFill  )then
00619      call shr_ncio_abort( subName//': Returned integer has not been set yet' )
00620   end if
00621 
00622 END FUNCTION shr_ncio_descripGetInteger
00623 
00624 !===============================================================================
00625 !BOP ===========================================================================
00626 !
00627 ! !IROUTINE: shr_ncio_descripGetLogical -- Return the logical  value of this ncio variable
00628 !
00629 ! !DESCRIPTION:
00630 !
00631 ! Returns the logical value from this variable
00632 !
00633 ! !INTERFACE: ------------------------------------------------------------------
00634 
00635 logical FUNCTION shr_ncio_descripGetLogical( DescripVar )
00636 
00637   implicit none
00638 
00639 ! !INPUT/OUTPUT PARAMETERS:
00640 
00641   type(shr_ncio_descripType), intent(IN) :: DescripVar ! Input NetCDF description variable
00642 
00643 !EOP
00644 
00645   !----- local -----
00646   character(len=*), parameter :: subName = '(shr_ncio_descripGetLogical) '
00647 
00648 !-------------------------------------------------------------------------------
00649 ! Notes:
00650 !-------------------------------------------------------------------------------
00651 
00652   ! --- If this structure hasn't been initialized yet -- abort with an error ------
00653   if ( DescripVar%Name == shr_ncio_stringFill )then
00654      call shr_ncio_abort( subName//': input shr_ncio description '// &
00655                          'variable has not been initializated yet: ' )
00656   end if
00657   ! --- If this isn't a logical type of variable -- abort with an error ------
00658   if ( DescripVar%XType /= shr_ncio_logicalDataValue )then
00659      call shr_ncio_abort( subName//': trying to get an logical from a '// &
00660                          'different variable type' )
00661   end if
00662   shr_ncio_descripGetLogical = DescripVar%LogicalData
00663 
00664 END FUNCTION shr_ncio_descripGetLogical
00665 
00666 !===============================================================================
00667 !BOP ===========================================================================
00668 !
00669 ! !IROUTINE: shr_ncio_descripGetRealR8 -- Return the realr8 value of this ncio variable
00670 !
00671 ! !DESCRIPTION:
00672 !
00673 ! Returns the realr8 value from this variable
00674 !
00675 ! !INTERFACE: ------------------------------------------------------------------
00676 
00677 real(SHR_KIND_R8) FUNCTION shr_ncio_descripGetRealR8( DescripVar )
00678 
00679   implicit none
00680 
00681 ! !INPUT/OUTPUT PARAMETERS:
00682 
00683   type(shr_ncio_descripType), intent(IN) :: DescripVar ! Input NetCDF description variable
00684 
00685 !EOP
00686 
00687   !----- local -----
00688   character(len=*), parameter :: subName = '(shr_ncio_descripGetRealR8) '
00689 
00690 !-------------------------------------------------------------------------------
00691 ! Notes:
00692 !-------------------------------------------------------------------------------
00693 
00694   ! --- If this structure hasn't been initialized yet -- abort with an error ------
00695   if ( DescripVar%Name == shr_ncio_stringFill )then
00696      call shr_ncio_abort( subName//': input shr_ncio description variable '// &
00697                          'has not been initializated yet: ' )
00698   end if
00699   ! --- If this isn't a real r8 type of variable -- abort with an error ------
00700   if ( DescripVar%XType /= shr_ncio_realR8DataValue )then
00701      call shr_ncio_abort( subName//': trying to get an real from a '// &
00702                          'different variable type' )
00703   end if
00704   ! --- If data not set yet abort with an error ------
00705   shr_ncio_descripGetRealR8 = DescripVar%RealR8Data
00706   if ( shr_ncio_descripGetRealR8 == shr_ncio_realR8Fill  )then
00707      call shr_ncio_abort( subName//': Returned realr8  has not been set yet' )
00708   end if
00709 
00710 END FUNCTION shr_ncio_descripGetRealR8
00711 
00712 !===============================================================================
00713 !BOP ===========================================================================
00714 !
00715 ! !IROUTINE: shr_ncio_descripRead  -- Read in netCDF restart file
00716 !
00717 ! !DESCRIPTION:
00718 !
00719 ! Read in restart file information from netCDF input restart file
00720 !
00721 ! !INTERFACE: ------------------------------------------------------------------
00722 
00723 SUBROUTINE shr_ncio_descripRead( ncId, nVars, prefix, mpicom, MasterTask, var )
00724 
00725 ! !USES:
00726 
00727   use shr_string_mod, only: shr_string_lastIndex
00728 
00729   use shr_mpi_mod,    only: shr_mpi_bcast
00730 
00731   implicit none
00732 
00733 ! !INPUT/OUTPUT PARAMETERS:
00734 
00735   integer,          intent(IN)           :: ncId       ! NetCDF file unit id
00736   integer,          intent(IN)           :: nVars      ! Number of variables
00737   character(len=*), intent(IN), optional :: prefix     ! Prefix in front of variable Names
00738   integer,          intent(IN), optional :: MPICom     ! MPI communicator
00739   logical,          intent(IN), optional :: MasterTask ! If Master PE task or not
00740   type(shr_ncio_descripType), intent(INOUT) :: var(:)  ! NetCDF description structure
00741   !----- local -----
00742   character(len=*), parameter :: subName = "(shr_ncio_descripRead) "
00743   logical :: MasterTask2                  ! If Master PE task or not
00744   integer :: rCode                        ! Return code
00745   integer :: nDims                        ! Number of dimensions on file
00746   integer :: VarDimIds(maxDims)           ! Array of dimension id's for this variable
00747   integer :: dimIds(maxDims)              ! Dimension id number
00748   integer :: type                         ! Type of variable
00749   integer :: i, dim                       ! Index
00750   integer :: nChars                       ! Number of characters in string
00751   integer :: n                            ! Character index
00752   character(SHR_KIND_CL) :: StringData    ! String value read in
00753   integer                :: IntegerData   ! Integer value read in
00754   real(SHR_KIND_R8)      :: RealR8Data    ! Real value to read in
00755   character(len=SHR_KIND_CS) :: prefixUse ! Prefix in front of variable Names
00756 
00757 !-------------------------------------------------------------------------------
00758 ! Notes:
00759 !   Currently this interface can NOT be used to read in non-scalar data.
00760 !-------------------------------------------------------------------------------
00761 
00762   if ( present(MasterTask) )then
00763      MasterTask2 = MasterTask
00764   else
00765      MasterTask2 = .true.
00766   end if
00767 
00768   if ( present(prefix) )then
00769      prefixUse = prefix
00770   else
00771      prefixUse = ""
00772   end if
00773   if ( MasterTask2 )then
00774      !-------------------------------------------------------------------------
00775      ! Loop through variables
00776      !-------------------------------------------------------------------------
00777      do i = 1, nVars
00778         if ( debugLevel > 1 .and. s_loglev > 0) write(s_logunit,*) 'Read variable: ', trim(var(i)%Name)
00779         ! --- If name not set, hasn't been initialized -- abort with an error -----
00780         if ( trim(var(i)%Name) == shr_ncio_stringFill )then
00781            write(s_logunit,'(a,i3,a,i3)') 'variable number = ', i, ' of ', nVars
00782            call shr_ncio_abort( subName//': variable name not defined -- '// &
00783                                'DescripVarSet not called' )
00784         end if
00785         ! --- Get variable ID -----
00786         rcode = nf90_inq_varid(ncId,trim(prefixUse)//trim(var(i)%Name),var(i)%id )
00787         call shr_ncio_abort( subName//': variable '// trim(var(i)%Name)//' not found', rcode )
00788         ! --- Get type of variable -----
00789         rcode = nf90_inquire_variable(ncId, var(i)%id, nDims=nDims, &
00790                                       XType=type )
00791         call shr_ncio_abort( subName// ': error on inquiry of '//var(i)%Name, rcode )
00792         if (nDims /= var(i)%nDims )then
00793            write(s_logunit,'(a,a,a,i4,a,i4)') 'Number of dimensions for variable', &
00794            trim(var(i)%name), ' :', nDims, ' expected:', var(i)%nDims
00795            call shr_ncio_abort( subName//': '//var(i)%Name// &
00796                                ' dimension size different than expected' )
00797         end if
00798         ! --- Read in the dimension names for this variable ----------------------
00799         do dim = 1, nDims
00800            rcode = nf90_inq_dimId(ncId, var(i)%dimNames(dim), dimIds(dim) )
00801            call shr_ncio_abort( subName// ': error gettting dimension', rcode )
00802         end do
00803         ! --- Check that dimension ids are correct -------------------------------
00804         if ( nDims > 0 )then
00805            rcode = nf90_inquire_variable(ncId, var(i)%id, dimIds=VarDimIds )
00806            if (rcode /= nf90_noerr) call shr_ncio_abort( subName// &
00807                                ': error on inquiry of dimIds'//var(i)%Name )
00808            if ( any(dimIds /= VarDimIds) ) call shr_ncio_abort( subName// &
00809                                 ': dimIds not correct' )
00810         end if
00811         ! --- If variable string data type -----
00812         if (var(i)%XType == shr_ncio_stringDataValue )then
00813            if ( type /= NF90_CHAR ) call shr_ncio_abort( subName//': '// &
00814                                         var(i)%Name//' not proper type' )
00815            rcode = nf90_get_att(ncId, var(i)%id, "nChars", nChars)
00816            if (rcode /= nf90_noerr) call shr_ncio_abort( subName// &
00817                              ': error getting nChars from : '//var(i)%Name )
00818            rcode = nf90_get_var( ncId, varid=var(i)%id, values=StringData, &
00819                                  count=(/nChars/) )
00820            if (rcode /= nf90_noerr) call shr_ncio_abort( subName// &
00821                                       ': error on get of '//var(i)%Name )
00822            var(i)%StringData(:) = ' '
00823            var(i)%StringData(:nChars) = StringData(:nChars)
00824         ! --- If integer data type --------
00825         else if (var(i)%XType == shr_ncio_integerDataValue )then
00826            if ( type /= NF90_INT ) call shr_ncio_abort( subName//': '// &
00827                                       var(i)%Name//' not proper type' )
00828            rcode = nf90_get_var( ncId, var(i)%id, IntegerData)
00829            if (rcode /= nf90_noerr) call shr_ncio_abort( subName// &
00830                                           ': error on get of '//var(i)%Name )
00831            var(i)%IntegerData = IntegerData
00832         ! --- If real r8 data type --------
00833         else if (var(i)%XType == shr_ncio_realR8DataValue )then
00834            if ( type /= NF90_DOUBLE) call shr_ncio_abort( subName//': '// &
00835                                         var(i)%Name//' not proper type' )
00836            rcode = nf90_get_var( ncId, var(i)%id, RealR8Data )
00837            if (rcode /= nf90_noerr) call shr_ncio_abort( subName// &
00838                                       ': error on get of '//var(i)%Name )
00839            var(i)%RealR8Data = RealR8Data
00840         ! --- If logical data type --------
00841         else if (var(i)%XType == shr_ncio_logicalDataValue )then
00842            if ( type /= NF90_INT ) call shr_ncio_abort( subName//': '// &
00843                                        var(i)%Name//' not proper type' )
00844            rcode = nf90_get_var( ncId, var(i)%id, IntegerData)
00845            if (rcode /= nf90_noerr) call shr_ncio_abort( subName// &
00846                                      ': error on get of '//var(i)%Name )
00847            var(i)%LogicalData = shr_ncio_logical2Int( IntegerData )
00848         ! --- Otherwise data type is unknown abort with an error --------
00849         else
00850            call shr_ncio_abort( subName//': only integer, logical, '// &
00851                  'real-r8 or character can not be read for variable ' &
00852                   //var(i)%Name )
00853         end if
00854      
00855      end do
00856   end if
00857 
00858   ! --- If MPI broadcast to other MPI tasks -----------------------------------
00859   if ( present(mpicom) )then
00860      if ( debugLevel > 1 .and. s_loglev > 0) write(s_logunit,*) 'Broadcast variables to all tasks'
00861      do i = 1, nVars
00862         if (      var(i)%XType == shr_ncio_stringDataValue )then
00863            call shr_mpi_bcast( var(i)%StringData, mpicom )
00864         else if ( var(i)%XType == shr_ncio_integerDataValue )then
00865            call shr_mpi_bcast( var(i)%IntegerData, mpicom )
00866         else if ( var(i)%XType == shr_ncio_realR8DataValue )then
00867            call shr_mpi_bcast( var(i)%RealR8Data, mpicom )
00868         else if ( var(i)%XType == shr_ncio_logicalDataValue )then
00869            call shr_mpi_bcast( var(i)%LogicalData, mpicom )
00870         else
00871            call shr_ncio_abort( subName//': invalid ncio type: ' )
00872         end if
00873      end do
00874   end if
00875 
00876 
00877 END SUBROUTINE shr_ncio_descripRead
00878 
00879 !===============================================================================
00880 !BOP ===========================================================================
00881 !
00882 ! !IROUTINE: shr_ncio_descripWrite -- Write out netCDF restart file information
00883 !
00884 ! !DESCRIPTION:
00885 !
00886 ! Write out restart file information to netCDF restart file
00887 !
00888 ! !INTERFACE: ------------------------------------------------------------------
00889 
00890 SUBROUTINE shr_ncio_descripWrite( ncId, nVars, prefix, mpicom, MasterTask, exists, &
00891                            var )
00892 
00893 ! !USES:
00894 
00895   use shr_string_mod,    only: shr_string_lastindex, shr_string_listGetName, &
00896                                shr_string_listGetNum
00897 
00898   implicit none
00899 
00900 ! !INPUT/OUTPUT PARAMETERS:
00901 
00902   integer,          intent(IN)           :: ncId      ! NetCDF file id
00903   integer,          intent(IN)           :: nVars     ! Number of variables
00904   character(len=*), intent(IN), optional :: prefix    ! Prefix in front of variable Names
00905   integer,          intent(IN), optional :: MPICom    ! MPI communicator
00906   logical,          intent(IN), optional :: MasterTask! If Master PE task or not
00907   logical,          intent(IN)           :: exists    ! If datafile exists already or not
00908   type(shr_ncio_descripType), intent(INOUT) :: var(:) ! NetCDF description structure
00909 
00910 !EOP 
00911 
00912   !----- local -----
00913   character(len=*), parameter :: subName = "(shr_ncio_descripWrite) "
00914   logical :: MasterTask2                  ! If Master PE task or not
00915   integer :: rcode                        ! NetCDF return code
00916   integer :: dimIds(maxDims)              ! Dimension id numbers
00917   integer :: i                            ! Variable index
00918   integer :: dim                          ! Dimension index
00919   logical :: NotSet                       ! If variables set yet or not
00920   logical :: DimSet                       ! If dimension set yet or not
00921   integer :: n                            ! character index
00922   integer :: type                         ! data type to write to file
00923   integer :: list                         ! List index number
00924   integer :: nList                        ! number of items in list
00925   character(len=SHR_KIND_CL) :: name      ! List description name
00926   character(len=SHR_KIND_CS) :: prefixUse ! Prefix in front of variable Names
00927   character(len=*), parameter :: F00= 
00928   "(a,' input: nciD=',i3,' nvars=',i3, ' prefix=',a,' master=',l1,' exists=',l1)"
00929 
00930 !-------------------------------------------------------------------------------
00931 ! Notes:
00932 !-------------------------------------------------------------------------------
00933 
00934   if ( present(MasterTask) )then
00935      MasterTask2 = MasterTask
00936   else
00937      MasterTask2 = .true.
00938   end if
00939 
00940   if ( present(prefix) )then
00941      prefixUse = prefix
00942   else
00943      prefixUse = ""
00944   end if
00945   !-----------------------------------------------------------------------------
00946   if ( debugLevel > 2 .and. s_loglev > 0) write(s_logunit,F00) subName, ncid, nVars, trim(prefixUse), &
00947                                      MasterTask2, exists
00948   if ( MasterTask2 )then
00949      ! --- If file already exists, go to re-define mode -----
00950      if ( exists )then
00951          rcode = nf90_redef(ncId)
00952         call shr_ncio_abort( subName// ': error on redefine output NetCDF file', rcode )
00953      end if
00954      !--------------------------------------------------------------------------
00955      ! Define variables
00956      !--------------------------------------------------------------------------
00957      do i = 1, nVars
00958         NotSet = .false.
00959         if ( debugLevel > 1 .and. s_loglev > 0) write(s_logunit,*) 'Write variable: ', trim(var(i)%Name)
00960         ! --- If file exists, check if given variable is already defined -------
00961         if ( exists )then
00962            rcode = nf90_inq_varid(ncId, Name=trim(prefixUse)//trim(var(i)%Name), &
00963                                   varid=var(i)%id )
00964            if (rcode == nf90_enotvar )then
00965               NotSet = .true.
00966            else if (rcode /= nf90_noerr)then
00967               call shr_ncio_abort( subName//': error getting variable id' )
00968            end if
00969         end if
00970         ! --- If new file or variable NOT defined, define it now ---------------
00971         if ( .not. exists .or. NotSet )then
00972            !--------------------------------------------------------------------
00973            ! Define dimensions for this variable if not already defined
00974            !--------------------------------------------------------------------
00975            do dim = 1, var(i)%nDims
00976               DimSet = .false.
00977               rcode = nf90_inq_dimId(ncId, Name=var(i)%dimNames(dim), &
00978                                      dimId=dimIds(dim))
00979               if ( rcode == nf90_ebaddim )then
00980                  DimSet = .true.
00981               else if (rcode /= nf90_noerr)then
00982                  call shr_ncio_abort( subName//': error getting correct '// &
00983                       'dimension id for :'//trim(var(i)%dimNames(dim)) )
00984               end if
00985               if ( DimSet )then
00986                  rcode = nf90_def_dim(ncId, Name=var(i)%dimNames(dim), &
00987                                       len=SHR_KIND_CL, dimId=dimIds(dim) )
00988                   call shr_ncio_abort( subName//': error writing dimension', &
00989                                        rcode )
00990               end if
00991            end do
00992            if ( var(i)%XType == shr_ncio_stringDataValue )then
00993               type = NF90_CHAR
00994            else if ( var(i)%XType == shr_ncio_integerDataValue .or. &
00995                      var(i)%XType == shr_ncio_logicalDataValue )then
00996               type = NF90_INT
00997            else if ( var(i)%XType == shr_ncio_realR8DataValue )then
00998               type = NF90_DOUBLE
00999            else
01000               call shr_ncio_abort( subName// &
01001                             ': error on variable definition: '// &
01002                             trim(var(i)%Name) )
01003            end if
01004            
01005            if ( var(i)%NDims > 0 )then
01006               rcode = nf90_def_var( ncId, trim(prefixUse)//trim(var(i)%Name), &
01007                                     type, dimIds=dimIds, varid=var(i)%id )
01008            else
01009               rcode = nf90_def_var( ncId, trim(prefixUse)//trim(var(i)%Name), &
01010                                     type, var(i)%id )
01011            end if
01012            if (rcode /= nf90_noerr) call shr_ncio_abort( subName// &
01013                             ': error on variable definition: '//   &
01014                             trim(var(i)%Name) )
01015         end if
01016         !-----------------------------------------------------------------------
01017         ! Attributes on variables
01018         !-----------------------------------------------------------------------
01019         rcode = nf90_put_att( ncId, var(i)%id, "long_name", var(i)%LongName )
01020         if (rcode /= nf90_noerr) call shr_ncio_abort( subName// &
01021                                               ': error on putting LongName '// &
01022                                               'attribute on variable: '//      &
01023                                               trim(var(i)%Name) )
01024         rcode = nf90_put_att( ncId, var(i)%id, "units", var(i)%Units )
01025         if (rcode /= nf90_noerr) call shr_ncio_abort( subName// &
01026                                     ': error on putting Units attribute '// &
01027                                     'on variable: '//trim(var(i)%Name) )
01028         if ( var(i)%XType == shr_ncio_stringDataValue )then
01029           rcode = nf90_put_att( ncId, var(i)%id, "nChars", &
01030                                 len_trim(var(i)%StringData) )
01031           if (rcode /= nf90_noerr) call shr_ncio_abort( subName// &
01032                                         ': error on putting nChars '// &
01033                                         'attribute on variable: '//    &
01034                                         trim(var(i)%Name) )
01035         end if
01036         ! --- Fill value for integer data -------
01037         if ( var(i)%IntegerFill /= shr_ncio_integerFill )then
01038           rcode = nf90_put_att( ncId, var(i)%id, "_FillValue", &
01039                                 var(i)%IntegerFill )
01040           if (rcode /= nf90_noerr) call shr_ncio_abort( subName// &
01041                                         ': error on putting _FillValue '//  &
01042                                         'integer attribute on variable: '// &
01043                                          var(i)%Name )
01044           rcode = nf90_put_att( ncId, var(i)%id, "missing_value", &
01045                                 var(i)%IntegerFill )
01046           if (rcode /= nf90_noerr) call shr_ncio_abort( subName// &
01047                                         ': error on putting missing_value'// &
01048                                         'integer attribute on variable: '//  &
01049                                         var(i)%Name )
01050         end if
01051         ! --- Fill value for real-r8 data -------
01052         if ( var(i)%RealR8Fill /= shr_ncio_realR8Fill )then
01053           rcode = nf90_put_att( ncId, var(i)%id, "_FillValue", &
01054                                 var(i)%RealR8Fill )
01055           if (rcode /= nf90_noerr) call shr_ncio_abort( subName// &
01056                                         ': error on putting _FillValue '// &
01057                                         'RealR8 attribute on variable: '// &
01058                                         var(i)%Name )
01059           rcode = nf90_put_att( ncId, var(i)%id, "missing_value", &
01060                                 var(i)%RealR8Fill )
01061           if (rcode /= nf90_noerr) call shr_ncio_abort( subName// &
01062                                         ': error on putting missing_value'// &
01063                                         'RealR8 attribute on variable: '//   &
01064                                         var(i)%Name )
01065         end if
01066         ! --- List description attributes -------------------------------------
01067         if ( var(i)%ListDescrips /= shr_ncio_stringFill )then
01068            rcode = nf90_put_att( ncId, var(i)%id, "type", "Integer list" )
01069            if (rcode /= nf90_noerr) call shr_ncio_abort( subName// &
01070                                   ': error on putting '// &
01071                                   ' type string attribute on variable: '// &
01072                                   var(i)%Name )
01073            nList = shr_string_listGetNum( var(i)%ListDescrips )
01074            do list = 1, nList
01075               call shr_string_listGetName( var(i)%ListDescrips, list, &
01076                                            name, rcode )
01077               rcode = nf90_put_att( ncId, var(i)%id, trim(name), &
01078                                     var(i)%ListValues(list) )
01079               if (rcode /= nf90_noerr) call shr_ncio_abort( subName// &
01080                               ': error on putting ' &
01081                               //name//' integer attribute on variable: '// &
01082                               var(i)%Name )
01083            end do
01084         end if
01085      end do
01086      ! --- Take it out of definition mode ------
01087      rcode = nf90_enddef( ncId )
01088      if (rcode /= nf90_noerr) call shr_ncio_abort( subName// &
01089                                            ': error ending definition mode' )
01090      !--------------------------------------------------------------------------
01091      ! Write out variables
01092      !--------------------------------------------------------------------------
01093      do i = 1, nVars
01094         if (      var(i)%XType == shr_ncio_stringDataValue )then
01095            rcode = nf90_put_var( ncId, var(i)%id, trim(var(i)%StringData), &
01096                                  count=(/len_trim(var(i)%StringData)/) )
01097         else if ( var(i)%XType == shr_ncio_integerDataValue )then
01098            rcode = nf90_put_var( ncId, var(i)%id, var(i)%IntegerData )
01099         else if ( var(i)%XType == shr_ncio_realR8DataValue )then
01100            rcode = nf90_put_var( ncId, var(i)%id, var(i)%RealR8Data )
01101         else if ( var(i)%XType == shr_ncio_logicalDataValue )then
01102            rcode = nf90_put_var( ncId, var(i)%id, shr_ncio_int2Logical( &
01103                                  var(i)%LogicalData ) )
01104         else
01105            call shr_ncio_abort( subName//': invalid ncio type: ' )
01106         end if
01107         if (rcode /= nf90_noerr) call shr_ncio_abort( subName// &
01108                                  ': error writing variable: '  &
01109                                  //var(i)%Name )
01110      end do
01111   end if
01112 END SUBROUTINE shr_ncio_descripWrite
01113 
01114 !===============================================================================
01115 !BOP ===========================================================================
01116 !
01117 ! !IROUTINE: shr_ncio_open -- Open a NetCDF file for reading, writing or appending
01118 !
01119 ! !DESCRIPTION:
01120 !
01121 ! Open NetCDF file for reading, writing or appending. If reading, or appending 
01122 ! abort if file does not exist or on error. If appending
01123 !
01124 ! !INTERFACE: ------------------------------------------------------------------
01125 
01126 subroutine shr_ncio_open( NCFileName, MasterTask, FileType, ncId, exists, &
01127                           writing, appending, clobber )
01128 
01129   implicit none
01130 
01131 ! !INPUT/OUTPUT PARAMETERS:
01132 
01133   character(len=*), intent(IN) :: NCFileName  ! Full path to input fileName to read
01134   logical, intent(IN) :: MasterTask           ! If Master PE task or not
01135   character(len=*), intent(IN) :: FileType    ! Description of file-type
01136   integer, intent(OUT) :: ncId                ! NetCDF file unit
01137   logical, intent(OUT) :: exists              ! If file exists or not
01138   logical, intent(IN), optional :: writing    ! If should open for writing
01139   logical, intent(IN), optional :: appending  ! If should open for appending
01140   logical, intent(IN), optional :: clobber    ! if exist clobber
01141 
01142 !EOP
01143 
01144   !----- local -----
01145   character(len=*), parameter :: subName = "(shr_ncio_open) "
01146   integer :: rCode                       ! Return code
01147   logical :: writing2                    ! If should open for writing
01148   logical :: appending2                  ! If should open for appending
01149   logical :: clobber2                    ! If exist clobber
01150 
01151 !-------------------------------------------------------------------------------
01152 ! Notes:
01153 !-------------------------------------------------------------------------------
01154 
01155   ! --- Only open file on MasterTask -----
01156   if ( MasterTask ) then
01157      if ( present(writing) )then
01158         writing2 = writing
01159      else
01160         writing2 = .false.
01161      end if
01162      if ( present(appending) )then
01163         appending2 = appending
01164      else
01165         appending2 = .false.
01166      end if
01167      if ( appending2 .and. writing2 )then
01168         call shr_ncio_abort( subName//': can NOT set both appending and writing option!' )
01169      end if
01170      if ( present(clobber)) then
01171         clobber2 = clobber
01172      else
01173         clobber2 = .false.
01174      end if
01175    
01176      if ( debugLevel > 0 .and. s_loglev > 0) write(s_logunit,*) 'Open NetCDF file FileType: '//trim(FileType)// &
01177                                       ' Filename: ', trim(NCFileName)
01178      inquire( file = trim(NCFileName), exist = exists )
01179      ! If file exists and reading but not appending
01180      if (      exists .and. (.not. writing2) .and. (.not. appending2) )then
01181         if ( debugLevel > 1 .and. s_loglev > 0) write(s_logunit,*) 'File exists open for reading not appending: '
01182         rCode = nf90_open( NCFileName, nf90_nowrite, ncId )
01183      ! If file exists and appending
01184      else if ( exists .and. appending2 )then
01185         if ( debugLevel > 1 .and. s_loglev > 0) write(s_logunit,*) 'File exists open for appending: '
01186         rCode = nf90_open( NCFileName, nf90_noclobber, ncId )
01187      ! If file exists and writing with no clobber
01188      else if ( exists .and. writing2 .and. .not.clobber2)then
01189         if ( debugLevel > 1 .and. s_loglev > 0) write(s_logunit,*) 'File exists open for writing: '
01190         rCode = nf90_open( NCFileName, nf90_write, ncId )
01191      ! If file exists and writing with clobber
01192      else if ( exists .and. writing2 .and. clobber2)then
01193         if ( debugLevel > 1 .and. s_loglev > 0) write(s_logunit,*) 'File exists clobber for writing: '
01194         rCode = nf90_create( NCFileName, NF90_64BIT_OFFSET, ncId )
01195      ! If file does NOT exist and writing
01196      else if ( (.not. exists) .and. writing2 )then
01197         if ( debugLevel > 1 .and. s_loglev > 0) write(s_logunit,*) 'File does NOT exist open for writing: '
01198         rCode = nf90_create( NCFileName, NF90_64BIT_OFFSET, ncId )
01199      ! If file does NOT exist and want to read or append -- flag an error
01200      else if ( .not. exists .and. ((.not. writing2) .or. appending2) )then
01201         call shr_ncio_abort( subName//': input file does not exist -- can '// &
01202                             'NOT open for reading!' )
01203      end if
01204      ! Check error code from above options...
01205      call shr_ncio_abort( subName//': error opening : '//NCFileName, rcode )
01206 
01207      if (clobber2) exists = .false.  ! it doesn't exist anymore
01208   end if
01209 
01210 end subroutine shr_ncio_open
01211 
01212 !===============================================================================
01213 !BOP ===========================================================================
01214 !
01215 ! !IROUTINE: shr_ncio_close -- Close a NetCDF file
01216 !
01217 ! !DESCRIPTION:
01218 !
01219 ! Close a NetCDF file
01220 !
01221 ! !INTERFACE: ------------------------------------------------------------------
01222 
01223 subroutine shr_ncio_close( ncId, MasterTask, NCFilename, type )
01224 
01225   implicit none
01226 
01227 ! !INPUT/OUTPUT PARAMETERS:
01228 
01229   integer, intent(IN) :: ncId                ! NetCDF file unit
01230   logical, intent(IN) :: MasterTask          ! If Master PE task or not
01231   character(len=*), optional :: NCFileName   ! Filename to close
01232   character(len=*), optional :: type         ! Type of file to close
01233 
01234 !EOP
01235 
01236   !----- local -----
01237   character(len=*), parameter :: subName = "(shr_ncio_close) "
01238   character(len=SHR_KIND_CL) :: FileName ! Filename to close
01239   character(len=SHR_KIND_CL) :: FileType ! Description of file to close
01240   integer :: rCode                       ! Return code
01241 
01242 !-------------------------------------------------------------------------------
01243 ! Notes:
01244 !-------------------------------------------------------------------------------
01245 
01246   ! --- Only close file on MasterTask -----
01247   if ( MasterTask )then
01248      if ( PRESENT(NCFileName) )then
01249        FileName = NCFileName
01250      else
01251        FileName = " "
01252      end if
01253      if ( PRESENT(type) )then
01254        FileType = type
01255      else
01256        FileType = " "
01257      end if
01258      rCode = nf90_close( ncId )
01259      if (rcode /= nf90_noerr) call shr_ncio_abort( subName// &
01260                               ': error closing '//trim(FileType)//' file: '// &
01261                               trim(FileName) )
01262   end if
01263 end subroutine shr_ncio_close
01264 
01265 !===============================================================================
01266 !BOP ===========================================================================
01267 !
01268 ! !IROUTINE: shr_ncio_setDebug -- set debug level
01269 !
01270 ! !DESCRIPTION:
01271 !
01272 ! Set debug printing level...
01273 !
01274 ! !INTERFACE: ------------------------------------------------------------------
01275 
01276 subroutine shr_ncio_setDebug(iflag)
01277 
01278   implicit none
01279 
01280 ! !INPUT/OUTPUT PARAMETERS:
01281 
01282   integer, intent(in) :: iflag    ! Flag value to set printing level to
01283 
01284 !EOP
01285 
01286   !--- local ---
01287   character(*),parameter :: subName =   "(shr_ncio_setDebug)"
01288 
01289 !-------------------------------------------------------------------------------
01290 ! Notes: 
01291 !-------------------------------------------------------------------------------
01292 
01293   debugLevel = iflag
01294 
01295 end subroutine shr_ncio_setDebug
01296 
01297 !===============================================================================
01298 !BOP ===========================================================================
01299 !
01300 ! !IROUTINE: shr_ncio_setAbort -- set abort level
01301 !
01302 ! !DESCRIPTION:
01303 !
01304 ! Set abort level...
01305 !
01306 ! !INTERFACE: ------------------------------------------------------------------
01307 
01308 subroutine shr_ncio_setAbort(flag)
01309 
01310   implicit none
01311 
01312 ! !INPUT/OUTPUT PARAMETERS:
01313 
01314   logical, intent(in) :: flag    ! Flag value to set abort level to
01315 
01316 !EOP
01317 
01318   !--- local ---
01319   character(*),parameter :: subName =   "(shr_ncio_setAbort)"
01320 
01321 !-------------------------------------------------------------------------------
01322 ! Notes: 
01323 !-------------------------------------------------------------------------------
01324 
01325   doAbort = flag
01326 
01327 end subroutine shr_ncio_setAbort
01328 
01329 !===============================================================================
01330 !BOP ===========================================================================
01331 !
01332 ! !IROUTINE: shr_ncio_logical2Int -- Return logical value based on integer input
01333 !
01334 ! !DESCRIPTION:
01335 !
01336 ! Convert integer to logical. Private to this module.
01337 !
01338 ! !INTERFACE: ------------------------------------------------------------------
01339 
01340 logical FUNCTION shr_ncio_logical2Int( int_input )
01341 
01342   implicit none
01343 
01344 ! !INPUT/OUTPUT PARAMETERS:
01345 
01346   integer, intent(IN) :: int_input      ! Integer input value to convert to logical
01347 
01348 !EOP
01349 
01350   !----- local -----
01351    character(len=*), parameter :: subName = '(shr_ncio_logical2Int) '
01352 
01353 !-------------------------------------------------------------------------------
01354 ! Notes:
01355 !-------------------------------------------------------------------------------
01356 
01357    if (      int_input == 0 )then
01358       shr_ncio_logical2Int = .false.
01359    else if ( int_input == 1 )then
01360       shr_ncio_logical2Int = .true.
01361    else
01362       call shr_ncio_abort( subName//': bad input to shr_ncio_logical2Int: ' )
01363    end if
01364 
01365 END FUNCTION shr_ncio_logical2Int
01366 
01367 !===============================================================================
01368 !BOP ===========================================================================
01369 !
01370 ! !IROUTINE: shr_ncio_int2Logical -- Return integer value based on logical input
01371 !
01372 ! !DESCRIPTION:
01373 !
01374 ! Convert logical to integer. Private to this module
01375 !
01376 ! !INTERFACE: ------------------------------------------------------------------
01377 
01378 integer FUNCTION shr_ncio_int2Logical( log_input )
01379 
01380   implicit none
01381 
01382 ! !INPUT/OUTPUT PARAMETERS:
01383 
01384   logical, intent(IN) :: log_input   ! input logical value to convert to integer
01385 
01386 !EOP
01387 
01388 !-------------------------------------------------------------------------------
01389 ! Notes:
01390 !-------------------------------------------------------------------------------
01391 
01392    if ( .not. log_input )then
01393       shr_ncio_int2Logical = 0
01394    else
01395       shr_ncio_int2Logical = 1
01396    end if
01397 
01398 END FUNCTION shr_ncio_int2Logical
01399 
01400 !===============================================================================
01401 !BOP ===========================================================================
01402 !
01403 ! !IROUTINE: shr_ncio_abort -- abort on error
01404 !
01405 ! !DESCRIPTION:
01406 !
01407 ! Private routine to abort on error
01408 !
01409 ! !INTERFACE: ------------------------------------------------------------------
01410 
01411 subroutine shr_ncio_abort( string, rcode)
01412 
01413 ! !USES:
01414 
01415    use shr_sys_mod,       only: shr_sys_abort
01416 
01417   implicit none
01418 
01419 ! !INPUT/OUTPUT PARAMETERS:
01420 
01421   character(*),optional,intent(IN) :: string  ! abort message
01422   integer,     optional,intent(IN) :: rcode   ! NetCDF error code
01423 
01424 !EOP
01425 
01426   !--- local ---
01427   character(SHR_KIND_CL) :: lstring
01428   character(*),parameter :: subName =   "(shr_ncio_abort)"
01429   character(*),parameter :: F00     = "('(shr_ncio_abort) ',a)"
01430 
01431 !-------------------------------------------------------------------------------
01432 ! Notes: 
01433 !-------------------------------------------------------------------------------
01434 
01435   if (present(rcode))then
01436      if ( rcode == nf90_noerr )then
01437         return
01438      else
01439         write(s_logunit,'(a,a,i3)') subname, ' : NetCDF error code = ', rcode
01440      end if
01441   end if
01442   lstring = ''
01443   if (present(string)) lstring = string
01444 
01445   if (doAbort) then
01446     call shr_sys_abort(lstring)
01447   else
01448     write(s_logunit,F00) ' no abort:'//trim(lstring)
01449   endif
01450 
01451 end subroutine shr_ncio_abort
01452 
01453 !===============================================================================
01454 !===============================================================================
01455 
01456 END MODULE shr_ncio_mod