Télécharger la plaquette Cast3M


fr en

Télécharger trback.eso

Retour à la liste

Numérotation des lignes : 

trback

  1. C TRBACK    SOURCE    PV090527  24/01/10    21:15:07     11818          
  2.       SUBROUTINE TRBACK
  3.       IMPLICIT INTEGER(I-N)
  4.  
  5. -INC PPARAM
  6. -INC CCOPTIO
  7. -INC SMBLOC
  8. -INC CCNOYAU
  9. -INC CCASSIS
  10.       CHARACTER*4 MFIN(4)
  11.       CHARACTER*8 CTYP
  12.       DATA MFIN/'FIN ','REPE','FINP','FINM'/
  13.       IIR=IERR
  14.       IERR=0
  15.       CALLGINT2
  16.  
  17. C      MTXBLC=MTXBL
  18. C      SEGACT MTXBLC
  19. C      MTXBLL=MTXBLC(MBCOUR)
  20. C      SEGACT MTXBLL
  21.       INTERR(1)=MBCOUR
  22. *     WRITE(6,FMT='(''  MBCOUR NUINST '',2I6)')MBCOUR,NUINST
  23. C      SEGDES MTXBLL
  24.       CALL ERREUR(-253)
  25.       CALL TRBAC
  26.       if(nbesc.ne.0) segact ipiloc
  27.       IERR=0
  28.       if(MISAUP.EQ.1) then
  29.          CALL NOUTRU
  30.          MBFONC=1
  31.          RETURN
  32.       ENDIF
  33.    1  CONTINUE
  34.       CALL NOUTRU
  35.       LECTAB=1
  36.       CALL LIRMOT(MFIN,4,IRETOU,0)
  37.       if(nbesc.ne.0) segact ipiloc
  38.       IF (IRETOU.EQ.0) THEN
  39.            GOTO 1
  40.       ELSEIF ( IRETOU.EQ.2) THEN
  41.            CALL REPETE(1)
  42.            MBCONT=1
  43.            GO TO 1
  44.       ELSEIF ( IRETOU.EQ.3.OR.IRETOU.EQ.4) THEN
  45.             ILONG=LMNNOM
  46.             MOTERR =' '
  47.             IF(ILONG.EQ.0)  then
  48.                  if(nbesc.ne.0) SEGDES,IPILOC
  49.                  RETURN
  50.             ENDIF
  51.             DO 10 I=1,ILONG
  52.               IF(INOOB1(I).EQ.1)              GO TO 10
  53.               IF(INOOB2(I).NE.'PROCEDUR')     GO TO 10
  54.               IF(MBLPRO.NE.ipipr1(IOUEP2(I))) GO TO 10
  55.               IP     =INOOB1(I)
  56.               IDEBCH =IPCHAR(IP)
  57.               IFINCH =IPCHAR(IP+1)-1
  58.               MOTERR =ICHARA(IDEBCH:IFINCH)
  59.             GO TO 11
  60.    10       CONTINUE
  61.  
  62.    11      CONTINUE
  63.            IERR=IIR
  64.            CALLGINT2
  65.            CALL FINPRO
  66.            IIR=IERR
  67.            IERR=0
  68.            CALLGINT2
  69.            IF(MBLSUP.NE.0.AND.MBFONC.EQ.0) THEN
  70.             MTXBLC=MTXBL
  71. C           MTXBLL=MTXBLC(MBCOUR)
  72. C           SEGACT MTXBLL
  73.             INTERR(1)= MBCOUR
  74.             CALL ERREUR(-255)
  75. C           SEGDES MTXBLL
  76.            ELSE
  77.             CALL ERREUR(-254)
  78.            ENDIF
  79.            CALL TRBAC
  80.            if(nbesc.ne.0) SEGDES,IPILOC
  81.            IF(MBLSUP.EQ.0.OR.MBFONC.NE.0) GO TO 2
  82.       ELSEIF ( IRETOU.EQ.1) THEN
  83.            MBCONT=1
  84.           CALL FIN
  85.           IF (MBLSUP.EQ.0.OR.MBFONC.NE.0) GO TO 2
  86.       ENDIF
  87.       GO TO 1
  88.    2  CONTINUE
  89.       if(nbesc.ne.0) SEGDES,IPILOC
  90.       IERR=IIR
  91.       CALLGINT2
  92.       RETURN
  93.       END
  94.  
  95.  
  96.  
  97.  

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