da_local_to_global.inc

1 subroutine da_local_to_global(xp, x, xg, dim)
2 
3    !---------------------------------------------------------------------------
4    ! Purpose: Make xg global-grid array by gathering the subdomain arrays x from 
5    !           each processor. The global array xg is stored only on the monitor
6    !           processor (typically, processor 0). 
7    !---------------------------------------------------------------------------
8 
9    implicit none
10 
11    type (XPOSE_type), intent(in):: xp                                    ! Domain decomposition vars.
12    real,  intent(in)   :: x (xp%ims:xp%ime,xp%jms:xp%jme,xp%kms:xp%kme)  ! Local-grid input array.
13    real,  intent(out)  :: xg(xp%ids:xp%ide,xp%jds:xp%jde,xp%kds:xp%kde)  ! Global-grid output array.
14    integer, intent(in) :: dim                         ! Number of dimensions (=2 for 2D, =3 for 3D). 
15 
16    integer                      :: glen(3) ! Global grid dimensions
17    integer                      :: llen(3) ! Local grid dimensions
18 
19    ! Set global and local index extent arrays.
20    glen(1) = xp%ide-xp%ids+1
21    llen(1) = xp%ime-xp%ims+1
22    glen(2) = xp%jde-xp%jds+1
23    llen(2) = xp%jme-xp%jms+1
24    if (dim .eq. 2) then
25       glen(3) = 1
26       llen(3) = 1
27       call rsl_write(xg,IO2D_IJ_INTERNAL,x,0,true_RSL_real,glen,llen)
28    elseif (dim.eq.3) then
29       glen(3) = xp%kde-xp%kds+1
30       llen(3) = xp%kme-xp%kms+1
31       call rsl_write(xg,IO3D_IJK_inTERNAL,x,0,true_RSL_real,glen,llen)
32    else
33       write(unit=message(1),fmt='(A,I5,A)') &
34          "dim=",dim,"must be 2 or 3"
35       call da_error(__FILE__,__LINE__,message(1:1))
36    end if
37 
38 end subroutine da_local_to_global
39 
40