Changeset 1320 for palm/trunk/SOURCE/buoyancy.f90
- Timestamp:
- Mar 20, 2014 8:40:49 AM (10 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/buoyancy.f90 (modified) (12 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/buoyancy.f90
r1310 r1320 20 20 ! Currrent revisions: 21 21 ! ------------------ 22 ! 22 ! ONLY-attribute added to USE-statements, 23 ! kind-parameters added to all INTEGER and REAL declaration statements, 24 ! kinds are defined in new module kinds, 25 ! revision history before 2012 removed, 26 ! comment fields (!:) to be used for variable explanations added to 27 ! all variable declaration statements 23 28 ! 24 29 ! Former revisions: … … 55 60 ! 1010 2012-09-20 07:59:54Z raasch 56 61 ! cpp switch __nopointer added for pointer free version 57 !58 ! 622 2010-12-10 08:08:13Z raasch59 ! optional barriers included in order to speed up collective operations60 !61 ! 515 2010-03-18 02:30:38Z raasch62 ! PGI-compiler creates SIGFPE in routine buoyancy, if opt>1 is used! Therefore,63 ! opt=1 is forced by compiler-directive.64 !65 ! 247 2009-02-27 14:01:30Z heinze66 ! Output of messages replaced by message handling routine67 !68 ! 132 2007-11-20 09:46:11Z letzel69 ! Vertical scalar profiles now based on nzb_s_inner and ngp_2dh_s_inner.70 !71 ! 106 2007-08-16 14:30:26Z raasch72 ! i loop for u-component (sloping surface) is starting from nxlu (needed for73 ! non-cyclic boundary conditions)74 !75 ! 97 2007-06-21 08:23:15Z raasch76 ! Routine reneralized to be used with temperature AND density:77 ! argument theta renamed var, new argument var_reference,78 ! use_pt_reference renamed use_reference,79 ! calc_mean_pt_profile renamed calc_mean_profile80 !81 ! 57 2007-03-09 12:05:41Z raasch82 ! Reference temperature pt_reference can be used.83 !84 ! RCS Log replace by Id keyword, revision history cleaned up85 !86 ! Revision 1.19 2006/04/26 12:09:56 raasch87 ! OpenMP optimization (one dimension added to sums_l)88 62 ! 89 63 ! Revision 1.1 1997/08/29 08:56:48 raasch … … 121 95 SUBROUTINE buoyancy( var, wind_component ) 122 96 123 USE arrays_3d 124 USE control_parameters 125 USE indices 97 USE arrays_3d, & 98 ONLY: pt, pt_slope_ref, ref_state, tend 99 100 USE control_parameters, & 101 ONLY: atmos_ocean_sign, cos_alpha_surface, g, message_string, & 102 pt_surface, sin_alpha_surface, sloping_surface 103 104 USE indices, & 105 ONLY: nxl, nxlu, nxr, nyn, nys, nzb_s_inner, nzt 106 107 USE kinds 108 126 109 USE pegrid 127 110 111 128 112 IMPLICIT NONE 129 113 130 INTEGER :: i, j, k, wind_component 114 INTEGER(iwp) :: i !: 115 INTEGER(iwp) :: j !: 116 INTEGER(iwp) :: k !: 117 INTEGER(iwp) :: wind_component !: 118 131 119 #if defined( __nopointer ) 132 REAL , DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: var120 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: var !: 133 121 #else 134 REAL , DIMENSION(:,:,:), POINTER :: var122 REAL(wp), DIMENSION(:,:,:), POINTER :: var 135 123 #endif 136 124 … … 185 173 ELSE 186 174 187 WRITE( message_string, * ) 'no term for component "', &175 WRITE( message_string, * ) 'no term for component "', & 188 176 wind_component,'"' 189 177 CALL message( 'buoyancy', 'PA0159', 1, 2, 0, 6, 0 ) … … 201 189 SUBROUTINE buoyancy_acc( var, wind_component ) 202 190 203 USE arrays_3d 204 USE control_parameters 205 USE indices 191 USE arrays_3d, & 192 ONLY: pt, pt_slope_ref, ref_state, tend 193 194 USE control_parameters, & 195 ONLY: atmos_ocean_sign, cos_alpha_surface, g, message_string, & 196 pt_surface, sin_alpha_surface, sloping_surface 197 198 USE indices, & 199 ONLY: i_left, i_right, j_north, j_south, nxl, nxlu, nxr, nyn, nys, & 200 nzb_s_inner, nzt 201 202 USE kinds 203 206 204 USE pegrid 207 205 206 208 207 IMPLICIT NONE 209 208 210 INTEGER :: i, j, k, wind_component 209 INTEGER(iwp) :: i !: 210 INTEGER(iwp) :: j !: 211 INTEGER(iwp) :: k !: 212 INTEGER(iwp) :: wind_component !: 213 211 214 #if defined( __nopointer ) 212 REAL , DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: var215 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: var !: 213 216 #else 214 REAL , DIMENSION(:,:,:), POINTER :: var217 REAL(wp), DIMENSION(:,:,:), POINTER :: var 215 218 #endif 216 219 … … 269 272 ELSE 270 273 271 WRITE( message_string, * ) 'no term for component "', &274 WRITE( message_string, * ) 'no term for component "', & 272 275 wind_component,'"' 273 276 CALL message( 'buoyancy', 'PA0159', 1, 2, 0, 6, 0 ) … … 288 291 SUBROUTINE buoyancy_ij( i, j, var, wind_component ) 289 292 290 USE arrays_3d 291 USE control_parameters 292 USE indices 293 USE arrays_3d, & 294 ONLY: pt, pt_slope_ref, ref_state, tend 295 296 USE control_parameters, & 297 ONLY: atmos_ocean_sign, cos_alpha_surface, g, message_string, & 298 pt_surface, sin_alpha_surface, sloping_surface 299 300 USE indices, & 301 ONLY: nzb_s_inner, nzt 302 303 USE kinds 304 293 305 USE pegrid 294 306 307 295 308 IMPLICIT NONE 296 309 297 INTEGER :: i, j, k, pr, wind_component 310 INTEGER(iwp) :: i !: 311 INTEGER(iwp) :: j !: 312 INTEGER(iwp) :: k !: 313 INTEGER(iwp) :: pr !: 314 INTEGER(iwp) :: wind_component !: 315 298 316 #if defined( __nopointer ) 299 REAL , DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: var317 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: var !: 300 318 #else 301 REAL , DIMENSION(:,:,:), POINTER :: var319 REAL(wp), DIMENSION(:,:,:), POINTER :: var 302 320 #endif 303 321 … … 307 325 !-- Normal case: horizontal surface 308 326 DO k = nzb_s_inner(j,i)+1, nzt-1 309 tend(k,j,i) = tend(k,j,i) + atmos_ocean_sign * g * 0.5 * ( &310 ( var(k,j,i) - ref_state(k) ) / ref_state(k) + &311 ( var(k+1,j,i) - ref_state(k+1) ) / ref_state(k+1) &327 tend(k,j,i) = tend(k,j,i) + atmos_ocean_sign * g * 0.5 * ( & 328 ( var(k,j,i) - ref_state(k) ) / ref_state(k) + & 329 ( var(k+1,j,i) - ref_state(k+1) ) / ref_state(k+1) & 312 330 ) 313 331 ENDDO … … 340 358 ELSE 341 359 342 WRITE( message_string, * ) 'no term for component "', &360 WRITE( message_string, * ) 'no term for component "', & 343 361 wind_component,'"' 344 362 CALL message( 'buoyancy', 'PA0159', 1, 2, 0, 6, 0 ) … … 361 379 !------------------------------------------------------------------------------! 362 380 363 USE arrays_3d, ONLY: ref_state 364 USE control_parameters 365 USE indices 381 USE arrays_3d, & 382 ONLY: ref_state 383 384 USE control_parameters, & 385 ONLY: intermediate_timestep_count, message_string 386 387 USE indices, & 388 ONLY: ngp_2dh_s_inner, nxl, nxr, nyn, nys, nzb, nzb_s_inner, nzt 389 390 USE kinds 391 366 392 USE pegrid 367 USE statistics 393 394 USE statistics, & 395 ONLY: flow_statistics_called, hom, sums, sums_l 396 368 397 369 398 IMPLICIT NONE 370 399 371 INTEGER :: i, j, k, omp_get_thread_num, pr, tn 372 CHARACTER (LEN=*) :: loc 400 CHARACTER (LEN=*) :: loc !: 401 402 INTEGER(iwp) :: i !: 403 INTEGER(iwp) :: j !: 404 INTEGER(iwp) :: k !: 405 INTEGER(iwp) :: pr !: 406 INTEGER(iwp) :: omp_get_thread_num !: 407 INTEGER(iwp) :: tn !: 408 373 409 #if defined( __nopointer ) 374 REAL , DIMENSION(:,:,:) :: var410 REAL(wp), DIMENSION(:,:,:) :: var !: 375 411 #else 376 REAL , DIMENSION(:,:,:), POINTER :: var412 REAL(wp), DIMENSION(:,:,:), POINTER :: var 377 413 #endif 378 414 … … 383 419 !-- spare communication time and to produce identical model results with jobs 384 420 !-- which are calling flow_statistics at different time intervals. 385 IF ( .NOT. flow_statistics_called .AND. &421 IF ( .NOT. flow_statistics_called .AND. & 386 422 intermediate_timestep_count == 1 ) THEN 387 423 … … 409 445 410 446 IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr ) 411 CALL MPI_ALLREDUCE( sums_l(nzb,pr,0), sums(nzb,pr), nzt+2-nzb, &447 CALL MPI_ALLREDUCE( sums_l(nzb,pr,0), sums(nzb,pr), nzt+2-nzb, & 412 448 MPI_REAL, MPI_SUM, comm2d, ierr ) 413 449
Note: See TracChangeset
for help on using the changeset viewer.
