fms/fms_io_unstructured_field_exist.inc

   1 !***********************************************************************
   2 !*                   GNU Lesser General Public License
   3 !*
   4 !* This file is part of the GFDL Flexible Modeling System (FMS).
   5 !*
   6 !* FMS is free software: you can redistribute it and/or modify it under
   7 !* the terms of the GNU Lesser General Public License as published by
   8 !* the Free Software Foundation, either version 3 of the License, or (at
   9 !* your option) any later version.
  10 !*
  11 !* FMS is distributed in the hope that it will be useful, but WITHOUT
  12 !* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  13 !* FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
  14 !* for more details.
  15 !*
  16 !* You should have received a copy of the GNU Lesser General Public
  17 !* License along with FMS.  If not, see <http://www.gnu.org/licenses/>.
  18 !***********************************************************************
  19 !----------
  20 !ug support
  21 !> @file
  22 !> @ingroup fms_io_mod
  23
  24 !>Return a flag indicating whether the inputted field exists in the inputted
  25 !!file, where the file is associated with an unstructured mpp domain.
  26 function fms_io_unstructured_field_exist(file_name, &
  27                                          field_name, &
  28                                          domain) &
  29                                          result(does_field_exist)
  30
  31    !Inputs/Outputs
  32     character(len=*),intent(in) :: file_name        !<Name of a file.
  33     character(len=*),intent(in) :: field_name       !<Name of a field.
  34     type(domainUG),intent(in)   :: domain           !<An unstructured mpp domain.
  35     logical(INT_KIND)           :: does_field_exist !<Flag telling if the inputted field exists in the inputted file.
  36
  37    !Local variables
  38     logical(INT_KIND)                        :: file_exist !<Flag telling if the inputted file
  39                                                            !! or one of its variants exists.
  40     character(len=256)                       :: fname      !<Actual name of the found file.
  41     logical(INT_KIND)                        :: read_dist  !<Flag telling if the file is "distributed"
  42                                                            !! (has IO domain tile id appended onto the end).
  43     integer(INT_KIND)                        :: funit      !<A file unit.
  44     integer(INT_KIND)                        :: nfile      !<Index of the inputted file in
  45                                                            !! the "files_read" module array.
  46     integer(INT_KIND)                        :: i          !<Loop variable.
  47     integer(INT_KIND)                        :: ndim       !<Number of dimensions in a file.
  48     integer(INT_KIND)                        :: nvar       !<Number of fields in a file.
  49     integer(INT_KIND)                        :: natt       !<Number of attributes in a file.
  50     integer(INT_KIND)                        :: ntime      !<Number of time levels in a file.
  51     character(len=64)                        :: tmp_name   !<Name of a field.
  52     type(fieldtype),dimension(:),allocatable :: fields     !<An array of fields found in the input file.
  53
  54
  55    !Set default return value for the function.
  56     does_field_exist = .false.
  57
  58    !Return if the inputted field name is in valid.
  59     if (len_trim(field_name) .eq. 0) then
  60         return
  61     endif
  62     if (field_name(1:1) .eq. ' ') then
  63         return
  64     endif
  65
  66    !Check if the file exists.
  67     file_exist = fms_io_unstructured_get_file_name(file_name, &
  68                                                    fname, &
  69                                                    read_dist, &
  70                                                    domain)
  71
  72     if (file_exist) then
  73
  74        !Get the file unit for the input file.
  75         call fms_io_unstructured_get_file_unit(fname, &
  76                                                funit, &
  77                                                nfile, &
  78                                                read_dist, &
  79                                                domain)
  80
  81        !Get the number of dimensions, fields, attributes and time levels
  82        !for the file.
  83         call mpp_get_info(funit, &
  84                           ndim, &
  85                           nvar, &
  86                           natt, &
  87                           ntime)
  88
  89        !Create an array of all fields contained in the file.
  90         allocate(fields(nvar))
  91         call mpp_get_fields(funit, &
  92                             fields)
  93
  94        !Loop through the fields to see if the inputted field name matches
  95        !any of the fields from the file.
  96         do i = 1,nvar
  97             call mpp_get_atts(fields(i), &
  98                               name=tmp_name)
  99             if (lowercase(trim(tmp_name)) .eq. lowercase(trim(field_name))) then
 100                 does_field_exist = .true.
 101             endif
 102         enddo
 103
 104        !Deallocate local allocatable.
 105         deallocate(fields)
 106     endif
 107
 108     return
 109 end function fms_io_unstructured_field_exist
 110
 111 !----------