Changeset 3948 for palm/trunk/SOURCE/pmc_interface_mod.f90

Timestamp:

May 3, 2019 2:49:57 PM (5 years ago)

Author:

hellstea

Message:

some cleaning up

File:

• palm/trunk/SOURCE/pmc_interface_mod.f90 (modified) (41 diffs)

palm/trunk/SOURCE/pmc_interface_mod.f90

@@ -25 +25 @@
 ! -----------------
 ! $Id$
+! Some variables renamed, a little cleaning up and some commenting improvements 
+! 
+! 3947 2019-05-03 07:56:44Z hellstea
 ! The checks included in 3946 are extended for the z-direction and moved into its
 ! own subroutine called from pmci_define_index_mapping.
@@ -542 +545 @@
 !
 !-- Children's parent-grid arrays
-    INTEGER(iwp), SAVE, DIMENSION(5), PUBLIC    ::  coarse_bound        !< subdomain index bounds for children's parent-grid arrays
+    INTEGER(iwp), SAVE, DIMENSION(5), PUBLIC    ::  parent_bound        !< subdomain index bounds for children's parent-grid arrays
 
     REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  dissc !< Parent-grid array on child domain - dissipation rate
@@ -804 +807 @@
 !
 !-- Set the steering switch which tells the models that they are nested (of
-!-- course the root domain (cpl_id = 1) is not nested)
-    IF ( cpl_id >= 2 )  THEN
+!-- course the root domain is not nested)
+    IF ( .NOT.  pmc_is_rootmodel() )  THEN
        child_domain = .TRUE.
        WRITE( coupling_char, '(A2,I2.2)') '_N', cpl_id
@@ -823 +826 @@
 !-- because no location messages would be generated otherwise.
 !-- world_comm is given a dummy value to avoid compiler warnings (INTENT(OUT)
-!-- should get an explicit value)
-!-- todo: why don't we print an error message instead of these settings?
+!-- must get an explicit value).
+!-- Note that this branch is only to avoid compiler warnings. The actual 
+!-- execution never reaches here because the call of this subroutine is 
+!-- already enclosed by  #if defined( __parallel ).
     cpl_id     = 1
     nested_run = .FALSE.
@@ -944 +949 @@
                                       !< of the child msib is within the y-range of the child m
 !
-!-- Initialize the current pmc parent
+!-- Initialize the current pmc parent.
     CALL pmc_parentinit
 !
@@ -980 +985 @@
 !--       Find the highest child-domain level in the parent grid for the reduced z
 !--       transfer
-          DO  kp = 1, nz                 
+          DO  kp = 1, nzt                 
              IF ( zw(kp) > child_height )  THEN
                 nz_child = kp
@@ -1041 +1046 @@
 !--       that the top ghost layer of the child grid does not exceed 
 !--       the parent domain top boundary.
-          IF ( child_height > zw(nz) ) THEN
+          IF ( child_height > zw(nzt) ) THEN
              nomatch = 1
           ENDIF
@@ -1462 +1467 @@
           CALL pmc_recv_from_parent( rans_mode_parent, 1, 0, 19, ierr )
 !
-!--       Receive Coarse grid information.
+!--       Receive parent-grid information.
           CALL pmc_recv_from_parent( parent_grid_info_real,                    &
                                      SIZE(parent_grid_info_real), 0, 21, ierr )
@@ -1480 +1485 @@
        pg%nz = parent_grid_info_int(3)
 !
-!--    Get parent coordinates on coarse grid
+!--    Allocate 1-D arrays for parent-grid coordinates and grid-spacings in the z-direction
        ALLOCATE( pg%coord_x(-nbgp:pg%nx+nbgp) )
        ALLOCATE( pg%coord_y(-nbgp:pg%ny+nbgp) )
@@ -1488 +1493 @@
        ALLOCATE( pg%zw(0:pg%nz+1) )
 !
-!--    Get coarse grid coordinates and values of the z-direction from the parent
+!--    Get parent-grid coordinates and grid-spacings in the z-direction from the parent
        IF ( myid == 0)  THEN
           CALL pmc_recv_from_parent( pg%coord_x, pg%nx+1+2*nbgp, 0, 24, ierr )
@@ -1505 +1510 @@
        CALL MPI_BCAST( pg%zu, pg%nz+2,  MPI_REAL, 0, comm2d, ierr )
        CALL MPI_BCAST( pg%zw, pg%nz+2,  MPI_REAL, 0, comm2d, ierr )
-       CALL MPI_BCAST( rans_mode_parent, 1, MPI_LOGICAL, 0, comm2d, ierr )
-
-!  CHECK IF pmci_check_grid_matching COULD BE MOVED HERE.
-       
+       CALL MPI_BCAST( rans_mode_parent, 1, MPI_LOGICAL, 0, comm2d, ierr )       
 !
 !--    Find the index bounds for the nest domain in the coarse-grid index space
@@ -1569 +1571 @@
        IMPLICIT NONE
 
-       INTEGER(iwp), DIMENSION(5,numprocs) ::  coarse_bound_all     !< Transfer array for parent-grid index bounds
+       INTEGER(iwp), DIMENSION(5,numprocs) ::  parent_bound_all     !< Transfer array for parent-grid index bounds
 
        INTEGER(iwp), DIMENSION(4)          ::  parent_bound_global  !< Transfer array for global parent-grid index bounds
@@ -1693 +1695 @@
        FLUSH(9)
 
-       coarse_bound(1) = ipl
-       coarse_bound(2) = ipr
-       coarse_bound(3) = jps
-       coarse_bound(4) = jpn
-       coarse_bound(5) = myid
+       parent_bound(1) = ipl
+       parent_bound(2) = ipr
+       parent_bound(3) = jps
+       parent_bound(4) = jpn
+       parent_bound(5) = myid
 !
 !--    The following index bounds are used for allocating index mapping and some other auxiliary arrays
@@ -1708 +1710 @@
 !--    This fact is exploited in creating the index list in pmci_create_index_list
 !    IMPROVE THIS COMMENT. EXPLAIN WHERE THIS INFORMATION IS NEEDED.
-       CALL MPI_GATHER( coarse_bound, 5, MPI_INTEGER, coarse_bound_all, 5,                          &
+       CALL MPI_GATHER( parent_bound, 5, MPI_INTEGER, parent_bound_all, 5,                          &
                         MPI_INTEGER, 0, comm2d, ierr )
 
        IF ( myid == 0 )  THEN
-          size_of_array(1) = SIZE( coarse_bound_all, 1 )
-          size_of_array(2) = SIZE( coarse_bound_all, 2 )
+          size_of_array(1) = SIZE( parent_bound_all, 1 )
+          size_of_array(2) = SIZE( parent_bound_all, 2 )
           CALL pmc_send_to_parent( size_of_array, 2, 0, 40, ierr )
-          CALL pmc_send_to_parent( coarse_bound_all, SIZE( coarse_bound_all ), 0, 41, ierr )
+          CALL pmc_send_to_parent( parent_bound_all, SIZE( parent_bound_all ), 0, 41, ierr )
 !
 !--       Determine the global parent-grid index bounds       
-          parent_bound_global(1) = MINVAL( coarse_bound_all(1,:) )
-          parent_bound_global(2) = MAXVAL( coarse_bound_all(2,:) )
-          parent_bound_global(3) = MINVAL( coarse_bound_all(3,:) )
-          parent_bound_global(4) = MAXVAL( coarse_bound_all(4,:) )
+          parent_bound_global(1) = MINVAL( parent_bound_all(1,:) )
+          parent_bound_global(2) = MAXVAL( parent_bound_all(2,:) )
+          parent_bound_global(3) = MINVAL( parent_bound_all(3,:) )
+          parent_bound_global(4) = MAXVAL( parent_bound_all(4,:) )
        ENDIF
 !
@@ -2404 +2406 @@
     IF ( .NOT. salsa_gases_from_chem )  pmc_max_array = pmc_max_array + ngases_salsa
 
-
 #endif
     
@@ -2411 +2412 @@
 
  SUBROUTINE pmci_set_array_pointer( name, child_id, nz_child, n )
-
+   
     IMPLICIT NONE
    
@@ -2420 +2421 @@
     
     CHARACTER(LEN=*), INTENT(IN) ::  name             !<
+
+#if defined( __parallel )     
 !
 !-- Local variables:       
@@ -2487 +2490 @@
 !
 !--    Give only one message for the root domain
-       IF ( myid == 0  .AND.  cpl_id == 1 )  THEN             
+       IF ( pmc_is_rootmodel()  .AND.  myid == 0 )  THEN
           message_string = 'pointer for array "' // TRIM( name ) // '" can''t be associated'
           CALL message( 'pmci_set_array_pointer', 'PA0117', 3, 2, 0, 6, 0 )
@@ -2497 +2500 @@
        
     ENDIF
+    
+#endif
     
  END SUBROUTINE pmci_set_array_pointer
@@ -2547 +2552 @@
     REAL(wp),INTENT(OUT) ::  lx_coord, lx_coord_b  !<
     REAL(wp),INTENT(OUT) ::  rx_coord, rx_coord_b  !<
+    REAL(wp),INTENT(OUT) ::  ny_coord, ny_coord_b  !<
     REAL(wp),INTENT(OUT) ::  sy_coord, sy_coord_b  !<
-    REAL(wp),INTENT(OUT) ::  ny_coord, ny_coord_b  !<
     REAL(wp),INTENT(OUT) ::  uz_coord, uz_coord_b  !<
 
+    
+#if defined( __parallel )
     
     lx_coord = childgrid(m)%lx_coord
@@ -2564 +2571 @@
     uz_coord_b = childgrid(m)%uz_coord_b
     
+#endif
+    
  END SUBROUTINE get_child_edges
 
@@ -2578 +2587 @@
     REAL(wp), INTENT(OUT), OPTIONAL ::  dz     !<
 
+
+#if defined( __parallel )
     
     dx = childgrid(m)%dx
@@ -2585 +2596 @@
     ENDIF
     
+#endif
+    
  END SUBROUTINE get_child_gridspacing
 
@@ -2598 +2611 @@
     INTEGER(iwp), INTENT(IN) ::  js      !<
     INTEGER(iwp), INTENT(IN) ::  nzc     !<  nzc is pg%nz, but note that pg%nz is not the original nz of parent,
-                                            !<  but the highest parent-grid level needed for nesting.
+                                         !<  but the highest parent-grid level needed for nesting.
     INTEGER(iwp), INTENT(IN), OPTIONAL ::  n  !< number of chemical species / salsa variables
     
     CHARACTER(LEN=*), INTENT(IN) ::  name    !<
+
+#if defined( __parallel )
 !       
 !-- Local variables:
@@ -2687 +2702 @@
     ELSE
 !
-!-- Give only one message for the first child domain.
-       IF ( myid == 0  .AND.  cpl_id == 2 )  THEN
+!--    Give only one message for the first child domain.
+       IF ( cpl_id == 2  .AND.  myid == 0 )  THEN
           message_string = 'pointer for array "' // TRIM( name ) //            &
                '" can''t be associated'
@@ -2700 +2715 @@
     ENDIF
 
+#endif
  END SUBROUTINE pmci_create_childs_parent_grid_arrays
 
 
-!
-! E N D   O F    S E T U P   R O U T I N E S 
-!
  SUBROUTINE pmci_parent_initialize
 
@@ -2748 +2761 @@
 !
 !-- Root model is never anyone's child
-    IF ( cpl_id > 1 )  THEN
+    IF ( .NOT.  pmc_is_rootmodel() )  THEN
 !
 !--    Get data from the parent
@@ -3202 +3215 @@
 
 
- SUBROUTINE pmci_datatrans( local_nesting_mode )
+ SUBROUTINE pmci_datatrans( local_nesting_mode )   
 !
 !-- This subroutine controls the nesting according to the nestpar 
@@ -3218 +3231 @@
     CHARACTER(LEN=*), INTENT(IN) ::  local_nesting_mode  !<  Nesting mode: 'one-way', 'two-way' or 'vertical'
 
+#if defined( __parallel )    
 !
 !-- Debug location message
@@ -3266 +3280 @@
     ENDIF
 
+#endif
  END SUBROUTINE pmci_datatrans
 
@@ -3271 +3286 @@
 
  SUBROUTINE pmci_parent_datatrans( direction )
-
+   
     IMPLICIT NONE
 
@@ -3344 +3359 @@
 
     dtl = dt_3d
-    IF ( cpl_id > 1 )  THEN
+    IF ( .NOT.  pmc_is_rootmodel() )  THEN
 
        IF ( direction == parent_to_child )  THEN
@@ -3929 +3944 @@
       workarr_lr = 0.0_wp     
       IF ( pdims(2) > 1 )  THEN
-#if defined( __parallel )
+         
          IF ( bc_dirichlet_s )  THEN 
             workarr_lr(0:pg%nz+1,jpsw:jpnw-1,0:2) = parent_array(0:pg%nz+1,jpsw:jpnw-1,ipbeg:ipbeg+2)
@@ -3952 +3967 @@
                             workarr_lr(0,jpsw,0), 1, workarr_lr_exchange_type, psouth,  1, comm2d,  &
                             status, ierr )                               
-#endif                                                                        
+
       ELSE                                                                    
          workarr_lr(0:pg%nz+1,jpsw:jpnw,0:2) = parent_array(0:pg%nz+1,jpsw:jpnw,ipbeg:ipbeg+2)            
@@ -4163 +4178 @@
       workarr_sn = 0.0_wp     
       IF ( pdims(1) > 1 )  THEN
-#if defined( __parallel )
+
          IF ( bc_dirichlet_l )  THEN
             workarr_sn(0:pg%nz+1,0:2,iplw:iprw-1) = parent_array(0:pg%nz+1,jpbeg:jpbeg+2,iplw:iprw-1)
@@ -4186 +4201 @@
                             workarr_sn(0,0,iplw), 1, workarr_sn_exchange_type, pleft, 1, comm2d,    &
                             status, ierr )
-#endif                                                                      
+
       ELSE                                                                  
          workarr_sn(0:pg%nz+1,0:2,iplw+1:iprw-1)                                                    &
@@ -4402 +4417 @@
 !--   Note that in case of 3-D nesting the left and right boundaries are 
 !--   not exchanged because the nest domain is not cyclic.
-#if defined( __parallel )
       IF ( pdims(1) > 1 )  THEN
 !
@@ -4431 +4445 @@
                             comm2d, status, ierr )
       ENDIF
-#endif      
 
       IF  ( var == 'w' )  THEN
@@ -4626 +4639 @@
 !
 !--   Define the index bounds ipl_anterp, ipr_anterp, jps_anterp and jpn_anterp.
-!--   Note that kcb_anterp is simply zero and kct_anterp enters here as a
-!--   parameter and it is determined in pmci_define_index_mapping.
-!--   Note that the grid points used also for interpolation (from parent to
+!--   Note that kcb_anterp is simply zero and kct_anterp depends on kct which enters 
+!--   here as a parameter and it is determined in pmci_define_index_mapping.
+!--   Note that the grid points directly used also for interpolation (from parent to
 !--   child) are always excluded from anterpolation, e.g. anterpolation is maximally
-!--   only from nzb:kct-1, as kct is used for interpolation. Similar restriction is
+!--   only from 0:kct-1, since kct is directly used for interpolation. Similar restriction is
 !--   applied to the lateral boundaries as well. An additional buffer is
 !--   also applied (default value for anterpolation_buffer_width = 2) in order
@@ -4708 +4721 @@
  SUBROUTINE pmci_boundary_conds
 
+#if defined( __parallel )
     USE chem_modules,                                                          &
         ONLY:  ibc_cs_b
@@ -4930 +4944 @@
     ENDIF
 
+#endif
  END SUBROUTINE pmci_boundary_conds