fanmsg.F90

Go to the documentation of this file.

! Oct-2012 P. Marguinaud 64b LFI
! Jan-2011 P. Marguinaud Thread-safe FA
! R. El Khatib 30-Mar-2012 KULOUT
SUBROUTINE fanmsg_fort                    &
&                     (fa,  knivau, kulout)
USE fa_mod, ONLY : fa_com, jpniil
USE parkind1, ONLY : jprb
USE yomhook , ONLY : lhook, dr_hook
USE lfi_precision
IMPLICIT NONE
!****
!        Ce sous-programme se charge de mettre le Niveau Global d'
!     impression des Messages du logiciel de Fichiers ARPEGE (*FA%NIMSGA*)
!     a la valeur KNIVAU, de meme que la variable correspondante du
!     du logiciel LFI. Par defaut, FA%NIMSGA vaut 1.
!**
!        Argument : KNIVAU (Entree) ==> Niveau Global d'Impression
!                                       des Messages.
!                                       Valeurs possibles:
!
!     0 : N'emettre que les messages d'erreurs reellement importants .
!     1 : N'emettre qu'un minimum de messages "globaux", et les messages
!         lies a un fichier ouvert qui sont de niveau au plus egal au
!         niveau de la messagerie pour ce fichier (Mode par defaut) .
!     2 : Emettre tous les messages possibles, meme s'ils ne correspon-
!         dent pas a un fichier ouvert avec le niveau de Messagerie 2 .
!
!                   KULOUT : logical unit number for printing
!
!
!
TYPE(fa_com) :: FA
INTEGER (KIND=JPLIKB) KNIVAU
INTEGER (KIND=JPLIKB) KULOUT
!
INTEGER (KIND=JPLIKB) IREP, INIMES, INUMER
CHARACTER(LEN=FA%JPXNOM) CLACTI 
CHARACTER(LEN=FA%JPLMES) CLMESS 
CHARACTER(LEN=FA%JPLSPX) CLNSPR
LOGICAL                  LLFATA

!
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE

IF (lhook) CALL dr_hook('FANMSG_MT',0,zhook_handle)
clacti=''

IF (fa%FANMSG_LLPREA) THEN
  CALL farine_fort              &
&                 (fa, 2_jplikb )
  fa%FANMSG_LLPREA=.false.
ENDIF
!
IF (knivau.GE.0.AND.knivau.LE.2) THEN
  inimes=max(fa%NIMSGA,knivau)
  fa%NIMSGA=knivau
  CALL lfinmg_fort                       &
&                 (fa%LFI, knivau,kulout)
  irep=0
ELSE
  inimes=fa%NIMSGA
  irep=-52
ENDIF
!
llfata=irep.NE.0.AND.fa%NRFAGA.NE.2
!
IF (llfata) THEN
  inimes=2
ELSEIF (irep.NE.0) THEN
  inimes=0
ELSEIF (inimes.NE.2) THEN
  IF (lhook) CALL dr_hook('FANMSG_MT',1,zhook_handle)
  RETURN
ENDIF
!
inumer=jpniil
clnspr='FANMSG'
!
IF (max(inimes,fa%NIMSGA).EQ.2) THEN
  WRITE (unit=clmess,                                  &
&         fmt='(''KNIVAU='',I5,'', CODE INTERNE='',I4)' &
&         ) knivau,irep
  IF (inimes.NE.2) CALL faipar_fort                          &
&                                  (fa, inumer,fa%NIMSGA,irep, &
&                                .false.,clmess,               &
&                                clnspr,clacti,.false.)
ENDIF
!
CALL faipar_fort                                     &
&               (fa, inumer,inimes,irep,llfata,clmess, &
&             clnspr,clacti,                           &
&             .false.)
!
IF (lhook) CALL dr_hook('FANMSG_MT',1,zhook_handle)
END SUBROUTINE fanmsg_fort


! Oct-2012 P. Marguinaud 64b LFI
SUBROUTINE fanmsg64           &
&           (knivau, kulout)
USE fa_mod, ONLY : fa => fa_com_default, &
&                   fa_com_default_init,  &
&                   new_fa_default
USE lfi_precision
IMPLICIT NONE
! Arguments
INTEGER (KIND=JPLIKB)  KNIVAU                                 ! IN   
INTEGER (KIND=JPLIKB)  KULOUT                                 ! IN   

IF (.NOT. fa_com_default_init) CALL new_fa_default ()

CALL fanmsg_fort               &
&           (fa, knivau, kulout)

END SUBROUTINE fanmsg64

SUBROUTINE fanmsg             &
&           (knivau, kulout)
USE fa_mod, ONLY : fa => fa_com_default, &
&                   fa_com_default_init,  &
&                   new_fa_default
USE lfi_precision
IMPLICIT NONE
! Arguments
INTEGER (KIND=JPLIKM)  KNIVAU                                 ! IN   
INTEGER (KIND=JPLIKM)  KULOUT                                 ! IN   

IF (.NOT. fa_com_default_init) CALL new_fa_default ()

CALL fanmsg_mt                 &
&           (fa, knivau, kulout)

END SUBROUTINE fanmsg

SUBROUTINE fanmsg_mt             &
&           (fa, knivau, kulout)
USE fa_mod, ONLY : fa_com
USE lfi_precision
IMPLICIT NONE
! Arguments
type(fa_com)          fa                                     ! INOUT
INTEGER (KIND=JPLIKM)  KNIVAU                                 ! IN   
INTEGER (KIND=JPLIKM)  KULOUT                                 ! IN   
! Local integers
INTEGER (KIND=JPLIKB)  INIVAU                                 ! IN   
INTEGER (KIND=JPLIKB)  IULOUT                                 ! IN   
! Convert arguments

inivau     = int(    knivau, jplikb)
iulout     = int(    kulout, jplikb)

CALL fanmsg_fort               &
&           (fa, inivau, iulout)


END SUBROUTINE fanmsg_mt

!INTF KNIVAU        IN    
!INTF KULOUT        IN