subroutine lagyin(pf ,fint ,wdy ,ydp ,jdp , & jcen ,fdp ,nlon ) !----------------------------------------------------------------------- ! ! Purpose: ! For each departure point in the latitude slice to be forecast, ! interpolate (using unequally spaced Lagrange cubic formulas) the ! x interpolants to the y value of the departure point. ! ! Method: ! ! Author: ! Original version: J. Olson ! Standardized: J. Rosinski, June 1992 ! Reviewed: D. Williamson, P. Rasch, August 1992 ! Reviewed: D. Williamson, P. Rasch, March 1996 ! !----------------------------------------------------------------------- ! ! $Id$ ! $Author$ ! !----------------------------------------------------------------------- use shr_kind_mod, only: r8 => shr_kind_r8 use pmgrid, only: plon, plev use scanslt, only: platd use abortutils, only: endrun use cam_logfile, only: iulog #if (!defined UNICOSMP) use srchutil, only: whenieq #endif !----------------------------------------------------------------------- implicit none !----------------------------------------------------------------------- #include !------------------------------Arguments-------------------------------- ! ! Input arguments ! integer, intent(in) :: pf ! dimension (number of fields) ! real(r8), intent(in) :: fint(plon,plev,ppdy,pf) ! x-interpolants real(r8), intent(in) :: wdy(4,2,platd) ! y-interpolation weights real(r8), intent(in) :: ydp(plon,plev) ! y-coordinates of departure pts. ! integer, intent(in) :: jdp(plon,plev) ! j-index of departure point coord. integer, intent(in) :: jcen ! current latitude integer, intent(in) :: nlon ! ! Output arguments ! real(r8), intent(out) :: fdp(plon,plev,pf) ! interpolants at the horiz. depart. pt. ! !----------------------------------------------------------------------- ! ! pf Number of fields being interpolated. ! fint (fint(i,k,j,m),j=ppdy/2,ppdy/2 + 1) contains the x ! interpolants at the endpoints of the y-interval that contains ! the departure point for grid point (i,k). The last index of ! fint allows for interpolation of multiple fields. fint is ! generated by a call to herxin. ! wdy Grid values and weights for Lagrange cubic interpolation on ! the unequally spaced y-grid. ! ydp ydp(i,k) is the y-coordinate of the departure point that ! corresponds to global grid point (i,k) in the latitude slice ! being forecasted. ! jdp jdp(i,k) is the index of the y-interval that contains the ! departure point corresponding to global grid point (i,k) in ! the latitude slice being forecasted. ! Note that ! y(jdp(i,k)) .le. ydp(i,k) .lt. y(jdp(i,k)+1) . ! fdp Horizontally interpolated field values at the departure point ! for the latitude slice being forecasted. ! !---------------------------Local variables----------------------------- ! integer i,m ! indices ! real(r8) ymy1 ! | real(r8) ymy2 ! | real(r8) ymy3 ! | real(r8) ymy4 ! | real(r8) coef12 ! | real(r8) coef34 ! | -- interpolation weights/coeffs. real(r8) term1(plon,plev) ! | real(r8) term2(plon,plev) ! | real(r8) term3(plon,plev) ! | real(r8) term4(plon,plev) ! | ! integer jdpval,icount,ii,indx(plon),nval(plev) integer k ! !----------------------------------------------------------------------- ! if( ppdy .ne. 4) then call endrun ('LAGYIN:Error: ppdy .ne. 4') end if icount = 0 do jdpval=jcen-2,jcen+1 if (icount.lt.nlon*plev) then !$OMP PARALLEL DO PRIVATE (K, INDX, II, I, YMY3, YMY4, COEF12, YMY2, YMY1, COEF34) do k=1,plev call whenieq(nlon,jdp(1,k),1,jdpval,indx,nval(k)) ! do ii = 1,nval(k) i=indx(ii) ymy3 = ydp(i,k) - wdy(3,1,jdpval) ymy4 = ydp(i,k) - wdy(4,1,jdpval) coef12 = ymy3*ymy4 ymy2 = ydp(i,k) - wdy(2,1,jdpval) term1(i,k) = coef12*ymy2*wdy(1,2,jdpval) ymy1 = ydp(i,k) - wdy(1,1,jdpval) term2(i,k) = coef12*ymy1*wdy(2,2,jdpval) coef34 = ymy1*ymy2 term3(i,k) = coef34*ymy4*wdy(3,2,jdpval) term4(i,k) = coef34*ymy3*wdy(4,2,jdpval) end do end do do k=1,plev icount = icount + nval(k) enddo end if end do if (icount.ne.nlon*plev) then write(iulog,*)'LAGYIN: Departure pt out of bounds: jcen,icount,nlon*plev=',jcen,icount,nlon*plev write(iulog,*)' ****** MODEL IS BLOWING UP: CFL condition likely violated *********' write(iulog,*)' Possible solutions: a) reduce time step' write(iulog,*)' b) if initial run, set "DIVDAMPN = 1." in namelist and rerun' write(iulog,*)' c) modified code may be in error' call endrun end if ! ! Loop over fields. ! do m = 1,pf !$OMP PARALLEL DO PRIVATE (K, I) do k=1,plev do i = 1,nlon fdp(i,k,m) = fint(i,k,1,m)*term1(i,k) + & fint(i,k,2,m)*term2(i,k) + & fint(i,k,3,m)*term3(i,k) + & fint(i,k,4,m)*term4(i,k) end do end do end do ! return end subroutine lagyin