1 : C NEUTRE SOURCE CHAT 06/03/29 21:27:56 5360 2 : SUBROUTINE NEUTRE 3 : C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 4 : C 5 : C OPERATEUR NEUT 6 : C 7 : C CALCULE LE BILAN ELECTRIQUE 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 MCNEUT.MCHPOI,ICNEUT.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=2 96 : JGN=4 97 : SEGINI MLMOTS 98 : MOTS(1)='CATI' 99 : MOTS(2)='ANIO' 99 : CALL CHMCRC(MLMOTS,MELEME,NPN,MCNEUT,ICNEUT) 100 : SEGSUP MLMOTS 101 : C 102 : C INITIALISATION 103 : SEGACT MELEME 104 : 105 : C 106 : C ------------------------------------------------------------------- 107 : C BOUCLE SUR LES POINTS 108 : C ------------------------------------------------------------------- 109 : DO 100 II=1,NPN 110 : C CHARGEMENT DE IDSCHI 110 : CALL CHMIDS(MLAA,MLOGK,MLFF,MLIDX,MLIDY,MLIDZ,MLIDP,MLNN,MLDECY, 111 : * MLNAME,MLIONZ,IDSCHI,MLNESP) 112 : C WRITE(6,*)' GK apres CHMIDS ' 113 : C WRITE(6,120)(GK(J),IDY(J),J=1,NYDIM) 114 : 120 FORMAT(6(1X,1PD12.5,I5)) 115 : C CHARGEMENT DE SP2 116 : DO 6 J=1,NXDIM 117 : TOT(J)= 0.D0 118 : GX(J)= 0.D0 119 : XX(J)=0.D0 120 : TOTAQ(J)=0.D0 121 : TOTFIX(J)=0.D0 122 : YY(J)=0.D0 123 : 6 CONTINUE 123 : CALL INITD(GC,NYDIM,0.D0) 123 : CALL INITD(CC,NYDIM,0.D0) 124 : DO 30 I=1,NSOL 125 : CC(I)=VPOCHA(II,IBID(I)) 126 : 30 CONTINUE 127 : C 128 : C= CALCUL DES BILANS 129 : C 130 : C 131 : TC=0.D0 132 : TA=0.D0 133 : L1=NN(1)+NN(2) 134 : DO 60 I=1,L1 135 : TW=0.D0 136 : C IF(IDECY(I).EQ.1)GO TO 50 137 : IF(IDECY(I).NE.0)GO TO 50 138 : DO 51 J=1,NXDIM 139 : TW=TW+IONZ(J)*AA(I,J) 140 : 51 CONTINUE 141 : 142 : IF (ABS(TW).LT.1.D-10) TW=0.D0 143 : IF (TW.LT.0.D0) TA=TA+TW*CC(I) 144 : IF (TW.GT.0.D0) TC=TC+TW*CC(I) 145 : 50 CONTINUE 146 : 60 CONTINUE 147 : ICNEUT.VPOCHA(II,1)= TC 148 : ICNEUT.VPOCHA(II,2)= TA 149 : 100 CONTINUE 150 : C -------------------------------------------------------------- 151 : C LE MENAGE 152 : C 153 : SEGSUP IDSCHI 154 : SEGSUP SP2,IZBID 155 : C 156 : C ON DESACTIVE LES DONNEES 157 : SEGDES MLAA,MLOGK,MLFF,MLIDX,MLIDY,MLIDZ,MLNN,MLDECY,MLNAME,MLNESP 158 : SEGDES MLIONZ,MLIDP 159 : SEGDES MELEME 160 : MLENTI=MLCOMP 161 : SEGDES MLENTI 162 : IF(MLSOSO.NE.0)THEN 163 : MLENTI=MLSOSO 164 : MLMOTS=MMSOSO 165 : SEGDES MLENTI,MLMOTS 166 : ENDIF 167 : IF(MLPOLE.NE.0)THEN 168 : MLENTI=MLPOLE 169 : MLMOTS=MMPOLE 170 : SEGDES MLENTI,MLMOTS 171 : ENDIF 172 : IF(MLSOLU.NE.0)THEN 173 : MLENTI=MLSOLU 174 : MLMOTS=MMSOLU 175 : SEGDES MLENTI,MLMOTS 176 : ENDIF 177 : IF(MLPREC.NE.0)THEN 178 : MLENTI=MLPREC 179 : MLMOTS=MMPREC 180 : SEGDES MLENTI,MLMOTS 181 : ENDIF 182 : IF(MLSURF.NE.0)THEN 183 : MLENTI=MLSURF 184 : MLMOTS=MMSURF 185 : SEGDES MLENTI,MLMOTS 186 : ENDIF 187 : IF(MLTYP3.NE.0)THEN 188 : MLENTI=MLTYP3 189 : MLMOTS=MMTYP3 190 : SEGDES MLENTI,MLMOTS 191 : ENDIF 192 : IF(MLTYP6.NE.0)THEN 193 : MLENTI=MLTYP6 194 : MLMOTS=MMTYP6 195 : SEGDES MLENTI,MLMOTS 196 : ENDIF 197 : IF(MLPARF.NE.0)THEN 198 : MLENTI=MLPARF 199 : SEGDES MLENTI 200 : ENDIF 201 : IF(MLREAC.NE.0)THEN 202 : MLENTI=MLREAC 203 : SEGDES MLENTI 204 : ENDIF 205 : IF(MLIMMO.NE.0)THEN 206 : MLENTI=MLIMMO 207 : SEGDES MLENTI 208 : ENDIF 209 : SEGDES MSOUPO,MPOVAL,MCHPOI 210 : C 211 : C 212 : C ON SAUVE LE RESULTAT 212 : CALL ECROBJ('CHPOINT',MCNEUT) 213 : MSOUPO=MCNEUT.IPCHP(1) 214 : SEGDES ICNEUT,MCNEUT,MSOUPO 215 : RETURN 216 : END 217 : 218 : 219 : 220 : 221 : 222 : 223 : 224 : 225 :
© Cast3M 2003 - All rights reserved.
Disclaimer