Changeset 4123 for palm/trunk/SOURCE/data_output_module.f90
- Timestamp:
- Jul 26, 2019 1:45:03 PM (5 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/data_output_module.f90 (modified) (38 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/data_output_module.f90
r4116 r4123 89 89 CHARACTER(LEN=charlen) :: data_type = '' !< data type 90 90 CHARACTER(LEN=charlen) :: name !< variable name 91 INTEGER(iwp) :: id = 0!< id within file91 INTEGER(iwp) :: id = -1 !< id within file 92 92 LOGICAL :: is_global = .FALSE. !< true if global variable 93 93 CHARACTER(LEN=charlen), DIMENSION(:), ALLOCATABLE :: dimension_names !< list of dimension names … … 99 99 CHARACTER(LEN=charlen) :: data_type = '' !< data type 100 100 CHARACTER(LEN=charlen) :: name !< dimension name 101 INTEGER(iwp) :: id = 0!< dimension id within file101 INTEGER(iwp) :: id = -1 !< dimension id within file 102 102 INTEGER(iwp) :: length !< length of dimension 103 103 INTEGER(iwp) :: length_mask !< length of masked dimension 104 INTEGER(iwp) :: var_id = 0!< associated variable id within file104 INTEGER(iwp) :: var_id = -1 !< associated variable id within file 105 105 LOGICAL :: is_masked = .FALSE. !< true if masked 106 106 INTEGER(iwp), DIMENSION(2) :: bounds !< lower and upper bound of dimension … … 127 127 CHARACTER(LEN=charlen) :: format = '' !< file format 128 128 CHARACTER(LEN=charlen) :: name = '' !< file name 129 INTEGER(iwp) :: id = 0!< id of file129 INTEGER(iwp) :: id = -1 !< id of file 130 130 LOGICAL :: is_init = .FALSE. !< true if initialized 131 131 TYPE(attribute_type), DIMENSION(:), ALLOCATABLE :: attributes !< list of attributes … … 965 965 ALLOCATE( dimension%masked_values_realwp(0:dimension%length_mask-1) ) 966 966 j = 0 967 DO i = 0, dimension%length-1967 DO i = dimension%bounds(1), dimension%bounds(2) !> @todo change loop also for other data types 968 968 IF ( dimension%mask(i) ) THEN 969 969 dimension%masked_values_realwp(j) = dimension%values_realwp(i) … … 1085 1085 ! ------------ 1086 1086 !> Add variable to database. 1087 !> Example call: 1088 !> dom_def_var( filename = 'DATA_OUTPUT_3D', & 1089 !> name = 'u', & 1090 !> dimension_names = (/'x ', 'y ', 'z ', 'time'/), & 1091 !> output_type = 'real32' ) 1092 !> @note The order of dimensions must match in reversed order to the dimensions of the 1093 !> corresponding variable array. The last given dimension can also be non-existent within the 1094 !> variable array if at any given call of 'dom_write_var' for this variable, the last 1095 !> dimension has only a single index. 1096 !> Hence, the array 'u' must be allocated with dimension 'x' as its last dimension, preceded 1097 !> by 'y', then 'z', and 'time' being the first dimension. If at any given write statement, 1098 !> only a single index of dimension 'time' is to be written, the dimension can be non-present 1099 !> in the variable array leaving dimension 'z' as the first dimension. 1100 !> So, the variable array needs to be allocated like either: 1101 !> ALLOCATE( u(<time>,<z>,<y>,<x>) ) 1102 !> or 1103 !> ALLOCATE( u(<z>,<y>,<x>) ) 1087 1104 !--------------------------------------------------------------------------------------------------! 1088 1105 FUNCTION dom_def_var( filename, name, dimension_names, output_type, is_global ) & … … 1123 1140 1124 1141 variable%dimension_names = dimension_names 1142 variable%dimension_ids = -1 1125 1143 variable%data_type = TRIM( output_type ) 1126 1144 … … 2578 2596 !> name = 'u', & 2579 2597 !> var_real64_3d = u, & 2580 !> bounds_start = (/nzb, nys, nxl/), & 2581 !> bounds_end = (/nzt, nyn, nxr/) ) 2598 !> bounds_start = (/nxl, nys, nzb, time_step/), & 2599 !> bounds_end = (/nxr, nyn, nzt, time_step/) ) 2600 !> @note The order of dimension bounds must match to the order of dimensions given in call 2601 !> 'dom_def_var'. I.e., the corresponding variable definition should be like: 2602 !> dom_def_var( filename = 'DATA_OUTPUT_3D', & 2603 !> name = 'u', & 2604 !> dimension_names = (/'x ', 'y ', 'z ', 'time'/), & 2605 !> output_type = <desired-output-type> ) 2582 2606 !--------------------------------------------------------------------------------------------------! 2583 2607 FUNCTION dom_write_var( filename, name, bounds_start, bounds_end, & … … 2606 2630 INTEGER(iwp) :: var_id !< variable ID 2607 2631 2608 INTEGER(iwp), DIMENSION(:), INTENT(IN) :: bounds_end !< end index (upper bound) of variable at each dimension2609 INTEGER(iwp), DIMENSION(:), INTENT(IN) :: bounds_start !< start index (lower bound) of variable at each dimension2610 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: bounds_ dim_start !< start index (lower bound) of each dimension of variable2611 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: bounds_ end_new !< start index (upper bound) of msked var at each dim2612 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: bounds_start_new !< start index (lower bound) of msked var at each dim2613 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: masked_indices !< dummy list holding all maskedindices along a dimension2632 INTEGER(iwp), DIMENSION(:), INTENT(IN) :: bounds_end !< end index per dimension of variable 2633 INTEGER(iwp), DIMENSION(:), INTENT(IN) :: bounds_start !< start index per dimension of variable 2634 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: bounds_origin !< first index of each dimension 2635 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: bounds_start_internal !< start index per dim. for output after masking 2636 INTEGER(iwp), DIMENSION(:), ALLOCATABLE :: value_counts !< count of indices to be written per dimension 2637 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE :: masked_indices !< list containing all output indices along a dimension 2614 2638 2615 2639 LOGICAL :: do_output !< true if any data lies within given range of masked dimension … … 2745 2769 2746 2770 !-- Save starting index (lower bounds) of each dimension 2747 ALLOCATE( bounds_dim_start(SIZE( dimension_list )) ) 2748 DO d = 1, SIZE( dimension_list ) 2749 bounds_dim_start(d) = dimension_list(d)%bounds(1) 2750 ENDDO 2751 2752 ALLOCATE( bounds_start_new(SIZE( dimension_list )) ) 2753 ALLOCATE( bounds_end_new(SIZE( dimension_list )) ) 2771 ALLOCATE( bounds_origin(SIZE( dimension_list )) ) 2772 ALLOCATE( bounds_start_internal(SIZE( dimension_list )) ) 2773 ALLOCATE( value_counts(SIZE( dimension_list )) ) 2754 2774 2755 2775 WRITE( temp_string, * ) bounds_start … … 2765 2785 2766 2786 !-- Get bounds for masking 2767 CALL get_masked_indices_and_masked_dimension_bounds( dimension_list, & 2768 bounds_start, bounds_end, bounds_start_new, bounds_end_new, & 2769 masked_indices, do_output ) 2770 2771 WRITE( temp_string, * ) bounds_start_new 2787 CALL get_masked_indices_and_masked_dimension_bounds( dimension_list, & 2788 bounds_start, bounds_end, bounds_start_internal, value_counts, bounds_origin, & 2789 masked_indices ) 2790 2791 do_output = .NOT. ANY( value_counts == 0 ) 2792 2793 WRITE( temp_string, * ) bounds_start_internal 2772 2794 CALL internal_message( 'debug', routine_name // & 2773 2795 ': file "' // TRIM( filename ) // & 2774 2796 '": variable "' // TRIM( name ) // & 2775 '": bounds_start_ new=' // TRIM( temp_string ) )2776 WRITE( temp_string, * ) bounds_end_new2797 '": bounds_start_internal =' // TRIM( temp_string ) ) 2798 WRITE( temp_string, * ) value_counts 2777 2799 CALL internal_message( 'debug', routine_name // & 2778 2800 ': file "' // TRIM( filename ) // & 2779 2801 '": variable "' // TRIM( name ) // & 2780 '": bounds_end_new=' // TRIM( temp_string ) )2802 '": value_counts =' // TRIM( temp_string ) ) 2781 2803 2782 2804 !-- Mask and resort variable … … 2786 2808 ELSEIF ( PRESENT( var_int8_1d ) ) THEN 2787 2809 IF ( do_output ) THEN 2788 ALLOCATE( var_int8_1d_resorted( bounds_start_new(1):bounds_end_new(1)) )2810 ALLOCATE( var_int8_1d_resorted(0:value_counts(1)-1) ) 2789 2811 !$OMP PARALLEL PRIVATE (i) 2790 2812 !$OMP DO 2791 DO i = bounds_start_new(1), bounds_end_new(1)2813 DO i = 0, value_counts(1) - 1 2792 2814 var_int8_1d_resorted(i) = var_int8_1d(masked_indices(1,i)) 2793 2815 ENDDO … … 2800 2822 ELSEIF ( PRESENT( var_int8_2d ) ) THEN 2801 2823 IF ( do_output ) THEN 2802 ALLOCATE( var_int8_2d_resorted( bounds_start_new(1):bounds_end_new(1), &2803 bounds_start_new(2):bounds_end_new(2)) )2824 ALLOCATE( var_int8_2d_resorted(0:value_counts(1)-1, & 2825 0:value_counts(2)-1) ) 2804 2826 !$OMP PARALLEL PRIVATE (i,j) 2805 2827 !$OMP DO 2806 DO i = bounds_start_new(1), bounds_end_new(1)2807 DO j = bounds_start_new(2), bounds_end_new(2)2828 DO i = 0, value_counts(1) - 1 2829 DO j = 0, value_counts(2) - 1 2808 2830 var_int8_2d_resorted(i,j) = var_int8_2d(masked_indices(2,j), & 2809 2831 masked_indices(1,i) ) … … 2818 2840 ELSEIF ( PRESENT( var_int8_3d ) ) THEN 2819 2841 IF ( do_output ) THEN 2820 ALLOCATE( var_int8_3d_resorted( bounds_start_new(1):bounds_end_new(1), &2821 bounds_start_new(2):bounds_end_new(2), &2822 bounds_start_new(3):bounds_end_new(3)) )2842 ALLOCATE( var_int8_3d_resorted(0:value_counts(1)-1, & 2843 0:value_counts(2)-1, & 2844 0:value_counts(3)-1) ) 2823 2845 !$OMP PARALLEL PRIVATE (i,j,k) 2824 2846 !$OMP DO 2825 DO i = bounds_start_new(1), bounds_end_new(1)2826 DO j = bounds_start_new(2), bounds_end_new(2)2827 DO k = bounds_start_new(3), bounds_end_new(3)2847 DO i = 0, value_counts(1) - 1 2848 DO j = 0, value_counts(2) - 1 2849 DO k = 0, value_counts(3) - 1 2828 2850 var_int8_3d_resorted(i,j,k) = var_int8_3d(masked_indices(3,k), & 2829 2851 masked_indices(2,j), & … … 2844 2866 ELSEIF ( PRESENT( var_int16_1d ) ) THEN 2845 2867 IF ( do_output ) THEN 2846 ALLOCATE( var_int16_1d_resorted( bounds_start_new(1):bounds_end_new(1)) )2868 ALLOCATE( var_int16_1d_resorted(0:value_counts(1)-1) ) 2847 2869 !$OMP PARALLEL PRIVATE (i) 2848 2870 !$OMP DO 2849 DO i = bounds_start_new(1), bounds_end_new(1)2871 DO i = 0, value_counts(1) - 1 2850 2872 var_int16_1d_resorted(i) = var_int16_1d(masked_indices(1,i)) 2851 2873 ENDDO … … 2858 2880 ELSEIF ( PRESENT( var_int16_2d ) ) THEN 2859 2881 IF ( do_output ) THEN 2860 ALLOCATE( var_int16_2d_resorted( bounds_start_new(1):bounds_end_new(1), &2861 bounds_start_new(2):bounds_end_new(2)) )2882 ALLOCATE( var_int16_2d_resorted(0:value_counts(1)-1, & 2883 0:value_counts(2)-1) ) 2862 2884 !$OMP PARALLEL PRIVATE (i,j) 2863 2885 !$OMP DO 2864 DO i = bounds_start_new(1), bounds_end_new(1)2865 DO j = bounds_start_new(2), bounds_end_new(2)2886 DO i = 0, value_counts(1) - 1 2887 DO j = 0, value_counts(2) - 1 2866 2888 var_int16_2d_resorted(i,j) = var_int16_2d(masked_indices(2,j), & 2867 2889 masked_indices(1,i)) … … 2876 2898 ELSEIF ( PRESENT( var_int16_3d ) ) THEN 2877 2899 IF ( do_output ) THEN 2878 ALLOCATE( var_int16_3d_resorted( bounds_start_new(1):bounds_end_new(1), &2879 bounds_start_new(2):bounds_end_new(2), &2880 bounds_start_new(3):bounds_end_new(3)) )2900 ALLOCATE( var_int16_3d_resorted(0:value_counts(1)-1, & 2901 0:value_counts(2)-1, & 2902 0:value_counts(3)-1) ) 2881 2903 !$OMP PARALLEL PRIVATE (i,j,k) 2882 2904 !$OMP DO 2883 DO i = bounds_start_new(1), bounds_end_new(1)2884 DO j = bounds_start_new(2), bounds_end_new(2)2885 DO k = bounds_start_new(3), bounds_end_new(3)2905 DO i = 0, value_counts(1) - 1 2906 DO j = 0, value_counts(2) - 1 2907 DO k = 0, value_counts(3) - 1 2886 2908 var_int16_3d_resorted(i,j,k) = var_int16_3d(masked_indices(3,k), & 2887 2909 masked_indices(2,j), & … … 2902 2924 ELSEIF ( PRESENT( var_int32_1d ) ) THEN 2903 2925 IF ( do_output ) THEN 2904 ALLOCATE( var_int32_1d_resorted( bounds_start_new(1):bounds_end_new(1)) )2926 ALLOCATE( var_int32_1d_resorted(0:value_counts(1)-1) ) 2905 2927 !$OMP PARALLEL PRIVATE (i) 2906 2928 !$OMP DO 2907 DO i = bounds_start_new(1), bounds_end_new(1)2929 DO i = 0, value_counts(1) - 1 2908 2930 var_int32_1d_resorted(i) = var_int32_1d(masked_indices(1,i)) 2909 2931 ENDDO … … 2916 2938 ELSEIF ( PRESENT( var_int32_2d ) ) THEN 2917 2939 IF ( do_output ) THEN 2918 ALLOCATE( var_int32_2d_resorted( bounds_start_new(1):bounds_end_new(1), &2919 bounds_start_new(2):bounds_end_new(2)) )2940 ALLOCATE( var_int32_2d_resorted(0:value_counts(1)-1, & 2941 0:value_counts(2)-1) ) 2920 2942 !$OMP PARALLEL PRIVATE (i,j) 2921 2943 !$OMP DO 2922 DO i = bounds_start_new(1), bounds_end_new(1)2923 DO j = bounds_start_new(2), bounds_end_new(2)2944 DO i = 0, value_counts(1) - 1 2945 DO j = 0, value_counts(2) - 1 2924 2946 var_int32_2d_resorted(i,j) = var_int32_2d(masked_indices(2,j), & 2925 2947 masked_indices(1,i) ) … … 2934 2956 ELSEIF ( PRESENT( var_int32_3d ) ) THEN 2935 2957 IF ( do_output ) THEN 2936 ALLOCATE( var_int32_3d_resorted( bounds_start_new(1):bounds_end_new(1), &2937 bounds_start_new(2):bounds_end_new(2), &2938 bounds_start_new(3):bounds_end_new(3)) )2958 ALLOCATE( var_int32_3d_resorted(0:value_counts(1)-1, & 2959 0:value_counts(2)-1, & 2960 0:value_counts(3)-1) ) 2939 2961 !$OMP PARALLEL PRIVATE (i,j,k) 2940 2962 !$OMP DO 2941 DO i = bounds_start_new(1), bounds_end_new(1)2942 DO j = bounds_start_new(2), bounds_end_new(2)2943 DO k = bounds_start_new(3), bounds_end_new(3)2963 DO i = 0, value_counts(1) - 1 2964 DO j = 0, value_counts(2) - 1 2965 DO k = 0, value_counts(3) - 1 2944 2966 var_int32_3d_resorted(i,j,k) = var_int32_3d(masked_indices(3,k), & 2945 2967 masked_indices(2,j), & … … 2960 2982 ELSEIF ( PRESENT( var_intwp_1d ) ) THEN 2961 2983 IF ( do_output ) THEN 2962 ALLOCATE( var_intwp_1d_resorted( bounds_start_new(1):bounds_end_new(1)) )2984 ALLOCATE( var_intwp_1d_resorted(0:value_counts(1)-1) ) 2963 2985 !$OMP PARALLEL PRIVATE (i) 2964 2986 !$OMP DO 2965 DO i = bounds_start_new(1), bounds_end_new(1)2987 DO i = 0, value_counts(1) - 1 2966 2988 var_intwp_1d_resorted(i) = var_intwp_1d(masked_indices(1,i)) 2967 2989 ENDDO … … 2974 2996 ELSEIF ( PRESENT( var_intwp_2d ) ) THEN 2975 2997 IF ( do_output ) THEN 2976 ALLOCATE( var_intwp_2d_resorted( bounds_start_new(1):bounds_end_new(1), &2977 bounds_start_new(2):bounds_end_new(2)) )2998 ALLOCATE( var_intwp_2d_resorted(0:value_counts(1)-1, & 2999 0:value_counts(2)-1) ) 2978 3000 !$OMP PARALLEL PRIVATE (i,j) 2979 3001 !$OMP DO 2980 DO i = bounds_start_new(1), bounds_end_new(1)2981 DO j = bounds_start_new(2), bounds_end_new(2)3002 DO i = 0, value_counts(1) - 1 3003 DO j = 0, value_counts(2) - 1 2982 3004 var_intwp_2d_resorted(i,j) = var_intwp_2d(masked_indices(2,j), & 2983 3005 masked_indices(1,i) ) … … 2992 3014 ELSEIF ( PRESENT( var_intwp_3d ) ) THEN 2993 3015 IF ( do_output ) THEN 2994 ALLOCATE( var_intwp_3d_resorted( bounds_start_new(1):bounds_end_new(1), &2995 bounds_start_new(2):bounds_end_new(2), &2996 bounds_start_new(3):bounds_end_new(3)) )3016 ALLOCATE( var_intwp_3d_resorted(0:value_counts(1)-1, & 3017 0:value_counts(2)-1, & 3018 0:value_counts(3)-1) ) 2997 3019 !$OMP PARALLEL PRIVATE (i,j,k) 2998 3020 !$OMP DO 2999 DO i = bounds_start_new(1), bounds_end_new(1)3000 DO j = bounds_start_new(2), bounds_end_new(2)3001 DO k = bounds_start_new(3), bounds_end_new(3)3021 DO i = 0, value_counts(1) - 1 3022 DO j = 0, value_counts(2) - 1 3023 DO k = 0, value_counts(3) - 1 3002 3024 var_intwp_3d_resorted(i,j,k) = var_intwp_3d(masked_indices(3,k), & 3003 3025 masked_indices(2,j), & … … 3018 3040 ELSEIF ( PRESENT( var_real32_1d ) ) THEN 3019 3041 IF ( do_output ) THEN 3020 ALLOCATE( var_real32_1d_resorted( bounds_start_new(1):bounds_end_new(1)) )3042 ALLOCATE( var_real32_1d_resorted(0:value_counts(1)-1) ) 3021 3043 !$OMP PARALLEL PRIVATE (i) 3022 3044 !$OMP DO 3023 DO i = bounds_start_new(1), bounds_end_new(1)3045 DO i = 0, value_counts(1) - 1 3024 3046 var_real32_1d_resorted(i) = var_real32_1d(masked_indices(1,i)) 3025 3047 ENDDO … … 3032 3054 ELSEIF ( PRESENT( var_real32_2d ) ) THEN 3033 3055 IF ( do_output ) THEN 3034 ALLOCATE( var_real32_2d_resorted( bounds_start_new(1):bounds_end_new(1), &3035 bounds_start_new(2):bounds_end_new(2)) )3056 ALLOCATE( var_real32_2d_resorted(0:value_counts(1)-1, & 3057 0:value_counts(2)-1) ) 3036 3058 !$OMP PARALLEL PRIVATE (i,j) 3037 3059 !$OMP DO 3038 DO i = bounds_start_new(1), bounds_end_new(1)3039 DO j = bounds_start_new(2), bounds_end_new(2)3060 DO i = 0, value_counts(1) - 1 3061 DO j = 0, value_counts(2) - 1 3040 3062 var_real32_2d_resorted(i,j) = var_real32_2d(masked_indices(2,j), & 3041 3063 masked_indices(1,i) ) … … 3050 3072 ELSEIF ( PRESENT( var_real32_3d ) ) THEN 3051 3073 IF ( do_output ) THEN 3052 ALLOCATE( var_real32_3d_resorted( bounds_start_new(1):bounds_end_new(1), &3053 bounds_start_new(2):bounds_end_new(2), &3054 bounds_start_new(3):bounds_end_new(3)) )3074 ALLOCATE( var_real32_3d_resorted(0:value_counts(1)-1, & 3075 0:value_counts(2)-1, & 3076 0:value_counts(3)-1) ) 3055 3077 !$OMP PARALLEL PRIVATE (i,j,k) 3056 3078 !$OMP DO 3057 DO i = bounds_start_new(1), bounds_end_new(1)3058 DO j = bounds_start_new(2), bounds_end_new(2)3059 DO k = bounds_start_new(3), bounds_end_new(3)3079 DO i = 0, value_counts(1) - 1 3080 DO j = 0, value_counts(2) - 1 3081 DO k = 0, value_counts(3) - 1 3060 3082 var_real32_3d_resorted(i,j,k) = var_real32_3d(masked_indices(3,k), & 3061 3083 masked_indices(2,j), & … … 3076 3098 ELSEIF ( PRESENT( var_real64_1d ) ) THEN 3077 3099 IF ( do_output ) THEN 3078 ALLOCATE( var_real64_1d_resorted( bounds_start_new(1):bounds_end_new(1)) )3100 ALLOCATE( var_real64_1d_resorted(0:value_counts(1)-1) ) 3079 3101 !$OMP PARALLEL PRIVATE (i) 3080 3102 !$OMP DO 3081 DO i = bounds_start_new(1), bounds_end_new(1)3103 DO i = 0, value_counts(1) - 1 3082 3104 var_real64_1d_resorted(i) = var_real64_1d(masked_indices(1,i)) 3083 3105 ENDDO … … 3090 3112 ELSEIF ( PRESENT( var_real64_2d ) ) THEN 3091 3113 IF ( do_output ) THEN 3092 ALLOCATE( var_real64_2d_resorted( bounds_start_new(1):bounds_end_new(1), &3093 bounds_start_new(2):bounds_end_new(2)) )3114 ALLOCATE( var_real64_2d_resorted(0:value_counts(1)-1, & 3115 0:value_counts(2)-1) ) 3094 3116 !$OMP PARALLEL PRIVATE (i,j) 3095 3117 !$OMP DO 3096 DO i = bounds_start_new(1), bounds_end_new(1)3097 DO j = bounds_start_new(2), bounds_end_new(2)3118 DO i = 0, value_counts(1) - 1 3119 DO j = 0, value_counts(2) - 1 3098 3120 var_real64_2d_resorted(i,j) = var_real64_2d(masked_indices(2,j), & 3099 3121 masked_indices(1,i) ) … … 3108 3130 ELSEIF ( PRESENT( var_real64_3d ) ) THEN 3109 3131 IF ( do_output ) THEN 3110 ALLOCATE( var_real64_3d_resorted( bounds_start_new(1):bounds_end_new(1), &3111 bounds_start_new(2):bounds_end_new(2), &3112 bounds_start_new(3):bounds_end_new(3)) )3132 ALLOCATE( var_real64_3d_resorted(0:value_counts(1)-1, & 3133 0:value_counts(2)-1, & 3134 0:value_counts(3)-1) ) 3113 3135 !$OMP PARALLEL PRIVATE (i,j,k) 3114 3136 !$OMP DO 3115 DO i = bounds_start_new(1), bounds_end_new(1)3116 DO j = bounds_start_new(2), bounds_end_new(2)3117 DO k = bounds_start_new(3), bounds_end_new(3)3137 DO i = 0, value_counts(1) - 1 3138 DO j = 0, value_counts(2) - 1 3139 DO k = 0, value_counts(3) - 1 3118 3140 var_real64_3d_resorted(i,j,k) = var_real64_3d(masked_indices(3,k), & 3119 3141 masked_indices(2,j), & … … 3134 3156 ELSEIF ( PRESENT( var_realwp_1d ) ) THEN 3135 3157 IF ( do_output ) THEN 3136 ALLOCATE( var_realwp_1d_resorted( bounds_start_new(1):bounds_end_new(1)) )3158 ALLOCATE( var_realwp_1d_resorted(0:value_counts(1)-1) ) 3137 3159 !$OMP PARALLEL PRIVATE (i) 3138 3160 !$OMP DO 3139 DO i = bounds_start_new(1), bounds_end_new(1)3161 DO i = 0, value_counts(1) - 1 3140 3162 var_realwp_1d_resorted(i) = var_realwp_1d(masked_indices(1,i)) 3141 3163 ENDDO … … 3148 3170 ELSEIF ( PRESENT( var_realwp_2d ) ) THEN 3149 3171 IF ( do_output ) THEN 3150 ALLOCATE( var_realwp_2d_resorted( bounds_start_new(1):bounds_end_new(1), &3151 bounds_start_new(2):bounds_end_new(2)) )3172 ALLOCATE( var_realwp_2d_resorted(0:value_counts(1)-1, & 3173 0:value_counts(2)-1) ) 3152 3174 !$OMP PARALLEL PRIVATE (i,j) 3153 3175 !$OMP DO 3154 DO i = bounds_start_new(1), bounds_end_new(1)3155 DO j = bounds_start_new(2), bounds_end_new(2)3176 DO i = 0, value_counts(1) - 1 3177 DO j = 0, value_counts(2) - 1 3156 3178 var_realwp_2d_resorted(i,j) = var_realwp_2d(masked_indices(2,j), & 3157 3179 masked_indices(1,i) ) … … 3166 3188 ELSEIF ( PRESENT( var_realwp_3d ) ) THEN 3167 3189 IF ( do_output ) THEN 3168 ALLOCATE( var_realwp_3d_resorted( bounds_start_new(1):bounds_end_new(1), &3169 bounds_start_new(2):bounds_end_new(2), &3170 bounds_start_new(3):bounds_end_new(3)) )3190 ALLOCATE( var_realwp_3d_resorted(0:value_counts(1)-1, & 3191 0:value_counts(2)-1, & 3192 0:value_counts(3)-1) ) 3171 3193 !$OMP PARALLEL PRIVATE (i,j,k) 3172 3194 !$OMP DO 3173 DO i = bounds_start_new(1), bounds_end_new(1)3174 DO j = bounds_start_new(2), bounds_end_new(2)3175 DO k = bounds_start_new(3), bounds_end_new(3)3195 DO i = 0, value_counts(1) - 1 3196 DO j = 0, value_counts(2) - 1 3197 DO k = 0, value_counts(3) - 1 3176 3198 var_realwp_3d_resorted(i,j,k) = var_realwp_3d(masked_indices(3,k), & 3177 3199 masked_indices(2,j), & … … 3207 3229 !-- 8bit integer output 3208 3230 IF ( PRESENT( var_int8_0d ) ) THEN 3209 CALL binary_write_variable( file_id, var_id, 3210 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3231 CALL binary_write_variable( file_id, var_id, & 3232 bounds_start_internal, value_counts, bounds_origin, is_global, & 3211 3233 var_int8_0d=var_int8_0d_pointer, return_value=output_return_value ) 3212 3234 ELSEIF ( PRESENT( var_int8_1d ) ) THEN 3213 CALL binary_write_variable( file_id, var_id, 3214 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3235 CALL binary_write_variable( file_id, var_id, & 3236 bounds_start_internal, value_counts, bounds_origin, is_global, & 3215 3237 var_int8_1d=var_int8_1d_pointer, return_value=output_return_value ) 3216 3238 ELSEIF ( PRESENT( var_int8_2d ) ) THEN 3217 CALL binary_write_variable( file_id, var_id, 3218 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3239 CALL binary_write_variable( file_id, var_id, & 3240 bounds_start_internal, value_counts, bounds_origin, is_global, & 3219 3241 var_int8_2d=var_int8_2d_pointer, return_value=output_return_value ) 3220 3242 ELSEIF ( PRESENT( var_int8_3d ) ) THEN 3221 CALL binary_write_variable( file_id, var_id, 3222 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3243 CALL binary_write_variable( file_id, var_id, & 3244 bounds_start_internal, value_counts, bounds_origin, is_global, & 3223 3245 var_int8_3d=var_int8_3d_pointer, return_value=output_return_value ) 3224 3246 !-- 16bit integer output 3225 3247 ELSEIF ( PRESENT( var_int16_0d ) ) THEN 3226 CALL binary_write_variable( file_id, var_id, 3227 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3248 CALL binary_write_variable( file_id, var_id, & 3249 bounds_start_internal, value_counts, bounds_origin, is_global, & 3228 3250 var_int16_0d=var_int16_0d_pointer, return_value=output_return_value ) 3229 3251 ELSEIF ( PRESENT( var_int16_1d ) ) THEN 3230 CALL binary_write_variable( file_id, var_id, 3231 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3252 CALL binary_write_variable( file_id, var_id, & 3253 bounds_start_internal, value_counts, bounds_origin, is_global, & 3232 3254 var_int16_1d=var_int16_1d_pointer, return_value=output_return_value ) 3233 3255 ELSEIF ( PRESENT( var_int16_2d ) ) THEN 3234 CALL binary_write_variable( file_id, var_id, 3235 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3256 CALL binary_write_variable( file_id, var_id, & 3257 bounds_start_internal, value_counts, bounds_origin, is_global, & 3236 3258 var_int16_2d=var_int16_2d_pointer, return_value=output_return_value ) 3237 3259 ELSEIF ( PRESENT( var_int16_3d ) ) THEN 3238 CALL binary_write_variable( file_id, var_id, 3239 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3260 CALL binary_write_variable( file_id, var_id, & 3261 bounds_start_internal, value_counts, bounds_origin, is_global, & 3240 3262 var_int16_3d=var_int16_3d_pointer, return_value=output_return_value ) 3241 3263 !-- 32bit integer output 3242 3264 ELSEIF ( PRESENT( var_int32_0d ) ) THEN 3243 CALL binary_write_variable( file_id, var_id, 3244 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3265 CALL binary_write_variable( file_id, var_id, & 3266 bounds_start_internal, value_counts, bounds_origin, is_global, & 3245 3267 var_int32_0d=var_int32_0d_pointer, return_value=output_return_value ) 3246 3268 ELSEIF ( PRESENT( var_int32_1d ) ) THEN 3247 CALL binary_write_variable( file_id, var_id, 3248 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3269 CALL binary_write_variable( file_id, var_id, & 3270 bounds_start_internal, value_counts, bounds_origin, is_global, & 3249 3271 var_int32_1d=var_int32_1d_pointer, return_value=output_return_value ) 3250 3272 ELSEIF ( PRESENT( var_int32_2d ) ) THEN 3251 CALL binary_write_variable( file_id, var_id, 3252 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3273 CALL binary_write_variable( file_id, var_id, & 3274 bounds_start_internal, value_counts, bounds_origin, is_global, & 3253 3275 var_int32_2d=var_int32_2d_pointer, return_value=output_return_value ) 3254 3276 ELSEIF ( PRESENT( var_int32_3d ) ) THEN 3255 CALL binary_write_variable( file_id, var_id, 3256 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3277 CALL binary_write_variable( file_id, var_id, & 3278 bounds_start_internal, value_counts, bounds_origin, is_global, & 3257 3279 var_int32_3d=var_int32_3d_pointer, return_value=output_return_value ) 3258 3280 !-- working-precision integer output 3259 3281 ELSEIF ( PRESENT( var_intwp_0d ) ) THEN 3260 CALL binary_write_variable( file_id, var_id, 3261 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3282 CALL binary_write_variable( file_id, var_id, & 3283 bounds_start_internal, value_counts, bounds_origin, is_global, & 3262 3284 var_intwp_0d=var_intwp_0d_pointer, return_value=output_return_value ) 3263 3285 ELSEIF ( PRESENT( var_intwp_1d ) ) THEN 3264 CALL binary_write_variable( file_id, var_id, 3265 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3286 CALL binary_write_variable( file_id, var_id, & 3287 bounds_start_internal, value_counts, bounds_origin, is_global, & 3266 3288 var_intwp_1d=var_intwp_1d_pointer, return_value=output_return_value ) 3267 3289 ELSEIF ( PRESENT( var_intwp_2d ) ) THEN 3268 CALL binary_write_variable( file_id, var_id, 3269 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3290 CALL binary_write_variable( file_id, var_id, & 3291 bounds_start_internal, value_counts, bounds_origin, is_global, & 3270 3292 var_intwp_2d=var_intwp_2d_pointer, return_value=output_return_value ) 3271 3293 ELSEIF ( PRESENT( var_intwp_3d ) ) THEN 3272 CALL binary_write_variable( file_id, var_id, 3273 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3294 CALL binary_write_variable( file_id, var_id, & 3295 bounds_start_internal, value_counts, bounds_origin, is_global, & 3274 3296 var_intwp_3d=var_intwp_3d_pointer, return_value=output_return_value ) 3275 3297 !-- 32bit real output 3276 3298 ELSEIF ( PRESENT( var_real32_0d ) ) THEN 3277 CALL binary_write_variable( file_id, var_id, 3278 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3299 CALL binary_write_variable( file_id, var_id, & 3300 bounds_start_internal, value_counts, bounds_origin, is_global, & 3279 3301 var_real32_0d=var_real32_0d_pointer, return_value=output_return_value ) 3280 3302 ELSEIF ( PRESENT( var_real32_1d ) ) THEN 3281 CALL binary_write_variable( file_id, var_id, 3282 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3303 CALL binary_write_variable( file_id, var_id, & 3304 bounds_start_internal, value_counts, bounds_origin, is_global, & 3283 3305 var_real32_1d=var_real32_1d_pointer, return_value=output_return_value ) 3284 3306 ELSEIF ( PRESENT( var_real32_2d ) ) THEN 3285 CALL binary_write_variable( file_id, var_id, 3286 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3307 CALL binary_write_variable( file_id, var_id, & 3308 bounds_start_internal, value_counts, bounds_origin, is_global, & 3287 3309 var_real32_2d=var_real32_2d_pointer, return_value=output_return_value ) 3288 3310 ELSEIF ( PRESENT( var_real32_3d ) ) THEN 3289 CALL binary_write_variable( file_id, var_id, 3290 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3311 CALL binary_write_variable( file_id, var_id, & 3312 bounds_start_internal, value_counts, bounds_origin, is_global, & 3291 3313 var_real32_3d=var_real32_3d_pointer, return_value=output_return_value ) 3292 3314 !-- 64bit real output 3293 3315 ELSEIF ( PRESENT( var_real64_0d ) ) THEN 3294 CALL binary_write_variable( file_id, var_id, 3295 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3316 CALL binary_write_variable( file_id, var_id, & 3317 bounds_start_internal, value_counts, bounds_origin, is_global, & 3296 3318 var_real64_0d=var_real64_0d_pointer, return_value=output_return_value ) 3297 3319 ELSEIF ( PRESENT( var_real64_1d ) ) THEN 3298 CALL binary_write_variable( file_id, var_id, 3299 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3320 CALL binary_write_variable( file_id, var_id, & 3321 bounds_start_internal, value_counts, bounds_origin, is_global, & 3300 3322 var_real64_1d=var_real64_1d_pointer, return_value=output_return_value ) 3301 3323 ELSEIF ( PRESENT( var_real64_2d ) ) THEN 3302 CALL binary_write_variable( file_id, var_id, 3303 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3324 CALL binary_write_variable( file_id, var_id, & 3325 bounds_start_internal, value_counts, bounds_origin, is_global, & 3304 3326 var_real64_2d=var_real64_2d_pointer, return_value=output_return_value ) 3305 3327 ELSEIF ( PRESENT( var_real64_3d ) ) THEN 3306 CALL binary_write_variable( file_id, var_id, 3307 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3328 CALL binary_write_variable( file_id, var_id, & 3329 bounds_start_internal, value_counts, bounds_origin, is_global, & 3308 3330 var_real64_3d=var_real64_3d_pointer, return_value=output_return_value ) 3309 3331 !-- working-precision real output 3310 3332 ELSEIF ( PRESENT( var_realwp_0d ) ) THEN 3311 CALL binary_write_variable( file_id, var_id, 3312 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3333 CALL binary_write_variable( file_id, var_id, & 3334 bounds_start_internal, value_counts, bounds_origin, is_global, & 3313 3335 var_realwp_0d=var_realwp_0d_pointer, return_value=output_return_value ) 3314 3336 ELSEIF ( PRESENT( var_realwp_1d ) ) THEN 3315 CALL binary_write_variable( file_id, var_id, 3316 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3337 CALL binary_write_variable( file_id, var_id, & 3338 bounds_start_internal, value_counts, bounds_origin, is_global, & 3317 3339 var_realwp_1d=var_realwp_1d_pointer, return_value=output_return_value ) 3318 3340 ELSEIF ( PRESENT( var_realwp_2d ) ) THEN 3319 CALL binary_write_variable( file_id, var_id, 3320 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3341 CALL binary_write_variable( file_id, var_id, & 3342 bounds_start_internal, value_counts, bounds_origin, is_global, & 3321 3343 var_realwp_2d=var_realwp_2d_pointer, return_value=output_return_value ) 3322 3344 ELSEIF ( PRESENT( var_realwp_3d ) ) THEN 3323 CALL binary_write_variable( file_id, var_id, 3324 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3345 CALL binary_write_variable( file_id, var_id, & 3346 bounds_start_internal, value_counts, bounds_origin, is_global, & 3325 3347 var_realwp_3d=var_realwp_3d_pointer, return_value=output_return_value ) 3326 3348 ELSE … … 3336 3358 !-- 8bit integer output 3337 3359 IF ( PRESENT( var_int8_0d ) ) THEN 3338 CALL netcdf4_write_variable( file_id, var_id, 3339 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3360 CALL netcdf4_write_variable( file_id, var_id, & 3361 bounds_start_internal, value_counts, bounds_origin, is_global, & 3340 3362 var_int8_0d=var_int8_0d_pointer, return_value=output_return_value ) 3341 3363 ELSEIF ( PRESENT( var_int8_1d ) ) THEN 3342 CALL netcdf4_write_variable( file_id, var_id, 3343 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3364 CALL netcdf4_write_variable( file_id, var_id, & 3365 bounds_start_internal, value_counts, bounds_origin, is_global, & 3344 3366 var_int8_1d=var_int8_1d_pointer, return_value=output_return_value ) 3345 3367 ELSEIF ( PRESENT( var_int8_2d ) ) THEN 3346 CALL netcdf4_write_variable( file_id, var_id, 3347 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3368 CALL netcdf4_write_variable( file_id, var_id, & 3369 bounds_start_internal, value_counts, bounds_origin, is_global, & 3348 3370 var_int8_2d=var_int8_2d_pointer, return_value=output_return_value ) 3349 3371 ELSEIF ( PRESENT( var_int8_3d ) ) THEN 3350 CALL netcdf4_write_variable( file_id, var_id, 3351 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3372 CALL netcdf4_write_variable( file_id, var_id, & 3373 bounds_start_internal, value_counts, bounds_origin, is_global, & 3352 3374 var_int8_3d=var_int8_3d_pointer, return_value=output_return_value ) 3353 3375 !-- 16bit integer output 3354 3376 ELSEIF ( PRESENT( var_int16_0d ) ) THEN 3355 CALL netcdf4_write_variable( file_id, var_id, 3356 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3377 CALL netcdf4_write_variable( file_id, var_id, & 3378 bounds_start_internal, value_counts, bounds_origin, is_global, & 3357 3379 var_int16_0d=var_int16_0d_pointer, return_value=output_return_value ) 3358 3380 ELSEIF ( PRESENT( var_int16_1d ) ) THEN 3359 CALL netcdf4_write_variable( file_id, var_id, 3360 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3381 CALL netcdf4_write_variable( file_id, var_id, & 3382 bounds_start_internal, value_counts, bounds_origin, is_global, & 3361 3383 var_int16_1d=var_int16_1d_pointer, return_value=output_return_value ) 3362 3384 ELSEIF ( PRESENT( var_int16_2d ) ) THEN 3363 CALL netcdf4_write_variable( file_id, var_id, 3364 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3385 CALL netcdf4_write_variable( file_id, var_id, & 3386 bounds_start_internal, value_counts, bounds_origin, is_global, & 3365 3387 var_int16_2d=var_int16_2d_pointer, return_value=output_return_value ) 3366 3388 ELSEIF ( PRESENT( var_int16_3d ) ) THEN 3367 CALL netcdf4_write_variable( file_id, var_id, 3368 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3389 CALL netcdf4_write_variable( file_id, var_id, & 3390 bounds_start_internal, value_counts, bounds_origin, is_global, & 3369 3391 var_int16_3d=var_int16_3d_pointer, return_value=output_return_value ) 3370 3392 !-- 32bit integer output 3371 3393 ELSEIF ( PRESENT( var_int32_0d ) ) THEN 3372 CALL netcdf4_write_variable( file_id, var_id, 3373 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3394 CALL netcdf4_write_variable( file_id, var_id, & 3395 bounds_start_internal, value_counts, bounds_origin, is_global, & 3374 3396 var_int32_0d=var_int32_0d_pointer, return_value=output_return_value ) 3375 3397 ELSEIF ( PRESENT( var_int32_1d ) ) THEN 3376 CALL netcdf4_write_variable( file_id, var_id, 3377 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3398 CALL netcdf4_write_variable( file_id, var_id, & 3399 bounds_start_internal, value_counts, bounds_origin, is_global, & 3378 3400 var_int32_1d=var_int32_1d_pointer, return_value=output_return_value ) 3379 3401 ELSEIF ( PRESENT( var_int32_2d ) ) THEN 3380 CALL netcdf4_write_variable( file_id, var_id, 3381 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3402 CALL netcdf4_write_variable( file_id, var_id, & 3403 bounds_start_internal, value_counts, bounds_origin, is_global, & 3382 3404 var_int32_2d=var_int32_2d_pointer, return_value=output_return_value ) 3383 3405 ELSEIF ( PRESENT( var_int32_3d ) ) THEN 3384 CALL netcdf4_write_variable( file_id, var_id, 3385 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3406 CALL netcdf4_write_variable( file_id, var_id, & 3407 bounds_start_internal, value_counts, bounds_origin, is_global, & 3386 3408 var_int32_3d=var_int32_3d_pointer, return_value=output_return_value ) 3387 3409 !-- working-precision integer output 3388 3410 ELSEIF ( PRESENT( var_intwp_0d ) ) THEN 3389 CALL netcdf4_write_variable( file_id, var_id, 3390 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3411 CALL netcdf4_write_variable( file_id, var_id, & 3412 bounds_start_internal, value_counts, bounds_origin, is_global, & 3391 3413 var_intwp_0d=var_intwp_0d_pointer, return_value=output_return_value ) 3392 3414 ELSEIF ( PRESENT( var_intwp_1d ) ) THEN 3393 CALL netcdf4_write_variable( file_id, var_id, 3394 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3415 CALL netcdf4_write_variable( file_id, var_id, & 3416 bounds_start_internal, value_counts, bounds_origin, is_global, & 3395 3417 var_intwp_1d=var_intwp_1d_pointer, return_value=output_return_value ) 3396 3418 ELSEIF ( PRESENT( var_intwp_2d ) ) THEN 3397 CALL netcdf4_write_variable( file_id, var_id, 3398 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3419 CALL netcdf4_write_variable( file_id, var_id, & 3420 bounds_start_internal, value_counts, bounds_origin, is_global, & 3399 3421 var_intwp_2d=var_intwp_2d_pointer, return_value=output_return_value ) 3400 3422 ELSEIF ( PRESENT( var_intwp_3d ) ) THEN 3401 CALL netcdf4_write_variable( file_id, var_id, 3402 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3423 CALL netcdf4_write_variable( file_id, var_id, & 3424 bounds_start_internal, value_counts, bounds_origin, is_global, & 3403 3425 var_intwp_3d=var_intwp_3d_pointer, return_value=output_return_value ) 3404 3426 !-- 32bit real output 3405 3427 ELSEIF ( PRESENT( var_real32_0d ) ) THEN 3406 CALL netcdf4_write_variable( file_id, var_id, 3407 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3428 CALL netcdf4_write_variable( file_id, var_id, & 3429 bounds_start_internal, value_counts, bounds_origin, is_global, & 3408 3430 var_real32_0d=var_real32_0d_pointer, return_value=output_return_value ) 3409 3431 ELSEIF ( PRESENT( var_real32_1d ) ) THEN 3410 CALL netcdf4_write_variable( file_id, var_id, 3411 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3432 CALL netcdf4_write_variable( file_id, var_id, & 3433 bounds_start_internal, value_counts, bounds_origin, is_global, & 3412 3434 var_real32_1d=var_real32_1d_pointer, return_value=output_return_value ) 3413 3435 ELSEIF ( PRESENT( var_real32_2d ) ) THEN 3414 CALL netcdf4_write_variable( file_id, var_id, 3415 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3436 CALL netcdf4_write_variable( file_id, var_id, & 3437 bounds_start_internal, value_counts, bounds_origin, is_global, & 3416 3438 var_real32_2d=var_real32_2d_pointer, return_value=output_return_value ) 3417 3439 ELSEIF ( PRESENT( var_real32_3d ) ) THEN 3418 CALL netcdf4_write_variable( file_id, var_id, 3419 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3440 CALL netcdf4_write_variable( file_id, var_id, & 3441 bounds_start_internal, value_counts, bounds_origin, is_global, & 3420 3442 var_real32_3d=var_real32_3d_pointer, return_value=output_return_value ) 3421 3443 !-- 64bit real output 3422 3444 ELSEIF ( PRESENT( var_real64_0d ) ) THEN 3423 CALL netcdf4_write_variable( file_id, var_id, 3424 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3445 CALL netcdf4_write_variable( file_id, var_id, & 3446 bounds_start_internal, value_counts, bounds_origin, is_global, & 3425 3447 var_real64_0d=var_real64_0d_pointer, return_value=output_return_value ) 3426 3448 ELSEIF ( PRESENT( var_real64_1d ) ) THEN 3427 CALL netcdf4_write_variable( file_id, var_id, 3428 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3449 CALL netcdf4_write_variable( file_id, var_id, & 3450 bounds_start_internal, value_counts, bounds_origin, is_global, & 3429 3451 var_real64_1d=var_real64_1d_pointer, return_value=output_return_value ) 3430 3452 ELSEIF ( PRESENT( var_real64_2d ) ) THEN 3431 CALL netcdf4_write_variable( file_id, var_id, 3432 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3453 CALL netcdf4_write_variable( file_id, var_id, & 3454 bounds_start_internal, value_counts, bounds_origin, is_global, & 3433 3455 var_real64_2d=var_real64_2d_pointer, return_value=output_return_value ) 3434 3456 ELSEIF ( PRESENT( var_real64_3d ) ) THEN 3435 CALL netcdf4_write_variable( file_id, var_id, 3436 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3457 CALL netcdf4_write_variable( file_id, var_id, & 3458 bounds_start_internal, value_counts, bounds_origin, is_global, & 3437 3459 var_real64_3d=var_real64_3d_pointer, return_value=output_return_value ) 3438 3460 !-- working-precision real output 3439 3461 ELSEIF ( PRESENT( var_realwp_0d ) ) THEN 3440 CALL netcdf4_write_variable( file_id, var_id, 3441 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3462 CALL netcdf4_write_variable( file_id, var_id, & 3463 bounds_start_internal, value_counts, bounds_origin, is_global, & 3442 3464 var_realwp_0d=var_realwp_0d_pointer, return_value=output_return_value ) 3443 3465 ELSEIF ( PRESENT( var_realwp_1d ) ) THEN 3444 CALL netcdf4_write_variable( file_id, var_id, 3445 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3466 CALL netcdf4_write_variable( file_id, var_id, & 3467 bounds_start_internal, value_counts, bounds_origin, is_global, & 3446 3468 var_realwp_1d=var_realwp_1d_pointer, return_value=output_return_value ) 3447 3469 ELSEIF ( PRESENT( var_realwp_2d ) ) THEN 3448 CALL netcdf4_write_variable( file_id, var_id, 3449 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3470 CALL netcdf4_write_variable( file_id, var_id, & 3471 bounds_start_internal, value_counts, bounds_origin, is_global, & 3450 3472 var_realwp_2d=var_realwp_2d_pointer, return_value=output_return_value ) 3451 3473 ELSEIF ( PRESENT( var_realwp_3d ) ) THEN 3452 CALL netcdf4_write_variable( file_id, var_id, 3453 bounds_start_ new, bounds_end_new, bounds_dim_start, do_output, is_global, &3474 CALL netcdf4_write_variable( file_id, var_id, & 3475 bounds_start_internal, value_counts, bounds_origin, is_global, & 3454 3476 var_realwp_3d=var_realwp_3d_pointer, return_value=output_return_value ) 3455 3477 ELSE … … 3608 3630 ! ------------ 3609 3631 !> Search for masked indices of dimensions within the given bounds ('bounds_start' and 3610 !> 'bounds_end'). Return the masked indices ('masked_indices') of the dimensions and the bounds of 3611 !> the masked dimensions containing these indices ('bounds_masked_start' and 'bounds_masked_end'). 3612 !> If no masked indices lie within the given bounds, 'mask_in_bounds' is .FALSE.. 3613 !--------------------------------------------------------------------------------------------------! 3614 SUBROUTINE get_masked_indices_and_masked_dimension_bounds( & 3615 dimensions, bounds_start, bounds_end, bounds_masked_start, bounds_masked_end, & 3616 masked_indices, mask_in_bounds ) 3632 !> 'bounds_end'). Return the masked indices ('masked_indices') of the dimensions, the first index 3633 !> of the masked dimensions containing these indices ('bounds_masked_start'), the count of masked 3634 !> indices within given bounds ('value_counts') and the origin index of each dimension 3635 !> ('bounds_origin'). If, for any dimension, no masked index lies within the given bounds, counts, 3636 !> starts and origins are set to zero for all dimensions. 3637 !--------------------------------------------------------------------------------------------------! 3638 SUBROUTINE get_masked_indices_and_masked_dimension_bounds( & 3639 dimensions, bounds_start, bounds_end, bounds_masked_start, value_counts, & 3640 bounds_origin, masked_indices ) 3617 3641 3618 3642 ! CHARACTER(LEN=*), PARAMETER :: routine_name = 'get_masked_indices_and_masked_dimension_bounds' !< name of routine … … 3623 3647 3624 3648 INTEGER(iwp), DIMENSION(:), INTENT(IN) :: bounds_end !< upper bonuds to be searched in 3625 INTEGER(iwp), DIMENSION(:), INTENT(OUT) :: bounds_masked_end !< upper bounds of masked dimensions within given bounds3626 3649 INTEGER(iwp), DIMENSION(:), INTENT(OUT) :: bounds_masked_start !< lower bounds of masked dimensions within given bounds 3650 INTEGER(iwp), DIMENSION(:), INTENT(OUT) :: bounds_origin !< first index of each dimension, 0 if dimension is masked 3627 3651 INTEGER(iwp), DIMENSION(:), INTENT(IN) :: bounds_start !< lower bounds to be searched in 3652 INTEGER(iwp), DIMENSION(:), INTENT(OUT) :: value_counts !< count of indices per dimension to be output 3628 3653 3629 3654 INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE, INTENT(OUT) :: masked_indices !< masked indices within given bounds 3630 3655 3631 LOGICAL, INTENT(OUT) :: mask_in_bounds !< true if any masked indices lie within given bounds3632 3633 3656 TYPE(dimension_type), DIMENSION(:), INTENT(IN) :: dimensions !< dimensions to be searched for masked indices 3634 3657 3635 3658 3636 mask_in_bounds = .TRUE. 3637 ALLOCATE( masked_indices(SIZE( dimensions ),0:MAXVAL( dimensions(:)%length - 1 )) ) 3659 ALLOCATE( masked_indices(SIZE( dimensions ),0:MAXVAL( bounds_end - bounds_start + 1 )) ) 3638 3660 masked_indices = -HUGE( 0_iwp ) 3639 3661 … … 3643 3665 IF ( dimensions(d)%is_masked ) THEN 3644 3666 3645 bounds_masked_end(d) = HUGE( 0_iwp ) 3667 bounds_origin(d) = 0 3668 3646 3669 bounds_masked_start(d) = -HUGE( 0_iwp ) 3647 3670 3648 3671 !-- Find number of masked values within given variable bounds 3649 j= 03672 value_counts(d) = 0 3650 3673 DO i = LBOUND( dimensions(d)%masked_indices, DIM=1 ), & 3651 3674 UBOUND( dimensions(d)%masked_indices, DIM=1 ) 3652 3675 3653 !-- Is masked positionwithin given bounds?3676 !-- Is masked index within given bounds? 3654 3677 IF ( dimensions(d)%masked_indices(i) >= bounds_start(d) .AND. & 3655 3678 dimensions(d)%masked_indices(i) <= bounds_end(d) ) THEN 3656 3679 3657 !-- Save masked position3658 masked_indices(d, i) = dimensions(d)%masked_indices(i)3659 j = j+ 13680 !-- Save masked index 3681 masked_indices(d,value_counts(d)) = dimensions(d)%masked_indices(i) 3682 value_counts(d) = value_counts(d) + 1 3660 3683 3661 3684 !-- Save bounds of mask within given bounds 3662 3685 IF ( bounds_masked_start(d) == -HUGE( 0_iwp ) ) bounds_masked_start(d) = i 3663 bounds_masked_end(d) = i3664 3686 3665 3687 ENDIF … … 3667 3689 ENDDO 3668 3690 3669 !-- Set masked bounds to zero if no masked data lies within bounds 3670 IF ( j == 0 ) THEN 3691 !-- Set masked bounds to zero if no masked index lies within bounds 3692 IF ( value_counts(d) == 0 ) THEN 3693 bounds_origin(:) = 0 3671 3694 bounds_masked_start(:) = 0_iwp 3672 bounds_masked_end(:) = 0_iwp 3673 mask_in_bounds = .FALSE. 3695 value_counts(:) = 0_iwp 3674 3696 EXIT 3675 3697 ENDIF … … 3677 3699 ELSE 3678 3700 3679 !-- If dimension is not masked, tread all data within bounds as masked 3701 !-- If dimension is not masked, save all indices within bounds for output 3702 bounds_origin(d) = dimensions(d)%bounds(1) 3680 3703 bounds_masked_start(d) = bounds_start(d) 3681 bounds_masked_end(d) = bounds_end(d) 3682 DO i = bounds_masked_start(d), bounds_masked_end(d) 3683 masked_indices(d,i) = i 3704 value_counts(d) = bounds_end(d) - bounds_start(d) + 1 3705 3706 DO i = 0, value_counts(d) - 1 3707 masked_indices(d,i) = bounds_start(d) + i 3684 3708 ENDDO 3685 3709
Note: See TracChangeset
for help on using the changeset viewer.
