Philippe 27/02/2019: IO: extract module PRINT_MSG from mode_io.f90

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

src/LIB/SURCOUCHE/src/mode_msg.f90

+!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