fanerg.F90

Go to the documentation of this file.

! Oct-2012 P. Marguinaud 64b LFI
! Jan-2011 P. Marguinaud Thread-safe FA
SUBROUTINE fanerg_fort             &
&                     (fa,  knivau )
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'Erreur
!     Fatale du logiciel de Fichiers ARPEGE (*FA%NRFAGA*) a la valeur
!     KNIVAU, de meme que la variable correspondante du logiciel LFI.
!     Par defaut, FA%NRFAGA vaut 1.
!**
!        Argument : KNIVAU (Entree) ==> Niveau global d'erreur fatale.
!                                       Valeurs possibles:
!
!     0 : Rendre fatale toute erreur detectee, meme si elle correspond
!         a un fichier ouvert avec l'option "pas d'erreur fatale".
!     1 : Ne rend fatales que certaines erreurs "globales", c'est-a-dire
!         non reliables a un fichier ouvert, et les erreurs sur les fi-
!         chiers ouverts avec l'option "erreur fatale" (Mode par defaut)
!     2 : Passer outre toute erreur detectee, meme si elle correspond
!         a un fichier ouvert avec l'option "erreur fatale".
!         Neanmoins, le code-reponse eventuel ne sera pas zero.
!
!
!
TYPE(fa_com) :: FA
INTEGER (KIND=JPLIKB) KNIVAU
!
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('FANERG_MT',0,zhook_handle)
clacti=''
IF (fa%FANERG_LLPREA) THEN
  CALL farine_fort              &
&                 (fa, 2_jplikb )
  fa%FANERG_LLPREA=.false.
ENDIF
!
IF (knivau.GE.0.AND.knivau.LE.2) THEN
  fa%NRFAGA=knivau
  CALL lfineg_fort                &
&                 (fa%LFI, knivau)
  irep=0
ELSE
  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 (fa%NIMSGA.EQ.2) THEN
  inimes=2
ELSE
  IF (lhook) CALL dr_hook('FANERG_MT',1,zhook_handle)
  RETURN
ENDIF
!
inumer=jpniil
clnspr='FANERG'
!
IF (max(inimes,fa%NIMSGA).EQ.2) THEN
  WRITE (unit=clmess,                                  &
&         fmt='(''KNIVAU='',I5,'', CODE INTERNE='',I4)' &
&         ) knivau,irep
ENDIF
!
CALL faipar_fort                                     &
&               (fa, inumer,inimes,irep,llfata,clmess, &
&             clnspr,clacti,.false.)
!
IF (lhook) CALL dr_hook('FANERG_MT',1,zhook_handle)
END SUBROUTINE fanerg_fort



! Oct-2012 P. Marguinaud 64b LFI
SUBROUTINE fanerg64           &
&           (knivau)
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   

IF (.NOT. fa_com_default_init) CALL new_fa_default ()

CALL fanerg_fort           &
&           (fa, knivau)

END SUBROUTINE fanerg64

SUBROUTINE fanerg             &
&           (knivau)
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   

IF (.NOT. fa_com_default_init) CALL new_fa_default ()

CALL fanerg_mt             &
&           (fa, knivau)

END SUBROUTINE fanerg

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

inivau     = int(    knivau, jplikb)

CALL fanerg_fort           &
&           (fa, inivau)


END SUBROUTINE fanerg_mt

!INTF KNIVAU        IN