Esope source files

   1 : C CHICMP    SOURCE    CHAT      05/01/12    21:57:00     5004           
   2 :       SUBROUTINE CHICMP(NVCOMP,IDSCHI)
   3 :       IMPLICIT INTEGER(I-N)
   4 :         IMPLICIT REAL*8 (A-H,O-Z)
   5 : C -------------------------------------------------------------------
   6 : C
   7 : C              AJOUT DE NOUVELLES COMPOSANTES ( CHIMIE)
   8 : C
   9 : C -------------------------------------------------------------------
  10 : -INC SMTABLE
  11 : -INC SMLENTI
  12 :       POINTEUR MLIDEN.MLENTI,MLXMX.MLENTI
  13 : -INC CCOPTIO
  14 :       SEGMENT IDSCHI
  15 :            REAL*8 GK(NYDIM),AA(NYDIM,NXDIM),FF(NZDIM,NPDIM)
  16 :            INTEGER IDX(NXDIM),IDY(NYDIM),IDZ(NZDIM),IDP(NPDIM),NN(6)
  17 :            INTEGER IDECY(NYDIM),IONZ(NXDIM)
  18 :            CHARACTER*32 NAME(NXDIM),NAMESP(NYDIM)
  19 :       ENDSEGMENT
  20 :       CHARACTER*8 MTYPI,CHARI,MTYPR,CHARR
  21 :       CHARACTER*32 CHARM
  22 :       LOGICAL LOGRE
  23 :       INTEGER LINIT
  24 : C
  25 :       NYDIM=IDY(/1)
  26 :       NXDIM=IDX(/1)
  27 :       NZDIM=IDZ(/1)
  28 :       NPDIM=IDP(/1)
  29 :       MTAB1=NVCOMP
  30 :       SEGACT MTAB1
  31 :       NNCOMP= MTAB1.MLOTAB
  32 :       NICOMP=NNCOMP
  33 :       IVALI=0
  34 :       XVALI=0.D0
  35 :       IRETI=0
  36 :       IVALR=0
  37 :       XVALR=0.D0
  38 :       IRETR=0
  39 :       MTYPI='MOT     '
  40 :       MTYPR='        '
  41 :       CHARR='        '
  41 :       CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'CLASSE',.TRUE.,IRETI,
  42 :      *        MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  43 :       IF(IERR.NE.0)RETURN
  44 :       SEGACT MTAB1
  45 :       IF(MTYPR.EQ.'MOT     ')THEN
  46 : C
  47 : C   on a trouvé CLASSE c'est un OBJET on va compter les indices entier
  48 : C
  49 :       NICOMP= 0
  50 :       DO 5 IESP=1,NNCOMP
  51 :       IF((MTAB1.MTABTI(IESP)).EQ.'ENTIER') NICOMP= NICOMP+1
  52 :     5 CONTINUE
  53 :        ENDIF
  54 :       DO 50 ICOMP=1,NICOMP
  55 :       IVALI=ICOMP
  56 :       XVALI=0.D0
  57 :       IRETI=0
  58 :       IVALR=0
  59 :       XVALR=0.D0
  60 :       IRETR=0
  61 :       MTYPI='ENTIER  '
  62 :       MTYPR='        '
  63 :       CHARR='        '
  64 :       CHARI='        '
  64 :       CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,CHARI,.TRUE.,IRETI,
  65 :      *MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  66 :       IF(IERR.NE.0)RETURN
  67 :       SEGACT MTAB1
  68 :       IF((MTYPR.EQ.'TABLE   ').OR.(MTYPR.EQ.'OBJET   ')) THEN
  69 :       MTAB2=IRETR
  70 :       SEGACT MTAB2
  71 :       NXDIM=NXDIM+1
  72 :       NYDIM=NYDIM+1
  73 :       SEGADJ IDSCHI
  74 :       IVALI=1
  75 :       XVALI=0.D0
  76 :       IRETI=0
  77 :       IVALR=0
  78 :       XVALR=0.D0
  79 :       IRETR=0
  80 :       MTYPI='MOT     '
  81 :       MTYPR='ENTIER  '
  82 :       CHARR='        '
  82 :       CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'IDEN',.TRUE.,IRETI,
  83 :      *MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  84 :       IF(IERR.NE.0)RETURN
  85 :       SEGACT MTAB1
  86 :       NVIDEN=IVALR
  87 :       IVALI=1
  88 :       XVALI=0.D0
  89 :       IRETI=0
  90 :       IVALR=0
  91 :       XVALR=0.D0
  92 :       IRETR=0
  93 :       MTYPI='MOT     '
  94 :       MTYPR='MOT     '
  95 :       CHARM='                                '
  95 :       CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'NOM',.TRUE.,IRETI,
  96 :      * MTYPR,IVALR,XVALR,CHARM,LOGRE,IRETR)
  97 :       SEGACT MTAB1
  98 :       IF(IERR.NE.0)RETURN
  99 :       NAME(NXDIM)=CHARM
 100 :       IVALI=1
 101 :       XVALI=0.D0
 102 :       IRETI=0
 103 :       IVALR=0
 104 :       XVALR=0.D0
 105 :       IRETR=0
 106 :       MTYPI='MOT     '
 107 :       MTYPR='ENTIER  '
 108 :       CHARR='        '
 108 :       CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'CHARGE',.TRUE.,
 109 :      *IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
 110 :       IF(IERR.NE.0)RETURN
 111 :       SEGACT MTAB1
 112 :       IONZ(NXDIM)=IVALR
 113 :       NN(6)=NN(6)+1
 114 :       IDY(NYDIM)=NVIDEN
 115 :       LINIT=6
 115 :       CALL CHIREX(IDSCHI,NVIDEN,LINIT,1)
 116 :       AA(NN(1),NXDIM)=1.D0
 117 :       IDX(NXDIM)=NVIDEN
 118 :       GK(NN(1))=0.D0
 119 :       SEGDES MTAB2
 120 :       ELSE
 121 :         MOTERR(1:40)='********         NVCOMP    ???????????  '
 121 :         CALL ERREUR(-301)
 121 :       CALL ERREUR(21)
 122 :       RETURN
 123 :       ENDIF
 124 :    50 CONTINUE
 125 :       SEGDES MTAB1
 126 : C     WRITE(6,*)' FIN CHICMP NXDIM NYDIM' ,NXDIM,NYDIM
 127 : C      WRITE(6,*)(NAME(I),I=1,NXDIM)
 128 : C      WRITE(6,*)'IDX',(IDX(I),I=1,NXDIM)
 129 : C      WRITE(6,*)'IDY',(IDY(I),I=1,NYDIM)
 130 : C      WRITE(6,*)'GK',(GK(I),I=1,NYDIM)
 131 : C      WRITE(6,110)((AA(I,J),I=1,NYDIM),J=1,NXDIM)
 132 :   110 FORMAT( 2X ,'AA',(10(1PE10.3)))
 133 : 
 134 : 
 135 : 
 136 :       RETURN
 137 :       END
 138 :  
 139 :  
 140 :  
 141 :  
 142 :  
 143 :  
 144 :  
 145 :