! $Id: $ MODULE print_control_mod INTEGER,SAVE :: lunout ! default output file identifier (6==screen) INTEGER,SAVE :: prt_level ! debug output level LOGICAL,SAVE :: debug ! flag to specify if in "debug mode" LOGICAL,SAVE :: alert_first_call = .TRUE. ! for printing alerts on first call to routine only LOGICAL,SAVE :: call_alert ! (combination of is_master and alert_first_call for easier use !$OMP THREADPRIVATE(lunout,prt_level,debug, alert_first_call, call_alert) ! NB: Module variable Initializations done by set_print_control ! routine from init_print_control_mod to avoid circular ! module dependencies CONTAINS SUBROUTINE set_print_control(lunout_,prt_level_,debug_) IMPLICIT NONE INTEGER, INTENT(IN) :: lunout_ INTEGER, INTENT(IN) :: prt_level_ LOGICAL, INTENT(IN) :: debug_ lunout = lunout_ prt_level = prt_level_ debug = debug_ END SUBROUTINE set_print_control SUBROUTINE prt_alerte(message, modname, niv_alerte) ! Function to print different values of alarms when first encountered ! Meant for informative purposee IMPLICIT NONE ! Arguments: ! message: message to print out ! modname: module/routine name ! niv_alerte: alert level (0/1/2) CHARACTER(LEN=*), INTENT(IN) :: modname CHARACTER(LEN=*) :: message INTEGER :: niv_alerte ! local variables CHARACTER(LEN=7), DIMENSION(0:2) :: alarm_color = (/ 'VERTE ','ORANGE ','ROUGE ' /) CHARACTER(LEN=7) :: alarm_couleur INTEGER :: alarm_file=15 ! in case we want/need to print out the special alarms in a separate file IF ( alert_first_call) then IF ( alarm_file .ne. lunout ) THEN OPEN(unit = alarm_file, file = "ALERTES.txt") ENDIF ENDIF alarm_couleur = alarm_color(niv_alerte) IF (niv_alerte < 0 .OR. niv_alerte > 3) then message = 'NIVEAU ALERTE INVALIDE '//message alarm_couleur='NOIRE ' ENDIF WRITE(alarm_file, *)' ALERTE ',alarm_couleur, trim(modname), trim(message) END SUBROUTINE prt_alerte END MODULE print_control_mod