lfifmp.F90

Go to the documentation of this file.

! Oct-2012 P. Marguinaud 64b LFI
! Jan-2011 P. Marguinaud Thread-safe LFI
SUBROUTINE lfifmp_fort                       &
&                     (lfi, knumer, kranfm )
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.
!     Calcule le rang de l'unite logique *KNUMER* dans la table des
!     Unites Logiques a Facteur Multiplicatif predefini;
!     si l'Unite Logique n'y est pas trouvee, le resultat est ZERO.
!
!        En mode Multi-Taches, il est necessaire de verrouiller
!     Globalement le code faisant appel a ce sous-programme.
!**
!       ARGUMENTS : KNUMER (Entree) ==> Numero d'unite logique cherche;
!                   KRANFM (Sortie) ==> Rang dans la table des unites
!                                       logiques a Facteur Multiplicatif
!                                       predefini (0 si pas trouve).
!
!
TYPE(lficom) :: LFI
INTEGER (KIND=JPLIKB) KNUMER, KRANFM, J, IRANFM

!**
!     1.  -  RECHERCHE DIRECTE DANS LA TABLE *LFI%MULOFM*.
!-----------------------------------------------------------------------
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('LFIFMP_FORT',0,zhook_handle)
DO j=1,lfi%NULOFM
!
IF (knumer.EQ.lfi%MULOFM(j)) THEN
  iranfm=j
  GOTO 102
ENDIF
!
ENDDO
!
iranfm=0
!
102 CONTINUE
kranfm=iranfm
!
IF (lhook) CALL dr_hook('LFIFMP_FORT',1,zhook_handle)
END SUBROUTINE lfifmp_fort



! Oct-2012 P. Marguinaud 64b LFI
SUBROUTINE lfifmp64           &
&           (knumer, kranfm)
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)  KRANFM                                 !   OUT

IF (.NOT. lficom_default_init) CALL new_lfi_default ()

CALL lfifmp_fort                &
&           (lfi, knumer, kranfm)

END SUBROUTINE lfifmp64

SUBROUTINE lfifmp             &
&           (knumer, kranfm)
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)  KRANFM                                 !   OUT

IF (.NOT. lficom_default_init) CALL new_lfi_default ()

CALL lfifmp_mt                  &
&           (lfi, knumer, kranfm)

END SUBROUTINE lfifmp

SUBROUTINE lfifmp_mt             &
&           (lfi, knumer, kranfm)
USE lfimod, ONLY : lficom
USE lfi_precision
IMPLICIT NONE
! Arguments
type(lficom)          lfi                                    ! INOUT
INTEGER (KIND=JPLIKM)  KNUMER                                 ! IN   
INTEGER (KIND=JPLIKM)  KRANFM                                 !   OUT
! Local integers
INTEGER (KIND=JPLIKB)  INUMER                                 ! IN   
INTEGER (KIND=JPLIKB)  IRANFM                                 !   OUT
! Convert arguments

inumer     = int(    knumer, jplikb)

CALL lfifmp_fort                &
&           (lfi, inumer, iranfm)

kranfm     = int(    iranfm, jplikm)

END SUBROUTINE lfifmp_mt

!INTF KNUMER        IN    
!INTF KRANFM          OUT