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

Go to the documentation of this file.
00001 C Jan-2011 P. Marguinaud Thread-safe FA
00002       SUBROUTINE FAIS2F_MT (FA,  KREP, KRANG )
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 initialise un tableau "reference" de
00008 C      l'en-tete GRIB, section 2.
00009 C      (routine appelee une seule fois pour un fichier Aladin donne)
00010 C**
00011 C    Arguments : KREP   (Sortie) ==> Code-reponse du sous-programme;
00012 C                KRANG  (Entree) ==> Rang de l'unite logique;
00013 C*
00014 C
00015 #include "precision.h"
00016 C
00017 C
00018       TYPE(FA_COM) :: FA
00019       INTEGER KREP, KRANG
00020 C
00021       INTEGER IRANGC, JM, JMAX, ILOW, IADD, INUMER, INIMES
00022 C
00023 #include "facom2.h"
00024 #include "facom_mt.h"
00025 C**
00026 C     0.  -  INITIALISATIONS ET CONTROLES
00027 C-----------------------------------------------------------------------
00028 C
00029       REAL(KIND=JPRB) :: ZHOOK_HANDLE
00030       IF (LHOOK) CALL DR_HOOK('FAIS2F_MT',0,ZHOOK_HANDLE)
00031       KREP=0
00032       IF (KRANG.LE.0.OR.KRANG.GT.FA%JPNXFA) THEN
00033         KREP=-66
00034         GOTO 1001
00035       ENDIF
00036       IRANGC=FA%NUCADR(KRANG)
00037 C**
00038 C     1.  -  INITIALISATION DU TABLEAU FA%NSC2ALF
00039 C-----------------------------------------------------------------------
00040 C
00041 C  Les valeurs de ce tableau representent les nb de pts
00042 C le long de chaque "parallele" (ici, le nb de coeff spectraux
00043 C pour un meme m (nb d'onde zonal), excepte le triangle et les axes non
00044 C compactes). Il s'agit en effet de deguiser un champ spectral 
00045 C Aladin en champ pts de grille (grille lat-lon) pour profiter
00046 C du compactage, voire de la compression, GRIBEX.
00047 C Le rangt des CSP est fait verticalement (par colonne de m=cst)
00048 C et pour chaque couple (m,n) correspond 4 CSP.
00049 C
00050       JMAX = (FA%NOZPAR(6,IRANGC)-FA%NOZPAR(5,IRANGC)+1)/4 -1
00051       DO JM=1,JMAX
00052         ILOW=2+2*JM+1
00053         IADD=4* MAX(FA%NSTROF(KRANG)+1-JM,1)
00054 C
00055         FA%NSC2ALF(JM,KRANG)=FA%NOMPAR(ILOW+1,IRANGC)-
00056      S                        (FA%NOMPAR(ILOW,IRANGC)+IADD)+1
00057       ENDDO
00058 C**
00059 C    10.  -  PHASE TERMINALE : MESSAGERIE, AVEC "ABORT" EVENTUEL,
00060 C            VIA LE SOUS-PROGRAMME "FAIPAR" .
00061 C-----------------------------------------------------------------------
00062 C
00063  1001 CONTINUE
00064       LLFATA=LLMOER (KREP,KRANG)
00065 C
00066       IF (FA%LFAMOP.OR.LLFATA) THEN
00067         INIMES=2
00068         CLNSPR='FAIS2F'
00069         INUMER=FA%JPNIIL
00070 C
00071         WRITE (UNIT=CLMESS,FMT='(''KREP='',I4,'', KRANG='',I4)')
00072      S     KREP, KRANG
00073         CALL FAIPAR_MT (FA, INUMER,INIMES,KREP,.FALSE.,CLMESS,
00074      S                  CLNSPR,CLNSPR,.FALSE.)
00075       ENDIF
00076 C
00077       IF (LHOOK) CALL DR_HOOK('FAIS2F_MT',1,ZHOOK_HANDLE)
00078       END
00079