Table Subroutine

public subroutine Table()

Arguments

None

Source Code

    subroutine Table()
!--------------------------------------------------------------------
      integer, parameter   :: nlines_0 = 11
      integer, dimension(nlines_0), parameter :: ncol_0 = &
           (/ 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11/)
      real(ESMF_KIND_R4), dimension(nlines_0), parameter ::plev_0 = &
           (/1000, 925, 850, 700, 500, 400, 300, 250, 200, 150, 100/)
      real(ESMF_KIND_R4), dimension(nlines_0, nlines_0) :: vCorr_0
!!!      real(ESMF_KIND_R4) :: vCorr_aux(121)
      character(ESMF_MAXSTR) :: failMsg
      character(ESMF_MAXSTR) :: name
      integer :: memstat

      integer :: result = 0
     
      vCorr_0 = RESHAPE (  (/ &
           1.00, 0., 0., 0., 0., 0., 0.,0., 0., 0., 0., &
           0.84, 1.00, 0., 0., 0., 0.,0., 0.,0., 0., 0., &
           0.68, 0.84, 1.00, 0., 0., 0., 0.,0., 0.,0., 0., & 
           0.53, 0.67, 0.81, 1.00, 0., 0., 0., 0.,0., 0.,0., & 
           0.35, 0.46, 0.56, 0.81, 1.00, 0., 0., 0., 0.,0., 0., & 
           0.27, 0.35, 0.44, 0.64, 0.79, 1.00, 0., 0., 0., 0.,0., & 
           0.18, 0.25, 0.32, 0.46, 0.58, 0.75, 1.00, 0., 0., 0., 0.,& 
           0.13, 0.19, 0.25, 0.38, 0.48, 0.62, 0.83, 1.00,  0., 0., 0., & 
           0.09, 0.14, 0.19, 0.29, 0.38, 0.49, 0.66, 0.80, 1.00, 0., 0., & 
           0.06, 0.09, 0.13, 0.20, 0.28, 0.36, 0.49, 0.59, 0.75, 1.00, 0., & 
           0.00, 0.03, 0.06, 0.10, 0.17, 0.23, 0.32, 0.39, 0.50, 0.75, 1.00  &
           /),  (/11,11/)  )


      
!            Get dimension, label and start getting lines

      rc = 0

!''''''''''''''''''''''''''''

     !------------------------------------------------------------------------
      !EX_UTest
      ! Config Get Dim Test
      write(failMsg, *) "Did not return ESMF_SUCCESS"
      write(name, *) "Config Get Dim Test"
      call ESMF_ConfigGetDim(cf, nlines, col, label='ObsErr*vCor_HH-7::', rc=rc)
      call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!''''''''''''''''''''''''''''
      counter_total =counter_total + 1
      if (rc /= ESMF_SUCCESS) then
         print *,'ESMF_ConfigGetDim failed, rc =', rc
         return
      endif

      if( nlines == nlines_0 ) then
         counter_success =counter_success + 1
      else
         print *,'ESMF_ConfigGetDim ERROR: got  =', nlines, &
              ' should be ', nlines_0 
         return
      endif

     !------------------------------------------------------------------------
     !EX_UTest
     ! Config Get Dim Verification Test
     write(failMsg, *) "Attribute Dim values are incorrect"
     write(name, *) "Verify Attribute Dim Values Test"
     call ESMF_Test((nlines.eq.nlines_0), name, failMsg, result, ESMF_SRCLINE)

      
!''''''''''''''''''''''''''''         

     !------------------------------------------------------------------------
      !EX_UTest
      ! Config Find Label Test
      write(failMsg, *) "Did not return ESMF_SUCCESS"
      write(name, *) "Config Find Label Test"
      call ESMF_ConfigFindLabel( cf,'ObsErr*vCor_HH-7::', rc=rc)
      call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!''''''''''''''''''''''''''''
      counter_total =counter_total + 1
      if (rc == ESMF_SUCCESS) then
         counter_success =counter_success + 1
      else
          print *,'ESMF_ConfigFindLabel failed, label ObsErr*vCor_HH-7::, = rc =', rc 
         return        
      endif

!''''''''''''''''''''''''''''     
         allocate(ncol(1:nlines), STAT= memstat)
!''''''''''''''''''''''''''''
      if (memstat /= 0) then
         print *,'array allocation failed, stat =', memstat
         rc = ESMF_RC_MEM
         return
      endif
      
      counter_total =counter_total + 1
!'''''''''''''''''''''''''''' 
      do line = 1, nlines

      call ESMF_ConfigNextLine(cf, rc = rc)
!''''''''''''''''''''''''''''
         if (rc /= ESMF_SUCCESS) then
            print *,'ESMF_ConfigNextLine failed, rc =', rc 
            exit        
         endif
!''''''''''''''''''''''''''''    
      ncol(line) = ESMF_ConfigGetLen(cf, rc = rc) - 1
!''''''''''''''''''''''''''''  
      if (rc /= ESMF_SUCCESS) then
         print *,'ESMF_ConfigGetLen failed, rc =', rc
         exit
      endif
!''''''''''''''''''''''''''''  
      enddo
!''''''''''''''''''''''''''''


     !------------------------------------------------------------------------
     !EX_UTest
     ! Config Get Next Line and Get Len Verification Test
     write(failMsg, *) "Attribute Line values are incorrect"
     write(name, *) "Verify Attribute Line Values Test"
     call ESMF_Test((all(ncol.eq.ncol_0)), name, failMsg, result, ESMF_SRCLINE)

      if( any(ncol /= ncol_0 )) then
         print *,'ESMF_ConfigGetInt ERROR: got ncol =', ncol(1:nlines), &
              ' should be ncol =', ncol_0(1:nlines_0) 
         return
      else
         counter_success =counter_success + 1
      endif


!            Looping over lines

!''''''''''''''''''''''''''''   
     !------------------------------------------------------------------------
      !EX_UTest
      ! Config Find Label Test
      write(failMsg, *) "Did not return ESMF_SUCCESS"
      write(name, *) "Config Bad Label Test"
      call ESMF_ConfigFindLabel( cf,'Bad', rc=rc)
      call ESMF_Test(rc /= ESMF_SUCCESS, name, failMsg, result, ESMF_SRCLINE)

     !------------------------------------------------------------------------
      !EX_UTest
      ! Config Find Label Test
      write(failMsg, *) "Did not return ESMF_SUCCESS"
      write(name, *) "Config Find Label Test"
      call ESMF_ConfigFindLabel( cf,'ObsErr*vCor_HH-7::', rc=rc)
      call ESMF_Test((rc.eq.ESMF_SUCCESS), name, failMsg, result, ESMF_SRCLINE)
!''''''''''''''''''''''''''''
      counter_total =counter_total + 1
      if (rc == ESMF_SUCCESS) then
         counter_success =counter_success + 1
      else
         print *,'ESMF_ConfigFindLabel failed, label = ObsErr*vCor_HH-7::, rc =', rc 
         return        
      endif


!''''''''''''''''''''''''''''
      do line = 1, nlines
         call ESMF_ConfigNextLine( cf, tableEnd=end, rc=rc)
!''''''''''''''''''''''''''''

         if (rc /= ESMF_SUCCESS) then
            print *,'ESMF_ConfigNextLine failed, rc =', rc 
            exit        
         endif
            
!               Retrieve pressure level
!               -----------------------
         counter_total =counter_total + 1
!''''''''''''''''''''''''''''
            call ESMF_ConfigGetAttribute( cf, plev(line), rc=rc )
!''''''''''''''''''''''''''''
         if (rc /= ESMF_SUCCESS) then
            print *,'ESMF_ConfigAttribute failed, rc =', rc 
            exit
         endif

         if( plev(line) /= plev_0(line) ) then
            print *,'ESMF_ConfigGetAttribute(float) ERROR: got plev =', &
                 plev(line), ' should be plev =', plev_0(line) 
            exit
         else
            counter_success =counter_success + 1
         endif
            
!               Looping over columns
!               --------------------
         counter_total =counter_total + 1
!''''''''''''''''''''''''''''
         do col =1, ncol(line)
            call ESMF_ConfigGetAttribute( cf, temp, rc=rc)
            if (rc == ESMF_SUCCESS) then 
               vCorr(line,col) = temp 
            end if
         end do
!''''''''''''''''''''''''''''
         if (rc /= ESMF_SUCCESS) then
            print *,'ESMF_ConfigGetAttribute(float) failed, rc =', rc 
            exit        
         endif

         
         do col =1, ncol(line)
            if (vCorr(line, col) /= vCorr_0(col, line)) then
               print *,'ESMF_ConfigGetAttribute(float):  Wrong value in vCorr line =', &
                   line,' col =', col,' VCorr = ', vCorr(col, line), &
                   ' should be ', vCorr_0(line, col)
               exit
            endif
         end do
         counter_success = counter_success + 1

!''''''''''''''''''''''''''''    
      end do
!''''''''''''''''''''''''''''
!''''''''''''''''''''''''''''     
      deallocate(ncol, STAT= memstat)
!''''''''''''''''''''''''''''
      if (memstat /= 0) then
         print *,'array deallocation failed, stat =', memstat
         rc = ESMF_RC_MEM
      endif


      return
    end subroutine Table