|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 C Jan-2011 P. Marguinaud Thread-safe FA 00002 SUBROUTINE FAINIG_MT (FA, KREP, KRANG, CDPREF, KNIVAU, CDSUFF, 00003 S LDCOSP, KLCHAM, KSEC1, KSEC2, PSEC2, KSEC3, 00004 S PSEC3, KSEC4 ) 00005 USE FA_MOD, ONLY : FA_COM 00006 USE PARKIND1, ONLY : JPRB 00007 USE YOMHOOK , ONLY : LHOOK, DR_HOOK 00008 C**** 00009 C Sous-programme INTERNE du logiciel de Fichiers ARPEGE: 00010 C INItialisation de l'entete Gribex d'un champ. 00011 C** 00012 C Arguments : KREP (Sortie) ==> Code-reponse du sous-programme; 00013 C KRANG (Entree) ==> Rang de l'unite logique; 00014 C CDPREF (Entree) ==> Prefixe eventuel du nom d'article; 00015 C KNIVAU (Entree) ==> Niveau vertical eventuel; 00016 C CDSUFF (Entree) ==> Suffixe eventuel du nom d'article; 00017 C LDCOSP (Entree) ==> Vrai si le champ est represente 00018 C par des coefficients spectraux; 00019 C KLCHAM (Entree) ==> Longueur totale du champ; 00020 C ( Tableau ) KSEC1 (Sortie) ==> Image des parametres de la section 1 00021 C de GRIBEX; 00022 C KSEC2 (Sortie) ==> Image des parametres de la section 2 00023 C de GRIBEX, partie entiere; 00024 C PSEC2 (Sortie) ==> Image des parametres de la section 2 00025 C de GRIBEX, partie reelle; 00026 C KSEC3 (Sortie) ==> Image des parametres de la section 3 00027 C de GRIBEX, partie entiere; 00028 C PSEC3 (Sortie) ==> Image des parametres de la section 3 00029 C de GRIBEX, partie reelle; 00030 C KSEC4 (Sortie) ==> Image des parametres de la section 4 00031 C de GRIBEX, partie entiere; 00032 C* 00033 C Modifications 00034 C ------------- 00035 C R. El Ouaraini: 03-Oct-06 introduction du new EGGX pour tester ERPK 00036 C R. El Khatib : 11-Aug-2009 Bugfix for non-square geometries 00037 C 00038 C 00039 C 00040 #include "precision.h" 00041 C 00042 C 00043 TYPE(FA_COM) :: FA 00044 REAL (KIND=JPDBLR) PSEC3(*), PSEC2(*) 00045 C 00046 INTEGER KREP, KRANG, KNIVAU, KLCHAM, KSEC1(*), KSEC2(*), KSEC3(*) 00047 INTEGER KSEC4(*) 00048 C 00049 CHARACTER CDPREF*(*), CDSUFF*(*) 00050 C 00051 LOGICAL LDCOSP 00052 C 00053 INTEGER IRANGC, INIMES, INUMER, INLAT, INIVAU, INBITS 00054 INTEGER INIPAR(6), ICPACK 00055 C 00056 LOGICAL LLMLAM 00057 C 00058 INTRINSIC LEN_TRIM 00059 C 00060 #include "facom2.h" 00061 #include "facom_mt.h" 00062 C** 00063 C 0. - CONTROLES ET INITIALISATIONS PREALABLES 00064 C----------------------------------------------------------------------- 00065 C 00066 C Controle de la bonne initialisation de la date 00067 C 00068 C 00069 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00070 IF (LHOOK) CALL DR_HOOK('FAINIG_MT',0,ZHOOK_HANDLE) 00071 IF (FA%LCREAF(KRANG)) THEN 00072 KREP=-85 00073 GOTO 1001 00074 ENDIF 00075 ICPACK=FA%NSTROF(KRANG) 00076 IRANGC=FA%NUCADR(KRANG) 00077 INLAT=FA%NLATIT(IRANGC) 00078 INIVAU=FA%NNIVER(IRANGC) 00079 LLMLAM=FA%LIMLAM(IRANGC) 00080 IF (LDCOSP) THEN 00081 INBITS=FA%NBFCSP(KRANG) 00082 ELSE 00083 INBITS=FA%NBFPDG(KRANG) 00084 ENDIF 00085 C 00086 C** 00087 C 1. - SECTION 1: the product definition section 00088 C----------------------------------------------------------------------- 00089 C 00090 C Appel a FAISC1 une seule fois pour un fichier: initialisation 00091 C du tableau FA%NSEC1(2:21,KRANG) qui va servir comme base pour KSEC1: 00092 C 00093 IF (FA%LISEC1(KRANG)) THEN 00094 CALL FAISC1_MT(FA, KREP,KRANG) 00095 IF (KREP.NE.0) GOTO 1001 00096 FA%LISEC1(KRANG)=.FALSE. 00097 ENDIF 00098 KSEC1(1:FA%JPSEC1)=0 00099 KSEC1(2:21)=FA%NSEC1(2:21,KRANG) 00100 C 00101 C Initialisation de INIPAR (5 elts de KSEC1 (1 et 6:9) et un indicateur 00102 C de type de champ: 0->RAS; 2->min/max; 4->cumul) 00103 CALL FAIPAG_MT (FA, KREP, KRANG, CDPREF, KNIVAU, CDSUFF, INIPAR ) 00104 IF (KREP.NE.0) GOTO 1001 00105 C Element 1: version number of code table 2 00106 KSEC1(1) = INIPAR(1) 00107 C Element 6: parameter indicator 00108 KSEC1(6) = INIPAR(2) 00109 IF (INIPAR(2).LT.0.OR.INIPAR(2).GT.254.AND.FA%LFAMOP) THEN 00110 WRITE (UNIT=FA%NULOUT,FMT=*) 00111 S '----------------------------------------------------' 00112 WRITE (UNIT=FA%NULOUT,FMT=*) 00113 S ' FAINIG: warning, parameter indicator not defined' 00114 WRITE (UNIT=FA%NULOUT,FMT=*) 00115 S 'for: ',CDPREF,' ',CDSUFF,'. Set to 255, by default' 00116 WRITE (UNIT=FA%NULOUT,FMT=*) 00117 S '----------------------------------------------------' 00118 KSEC1(6) = 255 00119 ENDIF 00120 C Element 7: type of level indicator 00121 KSEC1(7) = INIPAR(3) 00122 C Element 8: height, pressure, etc of level or top of level 00123 KSEC1(8) = INIPAR(4) 00124 C Element 9: height, pressure, etc of level or bottom of level 00125 KSEC1(9) = INIPAR(5) 00126 C Cas de la periode de reference 00127 IF (INIPAR(6)==2) THEN 00128 C Convention dans FA (depuis fin 2000): l'echeance precedente 00129 C est stockee dans FA%MADATE(10,KRANG). 00130 KSEC1(17)=KSEC1(16) 00131 KSEC1(16)=FA%MADATE(10,KRANG) 00132 KSEC1(18)=2 00133 C Cas du cumul 00134 ELSEIF (INIPAR(6)==4) THEN 00135 KSEC1(17)=KSEC1(16) 00136 KSEC1(16)=FA%MADATE(10,KRANG) 00137 KSEC1(18)=4 00138 C Nb de produits inclus dans le cumul: valeur bidon de 1 00139 KSEC1(19)=1 00140 ENDIF 00141 C** 00142 C 2. - SECTION 2: the grid definition section 00143 C----------------------------------------------------------------------- 00144 C 00145 C Appel a FAISC2 une seule fois pour un cadre, pour initialiser 00146 C les tableaux NSEC2xxx et FA%XSEC2. 00147 C 00148 IF (FA%LISEC2(IRANGC)) THEN 00149 CALL FAISC2_MT(FA, KREP,IRANGC) 00150 IF (KREP.NE.0) GOTO 1001 00151 FA%LISEC2(IRANGC)=.FALSE. 00152 ENDIF 00153 C 00154 C Appel a FAIS2F une seule fois pour un fichier Aladin, 00155 C pour initialiser le tableau FA%NSC2ALF (sauf redefinition 00156 C de la ss-tronc dans FAGOTE). 00157 C 00158 IF (LLMLAM.AND.FA%LISC2F(KRANG)) THEN 00159 CALL FAIS2F_MT(FA, KREP,KRANG) 00160 IF (KREP.NE.0) GOTO 1001 00161 FA%LISC2F(KRANG)=.FALSE. 00162 ENDIF 00163 KSEC2(1:FA%JPSEC2)=0 00164 IF (LLMLAM) THEN 00165 IF (LDCOSP) THEN 00166 C Le champ spectral que l'on doit coder va etre represente sur une 00167 C grille lat-lon quasi-reguliere puisque ce type de coeff. spectraux 00168 C n'est pas pris en compte dans GRIBEX. 00169 KSEC2(1:22)=FA%NSEC2AL(1:22,IRANGC) 00170 KSEC2(23:21+FA%NOMPAR(2,IRANGC))= 00171 S FA%NSC2ALF(1:FA%NOMPAR(2,IRANGC)-1,KRANG) 00172 ELSE 00173 IF (FA%SINLAT(1,IRANGC) .GE. 0) THEN 00174 C Old EGGX 00175 IF (FA%SINLAT(10,IRANGC).LT.0) THEN 00176 C Parametre de projection negatif, donc pas de projection 00177 C La grille de ce cadre est une grille lat-lon reguliere 00178 C du type Full-Pos (pour champ ARPEGE ou Aladin) 00179 KSEC2(1:22)=FA%NSEC2LL(1:22,IRANGC) 00180 ELSE 00181 C La grille de ce cadre est donc du type Lambert conforme 00182 C (cas general de la grille Aladin) 00183 KSEC2(1:22)=FA%NSEC2LA(1:22,IRANGC) 00184 ENDIF 00185 ELSE 00186 C New EGGX 00187 IF (FA%SINLAT(2,IRANGC).LT.0) THEN 00188 KSEC2(1:22)=FA%NSEC2LL(1:22,IRANGC) 00189 ELSE 00190 KSEC2(1:22)=FA%NSEC2LA(1:22,IRANGC) 00191 ENDIF 00192 ENDIF 00193 ENDIF 00194 ELSE 00195 IF (LDCOSP) THEN 00196 KSEC2(1:22)=FA%NSEC2SP(1:22,IRANGC) 00197 ELSE 00198 KSEC2(1:22+INLAT)=FA%NSEC2GG(1:22+INLAT,IRANGC) 00199 ENDIF 00200 ENDIF 00201 C 00202 C Controle ultime: on regarde le prefixe pour s'assurer de la 00203 C presence ou non d'une coordonnee hybride sur la verticale, 00204 C seul cas qui impose une description dans la section 2 reelle. 00205 C 00206 IF (CDPREF=='S') THEN 00207 KSEC2(12)=2*(INIVAU+1) 00208 ELSE 00209 KSEC2(12)=0 00210 ENDIF 00211 C 00212 PSEC2(1:10+KSEC2(12))=FA%XSEC2(1:10+KSEC2(12),IRANGC) 00213 C** 00214 C 3. - SECTION 3: the bitmap section 00215 C As KSEC1(5)=128, the Section 3 is omitted => dummy values 00216 C----------------------------------------------------------------------- 00217 C 00218 C 3.1 - INTEGER PART 00219 C 00220 C Flag: 0->bitmap included in the GRIB message, 1->not included 00221 KSEC3(1)=1 00222 C Value used at missing data points in an INTEGER data field 00223 KSEC3(2)=0 00224 C 00225 C 3.2 - REAL PART 00226 C 00227 C Ignored 00228 PSEC3(1)=0. 00229 C Value used at missing data points in an REAL data field 00230 PSEC3(2)=0. 00231 C** 00232 C 4. - SECTION 4: the binary data section (integer part only) 00233 C----------------------------------------------------------------------- 00234 C 00235 C 1: Nb of data values in array PSEC4 to be encoded 00236 KSEC4(1)=KLCHAM 00237 C 2: Nb of bits used for each encoded value 00238 KSEC4(2)=INBITS 00239 C 3: Type of data (0:grid point; 128:spherical harmonic coeff) 00240 KSEC4(3)=0 00241 C 4: Type of packing, only for spectral fields 00242 C but also to allow 2nd-order packing for grid points fields 00243 C and for Aladin spectral fields (seen as lat-lon grid points 00244 C by GRIBEX). 00245 C (0:simple packing; 64:complex packing and 2nd-order packing) 00246 IF (FA%NCOGRIF(2,KRANG)==0) THEN 00247 C If no Additional flags, then 2nd-order packing is not asked! 00248 KSEC4(4)=0 00249 ELSE 00250 KSEC4(4)=64 00251 ENDIF 00252 IF (LDCOSP.AND..NOT.LLMLAM) THEN 00253 C For spherical harmonics coeff, complex packing is always done 00254 KSEC4(3)=128 00255 KSEC4(4)=64 00256 ENDIF 00257 C 5: Data representation (0:float; 32:integer) 00258 KSEC4(5)=0 00259 C 6: Additional flags indicator (0:no; 16:yes) 00260 KSEC4(6)=FA%NCOGRIF(2,KRANG) 00261 IF (LDCOSP.AND..NOT.LLMLAM) THEN 00262 C For spherical harmonics coeff, additional flags indicator=0 00263 KSEC4(6)=0 00264 ENDIF 00265 C 7: Reserved 00266 KSEC4(7)=FA%NCOGRIF(3,KRANG) 00267 C 8: Nb of values indicator (0:single datum at each grid point; 64:matrix) 00268 KSEC4(8)=0 00269 C 9: Secondary bitmaps indicator (0:no; 32:yes) 00270 KSEC4(9)=FA%NCOGRIF(4,KRANG) 00271 C 10: Values width indicator (0:2nd order values have constant width; 16:not) 00272 KSEC4(10)=FA%NCOGRIF(5,KRANG) 00273 C 11: Nb of bits for 2nd order values when these have constant width 00274 KSEC4(11)=FA%NCOGRIF(6,KRANG) 00275 IF (KSEC4(11).EQ.-99) KSEC4(11)=1-INBITS 00276 C 12: General extended 2nd order packing (0:no; 8:yes) 00277 C 13: Boustrophedonic ordering (0:no; 4:yes) 00278 C 14,15: give the order of spatial differencing; if 0,0 then option rejected 00279 KSEC4(12:15)=FA%NCOGRIF(7:10,KRANG) 00280 C 16: For complex packing, a pointer to the start of packed data values (octet nb) 00281 KSEC4(16)=0 00282 C 17: For complex packing, the scaling factor factor P, stored as the INTEGER 00283 C value P*1000 (in the range -10000,+10000): defined later 00284 KSEC4(17)=0 00285 C 18: For complex packing, the pentagonal resolution parameter J specifying 00286 C the truncation of the subset of the data not packed (32 bits) 00287 KSEC4(18)=0 00288 C 19-20: Idem 18 for resolution parameters K and M 00289 KSEC4(19)=0 00290 KSEC4(20)=0 00291 IF (LDCOSP.AND..NOT.LLMLAM) THEN 00292 C For spherical harmonics coeff (ARPEGE) only 00293 KSEC4(18)=ICPACK 00294 KSEC4(19)=ICPACK 00295 KSEC4(20)=ICPACK 00296 ENDIF 00297 C 21-33: Reserved 00298 C 34-42: 'X' decoding option 00299 KSEC4(21:FA%JPSEC4)=0 00300 C** 00301 C 10. - PHASE TERMINALE : MESSAGERIE, AVEC "ABORT" EVENTUEL, 00302 C VIA LE SOUS-PROGRAMME "FAIPAR" . 00303 C----------------------------------------------------------------------- 00304 C 00305 1001 CONTINUE 00306 LLFATA=LLMOER (KREP,KRANG) 00307 C 00308 IF (FA%LFAMOP.OR.LLFATA) THEN 00309 INIMES=2 00310 CLNSPR='FAINIG' 00311 INUMER=FA%JPNIIL 00312 C 00313 WRITE (UNIT=CLMESS,FMT='(''KREP='',I4,'', KRANG=' 00314 ',I4, S '', CDPREF='''''',A,'''''', KNIVAU=' 00315 ',I6, S '', CDSUFF='''''',A,'''''', LDCOSP= '',L1)') 00316 S KREP,KRANG,CDPREF(1:LEN_TRIM(CDPREF)),KNIVAU, 00317 S CDSUFF(1:LEN_TRIM(CDSUFF)),LDCOSP 00318 CALL FAIPAR_MT (FA, INUMER,INIMES,KREP,.FALSE.,CLMESS, 00319 S CLNSPR, 00320 S CLNSPR,.FALSE.) 00321 ENDIF 00322 C 00323 IF (LHOOK) CALL DR_HOOK('FAINIG_MT',1,ZHOOK_HANDLE) 00324 END 00325
1.8.0
