#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,   grz1,    grd1,    grfu1,    &                  grfv1,   grut1,  grvt1,   grrh1,   grlps2,   &                  grt2,    grz2,   grd2,    grfu2,   grfv2,    &                  grut2,   grvt2,  grrh2,   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.! ! Method: ! ! Author: ! Original version:  J. Rosinski! Standardized:      J. Rosinski, June 1992! Reviewed:          D. Williamson, B. Boville, J. Hack, August 1992! Reviewed:          D. Williamson, March 1996! Reviewed:          B. Boville, April 1996!!-----------------------------------------------------------------------!! $Id: dyndrv.F90,v 1.3 2001/10/19 17:50:31 eaton Exp $! $Author: eaton $!   use precision   use pmgrid   use pspect   use time_manager, only: get_step_size, is_first_step!-----------------------------------------------------------------------   implicit none!------------------------------Commons----------------------------------use commap!------------------------------Arguments--------------------------------!! Input arguments!   real(r8), intent(in) :: grlps1(2*pmmax,plat/2)       ! ----------------------------   real(r8), intent(in) :: grt1(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)   ! |   real(r8), intent(in) :: grfv1(2*pmmax,plev,plat/2)   ! |   real(r8), intent(in) :: grut1(2*pmmax,plev,plat/2)   ! |   real(r8), intent(in) :: grvt1(2*pmmax,plev,plat/2)   ! |   real(r8), intent(in) :: grrh1(2*pmmax,plev,plat/2)   ! |- see linems and quad for   real(r8), intent(in) :: grlps2(2*pmmax,plat/2)       ! |  definitions: these variables are   real(r8), intent(in) :: grt2(2*pmmax,plev,plat/2)    ! |  declared here for data scoping   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) :: grut2(2*pmmax,plev,plat/2)   ! |   real(r8), intent(in) :: grvt2(2*pmmax,plev,plat/2)   ! |   real(r8), intent(in) :: grrh2(2*pmmax,plev,plat/2)   ! ----------------------------   real(r8), intent(in) :: vmax2d(plev,plat)            ! max. wind at each level, latitude   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)              ! 2dt*(n(n+1)/a^2)   real(r8) zdt                          ! dt unless nstep = 0   real(r8) ztdt                         ! 2*zdt (2dt)   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), grz1(1,1,irow), grd1(1,1,irow),&         grfu1(1,1,irow),  grfv1(1,1,irow),  grut1(1,1,irow),  grvt1(1,1,irow),grrh1(1,1,irow),  &         grlps2(1,irow),   grt2(1,1,irow),   grz2(1,1,irow),   grd2(1,1,irow), grfu2(1,1,irow),  &         grfv2(1,1,irow),  grut2(1,1,irow),  grvt2(1,1,irow),  grrh2(1,1,irow)  )   end do   call t_stopf('dyn')!!-----------------------------------------------------------------------!! Build expanded vector with del^2 response function!   zdt = get_step_size()   if (is_first_step()) zdt = .5*zdt   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,       zdt,     ztdtsq,  grlps1,  grlps2,  &                grt1,    grz1,    grd1,    grfu1,   grfv1,   &                grvt1,   grrh1,   grt2,    grz2,    grd2,   &                grfu2,   grfv2,   grvt2,   grrh2   )!! Complete time advance, solve vertically coupled semi-implicit system!#ifdef HADVTEST!!jr Turn off semi-implicit so T equation is horizontal advection only!        call tstep(n,zdt,ztdtsq)#else      call tstep(n,zdt,ztdtsq)#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 (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,    grz1,    grd1,    grfu1,    &                  grfv1,   grut1,   grvt1,   grrh1,   grlps2,   &                  grt2,    grz2,    grd2,    grfu2,   grfv2,    &                  grut2,   grvt2,   grrh2,   vmax2d,  vmax2dt,  &                  vcour   )!-----------------------------------------------------------------------!! 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.!!---------------------------Code history--------------------------------!! Original version:  J. Rosinski! Standardized:      J. Rosinski, June 1992! Reviewed:          D. Williamson, B. Boville, J. Hack, August 1992! Reviewed:          D. Williamson, March 1996!!-----------------------------------------------------------------------   use precision   use pmgrid   use pspect   use comspe   use commap   use time_manager, only: get_step_size, is_first_step#if ( defined SPMD ) && ( defined TIMING_BARRIERS )   use mpishorthand#endif   implicit none!! Input arguments!   real(r8) grlps1(2*pmmax,plat/2)       ! ----------------------------   real(r8) grt1(plev,2*pmmax,plat/2)    ! |   real(r8) grz1(plev,2*pmmax,plat/2)    ! |   real(r8) grd1(plev,2*pmmax,plat/2)    ! |   real(r8) grfu1(plev,2*pmmax,plat/2)   ! |   real(r8) grfv1(plev,2*pmmax,plat/2)   ! |   real(r8) grut1(plev,2*pmmax,plat/2)   ! |   real(r8) grvt1(plev,2*pmmax,plat/2)   ! |   real(r8) grrh1(plev,2*pmmax,plat/2)   ! |- see linems and quad for   real(r8) grlps2(2*pmmax,plat/2)       ! |  definitions: these variables are   real(r8) grt2(plev,2*pmmax,plat/2)    ! |  declared here for data scoping   real(r8) grz2(plev,2*pmmax,plat/2)    ! |   real(r8) grd2(plev,2*pmmax,plat/2)    ! |   real(r8) grfu2(plev,2*pmmax,plat/2)   ! |   real(r8) grfv2(plev,2*pmmax,plat/2)   ! |   real(r8) grut2(plev,2*pmmax,plat/2)   ! |   real(r8) grvt2(plev,2*pmmax,plat/2)   ! |   real(r8) grrh2(plev,2*pmmax,plat/2)   ! ----------------------------   real(r8) vmax2d(plev,plat)            ! max. wind at each level, latitude   real(r8) vmax2dt(plev,plat)           ! max. truncated wind at each lvl,lat   real(r8) vcour(plev,plat)             ! maximum Courant number in slice!!---------------------------Local workspace-----------------------------!   real(r8) ztdtsq(pnmax)                ! 2dt*(n(n+1)/a^2)   real(r8) zdt                          ! dt unless nstep = 0   real(r8) ztdt                         ! 2*zdt (2dt)   integer irow                      ! latitude pair index   integer m                         ! longitudinal wavenumber index   integer n                         ! total wavenumber 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,   grz1,   grd1,    grfu1,    &                  grfv1,   grut1,  grvt1,  grrh1,   grlps2,   &                  grt2,    grz2,   grd2,   grfu2,   grfv2,    &                  grut2,   grvt2,  grrh2   )   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),    &         grz1(1,1,irow),   grd1(1,1,irow),   &         grfu1(1,1,irow),  grfv1(1,1,irow),  &         grut1(1,1,irow),  grvt1(1,1,irow),  &         grrh1(1,1,irow),  &         grlps2(1,irow),   grt2(1,1,irow),   &         grz2(1,1,irow),   grd2(1,1,irow),   &         grfu2(1,1,irow),  &         grfv2(1,1,irow),  grut2(1,1,irow),  &         grvt2(1,1,irow),  grrh2(1,1,irow)  )   end do   call t_stopf('dyn')!!-----------------------------------------------------------------------!! Build vector with del^2 response function!   zdt = get_step_size()   if (is_first_step()) zdt = .5*zdt   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,    grz1,    grd1,    grfu1,   &                 grfv1,   grut1,   grvt1,   grrh1,   grlps2,  &                 grt2,    grz2,    grd2,    grfu2,   grfv2,   &                 grut2,   grvt2,   grrh2    )   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,      zdt,     ztdtsq,  grlps1,  grlps2,  &                grt1,   grz1,    grd1,    grfu1,   grfv1,   &                grvt1,  grrh1,   grt2,    grz2,    grd2,   &                grfu2,  grfv2,   grvt2,   grrh2   )!! Complete time advance, solve vertically coupled semi-implicit system!#ifdef HADVTEST!!jr Turn off semi-implicit so T equation is horizontal advection only!        call tstep(m,zdt,ztdtsq)#else      call tstep(m,zdt,ztdtsq)#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