LCOV - code coverage report
Current view: | top level - dynamics/se - stepon.F90 (source / functions) |  |  | Hit | Total | Coverage
Test: | coverage.info |  | Lines: | 100 | 220 | 45.5 %
Date: | 2024-12-17 17:57:11 |  | Functions: | 6 | 6 | 100.0 %

              Line data    Source code
           1             : module stepon
           2             :
           3             : use shr_kind_mod,   only: r8 => shr_kind_r8
           4             : use spmd_utils,     only: iam, mpicom, masterproc
           5             : use ppgrid,         only: begchunk, endchunk
           6             :
           7             : use physics_types,  only: physics_state, physics_tend
           8             : use dyn_comp,       only: dyn_import_t, dyn_export_t
           9             :
          10             : use perf_mod,       only: t_startf, t_stopf, t_barrierf
          11             : use cam_abortutils, only: endrun
          12             :
          13             : use parallel_mod,   only: par
          14             : use dimensions_mod, only: np, npsq, nlev, nelemd
          15             :
          16             : use aerosol_properties_mod, only: aerosol_properties
          17             : use aerosol_state_mod,      only: aerosol_state
          18             : use microp_aero,            only: aerosol_state_object, aerosol_properties_object
          19             : use scamMod,                only: use_iop, doiopupdate, single_column, &
          20             :                                   setiopupdate, readiopdata
          21             : use se_single_column_mod,   only: scm_setfield, iop_broadcast
          22             : use dyn_grid,               only: hvcoord
          23             : use time_manager,           only: get_step_size, is_first_restart_step
          24             : use cam_history,            only: outfld, write_camiop, addfld, add_default, horiz_only
          25             : use cam_history,            only: write_inithist, hist_fld_active, fieldname_len
          26             :
          27             : implicit none
          28             : private
          29             : save
          30             :
          31             : public stepon_init
          32             : public stepon_run1
          33             : public stepon_run2
          34             : public stepon_run3
          35             : public stepon_final
          36             :
          37             : class(aerosol_properties), pointer :: aero_props_obj => null()
          38             : logical :: aerosols_transported = .false.
          39             : logical :: iop_update_phase1
          40             :
          41             : !=========================================================================================
          42             : contains
          43             : !=========================================================================================
          44             :
          45      372480 : subroutine stepon_init(dyn_in, dyn_out )
          46             :
          47             :    use constituents,   only: pcnst, cnst_name, cnst_longname
          48             :    use dimensions_mod, only: fv_nphys, cnst_name_gll, cnst_longname_gll, qsize
          49             :
          50             :    ! arguments
          51             :    type (dyn_import_t), intent(inout) :: dyn_in  ! Dynamics import container
          52             :    type (dyn_export_t), intent(inout) :: dyn_out ! Dynamics export container
          53             :
          54             :    ! local variables
          55             :    integer :: m, m_cnst
          56             :    !----------------------------------------------------------------------------
          57             :    ! These fields on dynamics grid are output before the call to d_p_coupling.
          58       10752 :    do m_cnst = 1, qsize
          59           0 :      call addfld(trim(cnst_name_gll(m_cnst))//'_gll',  (/ 'lev' /), 'I', 'kg/kg',   &
          60       18432 :           trim(cnst_longname_gll(m_cnst)), gridname='GLL')
          61           0 :      call addfld(trim(cnst_name_gll(m_cnst))//'dp_gll',  (/ 'lev' /), 'I', 'kg/kg',   &
          62       19968 :           trim(cnst_longname_gll(m_cnst))//'*dp', gridname='GLL')
          63             :    end do
          64        3072 :    call addfld('U_gll'     ,(/ 'lev' /), 'I', 'm/s ','U wind on gll grid',gridname='GLL')
          65        3072 :    call addfld('V_gll'     ,(/ 'lev' /), 'I', 'm/s ','V wind on gll grid',gridname='GLL')
          66        3072 :    call addfld('T_gll'     ,(/ 'lev' /), 'I', 'K '  ,'T on gll grid'     ,gridname='GLL')
          67        3072 :    call addfld('dp_ref_gll' ,(/ 'lev' /), 'I', '  '  ,'dp dry / dp_ref on gll grid'     ,gridname='GLL')
          68        1536 :    call addfld('PSDRY_gll' ,horiz_only , 'I', 'Pa ' ,'psdry on gll grid' ,gridname='GLL')
          69        1536 :    call addfld('PS_gll'    ,horiz_only , 'I', 'Pa ' ,'ps on gll grid'    ,gridname='GLL')
          70        1536 :    call addfld('PHIS_gll'  ,horiz_only , 'I', 'Pa ' ,'PHIS on gll grid'  ,gridname='GLL')
          71             :
          72             :    ! Fields for initial condition files
          73        3072 :    call addfld('U&IC',   (/ 'lev' /),  'I', 'm/s', 'Zonal wind',     gridname='GLL' )
          74        3072 :    call addfld('V&IC',   (/ 'lev' /),  'I', 'm/s', 'Meridional wind',gridname='GLL' )
          75             :    ! Don't need to register U&IC V&IC as vector components since we don't interpolate IC files
          76        1536 :    call add_default('U&IC',0, 'I')
          77        1536 :    call add_default('V&IC',0, 'I')
          78             :
          79        1536 :    call addfld('PS&IC', horiz_only,  'I', 'Pa', 'Surface pressure',       gridname='GLL')
          80        3072 :    call addfld('T&IC',  (/ 'lev' /), 'I', 'K',  'Temperature',            gridname='GLL')
          81        1536 :    call add_default('PS&IC', 0, 'I')
          82        1536 :    call add_default('T&IC',  0, 'I')
          83             :
          84       18432 :    do m_cnst = 1,pcnst
          85       16896 :       call addfld(trim(cnst_name(m_cnst))//'&IC', (/ 'lev' /), 'I', 'kg/kg', &
          86       50688 :                   trim(cnst_longname(m_cnst)), gridname='GLL')
          87       18432 :       call add_default(trim(cnst_name(m_cnst))//'&IC', 0, 'I')
          88             :    end do
          89             :
          90             :    ! get aerosol properties
          91        1536 :    aero_props_obj => aerosol_properties_object()
          92             :
          93        1536 :    if (associated(aero_props_obj)) then
          94             :       ! determine if there are transported aerosol contistuents
          95           0 :       aerosols_transported = aero_props_obj%number_transported()>0
          96             :    end if
          97             :
          98        1536 : end subroutine stepon_init
          99             :
         100             : !=========================================================================================
         101             :
         102      741888 : subroutine stepon_run1( dtime_out, phys_state, phys_tend,               &
         103             :                         pbuf2d, dyn_in, dyn_out )
         104             :
         105             :    use dp_coupling,    only: d_p_coupling
         106             :    use physics_buffer, only: physics_buffer_desc
         107             :
         108             :    use se_dyn_time_mod,only: tstep                    ! dynamics timestep
         109             :
         110             :    real(r8),             intent(out)   :: dtime_out   ! Time-step
         111             :    type(physics_state),  intent(inout) :: phys_state(begchunk:endchunk)
         112             :    type(physics_tend),   intent(inout) :: phys_tend(begchunk:endchunk)
         113             :    type (dyn_import_t),  intent(inout) :: dyn_in  ! Dynamics import container
         114             :    type (dyn_export_t),  intent(inout) :: dyn_out ! Dynamics export container
         115             :    type (physics_buffer_desc), pointer :: pbuf2d(:,:)
         116             :    !----------------------------------------------------------------------------
         117             :
         118             :    integer :: c
         119             :    class(aerosol_state), pointer :: aero_state_obj
         120      370944 :    nullify(aero_state_obj)
         121             :
         122      370944 :    dtime_out = get_step_size()
         123             :
         124      370944 :    if (iam < par%nprocs) then
         125      370944 :       if (tstep <= 0)      call endrun('stepon_run1: bad tstep')
         126      370944 :       if (dtime_out <= 0)  call endrun('stepon_run1: bad dtime')
         127             :
         128             :       ! write diagnostic fields on gll grid and initial file
         129      370944 :       call diag_dynvar_ic(dyn_out%elem, dyn_out%fvm)
         130             :    end if
         131             :
         132             :    ! Determine whether it is time for an IOP update;
         133             :    ! doiopupdate set to true if model time step > next available IOP
         134             :
         135             :
         136      370944 :    if (use_iop .and. masterproc) then
         137           0 :        call setiopupdate
         138             :    end if
         139             :
         140      370944 :    if (single_column) then
         141             :
         142             :      ! If first restart step then ensure that IOP data is read
         143           0 :      if (is_first_restart_step()) then
         144           0 :         if (masterproc) call readiopdata( hvcoord%hyam, hvcoord%hybm, hvcoord%hyai, hvcoord%hybi, hvcoord%ps0  )
         145           0 :         call iop_broadcast()
         146             :      endif
         147             :
         148           0 :      iop_update_phase1 = .true.
         149           0 :      if ((is_first_restart_step() .or. doiopupdate) .and. masterproc) then
         150           0 :         call readiopdata( hvcoord%hyam, hvcoord%hybm, hvcoord%hyai, hvcoord%hybi, hvcoord%ps0  )
         151             :      endif
         152           0 :      call iop_broadcast()
         153             :
         154           0 :      call scm_setfield(dyn_out%elem,iop_update_phase1)
         155             :    endif
         156             :
         157      370944 :    call t_barrierf('sync_d_p_coupling', mpicom)
         158      370944 :    call t_startf('d_p_coupling')
         159             :    ! Move data into phys_state structure.
         160      370944 :    call d_p_coupling(phys_state, phys_tend,  pbuf2d, dyn_out )
         161      370944 :    call t_stopf('d_p_coupling')
         162             :
         163             :    !----------------------------------------------------------
         164             :    ! update aerosol state object from CAM physics state constituents
         165             :    !----------------------------------------------------------
         166      370944 :    if (aerosols_transported) then
         167             :
         168           0 :       do c = begchunk,endchunk
         169           0 :          aero_state_obj => aerosol_state_object(c)
         170             :          ! pass number mass or number mixing ratios of aerosol constituents
         171             :          ! to aerosol state object
         172           0 :          call aero_state_obj%set_transported(phys_state(c)%q)
         173             :       end do
         174             :
         175             :    end if
         176             :
         177      370944 : end subroutine stepon_run1
         178             :
         179             : !=========================================================================================
         180             :
         181      738816 : subroutine stepon_run2(phys_state, phys_tend, dyn_in, dyn_out)
         182             :
         183      370944 :    use dp_coupling,            only: p_d_coupling
         184             :    use dyn_grid,               only: TimeLevel
         185             :
         186             :    use se_dyn_time_mod,        only: TimeLevel_Qdp
         187             :    use control_mod,            only: qsplit
         188             :    use prim_advance_mod,       only: tot_energy_dyn
         189             :
         190             :
         191             :    ! arguments
         192             :    type(physics_state), intent(inout) :: phys_state(begchunk:endchunk)
         193             :    type(physics_tend),  intent(inout) :: phys_tend(begchunk:endchunk)
         194             :    type (dyn_import_t), intent(inout) :: dyn_in  ! Dynamics import container
         195             :    type (dyn_export_t), intent(inout) :: dyn_out ! Dynamics export container
         196             :
         197             :    ! local variables
         198             :    integer :: tl_f, tl_fQdp
         199             :
         200             :    integer :: c
         201             :    class(aerosol_state), pointer :: aero_state_obj
         202             :
         203             :    !----------------------------------------------------------------------------
         204             :
         205      369408 :    tl_f = TimeLevel%n0   ! timelevel which was adjusted by physics
         206      369408 :    call TimeLevel_Qdp(TimeLevel, qsplit, tl_fQdp)
         207             :
         208             :    !----------------------------------------------------------
         209             :    ! update physics state with aerosol constituents
         210             :    !----------------------------------------------------------
         211      369408 :    nullify(aero_state_obj)
         212             :
         213      369408 :    if (aerosols_transported) then
         214           0 :       do c = begchunk,endchunk
         215           0 :          aero_state_obj => aerosol_state_object(c)
         216             :          ! get mass or number mixing ratios of aerosol constituents
         217           0 :          call aero_state_obj%get_transported(phys_state(c)%q)
         218             :       end do
         219             :    end if
         220             :
         221      369408 :    call t_barrierf('sync_p_d_coupling', mpicom)
         222      369408 :    call t_startf('p_d_coupling')
         223             :    ! copy from phys structures -> dynamics structures
         224      369408 :    call p_d_coupling(phys_state, phys_tend, dyn_in, tl_f, tl_fQdp)
         225      369408 :    call t_stopf('p_d_coupling')
         226             :
         227      369408 :    if (iam < par%nprocs) then
         228      369408 :       call tot_energy_dyn(dyn_in%elem,dyn_in%fvm, 1, nelemd, tl_f, tl_fQdp,'dED')
         229             :    end if
         230             :
         231      369408 : end subroutine stepon_run2
         232             :
         233             : !=========================================================================================
         234             :
         235      369408 : subroutine stepon_run3(dtime, cam_out, phys_state, dyn_in, dyn_out)
         236             :
         237      369408 :    use camsrfexch,     only: cam_out_t
         238             :    use dyn_comp,       only: dyn_run
         239             :    use advect_tend,    only: compute_adv_tends_xyz, compute_write_iop_fields
         240             :    use dyn_grid,       only: TimeLevel
         241             :    use se_dyn_time_mod,only: TimeLevel_Qdp
         242             :    use control_mod,    only: qsplit
         243             :    use constituents,   only: pcnst, cnst_name
         244             :
         245             :    ! arguments
         246             :    real(r8),            intent(in)    :: dtime   ! Time-step
         247             :    type(cam_out_t),     intent(inout) :: cam_out(:) ! Output from CAM to surface
         248             :    type(physics_state), intent(inout) :: phys_state(begchunk:endchunk)
         249             :    type (dyn_import_t), intent(inout) :: dyn_in  ! Dynamics import container
         250             :    type (dyn_export_t), intent(inout) :: dyn_out ! Dynamics export container
         251             :
         252             :    integer :: tl_f, tl_fQdp
         253             :    !--------------------------------------------------------------------------------------
         254             :
         255      369408 :    if (single_column) then
         256             :       ! Update IOP properties e.g. omega, divT, divQ
         257           0 :       iop_update_phase1 = .false.
         258           0 :       if (doiopupdate) then
         259           0 :          if (masterproc) call readiopdata( hvcoord%hyam, hvcoord%hybm, hvcoord%hyai, hvcoord%hybi, hvcoord%ps0  )
         260           0 :          call iop_broadcast()
         261           0 :          call scm_setfield(dyn_out%elem,iop_update_phase1)
         262             :       endif
         263             :    endif
         264             :
         265      369408 :    call t_startf('comp_adv_tends1')
         266      369408 :    tl_f = TimeLevel%n0
         267      369408 :    call TimeLevel_Qdp(TimeLevel, qsplit, tl_fQdp)
         268      369408 :    call compute_adv_tends_xyz(dyn_in%elem,dyn_in%fvm,1,nelemd,tl_fQdp,tl_f)
         269      369408 :    if (write_camiop) call compute_write_iop_fields(dyn_in%elem,dyn_in%fvm,1,nelemd,tl_fQdp,tl_f)
         270      369408 :    call t_stopf('comp_adv_tends1')
         271             :
         272      369408 :    call t_barrierf('sync_dyn_run', mpicom)
         273      369408 :    call t_startf('dyn_run')
         274      369408 :    call dyn_run(dyn_out)
         275      369408 :    call t_stopf('dyn_run')
         276             :
         277      369408 :    call t_startf('comp_adv_tends2')
         278      369408 :    tl_f = TimeLevel%n0
         279      369408 :    call TimeLevel_Qdp(TimeLevel, qsplit, tl_fQdp)
         280      369408 :    call compute_adv_tends_xyz(dyn_in%elem,dyn_in%fvm,1,nelemd,tl_fQdp,tl_f)
         281      369408 :    if (write_camiop) call compute_write_iop_fields(dyn_in%elem,dyn_in%fvm,1,nelemd,tl_fQdp,tl_f)
         282      369408 :    call t_stopf('comp_adv_tends2')
         283             :
         284      369408 : end subroutine stepon_run3
         285             :
         286             : !=========================================================================================
         287             :
         288        1536 : subroutine stepon_final(dyn_in, dyn_out)
         289             :
         290             :    type (dyn_import_t), intent(inout) :: dyn_in  ! Dynamics import container
         291             :    type (dyn_export_t), intent(inout) :: dyn_out ! Dynamics export container
         292             :
         293      369408 : end subroutine stepon_final
         294             :
         295             : !=========================================================================================
         296             :
         297      370944 : subroutine diag_dynvar_ic(elem, fvm)
         298             :    use constituents,           only: cnst_type
         299             :    use dyn_grid,               only: TimeLevel
         300             :
         301             :    use se_dyn_time_mod,        only: TimeLevel_Qdp   !  dynamics typestep
         302             :    use control_mod,            only: qsplit
         303             :    use hybrid_mod,             only: config_thread_region, get_loop_ranges
         304             :    use hybrid_mod,             only: hybrid_t
         305             :    use dimensions_mod,         only: np, npsq, nc, nhc, fv_nphys, qsize, ntrac, nlev
         306             :    use dimensions_mod,         only: cnst_name_gll
         307             :    use constituents,           only: cnst_name
         308             :    use element_mod,            only: element_t
         309             :    use fvm_control_volume_mod, only: fvm_struct
         310             :    use fvm_mapping,            only: fvm2dyn
         311             :    use cam_thermo,             only: get_sum_species, get_dp_ref, get_ps
         312             :    use air_composition,        only: thermodynamic_active_species_idx
         313             :    use air_composition,        only: thermodynamic_active_species_idx_dycore
         314             :    use hycoef,                 only: hyai, hybi, ps0
         315             :    ! arguments
         316             :    type(element_t) , intent(in)    :: elem(1:nelemd)
         317             :    type(fvm_struct), intent(inout) :: fvm(:)
         318             :
         319             :    ! local variables
         320             :    integer              :: ie, i, j, k, m, m_cnst, nq
         321             :    integer              :: tl_f, tl_qdp
         322             :    character(len=fieldname_len) :: tfname
         323             :
         324             :    type(hybrid_t)        :: hybrid
         325             :    integer               :: nets, nete
         326      370944 :    real(r8), allocatable :: ftmp(:,:,:)
         327      370944 :    real(r8), allocatable :: fld_fvm(:,:,:,:,:), fld_gll(:,:,:,:,:)
         328      370944 :    real(r8), allocatable :: fld_2d(:,:)
         329             :    logical               :: llimiter(1)
         330             :    real(r8)              :: qtmp(np,np,nlev), dp_ref(np,np,nlev), ps_ref(np,np)
         331      370944 :    real(r8), allocatable :: factor_array(:,:,:)
         332             :    integer               :: astat
         333             :    character(len=*), parameter :: prefix = 'diag_dynvar_ic: '
         334             :    !----------------------------------------------------------------------------
         335             :
         336      370944 :    tl_f = timelevel%n0
         337      370944 :    call TimeLevel_Qdp(TimeLevel, qsplit, tl_Qdp)
         338             :
         339      370944 :    allocate(ftmp(npsq,nlev,2))
         340             :
         341             :    ! Output tracer fields for analysis of advection schemes
         342     2596608 :    do m_cnst = 1, qsize
         343     2225664 :      tfname = trim(cnst_name_gll(m_cnst))//'_gll'
         344     2596608 :      if (hist_fld_active(tfname)) then
         345           0 :        do ie = 1, nelemd
         346           0 :          qtmp(:,:,:) =  elem(ie)%state%Qdp(:,:,:,m_cnst,tl_qdp)/&
         347           0 :               elem(ie)%state%dp3d(:,:,:,tl_f)
         348           0 :          do j = 1, np
         349           0 :            do i = 1, np
         350           0 :              ftmp(i+(j-1)*np,:,1) = elem(ie)%state%Qdp(i,j,:,m_cnst,tl_qdp)/&
         351           0 :                   elem(ie)%state%dp3d(i,j,:,tl_f)
         352             :            end do
         353             :          end do
         354           0 :          call outfld(tfname, ftmp(:,:,1), npsq, ie)
         355             :        end do
         356             :      end if
         357             :    end do
         358             :
         359     2596608 :    do m_cnst = 1, qsize
         360     2225664 :      tfname = trim(cnst_name_gll(m_cnst))//'dp_gll'
         361     2596608 :      if (hist_fld_active(tfname)) then
         362           0 :        do ie = 1, nelemd
         363           0 :          do j = 1, np
         364           0 :            do i = 1, np
         365           0 :              ftmp(i+(j-1)*np,:,1) = elem(ie)%state%Qdp(i,j,:,m_cnst,tl_qdp)
         366             :            end do
         367             :          end do
         368           0 :          call outfld(tfname, ftmp(:,:,1), npsq, ie)
         369             :        end do
         370             :      end if
         371             :     end do
         372             :
         373      370944 :    if (hist_fld_active('U_gll') .or. hist_fld_active('V_gll')) then
         374           0 :       do ie = 1, nelemd
         375           0 :          do j = 1, np
         376           0 :             do i = 1, np
         377           0 :                ftmp(i+(j-1)*np,:,1) = elem(ie)%state%v(i,j,1,:,tl_f)
         378           0 :                ftmp(i+(j-1)*np,:,2) = elem(ie)%state%v(i,j,2,:,tl_f)
         379             :             end do
         380             :          end do
         381           0 :          call outfld('U_gll', ftmp(:,:,1), npsq, ie)
         382           0 :          call outfld('V_gll', ftmp(:,:,2), npsq, ie)
         383             :       end do
         384             :    end if
         385             :
         386      370944 :    if (hist_fld_active('T_gll')) then
         387           0 :       do ie = 1, nelemd
         388           0 :          do j = 1, np
         389           0 :             do i = 1, np
         390           0 :                ftmp(i+(j-1)*np,:,1) = elem(ie)%state%T(i,j,:,tl_f)
         391             :             end do
         392             :          end do
         393           0 :          call outfld('T_gll', ftmp(:,:,1), npsq, ie)
         394             :       end do
         395             :    end if
         396             :
         397      370944 :    if (hist_fld_active('dp_ref_gll')) then
         398           0 :      do ie = 1, nelemd
         399           0 :        call get_dp_ref(hyai, hybi, ps0, elem(ie)%state%phis(:,:), dp_ref(:,:,:), ps_ref(:,:))
         400           0 :          do j = 1, np
         401           0 :             do i = 1, np
         402           0 :                ftmp(i+(j-1)*np,:,1) = elem(ie)%state%dp3d(i,j,:,tl_f)/dp_ref(i,j,:)
         403             :             end do
         404             :          end do
         405           0 :          call outfld('dp_ref_gll', ftmp(:,:,1), npsq, ie)
         406             :       end do
         407             :    end if
         408             :
         409      370944 :    if (hist_fld_active('PSDRY_gll')) then
         410           0 :       do ie = 1, nelemd
         411           0 :          do j = 1, np
         412           0 :             do i = 1, np
         413           0 :                ftmp(i+(j-1)*np,1,1) = elem(ie)%state%psdry(i,j)
         414             :             end do
         415             :          end do
         416           0 :          call outfld('PSDRY_gll', ftmp(:,1,1), npsq, ie)
         417             :       end do
         418             :    end if
         419             :
         420      370944 :    if (hist_fld_active('PS_gll')) then
         421           0 :      allocate(fld_2d(np,np))
         422           0 :      do ie = 1, nelemd
         423           0 :        call get_ps(elem(ie)%state%Qdp(:,:,:,:,tl_Qdp), thermodynamic_active_species_idx_dycore,&
         424           0 :             elem(ie)%state%dp3d(:,:,:,tl_f),fld_2d,hyai(1)*ps0)
         425           0 :          do j = 1, np
         426           0 :             do i = 1, np
         427           0 :               ftmp(i+(j-1)*np,1,1) = fld_2d(i,j)
         428             :             end do
         429             :          end do
         430           0 :          call outfld('PS_gll', ftmp(:,1,1), npsq, ie)
         431             :        end do
         432           0 :        deallocate(fld_2d)
         433             :    end if
         434             :
         435      370944 :    if (hist_fld_active('PHIS_gll')) then
         436           0 :       do ie = 1, nelemd
         437           0 :          call outfld('PHIS_gll', RESHAPE(elem(ie)%state%phis, (/np*np/)), np*np, ie)
         438             :       end do
         439             :    end if
         440             :
         441      370944 :    if (write_inithist()) then
         442           0 :       allocate(fld_2d(np,np))
         443           0 :       do ie = 1, nelemd
         444           0 :          call get_ps(elem(ie)%state%Qdp(:,:,:,:,tl_Qdp), thermodynamic_active_species_idx_dycore,&
         445           0 :               elem(ie)%state%dp3d(:,:,:,tl_f),fld_2d,hyai(1)*ps0)
         446           0 :          do j = 1, np
         447           0 :             do i = 1, np
         448           0 :                ftmp(i+(j-1)*np,1,1) = fld_2d(i,j)
         449             :             end do
         450             :          end do
         451           0 :          call outfld('PS&IC', ftmp(:,1,1), npsq, ie)
         452             :       end do
         453           0 :       deallocate(fld_2d)
         454             :    endif
         455             :
         456      370944 :    deallocate(ftmp)
         457             :
         458      370944 :    if (write_inithist()) then
         459             :
         460           0 :       if (fv_nphys < 1) then
         461           0 :          allocate(factor_array(np,np,nlev),stat=astat)
         462           0 :          if (astat /= 0) call endrun(prefix//"Allocate factor_array failed")
         463             :       endif
         464             :
         465           0 :       do ie = 1, nelemd
         466           0 :          call outfld('T&IC', RESHAPE(elem(ie)%state%T(:,:,:,tl_f),   (/npsq,nlev/)), npsq, ie)
         467           0 :          call outfld('U&IC', RESHAPE(elem(ie)%state%v(:,:,1,:,tl_f), (/npsq,nlev/)), npsq, ie)
         468           0 :          call outfld('V&IC', RESHAPE(elem(ie)%state%v(:,:,2,:,tl_f), (/npsq,nlev/)), npsq, ie)
         469             :
         470           0 :          if (fv_nphys < 1) then
         471           0 :             call get_sum_species(elem(ie)%state%Qdp(:,:,:,:,tl_qdp), &
         472           0 :                  thermodynamic_active_species_idx_dycore, factor_array,dp_dry=elem(ie)%state%dp3d(:,:,:,tl_f))
         473           0 :             factor_array(:,:,:) = 1.0_r8/factor_array(:,:,:)
         474           0 :             do m_cnst = 1, qsize
         475           0 :                if (cnst_type(m_cnst) == 'wet') then
         476             :                   call outfld(trim(cnst_name(m_cnst))//'&IC', &
         477           0 :                        RESHAPE(factor_array(:,:,:)*elem(ie)%state%Qdp(:,:,:,m_cnst,tl_qdp)/&
         478           0 :                        elem(ie)%state%dp3d(:,:,:,tl_f), (/npsq,nlev/)), npsq, ie)
         479             :                else
         480             :                   call outfld(trim(cnst_name(m_cnst))//'&IC', &
         481           0 :                        RESHAPE(elem(ie)%state%Qdp(:,:,:,m_cnst,tl_qdp)/&
         482           0 :                        elem(ie)%state%dp3d(:,:,:,tl_f), (/npsq,nlev/)), npsq, ie)
         483             :                end if
         484             :             end do
         485             :          end if
         486             :       end do
         487             :
         488           0 :       if (fv_nphys > 0) then
         489             :          !JMD $OMP PARALLEL NUM_THREADS(horz_num_threads), DEFAULT(SHARED), PRIVATE(hybrid,nets,nete,n)
         490             :          !JMD        hybrid = config_thread_region(par,'horizontal')
         491           0 :          hybrid = config_thread_region(par,'serial')
         492           0 :          call get_loop_ranges(hybrid, ibeg=nets, iend=nete)
         493             :
         494           0 :          allocate(fld_fvm(1-nhc:nc+nhc,1-nhc:nc+nhc,nlev,1,nets:nete),stat=astat)
         495           0 :          if (astat /= 0) call endrun(prefix//"Allocate fld_fvm failed")
         496           0 :          allocate(fld_gll(np,np,nlev,1,nets:nete),stat=astat)
         497           0 :          if (astat /= 0) call endrun(prefix//"Allocate fld_gll failed")
         498           0 :          allocate(factor_array(nc,nc,nlev),stat=astat)
         499           0 :          if (astat /= 0) call endrun(prefix//"Allocate factor_array failed")
         500             :
         501           0 :          llimiter = .true.
         502             :
         503           0 :          do m_cnst = 1, ntrac
         504           0 :             do ie = nets, nete
         505             :
         506           0 :                call get_sum_species(fvm(ie)%c(1:nc,1:nc,:,:),thermodynamic_active_species_idx,factor_array)
         507           0 :                factor_array(:,:,:) = 1.0_r8/factor_array(:,:,:)
         508             :
         509           0 :                if (cnst_type(m_cnst) == 'wet') then
         510           0 :                   fld_fvm(1:nc,1:nc,:,1,ie) = fvm(ie)%c(1:nc,1:nc,:,m_cnst)*factor_array(:,:,:)
         511             :                else
         512           0 :                   fld_fvm(1:nc,1:nc,:,1,ie) = fvm(ie)%c(1:nc,1:nc,:,m_cnst)
         513             :                end if
         514             :             end do
         515             :
         516           0 :             call fvm2dyn(fld_fvm, fld_gll, hybrid, nets, nete, nlev, fvm(nets:nete), llimiter)
         517             :
         518           0 :             do ie = nets, nete
         519           0 :                call outfld(trim(cnst_name(m_cnst))//'&IC', &
         520           0 :                     RESHAPE(fld_gll(:,:,:,:,ie), (/npsq,nlev/)), npsq, ie)
         521             :             end do
         522             :          end do
         523             :
         524           0 :          deallocate(fld_fvm)
         525           0 :          deallocate(fld_gll)
         526             :       end if
         527             :
         528           0 :       deallocate(factor_array)
         529             :
         530             :    end if  ! if (write_inithist)
         531             :
         532      370944 : end subroutine diag_dynvar_ic
         533             :
         534             : !=========================================================================================
         535             :
         536             : end module stepon

Generated by: LCOV version 1.14