test_fms/diag_manager/test_diag_manager_time.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
  20 !> @brief  This programs tests diag_manager with the following diag_table
  21 !! test_diag_manager
  22 !! 2 1 1 0 0 0
  23 !! "ocn%4yr%2mo%2dy%2hr",      1,  "days", 1, "days", "time", 1, "days", "2 1 1 0 0 0"
  24 !! "test_diag_manager_mod", "sst", "sst", "ocn%4yr%2mo%2dy%2hr",  "all", .true., "none", 2
  25
  26 program test_diag_manager_time
  27
  28 use   mpp_domains_mod
  29 use   diag_manager_mod
  30 use   fms_mod
  31 use  time_manager_mod, only: time_type, set_calendar_type, set_date, NOLEAP, JULIAN, operator(+), set_time, print_time
  32
  33 implicit none
  34
  35 type(time_type)                   :: Time
  36 integer, dimension(2)             :: layout = (/1,1/)
  37 integer :: nlon, nlat, nz
  38 type(domain2d)                    :: Domain
  39 real, dimension(:), allocatable :: x, y, z
  40 integer :: i, j
  41 integer :: is, ie, js, je
  42 real, allocatable :: sst(:,:,:), ice(:,:)
  43 integer :: id_x, id_y, id_z, id_sst, id_ice
  44 logical :: used
  45
  46 call fms_init
  47 call set_calendar_type(JULIAN)
  48 call diag_manager_init
  49
  50 nlon = 20
  51 nlat = 30
  52 nz = 5
  53
  54 call mpp_domains_set_stack_size(17280000)
  55 call mpp_define_domains( (/1,nlon,1,nlat/), layout, Domain, name='test_diag_manager')
  56 call mpp_define_io_domain(Domain, (/1,1/))
  57 call mpp_get_compute_domain(Domain, is, ie, js, je)
  58
  59 ! Set up the data
  60 allocate(x(nlon), y(nlat), z(nz))
  61 allocate(sst(is:ie,js:je,1:nz), ice(is:ie,js:je))
  62
  63 do i=1,nlon
  64   x(i) = i
  65 enddo
  66 do j=1,nlat
  67   y(j) = j
  68 enddo
  69 do i=1,nz
  70    z(i) = i
  71 enddo
  72
  73 sst = 666.66
  74 ice = 619.0
  75
  76 ! Set up the intial time
  77 Time = set_date(2,1,1,0,0,0)
  78
  79 ! Register the diags
  80 id_x  = diag_axis_init('x',  x,  'point_E', 'x', long_name='point_E', Domain2=Domain)
  81 id_y  = diag_axis_init('y',  y,  'point_N', 'y', long_name='point_N', Domain2=Domain)
  82 id_z  = diag_axis_init('z',  z,  'point_Z', 'z', long_name='point_Z')
  83 id_sst = register_diag_field  ('test_diag_manager_mod', 'sst', (/id_x,id_y,id_z/), Time, 'SST', 'K')
  84 id_ice = register_diag_field  ('test_diag_manager_mod', 'ice', (/id_x,id_y/), Time, 'ICE', 'm')
  85
  86 ! Increase the time and send data
  87 do i=1,23
  88 Time = set_date(2,1,1,i,0,0)
  89 sst = real(i)
  90 ice = real(i)
  91 if(id_sst > 0) used = send_data(id_sst, sst, Time)
  92 if(id_ice > 0) used = send_data(id_ice, ice, Time)
  93 enddo
  94
  95 call diag_manager_end(Time)
  96 call fms_end
  97
  98 end program test_diag_manager_time