Télécharger la plaquette Cast3M


fr en

Télécharger chides.eso

Retour à la liste

Numérotation des lignes : 

chides

  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.  
  15. -INC PPARAM
  16. -INC CCOPTIO
  17.       SEGMENT IDSCHI
  18.            REAL*8 GK(NYDIM),AA(NYDIM,NXDIM),FF(NZDIM,NPDIM)
  19.            INTEGER IDX(NXDIM),IDY(NYDIM),IDZ(NZDIM),IDP(NPDIM),NN(6)
  20.            INTEGER IDECY(NYDIM),IONZ(NXDIM)
  21.            CHARACTER*32 NAME(NXDIM),NAMESP(NYDIM)
  22.       ENDSEGMENT
  23.       CHARACTER*8 MTYPI,CHARI,MTYPR,CHARR
  24. C
  25.       NYDIM=IDY(/1)
  26.       NXDIM=IDX(/1)
  27.       NZDIM=IDZ(/1)
  28.       NPDIM=IDP(/1)
  29.       SEGACT MTAB1
  30.       JG=NXDIM
  31.       SEGINI MLENTI
  32.       CALL RSETI(LECT,IDX,JG)
  33.       IVALI=0
  34.       XVALI=0.D0
  35.       IRETI=0
  36.       IVALR=0
  37.       XVALR=0.D0
  38.       IRETR=MLENTI
  39.       MTYPI='MOT     '
  40.       MTYPR='LISTENTI'
  41.       CHARR='        '
  42.       CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'IDX',.TRUE.,
  43.      *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  44.       SEGDES MLENTI
  45.       JG=NYDIM
  46.       SEGINI MLENTI
  47.       CALL RSETI(LECT,IDY,JG)
  48.       IRETR=MLENTI
  49.       MTYPR='LISTENTI'
  50.       CHARR='        '
  51.       CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'IDY',.TRUE.,
  52.      *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  53.       SEGDES MLENTI
  54.       JG=NZDIM
  55.       SEGINI MLENTI
  56.       CALL RSETI(LECT,IDZ,JG)
  57.       IRETR=MLENTI
  58.       MTYPR='LISTENTI'
  59.       CHARR='        '
  60.       CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'IDZ',.TRUE.,
  61.      *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  62.       SEGDES MLENTI
  63.       JG=NPDIM
  64.       SEGINI MLENTI
  65.       CALL RSETI(LECT,IDP,JG)
  66.       IRETR=MLENTI
  67.       MTYPR='LISTENTI'
  68.       CHARR='        '
  69.       CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'IDP',.TRUE.,
  70.      *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  71.       SEGDES MLENTI
  72.       JG=6
  73.       SEGINI MLENTI
  74.       CALL RSETI(LECT,NN,JG)
  75.       IRETR=MLENTI
  76.       MTYPR='LISTENTI'
  77.       CHARR='        '
  78.       CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'NN',.TRUE.,
  79.      *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  80.       SEGDES MLENTI
  81.       JG=NYDIM
  82.       SEGINI MLENTI
  83.       CALL RSETI(LECT,IDECY,JG)
  84.       IRETR=MLENTI
  85.       MTYPR='LISTENTI'
  86.       CHARR='        '
  87.       CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'IDSURF',.TRUE.,
  88.      *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  89.       SEGDES MLENTI
  90.       JG=NXDIM
  91.       SEGINI MLENTI
  92.       CALL RSETI(LECT,IONZ,JG)
  93.       IRETR=MLENTI
  94.       MTYPR='LISTENTI'
  95.       CHARR='        '
  96.       CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'CHARGE',.TRUE.,
  97.      *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  98.       SEGDES MLENTI
  99.       JG=NYDIM
  100.       SEGINI MLREEL
  101.       CALL RSETD(PROG,GK,JG)
  102.       IRETR=MLREEL
  103.       MTYPR='LISTREEL'
  104.       CHARR='        '
  105.       CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'LOGK',.TRUE.,
  106.      *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  107.       SEGDES MLREEL
  108.       JG=NYDIM*NXDIM
  109.       SEGINI MLREEL
  110.       CALL RSETD(PROG,AA,JG)
  111.       IRETR=MLREEL
  112.       MTYPR='LISTREEL'
  113.       CHARR='        '
  114.       CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'MATRICEA',.TRUE.,
  115.      *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  116.       SEGDES MLREEL
  117.       JG=NZDIM*NPDIM
  118.       SEGINI MLREEL
  119.       CALL RSETD(PROG,FF,JG)
  120.       IRETR=MLREEL
  121.       MTYPR='LISTREEL'
  122.       CHARR='        '
  123.       CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'MATRICEF',.TRUE.,
  124.      *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  125.       SEGDES MLREEL
  126.       JGN=32
  127.       JGM=NXDIM
  128.       SEGINI MLMOTS
  129.       DO 50 I=1,JGM
  130.       MOTS(I)=NAME(I)
  131.    50 CONTINUE
  132.       IRETR=MLMOTS
  133.       MTYPR='LISTMOTS'
  134.       CHARR='        '
  135.       CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'NOM',.TRUE.,
  136.      *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  137.       SEGDES MLMOTS
  138.       JGN=32
  139.       JGM=NYDIM
  140.       SEGINI MLMOTS
  141.       DO 60 I=1,JGM
  142.       MOTS(I)=NAMESP(I)
  143.    60 CONTINUE
  144.       IRETR=MLMOTS
  145.       MTYPR='LISTMOTS'
  146.       CHARR='        '
  147.       CALL ECCTAB(MTAB1,MTYPI,IVALI,XVALI,'NOMESPECE',.TRUE.,
  148.      *IRETI,MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR)
  149.       SEGDES MLMOTS
  150.       RETURN
  151.       END
  152.  
  153.  
  154.  
  155.  
  156.  

© Cast3M 2003 - Tous droits réservés.
Mentions légales