Esope source files

   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)
  34 :       CALL CHIADY(IDY,NYDIM,ID,IJ)
  34 :       IF(IJ.EQ.0)CALL ERREUR(22)
  35 : C
  36 :       K=1                                                                       
  37 :       II=0                                                                      
  38 : C
  39 :       DO 940 LL=1,LINIT                                                         
  40 :       II=II+NN(LL)
  41 : 940   CONTINUE
  42 :       III=II-NN(LINIT)+1                                                        
  43 : *      write(6,*)' ii ',ii,' iii ',iii,' IJ ',IJ,' CHIREX '
  44 :       IF (IJ.LT.III.OR.IJ.GT.II)THEN
  44 :            CALL ERREUR(22)
  45 :            RETURN
  46 :       ENDIF
  47 :       IF (LEND.GT.LINIT) GOTO 920                                               
  48 :       K=-1                                                                      
  49 :       II=III                                                                    
  50 : 920   CONTINUE                                                                  
  51 : C
  52 :       NN(LINIT)=NN(LINIT)-1                                                     
  53 :       NN(LEND)=NN(LEND)+1                                                       
  54 : 930   CONTINUE                                                                  
  55 : C                                                                               
  56 : C                                                                               
  57 :       I0=IJ
  58 :       IV=IDY(II)
  59 :       IDY(II)=IDY(I0)
  60 :       IDY(I0)=IV
  61 :       IV=IDECY(II)
  62 :       IDECY(II)=IDECY(I0)
  63 :       IDECY(I0)=IV
  64 : *      WRITE(6,*) '------ IDY(I0): ',IDY(I0)                                     
  65 :       DO 46 J=1,NXDIM
  66 :       V=AA(I0,J)
  67 :       AA(I0,J)=AA(II,J)
  68 :       AA(II,J)=V
  69 :  46   CONTINUE
  70 :       V=GK(I0)
  71 :       GK(I0)=GK(II)                                                             
  72 :       GK(II)=V                                                                  
  73 :       NAMINT=NAMESP(I0)
  74 :       NAMESP(I0)= NAMESP(II)
  75 :       NAMESP(II)=NAMINT
  76 : C
  77 : C
  78 : 
  79 : C                                                                               
  80 :       LINIT=LINIT+K                                                             
  81 :       IJ=II
  82 :       II=II+K*NN(LINIT)                                                         
  83 :       IF (LINIT.NE.LEND) GOTO 930                                               
  84 : C                                                                               
  85 :       LINIT=LINIT1                                                              
  86 :       RETURN                                                                    
  87 :       END                                                                       
  88 : C                                                                               
  89 :  
  90 :  
  91 :  
  92 :