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)