Télécharger chmpar.eso

Retour à la liste

Numérotation des lignes :

  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. -INC CCOPTIO
  15. -INC SMTABLE
  16. -INC SMLENTI
  17. CHARACTER*8 MTYPI,CHARI,MTYPR,CHARR
  18. LOGICAL LOGRE
  19. C
  20. C ON RECUPERE LES OBJETS OU TABLES
  21. IRETOU=0
  22. MTAB1=0
  23. CALL LIRTAB('DONNEES_CHIMIQUES',MTAB1,0,IRETOU)
  24. IRETO2=0
  25. MTAB2=0
  26. CALL LIROBJ('TABLE',MTAB2,0,IRETO2)
  27. IF(IRETO2.EQ.1)SEGACT MTAB2
  28. IF(IRETOU.EQ.0)THEN
  29. CALL LIROBJ('OBJET',MTAB3,1,IRETO1)
  30. IF(IRETO1.EQ.0)RETURN
  31. SEGACT MTAB3
  32. IVALI=1
  33. XVALI=0.D0
  34. IRETI=0
  35. IVALR=0
  36. XVALR=0.D0
  37. IRETR=0
  38. MTYPI='MOT '
  39. MTYPR='MOT '
  40. CHARR=' '
  41. CALL ACCTAB(MTAB3,MTYPI,IVALI,XVALI,'CLASSE',.TRUE.,IRETI,
  42. * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  43. IF(IERR.NE.0)RETURN
  44. IF(CHARR.EQ.'PARMCHI2')THEN
  45. MTAB2=MTAB3
  46. ELSEIF(CHARR.EQ.'DONCHI2 ')THEN
  47. MTAB1=MTAB3
  48. ELSE
  49. CALL ERREUR(21)
  50. RETURN
  51. ENDIF
  52. CALL LIROBJ('OBJET',MTAB3,0,IRETO1)
  53. IF(IRETO1.EQ.1)THEN
  54. SEGACT MTAB3
  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='MOT '
  63. CHARR=' '
  64. CALL ACCTAB(MTAB3,MTYPI,IVALI,XVALI,'CLASSE',.TRUE.,IRETI,
  65. * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  66. IF(IERR.NE.0)RETURN
  67. IF(CHARR.EQ.'PARMCHI2')THEN
  68. MTAB2=MTAB3
  69. ELSEIF(CHARR.EQ.'DONCHI2 ')THEN
  70. MTAB1=MTAB3
  71. ELSE
  72. CALL ERREUR(21)
  73. RETURN
  74. ENDIF
  75. ENDIF
  76. ENDIF
  77. C
  78. C LECTURE DES DONNEES CHIMIQUES
  79. IVALI=1
  80. XVALI=0.D0
  81. IRETI=0
  82. IVALR=0
  83. XVALR=0.D0
  84. IRETR=0
  85. MTYPI='MOT '
  86. MTYPR=' '
  87. CHARR=' '
  88. IFIONI=0
  89. CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'FIONI',.TRUE.,IRETI,
  90. * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  91. IF(MTYPR.NE.' ')THEN
  92. IF(MTYPR.EQ.'CHPOINT ')THEN
  93. IFIONI=IRETR
  94. ELSE
  95. MOTERR(1:11)='FIONI '
  96. MOTERR(12:20)='CHPOINT '
  97. CALL ERREUR(627)
  98. RETURN
  99. ENDIF
  100. ENDIF
  101. IVALI=1
  102. XVALI=0.D0
  103. IRETI=0
  104. IVALR=0
  105. XVALR=0.D0
  106. IRETR=0
  107. MTYPI='MOT '
  108. MTYPR=' '
  109. CHARR=' '
  110. IZTYP4=0
  111. CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'NTY4',.TRUE.,IRETI,
  112. * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  113. IF(MTYPR.NE.' ')THEN
  114. IF(MTYPR.EQ.'CHPOINT ')THEN
  115. IZTYP4=IRETR
  116. ELSE
  117. MOTERR(1:11)='NTYP4 '
  118. MOTERR(12:20)='CHPOINT '
  119. CALL ERREUR(627)
  120. RETURN
  121. ENDIF
  122. ENDIF
  123. IVALI=1
  124. XVALI=0.D0
  125. IRETI=0
  126. IVALR=0
  127. XVALR=0.D0
  128. IRETR=0
  129. MTYPI='MOT '
  130. MTYPR=' '
  131. CHARR=' '
  132. IZTEMP=0
  133. CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'TEMPE',.TRUE.,IRETI,
  134. * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  135. IF(MTYPR.NE.' ')THEN
  136. IF(MTYPR.EQ.'CHPOINT ')THEN
  137. IZTEMP=IRETR
  138. ELSE
  139. MOTERR(1:11)='TEMPE '
  140. <äiv s4ylg="font: normal normal 1em/1.2em monospace; margin:0; padding:0; background:none; vertical-align:top;"> MOTERR(12:20)='CHPOINT '
  • CALL ERREUR(627)
  • RETURN
  • ENDIF
  • ENDIF
  • IVALI=1
  • XVALI=0.D0
  • IRETI=0
  • IVALR=0
  • XVALR=0.D0
  • IRETR=0
  • MTYPI='MOT '
  • MTYPR=' '
  • CHARR=' '
  • IZCLIM=0
  • CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'CLIM',.TRUE.,IRETI,
  • * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  • IF(MTYPR.NE.' ')THEN
  • IF(MTYPR.EQ.'CHPOINT ')THEN
  • IZCLIM=IRETR
  • ELSE
  • MOTERR(1:11)='CLIM '
  • MOTERR(12:20)='CHPOINT '
  • CALL ERREUR(627)
  • RETURN
  • ENDIF
  • ENDIF
  • IVALI=1
  • XVALI=0.D0
  • IRETI=0
  • IVALR=0
  • XVALR=0.D0
  • IRETR=0
  • MTYPI='MOT '
  • MTYPR='CHPOINT '
  • CHARR=' '
  • CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'LOGC',.TRUE.,IRETI,
  • * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  • IF(IERR.NE.0)RETURN
  • IZLOGC=IRETR
  • IVALI=1
  • XVALI=0.D0
  • IRETI=0
  • IVALR=0
  • XVALR=0.D0
  • IRETR=0
  • MTYPI='MOT '
  • MTYPR='CHPOINT '
  • CHARR=' '
  • CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'TOT',.TRUE.,IRETI,
  • * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  • IF(IERR.NE.0)RETURN
  • IZTOT=IRETR
  • SEGDES MTAB1
  • C INITIALISATION DES PARAMETRES
  • EPS=1.D-4
  • ITMAX=20
  • ISOLM=10
  • IAFFI=2
  • PRECPE=1.D-10
  • DE=1.D0
  • MAXDE=20
  • NITEPE=50
  • NFI=4
  • MLIMPR=0
  • MLMSOR=0
  • ICALCLOG=0
  • C LECTURES DES PARAMETRES
  • IF(MTAB2.EQ.0)RETURN
  • IVALI=1
  • XVALI=0.D0
  • IRETI=0
  • IVALR=0
  • XVALR=0.D0
  • IRETR=0
  • MTYPI='MOT '
  • MTYPR=' '
  • CHARR=' '
  • CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'EPS',.TRUE.,IRETI,
  • * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  • IF(MTYPR.NE.' ')THEN
  • IF(MTYPR.EQ.'FLOTTANT')THEN
  • EPS=XVALR
  • ELSE
  • MOTERR(1:11)='EPS '
  • MOTERR(12:20)='FLOTTANT'
  • CALL ERREUR(627)
  • RETURN
  • ENDIF
  • ENDIF
  • IVALR=0
  • XVALR=0.D0
  • IRETR=0
  • MTYPI='MOT '
  • MTYPR=' '
  • CHARR=' '
  • CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'ITMAX',.TRUE.,IRETI,
  • * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  • IF(MTYPR.NE.' ')THEN
  • IF(MTYPR.EQ.'ENTIER ')THEN
  • ITMAX=IVALR
  • ELSE
  • MOTERR(1:11)='ITMAX '
  • MOTERR(12:20)='ENTIER '
  • CALL ERREUR(627)
  • RETURN
  • ENDIF
  • ENDIF
  • IVALR=0
  • XVALR=0.D0
  • IRETR=0
  • MTYPI='MOT '
  • MTYPR=' '
  • CHARR=' '
  • CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'ITERSOLI',.TRUE.,IRETI,
  • * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  • IF(MTYPR.NE.' ')THEN
  • IF(MTYPR.EQ.'ENTIER ')THEN
  • ISOLM=IVALR
  • ELSE
  • MOTERR(1:11)='ITERSOLI '
  • MOTERR(12:20)='ENTIER '
  • CALL ERREUR(627)
  • RETURN
  • ENDIF
  • ENDIF
  • IVALR=0
  • XVALR=0.D0
  • IRETR=0
  • MTYPI='MOT '
  • MTYPR=' '
  • CHARR=' '
  • CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'IAFFICHE',.TRUE.,IRETI,
  • * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  • IF(MTYPR.NE.' ')THEN
  • IF(MTYPR.EQ.'ENTIER ')THEN
  • IAFFI=IVALR
  • ELSE
  • MOTERR(1:11)='AFFICHE '
  • MOTERR(12:20)='ENTIER '
  • CALL ERREUR(627)
  • RETURN
  • ENDIF
  • ENDIF
  • IVALI=1
  • XVALI=0.D0
  • IRETI=0
  • IVALR=0
  • XVALR=0.D0
  • IRETR=0
  • MTYPI='MOT '
  • MTYPR=' '
  • CHARR=' '
  • CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'PRECPE',.TRUE.,IRETI,
  • * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  • IF(MTYPR.NE.' ')THEN
  • IF(MTYPR.EQ.'FLOTTANT')THEN
  • PRECPE=XVALR
  • ELSE
  • MOTERR(1:11)='PRECPE '
  • MOTERR(12:20)='FLOTTANT'
  • CALL ERREUR(627)
  • RETURN
  • ENDIF
  • ENDIF
  • IVALI=1
  • XVALI=0.D0
  • IRETI=0
  • IVALR=0
  • XVALR=0.D0
  • IRETR=0
  • MTYPI='MOT '
  • MTYPR=' '
  • CHARR=' '
  • CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'DELPE',.TRUE.,IRETI,
  • * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  • IF(MTYPR.NE.' ')THEN
  • IF(MTYPR.EQ.'FLOTTANT')THEN
  • DE=XVALR
  • ELSE
  • MOTERR(1:11)='DE '
  • MOTERR(12:20)='FLOTTANT'
  • CALL ERREUR(627)
  • RETURN
  • ENDIF
  • ENDIF
  • IVALR=0
  • XVALR=0.D0
  • IRETR=0
  • MTYPI='MOT '
  • MTYPR=' '
  • CHARR=' '
  • CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'MDELPE',.TRUE.,IRETI,
  • * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  • IF(MTYPR.NE.' ')THEN
  • IF(MTYPR.EQ.'ENTIER ')THEN
  • MAXDE=IVALR
  • ELSE
  • MOTERR(1:11)='MDELPE '
  • MOTERR(12:20)='ENTIER '
  • CALL ERREUR(627)
  • RETURN
  • ENDIF
  • ENDIF
  • IVALR=0
  • XVALR=0.D0
  • IRETR=0
  • MTYPI='MOT '
  • MTYPR=' '
  • CHARR=' '
  • CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'NITERPE',.TRUE.,IRETI,
  • * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  • IF(MTYPR.NE.' ')THEN
  • IF(MTYPR.EQ.'ENTIER ')THEN
  • NITEPE=IVALR
  • ELSE
  • MOTERR(1:11)='NITERPE '
  • MOTERR(12:20)='ENTIER '
  • CALL ERREUR(627)
  • RETURN
  • ENDIF
  • ENDIF
  • IVALR=0
  • XVALR=0.D0
  • IRETR=0
  • MTYPI='MOT '
  • MTYPR=' '
  • CHARR=' '
  • CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'NFI',.TRUE.,IRETI,
  • * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  • IF(MTYPR.NE.' ')THEN
  • IF(MTYPR.EQ.'ENTIER ')THEN
  • NFI=IVALR
  • ELSE
  • MOTERR(1:11)='NFI '
  • MOTERR(12:20)='ENTIER '
  • CALL ERREUR(627)
  • RETURN
  • ENDIF
  • ENDIF
  • IVALI=1
  • XVALI=0.D0
  • IRETI=0
  • IVALR=0
  • XVALR=0.D0
  • IRETR=0
  • MTYPI='MOT '
  • MTYPR=' '
  • CHARR=' '
  • CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'SORTIE',.TRUE.,IRETI,
  • * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  • IF(MTYPR.NE.' ')THEN
  • IF(MTYPR.EQ.'LISTMOTS')THEN
  • MLMSOR=IRETR
  • ELSE
  • MOTERR(1:11)='SORTIE '
  • MOTERR(12:20)='LISTMOTS'
  • CALL ERREUR(627)
  • RETURN
  • ENDIF
  • ENDIF
  • IVALI=1
  • XVALI=0.D0
  • IRETI=0
  • IVALR=0
  • XVALR=0.D0
  • IRETR=0
  • MTYPI='MOT '
  • MTYPR=' '
  • CHARR=' '
  • CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'CALCLOG',.TRUE.,IRETI,
  • * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  • IF(MTYPR.NE.' ')THEN
  • IF(MTYPR.EQ.'ENTIER ')THEN
  • ICALCLOG =IVALR
  • ELSE
  • MOTERR(1:11)='ICALCLOG '
  • MOTERR(12:20)='ENTIER '
  • CALL ERREUR(627)
  • RETURN
  • ENDIF
  • ENDIF
  •  
  • IF(IIMPI.GT.0)THEN
  • IVALI=1
  • XVALI=0.D0
  • IRETI=0
  • IVALR=0
  • XVALR=0.D0
  • IRETR=0
  • MTYPI='MOT '
  • MTYPR=' '
  • CHARR=' '
  • CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'IMPRIM',.TRUE.,IRETI,
  • * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR)
  • IF(MTYPR.NE.' ')THEN
  • IF(MTYPR.EQ.'LISTENTI')THEN
  • MLIMPR=IRETR
  • MLENTI=IRETR
  • SEGACT MLENTI
  • ELSE
  • MOTERR(1:11)='IMPRIM '
  • MOTERR(12:20)='LISTENTI'
  • CALL ERREUR(627)
  • RETURN
  • ENDIF
  • ENDIF
  • ENDIF
  • SEGDES MTAB2
  • RETURN
  • END
  •  
  •  
  •  
  •  
  •  
  •  
  •  
  •  
  •  
  •  
  • © Cast3M 2003 - Tous droits réservés.
    Mentions légales