37 type(mct_smatp),
pointer :: smatp(:)
38 integer(kind=ip_i4_p) :: nwgts
39 character(len=ic_long):: file
40 character(len=ic_med) :: loc
41 character(len=ic_med) :: opt
42 character(len=ic_med) :: optval
44 integer(kind=ip_i4_p) :: spart
45 integer(kind=ip_i4_p) :: dpart
46 character(len=ic_med) :: srcgrid
47 character(len=ic_med) :: dstgrid
49 type(mct_avect) :: av_ms
50 type(mct_avect) :: av_md
64 real(R8),
private,
allocatable ::
snew(:,:),
sold(:,:)
86 integer(ip_i4_p),
intent(in) :: mapid
87 integer(ip_i4_p),
intent(in) :: namid
90 integer(ip_i4_p) :: src_size,src_rank, ncrn_src
91 integer(ip_i4_p) ,
allocatable :: src_dims(:),src_mask(:)
92 real(ip_double_p),
allocatable :: src_lon(:),src_lat(:)
93 real(ip_double_p),
allocatable :: src_corner_lon(:,:),src_corner_lat(:,:)
94 integer(ip_i4_p) :: dst_size,dst_rank, ncrn_dst
95 integer(ip_i4_p) ,
allocatable :: dst_dims(:),dst_mask(:)
96 real(ip_double_p),
allocatable :: dst_lon(:),dst_lat(:)
97 real(ip_double_p),
allocatable :: dst_corner_lon(:,:),dst_corner_lat(:,:)
98 integer(ip_i4_p) ,
allocatable :: ifld2(:,:)
99 real(ip_double_p),
allocatable :: fld2(:,:),fld3(:,:,:)
100 integer(ip_i4_p) :: i,j,k,icnt,nx,ny,nc
101 logical :: lextrapdone
102 logical :: do_corners
103 character(len=ic_med) :: filename
104 character(len=ic_med) :: fldname
105 character(len=*),
parameter :: subname =
'(oasis_map_genmap)' 109 lextrapdone = .false.
116 if (trim(
namscrtyp(namid)) /=
'SCALAR')
then 117 write(
nulprt,*) subname,
estr,
'only scrip type SCALAR mapping supported' 122 if (trim(
namscrmet(namid)) ==
'CONSERV')
then 128 filename =
'grids.nc' 137 trim(fldname),nx,ny,nc,do_corners
140 allocate(src_dims(src_rank))
144 allocate(src_mask(src_size))
145 allocate(src_lon(src_size))
146 allocate(src_lat(src_size))
147 allocate(src_corner_lon(ncrn_src,src_size))
148 allocate(src_corner_lat(ncrn_src,src_size))
150 allocate(ifld2(nx,ny))
151 filename =
'masks.nc' 154 icnt = 0;
do j = 1,ny;
do i = 1,nx; icnt = icnt + 1
155 src_mask(icnt) = ifld2(i,j)
157 if (
oasis_debug >= 15)
write(
nulprt,*) subname,
' read ',trim(filename),
' ',trim(fldname), &
158 minval(src_mask),maxval(src_mask)
161 allocate(fld2(nx,ny))
162 filename =
'grids.nc' 165 icnt = 0;
do j = 1,ny;
do i = 1,nx; icnt = icnt + 1
166 src_lon(icnt) = fld2(i,j)
168 if (oasis_debug >= 15)
write(nulprt,*) subname,
' read ',trim(filename),
' ',trim(fldname), &
169 minval(src_lon),maxval(src_lon)
170 fldname = trim(namsrcgrd(namid))//
'.lat' 171 call oasis_io_read_field_fromroot(filename,fldname,fld2=fld2)
172 icnt = 0;
do j = 1,ny;
do i = 1,nx; icnt = icnt + 1
173 src_lat(icnt) = fld2(i,j)
175 if (oasis_debug >= 15)
write(nulprt,*) subname,
' read ',trim(filename),
' ',trim(fldname), &
176 minval(src_lat),maxval(src_lat)
180 allocate(fld3(nx,ny,nc))
181 filename =
'grids.nc' 182 fldname = trim(namsrcgrd(namid))//
'.clo' 183 call oasis_io_read_field_fromroot(filename,fldname,fld3=fld3)
184 icnt = 0;
do j = 1,ny;
do i = 1,nx; icnt = icnt + 1
186 src_corner_lon(k,icnt) = fld3(i,j,k)
189 if (oasis_debug >= 15)
write(nulprt,*) subname,
' read ',trim(filename),
' ',trim(fldname), &
190 minval(src_corner_lon),maxval(src_corner_lon)
191 fldname = trim(namsrcgrd(namid))//
'.cla' 192 call oasis_io_read_field_fromroot(filename,fldname,fld3=fld3)
193 icnt = 0;
do j = 1,ny;
do i = 1,nx; icnt = icnt + 1
195 src_corner_lat(k,icnt) = fld3(i,j,k)
198 if (oasis_debug >= 15)
write(nulprt,*) subname,
' read ',trim(filename),
' ',trim(fldname), &
199 minval(src_corner_lat),maxval(src_corner_lat)
202 src_corner_lon = -9999.
203 src_corner_lat = -9999.
208 filename =
'grids.nc' 210 fldname = trim(namdstgrd(namid))//
'.clo' 211 call oasis_io_read_field_fromroot(filename,fldname,nx=nx,ny=ny,nz=nc)
213 fldname = trim(namdstgrd(namid))//
'.lon' 214 call oasis_io_read_field_fromroot(filename,fldname,nx=nx,ny=ny)
216 if (oasis_debug >= 15)
write(nulprt,*) subname,
' read ',trim(filename),
' ',trim(fldname),nx,ny,nc
219 allocate(dst_dims(dst_rank))
223 allocate(dst_mask(dst_size))
224 allocate(dst_lon(dst_size))
225 allocate(dst_lat(dst_size))
226 allocate(dst_corner_lon(ncrn_dst,dst_size))
227 allocate(dst_corner_lat(ncrn_dst,dst_size))
229 allocate(ifld2(nx,ny))
230 filename =
'masks.nc' 231 fldname = trim(namdstgrd(namid))//
'.msk' 232 call oasis_io_read_field_fromroot(filename,fldname,ifld2=ifld2)
233 icnt = 0;
do j = 1,ny;
do i = 1,nx; icnt = icnt + 1
234 dst_mask(icnt) = ifld2(i,j)
236 if (oasis_debug >= 15)
write(nulprt,*) subname,
' read ',trim(filename),
' ',trim(fldname), &
237 minval(dst_mask),maxval(dst_mask)
240 allocate(fld2(nx,ny))
241 filename =
'grids.nc' 242 fldname = trim(namdstgrd(namid))//
'.lon' 243 call oasis_io_read_field_fromroot(filename,fldname,fld2=fld2)
244 icnt = 0;
do j = 1,ny;
do i = 1,nx; icnt = icnt + 1
245 dst_lon(icnt) = fld2(i,j)
247 if (oasis_debug >= 15)
write(nulprt,*) subname,
' read ',trim(filename),
' ',trim(fldname), &
248 minval(dst_lon),maxval(dst_lon)
249 fldname = trim(namdstgrd(namid))//
'.lat' 250 call oasis_io_read_field_fromroot(filename,fldname,fld2=fld2)
251 icnt = 0;
do j = 1,ny;
do i = 1,nx; icnt = icnt + 1
252 dst_lat(icnt) = fld2(i,j)
254 if (oasis_debug >= 15)
write(nulprt,*) subname,
' read ',trim(filename),
' ',trim(fldname), &
255 minval(dst_lat),maxval(dst_lat)
259 allocate(fld3(nx,ny,nc))
260 filename =
'grids.nc' 261 fldname = trim(namdstgrd(namid))//
'.clo' 262 call oasis_io_read_field_fromroot(filename,fldname,fld3=fld3)
263 icnt = 0;
do j = 1,ny;
do i = 1,nx; icnt = icnt + 1
265 dst_corner_lon(k,icnt) = fld3(i,j,k)
268 if (oasis_debug >= 15)
write(nulprt,*) subname,
' read ',trim(filename),
' ',trim(fldname), &
269 minval(dst_corner_lon),maxval(dst_corner_lon)
270 fldname = trim(namdstgrd(namid))//
'.cla' 271 call oasis_io_read_field_fromroot(filename,fldname,fld3=fld3)
272 icnt = 0;
do j = 1,ny;
do i = 1,nx; icnt = icnt + 1
274 dst_corner_lat(k,icnt) = fld3(i,j,k)
277 if (oasis_debug >= 15)
write(nulprt,*) subname,
' read ',trim(filename),
' ',trim(fldname), &
278 minval(dst_corner_lat),maxval(dst_corner_lat)
281 dst_corner_lon = -9999.
282 dst_corner_lat = -9999.
285 IF (oasis_debug >= 15)
THEN 286 WRITE(nulprt,*) subname,
' call grid_init ' 287 CALL oasis_flush(nulprt)
291 src_mask = 1 - src_mask
292 dst_mask = 1 - dst_mask
293 call grid_init(namscrmet(namid),namscrres(namid),namscrbin(namid), &
294 src_size, dst_size, src_dims, dst_dims, &
295 src_rank, dst_rank, ncrn_src, ncrn_dst, &
296 src_mask, dst_mask, namsrcgrd(namid), namdstgrd(namid), &
297 src_lat, src_lon, dst_lat, dst_lon, &
298 src_corner_lat, src_corner_lon, &
299 dst_corner_lat, dst_corner_lon, &
300 ilogunit=nulprt,ilogprt=oasis_debug)
301 if (oasis_debug >= 15)
then 302 WRITE(nulprt,*) subname,
' done grid_init ' 303 CALL oasis_flush(nulprt)
306 IF (oasis_debug >= 15)
THEN 307 WRITE(nulprt,*) subname,
' call scrip ' 308 CALL oasis_flush(nulprt)
312 namscrnor(namid),lextrapdone,namscrvam(namid),namscrnbr(namid),namscrord(namid), &
313 mpi_comm_map, mpi_size_map, mpi_rank_map, mpi_root_map)
315 IF (oasis_debug >= 15)
THEN 316 WRITE(nulprt,*) subname,
' done scrip ' 317 CALL oasis_flush(nulprt)
320 deallocate(src_dims, dst_dims)
324 deallocate(src_corner_lon)
325 deallocate(src_corner_lat)
329 deallocate(dst_corner_lon)
330 deallocate(dst_corner_lat)
333 call oasis_debug_exit(subname)
375 fileName,mytask,mpicom,nwgts, &
376 areasrc,areadst,ni_i,nj_i,ni_o,nj_o )
381 integer,
parameter :: R8 = ip_double_p
382 integer,
parameter :: IN = ip_i4_p
386 type(mct_smat) ,
intent(out),
pointer :: sMat(:)
387 type(mct_gsmap) ,
intent(in) ,
target :: SgsMap
388 type(mct_gsmap) ,
intent(in) ,
target :: DgsMap
389 character(*) ,
intent(in) :: newdom
391 character(*) ,
intent(in) :: filename
392 integer(IN) ,
intent(in) :: mytask
393 integer(IN) ,
intent(in) :: mpicom
394 integer(IN) ,
intent(out) :: nwgts
395 type(mct_avect) ,
intent(out),
optional :: areasrc
396 type(mct_avect) ,
intent(out),
optional :: areadst
397 integer(IN) ,
intent(out),
optional :: ni_i
398 integer(IN) ,
intent(out),
optional :: nj_i
399 integer(IN) ,
intent(out),
optional :: ni_o
400 integer(IN) ,
intent(out),
optional :: nj_o
425 logical :: abort_weight
428 real(R8) ,
allocatable :: rtemp(:)
429 real(R8) ,
allocatable :: Sbuf(:,:)
430 real(R8) ,
allocatable :: remaps(:,:)
431 integer,
allocatable :: Rbuf(:)
432 integer,
allocatable :: Cbuf(:)
437 integer,
allocatable :: lsstart(:)
438 integer,
allocatable :: lscount(:)
439 type(mct_gsmap),
pointer :: mygsmap
444 real(R8) ,
allocatable :: Snew(:,:),Sold(:,:)
445 integer,
allocatable :: Rnew(:),Rold(:)
446 integer,
allocatable :: Cnew(:),Cold(:)
448 character,
allocatable :: str(:)
449 character(len=ic_long):: attstr
455 integer,
parameter :: rbuf_size = 100000
458 type(mct_avect) :: areasrc0
459 type(mct_avect) :: areadst0
461 character(*),
parameter :: areaAV_field =
'aream' 464 character(*),
parameter :: subName =
'(oasis_map_sMatReaddnc_orig)' 470 call oasis_debug_enter(subname)
471 call oasis_mpi_commsize(mpicom,commsize)
475 if (mytask == 0)
then 476 if (oasis_debug >= 2)
write(nulprt,*) subname,
" reading mapping matrix data decomposed..." 482 if (oasis_debug >=2 )
write(nulprt,*) subname,
" * file name : ",trim(filename)
483 status = nf90_open(trim(filename),nf90_nowrite,fid)
484 if (status /= nf90_noerr)
then 485 write(nulprt,*) subname,
' nf90_strerror = ',trim(nf90_strerror(status))
486 WRITE(nulprt,*) subname,estr,
'mapping file not found = ',trim(filename)
487 call oasis_abort(file=__file__,line=__line__)
492 status = nf90_inq_dimid(fid,
'num_links', did)
493 status = nf90_inquire_dimension(fid, did , len = ns)
495 status = nf90_inq_dimid(fid,
'src_grid_size', did)
496 status = nf90_inquire_dimension(fid, did , len = na)
498 status = nf90_inq_dimid(fid,
'dst_grid_size', did)
499 status = nf90_inquire_dimension(fid, did , len = nb)
500 status = nf90_inq_dimid(fid,
'num_wgts', did)
501 status = nf90_inquire_dimension(fid, did , len = nwgts)
503 if (
present(ni_i) .and.
present(nj_i) .and.
present(ni_o) .and.
present(nj_o))
then 512 status = nf90_inq_varid(fid,
'src_grid_dims', vid)
513 status = nf90_get_var(fid, vid, dims)
516 status = nf90_inq_varid(fid,
'dst_grid_dims', vid)
517 status = nf90_get_var(fid, vid, dims)
522 if (oasis_debug >= 2)
write(nulprt,*) subname,
" * matrix dims src x dst : ",na,
' x',nb
523 if (oasis_debug >= 2)
write(nulprt,*) subname,
" * number of non-zero elements: ",ns
531 if (
present(areasrc))
then 532 if (mytask == 0)
then 533 call mct_avect_init(areasrc0,
' ',areaav_field,na)
535 status = nf90_inq_varid(fid,
'src_grid_area',vid)
536 IF (status /= nf90_noerr)
THEN 537 WRITE(nulprt,*) subname,
' nf90_strerrr = ',trim(nf90_strerror(status))
538 WRITE(nulprt,*) subname,
'model :',compid,
' proc :',mpi_rank_local
539 CALL oasis_flush(nulprt)
541 status = nf90_get_var(fid, vid, areasrc0%rAttr)
542 IF (status /= nf90_noerr)
THEN 543 WRITE(nulprt,*) subname,
' nf90_strerror = ',trim(nf90_strerror(status))
544 WRITE(nulprt,*) subname,
'model :',compid,
' proc :',mpi_rank_local
545 CALL oasis_flush(nulprt)
548 call mct_avect_scatter(areasrc0, areasrc, sgsmap, 0, mpicom, status)
549 if (status /= 0)
call mct_die(subname,
"Error on scatter of areasrc0")
550 if (mytask == 0)
then 557 call mct_avect_clean(areasrc0)
565 if (
present(areadst))
then 566 if (mytask == 0)
then 567 call mct_avect_init(areadst0,
' ',areaav_field,nb)
569 status = nf90_inq_varid(fid,
'dst_grid_area',vid)
570 IF (status /= nf90_noerr)
THEN 571 WRITE(nulprt,*) subname,
' nf90_strerror = ',trim(nf90_strerror(status))
572 WRITE(nulprt,*) subname,
'model :',compid,
' proc :',mpi_rank_local
573 CALL oasis_flush(nulprt)
575 status = nf90_get_var(fid, vid, areadst0%rAttr)
576 IF (status /= nf90_noerr)
THEN 577 WRITE(nulprt,*) subname,
' nf90_strerror = ',trim(nf90_strerror(status))
578 WRITE(nulprt,*) subname,
'model :',compid,
' proc :',mpi_rank_local
579 CALL oasis_flush(nulprt)
582 call mct_avect_scatter(areadst0, areadst, dgsmap, 0, mpicom, status)
583 if (status /= 0)
call mct_die(subname,
"Error on scatter of areadst0")
584 if (mytask == 0)
then 591 call mct_avect_clean(areadst0)
599 if (
present(ni_i) .and.
present(nj_i) .and.
present(ni_o) .and.
present(nj_o))
then 600 call oasis_mpi_bcast(ni_i,mpicom,subname//
" MPI in ni_i bcast")
601 call oasis_mpi_bcast(nj_i,mpicom,subname//
" MPI in nj_i bcast")
602 call oasis_mpi_bcast(ni_o,mpicom,subname//
" MPI in ni_o bcast")
603 call oasis_mpi_bcast(nj_o,mpicom,subname//
" MPI in nj_o bcast")
610 call oasis_mpi_bcast(ns,mpicom,subname//
" MPI in ns bcast")
611 call oasis_mpi_bcast(na,mpicom,subname//
" MPI in na bcast")
612 call oasis_mpi_bcast(nb,mpicom,subname//
" MPI in nb bcast")
613 call oasis_mpi_bcast(nwgts,mpicom,subname//
" MPI in nwgts bcast")
618 if (newdom ==
'src')
then 620 elseif (newdom ==
'dst')
then 623 write(nulprt,*) subname,estr,
'invalid newdom value, expect src or dst = ',newdom
624 call oasis_abort(file=__file__,line=__line__)
627 do n = 1,
size(mygsmap%start)
628 if (mygsmap%pe_loc(n) == mytask)
then 632 allocate(lsstart(lsize),lscount(lsize),stat=status)
633 if (status /= 0)
call mct_perr_die(subname,
':: allocate Lsstart',status)
640 do n = 1,
size(mygsmap%start)
641 if (mygsmap%pe_loc(n) == mytask)
then 645 do while (.not.found .and. l1 < lsize)
646 if (mygsmap%start(n) < lsstart(l1))
then 647 do l2 = lsize, l1+1, -1
648 lsstart(l2) = lsstart(l2-1)
649 lscount(l2) = lscount(l2-1)
656 lsstart(l1) = mygsmap%start(n)
657 lscount(l1) = mygsmap%length(n)
661 if (lsstart(n) > lsstart(n+1))
then 662 write(nulprt,*) subname,estr,
'lsstart not properly sorted' 663 call oasis_abort(file=__file__,line=__line__)
673 rsize = min(rbuf_size,ns)
674 bsize = ((ns/commsize) + 1 ) * 1.2
678 nread = (ns-1)/rsize + 1
685 if (mytask == 0)
then 686 allocate(remaps(nwgts,rsize),stat=status)
687 if (status /= 0)
call mct_perr_die(subname,
':: allocate remaps',status)
689 allocate(smat(nwgts),stat=status)
690 if (status /= 0)
call mct_perr_die(subname,
':: allocate Smat',status)
691 allocate(sbuf(nwgts,rsize),rbuf(rsize),cbuf(rsize),stat=status)
692 if (status /= 0)
call mct_perr_die(subname,
':: allocate Sbuf',status)
693 allocate(snew(nwgts,bsize),cnew(bsize),rnew(bsize),stat=status)
694 if (status /= 0)
call mct_perr_die(subname,
':: allocate Snew1',status)
702 start(1) = (n-1)*rsize + 1
703 count(1) = min(rsize,ns-start(1)+1)
715 status = nf90_inq_varid(fid,
'remap_matrix' ,vid)
717 status = nf90_get_var(fid,vid,remaps,start2,count2)
718 sbuf(:,:) = remaps(:,:)
719 IF (status /= nf90_noerr)
THEN 720 WRITE(nulprt,*) subname,
' nf90_strerror = ',trim(nf90_strerror(status))
721 WRITE(nulprt,*) subname,
'model :',compid,
' proc :',mpi_rank_local
722 CALL oasis_flush(nulprt)
726 status = nf90_inq_varid(fid,
'dst_address',vid)
727 status = nf90_get_var(fid,vid,rbuf,start,count)
728 IF (status /= nf90_noerr)
THEN 729 WRITE(nulprt,*) subname,
' nf90_strerror = ',trim(nf90_strerror(status))
730 WRITE(nulprt,*) subname,
'model :',compid,
' proc :',mpi_rank_local
731 CALL oasis_flush(nulprt)
735 status = nf90_inq_varid(fid,
'src_address',vid)
736 status = nf90_get_var(fid,vid,cbuf,start,count)
737 IF (status /= nf90_noerr)
THEN 738 WRITE(nulprt,*) subname,
' nf90_strerror = ',trim(nf90_strerror(status))
739 WRITE(nulprt,*) subname,
'model :',compid,
' proc :',mpi_rank_local
740 CALL oasis_flush(nulprt)
748 call oasis_mpi_bcast(sbuf,mpicom,subname//
" MPI in Sbuf bcast")
749 call oasis_mpi_bcast(rbuf,mpicom,subname//
" MPI in Rbuf bcast")
750 call oasis_mpi_bcast(cbuf,mpicom,subname//
" MPI in Cbuf bcast")
756 if (namwgtopt ==
"abort_on_bad_index")
then 757 abort_weight = .false.
760 if ((rbuf(m) <= 0 .or. rbuf(m) > nb .or. &
761 cbuf(m) <= 0 .or. cbuf(m) > na) &
763 .and. (minval(sbuf(:,m)) /= 0._r8 .or. maxval(sbuf(:,m)) /= 0._r8) &
765 abort_weight = .true.
766 WRITE(nulprt,
'(3A,I12,A,I12,A,I12,A,G13.7,A,G13.7,A)') &
767 subname,wstr,
'BAD weight found in '//trim(filename), &
768 m,
'=id',cbuf(m),
'=src',rbuf(m),
'=dst',minval(sbuf(:,m)),
'=minS',maxval(sbuf(:,m)),
'=maxS' 771 if (abort_weight)
then 772 WRITE(nulprt,*) subname,wstr,
'BAD weight found, aborting' 773 call oasis_abort(file=__file__,line=__line__)
779 if ((namwgtopt(1:16) ==
"ignore_bad_index") .and. &
780 (rbuf(m) <= 0 .or. rbuf(m) > nb .or. &
781 cbuf(m) <= 0 .or. cbuf(m) > na))
then 784 if (minval(sbuf(:,m)) /= 0._r8 .or. maxval(sbuf(:,m)) /= 0._r8)
then 785 if (oasis_debug >= 2 .and. namwgtopt /=
"ignore_bad_index_silently")
then 786 WRITE(nulprt,
'(3A,I12,A,I12,A,I12,A,G13.7,A,G13.7,A)') &
787 subname,wstr,
'BAD weight found in '//trim(filename), &
788 m,
'=id',cbuf(m),
'=src',rbuf(m),
'=dst',minval(sbuf(:,m)),
'=minS',maxval(sbuf(:,m)),
'=maxS' 791 elseif (newdom ==
'src')
then 793 elseif (newdom ==
'dst')
then 804 if (cnt > bsize)
then 806 allocate(sold(1:nwgts,cntold),rold(cntold),cold(cntold),stat=status)
807 if (status /= 0)
call mct_perr_die(subname,
':: allocate old',status)
808 sold(1:nwgts,1:cntold) = snew(1:nwgts,1:cntold)
809 rold(1:cntold) = rnew(1:cntold)
810 cold(1:cntold) = cnew(1:cntold)
813 deallocate(snew,rnew,cnew,stat=status)
814 if (status /= 0)
call mct_perr_die(subname,
':: allocate new',status)
816 if (oasis_debug > 15)
write(nulprt,*) subname,
' reallocate bsize to ',bsize
817 allocate(snew(nwgts,bsize),rnew(bsize),cnew(bsize),stat=status)
818 if (status /= 0)
call mct_perr_die(subname,
':: allocate old',status)
821 snew(1:nwgts,1:cntold) = sold(1:nwgts,1:cntold)
822 rnew(1:cntold) = rold(1:cntold)
823 cnew(1:cntold) = cold(1:cntold)
824 deallocate(sold,rold,cold,stat=status)
825 if (status /= 0)
call mct_perr_die(subname,
':: deallocate old',status)
828 snew(1:nwgts,cnt) = sbuf(1:nwgts,m)
839 if (mytask == 0)
then 840 deallocate(remaps, stat=status)
841 if (status /= 0)
call mct_perr_die(subname,
':: deallocate remaps',status)
843 deallocate(sbuf,rbuf,cbuf, stat=status)
844 if (status /= 0)
call mct_perr_die(subname,
':: deallocate Sbuf',status)
856 call mct_smat_init(smat(n), nb, na, cnt)
859 igrow = mct_smat_indexia(smat(1),
'grow')
860 igcol = mct_smat_indexia(smat(1),
'gcol')
861 iwgt = mct_smat_indexra(smat(1),
'weight')
865 smat(n)%data%rAttr(iwgt ,1:cnt) = snew(n,1:cnt)
866 smat(n)%data%iAttr(igrow,1:cnt) = rnew(1:cnt)
867 smat(n)%data%iAttr(igcol,1:cnt) = cnew(1:cnt)
877 deallocate(snew,rnew,cnew, stat=status)
878 deallocate(lsstart,lscount,stat=status)
879 if (status /= 0)
call mct_perr_die(subname,
':: deallocate new',status)
881 if (mytask == 0)
then 882 status = nf90_close(fid)
883 IF (oasis_debug >= 2)
THEN 884 WRITE(nulprt,*) subname,
" ... done reading file" 885 CALL oasis_flush(nulprt)
890 call oasis_debug_exit(subname)
929 fileName,mytask,mpicom,nwgts, &
930 areasrc,areadst,ni_i,nj_i,ni_o,nj_o )
936 type(mct_smat) ,
intent(out),
pointer :: sMat(:)
937 type(mct_gsmap) ,
intent(in) ,
target :: SgsMap
938 type(mct_gsmap) ,
intent(in) ,
target :: DgsMap
939 character(*) ,
intent(in) :: newdom
941 character(*) ,
intent(in) :: filename
942 integer(IN) ,
intent(in) :: mytask
943 integer(IN) ,
intent(in) :: mpicom
944 integer(IN) ,
intent(out) :: nwgts
945 type(mct_avect) ,
intent(out),
optional :: areasrc
946 type(mct_avect) ,
intent(out),
optional :: areadst
947 integer(IN) ,
intent(out),
optional :: ni_i
948 integer(IN) ,
intent(out),
optional :: nj_i
949 integer(IN) ,
intent(out),
optional :: ni_o
950 integer(IN) ,
intent(out),
optional :: nj_o
974 logical :: abort_weight
977 real(R8) ,
allocatable :: rtemp(:)
978 real(R8) ,
allocatable :: Sbuf(:,:)
979 real(R8) ,
allocatable :: remaps(:,:)
980 integer,
allocatable :: Rbuf(:)
981 integer,
allocatable :: Cbuf(:)
982 real(R8),
allocatable :: SReadData(:,:)
983 integer,
allocatable :: RReadData(:)
984 integer,
allocatable :: CReadData(:)
985 integer,
allocatable :: pesave(:)
986 real(R8),
allocatable :: SDistData(:,:)
987 integer,
allocatable :: RDistData(:)
988 integer,
allocatable :: CDistData(:)
992 type(mct_gsmap),
pointer :: mygsmap
993 integer :: l1,l2,lsize
994 integer,
allocatable :: lsstart(:)
995 integer,
allocatable :: lscount(:)
996 integer,
allocatable :: lspeloc(:)
997 integer,
allocatable :: sortkey(:)
1002 integer,
allocatable :: cntrs(:)
1003 integer :: mpistatus(mpi_status_size)
1005 character,
allocatable :: str(:)
1006 character(len=ic_long):: attstr
1012 integer,
parameter :: rbuf_size = 100000
1013 integer :: dimbuffer(8)
1016 type(mct_avect) :: areasrc0
1017 type(mct_avect) :: areadst0
1019 character(*),
parameter :: areaAV_field =
'aream' 1022 character(*),
parameter :: subName =
'(oasis_map_sMatReaddnc_ceg)' 1023 character*80 :: fname
1029 call oasis_debug_enter(subname)
1030 call oasis_mpi_commsize(mpicom,commsize)
1034 if (mytask == 0)
then 1035 if (oasis_debug >= 2)
write(nulprt,*) subname,
" reading mapping matrix data decomposed..." 1041 if (oasis_debug >=2 )
write(nulprt,*) subname,
" * file name : ",trim(filename)
1042 status = nf90_open(trim(filename),nf90_nowrite,fid)
1043 if (status /= nf90_noerr)
then 1044 write(nulprt,*) subname,
' nf90_strerror = ',trim(nf90_strerror(status))
1045 WRITE(nulprt,*) subname,estr,
'mapping file not found = ',trim(filename)
1046 call oasis_abort(file=__file__,line=__line__)
1051 status = nf90_inq_dimid(fid,
'num_links', did)
1052 status = nf90_inquire_dimension(fid, did , len = ns)
1054 status = nf90_inq_dimid(fid,
'src_grid_size', did)
1055 status = nf90_inquire_dimension(fid, did , len = na)
1057 status = nf90_inq_dimid(fid,
'dst_grid_size', did)
1058 status = nf90_inquire_dimension(fid, did , len = nb)
1059 status = nf90_inq_dimid(fid,
'num_wgts', did)
1060 status = nf90_inquire_dimension(fid, did , len = nwgts)
1062 if (
present(ni_i) .and.
present(nj_i) .and.
present(ni_o) .and.
present(nj_o))
then 1071 status = nf90_inq_varid(fid,
'src_grid_dims', vid)
1072 status = nf90_get_var(fid, vid, dims)
1075 status = nf90_inq_varid(fid,
'dst_grid_dims', vid)
1076 status = nf90_get_var(fid, vid, dims)
1081 if (oasis_debug >= 2)
write(nulprt,*) subname,
" * matrix dims src x dst : ",na,
' x',nb
1082 if (oasis_debug >= 2)
write(nulprt,*) subname,
" * number of non-zero elements: ",ns
1090 if (
present(areasrc))
then 1091 if (mytask == 0)
then 1092 call mct_avect_init(areasrc0,
' ',areaav_field,na)
1094 status = nf90_inq_varid(fid,
'src_grid_area',vid)
1095 IF (status /= nf90_noerr)
THEN 1096 WRITE(nulprt,*) subname,
' nf90_strerrr = ',trim(nf90_strerror(status))
1097 WRITE(nulprt,*) subname,
'model :',compid,
' proc :',mpi_rank_local
1098 CALL oasis_flush(nulprt)
1100 status = nf90_get_var(fid, vid, areasrc0%rAttr)
1101 IF (status /= nf90_noerr)
THEN 1102 WRITE(nulprt,*) subname,
' nf90_strerror = ',trim(nf90_strerror(status))
1103 WRITE(nulprt,*) subname,
'model :',compid,
' proc :',mpi_rank_local
1104 CALL oasis_flush(nulprt)
1107 call mct_avect_scatter(areasrc0, areasrc, sgsmap, 0, mpicom, status)
1108 if (status /= 0)
call mct_die(subname,
"Error on scatter of areasrc0")
1109 if (mytask == 0)
then 1115 call mct_avect_clean(areasrc0)
1123 if (
present(areadst))
then 1124 if (mytask == 0)
then 1125 call mct_avect_init(areadst0,
' ',areaav_field,nb)
1127 status = nf90_inq_varid(fid,
'dst_grid_area',vid)
1128 IF (status /= nf90_noerr)
THEN 1129 WRITE(nulprt,*) subname,
' nf90_strerror = ',trim(nf90_strerror(status))
1130 WRITE(nulprt,*) subname,
'model :',compid,
' proc :',mpi_rank_local
1131 CALL oasis_flush(nulprt)
1133 status = nf90_get_var(fid, vid, areadst0%rAttr)
1134 IF (status /= nf90_noerr)
THEN 1135 WRITE(nulprt,*) subname,
' nf90_strerror = ',trim(nf90_strerror(status))
1136 WRITE(nulprt,*) subname,
'model :',compid,
' proc :',mpi_rank_local
1137 CALL oasis_flush(nulprt)
1140 call mct_avect_scatter(areadst0, areadst, dgsmap, 0, mpicom, status)
1141 if (status /= 0)
call mct_die(subname,
"Error on scatter of areadst0")
1142 if (mytask == 0)
then 1148 call mct_avect_clean(areadst0)
1158 if (mpi_rank_local.eq.0)
then 1162 dimbuffer(4) = nwgts
1163 if (
present(ni_i) .and.
present(nj_i) .and.
present(ni_o) .and.
present(nj_o))
then 1170 call oasis_mpi_bcast(dimbuffer,mpicom,subname//
" MPI of dimbuffer")
1171 if (mpi_rank_local.ne.0)
then 1175 nwgts = dimbuffer(4)
1176 if (
present(ni_i) .and.
present(nj_i) .and.
present(ni_o) .and.
present(nj_o))
then 1190 if (newdom ==
'src')
then 1192 elseif (newdom ==
'dst')
then 1195 write(nulprt,*) subname,estr,
'invalid newdom value, expect src or dst = ',newdom
1196 call oasis_abort(file=__file__,line=__line__)
1203 rsize = min(rbuf_size,ns)
1204 bsize = ((ns/commsize) + 1 ) * 1.2
1208 nread = (ns-1)/rsize + 1
1215 allocate(smat(nwgts),stat=status)
1216 if (status /= 0)
call mct_perr_die(subname,
':: allocate Smat',status)
1217 allocate(sbuf(nwgts,rsize),rbuf(rsize),cbuf(rsize),stat=status)
1218 if (status /= 0)
call mct_perr_die(subname,
':: allocate Sbuf',status)
1219 allocate(
snew(nwgts,bsize),
cnew(bsize),
rnew(bsize),stat=status)
1220 if (status /= 0)
call mct_perr_die(subname,
':: allocate Snew1',status)
1230 if (mytask == 0)
then 1238 lsize =
size(mygsmap%start)
1239 allocate(lsstart(lsize),lscount(lsize),lspeloc(lsize),stat=status)
1240 if (status /= 0)
call mct_perr_die(subname,
':: allocate Lsstart',status)
1242 if (lsize > 10)
then 1244 allocate(sortkey(lsize),stat=status)
1245 if (status /= 0)
call mct_perr_die(subname,
':: allocate sortkey',status)
1247 lsstart(n) = mygsmap%start(n)
1248 lscount(n) = mygsmap%length(n)
1249 lspeloc(n) = mygsmap%pe_loc(n)
1252 call oasis_sys_sorti(lsize,lsstart,sortkey)
1253 call oasis_sys_sortikey(lsize,lscount,sortkey)
1254 call oasis_sys_sortikey(lsize,lspeloc,sortkey)
1261 do while (.not.found .and. l1 < n)
1262 if (mygsmap%start(n) < lsstart(l1))
then 1264 lsstart(l2) = lsstart(l2-1)
1265 lscount(l2) = lscount(l2-1)
1266 lspeloc(l2) = lspeloc(l2-1)
1273 lsstart(l1) = mygsmap%start(n)
1274 lscount(l1) = mygsmap%length(n)
1275 lspeloc(l1) = mygsmap%pe_loc(n)
1279 do n = 1,
size(mygsmap%start)-1
1280 if (lsstart(n) > lsstart(n+1))
then 1281 write(nulprt,*) subname,estr,
'lsstart not properly sorted' 1282 call oasis_abort(file=__file__,line=__line__)
1292 allocate(remaps(nwgts,rsize),stat=status)
1293 if (status /= 0)
call mct_perr_die(subname,
':: allocate remaps',status)
1294 allocate(sreaddata(nwgts,rsize),rreaddata(rsize),creaddata(rsize),stat=status)
1295 if (status /= 0)
call mct_perr_die(subname,
':: allocate SReadData',status)
1296 allocate(pesave(rsize),stat=status)
1297 if (status /= 0)
call mct_perr_die(subname,
':: allocate pesave',status)
1298 allocate(sdistdata(nwgts,rsize),rdistdata(rsize),cdistdata(rsize), stat=status)
1299 if (status /= 0)
call mct_perr_die(subname,
':: allocate SDistData',status)
1300 allocate(cntrs(0:mpi_size_local), stat=status)
1301 if (status /= 0)
call mct_perr_die(subname,
':: allocate cntrs',status)
1308 start(1) = (n-1)*rsize + 1
1309 count(1) = min(rsize,ns-start(1)+1)
1312 start2(2) = start(1)
1313 count2(2) = count(1)
1320 status = nf90_inq_varid(fid,
'remap_matrix' ,vid)
1322 status = nf90_get_var(fid,vid,remaps,start2,count2)
1323 sreaddata(:,:) = remaps(:,:)
1324 IF (status /= nf90_noerr)
THEN 1325 WRITE(nulprt,*) subname,
' nf90_strerror = ',trim(nf90_strerror(status))
1326 WRITE(nulprt,*) subname,
'model :',compid,
' proc :',mpi_rank_local
1327 CALL oasis_flush(nulprt)
1330 status = nf90_inq_varid(fid,
'dst_address',vid)
1331 status = nf90_get_var(fid,vid,rreaddata,start,count)
1332 IF (status /= nf90_noerr)
THEN 1333 WRITE(nulprt,*) subname,
' nf90_strerror = ',trim(nf90_strerror(status))
1334 WRITE(nulprt,*) subname,
'model :',compid,
' proc :',mpi_rank_local
1335 CALL oasis_flush(nulprt)
1339 status = nf90_inq_varid(fid,
'src_address',vid)
1340 status = nf90_get_var(fid,vid,creaddata,start,count)
1341 IF (status /= nf90_noerr)
THEN 1342 WRITE(nulprt,*) subname,
' nf90_strerror = ',trim(nf90_strerror(status))
1343 WRITE(nulprt,*) subname,
'model :',compid,
' proc :',mpi_rank_local
1344 CALL oasis_flush(nulprt)
1360 if (namwgtopt ==
"abort_on_bad_index")
then 1361 abort_weight = .false.
1364 if ((rreaddata(m) <= 0 .or. rreaddata(m) > nb .or. &
1365 creaddata(m) <= 0 .or. creaddata(m) > na) &
1367 .and. (minval(sreaddata(:,m)) /= 0._r8 .or. maxval(sreaddata(:,m)) /= 0._r8) &
1369 abort_weight = .true.
1370 WRITE(nulprt,
'(3A,I12,A,I12,A,I12,A,G13.7,A,G13.7,A)') &
1371 subname,wstr,
'BAD weight found in '//trim(filename), &
1372 m,
'=id',creaddata(m),
'=src',rreaddata(m),
'=dst',minval(sreaddata(:,m)),
'=minS',maxval(sreaddata(:,m)),
'=maxS' 1375 if (abort_weight)
then 1376 WRITE(nulprt,*) subname,wstr,
'BAD weight found, aborting' 1377 call oasis_abort(file=__file__,line=__line__)
1383 if ((namwgtopt(1:16) ==
"ignore_bad_index") .and. &
1384 (rreaddata(m) <= 0 .or. rreaddata(m) > nb .or. &
1385 creaddata(m) <= 0 .or. creaddata(m) > na))
then 1388 if (minval(sreaddata(:,m)) /= 0._r8 .or. maxval(sreaddata(:,m)) /= 0._r8)
then 1389 if (oasis_debug >= 2 .and. namwgtopt /=
"ignore_bad_index_silently")
then 1390 WRITE(nulprt,
'(3A,I12,A,I12,A,I12,A,G13.7,A,G13.7,A)') &
1391 subname,wstr,
'BAD weight found in '//trim(filename), &
1392 m,
'=id',creaddata(m),
'=src',rreaddata(m),
'=dst',minval(sreaddata(:,m)),
'=minS',maxval(sreaddata(:,m)),
'=maxS' 1395 else if (newdom ==
'src')
then 1396 pe =
get_cegindex(rreaddata(m),lsstart,lscount,lspeloc)
1397 else if (newdom ==
'dst')
then 1398 pe =
get_cegindex(creaddata(m),lsstart,lscount,lspeloc)
1405 elseif (pe+1 < 1 .or. pe+1 > mpi_size_local)
then 1409 cntrs(pe+1) = cntrs(pe+1) + 1
1415 do pe = 1, mpi_size_local
1416 cntrs(pe) = cntrs(pe-1) + cntrs(pe)
1428 if (pe+1 < 1 .or. pe+1 > mpi_size_local)
then 1433 sdistdata(:,cntrs(pe)) = sreaddata(:,m)
1434 rdistdata(cntrs(pe)) = rreaddata(m)
1435 cdistdata(cntrs(pe)) = creaddata(m)
1437 cntrs(pe) = cntrs(pe) + 1
1448 if (cntrs(0).gt.1)
then 1454 snew(1:nwgts,cnt:cnt+reclen-1) = sdistdata(1:nwgts,1:reclen)
1455 rnew(cnt:cnt+reclen-1) = rdistdata(1:reclen)
1456 cnew(cnt:cnt+reclen-1) = cdistdata(1:reclen)
1461 do pe = 1, mpi_size_local
1462 if (cntrs(pe).gt.cntrs(pe-1))
then 1464 m = cntrs(pe)-cntrs(pe-1)
1466 call mpi_send(m, 1, mpi_integer, pe, 4000, mpicom, ierr)
1467 call mpi_send(sdistdata(1,cntrs(pe-1)), nwgts*m, mpi_real8, pe, 1000, mpicom, ierr)
1468 call mpi_send(rdistdata(cntrs(pe-1)), m, mpi_integer, pe, 2000, mpicom, ierr)
1469 call mpi_send(cdistdata(cntrs(pe-1)), m, mpi_integer, pe, 3000, mpicom, ierr)
1480 do pe = 1, mpi_size_local-1
1482 call mpi_send(m, 1, mpi_integer, pe, 4000, mpicom, ierr)
1486 deallocate(lsstart,lscount,lspeloc, stat=status)
1487 if (status /= 0)
call mct_perr_die(subname,
':: deallocate lsstart',status)
1488 deallocate(pesave, stat=status)
1489 if (status /= 0)
call mct_perr_die(subname,
':: deallocate pesave',status)
1490 deallocate(sreaddata,rreaddata,creaddata, stat=status)
1491 if (status /= 0)
call mct_perr_die(subname,
':: deallocate SReadData',status)
1492 deallocate(sdistdata,rdistdata,cdistdata, stat=status)
1493 if (status /= 0)
call mct_perr_die(subname,
':: deallocate SDistData',status)
1494 deallocate(cntrs, stat=status)
1495 if (status /= 0)
call mct_perr_die(subname,
':: deallocate cntrs',status)
1496 deallocate(remaps, stat=status)
1497 if (status /= 0)
call mct_perr_die(subname,
':: deallocate remaps',status)
1512 call oasis_mpi_recv(reclen, 0, 4000, mpicom, subname//
" MPI in reclen recv")
1514 do while (reclen.ne.-1)
1518 call mpi_recv(sbuf, reclen*nwgts, mpi_real8, 0, 1000, mpicom, mpi_status_ignore, ierr)
1519 call mpi_recv(rbuf, reclen, mpi_integer, 0, 2000, mpicom, mpi_status_ignore, ierr)
1520 call mpi_recv(cbuf, reclen, mpi_integer, 0, mpi_any_tag, mpicom, mpistatus, ierr)
1529 snew(1:nwgts,cnt:cnt+reclen-1) = sbuf(1:nwgts,1:reclen)
1530 rnew(cnt:cnt+reclen-1) = rbuf(1:reclen)
1531 cnew(cnt:cnt+reclen-1) = cbuf(1:reclen)
1534 call oasis_mpi_recv(reclen, 0, 4000, mpicom, subname//
" MPI in reclen recv")
1548 deallocate(sbuf,rbuf,cbuf, stat=status)
1549 if (status /= 0)
call mct_perr_die(subname,
':: deallocate Sbuf',status)
1559 call mct_smat_init(smat(n), nb, na, cnt)
1562 igrow = mct_smat_indexia(smat(1),
'grow')
1563 igcol = mct_smat_indexia(smat(1),
'gcol')
1564 iwgt = mct_smat_indexra(smat(1),
'weight')
1568 smat(n)%data%rAttr(iwgt ,1:cnt) =
snew(n,1:cnt)
1569 smat(n)%data%iAttr(igrow,1:cnt) =
rnew(1:cnt)
1570 smat(n)%data%iAttr(igcol,1:cnt) =
cnew(1:cnt)
1581 if (status /= 0)
call mct_perr_die(subname,
':: deallocate new',status)
1583 if (mytask == 0)
then 1584 status = nf90_close(fid)
1585 IF (oasis_debug >= 2)
THEN 1586 WRITE(nulprt,*) subname,
" ... done reading file" 1587 CALL oasis_flush(nulprt)
1592 call oasis_debug_exit(subname)
1606 integer,
intent(inout) :: cnt
1607 integer,
intent(in) :: reclen
1608 integer,
intent(inout) :: bsize
1609 integer,
intent(in) :: nwgts
1613 character(*),
parameter :: subName =
'(ceg_coupler_augment_arrays)' 1617 if (cnt+reclen > bsize)
then 1622 allocate(
sold(1:nwgts,cnt),
rold(cnt),
cold(cnt),stat=status)
1623 if (status /= 0)
call mct_perr_die(subname,
':: allocate old',status)
1624 sold(1:nwgts,1:cnt-1) =
snew(1:nwgts,1:cnt-1)
1630 if (status /= 0)
call mct_perr_die(subname,
':: allocate new',status)
1631 bsize = 1.5 * (cnt+reclen)
1632 if (oasis_debug > 15)
write(nulprt,*) subname,
' reallocate bsize to ',bsize
1633 allocate(
snew(nwgts,bsize),
rnew(bsize),
cnew(bsize),stat=status)
1634 if (status /= 0)
call mct_perr_die(subname,
':: allocate old',status)
1637 snew(1:nwgts,1:cnt-1) =
sold(1:nwgts,1:cnt-1)
1641 if (status /= 0)
call mct_perr_die(subname,
':: deallocate old',status)
1667 integer,
parameter :: R8 = ip_double_p
1668 integer,
parameter :: IN = ip_i4_p
1672 integer(IN) :: index
1673 integer(IN) :: starti(:)
1674 integer(IN) :: counti(:)
1679 integer(IN) :: nl,nc,nr,ncprev
1680 integer(IN) :: lsize
1684 character(*),
parameter :: subName =
'(check_myindex) ' 1693 lsize =
size(starti)
1703 do while (.not.stopnow)
1704 if (index < starti(nc))
then 1706 elseif (index > (starti(nc) + counti(nc) - 1))
then 1715 if (nc == ncprev .or. nc < 1 .or. nc > lsize) stopnow = .true.
1737 integer function get_cegindex(index,starti,counti,peloci)
1743 integer,
parameter :: R8 = ip_double_p
1744 integer,
parameter :: IN = ip_i4_p
1748 integer(IN) :: index
1749 integer(IN) :: starti(:)
1750 integer(IN) :: counti(:)
1751 integer(IN) :: peloci(:)
1757 integer(IN) :: nl,nc,nr,ncprev
1758 integer(IN) :: lsize
1762 character(*),
parameter :: subName =
'(get_cegindex) ' 1770 lsize =
size(starti)
1780 do while (.not.stopnow)
1781 if (index < starti(nc))
then 1783 elseif (index > (starti(nc) + counti(nc) - 1))
then 1792 if (nc == ncprev .or. nc < 1 .or. nc > lsize) stopnow = .true.
Provides a common location for several OASIS variables.
Provides reusable IO routines for OASIS.
integer, dimension(:), allocatable, private rnew
subroutine, public oasis_map_smatreaddnc_ceg(sMat, SgsMap, DgsMap, newdom, fileName, mytask, mpicom, nwgts, areasrc, areadst, ni_i, nj_i, ni_o, nj_o)
Read in mapping matrix data from a SCRIP netCDF file using smart scatter (ceg)
logical function check_myindex(index, starti, counti)
Function that checks whether an index is part of a start and count list.
integer(kind=ip_intwp_p) nulprt
subroutine augment_arrays(cnt, reclen, bsize, nwgts)
Function that increases temporary work array size of Snew, Rnew, Cnew.
subroutine, public oasis_abort(id_compid, cd_routine, cd_message, file, line, rcode)
OASIS abort method, publically available to users.
subroutine, public oasis_map_smatreaddnc_orig(sMat, SgsMap, DgsMap, newdom, fileName, mytask, mpicom, nwgts, areasrc, areadst, ni_i, nj_i, ni_o, nj_o)
Read in mapping matrix data from a SCRIP netCDF weights file.
integer, parameter ip_i4_p
real(r8), dimension(:,:), allocatable, private snew
integer, parameter ip_double_p
Character string manipulation methods.
Provides a generic and simpler interface into MPI calls for OASIS.
integer, dimension(:), allocatable, private rold
subroutine, public oasis_debug_enter(string)
Used when a subroutine is entered, write info to log file at some debug level.
integer, dimension(:), allocatable, private cold
character(len=ic_lvar), dimension(:), pointer, public namsrcgrd
src grid name
OASIS partition data and methods.
subroutine, public oasis_io_read_field_fromroot(filename, fldname, ifld2, fld2, fld3, nx, ny, nz)
Read a field on the root task from a file into an array.
character(len=ic_med), dimension(:), pointer, public namscrtyp
scrip mapping type (SCALAR, VECTOR)
character(len=ic_med), dimension(:), pointer, public namscrmet
scrip method (CONSERV, DISTWGT, BILINEAR, BICUBIC, GAUSWGT)
subroutine, public oasis_map_genmap(mapid, namid)
Routine to generate mapping weights data via a direct SCRIP call.
integer(kind=ip_i4_p), public prism_mmapper
max mappers
Defines parameters for OASIS.
OASIS variable data and methods.
integer(kind=ip_i4_p) oasis_debug
character(len= *), parameter, public estr
type(prism_mapper_type), dimension(:), pointer, public prism_mapper
list of defined mappers
integer, dimension(:), allocatable, private cnew
integer function get_cegindex(index, starti, counti, peloci)
Function that carrys out a binary search for index in list.
integer(kind=ip_i4_p), public prism_nmapper
mapper counter
integer, parameter, private in
real(r8), dimension(:,:), allocatable, private sold
integer, parameter, private r8
Performance timer methods.
Reads the namcouple file for use in OASIS.
Mapper data for interpolating data between grids.
logical, parameter local_timers_on
OASIS map (interpolation) data and methods.