SURFEX v7.3: /home/dasprezs/EXPORT_v7_3/src/LIB/XRD38/FA/mt/faixla

Go to the documentation of this file.
00001 C Jan-2011 P. Marguinaud Thread-safe FA
00002       SUBROUTINE FAIXLA_MT (FA)
00003       USE FA_MOD, ONLY : FA_COM
00004       USE PARKIND1, ONLY : JPRB
00005       USE YOMHOOK , ONLY : LHOOK, DR_HOOK
00006 C****
00007 C        Ce sous-programme est charge des Initialisations des
00008 C     tableaux XLAp.d., utilises pour aplatir le spectre des champs
00009 C     avant le compactage (coefficients spectraux seulement).
00010 C**
00011 C
00012 #include "precision.h"
00013 C
00014 C
00015       TYPE(FA_COM) :: FA
00016       INTEGER J, JN, IDEBUT, IFIN, INDM, INDN, JJPUIS
00017 #include "facom_mt.h"
00018 C
00019 C
00020 C        On commence par les allocations des differents tableaux
00021 C
00022       REAL(KIND=JPRB) :: ZHOOK_HANDLE
00023       IF (LHOOK) CALL DR_HOOK('FAIXLA_MT',0,ZHOOK_HANDLE)
00024       ALLOCATE (FA%XLAP1D (FA%JPXTRO,0:1))
00025       ALLOCATE (FA%XLAP1DA (FA%JPXTRO*FA%JPXTRO,0:1))
00026       ALLOCATE (FA%XLAP2D (2:FA%JPXCSP,FA%JPUILA,0:1))
00027       ALLOCATE (FA%XLAP2DA (FA%JPXTRO*FA%JPXTRO,FA%JPUILA,0:1))
00028 C
00029       DO JN=1,FA%JPXTRO
00030         FA%XLAP1D(JN,0)=REAL (JN*(JN+1))
00031         FA%XLAP1D(JN,1)=1./FA%XLAP1D(JN,0)
00032       ENDDO
00033 C
00034       DO JN=1,FA%JPXTRO*FA%JPXTRO
00035         INDN=1+(JN-1)/FA%JPXTRO
00036         INDM=JN-(INDN-1)*FA%JPXTRO
00037         FA%XLAP1DA(JN,0)=REAL (INDN**2+INDM**2)
00038         FA%XLAP1DA(JN,1)=1./FA%XLAP1DA(JN,0)
00039       ENDDO
00040 C
00041       DO JN=1,FA%JPXTRO
00042         IDEBUT=JN**2+1
00043         IFIN=(1+JN)**2
00044 C
00045         DO JJPUIS=1,FA%JPUILA
00046 C
00047         DO J=IDEBUT,IFIN
00048           FA%XLAP2D(J,JJPUIS,0)=FA%XLAP1D(JN,0)**JJPUIS
00049           FA%XLAP2D(J,JJPUIS,1)=1./FA%XLAP2D(J,JJPUIS,0)
00050         ENDDO
00051 C        
00052         ENDDO
00053 C
00054       ENDDO
00055 C
00056       DO JJPUIS=1,FA%JPUILA
00057 C
00058       DO JN=1,FA%JPXTRO**2 
00059         FA%XLAP2DA(JN,JJPUIS,0)=FA%XLAP1DA(JN,0)**JJPUIS
00060         FA%XLAP2DA(JN,JJPUIS,1)=1./FA%XLAP2DA(JN,JJPUIS,0)
00061       ENDDO
00062 C
00063       ENDDO
00064 C
00065 C
00066       IF (LHOOK) CALL DR_HOOK('FAIXLA_MT',1,ZHOOK_HANDLE)
00067       END
00068