Changeset 940 for codes/icosagcm/devel/src/kernels_unst/coriolis.k90
- Timestamp:
- 07/05/19 15:13:09 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
codes/icosagcm/devel/src/kernels_unst/coriolis.k90
r683 r940 176 176 !$OMP END DO 177 177 ! 178 !$OMP DO SCHEDULE(STATIC) 179 DO edge = 1, edge_num 180 ! this VLOOP iterates over the TRISK stencil 181 SELECT CASE(trisk_deg(edge)) 182 CASE(4) 183 !DIR$ SIMD 184 DO l = 1, llm 185 du_trisk=0. 186 itrisk = 1 187 edge_trisk = trisk(1,edge) 188 du_trisk = du_trisk + wee(itrisk,edge)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk)) 189 itrisk = 2 190 edge_trisk = trisk(2,edge) 191 du_trisk = du_trisk + wee(itrisk,edge)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk)) 192 itrisk = 3 193 edge_trisk = trisk(3,edge) 194 du_trisk = du_trisk + wee(itrisk,edge)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk)) 195 itrisk = 4 196 edge_trisk = trisk(4,edge) 197 du_trisk = du_trisk + wee(itrisk,edge)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk)) 198 du(l,edge) = du(l,edge) + .5*du_trisk 199 END DO 200 CASE(10) 201 !DIR$ SIMD 202 DO l = 1, llm 203 du_trisk=0. 204 itrisk = 1 205 edge_trisk = trisk(1,edge) 206 du_trisk = du_trisk + wee(itrisk,edge)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk)) 207 itrisk = 2 208 edge_trisk = trisk(2,edge) 209 du_trisk = du_trisk + wee(itrisk,edge)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk)) 210 itrisk = 3 211 edge_trisk = trisk(3,edge) 212 du_trisk = du_trisk + wee(itrisk,edge)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk)) 213 itrisk = 4 214 edge_trisk = trisk(4,edge) 215 du_trisk = du_trisk + wee(itrisk,edge)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk)) 216 itrisk = 5 217 edge_trisk = trisk(5,edge) 218 du_trisk = du_trisk + wee(itrisk,edge)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk)) 219 itrisk = 6 220 edge_trisk = trisk(6,edge) 221 du_trisk = du_trisk + wee(itrisk,edge)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk)) 222 itrisk = 7 223 edge_trisk = trisk(7,edge) 224 du_trisk = du_trisk + wee(itrisk,edge)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk)) 225 itrisk = 8 226 edge_trisk = trisk(8,edge) 227 du_trisk = du_trisk + wee(itrisk,edge)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk)) 228 itrisk = 9 229 edge_trisk = trisk(9,edge) 230 du_trisk = du_trisk + wee(itrisk,edge)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk)) 231 itrisk = 10 232 edge_trisk = trisk(10,edge) 233 du_trisk = du_trisk + wee(itrisk,edge)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk)) 234 du(l,edge) = du(l,edge) + .5*du_trisk 235 END DO 236 CASE DEFAULT 237 !DIR$ SIMD 238 DO l = 1, llm 239 du_trisk=0. 240 DO itrisk = 1, trisk_deg(edge) 241 edge_trisk = trisk(itrisk,edge) 242 du_trisk = du_trisk + wee(itrisk,edge)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk)) 243 END DO 244 du(l,edge) = du(l,edge) + .5*du_trisk 245 END DO 246 END SELECT 247 END DO 248 !$OMP END DO 178 SELECT CASE(caldyn_conserv) 179 CASE(conserv_energy) ! energy-conserving TRiSK 180 !$OMP DO SCHEDULE(STATIC) 181 DO edge = 1, edge_num 182 ! this VLOOP iterates over the TRISK stencil 183 SELECT CASE(trisk_deg(edge)) 184 CASE(4) 185 !DIR$ SIMD 186 DO l = 1, llm 187 du_trisk=0. 188 itrisk = 1 189 edge_trisk = trisk(1,edge) 190 du_trisk = du_trisk + wee(itrisk,edge,1)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk)) 191 itrisk = 2 192 edge_trisk = trisk(2,edge) 193 du_trisk = du_trisk + wee(itrisk,edge,1)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk)) 194 itrisk = 3 195 edge_trisk = trisk(3,edge) 196 du_trisk = du_trisk + wee(itrisk,edge,1)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk)) 197 itrisk = 4 198 edge_trisk = trisk(4,edge) 199 du_trisk = du_trisk + wee(itrisk,edge,1)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk)) 200 du(l,edge) = du(l,edge) + .5*du_trisk 201 END DO 202 CASE(10) 203 !DIR$ SIMD 204 DO l = 1, llm 205 du_trisk=0. 206 itrisk = 1 207 edge_trisk = trisk(1,edge) 208 du_trisk = du_trisk + wee(itrisk,edge,1)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk)) 209 itrisk = 2 210 edge_trisk = trisk(2,edge) 211 du_trisk = du_trisk + wee(itrisk,edge,1)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk)) 212 itrisk = 3 213 edge_trisk = trisk(3,edge) 214 du_trisk = du_trisk + wee(itrisk,edge,1)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk)) 215 itrisk = 4 216 edge_trisk = trisk(4,edge) 217 du_trisk = du_trisk + wee(itrisk,edge,1)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk)) 218 itrisk = 5 219 edge_trisk = trisk(5,edge) 220 du_trisk = du_trisk + wee(itrisk,edge,1)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk)) 221 itrisk = 6 222 edge_trisk = trisk(6,edge) 223 du_trisk = du_trisk + wee(itrisk,edge,1)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk)) 224 itrisk = 7 225 edge_trisk = trisk(7,edge) 226 du_trisk = du_trisk + wee(itrisk,edge,1)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk)) 227 itrisk = 8 228 edge_trisk = trisk(8,edge) 229 du_trisk = du_trisk + wee(itrisk,edge,1)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk)) 230 itrisk = 9 231 edge_trisk = trisk(9,edge) 232 du_trisk = du_trisk + wee(itrisk,edge,1)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk)) 233 itrisk = 10 234 edge_trisk = trisk(10,edge) 235 du_trisk = du_trisk + wee(itrisk,edge,1)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk)) 236 du(l,edge) = du(l,edge) + .5*du_trisk 237 END DO 238 CASE DEFAULT 239 !DIR$ SIMD 240 DO l = 1, llm 241 du_trisk=0. 242 DO itrisk = 1, trisk_deg(edge) 243 edge_trisk = trisk(itrisk,edge) 244 du_trisk = du_trisk + wee(itrisk,edge,1)*hflux(l,edge_trisk)*(qu(l,edge)+qu(l,edge_trisk)) 245 END DO 246 du(l,edge) = du(l,edge) + .5*du_trisk 247 END DO 248 END SELECT 249 END DO 250 !$OMP END DO 251 CASE(conserv_enstrophy) ! enstrophy-conserving TRiSK 252 !$OMP DO SCHEDULE(STATIC) 253 DO edge = 1, edge_num 254 ! this VLOOP iterates over the TRISK stencil 255 SELECT CASE(trisk_deg(edge)) 256 CASE(4) 257 !DIR$ SIMD 258 DO l = 1, llm 259 du_trisk=0. 260 itrisk = 1 261 edge_trisk = trisk(1,edge) 262 du_trisk = du_trisk + wee(itrisk,edge,1)*hflux(l,edge_trisk) 263 itrisk = 2 264 edge_trisk = trisk(2,edge) 265 du_trisk = du_trisk + wee(itrisk,edge,1)*hflux(l,edge_trisk) 266 itrisk = 3 267 edge_trisk = trisk(3,edge) 268 du_trisk = du_trisk + wee(itrisk,edge,1)*hflux(l,edge_trisk) 269 itrisk = 4 270 edge_trisk = trisk(4,edge) 271 du_trisk = du_trisk + wee(itrisk,edge,1)*hflux(l,edge_trisk) 272 du(l,edge) = du(l,edge) + du_trisk*qu(l,edge) 273 END DO 274 CASE(10) 275 !DIR$ SIMD 276 DO l = 1, llm 277 du_trisk=0. 278 itrisk = 1 279 edge_trisk = trisk(1,edge) 280 du_trisk = du_trisk + wee(itrisk,edge,1)*hflux(l,edge_trisk) 281 itrisk = 2 282 edge_trisk = trisk(2,edge) 283 du_trisk = du_trisk + wee(itrisk,edge,1)*hflux(l,edge_trisk) 284 itrisk = 3 285 edge_trisk = trisk(3,edge) 286 du_trisk = du_trisk + wee(itrisk,edge,1)*hflux(l,edge_trisk) 287 itrisk = 4 288 edge_trisk = trisk(4,edge) 289 du_trisk = du_trisk + wee(itrisk,edge,1)*hflux(l,edge_trisk) 290 itrisk = 5 291 edge_trisk = trisk(5,edge) 292 du_trisk = du_trisk + wee(itrisk,edge,1)*hflux(l,edge_trisk) 293 itrisk = 6 294 edge_trisk = trisk(6,edge) 295 du_trisk = du_trisk + wee(itrisk,edge,1)*hflux(l,edge_trisk) 296 itrisk = 7 297 edge_trisk = trisk(7,edge) 298 du_trisk = du_trisk + wee(itrisk,edge,1)*hflux(l,edge_trisk) 299 itrisk = 8 300 edge_trisk = trisk(8,edge) 301 du_trisk = du_trisk + wee(itrisk,edge,1)*hflux(l,edge_trisk) 302 itrisk = 9 303 edge_trisk = trisk(9,edge) 304 du_trisk = du_trisk + wee(itrisk,edge,1)*hflux(l,edge_trisk) 305 itrisk = 10 306 edge_trisk = trisk(10,edge) 307 du_trisk = du_trisk + wee(itrisk,edge,1)*hflux(l,edge_trisk) 308 du(l,edge) = du(l,edge) + du_trisk*qu(l,edge) 309 END DO 310 CASE DEFAULT 311 !DIR$ SIMD 312 DO l = 1, llm 313 du_trisk=0. 314 DO itrisk = 1, trisk_deg(edge) 315 edge_trisk = trisk(itrisk,edge) 316 du_trisk = du_trisk + wee(itrisk,edge,1)*hflux(l,edge_trisk) 317 END DO 318 du(l,edge) = du(l,edge) + du_trisk*qu(l,edge) 319 END DO 320 END SELECT 321 END DO 322 !$OMP END DO 323 END SELECT 249 324 !---------------------------- coriolis ---------------------------------- 250 325 !--------------------------------------------------------------------------
Note: See TracChangeset
for help on using the changeset viewer.