diff --git a/driver/fvGFS/atmosphere.F90 b/driver/fvGFS/atmosphere.F90 index d94c5ccc5..37f8bb64d 100644 --- a/driver/fvGFS/atmosphere.F90 +++ b/driver/fvGFS/atmosphere.F90 @@ -1938,6 +1938,10 @@ subroutine atmos_phys_driver_statein (IPD_Data, Atm_block,flip_vc) real(kind=kind_phys) :: pk0inv, ptop, pktop real(kind=kind_phys) :: rTv, dm, qgrs_rad integer :: nb, blen, npz, i, j, k, ix, k1, kz, dnats, nq_adv +#ifdef MULTI_GASES + real :: q_grs(nq), q_min +#endif + !!! NOTES: lmh 6nov15 !!! - "Layer" means "layer mean", ie. the average value in a layer @@ -1958,7 +1962,13 @@ subroutine atmos_phys_driver_statein (IPD_Data, Atm_block,flip_vc) !$OMP shared (Atm_block, Atm, IPD_Data, npz, nq, ncnst, sphum, liq_wat, & !$OMP ice_wat, rainwat, snowwat, graupel, pk0inv, ptop, & !$OMP pktop, zvir, mygrid, dnats, nq_adv, flip_vc) & +#ifdef MULTI_GASES + +!$OMP private (dm, nb, blen, i, j, ix, k1, kz, rTv, qgrs_rad, q_min, q_grs) + +#else !$OMP private (dm, nb, blen, i, j, ix, k1, kz, rTv, qgrs_rad) +#endif do nb = 1,Atm_block%nblks ! gas_phase_mass <-- prsl @@ -2065,7 +2075,9 @@ subroutine atmos_phys_driver_statein (IPD_Data, Atm_block,flip_vc) do i=1,blen ! Geo-potential at interfaces: #ifdef MULTI_GASES - rTv = rdgas*IPD_Data(nb)%Statein%tgrs(i,k)*virq_max(IPD_Data(nb)%Statein%qgrs(i,k,:),qmin) + q_grs(1:nq_adv) = IPD_Data(nb)%Statein%qgrs(i,k,1:nq_adv) + q_min = qmin + rTv = rdgas*IPD_Data(nb)%Statein%tgrs(i,k)*virq_max(q_grs(:),q_min) #else qgrs_rad = max(qmin,IPD_Data(nb)%Statein%qgrs(i,k,sphum)) rTv = rdgas*IPD_Data(nb)%Statein%tgrs(i,k)*(1.+zvir*qgrs_rad) diff --git a/model/fv_control.F90 b/model/fv_control.F90 index 1d01c5288..fa377579e 100644 --- a/model/fv_control.F90 +++ b/model/fv_control.F90 @@ -157,8 +157,7 @@ module fv_control_mod #ifdef MULTI_GASES use constants_mod, only: rvgas, cp_air use multi_gases_mod, only: multi_gases_init, & - rilist => ri, & - cpilist => cpi + read_namelist_multi_gases_nml #endif implicit none @@ -537,6 +536,10 @@ subroutine fv_control_init(Atm, dt_atmos, this_grid, grids_on_this_pe, p_split) #endif call read_namelist_fv_grid_nml call read_namelist_fv_core_nml(Atm(this_grid)) ! do options processing here too? +#ifdef MULTI_GASES + call read_namelist_multi_gases_nml(Atm(this_grid)%nml_filename, & + Atm(this_grid)%flagstruct%ncnst, Atm(this_grid)%flagstruct%nwat) +#endif call read_namelist_test_case_nml(Atm(this_grid)%nml_filename) call mpp_get_current_pelist(Atm(this_grid)%pelist, commID=commID) ! for commID call mp_start(commID,halo_update_type) @@ -1046,59 +1049,22 @@ subroutine read_namelist_fv_core_nml(Atm) do_uni_zfull, adj_mass_vmr, fac_n_spl, fhouri, update_blend, regional, bc_update_interval, & regional_bcs_from_gsi, write_restart_with_bcs, nrows_blend -#ifdef MULTI_GASES - namelist /multi_gases_nml/ rilist,cpilist -#endif #ifdef INTERNAL_FILE_NML ! Read FVCORE namelist read (input_nml_file,fv_core_nml,iostat=ios) ierr = check_nml_error(ios,'fv_core_nml') ! Reset input_file_nml to default behavior (CHECK do we still need this???) !call read_input_nml -#ifdef MULTI_GASES - if( is_master() ) print *,' enter multi_gases: ncnst = ',ncnst - allocate (rilist(0:ncnst)) - allocate (cpilist(0:ncnst)) - rilist = 0.0 - cpilist = 0.0 - rilist(0) = rdgas - rilist(1) = rvgas - cpilist(0) = cp_air - cpilist(1) = 4*cp_air - ! Read multi_gases namelist - read (input_nml_file,multi_gases_nml,iostat=ios) - ierr = check_nml_error(ios,'multi_gases_nml') -#endif #else f_unit = open_namelist_file(Atm%nml_filename) ! Read FVCORE namelist read (f_unit,fv_core_nml,iostat=ios) ierr = check_nml_error(ios,'fv_core_nml') call close_file(f_unit) -#ifdef MULTI_GASES - if( is_master() ) print *,' enter multi_gases: ncnst = ',ncnst - allocate (rilist(0:ncnst)) - allocate (cpilist(0:ncnst)) - rilist = 0.0 - cpilist = 0.0 - rilist(0) = rdgas - rilist(1) = rvgas - cpilist(0) = cp_air - cpilist(1) = 4*cp_air - ! Read multi_gases namelist - rewind (f_unit) - read (f_unit,multi_gases_nml,iostat=ios) - ierr = check_nml_error(ios,'multi_gases_nml') -#endif - call close_file(f_unit) #endif call write_version_number ( 'FV_CONTROL_MOD', version ) unit = stdlog() write(unit, nml=fv_core_nml) -#ifdef MULTI_GASES - write(unit, nml=multi_gases_nml) - call multi_gases_init(ncnst,nwat) -#endif if (len_trim(res_latlon_dynamics) /= 0) Atm%flagstruct%res_latlon_dynamics = res_latlon_dynamics if (len_trim(res_latlon_tracers) /= 0) Atm%flagstruct%res_latlon_tracers = res_latlon_tracers diff --git a/model/multi_gases.F90 b/model/multi_gases.F90 index 71d02bbef..d100a5e0e 100644 --- a/model/multi_gases.F90 +++ b/model/multi_gases.F90 @@ -36,8 +36,10 @@ module multi_gases_mod ! ! - use constants_mod, only: rdgas, cp_air + use constants_mod, only: rdgas, rvgas, cp_air use fv_mp_mod, only: is_master + use mpp_mod, only: stdlog, input_nml_file + use fms_mod, only: check_nml_error implicit none @@ -53,7 +55,7 @@ module multi_gases_mod private num_wat, sphum, sphump1 public vir, vicp, vicv, ind_gas, num_gas - public multi_gases_init + public multi_gases_init, read_namelist_multi_gases_nml public virq public virq_max public virqd @@ -128,6 +130,46 @@ subroutine multi_gases_init(ngas, nwat) return end subroutine multi_gases_init + subroutine read_namelist_multi_gases_nml(nml_filename,ncnst,nwat) + + character(*), intent(IN) :: nml_filename + integer, intent(IN) :: ncnst, nwat + integer :: ierr, f_unit, unit, ios + + namelist /multi_gases_nml/ ri,cpi + + unit = stdlog() + + allocate (ri(0:ncnst)) + allocate (cpi(0:ncnst)) + + ri = 0.0 + cpi = 0.0 + ri(0) = rdgas + ri(1) = rvgas + cpi(0) = cp_air + cpi(1) = 4*cp_air +#ifdef INTERNAL_FILE_NML + + ! Read multi_gases namelist + read (input_nml_file,multi_gases_nml,iostat=ios) + ierr = check_nml_error(ios,'multi_gases_nml') + +#else + ! Read multi_gases namelist + f_unit = open_namelist_file(nml_filename) + + rewind (f_unit) + read (f_unit,multi_gases_nml,iostat=ios) + ierr = check_nml_error(ios,'multi_gases_nml') + call close_file(f_unit) +#endif + write(unit, nml=multi_gases_nml) + call multi_gases_init(ncnst,nwat) + + return + end subroutine read_namelist_multi_gases_nml + ! ----------------------------------------------------------------