C CHISOL SOURCE PV 07/11/23 21:15:39 5978 C CHISOL SOURCE BOS 97/03/03 SUBROUTINE CHISOL(NVSOSO,IDSCHI) IMPLICIT INTEGER(I-N) IMPLICIT REAL*8 (A-H,O-Z) C----------------------------------------------------------------- C C PRISE EN COMPTE DE NOUVELLES SOLUTIONS SOLIDES C C----------------------------------------------------------------- -INC SMTABLE -INC SMLENTI -INC SMLREEL -INC CCOPTIO POINTEUR MLIDEN.MLENTI SEGMENT IDSCHI REAL*8 GK(NYDIM),AA(NYDIM,NXDIM),FF(NZDIM,NPDIM) INTEGER IDX(NXDIM),IDY(NYDIM),IDZ(NZDIM),IDP(NPDIM),NN(6) INTEGER IDECY(NYDIM),IONZ(NXDIM) CHARACTER*32 NAME(NXDIM),NAMESP(NYDIM) ENDSEGMENT real*8 lf CHARACTER*8 MTYPI,CHARI,MTYPR,CHARR LOGICAL LOGRE INTEGER LINIT C NZDIM=IDZ(/1) NYDIM=IDY(/1) NXDIM=IDX(/1) NPDIM=IDP(/1) MTAB1=NVSOSO SEGACT MTAB1 NNSOSO=MTAB1.MLOTAB NISOSO=NNSOSO C si MTAB1 est une table tous ses indices sont des entiers, mais C si MTAB1 est un objet il y a des indices METHODE HERI ... en plus IVALI=0 XVALI=0.D0 IRETI=0 IVALR=0 XVALR=0.D0 IRETR=0 MTYPI='MOT ' MTYPR=' ' CHARR=' ' CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'CLASSE',.TRUE.,IRETI, * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) IF(IERR.NE.0)RETURN IF(MTYPR.EQ.'MOT ')THEN C C on a trouvé CLASSE c'est un OBJET on va compter les indices entier C NISOSO= 0 DO 5 IESP=1,NNSOSO IF((MTAB1.MTABTI(IESP)).EQ.'ENTIER') NISOSO= NISOSO+1 5 CONTINUE ENDIF * WRITE(6,*)'CHISOL',NNSOSO DO 80 ISOSO=1,NISOSO IVALI=ISOSO XVALI=0.D0 IRETI=0 IVALR=0 XVALR=0.D0 IRETR=0 MTYPI='ENTIER ' MTYPR=' ' CHARR=' ' CHARI=' ' CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,CHARI,.TRUE.,IRETI, * MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) IF(IERR.NE.0)RETURN IF((MTYPR.EQ.'TABLE ').OR.(MTYPR.EQ.'OBJET '))THEN MTAB2=IRETR * WRITE(6,*)'chisol mtab2=',MTAB2 SEGACT MTAB2 IVALI=1 XVALI=0.D0 IRETI=0 IVALR=0 XVALR=0.D0 IRETR=0 MTYPI='MOT ' MTYPR='ENTIER ' CHARR=' ' CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'IDEN',.TRUE.,IRETI, * MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) IF(IERR.NE.0)RETURN IDSOSO=IVALR * WRITE(6,*)'chisol idsoso=',IDSOSO IVALI=1 XVALI=0.D0 IRETI=0 IVALR=0 XVALR=0.D0 IRETR=0 MTYPI='MOT ' MTYPR='LISTENTI' CHARR=' ' CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'SOLID',.TRUE.,IRETI, * MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) IF(IERR.NE.0)RETURN MLENTI=IRETR * write(6,*)'chisol mlenti= ',MLENTI SEGACT MLENTI LB=LECT(/1) IVALI=1 XVALI=0.D0 IRETI=0 IVALR=0 XVALR=0.D0 IRETR=0 MTYPI='MOT ' MTYPR='ENTIER ' CHARR=' ' CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'ITYP',.TRUE.,IRETI, * MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) IF(IERR.NE.0)RETURN ITJP=IVALR * WRITE(6,*)'CHISOL idsoso,itjp,mlenti',IDSOSO,ITJP,MLENTI IVALI=1 XVALI=0.D0 IRETI=0 IVALR=0 XVALR=0.D0 IRETR=0 MTYPI='MOT ' MTYPR=' ' CHARR=' ' CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'FRACTIO',.TRUE.,IRETI, * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) * write(6,*)'chisol mtypr=',MTYPR,' iretr=',IRETR IF(MTYPR.EQ.'LISTREEL')THEN C SI L UTILISATEUR DONNE LES FRACTIONS MOLAIRES MLREEL=IRETR SEGACT MLREEL LC=PROG(/1) IF(LB.NE.LC)THEN MOTERR(1:40)='**********NVSOSO.FRACTIO ' CALL ERREUR(-301) CALL ERREUR(21) RETURN ENDIF DO 20 L=1,LB IF(LECT(L).NE.0)THEN IDCK=LECT(L) CALL CHIADY(IDP,NPDIM,IDCK,K) IF(K.EQ.0)THEN * WRITE(6,*)' LE POLE ',IDCK,' N A PAS ETE RETENU' * WRITE(6,*)' LA SOLSOL ',IDSOSO,' NE PEUT ETRE FORMEE' MOTERR(1:40)='**********NVSOSO.SOLID ' CALL ERREUR(-301) INTERR(1)=IDCK CALL ERREUR(776) RETURN ENDIF ELSE GOTO 30 ENDIF 20 CONTINUE 30 CONTINUE NN(6)=NN(6)+1 NYDIM=NYDIM+1 NZDIM=NZDIM+1 SEGADJ IDSCHI IDY(NYDIM)=IDSOSO DO 10 I=1,NPDIM FF(NZDIM,I)=0.D0 10 CONTINUE C PRISE EN COMPTE DES FRACTIONS MOLAIRES DONNEES DO 40 IX=1,LB IF(LECT(IX).EQ.0) GO TO 50 IDCK=LECT(IX) CALL CHIADY(IDP,NPDIM,IDCK,IK) FF(NZDIM,IK)=PROG(IX) 40 CONTINUE C CALCUL DES COEFFICIENTS STOECHIOMETRIQUES DO JC=1,NXDIM VF=0 DO IB=1,NPDIM IF(FF(NZDIM,IB).NE.0.D0)THEN IDPB=IDP(IB) CALL CHIADY(IDY,NYDIM,IDPB,IDPC) VF=VF+AA(IDPC,JC)*FF(NZDIM,IB) AA(NYDIM,JC)=VF ENDIF END DO END DO C CALCUL DE LA CONSTANTE D EQUILIBRE GK(NYDIM)=0 DO JD=1,NPDIM IDPJD=IDP(JD) CALL CHIADY(IDY,NYDIM,IDPJD,IDJD) IF(FF(NZDIM,JD).NE.0.D0)THEN LF=LOG10(ABS(FF(NZDIM,JD))) GK(NYDIM)=GK(NYDIM)+FF(NZDIM,JD)*(GK(IDJD)-LF) ENDIF END DO SEGDES MLREEL ELSE C SI L UTILISATEUR NE DONNE PAS DE FRACTIONS MOLAIRES NN(6)=NN(6)+1 NYDIM=NYDIM+1 NZDIM=NZDIM+1 SEGADJ IDSCHI IDY(NYDIM)=IDSOSO DO 15 I=1,NPDIM FF(NZDIM,I)=0.D0 15 CONTINUE C INITIALISATION DES FRACTIONS MOLAIRES DO 60 IIX=1,LB IF(LECT(IIX).EQ.0) GOTO 50 IDCK=LECT(IIX) CALL CHIADY(IDP,NPDIM,IDCK,IIK) FF(NZDIM,IIK)=1.D0 60 CONTINUE ENDIF 50 CONTINUE C MISE EN TYPE 6 DES POLES DE SOLUTIONS SOLIDES NN1=NN(1)+NN(2)+NN(3) NN2=NN(1)+NN(2)+NN(3)+NN(4) NN3=NN(1)+NN(2)+NN(3)+NN(4)+NN(5) NN4=NN(1)+NN(2)+NN(3)+NN(4)+NN(5)+1 DO INN=NN1+1,NN3 NN4=NN4-1 IDYN=IDY(NN4) * write(6,*)'chisol idyn',idyn,'idy(nn4)',idy(nn4) CALL CHIADY(IDP,NPDIM,IDYN,IDN) * write(6,*)'chisol idn',idn IF(IDN.NE.0)THEN IF(FF(NZDIM,IDN).NE.0.D0)THEN * write(6,*)'chisol ff(nzdim,idn)',ff(nzdim,idn) IF(NN4.GT.NN1.AND.NN4.LE.NN2)THEN LINIT=4 CALL CHIREX(IDSCHI,IDYN,LINIT,6) * write(6,*)'chisol 4 ok pour',idyn,'inn',nn4,'idy',idy(nn4) ENDIF IF(NN4.GT.NN2.AND.NN4.LE.NN3)THEN LINIT=5 CALL CHIREX(IDSCHI,IDYN,LINIT,6) * write(6,*)'chisol 5 ok pour',idyn,'nn4',nn4,'idy',idy(nn4) ENDIF ENDIF ENDIF END DO LINIT=6 CALL CHIREX(IDSCHI,IDSOSO,LINIT,ITJP) IDZ(NZDIM)=IDSOSO SEGDES MLENTI SEGDES MTAB2 ELSE MOTERR(1:40)='******** NVSOSO ??????????? ' CALL ERREUR(-301) CALL ERREUR(21) RETURN ENDIF 80 CONTINUE SEGDES MTAB1 * write(6,*)'fin chisol' * write(6,*)'NXDIM,NYDIM,NPDIM,NZDIM',NXDIM,NYDIM,NPDIM,NZDIM * write(6,*)(name(i),i=1,NXDIM) * write(6,*)'IDX',(IDX(I),I=1,NXDIM) * write(6,*)'IDY',(IDY(I),I=1,NYDIM) * WRITE(6,*)'IDZ',(IDZ(I),I=1,NZDIM) * write(6,*)'IDP',(IDP(I),i=1,npdim) * do 100 i=1,nydim * write(6,*)'IDY',idy(i),'AA',(aa(i,j),j=1,nxdim) * 100 continue * do 300 k=1,nzdim * write(6,*)'IDZ',idz(k),'FF',(ff(k,i),i=1,npdim) * 300 continue * write(6,*)'GK',(GK(I),I=1,NYDIM) * write(6,110)((aa(i,j),i=1,NYDIM),j=1,NXDIM) * write(6,110)((ff(k,i),k=1,NZDIM),i=1,NYDIM) 110 format(2x,(10(1PE10.3))) RETURN END