Changeset 3241 for palm/trunk/SOURCE/vertical_nesting_mod.f90
- Timestamp:
- Sep 12, 2018 3:02:00 PM (6 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/vertical_nesting_mod.f90 (modified) (49 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/vertical_nesting_mod.f90
r3232 r3241 26 26 ! ----------------- 27 27 ! $Id$ 28 ! unused variables removed 29 ! 30 ! 3232 2018-09-07 12:21:44Z raasch 28 31 ! references to mrun replaced by palmrun, and updated 29 32 ! … … 137 140 138 141 INTEGER(iwp) :: n_cell_c !> total no. of CG grid points in a PE 139 INTEGER(iwp) :: n_cell_f !> total no. of FG grid points in a PE140 142 INTEGER(iwp),DIMENSION(2) :: pdims_partner !> processor topology of partner PE 141 143 INTEGER(iwp) :: target_idex !> temporary variable … … 185 187 f_rnk_lst, c_rnk_lst, cfratio, pdims_partner, & 186 188 nxc, nxf, nyc, nyf, nzc, nzf, & 187 ngp_c, ngp_f, target_idex, n_cell_c, n_cell_f,&189 ngp_c, ngp_f, target_idex, n_cell_c, & 188 190 offset, map_coord, TYPE_VNEST_BC, TYPE_VNEST_ANTER 189 191 … … 253 255 USE interfaces 254 256 USE pegrid 255 USE surface_mod, &256 ONLY : surf_def_h, surf_def_v257 257 USE turbulence_closure_mod, & 258 258 ONLY : tcm_diffusivities … … 264 264 INTEGER(iwp) :: i 265 265 INTEGER(iwp) :: j 266 INTEGER(iwp) :: k267 INTEGER(iwp) :: im268 INTEGER(iwp) :: jn269 INTEGER(iwp) :: ko270 266 INTEGER(iwp) :: iif 271 267 INTEGER(iwp) :: jjf … … 480 476 comm_inter,status, ierr ) 481 477 interpol3d => u 482 call interpolate_to_fine_u ( 101 )478 call interpolate_to_fine_u 483 479 484 480 CALL MPI_RECV( work3d,n_cell_c, MPI_REAL, target_idex, 102, & 485 481 comm_inter,status, ierr ) 486 482 interpol3d => v 487 call interpolate_to_fine_v ( 102 )483 call interpolate_to_fine_v 488 484 489 485 CALL MPI_RECV( work3d,n_cell_c, MPI_REAL, target_idex, 103, & 490 486 comm_inter,status, ierr ) 491 487 interpol3d => w 492 call interpolate_to_fine_w ( 103 )488 call interpolate_to_fine_w 493 489 494 490 CALL MPI_RECV( work3d,n_cell_c, MPI_REAL, target_idex, 105, & 495 491 comm_inter,status, ierr ) 496 492 interpol3d => pt 497 call interpolate_to_fine_s ( 105 )493 call interpolate_to_fine_s 498 494 499 495 IF ( humidity ) THEN … … 501 497 comm_inter,status, ierr ) 502 498 interpol3d => q 503 call interpolate_to_fine_s ( 116 )499 call interpolate_to_fine_s 504 500 ENDIF 505 501 … … 507 503 comm_inter,status, ierr ) 508 504 interpol3d => e 509 call interpolate_to_fine_s ( 104 )505 call interpolate_to_fine_s 510 506 511 507 !-- kh,km no target attribute, use of pointer not possible 512 508 CALL MPI_RECV( work3d,n_cell_c, MPI_REAL, target_idex, 106, & 513 509 comm_inter,status, ierr ) 514 call interpolate_to_fine_kh ( 106 )510 call interpolate_to_fine_kh 515 511 516 512 CALL MPI_RECV( work3d,n_cell_c, MPI_REAL, target_idex, 107, & 517 513 comm_inter,status, ierr ) 518 call interpolate_to_fine_km ( 107 )514 call interpolate_to_fine_km 519 515 520 516 DEALLOCATE( work3d ) … … 644 640 CONTAINS 645 641 646 SUBROUTINE interpolate_to_fine_w ( tag )642 SUBROUTINE interpolate_to_fine_w 647 643 648 644 USE arrays_3d … … 655 651 IMPLICIT NONE 656 652 657 INTEGER(iwp), intent(in) :: tag658 653 INTEGER(iwp) :: i 659 654 INTEGER(iwp) :: j … … 776 771 END SUBROUTINE interpolate_to_fine_w 777 772 778 SUBROUTINE interpolate_to_fine_u ( tag )773 SUBROUTINE interpolate_to_fine_u 779 774 780 775 … … 788 783 IMPLICIT NONE 789 784 790 INTEGER(iwp), intent(in) :: tag791 785 INTEGER(iwp) :: i 792 786 INTEGER(iwp) :: j … … 922 916 923 917 924 SUBROUTINE interpolate_to_fine_v ( tag )918 SUBROUTINE interpolate_to_fine_v 925 919 926 920 … … 934 928 IMPLICIT NONE 935 929 936 INTEGER(iwp), intent(in) :: tag937 930 INTEGER(iwp) :: i 938 931 INTEGER(iwp) :: j … … 1066 1059 1067 1060 1068 SUBROUTINE interpolate_to_fine_s ( tag )1061 SUBROUTINE interpolate_to_fine_s 1069 1062 1070 1063 … … 1078 1071 IMPLICIT NONE 1079 1072 1080 INTEGER(iwp), intent(in) :: tag1081 1073 INTEGER(iwp) :: i 1082 1074 INTEGER(iwp) :: j … … 1216 1208 1217 1209 1218 SUBROUTINE interpolate_to_fine_kh ( tag )1210 SUBROUTINE interpolate_to_fine_kh 1219 1211 1220 1212 … … 1228 1220 IMPLICIT NONE 1229 1221 1230 INTEGER(iwp), intent(in) :: tag1231 1222 INTEGER(iwp) :: i 1232 1223 INTEGER(iwp) :: j … … 1248 1239 REAL(wp) :: edot 1249 1240 REAL(wp) :: eplus 1250 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: uprs1251 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: vprs1252 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: wprs1253 1241 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ptprs 1254 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: eprs1255 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: kmprs1256 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: khprs1257 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: tspr1258 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: uprf1259 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: vprf1260 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: wprf1261 1242 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ptprf 1262 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: eprf1263 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: kmprf1264 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: khprf1265 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: uswspr1266 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: vswspr1267 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: uspr1268 1243 1269 1244 … … 1384 1359 END SUBROUTINE interpolate_to_fine_kh 1385 1360 1386 SUBROUTINE interpolate_to_fine_km ( tag )1361 SUBROUTINE interpolate_to_fine_km 1387 1362 1388 1363 … … 1396 1371 IMPLICIT NONE 1397 1372 1398 INTEGER(iwp), intent(in) :: tag1399 1373 INTEGER(iwp) :: i 1400 1374 INTEGER(iwp) :: j … … 1416 1390 REAL(wp) :: edot 1417 1391 REAL(wp) :: eplus 1418 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: uprs1419 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: vprs1420 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: wprs1421 1392 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ptprs 1422 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: eprs1423 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: kmprs1424 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: khprs1425 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: vprf1426 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: wprf1427 1393 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ptprf 1428 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: eprf1429 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: kmprf1430 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: khprf1431 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: uswspr1432 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: vswspr1433 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: tspr1434 REAL(wp), DIMENSION(:,:), ALLOCATABLE :: uspr1435 1394 1436 1395 … … 1554 1513 1555 1514 1556 SUBROUTINE interpolate_to_fine_flux ( tag )1515 SUBROUTINE interpolate_to_fine_flux 1557 1516 1558 1517 … … 1566 1525 IMPLICIT NONE 1567 1526 1568 INTEGER(iwp), intent(in) :: tag1569 1527 INTEGER(iwp) :: i 1570 1528 INTEGER(iwp) :: j 1571 INTEGER(iwp) :: k1572 1529 INTEGER(iwp) :: iif 1573 1530 INTEGER(iwp) :: jjf 1574 INTEGER(iwp) :: kkf1575 INTEGER(iwp) :: nzbottom1576 INTEGER(iwp) :: nztop1577 1531 INTEGER(iwp) :: bottomx 1578 1532 INTEGER(iwp) :: bottomy 1579 INTEGER(iwp) :: bottomz1580 1533 INTEGER(iwp) :: topx 1581 1534 INTEGER(iwp) :: topy 1582 INTEGER(iwp) :: topz1583 1535 REAL(wp) :: eps 1584 1536 REAL(wp) :: alpha … … 1715 1667 INTEGER(iwp) :: iif 1716 1668 INTEGER(iwp) :: jjf 1717 REAL(wp) :: c_max1718 REAL(wp) :: denom1719 1669 1720 1670 … … 1868 1818 INTEGER(iwp) :: i 1869 1819 INTEGER(iwp) :: j 1870 INTEGER(iwp) :: k1871 1820 INTEGER(iwp) :: iif 1872 1821 INTEGER(iwp) :: jjf 1873 INTEGER(iwp) :: kkf1874 1822 INTEGER(iwp) :: bottomx 1875 1823 INTEGER(iwp) :: bottomy … … 1973 1921 INTEGER(iwp) :: iif 1974 1922 INTEGER(iwp) :: jjf 1975 INTEGER(iwp) :: kkf1976 1923 INTEGER(iwp) :: bottomx 1977 1924 INTEGER(iwp) :: bottomy … … 2073 2020 INTEGER(iwp) :: iif 2074 2021 INTEGER(iwp) :: jjf 2075 INTEGER(iwp) :: kkf2076 2022 INTEGER(iwp) :: bottomx 2077 2023 INTEGER(iwp) :: bottomy … … 2182 2128 INTEGER(iwp) :: iif 2183 2129 INTEGER(iwp) :: jjf 2184 INTEGER(iwp) :: kkf2185 2130 INTEGER(iwp) :: bottomx 2186 2131 INTEGER(iwp) :: bottomy … … 2332 2277 INTEGER(iwp) :: iif 2333 2278 INTEGER(iwp) :: jjf 2334 REAL(wp) :: c_max2335 REAL(wp) :: denom2336 2279 2337 2280 … … 2474 2417 INTEGER(iwp) :: iif 2475 2418 INTEGER(iwp) :: jjf 2476 INTEGER(iwp) :: kkf2477 2419 INTEGER(iwp) :: bottomx 2478 2420 INTEGER(iwp) :: bottomy … … 2614 2556 INTEGER(iwp) :: bottomx 2615 2557 INTEGER(iwp) :: bottomy 2616 INTEGER(iwp) :: bottomz2617 2558 INTEGER(iwp) :: topx 2618 2559 INTEGER(iwp) :: topy 2619 INTEGER(iwp) :: topz2620 2560 REAL(wp) :: eps 2621 2561 REAL(wp) :: alpha … … 2766 2706 INTEGER(iwp) :: j 2767 2707 INTEGER(iwp) :: k 2768 INTEGER(iwp) :: im2769 INTEGER(iwp) :: jn2770 INTEGER(iwp) :: ko2771 2708 INTEGER(iwp) :: kb !< variable to set respective boundary value, depends on facing. 2772 2709 INTEGER(iwp) :: l !< running index boundary type, for up- and downward-facing walls … … 2969 2906 anterpol3d => u 2970 2907 2971 CALL anterpolate_to_crse_u ( 101 )2908 CALL anterpolate_to_crse_u 2972 2909 CALL MPI_SEND( work3d, 1, TYPE_VNEST_ANTER, target_idex, & 2973 2910 101, comm_inter, ierr) … … 2975 2912 anterpol3d => v 2976 2913 2977 CALL anterpolate_to_crse_v ( 102 )2914 CALL anterpolate_to_crse_v 2978 2915 CALL MPI_SEND( work3d, 1, TYPE_VNEST_ANTER, target_idex, & 2979 2916 102, comm_inter, ierr) … … 2981 2918 anterpol3d => pt 2982 2919 2983 CALL anterpolate_to_crse_s ( 105 )2920 CALL anterpolate_to_crse_s 2984 2921 CALL MPI_SEND( work3d, 1, TYPE_VNEST_ANTER, target_idex, & 2985 2922 105, comm_inter, ierr) … … 2990 2927 anterpol3d => q 2991 2928 2992 CALL anterpolate_to_crse_s ( 106 )2929 CALL anterpolate_to_crse_s 2993 2930 CALL MPI_SEND( work3d, 1, TYPE_VNEST_ANTER, target_idex, & 2994 2931 106, comm_inter, ierr) … … 3001 2938 bdims_rem(1,1) :bdims_rem(1,2))) 3002 2939 anterpol3d => w 3003 CALL anterpolate_to_crse_w ( 103 )2940 CALL anterpolate_to_crse_w 3004 2941 CALL MPI_SEND( work3d, 1, TYPE_VNEST_ANTER, target_idex, & 3005 2942 103, comm_inter, ierr) … … 3013 2950 3014 2951 CONTAINS 3015 SUBROUTINE anterpolate_to_crse_u ( tag )2952 SUBROUTINE anterpolate_to_crse_u 3016 2953 3017 2954 … … 3025 2962 IMPLICIT NONE 3026 2963 3027 INTEGER(iwp), intent(in) :: tag 2964 INTEGER(iwp) :: i 2965 INTEGER(iwp) :: j 2966 INTEGER(iwp) :: k 2967 INTEGER(iwp) :: iif 2968 INTEGER(iwp) :: jjf 2969 INTEGER(iwp) :: kkf 2970 INTEGER(iwp) :: bottomy 2971 INTEGER(iwp) :: bottomz 2972 INTEGER(iwp) :: topy 2973 INTEGER(iwp) :: topz 2974 REAL(wp) :: aweight 2975 2976 ! 2977 !-- Anterpolation of the velocity components u 2978 !-- only values in yz-planes that coincide in the fine and 2979 !-- the coarse grid are considered 2980 2981 DO k = bdims_rem(3,1)+1, bdims_rem(3,2) 2982 2983 bottomz = (dzc/dzf) * (k-1) + 1 2984 topz = (dzc/dzf) * k 2985 2986 DO j = bdims_rem(2,1),bdims_rem(2,2) 2987 2988 bottomy = (nyf+1) / (nyc+1) * j 2989 topy = (nyf+1) / (nyc+1) * (j+1) - 1 2990 2991 DO i = bdims_rem(1,1),bdims_rem(1,2) 2992 2993 iif = (nxf+1) / (nxc+1) * i 2994 2995 aweight = 0.0 2996 2997 DO kkf = bottomz, topz 2998 DO jjf = bottomy, topy 2999 3000 aweight = aweight + anterpol3d(kkf,jjf,iif) * & 3001 (dzf/dzc) * (dyf/dyc) 3002 3003 END DO 3004 END DO 3005 3006 work3d(k,j,i) = aweight 3007 3008 END DO 3009 3010 END DO 3011 3012 END DO 3013 3014 3015 3016 END SUBROUTINE anterpolate_to_crse_u 3017 3018 3019 SUBROUTINE anterpolate_to_crse_v 3020 3021 3022 USE arrays_3d 3023 USE control_parameters 3024 USE grid_variables 3025 USE indices 3026 USE pegrid 3027 3028 3029 IMPLICIT NONE 3030 3031 INTEGER(iwp) :: i 3032 INTEGER(iwp) :: j 3033 INTEGER(iwp) :: k 3034 INTEGER(iwp) :: iif 3035 INTEGER(iwp) :: jjf 3036 INTEGER(iwp) :: kkf 3037 INTEGER(iwp) :: bottomx 3038 INTEGER(iwp) :: bottomz 3039 INTEGER(iwp) :: topx 3040 INTEGER(iwp) :: topz 3041 REAL(wp) :: aweight 3042 3043 ! 3044 !-- Anterpolation of the velocity components v 3045 !-- only values in xz-planes that coincide in the fine and 3046 !-- the coarse grid are considered 3047 3048 DO k = bdims_rem(3,1)+1, bdims_rem(3,2) 3049 3050 bottomz = (dzc/dzf) * (k-1) + 1 3051 topz = (dzc/dzf) * k 3052 3053 DO j = bdims_rem(2,1), bdims_rem(2,2) 3054 3055 jjf = (nyf+1) / (nyc+1) * j 3056 3057 DO i = bdims_rem(1,1), bdims_rem(1,2) 3058 3059 bottomx = (nxf+1) / (nxc+1) * i 3060 topx = (nxf+1) / (nxc+1) * (i+1) - 1 3061 3062 aweight = 0.0 3063 3064 DO kkf = bottomz, topz 3065 DO iif = bottomx, topx 3066 3067 aweight = aweight + anterpol3d(kkf,jjf,iif) * & 3068 (dzf/dzc) * (dxf/dxc) 3069 3070 3071 END DO 3072 END DO 3073 3074 work3d(k,j,i) = aweight 3075 3076 END DO 3077 END DO 3078 END DO 3079 3080 3081 3082 END SUBROUTINE anterpolate_to_crse_v 3083 3084 3085 SUBROUTINE anterpolate_to_crse_w 3086 3087 3088 USE arrays_3d 3089 USE control_parameters 3090 USE grid_variables 3091 USE indices 3092 USE pegrid 3093 3094 3095 IMPLICIT NONE 3096 3097 INTEGER(iwp) :: i 3098 INTEGER(iwp) :: j 3099 INTEGER(iwp) :: k 3100 INTEGER(iwp) :: iif 3101 INTEGER(iwp) :: jjf 3102 INTEGER(iwp) :: kkf 3103 INTEGER(iwp) :: bottomx 3104 INTEGER(iwp) :: bottomy 3105 INTEGER(iwp) :: topx 3106 INTEGER(iwp) :: topy 3107 REAL(wp) :: aweight 3108 3109 ! 3110 !-- Anterpolation of the velocity components w 3111 !-- only values in xy-planes that coincide in the fine and 3112 !-- the coarse grid are considered 3113 3114 DO k = bdims_rem(3,1), bdims_rem(3,2)-1 3115 3116 kkf = cfratio(3) * k 3117 3118 DO j = bdims_rem(2,1), bdims_rem(2,2) 3119 3120 bottomy = (nyf+1) / (nyc+1) * j 3121 topy = (nyf+1) / (nyc+1) * (j+1) - 1 3122 3123 DO i = bdims_rem(1,1), bdims_rem(1,2) 3124 3125 bottomx = (nxf+1) / (nxc+1) * i 3126 topx = (nxf+1) / (nxc+1) * (i+1) - 1 3127 3128 aweight = 0.0 3129 3130 DO jjf = bottomy, topy 3131 DO iif = bottomx, topx 3132 3133 aweight = aweight + anterpol3d (kkf,jjf,iif) * & 3134 (dxf/dxc) * (dyf/dyc) 3135 3136 END DO 3137 END DO 3138 3139 work3d(k,j,i) = aweight 3140 3141 END DO 3142 3143 END DO 3144 3145 END DO 3146 3147 3148 END SUBROUTINE anterpolate_to_crse_w 3149 3150 3151 SUBROUTINE anterpolate_to_crse_s 3152 3153 3154 USE arrays_3d 3155 USE control_parameters 3156 USE grid_variables 3157 USE indices 3158 USE pegrid 3159 3160 3161 IMPLICIT NONE 3162 3028 3163 INTEGER(iwp) :: i 3029 3164 INTEGER(iwp) :: j … … 3041 3176 3042 3177 ! 3043 !-- Anterpolation of the velocity components u3044 !-- only values in yz-planes that coincide in the fine and3045 !-- the coarse grid are considered3046 3047 DO k = bdims_rem(3,1)+1, bdims_rem(3,2)3048 3049 bottomz = (dzc/dzf) * (k-1) + 13050 topz = (dzc/dzf) * k3051 3052 DO j = bdims_rem(2,1),bdims_rem(2,2)3053 3054 bottomy = (nyf+1) / (nyc+1) * j3055 topy = (nyf+1) / (nyc+1) * (j+1) - 13056 3057 DO i = bdims_rem(1,1),bdims_rem(1,2)3058 3059 iif = (nxf+1) / (nxc+1) * i3060 3061 aweight = 0.03062 3063 DO kkf = bottomz, topz3064 DO jjf = bottomy, topy3065 3066 aweight = aweight + anterpol3d(kkf,jjf,iif) * &3067 (dzf/dzc) * (dyf/dyc)3068 3069 END DO3070 END DO3071 3072 work3d(k,j,i) = aweight3073 3074 END DO3075 3076 END DO3077 3078 END DO3079 3080 3081 3082 END SUBROUTINE anterpolate_to_crse_u3083 3084 3085 SUBROUTINE anterpolate_to_crse_v( tag )3086 3087 3088 USE arrays_3d3089 USE control_parameters3090 USE grid_variables3091 USE indices3092 USE pegrid3093 3094 3095 IMPLICIT NONE3096 3097 INTEGER(iwp), intent(in) :: tag3098 INTEGER(iwp) :: i3099 INTEGER(iwp) :: j3100 INTEGER(iwp) :: k3101 INTEGER(iwp) :: iif3102 INTEGER(iwp) :: jjf3103 INTEGER(iwp) :: kkf3104 INTEGER(iwp) :: bottomx3105 INTEGER(iwp) :: bottomy3106 INTEGER(iwp) :: bottomz3107 INTEGER(iwp) :: topx3108 INTEGER(iwp) :: topy3109 INTEGER(iwp) :: topz3110 REAL(wp) :: aweight3111 3112 !3113 !-- Anterpolation of the velocity components v3114 !-- only values in xz-planes that coincide in the fine and3115 !-- the coarse grid are considered3116 3117 DO k = bdims_rem(3,1)+1, bdims_rem(3,2)3118 3119 bottomz = (dzc/dzf) * (k-1) + 13120 topz = (dzc/dzf) * k3121 3122 DO j = bdims_rem(2,1), bdims_rem(2,2)3123 3124 jjf = (nyf+1) / (nyc+1) * j3125 3126 DO i = bdims_rem(1,1), bdims_rem(1,2)3127 3128 bottomx = (nxf+1) / (nxc+1) * i3129 topx = (nxf+1) / (nxc+1) * (i+1) - 13130 3131 aweight = 0.03132 3133 DO kkf = bottomz, topz3134 DO iif = bottomx, topx3135 3136 aweight = aweight + anterpol3d(kkf,jjf,iif) * &3137 (dzf/dzc) * (dxf/dxc)3138 3139 3140 END DO3141 END DO3142 3143 work3d(k,j,i) = aweight3144 3145 END DO3146 END DO3147 END DO3148 3149 3150 3151 END SUBROUTINE anterpolate_to_crse_v3152 3153 3154 SUBROUTINE anterpolate_to_crse_w( tag )3155 3156 3157 USE arrays_3d3158 USE control_parameters3159 USE grid_variables3160 USE indices3161 USE pegrid3162 3163 3164 IMPLICIT NONE3165 3166 INTEGER(iwp), intent(in) :: tag3167 INTEGER(iwp) :: i3168 INTEGER(iwp) :: j3169 INTEGER(iwp) :: k3170 INTEGER(iwp) :: iif3171 INTEGER(iwp) :: jjf3172 INTEGER(iwp) :: kkf3173 INTEGER(iwp) :: bottomx3174 INTEGER(iwp) :: bottomy3175 INTEGER(iwp) :: bottomz3176 INTEGER(iwp) :: topx3177 INTEGER(iwp) :: topy3178 INTEGER(iwp) :: topz3179 REAL(wp) :: aweight3180 3181 !3182 !-- Anterpolation of the velocity components w3183 !-- only values in xy-planes that coincide in the fine and3184 !-- the coarse grid are considered3185 3186 DO k = bdims_rem(3,1), bdims_rem(3,2)-13187 3188 kkf = cfratio(3) * k3189 3190 DO j = bdims_rem(2,1), bdims_rem(2,2)3191 3192 bottomy = (nyf+1) / (nyc+1) * j3193 topy = (nyf+1) / (nyc+1) * (j+1) - 13194 3195 DO i = bdims_rem(1,1), bdims_rem(1,2)3196 3197 bottomx = (nxf+1) / (nxc+1) * i3198 topx = (nxf+1) / (nxc+1) * (i+1) - 13199 3200 aweight = 0.03201 3202 DO jjf = bottomy, topy3203 DO iif = bottomx, topx3204 3205 aweight = aweight + anterpol3d (kkf,jjf,iif) * &3206 (dxf/dxc) * (dyf/dyc)3207 3208 END DO3209 END DO3210 3211 work3d(k,j,i) = aweight3212 3213 END DO3214 3215 END DO3216 3217 END DO3218 3219 3220 END SUBROUTINE anterpolate_to_crse_w3221 3222 3223 SUBROUTINE anterpolate_to_crse_s( tag )3224 3225 3226 USE arrays_3d3227 USE control_parameters3228 USE grid_variables3229 USE indices3230 USE pegrid3231 3232 3233 IMPLICIT NONE3234 3235 INTEGER(iwp), intent(in) :: tag3236 INTEGER(iwp) :: i3237 INTEGER(iwp) :: j3238 INTEGER(iwp) :: k3239 INTEGER(iwp) :: iif3240 INTEGER(iwp) :: jjf3241 INTEGER(iwp) :: kkf3242 INTEGER(iwp) :: bottomx3243 INTEGER(iwp) :: bottomy3244 INTEGER(iwp) :: bottomz3245 INTEGER(iwp) :: topx3246 INTEGER(iwp) :: topy3247 INTEGER(iwp) :: topz3248 REAL(wp) :: aweight3249 3250 !3251 3178 !-- Anterpolation of the potential temperature pt 3252 3179 !-- all fine grid values are considered … … 3317 3244 INTEGER(iwp) :: i 3318 3245 INTEGER(iwp) :: j 3319 INTEGER(iwp) :: k3320 INTEGER(iwp) :: im3321 INTEGER(iwp) :: jn3322 INTEGER(iwp) :: ko3323 3324 3246 3325 3247 ! … … 3437 3359 anterpol3d => e 3438 3360 3439 CALL anterpolate_to_crse_e ( 104 )3361 CALL anterpolate_to_crse_e 3440 3362 3441 3363 CALL MPI_SEND( work3d, 1, TYPE_VNEST_ANTER, target_idex, & … … 3453 3375 3454 3376 3455 SUBROUTINE anterpolate_to_crse_e ( tag )3377 SUBROUTINE anterpolate_to_crse_e 3456 3378 3457 3379 … … 3465 3387 IMPLICIT NONE 3466 3388 3467 INTEGER(iwp), intent(in) :: tag3468 3389 INTEGER(iwp) :: i 3469 3390 INTEGER(iwp) :: j … … 3565 3486 3566 3487 3567 USE control_parameters, & 3568 ONLY: coupling_mode, coupling_mode_remote, coupling_topology, dz 3569 3570 USE grid_variables, & 3571 ONLY: dx, dy 3572 3573 USE indices, & 3574 ONLY: nbgp, nx, ny, nz 3488 USE control_parameters, & 3489 ONLY: coupling_mode 3575 3490 3576 3491 USE kinds … … 3588 3503 CALL MPI_SEND( pdims, 2, MPI_INTEGER, numprocs, 33, comm_inter, & 3589 3504 ierr ) 3590 CALL MPI_RECV( pdims_partner, 2, MPI_INTEGER, numprocs, 66, 3505 CALL MPI_RECV( pdims_partner, 2, MPI_INTEGER, numprocs, 66, & 3591 3506 comm_inter, status, ierr ) 3592 3507 ELSEIF ( coupling_mode == 'vnested_fine') THEN … … 3649 3564 #if defined( __parallel ) 3650 3565 3651 USE control_parameters, 3652 ONLY: coupling_mode, coupling_ mode_remote, coupling_topology, dz,&3566 USE control_parameters, & 3567 ONLY: coupling_mode, coupling_topology, dz, & 3653 3568 dz_stretch_level_start, message_string 3654 3569 3655 USE grid_variables, 3570 USE grid_variables, & 3656 3571 ONLY: dx, dy 3657 3572 3658 USE indices, & 3659 ONLY: nbgp, nx, ny, nz, nxl, nxr, nys, nyn, nzb, nzt, & 3660 nxlg, nxrg, nysg, nyng 3573 USE indices, & 3574 ONLY: nbgp, nx, ny, nz, nxl, nxr, nys, nyn, nzb, nzt 3661 3575 3662 3576 USE kinds … … 3666 3580 IMPLICIT NONE 3667 3581 3668 INTEGER(iwp) :: dest_rnk3669 3582 INTEGER(iwp) :: i !< 3670 3583 INTEGER(iwp) :: j !<
Note: See TracChangeset
for help on using the changeset viewer.
