1 : C RDEMUP SOURCE BECC 11/01/05 21:15:21 6836 2 : SUBROUTINE RDEMUP(IDIM, NPAR, 3 : & SCON1, SG1, SD1, 4 : & SCON2, SG2, SD2, 5 : & SURF,VOLG,VOLD, 6 : & CNX,CNY,CNZ,CTX,CTY,CTZ,CT1X,CT1Y,CT1Z, 7 : & FLU,FLULAG,RESG,RESD) 8 : C************************************************************************ 9 : C 10 : C PROJET : CASTEM 2000 11 : C 12 : C NOM : RDEMUP 13 : C 14 : C DESCRIPTION : Voir KODFL1 15 : C Update of the residual in RDEM 16 : C Cas deux/trois dimensions 17 : C 18 : C LANGAGE : FORTRAN 77 + ESOPE 2000 (avec estensions CISI) 19 : C 20 : C AUTEUR : A. BECCANTINI, DEN/DM2S/SFME/LTMF 21 : C 22 : C************************************************************************ 23 : C 24 : C HISTORIQUE (Anomalies et modifications éventuelles) 25 : C 26 : C Crée le 11.06.2010 27 : C Estension au 3D le 21.12.2010 28 : C 29 : * 30 : * --- variables globales 31 : * 32 : IMPLICIT INTEGER(I-N) 33 : INTEGER IDIM, NPAR, ICOMP 34 : REAL*8 SCON1, SG1, SD1, 35 : & SCON2, SG2, SD2, 36 : & SURF, VOLG, VOLD, CNX,CNY,CNZ, 37 : & CTX, CTY, CTZ, CT1X, CT1Y, CT1Z, 38 : & FLU(*),FLULAG(*), RESG(*),RESD(*), 39 : & FG(3),FD(3) 40 : C 41 : C 42 : C do icomp = 1, (idim + 3) 43 : C write(*,*) icomp, flu(icomp), flulag(icomp) 44 : C enddo 45 : C 46 : C PHASE 1 47 : C 48 : C alpha1 49 : C 50 : FD(1) = -1.0D0 * FLULAG(IDIM + 3) * SD1 51 : FG(1) = FLULAG(IDIM + 3) * SG1 52 : RESD(1) = (FD(1) * SURF / VOLD) 53 : RESG(1) = -1.0D0 * (FG(1) * SURF / VOLG) 54 : C 55 : C rho1 alpha1 56 : C 57 : FG(1) = FLU(1) * SCON1 + FLULAG(1) * SG1 58 : FD(1) = FLU(1) * SCON1 - FLULAG(1) * SD1 59 : RESG(2) = -1.D0 * (FG(1) * SURF / VOLG) 60 : RESD(2) = (FD(1) * SURF / VOLD) 61 : C 62 : C rho1 alpha1 ux1, uy1, uz1 63 : C 64 : FD(1) = (FLU(2) * CNX) * 65 : & SCON1 - 66 : & (FLULAG(2) * CNX) 67 : $ * SD1 68 : FG(1) = (FLU(2) * CNX) * 69 : & SCON1 + 70 : & (FLULAG(2) * CNX) 71 : $ * SG1 72 : IF (IDIM .GE. 2) THEN 73 : FD(1) = FD(1) + 74 : & ((FLU(3) * CTX) * 75 : & SCON1 - 76 : & (FLULAG(3) * CTX) 77 : $ * SD1) 78 : FG(1) = FG(1) + 79 : & ((FLU(3) * CTX) * 80 : & SCON1 + 81 : & (FLULAG(3) * CTX) 82 : $ * SG1) 83 : FD(2) = (FLU(2) * CNY + FLU(3) * CTY) 84 : & * SCON1 - 85 : & (FLULAG(2) * CNY + FLULAG(3) * CTY) 86 : & * SD1 87 : FG(2) = (FLU(2) * CNY + FLU(3) * CTY) 88 : & * SCON1 + 89 : & (FLULAG(2) * CNY + FLULAG(3) * CTY) 90 : & * SG1 91 : ENDIF 92 : IF (IDIM .EQ. 3) THEN 93 : FD(1) = FD(1) + 94 : & ((FLU(4) * CT1X) * 95 : & SCON1 - 96 : & (FLULAG(4) * CT1X) 97 : $ * SD1) 98 : FG(1) = FG(1) + 99 : & ((FLU(4) * CT1X) * 100 : & SCON1 + 101 : & (FLULAG(4) * CT1X) 102 : $ * SG1) 103 : FD(2) = FD(2) + 104 : & ((FLU(4) * CT1Y) 105 : & * SCON1 - 106 : & (FLULAG(4) * CT1Y) 107 : & * SD1) 108 : FG(2) = FG(2) + 109 : & ((FLU(4)* CT1Y) 110 : & * SCON1 + 111 : & (FLULAG(4) * CT1Y) 112 : & * SG1) 113 : FD(3) = (FLU(2) * CNZ + FLU(3) * CTZ + FLU(4) * CT1Z) 114 : & * SCON1 - 115 : & (FLULAG(2) * CNZ + FLULAG(3) * CTZ + FLULAG(4) * CT1Z) 116 : & * SD1 117 : FG(3) = (FLU(2) * CNZ + FLU(3) * CTZ + FLU(4) * CT1Z) 118 : & * SCON1 + 119 : & (FLULAG(2) * CNZ + FLULAG(3) * CTZ + FLULAG(4) * CT1Z) 120 : & * SG1 121 : ENDIF 122 : C 123 : C write(*,*) 'Flux on momentum, 1' 124 : C write(*,*) fg(1), fd(1) 125 : C write(*,*) fg(2), fd(2) 126 : C if (idim .eq. 3) write(*,*) fg(3), fd(3) 127 : C 128 : DO ICOMP = 1, IDIM, 1 129 : RESG(2 + ICOMP) = -1.D0 * (FG(ICOMP) * SURF / VOLG) 130 : RESD(2 + ICOMP) = (FD(ICOMP) * SURF / VOLD) 131 : ENDDO 132 : C 133 : C rho1 alpha1 et1 134 : C 135 : FG(1) = FLU(2 + IDIM) * SCON1 + FLULAG(2 + IDIM) * SG1 136 : FD(1) = FLU(2 + IDIM) * SCON1 - FLULAG(2 + IDIM) * SD1 137 : RESG(3 + IDIM) = -1.0D0 * (FG(1) * SURF / VOLG) 138 : RESD(3 + IDIM) = (FD(1) * SURF / VOLD) 139 : C 140 : DO ICOMP = 4 + IDIM, 3 + IDIM + NPAR, 1 141 : FG(1) = FLU(ICOMP) * SCON1 + FLULAG(ICOMP) * SG1 142 : FD(1) = FLU(ICOMP) * SCON1 - FLULAG(ICOMP) * SD1 143 : RESG(ICOMP) = -1.0D0 * (FG(1) * SURF / VOLG) 144 : RESD(ICOMP) = (FD(1) * SURF / VOLD) 145 : ENDDO 146 : C 147 : C 148 : C PHASE 2. 149 : C 150 : C alpha2 151 : C 152 : FG(1) = FLULAG(IDIM + 3) * SG2 153 : FD(1) = -1.0D0 * FLULAG(IDIM + 3) * SD2 154 : RESD(4 + IDIM + NPAR) = (FD(1) * SURF / VOLD) 155 : RESG(4 + IDIM + NPAR) = -1.0D0 * (FG(1) * SURF / VOLG) 156 : C 157 : C alpha2 rho2 158 : C 159 : FG(1) = FLU(1) * SCON2 + FLULAG(1) * SG2 160 : FD(1) = FLU(1) * SCON2 - FLULAG(1) * SD2 161 : RESD(5 + IDIM + NPAR) = (FD(1) * SURF / VOLD) 162 : RESG(5 + IDIM + NPAR) = -1.0D0 * (FG(1) * SURF / VOLG) 163 : C 164 : C alpha2 rho2 ux uy uz 165 : C 166 : FD(1) = (FLU(2) * CNX) * 167 : & SCON2 - 168 : & (FLULAG(2) * CNX) 169 : $ * SD2 170 : FG(1) = (FLU(2) * CNX) * 171 : & SCON2 + 172 : & (FLULAG(2) * CNX) 173 : $ * SG2 174 : IF (IDIM .GE. 2) THEN 175 : FD(1) = FD(1) + 176 : & ((FLU(3) * CTX) * 177 : & SCON2 - 178 : & (FLULAG(3) * CTX) 179 : $ * SD2) 180 : FG(1) = FG(1) + 181 : & ((FLU(3) * CTX) * 182 : & SCON2 + 183 : & (FLULAG(3) * CTX) 184 : $ * SG2) 185 : FG(2) = (FLU(2) * CNY + FLU(3) * CTY) 186 : & * SCON2 + 187 : & (FLULAG(2) * CNY + FLULAG(3) * CTY) 188 : & * SG2 189 : FD(2) = (FLU(2) * CNY + FLU(3) * CTY) 190 : & * SCON2 - 191 : & (FLULAG(2) * CNY + FLULAG(3) * CTY) 192 : & * SD2 193 : ENDIF 194 : IF (IDIM .EQ. 3) THEN 195 : FD(1) = FD(1) + 196 : & ((FLU(4) * CT1X) * 197 : & SCON2 - 198 : & (FLULAG(4) * CT1X) 199 : $ * SD2) 200 : FG(1) = FG(1) + 201 : & ((FLU(4) * CT1X) * 202 : & SCON2 + 203 : & (FLULAG(4) * CT1X) 204 : $ * SG2) 205 : FG(2) = FG(2) + 206 : & ((FLU(4) * CT1Y) 207 : & * SCON2 + 208 : & (FLULAG(4) * CT1Y) 209 : & * SG2) 210 : FD(2) = FD(2) + 211 : & ((FLU(4) * CT1Y) 212 : & * SCON2 - 213 : & (FLULAG(4) * CT1Y) 214 : & * SD2) 215 : FG(3) = (FLU(2) * CNZ + FLU(3) * CTZ + FLU(4) * CT1Z) 216 : & * SCON2 + 217 : & (FLULAG(2) * CNZ + FLULAG(3) * CTZ + FLULAG(4) * CT1Z) 218 : & * SG2 219 : FD(3) = (FLU(2) * CNZ + FLU(3) * CTZ + FLU(4) * CT1Z) 220 : & * SCON2 - 221 : & (FLULAG(2) * CNZ + FLULAG(3) * CTZ + FLULAG(4) * CT1Z) 222 : & * SD2 223 : ENDIF 224 : C 225 : C write(*,*) 'Flux on momentum, 2' 226 : C write(*,*) fg(1), fd(1) 227 : C write(*,*) fg(2), fd(2) 228 : C if (idim .eq. 3) write(*,*) fg(3), fd(3) 229 : C 230 : DO ICOMP = 1, IDIM, 1 231 : RESD(5 + IDIM + NPAR + ICOMP) = (FD(ICOMP) * SURF / VOLD) 232 : RESG(5 + IDIM + NPAR + ICOMP) = -1.0D0 * (FG(ICOMP) * SURF / 233 : $ VOLG) 234 : ENDDO 235 : C 236 : C rho2 alpha2 et2 237 : C 238 : FG(1) = FLU(2 + IDIM) * SCON2 + FLULAG(2 + IDIM) * SG2 239 : FD(1) = FLU(2 + IDIM) * SCON2 - FLULAG(2 + IDIM) * SD2 240 : RESD(6 + (2 * IDIM) + NPAR) = (FD(1) * SURF / VOLD) 241 : RESG(6 + (2 * IDIM) + NPAR) = -1.0D0 * (FG(1) * SURF / VOLG) 242 : C 243 : DO ICOMP = 4 + IDIM, 3 + IDIM + NPAR, 1 244 : FG(1) = FLU(ICOMP) * SCON2 + FLULAG(ICOMP) * SG2 245 : FD(1) = FLU(ICOMP) * SCON2 - FLULAG(ICOMP) * SD2 246 : RESD(3 + IDIM + NPAR + ICOMP) = (FD(1) * SURF / VOLD) 247 : RESG(3 + IDIM + NPAR + ICOMP) = -1.0D0 * (FG(1) * SURF / 248 : $ VOLG) 249 : ENDDO 250 : C 251 : C write(*,*) 'S' 252 : C write(*,*) SCON1, SG1, SD1, 253 : C & SCON2, SG2, SD2 254 : C DO ICOMP = 1, (3 + IDIM + NPAR), 1 255 : C write(*,*) 'icomp, resd, resg' 256 : C write(*,*) icomp, resd(icomp),resg(icomp) 257 : C ENDDO 258 : C 259 : C write(*,*) 'Conservativity check' 260 : C do icomp = 1, 3 + IDIM + NPAR 261 : C write(*,*) ((resg(icomp) + resg(3 + IDIM + NPAR + icomp)) 262 : C & * volg) + 263 : C & ((resd(icomp) + resd(3 + IDIM + NPAR + icomp)) 264 : C & * vold) 265 : C enddo 266 : RETURN 267 : END 268 : * 269 :
© Cast3M 2003 - All rights reserved.
Disclaimer