Changeset 2350 for palm/trunk/SOURCE/urban_surface_mod.f90
 Timestamp:
 Aug 15, 2017 11:48:26 AM (4 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

palm/trunk/SOURCE/urban_surface_mod.f90
r2318 r2350 26 26 !  27 27 ! $Id$ 28 ! Bugfix and error message for nopointer version. 29 ! Additional "! defined(__nopointer)" as workaround to enable compilation of 30 ! nopointer version. 31 ! 32 ! 2318 20170720 17:27:44Z suehring 28 33 ! Get topography top index via Function call 29 34 ! … … 135 140 MODULE urban_surface_mod 136 141 142 #if ! defined( __nopointer ) 137 143 USE arrays_3d, & 138 144 ONLY: zu, pt, pt_1, pt_2, p, u, v, w, hyp, tend 145 #endif 139 146 140 147 USE cloud_parameters, & … … 441 448 442 449 #if defined( __nopointer ) 443 REAL(wp), DIMENSION(: ), ALLOCATABLE, TARGET :: t_wall_h !< Wall temperature (K)444 REAL(wp), DIMENSION(: ), ALLOCATABLE, TARGET :: t_wall_h_av !< Average of t_wall445 REAL(wp), DIMENSION(: ), ALLOCATABLE, TARGET :: t_wall_h_p !< Prog. wall temperature (K)450 REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET :: t_wall_h !< Wall temperature (K) 451 REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET :: t_wall_h_av !< Average of t_wall 452 REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET :: t_wall_h_p !< Prog. wall temperature (K) 446 453 447 454 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 3157 3164 REAL(wp) :: c, d, tin, exn 3158 3165 3166 ! 3167 ! NOPOINTER version not implemented yet 3168 #if defined( __nopointer ) 3169 message_string = 'The urban surface module only runs with POINTER version' 3170 CALL message( 'urban_surface_mod', 'PA0452', 1, 2, 0, 6, 0 ) 3171 #endif 3159 3172 3160 3173 CALL cpu_log( log_point_s(78), 'usm_init', 'start' ) … … 3221 3234 ! At horizontal surfaces. Please note, t_surf_h is defined on a 3222 3235 ! different data type, but with the same dimension. 3236 #if ! defined( __nopointer ) 3223 3237 DO m = 1, surf_usm_h%ns 3224 3238 i = surf_usm_h%i(m) … … 3239 3253 ENDDO 3240 3254 ENDDO 3241 3255 #endif 3242 3256 3243 3257 ! initial values for t_wall … … 3519 3533 INTEGER(iwp), DIMENSION(0:3) :: reorder = (/ 1, 0, 3, 2 /) 3520 3534 3521 3535 #if ! defined( __nopointer ) 3522 3536 IF ( plant_canopy ) THEN 3523 3537 pchf_prep(:) = r_d * (hyp(nzub:nzut) / 100000.0_wp)**0.286_wp & 3524 3538 / (cp * hyp(nzub:nzut) * dx*dy*dz) !< equals to 1 / (rho * c_p * Vbox * T) 3525 3539 ENDIF 3526 3540 #endif 3527 3541 sun_direction = .TRUE. 3528 3542 CALL calc_zenith !< required also for diffusion radiation … … 3782 3796 3783 3797 ! push heat flux absorbed by plant canopy to respective 3D arrays 3798 #if ! defined( __nopointer ) 3784 3799 IF ( plant_canopy ) THEN 3785 3800 pc_heating_rate(:,:,:) = 0._wp … … 3795 3810 ENDDO 3796 3811 ENDIF 3812 #endif 3797 3813 ! 3798 3814 ! Transfer radiation arrays required for energy balance to the respective data types … … 4293 4309 t_surf_h, tmp_surf_h, & 4294 4310 surf_usm_h%start_index ) 4295 ENDIF4296 4311 #else 4297 4312 IF ( kk == 1 ) THEN … … 4315 4330 t_surf_v(0)%t, tmp_surf_v(0)%t, & 4316 4331 surf_usm_v(0)%start_index ) 4317 ENDIF4318 4332 #else 4319 4333 IF ( kk == 1 ) THEN … … 4459 4473 t_wall_v(2)%t, tmp_wall_v(2)%t, & 4460 4474 surf_usm_v(2)%start_index ) 4461 ENDIF4462 4475 #else 4463 4476 IF ( kk == 1 ) THEN … … 4812 4825 4813 4826 IF ( usm_par(5,jw,iw) == 0 ) THEN 4827 #if ! defined( __nopointer ) 4814 4828 IF ( zu(kw) >= roof_height_limit ) THEN 4815 4829 surf_usm_h%isroof_surf(m) = .TRUE. … … 4819 4833 surf_usm_h%surface_types(m) = land_category !< default category for land surface 4820 4834 ENDIF 4835 #endif 4821 4836 surf_usm_h%albedo_surf(m) = 1.0_wp 4822 4837 surf_usm_h%thickness_wall(m) = 1.0_wp … … 5038 5053 5039 5054 dxdir = (/dz,dy,dy,dx,dx/) 5040 5055 #if ! defined( __nopointer ) 5041 5056 exn(:) = (hyp(nzub:nzut) / 100000.0_wp )**0.286_wp !< Exner function 5057 #endif 5042 5058 ! 5043 5059 ! First, treat horizontal surface elements … … 5058 5074 lambda_surface = surf_usm_h%lambda_surf(m) 5059 5075 ENDIF 5060 5076 #if ! defined( __nopointer ) 5061 5077 pt1 = pt(k,j,i) 5062 5078 ! 5063 5079 ! calculate rho * cp coefficient at surface layer 5064 5080 rho_cp = cp * hyp(k) / ( r_d * pt1 * exn(k) ) 5081 #endif 5065 5082 ! 5066 5083 ! Calculate aerodyamic resistance. … … 5138 5155 ! pt(k,j,i) is calculated for all directions in diffusion_s 5139 5156 ! using surface and wall heat fluxes 5157 #if ! defined( __nopointer ) 5140 5158 pt(k1,j,i) = t_surf_h_p(m) / exn(k) ! not for vertical surfaces 5159 #endif 5141 5160 5142 5161 ! calculate fluxes … … 5172 5191 ! stratification is not considered in this case. 5173 5192 lambda_surface = surf_usm_v(l)%lambda_surf(m) 5174 5193 #if ! defined( __nopointer ) 5175 5194 pt1 = pt(k,j,i) 5176 5195 ! 5177 5196 ! calculate rho * cp coefficient at surface layer 5178 5197 rho_cp = cp * hyp(k) / ( r_d * pt1 * exn(k) ) 5198 #endif 5179 5199 5180 5200 ! Calculation of r_a for vertical surfaces … … 5201 5221 ! obtained by simple linear interpolation. ( An alternative would 5202 5222 ! be an logarithmic interpolation. ) 5223 #if ! defined( __nopointer ) 5203 5224 u1 = ( u(k,j,i) + u(k,j,i+1) ) * 0.5_wp 5204 5225 v1 = ( v(k,j,i) + v(k,j+1,i) ) * 0.5_wp 5205 5226 w1 = ( w(k,j,i) + w(k1,j,i) ) * 0.5_wp 5227 #endif 5206 5228 5207 5229 Ueff = SQRT( u1**2 + v1**2 + w1**2 ) … … 5317 5339 ! pt and shf are defined on nxlg:nxrg,nysg:nyng 5318 5340 ! get the borders from neighbours 5341 #if ! defined( __nopointer ) 5319 5342 CALL exchange_horiz( pt, nbgp ) 5343 #endif 5320 5344 5321 5345
Note: See TracChangeset
for help on using the changeset viewer.