fainoc.F90

Go to the documentation of this file.

! Oct-2012 P. Marguinaud 64b LFI
! Jan-2011 P. Marguinaud Thread-safe FA
SUBROUTINE fainoc_fort            &
&                     (fa,  krang )
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 d'INterpreter, pour un fichier ARPEGE
!     ouvert, les Options par defaut (-1) du Codage GRIB des champs:
!     FA%NBFPDG(KRANG), FA%NBFCSP(KRANG), FA%NSTROF(KRANG), FA%NPUFLA(KRANG).
!     Cette routine doit etre appelee par FAITOU ou FANOUV ou FAGOTE
!     pour ne pas laisser le defaut -1 lors du decodage ou du codage
!     GRIB.
!
!**
!     Arguments : KRANG  (Entree) ==> Rang de l'unite logique;
!
!
!
!
TYPE(fa_com) :: FA
INTEGER (KIND=JPLIKB) KRANG
!
INTEGER (KIND=JPLIKB) IRANGC, ITRONC, INBITS
INTEGER (KIND=JPLIKB) ITYPTR, IAUXIL, IREP, INIMES
INTEGER (KIND=JPLIKB) INUMER
!
LOGICAL LLVERF, LLMLAM
!
CHARACTER(LEN=FA%JPLMES) CLMESS 
CHARACTER(LEN=FA%JPLSPX) CLNSPR

!**
!     1.  -  INITIALISATIONS PREALABLES.
!-----------------------------------------------------------------------
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('FAINOC_MT',0,zhook_handle)
llverf=.false.
!
!         Verrouillage eventuel du fichier.
!
IF (fa%LFAMUL) CALL lfiver_fort                               &
&                              (fa%LFI, fa%FICHIER(krang)%VRFICH,'ON')
llverf=fa%LFAMUL
!
irangc=fa%FICHIER(krang)%NUCADR
llmlam=fa%CADRE(irangc)%LIMLAM
itronc=fa%CADRE(irangc)%MTRONC
ityptr=fa%CADRE(irangc)%NTYPTR
!
!**
!     2.  -  INTERPRETATION DES OPTIONS PAR DEFAUT.
!-----------------------------------------------------------------------
!
! On distingue le cas ARPEGE du cas ALADIN (LLMLAM=.T.).
!
!
! Evaluation du nombre de bits par valeur point-de-grille
!
IF (fa%FICHIER(krang)%NBFPDG.LT.0) THEN
  IF (llmlam) THEN
    fa%FICHIER(krang)%NBFPDG=16
  ELSE
    fa%FICHIER(krang)%NBFPDG=16
  ENDIF
ENDIF
!
! Evaluation du nombre de bits par partie reelle/imagin. de coeff. spectral
!
IF (fa%FICHIER(krang)%NBFCSP.LT.0) THEN
  IF (llmlam) THEN
    fa%FICHIER(krang)%NBFCSP=18
  ELSE
    fa%FICHIER(krang)%NBFCSP=16
  ENDIF
ENDIF
!
! Evaluation de la sous-troncature non compactee
!
IF (fa%FICHIER(krang)%NSTROF.LT.0) THEN
  inbits=fa%FICHIER(krang)%NBFCSP
  IF (llmlam) THEN
    iauxil=max( itronc, -ityptr )
    iauxil=max( 10_jplikb , ((1+iauxil)*25)/(10*inbits),  &
&               (1+iauxil)/10 )
    iauxil=min( iauxil, itronc-1, -ityptr-1 )
    fa%FICHIER(krang)%NSTROF=iauxil
  ELSE
    iauxil=max( 10_jplikb , 480/inbits-10, (1+itronc)/10 )
    iauxil=min( iauxil, itronc-1 )
    fa%FICHIER(krang)%NSTROF=iauxil
  ENDIF
ENDIF
!
! Evaluation de la puissance de laplacien
!
IF (fa%FICHIER(krang)%NPUFLA.LT.0) THEN
  IF (llmlam) THEN
    fa%FICHIER(krang)%NPUFLA=2
  ELSE
    fa%FICHIER(krang)%NPUFLA=1
  ENDIF
ENDIF
!**
!    10.  -  PHASE TERMINALE : MESSAGERIE,
!            VIA LE SOUS-PROGRAMME "FAIPAR" .
!-----------------------------------------------------------------------
!
!
!        Deverrouillage eventuel du fichier.
!
IF (llverf) CALL lfiver_fort                                &
&                           (fa%LFI, fa%FICHIER(krang)%VRFICH,'OFF')
!
IF (ixnvms(krang).NE.2)  THEN 
  IF (lhook) CALL dr_hook('FAINOC_MT',1,zhook_handle)
  RETURN
ENDIF
!
inumer=jpniil
inimes=ixnvms(krang)
irep=0
clnspr='FAINOC'
WRITE (unit=clmess,fmt='(''KRANG='',I4)') krang
CALL faipar_fort                                      &
&               (fa, inumer,inimes,irep,.false.,clmess, &
&                clnspr,' ',.false.)
!
IF (lhook) CALL dr_hook('FAINOC_MT',1,zhook_handle)

CONTAINS

#include "facom2.ixnvms.h"

END SUBROUTINE fainoc_fort



! Oct-2012 P. Marguinaud 64b LFI
SUBROUTINE fainoc64           &
&           (krang)
USE fa_mod, ONLY : fa => fa_com_default, &
&                   fa_com_default_init,  &
&                   new_fa_default
USE lfi_precision
IMPLICIT NONE
! Arguments
INTEGER (KIND=JPLIKB)  KRANG                                  ! IN   

IF (.NOT. fa_com_default_init) CALL new_fa_default ()

CALL fainoc_fort           &
&           (fa, krang)

END SUBROUTINE fainoc64

SUBROUTINE fainoc             &
&           (krang)
USE fa_mod, ONLY : fa => fa_com_default, &
&                   fa_com_default_init,  &
&                   new_fa_default
USE lfi_precision
IMPLICIT NONE
! Arguments
INTEGER (KIND=JPLIKM)  KRANG                                  ! IN   

IF (.NOT. fa_com_default_init) CALL new_fa_default ()

CALL fainoc_mt             &
&           (fa, krang)

END SUBROUTINE fainoc

SUBROUTINE fainoc_mt             &
&           (fa, krang)
USE fa_mod, ONLY : fa_com
USE lfi_precision
IMPLICIT NONE
! Arguments
type(fa_com)          fa                                     ! INOUT
INTEGER (KIND=JPLIKM)  KRANG                                  ! IN   
! Local integers
INTEGER (KIND=JPLIKB)  IRANG                                  ! IN   
! Convert arguments

irang      = int(     krang, jplikb)

CALL fainoc_fort           &
&           (fa, irang)


END SUBROUTINE fainoc_mt

!INTF KRANG         IN