** TAG CREATION **
[WPS-merge.git] / util / src / avg_tsfc.F
blobe0caaa29463f9db3100be831e71c3bfebfe63b77
1 program avg_tsfc
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
10    implicit none
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
18    call get_namelist_params()
20    call set_debug_level(WARN)
22    nullify(avg_data%slab)
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)
28    n_times = idiff / interval_seconds
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)
36    fg_idx = 1
38    input_name = fg_name(fg_idx)
40    discardtimes = mod(idiff+interval_seconds,86400) / interval_seconds
42    do while (input_name /= '*')
44       ! Loop over all times to be processed for this domain
45       do t=0,n_times-discardtimes
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)
51          ! Initialize the module for reading in the met fields
52          call read_met_init(trim(input_name), .false., temp_date(1:13), istatus)
54          if (istatus == 0) then
55             call mprintf(.true.,STDOUT,'Reading from %s at time %s', s1=input_name, s2=temp_date(1:13))
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)
62                call read_next_met_field(fg_data, istatus)
64                if (istatus == 0) then
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
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()
96          else
97             call mprintf(.true.,ERROR,'Problem opening %s at time %s', s1=input_name, s2=temp_date(1:13))
98          end if
100       end do 
102       if (associated(avg_data%slab)) then
103          avg_data%slab = avg_data%slab /real(n_times-discardtimes+1)
105          call write_met_init('TAVGSFC', .true., temp_date(1:13), istatus)
107          call write_next_met_field(avg_data, istatus) 
109          call write_met_close()
110   
111          deallocate(avg_data%slab)
112       end if
114       fg_idx = fg_idx + 1
115       input_name = fg_name(fg_idx)
117    end do 
119    call mprintf(.true.,STDOUT,' *** Successful completion of program avg_tsfc.exe *** ')
121    stop
123 end program avg_tsfc