LCOV - code coverage report
Current view: | top level - physics/cam - const_init.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 0 | 97 | 0.0 %
Date: | 2024-12-17 17:57:11 |  | Functions: | 0 | 2 | 0.0 %

              Line data    Source code
           1             : module const_init
           2             :
           3             : ! Initialize constituents to default values
           4             :
           5             : use shr_kind_mod,     only: r8 => shr_kind_r8, max_chars=>shr_kind_cl
           6             : use spmd_utils,       only: masterproc
           7             : use cam_abortutils,   only: endrun
           8             : use cam_logfile,      only: iulog
           9             :
          10             : implicit none
          11             : private
          12             : save
          13             :
          14             : public :: cnst_init_default
          15             :
          16             : interface cnst_init_default
          17             :   module procedure cnst_init_default_col
          18             :   module procedure cnst_init_default_cblock
          19             : end interface cnst_init_default
          20             :
          21             : !==============================================================================
          22             : CONTAINS
          23             : !==============================================================================
          24             :
          25           0 :   subroutine cnst_init_default_col(m_cnst, latvals, lonvals, q, mask,         &
          26           0 :        verbose, notfound, z)
          27             :     use constituents,  only: cnst_name, cnst_read_iv
          28             :     use aoa_tracers,   only: aoa_tracers_implements_cnst,   aoa_tracers_init_cnst
          29             :     use carma_intr,    only: carma_implements_cnst,         carma_init_cnst
          30             :     use chemistry,     only: chem_implements_cnst,          chem_init_cnst
          31             :     use clubb_intr,    only: clubb_implements_cnst,         clubb_init_cnst
          32             :     use co2_cycle,     only: co2_implements_cnst,           co2_init_cnst
          33             :     use microp_driver, only: microp_driver_implements_cnst, microp_driver_init_cnst
          34             :     use rk_stratiform, only: rk_stratiform_implements_cnst, rk_stratiform_init_cnst
          35             :     use tracers,       only: tracers_implements_cnst,       tracers_init_cnst
          36             :     use unicon_cam,    only: unicon_implements_cnst,        unicon_init_cnst
          37             :
          38             :     !-----------------------------------------------------------------------
          39             :     !
          40             :     ! Purpose: initialize named tracer mixing ratio field
          41             :     !  This subroutine should be called ONLY at the beginning of an initial run
          42             :     !
          43             :     !-----------------------------------------------------------------------
          44             :
          45             :     ! Dummy arguments
          46             :     integer,           intent(in)  :: m_cnst     ! Constant index
          47             :     real(r8),          intent(in)  :: latvals(:) ! lat in degrees (ncol)
          48             :     real(r8),          intent(in)  :: lonvals(:) ! lon in degrees (ncol)
          49             :     real(r8),          intent(out) :: q(:,:)     ! mixing ratio (ncol, plev)
          50             :     logical, optional, intent(in)  :: mask(:)    ! Only initialize where .true.
          51             :     logical, optional, intent(in)  :: verbose    ! For internal use
          52             :     logical, optional, intent(in)  :: notfound   ! Turn off initial dataset warn
          53             :     real(r8),optional, intent(in)  :: z(:,:)     ! height of full pressure level
          54             :     ! Local variables
          55           0 :     logical, allocatable           :: mask_use(:)
          56             :     character(len=max_chars)       :: name
          57             :     logical                        :: verbose_use
          58             :     logical                        :: notfound_use
          59             :
          60           0 :     name = cnst_name(m_cnst)
          61             :
          62           0 :     allocate(mask_use(size(latvals)))
          63           0 :     if (present(mask)) then
          64           0 :       if (size(mask_use) /= size(mask)) then
          65           0 :         call endrun('cnst_init_default: input, mask, is wrong size')
          66             :       end if
          67           0 :       mask_use = mask
          68             :     else
          69           0 :       mask_use = .true.
          70             :     end if
          71             :
          72           0 :     if (present(verbose)) then
          73           0 :       verbose_use = verbose
          74             :     else
          75             :       verbose_use = .true.
          76             :     end if
          77             :
          78             :     ! default is to assume the constituent was not found on the initial file
          79             :     ! before calling this routine.  But it is also possible that the constituent
          80             :     ! was added with the "readiv=.false." option
          81           0 :     if (present(notfound)) then
          82           0 :       notfound_use = notfound
          83             :     else
          84             :       notfound_use = .true.
          85             :     end if
          86             :
          87           0 :     q = 0.0_r8 ! Make sure we start fresh (insurance)
          88             :
          89           0 :     if (masterproc .and. verbose_use .and. notfound_use) then
          90           0 :        if (cnst_read_iv(m_cnst)) then
          91           0 :           write(iulog, *) 'Field ',trim(trim(name)),' not found on initial dataset'
          92             :        else
          93           0 :           write(iulog, *) 'Field ',trim(trim(name)),' not read from initial dataset'
          94             :        end if
          95             :     end if
          96             :
          97           0 :     if (aoa_tracers_implements_cnst(trim(name))) then
          98           0 :       call aoa_tracers_init_cnst(trim(name), latvals, lonvals, mask_use, q)
          99           0 :       if(masterproc .and. verbose_use) then
         100           0 :         write(iulog,*) '          ', trim(name), ' initialized by "aoa_tracers_init_cnst"'
         101             :       end if
         102           0 :     else if (carma_implements_cnst(trim(name))) then
         103           0 :       call carma_init_cnst(trim(name), latvals, lonvals, mask_use, q)
         104           0 :       if(masterproc .and. verbose_use) then
         105           0 :         write(iulog,*) '          ', trim(name), ' initialized by "carma_init_cnst"'
         106             :       end if
         107           0 :     else if (chem_implements_cnst(trim(name))) then
         108           0 :       call chem_init_cnst(trim(name), latvals, lonvals, mask_use, q)
         109           0 :       if(masterproc .and. verbose_use) then
         110           0 :         write(iulog,*) '          ', trim(name), ' initialized by "chem_init_cnst"'
         111             :       end if
         112           0 :     else if (clubb_implements_cnst(trim(name))) then
         113           0 :       call clubb_init_cnst(trim(name), latvals, lonvals, mask_use, q)
         114           0 :       if(masterproc .and. verbose_use) then
         115           0 :         write(iulog,*) '          ', trim(name), ' initialized by "clubb_init_cnst"'
         116             :       end if
         117           0 :     else if (co2_implements_cnst(trim(name))) then
         118           0 :       call co2_init_cnst(trim(name), latvals, lonvals, mask_use, q)
         119           0 :       if(masterproc .and. verbose_use) then
         120           0 :         write(iulog,*) '          ', trim(name), ' initialized by "co2_init_cnst"'
         121             :       end if
         122           0 :     else if (microp_driver_implements_cnst(trim(name))) then
         123           0 :       call microp_driver_init_cnst(trim(name), latvals, lonvals, mask_use, q)
         124           0 :       if(masterproc .and. verbose_use) then
         125           0 :         write(iulog,*) '          ', trim(name), ' initialized by "microp_driver_init_cnst"'
         126             :       end if
         127           0 :     else if (rk_stratiform_implements_cnst(trim(name))) then
         128           0 :       call rk_stratiform_init_cnst(trim(name), latvals, lonvals, mask_use, q)
         129           0 :       if(masterproc .and. verbose_use) then
         130           0 :         write(iulog,*) '          ', trim(name), ' initialized by "rk_stratiform_init_cnst"'
         131             :       end if
         132           0 :     else if (tracers_implements_cnst(trim(name))) then
         133           0 :       call tracers_init_cnst(trim(name), latvals, lonvals, mask_use, q, z=z)
         134           0 :       if(masterproc .and. verbose_use) then
         135           0 :         write(iulog,*) '          ', trim(name), ' initialized by "tracers_init_cnst"'
         136             :       end if
         137           0 :     else if (unicon_implements_cnst(trim(name))) then
         138           0 :       call unicon_init_cnst(trim(name), latvals, lonvals, mask_use, q)
         139           0 :       if(masterproc .and. verbose_use) then
         140           0 :         write(iulog,*) '          ', trim(name), ' initialized by "unicon_init_cnst"'
         141             :       end if
         142             :     else
         143           0 :       if(masterproc .and. verbose_use) then
         144           0 :         write(iulog,*) '          ', trim(name), ' set to minimum value'
         145             :       end if
         146             :       ! Q already set to zero
         147             :     end if
         148             :
         149           0 :   end subroutine cnst_init_default_col
         150             :
         151           0 :   subroutine cnst_init_default_cblock(m_cnst, latvals, lonvals, q, mask)
         152             :
         153             :     !-----------------------------------------------------------------------
         154             :     !
         155             :     ! Purpose: initialize named tracer mixing ratio field
         156             :     !  This subroutine should be called ONLY at the beginning of an initial run
         157             :     !
         158             :     !-----------------------------------------------------------------------
         159             :
         160             :     ! Dummy arguments
         161             :     integer,           intent(in)  :: m_cnst     ! Constant index
         162             :     real(r8),          intent(in)  :: latvals(:) ! lat in degrees (ncol*blk)
         163             :     real(r8),          intent(in)  :: lonvals(:) ! lon in degrees (ncol*blk)
         164             :     real(r8),          intent(out) :: q(:,:,:)   ! mix ratio (ncol, plev, blk)
         165             :     logical, optional, intent(in)  :: mask(:)    ! Only initialize where .true.
         166             :
         167             :     ! Local variables
         168           0 :     real(r8), allocatable         :: latblk(:)
         169             :     integer                       :: i, bbeg, bend
         170             :     integer                       :: size1, size2, size3
         171             :     integer                       :: nblks, blksize
         172             :     logical                       :: verbose
         173             :
         174           0 :     verbose = .true.
         175           0 :     size1 = size(q, 1)
         176           0 :     size2 = size(q, 2)
         177           0 :     size3 = size(q, 3)
         178           0 :     if ((size(latvals) == size1*size3) .and. (size(lonvals) == size1*size3)) then
         179             :       ! Case: unstructured with blocks in 3rd dim
         180           0 :       nblks = size3
         181             :       blksize = size1
         182             :       bend = 0
         183           0 :       do i = 1, nblks
         184           0 :         bbeg = bend + 1
         185           0 :         bend = bbeg + blksize - 1
         186           0 :         if (present(mask)) then
         187           0 :           if (size(mask) /= size(latvals)) then
         188           0 :             call endrun('cnst_init_default_cblock: incorrect mask size')
         189             :           end if
         190           0 :           call cnst_init_default(m_cnst, latvals(bbeg:bend), lonvals(bbeg:bend), q(:,:,i), mask=mask(bbeg:bend), verbose=verbose)
         191             :         else
         192           0 :           call cnst_init_default(m_cnst, latvals(bbeg:bend), lonvals(bbeg:bend), q(:,:,i), verbose=verbose)
         193             :         end if
         194           0 :         verbose = .false.
         195             :       end do
         196           0 :     else if ((size(latvals) == size2) .and. (size(lonvals) == size1)) then
         197             :       ! Case: lon,lat,lev
         198           0 :       if (present(mask)) then
         199           0 :         call endrun('cnst_init_default_cblock: mask not supported for lon/lat')
         200             :       else
         201           0 :         nblks = size2
         202           0 :         allocate(latblk(size1))
         203           0 :         do i = 1, nblks
         204           0 :           latblk(:) = latvals(i)
         205           0 :           call cnst_init_default(m_cnst, latblk, lonvals, q(:,i,:), verbose=verbose)
         206           0 :           verbose = .false.
         207             :         end do
         208           0 :         deallocate(latblk)
         209             :       end if
         210           0 :     else if ((size(latvals) == size3) .and. (size(lonvals) == size1)) then
         211             :       ! Case: lon,lev,lat
         212           0 :       if (present(mask)) then
         213           0 :         call endrun('cnst_init_default_cblock: mask not supported for lon/lat')
         214             :       else
         215           0 :         nblks = size3
         216           0 :         allocate(latblk(size1))
         217           0 :         do i = 1, nblks
         218           0 :           latblk(:) = latvals(i)
         219           0 :           call cnst_init_default(m_cnst, latblk, lonvals, q(:,:,i), verbose=verbose)
         220           0 :           verbose = .false.
         221             :         end do
         222           0 :         deallocate(latblk)
         223             :       end if
         224             :     else
         225           0 :       call endrun('cnst_init_default_cblock: Unknown q layout')
         226             :     end if
         227             :
         228           0 :   end subroutine cnst_init_default_cblock
         229             :
         230             : end module const_init

Generated by: LCOV version 1.14