Télécharger la plaquette Cast3M


fr en

Télécharger chmide.eso

Retour à la liste

Numérotation des lignes : 

chmide

  1. C CHMIDE    SOURCE    CHAT      05/01/12    21:59:07     5004
  2.       SUBROUTINE CHMIDE(ITIDEN,MLCOMP,MLSOLU,MMSOLU,MLPREC,MMPREC,
  3.      *     MLSURF,MMSURF,MLTYP3,MMTYP3,MLTYP6,MMTYP6,MLPARF,MLREAC,
  4.      *     MLIMMO,MLPOLE,MMPOLE,MLSOSO,MMSOSO,LIMP3)
  5. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  6. C
  7. C                    OPERATEUR CHI2
  8. C    ON DECODE LA SOUS TABLE ISSUE DE CHI1 TADEB.IDEN
  9. C
  10. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  11.       IMPLICIT INTEGER(I-N)
  12.       IMPLICIT REAL*8(A-H,O-Z)
  13.  
  14. -INC PPARAM
  15. -INC CCOPTIO
  16. -INC SMLENTI
  17. -INC SMLREEL
  18. -INC SMTABLE
  19. -INC SMLMOTS
  20.       CHARACTER*8 MTYPI,CHARI,MTYPR,CHARR
  21.       LOGICAL LOGRE
  22. C
  23.       MTAB2=ITIDEN
  24. *     write(6,*)'chmide mtab2=itiden= ',MTAB2
  25.       SEGACT MTAB2
  26.       IVALI=1
  27.       XVALI=0.D0
  28.       IRETI=0
  29.       IVALR=0
  30.       XVALR=0.D0
  31.       IRETR=0
  32.       MTYPI='MOT     '
  33.       MTYPR='LISTENTI'
  34.       CHARR='        '
  35.       CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'COMP',.TRUE.,IRETI,
  36.      *     MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  37.       IF(IERR.NE.0)RETURN
  38.       MLCOMP=IRETR
  39.       MLENTI=IRETR
  40.       SEGACT MLENTI
  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='LISTENTI'
  49.       CHARR='        '
  50.       CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'SOLU',.TRUE.,IRETI,
  51.      *     MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  52.       IF(IERR.NE.0)RETURN
  53.       MLSOLU=IRETR
  54.       MLENTI=IRETR
  55.       SEGACT MLENTI
  56.       IVALI=1
  57.       XVALI=0.D0
  58.       IRETI=0
  59.       IVALR=0
  60.       XVALR=0.D0
  61.       IRETR=0
  62.       MTYPI='MOT     '
  63.       MTYPR='LISTMOTS'
  64.       CHARR='        '
  65.       CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'NOMSOLU',
  66.      *     .TRUE.,IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  67.       IF(IERR.NE.0)RETURN
  68.       MMSOLU=IRETR
  69.       MLMOTS=IRETR
  70.       SEGACT MLMOTS
  71.       MLPREC=0
  72.       MMPREC=0
  73.       IVALI=1
  74.       XVALI=0.D0
  75.       IRETI=0
  76.       IVALR=0
  77.       XVALR=0.D0
  78.       IRETR=0
  79.       MTYPI='MOT     '
  80.       MTYPR='        '
  81.       CHARR='        '
  82.       CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'PRECI',.TRUE.,IRETI,
  83.      *     MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  84.       IF(MTYPR.NE.'        ')THEN
  85.          IF(MTYPR.EQ.'LISTENTI')THEN
  86.             MLPREC=IRETR
  87.             MLENTI=IRETR
  88.             SEGACT MLENTI
  89.             IVALI=1
  90.             XVALI=0.D0
  91.             IRETI=0
  92.             IVALR=0
  93.             XVALR=0.D0
  94.             IRETR=0
  95.             MTYPI='MOT     '
  96.             MTYPR='LISTMOTS'
  97.             CHARR='        '
  98.             CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'NOMPRECI',
  99.      *           .TRUE.,IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  100.             IF(IERR.NE.0)RETURN
  101.             MMPREC=IRETR
  102.             MLMOTS=IRETR
  103.             SEGACT MLMOTS
  104.          ELSE
  105.             CALL ERREUR(21)
  106.          ENDIF
  107.       ENDIF
  108.       MLPOLE=0
  109.       MMPOLE=0
  110.       IVALI=1
  111.       XVALI=0.D0
  112.       IRETI=0
  113.       IVALR=0
  114.       XVALR=0.D0
  115.       IRETR=0
  116.       MTYPI='MOT     '
  117.       MTYPR='        '
  118.       CHARR='        '
  119.       CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'POLE',.TRUE.,IRETI,
  120.      *     MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  121.       IF(MTYPR.NE.'        ')THEN
  122.          IF(MTYPR.EQ.'LISTENTI')THEN
  123.             MLPOLE=IRETR
  124.             MLENTI=IRETR
  125.             SEGACT MLENTI
  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='LISTMOTS'
  134.             CHARR='        '
  135.             CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'NOMPOLE',
  136.      *           .TRUE.,IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  137.             IF(IERR.NE.0)RETURN
  138.             MMPOLE=IRETR
  139. *     write(6,*)'chmide mmpole',mmpole
  140.             MLMOTS=IRETR
  141.             SEGACT MLMOTS
  142.          ELSE
  143.             CALL ERREUR(21)
  144.          ENDIF
  145.       ENDIF
  146.       MLSOSO=0
  147.       MMSOSO=0
  148.       IVALI=1
  149.       XVALI=0.D0
  150.       IRETI=0
  151.       IVALR=0
  152.       XVALR=0.D0
  153.       IRETR=0
  154.       MTYPI='MOT     '
  155.       MTYPR='        '
  156.       CHARR='        '
  157.       CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'SOSO',.TRUE.,IRETI,
  158.      *     MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  159.       IF(MTYPR.NE.'        ')THEN
  160.          IF(MTYPR.EQ.'LISTENTI')THEN
  161.             MLSOSO=IRETR
  162. *      write(6,*)'chmide mlsoso',mlsoso
  163.             MLENTI=IRETR
  164.             SEGACT MLENTI
  165.             IVALI=1
  166.             XVALI=0.D0
  167.             IRETI=0
  168.             IVALR=0
  169.             XVALR=0.D0
  170.             IRETR=0
  171.             MTYPI='MOT     '
  172.             MTYPR='LISTMOTS'
  173.             CHARR='        '
  174.             CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'NOMSOSO',
  175.      *           .TRUE.,IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  176.             IF(IERR.NE.0)RETURN
  177.             MMSOSO=IRETR
  178. *     write(6,*)'chmide mmsoso',mmsoso
  179.             MLMOTS=IRETR
  180.             SEGACT MLMOTS
  181.          ELSE
  182.             CALL ERREUR(21)
  183.          ENDIF
  184.       ENDIF
  185.       MLSURF=0
  186.       MMSURF=0
  187.       IVALI=1
  188.       XVALI=0.D0
  189.       IRETI=0
  190.       IVALR=0
  191.       XVALR=0.D0
  192.       IRETR=0
  193.       MTYPI='MOT     '
  194.       MTYPR='        '
  195.       CHARR='        '
  196.       CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'SURF',.TRUE.,IRETI,
  197.      *     MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  198.       IF(MTYPR.NE.'        ')THEN
  199.          IF(MTYPR.EQ.'LISTENTI')THEN
  200.             MLSURF=IRETR
  201.             MLENTI=IRETR
  202.             SEGACT MLENTI
  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='LISTMOTS'
  211.             CHARR='        '
  212.             CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'NOMSURF',
  213.      *           .TRUE.,IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  214.             IF(IERR.NE.0)RETURN
  215.             MMSURF=IRETR
  216.             MLMOTS=IRETR
  217.             SEGACT MLMOTS
  218.          ELSE
  219.             CALL ERREUR(21)
  220.          ENDIF
  221.       ENDIF
  222.       MLTYP3=0
  223.       MMTYP3=0
  224.       IVALI=1
  225.       XVALI=0.D0
  226.       IRETI=0
  227.       IVALR=0
  228.       XVALR=0.D0
  229.       IRETR=0
  230.       MTYPI='MOT     '
  231.       MTYPR='        '
  232.       CHARR='        '
  233.       CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'TYP3',.TRUE.,IRETI,
  234.      *     MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  235.       IF(MTYPR.NE.'        ')THEN
  236.          IF(MTYPR.EQ.'LISTENTI')THEN
  237.             MLTYP3=IRETR
  238. *     write(6,*)'chmide mltyp3=',MLTYP3
  239.             MLENTI=IRETR
  240.             SEGACT MLENTI
  241.             IVALI=1
  242.             XVALI=0.D0
  243.             IRETI=0
  244.             IVALR=0
  245.             XVALR=0.D0
  246.             IRETR=0
  247.             MTYPI='MOT     '
  248.             MTYPR='LISTMOTS'
  249.             CHARR='        '
  250.             CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'NOMTYP3',
  251.      *           .TRUE.,IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  252.             IF(IERR.NE.0)RETURN
  253.             MMTYP3=IRETR
  254.             MLMOTS=IRETR
  255.             SEGACT MLMOTS
  256.          ELSE
  257.             CALL ERREUR(21)
  258.          ENDIF
  259.       ENDIF
  260.       LIMP3=0
  261.       IVALI=1
  262.       XVALI=0.D0
  263.       IRETI=0
  264.       IVALR=0
  265.       XVALR=0.D0
  266.       IRETR=0
  267.       MTYPI='MOT     '
  268.       MTYPR='        '
  269.       CHARR='        '
  270.       CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'IMP3',.TRUE.,IRETI,
  271.      *     MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  272.       IF(MTYPR.NE.'        ')THEN
  273.          IF(MTYPR.EQ.'LISTENTI')THEN
  274.             LIMP3=IRETR
  275.          ELSE
  276.             CALL ERREUR(21)
  277.          ENDIF
  278.       ENDIF
  279.       MLTYP6=0
  280.       MMTYP6=0
  281.       IVALI=1
  282.       XVALI=0.D0
  283.       IRETI=0
  284.       IVALR=0
  285.       XVALR=0.D0
  286.       IRETR=0
  287.       MTYPI='MOT     '
  288.       MTYPR='        '
  289.       CHARR='        '
  290.       CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'TYP6',.TRUE.,IRETI,
  291.      *     MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  292.       IF(MTYPR.NE.'        ')THEN
  293.          IF(MTYPR.EQ.'LISTENTI')THEN
  294.             MLTYP6=IRETR
  295.             MLENTI=IRETR
  296.             SEGACT MLENTI
  297.             IVALI=1
  298.             XVALI=0.D0
  299.             IRETI=0
  300.             IVALR=0
  301.             XVALR=0.D0
  302.             IRETR=0
  303.             MTYPI='MOT     '
  304.             MTYPR='LISTMOTS'
  305.             CHARR='        '
  306.             CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'NOMTYP6',
  307.      *           .TRUE.,IRETI,MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  308.             IF(IERR.NE.0)RETURN
  309.             MMTYP6=IRETR
  310.             MLMOTS=IRETR
  311.             SEGACT MLMOTS
  312.          ELSE
  313.             CALL ERREUR(21)
  314.          ENDIF
  315.       ENDIF
  316.       MLPARF=0
  317.       IVALI=1
  318.       XVALI=0.D0
  319.       IRETI=0
  320.       IVALR=0
  321.       XVALR=0.D0
  322.       IRETR=0
  323.       MTYPI='MOT     '
  324.       MTYPR='        '
  325.       CHARR='        '
  326.       CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'PARF',.TRUE.,IRETI,
  327.      *     MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  328.       IF(MTYPR.NE.'        ')THEN
  329.          IF(MTYPR.EQ.'LISTENTI')THEN
  330.             MLPARF=IRETR
  331.             MLENTI=IRETR
  332.             SEGACT MLENTI
  333.          ELSE
  334.             CALL ERREUR(21)
  335.          ENDIF
  336.       ENDIF
  337.       MLREAC=0
  338.       IVALI=1
  339.       XVALI=0.D0
  340.       IRETI=0
  341.       IVALR=0
  342.       XVALR=0.D0
  343.       IRETR=0
  344.       MTYPI='MOT     '
  345.       MTYPR='        '
  346.       CHARR='        '
  347.       CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'REAC',.TRUE.,IRETI,
  348.      *     MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  349.       IF(MTYPR.NE.'        ')THEN
  350.          IF(MTYPR.EQ.'LISTENTI')THEN
  351.             MLREAC=IRETR
  352.             MLENTI=IRETR
  353.             SEGACT MLENTI
  354.          ELSE
  355.             CALL ERREUR(21)
  356.          ENDIF
  357.       ENDIF
  358.       MLIMMO=0
  359.       IVALI=1
  360.       XVALI=0.D0
  361.       IRETI=0
  362.       IVALR=0
  363.       XVALR=0.D0
  364.       IRETR=0
  365.       MTYPI='MOT     '
  366.       MTYPR='        '
  367.       CHARR='        '
  368.       CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'IMMO',.TRUE.,IRETI,
  369.      *     MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  370.       IF(MTYPR.NE.'        ')THEN
  371.          IF(MTYPR.EQ.'LISTENTI')THEN
  372.             MLIMMO=IRETR
  373.             MLENTI=IRETR
  374.             SEGACT MLENTI
  375.          ELSE
  376.             CALL ERREUR(21)
  377.          ENDIF
  378.       ENDIF
  379.       SEGDES MTAB2
  380.       RETURN
  381.       END
  382.  
  383.  
  384.  
  385.  
  386.  
  387.  
  388.  
  389.  

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