Download anabac.eso

Back to the list

   1 : C ANABAC    SOURCE    CHAT      06/03/29    21:15:24     5360           
   2 :       SUBROUTINE ANABAC                                                  
   3 :       IMPLICIT INTEGER(I-N)
   4 : -INC CCOPTIO                                                             
   5 : -INC SMBLOC                                                              
   6 : -INC CCNOYAU                                                             
   7 : -INC CCASSIS
   8 : -INC SMLMOTS
   9 :       SEGMENT MTTE                                                       
  10 :          CHARACTER*600 PHRA                                              
  11 :          CHARACTER*600 PHRH                                              
  12 :          CHARACTER*72 TRA                                                
  13 :          CHARACTER*8  NOM                                                
  14 :       ENDSEGMENT                                                         
  15 :       IF ( .NOT. LODESL ) THEN
  16 :         IRR=IERR
  17 :         IERR=0
  17 :         CALL GINT2
  17 :         CALL ERREUR (-273)
  18 :         IERR=IRR 
  18 :         CALL GINT2
  19 :       END IF
  20 :       SEGINI MTTE                                                        
  21 :       JNDI = 1                                                           
  22 :       PHRA = ' '                                                         
  23 :       PHRH = ' ' 
  24 :       if(nbesc.ne.0) segact ipiloc                                       
  25 :       DO 104 I=1,ITINTE(/1)                                              
  26 : C     WRITE(6,FMT='('' JNDI '',i5)') JNDI                                
  27 :       IPLAC=ITINTE(I)                                                    
  28 :       IF(IPLAC.LE.0) GO TO 118
  29 :       IP=INOOB1(IPLAC)
  30 :       IDEBCH = IPCHAR(IP)
  31 :       IFINCH=IPCHAR(IP+1)                                                
  32 :       NOM = ICHARA(IDEBCH:IFINCH-1)                                      
  33 :       IPO=IOUEP2(IPLAC) 
  34 :       IK=IFINCH-IDEBCH                                                   
  35 :       IF(NOM.NE.' ') THEN                                                
  36 :          PHRA(JNDI:JNDI+IK-1)=NOM(1:IK)                                  
  37 :          NOM = INOOB2(IPLAC)                                             
  38 :          DO 1042 K=8,1,-1                                                
  39 :          IF(NOM(K:K).NE.' ') THEN                                        
  40 :             IL=K                                                         
  41 :             GO TO 1043                                                   
  42 :          ENDIF                                                           
  43 :  1042    CONTINUE                                                        
  44 :  1043    CONTINUE                                                        
  45 :          PHRH(JNDI:JNDI+IL-1) = NOM                                      
  46 : C        WRITE(6,FMT='( '' OBJET'',i4)') IK                              
  47 :          JNDI=JNDI + MAX( IK,IL) + 1                                     
  48 :          IF (JNDI.GT.588 ) GO TO 118                                     
  49 :       ELSE                                                               
  50 :          IF(INOOB2(IPLAC).EQ.'ENTIER  ') THEN                            
  51 :            TRA(1:10)=' '                                                 
  52 :            WRITE(TRA,FMT='(I10)') IPO                                    
  53 :            DO 1034 K=1,10                                                
  54 :            IF(TRA(K:K).NE.' ') THEN                                      
  55 :               IK=K                                                       
  56 :               GO TO 1035                                                 
  57 :            ENDIF                                                         
  58 :  1034      CONTINUE                                                      
  59 :  1035      CONTINUE                                                      
  60 :            PHRA(JNDI:JNDI+10-IK)=TRA(IK:10)                              
  61 :            PHRH(JNDI:JNDI+5 )='ENTIER'                                   
  62 :            JNDI=JNDI + MAX ( 10 -IK,5) +2                                
  63 : C          WRITE(6,FMT='( '' ENTIER'',i4)') IK                           
  64 :            IF (JNDI.GT.588 ) GO TO 118                                   
  65 :          ELSEIF(INOOB2(IPLAC).EQ.'FLOTTANT')THEN                         
  66 :            WRITE(TRA,FMT='(G15.8)')XIFLOT(IPO)                           
  67 :            DO 1036 K=1,15                                                
  68 :            IF(TRA(K:K).NE.' ') THEN                                      
  69 :               IK=K                                                       
  70 :               GO TO 1037                                                 
  71 :            ENDIF                                                         
  72 :  1036      CONTINUE                                                      
  73 :  1037      CONTINUE                                                      
  74 :            DO 1038 K=15,IK,-1                                            
  75 :            IF(TRA(K:K).NE.'0'.AND.TRA(K:K).NE.' ') THEN                  
  76 :               IKK=K                                                      
  77 :               GO TO 1039                                                 
  78 :            ENDIF                                                         
  79 :  1038      CONTINUE                                                      
  80 :  1039      CONTINUE                                                      
  81 :            PHRA(JNDI:JNDI+IKK-IK)=TRA(IK:IKK)                            
  82 :            PHRH(JNDI:JNDI+7)='FLOTTANT'                                  
  83 :            JNDI=JNDI + MAX(IKK-IK,7) + 2                                 
  84 :            IK1= IKK -IK                                                  
  85 : C          WRITE(6,FMT='( '' FLOTTANT'',I4)') IK1                        
  86 :            IF (JNDI.GT.588 ) GO TO 118                                   
  87 :          ELSEIF(INOOB2(IPLAC).EQ.'MOT     ')THEN                         
  88 :            JF=IPCHAR(IPO+1)                                              
  89 :            ID=IPCHAR(IPO)                                        
  90 :            ILO=JF-ID                                                     
  91 :            PHRA(JNDI:JNDI+ILO-1)=ICHARA(ID:ID+ILO-1)                     
  92 :            PHRH(JNDI:JNDI+ 2   )='MOT'                                   
  93 :            JNDI=JNDI + MAX(ILO,3) + 2                                    
  94 : C          WRITE(6,FMT='( '' MOT     '',I4)') ILO                        
  95 :            IF (JNDI.GT.588 ) GO TO 118                                   
  96 :          ENDIF                                                           
  97 :       ENDIF                                                              
  98 : 104   CONTINUE                                                           
  99 :   118 CONTINUE 
 100 :       if(nbesc.ne.0) segdes ipiloc                                       
 101 :       JNDI = JNDI -1                                                     
 102 :       IF ( .NOT. LODESL ) THEN
 103 :         DO      3546 I=1,JNDI,72 
 104 :         IJ = MIN( JNDI,I * 72)  
 105 :         WRITE(6,355) PHRA(I:IJ)
 106 :         WRITE(6,355) PHRH(I:IJ)
 107 :  355    FORMAT ( 1X,A)
 108 :  3546   CONTINUE
 109 :       ELSE
 110 :           JGN = JNDI
 111 :           JGM = 2
 112 :           SEGINI MLMOTS
 113 :           MOTS(1)(1:JGN) = PHRA(1:JGN)
 114 :           MOTS(2)(1:JGN) = PHRH(1:JGN)
 115 :           SEGDES MLMOTS
 116 :           IPCAR1 = MLMOTS
 117 :       END IF
 118 :       SEGSUP MTTE                                                        
 119 :       RETURN                                                             
 120 :       END     
 121 :  
 122 :  

© Cast3M 2003 - All rights reserved.
Disclaimer