faisc2.F90

Go to the documentation of this file.

! Oct-2012 P. Marguinaud 64b LFI
! Jan-2011 P. Marguinaud Thread-safe FA
SUBROUTINE faisc2_fort                   &
&                     (fa,  krep, krangc )
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 initialise des tableaux "reference" de
!      l'en-tete GRIB, section 2: les differents types de grille
!      sont abordes (routine appelee une seule fois pour un cadre donne)
!**
!    Arguments : KREP   (Sortie) ==> Code-reponse du sous-programme;
!                KRANGC (Entree) ==> Rang dans la table des cadres;
!*
!
!
!
TYPE(fa_com) :: FA
INTEGER (KIND=JPLIKB) KREP, KRANGC
!
REAL (KIND=JPDBLR) :: ZPI, ZRAMDE, ZLATPRE,     &
&                      ZLATDER, ZLONPRE, ZLONDER
REAL (KIND=JPDBLR), PARAMETER :: ONE = 1.0_jpdblr
!
INTEGER (KIND=JPLIKB) INLAT, INIVAU, INUMER, INIMES
!
LOGICAL LLMLAM
!
CHARACTER(LEN=FA%JPLMES) CLMESS 
CHARACTER(LEN=FA%JPLSPX) CLNSPR

!**
!     0.  -  INITIALISATIONS PREALABLES
!-----------------------------------------------------------------------
!
REAL(KIND=JPRB) :: ZHOOK_HANDLE
IF (lhook) CALL dr_hook('FAISC2_MT',0,zhook_handle)
krep=0
IF (krangc.LE.0.OR.krangc.GT.fa%JPNXCA) THEN
  krep=-66
  GOTO 1001
ENDIF
inlat  = fa%CADRE(krangc)%NLATIT
inivau = fa%CADRE(krangc)%NNIVER
llmlam = fa%CADRE(krangc)%LIMLAM
zpi = 2._jpdblr*asin(1._jpdblr)
! Conversion des radians en 1/1000 de degre
zramde = 180000._jpdblr/zpi
!
IF (llmlam) GOTO 300
!**
!     1.  -  KSEC2 POUR LA REPRESENTATION SPECTRALE ARPEGE
!-----------------------------------------------------------------------
!
! Type de representation de donnees
!
! FA%SSLAPO=sinus latitude du pole d'interet
! (si=1, pole=pole N et pas de rotation)
! FA%SCODIL=coeff de dilation (si =1, pas de dilatation)
IF ((1._jpdblr-fa%CADRE(krangc)%SSLAPO).LE.1.e-10_jpdblr) THEN
  fa%CADRE(krangc)%NSEC2SP(1)=70
  IF (abs(fa%CADRE(krangc)%SCODIL-1._jpdblr).LE.1.e-10_jpdblr) THEN
    fa%CADRE(krangc)%NSEC2SP(1)=50
  ENDIF
ELSE
  fa%CADRE(krangc)%NSEC2SP(1)=80
  IF (abs(fa%CADRE(krangc)%SCODIL-1._jpdblr).LE.1.e-10_jpdblr) THEN
    fa%CADRE(krangc)%NSEC2SP(1)=60
  ENDIF
ENDIF
! Troncature (3 fois la meme si triangulaire)
fa%CADRE(krangc)%NSEC2SP(2) =fa%CADRE(krangc)%MTRONC
fa%CADRE(krangc)%NSEC2SP(3) =fa%CADRE(krangc)%MTRONC
fa%CADRE(krangc)%NSEC2SP(4) =fa%CADRE(krangc)%MTRONC
! Type de representation
fa%CADRE(krangc)%NSEC2SP(5) =1
! Mode de representation (2->complex packing)
fa%CADRE(krangc)%NSEC2SP(6) =2
! Reserves
fa%CADRE(krangc)%NSEC2SP(7:11)=0
! Nb de parametres pour la coord verticale
! On prend ici le cas de la coordonnee hybride
! mais le cas de la coord pression sera aisement
! pris en compte + tard (KSEC2(12)=0).
fa%CADRE(krangc)%NSEC2SP(12)=2*(inivau+1)
! Latitude du pole sud de rotation
fa%CADRE(krangc)%NSEC2SP(13)=0
! Longitude du pole sud de rotation
fa%CADRE(krangc)%NSEC2SP(14)=0
! Lat et lon du pole d'etirement
IF (fa%CADRE(krangc)%NTYPTR.GE.2) THEN
  fa%CADRE(krangc)%NSEC2SP(15)=int(zramde*asin(fa%CADRE(krangc)%SSLAPO),  &
&                             jplikb)
  fa%CADRE(krangc)%NSEC2SP(16)=int(zramde*                       &
&    (sign(one,fa%CADRE(krangc)%SSLOPO)*acos(fa%CADRE(krangc)%SCLOPO)), &
&    jplikb)
ELSE
  fa%CADRE(krangc)%NSEC2SP(15)=0
  fa%CADRE(krangc)%NSEC2SP(16)=0
ENDIF
! Reserves
fa%CADRE(krangc)%NSEC2SP(17:22)=0
!**
!     2.  -  KSEC2 POUR LA GRILLE DE GAUSS (ARPEGE)
!-----------------------------------------------------------------------
!
! Type de representation de donnees
!
! FA%SSLAPO=sinus latitude du pole d'interet
! (si=1, pole=pole N et pas de rotation)
! FA%SCODIL=coeff de dilation (si =1, pas de dilatation)
IF ((1._jpdblr-fa%CADRE(krangc)%SSLAPO).LE.1.e-10_jpdblr) THEN
  fa%CADRE(krangc)%NSEC2GG(1)=24
  IF (abs(fa%CADRE(krangc)%SCODIL-1._jpdblr).LE.1.e-10_jpdblr) THEN
    fa%CADRE(krangc)%NSEC2GG(1)=4
  ENDIF
ELSE
  fa%CADRE(krangc)%NSEC2GG(1)=34
  IF (abs(fa%CADRE(krangc)%SCODIL-1._jpdblr).LE.1.e-10_jpdblr) THEN
    fa%CADRE(krangc)%NSEC2GG(1)=14
  ENDIF
ENDIF
! Nb de pts sur un parallele
fa%CADRE(krangc)%NSEC2GG(2)=fa%CADRE(krangc)%NXLOPA
! Nb de pts sur une longitude
fa%CADRE(krangc)%NSEC2GG(3)=inlat
zlatpre=asin(max(-1._jpdblr,min(1._jpdblr,fa%CADRE(krangc)%SINLAT(1))))
! Latitude (1/1000 degre) du premier pt de grille
fa%CADRE(krangc)%NSEC2GG(4)=int(zramde*zlatpre, jplikb)
! Longitude (1/1000 degre) du premier pt de grille
fa%CADRE(krangc)%NSEC2GG(5)=0
! Flag pour la resolution (0->on ne donne pas l'increment)
fa%CADRE(krangc)%NSEC2GG(6)=0
! Latitude (1/1000 degre) du dernier pt de grille
fa%CADRE(krangc)%NSEC2GG(7)=-fa%CADRE(krangc)%NSEC2GG(4)
! Longitude (1/1000 degre) du dernier pt de grille.
! (FA%NLOPAR(1,KRANGC)=nb de longitudes sur le 1er parallele)
fa%CADRE(krangc)%NSEC2GG(8)=-360000/fa%CADRE(krangc)%NLOPAR(1)
! Increment zonal (1/1000 degre)
! Pas de sens ici.
fa%CADRE(krangc)%NSEC2GG(9)=0
! Nb de paralleles entre le pole et l'equateur
fa%CADRE(krangc)%NSEC2GG(10)=(inlat+1)/2
! Flag pour le mode de balayage
fa%CADRE(krangc)%NSEC2GG(11)=0
! Nombre de parametres pour la coord. verticale
fa%CADRE(krangc)%NSEC2GG(12)=0
! Latitude du pole sud de rotation
fa%CADRE(krangc)%NSEC2GG(13)=0
! Longitude du pole sud de rotation
fa%CADRE(krangc)%NSEC2GG(14)=0
! Latitude et longitude du pole d'etirement
IF (fa%CADRE(krangc)%NTYPTR.GE.2) THEN
  fa%CADRE(krangc)%NSEC2GG(15)=int(zramde*asin(fa%CADRE(krangc)%SSLAPO),  &
&                             jplikb)
  fa%CADRE(krangc)%NSEC2GG(16)=int(zramde*                        &
&     (sign(one,fa%CADRE(krangc)%SSLOPO)*acos(fa%CADRE(krangc)%SCLOPO)), &
&     jplikb)
ELSE
  fa%CADRE(krangc)%NSEC2GG(15)=0
  fa%CADRE(krangc)%NSEC2GG(16)=0
ENDIF
! Flag:      0 -> grille reguliere,  1 -> grille reduite
IF (fa%CADRE(krangc)%NLOPAR(1)==fa%CADRE(krangc)%NLOPAR((1+inlat)/2)) THEN
  fa%CADRE(krangc)%NSEC2GG(17)=0
ELSE
  fa%CADRE(krangc)%NSEC2GG(17)=1
ENDIF
! Flag:      0 -> Terre ronde     , 64 -> Terre ellipsoide
fa%CADRE(krangc)%NSEC2GG(18)=0
! Flag sur les composantes des vecteurs (0->geographique, 8->grille)
fa%CADRE(krangc)%NSEC2GG(19)=0
! Reserves
fa%CADRE(krangc)%NSEC2GG(20:22)=0
! Pour les grilles reduites, nb de points sur chaque parallele
fa%CADRE(krangc)%NSEC2GG(23:22+(1+inlat)/2)=            &
&                 fa%CADRE(krangc)%NLOPAR(1:(1+inlat)/2)
fa%CADRE(krangc)%NSEC2GG(23-mod(inlat,2_jplikb )+(1+inlat)/2:22+inlat)=  &
&                               fa%CADRE(krangc)%NLOPAR((1+inlat)/2:1:-1)
GOTO 600
!**
!     3.  -  KSEC2 POUR LA GRILLE LAT-LON (CAS FULL-POS, ARPEGE OU ALADIN)
!-------------------------------------------------------------------------
!
300 CONTINUE
! TEST POUR NEW EGGX
IF (fa%CADRE(krangc)%SINLAT(1) .GE. 0) THEN
! OLD EGGX
zlatpre=fa%CADRE(krangc)%SINLAT(7)
zlonpre=fa%CADRE(krangc)%SINLAT(4)
zlatder=fa%CADRE(krangc)%SINLAT(5)
zlonder=fa%CADRE(krangc)%SINLAT(6)
! Type de representation de donnees
ELSE
! NEW EGGX
zlatpre=fa%CADRE(krangc)%SINLAT(16)
zlonpre=fa%CADRE(krangc)%SINLAT(13)
zlatder=fa%CADRE(krangc)%SINLAT(14)
zlonder=fa%CADRE(krangc)%SINLAT(15)
ENDIF
!
! Type de representation de donnees
fa%CADRE(krangc)%NSEC2LL(1)=0
! Nb de pts sur un parallele
fa%CADRE(krangc)%NSEC2LL(2)=fa%CADRE(krangc)%NXLOPA
! Nb de pts sur une longitude
fa%CADRE(krangc)%NSEC2LL(3)=inlat
! Latitude (1/1000 degre) du premier pt de grille
fa%CADRE(krangc)%NSEC2LL(4)=nint(zramde*zlatpre,kind=jplikb)
! Longitude (1/1000 degre) du premier pt de grille
fa%CADRE(krangc)%NSEC2LL(5)=nint(zramde*zlonpre,kind=jplikb)
!
CALL lon360000 (fa%CADRE(krangc)%NSEC2LL(5))
! Flag pour la resolution (128->on donne l'increment: grille reguliere)
fa%CADRE(krangc)%NSEC2LL(6)=128
! Latitude (1/1000 degre) du dernier pt de grille
fa%CADRE(krangc)%NSEC2LL(7)=nint(zramde*zlatder,kind=jplikb)
! Longitude (1/1000 degre) du dernier pt de grille
fa%CADRE(krangc)%NSEC2LL(8)=nint(zramde*zlonder,kind=jplikb)
CALL lon360000 (fa%CADRE(krangc)%NSEC2LL(8))
! Increment zonal (1/1000 degre)
IF (zlonpre.GT.zlonder) THEN
  fa%CADRE(krangc)%NSEC2LL(9)=                         &
&    nint((zlonder+2._jpdblr*zpi-zlonpre)*zramde &
&         /(fa%CADRE(krangc)%NXLOPA-1),                &
&         kind=jplikb)
ELSE
  fa%CADRE(krangc)%NSEC2LL(9)=                                      &
&        nint((zlonder-zlonpre)*zramde/(fa%CADRE(krangc)%NXLOPA-1), &
&             kind=jplikb)
ENDIF
! Increment meridien (1/1000 degre)
fa%CADRE(krangc)%NSEC2LL(10)=                             &
&          nint((zlatpre-zlatder)*zramde/(inlat-1), &
&               kind=jplikb)
! Flag pour le mode de balayage: W->E et S->N = 64; W->E et N->S = 0
! Full-Pos produit des champs lat-lon ranges S->N pour ARP et ALD.
! Or la BDAP attend un rangt N->S pour les grilles lat-lon.
! FA renverse donc les champs issus de Full-Pos avant codage GRIBEX.
! 
fa%CADRE(krangc)%NSEC2LL(11)=0
! Nombre de parametres pour la coord. verticale
fa%CADRE(krangc)%NSEC2LL(12)=0
! Latitude du pole sud de rotation
fa%CADRE(krangc)%NSEC2LL(13)=0
! Longitude du pole sud de rotation
fa%CADRE(krangc)%NSEC2LL(14)=0
! Latitude et longitude du pole d'etirement
fa%CADRE(krangc)%NSEC2LL(15)=0
fa%CADRE(krangc)%NSEC2LL(16)=0
! Flag:      0 -> grille reguliere,  1 -> grille reduite
fa%CADRE(krangc)%NSEC2LL(17)=0
! Flag:      0 -> Terre ronde     , 64 -> Terre ellipsoide
fa%CADRE(krangc)%NSEC2LL(18)=0
! Flag sur les composantes des vecteurs (0->geographique, 8->grille)
fa%CADRE(krangc)%NSEC2LL(19)=0
! Reserves
fa%CADRE(krangc)%NSEC2LL(20:22)=0
!**
!     4.  -  KSEC2 POUR LA GRILLE LAT-LON QUASI-REGULIERE ALADIN
!            (en fait, tenue de camouflage pour les coeff spectraux
!             que l'on va ranger en balayant le 1/4 de l'ellipse
!             verticalement: axe X=axe n (nb d'onde meridien) et
!             axe Y=axe m (nb d'onde zonal) afin de suivre le rangt
!             dans le modele. Seuls les coeff spectraux qui seront
!             compactes sont stockes sur la grille lat-lon, soit
!             tous sauf ceux des axes et ceux inclus dans le carre
!             delimite par la ss-tronc de non-compactage).
!-----------------------------------------------------------------------
!
! Type de representation de donnees
fa%CADRE(krangc)%NSEC2AL(1)=0
! Nb de pts sur un parallele: valeur manquante
fa%CADRE(krangc)%NSEC2AL(2)=2**16 -1
! Nb de pts sur une longitude: nombre d'onde zonal max -1
! associe au nombre d'onde meridien 1 (les CSP sur les axes sont
! extraits des champs de CSP puisque non compactes)
fa%CADRE(krangc)%NSEC2AL(3)=(fa%CADRE(krangc)%NOZPAR(6)-        &
&                      fa%CADRE(krangc)%NOZPAR(5)+1)/4 -1
! Latitude (1/1000 degre) du premier pt de grille: valeur bidon
fa%CADRE(krangc)%NSEC2AL(4)=0
! Longitude (1/1000 degre) du premier pt de grille: valeur bidon
fa%CADRE(krangc)%NSEC2AL(5)=0
! Flag pour la resolution (128->on donne l'increment: grille reguliere)
fa%CADRE(krangc)%NSEC2AL(6)=0
! Latitude (1/1000 degre) du dernier pt de grille: valeur bidon
fa%CADRE(krangc)%NSEC2AL(7)=40000
! Longitude (1/1000 degre) du dernier pt de grille: valeur bidon
fa%CADRE(krangc)%NSEC2AL(8)=40000
! Increment zonal (1/1000 degre)
fa%CADRE(krangc)%NSEC2AL(9)=2**16 -1
! Increment meridien (1/1000 degre): deduit des valeurs bidon
fa%CADRE(krangc)%NSEC2AL(10)=(fa%CADRE(krangc)%NSEC2AL(7)-fa%CADRE(krangc)%NSEC2AL(4))/ &
&                   (fa%CADRE(krangc)%NSEC2AL(3)-1)
! Flag pour le mode de balayage
fa%CADRE(krangc)%NSEC2AL(11)=0
! Nombre de parametres pour la coord. verticale
fa%CADRE(krangc)%NSEC2AL(12)=0
! Latitude du pole sud de rotation
fa%CADRE(krangc)%NSEC2AL(13)=0
! Longitude du pole sud de rotation
fa%CADRE(krangc)%NSEC2AL(14)=0
! Latitude et longitude du pole d'etirement
fa%CADRE(krangc)%NSEC2AL(15)=0
fa%CADRE(krangc)%NSEC2AL(16)=0
! Flag:      0 -> grille reguliere,  1 -> grille reduite
fa%CADRE(krangc)%NSEC2AL(17)=1
! Flag:      0 -> Terre ronde     , 64 -> Terre ellipsoide
fa%CADRE(krangc)%NSEC2AL(18)=0
! Flag sur les composantes des vecteurs (0->geographique, 8->grille)
fa%CADRE(krangc)%NSEC2AL(19)=0
! Reserves
fa%CADRE(krangc)%NSEC2AL(20:22)=0
! Les valeurs (22+1:22+FA%MTRONC(KRANGC)-1) representant les nb de pts
! le long de chaque parallele (ici, le nb de coeff spectraux
! pour un meme n (et -n), excepte le triangle et les axes non
! compactes) dependent de la ss-troncature qui depend du fichier
! et ne seront donc pas stockes dans le tableau FA%NSEC2AL qui
! depend du cadre. Le tableau FA%NSC2ALF(FA%JPXTRO-1,FA%JPNXFA) les
! contiendra.
!
!**
!     5.  -  KSEC2 POUR LA GRILLE LAMBERT CONFORME (CAS GENERAL ALADIN)
!-------------------------------------------------------------------------
!
! Type de representation de donnees
fa%CADRE(krangc)%NSEC2LA(1)=3
! Nb de pts sur un parallele
fa%CADRE(krangc)%NSEC2LA(2)=fa%CADRE(krangc)%NXLOPA
! Nb de pts sur une longitude
fa%CADRE(krangc)%NSEC2LA(3)=inlat
!
! Les parametres communs sont regroupes
! Flag pour la resolution (128->on donne l'increment: grille reguliere)
fa%CADRE(krangc)%NSEC2LA(6)=128
! Reserve
fa%CADRE(krangc)%NSEC2LA(8)=0
! Flag pour le mode de balayage: W->E et S->N = 64; W->E et N->S = 0
fa%CADRE(krangc)%NSEC2LA(11)=64
! Nombre de parametres pour la coord. verticale
fa%CADRE(krangc)%NSEC2LA(12)=0
! Latitude (1/1000 degre) du premier pt de grille
fa%CADRE(krangc)%NSEC2LA(4)=nint(zramde*zlatpre,kind=jplikb)
! Longitude (1/1000 degre) du premier pt de grille
fa%CADRE(krangc)%NSEC2LA(5)=nint(zramde*zlonpre,kind=jplikb)
!
CALL lon360000 (fa%CADRE(krangc)%NSEC2LA(5))
!
! TEST POUR OLD/NEW EGGX
IF (fa%CADRE(krangc)%SINLAT(1) .GE. 0) THEN
! Old EGGX
! Orientation de la grille
fa%CADRE(krangc)%NSEC2LA(7)=nint(zramde*fa%CADRE(krangc)%SINLAT(8), &
&                          kind=jplikb)
!
CALL lon360000 (fa%CADRE(krangc)%NSEC2LA(7))
! Dimension de la maille dans la direction X
fa%CADRE(krangc)%NSEC2LA(9)=nint(fa%CADRE(krangc)%SINLAT(15),kind=jplikb)
! Dimension de la maille dans la direction Y
fa%CADRE(krangc)%NSEC2LA(10)=nint(fa%CADRE(krangc)%SINLAT(16),kind=jplikb)
! Flag pour le centre de projection
! (0: le pole Nord est sur le plan de projection
!  et 1 seul centre de projection est utilise;
!  128: idem sauf que c'est le pole Sud)
IF (fa%CADRE(krangc)%SINLAT(9).GE.0) THEN
  fa%CADRE(krangc)%NSEC2LA(13)=0
ELSE
  fa%CADRE(krangc)%NSEC2LA(13)=128
ENDIF
! Premiere latitude depuis le pole ou le cone coupe la sphere
fa%CADRE(krangc)%NSEC2LA(14)=nint(zramde*fa%CADRE(krangc)%SINLAT(9), &
&                           kind=jplikb)
! Deuxieme latitude depuis le pole ou le cone coupe la sphere
! Dans Aladin, le plan de projection est rarement secant (cela
! releve plus d'un domaine mal defini que d'un choix) et cette
! possibilite va disparaitre bientot. Comme le calcul de cette
! seconde latitude n'est pas aise (pb de convergence), on va
! declarer la grille tangente! mais avec un WARNING...
fa%CADRE(krangc)%NSEC2LA(15)=fa%CADRE(krangc)%NSEC2LA(14)
IF (abs(fa%CADRE(krangc)%SINLAT(10)-sin(fa%CADRE(krangc)%SINLAT(9))) &
&    .GT.1.e-10_jpdblr .AND. fa%LFAMOP) THEN
  WRITE (unit=fa%NULOUT,fmt=*)                                   &
&          ' FAISC2: WARNING !! La grille Lambert coupe en fait', &
&          ' la sphere, mais sera consideree comme tangente'
ENDIF
ELSE
! NEW EGGX
! Orientation de la grille
fa%CADRE(krangc)%NSEC2LA(7)=nint(zramde*fa%CADRE(krangc)%SINLAT(3), &
&                          kind=jplikb)
!
CALL lon360000 (fa%CADRE(krangc)%NSEC2LA(7))
! Dimension de la maille dans la direction X
fa%CADRE(krangc)%NSEC2LA(9)=nint(fa%CADRE(krangc)%SINLAT(7),kind=jplikb)
! Dimension de la maille dans la direction Y
fa%CADRE(krangc)%NSEC2LA(10)=nint(fa%CADRE(krangc)%SINLAT(8),kind=jplikb)
! Flag pour le centre de projection
! (0: le pole Nord est sur le plan de projection
!  et 1 seul centre de projection est utilise;
!  128: idem sauf que c'est le pole Sud)
IF (fa%CADRE(krangc)%SINLAT(4).GE.0) THEN
  fa%CADRE(krangc)%NSEC2LA(13)=0
ELSE
  fa%CADRE(krangc)%NSEC2LA(13)=128
ENDIF
! Premiere latitude depuis le pole ou le cone coupe la sphere
fa%CADRE(krangc)%NSEC2LA(14)=nint(zramde*fa%CADRE(krangc)%SINLAT(4), &
&                           kind=jplikb)
! NEW EGGX toujours tangent
fa%CADRE(krangc)%NSEC2LA(15)=fa%CADRE(krangc)%NSEC2LA(14)
ENDIF

! Reserve
fa%CADRE(krangc)%NSEC2LA(16)=0
! Flag:      0 -> grille reguliere
fa%CADRE(krangc)%NSEC2LA(17)=0
! Flag:      0 -> Terre ronde     , 64 -> Terre ellipsoide
fa%CADRE(krangc)%NSEC2LA(18)=0
! Flag sur les composantes des vecteurs (0->geographique, 8->grille)
fa%CADRE(krangc)%NSEC2LA(19)=8
! Latitude du pole sud
fa%CADRE(krangc)%NSEC2LA(20)=0
! Longitude du pole sud
fa%CADRE(krangc)%NSEC2LA(21)=0
! Reserve
fa%CADRE(krangc)%NSEC2LA(22)=0
!**
!     6.  -  PARTIE REELLE DE LA SECTION 2 DE GRIBEX
!-----------------------------------------------------------------------
!
600 CONTINUE
! Angle de rotation
fa%CADRE(krangc)%XSEC2(1)=0._jpdblr
! Coefficient d'etirement
fa%CADRE(krangc)%XSEC2(2)=fa%CADRE(krangc)%SCODIL
! Reserve
fa%CADRE(krangc)%XSEC2(3:10)=0._jpdblr
! Parametres pour la coordonnee verticale
fa%CADRE(krangc)%XSEC2(11:11+inivau)=fa%CADRE(krangc)%SFOHYB(1,0:inivau)* &
&                           fa%CADRE(krangc)%SPREFE
fa%CADRE(krangc)%XSEC2(12+inivau:12+2*inivau)= &
&     fa%CADRE(krangc)%SFOHYB(2,0:inivau)
!**
!    10.  -  PHASE TERMINALE : MESSAGERIE, AVEC "ABORT" EVENTUEL,
!            VIA LE SOUS-PROGRAMME "FAIPAR" .
!-----------------------------------------------------------------------
!
1001 CONTINUE
!
IF (fa%LFAMOP.OR.krep.NE.0) THEN
  inimes=2
  clnspr='FAISC2'
  inumer=jpniil
!
  WRITE (unit=clmess,fmt='(''KREP='',I4,'', KRANGC='',I4)') &
&     krep, krangc
  CALL faipar_fort                                      &
&                 (fa, inumer,inimes,krep,.false.,clmess, &
&                  clnspr,clnspr,.false.)
ENDIF

!
IF (lhook) CALL dr_hook('FAISC2_MT',1,zhook_handle)

CONTAINS

SUBROUTINE lon360000 (KLON)

INTEGER (KIND=JPLIKB) :: KLON

klon = modulo(klon, 360000_jplikb)

END SUBROUTINE lon360000

END SUBROUTINE faisc2_fort



! Oct-2012 P. Marguinaud 64b LFI
SUBROUTINE faisc264           &
&           (krep, krangc)
USE fa_mod, ONLY : fa => fa_com_default, &
&                   fa_com_default_init,  &
&                   new_fa_default
USE lfi_precision
IMPLICIT NONE
! Arguments
INTEGER (KIND=JPLIKB)  KREP                                   !   OUT
INTEGER (KIND=JPLIKB)  KRANGC                                 ! IN   

IF (.NOT. fa_com_default_init) CALL new_fa_default ()

CALL faisc2_fort             &
&           (fa, krep, krangc)

END SUBROUTINE faisc264

SUBROUTINE faisc2             &
&           (krep, krangc)
USE fa_mod, ONLY : fa => fa_com_default, &
&                   fa_com_default_init,  &
&                   new_fa_default
USE lfi_precision
IMPLICIT NONE
! Arguments
INTEGER (KIND=JPLIKM)  KREP                                   !   OUT
INTEGER (KIND=JPLIKM)  KRANGC                                 ! IN   

IF (.NOT. fa_com_default_init) CALL new_fa_default ()

CALL faisc2_mt               &
&           (fa, krep, krangc)

END SUBROUTINE faisc2

SUBROUTINE faisc2_mt             &
&           (fa, krep, krangc)
USE fa_mod, ONLY : fa_com
USE lfi_precision
IMPLICIT NONE
! Arguments
type(fa_com)          fa                                     ! INOUT
INTEGER (KIND=JPLIKM)  KREP                                   !   OUT
INTEGER (KIND=JPLIKM)  KRANGC                                 ! IN   
! Local integers
INTEGER (KIND=JPLIKB)  IREP                                   !   OUT
INTEGER (KIND=JPLIKB)  IRANGC                                 ! IN   
! Convert arguments

irangc     = int(    krangc, jplikb)

CALL faisc2_fort             &
&           (fa, irep, irangc)

krep       = int(      irep, jplikm)

END SUBROUTINE faisc2_mt

!INTF KREP            OUT 
!INTF KRANGC        IN