Changeset 2938 for palm/trunk/SOURCE/pmc_interface_mod.f90
- Timestamp:
- Mar 27, 2018 3:52:42 PM (6 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/pmc_interface_mod.f90 (modified) (38 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/pmc_interface_mod.f90
r2903 r2938 25 25 ! ----------------- 26 26 ! $Id$ 27 ! - Nesting for RANS mode implemented 28 ! - Interpolation of TKE onto child domain only if both parent and child are 29 ! either in LES mode or in RANS mode 30 ! - Interpolation of dissipation if both parent and child are in RANS mode 31 ! and TKE-epsilon closure is applied 32 ! - Enable anterpolation of TKE and dissipation rate in case parent and 33 ! child operate in RANS mode 34 ! 35 ! - Some unused variables removed from ONLY list 36 ! - Some formatting adjustments for particle nesting 37 ! 38 ! 2936 2018-03-27 14:49:27Z suehring 27 39 ! Control logics improved to allow nesting also in cases with 28 40 ! constant_flux_layer = .F. or constant_diffusion = .T. … … 254 266 #if defined( __nopointer ) 255 267 USE arrays_3d, & 256 ONLY: d zu, dzw, e, e_p, nc, nr, pt, pt_p, q, q_p, qc, qr, s, u, u_p,&268 ONLY: diss, dzu, dzw, e, e_p, nc, nr, pt, q, qc, qr, s, u, u_p, & 257 269 v, v_p, w, w_p, zu, zw 258 270 #else 259 271 USE arrays_3d, & 260 ONLY: d zu, dzw, e, e_p, e_1, e_2, nc, nc_2, nc_p, nr, nr_2, nr_p, pt,&261 pt _p, pt_1, pt_2, q, q_p, q_1, q_2, qc, qc_2, qr, qr_2, s, s_2,&262 u, u_p, u_ 1, u_2, v, v_p, v_1, v_2, w, w_p, w_1, w_2, zu, zw272 ONLY: diss, diss_2, dzu, dzw, e, e_p, e_2, nc, nc_2, nc_p, nr, nr_2, & 273 pt, pt_2, q, q_2, qc, qc_2, qr, qr_2, s, s_2, & 274 u, u_p, u_2, v, v_p, v_2, w, w_p, w_2, zu, zw 263 275 #endif 264 276 … … 269 281 microphysics_morrison, microphysics_seifert, & 270 282 nest_bound_l, nest_bound_r, nest_bound_s, nest_bound_n, & 271 nest_domain, neutral, passive_scalar, r oughness_length, &272 simulated_time, topography, volume_flow283 nest_domain, neutral, passive_scalar, rans_mode, rans_tke_e, & 284 roughness_length, simulated_time, topography, volume_flow 273 285 274 286 USE chem_modules, & … … 359 371 360 372 LOGICAL, SAVE :: nested_run = .FALSE. !< general switch 373 LOGICAL :: rans_mode_parent = .FALSE. !< mode of parent model (.F. - LES mode, .T. - RANS mode) 361 374 362 375 REAL(wp), SAVE :: anterp_relax_length_l = -1.0_wp !< … … 387 400 REAL(wp), SAVE, DIMENSION(:,:), ALLOCATABLE :: tkefactor_t !< 388 401 402 REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: dissc !< coarse grid array on child domain - dissipation rate 389 403 REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ec !< 390 404 REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ptc !< … … 401 415 INTEGER(idp), SAVE, DIMENSION(:,:), ALLOCATABLE, TARGET, PUBLIC :: part_adrc !< 402 416 403 404 REAL(wp), SAVE, DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: chem_spec_c !< child coarse data array for chemical species 417 REAL(wp), SAVE, DIMENSION(:,:,:,:), ALLOCATABLE, TARGET :: chem_spec_c !< coarse grid array on child domain - chemical species 405 418 406 419 ! … … 616 629 anterp_relax_length_t, child_to_parent, comm_world_nesting, & 617 630 cpl_id, nested_run, nesting_datatransfer_mode, nesting_mode, & 618 parent_to_child 631 parent_to_child, rans_mode_parent 619 632 620 633 PUBLIC pmci_boundary_conds … … 804 817 ! Initialize the pmc parent 805 818 CALL pmc_parentinit 819 806 820 ! 807 821 !-- Corners of all children of the present parent … … 821 835 822 836 child_id = pmc_parent_for_child(m) 823 IF ( myid == 0 ) THEN 837 838 IF ( myid == 0 ) THEN 824 839 825 840 CALL pmc_recv_from_child( child_id, val, size(val), 0, 123, ierr ) … … 932 947 DEALLOCATE( cl_coord_x ) 933 948 DEALLOCATE( cl_coord_y ) 949 950 ! 951 !-- Send information about operating mode (LES or RANS) to child. This will be 952 !-- used to control TKE nesting and setting boundary conditions properly. 953 CALL pmc_send_to_child( child_id, rans_mode, 1, 0, 19, ierr ) 934 954 ! 935 955 !-- Send coarse grid information to child … … 990 1010 ENDIF 991 1011 ENDDO 1012 992 1013 CALL pmc_s_setind_and_allocmem( child_id ) 993 1014 ENDDO … … 1195 1216 CALL pmc_set_dataarray_name( 'coarse', 'v' ,'fine', 'v', ierr ) 1196 1217 CALL pmc_set_dataarray_name( 'coarse', 'w' ,'fine', 'w', ierr ) 1218 ! 1219 !-- Set data array name for TKE. Please note, nesting of TKE is actually 1220 !-- only done if both parent and child are in LES or in RANS mode. Due to 1221 !-- design of model coupler, however, data array names must be already 1222 !-- available at this point. 1197 1223 CALL pmc_set_dataarray_name( 'coarse', 'e' ,'fine', 'e', ierr ) 1224 ! 1225 !-- Nesting of dissipation rate only if both parent and child are in RANS 1226 !-- mode and TKE-epsilo closure is applied. Please so also comment for TKE 1227 !-- above. 1228 CALL pmc_set_dataarray_name( 'coarse', 'diss' ,'fine', 'diss', ierr ) 1198 1229 1199 1230 IF ( .NOT. neutral ) THEN … … 1260 1291 CALL pmc_send_to_parent( coord_x, nx + 1 + 2 * nbgp, 0, 11, ierr ) 1261 1292 CALL pmc_send_to_parent( coord_y, ny + 1 + 2 * nbgp, 0, 12, ierr ) 1293 1294 CALL pmc_recv_from_parent( rans_mode_parent, 1, 0, 19, ierr ) 1295 ! 1262 1296 ! 1263 1297 !-- Receive Coarse grid information. … … 1319 1353 CALL MPI_BCAST( cg%zu, cg%nz+2, MPI_REAL, 0, comm2d, ierr ) 1320 1354 CALL MPI_BCAST( cg%zw, cg%nz+2, MPI_REAL, 0, comm2d, ierr ) 1321 1355 CALL MPI_BCAST( rans_mode_parent, 1, MPI_LOGICAL, 0, comm2d, ierr ) 1356 1322 1357 ! 1323 1358 !-- Find the index bounds for the nest domain in the coarse-grid index space … … 1357 1392 ENDIF 1358 1393 ! 1359 !-- Define the SGS-TKE scaling factor based on the grid-spacing ratio 1360 IF ( .NOT. constant_diffusion ) THEN 1361 CALL pmci_init_tkefactor 1362 ENDIF 1394 !-- Define the SGS-TKE scaling factor based on the grid-spacing ratio. Only 1395 !-- if both parent and child are in LES mode or in RANS mode. 1396 !-- Please note, in case parent and child are in RANS mode, TKE weighting 1397 !-- factor is simply one. 1398 IF ( ( rans_mode_parent .AND. rans_mode ) .OR. & 1399 ( .NOT. rans_mode_parent .AND. .NOT. rans_mode .AND. & 1400 .NOT. constant_diffusion ) ) CALL pmci_init_tkefactor 1363 1401 ! 1364 1402 !-- Two-way coupling for general and vertical nesting. … … 2995 3033 !-- energy spectrum. Near the surface, the reduction of TKE is made 2996 3034 !-- smaller than further away from the surface. 3035 !-- Please note, in case parent and child model operate in RANS mode, 3036 !-- TKE is not grid depenedent and weighting factor is one. 2997 3037 2998 3038 IMPLICIT NONE … … 3012 3052 REAL(wp), PARAMETER :: p23 = 2.0_wp/3.0_wp !< 3013 3053 3014 IF ( nest_bound_l ) THEN 3015 ALLOCATE( tkefactor_l(nzb:nzt+1,nysg:nyng) ) 3016 tkefactor_l = 0.0_wp 3017 i = nxl - 1 3018 DO j = nysg, nyng 3019 k_wall = get_topography_top_index_ji( j, i, 's' ) 3020 3021 DO k = k_wall + 1, nzt 3022 3023 kc = kco(k) + 1 3024 glsf = ( dx * dy * dzu(k) )**p13 3025 glsc = ( cg%dx * cg%dy *cg%dzu(kc) )**p13 3026 height = zu(k) - zu(k_wall) 3027 fw = EXP( -cfw * height / glsf ) 3028 tkefactor_l(k,j) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) * & 3029 ( glsf / glsc )**p23 ) 3054 ! 3055 IF ( .NOT. rans_mode .AND. .NOT. rans_mode_parent ) THEN 3056 IF ( nest_bound_l ) THEN 3057 ALLOCATE( tkefactor_l(nzb:nzt+1,nysg:nyng) ) 3058 tkefactor_l = 0.0_wp 3059 i = nxl - 1 3060 DO j = nysg, nyng 3061 k_wall = get_topography_top_index_ji( j, i, 's' ) 3062 3063 DO k = k_wall + 1, nzt 3064 kc = kco(k) + 1 3065 glsf = ( dx * dy * dzu(k) )**p13 3066 glsc = ( cg%dx * cg%dy *cg%dzu(kc) )**p13 3067 height = zu(k) - zu(k_wall) 3068 fw = EXP( -cfw * height / glsf ) 3069 tkefactor_l(k,j) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) * & 3070 ( glsf / glsc )**p23 ) 3071 ENDDO 3072 tkefactor_l(k_wall,j) = c_tkef * fw0 3030 3073 ENDDO 3031 tkefactor_l(k_wall,j) = c_tkef * fw0 3032 ENDDO 3033 ENDIF 3034 3035 IF ( nest_bound_r ) THEN 3036 ALLOCATE( tkefactor_r(nzb:nzt+1,nysg:nyng) ) 3037 tkefactor_r = 0.0_wp 3038 i = nxr + 1 3039 DO j = nysg, nyng 3040 k_wall = get_topography_top_index_ji( j, i, 's' ) 3041 3042 DO k = k_wall + 1, nzt 3074 ENDIF 3075 3076 IF ( nest_bound_r ) THEN 3077 ALLOCATE( tkefactor_r(nzb:nzt+1,nysg:nyng) ) 3078 tkefactor_r = 0.0_wp 3079 i = nxr + 1 3080 DO j = nysg, nyng 3081 k_wall = get_topography_top_index_ji( j, i, 's' ) 3082 3083 DO k = k_wall + 1, nzt 3084 kc = kco(k) + 1 3085 glsf = ( dx * dy * dzu(k) )**p13 3086 glsc = ( cg%dx * cg%dy * cg%dzu(kc) )**p13 3087 height = zu(k) - zu(k_wall) 3088 fw = EXP( -cfw * height / glsf ) 3089 tkefactor_r(k,j) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) * & 3090 ( glsf / glsc )**p23 ) 3091 ENDDO 3092 tkefactor_r(k_wall,j) = c_tkef * fw0 3093 ENDDO 3094 ENDIF 3095 3096 IF ( nest_bound_s ) THEN 3097 ALLOCATE( tkefactor_s(nzb:nzt+1,nxlg:nxrg) ) 3098 tkefactor_s = 0.0_wp 3099 j = nys - 1 3100 DO i = nxlg, nxrg 3101 k_wall = get_topography_top_index_ji( j, i, 's' ) 3102 3103 DO k = k_wall + 1, nzt 3104 3105 kc = kco(k) + 1 3106 glsf = ( dx * dy * dzu(k) )**p13 3107 glsc = ( cg%dx * cg%dy * cg%dzu(kc) ) ** p13 3108 height = zu(k) - zu(k_wall) 3109 fw = EXP( -cfw*height / glsf ) 3110 tkefactor_s(k,i) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) * & 3111 ( glsf / glsc )**p23 ) 3112 ENDDO 3113 tkefactor_s(k_wall,i) = c_tkef * fw0 3114 ENDDO 3115 ENDIF 3116 3117 IF ( nest_bound_n ) THEN 3118 ALLOCATE( tkefactor_n(nzb:nzt+1,nxlg:nxrg) ) 3119 tkefactor_n = 0.0_wp 3120 j = nyn + 1 3121 DO i = nxlg, nxrg 3122 k_wall = get_topography_top_index_ji( j, i, 's' ) 3123 3124 DO k = k_wall + 1, nzt 3125 3126 kc = kco(k) + 1 3127 glsf = ( dx * dy * dzu(k) )**p13 3128 glsc = ( cg%dx * cg%dy * cg%dzu(kc) )**p13 3129 height = zu(k) - zu(k_wall) 3130 fw = EXP( -cfw * height / glsf ) 3131 tkefactor_n(k,i) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) * & 3132 ( glsf / glsc )**p23 ) 3133 ENDDO 3134 tkefactor_n(k_wall,i) = c_tkef * fw0 3135 ENDDO 3136 ENDIF 3137 3138 ALLOCATE( tkefactor_t(nysg:nyng,nxlg:nxrg) ) 3139 k = nzt 3140 3141 DO i = nxlg, nxrg 3142 DO j = nysg, nyng 3143 ! 3144 !-- Determine vertical index for local topography top 3145 k_wall = get_topography_top_index_ji( j, i, 's' ) 3043 3146 3044 3147 kc = kco(k) + 1 … … 3047 3150 height = zu(k) - zu(k_wall) 3048 3151 fw = EXP( -cfw * height / glsf ) 3049 tkefactor_ r(k,j) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) *&3152 tkefactor_t(j,i) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) * & 3050 3153 ( glsf / glsc )**p23 ) 3051 3154 ENDDO 3052 tkefactor_r(k_wall,j) = c_tkef * fw03053 3155 ENDDO 3054 ENDIF 3055 3056 IF ( nest_bound_s ) THEN 3057 ALLOCATE( tkefactor_s(nzb:nzt+1,nxlg:nxrg) ) 3058 tkefactor_s = 0.0_wp 3059 j = nys - 1 3060 DO i = nxlg, nxrg 3061 k_wall = get_topography_top_index_ji( j, i, 's' ) 3062 3063 DO k = k_wall + 1, nzt 3064 3065 kc = kco(k) + 1 3066 glsf = ( dx * dy * dzu(k) )**p13 3067 glsc = ( cg%dx * cg%dy * cg%dzu(kc) ) ** p13 3068 height = zu(k) - zu(k_wall) 3069 fw = EXP( -cfw*height / glsf ) 3070 tkefactor_s(k,i) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) * & 3071 ( glsf / glsc )**p23 ) 3072 ENDDO 3073 tkefactor_s(k_wall,i) = c_tkef * fw0 3074 ENDDO 3075 ENDIF 3076 3077 IF ( nest_bound_n ) THEN 3078 ALLOCATE( tkefactor_n(nzb:nzt+1,nxlg:nxrg) ) 3079 tkefactor_n = 0.0_wp 3080 j = nyn + 1 3081 DO i = nxlg, nxrg 3082 k_wall = get_topography_top_index_ji( j, i, 's' ) 3083 3084 DO k = k_wall + 1, nzt 3085 3086 kc = kco(k) + 1 3087 glsf = ( dx * dy * dzu(k) )**p13 3088 glsc = ( cg%dx * cg%dy * cg%dzu(kc) )**p13 3089 height = zu(k) - zu(k_wall) 3090 fw = EXP( -cfw * height / glsf ) 3091 tkefactor_n(k,i) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) * & 3092 ( glsf / glsc )**p23 ) 3093 ENDDO 3094 tkefactor_n(k_wall,i) = c_tkef * fw0 3095 ENDDO 3096 ENDIF 3097 3098 ALLOCATE( tkefactor_t(nysg:nyng,nxlg:nxrg) ) 3099 k = nzt 3100 3101 DO i = nxlg, nxrg 3102 DO j = nysg, nyng 3103 ! 3104 !-- Determine vertical index for local topography top 3105 k_wall = get_topography_top_index_ji( j, i, 's' ) 3106 3107 kc = kco(k) + 1 3108 glsf = ( dx * dy * dzu(k) )**p13 3109 glsc = ( cg%dx * cg%dy * cg%dzu(kc) )**p13 3110 height = zu(k) - zu(k_wall) 3111 fw = EXP( -cfw * height / glsf ) 3112 tkefactor_t(j,i) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) * & 3113 ( glsf / glsc )**p23 ) 3114 ENDDO 3115 ENDDO 3156 ! 3157 !-- RANS mode 3158 ELSE 3159 IF ( nest_bound_l ) THEN 3160 ALLOCATE( tkefactor_l(nzb:nzt+1,nysg:nyng) ) 3161 tkefactor_l = 1.0_wp 3162 ENDIF 3163 IF ( nest_bound_r ) THEN 3164 ALLOCATE( tkefactor_r(nzb:nzt+1,nysg:nyng) ) 3165 tkefactor_r = 1.0_wp 3166 ENDIF 3167 IF ( nest_bound_s ) THEN 3168 ALLOCATE( tkefactor_s(nzb:nzt+1,nxlg:nxrg) ) 3169 tkefactor_s = 1.0_wp 3170 ENDIF 3171 IF ( nest_bound_n ) THEN 3172 ALLOCATE( tkefactor_n(nzb:nzt+1,nxlg:nxrg) ) 3173 tkefactor_n = 1.0_wp 3174 ENDIF 3175 3176 ALLOCATE( tkefactor_t(nysg:nyng,nxlg:nxrg) ) 3177 tkefactor_t = 1.0_wp 3178 3179 ENDIF 3116 3180 3117 3181 END SUBROUTINE pmci_init_tkefactor … … 3177 3241 !-- List of array names, which can be coupled. 3178 3242 !-- In case of 3D please change also the second array for the pointer version 3179 IF ( TRIM(name) == "u" ) p_3d => u 3180 IF ( TRIM(name) == "v" ) p_3d => v 3181 IF ( TRIM(name) == "w" ) p_3d => w 3182 IF ( TRIM(name) == "e" ) p_3d => e 3183 IF ( TRIM(name) == "pt" ) p_3d => pt 3184 IF ( TRIM(name) == "q" ) p_3d => q 3185 IF ( TRIM(name) == "qc" ) p_3d => qc 3186 IF ( TRIM(name) == "qr" ) p_3d => qr 3187 IF ( TRIM(name) == "nr" ) p_3d => nr 3188 IF ( TRIM(name) == "nc" ) p_3d => nc 3189 IF ( TRIM(name) == "s" ) p_3d => s 3190 IF ( TRIM(name) == "nr_part" ) i_2d => nr_part 3191 IF ( TRIM(name) == "part_adr" ) i_2d => part_adr 3243 IF ( TRIM(name) == "u" ) p_3d => u 3244 IF ( TRIM(name) == "v" ) p_3d => v 3245 IF ( TRIM(name) == "w" ) p_3d => w 3246 IF ( TRIM(name) == "e" ) p_3d => e 3247 IF ( TRIM(name) == "pt" ) p_3d => pt 3248 IF ( TRIM(name) == "q" ) p_3d => q 3249 IF ( TRIM(name) == "qc" ) p_3d => qc 3250 IF ( TRIM(name) == "qr" ) p_3d => qr 3251 IF ( TRIM(name) == "nr" ) p_3d => nr 3252 IF ( TRIM(name) == "nc" ) p_3d => nc 3253 IF ( TRIM(name) == "s" ) p_3d => s 3254 IF ( TRIM(name) == "diss" ) p_3d => diss 3255 IF ( TRIM(name) == "nr_part" ) i_2d => nr_part 3256 IF ( TRIM(name) == "part_adr" ) i_2d => part_adr 3192 3257 IF ( INDEX( TRIM(name), "chem_" ) /= 0 ) p_3d => chem_species(n)%conc 3193 3258 … … 3219 3284 ENDIF 3220 3285 #else 3221 IF ( TRIM(name) == "u" ) p_3d_sec => u_2 3222 IF ( TRIM(name) == "v" ) p_3d_sec => v_2 3223 IF ( TRIM(name) == "w" ) p_3d_sec => w_2 3224 IF ( TRIM(name) == "e" ) p_3d_sec => e_2 3225 IF ( TRIM(name) == "pt" ) p_3d_sec => pt_2 3226 IF ( TRIM(name) == "q" ) p_3d_sec => q_2 3227 IF ( TRIM(name) == "qc" ) p_3d_sec => qc_2 3228 IF ( TRIM(name) == "qr" ) p_3d_sec => qr_2 3229 IF ( TRIM(name) == "nr" ) p_3d_sec => nr_2 3230 IF ( TRIM(name) == "nc" ) p_3d_sec => nc_2 3231 IF ( TRIM(name) == "s" ) p_3d_sec => s_2 3286 IF ( TRIM(name) == "u" ) p_3d_sec => u_2 3287 IF ( TRIM(name) == "v" ) p_3d_sec => v_2 3288 IF ( TRIM(name) == "w" ) p_3d_sec => w_2 3289 IF ( TRIM(name) == "e" ) p_3d_sec => e_2 3290 IF ( TRIM(name) == "pt" ) p_3d_sec => pt_2 3291 IF ( TRIM(name) == "q" ) p_3d_sec => q_2 3292 IF ( TRIM(name) == "qc" ) p_3d_sec => qc_2 3293 IF ( TRIM(name) == "qr" ) p_3d_sec => qr_2 3294 IF ( TRIM(name) == "nr" ) p_3d_sec => nr_2 3295 IF ( TRIM(name) == "nc" ) p_3d_sec => nc_2 3296 IF ( TRIM(name) == "s" ) p_3d_sec => s_2 3297 IF ( TRIM(name) == "diss" ) p_3d_sec => diss_2 3232 3298 IF ( INDEX( TRIM(name), "chem_" ) /= 0 ) p_3d_sec => spec_conc_2(:,:,:,n) 3233 3299 … … 3358 3424 IF ( .NOT. ALLOCATED( ec ) ) ALLOCATE( ec(0:nzc+1,js:je,is:ie) ) 3359 3425 p_3d => ec 3426 ELSEIF ( TRIM( name ) == "diss" ) THEN 3427 IF ( .NOT. ALLOCATED( dissc ) ) ALLOCATE( dissc(0:nzc+1,js:je,is:ie) ) 3428 p_3d => dissc 3360 3429 ELSEIF ( TRIM( name ) == "pt") THEN 3361 3430 IF ( .NOT. ALLOCATED( ptc ) ) ALLOCATE( ptc(0:nzc+1,js:je,is:ie) ) … … 3379 3448 IF ( .NOT. ALLOCATED( sc ) ) ALLOCATE( sc(0:nzc+1,js:je,is:ie) ) 3380 3449 p_3d => sc 3381 ELSEIF ( trim(name) == "nr_part") then3382 IF ( .not.allocated(nr_partc)) allocate(nr_partc(js:je, is:ie))3450 ELSEIF ( TRIM( name ) == "nr_part") THEN 3451 IF ( .NOT. ALLOCATED( nr_partc ) ) ALLOCATE( nr_partc(js:je,is:ie) ) 3383 3452 i_2d => nr_partc 3384 ELSEIF ( trim(name) == "part_adr") then3385 IF ( .not.allocated(part_adrc)) allocate(part_adrc(js:je, is:ie))3453 ELSEIF ( TRIM( name ) == "part_adr") THEN 3454 IF ( .NOT. ALLOCATED( part_adrc ) ) ALLOCATE( part_adrc(js:je,is:ie) ) 3386 3455 i_2d => part_adrc 3387 3456 ELSEIF ( TRIM( name(1:5) ) == "chem_" ) THEN … … 3484 3553 r2yo, r1zw, r2zw, 'w' ) 3485 3554 3486 IF ( .NOT. constant_diffusion ) THEN 3487 CALL pmci_interp_tril_all ( e, ec, ico, jco, kco, r1xo, r2xo, & 3488 r1yo, r2yo, r1zo, r2zo, 'e' ) 3489 ENDIF 3490 3555 IF ( ( rans_mode_parent .AND. rans_mode ) .OR. & 3556 ( .NOT. rans_mode_parent .AND. .NOT. rans_mode .AND. & 3557 .NOT. constant_diffusion ) ) THEN 3558 CALL pmci_interp_tril_all ( e, ec, ico, jco, kco, r1xo, r2xo, r1yo, & 3559 r2yo, r1zo, r2zo, 'e' ) 3560 ENDIF 3561 3562 IF ( rans_mode_parent .AND. rans_mode .AND. rans_tke_e ) THEN 3563 CALL pmci_interp_tril_all ( diss, dissc, ico, jco, kco, r1xo, r2xo,& 3564 r1yo, r2yo, r1zo, r2zo, 's' ) 3565 ENDIF 3566 3491 3567 IF ( .NOT. neutral ) THEN 3492 3568 CALL pmci_interp_tril_all ( pt, ptc, ico, jco, kco, r1xo, r2xo, & … … 4207 4283 nzt_topo_nestbc_l, 'l', 'w' ) 4208 4284 4209 IF ( .NOT. constant_diffusion ) THEN 4285 IF ( ( rans_mode_parent .AND. rans_mode ) .OR. & 4286 ( .NOT. rans_mode_parent .AND. .NOT. rans_mode .AND. & 4287 .NOT. constant_diffusion ) ) THEN 4210 4288 CALL pmci_interp_tril_lr( e, ec, ico, jco, kco, r1xo, r2xo, & 4211 4289 r1yo, r2yo, r1zo, r2zo, & … … 4214 4292 nzt_topo_nestbc_l, 'l', 'e' ) 4215 4293 ENDIF 4216 4294 4295 IF ( rans_mode_parent .AND. rans_mode .AND. rans_tke_e ) THEN 4296 CALL pmci_interp_tril_lr( diss, dissc, ico, jco, kco, r1xo, & 4297 r2xo, r1yo, r2yo, r1zo, r2zo, & 4298 logc_w_l, logc_ratio_w_l, & 4299 logc_kbounds_w_l, & 4300 nzt_topo_nestbc_l, 'l', 's' ) 4301 ENDIF 4302 4217 4303 IF ( .NOT. neutral ) THEN 4218 4304 CALL pmci_interp_tril_lr( pt, ptc, ico, jco, kco, r1xo, r2xo, & … … 4304 4390 nzt_topo_nestbc_r, 'r', 'w' ) 4305 4391 4306 IF ( .NOT. constant_diffusion ) THEN 4392 IF ( ( rans_mode_parent .AND. rans_mode ) .OR. & 4393 ( .NOT. rans_mode_parent .AND. .NOT. rans_mode .AND. & 4394 .NOT. constant_diffusion ) ) THEN 4307 4395 CALL pmci_interp_tril_lr( e, ec, ico, jco, kco, r1xo, r2xo, & 4308 4396 r1yo,r2yo, r1zo, r2zo, & … … 4310 4398 logc_kbounds_w_r, & 4311 4399 nzt_topo_nestbc_r, 'r', 'e' ) 4400 4401 ENDIF 4402 4403 IF ( rans_mode_parent .AND. rans_mode .AND. rans_tke_e ) THEN 4404 CALL pmci_interp_tril_lr( diss, dissc, ico, jco, kco, r1xo, & 4405 r2xo, r1yo,r2yo, r1zo, r2zo, & 4406 logc_w_r, logc_ratio_w_r, & 4407 logc_kbounds_w_r, & 4408 nzt_topo_nestbc_r, 'r', 's' ) 4409 4312 4410 ENDIF 4313 4411 … … 4382 4480 ENDDO 4383 4481 ENDIF 4384 4385 4482 ENDIF 4386 4483 ! … … 4406 4503 nzt_topo_nestbc_s, 's','w' ) 4407 4504 4408 IF ( .NOT. constant_diffusion ) THEN 4505 IF ( ( rans_mode_parent .AND. rans_mode ) .OR. & 4506 ( .NOT. rans_mode_parent .AND. .NOT. rans_mode .AND. & 4507 .NOT. constant_diffusion ) ) THEN 4409 4508 CALL pmci_interp_tril_sn( e, ec, ico, jco, kco, r1xo, r2xo, & 4410 4509 r1yo, r2yo, r1zo, r2zo, & … … 4412 4511 logc_kbounds_w_s, & 4413 4512 nzt_topo_nestbc_s, 's', 'e' ) 4513 4414 4514 ENDIF 4415 4515 4516 IF ( rans_mode_parent .AND. rans_mode .AND. rans_tke_e ) THEN 4517 CALL pmci_interp_tril_sn( diss, dissc, ico, jco, kco, r1xo, & 4518 r2xo, r1yo, r2yo, r1zo, r2zo, & 4519 logc_w_s, logc_ratio_w_s, & 4520 logc_kbounds_w_s, & 4521 nzt_topo_nestbc_s, 's', 's' ) 4522 4523 ENDIF 4524 4416 4525 IF ( .NOT. neutral ) THEN 4417 4526 CALL pmci_interp_tril_sn( pt, ptc, ico, jco, kco, r1xo, r2xo, & … … 4482 4591 ENDDO 4483 4592 ENDIF 4484 4485 4593 ENDIF 4486 4594 ! … … 4505 4613 logc_kbounds_w_n, & 4506 4614 nzt_topo_nestbc_n, 'n', 'w' ) 4507 IF ( .NOT. constant_diffusion ) THEN 4615 4616 IF ( ( rans_mode_parent .AND. rans_mode ) .OR. & 4617 ( .NOT. rans_mode_parent .AND. .NOT. rans_mode .AND. & 4618 .NOT. constant_diffusion ) ) THEN 4508 4619 CALL pmci_interp_tril_sn( e, ec, ico, jco, kco, r1xo, r2xo, & 4509 4620 r1yo, r2yo, r1zo, r2zo, & … … 4511 4622 logc_kbounds_w_n, & 4512 4623 nzt_topo_nestbc_n, 'n', 'e' ) 4624 4513 4625 ENDIF 4514 4626 4627 IF ( rans_mode_parent .AND. rans_mode .AND. rans_tke_e ) THEN 4628 CALL pmci_interp_tril_sn( diss, dissc, ico, jco, kco, r1xo, & 4629 r2xo, r1yo, r2yo, r1zo, r2zo, & 4630 logc_w_n, logc_ratio_w_n, & 4631 logc_kbounds_w_n, & 4632 nzt_topo_nestbc_n, 'n', 's' ) 4633 4634 ENDIF 4635 4515 4636 IF ( .NOT. neutral ) THEN 4516 4637 CALL pmci_interp_tril_sn( pt, ptc, ico, jco, kco, r1xo, r2xo, & … … 4581 4702 ENDDO 4582 4703 ENDIF 4583 4584 4704 ENDIF 4585 4705 … … 4593 4713 CALL pmci_interp_tril_t( w, wc, ico, jco, kcw, r1xo, r2xo, r1yo, & 4594 4714 r2yo, r1zw, r2zw, 'w' ) 4595 IF ( .NOT. constant_diffusion ) THEN 4715 4716 IF ( ( rans_mode_parent .AND. rans_mode ) .OR. & 4717 ( .NOT. rans_mode_parent .AND. .NOT. rans_mode .AND. & 4718 .NOT. constant_diffusion ) ) THEN 4596 4719 CALL pmci_interp_tril_t( e, ec, ico, jco, kco, r1xo, r2xo, r1yo, & 4597 4720 r2yo, r1zo, r2zo, 'e' ) 4598 4721 ENDIF 4722 4723 IF ( rans_mode_parent .AND. rans_mode .AND. rans_tke_e ) THEN 4724 CALL pmci_interp_tril_t( diss, dissc, ico, jco, kco, r1xo, r2xo, & 4725 r1yo, r2yo, r1zo, r2zo, 's' ) 4726 ENDIF 4727 4599 4728 IF ( .NOT. neutral ) THEN 4600 4729 CALL pmci_interp_tril_t( pt, ptc, ico, jco, kco, r1xo, r2xo, r1yo, & … … 4644 4773 ENDDO 4645 4774 ENDIF 4646 4775 4647 4776 END SUBROUTINE pmci_interpolation 4648 4777 … … 4666 4795 CALL pmci_anterp_tophat( w, wc, kctw, iflo, ifuo, jflo, jfuo, kflw, & 4667 4796 kfuw, ijfc_s, kfc_w, 'w' ) 4797 ! 4798 !-- Anterpolation of TKE and dissipation rate if parent and child are in 4799 !-- RANS mode. 4800 IF ( rans_mode_parent .AND. rans_mode ) THEN 4801 CALL pmci_anterp_tophat( e, ec, kctu, iflo, ifuo, jflo, jfuo, kflo, & 4802 kfuo, ijfc_s, kfc_s, 'e' ) 4803 ! 4804 !-- Anterpolation of dissipation rate only if TKE-e closure is applied. 4805 IF ( rans_tke_e ) THEN 4806 CALL pmci_anterp_tophat( diss, dissc, kctu, iflo, ifuo, jflo, jfuo,& 4807 kflo, kfuo, ijfc_s, kfc_s, 'diss' ) 4808 ENDIF 4809 4810 ENDIF 4668 4811 4669 4812 IF ( .NOT. neutral ) THEN … … 5569 5712 END SUBROUTINE pmci_boundary_conds 5570 5713 5714 5571 5715 END MODULE pmc_interface
Note: See TracChangeset
for help on using the changeset viewer.
