faixla.F90

Go to the documentation of this file.

! Oct-2012 P. Marguinaud 64b LFI
! Jan-2011 P. Marguinaud Thread-safe FA
SUBROUTINE faixla_fort           &
&                     (fa)
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 XLAp.d., utilises pour aplatir le spectre des champs
!     avant le compactage (coefficients spectraux seulement).
!**
!
!
!
TYPE(fa_com) :: FA
INTEGER (KIND=JPLIKB) J, JN, IDEBUT
INTEGER (KIND=JPLIKB) IFIN, INDM, INDN, JJPUIS

!
!
!        On commence par les allocations des differents tableaux
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('FAIXLA_MT',0,zhook_handle)
ALLOCATE (fa%XLAP1D (fa%JPXTRO,0:1))
ALLOCATE (fa%XLAP1DA (fa%JPXTRO*fa%JPXTRO,0:1))
ALLOCATE (fa%XLAP2D (2:fa%JPXCSP,fa%JPUILA,0:1))
ALLOCATE (fa%XLAP2DA (fa%JPXTRO*fa%JPXTRO,fa%JPUILA,0:1))
!
DO jn=1,fa%JPXTRO
  fa%XLAP1D(jn,0)=REAL (JN*(JN+1), JPDBLR)
  fa%XLAP1D(jn,1)=1._jpdblr/fa%XLAP1D(jn,0)
ENDDO
!
DO jn=1,fa%JPXTRO*fa%JPXTRO
  indn=1+(jn-1)/fa%JPXTRO
  indm=jn-(indn-1)*fa%JPXTRO
  fa%XLAP1DA(jn,0)=real(indn**2+indm**2, jpdblr)
  fa%XLAP1DA(jn,1)=1._jpdblr/fa%XLAP1DA(jn,0)
ENDDO
!
DO jn=1,fa%JPXTRO
  idebut=jn**2+1
  ifin=(1+jn)**2
!
  DO jjpuis=1,fa%JPUILA
!
  DO j=idebut,ifin
    fa%XLAP2D(j,jjpuis,0)=fa%XLAP1D(jn,0)**jjpuis
    fa%XLAP2D(j,jjpuis,1)=1._jpdblr/fa%XLAP2D(j,jjpuis,0)
  ENDDO
!        
  ENDDO
!
ENDDO
!
DO jjpuis=1,fa%JPUILA
!
DO jn=1,fa%JPXTRO**2 
  fa%XLAP2DA(jn,jjpuis,0)=fa%XLAP1DA(jn,0)**jjpuis
  fa%XLAP2DA(jn,jjpuis,1)=1._jpdblr/fa%XLAP2DA(jn,jjpuis,0)
ENDDO
!
ENDDO
!
!
IF (lhook) CALL dr_hook('FAIXLA_MT',1,zhook_handle)
END SUBROUTINE faixla_fort



! Oct-2012 P. Marguinaud 64b LFI
SUBROUTINE faixla64           &
&           ()
USE fa_mod, ONLY : fa => fa_com_default, &
&                   fa_com_default_init,  &
&                   new_fa_default
USE lfi_precision
IMPLICIT NONE
! Arguments

IF (.NOT. fa_com_default_init) CALL new_fa_default ()

CALL faixla_fort           &
&           (fa)

END SUBROUTINE faixla64

SUBROUTINE faixla             &
&           ()
USE fa_mod, ONLY : fa => fa_com_default, &
&                   fa_com_default_init,  &
&                   new_fa_default
USE lfi_precision
IMPLICIT NONE
! Arguments

IF (.NOT. fa_com_default_init) CALL new_fa_default ()

CALL faixla_mt             &
&           (fa)

END SUBROUTINE faixla

SUBROUTINE faixla_mt             &
&           (fa)
USE fa_mod, ONLY : fa_com
USE lfi_precision
IMPLICIT NONE
! Arguments
type(fa_com)          fa                                     ! INOUT
! Local integers
! Convert arguments


CALL faixla_fort           &
&           (fa)


END SUBROUTINE faixla_mt