[Dart-dev] DART/branches Revision: 12859

[dart at ucar.edu]

nancy at ucar.edu
2018-09-25 16:37:21 -0600 (Tue, 25 Sep 2018)
428
fix a bug in the irregular grid interpolation routine - was
returning the box indicies in the wrong order.  note that this
routine is never used in the cam code (grid is fully regular).
found in the ROMS code and just keeping this version in sync
with it.

also style changes from tim to wrap long lines and move the
comments to before the routines.  remove some unused vars
and add the 'routine' variables for error messages.




Modified: DART/branches/recam/models/utilities/quad_utils_mod.f90
===================================================================
--- DART/branches/recam/models/utilities/quad_utils_mod.f90	2018-09-25 22:28:28 UTC (rev 12858)
+++ DART/branches/recam/models/utilities/quad_utils_mod.f90	2018-09-25 22:37:21 UTC (rev 12859)
@@ -33,9 +33,10 @@
 
 ! This code will interpolate in a logically rectangular but deformed lat/lon grid.
 
-! Modules that are absolutely required for use are listed
 use        types_mod, only : r8, i8, MISSING_R8, PI, deg2rad
+
 use     location_mod, only : location_type, get_location
+
 use    utilities_mod, only : register_module, error_handler,         &
                              E_ERR, E_WARN, E_MSG, nmlfileunit,      &
                              do_output, do_nml_file, do_nml_term,    &
@@ -65,10 +66,10 @@
 
 
 ! version controlled file description for error handling, do not edit
-character(len=256), parameter :: source   = &
+character(len=*), parameter :: source   = &
    "$URL$"
-character(len=32 ), parameter :: revision = "$Revision$"
-character(len=128), parameter :: revdate  = "$Date$"
+character(len=*), parameter :: revision = "$Revision$"
+character(len=*), parameter :: revdate  = "$Date$"
 
 ! message strings
 character(len=512) :: string1, string2, string3
@@ -113,7 +114,7 @@
    logical :: uses_mask = .false.
    logical, allocatable :: grid_mask(:,:)
 
-   ! is this a global grid?  if yes, both spans_lon_zero and pole_wrap are true as well.
+   ! global grid?  if yes, both spans_lon_zero and pole_wrap are true as well.
    ! if not, either or both could still be true but we can't assume.
    logical :: global_grid = .false.
 
@@ -324,7 +325,7 @@
 interp_handle%nlat = num_lats
 interp_handle%nlon = num_lons
 
-!>@todo  FIXME: add sanity checking between global, spans_lon_zero, pole_wrap settings
+!>@todo  : add sanity checking between global, spans_lon_zero, pole_wrap settings
 
 if (global) then
    interp_handle%opt%global_grid = .true.
@@ -348,7 +349,7 @@
       interp_handle%ir%lons_1D(num_lons) = MISSING_R8
 
    case(GRID_QUAD_FULLY_IRREGULAR)
-      allocate(interp_handle%ii%lats_2D(num_lons,num_lats), &
+      allocate(interp_handle%ii%lats_2D(num_lons, num_lats), &
                interp_handle%ii%lons_2D(num_lons, num_lats))
       interp_handle%ii%lats_2D(num_lons, num_lats) = MISSING_R8
       interp_handle%ii%lons_2D(num_lons, num_lats) = MISSING_R8
@@ -362,7 +363,7 @@
       if (num_lats * num_lons > 6 * 1000 * 1000) then  ! ~1/10th degree
          interp_handle%ii%num_reg_x = 900
          interp_handle%ii%num_reg_y = 900
-         interp_handle%ii%max_reg_list_num = 800   ! FIXME!!!  what is good val?
+         interp_handle%ii%max_reg_list_num = 800   !>@todo  what is good val?
 !print *, 'case 1: ', interp_handle%ii%num_reg_x, interp_handle%ii%num_reg_y, &
 !                     interp_handle%ii%max_reg_list_num
 
@@ -381,8 +382,10 @@
 !                     interp_handle%ii%max_reg_list_num
       endif
 
-      allocate(interp_handle%ii%grid_start(interp_handle%ii%num_reg_x,interp_handle%ii%num_reg_y), &
-               interp_handle%ii%grid_num(  interp_handle%ii%num_reg_x,interp_handle%ii%num_reg_y))
+      allocate(interp_handle%ii%grid_start(interp_handle%ii%num_reg_x, &
+                                           interp_handle%ii%num_reg_y))
+      allocate(interp_handle%ii%grid_num(  interp_handle%ii%num_reg_x, &
+                                           interp_handle%ii%num_reg_y))
 
       interp_handle%ii%grid_num = 0
 
@@ -432,7 +435,8 @@
                 interp_handle%ir%lons_1D(interp_handle%nlon)
 
    case(GRID_QUAD_FULLY_IRREGULAR)
-      print * !, interp_handle%ii%lats_2D(num_lons,num_lats), interp_handle%ii%lons_2D(num_lons, num_lats)
+      print * !, interp_handle%ii%lats_2D(num_lons, num_lats), &
+              !  interp_handle%ii%lons_2D(num_lons, num_lats)
 
    case default
       write(string1, *) 'unrecognized grid type: ', interp_handle%grid_type
@@ -478,7 +482,8 @@
 
 !------------------------------------------------------------
 
-subroutine set_reg_quad_coords(interp_handle, lon_start, lon_delta, lat_start, lat_delta)
+subroutine set_reg_quad_coords(interp_handle, lon_start, lon_delta, &
+                                              lat_start, lat_delta)
 
 type(quad_interp_handle), intent(inout) :: interp_handle
 real(r8),                 intent(in)    :: lon_start, lon_delta
@@ -569,12 +574,13 @@
 end subroutine shapecheck