|
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 FAITOU_MT (FA, KREP, KNUMER, LDNOMM, CDNOMF, CDSTTU, 00003 S LDERFA, LDIMST, KNIMES, KNBARP, KNBARI, 00004 S CDNOMC ) 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 d'OUVERTURE d'une unite logique "Fichier ARPEGE" 00010 C Il s'agit d'un fichier indexe, traite par le logiciel LFI. 00011 C 00012 C** 00013 C ARGUMENTS : Ce sont les memes que pour "LFIOUV", avec CDNOMC comme 00014 C argument supplementaire. 00015 C 00016 C KREP (Sortie) ==> Code-reponse du sous-programme; 00017 C KNUMER (Entree) ==> Numero de l'unite logique; 00018 C LDNOMM (Entree) ==> Vrai si l'unite logique doit etre 00019 C associee a un NOM de Fichier EXP- 00020 C LICITE lors de l'"OPEN" FORTRAN; 00021 C CDNOMF (Entree) ==> Nom de fichier explicite, si 00022 C *LDNOMM* est VRAI - Meme si ce 00023 C n'est pas le cas, ce *DOIT* ETRE 00024 C UN OBJET DE TYPE "CHARACTER" . 00025 C CDSTTU (Entree) ==> "STATUS" pour l'"OPEN" FORTRAN 00026 C ('OLD','NEW','UNKNOWN','SCRATCH') 00027 C par defaut, mettre 'UNKNOWN'; 00028 C LDERFA (Entree) ==> Option d'erreur fatale; 00029 C LDIMST (Entree) ==> Option impression de Statistiques 00030 C au moment de la fermeture; 00031 C KNIMES (Entree) ==> Niveau de la Messagerie (0,1 ou 2) 00032 C ( 0==>Rien, 2==>Tout ) 00033 C KNBARP (Entree) ==> Nombre d'articles logiques prevus, 00034 C ce qui n'est utilise que lors de 00035 C la Creation du fichier, 00036 C et qui n'empeche quand meme pas 00037 C d'avoir plus d'articles logiques; 00038 C KNBARI (Sortie) ==> Nombre d'articles logiques de don- 00039 C nees sur le fichier, initialement. 00040 C (zero si creation) 00041 C CDNOMC (Entree) ==> Nom du CADRE associe au fichier. 00042 C* 00043 C N.B. : Pour un fichier en mode creation, ce cadre doit avoir ete 00044 C defini au prealable (via le sous-programme FACADE, ou par 00045 C l'ouverture d'un fichier preexistant). 00046 C Pour un fichier ARPEGE preexistant, le cadre est lu sur le 00047 C fichier; s'il etait deja defini auparavant, il y a controle 00048 C de coherence entre les deux versions du cadre. 00049 C 00050 #include "precision.h" 00051 C 00052 C 00053 TYPE(FA_COM) :: FA 00054 INTEGER KREP, KNUMER, KNIMES, KNBARP, KNBARI 00055 C 00056 CHARACTER CPNOMD*(*) 00057 PARAMETER ( CPNOMD='%%%%% FICHIER SANS NOM %%%%%' ) 00058 C 00059 INTEGER IRANG, INUMER, IRANMS, IREPOU, ILNOMC, ILOMIN, IREP, J 00060 INTEGER INBARP, IRANER, IRANGC, INPAHE, INLATI, ISULEI, INPIND 00061 INTEGER INPGEO, INIVER, ILONGA, ITRONC, ILACTI, INIMES, INXLON 00062 INTEGER ITYPTR, IPHASE, IGARDE, IPOSEX, IPUILA 00063 C 00064 INTEGER IDIMEN (FA%JPCADI), IRDPOL (FA%JPXPAH+FA%JPXIND) 00065 INTEGER IDATEF (FA%JPLDAT) 00066 INTEGER (KIND=JPDBLE) ILDIMEN(FA%JPCADI), 00067 S ILRDPOL(FA%JPXPAH+FA%JPXIND) 00068 INTEGER (KIND=JPDBLE) ILPNVER, ILDATEF(FA%JPLDAT) 00069 C 00070 REAL (KIND=JPDBLR) ZCHMID (FA%JPCAFS), ZSINLA (FA%JPXGEO) 00071 REAL (KIND=JPDBLR) ZHYBRI (0:(1+FA%JPXNIV)*2) 00072 C 00073 LOGICAL LDNOMM, LDERFA, LDIMST, LLVERG, LLNOUF, LLNOUC, LLRLFI 00074 LOGICAL LLMODC, LLREDF, LLMODA, LLMLAM 00075 C 00076 CHARACTER CDNOMF*(*), CDSTTU*(*), CDNOMC*(*) 00077 C 00078 #include "facom2.h" 00079 #include "facom_mt.h" 00080 C** 00081 C 1. - CONTROLES DIVERS, ET OUVERTURE DU FICHIER AU SENS "LFI". 00082 C----------------------------------------------------------------------- 00083 C 00084 C Controle sommaire sur les arguments...le reste est "sous-traite" 00085 C au sous-programme LFIOUV. 00086 C 00087 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00088 IF (LHOOK) CALL DR_HOOK('FAITOU_MT',0,ZHOOK_HANDLE) 00089 IRANG=0 00090 IRANER=0 00091 IRANMS=0 00092 IREPOU=FA%JPNIIL 00093 LLRLFI=.FALSE. 00094 LLVERG=.FALSE. 00095 ILNOMC=LEN (CDNOMC) 00096 ILOMIN=MIN ( LEN (CDNOMF), LEN (CDSTTU), ILNOMC) 00097 C 00098 C L'appel ci-dessous est legerement anticipe, de maniere a 00099 C initialiser les variables globales du logiciel s'il s'agit 00100 C du premier appel a un sous-programme de ce logiciel. 00101 C 00102 CALL FANUMU_MT (FA, KNUMER,IRANG) 00103 C 00104 IF (ILOMIN.LE.0) THEN 00105 IREP=-65 00106 GOTO 1001 00107 ELSEIF (IRANG.NE.0) THEN 00108 C 00109 C Controle de non-ouverture prealable (au sens du logiciel) 00110 C 00111 IREP=-55 00112 IRANMS=IRANG 00113 GOTO 1001 00114 ENDIF 00115 C 00116 C Verrouillage global, si necessaire. 00117 C 00118 IF (FA%LFAMUL) CALL LFIVER_MT (FA%LFI, FA%VRGLAS,'ON') 00119 LLVERG=FA%LFAMUL 00120 C 00121 C A-t-on deja atteint le nombre limite de fichiers ARPEGE 00122 C ouverts simultanement ? Si non, on cherche un emplacement libre 00123 C dans la table FA%NULOGI (logiquement, il devrait en exister un) 00124 C 00125 IF (FA%NFIOUV.GE.FA%JPNXFA) THEN 00126 IREP=-56 00127 GOTO 1001 00128 ELSE 00129 C 00130 DO 101 J=1,FA%JPNXFA 00131 C 00132 IF (FA%NULOGI(J).EQ.FA%JPNIIL) THEN 00133 IRANG=J 00134 GOTO 102 00135 ENDIF 00136 C 00137 101 CONTINUE 00138 C 00139 IREP=-66 00140 GOTO 1001 00141 C 00142 102 CONTINUE 00143 C 00144 ENDIF 00145 C 00146 C Ouverture du fichier au sens du logiciel LFI. 00147 C (on ajoute au nombre d'articles prevus par l'utilisateur les 00148 C articles constituant le cadre, la date et l'identificateur) 00149 C 00150 INBARP=KNBARP+7 00151 CALL LFIOUV_MT (FA%LFI, IREPOU,KNUMER,LDNOMM,CDNOMF,CDSTTU, 00152 S LDERFA,LDIMST, 00153 S KNIMES,INBARP,KNBARI) 00154 C 00155 IF (IREPOU.NE.0.AND.IREPOU.NE.-11) THEN 00156 IREP=IREPOU 00157 LLRLFI=.TRUE. 00158 GOTO 1001 00159 ENDIF 00160 C** 00161 C 2. - CONTROLES SPECIFIQUES AU LOGICIEL DE FICHIERS ARPEGE. 00162 C----------------------------------------------------------------------- 00163 C 00164 LLNOUF=KNBARI.EQ.0 00165 CALL FANUCA_MT (FA, CDNOMC,IRANGC,.FALSE.) 00166 LLNOUC=IRANGC.EQ.0 00167 C 00168 IF (LLNOUF) THEN 00169 C 00170 IF (LLNOUC) THEN 00171 IREP=-57 00172 GOTO 1001 00173 ELSE 00174 C 00175 C Fichier en mode creation et cadre predefini... OK a ce niveau. 00176 C 00177 C On ecrit les articles definissant le cadre sur le fichier, 00178 C ainsi qu'un article ayant pour nom l'identificateur "par defaut", 00179 C (en fait, le nom du cadre) de maniere a ce que cet article soit 00180 C sequentiellement celui qui suit le dernier article du cadre. 00181 C 00182 LLMLAM=FA%LIMLAM(IRANGC) 00183 C 00184 IDIMEN(1)=FA%MTRONC(IRANGC) 00185 INLATI=FA%NLATIT(IRANGC) 00186 IF (.NOT.LLMLAM) THEN 00187 INPAHE=(1+INLATI)/2 00188 ELSE 00189 INPAHE=8 00190 ISULEI=FA%NOZPAR(1,IRANGC) 00191 C 00192 INPIND=2*ISULEI+4 00193 INPGEO=18 00194 ENDIF 00195 IDIMEN(2)=INLATI 00196 IDIMEN(3)=FA%NXLOPA(IRANGC) 00197 INIVER=FA%NNIVER(IRANGC) 00198 IDIMEN(4)=INIVER 00199 IDIMEN(5)=FA%NTYPTR(IRANGC) 00200 ZCHMID(1)=FA%SSLAPO(IRANGC) 00201 ZCHMID(2)=FA%SCLOPO(IRANGC) 00202 ZCHMID(3)=FA%SSLOPO(IRANGC) 00203 ZCHMID(4)=FA%SCODIL(IRANGC) 00204 ZHYBRI(0)=FA%SPREFE(IRANGC) 00205 ILNOMC=FA%NLCCAD(IRANGC) 00206 CLNOMA=CDNOMC 00207 C 00208 IF (.NOT.LLMLAM) THEN 00209 C 00210 DO 201 J=1,INPAHE 00211 IRDPOL(J)=FA%NLOPAR(J,IRANGC) 00212 IRDPOL(INPAHE+J)=FA%NOZPAR(J,IRANGC) 00213 ZSINLA(J)=FA%SINLAT(J,IRANGC) 00214 201 CONTINUE 00215 C 00216 ELSE 00217 DO 211 J=1,INPGEO 00218 ZSINLA(J)=FA%SINLAT(J,IRANGC) 00219 211 CONTINUE 00220 DO 213 J=1,INPAHE 00221 IRDPOL(J)=FA%NLOPAR(J,IRANGC) 00222 213 CONTINUE 00223 DO 215 J=1,INPIND 00224 IRDPOL(INPAHE+J)=FA%NOZPAR(J,IRANGC) 00225 215 CONTINUE 00226 C 00227 ENDIF 00228 C 00229 DO 202 J=0,INIVER 00230 ZHYBRI(J+1)=FA%SFOHYB(1,J,IRANGC) 00231 ZHYBRI(J+2+INIVER)=FA%SFOHYB(2,J,IRANGC) 00232 202 CONTINUE 00233 C 00234 LLRLFI=.TRUE. 00235 ILDIMEN=IDIMEN 00236 CALL LFIECR_MT(FA%LFI,IREP,KNUMER,FA%CPCADI,ILDIMEN,FA%JPCADI) 00237 IDIMEN=ILDIMEN 00238 IF (IREP.NE.0) GOTO 1001 00239 C 00240 CALL LFIECR_MT(FA%LFI,IREP,KNUMER,FA%CPCAFS,ZCHMID,FA%JPCAFS) 00241 IF (IREP.NE.0) GOTO 1001 00242 C 00243 IF (.NOT.LLMLAM) THEN 00244 C 00245 ILONGA=INPAHE*2 00246 ILRDPOL=IRDPOL 00247 CALL LFIECR_MT(FA%LFI,IREP,KNUMER,FA%CPCARP,ILRDPOL,ILONGA) 00248 IRDPOL=ILRDPOL 00249 IF (IREP.NE.0) GOTO 1001 00250 C 00251 ILONGA=INPAHE 00252 CALL LFIECR_MT(FA%LFI,IREP,KNUMER,FA%CPCASL,ZSINLA,ILONGA) 00253 IF (IREP.NE.0) GOTO 1001 00254 C 00255 ELSE 00256 C 00257 ILONGA=INPAHE+INPIND 00258 ILRDPOL=IRDPOL 00259 CALL LFIECR_MT(FA%LFI,IREP,KNUMER,FA%CPCARP,ILRDPOL,ILONGA) 00260 IRDPOL=ILRDPOL 00261 IF (IREP.NE.0) GOTO 1001 00262 C 00263 ILONGA=INPGEO 00264 CALL LFIECR_MT(FA%LFI,IREP,KNUMER,FA%CPCASL,ZSINLA,ILONGA) 00265 IF (IREP.NE.0) GOTO 1001 00266 C 00267 ENDIF 00268 C 00269 ILONGA=1+(1+INIVER)*2 00270 CALL LFIECR_MT (FA%LFI, IREP,KNUMER,FA%CPCACH,ZHYBRI,ILONGA) 00271 IF (IREP.NE.0) GOTO 1001 00272 C 00273 ILPNVER=FA%JPNVER 00274 CALL LFIECR_MT (FA%LFI, IREP,KNUMER, 00275 S CLNOMA(1:ILNOMC),ILPNVER,1) 00276 IF (IREP.NE.0) GOTO 1001 00277 C 00278 LLRLFI=.FALSE. 00279 GOTO 300 00280 ENDIF 00281 C 00282 ENDIF 00283 C* 00284 C 2.1 - Fichier preexistant...lecture et controle du Cadre "Fichier" 00285 C----------------------------------------------------------------------- 00286 C 00287 CALL LFINFO_MT (FA%LFI, IREP,KNUMER,FA%CPCADI,ILONGA,IPOSEX) 00288 C 00289 IF (IREP.NE.0) THEN 00290 LLRLFI=.TRUE. 00291 GOTO 1001 00292 ELSEIF (ILONGA.EQ.0) THEN 00293 IREP=-60 00294 GOTO 1001 00295 ELSEIF (ILONGA.NE.FA%JPCADI) THEN 00296 IREP=-61 00297 GOTO 1001 00298 ENDIF 00299 C 00300 ILDIMEN=IDIMEN 00301 CALL LFILEC_MT (FA%LFI, IREP,KNUMER,FA%CPCADI,ILDIMEN,FA%JPCADI) 00302 IDIMEN=ILDIMEN 00303 C 00304 IF (IREP.NE.0) THEN 00305 LLRLFI=.TRUE. 00306 GOTO 1001 00307 ENDIF 00308 C 00309 CALL LFINFO_MT (FA%LFI, IREP,KNUMER,FA%CPCAFS,ILONGA,IPOSEX) 00310 C 00311 IF (IREP.NE.0) THEN 00312 LLRLFI=.TRUE. 00313 GOTO 1001 00314 ELSEIF (ILONGA.EQ.0) THEN 00315 IREP=-60 00316 GOTO 1001 00317 ELSEIF (ILONGA.NE.FA%JPCAFS) THEN 00318 IREP=-61 00319 GOTO 1001 00320 ENDIF 00321 C 00322 CALL LFILEC_MT (FA%LFI, IREP,KNUMER,FA%CPCAFS,ZCHMID,FA%JPCAFS) 00323 C 00324 IF (IREP.NE.0) THEN 00325 LLRLFI=.TRUE. 00326 GOTO 1001 00327 ENDIF 00328 C 00329 C Coherence des dimensions par rapport aux valeurs "licites", 00330 C que l'on doit faire avant de poursuivre les lectures. 00331 C 00332 IF(IDIMEN(5).LE.0) LLMLAM = .TRUE. 00333 ITRONC=IDIMEN(1) 00334 INLATI=IDIMEN(2) 00335 INPAHE=(1+INLATI)/2 00336 INXLON=IDIMEN(3) 00337 INIVER=IDIMEN(4) 00338 ITYPTR=IDIMEN(5) 00339 IPHASE=1 00340 IGARDE=1 00341 CALL FACADI_MT(FA, IREP,CDNOMC,ITYPTR,ZCHMID(1),ZCHMID(2), 00342 S ZCHMID(3),ZCHMID(4),ITRONC,INLATI,INXLON,IRDPOL(1), 00343 S IRDPOL(FA%JPXPAH+1),ZSINLA, 00344 S INIVER,ZHYBRI(0),ZHYBRI(1),ZHYBRI(FA%JPXNIV+2), 00345 S LLMODC,LLREDF,IPHASE,IRANGC,ILNOMC,IGARDE) 00346 IF (IREP.NE.0) GOTO 1001 00347 C 00348 CALL LFINFO_MT (FA%LFI, IREP,KNUMER,FA%CPCARP,ILONGA,IPOSEX) 00349 C 00350 IF (IREP.NE.0) THEN 00351 LLRLFI=.TRUE. 00352 GOTO 1001 00353 ELSEIF (ILONGA.EQ.0) THEN 00354 IREP=-60 00355 GOTO 1001 00356 ELSEIF (ILONGA.NE.INPAHE*2) THEN 00357 IF (.NOT.LLMLAM) THEN 00358 IREP=-61 00359 GOTO 1001 00360 ENDIF 00361 ENDIF 00362 C 00363 ILRDPOL=IRDPOL 00364 CALL LFILEC_MT (FA%LFI, IREP,KNUMER,FA%CPCARP,ILRDPOL,ILONGA) 00365 IRDPOL=ILRDPOL 00366 C 00367 IF (IREP.NE.0) THEN 00368 LLRLFI=.TRUE. 00369 GOTO 1001 00370 ENDIF 00371 C 00372 CALL LFINFO_MT (FA%LFI, IREP,KNUMER,FA%CPCASL,ILONGA,IPOSEX) 00373 C 00374 IF (IREP.NE.0) THEN 00375 LLRLFI=.TRUE. 00376 GOTO 1001 00377 ELSEIF (ILONGA.EQ.0) THEN 00378 IREP=-60 00379 GOTO 1001 00380 ELSEIF (ILONGA.NE.INPAHE) THEN 00381 IF (.NOT.LLMLAM) THEN 00382 IREP=-61 00383 GOTO 1001 00384 ENDIF 00385 ENDIF 00386 C 00387 CALL LFILEC_MT (FA%LFI, IREP,KNUMER,FA%CPCASL,ZSINLA,ILONGA) 00388 C 00389 IF (IREP.NE.0) THEN 00390 LLRLFI=.TRUE. 00391 GOTO 1001 00392 ENDIF 00393 C 00394 CALL LFINFO_MT (FA%LFI, IREP,KNUMER,FA%CPCACH,ILONGA,IPOSEX) 00395 C 00396 IF (IREP.NE.0) THEN 00397 LLRLFI=.TRUE. 00398 GOTO 1001 00399 ELSEIF (ILONGA.EQ.0) THEN 00400 IREP=-60 00401 GOTO 1001 00402 ELSEIF (ILONGA.NE.1+(1+INIVER)*2) THEN 00403 IF (.NOT.LLMLAM) THEN 00404 IREP=-61 00405 GOTO 1001 00406 ENDIF 00407 ENDIF 00408 C 00409 CALL LFILEC_MT (FA%LFI, IREP,KNUMER,FA%CPCACH,ZHYBRI,ILONGA) 00410 C 00411 IF (IREP.NE.0) THEN 00412 LLRLFI=.TRUE. 00413 GOTO 1001 00414 ENDIF 00415 C 00416 C Tests complementaires sur les valeurs lues. 00417 C 00418 IPHASE=2 00419 CALL FACADI_MT(FA, IREP,CDNOMC,ITYPTR,ZCHMID(1),ZCHMID(2), 00420 S ZCHMID(3),ZCHMID(4),ITRONC,INLATI,INXLON,IRDPOL(1), 00421 S IRDPOL(INPAHE+1),ZSINLA, 00422 S INIVER,ZHYBRI(0),ZHYBRI(1),ZHYBRI(INIVER+2), 00423 S LLMODC,LLREDF,IPHASE,IRANGC,ILNOMC,IGARDE) 00424 IF (IREP.NE.0) GOTO 1001 00425 C* 00426 C 2.2 - Fichier preexistant...l'identificateur du fichier est le 00427 C premier article suivant les articles du cadre. 00428 C----------------------------------------------------------------------- 00429 C 00430 CALL LFICAS_MT (FA%LFI, IREP,KNUMER,CLNOMA,ILONGA, 00431 S IPOSEX,.FALSE.) 00432 C 00433 IF (IREP.NE.0) THEN 00434 LLRLFI=.TRUE. 00435 GOTO 1001 00436 ELSEIF (ILONGA.EQ.0) THEN 00437 IREP=-110 00438 GOTO 1001 00439 ENDIF 00440 C 00441 C* 00442 C 2.3 - Fichier preexistant...lecture et controle de l'article DATE. 00443 C----------------------------------------------------------------------- 00444 C 00445 CALL LFINFO_MT (FA%LFI, IREP,KNUMER,FA%CPDATE,ILONGA,IPOSEX) 00446 C 00447 IF (IREP.NE.0) THEN 00448 LLRLFI=.TRUE. 00449 GOTO 1001 00450 ELSEIF (ILONGA.EQ.0) THEN 00451 IREP=-62 00452 GOTO 1001 00453 ELSEIF (ILONGA.NE.FA%JPLDAT) THEN 00454 IREP=-63 00455 GOTO 1001 00456 ENDIF 00457 C 00458 ILDATEF=IDATEF 00459 CALL LFILEC_MT (FA%LFI, IREP,KNUMER,FA%CPDATE,ILDATEF,FA%JPLDAT) 00460 IDATEF=ILDATEF 00461 C 00462 IF (IREP.NE.0) THEN 00463 LLRLFI=.TRUE. 00464 GOTO 1001 00465 ENDIF 00466 C 00467 C La ligne ci-dessous evite a FANDAI de croire, eventuellement, 00468 C a une redefinition de date. 00469 C 00470 FA%LCREAF(IRANG)=.TRUE. 00471 C 00472 C Controle de la Date fichier, et stockage dans FA%MADATE. 00473 C 00474 CALL FANDAI_MT (FA, IREP,IRANG,IDATEF,LLMODA) 00475 IF (IREP.NE.0) GOTO 1001 00476 C 00477 C Definition du Cadre proprement dite. 00478 C 00479 IPHASE=3 00480 CALL FACADI_MT(FA, IREP,CDNOMC,ITYPTR,ZCHMID(1),ZCHMID(2), 00481 S ZCHMID(3),ZCHMID(4),ITRONC,INLATI,INXLON,IRDPOL(1), 00482 S IRDPOL(INPAHE+1),ZSINLA, 00483 S INIVER,ZHYBRI(0),ZHYBRI(1),ZHYBRI(INIVER+2), 00484 S LLMODC,LLREDF,IPHASE,IRANGC,ILNOMC,IGARDE) 00485 IF (IREP.NE.0) GOTO 1001 00486 C** 00487 C 3. - ON MET A JOUR LES TABLES RELATIVES AUX FICHIERS. 00488 C----------------------------------------------------------------------- 00489 C 00490 300 CONTINUE 00491 C 00492 FA%NFIOUV=FA%NFIOUV+1 00493 FA%NULIND(FA%NFIOUV)=IRANG 00494 FA%NULOGI(IRANG)=KNUMER 00495 FA%NUCADR(IRANG)=IRANGC 00496 C 00497 FA%LNOMME(IRANG)=LDNOMM 00498 FA%NIVOMS(IRANG)=KNIMES 00499 FA%LERRFA(IRANG)=LDERFA 00500 FA%LCREAF(IRANG)=LLNOUF 00501 FA%NBFPDG(IRANG)=FA%NBIPDG 00502 FA%NBFCSP(IRANG)=FA%NBICSP 00503 FA%NPUFLA(IRANG)=FA%NPUILA 00504 FA%NMFDPL(IRANG)=FA%NMIDPL 00505 FA%NFGRIB(IRANG)=FA%NIGRIB 00506 FA%CIDENT(IRANG)=CLNOMA 00507 ITRONC=FA%MTRONC(IRANGC) 00508 ITYPTR=FA%NTYPTR(IRANGC) 00509 C 00510 IF (ITYPTR.LT.0) THEN 00511 FA%NSTROF(IRANG)=MIN (FA%NSTROI,ITRONC-1,-ITYPTR-1) 00512 ELSE 00513 FA%NSTROF(IRANG)=MIN (FA%NSTROI,ITRONC-1) 00514 ENDIF 00515 C 00516 C Appel a FAINOC pour interpreter les eventuels defauts 00517 C de -1 pris par FA%NBFPDG, FA%NBFCSP, FA%NSTROF et FA%NPUFLA en 00518 C IRANG-ieme position. 00519 C 00520 CALL FAINOC_MT (FA, IRANG ) 00521 C 00522 IRANER=IRANG 00523 IRANMS=IRANG 00524 IPUILA=FA%NPUFLA(IRANG) 00525 C 00526 FA%NCOGRIF(:,IRANG)=FA%NCODGRI(:) 00527 FA%NRASHO(IRANG) = 0 00528 FA%NRASVE(IRANG) = 0 00529 C 00530 C L'initialisation de FLAP1Dx sera faite dans FACSIM 00531 C 00532 FA%LIFLAP(IRANG)=.TRUE. 00533 C 00534 C 00535 IF (FA%LFAMUL) CALL LFIVER_MT (FA%LFI, FA%VRFICH(IRANG),'ASGN') 00536 C 00537 C On incremente le nombre de fichiers attaches au cadre specifie. 00538 C 00539 FA%NULCAD(IRANGC)=FA%NULCAD(IRANGC)+1 00540 IREP=IREPOU 00541 GOTO 1001 00542 C** 00543 C 9. - CI-DESSOUS, ETIQUETTES DE BRANCHEMENT EN CAS D'ERREUR E/S. 00544 C----------------------------------------------------------------------- 00545 C 00546 901 CONTINUE 00547 CLACTI='INQUIRE' 00548 C 00549 C AU CAS OU, ON FORCE LE CODE-REPONSE ENTREE/SORTIE A ETRE POSITIF. 00550 C 00551 IREP=IABS (IREP) 00552 C** 00553 C 10. - PHASE TERMINALE : MESSAGERIE, AVEC "ABORT" EVENTUEL, 00554 C VIA LE SOUS-PROGRAMME "LFIEMS" . 00555 C----------------------------------------------------------------------- 00556 C 00557 1001 CONTINUE 00558 KREP=IREP 00559 LLFATA=LLMOER (IREP,IRANER) 00560 C 00561 IF (LLFATA) THEN 00562 INIMES=2 00563 ELSE 00564 INIMES=IXNVMS (IRANMS) 00565 ENDIF 00566 C 00567 C Deverrouillage global eventuel. 00568 C 00569 IF (LLVERG) CALL LFIVER_MT (FA%LFI, FA%VRGLAS,'OFF') 00570 C 00571 IF (.NOT.LLFATA.AND.INIMES.EQ.0) THEN 00572 IF (LHOOK) CALL DR_HOOK('FAITOU_MT',1,ZHOOK_HANDLE) 00573 RETURN 00574 ENDIF 00575 C 00576 CLNSPR='FAITOU' 00577 C 00578 IF (INIMES.EQ.2) THEN 00579 C 00580 IF (ILNOMC.GT.0) THEN 00581 ILACTI=MIN (LEN (CLACTI),ILNOMC) 00582 CLACTI(1:ILACTI)=CDNOMC(1:ILNOMC) 00583 ELSE 00584 ILACTI=8 00585 CLACTI=FA%CHAINC(:ILACTI) 00586 ENDIF 00587 C 00588 WRITE (UNIT=CLMESS,FMT='(''KREP='',I4,'', KNUMER=' 00589 ',I3, S '', LDNOMM= '',L1,'', CDSTTU='''''',A7,'''''', LDERFA= ' 00590 ',L1, S '', LDIMST= ' 00591 ',L1, S '', KNIMES='',I2,'', KNBARP='',I6,'' KNBARI='',I6)') 00592 S KREP,KNUMER,LDNOMM,CDSTTU,LDERFA,LDIMST,KNIMES,KNBARP,KNBARI 00593 CALL FAIPAR_MT (FA, KNUMER,INIMES,IREP,.FALSE.,CLMESS, 00594 S CLNSPR,CLACTI(1:ILACTI),LLRLFI) 00595 CLMESS='CDNOMC='''//CLACTI(1:ILACTI)//'''' 00596 CALL FAIPAR_MT (FA, KNUMER,INIMES,IREP,LLFATA,CLMESS, 00597 S CLNSPR,CLACTI(1:ILACTI),LLRLFI) 00598 ENDIF 00599 C 00600 IF (LHOOK) CALL DR_HOOK('FAITOU_MT',1,ZHOOK_HANDLE) 00601 END 00602
1.8.0
