Changeset 2350 for palm/trunk/SOURCE/urban_surface_mod.f90

Timestamp:

Aug 15, 2017 11:48:26 AM (7 years ago)

Author:

kanani

Message:

bugfixes and workarounds for nopointer version

File:

• palm/trunk/SOURCE/urban_surface_mod.f90 (modified) (20 diffs)

palm/trunk/SOURCE/urban_surface_mod.f90

@@ -26 +26 @@
 ! -----------------
 ! $Id$
+! Bugfix and error message for nopointer version. 
+! Additional "! defined(__nopointer)" as workaround to enable compilation of 
+! nopointer version.
+! 
+! 2318 2017-07-20 17:27:44Z suehring
 ! Get topography top index via Function call 
 ! 
@@ -135 +140 @@
  MODULE urban_surface_mod
 
+#if ! defined( __nopointer )
     USE arrays_3d,                                                             &
         ONLY:  zu, pt, pt_1, pt_2, p, u, v, w, hyp, tend
+#endif
 
     USE cloud_parameters,                                                      &
@@ -441 +448 @@
 
 #if defined( __nopointer )
-    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_wall_h             !< Wall temperature (K)
-    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_wall_h_av          !< Average of t_wall
-    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_wall_h_p           !< Prog. wall temperature (K)
+    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    :: t_wall_h             !< Wall temperature (K)
+    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    :: t_wall_h_av          !< Average of t_wall
+    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    :: t_wall_h_p           !< Prog. wall temperature (K)
 
     TYPE(t_wall_vertical), DIMENSION(0:3), TARGET  :: t_wall_v             !< Wall temperature (K)
@@ -3156 +3163 @@
         INTEGER(iwp) ::  i, j, k, l, m            !< running indices
         REAL(wp)     ::  c, d, tin, exn
-        
+
+!
+!-- NOPOINTER version not implemented yet
+#if defined( __nopointer )
+    message_string = 'The urban surface module only runs with POINTER version'
+    CALL message( 'urban_surface_mod', 'PA0452', 1, 2, 0, 6, 0 )
+#endif
 
         CALL cpu_log( log_point_s(78), 'usm_init', 'start' )
@@ -3221 +3234 @@
 !--         At horizontal surfaces. Please note, t_surf_h is defined on a 
 !--         different data type, but with the same dimension.
+#if ! defined( __nopointer )
             DO  m = 1, surf_usm_h%ns
                i = surf_usm_h%i(m)            
@@ -3239 +3253 @@
                ENDDO
             ENDDO
-
+#endif
       
 !--         initial values for t_wall
@@ -3519 +3533 @@
         INTEGER(iwp), DIMENSION(0:3) :: reorder = (/ 1, 0, 3, 2 /)
         
-        
+#if ! defined( __nopointer )
         IF ( plant_canopy )  THEN
             pchf_prep(:) = r_d * (hyp(nzub:nzut) / 100000.0_wp)**0.286_wp &
                         / (cp * hyp(nzub:nzut) * dx*dy*dz) !< equals to 1 / (rho * c_p * Vbox * T)
         ENDIF
-
+#endif
         sun_direction = .TRUE.
         CALL calc_zenith  !< required also for diffusion radiation
@@ -3782 +3796 @@
 
 !--     push heat flux absorbed by plant canopy to respective 3D arrays
+#if ! defined( __nopointer )
         IF ( plant_canopy )  THEN
             pc_heating_rate(:,:,:) = 0._wp
@@ -3795 +3810 @@
             ENDDO
         ENDIF
+#endif
 !
 !--     Transfer radiation arrays required for energy balance to the respective data types
@@ -4293 +4309 @@
                                               t_surf_h, tmp_surf_h,            &
                                               surf_usm_h%start_index )
-                      ENDIF
 #else                      
                       IF ( kk == 1 )  THEN
@@ -4315 +4330 @@
                                               t_surf_v(0)%t, tmp_surf_v(0)%t,  &
                                               surf_usm_v(0)%start_index )
-                      ENDIF
 #else                      
                       IF ( kk == 1 )  THEN
@@ -4459 +4473 @@
                                               t_wall_v(2)%t, tmp_wall_v(2)%t,  &
                                               surf_usm_v(2)%start_index )
-                      ENDIF
 #else
                       IF ( kk == 1 )  THEN
@@ -4812 +4825 @@
 
            IF ( usm_par(5,jw,iw) == 0 )  THEN
+#if ! defined( __nopointer )
               IF ( zu(kw) >= roof_height_limit )  THEN
                  surf_usm_h%isroof_surf(m)   = .TRUE.
@@ -4819 +4833 @@
                  surf_usm_h%surface_types(m) = land_category         !< default category for land surface
               ENDIF
+#endif
               surf_usm_h%albedo_surf(m)    = -1.0_wp
               surf_usm_h%thickness_wall(m) = -1.0_wp
@@ -5038 +5053 @@
 
         dxdir = (/dz,dy,dy,dx,dx/)
-        
+#if ! defined( __nopointer )
         exn(:) = (hyp(nzub:nzut) / 100000.0_wp )**0.286_wp          !< Exner function
+#endif
 !        
 !--     First, treat horizontal surface elements
@@ -5058 +5074 @@
               lambda_surface = surf_usm_h%lambda_surf(m)
            ENDIF
-            
+#if ! defined( __nopointer )
            pt1  = pt(k,j,i)
 !
 !--        calculate rho * cp coefficient at surface layer
            rho_cp  = cp * hyp(k) / ( r_d * pt1 * exn(k) )
+#endif
 !
 !--        Calculate aerodyamic resistance. 
@@ -5138 +5155 @@
 !--        pt(k,j,i) is calculated for all directions in diffusion_s
 !--        using surface and wall heat fluxes
+#if ! defined( __nopointer )
            pt(k-1,j,i) = t_surf_h_p(m) / exn(k)  ! not for vertical surfaces
+#endif
 
 !--        calculate fluxes
@@ -5172 +5191 @@
 !--          stratification is not considered in this case.
              lambda_surface = surf_usm_v(l)%lambda_surf(m)
-            
+#if ! defined( __nopointer )          
              pt1  = pt(k,j,i)
 !
 !--          calculate rho * cp coefficient at surface layer
              rho_cp  = cp * hyp(k) / ( r_d * pt1 * exn(k) )
+#endif
 
 !--          Calculation of r_a for vertical surfaces
@@ -5201 +5221 @@
 !--          obtained by simple linear interpolation. ( An alternative would
 !--          be an logarithmic interpolation. )
+#if ! defined( __nopointer )
              u1 = ( u(k,j,i) + u(k,j,i+1) ) * 0.5_wp
              v1 = ( v(k,j,i) + v(k,j+1,i) ) * 0.5_wp
              w1 = ( w(k,j,i) + w(k-1,j,i) ) * 0.5_wp
+#endif
                 
              Ueff   = SQRT( u1**2 + v1**2 + w1**2 )
@@ -5317 +5339 @@
 !--     pt and shf are defined on nxlg:nxrg,nysg:nyng
 !--     get the borders from neighbours
+#if ! defined( __nopointer )
         CALL exchange_horiz( pt, nbgp )
+#endif