Merge branch 'master' of https://github.com/UMR-CNRM/PHYEX

src/lmdz/aux/mode_msg.F90

+! Author(s)
+!   S. Riette (18 Nov 2021), adapted from the Meso-NH version
+! Modifications:
+!-----------------------------------------------------------------
+MODULE MODE_MSG
+
+USE MODD_IO, ONLY: NVERB_FATAL, NVERB_ERROR, NVERB_WARNING, &
+                  &NVERB_INFO, NVERB_DEBUG, N_ABORT_LEVEL
+
+IMPLICIT NONE
+
+INTEGER, PARAMETER :: NMSGLGTMAX   = 100 ! Maximum length for a message
+INTEGER, PARAMETER :: NMSGLLINEMAX = 10  ! Maximum number of lines for a message
+CHARACTER(LEN=NMSGLGTMAX), DIMENSION(NMSGLLINEMAX) :: CMNHMSG=''
+
+#include "abor1.intfb.h"
+
+INTERFACE PRINT_MSG
+  MODULE PROCEDURE PRINT_MSG_1LINE, PRINT_MSG_MULTI_CMNHMSG, PRINT_MSG_MULTI
+ENDINTERFACE PRINT_MSG
+
+CONTAINS
+
+SUBROUTINE PRINT_MSG_1LINE(KVERB, HDOMAIN, HSUBR, HMSG)
+  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
+
+  CALL PRINT_MSG_MULTI(KVERB, HDOMAIN, HSUBR, [HMSG])
+
+ENDSUBROUTINE PRINT_MSG_1LINE
+
+SUBROUTINE PRINT_MSG_MULTI_CMNHMSG(KVERB, HDOMAIN, HSUBR)
+  INTEGER,          INTENT(IN) :: KVERB   !Verbosity level
+  CHARACTER(LEN=*), INTENT(IN) :: HDOMAIN !Domain/category of message
+  CHARACTER(LEN=*), INTENT(IN) :: HSUBR   !Subroutine/function name
+
+  INTEGER :: ILINES
+
+  !Find the last non empty line
+  ILINES=SIZE(CMNHMSG)
+  DO WHILE (LEN_TRIM(CMNHMSG(ILINES))==0)
+    ILINES=ILINES - 1
+  ENDDO
+
+  CALL PRINT_MSG_MULTI(KVERB, HDOMAIN, HSUBR, CMNHMSG(1:ILINES))
+
+  !Empty the message buffer
+  !This is necessary especially if the next call contain a shorter message
+  CMNHMSG(1:ILINES)=''
+
+ENDSUBROUTINE PRINT_MSG_MULTI_CMNHMSG
+
+SUBROUTINE PRINT_MSG_MULTI(KVERB, HDOMAIN, HSUBR, HMSG)
+!
+USE print_control_mod, ONLY : lunout
+!
+!
+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=*), dimension(:), INTENT(IN) :: HMSG    !Message
+!
+CHARACTER(LEN=2)  :: YSZ
+CHARACTER(LEN=9)  :: YPRE
+CHARACTER(LEN=30) :: YSUBR
+CHARACTER(LEN=:), ALLOCATABLE :: YFORMAT
+INTEGER :: JI
+INTEGER :: ILINES
+!
+ILINES=SIZE(HMSG)
+
+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
+    WRITE(UNIT=lunout, FMT=*) 'ERROR: PRINT_MSG: wrong verbosity level'
+END SELECT
+!
+YSUBR=TRIM(HSUBR)//':'
+
+IF (ILINES==1) THEN
+  WRITE(UNIT=lunout, FMT="(A9,A30,A)") YPRE, YSUBR, TRIM(HMSG(1))
+ELSE
+ IF (ILINES<10) THEN
+    YSZ = 'I1'
+  ELSEIF (ILINES<100) THEN
+    YSZ = 'I2'
+  ELSEIF (ILINES<1000) THEN
+    YSZ = 'I3'
+  ELSE
+    YSZ = 'I4'
+  ENDIF
+  YFORMAT='(A9,A30,' // YSZ // ',''/'',' // YSZ // ','': '',A)'
+  DO JI=1, ILINES
+    WRITE(UNIT=lunout, FMT=YFORMAT) YPRE, YSUBR, JI, ILINES, TRIM(HMSG(JI))
+  ENDDO
+ENDIF
+!
+IF (KVERB<=N_ABORT_LEVEL) THEN
+  CALL ABOR1(TRIM(HMSG(ILINES))) !Last line repeated
+END IF
+!
+ENDSUBROUTINE PRINT_MSG_MULTI
+
+ENDMODULE MODE_MSG