C CHIREX SOURCE CHAT 05/01/12 21:58:07 5004 SUBROUTINE CHIREX(IDSCHI,ID,LINIT,LEND) C======================================================================= C ISSU DE TREXTY DE TRIOEF C C OBJET: CHANGE LE TYPE D'ESPECE DE L'ESPECE ID C C ARGUMENTS: ID =N› DE L'ESPECE CONCERNE, APPARTIENT AU TABLEAU IDY C LINIT =TYPE D'ESPECE ACTUEL C LEND =TYPE D'ESPECE FINAL C IDSCHI =SEGMENT DE CHIMI1 C C C CETTE SUBROUTINE MODIFIE CERTAINS TABLEAUX CONCERNANT LES ESPECES, C TELS QUE NN, IDY, ETC... C C====================================================================== IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) CHARACTER*32 NAMINT SEGMENT IDSCHI REAL*8 GK(NYDIM),AA(NYDIM,NXDIM),FF(NZDIM,NPDIM) INTEGER IDX(NXDIM),IDY(NYDIM),IDZ(NZDIM),IDP(NPDIM),NN(6) INTEGER IDECY(NYDIM),IONZ(NXDIM) CHARACTER*32 NAME(NXDIM),NAMESP(NYDIM) ENDSEGMENT C IF (LINIT.EQ.LEND) RETURN LINIT1=LINIT NXDIM=IDX(/1) NYDIM=IDY(/1) NZDIM=IDZ(/1) NPDIM=IDP(/1) CALL CHIADY(IDY,NYDIM,ID,IJ) IF(IJ.EQ.0)CALL ERREUR(22) C K=1 II=0 C DO 940 LL=1,LINIT II=II+NN(LL) 940 CONTINUE III=II-NN(LINIT)+1 * write(6,*)' ii ',ii,' iii ',iii,' IJ ',IJ,' CHIREX ' IF (IJ.LT.III.OR.IJ.GT.II)THEN CALL ERREUR(22) RETURN ENDIF IF (LEND.GT.LINIT) GOTO 920 K=-1 II=III 920 CONTINUE C NN(LINIT)=NN(LINIT)-1 NN(LEND)=NN(LEND)+1 930 CONTINUE C C I0=IJ IV=IDY(II) IDY(II)=IDY(I0) IDY(I0)=IV IV=IDECY(II) IDECY(II)=IDECY(I0) IDECY(I0)=IV * WRITE(6,*) '------ IDY(I0): ',IDY(I0) DO 46 J=1,NXDIM V=AA(I0,J) AA(I0,J)=AA(II,J) AA(II,J)=V 46 CONTINUE V=GK(I0) GK(I0)=GK(II) GK(II)=V NAMINT=NAMESP(I0) NAMESP(I0)= NAMESP(II) NAMESP(II)=NAMINT C C C LINIT=LINIT+K IJ=II II=II+K*NN(LINIT) IF (LINIT.NE.LEND) GOTO 930 C LINIT=LINIT1 RETURN END C