da_wrfvar_finalize.f90

1 subroutine da_wrfvar_finalize
2 
3    !-------------------------------------------------------------------------
4    ! Purpose: Tidy up at the end
5    !-------------------------------------------------------------------------
6 
7    use module_domain, only : domain, head_grid
8    use da_control, only : trace_use, cost_unit, &
9       check_max_iv_unit,grad_unit,ierr,num_alpha_corr_types, &
10       num_sound_diag,rootproc,stats_unit, unit_start, &
11       unit_end, jo_unit, unit_used,alpha_corr_unit1, alpha_corr_unit2, &
12       sound_diag_unit
13    use da_radiance1, only : num_tovs_before, tovs_recv_pe,tovs_copy_count, &
14       tovs_send_pe,tovs_send_count,tovs_recv_start, num_tovs_after, &
15       tovs_send_start
16    use da_wrfvar_io, only : da_med_initialdata_output
17    use da_tracing, only : da_trace_entry, da_trace_exit
18    use da_wrfvar_top, only : config_flags
19    use da_tools1, only : da_free_unit
20    use da_wrf_interfaces, only : wrf_error_fatal,med_shutdown_io
21    use da_reporting, only : da_message
22 
23    implicit none
24 
25    integer :: i
26    type(domain), pointer :: grid
27 
28    if (trace_use) call da_trace_entry ("da_wrfvar_finalize")
29 
30    ! output wrfvar analysis
31 
32    if ((config_flags%real_data_init_type == 1) .or. &
33        (config_flags%real_data_init_type == 3)) then
34       call da_med_initialdata_output (head_grid , config_flags)
35       call med_shutdown_io (head_grid , config_flags)
36    end if
37 
38    grid => head_grid
39 
40    deallocate (grid%parents)
41    deallocate (grid%nests)
42    deallocate (grid%domain_clock)
43    deallocate (grid%alarms)
44    deallocate (grid%alarms_created)
45 
46    deallocate (grid%i_start)
47    deallocate (grid%i_end)
48    deallocate (grid%j_start)
49    deallocate (grid%j_end)
50 
51 #include "em_deallocs.inc"
52 
53    deallocate (grid)
54 
55    if (allocated(num_tovs_before)) deallocate (num_tovs_before)
56    if (allocated(num_tovs_after))  deallocate (num_tovs_after)
57    if (allocated(tovs_copy_count)) deallocate (tovs_copy_count)
58    if (allocated(tovs_send_pe))    deallocate (tovs_send_pe)
59    if (allocated(tovs_recv_pe))    deallocate (tovs_recv_pe)
60    if (allocated(tovs_send_start)) deallocate (tovs_send_start)
61    if (allocated(tovs_send_count)) deallocate (tovs_send_count)
62    if (allocated(tovs_recv_start)) deallocate (tovs_recv_start)
63 
64    if (rootproc) then
65       close (cost_unit)
66       close (grad_unit)
67       close (stats_unit)
68       close (jo_unit)
69       close (check_max_iv_unit)
70       call da_free_unit (cost_unit)
71       call da_free_unit (grad_unit)
72       call da_free_unit (stats_unit)
73       call da_free_unit (jo_unit)
74       call da_free_unit (check_max_iv_unit)
75 
76       do i=1,num_alpha_corr_types
77          close (alpha_corr_unit1(i))
78          close (alpha_corr_unit2(i))
79          call da_free_unit (alpha_corr_unit1(i))
80          call da_free_unit (alpha_corr_unit2(i))
81       end do
82       do i=1,num_sound_diag
83          call da_free_unit (sound_diag_unit(i))
84       end do
85    end if
86 
87    do i=unit_start,unit_end
88       if (unit_used(i)) then
89          write(0,*) "unit",i,"still used"
90       end if
91    end do
92 
93    call da_message ((/"SUCCESS COMPLETE WRFVAR"/))
94 
95    if (trace_use) call da_trace_exit ("da_wrfvar_finalize")
96 
97 end subroutine da_wrfvar_finalize
98 
99