1 : C CHISOL SOURCE PV 07/11/23 21:15:39 5978 2 : C CHISOL SOURCE BOS 97/03/03 3 : SUBROUTINE CHISOL(NVSOSO,IDSCHI) 4 : IMPLICIT INTEGER(I-N) 5 : IMPLICIT REAL*8 (A-H,O-Z) 6 : C----------------------------------------------------------------- 7 : C 8 : C PRISE EN COMPTE DE NOUVELLES SOLUTIONS SOLIDES 9 : C 10 : C----------------------------------------------------------------- 11 : -INC SMTABLE 12 : -INC SMLENTI 13 : -INC SMLREEL 14 : -INC CCOPTIO 15 : POINTEUR MLIDEN.MLENTI 16 : SEGMENT IDSCHI 17 : REAL*8 GK(NYDIM),AA(NYDIM,NXDIM),FF(NZDIM,NPDIM) 18 : INTEGER IDX(NXDIM),IDY(NYDIM),IDZ(NZDIM),IDP(NPDIM),NN(6) 19 : INTEGER IDECY(NYDIM),IONZ(NXDIM) 20 : CHARACTER*32 NAME(NXDIM),NAMESP(NYDIM) 21 : ENDSEGMENT 22 : real*8 lf 23 : CHARACTER*8 MTYPI,CHARI,MTYPR,CHARR 24 : LOGICAL LOGRE 25 : INTEGER LINIT 26 : C 27 : NZDIM=IDZ(/1) 28 : NYDIM=IDY(/1) 29 : NXDIM=IDX(/1) 30 : NPDIM=IDP(/1) 31 : MTAB1=NVSOSO 32 : SEGACT MTAB1 33 : NNSOSO=MTAB1.MLOTAB 34 : NISOSO=NNSOSO 35 : C si MTAB1 est une table tous ses indices sont des entiers, mais 36 : C si MTAB1 est un objet il y a des indices METHODE HERI ... en plus 37 : IVALI=0 38 : XVALI=0.D0 39 : IRETI=0 40 : IVALR=0 41 : XVALR=0.D0 42 : IRETR=0 43 : MTYPI='MOT ' 44 : MTYPR=' ' 45 : CHARR=' ' 45 : CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,'CLASSE',.TRUE.,IRETI, 46 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 47 : IF(IERR.NE.0)RETURN 48 : IF(MTYPR.EQ.'MOT ')THEN 49 : C 50 : C on a trouvé CLASSE c'est un OBJET on va compter les indices entier 51 : C 52 : NISOSO= 0 53 : DO 5 IESP=1,NNSOSO 54 : IF((MTAB1.MTABTI(IESP)).EQ.'ENTIER') NISOSO= NISOSO+1 55 : 5 CONTINUE 56 : ENDIF 57 : * WRITE(6,*)'CHISOL',NNSOSO 58 : DO 80 ISOSO=1,NISOSO 59 : IVALI=ISOSO 60 : XVALI=0.D0 61 : IRETI=0 62 : IVALR=0 63 : XVALR=0.D0 64 : IRETR=0 65 : MTYPI='ENTIER ' 66 : MTYPR=' ' 67 : CHARR=' ' 68 : CHARI=' ' 68 : CALL ACCTAB(MTAB1,MTYPI,IVALI,XVALI,CHARI,.TRUE.,IRETI, 69 : * MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) 70 : IF(IERR.NE.0)RETURN 71 : IF((MTYPR.EQ.'TABLE ').OR.(MTYPR.EQ.'OBJET '))THEN 72 : MTAB2=IRETR 73 : * WRITE(6,*)'chisol mtab2=',MTAB2 74 : SEGACT MTAB2 75 : IVALI=1 76 : XVALI=0.D0 77 : IRETI=0 78 : IVALR=0 79 : XVALR=0.D0 80 : IRETR=0 81 : MTYPI='MOT ' 82 : MTYPR='ENTIER ' 83 : CHARR=' ' 83 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'IDEN',.TRUE.,IRETI, 84 : * MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) 85 : IF(IERR.NE.0)RETURN 86 : IDSOSO=IVALR 87 : * WRITE(6,*)'chisol idsoso=',IDSOSO 88 : IVALI=1 89 : XVALI=0.D0 90 : IRETI=0 91 : IVALR=0 92 : XVALR=0.D0 93 : IRETR=0 94 : MTYPI='MOT ' 95 : MTYPR='LISTENTI' 96 : CHARR=' ' 96 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'SOLID',.TRUE.,IRETI, 97 : * MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) 98 : IF(IERR.NE.0)RETURN 99 : MLENTI=IRETR 100 : * write(6,*)'chisol mlenti= ',MLENTI 101 : SEGACT MLENTI 102 : LB=LECT(/1) 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='ENTIER ' 111 : CHARR=' ' 111 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'ITYP',.TRUE.,IRETI, 112 : * MTYPR,IVALR,XVALR,CHARR,.TRUE.,IRETR) 113 : IF(IERR.NE.0)RETURN 114 : ITJP=IVALR 115 : * WRITE(6,*)'CHISOL idsoso,itjp,mlenti',IDSOSO,ITJP,MLENTI 116 : IVALI=1 117 : XVALI=0.D0 118 : IRETI=0 119 : IVALR=0 120 : XVALR=0.D0 121 : IRETR=0 122 : MTYPI='MOT ' 123 : MTYPR=' ' 124 : CHARR=' ' 124 : CALL ACCTAB(MTAB2,MTYPI,IVALI,XVALI,'FRACTIO',.TRUE.,IRETI, 125 : * MTYPR,IVALR,XVALR,CHARR,LOGRE,IRETR) 126 : * write(6,*)'chisol mtypr=',MTYPR,' iretr=',IRETR 127 : IF(MTYPR.EQ.'LISTREEL')THEN 128 : 129 : C SI L UTILISATEUR DONNE LES FRACTIONS MOLAIRES 130 : MLREEL=IRETR 131 : SEGACT MLREEL 132 : LC=PROG(/1) 133 : IF(LB.NE.LC)THEN 134 : MOTERR(1:40)='**********NVSOSO.FRACTIO ' 134 : CALL ERREUR(-301) 134 : CALL ERREUR(21) 135 : RETURN 136 : ENDIF 137 : DO 20 L=1,LB 138 : IF(LECT(L).NE.0)THEN 139 : IDCK=LECT(L) 139 : CALL CHIADY(IDP,NPDIM,IDCK,K) 140 : IF(K.EQ.0)THEN 141 : * WRITE(6,*)' LE POLE ',IDCK,' N A PAS ETE RETENU' 142 : * WRITE(6,*)' LA SOLSOL ',IDSOSO,' NE PEUT ETRE FORMEE' 143 : MOTERR(1:40)='**********NVSOSO.SOLID ' 143 : CALL ERREUR(-301) 144 : INTERR(1)=IDCK 144 : CALL ERREUR(776) 145 : RETURN 146 : ENDIF 147 : ELSE 148 : GOTO 30 149 : ENDIF 150 : 20 CONTINUE 151 : 30 CONTINUE 152 : NN(6)=NN(6)+1 153 : NYDIM=NYDIM+1 154 : NZDIM=NZDIM+1 155 : SEGADJ IDSCHI 156 : IDY(NYDIM)=IDSOSO 157 : DO 10 I=1,NPDIM 158 : FF(NZDIM,I)=0.D0 159 : 10 CONTINUE 160 : 161 : C PRISE EN COMPTE DES FRACTIONS MOLAIRES DONNEES 162 : DO 40 IX=1,LB 163 : IF(LECT(IX).EQ.0) GO TO 50 164 : IDCK=LECT(IX) 164 : CALL CHIADY(IDP,NPDIM,IDCK,IK) 165 : FF(NZDIM,IK)=PROG(IX) 166 : 40 CONTINUE 167 : 168 : C CALCUL DES COEFFICIENTS STOECHIOMETRIQUES 169 : DO JC=1,NXDIM 170 : VF=0 171 : DO IB=1,NPDIM 172 : IF(FF(NZDIM,IB).NE.0.D0)THEN 173 : IDPB=IDP(IB) 173 : CALL CHIADY(IDY,NYDIM,IDPB,IDPC) 174 : VF=VF+AA(IDPC,JC)*FF(NZDIM,IB) 175 : AA(NYDIM,JC)=VF 176 : ENDIF 177 : END DO 178 : END DO 179 : 180 : C CALCUL DE LA CONSTANTE D EQUILIBRE 181 : GK(NYDIM)=0 182 : DO JD=1,NPDIM 183 : IDPJD=IDP(JD) 183 : CALL CHIADY(IDY,NYDIM,IDPJD,IDJD) 184 : IF(FF(NZDIM,JD).NE.0.D0)THEN 185 : LF=LOG10(ABS(FF(NZDIM,JD))) 186 : GK(NYDIM)=GK(NYDIM)+FF(NZDIM,JD)*(GK(IDJD)-LF) 187 : ENDIF 188 : END DO 189 : SEGDES MLREEL 190 : ELSE 191 : 192 : C SI L UTILISATEUR NE DONNE PAS DE FRACTIONS MOLAIRES 193 : NN(6)=NN(6)+1 194 : NYDIM=NYDIM+1 195 : NZDIM=NZDIM+1 196 : SEGADJ IDSCHI 197 : IDY(NYDIM)=IDSOSO 198 : DO 15 I=1,NPDIM 199 : FF(NZDIM,I)=0.D0 200 : 15 CONTINUE 201 : 202 : C INITIALISATION DES FRACTIONS MOLAIRES 203 : DO 60 IIX=1,LB 204 : IF(LECT(IIX).EQ.0) GOTO 50 205 : IDCK=LECT(IIX) 205 : CALL CHIADY(IDP,NPDIM,IDCK,IIK) 206 : FF(NZDIM,IIK)=1.D0 207 : 60 CONTINUE 208 : ENDIF 209 : 210 : 50 CONTINUE 211 : 212 : C MISE EN TYPE 6 DES POLES DE SOLUTIONS SOLIDES 213 : NN1=NN(1)+NN(2)+NN(3) 214 : NN2=NN(1)+NN(2)+NN(3)+NN(4) 215 : NN3=NN(1)+NN(2)+NN(3)+NN(4)+NN(5) 216 : NN4=NN(1)+NN(2)+NN(3)+NN(4)+NN(5)+1 217 : DO INN=NN1+1,NN3 218 : NN4=NN4-1 219 : IDYN=IDY(NN4) 220 : * write(6,*)'chisol idyn',idyn,'idy(nn4)',idy(nn4) 220 : CALL CHIADY(IDP,NPDIM,IDYN,IDN) 221 : * write(6,*)'chisol idn',idn 222 : IF(IDN.NE.0)THEN 223 : IF(FF(NZDIM,IDN).NE.0.D0)THEN 224 : * write(6,*)'chisol ff(nzdim,idn)',ff(nzdim,idn) 225 : IF(NN4.GT.NN1.AND.NN4.LE.NN2)THEN 226 : LINIT=4 226 : CALL CHIREX(IDSCHI,IDYN,LINIT,6) 227 : * write(6,*)'chisol 4 ok pour',idyn,'inn',nn4,'idy',idy(nn4) 228 : ENDIF 229 : IF(NN4.GT.NN2.AND.NN4.LE.NN3)THEN 230 : LINIT=5 230 : CALL CHIREX(IDSCHI,IDYN,LINIT,6) 231 : * write(6,*)'chisol 5 ok pour',idyn,'nn4',nn4,'idy',idy(nn4) 232 : ENDIF 233 : ENDIF 234 : ENDIF 235 : END DO 236 : 237 : LINIT=6 237 : CALL CHIREX(IDSCHI,IDSOSO,LINIT,ITJP) 238 : IDZ(NZDIM)=IDSOSO 239 : SEGDES MLENTI 240 : SEGDES MTAB2 241 : ELSE 242 : MOTERR(1:40)='******** NVSOSO ??????????? ' 242 : CALL ERREUR(-301) 242 : CALL ERREUR(21) 243 : RETURN 244 : ENDIF 245 : 80 CONTINUE 246 : SEGDES MTAB1 247 : 248 : * write(6,*)'fin chisol' 249 : * write(6,*)'NXDIM,NYDIM,NPDIM,NZDIM',NXDIM,NYDIM,NPDIM,NZDIM 250 : * write(6,*)(name(i),i=1,NXDIM) 251 : * write(6,*)'IDX',(IDX(I),I=1,NXDIM) 252 : * write(6,*)'IDY',(IDY(I),I=1,NYDIM) 253 : * WRITE(6,*)'IDZ',(IDZ(I),I=1,NZDIM) 254 : * write(6,*)'IDP',(IDP(I),i=1,npdim) 255 : * do 100 i=1,nydim 256 : * write(6,*)'IDY',idy(i),'AA',(aa(i,j),j=1,nxdim) 257 : * 100 continue 258 : * do 300 k=1,nzdim 259 : * write(6,*)'IDZ',idz(k),'FF',(ff(k,i),i=1,npdim) 260 : * 300 continue 261 : * write(6,*)'GK',(GK(I),I=1,NYDIM) 262 : * write(6,110)((aa(i,j),i=1,NYDIM),j=1,NXDIM) 263 : * write(6,110)((ff(k,i),k=1,NZDIM),i=1,NYDIM) 264 : 110 format(2x,(10(1PE10.3))) 265 : 266 : RETURN 267 : END 268 : 269 : 270 : 271 : 272 : 273 : 274 :
© Cast3M 2003 - All rights reserved.
Disclaimer