C CHINP SOURCE OF166741 23/10/16 21:15:04 11754 SUBROUTINE CHINP(IDSCHI,LXMX,IOCHI1,IOCHI2) C C======================================================================= C sp issu de TRIOEF C C C C LECTURE DE LA B.D.D. THERMODYNAMIQUE MINEQL C C====================================================================== IMPLICIT INTEGER(I-N) IMPLICIT REAL*8(A-H,O-Z) -INC PPARAM -INC CCOPTIO -INC SMLENTI POINTEUR MLXMX.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 SEGMENT IZCOMP CHARACTER*8 NAM(NXD) INTEGER ION(NXD),IADXT(NXD) ENDSEGMENT DIMENSION IAT(4),IDT(4) NXD=200 SEGINI IZCOMP C INITIALIZE ADDRESS DO J=1,NXD NAM(J) =' ' ION(J) =0 IADXT(J)=0 ENDDO c*dbg write(ioimp,*) 'CHINP debut lecture',iochi1,iochi2 CBRUNO I_Z=0 READ(IOCHI1,520,END=910) (NAM(J),J=1,NXD) I_Z=1 910 CONTINUE IF (I_Z.EQ.0) THEN write(ioimp,*) 'Fin du fichier IOCHI1 atteinte',J ENDIF c*dbg write(ioimp,*) 'Fichier IOCHI1' c*dbg write(ioimp,*) ('='//NAM(J)//'=',J=1,NXD) READ(IOCHI1,530) (ION(J),J=1,NXD) C WRITE(ioimp,*)'chinp COMPO LU ' C INITIALIZE NN NXDIM=IDX(/1) NYDIM=IDY(/1) NZDIM=IDZ(/1) NPDIM=IDP(/1) NNN=NXDIM C WRITE(ioimp,*)'chinp NNN',NNN C INPUT BASIS IN A MATRIX DO I=1,NNN IDXT=IDX(I) IF(IDXT.GT.NXD)THEN C WRITE(6,*)'IDXT',IDXT C WRITE(6,*)'NDX',NDX INTERR(1)=IDXT CALL ERREUR(781) GO TO 500 ENDIF CRUNO NAME(I)=' ' NAME(I)(1:8)=NAM(IDXT) IONZ(I)=ION(IDXT) C IF (IDX(I).EQ.90) JSOH=I IADXT(IDXT)=I C X(I)=10.**GX(I) IDY(I)=IDX(I) AA(I,I)=1.0D0 GK(I)=0.0D0 ENDDO c*dbg WRITE(ioimp,*)'chinp COMPOSANT SURFACE ' NN(1)=NNN C ***************** LECTURE DES DONNEES THERMODYNAMIQUES I=NN(1) DO 400 L=2,6 c*dbg WRITE(ioimp,*)' TYPE ',L I0=I READ(IOCHI2,510) IN c*dbg WRITE(ioimp,*)'chinp NOMBRE ESPECE ' ,IN IF(IN.EQ.0) GO TO 400 DO 300 II=1,IN READ(IOCHI2,510) IDYT,GKT,(IDT(J),IAT(J),J=1,4) DO 310 J=1,4 JTEST=IDT(J) IF(JTEST.EQ.0) GO TO 310 IF(IADXT(JTEST).EQ.0) GO TO 300 310 CONTINUE I=I+1 IF (I.GT.NYDIM) THEN MOTERR(1:8)=' CHXMX ' MOTERR(9:16)='SUITENTI' CALL ERREUR(787) RETURN ENDIF IDY(I)=IDYT GK(I)=GKT C WRITE(ioimp,*)'chinp ESPÈCE',IDY(I) DO 320 J=1,4 JTEST=IDT(J) C IF (IDT(J).EQ.90) N3=N3+1 IF(JTEST.EQ.0) GO TO 320 IADTJT=IADXT(JTEST) AA(I,IADTJT)=IAT(J) C WRITE(6,*)'chinp COMP',IDT(J),AA(I,IADTJT) 320 CONTINUE 300 CONTINUE CMONI---------------LE 10 SEPT 91---------------------------- IF (L.EQ.5) THEN NOUVI=0 * WRITE(6,*)' NMXCH ',NMXCH IF (LXMX.EQ.0) GOTO 270 MLXMX=LXMX SEGACT MLXMX NMXCH=MLXMX.LECT(/1) CPATBOS------------------------------------------------------ C MISE EN IDP DES SOLIDES CHOISIS PAR L UTILISATEUR NPDIM=NMXCH SEGADJ IDSCHI CALL RSETI(IDP,MLXMX.LECT,NPDIM) IN5=I C *-----------------***------MONI------***------------------------------- * CES MODIFS PERMETTENT DE FAIRE UN CHOIX DES MINERAUX A PRENDRE * EN COMPTE;( AVEC MINEQL IL EXISTE UNE FACON BIEN SIMPLE : * METTRE, DANS LE MAIN, TOUTES LES ESPECES DE TYPE 5 * (MINERAL DISSOUS QUI PEUT PRECIPITER S'IL ARRIVE A SATURATION), * EN TYPE 6 : * NN(6)=NN(5)+NN(6) * NN(5)=0 * PUIS, SELECTIONNER EN TYPE 5 LES MINERAUX CHOISIS : * EX: * I5=5 * I6=6 * CALL EXTYP(02231,I6,I5) ********************************************************************** *C RECHERCHE DES MINERAUX NON PRIS EN COMPTE III=I C --- DO 266 ICHOI=I0+1,III DO 267 NM0=1,NMXCH IF (IDY(ICHOI).EQ.(MLXMX.LECT(NM0))) GOTO 269 267 CONTINUE IDY(ICHOI)=0 GK(ICHOI)=0.D0 CBRUNO DO 210 JK=1,NNN AA(ICHOI,JK)=0.D0 210 CONTINUE I=I-1 GOTO 265 269 NOUVI=NOUVI+1 IDY(I0+NOUVI)=IDY(ICHOI) GK(I0+NOUVI)=GK(ICHOI) CBRUNO DO JK=1,NNN AA(I0+NOUVI,JK)=AA(ICHOI,JK) IF(ICHOI.NE.(I0+NOUVI)) AA(ICHOI,JK)=0.D0 ENDDO 265 CONTINUE 266 CONTINUE DO LIK = I0+NMXCH+1,IN5 IDY(LIK)=0 DO JIK=1,NNN AA(LIK,JIK)=0.D0 ENDDO ENDDO ENDIF 270 CONTINUE NN(L)=I-I0 * WRITE(6,*)' NN(',L,')',NN(L) * write(6,*)'NN(4)',NN(4) 400 CONTINUE C MISE EN IDP DES MINERAUX LORSQUE LMXMX=0 IF(LXMX.NE.0) THEN SEGDES MLXMX ELSE NN123=NN(1)+NN(2)+NN(3)+1 NN45=NN(1)+NN(2)+NN(3)+NN(4)+NN(5) DO 600 N=NN123,NN45 NPDIM=NPDIM+1 SEGADJ IDSCHI IDP(NPDIM)=IDY(N) 600 CONTINUE ENDIF C IF (I.LT.NYDIM) THEN NYDIM=I * write(6,*)'Fin chinp' * WRITE(6,*)' NXDIM ',NXDIM,' NYDIM ',NYDIM,' NPDIM ',NPDIM, * * ' NZDIM ',NZDIM SEGADJ IDSCHI ENDIF SEGSUP IZCOMP 510 FORMAT (I5,F9.2,4(I4,I3),T43,A5) C 520 FORMAT((7X,A10,3(8X,A10))) 520 FORMAT((7X,A8,2X,3(8X,A8,2X))) 530 FORMAT (40I2) C*****************REMISE EN TETE DES FICHIERS IOCHI1 ET IOCHI2****** 500 CONTINUE C REWIND(UNIT=IOCHI2) C CLOSE(UNIT=IOCHI2) C REWIND(UNIT=IOCHI1) C CLOSE(UNIT=IOCHI1) C******************************************************************* RETURN END