Télécharger la plaquette Cast3M


fr en

Télécharger chmdeb.eso

Retour à la liste

Numérotation des lignes : 

chmdeb

  1. C CHMDEB    SOURCE    CHAT      05/01/12    21:58:48     5004
  2.       SUBROUTINE CHMDEB(MLAA,MLOGK,MLFF,MLIDX,MLIDY,MLIDZ,MLIDP,MLNN,
  3.      * MLDECY,MLNAME,MLIONZ,ITIDEN,ITREDO,ITEMPE,MLNESP)
  4. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  5. C
  6. C               OPERATEUR CHI2
  7. C    ON DECODE LA TABLE ISSUE DE CHI1
  8. C
  9. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  10.       IMPLICIT INTEGER(I-N)
  11.       IMPLICIT REAL*8(A-H,O-Z)
  12.  
  13. -INC PPARAM
  14. -INC CCOPTIO
  15. -INC SMLENTI
  16. -INC SMLREEL
  17. -INC SMTABLE
  18. -INC SMLMOTS
  19.       CHARACTER*8 MTYPI,CHARI,MTYPR,CHARR
  20.       LOGICAL LOGRE
  21. C
  22.       IRETOU=0
  23.       MTAB1=0
  24.       CALL LIRTAB('CHIMI1',MTAB1,1,IRETOU)
  25.       IF(IRETOU.EQ.0)RETURN
  26.       SEGACT MTAB1
  27.       IVALI=1
  28.       XVALI=0.D0
  29.       IRETI=0
  30.       IVALR=0
  31.       XVALR=0.D0
  32.       IRETR=0
  33.       MTYPI='MOT     '
  34.       MTYPR='TABLE   '
  35.       CHARR='        '
  36.       CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'DESCHI',.TRUE.,IRETI,
  37.      * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  38.       IF(IERR.NE.0)RETURN
  39.       MTAB2=IRETR
  40.       SEGACT MTAB2
  41.       IVALI=1
  42.       XVALI=0.D0
  43.       IRETI=0
  44.       IVALR=0
  45.       XVALR=0.D0
  46.       IRETR=0
  47.       MTYPI='MOT     '
  48.       MTYPR='TABLE   '
  49.       CHARR='        '
  50.       CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'IDEN',.TRUE.,IRETI,
  51.      * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  52.       IF(IERR.NE.0)RETURN
  53.       ITIDEN=IRETR
  54. *      write(6,*)'chmdeb itiden= ',ITIDEN
  55.       IVALI=1
  56.       XVALI=0.D0
  57.       IRETI=0
  58.       IVALR=0
  59.       XVALR=0.D0
  60.       IRETR=0
  61.       MTYPI='MOT     '
  62.       MTYPR='        '
  63.       CHARR='        '
  64.       ITREDO=0
  65.       CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'REDOX',.TRUE.,IRETI,
  66.      * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  67.       IF(MTYPR.NE.'        ')THEN
  68.             IF(MTYPR.EQ.'TABLE   ')THEN
  69.                  ITREDO=IRETR
  70.             ELSE
  71.                  MOTERR(1:11)='REDOX      '
  72.                  MOTERR(12:20)='TABLE   '
  73.                  CALL ERREUR(627)
  74.                  RETURN
  75.             ENDIF
  76.       ENDIF
  77.       IVALI=1
  78.       XVALI=0.D0
  79.       IRETI=0
  80.       IVALR=0
  81.       XVALR=0.D0
  82.       IRETR=0
  83.       MTYPI='MOT     '
  84.       MTYPR='        '
  85.       CHARR='        '
  86.       ITEMPE=0
  87.       CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'TEMPE',.TRUE.,IRETI,
  88.      * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  89.       IF(MTYPR.NE.'        ')THEN
  90.             IF(MTYPR.EQ.'TABLE   ')THEN
  91.                  ITEMPE=IRETR
  92.             ELSE
  93.                  MOTERR(1:11)='TEMPE      '
  94.                  MOTERR(12:20)='TABLE   '
  95.                  CALL ERREUR(627)
  96.                  RETURN
  97.             ENDIF
  98.       ENDIF
  99. C                                 ON DECODE LA TABLE DESCHI
  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='LISTENTI'
  108.       CHARR='        '
  109.       CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'IDX',.TRUE.,IRETI,
  110.      * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  111.       IF(IERR.NE.0)RETURN
  112.       MLIDX=IRETR
  113.       IVALI=1
  114.       XVALI=0.D0
  115.       IRETI=0
  116.       IVALR=0
  117.       XVALR=0.D0
  118.       IRETR=0
  119.       MTYPI='MOT     '
  120.       MTYPR='LISTENTI'
  121.       CHARR='        '
  122.       CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'IDY',.TRUE.,IRETI,
  123.      * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  124.       IF(IERR.NE.0)RETURN
  125.       MLIDY=IRETR
  126.       IVALI=1
  127.       XVALI=0.D0
  128.       IRETI=0
  129.       IVALR=0
  130.       XVALR=0.D0
  131.       IRETR=0
  132.       MTYPI='MOT     '
  133.       MTYPR='        '
  134.       CHARR='        '
  135.       CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'IDZ',.TRUE.,IRETI,
  136.      * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  137.       IF(IERR.NE.0)RETURN
  138.       MLIDZ=IRETR
  139.       IVALI=1
  140.       XVALI=0.D0
  141.       IRETI=0
  142.       IVALR=0
  143.       XVALR=0.D0
  144.       IRETR=0
  145.       MTYPI='MOT     '
  146.       MTYPR='LISTENTI'
  147.       CHARR='        '
  148.       CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'IDP',.TRUE.,IRETI,
  149.      * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  150.       MLIDP=IRETR
  151.       IVALI=1
  152.       XVALI=0.D0
  153.       IRETI=0
  154.       IVALR=0
  155.       XVALR=0.D0
  156.       IRETR=0
  157.       MTYPI='MOT     '
  158.       MTYPR='LISTENTI'
  159.       CHARR='        '
  160.       CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'NN',.TRUE.,IRETI,
  161.      * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  162.       IF(IERR.NE.0)RETURN
  163.       MLNN=IRETR
  164.       IVALI=1
  165.       XVALI=0.D0
  166.       IRETI=0
  167.       IVALR=0
  168.       XVALR=0.D0
  169.       IRETR=0
  170.       MTYPI='MOT     '
  171.       MTYPR='LISTENTI'
  172.       CHARR='        '
  173.       CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'IDSURF',.TRUE.,IRETI,
  174.      * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  175.       IF(IERR.NE.0)RETURN
  176.       MLDECY=IRETR
  177.       IVALI=1
  178.       XVALI=0.D0
  179.       IRETI=0
  180.       IVALR=0
  181.       XVALR=0.D0
  182.       IRETR=0
  183.       MTYPI='MOT     '
  184.       MTYPR='LISTENTI'
  185.       CHARR='        '
  186.       CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'CHARGE',.TRUE.,IRETI,
  187.      * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  188.       IF(IERR.NE.0)RETURN
  189.       MLIONZ=IRETR
  190.       IVALI=1
  191.       XVALI=0.D0
  192.       IRETI=0
  193.       IVALR=0
  194.       XVALR=0.D0
  195.       IRETR=0
  196.       MTYPI='MOT     '
  197.       MTYPR='LISTREEL'
  198.       CHARR='        '
  199.       CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'MATRICEA',.TRUE.,IRETI,
  200.      * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  201.       IF(IERR.NE.0)RETURN
  202.       MLAA=IRETR
  203.       IVALI=1
  204.       XVALI=0.D0
  205.       IRETI=0
  206.       IVALR=0
  207.       XVALR=0.D0
  208.       IRETR=0
  209.       MTYPI='MOT     '
  210.       MTYPR='        '
  211.       CHARR='        '
  212.       CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'MATRICEF',.TRUE.,IRETI,
  213.      * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  214.       IF(IERR.NE.0)RETURN
  215.       MLFF=IRETR
  216.       IVALI=1
  217.       XVALI=0.D0
  218.       IRETI=0
  219.       IVALR=0
  220.       XVALR=0.D0
  221.       IRETR=0
  222.       MTYPI='MOT     '
  223.       MTYPR='LISTREEL'
  224.       CHARR='        '
  225.       CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'LOGK',.TRUE.,IRETI,
  226.      * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  227.       IF(IERR.NE.0)RETURN
  228.       MLOGK=IRETR
  229.       IVALI=1
  230.       XVALI=0.D0
  231.       IRETI=0
  232.       IVALR=0
  233.       XVALR=0.D0
  234.       IRETR=0
  235.       MTYPI='MOT     '
  236.       MTYPR='LISTMOTS'
  237.       CHARR='        '
  238.       CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'NOM',.TRUE.,IRETI,
  239.      * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  240.       IF(IERR.NE.0)RETURN
  241.       MLNAME=IRETR
  242.       IVALI=1
  243.       XVALI=0.D0
  244.       IRETI=0
  245.       IVALR=0
  246.       XVALR=0.D0
  247.       IRETR=0
  248.       MTYPI='MOT     '
  249.       MTYPR='LISTMOTS'
  250.       CHARR='        '
  251.       CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'NOMESPECE',.TRUE.,IRETI,
  252.      * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  253.       IF(IERR.NE.0)RETURN
  254.       MLNESP=IRETR
  255.       SEGDES MTAB1,MTAB2
  256. c      write(6,*)'fin chmdeb'
  257. c      write(6,*)'nxdim, nydim, nzdim ',nxdim,nydim,nzdim
  258. c      write(6,*)'idx ',(idx(i),i=1,nxdim)
  259. c      write(6,*)'idy ',(idy(i),i=1,nydim)
  260. c      write(6,*)'idz ',(idz(i),i=1,nzdim)
  261. c      do 700 i=1,nydim
  262. c         write(6,*)'idy ',idy(i),'aa ',(aa(j),j=1,nxdim)
  263. c  700 continue
  264. c      do 800 k=1,nzdim
  265. c         write(6,*)'idz ',idz(k),'ff ',(ff(i),i=1,nydim)
  266. c  800 continue
  267.       RETURN
  268.       END
  269.  
  270.  
  271.  
  272.  
  273.  
  274.  

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