Esope source files

   1 : C CHIDES    SOURCE    CHAT      05/01/12    21:57:08     5004           
   2 :       SUBROUTINE CHIDES(MTAB1,IDSCHI)
   3 :       IMPLICIT INTEGER(I-N)
   4 :         IMPLICIT REAL*8 (A-H,O-Z)
   5 : C------------------------------------------------------------------
   6 : C
   7 : C       CHARGEMENT DE LA TABLE DESCHI
   8 : C
   9 : C------------------------------------------------------------------
  10 : -INC SMTABLE
  11 : -INC SMLENTI
  12 : -INC SMLREEL
  13 : -INC SMLMOTS
  14 : -INC CCOPTIO
  15 :       SEGMENT IDSCHI
  16 :            REAL*8 GK(NYDIM),AA(NYDIM,NXDIM),FF(NZDIM,NPDIM)
  17 :            INTEGER IDX(NXDIM),IDY(NYDIM),IDZ(NZDIM),IDP(NPDIM),NN(6)
  18 :            INTEGER IDECY(NYDIM),IONZ(NXDIM)
  19 :            CHARACTER*32 NAME(NXDIM),NAMESP(NYDIM)
  20 :       ENDSEGMENT
  21 :       CHARACTER*8 MTYPI,CHARI,MTYPR,CHARR
  22 : C
  23 :       NYDIM=IDY(/1)
  24 :       NXDIM=IDX(/1)
  25 :       NZDIM=IDZ(/1)
  26 :       NPDIM=IDP(/1)
  27 :       SEGACT MTAB1
  28 :       JG=NXDIM
  29 :       SEGINI MLENTI
  29 :       CALL RSETI(LECT,IDX,JG)
  30 :       IVALI=0
  31 :       XVALI=0.D0
  32 :       IRETI=0
  33 :       IVALR=0
  34 :       XVALR=0.D0
  35 :       IRETR=MLENTI
  36 :       MTYPI='MOT     '
  37 :       MTYPR='LISTENTI'
  38 :       CHARR='        '
  38 :       CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'IDX',.TRUE.,
  39 :      *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  40 :       SEGDES MLENTI
  41 :       JG=NYDIM
  42 :       SEGINI MLENTI
  42 :       CALL RSETI(LECT,IDY,JG)
  43 :       IRETR=MLENTI
  44 :       MTYPR='LISTENTI'
  45 :       CHARR='        '
  45 :       CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'IDY',.TRUE.,
  46 :      *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  47 :       SEGDES MLENTI
  48 :       JG=NZDIM
  49 :       SEGINI MLENTI
  49 :       CALL RSETI(LECT,IDZ,JG)
  50 :       IRETR=MLENTI
  51 :       MTYPR='LISTENTI'
  52 :       CHARR='        '
  52 :       CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'IDZ',.TRUE.,
  53 :      *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  54 :       SEGDES MLENTI
  55 :       JG=NPDIM
  56 :       SEGINI MLENTI
  56 :       CALL RSETI(LECT,IDP,JG)
  57 :       IRETR=MLENTI
  58 :       MTYPR='LISTENTI'
  59 :       CHARR='        '
  59 :       CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'IDP',.TRUE.,
  60 :      *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  61 :       SEGDES MLENTI
  62 :       JG=6
  63 :       SEGINI MLENTI
  63 :       CALL RSETI(LECT,NN,JG)
  64 :       IRETR=MLENTI
  65 :       MTYPR='LISTENTI'
  66 :       CHARR='        '
  66 :       CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'NN',.TRUE.,
  67 :      *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  68 :       SEGDES MLENTI
  69 :       JG=NYDIM
  70 :       SEGINI MLENTI
  70 :       CALL RSETI(LECT,IDECY,JG)
  71 :       IRETR=MLENTI
  72 :       MTYPR='LISTENTI'
  73 :       CHARR='        '
  73 :       CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'IDSURF',.TRUE.,
  74 :      *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  75 :       SEGDES MLENTI
  76 :       JG=NXDIM
  77 :       SEGINI MLENTI
  77 :       CALL RSETI(LECT,IONZ,JG)
  78 :       IRETR=MLENTI
  79 :       MTYPR='LISTENTI'
  80 :       CHARR='        '
  80 :       CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'CHARGE',.TRUE.,
  81 :      *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  82 :       SEGDES MLENTI
  83 :       JG=NYDIM
  84 :       SEGINI MLREEL
  84 :       CALL RSETD(PROG,GK,JG)
  85 :       IRETR=MLREEL
  86 :       MTYPR='LISTREEL'
  87 :       CHARR='        '
  87 :       CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'LOGK',.TRUE.,
  88 :      *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  89 :       SEGDES MLREEL
  90 :       JG=NYDIM*NXDIM
  91 :       SEGINI MLREEL
  91 :       CALL RSETD(PROG,AA,JG)
  92 :       IRETR=MLREEL
  93 :       MTYPR='LISTREEL'
  94 :       CHARR='        '
  94 :       CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'MATRICEA',.TRUE.,
  95 :      *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  96 :       SEGDES MLREEL
  97 :       JG=NZDIM*NPDIM
  98 :       SEGINI MLREEL
  98 :       CALL RSETD(PROG,FF,JG)
  99 :       IRETR=MLREEL
 100 :       MTYPR='LISTREEL'
 101 :       CHARR='        '
 101 :       CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'MATRICEF',.TRUE.,
 102 :      *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
 103 :       SEGDES MLREEL
 104 :       JGN=32
 105 :       JGM=NXDIM
 106 :       SEGINI MLMOTS
 107 :       DO 50 I=1,JGM
 108 :       MOTS(I)=NAME(I)
 109 :    50 CONTINUE
 110 :       IRETR=MLMOTS
 111 :       MTYPR='LISTMOTS'
 112 :       CHARR='        '
 112 :       CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'NOM',.TRUE.,
 113 :      *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
 114 :       SEGDES MLMOTS
 115 :       JGN=32
 116 :       JGM=NYDIM
 117 :       SEGINI MLMOTS
 118 :       DO 60 I=1,JGM
 119 :       MOTS(I)=NAMESP(I)
 120 :    60 CONTINUE
 121 :       IRETR=MLMOTS
 122 :       MTYPR='LISTMOTS'
 123 :       CHARR='        '
 123 :       CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'NOMESPECE',.TRUE.,
 124 :      *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
 125 :       SEGDES MLMOTS
 126 :       RETURN
 127 :       END
 128 :  
 129 :  
 130 :  
 131 :