lfildo.F90

Go to the documentation of this file.

! Oct-2012 P. Marguinaud 64b LFI
! Jan-2011 P. Marguinaud Thread-safe LFI
SUBROUTINE lfildo_fort                                           &
&                     (lfi, krep, knumer, krec, ktab, knblec,  &
&                      kfactm, ydfic, kretin)
USE lfimod, ONLY : lficom, lficrw
USE parkind1, ONLY : jprb, jpib, jpia, jpim
USE yomhook , ONLY : lhook, dr_hook
USE lfi_precision
IMPLICIT NONE
!****
!        Sous-programme charge des Lectures de DOnnees du logiciel LFI,
!     *SAUF* pour les articles d'index de type caractere.
!**
!     Arguments: KREP   (Sortie) ==> Code-reponse ( zero si OK; code-
!                                    reponse du "READ" FORTRAN sinon);
!                KNUMER (Entree) ==> NUMERo d'unite logique FORTRAN;
!                KREC   (Entree) ==> Numero d'enregistrement a lire;
!                KTAB   (Sortie) ==> Zone a lire, de Longueur
!                                    LFI%JPLARD*KFACTM *mots*;
!                KNBLEC (Entree  ==> Compteur de LECtures sur l'unite;
!                       +Sortie)
!                KFACTM (Entree) ==> FACteur Multiplicatif LFI de
!                                    l'unite logique;
!                KRETIN (Sortie) ==> Code-retour interne.
!
!
TYPE(lficom) :: LFI
INTEGER (KIND=JPLIKB) KREP, KNUMER, KREC, KNBLEC, KFACTM, KRETIN
type(lficrw)         ydfic
!
INTEGER (KIND=JPLIKB)  KTAB (lfi%jplard*kfactm)
INTEGER (KIND=JPIB)    IREP, ISIZE

!
!        LECTURE .
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('LFILDO_FORT',0,zhook_handle)

IF (knumer > 0) THEN
  READ (unit=knumer,rec=krec,err=901,iostat=krep) ktab
ELSE
  krep=0
  CALL lfisee (lfi, ydfic%N_C_FPDESC, ydfic%N_C_OFFSET, kfactm, krec, krep)
  IF (krep /= 0) GOTO 901
  isize = int(SIZE (ktab) * 8, jplikb)
  CALL fi_fread (irep, ktab, 1_jplikb, isize, ydfic%N_C_FPDESC)
  IF (irep /= isize) THEN
    krep = 1
    GOTO 901
  ENDIF
  ydfic%N_C_OFFSET = ydfic%N_C_OFFSET + isize
ENDIF

!IF (YDFIC%L_C_BTSWAP) CALL JSWAP (KTAB, KTAB, 8_JPLIKM, INT (SIZE (KTAB), JPLIKM))

IF (lfi%LMISOP) THEN
  WRITE (unit=lfi%NULOUT,fmt=*)                            &
&          '+++++ LFILDO - READ / ',knumer,', REC = ',krec, &
&          ' +++++'
ENDIF
!
knblec=knblec+1
kretin=0
GOTO 1001
!
901 CONTINUE
kretin=2
!
1001 CONTINUE
!
IF (lhook) CALL dr_hook('LFILDO_FORT',1,zhook_handle)
END SUBROUTINE lfildo_fort