lfinaf.F90

Go to the documentation of this file.

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

SUBROUTINE lfinaf_fort                                     &
&                     (lfi, krep, knumer, knaldo, kntrou,  &
&                      knares, knamax )
USE lfimod, ONLY : lficom
USE parkind1, ONLY : jprb
USE yomhook , ONLY : lhook, dr_hook
USE lfi_precision
IMPLICIT NONE
!****
!        SOUS-PROGRAMME DONNANT DES NOMBRES D'ARTICLES LOGIQUES DIVERS
!     ( DE DONNEES, "TROUS", POSSIBLE, MAXIMUM ) POUR UNE UNITE LOGIQUE
!     OUVERTE POUR LE LOGICIEL DE FICHIERS INDEXES *LFI* .
!**
!    ARGUMENTS : KREP   (SORTIE) ==> CODE-REPONSE DU SOUS-PROGRAMME;
!                KNUMER (ENTREE) ==> LFI%NUMERO DE L'UNITE LOGIQUE;
!                KNALDO (SORTIE) ==> NOMBRE D'ARTICLES LOGIQUES
!                                  *DE DONNEES* (TROUS EXCLUS) PRESENTS;
!                KNTROU (SORTIE) ==> NOMBRE D'ARTICLES LOGIQUES QUI SONT
!                                    DEVENUS DES "TROUS", PAR SUITE DE
!                                    REECRITURES D'ARTICLES PLUS LONGUES
!                                    QU'INITIALEMENT, ET QUI N'ONT PAS
!                                    PU ETRE (ENCORE) RECYCLES;
!                KNARES (SORTIE) ==> NOMBRE D'ARTICLES LOGIQUES POUVANT
!                                    ETRE ECRITS DANS LA PARTIE "PRERER-
!                                    VEE" DE L'INDEX (TROUS COMPRIS);
!                KNAMAX (SORTIE) ==> NOMBRE D'ARTICLES LOGIQUES MAXIMUM
!                                    POUVANT ETRE ECRITS SUR L'UNITE
!                                    LOGIQUE, EN "DEBORDANT" AU MAXIMUM
!                                   DE LA PARTIE PRERESERVEE DE L'INDEX.
!                                    ( TROUS COMPRIS )
!
!
TYPE(lficom) :: LFI
INTEGER (KIND=JPLIKB) KREP, KNUMER, KNALDO, KNTROU, KNARES, KNAMAX
INTEGER (KIND=JPLIKB) IRANG, IREP, IFACTM, ILARPH, INALPP, INIMES
!
CHARACTER(LEN=LFI%JPLSPX) CLNSPR
CHARACTER(LEN=LFI%JPLMES) CLMESS
CHARACTER(LEN=LFI%JPLFTX) CLACTI
LOGICAL LLFATA

!**
!     1.  -  CONTROLES DU PARAMETRE D'APPEL, PUIS INITIALISATIONS.
!-----------------------------------------------------------------------
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('LFINAF_FORT',0,zhook_handle)
clacti=''
CALL lfinum_fort                    &
&               (lfi, knumer,irang)
!
IF (irang.EQ.0) THEN
  kntrou=0
  knaldo=0
  knares=0
  knamax=0
  irep=-1
  GOTO 1001
ENDIF
!
 IF (lfi%LMULTI) CALL lfiver_fort                              &
&                                (lfi, lfi%VERRUE(irang),'ON')
!**
!     2.  -  CALCUL DIRECT DES ARGUMENTS DE SORTIE DU SOUS-PROGRAMME.
!-----------------------------------------------------------------------
!
ifactm=lfi%MFACTM(irang)
ilarph=lfi%JPLARD*ifactm
inalpp=lfi%JPNAPP*ifactm
kntrou=lfi%MDES1D(ixm(lfi%JPNTRU,irang))+lfi%NBTROU(irang)
knaldo=lfi%MDES1D(ixm(lfi%JPNALO,irang))-kntrou
knares=inalpp*lfi%MDES1D(ixm(lfi%JPNPIR,irang))
knamax=knares+inalpp*(ilarph-lfi%JPLDOC)
irep=0
!**
!    10.  -  PHASE TERMINALE : MESSAGERIE, AVEC "ABORT" EVENTUEL,
!            VIA LE SOUS-PROGRAMME "LFIEMS" .
!-----------------------------------------------------------------------
!
1001 CONTINUE
krep=irep
llfata=llmoer(irep,irang)
!
IF (irang.NE.0) THEN
  lfi%NDEROP(irang)=12
  lfi%NDERCO(irang)=irep
   IF (lfi%LMULTI) CALL lfiver_fort                               &
&                                  (lfi, lfi%VERRUE(irang),'OFF')
ENDIF
!
IF (llfata.OR.ixnims(irang).EQ.2) THEN
  inimes=2
ELSE
  IF (lhook) CALL dr_hook('LFINAF_FORT',1,zhook_handle)
  RETURN
ENDIF
!
clnspr='LFINAF'
WRITE (unit=clmess,fmt='(''KREP='',I4,'', KNUMER='',I3,             &
&       '', KNALDO='',I6,'', KNTROU='',I6,'', KNARES='',I6,         &
&       '', KNAMAX='',I6)') krep,knumer,knaldo,kntrou,knares,knamax
CALL lfiems_fort                                 &
&               (lfi, knumer,inimes,irep,llfata, &
&                clmess,clnspr,clacti)
!
IF (lhook) CALL dr_hook('LFINAF_FORT',1,zhook_handle)

CONTAINS

#include "lficom2.ixm.h"
#include "lficom2.ixnims.h"
#include "lficom2.llmoer.h"

END SUBROUTINE lfinaf_fort



! Oct-2012 P. Marguinaud 64b LFI
SUBROUTINE lfinaf64                                      &
&           (krep, knumer, knaldo, kntrou, knares, knamax)
USE lfimod, ONLY : lfi => lficom_default, &
&                  lficom_default_init,   &
&                  new_lfi_default
USE lfi_precision
IMPLICIT NONE
! Arguments
INTEGER (KIND=JPLIKB)  KREP                                   !   OUT
INTEGER (KIND=JPLIKB)  KNUMER                                 ! IN   
INTEGER (KIND=JPLIKB)  KNALDO                                 !   OUT
INTEGER (KIND=JPLIKB)  KNTROU                                 !   OUT
INTEGER (KIND=JPLIKB)  KNARES                                 !   OUT
INTEGER (KIND=JPLIKB)  KNAMAX                                 !   OUT

IF (.NOT. lficom_default_init) CALL new_lfi_default ()

CALL lfinaf_fort                                               &
&           (lfi, krep, knumer, knaldo, kntrou, knares, knamax)

END SUBROUTINE lfinaf64

SUBROUTINE lfinaf                                        &
&           (krep, knumer, knaldo, kntrou, knares, knamax)
USE lfimod, ONLY : lfi => lficom_default, &
&                  lficom_default_init,   &
&                  new_lfi_default
USE lfi_precision
IMPLICIT NONE
! Arguments
INTEGER (KIND=JPLIKM)  KREP                                   !   OUT
INTEGER (KIND=JPLIKM)  KNUMER                                 ! IN   
INTEGER (KIND=JPLIKM)  KNALDO                                 !   OUT
INTEGER (KIND=JPLIKM)  KNTROU                                 !   OUT
INTEGER (KIND=JPLIKM)  KNARES                                 !   OUT
INTEGER (KIND=JPLIKM)  KNAMAX                                 !   OUT

IF (.NOT. lficom_default_init) CALL new_lfi_default ()

CALL lfinaf_mt                                                &
&           (lfi, krep, knumer, knaldo, kntrou, knares, knamax)

END SUBROUTINE lfinaf

SUBROUTINE lfinaf_mt                                          &
&           (lfi, krep, knumer, knaldo, kntrou, knares, knamax)
USE lfimod, ONLY : lficom
USE lfi_precision
IMPLICIT NONE
! Arguments
type(lficom)          lfi                                    ! INOUT
INTEGER (KIND=JPLIKM)  KREP                                   !   OUT
INTEGER (KIND=JPLIKM)  KNUMER                                 ! IN   
INTEGER (KIND=JPLIKM)  KNALDO                                 !   OUT
INTEGER (KIND=JPLIKM)  KNTROU                                 !   OUT
INTEGER (KIND=JPLIKM)  KNARES                                 !   OUT
INTEGER (KIND=JPLIKM)  KNAMAX                                 !   OUT
! Local integers
INTEGER (KIND=JPLIKB)  IREP                                   !   OUT
INTEGER (KIND=JPLIKB)  INUMER                                 ! IN   
INTEGER (KIND=JPLIKB)  INALDO                                 !   OUT
INTEGER (KIND=JPLIKB)  INTROU                                 !   OUT
INTEGER (KIND=JPLIKB)  INARES                                 !   OUT
INTEGER (KIND=JPLIKB)  INAMAX                                 !   OUT
! Convert arguments

inumer     = int(    knumer, jplikb)

CALL lfinaf_fort                                               &
&           (lfi, irep, inumer, inaldo, introu, inares, inamax)

krep       = int(      irep, jplikm)
knaldo     = int(    inaldo, jplikm)
kntrou     = int(    introu, jplikm)
knares     = int(    inares, jplikm)
knamax     = int(    inamax, jplikm)

END SUBROUTINE lfinaf_mt

!INTF KREP            OUT 
!INTF KNUMER        IN    
!INTF KNALDO          OUT 
!INTF KNTROU          OUT 
!INTF KNARES          OUT 
!INTF KNAMAX          OUT