#include <misc.h>#include <params.h>! Note that this routine has 2 complete blocks of code for PVP vs.! non-PVP.  Make sure to make appropriate coding changes where! necessary.#if ( defined PVP )subroutine dyndrv(grlps1  ,grt1    ,grq1    ,grz1    ,grd1    , &                  grfu1   ,grfv1   ,grlps2  ,grt2    ,grq2    , &                  grz2    ,grd2    ,grfu2   ,grfv2   ,vmax2d  , &                  vmax2dt ,vcour   )!-----------------------------------------------------------------------!! Purpose:! Driving routine for Gaussian quadrature, semi-implicit equation! solution and linear part of horizontal diffusion.! The need for this interface routine is to have a multitasking! driver for the spectral space routines it invokes.!! Author:  J. Rosinski!!-----------------------------------------------------------------------!! $Id: dyndrv.F90,v 1.5 2001/10/19 17:50:34 eaton Exp $! $Author: eaton $!!-----------------------------------------------------------------------  use precision  use pmgrid  use pspect  use commap  use time_manager, only: get_step_size  implicit none!------------------------------Arguments--------------------------------!  real(r8), intent(in)   :: grlps1(2*pmmax,plat/2)      ! ----------------------------  real(r8), intent(in)   :: grt1  (2*pmmax,plev,plat/2) ! |  real(r8), intent(in)   :: grq1  (2*pmmax,plev,plat/2) ! |  real(r8), intent(in)   :: grz1  (2*pmmax,plev,plat/2) ! |  real(r8), intent(in)   :: grd1  (2*pmmax,plev,plat/2) ! |  real(r8), intent(in)   :: grfu1 (2*pmmax,plev,plat/2) ! | see quad for definitions:  real(r8), intent(in)   :: grfv1 (2*pmmax,plev,plat/2) ! | these variables are  real(r8), intent(in)   :: grlps2(2*pmmax,plat/2)      ! | declared here for data  real(r8), intent(in)   :: grt2  (2*pmmax,plev,plat/2) ! | scoping  real(r8), intent(in)   :: grq2  (2*pmmax,plev,plat/2) ! |  real(r8), intent(in)   :: grz2  (2*pmmax,plev,plat/2) ! |  real(r8), intent(in)   :: grd2  (2*pmmax,plev,plat/2) ! |  real(r8), intent(in)   :: grfu2 (2*pmmax,plev,plat/2) ! |  real(r8), intent(in)   :: grfv2 (2*pmmax,plev,plat/2) ! ----------------------------  real(r8), intent(in)   :: vmax2d (plev,plat)   ! max. wind at each level, lat  real(r8), intent(in)   :: vmax2dt(plev,plat)   ! max. truncated wind at each lvl, lat  real(r8), intent(in)   :: vcour  (plev,plat)   ! maximum Courant number in slice!!---------------------------Local workspace-----------------------------!  real(r8) ztdtsq(2*pnmax)  ! dt*(n(n+1)/a^2)  real(r8) zdt              ! dt  real(r8) ztdt             ! dt  integer irow              ! latitude pair index  integer n                 ! meridional wavenumber index  integer k                 ! level index!!-----------------------------------------------------------------------!  call t_startf('dyn')!$OMP PARALLEL DO PRIVATE (IROW)  do irow = 1,plat/2     call dyn(irow    ,grlps1(1,irow),grt1(1,1,irow),grq1(1,1,irow),grz1(1,1,irow)   , &              grd1(1,1,irow),grfu1(1,1,irow),grfv1(1,1,irow),grlps2(1,irow), &                 grt2(1,1,irow) , &              grq2(1,1,irow),grz2 (1,1,irow),grd2 (1,1,irow),grfu2(1,1,irow), &                 grfv2(1,1,irow)  )  end do  call t_stopf('dyn')!!-----------------------------------------------------------------------!! Build expanded vector with del^2 response function!  zdt  = get_step_size()*0.5  ztdt = 2.*zdt!DIR$ IVDEP  do n=1,pnmax     ztdtsq(2*n-1) = ztdt*sq(n)     ztdtsq(2*n  ) = ztdt*sq(n)  end do!! Perform Gaussian quadrature (multitasked loop)!  call t_startf('quad_tstep')!$OMP PARALLEL DO PRIVATE (N)  do n=1,pmax     call quad(n       ,grlps1  ,grlps2  ,grt1    ,grq1    , &               grz1    ,grd1    ,grfu1   ,grfv1   ,grt2    , &               grq2    ,grz2    ,grd2    ,grfu2   ,grfv2   )!! Transform spectral terms into vertical normal modes!#ifdef HADVTEST!!jr Turn off semi-implicit so T equation is horizontal advection only!        call tstep(n       ,ztdtsq  )#else     call tstep(n       ,ztdtsq)  end do  call t_stopf('quad_tstep')!! Solve vertically de-coupled semi-implicit divergence/vorticity system! in normal mode space!  call t_startf('vertnm')!$OMP PARALLEL DO PRIVATE(K)  do k=1,plev     call vertnm(k)  end do  call t_stopf('vertnm')!! Transform divergence and vorticity back from normal mode space and! complete time advance.!  call t_startf('tstep1')!$OMP PARALLEL DO PRIVATE(N)  do n=1,pmax     call tstep1(n       ,zdt     )  end do#endif  call t_stopf('tstep1')!! Find out if courant limit has been exceeded.  If so, the limiter will! be applied in HORDIF!  call t_startf('courlim')  call courlim(vmax2d  ,vmax2dt ,vcour   )  call t_stopf('courlim')!! Linear part of horizontal diffusion (multitasked loop)!  call t_startf('hordif')!$OMP PARALLEL DO PRIVATE(K)  do k=1,plev     call hordif(k       ,ztdt    )  end do  call t_stopf('hordif')!  returnend subroutine dyndrv#elsesubroutine dyndrv(grlps1  ,grt1    ,grq1    ,grz1    ,grd1    , &                  grfu1   ,grfv1   ,grlps2  ,grt2    ,grq2    , &                  grz2    ,grd2    ,grfu2   ,grfv2   ,vmax2d  , &                  vmax2dt ,vcour   )!-----------------------------------------------------------------------!! Purpose:! Driving routine for Gaussian quadrature, semi-implicit equation! solution and linear part of horizontal diffusion.! The need for this interface routine is to have a multitasking! driver for the spectral space routines it invokes.!! Author:  J. Rosinski!!-----------------------------------------------------------------------  use precision  use pmgrid  use pspect  use comspe  use commap  use time_manager, only: get_step_size#if ( defined SPMD ) && ( defined TIMING_BARRIERS )  use mpishorthand#endif  implicit none!------------------------------Arguments--------------------------------!  real(r8), intent(inout)   :: grlps1(2*pmmax,plat/2)      ! ----------------------------  real(r8), intent(inout)   :: grt1  (plev,2*pmmax,plat/2) ! |  real(r8), intent(inout)   :: grq1  (plev,2*pmmax,plat/2) ! |  real(r8), intent(inout)   :: grz1  (plev,2*pmmax,plat/2) ! |  real(r8), intent(inout)   :: grd1  (plev,2*pmmax,plat/2) ! |  real(r8), intent(inout)   :: grfu1 (plev,2*pmmax,plat/2) ! |  real(r8), intent(inout)   :: grfv1 (plev,2*pmmax,plat/2) ! |  real(r8), intent(inout)   :: grlps2(2*pmmax,plat/2)      ! | definitions: these  real(r8), intent(inout)   :: grt2  (plev,2*pmmax,plat/2) ! | variables are declared here  real(r8), intent(inout)   :: grq2  (plev,2*pmmax,plat/2) ! | for data scoping  real(r8), intent(inout)   :: grz2  (plev,2*pmmax,plat/2) ! |  real(r8), intent(inout)   :: grd2  (plev,2*pmmax,plat/2) ! |  real(r8), intent(inout)   :: grfu2 (plev,2*pmmax,plat/2) ! |  real(r8), intent(inout)   :: grfv2 (plev,2*pmmax,plat/2) ! |  real(r8), intent(inout)   :: vmax2d (plev,plat)   ! max. wind at each level, latitude  real(r8), intent(inout)   :: vmax2dt(plev,plat)   ! max. truncated wind at each lvl,lat  real(r8), intent(inout)   :: vcour  (plev,plat)     ! maximum Courant number in slice!!---------------------------Local workspace-----------------------------!  real(r8) ztdtsq(pnmax)    ! dt*(n(n+1)/a^2)  real(r8) zdt              ! dt  real(r8) ztdt             ! dt  integer irow              ! latitude pair index  integer m                 ! longitudinal wavenumber index  integer n                 ! spectral index  integer k                 ! level index!!-----------------------------------------------------------------------!#if ( defined SPMD )#if ( defined TIMING_BARRIERS )  call t_startf ('sync_realloc3')  call mpibarrier (mpicom)  call t_stopf ('sync_realloc3')#endif  call t_startf ('realloc3')  call realloc3 (grlps1  ,grt1    ,grq1    ,grz1    ,grd1    , &                 grfu1   ,grfv1   ,grlps2  ,grt2    ,grq2    , &                 grz2    ,grd2    ,grfu2   ,grfv2   )  call t_stopf ('realloc3')#endif  call t_startf('dyn')!$OMP PARALLEL DO PRIVATE (IROW)  do irow=begirow,endirow     call dyn(irow    ,grlps1(1,irow),grt1(1,1,irow),grq1(1,1,irow),grz1(1,1,irow), &              grd1(1,1,irow),grfu1(1,1,irow),grfv1(1,1,irow),grlps2(1,irow)  , &                 grt2(1,1,irow), &              grq2(1,1,irow),grz2 (1,1,irow),grd2 (1,1,irow),grfu2 (1,1,irow), &                 grfv2(1,1,irow)  )  end do  call t_stopf('dyn')!!-----------------------------------------------------------------------!! Build vector with del^2 response function!  zdt  = get_step_size()*0.5  ztdt = 2.*zdt  do n=1,pnmax     ztdtsq(n) = ztdt*sq(n)  end do#if ( defined SPMD )#if ( defined TIMING_BARRIERS )  call t_startf ('sync_realloc4')  call mpibarrier (mpicom)  call t_stopf ('sync_realloc4')#endif  call t_startf('realloc4')  call realloc4(grlps1  ,grt1    ,grq1    ,grz1    ,grd1    , &                grfu1   ,grfv1   ,grlps2  ,grt2    ,grq2    , &                grz2    ,grd2    ,grfu2   ,grfv2   )  call t_stopf('realloc4')#endif  call t_startf('quad_tstep')!$OMP PARALLEL DO PRIVATE(M)  do m=begm(iam),endm(iam)!! Perform Gaussian quadrature!     call quad(m       ,grlps1  ,grlps2  ,grt1    ,grq1    , &               grz1    ,grd1    ,grfu1   ,grfv1   ,grt2    , &               grq2    ,grz2    ,grd2    ,grfu2   ,grfv2   )#ifdef HADVTEST!!jr Turn off semi-implicit so T equation is horizontal advection only!        call tstep(m       ,ztdtsq  )#else!! Complete time advance, solve vertically coupled semi-implicit system!     call tstep(m       ,ztdtsq  )!! Solve vertically de-coupled semi-implicit divergence/vorticity system! in normal mode space!     call vertnm(m)!! Transform divergence and vorticity back from normal mode space and! complete time advance.!     call tstep1(m       ,zdt     )#endif  end do  call t_stopf('quad_tstep')!! Find out if courant limit has been exceeded.  If so, the limiter will! be applied in HORDIF!  call t_startf('courlim')  call courlim(vmax2d  ,vmax2dt ,vcour   )  call t_stopf('courlim')!! Linear part of horizontal diffusion!  call t_startf('hordif')!$OMP PARALLEL DO PRIVATE(K)  do k=1,plev     call hordif(k       ,ztdt    )  end do  call t_stopf('hordif')#if ( defined SPMD )#if ( defined TIMING_BARRIERS )  call t_startf ('sync_realloc6')  call mpibarrier (mpicom)  call t_stopf ('sync_realloc6')#endif  call t_startf('realloc6')  call realloc6  call t_stopf('realloc6')#endif  returnend subroutine dyndrv#endif