[Dart-dev] DART/branches Revision: 12478

[dart at ucar.edu]

nancy at ucar.edu
2018-04-02 09:25:07 -0600 (Mon, 02 Apr 2018)
278
clean up the code in the compare_states program.  don't need
a case for every dimensionality of array.  also created a small
tool that prints the min/max of each field in a single netcdf file.  
there must be another tools somewhere that does this 
but i haven't found it yet.




Modified: DART/branches/nsc_updates/assimilation_code/programs/compare_states/compare_states.f90
===================================================================
--- DART/branches/nsc_updates/assimilation_code/programs/compare_states/compare_states.f90	2018-04-02 15:21:44 UTC (rev 12477)
+++ DART/branches/nsc_updates/assimilation_code/programs/compare_states/compare_states.f90	2018-04-02 15:25:07 UTC (rev 12478)
@@ -47,24 +47,12 @@
 real(r8) ::  min1,  min2,  max1,  max2,  delmin,  delmax
 integer  :: imin1, imin2, imax1, imax2, idelmin, idelmax
 
-! arrays for all possible dimensions, real and int
-real(r8)          ::  zerod1,                 zerod2
-real(r8), pointer ::   oned1(:),               oned2(:)       
-real(r8), pointer ::   twod1(:,:),             twod2(:,:)
-real(r8), pointer :: threed1(:,:,:),         threed2(:,:,:)
-real(r8), pointer ::  fourd1(:,:,:,:),        fourd2(:,:,:,:)
-real(r8), pointer ::  fived1(:,:,:,:,:),      fived2(:,:,:,:,:)
-real(r8), pointer ::   sixd1(:,:,:,:,:,:),     sixd2(:,:,:,:,:,:)
-real(r8), pointer :: sevend1(:,:,:,:,:,:,:), sevend2(:,:,:,:,:,:,:)
+! arrays and scalars for real and int
+real(r8)              ::  zerod1,    zerod2
+real(r8), allocatable ::  oned1(:),  oned2(:)       
 
-integer           ::  izerod1,                 izerod2
-integer,  pointer ::   ioned1(:),               ioned2(:)       
-integer,  pointer ::   itwod1(:,:),             itwod2(:,:)
-integer,  pointer :: ithreed1(:,:,:),         ithreed2(:,:,:)
-integer,  pointer ::  ifourd1(:,:,:,:),        ifourd2(:,:,:,:)
-integer,  pointer ::  ifived1(:,:,:,:,:),      ifived2(:,:,:,:,:)
-integer,  pointer ::   isixd1(:,:,:,:,:,:),     isixd2(:,:,:,:,:,:)
-integer,  pointer :: isevend1(:,:,:,:,:,:,:), isevend2(:,:,:,:,:,:,:)
+integer               ::  izerod1,   izerod2
+integer,  allocatable ::  ioned1(:), ioned2(:)       
 
 logical, save :: module_initialized = .false.
 
@@ -256,6 +244,7 @@
       call error_handler(E_ERR, 'compare_states', msgstring, source, revision, revdate)
    endif
    
+   dimlen(:) = 1
    do j=1,ndims
       call nc_check( nf90_inquire_dimension(ncinid1,  dimid(j),  dimname(j),  dimlen(j)), &
                    'nf90_inquire_dimension', 'infile1/'//trim( dimname(j)) )
@@ -287,32 +276,16 @@
    enddo
 
 
-   select case(ndims)
-      case (0)
-         write(tmpstring, '(2A)')       trim(nextfield), ' [scalar value]'
-      case (1)
-         write(tmpstring, '(2A,1I8,A)') trim(nextfield), '(', dimlen(1),   ')'
-      case (2)
-         write(tmpstring, '(2A,2I8,A)') trim(nextfield), '(', dimlen(1:2), ')'
-      case (3)
-         write(tmpstring, '(2A,3I8,A)') trim(nextfield), '(', dimlen(1:3), ')'
-      case (4)
-         write(tmpstring, '(2A,4I8,A)') trim(nextfield), '(', dimlen(1:4), ')'
-      case (5)
-         write(tmpstring, '(2A,5I8,A)') trim(nextfield), '(', dimlen(1:5), ')'
-      case (6)
-         write(tmpstring, '(2A,6I8,A)') trim(nextfield), '(', dimlen(1:6), ')'
-      case (7)
-         write(tmpstring, '(2A,7I8,A)') trim(nextfield), '(', dimlen(1:7), ')'
-      case default
-         ! "can't happen"
-         write(msgstring, *) 'array dimension is illegal value: ', ndims
-         call error_handler(E_ERR, 'compare_states', msgstring, source, revision, revdate)
-   end select
+   if (ndims == 0) then
+      write(tmpstring, '(2A)') trim(nextfield), ' [scalar value]'
+   else
+      write(tmpstring, '(2A,1I8)') trim(nextfield), '(', dimlen(1)
+      do j=2, ndims
+         write(tmpstring, '(2A,2I8)') trim(tmpstring), ',', dimlen(j)
+      enddo
+      write(tmpstring, '(2A)') trim(tmpstring), ')'
+   endif
 
-   ! announce what we're about to do
-   write(msgstring, *) 'checking equality of: ', trim(tmpstring)
-   call error_handler(E_MSG, 'compare_states', msgstring)
 
    ! allocate right dim array
    ! read/write and then deallocate
@@ -337,11 +310,10 @@
          else
             nitems = 0
          endif
-      case (1)
-         allocate(ioned1(dimlen(1)))
-         allocate(ioned2(dimlen(1)))
-         call nc_check(nf90_get_var(ncinid1, invarid1, ioned1), 'nf90_get_var', 'infile1')
-         call nc_check(nf90_get_var(ncinid2, invarid2, ioned2), 'nf90_get_var', 'infile2')
+      case (1:7)
+         allocate(ioned1(product(dimlen)), ioned2(product(dimlen)))
+         call nc_check(nf90_get_var(ncinid1, invarid1, ioned1, count=dimlen), 'nf90_get_var', 'infile1')
+         call nc_check(nf90_get_var(ncinid2, invarid2, ioned2, count=dimlen), 'nf90_get_var', 'infile2')
          imin1 = minval(ioned1)
          imax1 = maxval(ioned1)
          imin2 = minval(ioned2)
@@ -350,90 +322,12 @@