Sources Esope | Cast3M

anabac
C ANABAC    SOURCE    CB215821  24/07/17    21:15:02     11961          
      SUBROUTINE ANABAC
      IMPLICIT INTEGER(I-N)
 
-INC PPARAM
-INC CCOPTIO
-INC SMBLOC
-INC CCNOYAU
-INC CCASSIS
-INC SMLMOTS
      SEGMENT MTTE
         CHARACTER*600 PHRA
         CHARACTER*600 PHRH
         CHARACTER*72 TRA
         CHARACTER*8  NOM
      ENDSEGMENT
      IF ( .NOT. LODESL ) THEN
        IRR=IERR
        IERR=0
        CALL GINT2
        CALL ERREUR (-273)
        IERR=IRR
        CALL GINT2
      END IF
      SEGINI MTTE
      JNDI = 1
      PHRA = ' '
      PHRH = ' '
      if(nbesc.ne.0) segact ipiloc
      DO 104 I=1,ITINTE(/1)
C     WRITE(6,FMT='('' JNDI '',i5)') JNDI
      IPLAC=ITINTE(I)
      IF(IPLAC.LE.0) GO TO 118
      IP=INOOB1(IPLAC)
      IDEBCH = IPCHAR(IP)
      IFINCH=IPCHAR(IP+1)
      NOM = ICHARA(IDEBCH:IFINCH-1)
      IPO=IOUEP2(IPLAC)
      IK=IFINCH-IDEBCH
      IF(NOM.NE.' ') THEN
         PHRA(JNDI:JNDI+IK-1)=NOM(1:IK)
         NOM = INOOB2(IPLAC)
         DO 1042 K=8,1,-1
         IF(NOM(K:K).NE.' ') THEN
            IL=K
            GO TO 1043
         ENDIF
 1042    CONTINUE
 1043    CONTINUE
         PHRH(JNDI:JNDI+IL-1) = NOM
C        WRITE(6,FMT='( '' OBJET'',i4)') IK
         JNDI=JNDI + MAX( IK,IL) + 1
         IF (JNDI.GT.588 ) GO TO 118
      ELSE
         IF(INOOB2(IPLAC).EQ.'ENTIER  ') THEN
           TRA(1:10)=' '
           WRITE(TRA,FMT='(I10)') IPO
           DO 1034 K=1,10
           IF(TRA(K:K).NE.' ') THEN
              IK=K
              GO TO 1035
           ENDIF
 1034      CONTINUE
 1035      CONTINUE
           PHRA(JNDI:JNDI+10-IK)=TRA(IK:10)
           PHRH(JNDI:JNDI+5 )='ENTIER'
           JNDI=JNDI + MAX ( 10 -IK,5) +2
C          WRITE(6,FMT='( '' ENTIER'',i4)') IK
           IF (JNDI.GT.588 ) GO TO 118
         ELSEIF(INOOB2(IPLAC).EQ.'FLOTTANT')THEN
           WRITE(TRA,FMT='(G15.8)')XIFLOT(IPO)
           DO 1036 K=1,15
           IF(TRA(K:K).NE.' ') THEN
              IK=K
              GO TO 1037
           ENDIF
 1036      CONTINUE
 1037      CONTINUE
           DO 1038 K=15,IK,-1
           IF(TRA(K:K).NE.'0'.AND.TRA(K:K).NE.' ') THEN
              IKK=K
              GO TO 1039
           ENDIF
 1038      CONTINUE
 1039      CONTINUE
           PHRA(JNDI:JNDI+IKK-IK)=TRA(IK:IKK)
           PHRH(JNDI:JNDI+7)='FLOTTANT'
           JNDI=JNDI + MAX(IKK-IK,7) + 2
           IK1= IKK -IK
C          WRITE(6,FMT='( '' FLOTTANT'',I4)') IK1
           IF (JNDI.GT.588 ) GO TO 118
         ELSEIF(INOOB2(IPLAC).EQ.'MOT     ')THEN
           JF=IPCHAR(IPO+1)
           ID=IPCHAR(IPO)
           ILO=JF-ID
           PHRA(JNDI:JNDI+ILO-1)=ICHARA(ID:ID+ILO-1)
           PHRH(JNDI:JNDI+ 2   )='MOT'
           JNDI=JNDI + MAX(ILO,3) + 2
C          WRITE(6,FMT='( '' MOT     '',I4)') ILO
           IF (JNDI.GT.588 ) GO TO 118
         ENDIF
      ENDIF
104   CONTINUE
  118 CONTINUE
      if(nbesc.ne.0) SEGDES,IPILOC
      JNDI = JNDI -1
      IF ( .NOT. LODESL ) THEN
        DO      3546 I=1,JNDI,72
        IJ = MIN( JNDI,I * 72)
        WRITE(6,355) PHRA(I:IJ)
        WRITE(6,355) PHRH(I:IJ)
 355    FORMAT ( 1X,A)
 3546   CONTINUE
      ELSE
          JGN = JNDI
          JGM = 2
          SEGINI MLMOTS
          MOTS(1)(1:JGN) = PHRA(1:JGN)
          MOTS(2)(1:JGN) = PHRH(1:JGN)
          SEGDES MLMOTS
          IPCAR1 = MLMOTS
      END IF
      SEGSUP MTTE
      RETURN
      END