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

Timestamp:

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

Author:

raasch

Message:

pmc now runs with pointer version too

File:

• palm/trunk/SOURCE/pmc_interface.f90 (modified) (11 diffs)

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