diff --git a/src/LIB/SURCOUCHE/src/mode_io.f90 b/src/LIB/SURCOUCHE/src/mode_io.f90 index 1f86e15535008317c0828f75e53cb0f34c25c8aa..385f8ec0106c4e0b6bf33b8ac0d3330c817a10bf 100644 --- a/src/LIB/SURCOUCHE/src/mode_io.f90 +++ b/src/LIB/SURCOUCHE/src/mode_io.f90 @@ -509,129 +509,3 @@ CONTAINS END SUBROUTINE CLOSE_ll END MODULE MODE_IO_ll - - -MODULE MODE_MSG -! -USE MODD_IO_ll, ONLY : NVERB_FATAL,NVERB_ERROR,NVERB_WARNING,NVERB_INFO,NVERB_DEBUG -! -IMPLICIT NONE -! -CONTAINS -! -SUBROUTINE PRINT_MSG(KVERB,HDOMAIN,HSUBR,HMSG) -! -USE ISO_FORTRAN_ENV, ONLY : ERROR_UNIT, OUTPUT_UNIT -! -USE MODD_CONF, ONLY : CPROGRAM -USE MODD_IO_ll, ONLY : NIO_VERB,NIO_ABORT_LEVEL,NGEN_VERB,NGEN_ABORT_LEVEL, & - LVERB_OUTLST, LVERB_STDOUT, LVERB_ALLPRC, TFILE_OUTPUTLISTING -USE MODD_LUNIT, ONLY : TLUOUT0 -USE MODD_VAR_ll, ONLY : IP, NMNH_COMM_WORLD -! -use modi_tools_c -! -!USE MODE_FM, ONLY : IO_FILE_CLOSE_ll -! -INTEGER, INTENT(IN) :: KVERB !Verbosity level -CHARACTER(LEN=*),INTENT(IN) :: HDOMAIN !Domain/category of message -CHARACTER(LEN=*),INTENT(IN) :: HSUBR !Subroutine/function name -CHARACTER(LEN=*),INTENT(IN) :: HMSG !Message -! -CHARACTER(LEN=8) :: YPRC -CHARACTER(LEN=9) :: YPRE -CHARACTER(LEN=30) :: YSUBR -INTEGER :: IERR, IMAXVERB,IABORTLEVEL -INTEGER :: ILU -LOGICAL :: GWRITE_OUTLST,GWRITE_STDOUT -! -!Determine if the process will write -GWRITE_OUTLST = .FALSE. -GWRITE_STDOUT = .FALSE. -IF (IP == 1 .OR. LVERB_ALLPRC) THEN - IF (LVERB_OUTLST) GWRITE_OUTLST = .TRUE. - IF (LVERB_STDOUT) GWRITE_STDOUT = .TRUE. -END IF -! -YPRC='' -IF (LVERB_ALLPRC) WRITE(YPRC,'( I8 )') IP-1 -! -!Check if the output file is available -ILU = -1 -IF (ASSOCIATED(TFILE_OUTPUTLISTING)) THEN - IF (TFILE_OUTPUTLISTING%LOPENED) THEN - ILU = TFILE_OUTPUTLISTING%NLU - ELSE - GWRITE_OUTLST = .FALSE. - IF (GWRITE_STDOUT) WRITE(UNIT=OUTPUT_UNIT,FMT=*) 'TFILE_OUTPUTLISTING not opened' - END IF -ELSE -!PW: TODO?: temporary to detect non-initialisation -! should disappear except at the beginning of a run - GWRITE_OUTLST = .FALSE. - IF (GWRITE_STDOUT .AND. CPROGRAM/='LFICDF') WRITE(UNIT=OUTPUT_UNIT,FMT=*) 'TFILE_OUTPUTLISTING not associated' -END IF -! -SELECT CASE(HDOMAIN) - CASE('IO') - IMAXVERB = NIO_VERB - IABORTLEVEL = NIO_ABORT_LEVEL - CASE ('GEN') - IMAXVERB = NGEN_VERB - IABORTLEVEL = NGEN_ABORT_LEVEL - CASE DEFAULT - IF (GWRITE_STDOUT) WRITE(UNIT=OUTPUT_UNIT,FMT=*) 'ERROR: PRINT_MSG: wrong message category (',TRIM(HDOMAIN),')' - IF (GWRITE_OUTLST) WRITE(UNIT=ILU, FMT=*) 'ERROR: PRINT_MSG: wrong message category (',TRIM(HDOMAIN),')' - RETURN -END SELECT -! -IF (KVERB>IMAXVERB) RETURN -! -SELECT CASE(KVERB) - CASE(NVERB_FATAL) - YPRE='FATAL: ' - CASE(NVERB_ERROR) - YPRE='ERROR: ' - CASE(NVERB_WARNING) - YPRE='WARNING: ' - CASE(NVERB_INFO) - YPRE='INFO: ' - CASE(NVERB_DEBUG) - YPRE='DEBUG: ' - CASE DEFAULT - IF (GWRITE_STDOUT) WRITE(UNIT=OUTPUT_UNIT,FMT=*) 'ERROR: PRINT_MSG: wrong verbosity level' - IF (GWRITE_OUTLST) WRITE(UNIT=ILU, FMT=*) 'ERROR: PRINT_MSG: wrong verbosity level' -END SELECT -! -YSUBR=TRIM(HSUBR)//':' -IF (LVERB_ALLPRC) THEN - IF (GWRITE_STDOUT) WRITE(UNIT=OUTPUT_UNIT,FMT="(A8,': ',A9,A30,A)") ADJUSTL(YPRC),YPRE,YSUBR,HMSG - IF (GWRITE_OUTLST) WRITE(UNIT=ILU, FMT="(A8,': ',A9,A30,A)") ADJUSTL(YPRC),YPRE,YSUBR,HMSG -ELSE - IF (GWRITE_STDOUT) WRITE(UNIT=OUTPUT_UNIT,FMT="(A9,A30,A)") YPRE,YSUBR,HMSG - IF (GWRITE_OUTLST) WRITE(UNIT=ILU, FMT="(A9,A30,A)") YPRE,YSUBR,HMSG -END IF -! -IF (KVERB<=IABORTLEVEL) THEN - IF (IP==1) WRITE(UNIT=ERROR_UNIT,FMT=*) 'ABORT asked by application '//TRIM(CPROGRAM) - IF (GWRITE_STDOUT) WRITE(UNIT=OUTPUT_UNIT,FMT=*) 'ABORT asked by application '//TRIM(CPROGRAM) - IF (GWRITE_OUTLST) WRITE(UNIT=ILU, FMT=*) 'ABORT asked by application '//TRIM(CPROGRAM) -#if 0 - !Problem: loop dependency between MODE_MSG and MODE_FM (IO_FILE_CLOSE_ll call PRINT_MSG) - NIO_VERB = 0 !To not get further messages (ABORT should be the last for readability) - IF (ILU>0) CALL IO_FILE_CLOSE_ll(TFILE_OUTPUTLISTING) !To flush it -#else - IF (ILU>0) FLUSH(UNIT=ILU) !OK in F2003 - IF (ASSOCIATED(TLUOUT0)) FLUSH(UNIT=TLUOUT0%NLU) -#endif - !Add a sleep to ensure that the process(es) that have to write to stderr and to file - !have enough time before an other process calls mpi_abort - CALL SLEEP_C(5) - ! - CALL MPI_ABORT(NMNH_COMM_WORLD, -10, IERR) - CALL ABORT -END IF -! -END SUBROUTINE PRINT_MSG -! -END MODULE MODE_MSG diff --git a/src/LIB/SURCOUCHE/src/mode_msg.f90 b/src/LIB/SURCOUCHE/src/mode_msg.f90 new file mode 100644 index 0000000000000000000000000000000000000000..ad5cd4191b6ce81207039e6b83fd8e7cc908ab20 --- /dev/null +++ b/src/LIB/SURCOUCHE/src/mode_msg.f90 @@ -0,0 +1,134 @@ +!MNH_LIC Copyright 2017-2019 CNRS, Meteo-France and Universite Paul Sabatier +!MNH_LIC This is part of the Meso-NH software governed by the CeCILL-C licence +!MNH_LIC version 1. See LICENSE, CeCILL-C_V1-en.txt and CeCILL-C_V1-fr.txt +!MNH_LIC for details. version 1. +!----------------------------------------------------------------- +! Author(s) +! P. Wautelet 24/01/2017 +! Modifications: +! P. Wautelet 27/02/2019: module extracted from mode_io.f90 +!----------------------------------------------------------------- +MODULE MODE_MSG +! +USE MODD_IO_ll, ONLY : NVERB_FATAL,NVERB_ERROR,NVERB_WARNING,NVERB_INFO,NVERB_DEBUG +! +IMPLICIT NONE +! +CONTAINS +! +SUBROUTINE PRINT_MSG(KVERB,HDOMAIN,HSUBR,HMSG) +! +USE ISO_FORTRAN_ENV, ONLY : ERROR_UNIT, OUTPUT_UNIT +! +USE MODD_CONF, ONLY : CPROGRAM +USE MODD_IO_ll, ONLY : NIO_VERB,NIO_ABORT_LEVEL,NGEN_VERB,NGEN_ABORT_LEVEL, & + LVERB_OUTLST, LVERB_STDOUT, LVERB_ALLPRC, TFILE_OUTPUTLISTING +USE MODD_LUNIT, ONLY : TLUOUT0 +USE MODD_VAR_ll, ONLY : IP, NMNH_COMM_WORLD +! +use modi_tools_c +! +!USE MODE_FM, ONLY : IO_FILE_CLOSE_ll +! +INTEGER, INTENT(IN) :: KVERB !Verbosity level +CHARACTER(LEN=*),INTENT(IN) :: HDOMAIN !Domain/category of message +CHARACTER(LEN=*),INTENT(IN) :: HSUBR !Subroutine/function name +CHARACTER(LEN=*),INTENT(IN) :: HMSG !Message +! +CHARACTER(LEN=8) :: YPRC +CHARACTER(LEN=9) :: YPRE +CHARACTER(LEN=30) :: YSUBR +INTEGER :: IERR, IMAXVERB,IABORTLEVEL +INTEGER :: ILU +LOGICAL :: GWRITE_OUTLST,GWRITE_STDOUT +! +!Determine if the process will write +GWRITE_OUTLST = .FALSE. +GWRITE_STDOUT = .FALSE. +IF (IP == 1 .OR. LVERB_ALLPRC) THEN + IF (LVERB_OUTLST) GWRITE_OUTLST = .TRUE. + IF (LVERB_STDOUT) GWRITE_STDOUT = .TRUE. +END IF +! +YPRC='' +IF (LVERB_ALLPRC) WRITE(YPRC,'( I8 )') IP-1 +! +!Check if the output file is available +ILU = -1 +IF (ASSOCIATED(TFILE_OUTPUTLISTING)) THEN + IF (TFILE_OUTPUTLISTING%LOPENED) THEN + ILU = TFILE_OUTPUTLISTING%NLU + ELSE + GWRITE_OUTLST = .FALSE. + IF (GWRITE_STDOUT) WRITE(UNIT=OUTPUT_UNIT,FMT=*) 'TFILE_OUTPUTLISTING not opened' + END IF +ELSE +!PW: TODO?: temporary to detect non-initialisation +! should disappear except at the beginning of a run + GWRITE_OUTLST = .FALSE. + IF (GWRITE_STDOUT .AND. CPROGRAM/='LFICDF') WRITE(UNIT=OUTPUT_UNIT,FMT=*) 'TFILE_OUTPUTLISTING not associated' +END IF +! +SELECT CASE(HDOMAIN) + CASE('IO') + IMAXVERB = NIO_VERB + IABORTLEVEL = NIO_ABORT_LEVEL + CASE ('GEN') + IMAXVERB = NGEN_VERB + IABORTLEVEL = NGEN_ABORT_LEVEL + CASE DEFAULT + IF (GWRITE_STDOUT) WRITE(UNIT=OUTPUT_UNIT,FMT=*) 'ERROR: PRINT_MSG: wrong message category (',TRIM(HDOMAIN),')' + IF (GWRITE_OUTLST) WRITE(UNIT=ILU, FMT=*) 'ERROR: PRINT_MSG: wrong message category (',TRIM(HDOMAIN),')' + RETURN +END SELECT +! +IF (KVERB>IMAXVERB) RETURN +! +SELECT CASE(KVERB) + CASE(NVERB_FATAL) + YPRE='FATAL: ' + CASE(NVERB_ERROR) + YPRE='ERROR: ' + CASE(NVERB_WARNING) + YPRE='WARNING: ' + CASE(NVERB_INFO) + YPRE='INFO: ' + CASE(NVERB_DEBUG) + YPRE='DEBUG: ' + CASE DEFAULT + IF (GWRITE_STDOUT) WRITE(UNIT=OUTPUT_UNIT,FMT=*) 'ERROR: PRINT_MSG: wrong verbosity level' + IF (GWRITE_OUTLST) WRITE(UNIT=ILU, FMT=*) 'ERROR: PRINT_MSG: wrong verbosity level' +END SELECT +! +YSUBR=TRIM(HSUBR)//':' +IF (LVERB_ALLPRC) THEN + IF (GWRITE_STDOUT) WRITE(UNIT=OUTPUT_UNIT,FMT="(A8,': ',A9,A30,A)") ADJUSTL(YPRC),YPRE,YSUBR,HMSG + IF (GWRITE_OUTLST) WRITE(UNIT=ILU, FMT="(A8,': ',A9,A30,A)") ADJUSTL(YPRC),YPRE,YSUBR,HMSG +ELSE + IF (GWRITE_STDOUT) WRITE(UNIT=OUTPUT_UNIT,FMT="(A9,A30,A)") YPRE,YSUBR,HMSG + IF (GWRITE_OUTLST) WRITE(UNIT=ILU, FMT="(A9,A30,A)") YPRE,YSUBR,HMSG +END IF +! +IF (KVERB<=IABORTLEVEL) THEN + IF (IP==1) WRITE(UNIT=ERROR_UNIT,FMT=*) 'ABORT asked by application '//TRIM(CPROGRAM) + IF (GWRITE_STDOUT) WRITE(UNIT=OUTPUT_UNIT,FMT=*) 'ABORT asked by application '//TRIM(CPROGRAM) + IF (GWRITE_OUTLST) WRITE(UNIT=ILU, FMT=*) 'ABORT asked by application '//TRIM(CPROGRAM) +#if 0 + !Problem: loop dependency between MODE_MSG and MODE_FM (IO_FILE_CLOSE_ll call PRINT_MSG) + NIO_VERB = 0 !To not get further messages (ABORT should be the last for readability) + IF (ILU>0) CALL IO_FILE_CLOSE_ll(TFILE_OUTPUTLISTING) !To flush it +#else + IF (ILU>0) FLUSH(UNIT=ILU) !OK in F2003 + IF (ASSOCIATED(TLUOUT0)) FLUSH(UNIT=TLUOUT0%NLU) +#endif + !Add a sleep to ensure that the process(es) that have to write to stderr and to file + !have enough time before an other process calls mpi_abort + CALL SLEEP_C(5) + ! + CALL MPI_ABORT(NMNH_COMM_WORLD, -10, IERR) + CALL ABORT +END IF +! +END SUBROUTINE PRINT_MSG +! +END MODULE MODE_MSG