da_write_kma_increments.inc

1 subroutine da_write_kma_increments(grid)
2 
3    !---------------------------------------------------------------------------
4    ! Purpose: Gathers KMA analysis increments and writes 
5    !           on "anl_inc_unit" unit 
6    !---------------------------------------------------------------------------
7 
8    implicit none
9 
10    type (domain), intent(in) :: grid
11 
12    ! Arrays for write out increments:
13    integer                                     :: ix, jy, kz
14 
15 #ifdef DM_PARALLEL
16    real, dimension(1:grid%xb%mix,1:grid%xb%mjy)          :: gbuf_2d
17    real, dimension(1:grid%xb%mix,1:grid%xb%mjy,1:grid%xb%mkz) :: gbuf
18    real, dimension(:,:)  , allocatable :: psfc_g
19    real, dimension(:,:,:), allocatable :: u_g, v_g, t_g, q_g, p_g
20 #endif
21 
22    integer                                     :: i, j, k,anl_inc_unit
23 
24    if (trace_use) call da_trace_entry("da_write_kma_increments")
25 
26    ! Dimension of the domain:
27    ix = grid%xb%mix
28    jy = grid%xb%mjy
29    kz = grid%xb%mkz
30 
31 #ifdef DM_PARALLEL
32  
33    ! 3-d and 2-d increments:
34 
35    allocate (psfc_g (1:ix,1:jy))
36    allocate (   u_g (1:ix,1:jy,1:kz))
37    allocate (   v_g (1:ix,1:jy,1:kz))
38    allocate (   t_g (1:ix,1:jy,1:kz))
39    allocate (   q_g (1:ix,1:jy,1:kz))
40    allocate (   p_g (1:ix,1:jy,1:kz))
41 
42    call da_patch_to_global(grid, grid%xa%psfc, gbuf_2d) 
43    if (rootproc) then 
44       psfc_g(1:ix,1:jy) = gbuf_2d(1:ix,1:jy) 
45    end if 
46 
47    call da_patch_to_global(grid, grid%xa%u, gbuf) 
48    if (rootproc) then 
49       u_g(1:ix,1:jy,1:kz) = gbuf(1:ix,1:jy,1:kz) 
50    end if 
51 
52    call da_patch_to_global(grid, grid%xa%v, gbuf) 
53    if (rootproc) then 
54       v_g(1:ix,1:jy,1:kz) = gbuf(1:ix,1:jy,1:kz) 
55    end if 
56 
57    call da_patch_to_global(grid, grid%xa%t, gbuf) 
58    if (rootproc) then 
59       t_g(1:ix,1:jy,1:kz) = gbuf(1:ix,1:jy,1:kz) 
60    end if 
61 
62    call da_patch_to_global(grid, grid%xa%q, gbuf) 
63    if (rootproc) then 
64       q_g(1:ix,1:jy,1:kz) = gbuf(1:ix,1:jy,1:kz) 
65    end if 
66 
67    call da_patch_to_global(grid, grid%xa%p, gbuf) 
68    if (rootproc) then 
69       p_g(1:ix,1:jy,1:kz) = gbuf(1:ix,1:jy,1:kz) 
70    end if 
71 #endif
72 
73    if (rootproc) then
74       ! 3d- and 2d-increments:
75 
76       call da_get_unit(anl_inc_unit)
77       open(unit=anl_inc_unit,file="analysis_increments_kma",status="replace", &
78          form="unformatted")
79 #ifdef DM_PARALLEL
80       write(anl_inc_unit) ((psfc_g(i,j),i=ids,ide),j=jds,jde)
81       write(anl_inc_unit) (((u_g(i,j,k),i=ids,ide),j=ids,jde),k=kds,kde)
82       write(anl_inc_unit) (((v_g(i,j,k),i=ids,ide),j=ids,jde),k=kds,kde)
83       write(anl_inc_unit) (((t_g(i,j,k),i=ids,ide),j=ids,jde),k=kds,kde)
84       write(anl_inc_unit) (((q_g(i,j,k),i=ids,ide),j=ids,jde),k=kds,kde)
85       write(anl_inc_unit) (((p_g(i,j,k),i=ids,ide),j=ids,jde),k=kds,kde)
86 #else
87       write(anl_inc_unit) ((grid%xa%psfc(i,j),i=ids,ide),j=jds,jde)
88       write(anl_inc_unit) (((grid%xa%u(i,j,k),i=ids,ide),j=jds,jde),k=kds,kde)
89       write(anl_inc_unit) (((grid%xa%v(i,j,k),i=ids,ide),j=jds,jde),k=kds,kde)
90       write(anl_inc_unit) (((grid%xa%t(i,j,k),i=ids,ide),j=jds,jde),k=kds,kde)
91       write(anl_inc_unit) (((grid%xa%q(i,j,k),i=ids,ide),j=jds,jde),k=kds,kde)
92       write(anl_inc_unit) (((grid%xa%p(i,j,k),i=ids,ide),j=jds,jde),k=kds,kde)
93 #endif
94       close(anl_inc_unit)
95       call da_free_unit(anl_inc_unit)
96    end if
97 
98    if (trace_use) call da_trace_exit("da_write_kma_increments")
99 
100 end subroutine da_write_kma_increments 
101 
102