Télécharger chirex.eso

Retour à la liste

Numérotation des lignes :

  1. C CHIREX SOURCE CHAT 05/01/12 21:58:07 5004
  2. SUBROUTINE CHIREX(IDSCHI,ID,LINIT,LEND)
  3. C=======================================================================
  4. C ISSU DE TREXTY DE TRIOEF
  5. C
  6. C OBJET: CHANGE LE TYPE D'ESPECE DE L'ESPECE ID
  7. C
  8. C ARGUMENTS: ID =N› DE L'ESPECE CONCERNE, APPARTIENT AU TABLEAU IDY
  9. C LINIT =TYPE D'ESPECE ACTUEL
  10. C LEND =TYPE D'ESPECE FINAL
  11. C IDSCHI =SEGMENT DE CHIMI1
  12. C
  13. C
  14. C CETTE SUBROUTINE MODIFIE CERTAINS TABLEAUX CONCERNANT LES ESPECES,
  15. C TELS QUE NN, IDY, ETC...
  16. C
  17. C======================================================================
  18. IMPLICIT INTEGER(I-N)
  19. IMPLICIT REAL*8(A-H,O-Z)
  20. CHARACTER*32 NAMINT
  21. SEGMENT IDSCHI
  22. REAL*8 GK(NYDIM),AA(NYDIM,NXDIM),FF(NZDIM,NPDIM)
  23. INTEGER IDX(NXDIM),IDY(NYDIM),IDZ(NZDIM),IDP(NPDIM),NN(6)
  24. INTEGER IDECY(NYDIM),IONZ(NXDIM)
  25. CHARACTER*32 NAME(NXDIM),NAMESP(NYDIM)
  26. ENDSEGMENT
  27. C
  28.  
  29. IF (LINIT.EQ.LEND) RETURN
  30. LINIT1=LINIT
  31. NXDIM=IDX(/1)
  32. NYDIM=IDY(/1)
  33. NZDIM=IDZ(/1)
  34. NPDIM=IDP(/1)
  35. CALL CHIADY(IDY,NYDIM,ID,IJ)
  36. IF(IJ.EQ.0)CALL ERREUR(22)
  37. C
  38. K=1
  39. II=0
  40. C
  41. DO 940 LL=1,LINIT
  42. II=II+NN(LL)
  43. 940 CONTINUE
  44. III=II-NN(LINIT)+1
  45. * write(6,*)' ii ',ii,' iii ',iii,' IJ ',IJ,' CHIREX '
  46. IF (IJ.LT.III.OR.IJ.GT.II)THEN
  47. CALL ERREUR(22)
  48. RETURN
  49. ENDIF
  50. IF (LEND.GT.LINIT) GOTO 920
  51. K=-1
  52. II=III
  53. 920 CONTINUE
  54. C
  55. NN(LINIT)=NN(LINIT)-1
  56. NN(LEND)=NN(LEND)+1
  57. 930 CONTINUE
  58. C
  59. C
  60. I0=IJ
  61. IV=IDY(II)
  62. IDY(II)=IDY(I0)
  63. IDY(I0)=IV
  64. IV=IDECY(II)
  65. IDECY(II)=IDECY(I0)
  66. IDECY(I0)=IV
  67. * WRITE(6,*) '------ IDY(I0): ',IDY(I0)
  68. DO 46 J=1,NXDIM
  69. V=AA(I0,J)
  70. AA(I0,J)=AA(II,J)
  71. AA(II,J)=V
  72. 46 CONTINUE
  73. V=GK(I0)
  74. GK(I0)=GK(II)
  75. GK(II)=V
  76. NAMINT=NAMESP(I0)
  77. NAMESP(I0)= NAMESP(II)
  78. NAMESP(II)=NAMINT
  79. C
  80. C
  81.  
  82. C
  83. LINIT=LINIT+K
  84. IJ=II
  85. II=II+K*NN(LINIT)
  86. IF (LINIT.NE.LEND) GOTO 930
  87. C
  88. LINIT=LINIT1
  89. RETURN
  90. END
  91. C
  92.  
  93.  
  94.  
  95.  
  96.  

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