<p><b>duda</b> 2013-03-26 17:24:50 -0600 (Tue, 26 Mar 2013)</p><p>BRANCH COMMIT<br>
<br>
Enclose some debugging print statements in the monotonic transport routine<br>
in an "if (debug_print) then" clause.<br>
<br>
Also, combine the flux scaling arrays into a single 3d array so we only need<br>
to call the halo exchange routine once in atm_advance_scalars_mono() for rescaling.<br>
<br>
No change to results.<br>
<br>
<br>
M src/core_nhyd_atmos/mpas_atm_time_integration.F<br>
</p><hr noshade><pre><font color="gray">Modified: branches/atmos_physics/src/core_nhyd_atmos/mpas_atm_time_integration.F
===================================================================
--- branches/atmos_physics/src/core_nhyd_atmos/mpas_atm_time_integration.F 2013-03-26 23:03:26 UTC (rev 2670)
+++ branches/atmos_physics/src/core_nhyd_atmos/mpas_atm_time_integration.F 2013-03-26 23:24:50 UTC (rev 2671)
@@ -1424,13 +1424,15 @@
integer, dimension(:), pointer :: nAdvCellsForEdge
real (kind=RKIND), dimension(:,:), pointer :: adv_coefs, adv_coefs_3rd
- type (field2DReal), pointer :: tempField
- type (field2DReal), target :: tempFieldTarget
+ type (field3DReal), pointer :: tempField
+ type (field3DReal), target :: tempFieldTarget
real (kind=RKIND), dimension( grid % nVertLevels, grid % nCells ) :: scalar_old, scalar_new
real (kind=RKIND), dimension( grid % nVertLevels, grid % nCells ) :: s_max, s_min
- real (kind=RKIND), dimension( grid % nVertLevels, grid % nCells ), target :: scale_in, scale_out
+ real (kind=RKIND), dimension( 2, grid % nVertLevels, grid % nCells ), target :: scale_arr
+ integer, parameter :: SCALE_IN = 1, SCALE_OUT = 2
+
real (kind=RKIND), dimension( grid % nVertLevels, grid % nEdges ) :: flux_arr
real (kind=RKIND), dimension( grid % nVertLevels + 1, grid % nCells ) :: wdtn
@@ -1532,25 +1534,27 @@
end do
end do
- scmin = scalar_old(1,1)
- scmax = scalar_old(1,1)
- do iCell = 1, grid%nCells
- do k=1, grid%nVertLevels
- scmin = min(scmin,scalar_old(k,iCell))
- scmax = max(scmax,scalar_old(k,iCell))
- enddo
- enddo
- write(0,*) ' scmin, scmin old in ',scmin,scmax
+ if(debug_print) then
+ scmin = scalar_old(1,1)
+ scmax = scalar_old(1,1)
+ do iCell = 1, grid%nCells
+ do k=1, grid%nVertLevels
+ scmin = min(scmin,scalar_old(k,iCell))
+ scmax = max(scmax,scalar_old(k,iCell))
+ enddo
+ enddo
+ write(0,*) ' scmin, scmin old in ',scmin,scmax
- scmin = scalar_new(1,1)
- scmax = scalar_new(1,1)
- do iCell = 1, grid%nCells
- do k=1, grid%nVertLevels
- scmin = min(scmin,scalar_new(k,iCell))
- scmax = max(scmax,scalar_new(k,iCell))
- enddo
- enddo
- write(0,*) ' scmin, scmin new in ',scmin,scmax
+ scmin = scalar_new(1,1)
+ scmax = scalar_new(1,1)
+ do iCell = 1, grid%nCells
+ do k=1, grid%nVertLevels
+ scmin = min(scmin,scalar_new(k,iCell))
+ scmax = max(scmax,scalar_new(k,iCell))
+ enddo
+ enddo
+ write(0,*) ' scmin, scmin new in ',scmin,scmax
+ end if
!
@@ -1635,12 +1639,12 @@
wdtn(k,iCell) = dt*wdtn(k,iCell) - flux_upwind
end do
-! scale_in(:,:) and scale_out(:,:) are used here to store the incoming and outgoing perturbation flux
+! scale_arr(SCALE_IN,:,:) and scale_arr(SCALE_OUT:,:) are used here to store the incoming and outgoing perturbation flux
! contributions to the update: first the vertical flux component, then the horizontal
do k=1,nVertLevels
- scale_in (k,iCell) = - rdnw(k)*(min(0.0_RKIND,wdtn(k+1,iCell))-max(0.0_RKIND,wdtn(k,iCell)))
- scale_out(k,iCell) = - rdnw(k)*(max(0.0_RKIND,wdtn(k+1,iCell))-min(0.0_RKIND,wdtn(k,iCell)))
+ scale_arr(SCALE_IN, k,iCell) = - rdnw(k)*(min(0.0_RKIND,wdtn(k+1,iCell))-max(0.0_RKIND,wdtn(k,iCell)))
+ scale_arr(SCALE_OUT,k,iCell) = - rdnw(k)*(max(0.0_RKIND,wdtn(k+1,iCell))-min(0.0_RKIND,wdtn(k,iCell)))
end do
end do
@@ -1660,10 +1664,10 @@
scalar_new(k,cell1) = scalar_new(k,cell1) - flux_upwind / areaCell(cell1)
scalar_new(k,cell2) = scalar_new(k,cell2) + flux_upwind / areaCell(cell2)
- scale_out(k,cell1) = scale_out(k,cell1) - max(0.0_RKIND,flux_arr(k,iEdge)) / areaCell(cell1)
- scale_in (k,cell1) = scale_in (k,cell1) - min(0.0_RKIND,flux_arr(k,iEdge)) / areaCell(cell1)
- scale_out(k,cell2) = scale_out(k,cell2) + min(0.0_RKIND,flux_arr(k,iEdge)) / areaCell(cell2)
- scale_in (k,cell2) = scale_in (k,cell2) + max(0.0_RKIND,flux_arr(k,iEdge)) / areaCell(cell2)
+ scale_arr(SCALE_OUT,k,cell1) = scale_arr(SCALE_OUT,k,cell1) - max(0.0_RKIND,flux_arr(k,iEdge)) / areaCell(cell1)
+ scale_arr(SCALE_IN, k,cell1) = scale_arr(SCALE_IN, k,cell1) - min(0.0_RKIND,flux_arr(k,iEdge)) / areaCell(cell1)
+ scale_arr(SCALE_OUT,k,cell2) = scale_arr(SCALE_OUT,k,cell2) + min(0.0_RKIND,flux_arr(k,iEdge)) / areaCell(cell2)
+ scale_arr(SCALE_IN, k,cell2) = scale_arr(SCALE_IN, k,cell2) + max(0.0_RKIND,flux_arr(k,iEdge)) / areaCell(cell2)
end do
end if
@@ -1673,15 +1677,15 @@
do iCell = 1, grid % nCellsSolve
do k = 1, nVertLevels
- s_min_update = (scalar_new(k,iCell)+scale_out(k,iCell))/h_new(k,iCell)
- s_max_update = (scalar_new(k,iCell)+scale_in (k,iCell))/h_new(k,iCell)
+ s_min_update = (scalar_new(k,iCell)+scale_arr(SCALE_OUT,k,iCell))/h_new(k,iCell)
+ s_max_update = (scalar_new(k,iCell)+scale_arr(SCALE_IN,k,iCell))/h_new(k,iCell)
s_upwind = scalar_new(k,iCell)/h_new(k,iCell)
scale_factor = (s_max(k,iCell)-s_upwind)/(s_max_update-s_upwind+eps)
- scale_in(k,iCell) = min( 1.0_RKIND, max( 0.0_RKIND, scale_factor) )
+ scale_arr(SCALE_IN,k,iCell) = min( 1.0_RKIND, max( 0.0_RKIND, scale_factor) )
scale_factor = (s_upwind-s_min(k,iCell))/(s_upwind-s_min_update+eps)
- scale_out(k,iCell) = min( 1.0_RKIND, max( 0.0_RKIND, scale_factor) )
+ scale_arr(SCALE_OUT,k,iCell) = min( 1.0_RKIND, max( 0.0_RKIND, scale_factor) )
end do
end do
@@ -1694,20 +1698,18 @@
tempField => tempFieldTarget
tempField % block => block
- tempField % dimSizes(1) = grid % nVertLevels
- tempField % dimSizes(2) = grid % nCells
+ tempField % dimSizes(1) = 2
+ tempField % dimSizes(2) = grid % nVertLevels
+ tempField % dimSizes(3) = grid % nCells
tempField % sendList => block % parinfo % cellsToSend
tempField % recvList => block % parinfo % cellsToRecv
tempField % copyList => block % parinfo % cellsToCopy
tempField % prev => null()
tempField % next => null()
- tempField % array => scale_in
+ tempField % array => scale_arr
call mpas_dmpar_exch_halo_field(tempField, (/ 1 /))
- tempField % array => scale_out
- call mpas_dmpar_exch_halo_field(tempField, (/ 1 /))
-
!
! rescale the fluxes
!
@@ -1717,8 +1719,8 @@
if (cell1 <= grid%nCellsSolve .or. cell2 <= grid%nCellsSolve) then
do k = 1, nVertLevels
flux = flux_arr(k,iEdge)
- flux = max(0.0_RKIND,flux) * min(scale_out(k,cell1), scale_in(k,cell2)) &
- + min(0.0_RKIND,flux) * min(scale_in(k,cell1), scale_out(k,cell2))
+ flux = max(0.0_RKIND,flux) * min(scale_arr(SCALE_OUT,k,cell1), scale_arr(SCALE_IN, k,cell2)) &
+ + min(0.0_RKIND,flux) * min(scale_arr(SCALE_IN, k,cell1), scale_arr(SCALE_OUT,k,cell2))
flux_arr(k,iEdge) = flux
end do
end if
@@ -1729,8 +1731,8 @@
do iCell=1,grid % nCells
do k = 2, nVertLevels
flux = wdtn(k,iCell)
- flux = max(0.0_RKIND,flux) * min(scale_out(k-1,iCell), scale_in(k ,iCell)) &
- + min(0.0_RKIND,flux) * min(scale_out(k ,iCell), scale_in(k-1,iCell))
+ flux = max(0.0_RKIND,flux) * min(scale_arr(SCALE_OUT,k-1,iCell), scale_arr(SCALE_IN,k ,iCell)) &
+ + min(0.0_RKIND,flux) * min(scale_arr(SCALE_OUT,k ,iCell), scale_arr(SCALE_IN,k-1,iCell))
wdtn(k,iCell) = flux
end do
end do
@@ -1748,39 +1750,39 @@
end if
end do
- do iCell=1,grid % nCellsSolve
- do k=1,grid % nVertLevels
- scalar_new(k,iCell) = ( scalar_new(k,iCell) &
- + (-rdnw(k)*(wdtn(k+1,iCell)-wdtn(k,iCell)) ) )/h_new(k,iCell)
- end do
- end do
+ do iCell=1,grid % nCellsSolve
+ do k=1,grid % nVertLevels
+ scalar_new(k,iCell) = ( scalar_new(k,iCell) &
+ + (-rdnw(k)*(wdtn(k+1,iCell)-wdtn(k,iCell)) ) )/h_new(k,iCell)
+ end do
+ end do
- if(debug_print) then
+ if(debug_print) then
- scmin = scalar_new(1,1)
- scmax = scalar_new(1,1)
- do iCell = 1, grid%nCellsSolve
- do k=1, grid%nVertLevels
- scmax = max(scmax,scalar_new(k,iCell))
- scmin = min(scmin,scalar_new(k,iCell))
- if(s_max(k,iCell) < scalar_new(k,iCell)) then
- write(32,*) ' over - k,iCell,s_min,s_max,scalar_new ',k,iCell,s_min(k,iCell),s_max(k,iCell),scalar_new(k,iCell)
- end if
- if(s_min(k,iCell) > scalar_new(k,iCell)) then
- write(32,*) ' under - k,iCell,s_min,s_max,scalar_new ',k,iCell,s_min(k,iCell),s_max(k,iCell),scalar_new(k,iCell)
- end if
- enddo
- enddo
- write(0,*) ' scmin, scmax new out ',scmin,scmax
- write(0,*) ' icell_min, k_min ',icellmax, kmax
+ scmin = scalar_new(1,1)
+ scmax = scalar_new(1,1)
+ do iCell = 1, grid%nCellsSolve
+ do k=1, grid%nVertLevels
+ scmax = max(scmax,scalar_new(k,iCell))
+ scmin = min(scmin,scalar_new(k,iCell))
+ if(s_max(k,iCell) < scalar_new(k,iCell)) then
+ write(32,*) ' over - k,iCell,s_min,s_max,scalar_new ',k,iCell,s_min(k,iCell),s_max(k,iCell),scalar_new(k,iCell)
+ end if
+ if(s_min(k,iCell) > scalar_new(k,iCell)) then
+ write(32,*) ' under - k,iCell,s_min,s_max,scalar_new ',k,iCell,s_min(k,iCell),s_max(k,iCell),scalar_new(k,iCell)
+ end if
+ enddo
+ enddo
+ write(0,*) ' scmin, scmax new out ',scmin,scmax
+ write(0,*) ' icell_min, k_min ',icellmax, kmax
- end if
+ end if
- do iCell = 1, grid%nCells
- do k=1, grid%nVertLevels
- s_new % scalars % array(iScalar,k,iCell) = max(0.0_RKIND,scalar_new(k,iCell))
- end do
- end do
+ do iCell = 1, grid%nCells
+ do k=1, grid%nVertLevels
+ s_new % scalars % array(iScalar,k,iCell) = max(0.0_RKIND,scalar_new(k,iCell))
+ end do
+ end do
end do ! loop over scalars
</font>
</pre>