26#if defined PIO_LIB && defined DISTRIBUTE
33#if defined PIO_LIB && defined DISTRIBUTE
72 USE roms_interpolate_mod
78#if defined DISTRIBUTE && defined REGRID_SHAPIRO
91#if defined PIO_LIB && defined DISTRIBUTE
99 & ncvname, ncvarid, gtype, iflag, &
100 & Nx, Ny, Finp, Amin, Amax, &
101 & LBi, UBi, LBj, UBj, &
102 & Imin, Imax, Jmin, Jmax, &
106 & MyXout, Xout, Yout, Fout)
111 integer,
intent(in) :: ng, model, ncid, ncvarid, gtype, iflag
112 integer,
intent(in) :: nx, ny
113 integer,
intent(in) :: lbi, ubi, lbj, ubj
114 integer,
intent(in) :: imin, imax, jmin, jmax
116 real(r8),
intent(inout) :: amin, amax
118 real(r8),
intent(inout) :: finp(nx,ny)
120 real(r8),
intent(inout) :: myxout(lbi:ubi,lbj:ubj)
123 real(r8),
intent(in) :: mymask(lbi:ubi,lbj:ubj)
125 real(r8),
intent(in) :: xout(lbi:ubi,lbj:ubj)
126 real(r8),
intent(in) :: yout(lbi:ubi,lbj:ubj)
128 real(r8),
intent(out) :: fout(lbi:ubi,lbj:ubj)
130 character (len=*),
intent(in) :: ncname
131 character (len=*),
intent(in) :: ncvname
135 logical :: eastlon, rectangular
138 integer :: istr, iend, jstr, jend
140 integer :: imins, imaxs, jmins, jmaxs, tile
143 integer :: cgrid, ghost
146 real(r8),
parameter :: ijspv = 0.0_r8
148 real(r8) :: my_min, my_max, xmin, xmax, ymin, ymax
149 real(r8) :: mylonmin, mylonmax
151 real(r8),
dimension(Nx,Ny) :: angle
152 real(r8),
dimension(Nx,Ny) :: xinp
153 real(r8),
dimension(Nx,Ny) :: yinp
155 real(r8),
dimension(LBi:UBi,LBj:UBj) :: iout
156 real(r8),
dimension(LBi:UBi,LBj:UBj) :: jout
159 real(r8),
dimension(2) :: rbuffer
161 character (len=3),
dimension(2) :: op_handle
164 character (len=*),
parameter :: myfile = &
165 & __FILE__//
", regrid_nf90"
172 & ncvname, ncvarid, nx, ny, &
173 & xmin, xmax, xinp, ymin, ymax, yinp, &
197 IF ((xmin.ge.0.0_r8).and.(xmax.gt.0.0_r8).and. &
198 & ((xmax-xmin).gt.315.0_r8))
THEN
200 mylonmin=modulo(
lonmin(ng), 360.0_r8)
201 IF ((mylonmin.eq.0.0_r8).and. &
202 & (
lonmin(ng).gt.0.0_r8)) mylonmin=360.0_r8
203 mylonmax=modulo(
lonmax(ng), 360.0_r8)
204 IF ((mylonmax.eq.0.0_r8).and. &
205 & (
lonmax(ng).gt.0.0_r8)) mylonmax=360.0_r8
214 myxout(i,j)=modulo(xout(i,j), 360.0_r8)
215 IF ((myxout(i,j).eq.0.0_r8).and. &
216 & (xout(i,j).gt.0.0_r8)) myxout(i,j)=360.0_r8
222 myxout(i,j)=xout(i,j)
231 IF ((mylonmin .lt.xmin).or. &
232 & (mylonmax .gt.xmax).or. &
233 & (
latmin(ng).lt.ymin).or. &
234 & (
latmax(ng).gt.ymax))
THEN
236 WRITE (
stdout,10) xmin, xmax, ymin, ymax, &
237 & mylonmin , mylonmax, &
239 10
FORMAT (/,
' REGRID - input gridded data does not contain', &
240 &
' model grid:', /, &
241 & /,10x,
'Gridded: LonMin = ',f9.4,
' LonMax = ',f9.4, &
242 & /,10x,
' LatMin = ',f9.4,
' LatMax = ',f9.4, &
243 & /,10x,
'Model: LonMin = ',f9.4,
' LonMax = ',f9.4, &
244 & /,10x,
' LatMin = ',f9.4,
' LatMax = ',f9.4)
259 SELECT CASE (abs(gtype))
286 CALL hindices (ng, 1, nx, 1, ny, 1, nx, 1, ny, &
287 & angle, xinp, yinp, &
288 & lbi, ubi, lbj, ubj, &
289 & istr, iend, jstr, jend, &
292 & ijspv, rectangular)
296 & xinp, yinp, finp, &
297 & lbi, ubi, lbj, ubj, &
298 & istr, iend, jstr, jend, &
299 & iout, jout, myxout, yout, &
300 & fout, my_min, my_max)
301 ELSE IF (iflag.eq.
cubic)
THEN
303 & xinp, yinp, finp, &
304 & lbi, ubi, lbj, ubj, &
305 & istr, iend, jstr, jend, &
306 & iout, jout, myxout, yout, &
307 & fout, my_min, my_max)
319 & lbi, ubi, lbj, ubj, &
327 imins=
bounds(ng)%Istr(tile)-4
328 imaxs=
bounds(ng)%Iend(tile)+3
329 jmins=
bounds(ng)%Jstr(tile)-4
330 jmaxs=
bounds(ng)%Jend(tile)+3
332 imins=
bounds(ng)%Istr(tile)-3
333 imaxs=
bounds(ng)%Iend(tile)+3
334 jmins=
bounds(ng)%Jstr(tile)-3
335 jmaxs=
bounds(ng)%Jend(tile)+3
339 & lbi, ubi, lbj, ubj, &
340 & imins, imaxs, jmins, jmaxs, &
355 CALL mp_reduce (ng, model, 2, rbuffer, op_handle)
366#if defined PIO_LIB && defined DISTRIBUTE
370 & ncvname, pioVar, gtype, iflag, &
371 & Nx, Ny, Finp, Amin, Amax, &
372 & LBi, UBi, LBj, UBj, &
373 & Imin, Imax, Jmin, Jmax, &
377 & MyXout, Xout, Yout, Fout)
384 integer,
intent(in) :: ng, model, gtype, iflag
385 integer,
intent(in) :: nx, ny
386 integer,
intent(in) :: lbi, ubi, lbj, ubj
387 integer,
intent(in) :: imin, imax, jmin, jmax
389 real(r8),
intent(inout) :: amin, amax
391 real(r8),
intent(inout) :: finp(nx,ny)
393 real(r8),
intent(inout) :: myxout(lbi:ubi,lbj:ubj)
396 real(r8),
intent(in) :: mymask(lbi:ubi,lbj:ubj)
398 real(r8),
intent(in) :: xout(lbi:ubi,lbj:ubj)
399 real(r8),
intent(in) :: yout(lbi:ubi,lbj:ubj)
401 real(r8),
intent(out) :: fout(lbi:ubi,lbj:ubj)
403 character (len=*),
intent(in) :: ncname
404 character (len=*),
intent(in) :: ncvname
406 TYPE (file_desc_t),
intent(inout) :: piofile
411 logical :: eastlon, rectangular
414 integer :: istr, iend, jstr, jend
415# ifdef REGRID_SHAPIRO
416 integer :: imins, imaxs, jmins, jmaxs, tile
419 integer :: cgrid, ghost
422 real(r8),
parameter :: ijspv = 0.0_r8
424 real(r8) :: my_min, my_max, xmin, xmax, ymin, ymax
425 real(r8) :: mylonmin, mylonmax
427 real(r8),
dimension(Nx,Ny) :: angle
428 real(r8),
dimension(Nx,Ny) :: xinp
429 real(r8),
dimension(Nx,Ny) :: yinp
431 real(r8),
dimension(LBi:UBi,LBj:UBj) :: iout
432 real(r8),
dimension(LBi:UBi,LBj:UBj) :: jout
435 real(r8),
dimension(2) :: rbuffer
437 character (len=3),
dimension(2) :: op_handle
440 character (len=*),
parameter :: myfile = &
441 & __FILE__//
", regrid_pio"
448 & ncvname, piovar, nx, ny, &
449 & xmin, xmax, xinp, ymin, ymax, yinp, &
473 IF ((xmin.ge.0.0_r8).and.(xmax.gt.0.0_r8).and. &
474 & ((xmax-xmin).gt.315.0_r8))
THEN
476 mylonmin=modulo(
lonmin(ng), 360.0_r8)
477 IF ((mylonmin.eq.0.0_r8).and. &
478 & (
lonmin(ng).gt.0.0_r8)) mylonmin=360.0_r8
479 mylonmax=modulo(
lonmax(ng), 360.0_r8)
480 IF ((mylonmax.eq.0.0_r8).and. &
481 & (
lonmax(ng).gt.0.0_r8)) mylonmax=360.0_r8
490 myxout(i,j)=modulo(xout(i,j), 360.0_r8)
491 IF ((myxout(i,j).eq.0.0_r8).and. &
492 & (xout(i,j).gt.0.0_r8)) myxout(i,j)=360.0_r8
498 myxout(i,j)=xout(i,j)
507 IF ((mylonmin .lt.xmin).or. &
508 & (mylonmax .gt.xmax).or. &
509 & (
latmin(ng).lt.ymin).or. &
510 & (
latmax(ng).gt.ymax))
THEN
512 WRITE (
stdout,10) xmin, xmax, ymin, ymax, &
513 & mylonmin , mylonmax, &
515 10
FORMAT (/,
' REGRID - input gridded data does not contain', &
516 &
' model grid:', /, &
517 & /,10x,
'Gridded: LonMin = ',f9.4,
' LonMax = ',f9.4, &
518 & /,10x,
' LatMin = ',f9.4,
' LatMax = ',f9.4, &
519 & /,10x,
'Model: LonMin = ',f9.4,
' LonMax = ',f9.4, &
520 & /,10x,
' LatMin = ',f9.4,
' LatMax = ',f9.4)
535 SELECT CASE (abs(gtype))
562 CALL hindices (ng, 1, nx, 1, ny, 1, nx, 1, ny, &
563 & angle, xinp, yinp, &
564 & lbi, ubi, lbj, ubj, &
565 & istr, iend, jstr, jend, &
568 & ijspv, rectangular)
572 & xinp, yinp, finp, &
573 & lbi, ubi, lbj, ubj, &
574 & istr, iend, jstr, jend, &
575 & iout, jout, myxout, yout, &
576 & fout, my_min, my_max)
577 ELSE IF (iflag.eq.
cubic)
THEN
579 & xinp, yinp, finp, &
580 & lbi, ubi, lbj, ubj, &
581 & istr, iend, jstr, jend, &
582 & iout, jout, myxout, yout, &
583 & fout, my_min, my_max)
586# ifdef REGRID_SHAPIRO
595 & lbi, ubi, lbj, ubj, &
603 imins=
bounds(ng)%Istr(tile)-4
604 imaxs=
bounds(ng)%Iend(tile)+3
605 jmins=
bounds(ng)%Jstr(tile)-4
606 jmaxs=
bounds(ng)%Jend(tile)+3
608 imins=
bounds(ng)%Istr(tile)-3
609 imaxs=
bounds(ng)%Iend(tile)+3
610 jmins=
bounds(ng)%Jstr(tile)-3
611 jmaxs=
bounds(ng)%Jend(tile)+3
615 & lbi, ubi, lbj, ubj, &
616 & imins, imaxs, jmins, jmaxs, &
631 CALL mp_reduce (ng, model, 2, rbuffer, op_handle)
subroutine hindices(ng, lbi, ubi, lbj, ubj, is, ie, js, je, angler, xgrd, ygrd, lbm, ubm, lbn, ubn, ms, me, ns, ne, xpos, ypos, ipos, jpos, ijspv, rectangular)
subroutine cinterp2d(ng, lbx, ubx, lby, uby, xinp, yinp, finp, lbi, ubi, lbj, ubj, istr, iend, jstr, jend, iout, jout, xout, yout, fout, minval, maxval)
subroutine linterp2d(ng, lbx, ubx, lby, uby, xinp, yinp, finp, lbi, ubi, lbj, ubj, istr, iend, jstr, jend, iout, jout, xout, yout, fout, minval, maxval)
type(t_bounds), dimension(:), allocatable bounds
integer, parameter r3dvar
integer, parameter u3dvar
integer, parameter u2dvar
integer, parameter p2dvar
integer, parameter r2dvar
integer, parameter v2dvar
integer, parameter p3dvar
integer, parameter v3dvar
real(r8), dimension(:), allocatable latmax
logical, dimension(:), allocatable ewperiodic
logical, dimension(:), allocatable nsperiodic
integer, parameter linear
real(r8), dimension(:), allocatable latmin
real(r8), dimension(:), allocatable lonmax
real(r8), dimension(:), allocatable lonmin
subroutine mp_exchange2d(ng, tile, model, nvar, lbi, ubi, lbj, ubj, nghost, ew_periodic, ns_periodic, a, b, c, d)
subroutine, public regrid_nf90(ng, model, ncname, ncid, ncvname, ncvarid, gtype, iflag, nx, ny, finp, amin, amax, lbi, ubi, lbj, ubj, imin, imax, jmin, jmax, mymask, myxout, xout, yout, fout)
subroutine, public regrid_pio(ng, model, ncname, piofile, ncvname, piovar, gtype, iflag, nx, ny, finp, amin, amax, lbi, ubi, lbj, ubj, imin, imax, jmin, jmax, mymask, myxout, xout, yout, fout)
subroutine shapiro2d_tile(ng, tile, model, lbi, ubi, lbj, ubj, imins, imaxs, jmins, jmaxs, amask, a)
logical function, public founderror(flag, noerr, line, routine)