Esope source files

   1 : C NOMC      SOURCE    FANDEUR   11/07/19    21:16:50     7039           
   2 : 
   3 : C=======================================================================        
   4 : C                                                                               
   5 : C     OPERATEUR RENOMMANT LE NOM DE LA COMPOSANTE D UN CHPOINT                  
   6 : C                                              OU D UN MCHAML 
   7 : C                         certaines composantes d'un chpoint (extension) 
   8 : C     CHPO1 = NOMC | MOT         | CHPO2           
   9 : C                  | LISM1 LISM2 |                                  
  10 : C     CHE1 = NOMC | MOT         | CHE2           
  11 : C                  | LISM1 LISM2 |                                  
  12 : C                                                                               
  13 : C     EBERSOLT DECEMBRE 84        D. R.-M. avril 94                             
  14 : C     extension MCHAML kich 01/99                                               
  15 : C=======================================================================        
  16 : C                                                                               
  17 :       SUBROUTINE NOMC                                                           
  18 : 
  19 :       IMPLICIT INTEGER(I-N)
  20 :       IMPLICIT REAL*8(A-H,O-Z)
  21 : 
  22 : -INC CCOPTIO       
  23 : -INC SMCHPOI                                                              
  24 : 
  25 :       CHARACTER*4 MOT1,MOT2(1),MOTNAT(3)
  26 :       DATA MOT2/'NATU'/
  27 :       DATA MOTNAT/'INDE','DIFF','DISC'/ 
  28 : 
  29 : C On initialise comme sur IBM (a -1)
  30 :       IRT1=-1
  31 :       IRT2=-1
  32 :       IRT3=-1
  33 :       IRT6=-1
  34 : C
  35 : C     On tente de lire un LISTMOTS
  36 : C
  36 :       CALL LIROBJ('LISTMOTS',IPLM1,0,IRT3) 
  37 :       IF (IERR.NE.0) GOTO 666
  38 : C
  39 :       IF (IRT3.EQ.1) THEN
  39 :          CALL LIROBJ('LISTMOTS',IPLM2,1,IRT3) 
  40 :          IF (IERR.NE.0) GOTO 666
  41 : C
  41 :          CALL LIROBJ('CHPOINT ',IPCH1,0,IRT2)  
  42 :          IF (IERR.NE.0) GOTO 666
  43 : C
  44 :          IF (IRT2.EQ.1) THEN
  44 :            CALL NOMC2(IPCH1,IPLM1,IPLM2,IPCH2)
  45 :          ELSE
  45 :            CALL LIROBJ('MCHAML  ',IPCH1,1,IRT6)
  46 :            IF (IERR.NE.0) GOTO 266
  46 :            CALL NOMC3(IPCH1,IPLM1,IPLM2,IPCH2,' ')
  47 :          ENDIF
  48 :          IF (IERR.NE.0) GOTO 666
  49 : C
  50 :       ELSE 
  50 :          CALL LIRCHA(MOT1,1,IRT1)   
  51 :          IF (IERR.NE.0) GOTO 666
  52 : C
  52 :          CALL LIROBJ('CHPOINT ',IPCH1,0,IRT2)
  53 :          IF (IERR.NE.0) GOTO 666
  54 : 
  55 :          IF (IRT2.EQ.1) THEN
  56 :            IRET=-1
  56 :            CALL NOMCOM(IPCH1,MOT1,IPCH2,IRET)
  57 :            IF (IRET.EQ.0) GOTO 666    
  58 :          ELSE
  58 :            CALL LIROBJ('MCHAML  ',IPCH1,1,IRT6)
  59 :            IF (IERR.NE.0) GOTO 266
  59 :            CALL NOMC3(IPCH1,-1,-1,IPCH2,MOT1)
  60 :          ENDIF
  61 :          IF (IERR.NE.0) GOTO 666
  62 :       ENDIF
  63 : C
  64 : C     on essaie de lire la nouvelle nature
  65 : C
  66 :       IF (IRT2.EQ.1) THEN
  66 :         CALL LIRMOT(MOT2,1,INAT,0)
  67 :         IF (IERR .NE. 0) GOTO 666
  68 :         IF (INAT.NE.0) THEN
  68 :           CALL LIRMOT(MOTNAT,3,JATT1,1)
  69 :           IF (IERR .NE. 0) GOTO 666
  70 :           MCHPOI=IPCH2
  71 :           SEGACT MCHPOI*MOD
  72 :           NJAT = JATTRI(/1)
  73 :           IF (NJAT.LT.1) THEN
  74 :             NSOUPO = IPCHP(/1)
  75 :             NAT = 1
  76 :             SEGADJ MCHPOI
  77 :           ENDIF
  78 :           JATTRI(INAT)=JATT1-1
  79 :           SEGDES MCHPOI
  80 :         ENDIF                             
  81 :       ENDIF                             
  82 : C                                                                               
  83 :       IF (IRT2.EQ.1) THEN
  83 :         CALL ECROBJ('CHPOINT ',IPCH2)                                            
  84 :       ELSE
  84 :         CALL ECROBJ('MCHAML  ',IPCH2)                                           
  85 :       ENDIF
  86 :       GOTO 666                                                                  
  87 : C                                                                               
  88 : C    PAS D OPERANDE CORRECTE TROUVE                                             
  89 : C                                                                               
  89 :  266  CALL QUETYP(MOTERR(1:8),0,IRETOU)                                         
  90 :       IF(IRETOU.NE.0) THEN                                                      
  90 :          CALL ERREUR (39)                                                       
  91 :       ELSE                                                                      
  91 :          CALL ERREUR(533)                                                       
  92 :       ENDIF                                                                     
  93 : 
  94 :   666 CONTINUE                                                                  
  95 :       RETURN                                                                    
  96 :       END                                                                   
  97 : 
  98 :