1 : C LOGK SOURCE CHAT 06/03/29 21:27:14 5360 2 : SUBROUTINE LOGK 3 : C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 4 : C 5 : C OPERATEUR LOGK 6 : C 7 : C CALCULE LA CONSTANTE APPARENTE DE LA LOI D'ACTION 8 : C DE MASSE ( DANS UNE SOLUTION CHIMIQUE) 9 : C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 10 : IMPLICIT INTEGER(I-N) 11 : IMPLICIT REAL*8(A-H,O-Z) 12 : CHARACTER*8 MOCLE(2) 13 : CHARACTER*4 NOMTOT 14 : -INC CCOPTIO 15 : -INC SMLENTI 16 : -INC SMLMOTS 17 : -INC SMCHPOI 18 : -INC SMELEME 19 : POINTEUR MLAA.MLREEL,MLOGK.MLREEL,MLFF.MLREEL 20 : POINTEUR MLIDX.MLENTI,MLIDY.MLENTI,MLIDZ.MLENTI,MLIDP.MLENTI 21 : POINTEUR MLNN.MLENTI,MLDECY.MLENTI 22 : POINTEUR MLIONZ.MLENTI,MLPREC.MLENTI,LISCAL.MLENTI 23 : POINTEUR MLNAME.MLMOTS,MLNESP.MLMOTS 24 : POINTEUR MLSOLU.MLENTI,MMSOLU.MLMOTS 25 : POINTEUR MCLOGK.MCHPOI,ICLOGK.MPOVAL 26 : POINTEUR MCHTMP.MCHPOI,ICHTMP.MPOVAL 27 : CHARACTER*8 TYPEMA 28 : SEGMENT IDSCHI 29 : REAL*8 GK(NYDIM),AA(NYDIM,NXDIM),FF(NZDIM,NPDIM) 30 : INTEGER IDX(NXDIM),IDY(NYDIM),IDZ(NZDIM),IDP(NPDIM),NN(6) 31 : INTEGER IDECY(NYDIM),IONZ(NXDIM) 32 : CHARACTER*32 NAME(NXDIM),NAMESP(NYDIM) 33 : ENDSEGMENT 34 : SEGMENT SP2 35 : REAL*8 GX(NXDIM),XX(NXDIM),GS(NZDIM),SS(NZDIM) 36 : REAL*8 TOT(NXDIM),TOTAQ(NXDIM),TOTFIX(NXDIM),GKS(NZDIM) 37 : REAL*8 YY(NXDIM),ZZ(NXDIM,NXDIM),CC(NYDIM),GC(NYDIM) 38 : ENDSEGMENT 39 : SEGMENT IZBID 40 : INTEGER IBID(NLISCA) 41 : ENDSEGMENT 42 : DATA MOCLE/'FORCEION','TEMPERAT'/ 43 : C 44 : 45 : ICOTY3=0 46 : C 47 : C LECTURE DE LA TABLE CHIMI1 47 : CALL CHMDEB(MLAA,MLOGK,MLFF,MLIDX,MLIDY,MLIDZ,MLIDP,MLNN,MLDECY, 48 : * MLNAME,MLIONZ,ITIDEN,ITREDO,ITEMPE,MLNESP) 49 : IF(IERR.NE.0)RETURN 50 : C 51 : C LECTURE DE LA TABLE IDEN 52 : C TOUS LES SEGMENTS REVIENNENT ACTIFS OU AVEC UN POINTEUR NUL 53 : C 53 : CALL CHMIDE(ITIDEN,MLCOMP,MLSOLU,MMSOLU,MLPREC,MMPREC,MLSURF, 54 : * MMSURF,MLTYP3,MMTYP3,MLTYP6,MMTYP6,MLPARF,MLREAC,MLIMMO, 55 : * MLPOLE,MMPOLE,MLSOSO,MMSOSO,LIMP3) 56 : IF(IERR.NE.0)RETURN 57 : C 58 : C 59 : C LECTURE DE LA TABLE TEMPE(SI ELLE EXISTE) 60 : C TOUS LES SEGMENTS REVIENNENT ACTIFS OU AVEC UN POINTEUR NUL 60 : CALL CHMTET(ITEMPE,LGKMOD,LGKTMP,IP1,IP2,IP3,IP4,IP5) 61 : IF(IERR.NE.0)RETURN 62 : LTMP=0 63 : IF(LGKMOD.NE.0)LTMP=IP3 64 : C 65 : C 66 : JCHTMP=0 67 : JCHFIO=0 68 : NPN=0 69 : LISCAL=0 70 : 10 CONTINUE 71 : IF(LISCAL.EQ.0)THEN 72 : ICO1=0 72 : CALL LIROBJ('LISTENTI',LISCAL,ICO1,IRETOU) 73 : ENDIF 74 : ICOND=0 74 : CALL LIRMOT(MOCLE,2,IRAN,ICOND) 75 : IF(IERR.NE.0)RETURN 76 : IF(IRAN.EQ.1)THEN 77 : C 78 : C 79 : C LECTURE DU CHPOIN DES FORCES IONIQUES 80 : C 80 : CALL LIROBJ('CHPOINT',JCHFIO,0,IRETOU) 81 : IF(IRETOU.EQ.0)THEN 81 : CALL ERREUR(21) 82 : RETURN 83 : ENDIF 84 : MCHPOI=JCHFIO 85 : SEGACT MCHPOI 86 : NSOUPO=IPCHP(/1) 87 : IF(NSOUPO.NE.1)THEN 87 : CALL ERREUR(21) 88 : RETURN 89 : ENDIF 90 : MSOUPO=IPCHP(1) 91 : SEGACT MSOUPO 92 : MELEME=IGEOC 93 : MPOVAL=IPOVAL 94 : SEGACT MPOVAL 95 : NPN=VPOCHA(/1) 96 : GO TO 10 97 : ENDIF 98 : IF(IRAN.EQ.2)THEN 99 : C 100 : C 101 : C LECTURE DU CHPOIN DES TEMPERATURES 102 : C 102 : CALL LIROBJ('CHPOINT',JCHTMP,0,IRETOU) 103 : IF(IRETOU.EQ.0)THEN 103 : CALL ERREUR(21) 104 : RETURN 105 : ENDIF 106 : GO TO 10 107 : ENDIF 108 : IF(JCHTMP.NE.0)THEN 109 : IF(JCHFIO.NE.0)THEN 110 : INDIQ=1 111 : NBCOMP=-1 112 : NOMTOT=' ' 112 : CALL QUEPOI(JCHTMP,MELEME,INDIQ,NBCOMP,NOMTOT) 113 : IF(INDIQ.LT.0)THEN 113 : CALL ERREUR(22) 114 : ENDIF 115 : IF(IERR.NE.0)RETURN 116 : ENDIF 117 : MCHTMP=JCHTMP 117 : CALL LICHT(MCHTMP,ICHTMP,TYPEMA,IGEOM) 118 : NPN=ICHTMP.VPOCHA(/1) 119 : MELEME=IGEOM 120 : ENDIF 121 : IF(NPN.EQ.0)THEN 121 : CALL ERREUR(641) 122 : RETURN 123 : ENDIF 124 : C 125 : C ON ACTIVE LES SEGMENTS 126 : C ET ON DEFINIT LES TABLEAUX DE TRAVAIL 127 : SEGACT MLAA,MLOGK,MLFF,MLIDX,MLIDY,MLIDZ,MLNN,MLDECY,MLNAME,MLNESP 128 : SEGACT MLIONZ,MLIDP 129 : NXDIM=MLIDX.LECT(/1) 130 : NYDIM=MLIDY.LECT(/1) 131 : NZDIM=MLIDZ.LECT(/1) 132 : NPDIM=MLIDP.LECT(/1) 133 : SEGINI IDSCHI 134 : SEGINI SP2 135 : C 136 : C LE CHPOINT RESULTAT 137 : JGM=NYDIM 138 : JGN=4 139 : IF(LISCAL.NE.0)THEN 140 : SEGACT LISCAL 141 : JGM=LISCAL.LECT(/1) 142 : ENDIF 143 : NLISCA=JGM 144 : SEGINI MLMOTS,IZBID 145 : IF(LISCAL.EQ.0)THEN 146 : DO 11 I=1,NYDIM 147 : IBID(I)=I 148 : 11 CONTINUE 149 : ELSE 150 : DO 12 I=1,NLISCA 151 : DO 13 J=1,NYDIM 152 : IF(LISCAL.LECT(I).EQ.MLIDY.LECT(J))THEN 153 : IBID(I)=J 154 : GO TO 14 155 : ENDIF 156 : 13 CONTINUE 156 : CALL ERREUR(21) 157 : RETURN 158 : 14 CONTINUE 159 : 12 CONTINUE 160 : ENDIF 161 : 110 FORMAT('W',I3.3) 162 : DO 15 I=1,NLISCA 163 : WRITE(MOTS(I),110)IBID(I) 164 : 15 CONTINUE 164 : CALL CHMCRC(MLMOTS,MELEME,NPN,MCLOGK,ICLOGK) 165 : SEGSUP MLMOTS 166 : C 167 : C INITIALISATION 168 : SEGACT MELEME 169 : 170 : C 171 : C ------------------------------------------------------------------- 172 : C BOUCLE SUR LES POINTS 173 : C ------------------------------------------------------------------- 174 : DO 100 II=1,NPN 175 : C CHARGEMENT DE IDSCHI 175 : CALL CHMIDS(MLAA,MLOGK,MLFF,MLIDX,MLIDY,MLIDZ,MLIDP,MLNN,MLDECY, 176 : * MLNAME,MLIONZ,IDSCHI,MLNESP) 177 : C WRITE(6,*)' GK apres CHMIDS ' 178 : C WRITE(6,120)(GK(J),IDY(J),J=1,NYDIM) 179 : 120 FORMAT(6(1X,1PD12.5,I5)) 180 : C CHARGEMENT EVENTUEL DE LGKMOD OU LGKTMP 180 : CALL CHMLGK(LGKMOD,LGKTMP,IP1,IP2,IP3,IP4,IP5) 181 : C 182 : XMU=0.D0 183 : XMUNEW=0.D0 184 : IF(JCHFIO.NE.0)THEN 185 : XMUNEW=VPOCHA(II,1) 186 : ENDIF 187 : TMP=25.D0 188 : TMPNEW=25.D0 189 : IF(JCHTMP.NE.0)TMPNEW=ICHTMP.VPOCHA(II,1) 189 : CALL CHMKMD(IDSCHI,LGKMOD,LGKTMP,ICOTY3,LTMP,TMP,TMPNEW, 190 : * XMU,XMUNEW,GNEW) 191 : DO 95 J=1,NLISCA 192 : ICLOGK.VPOCHA(II,J)=GK(IBID(J)) 193 : 95 CONTINUE 194 : 100 CONTINUE 195 : C -------------------------------------------------------------- 196 : C LE MENAGE 197 : C 198 : SEGSUP IDSCHI 199 : SEGSUP SP2,IZBID 200 : C 201 : C ON DESACTIVE LES DONNEES 202 : SEGDES MLAA,MLOGK,MLFF,MLIDX,MLIDY,MLIDZ,MLNN,MLDECY,MLNAME,MLNESP 203 : SEGDES MLIONZ,MLIDP 204 : SEGDES MELEME 205 : MLENTI=MLCOMP 206 : SEGDES MLENTI 207 : IF(MLSOSO.NE.0)THEN 208 : MLENTI=MLSOSO 209 : MLMOTS=MMSOSO 210 : SEGDES MLENTI,MLMOTS 211 : ENDIF 212 : IF(MLPOLE.NE.0)THEN 213 : MLENTI=MLPOLE 214 : MLMOTS=MMPOLE 215 : SEGDES MLENTI,MLMOTS 216 : ENDIF 217 : IF(MLSOLU.NE.0)THEN 218 : MLENTI=MLSOLU 219 : MLMOTS=MMSOLU 220 : SEGDES MLENTI,MLMOTS 221 : ENDIF 222 : IF(MLPREC.NE.0)THEN 223 : MLENTI=MLPREC 224 : MLMOTS=MMPREC 225 : SEGDES MLENTI,MLMOTS 226 : ENDIF 227 : IF(MLSURF.NE.0)THEN 228 : MLENTI=MLSURF 229 : MLMOTS=MMSURF 230 : SEGDES MLENTI,MLMOTS 231 : ENDIF 232 : IF(MLTYP3.NE.0)THEN 233 : MLENTI=MLTYP3 234 : MLMOTS=MMTYP3 235 : SEGDES MLENTI,MLMOTS 236 : ENDIF 237 : IF(MLTYP6.NE.0)THEN 238 : MLENTI=MLTYP6 239 : MLMOTS=MMTYP6 240 : SEGDES MLENTI,MLMOTS 241 : ENDIF 242 : IF(MLPARF.NE.0)THEN 243 : MLENTI=MLPARF 244 : SEGDES MLENTI 245 : ENDIF 246 : IF(MLREAC.NE.0)THEN 247 : MLENTI=MLREAC 248 : SEGDES MLENTI 249 : ENDIF 250 : IF(MLIMMO.NE.0)THEN 251 : MLENTI=MLIMMO 252 : SEGDES MLENTI 253 : ENDIF 254 : IF(JCHTMP.NE.0)THEN 255 : SEGDES ICHTMP 256 : ENDIF 257 : IF(JCHFIO.NE.0)THEN 258 : SEGDES MSOUPO,MPOVAL,MCHPOI 259 : ENDIF 260 : IF(LISCAL.NE.0)THEN 261 : SEGDES LISCAL 262 : ENDIF 262 : CALL CHMDGK(LGKMOD,LGKTMP,IP1,IP2,IP3,IP4,IP5) 263 : C 264 : C ON SAUVE LE RESULTAT 264 : CALL ECROBJ('CHPOINT',MCLOGK) 265 : MSOUPO=MCLOGK.IPCHP(1) 266 : SEGDES ICLOGK,MCLOGK,MSOUPO 267 : RETURN 268 : END 269 : 270 : 271 : 272 : 273 : 274 : 275 : 276 : 277 :
© Cast3M 2003 - All rights reserved.
Disclaimer