Changeset 667 for palm/trunk/SOURCE/data_output_2d.f90
- Timestamp:
- Dec 23, 2010 12:06:00 PM (14 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE
-
Property
svn:mergeinfo
set to
(toggle deleted branches)
/palm/branches/suehring 423-666 /palm/branches/letzel/masked_output/SOURCE 296-409
-
Property
svn:mergeinfo
set to
(toggle deleted branches)
-
palm/trunk/SOURCE/data_output_2d.f90
r623 r667 4 4 ! Current revisions: 5 5 ! ----------------- 6 ! 6 ! nxl-1, nxr+1, nys-1, nyn+1 replaced by nxlg, nxrg, nysg, nyng in loops and 7 ! allocation of arrays local_2d and total_2d. 8 ! Calls of exchange_horiz are modiefied. 7 9 ! 8 10 ! Former revisions: … … 112 114 113 115 CASE ( 'xy' ) 114 115 116 s = 1 116 ALLOCATE( level_z( 0:nzt+1), local_2d(nxl-1:nxr+1,nys-1:nyn+1) )117 ALLOCATE( level_z(nzb:nzt+1), local_2d(nxlg:nxrg,nysg:nyng) ) 117 118 118 119 ! … … 130 131 IF ( iso2d_output ) CALL check_open( 21 ) 131 132 #if defined( __parallel ) 132 ALLOCATE( total_2d(- 1:nx+1,-1:ny+1) )133 ALLOCATE( total_2d(-nbgp:nx+nbgp,-nbgp:ny+nbgp) ) 133 134 #endif 134 135 ENDIF … … 136 137 137 138 CASE ( 'xz' ) 138 139 139 s = 2 140 ALLOCATE( local_2d(nxl -1:nxr+1,nzb:nzt+1) )140 ALLOCATE( local_2d(nxlg:nxrg,nzb:nzt+1) ) 141 141 142 142 ! … … 154 154 IF ( iso2d_output ) CALL check_open( 22 ) 155 155 #if defined( __parallel ) 156 ALLOCATE( total_2d(- 1:nx+1,nzb:nzt+1) )156 ALLOCATE( total_2d(-nbgp:nx+nbgp,nzb:nzt+1) ) 157 157 #endif 158 158 ENDIF … … 162 162 163 163 s = 3 164 ALLOCATE( local_2d(nys -1:nyn+1,nzb:nzt+1) )164 ALLOCATE( local_2d(nysg:nyng,nzb:nzt+1) ) 165 165 166 166 ! … … 178 178 IF ( iso2d_output ) CALL check_open( 23 ) 179 179 #if defined( __parallel ) 180 ALLOCATE( total_2d(- 1:ny+1,nzb:nzt+1) )180 ALLOCATE( total_2d(-nbgp:ny+nbgp,nzb:nzt+1) ) 181 181 #endif 182 182 ENDIF … … 192 192 ! 193 193 !-- Allocate a temporary array for resorting (kji -> ijk). 194 ALLOCATE( local_pf(nxl -1:nxr+1,nys-1:nyn+1,nzb:nzt+1) )194 ALLOCATE( local_pf(nxlg:nxrg,nysg:nyng,nzb:nzt+1) ) 195 195 196 196 ! … … 219 219 CASE ( 'lwp*_xy' ) ! 2d-array 220 220 IF ( av == 0 ) THEN 221 DO i = nxl -1, nxr+1222 DO j = nys -1, nyn+1221 DO i = nxlg, nxrg 222 DO j = nysg, nyng 223 223 local_pf(i,j,nzb+1) = SUM( ql(nzb:nzt,j,i) * & 224 224 dzw(1:nzt+1) ) … … 226 226 ENDDO 227 227 ELSE 228 DO i = nxl -1, nxr+1229 DO j = nys -1, nyn+1228 DO i = nxlg, nxrg 229 DO j = nysg, nyng 230 230 local_pf(i,j,nzb+1) = lwp_av(j,i) 231 231 ENDDO … … 248 248 IF ( simulated_time >= particle_advection_start ) THEN 249 249 tend = prt_count 250 CALL exchange_horiz( tend )250 CALL exchange_horiz( tend, nbgp ) 251 251 ELSE 252 252 tend = 0.0 253 253 ENDIF 254 DO i = nxl -1, nxr+1255 DO j = nys -1, nyn+1254 DO i = nxlg, nxrg 255 DO j = nysg, nyng 256 256 DO k = nzb, nzt+1 257 257 local_pf(i,j,k) = tend(k,j,i) … … 261 261 resorted = .TRUE. 262 262 ELSE 263 CALL exchange_horiz( pc_av )263 CALL exchange_horiz( pc_av, nbgp ) 264 264 to_be_resorted => pc_av 265 265 ENDIF … … 287 287 ENDDO 288 288 ENDDO 289 CALL exchange_horiz( tend )289 CALL exchange_horiz( tend, nbgp ) 290 290 ELSE 291 291 tend = 0.0 292 END IF293 DO i = nxl -1, nxr+1294 DO j = nys -1, nyn+1292 END IF 293 DO i = nxlg, nxrg 294 DO j = nysg, nyng 295 295 DO k = nzb, nzt+1 296 296 local_pf(i,j,k) = tend(k,j,i) … … 300 300 resorted = .TRUE. 301 301 ELSE 302 CALL exchange_horiz( pr_av )302 CALL exchange_horiz( pr_av, nbgp ) 303 303 to_be_resorted => pr_av 304 304 ENDIF … … 306 306 CASE ( 'pra*_xy' ) ! 2d-array / integral quantity => no av 307 307 CALL exchange_horiz_2d( precipitation_amount ) 308 DO i = nxl-1, nxr+1309 DO j = nys-1, nyn+1308 DO i = nxlg, nxrg 309 DO j = nysg, nyng 310 310 local_pf(i,j,nzb+1) = precipitation_amount(j,i) 311 311 ENDDO … … 319 319 IF ( av == 0 ) THEN 320 320 CALL exchange_horiz_2d( precipitation_rate ) 321 DO i = nxl -1, nxr+1322 DO j = nys -1, nyn+1321 DO i = nxlg, nxrg 322 DO j = nysg, nyng 323 323 local_pf(i,j,nzb+1) = precipitation_rate(j,i) 324 324 ENDDO … … 326 326 ELSE 327 327 CALL exchange_horiz_2d( precipitation_rate_av ) 328 DO i = nxl -1, nxr+1329 DO j = nys -1, nyn+1328 DO i = nxlg, nxrg 329 DO j = nysg, nyng 330 330 local_pf(i,j,nzb+1) = precipitation_rate_av(j,i) 331 331 ENDDO … … 341 341 to_be_resorted => pt 342 342 ELSE 343 DO i = nxl-1, nxr+1344 DO j = nys-1, nyn+1343 DO i = nxlg, nxrg 344 DO j = nysg, nyng 345 345 DO k = nzb, nzt+1 346 346 local_pf(i,j,k) = pt(k,j,i) + l_d_cp * & … … 399 399 CASE ( 'qsws*_xy' ) ! 2d-array 400 400 IF ( av == 0 ) THEN 401 DO i = nxl -1, nxr+1402 DO j = nys -1, nyn+1401 DO i = nxlg, nxrg 402 DO j = nysg, nyng 403 403 local_pf(i,j,nzb+1) = qsws(j,i) 404 404 ENDDO 405 405 ENDDO 406 406 ELSE 407 DO i = nxl -1, nxr+1408 DO j = nys -1, nyn+1407 DO i = nxlg, nxrg 408 DO j = nysg, nyng 409 409 local_pf(i,j,nzb+1) = qsws_av(j,i) 410 410 ENDDO … … 417 417 CASE ( 'qv_xy', 'qv_xz', 'qv_yz' ) 418 418 IF ( av == 0 ) THEN 419 DO i = nxl -1, nxr+1420 DO j = nys -1, nyn+1419 DO i = nxlg, nxrg 420 DO j = nysg, nyng 421 421 DO k = nzb, nzt+1 422 422 local_pf(i,j,k) = q(k,j,i) - ql(k,j,i) … … 453 453 CASE ( 'shf*_xy' ) ! 2d-array 454 454 IF ( av == 0 ) THEN 455 DO i = nxl -1, nxr+1456 DO j = nys -1, nyn+1455 DO i = nxlg, nxrg 456 DO j = nysg, nyng 457 457 local_pf(i,j,nzb+1) = shf(j,i) 458 458 ENDDO 459 459 ENDDO 460 460 ELSE 461 DO i = nxl -1, nxr+1462 DO j = nys -1, nyn+1461 DO i = nxlg, nxrg 462 DO j = nysg, nyng 463 463 local_pf(i,j,nzb+1) = shf_av(j,i) 464 464 ENDDO … … 471 471 CASE ( 't*_xy' ) ! 2d-array 472 472 IF ( av == 0 ) THEN 473 DO i = nxl -1, nxr+1474 DO j = nys -1, nyn+1473 DO i = nxlg, nxrg 474 DO j = nysg, nyng 475 475 local_pf(i,j,nzb+1) = ts(j,i) 476 476 ENDDO 477 477 ENDDO 478 478 ELSE 479 DO i = nxl -1, nxr+1480 DO j = nys -1, nyn+1479 DO i = nxlg, nxrg 480 DO j = nysg, nyng 481 481 local_pf(i,j,nzb+1) = ts_av(j,i) 482 482 ENDDO … … 503 503 CASE ( 'u*_xy' ) ! 2d-array 504 504 IF ( av == 0 ) THEN 505 DO i = nxl -1, nxr+1506 DO j = nys -1, nyn+1505 DO i = nxlg, nxrg 506 DO j = nysg, nyng 507 507 local_pf(i,j,nzb+1) = us(j,i) 508 508 ENDDO 509 509 ENDDO 510 510 ELSE 511 DO i = nxl -1, nxr+1512 DO j = nys -1, nyn+1511 DO i = nxlg, nxrg 512 DO j = nysg, nyng 513 513 local_pf(i,j,nzb+1) = us_av(j,i) 514 514 ENDDO … … 551 551 CASE ( 'z0*_xy' ) ! 2d-array 552 552 IF ( av == 0 ) THEN 553 DO i = nxl -1, nxr+1554 DO j = nys -1, nyn+1553 DO i = nxlg, nxrg 554 DO j = nysg, nyng 555 555 local_pf(i,j,nzb+1) = z0(j,i) 556 556 ENDDO 557 557 ENDDO 558 558 ELSE 559 DO i = nxl -1, nxr+1560 DO j = nys -1, nyn+1559 DO i = nxlg, nxrg 560 DO j = nysg, nyng 561 561 local_pf(i,j,nzb+1) = z0_av(j,i) 562 562 ENDDO … … 593 593 !-- Resort the array to be output, if not done above 594 594 IF ( .NOT. resorted ) THEN 595 DO i = nxl -1, nxr+1596 DO j = nys -1, nyn+1595 DO i = nxlg, nxrg 596 DO j = nysg, nyng 597 597 DO k = nzb, nzt+1 598 598 local_pf(i,j,k) = to_be_resorted(k,j,i) … … 647 647 !-- Carry out the averaging (all data are on the PE) 648 648 DO k = nzb, nzt+1 649 DO j = nys -1, nyn+1650 DO i = nxl -1, nxr+1649 DO j = nysg, nyng 650 DO i = nxlg, nxrg 651 651 local_2d(i,j) = local_2d(i,j) + local_pf(i,j,k) 652 652 ENDDO … … 654 654 ENDDO 655 655 656 local_2d = local_2d / ( nzt -nzb + 2.0 656 local_2d = local_2d / ( nzt -nzb + 2.0) 657 657 658 658 ELSE … … 723 723 ENDIF 724 724 #endif 725 WRITE ( 21 ) nxl -1, nxr+1, nys-1, nyn+1725 WRITE ( 21 ) nxlg, nxrg, nysg, nyng 726 726 WRITE ( 21 ) local_2d 727 727 … … 734 734 CALL MPI_BARRIER( comm2d, ierr ) 735 735 736 ngp = ( nxr -nxl+3 ) * ( nyn-nys+3)736 ngp = ( nxrg-nxlg+1 ) * ( nyng-nysg+1 ) 737 737 IF ( myid == 0 ) THEN 738 738 ! 739 739 !-- Local array can be relocated directly. 740 total_2d(nxl -1:nxr+1,nys-1:nyn+1) = local_2d740 total_2d(nxlg:nxrg,nysg:nyng) = local_2d 741 741 ! 742 742 !-- Receive data from all other PEs. … … 760 760 !-- Output of the total cross-section. 761 761 IF ( iso2d_output ) THEN 762 WRITE (21) total_2d( 0:nx+1,0:ny+1)762 WRITE (21) total_2d(-nbgp:nx+nbgp,-nbgp:ny+nbgp) 763 763 ENDIF 764 764 ! 765 765 !-- Relocate the local array for the next loop increment 766 766 DEALLOCATE( local_2d ) 767 ALLOCATE( local_2d(nxl -1:nxr+1,nys-1:nyn+1) )767 ALLOCATE( local_2d(nxlg:nxrg,nysg:nyng) ) 768 768 769 769 #if defined( __netcdf ) … … 789 789 ! 790 790 !-- First send the local index limits to PE0 791 ind(1) = nxl -1; ind(2) = nxr+1792 ind(3) = nys -1; ind(4) = nyn+1791 ind(1) = nxlg; ind(2) = nxrg 792 ind(3) = nysg; ind(4) = nyng 793 793 CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, & 794 794 comm2d, ierr ) 795 795 ! 796 796 !-- Send data to PE0 797 CALL MPI_SEND( local_2d(nxl -1,nys-1), ngp, &797 CALL MPI_SEND( local_2d(nxlg,nysg), ngp, & 798 798 MPI_REAL, 0, 1, comm2d, ierr ) 799 799 ENDIF … … 882 882 883 883 ENDIF 884 884 885 ! 885 886 !-- If required, carry out averaging along y 886 887 IF ( section(is,s) == -1 ) THEN 887 888 888 ALLOCATE( local_2d_l(nxl -1:nxr+1,nzb:nzt+1) )889 ALLOCATE( local_2d_l(nxlg:nxrg,nzb:nzt+1) ) 889 890 local_2d_l = 0.0 890 ngp = ( nxr -nxl+3) * ( nzt-nzb+2 )891 ngp = ( nxrg-nxlg+1 ) * ( nzt-nzb+2 ) 891 892 ! 892 893 !-- First local averaging on the PE 893 894 DO k = nzb, nzt+1 894 895 DO j = nys, nyn 895 DO i = nxl -1, nxr+1896 DO i = nxlg, nxrg 896 897 local_2d_l(i,k) = local_2d_l(i,k) + & 897 898 local_pf(i,j,k) … … 903 904 !-- Now do the averaging over all PEs along y 904 905 IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr ) 905 CALL MPI_ALLREDUCE( local_2d_l(nxl -1,nzb), &906 local_2d(nxl -1,nzb), ngp, MPI_REAL, &906 CALL MPI_ALLREDUCE( local_2d_l(nxlg,nzb), & 907 local_2d(nxlg,nzb), ngp, MPI_REAL, & 907 908 MPI_SUM, comm1dy, ierr ) 908 909 #else … … 936 937 !-- BEGIN WORKAROUND--------------------------------------- 937 938 IF ( npey /= 1 .AND. section(is,s) /= -1) THEN 938 ALLOCATE( local_2d_l(nxl -1:nxr+1,nzb:nzt+1) )939 ALLOCATE( local_2d_l(nxlg:nxrg,nzb:nzt+1) ) 939 940 local_2d_l = 0.0 940 941 IF ( section(is,s) >= nys .AND. section(is,s) <= nyn )& … … 945 946 ! 946 947 !-- Distribute data over all PEs along y 947 ngp = ( nxr -nxl+3) * ( nzt-nzb+2 )948 ngp = ( nxrg-nxlg+1 ) * ( nzt-nzb+2 ) 948 949 IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr ) 949 CALL MPI_ALLREDUCE( local_2d_l(nxl -1,nzb), &950 local_2d(nxl -1,nzb), ngp, &950 CALL MPI_ALLREDUCE( local_2d_l(nxlg,nzb), & 951 local_2d(nxlg,nzb), ngp, & 951 952 MPI_REAL, MPI_SUM, comm1dy, ierr ) 952 953 #else … … 1022 1023 ( section(is,s) == -1 .AND. nys-1 == -1 ) ) & 1023 1024 THEN 1024 WRITE (22) nxl -1, nxr+1, nzb, nzt+11025 WRITE (22) nxlg, nxrg, nzb, nzt+1 1025 1026 WRITE (22) local_2d 1026 1027 ELSE … … 1036 1037 CALL MPI_BARRIER( comm2d, ierr ) 1037 1038 1038 ngp = ( nxr -nxl+3) * ( nzt-nzb+2 )1039 ngp = ( nxrg-nxlg+1 ) * ( nzt-nzb+2 ) 1039 1040 IF ( myid == 0 ) THEN 1040 1041 ! … … 1044 1045 ( section(is,s) == -1 .AND. nys-1 == -1 ) ) & 1045 1046 THEN 1046 total_2d(nxl -1:nxr+1,nzb:nzt+1) = local_2d1047 total_2d(nxlg:nxrg,nzb:nzt+1) = local_2d 1047 1048 ENDIF 1048 1049 ! … … 1073 1074 !-- Output of the total cross-section. 1074 1075 IF ( iso2d_output ) THEN 1075 WRITE (22) total_2d( 0:nx+1,nzb:nzt+1)1076 WRITE (22) total_2d(-nbgp:nx+nbgp,nzb:nzt+1) 1076 1077 ENDIF 1077 1078 ! 1078 1079 !-- Relocate the local array for the next loop increment 1079 1080 DEALLOCATE( local_2d ) 1080 ALLOCATE( local_2d(nxl -1:nxr+1,nzb:nzt+1) )1081 ALLOCATE( local_2d(nxlg:nxrg,nzb:nzt+1) ) 1081 1082 1082 1083 #if defined( __netcdf ) … … 1099 1100 ( section(is,s) == -1 .AND. nys-1 == -1 ) ) & 1100 1101 THEN 1101 ind(1) = nxl -1; ind(2) = nxr+11102 ind(1) = nxlg; ind(2) = nxrg 1102 1103 ind(3) = nzb; ind(4) = nzt+1 1103 1104 ELSE … … 1110 1111 !-- If applicable, send data to PE0. 1111 1112 IF ( ind(1) /= -9999 ) THEN 1112 CALL MPI_SEND( local_2d(nxl -1,nzb), ngp, &1113 CALL MPI_SEND( local_2d(nxlg,nzb), ngp, & 1113 1114 MPI_REAL, 0, 1, comm2d, ierr ) 1114 1115 ENDIF … … 1187 1188 IF ( section(is,s) == -1 ) THEN 1188 1189 1189 ALLOCATE( local_2d_l(nys -1:nyn+1,nzb:nzt+1) )1190 ALLOCATE( local_2d_l(nysg:nyng,nzb:nzt+1) ) 1190 1191 local_2d_l = 0.0 1191 ngp = ( nyn -nys+3) * ( nzt-nzb+2 )1192 ngp = ( nyng-nysg+1 ) * ( nzt-nzb+2 ) 1192 1193 ! 1193 1194 !-- First local averaging on the PE 1194 1195 DO k = nzb, nzt+1 1195 DO j = nys -1, nyn+11196 DO j = nysg, nyng 1196 1197 DO i = nxl, nxr 1197 1198 local_2d_l(j,k) = local_2d_l(j,k) + & … … 1204 1205 !-- Now do the averaging over all PEs along x 1205 1206 IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr ) 1206 CALL MPI_ALLREDUCE( local_2d_l(nys -1,nzb), &1207 local_2d(nys -1,nzb), ngp, MPI_REAL, &1207 CALL MPI_ALLREDUCE( local_2d_l(nysg,nzb), & 1208 local_2d(nysg,nzb), ngp, MPI_REAL, & 1208 1209 MPI_SUM, comm1dx, ierr ) 1209 1210 #else … … 1237 1238 !-- BEGIN WORKAROUND--------------------------------------- 1238 1239 IF ( npex /= 1 .AND. section(is,s) /= -1) THEN 1239 ALLOCATE( local_2d_l(nys -1:nyn+1,nzb:nzt+1) )1240 ALLOCATE( local_2d_l(nysg:nyng,nzb:nzt+1) ) 1240 1241 local_2d_l = 0.0 1241 1242 IF ( section(is,s) >= nxl .AND. section(is,s) <= nxr )& … … 1246 1247 ! 1247 1248 !-- Distribute data over all PEs along x 1248 ngp = ( nyn -nys+3 ) * ( nzt-nzb+2 )1249 ngp = ( nyng-nysg+1 ) * ( nzt-nzb + 2 ) 1249 1250 IF ( collective_wait ) CALL MPI_BARRIER( comm2d, ierr ) 1250 CALL MPI_ALLREDUCE( local_2d_l(nys -1,nzb), &1251 local_2d(nys -1,nzb), ngp, &1251 CALL MPI_ALLREDUCE( local_2d_l(nysg,nzb), & 1252 local_2d(nysg,nzb), ngp, & 1252 1253 MPI_REAL, MPI_SUM, comm1dx, ierr ) 1253 1254 #else … … 1323 1324 ( section(is,s) == -1 .AND. nxl-1 == -1 ) ) & 1324 1325 THEN 1325 WRITE (23) nys -1, nyn+1, nzb, nzt+11326 WRITE (23) nysg, nyng, nzb, nzt+1 1326 1327 WRITE (23) local_2d 1327 1328 ELSE … … 1337 1338 CALL MPI_BARRIER( comm2d, ierr ) 1338 1339 1339 ngp = ( nyn -nys+3) * ( nzt-nzb+2 )1340 ngp = ( nyng-nysg+1 ) * ( nzt-nzb+2 ) 1340 1341 IF ( myid == 0 ) THEN 1341 1342 ! … … 1345 1346 ( section(is,s) == -1 .AND. nxl-1 == -1 ) ) & 1346 1347 THEN 1347 total_2d(nys -1:nyn+1,nzb:nzt+1) = local_2d1348 total_2d(nysg:nyng,nzb:nzt+1) = local_2d 1348 1349 ENDIF 1349 1350 ! … … 1379 1380 !-- Relocate the local array for the next loop increment 1380 1381 DEALLOCATE( local_2d ) 1381 ALLOCATE( local_2d(nys -1:nyn+1,nzb:nzt+1) )1382 ALLOCATE( local_2d(nysg:nyng,nzb:nzt+1) ) 1382 1383 1383 1384 #if defined( __netcdf ) … … 1400 1401 ( section(is,s) == -1 .AND. nxl-1 == -1 ) ) & 1401 1402 THEN 1402 ind(1) = nys -1; ind(2) = nyn+11403 ind(1) = nysg; ind(2) = nyng 1403 1404 ind(3) = nzb; ind(4) = nzt+1 1404 1405 ELSE … … 1411 1412 !-- If applicable, send data to PE0. 1412 1413 IF ( ind(1) /= -9999 ) THEN 1413 CALL MPI_SEND( local_2d(nys -1,nzb), ngp, &1414 CALL MPI_SEND( local_2d(nysg,nzb), ngp, & 1414 1415 MPI_REAL, 0, 1, comm2d, ierr ) 1415 1416 ENDIF
Note: See TracChangeset
for help on using the changeset viewer.