[Dart-dev] DART/branches Revision: 11666

[dart at ucar.edu]

nancy at ucar.edu
2017-05-26 08:59:53 -0600 (Fri, 26 May 2017)
659
potential update to the wrf model_mod.  definitely a couple
bug fixes for any field staggered in the vertical.  rename
'count' to 'kcount' because count is a fortran intrinsic 
and while the name spaces are distinct, it's often confusing
for us programmers.  and finally, this has something i'm
more confused about but will have ryan and glen look at:
in get_model_pressure_profile_distrib() i found some
quite different code in one of my versions from what's
in the repository.  it looks like better code but i'm 
not sure.  i'm committing it to my branch but that
part of the update might not migrate to the rma_trunk
unless i get an ok from the wrf guys.




Modified: DART/branches/rma_updates_nancy/models/wrf/model_mod.f90
===================================================================
--- DART/branches/rma_updates_nancy/models/wrf/model_mod.f90	2017-05-26 14:49:11 UTC (rev 11665)
+++ DART/branches/rma_updates_nancy/models/wrf/model_mod.f90	2017-05-26 14:59:53 UTC (rev 11666)
@@ -103,7 +103,7 @@
                                 get_index_start, get_index_end, &
                                 get_dart_vector_index
 
-use mpi_utilities_mod,   only : all_reduce_min_max
+use mpi_utilities_mod,   only : broadcast_minmax
 
 ! FIXME:
 ! the kinds QTY_CLOUD_LIQUID_WATER should be QTY_CLOUDWATER_MIXING_RATIO, 
@@ -1000,7 +1000,7 @@
 real(r8) :: x_ill(ens_size), x_iul(ens_size), x_ilr(ens_size), x_iur(ens_size), ugrid(ens_size), vgrid(ens_size)
 real(r8) :: x_ugrid_1(ens_size), x_ugrid_2(ens_size), x_ugrid_3(ens_size), x_ugrid_4(ens_size)
 real(r8) :: x_vgrid_1(ens_size), x_vgrid_2(ens_size), x_vgrid_3(ens_size), x_vgrid_4(ens_size)
-integer  :: e, count, uk !< index varibles for loop
+integer  :: e, kcount, uk !< index variables for loop
 real(r8) :: failedcopies(ens_size)
 integer, allocatable  :: uniquek(:)
 integer  :: ksort(ens_size)
@@ -1294,27 +1294,12 @@
    enddo
 
    ! Set a working integer k value -- if (int(zloc) < 1), then k = 1
-   k = max(1,int(zloc)) !HK k is now ensemble size
+   k = max(1,int(zloc))  ! k is an ensemble-sized array 
 
+   kcount = count_unique_vals(k)
+   allocate(uniquek(kcount))
+   call keep_unique_vals(k, uniquek)
 
-   ! Find the unique k values
-   ksort = sort(k)
-
-   count = 1
-   do e = 2, ens_size
-       if ( ksort(e) /= ksort(e-1) ) count = count + 1
-   enddo
-
-   allocate(uniquek(count))
- 
-   uk = 1
-   do e = 1, ens_size
-      if ( all(uniquek /= k(e)) ) then
-         uniquek(uk) = k(e)
-         uk = uk + 1
-      endif
-   enddo
-
    ! The big horizontal interp loop below computes the data values in the level
    ! below and above the actual location, and then does a separate vertical
    ! interpolation (if the obs is not a 2d surface obs).  The two values are
@@ -1448,7 +1433,7 @@
             call toGrid(xloc_u,i_u,dx_u,dxm_u)
             call toGrid(yloc_v,j_v,dy_v,dym_v)
 
-            do uk = 1, count ! for the different ks
+            do uk = 1, kcount ! for the different ks
 
                ! Check to make sure retrieved integer gridpoints are in valid range
                if ( boundsCheck( i_u, wrf%dom(id)%periodic_x, id, dim=1, type=wrf%dom(id)%type_u) .and. &
@@ -1603,7 +1588,7 @@
 
          if ( wrf%dom(id)%type_t >= 0 ) then
 
-            do uk = 1, count ! for the different ks
+            do uk = 1, kcount ! for the different ks
 
                ! Check to make sure retrieved integer gridpoints are in valid range
                if ( boundsCheck( i, wrf%dom(id)%periodic_x, id, dim=1, type=wrf%dom(id)%type_t ) .and. &
@@ -1697,7 +1682,7 @@
 
          if ( wrf%dom(id)%type_t >= 0 ) then
 
-            do uk = 1, count
+            do uk = 1, kcount
 
             ! Check to make sure retrieved integer gridpoints are in valid range
             if ( boundsCheck( i, wrf%dom(id)%periodic_x, id, dim=1, type=wrf%dom(id)%type_t ) .and. &
@@ -1760,7 +1745,7 @@
    ! 1.d Density (Rho)
    elseif (obs_kind == QTY_DENSITY) then
 
-      do uk = 1, count ! for the different ks
+      do uk = 1, kcount ! for the different ks
 
       ! Check to make sure retrieved integer gridpoints are in valid range
       if ( boundsCheck( i, wrf%dom(id)%periodic_x, id, dim=1, type=wrf%dom(id)%type_t ) .and. &
@@ -1812,9 +1797,19 @@
    elseif ( obs_kind == QTY_VERTICAL_VELOCITY ) then
 
       ! Adjust zloc for staggered ZNW grid (or W-grid, as compared to ZNU or M-grid)
+      ! and recompute unique K values.
       zloc = zloc + 0.5_r8
-      k = max(1,int(zloc))  !> @todo what should you do with this?
 
+      ! Reset a working integer k value -- if (int(zloc) < 1), then k = 1
+      k = max(1,int(zloc))  ! k is an ensemble-sized array 
+