Télécharger ntatab.eso

Retour à la liste

Numérotation des lignes :

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

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