LCOV - code coverage report
Current view: | top level - chemistry/mozart - cfc11star.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 45 | 47 | 95.7 %
Date: | 2024-12-17 22:39:59 |  | Functions: | 3 | 3 | 100.0 %

              Line data    Source code
           1             : !---------------------------------------------------------------------------------
           2             : ! Manages the CFC11* for radiation
           3             : !  4 Dec 2009 -- Francis Vitt created
           4             : !  8 Mar 2013 -- expanded for waccm_tsmlt -- fvitt
           5             : !---------------------------------------------------------------------------------
           6             : module cfc11star
           7             :
           8             :   use shr_kind_mod, only : r8 => shr_kind_r8
           9             :   use cam_logfile,  only : iulog
          10             :
          11             :   use physics_buffer, only : pbuf_add_field, dtype_r8
          12             :   use ppgrid,         only : pcols, pver, begchunk, endchunk
          13             :   use spmd_utils,     only : masterproc
          14             :   use constituents,   only : cnst_get_ind
          15             :   use mo_chem_utls,   only : get_inv_ndx
          16             :   use mo_flbc,        only : flbc_get_cfc11eq, flbc_has_cfc11eq
          17             :
          18             :   implicit none
          19             :   save
          20             :
          21             :   private
          22             :   public :: register_cfc11star
          23             :   public :: update_cfc11star
          24             :   public :: init_cfc11star
          25             :
          26             :   logical :: do_cfc11star
          27             :   character(len=16), parameter :: pbufname = 'CFC11STAR'
          28             :   integer :: pbf_idx = -1
          29             :   integer, parameter :: ncfcs = 14
          30             :
          31             :   integer :: indices(ncfcs)
          32             :   integer :: inv_indices(ncfcs)
          33             :
          34             :   real(r8) :: rel_rf(ncfcs)
          35             :   character(len=8), parameter :: species(ncfcs) = &
          36             :     (/ 'CFC11   ','CFC113  ','CFC114  ','CFC115  ','CCL4    ','CH3CCL3 ','CH3CL   ','HCFC22  ',&
          37             :        'HCFC141B','HCFC142B','CF2CLBR ','CF3BR   ','H2402   ','HALONS  ' /)
          38             :
          39             : contains
          40             :
          41             : !---------------------------------------------------------------------------------
          42             : !---------------------------------------------------------------------------------
          43      372480 :   subroutine register_cfc11star
          44             :
          45             :     implicit none
          46             :
          47             :     integer :: m
          48             :
          49             :     real(r8), parameter :: cfc_rf(ncfcs) = &
          50             :       (/  0.25_r8,   0.30_r8,   0.31_r8,   0.18_r8,   0.13_r8,   0.06_r8,   0.01_r8,   0.20_r8,  &
          51             :           0.14_r8,   0.20_r8,   0.30_r8,   0.32_r8,   0.33_r8,   0.25_r8 /) ! W/m2/ppb
          52             :
          53       23040 :     do m = 1, ncfcs
          54       21504 :        call cnst_get_ind(species(m), indices(m), abort=.false.)
          55       23040 :        if (indices(m)<=0) then
          56       19968 :          inv_indices(m)=get_inv_ndx(species(m))
          57             :        end if
          58             :     enddo
          59             :
          60       23040 :     do_cfc11star = (any(indices(:)>0).or.any(inv_indices(:)>0))
          61        1536 :     if (.not.do_cfc11star) return
          62             :
          63        1536 :     call pbuf_add_field(pbufname,'global',dtype_r8,(/pcols,pver/),pbf_idx)
          64             :
          65        1536 :     rel_rf(:) = cfc_rf(:) / cfc_rf(1)
          66             :
          67             :   endsubroutine register_cfc11star
          68             :
          69             : !---------------------------------------------------------------------------------
          70             : !---------------------------------------------------------------------------------
          71        1536 :   subroutine init_cfc11star(pbuf2d)
          72             :     use cam_history,  only : addfld, horiz_only
          73             :     use infnan,       only : nan, assignment(=)
          74             :     use physics_buffer, only : physics_buffer_desc, pbuf_set_field
          75             :
          76             :     real(r8) :: real_nan
          77             :     type(physics_buffer_desc), pointer :: pbuf2d(:,:)
          78             :
          79        1536 :     if (.not.do_cfc11star) return
          80             :
          81        1536 :     real_nan = nan
          82        1536 :     call pbuf_set_field(pbuf2d, pbf_idx, real_nan)
          83             :
          84        3072 :     call addfld(pbufname,(/ 'lev' /),'A','kg/kg','cfc11star for radiation' )
          85             :
          86        1536 :     if (flbc_has_cfc11eq) then
          87        3072 :        call addfld('CFC11STAR0', (/ 'lev' /), 'A','kg/kg','cfc11star for radiation before scaling' )
          88        1536 :        call addfld('CFC11EQ_LBC', horiz_only, 'A','mole/mole','cfc11eq LBC' )
          89             :     endif
          90             :
          91        1536 :     if (masterproc) then
          92           2 :        write(iulog,*) 'init_cfc11star: CFC11STAR is added to pbuf2d for radiation'
          93             :     endif
          94        1536 :   end subroutine init_cfc11star
          95             :
          96             : !---------------------------------------------------------------------------------
          97             : !---------------------------------------------------------------------------------
          98      370944 :   subroutine update_cfc11star( pbuf2d, phys_state )
          99             :
         100        1536 :     use cam_history,    only : outfld
         101             :     use physics_types,  only : physics_state
         102             :     use physics_buffer, only : physics_buffer_desc, pbuf_get_field, pbuf_get_chunk
         103             :     use tracer_cnst,    only : get_cnst_data_ptr ! returns pointer to
         104             :
         105             :     implicit none
         106             :
         107             :     type(physics_state), intent(in):: phys_state(begchunk:endchunk)
         108             :     type(physics_buffer_desc), pointer :: pbuf2d(:,:)
         109             :
         110             :
         111             :     integer :: lchnk, ncol
         112             :     integer :: c, m, k
         113      370944 :     real(r8), pointer :: cf11star(:,:)
         114      370944 :     real(r8), pointer :: cnst_offline(:,:)
         115             :     real(r8) :: cfc11eq_vmr(pcols)
         116             :     real(r8) :: scale_factor(pcols)
         117             :     real(r8), parameter :: vmr2mmr = 137.35_r8/28.97_r8
         118             :
         119      370944 :     if (.not.do_cfc11star) return
         120             :
         121     1866312 :     do c = begchunk,endchunk
         122     1495368 :        lchnk = phys_state(c)%lchnk
         123     1495368 :        ncol = phys_state(c)%ncol
         124             :
         125     1495368 :        call pbuf_get_field(pbuf_get_chunk(pbuf2d, lchnk), pbf_idx, cf11star)
         126             :
         127  2323627992 :        cf11star(:ncol,:) = 0._r8
         128    22430520 :        do m = 1, ncfcs
         129    22430520 :           if ( indices(m)>0 ) then
         130           0 :              cf11star(:ncol,:) = cf11star(:ncol,:) &
         131  2323627992 :                                + phys_state(c)%q(:ncol,:,indices(m)) * rel_rf(m)
         132    19439784 :           elseif (inv_indices(m)>0) then
         133     1495368 :              call get_cnst_data_ptr( species(m), phys_state(c), cnst_offline, pbuf_get_chunk(pbuf2d, lchnk) )
         134           0 :              cf11star(:ncol,:) = cf11star(:ncol,:) &
         135  4645760616 :                                + cnst_offline(:ncol,:) * rel_rf(m)
         136             :           endif
         137             :        enddo
         138             :
         139     1495368 :        if (flbc_has_cfc11eq) then
         140     1495368 :           call flbc_get_cfc11eq( cfc11eq_vmr, ncol, lchnk )
         141             :
         142     1495368 :           call outfld( 'CFC11EQ_LBC', cfc11eq_vmr(:ncol), ncol, lchnk)
         143     1495368 :           call outfld( 'CFC11STAR0', cf11star(:ncol,:), ncol, lchnk)
         144             :
         145             :           ! scale according to CAM's CFC11_eq
         146    24969168 :           scale_factor(:ncol) = (vmr2mmr*cfc11eq_vmr(:ncol))/cf11star(:ncol,pver)
         147   140564592 :           do k = 1,pver
         148  2323627992 :              cf11star(:ncol,k) = scale_factor(:ncol)*cf11star(:ncol,k)
         149             :           enddo
         150             :        endif
         151             :
         152     1866312 :        call outfld( pbufname, cf11star(:ncol,:), ncol, lchnk)
         153             :
         154             :     enddo
         155             :
         156      741888 :   endsubroutine update_cfc11star
         157             :
         158             : end module cfc11star

Generated by: LCOV version 1.14