Back to OASIS3-MCT home
In
oasis3-mct/lib/psmile/src :
mod_oasis_coupler.F90
:
CONTAINS
SUBROUTINE oasis_coupler_setup() ! Set up global structures prism_mapper and prism_coupler
=> oasis_debug_enter(subname)
=> oasis_timer_start('cpl_setup')
=> oasis_debug_note(subname//' set defaults for datatypes')
do n = 1,prism_amodels
if (n == compid) then
! Each root of each component sends
its variables to all the procs of all components
=>
oasis_mpi_bcast(mynvar,mpi_comm_global,'mynvar',mpi_root_global(n))
nallvar(n) = mynvar
=> call
oasis_mpi_bcast(myvar,mpi_comm_global,'myvar',mpi_root_global(n))
allvar(:,n) = myvar(:)
=> call
oasis_mpi_bcast(myops,mpi_comm_global,'myops',mpi_root_global(n))
allops(:,n) = myops(:)
SUBROUTINE
oasis_coupler_print(cplid)
SUBROUTINE oasis_coupler_genmap(mapid,namid)
SUBROUTINE oasis_coupler_sMatReaddnc(sMat,SgsMap,DgsMap,newdom,
fileName,mytask,mpicom, areasrc,areadst,ni_i,nj_i,ni_o,nj_o )
=> oasis_debug_enter(subname)
=> oasis_mpi_commsize(mpicom,commsize)
if (mytask == 0) then
=> status = nf90_open(trim(filename),NF90_NOWRITE,fid)
=> status = nf90_inq_dimid (fid, 'num_links', did) ! size of
sparse matrix
=> status = nf90_inquire_dimension(fid, did , len = ns)
=> status = nf90_inq_dimid (fid, 'src_grid_size', did) ! size
of input vector
=> status = nf90_inquire_dimension(fid, did , len = na)
=> status = nf90_inq_dimid (fid, 'dst_grid_size', did) ! size
of output vector
=> status = nf90_inquire_dimension(fid, did , len = nb)
=> status = nf90_inq_dimid (fid, 'num_wgts', did) ! size of
output vector
=> status = nf90_inquire_dimension(fid, did , len = nwgts)
endif
=> oasis_mpi_bcast(ns,mpicom,subName//" MPI in ns bcast")
=> oasis_mpi_bcast(na,mpicom,subName//" MPI in na bcast")
=> oasis_mpi_bcast(nb,mpicom,subName//" MPI in nb bcast")
=> oasis_mpi_bcast(nwgts,mpicom,subName//" MPI in nwgts bcast")
if
(newdom
== 'src') then
mygsmap
=>
DgsMap
elseif
(newdom
== 'dst') then
mygsmap
=>
SgsMap
endif
do n = 1,size(mygsmap%start)
if (mygsmap%pe_loc(n) == mytask) then ! on my pe
if (mytask== 0)
then ! Read
remap_matrix (remaps), dst_address (Rbuf) and src_address (Cbuf)
=> status = nf90_inq_varid (fid,'remap_matrix' ,vid)
=> status = nf90_get_var (fid,vid,Sbuf,start2,count2)
=> status = nf90_inq_varid (fid,'dst_address',vid)
=> status = nf90_get_var (fid,vid,Rbuf,start,count)
=> status = nf90_inq_varid (fid,'src_address',vid)
=> status = nf90_get_var (fid,vid,Cbuf,start,count)
! Broadcast them to the processes of
the model
=> oasis_mpi_bcast(Sbuf,mpicom,subName//" MPI in Sbuf
bcast")
=> oasis_mpi_bcast(Rbuf,mpicom,subName//" MPI in Rbuf bcast")
=> oasis_mpi_bcast(Cbuf,mpicom,subName//" MPI in Cbuf bcast")
! Each task keeps only the data
required, loop on each
element of Rbuf or Cbuf (do m = 1,count(1))
if (newdom == 'src') then
=> check_myindex(Rbuf(m),lsstart,lscount)
elseif (newdom == 'dst') then
=> check_myindex(Cbuf(m),lsstart,lscount)
endif
Finally if src : each proc knows
which dst_address belong to it (and then the corresponding src_address
and weights of each target point)
if dst : each proc knows which
src_address belong to it (and then the corresponding dst_address and
weights of each source point)
logical
function
check_myindex(index,starti,counti)