LCOV - code coverage report
Current view: | top level - dynamics/se - advect_tend.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 25 | 136 | 18.4 %
Date: | 2025-01-13 21:54:50 |  | Functions: | 1 | 2 | 50.0 %

              Line data    Source code
           1             : !----------------------------------------------------------------------
           2             : ! this module computes the total advection tendencies of advected
           3             : ! constituents for the finite volume dycore
           4             : !----------------------------------------------------------------------
           5             : module advect_tend
           6             :
           7             :   use shr_kind_mod, only : r8 => shr_kind_r8
           8             :
           9             :   save
          10             :   private
          11             :
          12             :   public :: compute_adv_tends_xyz
          13             :   public :: compute_write_iop_fields
          14             :
          15             :   real(r8), allocatable :: adv_tendxyz(:,:,:,:,:)
          16             :   real(r8), allocatable :: iop_qtendxyz(:,:,:,:,:)
          17             :   real(r8), allocatable :: iop_qtendxyz_init(:,:,:,:,:)
          18             :   real(r8), allocatable :: derivedfq(:,:,:,:,:)
          19             :   real(r8), allocatable :: iop_ttendxyz(:,:,:,:)
          20             :   real(r8), allocatable :: iop_ttendxyz_init(:,:,:,:)
          21             :
          22             : contains
          23             :
          24             :   !----------------------------------------------------------------------
          25             :   ! computes the total advective tendencies
          26             :   ! called twice each time step:
          27             :   !   - first call sets the initial mixing ratios
          28             :   !   - second call computes and outputs the tendencies
          29             :   !----------------------------------------------------------------------
          30      738816 :   subroutine compute_adv_tends_xyz(elem,fvm,nets,nete,qn0,n0)
          31             :     use cam_history,            only: outfld
          32             :     use time_manager,           only: get_step_size
          33             :     use constituents,           only: tottnam,pcnst
          34             :     use dimensions_mod,         only: nc,np,nlev,use_cslam
          35             :     use element_mod,            only: element_t
          36             :     use fvm_control_volume_mod, only: fvm_struct
          37             :     implicit none
          38             :
          39             :     type (element_t), intent(in) :: elem(:)
          40             :     type(fvm_struct), intent(in) :: fvm(:)
          41             :     integer,          intent(in) :: nets,nete,qn0,n0
          42             :     real(r8) :: dt
          43             :     integer  :: i,j,ic,nx,ie
          44             :     logical  :: init
          45      738816 :     real(r8), allocatable, dimension(:,:) :: ftmp
          46             :
          47      738816 :     if (use_cslam) then
          48             :       nx=nc
          49             :     else
          50           0 :       nx=np
          51             :     endif
          52     2216448 :     allocate( ftmp(nx*nx,nlev) )
          53             :
          54      738816 :     init = .false.
          55      738816 :     if ( .not. allocated( adv_tendxyz ) ) then
          56      369408 :       init = .true.
          57     2585856 :       allocate( adv_tendxyz(nx,nx,nlev,pcnst,nets:nete) )
          58  2644522608 :       adv_tendxyz(:,:,:,:,:) = 0._r8
          59             :     endif
          60             :
          61      738816 :     if (use_cslam) then
          62     5933616 :       do ie=nets,nete
          63    21518016 :         do ic=1,pcnst
          64  5288306400 :           adv_tendxyz(:,:,:,ic,ie) = fvm(ie)%c(1:nc,1:nc,:,ic) - adv_tendxyz(:,:,:,ic,ie)
          65             :         end do
          66             :       end do
          67             :     else
          68           0 :       do ie=nets,nete
          69           0 :         do ic=1,pcnst
          70           0 :           adv_tendxyz(:,:,:,ic,ie) = elem(ie)%state%Qdp(:,:,:,ic,qn0)/elem(ie)%state%dp3d(:,:,:,n0)  - adv_tendxyz(:,:,:,ic,ie)
          71             :         enddo
          72             :       end do
          73             :     end if
          74             :
          75      738816 :     if ( .not. init ) then
          76      369408 :       dt = get_step_size()
          77             :
          78     2966808 :       do ie=nets,nete
          79    10759008 :         do ic = 1,pcnst
          80    31168800 :           do j=1,nx
          81   101298600 :             do i=1,nx
          82  1916881200 :               ftmp(i+(j-1)*nx,:) = adv_tendxyz(i,j,:,ic,ie)
          83             :             end do
          84             :           end do
          85    10389600 :           call outfld(tottnam(ic), ftmp,nx*nx, ie)
          86             :         end do
          87             :       end do
          88      369408 :       deallocate(adv_tendxyz)
          89             :     endif
          90      738816 :     deallocate(ftmp)
          91      738816 :   end subroutine compute_adv_tends_xyz
          92             :
          93             :   !----------------------------------------------------------------------
          94             :   ! computes camiop specific tendencies
          95             :   ! and writes these to the camiop file
          96             :   ! called twice each time step:
          97             :   !   - first call sets the initial mixing ratios/state
          98             :   !   - second call computes and outputs the tendencies
          99             :   !----------------------------------------------------------------------
         100           0 :   subroutine compute_write_iop_fields(elem,fvm,nets,nete,qn0,n0)
         101      738816 :     use cam_abortutils,         only: endrun
         102             :     use cam_history,            only: outfld, hist_fld_active
         103             :     use time_manager,           only: get_step_size
         104             :     use constituents,           only: pcnst,cnst_name
         105             :     use dimensions_mod,         only: nc,np,nlev,use_cslam,npsq
         106             :     use element_mod,            only: element_t
         107             :     use fvm_control_volume_mod, only: fvm_struct
         108             :     implicit none
         109             :
         110             :     type (element_t), intent(inout) :: elem(:)
         111             :     type(fvm_struct), intent(inout) :: fvm(:)
         112             :     integer,          intent(in) :: nets,nete,qn0,n0
         113             :     real(r8) :: dt
         114           0 :     real(r8), allocatable        :: q_new(:,:,:)
         115           0 :     real(r8), allocatable        :: q_adv(:,:,:)
         116           0 :     real(r8), allocatable        :: t_adv(:,:)
         117           0 :     real(r8), allocatable        :: out_q(:,:)
         118           0 :     real(r8), allocatable        :: out_t(:,:)
         119           0 :     real(r8), allocatable        :: out_u(:,:)
         120           0 :     real(r8), allocatable        :: out_v(:,:)
         121           0 :     real(r8), allocatable        :: out_ps(:)
         122             :
         123             :     integer  :: i,j,ic,nx,ie,nxsq,p
         124             :     integer  :: ierr
         125             :     logical  :: init
         126             :     character(len=*), parameter :: sub = 'compute_write_iop_fields:'
         127             :     !----------------------------------------------------------------------------
         128             :
         129           0 :     if (use_cslam) then
         130             :       nx=nc
         131             :     else
         132           0 :       nx=np
         133             :     endif
         134           0 :     nxsq=nx*nx
         135             :
         136           0 :     init = .false.
         137           0 :     dt = get_step_size()
         138             :
         139           0 :     if ( .not. allocated( iop_qtendxyz ) ) then
         140           0 :       init = .true.
         141             :
         142           0 :       allocate( iop_qtendxyz(nx,nx,nlev,pcnst,nets:nete),stat=ierr )
         143           0 :       if (ierr/=0) call endrun( sub//': not able to allocate iop_qtendxyz' )
         144           0 :       iop_qtendxyz = 0._r8
         145           0 :       allocate( derivedfq(nx,nx,nlev,pcnst,nets:nete),stat=ierr )
         146           0 :       if (ierr/=0) call endrun( sub//': not able to allocate derivedfq' )
         147           0 :       derivedfq = 0._r8
         148           0 :       allocate( iop_qtendxyz_init(nx,nx,nlev,pcnst,nets:nete),stat=ierr )
         149           0 :       if (ierr/=0) call endrun( sub//': not able to allocate iop_qtendxyz' )
         150           0 :       iop_qtendxyz_init = 0._r8
         151           0 :       allocate( iop_ttendxyz(nx,nx,nlev,nets:nete),stat=ierr )
         152           0 :       if (ierr/=0) call endrun( sub//': not able to allocate iop_ttendxyz' )
         153           0 :       iop_ttendxyz = 0._r8
         154           0 :       allocate( iop_ttendxyz_init(nx,nx,nlev,nets:nete),stat=ierr )
         155           0 :       if (ierr/=0) call endrun( sub//': not able to allocate iop_ttendxyz_init' )
         156           0 :       iop_ttendxyz_init = 0._r8
         157             :     endif
         158             :
         159             :     ! save initial/calc tendencies on second call to this routine.
         160           0 :     if (use_cslam) then
         161           0 :       do ie=nets,nete
         162           0 :         do ic=1,pcnst
         163           0 :           iop_qtendxyz(:,:,:,ic,ie) = fvm(ie)%c(1:nc,1:nc,:,ic) - iop_qtendxyz(:,:,:,ic,ie)
         164             :         end do
         165             :       end do
         166             :     else
         167           0 :       do ie=nets,nete
         168           0 :         do ic=1,pcnst
         169           0 :           iop_qtendxyz(:,:,:,ic,ie) = elem(ie)%state%Qdp(:,:,:,ic,qn0)/elem(ie)%state%dp3d(:,:,:,n0)  - iop_qtendxyz(:,:,:,ic,ie)
         170             :        enddo
         171             :       end do
         172             :     end if
         173           0 :     do ie=nets,nete
         174           0 :        iop_ttendxyz(:,:,:,ie) = elem(ie)%state%T(:,:,:,n0)  - iop_ttendxyz(:,:,:,ie)
         175             :     end do
         176             :
         177           0 :     if (init) then
         178           0 :        do ie=nets,nete
         179           0 :           iop_ttendxyz_init(:,:,:,ie)   = iop_ttendxyz(:,:,:,ie)
         180           0 :           iop_qtendxyz_init(:,:,:,:,ie) = iop_qtendxyz(:,:,:,:,ie)
         181           0 :           derivedfq(:,:,:,:,ie)=elem(ie)%derived%FQ(:,:,:,:)/dt
         182             :        end do
         183             :     end if
         184             :
         185             :     if ( .not. init ) then
         186           0 :       allocate( q_adv(nxsq,nlev,pcnst),stat=ierr )
         187           0 :       if (ierr/=0) call endrun( sub//': not able to allocate q_adv' )
         188           0 :       q_adv = 0._r8
         189           0 :       allocate( t_adv(npsq,nlev),stat=ierr )
         190           0 :       if (ierr/=0) call endrun( sub//': not able to allocate t_adv' )
         191           0 :       t_adv = 0._r8
         192           0 :       allocate( q_new(nx,nx,nlev),stat=ierr )
         193           0 :       if (ierr/=0) call endrun( sub//': not able to allocate q_new' )
         194           0 :       q_new = 0._r8
         195           0 :       allocate( out_q(npsq,nlev),stat=ierr )
         196           0 :       if (ierr/=0) call endrun( sub//': not able to allocate out_q' )
         197           0 :       out_q = 0._r8
         198           0 :       allocate( out_t(npsq,nlev),stat=ierr )
         199           0 :       if (ierr/=0) call endrun( sub//': not able to allocate out_t' )
         200           0 :       out_t = 0._r8
         201           0 :       allocate( out_u(npsq,nlev),stat=ierr )
         202           0 :       if (ierr/=0) call endrun( sub//': not able to allocate out_u' )
         203           0 :       out_u = 0._r8
         204           0 :       allocate( out_v(npsq,nlev),stat=ierr )
         205           0 :       if (ierr/=0) call endrun( sub//': not able to allocate out_v' )
         206           0 :       out_v = 0._r8
         207           0 :       allocate( out_ps(npsq),stat=ierr )
         208           0 :       if (ierr/=0) call endrun( sub//': not able to allocate out_ps' )
         209           0 :       out_ps = 0._r8
         210           0 :       do ie=nets,nete
         211           0 :          do j=1,nx
         212           0 :             do i=1,nx
         213           0 :                t_adv(i+(j-1)*np,:) = iop_ttendxyz(i,j,:,ie)/dt - elem(ie)%derived%FT(i,j,:)
         214           0 :                out_u(i+(j-1)*np,:) = elem(ie)%state%v(i,j,1,:,n0)
         215           0 :                out_v(i+(j-1)*np,:) = elem(ie)%state%v(i,j,2,:,n0)
         216           0 :                out_ps(i+(j-1)*np) = elem(ie)%state%psdry(i,j)
         217             :
         218             :                ! to retain bfb, replace state q and t with roundoff version calculated using the ordering and tendencies of the
         219             :                ! scam prognostic equation
         220           0 :                elem(ie)%state%T(i,j,:,n0) =  iop_ttendxyz_init(i,j,:,ie) + dt*(elem(ie)%derived%FT(i,j,:) + t_adv(i+(j-1)*np,:))
         221           0 :                out_t(i+(j-1)*np,:) = elem(ie)%state%T(i,j,:,n0)
         222           0 :                do p=1,pcnst
         223           0 :                   q_adv(i+(j-1)*nx,:,p) = iop_qtendxyz(i,j,:,p,ie)/dt - derivedfq(i,j,:,p,ie)
         224           0 :                   q_new(i,j,:) = iop_qtendxyz_init(i,j,:,p,ie) + dt*(derivedfq(i,j,:,p,ie) + q_adv(i+(j-1)*nx,:,p))
         225           0 :                   if (use_cslam) then
         226           0 :                      fvm(ie)%c(i,j,:,p)=q_new(i,j,:)
         227             :                   else
         228           0 :                      elem(ie)%state%Qdp(i,j,:,p,qn0)=q_new(i,j,:)*elem(ie)%state%dp3d(i,j,:,n0)
         229             :                   end if
         230             :                enddo
         231           0 :                out_q(i+(j-1)*nx,:) = elem(ie)%state%Qdp(i,j,:,1,qn0)/elem(ie)%state%dp3d(i,j,:,n0)
         232             :             end do
         233             :          end do
         234           0 :          call outfld('Ps',out_ps,npsq,ie)
         235           0 :          call outfld('t',out_t,npsq,ie)
         236           0 :          call outfld('q',out_q,nxsq,ie)
         237           0 :          call outfld('u',out_u,npsq,ie)
         238           0 :          call outfld('v',out_v,npsq,ie)
         239           0 :          call outfld('divT3d',t_adv,npsq,ie)
         240           0 :          do p=1,pcnst
         241           0 :             call outfld(trim(cnst_name(p))//'_dten',q_adv(:,:,p),nxsq,ie)
         242             :          enddo
         243             :       end do
         244             :
         245           0 :       deallocate(iop_ttendxyz)
         246           0 :       deallocate(iop_ttendxyz_init)
         247           0 :       deallocate(iop_qtendxyz)
         248           0 :       deallocate(iop_qtendxyz_init)
         249           0 :       deallocate(derivedfq)
         250           0 :       deallocate(out_t)
         251           0 :       deallocate(out_q)
         252           0 :       deallocate(out_u)
         253           0 :       deallocate(out_v)
         254           0 :       deallocate(out_ps)
         255           0 :       deallocate(t_adv)
         256           0 :       deallocate(q_adv)
         257           0 :       deallocate(q_new)
         258             :
         259             :     endif
         260           0 :   end subroutine compute_write_iop_fields
         261             :
         262             : end module advect_tend

Generated by: LCOV version 1.14