Télécharger nomc.eso

Retour à la liste

Numérotation des lignes :

  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
  37. CALL LIROBJ('LISTMOTS',IPLM1,0,IRT3)
  38. IF (IERR.NE.0) GOTO 666
  39. C
  40. IF (IRT3.EQ.1) THEN
  41. CALL LIROBJ('LISTMOTS',IPLM2,1,IRT3)
  42. IF (IERR.NE.0) GOTO 666
  43. C
  44. CALL LIROBJ('CHPOINT ',IPCH1,0,IRT2)
  45. IF (IERR.NE.0) GOTO 666
  46. C
  47. IF (IRT2.EQ.1) THEN
  48. CALL NOMC2(IPCH1,IPLM1,IPLM2,IPCH2)
  49. ELSE
  50. CALL LIROBJ('MCHAML ',IPCH1,1,IRT6)
  51. IF (IERR.NE.0) GOTO 266
  52. CALL NOMC3(IPCH1,IPLM1,IPLM2,IPCH2,' ')
  53. ENDIF
  54. IF (IERR.NE.0) GOTO 666
  55. C
  56. ELSE
  57. CALL LIRCHA(MOT1,1,IRT1)
  58. IF (IERR.NE.0) GOTO 666
  59. C
  60. CALL LIROBJ('CHPOINT ',IPCH1,0,IRT2)
  61. IF (IERR.NE.0) GOTO 666
  62.  
  63. IF (IRT2.EQ.1) THEN
  64. IRET=-1
  65. CALL NOMCOM(IPCH1,MOT1,IPCH2,IRET)
  66. IF (IRET.EQ.0) GOTO 666
  67. ELSE
  68. CALL LIROBJ('MCHAML ',IPCH1,1,IRT6)
  69. IF (IERR.NE.0) GOTO 266
  70. CALL NOMC3(IPCH1,-1,-1,IPCH2,MOT1)
  71. ENDIF
  72. IF (IERR.NE.0) GOTO 666
  73. ENDIF
  74. C
  75. C on essaie de lire la nouvelle nature
  76. C
  77. IF (IRT2.EQ.1) THEN
  78. CALL LIRMOT(MOT2,1,INAT,0)
  79. IF (IERR .NE. 0) GOTO 666
  80. IF (INAT.NE.0) THEN
  81. CALL LIRMOT(MOTNAT,3,JATT1,1)
  82. IF (IERR .NE. 0) GOTO 666
  83. MCHPOI=IPCH2
  84. SEGACT MCHPOI*MOD
  85. NJAT = JATTRI(/1)
  86. IF (NJAT.LT.1) THEN
  87. NSOUPO = IPCHP(/1)
  88. NAT = 1
  89. SEGADJ MCHPOI
  90. ENDIF
  91. JATTRI(INAT)=JATT1-1
  92. SEGDES MCHPOI
  93. ENDIF
  94. ENDIF
  95. C
  96. IF (IRT2.EQ.1) THEN
  97. CALL ECROBJ('CHPOINT ',IPCH2)
  98. ELSE
  99. CALL ECROBJ('MCHAML ',IPCH2)
  100. ENDIF
  101. GOTO 666
  102. C
  103. C PAS D OPERANDE CORRECTE TROUVE
  104. C
  105. 266 CALL QUETYP(MOTERR(1:8),0,IRETOU)
  106. IF(IRETOU.NE.0) THEN
  107. CALL ERREUR (39)
  108. ELSE
  109. CALL ERREUR(533)
  110. ENDIF
  111.  
  112. 666 CONTINUE
  113. RETURN
  114. END
  115.  
  116.  
  117.  

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