Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

corrections for intialization #8

Merged
merged 2 commits into from
Jun 12, 2020
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
17 changes: 8 additions & 9 deletions src/NorESM/micro_mg_cam.F90
Original file line number Diff line number Diff line change
Expand Up @@ -1824,7 +1824,6 @@ subroutine micro_mg_cam_tend_pack(state, ptend, dtime, pbuf, mgncol, mgcols, nle
real(r8), pointer :: pckdptr(:,:)

!-------------------------------------------------------------------------------

lchnk = state%lchnk
ncol = state%ncol
psetcols = state%psetcols
Expand Down Expand Up @@ -2077,7 +2076,6 @@ subroutine micro_mg_cam_tend_pack(state, ptend, dtime, pbuf, mgncol, mgcols, nle
call post_proc%add_field(p(qiten), p(packed_qitend))
call post_proc%add_field(p(ncten), p(packed_nctend))
call post_proc%add_field(p(niten), p(packed_nitend))

if (micro_mg_version > 1) then
call post_proc%add_field(p(qrten), p(packed_qrtend))
call post_proc%add_field(p(qsten), p(packed_qstend))
Expand Down Expand Up @@ -2180,8 +2178,10 @@ subroutine micro_mg_cam_tend_pack(state, ptend, dtime, pbuf, mgncol, mgcols, nle
call post_proc%add_field(p(npccno), p(packed_npccno))
call post_proc%add_field(p(nnuccdo), p(packed_nnuccdo))
call post_proc%add_field(p(mnudepo), p(packed_mnudepo))
call post_proc%add_field(p(nctncons), p(packed_nctncons))
call post_proc%add_field(p(nctnnbmn), p(packed_nctnnbmn))
if(micro_mg_version <2) then
call post_proc%add_field(p(nctncons), p(packed_nctncons))
call post_proc%add_field(p(nctnnbmn), p(packed_nctnnbmn))
ENDIF
call post_proc%add_field(p(nctnszmn), p(packed_nctnszmn))
call post_proc%add_field(p(nctnszmx), p(packed_nctnszmx))
call post_proc%add_field(p(nctnncld), p(packed_nctnncld))
Expand Down Expand Up @@ -2269,7 +2269,6 @@ subroutine micro_mg_cam_tend_pack(state, ptend, dtime, pbuf, mgncol, mgcols, nle
packed_qs = packer%pack(state_loc%q(:,:,ixsnow))
packed_ns = packer%pack(state_loc%q(:,:,ixnumsnow))
end if

select case (micro_mg_version)
case (1)
select case (micro_mg_sub_version)
Expand Down Expand Up @@ -2314,7 +2313,6 @@ subroutine micro_mg_cam_tend_pack(state, ptend, dtime, pbuf, mgncol, mgcols, nle
case(2)
select case (micro_mg_sub_version)
case (0)

call micro_mg_tend2_0( &
mgncol, nlev, dtime/num_steps,&
packed_t, packed_q, &
Expand Down Expand Up @@ -2420,7 +2418,6 @@ subroutine micro_mg_cam_tend_pack(state, ptend, dtime, pbuf, mgncol, mgcols, nle
ptend_loc%q(:,:,ixnumsnow) = packer%unpack(packed_nstend, &
-state_loc%q(:,:,ixnumsnow)/(dtime/num_steps))
end if

! Sum into overall ptend
call physics_ptend_sum(ptend_loc, ptend, ncol)

Expand Down Expand Up @@ -3238,8 +3235,10 @@ subroutine micro_mg_cam_tend_pack(state, ptend, dtime, pbuf, mgncol, mgcols, nle
call outfld ('NPCCNO2 ', npccn, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
call outfld ('NNUCCDO ', nnuccdo, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
call outfld ('MNUDEPO ', mnudepo, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
call outfld ('NCTNCONS ', nctncons, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
call outfld ('NCTNNBMN ', nctnnbmn, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
if (micro_mg_version <2) then
call outfld ('NCTNCONS ', nctncons, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
call outfld ('NCTNNBMN ', nctnnbmn, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
endif
call outfld ('NCTNSZMN ', nctnszmn, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
call outfld ('NCTNSZMX ', nctnszmx, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
call outfld ('NCTNNCLD ', nctnncld, psetcols, lchnk, avg_subcol_field=use_subcol_microp )
Expand Down
42 changes: 21 additions & 21 deletions src/NorESM/physpkg.F90
Original file line number Diff line number Diff line change
Expand Up @@ -2087,14 +2087,14 @@ subroutine tphysbc (ztodt, state, &
! if(precc(i).lt.0.) precc(i)=0.
! end do
#ifdef AEROCOM
do kcomp=1,14
do k=1,pver
do i=1,ncol
rnew3d(i,k,kcomp) =0.0_r8
logsig3d(i,k,kcomp)=0.0_r8
enddo
enddo
enddo
! do kcomp=1,14
! do k=1,pver
! do i=1,ncol
rnew3d(:,:,:) =0.0_r8
logsig3d(:,:,:)=0.0_r8
! enddo
! enddo
! enddo
#endif ! aerocom
#endif ! dirind

Expand Down Expand Up @@ -2340,7 +2340,7 @@ subroutine tphysbc (ztodt, state, &
! Estimating hygroscopic growth by use of linear interpolation w.r.t. mass
! fractions of each internally mixed component for each mode (kcomp).
!
call intfrh(lchnk, ncol, v3so4, v3insol, v3oc, v3ss, relhum, frh)
! call intfrh(lchnk, ncol, v3so4, v3insol, v3oc, v3ss, relhum, frh)
!
do k=1,pver
do i=1,ncol
Expand All @@ -2356,18 +2356,18 @@ subroutine tphysbc (ztodt, state, &
rnewdry11(i,k) = rnew3d(i,k,11)
rnewdry13(i,k) = rnew3d(i,k,13)
rnewdry14(i,k) = rnew3d(i,k,14)
rnew1(i,k) = rnew3d(i,k,1)*frh(i,k,1)
rnew2(i,k) = rnew3d(i,k,2)*frh(i,k,2)
rnew4(i,k) = rnew3d(i,k,4)*frh(i,k,4)
rnew5(i,k) = rnew3d(i,k,5)*frh(i,k,5)
rnew6(i,k) = rnew3d(i,k,6)*frh(i,k,6)
rnew7(i,k) = rnew3d(i,k,7)*frh(i,k,7)
rnew8(i,k) = rnew3d(i,k,8)*frh(i,k,8)
rnew9(i,k) = rnew3d(i,k,9)*frh(i,k,9)
rnew10(i,k) = rnew3d(i,k,10)*frh(i,k,10)
rnew11(i,k) = rnew3d(i,k,11)*frh(i,k,11)
rnew13(i,k) = rnew3d(i,k,13)*frh(i,k,13)
rnew14(i,k) = rnew3d(i,k,14)*frh(i,k,14)
! rnew1(i,k) = rnew3d(i,k,1)*frh(i,k,1)
! rnew2(i,k) = rnew3d(i,k,2)*frh(i,k,2)
! rnew4(i,k) = rnew3d(i,k,4)*frh(i,k,4)
! rnew5(i,k) = rnew3d(i,k,5)*frh(i,k,5)
! rnew6(i,k) = rnew3d(i,k,6)*frh(i,k,6)
! rnew7(i,k) = rnew3d(i,k,7)*frh(i,k,7)
! rnew8(i,k) = rnew3d(i,k,8)*frh(i,k,8)
! rnew9(i,k) = rnew3d(i,k,9)*frh(i,k,9)
! rnew10(i,k) = rnew3d(i,k,10)*frh(i,k,10)
! rnew11(i,k) = rnew3d(i,k,11)*frh(i,k,11)
! rnew13(i,k) = rnew3d(i,k,13)*frh(i,k,13)
! rnew14(i,k) = rnew3d(i,k,14)*frh(i,k,14)
logsig1(i,k) = logsig3d(i,k,1)
logsig2(i,k) = logsig3d(i,k,2)
logsig4(i,k) = logsig3d(i,k,4)
Expand Down
5 changes: 4 additions & 1 deletion src/NorESM/zm_conv.F90
Original file line number Diff line number Diff line change
Expand Up @@ -3258,7 +3258,10 @@ subroutine cldprp(lchnk , &
!-tht
tvu(i,k) = tvuo(i,k)
frz(i,k) = 0._r8

!+tht 25/05/2020
td(i,k) = (hd(i,k)-grav*zf(i,k)-(1._r8+dcol*tmelt)*rl*qds(i,k)) &
/(cp*( 1._r8 + (cpvir-dcol*(rl/cp))*qds(i,k) ))
!-tht
end do
end do
if (zmconv_microp) then
Expand Down
2 changes: 2 additions & 0 deletions src/chemistry/aerosol/soil_erod_mod.F90
Original file line number Diff line number Diff line change
Expand Up @@ -86,6 +86,8 @@ subroutine soil_erod_init( dust_emis_fact, soil_erod_file )
dst_lons(:) = d2r * dst_lons(:)

allocate( soil_erodibility(pcols,begchunk:endchunk), stat=ierr )
soil_erodibility(:,:)=0._r8

if( ierr /= 0 ) then
write(iulog,*) 'soil_erod_init: failed to allocate soil_erodibility_in, ierr = ',ierr
call endrun('soil_erod_init: failed to allocate soil_erodibility_in')
Expand Down
2 changes: 1 addition & 1 deletion src/chemistry/mozart/chemistry.F90
Original file line number Diff line number Diff line change
Expand Up @@ -1307,7 +1307,7 @@ subroutine chem_timestep_tend( state, ptend, cam_in, cam_out, dt, pbuf, fh2o)
logical :: lq(pcnst)

if ( .not. chem_step ) return

ncldwtr(:,:) = 0._r8
chem_dt = chem_freq*dt

lchnk = state%lchnk
Expand Down
2 changes: 1 addition & 1 deletion src/chemistry/oslo_aero/aero_model.F90
Original file line number Diff line number Diff line change
Expand Up @@ -366,7 +366,7 @@ subroutine aero_model_drydep ( state, pbuf, obklen, ustar, cam_in, dt, cam_out,
real(r8), dimension(pcols, pver, numberOfProcessModeTracers) :: oslo_wetdens_processmodes

ncol = state%ncol

oslo_wetdens(:,:,:) = 0._r8
call calcaersize_sub( ncol, &
state%t, state%q(1,1,1), state%pmid, state%pdel &
,oslo_dgnumwet , oslo_wetdens &
Expand Down
5 changes: 4 additions & 1 deletion src/chemistry/oslo_aero/aeronucl.F90
Original file line number Diff line number Diff line change
Expand Up @@ -86,7 +86,10 @@ subroutine aeronucl(lchnk, ncol, t, pmid, h2ommr, h2so4pc, oxidorg, coagnuc, nuc

nuclso4(:,:)=0._r8
nuclorg(:,:)=0._r8

nuclrate_bin(:,:)=0._r8
nuclrate_pbl(:,:)=0._r8
formrate_bin(:,:)=0._r8
formrate_pbl(:,:)=0._r8
!-- The highest level in planetary boundary layer
do i=1,ncol
pblht_lim(i)=MIN(MAX(pblht(i),500._r8),7000._r8)
Expand Down
1 change: 1 addition & 0 deletions src/chemistry/oslo_aero/microp_aero.F90
Original file line number Diff line number Diff line change
Expand Up @@ -556,6 +556,7 @@ subroutine microp_aero_run ( &
!-- wy4.0

#ifdef OSLO_AERO
cam(:,:,:) = 0._r8
!qaercwpt(1:ncol,1:pver,:) = 0.0_r8
! do m=1,nmodes_oslo
! do n=1,getNumberOfTracersInMode(m)
Expand Down
1 change: 1 addition & 0 deletions src/chemistry/oslo_aero/oslo_aerosols_intr.F90
Original file line number Diff line number Diff line change
Expand Up @@ -371,6 +371,7 @@ subroutine oslo_aero_dry_intr ( state, pbuf, obklen, ustar, cam_in, dt, cam_out
!The following logic is based on that process-mode tracers
!always follow AFTER the actual tracers!!

dens_aer(:,:) = 0._r8
do m = 0, nmodes ! main loop over aerosol modes

do lphase = 1, 2 ! loop over interstitial / cloud-borne forms
Expand Down
2 changes: 1 addition & 1 deletion src/physics/cam/physics_types.F90
Original file line number Diff line number Diff line change
Expand Up @@ -1469,7 +1469,7 @@ subroutine physics_dme_adjust_THT(state, tend, qini, dt, eflx, ent_tnd, ohf_adju
if (present(ent_tnd)) then
ent_tnd(:ncol)=0._r8
do k=1,pver
ent_tnd(:ncol)=ent_tnd-(state%t(:ncol,k)*cpairv(:ncol,k,lchnk) &
ent_tnd(:ncol)=ent_tnd(:ncol)-(state%t(:ncol,k)*cpairv(:ncol,k,lchnk) &
+0.5_r8*(state%u(:ncol,k)**2+state%v(:ncol,k)**2))*state%pdel(:ncol,k)
enddo
endif
Expand Down
2 changes: 2 additions & 0 deletions src/physics/cam_oslo/opticsAtConstRh.F90
Original file line number Diff line number Diff line change
Expand Up @@ -202,6 +202,8 @@ subroutine opticsAtConstRh (lchnk, ncol, pint, rhoda, Nnatk, xrh, irh1, irf, &

!000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000

belt1x(:,:,:) = 0._r8

do iloop=1,1

! BC(ax) mode (hydrophobic, so no rhum needed here):
Expand Down
13 changes: 11 additions & 2 deletions src/physics/cam_oslo/pmxsub.F90
Original file line number Diff line number Diff line change
Expand Up @@ -1274,8 +1274,17 @@ subroutine pmxsub(lchnk, ncol, pint, pmid, coszrs, state, t, cld, qm1, Nnatk, &
dload(icol,i)=0.0_r8
enddo
enddo


bext550n(:,:,:) = 0._r8
babs550n(:,:,:) = 0._r8
bext440n(:,:,:) = 0._r8
babs440n(:,:,:) = 0._r8
bext870n(:,:,:) = 0._r8
babs870n(:,:,:) = 0._r8
babs500n(:,:,:) = 0._r8
babs670n(:,:,:) = 0._r8
vnbcarr(:,:) =0.0_r8
vaitbcarr(:,:) =0.0_r8
cknorm(:,:,:) =0.0_r8
!000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000

! AeroCom diagnostics requiring table look-ups with ambient RH.
Expand Down
6 changes: 6 additions & 0 deletions src/physics/cam_oslo/radiation.F90
Original file line number Diff line number Diff line change
Expand Up @@ -986,6 +986,12 @@ subroutine radiation_tend( &
lchnk = state%lchnk
ncol = state%ncol

per_lw_abs(:,:,:)=0._r8
per_tau(:,:,:)=0._r8
per_tau_w(:,:,:)=0._r8
per_tau_w_g(:,:,:)=0._r8
per_tau_w_f(:,:,:)=0._r8

if (present(rd_out)) then
rd => rd_out
write_output = .false.
Expand Down