lfichi.F90

Go to the documentation of this file.

! Oct-2012 P. Marguinaud 64b LFI
! Jan-2011 P. Marguinaud Thread-safe LFI
SUBROUTINE lfichi_fort                                   &
&                     (lfi, krep, cdstru, kval, kposc2 )
USE lfimod, ONLY : lficom
USE parkind1, ONLY : jprb
USE yomhook , ONLY : lhook, dr_hook
USE lfi_precision
IMPLICIT NONE
!****
!        SOUS-PROGRAMME *INTERNE* DU LOGICIEL DE FICHIERS INDEXES LFI;
!     permet de decoder une valeur entiere (CHIffres)
!     dans une chaine de caracteres.
!**
!    ARGUMENTS : KREP   (Sortie) ==> Code-Reponse du sous-programme;
!                CDSTRU (Entree) ==> Chaine a decoder;
!                KVAL   (Sortie) ==> Valeur entiere decodee;
!                KPOSC2 (Sortie) ==> Position du dernier chiffre.
!
TYPE(lficom) :: LFI
CHARACTER(LEN=*) CDSTRU
CHARACTER(LEN=7) CLFORM
!
INTEGER (KIND=JPLIKB) KREP, KVAL, KPOSC2
INTEGER (KIND=JPLIKB) ILUSTR, J, IPOSC1, IPOSC2

!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('LFICHI_FORT',0,zhook_handle)
krep=0
ilustr=int(len(cdstru), jplikb)
!
DO j=1,ilustr
!
IF (cdstru(j:j).NE.' ') THEN
!
  iposc1=int(index(lfi%LFICHI_CLCHIF,cdstru(j:j)), jplikb)
!
  IF (iposc1.EQ.0) THEN
    krep=-40
    GOTO 1001
  ENDIF
!
  iposc1=j
  GOTO 223
!
ENDIF
!
ENDDO
!
iposc1=1
!
223 CONTINUE
!
DO j=iposc1+1,ilustr
!
IF (int(index(lfi%LFICHI_CLCHIF,cdstru(j:j)), jplikb).EQ.0) THEN
  iposc2=j-1
  GOTO 225
ENDIF
!
ENDDO
!
iposc2=ilustr
!
225 CONTINUE
!
WRITE (unit=clform,fmt='(''(BN,I'',I1,'')'')') iposc2-iposc1+1
READ (unit=cdstru(iposc1:iposc2),fmt=clform,err=226) kval
kposc2=iposc2
GOTO 1001
!
226 CONTINUE
!
krep=-40
!
1001 CONTINUE
!
IF (lhook) CALL dr_hook('LFICHI_FORT',1,zhook_handle)
END SUBROUTINE lfichi_fort



! Oct-2012 P. Marguinaud 64b LFI
SUBROUTINE lfichi64                    &
&           (krep, cdstru, kval, kposc2)
USE lfimod, ONLY : lfi => lficom_default, &
&                   lficom_default_init,   &
&                   new_lfi_default
USE lfi_precision
IMPLICIT NONE
! Arguments
INTEGER (KIND=JPLIKB)  KREP                                   !   OUT
CHARACTER (LEN=*)      CDSTRU                                 ! IN   
INTEGER (KIND=JPLIKB)  KVAL                                   !   OUT
INTEGER (KIND=JPLIKB)  KPOSC2                                 !   OUT

IF (.NOT. lficom_default_init) CALL new_lfi_default ()

CALL lfichi_fort                            &
&           (lfi, krep, cdstru, kval, kposc2)

END SUBROUTINE lfichi64

SUBROUTINE lfichi                      &
&           (krep, cdstru, kval, kposc2)
USE lfimod, ONLY : lfi => lficom_default, &
&                   lficom_default_init,   &
&                   new_lfi_default
USE lfi_precision
IMPLICIT NONE
! Arguments
INTEGER (KIND=JPLIKM)  KREP                                   !   OUT
CHARACTER (LEN=*)      CDSTRU                                 ! IN   
INTEGER (KIND=JPLIKM)  KVAL                                   !   OUT
INTEGER (KIND=JPLIKM)  KPOSC2                                 !   OUT

IF (.NOT. lficom_default_init) CALL new_lfi_default ()

CALL lfichi_mt                              &
&           (lfi, krep, cdstru, kval, kposc2)

END SUBROUTINE lfichi

SUBROUTINE lfichi_mt                        &
&           (lfi, krep, cdstru, kval, kposc2)
USE lfimod, ONLY : lficom
USE lfi_precision
IMPLICIT NONE
! Arguments
type(lficom)          lfi                                    ! INOUT
INTEGER (KIND=JPLIKM)  KREP                                   !   OUT
CHARACTER (LEN=*)      CDSTRU                                 ! IN   
INTEGER (KIND=JPLIKM)  KVAL                                   !   OUT
INTEGER (KIND=JPLIKM)  KPOSC2                                 !   OUT
! Local integers
INTEGER (KIND=JPLIKB)  IREP                                   !   OUT
INTEGER (KIND=JPLIKB)  IVAL                                   !   OUT
INTEGER (KIND=JPLIKB)  IPOSC2                                 !   OUT
! Convert arguments


CALL lfichi_fort                            &
&           (lfi, irep, cdstru, ival, iposc2)

krep       = int(      irep, jplikm)
kval       = int(      ival, jplikm)
kposc2     = int(    iposc2, jplikm)

END SUBROUTINE lfichi_mt

!INTF KREP            OUT 
!INTF CDSTRU        IN    
!INTF KVAL            OUT 
!INTF KPOSC2          OUT