Télécharger ntatab.eso

Retour à la liste

Numérotation des lignes :

  1. C NTATAB SOURCE GOUNAND 14/01/29 21:15:14 7923
  2. C AFFECTE UN ELEMENT D'UNE TABLE. APPELE PAR LIRNOM
  3. C
  4. SUBROUTINE NTATAB(INOM,IBTYP,IRET,ISUCC)
  5. C ITAB POINTEUR SUR LA TABLE
  6. C INDIC1 TYPE DE L'INDICE
  7. C INDIC2 RANG DANS PILE DE L'INDICE
  8. C IBTYP TYPE DE L'ELEMENT
  9. C IRET VALEUR DE L'ELEMENT
  10. C DIMENSION IBTYP(2)
  11. IMPLICIT INTEGER(I-N)
  12. -INC CCNOYAU
  13. -INC CCOPTIO
  14. -INC SMTABLE
  15. -INC SMBLOC
  16. -INC CCASSIS
  17. REAL*8 XIFTMP
  18. CHARACTER*(*)IBTYP
  19. CHARACTER*(8)ITBNO
  20. *sg CHARACTER*72 CHARIN
  21. CHARACTER*512 CHARIN
  22. EXTERNAL LONG
  23. IMETH=ISUCC
  24. * write(6,*) ' entree dans ntatab isucc',imeth
  25. ITBNOM=ITANO1(INOM)
  26. MTABLE=IOUEP2(ITBNOM)
  27. IF(IMETH.EQ.1) THEN
  28. IF (MOBJCO.NE.0) THEN
  29. MTABLE=MOBJCO
  30. ELSE
  31. CALL ERREUR(863)
  32. RETURN
  33. ENDIF
  34. ELSE
  35. INDIC1=ITANO1(INOM+1)
  36. ITBNO=INOOB2(INDIC1)
  37. IF(ITBNO.NE.'SEPARATE') RETURN
  38. ENDIF
  39. INOM=INOM+2-IMETH
  40. INDIC2=ITANO1(INOM)
  41. ITBNO=INOOB2(INDIC2)
  42. INDIC2=IOUEP2(INDIC2)
  43. SEGACT MTABLE*MOD
  44. 10 CONTINUE
  45. * RECHERCHE DE LA POSITION CORRESPONDANTE DE LA TABLE
  46. NTDIM= MLOTAB
  47. IF(NTDIM.EQ.0) GO TO 21
  48. if(nbesc.ne.0) segact ipiloc
  49. XIFTMP=0
  50. IF (ITBNO.EQ.'FLOTTANT') XIFTMP=XIFLOT(INDIC2)
  51. DO 20 I=1,NTDIM
  52. IF (MTABTI(I).NE.ITBNO) GOTO 20
  53. IF (ITBNO.EQ.'FLOTTANT') THEN
  54. IF (RMTABI(I).NE.XIFTMP) GOTO 20
  55. ELSEIF(ITBNO.EQ.'MOT ')THEN
  56. C ON VA COMPARER LES MOTS SANS TENIR COMPTE DES BLANCS DE LA FIN
  57. IOD=IPCHAR(INDIC2)
  58. IOF=IPCHAR(INDIC2+1)
  59. L2= LONG(ICHARA(IOD:IOF-1))+IOD-1
  60. IP=MTABII(I)
  61. ID=IPCHAR(IP)
  62. IFI=IPCHAR(IP+1)
  63. L1=LONG(ICHARA(ID:IFI-1))+ID-1
  64. IF(ICHARA(IOD:L2).NE.ICHARA(ID:L1))GO TO 20
  65. ELSE
  66. IF (MTABII(I).NE.INDIC2) GOTO 20
  67. ENDIF
  68. * REMPLACEMENT DANS LE CAS OU IL NE S'AGIT PAS D'UNE TABLE
  69. * SINON RENVOI EN 10 AVEC LA NOUVELLE TABLE
  70. IF(MTABTV(I).EQ.'TABLE ') THEN
  71. MTAB1 = MTABIV(I)
  72. IF((INOM+1).GT.NBNOM) GO TO 11
  73. INDIC1=ITANO1(INOM + 1)
  74. ITBNO=INOOB2(INDIC1)
  75. IF(ITBNO.EQ.'SEPARATE') THEN
  76. * IL NE S'AGISSAIT PAS REELEMENT D'UN REMPLACEMENT
  77. INOM=INOM+2
  78. IF(INOM.GT.NBNOM) THEN
  79. CALL ERREUR(314)
  80. if ( nbesc.ne.0) segdes ipiloc
  81. RETURN
  82. ENDIF
  83. INDIC2=ITANO1(INOM)
  84. ITBNO=INOOB2(INDIC2)
  85. INDIC2=IOUEP2(INDIC2)
  86. SEGDES MTABLE
  87. MTABLE=MTAB1
  88. SEGACT MTABLE*MOD
  89. GO TO 10
  90. ENDIF
  91. ENDIF
  92. 11 CONTINUE
  93. MTABTV(I)= IBTYP
  94. IF (IBTYP.NE.'FLOTTANT') THEN
  95. MTABIV(I)= IRET
  96. ELSE
  97. RMTABV(I)=XIFLOT(IRET)
  98. ENDIF
  99. SEGDES MTABLE
  100. if(nbesc.ne.0) segdes ipiloc
  101. RETURN
  102. 20 CONTINUE
  103. if(nbesc.ne.0) segdes ipiloc
  104. 21 CONTINUE
  105. MLOTAB=NTDIM+1
  106. M=MTABII(/1)
  107. IF (MLOTAB.GT.M) THEN
  108. M=M+50
  109. SEGADJ MTABLE
  110. ENDIF
  111. M=MLOTAB
  112. * ON AJOUTE A LA TABLE
  113. MTABTI(M)=ITBNO
  114. IF(' '.EQ.ITBNO) THEN
  115. CALL ERREUR (600)
  116. RETURN
  117. ENDIF
  118. if(nbesc.ne.0) segact ipiloc
  119. IF (ITBNO .EQ.'FLOTTANT') THEN
  120. RMTABI(M)=XIFLOT(INDIC2)
  121. ELSEIF(ITBNO .EQ.'MOT ') THEN
  122. C si l'indice est un mot on ne garde pas les blancs a la fin du mot
  123. IOD=IPCHAR(INDIC2)
  124. IOF=IPCHAR(INDIC2+1)
  125. L2= LONG(ICHARA(IOD:IOF-1))
  126. *sg attention si L2> len(charin)
  127. L2=MIN(L2,LEN(CHARIN))
  128. CHARIN(1:L2)=ICHARA(IOD:L2+IOD-1)
  129. CALL POSCHA(CHARIN(1:L2),IRET2)
  130. if(nbesc.ne.0) segact ipiloc
  131. MTABII(M)=IRET2
  132. ELSE
  133. MTABII(M)=INDIC2
  134. ENDIF
  135. MTABTV(M)=IBTYP
  136. IF (IBTYP.NE.'FLOTTANT') THEN
  137. MTABIV(M)=IRET
  138. ELSE
  139. RMTABV(M)=XIFLOT(IRET)
  140. ENDIF
  141. if(nbesc.ne.0) segdes ipiloc
  142. SEGDES MTABLE
  143. RETURN
  144. END
  145.  
  146.  
  147.  

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