Changeset 1766 for palm/trunk/SOURCE/pmc_server.f90

Timestamp:

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

Author:

raasch

Message:

pmc now runs with pointer version too

File:

• palm/trunk/SOURCE/pmc_server.f90 (modified) (10 diffs)

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