lfiini.F90

Go to the documentation of this file.

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

SUBROUTINE lfiini_fort               &
&                     (lfi, koptio )
USE lfimod, ONLY : lficom
USE parkind1, ONLY : jprb
USE yomhook , ONLY : lhook, dr_hook
USE lfi_precision
IMPLICIT NONE
!****
!        CE SOUS-PROGRAMME EST CHARGE DES INITIALISATIONS DU LOGICIEL
!     DE FICHIERS INDEXES LFI .
!**
!        ARGUMENT : KOPTIO  ==> OPTION CONCERNANT LE MODE D'UTILISATION.
!                  (ENTREE)     (MULTI-TACHE OU NON)
!     VALEURS POSSIBLES : 0 ==> MODE MONO-TACHE PRESCRIT
!                         1 ==> MODE MULTI-TACHE PRESCRIT
!                         2 ==> UTILISATION DU MODE PAR DEFAUT SI C'EST
!                               LE PREMIER APPEL; SINON ON GARDE LE MODE
!                               PRESCRIT ANTERIEUREMENT .
!
!
TYPE(lficom) :: LFI
INTEGER (KIND=JPLIKB) KOPTIO, JNPAGE, J, JRANG, IREP 
INTEGER (KIND=JPLIKB) INIMES, INUMER, IRGPIM
!
LOGICAL LLNMUL, LLASGN, LLREL
CHARACTER(LEN=LFI%JPLSPX) CLNSPR
CHARACTER(LEN=LFI%JPLMES) CLMESS
CHARACTER(LEN=LFI%JPLFTX) CLACTI
LOGICAL LLFATA

!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('LFIINI_FORT',0,zhook_handle)
clacti=''
IF (lfi%LFIINI_LLPREA) THEN
!
!         C'EST LE PREMIER APPEL AU SOUS-PROGRAMME - INITIALISATIONS .
!
  lfi%NBFIOU=0
  lfi%NFACTM=0
  lfi%NULOFM=0
  lfi%NUIMEX=0
  lfi%NERFAG=1
  lfi%NISTAG=1
  lfi%NIMESG=1
  lfi%NPISAF=0
  lfi%LTAMLG=.false.
  lfi%LTAMEG=.true.
  lfi%LMISOP=.false.
  lfi%LFRANC=.true.
  lfi%LERFAT(0)=.true.
  lfi%NIVMES(0)=0
!
!          L'indice zero dans LFI%MFACTU correspond au facteur multiplicatif
!     "par defaut" .
!
#ifdef HIGHRES
  lfi%MFACTU(0)=6
#else
  lfi%MFACTU(0)=1
#endif
  lfi%MFACTM(0)=0
  lfi%NUMAPH(0)=lfi%JPNIL
!
  lfi%CFGMXD(0)='locale'
  lfi%NBMOSD(0)=lfi%JPNBIM
  lfi%NBCASD(0)=lfi%JPNBIC
  lfi%CFGMXD(1)='ieee'
  lfi%NBMOSD(1)=32
  lfi%NBCASD(1)=8
  lfi%CFGMXD(2)='ultrix'
  lfi%NBMOSD(2)=32
  lfi%NBCASD(2)=8
  lfi%CFGMXD(3)='ieee_dp'
  lfi%NBMOSD(3)=64
  lfi%NBCASD(3)=8
  lfi%CFGMXD(4)='ultrix_dp'
  lfi%NBMOSD(4)=64
  lfi%NBCASD(4)=8
  lfi%CTYPMX='ircdl'
!
  DO jnpage=1,lfi%JPNXPI
  lfi%MCOPIF(jnpage)=lfi%JPNIL
  lfi%MRGPIF(jnpage)=lfi%JPNIL
  lfi%LECRPI(jnpage,1)=.false.
  lfi%LECRPI(jnpage,2)=.false.
  ENDDO
!
  DO j=1,lfi%JPNPIA
!
  DO jrang=1,lfi%JPNXFI
  irgpim=jrang+(j-1)*lfi%JPNXFI
  lfi%MCOPIF(irgpim)=jrang
  lfi%MRGPIM(j,jrang)=irgpim
  ENDDO
!
  ENDDO
!
  DO jrang=1,lfi%JPNXFI
  lfi%MRGPIF(jrang)=1
  lfi%NUMERO(jrang)=lfi%JPNIL
  lfi%NUMAPH(jrang)=lfi%JPNIL
  ENDDO
!
  DO j=1,lfi%JPNCPN
  lfi%CHINCO(j:j)='?'
  ENDDO
!
  DO j=1,lfi%JPIMEX
  lfi%MNUIEX(j)=lfi%JPNIL
  lfi%NREXPL(0,j)=0
  ENDDO
!
  lfi%LFIINI_LLPREA=.false.
  llnmul=(koptio.EQ.1).OR.(koptio.EQ.2.AND.lfi%LFIINI_LLDEFM)
  llasgn=llnmul
  llrel=.false.
!
ELSEIF (koptio.EQ.2) THEN
!
!         CE N'EST PAS LE PREMIER APPEL, MAIS COMME L'ARGUMENT VAUT 2,
!         ON LAISSE LES CHOSES EN PLACE .
!
  llnmul=lfi%LMULTI
  llasgn=.false.
  llrel =.false.
ELSE
!
!     CE N'EST PAS LE PREMIER APPEL ET LE MODE EST PASSE 'EXPLICITEMENT'
!
  llnmul=koptio.EQ.1
  llasgn=llnmul.AND.(.NOT.lfi%LMULTI)
  llrel =(.NOT.llnmul).AND.lfi%LMULTI
!
  IF ((llasgn.OR.llrel).AND.lfi%NBFIOU.NE.0) THEN
    irep=-4
    GOTO 1001
  ENDIF
!
ENDIF
!
lfi%LMULTI=llnmul
!
!        Le controle de coherence ci-dessous ne peut etre fait qu'apres
!     l'initialisation eventuelle des variables globales du logiciel.
!
IF (koptio.LT.0.OR.koptio.GT.2) THEN
  irep=-2
  GOTO 1001
ENDIF
!
irep=0
!
IF (llasgn) THEN
  CALL lfiver_fort                         &
&                 (lfi, lfi%VERGLA,'ASGN')
ELSEIF (llrel) THEN
  CALL lfiver_fort                        &
&                 (lfi, lfi%VERGLA,'REL')
ENDIF
!
1001 CONTINUE
!
!        MESSAGERIE EVENTUELLE, AVEC ABORT SI NECESSAIRE .
!
llfata=irep.NE.0.AND.lfi%NERFAG.NE.2
!
IF (llfata) THEN
  inimes=2
ELSEIF (irep.NE.0) THEN
  inimes=0
ELSEIF (lfi%NIMESG.EQ.2.OR.(lfi%NIMESG.EQ.1.AND.koptio.NE.2)) THEN
  inimes=lfi%NIMESG
ELSE
  IF (lhook) CALL dr_hook('LFIINI_FORT',1,zhook_handle)
  RETURN
ENDIF
!
clnspr='LFIINI'
inumer=lfi%JPNIL
!
IF (max(inimes,lfi%NIMESG).EQ.2) THEN
!
  IF (lfi%LFRANC) THEN
    WRITE (unit=clmess,                              &
&           fmt='(''KOPTIO='',I5,'', CODE INTERNE='', &
&           I4)') koptio,irep
  ELSE
    WRITE (unit=clmess,                               &
&           fmt='(''KOPTIO='',I5,'', INTERNAL CODE='', &
&           I4)') koptio,irep
  ENDIF
!
  IF (inimes.NE.2) CALL lfiems_fort                              &
&                                  (lfi, inumer,lfi%NIMESG,irep, &
&                                   .false.,clmess,              &
&                                   clnspr,clacti)
ENDIF
!
CALL lfiems_fort                                 &
&               (lfi, inumer,inimes,irep,llfata, &
&                clmess,clnspr,clacti)
!
IF (inimes.GE.1.AND.koptio.NE.2) THEN
!
!        Cette messagerie de niveau 1 n'est pas emise en cas d'erreur,
!     meme non fatale.
!
  IF (lfi%LFRANC) THEN
!
    IF (koptio.EQ.0) THEN
      clmess='$ Mode MONO-TACHE Prescrit explicitement... $'
    ELSE
      clmess='$ Mode MULTI-TACHE Prescrit explicitement... $'
    ENDIF
!
  ELSE
!
    IF (koptio.EQ.0) THEN
      clmess='$ MONO-TASKING Mode explicitely Specified... $'
    ELSE
      clmess='$ MULTI-TASKING Mode explicitely Specified... $'
    ENDIF
!
  ENDIF
!
  CALL lfiems_fort                                  &
&                 (lfi, inumer,inimes,irep,.false., &
&                  clmess,clnspr,clacti)
ENDIF
!
IF (lhook) CALL dr_hook('LFIINI_FORT',1,zhook_handle)
END SUBROUTINE lfiini_fort



! Oct-2012 P. Marguinaud 64b LFI
SUBROUTINE lfiini64           &
&           (koptio)
USE lfimod, ONLY : lfi => lficom_default, &
&                   lficom_default_init,   &
&                   new_lfi_default
USE lfi_precision
IMPLICIT NONE
! Arguments
INTEGER (KIND=JPLIKB)  KOPTIO                                 ! IN   

IF (.NOT. lficom_default_init) CALL new_lfi_default ()

CALL lfiini_fort            &
&           (lfi, koptio)

END SUBROUTINE lfiini64

SUBROUTINE lfiini             &
&           (koptio)
USE lfimod, ONLY : lfi => lficom_default, &
&                   lficom_default_init,   &
&                   new_lfi_default
USE lfi_precision
IMPLICIT NONE
! Arguments
INTEGER (KIND=JPLIKM)  KOPTIO                                 ! IN   

IF (.NOT. lficom_default_init) CALL new_lfi_default ()

CALL lfiini_mt             &
&           (lfi, koptio)

END SUBROUTINE lfiini

SUBROUTINE lfiini_mt             &
&           (lfi, koptio)
USE lfimod, ONLY : lficom
USE lfi_precision
IMPLICIT NONE
! Arguments
type(lficom)          lfi                                    ! INOUT
INTEGER (KIND=JPLIKM)  KOPTIO                                 ! IN   
! Local integers
INTEGER (KIND=JPLIKB)  IOPTIO                                 ! IN   
! Convert arguments

ioptio     = int(    koptio, jplikb)

CALL lfiini_fort            &
&           (lfi, ioptio)


END SUBROUTINE lfiini_mt

!INTF KOPTIO        IN