! $Id: ropp_fm_summary.f90 2197 2009-06-23 09:11:17Z idculv $ PROGRAM ropp_fm_summary !****p* Programs/ropp_fm_summary * ! ! NAME ! ropp_fm_summary - Computes and publishes a summary table of ! the results of ropp_fm make tests. ! ! SYNOPSIS ! ropp_fm_summary ! ! DESCRIPTION ! Generates summary table ropp_fm_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_fm_summary.txt. ! ! NOTES ! The names of the possible tests here must match (a subset of) ! those listed in ropp_fm/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=27 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_fm_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_fm_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_fascod_1' sdesc(i_test) = 'FM FASCOD 1D ref' CASE (2) sname(i_test) = 't_fascod_tl_1' sdesc(i_test) = 'FM_TL FASCOD 1D ref' CASE (3) sname(i_test) = 't_fascod_ad_1' sdesc(i_test) = 'FM_AD FASCOD 1D ref' CASE (4) sname(i_test) = 't_fascod_2' sdesc(i_test) = 'FM FASCOD 1D ref -comp' CASE (5) sname(i_test) = 't_fascod_tl_2' sdesc(i_test) = 'FM_TL FASCOD 1D ref -comp' CASE (6) sname(i_test) = 't_fascod_ad_2' sdesc(i_test) = 'FM_AD FASCOD 1D ref -comp' CASE (7) sname(i_test) = 't_fascod_3' sdesc(i_test) = 'FM FASCOD 1D ref -new_op' CASE (8) sname(i_test) = 't_fascod_tl_3' sdesc(i_test) = 'FM_TL FASCOD 1D ref -new_op' CASE (9) sname(i_test) = 't_fascod_ad_3' sdesc(i_test) = 'FM_AD FASCOD 1D ref -new_op' CASE (10) sname(i_test) = 't_fascod_4' sdesc(i_test) = 'FM FASCOD 1D ref -comp -new_op' CASE (11) sname(i_test) = 't_fascod_tl_4' sdesc(i_test) = 'FM_TL FASCOD 1D ref -comp -new_op' CASE (12) sname(i_test) = 't_fascod_ad_4' sdesc(i_test) = 'FM_AD FASCOD 1D ref -comp -new_op' CASE (13) sname(i_test) = 't_twodop_1' sdesc(i_test) = 'FM TWOD' CASE (14) sname(i_test) = 't_twodtl_1' sdesc(i_test) = 'FM_TL TWOD' CASE (15) sname(i_test) = 't_twodad_1' sdesc(i_test) = 'FM_AD TWOD' CASE (16) sname(i_test) = 't_twodop_2' sdesc(i_test) = 'FM TWOD -comp' CASE (17) sname(i_test) = 't_twodtl_2' sdesc(i_test) = 'FM_TL TWOD -comp' CASE (18) sname(i_test) = 't_twodad_2' sdesc(i_test) = 'FM_AD TWOD -comp' CASE (19) sname(i_test) = 't_iono_1' sdesc(i_test) = 'FM L1 and L2' CASE (20) sname(i_test) = 't_iono_tl_1' sdesc(i_test) = 'FM_TL L1 and L2' CASE (21) sname(i_test) = 't_iono_ad_1' sdesc(i_test) = 'FM_AD L1 and L2' CASE (22) sname(i_test) = 't_fm_1D_1' sdesc(i_test) = 'ECMWF bgs; default options' CASE (23) sname(i_test) = 't_fm_1D_2' sdesc(i_test) = 'ECMWF bgs; w/ comp factors' CASE (24) sname(i_test) = 't_fm_2D_1' sdesc(i_test) = 'ECMWF 2D bgs; default options' CASE (25) sname(i_test) = 't_fm_2D_2' sdesc(i_test) = 'ECMWF 2D bgs; w/ comp factors' CASE (26) sname(i_test) = 't_fm_iono_1' sdesc(i_test) = 'ECMWF bgs to L1 and L2 (neut)' CASE (27) sname(i_test) = 't_fm_iono_2' sdesc(i_test) = 'ECMWF bgs to L1 and L2 (iono)' 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_FM 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 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_fm_summary