Esope source files

   1 : C METHOD    SOURCE    CHAT      06/03/16    21:21:38     5336           
   2 :       SUBROUTINE METHOD
   3 :       IMPLICIT INTEGER(I-N)
   4 :       IMPLICIT REAL*8(A-H,O-Z)
   5 : -INC CCOPTIO
   6 : -INC CCNOYAU
   7 : -INC SMTABLE
   8 : -INC SMBLOC
   9 : -INC CCASSIS
  10 :       CHARACTER*(8)INOMP,CHAANC
  11 :       CHARACTER*72 ICHA
  12 :       LOGICAL LOGI
  12 :       CALL LIROBJ ('OBJET   ',MTABLE,0,IRETOU)
  13 :       IF(IRETOU.EQ.0) THEN
  14 :         IF(MOBJCO.NE.0) THEN
  15 :           MTABLE=MOBJCO
  16 :         ELSE
  17 :           MOTERR(1:8)='OBJET   '
  17 :           CALL ERREUR(37)
  18 :         ENDIF
  19 :       ENDIF
  20 : *      write(6,*) ' 1 method mtable',mtable
  21 :       IF(IERR.NE.0) RETURN
  22 : * lecture du nom de la methode en fait on cherche sa position
  23 : * dans la pile des  chaines 
  24 :       ILON=1
  24 :       CALL QUETYP (CHAANC ,0,IRETOU)
  25 : *      write(6,*)' method chaanc' , chaanc  
  26 :       IF(IRETOU.EQ.0) RETURN                 
  27 :       IF(CHAANC.EQ.'ENTIER  ') THEN                                      
  27 :                 CALL LIRENT ( II,1,IRETOU)                               
  28 :       ELSEIF(CHAANC.EQ.'FLOTTANT') THEN                                  
  28 :                 CALL LIRREE(XRET,1,IRETOU)                               
  29 :       ELSEIF(CHAANC.EQ.'MOT     ') THEN                                  
  29 :                 CALL LIRCHA(ICHA,1,ILON)                               
  30 :       ELSEIF(CHAANC.EQ.'LOGIQUE ') THEN                                  
  30 :                 CALL LIRLOG(LOGI,1,IRETOU)                               
  31 :       ELSE                                                               
  31 :                 CALL LIROBJ(CHAANC,IRET,1,IRETOU) 
  32 : *      write(6,*) ' 2 method mtable',iret                              
  33 :       ENDIF 
  34 : *      write(6,*) ' method iret imotlu jpoob2',
  35 : *     $ iret,imotlu,jpoob2(imotlu)      
  36 :       IF(JPOOB2(IMOTLU).EQ.0) THEN 
  37 : C  PAS DE NOM A LA DERNIERE DONNEE LUE  
  37 :           CALL ERREUR(21)                                                
  38 :           RETURN                                                         
  39 :       ENDIF
  40 :       IP=INOOB1(JPOOB2(IMOTLU))
  41 :       IF(IP.NE.1) THEN
  42 :         if(nbesc.ne.0) segact ipiloc
  43 :         IDEBCH=IPCHAR(IP)
  44 :         IFINCH= IPCHAR(IP+1)-1                                           
  45 :         ICHA=ICHARA(IDEBCH:IFINCH) 
  46 :         ILON=IFINCH-IDEBCH+1
  47 :         if(nbesc.ne.0) segdes ipiloc
  48 :       ENDIF  
  49 : * lecture de la procedur
  49 :       CALL  LIROBJ ('PROCEDUR',IVAL,1,IRETOU)
  50 :       IF(IERR.NE.0) RETURN
  50 :       CALL ECCTAB (MTABLE, 'METHODE ',IP,XX,ICHA(1:ILON),LOGI,IP,
  51 :      $      'PROCEDUR',IVAL,XX,ICHA,LOGI,IVAL)
  52 :       RETURN
  53 :       END    
  54 :