Télécharger la plaquette Cast3M


fr en

Télécharger operso.eso

Retour à la liste

Numérotation des lignes : 

operso

  1. C OPERSO    SOURCE    PASCAL    22/11/21    21:15:05     11502          
  2.       SUBROUTINE OPERSO
  3. C_______________________________________________________________________
  4. C
  5. C     SOUSTRAIT  2 NOMBRES  (ENTIER OU FLOTTANT)
  6. C                2 CHPS/ELMTS
  7. C                2 CHPS/POINT
  8. C                2 EVOLUTIONS
  9. C                2 LISTES ENTIERES
  10. C                2 LISTES REELLES
  11. C                2 TABLE SOUSTYPE VECTEUR
  12. C
  13. C     PASSAGE AUX NOUVEAUX MCHAMLS PAR JM CAMPENON LE 29 10 90
  14. C
  15. C_______________________________________________________________________
  16. C
  17.       IMPLICIT INTEGER(I-N)
  18.       IMPLICIT REAL*8(A-H,O-Z)
  19.  
  20. -INC PPARAM
  21. -INC CCOPTIO
  22. -INC SMTABLE
  23. -INC SMLENTI
  24. -INC SMLREEL
  25.  
  26.       PARAMETER (NCLEVO = 2)
  27. C
  28.       CHARACTER*4 CLEVO(NCLEVO)
  29.       CHARACTER*8 CHA1,CHA2,CTYP,COMP
  30.       REAL*8 FLOT1
  31.  
  32.       DATA CLEVO/'ABSC','ORDO'/
  33.  
  34.        INTEGER ICH1
  35.        INTEGER IOPERA
  36.        INTEGER IARGU
  37.        INTEGER I1
  38.        REAL*8 FLO
  39.        INTEGER ICHR
  40.        INTEGER IRET
  41.        ICH1 = 0
  42.        IOPERA = 0
  43.        IARGU = 0
  44.        I1 = 0
  45.        FLO = 0.D0
  46.        ICHR = 0
  47.        IRET = 0
  48.  
  49.       CHA1   = '        '
  50.       CHA2   = '        '
  51. *
  52. *   RECHERCHE DU TYPE DU PREMIER ARGUMENT
  53. *
  54.       CALL QUETYP(CTYP,0,IRETOU)
  55.       IRETOU=0
  56. C_______________________________________________________________________
  57. C
  58. C     CHERCHE A LIROBJ DES CHAMPS PAR ELEMENT (MCHAML)
  59. C_______________________________________________________________________
  60. C      IF (CTYP .NE. 'MCHAML') GOTO 102
  61.       CALL LIROBJ('MCHAML',ICH1,0,IRETOU)
  62.       IF (IRETOU.EQ.0) GOTO 102
  63.       CALL ACTOBJ('MCHAML  ',ICH1,1)
  64.  
  65.       CALL LIROBJ('MCHAML  ',ICH2,0,IRETOU)      
  66.       IF (IRETOU.EQ.0) THEN
  67.         CALL LIRREE(FLO,0,IRETOU)
  68.         IF(IRETOU.EQ.0) THEN
  69.             CALL REFUS
  70.             GOTO 102
  71.         ENDIF
  72. C       IOPERA= 4 pour l'operation ADDITION
  73.         IOPERA= 4
  74.         IF (CTYP .EQ. 'MCHAML  ') THEN
  75. C         IARGU = 2  pour MCHAML - FLOTTANT
  76.           IARGU = 2
  77.         ELSE
  78. C         IARGU = 21 pour FLOTTANT - MCHAML
  79.           IARGU = 21
  80.         ENDIF
  81.         I1    = 0
  82.         ICHR = 0
  83.         IRET = 0
  84.         CALL OPCHE1(ICH1,IOPERA,IARGU,I1,FLO,ICHR,IRET)
  85.         IF(IRET.NE.0) THEN
  86.           CALL ACTOBJ('MCHAML  ',ICHR,1)
  87.           CALL ECROBJ('MCHAML  ',ICHR)
  88.         ELSE
  89.           CALL ERREUR(26)
  90.         ENDIF
  91.         RETURN
  92.  
  93.       ELSE
  94.         CALL ADCHEL(ICH1,ICH2,IPCHAD,-1)
  95.         IF (IPCHAD.EQ.0) RETURN
  96.         CALL ACTOBJ('MCHAML  ',IPCHAD,1)
  97.         CALL ECROBJ('MCHAML  ',IPCHAD)
  98.         ENDIF
  99.       RETURN
  100.  
  101. C_______________________________________________________________________
  102. C
  103. C     CHERCHE A LIROBJ DES CHPOINT
  104. C_______________________________________________________________________
  105.   102 CALL LIROBJ('CHPOINT ',IPO1,0,IRETOU)
  106.       IF (IRETOU.EQ.0) GOTO 103
  107.       CALL ACTOBJ('CHPOINT ',IPO1,1)
  108.       CALL LIROBJ('CHPOINT ',IPO2,0,IRETOU)
  109.       IF (IRETOU.EQ.0) THEN
  110.           CALL REFUS
  111.           GOTO 103
  112.       ENDIF
  113.       CALL ACTOBJ('CHPOINT ',IPO2,1)
  114.       CALL ADCHPO(IPO1,IPO2,IRET,1D0,-1D0)
  115.       IF(IRET.EQ.0) RETURN
  116.       CALL ACTOBJ('CHPOINT ',IRET,1)
  117.       CALL ECROBJ('CHPOINT ',IRET)
  118.       RETURN
  119. C_______________________________________________________________________
  120. C
  121. C  SOUSTRACTION CHPOINT-FLOTTANT OU FLOTTANT-CHPOINT
  122. C_______________________________________________________________________
  123.   103 CALL LIROBJ('CHPOINT ',ICH,0,IRETOU)
  124.       IF (IRETOU.EQ.0) GOTO 104
  125.       CALL ACTOBJ('CHPOINT ',ICH,1)
  126.       CALL LIRREE(FLO,0,IRETOU)
  127.       IF (IRETOU.EQ.0) THEN
  128.           CALL REFUS
  129.           GOTO 104
  130.       ENDIF
  131. C     IOPERA= 4 pour l'operation SOUSTRACTION
  132.       IOPERA= 4
  133.       IF (CTYP .EQ. 'CHPOINT ') THEN
  134. C       IARGU = 2  pour CHPOINT - FLOTTANT
  135.         IARGU = 2
  136.       ELSE
  137. C       IARGU = 21 pour FLOTTANT - CHPOINT
  138.         IARGU = 21
  139.       ENDIF
  140.       I1    = 0
  141.       CALL OPCHP1(ICH,IOPERA,IARGU,I1,FLO,ICHR,IRET)
  142.       IF(IRET.NE.0) THEN
  143.         CALL ACTOBJ('CHPOINT ',ICHR,1)
  144.         CALL ECROBJ('CHPOINT ',ICHR)
  145.       ELSE
  146.         CALL ERREUR(26)
  147.       ENDIF
  148.       RETURN
  149. C_______________________________________________________________________
  150. C
  151. C     CHERCHE A LIROBJ DES EVOLUTIONS
  152. C_______________________________________________________________________
  153.   104 CALL LIROBJ('EVOLUTIO',IPO1,0,IRETOU)
  154.       IF(IRETOU.EQ.0) GOTO 105
  155.       CALL ACTOBJ('EVOLUTIO',IPO1,1)
  156.       CALL LIROBJ('EVOLUTIO',IPO2,0,IRETOU)
  157.       IF (IRETOU.EQ.0) THEN
  158.           CALL REFUS
  159.           GOTO 105
  160.       ENDIF
  161.       CALL ACTOBJ('EVOLUTIO',IPO2,1)
  162.       CALL ADEVOL(IPO1,IPO2,IRET,-1)
  163.       IF(IRET.EQ.0) RETURN
  164.       CALL ACTOBJ('EVOLUTIO',IRET,1)
  165.       CALL ECROBJ('EVOLUTIO',IRET)
  166.       RETURN
  167. C_______________________________________________________________________
  168. C
  169. C     CHERCHE A LIROBJ DES LISTREEL
  170. C_______________________________________________________________________
  171.   105 CALL LIROBJ('LISTREEL',ICH1,0,IRETOU)
  172.       IF(IRETOU.EQ.0) GOTO 106
  173.       MLREEL=ICH1
  174.       SEGACT,MLREEL
  175.       CALL LIROBJ('LISTREEL',ICHR,0,IRETOU)
  176.       IF (IRETOU.EQ.0) THEN
  177.           CALL REFUS
  178.           GOTO 106
  179.       ENDIF
  180.       MLREEL=ICHR
  181.       SEGACT,MLREEL
  182. C     IOPERA= 4 pour l'operation SOUSTRACTION
  183. C     IARGU = 0
  184.       IOPERA= 4
  185.       IARGU = 0
  186.       I1    = 0
  187.       FLO   = REAL(0.D0)
  188.       CALL OPLRE1(ICH1,IOPERA,IARGU,I1,FLO,ICHR,IRET)
  189.       IF(IRET.NE.0) THEN
  190.         MLREEL=ICHR
  191.         SEGACT,MLREEL*NOMOD
  192.         CALL ECROBJ('LISTREEL',ICHR)
  193.       ELSE
  194.         CALL ERREUR(26)
  195.       ENDIF
  196.       RETURN
  197. C_______________________________________________________________________
  198. C
  199. C     CHERCHE A LIROBJ DES LISTENTI
  200. C_______________________________________________________________________
  201.   106 CALL LIROBJ('LISTENTI',IPO1,0,IRETOU)
  202.       IF(IRETOU.EQ.0) GOTO 1061
  203.       MLENTI=IPO1
  204.       SEGACT,MLENTI
  205.       CALL LIROBJ('LISTENTI',IPO2,0,IRETOU)
  206.       IF (IRETOU.EQ.0) THEN
  207.           CALL REFUS
  208.           GOTO 1061
  209.       ENDIF
  210.       MLENTI=IPO2
  211.       SEGACT,MLENTI
  212.       CALL ADLISE(IPO1,IPO2,IRET,-1)
  213.       IF(IRET.EQ.0) RETURN
  214.       MLENTI=IRET
  215.       SEGACT,MLENTI*NOMOD
  216.       CALL ECROBJ('LISTENTI',IRET)
  217.       RETURN
  218. C_______________________________________________________________________
  219. C
  220. C     CHERCHE A LIROBJ 1 LISTREEL ET 1 LISTENTI
  221. C_______________________________________________________________________C
  222.  1061 CALL LIROBJ('LISTREEL',IPO1,0,IRETOU)
  223.       IF(IRETOU.EQ.0) GOTO 1062
  224.       MLREEL=IPO1
  225.       SEGACT,MLREEL
  226.       CALL LIROBJ('LISTENTI',MLENTI,0,IRETOU)
  227.       IF(IRETOU.EQ.0) THEN
  228.            CALL REFUS
  229.            GOTO 1062
  230.       ENDIF
  231. C     Conversion du LISTENTI en LISTREEL
  232.       SEGACT,MLENTI
  233.       JG=LECT(/1)
  234.       SEGINI,MLREEL
  235.       DO IG=1,JG
  236.         PROG(IG)= REAL(LECT(IG))
  237.       ENDDO
  238.  
  239.       IF( CTYP .EQ. 'LISTENTI') THEN
  240.         CALL ADLISR(MLREEL,IPO1,IRET,-1)
  241.       ELSE
  242.         CALL ADLISR(IPO1,MLREEL,IRET,-1)
  243.       ENDIF
  244.       IF(IRET.EQ.0) RETURN
  245.       MLREEL=IRET
  246.       SEGACT,MLREEL*NOMOD
  247.       CALL ECROBJ('LISTREEL',IRET)
  248.       RETURN
  249. C_______________________________________________________________________
  250. C
  251. C     CHERCHE A LIROBJ 1 LISTREEL ET 1 ENTIER / FLOTTANT
  252. C_______________________________________________________________________
  253.  1062 CALL LIROBJ('LISTREEL',ICH1,0,IRETOU)
  254.       IF(IRETOU.EQ.0) GOTO 1063
  255.       MLREEL=ICH1
  256.       SEGACT,MLREEL
  257.       CALL LIRREE(FLO,0,IR2)
  258.       IF(IR2 .EQ. 0) THEN
  259.         CALL REFUS
  260.         GOTO 1063
  261.       ENDIF
  262. C     IOPERA= 4 pour l'operation SOUSTRACTION
  263.       IOPERA= 4
  264.       IF (CTYP .EQ. 'LISTREEL') THEN
  265. C       IARGU = 2  pour LISTREEL - FLOTTANT
  266.         IARGU = 2
  267.       ELSE
  268. C       IARGU = 21 pour FLOTTANT - LISTREEL
  269.         IARGU = 21
  270.       ENDIF
  271.       I1    = 0
  272.       CALL OPLRE1(ICH1,IOPERA,IARGU,I1,FLO,ICHR,IRET)
  273.       IF(IRET.NE.0) THEN
  274.         MLREEL=ICHR
  275.         SEGACT,MLREEL*NOMOD
  276.         CALL ECROBJ('LISTREEL',ICHR)
  277.       ELSE
  278.         CALL ERREUR(26)
  279.       ENDIF
  280.       RETURN
  281. C_______________________________________________________________________
  282. C
  283. C     CHERCHE A LIROBJ 1 LISTENTI ET 1 ENTIER / FLOTTANT
  284. C_______________________________________________________________________
  285.  1063 CALL LIROBJ('LISTENTI',MLENT1,0,IRETOU)
  286.       IF(IRETOU.EQ.0) GOTO 107
  287.       MLENTI=MLENT1
  288.       SEGACT,MLENTI
  289.  
  290.       CALL LIRENT(I1,0,IR1)
  291.       CALL LIRREE(X1,0,IR2)
  292.  
  293.       IF( (IR1.EQ.0) .AND. (IR2.EQ.0)) THEN
  294.         CALL REFUS
  295.         GOTO 107
  296.       ENDIF
  297. C     Soustraction entre l'ENTIER/FLOTTANT et tous les indices du LISTENTIER
  298.       JG=MLENT1.LECT(/1)
  299.       IF (IR1 .NE. 0) THEN
  300. C       Cas de la soustraction avec un ENTIER
  301.         SEGINI,MLENT2
  302.         DO IG=1,JG
  303.           IF( CTYP .EQ. 'ENTIER  ') THEN
  304.             IENT1   = I1 - MLENT1.LECT(IG)
  305.             MLENT2.LECT(IG)= IENT1
  306.           ELSE
  307.             IENT1   = MLENT1.LECT(IG) - I1
  308.             MLENT2.LECT(IG)= IENT1
  309.           ENDIF
  310.         ENDDO
  311.         SEGACT,MLENT2*NOMOD
  312.         CALL ECROBJ('LISTENTI',MLENT2)
  313.  
  314.       ELSEIF (IR2 .NE. 0) THEN
  315. C       Cas de la soustraction avec un FLOTTANT
  316.         SEGINI,MLREE2
  317.         DO IG=1,JG
  318.           IF( CTYP .EQ. 'FLOTTANT') THEN
  319.             FLOT1   = X1 - REAL(MLENT1.LECT(IG))
  320.             MLREE2.PROG(IG)= FLOT1
  321.           ELSE
  322.             FLOT1   = REAL(MLENT1.LECT(IG)) - X1
  323.             MLREE2.PROG(IG)= FLOT1
  324.           ENDIF
  325.         ENDDO
  326.         SEGACT,MLREE2*NOMOD
  327.         CALL ECROBJ('LISTREEL',MLREE2)
  328.       ENDIF 
  329.       RETURN
  330. C_______________________________________________________________________
  331. C
  332. C     CHERCHE A LIROBJ 2 NOMBRES ENTIER
  333. C_______________________________________________________________________
  334.   107 CALL LIRENT(I1,0,IRETOU)
  335.       IF (IRETOU.EQ.0) GOTO 108
  336.       CALL LIRENT(I2,0,IRETOU)
  337.       IF (IRETOU.EQ.0) THEN
  338.           CALL REFUS
  339.           GOTO 108
  340.       ENDIF
  341.       CALL ECRENT(I1-I2)
  342.       RETURN
  343. C_______________________________________________________________________
  344. C
  345. C     CHERCHE A LIROBJ 2 NOMBRES FLOTTANTS
  346. C_______________________________________________________________________
  347.   108 CALL LIRREE(X1,0,IRETOU)
  348.       IF (IRETOU.EQ.0) GOTO 109
  349.       CALL LIRREE(X2,0,IRETOU)
  350.       IF (IRETOU.EQ.0) THEN
  351.           CALL REFUS
  352.           GOTO 109
  353.       ENDIF
  354.       CALL ECRREE(X1-X2)
  355.       RETURN
  356. C_______________________________________________________________________
  357. C
  358. C     CHERCHE A LIROBJ 2 TABLES SOUS-TYPE VECTEUR
  359. C_______________________________________________________________________
  360.  109  CALL LIRTAB('VECTEUR',MTAB1,0,IRETOU)
  361.       IF (IRETOU.EQ.0) GOTO 110
  362.       CALL QUENOM(MOTERR(1:8))
  363.       CALL LIRTAB('VECTEUR',MTAB2,0,IRETOU)
  364.       IF (IRETOU.EQ.0) THEN
  365.           CALL REFUS
  366.           GOTO 110
  367.       ENDIF
  368.       CALL QUENOM(MOTERR(9:16))
  369.       SEGINI,MTABLE=MTAB1
  370.       SEGACT MTAB2
  371.       DO 71 J=1,MTAB2.MLOTAB
  372.        CHA1=MTAB2.MTABTI(J)
  373.        X1=MTAB2.RMTABI(J)
  374.        IVA1=MTAB2.MTABII(J)
  375.        DO 72 I=1,MLOTAB
  376.         IF (CHA1.NE.MTABTI(I)) GOTO 72
  377.         IF (CHA1.EQ.'FLOTTANT') THEN
  378.           IF (X1.NE.RMTABI(I)) GOTO 72
  379.         ELSE
  380.           IF (IVA1.NE.MTABII(I)) GOTO 72
  381.         ENDIF
  382. *  ON A UN INDICE COMMUN ON REGARDE SI LE TYPE DE LA DONNEE EST SOMMABLE
  383.         CHA2=MTAB2.MTABTV(J)
  384.         IF (CHA2.EQ.'FLOTTANT') THEN
  385.          IF (MTABTV(I).EQ.'FLOTTANT') THEN
  386.             RMTABV(I)=RMTABV(I)-MTAB2.RMTABV(J)
  387.          ELSEIF (MTABTV(I).EQ.'ENTIER  ') THEN
  388.             MTABTV(I)='FLOTTANT'
  389.             RMTABV(I)=MTABIV(I)-MTAB2.RMTABV(J)
  390.          ELSE
  391.             CALL ERREUR(135)
  392.          ENDIF
  393.         ELSEIF (CHA2.EQ.'ENTIER  ') THEN
  394.          IF (MTABTV(I).EQ.'ENTIER  ') THEN
  395.             MTABIV(I)=MTABIV(I)-MTAB2.MTABIV(J)
  396.          ELSEIF (MTABTV(I).EQ.'FLOTTANT') THEN
  397.             RMTABV(I)=RMTABV(I)-MTAB2.MTABIV(J)
  398.          ELSE
  399.             CALL ERREUR(135)
  400.          ENDIF
  401.         ELSE
  402.            IF (MTABTV(I).NE.CHA2.OR.MTABTV(I).NE.MTAB2.MTABTV(J))
  403.      #          CALL ERREUR(135)
  404.         ENDIF
  405. *  C'EST PASSE OU CA A CASSE ON SORT
  406.         IF (IERR.NE.0) RETURN
  407.         GOTO 71
  408.   72    CONTINUE
  409. *  ON RAJOUTE LE MTAB2(J) A MTABL
  410.         MLOTAB=MLOTAB+1
  411.         M=MTABII(/1)
  412.         IF (M.LT.MLOTAB) THEN
  413.          M=M+100
  414.          SEGADJ MTABLE
  415.         ENDIF
  416.         MTABII(MLOTAB)=MTAB2.MTABII(J)
  417.         MTABTI(MLOTAB)=MTAB2.MTABTI(J)
  418.         RMTABI(MLOTAB)=MTAB2.RMTABI(J)
  419.         MTABIV(MLOTAB)=MTAB2.MTABIV(J)
  420.         MTABTV(MLOTAB)=MTAB2.MTABTV(J)
  421.         RMTABV(MLOTAB)=-MTAB2.RMTABV(J)
  422. *  SI ENTIER ON OPPOSE
  423.         IF (MTABTV(MLOTAB).EQ.'ENTIER  ') MTABIV(MLOTAB)=-MTABIV(MLOTAB)
  424.   71  CONTINUE
  425.       SEGDES MTABLE,MTAB1,MTAB2
  426.       CALL ECROBJ('TABLE',MTABLE)
  427.       RETURN
  428. C_______________________________________________________________________
  429. C
  430. C     CHERCHE A LIROBJ 1 EVOLUTIO ET 1 ENTIER / FLOTTANT
  431. C_______________________________________________________________________
  432.  110  CALL LIROBJ('EVOLUTIO',ICH,0,IRETOU)
  433.       IF(IRETOU.EQ.0) GOTO 111
  434.       CALL ACTOBJ('EVOLUTIO',ICH,1)
  435.       CALL LIRENT(I1,0,IREENT)
  436.       IF(IREENT.EQ.0) THEN
  437.         I1=0
  438.         CALL LIRREE(FLO,0,IREFLO)
  439.         IF(IREFLO.EQ.0) THEN      
  440.           CALL REFUS
  441.           GOTO 111
  442.         ELSE
  443.           IF (CTYP .EQ. 'EVOLUTIO') THEN
  444. C           IARGU = 2  pour EVOLUTIO - FLOTTANT
  445.             IARGU = 2
  446.           ELSE
  447. C           IARGU = 21 pour FLOTTANT - EVOLUTIO
  448.             IARGU = 21
  449.           ENDIF
  450.         ENDIF
  451.       ELSE
  452.         FLO=REAL(0.D0)
  453.         IF (CTYP .EQ. 'EVOLUTIO') THEN
  454. C         IARGU = 1  pour EVOLUTIO - ENTIER
  455.           IARGU = 1
  456.         ELSE
  457. C         IARGU = 11 pour ENTIER   - EVOLUTIO
  458.           IARGU = 11
  459.         ENDIF
  460.       ENDIF
  461. C     Soustraction entre l'ENTIER/FLOTTANT et tous les indices du EVOLUTIO
  462. C     IOPERA= 4 pour l'operation SOUSTRACTION
  463.       IOPERA= 4
  464.       ICLE = 0
  465.       CALL LIRMOT(CLEVO,NCLEVO,ICLE,0)
  466.       IF (ICLE.EQ.0) ICLE = 2
  467.       CALL OPEVO1(ICH,IOPERA,IARGU,ICLE,I1,FLO,ICHR,IRET)
  468.       IF(IRET.NE.0) THEN
  469.         CALL ACTOBJ('EVOLUTIO',ICHR,1)
  470.         CALL ECROBJ('EVOLUTIO',ICHR)
  471.       ELSE
  472.         CALL ERREUR(26)
  473.       ENDIF
  474.       RETURN
  475. C_______________________________________________________________________
  476. C
  477. C     CHERCHE A LIROBJ 1 NUAGE ET 1 ENTIER / FLOTTANT
  478. C_______________________________________________________________________
  479.  111  CALL LIROBJ('NUAGE   ',ICH,0,IRETOU)
  480.       IF(IRETOU.EQ.0) GOTO 120
  481.       CALL ACTOBJ('NUAGE   ',ICH,1)
  482.       CALL LIRENT(I1,0,IREENT)
  483.       IF (IREENT.EQ.0) THEN
  484.         I1=0
  485.         CALL LIRREE(FLO,0,IREFLO)
  486.         IF (IREFLO.EQ.0) THEN
  487.           CALL REFUS
  488.           GOTO 120
  489.         ELSE
  490.           IF (CTYP .EQ. 'NUAGE   ') THEN
  491. C           IARGU = 2  pour NUAGE - FLOTTANT
  492.             IARGU = 2
  493.           ELSE
  494. C           IARGU = 21 pour FLOTTANT - NUAGE
  495.             IARGU = 21
  496.           ENDIF
  497.         ENDIF
  498.       ELSE
  499.         FLO=REAL(0.D0)
  500.         IF (CTYP .EQ. 'NUAGE   ') THEN
  501. C         IARGU = 1  pour NUAGE - ENTIER
  502.           IARGU = 1
  503.         ELSE
  504. C         IARGU = 11 pour ENTIER   - NUAGE
  505.           IARGU = 11
  506.         ENDIF
  507.       ENDIF
  508. C     Lecture du nom de la composante
  509.       CALL LIRCHA(COMP,1,IRETOU)
  510.       IF (IERR.NE.0) RETURN
  511. C     Soustraction entre l'ENTIER/FLOTTANT et les valeurs du NUAGE
  512. C     IOPERA= 4 pour l'operation SOUSTRACTION
  513.       IOPERA= 4
  514.       CALL OPNUA1(ICH,IOPERA,IARGU,COMP,I1,FLO,ICHR,IRET)
  515.       IF (IERR.NE.0) RETURN
  516.       IF(IRET.NE.0) THEN
  517.         CALL ACTOBJ('NUAGE   ',ICHR,1)
  518.         CALL ECROBJ('NUAGE   ',ICHR)
  519.       ELSE
  520. C       ERREUR 5 car erreurs gerees dans OPNUA1
  521.         CALL ERREUR(5)
  522.       ENDIF
  523.       RETURN
  524.  
  525. C_______________________________________________________________________
  526. C
  527. C   ON A DONC RIEN TROUVE POUR FAIRE L OPERATION
  528. C_______________________________________________________________________
  529.   120 CONTINUE
  530.       CALL QUETYP(MOTERR(1:8),0,IRETOU)
  531.       IF(IRETOU.NE.0) THEN
  532.          CALL LIROBJ(MOTERR(1:8),IRET,1,IRETOU)
  533.          CALL QUETYP(MOTERR(9:16),0,IRETOU)
  534.          IF (IRETOU.EQ.0)  MOTERR(9:16) = '  ????  '
  535.          CALL ERREUR(532)
  536.       ELSE
  537.          CALL ERREUR(533)
  538.       ENDIF
  539.  
  540.       RETURN
  541.       END
  542.  
  543.  
  544.  
  545.  
  546.  
  547.  

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