LCOV - code coverage report
Current view: | top level - physics/cam - tracers_suite.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 0 | 93 | 0.0 %
Date: | 2024-12-17 22:39:59 |  | Functions: | 0 | 7 | 0.0 %

              Line data    Source code
           1             :
           2             : module tracers_suite
           3             :
           4             : !---------------------------------------------------------------
           5             : !
           6             : ! Implements artificial suite of passive tracers
           7             : !    1) low tracer with unit mixing ratio at about 800 mb
           8             : !    2) med tracer with unit mixing ratio at about 500 mb
           9             : !    3) high tracer with unit mixing ratio at about 200 mb
          10             : !    4) reverse med tracer with unit mixing ratio everywhere except about 500 mb
          11             : !    5) unit tracer with unit mixing ratio everywhere
          12             : !
          13             : !  D Bundy June 2003
          14             : !  modified Feb 2004 to include TT_UN and smoothing
          15             : !
          16             : !  A Mirin and B Eaton, August 2007
          17             : !  Modified to create up to 1000 distinct copies of the 5 basic tracers
          18             : !  by appending up to a 3 digit number to the base tracer name.
          19             : !  RESTRICTION - trac_ncnstmx cannot exceed 5000 unless the algorithm for
          20             : !                constructing new tracer names is extended.
          21             : !
          22             : !---------------------------------------------------------------
          23             :
          24             : use shr_kind_mod,   only: r8 => shr_kind_r8
          25             : use ppgrid,         only: pcols, pver
          26             : use ref_pres,       only: pref_mid
          27             : use cam_abortutils, only: endrun
          28             : use cam_logfile,    only: iulog
          29             :
          30             : implicit none
          31             : private
          32             : save
          33             :
          34             : public get_tracer_name  ! generate names of tracers
          35             : public init_cnst_tr     ! initialize tracer fields
          36             :
          37             : integer, parameter :: trac_ncnstmx=5000 ! Max no. of tracers based on current algorithm for
          38             :                                         ! constructing tracer names.  This could easily be extended.
          39             : integer, parameter :: trac_names=5      ! No. of base tracers
          40             :
          41             : logical, parameter :: smooth = .false.
          42             :
          43             : !======================================================================
          44             : contains
          45             : !======================================================================
          46             :
          47           0 : function get_tracer_name(n)
          48             :
          49             :    ! The tracer names are only defined in this module. This function is for
          50             :    ! outside programs to grab the name for each tracer number.
          51             :
          52             :    integer, intent(in) :: n
          53             :    character(len=8)    :: get_tracer_name
          54             :
          55             :    ! Local variables
          56             :    character(len=5), dimension(trac_names), parameter :: & ! constituent names
          57             :       tracer_names  =  (/ 'TT_LW', 'TT_MD', 'TT_HI', 'TTRMD' , 'TT_UN'/)
          58             :
          59             :    integer :: nbase  ! Corresponding base tracer index
          60             :    integer :: ncopy  ! No. of copies of base tracers
          61             :    character(len=1) :: c1
          62             :    character(len=2) :: c2
          63             :    character(len=3) :: c3
          64             :    !-----------------------------------------------------------------------
          65             :
          66           0 :    if ( n > trac_ncnstmx ) then
          67           0 :       write(iulog,*) 'tracers_suite:get_tracer_name()','requested tracer',n
          68           0 :       write(iulog,*) 'only ',trac_ncnstmx,' tracers available'
          69           0 :       call endrun('tracers_suite: ERROR in get_tracer_name(); n too large')
          70             :    else
          71           0 :       nbase = mod(n-1, trac_names) + 1
          72           0 :       ncopy = (n-1)/trac_names
          73           0 :       if ( ncopy == 0 ) then
          74           0 :          get_tracer_name = tracer_names(nbase)
          75           0 :       else if ( ncopy >= 1  .and.  ncopy <= 9 ) then
          76           0 :          write (c1,'(i1)') ncopy
          77           0 :          get_tracer_name = tracer_names(nbase) // c1
          78           0 :       else if ( ncopy >= 10  .and.  ncopy <= 99 ) then
          79           0 :          write (c2,'(i2)') ncopy
          80           0 :          get_tracer_name = tracer_names(nbase) // c2
          81           0 :       else if ( ncopy >= 100  .and.  ncopy <= 999 ) then
          82           0 :          write (c3,'(i3)') ncopy
          83           0 :          get_tracer_name = tracer_names(nbase) // c3
          84             :       end if
          85             :    endif
          86             :
          87           0 : end function get_tracer_name
          88             :
          89             : !======================================================================
          90             :
          91           0 : subroutine init_cnst_tr(m, latvals, lonvals, mask, q)
          92             :
          93             :    ! calls initialization routine for tracer m, returns mixing ratio in q
          94             :
          95             :    integer,  intent(in)  :: m          ! index of tracer
          96             :    real(r8), intent(in)  :: latvals(:) ! lat in radians (ncol)
          97             :    real(r8), intent(in)  :: lonvals(:) ! lon in radians (ncol)
          98             :    logical,  intent(in)  :: mask(:)    ! Only initialize where .true.
          99             :    real(r8), intent(out) :: q(:,:)     ! kg tracer/kg dry air (gcol,plev)
         100             :
         101             :    integer nbase ! Corresponding base tracer index
         102             :
         103           0 :    if ( m > trac_ncnstmx ) then
         104           0 :       write(iulog,*) 'tracers_suite:init_cnst_tr()'
         105           0 :       write(iulog,*) ' asked to initialize tracer number ',m
         106           0 :       write(iulog,*) ' but there are only trac_ncnstmx = ',trac_ncnstmx,' tracers'
         107           0 :       call endrun('tracers_suite: ERROR in init_cnst_tr(); m too large')
         108             :    endif
         109             :
         110           0 :    nbase = mod(m-1,trac_names)+1
         111             :
         112           0 :    if ( nbase == 1 ) then
         113           0 :       call init_cnst_lw(latvals, lonvals, mask, q)
         114           0 :    else if ( nbase == 2 ) then
         115           0 :       call init_cnst_md(latvals, lonvals, mask, q)
         116           0 :    else if ( nbase == 3 ) then
         117           0 :       call init_cnst_hi(latvals, lonvals, mask, q)
         118           0 :    else if ( nbase == 4 ) then
         119           0 :       call init_cnst_md(latvals, lonvals, mask, q, rev_in=1)
         120           0 :    else if ( nbase == 5 ) then
         121           0 :       call init_cnst_un(latvals, lonvals, mask, q)
         122             :    else
         123           0 :       write(iulog,*) 'tracers_suite:init_cnst_tr()'
         124           0 :       write(iulog,*) 'no initialization routine specified for tracer',nbase
         125           0 :       call endrun('tracers_suite: ERROR in init_cnst_tr(); no init routine available')
         126             :    endif
         127             :
         128           0 : end subroutine init_cnst_tr
         129             :
         130             : !======================================================================
         131             :
         132           0 : subroutine init_cnst_lw(latvals, lonvals, mask, q)
         133             :
         134             :    ! Initialize test tracer TT_LW
         135             :    ! Initialize low tracer to zero except at 800 level
         136             :
         137             :    ! Arguments
         138             :    real(r8), intent(in)  :: latvals(:) ! lat in radians (ncol)
         139             :    real(r8), intent(in)  :: lonvals(:) ! lon in radians (ncol)
         140             :    logical,  intent(in)  :: mask(:)    ! Only initialize where .true.
         141             :    real(r8), intent(out) :: q(:,:)    ! kg tracer/kg dry air (gcol,plev)
         142             :
         143             :    ! Local
         144             :    integer :: indx, k
         145             :    !-----------------------------------------------------------------------
         146             :
         147           0 :    indx = setpindxtr(800._r8)
         148             :
         149             :    if ( smooth ) then
         150             :       call setsmoothtr(indx,q,.876_r8, mask)
         151             :    else
         152           0 :       do k = 1, size(q, 2)
         153           0 :          if (k == indx) then
         154           0 :             where(mask)
         155           0 :                q(:,k) = 1.0_r8
         156             :             end where
         157             :          else
         158           0 :             where(mask)
         159           0 :                q(:,k) = 0.0_r8
         160             :             end where
         161             :          end if
         162             :       end do
         163             :    end if
         164             :
         165           0 : end subroutine init_cnst_lw
         166             :
         167             : !======================================================================
         168             :
         169           0 : subroutine init_cnst_md(latvals, lonvals, mask, q, rev_in)
         170             :
         171             :    ! Initialize test tracer TT_MD
         172             :    ! Initialize med tracer to zero except at 500 level
         173             :
         174             :    ! Arguments
         175             :    real(r8), intent(in)  :: latvals(:) ! lat in radians (ncol)
         176             :    real(r8), intent(in)  :: lonvals(:) ! lon in radians (ncol)
         177             :    logical,  intent(in)  :: mask(:)    ! Only initialize where .true.
         178             :    real(r8), intent(out) :: q(:,:)    ! kg tracer/kg dry air
         179             :    integer,  intent(in), optional :: rev_in         ! reverse the mixing ratio
         180             :
         181             :    ! Local
         182             :    integer :: indx, k
         183             :    integer :: rev
         184             :    !-----------------------------------------------------------------------
         185             :
         186           0 :    rev = 0
         187           0 :    if (present(rev_in)) then
         188           0 :       if (rev_in == 1) then
         189           0 :          rev = 1
         190             :       endif
         191             :    endif
         192             :
         193           0 :    indx = setpindxtr(500._r8)
         194             :
         195             :    if ( smooth ) then
         196             :       call setsmoothtr(indx,q,.876_r8,mask,rev_in=rev)
         197             :    else
         198           0 :       do k = 1, size(q, 2)
         199           0 :          if (rev == 1 ) then
         200           0 :             if (k == indx) then
         201           0 :                where(mask)
         202           0 :                   q(:,indx) = 0.0_r8
         203             :                end where
         204             :             else
         205           0 :                where(mask)
         206           0 :                   q(:,k) = 1.0_r8
         207             :                end where
         208             :             end if
         209             :          else
         210           0 :             if (k == indx) then
         211           0 :                where(mask)
         212           0 :                   q(:,indx) = 1.0_r8
         213             :                end where
         214             :             else
         215           0 :                where(mask)
         216           0 :                   q(:,k) = 0.0_r8
         217             :                end where
         218             :             end if
         219             :          end if
         220             :       end do
         221             :    end if
         222             :
         223           0 : end subroutine init_cnst_md
         224             :
         225             : !======================================================================
         226             :
         227           0 : subroutine init_cnst_hi(latvals, lonvals, mask, q)
         228             :
         229             :    ! Initialize test tracer TT_HI
         230             :    ! Initialize high tracer to zero except at 200 level
         231             :
         232             :    ! Arguments
         233             :    real(r8), intent(in)  :: latvals(:) ! lat in radians (ncol)
         234             :    real(r8), intent(in)  :: lonvals(:) ! lon in radians (ncol)
         235             :    logical,  intent(in)  :: mask(:)    ! Only initialize where .true.
         236             :    real(r8), intent(out) :: q(:,:)    ! kg tracer/kg dry air
         237             :
         238             :    ! Local
         239             :    integer :: indx, k
         240             :    !-----------------------------------------------------------------------
         241             :
         242           0 :    indx = setpindxtr(200._r8)
         243             :
         244             :    if ( smooth ) then
         245             :       call setsmoothtr(indx,q,.3_r8,mask)
         246             :    else
         247           0 :       do k = 1, size(q, 2)
         248           0 :          if (k == indx) then
         249           0 :             where(mask)
         250           0 :                q(:,k) = 1.0_r8
         251             :             end where
         252             :          else
         253           0 :             where(mask)
         254           0 :                q(:,k) = 0.0_r8
         255             :             end where
         256             :          end if
         257             :       end do
         258             :    end if
         259             :
         260           0 : end subroutine init_cnst_hi
         261             :
         262             : !======================================================================
         263             :
         264           0 : subroutine init_cnst_un(latvals, lonvals, mask, q)
         265             :
         266             :    ! Initialize test unit tracer TT_UN
         267             :
         268             :    real(r8), intent(in)  :: latvals(:) ! lat in radians (ncol)
         269             :    real(r8), intent(in)  :: lonvals(:) ! lon in radians (ncol)
         270             :    logical,  intent(in)  :: mask(:)    ! Only initialize where .true.
         271             :    real(r8), intent(out) :: q(:,:)    ! kg tracer/kg dry air
         272             :    !-----------------------------------------------------------------------
         273             :    integer :: k
         274             :
         275           0 :    do k = 1, size(q, 2)
         276           0 :       where(mask)
         277           0 :          q(:,k) = 1.0_r8
         278             :       end where
         279             :    end do
         280             :
         281           0 : end subroutine init_cnst_un
         282             :
         283             : !======================================================================
         284             :
         285             : subroutine setsmoothtr(indx,q,width,mask,rev_in)
         286             :
         287             :    ! Arguments
         288             :    integer, intent(in)     :: indx               ! k index of pressure level
         289             :    real(r8), intent(inout) :: q(:,:)  ! kg tracer/kg dry air
         290             :    real(r8), intent(in)    :: width              ! eta difference from unit level where q = 0.1
         291             :    logical,  intent(in)    :: mask(:) ! Only set q where mask is .true.
         292             :    integer,  intent(in), optional :: rev_in      ! reverse the mixing ratio
         293             :
         294             :    ! Local variables
         295             :    integer  :: k
         296             :    real(r8) :: alpha ! guassian width, determined by width, T
         297             :    real(r8) :: pdist ! pressure distance (eta.e4) from k=indx
         298             :    real(r8) :: T     ! desired m.r. in level specified by pdiff from k=indx
         299             :    integer  :: rev  ! = 1 then reverse (q = 1, q(k=indx) = 0 )
         300             :
         301             :    rev = 0
         302             :    if (present(rev_in)) then
         303             :       if (rev_in == 1) then
         304             :          rev = 1
         305             :       endif
         306             :    endif
         307             :
         308             :    T = 0.1_r8
         309             :    alpha = -log(T)/(width*1.e4_r8)**2  ! s.t. in level width from indx, mr = T
         310             :
         311             :    !  alpha = 3.e-8  ! m.r. ~ 0.1 in adjacent levels, where change eta ~ 0.08
         312             :
         313             :    do k=1,pver
         314             :       pdist = pref_mid(k) - pref_mid(indx)
         315             :
         316             :       if ( rev == 1 ) then
         317             :          where(mask)
         318             :             q(:,k) = 1.0_r8 - exp(-alpha*(pdist**2))
         319             :          end where
         320             :       else
         321             :          where(mask)
         322             :             q(:,k) =       exp(-alpha*(pdist**2))
         323             :          end where
         324             :       endif
         325             :    end do
         326             :
         327             : end subroutine setsmoothtr
         328             :
         329             : !======================================================================
         330             :
         331           0 : integer function setpindxtr(pmb)
         332             :
         333             :    ! find the index of layer nearest pmb
         334             :
         335             :    real(r8), intent(in) :: pmb
         336             :
         337             :    integer  :: indx, k
         338             :    real(r8) :: pmin, pdist
         339             :
         340           0 :    indx = 0
         341           0 :    pmin = 1.e36_r8
         342           0 :    pdist = 1.e36_r8
         343           0 :    do k=1,pver
         344           0 :       pdist = abs(pref_mid(k) - pmb*100._r8)
         345           0 :       if (pdist < pmin) then
         346           0 :          indx = k
         347           0 :          pmin = pdist
         348             :       end if
         349             :    end do
         350             :
         351           0 :    setpindxtr = indx
         352             :
         353           0 : end function setpindxtr
         354             :
         355             : !======================================================================
         356             :
         357             : end module tracers_suite

Generated by: LCOV version 1.14