Télécharger nomc.eso

Retour à la liste

Numérotation des lignes :

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

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