C CHMPAR SOURCE CHAT 05/01/12 21:59:45 5004 SUBROUTINE CHMPAR(EPS,ITMAX,ISOLM,IAFFI,PRECPE,NITEPE,NFI,IFIONI, *IZTYP4,IZTEMP,IZLOGC,IZTOT,IZCLIM,MLMSOR,DE,MAXDE,MLIMPR,ICALCLOG) C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C C OPERATEUR CHI2 C ON DECODE LES TABLE CONTENANT LES DONNNES ET LES PARAMETRES DE CALCUL C C modif Phm: prise ne compte d'un idicateur pour les calculs c en log de concentration C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC SMTABLE -INC SMLENTI CHARACTER*8 MTYPI,CHARI,MTYPR,CHARR LOGICAL LOGRE C C ON RECUPERE LES OBJETS OU TABLES IRETOU=0 MTAB1=0 CALL LIRTAB('DONNEES_CHIMIQUES',MTAB1,0,IRETOU) IRETO2=0 MTAB2=0 CALL LIROBJ('TABLE',MTAB2,0,IRETO2) IF(IRETO2.EQ.1)SEGACT MTAB2 IF(IRETOU.EQ.0)THEN CALL LIROBJ('OBJET',MTAB3,1,IRETO1) IF(IRETO1.EQ.0)RETURN SEGACT MTAB3 IVALI=1 XVALI=0.D0 IRETI=0 IVALR=0 XVALR=0.D0 IRETR=0 MTYPI='MOT ' MTYPR='MOT ' CHARR=' ' CALL ACCTAB(MTAB3,MTYPI,IVALI,XVALI,'CLASSE',.TRUE.,IRETI, * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) IF(IERR.NE.0)RETURN IF(CHARR.EQ.'PARMCHI2')THEN MTAB2=MTAB3 ELSEIF(CHARR.EQ.'DONCHI2 ')THEN MTAB1=MTAB3 ELSE CALL ERREUR(21) RETURN ENDIF CALL LIROBJ('OBJET',MTAB3,0,IRETO1) IF(IRETO1.EQ.1)THEN SEGACT MTAB3 IVALI=1 XVALI=0.D0 IRETI=0 IVALR=0 XVALR=0.D0 IRETR=0 MTYPI='MOT ' MTYPR='MOT ' CHARR=' ' CALL ACCTAB(MTAB3,MTYPI,IVALI,XVALI,'CLASSE',.TRUE.,IRETI, * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) IF(IERR.NE.0)RETURN IF(CHARR.EQ.'PARMCHI2')THEN MTAB2=MTAB3 ELSEIF(CHARR.EQ.'DONCHI2 ')THEN MTAB1=MTAB3 ELSE CALL ERREUR(21) RETURN ENDIF ENDIF ENDIF C C LECTURE DES DONNEES CHIMIQUES IVALI=1 XVALI=0.D0 IRETI=0 IVALR=0 XVALR=0.D0 IRETR=0 MTYPI='MOT ' MTYPR=' ' CHARR=' ' IFIONI=0 CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'FIONI',.TRUE.,IRETI, * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) IF(MTYPR.NE.' ')THEN IF(MTYPR.EQ.'CHPOINT ')THEN IFIONI=IRETR ELSE MOTERR(1:11)='FIONI ' 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=' ' IZTYP4=0 CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'NTY4',.TRUE.,IRETI, * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) IF(MTYPR.NE.' ')THEN IF(MTYPR.EQ.'CHPOINT ')THEN IZTYP4=IRETR ELSE MOTERR(1:11)='NTYP4 ' 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=' ' IZTEMP=0 CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'TEMPE',.TRUE.,IRETI, * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) IF(MTYPR.NE.' ')THEN IF(MTYPR.EQ.'CHPOINT ')THEN IZTEMP=IRETR ELSE MOTERR(1:11)='TEMPE ' 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