util/src/avg_tsfc.F

   1 program avg_tsfc
   2
   3    use date_pack
   4    use gridinfo_module
   5    use read_met_module
   6    use write_met_module
   7    use misc_definitions_module
   8    use module_debug
   9
  10    implicit none
  11
  12    ! Local variables
  13    integer :: idiff, n_times, t, istatus, fg_idx, discardtimes
  14    character (len=19) :: valid_date, temp_date
  15    character (len=128) :: input_name
  16    type (met_data) :: fg_data, avg_data
  17
  18    call get_namelist_params()
  19
  20    call set_debug_level(WARN)
  21
  22    nullify(avg_data%slab)
  23
  24    ! Compute number of times that we will process
  25    call geth_idts(end_date(1), start_date(1), idiff)
  26    call mprintf((idiff < 0),ERROR,'Ending date is earlier than starting date in namelist for domain %i.', i1=1)
  27
  28    n_times = idiff / interval_seconds
  29
  30    ! Check that the interval evenly divides the range of times to process
  31    call mprintf((mod(idiff, interval_seconds) /= 0),WARN, &
  32                 'In namelist, interval_seconds does not evenly divide '// &
  33                 '(end_date - start_date) for domain %i. Only %i time periods '// &
  34                 'will be processed.', i1=1, i2=n_times)
  35
  36    fg_idx = 1
  37
  38    input_name = fg_name(fg_idx)
  39
  40    discardtimes = mod(idiff+interval_seconds,86400) / interval_seconds
  41
  42    do while (input_name /= '*')
  43
  44       ! Loop over all times to be processed for this domain
  45       do t=0,n_times-discardtimes
  46
  47          call geth_newdate(valid_date, trim(start_date(1)), t*interval_seconds)
  48          temp_date = ' '
  49          write(temp_date,'(a19)') valid_date(1:10)//'_'//valid_date(12:19)
  50
  51          ! Initialize the module for reading in the met fields
  52          call read_met_init(trim(input_name), .false., temp_date(1:13), istatus)
  53
  54          if (istatus == 0) then
  55             call mprintf(.true.,STDOUT,'Reading from %s at time %s', s1=input_name, s2=temp_date(1:13))
  56
  57             ! Process all fields and levels from the current file; read_next_met_field()
  58             !   will return a non-zero status when there are no more fields to be read.
  59             do while (istatus == 0)
  60
  61
  62                call read_next_met_field(fg_data, istatus)
  63
  64                if (istatus == 0) then
  65
  66                   if (trim(fg_data%field) == 'TT' .and. fg_data%xlvl == 200100.) then
  67                      if (.not. associated(avg_data%slab)) then
  68                         avg_data = fg_data
  69                         avg_data%hdate = '0000-00-00_00:00:00     '
  70                         avg_data%xfcst = 0.
  71                         avg_data%xlvl = 200100.
  72                         avg_data%field = 'TAVGSFC  '
  73                         nullify(avg_data%slab)
  74                         allocate(avg_data%slab(avg_data%nx,avg_data%ny))
  75                         avg_data%slab = 0.
  76                      end if
  77
  78                      if (avg_data%nx    /= fg_data%nx .or. &
  79                          avg_data%ny    /= fg_data%ny .or. &
  80                          avg_data%iproj /= fg_data%iproj) then
  81                         call mprintf(.true.,ERROR,'Mismatch in Tsfc field dimensions in file %s', &
  82                                      s1=trim(input_name)//':'//temp_date(1:13))
  83                      end if
  84
  85                      avg_data%slab = avg_data%slab + fg_data%slab
  86                   end if
  87
  88                   if (associated(fg_data%slab)) deallocate(fg_data%slab)
  89
  90                end if
  91
  92             end do
  93
  94             call read_met_close()
  95
  96          else
  97             call mprintf(.true.,ERROR,'Problem opening %s at time %s', s1=input_name, s2=temp_date(1:13))
  98          end if
  99
 100       end do
 101
 102       if (associated(avg_data%slab)) then
 103          avg_data%slab = avg_data%slab /real(n_times-discardtimes+1)
 104
 105          call write_met_init('TAVGSFC', .true., temp_date(1:13), istatus)
 106
 107          call write_next_met_field(avg_data, istatus)
 108
 109          call write_met_close()
 110
 111          deallocate(avg_data%slab)
 112       end if
 113
 114       fg_idx = fg_idx + 1
 115       input_name = fg_name(fg_idx)
 116
 117    end do
 118
 119    call mprintf(.true.,STDOUT,' *** Successful completion of program avg_tsfc.exe *** ')
 120
 121    stop
 122
 123 end program avg_tsfc