<p><b>duda</b> 2010-04-23 15:06:33 -0600 (Fri, 23 Apr 2010)</p><p>Add implementations of MPAS_TO_CAM(...) and CAM_TO_MPAS(...). For now,<br>
we store the wind and temperature tendencies from CAM physics in new<br>
arrays theta_phys_tend and u_phys_tend, while the new moisture fields<br>
are copied directly, since they aren't provided as tendencies.<br>
<br>
<br>
M core_hyd_atmos/Registry<br>
M driver_cam_interface/module_mpas_cam_interface.F<br>
</p><hr noshade><pre><font color="gray">Modified: branches/mpas_cam_coupling/src/core_hyd_atmos/Registry
===================================================================
--- branches/mpas_cam_coupling/src/core_hyd_atmos/Registry 2010-04-23 20:43:27 UTC (rev 208)
+++ branches/mpas_cam_coupling/src/core_hyd_atmos/Registry 2010-04-23 21:06:33 UTC (rev 209)
@@ -152,6 +152,10 @@
var real qr_old ( nVertLevels nCells ) - qr_old scalars_old moist_old
#var real tracers_old ( nTracers nVertLevels nCells ) - tracers_old - -
+# Physics tendencies
+var real theta_phys_tend ( nVertLevels nCells Time ) - theta_phys_tend - -
+var real u_phys_tend ( nVertLevels nEdges Time ) - u_phys_tend - -
+
# Space needed for advection
var real deriv_two ( FIFTEEN TWO nEdges ) o deriv_two - -
var integer advCells ( TWENTYONE nCells ) - advCells - -
Modified: branches/mpas_cam_coupling/src/driver_cam_interface/module_mpas_cam_interface.F
===================================================================
--- branches/mpas_cam_coupling/src/driver_cam_interface/module_mpas_cam_interface.F 2010-04-23 20:43:27 UTC (rev 208)
+++ branches/mpas_cam_coupling/src/driver_cam_interface/module_mpas_cam_interface.F 2010-04-23 21:06:33 UTC (rev 209)
@@ -523,37 +523,76 @@
real (kind=RKIND), dimension(Numcols,Plev), intent(out) :: Omega
real (kind=RKIND), dimension(Numcols,Plev,Pcnst), intent(out) :: Tracer
+ integer :: iCell, k, iScalar
+ real (kind=RKIND), dimension(:), pointer :: latCell, lonCell
+ real (kind=RKIND), dimension(:,:), pointer :: theta, pressure, ww, uReconstX, uReconstY, uReconstZ, east, north
+ real (kind=RKIND), dimension(:,:,:), pointer :: scalars
type (block_type), pointer :: block
write(0,*) 'Called MPAS_TO_CAM'
block => domain % blocklist
+ latCell => block % mesh % latCell % array
+ lonCell => block % mesh % lonCell % array
+ east => block % mesh % east % array
+ north => block % mesh % north % array
+ theta => block % time_levs(2) % state % theta % array
+ pressure => block % time_levs(2) % state % pressure % array
+ ww => block % time_levs(2) % state % ww % array
+ uReconstX => block % time_levs(2) % state % uReconstructX % array
+ uReconstY => block % time_levs(2) % state % uReconstructY % array
+ uReconstZ => block % time_levs(2) % state % uReconstructZ % array
+ scalars => block % time_levs(2) % state % scalars % array
+
+
!
! Perform basic sanity check on expected and available field dimensions
!
if (Numcols /= block % mesh % nCellsSolve) then
write(0,*) 'Error: mismatch between Numcols and nCellsSolve: ', Numcols, block % mesh % nCellsSolve
+ return
end if
if (Plev /= block % mesh % nVertLevels) then
write(0,*) 'Error: mismatch between Plev and nVertLevels: ', Plev, block % mesh % nVertLevels
+ return
end if
if (Pcnst /= num_scalars) then
write(0,*) 'Error: mismatch between Pcnst and num_scalars: ', Pcnst, num_scalars
+ return
end if
!
! Fill in CAM arrays from block % time_levs(2) % state arrays
!
- Psd = 3.1415926
- Phis = 3.1415926
- T = 3.1415926
- Ux = 3.1415926
- Uy = 3.1415926
- Omega = 3.1415926
- Tracer = 3.1415926
-
+ do iCell=1,block % mesh % nCellsSolve
+ Psd(iCell) = block % time_levs(2) % state % surface_pressure % array(iCell)
+ Phis(iCell) = block % time_levs(2) % state % geopotential % array(1,iCell)
+ do k=1,block % mesh % nVertLevels
+ T(iCell,k) = theta(k,iCell) * (0.5*(pressure(k,iCell)+pressure(k+1,iCell)) / 100000.0) ** (rgas/cp)
+ Omega(iCell,k) = 0.5*(ww(k,iCell) + ww(k+1,iCell))
+ !
+ ! NOTE: Eventually, we need to ensure that the moisture variables we return to CAM
+ ! are what CAM expects, rather than simply what we have in our scalars array
+ !
+ do iScalar=1,num_scalars
+ Tracer(iCell,k,iScalar) = scalars(iScalar,k,iCell)
+ end do
+ end do
+ end do
+
+ do iCell=1,block % mesh % nCellsSolve
+ do k=1,block % mesh % nVertLevels
+ Ux(iCell,k) = uReconstX(k,iCell) * east(1,iCell) &
+ + uReconstY(k,iCell) * east(2,iCell) &
+ + uReconstZ(k,iCell) * east(3,iCell)
+ Uy(iCell,k) = uReconstX(k,iCell) * north(1,iCell) &
+ + uReconstY(k,iCell) * north(2,iCell) &
+ + uReconstZ(k,iCell) * north(3,iCell)
+ end do
+ end do
+
end subroutine mpas_to_cam
@@ -581,34 +620,109 @@
real (kind=RKIND), dimension(Numcols,Plev), intent(in) :: Uy_tend
real (kind=RKIND), dimension(Numcols,Plev,Pcnst), intent(in) :: Tracer
+ integer :: iCell, iEdge, iScalar, k, j
+ integer, dimension(:), pointer :: nEdgesOnCell
+ integer, dimension(:,:), pointer :: edgesOnCell
+ real (kind=RKIND), dimension(:,:), pointer :: east, north, edge_normal, pressure
+ real (kind=RKIND), dimension(:,:), pointer :: Ux_tend_halo, Uy_tend_halo, theta_tend, u_tend
+ real (kind=RKIND), dimension(:,:,:), pointer :: scalars
type (block_type), pointer :: block
write(0,*) 'Called CAM_TO_MPAS'
block => domain % blocklist
+ nEdgesOnCell => block % mesh % nEdgesOnCell % array
+ edgesOnCell => block % mesh % edgesOnCell % array
+ east => block % mesh % east % array
+ north => block % mesh % north % array
+ edge_normal => block % mesh % edge_normal % array
+ pressure => block % time_levs(2) % state % pressure % array
+ scalars => block % time_levs(2) % state % scalars % array
+ theta_tend => block % time_levs(2) % state % theta_phys_tend % array
+ u_tend => block % time_levs(2) % state % u_phys_tend % array
!
! Perform basic sanity check on expected and available field dimensions
!
if (Numcols /= block % mesh % nCellsSolve) then
write(0,*) 'Error: mismatch between Numcols and nCellsSolve: ', Numcols, block % mesh % nCellsSolve
+ return
end if
if (Plev /= block % mesh % nVertLevels) then
write(0,*) 'Error: mismatch between Plev and nVertLevels: ', Plev, block % mesh % nVertLevels
+ return
end if
if (Pcnst /= num_scalars) then
write(0,*) 'Error: mismatch between Pcnst and num_scalars: ', Pcnst, num_scalars
+ return
end if
!
! Fill in MPAS tendency arrays from arguments
!
+ allocate(Ux_tend_halo(block % mesh % nVertLevels, block % mesh % nCells))
+ allocate(Uy_tend_halo(block % mesh % nVertLevels, block % mesh % nCells))
+ do iCell=1,block % mesh % nCellsSolve
+ do k=1,block % mesh % nVertLevels
+ Ux_tend_halo(k,iCell) = Ux_tend(iCell,k)
+ Uy_tend_halo(k,iCell) = Uy_tend(iCell,k)
+ end do
+ end do
+ call dmpar_exch_halo_field2dReal(domain % dminfo, Ux_tend_halo, &
+ block % mesh % nVertLevels, block % mesh % nCells, &
+ block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+ call dmpar_exch_halo_field2dReal(domain % dminfo, Uy_tend_halo, &
+ block % mesh % nVertLevels, block % mesh % nCells, &
+ block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+
+ u_tend(:,:) = 0.0
+ do iCell=1,block % mesh % nCells
+ do j=1,nEdgesOnCell(iCell)
+ iEdge = edgesOnCell(j,iCell)
+ do k=1,block % mesh % nVertLevels
+ u_tend(k,iEdge) = u_tend(k,iEdge) + 0.5 * Ux_tend_halo(k,iCell) * (edge_normal(1,iEdge) * east(1,iCell) + &
+ edge_normal(2,iEdge) * east(2,iCell) + &
+ edge_normal(3,iEdge) * east(3,iCell)) &
+ + 0.5 * Uy_tend_halo(k,iCell) * (edge_normal(1,iEdge) * north(1,iCell) + &
+ edge_normal(2,iEdge) * north(2,iCell) + &
+ edge_normal(3,iEdge) * north(3,iCell))
+ end do
+ end do
+ end do
+
+ deallocate(Ux_tend_halo)
+ deallocate(Uy_tend_halo)
+
+ do iCell=1,block % mesh % nCellsSolve
+ do k=1,block % mesh % nVertLevels
+ theta_tend(k,iCell) = T_tend(iCell,k) * (100000.0 / (0.5*(pressure(k,iCell)+pressure(k+1,iCell)))) ** (rgas/cp)
+
+ !
+ ! NOTE: Once we begin to use more than just qv in MPAS, we need to make sure to
+ ! properly assign variables from Tracer array provided from CAM physics
+ !
+ do iScalar=1,num_scalars
+ scalars(iScalar,k,iCell) = Tracer(iCell,k,iScalar)
+ end do
+ end do
+ end do
+
+
!
- ! It might also be necessary to do a ghost-cell update on tendency arrays
+ ! Do a ghost-cell update on tendency arrays
!
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(1) % state % theta_phys_tend % array(:,:), &
+ block % mesh % nVertLevels, block % mesh % nCells, &
+ block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
+ call dmpar_exch_halo_field2dReal(domain % dminfo, block % time_levs(1) % state % u_phys_tend % array(:,:), &
+ block % mesh % nVertLevels, block % mesh % nEdges, &
+ block % parinfo % edgesToSend, block % parinfo % edgesToRecv)
+ call dmpar_exch_halo_field3dReal(domain % dminfo, block % time_levs(1) % state % scalars % array(:,:,:), &
+ num_scalars, block % mesh % nVertLevels, block % mesh % nCells, &
+ block % parinfo % cellsToSend, block % parinfo % cellsToRecv)
end subroutine cam_to_mpas
</font>
</pre>