Télécharger rescha.eso

Retour à la liste

Numérotation des lignes :

  1. C RESCHA SOURCE PV 16/11/26 21:16:18 9205
  2. SUBROUTINE RESCHA (ICOLAC,ITLACC,IMAX1,IDEB)
  3. IMPLICIT INTEGER(I-N)
  4. IMPLICIT REAL*8 (A-H,O-Z)
  5. *--------------------------------------------------------------------*
  6. * *
  7. * Restauration des pointeurs issus de la pile des CHAMELEMs. *
  8. * *
  9. *--------------------------------------------------------------------*
  10. -INC CCOPTIO
  11. -INC SMCHAML
  12. -INC TMCOLAC
  13. CHARACTER*8 MOTIP
  14. CHARACTER*16 NOCOMP
  15. *
  16. * Boucle sur les CHAMELEMs contenus dans la pile:
  17. *
  18. ITLAC1 = KCOLA(1)
  19. DO 10 IEL =IDEB,IMAX1
  20. MCHELM = ITLAC(IEL)
  21. IF (MCHELM.EQ.0) GOTO 10
  22. SEGACT,MCHELM*MOD
  23. NSOUEL = ICHAML(/1)
  24. N3 = INFCHE(/2)
  25. IF (NSOUEL.EQ.0) GOTO 10
  26. DO 20 ISOU=1,NSOUEL
  27. MCHAML=ICHAML(ISOU)
  28. IF (MCHAML.EQ.0) GO TO 20
  29. SEGACT,MCHAML*MOD
  30. *
  31. IVA = ABS(IMACHE(ISOU))
  32. * IF(IVA.NE.0) IMACHE(ISOU) = ITLAC1.ITLAC(IVA)
  33. * CORRECTION MILL 3 / 9 / 92
  34. IF(IVA.NE.0) IMACHE(ISOU) = ITLAC1.ITLAC(IVA)
  35. * IF(IMACHE(ISOU).LT.0)
  36. * $ IMACHE(ISOU) = ITLAC1.ITLAC(IVA)
  37. *
  38. IF(N3.GE.4) THEN
  39. ITLAC2 = KCOLA(40)
  40. IVA = ABS(INFCHE(ISOU,4))
  41. * IF(IVA.NE.0) INFCHE(ISOU,4) = ITLAC2.ITLAC(IVA)
  42. IF(INFCHE(ISOU,4).LT.0)
  43. $ INFCHE(ISOU,4) = ITLAC2.ITLAC(IVA)
  44. ENDIF
  45. *
  46. NCO = TYPCHE(/2)
  47. DO 30 ICO=1,NCO
  48. NOCOMP = TYPCHE(ICO)
  49. IF (NOCOMP(1:6).NE.'REAL*8') THEN
  50. MOTIP(1:8)=NOCOMP(9:16)
  51. CALL TYPFIL(MOTIP,ITYP)
  52. IF(ITYP.LE.0) GO TO 30
  53. ITLAC2 = KCOLA(ITYP)
  54. MELVAL = IELVAL(ICO)
  55. IF (MELVAL.NE.0) THEN
  56. SEGACT,MELVAL*MOD
  57. N1 = IELCHE(/1)
  58. N2 = IELCHE(/2)
  59. DO 40 I2=1,N2
  60. DO 50 I1=1,N1
  61. IVA = ABS(IELCHE(I1,I2))
  62. * IF(IVA.NE.0) IELCHE(I1,I2) = ITLAC2.ITLAC(IVA)
  63. IF(IELCHE(I1,I2).LT.0)
  64. $ IELCHE(I1,I2) = ITLAC2.ITLAC(IVA)
  65. 50 CONTINUE
  66. 40 CONTINUE
  67. SEGDES,MELVAL
  68. ENDIF
  69. ENDIF
  70. 30 CONTINUE
  71. SEGDES,MCHAML
  72. 20 CONTINUE
  73. 10 CONTINUE
  74. RETURN
  75. END
  76.  
  77.  
  78.  
  79.  
  80.  
  81.  
  82.  
  83.  
  84.  
  85.  

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