1 : C FIONI SOURCE CHAT 06/03/29 21:21:07 5360 2 : SUBROUTINE FIONI 3 : C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 4 : C 5 : C OPERATEUR FION 6 : C 7 : C CALCULE LA FORCE IONIQUE D'UNE SOLUTION CHIMIQUE 8 : C UTILISE LES RESULTATS DE CHI1 9 : C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 10 : IMPLICIT INTEGER(I-N) 11 : IMPLICIT REAL*8(A-H,O-Z) 12 : -INC CCOPTIO 13 : -INC SMLENTI 14 : -INC SMLMOTS 15 : -INC SMCHPOI 16 : -INC SMELEME 17 : POINTEUR MLAA.MLREEL,MLOGK.MLREEL,MLFF.MLREEL 18 : POINTEUR MLIDX.MLENTI,MLIDY.MLENTI,MLIDZ.MLENTI,MLIDP.MLENTI 19 : POINTEUR MLNN.MLENTI,MLDECY.MLENTI 20 : POINTEUR MLIONZ.MLENTI,MLPREC.MLENTI 21 : POINTEUR MLNAME.MLMOTS,MLNESP.MLMOTS 22 : POINTEUR MLSOLU.MLENTI,MMSOLU.MLMOTS 23 : POINTEUR MCHFIO.MCHPOI,ICHFIO.MPOVAL 24 : CHARACTER*8 TYPEMA 25 : SEGMENT IDSCHI 26 : REAL*8 GK(NYDIM),AA(NYDIM,NXDIM),FF(NZDIM,NPDIM) 27 : INTEGER IDX(NXDIM),IDY(NYDIM),IDZ(NZDIM),IDP(NPDIM),NN(6) 28 : INTEGER IDECY(NYDIM),IONZ(NXDIM) 29 : CHARACTER*32 NAME(NXDIM),NAMESP(NYDIM) 30 : ENDSEGMENT 31 : SEGMENT SP2 32 : REAL*8 GX(NXDIM),XX(NXDIM),GS(NZDIM),SS(NZDIM) 33 : REAL*8 TOT(NXDIM),TOTAQ(NXDIM),TOTFIX(NXDIM),GKS(NZDIM) 34 : REAL*8 YY(NXDIM),ZZ(NXDIM,NXDIM),CC(NYDIM),GC(NYDIM) 35 : ENDSEGMENT 36 : SEGMENT IZBID 37 : INTEGER IBID(NSOL) 38 : ENDSEGMENT 39 : C 40 : 41 : C 42 : C LECTURE DE LA TABLE CHIMI1 42 : CALL CHMDEB(MLAA,MLOGK,MLFF,MLIDX,MLIDY,MLIDZ,MLIDP,MLNN,MLDECY, 43 : * MLNAME,MLIONZ,ITIDEN,ITREDO,ITEMPE,MLNESP) 44 : IF(IERR.NE.0)RETURN 45 : C 46 : C LECTURE DE LA TABLE IDEN 47 : C TOUS LES SEGMENTS REVIENNENT ACTIFS OU AVEC UN POINTEUR NUL 48 : C 48 : CALL CHMIDE(ITIDEN,MLCOMP,MLSOLU,MMSOLU,MLPREC,MMPREC,MLSURF, 49 : * MMSURF,MLTYP3,MMTYP3,MLTYP6,MMTYP6,MLPARF,MLREAC,MLIMMO, 50 : * MLPOLE,MMPOLE,MLSOSO,MMSOSO,LIMP3) 51 : IF(IERR.NE.0)RETURN 52 : C 53 : C LECTURE DU CHPOIN DES CONCENTRATIONS 54 : C 54 : CALL LIROBJ('CHPOINT',MCHPOI,0,IRETOU) 55 : IF(IRETOU.EQ.0)THEN 55 : CALL ERREUR(21) 56 : RETURN 57 : ENDIF 58 : SEGACT MCHPOI 59 : NSOUPO=IPCHP(/1) 60 : IF(NSOUPO.NE.1)THEN 60 : CALL ERREUR(21) 61 : RETURN 62 : ENDIF 63 : MSOUPO=IPCHP(1) 64 : SEGACT MSOUPO 65 : MELEME=IGEOC 66 : MPOVAL=IPOVAL 67 : NC=NOCOMP(/2) 68 : NSOL=MLSOLU.LECT(/1) 69 : SEGINI IZBID 70 : DO 20 I=1,NSOL 71 : DO 25 J=1,NC 72 : IF(MMSOLU.MOTS(I).EQ.NOCOMP(J))THEN 73 : IBID(I)=J 74 : GO TO 22 75 : ENDIF 76 : 25 CONTINUE 76 : CALL ERREUR(21) 77 : RETURN 78 : 22 CONTINUE 79 : 20 CONTINUE 80 : SEGACT MPOVAL 81 : NPN=VPOCHA(/1) 82 : 83 : C 84 : C ON ACTIVE LES SEGMENTS 85 : C ET ON DEFINIT LES TABLEAUX DE TRAVAIL 86 : SEGACT MLAA,MLOGK,MLFF,MLIDX,MLIDY,MLIDZ,MLNN,MLDECY,MLNAME,MLNESP 87 : SEGACT MLIONZ,MLIDP 88 : NXDIM=MLIDX.LECT(/1) 89 : NYDIM=MLIDY.LECT(/1) 90 : NZDIM=MLIDZ.LECT(/1) 91 : NPDIM=MLIDP.LECT(/1) 92 : SEGINI IDSCHI 93 : SEGINI SP2 94 : C 95 : JGM=1 96 : JGN=4 97 : SEGINI MLMOTS 98 : MOTS(1)='SCAL' 98 : CALL CHMCRC(MLMOTS,MELEME,NPN,MCHFIO,ICHFIO) 99 : SEGSUP MLMOTS 100 : C 101 : C INITIALISATION 102 : SEGACT MELEME 103 : C 104 : C ------------------------------------------------------------------- 105 : C BOUCLE SUR LES POINTS 106 : C ------------------------------------------------------------------- 107 : DO 100 II=1,NPN 108 : C CHARGEMENT DE IDSCHI 108 : CALL CHMIDS(MLAA,MLOGK,MLFF,MLIDX,MLIDY,MLIDZ,MLIDP,MLNN,MLDECY, 109 : * MLNAME,MLIONZ,IDSCHI,MLNESP) 110 : C WRITE(6,*)' GK apres CHMIDS ' 111 : C WRITE(6,120)(GK(J),IDY(J),J=1,NYDIM) 112 : 120 FORMAT(6(1X,1PD12.5,I5)) 113 : C CHARGEMENT DE SP2 114 : DO 6 J=1,NXDIM 115 : TOT(J)= 0.D0 116 : GX(J)= 0.D0 117 : XX(J)=0.D0 118 : TOTAQ(J)=0.D0 119 : TOTFIX(J)=0.D0 120 : YY(J)=0.D0 121 : 6 CONTINUE 121 : CALL INITD(GC,NYDIM,0.D0) 121 : CALL INITD(CC,NYDIM,0.D0) 122 : DO 30 I=1,NSOL 123 : CC(I)=VPOCHA(II,IBID(I)) 124 : 30 CONTINUE 125 : C 126 : C= REMISE A ZERO DES FORCES IONIQUES 127 : C 128 : XMUNEW = 0.D0 128 : CALL CHMION(IDSCHI,SP2,XMUNEW) 129 : ICHFIO.VPOCHA(II,1)= XMUNEW 130 : 100 CONTINUE 131 : C -------------------------------------------------------------- 132 : C LE MENAGE 133 : C 134 : SEGSUP IDSCHI 135 : SEGSUP SP2,IZBID 136 : C 137 : C ON DESACTIVE LES DONNEES 138 : SEGDES MLAA,MLOGK,MLFF,MLIDX,MLIDY,MLIDZ,MLNN,MLDECY,MLNAME,MLNESP 139 : SEGDES MLIONZ,MLIDP 140 : SEGDES MELEME 141 : MLENTI=MLCOMP 142 : SEGDES MLENTI 143 : IF(MLSOSO.NE.0)THEN 144 : MLENTI=MLSOSO 145 : MLMOTS=MMSOSO 146 : SEGDES MLENTI,MLMOTS 147 : ENDIF 148 : IF(MLPOLE.NE.0)THEN 149 : MLENTI=MLPOLE 150 : MLMOTS=MMPOLE 151 : SEGDES MLENTI,MLMOTS 152 : ENDIF 153 : IF(MLSOLU.NE.0)THEN 154 : MLENTI=MLSOLU 155 : MLMOTS=MMSOLU 156 : SEGDES MLENTI,MLMOTS 157 : ENDIF 158 : IF(MLPREC.NE.0)THEN 159 : MLENTI=MLPREC 160 : MLMOTS=MMPREC 161 : SEGDES MLENTI,MLMOTS 162 : ENDIF 163 : IF(MLSURF.NE.0)THEN 164 : MLENTI=MLSURF 165 : MLMOTS=MMSURF 166 : SEGDES MLENTI,MLMOTS 167 : ENDIF 168 : IF(MLTYP3.NE.0)THEN 169 : MLENTI=MLTYP3 170 : MLMOTS=MMTYP3 171 : SEGDES MLENTI,MLMOTS 172 : ENDIF 173 : IF(MLTYP6.NE.0)THEN 174 : MLENTI=MLTYP6 175 : MLMOTS=MMTYP6 176 : SEGDES MLENTI,MLMOTS 177 : ENDIF 178 : IF(MLPARF.NE.0)THEN 179 : MLENTI=MLPARF 180 : SEGDES MLENTI 181 : ENDIF 182 : IF(MLREAC.NE.0)THEN 183 : MLENTI=MLREAC 184 : SEGDES MLENTI 185 : ENDIF 186 : IF(MLIMMO.NE.0)THEN 187 : MLENTI=MLIMMO 188 : SEGDES MLENTI 189 : ENDIF 190 : SEGDES MSOUPO,MPOVAL,MCHPOI 191 : C 192 : C ON SAUVE LE RESULTAT 192 : CALL ECROBJ('CHPOINT',MCHFIO) 193 : MSOUPO=MCHFIO.IPCHP(1) 194 : SEGDES ICHFIO,MCHFIO,MSOUPO 195 : RETURN 196 : END 197 : 198 : 199 : 200 : 201 : 202 : 203 :
© Cast3M 2003 - All rights reserved.
Disclaimer