1 : C CLI252 SOURCE MAGN 09/07/30 21:16:10 6458 2 : SUBROUTINE CLI252(NSP,MELEMF,MELEMC,MELECB,MELEFC,MELRES,INORM, 3 : & ICHPVO,ICHPSU,LRECP,LRECV, 4 : & IROC,IVITC,IPC,IYC,ICHLIM,ILIINC,ILIINP,IJAC,IJACO) 5 : C************************************************************************ 6 : C 7 : C PROJET : CASTEM 2000 8 : C 9 : C NOM : CLI252 10 : C 11 : C DESCRIPTION : Subroutine appellée par CLIM22 12 : C Jacobian for 'OUTP ' 13 : C 14 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI) 15 : C 16 : C AUTEUR : S. Kudriakov, DEN/DM2S/SFME/LTMF 17 : C 18 : C************************************************************************ 19 : C 20 : C APPELES (Calcul) : 21 : C 22 : C************************************************************************ 23 : C 24 : C HISTORIQUE (Anomalies et modifications éventuelles) 25 : C 26 : C HISTORIQUE : 27 : C 28 : C************************************************************************ 29 : C 30 : C---------------------------------------------------- 31 : C**** Variables de COOPTIO 32 : C---------------------------------------------------- 33 : C INTEGER IPLLB, IERPER, IERMAX, IERR, INTERR 34 : C & ,IOTER, IOLEC, IOIMP, IOCAR, IOACQ 35 : C & ,IOPER, IOSGB, IOGRA, IOSAU, IORES 36 : C & ,IECHO, IIMPI, IOSPI 37 : C & ,IDIM, IFICLE, IPREFI 38 : C & ,MCOORD 39 : C & ,IFOMOD, NIFOUR, IFOUR, NSDPGE, IONIVE 40 : C & ,NGMAXY, IZROSF, ISOTYP, IOSCR,LTEXLU 41 : C & ,NORINC,NORVAL,NORIND,NORVAD 42 : C & ,NUCROU, IPSAUV 43 : C 44 : IMPLICIT INTEGER(I-N) 45 : INTEGER MELEMF,MELEMC,MELECB,INORM,ICHPVO,ICHPSU, IROC,IVITC,IPC 46 : & ,IGAMC,ICHLIM,ICEL,NFAC,IFAC,MELRES,IJACO 47 : & ,NGF,NGC,NLF,NLC,NLCB 48 : & ,ILIINC,ILIINP,IJAC,II,JJ 49 : & ,MP, NBEL, NBME, NBSOUS, NKID, NKMT, NMATRI, NP, NRIGE 50 : & ,NSP,I, IYC,J, LRECP,LRECV,KV 51 : REAL*8 VOLU,SURF,RC,PC,UXC,UYC,CNX,CNY,CTX,CTY 52 : & ,PF,COEF 53 : REAL*8 WVEC_L(4), WVEC_R(4), NVECT(2), TVECT(2) 54 : CHARACTER*(8) TYPE 55 : -INC CCOPTIO 56 : -INC SMLMOTS 57 : -INC SMELEME 58 : POINTEUR MELEFC.MELEME 59 : -INC SMLENTI 60 : POINTEUR MLEMC.MLENTI, MLEMCB.MLENTI,MLEMF.MLENTI 61 : -INC SMCHPOI 62 : POINTEUR MPNORM.MPOVAL, MPVOL.MPOVAL, MPSURF.MPOVAL, MPRC.MPOVAL, 63 : & MPVC.MPOVAL, MPPC.MPOVAL, MPLIM.MPOVAL, MPYC.MPOVAL 64 : -INC SMMATRIK 65 : POINTEUR CELL.IZAFM 66 : C------------------------------------------------------- 67 : -INC SMLREEL 68 : POINTEUR MLRECP.MLREEL, MLRECV.MLREEL 69 : C------------------------------------------------------- 70 : C********* Les Jacobians ****************************** 71 : C------------------------------------------------------- 72 : SEGMENT JACEL 73 : REAL*8 JAC(3+NSP,3+NSP) 74 : ENDSEGMENT 75 : POINTEUR JLL.JACEL,JPL.JACEL,JTL.JACEL,JTT.JACEL 76 : C------------------------------------------------------------- 77 : C******* Les fractionines massiques ************************** 78 : C------------------------------------------------------------- 79 : SEGMENT FRAMAS 80 : REAL*8 YET(NSP) 81 : ENDSEGMENT 82 : POINTEUR YC.FRAMAS 83 : C------------------------------------------------------- 84 : C********** Les CP's and CV's *********************** 85 : C------------------------------------------------------- 86 : SEGMENT GCONST 87 : REAL*8 GC(NSP) 88 : ENDSEGMENT 89 : POINTEUR CP.GCONST, CV.GCONST 90 : C---------------------------------------------------- 91 : C**** KRIPAD pour la correspondance global/local 92 : C---------------------------------------------------- 92 : CALL KRIPAD(MELEMC,MLEMC) 92 : CALL KRIPAD(MELECB,MLEMCB) 92 : CALL KRIPAD(MELEMF,MLEMF) 93 : C---------------------------------------------------- 94 : C**** CHPOINTs de la table DOMAINE 95 : C---------------------------------------------------- 95 : CALL LICHT(INORM,MPNORM,TYPE,ICEL) 95 : CALL LICHT(ICHPVO,MPVOL,TYPE,ICEL) 95 : CALL LICHT(ICHPSU,MPSURF,TYPE,ICEL) 96 : C---------------------------------------------------- 97 : C**** CHPOINTs des variables 98 : C---------------------------------------------------- 98 : CALL LICHT(IROC,MPRC,TYPE,ICEL) 98 : CALL LICHT(IVITC,MPVC,TYPE,ICEL) 98 : CALL LICHT(IPC,MPPC,TYPE,ICEL) 98 : CALL LICHT(IYC,MPYC,TYPE,ICEL) 98 : CALL LICHT(ICHLIM,MPLIM,TYPE,ICEL) 99 : C-------------------------------------------------------- 100 : C**** Boucle sur le face pour le calcul des invariants de 101 : C Riemann et du flux 102 : C-------------------------------------------------------- 103 : SEGACT MELEFC 104 : NFAC=MELEFC.NUM(/2) 105 : C--------------------------------- 106 : C**** Objet MATRIK 107 : C--------------------------------- 108 : NRIGE = 7 109 : NMATRI = 1 110 : NKID = 9 111 : NKMT = 7 112 : C--------------------------------- 113 : SEGINI MATRIK 114 : IJACO = MATRIK 115 : MATRIK.IRIGEL(1,1) = MELRES 116 : MATRIK.IRIGEL(2,1) = MELRES 117 : C--------------------------------- 118 : C**** Matrice non symetrique 119 : C--------------------------------- 120 : MATRIK.IRIGEL(7,1) = 2 121 : C--------------------------------- 122 : NBME = (3+NSP)*(3+NSP) 123 : NBSOUS = 1 124 : SEGINI IMATRI 125 : IF(IJAC.EQ.1)THEN 126 : MLMOTS=ILIINC 127 : ELSEIF(IJAC.EQ.2)THEN 128 : MLMOTS=ILIINP 129 : ENDIF 130 : SEGACT MLMOTS 131 : MATRIK.IRIGEL(4,1) = IMATRI 132 : C------------------------------------------- 133 : DO 1 J=1,(NSP+3) 134 : KV=(J-1)*(3+NSP) 135 : IMATRI.LISPRI(KV+1) = MLMOTS.MOTS(1) 136 : IMATRI.LISPRI(KV+2) = MLMOTS.MOTS(2) 137 : IMATRI.LISPRI(KV+3) = MLMOTS.MOTS(3) 138 : IMATRI.LISPRI(KV+4) = MLMOTS.MOTS(4) 139 : DO 2 I=1,(NSP-1) 140 : IMATRI.LISPRI(KV+4+I) = MLMOTS.MOTS(4+I) 141 : 2 CONTINUE 142 : 1 CONTINUE 143 : C----------------------------------------------- 144 : SEGDES MLMOTS 145 : MLMOTS=ILIINC 146 : SEGACT MLMOTS 147 : C----------------------------------------------- 148 : DO 3 J=1,(NSP+3) 149 : KV=(J-1)*(3+NSP) 150 : IMATRI.LISDUA(KV+1) = MLMOTS.MOTS(j) 151 : IMATRI.LISDUA(KV+2) = MLMOTS.MOTS(j) 152 : IMATRI.LISDUA(KV+3) = MLMOTS.MOTS(j) 153 : IMATRI.LISDUA(KV+4) = MLMOTS.MOTS(j) 154 : DO 4 I=1,(NSP-1) 155 : IMATRI.LISDUA(KV+4+I) = MLMOTS.MOTS(j) 156 : 4 CONTINUE 157 : 3 CONTINUE 158 : C----------------------------------------------- 159 : C----------------------------------------------- 160 : SEGDES MLMOTS 161 : NBEL = NFAC 162 : NBSOUS = 1 163 : NP = 1 164 : MP = 1 165 : C----------------------------------------------------------- 166 : C----------------------------------------------------------- 167 : DO 5 I=1,NBME 168 : SEGINI CELL 169 : IMATRI.LIZAFM(1,I) = CELL 170 : 5 CONTINUE 171 : C--------------------------------- 172 : C**** Fin definition MATRIK 173 : C--------------------------------- 174 : DO IFAC=1,NFAC,1 175 : NGF=MELEFC.NUM(1,IFAC) 176 : NGC=MELEFC.NUM(2,IFAC) 177 : NLF=MLEMF.LECT(NGF) 178 : NLC=MLEMC.LECT(NGC) 179 : NLCB=MLEMCB.LECT(NGF) 180 : VOLU=MPVOL.VPOCHA(NLC,1) 181 : SURF=MPSURF.VPOCHA(NLF,1) 182 : C In CASTEM les normales sont sortantes 183 : CNX=MPNORM.VPOCHA(NLF,1) 184 : CNY=MPNORM.VPOCHA(NLF,2) 185 : CTX=-1.0D0*CNY 186 : CTY=CNX 187 : C---------------------------------------------- 188 : SEGINI CP, CV 189 : MLRECP = LRECP 190 : MLRECV = LRECV 191 : SEGACT MLRECP, MLRECV 192 : DO 10 I=1,(NSP-1) 193 : CP.GC(I)=MLRECP.PROG(I) 194 : CV.GC(I)=MLRECV.PROG(I) 195 : 10 CONTINUE 196 : CP.GC(NSP)=MLRECP.PROG(NSP) 197 : CV.GC(NSP)=MLRECV.PROG(NSP) 198 : C--------------------------------- 199 : C Variables au centre 200 : C--------------------------------- 201 : RC=MPRC.VPOCHA(NLC,1) 202 : PC=MPPC.VPOCHA(NLC,1) 203 : UXC=MPVC.VPOCHA(NLC,1) 204 : UYC=MPVC.VPOCHA(NLC,2) 205 : SEGINI YC 206 : SEGACT MPYC 207 : DO 100 I=1,(NSP-1) 208 : YC.YET(I)=MPYC.VPOCHA(NLC,I) 209 : 100 CONTINUE 210 : C--------------------------------- 211 : C Variables à la face 212 : C--------------------------------- 213 : PF=MPLIM.VPOCHA(NLCB,1) 214 : C------------------------------ 215 : C******* Derivatives 216 : C------------------------------ 217 : wvec_l(1)=RC 218 : wvec_l(2)=UXC 219 : wvec_l(3)=UYC 220 : wvec_l(4)=PC 221 : C-------------------------- 222 : wvec_r(1)=RC 223 : wvec_r(2)=UXC 224 : wvec_r(3)=UYC 225 : wvec_r(4)=PF 226 : C-------------------------- 227 : nvect(1)=CNX 228 : nvect(2)=CNY 229 : tvect(1)=CTX 230 : tvect(2)=CTY 230 : call copmsp(nsp,jpl,jll,wvec_l,wvec_r,nvect,tvect, 231 : & mpyc,lrecp,lrecv,nlc,nlc) 232 : C----------------------------------------------- 233 : COEF=-SURF/VOLU 234 : C---------------------------------------- 235 : JTT=JLL 236 : JTL=JPL 237 : SEGACT JTT 238 : SEGACT JTL 239 : C---------------------------------------- 240 : C---------------------------------------------------------------- 241 : C******* Jacobian with respect to conservative variables 242 : C---------------------------------------------------------------- 243 : IF(IJAC.EQ.1)THEN 244 : DO 9 II = 1,(3+NSP) 245 : DO 15 JJ = 1,(3+NSP) 246 : KV = (II-1)*(3+NSP) 247 : C---------------------------------- 248 : CELL = IMATRI.LIZAFM(1,KV+JJ) 249 : CELL.AM(IFAC,1,1) = JTT.JAC(II,JJ)*COEF 250 : 15 CONTINUE 251 : 9 CONTINUE 252 : ELSEIF(IJAC.EQ.2)THEN 253 : DO 20 II = 1,(3+NSP) 254 : DO 25 JJ = 1,(3+NSP) 255 : KV = (II-1)*(3+NSP) 256 : C---------------------------------- 257 : CELL = IMATRI.LIZAFM(1,KV+JJ) 258 : CELL.AM(IFAC,1,1) = JTL.JAC(II,JJ)*COEF 259 : 25 CONTINUE 260 : 20 CONTINUE 261 : ENDIF 262 : c-------------------------------------------------- 263 : ENDDO 264 : C 265 : SEGDES MELEFC 266 : C 267 : SEGSUP MLEMC 268 : SEGSUP MLEMCB 269 : SEGSUP MLEMF 270 : C 271 : SEGDES MPNORM 272 : SEGDES MPVOL 273 : SEGDES MPSURF 274 : SEGDES MPRC 275 : SEGDES MPPC 276 : SEGDES MPVC 277 : SEGDES MPYC 278 : SEGDES MPLIM 279 : SEGDES YC 280 : c SEGDES YF 281 : SEGDES CP 282 : SEGDES CV 283 : SEGDES JTL 284 : SEGDES JTT 285 : c SEGDES WL 286 : c SEGDES DYDG1, DFRYG1, 287 : c & DG1DY, DGDYC 288 : SEGDES MATRIK 289 : DO 80 II=1,NBME 290 : CELL = IMATRI.LIZAFM(1,II) 291 : SEGDES CELL 292 : 80 CONTINUE 293 : SEGDES IMATRI 294 : C--------------------------------------------- 295 : 9999 CONTINUE 296 : RETURN 297 : END 298 : 299 : 300 : 301 : 302 : 303 : 304 : 305 : 306 : 307 :
© Cast3M 2003 - All rights reserved.
Disclaimer