!--------------------------------------- LICENCE BEGIN -----------------------------------
!Environment Canada - Atmospheric Science and Technology License/Disclaimer,
! version 3; Last Modified: May 7, 2008.
!This is free but copyrighted software; you can use/redistribute/modify it under the terms
!of the Environment Canada - Atmospheric Science and Technology License/Disclaimer
!version 3 or (at your option) any later version that should be found at:
!http://collaboration.cmc.ec.gc.ca/science/rpn.comm/license.html
!
!This software is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY;
!without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
!See the above mentioned License/Disclaimer for more details.
!You should have received a copy of the License/Disclaimer along with this software;
!if not, you can write to: EC-RPN COMM Group, 2121 TransCanada, suite 500, Dorval (Quebec),
!CANADA, H9P 1J3; or send e-mail to service.rpn@ec.gc.ca
!-------------------------------------- LICENCE END --------------------------------------
subroutine setObsMpiStrategy(lobsSpaceData, mpiStrategy) 1,16
!
! PURPOSE:
! Header indices are distributed following the chosen strategy,
! currently either "round robin" or by latitude bands.
!
use mpi_mod
use MathPhysConstants_mod
use obsSpaceData_mod
use HorizontalCoord_mod
implicit none
type(struct_obs), intent(inout) :: lobsSpaceData
character(len=*), intent(in) :: mpiStrategy
type(struct_hco), pointer :: hco_anl
real(8) :: lat_r8, lon_r8
real :: lat_r4, lon_r4
real :: xpos_r4, ypos_r4
integer :: headerIndex_mpiglobal
integer :: latIndex, lonIndex
integer :: ierr
integer :: IP, IP_x, IP_y
integer :: gdxyfll
!
!- 1. Get some info
!
!- 1.1 Get the horizontal coordinate of the analysis grid
hco_anl => hco_Get
('Analysis')
!
!- 2. Determine obs_ip according to distribution strategy
!
write(*,*)
write(*,*) 'numHeader_mpiGlobal= ',obs_numheader
(lobsSpaceData)
select case (trim(mpiStrategy))
case ('ROUNDROBIN')
!- 2.1 Distribute by round robin:
do headerIndex_mpiglobal = 1, obs_numheader
(lobsSpaceData)
IP = mod((headerIndex_mpiglobal-1),mpi_nprocs)
call obs_headSet_i
(lobsSpaceData,OBS_IP,headerIndex_mpiglobal, IP)
end do
case ('LATBANDS')
!- 2.2 Distribute by latitude band:
do headerIndex_mpiglobal = 1, obs_numheader
(lobsSpaceData)
lat_r8 = obs_headElem_r
(lobsSpaceData,OBS_LAT,headerIndex_mpiglobal)
lon_r8 = obs_headElem_r
(lobsSpaceData,OBS_LON,headerIndex_mpiglobal)
lat_r4 = real(lat_r8) * MPC_DEGREES_PER_RADIAN_R4
lon_r4 = real(lon_r8) * MPC_DEGREES_PER_RADIAN_R4
ierr = gdxyfll( hco_anl%EZscintID, & ! IN
xpos_r4, ypos_r4, & ! OUT
lat_r4, lon_r4, 1 ) ! IN
if ( trim(hco_anl%grtyp) == 'G' .and. hco_anl%ig2 == 1 ) then
! Revert latitudes since gdxyfll does not handle properly this grid type
ypos_r4 = real(hco_anl%nj,4) - ypos_r4 + 1.0
end if
latIndex = floor(ypos_r4)
IP = ( mpi_npey * (latIndex-1) ) / hco_anl%nj
call obs_headSet_i
(lobsSpaceData,OBS_IP,headerIndex_mpiglobal, IP)
end do
case ('LATLONTILES')
!- 2.3 Distribute by latitude/longitude tiles:
do headerIndex_mpiglobal = 1, obs_numheader
(lobsSpaceData)
lat_r8 = obs_headElem_r
(lobsSpaceData,OBS_LAT,headerIndex_mpiglobal)
lon_r8 = obs_headElem_r
(lobsSpaceData,OBS_LON,headerIndex_mpiglobal)
lat_r4 = real(lat_r8) * MPC_DEGREES_PER_RADIAN_R4
lon_r4 = real(lon_r8) * MPC_DEGREES_PER_RADIAN_R4
ierr = gdxyfll( hco_anl%EZscintID, & ! IN
xpos_r4, ypos_r4, & ! OUT
lat_r4, lon_r4, 1 ) ! IN
if ( trim(hco_anl%grtyp) == 'G' .and. hco_anl%ig2 == 1 ) then
! Revert latitudes since gdxyfll does not handle properly this grid type
ypos_r4 = real(hco_anl%nj,4) - ypos_r4 + 1.0
end if
latIndex = floor(ypos_r4)
lonIndex = floor(xpos_r4)
IP_y = ( mpi_npey * (latIndex-1) ) / hco_anl%nj
IP_x = ( mpi_npex * (lonIndex-1) ) / hco_anl%ni
IP = IP_x + IP_y*mpi_npex
call obs_headSet_i
(lobsSpaceData,OBS_IP,headerIndex_mpiglobal, IP)
end do
case default
write(*,*)
write(*,*) 'ERROR unknown mpiStrategy: ', trim(mpiStrategy)
stop
end select
end subroutine setObsMpiStrategy