Ideal tropical cyclone fix (#2295)

TYPE: bug fix

KEYWORDS: em_tropical_cyclone, halo depth

SOURCE: Wen-Pu Ho (National Central University, Taiwan)

DESCRIPTION OF CHANGES:
Problem:
Some loops were hardcoded to start from index 1. This fails to properly
account for the ghost cells required in decomposed sub-domains, leading
to segmentation fault when running ideal.exe for the em_tropical_cyclone
case in MPI (parallel) environment.

Solution:
Fix hardcoded loop indices for proper handling in MPI-decomposed
domains, and broadcast base state variables with MPI function.

ISSUE:
Fixes #2294 

LIST OF MODIFIED FILES:
dyn_em/module_initialize_tropical_cyclone.F

TESTS CONDUCTED: 
Tested with idealized TC initialization using MPI processes.

RELEASE NOTE: This PR fixed an issue with not being able to execute
idealized initialization program of tropical cyclone case with MPI.

Author: wpuho

dyn_em/module_initialize_tropical_cyclone.F

@@ -484,12 +484,14 @@ SUBROUTINE init_domain_rk ( grid &
       grid%phb(i,k,j) = grid%phb(i,k-1,j) - grid%dnw(k-1)*(grid%c1h(k-1)*grid%mub(i,j)+grid%c2h(k-1))*grid%alb(i,k-1,j)
     ENDDO
 
+    if ((i.eq.1).and.(j.eq.1)) then
+      write(6,*) ' ptop is ',grid%p_top
+      write(6,*) ' base state grid%mub(1,1), p_surf is ',grid%mub(1,1),grid%mub(1,1)+grid%p_top
+    endif  
+
   ENDDO
   ENDDO
 
-  write(6,*) ' ptop is ',grid%p_top
-  write(6,*) ' base state grid%mub(1,1), p_surf is ',grid%mub(1,1),grid%mub(1,1)+grid%p_top
-
 !  calculate full state for each column - this includes moisture.
 
   write(6,*) ' getting moist sounding for full state '
@@ -586,8 +588,8 @@ SUBROUTINE init_domain_rk ( grid &
     nref = 1 + int( float(ide-ids+1)/2.0 )
     kref = kte-1
 
-    print *,'  ids,ide,kds,kds  = ',ids,ide,kds,kde
-    print *,'  its,ite,kts,kts  = ',its,ite,kts,kte
+    print *,'  ids,ide,kds,kde  = ',ids,ide,kds,kde
+    print *,'  its,ite,kts,kte  = ',its,ite,kts,kte
     print *,'  nref,fcor        = ',nref,fcor
     print *,'  r0,rmax,vmax,zdd = ',r0,rmax,vmax,zdd
 
@@ -607,22 +609,39 @@ SUBROUTINE init_domain_rk ( grid &
     allocate( qvref(nref,0:kref+1))
 
     ! get base state:
-    print *,'  zref,th0,qv0,thv0:'
+    if ((its.eq.1).and.(jts.eq.1)) then
     do k=1,kref
-      th0(k) = t0+grid%t_1(1,k,1)
-      qv0(k) = moist(1,k,1,P_QV)
+      th0(k) = t0+grid%t_1(its,k,jts)
+      qv0(k) = moist(its,k,jts,P_QV)
       thv0(k) = th0(k)*(1.0+(r_v/r_d)*qv0(k))/(1.0+qv0(k))
-      zref(k) = 0.5*(grid%phb(1,k,1)+grid%phb(1,k+1,1)+grid%ph_1(1,k,1)+grid%ph_1(1,k+1,1))/g
-      print *,k,zref(k),th0(k),qv0(k),thv0(k)
+      zref(k) = 0.5*(grid%phb(its,k,jts)+grid%phb(its,k+1,jts)+grid%ph_1(its,k,jts)+grid%ph_1(its,k+1,jts))/g
     enddo
-
-    print *,'  prs0,pi0,rh0:'
     do k=1,kref
-      prs0(k) = grid%p(1,k,1)+grid%pb(1,k,1)
+      prs0(k) = grid%p(its,k,jts)+grid%pb(its,k,jts)
       pi0(k) = (prs0(k)/p0)**(r_d/cp)
       E1=1000.0*SVP1*EXP(SVP2*(th0(k)*pi0(k)-SVPT0)/(th0(k)*pi0(k)-SVP3))
       qvs = EP_2*E1/(prs0(k)-E1)
       rh0(k) = qv0(k)/qvs
+    enddo
+    endif
+
+#ifdef DM_PARALLEL
+    CALL wrf_dm_bcast_real( th0 , kref+2 )
+    CALL wrf_dm_bcast_real( qv0 , kref+2 )
+    CALL wrf_dm_bcast_real( thv0 , kref+2 )
+    CALL wrf_dm_bcast_real( zref , kref+2 )
+    CALL wrf_dm_bcast_real( prs0 , kref+2 )
+    CALL wrf_dm_bcast_real( pi0 , kref+2 )
+    CALL wrf_dm_bcast_real( rh0 , kref+2 )
+#endif
+
+    print *,'  zref,th0,qv0,thv0:'
+    do k=1,kref
+      print *,k,zref(k),th0(k),qv0(k),thv0(k)
+    enddo
+
+    print *,'  prs0,pi0,rh0:'
+    do k=1,kref
       print *,k,prs0(k),pi0(k),rh0(k)
     enddo
 
@@ -1016,21 +1035,22 @@ SUBROUTINE init_domain_rk ( grid &
 	endif 
 !#endif
 
-   write(6,*) ' grid%mu_1 from comp ', grid%mu_1(1,1)
+   write(6,*) ' grid%mu_1 from comp ', grid%mu_1(its,jts)
    write(6,*) ' full state sounding from comp, ph, grid%p, grid%al, grid%t_1, qv '
    do k=1,kde-1
-     write(6,'(i3,1x,5(1x,1pe10.3))') k, grid%ph_1(1,k,1)+grid%phb(1,k,1), &
-                                      grid%p(1,k,1)+grid%pb(1,k,1), grid%alt(1,k,1), &
-                                      grid%t_1(1,k,1)+t0, moist(1,k,1,P_QV)
+     write(6,'(i3,1x,5(1x,1pe10.3))') k, grid%ph_1(its,k,jts)+grid%phb(its,k,jts), &
+                                      grid%p(its,k,jts)+grid%pb(its,k,jts), grid%alt(its,k,jts), &
+                                      grid%t_1(its,k,jts)+t0, moist(its,k,jts,P_QV)
    enddo
 
    write(6,*) ' pert state sounding from comp, grid%ph_1, pp, alp, grid%t_1, qv '
    do k=1,kde-1
-     write(6,'(i3,1x,5(1x,1pe10.3))') k, grid%ph_1(1,k,1), &
-                                      grid%p(1,k,1), grid%al(1,k,1), &
-                                      grid%t_1(1,k,1), moist(1,k,1,P_QV)
+     write(6,'(i3,1x,5(1x,1pe10.3))') k, grid%ph_1(its,k,jts), &
+                                      grid%p(its,k,jts), grid%al(its,k,jts), &
+                                      grid%t_1(its,k,jts), moist(its,k,jts,P_QV)
    enddo
 
+
 !! interp v
 !
 !  DO J = jts, jte
@@ -1100,13 +1120,22 @@ SUBROUTINE init_domain_rk ( grid &
   ENDDO
   ENDDO
 
+  if ((its.eq.1).and.(jts.eq.1)) then
   DO k=1,kte-1
-    grid%t_base(k) = grid%t_1(1,k,1)
-    grid%qv_base(k) = moist(1,k,1,P_QV)
-    grid%u_base(k) = grid%u_1(1,k,1)
-    grid%v_base(k) = grid%v_1(1,k,1)
-    grid%z_base(k) = 0.5*(grid%phb(1,k,1)+grid%phb(1,k+1,1)+grid%ph_1(1,k,1)+grid%ph_1(1,k+1,1))/g
+    grid%t_base(k) = grid%t_1(its,k,jts)
+    grid%qv_base(k) = moist(its,k,jts,P_QV)
+    grid%u_base(k) = grid%u_1(its,k,jts)
+    grid%v_base(k) = grid%v_1(its,k,jts)
+    grid%z_base(k) = 0.5*(grid%phb(its,k,jts)+grid%phb(its,k+1,jts)+grid%ph_1(its,k,jts)+grid%ph_1(its,k+1,jts))/g
   ENDDO
+  endif
+#ifdef DM_PARALLEL
+    CALL wrf_dm_bcast_real( grid%t_base , kte )
+    CALL wrf_dm_bcast_real( grid%qv_base , kte )
+    CALL wrf_dm_bcast_real( grid%u_base , kte )
+    CALL wrf_dm_bcast_real( grid%v_base , kte )
+    CALL wrf_dm_bcast_real( grid%z_base , kte )
+#endif
 
   DO J = jts, min(jde-1,jte)
   DO I = its, min(ide-1,ite)