lfieng.F90

Go to the documentation of this file.

! Oct-2012 P. Marguinaud 64b LFI
! Jan-2011 P. Marguinaud Thread-safe LFI
SUBROUTINE lfieng_fort                                      &
&                     (lfi, knumer, knimes, kcode, ldfata,  &
&                      cdmess, cdnspr,cdacti )
USE lfimod, ONLY : lficom
USE parkind1, ONLY : jprb
USE yomhook , ONLY : lhook, dr_hook
USE sdl_mod   , ONLY : sdl_srlabort
USE lfi_precision
IMPLICIT NONE
!****
!        THIS SUBROUTINE PRINTS STANDARD MESSAGES FROM LFI INDEXED-
!     FILE SOFTWARE, ABORTING PROGRAM IF REQUIRED.
!        Messages related to "debugging mode" are directly printed
!     by concerned subroutines.
!
!        This subroutine is the english version, translated from the
!     the original (french) one, and is always called through the
!     "hat" routine LFIEMS.
!     For french version see subroutine LFIEFR.
!     ( Pour la version francaise, voir LFIEFR )
!**
!  DUMMY ARGUMENTS : KNUMER ==> Logical Unit concerned, if any;
!  ( all INPUT ones )           ( if LFI%JPNIL ==> no Logical Unit )
!                    KNIMES ==> Level (0,1,2) of Message;
!                    KCODE  ==> Response code of action concerned;
!                    LDFATA ==> True if Abort of program is required;
!                    CDMESS ==> If KNIMES#0, Message to print;
!                    CDNSPR ==> Subroutine name which calls LFIEMS;
!                    CDACTI ==> Name of FORTRAN input/output action
!                               if KCODE >0, else... it depends !
!*
!     !----------------------------------------------------------------!
!     !   TABLE OF POSSIBLE VALUES FOR RESPONSE CODES OF LFI SOFTWARE  !
!     !----------------------------------------------------------------!
!
!-----------------------------------------------------------------------
!      0 ==> No error has been detected, everything is OK.
!-----------------------------------------------------------------------
!positive==> It is the (absolute value of) FORTRAN response code
!  value     from an OPEN, READ, WRITE, CLOSE or INQUIRE instruction;
!            see vendor's reference manual for exact meaning.
!-----------------------------------------------------------------------
!     -1 ==> Logical Unit currently not opened for the software.
!-----------------------------------------------------------------------
!     -2 ==> "LEVEL" value outside [0-2] range .
!-----------------------------------------------------------------------
!     -3 ==> Bad lock option (internal subroutine "LFIVER") .
!-----------------------------------------------------------------------
!     -4 ==> Explicit change for Multi-Tasking mode, but almost one unit
!            is currently open-problems may arise (subroutine "LFIINI").
!-----------------------------------------------------------------------
!     -5 ==> Logical Unit is currently opened (LFIOUV, LFIAFM, LFISFM) .
!-----------------------------------------------------------------------
!     -6 ==> Not enough space within tables to open requested Unit.
!            (LFIOUV)
!-----------------------------------------------------------------------
!     -7 ==> Invalid "STATUS" for FORTRAN instruction "OPEN" (LFIOUV) .
!-----------------------------------------------------------------------
!     -8 ==> Incompatible values given for "LDNOMM" and "CDSTTO":
!            a file which "STATUS" is 'OLD' or 'NEW' must have a name .
!            (LFIOUV) (THIS REPONSE CODE HAS CURRENTLY NO MORE SENSE)
!-----------------------------------------------------------------------
!     -9 ==> Incompatibility between "STATUS" 'NEW' or 'OLD' and (respe-
!            ctively) file existence or non-existence (LFIOUV) .
!-----------------------------------------------------------------------
!    -10 ==> The file is not a LFI one, or may not be treated through
!            this configuration or version of the software (LFIOUV) .
!-----------------------------------------------------------------------
!    -11 ==> File not closed after a modification (LFIOUV): this
!            error is not fatal if "LDERFA" is .FALSE., but in such a
!            case file integrity and data coherence are not guaranteed.
!            Note that once a file has got such problem, this response
!            code will stay even after a subsequent modification.
!-----------------------------------------------------------------------
!    -12 ==> File has a "STATUS" 'OLD' but an error occurred when
!            reading the first physical record of file (LFIOUV) .
!-----------------------------------------------------------------------
!    -13 ==> File is already open for another LFI logical unit.
!            (LFIOUV)
!-----------------------------------------------------------------------
!    -14 ==> Incorrect value for INTEGER argument (generally negative) .
!-----------------------------------------------------------------------
!    -15 ==> Incorrect CHARACTER argument (too long, for instance).
!-----------------------------------------------------------------------
!    -16 ==> Incoherence in Tables, File, internal calls, software.
!            THIS ERROR MAY NEVER BE FILTERED. ALWAYS FATAL.
!-----------------------------------------------------------------------
!    -17 ==> Too many logical records to store an extra one (LFIECR) .
!            (note that logical records consist of user-readable data
!             records, but also of holes cataloged in index... which are
!             created when existing records may not be rewritten in
!             place, or when records are suppressed; such holes may be
!             "re-cycled")
!-----------------------------------------------------------------------
!    -18 ==> A logical record name formed only with SPACES is invalid.
!            (for internal use of LFI software, holes in index are
!             described by a blank record name)
!-----------------------------------------------------------------------
!    -19 ==> File opened with "STATUS" set to 'SCRATCH', so may not be
!            kept at CLOSE time: 'KEEP' is illicit for "CDSTTC" (LFIFER)
!            if this error is not fatal, then a FORTRAN "CLOSE" without
!            "STATUS" parameter is performed, in the same manner as if
!            "CDSTTC" is neither 'KEEP' nor 'DELETE'.
!-----------------------------------------------------------------------
!    -20 ==> No logical record with such name found within logical unit.
!            (LFILEC, LFIREN, LFISUP)
!-----------------------------------------------------------------------
!    -21 ==> Requested logical record is LONGER (has more data) in file;
!            if this error is not fatal, then a PARTIAL read is
!            performed, at requested length.
!            (LFILAP, LFILAS, LFILEC)
!-----------------------------------------------------------------------
!    -22 ==> Requested logical record SHORTER (has less data) in file;
!            even if this error is not fatal, NO READING OF DATA OCCURS.
!            (LFILAP, LFILAS, LFILEC) .
!-----------------------------------------------------------------------
!    -23 ==> No or no more "NEXT" record to read (LFILAS) .
!-----------------------------------------------------------------------
!    -24 ==> The character variable given as actual output argument is
!            TOO SHORT to store the record NAME, even when suppressing
!            any spaces at the end of the name.
!            (LFICAP, LFICAS, LFILAP, LFILAS)
!-----------------------------------------------------------------------
!    -25 ==> The new name of the logical record is (already) used for
!            another logical record within the file (LFIREN).
!-----------------------------------------------------------------------
!    -26 ==> No or no more "PREVIOUS" logical record to read (LFILAP).
!-----------------------------------------------------------------------
!    -27 ==> Insufficient CONTIGUOUS space within tables to treat the
!            "multiple" file requested (LFIOUV) .
!-----------------------------------------------------------------------
!    -28 ==> Multiply factor (of elementary physical record length) too
!            big for the current configuration of the software.
!            (LFIOUV, LFIAFM, LFIFMD)
!-----------------------------------------------------------------------
!    -29 ==> Not enough space within tables to store the multiply factor
!            to be associated to logical unit (LFIAFM) .
!-----------------------------------------------------------------------
!    -30 ==> Logical unit number invalid for FORTRAN.
!-----------------------------------------------------------------------
!    -31 ==> Logical unit has no multiply factor predefined.
!            (LFISFM)
!-----------------------------------------------------------------------
!
!
TYPE(lficom) :: LFI
INTEGER (KIND=JPLIKB) KNUMER, KNIMES, KCODE, ILDMES 
INTEGER (KIND=JPLIKB) ILBLAN, INLNOM, INUMER
INTEGER (KIND=JPLIKB) IDECBL, IPOSBL, ILACTI, ILACT2 
INTEGER (KIND=JPLIKB) ILNSPR, ILMESU, IJL, J, IJ
INTEGER (KIND=JPLIKB) INBALO, ILMESA, INLIGN, IDECAL
!
LOGICAL LDFATA
!
CHARACTER(LEN=*)  CDNSPR
CHARACTER(LEN=6)  CLJOLI
CHARACTER(LEN=*)  CDMESS
CHARACTER(LEN=80) CLMESA
CHARACTER(LEN=*)  CDACTI
!
CHARACTER(LEN=LFI%JPLMES) CLMESS

!**
!     1.  -  INITIALISATIONS.
!-----------------------------------------------------------------------
!
!        Search for "useful" length of argument CDACTI.
!        (i.e. not taking into account any blank characters at the end)
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('LFIENG_FORT',0,zhook_handle)
idecbl=0
!
101 CONTINUE
iposbl=idecbl+int(index(cdacti(idecbl+1:),' '), jplikb)
!
IF (iposbl.LE.idecbl) THEN
  ilacti=int(len(cdacti), jplikb)
ELSEIF (cdacti(iposbl:).EQ.' ') THEN
  ilacti=iposbl-1
ELSE
  idecbl=iposbl
  GOTO 101
ENDIF
!
ilact2=min(ilacti,lfi%JPNCPN)
ilacti=min(ilact2,8_jplikb )
ilnspr=min(int(len(cdnspr), jplikb),lfi%JPLSPX)
!
!        Prefix (and possible suffix) for the message(s).
!
IF (ldfata) THEN
  cljoli=' *****'
ELSEIF (knimes.EQ.0.OR.kcode.NE.0) THEN
  cljoli=' */*/*'
ELSE
  cljoli=' /////'
ENDIF
!
IF (knimes.NE.0) THEN
!**
!     2.  -  PRINTS MESSAGE PREPARED BY SUBROUTINE WHICH CALLED LFIEMS.
!-----------------------------------------------------------------------
!
  ilmesu=min(int(len(clmess), jplikb)-     &
&         int(len(cljoli), jplikb)-ilnspr-4, &
&         int(len(cdmess), jplikb))
  clmess=cljoli//' '//cdnspr(1:ilnspr)//' - ' &
&             //cdmess(1:ilmesu)
  WRITE (unit=lfi%NULOUT,fmt='(A)') trim(clmess)
ENDIF
!
IF (knimes.EQ.0.OR.ldfata) THEN
!**
!     3.  -  CONSTITUTION OF "AD HOC" MESSAGE, DEPENDING OF *KCODE*.
!-----------------------------------------------------------------------
!
!     Before, check if logical unit considered corresponds to a logical
!     unit currently opened for LFI software (or not).
!
  IF (knumer.EQ.lfi%JPNIL) THEN
    ijl=0
  ELSE
!
    DO j=1,lfi%NBFIOU
    ijl=lfi%NUMIND(j)
    IF (knumer.EQ.lfi%NUMERO(ijl)) GOTO 302
    ENDDO
!
    ijl=0
  ENDIF
!
302 CONTINUE
!
  IF (kcode.GT.0) THEN
!
    IF ((cdacti.EQ.'READ'.OR.cdacti.EQ.'WRITE') &
&        .AND.lfi%NUMAPH(ijl).GT.0) THEN
      WRITE (unit=clmess,fmt='(''ERROR "'',A,''"'',I7,    &
&             '',UNIT'',I3,'',REC.NUM'',I6,'',*'',I6,      &
&             '' WORDS'')') cdacti(1:ilacti),kcode,knumer, &
&                            lfi%NUMAPH(ijl),              &
&                            lfi%JPLARD*lfi%MFACTM(ijl)
    ELSE
      WRITE (unit=clmess,                                        &
&             fmt='(''FORTRAN "'',A,''" ERROR, CODE=''            &
&             ,I7,'', UNIT='',I3)') cdacti(1:ilacti),kcode,knumer
    ENDIF
!
  ELSEIF (kcode.EQ.-1) THEN
    WRITE (unit=clmess,fmt='(''LOGICAL UNIT'',I3,     &
&           '' NOT OPENED FOR LFI SOFTWARE'')') knumer
!
  ELSEIF (kcode.EQ.-2) THEN
!
    IF (knumer.EQ.lfi%JPNIL) THEN
      clmess='ACTUAL VALUE FOR LEVEL "KNIVAU" '// &
&                 'OUTSIDE [0-2] RANGE'
    ELSE
      WRITE (unit=clmess,fmt=                                 &
&   '(''MESSAGE LEVEL OUTSIDE [0-2] RANGE, UNIT'',I3)') knumer
    ENDIF
!
  ELSEIF (kcode.EQ.-3) THEN
    ildmes=min(8_jplikb ,int(len(cdmess), jplikb))
    clmess='UNKNOWN ACTION '''//cdmess(1:ildmes) &
&           //''' ON LOCKS'
!
  ELSEIF (kcode.EQ.-4) THEN
    clmess='EXPL.CHANGE OF MULTI-TASKING MODE '// &
&               'WITH UNIT(S) OPENED'
!
  ELSEIF (kcode.EQ.-5) THEN
    WRITE (unit=clmess,fmt='(''LOGICAL UNIT'',I3,                 &
&          '' ALREADY OPENED FOR LFI - AND SHOULD NOT.'')') knumer
!
  ELSEIF (kcode.EQ.-6) THEN
    WRITE (unit=clmess,fmt='(I3,'' ENTRIES,'',         &
&    '' NOT ENOUGH PLACE WITHIN TABLES FOR UNIT'',I3)') &
&    lfi%JPNXFI,knumer
!
  ELSEIF (kcode.EQ.-7) THEN
    WRITE (unit=clmess,fmt='(''FORTRAN STATUS'''''',A,          &
&           '''''' UNKNOWN, UNIT'',I3)') cdacti(1:ilacti),knumer
!
  ELSEIF (kcode.EQ.-8) THEN
    WRITE (unit=clmess,fmt='(''UNIT'',I3,'' OF STATUS ''''''      &
&,A,'''''' MUST HAVE AN EXPLICIT NAME'')') knumer,cdacti(1:ilacti)
!
  ELSEIF (kcode.EQ.-9) THEN
!
  IF (cdacti.EQ.'OLD') THEN
    WRITE (unit=clmess,fmt=                             &
&'(''STATUS ''''OLD'''' BUT FILE DOES NOT EXIST, UNIT'', &
&      I3)') knumer
  ELSE
    ilblan=int(index(cdacti(1:ilacti),' '), jplikb)
    IF (ilblan.GT.1) ilacti=ilblan-1
    WRITE (unit=clmess,fmt=                                 &
&'(''STATUS '''''',A,'''''' BUT FILE ALREADY EXISTS, UNIT'', &
&  I3)') cdacti(1:ilacti),knumer
  ENDIF
!
  ELSEIF (kcode.EQ.-10) THEN
    WRITE (unit=clmess,fmt='(''INCOMPATIBILITY'',  &
&           '' FILE / SOFTWARE, UNIT'',I3)') knumer
!
  ELSEIF (kcode.EQ.-11) THEN
    WRITE (unit=clmess,                              &
&           fmt='(''UNIT'',I3,'' NOT CLOSED AFTER '', &
&           ''ITS LAST MODIFICATION'')') knumer
!
  ELSEIF (kcode.EQ.-12) THEN
    WRITE (unit=clmess,fmt='(''UNIT'',I3,                     &
&  '' OF STATUS ''''OLD'''' - READ OF FIRST RECORD FAILED'')') &
&       knumer
!
  ELSEIF (kcode.EQ.-13) THEN
    inlnom=1
    inumer=lfi%JPNIL
!
    DO j=1,lfi%NBFIOU
    ij=lfi%NUMIND(j)
!
    IF (cdacti.EQ.lfi%CNOMFI(ij)) THEN
      inumer=lfi%NUMERO(ij)
      inlnom=min(lfi%NLNOMF(ij),                       &
&                  int(len(clmess), jplikb)-3_jplikb )
      GOTO 132
    ENDIF
!
    ENDDO
!
132 CONTINUE
    clmess=' '''//cdacti(1:inlnom)//''''
    WRITE (unit=lfi%NULOUT,fmt='(A)') trim(clmess)
    WRITE (unit=clmess,fmt='(''UNIT'',I3,'' - FILE '',    &
&           ''ALREADY OPEN WITH UNIT'',I3)') knumer,inumer
!
  ELSEIF (kcode.EQ.-14) THEN
!
    IF (cdnspr.EQ.'LFIECR'.OR.cdnspr.EQ.'LFILEC'.OR.   &
&        cdnspr.EQ.'LFILAS'.OR.cdnspr.EQ.'LFILAP') THEN
      WRITE (unit=clmess,fmt=                       &
&   '(''INCORRECT RECORD LENGTH, UNIT'',I3)') knumer
    ELSEIF (knumer.EQ.lfi%JPNIL) THEN
      clmess='INCORRECT ENTRY IN *LFI%NUMERO* TABLE'
    ELSE
      WRITE (unit=clmess,fmt=                               &
&   '(''INCORRECT INTEGER TYPE ARGUMENT, UNIT'',I3)') knumer
    ENDIF
!
  ELSEIF (kcode.EQ.-15) THEN
    WRITE (unit=clmess,fmt='(''RECORD NAME INCORRECT OR '', &
&           ''TOO LONG, UNIT'',I3)') knumer
!
  ELSEIF (kcode.EQ.-16) THEN
    WRITE (unit=clmess,fmt='(''INCOHERENCE (TABLES, FILE, '', &
&           ''INTERNAL CALLS, SOFTWARE), UNIT'',I3)') knumer
!
  ELSEIF (kcode.EQ.-17) THEN
!
    IF (ijl.NE.0) THEN
      inbalo=lfi%MDES1D(ixm(lfi%JPNALO,ijl))
    ELSE
      inbalo=lfi%JPNIL
    ENDIF
!
    WRITE (unit=clmess,                             &
&           fmt='(I6,'' RECORDS, INDEX FULL, UNIT'', &
&           I3)') inbalo,knumer
!
  ELSEIF (kcode.EQ.-18) THEN
    WRITE (unit=clmess,fmt='(''BLANK RECORD NAME IS INVALID'', &
&           '', UNIT'',I3)') knumer
!
  ELSEIF (kcode.EQ.-19) THEN
    WRITE (unit=clmess,fmt='(''UNIT'',I3,                        &
&           '' IS ''''SCRATCH'''', SO MAY NOT BE KEPT'')') knumer
!
  ELSEIF (kcode.EQ.-20) THEN
    WRITE (unit=clmess,fmt='(''RECORD "'',A,                   &
&           ''" NOT FOUND, UNIT'',I3)') cdacti(1:ilact2),knumer
!
  ELSEIF (kcode.EQ.-21) THEN
    WRITE (unit=clmess,fmt='(''RECORD "'',A,  &
&    ''" *LONGER* THAN REQUESTED, UNIT'',I3)') &
&      cdacti(1:ilact2),knumer
!
  ELSEIF (kcode.EQ.-22) THEN
    WRITE (unit=clmess,fmt='(''RECORD "'',A,  &
&    ''" *SHORTER* THAN REQUESTED-UNIT'',I3)') &
&      cdacti(1:ilact2),knumer
!
  ELSEIF (kcode.EQ.-23) THEN
    WRITE (unit=clmess,fmt='(''NO/NO MORE NEXT RECORD'', &
&    '' TO READ, UNIT'',I3)') knumer
!
  ELSEIF (kcode.EQ.-24) THEN
    WRITE (unit=clmess,fmt='(''CHARAC. VARIABLE TOO SHORT '', &
&    ''FOR "'',A,''", UNIT'',I3)')                             &
&      cdacti(1:ilact2),knumer
!
  ELSEIF (kcode.EQ.-25) THEN
    WRITE (unit=clmess,fmt='(''NEW RECORD NAME: "'',A, &
&    ''" ALREADY USED, UNIT'',I3)')                     &
&      cdacti(1:ilact2),knumer
!
  ELSEIF (kcode.EQ.-26) THEN
    WRITE (unit=clmess,fmt='(''NO/NO MORE PREVIOUS RECORD '', &
&    '' TO READ, UNIT'',I3)') knumer
!
  ELSEIF (kcode.EQ.-27) THEN
    WRITE (unit=clmess,                                &
&           fmt='(''INSUFFICIENT CONTIGUOUS SPACE WI'', &
&    ''THIN TABLES, UNIT'',I3)') knumer
!
  ELSEIF (kcode.EQ.-28) THEN
!
    IF (knumer.EQ.lfi%JPNIL) THEN
      WRITE (unit=clmess,                              &
&             fmt='(''NEW DEFAULT MULTIPLY FACTOR EX'', &
&      ''CEEDS MAXIMUM ('',I3,'')'')') lfi%JPFACX
    ELSE
      WRITE (unit=clmess,fmt='(''SPECIFIED MULTIPLY FACTOR '',     &
&      ''EXCEEDS MAXIMUM ('',I3,''), UNIT'',I3)') lfi%JPFACX,knumer
    ENDIF
!
  ELSEIF (kcode.EQ.-29) THEN
    WRITE (unit=clmess,fmt='(I3,'' ENTRIES,'',         &
&    '' NO MORE PLACE FOR MULTIPLY FACTOR, UNIT'',I3)') &
&    lfi%JPXUFM,knumer
!
  ELSEIF (kcode.EQ.-30) THEN
    WRITE (unit=clmess,fmt='(''INVALID FORTRAN LOGICAL UNIT'', &
&           '' NUMBER:'',I8)') knumer
!
  ELSEIF (kcode.EQ.-31) THEN
    WRITE (unit=clmess,fmt='(''LOGICAL UNIT NUMBER'',I3, &
&       '' HAS NO PREDEFINED MULTIPLY FACTOR'')') knumer
!
!                  For unexpected error codes...
!
  ELSEIF (knumer.EQ.lfi%JPNIL) THEN
    WRITE (unit=clmess,fmt='(''*UNKNOWN* GLOBAL ERROR CODE'', &
&                             I6)') kcode
  ELSE
    WRITE (unit=clmess,fmt='(''*UNKNOWN* ERROR CODE'',I6, &
&           '' ON LOGICAL UNIT'',I3)') kcode,knumer
  ENDIF
!
  ilmesa=int(len(clmesa), jplikb)
  ilmesu=ilmesa-1-2*int(len(cljoli), jplikb)-ilnspr-4
  clmesa=cljoli//' '//cdnspr(1:ilnspr)//' - '// &
&         clmess(1:ilmesu)//cljoli
  WRITE (unit=lfi%NULOUT,fmt='(A)') clmesa
!
!           If logical unit corresponds to a LFI logical unit
!     already opened, its name is printed.
!
  IF (ijl.NE.0) THEN
!
    IF (lfi%NLNOMF(ijl).LE.lfi%JPLFTX) THEN
      WRITE (unit=lfi%NULOUT,fmt='(A,/)') cljoli            &
&             //' NAME - APPEARENT BUT'                      &
&             //' COMPLETE - OF LFI LOGICAL UNIT CONCERNED:'
    ELSE
      WRITE (unit=clmess,fmt='(A,                          &
&             '' NAME - APPEARENT, AND TRUNCATED BY'',I4,   &
&       '' CARACTERES - OF LFI LOGICAL UNIT CONCERNED:'')') &
&      cljoli,lfi%NLNOMF(ijl)-lfi%JPLFTX
      WRITE (unit=lfi%NULOUT,fmt='(A,/)') trim(clmess)
    ENDIF
!
    inlign=(lfi%NLNOMF(ijl)-1)/lfi%JPLFIX
    idecal=0
!
    DO j=1,inlign
    WRITE (unit=lfi%NULOUT,fmt='(A)')                         &
&           lfi%CNOMFI(ijl)(idecal+1:idecal+lfi%JPLFIX)//'...'
    idecal=idecal+lfi%JPLFIX
    ENDDO
!
    IF (lfi%NLNOMF(ijl).LE.lfi%JPLFTX) THEN
      WRITE (unit=lfi%NULOUT,fmt='(A,/)')              &
&             lfi%CNOMFI(ijl)(idecal+1:lfi%NLNOMF(ijl))
    ELSE
      WRITE (unit=lfi%NULOUT,fmt='(A,/)')         &
&             lfi%CNOMFI(ijl)(idecal+1:lfi%JPLFTX) &
&             //'...'
    ENDIF
!
    IF (lfi%CNOMSY(ijl).NE.lfi%CNOMFI(ijl)) THEN
      WRITE (unit=lfi%NULOUT,fmt='(A,/)') cljoli//           &
& ' *SYSTEM* NAME (APPEARENT) OF LFI LOGICAL UNIT CONCERNED:'
      inlign=(lfi%NLNOMS(ijl)-1)/lfi%JPLFIX
      idecal=0
!
      DO j=1,inlign
      WRITE (unit=lfi%NULOUT,fmt='(A)')                         &
&             lfi%CNOMSY(ijl)(idecal+1:idecal+lfi%JPLFIX)//'...'
      idecal=idecal+lfi%JPLFIX
      ENDDO
!
      WRITE (unit=lfi%NULOUT,fmt='(A,/)')              &
&             lfi%CNOMSY(ijl)(idecal+1:lfi%NLNOMS(ijl))
    ENDIF
!
  ENDIF
!
  WRITE (unit=lfi%NULOUT,fmt='(A)') clmesa
  IF (ldfata.AND.kcode.NE.0) THEN
!
!            Aborts program.
!
    CALL sdl_srlabort
  ENDIF
!
ENDIF
!
IF (lhook) CALL dr_hook('LFIENG_FORT',1,zhook_handle)

CONTAINS

#include "lficom2.ixm.h"

END SUBROUTINE lfieng_fort



! Oct-2012 P. Marguinaud 64b LFI
SUBROUTINE lfieng64                                       &
&           (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 lfieng_fort                                               &
&           (lfi, knumer, knimes, kcode, ldfata, cdmess, cdnspr, &
&           cdacti)

END SUBROUTINE lfieng64

SUBROUTINE lfieng                                         &
&           (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 lfieng_mt                                                 &
&           (lfi, knumer, knimes, kcode, ldfata, cdmess, cdnspr, &
&           cdacti)

END SUBROUTINE lfieng

SUBROUTINE lfieng_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 lfieng_fort                                               &
&           (lfi, inumer, inimes, icode, ldfata, cdmess, cdnspr, &
&           cdacti)


END SUBROUTINE lfieng_mt

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