From 288e90318207db8397e6972e15fb0f692d080d03 Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Thu, 2 May 2024 11:05:46 -0700 Subject: [PATCH 01/10] Split the complex routines out of module_dm file --- .../RSL_LITE/feedback_domain_em_part1.F90 | 111 ++ .../RSL_LITE/feedback_domain_em_part2.F90 | 200 +++ external/RSL_LITE/force_domain_em_part2.F90 | 314 ++++ external/RSL_LITE/interp_domain_em_part1.F90 | 105 ++ external/RSL_LITE/interp_domain_em_part2.F90 | 187 +++ external/RSL_LITE/interp_domain_em_part3.F90 | 49 + external/RSL_LITE/interp_domain_em_small.F90 | 411 ++++++ external/RSL_LITE/module_dm.F | 1314 ----------------- 8 files changed, 1377 insertions(+), 1314 deletions(-) create mode 100644 external/RSL_LITE/feedback_domain_em_part1.F90 create mode 100644 external/RSL_LITE/feedback_domain_em_part2.F90 create mode 100644 external/RSL_LITE/force_domain_em_part2.F90 create mode 100644 external/RSL_LITE/interp_domain_em_part1.F90 create mode 100644 external/RSL_LITE/interp_domain_em_part2.F90 create mode 100644 external/RSL_LITE/interp_domain_em_part3.F90 create mode 100644 external/RSL_LITE/interp_domain_em_small.F90 diff --git a/external/RSL_LITE/feedback_domain_em_part1.F90 b/external/RSL_LITE/feedback_domain_em_part1.F90 new file mode 100644 index 0000000000..8fe36fc147 --- /dev/null +++ b/external/RSL_LITE/feedback_domain_em_part1.F90 @@ -0,0 +1,111 @@ +#if ( EM_CORE == 1 && DA_CORE != 1 ) + +!------------------------------------------------------------------ + SUBROUTINE feedback_domain_em_part1 ( grid, ngrid, config_flags & +! +#include "dummy_new_args.inc" +! + ) + USE module_state_description + USE module_domain, ONLY : domain, get_ijk_from_grid + USE module_configure, ONLY : grid_config_rec_type, model_config_rec, model_to_grid_config_rec + USE module_dm, ONLY : ntasks, ntasks_x, ntasks_y, itrace, local_communicator, mytask, & + ipe_save, jpe_save, ips_save, jps_save, & + nest_pes_x, nest_pes_y + + IMPLICIT NONE +! + TYPE(domain), POINTER :: grid ! name of the grid being dereferenced (must be "grid") + TYPE(domain), POINTER :: ngrid +#include "dummy_new_decl.inc" + INTEGER nlev, msize + INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k + TYPE(domain), POINTER :: xgrid + TYPE (grid_config_rec_type) :: config_flags, nconfig_flags + REAL xv(2000) + INTEGER :: cids, cide, cjds, cjde, ckds, ckde, & + cims, cime, cjms, cjme, ckms, ckme, & + cips, cipe, cjps, cjpe, ckps, ckpe + INTEGER :: nids, nide, njds, njde, nkds, nkde, & + nims, nime, njms, njme, nkms, nkme, & + nips, nipe, njps, njpe, nkps, nkpe + + INTEGER idim1,idim2,idim3,idim4,idim5,idim6,idim7 + + INTEGER local_comm, myproc, nproc, idum1, idum2 + INTEGER thisdomain_max_halo_width + +!cyl: add variables for trajectory + integer tjk + + INTERFACE + SUBROUTINE feedback_nest_prep ( grid, config_flags & +! +#include "dummy_new_args.inc" +! +) + USE module_state_description + USE module_domain, ONLY : domain + USE module_configure, ONLY : grid_config_rec_type +! + TYPE (grid_config_rec_type) :: config_flags + TYPE(domain), TARGET :: grid +#include "dummy_new_decl.inc" + END SUBROUTINE feedback_nest_prep + END INTERFACE +! + + CALL wrf_get_dm_communicator ( local_comm ) + CALL wrf_get_myproc( myproc ) + CALL wrf_get_nproc( nproc ) + +! +! intermediate grid + CALL get_ijk_from_grid ( grid , & + cids, cide, cjds, cjde, ckds, ckde, & + cims, cime, cjms, cjme, ckms, ckme, & + cips, cipe, cjps, cjpe, ckps, ckpe ) +! nest grid + CALL get_ijk_from_grid ( ngrid , & + nids, nide, njds, njde, nkds, nkde, & + nims, nime, njms, njme, nkms, nkme, & + nips, nipe, njps, njpe, nkps, nkpe ) + + nlev = ckde - ckds + 1 + + ips_save = ngrid%i_parent_start ! used in feedback_domain_em_part2 below + jps_save = ngrid%j_parent_start + ipe_save = ngrid%i_parent_start + (nide-nids+1) / ngrid%parent_grid_ratio - 1 + jpe_save = ngrid%j_parent_start + (njde-njds+1) / ngrid%parent_grid_ratio - 1 + +! feedback_nest_prep invokes a halo exchange on the ngrid. It is done this way +! in a separate routine because the HALOs need the data to be dereference from the +! grid data structure and, in this routine, the dereferenced fields are related to +! the intermediate domain, not the nest itself. Save the current grid pointer to intermediate +! domain, switch grid to point to ngrid, invoke feedback_nest_prep, then restore grid +! to point to intermediate domain. + + CALL model_to_grid_config_rec ( ngrid%id , model_config_rec , nconfig_flags ) + CALL set_scalar_indices_from_config ( ngrid%id , idum1 , idum2 ) + xgrid => grid + grid => ngrid + + CALL feedback_nest_prep ( grid, nconfig_flags & +! +#include "actual_new_args.inc" +! +) + +! put things back so grid is intermediate grid + + grid => xgrid + CALL set_scalar_indices_from_config ( grid%id , idum1 , idum2 ) + +! "interp" (basically copy) ngrid onto intermediate grid + +#include "nest_feedbackup_interp.inc" + + RETURN + END SUBROUTINE feedback_domain_em_part1 +#endif + diff --git a/external/RSL_LITE/feedback_domain_em_part2.F90 b/external/RSL_LITE/feedback_domain_em_part2.F90 new file mode 100644 index 0000000000..3096e9cef5 --- /dev/null +++ b/external/RSL_LITE/feedback_domain_em_part2.F90 @@ -0,0 +1,200 @@ +#if ( EM_CORE == 1 && DA_CORE != 1 ) + +!------------------------------------------------------------------ + + SUBROUTINE feedback_domain_em_part2 ( grid, intermediate_grid, ngrid , config_flags & +! +#include "dummy_new_args.inc" +! + ) + USE module_state_description + USE module_domain, ONLY : domain, domain_clock_get, get_ijk_from_grid + USE module_configure, ONLY : grid_config_rec_type, model_config_rec + USE module_dm, ONLY : ntasks, ntasks_x, ntasks_y, itrace, local_communicator, mytask, & + ipe_save, jpe_save, ips_save, jps_save, get_dm_max_halo_width, & + nest_pes_x, nest_pes_y, & + intercomm_active, nest_task_offsets, & + mpi_comm_to_mom, mpi_comm_to_kid, which_kid !, & + !push_communicators_for_domain, pop_communicators_for_domain + + USE module_comm_nesting_dm, ONLY : halo_interp_up_sub + USE module_utility + IMPLICIT NONE + +! + TYPE(domain), POINTER :: grid ! name of the grid being dereferenced (must be "grid") + TYPE(domain), POINTER :: intermediate_grid + TYPE(domain), POINTER :: ngrid + TYPE(domain), POINTER :: parent_grid + +#include "dummy_new_decl.inc" + INTEGER nlev, msize + INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k + TYPE (grid_config_rec_type) :: config_flags + REAL xv(2000) + INTEGER :: cids, cide, cjds, cjde, ckds, ckde, & + cims, cime, cjms, cjme, ckms, ckme, & + cips, cipe, cjps, cjpe, ckps, ckpe + INTEGER :: nids, nide, njds, njde, nkds, nkde, & + nims, nime, njms, njme, nkms, nkme, & + nips, nipe, njps, njpe, nkps, nkpe + INTEGER :: xids, xide, xjds, xjde, xkds, xkde, & + xims, xime, xjms, xjme, xkms, xkme, & + xips, xipe, xjps, xjpe, xkps, xkpe + INTEGER :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + ips, ipe, jps, jpe, kps, kpe + + INTEGER idim1,idim2,idim3,idim4,idim5,idim6,idim7 + + INTEGER icoord, jcoord, idim_cd, jdim_cd + INTEGER local_comm, myproc, nproc, ioffset + INTEGER iparstrt, jparstrt, sw, thisdomain_max_halo_width + REAL nest_influence + + character*256 :: timestr + integer ierr + + LOGICAL, EXTERNAL :: cd_feedback_mask + +!cyl: add variables for trajectory + integer tjk + +! On entry to this routine, +! "grid" refers to the parent domain +! "intermediate_grid" refers to local copy of parent domain that overlies this patch of nest +! "ngrid" refers to the nest, which is only needed for smoothing on the parent because +! the nest feedback data has already been transferred during em_nest_feedbackup_interp +! in part1, above. +! The way these settings c and n dimensions are set, below, looks backwards but from the point +! of view of the RSL routine rsl_lite_to_parent_info(), call to which is included by +! em_nest_feedbackup_pack, the "n" domain represents the parent domain and the "c" domain +! represents the intermediate domain. The backwards lookingness should be fixed in the gen_comms.c +! registry routine that accompanies RSL_LITE but, just as it's sometimes easier to put up a road +! sign that says "DIP" than fix the dip, at this point it was easier just to write this comment. JM +! + nest_influence = 1. + + CALL domain_clock_get( grid, current_timestr=timestr ) + + CALL get_ijk_from_grid ( intermediate_grid , & + cids, cide, cjds, cjde, ckds, ckde, & + cims, cime, cjms, cjme, ckms, ckme, & + cips, cipe, cjps, cjpe, ckps, ckpe ) + CALL get_ijk_from_grid ( grid , & + nids, nide, njds, njde, nkds, nkde, & + nims, nime, njms, njme, nkms, nkme, & + nips, nipe, njps, njpe, nkps, nkpe ) + CALL get_ijk_from_grid ( ngrid , & + xids, xide, xjds, xjde, xkds, xkde, & + xims, xime, xjms, xjme, xkms, xkme, & + xips, xipe, xjps, xjpe, xkps, xkpe ) + + ips_save = ngrid%i_parent_start ! used in feedback_domain_em_part2 below + jps_save = ngrid%j_parent_start + ipe_save = ngrid%i_parent_start + (xide-xids+1) / ngrid%parent_grid_ratio - 1 + jpe_save = ngrid%j_parent_start + (xjde-xjds+1) / ngrid%parent_grid_ratio - 1 + + + + +IF ( ngrid%active_this_task ) THEN +!cyl add this for trajectory + CALL push_communicators_for_domain( ngrid%id ) + + do tjk = 1,config_flags%num_traj + if (ngrid%traj_long(tjk) .eq. -9999.0) then +! print*,'n=-9999',tjk + ngrid%traj_long(tjk)=grid%traj_long(tjk) + ngrid%traj_k(tjk)=grid%traj_k(tjk) + else +! print*,'p!=-9999',tjk + grid%traj_long(tjk)=ngrid%traj_long(tjk) + grid%traj_k(tjk)=ngrid%traj_k(tjk) + endif + if (ngrid%traj_lat(tjk) .eq. -9999.0) then + ngrid%traj_lat(tjk)=grid%traj_lat(tjk) + ngrid%traj_k(tjk)=grid%traj_k(tjk) + else + grid%traj_lat(tjk)=ngrid%traj_lat(tjk) + grid%traj_k(tjk)=ngrid%traj_k(tjk) + endif + enddo +!endcyl + + CALL nl_get_i_parent_start ( intermediate_grid%id, iparstrt ) + CALL nl_get_j_parent_start ( intermediate_grid%id, jparstrt ) + CALL nl_get_shw ( intermediate_grid%id, sw ) + icoord = iparstrt - sw + jcoord = jparstrt - sw + idim_cd = cide - cids + 1 + jdim_cd = cjde - cjds + 1 + + nlev = ckde - ckds + 1 + + CALL get_dm_max_halo_width ( grid%id , thisdomain_max_halo_width ) + + parent_grid => grid + grid => ngrid +#include "nest_feedbackup_pack.inc" + grid => parent_grid + CALL pop_communicators_for_domain + +END IF + +! CALL wrf_get_dm_communicator ( local_comm ) +! CALL wrf_get_myproc( myproc ) +! CALL wrf_get_nproc( nproc ) + + ! determine which communicator and offset to use + IF ( intercomm_active( grid%id ) ) THEN ! I am parent + local_comm = mpi_comm_to_kid( which_kid(ngrid%id), grid%id ) + ioffset = nest_task_offsets(ngrid%id) + ELSE IF ( intercomm_active( ngrid%id ) ) THEN ! I am nest + local_comm = mpi_comm_to_mom( ngrid%id ) + ioffset = nest_task_offsets(ngrid%id) + END IF + + IF ( grid%active_this_task .OR. ngrid%active_this_task ) THEN +#ifndef STUBMPI + CALL mpi_comm_rank(local_comm,myproc,ierr) + CALL mpi_comm_size(local_comm,nproc,ierr) +#endif +!call tracebackqq() + CALL rsl_lite_merge_msgs( myproc, nest_pes_x(grid%id)*nest_pes_y(grid%id), & + nest_pes_x(ngrid%id)*nest_pes_y(ngrid%id), & + ioffset, local_comm ) + END IF + +IF ( grid%active_this_task ) THEN + CALL push_communicators_for_domain( grid%id ) + + +#define NEST_INFLUENCE(A,B) A = B +#include "nest_feedbackup_unpack.inc" + + ! smooth coarse grid + CALL get_ijk_from_grid ( ngrid, & + nids, nide, njds, njde, nkds, nkde, & + nims, nime, njms, njme, nkms, nkme, & + nips, nipe, njps, njpe, nkps, nkpe ) + CALL get_ijk_from_grid ( grid , & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + ips, ipe, jps, jpe, kps, kpe ) + +#include "HALO_INTERP_UP.inc" + + CALL get_ijk_from_grid ( grid , & + cids, cide, cjds, cjde, ckds, ckde, & + cims, cime, cjms, cjme, ckms, ckme, & + cips, cipe, cjps, cjpe, ckps, ckpe ) + +#include "nest_feedbackup_smooth.inc" + + CALL pop_communicators_for_domain +END IF + + RETURN + END SUBROUTINE feedback_domain_em_part2 +#endif diff --git a/external/RSL_LITE/force_domain_em_part2.F90 b/external/RSL_LITE/force_domain_em_part2.F90 new file mode 100644 index 0000000000..8c6c4e7e98 --- /dev/null +++ b/external/RSL_LITE/force_domain_em_part2.F90 @@ -0,0 +1,314 @@ +#if ( EM_CORE == 1 && DA_CORE != 1 ) + +!------------------------------------------------------------------ + + SUBROUTINE force_domain_em_part2 ( grid, ngrid, pgrid, config_flags & +! +#include "dummy_new_args.inc" +! + ) + USE module_state_description + USE module_domain, ONLY : domain, get_ijk_from_grid + USE module_configure, ONLY : grid_config_rec_type + USE module_dm, ONLY : ntasks, ntasks_x, ntasks_y, local_communicator, mytask, & + nest_pes_x, nest_pes_y ! , & + !push_communicators_for_domain,pop_communicators_for_domain + USE module_comm_nesting_dm, ONLY : halo_force_down_sub + USE module_model_constants + IMPLICIT NONE +! + TYPE(domain), POINTER :: grid ! name of the grid being dereferenced (must be "grid") + TYPE(domain), POINTER :: ngrid + TYPE(domain), POINTER :: pgrid !KAL added for vertical nesting +#include "dummy_new_decl.inc" + INTEGER nlev, msize + INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k,kk + TYPE (grid_config_rec_type) :: config_flags + REAL xv(2000) + INTEGER :: cids, cide, cjds, cjde, ckds, ckde, & + cims, cime, cjms, cjme, ckms, ckme, & + cips, cipe, cjps, cjpe, ckps, ckpe + INTEGER :: nids, nide, njds, njde, nkds, nkde, & + nims, nime, njms, njme, nkms, nkme, & + nips, nipe, njps, njpe, nkps, nkpe + INTEGER :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + ips, ipe, jps, jpe, kps, kpe + INTEGER idim1,idim2,idim3,idim4,idim5,idim6,idim7,itrace + REAL dummy_xs, dummy_xe, dummy_ys, dummy_ye + + !KAL variables for vertical nesting + REAL :: p_top_m , p_surf_m , mu_m , hsca_m , pre_c ,pre_n + REAL, DIMENSION(pgrid%s_vert:pgrid%e_vert) :: alt_w_c + REAL, DIMENSION(pgrid%s_vert:pgrid%e_vert+1) :: alt_u_c + REAL, DIMENSION(ngrid%s_vert:ngrid%e_vert) :: alt_w_n + REAL, DIMENSION(ngrid%s_vert:ngrid%e_vert+1) :: alt_u_n + + REAL, DIMENSION(:,:,:), ALLOCATABLE :: p, al + REAL :: pfu, pfd, phm, temp, qvf, qvf1, qvf2 + + !KAL change this for vertical nesting + ! force_domain_em_part1 packs up the interpolation onto the coarse (vertical) grid + ! therefore the message size is based on the coarse grid number of levels + ! here it is unpacked onto the intermediate grid + CALL get_ijk_from_grid ( pgrid , & + cids, cide, cjds, cjde, ckds, ckde, & + cims, cime, cjms, cjme, ckms, ckme, & + cips, cipe, cjps, cjpe, ckps, ckpe ) + + !KAL this is the original WRF code + !CALL get_ijk_from_grid ( grid , & + ! cids, cide, cjds, cjde, ckds, ckde, & + ! cims, cime, cjms, cjme, ckms, ckme, & + ! cips, cipe, cjps, cjpe, ckps, ckpe ) + CALL get_ijk_from_grid ( ngrid , & + nids, nide, njds, njde, nkds, nkde, & + nims, nime, njms, njme, nkms, nkme, & + nips, nipe, njps, njpe, nkps, nkpe ) + + nlev = ckde - ckds + 1 + +#include "nest_interpdown_unpack.inc" + +if (ngrid%vert_refine_method .NE. 0) then + + !KAL calculating the vertical coordinate for parent and nest grid (code from ndown) + ! assume that the parent and nest have the same p_top value (as in ndown) + +!KAL ckde is equal to e_vert of the coarse grid. There are e_vert-1 u points. The coarse 1D grid here is e_vert+1, +! so it is the e_vert-1 points from the coarse grid, plus a surface point plus a top point. Extrapolation coefficients +! are used to get the surface and top points to fill out the pro_u_c 1D array of u values from the coarse grid. + + hsca_m = 6.7 !KAL scale height of the atmosphere + p_top_m = ngrid%p_top + p_surf_m = 1.e5 + mu_m = p_surf_m - p_top_m +! parent + do k = 1,ckde + pre_c = mu_m * pgrid%c3f(k) + p_top_m + pgrid%c4f(k) + alt_w_c(k) = -hsca_m * alog(pre_c/p_surf_m) + enddo + do k = 1,ckde-1 + pre_c = mu_m * pgrid%c3h(k) + p_top_m + pgrid%c4h(k) + alt_u_c(k+1) = -hsca_m * alog(pre_c/p_surf_m) + enddo + alt_u_c(1) = alt_w_c(1) + alt_u_c(ckde+1) = alt_w_c(ckde) +! nest + do k = 1,nkde + pre_n = mu_m * ngrid%c3f(k) + p_top_m + ngrid%c4f(k) + alt_w_n(k) = -hsca_m * alog(pre_n/p_surf_m) + enddo + do k = 1,nkde-1 + pre_n = mu_m * ngrid%c3h(k) + p_top_m + ngrid%c4h(k) + alt_u_n(k+1) = -hsca_m * alog(pre_n/p_surf_m) + enddo + alt_u_n(1) = alt_w_n(1) + alt_u_n(nkde+1) = alt_w_n(nkde) + +endif + + !KAL added this call for vertical nesting (return coarse grid dimensions to intended values) + CALL get_ijk_from_grid ( grid , & + cids, cide, cjds, cjde, ckds, ckde, & + cims, cime, cjms, cjme, ckms, ckme, & + cips, cipe, cjps, cjpe, ckps, ckpe ) + + CALL get_ijk_from_grid ( grid , & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + ips, ipe, jps, jpe, kps, kpe ) + + ! Vertical refinement is turned on. + + IF (ngrid%vert_refine_method .NE. 0) THEN + +#include "nest_forcedown_interp_vert.inc" + + IF ( ngrid%this_is_an_ideal_run ) THEN + IF ( SIZE( grid%t_init, 1 ) * SIZE( grid%t_init, 3 ) .GT. 1 ) THEN + CALL vert_interp_vert_nesting( grid%t_init, & !CD field + ids, ide, kds, kde, jds, jde, & !CD dims + ims, ime, kms, kme, jms, jme, & !CD dims + ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & !CD dims + pgrid%s_vert, pgrid%e_vert, & !vertical dimension of the parent grid + pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & !coarse grid extrapolation constants + alt_u_c, alt_u_n ) !coordinates for parent and nest + END IF ! Check t_init is a fully allocated 3d array. + END IF ! only for ideal runs + + + ! Rebalance the grid on the intermediate grid. The intermediate grid has the horizontal + ! resolution of the parent grid, but at this point has been interpolated in the vertical + ! to the resolution of the nest. The base state (phb, pb, etc) from the parent grid is + ! unpacked onto the intermediate grid every time this subroutine is called. We need the + ! base state of the nest, so it is recalculated here. + + ! Additionally, we do not need to vertically interpolate the entire intermediate grid + ! above, just the points that contribute to the boundary forcing. + + ! Base state potential temperature and inverse density (alpha = 1/rho) from + ! the half eta levels and the base-profile surface pressure. Compute 1/rho + ! from equation of state. The potential temperature is a perturbation from t0. + + ! Uncouple the variables moist and t_2 that are used to calculate ph_2 + + DO j = MAX(jds,jps),MIN(jde-1,jpe) + DO i = MAX(ids,ips),MIN(ide-1,ipe) + DO k=kds,kde-1 + grid%t_2(i,k,j) = grid%t_2(i,k,j)/((ngrid%c1h(k)*grid%mub(i,j)+ngrid%c2h(k)) + (ngrid%c1h(k)*grid%mu_2(i,j))) + moist(i,k,j,P_QV) = moist(i,k,j,P_QV)/((ngrid%c1h(k)*grid%mub(i,j)+ngrid%c2h(k)) + (ngrid%c1h(k)*grid%mu_2(i,j))) + END DO + END DO + END DO + + DO j = MAX(jds,jps),MIN(jde-1,jpe) + DO i = MAX(ids,ips),MIN(ide-1,ipe) + + DO k = 1, kpe-1 + grid%pb(i,k,j) = ngrid%c3h(k) * grid%mub(i,j) + ngrid%c4h(k) + ngrid%p_top + + ! If this is a real run, recalc t_init. + + IF ( .NOT. ngrid%this_is_an_ideal_run ) THEN + temp = MAX ( ngrid%tiso, ngrid%t00 + ngrid%tlp*LOG(grid%pb(i,k,j)/ngrid%p00) ) + IF ( grid%pb(i,k,j) .LT. ngrid%p_strat ) THEN + temp = ngrid%tiso + ngrid%tlp_strat * LOG ( grid%pb(i,k,j)/ngrid%p_strat ) + END IF + grid%t_init(i,k,j) = temp*(ngrid%p00/grid%pb(i,k,j))**(r_d/cp) - t0 + END IF + grid%alb(i,k,j) = (r_d/p1000mb)*(grid%t_init(i,k,j)+t0)*(grid%pb(i,k,j)/p1000mb)**cvpm + END DO + + ! Integrate base geopotential, starting at terrain elevation. This assures that + ! the base state is in exact hydrostatic balance with respect to the model equations. + ! This field is on full levels. + + grid%phb(i,1,j) = grid%ht(i,j) * g + IF (grid%hypsometric_opt == 1) THEN + DO kk = 2,kpe + k = kk - 1 + grid%phb(i,kk,j) = grid%phb(i,k,j) - ngrid%dnw(k)*(ngrid%c1h(k)*grid%mub(i,j)+ngrid%c2h(k))*grid%alb(i,k,j) + END DO + ELSE IF (grid%hypsometric_opt == 2) THEN + DO k = 2,kpe + pfu = ngrid%c3f(k )*grid%MUB(i,j) + ngrid%c4f(k ) + ngrid%p_top + pfd = ngrid%c3f(k-1)*grid%MUB(i,j) + ngrid%c4f(k-1) + ngrid%p_top + phm = ngrid%c3h(k-1)*grid%MUB(i,j) + ngrid%c4h(k-1) + ngrid%p_top + grid%phb(i,k,j) = grid%phb(i,k-1,j) + grid%alb(i,k-1,j)*phm*LOG(pfd/pfu) + END DO + ELSE + CALL wrf_error_fatal( 'module_dm: hypsometric_opt should be 1 or 2' ) + END IF ! which hypsometric option + END DO ! i loop + END DO ! j loop + ! Perturbation fields + ALLOCATE( p (ips:ipe, kps:kpe, jps:jpe) ) + ALLOCATE( al(ips:ipe, kps:kpe, jps:jpe) ) + DO j = MAX(jds,jps),MIN(jde-1,jpe) + DO i = MAX(ids,ips),MIN(ide-1,ipe) + ! Integrate the hydrostatic equation (from the RHS of the bigstep vertical momentum + ! equation) down from the top to get the pressure perturbation. First get the pressure + ! perturbation, moisture, and inverse density (total and perturbation) at the top-most level. + + kk = kpe-1 + k = kk+1 + + qvf1 = 0.5*(moist(i,kk,j,P_QV)+moist(i,kk,j,P_QV)) + qvf2 = 1./(1.+qvf1) + qvf1 = qvf1*qvf2 + + p(i,kk,j) = - 0.5*((ngrid%c1f(k)*grid%Mu_2(i,j))+qvf1*(ngrid%c1f(k)*grid%Mub(i,j)+ngrid%c2f(k)))/ngrid%rdnw(kk)/qvf2 + IF ( config_flags%use_theta_m == 0) THEN + qvf = 1. + rvovrd*moist(i,kk,j,P_QV) + ELSE + qvf = 1. + ENDIF + al(i,kk,j) = (r_d/p1000mb)*(grid%t_2(i,kk,j)+t0)*qvf* & + (((p(i,kk,j)+grid%pb(i,kk,j))/p1000mb)**cvpm) - grid%alb(i,kk,j) + + ! Now, integrate down the column to compute the pressure perturbation, and diagnose the two + ! inverse density fields (total and perturbation). + + DO kk=kpe-2,1,-1 + k = kk + 1 + qvf1 = 0.5*(moist(i,kk,j,P_QV)+moist(i,kk+1,j,P_QV)) + qvf2 = 1./(1.+qvf1) + qvf1 = qvf1*qvf2 + p(i,kk,j) = p(i,kk+1,j) - ((ngrid%c1f(k)*grid%Mu_2(i,j)) + qvf1*(ngrid%c1f(k)*grid%Mub(i,j)+ngrid%c2f(k)))/qvf2/ngrid%rdn(kk+1) + IF ( config_flags%use_theta_m == 0) THEN + qvf = 1. + rvovrd*moist(i,kk,j,P_QV) + ELSE + qvf = 1. + ENDIF + al(i,kk,j) = (r_d/p1000mb)*(grid%t_2(i,kk,j)+t0)*qvf* & + (((p(i,kk,j)+grid%pb(i,kk,j))/p1000mb)**cvpm) - grid%alb(i,kk,j) + END DO + + ! This is the hydrostatic equation used in the model after the small timesteps. In + ! the model, grid%al (inverse density) is computed from the geopotential. + + IF (grid%hypsometric_opt == 1) THEN + DO kk = 2,kpe + k = kk - 1 + grid%ph_2(i,kk,j) = grid%ph_2(i,kk-1,j) - & + ngrid%dnw(kk-1) * ( ((ngrid%c1h(k)*grid%mub(i,j)+ngrid%c2h(k))+(ngrid%c1h(k)*grid%mu_2(i,j)))*al(i,kk-1,j) & + + (ngrid%c1h(k)*grid%mu_2(i,j))*grid%alb(i,kk-1,j) ) + END DO + + ! Alternative hydrostatic eq.: dZ = -al*p*dLOG(p), where p is dry pressure. + ! Note that al*p approximates Rd*T and dLOG(p) does z. + ! Here T varies mostly linear with z, the first-order integration produces better result. + + ELSE IF (grid%hypsometric_opt == 2) THEN + + grid%ph_2(i,1,j) = grid%phb(i,1,j) + DO k = 2,kpe + pfu = ngrid%c3f(k )*( grid%MUB(i,j)+grid%MU_2(i,j) ) + ngrid%c4f(k ) + ngrid%p_top + pfd = ngrid%c3f(k-1)*( grid%MUB(i,j)+grid%MU_2(i,j) ) + ngrid%c4f(k-1) + ngrid%p_top + phm = ngrid%c3h(k-1)*( grid%MUB(i,j)+grid%MU_2(i,j) ) + ngrid%c4h(k-1) + ngrid%p_top + grid%ph_2(i,k,j) = grid%ph_2(i,k-1,j) + (grid%alb(i,k-1,j)+al(i,k-1,j))*phm*LOG(pfd/pfu) + END DO + + DO k = 1,kpe + grid%ph_2(i,k,j) = grid%ph_2(i,k,j) - grid%phb(i,k,j) + END DO + + END IF + + END DO ! i loop + END DO ! j loop + + DEALLOCATE(p) + DEALLOCATE(al) + + ! Couple the variables moist and t_2, and the newly calculated ph_2 + DO j = MAX(jds,jps),MIN(jde-1,jpe) + DO i = MAX(ids,ips),MIN(ide-1,ipe) + DO k=kps,kpe + grid%ph_2(i,k,j) = grid%ph_2(i,k,j)*((ngrid%c1f(k)*grid%Mub(i,j)+ngrid%c2f(k)) + (ngrid%c1f(k)*grid%Mu_2(i,j))) + END DO + END DO + END DO + DO j = MAX(jds,jps),MIN(jde-1,jpe) + DO i = MAX(ids,ips),MIN(ide-1,ipe) + DO k=kps,kpe-1 + grid%t_2(i,k,j) = grid%t_2(i,k,j)*((ngrid%c1h(k)*grid%mub(i,j)+ngrid%c2h(k)) + (ngrid%c1h(k)*grid%mu_2(i,j))) + moist(i,k,j,P_QV) = moist(i,k,j,P_QV)*((ngrid%c1h(k)*grid%mub(i,j)+ngrid%c2h(k)) + (ngrid%c1h(k)*grid%mu_2(i,j))) + END DO + END DO + END DO + + + END IF + + +#include "HALO_FORCE_DOWN.inc" + + ! code here to interpolate the data into the nested domain +# include "nest_forcedown_interp.inc" + + RETURN + END SUBROUTINE force_domain_em_part2 + +#endif diff --git a/external/RSL_LITE/interp_domain_em_part1.F90 b/external/RSL_LITE/interp_domain_em_part1.F90 new file mode 100644 index 0000000000..c7061f745c --- /dev/null +++ b/external/RSL_LITE/interp_domain_em_part1.F90 @@ -0,0 +1,105 @@ + +!------------------------------------------------------------------ + +#if ( EM_CORE == 1 && DA_CORE != 1 ) + +!------------------------------------------------------------------ + + SUBROUTINE interp_domain_em_part1 ( grid, intermediate_grid, ngrid, config_flags & +! +#include "dummy_new_args.inc" +! + ) + USE module_state_description + USE module_domain, ONLY : domain, get_ijk_from_grid + USE module_configure, ONLY : grid_config_rec_type + USE module_dm, ONLY : ntasks, ntasks_x, ntasks_y, itrace, local_communicator, & + nest_task_offsets, nest_pes_x, nest_pes_y, which_kid, & + intercomm_active, mpi_comm_to_kid, mpi_comm_to_mom, & + mytask, get_dm_max_halo_width + USE module_timing + IMPLICIT NONE +! + TYPE(domain), POINTER :: grid ! name of the grid being dereferenced (must be "grid") + TYPE(domain), POINTER :: intermediate_grid + TYPE(domain), POINTER :: ngrid +#include "dummy_new_decl.inc" + INTEGER nlev, msize + INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k + INTEGER iparstrt,jparstrt,sw + TYPE (grid_config_rec_type) :: config_flags + REAL xv(2000) + INTEGER :: cids, cide, cjds, cjde, ckds, ckde, & + cims, cime, cjms, cjme, ckms, ckme, & + cips, cipe, cjps, cjpe, ckps, ckpe + INTEGER :: iids, iide, ijds, ijde, ikds, ikde, & + iims, iime, ijms, ijme, ikms, ikme, & + iips, iipe, ijps, ijpe, ikps, ikpe + INTEGER :: nids, nide, njds, njde, nkds, nkde, & + nims, nime, njms, njme, nkms, nkme, & + nips, nipe, njps, njpe, nkps, nkpe + + INTEGER idim1,idim2,idim3,idim4,idim5,idim6,idim7 + + INTEGER icoord, jcoord, idim_cd, jdim_cd, pgr + INTEGER thisdomain_max_halo_width + INTEGER local_comm, myproc, nproc + INTEGER ioffset, ierr + + CALL wrf_get_dm_communicator ( local_comm ) + CALL wrf_get_myproc( myproc ) + CALL wrf_get_nproc( nproc ) + + CALL get_ijk_from_grid ( grid , & + cids, cide, cjds, cjde, ckds, ckde, & + cims, cime, cjms, cjme, ckms, ckme, & + cips, cipe, cjps, cjpe, ckps, ckpe ) + CALL get_ijk_from_grid ( intermediate_grid , & + iids, iide, ijds, ijde, ikds, ikde, & + iims, iime, ijms, ijme, ikms, ikme, & + iips, iipe, ijps, ijpe, ikps, ikpe ) + CALL get_ijk_from_grid ( ngrid , & + nids, nide, njds, njde, nkds, nkde, & + nims, nime, njms, njme, nkms, nkme, & + nips, nipe, njps, njpe, nkps, nkpe ) + + CALL nl_get_parent_grid_ratio ( ngrid%id, pgr ) + CALL nl_get_i_parent_start ( intermediate_grid%id, iparstrt ) + CALL nl_get_j_parent_start ( intermediate_grid%id, jparstrt ) + CALL nl_get_shw ( intermediate_grid%id, sw ) + icoord = iparstrt - sw + jcoord = jparstrt - sw + idim_cd = iide - iids + 1 + jdim_cd = ijde - ijds + 1 + + nlev = ckde - ckds + 1 + + ! get max_halo_width for parent. It may be smaller if it is moad + CALL get_dm_max_halo_width ( grid%id , thisdomain_max_halo_width ) + + IF ( grid%active_this_task ) THEN +#include "nest_interpdown_pack.inc" + END IF + + ! determine which communicator and offset to use + IF ( intercomm_active( grid%id ) ) THEN ! I am parent + local_comm = mpi_comm_to_kid( which_kid(ngrid%id), grid%id ) + ioffset = nest_task_offsets(ngrid%id) + ELSE IF ( intercomm_active( ngrid%id ) ) THEN ! I am nest + local_comm = mpi_comm_to_mom( ngrid%id ) + ioffset = nest_task_offsets(ngrid%id) + END IF + + IF ( grid%active_this_task .OR. ngrid%active_this_task ) THEN +#ifndef STUBMPI + CALL mpi_comm_rank(local_comm,myproc,ierr) + CALL mpi_comm_size(local_comm,nproc,ierr) +#endif + CALL rsl_lite_bcast_msgs( myproc, nest_pes_x(grid%id)*nest_pes_y(grid%id), & + nest_pes_x(ngrid%id)*nest_pes_y(ngrid%id), & + ioffset, local_comm ) + END IF + + RETURN + END SUBROUTINE interp_domain_em_part1 +#endif diff --git a/external/RSL_LITE/interp_domain_em_part2.F90 b/external/RSL_LITE/interp_domain_em_part2.F90 new file mode 100644 index 0000000000..be6a531c4d --- /dev/null +++ b/external/RSL_LITE/interp_domain_em_part2.F90 @@ -0,0 +1,187 @@ +!------------------------------------------------------------------ + +#if ( EM_CORE == 1 && DA_CORE != 1 ) + +!------------------------------------------------------------------ + + SUBROUTINE interp_domain_em_part2 ( grid, ngrid, pgrid, config_flags & +! +#include "dummy_new_args.inc" +! + ) + USE module_state_description + USE module_domain, ONLY : domain, get_ijk_from_grid + USE module_configure, ONLY : grid_config_rec_type + USE module_dm, ONLY : ntasks, ntasks_x, ntasks_y, itrace, local_communicator, & + mytask, get_dm_max_halo_width, which_kid + ! push_communicators_for_domain,pop_communicators_for_domain + USE module_comm_nesting_dm, ONLY : halo_interp_down_sub + IMPLICIT NONE +! + TYPE(domain), POINTER :: grid ! name of the grid being dereferenced (must be "grid") + TYPE(domain), POINTER :: ngrid + TYPE(domain), POINTER :: pgrid !KAL added for vertical nesting +#include "dummy_new_decl.inc" + INTEGER nlev, msize + INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k + TYPE (grid_config_rec_type) :: config_flags + REAL xv(2000) + INTEGER :: cids, cide, cjds, cjde, ckds, ckde, & + cims, cime, cjms, cjme, ckms, ckme, & + cips, cipe, cjps, cjpe, ckps, ckpe + INTEGER :: nids, nide, njds, njde, nkds, nkde, & + nims, nime, njms, njme, nkms, nkme, & + nips, nipe, njps, njpe, nkps, nkpe + INTEGER :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + ips, ipe, jps, jpe, kps, kpe + + INTEGER idim1,idim2,idim3,idim4,idim5,idim6,idim7 + + INTEGER myproc + INTEGER ierr + INTEGER thisdomain_max_halo_width + + !KAL variables for vertical nesting + REAL :: p_top_m , p_surf_m , mu_m , hsca_m , pre_c ,pre_n + REAL, DIMENSION(pgrid%s_vert:pgrid%e_vert) :: alt_w_c + REAL, DIMENSION(pgrid%s_vert:pgrid%e_vert+1) :: alt_u_c + REAL, DIMENSION(ngrid%s_vert:ngrid%e_vert) :: alt_w_n + REAL, DIMENSION(ngrid%s_vert:ngrid%e_vert+1) :: alt_u_n + + + !KAL change this for vertical nesting + ! interp_domain_em_part1 packs up the interpolation onto the coarse (vertical) grid + ! therefore the message size is based on the coarse grid number of levels + ! here it is unpacked onto the intermediate grid + CALL get_ijk_from_grid ( pgrid , & + cids, cide, cjds, cjde, ckds, ckde, & + cims, cime, cjms, cjme, ckms, ckme, & + cips, cipe, cjps, cjpe, ckps, ckpe ) + !KAL this is the original WRF code + !CALL get_ijk_from_grid ( grid , & + ! cids, cide, cjds, cjde, ckds, ckde, & + ! cims, cime, cjms, cjme, ckms, ckme, & + ! cips, cipe, cjps, cjpe, ckps, ckpe ) + CALL get_ijk_from_grid ( ngrid , & + nids, nide, njds, njde, nkds, nkde, & + nims, nime, njms, njme, nkms, nkme, & + nips, nipe, njps, njpe, nkps, nkpe ) + + nlev = ckde - ckds + 1 + + CALL get_dm_max_halo_width ( ngrid%id , thisdomain_max_halo_width ) + +#include "nest_interpdown_unpack.inc" + + +if (ngrid%vert_refine_method .NE. 0) then + + !KAL calculating the vertical coordinate for parent and nest grid (code from ndown) + ! assume that the parent and nest have the same p_top value (as in ndown) + +!KAL ckde is equal to e_vert of the coarse grid. There are e_vert-1 u points. The coarse 1D grid here is e_vert+1, +! so it is the e_vert-1 points from the coarse grid, plus a surface point plus a top point. Extrapolation coefficients +! are used to get the surface and top points to fill out the pro_u_c 1D array of u values from the coarse grid. + + hsca_m = 6.7 !KAL scale height of the atmosphere + p_top_m = ngrid%p_top + p_surf_m = 1.e5 + mu_m = p_surf_m - p_top_m +! parent + do k = 1,ckde + pre_c = mu_m * pgrid%c3f(k) + p_top_m + pgrid%c4f(k) + alt_w_c(k) = -hsca_m * alog(pre_c/p_surf_m) + enddo + do k = 1,ckde-1 + pre_c = mu_m * pgrid%c3h(k) + p_top_m + pgrid%c4h(k) + alt_u_c(k+1) = -hsca_m * alog(pre_c/p_surf_m) + enddo + alt_u_c(1) = alt_w_c(1) + alt_u_c(ckde+1) = alt_w_c(ckde) +! nest + do k = 1,nkde + pre_n = mu_m * ngrid%c3f(k) + p_top_m + ngrid%c4f(k) + alt_w_n(k) = -hsca_m * alog(pre_n/p_surf_m) + enddo + do k = 1,nkde-1 + pre_n = mu_m * ngrid%c3h(k) + p_top_m + ngrid%c4h(k) + alt_u_n(k+1) = -hsca_m * alog(pre_n/p_surf_m) + enddo + alt_u_n(1) = alt_w_n(1) + alt_u_n(nkde+1) = alt_w_n(nkde) +endif + + + + !KAL added this call for vertical nesting (return coarse grid dimensions to intended values) + CALL get_ijk_from_grid ( grid , & + cids, cide, cjds, cjde, ckds, ckde, & + cims, cime, cjms, cjme, ckms, ckme, & + cips, cipe, cjps, cjpe, ckps, ckpe ) + + CALL get_ijk_from_grid ( grid , & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + ips, ipe, jps, jpe, kps, kpe ) + + +if (ngrid%vert_refine_method .NE. 0) then + +!KAL added this code (the include file) for the vertical nesting +#include "nest_interpdown_interp_vert.inc" + + + !KAL finish off the 1-D variables (t_base, u_base, v_base, qv_base, and z_base) (move this out of here if alt_u_c and alt_u_n are calculated elsewhere) + CALL vert_interp_vert_nesting_1d ( & + ngrid%t_base, & ! CD field + ids, ide, kds, kde, jds, jde, & ! CD dims + ims, ime, kms, kme, jms, jme, & ! CD dims + ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & ! CD dims + pgrid%s_vert, pgrid%e_vert, & ! vertical dimension of the parent grid + pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & ! coarse grid extrapolation constants + alt_u_c, alt_u_n) ! coordinates for parent and nest + CALL vert_interp_vert_nesting_1d ( & + ngrid%u_base, & ! CD field + ids, ide, kds, kde, jds, jde, & ! CD dims + ims, ime, kms, kme, jms, jme, & ! CD dims + ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & ! CD dims + pgrid%s_vert, pgrid%e_vert, & ! vertical dimension of the parent grid + pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & ! coarse grid extrapolation constants + alt_u_c, alt_u_n) ! coordinates for parent and nest + CALL vert_interp_vert_nesting_1d ( & + ngrid%v_base, & ! CD field + ids, ide, kds, kde, jds, jde, & ! CD dims + ims, ime, kms, kme, jms, jme, & ! CD dims + ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & ! CD dims + pgrid%s_vert, pgrid%e_vert, & ! vertical dimension of the parent grid + pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & ! coarse grid extrapolation constants + alt_u_c, alt_u_n) ! coordinates for parent and nest + CALL vert_interp_vert_nesting_1d ( & + ngrid%qv_base, & ! CD field + ids, ide, kds, kde, jds, jde, & ! CD dims + ims, ime, kms, kme, jms, jme, & ! CD dims + ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & ! CD dims + pgrid%s_vert, pgrid%e_vert, & ! vertical dimension of the parent grid + pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & ! coarse grid extrapolation constants + alt_u_c, alt_u_n) ! coordinates for parent and nest + CALL vert_interp_vert_nesting_1d ( & + ngrid%z_base, & ! CD field + ids, ide, kds, kde, jds, jde, & ! CD dims + ims, ime, kms, kme, jms, jme, & ! CD dims + ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & ! CD dims + pgrid%s_vert, pgrid%e_vert, & ! vertical dimension of the parent grid + pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & ! coarse grid extrapolation constants + alt_u_c, alt_u_n) ! coordinates for parent and nest + +endif + + CALL push_communicators_for_domain( grid%id ) + +#include "HALO_INTERP_DOWN.inc" + + CALL pop_communicators_for_domain + + RETURN + END SUBROUTINE interp_domain_em_part2 +#endif diff --git a/external/RSL_LITE/interp_domain_em_part3.F90 b/external/RSL_LITE/interp_domain_em_part3.F90 new file mode 100644 index 0000000000..090beb0e8d --- /dev/null +++ b/external/RSL_LITE/interp_domain_em_part3.F90 @@ -0,0 +1,49 @@ +!------------------------------------------------------------------ + +#if ( EM_CORE == 1 && DA_CORE != 1 ) + +!------------------------------------------------------------------ + + SUBROUTINE interp_domain_em_part3 ( grid, ngrid, pgrid, config_flags & +! +#include "dummy_new_args.inc" +! + ) + USE module_state_description + USE module_domain, ONLY : domain, get_ijk_from_grid + USE module_configure, ONLY : grid_config_rec_type + USE module_dm, ONLY : ntasks, ntasks_x, ntasks_y, itrace, local_communicator, & + mytask, get_dm_max_halo_width, which_kid + ! push_communicators_for_domain,pop_communicators_for_domain + USE module_comm_nesting_dm, ONLY : halo_interp_down_sub + IMPLICIT NONE +! + TYPE(domain), POINTER :: grid ! name of the grid being dereferenced (must be "grid") + TYPE(domain), POINTER :: ngrid + TYPE(domain), POINTER :: pgrid !KAL added for vertical nesting +#include "dummy_new_decl.inc" + INTEGER nlev, msize + INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k + TYPE (grid_config_rec_type) :: config_flags + REAL xv(2000) + INTEGER :: cids, cide, cjds, cjde, ckds, ckde, & + cims, cime, cjms, cjme, ckms, ckme, & + cips, cipe, cjps, cjpe, ckps, ckpe + INTEGER :: nids, nide, njds, njde, nkds, nkde, & + nims, nime, njms, njme, nkms, nkme, & + nips, nipe, njps, njpe, nkps, nkpe + INTEGER :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + ips, ipe, jps, jpe, kps, kpe + + INTEGER idim1,idim2,idim3,idim4,idim5,idim6,idim7 + + INTEGER myproc + INTEGER ierr + INTEGER thisdomain_max_halo_width + +# include "nest_interpdown_interp.inc" + + RETURN + END SUBROUTINE interp_domain_em_part3 +#endif diff --git a/external/RSL_LITE/interp_domain_em_small.F90 b/external/RSL_LITE/interp_domain_em_small.F90 new file mode 100644 index 0000000000..cfb175a95f --- /dev/null +++ b/external/RSL_LITE/interp_domain_em_small.F90 @@ -0,0 +1,411 @@ + +!------------------------------------------------------------------ + +#if ( EM_CORE == 1 && DA_CORE != 1 ) + +!------------------------------------------------------------------ + + SUBROUTINE interp_domain_em_small_part1 ( grid, intermediate_grid, ngrid, config_flags & +! +#include "dummy_new_args.inc" +! + ) + USE module_state_description + USE module_domain, ONLY : domain, get_ijk_from_grid + USE module_configure, ONLY : grid_config_rec_type + USE module_comm_dm, ONLY: halo_em_horiz_interp_sub + USE module_dm, ONLY : ntasks, ntasks_x, ntasks_y, itrace, local_communicator, & + mytask, get_dm_max_halo_width, & + nest_task_offsets, mpi_comm_to_kid, mpi_comm_to_mom, & + which_kid, nest_pes_x, nest_pes_y, intercomm_active + USE module_timing + IMPLICIT NONE +! + TYPE(domain), POINTER :: grid ! name of the grid being dereferenced (must be "grid") + TYPE(domain), POINTER :: intermediate_grid + TYPE(domain), POINTER :: ngrid +#include "dummy_new_decl.inc" + INTEGER nlev, msize + INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k + INTEGER iparstrt,jparstrt,sw + TYPE (grid_config_rec_type) :: config_flags + REAL xv(2000) + INTEGER :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + ips, ipe, jps, jpe, kps, kpe + + INTEGER :: cids, cide, cjds, cjde, ckds, ckde, & + cims, cime, cjms, cjme, ckms, ckme, & + cips, cipe, cjps, cjpe, ckps, ckpe + INTEGER :: iids, iide, ijds, ijde, ikds, ikde, & + iims, iime, ijms, ijme, ikms, ikme, & + iips, iipe, ijps, ijpe, ikps, ikpe + INTEGER :: nids, nide, njds, njde, nkds, nkde, & + nims, nime, njms, njme, nkms, nkme, & + nips, nipe, njps, njpe, nkps, nkpe + + INTEGER idim1,idim2,idim3,idim4,idim5,idim6,idim7 + + INTEGER icoord, jcoord, idim_cd, jdim_cd, pgr + INTEGER thisdomain_max_halo_width + INTEGER local_comm, myproc, nproc + INTEGER ioffset + + CALL wrf_get_dm_communicator ( local_comm ) + CALL wrf_get_myproc( myproc ) + CALL wrf_get_nproc( nproc ) + + CALL get_ijk_from_grid ( grid , & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + ips, ipe, jps, jpe, kps, kpe ) +#ifdef DM_PARALLEL +# include "HALO_EM_HORIZ_INTERP.inc" +#endif + + CALL get_ijk_from_grid ( grid , & + cids, cide, cjds, cjde, ckds, ckde, & + cims, cime, cjms, cjme, ckms, ckme, & + cips, cipe, cjps, cjpe, ckps, ckpe ) + CALL get_ijk_from_grid ( intermediate_grid , & + iids, iide, ijds, ijde, ikds, ikde, & + iims, iime, ijms, ijme, ikms, ikme, & + iips, iipe, ijps, ijpe, ikps, ikpe ) + CALL get_ijk_from_grid ( ngrid , & + nids, nide, njds, njde, nkds, nkde, & + nims, nime, njms, njme, nkms, nkme, & + nips, nipe, njps, njpe, nkps, nkpe ) + + CALL nl_get_parent_grid_ratio ( ngrid%id, pgr ) + CALL nl_get_i_parent_start ( intermediate_grid%id, iparstrt ) + CALL nl_get_j_parent_start ( intermediate_grid%id, jparstrt ) + CALL nl_get_shw ( intermediate_grid%id, sw ) + icoord = iparstrt - sw + jcoord = jparstrt - sw + idim_cd = iide - iids + 1 + jdim_cd = ijde - ijds + 1 + + nlev = ckde - ckds + 1 + + ! get max_halo_width for parent. It may be smaller if it is moad + CALL get_dm_max_halo_width ( grid%id , thisdomain_max_halo_width ) + + ! How many 3d arrays, so far just 3d theta-300 and geopotential perturbation, + ! and the 2d topo elevation, three max press/temp/height fields, and three + ! min press/temp/height fields. + + msize = ( 2 )* nlev + 7 + +!call wrf_debug(0,'/external/RSL_LITE/module_dm.F, calling rsl_lite_to_child') + CALL rsl_lite_to_child_info( local_communicator, msize*RWORDSIZE & + ,cips,cipe,cjps,cjpe & + ,iids,iide,ijds,ijde & + ,nids,nide,njds,njde & + ,pgr , sw & + ,ntasks_x,ntasks_y & + ,thisdomain_max_halo_width & + ,icoord,jcoord & + ,idim_cd,jdim_cd & + ,pig,pjg,retval ) +!call wrf_debug(0,'/external/RSL_LITE/module_dm.F, back from rsl_lite_to_child') + DO while ( retval .eq. 1 ) + IF ( SIZE(grid%ph_2) .GT. 1 ) THEN +!call wrf_debug(0,'/external/RSL_LITE/module_dm.F, ph_2') + DO k = ckds,ckde + xv(k)= grid%ph_2(pig,k,pjg) + END DO + CALL rsl_lite_to_child_msg(((ckde)-(ckds)+1)*RWORDSIZE,xv) + END IF + + IF ( SIZE(grid%t_2) .GT. 1 ) THEN +!call wrf_debug(0,'/external/RSL_LITE/module_dm.F, t_2') + DO k = ckds,(ckde-1) + xv(k)= grid%t_2(pig,k,pjg) + END DO + CALL rsl_lite_to_child_msg((((ckde-1))-(ckds)+1)*RWORDSIZE,xv) + END IF + + IF ( SIZE(grid%ht) .GT. 1 ) THEN +!call wrf_debug(0,'/external/RSL_LITE/module_dm.F, ht') + xv(1)= grid%ht(pig,pjg) + CALL rsl_lite_to_child_msg(RWORDSIZE,xv) + END IF + + IF ( SIZE(grid%t_max_p) .GT. 1 ) THEN +!call wrf_debug(0,'/external/RSL_LITE/module_dm.F, t_max_p') + xv(1)= grid%t_max_p(pig,pjg) + CALL rsl_lite_to_child_msg(RWORDSIZE,xv) + END IF + + IF ( SIZE(grid%ght_max_p) .GT. 1 ) THEN +!call wrf_debug(0,'/external/RSL_LITE/module_dm.F, ght_max_p') + xv(1)= grid%ght_max_p(pig,pjg) + CALL rsl_lite_to_child_msg(RWORDSIZE,xv) + END IF + + IF ( SIZE(grid%max_p) .GT. 1 ) THEN +!call wrf_debug(0,'/external/RSL_LITE/module_dm.F, max_p') + xv(1)= grid%max_p(pig,pjg) + CALL rsl_lite_to_child_msg(RWORDSIZE,xv) + END IF + + IF ( SIZE(grid%t_min_p) .GT. 1 ) THEN +!call wrf_debug(0,'/external/RSL_LITE/module_dm.F, t_min_p') + xv(1)= grid%t_min_p(pig,pjg) + CALL rsl_lite_to_child_msg(RWORDSIZE,xv) + END IF + + IF ( SIZE(grid%ght_min_p) .GT. 1 ) THEN +!call wrf_debug(0,'/external/RSL_LITE/module_dm.F, ght_min_p') + xv(1)= grid%ght_min_p(pig,pjg) + CALL rsl_lite_to_child_msg(RWORDSIZE,xv) + END IF + + IF ( SIZE(grid%min_p) .GT. 1 ) THEN +!call wrf_debug(0,'/external/RSL_LITE/module_dm.F, min_p') + xv(1)= grid%min_p(pig,pjg) + CALL rsl_lite_to_child_msg(RWORDSIZE,xv) + END IF + +!call wrf_debug(0,'/external/RSL_LITE/module_dm.F, calling rsl_lite_to_child_info') + CALL rsl_lite_to_child_info( local_communicator, msize*RWORDSIZE & + ,cips,cipe,cjps,cjpe & + ,iids,iide,ijds,ijde & + ,nids,nide,njds,njde & + ,pgr , sw & + ,ntasks_x,ntasks_y & + ,thisdomain_max_halo_width & + ,icoord,jcoord & + ,idim_cd,jdim_cd & + ,pig,pjg,retval ) +!call wrf_debug(0,'/external/RSL_LITE/module_dm.F, back from rsl_lite_to_child_info') + END DO + + ! determine which communicator and offset to use + IF ( intercomm_active( grid%id ) ) THEN ! I am parent + local_comm = mpi_comm_to_kid( which_kid(ngrid%id), grid%id ) + ioffset = nest_task_offsets(ngrid%id) + ELSE IF ( intercomm_active( ngrid%id ) ) THEN ! I am nest + local_comm = mpi_comm_to_mom( ngrid%id ) + ioffset = nest_task_offsets(ngrid%id) + END IF + +!call wrf_debug(0,'/external/RSL_LITE/module_dm.F, calling rsl_lite_bcast') + CALL rsl_lite_bcast_msgs( myproc, nest_pes_x(grid%id)*nest_pes_y(grid%id), & + nest_pes_x(ngrid%id)*nest_pes_y(ngrid%id), & + ioffset, local_comm ) +!call wrf_debug(0,'/external/RSL_LITE/module_dm.F, back from rsl_lite_bcast') + + RETURN + END SUBROUTINE interp_domain_em_small_part1 + +!------------------------------------------------------------------ + + SUBROUTINE interp_domain_em_small_part2 ( grid, ngrid, config_flags & +! +#include "dummy_new_args.inc" +! + ) + USE module_state_description + USE module_domain, ONLY : domain, get_ijk_from_grid + USE module_configure, ONLY : grid_config_rec_type + USE module_dm, ONLY : ntasks, ntasks_x, ntasks_y, itrace, local_communicator, & + mytask, get_dm_max_halo_width + USE module_comm_nesting_dm, ONLY : halo_interp_down_sub + IMPLICIT NONE +! + TYPE(domain), POINTER :: grid ! name of the grid being dereferenced (must be "grid") + TYPE(domain), POINTER :: ngrid +#include "dummy_new_decl.inc" + INTEGER nlev, msize + INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k + TYPE (grid_config_rec_type) :: config_flags + REAL xv(2000) + INTEGER :: cids, cide, cjds, cjde, ckds, ckde, & + cims, cime, cjms, cjme, ckms, ckme, & + cips, cipe, cjps, cjpe, ckps, ckpe + INTEGER :: nids, nide, njds, njde, nkds, nkde, & + nims, nime, njms, njme, nkms, nkme, & + nips, nipe, njps, njpe, nkps, nkpe + INTEGER :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + ips, ipe, jps, jpe, kps, kpe + + INTEGER idim1,idim2,idim3,idim4,idim5,idim6,idim7 + + INTEGER myproc + INTEGER ierr + INTEGER thisdomain_max_halo_width + + CALL get_ijk_from_grid ( grid , & + cids, cide, cjds, cjde, ckds, ckde, & + cims, cime, cjms, cjme, ckms, ckme, & + cips, cipe, cjps, cjpe, ckps, ckpe ) + CALL get_ijk_from_grid ( ngrid , & + nids, nide, njds, njde, nkds, nkde, & + nims, nime, njms, njme, nkms, nkme, & + nips, nipe, njps, njpe, nkps, nkpe ) + + nlev = ckde - ckds + 1 + + CALL get_dm_max_halo_width ( ngrid%id , thisdomain_max_halo_width ) + + CALL rsl_lite_from_parent_info(pig,pjg,retval) + + DO while ( retval .eq. 1 ) + + IF ( SIZE(grid%ph_2) .GT. 1 ) THEN + CALL rsl_lite_from_parent_msg(((ckde)-(ckds)+1)*RWORDSIZE,xv) + DO k = ckds,ckde + grid%ph_2(pig,k,pjg) = xv(k) + END DO + END IF + + IF ( SIZE(grid%t_2) .GT. 1 ) THEN + CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*RWORDSIZE,xv) + DO k = ckds,(ckde-1) + grid%t_2(pig,k,pjg) = xv(k) + END DO + END IF + + IF ( SIZE(grid%ht) .GT. 1 ) THEN + CALL rsl_lite_from_parent_msg(RWORDSIZE,xv) + grid%ht(pig,pjg) = xv(1) + END IF + + IF ( SIZE(grid%t_max_p) .GT. 1 ) THEN + CALL rsl_lite_from_parent_msg(RWORDSIZE,xv) + grid%t_max_p(pig,pjg) = xv(1) + END IF + + IF ( SIZE(grid%ght_max_p) .GT. 1 ) THEN + CALL rsl_lite_from_parent_msg(RWORDSIZE,xv) + grid%ght_max_p(pig,pjg) = xv(1) + END IF + + IF ( SIZE(grid%max_p) .GT. 1 ) THEN + CALL rsl_lite_from_parent_msg(RWORDSIZE,xv) + grid%max_p(pig,pjg) = xv(1) + END IF + + IF ( SIZE(grid%t_min_p) .GT. 1 ) THEN + CALL rsl_lite_from_parent_msg(RWORDSIZE,xv) + grid%t_min_p(pig,pjg) = xv(1) + END IF + + IF ( SIZE(grid%ght_min_p) .GT. 1 ) THEN + CALL rsl_lite_from_parent_msg(RWORDSIZE,xv) + grid%ght_min_p(pig,pjg) = xv(1) + END IF + + IF ( SIZE(grid%min_p) .GT. 1 ) THEN + CALL rsl_lite_from_parent_msg(RWORDSIZE,xv) + grid%min_p(pig,pjg) = xv(1) + END IF + + CALL rsl_lite_from_parent_info(pig,pjg,retval) + + END DO + + CALL get_ijk_from_grid ( grid , & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + ips, ipe, jps, jpe, kps, kpe ) + +#include "HALO_INTERP_DOWN.inc" + + CALL interp_fcn_bl ( grid%ph_2, & + cids, cide, ckds, ckde, cjds, cjde, & + cims, cime, ckms, ckme, cjms, cjme, & + cips, cipe, ckps, MIN( ckde, ckpe ), cjps, cjpe, & + ngrid%ph_2, & + nids, nide, nkds, nkde, njds, njde, & + nims, nime, nkms, nkme, njms, njme, & + nips, nipe, nkps, MIN( nkde, nkpe ), njps, njpe, & + config_flags%shw, ngrid%imask_nostag, & + .FALSE., .FALSE., & + ngrid%i_parent_start, ngrid%j_parent_start, & + ngrid%parent_grid_ratio, ngrid%parent_grid_ratio, & + grid%ht, ngrid%ht, & + grid%t_max_p, ngrid%t_max_p, & + grid%ght_max_p, ngrid%ght_max_p, & + grid%max_p, ngrid%max_p, & + grid%t_min_p, ngrid%t_min_p, & + grid%ght_min_p, ngrid%ght_min_p, & + grid%min_p, ngrid%min_p, & + ngrid%znw, ngrid%p_top ) + + CALL interp_fcn_bl ( grid%t_2, & + cids, cide, ckds, ckde, cjds, cjde, & + cims, cime, ckms, ckme, cjms, cjme, & + cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & + ngrid%t_2, & + nids, nide, nkds, nkde, njds, njde, & + nims, nime, nkms, nkme, njms, njme, & + nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & + config_flags%shw, ngrid%imask_nostag, & + .FALSE., .FALSE., & + ngrid%i_parent_start, ngrid%j_parent_start, & + ngrid%parent_grid_ratio, ngrid%parent_grid_ratio, & + grid%ht, ngrid%ht, & + grid%t_max_p, ngrid%t_max_p, & + grid%ght_max_p, ngrid%ght_max_p, & + grid%max_p, ngrid%max_p, & + grid%t_min_p, ngrid%t_min_p, & + grid%ght_min_p, ngrid%ght_min_p, & + grid%min_p, ngrid%min_p, & + ngrid%znu, ngrid%p_top ) + + RETURN + END SUBROUTINE interp_domain_em_small_part2 + +!------------------------------------------------------------------ + + SUBROUTINE feedback_nest_prep ( grid, config_flags & +! +#include "dummy_new_args.inc" +! +) + USE module_state_description + USE module_domain, ONLY : domain, get_ijk_from_grid + USE module_configure, ONLY : grid_config_rec_type + USE module_dm, ONLY : ntasks, ntasks_x, ntasks_y, itrace, local_communicator, mytask !, & + !push_communicators_for_domain, pop_communicators_for_domain + USE module_comm_nesting_dm, ONLY : halo_interp_up_sub + IMPLICIT NONE +! + TYPE(domain), TARGET :: grid ! name of the grid being dereferenced (must be "grid") + TYPE (grid_config_rec_type) :: config_flags ! configureation flags, has vertical dim of + ! soil temp, moisture, etc., has vertical dim + ! of soil categories +#include "dummy_new_decl.inc" + + INTEGER :: ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + ips, ipe, jps, jpe, kps, kpe + + INTEGER idim1,idim2,idim3,idim4,idim5,idim6,idim7 + + INTEGER :: idum1, idum2 + + + CALL get_ijk_from_grid ( grid , & + ids, ide, jds, jde, kds, kde, & + ims, ime, jms, jme, kms, kme, & + ips, ipe, jps, jpe, kps, kpe ) + + IF ( grid%active_this_task ) THEN + CALL push_communicators_for_domain( grid%id ) + +#ifdef DM_PARALLEL +#include "HALO_INTERP_UP.inc" +#endif + + CALL pop_communicators_for_domain + END IF + + END SUBROUTINE feedback_nest_prep + +!------------------------------------------------------------------ + +#endif diff --git a/external/RSL_LITE/module_dm.F b/external/RSL_LITE/module_dm.F index 5c9bb62a67..ea166ae384 100644 --- a/external/RSL_LITE/module_dm.F +++ b/external/RSL_LITE/module_dm.F @@ -3918,1320 +3918,6 @@ SUBROUTINE wrf_dm_nestexchange_init END SUBROUTINE wrf_dm_nestexchange_init -!------------------------------------------------------------------ - -#if ( EM_CORE == 1 && DA_CORE != 1 ) - -!------------------------------------------------------------------ - - SUBROUTINE force_domain_em_part2 ( grid, ngrid, pgrid, config_flags & -! -#include "dummy_new_args.inc" -! - ) - USE module_state_description - USE module_domain, ONLY : domain, get_ijk_from_grid - USE module_configure, ONLY : grid_config_rec_type - USE module_dm, ONLY : ntasks, ntasks_x, ntasks_y, local_communicator, mytask, & - nest_pes_x, nest_pes_y ! , & - !push_communicators_for_domain,pop_communicators_for_domain - USE module_comm_nesting_dm, ONLY : halo_force_down_sub - USE module_model_constants - IMPLICIT NONE -! - TYPE(domain), POINTER :: grid ! name of the grid being dereferenced (must be "grid") - TYPE(domain), POINTER :: ngrid - TYPE(domain), POINTER :: pgrid !KAL added for vertical nesting -#include "dummy_new_decl.inc" - INTEGER nlev, msize - INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k,kk - TYPE (grid_config_rec_type) :: config_flags - REAL xv(2000) - INTEGER :: cids, cide, cjds, cjde, ckds, ckde, & - cims, cime, cjms, cjme, ckms, ckme, & - cips, cipe, cjps, cjpe, ckps, ckpe - INTEGER :: nids, nide, njds, njde, nkds, nkde, & - nims, nime, njms, njme, nkms, nkme, & - nips, nipe, njps, njpe, nkps, nkpe - INTEGER :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - ips, ipe, jps, jpe, kps, kpe - INTEGER idim1,idim2,idim3,idim4,idim5,idim6,idim7,itrace - REAL dummy_xs, dummy_xe, dummy_ys, dummy_ye - - !KAL variables for vertical nesting - REAL :: p_top_m , p_surf_m , mu_m , hsca_m , pre_c ,pre_n - REAL, DIMENSION(pgrid%s_vert:pgrid%e_vert) :: alt_w_c - REAL, DIMENSION(pgrid%s_vert:pgrid%e_vert+1) :: alt_u_c - REAL, DIMENSION(ngrid%s_vert:ngrid%e_vert) :: alt_w_n - REAL, DIMENSION(ngrid%s_vert:ngrid%e_vert+1) :: alt_u_n - - REAL, DIMENSION(:,:,:), ALLOCATABLE :: p, al - REAL :: pfu, pfd, phm, temp, qvf, qvf1, qvf2 - - !KAL change this for vertical nesting - ! force_domain_em_part1 packs up the interpolation onto the coarse (vertical) grid - ! therefore the message size is based on the coarse grid number of levels - ! here it is unpacked onto the intermediate grid - CALL get_ijk_from_grid ( pgrid , & - cids, cide, cjds, cjde, ckds, ckde, & - cims, cime, cjms, cjme, ckms, ckme, & - cips, cipe, cjps, cjpe, ckps, ckpe ) - - !KAL this is the original WRF code - !CALL get_ijk_from_grid ( grid , & - ! cids, cide, cjds, cjde, ckds, ckde, & - ! cims, cime, cjms, cjme, ckms, ckme, & - ! cips, cipe, cjps, cjpe, ckps, ckpe ) - CALL get_ijk_from_grid ( ngrid , & - nids, nide, njds, njde, nkds, nkde, & - nims, nime, njms, njme, nkms, nkme, & - nips, nipe, njps, njpe, nkps, nkpe ) - - nlev = ckde - ckds + 1 - -#include "nest_interpdown_unpack.inc" - -if (ngrid%vert_refine_method .NE. 0) then - - !KAL calculating the vertical coordinate for parent and nest grid (code from ndown) - ! assume that the parent and nest have the same p_top value (as in ndown) - -!KAL ckde is equal to e_vert of the coarse grid. There are e_vert-1 u points. The coarse 1D grid here is e_vert+1, -! so it is the e_vert-1 points from the coarse grid, plus a surface point plus a top point. Extrapolation coefficients -! are used to get the surface and top points to fill out the pro_u_c 1D array of u values from the coarse grid. - - hsca_m = 6.7 !KAL scale height of the atmosphere - p_top_m = ngrid%p_top - p_surf_m = 1.e5 - mu_m = p_surf_m - p_top_m -! parent - do k = 1,ckde - pre_c = mu_m * pgrid%c3f(k) + p_top_m + pgrid%c4f(k) - alt_w_c(k) = -hsca_m * alog(pre_c/p_surf_m) - enddo - do k = 1,ckde-1 - pre_c = mu_m * pgrid%c3h(k) + p_top_m + pgrid%c4h(k) - alt_u_c(k+1) = -hsca_m * alog(pre_c/p_surf_m) - enddo - alt_u_c(1) = alt_w_c(1) - alt_u_c(ckde+1) = alt_w_c(ckde) -! nest - do k = 1,nkde - pre_n = mu_m * ngrid%c3f(k) + p_top_m + ngrid%c4f(k) - alt_w_n(k) = -hsca_m * alog(pre_n/p_surf_m) - enddo - do k = 1,nkde-1 - pre_n = mu_m * ngrid%c3h(k) + p_top_m + ngrid%c4h(k) - alt_u_n(k+1) = -hsca_m * alog(pre_n/p_surf_m) - enddo - alt_u_n(1) = alt_w_n(1) - alt_u_n(nkde+1) = alt_w_n(nkde) - -endif - - !KAL added this call for vertical nesting (return coarse grid dimensions to intended values) - CALL get_ijk_from_grid ( grid , & - cids, cide, cjds, cjde, ckds, ckde, & - cims, cime, cjms, cjme, ckms, ckme, & - cips, cipe, cjps, cjpe, ckps, ckpe ) - - CALL get_ijk_from_grid ( grid , & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - ips, ipe, jps, jpe, kps, kpe ) - - ! Vertical refinement is turned on. - - IF (ngrid%vert_refine_method .NE. 0) THEN - -#include "nest_forcedown_interp_vert.inc" - - IF ( ngrid%this_is_an_ideal_run ) THEN - IF ( SIZE( grid%t_init, 1 ) * SIZE( grid%t_init, 3 ) .GT. 1 ) THEN - CALL vert_interp_vert_nesting( grid%t_init, & !CD field - ids, ide, kds, kde, jds, jde, & !CD dims - ims, ime, kms, kme, jms, jme, & !CD dims - ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & !CD dims - pgrid%s_vert, pgrid%e_vert, & !vertical dimension of the parent grid - pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & !coarse grid extrapolation constants - alt_u_c, alt_u_n ) !coordinates for parent and nest - END IF ! Check t_init is a fully allocated 3d array. - END IF ! only for ideal runs - - - ! Rebalance the grid on the intermediate grid. The intermediate grid has the horizontal - ! resolution of the parent grid, but at this point has been interpolated in the vertical - ! to the resolution of the nest. The base state (phb, pb, etc) from the parent grid is - ! unpacked onto the intermediate grid every time this subroutine is called. We need the - ! base state of the nest, so it is recalculated here. - - ! Additionally, we do not need to vertically interpolate the entire intermediate grid - ! above, just the points that contribute to the boundary forcing. - - ! Base state potential temperature and inverse density (alpha = 1/rho) from - ! the half eta levels and the base-profile surface pressure. Compute 1/rho - ! from equation of state. The potential temperature is a perturbation from t0. - - ! Uncouple the variables moist and t_2 that are used to calculate ph_2 - - DO j = MAX(jds,jps),MIN(jde-1,jpe) - DO i = MAX(ids,ips),MIN(ide-1,ipe) - DO k=kds,kde-1 - grid%t_2(i,k,j) = grid%t_2(i,k,j)/((ngrid%c1h(k)*grid%mub(i,j)+ngrid%c2h(k)) + (ngrid%c1h(k)*grid%mu_2(i,j))) - moist(i,k,j,P_QV) = moist(i,k,j,P_QV)/((ngrid%c1h(k)*grid%mub(i,j)+ngrid%c2h(k)) + (ngrid%c1h(k)*grid%mu_2(i,j))) - END DO - END DO - END DO - - DO j = MAX(jds,jps),MIN(jde-1,jpe) - DO i = MAX(ids,ips),MIN(ide-1,ipe) - - DO k = 1, kpe-1 - grid%pb(i,k,j) = ngrid%c3h(k) * grid%mub(i,j) + ngrid%c4h(k) + ngrid%p_top - - ! If this is a real run, recalc t_init. - - IF ( .NOT. ngrid%this_is_an_ideal_run ) THEN - temp = MAX ( ngrid%tiso, ngrid%t00 + ngrid%tlp*LOG(grid%pb(i,k,j)/ngrid%p00) ) - IF ( grid%pb(i,k,j) .LT. ngrid%p_strat ) THEN - temp = ngrid%tiso + ngrid%tlp_strat * LOG ( grid%pb(i,k,j)/ngrid%p_strat ) - END IF - grid%t_init(i,k,j) = temp*(ngrid%p00/grid%pb(i,k,j))**(r_d/cp) - t0 - END IF - grid%alb(i,k,j) = (r_d/p1000mb)*(grid%t_init(i,k,j)+t0)*(grid%pb(i,k,j)/p1000mb)**cvpm - END DO - - ! Integrate base geopotential, starting at terrain elevation. This assures that - ! the base state is in exact hydrostatic balance with respect to the model equations. - ! This field is on full levels. - - grid%phb(i,1,j) = grid%ht(i,j) * g - IF (grid%hypsometric_opt == 1) THEN - DO kk = 2,kpe - k = kk - 1 - grid%phb(i,kk,j) = grid%phb(i,k,j) - ngrid%dnw(k)*(ngrid%c1h(k)*grid%mub(i,j)+ngrid%c2h(k))*grid%alb(i,k,j) - END DO - ELSE IF (grid%hypsometric_opt == 2) THEN - DO k = 2,kpe - pfu = ngrid%c3f(k )*grid%MUB(i,j) + ngrid%c4f(k ) + ngrid%p_top - pfd = ngrid%c3f(k-1)*grid%MUB(i,j) + ngrid%c4f(k-1) + ngrid%p_top - phm = ngrid%c3h(k-1)*grid%MUB(i,j) + ngrid%c4h(k-1) + ngrid%p_top - grid%phb(i,k,j) = grid%phb(i,k-1,j) + grid%alb(i,k-1,j)*phm*LOG(pfd/pfu) - END DO - ELSE - CALL wrf_error_fatal( 'module_dm: hypsometric_opt should be 1 or 2' ) - END IF ! which hypsometric option - END DO ! i loop - END DO ! j loop - ! Perturbation fields - ALLOCATE( p (ips:ipe, kps:kpe, jps:jpe) ) - ALLOCATE( al(ips:ipe, kps:kpe, jps:jpe) ) - DO j = MAX(jds,jps),MIN(jde-1,jpe) - DO i = MAX(ids,ips),MIN(ide-1,ipe) - ! Integrate the hydrostatic equation (from the RHS of the bigstep vertical momentum - ! equation) down from the top to get the pressure perturbation. First get the pressure - ! perturbation, moisture, and inverse density (total and perturbation) at the top-most level. - - kk = kpe-1 - k = kk+1 - - qvf1 = 0.5*(moist(i,kk,j,P_QV)+moist(i,kk,j,P_QV)) - qvf2 = 1./(1.+qvf1) - qvf1 = qvf1*qvf2 - - p(i,kk,j) = - 0.5*((ngrid%c1f(k)*grid%Mu_2(i,j))+qvf1*(ngrid%c1f(k)*grid%Mub(i,j)+ngrid%c2f(k)))/ngrid%rdnw(kk)/qvf2 - IF ( config_flags%use_theta_m == 0) THEN - qvf = 1. + rvovrd*moist(i,kk,j,P_QV) - ELSE - qvf = 1. - ENDIF - al(i,kk,j) = (r_d/p1000mb)*(grid%t_2(i,kk,j)+t0)*qvf* & - (((p(i,kk,j)+grid%pb(i,kk,j))/p1000mb)**cvpm) - grid%alb(i,kk,j) - - ! Now, integrate down the column to compute the pressure perturbation, and diagnose the two - ! inverse density fields (total and perturbation). - - DO kk=kpe-2,1,-1 - k = kk + 1 - qvf1 = 0.5*(moist(i,kk,j,P_QV)+moist(i,kk+1,j,P_QV)) - qvf2 = 1./(1.+qvf1) - qvf1 = qvf1*qvf2 - p(i,kk,j) = p(i,kk+1,j) - ((ngrid%c1f(k)*grid%Mu_2(i,j)) + qvf1*(ngrid%c1f(k)*grid%Mub(i,j)+ngrid%c2f(k)))/qvf2/ngrid%rdn(kk+1) - IF ( config_flags%use_theta_m == 0) THEN - qvf = 1. + rvovrd*moist(i,kk,j,P_QV) - ELSE - qvf = 1. - ENDIF - al(i,kk,j) = (r_d/p1000mb)*(grid%t_2(i,kk,j)+t0)*qvf* & - (((p(i,kk,j)+grid%pb(i,kk,j))/p1000mb)**cvpm) - grid%alb(i,kk,j) - END DO - - ! This is the hydrostatic equation used in the model after the small timesteps. In - ! the model, grid%al (inverse density) is computed from the geopotential. - - IF (grid%hypsometric_opt == 1) THEN - DO kk = 2,kpe - k = kk - 1 - grid%ph_2(i,kk,j) = grid%ph_2(i,kk-1,j) - & - ngrid%dnw(kk-1) * ( ((ngrid%c1h(k)*grid%mub(i,j)+ngrid%c2h(k))+(ngrid%c1h(k)*grid%mu_2(i,j)))*al(i,kk-1,j) & - + (ngrid%c1h(k)*grid%mu_2(i,j))*grid%alb(i,kk-1,j) ) - END DO - - ! Alternative hydrostatic eq.: dZ = -al*p*dLOG(p), where p is dry pressure. - ! Note that al*p approximates Rd*T and dLOG(p) does z. - ! Here T varies mostly linear with z, the first-order integration produces better result. - - ELSE IF (grid%hypsometric_opt == 2) THEN - - grid%ph_2(i,1,j) = grid%phb(i,1,j) - DO k = 2,kpe - pfu = ngrid%c3f(k )*( grid%MUB(i,j)+grid%MU_2(i,j) ) + ngrid%c4f(k ) + ngrid%p_top - pfd = ngrid%c3f(k-1)*( grid%MUB(i,j)+grid%MU_2(i,j) ) + ngrid%c4f(k-1) + ngrid%p_top - phm = ngrid%c3h(k-1)*( grid%MUB(i,j)+grid%MU_2(i,j) ) + ngrid%c4h(k-1) + ngrid%p_top - grid%ph_2(i,k,j) = grid%ph_2(i,k-1,j) + (grid%alb(i,k-1,j)+al(i,k-1,j))*phm*LOG(pfd/pfu) - END DO - - DO k = 1,kpe - grid%ph_2(i,k,j) = grid%ph_2(i,k,j) - grid%phb(i,k,j) - END DO - - END IF - - END DO ! i loop - END DO ! j loop - - DEALLOCATE(p) - DEALLOCATE(al) - - ! Couple the variables moist and t_2, and the newly calculated ph_2 - DO j = MAX(jds,jps),MIN(jde-1,jpe) - DO i = MAX(ids,ips),MIN(ide-1,ipe) - DO k=kps,kpe - grid%ph_2(i,k,j) = grid%ph_2(i,k,j)*((ngrid%c1f(k)*grid%Mub(i,j)+ngrid%c2f(k)) + (ngrid%c1f(k)*grid%Mu_2(i,j))) - END DO - END DO - END DO - DO j = MAX(jds,jps),MIN(jde-1,jpe) - DO i = MAX(ids,ips),MIN(ide-1,ipe) - DO k=kps,kpe-1 - grid%t_2(i,k,j) = grid%t_2(i,k,j)*((ngrid%c1h(k)*grid%mub(i,j)+ngrid%c2h(k)) + (ngrid%c1h(k)*grid%mu_2(i,j))) - moist(i,k,j,P_QV) = moist(i,k,j,P_QV)*((ngrid%c1h(k)*grid%mub(i,j)+ngrid%c2h(k)) + (ngrid%c1h(k)*grid%mu_2(i,j))) - END DO - END DO - END DO - - - END IF - - -#include "HALO_FORCE_DOWN.inc" - - ! code here to interpolate the data into the nested domain -# include "nest_forcedown_interp.inc" - - RETURN - END SUBROUTINE force_domain_em_part2 - -!------------------------------------------------------------------ - - SUBROUTINE interp_domain_em_part1 ( grid, intermediate_grid, ngrid, config_flags & -! -#include "dummy_new_args.inc" -! - ) - USE module_state_description - USE module_domain, ONLY : domain, get_ijk_from_grid - USE module_configure, ONLY : grid_config_rec_type - USE module_dm, ONLY : ntasks, ntasks_x, ntasks_y, itrace, local_communicator, & - nest_task_offsets, nest_pes_x, nest_pes_y, which_kid, & - intercomm_active, mpi_comm_to_kid, mpi_comm_to_mom, & - mytask, get_dm_max_halo_width - USE module_timing - IMPLICIT NONE -! - TYPE(domain), POINTER :: grid ! name of the grid being dereferenced (must be "grid") - TYPE(domain), POINTER :: intermediate_grid - TYPE(domain), POINTER :: ngrid -#include "dummy_new_decl.inc" - INTEGER nlev, msize - INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k - INTEGER iparstrt,jparstrt,sw - TYPE (grid_config_rec_type) :: config_flags - REAL xv(2000) - INTEGER :: cids, cide, cjds, cjde, ckds, ckde, & - cims, cime, cjms, cjme, ckms, ckme, & - cips, cipe, cjps, cjpe, ckps, ckpe - INTEGER :: iids, iide, ijds, ijde, ikds, ikde, & - iims, iime, ijms, ijme, ikms, ikme, & - iips, iipe, ijps, ijpe, ikps, ikpe - INTEGER :: nids, nide, njds, njde, nkds, nkde, & - nims, nime, njms, njme, nkms, nkme, & - nips, nipe, njps, njpe, nkps, nkpe - - INTEGER idim1,idim2,idim3,idim4,idim5,idim6,idim7 - - INTEGER icoord, jcoord, idim_cd, jdim_cd, pgr - INTEGER thisdomain_max_halo_width - INTEGER local_comm, myproc, nproc - INTEGER ioffset, ierr - - CALL wrf_get_dm_communicator ( local_comm ) - CALL wrf_get_myproc( myproc ) - CALL wrf_get_nproc( nproc ) - - CALL get_ijk_from_grid ( grid , & - cids, cide, cjds, cjde, ckds, ckde, & - cims, cime, cjms, cjme, ckms, ckme, & - cips, cipe, cjps, cjpe, ckps, ckpe ) - CALL get_ijk_from_grid ( intermediate_grid , & - iids, iide, ijds, ijde, ikds, ikde, & - iims, iime, ijms, ijme, ikms, ikme, & - iips, iipe, ijps, ijpe, ikps, ikpe ) - CALL get_ijk_from_grid ( ngrid , & - nids, nide, njds, njde, nkds, nkde, & - nims, nime, njms, njme, nkms, nkme, & - nips, nipe, njps, njpe, nkps, nkpe ) - - CALL nl_get_parent_grid_ratio ( ngrid%id, pgr ) - CALL nl_get_i_parent_start ( intermediate_grid%id, iparstrt ) - CALL nl_get_j_parent_start ( intermediate_grid%id, jparstrt ) - CALL nl_get_shw ( intermediate_grid%id, sw ) - icoord = iparstrt - sw - jcoord = jparstrt - sw - idim_cd = iide - iids + 1 - jdim_cd = ijde - ijds + 1 - - nlev = ckde - ckds + 1 - - ! get max_halo_width for parent. It may be smaller if it is moad - CALL get_dm_max_halo_width ( grid%id , thisdomain_max_halo_width ) - - IF ( grid%active_this_task ) THEN -#include "nest_interpdown_pack.inc" - END IF - - ! determine which communicator and offset to use - IF ( intercomm_active( grid%id ) ) THEN ! I am parent - local_comm = mpi_comm_to_kid( which_kid(ngrid%id), grid%id ) - ioffset = nest_task_offsets(ngrid%id) - ELSE IF ( intercomm_active( ngrid%id ) ) THEN ! I am nest - local_comm = mpi_comm_to_mom( ngrid%id ) - ioffset = nest_task_offsets(ngrid%id) - END IF - - IF ( grid%active_this_task .OR. ngrid%active_this_task ) THEN -#ifndef STUBMPI - CALL mpi_comm_rank(local_comm,myproc,ierr) - CALL mpi_comm_size(local_comm,nproc,ierr) -#endif - CALL rsl_lite_bcast_msgs( myproc, nest_pes_x(grid%id)*nest_pes_y(grid%id), & - nest_pes_x(ngrid%id)*nest_pes_y(ngrid%id), & - ioffset, local_comm ) - END IF - - RETURN - END SUBROUTINE interp_domain_em_part1 - -!------------------------------------------------------------------ - - SUBROUTINE interp_domain_em_part2 ( grid, ngrid, pgrid, config_flags & -! -#include "dummy_new_args.inc" -! - ) - USE module_state_description - USE module_domain, ONLY : domain, get_ijk_from_grid - USE module_configure, ONLY : grid_config_rec_type - USE module_dm, ONLY : ntasks, ntasks_x, ntasks_y, itrace, local_communicator, & - mytask, get_dm_max_halo_width, which_kid - ! push_communicators_for_domain,pop_communicators_for_domain - USE module_comm_nesting_dm, ONLY : halo_interp_down_sub - IMPLICIT NONE -! - TYPE(domain), POINTER :: grid ! name of the grid being dereferenced (must be "grid") - TYPE(domain), POINTER :: ngrid - TYPE(domain), POINTER :: pgrid !KAL added for vertical nesting -#include "dummy_new_decl.inc" - INTEGER nlev, msize - INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k - TYPE (grid_config_rec_type) :: config_flags - REAL xv(2000) - INTEGER :: cids, cide, cjds, cjde, ckds, ckde, & - cims, cime, cjms, cjme, ckms, ckme, & - cips, cipe, cjps, cjpe, ckps, ckpe - INTEGER :: nids, nide, njds, njde, nkds, nkde, & - nims, nime, njms, njme, nkms, nkme, & - nips, nipe, njps, njpe, nkps, nkpe - INTEGER :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - ips, ipe, jps, jpe, kps, kpe - - INTEGER idim1,idim2,idim3,idim4,idim5,idim6,idim7 - - INTEGER myproc - INTEGER ierr - INTEGER thisdomain_max_halo_width - - !KAL variables for vertical nesting - REAL :: p_top_m , p_surf_m , mu_m , hsca_m , pre_c ,pre_n - REAL, DIMENSION(pgrid%s_vert:pgrid%e_vert) :: alt_w_c - REAL, DIMENSION(pgrid%s_vert:pgrid%e_vert+1) :: alt_u_c - REAL, DIMENSION(ngrid%s_vert:ngrid%e_vert) :: alt_w_n - REAL, DIMENSION(ngrid%s_vert:ngrid%e_vert+1) :: alt_u_n - - - !KAL change this for vertical nesting - ! interp_domain_em_part1 packs up the interpolation onto the coarse (vertical) grid - ! therefore the message size is based on the coarse grid number of levels - ! here it is unpacked onto the intermediate grid - CALL get_ijk_from_grid ( pgrid , & - cids, cide, cjds, cjde, ckds, ckde, & - cims, cime, cjms, cjme, ckms, ckme, & - cips, cipe, cjps, cjpe, ckps, ckpe ) - !KAL this is the original WRF code - !CALL get_ijk_from_grid ( grid , & - ! cids, cide, cjds, cjde, ckds, ckde, & - ! cims, cime, cjms, cjme, ckms, ckme, & - ! cips, cipe, cjps, cjpe, ckps, ckpe ) - CALL get_ijk_from_grid ( ngrid , & - nids, nide, njds, njde, nkds, nkde, & - nims, nime, njms, njme, nkms, nkme, & - nips, nipe, njps, njpe, nkps, nkpe ) - - nlev = ckde - ckds + 1 - - CALL get_dm_max_halo_width ( ngrid%id , thisdomain_max_halo_width ) - -#include "nest_interpdown_unpack.inc" - - -if (ngrid%vert_refine_method .NE. 0) then - - !KAL calculating the vertical coordinate for parent and nest grid (code from ndown) - ! assume that the parent and nest have the same p_top value (as in ndown) - -!KAL ckde is equal to e_vert of the coarse grid. There are e_vert-1 u points. The coarse 1D grid here is e_vert+1, -! so it is the e_vert-1 points from the coarse grid, plus a surface point plus a top point. Extrapolation coefficients -! are used to get the surface and top points to fill out the pro_u_c 1D array of u values from the coarse grid. - - hsca_m = 6.7 !KAL scale height of the atmosphere - p_top_m = ngrid%p_top - p_surf_m = 1.e5 - mu_m = p_surf_m - p_top_m -! parent - do k = 1,ckde - pre_c = mu_m * pgrid%c3f(k) + p_top_m + pgrid%c4f(k) - alt_w_c(k) = -hsca_m * alog(pre_c/p_surf_m) - enddo - do k = 1,ckde-1 - pre_c = mu_m * pgrid%c3h(k) + p_top_m + pgrid%c4h(k) - alt_u_c(k+1) = -hsca_m * alog(pre_c/p_surf_m) - enddo - alt_u_c(1) = alt_w_c(1) - alt_u_c(ckde+1) = alt_w_c(ckde) -! nest - do k = 1,nkde - pre_n = mu_m * ngrid%c3f(k) + p_top_m + ngrid%c4f(k) - alt_w_n(k) = -hsca_m * alog(pre_n/p_surf_m) - enddo - do k = 1,nkde-1 - pre_n = mu_m * ngrid%c3h(k) + p_top_m + ngrid%c4h(k) - alt_u_n(k+1) = -hsca_m * alog(pre_n/p_surf_m) - enddo - alt_u_n(1) = alt_w_n(1) - alt_u_n(nkde+1) = alt_w_n(nkde) -endif - - - - !KAL added this call for vertical nesting (return coarse grid dimensions to intended values) - CALL get_ijk_from_grid ( grid , & - cids, cide, cjds, cjde, ckds, ckde, & - cims, cime, cjms, cjme, ckms, ckme, & - cips, cipe, cjps, cjpe, ckps, ckpe ) - - CALL get_ijk_from_grid ( grid , & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - ips, ipe, jps, jpe, kps, kpe ) - - -if (ngrid%vert_refine_method .NE. 0) then - -!KAL added this code (the include file) for the vertical nesting -#include "nest_interpdown_interp_vert.inc" - - - !KAL finish off the 1-D variables (t_base, u_base, v_base, qv_base, and z_base) (move this out of here if alt_u_c and alt_u_n are calculated elsewhere) - CALL vert_interp_vert_nesting_1d ( & - ngrid%t_base, & ! CD field - ids, ide, kds, kde, jds, jde, & ! CD dims - ims, ime, kms, kme, jms, jme, & ! CD dims - ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & ! CD dims - pgrid%s_vert, pgrid%e_vert, & ! vertical dimension of the parent grid - pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & ! coarse grid extrapolation constants - alt_u_c, alt_u_n) ! coordinates for parent and nest - CALL vert_interp_vert_nesting_1d ( & - ngrid%u_base, & ! CD field - ids, ide, kds, kde, jds, jde, & ! CD dims - ims, ime, kms, kme, jms, jme, & ! CD dims - ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & ! CD dims - pgrid%s_vert, pgrid%e_vert, & ! vertical dimension of the parent grid - pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & ! coarse grid extrapolation constants - alt_u_c, alt_u_n) ! coordinates for parent and nest - CALL vert_interp_vert_nesting_1d ( & - ngrid%v_base, & ! CD field - ids, ide, kds, kde, jds, jde, & ! CD dims - ims, ime, kms, kme, jms, jme, & ! CD dims - ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & ! CD dims - pgrid%s_vert, pgrid%e_vert, & ! vertical dimension of the parent grid - pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & ! coarse grid extrapolation constants - alt_u_c, alt_u_n) ! coordinates for parent and nest - CALL vert_interp_vert_nesting_1d ( & - ngrid%qv_base, & ! CD field - ids, ide, kds, kde, jds, jde, & ! CD dims - ims, ime, kms, kme, jms, jme, & ! CD dims - ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & ! CD dims - pgrid%s_vert, pgrid%e_vert, & ! vertical dimension of the parent grid - pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & ! coarse grid extrapolation constants - alt_u_c, alt_u_n) ! coordinates for parent and nest - CALL vert_interp_vert_nesting_1d ( & - ngrid%z_base, & ! CD field - ids, ide, kds, kde, jds, jde, & ! CD dims - ims, ime, kms, kme, jms, jme, & ! CD dims - ips, ipe, kps, MIN( (kde-1), kpe ), jps, jpe, & ! CD dims - pgrid%s_vert, pgrid%e_vert, & ! vertical dimension of the parent grid - pgrid%cf1, pgrid%cf2, pgrid%cf3, pgrid%cfn, pgrid%cfn1, & ! coarse grid extrapolation constants - alt_u_c, alt_u_n) ! coordinates for parent and nest - -endif - - CALL push_communicators_for_domain( grid%id ) - -#include "HALO_INTERP_DOWN.inc" - - CALL pop_communicators_for_domain - -# include "nest_interpdown_interp.inc" - - RETURN - END SUBROUTINE interp_domain_em_part2 - -!------------------------------------------------------------------ - - SUBROUTINE interp_domain_em_small_part1 ( grid, intermediate_grid, ngrid, config_flags & -! -#include "dummy_new_args.inc" -! - ) - USE module_state_description - USE module_domain, ONLY : domain, get_ijk_from_grid - USE module_configure, ONLY : grid_config_rec_type - USE module_comm_dm, ONLY: halo_em_horiz_interp_sub - USE module_dm, ONLY : ntasks, ntasks_x, ntasks_y, itrace, local_communicator, & - mytask, get_dm_max_halo_width, & - nest_task_offsets, mpi_comm_to_kid, mpi_comm_to_mom, & - which_kid, nest_pes_x, nest_pes_y, intercomm_active - USE module_timing - IMPLICIT NONE -! - TYPE(domain), POINTER :: grid ! name of the grid being dereferenced (must be "grid") - TYPE(domain), POINTER :: intermediate_grid - TYPE(domain), POINTER :: ngrid -#include "dummy_new_decl.inc" - INTEGER nlev, msize - INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k - INTEGER iparstrt,jparstrt,sw - TYPE (grid_config_rec_type) :: config_flags - REAL xv(2000) - INTEGER :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - ips, ipe, jps, jpe, kps, kpe - - INTEGER :: cids, cide, cjds, cjde, ckds, ckde, & - cims, cime, cjms, cjme, ckms, ckme, & - cips, cipe, cjps, cjpe, ckps, ckpe - INTEGER :: iids, iide, ijds, ijde, ikds, ikde, & - iims, iime, ijms, ijme, ikms, ikme, & - iips, iipe, ijps, ijpe, ikps, ikpe - INTEGER :: nids, nide, njds, njde, nkds, nkde, & - nims, nime, njms, njme, nkms, nkme, & - nips, nipe, njps, njpe, nkps, nkpe - - INTEGER idim1,idim2,idim3,idim4,idim5,idim6,idim7 - - INTEGER icoord, jcoord, idim_cd, jdim_cd, pgr - INTEGER thisdomain_max_halo_width - INTEGER local_comm, myproc, nproc - INTEGER ioffset - - CALL wrf_get_dm_communicator ( local_comm ) - CALL wrf_get_myproc( myproc ) - CALL wrf_get_nproc( nproc ) - - CALL get_ijk_from_grid ( grid , & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - ips, ipe, jps, jpe, kps, kpe ) -#ifdef DM_PARALLEL -# include "HALO_EM_HORIZ_INTERP.inc" -#endif - - CALL get_ijk_from_grid ( grid , & - cids, cide, cjds, cjde, ckds, ckde, & - cims, cime, cjms, cjme, ckms, ckme, & - cips, cipe, cjps, cjpe, ckps, ckpe ) - CALL get_ijk_from_grid ( intermediate_grid , & - iids, iide, ijds, ijde, ikds, ikde, & - iims, iime, ijms, ijme, ikms, ikme, & - iips, iipe, ijps, ijpe, ikps, ikpe ) - CALL get_ijk_from_grid ( ngrid , & - nids, nide, njds, njde, nkds, nkde, & - nims, nime, njms, njme, nkms, nkme, & - nips, nipe, njps, njpe, nkps, nkpe ) - - CALL nl_get_parent_grid_ratio ( ngrid%id, pgr ) - CALL nl_get_i_parent_start ( intermediate_grid%id, iparstrt ) - CALL nl_get_j_parent_start ( intermediate_grid%id, jparstrt ) - CALL nl_get_shw ( intermediate_grid%id, sw ) - icoord = iparstrt - sw - jcoord = jparstrt - sw - idim_cd = iide - iids + 1 - jdim_cd = ijde - ijds + 1 - - nlev = ckde - ckds + 1 - - ! get max_halo_width for parent. It may be smaller if it is moad - CALL get_dm_max_halo_width ( grid%id , thisdomain_max_halo_width ) - - ! How many 3d arrays, so far just 3d theta-300 and geopotential perturbation, - ! and the 2d topo elevation, three max press/temp/height fields, and three - ! min press/temp/height fields. - - msize = ( 2 )* nlev + 7 - -!call wrf_debug(0,'/external/RSL_LITE/module_dm.F, calling rsl_lite_to_child') - CALL rsl_lite_to_child_info( local_communicator, msize*RWORDSIZE & - ,cips,cipe,cjps,cjpe & - ,iids,iide,ijds,ijde & - ,nids,nide,njds,njde & - ,pgr , sw & - ,ntasks_x,ntasks_y & - ,thisdomain_max_halo_width & - ,icoord,jcoord & - ,idim_cd,jdim_cd & - ,pig,pjg,retval ) -!call wrf_debug(0,'/external/RSL_LITE/module_dm.F, back from rsl_lite_to_child') - DO while ( retval .eq. 1 ) - IF ( SIZE(grid%ph_2) .GT. 1 ) THEN -!call wrf_debug(0,'/external/RSL_LITE/module_dm.F, ph_2') - DO k = ckds,ckde - xv(k)= grid%ph_2(pig,k,pjg) - END DO - CALL rsl_lite_to_child_msg(((ckde)-(ckds)+1)*RWORDSIZE,xv) - END IF - - IF ( SIZE(grid%t_2) .GT. 1 ) THEN -!call wrf_debug(0,'/external/RSL_LITE/module_dm.F, t_2') - DO k = ckds,(ckde-1) - xv(k)= grid%t_2(pig,k,pjg) - END DO - CALL rsl_lite_to_child_msg((((ckde-1))-(ckds)+1)*RWORDSIZE,xv) - END IF - - IF ( SIZE(grid%ht) .GT. 1 ) THEN -!call wrf_debug(0,'/external/RSL_LITE/module_dm.F, ht') - xv(1)= grid%ht(pig,pjg) - CALL rsl_lite_to_child_msg(RWORDSIZE,xv) - END IF - - IF ( SIZE(grid%t_max_p) .GT. 1 ) THEN -!call wrf_debug(0,'/external/RSL_LITE/module_dm.F, t_max_p') - xv(1)= grid%t_max_p(pig,pjg) - CALL rsl_lite_to_child_msg(RWORDSIZE,xv) - END IF - - IF ( SIZE(grid%ght_max_p) .GT. 1 ) THEN -!call wrf_debug(0,'/external/RSL_LITE/module_dm.F, ght_max_p') - xv(1)= grid%ght_max_p(pig,pjg) - CALL rsl_lite_to_child_msg(RWORDSIZE,xv) - END IF - - IF ( SIZE(grid%max_p) .GT. 1 ) THEN -!call wrf_debug(0,'/external/RSL_LITE/module_dm.F, max_p') - xv(1)= grid%max_p(pig,pjg) - CALL rsl_lite_to_child_msg(RWORDSIZE,xv) - END IF - - IF ( SIZE(grid%t_min_p) .GT. 1 ) THEN -!call wrf_debug(0,'/external/RSL_LITE/module_dm.F, t_min_p') - xv(1)= grid%t_min_p(pig,pjg) - CALL rsl_lite_to_child_msg(RWORDSIZE,xv) - END IF - - IF ( SIZE(grid%ght_min_p) .GT. 1 ) THEN -!call wrf_debug(0,'/external/RSL_LITE/module_dm.F, ght_min_p') - xv(1)= grid%ght_min_p(pig,pjg) - CALL rsl_lite_to_child_msg(RWORDSIZE,xv) - END IF - - IF ( SIZE(grid%min_p) .GT. 1 ) THEN -!call wrf_debug(0,'/external/RSL_LITE/module_dm.F, min_p') - xv(1)= grid%min_p(pig,pjg) - CALL rsl_lite_to_child_msg(RWORDSIZE,xv) - END IF - -!call wrf_debug(0,'/external/RSL_LITE/module_dm.F, calling rsl_lite_to_child_info') - CALL rsl_lite_to_child_info( local_communicator, msize*RWORDSIZE & - ,cips,cipe,cjps,cjpe & - ,iids,iide,ijds,ijde & - ,nids,nide,njds,njde & - ,pgr , sw & - ,ntasks_x,ntasks_y & - ,thisdomain_max_halo_width & - ,icoord,jcoord & - ,idim_cd,jdim_cd & - ,pig,pjg,retval ) -!call wrf_debug(0,'/external/RSL_LITE/module_dm.F, back from rsl_lite_to_child_info') - END DO - - ! determine which communicator and offset to use - IF ( intercomm_active( grid%id ) ) THEN ! I am parent - local_comm = mpi_comm_to_kid( which_kid(ngrid%id), grid%id ) - ioffset = nest_task_offsets(ngrid%id) - ELSE IF ( intercomm_active( ngrid%id ) ) THEN ! I am nest - local_comm = mpi_comm_to_mom( ngrid%id ) - ioffset = nest_task_offsets(ngrid%id) - END IF - -!call wrf_debug(0,'/external/RSL_LITE/module_dm.F, calling rsl_lite_bcast') - CALL rsl_lite_bcast_msgs( myproc, nest_pes_x(grid%id)*nest_pes_y(grid%id), & - nest_pes_x(ngrid%id)*nest_pes_y(ngrid%id), & - ioffset, local_comm ) -!call wrf_debug(0,'/external/RSL_LITE/module_dm.F, back from rsl_lite_bcast') - - RETURN - END SUBROUTINE interp_domain_em_small_part1 - -!------------------------------------------------------------------ - - SUBROUTINE interp_domain_em_small_part2 ( grid, ngrid, config_flags & -! -#include "dummy_new_args.inc" -! - ) - USE module_state_description - USE module_domain, ONLY : domain, get_ijk_from_grid - USE module_configure, ONLY : grid_config_rec_type - USE module_dm, ONLY : ntasks, ntasks_x, ntasks_y, itrace, local_communicator, & - mytask, get_dm_max_halo_width - USE module_comm_nesting_dm, ONLY : halo_interp_down_sub - IMPLICIT NONE -! - TYPE(domain), POINTER :: grid ! name of the grid being dereferenced (must be "grid") - TYPE(domain), POINTER :: ngrid -#include "dummy_new_decl.inc" - INTEGER nlev, msize - INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k - TYPE (grid_config_rec_type) :: config_flags - REAL xv(2000) - INTEGER :: cids, cide, cjds, cjde, ckds, ckde, & - cims, cime, cjms, cjme, ckms, ckme, & - cips, cipe, cjps, cjpe, ckps, ckpe - INTEGER :: nids, nide, njds, njde, nkds, nkde, & - nims, nime, njms, njme, nkms, nkme, & - nips, nipe, njps, njpe, nkps, nkpe - INTEGER :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - ips, ipe, jps, jpe, kps, kpe - - INTEGER idim1,idim2,idim3,idim4,idim5,idim6,idim7 - - INTEGER myproc - INTEGER ierr - INTEGER thisdomain_max_halo_width - - CALL get_ijk_from_grid ( grid , & - cids, cide, cjds, cjde, ckds, ckde, & - cims, cime, cjms, cjme, ckms, ckme, & - cips, cipe, cjps, cjpe, ckps, ckpe ) - CALL get_ijk_from_grid ( ngrid , & - nids, nide, njds, njde, nkds, nkde, & - nims, nime, njms, njme, nkms, nkme, & - nips, nipe, njps, njpe, nkps, nkpe ) - - nlev = ckde - ckds + 1 - - CALL get_dm_max_halo_width ( ngrid%id , thisdomain_max_halo_width ) - - CALL rsl_lite_from_parent_info(pig,pjg,retval) - - DO while ( retval .eq. 1 ) - - IF ( SIZE(grid%ph_2) .GT. 1 ) THEN - CALL rsl_lite_from_parent_msg(((ckde)-(ckds)+1)*RWORDSIZE,xv) - DO k = ckds,ckde - grid%ph_2(pig,k,pjg) = xv(k) - END DO - END IF - - IF ( SIZE(grid%t_2) .GT. 1 ) THEN - CALL rsl_lite_from_parent_msg((((ckde-1))-(ckds)+1)*RWORDSIZE,xv) - DO k = ckds,(ckde-1) - grid%t_2(pig,k,pjg) = xv(k) - END DO - END IF - - IF ( SIZE(grid%ht) .GT. 1 ) THEN - CALL rsl_lite_from_parent_msg(RWORDSIZE,xv) - grid%ht(pig,pjg) = xv(1) - END IF - - IF ( SIZE(grid%t_max_p) .GT. 1 ) THEN - CALL rsl_lite_from_parent_msg(RWORDSIZE,xv) - grid%t_max_p(pig,pjg) = xv(1) - END IF - - IF ( SIZE(grid%ght_max_p) .GT. 1 ) THEN - CALL rsl_lite_from_parent_msg(RWORDSIZE,xv) - grid%ght_max_p(pig,pjg) = xv(1) - END IF - - IF ( SIZE(grid%max_p) .GT. 1 ) THEN - CALL rsl_lite_from_parent_msg(RWORDSIZE,xv) - grid%max_p(pig,pjg) = xv(1) - END IF - - IF ( SIZE(grid%t_min_p) .GT. 1 ) THEN - CALL rsl_lite_from_parent_msg(RWORDSIZE,xv) - grid%t_min_p(pig,pjg) = xv(1) - END IF - - IF ( SIZE(grid%ght_min_p) .GT. 1 ) THEN - CALL rsl_lite_from_parent_msg(RWORDSIZE,xv) - grid%ght_min_p(pig,pjg) = xv(1) - END IF - - IF ( SIZE(grid%min_p) .GT. 1 ) THEN - CALL rsl_lite_from_parent_msg(RWORDSIZE,xv) - grid%min_p(pig,pjg) = xv(1) - END IF - - CALL rsl_lite_from_parent_info(pig,pjg,retval) - - END DO - - CALL get_ijk_from_grid ( grid , & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - ips, ipe, jps, jpe, kps, kpe ) - -#include "HALO_INTERP_DOWN.inc" - - CALL interp_fcn_bl ( grid%ph_2, & - cids, cide, ckds, ckde, cjds, cjde, & - cims, cime, ckms, ckme, cjms, cjme, & - cips, cipe, ckps, MIN( ckde, ckpe ), cjps, cjpe, & - ngrid%ph_2, & - nids, nide, nkds, nkde, njds, njde, & - nims, nime, nkms, nkme, njms, njme, & - nips, nipe, nkps, MIN( nkde, nkpe ), njps, njpe, & - config_flags%shw, ngrid%imask_nostag, & - .FALSE., .FALSE., & - ngrid%i_parent_start, ngrid%j_parent_start, & - ngrid%parent_grid_ratio, ngrid%parent_grid_ratio, & - grid%ht, ngrid%ht, & - grid%t_max_p, ngrid%t_max_p, & - grid%ght_max_p, ngrid%ght_max_p, & - grid%max_p, ngrid%max_p, & - grid%t_min_p, ngrid%t_min_p, & - grid%ght_min_p, ngrid%ght_min_p, & - grid%min_p, ngrid%min_p, & - ngrid%znw, ngrid%p_top ) - - CALL interp_fcn_bl ( grid%t_2, & - cids, cide, ckds, ckde, cjds, cjde, & - cims, cime, ckms, ckme, cjms, cjme, & - cips, cipe, ckps, MIN( (ckde-1), ckpe ), cjps, cjpe, & - ngrid%t_2, & - nids, nide, nkds, nkde, njds, njde, & - nims, nime, nkms, nkme, njms, njme, & - nips, nipe, nkps, MIN( (nkde-1), nkpe ), njps, njpe, & - config_flags%shw, ngrid%imask_nostag, & - .FALSE., .FALSE., & - ngrid%i_parent_start, ngrid%j_parent_start, & - ngrid%parent_grid_ratio, ngrid%parent_grid_ratio, & - grid%ht, ngrid%ht, & - grid%t_max_p, ngrid%t_max_p, & - grid%ght_max_p, ngrid%ght_max_p, & - grid%max_p, ngrid%max_p, & - grid%t_min_p, ngrid%t_min_p, & - grid%ght_min_p, ngrid%ght_min_p, & - grid%min_p, ngrid%min_p, & - ngrid%znu, ngrid%p_top ) - - RETURN - END SUBROUTINE interp_domain_em_small_part2 - -!------------------------------------------------------------------ - - SUBROUTINE feedback_nest_prep ( grid, config_flags & -! -#include "dummy_new_args.inc" -! -) - USE module_state_description - USE module_domain, ONLY : domain, get_ijk_from_grid - USE module_configure, ONLY : grid_config_rec_type - USE module_dm, ONLY : ntasks, ntasks_x, ntasks_y, itrace, local_communicator, mytask !, & - !push_communicators_for_domain, pop_communicators_for_domain - USE module_comm_nesting_dm, ONLY : halo_interp_up_sub - IMPLICIT NONE -! - TYPE(domain), TARGET :: grid ! name of the grid being dereferenced (must be "grid") - TYPE (grid_config_rec_type) :: config_flags ! configureation flags, has vertical dim of - ! soil temp, moisture, etc., has vertical dim - ! of soil categories -#include "dummy_new_decl.inc" - - INTEGER :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - ips, ipe, jps, jpe, kps, kpe - - INTEGER idim1,idim2,idim3,idim4,idim5,idim6,idim7 - - INTEGER :: idum1, idum2 - - - CALL get_ijk_from_grid ( grid , & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - ips, ipe, jps, jpe, kps, kpe ) - - IF ( grid%active_this_task ) THEN - CALL push_communicators_for_domain( grid%id ) - -#ifdef DM_PARALLEL -#include "HALO_INTERP_UP.inc" -#endif - - CALL pop_communicators_for_domain - END IF - - END SUBROUTINE feedback_nest_prep - -!------------------------------------------------------------------ - - SUBROUTINE feedback_domain_em_part1 ( grid, ngrid, config_flags & -! -#include "dummy_new_args.inc" -! - ) - USE module_state_description - USE module_domain, ONLY : domain, get_ijk_from_grid - USE module_configure, ONLY : grid_config_rec_type, model_config_rec, model_to_grid_config_rec - USE module_dm, ONLY : ntasks, ntasks_x, ntasks_y, itrace, local_communicator, mytask, & - ipe_save, jpe_save, ips_save, jps_save, & - nest_pes_x, nest_pes_y - - IMPLICIT NONE -! - TYPE(domain), POINTER :: grid ! name of the grid being dereferenced (must be "grid") - TYPE(domain), POINTER :: ngrid -#include "dummy_new_decl.inc" - INTEGER nlev, msize - INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k - TYPE(domain), POINTER :: xgrid - TYPE (grid_config_rec_type) :: config_flags, nconfig_flags - REAL xv(2000) - INTEGER :: cids, cide, cjds, cjde, ckds, ckde, & - cims, cime, cjms, cjme, ckms, ckme, & - cips, cipe, cjps, cjpe, ckps, ckpe - INTEGER :: nids, nide, njds, njde, nkds, nkde, & - nims, nime, njms, njme, nkms, nkme, & - nips, nipe, njps, njpe, nkps, nkpe - - INTEGER idim1,idim2,idim3,idim4,idim5,idim6,idim7 - - INTEGER local_comm, myproc, nproc, idum1, idum2 - INTEGER thisdomain_max_halo_width - -!cyl: add variables for trajectory - integer tjk - - INTERFACE - SUBROUTINE feedback_nest_prep ( grid, config_flags & -! -#include "dummy_new_args.inc" -! -) - USE module_state_description - USE module_domain, ONLY : domain - USE module_configure, ONLY : grid_config_rec_type -! - TYPE (grid_config_rec_type) :: config_flags - TYPE(domain), TARGET :: grid -#include "dummy_new_decl.inc" - END SUBROUTINE feedback_nest_prep - END INTERFACE -! - - CALL wrf_get_dm_communicator ( local_comm ) - CALL wrf_get_myproc( myproc ) - CALL wrf_get_nproc( nproc ) - -! -! intermediate grid - CALL get_ijk_from_grid ( grid , & - cids, cide, cjds, cjde, ckds, ckde, & - cims, cime, cjms, cjme, ckms, ckme, & - cips, cipe, cjps, cjpe, ckps, ckpe ) -! nest grid - CALL get_ijk_from_grid ( ngrid , & - nids, nide, njds, njde, nkds, nkde, & - nims, nime, njms, njme, nkms, nkme, & - nips, nipe, njps, njpe, nkps, nkpe ) - - nlev = ckde - ckds + 1 - - ips_save = ngrid%i_parent_start ! used in feedback_domain_em_part2 below - jps_save = ngrid%j_parent_start - ipe_save = ngrid%i_parent_start + (nide-nids+1) / ngrid%parent_grid_ratio - 1 - jpe_save = ngrid%j_parent_start + (njde-njds+1) / ngrid%parent_grid_ratio - 1 - -! feedback_nest_prep invokes a halo exchange on the ngrid. It is done this way -! in a separate routine because the HALOs need the data to be dereference from the -! grid data structure and, in this routine, the dereferenced fields are related to -! the intermediate domain, not the nest itself. Save the current grid pointer to intermediate -! domain, switch grid to point to ngrid, invoke feedback_nest_prep, then restore grid -! to point to intermediate domain. - - CALL model_to_grid_config_rec ( ngrid%id , model_config_rec , nconfig_flags ) - CALL set_scalar_indices_from_config ( ngrid%id , idum1 , idum2 ) - xgrid => grid - grid => ngrid - - CALL feedback_nest_prep ( grid, nconfig_flags & -! -#include "actual_new_args.inc" -! -) - -! put things back so grid is intermediate grid - - grid => xgrid - CALL set_scalar_indices_from_config ( grid%id , idum1 , idum2 ) - -! "interp" (basically copy) ngrid onto intermediate grid - -#include "nest_feedbackup_interp.inc" - - RETURN - END SUBROUTINE feedback_domain_em_part1 - -!------------------------------------------------------------------ - - SUBROUTINE feedback_domain_em_part2 ( grid, intermediate_grid, ngrid , config_flags & -! -#include "dummy_new_args.inc" -! - ) - USE module_state_description - USE module_domain, ONLY : domain, domain_clock_get, get_ijk_from_grid - USE module_configure, ONLY : grid_config_rec_type, model_config_rec - USE module_dm, ONLY : ntasks, ntasks_x, ntasks_y, itrace, local_communicator, mytask, & - ipe_save, jpe_save, ips_save, jps_save, get_dm_max_halo_width, & - nest_pes_x, nest_pes_y, & - intercomm_active, nest_task_offsets, & - mpi_comm_to_mom, mpi_comm_to_kid, which_kid !, & - !push_communicators_for_domain, pop_communicators_for_domain - - USE module_comm_nesting_dm, ONLY : halo_interp_up_sub - USE module_utility - IMPLICIT NONE - -! - TYPE(domain), POINTER :: grid ! name of the grid being dereferenced (must be "grid") - TYPE(domain), POINTER :: intermediate_grid - TYPE(domain), POINTER :: ngrid - TYPE(domain), POINTER :: parent_grid - -#include "dummy_new_decl.inc" - INTEGER nlev, msize - INTEGER i,j,pig,pjg,cm,cn,nig,njg,retval,k - TYPE (grid_config_rec_type) :: config_flags - REAL xv(2000) - INTEGER :: cids, cide, cjds, cjde, ckds, ckde, & - cims, cime, cjms, cjme, ckms, ckme, & - cips, cipe, cjps, cjpe, ckps, ckpe - INTEGER :: nids, nide, njds, njde, nkds, nkde, & - nims, nime, njms, njme, nkms, nkme, & - nips, nipe, njps, njpe, nkps, nkpe - INTEGER :: xids, xide, xjds, xjde, xkds, xkde, & - xims, xime, xjms, xjme, xkms, xkme, & - xips, xipe, xjps, xjpe, xkps, xkpe - INTEGER :: ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - ips, ipe, jps, jpe, kps, kpe - - INTEGER idim1,idim2,idim3,idim4,idim5,idim6,idim7 - - INTEGER icoord, jcoord, idim_cd, jdim_cd - INTEGER local_comm, myproc, nproc, ioffset - INTEGER iparstrt, jparstrt, sw, thisdomain_max_halo_width - REAL nest_influence - - character*256 :: timestr - integer ierr - - LOGICAL, EXTERNAL :: cd_feedback_mask - -!cyl: add variables for trajectory - integer tjk - -! On entry to this routine, -! "grid" refers to the parent domain -! "intermediate_grid" refers to local copy of parent domain that overlies this patch of nest -! "ngrid" refers to the nest, which is only needed for smoothing on the parent because -! the nest feedback data has already been transferred during em_nest_feedbackup_interp -! in part1, above. -! The way these settings c and n dimensions are set, below, looks backwards but from the point -! of view of the RSL routine rsl_lite_to_parent_info(), call to which is included by -! em_nest_feedbackup_pack, the "n" domain represents the parent domain and the "c" domain -! represents the intermediate domain. The backwards lookingness should be fixed in the gen_comms.c -! registry routine that accompanies RSL_LITE but, just as it's sometimes easier to put up a road -! sign that says "DIP" than fix the dip, at this point it was easier just to write this comment. JM -! - nest_influence = 1. - - CALL domain_clock_get( grid, current_timestr=timestr ) - - CALL get_ijk_from_grid ( intermediate_grid , & - cids, cide, cjds, cjde, ckds, ckde, & - cims, cime, cjms, cjme, ckms, ckme, & - cips, cipe, cjps, cjpe, ckps, ckpe ) - CALL get_ijk_from_grid ( grid , & - nids, nide, njds, njde, nkds, nkde, & - nims, nime, njms, njme, nkms, nkme, & - nips, nipe, njps, njpe, nkps, nkpe ) - CALL get_ijk_from_grid ( ngrid , & - xids, xide, xjds, xjde, xkds, xkde, & - xims, xime, xjms, xjme, xkms, xkme, & - xips, xipe, xjps, xjpe, xkps, xkpe ) - - ips_save = ngrid%i_parent_start ! used in feedback_domain_em_part2 below - jps_save = ngrid%j_parent_start - ipe_save = ngrid%i_parent_start + (xide-xids+1) / ngrid%parent_grid_ratio - 1 - jpe_save = ngrid%j_parent_start + (xjde-xjds+1) / ngrid%parent_grid_ratio - 1 - - - - -IF ( ngrid%active_this_task ) THEN -!cyl add this for trajectory - CALL push_communicators_for_domain( ngrid%id ) - - do tjk = 1,config_flags%num_traj - if (ngrid%traj_long(tjk) .eq. -9999.0) then -! print*,'n=-9999',tjk - ngrid%traj_long(tjk)=grid%traj_long(tjk) - ngrid%traj_k(tjk)=grid%traj_k(tjk) - else -! print*,'p!=-9999',tjk - grid%traj_long(tjk)=ngrid%traj_long(tjk) - grid%traj_k(tjk)=ngrid%traj_k(tjk) - endif - if (ngrid%traj_lat(tjk) .eq. -9999.0) then - ngrid%traj_lat(tjk)=grid%traj_lat(tjk) - ngrid%traj_k(tjk)=grid%traj_k(tjk) - else - grid%traj_lat(tjk)=ngrid%traj_lat(tjk) - grid%traj_k(tjk)=ngrid%traj_k(tjk) - endif - enddo -!endcyl - - CALL nl_get_i_parent_start ( intermediate_grid%id, iparstrt ) - CALL nl_get_j_parent_start ( intermediate_grid%id, jparstrt ) - CALL nl_get_shw ( intermediate_grid%id, sw ) - icoord = iparstrt - sw - jcoord = jparstrt - sw - idim_cd = cide - cids + 1 - jdim_cd = cjde - cjds + 1 - - nlev = ckde - ckds + 1 - - CALL get_dm_max_halo_width ( grid%id , thisdomain_max_halo_width ) - - parent_grid => grid - grid => ngrid -#include "nest_feedbackup_pack.inc" - grid => parent_grid - CALL pop_communicators_for_domain - -END IF - -! CALL wrf_get_dm_communicator ( local_comm ) -! CALL wrf_get_myproc( myproc ) -! CALL wrf_get_nproc( nproc ) - - ! determine which communicator and offset to use - IF ( intercomm_active( grid%id ) ) THEN ! I am parent - local_comm = mpi_comm_to_kid( which_kid(ngrid%id), grid%id ) - ioffset = nest_task_offsets(ngrid%id) - ELSE IF ( intercomm_active( ngrid%id ) ) THEN ! I am nest - local_comm = mpi_comm_to_mom( ngrid%id ) - ioffset = nest_task_offsets(ngrid%id) - END IF - - IF ( grid%active_this_task .OR. ngrid%active_this_task ) THEN -#ifndef STUBMPI - CALL mpi_comm_rank(local_comm,myproc,ierr) - CALL mpi_comm_size(local_comm,nproc,ierr) -#endif -!call tracebackqq() - CALL rsl_lite_merge_msgs( myproc, nest_pes_x(grid%id)*nest_pes_y(grid%id), & - nest_pes_x(ngrid%id)*nest_pes_y(ngrid%id), & - ioffset, local_comm ) - END IF - -IF ( grid%active_this_task ) THEN - CALL push_communicators_for_domain( grid%id ) - - -#define NEST_INFLUENCE(A,B) A = B -#include "nest_feedbackup_unpack.inc" - - ! smooth coarse grid - CALL get_ijk_from_grid ( ngrid, & - nids, nide, njds, njde, nkds, nkde, & - nims, nime, njms, njme, nkms, nkme, & - nips, nipe, njps, njpe, nkps, nkpe ) - CALL get_ijk_from_grid ( grid , & - ids, ide, jds, jde, kds, kde, & - ims, ime, jms, jme, kms, kme, & - ips, ipe, jps, jpe, kps, kpe ) - -#include "HALO_INTERP_UP.inc" - - CALL get_ijk_from_grid ( grid , & - cids, cide, cjds, cjde, ckds, ckde, & - cims, cime, cjms, cjme, ckms, ckme, & - cips, cipe, cjps, cjpe, ckps, ckpe ) - -#include "nest_feedbackup_smooth.inc" - - CALL pop_communicators_for_domain -END IF - - RETURN - END SUBROUTINE feedback_domain_em_part2 -#endif - - -!------------------------------------------------------------------ - SUBROUTINE wrf_gatherv_real (Field, field_ofst, & my_count , & ! sendcount globbuf, glob_ofst , & ! recvbuf From 0596ebf82f141efda42eeddb5b0f02b0e30e52ff Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Thu, 2 May 2024 11:06:11 -0700 Subject: [PATCH 02/10] Adjust for new part3 --- dyn_em/interp_domain_em.F | 3 +++ share/mediation_interp_domain.F | 20 ++++++++++++++++++++ 2 files changed, 23 insertions(+) diff --git a/dyn_em/interp_domain_em.F b/dyn_em/interp_domain_em.F index 1c97931a6e..739d73c400 100644 --- a/dyn_em/interp_domain_em.F +++ b/dyn_em/interp_domain_em.F @@ -55,6 +55,9 @@ END SUBROUTINE interp_domain_em_part1 SUBROUTINE interp_domain_em_part2 END SUBROUTINE interp_domain_em_part2 +SUBROUTINE interp_domain_em_part3 +END SUBROUTINE interp_domain_em_part3 + #endif diff --git a/share/mediation_interp_domain.F b/share/mediation_interp_domain.F index 57abe41cdd..ccd3ec1bad 100644 --- a/share/mediation_interp_domain.F +++ b/share/mediation_interp_domain.F @@ -51,6 +51,21 @@ SUBROUTINE interp_domain_em_part2 ( grid, nested_grid, parent_grid, config_flags TYPE (grid_config_rec_type) :: config_flags # include "dummy_new_decl.inc" END SUBROUTINE interp_domain_em_part2 + + + SUBROUTINE interp_domain_em_part3 ( grid, nested_grid, parent_grid, config_flags & +! +# include "dummy_new_args.inc" +! + ) + USE module_domain + USE module_configure + TYPE(domain), POINTER :: grid ! name of the grid being dereferenced (must be "grid") + TYPE(domain), POINTER :: nested_grid + TYPE(domain), POINTER :: parent_grid !KAL added for vertical nesting + TYPE (grid_config_rec_type) :: config_flags +# include "dummy_new_decl.inc" + END SUBROUTINE interp_domain_em_part3 #endif END INTERFACE ! ---------------------------------------------------------- @@ -99,6 +114,11 @@ END SUBROUTINE interp_domain_em_part2 CALL interp_domain_em_part2 ( grid, nested_grid, parent_grid, config_flags & ! # include "actual_new_args.inc" +! + ) + CALL interp_domain_em_part3 ( grid, nested_grid, parent_grid, config_flags & +! +# include "actual_new_args.inc" ! ) ENDIF From a147cc1374a9e3f049310aa7993198d2258dbe36 Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Thu, 2 May 2024 11:06:29 -0700 Subject: [PATCH 03/10] Update cmake build for split files --- frame/CMakeLists.txt | 12 +++++++++++- 1 file changed, 11 insertions(+), 1 deletion(-) diff --git a/frame/CMakeLists.txt b/frame/CMakeLists.txt index 59f8d2551b..3039876cbd 100644 --- a/frame/CMakeLists.txt +++ b/frame/CMakeLists.txt @@ -87,7 +87,17 @@ target_include_directories( set( MODULE_DM module_dm_stubs.F ) if ( ${USE_RSL_LITE} ) message( STATUS "Setting module_dm to RSL_LITE" ) - set( MODULE_DM ${PROJECT_SOURCE_DIR}/external/RSL_LITE/module_dm.F ) + set( + MODULE_DM + ${PROJECT_SOURCE_DIR}/external/RSL_LITE/module_dm.F + ${PROJECT_SOURCE_DIR}/external/RSL_LITE/feedback_domain_em_part1.F90 + ${PROJECT_SOURCE_DIR}/external/RSL_LITE/feedback_domain_em_part2.F90 + ${PROJECT_SOURCE_DIR}/external/RSL_LITE/force_domain_em_part2.F90 + ${PROJECT_SOURCE_DIR}/external/RSL_LITE/interp_domain_em_part1.F90 + ${PROJECT_SOURCE_DIR}/external/RSL_LITE/interp_domain_em_part2.F90 + ${PROJECT_SOURCE_DIR}/external/RSL_LITE/interp_domain_em_part3.F90 + ${PROJECT_SOURCE_DIR}/external/RSL_LITE/interp_domain_em_small.F90 + ) endif() target_sources( From 94c2d5e635a2227c2c7421452653daf189704afe Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Thu, 2 May 2024 14:51:23 -0700 Subject: [PATCH 04/10] Update make build to split dm routines out --- frame/Makefile | 18 ++++++++++---- main/depend.common | 58 ++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 72 insertions(+), 4 deletions(-) diff --git a/frame/Makefile b/frame/Makefile index a861a9e979..cd2ad5ba80 100644 --- a/frame/Makefile +++ b/frame/Makefile @@ -1,4 +1,5 @@ # +include ../configure.wrf LN = ln -sf MAKE = make -i -r @@ -73,16 +74,25 @@ OBJS = \ hires_timer.o \ clog.o +ifeq ($(DMPARALLEL),1) + RSL_OBJS= \ + ../external/RSL_LITE/feedback_domain_em_part1.o \ + ../external/RSL_LITE/feedback_domain_em_part2.o \ + ../external/RSL_LITE/force_domain_em_part2.o \ + ../external/RSL_LITE/interp_domain_em_part1.o \ + ../external/RSL_LITE/interp_domain_em_part2.o \ + ../external/RSL_LITE/interp_domain_em_part3.o \ + ../external/RSL_LITE/interp_domain_em_small.o +endif + #compile as a .o but do not link into the main library SPECIAL = module_internal_header_util.o pack_utils.o - -include ../configure.wrf LIBTARGET = framework TARGETDIR = ./ -$(LIBTARGET) : $(MODULES) $(OBJS) $(SPECIAL) $(NLOBJS) $(ALOBJS) - $(AR) $(ARFLAGS) ../main/$(LIBWRFLIB) $(MODULES) $(OBJS) $(NLOBJS) $(ALOBJS) +$(LIBTARGET) : $(MODULES) $(OBJS) $(SPECIAL) $(NLOBJS) $(ALOBJS) $(RSL_OBJS) + $(AR) $(ARFLAGS) ../main/$(LIBWRFLIB) $(MODULES) $(OBJS) $(NLOBJS) $(ALOBJS) $(RSL_OBJS) $(RANLIB) ../main/$(LIBWRFLIB) nl_set_0_routines.o : nl_access_routines.F module_configure.o diff --git a/main/depend.common b/main/depend.common index c1f5dc2526..3b79248d2e 100644 --- a/main/depend.common +++ b/main/depend.common @@ -21,6 +21,64 @@ module_dm.o: \ module_cpl.o \ ../share/module_model_constants.o +../external/RSL_LITE/feedback_domain_em_part1.o: \ + module_dm.o \ + module_configure.o \ + module_state_description.o \ + module_domain.o + + +../external/RSL_LITE/feedback_domain_em_part2.o: \ + module_dm.o \ + module_configure.o \ + module_state_description.o \ + module_domain.o \ + module_comm_nesting_dm.o \ + ../external/esmf_time_f90/module_utility.o + + +../external/RSL_LITE/force_domain_em_part2.o: \ + module_dm.o \ + module_configure.o \ + module_state_description.o \ + module_domain.o \ + ../share/module_model_constants.o \ + module_comm_nesting_dm.o + + +../external/RSL_LITE/interp_domain_em_part1.o: \ + module_dm.o \ + module_configure.o \ + module_state_description.o \ + module_domain.o \ + module_timing.o + + +../external/RSL_LITE/interp_domain_em_part2.o: \ + module_dm.o \ + module_configure.o \ + module_state_description.o \ + module_domain.o \ + module_comm_nesting_dm.o + + +../external/RSL_LITE/interp_domain_em_part3.o: \ + module_dm.o \ + module_configure.o \ + module_state_description.o \ + module_domain.o \ + module_comm_nesting_dm.o + + +../external/RSL_LITE/interp_domain_em_small.o: \ + module_dm.o \ + module_configure.o \ + module_state_description.o \ + module_domain.o \ + module_comm_dm.o \ + module_comm_nesting_dm.o \ + module_timing.o + module_timing.o: \ module_wrf_error.o \ From 7bcfbe5d2b6979d4ea555d671857800c9f78c151 Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Tue, 18 Jun 2024 15:37:40 -0700 Subject: [PATCH 05/10] Add generated files fo clean rule --- external/RSL_LITE/makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/external/RSL_LITE/makefile b/external/RSL_LITE/makefile index 5d1139fe4c..df85d5f923 100644 --- a/external/RSL_LITE/makefile +++ b/external/RSL_LITE/makefile @@ -51,7 +51,7 @@ f_xpose.o: f_xpose.F90 f_pack.o $(FC) -o $@ $(FFLAGS) -c f_xpose.f clean : - @/bin/rm -f *.f *.o *.mod *.obj *.i + @/bin/rm -f *.f *.f90 *.o *.mod *.obj *.i superclean : clean @/bin/rm -f *.a From b7a3c5c921af9815e16a8644a186180de70e4439 Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Tue, 18 Jun 2024 15:38:10 -0700 Subject: [PATCH 06/10] Make sure to re-populate coordinates from grid and nested grid --- external/RSL_LITE/interp_domain_em_part3.F90 | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/external/RSL_LITE/interp_domain_em_part3.F90 b/external/RSL_LITE/interp_domain_em_part3.F90 index 090beb0e8d..9367e23b9b 100644 --- a/external/RSL_LITE/interp_domain_em_part3.F90 +++ b/external/RSL_LITE/interp_domain_em_part3.F90 @@ -42,6 +42,16 @@ SUBROUTINE interp_domain_em_part3 ( grid, ngrid, pgrid, config_flags & INTEGER ierr INTEGER thisdomain_max_halo_width + CALL get_ijk_from_grid ( grid , & + cids, cide, cjds, cjde, ckds, ckde, & + cims, cime, cjms, cjme, ckms, ckme, & + cips, cipe, cjps, cjpe, ckps, ckpe ) + + CALL get_ijk_from_grid ( ngrid , & + nids, nide, njds, njde, nkds, nkde, & + nims, nime, njms, njme, nkms, nkme, & + nips, nipe, njps, njpe, nkps, nkpe ) + # include "nest_interpdown_interp.inc" RETURN From f578f4404eb64a1d83c5e88dbbc8047840a4ccf2 Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Tue, 17 Sep 2024 16:09:58 -0700 Subject: [PATCH 07/10] Moving broken out files to .F extension --- .../{feedback_domain_em_part1.F90 => feedback_domain_em_part1.F} | 0 .../{feedback_domain_em_part2.F90 => feedback_domain_em_part2.F} | 0 .../{force_domain_em_part2.F90 => force_domain_em_part2.F} | 0 .../{interp_domain_em_part1.F90 => interp_domain_em_part1.F} | 0 .../{interp_domain_em_part2.F90 => interp_domain_em_part2.F} | 0 .../{interp_domain_em_part3.F90 => interp_domain_em_part3.F} | 0 .../{interp_domain_em_small.F90 => interp_domain_em_small.F} | 0 7 files changed, 0 insertions(+), 0 deletions(-) rename external/RSL_LITE/{feedback_domain_em_part1.F90 => feedback_domain_em_part1.F} (100%) rename external/RSL_LITE/{feedback_domain_em_part2.F90 => feedback_domain_em_part2.F} (100%) rename external/RSL_LITE/{force_domain_em_part2.F90 => force_domain_em_part2.F} (100%) rename external/RSL_LITE/{interp_domain_em_part1.F90 => interp_domain_em_part1.F} (100%) rename external/RSL_LITE/{interp_domain_em_part2.F90 => interp_domain_em_part2.F} (100%) rename external/RSL_LITE/{interp_domain_em_part3.F90 => interp_domain_em_part3.F} (100%) rename external/RSL_LITE/{interp_domain_em_small.F90 => interp_domain_em_small.F} (100%) diff --git a/external/RSL_LITE/feedback_domain_em_part1.F90 b/external/RSL_LITE/feedback_domain_em_part1.F similarity index 100% rename from external/RSL_LITE/feedback_domain_em_part1.F90 rename to external/RSL_LITE/feedback_domain_em_part1.F diff --git a/external/RSL_LITE/feedback_domain_em_part2.F90 b/external/RSL_LITE/feedback_domain_em_part2.F similarity index 100% rename from external/RSL_LITE/feedback_domain_em_part2.F90 rename to external/RSL_LITE/feedback_domain_em_part2.F diff --git a/external/RSL_LITE/force_domain_em_part2.F90 b/external/RSL_LITE/force_domain_em_part2.F similarity index 100% rename from external/RSL_LITE/force_domain_em_part2.F90 rename to external/RSL_LITE/force_domain_em_part2.F diff --git a/external/RSL_LITE/interp_domain_em_part1.F90 b/external/RSL_LITE/interp_domain_em_part1.F similarity index 100% rename from external/RSL_LITE/interp_domain_em_part1.F90 rename to external/RSL_LITE/interp_domain_em_part1.F diff --git a/external/RSL_LITE/interp_domain_em_part2.F90 b/external/RSL_LITE/interp_domain_em_part2.F similarity index 100% rename from external/RSL_LITE/interp_domain_em_part2.F90 rename to external/RSL_LITE/interp_domain_em_part2.F diff --git a/external/RSL_LITE/interp_domain_em_part3.F90 b/external/RSL_LITE/interp_domain_em_part3.F similarity index 100% rename from external/RSL_LITE/interp_domain_em_part3.F90 rename to external/RSL_LITE/interp_domain_em_part3.F diff --git a/external/RSL_LITE/interp_domain_em_small.F90 b/external/RSL_LITE/interp_domain_em_small.F similarity index 100% rename from external/RSL_LITE/interp_domain_em_small.F90 rename to external/RSL_LITE/interp_domain_em_small.F From 61c9a3bbf2dfa49d1ee2635aedd810252cdcab0d Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Tue, 17 Sep 2024 16:10:56 -0700 Subject: [PATCH 08/10] Removing edit to makefile to be closer to original .F usage --- external/RSL_LITE/makefile | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/external/RSL_LITE/makefile b/external/RSL_LITE/makefile index df85d5f923..5d1139fe4c 100644 --- a/external/RSL_LITE/makefile +++ b/external/RSL_LITE/makefile @@ -51,7 +51,7 @@ f_xpose.o: f_xpose.F90 f_pack.o $(FC) -o $@ $(FFLAGS) -c f_xpose.f clean : - @/bin/rm -f *.f *.f90 *.o *.mod *.obj *.i + @/bin/rm -f *.f *.o *.mod *.obj *.i superclean : clean @/bin/rm -f *.a From 34097bf20e7d632dbedf580e9356900a264d1725 Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Tue, 17 Sep 2024 16:11:11 -0700 Subject: [PATCH 09/10] Use .F extension --- frame/CMakeLists.txt | 14 +++++++------- 1 file changed, 7 insertions(+), 7 deletions(-) diff --git a/frame/CMakeLists.txt b/frame/CMakeLists.txt index 3039876cbd..5588b4753f 100644 --- a/frame/CMakeLists.txt +++ b/frame/CMakeLists.txt @@ -90,13 +90,13 @@ if ( ${USE_RSL_LITE} ) set( MODULE_DM ${PROJECT_SOURCE_DIR}/external/RSL_LITE/module_dm.F - ${PROJECT_SOURCE_DIR}/external/RSL_LITE/feedback_domain_em_part1.F90 - ${PROJECT_SOURCE_DIR}/external/RSL_LITE/feedback_domain_em_part2.F90 - ${PROJECT_SOURCE_DIR}/external/RSL_LITE/force_domain_em_part2.F90 - ${PROJECT_SOURCE_DIR}/external/RSL_LITE/interp_domain_em_part1.F90 - ${PROJECT_SOURCE_DIR}/external/RSL_LITE/interp_domain_em_part2.F90 - ${PROJECT_SOURCE_DIR}/external/RSL_LITE/interp_domain_em_part3.F90 - ${PROJECT_SOURCE_DIR}/external/RSL_LITE/interp_domain_em_small.F90 + ${PROJECT_SOURCE_DIR}/external/RSL_LITE/feedback_domain_em_part1.F + ${PROJECT_SOURCE_DIR}/external/RSL_LITE/feedback_domain_em_part2.F + ${PROJECT_SOURCE_DIR}/external/RSL_LITE/force_domain_em_part2.F + ${PROJECT_SOURCE_DIR}/external/RSL_LITE/interp_domain_em_part1.F + ${PROJECT_SOURCE_DIR}/external/RSL_LITE/interp_domain_em_part2.F + ${PROJECT_SOURCE_DIR}/external/RSL_LITE/interp_domain_em_part3.F + ${PROJECT_SOURCE_DIR}/external/RSL_LITE/interp_domain_em_small.F ) endif() From 6b060e4c7868493db4e8a2744c6d5cbb67c0c826 Mon Sep 17 00:00:00 2001 From: Anthony Islas Date: Tue, 24 Sep 2024 16:06:01 -0700 Subject: [PATCH 10/10] Add explicit files to remove in clean operation --- external/RSL_LITE/makefile | 15 ++++++++++++++- 1 file changed, 14 insertions(+), 1 deletion(-) diff --git a/external/RSL_LITE/makefile b/external/RSL_LITE/makefile index 5d1139fe4c..bcd3e2d05d 100644 --- a/external/RSL_LITE/makefile +++ b/external/RSL_LITE/makefile @@ -9,6 +9,19 @@ CFLAGS = $(PLUSFLAG) CPPFLAGS = FFLAGS = +# These .F files are compiled in frame but leave behind auto-gen files here +F_FILES = \ + feedback_domain_em_part1.F \ + feedback_domain_em_part2.F \ + force_domain_em_part2.F \ + interp_domain_em_part1.F \ + interp_domain_em_part2.F \ + interp_domain_em_part3.F \ + interp_domain_em_small.F + +# These will be the files we need to clean up +F90_FILES = $(foreach file,$(F_FILES),$(patsubst %.F,%.f90,$(file))) + .SUFFIXES: .F90 .F .f .o .code @@ -51,7 +64,7 @@ f_xpose.o: f_xpose.F90 f_pack.o $(FC) -o $@ $(FFLAGS) -c f_xpose.f clean : - @/bin/rm -f *.f *.o *.mod *.obj *.i + @/bin/rm -f *.f *.o *.mod *.obj *.i $(F90_FILES) superclean : clean @/bin/rm -f *.a