Télécharger oter.eso

Retour à la liste

Numérotation des lignes :

  1. C OTER SOURCE CHAT 09/09/09 21:15:08 6493
  2. subroutine oter
  3. implicit integer(i-n)
  4. implicit real*8(a-h,o-z)
  5. -INC CCOPTIO
  6. -INC SMTABLE
  7. character*8 typind
  8. *
  9. * oter un indice d'une table en conservant la meme table
  10. *
  11. call lirobj ('TABLE', IPTABL,1,iretou)
  12. if(ierr.ne.0) return
  13. CALL QUETYP ( TYPIND,1,IRETOU)
  14. IF(IERR.NE.0) RETURN
  15. IF(TYPIND.EQ.'FLOTTANT' ) THEN
  16. CALL LIRREE ( XVA,1,IRETOU)
  17. ELSE
  18. CALL LIROBJ ( TYPIND , INDICE, 1,IRETOU)
  19. ENDIF
  20. IF ( IERR.NE.0) RETURN
  21. MTABLE = IPTABL
  22. SEGACT,MTABLE*MOD
  23. M = MLOTAB
  24. M0 = 0
  25. IF (TYPIND.EQ.'FLOTTANT') THEN
  26. DO 103 I=1,M
  27. IF( RMTABI(I) . EQ. XVA) THEN
  28. M0 = I
  29. GO TO 102
  30. ENDIF
  31. 103 CONTINUE
  32. ELSE
  33. DO 100 I=1,M
  34. IF (MTABTI(I) .EQ. TYPIND) THEN
  35. IF (MTABII(I) .EQ. INDICE) THEN
  36. M0 = I
  37. GOTO 102
  38. END IF
  39. END IF
  40. 100 CONTINUE
  41.  
  42. * END DO
  43. ENDIF
  44. 102 CONTINUE
  45. *
  46. IF (M0 .EQ. 0) THEN
  47. CALL ERREUR (171)
  48. RETURN
  49. END IF
  50. *
  51. * write(6,*) ' M0 ', M0
  52. M = M - 1
  53. MLOTAB=MLOTAB-1
  54. *
  55. * END DO
  56. DO 210 I=M0,M
  57. MTABLE.MTABTI(I) = MTABLE.MTABTI(I+1)
  58. MTABLE.MTABTV(I) = MTABLE.MTABTV(I+1)
  59. MTABLE.RMTABI(I) = MTABLE.RMTABI(I+1)
  60. MTABLE.MTABII(I) = MTABLE.MTABII(I+1)
  61. MTABLE.MTABIV(I) = MTABLE.MTABIV(I+1)
  62. MTABLE.RMTABV(I) = MTABLE.RMTABV(I+1)
  63. 210 CONTINUE
  64. * END DO
  65. *
  66. SEGDES,MTABLE
  67. *
  68. END
  69.  
  70.  

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