Back to OASIS3-MCT home
In
oasis3-mct/lib/psmile/src :
mod_oasis_coupler.F90
:
CONTAINS
SUBROUTINE oasis_coupler_setup()
=> oasis_timer_start('cpl_setup')
=>
oasis_mpi_max(pe,model_root(n),mpi_comm_global,subname//':cg',.true.)
=> oasis_mpi_bcast
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 )
!--- arbitrary size
of read buffer, this is the chunk (big piece of data) size weights
reading
integer,parameter
:: rbuf_size = 100000
=> oasis_debug_enter(subname)
=> oasis_mpi_commsize(mpicom,commsize) ! commsize : size of local
communicator
if (mytask == 0) then
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)
if (present(ni_i) .and. present(nj_i)
.and. present(ni_o) .and. present(nj_o)) then
status = nf90_inq_varid(fid,
'src_grid_dims', vid)
status = nf90_get_var(fid, vid, dims)
endif
if (OASIS_debug >= 2)
write(nulprt,F01) "* matrix dims src x
dst : ",na,' x',nb
if (OASIS_debug >= 2)
write(nulprt,F01) "* number of non-zero elements: ",ns
endif
=> oasis_mpi_bcast(ns,mpicom,subName//" MPI in ns bcast")
! Broadcast array sizes
and allocate arrays for local storage
=> 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
rsize =
min(rbuf_size,ns)
! size of i/o chunks and size
of local array storing read data
bsize = ((ns/commsize) + 1 ) *
1.2 ! local temporary buffer size
if (ns == 0) then
nread
= 0
else
nread
= (ns-1)/rsize +
1
! num of reads to do
endif
cnt = 0
do n = 1,nread
if (mytask== 0) then
status =
nf90_inq_varid (fid,'remap_matrix'
,vid)
status =
nf90_get_var(fid,vid,remaps,start2,count2)
Sbuf(:,:) = remaps(:,:)
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)
endif
=> 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")
do m = 1,count(1) !--- should this
weight be on my pe
if (newdom == 'src') then
=> mywt = check_myindex(Rbuf(m),lsstart,lscount)
elseif (newdom == 'dst') then
=> mywt = check_myindex(Cbuf(m),lsstart,lscount)
endif
if (mywt) then
cntold = cnt
cnt = cnt + 1
Snew(1:nwgts,cnt)
= Sbuf(1:nwgts,m)
Rnew(cnt) = Rbuf(m)
Cnew(cnt) = Cbuf(m)
endif
enddo ! count
enddo ! nread
logical
function check_myindex(index,starti,counti)