LCOV - code coverage report
Current view: top level - dynamics/se/dycore - element_mod.F90 (source / functions) Hit Total Coverage
Test: coverage.info Lines: 27 65 41.5 %
Date: 2025-03-13 19:04:48 Functions: 2 15 13.3 %

          Line data    Source code
       1             : module element_mod
       2             : 
       3             :   use shr_kind_mod,           only: r8=>shr_kind_r8, i8=>shr_kind_i8
       4             :   use coordinate_systems_mod, only: spherical_polar_t, cartesian2D_t, cartesian3D_t, distance
       5             :   use dimensions_mod,         only: np, nc, npsq, nlev, nlevp, qsize_d, max_neigh_edges,ntrac_d
       6             :   use edgetype_mod,           only: edgedescriptor_t
       7             :   use gridgraph_mod,          only: gridvertex_t
       8             : 
       9             :   implicit none
      10             :   private
      11             :   integer, public, parameter :: timelevels = 3
      12             : 
      13             : 
      14             : ! =========== PRIMITIVE-EQUATION DATA-STRUCTURES =====================
      15             : 
      16             :   type, public :: elem_state_t
      17             : 
      18             :     ! prognostic variables for preqx solver
      19             : 
      20             :     ! prognostics must match those in prim_restart_mod.F90
      21             :     ! vertically-lagrangian code advects dp3d instead of ps
      22             :     ! tracers Q, Qdp always use 2 level time scheme
      23             : 
      24             :     real (kind=r8) :: v     (np,np,2,nlev,timelevels)            ! velocity                           
      25             :     real (kind=r8) :: T     (np,np,nlev,timelevels)              ! temperature                        
      26             :     real (kind=r8) :: dp3d  (np,np,nlev,timelevels)              ! dry delta p on levels              
      27             :     real (kind=r8) :: psdry (np,np)                              ! dry surface pressure               
      28             :     real (kind=r8) :: phis  (np,np)                              ! surface geopotential (prescribed)
      29             :     real (kind=r8), allocatable :: Qdp(:,:,:,:,:)                ! Tracer mass
      30             :   end type elem_state_t
      31             : 
      32             :   !___________________________________________________________________
      33             :   type, public :: derived_state_t
      34             :      !
      35             :      ! storage for subcycling tracers/dynamics
      36             :      !
      37             :     real (kind=r8) :: vn0  (np,np,2,nlev)                      ! velocity for SE tracer advection
      38             :     real (kind=r8) :: dpdiss_biharmonic(np,np,nlev)            ! mean dp dissipation tendency, if nu_p>0
      39             :     real (kind=r8) :: dpdiss_ave(np,np,nlev)                   ! mean dp used to compute psdiss_tens
      40             : 
      41             :     ! diagnostics for explicit timestep
      42             :     real (kind=r8) :: phi(np,np,nlev)                          ! geopotential
      43             :     real (kind=r8) :: omega(np,np,nlev)                        ! vertical velocity
      44             : 
      45             :     ! tracer advection fields used for consistency and limiters
      46             :     real (kind=r8) :: dp(np,np,nlev)                           ! for dp_tracers at physics timestep
      47             :     real (kind=r8), allocatable :: divdp(:,:,:)                ! divergence of dp
      48             :     real (kind=r8), allocatable :: divdp_proj(:,:,:)           ! DSSed divdp
      49             :     real (kind=r8) :: mass(MAX(qsize_d,ntrac_d)+9)             ! total tracer mass for diagnostics
      50             : 
      51             :     ! forcing terms for CAM
      52             :     real (kind=r8), allocatable :: FQ(:,:,:,:)                 ! tracer forcing
      53             :     real (kind=r8) :: FM(np,np,2,nlev)                         ! momentum forcing
      54             :     real (kind=r8), allocatable :: FDP(:,:,:)                  ! save full updated dp right after physics
      55             :     real (kind=r8) :: FT(np,np,nlev)                           ! temperature forcing
      56             : 
      57             :     ! reference profiles
      58             :     real (kind=r8) :: T_ref(np,np,nlev)                        ! reference temperature
      59             :     real (kind=r8) :: dp_ref(np,np,nlev)                       ! reference pressure level thickness
      60             :   end type derived_state_t
      61             : 
      62             :   !___________________________________________________________________
      63             :   type, public :: elem_accum_t
      64             : 
      65             : 
      66             :     ! the "4" timelevels represents data computed at:
      67             :     !  1  t-.5
      68             :     !  2  t+.5   after dynamics
      69             :     !  3  t+.5   after forcing
      70             :     !  4  t+.5   after Robert
      71             :     ! after calling TimeLevelUpdate, all times above decrease by 1.0
      72             : 
      73             : 
      74             :   end type elem_accum_t
      75             : 
      76             : 
      77             : ! ============= DATA-STRUCTURES COMMON TO ALL SOLVERS ================
      78             : 
      79             :   type, public :: index_t
      80             :      integer :: ia(npsq),ja(npsq)
      81             :      integer :: is,ie
      82             :      integer :: NumUniquePts
      83             :      integer :: UniquePtOffset
      84             :   end type index_t
      85             : 
      86             :   !___________________________________________________________________
      87             :   type, public :: element_t
      88             :      integer :: LocalId
      89             :      integer :: GlobalId
      90             : 
      91             :      ! Coordinate values of element points
      92             :      type (spherical_polar_t) :: spherep(np,np)                       ! Spherical coords of GLL points
      93             : 
      94             :      ! Equ-angular gnomonic projection coordinates
      95             :      type (cartesian2D_t)     :: cartp(np,np)                         ! gnomonic coords of GLL points
      96             :      type (cartesian2D_t)     :: corners(4)                           ! gnomonic coords of element corners
      97             :      real (kind=r8)    :: u2qmap(4,2)                          ! bilinear map from ref element to quad in cubedsphere coordinates
      98             :                                                                       ! SHOULD BE REMOVED
      99             :      ! 3D cartesian coordinates
     100             :      type (cartesian3D_t)     :: corners3D(4)
     101             : 
     102             :      ! Element diagnostics
     103             :      real (kind=r8)    :: area                                 ! Area of element
     104             :      real (kind=r8)    :: normDinv                             ! some type of norm of Dinv used for CFL
     105             :      real (kind=r8)    :: dx_short                             ! short length scale in km
     106             :      real (kind=r8)    :: dx_long                              ! long length scale in km
     107             : 
     108             :      real (kind=r8)    :: variable_hyperviscosity(np,np)       ! hyperviscosity based on above
     109             :      real (kind=r8)    :: hv_courant                           ! hyperviscosity courant number
     110             :      real (kind=r8)    :: tensorVisc(np,np,2,2)                !og, matrix V for tensor viscosity
     111             : 
     112             :      ! Edge connectivity information
     113             : !     integer :: node_numbers(4)
     114             : !     integer :: node_multiplicity(4)                 ! number of elements sharing corner node
     115             : 
     116             :      type (GridVertex_t)      :: vertex                               ! element grid vertex information
     117             :      type (EdgeDescriptor_t)  :: desc
     118             : 
     119             :      type (elem_state_t)      :: state
     120             : 
     121             :      type (derived_state_t)   :: derived
     122             :      ! Metric terms
     123             :      real (kind=r8)    :: met(np,np,2,2)                       ! metric tensor on velocity and pressure grid
     124             :      real (kind=r8)    :: metinv(np,np,2,2)                    ! metric tensor on velocity and pressure grid
     125             :      real (kind=r8)    :: metdet(np,np)                        ! g = SQRT(det(g_ij)) on velocity and pressure grid
     126             :      real (kind=r8)    :: rmetdet(np,np)                       ! 1/metdet on velocity pressure grid
     127             :      real (kind=r8)    :: D(np,np,2,2)                         ! Map covariant field on cube to vector field on the sphere
     128             :      real (kind=r8)    :: Dinv(np,np,2,2)                      ! Map vector field on the sphere to covariant v on cube
     129             : 
     130             : 
     131             :      ! Mass flux across the sides of each sub-element.
     132             :      ! The storage is redundent since the mass across shared sides
     133             :      ! must be equal in magnitude and opposite in sign.
     134             :      ! The layout is like:
     135             :      !   --------------------------------------------------------------
     136             :      ! ^|    (1,4,3)     |                |              |    (4,4,3) |
     137             :      ! ||                |                |              |            |
     138             :      ! ||(1,4,4)         |                |              |(4,4,4)     |
     139             :      ! ||         (1,4,2)|                |              |     (4,4,2)|
     140             :      ! ||                |                |              |            |
     141             :      ! ||   (1,4,1)      |                |              |  (4,4,1)   |
     142             :      ! |---------------------------------------------------------------
     143             :      ! S|                |                |              |            |
     144             :      ! e|                |                |              |            |
     145             :      ! c|                |                |              |            |
     146             :      ! o|                |                |              |            |
     147             :      ! n|                |                |              |            |
     148             :      ! d|                |                |              |            |
     149             :      !  ---------------------------------------------------------------
     150             :      ! C|                |                |              |            |
     151             :      ! o|                |                |              |            |
     152             :      ! o|                |                |              |            |
     153             :      ! r|                |                |              |            |
     154             :      ! d|                |                |              |            |
     155             :      ! i|                |                |              |            |
     156             :      ! n---------------------------------------------------------------
     157             :      ! a|    (1,1,3)     |                |              |    (4,1,3) |
     158             :      ! t|                |                |              |(4,1,4)     |
     159             :      ! e|(1,1,4)         |                |              |            |
     160             :      !  |         (1,1,2)|                |              |     (4,1,2)|
     161             :      !  |                |                |              |            |
     162             :      !  |    (1,1,1)     |                |              |  (4,1,1)   |
     163             :      !  ---------------------------------------------------------------
     164             :      !          First Coordinate ------->
     165             :      real (kind=r8) :: sub_elem_mass_flux(nc,nc,4,nlev)
     166             : 
     167             :      ! Convert vector fields from spherical to rectangular components
     168             :      ! The transpose of this operation is its pseudoinverse.
     169             :      real (kind=r8)    :: vec_sphere2cart(np,np,3,2)
     170             : 
     171             :      ! Mass matrix terms for an element on a cube face
     172             :      real (kind=r8)    :: mp(np,np)                            ! mass matrix on v and p grid
     173             :      real (kind=r8)    :: rmp(np,np)                           ! inverse mass matrix on v and p grid
     174             : 
     175             :      ! Mass matrix terms for an element on the sphere
     176             :      ! This mass matrix is used when solving the equations in weak form
     177             :      ! with the natural (surface area of the sphere) inner product
     178             :      real (kind=r8)    :: spheremp(np,np)                      ! mass matrix on v and p grid
     179             :      real (kind=r8)    :: rspheremp(np,np)                     ! inverse mass matrix on v and p grid
     180             : 
     181             :      integer(i8) :: gdofP(np,np)                     ! global degree of freedom (P-grid)
     182             : 
     183             :      real (kind=r8)    :: fcor(np,np)                          ! Coreolis term
     184             : 
     185             :      type (index_t) :: idxP
     186             :      type (index_t),pointer :: idxV
     187             :      integer :: FaceNum
     188             : 
     189             :      ! force element_t to be a multiple of 8 bytes.
     190             :      ! on BGP, code will crash (signal 7, or signal 15) if 8 byte alignment is off
     191             :      ! check core file for:
     192             :      ! core.63:Generated by interrupt..(Alignment Exception DEAR=0xa1ef671c ESR=0x01800000 CCR0=0x4800a002)
     193             :      integer :: dummy
     194             :   end type element_t
     195             : 
     196             :   !___________________________________________________________________
     197             :   public :: element_coordinates
     198             :   public :: element_var_coordinates
     199             :   public :: element_var_coordinates3D
     200             :   public :: GetColumnIdP,GetColumnIdV
     201             :   public :: allocate_element_desc
     202             :   public :: PrintElem
     203             : 
     204             : contains
     205             : 
     206           0 :   subroutine PrintElem(arr)
     207             : 
     208             :     real(kind=r8) :: arr(:,:)
     209             :     integer :: i,j
     210             : 
     211           0 :       do j=np,1,-1
     212           0 :          write(6,*) (arr(i,j), i=1,np)
     213             :       enddo
     214             : 
     215           0 :   end subroutine PrintElem
     216             : ! ===================== ELEMENT_MOD METHODS ==========================
     217             : 
     218           0 :   function GetColumnIdP(elem,i,j) result(col_id)
     219             : 
     220             :     ! Get unique identifier for a Physics column on the P-grid
     221             : 
     222             :     type(element_t), intent(in) :: elem
     223             :     integer, intent(in) :: i,j
     224             :     integer :: col_id
     225           0 :     col_id = elem%gdofP(i,j)
     226           0 :   end function GetColumnIdP
     227             : 
     228             :   !___________________________________________________________________
     229           0 :   function GetColumnIdV(elem,i,j) result(col_id)
     230             : 
     231             :     !  Get unique identifier for a Physics column on the V-grid
     232             : 
     233             :     type(element_t), intent(in) :: elem
     234             :     integer, intent(in) :: i,j
     235             :     integer :: col_id
     236           0 :     col_id = elem%gdofP(i,j)
     237           0 :   end function GetColumnIdV
     238             : 
     239             :   !___________________________________________________________________
     240           0 :   function element_coordinates(start,end,points) result(cart)
     241             : 
     242             :     ! Initialize 2D rectilinear element colocation points
     243             : 
     244             :     type (cartesian2D_t), intent(in) :: start
     245             :     type (cartesian2D_t), intent(in) :: end
     246             :     real(r8),             intent(in) :: points(:)
     247             :     type (cartesian2D_t)             :: cart(SIZE(points),SIZE(points))
     248             : 
     249             :     type (cartesian2D_t) :: length, centroid
     250             :     real(r8)             :: y
     251             :     integer              :: i,j
     252             : 
     253           0 :     length%x   = 0.50D0*(end%x-start%x)
     254           0 :     length%y   = 0.50D0*(end%y-start%y)
     255           0 :     centroid%x = 0.50D0*(end%x+start%x)
     256           0 :     centroid%y = 0.50D0*(end%y+start%y)
     257           0 :     do j=1,SIZE(points)
     258           0 :        y = centroid%y + length%y*points(j)
     259           0 :        do i=1,SIZE(points)
     260           0 :           cart(i,j)%x = centroid%x + length%x*points(i)
     261           0 :           cart(i,j)%y = y
     262             :        end do
     263             :     end do
     264           0 :   end function element_coordinates
     265             : 
     266             :   !___________________________________________________________________
     267       21600 :   function element_var_coordinates(c,points) result(cart)
     268             : 
     269             :     type (cartesian2D_t), intent(in) :: c(4)
     270             :     real(r8),             intent(in) :: points(:)
     271             :     type (cartesian2D_t)             :: cart(SIZE(points),SIZE(points))
     272             : 
     273       43200 :     real(r8) :: p(size(points))
     274       43200 :     real(r8) :: q(size(points))
     275             :     integer  :: i,j
     276             : 
     277      129600 :     p(:) = (1.0D0-points(:))/2.0D0
     278      108000 :     q(:) = (1.0D0+points(:))/2.0D0
     279             : 
     280      108000 :     do j=1,SIZE(points)
     281      453600 :        do i=1,SIZE(points)
     282      691200 :           cart(i,j)%x = p(i)*p(j)*c(1)%x &
     283             :                       + q(i)*p(j)*c(2)%x &
     284             :                       + q(i)*q(j)*c(3)%x &
     285      691200 :                       + p(i)*q(j)*c(4)%x
     286             :           cart(i,j)%y = p(i)*p(j)*c(1)%y &
     287             :                       + q(i)*p(j)*c(2)%y &
     288             :                       + q(i)*q(j)*c(3)%y &
     289      432000 :                       + p(i)*q(j)*c(4)%y
     290             :        end do
     291             :     end do
     292       21600 :   end function element_var_coordinates
     293             : 
     294             :   !___________________________________________________________________
     295           0 :   function element_var_coordinates3d(c,points) result(cart)
     296             : 
     297             :     type(cartesian3D_t), intent(in) :: c(4)
     298             :     real(r8), intent(in) :: points(:)
     299             : 
     300             :     type(cartesian3D_t)  :: cart(SIZE(points),SIZE(points))
     301             : 
     302           0 :     real(r8) :: p(size(points))
     303           0 :     real(r8) :: q(size(points)), r
     304             :     integer  :: i,j
     305             : 
     306           0 :     p(:) = (1.0D0-points(:))/2.0D0
     307           0 :     q(:) = (1.0D0+points(:))/2.0D0
     308             : 
     309           0 :     do j=1,SIZE(points)
     310           0 :        do i=1,SIZE(points)
     311           0 :           cart(i,j)%x = p(i)*p(j)*c(1)%x &
     312             :                       + q(i)*p(j)*c(2)%x &
     313             :                       + q(i)*q(j)*c(3)%x &
     314           0 :                       + p(i)*q(j)*c(4)%x
     315             :           cart(i,j)%y = p(i)*p(j)*c(1)%y &
     316             :                       + q(i)*p(j)*c(2)%y &
     317             :                       + q(i)*q(j)*c(3)%y &
     318           0 :                       + p(i)*q(j)*c(4)%y
     319             :           cart(i,j)%z = p(i)*p(j)*c(1)%z &
     320             :                       + q(i)*p(j)*c(2)%z &
     321             :                       + q(i)*q(j)*c(3)%z &
     322           0 :                       + p(i)*q(j)*c(4)%z
     323             : 
     324             :           ! project back to sphere:
     325           0 :           r = distance(cart(i,j))
     326           0 :           cart(i,j)%x = cart(i,j)%x/r
     327           0 :           cart(i,j)%y = cart(i,j)%y/r
     328           0 :           cart(i,j)%z = cart(i,j)%z/r
     329             :        end do
     330             :     end do
     331           0 :   end function element_var_coordinates3d
     332             : 
     333             :   !___________________________________________________________________
     334        1536 :   subroutine allocate_element_desc(elem)
     335             : 
     336             :     type (element_t), intent(inout)   :: elem(:)
     337             :     integer                           :: num, j,i
     338             : 
     339        1536 :     num = SIZE(elem)
     340             : 
     341       12336 :     do j=1,num
     342       32400 :        allocate(elem(j)%desc%putmapP(max_neigh_edges))
     343       21600 :        allocate(elem(j)%desc%getmapP(max_neigh_edges))
     344       21600 :        allocate(elem(j)%desc%putmapP_ghost(max_neigh_edges))
     345       21600 :        allocate(elem(j)%desc%getmapP_ghost(max_neigh_edges))
     346       21600 :        allocate(elem(j)%desc%putmapS(max_neigh_edges))
     347       21600 :        allocate(elem(j)%desc%getmapS(max_neigh_edges))
     348       21600 :        allocate(elem(j)%desc%reverse(max_neigh_edges))
     349       21600 :        allocate(elem(j)%desc%globalID(max_neigh_edges))
     350       21600 :        allocate(elem(j)%desc%loc2buf(max_neigh_edges))
     351       98736 :        do i=1,max_neigh_edges
     352       86400 :           elem(j)%desc%loc2buf(i)=i
     353       97200 :           elem(j)%desc%globalID(i)=-1
     354             :        enddo
     355             : 
     356             :     end do
     357        1536 :   end subroutine allocate_element_desc
     358             : 
     359             : 
     360           0 : end module element_mod

Generated by: LCOV version 1.14