! $Id: ropp_1dvar_summary.f90 2197 2009-06-23 09:11:17Z idculv $

PROGRAM ropp_1dvar_summary

!****p* Programs/ropp_1dvar_summary *
!
! NAME
!    ropp_1dvar_summary - Computes and publishes a summary table of
!                         the results of ropp_1dvar make tests.
!
! SYNOPSIS
!    ropp_1dvar_summary
!
! DESCRIPTION
!    Generates summary table ropp_1dvar_summary.txt, using information in
!    compare.txt, which is generated by ropp_io_fields_compare.f90.
!    It extends this table by checking which of the standard 'make test'
!    tests have been run, and tells the user if they haven't.
!
! INPUTS
!    Text file compare.txt.
!
! OUTPUT
!    Stdout and text file ropp_1dvar_summary.txt.
!
! NOTES
!    The names of the possible tests here must match (a subset of) 
!    those listed in ropp_1dvar/tests/Makefile.am.
!
! REFERENCES
!
! AUTHOR
!    Met Office, Exeter, UK.
!    Any comments on this software should be given via the ROM SAF
!    Helpdesk at http://www.romsaf.org
!
! COPYRIGHT
!   (c) EUMETSAT. All rights reserved.
!   For further details please refer to the file COPYRIGHT
!   which you should have received as part of this distribution.
!
!****

  USE messages
  USE ropp_utils,    ONLY: Get_IO_Unit

  IMPLICIT NONE

  INTEGER, PARAMETER                     :: n_tests=15

  CHARACTER(LEN=256), DIMENSION(n_tests) :: sname ! Name of the test
  CHARACTER(LEN=256), DIMENSION(n_tests) :: sdesc ! Description of the test
  CHARACTER(LEN=256), DIMENSION(n_tests) :: sdone ! Has the test run?
  CHARACTER(LEN=256), DIMENSION(n_tests) :: spass ! Has test passed or failed?

  CHARACTER(LEN=256), PARAMETER          :: sformat=&
                                  "('| ',a30,' | ',a30,' | ',a7,' | ',a6,' |')"

  CHARACTER(LEN=256), PARAMETER          :: compare_file='compare.txt'
  INTEGER                                :: compare_lun

  CHARACTER(LEN=256), PARAMETER          :: summary_file='ropp_1dvar_summary.txt'
  INTEGER                                :: summary_lun

  CHARACTER(LEN=256)                     :: work       ! Dummy work space
  CHARACTER(LEN=256)                     :: routine    ! Routine name for diagnostics
  LOGICAL                                :: exists     ! File exists flag
  LOGICAL                                :: test_found ! Test in comparison file flag
  INTEGER                                :: iostatus   ! I/O Status

  INTEGER                                :: i_test     ! Test loop counter
  INTEGER                                :: i          ! Loop counter

! ------------------------------------------------------------------------------
! 0. Set routine for error messages
! ------------------------------------------------------------------------------

  CALL message_get_routine(routine)
  CALL message_set_routine('ropp_1dvar_summary')


! ------------------------------------------------------------------------------
! 1. Interrogate comparison file
! ------------------------------------------------------------------------------

! 1.1 Define tests to loop through
! --------------------------------

  DO i_test=1,n_tests

    SELECT CASE (i_test)

      CASE (1)
        sname(i_test) = 't_1dvar_01_refrac'
        sdesc(i_test) = '1DVAR basic; default'
      CASE (2)
        sname(i_test) = 't_1dvar_01comp_refrac'
        sdesc(i_test) = '1DVAR basic; comp factors'

      CASE (3)
        sname(i_test) = 't_1dvar_GRAS_05_bangle'
        sdesc(i_test) = '1DVAR GRAS; default'
      CASE (4)
        sname(i_test) = 't_1dvar_GRAS_05comp_bangle'
        sdesc(i_test) = '1DVAR GRAS; comp factors'
      CASE (5)
        sname(i_test) = 't_1dvar_GRAS_05newop_bangle'
        sdesc(i_test) = '1DVAR GRAS; new interp'

      CASE (6)
        sname(i_test) = 't_1dvar_GRAS_05_refrac'
        sdesc(i_test) = '1DVAR GRAS; default'
      CASE (7)
        sname(i_test) = 't_1dvar_GRAS_05comp_refrac'
        sdesc(i_test) = '1DVAR GRAS; comp factors'
      CASE (8)
        sname(i_test) = 't_1dvar_GRAS_05newop_refrac'
        sdesc(i_test) = '1DVAR GRAS; new interp'

      CASE (9)
        sname(i_test) = 't_1dvar_COSMIC_04_bangle'
        sdesc(i_test) = '1DVAR COSMIC; default'
      CASE (10)
        sname(i_test) = 't_1dvar_COSMIC_04comp_bangle'
        sdesc(i_test) = '1DVAR COSMIC; comp factors'
      CASE (11)
        sname(i_test) = 't_1dvar_COSMIC_04newop_bangle'
        sdesc(i_test) = '1DVAR COSMIC; new interp'

      CASE (12)
        sname(i_test) = 't_1dvar_COSMIC_04_refrac'
        sdesc(i_test) = '1DVAR COSMIC; default'
      CASE (13)
        sname(i_test) = 't_1dvar_COSMIC_04comp_refrac'
        sdesc(i_test) = '1DVAR COSMIC; comp factors'
      CASE (14)
        sname(i_test) = 't_1dvar_COSMIC_04newop_refrac'
        sdesc(i_test) = '1DVAR COSMIC; new interp'

      CASE (15)
        sname(i_test) = 't_1dvar_iono_bangle'
        sdesc(i_test) = '1DVAR L1 and L2'

       CASE DEFAULT
        sname(i_test) = ''
        sdesc(i_test) = ''

    END SELECT

    sdone(i_test) = 'Not run'
    spass(i_test) = '------'

  ENDDO

! 1.2 Open the summary file
! -------------------------

  summary_lun = get_io_unit()  ! Find a free lun

  OPEN ( summary_lun, FILE=summary_file, STATUS='REPLACE', &
         ACTION='WRITE', IOSTAT=iostatus )

  IF ( iostatus > 0 ) &
    CALL message ( msg_fatal, 'I/O error when opening output summary file ' // &
                               summary_file )

  WRITE ( summary_lun, '(a)' ) '************************** SUMMARY OF ROPP_1DVAR TEST RESULTS ************************'
  WRITE ( summary_lun, '(a)' ) '--------------------------------------------------------------------------------------'
  WRITE ( summary_lun, sformat ) 'Test name   ', 'Description      ', 'Run?', 'PASS?'
  WRITE ( summary_lun, '(a)' ) '--------------------------------------------------------------------------------------'

! 1.3 Open the comparison file
! ----------------------------

  INQUIRE ( FILE=compare_file, EXIST=exists )

  IF ( .NOT. exists ) &
    CALL message( msg_fatal, 'Non-existent input summary file ' // &
                              compare_file )

  compare_lun = get_io_unit()  ! Find a free lun

  OPEN ( compare_lun, FILE=compare_file, STATUS='OLD', &
         ACTION='READ', IOSTAT=iostatus )

  IF ( iostatus /= 0 ) &
    CALL message ( msg_fatal, 'I/O error when opening input summary file ' // &
                               compare_file )

! 1.4 Loop through the comparison file
! ------------------------------------

  tests: DO i_test=1,n_tests

    test_found = .FALSE.

    REWIND ( compare_lun )

    DO i=1,4  ! Omit 4 line header
      READ ( compare_lun, '(a)', IOSTAT=iostatus ) work
      IF ( iostatus /= 0 ) &
        CALL message ( msg_fatal, 'I/O error when reading input summary file ' // &
                                   compare_file )
    END DO

    comparison_file_loop: DO

      READ ( compare_lun, '(a)', IOSTAT=iostatus ) work

      IF ( iostatus > 0 ) &
         CALL message ( msg_fatal, 'I/O error when reading input summary file ' // &
                                    compare_file )

      IF ( iostatus < 0 ) EXIT  ! End of file or record

      IF ( INDEX(work, TRIM(ADJUSTL(sname(i_test)))//' ') /= 0 ) THEN ! Test in comparison file

! Fixme: Make it write out the sdesc defined at the top of this routine,
!        not the one specified in the script that ran the test.

        WRITE ( summary_lun, '(a)' ) TRIM(ADJUSTL(work))

        test_found = .TRUE.

        EXIT

      END IF

    END DO comparison_file_loop

    IF ( .NOT. test_found ) &  ! Write out 'not run' message
      WRITE ( summary_lun, sformat ) TRIM(ADJUSTL(sname(i_test))), &
                                     TRIM(ADJUSTL(sdesc(i_test))), &
                                     TRIM(ADJUSTL(sdone(i_test))), &
                                     TRIM(ADJUSTL(spass(i_test)))

  END DO tests

  WRITE ( summary_lun, '(a)' ) '--------------------------------------------------------------------------------------'

  CLOSE ( compare_lun )
  CLOSE ( summary_lun )


END PROGRAM ropp_1dvar_summary