1!Crown Copyright 2012 AWE.
2!
3! This file is part of CloverLeaf.
4!
5! CloverLeaf is free software: you can redistribute it and/or modify it under
6! the terms of the GNU General Public License as published by the
7! Free Software Foundation, either version 3 of the License, or (at your option)
8! any later version.
9!
10! CloverLeaf is distributed in the hope that it will be useful, but
11! WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
12! FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
13! details.
14!
15! You should have received a copy of the GNU General Public License along with
16! CloverLeaf. If not, see http://www.gnu.org/licenses/.
17
18!>  @brief Fortran field summary kernel
19!>  @author Wayne Gaudin
20!>  @details The total mass, internal energy, kinetic energy and volume weighted
21!>  pressure for the chunk is calculated.
22
23MODULE field_summary_kernel_module
24
25CONTAINS
26
27SUBROUTINE field_summary_kernel(x_min,x_max,y_min,y_max,z_min,z_max, &
28                                volume,                  &
29                                density0,                &
30                                energy0,                 &
31                                pressure,                &
32                                xvel0,                   &
33                                yvel0,                   &
34                                zvel0,                   &
35                                vol,mass,ie,ke,press     )
36
37  IMPLICIT NONE
38
39  INTEGER      :: x_min,x_max,y_min,y_max,z_min,z_max
40  REAL(KIND=8), DIMENSION(x_min-2:x_max+2,y_min-2:y_max+2,z_min-2:z_max+2) :: volume
41  REAL(KIND=8), DIMENSION(x_min-2:x_max+2,y_min-2:y_max+2,z_min-2:z_max+2) :: density0,energy0
42  REAL(KIND=8), DIMENSION(x_min-2:x_max+2,y_min-2:y_max+2,z_min-2:z_max+2) :: pressure
43  REAL(KIND=8), DIMENSION(x_min-2:x_max+3,y_min-2:y_max+3,z_min-2:z_max+2) :: xvel0,yvel0,zvel0
44  REAL(KIND=8) :: vol,mass,ie,ke,press
45
46  INTEGER      :: j,k,l,jv,kv,lv
47  REAL(KIND=8) :: vsqrd,cell_vol,cell_mass
48
49  vol=0.0
50  mass=0.0
51  ie=0.0
52  ke=0.0
53  press=0.0
54
55!$OMP PARALLEL
56!$OMP DO PRIVATE(vsqrd,cell_vol,cell_mass,j,k,jv,kv,lv) REDUCTION(+ : vol,mass,press,ie,ke)
57  DO l=z_min,z_max
58    DO k=y_min,y_max
59      DO j=x_min,x_max
60        vsqrd=0.0
61        DO lv=l,l+1
62          DO kv=k,k+1
63            DO jv=j,j+1
64              vsqrd=vsqrd+0.125*(xvel0(jv,kv,lv)**2+yvel0(jv,kv,lv)**2+zvel0(jv,kv,lv)**2)
65            ENDDO
66          ENDDO
67        ENDDO
68        cell_vol=volume(j,k,l)
69        cell_mass=cell_vol*density0(j,k,l)
70        vol=vol+cell_vol
71        mass=mass+cell_mass
72        ie=ie+cell_mass*energy0(j,k,l)
73        ke=ke+cell_mass*0.5*vsqrd
74        press=press+cell_vol*pressure(j,k,l)
75      ENDDO
76    ENDDO
77  ENDDO
78!$OMP END DO
79!$OMP END PARALLEL
80
81END SUBROUTINE field_summary_kernel
82
83END MODULE field_summary_kernel_module
84