|
SURFEX v7.3
General documentation of Surfex
|
|
SURFEX v7.3
General documentation of Surfex
|
00001 C Jan-2011 P. Marguinaud Interface to thread-safe LFI 00002 MODULE LFIMOD 00003 USE PARKIND1, ONLY : JPIM 00004 IMPLICIT NONE 00005 #include "precision.h" 00006 C 00007 C----- DESCRIPTION DES "PARAMETER" DU LOGICIEL DE FICHIERS INDEXES ----- 00008 C----- (et des variables logiques a charger absolument partout ) ----- 00009 C 00010 C JPNBIM = NOMBRE DE BITS PAR MOT MACHINE 00011 C JPNBIC = NOMBRE DE BITS PAR CARACTERE 00012 C JPNCMO = NOMBRE DE CARACTERES PAR MOT MACHINE 00013 C 00014 C JPNCPN = NOMBRE MAXI. POSSIBLE DE CARACTERES PAR NOM D'ARTICLE 00015 C JPLARD = LONGUEUR D'ARTICLE "PHYSIQUE" elementaire des Fichiers 00016 C ( exprimee en mots, DOIT ETRE PAIRE, SUPERIEURE OU EGALE 00017 C a JPLDOC, JPLARD*JPNCMO DOIT ETRE MULTIPLE DE JPNCPN ) 00018 C JPLARC = Longueur d'article "physique" exprimee en caracteres 00019 C JPRECL = PARAMETRE "RECL" de base POUR "OPEN" DES FICHIERS 00020 C JPNXFI = NOMBRE MAXIMUM DE FICHIERS INDEXES OUVERTS SIMULTANEMENT 00021 C (1 fichier de "multiplicite" N comptant comme N fichiers) 00022 C JPFACX = FACteur multiplicateur maXimum entre longueur d'article 00023 C physique effective et elementaire ( de 1 a JPNXFI ) 00024 C JPXUFM = Nombre maXimum d'Unites logiques a Facteur Mul. predefini 00025 C JPNPIA = NOMBRE DE *PAIRES* DE "PAGES D'INDEX" EN MEMOIRE 00026 C *PREALLOUEES* PAR UNITE LOGIQUE ( AU MOINS *4* ) 00027 C JPNXPI = NOMBRE TOTAL DE *PAIRES* DE "PAGES D'INDEX" EN MEMOIRE 00028 C ALLOUABLES ( DOIT ETRE AU MOINS EGAL A JPNPIA*JPNXFI ) 00029 C JPNPIS = NOMBRE DE *PAIRES* DE "PAGES D'INDEX" NON PREALLOUEES 00030 C JPNXNA = NOMBRE MAXI. DE NOMS D'ARTICLES PAR PAGE/ARTICLE D'INDEX 00031 C JPNBLP = NOMBRE MAXI. DE COUPLES (LONGUEUR/POSITION)" " " 00032 C JPNAPP = NOMBRE MAXI. UTILE DE NOMS D'ARTICLES PAR PAGE/AR D'INDEX 00033 C JPLDOC = LONGUEUR (MOTS) DE LA PARTIE DOCUMENTAIRE DU 1ER ARTICLE 00034 C JPNPDF = NOMBRE DE PAGES DE DONNEES PAR FICHIER OUVERT ( >= 2 ) 00035 C JPNXPR = NOMBRE MAXIMUM DE PAIRES D'ARTICLES D'INDEX RESERVABLES 00036 C JPNIL = CODE DE "VALEUR ABSENTE" POUR CERTAINES TABLES D'ENTIERS. 00037 C JPNMPN = NOMBRE DE MOTS NECESSAIRE AU STOCKAGE D'UN NOM D'ARTICLE 00038 C JPNAPX = JPNAPP*JPFACX 00039 C JPLARX = JPLARD*JPFACX = longueur d'article physique maximale 00040 C JPLFTX = Longueur maximale traitable des noms de fichiers. 00041 C JPLFIX = " " imprimable " " " " . 00042 C JPLSPX = " " des noms des sous-programmes du logiciel. 00043 C JPLSTX = " " des valeurs du "STATUS" FORTRAN (open/close). 00044 C JPCFMX = Nombre maximum de ConFigurations pour iMport/eXport. 00045 C JPIMEX = " " de fichiers imp/exportables "simultanement". 00046 C JPDEXP = Dimension tableau Descripteurs EXPlicites d'imp/export. 00047 C JPDIMP = " " " IMPlicites " " " . 00048 C JPXDAM = Nombre maXimum noms D'Articles d'imp/export en Memoire. 00049 C JPXCIE = " " de Caracteres par nom pour Import/Export. 00050 C JPXMET = " " " " " " avec METacaracteres. 00051 C JPXCCF = " " " " des noms de ConFig. imp/exp. 00052 C JPTYMX = " de TYpes de variables valides pour Import/Export. 00053 C 00054 C 00055 C 00056 INTEGER, PARAMETER :: JPLSTX = 7 00057 INTEGER, PARAMETER :: JPNBST = 4 00058 INTEGER, PARAMETER :: JPNCPN = 16 00059 INTEGER, PARAMETER :: JPLFTX = 512 00060 INTEGER, PARAMETER :: JPXCCF = 16 00061 INTEGER, PARAMETER :: JPXMET = 2 * JPNCPN 00062 INTEGER, PARAMETER :: JPTYMX = 5 00063 INTEGER, PARAMETER :: JPLSPX = 6 00064 00065 C 00066 C---------- VARIABLES LOGIQUES A CHARGER ABSOLUMENT PARTOUT ------------ 00067 C 00068 C LMISOP = VRAI SI ON DOIT TRAVAILLER EN MODE MISE AU POINT LOGICIEL 00069 C LFRANC = Vrai/Faux si la messagerie doit etre en francais/anglais 00070 C 00071 C 00072 C-------- DESCRIPTION DE LA PARTIE DOCUMENTAIRE DU 1ER ARTICLE --------- 00073 C 00074 C MOT 1 ==> LONGUEUR "PHYSIQUE" Effective DES ARTICLES (EN MOTS) 00075 C MOT 2 ==> LONGUEUR MAXIMUM DES NOMS D'ARTICLES (CARACTERES) 00076 C MOT 3 ==> "DRAPEAU" SIGNALANT SI LE FICHIER A BIEN ETE FERME 00077 C APRES LA DERNIERE MODIFICATION 00078 C MOT 4 ==> LONGUEUR DE LA PARTIE DOCUMENTAIRE DU FICHIER 00079 C MOT 5 ==> NOMBRE D'ARTICLES "PHYSIQUES" DANS LE FICHIER 00080 C MOT 6 ==> " " LOGIQUES " " " 00081 C (Y COMPRIS LES "TROUS" CREES PAR LES REECRITURES 00082 C D'ARTICLES PLUS LONGUES QUE PRECEDEMMENT, ET N'AYANT 00083 C PAS ENCORE PU ETRE REUTILISES, COMPTES DANS LE MOT 21) 00084 C MOT 7 ==> LONGUEUR MINI. DES ARTICLES LOGIQUES DE DONNEES (MOTS) 00085 C MOT 8 ==> " MAXI. " " " " " " 00086 C MOT 9 ==> " TOTALE " " " " " " 00087 C MOT 10 ==> NOMBRE DE REECRITURES SUR PLACE (VRAIES) 00088 C MOT 11 ==> " " " PLUS COURTES 00089 C MOT 12 ==> " " " " LONGUES 00090 C MOT 13 ==> NOMBRE MAXIMUM D'ARTICLES PAR PAGE OU ARTICLE D'INDEX 00091 C MOT 14 ==> DATE DE LA CREATION DU FICHIER (1ERE OUVERTURE) 00092 C MOT 15 ==> HEURE " " " " " ( " " ) 00093 C MOT 16 ==> DATE DE LA DERNIERE MODIFICATION GARANTIE (FERMETURE) 00094 C MOT 17 ==> HEURE " " " " " ( " ) 00095 C MOT 18 ==> DATE DE LA 1ERE MODIFICATION PAS FORCEMENT GARANTIE 00096 C MOT 19 ==> HEURE " " " " " " " 00097 C (LES MODIFICATIONS NE SONT GARANTIES QUE SI LE MOT 4 VAUT ZERO) 00098 C MOT 20 ==> NOMBRE DE PAIRES D'ARTICLES D'INDEX PRERESERVES . 00099 C MOT 21 ==> NOMBRE DE "TROUS" CORRESP. A DES REECRITURES + LONGUES 00100 C ( AVANT OUVERTURE ) 00101 C MOT 22 ==> NUMERO D'ARTICLE MAXI. DES ARTICLES PHYSIQ. DE DONNEES 00102 C 00103 C------ "PARAMETER" DECRIVANT LES POSITIONS DES ENTITES CI-DESSUS ------ 00104 C 00105 C 00106 C 00107 C 00108 C--- DESCRIPTIF DES TABLES CONCERNANT LES (PAIRES DE) PAGES D'INDEX ---- 00109 C ( ALIAS "P.P.I." ) 00110 C 00111 C CNOMAR = TABLE DES PAGES D'INDEX DE TYPE "NOMS D'ARTICLES" 00112 C MLGPOS = TABLE DES PAGES D'INDEX DE TYPE "LONGUEUR/POSITION" 00113 C MRGPIF = TABLE DES RANGS DES P.P.I. DANS LEUR FICHIER RESPECTIF 00114 C MCOPIF = TABLE DE CORRESPONDANCE PAGES D'INDEX/UNITES LOGIQUES 00115 C MRGPIM = TABLE DES RANGS EN MEMOIRE DES P.P.I. AFFECTEES 00116 C ( DANS *MCOPIF,MRGPIF,CNOMAR,MLGPOS,LECRPI,LPHASP* ) 00117 C LECRPI = VRAI SI LA PAGE D'INDEX CORRESP. DOIT ETRE (RE)ECRITE 00118 C (.,1) ==> PAGE "NOM", (.,2) ==> PAGE "LONGUEUR/POSITION" 00119 C LPHASP = VRAI SI LA PAGE D'INDEX "LONG/POS" EST PHASEE EN MEMOIRE 00120 C AVEC LA PAGE D'INDEX "NOM" CORRESPONDANTE 00121 C 00122 C---------------- VARIABLES "SIMPLES" GLOBALES ------------------------- 00123 C 00124 C NBFIOU = Nombre d'Unites Logiques ouvertes 00125 C NFACTM = Somme des Facteurs Multiplicatifs utilises 00126 C NIMESG = NIVEAU *GLOBAL* DE LA MESSAGERIE 00127 C NERFAG = NIVEAU DE FILTRAGE GLOBAL DES ERREURS FATALES 00128 C NISTAG = NIVEAU D'IMPRESSION GLOBAL DES STATISTIQUES 00129 C NPISAF = NBRE DE PAIRES DE PAGES D'INDEX SUPPLEMENTAIRES AFFECTEES 00130 C LMULTI = VRAI SI ON DOIT TRAVAILLER EN MODE MULTI-TACHES 00131 C LTAMLG = OPTION PAR DEFAUT D'UTILISATION DE LA MEMOIRE TAMPON EN 00132 C LECTURE; VRAIE ==> UTILISATION MAXIMUM 00133 C LTAMEG = CF. CI-DESSUS, EN ECRITURE 00134 C VERGLA = VERROU GLOBAL (EN MULTI-TASKING) 00135 C NULOFM = Nombre d'Unites LOgiques a Facteur Multiplicat. predefini 00136 C CHINCO = Nom par defaut d'une variable qui devrait etre CHaracter 00137 C NUIMEX = Nombre d'Unites LOgiques en cours d'IMport/EXport 00138 C 00139 C--------- DESCRIPTIF DES ELEMENTS CONCERNANT UNE UNITE LOGIQUE -------- 00140 C 00141 C NUMIND = TABLE D'ADRESSAGE INDIRECT DANS LES TABLEAUX CI-DESSOUS 00142 C NUMERO = NUMERO DE L'UNITE LOGIQUE 00143 C MFACTM = FACteur Multiplicatif de la longueur physique elementaire 00144 C CNOMFI = NOM eventuel du FIchier associe a l'unite logique 00145 C CNOMSY = Idem pour le systeme, ou a defaut pour l'utilisateur. 00146 C NLNOMF = LONGUEUR (CARACTERES) DU NOM EVENTUEL 00147 C NLNOMS = Longueur (en caracteres) du Nom SYSTEME eventuel 00148 C NDEROP = CODE DE LA DERNIERE ACTION EFFECTUEE 00149 C CSTAOP = 'STATUS' DE L'OUVERTURE 00150 C LNOUFI = VRAI SI LE FICHIER EST NOUVEAU (AU SENS DU LOGICIEL) 00151 C LMODIF = " " " " A ETE MODIFIE DEPUIS L'OUVERTURE 00152 C NDERCO = DERNIER CODE-REPONSE (CORRESPONDANT A LA DERNIERE ACTION) 00153 C MTAMPD = PAGES DE DONNEES "TAMPON" 00154 C NUMAPD = NUMERO D'ARTICLE PHYSIQUE CORRESPONDANT A CES PAGES 00155 C LECRPD = VRAI SI LA PAGE DE DONNEES CORRESP. DOIT ETRE ECRITE 00156 C NLONPD = LONGUEUR DE PAGE DE DONNEES REELLEMENT REMPLIE 00157 C NDERPD = NUMERO DE LA DERNIERE PAGE DE DONNEES UTILISEE 00158 C NPODPI = RANG DE LA DERNIERE PAGE D'INDEX DANS LA TABLE *MRGPIM* 00159 C NALDPI = NOMBRE D'ARTICLES LOGIQUES DANS LA DERNIERE PAGE D'INDEX 00160 C NBLECT = " DE LECTURES EFFECTUEES DEPUIS L'OUVERTURE 00161 C NBNECR = " " NOUVELLES ECRITURES " " " 00162 C NREESP = " " "VRAIES" REECRITURES SUR PLACE " " 00163 C NREECO = " " REECRITURES PLUS COURTES " " 00164 C NREELO = " " " PLUS LONGUES " " 00165 C NBRENO = " " FOIS OU ON A RENOMME UN ARTICLE " " 00166 C NBSUPP = " " " " " " " SUPPRIME " " " " 00167 C NBTROU = " " TROUS D'INDEX CREES " " 00168 C NIVMES = NIVEAU DE LA MESSAGERIE 00169 C LERFAT = VRAI SI TOUTE ERREUR DOIT ETRE FATALE 00170 C LISTAT = OPTION D'IMPRESSION DES STATISTIQUES ( A LA FERMETURE ) 00171 C VERRUE = VERROU DE L'UNITE LOGIQUE (EN MODE MULTI-TASKING) 00172 C NPPIMM = NBRE DE PAIRES DE PAGES D'INDEX EN MEMOIRE 00173 C MDES1D = TABLE CONTENANT LE 1ER ARTICLE ("DESCRIPTIF") 00174 C NTRULZ = NOMBRE DE TROUS D'INDEX DE LONGUEUR NULLE 00175 C NRFPTZ = RANG PREMIERE ARTICLE AYANT LA CARACTERISTIQUE CI-DESSUS 00176 C NRFDTZ = " DERNIER " " " " " 00177 C NBREAD = NOMBRE DE "READ" FORTRAN REELLEMENT EXECUTES (DEPUIS L' 00178 C NBWRIT = " "WRITE" " " " OUVERTURE) 00179 C NBMOLU = NOMBRE DE MOTS UTILISATEUR LUS CORRECTEMENT (DEPUIS L' 00180 C NBMOEC = " " " " ECRITS " OUVERTURE) 00181 C LTAMPL = OPTION D'UTILISATION MAXI DE LA MEMOIRE TAMPON EN LECTURE 00182 C LTAMPE = " " " " " " " " " ECRITURE 00183 C NDERGF = RANG DANS LE FICHIER DU DERNIER ARTICLE LOGIQUE LU 00184 C ou dont on a demande les caracteristiques (LFICAS/LFICAP) 00185 C CNDERA = NOM de ce dernier article logique de donnees 00186 C NSUIVF = RANG DANS LE FICHIER DU PROCHAIN ARTICLE LOGIQUE A LIRE 00187 C "SEQUENTIELLEMENT" 00188 C NPRECF = RANG DANS LE FICHIER DU PROCHAIN ARTICLE LOGIQUE 00189 C "PRECEDENT" A LIRE 00190 C LMIMAL = VRAI SI ON DOIT RECALCULER LES LONGUEURS MINI. ET MAXI. 00191 C DES ARTICLES LOGIQUES DE DONNEES 00192 C NUMAPH = NUMero d'Article PHysique (pour messages d'erreur E/S). 00193 C NEXPOR = Rang eventuel (d'EXPORt) dans les tables MNUIEX,NDIMPL, 00194 C NIMPOR = " " (d'IMPORt) NDEXPL,NREXPL,CNEXPL,NIMPEX... 00195 C 00196 C------------------------ VARIABLES DIVERSES --------------------------- 00197 C 00198 C MULOFM = Table des Unites LOgiques avec Facteur Multip. predefini 00199 C MFACTU = " " FActeurs mUltiplicatifs associes a ces Unites 00200 C MNUIEX = " " Numeros d'Unites logiques en Import/EXport 00201 C NINIEX = " d'adressage INdirect dans MNUIEX 00202 C NDIMPL = Descripteurs IMPLicites d'import/export en memoire 00203 C NDEXPL = " EXPLicites " " / " " " 00204 C CNIMPL = Profil des articles a description IMPLicite 00205 C NAEXPL = Nombre d'articles decrits EXPLicitement 00206 C CNEXPL = Noms des articles decrits dans NDEXPL 00207 C NREXPL = Rang " " " " NDEXPL 00208 C NIMPEX = Numero d'unite logique associee a l'IMPort ou l'EXport. 00209 C NUTRAV = " " " " de TRAVail pour import ou export. 00210 C NLAPFD = Longueur d'Article Physique du fichier d'export/import. 00211 C NXCNLD = Nb.maX. Caracteres/Nom d'article du logiciel LFI Distant. 00212 C NRCFMX = Rang de la config. Imp/eXport dans CFGMXD, NBMOSD, NBCASD 00213 C CFGMXD = ConFiGuration pour iMport/eXport des systemes Distants. 00214 C NBMOSD = Nombre de Bits par MOt des systemes Distants. 00215 C NBCASD = " " " " CAractere " " " . 00216 C CTYPMX = Liste des types de variables valides pour Import/eXport. 00217 C 00218 TYPE LFICOM 00219 ! lficom0 00220 INTEGER JPNBIM, JPNBIC, JPNCPN, JPLARD, JPNPDF, JPXUFM, JPNXFI 00221 INTEGER JPNPIA, JPNXPI, JPNXPR, JPLDOC, JPNIL, JPNCMO, JPLARC 00222 INTEGER JPXMET, JPRECL, JPFACX, JPLFTX, JPLFIX, JPLSPX, JPLSTX 00223 INTEGER JPIMEX, JPDEXP, JPDIMP, JPXDAM, JPXCIE, JPCFMX, JPXCCF 00224 INTEGER JPNXNA, JPNBLP, JPNAPP, JPNPIS, JPNAPX, JPNMPN, JPLARX 00225 INTEGER JPTYMX, JPNBST 00226 LOGICAL LMISOP, LFRANC 00227 ! lficom1 00228 INTEGER JPLPAR, JPLMNA, JPFEAM, JPLLDO, JPNAPH, JPNALO, JPLNAL 00229 INTEGER JPLXAL, JPLTAL, JPNRES, JPNREC, JPNREL, JPXAPI, JPDCRE 00230 INTEGER JPHCRE, JPDDMG, JPHDMG, JPDMNG, JPHMNG, JPNPIR, JPNTRU 00231 INTEGER JPAXPD 00232 CHARACTER*(JPNCPN), POINTER :: CNOMAR (:), CNDERA (:) 00233 CHARACTER*(JPNCPN) CHINCO 00234 CHARACTER*(JPLFTX), POINTER :: CNOMFI (:), CNOMSY (:) 00235 CHARACTER, POINTER :: CSTAOP (:)*(JPLSTX) 00236 CHARACTER, POINTER :: CNEXPL (:,:)*(JPNCPN) 00237 CHARACTER CTYPMX*(JPTYMX) 00238 CHARACTER, POINTER :: CNIMPL (:)*(JPXMET), CFGMXD (:)*(JPXCCF) 00239 C 00240 INTEGER NBFIOU, NFACTM, NIMESG, NERFAG, NISTAG, NPISAF, NULOFM 00241 #ifndef f77 00242 INTEGER (KIND=JPDBLE), POINTER :: MLGPOS (:) 00243 INTEGER (KIND=JPDBLE), POINTER :: MTAMPD (:) 00244 INTEGER (KIND=JPDBLE), POINTER :: MDES1D (:) 00245 #else 00246 INTEGER, POINTER :: LGPOS (:) 00247 INTEGER, POINTER :: DES1D (:), MTAMPD (:) 00248 #endif 00249 INTEGER, POINTER :: MRGPIM (:,:), NDERPD (:) 00250 INTEGER, POINTER :: MCOPIF (:), MRGPIF (:), NLNOMS (:) 00251 INTEGER, POINTER :: NUMERO (:), NLNOMF (:), NDERCO (:) 00252 INTEGER, POINTER :: NPODPI (:), NUMAPH (:) 00253 INTEGER, POINTER :: NALDPI (:), NBLECT (:), NBNECR (:) 00254 INTEGER, POINTER :: NREESP (:), NREECO (:), NREELO (:) 00255 INTEGER, POINTER :: NIVMES (:), NDEROP (:), NPPIMM (:) 00256 INTEGER, POINTER :: NUMAPD (:,:), NLONPD (:,:) 00257 INTEGER, POINTER :: NTRULZ (:), NRFPTZ (:), NRFDTZ (:) 00258 INTEGER, POINTER :: NBTROU (:), NUMIND (:), NBREAD (:) 00259 INTEGER, POINTER :: NBWRIT (:), NBMOLU (:), NBMOEC (:) 00260 INTEGER, POINTER :: NDERGF (:), NSUIVF (:), NPRECF (:) 00261 INTEGER, POINTER :: NBRENO (:), NBSUPP (:), MFACTM (:) 00262 INTEGER, POINTER :: MULOFM (:), MFACTU (:) 00263 INTEGER, POINTER :: NIMPEX (:), NUTRAV (:), NBMOSD (:) 00264 INTEGER, POINTER :: NBCASD (:), NLAPFD (:) 00265 INTEGER, POINTER :: MNUIEX (:), NINIEX (:), NDEXPL (:,:) 00266 INTEGER, POINTER :: NDIMPL (:,:), NXCNLD (:), NAEXPL (:) 00267 INTEGER, POINTER :: NEXPOR (:), NIMPOR (:), NRCFMX (:) 00268 INTEGER NUIMEX 00269 INTEGER, POINTER :: NREXPL (:,:) 00270 C 00271 REAL, POINTER :: VERRUE (:) 00272 REAL VERGLA 00273 C 00274 LOGICAL LMULTI, LTAMLG, LTAMEG 00275 LOGICAL, POINTER :: LECRPI (:,:) 00276 LOGICAL, POINTER :: LTAMPL (:), LTAMPE (:), LMODIF (:) 00277 LOGICAL, POINTER :: LNOUFI (:), LERFAT (:), LISTAT (:) 00278 LOGICAL, POINTER :: LPHASP (:), LECRPD (:,:) 00279 LOGICAL, POINTER :: LMIMAL (:) 00280 00281 ! subroutine saved variables 00282 LOGICAL :: LFICFG_LLPREA = .TRUE. 00283 CHARACTER :: LFICHI_CLCHIF*10 = '0123456789' 00284 LOGICAL :: LFIDEB_LLPREA = .TRUE. 00285 LOGICAL :: LFIFMD_LLPREA = .TRUE. 00286 LOGICAL :: LFIFRA_LLPREA = .TRUE. 00287 LOGICAL :: LFIINI_LLPREA = .TRUE., LFIINI_LLDEFM = .FALSE. 00288 LOGICAL :: LFINEG_LLPREA = .TRUE. 00289 LOGICAL :: LFINMG_LLPREA = .TRUE. 00290 LOGICAL :: LFINSG_LLPREA = .TRUE. 00291 LOGICAL :: LFINUM_LLPREA = .TRUE. 00292 LOGICAL :: LFIOEG_LLPREA = .TRUE. 00293 LOGICAL :: LFIOFD_LLPREA = .TRUE. 00294 LOGICAL :: LFIOMG_LLPREA = .TRUE. 00295 LOGICAL :: LFIOSG_LLPREA = .TRUE. 00296 CHARACTER*(JPLSTX) :: LFIOUV_CLSTEX (JPNBST) 00297 00298 INTEGER LFIRAC_JPDEBN 00299 00300 INTEGER :: NULOUT = 0 00301 00302 END TYPE LFICOM 00303 00304 00305 TYPE (LFICOM), SAVE, TARGET :: LFICOM_DEFAULT 00306 LOGICAL, SAVE :: LFICOM_DEFAULT_INIT = .FALSE. 00307 00308 CONTAINS 00309 00310 SUBROUTINE NEW_LFI_DEFAULT () 00311 INTEGER(KIND=JPIM) :: IERR 00312 00313 IF (.NOT. LFICOM_DEFAULT_INIT) THEN 00314 CALL NEW_LFI (LFICOM_DEFAULT, IERR) 00315 LFICOM_DEFAULT_INIT = .TRUE. 00316 ENDIF 00317 00318 END SUBROUTINE 00319 00320 SUBROUTINE NEW_LFI (LFI, KERR, KPNXFI, KPFACX) 00321 TYPE (LFICOM) :: LFI 00322 INTEGER(KIND=JPIM), INTENT(OUT) :: KERR 00323 INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN) :: KPNXFI 00324 INTEGER(KIND=JPIM), OPTIONAL, INTENT(IN) :: KPFACX 00325 00326 00327 KERR = 0 00328 00329 LFI%JPLSTX = JPLSTX 00330 LFI%JPNBST = JPNBST 00331 LFI%JPNCPN = JPNCPN 00332 LFI%JPLFTX = JPLFTX 00333 00334 LFI%JPLARD=512 00335 LFI%JPNPDF=20 00336 LFI%JPXUFM=100 00337 LFI%JPNPIA=4 00338 LFI%JPNXPR=100 00339 00340 00341 #ifdef HIGHRES 00342 LFI%JPNXFI=300 00343 LFI%JPFACX=120 00344 #else 00345 LFI%JPNXFI=50 00346 LFI%JPFACX=20 00347 #endif 00348 00349 00350 IF (PRESENT (KPNXFI)) LFI%JPNXFI = KPNXFI 00351 IF (PRESENT (KPFACX)) LFI%JPFACX = KPFACX 00352 00353 C 00354 C Implementation-dependent symbolic constants (except for JPNCMO and 00355 C JPLARC definitions, which are there to have only one set of 00356 C "ifdef" in current header). 00357 C 00358 #if defined ( DEC ) 00359 LFI%JPNBIM=64 00360 LFI%JPNBIC=8 00361 LFI%JPNCMO=LFI%JPNBIM/LFI%JPNBIC 00362 LFI%JPLARC=LFI%JPNCMO*LFI%JPLARD 00363 LFI%JPRECL=2*LFI%JPLARD 00364 #elif defined ( HPPA ) 00365 LFI%JPNBIM=32 00366 LFI%JPNBIC=8 00367 LFI%JPNCMO=LFI%JPNBIM/LFI%JPNBIC 00368 LFI%JPLARC=LFI%JPNCMO*LFI%JPLARD 00369 LFI%JPRECL=LFI%JPLARC 00370 #else 00371 C Notice : record length should be in BYTES for the computer system 00372 LFI%JPNBIM=64 00373 LFI%JPNBIC=8 00374 LFI%JPNCMO=LFI%JPNBIM/LFI%JPNBIC 00375 LFI%JPLARC=LFI%JPNCMO*LFI%JPLARD 00376 LFI%JPRECL=LFI%JPLARC 00377 #endif 00378 00379 LFI%JPLDOC=22 00380 LFI%JPNIL=-999 00381 LFI%JPXMET=JPXMET 00382 LFI%JPCFMX=4 00383 LFI%JPNXPI=LFI%JPNPIA*LFI%JPNXFI+2*LFI%JPFACX 00384 LFI%JPXCIE=2*LFI%JPNCPN 00385 LFI%JPLFIX=128 00386 LFI%JPLSPX=JPLSPX 00387 LFI%JPLSTX=7 00388 LFI%JPTYMX=JPTYMX 00389 LFI%JPIMEX=2 00390 LFI%JPDEXP=10000 00391 LFI%JPDIMP=1000 00392 LFI%JPXDAM=1000 00393 LFI%JPNXNA=(LFI%JPLARD*LFI%JPNCMO)/LFI%JPNCPN 00394 LFI%JPNBLP=LFI%JPLARD/2 00395 LFI%JPNAPP=(LFI%JPNBLP*(LFI%JPNXNA/LFI%JPNBLP)+LFI%JPNXNA* 00396 > (LFI%JPNBLP/LFI%JPNXNA))/(LFI%JPNXNA/ 00397 > LFI%JPNBLP+LFI%JPNBLP/LFI%JPNXNA) 00398 LFI%JPXCCF=JPXCCF 00399 LFI%JPNPIS=LFI%JPNXPI-LFI%JPNPIA*LFI%JPNXFI 00400 LFI%JPNAPX=LFI%JPNAPP*LFI%JPFACX 00401 LFI%JPNMPN=1+(LFI%JPNCPN-1)/LFI%JPNCMO 00402 LFI%JPLARX=LFI%JPLARD*LFI%JPFACX 00403 LFI%JPLPAR=1 00404 LFI%JPLMNA=2 00405 LFI%JPFEAM=3 00406 LFI%JPLLDO=4 00407 LFI%JPNAPH=5 00408 LFI%JPNALO=6 00409 LFI%JPLNAL=7 00410 LFI%JPLXAL=8 00411 LFI%JPLTAL=9 00412 LFI%JPNRES=10 00413 LFI%JPNREC=11 00414 LFI%JPNREL=12 00415 LFI%JPXAPI=13 00416 LFI%JPDCRE=14 00417 LFI%JPHCRE=15 00418 LFI%JPDDMG=16 00419 LFI%JPHDMG=17 00420 LFI%JPDMNG=18 00421 LFI%JPHMNG=19 00422 LFI%JPNPIR=20 00423 LFI%JPNTRU=21 00424 LFI%JPAXPD=22 00425 00426 LFI%LFIRAC_JPDEBN=(LFI%JPNMPN*(2/LFI%JPNMPN)+2*(LFI%JPNMPN/2)) 00427 > /((LFI%JPNMPN/2)+(2/LFI%JPNMPN)) 00428 00429 LFI%LFIOUV_CLSTEX = '' 00430 LFI%LFIOUV_CLSTEX(1) = 'OLD' 00431 LFI%LFIOUV_CLSTEX(2) = 'NEW' 00432 LFI%LFIOUV_CLSTEX(3) = 'UNKNOWN' 00433 LFI%LFIOUV_CLSTEX(4) = 'SCRATCH' 00434 00435 ALLOCATE ( 00436 > LFI%CNOMAR (LFI%JPNXNA*LFI%JPNXPI), LFI%CNDERA (LFI%JPNXFI), 00437 > LFI%CNOMFI (LFI%JPNXFI), LFI%CNOMSY (LFI%JPNXFI), 00438 > LFI%CSTAOP (LFI%JPNXFI), LFI%CNEXPL (LFI%JPXDAM,LFI%JPIMEX), 00439 > LFI%CNIMPL (LFI%JPIMEX), LFI%CFGMXD (0:LFI%JPCFMX), 00440 > LFI%MLGPOS (LFI%JPLARD*LFI%JPNXPI), 00441 > LFI%MTAMPD (LFI%JPLARD*LFI%JPNPDF*LFI%JPNXFI), 00442 > LFI%MDES1D (LFI%JPLARD*LFI%JPNXFI), 00443 > LFI%MRGPIM (LFI%JPNPIA+LFI%JPNPIS,LFI%JPNXFI), 00444 > LFI%NDERPD (LFI%JPNXFI), LFI%MCOPIF (LFI%JPNXPI), 00445 > LFI%MRGPIF (LFI%JPNXPI), LFI%NLNOMS (LFI%JPNXFI), 00446 > LFI%NUMERO (LFI%JPNXFI), LFI%NLNOMF (LFI%JPNXFI), 00447 > LFI%NDERCO (LFI%JPNXFI), LFI%NPODPI (LFI%JPNXFI), 00448 > STAT = KERR ) 00449 IF (KERR /= 0) RETURN 00450 00451 ALLOCATE ( 00452 > LFI%NUMAPH (0:LFI%JPNXFI), LFI%NALDPI (LFI%JPNXFI), 00453 > LFI%NBLECT (LFI%JPNXFI), LFI%NBNECR (LFI%JPNXFI), 00454 > LFI%NREESP (LFI%JPNXFI), LFI%NREECO (LFI%JPNXFI), 00455 > LFI%NREELO (LFI%JPNXFI), LFI%NIVMES (0:LFI%JPNXFI), 00456 > LFI%NDEROP (LFI%JPNXFI), LFI%NPPIMM (LFI%JPNXFI), 00457 > LFI%NUMAPD (0:LFI%JPNPDF-1,LFI%JPNXFI), 00458 > LFI%NLONPD (0:LFI%JPNPDF-1,LFI%JPNXFI), LFI%NTRULZ (LFI%JPNXFI), 00459 > LFI%NRFPTZ (LFI%JPNXFI), LFI%NRFDTZ (LFI%JPNXFI), 00460 > LFI%NBTROU (LFI%JPNXFI), LFI%NUMIND (LFI%JPNXFI), 00461 > LFI%NBREAD (LFI%JPNXFI), LFI%NBWRIT (LFI%JPNXFI), 00462 > LFI%NBMOLU (LFI%JPNXFI), LFI%NBMOEC (LFI%JPNXFI), 00463 > STAT = KERR ) 00464 IF (KERR /= 0) RETURN 00465 00466 ALLOCATE ( 00467 > LFI%NDERGF (LFI%JPNXFI), LFI%NSUIVF (LFI%JPNXFI), 00468 > LFI%NPRECF (LFI%JPNXFI), LFI%NBRENO (LFI%JPNXFI), 00469 > LFI%NBSUPP (LFI%JPNXFI), LFI%MFACTM (0:LFI%JPNXFI), 00470 > LFI%MULOFM (LFI%JPXUFM), LFI%MFACTU (0:LFI%JPXUFM), 00471 > LFI%NIMPEX (LFI%JPIMEX), LFI%NUTRAV (LFI%JPIMEX), 00472 > LFI%NBMOSD (0:LFI%JPCFMX), LFI%NBCASD (0:LFI%JPCFMX), 00473 > LFI%NLAPFD (LFI%JPIMEX), LFI%MNUIEX (LFI%JPIMEX), 00474 > LFI%NINIEX (LFI%JPIMEX), LFI%NDEXPL (LFI%JPDEXP,LFI%JPIMEX), 00475 > LFI%NDIMPL (LFI%JPDIMP,LFI%JPIMEX), LFI%NXCNLD (LFI%JPIMEX), 00476 > STAT = KERR ) 00477 IF (KERR /= 0) RETURN 00478 00479 ALLOCATE ( 00480 > LFI%NAEXPL (LFI%JPIMEX), LFI%NEXPOR (LFI%JPNXFI), 00481 > LFI%NIMPOR (LFI%JPNXFI), LFI%NRCFMX (LFI%JPIMEX), 00482 > LFI%NREXPL (0:LFI%JPXDAM,LFI%JPIMEX), LFI%VERRUE (LFI%JPNXFI), 00483 > LFI%LECRPI (LFI%JPNXPI,2), LFI%LTAMPL (LFI%JPNXFI), 00484 > LFI%LTAMPE (LFI%JPNXFI), LFI%LMODIF (LFI%JPNXFI), 00485 > LFI%LNOUFI (LFI%JPNXFI), LFI%LERFAT (0:LFI%JPNXFI), 00486 > LFI%LISTAT (LFI%JPNXFI), LFI%LPHASP (LFI%JPNXPI), 00487 > LFI%LECRPD (0:LFI%JPNPDF-1,LFI%JPNXFI), LFI%LMIMAL (LFI%JPNXFI), 00488 > STAT = KERR ) 00489 IF (KERR /= 0) RETURN 00490 00491 00492 00493 END SUBROUTINE 00494 00495 SUBROUTINE FREE_LFI (LFI, KERR) 00496 TYPE (LFICOM) :: LFI 00497 INTEGER(KIND=JPIM), INTENT(OUT) :: KERR 00498 00499 KERR = 0 00500 00501 DEALLOCATE ( 00502 > LFI%CNOMAR, LFI%CNDERA, 00503 > LFI%CNOMFI, LFI%CNOMSY, 00504 > LFI%CSTAOP, LFI%CNEXPL, 00505 > LFI%CNIMPL, LFI%CFGMXD, 00506 > LFI%MLGPOS, 00507 > LFI%MTAMPD, 00508 > LFI%MDES1D, 00509 > LFI%MRGPIM, 00510 > LFI%NDERPD, LFI%MCOPIF, 00511 > LFI%MRGPIF, LFI%NLNOMS, 00512 > LFI%NUMERO, LFI%NLNOMF, 00513 > LFI%NDERCO, LFI%NPODPI, 00514 > STAT = KERR ) 00515 IF (KERR .NE. 0) RETURN 00516 00517 DEALLOCATE ( 00518 > LFI%NUMAPH, LFI%NALDPI, 00519 > LFI%NBLECT, LFI%NBNECR, 00520 > LFI%NREESP, LFI%NREECO, 00521 > LFI%NREELO, LFI%NIVMES, 00522 > LFI%NDEROP, LFI%NPPIMM, 00523 > LFI%NUMAPD, 00524 > LFI%NLONPD, LFI%NTRULZ, 00525 > LFI%NRFPTZ, LFI%NRFDTZ, 00526 > LFI%NBTROU, LFI%NUMIND, 00527 > LFI%NBREAD, LFI%NBWRIT, 00528 > LFI%NBMOLU, LFI%NBMOEC, 00529 > STAT = KERR ) 00530 IF (KERR .NE. 0) RETURN 00531 00532 DEALLOCATE ( 00533 > LFI%NDERGF, LFI%NSUIVF, 00534 > LFI%NPRECF, LFI%NBRENO, 00535 > LFI%NBSUPP, LFI%MFACTM, 00536 > LFI%MULOFM, LFI%MFACTU, 00537 > LFI%NIMPEX, LFI%NUTRAV, 00538 > LFI%NBMOSD, LFI%NBCASD, 00539 > LFI%NLAPFD, LFI%MNUIEX, 00540 > LFI%NINIEX, LFI%NDEXPL, 00541 > LFI%NDIMPL, LFI%NXCNLD, 00542 > STAT = KERR ) 00543 IF (KERR .NE. 0) RETURN 00544 00545 DEALLOCATE ( 00546 > LFI%NAEXPL, LFI%NEXPOR, 00547 > LFI%NIMPOR, LFI%NRCFMX, 00548 > LFI%NREXPL, LFI%VERRUE, 00549 > LFI%LECRPI, LFI%LTAMPL, 00550 > LFI%LTAMPE, LFI%LMODIF, 00551 > LFI%LNOUFI, LFI%LERFAT, 00552 > LFI%LISTAT, LFI%LPHASP, 00553 > LFI%LECRPD, LFI%LMIMAL, 00554 > STAT = KERR ) 00555 IF (KERR .NE. 0) RETURN 00556 END SUBROUTINE 00557 00558 END MODULE LFIMOD 00559
1.8.0
