Télécharger la plaquette Cast3M


fr en

Télécharger nomc.eso

Retour à la liste

Numérotation des lignes : 

nomc

  1. C NOMC      SOURCE    CB215821  21/05/05    21:15:09     10993          
  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     ajouts actobj sg 12/2019      
  16. C=======================================================================
  17. C
  18.       SUBROUTINE NOMC
  19.  
  20.       IMPLICIT INTEGER(I-N)
  21.       IMPLICIT REAL*8(A-H,O-Z)
  22.  
  23.  
  24. -INC PPARAM
  25. -INC CCOPTIO
  26. -INC SMCHPOI
  27.  
  28.       CHARACTER*(LOCOMP) MOT1
  29.       CHARACTER*4        MOT2(1),MOTNAT(3)
  30.       DATA               MOT2/'NATU'/
  31.       DATA               MOTNAT/'INDE','DIFF','DISC'/
  32.  
  33. C On initialise comme sur IBM (a -1)
  34.       IRT1=-1
  35.       IRT2=-1
  36.       IRT3=-1
  37.       IRT6=-1
  38. C
  39. C     On tente de lire un LISTMOTS
  40. C
  41.       CALL LIROBJ('LISTMOTS',IPLM1,0,IRT3)
  42.       IF (IERR.NE.0) GOTO 666
  43. C
  44.       IF (IRT3.EQ.1) THEN
  45.          CALL ACTOBJ('LISTMOTS',IPLM1,1)
  46.          CALL LIROBJ('LISTMOTS',IPLM2,1,IRT3)
  47.          IF (IERR.NE.0) GOTO 666
  48.          CALL ACTOBJ('LISTMOTS',IPLM2,1)
  49. C
  50.          CALL LIROBJ('CHPOINT ',IPCH1,0,IRT2)
  51.          IF (IERR.NE.0) GOTO 666
  52. C
  53.          IF (IRT2.EQ.1) THEN
  54.             CALL ACTOBJ('CHPOINT ',IPCH1,1)
  55.             CALL NOMC2(IPCH1,IPLM1,IPLM2,IPCH2)
  56.          ELSE
  57.            CALL LIROBJ('MCHAML  ',IPCH1,1,IRT6)
  58.            IF (IERR.NE.0) GOTO 266
  59.            CALL ACTOBJ('MCHAML  ',IPCH1,1)
  60.            CALL NOMC3(IPCH1,IPLM1,IPLM2,IPCH2,' ')
  61.         ENDIF
  62.         IF (IERR.NE.0) GOTO 666
  63. C
  64.       ELSE
  65.          CALL LIRCHA(MOT1,1,IRT1)
  66.          IF (IERR.NE.0) GOTO 666
  67. C
  68.          CALL LIROBJ('CHPOINT ',IPCH1,0,IRT2)
  69.          IF (IERR.NE.0) GOTO 666
  70.  
  71.          IF (IRT2.EQ.1) THEN
  72.             CALL ACTOBJ('CHPOINT ',IPCH1,1)
  73.             IRET=-1
  74.             CALL NOMCOM(IPCH1,MOT1,IPCH2,IRET)
  75.             IF (IRET.EQ.0) GOTO 666
  76.          ELSE
  77.             CALL LIROBJ('MCHAML  ',IPCH1,1,IRT6)
  78.             IF (IERR.NE.0) GOTO 266
  79.             CALL ACTOBJ('MCHAML  ',IPCH1,1)
  80.             CALL NOMC3(IPCH1,-1,-1,IPCH2,MOT1)
  81.          ENDIF
  82.          IF (IERR.NE.0) GOTO 666
  83.       ENDIF
  84. C
  85. C     on essaie de lire la nouvelle nature
  86. C
  87.       IF (IRT2.EQ.1) THEN
  88.          CALL LIRMOT(MOT2,1,INAT,0)
  89.          IF (IERR .NE. 0) GOTO 666
  90.          IF (INAT.NE.0) THEN
  91.             CALL LIRMOT(MOTNAT,3,JATT1,1)
  92.             IF (IERR .NE. 0) GOTO 666
  93.             MCHPOI=IPCH2
  94.             SEGACT MCHPOI*MOD
  95.             NJAT = JATTRI(/1)
  96.             IF (NJAT.LT.1) THEN
  97.                NSOUPO = IPCHP(/1)
  98.                NAT = 1
  99.                SEGADJ MCHPOI
  100.             ENDIF
  101.             JATTRI(INAT)=JATT1-1
  102. *new-paradigm            SEGDES MCHPOI
  103.          ENDIF
  104.       ENDIF
  105. C
  106.       IF (IRT2.EQ.1) THEN
  107.          CALL ACTOBJ('CHPOINT ',IPCH2,1)
  108.          CALL ECROBJ('CHPOINT ',IPCH2)
  109.       ELSE
  110.          CALL ACTOBJ('MCHAML  ',IPCH2,1)
  111.          CALL ECROBJ('MCHAML  ',IPCH2)
  112.       ENDIF
  113.       GOTO 666
  114. C
  115. C    PAS D OPERANDE CORRECTE TROUVE
  116. C
  117.  266  CALL QUETYP(MOTERR(1:8),0,IRETOU)
  118.       IF(IRETOU.NE.0) THEN
  119.          CALL ERREUR (39)
  120.       ELSE
  121.          CALL ERREUR(533)
  122.       ENDIF
  123.  
  124.   666 CONTINUE
  125.       RETURN
  126.       END
  127.  
  128.  
  129.  
  130.  
  131.  
  132.  

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