falimu.F90

Go to the documentation of this file.

! Oct-2012 P. Marguinaud 64b LFI
! Jan-2011 P. Marguinaud Thread-safe FA
SUBROUTINE falimu_fort                                     &
&                     (fa,  kxnivv, kxtron, kxlati, kxlong )
USE fa_mod, ONLY : fa_com, jpniil
USE parkind1, ONLY : jprb
USE yomhook , ONLY : lhook, dr_hook
USE lfi_precision
IMPLICIT NONE
!****
!        Sous-programme servant a obtenir les valeurs courantes
!     des LIMites Utilisateur en termes de Resolutions horizontale
!     et verticale, valides globalement pour tous les Fichiers et Cadres
!     ARPEGE manipules par le programme utilisateur.
!**
!        Arguments : KXNIVV ==> Nombre maximum de niveaux verticaux;
!  (tous de Sortie)  KXTRON ==> Troncature maximum;
!                    KXLATI ==> Nombre maximum de latitudes pole a pole;
!                    KXLONG ==> Nombre maxi de longitudes par parallele.
!
!
!
TYPE(fa_com) :: FA
INTEGER (KIND=JPLIKB) KXNIVV, KXTRON, KXLATI, KXLONG
!
INTEGER (KIND=JPLIKB) INUMER, INIMES, IREP
!
LOGICAL LLVERG
!
!
!
CHARACTER(LEN=FA%JPXNOM) CLACTI 
CHARACTER(LEN=FA%JPLMES) CLMESS 
CHARACTER(LEN=FA%JPLSPX) CLNSPR
LOGICAL                  LLFATA

!**
!     1.  -  SI PREMIERE UTILISATION, APPEL AU SOUS-PROGRAMME "FARINE".
!-----------------------------------------------------------------------
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('FALIMU_MT',0,zhook_handle)
clacti=''
IF (fa%FALIMU_LLPREA) THEN
  CALL farine_fort              &
&                 (fa, 2_jplikb )
  fa%FALIMU_LLPREA=.false.
ENDIF
!
!             Verrouillage global, si necessaire.
!
IF (fa%LFAMUL) CALL lfiver_fort                        &
&                              (fa%LFI, fa%VRGLAS,'ON')
llverg=fa%LFAMUL
!**
!     2.  -  RECOPIE DES VALEURS EN COMMON DANS LES ARGUMENTS.
!-----------------------------------------------------------------------
!
kxnivv=fa%NXNIVV
kxtron=fa%NXTRON
kxlati=fa%NXLATI
kxlong=fa%NXLONG
!**
!    10.  -  PHASE TERMINALE : MESSAGERIE, AVEC "ABORT" EVENTUEL,
!            VIA LE sous-programme "FAIPAR" .
!-----------------------------------------------------------------------
!
!
!          Deverrouillage global eventuel.
!
IF (llverg) CALL lfiver_fort                         &
&                           (fa%LFI, fa%VRGLAS,'OFF')
!
IF (fa%NIMSGA.EQ.2) THEN
  irep=0
  inimes=2
  clnspr='FALIMU'
  inumer=jpniil
  WRITE (unit=clmess,fmt='(''KXNIVV='',I4,'', KXTRON='',I4, &
&         '', KXLATI='',I4,'', KXLONG='',I4)')               &
&     kxnivv,kxtron,kxlati,kxlong
  CALL faipar_fort                                     &
&                 (fa, inumer,inimes,irep,llfata,clmess, &
&               clnspr,clacti,.false.)
ENDIF
!
IF (lhook) CALL dr_hook('FALIMU_MT',1,zhook_handle)
END SUBROUTINE falimu_fort



! Oct-2012 P. Marguinaud 64b LFI
SUBROUTINE falimu64                        &
&           (kxnivv, kxtron, kxlati, kxlong)
USE fa_mod, ONLY : fa => fa_com_default, &
&                   fa_com_default_init,  &
&                   new_fa_default
USE lfi_precision
IMPLICIT NONE
! Arguments
INTEGER (KIND=JPLIKB)  KXNIVV                                 !   OUT
INTEGER (KIND=JPLIKB)  KXTRON                                 !   OUT
INTEGER (KIND=JPLIKB)  KXLATI                                 !   OUT
INTEGER (KIND=JPLIKB)  KXLONG                                 !   OUT

IF (.NOT. fa_com_default_init) CALL new_fa_default ()

CALL falimu_fort                               &
&           (fa, kxnivv, kxtron, kxlati, kxlong)

END SUBROUTINE falimu64

SUBROUTINE falimu                          &
&           (kxnivv, kxtron, kxlati, kxlong)
USE fa_mod, ONLY : fa => fa_com_default, &
&                   fa_com_default_init,  &
&                   new_fa_default
USE lfi_precision
IMPLICIT NONE
! Arguments
INTEGER (KIND=JPLIKM)  KXNIVV                                 !   OUT
INTEGER (KIND=JPLIKM)  KXTRON                                 !   OUT
INTEGER (KIND=JPLIKM)  KXLATI                                 !   OUT
INTEGER (KIND=JPLIKM)  KXLONG                                 !   OUT

IF (.NOT. fa_com_default_init) CALL new_fa_default ()

CALL falimu_mt                                 &
&           (fa, kxnivv, kxtron, kxlati, kxlong)

END SUBROUTINE falimu

SUBROUTINE falimu_mt                           &
&           (fa, kxnivv, kxtron, kxlati, kxlong)
USE fa_mod, ONLY : fa_com
USE lfi_precision
IMPLICIT NONE
! Arguments
type(fa_com)          fa                                     ! INOUT
INTEGER (KIND=JPLIKM)  KXNIVV                                 !   OUT
INTEGER (KIND=JPLIKM)  KXTRON                                 !   OUT
INTEGER (KIND=JPLIKM)  KXLATI                                 !   OUT
INTEGER (KIND=JPLIKM)  KXLONG                                 !   OUT
! Local integers
INTEGER (KIND=JPLIKB)  IXNIVV                                 !   OUT
INTEGER (KIND=JPLIKB)  IXTRON                                 !   OUT
INTEGER (KIND=JPLIKB)  IXLATI                                 !   OUT
INTEGER (KIND=JPLIKB)  IXLONG                                 !   OUT
! Convert arguments


CALL falimu_fort                               &
&           (fa, ixnivv, ixtron, ixlati, ixlong)

kxnivv     = int(    ixnivv, jplikm)
kxtron     = int(    ixtron, jplikm)
kxlati     = int(    ixlati, jplikm)
kxlong     = int(    ixlong, jplikm)

END SUBROUTINE falimu_mt

!INTF KXNIVV          OUT 
!INTF KXTRON          OUT 
!INTF KXLATI          OUT 
!INTF KXLONG          OUT