[Dart-dev] [10342] DART/trunk/models/wrf/model_mod.f90: Bug Fix 1 (wrf/model_mod.f90) : Using the correct type to grab

[nancy at ucar.edu]

Revision: 10342
Author:   hendric
Date:     2016-06-06 17:19:54 -0600 (Mon, 06 Jun 2016)
Log Message:
-----------
Bug Fix 1 (wrf/model_mod.f90) : Using the correct type to grab
variable size in nc_write_model_atts for types w and gz. When
no variable type_w is present and type_gz is present then attributes
were grabbing type information exclusively from type_w to calculate sizes 
which may not present.  This was causing filter to crash when writting 
attributes since type_w is not defined.

Bug Fix 2 (wrf/model_mod.f90) : Using my_index instead of ind to 
find variable size in nc_write_model_atts. This is only a problem
if you are using multiple domains that contain different variables.

Modified Paths:
--------------
    DART/trunk/models/wrf/model_mod.f90

-------------- next part --------------
Modified: DART/trunk/models/wrf/model_mod.f90
===================================================================
--- DART/trunk/models/wrf/model_mod.f90	2016-06-06 23:14:41 UTC (rev 10341)
+++ DART/trunk/models/wrf/model_mod.f90	2016-06-06 23:19:54 UTC (rev 10342)
@@ -4633,11 +4633,11 @@
          ! vertical dimension can be stag, unstag, or staggered soil
          ! need to use if/then/else instead of select because testing
          ! is against variables
-         if ( wrf%dom(id)%var_size(3,ind) == wrf%dom(id)%bts ) then
+         if ( wrf%dom(id)%var_size(3,my_index) == wrf%dom(id)%bts ) then
            dimids_3D(3)=btStagDimID(id)
-         elseif ( wrf%dom(id)%var_size(3,ind) == wrf%dom(id)%bt ) then
+         elseif ( wrf%dom(id)%var_size(3,my_index) == wrf%dom(id)%bt ) then
            dimids_3D(3)=btDimID(id)
-         elseif ( wrf%dom(id)%var_size(3,ind) == wrf%dom(id)%sls ) then
+         elseif ( wrf%dom(id)%var_size(3,my_index) == wrf%dom(id)%sls ) then
            dimids_3D(3)=slSDimID(id)
          else
            write(errstring,*)'Could not determine dim_id for vertical dimension to output variable '//varname
@@ -4673,22 +4673,22 @@
 
       endif ! 3D or 2D
 
-      unitsval = trim(wrf%dom(id)%units(ind))
+      unitsval = trim(wrf%dom(id)%units(my_index))
 
       call nc_check(nf90_put_att(ncFileID, var_id, "units", trim(unitsval)), &
                  'nc_write_model_atts','put_att '//varname//' units')
 
-      descriptionval = trim(wrf%dom(id)%description(ind))
+      descriptionval = trim(wrf%dom(id)%description(my_index))
 
       call nc_check(nf90_put_att(ncFileID, var_id, "description", trim(descriptionval)), &
                  'nc_write_model_atts','put_att '//varname//' description')
 
-      long_nameval = trim(wrf%dom(id)%description(ind))
+      long_nameval = trim(wrf%dom(id)%description(my_index))
 
       call nc_check(nf90_put_att(ncFileID, var_id, "long_name", trim(long_nameval)), &
                  'nc_write_model_atts','put_att '//varname//' long_name')
 
-      coordinatesval = trim(wrf%dom(id)%coordinates(ind))
+      coordinatesval = trim(wrf%dom(id)%coordinates(my_index))
       if (coordinatesval(1:7) .eq. 'XLONG_U') then
         coordinate_char = "XLONG_U_d0"//idom//" XLAT_U_d0"//idom
       else if (coordinatesval(1:7) .eq. 'XLONG_V') then
@@ -5201,7 +5201,7 @@
 real(r8), intent(in)  :: x(:)
 real(r8)              :: model_pressure
 
-integer  :: off
+integer  :: off, type_x
 real(r8) :: pres1, pres2
 
 model_pressure = missing_r8
@@ -5210,13 +5210,19 @@
 !   we are at the upper or lower boundary in which case we will extrapolate.
 if( (var_type == wrf%dom(id)%type_w) .or. (var_type == wrf%dom(id)%type_gz) ) then
 
+   if (var_type == wrf%dom(id)%type_w) then
+      type_x = wrf%dom(id)%type_w
+   else
+      type_x = wrf%dom(id)%type_gz
+   endif
+
    if( k == 1 ) then
 
       pres1 = model_pressure_t(i,j,k,  id,x)
       pres2 = model_pressure_t(i,j,k+1,id,x)
       model_pressure = interp_pressure(pres1, pres2, extrapolate=.true.)
 
-   elseif( k == wrf%dom(id)%var_size(3,wrf%dom(id)%type_w) ) then
+   elseif( k == wrf%dom(id)%var_size(3,type_x) ) then
 
       pres1 = model_pressure_t(i,j,k-1,id,x)
       pres2 = model_pressure_t(i,j,k-2,id,x)