faifla.F90

Go to the documentation of this file.

! Oct-2012 P. Marguinaud 64b LFI
! Jan-2011 P. Marguinaud Thread-safe FA
SUBROUTINE faifla_fort           &
&                     (fa, krang)
USE fa_mod, ONLY : fa_com
USE parkind1, ONLY : jprb
USE yomhook , ONLY : lhook, dr_hook
USE lfi_precision
IMPLICIT NONE
!****
!        Ce sous-programme est charge des Initialisations des
!     tableaux FLAp1d., utilises pour aplatir le spectre des champs
!     d'un fichier avant le compactage (coefficients spectraux seulement).
!**
!
!
!**
!     ARGUMENTS :    KRANG  (Entree) ==> Rang de l'unite logique
!
!
!
!
TYPE(fa_com) :: FA
INTEGER (KIND=JPLIKB) KRANG
!
INTEGER (KIND=JPLIKB) J, IRANGC, IPUILA, ITRONC

!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('FAIFLA_MT',0,zhook_handle)
!
ipuila = fa%FICHIER(krang)%NPUFLA
irangc = fa%FICHIER(krang)%NUCADR
itronc = fa%CADRE(irangc)%MTRONC
!
IF (.NOT. ASSOCIATED (fa%FICHIER(krang)%FLAP1D)) &
& ALLOCATE (fa%FICHIER(krang)%FLAP1D (itronc))
IF (.NOT. ASSOCIATED (fa%FICHIER(krang)%FLAP1DA)) &
& ALLOCATE (fa%FICHIER(krang)%FLAP1DA (fa%JPXTRO*fa%JPXTRO))

!
IF (ipuila.GT.0) THEN
!
  DO j=1,itronc
    fa%FICHIER(krang)%FLAP1D(j)=fa%XLAP1D(j,0)**ipuila
  ENDDO
  DO j=1,fa%JPXTRO*fa%JPXTRO
    fa%FICHIER(krang)%FLAP1DA(j)=fa%XLAP1DA(j,0)**ipuila
  ENDDO
!
ELSEIF (ipuila.LT.0) THEN
!
  DO j=1,itronc
    fa%FICHIER(krang)%FLAP1D(j)=fa%XLAP1D(j,1)**(-ipuila)
  ENDDO
  DO j=1,fa%JPXTRO*fa%JPXTRO
    fa%FICHIER(krang)%FLAP1DA(j)=fa%XLAP1DA(j,1)**(-ipuila)
  ENDDO
!
ENDIF
!
IF (lhook) CALL dr_hook('FAIFLA_MT',1,zhook_handle)
END SUBROUTINE faifla_fort



! Oct-2012 P. Marguinaud 64b LFI
SUBROUTINE faifla64           &
&           (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 faifla_fort           &
&           (fa, krang)

END SUBROUTINE faifla64

SUBROUTINE faifla             &
&           (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 faifla_mt             &
&           (fa, krang)

END SUBROUTINE faifla

SUBROUTINE faifla_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 faifla_fort           &
&           (fa, irang)


END SUBROUTINE faifla_mt

!INTF KRANG         IN