Sources Esope | Cast3M

method
C METHOD    SOURCE    PV090527  24/01/09    21:15:16     11817          
      SUBROUTINE METHOD
      IMPLICIT INTEGER(I-N)
      IMPLICIT REAL*8(A-H,O-Z)
 
-INC PPARAM
-INC CCOPTIO
-INC CCNOYAU
-INC SMTABLE
-INC SMBLOC
-INC CCASSIS
      CHARACTER*(8)INOMP,CHAANC
      CHARACTER*72 ICHA
      LOGICAL LOGI
 
      XX=0.D0
 
      CALL LIROBJ ('OBJET   ',MTABLE,0,IRETOU)
      IF(IRETOU.EQ.0) THEN
        IF(MOBJCO.NE.0) THEN
          MTABLE=MOBJCO
        ELSE
          MOTERR(1:8)='OBJET   '
          CALL ERREUR(37)
        ENDIF
      ENDIF
*      write(6,*) ' 1 method mtable',mtable
      IF(IERR.NE.0) RETURN
* lecture du nom de la methode en fait on cherche sa position
* dans la pile des  chaines
      ILON=1
      CALL QUETYP (CHAANC ,0,IRETOU)
*      write(6,*)' method chaanc' , chaanc
      IF(IRETOU.EQ.0) RETURN
      IF(CHAANC.EQ.'ENTIER  ') THEN
                CALL LIRENT ( II,1,IRETOU)
      ELSEIF(CHAANC.EQ.'FLOTTANT') THEN
                CALL LIRREE(XRET,1,IRETOU)
      ELSEIF(CHAANC.EQ.'MOT     ') THEN
                CALL LIRCHA(ICHA,1,ILON)
      ELSEIF(CHAANC.EQ.'LOGIQUE ') THEN
                CALL LIRLOG(LOGI,1,IRETOU)
      ELSE
                CALL LIROBJ(CHAANC,IRET,1,IRETOU)
*      write(6,*) ' 2 method mtable',iret
      ENDIF
*      write(6,*) ' method iret imotlu jpoob2',
*     $ iret,imotlu,jpoob2(imotlu)
      IF(JPOOB2(IMOTLU).EQ.0) THEN
C  PAS DE NOM A LA DERNIERE DONNEE LUE
          CALL ERREUR(21)
          RETURN
      ENDIF
      IP=INOOB1(JPOOB2(IMOTLU))
      IF(IP.NE.1) THEN
        if(nbesc.ne.0) segact ipiloc
        IDEBCH=IPCHAR(IP)
        IFINCH= IPCHAR(IP+1)-1
        ICHA=ICHARA(IDEBCH:IFINCH)
        ILON=IFINCH-IDEBCH+1
        if(nbesc.ne.0) SEGDES,IPILOC
      ENDIF
* lecture de la procedur
      CALL  LIROBJ ('PROCEDUR',IVAL,1,IRETOU)
      IF(IERR.NE.0) RETURN
      CALL ECCTAB (MTABLE, 'METHODE ',IP,XX,ICHA(1:ILON),LOGI,IP,
     $      'PROCEDUR',IVAL,XX,ICHA,LOGI,IVAL)
      RETURN
      END