lfiems.F90

Go to the documentation of this file.

! Oct-2012 P. Marguinaud 64b LFI
! Jan-2011 P. Marguinaud Thread-safe LFI

SUBROUTINE lfiems_fort                                      &
&                     (lfi, knumer, knimes, kcode, ldfata,  &
&                      cdmess, cdnspr, cdacti )
USE lfimod, ONLY : lficom
USE parkind1, ONLY : jprb
USE yomhook , ONLY : lhook, dr_hook
USE lfi_precision
IMPLICIT NONE
!****
!        CE SOUS-PROGRAMME EST CHARGE DE FAIRE L'ECHO DES MESSAGES
!     EMIS PAR LE LOGICIEL DE FICHIERS INDEXES LFI, EN FAISANT SI
!     BESOIN EST L'"ABORT" DU PROGRAMME .
!        En l'occurrence, il s'agit d'un "chapeau" qui aiguille sur
!     LFIEFR ou LFIENG en fonction de la variable logique LFI%LFRANC.
!**
!        ARGUMENTS : KNUMER ==> Numero eventuel de l'Unite Logique;
!        ( tous                 ( si LFI%JPNIL ==> pas d'Unite Logique )
!         d'Entree ) KNIMES ==> Niveau (0,1,2) du Message;
!                    KCODE  ==> CODE CORRESPONDANT A L'ACTION;
!                    LDFATA ==> VRAI SI ON DOIT AVORTER LE PROGRAMME;
!                    CDMESS ==> SI KNIMES#0, MESSAGE A EMETTRE;
!                    CDNSPR ==> NOM DU SOUS-PROGRAMME APPELANT;
!                    CDACTI ==> NOM DE L'ACTION D'ENTREE/SORTIE FORTRAN
!                               (SI KCODE >0), SINON FOURRE-TOUT (!) .
!*
!        Pour la table des codes-reponses possibles, voir LFIEFR/LFIENG.
!
!
TYPE(lficom) :: LFI
INTEGER (KIND=JPLIKB) KNUMER, KNIMES, KCODE, ICODE, IREPON
!
LOGICAL LDFATA, LLEXUL
!
CHARACTER  CDNSPR*(*), CDMESS*(*), CDACTI*(*)

!**
!     1.  -  MODIFICATION EVENTUELLE DU CODE-REPONSE S'IL VAUT (-1).
!-----------------------------------------------------------------------
!*
!        Il s'agit en effet de discriminer entre un numero d'unite
!     logique licite pour le FORTRAN, mais effectivement non ouvert pour
!     le logiciel LFI, auquel cas le code-reponse est laisse a (-1),
!     et un numero d'unite logique FORTRAN carrement illicite, que l'on
!     traduit par le code-reponse (-30).
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('LFIEMS_FORT',0,zhook_handle)
IF (kcode.EQ.-1) THEN
  icode=-30
  IF (knumer > 0) THEN
    INQUIRE (unit=knumer,exist=llexul,err=101,iostat=irepon)
  ELSE
    llexul=.true.
  ENDIF
  IF (llexul) icode=kcode
ELSE
  icode=kcode
ENDIF
!
101 CONTINUE
!**
!     2.  -  APPEL AU SOUS-PROGRAMME AD HOC EN FONCTION DE *LFI%LFRANC*.
!-----------------------------------------------------------------------
!
IF (lfi%LFRANC) THEN
  CALL lfiefr_fort                                  &
&                 (lfi, knumer,knimes,icode,ldfata, &
&                  cdmess,cdnspr,cdacti)
ELSE
  CALL lfieng_fort                                  &
&                 (lfi, knumer,knimes,icode,ldfata, &
&                  cdmess,cdnspr,cdacti)
ENDIF
!
IF (lhook) CALL dr_hook('LFIEMS_FORT',1,zhook_handle)
END SUBROUTINE lfiems_fort



! Oct-2012 P. Marguinaud 64b LFI
SUBROUTINE lfiems64                                       &
&           (knumer, knimes, kcode, ldfata, cdmess, cdnspr, &
&           cdacti)
USE lfimod, ONLY : lfi => lficom_default, &
&                   lficom_default_init,   &
&                   new_lfi_default
USE lfi_precision
IMPLICIT NONE
! Arguments
INTEGER (KIND=JPLIKB)  KNUMER                                 ! IN   
INTEGER (KIND=JPLIKB)  KNIMES                                 ! IN   
INTEGER (KIND=JPLIKB)  KCODE                                  ! IN   
LOGICAL                LDFATA                                 ! IN   
CHARACTER (LEN=*)      CDMESS                                 ! IN   
CHARACTER (LEN=*)      CDNSPR                                 ! IN   
CHARACTER (LEN=*)      CDACTI                                 ! IN   

IF (.NOT. lficom_default_init) CALL new_lfi_default ()

CALL lfiems_fort                                               &
&           (lfi, knumer, knimes, kcode, ldfata, cdmess, cdnspr, &
&           cdacti)

END SUBROUTINE lfiems64

SUBROUTINE lfiems                                         &
&           (knumer, knimes, kcode, ldfata, cdmess, cdnspr, &
&           cdacti)
USE lfimod, ONLY : lfi => lficom_default, &
&                   lficom_default_init,   &
&                   new_lfi_default
USE lfi_precision
IMPLICIT NONE
! Arguments
INTEGER (KIND=JPLIKM)  KNUMER                                 ! IN   
INTEGER (KIND=JPLIKM)  KNIMES                                 ! IN   
INTEGER (KIND=JPLIKM)  KCODE                                  ! IN   
LOGICAL                LDFATA                                 ! IN   
CHARACTER (LEN=*)      CDMESS                                 ! IN   
CHARACTER (LEN=*)      CDNSPR                                 ! IN   
CHARACTER (LEN=*)      CDACTI                                 ! IN   

IF (.NOT. lficom_default_init) CALL new_lfi_default ()

CALL lfiems_mt                                                 &
&           (lfi, knumer, knimes, kcode, ldfata, cdmess, cdnspr, &
&           cdacti)

END SUBROUTINE lfiems

SUBROUTINE lfiems_mt                                           &
&           (lfi, knumer, knimes, kcode, ldfata, cdmess, cdnspr, &
&           cdacti)
USE lfimod, ONLY : lficom
USE lfi_precision
IMPLICIT NONE
! Arguments
type(lficom)          lfi                                    ! INOUT
INTEGER (KIND=JPLIKM)  KNUMER                                 ! IN   
INTEGER (KIND=JPLIKM)  KNIMES                                 ! IN   
INTEGER (KIND=JPLIKM)  KCODE                                  ! IN   
LOGICAL                LDFATA                                 ! IN   
CHARACTER (LEN=*)      CDMESS                                 ! IN   
CHARACTER (LEN=*)      CDNSPR                                 ! IN   
CHARACTER (LEN=*)      CDACTI                                 ! IN   
! Local integers
INTEGER (KIND=JPLIKB)  INUMER                                 ! IN   
INTEGER (KIND=JPLIKB)  INIMES                                 ! IN   
INTEGER (KIND=JPLIKB)  ICODE                                  ! IN   
! Convert arguments

inumer     = int(    knumer, jplikb)
inimes     = int(    knimes, jplikb)
icode      = int(     kcode, jplikb)

CALL lfiems_fort                                               &
&           (lfi, inumer, inimes, icode, ldfata, cdmess, cdnspr, &
&           cdacti)


END SUBROUTINE lfiems_mt

!INTF KNUMER        IN    
!INTF KNIMES        IN    
!INTF KCODE         IN    
!INTF LDFATA        IN    
!INTF CDMESS        IN    
!INTF CDNSPR        IN    
!INTF CDACTI        IN