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

Go to the documentation of this file.
00001 C Jan-2011 P. Marguinaud Thread-safe FA
00002       SUBROUTINE FARINE_MT (FA,  KOPTIO )
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 du logiciel
00008 C     de Fichiers ARPEGE FA ( Routine d'INitialisation )
00009 C**
00010 C        Argument : KOPTIO  ==> OPTION concernant le mode d'utilisation.
00011 C                  (Entree)     (MULTI-TACHE ou NON)
00012 C     VALEURS POSSIBLES : 0 ==> Mode MONO-Tache prescrit;
00013 C                         1 ==> Mode MULTI-Taches prescrit;
00014 C                         2 ==> Utilisation du mode par defaut si c'est
00015 C                               le premier appel; sinon on garde le mode
00016 C                               prescrit anterieurement .
00017 C
00018 #include "precision.h"
00019 C
00020 C
00021       TYPE(FA_COM) :: FA
00022       INTEGER KOPTIO
00023 C
00024       INTEGER IREP, J, JN, IDEBUT, IFIN, INDM, INDN, INIMES, INUMER
00025       INTEGER JJPUIS, INCHIF
00026 C
00027       LOGICAL LLNMUL, LLASGN, LLREL
00028 C
00029 C
00030 #include "facom2.h"
00031 #include "facom_mt.h"
00032 C
00033       REAL(KIND=JPRB) :: ZHOOK_HANDLE
00034       IF (LHOOK) CALL DR_HOOK('FARINE_MT',0,ZHOOK_HANDLE)
00035       IF (KOPTIO.LT.0.OR.KOPTIO.GT.2) THEN
00036         IREP=-52
00037         GOTO 1001
00038       ENDIF
00039 C
00040       IF (FA%FARINE_LLPREA) THEN
00041 C
00042 C         C'EST LE PREMIER APPEL AU sous-programme - INITIALISATIONS .
00043 C
00044         FA%NFIOUV=0
00045         FA%NCADEF=0
00046         FA%NRFAGA=1
00047         FA%NIMSGA=1
00048         FA%NBIPDG=24
00049         FA%NBICSP=24
00050         FA%NPUILA=1
00051         FA%NSTROI=10
00052         FA%NMIDPL=5
00053         FA%NIGRIB=2
00054         FA%LFAMOP=.FALSE.
00055         FA%LERRFA(0)=.TRUE.
00056         FA%NIVOMS(0)=0
00057         FA%NCPCAD=LEN (FA%CNOMCA(1))
00058         FA%SPSMIN=45000.
00059         FA%SPSMAX=110000.
00060         FA%MPRESX=100000
00061         FA%NBIMAC=64
00062         FA%NBIMAX=31
00063         FA%LIGARD=.FALSE.
00064         FA%NTYPTX=2
00065         FA%NXNIVV=FA%JPXNIV
00066         FA%NXTRON=FA%JPXTRO
00067         FA%NXLATI=FA%JPXLAT
00068         FA%NXLONG=FA%JPXLON
00069 C
00070         DO 101 J=1,FA%JPNXFA
00071           FA%NULOGI(J)=FA%JPNIIL
00072           FA%NRASHO(J)=0
00073           FA%NRASVE(J)=0
00074   101   CONTINUE
00075 C
00076         DO 102 J=1,FA%JPNXCA
00077           FA%CNOMCA(J)=' '
00078   102   CONTINUE
00079 C
00080         DO 1020 J=1,FA%JPXNOM
00081           FA%CHAINC(J:J)='?'
00082  1020   CONTINUE
00083 C
00084 C        Descripteurs lies aux types de niveaux verticaux:
00085 C        prefixes reconnus, extrema possibles du niveau dans le cas
00086 C        d'une coordonnee verticale, premiers elements de xB1PAR.
00087 C
00088         DO 111 J=0,FA%JPTNIV
00089 C
00090 C       Initialisation par defaut pour la serie d'affectations qui suit.
00091 C
00092           FA%NIVDSC(0,J)=0
00093           FA%NIVDSC(1,J)=0
00094           FA%NIVDSC(2,J)=0
00095 C
00096 C        Tous les cas sont reputes "niveau vrai" (pas des couches).
00097 C
00098           FA%NIVDSC(4,J)=0
00099   111   CONTINUE
00100 C
00101 C           Cas du type non reconnu.
00102 C
00103         FA%NIVDSC(0,0)=0
00104         FA%NIVDSC(3,0)=200
00105 C
00106 C           Niveau hybride.
00107 C
00108         FA%CTNPRF(1)='S'
00109         FA%NIVDSC(0,1)=3
00110         FA%NIVDSC(2,1)=FA%JPXNIV
00111         FA%NIVDSC(3,1)=109
00112 C
00113 C           Niveau isobare.
00114 C
00115         FA%CTNPRF(2)='P'
00116         FA%NIVDSC(0,2)=5
00117         FA%NIVDSC(1,2)=1
00118         FA%NIVDSC(2,2)=10**5
00119         FA%NIVDSC(3,2)=100
00120 C
00121 C           Niveau iso-hauteur (au-dessus d'un relief de reference).
00122 C
00123         FA%CTNPRF(3)='H'
00124         FA%NIVDSC(0,3)=5
00125         FA%NIVDSC(2,3)=10**5-1
00126         FA%NIVDSC(3,3)=105
00127 C
00128 C           Niveau iso-tourbillon_potentiel.
00129 C
00130         FA%CTNPRF(4)='V'
00131         FA%NIVDSC(0,4)=3
00132         FA%NIVDSC(2,4)=10**3-1
00133         FA%NIVDSC(3,4)=117
00134 C
00135 C           Niveau iso-temperature_potentielle.
00136 C
00137         FA%CTNPRF(5)='T'
00138         FA%NIVDSC(0,5)=3
00139         FA%NIVDSC(2,5)=10**3-1
00140         FA%NIVDSC(3,5)=113
00141 C
00142 C           Niveau surface.
00143 C
00144         FA%CTNPRF(6)='SURF'
00145         FA%NIVDSC(3,6)=1
00146 C
00147 C           Niveau de vent max (jet).
00148 C
00149         FA%CTNPRF(7)='JET'
00150         FA%NIVDSC(3,7)=6
00151 C
00152 C           Niveau surface.
00153 C
00154         FA%CTNPRF(8)='TROPO'
00155         FA%NIVDSC(3,8)=7
00156 C
00157 C           Niveau moyen de la mer.
00158 C
00159         FA%CTNPRF(9)='MER'
00160         FA%NIVDSC(3,9)=102
00161 C
00162 C           Niveau hybride bis pour MOCAGE
00163 C
00164         FA%CTNPRF(10)='L'
00165         FA%NIVDSC(0,10)=3
00166         FA%NIVDSC(2,10)=FA%JPXNIV
00167 C  
00168 C           Niveau iso-temperature.
00169 C
00170         FA%CTNPRF(11)='KB'
00171         FA%NIVDSC(0,11)=3
00172         FA%NIVDSC(2,11)=10**3-1
00173         FA%NIVDSC(3,11)=113
00174 C
00175         FA%CTNPRF(12)='KT'
00176         FA%NIVDSC(0,12)=3
00177         FA%NIVDSC(2,12)=10**3-1
00178         FA%NIVDSC(3,12)=113
00179 
00180 C
00181 C  Initialisations pour la mise en oeuvre de GRIBEX
00182 C
00183 C  1/ On force GRIBEX a calculer la puissance de laplacien
00184 C        CALL GRSMKP(1)
00185 C  2/ On retire l'arrondi du message GRIB a un multiple de 120 octets
00186 C        CALL GRSRND(0)
00187 C
00188 C  3/ Creation de la correspondance "nom article FA" et
00189 C                                   "descripteurs GRIBEX"
00190         CALL FAICOR_MT (FA)
00191 C
00192 C
00193 C  4/ Definition du codage GRIBEX par defaut:
00194 C
00195 C  Il s'agit d'une compression "APAC1" (meilleure solution entre
00196 C  l'absence de compression et la compression ligne a ligne)
00197 C  associee a la compression "general extended", a la differentiation
00198 C  spatiale (-1: calcul dynamique de l'ordre) et au rearrangement
00199 C  boustrophedonique.
00200 C
00201 C  "APAC1"
00202         FA%NCODGRI(1) = 1
00203         FA%NCODGRI(2) = 16
00204         FA%NCODGRI(3) = 0
00205         FA%NCODGRI(4) = 0
00206         FA%NCODGRI(5) = 16
00207         FA%NCODGRI(6) = 0
00208 C  compression "general extended"
00209         FA%NCODGRI(7) = 8
00210 C  arrangement boustrophedonique
00211         FA%NCODGRI(8) = 4
00212 C  differentiation spatiale
00213         FA%NCODGRI( 9)= 0
00214         FA%NCODGRI(10)= -1
00215 C
00216 C  5/ Initialisation de logiques pilotant des initialisations ulterieures
00217 C
00218 C  Il faudra initialiser XLAPxDx
00219         FA%LIXLAP=.TRUE.
00220 C  Il ne faut pas initialiser FLAP1Dx(): on attend l'ouverture du fichier
00221         FA%LIFLAP(:)=.FALSE.
00222 C  Il faudra initialiser le tableau FA%NSEC1 (section 1 GRIBEX) via FAISC1
00223         FA%LISEC1(:)=.TRUE.
00224 C  Il faudra initialiser les tableaux NSEC2xxx et FA%XSEC2
00225 C  (section 2 GRIBEX) via FAISC2
00226         FA%LISEC2(:)=.TRUE.
00227 C  Il faudra initialiser le tableau FA%NSC2ALF
00228 C  (section 2 GRIBEX) via FAIS2F
00229         FA%LISC2F(:)=.TRUE.
00230 C
00231         FA%FARINE_LLPREA=.FALSE.
00232         LLNMUL=(KOPTIO.EQ.1).OR.(KOPTIO.EQ.2.AND.FA%FARINE_LLDEFM)
00233         LLASGN=LLNMUL
00234         LLREL=.FALSE.
00235         CALL LFIINI_MT(FA%LFI, KOPTIO)
00236 C
00237       ELSEIF (KOPTIO.EQ.2) THEN
00238 C
00239 C         CE N'EST PAS LE PREMIER APPEL, MAIS COMME L'ARGUMENT VAUT 2,
00240 C         ON LAISSE LES CHOSES EN PLACE .
00241 C
00242         LLNMUL=FA%LFAMUL
00243         LLASGN=.FALSE.
00244         LLREL =.FALSE.
00245 C
00246       ELSE
00247         LLNMUL=KOPTIO.EQ.1
00248         LLASGN=LLNMUL.AND.(.NOT.FA%LFAMUL)
00249         LLREL =(.NOT.LLNMUL).AND.FA%LFAMUL
00250 C
00251 C     CE N'EST PAS LE PREMIER APPEL ET LE MODE EST PASSE 'EXPLICITEMENT'
00252 C
00253         IF ((LLASGN.OR.LLREL).AND.FA%NFIOUV.NE.0) THEN
00254           IREP=-54
00255           GOTO 1001
00256         ENDIF
00257 C
00258         CALL LFIINI_MT(FA%LFI, KOPTIO)
00259 C
00260       ENDIF
00261 C
00262       FA%LFAMUL=LLNMUL
00263       IREP=0
00264 C
00265       IF (LLASGN) THEN
00266         CALL LFIVER_MT (FA%LFI, FA%VRGLAS,'ASGN')
00267       ELSEIF (LLREL) THEN
00268         CALL LFIVER_MT (FA%LFI, FA%VRGLAS,'REL')
00269       ENDIF
00270 C
00271  1001 CONTINUE
00272 C
00273 C        MESSAGERIE EVENTUELLE, AVEC ABORT SI NECESSAIRE .
00274 C
00275       LLFATA=IREP.NE.0.AND.FA%NRFAGA.NE.2
00276 C
00277       IF (LLFATA.OR.FA%LFAMOP) THEN
00278         INIMES=2
00279       ELSEIF (IREP.NE.0) THEN
00280         INIMES=0
00281       ELSEIF (FA%NIMSGA.EQ.2) THEN
00282         INIMES=2
00283       ELSE
00284         IF (LHOOK) CALL DR_HOOK('FARINE_MT',1,ZHOOK_HANDLE)
00285         RETURN
00286       ENDIF
00287 C
00288       CLNSPR='FARINE'
00289       INUMER=FA%JPNIIL
00290 C
00291       IF (MAX (INIMES,FA%NIMSGA).EQ.2) THEN
00292         WRITE (UNIT=CLMESS,
00293      S         FMT='(''KOPTIO='',I5,'', CODE INTERNE='',I4)'
00294      S         ) KOPTIO,IREP
00295         IF (INIMES.NE.2) CALL FAIPAR_MT (FA, INUMER,FA%NIMSGA,IREP,
00296      S                                .FALSE.,CLMESS,
00297      S                                CLNSPR,CLACTI,.FALSE.)
00298       ENDIF
00299 C
00300       CALL FAIPAR_MT (FA, INUMER,INIMES,IREP,LLFATA,CLMESS,
00301      S             CLNSPR,CLACTI,.FALSE.)
00302 C
00303       IF (LHOOK) CALL DR_HOOK('FARINE_MT',1,ZHOOK_HANDLE)
00304       END
00305