Changeset 1766

Timestamp:

Feb 29, 2016 8:37:15 AM (9 years ago)

Author:

raasch

Message:

pmc now runs with pointer version too

Location:

palm/trunk/SOURCE

Files:

• Makefile (modified) (2 diffs)
• pmc_general.f90 (modified) (2 diffs)
• pmc_interface.f90 (modified) (11 diffs)
• pmc_server.f90 (modified) (10 diffs)
• swap_timelevel.f90 (modified) (4 diffs)

palm/trunk/SOURCE/Makefile

@@ -20 +20 @@
 # Current revisions:
 # ------------------
-# 
+# update dependency for swap_timelevel
 # 
 # Former revisions:
@@ -474 +474 @@
 surface_coupler.o: modules.o cpulog.o mod_kinds.o
 surface_layer_fluxes.o: modules.o mod_kinds.o land_surface_model.o
-swap_timelevel.o: modules.o cpulog.o mod_kinds.o land_surface_model.o
+swap_timelevel.o: modules.o cpulog.o mod_kinds.o land_surface_model.o\
+   pmc_interface.o
 temperton_fft.o: modules.o mod_kinds.o
 time_integration.o: modules.o advec_ws.o buoyancy.o calc_mean_profile.o \

palm/trunk/SOURCE/pmc_general.f90

@@ -20 +20 @@
 ! Current revisions:
 ! ------------------
-!
+! +po_data in type arraydef
 !
 ! Former revisions:
@@ -75 +75 @@
       INTEGER,DIMENSION(4)          :: A_dim                       ! Size of dimensions
       INTEGER                       :: dim_order                   ! Order of Dimensions: 2 = 2D array, 33 = 3D array
-      TYPE (c_ptr)                  :: data                        ! Pointer of data in server space
+      TYPE(c_ptr)                   :: data                        ! Pointer of data in server space
+      TYPE(c_ptr), DIMENSION(2)     :: po_data                     ! Base Pointers, PMC_S_Set_Active_data_array sets active pointer
       INTEGER(idp)                  :: BufIndex                    ! index in Send Buffer
       INTEGER                       :: BufSize                     ! size in Send Buffer

palm/trunk/SOURCE/pmc_interface.f90

@@ -20 +20 @@
 ! Current revisions:
 ! ------------------
-!
+! modifications to allow for using PALM's pointer version,
+! +new routine pmci_set_swaplevel
 !
 ! Former revisions:
@@ -42 +43 @@
 !------------------------------------------------------------------------------!
 
+#if defined( __nopointer )
+!-- TO_DO: is it really required to use arrays te_m, tu_m, etc. and to set them
+!--        to zero withi buildings?
     USE arrays_3d,                                                             &
         ONLY:  dzu, dzw, e, e_p, pt, pt_p, q, q_p, te_m, tu_m, tv_m, tw_m, u,  &
                u_p, v, v_p, w, w_p, zu, zw, z0
+#else
+   USE arrays_3d,                                                              &
+        ONLY:  dzu, dzw, e, e_p, e_1, e_2, pt, pt_p, pt_1, pt_2, q, q_p, q_1, q_2, te_m, tu_m, &
+               tv_m, tw_m, u, u_p, u_1, u_2, v, v_p, v_1, v_2, w, w_p, w_1, w_2, zu, zw, z0
+#endif
 
     USE control_parameters,                                                    &
@@ -94 +103 @@
         ONLY:  pmc_serverinit, pmc_s_fillbuffer, pmc_s_getdata_from_buffer,    &
                pmc_s_getnextarray, pmc_s_setind_and_allocmem,                  &
-               pmc_s_set_dataarray, pmc_s_set_2d_index_list
+               pmc_s_set_active_data_array, pmc_s_set_dataarray,               &
+               pmc_s_set_2d_index_list
 
 #endif
@@ -309 +319 @@
     END INTERFACE
 
+    INTERFACE pmci_set_swaplevel
+       MODULE PROCEDURE pmci_set_swaplevel
+    END INTERFACE pmci_set_swaplevel
+
     INTERFACE pmci_update_new
        MODULE PROCEDURE pmci_update_new
@@ -322 +336 @@
     PUBLIC pmci_server_initialize
     PUBLIC pmci_server_synchronize
+    PUBLIC pmci_set_swaplevel
     PUBLIC pmci_update_new
 
@@ -2214 +2229 @@
  END SUBROUTINE pmci_client_synchronize
                 
+
+
+ SUBROUTINE pmci_set_swaplevel( swaplevel )
+
+    IMPLICIT NONE
+
+    INTEGER(iwp),INTENT(IN) ::  swaplevel  !: swaplevel (1 or 2) of PALM's timestep
+
+    INTEGER(iwp)            ::  client_id  !:
+    INTEGER(iwp)            ::  m          !:
+
+!
+!-- After each timestep, alternately set buffer one or buffer two active
+    DO  m = 1, SIZE( pmc_server_for_client )-1
+       client_id = pmc_server_for_client(m)
+       CALL pmc_s_set_active_data_array( client_id, swaplevel )
+    ENDDO
+
+ END SUBROUTINE pmci_set_swaplevel
+
 
 
@@ -3320 +3355 @@
     w(nzt+1,:,:) = w(nzt,:,:)
 
-#if defined( __nopointer )
-
     u_p  = u
     v_p  = v
@@ -3331 +3364 @@
     ENDIF
 
-#endif
-
 !
 !-- TO_DO: Find out later if nesting would work without __nopointer.
@@ -3351 +3382 @@
 #if defined( __parallel )
     REAL(wp), POINTER, DIMENSION(:,:)    ::  p_2d        !:
+    REAL(wp), POINTER, DIMENSION(:,:)    ::  p_2d_sec    !:
     REAL(wp), POINTER, DIMENSION(:,:,:)  ::  p_3d        !:
+    REAL(wp), POINTER, DIMENSION(:,:,:)  ::  p_3d_sec    !:
     INTEGER(iwp)                         ::  ierr        !:
     INTEGER(iwp)                         ::  istat       !:
@@ -3369 +3402 @@
     !IF ( TRIM(name) == "z0" )    p_2d => z0
 
+#if defined( __nopointer )
     IF ( ASSOCIATED( p_3d ) )  THEN
        CALL pmc_s_set_dataarray( client_id, p_3d, nz_cl, nz )
@@ -3387 +3421 @@
        ENDIF
     ENDIF
+#else
+!-- TO_DO: Why aren't the other pointers (p_3d) not set to u_1, v_1, etc.??
+    IF ( TRIM(name) == "u" )     p_3d_sec => u_2
+    IF ( TRIM(name) == "v" )     p_3d_sec => v_2
+    IF ( TRIM(name) == "w" )     p_3d_sec => w_2
+    IF ( TRIM(name) == "e" )     p_3d_sec => e_2
+    IF ( TRIM(name) == "pt" )    p_3d_sec => pt_2
+    !IF ( TRIM(name) == "z0" )    p_2d_sec => z0_2
+
+    IF ( ASSOCIATED( p_3d ) )  THEN
+       CALL pmc_s_set_dataarray( client_id, p_3d, nz_cl, nz, &
+                                 array_2 = p_3d_sec )
+    ELSEIF ( ASSOCIATED( p_2d ) )  THEN
+       CALL pmc_s_set_dataarray( client_id, p_2d, array_2 = p_2d_sec )
+    ELSE
+!
+!--    Give only one message for the root domain
+       IF ( myid == 0  .AND.  cpl_id == 1 )  THEN
+
+          message_string = 'pointer for array "' // TRIM( name ) //            &
+                           '" can''t be associated'
+          CALL message( 'pmci_set_array_pointer', 'PA0117', 3, 2, 0, 6, 0 )
+       ELSE
+!
+!--       Avoid others to continue
+          CALL MPI_BARRIER( comm2d, ierr )
+       ENDIF
+
+   ENDIF
+#endif
 
 #endif

palm/trunk/SOURCE/pmc_server.f90

@@ -20 +20 @@
 ! Current revisions:
 ! ------------------
-!
+! modifications to allow for using PALM's pointer version
+! +new routine PMC_S_Set_Active_data_array
 !
 ! Former revisions:
@@ -103 +104 @@
     END INTERFACE PMC_S_GetData_from_Buffer
 
+    INTERFACE PMC_S_Set_Active_data_array
+        MODULE procedure PMC_S_Set_Active_data_array
+    END INTERFACE PMC_S_Set_Active_data_array
+
     ! PUBLIC section
 
     PUBLIC PMC_ServerInit, PMC_S_Set_2D_index_list, PMC_S_GetNextArray, PMC_S_Set_DataArray
-    PUBLIC PMC_S_setInd_and_AllocMem, PMC_S_FillBuffer, PMC_S_GetData_from_Buffer
+    PUBLIC PMC_S_setInd_and_AllocMem, PMC_S_FillBuffer, PMC_S_GetData_from_Buffer, PMC_S_Set_Active_data_array
 
 CONTAINS
@@ -232 +237 @@
     END function PMC_S_GetNextArray
 
-    SUBROUTINE PMC_S_Set_DataArray_2d (ClientId, array)
+    SUBROUTINE PMC_S_Set_DataArray_2d (ClientId, array, array_2 )
         IMPLICIT none
         INTEGER,INTENT(IN)                         :: ClientId
 !--   TO_DO: has array always to be of dp-kind, or can wp used here
 !--          this effects all respective declarations in this file
-        REAL(kind=dp),INTENT(IN),DIMENSION(:,:)    :: array
+        REAL(kind=dp),INTENT(IN),DIMENSION(:,:)           :: array
+        REAL(kind=dp),INTENT(IN),DIMENSION(:,:),OPTIONAL  :: array_2
         !-- local variables
         INTEGER                           :: NrDims
@@ -243 +249 @@
         INTEGER                           :: dim_order
         TYPE(c_ptr)                       :: array_adr
+        TYPE(c_ptr)                       :: second_adr
 
         dims = 1
@@ -253 +260 @@
         array_adr = c_loc(array)
 
-        CALL PMC_S_SetArray (ClientId, NrDims, dims, dim_order, array_adr)
+        IF ( PRESENT( array_2 ) )  THEN
+           second_adr = c_loc(array_2)
+           CALL PMC_S_SetArray (ClientId, NrDims, dims, dim_order, array_adr, second_adr = second_adr)
+        ELSE
+           CALL PMC_S_SetArray (ClientId, NrDims, dims, dim_order, array_adr)
+        ENDIF
 
         return
     END SUBROUTINE PMC_S_Set_DataArray_2d
 
-    SUBROUTINE PMC_S_Set_DataArray_3d (ClientId, array, nz_cl, nz)
+    SUBROUTINE PMC_S_Set_DataArray_3d (ClientId, array, nz_cl, nz, array_2 )
         IMPLICIT none
         INTEGER,INTENT(IN)                         :: ClientId
         REAL(kind=dp),INTENT(IN),DIMENSION(:,:,:)  :: array
+        REAL(kind=dp),INTENT(IN),DIMENSION(:,:,:),OPTIONAL  :: array_2
         INTEGER,INTENT(IN)                         :: nz_cl
         INTEGER,INTENT(IN)                         :: nz
@@ -269 +282 @@
         INTEGER                           :: dim_order
         TYPE(c_ptr)                       :: array_adr
+        TYPE(c_ptr)                       :: second_adr
 
         dims = 1
@@ -282 +296 @@
         array_adr = c_loc(array)
 
-        CALL PMC_S_SetArray (ClientId, NrDims, dims, dim_order, array_adr)
+!
+!--     In PALM's pointer version, two indices have to be stored internally.
+!--     The active address of the data array is set in swap_timelevel
+        IF ( PRESENT( array_2 ) )  THEN
+          second_adr = c_loc(array_2)
+          CALL PMC_S_SetArray (ClientId, NrDims, dims, dim_order, array_adr, second_adr = second_adr)
+        ELSE
+           CALL PMC_S_SetArray (ClientId, NrDims, dims, dim_order, array_adr)
+        ENDIF
 
         return
@@ -510 +532 @@
    END SUBROUTINE Get_DA_names_from_client
 
-   SUBROUTINE PMC_S_SetArray (ClientId, NrDims, dims, dim_order, array_adr)
+   SUBROUTINE PMC_S_SetArray (ClientId, NrDims, dims, dim_order, array_adr, second_adr)
       IMPLICIT none
 
@@ -518 +540 @@
       INTEGER,INTENT(IN)                      :: dim_order
       TYPE(c_ptr),INTENT(IN)                  :: array_adr
+      TYPE(c_ptr),INTENT(IN),OPTIONAL         :: second_adr
 
       INTEGER                                 :: i
@@ -533 +556 @@
           ar%dim_order = dim_order
           ar%data      = array_adr
+          if(present(second_adr)) then
+             ar%po_data(1) = array_adr
+             ar%po_data(2) = second_adr
+          else
+             ar%po_data(1) = C_NULL_PTR
+             ar%po_data(2) = C_NULL_PTR
+          end if
        end do
 
       return
    END SUBROUTINE PMC_S_SetArray
+
+
+   SUBROUTINE PMC_S_Set_Active_data_array (ClientId,iactive)
+      IMPLICIT none
+
+      INTEGER,INTENT(IN)                      :: ClientId
+      INTEGER,INTENT(IN)                      :: iactive
+
+!--   local variables
+      INTEGER                                 :: i, ip
+      TYPE(PeDef),POINTER                     :: aPE
+      TYPE(ArrayDef),POINTER                  :: ar
+      CHARACTER(len=DA_Namelen)               :: myName
+
+      do ip=1,Clients(ClientId)%inter_npes
+         aPE => Clients(ClientId)%PEs(ip)
+         do while (PMC_S_GetNextArray ( ClientId, myName,ip))
+            ar  => aPE%Arrays
+            if(iactive == 1 .OR. iactive == 2)   then
+               ar%data = ar%po_data(iactive)
+            end if
+         end do
+      end do
+
+      return
+   END SUBROUTINE PMC_S_Set_Active_data_array
 
 

palm/trunk/SOURCE/swap_timelevel.f90

@@ -19 +19 @@
 ! Current revisions:
 ! -----------------
-! 
+! setting the swap level for pmc data transfer
 !
 ! Former revisions:
@@ -99 +99 @@
     USE indices,                                                               &
         ONLY:  nxlg, nxrg, nyng, nysg, nzb, nzt
+
+    USE pmc_interface,                                                         &
+        ONLY: nested_run, pmci_set_swaplevel
+
+
     IMPLICIT NONE
 
-    INTEGER ::  i, j, k   !: loop indices
+    INTEGER ::  i, j, k     !> loop indices
+    INTEGER ::  swap_level  !> swap_level for steering the pmc data transfer
 
 !
@@ -195 +201 @@
           ENDIF
 
+          swap_level = 1
 
        CASE ( 1 )
@@ -223 +230 @@
           ENDIF
 
+          swap_level = 2
 
     END SELECT
+
+!
+!-- Set the swap level for steering the pmc data transfer
+    IF ( nested_run )  CALL pmci_set_swaplevel( swap_level )
 
     CALL cpu_log( log_point(28), 'swap_timelevel', 'stop' )