Télécharger copba2.eso

Retour à la liste

Numérotation des lignes :

  1. C COPBA2 SOURCE CHAT 05/01/12 22:19:27 5004
  2. SUBROUTINE COPBA2(LCHAIN,ITBAS,ITBA2)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8(A-H,O-Z)
  5.  
  6. *--------------------------------------------------------------------*
  7. * *
  8. * Duplique la table des modes, cr{ation d'un nouveau point rep}- *
  9. * re, d'un nouveau chpoint, d'un nouveau chamelem, d'une nouvelle*
  10. * table des d{placements g{neralis{s. *
  11. * *
  12. * Param}tres: *
  13. * *
  14. * e LCHAIN contient les chaines de caract}res de la table ITBAS. *
  15. * e ITBAS table de sous-type BASE_DE_MODES, contenant les modes, *
  16. * ou de sous-type PSEUDO_MODE, contenant les pseudo-modes*
  17. * s ITBA2 table dupliqu{e. *
  18. * *
  19. * Auteur, date de cr{ation: *
  20. * *
  21. * Lionel VIVAN, le 15 mai 1990. *
  22. * *
  23. *--------------------------------------------------------------------*
  24. * *
  25. -INC CCOPTIO
  26. -INC SMTABLE
  27. *
  28. INTEGER LCHAIN(*)
  29. *
  30. CALL COPIE6(ITBAS,ITBA2)
  31. MTABLE = ITBAS
  32. SEGACT MTABLE
  33. LONG = MLOTAB
  34. MTAB1 = ITBA2
  35. SEGACT MTAB1*MOD
  36. IM = 1
  37. DO 10 I = 1,LONG
  38. IF (MTABTI(I).EQ.'ENTIER ' .AND. MTABII(I).EQ.IM .AND.
  39. & MTABTV(I).EQ.'TABLE ') THEN
  40. IM = IM + 1
  41. ITMOD = MTABIV(I)
  42. CALL COPIE6(ITMOD,ITMO2)
  43. MTAB1.MTABIV(I) = ITMO2
  44. MTAB2 = ITMOD
  45. SEGACT MTAB2
  46. LON2 = MTAB2.MLOTAB
  47. MTAB3 = ITMO2
  48. SEGACT MTAB3*MOD
  49. DO 20 I2 = 1,LON2
  50. IF (MTAB2.MTABTI(I2).EQ.'MOT ') THEN
  51. IF (MTAB2.MTABII(I2).EQ.LCHAIN(1) .AND.
  52. & MTAB2.MTABTV(I2).EQ.'POINT ') THEN
  53. IPTR = MTAB2.MTABIV(I2)
  54. CALL COPIE7(IPTR,INOPT)
  55. MTAB3.MTABIV(I2) = INOPT
  56. ELSE IF (MTAB2.MTABII(I2).EQ.LCHAIN(2) .AND.
  57. & MTAB2.MTABTV(I2).EQ.'TABLE ') THEN
  58. ITDG = MTAB2.MTABIV(I2)
  59. CALL COPIE6(ITDG,ITDG2)
  60. MTAB3.MTABIV(I2) = ITDG2
  61. ELSE IF (MTAB2.MTABII(I2).EQ.LCHAIN(3) .AND.
  62. & MTAB2.MTABTV(I2).EQ.'CHPOINT ') THEN
  63. ICHD = MTAB2.MTABIV(I2)
  64. CALL COPIE2(ICHD,ICHD2)
  65. MTAB3.MTABIV(I2) = ICHD2
  66. ELSE IF (MTAB2.MTABII(I2).EQ.LCHAIN(4) .AND.
  67. & MTAB2.MTABTV(I2).EQ.'MCHAML ') THEN
  68. ICHC = MTAB2.MTABIV(I2)
  69. CALL COPIE8(ICHC,ICHC2)
  70. MTAB3.MTABIV(I2) = ICHC2
  71. ELSE IF (MTAB2.MTABII(I2).EQ.LCHAIN(5) .AND.
  72. & MTAB2.MTABTV(I2).EQ.'CHPOINT ') THEN
  73. ICHD = MTAB2.MTABIV(I2)
  74. CALL COPIE2(ICHD,ICHD2)
  75. MTAB3.MTABIV(I2) = ICHD2
  76. ELSE IF (MTAB2.MTABII(I2).EQ.LCHAIN(6) .AND.
  77. & MTAB2.MTABTV(I2).EQ.'CHPOINT ') THEN
  78. ICHD = MTAB2.MTABIV(I2)
  79. CALL COPIE2(ICHD,ICHD2)
  80. MTAB3.MTABIV(I2) = ICHD2
  81. ELSE IF (MTAB2.MTABII(I2).EQ.LCHAIN(7) .AND.
  82. & MTAB2.MTABTV(I2).EQ.'MCHAML ') THEN
  83. ICHC = MTAB2.MTABIV(I2)
  84. CALL COPIE8(ICHC,ICHC2)
  85. MTAB3.MTABIV(I2) = ICHC2
  86. ELSE IF (MTAB2.MTABII(I2).EQ.LCHAIN(8) .AND.
  87. & MTAB2.MTABTV(I2).EQ.'CHPOINT ') THEN
  88. ICHD = MTAB2.MTABIV(I2)
  89. CALL COPIE2(ICHD,ICHD2)
  90. MTAB3.MTABIV(I2) = ICHD2
  91. ELSE IF (MTAB2.MTABII(I2).EQ.LCHAIN(9) .AND.
  92. & MTAB2.MTABTV(I2).EQ.'CHPOINT ') THEN
  93. ICHD = MTAB2.MTABIV(I2)
  94. CALL COPIE2(ICHD,ICHD2)
  95. MTAB3.MTABIV(I2) = ICHD2
  96. ENDIF
  97. ENDIF
  98. 20 CONTINUE
  99. * end do
  100. SEGDES MTAB2
  101. SEGDES MTAB3
  102. ENDIF
  103. 10 CONTINUE
  104. * end do
  105. SEGDES MTABLE
  106. SEGDES MTAB1
  107. *
  108. END
  109.  
  110.  
  111.  

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