diff --git a/src/ALE/MOM_regridding.F90 b/src/ALE/MOM_regridding.F90 index e215fde06f..35dcdaa819 100644 --- a/src/ALE/MOM_regridding.F90 +++ b/src/ALE/MOM_regridding.F90 @@ -477,10 +477,10 @@ subroutine initialize_regridding(CS, GV, US, max_depth, param_file, mdl, coord_m CS%nk=ke ! Target resolution (for fixed coordinates) - allocate( CS%coordinateResolution(CS%nk) ); CS%coordinateResolution(:) = -1.E30 + allocate( CS%coordinateResolution(CS%nk), source=-1.E30 ) if (state_dependent(CS%regridding_scheme)) then ! Target values - allocate( CS%target_density(CS%nk+1) ); CS%target_density(:) = -1.E30*US%kg_m3_to_R + allocate( CS%target_density(CS%nk+1), source=-1.E30*US%kg_m3_to_R ) endif if (allocated(dz)) then diff --git a/src/core/MOM.F90 b/src/core/MOM.F90 index eea888cd70..4865e543c9 100644 --- a/src/core/MOM.F90 +++ b/src/core/MOM.F90 @@ -2233,16 +2233,10 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & endif endif - if (use_frazil) then - allocate(CS%tv%frazil(isd:ied,jsd:jed)) ; CS%tv%frazil(:,:) = 0.0 - endif - if (bound_salinity) then - allocate(CS%tv%salt_deficit(isd:ied,jsd:jed)) ; CS%tv%salt_deficit(:,:) = 0.0 - endif + if (use_frazil) allocate(CS%tv%frazil(isd:ied,jsd:jed), source=0.0) + if (bound_salinity) allocate(CS%tv%salt_deficit(isd:ied,jsd:jed), source=0.0) - if (bulkmixedlayer .or. use_temperature) then - allocate(CS%Hml(isd:ied,jsd:jed)) ; CS%Hml(:,:) = 0.0 - endif + if (bulkmixedlayer .or. use_temperature) allocate(CS%Hml(isd:ied,jsd:jed), source=0.0) if (bulkmixedlayer) then GV%nkml = nkml ; GV%nk_rho_varies = nkml + nkbl @@ -2258,8 +2252,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & CS%t_dyn_rel_adv = 0.0 ; CS%t_dyn_rel_thermo = 0.0 ; CS%t_dyn_rel_diag = 0.0 if (debug_truncations) then - allocate(CS%u_prev(IsdB:IedB,jsd:jed,nz)) ; CS%u_prev(:,:,:) = 0.0 - allocate(CS%v_prev(isd:ied,JsdB:JedB,nz)) ; CS%v_prev(:,:,:) = 0.0 + allocate(CS%u_prev(IsdB:IedB,jsd:jed,nz), source=0.0) + allocate(CS%v_prev(isd:ied,JsdB:JedB,nz), source=0.0) MOM_internal_state%u_prev => CS%u_prev MOM_internal_state%v_prev => CS%v_prev call safe_alloc_ptr(CS%ADp%du_dt_visc,IsdB,IedB,jsd,jed,nz) @@ -2279,9 +2273,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & CS%CDp%uh => CS%uh ; CS%CDp%vh => CS%vh - if (CS%interp_p_surf) then - allocate(CS%p_surf_prev(isd:ied,jsd:jed)) ; CS%p_surf_prev(:,:) = 0.0 - endif + if (CS%interp_p_surf) allocate(CS%p_surf_prev(isd:ied,jsd:jed), source=0.0) ALLOC_(CS%ssh_rint(isd:ied,jsd:jed)) ; CS%ssh_rint(:,:) = 0.0 ALLOC_(CS%ave_ssh_ibc(isd:ied,jsd:jed)) ; CS%ave_ssh_ibc(:,:) = 0.0 @@ -2293,9 +2285,9 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! initialization routine for tv. if (use_EOS) call EOS_init(param_file, CS%tv%eqn_of_state, US) if (use_temperature) then - allocate(CS%tv%TempxPmE(isd:ied,jsd:jed)) ; CS%tv%TempxPmE(:,:) = 0.0 + allocate(CS%tv%TempxPmE(isd:ied,jsd:jed), source=0.0) if (use_geothermal) then - allocate(CS%tv%internal_heat(isd:ied,jsd:jed)) ; CS%tv%internal_heat(:,:) = 0.0 + allocate(CS%tv%internal_heat(isd:ied,jsd:jed), source=0.0) endif endif call callTree_waypoint("state variables allocated (initialize_MOM)") @@ -2406,18 +2398,13 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & if (CS%rotate_index) then G_in%ke = GV%ke - allocate(u_in(G_in%IsdB:G_in%IedB, G_in%jsd:G_in%jed, nz)) - allocate(v_in(G_in%isd:G_in%ied, G_in%JsdB:G_in%JedB, nz)) - allocate(h_in(G_in%isd:G_in%ied, G_in%jsd:G_in%jed, nz)) - u_in(:,:,:) = 0.0 - v_in(:,:,:) = 0.0 - h_in(:,:,:) = GV%Angstrom_H + allocate(u_in(G_in%IsdB:G_in%IedB, G_in%jsd:G_in%jed, nz), source=0.0) + allocate(v_in(G_in%isd:G_in%ied, G_in%JsdB:G_in%JedB, nz), source=0.0) + allocate(h_in(G_in%isd:G_in%ied, G_in%jsd:G_in%jed, nz), source=GV%Angstrom_H) if (use_temperature) then - allocate(T_in(G_in%isd:G_in%ied, G_in%jsd:G_in%jed, nz)) - allocate(S_in(G_in%isd:G_in%ied, G_in%jsd:G_in%jed, nz)) - T_in(:,:,:) = 0.0 - S_in(:,:,:) = 0.0 + allocate(T_in(G_in%isd:G_in%ied, G_in%jsd:G_in%jed, nz), source=0.0) + allocate(S_in(G_in%isd:G_in%ied, G_in%jsd:G_in%jed, nz), source=0.0) CS%tv%T => T_in CS%tv%S => S_in @@ -2428,10 +2415,8 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & ! when using an ice shelf. Passing the ice shelf diagnostics CS from MOM ! for legacy reasons. The actual ice shelf diag CS is internal to the ice shelf call initialize_ice_shelf(param_file, G_in, Time, ice_shelf_CSp, diag_ptr) - allocate(frac_shelf_in(G_in%isd:G_in%ied, G_in%jsd:G_in%jed)) - frac_shelf_in(:,:) = 0.0 - allocate(CS%frac_shelf_h(isd:ied, jsd:jed)) - CS%frac_shelf_h(:,:) = 0.0 + allocate(frac_shelf_in(G_in%isd:G_in%ied, G_in%jsd:G_in%jed), source=0.0) + allocate(CS%frac_shelf_h(isd:ied, jsd:jed), source=0.0) call ice_shelf_query(ice_shelf_CSp,G,CS%frac_shelf_h) ! MOM_initialize_state is using the unrotated metric call rotate_array(CS%frac_shelf_h, -turns, frac_shelf_in) @@ -2479,8 +2464,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & else if (use_ice_shelf) then call initialize_ice_shelf(param_file, G, Time, ice_shelf_CSp, diag_ptr) - allocate(CS%frac_shelf_h(isd:ied, jsd:jed)) - CS%frac_shelf_h(:,:) = 0.0 + allocate(CS%frac_shelf_h(isd:ied, jsd:jed), source=0.0) call ice_shelf_query(ice_shelf_CSp,G,CS%frac_shelf_h) call MOM_initialize_state(CS%u, CS%v, CS%h, CS%tv, Time, G, GV, US, & param_file, dirs, restart_CSp, CS%ALE_CSp, CS%tracer_Reg, & @@ -2617,7 +2601,7 @@ subroutine initialize_MOM(Time, Time_init, param_file, dirs, CS, restart_CSp, & call thickness_diffuse_init(Time, G, GV, US, param_file, diag, CS%CDp, CS%thickness_diffuse_CSp) if (CS%split) then - allocate(eta(SZI_(G),SZJ_(G))) ; eta(:,:) = 0.0 + allocate(eta(SZI_(G),SZJ_(G)), source=0.0) call initialize_dyn_split_RK2(CS%u, CS%v, CS%h, CS%uh, CS%vh, eta, Time, & G, GV, US, param_file, diag, CS%dyn_split_RK2_CSp, restart_CSp, & CS%dt, CS%ADp, CS%CDp, MOM_internal_state, CS%VarMix, CS%MEKE, & diff --git a/src/core/MOM_barotropic.F90 b/src/core/MOM_barotropic.F90 index 471999c60c..48eb8259b4 100644 --- a/src/core/MOM_barotropic.F90 +++ b/src/core/MOM_barotropic.F90 @@ -3092,17 +3092,17 @@ subroutine set_up_BT_OBC(OBC, eta, BT_OBC, BT_Domain, G, GV, US, MS, halo, use_B endif if (.not. BT_OBC%is_alloced) then - allocate(BT_OBC%Cg_u(isdw-1:iedw,jsdw:jedw)) ; BT_OBC%Cg_u(:,:) = 0.0 - allocate(BT_OBC%H_u(isdw-1:iedw,jsdw:jedw)) ; BT_OBC%H_u(:,:) = 0.0 - allocate(BT_OBC%uhbt(isdw-1:iedw,jsdw:jedw)) ; BT_OBC%uhbt(:,:) = 0.0 - allocate(BT_OBC%ubt_outer(isdw-1:iedw,jsdw:jedw)) ; BT_OBC%ubt_outer(:,:) = 0.0 - allocate(BT_OBC%eta_outer_u(isdw-1:iedw,jsdw:jedw)) ; BT_OBC%eta_outer_u(:,:) = 0.0 - - allocate(BT_OBC%Cg_v(isdw:iedw,jsdw-1:jedw)) ; BT_OBC%Cg_v(:,:) = 0.0 - allocate(BT_OBC%H_v(isdw:iedw,jsdw-1:jedw)) ; BT_OBC%H_v(:,:) = 0.0 - allocate(BT_OBC%vhbt(isdw:iedw,jsdw-1:jedw)) ; BT_OBC%vhbt(:,:) = 0.0 - allocate(BT_OBC%vbt_outer(isdw:iedw,jsdw-1:jedw)) ; BT_OBC%vbt_outer(:,:) = 0.0 - allocate(BT_OBC%eta_outer_v(isdw:iedw,jsdw-1:jedw)) ; BT_OBC%eta_outer_v(:,:)=0.0 + allocate(BT_OBC%Cg_u(isdw-1:iedw,jsdw:jedw), source=0.0) + allocate(BT_OBC%H_u(isdw-1:iedw,jsdw:jedw), source=0.0) + allocate(BT_OBC%uhbt(isdw-1:iedw,jsdw:jedw), source=0.0) + allocate(BT_OBC%ubt_outer(isdw-1:iedw,jsdw:jedw), source=0.0) + allocate(BT_OBC%eta_outer_u(isdw-1:iedw,jsdw:jedw), source=0.0) + + allocate(BT_OBC%Cg_v(isdw:iedw,jsdw-1:jedw), source=0.0) + allocate(BT_OBC%H_v(isdw:iedw,jsdw-1:jedw), source=0.0) + allocate(BT_OBC%vhbt(isdw:iedw,jsdw-1:jedw), source=0.0) + allocate(BT_OBC%vbt_outer(isdw:iedw,jsdw-1:jedw), source=0.0) + allocate(BT_OBC%eta_outer_v(isdw:iedw,jsdw-1:jedw), source=0.0) BT_OBC%is_alloced = .true. call create_group_pass(BT_OBC%pass_uv, BT_OBC%ubt_outer, BT_OBC%vbt_outer, BT_Domain) call create_group_pass(BT_OBC%pass_uhvh, BT_OBC%uhbt, BT_OBC%vhbt, BT_Domain) @@ -4743,7 +4743,7 @@ subroutine barotropic_init(u, v, h, eta, Time, G, GV, US, param_file, diag, CS, wave_drag_file = trim(slasher(inputdir))//trim(wave_drag_file) call log_param(param_file, mdl, "INPUTDIR/BT_WAVE_DRAG_FILE", wave_drag_file) - allocate(lin_drag_h(isd:ied,jsd:jed)) ; lin_drag_h(:,:) = 0.0 + allocate(lin_drag_h(isd:ied,jsd:jed), source=0.0) call MOM_read_data(wave_drag_file, wave_drag_var, lin_drag_h, G%Domain, scale=US%m_to_Z*US%T_to_s) call pass_var(lin_drag_h, G%Domain) diff --git a/src/core/MOM_dynamics_split_RK2.F90 b/src/core/MOM_dynamics_split_RK2.F90 index a168fe1319..0532aeac53 100644 --- a/src/core/MOM_dynamics_split_RK2.F90 +++ b/src/core/MOM_dynamics_split_RK2.F90 @@ -946,8 +946,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s endif if (CS%id_hf_PFu_2d > 0) then - allocate(hf_PFu_2d(G%IsdB:G%IedB,G%jsd:G%jed)) - hf_PFu_2d(:,:) = 0.0 + allocate(hf_PFu_2d(G%IsdB:G%IedB,G%jsd:G%jed), source=0.0) do k=1,nz ; do j=js,je ; do I=Isq,Ieq hf_PFu_2d(I,j) = hf_PFu_2d(I,j) + CS%PFu(I,j,k) * CS%ADp%diag_hfrac_u(I,j,k) enddo ; enddo ; enddo @@ -955,8 +954,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s deallocate(hf_PFu_2d) endif if (CS%id_hf_PFv_2d > 0) then - allocate(hf_PFv_2d(G%isd:G%ied,G%JsdB:G%JedB)) - hf_PFv_2d(:,:) = 0.0 + allocate(hf_PFv_2d(G%isd:G%ied,G%JsdB:G%JedB), source=0.0) do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie hf_PFv_2d(i,J) = hf_PFv_2d(i,J) + CS%PFv(i,J,k) * CS%ADp%diag_hfrac_v(i,J,k) enddo ; enddo ; enddo @@ -965,8 +963,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s endif if (CS%id_h_PFu > 0) then - allocate(h_PFu(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) - h_PFu(:,:,:) = 0.0 + allocate(h_PFu(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) do k=1,nz ; do j=js,je ; do I=Isq,Ieq h_PFu(I,j,k) = CS%PFu(I,j,k) * CS%ADp%diag_hu(I,j,k) enddo ; enddo ; enddo @@ -974,8 +971,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s deallocate(h_PFu) endif if (CS%id_h_PFv > 0) then - allocate(h_PFv(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) - h_PFv(:,:,:) = 0.0 + allocate(h_PFv(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie h_PFv(i,J,k) = CS%PFv(i,J,k) * CS%ADp%diag_hv(i,J,k) enddo ; enddo ; enddo @@ -1013,8 +1009,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s endif if (CS%id_hf_CAu_2d > 0) then - allocate(hf_CAu_2d(G%IsdB:G%IedB,G%jsd:G%jed)) - hf_CAu_2d(:,:) = 0.0 + allocate(hf_CAu_2d(G%IsdB:G%IedB,G%jsd:G%jed), source=0.0) do k=1,nz ; do j=js,je ; do I=Isq,Ieq hf_CAu_2d(I,j) = hf_CAu_2d(I,j) + CS%CAu(I,j,k) * CS%ADp%diag_hfrac_u(I,j,k) enddo ; enddo ; enddo @@ -1022,8 +1017,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s deallocate(hf_CAu_2d) endif if (CS%id_hf_CAv_2d > 0) then - allocate(hf_CAv_2d(G%isd:G%ied,G%JsdB:G%JedB)) - hf_CAv_2d(:,:) = 0.0 + allocate(hf_CAv_2d(G%isd:G%ied,G%JsdB:G%JedB), source=0.0) do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie hf_CAv_2d(i,J) = hf_CAv_2d(i,J) + CS%CAv(i,J,k) * CS%ADp%diag_hfrac_v(i,J,k) enddo ; enddo ; enddo @@ -1032,8 +1026,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s endif if (CS%id_h_CAu > 0) then - allocate(h_CAu(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) - h_CAu(:,:,:) = 0.0 + allocate(h_CAu(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) do k=1,nz ; do j=js,je ; do I=Isq,Ieq h_CAu(I,j,k) = CS%CAu(I,j,k) * CS%ADp%diag_hu(I,j,k) enddo ; enddo ; enddo @@ -1041,8 +1034,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s deallocate(h_CAu) endif if (CS%id_h_CAv > 0) then - allocate(h_CAv(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) - h_CAv(:,:,:) = 0.0 + allocate(h_CAv(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie h_CAv(i,J,k) = CS%CAv(i,J,k) * CS%ADp%diag_hv(i,J,k) enddo ; enddo ; enddo @@ -1080,8 +1072,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s endif if (CS%id_hf_u_BT_accel_2d > 0) then - allocate(hf_u_BT_accel_2d(G%IsdB:G%IedB,G%jsd:G%jed)) - hf_u_BT_accel_2d(:,:) = 0.0 + allocate(hf_u_BT_accel_2d(G%IsdB:G%IedB,G%jsd:G%jed), source=0.0) do k=1,nz ; do j=js,je ; do I=Isq,Ieq hf_u_BT_accel_2d(I,j) = hf_u_BT_accel_2d(I,j) + CS%u_accel_bt(I,j,k) * CS%ADp%diag_hfrac_u(I,j,k) enddo ; enddo ; enddo @@ -1089,8 +1080,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s deallocate(hf_u_BT_accel_2d) endif if (CS%id_hf_v_BT_accel_2d > 0) then - allocate(hf_v_BT_accel_2d(G%isd:G%ied,G%JsdB:G%JedB)) - hf_v_BT_accel_2d(:,:) = 0.0 + allocate(hf_v_BT_accel_2d(G%isd:G%ied,G%JsdB:G%JedB), source=0.0) do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie hf_v_BT_accel_2d(i,J) = hf_v_BT_accel_2d(i,J) + CS%v_accel_bt(i,J,k) * CS%ADp%diag_hfrac_v(i,J,k) enddo ; enddo ; enddo @@ -1099,8 +1089,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s endif if (CS%id_h_u_BT_accel > 0) then - allocate(h_u_BT_accel(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) - h_u_BT_accel(:,:,:) = 0.0 + allocate(h_u_BT_accel(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) do k=1,nz ; do j=js,je ; do I=Isq,Ieq h_u_BT_accel(I,j,k) = CS%u_accel_bt(I,j,k) * CS%ADp%diag_hu(I,j,k) enddo ; enddo ; enddo @@ -1108,8 +1097,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s deallocate(h_u_BT_accel) endif if (CS%id_h_v_BT_accel > 0) then - allocate(h_v_BT_accel(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) - h_v_BT_accel(:,:,:) = 0.0 + allocate(h_v_BT_accel(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie h_v_BT_accel(i,J,k) = CS%v_accel_bt(i,J,k) * CS%ADp%diag_hv(i,J,k) enddo ; enddo ; enddo @@ -1118,8 +1106,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s endif if (CS%id_PFu_visc_rem > 0) then - allocate(PFu_visc_rem(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) - PFu_visc_rem(:,:,:) = 0.0 + allocate(PFu_visc_rem(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) do k=1,nz ; do j=js,je ; do I=Isq,Ieq PFu_visc_rem(I,j,k) = CS%PFu(I,j,k) * CS%ADp%visc_rem_u(I,j,k) enddo ; enddo ; enddo @@ -1127,8 +1114,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s deallocate(PFu_visc_rem) endif if (CS%id_PFv_visc_rem > 0) then - allocate(PFv_visc_rem(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) - PFv_visc_rem(:,:,:) = 0.0 + allocate(PFv_visc_rem(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie PFv_visc_rem(i,J,k) = CS%PFv(i,J,k) * CS%ADp%visc_rem_v(i,J,k) enddo ; enddo ; enddo @@ -1136,8 +1122,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s deallocate(PFv_visc_rem) endif if (CS%id_CAu_visc_rem > 0) then - allocate(CAu_visc_rem(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) - CAu_visc_rem(:,:,:) = 0.0 + allocate(CAu_visc_rem(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) do k=1,nz ; do j=js,je ; do I=Isq,Ieq CAu_visc_rem(I,j,k) = CS%CAu(I,j,k) * CS%ADp%visc_rem_u(I,j,k) enddo ; enddo ; enddo @@ -1145,8 +1130,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s deallocate(CAu_visc_rem) endif if (CS%id_CAv_visc_rem > 0) then - allocate(CAv_visc_rem(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) - CAv_visc_rem(:,:,:) = 0.0 + allocate(CAv_visc_rem(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie CAv_visc_rem(i,J,k) = CS%CAv(i,J,k) * CS%ADp%visc_rem_v(i,J,k) enddo ; enddo ; enddo @@ -1154,8 +1138,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s deallocate(CAv_visc_rem) endif if (CS%id_u_BT_accel_visc_rem > 0) then - allocate(u_BT_accel_visc_rem(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) - u_BT_accel_visc_rem(:,:,:) = 0.0 + allocate(u_BT_accel_visc_rem(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) do k=1,nz ; do j=js,je ; do I=Isq,Ieq u_BT_accel_visc_rem(I,j,k) = CS%u_accel_bt(I,j,k) * CS%ADp%visc_rem_u(I,j,k) enddo ; enddo ; enddo @@ -1163,8 +1146,7 @@ subroutine step_MOM_dyn_split_RK2(u, v, h, tv, visc, Time_local, dt, forces, p_s deallocate(u_BT_accel_visc_rem) endif if (CS%id_v_BT_accel_visc_rem > 0) then - allocate(v_BT_accel_visc_rem(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) - v_BT_accel_visc_rem(:,:,:) = 0.0 + allocate(v_BT_accel_visc_rem(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie v_BT_accel_visc_rem(i,J,k) = CS%v_accel_bt(i,J,k) * CS%ADp%visc_rem_v(i,J,k) enddo ; enddo ; enddo @@ -1375,8 +1357,8 @@ subroutine initialize_dyn_split_RK2(u, v, h, uh, vh, eta, Time, G, GV, US, param call get_param(param_file, mdl, "DEBUG_TRUNCATIONS", debug_truncations, & default=.false.) - allocate(CS%taux_bot(IsdB:IedB,jsd:jed)) ; CS%taux_bot(:,:) = 0.0 - allocate(CS%tauy_bot(isd:ied,JsdB:JedB)) ; CS%tauy_bot(:,:) = 0.0 + allocate(CS%taux_bot(IsdB:IedB,jsd:jed), source=0.0) + allocate(CS%tauy_bot(isd:ied,JsdB:JedB), source=0.0) ALLOC_(CS%uhbt(IsdB:IedB,jsd:jed)) ; CS%uhbt(:,:) = 0.0 ALLOC_(CS%vhbt(isd:ied,JsdB:JedB)) ; CS%vhbt(:,:) = 0.0 diff --git a/src/core/MOM_dynamics_unsplit.F90 b/src/core/MOM_dynamics_unsplit.F90 index 375f7e3ef1..6f33a00768 100644 --- a/src/core/MOM_dynamics_unsplit.F90 +++ b/src/core/MOM_dynamics_unsplit.F90 @@ -640,8 +640,8 @@ subroutine initialize_dyn_unsplit(u, v, h, Time, G, GV, US, param_file, diag, CS call get_param(param_file, mdl, "TIDES", use_tides, & "If true, apply tidal momentum forcing.", default=.false.) - allocate(CS%taux_bot(IsdB:IedB,jsd:jed)) ; CS%taux_bot(:,:) = 0.0 - allocate(CS%tauy_bot(isd:ied,JsdB:JedB)) ; CS%tauy_bot(:,:) = 0.0 + allocate(CS%taux_bot(IsdB:IedB,jsd:jed), source=0.0) + allocate(CS%tauy_bot(isd:ied,JsdB:JedB), source=0.0) MIS%diffu => CS%diffu ; MIS%diffv => CS%diffv MIS%PFu => CS%PFu ; MIS%PFv => CS%PFv diff --git a/src/core/MOM_dynamics_unsplit_RK2.F90 b/src/core/MOM_dynamics_unsplit_RK2.F90 index fea7f0d873..18a192cb39 100644 --- a/src/core/MOM_dynamics_unsplit_RK2.F90 +++ b/src/core/MOM_dynamics_unsplit_RK2.F90 @@ -602,8 +602,8 @@ subroutine initialize_dyn_unsplit_RK2(u, v, h, Time, G, GV, US, param_file, diag call get_param(param_file, mdl, "TIDES", use_tides, & "If true, apply tidal momentum forcing.", default=.false.) - allocate(CS%taux_bot(IsdB:IedB,jsd:jed)) ; CS%taux_bot(:,:) = 0.0 - allocate(CS%tauy_bot(isd:ied,JsdB:JedB)) ; CS%tauy_bot(:,:) = 0.0 + allocate(CS%taux_bot(IsdB:IedB,jsd:jed), source=0.0) + allocate(CS%tauy_bot(isd:ied,JsdB:JedB), source=0.0) MIS%diffu => CS%diffu ; MIS%diffv => CS%diffv MIS%PFu => CS%PFu ; MIS%PFv => CS%PFv diff --git a/src/core/MOM_grid.F90 b/src/core/MOM_grid.F90 index e672252c24..7592dc8477 100644 --- a/src/core/MOM_grid.F90 +++ b/src/core/MOM_grid.F90 @@ -587,10 +587,10 @@ subroutine allocate_metrics(G) ALLOC_(G%sin_rot(isd:ied,jsd:jed)) ; G%sin_rot(:,:) = 0.0 ALLOC_(G%cos_rot(isd:ied,jsd:jed)) ; G%cos_rot(:,:) = 1.0 - allocate(G%gridLonT(isg:ieg)) ; G%gridLonT(:) = 0.0 - allocate(G%gridLonB(G%IsgB:G%IegB)) ; G%gridLonB(:) = 0.0 - allocate(G%gridLatT(jsg:jeg)) ; G%gridLatT(:) = 0.0 - allocate(G%gridLatB(G%JsgB:G%JegB)) ; G%gridLatB(:) = 0.0 + allocate(G%gridLonT(isg:ieg), source=0.0) + allocate(G%gridLonB(G%IsgB:G%IegB), source=0.0) + allocate(G%gridLatT(jsg:jeg), source=0.0) + allocate(G%gridLatB(G%JsgB:G%JegB), source=0.0) end subroutine allocate_metrics diff --git a/src/core/MOM_open_boundary.F90 b/src/core/MOM_open_boundary.F90 index b83c4d1be8..f0b1158b22 100644 --- a/src/core/MOM_open_boundary.F90 +++ b/src/core/MOM_open_boundary.F90 @@ -523,8 +523,8 @@ subroutine open_boundary_config(G, US, param_file, OBC) OBC%segment(l)%Velocity_nudging_timescale_out = 0.0 OBC%segment(l)%num_fields = 0 enddo - allocate(OBC%segnum_u(G%IsdB:G%IedB,G%jsd:G%jed)) ; OBC%segnum_u(:,:) = OBC_NONE - allocate(OBC%segnum_v(G%isd:G%ied,G%JsdB:G%JedB)) ; OBC%segnum_v(:,:) = OBC_NONE + allocate(OBC%segnum_u(G%IsdB:G%IedB,G%jsd:G%jed), source=OBC_NONE) + allocate(OBC%segnum_v(G%isd:G%ied,G%JsdB:G%JedB), source=OBC_NONE) do l = 1, OBC%number_of_segments write(segment_param_str(1:15),"('OBC_SEGMENT_',i3.3)") l @@ -3522,88 +3522,72 @@ subroutine allocate_OBC_segment_data(OBC, segment) if (segment%is_E_or_W) then ! If these are just Flather, change update_OBC_segment_data accordingly - allocate(segment%Cg(IsdB:IedB,jsd:jed)); segment%Cg(:,:)=0. - allocate(segment%Htot(IsdB:IedB,jsd:jed)); segment%Htot(:,:)=0.0 - allocate(segment%h(IsdB:IedB,jsd:jed,OBC%ke)); segment%h(:,:,:)=0.0 - allocate(segment%eta(IsdB:IedB,jsd:jed)); segment%eta(:,:)=0.0 - if (segment%radiation) then - allocate(segment%rx_norm_rad(IsdB:IedB,jsd:jed,OBC%ke)); segment%rx_norm_rad(:,:,:)=0.0 - endif - allocate(segment%normal_vel(IsdB:IedB,jsd:jed,OBC%ke)); segment%normal_vel(:,:,:)=0.0 - allocate(segment%normal_vel_bt(IsdB:IedB,jsd:jed)); segment%normal_vel_bt(:,:)=0.0 - allocate(segment%normal_trans(IsdB:IedB,jsd:jed,OBC%ke)); segment%normal_trans(:,:,:)=0.0 - if (segment%nudged) then - allocate(segment%nudged_normal_vel(IsdB:IedB,jsd:jed,OBC%ke)); segment%nudged_normal_vel(:,:,:)=0.0 - endif + allocate(segment%Cg(IsdB:IedB,jsd:jed), source=0.0) + allocate(segment%Htot(IsdB:IedB,jsd:jed), source=0.0) + allocate(segment%h(IsdB:IedB,jsd:jed,OBC%ke), source=0.0) + allocate(segment%eta(IsdB:IedB,jsd:jed), source=0.0) + if (segment%radiation) & + allocate(segment%rx_norm_rad(IsdB:IedB,jsd:jed,OBC%ke), source=0.0) + allocate(segment%normal_vel(IsdB:IedB,jsd:jed,OBC%ke), source=0.0) + allocate(segment%normal_vel_bt(IsdB:IedB,jsd:jed), source=0.0) + allocate(segment%normal_trans(IsdB:IedB,jsd:jed,OBC%ke), source=0.0) + if (segment%nudged) & + allocate(segment%nudged_normal_vel(IsdB:IedB,jsd:jed,OBC%ke), source=0.0) if (segment%radiation_tan .or. segment%nudged_tan .or. segment%specified_tan .or. & - segment%oblique_tan .or. OBC%computed_vorticity .or. OBC%computed_strain) then - allocate(segment%tangential_vel(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%tangential_vel(:,:,:)=0.0 - endif - if (segment%nudged_tan) then - allocate(segment%nudged_tangential_vel(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%nudged_tangential_vel(:,:,:)=0.0 - endif - if (segment%nudged_grad) then - allocate(segment%nudged_tangential_grad(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%nudged_tangential_grad(:,:,:)=0.0 - endif + segment%oblique_tan .or. OBC%computed_vorticity .or. OBC%computed_strain) & + allocate(segment%tangential_vel(IsdB:IedB,JsdB:JedB,OBC%ke), source=0.0) + if (segment%nudged_tan) & + allocate(segment%nudged_tangential_vel(IsdB:IedB,JsdB:JedB,OBC%ke), source=0.0) + if (segment%nudged_grad) & + allocate(segment%nudged_tangential_grad(IsdB:IedB,JsdB:JedB,OBC%ke), source=0.0) if (OBC%specified_vorticity .or. OBC%specified_strain .or. segment%radiation_grad .or. & - segment%oblique_grad .or. segment%specified_grad) then - allocate(segment%tangential_grad(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%tangential_grad(:,:,:)=0.0 - endif + segment%oblique_grad .or. segment%specified_grad) & + allocate(segment%tangential_grad(IsdB:IedB,JsdB:JedB,OBC%ke), source=0.0) if (segment%oblique) then - allocate(segment%grad_normal(JsdB:JedB,2,OBC%ke)); segment%grad_normal(:,:,:) = 0.0 - allocate(segment%rx_norm_obl(IsdB:IedB,jsd:jed,OBC%ke)); segment%rx_norm_obl(:,:,:)=0.0 - allocate(segment%ry_norm_obl(IsdB:IedB,jsd:jed,OBC%ke)); segment%ry_norm_obl(:,:,:)=0.0 - allocate(segment%cff_normal(IsdB:IedB,jsd:jed,OBC%ke)); segment%cff_normal(:,:,:)=0.0 - endif - if (segment%oblique_tan) then - allocate(segment%grad_tan(jsd-1:jed+1,2,OBC%ke)); segment%grad_tan(:,:,:) = 0.0 - endif - if (segment%oblique_grad) then - allocate(segment%grad_gradient(jsd:jed,2,OBC%ke)); segment%grad_gradient(:,:,:) = 0.0 + allocate(segment%grad_normal(JsdB:JedB,2,OBC%ke), source=0.0) + allocate(segment%rx_norm_obl(IsdB:IedB,jsd:jed,OBC%ke), source=0.0) + allocate(segment%ry_norm_obl(IsdB:IedB,jsd:jed,OBC%ke), source=0.0) + allocate(segment%cff_normal(IsdB:IedB,jsd:jed,OBC%ke), source=0.0) endif + if (segment%oblique_tan) & + allocate(segment%grad_tan(jsd-1:jed+1,2,OBC%ke), source=0.0) + if (segment%oblique_grad) & + allocate(segment%grad_gradient(jsd:jed,2,OBC%ke), source=0.0) endif if (segment%is_N_or_S) then ! If these are just Flather, change update_OBC_segment_data accordingly - allocate(segment%Cg(isd:ied,JsdB:JedB)); segment%Cg(:,:)=0. - allocate(segment%Htot(isd:ied,JsdB:JedB)); segment%Htot(:,:)=0.0 - allocate(segment%h(isd:ied,JsdB:JedB,OBC%ke)); segment%h(:,:,:)=0.0 - allocate(segment%eta(isd:ied,JsdB:JedB)); segment%eta(:,:)=0.0 - if (segment%radiation) then - allocate(segment%ry_norm_rad(isd:ied,JsdB:JedB,OBC%ke)); segment%ry_norm_rad(:,:,:)=0.0 - endif - allocate(segment%normal_vel(isd:ied,JsdB:JedB,OBC%ke)); segment%normal_vel(:,:,:)=0.0 - allocate(segment%normal_vel_bt(isd:ied,JsdB:JedB)); segment%normal_vel_bt(:,:)=0.0 - allocate(segment%normal_trans(isd:ied,JsdB:JedB,OBC%ke)); segment%normal_trans(:,:,:)=0.0 - if (segment%nudged) then - allocate(segment%nudged_normal_vel(isd:ied,JsdB:JedB,OBC%ke)); segment%nudged_normal_vel(:,:,:)=0.0 - endif + allocate(segment%Cg(isd:ied,JsdB:JedB), source=0.0) + allocate(segment%Htot(isd:ied,JsdB:JedB), source=0.0) + allocate(segment%h(isd:ied,JsdB:JedB,OBC%ke), source=0.0) + allocate(segment%eta(isd:ied,JsdB:JedB), source=0.0) + if (segment%radiation) & + allocate(segment%ry_norm_rad(isd:ied,JsdB:JedB,OBC%ke), source=0.0) + allocate(segment%normal_vel(isd:ied,JsdB:JedB,OBC%ke), source=0.0) + allocate(segment%normal_vel_bt(isd:ied,JsdB:JedB), source=0.0) + allocate(segment%normal_trans(isd:ied,JsdB:JedB,OBC%ke), source=0.0) + if (segment%nudged) & + allocate(segment%nudged_normal_vel(isd:ied,JsdB:JedB,OBC%ke), source=0.0) if (segment%radiation_tan .or. segment%nudged_tan .or. segment%specified_tan .or. & - segment%oblique_tan .or. OBC%computed_vorticity .or. OBC%computed_strain) then - allocate(segment%tangential_vel(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%tangential_vel(:,:,:)=0.0 - endif - if (segment%nudged_tan) then - allocate(segment%nudged_tangential_vel(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%nudged_tangential_vel(:,:,:)=0.0 - endif - if (segment%nudged_grad) then - allocate(segment%nudged_tangential_grad(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%nudged_tangential_grad(:,:,:)=0.0 - endif + segment%oblique_tan .or. OBC%computed_vorticity .or. OBC%computed_strain) & + allocate(segment%tangential_vel(IsdB:IedB,JsdB:JedB,OBC%ke), source=0.0) + if (segment%nudged_tan) & + allocate(segment%nudged_tangential_vel(IsdB:IedB,JsdB:JedB,OBC%ke), source=0.0) + if (segment%nudged_grad) & + allocate(segment%nudged_tangential_grad(IsdB:IedB,JsdB:JedB,OBC%ke), source=0.0) if (OBC%specified_vorticity .or. OBC%specified_strain .or. segment%radiation_grad .or. & - segment%oblique_grad .or. segment%specified_grad) then - allocate(segment%tangential_grad(IsdB:IedB,JsdB:JedB,OBC%ke)); segment%tangential_grad(:,:,:)=0.0 - endif + segment%oblique_grad .or. segment%specified_grad) & + allocate(segment%tangential_grad(IsdB:IedB,JsdB:JedB,OBC%ke), source=0.0) if (segment%oblique) then - allocate(segment%grad_normal(IsdB:IedB,2,OBC%ke)); segment%grad_normal(:,:,:) = 0.0 - allocate(segment%rx_norm_obl(isd:ied,JsdB:JedB,OBC%ke)); segment%rx_norm_obl(:,:,:)=0.0 - allocate(segment%ry_norm_obl(isd:ied,JsdB:JedB,OBC%ke)); segment%ry_norm_obl(:,:,:)=0.0 - allocate(segment%cff_normal(isd:ied,JsdB:JedB,OBC%ke)); segment%cff_normal(:,:,:)=0.0 - endif - if (segment%oblique_tan) then - allocate(segment%grad_tan(isd-1:ied+1,2,OBC%ke)); segment%grad_tan(:,:,:) = 0.0 - endif - if (segment%oblique_grad) then - allocate(segment%grad_gradient(isd:ied,2,OBC%ke)); segment%grad_gradient(:,:,:) = 0.0 + allocate(segment%grad_normal(IsdB:IedB,2,OBC%ke), source=0.0) + allocate(segment%rx_norm_obl(isd:ied,JsdB:JedB,OBC%ke), source=0.0) + allocate(segment%ry_norm_obl(isd:ied,JsdB:JedB,OBC%ke), source=0.0) + allocate(segment%cff_normal(isd:ied,JsdB:JedB,OBC%ke), source=0.0) endif + if (segment%oblique_tan) & + allocate(segment%grad_tan(isd-1:ied+1,2,OBC%ke), source=0.0) + if (segment%oblique_grad) & + allocate(segment%grad_gradient(isd:ied,2,OBC%ke), source=0.0) endif end subroutine allocate_OBC_segment_data @@ -3801,8 +3785,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) ! calculate auxiliary fields at staggered locations ishift=0;jshift=0 if (segment%is_E_or_W) then - allocate(normal_trans_bt(segment%HI%IsdB:segment%HI%IedB,segment%HI%jsd:segment%HI%jed)) - normal_trans_bt(:,:) = 0.0 + allocate(normal_trans_bt(segment%HI%IsdB:segment%HI%IedB,segment%HI%jsd:segment%HI%jed), source=0.0) if (segment%direction == OBC_DIRECTION_W) ishift=1 I=segment%HI%IsdB do j=segment%HI%jsd,segment%HI%jed @@ -3814,8 +3797,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) segment%Cg(I,j) = sqrt(GV%g_prime(1)*segment%Htot(I,j)*GV%H_to_Z) enddo else! (segment%direction == OBC_DIRECTION_N .or. segment%direction == OBC_DIRECTION_S) - allocate(normal_trans_bt(segment%HI%isd:segment%HI%ied,segment%HI%JsdB:segment%HI%JedB)) - normal_trans_bt(:,:) = 0.0 + allocate(normal_trans_bt(segment%HI%isd:segment%HI%ied,segment%HI%JsdB:segment%HI%JedB), source=0.0) if (segment%direction == OBC_DIRECTION_S) jshift=1 J=segment%HI%JsdB do i=segment%HI%isd,segment%HI%ied @@ -3828,8 +3810,7 @@ subroutine update_OBC_segment_data(G, GV, US, OBC, tv, h, Time) enddo endif - allocate(h_stack(GV%ke)) - h_stack(:) = 0.0 + allocate(h_stack(GV%ke), source=0.0) do m = 1,segment%num_fields if (segment%field(m)%fid > 0) then siz(1)=size(segment%field(m)%buffer_src,1) @@ -4580,12 +4561,12 @@ subroutine register_segment_tracer(tr_ptr, param_file, GV, segment, & if (present(OBC_scalar)) segment%tr_Reg%Tr(ntseg)%OBC_inflow_conc = OBC_scalar ! initialize tracer value later if (present(OBC_array)) then if (segment%is_E_or_W) then - allocate(segment%tr_Reg%Tr(ntseg)%t(IsdB:IedB,jsd:jed,1:GV%ke));segment%tr_Reg%Tr(ntseg)%t(:,:,:)=0.0 - allocate(segment%tr_Reg%Tr(ntseg)%tres(IsdB:IedB,jsd:jed,1:GV%ke));segment%tr_Reg%Tr(ntseg)%tres(:,:,:)=0.0 + allocate(segment%tr_Reg%Tr(ntseg)%t(IsdB:IedB,jsd:jed,1:GV%ke), source=0.0) + allocate(segment%tr_Reg%Tr(ntseg)%tres(IsdB:IedB,jsd:jed,1:GV%ke), source=0.0) segment%tr_Reg%Tr(ntseg)%is_initialized=.false. elseif (segment%is_N_or_S) then - allocate(segment%tr_Reg%Tr(ntseg)%t(isd:ied,JsdB:JedB,1:GV%ke));segment%tr_Reg%Tr(ntseg)%t(:,:,:)=0.0 - allocate(segment%tr_Reg%Tr(ntseg)%tres(isd:ied,JsdB:JedB,1:GV%ke));segment%tr_Reg%Tr(ntseg)%tres(:,:,:)=0.0 + allocate(segment%tr_Reg%Tr(ntseg)%t(isd:ied,JsdB:JedB,1:GV%ke), source=0.0) + allocate(segment%tr_Reg%Tr(ntseg)%tres(isd:ied,JsdB:JedB,1:GV%ke), source=0.0) segment%tr_Reg%Tr(ntseg)%is_initialized=.false. endif endif @@ -4728,8 +4709,8 @@ subroutine mask_outside_OBCs(G, US, param_file, OBC) units="m", default=0.0, scale=US%m_to_Z, do_not_log=.true.) ! The reference depth on a dyn_horgrid is 0, otherwise would need: min_depth = min_depth - G%Z_ref - allocate(color(G%isd:G%ied, G%jsd:G%jed)) ; color = 0 - allocate(color2(G%isd:G%ied, G%jsd:G%jed)) ; color2 = 0 + allocate(color(G%isd:G%ied, G%jsd:G%jed), source=0.0) + allocate(color2(G%isd:G%ied, G%jsd:G%jed), source=0.0) ! Paint a frame around the outside. do j=G%jsd,G%jed @@ -4979,10 +4960,8 @@ subroutine open_boundary_register_restarts(HI, GV, OBC, Reg, param_file, restart ! to be able to add 2D ( x,z or y,z ) data to restarts to avoid using ! so much memory and disk space. *** if (OBC%radiation_BCs_exist_globally) then - allocate(OBC%rx_normal(HI%isdB:HI%iedB,HI%jsd:HI%jed,GV%ke)) - allocate(OBC%ry_normal(HI%isd:HI%ied,HI%jsdB:HI%jedB,GV%ke)) - OBC%rx_normal(:,:,:) = 0.0 - OBC%ry_normal(:,:,:) = 0.0 + allocate(OBC%rx_normal(HI%isdB:HI%iedB,HI%jsd:HI%jed,GV%ke), source=0.0) + allocate(OBC%ry_normal(HI%isd:HI%ied,HI%jsdB:HI%jedB,GV%ke), source=0.0) vd(1) = var_desc("rx_normal", "m s-1", "Normal Phase Speed for EW radiation OBCs", 'u', 'L') vd(2) = var_desc("ry_normal", "m s-1", "Normal Phase Speed for NS radiation OBCs", 'v', 'L') @@ -4991,18 +4970,15 @@ subroutine open_boundary_register_restarts(HI, GV, OBC, Reg, param_file, restart endif if (OBC%oblique_BCs_exist_globally) then - allocate(OBC%rx_oblique(HI%isdB:HI%iedB,HI%jsd:HI%jed,GV%ke)) - allocate(OBC%ry_oblique(HI%isd:HI%ied,HI%jsdB:HI%jedB,GV%ke)) - OBC%rx_oblique(:,:,:) = 0.0 - OBC%ry_oblique(:,:,:) = 0.0 + allocate(OBC%rx_oblique(HI%isdB:HI%iedB,HI%jsd:HI%jed,GV%ke), source=0.0) + allocate(OBC%ry_oblique(HI%isd:HI%ied,HI%jsdB:HI%jedB,GV%ke), source=0.0) vd(1) = var_desc("rx_oblique", "m2 s-2", "Radiation Speed Squared for EW oblique OBCs", 'u', 'L') vd(2) = var_desc("ry_oblique", "m2 s-2", "Radiation Speed Squared for NS oblique OBCs", 'v', 'L') call register_restart_pair(OBC%rx_oblique, OBC%ry_oblique, vd(1), vd(2), & .false., restart_CSp) - allocate(OBC%cff_normal(HI%IsdB:HI%IedB,HI%jsdB:HI%jedB,GV%ke)) - OBC%cff_normal(:,:,:) = 0.0 + allocate(OBC%cff_normal(HI%IsdB:HI%IedB,HI%jsdB:HI%jedB,GV%ke), source=0.0) vd(1) = var_desc("cff_normal", "m2 s-2", "denominator for oblique OBCs", 'q', 'L') call register_restart_field(OBC%cff_normal, vd(1), .false., restart_CSp) endif @@ -5010,10 +4986,8 @@ subroutine open_boundary_register_restarts(HI, GV, OBC, Reg, param_file, restart if (Reg%ntr == 0) return if (.not. associated(OBC%tracer_x_reservoirs_used)) then OBC%ntr = Reg%ntr - allocate(OBC%tracer_x_reservoirs_used(Reg%ntr)) - allocate(OBC%tracer_y_reservoirs_used(Reg%ntr)) - OBC%tracer_x_reservoirs_used(:) = .false. - OBC%tracer_y_reservoirs_used(:) = .false. + allocate(OBC%tracer_x_reservoirs_used(Reg%ntr), source=.false.) + allocate(OBC%tracer_y_reservoirs_used(Reg%ntr), source=.false.) call parse_for_tracer_reservoirs(OBC, param_file, use_temperature) else ! This would be coming from user code such as DOME. @@ -5026,8 +5000,7 @@ subroutine open_boundary_register_restarts(HI, GV, OBC, Reg, param_file, restart ! Still painfully inefficient, now in four dimensions. if (any(OBC%tracer_x_reservoirs_used)) then - allocate(OBC%tres_x(HI%isdB:HI%iedB,HI%jsd:HI%jed,GV%ke,OBC%ntr)) - OBC%tres_x(:,:,:,:) = 0.0 + allocate(OBC%tres_x(HI%isdB:HI%iedB,HI%jsd:HI%jed,GV%ke,OBC%ntr), source=0.0) do m=1,OBC%ntr if (OBC%tracer_x_reservoirs_used(m)) then if (modulo(HI%turns, 2) /= 0) then @@ -5043,8 +5016,7 @@ subroutine open_boundary_register_restarts(HI, GV, OBC, Reg, param_file, restart enddo endif if (any(OBC%tracer_y_reservoirs_used)) then - allocate(OBC%tres_y(HI%isd:HI%ied,HI%jsdB:HI%jedB,GV%ke,OBC%ntr)) - OBC%tres_y(:,:,:,:) = 0.0 + allocate(OBC%tres_y(HI%isd:HI%ied,HI%jsdB:HI%jedB,GV%ke,OBC%ntr), source=0.0) do m=1,OBC%ntr if (OBC%tracer_y_reservoirs_used(m)) then if (modulo(HI%turns, 2) /= 0) then diff --git a/src/core/MOM_variables.F90 b/src/core/MOM_variables.F90 index 9b250d8007..363f3eebfb 100644 --- a/src/core/MOM_variables.F90 +++ b/src/core/MOM_variables.F90 @@ -348,43 +348,43 @@ subroutine allocate_surface_state(sfc_state, G, use_temperature, do_integrals, & if (sfc_state%arrays_allocated) return if (use_temp) then - allocate(sfc_state%SST(isd:ied,jsd:jed)) ; sfc_state%SST(:,:) = 0.0 - allocate(sfc_state%SSS(isd:ied,jsd:jed)) ; sfc_state%SSS(:,:) = 0.0 + allocate(sfc_state%SST(isd:ied,jsd:jed), source=0.0) + allocate(sfc_state%SSS(isd:ied,jsd:jed), source=0.0) else - allocate(sfc_state%sfc_density(isd:ied,jsd:jed)) ; sfc_state%sfc_density(:,:) = 0.0 + allocate(sfc_state%sfc_density(isd:ied,jsd:jed), source=0.0) endif if (use_temp .and. alloc_frazil) then - allocate(sfc_state%frazil(isd:ied,jsd:jed)) ; sfc_state%frazil(:,:) = 0.0 + allocate(sfc_state%frazil(isd:ied,jsd:jed), source=0.0) endif - allocate(sfc_state%sea_lev(isd:ied,jsd:jed)) ; sfc_state%sea_lev(:,:) = 0.0 - allocate(sfc_state%Hml(isd:ied,jsd:jed)) ; sfc_state%Hml(:,:) = 0.0 - allocate(sfc_state%u(IsdB:IedB,jsd:jed)) ; sfc_state%u(:,:) = 0.0 - allocate(sfc_state%v(isd:ied,JsdB:JedB)) ; sfc_state%v(:,:) = 0.0 + allocate(sfc_state%sea_lev(isd:ied,jsd:jed), source=0.0) + allocate(sfc_state%Hml(isd:ied,jsd:jed), source=0.0) + allocate(sfc_state%u(IsdB:IedB,jsd:jed), source=0.0) + allocate(sfc_state%v(isd:ied,JsdB:JedB), source=0.0) if (use_melt_potential) then - allocate(sfc_state%melt_potential(isd:ied,jsd:jed)) ; sfc_state%melt_potential(:,:) = 0.0 + allocate(sfc_state%melt_potential(isd:ied,jsd:jed), source=0.0) endif if (alloc_cfcs) then - allocate(sfc_state%sfc_cfc11(isd:ied,jsd:jed)) ; sfc_state%sfc_cfc11(:,:) = 0.0 - allocate(sfc_state%sfc_cfc12(isd:ied,jsd:jed)) ; sfc_state%sfc_cfc12(:,:) = 0.0 + allocate(sfc_state%sfc_cfc11(isd:ied,jsd:jed), source=0.0) + allocate(sfc_state%sfc_cfc12(isd:ied,jsd:jed), source=0.0) endif if (alloc_integ) then ! Allocate structures for the vertically integrated ocean_mass, ocean_heat, and ocean_salt. - allocate(sfc_state%ocean_mass(isd:ied,jsd:jed)) ; sfc_state%ocean_mass(:,:) = 0.0 + allocate(sfc_state%ocean_mass(isd:ied,jsd:jed), source=0.0) if (use_temp) then - allocate(sfc_state%ocean_heat(isd:ied,jsd:jed)) ; sfc_state%ocean_heat(:,:) = 0.0 - allocate(sfc_state%ocean_salt(isd:ied,jsd:jed)) ; sfc_state%ocean_salt(:,:) = 0.0 - allocate(sfc_state%TempxPmE(isd:ied,jsd:jed)) ; sfc_state%TempxPmE(:,:) = 0.0 - allocate(sfc_state%salt_deficit(isd:ied,jsd:jed)) ; sfc_state%salt_deficit(:,:) = 0.0 - allocate(sfc_state%internal_heat(isd:ied,jsd:jed)) ; sfc_state%internal_heat(:,:) = 0.0 + allocate(sfc_state%ocean_heat(isd:ied,jsd:jed), source=0.0) + allocate(sfc_state%ocean_salt(isd:ied,jsd:jed), source=0.0) + allocate(sfc_state%TempxPmE(isd:ied,jsd:jed), source=0.0) + allocate(sfc_state%salt_deficit(isd:ied,jsd:jed), source=0.0) + allocate(sfc_state%internal_heat(isd:ied,jsd:jed), source=0.0) endif endif if (alloc_iceshelves) then - allocate(sfc_state%taux_shelf(IsdB:IedB,jsd:jed)) ; sfc_state%taux_shelf(:,:) = 0.0 - allocate(sfc_state%tauy_shelf(isd:ied,JsdB:JedB)) ; sfc_state%tauy_shelf(:,:) = 0.0 + allocate(sfc_state%taux_shelf(IsdB:IedB,jsd:jed), source=0.0) + allocate(sfc_state%tauy_shelf(isd:ied,JsdB:JedB), source=0.0) endif if (present(gas_fields_ocn)) & @@ -509,23 +509,23 @@ subroutine alloc_BT_cont_type(BT_cont, G, GV, alloc_faces) "alloc_BT_cont_type called with an associated BT_cont_type pointer.") allocate(BT_cont) - allocate(BT_cont%FA_u_WW(IsdB:IedB,jsd:jed)) ; BT_cont%FA_u_WW(:,:) = 0.0 - allocate(BT_cont%FA_u_W0(IsdB:IedB,jsd:jed)) ; BT_cont%FA_u_W0(:,:) = 0.0 - allocate(BT_cont%FA_u_E0(IsdB:IedB,jsd:jed)) ; BT_cont%FA_u_E0(:,:) = 0.0 - allocate(BT_cont%FA_u_EE(IsdB:IedB,jsd:jed)) ; BT_cont%FA_u_EE(:,:) = 0.0 - allocate(BT_cont%uBT_WW(IsdB:IedB,jsd:jed)) ; BT_cont%uBT_WW(:,:) = 0.0 - allocate(BT_cont%uBT_EE(IsdB:IedB,jsd:jed)) ; BT_cont%uBT_EE(:,:) = 0.0 - - allocate(BT_cont%FA_v_SS(isd:ied,JsdB:JedB)) ; BT_cont%FA_v_SS(:,:) = 0.0 - allocate(BT_cont%FA_v_S0(isd:ied,JsdB:JedB)) ; BT_cont%FA_v_S0(:,:) = 0.0 - allocate(BT_cont%FA_v_N0(isd:ied,JsdB:JedB)) ; BT_cont%FA_v_N0(:,:) = 0.0 - allocate(BT_cont%FA_v_NN(isd:ied,JsdB:JedB)) ; BT_cont%FA_v_NN(:,:) = 0.0 - allocate(BT_cont%vBT_SS(isd:ied,JsdB:JedB)) ; BT_cont%vBT_SS(:,:) = 0.0 - allocate(BT_cont%vBT_NN(isd:ied,JsdB:JedB)) ; BT_cont%vBT_NN(:,:) = 0.0 + allocate(BT_cont%FA_u_WW(IsdB:IedB,jsd:jed), source=0.0) + allocate(BT_cont%FA_u_W0(IsdB:IedB,jsd:jed), source=0.0) + allocate(BT_cont%FA_u_E0(IsdB:IedB,jsd:jed), source=0.0) + allocate(BT_cont%FA_u_EE(IsdB:IedB,jsd:jed), source=0.0) + allocate(BT_cont%uBT_WW(IsdB:IedB,jsd:jed), source=0.0) + allocate(BT_cont%uBT_EE(IsdB:IedB,jsd:jed), source=0.0) + + allocate(BT_cont%FA_v_SS(isd:ied,JsdB:JedB), source=0.0) + allocate(BT_cont%FA_v_S0(isd:ied,JsdB:JedB), source=0.0) + allocate(BT_cont%FA_v_N0(isd:ied,JsdB:JedB), source=0.0) + allocate(BT_cont%FA_v_NN(isd:ied,JsdB:JedB), source=0.0) + allocate(BT_cont%vBT_SS(isd:ied,JsdB:JedB), source=0.0) + allocate(BT_cont%vBT_NN(isd:ied,JsdB:JedB), source=0.0) if (present(alloc_faces)) then ; if (alloc_faces) then - allocate(BT_cont%h_u(IsdB:IedB,jsd:jed,1:nz)) ; BT_cont%h_u(:,:,:) = 0.0 - allocate(BT_cont%h_v(isd:ied,JsdB:JedB,1:nz)) ; BT_cont%h_v(:,:,:) = 0.0 + allocate(BT_cont%h_u(IsdB:IedB,jsd:jed,1:nz), source=0.0) + allocate(BT_cont%h_v(isd:ied,JsdB:JedB,1:nz), source=0.0) endif ; endif end subroutine alloc_BT_cont_type diff --git a/src/core/MOM_verticalGrid.F90 b/src/core/MOM_verticalGrid.F90 index 7495e0033b..46fbd55862 100644 --- a/src/core/MOM_verticalGrid.F90 +++ b/src/core/MOM_verticalGrid.F90 @@ -173,8 +173,8 @@ subroutine verticalGridInit( param_file, GV, US ) allocate( GV%sInterface(nk+1) ) allocate( GV%sLayer(nk) ) - allocate( GV%g_prime(nk+1) ) ; GV%g_prime(:) = 0.0 - allocate( GV%Rlay(nk) ) ; GV%Rlay(:) = 0.0 + allocate( GV%g_prime(nk+1), source=0.0 ) + allocate( GV%Rlay(nk), source=0.0 ) end subroutine verticalGridInit diff --git a/src/framework/MOM_checksums.F90 b/src/framework/MOM_checksums.F90 index 7b073e8a0b..718a796802 100644 --- a/src/framework/MOM_checksums.F90 +++ b/src/framework/MOM_checksums.F90 @@ -151,8 +151,7 @@ subroutine zchksum(array, mesg, scale, logunit) if (calculateStatistics) then if (present(scale)) then - allocate(rescaled_array(LBOUND(array,1):UBOUND(array,1))) - rescaled_array(:) = 0.0 + allocate(rescaled_array(LBOUND(array,1):UBOUND(array,1)), source=0.0) do k=1, size(array, 1) rescaled_array(k) = scale * array(k) enddo @@ -358,8 +357,7 @@ subroutine chksum_h_2d(array_m, mesg, HI_m, haloshift, omit_corners, scale, logu if (calculateStatistics) then if (present(scale)) then allocate( rescaled_array(LBOUND(array,1):UBOUND(array,1), & - LBOUND(array,2):UBOUND(array,2)) ) - rescaled_array(:,:) = 0.0 + LBOUND(array,2):UBOUND(array,2)), source=0.0 ) do j=HI%jsc,HI%jec ; do i=HI%isc,HI%iec rescaled_array(i,j) = scale*array(i,j) enddo ; enddo @@ -627,8 +625,7 @@ subroutine chksum_B_2d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, if (calculateStatistics) then if (present(scale)) then allocate( rescaled_array(LBOUND(array,1):UBOUND(array,1), & - LBOUND(array,2):UBOUND(array,2)) ) - rescaled_array(:,:) = 0.0 + LBOUND(array,2):UBOUND(array,2)), source=0.0 ) Is = HI%isc ; if (sym_stats) Is = HI%isc-1 Js = HI%jsc ; if (sym_stats) Js = HI%jsc-1 do J=Js,HI%JecB ; do I=Is,HI%IecB @@ -911,8 +908,7 @@ subroutine chksum_u_2d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, if (calculateStatistics) then if (present(scale)) then allocate( rescaled_array(LBOUND(array,1):UBOUND(array,1), & - LBOUND(array,2):UBOUND(array,2)) ) - rescaled_array(:,:) = 0.0 + LBOUND(array,2):UBOUND(array,2)), source=0.0 ) Is = HI%isc ; if (sym_stats) Is = HI%isc-1 do j=HI%jsc,HI%jec ; do I=Is,HI%IecB rescaled_array(I,j) = scale*array(I,j) @@ -1090,8 +1086,7 @@ subroutine chksum_v_2d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, if (calculateStatistics) then if (present(scale)) then allocate( rescaled_array(LBOUND(array,1):UBOUND(array,1), & - LBOUND(array,2):UBOUND(array,2)) ) - rescaled_array(:,:) = 0.0 + LBOUND(array,2):UBOUND(array,2)), source=0.0 ) Js = HI%jsc ; if (sym_stats) Js = HI%jsc-1 do J=Js,HI%JecB ; do i=HI%isc,HI%iec rescaled_array(i,J) = scale*array(i,J) @@ -1257,8 +1252,7 @@ subroutine chksum_h_3d(array_m, mesg, HI_m, haloshift, omit_corners, scale, logu if (present(scale)) then allocate( rescaled_array(LBOUND(array,1):UBOUND(array,1), & LBOUND(array,2):UBOUND(array,2), & - LBOUND(array,3):UBOUND(array,3)) ) - rescaled_array(:,:,:) = 0.0 + LBOUND(array,3):UBOUND(array,3)), source=0.0 ) do k=1,size(array,3) ; do j=HI%jsc,HI%jec ; do i=HI%isc,HI%iec rescaled_array(i,j,k) = scale*array(i,j,k) enddo ; enddo ; enddo @@ -1411,8 +1405,7 @@ subroutine chksum_B_3d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, if (present(scale)) then allocate( rescaled_array(LBOUND(array,1):UBOUND(array,1), & LBOUND(array,2):UBOUND(array,2), & - LBOUND(array,3):UBOUND(array,3)) ) - rescaled_array(:,:,:) = 0.0 + LBOUND(array,3):UBOUND(array,3)), source=0.0 ) Is = HI%isc ; if (sym_stats) Is = HI%isc-1 Js = HI%jsc ; if (sym_stats) Js = HI%jsc-1 do k=1,size(array,3) ; do J=Js,HI%JecB ; do I=Is,HI%IecB @@ -1591,8 +1584,7 @@ subroutine chksum_u_3d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, if (present(scale)) then allocate( rescaled_array(LBOUND(array,1):UBOUND(array,1), & LBOUND(array,2):UBOUND(array,2), & - LBOUND(array,3):UBOUND(array,3)) ) - rescaled_array(:,:,:) = 0.0 + LBOUND(array,3):UBOUND(array,3)), source=0.0 ) Is = HI%isc ; if (sym_stats) Is = HI%isc-1 do k=1,size(array,3) ; do j=HI%jsc,HI%jec ; do I=Is,HI%IecB rescaled_array(I,j,k) = scale*array(I,j,k) @@ -1770,8 +1762,7 @@ subroutine chksum_v_3d(array_m, mesg, HI_m, haloshift, symmetric, omit_corners, if (present(scale)) then allocate( rescaled_array(LBOUND(array,1):UBOUND(array,1), & LBOUND(array,2):UBOUND(array,2), & - LBOUND(array,3):UBOUND(array,3)) ) - rescaled_array(:,:,:) = 0.0 + LBOUND(array,3):UBOUND(array,3)), source=0.0 ) Js = HI%jsc ; if (sym_stats) Js = HI%jsc-1 do k=1,size(array,3) ; do J=Js,HI%JecB ; do i=HI%isc,HI%iec rescaled_array(i,J,k) = scale*array(i,J,k) @@ -1921,7 +1912,7 @@ subroutine chksum1d(array, mesg, start_i, end_i, compare_PEs) enddo pe_num = pe_here() + 1 - root_pe() ; nPEs = num_pes() - allocate(sum_here(nPEs)) ; sum_here(:) = 0.0 ; sum_here(pe_num) = sum + allocate(sum_here(nPEs), source=0.0) ; sum_here(pe_num) = sum call sum_across_PEs(sum_here,nPEs) sum1 = sum_bc diff --git a/src/framework/MOM_diag_mediator.F90 b/src/framework/MOM_diag_mediator.F90 index 836c692486..374f54548e 100644 --- a/src/framework/MOM_diag_mediator.F90 +++ b/src/framework/MOM_diag_mediator.F90 @@ -764,7 +764,7 @@ subroutine set_masks_for_axes(G, diag_cs) ! Level/layer h-points in diagnostic coordinate axes => diag_cs%remap_axesTL(c) nk = axes%nz - allocate( axes%mask3d(G%isd:G%ied,G%jsd:G%jed,nk) ) ; axes%mask3d(:,:,:) = 0. + allocate( axes%mask3d(G%isd:G%ied,G%jsd:G%jed,nk), source=0. ) call diag_remap_calc_hmask(diag_cs%diag_remap_cs(c), G, axes%mask3d) h_axes => diag_cs%remap_axesTL(c) ! Use the h-point masks to generate the u-, v- and q- masks @@ -773,7 +773,7 @@ subroutine set_masks_for_axes(G, diag_cs) axes => diag_cs%remap_axesCuL(c) call assert(axes%nz == nk, 'set_masks_for_axes: vertical size mismatch at u-layers') call assert(.not. associated(axes%mask3d), 'set_masks_for_axes: already associated') - allocate( axes%mask3d(G%IsdB:G%IedB,G%jsd:G%jed,nk) ) ; axes%mask3d(:,:,:) = 0. + allocate( axes%mask3d(G%IsdB:G%IedB,G%jsd:G%jed,nk), source=0. ) do k = 1, nk ; do j=G%jsc,G%jec ; do I=G%isc-1,G%iec if (h_axes%mask3d(i,j,k) + h_axes%mask3d(i+1,j,k) > 0.) axes%mask3d(I,j,k) = 1. enddo ; enddo ; enddo @@ -782,7 +782,7 @@ subroutine set_masks_for_axes(G, diag_cs) axes => diag_cs%remap_axesCvL(c) call assert(axes%nz == nk, 'set_masks_for_axes: vertical size mismatch at v-layers') call assert(.not. associated(axes%mask3d), 'set_masks_for_axes: already associated') - allocate( axes%mask3d(G%isd:G%ied,G%JsdB:G%JedB,nk) ) ; axes%mask3d(:,:,:) = 0. + allocate( axes%mask3d(G%isd:G%ied,G%JsdB:G%JedB,nk), source=0. ) do k = 1, nk ; do J=G%jsc-1,G%jec ; do i=G%isc,G%iec if (h_axes%mask3d(i,j,k) + h_axes%mask3d(i,j+1,k) > 0.) axes%mask3d(i,J,k) = 1. enddo ; enddo ; enddo @@ -791,7 +791,7 @@ subroutine set_masks_for_axes(G, diag_cs) axes => diag_cs%remap_axesBL(c) call assert(axes%nz == nk, 'set_masks_for_axes: vertical size mismatch at q-layers') call assert(.not. associated(axes%mask3d), 'set_masks_for_axes: already associated') - allocate( axes%mask3d(G%IsdB:G%IedB,G%JsdB:G%JedB,nk) ) ; axes%mask3d(:,:,:) = 0. + allocate( axes%mask3d(G%IsdB:G%IedB,G%JsdB:G%JedB,nk), source=0. ) do k = 1, nk ; do J=G%jsc-1,G%jec ; do I=G%isc-1,G%iec if (h_axes%mask3d(i,j,k) + h_axes%mask3d(i+1,j+1,k) + & h_axes%mask3d(i+1,j,k) + h_axes%mask3d(i,j+1,k) > 0.) axes%mask3d(I,J,k) = 1. @@ -801,7 +801,7 @@ subroutine set_masks_for_axes(G, diag_cs) axes => diag_cs%remap_axesTi(c) call assert(axes%nz == nk, 'set_masks_for_axes: vertical size mismatch at h-interfaces') call assert(.not. associated(axes%mask3d), 'set_masks_for_axes: already associated') - allocate( axes%mask3d(G%isd:G%ied,G%jsd:G%jed,nk+1) ) ; axes%mask3d(:,:,:) = 0. + allocate( axes%mask3d(G%isd:G%ied,G%jsd:G%jed,nk+1), source=0. ) do J=G%jsc-1,G%jec+1 ; do i=G%isc-1,G%iec+1 if (h_axes%mask3d(i,j,1) > 0.) axes%mask3d(i,J,1) = 1. do K = 2, nk @@ -816,7 +816,7 @@ subroutine set_masks_for_axes(G, diag_cs) axes => diag_cs%remap_axesCui(c) call assert(axes%nz == nk, 'set_masks_for_axes: vertical size mismatch at u-interfaces') call assert(.not. associated(axes%mask3d), 'set_masks_for_axes: already associated') - allocate( axes%mask3d(G%IsdB:G%IedB,G%jsd:G%jed,nk+1) ) ; axes%mask3d(:,:,:) = 0. + allocate( axes%mask3d(G%IsdB:G%IedB,G%jsd:G%jed,nk+1), source=0. ) do k = 1, nk+1 ; do j=G%jsc,G%jec ; do I=G%isc-1,G%iec if (h_axes%mask3d(i,j,k) + h_axes%mask3d(i+1,j,k) > 0.) axes%mask3d(I,j,k) = 1. enddo ; enddo ; enddo @@ -825,7 +825,7 @@ subroutine set_masks_for_axes(G, diag_cs) axes => diag_cs%remap_axesCvi(c) call assert(axes%nz == nk, 'set_masks_for_axes: vertical size mismatch at v-interfaces') call assert(.not. associated(axes%mask3d), 'set_masks_for_axes: already associated') - allocate( axes%mask3d(G%isd:G%ied,G%JsdB:G%JedB,nk+1) ) ; axes%mask3d(:,:,:) = 0. + allocate( axes%mask3d(G%isd:G%ied,G%JsdB:G%JedB,nk+1), source=0. ) do k = 1, nk+1 ; do J=G%jsc-1,G%jec ; do i=G%isc,G%iec if (h_axes%mask3d(i,j,k) + h_axes%mask3d(i,j+1,k) > 0.) axes%mask3d(i,J,k) = 1. enddo ; enddo ; enddo @@ -834,7 +834,7 @@ subroutine set_masks_for_axes(G, diag_cs) axes => diag_cs%remap_axesBi(c) call assert(axes%nz == nk, 'set_masks_for_axes: vertical size mismatch at q-interfaces') call assert(.not. associated(axes%mask3d), 'set_masks_for_axes: already associated') - allocate( axes%mask3d(G%IsdB:G%IedB,G%JsdB:G%JedB,nk+1) ) ; axes%mask3d(:,:,:) = 0. + allocate( axes%mask3d(G%IsdB:G%IedB,G%JsdB:G%JedB,nk+1), source=0. ) do k = 1, nk ; do J=G%jsc-1,G%jec ; do I=G%isc-1,G%iec if (h_axes%mask3d(i,j,k) + h_axes%mask3d(i+1,j+1,k) + & h_axes%mask3d(i+1,j,k) + h_axes%mask3d(i,j+1,k) > 0.) axes%mask3d(I,J,k) = 1. diff --git a/src/framework/MOM_dyn_horgrid.F90 b/src/framework/MOM_dyn_horgrid.F90 index 89a59374a7..43aeb3372a 100644 --- a/src/framework/MOM_dyn_horgrid.F90 +++ b/src/framework/MOM_dyn_horgrid.F90 @@ -211,71 +211,71 @@ subroutine create_dyn_horgrid(G, HI, bathymetry_at_vel) IsdB = G%IsdB ; IedB = G%IedB ; JsdB = G%JsdB ; JedB = G%JedB isg = G%isg ; ieg = G%ieg ; jsg = G%jsg ; jeg = G%jeg - allocate(G%dxT(isd:ied,jsd:jed)) ; G%dxT(:,:) = 0.0 - allocate(G%dxCu(IsdB:IedB,jsd:jed)) ; G%dxCu(:,:) = 0.0 - allocate(G%dxCv(isd:ied,JsdB:JedB)) ; G%dxCv(:,:) = 0.0 - allocate(G%dxBu(IsdB:IedB,JsdB:JedB)) ; G%dxBu(:,:) = 0.0 - allocate(G%IdxT(isd:ied,jsd:jed)) ; G%IdxT(:,:) = 0.0 - allocate(G%IdxCu(IsdB:IedB,jsd:jed)) ; G%IdxCu(:,:) = 0.0 - allocate(G%IdxCv(isd:ied,JsdB:JedB)) ; G%IdxCv(:,:) = 0.0 - allocate(G%IdxBu(IsdB:IedB,JsdB:JedB)) ; G%IdxBu(:,:) = 0.0 - - allocate(G%dyT(isd:ied,jsd:jed)) ; G%dyT(:,:) = 0.0 - allocate(G%dyCu(IsdB:IedB,jsd:jed)) ; G%dyCu(:,:) = 0.0 - allocate(G%dyCv(isd:ied,JsdB:JedB)) ; G%dyCv(:,:) = 0.0 - allocate(G%dyBu(IsdB:IedB,JsdB:JedB)) ; G%dyBu(:,:) = 0.0 - allocate(G%IdyT(isd:ied,jsd:jed)) ; G%IdyT(:,:) = 0.0 - allocate(G%IdyCu(IsdB:IedB,jsd:jed)) ; G%IdyCu(:,:) = 0.0 - allocate(G%IdyCv(isd:ied,JsdB:JedB)) ; G%IdyCv(:,:) = 0.0 - allocate(G%IdyBu(IsdB:IedB,JsdB:JedB)) ; G%IdyBu(:,:) = 0.0 - - allocate(G%areaT(isd:ied,jsd:jed)) ; G%areaT(:,:) = 0.0 - allocate(G%IareaT(isd:ied,jsd:jed)) ; G%IareaT(:,:) = 0.0 - allocate(G%areaBu(IsdB:IedB,JsdB:JedB)) ; G%areaBu(:,:) = 0.0 - allocate(G%IareaBu(IsdB:IedB,JsdB:JedB)) ; G%IareaBu(:,:) = 0.0 - - allocate(G%mask2dT(isd:ied,jsd:jed)) ; G%mask2dT(:,:) = 0.0 - allocate(G%mask2dCu(IsdB:IedB,jsd:jed)) ; G%mask2dCu(:,:) = 0.0 - allocate(G%mask2dCv(isd:ied,JsdB:JedB)) ; G%mask2dCv(:,:) = 0.0 - allocate(G%mask2dBu(IsdB:IedB,JsdB:JedB)) ; G%mask2dBu(:,:) = 0.0 - allocate(G%geoLatT(isd:ied,jsd:jed)) ; G%geoLatT(:,:) = 0.0 - allocate(G%geoLatCu(IsdB:IedB,jsd:jed)) ; G%geoLatCu(:,:) = 0.0 - allocate(G%geoLatCv(isd:ied,JsdB:JedB)) ; G%geoLatCv(:,:) = 0.0 - allocate(G%geoLatBu(IsdB:IedB,JsdB:JedB)) ; G%geoLatBu(:,:) = 0.0 - allocate(G%geoLonT(isd:ied,jsd:jed)) ; G%geoLonT(:,:) = 0.0 - allocate(G%geoLonCu(IsdB:IedB,jsd:jed)) ; G%geoLonCu(:,:) = 0.0 - allocate(G%geoLonCv(isd:ied,JsdB:JedB)) ; G%geoLonCv(:,:) = 0.0 - allocate(G%geoLonBu(IsdB:IedB,JsdB:JedB)) ; G%geoLonBu(:,:) = 0.0 - - allocate(G%dx_Cv(isd:ied,JsdB:JedB)) ; G%dx_Cv(:,:) = 0.0 - allocate(G%dy_Cu(IsdB:IedB,jsd:jed)) ; G%dy_Cu(:,:) = 0.0 - - allocate(G%areaCu(IsdB:IedB,jsd:jed)) ; G%areaCu(:,:) = 0.0 - allocate(G%areaCv(isd:ied,JsdB:JedB)) ; G%areaCv(:,:) = 0.0 - allocate(G%IareaCu(IsdB:IedB,jsd:jed)) ; G%IareaCu(:,:) = 0.0 - allocate(G%IareaCv(isd:ied,JsdB:JedB)) ; G%IareaCv(:,:) = 0.0 - - allocate(G%bathyT(isd:ied, jsd:jed)) ; G%bathyT(:,:) = 0.0 - allocate(G%CoriolisBu(IsdB:IedB, JsdB:JedB)) ; G%CoriolisBu(:,:) = 0.0 - allocate(G%dF_dx(isd:ied, jsd:jed)) ; G%dF_dx(:,:) = 0.0 - allocate(G%dF_dy(isd:ied, jsd:jed)) ; G%dF_dy(:,:) = 0.0 - - allocate(G%sin_rot(isd:ied,jsd:jed)) ; G%sin_rot(:,:) = 0.0 - allocate(G%cos_rot(isd:ied,jsd:jed)) ; G%cos_rot(:,:) = 1.0 + allocate(G%dxT(isd:ied,jsd:jed), source=0.0) + allocate(G%dxCu(IsdB:IedB,jsd:jed), source=0.0) + allocate(G%dxCv(isd:ied,JsdB:JedB), source=0.0) + allocate(G%dxBu(IsdB:IedB,JsdB:JedB), source=0.0) + allocate(G%IdxT(isd:ied,jsd:jed), source=0.0) + allocate(G%IdxCu(IsdB:IedB,jsd:jed), source=0.0) + allocate(G%IdxCv(isd:ied,JsdB:JedB), source=0.0) + allocate(G%IdxBu(IsdB:IedB,JsdB:JedB), source=0.0) + + allocate(G%dyT(isd:ied,jsd:jed), source=0.0) + allocate(G%dyCu(IsdB:IedB,jsd:jed), source=0.0) + allocate(G%dyCv(isd:ied,JsdB:JedB), source=0.0) + allocate(G%dyBu(IsdB:IedB,JsdB:JedB), source=0.0) + allocate(G%IdyT(isd:ied,jsd:jed), source=0.0) + allocate(G%IdyCu(IsdB:IedB,jsd:jed), source=0.0) + allocate(G%IdyCv(isd:ied,JsdB:JedB), source=0.0) + allocate(G%IdyBu(IsdB:IedB,JsdB:JedB), source=0.0) + + allocate(G%areaT(isd:ied,jsd:jed), source=0.0) + allocate(G%IareaT(isd:ied,jsd:jed), source=0.0) + allocate(G%areaBu(IsdB:IedB,JsdB:JedB), source=0.0) + allocate(G%IareaBu(IsdB:IedB,JsdB:JedB), source=0.0) + + allocate(G%mask2dT(isd:ied,jsd:jed), source=0.0) + allocate(G%mask2dCu(IsdB:IedB,jsd:jed), source=0.0) + allocate(G%mask2dCv(isd:ied,JsdB:JedB), source=0.0) + allocate(G%mask2dBu(IsdB:IedB,JsdB:JedB), source=0.0) + allocate(G%geoLatT(isd:ied,jsd:jed), source=0.0) + allocate(G%geoLatCu(IsdB:IedB,jsd:jed), source=0.0) + allocate(G%geoLatCv(isd:ied,JsdB:JedB), source=0.0) + allocate(G%geoLatBu(IsdB:IedB,JsdB:JedB), source=0.0) + allocate(G%geoLonT(isd:ied,jsd:jed), source=0.0) + allocate(G%geoLonCu(IsdB:IedB,jsd:jed), source=0.0) + allocate(G%geoLonCv(isd:ied,JsdB:JedB), source=0.0) + allocate(G%geoLonBu(IsdB:IedB,JsdB:JedB), source=0.0) + + allocate(G%dx_Cv(isd:ied,JsdB:JedB), source=0.0) + allocate(G%dy_Cu(IsdB:IedB,jsd:jed), source=0.0) + + allocate(G%areaCu(IsdB:IedB,jsd:jed), source=0.0) + allocate(G%areaCv(isd:ied,JsdB:JedB), source=0.0) + allocate(G%IareaCu(IsdB:IedB,jsd:jed), source=0.0) + allocate(G%IareaCv(isd:ied,JsdB:JedB), source=0.0) + + allocate(G%bathyT(isd:ied, jsd:jed), source=0.0) + allocate(G%CoriolisBu(IsdB:IedB, JsdB:JedB), source=0.0) + allocate(G%dF_dx(isd:ied, jsd:jed), source=0.0) + allocate(G%dF_dy(isd:ied, jsd:jed), source=0.0) + + allocate(G%sin_rot(isd:ied,jsd:jed), source=0.0) + allocate(G%cos_rot(isd:ied,jsd:jed), source=1.0) if (G%bathymetry_at_vel) then - allocate(G%Dblock_u(IsdB:IedB, jsd:jed)) ; G%Dblock_u(:,:) = 0.0 - allocate(G%Dopen_u(IsdB:IedB, jsd:jed)) ; G%Dopen_u(:,:) = 0.0 - allocate(G%Dblock_v(isd:ied, JsdB:JedB)) ; G%Dblock_v(:,:) = 0.0 - allocate(G%Dopen_v(isd:ied, JsdB:JedB)) ; G%Dopen_v(:,:) = 0.0 + allocate(G%Dblock_u(IsdB:IedB, jsd:jed), source=0.0) + allocate(G%Dopen_u(IsdB:IedB, jsd:jed), source=0.0) + allocate(G%Dblock_v(isd:ied, JsdB:JedB), source=0.0) + allocate(G%Dopen_v(isd:ied, JsdB:JedB), source=0.0) endif ! gridLonB and gridLatB are used as edge values in some cases, so they ! always need to use symmetric memory allcoations. - allocate(G%gridLonT(isg:ieg)) ; G%gridLonT(:) = 0.0 - allocate(G%gridLonB(isg-1:ieg)) ; G%gridLonB(:) = 0.0 - allocate(G%gridLatT(jsg:jeg)) ; G%gridLatT(:) = 0.0 - allocate(G%gridLatB(jsg-1:jeg)) ; G%gridLatB(:) = 0.0 + allocate(G%gridLonT(isg:ieg), source=0.0) + allocate(G%gridLonB(isg-1:ieg), source=0.0) + allocate(G%gridLatT(jsg:jeg), source=0.0) + allocate(G%gridLatB(jsg-1:jeg), source=0.0) end subroutine create_dyn_horgrid diff --git a/src/framework/MOM_horizontal_regridding.F90 b/src/framework/MOM_horizontal_regridding.F90 index de2a76a746..491bcae2a4 100644 --- a/src/framework/MOM_horizontal_regridding.F90 +++ b/src/framework/MOM_horizontal_regridding.F90 @@ -428,8 +428,8 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, z_edges_in(kd+1) = 2.0*z_in(kd) - z_in(kd-1) if (is_ongrid) then - allocate(tr_in(is:ie,js:je)) ; tr_in(:,:)=0.0 - allocate(mask_in(is:ie,js:je)) ; mask_in(:,:)=0.0 + allocate(tr_in(is:ie,js:je), source=0.0) + allocate(mask_in(is:ie,js:je), source=0.0) else call horiz_interp_init() lon_in = lon_in*PI_180 @@ -438,9 +438,9 @@ subroutine horiz_interp_and_extrap_tracer_record(filename, varnam, conversion, call meshgrid(lon_in, lat_in, x_in, y_in) lon_out(:,:) = G%geoLonT(:,:)*PI_180 lat_out(:,:) = G%geoLatT(:,:)*PI_180 - allocate(tr_in(id,jd)) ; tr_in(:,:) = 0.0 - allocate(tr_inp(id,jdp)) ; tr_inp(:,:) = 0.0 - allocate(mask_in(id,jdp)) ; mask_in(:,:) = 0.0 + allocate(tr_in(id,jd), source=0.0) + allocate(tr_inp(id,jdp), source=0.0) + allocate(mask_in(id,jdp), source=0.0) endif max_depth = maxval(G%bathyT(:,:)) + G%Z_ref @@ -739,10 +739,10 @@ subroutine horiz_interp_and_extrap_tracer_fms_id(fms_id, Time, conversion, G, t call meshgrid(lon_in, lat_in, x_in, y_in) lon_out(:,:) = G%geoLonT(:,:)*PI_180 lat_out(:,:) = G%geoLatT(:,:)*PI_180 - allocate(data_in(id,jd,kd)) ; data_in(:,:,:)=0.0 - allocate(tr_in(id,jd)) ; tr_in(:,:)=0.0 - allocate(tr_inp(id,jdp)) ; tr_inp(:,:)=0.0 - allocate(mask_in(id,jdp)) ; mask_in(:,:)=0.0 + allocate(data_in(id,jd,kd), source=0.0) + allocate(tr_in(id,jd), source=0.0) + allocate(tr_inp(id,jdp), source=0.0) + allocate(mask_in(id,jdp), source=0.0) else allocate(data_in(isd:ied,jsd:jed,kd)) endif diff --git a/src/framework/MOM_safe_alloc.F90 b/src/framework/MOM_safe_alloc.F90 index 47dd8376a3..8960e8e358 100644 --- a/src/framework/MOM_safe_alloc.F90 +++ b/src/framework/MOM_safe_alloc.F90 @@ -38,11 +38,10 @@ subroutine safe_alloc_ptr_1d(ptr, i1, i2) integer, optional, intent(in) :: i2 !< The ending index of the array if (.not.associated(ptr)) then if (present(i2)) then - allocate(ptr(i1:i2)) + allocate(ptr(i1:i2), source=0.0) else - allocate(ptr(i1)) + allocate(ptr(i1), source=0.0) endif - ptr(:) = 0.0 endif end subroutine safe_alloc_ptr_1d @@ -52,8 +51,7 @@ subroutine safe_alloc_ptr_2d_2arg(ptr, ni, nj) integer, intent(in) :: ni !< The size of the 1st dimension of the array integer, intent(in) :: nj !< The size of the 2nd dimension of the array if (.not.associated(ptr)) then - allocate(ptr(ni,nj)) - ptr(:,:) = 0.0 + allocate(ptr(ni,nj), source=0.0) endif end subroutine safe_alloc_ptr_2d_2arg @@ -64,8 +62,7 @@ subroutine safe_alloc_ptr_3d_3arg(ptr, ni, nj, nk) integer, intent(in) :: nj !< The size of the 2nd dimension of the array integer, intent(in) :: nk !< The size of the 3rd dimension of the array if (.not.associated(ptr)) then - allocate(ptr(ni,nj,nk)) - ptr(:,:,:) = 0.0 + allocate(ptr(ni,nj,nk), source=0.0) endif end subroutine safe_alloc_ptr_3d_3arg @@ -77,8 +74,7 @@ subroutine safe_alloc_ptr_2d(ptr, is, ie, js, je) integer, intent(in) :: js !< The start index to allocate for the 2nd dimension integer, intent(in) :: je !< The end index to allocate for the 2nd dimension if (.not.associated(ptr)) then - allocate(ptr(is:ie,js:je)) - ptr(:,:) = 0.0 + allocate(ptr(is:ie,js:je), source=0.0) endif end subroutine safe_alloc_ptr_2d @@ -91,8 +87,7 @@ subroutine safe_alloc_ptr_3d(ptr, is, ie, js, je, nk) integer, intent(in) :: je !< The end index to allocate for the 2nd dimension integer, intent(in) :: nk !< The size to allocate for the 3rd dimension if (.not.associated(ptr)) then - allocate(ptr(is:ie,js:je,nk)) - ptr(:,:,:) = 0.0 + allocate(ptr(is:ie,js:je,nk), source=0.0) endif end subroutine safe_alloc_ptr_3d @@ -106,8 +101,7 @@ subroutine safe_alloc_ptr_3d_6arg(ptr, is, ie, js, je, ks, ke) integer, intent(in) :: ks !< The start index to allocate for the 3rd dimension integer, intent(in) :: ke !< The end index to allocate for the 3rd dimension if (.not.associated(ptr)) then - allocate(ptr(is:ie,js:je,ks:ke)) - ptr(:,:,:) = 0.0 + allocate(ptr(is:ie,js:je,ks:ke), source=0.0) endif end subroutine safe_alloc_ptr_3d_6arg @@ -120,8 +114,7 @@ subroutine safe_alloc_allocatable_2d(ptr, is, ie, js, je) integer, intent(in) :: js !< The start index to allocate for the 2nd dimension integer, intent(in) :: je !< The end index to allocate for the 2nd dimension if (.not.allocated(ptr)) then - allocate(ptr(is:ie,js:je)) - ptr(:,:) = 0.0 + allocate(ptr(is:ie,js:je), source=0.0) endif end subroutine safe_alloc_allocatable_2d @@ -135,8 +128,7 @@ subroutine safe_alloc_allocatable_3d(ptr, is, ie, js, je, nk) integer, intent(in) :: je !< The end index to allocate for the 2nd dimension integer, intent(in) :: nk !< The size to allocate for the 3rd dimension if (.not.allocated(ptr)) then - allocate(ptr(is:ie,js:je,nk)) - ptr(:,:,:) = 0.0 + allocate(ptr(is:ie,js:je,nk), source=0.0) endif end subroutine safe_alloc_allocatable_3d @@ -150,8 +142,7 @@ subroutine safe_alloc_allocatable_3d_6arg(ptr, is, ie, js, je, ks, ke) integer, intent(in) :: ks !< The start index to allocate for the 3rd dimension integer, intent(in) :: ke !< The end index to allocate for the 3rd dimension if (.not.allocated(ptr)) then - allocate(ptr(is:ie,js:je,ks:ke)) - ptr(:,:,:) = 0.0 + allocate(ptr(is:ie,js:je,ks:ke), source=0.0) endif end subroutine safe_alloc_allocatable_3d_6arg diff --git a/src/ice_shelf/MOM_ice_shelf.F90 b/src/ice_shelf/MOM_ice_shelf.F90 index cdb82cdf76..cfe75ba380 100644 --- a/src/ice_shelf/MOM_ice_shelf.F90 +++ b/src/ice_shelf/MOM_ice_shelf.F90 @@ -1524,7 +1524,7 @@ subroutine initialize_ice_shelf(param_file, ocn_grid, Time, CS, diag, forces_in, inputdir = slasher(inputdir) TideAmp_file = trim(inputdir) // trim(TideAmp_file) if (CS%rotate_index) then - allocate(tmp2d(CS%Grid_in%isd:CS%Grid_in%ied,CS%Grid_in%jsd:CS%Grid_in%jed)) ; tmp2d(:,:) = 0.0 + allocate(tmp2d(CS%Grid_in%isd:CS%Grid_in%ied,CS%Grid_in%jsd:CS%Grid_in%jed), source=0.0) call MOM_read_data(TideAmp_file, 'tideamp', tmp2d, CS%Grid_in%domain, timelevel=1, scale=US%m_s_to_L_T) call rotate_array(tmp2d, CS%turns, CS%utide) deallocate(tmp2d) @@ -1994,9 +1994,9 @@ subroutine update_shelf_mass(G, US, CS, ISS, Time) if (CS%rotate_index) then - allocate(tmp2d(CS%Grid_in%isc:CS%Grid_in%iec,CS%Grid_in%jsc:CS%Grid_in%jec)) ; tmp2d(:,:) = 0.0 + allocate(tmp2d(CS%Grid_in%isc:CS%Grid_in%iec,CS%Grid_in%jsc:CS%Grid_in%jec), source=0.0) else - allocate(tmp2d(is:ie,js:je)) ; tmp2d(:,:) = 0.0 + allocate(tmp2d(is:ie,js:je), source=0.0) endif call time_interp_external(CS%id_read_mass, Time, tmp2d) diff --git a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 index c95036a83e..7c7705ef35 100644 --- a/src/ice_shelf/MOM_ice_shelf_dynamics.F90 +++ b/src/ice_shelf/MOM_ice_shelf_dynamics.F90 @@ -256,23 +256,23 @@ subroutine register_ice_shelf_dyn_restarts(G, param_file, CS, restart_CS) endif if (active_shelf_dynamics) then - allocate( CS%u_shelf(IsdB:IedB,JsdB:JedB) ) ; CS%u_shelf(:,:) = 0.0 - allocate( CS%v_shelf(IsdB:IedB,JsdB:JedB) ) ; CS%v_shelf(:,:) = 0.0 - allocate( CS%t_shelf(isd:ied,jsd:jed) ) ; CS%t_shelf(:,:) = -10.0 - allocate( CS%ice_visc(isd:ied,jsd:jed) ) ; CS%ice_visc(:,:) = 0.0 - allocate( CS%AGlen_visc(isd:ied,jsd:jed) ) ; CS%AGlen_visc(:,:) = 2.261e-25 - allocate( CS%basal_traction(isd:ied,jsd:jed) ) ; CS%basal_traction(:,:) = 0.0 - allocate( CS%C_basal_friction(isd:ied,jsd:jed) ) ; CS%C_basal_friction(:,:) = 5.0e10 - allocate( CS%OD_av(isd:ied,jsd:jed) ) ; CS%OD_av(:,:) = 0.0 - allocate( CS%ground_frac(isd:ied,jsd:jed) ) ; CS%ground_frac(:,:) = 0.0 - allocate( CS%taudx_shelf(IsdB:IedB,JsdB:JedB) ) ; CS%taudx_shelf(:,:) = 0.0 - allocate( CS%taudy_shelf(IsdB:IedB,JsdB:JedB) ) ; CS%taudy_shelf(:,:) = 0.0 + allocate( CS%u_shelf(IsdB:IedB,JsdB:JedB), source=0.0 ) + allocate( CS%v_shelf(IsdB:IedB,JsdB:JedB), source=0.0 ) + allocate( CS%t_shelf(isd:ied,jsd:jed), source=-10.0 ) ! [degC] + allocate( CS%ice_visc(isd:ied,jsd:jed), source=0.0 ) + allocate( CS%AGlen_visc(isd:ied,jsd:jed), source=2.261e-25 ) ! [Units?] + allocate( CS%basal_traction(isd:ied,jsd:jed), source=0.0 ) + allocate( CS%C_basal_friction(isd:ied,jsd:jed), source=5.0e10 ) ! [Units?] + allocate( CS%OD_av(isd:ied,jsd:jed), source=0.0 ) + allocate( CS%ground_frac(isd:ied,jsd:jed), source=0.0 ) + allocate( CS%taudx_shelf(IsdB:IedB,JsdB:JedB), source=0.0 ) + allocate( CS%taudy_shelf(IsdB:IedB,JsdB:JedB), source=0.0 ) allocate( CS%bed_elev(isd:ied,jsd:jed) ) ; CS%bed_elev(:,:) = G%bathyT(:,:) + G%Z_ref - allocate( CS%u_bdry_val(IsdB:IedB,JsdB:JedB) ) ; CS%u_bdry_val(:,:) = 0.0 - allocate( CS%v_bdry_val(IsdB:IedB,JsdB:JedB) ) ; CS%v_bdry_val(:,:) = 0.0 - allocate( CS%u_face_mask_bdry(IsdB:IedB,JsdB:JedB) ) ; CS%u_face_mask_bdry(:,:) = -2.0 - allocate( CS%v_face_mask_bdry(IsdB:iedB,JsdB:JedB) ) ; CS%v_face_mask_bdry(:,:) = -2.0 - allocate( CS%h_bdry_val(isd:ied,jsd:jed) ) ; CS%h_bdry_val(:,:) = 0.0 + allocate( CS%u_bdry_val(IsdB:IedB,JsdB:JedB), source=0.0 ) + allocate( CS%v_bdry_val(IsdB:IedB,JsdB:JedB), source=0.0 ) + allocate( CS%u_face_mask_bdry(IsdB:IedB,JsdB:JedB), source=-2.0 ) + allocate( CS%v_face_mask_bdry(IsdB:iedB,JsdB:JedB), source=-2.0 ) + allocate( CS%h_bdry_val(isd:ied,jsd:jed), source=0.0 ) ! additional restarts for ice shelf state call register_restart_field(CS%u_shelf, "u_shelf", .false., restart_CS, & "ice sheet/shelf u-velocity", "m s-1", hor_grid='Bu') @@ -437,22 +437,22 @@ subroutine initialize_ice_shelf_dyn(param_file, Time, ISS, CS, G, US, diag, new_ ! previously allocated for registration for restarts. if (active_shelf_dynamics) then - allocate( CS%t_bdry_val(isd:ied,jsd:jed) ) ; CS%t_bdry_val(:,:) = -15.0 - allocate( CS%thickness_bdry_val(isd:ied,jsd:jed) ) ; CS%thickness_bdry_val(:,:) = 0.0 - allocate( CS%u_face_mask(Isdq:Iedq,Jsdq:Jedq) ) ; CS%u_face_mask(:,:) = 0.0 - allocate( CS%v_face_mask(Isdq:Iedq,Jsdq:Jedq) ) ; CS%v_face_mask(:,:) = 0.0 - allocate( CS%u_flux_bdry_val(Isdq:Iedq,jsd:jed) ) ; CS%u_flux_bdry_val(:,:) = 0.0 - allocate( CS%v_flux_bdry_val(isd:ied,Jsdq:Jedq) ) ; CS%v_flux_bdry_val(:,:) = 0.0 - allocate( CS%umask(Isdq:Iedq,Jsdq:Jedq) ) ; CS%umask(:,:) = -1.0 - allocate( CS%vmask(Isdq:Iedq,Jsdq:Jedq) ) ; CS%vmask(:,:) = -1.0 - allocate( CS%tmask(Isdq:Iedq,Jsdq:Jedq) ) ; CS%tmask(:,:) = -1.0 + allocate( CS%t_bdry_val(isd:ied,jsd:jed), source=-15.0) ! [degC] + allocate( CS%thickness_bdry_val(isd:ied,jsd:jed), source=0.0) + allocate( CS%u_face_mask(Isdq:Iedq,Jsdq:Jedq), source=0.0) + allocate( CS%v_face_mask(Isdq:Iedq,Jsdq:Jedq), source=0.0) + allocate( CS%u_flux_bdry_val(Isdq:Iedq,jsd:jed), source=0.0) + allocate( CS%v_flux_bdry_val(isd:ied,Jsdq:Jedq), source=0.0) + allocate( CS%umask(Isdq:Iedq,Jsdq:Jedq), source=-1.0) + allocate( CS%vmask(Isdq:Iedq,Jsdq:Jedq), source=-1.0) + allocate( CS%tmask(Isdq:Iedq,Jsdq:Jedq), source=-1.0) CS%OD_rt_counter = 0 - allocate( CS%OD_rt(isd:ied,jsd:jed) ) ; CS%OD_rt(:,:) = 0.0 - allocate( CS%ground_frac_rt(isd:ied,jsd:jed) ) ; CS%ground_frac_rt(:,:) = 0.0 + allocate( CS%OD_rt(isd:ied,jsd:jed), source=0.0) + allocate( CS%ground_frac_rt(isd:ied,jsd:jed), source=0.0) if (CS%calve_to_mask) then - allocate( CS%calve_mask(isd:ied,jsd:jed) ) ; CS%calve_mask(:,:) = 0.0 + allocate( CS%calve_mask(isd:ied,jsd:jed), source=0.0) endif CS%elapsed_velocity_time = 0.0 @@ -867,7 +867,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, i ! need to make these conditional on GL interpolation float_cond(:,:) = 0.0 ; H_node(:,:) = 0.0 CS%ground_frac(:,:) = 0.0 - allocate(Phisub(nsub,nsub,2,2,2,2)) ; Phisub(:,:,:,:,:,:) = 0.0 + allocate(Phisub(nsub,nsub,2,2,2,2), source=0.0) do j=G%jsc,G%jec do i=G%isc,G%iec @@ -913,7 +913,7 @@ subroutine ice_shelf_solve_outer(CS, ISS, G, US, u_shlf, v_shlf, taudx, taudy, i endif ! must prepare Phi - allocate(Phi(1:8,1:4,isd:ied,jsd:jed)) ; Phi(:,:,:,:) = 0.0 + allocate(Phi(1:8,1:4,isd:ied,jsd:jed), source=0.0) do j=jsd,jed ; do i=isd,ied call bilinear_shape_fn_grid(G, i, j, Phi(:,:,i,j)) diff --git a/src/ice_shelf/MOM_ice_shelf_initialize.F90 b/src/ice_shelf/MOM_ice_shelf_initialize.F90 index 2daffcb07e..469cba39ce 100644 --- a/src/ice_shelf/MOM_ice_shelf_initialize.F90 +++ b/src/ice_shelf/MOM_ice_shelf_initialize.F90 @@ -61,9 +61,9 @@ subroutine initialize_ice_thickness(h_shelf, area_shelf_h, hmask, G, G_in, US, P if (PRESENT(rotate_index)) rotate=rotate_index if (rotate) then - allocate(tmp1_2d(G_in%isd:G_in%ied,G_in%jsd:G_in%jed)) ; tmp1_2d(:,:)=0.0 - allocate(tmp2_2d(G_in%isd:G_in%ied,G_in%jsd:G_in%jed)) ; tmp2_2d(:,:)=0.0 - allocate(tmp3_2d(G_in%isd:G_in%ied,G_in%jsd:G_in%jed)) ; tmp3_2d(:,:)=0.0 + allocate(tmp1_2d(G_in%isd:G_in%ied,G_in%jsd:G_in%jed), source=0.0) + allocate(tmp2_2d(G_in%isd:G_in%ied,G_in%jsd:G_in%jed), source=0.0) + allocate(tmp3_2d(G_in%isd:G_in%ied,G_in%jsd:G_in%jed), source=0.0) select case ( trim(config) ) case ("CHANNEL") ; call initialize_ice_thickness_channel (tmp1_2d, tmp2_2d, tmp3_2d, G_in, US, PF) case ("FILE") ; call initialize_ice_thickness_from_file (tmp1_2d, tmp2_2d, tmp3_2d, G_in, US, PF) diff --git a/src/ice_shelf/MOM_ice_shelf_state.F90 b/src/ice_shelf/MOM_ice_shelf_state.F90 index a3784b5a34..ed3b419c9a 100644 --- a/src/ice_shelf/MOM_ice_shelf_state.F90 +++ b/src/ice_shelf/MOM_ice_shelf_state.F90 @@ -67,16 +67,16 @@ subroutine ice_shelf_state_init(ISS, G) endif allocate(ISS) - allocate(ISS%mass_shelf(isd:ied,jsd:jed) ) ; ISS%mass_shelf(:,:) = 0.0 - allocate(ISS%area_shelf_h(isd:ied,jsd:jed) ) ; ISS%area_shelf_h(:,:) = 0.0 - allocate(ISS%h_shelf(isd:ied,jsd:jed) ) ; ISS%h_shelf(:,:) = 0.0 - allocate(ISS%hmask(isd:ied,jsd:jed) ) ; ISS%hmask(:,:) = -2.0 - - allocate(ISS%tflux_ocn(isd:ied,jsd:jed) ) ; ISS%tflux_ocn(:,:) = 0.0 - allocate(ISS%water_flux(isd:ied,jsd:jed) ) ; ISS%water_flux(:,:) = 0.0 - allocate(ISS%salt_flux(isd:ied,jsd:jed) ) ; ISS%salt_flux(:,:) = 0.0 - allocate(ISS%tflux_shelf(isd:ied,jsd:jed) ) ; ISS%tflux_shelf(:,:) = 0.0 - allocate(ISS%tfreeze(isd:ied,jsd:jed) ) ; ISS%tfreeze(:,:) = 0.0 + allocate(ISS%mass_shelf(isd:ied,jsd:jed), source=0.0 ) + allocate(ISS%area_shelf_h(isd:ied,jsd:jed), source=0.0 ) + allocate(ISS%h_shelf(isd:ied,jsd:jed), source=0.0 ) + allocate(ISS%hmask(isd:ied,jsd:jed), source=-2.0 ) + + allocate(ISS%tflux_ocn(isd:ied,jsd:jed), source=0.0 ) + allocate(ISS%water_flux(isd:ied,jsd:jed), source=0.0 ) + allocate(ISS%salt_flux(isd:ied,jsd:jed), source=0.0 ) + allocate(ISS%tflux_shelf(isd:ied,jsd:jed), source=0.0 ) + allocate(ISS%tfreeze(isd:ied,jsd:jed), source=0.0 ) end subroutine ice_shelf_state_init diff --git a/src/initialization/MOM_shared_initialization.F90 b/src/initialization/MOM_shared_initialization.F90 index 05bac16710..0baf357cbc 100644 --- a/src/initialization/MOM_shared_initialization.F90 +++ b/src/initialization/MOM_shared_initialization.F90 @@ -909,17 +909,17 @@ subroutine reset_face_lengths_list(G, param_file, US) if (num_lines > 0) then allocate(lines(num_lines)) - allocate(u_lat(2,num_lines)) ; u_lat(:,:) = -1e34 - allocate(u_lon(2,num_lines)) ; u_lon(:,:) = -1e34 - allocate(u_width(num_lines)) ; u_width(:) = -1e34 - allocate(u_line_used(num_lines)) ; u_line_used(:) = 0 - allocate(u_line_no(num_lines)) ; u_line_no(:) = 0 - - allocate(v_lat(2,num_lines)) ; v_lat(:,:) = -1e34 - allocate(v_lon(2,num_lines)) ; v_lon(:,:) = -1e34 - allocate(v_width(num_lines)) ; v_width(:) = -1e34 - allocate(v_line_used(num_lines)) ; v_line_used(:) = 0 - allocate(v_line_no(num_lines)) ; v_line_no(:) = 0 + allocate(u_lat(2,num_lines), source=-1e34) + allocate(u_lon(2,num_lines), source=-1e34) + allocate(u_width(num_lines), source=-1e34) + allocate(u_line_used(num_lines), source=0) + allocate(u_line_no(num_lines), source=0) + + allocate(v_lat(2,num_lines), source=-1e34) + allocate(v_lon(2,num_lines), source=-1e34) + allocate(v_width(num_lines), source=-1e34) + allocate(v_line_used(num_lines), source=0) + allocate(v_line_no(num_lines), source=0) ! Actually read the lines. if (is_root_pe()) then diff --git a/src/initialization/MOM_state_initialization.F90 b/src/initialization/MOM_state_initialization.F90 index 56a15c4091..1ca466b7fa 100644 --- a/src/initialization/MOM_state_initialization.F90 +++ b/src/initialization/MOM_state_initialization.F90 @@ -1929,7 +1929,7 @@ subroutine initialize_sponges_file(G, GV, US, use_temperature, tv, u, v, depth_t if (.not. use_ALE) then ! The first call to set_up_sponge_field is for the interface heights if in layered mode. - allocate(eta(isd:ied,jsd:jed,nz+1)); eta(:,:,:) = 0.0 + allocate(eta(isd:ied,jsd:jed,nz+1), source=0.0) call MOM_read_data(filename, eta_var, eta(:,:,:), G%Domain, scale=US%m_to_Z) do j=js,je ; do i=is,ie @@ -2194,9 +2194,8 @@ subroutine initialize_oda_incupd_file(G, GV, US, use_temperature, tv, h, u, v, p call log_param(param_file, mdl, "INPUTDIR/ODA_INCUPD_UV_FILE", filename) if (.not.file_exists(filename, G%Domain)) & call MOM_error(FATAL, " initialize_oda_incupd_uv: Unable to open "//trim(filename)) - allocate(tmp_u(G%IsdB:G%IedB,jsd:jed,nz_data)) - allocate(tmp_v(isd:ied,G%JsdB:G%JedB,nz_data)) - tmp_u(:,:,:) = 0.0 ; tmp_v(:,:,:) = 0.0 + allocate(tmp_u(G%IsdB:G%IedB,jsd:jed,nz_data), source=0.0) + allocate(tmp_v(isd:ied,G%JsdB:G%JedB,nz_data), source=0.0) call MOM_read_vector(filename, uinc_var, vinc_var, tmp_u, tmp_v, G%Domain,scale=US%m_s_to_L_T) call set_up_oda_incupd_vel_field(tmp_u, tmp_v, G, GV, oda_incupd_CSp) deallocate(tmp_u,tmp_v) @@ -2550,10 +2549,10 @@ subroutine MOM_temp_salt_initialize_from_Z(h, tv, depth_tot, G, GV, US, PF, just nkd = max(GV%ke, kd) ! Build the source grid and copy data onto model-shaped arrays with vanished layers - allocate( tmp_mask_in(isd:ied,jsd:jed,nkd) ) ; tmp_mask_in(:,:,:) = 0. - allocate( h1(isd:ied,jsd:jed,nkd) ) ; h1(:,:,:) = 0. - allocate( tmpT1dIn(isd:ied,jsd:jed,nkd) ) ; tmpT1dIn(:,:,:) = 0. - allocate( tmpS1dIn(isd:ied,jsd:jed,nkd) ) ; tmpS1dIn(:,:,:) = 0. + allocate( tmp_mask_in(isd:ied,jsd:jed,nkd), source=0.0 ) + allocate( h1(isd:ied,jsd:jed,nkd), source=0.0 ) + allocate( tmpT1dIn(isd:ied,jsd:jed,nkd), source=0.0 ) + allocate( tmpS1dIn(isd:ied,jsd:jed,nkd), source=0.0 ) do j = js, je ; do i = is, ie if (G%mask2dT(i,j)>0.) then zTopOfCell = 0. ; zBottomOfCell = 0. diff --git a/src/ocean_data_assim/MOM_oda_driver.F90 b/src/ocean_data_assim/MOM_oda_driver.F90 index dd9c46ff90..6c36cbbacb 100644 --- a/src/ocean_data_assim/MOM_oda_driver.F90 +++ b/src/ocean_data_assim/MOM_oda_driver.F90 @@ -311,13 +311,13 @@ subroutine init_oda(Time, G, GV, diag_CS, CS) !jsd=jsd+jdg_offset; jed=jed+jdg_offset ! TODO: switch to local indexing? (mjh) if (.not. associated(CS%h)) then - allocate(CS%h(isd:ied,jsd:jed,CS%GV%ke)); CS%h(:,:,:)=CS%GV%Angstrom_m*CS%GV%H_to_m + allocate(CS%h(isd:ied,jsd:jed,CS%GV%ke), source=CS%GV%Angstrom_m*CS%GV%H_to_m) ! assign thicknesses call ALE_initThicknessToCoord(CS%ALE_CS,G,CS%GV,CS%h) endif allocate(CS%tv) - allocate(CS%tv%T(isd:ied,jsd:jed,CS%GV%ke)); CS%tv%T(:,:,:)=0.0 - allocate(CS%tv%S(isd:ied,jsd:jed,CS%GV%ke)); CS%tv%S(:,:,:)=0.0 + allocate(CS%tv%T(isd:ied,jsd:jed,CS%GV%ke), source=0.0) + allocate(CS%tv%S(isd:ied,jsd:jed,CS%GV%ke), source=0.0) ! call set_axes_info(CS%Grid, CS%GV, CS%US, PF, CS%diag_cs, set_vertical=.true.) ! missing in Feiyu's fork allocate(CS%oda_grid) CS%oda_grid%x => CS%Grid%geolonT @@ -329,8 +329,7 @@ subroutine init_oda(Time, G, GV, diag_CS, CS) "A file in which to find the basin masks, in variable 'basin'.", & default="basin.nc") basin_file = trim(inputdir) // trim(basin_file) - allocate(CS%oda_grid%basin_mask(isd:ied,jsd:jed)) - CS%oda_grid%basin_mask(:,:) = 0.0 + allocate(CS%oda_grid%basin_mask(isd:ied,jsd:jed), source=0.0) call MOM_read_data(basin_file,'basin',CS%oda_grid%basin_mask,CS%Grid%domain, timelevel=1) endif @@ -365,8 +364,8 @@ subroutine init_oda(Time, G, GV, diag_CS, CS) CS%INC_CS%fldno = 2 if (CS%nk .ne. fld_sz(3)) call MOM_error(FATAL,'Increment levels /= ODA levels') allocate(CS%tv_bc) ! storage for increment - allocate(CS%tv_bc%T(G%isd:G%ied,G%jsd:G%jed,CS%GV%ke)); CS%tv_bc%T(:,:,:)=0.0 - allocate(CS%tv_bc%S(G%isd:G%ied,G%jsd:G%jed,CS%GV%ke)); CS%tv_bc%S(:,:,:)=0.0 + allocate(CS%tv_bc%T(G%isd:G%ied,G%jsd:G%jed,CS%GV%ke), source=0.0) + allocate(CS%tv_bc%S(G%isd:G%ied,G%jsd:G%jed,CS%GV%ke), source=0.0) endif call cpu_clock_end(id_clock_oda_init) @@ -596,13 +595,13 @@ subroutine init_ocean_ensemble(CS,Grid,GV,ens_size) allocate(CS%T(is:ie,js:je,nk,ens_size)) allocate(CS%S(is:ie,js:je,nk,ens_size)) allocate(CS%SSH(is:ie,js:je,ens_size)) -! allocate(CS%id_t(ens_size));CS%id_t(:)=-1 -! allocate(CS%id_s(ens_size));CS%id_s(:)=-1 +! allocate(CS%id_t(ens_size), source=-1) +! allocate(CS%id_s(ens_size), source=-1) ! allocate(CS%U(is:ie,js:je,nk,ens_size)) ! allocate(CS%V(is:ie,js:je,nk,ens_size)) -! allocate(CS%id_u(ens_size));CS%id_u(:)=-1 -! allocate(CS%id_v(ens_size));CS%id_v(:)=-1 -! allocate(CS%id_ssh(ens_size));CS%id_ssh(:)=-1 +! allocate(CS%id_u(ens_size), source=-1) +! allocate(CS%id_v(ens_size), source=-1) +! allocate(CS%id_ssh(ens_size), source=-1) return end subroutine init_ocean_ensemble @@ -730,12 +729,10 @@ subroutine set_up_global_tgrid(T_grid, CS, G) allocate(T_grid%basin_mask(CS%ni,CS%nj)) call global_field(CS%mpp_domain, CS%oda_grid%basin_mask, T_grid%basin_mask) endif - allocate(T_grid%mask(CS%ni,CS%nj,CS%nk)) - allocate(T_grid%z(CS%ni,CS%nj,CS%nk)) + allocate(T_grid%mask(CS%ni,CS%nj,CS%nk), source=0.0) + allocate(T_grid%z(CS%ni,CS%nj,CS%nk), source=0.0) allocate(global2D(CS%ni,CS%nj)) allocate(global2D_old(CS%ni,CS%nj)) - T_grid%mask(:,:,:) = 0.0 - T_grid%z(:,:,:) = 0.0 do k = 1, CS%nk call global_field(G%Domain%mpp_domain, CS%h(:,:,k), global2D) diff --git a/src/ocean_data_assim/MOM_oda_incupd.F90 b/src/ocean_data_assim/MOM_oda_incupd.F90 index d3199dcb74..91210a328d 100644 --- a/src/ocean_data_assim/MOM_oda_incupd.F90 +++ b/src/ocean_data_assim/MOM_oda_incupd.F90 @@ -31,11 +31,7 @@ module MOM_oda_incupd use MOM_time_manager, only : time_type use MOM_unit_scaling, only : unit_scale_type use MOM_variables, only : thermo_var_ptrs -use MOM_verticalGrid, only : verticalGrid_type -use MOM_verticalGrid, only : get_thickness_units - -use mpp_io_mod, only : mpp_get_axis_length -use mpp_io_mod, only : axistype +use MOM_verticalGrid, only : verticalGrid_type, get_thickness_units implicit none ; private @@ -238,8 +234,7 @@ subroutine initialize_oda_incupd( G, GV, US, param_file, CS, data_h,nz_data, res ! get the vertical grid (h_obs) of the increments CS%nz_data = nz_data - allocate(CS%Ref_h%p(G%isd:G%ied,G%jsd:G%jed,CS%nz_data)) - CS%Ref_h%p(:,:,:) = 0.0 ; + allocate(CS%Ref_h%p(G%isd:G%ied,G%jsd:G%jed,CS%nz_data), source=0.0) do j=G%jsc,G%jec; do i=G%isc,G%iec ; do k=1,CS%nz_data CS%Ref_h%p(i,j,k) = data_h(i,j,k) enddo; enddo ; enddo @@ -277,8 +272,7 @@ subroutine set_up_oda_incupd_field(sp_val, G, GV, CS) ! store the increment/full field tracer profiles CS%Inc(CS%fldno)%nz_data = CS%nz_data - allocate(CS%Inc(CS%fldno)%p(G%isd:G%ied,G%jsd:G%jed,CS%nz_data)) - CS%Inc(CS%fldno)%p(:,:,:) = 0.0 + allocate(CS%Inc(CS%fldno)%p(G%isd:G%ied,G%jsd:G%jed,CS%nz_data), source=0.0) do k=1,CS%nz_data ; do j=G%jsc,G%jec ; do i=G%isc,G%iec CS%Inc(CS%fldno)%p(i,j,k) = sp_val(i,j,k) enddo ; enddo ; enddo @@ -305,8 +299,7 @@ subroutine set_up_oda_incupd_vel_field(u_val, v_val, G, GV, CS) ! store the increment/full field u profile - allocate(CS%Inc_u%p(G%isdB:G%iedB,G%jsd:G%jed,CS%nz_data)) - CS%Inc_u%p(:,:,:) = 0.0 + allocate(CS%Inc_u%p(G%isdB:G%iedB,G%jsd:G%jed,CS%nz_data), source=0.0) do j=G%jsc,G%jec ; do i=G%iscB,G%iecB do k=1,CS%nz_data CS%Inc_u%p(i,j,k) = u_val(i,j,k) @@ -314,8 +307,7 @@ subroutine set_up_oda_incupd_vel_field(u_val, v_val, G, GV, CS) enddo ; enddo ! store the increment/full field v profile - allocate(CS%Inc_v%p(G%isd:G%ied,G%jsdB:G%jedB,CS%nz_data)) - CS%Inc_v%p(:,:,:) = 0.0 + allocate(CS%Inc_v%p(G%isd:G%ied,G%jsdB:G%jedB,CS%nz_data), source=0.0) do j=G%jscB,G%jecB ; do i=G%isc,G%iec do k=1,CS%nz_data CS%Inc_v%p(i,j,k) = v_val(i,j,k) @@ -376,7 +368,7 @@ subroutine calc_oda_increments(h, tv, u, v, G, GV, US, CS) ! get h_obs nz_data = CS%Inc(1)%nz_data - allocate(h_obs(G%isd:G%ied,G%jsd:G%jed,nz_data)) ; h_obs(:,:,:) = 0.0 + allocate(h_obs(G%isd:G%ied,G%jsd:G%jed,nz_data), source=0.0) do k=1,nz_data ; do j=js,je ; do i=is,ie h_obs(i,j,k) = CS%Ref_h%p(i,j,k) enddo ; enddo ; enddo @@ -384,10 +376,10 @@ subroutine calc_oda_increments(h, tv, u, v, G, GV, US, CS) ! allocate 1-d arrays - allocate(tmp_h(nz_data)); tmp_h(:) = 0.0 - allocate(tmp_val2(nz_data)) ; tmp_val2(:) = 0.0 - allocate(hu_obs(nz_data)) ; hu_obs(:) = 0.0 - allocate(hv_obs(nz_data)) ; hv_obs(:) = 0.0 + allocate(tmp_h(nz_data), source=0.0) + allocate(tmp_val2(nz_data), source=0.0) + allocate(hu_obs(nz_data), source=0.0) + allocate(hv_obs(nz_data), source=0.0) ! remap t,s (on h_init) to h_obs to get increment tmp_val1(:) = 0.0 @@ -591,17 +583,17 @@ subroutine apply_oda_incupd(h, tv, u, v, dt, G, GV, US, CS) ! get h_obs nz_data = CS%Inc(1)%nz_data - allocate(h_obs(G%isd:G%ied,G%jsd:G%jed,nz_data)) ; h_obs(:,:,:) = 0.0 + allocate(h_obs(G%isd:G%ied,G%jsd:G%jed,nz_data), source=0.0) do k=1,nz_data ; do j=js,je ; do i=is,ie h_obs(i,j,k) = CS%Ref_h%p(i,j,k) enddo ; enddo ; enddo call pass_var(h_obs,G%Domain) ! allocate 1-d array - allocate(tmp_h(nz_data)); tmp_h(:) = 0.0 + allocate(tmp_h(nz_data), source=0.0) allocate(tmp_val2(nz_data)) - allocate(hu_obs(nz_data)) ; hu_obs(:) = 0.0 - allocate(hv_obs(nz_data)) ; hv_obs(:) = 0.0 + allocate(hu_obs(nz_data), source=0.0) + allocate(hv_obs(nz_data), source=0.0) ! add increments to tracers tmp_val1(:) = 0.0 diff --git a/src/parameterizations/lateral/MOM_MEKE.F90 b/src/parameterizations/lateral/MOM_MEKE.F90 index a2e395d06a..5efb318db1 100644 --- a/src/parameterizations/lateral/MOM_MEKE.F90 +++ b/src/parameterizations/lateral/MOM_MEKE.F90 @@ -1408,41 +1408,36 @@ subroutine MEKE_alloc_register_restart(HI, param_file, MEKE, restart_CS) ! Allocate memory call MOM_mesg("MEKE_alloc_register_restart: allocating and registering", 5) isd = HI%isd ; ied = HI%ied ; jsd = HI%jsd ; jed = HI%jed - allocate(MEKE%MEKE(isd:ied,jsd:jed)) ; MEKE%MEKE(:,:) = 0.0 + allocate(MEKE%MEKE(isd:ied,jsd:jed), source=0.0) vd = var_desc("MEKE", "m2 s-2", hor_grid='h', z_grid='1', & longname="Mesoscale Eddy Kinetic Energy") call register_restart_field(MEKE%MEKE, vd, .false., restart_CS) - if (MEKE_GMcoeff>=0.) then - allocate(MEKE%GM_src(isd:ied,jsd:jed)) ; MEKE%GM_src(:,:) = 0.0 - endif - if (MEKE_FrCoeff>=0. .or. MEKE_GMECoeff>=0.) then - allocate(MEKE%mom_src(isd:ied,jsd:jed)) ; MEKE%mom_src(:,:) = 0.0 - endif - if (MEKE_GMECoeff>=0.) then - allocate(MEKE%GME_snk(isd:ied,jsd:jed)) ; MEKE%GME_snk(:,:) = 0.0 - endif + if (MEKE_GMcoeff>=0.) allocate(MEKE%GM_src(isd:ied,jsd:jed), source=0.0) + if (MEKE_FrCoeff>=0. .or. MEKE_GMECoeff>=0.) & + allocate(MEKE%mom_src(isd:ied,jsd:jed), source=0.0) + if (MEKE_GMECoeff>=0.) allocate(MEKE%GME_snk(isd:ied,jsd:jed), source=0.0) if (MEKE_KhCoeff>=0.) then - allocate(MEKE%Kh(isd:ied,jsd:jed)) ; MEKE%Kh(:,:) = 0.0 + allocate(MEKE%Kh(isd:ied,jsd:jed), source=0.0) vd = var_desc("MEKE_Kh", "m2 s-1", hor_grid='h', z_grid='1', & longname="Lateral diffusivity from Mesoscale Eddy Kinetic Energy") call register_restart_field(MEKE%Kh, vd, .false., restart_CS) endif - allocate(MEKE%Rd_dx_h(isd:ied,jsd:jed)) ; MEKE%Rd_dx_h(:,:) = 0.0 + allocate(MEKE%Rd_dx_h(isd:ied,jsd:jed), source=0.0) if (MEKE_viscCoeff_Ku/=0.) then - allocate(MEKE%Ku(isd:ied,jsd:jed)) ; MEKE%Ku(:,:) = 0.0 + allocate(MEKE%Ku(isd:ied,jsd:jed), source=0.0) vd = var_desc("MEKE_Ku", "m2 s-1", hor_grid='h', z_grid='1', & longname="Lateral viscosity from Mesoscale Eddy Kinetic Energy") call register_restart_field(MEKE%Ku, vd, .false., restart_CS) endif if (Use_Kh_in_MEKE) then - allocate(MEKE%Kh_diff(isd:ied,jsd:jed)) ; MEKE%Kh_diff(:,:) = 0.0 + allocate(MEKE%Kh_diff(isd:ied,jsd:jed), source=0.0) vd = var_desc("MEKE_Kh_diff", "m2 s-1",hor_grid='h',z_grid='1', & longname="Copy of thickness diffusivity for diffusing MEKE") call register_restart_field(MEKE%Kh_diff, vd, .false., restart_CS) endif if (MEKE_viscCoeff_Au/=0.) then - allocate(MEKE%Au(isd:ied,jsd:jed)) ; MEKE%Au(:,:) = 0.0 + allocate(MEKE%Au(isd:ied,jsd:jed), source=0.0) vd = var_desc("MEKE_Au", "m4 s-1", hor_grid='h', z_grid='1', & longname="Lateral biharmonic viscosity from Mesoscale Eddy Kinetic Energy") call register_restart_field(MEKE%Au, vd, .false., restart_CS) diff --git a/src/parameterizations/lateral/MOM_hor_visc.F90 b/src/parameterizations/lateral/MOM_hor_visc.F90 index 84eabc9317..7a3e56ef63 100644 --- a/src/parameterizations/lateral/MOM_hor_visc.F90 +++ b/src/parameterizations/lateral/MOM_hor_visc.F90 @@ -1711,8 +1711,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif if (present(ADp) .and. (CS%id_h_diffu > 0)) then - allocate(h_diffu(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) - h_diffu(:,:,:) = 0.0 + allocate(h_diffu(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) do k=1,nz ; do j=js,je ; do I=Isq,Ieq h_diffu(I,j,k) = diffu(I,j,k) * ADp%diag_hu(I,j,k) enddo ; enddo ; enddo @@ -1720,8 +1719,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, deallocate(h_diffu) endif if (present(ADp) .and. (CS%id_h_diffv > 0)) then - allocate(h_diffv(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) - h_diffv(:,:,:) = 0.0 + allocate(h_diffv(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie h_diffv(i,J,k) = diffv(i,J,k) * ADp%diag_hv(i,J,k) enddo ; enddo ; enddo @@ -1730,8 +1728,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, endif if (present(ADp) .and. (CS%id_diffu_visc_rem > 0)) then - allocate(diffu_visc_rem(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) - diffu_visc_rem(:,:,:) = 0.0 + allocate(diffu_visc_rem(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) do k=1,nz ; do j=js,je ; do I=Isq,Ieq diffu_visc_rem(I,j,k) = diffu(I,j,k) * ADp%visc_rem_u(I,j,k) enddo ; enddo ; enddo @@ -1739,8 +1736,7 @@ subroutine horizontal_viscosity(u, v, h, diffu, diffv, MEKE, VarMix, G, GV, US, deallocate(diffu_visc_rem) endif if (present(ADp) .and. (CS%id_diffv_visc_rem > 0)) then - allocate(diffv_visc_rem(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) - diffv_visc_rem(:,:,:) = 0.0 + allocate(diffv_visc_rem(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie diffv_visc_rem(i,J,k) = diffv(i,J,k) * ADp%visc_rem_v(i,J,k) enddo ; enddo ; enddo diff --git a/src/parameterizations/lateral/MOM_internal_tides.F90 b/src/parameterizations/lateral/MOM_internal_tides.F90 index 6ca6f27ee0..8b46eb8169 100644 --- a/src/parameterizations/lateral/MOM_internal_tides.F90 +++ b/src/parameterizations/lateral/MOM_internal_tides.F90 @@ -2129,8 +2129,7 @@ end subroutine PPM_limit_pos ! num_angle = 24 ! call read_param(param_file, "INTERNAL_TIDE_ANGLES", num_angle) -! allocate(CS%En_restart(isd:ied, jsd:jed, num_angle)) -! CS%En_restart(:,:,:) = 0.0 +! allocate(CS%En_restart(isd:ied, jsd:jed, num_angle), source=0.0) ! vd = vardesc("En_restart", & ! "The internal wave energy density as a function of (i,j,angle,frequency,mode)", & @@ -2208,12 +2207,10 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) CS%nFreq = num_freq ; CS%nAngle = num_angle ; CS%nMode = num_mode ! Allocate energy density array - allocate(CS%En(isd:ied, jsd:jed, num_angle, num_freq, num_mode)) - CS%En(:,:,:,:,:) = 0.0 + allocate(CS%En(isd:ied, jsd:jed, num_angle, num_freq, num_mode), source=0.0) ! Allocate phase speed array - allocate(CS%cp(isd:ied, jsd:jed, num_freq, num_mode)) - CS%cp(:,:,:,:) = 0.0 + allocate(CS%cp(isd:ied, jsd:jed, num_freq, num_mode), source=0.0) ! Allocate and populate frequency array (each a multiple of first for now) allocate(CS%frequency(num_freq)) @@ -2335,21 +2332,16 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) "INT_TIDE_DISSIPATION.", units="nondim", default=1.0) ! Allocate various arrays needed for loss rates - allocate(h2(isd:ied,jsd:jed)) ; h2(:,:) = 0.0 - allocate(CS%TKE_itidal_loss_fixed(isd:ied,jsd:jed)) - CS%TKE_itidal_loss_fixed = 0.0 - allocate(CS%TKE_leak_loss(isd:ied,jsd:jed,num_angle,num_freq,num_mode)) - CS%TKE_leak_loss(:,:,:,:,:) = 0.0 - allocate(CS%TKE_quad_loss(isd:ied,jsd:jed,num_angle,num_freq,num_mode)) - CS%TKE_quad_loss(:,:,:,:,:) = 0.0 - allocate(CS%TKE_itidal_loss(isd:ied,jsd:jed,num_angle,num_freq,num_mode)) - CS%TKE_itidal_loss(:,:,:,:,:) = 0.0 - allocate(CS%TKE_Froude_loss(isd:ied,jsd:jed,num_angle,num_freq,num_mode)) - CS%TKE_Froude_loss(:,:,:,:,:) = 0.0 - allocate(CS%tot_leak_loss(isd:ied,jsd:jed)) ; CS%tot_leak_loss(:,:) = 0.0 - allocate(CS%tot_quad_loss(isd:ied,jsd:jed) ) ; CS%tot_quad_loss(:,:) = 0.0 - allocate(CS%tot_itidal_loss(isd:ied,jsd:jed)) ; CS%tot_itidal_loss(:,:) = 0.0 - allocate(CS%tot_Froude_loss(isd:ied,jsd:jed)) ; CS%tot_Froude_loss(:,:) = 0.0 + allocate(h2(isd:ied,jsd:jed), source=0.0) + allocate(CS%TKE_itidal_loss_fixed(isd:ied,jsd:jed), source=0.0) + allocate(CS%TKE_leak_loss(isd:ied,jsd:jed,num_angle,num_freq,num_mode), source=0.0) + allocate(CS%TKE_quad_loss(isd:ied,jsd:jed,num_angle,num_freq,num_mode), source=0.0) + allocate(CS%TKE_itidal_loss(isd:ied,jsd:jed,num_angle,num_freq,num_mode), source=0.0) + allocate(CS%TKE_Froude_loss(isd:ied,jsd:jed,num_angle,num_freq,num_mode), source=0.0) + allocate(CS%tot_leak_loss(isd:ied,jsd:jed), source=0.0) + allocate(CS%tot_quad_loss(isd:ied,jsd:jed), source=0.0) + allocate(CS%tot_itidal_loss(isd:ied,jsd:jed), source=0.0) + allocate(CS%tot_Froude_loss(isd:ied,jsd:jed), source=0.0) ! Compute the fixed part of the bottom drag loss from baroclinic modes call get_param(param_file, mdl, "H2_FILE", h2_file, & @@ -2383,7 +2375,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) "the coastline/ridge/shelf with respect to the equator.", & fail_if_missing=.false., default='') filename = trim(CS%inputdir) // trim(refl_angle_file) - allocate(CS%refl_angle(isd:ied,jsd:jed)) ; CS%refl_angle(:,:) = CS%nullangle + allocate(CS%refl_angle(isd:ied,jsd:jed), source=CS%nullangle) if (file_exists(filename, G%domain)) then call log_param(param_file, mdl, "INPUTDIR/REFL_ANGLE_FILE", filename) call MOM_read_data(filename, 'refl_angle', CS%refl_angle, G%domain) @@ -2402,7 +2394,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) "The path to the file containing the reflection coefficients.", & fail_if_missing=.false., default='') filename = trim(CS%inputdir) // trim(refl_pref_file) - allocate(CS%refl_pref(isd:ied,jsd:jed)) ; CS%refl_pref(:,:) = 1.0 + allocate(CS%refl_pref(isd:ied,jsd:jed), source=1.0) if (file_exists(filename, G%domain)) then call log_param(param_file, mdl, "INPUTDIR/REFL_PREF_FILE", filename) call MOM_read_data(filename, 'refl_pref', CS%refl_pref, G%domain) @@ -2414,7 +2406,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) call pass_var(CS%refl_pref,G%domain) ! Tag reflection cells with partial reflection (done here for speed) - allocate(CS%refl_pref_logical(isd:ied,jsd:jed)) ; CS%refl_pref_logical(:,:) = .false. + allocate(CS%refl_pref_logical(isd:ied,jsd:jed), source=.false.) do j=jsd,jed do i=isd,ied ! flag cells with partial reflection @@ -2430,7 +2422,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) "The path to the file containing the double-reflective ridge tags.", & fail_if_missing=.false., default='') filename = trim(CS%inputdir) // trim(refl_dbl_file) - allocate(ridge_temp(isd:ied,jsd:jed)) ; ridge_temp(:,:) = 0.0 + allocate(ridge_temp(isd:ied,jsd:jed), source=0.0) if (file_exists(filename, G%domain)) then call log_param(param_file, mdl, "INPUTDIR/REFL_DBL_FILE", filename) call MOM_read_data(filename, 'refl_dbl', ridge_temp, G%domain) @@ -2439,7 +2431,7 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) "REFL_DBL_FILE: "//trim(filename)//" not found") endif call pass_var(ridge_temp,G%domain) - allocate(CS%refl_dbl(isd:ied,jsd:jed)) ; CS%refl_dbl(:,:) = .false. + allocate(CS%refl_dbl(isd:ied,jsd:jed), source=.false.) do i=isd,ied ; do j=jsd,jed if (ridge_temp(i,j) == 1) then; CS%refl_dbl(i,j) = .true. else ; CS%refl_dbl(i,j) = .false. ; endif @@ -2526,15 +2518,15 @@ subroutine internal_tides_init(Time, G, GV, US, param_file, diag, CS) Time, 'Internal tide energy loss summed over all processes', & 'W m-2', conversion=US%RZ3_T3_to_W_m2) - allocate(CS%id_En_mode(CS%nFreq,CS%nMode)) ; CS%id_En_mode(:,:) = -1 - allocate(CS%id_En_ang_mode(CS%nFreq,CS%nMode)) ; CS%id_En_ang_mode(:,:) = -1 - allocate(CS%id_itidal_loss_mode(CS%nFreq,CS%nMode)) ; CS%id_itidal_loss_mode(:,:) = -1 - allocate(CS%id_allprocesses_loss_mode(CS%nFreq,CS%nMode)) ; CS%id_allprocesses_loss_mode(:,:) = -1 - allocate(CS%id_itidal_loss_ang_mode(CS%nFreq,CS%nMode)) ; CS%id_itidal_loss_ang_mode(:,:) = -1 - allocate(CS%id_Ub_mode(CS%nFreq,CS%nMode)) ; CS%id_Ub_mode(:,:) = -1 - allocate(CS%id_cp_mode(CS%nFreq,CS%nMode)) ; CS%id_cp_mode(:,:) = -1 + allocate(CS%id_En_mode(CS%nFreq,CS%nMode), source=-1) + allocate(CS%id_En_ang_mode(CS%nFreq,CS%nMode), source=-1) + allocate(CS%id_itidal_loss_mode(CS%nFreq,CS%nMode), source=-1) + allocate(CS%id_allprocesses_loss_mode(CS%nFreq,CS%nMode), source=-1) + allocate(CS%id_itidal_loss_ang_mode(CS%nFreq,CS%nMode), source=-1) + allocate(CS%id_Ub_mode(CS%nFreq,CS%nMode), source=-1) + allocate(CS%id_cp_mode(CS%nFreq,CS%nMode), source=-1) - allocate(angles(CS%NAngle)) ; angles(:) = 0.0 + allocate(angles(CS%NAngle), source=0.0) Angle_size = (8.0*atan(1.0)) / (real(num_angle)) do a=1,num_angle ; angles(a) = (real(a) - 1) * Angle_size ; enddo diff --git a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 index b3dd5c9b70..2d1f7103e6 100644 --- a/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 +++ b/src/parameterizations/lateral/MOM_lateral_mixing_coeffs.F90 @@ -1268,7 +1268,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) "The depth below which N2 is monotonized to avoid stratification "//& "artifacts from altering the equivalent barotropic mode structure.",& units="m", default=2000., scale=US%m_to_Z) - allocate(CS%ebt_struct(isd:ied,jsd:jed,GV%ke)) ; CS%ebt_struct(:,:,:) = 0.0 + allocate(CS%ebt_struct(isd:ied,jsd:jed,GV%ke), source=0.0) endif if (CS%use_stored_slopes) then @@ -1285,8 +1285,8 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) if (CS%use_stored_slopes) then in_use = .true. - allocate(CS%slope_x(IsdB:IedB,jsd:jed,GV%ke+1)) ; CS%slope_x(:,:,:) = 0.0 - allocate(CS%slope_y(isd:ied,JsdB:JedB,GV%ke+1)) ; CS%slope_y(:,:,:) = 0.0 + allocate(CS%slope_x(IsdB:IedB,jsd:jed,GV%ke+1), source=0.0) + allocate(CS%slope_y(isd:ied,JsdB:JedB,GV%ke+1), source=0.0) call get_param(param_file, mdl, "KD_SMOOTH", CS%kappa_smooth, & "A diapycnal diffusivity that is used to interpolate "//& "more sensible values of T & S into thin layers.", & @@ -1295,8 +1295,8 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) if (CS%calculate_Eady_growth_rate) then in_use = .true. - allocate(CS%SN_u(IsdB:IedB,jsd:jed)) ; CS%SN_u(:,:) = 0.0 - allocate(CS%SN_v(isd:ied,JsdB:JedB)) ; CS%SN_v(:,:) = 0.0 + allocate(CS%SN_u(IsdB:IedB,jsd:jed), source=0.0) + allocate(CS%SN_v(isd:ied,JsdB:JedB), source=0.0) CS%id_SN_u = register_diag_field('ocean_model', 'SN_u', diag%axesCu1, Time, & 'Inverse eddy time-scale, S*N, at u-points', 's-1', conversion=US%s_to_T) CS%id_SN_v = register_diag_field('ocean_model', 'SN_v', diag%axesCv1, Time, & @@ -1329,8 +1329,8 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) call get_param(param_file, mdl, "VISBECK_L_SCALE", CS%Visbeck_L_scale, & "The fixed length scale in the Visbeck formula.", units="m", & default=0.0) - allocate(CS%L2u(IsdB:IedB,jsd:jed)) ; CS%L2u(:,:) = 0.0 - allocate(CS%L2v(isd:ied,JsdB:JedB)) ; CS%L2v(:,:) = 0.0 + allocate(CS%L2u(IsdB:IedB,jsd:jed), source=0.0) + allocate(CS%L2v(isd:ied,JsdB:JedB), source=0.0) if (CS%Visbeck_L_scale<0) then do j=js,je ; do I=is-1,Ieq CS%L2u(I,j) = CS%Visbeck_L_scale**2 * G%areaCu(I,j) @@ -1386,16 +1386,16 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) if (CS%Resoln_scaled_Kh .or. CS%Resoln_scaled_KhTh .or. CS%Resoln_scaled_KhTr) then CS%calculate_Rd_dx = .true. CS%calculate_res_fns = .true. - allocate(CS%Res_fn_h(isd:ied,jsd:jed)) ; CS%Res_fn_h(:,:) = 0.0 - allocate(CS%Res_fn_q(IsdB:IedB,JsdB:JedB)) ; CS%Res_fn_q(:,:) = 0.0 - allocate(CS%Res_fn_u(IsdB:IedB,jsd:jed)) ; CS%Res_fn_u(:,:) = 0.0 - allocate(CS%Res_fn_v(isd:ied,JsdB:JedB)) ; CS%Res_fn_v(:,:) = 0.0 - allocate(CS%beta_dx2_q(IsdB:IedB,JsdB:JedB)) ; CS%beta_dx2_q(:,:) = 0.0 - allocate(CS%beta_dx2_u(IsdB:IedB,jsd:jed)) ; CS%beta_dx2_u(:,:) = 0.0 - allocate(CS%beta_dx2_v(isd:ied,JsdB:JedB)) ; CS%beta_dx2_v(:,:) = 0.0 - allocate(CS%f2_dx2_q(IsdB:IedB,JsdB:JedB)) ; CS%f2_dx2_q(:,:) = 0.0 - allocate(CS%f2_dx2_u(IsdB:IedB,jsd:jed)) ; CS%f2_dx2_u(:,:) = 0.0 - allocate(CS%f2_dx2_v(isd:ied,JsdB:JedB)) ; CS%f2_dx2_v(:,:) = 0.0 + allocate(CS%Res_fn_h(isd:ied,jsd:jed), source=0.0) + allocate(CS%Res_fn_q(IsdB:IedB,JsdB:JedB), source=0.0) + allocate(CS%Res_fn_u(IsdB:IedB,jsd:jed), source=0.0) + allocate(CS%Res_fn_v(isd:ied,JsdB:JedB), source=0.0) + allocate(CS%beta_dx2_q(IsdB:IedB,JsdB:JedB), source=0.0) + allocate(CS%beta_dx2_u(IsdB:IedB,jsd:jed), source=0.0) + allocate(CS%beta_dx2_v(isd:ied,JsdB:JedB), source=0.0) + allocate(CS%f2_dx2_q(IsdB:IedB,JsdB:JedB), source=0.0) + allocate(CS%f2_dx2_u(IsdB:IedB,jsd:jed), source=0.0) + allocate(CS%f2_dx2_v(isd:ied,JsdB:JedB), source=0.0) CS%id_Res_fn = register_diag_field('ocean_model', 'Res_fn', diag%axesT1, Time, & 'Resolution function for scaling diffusivities', 'nondim') @@ -1483,14 +1483,14 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) if (CS%Depth_scaled_KhTh) then CS%calculate_depth_fns = .true. - allocate(CS%Depth_fn_u(IsdB:IedB,jsd:jed)) ; CS%Depth_fn_u(:,:) = 0.0 - allocate(CS%Depth_fn_v(isd:ied,JsdB:JedB)) ; CS%Depth_fn_v(:,:) = 0.0 + allocate(CS%Depth_fn_u(IsdB:IedB,jsd:jed), source=0.0) + allocate(CS%Depth_fn_v(isd:ied,JsdB:JedB), source=0.0) call get_param(param_file, mdl, "DEPTH_SCALED_KHTH_H0", CS%depth_scaled_khth_h0, & - "The depth above which KHTH is scaled away.",& - units="m", scale=US%m_to_Z, default=1000.) + "The depth above which KHTH is scaled away.", & + units="m", scale=US%m_to_Z, default=1000.) call get_param(param_file, mdl, "DEPTH_SCALED_KHTH_EXP", CS%depth_scaled_khth_exp, & - "The exponent used in the depth dependent scaling function for KHTH.",& - units="nondim", default=3.0) + "The exponent used in the depth dependent scaling function for KHTH.", & + units="nondim", default=3.0) endif ! Resolution %Rd_dx_h @@ -1500,9 +1500,9 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) if (CS%calculate_Rd_dx) then CS%calculate_cg1 = .true. ! We will need %cg1 - allocate(CS%Rd_dx_h(isd:ied,jsd:jed)) ; CS%Rd_dx_h(:,:) = 0.0 - allocate(CS%beta_dx2_h(isd:ied,jsd:jed)); CS%beta_dx2_h(:,:) = 0.0 - allocate(CS%f2_dx2_h(isd:ied,jsd:jed)) ; CS%f2_dx2_h(:,:) = 0.0 + allocate(CS%Rd_dx_h(isd:ied,jsd:jed), source=0.0) + allocate(CS%beta_dx2_h(isd:ied,jsd:jed), source=0.0) + allocate(CS%f2_dx2_h(isd:ied,jsd:jed), source=0.0) do j=js-1,je+1 ; do i=is-1,ie+1 CS%f2_dx2_h(i,j) = (G%dxT(i,j)**2 + G%dyT(i,j)**2) * & max(0.25 * ((G%CoriolisBu(I,J)**2 + G%CoriolisBu(I-1,J-1)**2) + & @@ -1518,7 +1518,7 @@ subroutine VarMix_init(Time, G, GV, US, param_file, diag, CS) if (CS%calculate_cg1) then in_use = .true. - allocate(CS%cg1(isd:ied,jsd:jed)) ; CS%cg1(:,:) = 0.0 + allocate(CS%cg1(isd:ied,jsd:jed), source=0.0) call get_param(param_file, mdl, "DEFAULT_2018_ANSWERS", default_2018_answers, & "This sets the default value for the various _2018_ANSWERS parameters.", & default=.false.) diff --git a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 index 9da72d9b2d..0d2062441e 100644 --- a/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 +++ b/src/parameterizations/lateral/MOM_mixed_layer_restrat.F90 @@ -971,14 +971,14 @@ subroutine mixedlayer_restrat_register_restarts(HI, param_file, CS, restart_CS) default=0., do_not_log=.true.) if (CS%MLE_MLD_decay_time>0. .or. CS%MLE_MLD_decay_time2>0.) then ! CS%MLD_filtered is used to keep a running mean of the PBL's actively mixed MLD. - allocate(CS%MLD_filtered(HI%isd:HI%ied,HI%jsd:HI%jed)) ; CS%MLD_filtered(:,:) = 0. + allocate(CS%MLD_filtered(HI%isd:HI%ied,HI%jsd:HI%jed), source=0.) vd = var_desc("MLD_MLE_filtered","m","Time-filtered MLD for use in MLE", & hor_grid='h', z_grid='1') call register_restart_field(CS%MLD_filtered, vd, .false., restart_CS) endif if (CS%MLE_MLD_decay_time2>0.) then ! CS%MLD_filtered_slow is used to keep a running mean of the PBL's seasonal or winter MLD. - allocate(CS%MLD_filtered_slow(HI%isd:HI%ied,HI%jsd:HI%jed)) ; CS%MLD_filtered_slow(:,:) = 0. + allocate(CS%MLD_filtered_slow(HI%isd:HI%ied,HI%jsd:HI%jed), source=0.) vd = var_desc("MLD_MLE_filtered_slow","m","c Slower time-filtered MLD for use in MLE", & hor_grid='h', z_grid='1') call register_restart_field(CS%MLD_filtered_slow, vd, .false., restart_CS) diff --git a/src/parameterizations/lateral/MOM_tidal_forcing.F90 b/src/parameterizations/lateral/MOM_tidal_forcing.F90 index 307fbbe3ef..862b622d56 100644 --- a/src/parameterizations/lateral/MOM_tidal_forcing.F90 +++ b/src/parameterizations/lateral/MOM_tidal_forcing.F90 @@ -270,8 +270,8 @@ subroutine tidal_forcing_init(Time, G, param_file, CS) ! Set up the spatial structure functions for the diurnal, semidiurnal, and ! low-frequency tidal components. - allocate(CS%sin_struct(isd:ied,jsd:jed,3)) ; CS%sin_struct(:,:,:) = 0.0 - allocate(CS%cos_struct(isd:ied,jsd:jed,3)) ; CS%cos_struct(:,:,:) = 0.0 + allocate(CS%sin_struct(isd:ied,jsd:jed,3), source=0.0) + allocate(CS%cos_struct(isd:ied,jsd:jed,3), source=0.0) deg_to_rad = 4.0*ATAN(1.0)/180.0 do j=js-1,je+1 ; do i=is-1,ie+1 lat_rad(i,j) = G%geoLatT(i,j)*deg_to_rad diff --git a/src/parameterizations/vertical/MOM_ALE_sponge.F90 b/src/parameterizations/vertical/MOM_ALE_sponge.F90 index 5847b13fa8..1225487eaf 100644 --- a/src/parameterizations/vertical/MOM_ALE_sponge.F90 +++ b/src/parameterizations/vertical/MOM_ALE_sponge.F90 @@ -28,9 +28,6 @@ module MOM_ALE_sponge use MOM_unit_scaling, only : unit_scale_type use MOM_verticalGrid, only : verticalGrid_type -use mpp_io_mod, only : mpp_get_axis_length -use mpp_io_mod, only : axistype - implicit none ; private #include @@ -238,9 +235,9 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, GV, param_file, CS, data_h, enddo ; enddo if (CS%num_col > 0) then - allocate(CS%Iresttime_col(CS%num_col)) ; CS%Iresttime_col = 0.0 - allocate(CS%col_i(CS%num_col)) ; CS%col_i = 0 - allocate(CS%col_j(CS%num_col)) ; CS%col_j = 0 + allocate(CS%Iresttime_col(CS%num_col), source=0.0) + allocate(CS%col_i(CS%num_col), source=0) + allocate(CS%col_j(CS%num_col), source=0) ! pass indices, restoring time to the CS structure col = 1 do j=G%jsc,G%jec ; do i=G%isc,G%iec @@ -269,8 +266,8 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, GV, param_file, CS, data_h, "The total number of columns where sponges are applied at h points.", like_default=.true.) if (CS%sponge_uv) then - allocate(Iresttime_u(G%isdB:G%iedB,G%jsd:G%jed)) ; Iresttime_u(:,:) = 0.0 - allocate(Iresttime_v(G%isd:G%ied,G%jsdB:G%jedB)) ; Iresttime_v(:,:) = 0.0 + allocate(Iresttime_u(G%isdB:G%iedB,G%jsd:G%jed), source=0.0) + allocate(Iresttime_v(G%isd:G%ied,G%jsdB:G%jedB), source=0.0) call pass_var(Iresttime,G%Domain) call pass_var(data_h,G%Domain) @@ -291,9 +288,9 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, GV, param_file, CS, data_h, if (CS%num_col_u > 0) then - allocate(CS%Iresttime_col_u(CS%num_col_u)) ; CS%Iresttime_col_u(:) = 0.0 - allocate(CS%col_i_u(CS%num_col_u)) ; CS%col_i_u(:) = 0 - allocate(CS%col_j_u(CS%num_col_u)) ; CS%col_j_u(:) = 0 + allocate(CS%Iresttime_col_u(CS%num_col_u), source=0.0) + allocate(CS%col_i_u(CS%num_col_u), source=0) + allocate(CS%col_j_u(CS%num_col_u), source=0) ! Store the column indices and restoring rates in the CS structure col = 1 @@ -335,9 +332,9 @@ subroutine initialize_ALE_sponge_fixed(Iresttime, G, GV, param_file, CS, data_h, if (CS%num_col_v > 0) then - allocate(CS%Iresttime_col_v(CS%num_col_v)) ; CS%Iresttime_col_v = 0.0 - allocate(CS%col_i_v(CS%num_col_v)) ; CS%col_i_v = 0 - allocate(CS%col_j_v(CS%num_col_v)) ; CS%col_j_v = 0 + allocate(CS%Iresttime_col_v(CS%num_col_v), source=0.0) + allocate(CS%col_i_v(CS%num_col_v), source=0) + allocate(CS%col_j_v(CS%num_col_v), source=0) ! pass indices, restoring time to the CS structure col = 1 @@ -397,12 +394,12 @@ subroutine get_ALE_sponge_thicknesses(G, data_h, sponge_mask, CS) if (.not.associated(CS)) then ! There are no sponge points on this PE. - allocate(data_h(G%isd:G%ied,G%jsd:G%jed,1)) ; data_h(:,:,:) = -1.0 + allocate(data_h(G%isd:G%ied,G%jsd:G%jed,1), source=-1.0) sponge_mask(:,:) = .false. return endif - allocate(data_h(G%isd:G%ied,G%jsd:G%jed,CS%nz_data)) ; data_h(:,:,:) = -1.0 + allocate(data_h(G%isd:G%ied,G%jsd:G%jed,CS%nz_data), source=-1.0) sponge_mask(:,:) = .false. do c=1,CS%num_col @@ -503,9 +500,9 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, GV, param_file, CS, Irest CS%num_col = CS%num_col + 1 enddo ; enddo if (CS%num_col > 0) then - allocate(CS%Iresttime_col(CS%num_col)) ; CS%Iresttime_col = 0.0 - allocate(CS%col_i(CS%num_col)) ; CS%col_i = 0 - allocate(CS%col_j(CS%num_col)) ; CS%col_j = 0 + allocate(CS%Iresttime_col(CS%num_col), source=0.0) + allocate(CS%col_i(CS%num_col), source=0) + allocate(CS%col_j(CS%num_col), source=0) ! pass indices, restoring time to the CS structure col = 1 do j=G%jsc,G%jec ; do i=G%isc,G%iec @@ -525,8 +522,8 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, GV, param_file, CS, Irest call log_param(param_file, mdl, "!Total sponge columns at h points", total_sponge_cols, & "The total number of columns where sponges are applied at h points.", like_default=.true.) if (CS%sponge_uv) then - allocate(Iresttime_u(G%isdB:G%iedB,G%jsd:G%jed)) ; Iresttime_u(:,:) = 0.0 - allocate(Iresttime_v(G%isd:G%ied,G%jsdB:G%jedB)) ; Iresttime_v(:,:) = 0.0 + allocate(Iresttime_u(G%isdB:G%iedB,G%jsd:G%jed), source=0.0) + allocate(Iresttime_v(G%isd:G%ied,G%jsdB:G%jedB), source=0.0) call pass_var(Iresttime,G%Domain) ! u points @@ -543,9 +540,9 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, GV, param_file, CS, Irest CS%num_col_u = CS%num_col_u + 1 enddo ; enddo if (CS%num_col_u > 0) then - allocate(CS%Iresttime_col_u(CS%num_col_u)) ; CS%Iresttime_col_u = 0.0 - allocate(CS%col_i_u(CS%num_col_u)) ; CS%col_i_u = 0 - allocate(CS%col_j_u(CS%num_col_u)) ; CS%col_j_u = 0 + allocate(CS%Iresttime_col_u(CS%num_col_u), source=0.0) + allocate(CS%col_i_u(CS%num_col_u), source=0) + allocate(CS%col_j_u(CS%num_col_u), source=0) ! pass indices, restoring time to the CS structure col = 1 do j=G%jsc,G%jec ; do I=G%iscB,G%iecB @@ -575,9 +572,9 @@ subroutine initialize_ALE_sponge_varying(Iresttime, G, GV, param_file, CS, Irest CS%num_col_v = CS%num_col_v + 1 enddo ; enddo if (CS%num_col_v > 0) then - allocate(CS%Iresttime_col_v(CS%num_col_v)) ; CS%Iresttime_col_v = 0.0 - allocate(CS%col_i_v(CS%num_col_v)) ; CS%col_i_v = 0 - allocate(CS%col_j_v(CS%num_col_v)) ; CS%col_j_v = 0 + allocate(CS%Iresttime_col_v(CS%num_col_v), source=0.0) + allocate(CS%col_i_v(CS%num_col_v), source=0) + allocate(CS%col_j_v(CS%num_col_v), source=0) ! pass indices, restoring time to the CS structure col = 1 do J=G%jscB,G%jecB ; do i=G%isc,G%iec @@ -652,8 +649,7 @@ subroutine set_up_ALE_sponge_field_fixed(sp_val, G, GV, f_ptr, CS) ! stores the reference profile CS%Ref_val(CS%fldno)%nz_data = CS%nz_data - allocate(CS%Ref_val(CS%fldno)%p(CS%nz_data,CS%num_col)) - CS%Ref_val(CS%fldno)%p(:,:) = 0.0 + allocate(CS%Ref_val(CS%fldno)%p(CS%nz_data,CS%num_col), source=0.0) do col=1,CS%num_col do k=1,CS%nz_data CS%Ref_val(CS%fldno)%p(k,col) = sp_val(CS%col_i(col),CS%col_j(col),k) @@ -718,10 +714,8 @@ subroutine set_up_ALE_sponge_field_varying(filename, fieldname, Time, G, GV, US, CS%Ref_val(CS%fldno)%num_tlevs = fld_sz(4) ! initializes the target profile array for this field ! for all columns which will be masked - allocate(CS%Ref_val(CS%fldno)%p(nz_data,CS%num_col)) - CS%Ref_val(CS%fldno)%p(:,:) = 0.0 - allocate( CS%Ref_val(CS%fldno)%h(nz_data,CS%num_col) ) - CS%Ref_val(CS%fldno)%h(:,:) = 0.0 + allocate(CS%Ref_val(CS%fldno)%p(nz_data,CS%num_col), source=0.0) + allocate(CS%Ref_val(CS%fldno)%h(nz_data,CS%num_col), source=0.0) CS%var(CS%fldno)%p => f_ptr end subroutine set_up_ALE_sponge_field_varying @@ -749,16 +743,14 @@ subroutine set_up_ALE_sponge_vel_field_fixed(u_val, v_val, G, GV, u_ptr, v_ptr, if (.not.associated(CS)) return ! stores the reference profile - allocate(CS%Ref_val_u%p(CS%nz_data,CS%num_col_u)) - CS%Ref_val_u%p(:,:) = 0.0 + allocate(CS%Ref_val_u%p(CS%nz_data,CS%num_col_u), source=0.0) do col=1,CS%num_col_u do k=1,CS%nz_data CS%Ref_val_u%p(k,col) = u_val(CS%col_i_u(col),CS%col_j_u(col),k) enddo enddo CS%var_u%p => u_ptr - allocate(CS%Ref_val_v%p(CS%nz_data,CS%num_col_v)) - CS%Ref_val_v%p(:,:) = 0.0 + allocate(CS%Ref_val_v%p(CS%nz_data,CS%num_col_v), source=0.0) do col=1,CS%num_col_v do k=1,CS%nz_data CS%Ref_val_v%p(k,col) = v_val(CS%col_i_v(col),CS%col_j_v(col),k) @@ -797,9 +789,7 @@ subroutine set_up_ALE_sponge_vel_field_varying(filename_u, fieldname_u, filename integer :: isdB, iedB, jsdB, jedB integer, dimension(4) :: fld_sz character(len=256) :: mesg ! String for error messages - type(axistype), dimension(4) :: axes_data integer :: tmp - integer :: axis_sizes(4) if (.not.associated(CS)) return override =.true. @@ -830,15 +820,11 @@ subroutine set_up_ALE_sponge_vel_field_varying(filename_u, fieldname_u, filename CS%Ref_val_v%num_tlevs = fld_sz(4) ! stores the reference profile - allocate(CS%Ref_val_u%p(fld_sz(3),CS%num_col_u)) - CS%Ref_val_u%p(:,:) = 0.0 - allocate(CS%Ref_val_u%h(fld_sz(3),CS%num_col_u) ) - CS%Ref_val_u%h(:,:) = 0.0 + allocate(CS%Ref_val_u%p(fld_sz(3),CS%num_col_u), source=0.0) + allocate(CS%Ref_val_u%h(fld_sz(3),CS%num_col_u), source=0.0) CS%var_u%p => u_ptr - allocate(CS%Ref_val_v%p(fld_sz(3),CS%num_col_v)) - CS%Ref_val_v%p(:,:) = 0.0 - allocate(CS%Ref_val_v%h(fld_sz(3),CS%num_col_v) ) - CS%Ref_val_v%h(:,:) = 0.0 + allocate(CS%Ref_val_v%p(fld_sz(3),CS%num_col_v), source=0.0) + allocate(CS%Ref_val_v%h(fld_sz(3),CS%num_col_v), source=0.0) CS%var_v%p => v_ptr end subroutine set_up_ALE_sponge_vel_field_varying @@ -948,7 +934,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) nz_data = CS%Ref_val(m)%nz_data allocate(tmp_val2(CS%Ref_val(m)%nz_data)) if (CS%id_sp_tendency(m) > 0) then - allocate(tmp(G%isd:G%ied,G%jsd:G%jed,nz));tmp(:,:,:) = 0.0 + allocate(tmp(G%isd:G%ied,G%jsd:G%jed,nz), source=0.0) endif do c=1,CS%num_col ! c is an index for the next 3 lines but a multiplier for the rest of the loop @@ -1091,7 +1077,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) nz_data = CS%Ref_val_u%nz_data allocate(tmp_val2(nz_data)) if (CS%id_sp_u_tendency > 0) then - allocate(tmp_u(G%isdB:G%iedB,G%jsd:G%jed,nz)) ; tmp_u(:,:,:)=0.0 + allocate(tmp_u(G%isdB:G%iedB,G%jsd:G%jed,nz), source=0.0) endif ! u points do c=1,CS%num_col_u @@ -1121,7 +1107,7 @@ subroutine apply_ALE_sponge(h, dt, G, GV, US, CS, Time) endif ! v points if (CS%id_sp_v_tendency > 0) then - allocate(tmp_v(G%isd:G%ied,G%jsdB:G%jedB,nz)) ; tmp_v(:,:,:)=0.0 + allocate(tmp_v(G%isd:G%ied,G%jsdB:G%jedB,nz), source=0.0) endif nz_data = CS%Ref_val_v%nz_data allocate(tmp_val2(nz_data)) @@ -1187,15 +1173,13 @@ subroutine rotate_ALE_sponge(sponge_in, G_in, sponge, G, GV, turns, param_file) fixed_sponge = .not. sponge_in%time_varying_sponges ! NOTE: nz_data is only conditionally set when fixed_sponge is true. - allocate(Iresttime_in(G_in%isd:G_in%ied, G_in%jsd:G_in%jed)) + allocate(Iresttime_in(G_in%isd:G_in%ied, G_in%jsd:G_in%jed), source=0.0) allocate(Iresttime(G%isd:G%ied, G%jsd:G%jed)) - Iresttime_in(:,:) = 0.0 if (fixed_sponge) then nz_data = sponge_in%nz_data - allocate(data_h_in(G_in%isd:G_in%ied, G_in%jsd:G_in%jed, nz_data)) + allocate(data_h_in(G_in%isd:G_in%ied, G_in%jsd:G_in%jed, nz_data), source=0.0) allocate(data_h(G%isd:G%ied, G%jsd:G%jed, nz_data)) - data_h_in(:,:,:) = 0. endif ! Re-populate the 2D Iresttime and data_h arrays on the original grid @@ -1264,10 +1248,8 @@ subroutine rotate_ALE_sponge(sponge_in, G_in, sponge, G, GV, turns, param_file) nz_data = sponge_in%Ref_val(n)%nz_data sponge%Ref_val(n)%nz_data = nz_data - allocate(sponge%Ref_val(n)%p(nz_data, sponge_in%num_col)) - allocate(sponge%Ref_val(n)%h(nz_data, sponge_in%num_col)) - sponge%Ref_val(n)%p(:,:) = 0.0 - sponge%Ref_val(n)%h(:,:) = 0.0 + allocate(sponge%Ref_val(n)%p(nz_data, sponge_in%num_col), source=0.0) + allocate(sponge%Ref_val(n)%h(nz_data, sponge_in%num_col), source=0.0) ! TODO: There is currently no way to associate a generic field pointer to ! its rotated equivalent without introducing a new data structure which diff --git a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 index 4dcaa70bc2..0711d2291d 100644 --- a/src/parameterizations/vertical/MOM_CVMix_KPP.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_KPP.F90 @@ -577,49 +577,29 @@ logical function KPP_init(paramFile, G, GV, US, diag, Time, CS, passive, Waves) CS%id_La_SL = register_diag_field('ocean_model', 'KPP_La_SL', diag%axesT1, Time, & 'Surface-layer Langmuir number computed in [CVMix] KPP','nondim') - allocate( CS%N( SZI_(G), SZJ_(G),SZK_(GV)+1 ) ) - CS%N(:,:,:) = 0. - allocate( CS%OBLdepth( SZI_(G), SZJ_(G) ) ) - CS%OBLdepth(:,:) = 0. - allocate( CS%kOBL( SZI_(G), SZJ_(G) ) ) - CS%kOBL(:,:) = 0. - allocate( CS%La_SL( SZI_(G), SZJ_(G) ) ) - CS%La_SL(:,:) = 0. - allocate( CS%Vt2( SZI_(G), SZJ_(G),SZK_(GV) ) ) - CS%Vt2(:,:,:) = 0. + allocate( CS%N( SZI_(G), SZJ_(G), SZK_(GV)+1 ), source=0. ) + allocate( CS%OBLdepth( SZI_(G), SZJ_(G) ), source=0. ) + allocate( CS%kOBL( SZI_(G), SZJ_(G) ), source=0. ) + allocate( CS%La_SL( SZI_(G), SZJ_(G) ), source=0. ) + allocate( CS%Vt2( SZI_(G), SZJ_(G), SZK_(GV) ), source=0. ) if (CS%id_OBLdepth_original > 0) allocate( CS%OBLdepth_original( SZI_(G), SZJ_(G) ) ) - allocate( CS%OBLdepthprev( SZI_(G), SZJ_(G) ) ) ; CS%OBLdepthprev(:,:) = 0.0 - if (CS%id_BulkDrho > 0) allocate( CS%dRho( SZI_(G), SZJ_(G),SZK_(GV) ) ) - if (CS%id_BulkDrho > 0) CS%dRho(:,:,:) = 0. - if (CS%id_BulkUz2 > 0) allocate( CS%Uz2( SZI_(G), SZJ_(G),SZK_(GV) ) ) - if (CS%id_BulkUz2 > 0) CS%Uz2(:,:,:) = 0. - if (CS%id_BulkRi > 0) allocate( CS%BulkRi( SZI_(G), SZJ_(G),SZK_(GV) ) ) - if (CS%id_BulkRi > 0) CS%BulkRi(:,:,:) = 0. - if (CS%id_Sigma > 0) allocate( CS%sigma( SZI_(G), SZJ_(G),SZK_(GV)+1 ) ) - if (CS%id_Sigma > 0) CS%sigma(:,:,:) = 0. - if (CS%id_Ws > 0) allocate( CS%Ws( SZI_(G), SZJ_(G),SZK_(GV) ) ) - if (CS%id_Ws > 0) CS%Ws(:,:,:) = 0. - if (CS%id_N2 > 0) allocate( CS%N2( SZI_(G), SZJ_(G),SZK_(GV)+1 ) ) - if (CS%id_N2 > 0) CS%N2(:,:,:) = 0. - if (CS%id_Kt_KPP > 0) allocate( CS%Kt_KPP( SZI_(G), SZJ_(G),SZK_(GV)+1 ) ) - if (CS%id_Kt_KPP > 0) CS%Kt_KPP(:,:,:) = 0. - if (CS%id_Ks_KPP > 0) allocate( CS%Ks_KPP( SZI_(G), SZJ_(G),SZK_(GV)+1 ) ) - if (CS%id_Ks_KPP > 0) CS%Ks_KPP(:,:,:) = 0. - if (CS%id_Kv_KPP > 0) allocate( CS%Kv_KPP( SZI_(G), SZJ_(G),SZK_(GV)+1 ) ) - if (CS%id_Kv_KPP > 0) CS%Kv_KPP(:,:,:) = 0. - if (CS%id_Tsurf > 0) allocate( CS%Tsurf( SZI_(G), SZJ_(G)) ) - if (CS%id_Tsurf > 0) CS%Tsurf(:,:) = 0. - if (CS%id_Ssurf > 0) allocate( CS%Ssurf( SZI_(G), SZJ_(G)) ) - if (CS%id_Ssurf > 0) CS%Ssurf(:,:) = 0. - if (CS%id_Usurf > 0) allocate( CS%Usurf( SZIB_(G), SZJ_(G)) ) - if (CS%id_Usurf > 0) CS%Usurf(:,:) = 0. - if (CS%id_Vsurf > 0) allocate( CS%Vsurf( SZI_(G), SZJB_(G)) ) - if (CS%id_Vsurf > 0) CS%Vsurf(:,:) = 0. - if (CS%id_EnhVt2 > 0) allocate( CS%EnhVt2( SZI_(G), SZJ_(G),SZK_(GV)) ) - if (CS%id_EnhVt2 > 0) CS%EnhVt2(:,:,:) = 0. - if (CS%id_EnhK > 0) allocate( CS%EnhK( SZI_(G), SZJ_(G),SZK_(GV)+1 ) ) - if (CS%id_EnhK > 0) CS%EnhK(:,:,:) = 0. + allocate( CS%OBLdepthprev( SZI_(G), SZJ_(G) ), source=0.0 ) + if (CS%id_BulkDrho > 0) allocate( CS%dRho( SZI_(G), SZJ_(G), SZK_(GV) ), source=0. ) + if (CS%id_BulkUz2 > 0) allocate( CS%Uz2( SZI_(G), SZJ_(G), SZK_(GV) ), source=0. ) + if (CS%id_BulkRi > 0) allocate( CS%BulkRi( SZI_(G), SZJ_(G), SZK_(GV) ), source=0. ) + if (CS%id_Sigma > 0) allocate( CS%sigma( SZI_(G), SZJ_(G), SZK_(GV)+1 ), source=0. ) + if (CS%id_Ws > 0) allocate( CS%Ws( SZI_(G), SZJ_(G), SZK_(GV) ), source=0. ) + if (CS%id_N2 > 0) allocate( CS%N2( SZI_(G), SZJ_(G), SZK_(GV)+1 ), source=0. ) + if (CS%id_Kt_KPP > 0) allocate( CS%Kt_KPP( SZI_(G), SZJ_(G), SZK_(GV)+1 ), source=0. ) + if (CS%id_Ks_KPP > 0) allocate( CS%Ks_KPP( SZI_(G), SZJ_(G), SZK_(GV)+1 ), source=0. ) + if (CS%id_Kv_KPP > 0) allocate( CS%Kv_KPP( SZI_(G), SZJ_(G), SZK_(GV)+1 ), source=0. ) + if (CS%id_Tsurf > 0) allocate( CS%Tsurf( SZI_(G), SZJ_(G) ), source=0. ) + if (CS%id_Ssurf > 0) allocate( CS%Ssurf( SZI_(G), SZJ_(G) ), source=0. ) + if (CS%id_Usurf > 0) allocate( CS%Usurf( SZIB_(G), SZJ_(G) ), source=0. ) + if (CS%id_Vsurf > 0) allocate( CS%Vsurf( SZI_(G), SZJB_(G) ), source=0. ) + if (CS%id_EnhVt2 > 0) allocate( CS%EnhVt2( SZI_(G), SZJ_(G), SZK_(GV) ), source=0. ) + if (CS%id_EnhK > 0) allocate( CS%EnhK( SZI_(G), SZJ_(G), SZK_(GV)+1 ), source=0. ) id_clock_KPP_calc = cpu_clock_id('Ocean KPP calculate)', grain=CLOCK_MODULE) id_clock_KPP_compute_BLD = cpu_clock_id('(Ocean KPP comp BLD)', grain=CLOCK_ROUTINE) diff --git a/src/parameterizations/vertical/MOM_CVMix_shear.F90 b/src/parameterizations/vertical/MOM_CVMix_shear.F90 index 35e5352a9f..87e5107acd 100644 --- a/src/parameterizations/vertical/MOM_CVMix_shear.F90 +++ b/src/parameterizations/vertical/MOM_CVMix_shear.F90 @@ -289,26 +289,26 @@ logical function CVMix_shear_init(Time, G, GV, US, param_file, diag, CS) CS%id_N2 = register_diag_field('ocean_model', 'N2_shear', diag%axesTi, Time, & 'Square of Brunt-Vaisala frequency used by MOM_CVMix_shear module', '1/s2', conversion=US%s_to_T**2) if (CS%id_N2 > 0) then - allocate( CS%N2( SZI_(G), SZJ_(G),SZK_(GV)+1 ) ) ; CS%N2(:,:,:) = 0. + allocate( CS%N2( SZI_(G), SZJ_(G), SZK_(GV)+1 ), source=0. ) endif CS%id_S2 = register_diag_field('ocean_model', 'S2_shear', diag%axesTi, Time, & 'Square of vertical shear used by MOM_CVMix_shear module','1/s2', conversion=US%s_to_T**2) if (CS%id_S2 > 0) then - allocate( CS%S2( SZI_(G), SZJ_(G),SZK_(GV)+1 ) ) ; CS%S2(:,:,:) = 0. + allocate( CS%S2( SZI_(G), SZJ_(G), SZK_(GV)+1 ), source=0. ) endif CS%id_ri_grad = register_diag_field('ocean_model', 'ri_grad_shear', diag%axesTi, Time, & 'Gradient Richarson number used by MOM_CVMix_shear module','nondim') if (CS%id_ri_grad > 0) then !Initialize w/ large Richardson value - allocate( CS%ri_grad( SZI_(G), SZJ_(G),SZK_(GV)+1 )) ; CS%ri_grad(:,:,:) = 1.e8 + allocate( CS%ri_grad( SZI_(G), SZJ_(G), SZK_(GV)+1 ), source=1.e8 ) endif CS%id_ri_grad_smooth = register_diag_field('ocean_model', 'ri_grad_shear_smooth', & diag%axesTi, Time, & 'Smoothed gradient Richarson number used by MOM_CVMix_shear module','nondim') if (CS%id_ri_grad_smooth > 0) then !Initialize w/ large Richardson value - allocate( CS%ri_grad_smooth( SZI_(G), SZJ_(G),SZK_(GV)+1 )) ; CS%ri_grad_smooth(:,:,:) = 1.e8 + allocate( CS%ri_grad_smooth( SZI_(G), SZJ_(G), SZK_(GV)+1 ), source=1.e8 ) endif CS%id_kd = register_diag_field('ocean_model', 'kd_shear_CVMix', diag%axesTi, Time, & diff --git a/src/parameterizations/vertical/MOM_diabatic_aux.F90 b/src/parameterizations/vertical/MOM_diabatic_aux.F90 index 072bc1445e..8d53594ebb 100644 --- a/src/parameterizations/vertical/MOM_diabatic_aux.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_aux.F90 @@ -1657,8 +1657,8 @@ subroutine diabatic_aux_init(Time, G, GV, US, param_file, diag, CS, useALEalgori ! need both arrays for the SW diagnostics (one for flux, one for convergence) if (CS%id_penSW_diag>0 .or. CS%id_penSWflux_diag>0) then - allocate(CS%penSW_diag(isd:ied,jsd:jed,nz)) ; CS%penSW_diag(:,:,:) = 0.0 - allocate(CS%penSWflux_diag(isd:ied,jsd:jed,nz+1)) ; CS%penSWflux_diag(:,:,:) = 0.0 + allocate(CS%penSW_diag(isd:ied,jsd:jed,nz), source=0.0) + allocate(CS%penSWflux_diag(isd:ied,jsd:jed,nz+1), source=0.0) endif ! diagnostic for non-downwelling SW radiation (i.e., SW absorbed at ocean surface) @@ -1668,7 +1668,7 @@ subroutine diabatic_aux_init(Time, G, GV, US, param_file, diag, CS, useALEalgori 'W m-2', conversion=US%QRZ_T_to_W_m2, & standard_name='nondownwelling_shortwave_flux_in_sea_water') if (CS%id_nonpenSW_diag > 0) then - allocate(CS%nonpenSW_diag(isd:ied,jsd:jed)) ; CS%nonpenSW_diag(:,:) = 0.0 + allocate(CS%nonpenSW_diag(isd:ied,jsd:jed), source=0.0) endif endif diff --git a/src/parameterizations/vertical/MOM_diabatic_driver.F90 b/src/parameterizations/vertical/MOM_diabatic_driver.F90 index 37f9d210a5..a546bcdec0 100644 --- a/src/parameterizations/vertical/MOM_diabatic_driver.F90 +++ b/src/parameterizations/vertical/MOM_diabatic_driver.F90 @@ -2489,8 +2489,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e !! Diagnostics for terms multiplied by fractional thicknesses if (CS%id_hf_dudt_dia_2d > 0) then - allocate(hf_dudt_dia_2d(G%IsdB:G%IedB,G%jsd:G%jed)) - hf_dudt_dia_2d(:,:) = 0.0 + allocate(hf_dudt_dia_2d(G%IsdB:G%IedB,G%jsd:G%jed), source=0.0) do k=1,nz ; do j=js,je ; do I=Isq,Ieq hf_dudt_dia_2d(I,j) = hf_dudt_dia_2d(I,j) + ADp%du_dt_dia(I,j,k) * ADp%diag_hfrac_u(I,j,k) enddo ; enddo ; enddo @@ -2499,8 +2498,7 @@ subroutine layered_diabatic(u, v, h, tv, Hml, fluxes, visc, ADp, CDp, dt, Time_e endif if (CS%id_hf_dvdt_dia_2d > 0) then - allocate(hf_dvdt_dia_2d(G%isd:G%ied,G%JsdB:G%JedB)) - hf_dvdt_dia_2d(:,:) = 0.0 + allocate(hf_dvdt_dia_2d(G%isd:G%ied,G%JsdB:G%JedB), source=0.0) do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie hf_dvdt_dia_2d(i,J) = hf_dvdt_dia_2d(i,J) + ADp%dv_dt_dia(i,J,k) * ADp%diag_hfrac_v(i,J,k) enddo ; enddo ; enddo @@ -3092,7 +3090,7 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di if (CS%use_int_tides) then CS%id_cg1 = register_diag_field('ocean_model', 'cn1', diag%axesT1, & Time, 'First baroclinic mode (eigen) speed', 'm s-1', conversion=US%L_T_to_m_s) - allocate(CS%id_cn(CS%nMode)) ; CS%id_cn(:) = -1 + allocate(CS%id_cn(CS%nMode), source=-1) do m=1,CS%nMode write(var_name, '("cn_mode",i1)') m write(var_descript, '("Baroclinic (eigen) speed of mode ",i1)') m @@ -3205,13 +3203,13 @@ subroutine diabatic_driver_init(Time, G, GV, US, param_file, useALEalgorithm, di ! KPP_init() allocated CS%KPP_Csp and also sets CS%KPPisPassive CS%useKPP = KPP_init(param_file, G, GV, US, diag, Time, CS%KPP_CSp, passive=CS%KPPisPassive) if (CS%useKPP) then - allocate( CS%KPP_NLTheat(isd:ied,jsd:jed,nz+1) ) ; CS%KPP_NLTheat(:,:,:) = 0. - allocate( CS%KPP_NLTscalar(isd:ied,jsd:jed,nz+1) ) ; CS%KPP_NLTscalar(:,:,:) = 0. + allocate(CS%KPP_NLTheat(isd:ied,jsd:jed,nz+1), source=0.0) + allocate(CS%KPP_NLTscalar(isd:ied,jsd:jed,nz+1), source=0.0) endif if (CS%useKPP) then - allocate( CS%KPP_buoy_flux(isd:ied,jsd:jed,nz+1) ) ; CS%KPP_buoy_flux(:,:,:) = 0. - allocate( CS%KPP_temp_flux(isd:ied,jsd:jed) ) ; CS%KPP_temp_flux(:,:) = 0. - allocate( CS%KPP_salt_flux(isd:ied,jsd:jed) ) ; CS%KPP_salt_flux(:,:) = 0. + allocate(CS%KPP_buoy_flux(isd:ied,jsd:jed,nz+1), source=0.0) + allocate(CS%KPP_temp_flux(isd:ied,jsd:jed), source=0.0) + allocate(CS%KPP_salt_flux(isd:ied,jsd:jed), source=0.0) endif diff --git a/src/parameterizations/vertical/MOM_internal_tide_input.F90 b/src/parameterizations/vertical/MOM_internal_tide_input.F90 index a6835d42ed..df24d3f4e9 100644 --- a/src/parameterizations/vertical/MOM_internal_tide_input.F90 +++ b/src/parameterizations/vertical/MOM_internal_tide_input.F90 @@ -355,11 +355,11 @@ subroutine int_tide_input_init(Time, G, GV, US, param_file, diag, CS, itide) "The constant tidal amplitude used with INT_TIDE_DISSIPATION.", & units="m s-1", default=0.0, scale=US%m_s_to_L_T) - allocate(itide%Nb(isd:ied,jsd:jed)) ; itide%Nb(:,:) = 0.0 - allocate(itide%h2(isd:ied,jsd:jed)) ; itide%h2(:,:) = 0.0 - allocate(itide%TKE_itidal_input(isd:ied,jsd:jed)) ; itide%TKE_itidal_input(:,:) = 0.0 - allocate(itide%tideamp(isd:ied,jsd:jed)) ; itide%tideamp(:,:) = utide - allocate(CS%TKE_itidal_coef(isd:ied,jsd:jed)) ; CS%TKE_itidal_coef(:,:) = 0.0 + allocate(itide%Nb(isd:ied,jsd:jed), source=0.0) + allocate(itide%h2(isd:ied,jsd:jed), source=0.0) + allocate(itide%TKE_itidal_input(isd:ied,jsd:jed), source=0.0) + allocate(itide%tideamp(isd:ied,jsd:jed), source=utide) + allocate(CS%TKE_itidal_coef(isd:ied,jsd:jed), source=0.0) call get_param(param_file, mdl, "KAPPA_ITIDES", kappa_itides, & "A topographic wavenumber used with INT_TIDE_DISSIPATION. "//& diff --git a/src/parameterizations/vertical/MOM_opacity.F90 b/src/parameterizations/vertical/MOM_opacity.F90 index 0b6a3cf76c..51c67504d4 100644 --- a/src/parameterizations/vertical/MOM_opacity.F90 +++ b/src/parameterizations/vertical/MOM_opacity.F90 @@ -1097,7 +1097,7 @@ subroutine opacity_init(Time, G, GV, US, param_file, diag, CS, optics) allocate(optics%opacity_band(optics%nbands,isd:ied,jsd:jed,nz)) if (.not.associated(optics%sw_pen_band)) & allocate(optics%sw_pen_band(optics%nbands,isd:ied,jsd:jed)) - allocate(CS%id_opacity(optics%nbands)) ; CS%id_opacity(:) = -1 + allocate(CS%id_opacity(optics%nbands), source=-1) CS%id_sw_pen = register_diag_field('ocean_model', 'SW_pen', diag%axesT1, Time, & 'Penetrating shortwave radiation flux into ocean', 'W m-2', conversion=US%QRZ_T_to_W_m2) diff --git a/src/parameterizations/vertical/MOM_set_diffusivity.F90 b/src/parameterizations/vertical/MOM_set_diffusivity.F90 index 0d07f0fea4..4ce947e817 100644 --- a/src/parameterizations/vertical/MOM_set_diffusivity.F90 +++ b/src/parameterizations/vertical/MOM_set_diffusivity.F90 @@ -309,40 +309,20 @@ subroutine set_diffusivity(u, v, h, u_h, v_h, tv, fluxes, optics, visc, dt, & ! Set up arrays for diagnostics. - if (CS%id_N2 > 0) then - allocate(dd%N2_3d(isd:ied,jsd:jed,nz+1)) ; dd%N2_3d(:,:,:) = 0.0 - endif - if (CS%id_Kd_user > 0) then - allocate(dd%Kd_user(isd:ied,jsd:jed,nz+1)) ; dd%Kd_user(:,:,:) = 0.0 - endif - if (CS%id_Kd_work > 0) then - allocate(dd%Kd_work(isd:ied,jsd:jed,nz)) ; dd%Kd_work(:,:,:) = 0.0 - endif - if (CS%id_maxTKE > 0) then - allocate(dd%maxTKE(isd:ied,jsd:jed,nz)) ; dd%maxTKE(:,:,:) = 0.0 - endif - if (CS%id_TKE_to_Kd > 0) then - allocate(dd%TKE_to_Kd(isd:ied,jsd:jed,nz)) ; dd%TKE_to_Kd(:,:,:) = 0.0 - endif - if ((CS%double_diffusion) .and. (CS%id_KT_extra > 0)) then - allocate(dd%KT_extra(isd:ied,jsd:jed,nz+1)) ; dd%KT_extra(:,:,:) = 0.0 - endif - if ((CS%double_diffusion) .and. (CS%id_KS_extra > 0)) then - allocate(dd%KS_extra(isd:ied,jsd:jed,nz+1)) ; dd%KS_extra(:,:,:) = 0.0 - endif - if (CS%id_R_rho > 0) then - allocate(dd%drho_rat(isd:ied,jsd:jed,nz+1)) ; dd%drho_rat(:,:,:) = 0.0 - endif - if (CS%id_Kd_BBL > 0) then - allocate(dd%Kd_BBL(isd:ied,jsd:jed,nz+1)) ; dd%Kd_BBL(:,:,:) = 0.0 - endif - - if (CS%id_Kd_bkgnd > 0) then - allocate(dd%Kd_bkgnd(isd:ied,jsd:jed,nz+1)) ; dd%Kd_bkgnd(:,:,:) = 0. - endif - if (CS%id_Kv_bkgnd > 0) then - allocate(dd%Kv_bkgnd(isd:ied,jsd:jed,nz+1)) ; dd%Kv_bkgnd(:,:,:) = 0. - endif + if (CS%id_N2 > 0) allocate(dd%N2_3d(isd:ied,jsd:jed,nz+1), source=0.0) + if (CS%id_Kd_user > 0) allocate(dd%Kd_user(isd:ied,jsd:jed,nz+1), source=0.0) + if (CS%id_Kd_work > 0) allocate(dd%Kd_work(isd:ied,jsd:jed,nz), source=0.0) + if (CS%id_maxTKE > 0) allocate(dd%maxTKE(isd:ied,jsd:jed,nz), source=0.0) + if (CS%id_TKE_to_Kd > 0) allocate(dd%TKE_to_Kd(isd:ied,jsd:jed,nz), source=0.0) + if ((CS%double_diffusion) .and. (CS%id_KT_extra > 0)) & + allocate(dd%KT_extra(isd:ied,jsd:jed,nz+1), source=0.0) + if ((CS%double_diffusion) .and. (CS%id_KS_extra > 0)) & + allocate(dd%KS_extra(isd:ied,jsd:jed,nz+1), source=0.0) + if (CS%id_R_rho > 0) allocate(dd%drho_rat(isd:ied,jsd:jed,nz+1), source=0.0) + if (CS%id_Kd_BBL > 0) allocate(dd%Kd_BBL(isd:ied,jsd:jed,nz+1), source=0.0) + + if (CS%id_Kd_bkgnd > 0) allocate(dd%Kd_bkgnd(isd:ied,jsd:jed,nz+1), source=0.) + if (CS%id_Kv_bkgnd > 0) allocate(dd%Kv_bkgnd(isd:ied,jsd:jed,nz+1), source=0.) ! set up arrays for tidal mixing diagnostics if (CS%use_tidal_mixing) & diff --git a/src/parameterizations/vertical/MOM_set_viscosity.F90 b/src/parameterizations/vertical/MOM_set_viscosity.F90 index 138ba9c79f..9770325d85 100644 --- a/src/parameterizations/vertical/MOM_set_viscosity.F90 +++ b/src/parameterizations/vertical/MOM_set_viscosity.F90 @@ -2145,12 +2145,12 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS endif if (CS%bottomdraglaw) then - allocate(visc%bbl_thick_u(IsdB:IedB,jsd:jed)) ; visc%bbl_thick_u(:,:) = 0.0 - allocate(visc%kv_bbl_u(IsdB:IedB,jsd:jed)) ; visc%kv_bbl_u(:,:) = 0.0 - allocate(visc%bbl_thick_v(isd:ied,JsdB:JedB)) ; visc%bbl_thick_v(:,:) = 0.0 - allocate(visc%kv_bbl_v(isd:ied,JsdB:JedB)) ; visc%kv_bbl_v(:,:) = 0.0 - allocate(visc%ustar_bbl(isd:ied,jsd:jed)) ; visc%ustar_bbl(:,:) = 0.0 - allocate(visc%TKE_bbl(isd:ied,jsd:jed)) ; visc%TKE_bbl(:,:) = 0.0 + allocate(visc%bbl_thick_u(IsdB:IedB,jsd:jed), source=0.0) + allocate(visc%kv_bbl_u(IsdB:IedB,jsd:jed), source=0.0) + allocate(visc%bbl_thick_v(isd:ied,JsdB:JedB), source=0.0) + allocate(visc%kv_bbl_v(isd:ied,JsdB:JedB), source=0.0) + allocate(visc%ustar_bbl(isd:ied,jsd:jed), source=0.0) + allocate(visc%TKE_bbl(isd:ied,jsd:jed), source=0.0) CS%id_bbl_thick_u = register_diag_field('ocean_model', 'bbl_thick_u', & diag%axesCu1, Time, 'BBL thickness at u points', 'm', conversion=US%Z_to_m) @@ -2159,7 +2159,7 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS CS%id_bbl_u = register_diag_field('ocean_model', 'bbl_u', diag%axesCu1, & Time, 'BBL mean u current', 'm s-1', conversion=US%L_T_to_m_s) if (CS%id_bbl_u>0) then - allocate(CS%bbl_u(IsdB:IedB,jsd:jed)) ; CS%bbl_u(:,:) = 0.0 + allocate(CS%bbl_u(IsdB:IedB,jsd:jed), source=0.0) endif CS%id_bbl_thick_v = register_diag_field('ocean_model', 'bbl_thick_v', & diag%axesCv1, Time, 'BBL thickness at v points', 'm', conversion=US%Z_to_m) @@ -2168,10 +2168,10 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS CS%id_bbl_v = register_diag_field('ocean_model', 'bbl_v', diag%axesCv1, & Time, 'BBL mean v current', 'm s-1', conversion=US%L_T_to_m_s) if (CS%id_bbl_v>0) then - allocate(CS%bbl_v(isd:ied,JsdB:JedB)) ; CS%bbl_v(:,:) = 0.0 + allocate(CS%bbl_v(isd:ied,JsdB:JedB), source=0.0) endif if (CS%BBL_use_tidal_bg) then - allocate(CS%tideamp(isd:ied,jsd:jed)) ; CS%tideamp(:,:) = 0.0 + allocate(CS%tideamp(isd:ied,jsd:jed), source=0.0) filename = trim(CS%inputdir) // trim(tideamp_file) call log_param(param_file, mdl, "INPUTDIR/TIDEAMP_FILE", filename) call MOM_read_data(filename, 'tideamp', CS%tideamp, G%domain, scale=US%m_to_Z*US%T_to_s) @@ -2179,8 +2179,8 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS endif endif if (CS%Channel_drag) then - allocate(visc%Ray_u(IsdB:IedB,jsd:jed,nz)) ; visc%Ray_u(:,:,:) = 0.0 - allocate(visc%Ray_v(isd:ied,JsdB:JedB,nz)) ; visc%Ray_v(:,:,:) = 0.0 + allocate(visc%Ray_u(IsdB:IedB,jsd:jed,nz), source=0.0) + allocate(visc%Ray_v(isd:ied,JsdB:JedB,nz), source=0.0) CS%id_Ray_u = register_diag_field('ocean_model', 'Rayleigh_u', diag%axesCuL, & Time, 'Rayleigh drag velocity at u points', 'm s-1', conversion=US%Z_to_m*US%s_to_T) CS%id_Ray_v = register_diag_field('ocean_model', 'Rayleigh_v', diag%axesCvL, & @@ -2189,8 +2189,8 @@ subroutine set_visc_init(Time, G, GV, US, param_file, diag, visc, CS, restart_CS if (CS%dynamic_viscous_ML) then - allocate(visc%nkml_visc_u(IsdB:IedB,jsd:jed)) ; visc%nkml_visc_u(:,:) = 0.0 - allocate(visc%nkml_visc_v(isd:ied,JsdB:JedB)) ; visc%nkml_visc_v(:,:) = 0.0 + allocate(visc%nkml_visc_u(IsdB:IedB,jsd:jed), source=0.0) + allocate(visc%nkml_visc_v(isd:ied,JsdB:JedB), source=0.0) CS%id_nkml_visc_u = register_diag_field('ocean_model', 'nkml_visc_u', & diag%axesCu1, Time, 'Number of layers in viscous mixed layer at u points', 'm') CS%id_nkml_visc_v = register_diag_field('ocean_model', 'nkml_visc_v', & diff --git a/src/parameterizations/vertical/MOM_sponge.F90 b/src/parameterizations/vertical/MOM_sponge.F90 index ebb9575974..2699e57099 100644 --- a/src/parameterizations/vertical/MOM_sponge.F90 +++ b/src/parameterizations/vertical/MOM_sponge.F90 @@ -147,9 +147,9 @@ subroutine initialize_sponge(Iresttime, int_height, G, param_file, CS, GV, & if (CS%num_col > 0) then - allocate(CS%Iresttime_col(CS%num_col)) ; CS%Iresttime_col = 0.0 - allocate(CS%col_i(CS%num_col)) ; CS%col_i = 0 - allocate(CS%col_j(CS%num_col)) ; CS%col_j = 0 + allocate(CS%Iresttime_col(CS%num_col), source=0.0) + allocate(CS%col_i(CS%num_col), source=0) + allocate(CS%col_j(CS%num_col), source=0) col = 1 do j=G%jsc,G%jec ; do i=G%isc,G%iec @@ -168,8 +168,8 @@ subroutine initialize_sponge(Iresttime, int_height, G, param_file, CS, GV, & endif if (CS%do_i_mean_sponge) then - allocate(CS%Iresttime_im(G%jsd:G%jed)) ; CS%Iresttime_im(:) = 0.0 - allocate(CS%Ref_eta_im(G%jsd:G%jed,GV%ke+1)) ; CS%Ref_eta_im(:,:) = 0.0 + allocate(CS%Iresttime_im(G%jsd:G%jed), source=0.0) + allocate(CS%Ref_eta_im(G%jsd:G%jed,GV%ke+1), source=0.0) do j=G%jsc,G%jec CS%Iresttime_im(j) = Iresttime_i_mean(j) @@ -238,8 +238,7 @@ subroutine set_up_sponge_field(sp_val, f_ptr, G, GV, nlay, CS, sp_val_i_mean) call MOM_error(FATAL,"set_up_sponge_field: "//mesg) endif - allocate(CS%Ref_val(CS%fldno)%p(CS%nz,CS%num_col)) - CS%Ref_val(CS%fldno)%p(:,:) = 0.0 + allocate(CS%Ref_val(CS%fldno)%p(CS%nz,CS%num_col), source=0.0) do col=1,CS%num_col do k=1,nlay CS%Ref_val(CS%fldno)%p(k,col) = sp_val(CS%col_i(col),CS%col_j(col),k) @@ -262,8 +261,7 @@ subroutine set_up_sponge_field(sp_val, f_ptr, G, GV, nlay, CS, sp_val_i_mean) if (.not.present(sp_val_i_mean)) call MOM_error(FATAL, & "set_up_sponge_field: sp_val_i_mean must be present with i-mean sponges.") - allocate(CS%Ref_val_im(CS%fldno)%p(CS%jsd:CS%jed,CS%nz)) - CS%Ref_val(CS%fldno)%p(:,:) = 0.0 + allocate(CS%Ref_val_im(CS%fldno)%p(CS%jsd:CS%jed,CS%nz), source=0.0) do k=1,CS%nz ; do j=CS%jsc,CS%jec CS%Ref_val_im(CS%fldno)%p(j,k) = sp_val_i_mean(j,k) enddo ; enddo @@ -302,7 +300,7 @@ subroutine set_up_sponge_ML_density(sp_val, G, CS, sp_val_i_mean) endif CS%bulkmixedlayer = .true. - allocate(CS%Rcv_ml_ref(CS%num_col)) ; CS%Rcv_ml_ref(:) = 0.0 + allocate(CS%Rcv_ml_ref(CS%num_col), source=0.0) do col=1,CS%num_col CS%Rcv_ml_ref(col) = sp_val(CS%col_i(col),CS%col_j(col)) enddo @@ -311,7 +309,7 @@ subroutine set_up_sponge_ML_density(sp_val, G, CS, sp_val_i_mean) if (.not.present(sp_val_i_mean)) call MOM_error(FATAL, & "set_up_sponge_field: sp_val_i_mean must be present with i-mean sponges.") - allocate(CS%Rcv_ml_ref_im(CS%jsd:CS%jed)) ; CS%Rcv_ml_ref_im(:) = 0.0 + allocate(CS%Rcv_ml_ref_im(CS%jsd:CS%jed), source=0.0) do j=CS%jsc,CS%jec CS%Rcv_ml_ref_im(j) = sp_val_i_mean(j) enddo diff --git a/src/parameterizations/vertical/MOM_tidal_mixing.F90 b/src/parameterizations/vertical/MOM_tidal_mixing.F90 index 797ceb9a35..3b26d60451 100644 --- a/src/parameterizations/vertical/MOM_tidal_mixing.F90 +++ b/src/parameterizations/vertical/MOM_tidal_mixing.F90 @@ -1426,76 +1426,46 @@ subroutine setup_tidal_diagnostics(G, GV, CS) isd = G%isd; ied = G%ied; jsd = G%jsd; jed = G%jed; nz = GV%ke dd => CS%dd - if ((CS%id_Kd_itidal > 0) .or. (CS%id_Kd_Itidal_work > 0)) then - allocate(dd%Kd_itidal(isd:ied,jsd:jed,nz+1)) ; dd%Kd_itidal(:,:,:) = 0.0 - endif - if ((CS%id_Kd_lowmode > 0) .or. (CS%id_Kd_lowmode_work > 0)) then - allocate(dd%Kd_lowmode(isd:ied,jsd:jed,nz+1)) ; dd%Kd_lowmode(:,:,:) = 0.0 - endif - if ( (CS%id_Fl_itidal > 0) ) then - allocate(dd%Fl_itidal(isd:ied,jsd:jed,nz+1)) ; dd%Fl_itidal(:,:,:) = 0.0 - endif - if ( (CS%id_Fl_lowmode > 0) ) then - allocate(dd%Fl_lowmode(isd:ied,jsd:jed,nz+1)) ; dd%Fl_lowmode(:,:,:) = 0.0 - endif - if ( (CS%id_Polzin_decay_scale > 0) ) then - allocate(dd%Polzin_decay_scale(isd:ied,jsd:jed)) - dd%Polzin_decay_scale(:,:) = 0.0 - endif - if ( (CS%id_N2_bot > 0) ) then - allocate(dd%N2_bot(isd:ied,jsd:jed)) ; dd%N2_bot(:,:) = 0.0 - endif - if ( (CS%id_N2_meanz > 0) ) then - allocate(dd%N2_meanz(isd:ied,jsd:jed)) ; dd%N2_meanz(:,:) = 0.0 - endif - if ( (CS%id_Polzin_decay_scale_scaled > 0) ) then - allocate(dd%Polzin_decay_scale_scaled(isd:ied,jsd:jed)) - dd%Polzin_decay_scale_scaled(:,:) = 0.0 - endif - if ((CS%id_Kd_Niku > 0) .or. (CS%id_Kd_Niku_work > 0)) then - allocate(dd%Kd_Niku(isd:ied,jsd:jed,nz+1)) ; dd%Kd_Niku(:,:,:) = 0.0 - endif - if (CS%id_Kd_Niku_work > 0) then - allocate(dd%Kd_Niku_work(isd:ied,jsd:jed,nz)) ; dd%Kd_Niku_work(:,:,:) = 0.0 - endif - if (CS%id_Kd_Itidal_work > 0) then - allocate(dd%Kd_Itidal_work(isd:ied,jsd:jed,nz)) - dd%Kd_Itidal_work(:,:,:) = 0.0 - endif - if (CS%id_Kd_Lowmode_Work > 0) then - allocate(dd%Kd_Lowmode_Work(isd:ied,jsd:jed,nz)) - dd%Kd_Lowmode_Work(:,:,:) = 0.0 - endif - if (CS%id_TKE_itidal > 0) then - allocate(dd%TKE_Itidal_used(isd:ied,jsd:jed)) ; dd%TKE_Itidal_used(:,:) = 0. - endif + if ((CS%id_Kd_itidal > 0) .or. (CS%id_Kd_Itidal_work > 0)) & + allocate(dd%Kd_itidal(isd:ied,jsd:jed,nz+1), source=0.0) + if ((CS%id_Kd_lowmode > 0) .or. (CS%id_Kd_lowmode_work > 0)) & + allocate(dd%Kd_lowmode(isd:ied,jsd:jed,nz+1), source=0.0) + if (CS%id_Fl_itidal > 0) allocate(dd%Fl_itidal(isd:ied,jsd:jed,nz+1), source=0.0) + if (CS%id_Fl_lowmode > 0) allocate(dd%Fl_lowmode(isd:ied,jsd:jed,nz+1), source=0.0) + if (CS%id_Polzin_decay_scale > 0) allocate(dd%Polzin_decay_scale(isd:ied,jsd:jed), source=0.0) + if (CS%id_N2_bot > 0) allocate(dd%N2_bot(isd:ied,jsd:jed), source=0.0) + if (CS%id_N2_meanz > 0) allocate(dd%N2_meanz(isd:ied,jsd:jed), source=0.0) + if (CS%id_Polzin_decay_scale_scaled > 0) & + allocate(dd%Polzin_decay_scale_scaled(isd:ied,jsd:jed), source=0.0) + if ((CS%id_Kd_Niku > 0) .or. (CS%id_Kd_Niku_work > 0)) & + allocate(dd%Kd_Niku(isd:ied,jsd:jed,nz+1), source=0.0) + if (CS%id_Kd_Niku_work > 0) allocate(dd%Kd_Niku_work(isd:ied,jsd:jed,nz), source=0.0) + if (CS%id_Kd_Itidal_work > 0) allocate(dd%Kd_Itidal_work(isd:ied,jsd:jed,nz), source=0.0) + if (CS%id_Kd_Lowmode_Work > 0) allocate(dd%Kd_Lowmode_Work(isd:ied,jsd:jed,nz), source=0.0) + if (CS%id_TKE_itidal > 0) allocate(dd%TKE_Itidal_used(isd:ied,jsd:jed), source=0.) ! additional diags for CVMix - if (CS%id_N2_int > 0) then - allocate(dd%N2_int(isd:ied,jsd:jed,nz+1)) ; dd%N2_int(:,:,:) = 0.0 - endif + if (CS%id_N2_int > 0) allocate(dd%N2_int(isd:ied,jsd:jed,nz+1), source=0.0) if (CS%id_Simmons_coeff > 0) then if (CS%CVMix_tidal_scheme .ne. SIMMONS) then call MOM_error(FATAL, "setup_tidal_diagnostics: Simmons_coeff diagnostics is available "//& "only when CVMix_tidal_scheme is Simmons") endif - allocate(dd%Simmons_coeff_2d(isd:ied,jsd:jed)) ; dd%Simmons_coeff_2d(:,:) = 0.0 - endif - if (CS%id_vert_dep > 0) then - allocate(dd%vert_dep_3d(isd:ied,jsd:jed,nz+1)) ; dd%vert_dep_3d(:,:,:) = 0.0 + allocate(dd%Simmons_coeff_2d(isd:ied,jsd:jed), source=0.0) endif + if (CS%id_vert_dep > 0) allocate(dd%vert_dep_3d(isd:ied,jsd:jed,nz+1), source=0.0) if (CS%id_Schmittner_coeff > 0) then if (CS%CVMix_tidal_scheme .ne. SCHMITTNER) then call MOM_error(FATAL, "setup_tidal_diagnostics: Schmittner_coeff diagnostics is available "//& "only when CVMix_tidal_scheme is Schmittner.") endif - allocate(dd%Schmittner_coeff_3d(isd:ied,jsd:jed,nz)) ; dd%Schmittner_coeff_3d(:,:,:) = 0.0 + allocate(dd%Schmittner_coeff_3d(isd:ied,jsd:jed,nz), source=0.0) endif if (CS%id_tidal_qe_md > 0) then if (CS%CVMix_tidal_scheme .ne. SCHMITTNER) then call MOM_error(FATAL, "setup_tidal_diagnostics: tidal_qe_md diagnostics is available "//& "only when CVMix_tidal_scheme is Schmittner.") endif - allocate(dd%tidal_qe_md(isd:ied,jsd:jed,nz)) ; dd%tidal_qe_md(:,:,:) = 0.0 + allocate(dd%tidal_qe_md(isd:ied,jsd:jed,nz), source=0.0) endif end subroutine setup_tidal_diagnostics diff --git a/src/parameterizations/vertical/MOM_vert_friction.F90 b/src/parameterizations/vertical/MOM_vert_friction.F90 index 1d46f9aee3..f9512d8c06 100644 --- a/src/parameterizations/vertical/MOM_vert_friction.F90 +++ b/src/parameterizations/vertical/MOM_vert_friction.F90 @@ -532,8 +532,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & ! call post_data(CS%id_hf_dv_dt_visc, CS%hf_dv_dt_visc, CS%diag) !endif if (CS%id_hf_du_dt_visc_2d > 0) then - allocate(hf_du_dt_visc_2d(G%IsdB:G%IedB,G%jsd:G%jed)) - hf_du_dt_visc_2d(:,:) = 0.0 + allocate(hf_du_dt_visc_2d(G%IsdB:G%IedB,G%jsd:G%jed), source=0.0) do k=1,nz ; do j=js,je ; do I=Isq,Ieq hf_du_dt_visc_2d(I,j) = hf_du_dt_visc_2d(I,j) + ADp%du_dt_visc(I,j,k) * ADp%diag_hfrac_u(I,j,k) enddo ; enddo ; enddo @@ -541,8 +540,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & deallocate(hf_du_dt_visc_2d) endif if (CS%id_hf_dv_dt_visc_2d > 0) then - allocate(hf_dv_dt_visc_2d(G%isd:G%ied,G%JsdB:G%JedB)) - hf_dv_dt_visc_2d(:,:) = 0.0 + allocate(hf_dv_dt_visc_2d(G%isd:G%ied,G%JsdB:G%JedB), source=0.0) do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie hf_dv_dt_visc_2d(i,J) = hf_dv_dt_visc_2d(i,J) + ADp%dv_dt_visc(i,J,k) * ADp%diag_hfrac_v(i,J,k) enddo ; enddo ; enddo @@ -551,8 +549,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & endif if (CS%id_h_du_dt_visc > 0) then - allocate(h_du_dt_visc(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) - h_du_dt_visc(:,:,:) = 0.0 + allocate(h_du_dt_visc(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) do k=1,nz ; do j=js,je ; do I=Isq,Ieq h_du_dt_visc(I,j,k) = ADp%du_dt_visc(I,j,k) * ADp%diag_hu(I,j,k) enddo ; enddo ; enddo @@ -560,8 +557,7 @@ subroutine vertvisc(u, v, h, forces, visc, dt, OBC, ADp, CDp, G, GV, US, CS, & deallocate(h_du_dt_visc) endif if (CS%id_h_dv_dt_visc > 0) then - allocate(h_dv_dt_visc(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) - h_dv_dt_visc(:,:,:) = 0.0 + allocate(h_dv_dt_visc(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) do k=1,nz ; do J=Jsq,Jeq ; do i=is,ie h_dv_dt_visc(i,J,k) = ADp%dv_dt_visc(i,J,k) * ADp%diag_hv(i,J,k) enddo ; enddo ; enddo @@ -765,28 +761,20 @@ subroutine vertvisc_coef(u, v, h, forces, visc, dt, G, GV, US, CS, OBC) I_Hbbl(:) = 1.0 / (CS%Hbbl + h_neglect) I_valBL = 0.0 ; if (CS%harm_BL_val > 0.0) I_valBL = 1.0 / CS%harm_BL_val - if (CS%id_Kv_u > 0) then - allocate(Kv_u(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke)) ; Kv_u(:,:,:) = 0.0 - endif + if (CS%id_Kv_u > 0) allocate(Kv_u(G%IsdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) - if (CS%id_Kv_v > 0) then - allocate(Kv_v(G%isd:G%ied,G%JsdB:G%JedB,GV%ke)) ; Kv_v(:,:,:) = 0.0 - endif + if (CS%id_Kv_v > 0) allocate(Kv_v(G%isd:G%ied,G%JsdB:G%JedB,GV%ke), source=0.0) - if (CS%debug .or. (CS%id_hML_u > 0)) then - allocate(hML_u(G%IsdB:G%IedB,G%jsd:G%jed)) ; hML_u(:,:) = 0.0 - endif - if (CS%debug .or. (CS%id_hML_v > 0)) then - allocate(hML_v(G%isd:G%ied,G%JsdB:G%JedB)) ; hML_v(:,:) = 0.0 - endif + if (CS%debug .or. (CS%id_hML_u > 0)) allocate(hML_u(G%IsdB:G%IedB,G%jsd:G%jed), source=0.0) + if (CS%debug .or. (CS%id_hML_v > 0)) allocate(hML_v(G%isd:G%ied,G%JsdB:G%JedB), source=0.0) if ((associated(visc%taux_shelf) .or. associated(forces%frac_shelf_u)) .and. & .not.associated(CS%a1_shelf_u)) then - allocate(CS%a1_shelf_u(G%IsdB:G%IedB,G%jsd:G%jed)) ; CS%a1_shelf_u(:,:)=0.0 + allocate(CS%a1_shelf_u(G%IsdB:G%IedB,G%jsd:G%jed), source=0.0) endif if ((associated(visc%tauy_shelf) .or. associated(forces%frac_shelf_v)) .and. & .not.associated(CS%a1_shelf_v)) then - allocate(CS%a1_shelf_v(G%isd:G%ied,G%JsdB:G%JedB)) ; CS%a1_shelf_v(:,:)=0.0 + allocate(CS%a1_shelf_v(G%isd:G%ied,G%JsdB:G%JedB), source=0.0) endif !$OMP parallel do default(private) shared(G,GV,US,CS,visc,Isq,Ieq,nz,u,h,forces,hML_u, & diff --git a/src/tracer/DOME_tracer.F90 b/src/tracer/DOME_tracer.F90 index 44421c7387..62181fe9ea 100644 --- a/src/tracer/DOME_tracer.F90 +++ b/src/tracer/DOME_tracer.F90 @@ -105,7 +105,7 @@ function register_DOME_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) "The exact location and properties of those sponges are "//& "specified from MOM_initialization.F90.", default=.false.) - allocate(CS%tr(isd:ied,jsd:jed,nz,NTR)) ; CS%tr(:,:,:,:) = 0.0 + allocate(CS%tr(isd:ied,jsd:jed,nz,NTR), source=0.0) do m=1,NTR if (m < 10) then ; write(name,'("tr_D",I1.1)') m diff --git a/src/tracer/ISOMIP_tracer.F90 b/src/tracer/ISOMIP_tracer.F90 index 0e31282e9c..144b21e29a 100644 --- a/src/tracer/ISOMIP_tracer.F90 +++ b/src/tracer/ISOMIP_tracer.F90 @@ -110,7 +110,7 @@ function register_ISOMIP_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) "The exact location and properties of those sponges are "//& "specified from MOM_initialization.F90.", default=.false.) - allocate(CS%tr(isd:ied,jsd:jed,nz,NTR)) ; CS%tr(:,:,:,:) = 0.0 + allocate(CS%tr(isd:ied,jsd:jed,nz,NTR), source=0.0) do m=1,NTR if (m < 10) then ; write(name,'("tr_D",I1.1)') m diff --git a/src/tracer/MOM_CFC_cap.F90 b/src/tracer/MOM_CFC_cap.F90 index e1770b0d52..187ce13b60 100644 --- a/src/tracer/MOM_CFC_cap.F90 +++ b/src/tracer/MOM_CFC_cap.F90 @@ -151,8 +151,8 @@ function register_CFC_cap(HI, GV, param_file, CS, tr_Reg, restart_CS) CS%CFC11_desc = var_desc(CS%CFC11_name,"mol kg-1","Moles Per Unit Mass of CFC-11 in sea water", caller=mdl) CS%CFC12_desc = var_desc(CS%CFC12_name,"mol kg-1","Moles Per Unit Mass of CFC-12 in sea water", caller=mdl) - allocate(CS%CFC11(isd:ied,jsd:jed,nz)) ; CS%CFC11(:,:,:) = 0.0 - allocate(CS%CFC12(isd:ied,jsd:jed,nz)) ; CS%CFC12(:,:,:) = 0.0 + allocate(CS%CFC11(isd:ied,jsd:jed,nz), source=0.0) + allocate(CS%CFC12(isd:ied,jsd:jed,nz), source=0.0) ! This pointer assignment is needed to force the compiler not to do a copy in ! the registration calls. Curses on the designers and implementers of F90. diff --git a/src/tracer/MOM_OCMIP2_CFC.F90 b/src/tracer/MOM_OCMIP2_CFC.F90 index a1039fd1b7..43a1d7d174 100644 --- a/src/tracer/MOM_OCMIP2_CFC.F90 +++ b/src/tracer/MOM_OCMIP2_CFC.F90 @@ -163,8 +163,8 @@ function register_OCMIP2_CFC(HI, GV, param_file, CS, tr_Reg, restart_CS) if (GV%Boussinesq) then ; flux_units = "mol s-1" else ; flux_units = "mol m-3 kg s-1" ; endif - allocate(CS%CFC11(isd:ied,jsd:jed,nz)) ; CS%CFC11(:,:,:) = 0.0 - allocate(CS%CFC12(isd:ied,jsd:jed,nz)) ; CS%CFC12(:,:,:) = 0.0 + allocate(CS%CFC11(isd:ied,jsd:jed,nz), source=0.0) + allocate(CS%CFC12(isd:ied,jsd:jed,nz), source=0.0) ! This pointer assignment is needed to force the compiler not to do a copy in ! the registration calls. Curses on the designers and implementers of F90. diff --git a/src/tracer/MOM_lateral_boundary_diffusion.F90 b/src/tracer/MOM_lateral_boundary_diffusion.F90 index 8f022821ea..dc6a121df1 100644 --- a/src/tracer/MOM_lateral_boundary_diffusion.F90 +++ b/src/tracer/MOM_lateral_boundary_diffusion.F90 @@ -626,9 +626,9 @@ subroutine fluxes_layer_method(boundary, ke, hbl_L, hbl_R, h_L, h_R, phi_L, phi_ nk = SIZE(dz_top) ! allocate arrays - allocate(phi_L_z(nk)); phi_L_z(:) = 0.0 - allocate(phi_R_z(nk)); phi_R_z(:) = 0.0 - allocate(F_layer_z(nk)); F_layer_z(:) = 0.0 + allocate(phi_L_z(nk), source=0.0) + allocate(phi_R_z(nk), source=0.0) + allocate(F_layer_z(nk), source=0.0) ! remap tracer to dz_top call remapping_core_h(CS%remap_cs, ke, h_L(:), phi_L(:), nk, dz_top(:), phi_L_z(:)) diff --git a/src/tracer/MOM_neutral_diffusion.F90 b/src/tracer/MOM_neutral_diffusion.F90 index 03b89be1a4..4851bec9c1 100644 --- a/src/tracer/MOM_neutral_diffusion.F90 +++ b/src/tracer/MOM_neutral_diffusion.F90 @@ -250,24 +250,24 @@ logical function neutral_diffusion_init(Time, G, GV, US, param_file, diag, EOS, ! call closeParameterBlock(param_file) if (CS%continuous_reconstruction) then CS%nsurf = 2*GV%ke+2 ! Continuous reconstruction means that every interface has two connections - allocate(CS%dRdT(SZI_(G),SZJ_(G),SZK_(GV)+1)) ; CS%dRdT(:,:,:) = 0. - allocate(CS%dRdS(SZI_(G),SZJ_(G),SZK_(GV)+1)) ; CS%dRdS(:,:,:) = 0. + allocate(CS%dRdT(SZI_(G),SZJ_(G),SZK_(GV)+1), source=0.) + allocate(CS%dRdS(SZI_(G),SZJ_(G),SZK_(GV)+1), source=0.) else CS%nsurf = 4*GV%ke ! Discontinuous means that every interface has four connections - allocate(CS%T_i(SZI_(G),SZJ_(G),SZK_(GV),2)) ; CS%T_i(:,:,:,:) = 0. - allocate(CS%S_i(SZI_(G),SZJ_(G),SZK_(GV),2)) ; CS%S_i(:,:,:,:) = 0. - allocate(CS%P_i(SZI_(G),SZJ_(G),SZK_(GV),2)) ; CS%P_i(:,:,:,:) = 0. - allocate(CS%dRdT_i(SZI_(G),SZJ_(G),SZK_(GV),2)) ; CS%dRdT_i(:,:,:,:) = 0. - allocate(CS%dRdS_i(SZI_(G),SZJ_(G),SZK_(GV),2)) ; CS%dRdS_i(:,:,:,:) = 0. - allocate(CS%ppoly_coeffs_T(SZI_(G),SZJ_(G),SZK_(GV),CS%deg+1)) ; CS%ppoly_coeffs_T(:,:,:,:) = 0. - allocate(CS%ppoly_coeffs_S(SZI_(G),SZJ_(G),SZK_(GV),CS%deg+1)) ; CS%ppoly_coeffs_S(:,:,:,:) = 0. - allocate(CS%ns(SZI_(G),SZJ_(G))) ; CS%ns(:,:) = 0. + allocate(CS%T_i(SZI_(G),SZJ_(G),SZK_(GV),2), source=0.) + allocate(CS%S_i(SZI_(G),SZJ_(G),SZK_(GV),2), source=0.) + allocate(CS%P_i(SZI_(G),SZJ_(G),SZK_(GV),2), source=0.) + allocate(CS%dRdT_i(SZI_(G),SZJ_(G),SZK_(GV),2), source=0.) + allocate(CS%dRdS_i(SZI_(G),SZJ_(G),SZK_(GV),2), source=0.) + allocate(CS%ppoly_coeffs_T(SZI_(G),SZJ_(G),SZK_(GV),CS%deg+1), source=0.) + allocate(CS%ppoly_coeffs_S(SZI_(G),SZJ_(G),SZK_(GV),CS%deg+1), source=0.) + allocate(CS%ns(SZI_(G),SZJ_(G)), source=0) endif ! T-points - allocate(CS%Tint(SZI_(G),SZJ_(G),SZK_(GV)+1)) ; CS%Tint(:,:,:) = 0. - allocate(CS%Sint(SZI_(G),SZJ_(G),SZK_(GV)+1)) ; CS%Sint(:,:,:) = 0. - allocate(CS%Pint(SZI_(G),SZJ_(G),SZK_(GV)+1)) ; CS%Pint(:,:,:) = 0. - allocate(CS%stable_cell(SZI_(G),SZJ_(G),SZK_(GV))) ; CS%stable_cell(:,:,:) = .true. + allocate(CS%Tint(SZI_(G),SZJ_(G),SZK_(GV)+1), source=0.) + allocate(CS%Sint(SZI_(G),SZJ_(G),SZK_(GV)+1), source=0.) + allocate(CS%Pint(SZI_(G),SZJ_(G),SZK_(GV)+1), source=0.) + allocate(CS%stable_cell(SZI_(G),SZJ_(G),SZK_(GV)), source=.true.) ! U-points allocate(CS%uPoL(G%isd:G%ied,G%jsd:G%jed, CS%nsurf)); CS%uPoL(G%isc-1:G%iec,G%jsc:G%jec,:) = 0. allocate(CS%uPoR(G%isd:G%ied,G%jsd:G%jed, CS%nsurf)); CS%uPoR(G%isc-1:G%iec,G%jsc:G%jec,:) = 0. diff --git a/src/tracer/MOM_offline_aux.F90 b/src/tracer/MOM_offline_aux.F90 index 59e63a5ddd..9486e87369 100644 --- a/src/tracer/MOM_offline_aux.F90 +++ b/src/tracer/MOM_offline_aux.F90 @@ -696,14 +696,10 @@ subroutine update_offline_from_files(G, GV, nk_input, mean_file, sum_file, snap_ ! This block makes sure that the fluxes control structure, which may not be used in the solo_driver, ! contains netMassIn and netMassOut which is necessary for the applyTracerBoundaryFluxesInOut routine if (do_ale) then - if (.not. associated(fluxes%netMassOut)) then - allocate(fluxes%netMassOut(G%isd:G%ied,G%jsd:G%jed)) - fluxes%netMassOut(:,:) = 0.0 - endif - if (.not. associated(fluxes%netMassIn)) then - allocate(fluxes%netMassIn(G%isd:G%ied,G%jsd:G%jed)) - fluxes%netMassIn(:,:) = 0.0 - endif + if (.not. associated(fluxes%netMassOut)) & + allocate(fluxes%netMassOut(G%isd:G%ied,G%jsd:G%jed), source=0.0) + if (.not. associated(fluxes%netMassIn)) & + allocate(fluxes%netMassIn(G%isd:G%ied,G%jsd:G%jed), source=0.0) fluxes%netMassOut(:,:) = 0.0 fluxes%netMassIn(:,:) = 0.0 diff --git a/src/tracer/MOM_offline_main.F90 b/src/tracer/MOM_offline_main.F90 index 408120b4e5..32ea7c1cd4 100644 --- a/src/tracer/MOM_offline_main.F90 +++ b/src/tracer/MOM_offline_main.F90 @@ -1434,17 +1434,15 @@ subroutine offline_transport_init(param_file, CS, diabatic_CSp, G, GV, US) CS%GV => GV ! Allocate arrays - allocate(CS%uhtr(IsdB:IedB,jsd:jed,nz)) ; CS%uhtr(:,:,:) = 0.0 - allocate(CS%vhtr(isd:ied,JsdB:JedB,nz)) ; CS%vhtr(:,:,:) = 0.0 - allocate(CS%eatr(isd:ied,jsd:jed,nz)) ; CS%eatr(:,:,:) = 0.0 - allocate(CS%ebtr(isd:ied,jsd:jed,nz)) ; CS%ebtr(:,:,:) = 0.0 - allocate(CS%h_end(isd:ied,jsd:jed,nz)) ; CS%h_end(:,:,:) = 0.0 - allocate(CS%netMassOut(G%isd:G%ied,G%jsd:G%jed)) ; CS%netMassOut(:,:) = 0.0 - allocate(CS%netMassIn(G%isd:G%ied,G%jsd:G%jed)) ; CS%netMassIn(:,:) = 0.0 - allocate(CS%Kd(isd:ied,jsd:jed,nz+1)) ; CS%Kd = 0. - if (CS%read_mld) then - allocate(CS%mld(G%isd:G%ied,G%jsd:G%jed)) ; CS%mld(:,:) = 0.0 - endif + allocate(CS%uhtr(IsdB:IedB,jsd:jed,nz), source=0.0) + allocate(CS%vhtr(isd:ied,JsdB:JedB,nz), source=0.0) + allocate(CS%eatr(isd:ied,jsd:jed,nz), source=0.0) + allocate(CS%ebtr(isd:ied,jsd:jed,nz), source=0.0) + allocate(CS%h_end(isd:ied,jsd:jed,nz), source=0.0) + allocate(CS%netMassOut(G%isd:G%ied,G%jsd:G%jed), source=0.0) + allocate(CS%netMassIn(G%isd:G%ied,G%jsd:G%jed), source=0.0) + allocate(CS%Kd(isd:ied,jsd:jed,nz+1), source=0.0) + if (CS%read_mld) allocate(CS%mld(G%isd:G%ied,G%jsd:G%jed), source=0.0) if (CS%read_all_ts_uvh) then call read_all_input(CS) @@ -1480,11 +1478,11 @@ subroutine read_all_input(CS) if (allocated(CS%temp_all)) call MOM_error(FATAL, "temp_all is already allocated") if (allocated(CS%salt_all)) call MOM_error(FATAL, "salt_all is already allocated") - allocate(CS%uhtr_all(IsdB:IedB,jsd:jed,nz,ntime)) ; CS%uhtr_all(:,:,:,:) = 0.0 - allocate(CS%vhtr_all(isd:ied,JsdB:JedB,nz,ntime)) ; CS%vhtr_all(:,:,:,:) = 0.0 - allocate(CS%hend_all(isd:ied,jsd:jed,nz,ntime)) ; CS%hend_all(:,:,:,:) = 0.0 - allocate(CS%temp_all(isd:ied,jsd:jed,nz,1:ntime)) ; CS%temp_all(:,:,:,:) = 0.0 - allocate(CS%salt_all(isd:ied,jsd:jed,nz,1:ntime)) ; CS%salt_all(:,:,:,:) = 0.0 + allocate(CS%uhtr_all(IsdB:IedB,jsd:jed,nz,ntime), source=0.0) + allocate(CS%vhtr_all(isd:ied,JsdB:JedB,nz,ntime), source=0.0) + allocate(CS%hend_all(isd:ied,jsd:jed,nz,ntime), source=0.0) + allocate(CS%temp_all(isd:ied,jsd:jed,nz,1:ntime), source=0.0) + allocate(CS%salt_all(isd:ied,jsd:jed,nz,1:ntime), source=0.0) call MOM_mesg("Reading in uhtr, vhtr, h_start, h_end, temp, salt") do t = 1,ntime diff --git a/src/tracer/MOM_tracer_Z_init.F90 b/src/tracer/MOM_tracer_Z_init.F90 index 7fb71f9773..cd6572cc9c 100644 --- a/src/tracer/MOM_tracer_Z_init.F90 +++ b/src/tracer/MOM_tracer_Z_init.F90 @@ -96,8 +96,8 @@ function tracer_Z_init(tr, h, filename, tr_name, G, GV, US, missing_val, land_va return endif - allocate(tr_in(G%isd:G%ied,G%jsd:G%jed,nz_in)) ; tr_in(:,:,:) = 0.0 - allocate(tr_1d(nz_in)) ; tr_1d(:) = 0.0 + allocate(tr_in(G%isd:G%ied,G%jsd:G%jed,nz_in), source=0.0) + allocate(tr_1d(nz_in), source=0.0) call MOM_read_data(filename, tr_name, tr_in(:,:,:), G%Domain) ! Fill missing values from above? Use a "close" test to avoid problems @@ -426,7 +426,7 @@ subroutine read_Z_edges(filename, tr_name, z_edges, nz_out, has_edges, & call read_attribute(filename, "edges", edge_name, varname=dim_names(3), found=has_edges, ncid_in=ncid) nz_edge = sizes(3) ; if (has_edges) nz_edge = sizes(3)+1 - allocate(z_edges(nz_edge)) ; z_edges(:) = 0.0 + allocate(z_edges(nz_edge), source=0.0) if (nz_out < 1) return diff --git a/src/tracer/RGC_tracer.F90 b/src/tracer/RGC_tracer.F90 index 59058abeda..6d355db36f 100644 --- a/src/tracer/RGC_tracer.F90 +++ b/src/tracer/RGC_tracer.F90 @@ -125,9 +125,9 @@ function register_RGC_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) "The length of the sponge layer (km).", & default=10.0) - allocate(CS%tr(isd:ied,jsd:jed,nz,NTR)) ; CS%tr(:,:,:,:) = 0.0 + allocate(CS%tr(isd:ied,jsd:jed,nz,NTR), source=0.0) if (CS%mask_tracers) then - allocate(CS%tr_aux(isd:ied,jsd:jed,nz,NTR)) ; CS%tr_aux(:,:,:,:) = 0.0 + allocate(CS%tr_aux(isd:ied,jsd:jed,nz,NTR), source=0.0) endif do m=1,NTR diff --git a/src/tracer/advection_test_tracer.F90 b/src/tracer/advection_test_tracer.F90 index 9d328e7a8f..4d05d43fd9 100644 --- a/src/tracer/advection_test_tracer.F90 +++ b/src/tracer/advection_test_tracer.F90 @@ -127,7 +127,7 @@ function register_advection_test_tracer(HI, GV, param_file, CS, tr_Reg, restart_ "restart files of a restarted run.", default=.false.) - allocate(CS%tr(isd:ied,jsd:jed,nz,NTR)) ; CS%tr(:,:,:,:) = 0.0 + allocate(CS%tr(isd:ied,jsd:jed,nz,NTR), source=0.0) do m=1,NTR if (m < 10) then ; write(name,'("tr",I1.1)') m diff --git a/src/tracer/boundary_impulse_tracer.F90 b/src/tracer/boundary_impulse_tracer.F90 index 4856abaefd..3aaa51b301 100644 --- a/src/tracer/boundary_impulse_tracer.F90 +++ b/src/tracer/boundary_impulse_tracer.F90 @@ -106,7 +106,7 @@ function register_boundary_impulse_tracer(HI, GV, param_file, CS, tr_Reg, restar "it is a fatal error if the tracers are not found in the "//& "restart files of a restarted run.", default=.false.) CS%ntr = NTR_MAX - allocate(CS%tr(isd:ied,jsd:jed,nz,CS%ntr)) ; CS%tr(:,:,:,:) = 0.0 + allocate(CS%tr(isd:ied,jsd:jed,nz,CS%ntr), source=0.0) CS%nkml = max(GV%nkml,1) diff --git a/src/tracer/dye_example.F90 b/src/tracer/dye_example.F90 index 2bf3cd94ed..a26c967eae 100644 --- a/src/tracer/dye_example.F90 +++ b/src/tracer/dye_example.F90 @@ -149,7 +149,7 @@ function register_dye_tracer(HI, GV, US, param_file, CS, tr_Reg, restart_CS) if (minval(CS%dye_source_maxdepth(:)) < -1.e29*US%m_to_Z) & call MOM_error(FATAL, "register_dye_tracer: Not enough values provided for DYE_SOURCE_MAXDEPTH ") - allocate(CS%tr(isd:ied,jsd:jed,nz,CS%ntr)) ; CS%tr(:,:,:,:) = 0.0 + allocate(CS%tr(isd:ied,jsd:jed,nz,CS%ntr), source=0.0) do m = 1, CS%ntr write(var_name(:),'(A,I3.3)') "dye",m diff --git a/src/tracer/dyed_obc_tracer.F90 b/src/tracer/dyed_obc_tracer.F90 index eb49d0beef..f299febfa8 100644 --- a/src/tracer/dyed_obc_tracer.F90 +++ b/src/tracer/dyed_obc_tracer.F90 @@ -98,7 +98,7 @@ function register_dyed_obc_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) CS%tracer_IC_file) endif - allocate(CS%tr(isd:ied,jsd:jed,nz,CS%ntr)) ; CS%tr(:,:,:,:) = 0.0 + allocate(CS%tr(isd:ied,jsd:jed,nz,CS%ntr), source=0.0) do m=1,CS%ntr write(name,'("dye_",I2.2)') m diff --git a/src/tracer/ideal_age_example.F90 b/src/tracer/ideal_age_example.F90 index 19e1df59dc..ffe4f9df72 100644 --- a/src/tracer/ideal_age_example.F90 +++ b/src/tracer/ideal_age_example.F90 @@ -163,7 +163,7 @@ function register_ideal_age_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) units="years", default=0.0) endif - allocate(CS%tr(isd:ied,jsd:jed,nz,CS%ntr)) ; CS%tr(:,:,:,:) = 0.0 + allocate(CS%tr(isd:ied,jsd:jed,nz,CS%ntr), source=0.0) do m=1,CS%ntr ! This is needed to force the compiler not to do a copy in the registration diff --git a/src/tracer/nw2_tracers.F90 b/src/tracer/nw2_tracers.F90 index e75c5c5d38..4578a422dc 100644 --- a/src/tracer/nw2_tracers.F90 +++ b/src/tracer/nw2_tracers.F90 @@ -87,7 +87,7 @@ logical function register_nw2_tracers(HI, GV, param_file, CS, tr_Reg, restart_CS units="days") CS%ntr = 3 * n_groups - allocate(CS%tr(isd:ied,jsd:jed,nz,CS%ntr)) ; CS%tr(:,:,:,:) = 0.0 + allocate(CS%tr(isd:ied,jsd:jed,nz,CS%ntr), source=0.0) allocate(CS%restore_rate(CS%ntr)) do m=1,CS%ntr diff --git a/src/tracer/oil_tracer.F90 b/src/tracer/oil_tracer.F90 index df96193181..fcc0de23d8 100644 --- a/src/tracer/oil_tracer.F90 +++ b/src/tracer/oil_tracer.F90 @@ -169,7 +169,7 @@ function register_oil_tracer(HI, GV, US, param_file, CS, tr_Reg, restart_CS) if (GV%Boussinesq) then ; flux_units = "kg s-1" else ; flux_units = "kg m-3 kg s-1" ; endif - allocate(CS%tr(isd:ied,jsd:jed,nz,CS%ntr)) ; CS%tr(:,:,:,:) = 0.0 + allocate(CS%tr(isd:ied,jsd:jed,nz,CS%ntr), source=0.0) do m=1,CS%ntr ! This is needed to force the compiler not to do a copy in the registration diff --git a/src/tracer/pseudo_salt_tracer.F90 b/src/tracer/pseudo_salt_tracer.F90 index eb15c05580..cd1ee41ebd 100644 --- a/src/tracer/pseudo_salt_tracer.F90 +++ b/src/tracer/pseudo_salt_tracer.F90 @@ -88,8 +88,8 @@ function register_pseudo_salt_tracer(HI, GV, param_file, CS, tr_Reg, restart_CS) ! Read all relevant parameters and write them to the model log. call log_version(param_file, mdl, version, "") - allocate(CS%ps(isd:ied,jsd:jed,nz)) ; CS%ps(:,:,:) = 0.0 - allocate(CS%diff(isd:ied,jsd:jed,nz)) ; CS%diff(:,:,:) = 0.0 + allocate(CS%ps(isd:ied,jsd:jed,nz), source=0.0) + allocate(CS%diff(isd:ied,jsd:jed,nz), source=0.0) CS%tr_desc = var_desc(trim("pseudo_salt"), "psu", & "Pseudo salt passive tracer", caller=mdl) diff --git a/src/tracer/tracer_example.F90 b/src/tracer/tracer_example.F90 index 349720304b..3eb83a79c5 100644 --- a/src/tracer/tracer_example.F90 +++ b/src/tracer/tracer_example.F90 @@ -99,7 +99,7 @@ function USER_register_tracer_example(HI, GV, param_file, CS, tr_Reg, restart_CS "The exact location and properties of those sponges are "//& "specified from MOM_initialization.F90.", default=.false.) - allocate(CS%tr(isd:ied,jsd:jed,nz,NTR)) ; CS%tr(:,:,:,:) = 0.0 + allocate(CS%tr(isd:ied,jsd:jed,nz,NTR), source=0.0) do m=1,NTR if (m < 10) then ; write(name,'("tr",I1.1)') m diff --git a/src/user/MOM_wave_interface.F90 b/src/user/MOM_wave_interface.F90 index 2f0d95a62d..10c3af7385 100644 --- a/src/user/MOM_wave_interface.F90 +++ b/src/user/MOM_wave_interface.F90 @@ -332,12 +332,9 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag ) "STK_BAND_COUPLER is the number of Stokes drift bands in the coupler. "// & "This has to be consistent with the number of Stokes drift bands in WW3, "//& "or the model will fail.",units='', default=1) - allocate( CS%WaveNum_Cen(CS%NumBands) ) - allocate( CS%STKx0(G%isdB:G%iedB,G%jsd:G%jed,CS%NumBands)) - allocate( CS%STKy0(G%isdB:G%iedB,G%jsd:G%jed,CS%NumBands)) - CS%WaveNum_Cen(:) = 0.0 - CS%STKx0(:,:,:) = 0.0 - CS%STKy0(:,:,:) = 0.0 + allocate( CS%WaveNum_Cen(CS%NumBands), source=0.0 ) + allocate( CS%STKx0(G%isdB:G%iedB,G%jsd:G%jed,CS%NumBands), source=0.0 ) + allocate( CS%STKy0(G%isdB:G%iedB,G%jsd:G%jed,CS%NumBands), source=0.0 ) CS%PartitionMode = 0 call get_param(param_file, mdl, "SURFBAND_WAVENUMBERS", CS%WaveNum_Cen, & "Central wavenumbers for surface Stokes drift bands.", & @@ -349,16 +346,11 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag ) "Make sure this is consistnet w/ WAVENUMBERS, STOKES_X, and "// & "STOKES_Y, there are no safety checks in the code.", & units='', default=1) - allocate( CS%WaveNum_Cen(1:CS%NumBands) ) - CS%WaveNum_Cen(:) = 0.0 - allocate( CS%PrescribedSurfStkX(1:CS%NumBands)) - CS%PrescribedSurfStkX(:) = 0.0 - allocate( CS%PrescribedSurfStkY(1:CS%NumBands)) - CS%PrescribedSurfStkY(:) = 0.0 - allocate( CS%STKx0(G%isdB:G%iedB,G%jsd:G%jed,1:CS%NumBands)) - CS%STKx0(:,:,:) = 0.0 - allocate( CS%STKy0(G%isd:G%ied,G%jsdB:G%jedB,1:CS%NumBands)) - CS%STKy0(:,:,:) = 0.0 + allocate( CS%WaveNum_Cen(1:CS%NumBands), source=0.0 ) + allocate( CS%PrescribedSurfStkX(1:CS%NumBands), source=0.0 ) + allocate( CS%PrescribedSurfStkY(1:CS%NumBands), source=0.0 ) + allocate( CS%STKx0(G%isdB:G%iedB,G%jsd:G%jed,1:CS%NumBands), source=0.0 ) + allocate( CS%STKy0(G%isd:G%ied,G%jsdB:G%jedB,1:CS%NumBands), source=0.0 ) CS%PartitionMode = 0 call get_param(param_file, mdl, "SURFBAND_WAVENUMBERS", CS%WaveNum_Cen, & "Central wavenumbers for surface Stokes drift bands.", & @@ -409,24 +401,17 @@ subroutine MOM_wave_interface_init(time, G, GV, US, param_file, CS, diag ) ! Allocate and initialize ! a. Stokes driftProfiles - allocate(CS%Us_x(G%isdB:G%IedB,G%jsd:G%jed,GV%ke)) - CS%Us_x(:,:,:) = 0.0 - allocate(CS%Us_y(G%isd:G%Ied,G%jsdB:G%jedB,GV%ke)) - CS%Us_y(:,:,:) = 0.0 + allocate(CS%Us_x(G%isdB:G%IedB,G%jsd:G%jed,GV%ke), source=0.0) + allocate(CS%Us_y(G%isd:G%Ied,G%jsdB:G%jedB,GV%ke), source=0.0) ! b. Surface Values - allocate(CS%US0_x(G%isdB:G%iedB,G%jsd:G%jed)) - CS%US0_x(:,:) = 0.0 - allocate(CS%US0_y(G%isd:G%ied,G%jsdB:G%jedB)) - CS%US0_y(:,:) = 0.0 + allocate(CS%US0_x(G%isdB:G%iedB,G%jsd:G%jed), source=0.0) + allocate(CS%US0_y(G%isd:G%ied,G%jsdB:G%jedB), source=0.0) ! c. Langmuir number - allocate(CS%La_SL(G%isc:G%iec,G%jsc:G%jec)) - allocate(CS%La_turb(G%isc:G%iec,G%jsc:G%jec)) - CS%La_SL(:,:) = 0.0 - CS%La_turb (:,:) = 0.0 + allocate(CS%La_SL(G%isc:G%iec,G%jsc:G%jec), source=0.0) + allocate(CS%La_turb(G%isc:G%iec,G%jsc:G%jec), source=0.0) ! d. Viscosity for Stokes drift if (CS%StokesMixing) then - allocate(CS%KvS(G%isd:G%Ied,G%jsd:G%jed,GV%ke)) - CS%KvS(:,:,:) = 0.0 + allocate(CS%KvS(G%isd:G%Ied,G%jsd:G%jed,GV%ke), source=0.0) endif ! Initialize Wave related outputs @@ -868,7 +853,7 @@ subroutine Surface_Bands_by_data_override(day_center, G, GV, US, CS) CS%NUMBANDS = sizes(1) ! Allocate the wavenumber bins - allocate( CS%WaveNum_Cen(CS%NUMBANDS) ) ; CS%WaveNum_Cen(:) = 0.0 + allocate( CS%WaveNum_Cen(CS%NUMBANDS), source=0.0 ) if (wavenumber_exists) then ! Wavenumbers found, so this file uses the old method: @@ -882,7 +867,7 @@ subroutine Surface_Bands_by_data_override(day_center, G, GV, US, CS) CS%PartitionMode = 1 ! Allocate the frequency bins - allocate( CS%Freq_Cen(CS%NUMBANDS) ) ; CS%Freq_Cen(:) = 0.0 + allocate( CS%Freq_Cen(CS%NUMBANDS), source=0.0 ) ! Reading frequencies PI = 4.0*atan(1.0) @@ -894,10 +879,10 @@ subroutine Surface_Bands_by_data_override(day_center, G, GV, US, CS) endif if (.not.allocated(CS%STKx0)) then - allocate( CS%STKx0(G%isdB:G%iedB,G%jsd:G%jed,CS%NUMBANDS) ) ; CS%STKx0(:,:,:) = 0.0 + allocate( CS%STKx0(G%isdB:G%iedB,G%jsd:G%jed,CS%NUMBANDS), source=0.0 ) endif if (.not.allocated(CS%STKy0)) then - allocate( CS%STKy0(G%isd:G%ied,G%jsdB:G%jedB,CS%NUMBANDS) ) ; CS%STKy0(:,:,:) = 0.0 + allocate( CS%STKy0(G%isd:G%ied,G%jsdB:G%jedB,CS%NUMBANDS), source=0.0 ) endif endif diff --git a/src/user/dumbbell_surface_forcing.F90 b/src/user/dumbbell_surface_forcing.F90 index ea27d01cdc..693d2b5ceb 100644 --- a/src/user/dumbbell_surface_forcing.F90 +++ b/src/user/dumbbell_surface_forcing.F90 @@ -235,7 +235,7 @@ subroutine dumbbell_surface_forcing_init(Time, G, US, param_file, diag, CS) CS%Flux_const = CS%Flux_const / 86400.0 - allocate(CS%forcing_mask(G%isd:G%ied, G%jsd:G%jed)); CS%forcing_mask(:,:)=0.0 + allocate(CS%forcing_mask(G%isd:G%ied, G%jsd:G%jed), source=0.0) allocate(CS%S_restore(G%isd:G%ied, G%jsd:G%jed)) do j=G%jsc,G%jec