LCOV - code coverage report
Current view: top level - dynamics/se/dycore - fvm_consistent_se_cslam.F90 (source / functions) Hit Total Coverage
Test: coverage.info Lines: 848 866 97.9 %
Date: 2025-03-13 19:18:33 Functions: 15 15 100.0 %

          Line data    Source code
       1             : module fvm_consistent_se_cslam
       2             :   use shr_kind_mod,           only: r8=>shr_kind_r8
       3             :   use dimensions_mod,         only: nc, nhe, nlev, ntrac, np, nhr, nhc, ngpc, ns, nht
       4             :   use dimensions_mod,         only: irecons_tracer
       5             :   use dimensions_mod,         only: kmin_jet,kmax_jet
       6             :   use cam_abortutils,         only: endrun
       7             :   use cam_logfile,            only: iulog
       8             : 
       9             :   use se_dyn_time_mod,        only: timelevel_t
      10             :   use element_mod,            only: element_t
      11             :   use fvm_control_volume_mod, only: fvm_struct
      12             :   use hybrid_mod,             only: hybrid_t, config_thread_region, get_loop_ranges, threadOwnsVertLevel
      13             :   use perf_mod,               only: t_startf, t_stopf 
      14             :   implicit none
      15             :   private
      16             :   save
      17             : 
      18             :   real (kind=r8),parameter       , private :: eps=1.0e-14_r8
      19             :   public :: run_consistent_se_cslam
      20             : contains
      21             :   !
      22             :   !**************************************************************************************
      23             :   !
      24             :   ! Consistent CSLAM-SE algorithm documented in
      25             :   !
      26             :   ! Lauritzen et al. (2017): CAM-SE-CSLAM: Consistent finite-volume transport with
      27             :   !                          spectral-element dynamics. Mon. Wea. Rev.
      28             :   !
      29             :   !
      30             :   !**************************************************************************************
      31             :   !
      32       44544 :   subroutine run_consistent_se_cslam(elem,fvm,hybrid,dt_fvm,tl,nets,nete,hvcoord,&
      33             :        ghostbufQnhc,ghostBufQ1, ghostBufFlux,kminp,kmaxp)
      34             :     ! ---------------------------------------------------------------------------------
      35             :     use fvm_mod               , only: fill_halo_fvm
      36             :     use fvm_reconstruction_mod, only: reconstruction
      37             :     use fvm_analytic_mod      , only: gauss_points
      38             :     use edge_mod              , only: ghostpack, ghostunpack
      39             :     use edgetype_mod          , only: edgebuffer_t    
      40             :     use bndry_mod             , only: ghost_exchange
      41             :     use hybvcoord_mod         , only: hvcoord_t
      42             :     use constituents          , only: qmin
      43             :     use dimensions_mod        , only: large_Courant_incr,irecons_tracer_lev
      44             :     use thread_mod            , only: vert_num_threads, omp_set_nested
      45             :     implicit none
      46             :     type (element_t)      , intent(inout) :: elem(:)
      47             :     type (fvm_struct), target     , intent(inout) :: fvm(:)
      48             :     type (hybrid_t)       , intent(in)    :: hybrid   ! distributed parallel structure (shared)
      49             :     type (TimeLevel_t)    , intent(in)    :: tl              ! time level struct
      50             :     type (hvcoord_t)      , intent(in)    :: hvcoord
      51             :     integer               , intent(in)    :: nets  ! starting thread element number (private)
      52             :     integer               , intent(in)    :: nete  ! ending thread element number   (private)
      53             :     real (kind=r8)        , intent(in)    :: dt_fvm
      54             :     type (EdgeBuffer_t)   , intent(inout) :: ghostbufQnhc,ghostBufQ1, ghostBufFlux
      55             :     integer               , intent(in)    :: kminp,kmaxp
      56             : 
      57             :     !high-order air density reconstruction
      58       89088 :     real (kind=r8) :: ctracer(irecons_tracer,1-nhe:nc+nhe,1-nhe:nc+nhe,ntrac)
      59             :     real (kind=r8) :: inv_dp_area(nc,nc)
      60             :     type (hybrid_t) :: hybridnew
      61             : 
      62             :     real (kind=r8), dimension(ngpc) :: gsweights, gspts
      63             : 
      64       89088 :     logical :: llimiter(ntrac)
      65             :     integer :: i,j,k,ie,itr,kptr,q
      66             :     integer :: kmin_jet_local,kmax_jet_local
      67             :     integer :: kmin,kmax
      68             :     integer :: ir
      69             :     integer :: kblk               ! total number of vertical levels per thread
      70             :     integer :: klev               ! total number of vertical levels in the JET region  
      71             :     integer :: region_num_threads
      72             :     logical :: inJetCall
      73             :     logical :: ActiveJetThread
      74             : 
      75       44544 :     real(r8), pointer :: fcube(:,:,:,:)
      76       44544 :     real(r8), pointer :: spherecentroid(:,:,:)
      77             : 
      78     1870848 :     llimiter = .true.
      79             : 
      80       44544 :     inJetCall = .false.
      81       44544 :     if(((kminp .ne. 1) .or. (kmaxp .ne. nlev)) .and. vert_num_threads>1) then 
      82           0 :        write(iulog,*)'WARNING: deactivating vertical threading for JET region call'   
      83           0 :        inJetCall = .true.
      84           0 :        region_num_threads = 1
      85             :     else
      86       44544 :        region_num_threads = vert_num_threads
      87             :     endif
      88             : 
      89       44544 :     call omp_set_nested(.true.)
      90             :     !$OMP PARALLEL NUM_THREADS(region_num_threads), DEFAULT(SHARED), & 
      91             :     !$OMP PRIVATE(hybridnew,kblk,ie,k,kmin,gspts,inv_dp_area,itr), &
      92             :     !$OMP PRIVATE(kmin_jet_local,kmax,kmax_jet_local,kptr,q,ctracer,ActiveJetThread)
      93       44544 :     call gauss_points(ngpc,gsweights,gspts) !set gauss points/weights
      94      178176 :     gspts = 0.5_r8*(gspts+1.0_r8) !shift location so in [0:1] instead of [-1:1]
      95             : 
      96       44544 :     if(inJetCall) then 
      97             :       ! ===============================================================================
      98             :       ! if this is the reduced Jet region call then do not thread over the vertical.... 
      99             :       ! Just use the number of vertical levels that were passed into subroutine
     100             :       ! ===============================================================================
     101           0 :       hybridnew = config_thread_region(hybrid,'serial')
     102           0 :       kmin = kminp
     103           0 :       kmax = kmaxp
     104             :     else
     105       44544 :       hybridnew = config_thread_region(hybrid,'vertical')
     106       44544 :       call get_loop_ranges(hybridnew,kbeg=kmin,kend=kmax)
     107             :     endif
     108             : 
     109       44544 :     kblk = kmax-kmin+1
     110             :     !call t_startf('fvm:before_Qnhc')
     111      357744 :     do ie=nets,nete
     112    29440800 :        do k=kmin,kmax
     113  1543762800 :           elem(ie)%sub_elem_mass_flux(:,:,:,k) = dt_fvm*elem(ie)%sub_elem_mass_flux(:,:,:,k)*fvm(ie)%dp_ref_inverse(k)
     114   378972000 :           fvm(ie)%dp_fvm(1:nc,1:nc,k)          =         fvm(ie)%dp_fvm (1:nc,1:nc,k)*fvm(ie)%dp_ref_inverse(k)
     115             :        end do
     116      313200 :        kptr = kmin-1
     117      313200 :        call ghostpack(ghostbufQnhc,fvm(ie)%dp_fvm(1-nhc:nc+nhc,1-nhc:nc+nhc,kmin:kmax)   ,kblk,      kptr,ie)
     118    13198944 :        do q=1,ntrac
     119    12841200 :           kptr = kptr + nlev
     120    13154400 :           call ghostpack(ghostbufQnhc,fvm(ie)%c(1-nhc:nc+nhc,1-nhc:nc+nhc,kmin:kmax,q),kblk,kptr,ie)
     121             :        enddo
     122             :     end do
     123             :     !call t_stopf('fvm:before_Qnhc')
     124             :     !call t_startf('fvm:ghost_exchange:Qnhc')
     125       44544 :     call ghost_exchange(hybridnew,ghostbufQnhc,location='ghostbufQnhc')
     126             :     !call t_stopf('fvm:ghost_exchange:Qnhc')
     127             :     !call t_startf('fvm:orthogonal_swept_areas')
     128      357744 :     do ie=nets,nete
     129    29440800 :       do k=kmin,kmax
     130  1544076000 :         fvm(ie)%se_flux    (1:nc,1:nc,:,k) = elem(ie)%sub_elem_mass_flux(:,:,:,k)
     131             :       end do
     132      313200 :       kptr = kmin-1
     133      313200 :       call ghostunpack(ghostbufQnhc, fvm(ie)%dp_fvm(1-nhc:nc+nhc,1-nhc:nc+nhc,kmin:kmax)   , kblk      ,kptr,ie)
     134    13154400 :       do q=1,ntrac
     135    12841200 :          kptr = kptr + nlev
     136    13154400 :          call ghostunpack(ghostbufQnhc, fvm(ie)%c(1-nhc:nc+nhc,1-nhc:nc+nhc,kmin:kmax,q),kblk,kptr,ie)
     137             :       enddo
     138    29440800 :       do k=kmin,kmax
     139    29440800 :         call compute_displacements_for_swept_areas (fvm(ie),fvm(ie)%dp_fvm(:,:,k),k,gsweights,gspts)
     140             :       end do
     141      313200 :       kptr = 4*(kmin-1)
     142      357744 :       call ghostpack(ghostBufFlux, fvm(ie)%se_flux(:,:,:,kmin:kmax),4*kblk,kptr,ie)
     143             :     end do
     144             : 
     145       44544 :     call ghost_exchange(hybridnew,ghostBufFlux,location='ghostBufFlux')
     146             : 
     147      357744 :     do ie=nets,nete
     148      313200 :       kptr = 4*(kmin-1)
     149      313200 :       call ghostunpack(ghostBufFlux, fvm(ie)%se_flux(:,:,:,kmin:kmax),4*kblk,kptr,ie)
     150    29485344 :       do k=kmin,kmax
     151    29440800 :          call ghost_flux_unpack(fvm(ie),fvm(ie)%se_flux(:,:,:,k))
     152             :       end do
     153             :     enddo
     154             : 
     155             :     !call t_stopf('fvm:orthogonal_swept_areas')
     156      357744 :     do ie=nets,nete
     157             :        ! Intel compiler version 2023.0.0 on derecho had significant slowdown on subroutine interface without
     158             :        ! these pointers.
     159      313200 :       fcube => fvm(ie)%c(:,:,:,:)
     160      313200 :       spherecentroid => fvm(ie)%spherecentroid(:,1-nhe:nc+nhe,1-nhe:nc+nhe)
     161    29485344 :       do k=kmin,kmax
     162             :          !call t_startf('FVM:tracers_reconstruct')
     163             :          call reconstruction(fcube,nlev,k,&
     164             :              ctracer(:,:,:,:),irecons_tracer,llimiter,ntrac,&
     165             :              nc,nhe,nhr,nhc,nht,ns,nhr+(nhe-1),&
     166    29127600 :              fvm(ie)%jx_min,fvm(ie)%jx_max,fvm(ie)%jy_min,fvm(ie)%jy_max,&
     167             :              fvm(ie)%cubeboundary,fvm(ie)%halo_interp_weight,fvm(ie)%ibase,&
     168             :              spherecentroid,&
     169    29127600 :              fvm(ie)%recons_metrics,fvm(ie)%recons_metrics_integral,&
     170             :              fvm(ie)%rot_matrix,fvm(ie)%centroid_stretch,&
     171             :              fvm(ie)%vertex_recons_weights,fvm(ie)%vtx_cart,&
     172    87382800 :              irecons_tracer_lev(k))
     173             :          !call t_stopf('FVM:tracers_reconstruct')
     174             :          !call t_startf('fvm:swept_flux')
     175    29440800 :          call swept_flux(elem(ie),fvm(ie),k,ctracer,irecons_tracer_lev(k),gsweights,gspts)
     176             :          !call t_stopf('fvm:swept_flux')
     177             :       end do
     178             :     end do
     179             :     !
     180             :     !***************************************
     181             :     !
     182             :     ! Large Courant number increment
     183             :     !
     184             :     !***************************************
     185             :     !
     186             :     ! In the jet region the effective Courant number
     187             :     ! in the cslam trajectory algorithm can be > 1
     188             :     ! (by up to 20%) in CAM
     189             :     !
     190             :     ! We limit the trajectories to < 1 but in this step
     191             :     ! we do a piecewise constant update for the
     192             :     ! amount of mass for which the Courant number is >1
     193             :     !
     194             :     !
     195       44544 :     if (large_Courant_incr) then
     196             :       !call t_startf('fvm:fill_halo_fvm:large_Courant')
     197             :       !if (kmin_jet<kmin.or.kmax_jet>kmax) then
     198             :       !  call endrun('ERROR: kmax_jet must be .le. kmax passed to run_consistent_se_cslam')
     199             :       !end if      
     200             :       ! Determine the extent of the JET that is owned by this thread
     201       44544 :       ActiveJetThread = threadOwnsVertLevel(hybridnew,kmin_jet) .or. threadOwnsVertLevel(hybridnew,kmax_jet)
     202       44544 :       kmin_jet_local = max(kmin_jet,kmin)
     203       44544 :       kmax_jet_local = min(kmax_jet,kmax)
     204       44544 :       klev = kmax_jet-kmin_jet+1
     205       44544 :       call fill_halo_fvm(ghostbufQ1,elem,fvm,hybridnew,nets,nete,1,kmin_jet_local,kmax_jet_local,klev,active=ActiveJetThread)
     206             :       !call t_stopf('fvm:fill_halo_fvm:large_Courant')
     207             :       !call t_startf('fvm:large_Courant_number_increment')
     208       44544 :       if(ActiveJetThread) then 
     209     4187136 :         do k=kmin_jet_local,kmax_jet_local !1,nlev
     210    33314736 :           do ie=nets,nete
     211    33270192 :             call large_courant_number_increment(fvm(ie),k)
     212             :           end do
     213             :         end do
     214             :       endif
     215             :       !call t_stopf('fvm:large_Courant_number_increment')
     216             :     end if
     217             : 
     218             :     !call t_startf('fvm:end_of_reconstruct_subroutine')
     219     4187136 :     do k=kmin,kmax
     220             :       !
     221             :       ! convert to mixing ratio
     222             :       !
     223    33314736 :       do ie=nets,nete
     224   116510400 :         do j=1,nc
     225   378658800 :           do i=1,nc
     226   349531200 :             inv_dp_area(i,j) = 1.0_r8/fvm(ie)%dp_fvm(i,j,k)
     227             :           end do
     228             :         end do
     229             :         
     230  1223359200 :         do itr=1,ntrac
     231  4806054000 :           do j=1,nc
     232 15525010800 :             do i=1,nc
     233             :               ! convert to mixing ratio
     234 10748084400 :               fvm(ie)%c(i,j,k,itr) = fvm(ie)%c(i,j,k,itr)*inv_dp_area(i,j)
     235             :               ! remove round-off undershoots
     236 14330779200 :               fvm(ie)%c(i,j,k,itr) = MAX(fvm(ie)%c(i,j,k,itr),qmin(itr))
     237             :             end do
     238             :           end do
     239             :         end do
     240             :         !
     241             :         ! convert to dp and scale back dp
     242             :         !
     243   378658800 :         fvm(ie)%dp_fvm(1:nc,1:nc,k) = fvm(ie)%dp_fvm(1:nc,1:nc,k)*fvm(ie)%dp_ref(k)*fvm(ie)%inv_area_sphere
     244             : #ifdef waccm_debug
     245             :         do j=1,nc
     246             :           do i=1,nc
     247             :             fvm(ie)%CSLAM_gamma(i,j,k,1) = MAXVAL(fvm(ie)%CSLAM_gamma(i,j,k,:))
     248             :           end do
     249             :         end do
     250             : #endif
     251  1547905392 :         elem(ie)%sub_elem_mass_flux(:,:,:,k)=0
     252             :       end do
     253             :     end do
     254             :     !call t_stopf('fvm:end_of_reconstruct_subroutine')
     255             :     !$OMP END PARALLEL 
     256       44544 :     call omp_set_nested(.false.)
     257       89088 :   end subroutine run_consistent_se_cslam
     258             : 
     259    29127600 :   subroutine swept_flux(elem,fvm,ilev,ctracer,irecons_tracer_actual,gsweights,gspts)
     260       44544 :     use fvm_analytic_mod      , only: get_high_order_weights_over_areas
     261             :     use dimensions_mod, only : kmin_jet,kmax_jet
     262             :     implicit none
     263             :     type (element_t) , intent(in)   :: elem
     264             :     type (fvm_struct), intent(inout):: fvm
     265             :     integer          , intent(in) :: ilev, irecons_tracer_actual
     266             :     real (kind=r8), intent(inout) :: ctracer(irecons_tracer,1-nhe:nc+nhe,1-nhe:nc+nhe,ntrac)
     267             :     real (kind=r8), dimension(ngpc), intent(in) :: gsweights, gspts
     268             :     integer, parameter :: num_area=5, num_sides=4, imin= 0, imax=nc+1
     269             :     real (kind=r8)    , dimension(0:7       , imin:imax,imin:imax,num_sides) :: displ
     270             :     integer (kind=r8) , dimension(1:2,11    , imin:imax,imin:imax,num_sides) :: base_vec
     271             :     real (kind=r8)    , dimension(1:2, 6    , imin:imax,imin:imax,num_sides) :: base_vtx
     272             :     integer                  , dimension(2,num_area, imin:imax,imin:imax,num_sides) :: idx
     273             :     real (kind=r8)    , dimension(imin:imax,imin:imax,num_sides)             :: mass_flux_se
     274             :     real (kind=r8)    , dimension(irecons_tracer,num_area) :: weights
     275             :     real (kind=r8)                     :: gamma
     276             :     integer :: i,j,iside,iarea,iw
     277             : 
     278             :     integer, parameter :: num_seg_max=5
     279             :     REAL(KIND=r8), dimension(2,num_seg_max,num_area) :: x, dx, x_static, dx_static
     280             :     integer             , dimension(num_area)               :: num_seg, num_seg_static
     281             :     REAL(KIND=r8), dimension(2,8) :: x_start, dgam_vec
     282             :     REAL(KIND=r8) :: gamma_max, displ_first_guess
     283             : 
     284    58255200 :     REAL(KIND=r8) :: flux,flux_tracer(ntrac)
     285             : 
     286             :     REAL(KIND=r8), dimension(num_area) :: dp_area
     287             : 
     288             :     real (kind=r8) :: dp(1-nhc:nc+nhc,1-nhc:nc+nhc)
     289             :     
     290             :     logical :: tl1,tl2,tr1,tr2
     291             : 
     292             :     integer, dimension(4), parameter :: imin_side = (/1   ,0   ,1   ,1   /)
     293             :     integer, dimension(4), parameter :: imax_side = (/nc  ,nc  ,nc  ,nc+1/)
     294             :     integer, dimension(4), parameter :: jmin_side = (/1   ,1   ,0   ,1   /)
     295             :     integer, dimension(4), parameter :: jmax_side = (/nc+1,nc  ,nc  ,nc  /)
     296             : 
     297             :     integer :: iseg, iseg_tmp,flowcase,ii,jj,itr
     298             : 
     299    29127600 :     call define_swept_areas(fvm,ilev,displ,base_vec,base_vtx,idx)
     300             : 
     301  1543762800 :     mass_flux_se(1:nc,1:nc,1:4)  = -elem%sub_elem_mass_flux(1:nc,1:nc,1:4,ilev)
     302   116510400 :     mass_flux_se(0   ,1:nc,2  )  =  elem%sub_elem_mass_flux(1   ,1:nc,4  ,ilev)
     303   116510400 :     mass_flux_se(nc+1,1:nc,4  )  =  elem%sub_elem_mass_flux(nc  ,1:nc,2  ,ilev)
     304   116510400 :     mass_flux_se(1:nc,0   ,3  )  =  elem%sub_elem_mass_flux(1:nc,1   ,1  ,ilev)
     305   116510400 :     mass_flux_se(1:nc,nc+1,1  )  =  elem%sub_elem_mass_flux(1:nc,nc  ,3  ,ilev)
     306             :     !
     307             :     ! prepare for air/tracer update
     308             :     !
     309             : !    dp = fvm%dp_fvm(1-nhe:nc+nhe,1-nhe:nc+nhe,ilev)
     310  2650611600 :     dp = fvm%dp_fvm(1-nhc:nc+nhc,1-nhc:nc+nhc,ilev)
     311   378658800 :     fvm%dp_fvm(1:nc,1:nc,ilev) = fvm%dp_fvm(1:nc,1:nc,ilev)*fvm%area_sphere
     312  1223359200 :     do itr=1,ntrac
     313 15525010800 :       fvm%c(1:nc,1:nc,ilev,itr) = fvm%c(1:nc,1:nc,ilev,itr)*fvm%dp_fvm(1:nc,1:nc,ilev)
     314  8388748800 :       do iw=1,irecons_tracer_actual
     315  7165389600 :         ctracer(iw,1-nhe:nc+nhe,1-nhe:nc+nhe,itr)=ctracer(iw,1-nhe:nc+nhe,1-nhe:nc+nhe,itr)*&
     316 >23048*10^7 :              dp(1-nhe:nc+nhe,1-nhe:nc+nhe)
     317             :       end do
     318             :     end do
     319             : 
     320   145638000 :     do iside=1,4
     321   553424400 :       do j=jmin_side(iside),jmax_side(iside)
     322  1922421600 :         do i=imin_side(iside),imax_side(iside)
     323             :            !DO NOT USE MASS_FLUX_SE AS THRESHOLD - THRESHOLD CONDITION MUST BE CONSISTENT WITH 
     324             :            !THE ONE USED IN DEFINE_SWEPT_AREAS
     325             : !          if (mass_flux_se(i,j,iside)>eps) then 
     326  1805911200 :           if (fvm%se_flux(i,j,iside,ilev)>eps) then
     327             :             !
     328             :             !        ||             ||
     329             :             !  tl1   ||             || tr1
     330             :             !        ||             ||
     331             :             !  =============================
     332             :             !        ||             ||
     333             :             !  tl2   ||             || tr2
     334             :             !        ||             ||
     335             :             !
     336   699062398 :             tl1 = displ(3,i,j,iside)<0.0_r8.and.displ(6,i,j,iside).ge.0.0_r8 !departure point in tl1 quadrant
     337   699062398 :             tl2 = displ(6,i,j,iside)<0.0_r8.and.displ(7,i,j,iside)   >0.0_r8 !departure point in tl2 quadrant
     338   699062398 :             tr1 = displ(2,i,j,iside)<0.0_r8.and.displ(4,i,j,iside).ge.0.0_r8 !departure point in tr1 quadrant
     339   699062398 :             tr2 = displ(4,i,j,iside)<0.0_r8.and.displ(5,i,j,iside)   >0.0_r8 !departure point in tr2 quadrant
     340             : 
     341             :             !
     342             :             ! pathological cases
     343             :             !
     344             :             !        |  ||           ||                      ||           ||
     345             :             !        |  ||-----------||                      ||-----------||
     346             :             !        |  ||           ||                      ||           ||
     347             :             !  ================================     =================================
     348             :             !           ||           ||                   |  ||           ||
     349             :             !  ---------||           ||             ------|--||           ||
     350             :             !           ||           ||                   |  ||           ||
     351             :             !
     352             :             !                tl1=tl1.or.tl2
     353             :             !                tr1=tr1.or.tr2
     354             :             !                tl1=displ(3,i,j,iside)<0.0_r8.and..not.(tl1.and.tl2)
     355             :             !                tr1=displ(2,i,j,iside)<0.0_r8.and..not.(tr1.and.tr2)
     356             : 
     357  8388748776 :             num_seg=-1; num_seg_static=-1 !initialization
     358   699062398 :             if (.not.tl1.and..not.tl2.and..not.tr1.and..not.tr2) then
     359    13186928 :               flowcase=0
     360             :               !
     361             :               !        ||             ||                 ||             ||                ||             ||
     362             :               !        ||  *       *  ||                 ||  *----------*                 |*----------*  ||
     363             :               !        || /         \ ||                 || /           ||                ||           \ ||
     364             :               !        ||/           \||                 ||/            ||                ||            \||
     365             :               !  =============================     =============================     =============================
     366             :               !        ||             ||                 ||             ||                ||             ||
     367             :               !
     368             :               !
     369             :               call define_area3_center (i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg,&
     370    13186928 :                    num_seg_static,x_start, dgam_vec,fvm%se_flux(i,j,iside,ilev),displ_first_guess)
     371             : 
     372    13186928 :               gamma=1.0_r8!fvm%se_flux(i,j,iside,ilev)
     373    13186928 :               gamma_max = fvm%displ_max(i,j,iside)/displ_first_guess
     374             :             else
     375   685875470 :               if (tl1.and.tr1) then
     376    10844147 :                 flowcase=1
     377             :                 !
     378             :                 !
     379             :                 !  tl1   ||             || tr1             ||             ||                ||             ||
     380             :                 !     *--||-------------||--*           *--||-------------||                ||-------------||--*
     381             :                 !      \ ||             || /             \ ||             ||\              /||             || /
     382             :                 !       \||             ||/               \||             || \            / ||             ||/
     383             :                 !  =============================     =========================*===     ==*==========================
     384             :                 !        ||             ||                 ||             ||                ||             ||
     385             :                 !
     386             :                 call define_area2           (i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static,&
     387    10844147 :                      num_seg, num_seg_static,x_start, dgam_vec,displ_first_guess)
     388             :                 call define_area3_left_right(i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static,&
     389    10844147 :                      num_seg, num_seg_static,x_start, dgam_vec)
     390             :                 call define_area4           (i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static,&
     391    10844147 :                      num_seg, num_seg_static,x_start, dgam_vec)
     392    10844147 :                 gamma=1.0_r8
     393    10844147 :                 gamma_max = fvm%displ_max(i,j,iside)/displ_first_guess
     394   675031323 :               else if (tl1.and..not.tr1.and..not.tr2) then
     395   323731730 :                 flowcase=2
     396             :                 !
     397             :                 !        ||             ||                 ||             ||                ||             ||
     398             :                 !     *--||----------*  ||                /||----------*  ||             *--||-------------*
     399             :                 !      \ ||           \ ||               / ||           \ ||              \ ||             ||
     400             :                 !       \||            \||              /  ||            \||               \||             ||
     401             :                 !  =============================     ==*==========================     =============================
     402             :                 !        ||             ||                 ||             ||                ||             ||
     403             :                 !
     404             :                 call define_area2     (i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg, num_seg_static,&
     405   323731730 :                      x_start, dgam_vec,displ_first_guess)
     406             :                 call define_area3_left(i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg, num_seg_static,&
     407   323731730 :                      x_start, dgam_vec)
     408   323731730 :                 gamma=1.0_r8
     409   323731730 :                 gamma_max = fvm%displ_max(i,j,iside)/displ_first_guess
     410   351299593 :               else if (tr1.and..not.tl1.and..not.tl2) then !displ(3).ge.0.0_r8) then
     411   323632724 :                 flowcase=3
     412             :                 !
     413             :                 !        ||  *----------||--*              ||  *----------||\                *-------------||--*
     414             :                 !        || /           || /               || /           || \              ||             || /
     415             :                 !        ||/            ||/                ||/            ||  \             ||             ||/
     416             :                 !  =============================     ==========================*==     =============================
     417             :                 !        ||             ||                 ||             ||                ||             ||
     418             :                 !        ||             ||                 ||             ||                ||             ||
     419             :                 !        ||             ||                 ||             ||                ||             ||
     420             :                 !
     421             :                 call define_area3_right(i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg, &
     422   323632724 :                      num_seg_static, x_start, dgam_vec)
     423             :                 call define_area4      (i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg, &
     424   323632724 :                      num_seg_static, x_start, dgam_vec,displ_first_guess)
     425   323632724 :                 gamma=1.0_r8
     426   323632724 :                 gamma_max = fvm%displ_max(i,j,iside)/displ_first_guess
     427    27666869 :               else if (tl2.and..not.tr1.and..not.tr2) then !displ(2).ge.0.0_r8) then
     428    13457516 :                 flowcase=4
     429             :                 !
     430             :                 !        ||----------*  ||                 ||-------------*
     431             :                 !       /||           \ ||                /||             ||
     432             :                 !      / ||            \||               / ||             ||
     433             :                 !  ===/=========================     ===/=========================
     434             :                 !     | /||             ||              | /||             ||
     435             :                 !     |/ ||             ||              |/ ||             ||
     436             :                 !     *  ||             ||              *  ||             ||
     437             :                 !
     438             :                 call define_area1_area2(i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg,&
     439    13457516 :                      num_seg_static,x_start, dgam_vec)
     440             :                 call define_area3_left (i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg,&
     441             :                      num_seg_static,&
     442    13457516 :                      x_start, dgam_vec,displ_first_guess)
     443    13457516 :                 gamma = 1.0_r8
     444    13457516 :                 gamma_max = fvm%displ_max(i,j,iside)/displ_first_guess
     445    14209353 :               else if (tr2.and..not.tl1.and..not.tl2) then !displ(3).ge.0.0_r8) then
     446    13454822 :                 flowcase=5
     447             :                 !                case(5)
     448             :                 !
     449             :                 !
     450             :                 !        ||  *-----2----||
     451             :                 !        || /1         3||\
     452             :                 !        ||/      4     || \
     453             :                 !  =============================
     454             :                 !        ||             ||\ |
     455             :                 !        ||             || \|
     456             :                 !        ||             ||  *
     457             :                 !
     458             :                 call define_area3_right(i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg,&
     459    13454822 :                      num_seg_static,x_start, dgam_vec)
     460             :                 call define_area4_area5(i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg,&
     461    13454822 :                      num_seg_static,x_start, dgam_vec,displ_first_guess)
     462    13454822 :                 gamma=1.0_r8
     463    13454822 :                 gamma_max = fvm%displ_max(i,j,iside)/displ_first_guess
     464      754531 :               else if (tl2.and.tr1.and..not.tr2) then
     465      365804 :                 flowcase=6
     466             :                 !                case(6)
     467             :                 !
     468             :                 !
     469             :                 !        ||-------------||--*
     470             :                 !       /||             || /
     471             :                 !      / ||             ||/
     472             :                 !  ===/=========================
     473             :                 !     | /||             ||
     474             :                 !     |/ ||             ||
     475             :                 !     *  ||             ||
     476             :                 !
     477             :                 !
     478             :                 call define_area1_area2     (i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg,&
     479      365804 :                      num_seg_static,x_start, dgam_vec)
     480             :                 call define_area3_left_right(i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg,&
     481      365804 :                      num_seg_static,x_start, dgam_vec)
     482             :                 call define_area4           (i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg,&
     483      365804 :                      num_seg_static,x_start, dgam_vec,displ_first_guess)
     484             : 
     485      365804 :                 gamma=1.0_r8
     486      365804 :                 gamma_max = fvm%displ_max(i,j,iside)/displ_first_guess
     487      388727 :               else if (tr2.and.tl1.and..not.tl2) then
     488      379534 :                 flowcase=7
     489             :                 !                case(7)
     490             :                 !
     491             :                 !
     492             :                 !     *--||-------------||
     493             :                 !      \ ||             ||\
     494             :                 !       \||             || \
     495             :                 !  =============================
     496             :                 !        ||             ||\ |
     497             :                 !        ||             || \|
     498             :                 !        ||             ||  *
     499             :                 !
     500             :                 !
     501             :                 call define_area2           (i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg,&
     502      379534 :                      num_seg_static,x_start, dgam_vec,displ_first_guess)
     503             :                 call define_area3_left_right(i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg,&
     504      379534 :                      num_seg_static,x_start, dgam_vec)
     505             :                 call define_area4_area5     (i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg,&
     506      379534 :                      num_seg_static,x_start, dgam_vec)
     507      379534 :                 gamma =  1.0_r8
     508      379534 :                 gamma_max = fvm%displ_max(i,j,iside)/displ_first_guess
     509        9193 :               else if (tl2.and.tr2) then
     510        9193 :                 flowcase=8
     511             :                 !                case(8)
     512             :                 !
     513             :                 !
     514             :                 !        ||-------------||
     515             :                 !       /||             ||\
     516             :                 !      / ||             || \
     517             :                 !  =============================
     518             :                 !     | /||             ||\ |
     519             :                 !     |/ ||             || \|
     520             :                 !     *  ||             ||  *
     521             :                 !
     522             :                 !
     523             :                 !
     524             :                 !
     525             :                 !
     526             :                 call define_area1_area2     (i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg,&
     527        9193 :                      num_seg_static,x_start, dgam_vec)
     528             :                 call define_area3_left_right(i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg,&
     529        9193 :                      num_seg_static,x_start, dgam_vec)
     530             :                 call define_area4_area5     (i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg,&
     531        9193 :                      num_seg_static,x_start, dgam_vec,displ_first_guess)
     532        9193 :                 gamma =  1.0_r8
     533        9193 :                 gamma_max = fvm%displ_max(i,j,iside)/displ_first_guess
     534             :               else
     535           0 :                 call endrun('ERROR - unknown flow case')
     536             :               end if
     537             :             end if
     538             :             !
     539             :             ! iterate to get flux area
     540             :             !
     541             :             !call t_startf('fvm:swept_area:get_gamma')
     542  4194374388 :             do iarea=1,num_area
     543  4194374388 :               dp_area(iarea) = dp(idx(1,iarea,i,j,iside),idx(2,iarea,i,j,iside))
     544             :             end do
     545             :             call get_flux_segments_area_iterate(x,x_static,dx_static,dx,x_start,dgam_vec,num_seg,num_seg_static,&
     546  2097187194 :                  num_seg_max,num_area,dp_area,flowcase,gamma,mass_flux_se(i,j,iside),0.0_r8,gamma_max,          &
     547  2097187194 :                  gsweights,gspts,ilev)
     548             :             !call t_stopf('fvm:swept_area:get_gamma')
     549             :             !
     550             :             ! pack segments for high-order weights computation
     551             :             !
     552  4194374388 :             do iarea=1,num_area
     553  5592499184 :               do iseg=1,num_seg_static(iarea)
     554  2097187194 :                 iseg_tmp=num_seg(iarea)+iseg
     555  6291561582 :                 x (:,iseg_tmp,iarea)  = x_static (:,iseg,iarea)
     556  9786873572 :                 dx(:,iseg_tmp,iarea)  = dx_static(:,iseg,iarea)
     557             :               end do
     558  4194374388 :               num_seg(iarea)=num_seg(iarea)+MAX(0,num_seg_static(iarea))
     559             :             end do
     560             :             !
     561             :             ! compute higher-order weights
     562             :             !
     563             :             !call t_startf('fvm:swept_area:get_high_order_w')
     564             :             call get_high_order_weights_over_areas(x,dx,num_seg,num_seg_max,num_area,weights,ngpc,&
     565   699062398 :                  gsweights, gspts,irecons_tracer)
     566             :             !call t_stopf('fvm:swept_area:get_high_order_w')
     567             :             !
     568             :             !**************************************************
     569             :             !
     570             :             ! remap air and tracers
     571             :             !
     572             :             !**************************************************
     573             :             !
     574             :             !call t_startf('fvm:swept_area:remap')
     575 29360620716 :             flux=0.0_r8; flux_tracer=0.0_r8
     576  4194374388 :             do iarea=1,num_area
     577  4194374388 :               if (num_seg(iarea)>0) then
     578  1424212608 :                 ii=idx(1,iarea,i,j,iside); jj=idx(2,iarea,i,j,iside)
     579  1424212608 :                 flux=flux+weights(1,iarea)*dp(ii,jj)
     580 59816929536 :                 do itr=1,ntrac
     581 >41017*10^7 :                   do iw=1,irecons_tracer_actual
     582 >40874*10^7 :                     flux_tracer(itr) = flux_tracer(itr)+weights(iw,iarea)*ctracer(iw,ii,jj,itr)
     583             :                   end do
     584             :                 end do
     585             :               end if
     586             :             end do
     587   699062398 :             fvm%se_flux(i,j,iside,ilev) = mass_flux_se(i,j,iside)-flux
     588   699062398 :             if (fvm%se_flux(i,j,iside,ilev)>1.0E-13_r8.and.(ilev<kmin_jet.or.ilev>kmax_jet)) then
     589           0 :               write(iulog,*) "CN excess flux outside of pre-scribed jet region"
     590           0 :               write(iulog,*) "Increase jet region with kmin_jet and kmax_jet ",&
     591           0 :                    ilev,fvm%se_flux(i,j,iside,ilev),mass_flux_se(i,j,iside),flux,flowcase,&
     592           0 :                    kmin_jet,kmax_jet
     593           0 :               call endrun('ERROR in CSLAM: local Courant number is > 1; Increase kmin_jet/kmax_jet?')
     594             :             end if
     595             : 
     596   699062398 :             fvm%dp_fvm(i  ,j  ,ilev        ) = fvm%dp_fvm(i  ,j  ,ilev        )-flux
     597 29360620716 :             fvm%     c(i  ,j  ,ilev,1:ntrac) = fvm%     c(i  ,j  ,ilev,1:ntrac)-flux_tracer(1:ntrac)
     598             :             !
     599             :             ! update flux in nearest neighbor cells
     600             :             !
     601   699062398 :             if (iside==1) then
     602   175795778 :               fvm%dp_fvm(i,j-1,ilev        ) = fvm%dp_fvm(i,j-1,ilev        )+flux
     603  7383422676 :               fvm%     c(i,j-1,ilev,1:ntrac) = fvm%     c(i,j-1,ilev,1:ntrac)+flux_tracer(1:ntrac)
     604             :             end if
     605   699062398 :             if (iside==2) then
     606   166778984 :               fvm%dp_fvm(i+1,j,ilev        ) = fvm%dp_fvm(i+1,j,ilev        )+flux
     607  7004717328 :               fvm%     c(i+1,j,ilev,1:ntrac) = fvm%     c(i+1,j,ilev,1:ntrac)+flux_tracer(1:ntrac)
     608             :             end if
     609   699062398 :             if (iside==3) then
     610   173735422 :               fvm%dp_fvm(i,j+1,ilev        ) = fvm%dp_fvm(i,j+1,ilev        )+flux
     611  7296887724 :               fvm%     c(i,j+1,ilev,1:ntrac) = fvm%     c(i,j+1,ilev,1:ntrac)+flux_tracer(1:ntrac)
     612             :             end if
     613   699062398 :             if (iside==4) then
     614   182752214 :               fvm%dp_fvm(i-1,j,ilev        ) = fvm%dp_fvm(i-1,j,ilev        )+flux
     615  7675592988 :               fvm%     c(i-1,j,ilev,1:ntrac) = fvm%     c(i-1,j,ilev,1:ntrac)+flux_tracer(1:ntrac)
     616             :             end if
     617             :             !call t_stopf('fvm:swept_area:remap')
     618             :           end if
     619             :         end do
     620             :       end do
     621             :     end do    
     622    29127600 :   end subroutine swept_flux
     623             : 
     624             : 
     625    29127600 :   subroutine large_courant_number_increment(fvm,ilev)
     626             :     implicit none
     627             :     type (fvm_struct), intent(inout):: fvm
     628             :     integer          , intent(in) :: ilev
     629             : 
     630             :     integer, parameter :: num_sides=4, imin= 0, imax=nc+1
     631             : 
     632             :     integer, dimension(4), parameter :: imin_side = (/1   ,0   ,1   ,1   /)
     633             :     integer, dimension(4), parameter :: imax_side = (/nc  ,nc  ,nc  ,nc+1/)
     634             :     integer, dimension(4), parameter :: jmin_side = (/1   ,1   ,0   ,1   /)
     635             :     integer, dimension(4), parameter :: jmax_side = (/nc+1,nc  ,nc  ,nc  /)
     636             : 
     637             :     integer :: i,j,iside,itr
     638    58255200 :     real (kind=r8)    :: flux,flux_tracer(ntrac)
     639             :     real (kind=r8), dimension(0:nc+1,0:nc+1)      :: inv_dp_area
     640    58255200 :     real (kind=r8), dimension(0:nc+1,0:nc+1,ntrac):: c_tmp
     641             : 
     642   902955600 :     inv_dp_area=1.0_r8/fvm%dp_fvm(0:nc+1,0:nc+1,ilev)
     643 37050307200 :     c_tmp      = fvm%c(0:nc+1,0:nc+1,ilev,1:ntrac)
     644   145638000 :     do iside=1,4
     645   553424400 :       do j=jmin_side(iside),jmax_side(iside)
     646  1922421600 :         do i=imin_side(iside),imax_side(iside)
     647  1805911200 :           if (fvm%se_flux(i,j,iside,ilev)>eps) then
     648             :             flux = fvm%se_flux(i,j,iside,ilev)
     649             : #ifdef waccm_debug
     650             :             if (i>0.and.j>0.and.i<nc+1.and.j<nc+1) then
     651             :                fvm%CSLAM_gamma(i,j,ilev,iside) = fvm%CSLAM_gamma(i,j,ilev,iside)+&
     652             :                     fvm%se_flux(i,j,iside,ilev)*inv_dp_area(i,j)
     653             :             end if
     654             : #endif
     655             :             
     656     3950646 :             do itr=1,ntrac
     657     3950646 :               flux_tracer(itr) = fvm%se_flux(i,j,iside,ilev)*c_tmp(i,j,itr)*inv_dp_area(i,j)
     658             :             end do
     659       94063 :             fvm%dp_fvm(i  ,j  ,ilev        ) = fvm%dp_fvm(i  ,j  ,ilev        )-flux
     660     3950646 :             fvm%     c(i  ,j  ,ilev,1:ntrac) = fvm%     c(i  ,j  ,ilev,1:ntrac)-flux_tracer(1:ntrac)
     661             :             !
     662             :             ! update flux in nearest neighbor cells
     663             :             !
     664       94063 :             if (iside==1) then
     665        9418 :               fvm%dp_fvm(i,j-1,ilev        ) = fvm%dp_fvm(i,j-1,ilev        )+flux
     666      395556 :               fvm%     c(i,j-1,ilev,1:ntrac) = fvm%     c(i,j-1,ilev,1:ntrac)+flux_tracer(1:ntrac)
     667             :             end if
     668       94063 :             if (iside==2) then
     669       56851 :               fvm%dp_fvm(i+1,j,ilev        ) = fvm%dp_fvm(i+1,j,ilev        )+flux
     670     2387742 :               fvm%     c(i+1,j,ilev,1:ntrac) = fvm%     c(i+1,j,ilev,1:ntrac)+flux_tracer(1:ntrac)
     671             :             end if
     672       94063 :             if (iside==3) then
     673       11572 :               fvm%dp_fvm(i,j+1,ilev        ) = fvm%dp_fvm(i,j+1,ilev        )+flux
     674      486024 :               fvm%     c(i,j+1,ilev,1:ntrac) = fvm%     c(i,j+1,ilev,1:ntrac)+flux_tracer(1:ntrac)
     675             :             end if
     676       94063 :             if (iside==4) then
     677       16222 :               fvm%dp_fvm(i-1,j,ilev        ) = fvm%dp_fvm(i-1,j,ilev        )+flux
     678      681324 :               fvm%     c(i-1,j,ilev,1:ntrac) = fvm%     c(i-1,j,ilev,1:ntrac)+flux_tracer(1:ntrac)
     679             :             end if
     680             :           end if
     681             :         end do
     682             :       end do
     683             :     end do
     684    29127600 :   end subroutine large_courant_number_increment
     685             : 
     686    29127600 :   subroutine ghost_flux_unpack(fvm,var)
     687             :     use control_mod, only : neast, nwest, seast, swest
     688             :     implicit none
     689             :     type (fvm_struct), intent(inout) :: fvm
     690             :     real(kind=r8)                    :: var(1-nhe:nc+nhe,1-nhe:nc+nhe,4)
     691             : 
     692             :     integer :: i,j,ishft
     693             :     !
     694             :     ! rotate coordinates if needed
     695             :     !
     696    29127600 :     if (fvm%cubeboundary.NE.0) then
     697    22525344 :       do j=1-nhe,nc+nhe
     698   116380944 :         do i=1-nhe,nc+nhe
     699    93855600 :           ishft = NINT(fvm%flux_orient(2,i,j))
     700   488049120 :           var(i,j,1:4) = cshift(var(i,j,1:4),shift=ishft)
     701             :         end do
     702             :       end do
     703             :       !
     704             :       ! non-existent cells in physical space - necessary?
     705             :       !
     706     3754224 :       if (fvm%cubeboundary==nwest) then
     707      420732 :         var(1-nhe:0,nc+1 :nc+nhe,:) = 0.0_r8
     708     3721860 :       else if (fvm%cubeboundary==swest) then
     709      420732 :         var(1-nhe:0,1-nhe:0     ,:) = 0.0_r8
     710     3689496 :       else if (fvm%cubeboundary==neast) then
     711      420732 :         var(nc+1 :nc+nhe,nc+1 :nc+nhe,:) = 0.0_r8
     712     3657132 :       else if (fvm%cubeboundary==seast) then
     713      420732 :         var(nc+1 :nc+nhe,1-nhe:0,:) = 0.0_r8
     714             :       end if
     715             :     end if
     716    29127600 :   end subroutine ghost_flux_unpack
     717             : 
     718    29127600 :   subroutine compute_displacements_for_swept_areas(fvm,cair,k,gsweights,gspts)
     719             :     use dimensions_mod, only: large_Courant_incr
     720             :     implicit none
     721             :     type (fvm_struct), intent(inout)     :: fvm
     722             :     integer, intent(in) :: k
     723             :     real (kind=r8)      :: cair(1-nhc:nc+nhc,1-nhc:nc+nhc) !high-order air density reconstruction
     724             :     real (kind=r8), dimension(ngpc), intent(in) :: gsweights, gspts
     725             :     !
     726             :     !   flux iside 1                     flux iside 3                    flux iside 2       flux iside 4
     727             :     !
     728             :     !   |          |                     |  ---1--> |                    |    --2-->|       |--1-->    |
     729             :     !  -4----------3-   /\              -4----------3-                  -4----------3-     -4----------3-   ||
     730             :     !   |          |   /||\              |\\\\\\\\\\|    ||              |   |\\\\\\|       |\\\\\\|   |
     731             :     !   |  --2-->  |    || dv(1)         |\\\\\\\\\\|    ||              |   |\\\\\\|       |\\\\\\|   |
     732             :     !   |----------|    ||               |----------|    || dv(3)        |   |\\\\\\|       |\\\\\\|   |
     733             :     !   |\\\\\\\\\\|    ||               | <--2---  |   \||/             |   |\\\\\\|       |\\\\\\|   |
     734             :     !   |\\\\\\\\\\|    ||               |          |    \/              |   |\\\\\\|       |\\\\\\|   |
     735             :     !  -1----------2-                   -1----------2-                  -1----------2-     -1----------2-
     736             :     !   |  <--1--  |                     |          |                    |    <--1--|       |<--2--
     737             :     !
     738             :     !                                                                     /                          \
     739             :     !   line-integral                                                    <==========         =========>
     740             :     !   from vertex 2                                                     \  dv(2)              dv(4)/
     741             :     !   to 1
     742             :     !
     743             :     !   Note vertical
     744             :     !   lines have
     745             :     !   zero line-
     746             :     !   integral!
     747             :     !
     748             :     integer               :: i,j,iside,ix
     749             :     integer, parameter :: num_area=1, num_seg_max=2
     750             :     REAL(KIND=r8), dimension(2,num_seg_max,num_area,4,nc,nc) :: x_static, dx_static
     751             :     REAL(KIND=r8), dimension(2,num_seg_max,num_area,4,nc,nc) :: x, dx
     752             :     REAL(KIND=r8), dimension(2,num_seg_max,num_area)         :: x_tmp, dx_tmp
     753             :     integer             , dimension(              num_area,4      ) :: num_seg, num_seg_static
     754             :     REAL(KIND=r8), dimension(2,8,                   4,nc,nc) :: x_start, dgam_vec
     755             :     REAL(KIND=r8), dimension(num_area) :: dp_area
     756             :     integer, dimension(4) :: flowcase
     757             :     REAL(KIND=r8)  :: gamma(4), flux_se
     758             : 
     759    29127600 :     num_seg_static(1,1) =  1; num_seg(1,1) = 1; flowcase(1) = -1
     760    29127600 :     num_seg_static(1,2) =  0; num_seg(1,2) = 2; flowcase(2) = -2
     761    29127600 :     num_seg_static(1,3) =  1; num_seg(1,3) = 1; flowcase(3) = -1
     762    29127600 :     num_seg_static(1,4) =  0; num_seg(1,4) = 2; flowcase(4) = -4
     763             : 
     764   116510400 :     do j=1,nc
     765   378658800 :        do i=1,nc
     766   873828000 :           do ix=1,2
     767   524296800 :              iside=1;
     768   524296800 :              x_static (ix,1,1,iside,i,j) = fvm%vtx_cart(2,ix,i,j)
     769   524296800 :              dx_static(ix,1,1,iside,i,j) = fvm%vtx_cart(1,ix,i,j)-fvm%vtx_cart(2,ix,i,j)
     770   524296800 :              x_start  (ix,1,  iside,i,j) = fvm%vtx_cart(1,ix,i,j)
     771   524296800 :              x_start  (ix,2,  iside,i,j) = fvm%vtx_cart(2,ix,i,j)
     772   524296800 :              dgam_vec (ix,1,  iside,i,j) = fvm%vtx_cart(4,ix,i,j)-fvm%vtx_cart(1,ix,i,j)
     773             :              !
     774             :              ! compute first guess
     775             :              !
     776   524296800 :              gamma(iside)                       = 0.5_r8
     777   524296800 :              x        (ix,1,1,iside,i,j) = x_start(ix,1,iside,i,j)+gamma(iside)*dgam_vec(ix,1,iside,i,j)
     778   524296800 :              dx       (ix,1,1,iside,i,j) = -dx_static(ix,1,1,iside,i,j)
     779             :              !
     780             :              ! side 2
     781             :              !
     782   524296800 :              iside=2;
     783   524296800 :              x_start  (ix,1,  iside,i,j) = fvm%vtx_cart(2,ix,i,j)
     784   524296800 :              x_start  (ix,2,  iside,i,j) = fvm%vtx_cart(3,ix,i,j)
     785   524296800 :              dgam_vec (ix,1,  iside,i,j) = fvm%vtx_cart(1,ix,i,j)-fvm%vtx_cart(2,ix,i,j)
     786   524296800 :              x        (ix,1,1,iside,i,j) = x_start(ix,1,iside,i,j)
     787             :              !
     788             :              ! compute first guess - gamma=1
     789             :              !
     790   524296800 :              gamma(iside)                       = 0.5_r8
     791   524296800 :              dx       (ix,1,1,iside,i,j) =  gamma(iside)*dgam_vec (ix,1,  iside,i,j)
     792   524296800 :              x        (ix,2,1,iside,i,j) =  x_start(ix,2,iside,i,j)+gamma(iside)*dgam_vec(ix,1,iside,i,j)
     793   524296800 :              dx       (ix,2,1,iside,i,j) = -gamma(iside)*dgam_vec (ix,1,  iside,i,j)
     794             :              !
     795             :              ! side 3
     796             :              !
     797   524296800 :              iside=3;
     798   524296800 :              x_static (ix,1,1,iside,i,j) = fvm%vtx_cart(4,ix,i,j)
     799   524296800 :              dx_static(ix,1,1,iside,i,j) = fvm%vtx_cart(3,ix,i,j)-fvm%vtx_cart(4,ix,i,j)
     800   524296800 :              x_start  (ix,1,  iside,i,j) = fvm%vtx_cart(3,ix,i,j)
     801   524296800 :              x_start  (ix,2,  iside,i,j) = fvm%vtx_cart(4,ix,i,j)
     802   524296800 :              dgam_vec (ix,1,  iside,i,j) = fvm%vtx_cart(2,ix,i,j)-fvm%vtx_cart(3,ix,i,j)
     803             :              !
     804             :              ! compute first guess - gamma(iside)=1
     805             :              !
     806   524296800 :              gamma(iside)                       = 0.5_r8
     807   524296800 :              x        (ix,1,1,iside,i,j) = x_start(ix,1,iside,i,j)+gamma(iside)*dgam_vec(ix,1,iside,i,j)
     808   524296800 :              dx       (ix,1,1,iside,i,j) = -dx_static(ix,1,1,iside,i,j)
     809             :              !
     810             :              ! side 4
     811             :              !
     812   524296800 :              iside=4;
     813   524296800 :              x_start  (ix,1,  iside,i,j) = fvm%vtx_cart(1,ix,i,j)
     814   524296800 :              x_start  (ix,2,  iside,i,j) = fvm%vtx_cart(4,ix,i,j)
     815   524296800 :              dgam_vec (ix,1,  iside,i,j) = fvm%vtx_cart(2,ix,i,j)-fvm%vtx_cart(1,ix,i,j)
     816   524296800 :              x        (ix,2,1,iside,i,j) = x_start(ix,2,iside,i,j)
     817             :              !
     818             :              ! compute first guess - gamma(iside)=1
     819             :              !
     820   524296800 :              gamma(iside)                       = 0.5_r8
     821   524296800 :              dx       (ix,2,1,iside,i,j) =  gamma(iside)*dgam_vec (ix,1,  iside,i,j)
     822   524296800 :              x        (ix,1,1,iside,i,j) =  x_start(ix,1,iside,i,j)+gamma(iside)*dgam_vec(ix,1,iside,i,j)
     823   786445200 :              dx       (ix,1,1,iside,i,j) = -gamma(iside)*dgam_vec (ix,1,  iside,i,j)
     824             :           end do
     825             :        end do
     826             :     end do
     827             : 
     828             : !    do k=1,nlev
     829   116510400 :       do j=1,nc
     830   378658800 :         do i=1,nc
     831   524296800 :           dp_area = cair(i,j)
     832  1398124800 :           do iside=1,4
     833  1048593600 :             flux_se = -fvm%se_flux(i,j,iside,k)
     834  1310742000 :             if (flux_se>eps) then
     835   524296799 :               gamma(iside)=0.5_r8
     836             :               !
     837             :               ! this copying is necessary since get_flux_segments_area_iterate change x and dx
     838             :               !
     839  3408261280 :               x_tmp (:,1:num_seg(1,iside),:)=x (:,1:num_seg(1,iside),:,iside,i,j)
     840  3408261280 :               dx_tmp(:,1:num_seg(1,iside),:)=dx(:,1:num_seg(1,iside),:,iside,i,j)
     841             :               call get_flux_segments_area_iterate(&
     842             :                    x_tmp(:,:,:),x_static(:,:,:,iside,i,j),dx_static(:,:,:,iside,i,j),dx_tmp(:,:,:),&
     843             :                    x_start(:,:,iside,i,j),dgam_vec(:,:,iside,i,j),num_seg(:,iside),num_seg_static(:,iside),&
     844             :                    num_seg_max,num_area,dp_area,flowcase(iside),gamma(iside),flux_se,0.0_r8,1.0_r8,        &
     845   524296799 :                    gsweights,gspts,k)
     846  1572890397 :               fvm%se_flux(i,j,iside,k) = ABS(SUM(gamma(iside)*dgam_vec(:,1,iside,i,j)))
     847             : #ifdef waccm_debug
     848             :               fvm%CSLAM_gamma(i,j,k,iside) = gamma(iside)
     849             : #endif              
     850   524296799 :               if (gamma(iside)>1_r8) then
     851           0 :                  if (.not.large_Courant_incr) then
     852           0 :                     write(iulog,*) 'ERROR in CSLAM: local Courant number is >1: gamma=',gamma(iside),' k=',k
     853           0 :                     call endrun('ERROR in CSLAM: local Courant number is > 1; set namelist se_large_Courant_incr=.true. ')
     854             :                  endif
     855           0 :                 gamma(iside)=1.0_r8-eps
     856             :               end if              
     857             :             else
     858   524296801 :               fvm%se_flux(i,j,iside,k) = 0.0_r8
     859             : #ifdef waccm_debug
     860             :               fvm%CSLAM_gamma(i,j,k,iside) = 0.0_r8
     861             : #endif                            
     862             :             end if
     863             :           enddo
     864             :         end do
     865             :       end do
     866             : !    end do
     867    29127600 :   end subroutine compute_displacements_for_swept_areas
     868             : 
     869             : 
     870             : 
     871  1223359197 :   subroutine get_flux_segments_area_iterate(x,x_static,dx_static,dx,x_start,dgam_vec,num_seg,num_seg_static,&
     872  1223359197 :        num_seg_max,num_area,c,flow_case,gamma,flux,gamma_min,gamma_max,gsweights,gspts,ilev)
     873             :     implicit none
     874             :     integer                                                , intent(in)    :: num_area, num_seg_max
     875             :     REAL(KIND=r8), dimension(2,num_seg_max,num_area), intent(in)    :: x_static, dx_static
     876             :     REAL(KIND=r8), dimension(2,num_seg_max,num_area), intent(inout) :: x, dx
     877             :     integer             , dimension(num_area              ), intent(in) :: num_seg, num_seg_static
     878             :     REAL(KIND=r8), dimension(2,8)                   , intent(in) :: x_start, dgam_vec
     879             :     REAL(KIND=r8)                                   , intent(inout) :: gamma
     880             :     REAL(KIND=r8)                                   , intent(in) :: flux,gamma_min,gamma_max
     881             :     integer                                                , intent(in) :: flow_case,ilev
     882             : 
     883             :     real (kind=r8), dimension(num_area)             , intent(in) :: c
     884             :     real (kind=r8), dimension(ngpc)                 , intent(in) :: gsweights, gspts
     885             : 
     886             :     real (kind=r8)                                :: flux_static
     887  2446718394 :     real (kind=r8)                                :: weight_area(num_area), xtmp(2), xtmp2(2)
     888             :     real (kind=r8)                                :: gamma1, gamma2, gamma3, dgamma, f1, f2
     889             : 
     890             :     real (kind=r8), dimension(  ngpc  ) :: xq,yq
     891             :     real (kind=r8), dimension(  ngpc,1) :: F !linear
     892             : 
     893  1223359197 :     real (kind=r8) :: xq2,xq2i, rho, rhoi, yrh, w_static(num_area)
     894             : 
     895             :     integer :: iseg,iarea,iter,ipt
     896             :     integer, parameter :: iter_max=40
     897             :     logical :: lexit_after_one_more_iteration
     898             : 
     899  1223359197 :     lexit_after_one_more_iteration = .false.
     900             :     !
     901             :     ! compute static line-integrals (not necessary to recompute them for every iteration)
     902             :     !
     903  1223359197 :     flux_static = 0.0_r8
     904  5242967986 :     w_static    = 0.0_r8
     905  5242967986 :     weight_area = 0.0_r8
     906  5242967986 :     do iarea=1,num_area
     907  6378833687 :        do iseg=1,num_seg_static(iarea)
     908             : 
     909             : !rck vector directive needed here
     910             : !DIR$ SIMD
     911  9436899592 :           do ipt=1,ngpc
     912  7077674694 :              xq(ipt) = x_static(1,iseg,iarea)+dx_static(1,iseg,iarea)*gspts(ipt)! create quadrature point locations
     913  7077674694 :              yq(ipt) = x_static(2,iseg,iarea)+dx_static(2,iseg,iarea)*gspts(ipt)
     914  9436899592 :              F(ipt,1) = yq(ipt)/(SQRT(1.0_r8+xq(ipt)*xq(ipt) + yq(ipt)*yq(ipt))*(1.0_r8+xq(ipt)*xq(ipt)))! potential ! potential
     915             :           enddo
     916 13456508381 :           weight_area(iarea) = weight_area(iarea)+sum(gsweights(:)*F(:,1))*0.5_r8*dx_static(1,iseg,iarea) !integral
     917             :        end do
     918  4019608789 :        w_static(iarea)= weight_area(iarea)
     919  5242967986 :        flux_static = flux_static+weight_area(iarea)*c(iarea)      !add to swept flux
     920             :     end do
     921             :     !
     922             :     ! initilization
     923             :     !
     924  1223359197 :     gamma1=0.0_r8; f1=-flux   ! zero flux guess 1
     925             :     !
     926             :     ! compute flux integrals of first guess passed to subroutine
     927             :     !
     928  1223359197 :     gamma2=gamma
     929  1223359197 :     f2 = 0.0_r8
     930  5242967986 :     weight_area=w_static
     931  5242967986 :     do iarea=1,num_area
     932  7693864639 :        do iseg=1,num_seg(iarea)
     933             : !rck vector directive needed here
     934             : !DIR$ SIMD
     935 14697023400 :           do ipt=1,ngpc
     936 11022767550 :              xq(ipt)  = x(1,iseg,iarea)+dx(1,iseg,iarea)*gspts(ipt)! create quadrature point locations
     937 11022767550 :              yq(ipt)  = x(2,iseg,iarea)+dx(2,iseg,iarea)*gspts(ipt)
     938 11022767550 :              xq2      =  xq(ipt)*xq(ipt)
     939 11022767550 :              xq2i     =  1.0_r8/(1.0_r8+xq2)
     940 11022767550 :              rho      =  SQRT(1.0_r8+xq2+yq(ipt)*yq(ipt))
     941 11022767550 :              rhoi     =  1.0_r8/rho
     942 11022767550 :              yrh      =  yq(ipt)*rhoi
     943 14697023400 :              F(ipt,1) =  yrh*xq2i
     944             :           enddo
     945 18716632189 :           weight_area(iarea) = weight_area(iarea)+sum(gsweights(:)*F(:,1))*0.5_r8*dx(1,iseg,iarea)! integral
     946             :        end do
     947  5242967986 :        f2 = f2+weight_area(iarea)*c(iarea)
     948             :     end do
     949  1223359197 :     f2 = f2-flux !integral error
     950  1223359197 :     iter=0
     951  1223359197 :     if (abs(f2-f1)<eps) then
     952             :       !
     953             :       ! in case the first guess is converged
     954             :       !
     955             :       return
     956             :     end if
     957             :     
     958             : 
     959  1223359197 :     dgamma=(gamma2-gamma1)*f2/(f2-f1);
     960  1223359197 :     gamma3 = gamma2-dgamma;                    ! Newton "guess" for gamma
     961  1223359197 :     gamma1 = gamma2; f1 = f2; gamma2 = gamma3; ! prepare for iteration
     962  3423715905 :     do iter=1,iter_max
     963             :        !
     964             :        ! update vertex location: flow_case dependent to avoid many zero operations
     965             :        !
     966  3855597594 :        select case(flow_case)
     967             :        case(-4)
     968   431881689 :           iarea=1
     969  1295645067 :           dx       (:,2,1) =  gamma3*dgam_vec (:,1)
     970  1295645067 :           x        (:,1,1) =  x_start(:,1)+gamma3*dgam_vec(:,1)
     971  1295645067 :           dx       (:,1,1) = -gamma3*dgam_vec (:,1)
     972             : 
     973             :        case(-2)
     974   387734063 :           iarea=1
     975  1163202189 :           dx       (:,1,iarea) =  gamma3*dgam_vec (:,1)
     976  1163202189 :           x        (:,2,iarea) =  x_start(:,2)+gamma3*dgam_vec(:,1)
     977  1163202189 :           dx       (:,2,iarea) = -gamma3*dgam_vec (:,1)
     978             :        case(-1)
     979             :           !
     980             :           ! to compute first-guess perpendicular displacements for iside=1
     981             :           !
     982   808995093 :           iarea=1          
     983  2426985279 :           x        (:,1,iarea) = x_start(:,1)+gamma3*dgam_vec(:,1)
     984  2426985279 :           dx       (:,1,iarea) = -dx_static(:,1,iarea)
     985  2426985279 :           x        (:,2,iarea) = x_start(:,2)+gamma3*dgam_vec(:,1)
     986  2426985279 :           dx       (:,2,iarea) = x_start(:,2)-x(:,2,iarea)
     987             :        case(0)
     988    35890700 :           iarea=3
     989   107672100 :           xtmp = x_start(:,1)+gamma3*dgam_vec(:,1)
     990   107672100 :           dx       (:,1,iarea) = xtmp(:  )-x(:,1,iarea)           !dynamic - line 2
     991   107672100 :           x        (:,2,iarea) = xtmp(:  )                        !dynamic - line 3
     992   107672100 :           dx       (:,2,iarea) = x_static(:,2,iarea)-x(:,2,iarea) !dynamic - line 3
     993             :        case(1)
     994    22580687 :           iarea=2
     995    67742061 :           xtmp(:        ) = x_start(:,1)+gamma3*dgam_vec(:,1)
     996    67742061 :           dx  (:,1,iarea) = xtmp(:)-x(:,1,iarea)        !dynamic - line 2
     997    67742061 :           x   (:,2,iarea) = xtmp(:)                     !dynamic  - line 3
     998    67742061 :           dx  (:,2,iarea) = x_static(:,1,iarea)-xtmp(:) !dynamic - line 3
     999             : 
    1000    22580687 :           iarea            = 3
    1001    67742061 :           xtmp (:  )       = x_start(:,4)+gamma3*dgam_vec(:,4)
    1002    67742061 :           xtmp2(:  )       = x_start(:,5)+gamma3*dgam_vec(:,5)
    1003    67742061 :           dx   (:,1,iarea) = xtmp(:)-x(:,1,iarea)       !dynamic
    1004    67742061 :           x    (:,2,iarea) = xtmp (:)         !dynamic
    1005    67742061 :           dx   (:,2,iarea) = xtmp2(:)-xtmp(:) !dynamic
    1006    67742061 :           x    (:,3,iarea) = xtmp2(:)              !dynamic
    1007    67742061 :           dx   (:,3,iarea) = x_start(:,5)-xtmp2(:) !dynamic
    1008             : 
    1009    22580687 :           iarea         = 4
    1010    67742061 :           xtmp    (:  ) = x_start(:,6)+gamma3*dgam_vec(:,6)
    1011    67742061 :           dx       (:,1,iarea) = xtmp(:)-x(:,1,iarea)    !dynamic - line 2
    1012    67742061 :           x        (:,2,iarea) = xtmp(:)                     !dynamic  -line 2
    1013    67742061 :           dx       (:,2,iarea) = x_static(:,1,iarea)-xtmp(:) !dynamic - line 2
    1014             :        case(2)
    1015   824750996 :           iarea=2
    1016  2474252988 :           xtmp(:        ) = x_start(:,1)+gamma3*dgam_vec(:,1)
    1017  2474252988 :           dx  (:,1,iarea) = xtmp(:)-x(:,1,iarea)        !dynamic - line 2
    1018  2474252988 :           x   (:,2,iarea) = xtmp(:)                     !dynamic  - line 3
    1019  2474252988 :           dx  (:,2,iarea) = x_static(:,1,iarea)-xtmp(:) !dynamic - line 3
    1020             : 
    1021   824750996 :           iarea=3
    1022  2474252988 :           xtmp(:        ) = x_start(:,4)+gamma3*dgam_vec(:,4)!
    1023  2474252988 :           dx  (:,1,iarea) = xtmp(:)-x(:,1,iarea)        !dynamic - line 1
    1024  2474252988 :           x   (:,2,iarea) = xtmp(:)                     !dynamic  -line 2
    1025  2474252988 :           dx  (:,2,iarea) = x_static(:,1,iarea)-xtmp(:) !dynamic - line 2
    1026             :        case(3)
    1027   826372229 :           iarea         = 3
    1028  2479116687 :           xtmp    (:  ) = x_start(:,5)+gamma3*dgam_vec(:,5)
    1029  2479116687 :           dx       (:,1,iarea) = xtmp(:)-x(:,1,iarea) !dynamic - line 2
    1030  2479116687 :           x        (:,2,iarea) = xtmp(:)                     !dynamic  -line 2
    1031  2479116687 :           dx       (:,2,iarea) = x_static(:,2,iarea)-xtmp(:) !dynamic - line 2
    1032             : 
    1033   826372229 :           iarea         = 4
    1034  2479116687 :           xtmp    (:  ) = x_start(:,6)+gamma3*dgam_vec(:,6)
    1035  2479116687 :           dx       (:,1,iarea) = xtmp(:)-x(:,1,iarea)    !dynamic - line 2
    1036  2479116687 :           x        (:,2,iarea) = xtmp(:)                     !dynamic  -line 2
    1037  2479116687 :           dx       (:,2,iarea) = x_static(:,1,iarea)-xtmp(:) !dynamic - line 2
    1038             :        case(4)
    1039    42138372 :           iarea           = 1
    1040   126415116 :           xtmp(:        ) = x_start(:,1)+gamma3*dgam_vec(:,1)
    1041   126415116 :           dx  (:,1,iarea) = xtmp(:)-x(:,1,iarea)       !dynamic
    1042   126415116 :           x (:,2,iarea) = xtmp(:)                      !dynamic
    1043   126415116 :           dx(:,2,iarea) = x_static(:,1,iarea)-xtmp(:)  !dynamic
    1044             : 
    1045    42138372 :           iarea         = 2
    1046   126415116 :           xtmp    (:  ) = x_start(:,2)+gamma3*dgam_vec(:,2)
    1047   126415116 :           xtmp2   (:  ) = x_start(:,3)+gamma3*dgam_vec(:,3)
    1048             : 
    1049   126415116 :           dx  (:,1,iarea) = xtmp(:)-x(:,1,iarea)    !dynamic
    1050             : 
    1051   126415116 :           x (:,2,iarea) = xtmp (:)          !dynamic
    1052   126415116 :           dx(:,2,iarea) = xtmp2(:)-xtmp(:)  !dynamic
    1053             : 
    1054   126415116 :           x (:,3,iarea) = xtmp2(:)                !dynamic
    1055   126415116 :           dx(:,3,iarea) = x(:,1,iarea)-xtmp2(:)   !dynamic
    1056             : 
    1057    42138372 :           iarea            = 3
    1058   126415116 :           xtmp (:        ) = x_start(:,4)+gamma3*dgam_vec(:,4)
    1059   126415116 :           dx   (:,1,iarea) = xtmp(:)-x(:,1,iarea)       !dynamic - line 1
    1060   126415116 :           x    (:,2,iarea) = xtmp(:)                     !dynamic  -line 2
    1061   126415116 :           dx   (:,2,iarea) = x_static(:,1,iarea)-xtmp(:) !dynamic - line 2
    1062             :        case(5)
    1063    41853471 :           iarea                = 3
    1064   125560413 :           xtmp    (:  )        = x_start(:,5)+gamma3*dgam_vec(:,5)
    1065   125560413 :           dx       (:,1,iarea) = xtmp(:)-x(:,1,iarea) !dynamic - line 2
    1066   125560413 :           x        (:,2,iarea) = xtmp(:)                     !dynamic  -line 2
    1067   125560413 :           dx       (:,2,iarea) = x_static(:,2,iarea)-xtmp(:) !dynamic - line 2
    1068             : 
    1069    41853471 :           iarea         = 4
    1070   125560413 :           xtmp    (:  ) = x_start(:,6)+gamma3*dgam_vec(:,6)
    1071   125560413 :           xtmp2   (:  ) = x_start(:,7)+gamma3*dgam_vec(:,7)
    1072             : 
    1073   125560413 :           dx(:,1,iarea) = xtmp(:)-x(:,1,iarea)   !dynamic - line 1
    1074   125560413 :           x (:,2,iarea) = xtmp(:)          !dynamic -line 2
    1075   125560413 :           dx       (:,2,iarea) = xtmp2(:)-xtmp(:) !dynamic - line 2
    1076   125560413 :           x        (:,3,iarea) = xtmp2(:)               !dynamic  -line 1
    1077   125560413 :           dx       (:,3,iarea) = x(:,1,iarea)-xtmp2(:)  !dynamic - line 1
    1078             : 
    1079    41853471 :           iarea             = 5
    1080   125560413 :           xtmp  (:  )       = x_start(:,8)+gamma3*dgam_vec(:,8)
    1081             : 
    1082   125560413 :           dx       (:,1,iarea) = xtmp(:)-x(:,1,iarea)   !dynamic - line 1
    1083   125560413 :           x        (:,2,iarea) = xtmp(:)                     !dynamic -line 2
    1084   125560413 :           dx       (:,2,iarea) = x_static(:,1,iarea)-xtmp(:) !dynamic - line 2
    1085             :        case(6)
    1086      736092 :           iarea = 1
    1087     2208276 :           xtmp(:  ) = x_start(:,1)+gamma3*dgam_vec(:,1)
    1088     2208276 :           dx  (:,1,iarea) = xtmp(:)-x(:,1,iarea)       !dynamic
    1089     2208276 :           x (:,2,iarea) = xtmp(:)                      !dynamic
    1090     2208276 :           dx(:,2,iarea) = x_static(:,1,iarea)-xtmp(:)  !dynamic
    1091             : 
    1092      736092 :           iarea         = 2
    1093     2208276 :           xtmp    (:  ) = x_start(:,2)+gamma3*dgam_vec(:,2)
    1094     2208276 :           xtmp2   (:  ) = x_start(:,3)+gamma3*dgam_vec(:,3)
    1095             : 
    1096     2208276 :           dx(:,1,iarea) = xtmp(:)-x(:,1,iarea)    !dynamic
    1097     2208276 :           x (:,2,iarea) = xtmp (:)          !dynamic
    1098     2208276 :           dx(:,2,iarea) = xtmp2(:)-xtmp(:)  !dynamic
    1099     2208276 :           x (:,3,iarea) = xtmp2(:)                !dynamic
    1100     2208276 :           dx(:,3,iarea) = x(:,1,iarea)-xtmp2(:)   !dynamic
    1101             : 
    1102      736092 :           iarea            = 3
    1103     2208276 :           xtmp (:  )       = x_start(:,4)+gamma3*dgam_vec(:,4)
    1104     2208276 :           xtmp2(:  )       = x_start(:,5)+gamma3*dgam_vec(:,5)
    1105     2208276 :           dx   (:,1,iarea) = xtmp(:)-x(:,1,iarea)       !dynamic
    1106     2208276 :           x    (:,2,iarea) = xtmp (:)         !dynamic
    1107     2208276 :           dx   (:,2,iarea) = xtmp2(:)-xtmp(:) !dynamic
    1108     2208276 :           x    (:,3,iarea) = xtmp2(:)              !dynamic
    1109     2208276 :           dx   (:,3,iarea) = x_start(:,5)-xtmp2(:) !dynamic
    1110             : 
    1111      736092 :           iarea         = 4
    1112     2208276 :           xtmp    (:  ) = x_start(:,6)+gamma3*dgam_vec(:,6)
    1113     2208276 :           dx       (:,1,iarea) = xtmp(:)-x(:,1,iarea)    !dynamic - line 2
    1114     2208276 :           x        (:,2,iarea) = xtmp(:)                     !dynamic  -line 2
    1115     2208276 :           dx       (:,2,iarea) = x_static(:,1,iarea)-xtmp(:) !dynamic - line 2
    1116             :        case(7)
    1117      764163 :           iarea=2
    1118     2292489 :           xtmp(:        ) = x_start(:,1)+gamma3*dgam_vec(:,1)
    1119     2292489 :           dx  (:,1,iarea) = xtmp(:)-x(:,1,iarea)        !dynamic - line 2
    1120     2292489 :           x   (:,2,iarea) = xtmp(:)                     !dynamic  - line 3
    1121     2292489 :           dx  (:,2,iarea) = x_static(:,1,iarea)-xtmp(:) !dynamic - line 3
    1122             : 
    1123      764163 :           iarea            = 3
    1124     2292489 :           xtmp (:  )       = x_start(:,4)+gamma3*dgam_vec(:,4)
    1125     2292489 :           xtmp2(:  )       = x_start(:,5)+gamma3*dgam_vec(:,5)
    1126     2292489 :           dx   (:,1,iarea) = xtmp(:)-x(:,1,iarea)       !dynamic
    1127     2292489 :           x    (:,2,iarea) = xtmp (:)         !dynamic
    1128     2292489 :           dx   (:,2,iarea) = xtmp2(:)-xtmp(:) !dynamic
    1129     2292489 :           x    (:,3,iarea) = xtmp2(:)              !dynamic
    1130     2292489 :           dx   (:,3,iarea) = x_start(:,5)-xtmp2(:) !dynamic
    1131             : 
    1132      764163 :           iarea      = 4
    1133     2292489 :           xtmp    (:  ) = x_start(:,6)+gamma3*dgam_vec(:,6)
    1134     2292489 :           xtmp2   (:  ) = x_start(:,7)+gamma3*dgam_vec(:,7)
    1135             : 
    1136     2292489 :           dx       (:,1,iarea) = xtmp(:)-x(:,1,iarea) !dynamic
    1137     2292489 :           x        (:,2,iarea) = xtmp(:)              !dynamic
    1138     2292489 :           dx       (:,2,iarea) = xtmp2(:)-xtmp(:)     !dynamic
    1139     2292489 :           x        (:,3,iarea) = xtmp2(:)               !dynamic
    1140     2292489 :           dx       (:,3,iarea) = x(:,1,iarea)-xtmp2(:)  !dynamic
    1141             : 
    1142      764163 :           iarea      = 5
    1143     2292489 :           xtmp (:  ) = x_start(:,8)+gamma3*dgam_vec(:,8)
    1144     2292489 :           dx   (:,1,iarea) = xtmp(:)-x(:,1,iarea)   !dynamic - line 1
    1145     2292489 :           x    (:,2,iarea) = xtmp(:)                     !dynamic -line 2
    1146     2292489 :           dx   (:,2,iarea) = x_static(:,1,iarea)-xtmp(:) !dynamic - line 2
    1147             :        case(8)
    1148       18350 :           iarea = 1
    1149       55050 :           xtmp(:  ) = x_start(:,1)+gamma3*dgam_vec(:,1)
    1150       55050 :           dx  (:,1,iarea) = xtmp(:)-x(:,1,iarea)       !dynamic
    1151       55050 :           x (:,2,iarea) = xtmp(:)                      !dynamic
    1152       55050 :           dx(:,2,iarea) = x_static(:,1,iarea)-xtmp(:)  !dynamic
    1153             : 
    1154       18350 :           iarea         = 2
    1155       55050 :           xtmp    (:  ) = x_start(:,2)+gamma3*dgam_vec(:,2)
    1156       55050 :           xtmp2   (:  ) = x_start(:,3)+gamma3*dgam_vec(:,3)
    1157             : 
    1158       55050 :           dx(:,1,iarea) = xtmp(:)-x(:,1,iarea)    !dynamic
    1159       55050 :           x (:,2,iarea) = xtmp (:)          !dynamic
    1160       55050 :           dx(:,2,iarea) = xtmp2(:)-xtmp(:)  !dynamic
    1161       55050 :           x (:,3,iarea) = xtmp2(:)                !dynamic
    1162       55050 :           dx(:,3,iarea) = x(:,1,iarea)-xtmp2(:)   !dynamic
    1163             : 
    1164       18350 :           iarea            = 3
    1165       55050 :           xtmp (:  )       = x_start(:,4)+gamma3*dgam_vec(:,4)
    1166       55050 :           xtmp2(:  )       = x_start(:,5)+gamma3*dgam_vec(:,5)
    1167       55050 :           dx   (:,1,iarea) = xtmp(:)-x(:,1,iarea)       !dynamic
    1168       55050 :           x    (:,2,iarea) = xtmp (:)         !dynamic
    1169       55050 :           dx   (:,2,iarea) = xtmp2(:)-xtmp(:) !dynamic
    1170       55050 :           x    (:,3,iarea) = xtmp2(:)              !dynamic
    1171       55050 :           dx   (:,3,iarea) = x_start(:,5)-xtmp2(:) !dynamic
    1172             : 
    1173       18350 :           iarea      = 4
    1174       55050 :           xtmp    (:  ) = x_start(:,6)+gamma3*dgam_vec(:,6)
    1175       55050 :           xtmp2   (:  ) = x_start(:,7)+gamma3*dgam_vec(:,7)
    1176             : 
    1177       55050 :           dx       (:,1,iarea) = xtmp(:)-x(:,1,iarea) !dynamic
    1178       55050 :           x        (:,2,iarea) = xtmp(:)              !dynamic
    1179       55050 :           dx       (:,2,iarea) = xtmp2(:)-xtmp(:)     !dynamic
    1180       55050 :           x        (:,3,iarea) = xtmp2(:)               !dynamic
    1181       55050 :           dx       (:,3,iarea) = x(:,1,iarea)-xtmp2(:)  !dynamic
    1182             : 
    1183       18350 :           iarea      = 5
    1184       55050 :           xtmp (:  ) = x_start(:,8)+gamma3*dgam_vec(:,8)
    1185       55050 :           dx   (:,1,iarea) = xtmp(:)-x(:,1,iarea)   !dynamic - line 1
    1186       55050 :           x    (:,2,iarea) = xtmp(:)                     !dynamic -line 2
    1187       55050 :           dx   (:,2,iarea) = x_static(:,1,iarea)-xtmp(:) !dynamic - line 2
    1188             :        case default
    1189  3423715905 :           call endrun('flow case not defined in get_flux_segments_area_iterate')
    1190             :        end select
    1191             :        !
    1192             :        ! compute flux integral
    1193             :        !
    1194 14027852050 :        f2 = 0.0_r8
    1195 14027852050 :        weight_area=w_static
    1196 14027852050 :        do iarea=1,num_area
    1197 20489885852 :          do iseg=1,num_seg(iarea)
    1198             : !rck vector directive needed here
    1199             : !DIR$ SIMD
    1200 39542998828 :            do ipt=1,ngpc
    1201             : 
    1202 29657249121 :              xq(ipt) = x(1,iseg,iarea)+dx(1,iseg,iarea)*gspts(ipt)! create quadrature point locations
    1203 29657249121 :              yq(ipt) = x(2,iseg,iarea)+dx(2,iseg,iarea)*gspts(ipt)
    1204             : 
    1205 29657249121 :              xq2      =  xq(ipt)*xq(ipt)
    1206 29657249121 :              xq2i     =  1.0_r8/(1.0_r8+xq2)
    1207 29657249121 :              rho      =  SQRT(1.0_r8+xq2+yq(ipt)*yq(ipt))
    1208 29657249121 :              rhoi     =  1.0_r8/rho
    1209 29657249121 :              yrh      =  yq(ipt)*rhoi
    1210 39542998828 :              F(ipt,1) =  yrh*xq2i
    1211             :            end do
    1212 50147134973 :            weight_area(iarea) = weight_area(iarea)+sum(gsweights(:)*F(:,1))*0.5_r8*dx(1,iseg,iarea)! integral
    1213             :          end do
    1214 14027852050 :          f2 = f2+weight_area(iarea)*c(iarea)
    1215             :        end do
    1216  3423715905 :        f2 = f2-flux !integral error
    1217             : 
    1218             :        !
    1219             :        ! uncommented logic leads to noise in PS in FKESSLER at element boundary
    1220             :        !
    1221             :        !       if (ABS(f2)<eps.or.ABS((gamma2-gamma1)*f2)<eps.or.lexit_after_one_more_iteration) then
    1222             :        !
    1223  4647075102 :        if (ABS(f2)<eps.or.lexit_after_one_more_iteration) then
    1224  1223520027 :          gamma=gamma3
    1225  1223520027 :          if (gamma>gamma_max) then
    1226      160830 :            lexit_after_one_more_iteration=.true.
    1227      160830 :            gamma=gamma_max
    1228      160830 :            gamma3=gamma_max
    1229             :          else
    1230             :            exit
    1231             :          end if
    1232             :        else
    1233             :           !
    1234             :           ! Newton increment
    1235             :           !
    1236  2200195878 :          if (abs(f2-f1)<eps) then
    1237             :            !
    1238             :            ! if entering here abs(f2)>eps and abs(f1)>eps but abs(f2-f1)<eps
    1239             :            !
    1240           7 :            dgamma=-0.5_r8*(gamma2-gamma1)
    1241           7 :            lexit_after_one_more_iteration=.true.
    1242             :          else
    1243  2200195871 :            dgamma=(gamma2-gamma1)*f2/(f2-f1)
    1244             :          endif
    1245  2200195878 :          if (ABS(dgamma)>eps) then
    1246  2200195878 :            gamma3 = gamma2-dgamma;
    1247             :          else
    1248             :            !
    1249             :            ! dgamma set to minimum displacement to avoid f2-f1=0
    1250             :            !
    1251           0 :            gamma3=gamma2-SIGN(1.0_r8,dgamma)*eps
    1252             :          end if
    1253  2200195878 :          gamma3=MAX(gamma3,gamma_min)
    1254             :          !
    1255             :          ! prepare for next iteration
    1256             :          !
    1257  2200195878 :          gamma1 = gamma2; f1 = f2; gamma2 = gamma3;
    1258             :        endif
    1259             :      end do
    1260  1223359197 :      if (iter>iter_max) write(iulog,*) "WARNING: iteration not converged",&
    1261           0 :           ABS(f2),flux,gamma1,gamma2,gamma3,ilev
    1262             :   end subroutine get_flux_segments_area_iterate
    1263             : 
    1264    29127600 :   subroutine define_swept_areas(fvm,ilev,displ,base_vec,base_vtx,idx)
    1265             :     use control_mod, only : neast, nwest, seast, swest
    1266             :     implicit none
    1267             :     type (fvm_struct), intent(inout) :: fvm
    1268             :     integer          , intent(in)    :: ilev
    1269             : 
    1270             : 
    1271             :     integer, parameter :: num_area=5, num_sides=4, imin= 0, imax=nc+1
    1272             :     real (kind=r8)    , dimension(0:7       , imin:imax,imin:imax,num_sides), intent(out) :: displ
    1273             :     integer (kind=r8) , dimension(1:2,11    , imin:imax,imin:imax,num_sides), intent(out) :: base_vec
    1274             :     real (kind=r8)    , dimension(1:2, 6    , imin:imax,imin:imax,num_sides), intent(out) :: base_vtx
    1275             :     integer           , dimension(2,num_area, imin:imax,imin:imax,num_sides), intent(out) :: idx
    1276             : 
    1277             :     real (kind=r8)        :: flux_sum     (0:nc+1,0:nc+1,2)
    1278             :     integer               :: degenerate   (1:nc+1,1:nc+1  )
    1279             :     integer               :: circular_flow(1:nc+1,1:nc+1  )
    1280             :     integer               :: illcond      (1:nc+1,1:nc+1)
    1281             :     integer               :: ib,i,j,sgn, iside, iarea
    1282             : 
    1283             :     !
    1284             :     ! set where reconstruction function is as a function of area and side
    1285             :     !
    1286             :     integer, dimension(num_area*4), parameter :: idx_shift_tmp = (/-1,-1, 0, 1, 1,&  !iside=1
    1287             :                                                                     1, 0, 0, 0, 1,&  !iside=2
    1288             :                                                                     1, 1, 0,-1,-1,&  !iside=3
    1289             :                                                                    -1, 0, 0, 0,-1/)  !iside=4
    1290             : 
    1291             :     integer, dimension(num_area*4), parameter :: idy_shift_tmp = (/-1, 0, 0, 0,-1,&  !iside=1
    1292             :                                                                    -1,-1, 0, 1, 1,&  !iside=2
    1293             :                                                                     1, 0, 0, 0, 1,&  !iside=3
    1294             :                                                                     1, 1, 0,-1,-1/)  !iside=4
    1295             : 
    1296             :     integer, dimension(num_area,4), parameter :: idx_shift = RESHAPE(idx_shift_tmp,(/num_area,4/))
    1297             :     integer, dimension(num_area,4), parameter :: idy_shift = RESHAPE(idy_shift_tmp,(/num_area,4/))
    1298             : 
    1299             :     integer, dimension(4), parameter :: iside_m1 = (/4,1,2,3/)
    1300             :     integer, dimension(4), parameter :: iside_p1 = (/2,3,4,1/)
    1301             :     integer, dimension(4), parameter :: iside_p2 = (/3,4,1,2/)
    1302             :     integer, dimension(4), parameter :: iside_p3 = (/4,1,2,3/)
    1303             : 
    1304             :     integer, dimension(4), parameter :: imin_side = (/1   ,0   ,1   ,1   /)
    1305             :     integer, dimension(4), parameter :: imax_side = (/nc  ,nc  ,nc  ,nc+1/)
    1306             :     integer, dimension(4), parameter :: jmin_side = (/1   ,1   ,0   ,1   /)
    1307             :     integer, dimension(4), parameter :: jmax_side = (/nc+1,nc  ,nc  ,nc  /)
    1308             : 
    1309             : 
    1310             : 
    1311             :     integer :: iur,jur,ilr,jlr,iul,jul,ill,jll
    1312             : 
    1313    29127600 :     ib = fvm%cubeboundary
    1314   728190000 :     flux_sum(0:nc+1,1:nc+1,1) = fvm%se_flux(0:nc+1,0:nc  ,3,ilev)-fvm%se_flux(0:nc+1,1:nc+1,1,ilev)
    1315   757317600 :     flux_sum(1:nc+1,0:nc+1,2) = fvm%se_flux(0:nc  ,0:nc+1,2,ilev)-fvm%se_flux(1:nc+1,0:nc+1,4,ilev)
    1316             : 
    1317             :     !
    1318             :     ! Degenerate case ("two departure points")
    1319             :     !
    1320             :     !           ||  |                        || no change in this situation ||  no change in this situation
    1321             :     !           ||  |                        ||                             ||
    1322             :     !           ||--------                   ||----------                   ||----------
    1323             :     !           ||  |                        ||                             ||
    1324             :     ! =======================      =======================         =====================
    1325             :     !       |   ||                       |   ||                             ||
    1326             :     !  -----|---||                 ------|---||                    ---------||
    1327             :     !       |   ||                       |   ||                             ||
    1328             :     !       |   ||                       |   ||                             ||
    1329             :     !
    1330             :     !
    1331   611679600 :     where (flux_sum(0:nc,1:nc+1,1)*flux_sum(1:nc+1,1:nc+1,1)<0.0_r8.and.flux_sum(1:nc+1,0:nc,2)*flux_sum(1:nc+1,1:nc+1,2)<0.0_r8)
    1332             :        degenerate(:,:) = 0
    1333             :     elsewhere
    1334             :        degenerate(:,:) = 1
    1335             :     end where
    1336             : 
    1337    29127600 :     if (ib>0) then
    1338     3754224 :        if (ib==swest) degenerate(1   ,1   ) = 1
    1339     3721860 :        if (ib==nwest) degenerate(1   ,nc+1) = 1
    1340     3721860 :        if (ib==neast) degenerate(nc+1,nc+1) = 1
    1341     3721860 :        if (ib==seast) degenerate(nc+1,1   ) = 1
    1342             :     end if
    1343             : 
    1344   145638000 :     do j=1,nc+1
    1345   611679600 :        do i=1,nc+1
    1346  1048593600 :           do sgn=-1,1,2
    1347             :              if (&
    1348  3728332800 :                   sgn*flux_sum(i-1,j,1)<0.0_r8.and.sgn*flux_sum(i,j-1,2)>0.0_r8.and.&
    1349  5126457600 :                   sgn*flux_sum(i  ,j,1)>0.0_r8.and.sgn*flux_sum(i,j  ,2)<0.0_r8) then
    1350      719470 :                 circular_flow(i,j) = 0
    1351             :              else
    1352   931363730 :                 circular_flow(i,j) = 1
    1353             :              end if
    1354             :           end do
    1355             :        end do
    1356             :     end do
    1357             :     !
    1358             :     ! wrap around corners
    1359             :     !
    1360    29127600 :     if (ib==nwest) then
    1361       32364 :        flux_sum(0,nc+1,1) = fvm%se_flux(0,nc,3,ilev)-fvm%se_flux(1,nc+1,4,ilev)
    1362       32364 :        flux_sum(1,nc+1,2) = fvm%se_flux(0,nc,3,ilev)-fvm%se_flux(1,nc+1,4,ilev)
    1363             : 
    1364       32364 :        i=1;j=nc+1;
    1365       32364 :        circular_flow(i,j) = 1
    1366       97092 :        do sgn=-1,1,2
    1367             :           if (&
    1368             :                sgn*flux_sum(i,j-1,2)>0.0_r8.and.&
    1369       97092 :                sgn*flux_sum(i  ,j,1)>0.0_r8.and.sgn*flux_sum(i,j  ,2)<0.0_r8) then
    1370          62 :              circular_flow(i,j) = 0
    1371             :           end if
    1372             :        end do
    1373    29095236 :     else if (ib==swest) then
    1374       32364 :        flux_sum(0,1,1) = fvm%se_flux(1,0,4,ilev)-fvm%se_flux(0,1,1,ilev)
    1375       32364 :        flux_sum(1,0,2) = fvm%se_flux(0,1,1,ilev)-fvm%se_flux(1,0,4,ilev)
    1376       32364 :        i=1;j=1;
    1377       32364 :        circular_flow(i,j) = 1
    1378       97092 :        do sgn=-1,1,2
    1379             :           if (&
    1380             :                sgn*flux_sum(i-1,j,1)<0.0_r8.and.&
    1381       97092 :                sgn*flux_sum(i  ,j,1)>0.0_r8.and.sgn*flux_sum(i,j  ,2)<0.0_r8) then
    1382         120 :              circular_flow(i,j) = 0
    1383             :           end if
    1384             :        end do
    1385    29062872 :     else if (ib==neast) then
    1386       32364 :        flux_sum(nc+1,nc+1,1) = fvm%se_flux(nc+1,nc,3,ilev)-fvm%se_flux(nc,nc+1,2,ilev)
    1387       32364 :        flux_sum(nc+1,nc+1,2) = fvm%se_flux(nc,nc+1,2,ilev)-fvm%se_flux(nc+1,nc,3,ilev)
    1388       32364 :        i=nc+1;j=nc+1;
    1389       32364 :        circular_flow(i,j) = 1
    1390       97092 :        do sgn=-1,1,2
    1391             :           if (&
    1392       64728 :                sgn*flux_sum(i-1,j,1)<0.0_r8.and.sgn*flux_sum(i,j-1,2)>0.0_r8.and.&
    1393       32364 :                sgn*flux_sum(i,j  ,2)<0.0_r8) then
    1394          69 :              circular_flow(i,j) = 0
    1395             :           end if
    1396             :        end do
    1397    29030508 :     else if (ib==seast) then
    1398       32364 :        flux_sum(nc+1,1   ,1) = fvm%se_flux(nc,0,2,ilev)-fvm%se_flux(nc+1,1,1,ilev)
    1399       32364 :        flux_sum(nc+1,0   ,2) = fvm%se_flux(nc,0,2,ilev)-fvm%se_flux(nc+1,1,1,ilev)
    1400       32364 :        i=nc+1;j=1;
    1401       32364 :        circular_flow(i,j) = 1
    1402       97092 :        do sgn=-1,1,2
    1403             :           if (&
    1404       64728 :                sgn*flux_sum(i-1,j,1)<0.0_r8.and.sgn*flux_sum(i,j-1,2)>0.0_r8.and.&
    1405       32364 :                sgn*flux_sum(i,j  ,2)<0.0_r8) then
    1406         142 :              circular_flow(i,j) = 0
    1407             :           end if
    1408             :        end do
    1409             :     end if
    1410   611679600 :     illcond = circular_flow*degenerate
    1411             :     !
    1412             :     !
    1413             :     !
    1414             :     !
    1415   145638000 :     do iside=1,4
    1416   553424400 :        do j=jmin_side(iside),jmax_side(iside)
    1417  1922421600 :           do i=imin_side(iside),imax_side(iside)
    1418  1805911200 :              if (fvm%se_flux(i,j,iside,ilev)>eps) then
    1419   699062398 :                 iur = i+idx_shift(4,iside); jur = j+idy_shift(4,iside) !(i,j) index of upper right quadrant
    1420   699062398 :                 ilr = i+idx_shift(5,iside); jlr = j+idy_shift(5,iside) !(i,j) index of lower left  quadrant
    1421   699062398 :                 iul = i+idx_shift(2,iside); jul = j+idy_shift(2,iside) !(i,j) index of upper right quadrant
    1422   699062398 :                 ill = i+idx_shift(1,iside); jll = j+idy_shift(1,iside) !(i,j) index of lower left  quadrant
    1423             : 
    1424             :                 !iside=1
    1425   699062398 :                 if (iside==1) then
    1426   175795778 :                 displ(0,i,j,iside) = -flux_sum   (i  ,j  ,1)*illcond(i,j)     !center left
    1427   175795778 :                 displ(1,i,j,iside) = -flux_sum   (i  ,j  ,1)*illcond(i+1,j)   !center right
    1428   175795778 :                 displ(2,i,j,iside) =  flux_sum   (i+1,j  ,2)*illcond(i+1,j)   !c2
    1429   175795778 :                 displ(3,i,j,iside) = -flux_sum   (i  ,j  ,2)*illcond(i  ,j)   !c3
    1430   175795778 :                 displ(4,i,j,iside) = -flux_sum   (i+1,j  ,1)*illcond(i+1,j)   !r1
    1431   175795778 :                 displ(5,i,j,iside) = -flux_sum   (i+1,j-1,2)*illcond(i+1,j)   !r2
    1432   175795778 :                 displ(6,i,j,iside) = -flux_sum   (i-1,j  ,1)*illcond(i  ,j)   !l1
    1433   175795778 :                 displ(7,i,j,iside) =  flux_sum   (i  ,j-1,2)*illcond(i  ,j)   !l2
    1434             : 
    1435             :                 end if
    1436   699062398 :                 if (iside==2) then
    1437             :                 !iside=2
    1438   166778984 :                 displ(0,i,j,iside) =  flux_sum   (i+1,j  ,2)*illcond(i+1,j  )     !center left
    1439   166778984 :                 displ(1,i,j,iside) =  flux_sum   (i+1,j  ,2)*illcond(i+1,j+1)   !center right
    1440   166778984 :                 displ(2,i,j,iside) =  flux_sum   (i  ,j+1,1)*illcond(i+1,j+1)   !c2
    1441   166778984 :                 displ(3,i,j,iside) = -flux_sum   (i  ,j  ,1)*illcond(i+1,j  )   !c3
    1442   166778984 :                 displ(4,i,j,iside) =  flux_sum   (i+1,j+1,2)*illcond(i+1,j+1)   !r1
    1443   166778984 :                 displ(5,i,j,iside) = -flux_sum   (i+1,j+1,1)*illcond(i+1,j+1)   !r2
    1444   166778984 :                 displ(6,i,j,iside) =  flux_sum   (i+1,j-1,2)*illcond(i+1,j)   !l1
    1445   166778984 :                 displ(7,i,j,iside) =  flux_sum   (i+1,j  ,1)*illcond(i+1,j)   !l2
    1446             :                 end if
    1447             :                 !iside=3
    1448   699062398 :                 if (iside==3) then
    1449   173735422 :                 displ(0,i,j,iside) =  flux_sum   (i  ,j+1,1)*illcond(i+1,j+1)     !center left
    1450   173735422 :                 displ(1,i,j,iside) =  flux_sum   (i  ,j+1,1)*illcond(i  ,j+1)   !center right
    1451   173735422 :                 displ(2,i,j,iside) = -flux_sum   (i  ,j  ,2)*illcond(i  ,j+1)   !c2
    1452   173735422 :                 displ(3,i,j,iside) =  flux_sum   (i+1,j  ,2)*illcond(i+1,j+1)   !c3
    1453   173735422 :                 displ(4,i,j,iside) =  flux_sum   (i-1,j+1,1)*illcond(i  ,j+1)   !r1
    1454   173735422 :                 displ(5,i,j,iside) =  flux_sum   (i  ,j+1,2)*illcond(i  ,j+1)   !r2
    1455   173735422 :                 displ(6,i,j,iside) =  flux_sum   (i+1,j+1,1)*illcond(i+1,j+1)   !l1
    1456   173735422 :                 displ(7,i,j,iside) = -flux_sum   (i+1,j+1,2)*illcond(i+1,j+1)   !l2
    1457             :                 end if
    1458   699062398 :                 if (iside==4) then
    1459             :                 !iside=4
    1460   182752214 :                 displ(0,i,j,iside) = -flux_sum   (i  ,j  ,2)*illcond(i  ,j+1)     !center left
    1461   182752214 :                 displ(1,i,j,iside) = -flux_sum   (i  ,j  ,2)*illcond(i  ,j  )   !center right
    1462   182752214 :                 displ(2,i,j,iside) = -flux_sum   (i  ,j  ,1)*illcond(i  ,j  )   !c2
    1463   182752214 :                 displ(3,i,j,iside) =  flux_sum   (i  ,j+1,1)*illcond(i  ,j+1)   !c3
    1464   182752214 :                 displ(4,i,j,iside) = -flux_sum   (i  ,j-1,2)*illcond(i  ,j  )   !r1
    1465   182752214 :                 displ(5,i,j,iside) =  flux_sum   (i-1,j  ,1)*illcond(i  ,j  )   !r2
    1466   182752214 :                 displ(6,i,j,iside) = -flux_sum   (i  ,j+1,2)*illcond(i  ,j+1)   !l1
    1467   182752214 :                 displ(7,i,j,iside) = -flux_sum   (i-1,j+1,1)*illcond(i  ,j+1)   !l2
    1468             :                 end if
    1469             : 
    1470  2097187194 :                 base_vtx(:,1,i,j,iside) = fvm%vtx_cart(iside,:,i  ,j            )       !vertex center left
    1471  2097187194 :                 base_vtx(:,2,i,j,iside) = fvm%vtx_cart(iside_p1(iside),:,i  ,j  )       !vertex center right
    1472  2097187194 :                 base_vtx(:,3,i,j,iside) = fvm%vtx_cart(iside,:,iur,jur          )       !vertex upper right
    1473  2097187194 :                 base_vtx(:,4,i,j,iside) = fvm%vtx_cart(iside_p3(iside),:,ilr,jlr)       !vertex lower right
    1474  2097187194 :                 base_vtx(:,5,i,j,iside) = fvm%vtx_cart(iside_p1(iside),:,iul,jul)       !vertex upper left
    1475  2097187194 :                 base_vtx(:,6,i,j,iside) = fvm%vtx_cart(iside_p2(iside),:,ill,jll)       !vertex lower left
    1476             : 
    1477  2097187194 :                 base_vec(:, 1,i,j,iside) = fvm%flux_vec    (:,i  ,j  ,iside          )      !vector center
    1478  2097187194 :                 base_vec(:, 2,i,j,iside) = fvm%flux_vec    (:,i  ,j  ,iside_p1(iside))      !vector center right
    1479  2097187194 :                 base_vec(:, 3,i,j,iside) = fvm%flux_vec    (:,i  ,j  ,iside_p3(iside))      !vector center left
    1480  2097187194 :                 base_vec(:, 4,i,j,iside) = fvm%flux_vec    (:,iur,jur,iside          )      !vector upper right 1
    1481  2097187194 :                 base_vec(:, 5,i,j,iside) = fvm%flux_vec    (:,iur,jur,iside_p3(iside))      !vector upper right 2
    1482  2097187194 :                 base_vec(:, 6,i,j,iside) = fvm%flux_vec    (:,ilr,jlr,iside_p3(iside))      !vector lower right 1
    1483  2097187194 :                 base_vec(:, 7,i,j,iside) = fvm%flux_vec    (:,ilr,jlr,iside_p2(iside))      !vector lower right 2
    1484  2097187194 :                 base_vec(:, 8,i,j,iside) = fvm%flux_vec    (:,iul,jul,iside          )      !vector upper left 1
    1485  2097187194 :                 base_vec(:, 9,i,j,iside) = fvm%flux_vec    (:,iul,jul,iside_p1(iside))      !vector upper left 2
    1486  2097187194 :                 base_vec(:,10,i,j,iside) = fvm%flux_vec    (:,ill,jll,iside_p1(iside))      !vector lower left 1
    1487  2097187194 :                 base_vec(:,11,i,j,iside) = fvm%flux_vec    (:,ill,jll,iside_p2(iside))      !vector lower left 2
    1488             : 
    1489  4194374388 :                 do iarea=1,5
    1490  3495311990 :                    idx(1,iarea,i,j,iside) = i+idx_shift(iarea,iside)
    1491  4194374388 :                    idx(2,iarea,i,j,iside) = j+idy_shift(iarea,iside)
    1492             :                 end do
    1493             :              else
    1494  6291561618 :                 displ(:,i,j,iside) = 9D99!for debugging
    1495             :              end if
    1496             :           end do
    1497             :        end do
    1498             :     end do
    1499             :     !
    1500             :     ! wrap around corners here
    1501             :     !
    1502             : 
    1503    29127600 :   end subroutine define_swept_areas
    1504             : 
    1505             : 
    1506             :   !
    1507             :   ! Notation conventions used in define_area subroutines
    1508             :   !
    1509             :   !
    1510             :   !
    1511             :   !   ^    ||--->   ^   <---||    ^
    1512             :   !  /|\   || 3    /|\    2 ||   /|\
    1513             :   !   | 6  ||     1 |       ||    | 4
    1514             :   !   |    ||       |       ||    |
    1515             :   ! =================================
    1516             :   !        ||               ||
    1517             :   !        ||               ||
    1518             :   !      7 ||               || 5
    1519             :   !    <---||               ||--->
    1520             :   !
    1521             : 
    1522    13832513 :   subroutine define_area1_area2(i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg, num_seg_static,&
    1523             :        x_start, dgam_vec)
    1524             :     implicit none
    1525             :     integer, intent(in) :: i,j,iside
    1526             :     integer, parameter :: num_area=5, num_sides=4, imin= 0, imax=nc+1
    1527             :     real (kind=r8)    , dimension(0:7       , imin:imax,imin:imax,num_sides), intent(inout) :: displ
    1528             :     integer (kind=r8) , dimension(1:2,11    , imin:imax,imin:imax,num_sides), intent(inout) :: base_vec
    1529             :     real (kind=r8)    , dimension(1:2, 6    , imin:imax,imin:imax,num_sides), intent(inout) :: base_vtx
    1530             :     integer, parameter :: num_seg_max=5
    1531             :     REAL(KIND=r8), dimension(2,num_seg_max,num_area), intent(inout) :: x, dx, x_static, dx_static
    1532             :     integer             , dimension(num_area)              , intent(inout) :: num_seg, num_seg_static
    1533             :     REAL(KIND=r8), dimension(2,8)                   , intent(inout):: x_start, dgam_vec
    1534             : 
    1535             : 
    1536             :     real (kind=r8)    , dimension(2,3) :: xdep !departure points
    1537             :     real (kind=r8)                     :: gamma
    1538             :     integer :: iarea
    1539             : 
    1540             : 
    1541             :     REAL(KIND=r8) :: xtmp(2),xtmp2(2)
    1542             :     !
    1543             :     !
    1544             :     !        ||-----        ||
    1545             :     !       /||             ||
    1546             :     !      / ||             ||
    1547             :     !  ===X=========================
    1548             :     !     | /||             ||
    1549             :     !     |/ ||             ||
    1550             :     !     *  ||             ||
    1551             :     !
    1552             :     !
    1553             :     ! crossing X
    1554    41497539 :     if (SUM(ABS(base_vec(:,9,i,j,iside))).NE.0) then
    1555    13810962 :        gamma = displ(0,i,j,iside)*displ(7,i,j,iside)/(displ(0,i,j,iside)-displ(6,i,j,iside))
    1556             : !       gamma = MAX(MIN(gamma,displ(7,i,j,iside),-displ(3,i,j,iside)),0.0_r8)!MWR manuscript
    1557    13810962 :        gamma = MAX(MIN(gamma,displ(7,i,j,iside),-0.25_r8*displ(3,i,j,iside)),0.0_r8)
    1558             :     else
    1559             :        !
    1560             :        ! corner case
    1561             :        !
    1562       21551 :        gamma=displ(0,i,j,iside)
    1563             :     end if
    1564             : 
    1565             : 
    1566    41497539 :     xdep    (:,1) = base_vtx(:, 6,i,j,iside)+displ(7,i,j,iside)*base_vec(:,10,i,j,iside)-displ(6,i,j,iside)*base_vec(:,11,i,j,iside)
    1567    41497539 :     x_start (:,1) = base_vtx(:, 6,i,j,iside)
    1568    41497539 :     dgam_vec(:,1) = base_vec(:,10,i,j,iside)*gamma
    1569             : 
    1570    41497539 :     xdep(:,2) = base_vtx(:,2,i,j,iside)+displ(1,i,j,iside)*base_vec(:, 1,i,j,iside)+displ(2,i,j,iside)*base_vec(:, 2,i,j,iside)
    1571             : 
    1572    13832513 :     iarea                  = 1
    1573    13832513 :     num_seg       (iarea)  = 2
    1574    13832513 :     num_seg_static(iarea)  = 1
    1575             : 
    1576    41497539 :     x_static (:,1,iarea) = base_vtx(:,6,i,j,iside)       !static
    1577    41497539 :     dx_static(:,1,iarea) = xdep(:,1)-x_static(:,1,iarea) !static
    1578             : 
    1579    41497539 :     xtmp(:        ) = x_start(:,1)+dgam_vec(:,1)
    1580    41497539 :     x   (:,1,iarea) = xdep(:,1)                  !static
    1581    41497539 :     dx  (:,1,iarea) = xtmp(:)-x(:,1,iarea)       !dynamic
    1582             : 
    1583    41497539 :     x (:,2,iarea) = xtmp(:)                      !dynamic
    1584    41497539 :     dx(:,2,iarea) = x_static(:,1,iarea)-xtmp(:)  !dynamic
    1585             :     !
    1586             :     !
    1587             :     !
    1588    13832513 :     iarea                  = 2
    1589    13832513 :     num_seg       (iarea)  = 3
    1590             : 
    1591    41497539 :     x_start (:,2) = base_vtx(:,5,i,j,iside)
    1592    41497539 :     dgam_vec(:,2) = base_vec(:,9,i,j,iside)*gamma
    1593    41497539 :     xtmp    (:  ) = x_start(:,2)+dgam_vec(:,2)
    1594             : 
    1595    41497539 :     x_start (:,3) = base_vtx(:,5,i,j,iside)
    1596    41497539 :     dgam_vec(:,3) = base_vec(:,8,i,j,iside)*displ(0,i,j,iside)
    1597    41497539 :     xtmp2   (:  ) = x_start(:,3)+dgam_vec(:,3)
    1598             : 
    1599    41497539 :     x   (:,1,iarea) = base_vtx(:,5,i,j,iside) !static
    1600    41497539 :     dx  (:,1,iarea) = xtmp(:)-x(:,1,iarea)    !dynamic
    1601             : 
    1602    41497539 :     x (:,2,iarea) = xtmp (:)          !dynamic
    1603    41497539 :     dx(:,2,iarea) = xtmp2(:)-xtmp(:)  !dynamic
    1604             : 
    1605    41497539 :     x (:,3,iarea) = xtmp2(:)                !dynamic
    1606    41497539 :     dx(:,3,iarea) = x(:,1,iarea)-xtmp2(:)   !dynamic
    1607    13832513 :   end subroutine define_area1_area2
    1608             : 
    1609             : 
    1610   334955411 :   subroutine define_area2(i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg, num_seg_static,x_start, dgam_vec,&
    1611             :        displ_first_guess)
    1612             :     implicit none
    1613             :     integer, intent(in) :: i,j,iside
    1614             :     integer, parameter :: num_area=5, num_sides=4, imin= 0, imax=nc+1
    1615             :     real (kind=r8)    , dimension(0:7       , imin:imax,imin:imax,num_sides), intent(inout) :: displ
    1616             :     integer (kind=r8) , dimension(1:2,11    , imin:imax,imin:imax,num_sides), intent(inout) :: base_vec
    1617             :     real (kind=r8)    , dimension(1:2, 6    , imin:imax,imin:imax,num_sides), intent(inout) :: base_vtx
    1618             :     integer, parameter :: num_seg_max=5
    1619             :     REAL(KIND=r8), dimension(2,num_seg_max,num_area), intent(inout) :: x, dx, x_static, dx_static
    1620             :     integer             , dimension(num_area)              , intent(inout) :: num_seg, num_seg_static
    1621             :     REAL(KIND=r8), dimension(2,8)                   , intent(inout):: x_start, dgam_vec
    1622             : 
    1623             : 
    1624             :     real (kind=r8)    , dimension(2,3) :: xdep !departure points
    1625             :     real (kind=r8), optional, intent(out)        :: displ_first_guess
    1626             :     real (kind=r8) :: gamma
    1627             :     integer :: iarea
    1628             : 
    1629             : 
    1630             :     REAL(KIND=r8) :: xtmp(2)
    1631             :     ! *: xdep(:,1)
    1632             :     ! x: xtmp
    1633             :     !
    1634             :     !      2 ||             ||
    1635             :     !     *--x              ||
    1636             :     !     1\3||1            ||
    1637             :     !       \||             ||
    1638             :     !  =============================
    1639             :     !        ||             ||
    1640             :     !
    1641             :     !
    1642             :     ! compute departure points (xdep(1) is left; xdep(3) is right and xdep(2) is midway
    1643             :     !
    1644             :     xdep(:,1) = base_vtx(:,5,i,j,iside)+&
    1645  1004866233 :          MAX(0.0_r8,displ(6,i,j,iside))*base_vec(:,8,i,j,iside)-displ(3,i,j,iside)*base_vec(:,9,i,j,iside)
    1646  1004866233 :     x_start (:,1) = base_vtx(:,5,i,j,iside)
    1647   334955411 :     gamma         = displ(0,i,j,iside)
    1648  1004866233 :     dgam_vec(:,1) = base_vec(:,8,i,j,iside)*gamma
    1649   334955411 :     if (present(displ_first_guess)) displ_first_guess = gamma
    1650             : 
    1651   334955411 :     iarea                  = 2
    1652   334955411 :     num_seg       (iarea)  = 2
    1653   334955411 :     num_seg_static(iarea)  = 1
    1654             : 
    1655  1004866233 :     x_static (:,1,iarea) = base_vtx(:,5,i,j,iside)       !static  - line 1
    1656  1004866233 :     dx_static(:,1,iarea) = xdep(:,1)-x_static(:,1,iarea) !static  - line 1
    1657             : 
    1658  1004866233 :     xtmp     (:        ) = x_start(:,1)+dgam_vec(:,1)
    1659  1004866233 :     x        (:,1,iarea) = xdep(:,1)                  !static  - line 2
    1660  1004866233 :     dx       (:,1,iarea) = xtmp(:)-x(:,1,iarea)       !dynamic - line 2
    1661             : 
    1662  1004866233 :     x        (:,2,iarea) = xtmp(:)                     !dynamic  - line 3
    1663  1004866233 :     dx       (:,2,iarea) = x_static(:,1,iarea)-xtmp(:) !dynamic - line 3
    1664   334955411 :   end subroutine define_area2
    1665             : 
    1666             : 
    1667   337189246 :   subroutine define_area3_left(i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, &
    1668             :        num_seg, num_seg_static,x_start, dgam_vec,displ_first_guess)
    1669             :     implicit none
    1670             :     integer, intent(in) :: i,j,iside
    1671             :     integer, parameter :: num_area=5, num_sides=4, imin= 0, imax=nc+1
    1672             :     real (kind=r8)    , dimension(0:7       , imin:imax,imin:imax,num_sides), intent(inout) :: displ
    1673             :     integer (kind=r8) , dimension(1:2,11    , imin:imax,imin:imax,num_sides), intent(inout) :: base_vec
    1674             :     real (kind=r8)    , dimension(1:2, 6    , imin:imax,imin:imax,num_sides), intent(inout) :: base_vtx
    1675             :     integer, parameter :: num_seg_max=5
    1676             :     REAL(KIND=r8), dimension(2,num_seg_max,num_area), intent(inout) :: x, dx, x_static, dx_static
    1677             :     integer             , dimension(num_area)              , intent(inout) :: num_seg, num_seg_static
    1678             :     REAL(KIND=r8), dimension(2,8)                   , intent(inout):: x_start, dgam_vec
    1679             :     real (kind=r8), optional, intent(out)        :: displ_first_guess
    1680             : 
    1681             :     real (kind=r8)    , dimension(2,3) :: xdep !departure points
    1682             :     real (kind=r8)                     :: gamma
    1683             :     integer :: iarea
    1684             : 
    1685             : 
    1686             :     REAL(KIND=r8) :: xtmp(2)
    1687             : 
    1688             :     ! iarea = 3
    1689             :     !-------------------------------------------------------------------------------------------
    1690             :     !
    1691             :     !          xtmp         xdep(2)
    1692             :     !           |x-----2------*   ||
    1693             :     !           ||             \  ||
    1694             :     !           |1              3 ||
    1695             :     !           ||               \||
    1696             :     !        ===========4==============
    1697             :     !
    1698             :     !
    1699   337189246 :     xdep(:,2) = base_vtx(:,2,i,j,iside)+displ(1,i,j,iside)*base_vec(:,1,i,j,iside)&
    1700  1348756984 :          +MAX(0.0_r8,displ(2,i,j,iside))*base_vec(:,2,i,j,iside)
    1701  1011567738 :     x_start (:,4) = base_vtx(:,1,i,j,iside)
    1702   337189246 :     gamma         = displ(0,i,j,iside)
    1703  1011567738 :     dgam_vec(:,4) = base_vec(:,1,i,j,iside)*gamma
    1704  1011567738 :     xtmp    (:  ) = x_start(:,4)+dgam_vec(:,4)
    1705             : 
    1706   337189246 :     if (present(displ_first_guess)) displ_first_guess = gamma
    1707             : 
    1708   337189246 :     iarea                  = 3
    1709   337189246 :     num_seg       (iarea)  = 2
    1710   337189246 :     num_seg_static(iarea)  = 2
    1711             : 
    1712  1011567738 :     x_static (:,1,iarea) = xdep(:,2)                         !static  - line 3
    1713  1011567738 :     dx_static(:,1,iarea) = base_vtx(:,2,i,j,iside)-xdep(:,2) !static  - line 3
    1714             : 
    1715  1011567738 :     x_static (:,2,iarea) = base_vtx(:,2,i,j,iside)                         !static  - line 4
    1716  1011567738 :     dx_static(:,2,iarea) = base_vtx(:,1,i,j,iside)-base_vtx(:,2,i,j,iside) !static  - line 4
    1717             : 
    1718  1011567738 :     x        (:,1,iarea) = base_vtx(:,1,i,j,iside)    !static  - line 1
    1719  1011567738 :     dx       (:,1,iarea) = xtmp(:)-x(:,1,iarea)       !dynamic - line 1
    1720             : 
    1721  1011567738 :     x        (:,2,iarea) = xtmp(:)                     !dynamic  -line 2
    1722  1011567738 :     dx       (:,2,iarea) = x_static(:,1,iarea)-xtmp(:) !dynamic - line 2
    1723   337189246 :   end subroutine define_area3_left
    1724             : 
    1725   337087546 :   subroutine define_area3_right(i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg, &
    1726             :        num_seg_static,x_start, dgam_vec)
    1727             :     implicit none
    1728             :     integer, intent(in) :: i,j,iside
    1729             :     integer, parameter :: num_area=5, num_sides=4, imin= 0, imax=nc+1
    1730             :     real (kind=r8)    , dimension(0:7       , imin:imax,imin:imax,num_sides), intent(inout) :: displ
    1731             :     integer (kind=r8) , dimension(1:2,11    , imin:imax,imin:imax,num_sides), intent(inout) :: base_vec
    1732             :     real (kind=r8)    , dimension(1:2, 6    , imin:imax,imin:imax,num_sides), intent(inout) :: base_vtx
    1733             :     integer, parameter :: num_seg_max=5
    1734             :     REAL(KIND=r8), dimension(2,num_seg_max,num_area), intent(inout) :: x, dx, x_static, dx_static
    1735             :     integer             , dimension(num_area)              , intent(inout) :: num_seg, num_seg_static
    1736             :     REAL(KIND=r8), dimension(2,8)                   , intent(inout):: x_start, dgam_vec
    1737             : 
    1738             : 
    1739             :     real (kind=r8)    , dimension(2,3) :: xdep !departure points
    1740             :     real (kind=r8)                     :: gamma
    1741             :     integer :: iarea
    1742             : 
    1743             :     REAL(KIND=r8) :: xtmp(2)
    1744             :     !
    1745             :     !
    1746             :     !        ||  *-----2----||\
    1747             :     !        || /1         3|| \
    1748             :     !        ||/      4     ||
    1749             :     !  =============================
    1750             :     !        ||             ||
    1751             :     !        ||             ||
    1752             :     !        ||             ||
    1753             :     !
    1754   337087546 :     xdep(:,1) = base_vtx(:,1,i,j,iside)+displ(0,i,j,iside)*base_vec(:,1,i,j,iside)&
    1755  1348350184 :          +MAX(0.0_r8,displ(3,i,j,iside))*base_vec(:,3,i,j,iside)
    1756  1011262638 :     x_start (:,5) = base_vtx(:,2,i,j,iside)
    1757   337087546 :     gamma         = displ(1,i,j,iside)
    1758  1011262638 :     dgam_vec(:,5) = base_vec(:,1,i,j,iside)*gamma
    1759  1011262638 :     xtmp    (:  ) = x_start(:,5)+dgam_vec(:,5)
    1760             : 
    1761   337087546 :     iarea                  = 3
    1762   337087546 :     num_seg       (iarea)  = 2
    1763   337087546 :     num_seg_static(iarea)  = 2
    1764             : 
    1765  1011262638 :     x_static (:,1,iarea) = base_vtx(:,1,i,j,iside)           !static  - line 1
    1766  1011262638 :     dx_static(:,1,iarea) = xdep(:,1)-base_vtx(:,1,i,j,iside) !static  - line 1
    1767             : 
    1768  1011262638 :     x_static (:,2,iarea) = base_vtx(:,2,i,j,iside)                         !static  - line 4
    1769  1011262638 :     dx_static(:,2,iarea) = base_vtx(:,1,i,j,iside)-base_vtx(:,2,i,j,iside) !static  - line 4
    1770             : 
    1771  1011262638 :     x        (:,1,iarea) = xdep(:,1)            !static  - line 2
    1772  1011262638 :     dx       (:,1,iarea) = xtmp(:)-x(:,1,iarea) !dynamic - line 2
    1773             : 
    1774  1011262638 :     x        (:,2,iarea) = xtmp(:)                     !dynamic  -line 2
    1775  1011262638 :     dx       (:,2,iarea) = x_static(:,2,iarea)-xtmp(:) !dynamic - line 2
    1776   337087546 :   end subroutine define_area3_right
    1777             : 
    1778             : 
    1779    11598678 :   subroutine define_area3_left_right(i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg, &
    1780             :        num_seg_static,x_start, dgam_vec)
    1781             :     implicit none
    1782             :     integer, parameter  :: num_area=5, num_sides=4, imin= 0, imax=nc+1
    1783             :     integer, parameter  :: num_seg_max=5
    1784             :     integer,                                                                 intent(in)   :: i,j,iside
    1785             :     real (kind=r8),    dimension(0:7       , imin:imax,imin:imax,num_sides), intent(inout):: displ
    1786             :     integer (kind=r8), dimension(1:2,11    , imin:imax,imin:imax,num_sides), intent(inout):: base_vec
    1787             :     real (kind=r8),    dimension(1:2, 6    , imin:imax,imin:imax,num_sides), intent(inout):: base_vtx
    1788             :     real(KIND=r8),     dimension(2,num_seg_max,num_area),                    intent(inout):: x, dx, x_static, dx_static
    1789             :     integer,           dimension(num_area),                                  intent(inout):: num_seg, num_seg_static
    1790             :     real(KIND=r8),     dimension(2,8),                                       intent(inout):: x_start, dgam_vec
    1791             : 
    1792             :     real (kind=r8)      :: gamma
    1793             :     integer             :: iarea
    1794             :     real(KIND=r8)       :: xtmp(2),xtmp2(2)
    1795             :     !
    1796             :     !        ||-------------||
    1797             :     !       /||             ||\
    1798             :     !        ||             ||
    1799             :     !  =============================
    1800             :     !        ||             ||
    1801             :     !        ||             ||
    1802             :     !        ||             ||
    1803             :     !
    1804    34796034 :     x_start (:,4) = base_vtx(:,1,i,j,iside)
    1805    34796034 :     x_start (:,5) = base_vtx(:,2,i,j,iside)
    1806    11598678 :     gamma         = displ(0,i,j,iside)
    1807    34796034 :     dgam_vec(:,4) = base_vec(:,1,i,j,iside)*gamma
    1808    34796034 :     dgam_vec(:,5) = base_vec(:,1,i,j,iside)*gamma
    1809    34796034 :     xtmp    (:  ) = x_start(:,4)+dgam_vec(:,4)
    1810    34796034 :     xtmp2   (:  ) = x_start(:,5)+dgam_vec(:,5)
    1811             : 
    1812    11598678 :     iarea                  = 3
    1813    11598678 :     num_seg       (iarea)  = 3
    1814    11598678 :     num_seg_static(iarea)  = 1
    1815             : 
    1816    34796034 :     x_static (:,1,iarea) = base_vtx(:,2,i,j,iside)                         !static
    1817    34796034 :     dx_static(:,1,iarea) = base_vtx(:,1,i,j,iside)-base_vtx(:,2,i,j,iside) !static
    1818             : 
    1819    34796034 :     x        (:,1,iarea) = base_vtx(:,1,i,j,iside)    !static
    1820    34796034 :     dx       (:,1,iarea) = xtmp(:)-x(:,1,iarea)       !dynamic
    1821             : 
    1822    34796034 :     x        (:,2,iarea) = xtmp (:)         !dynamic
    1823    34796034 :     dx       (:,2,iarea) = xtmp2(:)-xtmp(:) !dynamic
    1824             : 
    1825    34796034 :     x        (:,3,iarea) = xtmp2(:)              !dynamic
    1826    34796034 :     dx       (:,3,iarea) = x_start(:,5)-xtmp2(:) !dynamic
    1827    11598678 :   end subroutine define_area3_left_right
    1828             : 
    1829    13843549 :   subroutine define_area4_area5(i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg, &
    1830             :        num_seg_static,x_start, dgam_vec,displ_first_guess)
    1831             :     implicit none
    1832             :     integer, intent(in) :: i,j,iside
    1833             :     integer, parameter :: num_area=5, num_sides=4, imin= 0, imax=nc+1
    1834             :     integer, parameter :: num_seg_max=5
    1835             :     real (kind=r8),    dimension(0:7       , imin:imax,imin:imax,num_sides), intent(inout) :: displ
    1836             :     integer (kind=r8), dimension(1:2,11    , imin:imax,imin:imax,num_sides), intent(inout) :: base_vec
    1837             :     real (kind=r8),    dimension(1:2, 6    , imin:imax,imin:imax,num_sides), intent(inout) :: base_vtx
    1838             :     real(KIND=r8),     dimension(2,num_seg_max,num_area), intent(inout) :: x, dx, x_static, dx_static
    1839             :     integer,           dimension(num_area),               intent(inout) :: num_seg, num_seg_static
    1840             :     real(KIND=r8),     dimension(2,8),                    intent(inout) :: x_start, dgam_vec
    1841             :     real(KIND=r8),     optional,                          intent(out)   :: displ_first_guess
    1842             : 
    1843             : 
    1844             :     real (kind=r8)    , dimension(2,3) :: xdep !departure points
    1845             :     real (kind=r8)                     :: gamma
    1846             :     integer :: iarea
    1847             : 
    1848             :     real(KIND=r8) :: xtmp(2),xtmp2(2)
    1849             :     !
    1850             :     !        ||     --------||
    1851             :     !        ||             ||\
    1852             :     !        ||             || \
    1853             :     !  =============================
    1854             :     !        ||             ||\ |
    1855             :     !        ||             || \|
    1856             :     !        ||             ||  *
    1857             :     !
    1858             :     !
    1859             :     ! iarea  = 4
    1860             :     !
    1861    13843549 :     iarea                  = 4
    1862    13843549 :     num_seg       (iarea)  = 3
    1863             : 
    1864    41530647 :     if (SUM(ABS(base_vec(:,5,i,j,iside))).NE.0) then
    1865    13822079 :        gamma = displ(1,i,j,iside)*displ(5,i,j,iside)/(displ(1,i,j,iside)-displ(4,i,j,iside))
    1866             : !       gamma = MAX(MIN(gamma,displ(5,i,j,iside),-displ(2,i,j,iside)),0.0_r8)!MWR manuscript
    1867    13822079 :        gamma = MAX(MIN(gamma,displ(5,i,j,iside),-0.25_r8*displ(2,i,j,iside)),0.0_r8)
    1868             :     else
    1869             :        !
    1870             :        ! corner case
    1871             :        !
    1872       21470 :        gamma = displ(1,i,j,iside)
    1873             :     end if
    1874             : 
    1875    13843549 :     if (present(displ_first_guess)) displ_first_guess = displ(1,i,j,iside)
    1876             : 
    1877    41530647 :     x_start (:,6) = base_vtx(:,3,i,j,iside)
    1878    41530647 :     dgam_vec(:,6) = base_vec(:,4,i,j,iside)*displ(1,i,j,iside)
    1879    41530647 :     xtmp    (:  ) = x_start(:,6)+dgam_vec(:,6)
    1880    41530647 :     x_start (:,7) = base_vtx(:,3,i,j,iside)
    1881    41530647 :     dgam_vec(:,7) = base_vec(:,5,i,j,iside)*gamma
    1882    41530647 :     xtmp2   (:  ) = x_start(:,7)+dgam_vec(:,7)
    1883             : 
    1884    41530647 :     x        (:,1,iarea) = base_vtx(:,3,i,j,iside)!static   -line 1
    1885    41530647 :     dx       (:,1,iarea) = xtmp(:)-x(:,1,iarea)   !dynamic - line 1
    1886             : 
    1887    41530647 :     x        (:,2,iarea) = xtmp(:)          !dynamic -line 2
    1888    41530647 :     dx       (:,2,iarea) = xtmp2(:)-xtmp(:) !dynamic - line 2
    1889             : 
    1890    41530647 :     x        (:,3,iarea) = xtmp2(:)               !static   -line 1
    1891    41530647 :     dx       (:,3,iarea) = x(:,1,iarea)-xtmp2(:)  !dynamic - line 1
    1892             :     !
    1893             :     !iarea = 5
    1894             :     !
    1895             :     xdep(:,1) = base_vtx(:,4,i,j,iside)+displ(5,i,j,iside)*base_vec(:,6,i,j,iside)&
    1896    41530647 :          -displ(4,i,j,iside)*base_vec(:,7,i,j,iside)
    1897    41530647 :     x_start (:,8) = base_vtx(:,4,i,j,iside)
    1898    41530647 :     dgam_vec(:,8) = base_vec(:,6,i,j,iside)*gamma
    1899    41530647 :     xtmp    (:  ) = x_start(:,8)+dgam_vec(:,8)
    1900             : 
    1901    13843549 :     iarea                  = 5
    1902    13843549 :     num_seg       (iarea)  = 2
    1903    13843549 :     num_seg_static(iarea)  = 1
    1904             : 
    1905    41530647 :     x        (:,1,iarea) = base_vtx(:,4,i,j,iside)!static   -line 1
    1906    41530647 :     dx       (:,1,iarea) = xtmp(:)-x(:,1,iarea)   !dynamic - line 1
    1907             : 
    1908    41530647 :     x_static (:,1,iarea) = xdep(:,1)                        !static - line 1
    1909    41530647 :     dx_static(:,1,iarea) = x(:,1,iarea)-x_static(:,1,iarea) !static - line 1
    1910             : 
    1911    41530647 :     x        (:,2,iarea) = xtmp(:)                     !dynamic -line 2
    1912    41530647 :     dx       (:,2,iarea) = x_static(:,1,iarea)-xtmp(:) !dynamic - line 2
    1913    13843549 :   end subroutine define_area4_area5
    1914             : 
    1915             : 
    1916   334842675 :   subroutine define_area4(i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg, &
    1917             :        num_seg_static,x_start, dgam_vec,displ_first_guess)
    1918             :     implicit none
    1919             :     integer, parameter :: num_area=5, num_sides=4, imin= 0, imax=nc+1
    1920             :     integer, parameter :: num_seg_max=5
    1921             :     integer,                                                                 intent(in)    :: i,j,iside
    1922             :     real (kind=r8),    dimension(0:7       , imin:imax,imin:imax,num_sides), intent(inout) :: displ
    1923             :     integer (kind=r8), dimension(1:2,11    , imin:imax,imin:imax,num_sides), intent(inout) :: base_vec
    1924             :     real (kind=r8),    dimension(1:2, 6    , imin:imax,imin:imax,num_sides), intent(inout) :: base_vtx
    1925             : 
    1926             :     real(KIND=r8),     dimension(2,num_seg_max,num_area), intent(inout) :: x, dx, x_static, dx_static
    1927             :     integer,           dimension(num_area)              , intent(inout) :: num_seg, num_seg_static
    1928             :     real(KIND=r8),     dimension(2,8)                   , intent(inout) :: x_start, dgam_vec
    1929             :     real(KIND=r8), optional,                              intent(out)   :: displ_first_guess
    1930             : 
    1931             : 
    1932             : 
    1933             :     real (kind=r8), dimension(2,3) :: xdep !departure points
    1934             :     real (kind=r8)                 :: gamma
    1935             :     integer                        :: iarea
    1936             :     real(KIND=r8)                  :: xtmp(2)
    1937             : 
    1938   334842675 :     iarea                  = 4
    1939   334842675 :     num_seg       (iarea)  = 2
    1940   334842675 :     num_seg_static(iarea)  = 1
    1941             : 
    1942   334842675 :     xdep(:,1) = base_vtx(:,3,i,j,iside)+MAX(0.0_r8,displ(4,i,j,iside))*base_vec(:,4,i,j,iside)&
    1943  1339370700 :          -displ(2,i,j,iside)*base_vec(:,5,i,j,iside)
    1944  1004528025 :     x_start (:,6) = base_vtx(:,3,i,j,iside)
    1945   334842675 :     gamma         = displ(1,i,j,iside)
    1946  1004528025 :     dgam_vec(:,6) = base_vec(:,4,i,j,iside)*gamma
    1947  1004528025 :     xtmp    (:  ) = x_start(:,6)+dgam_vec(:,6)
    1948             : 
    1949   334842675 :     if (present(displ_first_guess)) displ_first_guess = gamma
    1950             : 
    1951  1004528025 :     x_static (:,1,iarea) = xdep(:,1)                         !static
    1952  1004528025 :     dx_static(:,1,iarea) = base_vtx(:,3,i,j,iside)-xdep(:,1) !static
    1953             : 
    1954  1004528025 :     x        (:,1,iarea) = base_vtx(:,3,i,j,iside) !static  - line 2
    1955  1004528025 :     dx       (:,1,iarea) = xtmp(:)-x(:,1,iarea)    !dynamic - line 2
    1956             : 
    1957  1004528025 :     x        (:,2,iarea) = xtmp(:)                     !dynamic  -line 2
    1958  1004528025 :     dx       (:,2,iarea) = x_static(:,1,iarea)-xtmp(:) !dynamic - line 2
    1959   334842675 :   end subroutine define_area4
    1960             : 
    1961    13186928 :   subroutine define_area3_center(i,j,iside,displ,base_vec,base_vtx,x, dx, x_static, dx_static, num_seg, num_seg_static,&
    1962             :        x_start, dgam_vec,se_flux_center,displ_first_guess)
    1963             :     implicit none
    1964             :     integer, intent(in) :: i,j,iside
    1965             :     integer, parameter :: num_area=5, num_sides=4, imin= 0, imax=nc+1
    1966             :     integer, parameter :: num_seg_max=5
    1967             :     real (kind=r8),    dimension(0:7       , imin:imax,imin:imax,num_sides), intent(inout) :: displ
    1968             :     integer (kind=r8), dimension(1:2,11    , imin:imax,imin:imax,num_sides), intent(inout) :: base_vec
    1969             :     real (kind=r8),    dimension(1:2, 6    , imin:imax,imin:imax,num_sides), intent(inout) :: base_vtx
    1970             : 
    1971             :     real(KIND=r8),     dimension(2,num_seg_max,num_area), intent(inout) :: x, dx, x_static, dx_static
    1972             :     integer,           dimension(num_area),               intent(inout) :: num_seg, num_seg_static
    1973             :     real(KIND=r8),     dimension(2,8),                    intent(inout) :: x_start, dgam_vec
    1974             :     real(KIND=r8) ,                                       intent(in   ) :: se_flux_center
    1975             :     real(KIND=r8),     optional,                          intent(out)   :: displ_first_guess
    1976             : 
    1977             :     real (kind=r8)    , dimension(2,3) :: xdep !departure points
    1978             :     real (kind=r8)                     :: gamma
    1979             :     integer :: iarea
    1980             :     !
    1981             :     !                 xdep(2)
    1982             :     !                 ______X______
    1983             :     !        ||      /             \      ||
    1984             :     !        ||  *--/               \--*  ||
    1985             :     !        || /xdep(1)         xdep(3)\ ||
    1986             :     !        ||/                         \||
    1987             :     !  ========================================
    1988             :     !        ||                           ||
    1989             :     !
    1990             :     !
    1991             :     ! compute departure points (xdep(1) is left; xdep(3) is right and xdep(2) is midway
    1992             :     !
    1993             : 
    1994             :     xdep(:,1) = base_vtx(:,1,i,j,iside)+&
    1995    39560784 :          displ(0,i,j,iside)*base_vec(:,1,i,j,iside)+displ(3,i,j,iside)*base_vec(:,3,i,j,iside)
    1996             :     xdep(:,3) = base_vtx(:,2,i,j,iside)+&
    1997    39560784 :          displ(1,i,j,iside)*base_vec(:,1,i,j,iside)+displ(2,i,j,iside)*base_vec(:,2,i,j,iside)
    1998    39560784 :     xdep(:,2) = 0.5_r8*(xdep(:,1)+xdep(:,3))
    1999             : 
    2000    13186928 :     gamma= se_flux_center
    2001             :     x_start(:,1) = ABS(base_vec(:,3,i,j,iside))*((xdep(:,2)-base_vtx(:,1,i,j,iside)))+&
    2002    39560784 :          base_vtx(:,1,i,j,iside) !xdep(2) - midway between departure points projected to side 1
    2003             : 
    2004    39560784 :     dgam_vec(:,1) = gamma*base_vec(:,1,i,j,iside)
    2005             : 
    2006    13186928 :     if (present(displ_first_guess)) displ_first_guess = gamma
    2007             : 
    2008    39560784 :     xdep(:,2)     = x_start(:,1)+dgam_vec(:,1)
    2009    13186928 :     iarea                  = 3
    2010    13186928 :     num_seg       (iarea)  = 2
    2011    13186928 :     num_seg_static(iarea)  = 3
    2012             : 
    2013             :     !                 ______X______
    2014             :     !        ||    2 /             \ 3    ||
    2015             :     !        ||  *--/               \--*  ||
    2016             :     !        || /                       \ ||
    2017             :     !        ||/ 1          5           4\||
    2018             :     !  ========================================
    2019             :     !        ||                           ||
    2020             :     !
    2021    39560784 :     x_static (:,1,iarea) = base_vtx(:,1,i,j,iside)       !static  - line 1
    2022    39560784 :     dx_static(:,1,iarea) = xdep(:,1)-x_static(:,1,iarea) !static  - line 1
    2023             : 
    2024    39560784 :     x        (:,1,iarea) = xdep(:,1)                     !static  - line 2
    2025    39560784 :     dx       (:,1,iarea) = xdep(:,2)-x(:,1,iarea)        !dynamic - line 2
    2026             : 
    2027    39560784 :     x        (:,2,iarea) = xdep(:,2)                     !dynamic - line 3
    2028    39560784 :     dx       (:,2,iarea) = xdep(:,3)-x(:,2,iarea)        !dynamic - line 3
    2029             : 
    2030    39560784 :     x_static (:,2,iarea) = xdep(:,3)                                  !static  - line 4
    2031    39560784 :     dx_static(:,2,iarea) = base_vtx(:,2,i,j,iside)-x_static(:,2,iarea)!static  - line 4
    2032             : 
    2033    39560784 :     x_static (:,3,iarea) = base_vtx(:,2,i,j,iside)                         !static - line 5
    2034    39560784 :     dx_static(:,3,iarea) = base_vtx(:,1,i,j,iside)-base_vtx(:,2,i,j,iside) !static - line 5
    2035             : 
    2036    13186928 :   end subroutine define_area3_center
    2037             : end module fvm_consistent_se_cslam

Generated by: LCOV version 1.14