1 : C FIMVF3 SOURCE MAGN 09/07/30 21:17:00 6458 2 : SUBROUTINE FIMVF3(ILIINC,ICEN,IGRAV,IJAC) 3 : C************************************************************************ 4 : C 5 : C PROJET : CASTEM 2000 6 : C 7 : C NOM : FIMVF3 8 : C 9 : C DESCRIPTION : VOIR FIMVF1 10 : C 11 : C Gaz ideal mono-espece: 12 : C jacobienne lié à la gravité. 13 : C 14 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec extensions CISI) 15 : C 16 : C AUTEUR : A. BECCANTINI, DEN/DM2S/SFME/LTMF 17 : C 18 : C************************************************************************ 19 : C 20 : C ENTREES : 21 : C 22 : C ILIINC : LISTMOTS, noms des inconnues 23 : C 24 : C ICEN : SPG geometrique 25 : C 26 : C IGRAV : CHPOINT gravité 27 : C 28 : C 29 : C SORTIES : IJAC : MATRIK jacobienne 30 : C 31 : C 32 : C************************************************************************ 33 : C 34 : C HISTORIQUE (Anomalies et modifications éventuelles) 35 : C 36 : C HISTORIQUE : Créée le 24.1.03 37 : C 38 : C************************************************************************ 39 : C 40 : C 41 : C**** Variables de COOPTIO 42 : C 43 : C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 44 : C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 45 : C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 46 : C & ,IECHO, IIMPI, IOSPI 47 : C & ,IDIM 48 : C & ,MCOORD 49 : C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 50 : C & ,NGMAXY, IZROSF, ISOTYP, IOSCR, LTEXLU 51 : C & ,NORINC, NORVAL, NORIND, NORVAD 52 : C & ,NUCROU, IPSAUV, IFICLE, IPREFI 53 : C 54 : C**** Les variables 55 : C 56 : IMPLICIT INTEGER(I-N) 57 : INTEGER ILIINC,ICEN,IGRAV,IJAC,N1,NLCE 58 : & ,IGEOM 59 : & ,MP, NBEL, NBME, NBSOUS, NKID, NKMT, NMATRI, NP, NRIGE 60 : CHARACTER*8 TYPE 61 : REAL*8 GX, GY, GZ 62 : C 63 : C**** Les includes 64 : C 65 : -INC CCOPTIO 66 : -INC SMLMOTS 67 : -INC SMELEME 68 : -INC SMCHPOI 69 : -INC SMMATRIK 70 : C 71 : C**** Dual = ux (composante de la qdm) 72 : C Primal = rho 73 : C Matrice elementaire = UXR 74 : C 75 : POINTEUR UXR.IZAFM, UYR.IZAFM, UZR.IZAFM, 76 : & RETUX.IZAFM, RETUY.IZAFM, RETUZ.IZAFM 77 : C 78 : C**** Let's start programming!!! 79 : C 80 : IPT1 = ICEN 81 : SEGACT IPT1 82 : N1 = IPT1.NUM(/2) 83 : SEGDES IPT1 84 : C 85 : C**** Lecture de MPOVALs 86 : C 86 : CALL LICHT(IGRAV,MPOVA3,TYPE,IGEOM) 87 : C 88 : C**** LICHT active les MPOVALs en *MOD 89 : C 90 : C i.e. 91 : C 92 : C SEGACT MPOVA3*MOD 93 : C 94 : C 95 : C**** Objet MATRIK 96 : C 97 : NRIGE = 7 98 : NMATRI = 1 99 : NKID = 9 100 : NKMT = 7 101 : C 102 : SEGINI MATRIK 103 : IJAC = MATRIK 104 : MATRIK.IRIGEL(1,1) = ICEN 105 : MATRIK.IRIGEL(2,1) = ICEN 106 : C 107 : C**** Matrice non symetrique 108 : C 109 : MATRIK.IRIGEL(7,1) = 2 110 : C 111 : MLMOTS=ILIINC 112 : SEGACT MLMOTS 113 : NBSOUS = 1 114 : IF(IDIM.EQ.2)THEN 115 : NBME = 4 116 : SEGINI IMATRI 117 : MATRIK.IRIGEL(4,1) = IMATRI 118 : C 119 : IMATRI.LISPRI(1) = MLMOTS.MOTS(1) 120 : IMATRI.LISPRI(2) = MLMOTS.MOTS(1) 121 : IMATRI.LISPRI(3) = MLMOTS.MOTS(2) 122 : IMATRI.LISPRI(4) = MLMOTS.MOTS(3) 123 : C 124 : IMATRI.LISDUA(1) = MLMOTS.MOTS(2) 125 : IMATRI.LISDUA(2) = MLMOTS.MOTS(3) 126 : IMATRI.LISDUA(3) = MLMOTS.MOTS(4) 127 : IMATRI.LISDUA(4) = MLMOTS.MOTS(4) 128 : ELSEIF(IDIM.EQ.3)THEN 129 : C 130 : NBME = 6 131 : SEGINI IMATRI 132 : MATRIK.IRIGEL(4,1) = IMATRI 133 : C 134 : IMATRI.LISPRI(1) = MLMOTS.MOTS(1) 135 : IMATRI.LISPRI(2) = MLMOTS.MOTS(1) 136 : IMATRI.LISPRI(3) = MLMOTS.MOTS(1) 137 : IMATRI.LISPRI(4) = MLMOTS.MOTS(2) 138 : IMATRI.LISPRI(5) = MLMOTS.MOTS(3) 139 : IMATRI.LISPRI(6) = MLMOTS.MOTS(4) 140 : C 141 : IMATRI.LISDUA(1) = MLMOTS.MOTS(2) 142 : IMATRI.LISDUA(2) = MLMOTS.MOTS(3) 143 : IMATRI.LISDUA(3) = MLMOTS.MOTS(4) 144 : IMATRI.LISDUA(4) = MLMOTS.MOTS(5) 145 : IMATRI.LISDUA(5) = MLMOTS.MOTS(5) 146 : IMATRI.LISDUA(6) = MLMOTS.MOTS(5) 147 : ENDIF 148 : C 149 : SEGDES MLMOTS 150 : NBEL = N1 151 : NBSOUS = 1 152 : NP = 1 153 : MP = 1 154 : C 155 : IF(IDIM .EQ. 2)THEN 156 : SEGINI UXR, UYR, RETUX, RETUY 157 : IMATRI.LIZAFM(1,1) = UXR 158 : IMATRI.LIZAFM(1,2) = UYR 159 : IMATRI.LIZAFM(1,3) = RETUX 160 : IMATRI.LIZAFM(1,4) = RETUY 161 : ELSEIF(IDIM.EQ.3)THEN 162 : SEGINI UXR, UYR, UZR, RETUX, RETUY, RETUZ 163 : IMATRI.LIZAFM(1,1) = UXR 164 : IMATRI.LIZAFM(1,2) = UYR 165 : IMATRI.LIZAFM(1,3) = UZR 166 : IMATRI.LIZAFM(1,4) = RETUX 167 : IMATRI.LIZAFM(1,5) = RETUY 168 : IMATRI.LIZAFM(1,6) = RETUZ 169 : ENDIF 170 : C 171 : SEGDES MATRIK 172 : SEGDES IMATRI 173 : C SEGDES IMATRI 174 : C 175 : C**** Fin definition MATRIK 176 : C 177 : GZ = 0.0D0 178 : DO NLCE = 1, N1, 1 179 : C 180 : C******* Les differents variables a chaque centre 181 : C 182 : GX = MPOVA3.VPOCHA(NLCE,1) 183 : GY = MPOVA3.VPOCHA(NLCE,2) 184 : IF(IDIM .EQ. 3)THEN 185 : GZ = MPOVA3.VPOCHA(NLCE,3) 186 : ENDIF 187 : C 188 : UXR.AM(NLCE,1,1)=GX 189 : UYR.AM(NLCE,1,1)=GY 190 : RETUX.AM(NLCE,1,1)=GX 191 : RETUY.AM(NLCE,1,1)=GY 192 : IF(IDIM.EQ.3)THEN 193 : UZR.AM(NLCE,1,1)=GZ 194 : RETUZ.AM(NLCE,1,1)=GZ 195 : ENDIF 196 : ENDDO 197 : C 198 : SEGDES MPOVA3 199 : IF(IDIM .EQ. 2)THEN 200 : SEGDES UXR, UYR, RETUX, RETUY 201 : ELSEIF(IDIM.EQ.3)THEN 202 : SEGDES UXR, UYR, UZR, RETUX, RETUY, RETUZ 203 : ENDIF 204 : RETURN 205 : END 206 : 207 : 208 : 209 : 210 : 211 : 212 : 213 : 214 : 215 :
© Cast3M 2003 - All rights reserved.
Disclaimer