Télécharger la plaquette Cast3M


fr en

Télécharger chmpar.eso

Retour à la liste

Numérotation des lignes : 

chmpar

  1. C CHMPAR    SOURCE    CHAT      05/01/12    21:59:45     5004
  2.       SUBROUTINE CHMPAR(EPS,ITMAX,ISOLM,IAFFI,PRECPE,NITEPE,NFI,IFIONI,
  3.      *IZTYP4,IZTEMP,IZLOGC,IZTOT,IZCLIM,MLMSOR,DE,MAXDE,MLIMPR,ICALCLOG)
  4. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  5. C
  6. C               OPERATEUR CHI2
  7. C    ON DECODE LES TABLE CONTENANT LES DONNNES ET LES  PARAMETRES DE CALCUL
  8. C
  9. C modif Phm: prise ne compte d'un idicateur pour les calculs
  10. c en log de concentration
  11. C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  12.       IMPLICIT INTEGER(I-N)
  13.       IMPLICIT REAL*8(A-H,O-Z)
  14.  
  15. -INC PPARAM
  16. -INC CCOPTIO
  17. -INC SMTABLE
  18. -INC SMLENTI
  19.       CHARACTER*8 MTYPI,CHARI,MTYPR,CHARR
  20.       LOGICAL LOGRE
  21. C
  22. C                    ON RECUPERE LES OBJETS OU TABLES
  23.       IRETOU=0
  24.       MTAB1=0
  25.       CALL LIRTAB('DONNEES_CHIMIQUES',MTAB1,0,IRETOU)
  26.       IRETO2=0
  27.       MTAB2=0
  28.       CALL LIROBJ('TABLE',MTAB2,0,IRETO2)
  29.       IF(IRETO2.EQ.1)SEGACT MTAB2
  30.       IF(IRETOU.EQ.0)THEN
  31.       CALL LIROBJ('OBJET',MTAB3,1,IRETO1)
  32.       IF(IRETO1.EQ.0)RETURN
  33.       SEGACT MTAB3
  34.       IVALI=1
  35.       XVALI=0.D0
  36.       IRETI=0
  37.       IVALR=0
  38.       XVALR=0.D0
  39.       IRETR=0
  40.       MTYPI='MOT     '
  41.       MTYPR='MOT     '
  42.       CHARR='        '
  43.       CALL ACCTAB(MTAB3,MTYPI,IVALI,XVALI,'CLASSE',.TRUE.,IRETI,
  44.      * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  45.       IF(IERR.NE.0)RETURN
  46.       IF(CHARR.EQ.'PARMCHI2')THEN
  47.             MTAB2=MTAB3
  48.       ELSEIF(CHARR.EQ.'DONCHI2 ')THEN
  49.             MTAB1=MTAB3
  50.       ELSE
  51.            CALL ERREUR(21)
  52.            RETURN
  53.       ENDIF
  54.       CALL LIROBJ('OBJET',MTAB3,0,IRETO1)
  55.       IF(IRETO1.EQ.1)THEN
  56.       SEGACT MTAB3
  57.       IVALI=1
  58.       XVALI=0.D0
  59.       IRETI=0
  60.       IVALR=0
  61.       XVALR=0.D0
  62.       IRETR=0
  63.       MTYPI='MOT     '
  64.       MTYPR='MOT     '
  65.       CHARR='        '
  66.       CALL ACCTAB(MTAB3,MTYPI,IVALI,XVALI,'CLASSE',.TRUE.,IRETI,
  67.      * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  68.       IF(IERR.NE.0)RETURN
  69.       IF(CHARR.EQ.'PARMCHI2')THEN
  70.             MTAB2=MTAB3
  71.       ELSEIF(CHARR.EQ.'DONCHI2 ')THEN
  72.             MTAB1=MTAB3
  73.       ELSE
  74.            CALL ERREUR(21)
  75.            RETURN
  76.       ENDIF
  77.       ENDIF
  78.       ENDIF
  79. C
  80. C                             LECTURE DES DONNEES CHIMIQUES
  81.       IVALI=1
  82.       XVALI=0.D0
  83.       IRETI=0
  84.       IVALR=0
  85.       XVALR=0.D0
  86.       IRETR=0
  87.       MTYPI='MOT     '
  88.       MTYPR='        '
  89.       CHARR='        '
  90.       IFIONI=0
  91.       CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'FIONI',.TRUE.,IRETI,
  92.      * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  93.       IF(MTYPR.NE.'        ')THEN
  94.             IF(MTYPR.EQ.'CHPOINT ')THEN
  95.                  IFIONI=IRETR
  96.             ELSE
  97.                  MOTERR(1:11)='FIONI      '
  98.                  MOTERR(12:20)='CHPOINT '
  99.                  CALL ERREUR(627)
  100.                  RETURN
  101.             ENDIF
  102.       ENDIF
  103.       IVALI=1
  104.       XVALI=0.D0
  105.       IRETI=0
  106.       IVALR=0
  107.       XVALR=0.D0
  108.       IRETR=0
  109.       MTYPI='MOT     '
  110.       MTYPR='        '
  111.       CHARR='        '
  112.       IZTYP4=0
  113.       CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'NTY4',.TRUE.,IRETI,
  114.      * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  115.       IF(MTYPR.NE.'        ')THEN
  116.             IF(MTYPR.EQ.'CHPOINT ')THEN
  117.                  IZTYP4=IRETR
  118.             ELSE
  119.                  MOTERR(1:11)='NTYP4      '
  120.                  MOTERR(12:20)='CHPOINT '
  121.                  CALL ERREUR(627)
  122.                  RETURN
  123.             ENDIF
  124.       ENDIF
  125.       IVALI=1
  126.       XVALI=0.D0
  127.       IRETI=0
  128.       IVALR=0
  129.       XVALR=0.D0
  130.       IRETR=0
  131.       MTYPI='MOT     '
  132.       MTYPR='        '
  133.       CHARR='        '
  134.       IZTEMP=0
  135.       CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'TEMPE',.TRUE.,IRETI,
  136.      * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  137.       IF(MTYPR.NE.'        ')THEN
  138.             IF(MTYPR.EQ.'CHPOINT ')THEN
  139.                  IZTEMP=IRETR
  140.             ELSE
  141.                  MOTERR(1:11)='TEMPE      '
  142.                  MOTERR(12:20)='CHPOINT '
  143.                  CALL ERREUR(627)
  144.                  RETURN
  145.             ENDIF
  146.       ENDIF
  147.       IVALI=1
  148.       XVALI=0.D0
  149.       IRETI=0
  150.       IVALR=0
  151.       XVALR=0.D0
  152.       IRETR=0
  153.       MTYPI='MOT     '
  154.       MTYPR='        '
  155.       CHARR='        '
  156.       IZCLIM=0
  157.       CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'CLIM',.TRUE.,IRETI,
  158.      * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  159.       IF(MTYPR.NE.'        ')THEN
  160.             IF(MTYPR.EQ.'CHPOINT ')THEN
  161.                  IZCLIM=IRETR
  162.             ELSE
  163.                  MOTERR(1:11)='CLIM       '
  164.                  MOTERR(12:20)='CHPOINT '
  165.                  CALL ERREUR(627)
  166.                  RETURN
  167.             ENDIF
  168.       ENDIF
  169.       IVALI=1
  170.       XVALI=0.D0
  171.       IRETI=0
  172.       IVALR=0
  173.       XVALR=0.D0
  174.       IRETR=0
  175.       MTYPI='MOT     '
  176.       MTYPR='CHPOINT '
  177.       CHARR='        '
  178.       CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'LOGC',.TRUE.,IRETI,
  179.      * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  180.       IF(IERR.NE.0)RETURN
  181.       IZLOGC=IRETR
  182.       IVALI=1
  183.       XVALI=0.D0
  184.       IRETI=0
  185.       IVALR=0
  186.       XVALR=0.D0
  187.       IRETR=0
  188.       MTYPI='MOT     '
  189.       MTYPR='CHPOINT '
  190.       CHARR='        '
  191.       CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'TOT',.TRUE.,IRETI,
  192.      * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  193.       IF(IERR.NE.0)RETURN
  194.       IZTOT=IRETR
  195.       SEGDES MTAB1
  196. C                            INITIALISATION DES PARAMETRES
  197.       EPS=1.D-4
  198.       ITMAX=20
  199.       ISOLM=10
  200.       IAFFI=2
  201.       PRECPE=1.D-10
  202.       DE=1.D0
  203.       MAXDE=20
  204.       NITEPE=50
  205.       NFI=4
  206.       MLIMPR=0
  207.       MLMSOR=0
  208.       ICALCLOG=0
  209. C                             LECTURES DES PARAMETRES
  210.       IF(MTAB2.EQ.0)RETURN
  211.       IVALI=1
  212.       XVALI=0.D0
  213.       IRETI=0
  214.       IVALR=0
  215.       XVALR=0.D0
  216.       IRETR=0
  217.       MTYPI='MOT     '
  218.       MTYPR='        '
  219.       CHARR='        '
  220.       CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'EPS',.TRUE.,IRETI,
  221.      * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  222.       IF(MTYPR.NE.'        ')THEN
  223.             IF(MTYPR.EQ.'FLOTTANT')THEN
  224.                  EPS=XVALR
  225.             ELSE
  226.                  MOTERR(1:11)='EPS        '
  227.                  MOTERR(12:20)='FLOTTANT'
  228.                  CALL ERREUR(627)
  229.                  RETURN
  230.             ENDIF
  231.       ENDIF
  232.       IVALR=0
  233.       XVALR=0.D0
  234.       IRETR=0
  235.       MTYPI='MOT     '
  236.       MTYPR='        '
  237.       CHARR='        '
  238.       CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'ITMAX',.TRUE.,IRETI,
  239.      * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  240.       IF(MTYPR.NE.'        ')THEN
  241.             IF(MTYPR.EQ.'ENTIER  ')THEN
  242.                  ITMAX=IVALR
  243.             ELSE
  244.                  MOTERR(1:11)='ITMAX      '
  245.                  MOTERR(12:20)='ENTIER  '
  246.                  CALL ERREUR(627)
  247.                  RETURN
  248.             ENDIF
  249.       ENDIF
  250.       IVALR=0
  251.       XVALR=0.D0
  252.       IRETR=0
  253.       MTYPI='MOT     '
  254.       MTYPR='        '
  255.       CHARR='        '
  256.       CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'ITERSOLI',.TRUE.,IRETI,
  257.      * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  258.       IF(MTYPR.NE.'        ')THEN
  259.             IF(MTYPR.EQ.'ENTIER  ')THEN
  260.                  ISOLM=IVALR
  261.             ELSE
  262.                  MOTERR(1:11)='ITERSOLI   '
  263.                  MOTERR(12:20)='ENTIER  '
  264.                  CALL ERREUR(627)
  265.                  RETURN
  266.             ENDIF
  267.       ENDIF
  268.       IVALR=0
  269.       XVALR=0.D0
  270.       IRETR=0
  271.       MTYPI='MOT     '
  272.       MTYPR='        '
  273.       CHARR='        '
  274.       CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'IAFFICHE',.TRUE.,IRETI,
  275.      * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  276.       IF(MTYPR.NE.'        ')THEN
  277.             IF(MTYPR.EQ.'ENTIER  ')THEN
  278.                  IAFFI=IVALR
  279.             ELSE
  280.                  MOTERR(1:11)='AFFICHE    '
  281.                  MOTERR(12:20)='ENTIER  '
  282.                  CALL ERREUR(627)
  283.                  RETURN
  284.             ENDIF
  285.       ENDIF
  286.       IVALI=1
  287.       XVALI=0.D0
  288.       IRETI=0
  289.       IVALR=0
  290.       XVALR=0.D0
  291.       IRETR=0
  292.       MTYPI='MOT     '
  293.       MTYPR='        '
  294.       CHARR='        '
  295.       CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'PRECPE',.TRUE.,IRETI,
  296.      * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  297.       IF(MTYPR.NE.'        ')THEN
  298.             IF(MTYPR.EQ.'FLOTTANT')THEN
  299.                  PRECPE=XVALR
  300.             ELSE
  301.                  MOTERR(1:11)='PRECPE     '
  302.                  MOTERR(12:20)='FLOTTANT'
  303.                  CALL ERREUR(627)
  304.                  RETURN
  305.             ENDIF
  306.       ENDIF
  307.       IVALI=1
  308.       XVALI=0.D0
  309.       IRETI=0
  310.       IVALR=0
  311.       XVALR=0.D0
  312.       IRETR=0
  313.       MTYPI='MOT     '
  314.       MTYPR='        '
  315.       CHARR='        '
  316.       CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'DELPE',.TRUE.,IRETI,
  317.      * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  318.       IF(MTYPR.NE.'        ')THEN
  319.             IF(MTYPR.EQ.'FLOTTANT')THEN
  320.                  DE=XVALR
  321.             ELSE
  322.                  MOTERR(1:11)='DE         '
  323.                  MOTERR(12:20)='FLOTTANT'
  324.                  CALL ERREUR(627)
  325.                  RETURN
  326.             ENDIF
  327.       ENDIF
  328.       IVALR=0
  329.       XVALR=0.D0
  330.       IRETR=0
  331.       MTYPI='MOT     '
  332.       MTYPR='        '
  333.       CHARR='        '
  334.       CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'MDELPE',.TRUE.,IRETI,
  335.      * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  336.       IF(MTYPR.NE.'        ')THEN
  337.             IF(MTYPR.EQ.'ENTIER  ')THEN
  338.                  MAXDE=IVALR
  339.             ELSE
  340.                  MOTERR(1:11)='MDELPE     '
  341.                  MOTERR(12:20)='ENTIER  '
  342.                  CALL ERREUR(627)
  343.                  RETURN
  344.             ENDIF
  345.       ENDIF
  346.       IVALR=0
  347.       XVALR=0.D0
  348.       IRETR=0
  349.       MTYPI='MOT     '
  350.       MTYPR='        '
  351.       CHARR='        '
  352.       CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'NITERPE',.TRUE.,IRETI,
  353.      * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  354.       IF(MTYPR.NE.'        ')THEN
  355.             IF(MTYPR.EQ.'ENTIER  ')THEN
  356.                  NITEPE=IVALR
  357.             ELSE
  358.                  MOTERR(1:11)='NITERPE    '
  359.                  MOTERR(12:20)='ENTIER  '
  360.                  CALL ERREUR(627)
  361.                  RETURN
  362.             ENDIF
  363.       ENDIF
  364.       IVALR=0
  365.       XVALR=0.D0
  366.       IRETR=0
  367.       MTYPI='MOT     '
  368.       MTYPR='        '
  369.       CHARR='        '
  370.       CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'NFI',.TRUE.,IRETI,
  371.      * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  372.       IF(MTYPR.NE.'        ')THEN
  373.             IF(MTYPR.EQ.'ENTIER  ')THEN
  374.                  NFI=IVALR
  375.             ELSE
  376.                  MOTERR(1:11)='NFI        '
  377.                  MOTERR(12:20)='ENTIER  '
  378.                  CALL ERREUR(627)
  379.                  RETURN
  380.             ENDIF
  381.       ENDIF
  382.       IVALI=1
  383.       XVALI=0.D0
  384.       IRETI=0
  385.       IVALR=0
  386.       XVALR=0.D0
  387.       IRETR=0
  388.       MTYPI='MOT     '
  389.       MTYPR='        '
  390.       CHARR='        '
  391.       CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'SORTIE',.TRUE.,IRETI,
  392.      * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  393.       IF(MTYPR.NE.'        ')THEN
  394.             IF(MTYPR.EQ.'LISTMOTS')THEN
  395.                  MLMSOR=IRETR
  396.             ELSE
  397.                  MOTERR(1:11)='SORTIE     '
  398.                  MOTERR(12:20)='LISTMOTS'
  399.                  CALL ERREUR(627)
  400.                  RETURN
  401.             ENDIF
  402.       ENDIF
  403.       IVALI=1
  404.       XVALI=0.D0
  405.       IRETI=0
  406.       IVALR=0
  407.       XVALR=0.D0
  408.       IRETR=0
  409.       MTYPI='MOT     '
  410.       MTYPR='        '
  411.       CHARR='        '
  412.       CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'CALCLOG',.TRUE.,IRETI,
  413.      * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  414.       IF(MTYPR.NE.'        ')THEN
  415.             IF(MTYPR.EQ.'ENTIER  ')THEN
  416.                  ICALCLOG =IVALR
  417.             ELSE
  418.                  MOTERR(1:11)='ICALCLOG   '
  419.                  MOTERR(12:20)='ENTIER  '
  420.                  CALL ERREUR(627)
  421.                  RETURN
  422.             ENDIF
  423.       ENDIF
  424.  
  425.       IF(IIMPI.GT.0)THEN
  426.            IVALI=1
  427.            XVALI=0.D0
  428.            IRETI=0
  429.            IVALR=0
  430.            XVALR=0.D0
  431.            IRETR=0
  432.            MTYPI='MOT     '
  433.            MTYPR='        '
  434.            CHARR='        '
  435.            CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'IMPRIM',.TRUE.,IRETI,
  436.      *     MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  437.            IF(MTYPR.NE.'        ')THEN
  438.                  IF(MTYPR.EQ.'LISTENTI')THEN
  439.                       MLIMPR=IRETR
  440.                       MLENTI=IRETR
  441.                       SEGACT MLENTI
  442.                  ELSE
  443.                       MOTERR(1:11)='IMPRIM     '
  444.                       MOTERR(12:20)='LISTENTI'
  445.                       CALL ERREUR(627)
  446.                       RETURN
  447.                  ENDIF
  448.            ENDIF
  449.       ENDIF
  450.       SEGDES MTAB2
  451.       RETURN
  452.       END
  453.  
  454.  
  455.  
  456.  
  457.  
  458.  
  459.  
  460.  
  461.  
  462.  

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