Line data Source code
1 : 2 : module constituent_burden 3 : 4 : !----------------------------------------------------------------------------------------- 5 : ! Purpose: subroutines to generate constituent burden history variables 6 : ! 7 : ! Revision history: 8 : ! 2005-12-21 K. Lindsay Original version 9 : !----------------------------------------------------------------------------------------- 10 : 11 : use constituents, only: pcnst 12 : 13 : implicit none 14 : 15 : ! Public interfaces 16 : 17 : public constituent_burden_init 18 : public constituent_burden_comp 19 : 20 : private 21 : 22 : character(len=18) :: burdennam(pcnst) ! name of burden history variables 23 : 24 : save 25 : 26 : !========================================================================================= 27 : 28 : contains 29 : 30 : !========================================================================================= 31 : 32 1496904 : subroutine constituent_burden_init 33 : 34 : use cam_history, only: addfld, horiz_only 35 : use constituents, only: cnst_name 36 : 37 : integer :: m 38 : 39 4608 : do m = 2, pcnst 40 3072 : burdennam(m) = 'TM'//cnst_name(m) 41 : call addfld (burdennam(m), horiz_only, 'A', 'kg/m2', & 42 4608 : trim(cnst_name(m)) // ' column burden') 43 : end do 44 : 45 1536 : end subroutine constituent_burden_init 46 : 47 : !========================================================================================= 48 : 49 1495368 : subroutine constituent_burden_comp(state) 50 : 51 1536 : use physics_types, only: physics_state 52 : use shr_kind_mod, only: r8 => shr_kind_r8 53 : use constituents, only: cnst_type 54 : use ppgrid, only: pcols 55 : use physconst, only: rga 56 : use cam_history, only: outfld, hist_fld_active 57 : 58 : !----------------------------------------------------------------------- 59 : ! 60 : ! Arguments 61 : ! 62 : type(physics_state), intent(inout) :: state 63 : ! 64 : !---------------------------Local workspace----------------------------- 65 : 66 : real(r8) :: ftem(pcols) ! temporary workspace 67 : 68 : integer :: m, lchnk, ncol 69 : 70 1495368 : lchnk = state%lchnk 71 1495368 : ncol = state%ncol 72 : 73 4486104 : do m = 2, pcnst 74 2990736 : if (.not. hist_fld_active(burdennam(m))) cycle 75 0 : if (cnst_type(m) .eq. 'dry') then 76 0 : ftem(:ncol) = sum(state%q(:ncol,:,m) * state%pdeldry(:ncol,:), dim=2) * rga 77 : else 78 0 : ftem(:ncol) = sum(state%q(:ncol,:,m) * state%pdel(:ncol,:), dim=2) * rga 79 : endif 80 4486104 : call outfld (burdennam(m), ftem, pcols, lchnk) 81 : end do 82 : 83 1495368 : end subroutine constituent_burden_comp 84 : 85 : !========================================================================================= 86 : 87 : end module constituent_burden 88 :