| 1 | ! $Id: $ |
|---|
| 2 | MODULE print_control_mod |
|---|
| 3 | |
|---|
| 4 | INTEGER,SAVE :: lunout ! default output file identifier (6==screen) |
|---|
| 5 | INTEGER,SAVE :: prt_level ! debug output level |
|---|
| 6 | LOGICAL,SAVE :: debug ! flag to specify if in "debug mode" |
|---|
| 7 | LOGICAL,SAVE :: alert_first_call = .TRUE. ! for printing alerts on first call to routine only |
|---|
| 8 | LOGICAL,SAVE :: call_alert ! (combination of is_master and alert_first_call for easier use |
|---|
| 9 | !$OMP THREADPRIVATE(lunout,prt_level,debug, alert_first_call, call_alert) |
|---|
| 10 | |
|---|
| 11 | ! NB: Module variable Initializations done by set_print_control |
|---|
| 12 | ! routine from init_print_control_mod to avoid circular |
|---|
| 13 | ! module dependencies |
|---|
| 14 | |
|---|
| 15 | CONTAINS |
|---|
| 16 | |
|---|
| 17 | SUBROUTINE set_print_control(lunout_,prt_level_,debug_) |
|---|
| 18 | IMPLICIT NONE |
|---|
| 19 | INTEGER, INTENT(IN) :: lunout_ |
|---|
| 20 | INTEGER, INTENT(IN) :: prt_level_ |
|---|
| 21 | LOGICAL, INTENT(IN) :: debug_ |
|---|
| 22 | |
|---|
| 23 | lunout = lunout_ |
|---|
| 24 | prt_level = prt_level_ |
|---|
| 25 | debug = debug_ |
|---|
| 26 | |
|---|
| 27 | END SUBROUTINE set_print_control |
|---|
| 28 | |
|---|
| 29 | SUBROUTINE prt_alerte(message, modname, niv_alerte) |
|---|
| 30 | ! Function to print different values of alarms when first encountered |
|---|
| 31 | ! Meant for informative purposee |
|---|
| 32 | IMPLICIT NONE |
|---|
| 33 | ! Arguments: |
|---|
| 34 | ! message: message to print out |
|---|
| 35 | ! modname: module/routine name |
|---|
| 36 | ! niv_alerte: alert level (0/1/2) |
|---|
| 37 | CHARACTER(LEN=*), INTENT(IN) :: modname |
|---|
| 38 | CHARACTER(LEN=*) :: message |
|---|
| 39 | INTEGER :: niv_alerte |
|---|
| 40 | ! local variables |
|---|
| 41 | CHARACTER(LEN=7), DIMENSION(0:2) :: alarm_color = (/ 'VERTE ','ORANGE ','ROUGE ' /) |
|---|
| 42 | CHARACTER(LEN=7) :: alarm_couleur |
|---|
| 43 | INTEGER :: alarm_file=15 ! in case we want/need to print out the special alarms in a separate file |
|---|
| 44 | |
|---|
| 45 | IF ( alert_first_call) then |
|---|
| 46 | IF ( alarm_file .ne. lunout ) THEN |
|---|
| 47 | OPEN(unit = alarm_file, file = "ALERTES.txt") |
|---|
| 48 | ENDIF |
|---|
| 49 | ENDIF |
|---|
| 50 | |
|---|
| 51 | alarm_couleur = alarm_color(niv_alerte) |
|---|
| 52 | IF (niv_alerte < 0 .OR. niv_alerte > 3) then |
|---|
| 53 | message = 'NIVEAU ALERTE INVALIDE '//message |
|---|
| 54 | alarm_couleur='NOIRE ' |
|---|
| 55 | ENDIF |
|---|
| 56 | |
|---|
| 57 | WRITE(alarm_file, *)' ALERTE ',alarm_couleur, trim(modname), trim(message) |
|---|
| 58 | |
|---|
| 59 | END SUBROUTINE prt_alerte |
|---|
| 60 | |
|---|
| 61 | |
|---|
| 62 | END MODULE print_control_mod |
|---|
