|
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 FACADI_MT (FA, KREP, CDNOMC, KTYPTR, PSLAPO, PCLOPO, 00003 S PSLOPO, 00004 S PCODIL, KTRONC, KNLATI, KNXLON, KNLOPA, 00005 S KNOZPA, PSINLA, KNIVER, PREFER, PAHYBR, 00006 S PBHYBR, LDMODC, LDREDF, KPHASE, KRANGC, 00007 S KLNOMC, KGARDE ) 00008 USE FA_MOD, ONLY : FA_COM 00009 USE PARKIND1, ONLY : JPRB 00010 USE YOMHOOK , ONLY : LHOOK, DR_HOOK 00011 C**** 00012 C Sous-programme A USAGE INTERNE AU LOGICIEL. Fait la plupart 00013 C des controles en vue de Definir un CADre, voire le redefinir. 00014 C En mode multi-taches, il doit y avoir verrouillage global 00015 C de la zone d'appel au sous-programme. 00016 C** 00017 C Arguments : KREP ==> Code-reponse du sous-programme; 00018 C CDNOMC ==> Nom symbolique du cadre; 00019 C (tous d'Entree) KTYPTR ==> Type de transformation horizontale; 00020 C sauf KRANGC PSLAPO ==> Sinus de la latitude du pole d'interet; 00021 C et KLNOMC) PCLOPO ==> Cosinus " " longitude " " " ; 00022 C PSLOPO ==> Sinus " " longitude " " " ; 00023 C PCODIL ==> Coefficient de dilatation; 00024 C KTRONC ==> Troncature; 00025 C KNLATI ==> Nombre de latitudes (de pole a pole); 00026 C KNXLON ==> Nombre maxi de longitudes par parallele; 00027 C (Tableau) KNLOPA ==> Nombre de longitudes par parallele; 00028 C (du pole nord vers l'equateur seulement) 00029 C (Tableau) KNOZPA ==> Nombre d'onde zonal maxi par parallele; 00030 C (du pole nord vers l'equateur seulement) 00031 C (Tableau) PSINLA ==> Sinus des latitudes de l'hemisphere nord 00032 C (du pole nord vers l'equateur seulement) 00033 C KNIVER ==> Nombre de niveaux verticaux; 00034 C PREFER ==> Pression de reference (facteur multipli- 00035 C catif de la premiere fonction de la 00036 C coordonnee hybride) 00037 C (Tableau) PAHYBR ==> Valeurs de la fonction "A" de la coordo- 00038 C nnee hybride AUX LIMITES DE COUCHES; 00039 C (Tableau) PBHYBR ==> Valeurs de la fonction "B" de la coordo- 00040 C nnee hybride AUX LIMITES DE COUCHES; 00041 C LDMODC ==> Vrai s'il y a modification d'un cadre 00042 C deja defini au prealable; 00043 C LDREDF ==> Vrai s'il y a redefinition d'un cadre 00044 C au sens large du terme (avec ou sans 00045 C modification). 00046 C KPHASE ==> Indique quelle(s) phase(s) du sous-prog. 00047 C on doit executer: 00048 C 0 ==> Toutes, 00049 C 1 ==> Controle des variables simples, 00050 C 2 ==> Controle des tableaux, 00051 C 3 ==> Definition du cadre seule. 00052 C (Sortie) KRANGC ==> Rang du cadre dans les tables. 00053 C (Sortie si phase 1,KLNOMC ==> Longueur en caracteres du nom de cadre. 00054 C Entree sinon ! ) 00055 C KGARDE ==> Option de conservation du cadre 00056 C apres la fermeture du dernier fichier 00057 C qui s'y rattache. A noter que lors dans 00058 C le cas d'une definition dynamique de 00059 C cadre (appel par FAITOU, avec KGARDE=1), 00060 C une redefinition de cadre n'est toleree 00061 C qu'a l'identique. 00062 C 00063 C N.B. : En mode multi-taches, si l'on appelle le sous-programme 00064 C avec KPHASE=0 ou KPHASE=3, on doit verrouiller dans le 00065 C programme appelant l'appel au sous-programme. 00066 C Par ailleurs, LDMODC et LDREDF ne sont definis que si 00067 C KPHASE=0 ou KPHASE=3. 00068 C* 00069 C La "redefinition" d'un cadre est possible a l'une de ces 00070 C conditions: 00071 C 00072 C - le cadre a ete defini, mais n'a aucun fichier qui s'y rattache; 00073 C - le cadre defini a au moins un fichier qui s'y rattache, et les 00074 C nouveaux parametres de definition sont identiques a ceux deja 00075 C definis (a l'exception de l'option de conservation). 00076 C 00077 #include "precision.h" 00078 C 00079 C 00080 TYPE(FA_COM) :: FA 00081 INTEGER KTYPTR, KTRONC, KNLATI, KNXLON, KNIVER, KREP, KPHASE 00082 INTEGER KRANGC, KLNOMC, KGARDE 00083 C 00084 INTEGER KNLOPA (FA%JPXPAH), KNOZPA (FA%JPXIND) 00085 C 00086 REAL (KIND=JPDBLR) PSLAPO, PCLOPO, PSLOPO, PCODIL, PREFER 00087 C 00088 REAL (KIND=JPDBLR) PSINLA (FA%JPXGEO), PAHYBR (0:KNIVER) 00089 REAL (KIND=JPDBLR) PBHYBR (0:KNIVER) 00090 REAL (KIND=JPDBLR),PARAMETER :: ZEPS=1.E-15_JPDBLR 00091 C 00092 CHARACTER CDNOMC*(*) 00093 C 00094 LOGICAL LDREDF, LDMODC 00095 C 00096 INTEGER INEXPL, INGEOM, INPAHE, ILCDNO, J, IPREC, ICOMPT, IMSMAX 00097 INTEGER ISFLAM, JL, IK, INIMES, INUMER, ILNOMC 00098 C 00099 INTEGER IESN0 (0:FA%JPXTRO), ISUHIG (0:FA%JPXTRO) 00100 INTEGER IKNTMP(0:FA%JPXTRO), IKMTMP(0:FA%JPXTRO), 00101 S ICPL4N(0:FA%JPXTRO) 00102 C 00103 REAL (KIND=JPDBLR) ZMIN, ZPMIN, ZPMAX, ZPMINP, ZPMAXP, ZMSMAX 00104 C 00105 LOGICAL LLMLAM 00106 #include "facom_mt.h" 00107 C** 00108 C 0. - AIGUILLAGE EN FONCTION DE *KPHASE*. 00109 C----------------------------------------------------------------------- 00110 C 00111 REAL(KIND=JPRB) :: ZHOOK_HANDLE 00112 IF (LHOOK) CALL DR_HOOK('FACADI_MT',0,ZHOOK_HANDLE) 00113 KREP=0 00114 LDREDF=.FALSE. 00115 LDMODC=.FALSE. 00116 C 00117 IF (KTYPTR .LE. 0 ) THEN 00118 LLMLAM = .TRUE. 00119 INEXPL=8 00120 INGEOM=18 00121 ELSE 00122 LLMLAM = .FALSE. 00123 ENDIF 00124 C 00125 INPAHE=(1+KNLATI)/2 00126 C 00127 IF (KPHASE.EQ.2) THEN 00128 GOTO 200 00129 ELSEIF (KPHASE.EQ.3) THEN 00130 GOTO 300 00131 ELSEIF (KPHASE.LT.0.OR.KPHASE.GT.3) THEN 00132 KREP=-66 00133 GOTO 1001 00134 ENDIF 00135 C** 00136 C 1. - CONTROLE DES VARIABLES SIMPLES (SYNTAXE ET COHERENCE). 00137 C (sauf pression de reference) 00138 C----------------------------------------------------------------------- 00139 C 00140 ILCDNO=LEN (CDNOMC) 00141 KLNOMC=1 00142 C 00143 IF (ILCDNO.LE.0) THEN 00144 KREP=-65 00145 GOTO 1001 00146 ELSEIF (CDNOMC.EQ.' ') THEN 00147 KREP=-68 00148 GOTO 1001 00149 ELSEIF (KGARDE.LT.0.OR.KGARDE.GT.2) THEN 00150 KREP=-66 00151 GOTO 1001 00152 ENDIF 00153 C 00154 DO 101 J=ILCDNO,1,-1 00155 C 00156 IF (CDNOMC(J:J).NE.' ') THEN 00157 KLNOMC=J 00158 GOTO 102 00159 ENDIF 00160 C 00161 101 CONTINUE 00162 C 00163 102 CONTINUE 00164 C 00165 IF (KLNOMC.GT.FA%NCPCAD) THEN 00166 KREP=-65 00167 GOTO 1001 00168 ENDIF 00169 C 00170 IF (KTRONC.LE.0.OR.KTRONC.GT.FA%NXTRON) THEN 00171 KREP=-70 00172 GOTO 1001 00173 ELSEIF (KNLATI.LE.0.OR.KNLATI.GT.FA%NXLATI) THEN 00174 KREP=-71 00175 GOTO 1001 00176 ELSEIF (KNIVER.LE.0.OR.KNIVER.GT.FA%NXNIVV) THEN 00177 KREP=-72 00178 GOTO 1001 00179 ELSEIF (KNXLON.LE.0.OR.KNXLON.GT.FA%NXLONG) THEN 00180 KREP=-83 00181 GOTO 1001 00182 ENDIF 00183 00184 IF (LLMLAM) THEN 00185 IF (-2*KTYPTR+1.GT.KNXLON) THEN 00186 KREP=-115 00187 GOTO 1001 00188 ELSEIF (2*KTRONC+1.GT.KNLATI) THEN 00189 KREP=-116 00190 GOTO 1001 00191 ENDIF 00192 ELSE 00193 IF (PCODIL.LT.1.) THEN 00194 KREP=-73 00195 GOTO 1001 00196 ELSEIF (KTYPTR.LE.0.OR.KTYPTR.GT.FA%NTYPTX) THEN 00197 KREP=-109 00198 GOTO 1001 00199 ELSEIF (MAX(ABS(PSLAPO),ABS(PCLOPO),ABS(PSLOPO)).GT.1.) THEN 00200 KREP=-100 00201 GOTO 1001 00202 ELSEIF (ABS (1.-(PCLOPO**2+PSLOPO**2)).GT.1.E-5) THEN 00203 KREP=-101 00204 GOTO 1001 00205 ELSEIF (2*KTRONC+1.GT.KNXLON) THEN 00206 KREP=-84 00207 GOTO 1001 00208 ELSEIF (2*KTRONC+1.GT.4*(KNLATI/2)) THEN 00209 C 00210 C Le test ci-dessus est "dur" car il fait l'hypothese que, 00211 C dans le cas ou KNLATI est impair, la grille comporte les poles. 00212 C 00213 KREP=-79 00214 GOTO 1001 00215 ENDIF 00216 ENDIF 00217 C 00218 IF (KPHASE.EQ.1) THEN 00219 GOTO 1001 00220 ENDIF 00221 C** 00222 C 2. - CONTROLE DES TABLEAUX (SYNTAXE ET COHERENCE). 00223 C (et de la pression de reference) 00224 C----------------------------------------------------------------------- 00225 C 00226 200 CONTINUE 00227 C 00228 C 00229 IF (PREFER.LT.0..OR.PREFER.GT.REAL (10*FA%MPRESX)) THEN 00230 KREP=-108 00231 GOTO 1001 00232 ENDIF 00233 C 00234 C No Mount Everest test 00235 C 00236 IF (.FALSE.) THEN 00237 DO 202 J=0,KNIVER 00238 IPREC=MAX (0,J-1) 00239 ZMIN=MIN (PAHYBR(J),PBHYBR(J)) 00240 ZPMIN=PREFER*PAHYBR(J)+FA%SPSMIN*PBHYBR(J) 00241 ZPMAX=PREFER*PAHYBR(J)+FA%SPSMAX*PBHYBR(J) 00242 ZPMINP=PREFER*PAHYBR(IPREC)+FA%SPSMIN*PBHYBR(IPREC) 00243 ZPMAXP=PREFER*PAHYBR(IPREC)+FA%SPSMAX*PBHYBR(IPREC) 00244 C 00245 IF (ZMIN.LT.0..OR.PBHYBR(J).GT.1.) THEN 00246 KREP=-80 00247 GOTO 1001 00248 ELSEIF (J.NE.0.AND.(PBHYBR(J).LT.PBHYBR(IPREC).OR. 00249 S ZPMIN.LE.ZPMINP.OR.ZPMAX.LE.ZPMAXP)) THEN 00250 KREP=-81 00251 GOTO 1001 00252 ENDIF 00253 C 00254 202 CONTINUE 00255 ENDIF ! No Mount Everest test 00256 C 00257 IF (.NOT.LLMLAM) THEN 00258 C 00259 DO 201 J=1,INPAHE 00260 IPREC=MAX (1,J-1) 00261 C 00262 IF (KNLOPA(J).LE.0.OR.KNLOPA(J).GT.KNXLON) THEN 00263 KREP=-74 00264 GOTO 1001 00265 ELSEIF (KNLOPA(J).LT.KNLOPA(IPREC)) THEN 00266 KREP=-75 00267 GOTO 1001 00268 ELSEIF (KNOZPA(J).LT.0.OR.KNOZPA(J).GT.KTRONC) THEN 00269 KREP=-76 00270 GOTO 1001 00271 ELSEIF (KNOZPA(J).LT.KNOZPA(IPREC)) THEN 00272 KREP=-77 00273 GOTO 1001 00274 ELSEIF ((2*KNOZPA(J)+1).GT.KNLOPA(J)) THEN 00275 KREP=-78 00276 GOTO 1001 00277 ELSEIF (ABS (PSINLA(J)).GT.1.) THEN 00278 KREP=-102 00279 GOTO 1001 00280 ELSEIF (PSINLA(J).GE.PSINLA(IPREC).AND.J.NE.1) THEN 00281 KREP=-103 00282 GOTO 1001 00283 ENDIF 00284 C 00285 201 CONTINUE 00286 C 00287 ELSE 00288 C 00289 C ***** ERROR HANDLING FOR LAM CASE 00290 C 00291 IF (ABS(KNLOPA(2)).GT.1) THEN 00292 KREP=-117 00293 GOTO 1001 00294 ELSEIF (KNLOPA(3).LE.0.OR.KNLOPA(3).GT.KNXLON) THEN 00295 KREP=-118 00296 GOTO 1001 00297 ELSEIF (KNLOPA(4).LT.KNLOPA(3).OR.KNLOPA(4).GT.KNXLON) THEN 00298 KREP=-119 00299 GOTO 1001 00300 ELSEIF (KNLOPA(5).LE.0.OR.KNLOPA(5).GT.KNLATI) THEN 00301 KREP=-120 00302 GOTO 1001 00303 ELSEIF (KNLOPA(6).LE.KNLOPA(5).OR.KNLOPA(6).GT.KNLATI) THEN 00304 KREP=-121 00305 GOTO 1001 00306 ELSEIF (2*KNLOPA(7).GT.(KNLOPA(4)-KNLOPA(3))) THEN 00307 KREP=-122 00308 GOTO 1001 00309 ELSEIF (2*KNLOPA(8).GT.(KNLOPA(6)-KNLOPA(5))) THEN 00310 KREP=-123 00311 GOTO 1001 00312 ENDIF 00313 C 00314 ENDIF 00315 C 00316 IF (KPHASE.EQ.2) GOTO 1001 00317 C** 00318 C 3. - CONTROLES LIES A LA DEFINITION DU CADRE PROPREMENT DITE. 00319 C----------------------------------------------------------------------- 00320 C 00321 300 CONTINUE 00322 C 00323 C Le nom de cadre specifie est-il deja defini ? 00324 C 00325 CALL FANUCA_MT (FA, CDNOMC,KRANGC,.FALSE.) 00326 LDREDF=KRANGC.NE.0 00327 IF (LDREDF) GOTO 500 00328 C 00329 C En arrivant ici, il s'agit donc d'un nouveau cadre. 00330 C 00331 IF (FA%NCADEF.GE.FA%JPNXCA) THEN 00332 C 00333 C Trop de cadres deja definis pour en stocker un de plus. 00334 C 00335 KREP=-56 00336 GOTO 1001 00337 ENDIF 00338 C 00339 C Recherche d'un emplacement disponible dans les tables de cadres, 00340 C lequel devrait en bonne logique exister... 00341 C 00342 DO 302 J=1,FA%JPNXCA 00343 C 00344 IF (FA%CNOMCA(J).EQ.' ') THEN 00345 KRANGC=J 00346 GOTO 303 00347 ENDIF 00348 C 00349 302 CONTINUE 00350 C 00351 KREP=-66 00352 GOTO 1001 00353 C 00354 303 CONTINUE 00355 C 00356 C Nouveau cadre, mise a jour des tables partagees de cadres. 00357 C 00358 FA%NCADEF=FA%NCADEF+1 00359 FA%NCAIND(FA%NCADEF)=KRANGC 00360 FA%CNOMCA(KRANGC)=CDNOMC 00361 FA%NLCCAD(KRANGC)=KLNOMC 00362 C** 00363 C 4. - STOCKAGE DES PARAMETRES DU CADRE (NOUVEAU, OU REDEFINI). 00364 C----------------------------------------------------------------------- 00365 C 00366 400 CONTINUE 00367 C 00368 FA%NULCAD(KRANGC)=0 00369 FA%NTYPTR(KRANGC)=KTYPTR 00370 FA%MTRONC(KRANGC)=KTRONC 00371 FA%NNIVER(KRANGC)=KNIVER 00372 FA%NLATIT(KRANGC)=KNLATI 00373 FA%NXLOPA(KRANGC)=KNXLON 00374 FA%SSLAPO(KRANGC)=PSLAPO 00375 FA%SCLOPO(KRANGC)=PCLOPO 00376 FA%SSLOPO(KRANGC)=PSLOPO 00377 FA%SCODIL(KRANGC)=PCODIL 00378 FA%SPREFE(KRANGC)=PREFER 00379 C 00380 FA%LIMLAM(KRANGC)=LLMLAM 00381 FA%NSFLAM(KRANGC)=0 00382 C 00383 IF (.NOT.LDREDF.OR.KGARDE.NE.1) FA%NGARDE(KRANGC)=KGARDE 00384 C 00385 IF (.NOT.LLMLAM) THEN 00386 ICOMPT=0 00387 C 00388 DO 401 J=1,INPAHE 00389 ICOMPT=ICOMPT+KNLOPA(J) 00390 FA%NLOPAR(J,KRANGC)=KNLOPA(J) 00391 FA%NOZPAR(J,KRANGC)=KNOZPA(J) 00392 FA%SINLAT(J,KRANGC)=PSINLA(J) 00393 401 CONTINUE 00394 C 00395 IF (KNLATI.EQ.2*INPAHE) THEN 00396 FA%NVAPDG(KRANGC)=ICOMPT*2 00397 ELSE 00398 FA%NVAPDG(KRANGC)=ICOMPT*2-KNLOPA(INPAHE) 00399 ENDIF 00400 C 00401 ELSE 00402 C ***** CALCULATION OF KNOZPA(), THEN ALSO SETTING OF FACOM1-TABLES ***** 00403 C 00404 ZMSMAX=REAL(-KTYPTR) 00405 IMSMAX = -KTYPTR 00406 ISFLAM = 0 00407 CALL ELLIPS(KTRONC,IMSMAX,IKNTMP,IKMTMP) 00408 CDP CALL ELLIPS(IMSMAX,KTRONC,IKNTMP,IKMTMP) 00409 C 00410 C Initialisation de FA%NOMPAR (du module FAMODU) 00411 C 00412 FA%NOMPAR(2,KRANGC) = 0 00413 DO JL=0,IMSMAX 00414 FA%NOMPAR(2*JL+3,KRANGC) = FA%NOMPAR(2*JL+2,KRANGC) + 1 00415 FA%NOMPAR(2*JL+4,KRANGC) = FA%NOMPAR(2*JL+3,KRANGC) 00416 S + 4*(IKNTMP(JL)+1) -1 00417 ENDDO 00418 FA%NOMPAR(1,KRANGC) = KTRONC 00419 FA%NOMPAR(2,KRANGC) = IMSMAX 00420 C 00421 DO 717 JL=0,KTRONC 00422 IK=IKMTMP(JL) 00423 CDP IK=IKNTMP(JL) 00424 ICPL4N(JL)=4*(IK+1) 00425 ISFLAM = ISFLAM + 4*(IK+1) 00426 717 CONTINUE 00427 C 00428 IESN0(0)=1 00429 C 00430 DO 771 J=1,KTRONC 00431 IESN0(J)=IESN0(J-1)+ICPL4N(J-1) 00432 771 CONTINUE 00433 C 00434 C ----- NOW SETTING OF TABLES ----- 00435 DO 707 J=1,INEXPL 00436 FA%NLOPAR(J,KRANGC)=KNLOPA(J) 00437 707 CONTINUE 00438 DO 770 J=1,INGEOM 00439 FA%SINLAT(J,KRANGC)=PSINLA(J) 00440 770 CONTINUE 00441 FA%NOZPAR(1,KRANGC)=KTRONC 00442 FA%NOZPAR(2,KRANGC)=IMSMAX 00443 C 00444 DO 700 J=0,KTRONC 00445 FA%NOZPAR(2*J+3,KRANGC)=IESN0(J) 00446 FA%NOZPAR(2*J+4,KRANGC)=IESN0(J)+ICPL4N(J)-1 00447 700 CONTINUE 00448 00449 IF (FA%NOZPAR(2*KTRONC+4,KRANGC).NE. 00450 S FA%NOMPAR(2*IMSMAX+4,KRANGC)) 00451 S THEN 00452 KREP=-127 00453 GOTO 1001 00454 ENDIF 00455 C 00456 FA%NSFLAM(KRANGC)=ISFLAM 00457 C 00458 C ***** DETERMINATION OF FA%NVAPDG() ***** 00459 C 00460 FA%NVAPDG(KRANGC)=KNLATI*KNXLON 00461 C 00462 ENDIF 00463 C 00464 DO 402 J=0,KNIVER 00465 FA%SFOHYB(1,J,KRANGC)=PAHYBR(J) 00466 FA%SFOHYB(2,J,KRANGC)=PBHYBR(J) 00467 402 CONTINUE 00468 C 00469 GOTO 1001 00470 C** 00471 C 5. - TENTATIVE DE REDEFINITION D'UN CADRE. CONTROLES AD HOC. 00472 C----------------------------------------------------------------------- 00473 C 00474 500 CONTINUE 00475 C 00476 IF (FA%MTRONC(KRANGC).NE.KTRONC.OR.FA%NNIVER(KRANGC).NE.KNIVER.OR. 00477 S FA%NLATIT(KRANGC).NE.KNLATI.OR.FA%NXLOPA(KRANGC).NE.KNXLON.OR. 00478 S (ABS(FA%SSLAPO(KRANGC)-PSLAPO)>ZEPS) .OR. 00479 S (ABS(FA%SCLOPO(KRANGC)-PCLOPO)>ZEPS) .OR. 00480 S (ABS(FA%SSLOPO(KRANGC)-PSLOPO)>ZEPS) .OR. 00481 S (ABS(FA%SCODIL(KRANGC)-PCODIL)>ZEPS) .OR. 00482 S FA%NTYPTR(KRANGC).NE.KTYPTR.OR. 00483 S (ABS(FA%SPREFE(KRANGC)-PREFER)>ZEPS)) GOTO 505 00484 C 00485 IF (.NOT.LLMLAM) THEN 00486 DO 5010 J=1,INPAHE 00487 IF (FA%NLOPAR(J,KRANGC).NE.KNLOPA(J).OR. 00488 S FA%NOZPAR(J,KRANGC).NE.KNOZPA(J).OR. 00489 S (ABS(FA%SINLAT(J,KRANGC)-PSINLA(J))>ZEPS)) GOTO 505 00490 5010 CONTINUE 00491 ELSE 00492 DO 5011 J=1,8 00493 IF (FA%NLOPAR(J,KRANGC).NE.KNLOPA(J)) GOTO 505 00494 5011 CONTINUE 00495 DO 5012 J=1,18 00496 IF (ABS(FA%SINLAT(J,KRANGC)-PSINLA(J))>ZEPS) GOTO 505 00497 5012 CONTINUE 00498 ENDIF 00499 C 00500 DO 502 J=0,KNIVER 00501 IF ((ABS(FA%SFOHYB(1,J,KRANGC)-PAHYBR(J))>ZEPS).OR. 00502 S (ABS(FA%SFOHYB(2,J,KRANGC)-PBHYBR(J))>ZEPS)) GOTO 505 00503 502 CONTINUE 00504 C 00505 C Si on arrive ici, il y a redefinition a l'identique, 00506 C du moins pour les parametres numeriques. 00507 C L'option de conservation du cadre peut, elle, etre modifiee 00508 C dans le cas d'une definition non dynamique. 00509 C 00510 IF (KGARDE.NE.1) FA%NGARDE(KRANGC)=KGARDE 00511 GOTO 1001 00512 C 00513 505 CONTINUE 00514 LDMODC=.TRUE. 00515 C 00516 C Il y a donc redefinition avec changement de parametre(s), 00517 C ce qui n'est possible que s'il n'y a pas de fichier rattache, 00518 C et s'il ne s'agit pas d'une definition dynamique de cadre 00519 C (appel par FAITOU avec KGARDE=1). 00520 C 00521 IF (KGARDE.EQ.1) THEN 00522 KREP=-58 00523 ELSEIF (FA%NULCAD(KRANGC).NE.0) THEN 00524 KREP=-59 00525 ELSE 00526 GOTO 400 00527 ENDIF 00528 C** 00529 C 10. - PHASE TERMINALE : MESSAGERIE EVENTUELLE, 00530 C VIA LE sous-programme "FAIPAR" . 00531 C----------------------------------------------------------------------- 00532 C 00533 1001 CONTINUE 00534 C 00535 LLFATA=KREP.NE.0.AND.FA%NRFAGA.NE.2 00536 C 00537 IF (FA%LFAMOP.OR.LLFATA) THEN 00538 INIMES=2 00539 CLNSPR='FACADI' 00540 INUMER=FA%JPNIIL 00541 C 00542 IF (KREP.EQ.-65.AND.ILCDNO.LE.0) THEN 00543 ILNOMC=8 00544 CLACTI(1:ILNOMC)=FA%CHAINC(:ILNOMC) 00545 ELSE 00546 ILNOMC=MIN (KLNOMC,FA%NCPCAD,LEN (CLACTI)) 00547 CLACTI(1:ILNOMC)=CDNOMC(1:ILNOMC) 00548 ENDIF 00549 C 00550 WRITE (UNIT=CLMESS,FMT='(''ARGUM.SIMPLES='',I4,'',''''' 00551 ',A, S '''''''',4('','',F7.4),4('','',I4),'',' 00552 ',F10.3, S 2('','',L1),2('','',I2),'','',I3,'','',I1)') 00553 S KREP,CLACTI(1:ILNOMC),PSLAPO,PCLOPO,PSLOPO,PCODIL, 00554 S KTRONC,KNLATI,KNXLON,KNIVER,PREFER,LDMODC,LDREDF,KPHASE, 00555 S KRANGC,KLNOMC,KGARDE 00556 CALL FAIPAR_MT (FA, INUMER,INIMES,KREP,.FALSE.,CLMESS, 00557 S CLNSPR,CLACTI(1:ILNOMC),.FALSE.) 00558 ELSEIF (KTRONC.LE.FA%NSTROI.AND.(KPHASE.EQ.0.OR.KPHASE.EQ.1)) THEN 00559 INIMES=1 00560 CLNSPR='FACADI' 00561 INUMER=FA%JPNIIL 00562 ILNOMC=MIN (KLNOMC,FA%NCPCAD) 00563 WRITE (UNIT=CLMESS, 00564 S FMT='(''TRONCATURE ('',I2,'') INFERIEURE ' 00565 ', S ''OU EGALE A LA SOUS-TRONCATURE "NON COMPACTEE" IMPLICITE (' 00566 ',I2, S ''), CADRE '''''',A,'''''''')') KTRONC,FA%NSTROI,CDNOMC(1:ILNOMC) 00567 CALL FAIPAR_MT (FA, INUMER,INIMES,KREP,.FALSE.,CLMESS, 00568 S CLNSPR,CLACTI,.FALSE.) 00569 ENDIF 00570 C 00571 IF (LHOOK) CALL DR_HOOK('FACADI_MT',1,ZHOOK_HANDLE) 00572 END 00573
1.8.0
