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)