Télécharger la plaquette Cast3M


fr en

Télécharger chirex.eso

Retour à la liste

Numérotation des lignes : 

chirex

  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