Télécharger interp.eso

Retour à la liste

Numérotation des lignes :

  1. C INTERP SOURCE BP208322 16/08/31 21:15:02 9051
  2. SUBROUTINE INTERP
  3. C
  4. C=======================================================================
  5. C
  6. C Opérateur IPOL
  7. C
  8. C----------------------------
  9. C Phrases d'appel (GIBIANE) :
  10. C----------------------------
  11. C
  12. C OBJET2 = 'IPOL' OBJET1 | LISTREE1 LISTREE2 | ...
  13. C | EVOL1 |
  14. C ... (|'SPLI' ('DGAU' FLOT1) ('DDRO' FLOT2)) ;
  15. C (|'TOUS') ;
  16. C
  17. C OBJET2 = 'IPOL' FLOT1 TAB1 ;
  18. C
  19. C
  20. C OBJET2 = 'IPOL' OBJET1 NUA1 | ('GAUSS') | ;
  21. C | 'RATIO' |
  22. C | 'GRILL' |
  23. C
  24. C
  25. C------------------------
  26. C Opérandes et résultat :
  27. C------------------------
  28. C
  29. C Syntaxe 1
  30. C
  31. C LISTREE1 : liste des abscisses T de la fonction
  32. C
  33. C LISTREE2 : liste des ordonnées F(T) de la fonction
  34. C
  35. C EVOL1 : Evolution représentant la fonction
  36. C
  37. C OBJET1 : objet contenant les valeurs à interpoler sur F
  38. C (type FLOTTANT, CHPOINT, LISTREEL, MCHAML)
  39. C
  40. C OBJET2 : valeurs de la fonction interpolée aux points donnés
  41. C (même type que OBJET1)
  42. C
  43. C Syntaxe 2
  44. C
  45. C FLOT1 : valeur à interpoler sur F
  46. C
  47. C TAB1 : table de sous-type 'RESULTAT'
  48. C
  49. C OBJET2 : valeurs de la fonction interpolée au point donné
  50. C (type CHPOINT ou MCHAML)
  51. C
  52. C Syntaxe 3
  53. C
  54. C NUA1 : objet NUAGE représentant la fonction à interpoler
  55. C
  56. C OBJET1 : objet contenant les valeurs à interpoler sur F
  57. C (type CHPOINT, MCHAML)
  58. C
  59. C OBJET2 : valeurs de la fonction interpolée aux points donnés
  60. C (même type que OBJET1)
  61. C
  62. C
  63. C=======================================================================
  64. C
  65. C Remarques
  66. C
  67. C Les listes LISTREE1 et LISTREE2 doivent se correspondre
  68. C
  69. C L'évolution EVOL1 doit être élémentaire
  70. C
  71. C ATTENTION : la liste des abscisses donnéee est supposée monotone
  72. C
  73. C=======================================================================
  74. C
  75. C Auteur :
  76. C Création :
  77. C Modifications :
  78. C PM le 03/10/2006 : lecture d'une évolution en entrée
  79. C 19/03/2007 : vérification que les listes ont une longueur > 1
  80. C SG 22/10/2009 : option SPLINE (biblio : numerical recipes)
  81. C FDP 02/10/2015 : option GRILL (interpolation multi-lineaire
  82. C dans une grille de valeurs)
  83. C BP 29/08/2016 : ajout option TOUS pour la syntaxe 1
  84. C
  85. C=======================================================================
  86.  
  87. IMPLICIT INTEGER(I-N)
  88. IMPLICIT REAL*8(A-H,O-Z)
  89. CHARACTER*8 TYPE1,TYPE2,TYPEI,TYPO1,TYPO2,TYPOBJ
  90. CHARACTER*8 CHARIN,CHARRE
  91. LOGICAL LOGIN,LOGRE
  92. CHARACTER*4 CLE(1),CLE2(1)
  93. DATA CLE/'SPLI'/
  94. DATA CLE2/'TOUS'/
  95. CHARACTER*4 CDER(2)
  96. DATA CDER/'DGAU','DDRO'/
  97. LOGICAL LCDER(2)
  98. REAL*8 XCDER(2)
  99. INTEGER OOOVAL
  100.  
  101. -INC SMLREEL
  102. POINTEUR MLREE4.MLREEL,MLDERS.MLREEL,MLDER.MLREEL
  103. -INC CCREEL
  104. -INC SMCHPOI
  105. -INC SMELEME
  106. -INC CCOPTIO
  107. -INC SMCHAML
  108. -INC SMTABLE
  109. -INC SMEVOLL
  110. SEGMENT TABR
  111. REAL*8 TEMA(LOR)
  112. ENDSEGMENT
  113.  
  114. * syntaxe 3 ?
  115. CALL LIROBJ('NUAGE',INUA,0,IRETOU)
  116. IF(IRETOU.EQ.1) THEN
  117. CALL IPLNU1(INUA)
  118. RETURN
  119. ENDIF
  120. * syntaxe 2 ?
  121. CALL LIROBJ('TABLE',IPOT,0,IRETOU)
  122. IF(IRETOU.EQ.1) THEN
  123. CALL LIRREE(TEMPS,1,IRETOU)
  124. IF(IERR.NE.0) RETURN
  125. GOTO 50
  126. ENDIF
  127.  
  128. * syntaxe 1 (INDIC=1 à 4)
  129. CALL LIRREE(TEMPS,0,IRETOU)
  130. IF(IRETOU.EQ.1) THEN
  131. ELSE
  132. CALL LIROBJ('CHPOINT ',MTEMP,0,IRETOU)
  133. IF(IRETOU.EQ.1) THEN
  134. ELSE
  135. CALL LIROBJ('MCHAML',IPO1,0,IRETOU)
  136. IF(IRETOU.EQ.1) THEN
  137. ELSE
  138. CALL LIROBJ('LISTREEL',MLIST,0,IRETOU)
  139. IF(IRETOU.EQ.0) THEN
  140. * Pas d opérande correcte trouvée
  141. CALL QUETYP(MOTERR(1:8),0,IRETOU)
  142. IF(IRETOU.NE.0) THEN
  143. * On ne veut pas d'objet de type %m1:8
  144. CALL ERREUR(39)
  145. ELSE
  146. * Cet opérateur a encore besoin d'un opérande
  147. CALL ERREUR(533)
  148. ENDIF
  149. RETURN
  150. ENDIF
  151. ENDIF
  152. ENDIF
  153. ENDIF
  154.  
  155. * Lecture de la fonction à interpoler
  156. CALL LIROBJ('EVOLUTIO',IEVL,0,IRETOU)
  157. IF(IRETOU.EQ.1) THEN
  158. MEVOLL=IEVL
  159. SEGACT, MEVOLL
  160. * Vérification que l'évolution est élémentaire
  161. IF (IEVOLL(/1).NE.1) THEN
  162. * Opération interdite sur un objet complexe
  163. CALL ERREUR(25)
  164. RETURN
  165. ENDIF
  166. KEVOLL=IEVOLL(1)
  167. SEGACT, KEVOLL
  168. * de type scalaire
  169. IF (ITYEVO.NE.'REEL') THEN
  170. * Opération interdite sur un objet complexe
  171. CALL ERREUR(25)
  172. RETURN
  173. ENDIF
  174. * peuplée de flottants
  175. IF ((TYPX.NE.'LISTREEL').OR.(TYPY.NE.'LISTREEL')) THEN
  176. * Certaines courbes ne sont pas du bon type
  177. CALL ERREUR(871)
  178. RETURN
  179. ENDIF
  180. KTE=IPROGX
  181. KFT=IPROGY
  182. SEGDES,KEVOLL,MEVOLL
  183. ELSE
  184. CALL LIROBJ('LISTREEL',KTE,1,IRETOU)
  185. IF(IERR.NE.0) RETURN
  186. CALL LIROBJ('LISTREEL',KFT,1,IRETOU)
  187. IF(IERR.NE.0) RETURN
  188. ENDIF
  189.  
  190. * Longueur des listes décrivant la fonction
  191. MLREE1=KTE
  192. MLREE2=KFT
  193. SEGACT MLREE1,MLREE2
  194. IF(MLREE1.PROG(/1).NE.MLREE2.PROG(/1)) THEN
  195. * Les suites n ont pas la même longueur
  196. CALL ERREUR(212)
  197. RETURN
  198. ENDIF
  199. LON=MLREE1.PROG(/1)
  200.  
  201. C erreur 897 2 :
  202. C "La dimension des LISTREEL doit etre plus grande que 1"
  203. IF (LON.LT.1) THEN
  204. CALL ERREUR(897)
  205. RETURN
  206. ENDIF
  207.  
  208. c Lecture eventuelle du mot cle 'TOUS'
  209. CALL LIRMOT(CLE2,1,ITOUS,0)
  210. IF(ITOUS.EQ.1) THEN
  211. IF(INDIC.NE.1) THEN
  212. c Option %M1:8 incompatible avec les donnees
  213. MOTERR(1:8)='TOUS'
  214. CALL ERREUR(803)
  215. c On desire lire un nombre
  216. CALL ERREUR(15)
  217. RETURN
  218. ENDIF
  219. ISENS=0
  220. c GOTO 1
  221. c On va directement en 10 car SPLINE incompatible avec TOUS
  222. GOTO 10
  223. ENDIF
  224.  
  225. TDEB=MLREE1.PROG(1)
  226. TFIN=MLREE1.PROG(LON)
  227. * Les x sont-ils croissants ou décroissants ?
  228. IF (TFIN.GE.TDEB) THEN
  229. ISENS=0
  230. ELSE
  231. c si decroissant, on retourne la liste
  232. ISENS=1
  233. JG=LON
  234. SEGINI,MLREE3
  235. SEGINI,MLREE4
  236. DO ILON=1,LON
  237. MLREE3.PROG(ILON)=MLREE1.PROG(LON-ILON+1)
  238. MLREE4.PROG(ILON)=MLREE2.PROG(LON-ILON+1)
  239. ENDDO
  240. SEGDES,MLREE1
  241. SEGDES,MLREE2
  242. MLREE1=MLREE3
  243. MLREE2=MLREE4
  244. TDEB=MLREE1.PROG(1)
  245. TFIN=MLREE1.PROG(LON)
  246. ENDIF
  247. * On va vérifier que la liste est ordonnée
  248. IVERI=1
  249. C
  250. C Vérification que la liste est ordonnée
  251. C
  252. c IF (IVERI.EQ.1) THEN
  253. TPRE=TDEB
  254. DO ILON=2,LON
  255. TCOU=MLREE1.PROG(ILON)
  256. IF (TCOU.LT.TPRE) GOTO 6661
  257. TPRE=TCOU
  258. ENDDO
  259. c ENDIF
  260. GOTO 1
  261. 6661 CONTINUE
  262. C erreur 249 2 : "La suite de reels doit etre croissante"
  263. cbp : en realite elle doit etre monotone (decroissante possible)
  264. CALL ERREUR(249)
  265. RETURN
  266.  
  267. 1 CONTINUE
  268. *
  269. * Y a-t-il une option SPLINE ?
  270. *
  271. CALL LIRMOT(CLE,1,ISPLIN,0)
  272. IF (ISPLIN.EQ.1) THEN
  273. LCDER(1)=.FALSE.
  274. LCDER(2)=.FALSE.
  275. * Lecture des mots clés et valeurs associées
  276. * On lit les valeurs des dérivées premières à gauche et à droite
  277. * Si elles ne sont pas données, c'est la condition à la limite
  278. * naturelle qui s'applique
  279. 77 CONTINUE
  280. CALL LIRMOT(CDER,2,ICDER,0)
  281. IF (ICDER.GT.0) THEN
  282. LCDER(ICDER)=.TRUE.
  283. CALL LIRREE(XCDER(ICDER),1,IRETOU)
  284. IF(IERR.NE.0) RETURN
  285. GOTO 77
  286. ENDIF
  287. JG=LON
  288. SEGINI MLDERS
  289. SEGINI MLDER
  290. IF (LCDER(1)) THEN
  291. * Cas où on prescrit la dérivée première à gauche
  292. MLDERS.PROG(1)=-0.5D0
  293. DX=MLREE1.PROG(2)-MLREE1.PROG(1)
  294. DY=MLREE2.PROG(2)-MLREE2.PROG(1)
  295. MLDER.PROG(1)=(3.D0/DX)*((DY/DX)-XCDER(1))
  296. ELSE
  297. * Condition de bord naturelle (dérivée seconde nulle)
  298. MLDERS.PROG(1)=XZERO
  299. MLDER.PROG(1)=XZERO
  300. ENDIF
  301. DO ILON=2,LON-1
  302. XIM=MLREE1.PROG(ILON-1)
  303. XI=MLREE1.PROG(ILON)
  304. XIP=MLREE1.PROG(ILON+1)
  305. YIM=MLREE2.PROG(ILON-1)
  306. YI=MLREE2.PROG(ILON)
  307. YIP=MLREE2.PROG(ILON+1)
  308. DXIM=XI-XIM
  309. DXI2=XIP-XIM
  310. DXIP=XIP-XI
  311. XRAP=DXIM/DXI2
  312. XP=XRAP*MLDERS.PROG(ILON-1)+2.D0
  313. MLDERS.PROG(ILON)=(XRAP-1.D0)/XP
  314. DYIP=YIP-YI
  315. DYIM=YI-YIM
  316. MLDER.PROG(ILON)=(6.D0*(DYIP/DXIP-DYIM/DXIM)/DXI2-XRAP
  317. $ *MLDER.PROG(ILON-1))/XP
  318. ENDDO
  319. IF (LCDER(2)) THEN
  320. XQN=0.5D0
  321. DX=MLREE1.PROG(LON)-MLREE1.PROG(LON-1)
  322. DY=MLREE2.PROG(LON)-MLREE2.PROG(LON-1)
  323. XUN=(3.D0/DX)*(XCDER(2)-(DY/DX))
  324. ELSE
  325. * Condition de bord naturelle (dérivée seconde nulle)
  326. XQN=0.D0
  327. XUN=0.D0
  328. ENDIF
  329. MLDERS.PROG(LON)=(XUN-XQN*MLDER.PROG(LON-1))/
  330. $ (XQN*MLDERS.PROG(LON-1)+1.D0)
  331. DO ILON=LON-1,1,-1
  332. MLDERS.PROG(ILON)=MLDERS.PROG(ILON)*MLDERS.PROG(ILON+1)
  333. $ +MLDER.PROG(ILON)
  334. ENDDO
  335. SEGSUP MLDER
  336. c write(*,*) 'MLDERS=',(MLDERS.PROG(iou),iou=1,LON)
  337. ELSE
  338. MLDERS=0
  339. ENDIF
  340. * On ne va pas renvoyer d'erreur si t est en-dehors des bornes
  341. * On renvoie la valeur de la fonction pour t le plus proche
  342. IVERI=0
  343. *
  344. * Répartition suivant le type de l'objet fourni
  345. *
  346. GOTO (10,20,30,40) INDIC
  347.  
  348. ****************** T0 FLOTTANT *******************************
  349.  
  350. 10 CONTINUE
  351. IF(ITOUS.EQ.1) THEN
  352. CALL INTER4(TEMPS,MLREE1,MLREE2,IRET)
  353. IF (IRET.NE.0) CALL ECROBJ('LISTREEL',IRET)
  354. ELSE
  355. CALL INTER5(TEMPS,MLREE1,MLREE2,FT0,ISPLIN,MLDERS,IVERI,IRET)
  356. IF (IRET.EQ.1) CALL ECRREE(FT0)
  357. ENDIF
  358. GOTO 999
  359.  
  360. ********************* T0 CHPOINT *****************************
  361.  
  362. 20 CONTINUE
  363. MCHPO1=MTEMP
  364. SEGINI,MCHPOI=MCHPO1
  365. MFT0=MCHPOI
  366. NS=IPCHP(/1)
  367. DO 21 IA=1,NS
  368. MSOUP1=IPCHP(IA)
  369. SEGINI,MSOUPO=MSOUP1
  370. NC=NOHARM(/1)
  371. IPCHP(IA)=MSOUPO
  372. IPT1=IGEOC
  373. SEGINI,IPT2=IPT1
  374. SEGDES IPT2
  375. IGEOC=IPT2
  376. MPOVA1=IPOVAL
  377. SEGINI,MPOVAL=MPOVA1
  378. IPOVAL=MPOVAL
  379. N=VPOCHA(/1)
  380. DO IB=1,N
  381. DO IC=1,NC
  382. TEMPS=VPOCHA(IB,IC)
  383. CALL INTER5(TEMPS,MLREE1,MLREE2,FT0,ISPLIN,MLDERS,
  384. $ IVERI,IRET)
  385. IF (IRET.EQ.0) THEN
  386. SEGSUP MCHPOI,MSOUPO,MPOVAL
  387. GOTO 999
  388. ENDIF
  389. VPOCHA(IB,IC)=FT0
  390. ENDDO
  391. ENDDO
  392. SEGDES MPOVAL
  393. SEGDES MSOUPO
  394. 21 CONTINUE
  395. SEGDES MCHPOI
  396. CALL ECROBJ('CHPOINT ',MFT0)
  397. GOTO 999
  398.  
  399. ******************* T0 EST UN LISTREEL ***********************
  400.  
  401. 30 CONTINUE
  402. MLREE3=MLIST
  403. SEGACT MLREE3
  404. LONG=MLREE3.PROG(/1)
  405. JG=LONG
  406. SEGINI MLREEL
  407. MSOL=MLREEL
  408. DO 31 ILOOP=1,LONG
  409. TEMPS=MLREE3.PROG(ILOOP)
  410. CALL INTER5(TEMPS,MLREE1,MLREE2,FTO,ISPLIN,MLDERS,
  411. $ IVERI,IRET)
  412. IF(IRET.EQ.0) GOTO 999
  413. PROG(ILOOP)=FTO
  414. 31 CONTINUE
  415. SEGDES MLREEL,MLREE3
  416. CALL ECROBJ('LISTREEL',MSOL)
  417. GOTO 999
  418.  
  419. *********************** T0 MCHAML ***************************
  420.  
  421. 40 CONTINUE
  422. IRET=0
  423. MCHEL1=IPO1
  424. SEGINI,MCHELM=MCHEL1
  425. IRET=MCHELM
  426. NSOUS=IMACHE(/1)
  427. DO 72 IA=1,NSOUS
  428. MCHAM1=ICHAML(IA)
  429. SEGINI,MCHAML=MCHAM1
  430. ICHAML(IA)=MCHAML
  431. DO 75 ICOMP=1,IELVAL(/1)
  432. MELVA1 = IELVAL(ICOMP)
  433. SEGINI,MELVAL=MELVA1
  434. IELVAL(ICOMP) = MELVAL
  435. SEGACT MELVA1
  436. IF (TYPCHE(ICOMP).NE.'REAL*8') GOTO 166
  437. N1PTEL=VELCHE(/1)
  438. N1EL =VELCHE(/2)
  439. N2PTEL=0
  440. N2EL =0
  441. DO IB=1,N1PTEL
  442. DO ID=1,N1EL
  443. TEMPS=MELVA1.VELCHE(IB,ID)
  444. CALL INTER5(TEMPS,MLREE1,MLREE2,FT0,ISPLIN,
  445. $ MLDERS,IVERI,IREE)
  446. IF (IREE.EQ.0) THEN
  447. SEGSUP MCHELM,MCHAML,MELVAL
  448. SEGDES MELVA1
  449. GOTO 999
  450. ENDIF
  451. VELCHE(IB,ID)=FT0
  452. ENDDO
  453. ENDDO
  454. 166 SEGDES MELVAL,MELVA1
  455. 75 CONTINUE
  456. SEGDES MCHAML
  457. 72 CONTINUE
  458. SEGDES MCHELM
  459. CALL ECROBJ('MCHAML',IRET)
  460. GOTO 999
  461.  
  462. ************************ OBJET1 TABLE ******************************
  463.  
  464. 50 CONTINUE
  465. MTABLE = IPOT
  466. SEGACT MTABLE
  467. LO = MLOTAB
  468.  
  469. *-- Vérification du format de la table
  470. IF (LO.LE.2) THEN
  471. * La table n'a pas le format désiré
  472. CALL ERREUR(647)
  473. SEGDES MTABLE
  474. RETURN
  475. ENDIF
  476.  
  477. LOR = LO
  478. SEGINI TABR
  479.  
  480. *-- Vérification du sous-type de la table
  481. * IMOT est son indice dans la table
  482. IOK = 0
  483. DO 55 I=1,LO
  484. TYPE1 = MTABTI(I)
  485. IF(TYPE1.EQ.'MOT ') THEN
  486. CHARIN = 'SOUSTYPE'
  487. TYPOBJ = ' '
  488. CALL ACCTAB(MTABLE,TYPE1,IVALIN,XVALIN,CHARIN,LOGIN,
  489. $ IOBIN,TYPOBJ,IVALRE,XVALRE,CHARRE,LOGRE,IOBRE)
  490. segact mtable
  491. IF(CHARIN.EQ.'SOUSTYPE') THEN
  492. IF(CHARRE.EQ.'RESULTAT') THEN
  493. IOK = 1
  494. IMOT = I
  495. ENDIF
  496. ENDIF
  497. ENDIF
  498. 55 CONTINUE
  499.  
  500. IF(IOK.EQ.0) THEN
  501. * Le sous-type de la table est incorrect
  502. CALL ERREUR(648)
  503. SEGDES MTABLE
  504. SEGSUP TABR
  505. RETURN
  506. ENDIF
  507.  
  508. *-- Vérification qu'on a bien des flottants en indice
  509. * en dehors du sous-type
  510. J = 0
  511. DO 56 I=1,LO
  512. IF (IMOT.EQ.I) GOTO 56
  513. J=J+1
  514. TYPEI = MTABTI(I)
  515.  
  516. IF (TYPEI.NE.'FLOTTANT') THEN
  517. * La table n'a pas le format desire
  518. CALL ERREUR(647)
  519. SEGDES MTABLE
  520. SEGSUP TABR
  521. RETURN
  522. ENDIF
  523.  
  524. TEMA(J) = RMTABI(I)
  525. 56 CONTINUE
  526.  
  527. *-- Vérification de l'ordonnancement des indices
  528. DO 57 I=1,LOR-2
  529. TEM1 = TEMA(I)
  530. TEM2 = TEMA(I+1)
  531.  
  532. IF(TEM1.GT.TEM2) THEN
  533. * la liste des indices n'est pas ordonnee
  534. CALL ERREUR(211)
  535. SEGDES MTABLE
  536. SEGSUP TABR
  537. RETURN
  538. ENDIF
  539.  
  540. 57 CONTINUE
  541.  
  542. IF(IMOT.EQ.1) THEN
  543. TEM1 = RMTABI(2)
  544. TYPO1 = MTABTV(2)
  545. IVALO1 = MTABIV(2)
  546. NDEB = 3
  547. ENDIF
  548. IF(IMOT.EQ.2) THEN
  549. TEM1 = RMTABI(1)
  550. TYPO1 = MTABTV(1)
  551. IVALO1 = MTABIV(1)
  552. NDEB = 3
  553. ENDIF
  554. IF(IMOT.GE.3) THEN
  555. TEM1 = RMTABI(1)
  556. TYPO1 = MTABTV(1)
  557. IVALO1 = MTABIV(1)
  558. NDEB = 2
  559. ENDIF
  560.  
  561. DO 58 I=NDEB,LOR
  562. IF(IMOT.EQ.I) GOTO 58
  563. TEM2 = RMTABI(I)
  564. TYPO2 = MTABTV(I)
  565. IVALO2 = MTABIV(I)
  566. IF((TEM1.LE.TEMPS).AND.(TEMPS.LE.TEM2)) THEN
  567. DTEM = (TEMPS-TEM1)/(TEM2-TEM1)
  568. IF(TYPO1.EQ.'CHPOINT ') THEN
  569. IF(TYPO2.EQ.'CHPOINT ') THEN
  570. CALL ECROBJ('CHPOINT',IVALO2)
  571. CALL ECROBJ('CHPOINT',IVALO1)
  572. ELSE
  573. CALL ERREUR(647)
  574. SEGDES MTABLE
  575. SEGSUP TABR
  576. RETURN
  577. ENDIF
  578. ENDIF
  579. IF(TYPO1.EQ.'MCHAML ') THEN
  580. IF(TYPO2.EQ.'MCHAML ') THEN
  581. CALL ECROBJ('MCHAML',IVALO2)
  582. CALL ECROBJ('MCHAML',IVALO1)
  583. ELSE
  584. CALL ERREUR(647)
  585. SEGDES MTABLE
  586. SEGSUP TABR
  587. RETURN
  588. ENDIF
  589. ENDIF
  590. CALL ECRREE(DTEM)
  591. CALL ECRREE(1.D0-DTEM)
  592. CALL COLI
  593. SEGDES MTABLE
  594. SEGSUP TABR
  595. GOTO 500
  596. ENDIF
  597. TEM1 = TEM2
  598. TYPO1 = TYPO2
  599. IVALO1 = IVALO2
  600. 58 CONTINUE
  601.  
  602. * Le temps est en dehors des limites de la table
  603. CALL ERREUR(210)
  604. SEGDES MTABLE
  605. SEGSUP TABR
  606. GOTO 500
  607.  
  608. 999 CONTINUE
  609. IF (ISENS.EQ.0) THEN
  610. SEGDES MLREE1
  611. SEGDES MLREE2
  612. ELSE
  613. SEGSUP MLREE1
  614. SEGSUP MLREE2
  615. ENDIF
  616. IF (ISPLIN.EQ.1) THEN
  617. SEGSUP MLDERS
  618. ENDIF
  619. * Sortie
  620. 500 CONTINUE
  621. RETURN
  622. END
  623.  
  624.  
  625.  
  626.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales