drifters/drifters_input.F90

   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 !> @defgroup drifters_input_mod drifters_input_mod
  20 !> @ingroup drifters
  21 !> @brief Imports initial drifter positions from a netCDF file
  22
  23 !> @addtogroup drifters_input_mod
  24 !> @{
  25 module drifters_input_mod
  26   implicit none
  27   private
  28
  29   public :: drifters_input_type, drifters_input_new, drifters_input_del, drifters_input_save, assignment(=)
  30
  31   ! Globals
  32   integer, parameter, private   :: MAX_STR_LEN = 128
  33   ! Include variable "version" to be written to log file.
  34 #include<file_version.h>
  35   character, parameter, private :: SEPARATOR = ' '
  36   !> @}
  37
  38   !> @brief Input data type for drifters.
  39   !!
  40   !> @note Be sure to update drifters_input_new, drifters_input_del and drifters_input_copy_new
  41   !! when adding members
  42   !> @ingroup drifters_input_mod
  43   type drifters_input_type
  44      ! Be sure to update drifters_input_new, drifters_input_del and drifters_input_copy_new
  45      ! when adding members
  46      character(len=MAX_STR_LEN), allocatable :: position_names(:)
  47      character(len=MAX_STR_LEN), allocatable :: position_units(:)
  48      character(len=MAX_STR_LEN), allocatable :: field_names(:)
  49      character(len=MAX_STR_LEN), allocatable :: field_units(:)
  50      character(len=MAX_STR_LEN), allocatable :: velocity_names(:)
  51      real                      , allocatable :: positions(:,:)
  52      integer                   , allocatable :: ids(:)
  53      character(len=MAX_STR_LEN)               :: time_units
  54      character(len=MAX_STR_LEN)               :: title
  55      character(len=MAX_STR_LEN)               :: version
  56   end type drifters_input_type
  57
  58   !> @brief Assignment override for @ref drifters_input_type
  59   !> @ingroup drifters_input_mod
  60   interface assignment(=)
  61      module procedure drifters_input_copy_new
  62   end interface
  63
  64 !> @addtogroup drifters_input_mod
  65 !> @{
  66
  67   contains
  68
  69 !===============================================================================
  70
  71   subroutine drifters_input_new(self, filename, ermesg)
  72     use netcdf
  73     use netcdf_nf_data
  74     use netcdf_nf_interfaces
  75     type(drifters_input_type)    :: self
  76     character(len=*), intent(in) :: filename
  77     character(len=*), intent(out):: ermesg
  78
  79     ! Local
  80     integer :: ier, ncid, nd, nf, np, ipos, j, id, i, isz
  81     character(len=MAX_STR_LEN) :: attribute
  82
  83     ermesg = ''
  84
  85     ier = nf_open(filename, NF_NOWRITE, ncid)
  86     if(ier/=NF_NOERR) then
  87        ermesg = 'drifters_input: ERROR could not open netcdf file '//filename
  88        return
  89     endif
  90
  91     ! version
  92     ier = NF_PUT_ATT_TEXT(NCID, NF_GLOBAL, 'version', len(version), version)
  93
  94     ier = NF_INQ_DIMID(NCID, 'nd', id)
  95     if(ier/=NF_NOERR) then
  96        ermesg = 'drifters_input: ERROR could not find "nd" (number of dimensions)'
  97        ier = nf_close(ncid)
  98        return
  99     endif
 100     ier = NF_INQ_DIMLEN(NCID, id, nd)
 101
 102     ! determine number of fields (nf)
 103     attribute = ''
 104     ier = nf_get_att_text(ncid, NF_GLOBAL, 'field_names', attribute)
 105     isz = min(len(attribute), len(trim(attribute))+1)
 106     attribute(isz:isz) = ' '
 107     ipos = 1
 108     nf = 0
 109     do i = 1, isz
 110        if(attribute(i:i)==SEPARATOR) then
 111           nf = nf + 1
 112        endif
 113     enddo
 114
 115     ier = NF_INQ_DIMID(NCID, 'np', id)
 116     if(ier/=NF_NOERR) then
 117        ermesg = 'drifters_input: ERROR could not find "np" (number of particles)'
 118        ier = nf_close(ncid)
 119        return
 120     endif
 121     ier = NF_INQ_DIMLEN(NCID, id, np)
 122
 123     allocate(self%position_names(nd))
 124     allocate(self%position_units(nd))
 125     allocate(self%field_names(nf))
 126     allocate(self%field_units(nf))
 127     allocate(self%velocity_names(nd))
 128     allocate(self%ids(np))
 129     allocate(self%positions(nd, np))
 130
 131     ier = NF_INQ_VARID(NCID, 'ids', id)
 132     if(ier/=NF_NOERR) then
 133        ermesg = 'drifters_input: ERROR could not find "ids"'
 134        ier = nf_close(ncid)
 135        return
 136     endif
 137     ier = NF_GET_VAR_INT(NCID, id, self%ids)
 138
 139     ier = NF_INQ_VARID(NCID, 'positions', id)
 140     if(ier/=NF_NOERR) then
 141        ermesg = 'drifters_input: ERROR could not find "positions"'
 142        ier = nf_close(ncid)
 143        return
 144     endif
 145     ier = NF90_GET_VAR(NCID, id, self%positions)
 146
 147     attribute = ''
 148     ier = nf_get_att_text(ncid, NF_GLOBAL, 'version', attribute)
 149     self%version = trim(attribute)
 150
 151     attribute = ''
 152     ier = nf_get_att_text(ncid, NF_GLOBAL, 'time_units', attribute)
 153     self%time_units = trim(attribute)
 154
 155     attribute = ''
 156     ier = nf_get_att_text(ncid, NF_GLOBAL, 'title', attribute)
 157     self%title = trim(attribute)
 158
 159     attribute = ''
 160     ier = nf_get_att_text(ncid, id, 'names', attribute)
 161     isz = min(len(attribute), len(trim(attribute))+1)
 162     attribute(isz:isz) = ' '
 163     ipos = 1
 164     j = 1
 165     do i = 1, isz
 166        if(attribute(i:i)==SEPARATOR) then
 167           self%position_names(j)  = trim(adjustl(attribute(ipos:i-1)))
 168           ipos = i+1
 169           j = j + 1
 170           if(j > nd) exit
 171        endif
 172     enddo
 173
 174     attribute = ''
 175     ier = nf_get_att_text(ncid, id, 'units', attribute)
 176     isz = min(len(attribute), len(trim(attribute))+1)
 177     attribute(isz:isz) = ' '
 178     ipos = 1
 179     j = 1
 180     do i = 1, isz
 181        if(attribute(i:i)==SEPARATOR) then
 182           self%position_units(j)  = trim(adjustl(attribute(ipos:i-1)))
 183           ipos = i+1
 184           j = j + 1
 185           if(j > nd) exit
 186        endif
 187     enddo
 188
 189     attribute = ''
 190     ier = nf_get_att_text(ncid, NF_GLOBAL, 'field_names', attribute)
 191     isz = min(len(attribute), len(trim(attribute))+1)
 192     attribute(isz:isz) = ' '
 193     ipos = 1
 194     j = 1
 195     do i = 1, isz
 196        if(attribute(i:i)==SEPARATOR) then
 197           self%field_names(j)  = trim(adjustl(attribute(ipos:i-1)))
 198           ipos = i+1
 199           j = j + 1
 200           if(j > nf) exit
 201        endif
 202     enddo
 203
 204     attribute = ''
 205     ier = nf_get_att_text(ncid, NF_GLOBAL, 'field_units', attribute)
 206     isz = min(len(attribute), len(trim(attribute))+1)
 207     attribute(isz:isz) = ' '
 208     ipos = 1
 209     j = 1
 210     do i = 1, isz
 211        if(attribute(i:i)==SEPARATOR) then
 212           self%field_units(j)  = trim(adjustl(attribute(ipos:i-1)))
 213           ipos = i+1
 214           j = j + 1
 215           if(j > nf) exit
 216        endif
 217     enddo
 218
 219     attribute = ''
 220     ier = nf_get_att_text(ncid, NF_GLOBAL, 'velocity_names', attribute)
 221     isz = min(len(attribute), len(trim(attribute))+1)
 222     attribute(isz:isz) = ' '
 223     ipos = 1
 224     j = 1
 225     do i = 1, isz
 226        if(attribute(i:i)==SEPARATOR) then
 227           self%velocity_names(j)  = trim(adjustl(attribute(ipos:i-1)))
 228           ipos = i+1
 229           j = j + 1
 230           if(j > nd) exit
 231        endif
 232     enddo
 233
 234   end subroutine drifters_input_new
 235
 236 !===============================================================================
 237   subroutine drifters_input_del(self, ermesg)
 238     type(drifters_input_type)    :: self
 239     character(len=*), intent(out):: ermesg
 240
 241     integer :: iflag
 242
 243     ermesg = ''
 244
 245     deallocate(self%position_names, stat=iflag)
 246     deallocate(self%position_units, stat=iflag)
 247     deallocate(self%field_names, stat=iflag)
 248     deallocate(self%field_units, stat=iflag)
 249     deallocate(self%velocity_names, stat=iflag)
 250     deallocate(self%ids, stat=iflag)
 251     deallocate(self%positions, stat=iflag)
 252
 253   end subroutine drifters_input_del
 254
 255 !===============================================================================
 256   subroutine drifters_input_copy_new(new_instance, old_instance)
 257
 258     type(drifters_input_type), intent(inout) :: new_instance
 259     type(drifters_input_type), intent(in)    :: old_instance
 260
 261     allocate(new_instance%position_names( size(old_instance%position_names) ))
 262     allocate(new_instance%position_units( size(old_instance%position_units) ))
 263     allocate(new_instance%field_names( size(old_instance%field_names) ))
 264     allocate(new_instance%field_units( size(old_instance%field_units) ))
 265     allocate(new_instance%velocity_names( size(old_instance%velocity_names) ))
 266     new_instance%position_names = old_instance%position_names
 267     new_instance%position_units = old_instance%position_units
 268     new_instance%field_names    = old_instance%field_names
 269     new_instance%field_units    = old_instance%field_units
 270     new_instance%velocity_names = old_instance%velocity_names
 271     new_instance%time_units     = old_instance%time_units
 272     new_instance%title          = old_instance%title
 273     new_instance%version        = old_instance%version
 274     allocate(new_instance%positions( size(old_instance%positions,1),size(old_instance%positions,2) ))
 275     new_instance%positions      = old_instance%positions
 276     allocate(new_instance%ids(size(old_instance%ids)))
 277     new_instance%ids            = old_instance%ids
 278
 279   end subroutine drifters_input_copy_new
 280
 281 !===============================================================================
 282   !> @brief save state in netcdf file. can be used as restart file.
 283   subroutine drifters_input_save(self, filename, geolon, geolat, ermesg)
 284     ! save state in netcdf file. can be used as restart file.
 285     use netcdf
 286     use netcdf_nf_data
 287     use netcdf_nf_interfaces
 288     type(drifters_input_type)    :: self
 289     character(len=*), intent(in ):: filename
 290     real, intent(in), optional   :: geolon(:), geolat(:)
 291     character(len=*), intent(out):: ermesg
 292
 293
 294     integer ncid, nc_nd, nc_np, ier, nd, np, nf, nc_pos, nc_ids, i, j, n
 295     integer nc_lon, nc_lat
 296     character(len=MAX_STR_LEN) :: att
 297
 298
 299     ermesg = ''
 300
 301     ier = nf_create(filename, NF_CLOBBER, ncid)
 302     if(ier/=NF_NOERR) then
 303        ermesg = 'drifters_input: ERROR cannot create '//filename
 304        return
 305     endif
 306
 307     nd = size(self%positions, 1)
 308     np = size(self%positions, 2)
 309     nf = size(self%field_names)
 310
 311     ! dimensions
 312     ier = nf_def_dim(ncid, 'nd', nd, nc_nd)
 313     if(ier/=NF_NOERR) ermesg = 'drifters_input_save: ERROR creating dim "nd" '//nf_strerror(ier)
 314
 315     ier = nf_def_dim(ncid, 'np', np, nc_np)
 316     if(ier/=NF_NOERR) ermesg = 'drifters_input_save: ERROR creating dim "np" '//nf_strerror(ier)
 317
 318     ! global attributes
 319     ier = nf_put_att_text(ncid, NF_GLOBAL, 'title', len_trim(self%title), self%title)
 320     if(ier/=NF_NOERR) ermesg = 'drifters_input_save: ERROR setting global att "title" ' &
 321          & //nf_strerror(ier)
 322
 323     ier = nf_put_att_text(ncid, NF_GLOBAL, 'time_units', len_trim(self%time_units), self%time_units)
 324     if(ier/=NF_NOERR) ermesg = 'drifters_input_save: ERROR setting global att "time_units" ' &
 325          & //nf_strerror(ier)
 326
 327     att = ''
 328     j = 1
 329     do i = 1, nf
 330        n = len_trim(self%field_units(i))
 331        att(j:j+n+1) = trim(self%field_units(i)) // ' '
 332        j = j + n + 1
 333     enddo
 334     ier = nf_put_att_text(ncid, NF_GLOBAL, 'field_units',   len_trim(att), &
 335          & att)
 336     if(ier/=NF_NOERR) ermesg = 'drifters_input_save: ERROR setting global att "field_units" ' &
 337          & //nf_strerror(ier)
 338
 339     att = ''
 340     j = 1
 341     do i = 1, nf
 342        n = len_trim(self%field_names(i))
 343        att(j:j+n+1) = trim(self%field_names(i)) // ' '
 344        j = j + n + 1
 345     enddo
 346     ier = nf_put_att_text(ncid, NF_GLOBAL, 'field_names',   len_trim(att), &
 347          & att)
 348     if(ier/=NF_NOERR) ermesg = 'drifters_input_save: ERROR setting global att "field_names" ' &
 349          & //nf_strerror(ier)
 350
 351     att = ''
 352     j = 1
 353     do i = 1, nd
 354        n = len_trim(self%velocity_names(i))
 355        att(j:j+n+1) = trim(self%velocity_names(i)) // ' '
 356        j = j + n + 1
 357     enddo
 358     ier = nf_put_att_text(ncid, NF_GLOBAL, 'velocity_names',   len_trim(att), &
 359          & att)
 360     if(ier/=NF_NOERR) ermesg = 'drifters_input_save: ERROR setting global att "velocity_names" ' &
 361          & //nf_strerror(ier)
 362
 363     ! variables
 364     ier = nf_def_var(ncid, 'positions', NF_DOUBLE, 2, (/nc_nd, nc_np/), nc_pos)
 365     if(ier/=NF_NOERR) ermesg = 'drifters_input_save: ERROR creating var "positions" '//nf_strerror(ier)
 366
 367     ier = nf_def_var(ncid, 'ids', NF_INT, 1, (/nc_np/), nc_ids)
 368     if(ier/=NF_NOERR) ermesg = 'drifters_input_save: ERROR creating var "ids" '//nf_strerror(ier)
 369
 370     ! optional: longitudes/latitudes in deg
 371     if(present(geolon)) then
 372        ier = nf_def_var(ncid, 'longitude', NF_DOUBLE, 1, (/nc_np/), nc_lon)
 373        if(ier/=NF_NOERR) ermesg = 'drifters_input_save: ERROR creating var "longitude" ' &
 374             & //nf_strerror(ier)
 375        att = 'degrees_east'
 376        ier = nf_put_att_text(ncid, nc_lon, 'units', len(trim(att)), trim(att))
 377        if(ier/=NF_NOERR) ermesg = 'drifters_input_save: ERROR setting att "units" to "longitude" ' &
 378          & //nf_strerror(ier)
 379     endif
 380     if(present(geolat)) then
 381        ier = nf_def_var(ncid, 'latitude', NF_DOUBLE, 1, (/nc_np/), nc_lat)
 382        if(ier/=NF_NOERR) ermesg = 'drifters_input_save: ERROR creating var "latitude" ' &
 383             & //nf_strerror(ier)
 384        att = 'degrees_north'
 385        ier = nf_put_att_text(ncid, nc_lat, 'units', len(trim(att)), trim(att))
 386        if(ier/=NF_NOERR) ermesg = 'drifters_input_save: ERROR setting att "units" to "latitude" ' &
 387          & //nf_strerror(ier)
 388     endif
 389
 390     ! variable attributes
 391
 392     att = ''
 393     j = 1
 394     do i = 1, nd
 395        n = len_trim(self%position_units(i))
 396        att(j:j+n+1) = trim(self%position_units(i)) // ' '
 397        j = j + n + 1
 398     enddo
 399     ier = nf_put_att_text(ncid, nc_pos, 'units',   len_trim(att), &
 400          & att)
 401     if(ier/=NF_NOERR) ermesg = 'drifters_input_save: ERROR setting att "units" to "positions" ' &
 402          & //nf_strerror(ier)
 403
 404     att = ''
 405     j = 1
 406     do i = 1, nd
 407        n = len_trim(self%position_names(i))
 408        att(j:j+n+1) = trim(self%position_names(i)) // ' '
 409        j = j + n + 1
 410     enddo
 411     ier = nf_put_att_text(ncid, nc_pos, 'names',   len_trim(att), &
 412          & att)
 413     if(ier/=NF_NOERR) ermesg = 'drifters_input_save: ERROR setting att "names" to "positions" ' &
 414          & //nf_strerror(ier)
 415
 416     ! end of define mode
 417     ier = nf_enddef(ncid)
 418     if(ier/=NF_NOERR) ermesg = 'drifters_input_save: ERROR could not end define mode ' &
 419          & //nf_strerror(ier)
 420
 421     ! data
 422     ier = nf90_put_var(ncid, nc_pos, self%positions)
 423     if(ier/=NF_NOERR) ermesg = 'drifters_input_save: ERROR could not write "positions" ' &
 424          & //nf_strerror(ier)
 425
 426     ier = nf90_put_var(ncid, nc_ids, self%ids)
 427     if(ier/=NF_NOERR) ermesg = 'drifters_input_save: ERROR could not write "ids" ' &
 428          & //nf_strerror(ier)
 429
 430     if(present(geolon)) then
 431        ier = nf90_put_var(ncid, nc_lon, geolon)
 432        if(ier/=NF_NOERR) ermesg = 'drifters_input_save: ERROR could not write "geolon" ' &
 433             & //nf_strerror(ier)
 434     endif
 435     if(present(geolat)) then
 436        ier = nf90_put_var(ncid, nc_lat, geolat)
 437        if(ier/=NF_NOERR) ermesg = 'drifters_input_save: ERROR could not write "geolat" ' &
 438             & //nf_strerror(ier)
 439     endif
 440
 441
 442     ier = nf_close(ncid)
 443     if(ier/=NF_NOERR) ermesg = 'drifters_input_save: ERROR could not close file ' &
 444          & //nf_strerror(ier)
 445
 446   end subroutine drifters_input_save
 447
 448 end module drifters_input_mod
 449 !> @}
 450 ! close documentation grouping