favori.F90

Go to the documentation of this file.

! Oct-2012 P. Marguinaud 64b LFI
! Jan-2011 P. Marguinaud Thread-safe FA
SUBROUTINE favori_fort                                              &
&                     (fa,  kngrib, knbpdg, knbcsp, kstron, kpuila, &
&                      kdmopl)
USE fa_mod, ONLY : fa_com, jpniil
USE parkind1, ONLY : jprb
USE yomhook , ONLY : lhook, dr_hook
USE lfi_precision
IMPLICIT NONE
!****
!        Ce sous-programme permet de connaitre les options implicites
!     courantes liees au codage GRIB des champs.
!     CES OPTIONS NE SONT UTILISEES QUE POUR (RE)ECRIRE DES CHAMPS
!     codes en GRIB, et les valeurs implicites ne servent
!     que LORS d'une OUVERTURE de FICHIER.
!       ( Visualisation (?) Options R (??) Implicites )
!**
!     Arguments : KNGRIB ==> Niveau de codage GRIB (-1,0,1,2,3);
!     (tous de    KNBPDG ==> Nombre de bits par valeur point-de-grille;
!      SORTIE)    KNBCSP ==> Nombre de bits par partie reelle/imaginaire
!                            de coeff. spectral;
!                 KSTRON ==> Sous-troncature non compactee;
!                 KPUILA ==> Puissance de laplacien;
!                 KDMOPL ==> Degre de modulation de KPUILA.
!
!
!
TYPE(fa_com) :: FA
INTEGER (KIND=JPLIKB) KNGRIB, KNBPDG, KNBCSP
INTEGER (KIND=JPLIKB) KSTRON, KPUILA, KDMOPL
!
INTEGER (KIND=JPLIKB) IREP, INIMES, INUMER
!
LOGICAL LLVERG
!
!
!
CHARACTER(LEN=FA%JPXNOM) CLACTI 
CHARACTER(LEN=FA%JPLMES) CLMESS 
CHARACTER(LEN=FA%JPLSPX) CLNSPR

!**
!     1.  -  INITIALISATIONS.
!-----------------------------------------------------------------------
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('FAVORI_MT',0,zhook_handle)
clacti=''
IF (fa%FAVORI_LLPREA) THEN
!
!          A la premiere utilisation, appel au sous-programme "FARINE".
!
  CALL farine_fort             &
&                (fa, 2_jplikb )
  fa%FAVORI_LLPREA=.false.
ENDIF
!
!         Verrouillage global eventuel.
!
IF (fa%LFAMUL) CALL lfiver_fort                        &
&                              (fa%LFI, fa%VRGLAS,'ON')
llverg=fa%LFAMUL
!**
!     2.  -  RECOPIE DES VALEURS EN COMMON DANS LES ARGUMENTS.
!-----------------------------------------------------------------------
!
kngrib=fa%NIGRIB
knbpdg=fa%NBIPDG
knbcsp=fa%NBICSP
kstron=fa%NSTROI
kpuila=fa%NPUILA
kdmopl=fa%NMIDPL
!**
!    10.  -  PHASE TERMINALE : MESSAGERIE 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='FAVORI'
  WRITE (unit=clmess,fmt='(''KNGRIB='',I2,'', KNBPDG='',I3,  &
&         '', KNBCSP='',I3,'', KSTRON='',I3,'', KPUILA='',I3, &
&         '', KDMOPL='',I3)')                                 &
&    kngrib,knbpdg,knbcsp,kstron,kpuila,kdmopl
  inumer=jpniil
  CALL faipar_fort                                      &
&                 (fa, inumer,inimes,irep,.false.,clmess, &
&                  clnspr,clacti,.false.)
ENDIF
!
IF (lhook) CALL dr_hook('FAVORI_MT',1,zhook_handle)
END SUBROUTINE favori_fort



! Oct-2012 P. Marguinaud 64b LFI
SUBROUTINE favori64                                        &
&           (kngrib, knbpdg, knbcsp, kstron, kpuila, kdmopl)
USE fa_mod, ONLY : fa => fa_com_default, &
&                   fa_com_default_init,  &
&                   new_fa_default
USE lfi_precision
IMPLICIT NONE
! Arguments
INTEGER (KIND=JPLIKB)  KNGRIB                                 !   OUT
INTEGER (KIND=JPLIKB)  KNBPDG                                 !   OUT
INTEGER (KIND=JPLIKB)  KNBCSP                                 !   OUT
INTEGER (KIND=JPLIKB)  KSTRON                                 !   OUT
INTEGER (KIND=JPLIKB)  KPUILA                                 !   OUT
INTEGER (KIND=JPLIKB)  KDMOPL                                 !   OUT

IF (.NOT. fa_com_default_init) CALL new_fa_default ()

CALL favori_fort                                               &
&           (fa, kngrib, knbpdg, knbcsp, kstron, kpuila, kdmopl)

END SUBROUTINE favori64

SUBROUTINE favori                                          &
&           (kngrib, knbpdg, knbcsp, kstron, kpuila, kdmopl)
USE fa_mod, ONLY : fa => fa_com_default, &
&                   fa_com_default_init,  &
&                   new_fa_default
USE lfi_precision
IMPLICIT NONE
! Arguments
INTEGER (KIND=JPLIKM)  KNGRIB                                 !   OUT
INTEGER (KIND=JPLIKM)  KNBPDG                                 !   OUT
INTEGER (KIND=JPLIKM)  KNBCSP                                 !   OUT
INTEGER (KIND=JPLIKM)  KSTRON                                 !   OUT
INTEGER (KIND=JPLIKM)  KPUILA                                 !   OUT
INTEGER (KIND=JPLIKM)  KDMOPL                                 !   OUT

IF (.NOT. fa_com_default_init) CALL new_fa_default ()

CALL favori_mt                                                 &
&           (fa, kngrib, knbpdg, knbcsp, kstron, kpuila, kdmopl)

END SUBROUTINE favori

SUBROUTINE favori_mt                                           &
&           (fa, kngrib, knbpdg, knbcsp, kstron, kpuila, kdmopl)
USE fa_mod, ONLY : fa_com
USE lfi_precision
IMPLICIT NONE
! Arguments
type(fa_com)          fa                                     ! INOUT
INTEGER (KIND=JPLIKM)  KNGRIB                                 !   OUT
INTEGER (KIND=JPLIKM)  KNBPDG                                 !   OUT
INTEGER (KIND=JPLIKM)  KNBCSP                                 !   OUT
INTEGER (KIND=JPLIKM)  KSTRON                                 !   OUT
INTEGER (KIND=JPLIKM)  KPUILA                                 !   OUT
INTEGER (KIND=JPLIKM)  KDMOPL                                 !   OUT
! Local integers
INTEGER (KIND=JPLIKB)  INGRIB                                 !   OUT
INTEGER (KIND=JPLIKB)  INBPDG                                 !   OUT
INTEGER (KIND=JPLIKB)  INBCSP                                 !   OUT
INTEGER (KIND=JPLIKB)  ISTRON                                 !   OUT
INTEGER (KIND=JPLIKB)  IPUILA                                 !   OUT
INTEGER (KIND=JPLIKB)  IDMOPL                                 !   OUT
! Convert arguments


CALL favori_fort                                               &
&           (fa, ingrib, inbpdg, inbcsp, istron, ipuila, idmopl)

kngrib     = int(    ingrib, jplikm)
knbpdg     = int(    inbpdg, jplikm)
knbcsp     = int(    inbcsp, jplikm)
kstron     = int(    istron, jplikm)
kpuila     = int(    ipuila, jplikm)
kdmopl     = int(    idmopl, jplikm)

END SUBROUTINE favori_mt

!INTF KNGRIB          OUT 
!INTF KNBPDG          OUT 
!INTF KNBCSP          OUT 
!INTF KSTRON          OUT 
!INTF KPUILA          OUT 
!INTF KDMOPL          OUT