Changeset 493 for palm/trunk/SOURCE/data_output_2d.f90
- Timestamp:
- Mar 1, 2010 8:30:24 AM (14 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/data_output_2d.f90 (modified) (16 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/data_output_2d.f90
r392 r493 73 73 CHARACTER (LEN=25) :: section_chr 74 74 CHARACTER (LEN=50) :: rtext 75 INTEGER :: av, ngp, file_id, i, if, is, j, k, l, layer_xy, n, psi, s, &76 s ender, &75 INTEGER :: av, ngp, file_id, i, if, is, iis, j, k, l, layer_xy, n, psi, & 76 s, sender, & 77 77 ind(4) 78 78 LOGICAL :: found, resorted, two_d … … 110 110 ALLOCATE( level_z(0:nzt+1), local_2d(nxl-1:nxr+1,nys-1:nyn+1) ) 111 111 112 #if defined( __netcdf ) 113 IF ( myid == 0 .AND. netcdf_output ) CALL check_open( 101+av*10 ) 114 #endif 112 ! 113 !-- Classic and 64bit offset NetCDF output is done only on PE0. 114 !-- netCDF4/HDF5 output is done in parallel on all PEs. 115 IF ( netcdf_output .AND. ( myid == 0 .OR. netcdf_data_format > 2 ) ) & 116 THEN 117 CALL check_open( 101+av*10 ) 118 ENDIF 115 119 116 120 IF ( data_output_2d_on_each_pe ) THEN … … 130 134 ALLOCATE( local_2d(nxl-1:nxr+1,nzb:nzt+1) ) 131 135 132 #if defined( __netcdf ) 133 IF ( myid == 0 .AND. netcdf_output ) CALL check_open( 102+av*10 ) 134 #endif 136 ! 137 !-- Classic and 64bit offset NetCDF output is done only on PE0. 138 !-- netCDF4/HDF5 output may be done in parallel on all PEs. 139 IF ( netcdf_output .AND. ( myid == 0 .OR. netcdf_data_format > 2 ) ) & 140 THEN 141 CALL check_open( 102+av*10 ) 142 ENDIF 135 143 136 144 IF ( data_output_2d_on_each_pe ) THEN … … 150 158 ALLOCATE( local_2d(nys-1:nyn+1,nzb:nzt+1) ) 151 159 152 #if defined( __netcdf ) 153 IF ( myid == 0 .AND. netcdf_output ) CALL check_open( 103+av*10 ) 154 #endif 160 ! 161 !-- Classic and 64bit offset NetCDF output is done only on PE0. 162 !-- netCDF4/HDF5 output may be done in parallel on all PEs. 163 IF ( netcdf_output .AND. ( myid == 0 .OR. netcdf_data_format > 2 ) ) & 164 THEN 165 CALL check_open( 103+av*10 ) 166 ENDIF 155 167 156 168 IF ( data_output_2d_on_each_pe ) THEN … … 603 615 ! 604 616 !-- Update the NetCDF xy cross section time axis 605 IF ( myid == 0 ) THEN617 IF ( myid == 0 .OR. netcdf_data_format > 2 ) THEN 606 618 IF ( simulated_time /= do2d_xy_last_time(av) ) THEN 607 619 do2d_xy_time_count(av) = do2d_xy_time_count(av) + 1 608 620 do2d_xy_last_time(av) = simulated_time 609 IF ( .NOT. data_output_2d_on_each_pe .AND. & 610 netcdf_output ) THEN 621 IF ( ( .NOT. data_output_2d_on_each_pe .AND. & 622 netcdf_output ) .OR. netcdf_data_format > 2 ) & 623 THEN 611 624 #if defined( __netcdf ) 612 625 nc_stat = NF90_PUT_VAR( id_set_xy(av), & … … 615 628 start = (/ do2d_xy_time_count(av) /), & 616 629 count = (/ 1 /) ) 617 CALL handle_netcdf_error( 'data_output_2d', 53 )630 CALL handle_netcdf_error( 'data_output_2d', 53 ) 618 631 #endif 619 632 ENDIF … … 645 658 646 659 #if defined( __parallel ) 647 IF ( data_output_2d_on_each_pe ) THEN 648 ! 649 !-- Output of partial arrays on each PE 660 IF ( netcdf_output .AND. netcdf_data_format > 2 ) THEN 661 ! 662 !-- Output in NetCDF4/HDF5 format. 663 !-- Do not output redundant ghost point data except for the 664 !-- boundaries of the total domain. 665 IF ( two_d ) THEN 666 iis = 1 667 ELSE 668 iis = is 669 ENDIF 670 650 671 #if defined( __netcdf ) 651 IF ( netcdf_output .AND. myid == 0 ) THEN 652 WRITE ( 21 ) simulated_time, do2d_xy_time_count(av), & 653 av 654 ENDIF 655 #endif 656 WRITE ( 21 ) nxl-1, nxr+1, nys-1, nyn+1 657 WRITE ( 21 ) local_2d 658 672 IF ( nxr == nx .AND. nyn /= ny ) THEN 673 nc_stat = NF90_PUT_VAR( id_set_xy(av), & 674 id_var_do2d(av,if), & 675 local_2d(nxl:nxr+1,nys:nyn), & 676 start = (/ nxl+1, nys+1, iis, & 677 do2d_xy_time_count(av) /), & 678 count = (/ nxr-nxl+2, & 679 nyn-nys+1, 1, 1 /) ) 680 ELSEIF ( nxr /= nx .AND. nyn == ny ) THEN 681 nc_stat = NF90_PUT_VAR( id_set_xy(av), & 682 id_var_do2d(av,if), & 683 local_2d(nxl:nxr,nys:nyn+1), & 684 start = (/ nxl+1, nys+1, iis, & 685 do2d_xy_time_count(av) /), & 686 count = (/ nxr-nxl+1, & 687 nyn-nys+2, 1, 1 /) ) 688 ELSEIF ( nxr == nx .AND. nyn == ny ) THEN 689 nc_stat = NF90_PUT_VAR( id_set_xy(av), & 690 id_var_do2d(av,if), & 691 local_2d(nxl:nxr+1,nys:nyn+1),& 692 start = (/ nxl+1, nys+1, iis, & 693 do2d_xy_time_count(av) /), & 694 count = (/ nxr-nxl+2, & 695 nyn-nys+2, 1, 1 /) ) 696 ELSE 697 nc_stat = NF90_PUT_VAR( id_set_xy(av), & 698 id_var_do2d(av,if), & 699 local_2d(nxl:nxr,nys:nyn), & 700 start = (/ nxl+1, nys+1, iis, & 701 do2d_xy_time_count(av) /), & 702 count = (/ nxr-nxl+1, & 703 nyn-nys+1, 1, 1 /) ) 704 ENDIF 705 706 CALL handle_netcdf_error( 'data_output_2d', 55 ) 707 #endif 659 708 ELSE 660 ! 661 !-- PE0 receives partial arrays from all processors and then 662 !-- outputs them. Here a barrier has to be set, because 663 !-- otherwise "-MPI- FATAL: Remote protocol queue full" may 664 !-- occur. 665 CALL MPI_BARRIER( comm2d, ierr ) 666 667 ngp = ( nxr-nxl+3 ) * ( nyn-nys+3 ) 668 IF ( myid == 0 ) THEN 669 ! 670 !-- Local array can be relocated directly. 671 total_2d(nxl-1:nxr+1,nys-1:nyn+1) = local_2d 672 ! 673 !-- Receive data from all other PEs. 674 DO n = 1, numprocs-1 675 ! 676 !-- Receive index limits first, then array. 677 !-- Index limits are received in arbitrary order from 678 !-- the PEs. 679 CALL MPI_RECV( ind(1), 4, MPI_INTEGER, & 680 MPI_ANY_SOURCE, 0, comm2d, status, & 681 ierr ) 682 sender = status(MPI_SOURCE) 709 710 IF ( data_output_2d_on_each_pe ) THEN 711 ! 712 !-- Output of partial arrays on each PE 713 #if defined( __netcdf ) 714 IF ( netcdf_output .AND. myid == 0 ) THEN 715 WRITE ( 21 ) simulated_time, & 716 do2d_xy_time_count(av), av 717 ENDIF 718 #endif 719 WRITE ( 21 ) nxl-1, nxr+1, nys-1, nyn+1 720 WRITE ( 21 ) local_2d 721 722 ELSE 723 ! 724 !-- PE0 receives partial arrays from all processors and 725 !-- then outputs them. Here a barrier has to be set, 726 !-- because otherwise "-MPI- FATAL: Remote protocol queue 727 !-- full" may occur. 728 CALL MPI_BARRIER( comm2d, ierr ) 729 730 ngp = ( nxr-nxl+3 ) * ( nyn-nys+3 ) 731 IF ( myid == 0 ) THEN 732 ! 733 !-- Local array can be relocated directly. 734 total_2d(nxl-1:nxr+1,nys-1:nyn+1) = local_2d 735 ! 736 !-- Receive data from all other PEs. 737 DO n = 1, numprocs-1 738 ! 739 !-- Receive index limits first, then array. 740 !-- Index limits are received in arbitrary order from 741 !-- the PEs. 742 CALL MPI_RECV( ind(1), 4, MPI_INTEGER, & 743 MPI_ANY_SOURCE, 0, comm2d, & 744 status, ierr ) 745 sender = status(MPI_SOURCE) 746 DEALLOCATE( local_2d ) 747 ALLOCATE( local_2d(ind(1):ind(2),ind(3):ind(4)) ) 748 CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp, & 749 MPI_REAL, sender, 1, comm2d, & 750 status, ierr ) 751 total_2d(ind(1):ind(2),ind(3):ind(4)) = local_2d 752 ENDDO 753 ! 754 !-- Output of the total cross-section. 755 IF ( iso2d_output ) THEN 756 WRITE (21) total_2d(0:nx+1,0:ny+1) 757 ENDIF 758 ! 759 !-- Relocate the local array for the next loop increment 683 760 DEALLOCATE( local_2d ) 684 ALLOCATE( local_2d(ind(1):ind(2),ind(3):ind(4)) ) 685 CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp, & 686 MPI_REAL, sender, 1, comm2d, & 687 status, ierr ) 688 total_2d(ind(1):ind(2),ind(3):ind(4)) = local_2d 689 ENDDO 690 ! 691 !-- Output of the total cross-section. 692 IF ( iso2d_output ) WRITE (21) total_2d(0:nx+1,0:ny+1) 693 ! 694 !-- Relocate the local array for the next loop increment 695 DEALLOCATE( local_2d ) 696 ALLOCATE( local_2d(nxl-1:nxr+1,nys-1:nyn+1) ) 761 ALLOCATE( local_2d(nxl-1:nxr+1,nys-1:nyn+1) ) 697 762 698 763 #if defined( __netcdf ) 699 IF ( netcdf_output ) THEN700 IF ( two_d ) THEN701 nc_stat = NF90_PUT_VAR( id_set_xy(av),&702 id_var_do2d(av,if),&764 IF ( netcdf_output ) THEN 765 IF ( two_d ) THEN 766 nc_stat = NF90_PUT_VAR( id_set_xy(av), & 767 id_var_do2d(av,if), & 703 768 total_2d(0:nx+1,0:ny+1), & 704 769 start = (/ 1, 1, 1, do2d_xy_time_count(av) /), & 705 770 count = (/ nx+2, ny+2, 1, 1 /) ) 706 ELSE707 nc_stat = NF90_PUT_VAR( id_set_xy(av),&708 id_var_do2d(av,if),&771 ELSE 772 nc_stat = NF90_PUT_VAR( id_set_xy(av), & 773 id_var_do2d(av,if), & 709 774 total_2d(0:nx+1,0:ny+1), & 710 775 start = (/ 1, 1, is, do2d_xy_time_count(av) /), & 711 776 count = (/ nx+2, ny+2, 1, 1 /) ) 777 ENDIF 778 CALL handle_netcdf_error( 'data_output_2d', 54 ) 712 779 ENDIF 713 CALL handle_netcdf_error( 'data_output_2d', 54 ) 714 ENDIF 715 #endif 716 717 ELSE 718 ! 719 !-- First send the local index limits to PE0 720 ind(1) = nxl-1; ind(2) = nxr+1721 ind(3) = nys-1; ind(4) = nyn+1722 CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, comm2d, & 723 ierr ) 724 ! 725 !-- Send data to PE0 726 CALL MPI_SEND( local_2d(nxl-1,nys-1), ngp, MPI_REAL, &727 0, 1, comm2d, ierr ) 728 ENDIF 729 ! 730 !-- A barrier has to be set, because otherwise some PEs may731 !-- proceed too fast so that PE0 may receive wrong data on 732 !-- tag 0 733 CALL MPI_BARRIER( comm2d, ierr ) 780 #endif 781 782 ELSE 783 ! 784 !-- First send the local index limits to PE0 785 ind(1) = nxl-1; ind(2) = nxr+1 786 ind(3) = nys-1; ind(4) = nyn+1 787 CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, & 788 comm2d, ierr ) 789 ! 790 !-- Send data to PE0 791 CALL MPI_SEND( local_2d(nxl-1,nys-1), ngp, & 792 MPI_REAL, 0, 1, comm2d, ierr ) 793 ENDIF 794 ! 795 !-- A barrier has to be set, because otherwise some PEs may 796 !-- proceed too fast so that PE0 may receive wrong data on 797 !-- tag 0 798 CALL MPI_BARRIER( comm2d, ierr ) 799 ENDIF 800 734 801 ENDIF 735 802 #else … … 752 819 count = (/ nx+2, ny+2, 1, 1 /) ) 753 820 ENDIF 754 CALL handle_netcdf_error( 'data_output_2d', 55)821 CALL handle_netcdf_error( 'data_output_2d', 447 ) 755 822 ENDIF 756 823 #endif … … 789 856 ! 790 857 !-- Update the NetCDF xz cross section time axis 791 IF ( myid == 0 ) THEN 858 IF ( myid == 0 .OR. netcdf_data_format > 2 ) THEN 859 792 860 IF ( simulated_time /= do2d_xz_last_time(av) ) THEN 793 861 do2d_xz_time_count(av) = do2d_xz_time_count(av) + 1 794 862 do2d_xz_last_time(av) = simulated_time 795 IF ( .NOT. data_output_2d_on_each_pe .AND. & 796 netcdf_output ) THEN 863 IF ( ( .NOT. data_output_2d_on_each_pe .AND. & 864 netcdf_output ) .OR. netcdf_data_format > 2 ) & 865 THEN 797 866 #if defined( __netcdf ) 798 867 nc_stat = NF90_PUT_VAR( id_set_xz(av), & … … 801 870 start = (/ do2d_xz_time_count(av) /), & 802 871 count = (/ 1 /) ) 803 CALL handle_netcdf_error( 'data_output_2d', 56 ) 804 #endif 805 ENDIF 806 ENDIF 872 CALL handle_netcdf_error( 'data_output_2d', 56 ) 873 #endif 874 ENDIF 875 ENDIF 876 807 877 ENDIF 808 878 ! … … 848 918 849 919 #if defined( __parallel ) 850 IF ( data_output_2d_on_each_pe ) THEN 851 ! 852 !-- Output of partial arrays on each PE. If the cross section 853 !-- does not reside on the PE, output special index values. 920 IF ( netcdf_output .AND. netcdf_data_format > 2 ) THEN 921 ! 922 !-- ATTENTION: The following lines are a workaround, because 923 !-- independet output does not work with the 924 !-- current NetCDF4 installation. Therefore, data 925 !-- are transferred from PEs having the cross 926 !-- sections to other PEs along y having no cross 927 !-- section data. Some of these data are the 928 !-- output. 929 !-- BEGIN WORKAROUND--------------------------------------- 930 IF ( npey /= 1 .AND. section(is,s) /= -1) THEN 931 ALLOCATE( local_2d_l(nxl-1:nxr+1,nzb:nzt+1) ) 932 local_2d_l = 0.0 933 IF ( section(is,s) >= nys .AND. section(is,s) <= nyn )& 934 THEN 935 local_2d_l = local_2d 936 ENDIF 937 #if defined( __parallel ) 938 ! 939 !-- Distribute data over all PEs along y 940 ngp = ( nxr-nxl+3 ) * ( nzt-nzb+2 ) 941 CALL MPI_ALLREDUCE( local_2d_l(nxl-1,nzb), & 942 local_2d(nxl-1,nzb), ngp, & 943 MPI_REAL, MPI_SUM, comm1dy, ierr ) 944 #else 945 local_2d = local_2d_l 946 #endif 947 DEALLOCATE( local_2d_l ) 948 ENDIF 949 !-- END WORKAROUND----------------------------------------- 950 951 ! 952 !-- Output in NetCDF4/HDF5 format. 953 !-- Output only on those PEs where the respective cross 954 !-- sections reside. Cross sections averaged along y are 955 !-- output on the respective first PE along y (myidy=0). 956 IF ( ( section(is,s) >= nys .AND. & 957 section(is,s) <= nyn ) .OR. & 958 ( section(is,s) == -1 .AND. myidy == 0 ) ) THEN 959 ! 960 !-- Do not output redundant ghost point data except for the 961 !-- boundaries of the total domain. 854 962 #if defined( __netcdf ) 855 IF ( netcdf_output .AND. myid == 0 ) THEN 856 WRITE ( 22 ) simulated_time, do2d_xz_time_count(av), & 857 av 858 ENDIF 859 #endif 860 IF ( ( section(is,s)>=nys .AND. section(is,s)<=nyn ) .OR.& 861 ( section(is,s) == -1 .AND. nys-1 == -1 ) ) & 862 THEN 863 WRITE (22) nxl-1, nxr+1, nzb, nzt+1 864 WRITE (22) local_2d 963 IF ( nxr == nx ) THEN 964 nc_stat = NF90_PUT_VAR( id_set_xz(av), & 965 id_var_do2d(av,if), & 966 local_2d(nxl:nxr+1,nzb:nzt+1), & 967 start = (/ nxl+1, is, 1, & 968 do2d_xz_time_count(av) /), & 969 count = (/ nxr-nxl+2, 1, & 970 nzt+2, 1 /) ) 971 ELSE 972 nc_stat = NF90_PUT_VAR( id_set_xz(av), & 973 id_var_do2d(av,if), & 974 local_2d(nxl:nxr,nzb:nzt+1), & 975 start = (/ nxl+1, is, 1, & 976 do2d_xz_time_count(av) /), & 977 count = (/ nxr-nxl+1, 1, & 978 nzt+2, 1 /) ) 979 ENDIF 980 981 CALL handle_netcdf_error( 'data_output_2d', 57 ) 982 865 983 ELSE 866 WRITE (22) -1, -1, -1, -1 984 ! 985 !-- Output on other PEs. Only one point is output!! 986 !-- ATTENTION: This is a workaround (see above)!! 987 IF ( npey /= 1 ) THEN 988 nc_stat = NF90_PUT_VAR( id_set_xz(av), & 989 id_var_do2d(av,if), & 990 local_2d(nxl:nxl,nzb:nzb), & 991 start = (/ nxl+1, is, 1, & 992 do2d_xz_time_count(av) /), & 993 count = (/ 1, 1, 1, 1 /) ) 994 CALL handle_netcdf_error( 'data_output_2d', 451 ) 995 ENDIF 996 #endif 867 997 ENDIF 868 998 869 999 ELSE 870 ! 871 !-- PE0 receives partial arrays from all processors of the 872 !-- respective cross section and outputs them. Here a 873 !-- barrier has to be set, because otherwise 874 !-- "-MPI- FATAL: Remote protocol queue full" may occur. 875 CALL MPI_BARRIER( comm2d, ierr ) 876 877 ngp = ( nxr-nxl+3 ) * ( nzt-nzb+2 ) 878 IF ( myid == 0 ) THEN 879 ! 880 !-- Local array can be relocated directly. 881 IF ( ( section(is,s)>=nys .AND. section(is,s)<=nyn ) & 882 .OR. ( section(is,s) == -1 .AND. nys-1 == -1 ) ) & 1000 1001 IF ( data_output_2d_on_each_pe ) THEN 1002 ! 1003 !-- Output of partial arrays on each PE. If the cross 1004 !-- section does not reside on the PE, output special 1005 !-- index values. 1006 #if defined( __netcdf ) 1007 IF ( netcdf_output .AND. myid == 0 ) THEN 1008 WRITE ( 22 ) simulated_time, & 1009 do2d_xz_time_count(av), av 1010 ENDIF 1011 #endif 1012 IF ( ( section(is,s) >= nys .AND. & 1013 section(is,s) <= nyn ) .OR. & 1014 ( section(is,s) == -1 .AND. nys-1 == -1 ) ) & 883 1015 THEN 884 total_2d(nxl-1:nxr+1,nzb:nzt+1) = local_2d 885 ENDIF 886 ! 887 !-- Receive data from all other PEs. 888 DO n = 1, numprocs-1 889 ! 890 !-- Receive index limits first, then array. 891 !-- Index limits are received in arbitrary order from 892 !-- the PEs. 893 CALL MPI_RECV( ind(1), 4, MPI_INTEGER, & 894 MPI_ANY_SOURCE, 0, comm2d, status, & 895 ierr ) 896 ! 897 !-- Not all PEs have data for XZ-cross-section. 898 IF ( ind(1) /= -9999 ) THEN 899 sender = status(MPI_SOURCE) 900 DEALLOCATE( local_2d ) 901 ALLOCATE( local_2d(ind(1):ind(2),ind(3):ind(4)) ) 902 CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp, & 903 MPI_REAL, sender, 1, comm2d, & 1016 WRITE (22) nxl-1, nxr+1, nzb, nzt+1 1017 WRITE (22) local_2d 1018 ELSE 1019 WRITE (22) -1, -1, -1, -1 1020 ENDIF 1021 1022 ELSE 1023 ! 1024 !-- PE0 receives partial arrays from all processors of the 1025 !-- respective cross section and outputs them. Here a 1026 !-- barrier has to be set, because otherwise 1027 !-- "-MPI- FATAL: Remote protocol queue full" may occur. 1028 CALL MPI_BARRIER( comm2d, ierr ) 1029 1030 ngp = ( nxr-nxl+3 ) * ( nzt-nzb+2 ) 1031 IF ( myid == 0 ) THEN 1032 ! 1033 !-- Local array can be relocated directly. 1034 IF ( ( section(is,s) >= nys .AND. & 1035 section(is,s) <= nyn ) .OR. & 1036 ( section(is,s) == -1 .AND. nys-1 == -1 ) ) & 1037 THEN 1038 total_2d(nxl-1:nxr+1,nzb:nzt+1) = local_2d 1039 ENDIF 1040 ! 1041 !-- Receive data from all other PEs. 1042 DO n = 1, numprocs-1 1043 ! 1044 !-- Receive index limits first, then array. 1045 !-- Index limits are received in arbitrary order from 1046 !-- the PEs. 1047 CALL MPI_RECV( ind(1), 4, MPI_INTEGER, & 1048 MPI_ANY_SOURCE, 0, comm2d, & 904 1049 status, ierr ) 905 total_2d(ind(1):ind(2),ind(3):ind(4)) = local_2d 1050 ! 1051 !-- Not all PEs have data for XZ-cross-section. 1052 IF ( ind(1) /= -9999 ) THEN 1053 sender = status(MPI_SOURCE) 1054 DEALLOCATE( local_2d ) 1055 ALLOCATE( local_2d(ind(1):ind(2), & 1056 ind(3):ind(4)) ) 1057 CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp, & 1058 MPI_REAL, sender, 1, comm2d, & 1059 status, ierr ) 1060 total_2d(ind(1):ind(2),ind(3):ind(4)) = & 1061 local_2d 1062 ENDIF 1063 ENDDO 1064 ! 1065 !-- Output of the total cross-section. 1066 IF ( iso2d_output ) THEN 1067 WRITE (22) total_2d(0:nx+1,nzb:nzt+1) 906 1068 ENDIF 907 ENDDO 908 ! 909 !-- Output of the total cross-section. 910 IF ( iso2d_output ) THEN 911 WRITE (22) total_2d(0:nx+1,nzb:nzt+1) 912 ENDIF 913 ! 914 !-- Relocate the local array for the next loop increment 915 DEALLOCATE( local_2d ) 916 ALLOCATE( local_2d(nxl-1:nxr+1,nzb:nzt+1) ) 1069 ! 1070 !-- Relocate the local array for the next loop increment 1071 DEALLOCATE( local_2d ) 1072 ALLOCATE( local_2d(nxl-1:nxr+1,nzb:nzt+1) ) 917 1073 918 1074 #if defined( __netcdf ) 919 IF ( netcdf_output ) THEN920 nc_stat = NF90_PUT_VAR( id_set_xz(av),&1075 IF ( netcdf_output ) THEN 1076 nc_stat = NF90_PUT_VAR( id_set_xz(av), & 921 1077 id_var_do2d(av,if), & 922 1078 total_2d(0:nx+1,nzb:nzt+1),& 923 1079 start = (/ 1, is, 1, do2d_xz_time_count(av) /), & 924 1080 count = (/ nx+2, 1, nz+2, 1 /) ) 925 CALL handle_netcdf_error( 'data_output_2d', 57 ) 926 ENDIF 927 #endif 928 929 ELSE 930 ! 931 !-- If the cross section resides on the PE, send the 932 !-- local index limits, otherwise send -9999 to PE0. 933 IF ( ( section(is,s)>=nys .AND. section(is,s)<=nyn ) & 934 .OR. ( section(is,s) == -1 .AND. nys-1 == -1 ) ) & 935 THEN 936 ind(1) = nxl-1; ind(2) = nxr+1 937 ind(3) = nzb; ind(4) = nzt+1 1081 CALL handle_netcdf_error( 'data_output_2d', 58 ) 1082 ENDIF 1083 #endif 1084 938 1085 ELSE 939 ind(1) = -9999; ind(2) = -9999 940 ind(3) = -9999; ind(4) = -9999 941 ENDIF 942 CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, comm2d, & 943 ierr ) 944 ! 945 !-- If applicable, send data to PE0. 946 IF ( ind(1) /= -9999 ) THEN 947 CALL MPI_SEND( local_2d(nxl-1,nzb), ngp, MPI_REAL, & 948 0, 1, comm2d, ierr ) 949 ENDIF 950 ENDIF 951 ! 952 !-- A barrier has to be set, because otherwise some PEs may 953 !-- proceed too fast so that PE0 may receive wrong data on 954 !-- tag 0 955 CALL MPI_BARRIER( comm2d, ierr ) 1086 ! 1087 !-- If the cross section resides on the PE, send the 1088 !-- local index limits, otherwise send -9999 to PE0. 1089 IF ( ( section(is,s) >= nys .AND. & 1090 section(is,s) <= nyn ) .OR. & 1091 ( section(is,s) == -1 .AND. nys-1 == -1 ) ) & 1092 THEN 1093 ind(1) = nxl-1; ind(2) = nxr+1 1094 ind(3) = nzb; ind(4) = nzt+1 1095 ELSE 1096 ind(1) = -9999; ind(2) = -9999 1097 ind(3) = -9999; ind(4) = -9999 1098 ENDIF 1099 CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, & 1100 comm2d, ierr ) 1101 ! 1102 !-- If applicable, send data to PE0. 1103 IF ( ind(1) /= -9999 ) THEN 1104 CALL MPI_SEND( local_2d(nxl-1,nzb), ngp, & 1105 MPI_REAL, 0, 1, comm2d, ierr ) 1106 ENDIF 1107 ENDIF 1108 ! 1109 !-- A barrier has to be set, because otherwise some PEs may 1110 !-- proceed too fast so that PE0 may receive wrong data on 1111 !-- tag 0 1112 CALL MPI_BARRIER( comm2d, ierr ) 1113 ENDIF 1114 956 1115 ENDIF 957 1116 #else … … 966 1125 start = (/ 1, is, 1, do2d_xz_time_count(av) /), & 967 1126 count = (/ nx+2, 1, nz+2, 1 /) ) 968 CALL handle_netcdf_error( 'data_output_2d', 58)1127 CALL handle_netcdf_error( 'data_output_2d', 451 ) 969 1128 ENDIF 970 1129 #endif … … 995 1154 CASE ( 'yz' ) 996 1155 ! 997 !-- Update the NetCDF xy cross section time axis 998 IF ( myid == 0 ) THEN 1156 !-- Update the NetCDF yz cross section time axis 1157 IF ( myid == 0 .OR. netcdf_data_format > 2 ) THEN 1158 999 1159 IF ( simulated_time /= do2d_yz_last_time(av) ) THEN 1000 1160 do2d_yz_time_count(av) = do2d_yz_time_count(av) + 1 1001 1161 do2d_yz_last_time(av) = simulated_time 1002 IF ( .NOT. data_output_2d_on_each_pe .AND. & 1003 netcdf_output ) THEN 1162 IF ( ( .NOT. data_output_2d_on_each_pe .AND. & 1163 netcdf_output ) .OR. netcdf_data_format > 2 ) & 1164 THEN 1004 1165 #if defined( __netcdf ) 1005 1166 nc_stat = NF90_PUT_VAR( id_set_yz(av), & … … 1012 1173 ENDIF 1013 1174 ENDIF 1175 1014 1176 ENDIF 1015 1177 ! … … 1055 1217 1056 1218 #if defined( __parallel ) 1057 IF ( data_output_2d_on_each_pe ) THEN 1058 ! 1059 !-- Output of partial arrays on each PE. If the cross section 1060 !-- does not reside on the PE, output special index values. 1219 IF ( netcdf_output .AND. netcdf_data_format > 2 ) THEN 1220 ! 1221 !-- ATTENTION: The following lines are a workaround, because 1222 !-- independet output does not work with the 1223 !-- current NetCDF4 installation. Therefore, data 1224 !-- are transferred from PEs having the cross 1225 !-- sections to other PEs along y having no cross 1226 !-- section data. Some of these data are the 1227 !-- output. 1228 !-- BEGIN WORKAROUND--------------------------------------- 1229 IF ( npex /= 1 .AND. section(is,s) /= -1) THEN 1230 ALLOCATE( local_2d_l(nys-1:nyn+1,nzb:nzt+1) ) 1231 local_2d_l = 0.0 1232 IF ( section(is,s) >= nxl .AND. section(is,s) <= nxr )& 1233 THEN 1234 local_2d_l = local_2d 1235 ENDIF 1236 #if defined( __parallel ) 1237 ! 1238 !-- Distribute data over all PEs along x 1239 ngp = ( nyn-nys+3 ) * ( nzt-nzb+2 ) 1240 CALL MPI_ALLREDUCE( local_2d_l(nys-1,nzb), & 1241 local_2d(nys-1,nzb), ngp, & 1242 MPI_REAL, MPI_SUM, comm1dx, ierr ) 1243 #else 1244 local_2d = local_2d_l 1245 #endif 1246 DEALLOCATE( local_2d_l ) 1247 ENDIF 1248 !-- END WORKAROUND----------------------------------------- 1249 1250 ! 1251 !-- Output in NetCDF4/HDF5 format. 1252 !-- Output only on those PEs where the respective cross 1253 !-- sections reside. Cross sections averaged along x are 1254 !-- output on the respective first PE along x (myidx=0). 1255 IF ( ( section(is,s) >= nxl .AND. & 1256 section(is,s) <= nxr ) .OR. & 1257 ( section(is,s) == -1 .AND. myidx == 0 ) ) THEN 1258 ! 1259 !-- Do not output redundant ghost point data except for the 1260 !-- boundaries of the total domain. 1061 1261 #if defined( __netcdf ) 1062 IF ( netcdf_output .AND. myid == 0 ) THEN 1063 WRITE ( 23 ) simulated_time, do2d_yz_time_count(av), & 1064 av 1065 ENDIF 1066 #endif 1067 IF ( ( section(is,s)>=nxl .AND. section(is,s)<=nxr ) .OR.& 1068 ( section(is,s) == -1 .AND. nxl-1 == -1 ) ) & 1069 THEN 1070 WRITE (23) nys-1, nyn+1, nzb, nzt+1 1071 WRITE (23) local_2d 1262 IF ( nyn == ny ) THEN 1263 nc_stat = NF90_PUT_VAR( id_set_yz(av), & 1264 id_var_do2d(av,if), & 1265 local_2d(nys:nyn+1,nzb:nzt+1), & 1266 start = (/ is, nys+1, 1, & 1267 do2d_yz_time_count(av) /), & 1268 count = (/ 1, nyn-nys+2, & 1269 nzt+2, 1 /) ) 1270 ELSE 1271 nc_stat = NF90_PUT_VAR( id_set_yz(av), & 1272 id_var_do2d(av,if), & 1273 local_2d(nys:nyn,nzb:nzt+1), & 1274 start = (/ is, nys+1, 1, & 1275 do2d_yz_time_count(av) /), & 1276 count = (/ 1, nyn-nys+1, & 1277 nzt+2, 1 /) ) 1278 ENDIF 1279 1280 CALL handle_netcdf_error( 'data_output_2d', 60 ) 1281 1072 1282 ELSE 1073 WRITE (23) -1, -1, -1, -1 1283 ! 1284 !-- Output on other PEs. Only one point is output!! 1285 !-- ATTENTION: This is a workaround (see above)!! 1286 IF ( npex /= 1 ) THEN 1287 nc_stat = NF90_PUT_VAR( id_set_yz(av), & 1288 id_var_do2d(av,if), & 1289 local_2d(nys:nys,nzb:nzb), & 1290 start = (/ is, nys+1, 1, & 1291 do2d_yz_time_count(av) /), & 1292 count = (/ 1, 1, 1, 1 /) ) 1293 CALL handle_netcdf_error( 'data_output_2d', 452 ) 1294 ENDIF 1295 #endif 1074 1296 ENDIF 1075 1297 1076 1298 ELSE 1077 ! 1078 !-- PE0 receives partial arrays from all processors of the 1079 !-- respective cross section and outputs them. Here a 1080 !-- barrier has to be set, because otherwise 1081 !-- "-MPI- FATAL: Remote protocol queue full" may occur. 1082 CALL MPI_BARRIER( comm2d, ierr ) 1083 1084 ngp = ( nyn-nys+3 ) * ( nzt-nzb+2 ) 1085 IF ( myid == 0 ) THEN 1086 ! 1087 !-- Local array can be relocated directly. 1088 IF ( ( section(is,s)>=nxl .AND. section(is,s)<=nxr ) & 1089 .OR. ( section(is,s) == -1 .AND. nxl-1 == -1 ) ) & 1299 1300 IF ( data_output_2d_on_each_pe ) THEN 1301 ! 1302 !-- Output of partial arrays on each PE. If the cross 1303 !-- section does not reside on the PE, output special 1304 !-- index values. 1305 #if defined( __netcdf ) 1306 IF ( netcdf_output .AND. myid == 0 ) THEN 1307 WRITE ( 23 ) simulated_time, & 1308 do2d_yz_time_count(av), av 1309 ENDIF 1310 #endif 1311 IF ( ( section(is,s) >= nxl .AND. & 1312 section(is,s) <= nxr ) .OR. & 1313 ( section(is,s) == -1 .AND. nxl-1 == -1 ) ) & 1090 1314 THEN 1091 total_2d(nys-1:nyn+1,nzb:nzt+1) = local_2d 1092 ENDIF 1093 ! 1094 !-- Receive data from all other PEs. 1095 DO n = 1, numprocs-1 1096 ! 1097 !-- Receive index limits first, then array. 1098 !-- Index limits are received in arbitrary order from 1099 !-- the PEs. 1100 CALL MPI_RECV( ind(1), 4, MPI_INTEGER, & 1101 MPI_ANY_SOURCE, 0, comm2d, status, & 1102 ierr ) 1103 ! 1104 !-- Not all PEs have data for YZ-cross-section. 1105 IF ( ind(1) /= -9999 ) THEN 1106 sender = status(MPI_SOURCE) 1107 DEALLOCATE( local_2d ) 1108 ALLOCATE( local_2d(ind(1):ind(2),ind(3):ind(4)) ) 1109 CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp, & 1110 MPI_REAL, sender, 1, comm2d, & 1315 WRITE (23) nys-1, nyn+1, nzb, nzt+1 1316 WRITE (23) local_2d 1317 ELSE 1318 WRITE (23) -1, -1, -1, -1 1319 ENDIF 1320 1321 ELSE 1322 ! 1323 !-- PE0 receives partial arrays from all processors of the 1324 !-- respective cross section and outputs them. Here a 1325 !-- barrier has to be set, because otherwise 1326 !-- "-MPI- FATAL: Remote protocol queue full" may occur. 1327 CALL MPI_BARRIER( comm2d, ierr ) 1328 1329 ngp = ( nyn-nys+3 ) * ( nzt-nzb+2 ) 1330 IF ( myid == 0 ) THEN 1331 ! 1332 !-- Local array can be relocated directly. 1333 IF ( ( section(is,s) >= nxl .AND. & 1334 section(is,s) <= nxr ) .OR. & 1335 ( section(is,s) == -1 .AND. nxl-1 == -1 ) ) & 1336 THEN 1337 total_2d(nys-1:nyn+1,nzb:nzt+1) = local_2d 1338 ENDIF 1339 ! 1340 !-- Receive data from all other PEs. 1341 DO n = 1, numprocs-1 1342 ! 1343 !-- Receive index limits first, then array. 1344 !-- Index limits are received in arbitrary order from 1345 !-- the PEs. 1346 CALL MPI_RECV( ind(1), 4, MPI_INTEGER, & 1347 MPI_ANY_SOURCE, 0, comm2d, & 1111 1348 status, ierr ) 1112 total_2d(ind(1):ind(2),ind(3):ind(4)) = local_2d 1349 ! 1350 !-- Not all PEs have data for YZ-cross-section. 1351 IF ( ind(1) /= -9999 ) THEN 1352 sender = status(MPI_SOURCE) 1353 DEALLOCATE( local_2d ) 1354 ALLOCATE( local_2d(ind(1):ind(2), & 1355 ind(3):ind(4)) ) 1356 CALL MPI_RECV( local_2d(ind(1),ind(3)), ngp, & 1357 MPI_REAL, sender, 1, comm2d, & 1358 status, ierr ) 1359 total_2d(ind(1):ind(2),ind(3):ind(4)) = & 1360 local_2d 1361 ENDIF 1362 ENDDO 1363 ! 1364 !-- Output of the total cross-section. 1365 IF ( iso2d_output ) THEN 1366 WRITE (23) total_2d(0:ny+1,nzb:nzt+1) 1113 1367 ENDIF 1114 ENDDO 1115 ! 1116 !-- Output of the total cross-section. 1117 IF ( iso2d_output ) THEN 1118 WRITE (23) total_2d(0:ny+1,nzb:nzt+1) 1119 ENDIF 1120 ! 1121 !-- Relocate the local array for the next loop increment 1122 DEALLOCATE( local_2d ) 1123 ALLOCATE( local_2d(nys-1:nyn+1,nzb:nzt+1) ) 1368 ! 1369 !-- Relocate the local array for the next loop increment 1370 DEALLOCATE( local_2d ) 1371 ALLOCATE( local_2d(nys-1:nyn+1,nzb:nzt+1) ) 1124 1372 1125 1373 #if defined( __netcdf ) 1126 IF ( netcdf_output ) THEN1127 nc_stat = NF90_PUT_VAR( id_set_yz(av),&1374 IF ( netcdf_output ) THEN 1375 nc_stat = NF90_PUT_VAR( id_set_yz(av), & 1128 1376 id_var_do2d(av,if), & 1129 1377 total_2d(0:ny+1,nzb:nzt+1),& 1130 1378 start = (/ is, 1, 1, do2d_yz_time_count(av) /), & 1131 1379 count = (/ 1, ny+2, nz+2, 1 /) ) 1132 CALL handle_netcdf_error( 'data_output_2d', 60 ) 1133 ENDIF 1134 #endif 1135 1136 ELSE 1137 ! 1138 !-- If the cross section resides on the PE, send the 1139 !-- local index limits, otherwise send -9999 to PE0. 1140 IF ( ( section(is,s)>=nxl .AND. section(is,s)<=nxr ) & 1141 .OR. ( section(is,s) == -1 .AND. nxl-1 == -1 ) ) & 1142 THEN 1143 ind(1) = nys-1; ind(2) = nyn+1 1144 ind(3) = nzb; ind(4) = nzt+1 1380 CALL handle_netcdf_error( 'data_output_2d', 61 ) 1381 ENDIF 1382 #endif 1383 1145 1384 ELSE 1146 ind(1) = -9999; ind(2) = -9999 1147 ind(3) = -9999; ind(4) = -9999 1148 ENDIF 1149 CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, comm2d, & 1150 ierr ) 1151 ! 1152 !-- If applicable, send data to PE0. 1153 IF ( ind(1) /= -9999 ) THEN 1154 CALL MPI_SEND( local_2d(nys-1,nzb), ngp, MPI_REAL, & 1155 0, 1, comm2d, ierr ) 1156 ENDIF 1157 ENDIF 1158 ! 1159 !-- A barrier has to be set, because otherwise some PEs may 1160 !-- proceed too fast so that PE0 may receive wrong data on 1161 !-- tag 0 1162 CALL MPI_BARRIER( comm2d, ierr ) 1385 ! 1386 !-- If the cross section resides on the PE, send the 1387 !-- local index limits, otherwise send -9999 to PE0. 1388 IF ( ( section(is,s) >= nxl .AND. & 1389 section(is,s) <= nxr ) .OR. & 1390 ( section(is,s) == -1 .AND. nxl-1 == -1 ) ) & 1391 THEN 1392 ind(1) = nys-1; ind(2) = nyn+1 1393 ind(3) = nzb; ind(4) = nzt+1 1394 ELSE 1395 ind(1) = -9999; ind(2) = -9999 1396 ind(3) = -9999; ind(4) = -9999 1397 ENDIF 1398 CALL MPI_SEND( ind(1), 4, MPI_INTEGER, 0, 0, & 1399 comm2d, ierr ) 1400 ! 1401 !-- If applicable, send data to PE0. 1402 IF ( ind(1) /= -9999 ) THEN 1403 CALL MPI_SEND( local_2d(nys-1,nzb), ngp, & 1404 MPI_REAL, 0, 1, comm2d, ierr ) 1405 ENDIF 1406 ENDIF 1407 ! 1408 !-- A barrier has to be set, because otherwise some PEs may 1409 !-- proceed too fast so that PE0 may receive wrong data on 1410 !-- tag 0 1411 CALL MPI_BARRIER( comm2d, ierr ) 1412 ENDIF 1413 1163 1414 ENDIF 1164 1415 #else … … 1173 1424 start = (/ is, 1, 1, do2d_xz_time_count(av) /), & 1174 1425 count = (/ 1, ny+2, nz+2, 1 /) ) 1175 CALL handle_netcdf_error( 'data_output_2d', 61)1426 CALL handle_netcdf_error( 'data_output_2d', 452 ) 1176 1427 ENDIF 1177 1428 #endif
Note: See TracChangeset
for help on using the changeset viewer.
