Télécharger ntatab.eso

Retour à la liste

Numérotation des lignes :

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

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