Changeset 4665 for palm/trunk/SOURCE
- Timestamp:
- Sep 3, 2020 2:04:24 PM (4 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 2 edited
-
cpulog_mod.f90 (modified) (2 diffs)
-
pmc_interface_mod.f90 (modified) (68 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/cpulog_mod.f90
r4577 r4665 19 19 ! Current revisions: 20 20 ! ----------------- 21 ! 22 ! 21 ! 22 ! 23 23 ! Former revisions: 24 24 ! ----------------- 25 25 ! $Id$ 26 ! Format descriptor 102 slightly modified. 27 ! 28 ! 4577 2020-06-25 09:53:58Z raasch 26 29 ! further re-formatting concerning Fortran parameter variables 27 30 ! … … 550 553 &'---------------------') 551 554 552 102 FORMAT (A25,2X,F 9.3,2X,F7.2,1X,I7,2(1X,F9.3),1X,F6.2)555 102 FORMAT (A25,2X,F10.3,2X,F7.2,1X,I7,2(1X,F10.3),1X,F6.2) 553 556 103 FORMAT (/'Barriers are set in front of collective operations') 554 557 104 FORMAT (/'No barriers are set in front of collective operations') -
palm/trunk/SOURCE/pmc_interface_mod.f90
r4649 r4665 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Interpolation and anterpolation subroutines renamed and all missing subroutine description 28 ! comments added. 29 ! 30 ! 4649 2020-08-25 12:11:17Z raasch 27 31 ! File re-formatted to follow the PALM coding standard 28 32 ! … … 677 681 ! Description: 678 682 ! ------------ 679 !> @Todo: Missing subroutine description. 683 !> Find out if this is a nested run and if so, read and broadcast the nesting parameters and set 684 !> the communicators accordingly. 680 685 !--------------------------------------------------------------------------------------------------! 681 686 SUBROUTINE pmci_init( world_comm ) … … 764 769 ! Description: 765 770 ! ------------ 766 !> @Todo: Missing subroutine description.771 !> Define the nesting setup. 767 772 !--------------------------------------------------------------------------------------------------! 768 773 SUBROUTINE pmci_modelconfiguration … … 810 815 ! Description: 811 816 ! ------------ 812 !> @Todo: Missing subroutine description.817 !> Prepare the coupling environment for the current parent domain. 813 818 !--------------------------------------------------------------------------------------------------! 814 819 SUBROUTINE pmci_setup_parent … … 1134 1139 ! Description: 1135 1140 ! ------------ 1136 !> @Todo: Missing subroutine description.1141 !> Create the index list 1137 1142 !--------------------------------------------------------------------------------------------------! 1138 1143 SUBROUTINE pmci_create_index_list … … 1241 1246 ! Description: 1242 1247 ! ------------ 1243 !> @Todo: Missing subroutine description.1248 !> Store the child-edge coordinates. 1244 1249 !--------------------------------------------------------------------------------------------------! 1245 1250 SUBROUTINE pmci_set_child_edge_coords … … 1278 1283 ! Description: 1279 1284 ! ------------ 1280 !> @Todo: Missing subroutine description.1285 !> Prepare the coupling environment for the current child domain. 1281 1286 !--------------------------------------------------------------------------------------------------! 1282 1287 SUBROUTINE pmci_setup_child … … 1510 1515 ! Description: 1511 1516 ! ------------ 1512 !> @Todo: Missing subroutine description.1517 !> Determine index bounds of interpolation/anterpolation area in the parent-grid index space. 1513 1518 !--------------------------------------------------------------------------------------------------! 1514 1519 SUBROUTINE pmci_map_child_grid_to_parent_grid 1515 1520 1516 !1517 !-- Determine index bounds of interpolation/anterpolation area in the parent-grid index space1518 1521 IMPLICIT NONE 1519 1522 … … 1710 1713 ! Description: 1711 1714 ! ------------ 1712 !> @Todo: Missing subroutine description.1715 !> Precomputation of the mapping between the child- and parent-grid indices. 1713 1716 !--------------------------------------------------------------------------------------------------! 1714 1717 SUBROUTINE pmci_define_index_mapping 1715 !1716 !-- Precomputation of the mapping of the child- and parent-grid indices.1717 1718 1718 1719 IMPLICIT NONE … … 2028 2029 ! Description: 2029 2030 ! ------------ 2030 !> @Todo: Missing subroutine description. 2031 !> Check if the child domain is too small in terms of number of parent-grid cells covered so that 2032 !> anterpolation buffers fill the whole domain so that anterpolation not possible. Also, check that 2033 !> anterpolation_buffer_width is not too large to prevent anterpolation. 2031 2034 !--------------------------------------------------------------------------------------------------! 2032 2035 SUBROUTINE pmci_check_child_domain_size 2033 ! 2034 !-- Check if the child domain is too small in terms of number of parent-grid cells covered so that 2035 !-- anterpolation buffers fill the whole domain so that anterpolation not possible. Also, check that 2036 !-- anterpolation_buffer_width is not too large to prevent anterpolation. 2036 2037 2037 IMPLICIT NONE 2038 2038 … … 2113 2113 ! Description: 2114 2114 ! ------------ 2115 !> @Todo: Missing subroutine description.2115 !> Allocate parent-grid work-arrays for interpolation. 2116 2116 !--------------------------------------------------------------------------------------------------! 2117 2117 SUBROUTINE pmci_allocate_workarrays 2118 ! 2119 !-- Allocate parent-grid work-arrays for interpolation 2118 2120 2119 IMPLICIT NONE 2121 2120 … … 2161 2160 ! Description: 2162 2161 ! ------------ 2163 !> @Todo: Missing subroutine description. 2162 !> Define and create specific MPI-datatypes for the interpolation work-array exchange. 2163 !> Exhcanges are needed to make these arrays contiguous over the horizontal direction on the 2164 !> plane of the boundary. 2164 2165 !--------------------------------------------------------------------------------------------------! 2165 2166 SUBROUTINE pmci_create_workarray_exchange_datatypes 2166 ! 2167 !-- Define specific MPI types for workarr-exchange. 2167 2168 2168 IMPLICIT NONE 2169 2169 … … 2194 2194 ! Description: 2195 2195 ! ------------ 2196 !> @Todo: Missing subroutine description. 2196 !> Check that the grid lines of child and parent do match. Also check that the child subdomain 2197 !> width is not smaller than the parent grid spacing in the respective direction. 2197 2198 !--------------------------------------------------------------------------------------------------! 2198 2199 SUBROUTINE pmci_check_grid_matching 2199 ! 2200 !-- Check that the grid lines of child and parent do match. 2201 !-- Also check that the child subdomain width is not smaller than the parent grid spacing in the 2202 !-- respective direction. 2200 2203 2201 IMPLICIT NONE 2204 2202 … … 2327 2325 ! Description: 2328 2326 ! ------------ 2329 !> @Todo: Missing subroutine description.2327 !> Compute the areas of the domain boundary faces: left, right, south, north and top. 2330 2328 !--------------------------------------------------------------------------------------------------! 2331 2329 SUBROUTINE pmci_compute_face_areas … … 2452 2450 ! Description: 2453 2451 ! ------------ 2454 !> @Todo: Missing subroutine description. 2452 !> Translate the coordinates of the current domain into the root coordinate system and store them 2453 !> (z remains the same). 2455 2454 !--------------------------------------------------------------------------------------------------! 2456 2455 SUBROUTINE pmci_setup_coordinates … … 2536 2535 ! Description: 2537 2536 ! ------------ 2538 !> @Todo: Missing subroutine description.2537 !> Assigns the pointer to the array to be coupled. 2539 2538 !--------------------------------------------------------------------------------------------------! 2540 2539 SUBROUTINE pmci_set_array_pointer( name, child_id, nz_child, n ) … … 2672 2671 ! Description: 2673 2672 ! ------------ 2674 !> @Todo: Missing subroutine description.2673 !> Provides the child grid edge coordinates for pmc_particle_interface. 2675 2674 !--------------------------------------------------------------------------------------------------! 2676 2675 SUBROUTINE get_child_edges( m, lx_coord, lx_coord_b, rx_coord, rx_coord_b, sy_coord, sy_coord_b, & … … 2711 2710 ! Description: 2712 2711 ! ------------ 2713 !> @Todo: Missing subroutine description.2712 !> Provides the child grid spacings for pmc_particle_interface. 2714 2713 !--------------------------------------------------------------------------------------------------! 2715 2714 SUBROUTINE get_child_gridspacing( m, dx, dy,dz ) … … 2740 2739 ! Description: 2741 2740 ! ------------ 2742 !> @Todo: Missing subroutine description.2741 !> Allocate child's parent-grid arrays for data transfer between parent and child. 2743 2742 !--------------------------------------------------------------------------------------------------! 2744 2743 SUBROUTINE pmci_create_childs_parent_grid_arrays( name, is, ie, js, je, nzc, n ) … … 2862 2861 ! Description: 2863 2862 ! ------------ 2864 !> @Todo: Missing subroutine description. 2863 !> Send data for the children in order to let them create initial conditions by interpolating the 2864 !> parent-domain fields. 2865 2865 !--------------------------------------------------------------------------------------------------! 2866 2866 SUBROUTINE pmci_parent_initialize 2867 2868 ! 2869 !-- Send data for the children in order to let them create initial conditions by interpolating the 2870 !-- parent-domain fields. 2867 2871 2868 #if defined( __parallel ) 2872 2869 IMPLICIT NONE … … 2890 2887 ! Description: 2891 2888 ! ------------ 2892 !> @Todo: Missing subroutine description.2889 !> Create initial conditions for the current child domain by interpolating the parent-domain fields. 2893 2890 !--------------------------------------------------------------------------------------------------! 2894 2891 SUBROUTINE pmci_child_initialize 2895 2892 2896 !2897 !-- Create initial conditions for the current child domain by interpolating the parent-domain fields.2898 2893 #if defined( __parallel ) 2899 2894 IMPLICIT NONE … … 2917 2912 ! 2918 2913 !-- The interpolation. 2919 CALL pmci_interp_ 1sto_all ( u, uc, kcto, iflu, ifuu, jflo, jfuo, kflo, kfuo, 'u' )2920 CALL pmci_interp_ 1sto_all ( v, vc, kcto, iflo, ifuo, jflv, jfuv, kflo, kfuo, 'v' )2921 CALL pmci_interp_ 1sto_all ( w, wc, kctw, iflo, ifuo, jflo, jfuo, kflw, kfuw, 'w' )2914 CALL pmci_interp_all ( u, uc, kcto, iflu, ifuu, jflo, jfuo, kflo, kfuo, 'u' ) 2915 CALL pmci_interp_all ( v, vc, kcto, iflo, ifuo, jflv, jfuv, kflo, kfuo, 'v' ) 2916 CALL pmci_interp_all ( w, wc, kctw, iflo, ifuo, jflo, jfuo, kflw, kfuw, 'w' ) 2922 2917 2923 2918 IF ( ( rans_mode_parent .AND. rans_mode ) .OR. & 2924 2919 ( .NOT. rans_mode_parent .AND. .NOT. rans_mode .AND. & 2925 2920 .NOT. constant_diffusion ) ) THEN 2926 CALL pmci_interp_ 1sto_all ( e, ec, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 'e' )2921 CALL pmci_interp_all ( e, ec, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 'e' ) 2927 2922 ENDIF 2928 2923 2929 2924 IF ( rans_mode_parent .AND. rans_mode .AND. rans_tke_e ) THEN 2930 CALL pmci_interp_ 1sto_all ( diss, dissc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' )2925 CALL pmci_interp_all ( diss, dissc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' ) 2931 2926 ENDIF 2932 2927 2933 2928 IF ( .NOT. neutral ) THEN 2934 CALL pmci_interp_ 1sto_all ( pt, ptc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' )2929 CALL pmci_interp_all ( pt, ptc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' ) 2935 2930 ENDIF 2936 2931 2937 2932 IF ( humidity ) THEN 2938 2933 2939 CALL pmci_interp_ 1sto_all ( q, q_c, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' )2934 CALL pmci_interp_all ( q, q_c, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' ) 2940 2935 2941 2936 IF ( bulk_cloud_model .AND. microphysics_morrison ) THEN 2942 CALL pmci_interp_ 1sto_all ( qc, qcc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' )2943 CALL pmci_interp_ 1sto_all ( nc, ncc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' )2937 CALL pmci_interp_all ( qc, qcc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' ) 2938 CALL pmci_interp_all ( nc, ncc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' ) 2944 2939 ENDIF 2945 2940 2946 2941 IF ( bulk_cloud_model .AND. microphysics_seifert ) THEN 2947 CALL pmci_interp_ 1sto_all ( qr, qrc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' )2948 CALL pmci_interp_ 1sto_all ( nr, nrc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' )2942 CALL pmci_interp_all ( qr, qrc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' ) 2943 CALL pmci_interp_all ( nr, nrc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' ) 2949 2944 ENDIF 2950 2945 … … 2952 2947 2953 2948 IF ( passive_scalar ) THEN 2954 CALL pmci_interp_ 1sto_all ( s, sc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' )2949 CALL pmci_interp_all ( s, sc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' ) 2955 2950 ENDIF 2956 2951 2957 2952 IF ( air_chemistry .AND. nesting_chem ) THEN 2958 2953 DO n = 1, nspec 2959 CALL pmci_interp_ 1sto_all ( chem_species(n)%conc, chem_spec_c(:,:,:,n), &2954 CALL pmci_interp_all ( chem_species(n)%conc, chem_spec_c(:,:,:,n), & 2960 2955 kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' ) 2961 2956 ENDDO … … 2964 2959 IF ( salsa .AND. nesting_salsa ) THEN 2965 2960 DO lb = 1, nbins_aerosol 2966 CALL pmci_interp_ 1sto_all ( aerosol_number(lb)%conc, aerosol_number_c(:,:,:,lb), &2961 CALL pmci_interp_all ( aerosol_number(lb)%conc, aerosol_number_c(:,:,:,lb), & 2967 2962 kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' ) 2968 2963 ENDDO 2969 2964 DO lc = 1, nbins_aerosol * ncomponents_mass 2970 CALL pmci_interp_ 1sto_all ( aerosol_mass(lc)%conc, aerosol_mass_c(:,:,:,lc), &2965 CALL pmci_interp_all ( aerosol_mass(lc)%conc, aerosol_mass_c(:,:,:,lc), & 2971 2966 kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' ) 2972 2967 ENDDO 2973 2968 IF ( .NOT. salsa_gases_from_chem ) THEN 2974 2969 DO lg = 1, ngases_salsa 2975 CALL pmci_interp_ 1sto_all ( salsa_gas(lg)%conc, salsa_gas_c(:,:,:,lg), &2970 CALL pmci_interp_all ( salsa_gas(lg)%conc, salsa_gas_c(:,:,:,lg), & 2976 2971 kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' ) 2977 2972 ENDDO … … 3010 3005 ! Description: 3011 3006 ! ------------ 3012 !> @Todo: Missing subroutine description. 3013 !--------------------------------------------------------------------------------------------------! 3014 SUBROUTINE pmci_interp_1sto_all( child_array, parent_array, kct, ifl, ifu, jfl, jfu, kfl, kfu, & 3015 var ) 3016 ! 3017 !-- Interpolation of the internal values for the child-domain initialization 3007 !> Interpolation of the internal values for the child-domain initialization. 3008 !--------------------------------------------------------------------------------------------------! 3009 SUBROUTINE pmci_interp_all( child_array, parent_array, kct, ifl, ifu, jfl, jfu, kfl, kfu, var ) 3010 3018 3011 IMPLICIT NONE 3019 3012 … … 3261 3254 ENDIF 3262 3255 3263 END SUBROUTINE pmci_interp_ 1sto_all3256 END SUBROUTINE pmci_interp_all 3264 3257 3265 3258 #endif … … 3270 3263 ! Description: 3271 3264 ! ------------ 3272 !> @Todo: Missing subroutine description. 3265 !> Check for mismatches between settings of root and child variables (e.g., all children have to 3266 !> follow the end_time settings of the root model). The root model overwrites variables in the 3267 !> other models, so these variables only need to be set once in file PARIN. 3273 3268 !--------------------------------------------------------------------------------------------------! 3274 3269 SUBROUTINE pmci_check_setting_mismatches 3275 !3276 !-- Check for mismatches between settings of root and child variables (e.g., all children have to3277 !-- follow the end_time settings of the root model). The root model overwrites variables in the3278 !-- other models, so these variables only need to be set once in file PARIN.3279 3270 3280 3271 #if defined( __parallel ) … … 3358 3349 ! Description: 3359 3350 ! ------------ 3360 !> @Todo: Missing subroutine description. 3351 !> Unify the time steps for each model and synchronize using MPI_ALLREDUCE with the MPI_MIN 3352 !> operator over all processes using the global communicator MPI_COMM_WORLD. 3361 3353 !--------------------------------------------------------------------------------------------------! 3362 3354 SUBROUTINE pmci_synchronize 3363 3355 3364 3356 #if defined( __parallel ) 3365 !3366 !-- Unify the time steps for each model and synchronize using MPI_ALLREDUCE with the MPI_MIN3367 !-- operator over all processes using the global communicator MPI_COMM_WORLD.3368 3357 3369 3358 IMPLICIT NONE … … 3390 3379 ! Description: 3391 3380 ! ------------ 3392 !> @Todo: Missing subroutine description.3381 !> After each Runge-Kutta sub-timestep, alternately set buffer one or buffer two active 3393 3382 !--------------------------------------------------------------------------------------------------! 3394 3383 SUBROUTINE pmci_set_swaplevel( swaplevel ) 3395 3396 !3397 !-- After each Runge-Kutta sub-timestep, alternately set buffer one or buffer two active3398 3384 3399 3385 IMPLICIT NONE … … 3416 3402 ! Description: 3417 3403 ! ------------ 3418 !> @Todo: Missing subroutine description. 3404 !> This subroutine controls the nesting according to the nestpar parameter nesting_mode (two-way 3405 !> (default) or one-way) and the order of anterpolations according to the nestpar parameter 3406 !> nesting_datatransfer_mode (cascade, overlap or mixed (default)). Although nesting_mode is a 3407 !> variable of this module, pass it as an argument to allow for example to force one-way 3408 !> initialization phase. Note that interpolation ( parent_to_child ) must always be carried out 3409 !> before anterpolation ( child_to_parent ). 3419 3410 !--------------------------------------------------------------------------------------------------! 3420 3411 SUBROUTINE pmci_datatrans( local_nesting_mode ) 3421 !3422 !-- This subroutine controls the nesting according to the nestpar parameter nesting_mode (two-way3423 !-- (default) or one-way) and the order of anterpolations according to the nestpar parameter3424 !-- nesting_datatransfer_mode (cascade, overlap or mixed (default)). Although nesting_mode is a3425 !-- variable of this model, pass it as an argument to allow for example to force one-way3426 !-- initialization phase. Note that interpolation ( parent_to_child ) must always be carried out3427 !-- before anterpolation ( child_to_parent ).3428 3412 3429 3413 IMPLICIT NONE … … 3480 3464 ! Description: 3481 3465 ! ------------ 3482 !> @Todo: Missing subroutine description.3466 !> Wrapper routine including the parent-side calls to all the data-transfer routines. 3483 3467 !--------------------------------------------------------------------------------------------------! 3484 3468 SUBROUTINE pmci_parent_datatrans( direction ) … … 3543 3527 ! Description: 3544 3528 ! ------------ 3545 !> @Todo: Missing subroutine description.3529 !> Wrapper routine including the child-side calls to all the data-transfer and processing routines. 3546 3530 !--------------------------------------------------------------------------------------------------! 3547 3531 SUBROUTINE pmci_child_datatrans( direction ) … … 3589 3573 ! Description: 3590 3574 ! ------------ 3591 !> @Todo: Missing subroutine description.3575 !> A wrapper routine for all interpolation actions. 3592 3576 !--------------------------------------------------------------------------------------------------! 3593 3577 SUBROUTINE pmci_interpolation 3594 3595 !3596 !-- A wrapper routine for all interpolation actions3597 3578 3598 3579 IMPLICIT NONE … … 3612 3593 IF ( bc_dirichlet_l ) THEN 3613 3594 3614 CALL pmci_interp_ 1sto_lr( u, uc, kcto, jflo, jfuo, kflo, kfuo, 'l', 'u' )3615 CALL pmci_interp_ 1sto_lr( v, vc, kcto, jflv, jfuv, kflo, kfuo, 'l', 'v' )3616 CALL pmci_interp_ 1sto_lr( w, wc, kctw, jflo, jfuo, kflw, kfuw, 'l', 'w' )3595 CALL pmci_interp_lr( u, uc, kcto, jflo, jfuo, kflo, kfuo, 'l', 'u' ) 3596 CALL pmci_interp_lr( v, vc, kcto, jflv, jfuv, kflo, kfuo, 'l', 'v' ) 3597 CALL pmci_interp_lr( w, wc, kctw, jflo, jfuo, kflw, kfuw, 'l', 'w' ) 3617 3598 3618 3599 IF ( ( rans_mode_parent .AND. rans_mode ) .OR. & 3619 3600 ( .NOT. rans_mode_parent .AND. .NOT. rans_mode .AND. & 3620 3601 .NOT. constant_diffusion ) ) THEN 3621 ! CALL pmci_interp_ 1sto_lr( e, ec, kcto, jflo, jfuo, kflo, kfuo, 'l', 'e' )3602 ! CALL pmci_interp_lr( e, ec, kcto, jflo, jfuo, kflo, kfuo, 'l', 'e' ) 3622 3603 ! 3623 3604 !-- Interpolation of e is replaced by the Neumann condition. … … 3629 3610 3630 3611 IF ( rans_mode_parent .AND. rans_mode .AND. rans_tke_e ) THEN 3631 CALL pmci_interp_ 1sto_lr( diss, dissc, kcto, jflo, jfuo, kflo, kfuo, 'l', 's' )3612 CALL pmci_interp_lr( diss, dissc, kcto, jflo, jfuo, kflo, kfuo, 'l', 's' ) 3632 3613 ENDIF 3633 3614 3634 3615 IF ( .NOT. neutral ) THEN 3635 CALL pmci_interp_ 1sto_lr( pt, ptc, kcto, jflo, jfuo, kflo, kfuo, 'l', 's' )3616 CALL pmci_interp_lr( pt, ptc, kcto, jflo, jfuo, kflo, kfuo, 'l', 's' ) 3636 3617 ENDIF 3637 3618 3638 3619 IF ( humidity ) THEN 3639 3620 3640 CALL pmci_interp_ 1sto_lr( q, q_c, kcto, jflo, jfuo, kflo, kfuo, 'l', 's' )3621 CALL pmci_interp_lr( q, q_c, kcto, jflo, jfuo, kflo, kfuo, 'l', 's' ) 3641 3622 3642 3623 IF ( bulk_cloud_model .AND. microphysics_morrison ) THEN 3643 CALL pmci_interp_ 1sto_lr( qc, qcc, kcto, jflo, jfuo, kflo, kfuo, 'l', 's' )3644 CALL pmci_interp_ 1sto_lr( nc, ncc, kcto, jflo, jfuo, kflo, kfuo, 'l', 's' )3624 CALL pmci_interp_lr( qc, qcc, kcto, jflo, jfuo, kflo, kfuo, 'l', 's' ) 3625 CALL pmci_interp_lr( nc, ncc, kcto, jflo, jfuo, kflo, kfuo, 'l', 's' ) 3645 3626 ENDIF 3646 3627 3647 3628 IF ( bulk_cloud_model .AND. microphysics_seifert ) THEN 3648 CALL pmci_interp_ 1sto_lr( qr, qrc, kcto, jflo, jfuo, kflo, kfuo, 'l', 's' )3649 CALL pmci_interp_ 1sto_lr( nr, nrc, kcto, jflo, jfuo, kflo, kfuo, 'l', 's' )3629 CALL pmci_interp_lr( qr, qrc, kcto, jflo, jfuo, kflo, kfuo, 'l', 's' ) 3630 CALL pmci_interp_lr( nr, nrc, kcto, jflo, jfuo, kflo, kfuo, 'l', 's' ) 3650 3631 ENDIF 3651 3632 … … 3653 3634 3654 3635 IF ( passive_scalar ) THEN 3655 CALL pmci_interp_ 1sto_lr( s, sc, kcto, jflo, jfuo, kflo, kfuo, 'l', 's' )3636 CALL pmci_interp_lr( s, sc, kcto, jflo, jfuo, kflo, kfuo, 'l', 's' ) 3656 3637 ENDIF 3657 3638 3658 3639 IF ( air_chemistry .AND. nesting_chem ) THEN 3659 3640 DO n = 1, nspec 3660 CALL pmci_interp_ 1sto_lr( chem_species(n)%conc, chem_spec_c(:,:,:,n),&3661 3641 CALL pmci_interp_lr( chem_species(n)%conc, chem_spec_c(:,:,:,n), & 3642 kcto, jflo, jfuo, kflo, kfuo, 'l', 's' ) 3662 3643 ENDDO 3663 3644 ENDIF … … 3665 3646 IF ( salsa .AND. nesting_salsa ) THEN 3666 3647 DO lb = 1, nbins_aerosol 3667 CALL pmci_interp_ 1sto_lr( aerosol_number(lb)%conc, aerosol_number_c(:,:,:,lb),&3668 3648 CALL pmci_interp_lr( aerosol_number(lb)%conc, aerosol_number_c(:,:,:,lb), & 3649 kcto, jflo, jfuo, kflo, kfuo, 'l', 's') 3669 3650 ENDDO 3670 3651 DO lc = 1, nbins_aerosol * ncomponents_mass 3671 CALL pmci_interp_ 1sto_lr( aerosol_mass(lc)%conc, aerosol_mass_c(:,:,:,lc),&3672 3652 CALL pmci_interp_lr( aerosol_mass(lc)%conc, aerosol_mass_c(:,:,:,lc), & 3653 kcto, jflo, jfuo, kflo, kfuo, 'l', 's') 3673 3654 ENDDO 3674 3655 IF ( .NOT. salsa_gases_from_chem ) THEN 3675 3656 DO lg = 1, ngases_salsa 3676 CALL pmci_interp_ 1sto_lr( salsa_gas(lg)%conc, salsa_gas_c(:,:,:,lg),&3677 3657 CALL pmci_interp_lr( salsa_gas(lg)%conc, salsa_gas_c(:,:,:,lg), & 3658 kcto, jflo, jfuo, kflo, kfuo, 'l', 's') 3678 3659 ENDDO 3679 3660 ENDIF … … 3685 3666 IF ( bc_dirichlet_r ) THEN 3686 3667 3687 CALL pmci_interp_ 1sto_lr( u, uc, kcto, jflo, jfuo, kflo, kfuo, 'r', 'u' )3688 CALL pmci_interp_ 1sto_lr( v, vc, kcto, jflv, jfuv, kflo, kfuo, 'r', 'v' )3689 CALL pmci_interp_ 1sto_lr( w, wc, kctw, jflo, jfuo, kflw, kfuw, 'r', 'w' )3668 CALL pmci_interp_lr( u, uc, kcto, jflo, jfuo, kflo, kfuo, 'r', 'u' ) 3669 CALL pmci_interp_lr( v, vc, kcto, jflv, jfuv, kflo, kfuo, 'r', 'v' ) 3670 CALL pmci_interp_lr( w, wc, kctw, jflo, jfuo, kflw, kfuw, 'r', 'w' ) 3690 3671 3691 3672 IF ( ( rans_mode_parent .AND. rans_mode ) .OR. & 3692 3673 ( .NOT. rans_mode_parent .AND. .NOT. rans_mode .AND. & 3693 3674 .NOT. constant_diffusion ) ) THEN 3694 ! CALL pmci_interp_ 1sto_lr( e, ec, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 'r', 'e' )3675 ! CALL pmci_interp_lr( e, ec, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 'r', 'e' ) 3695 3676 ! 3696 3677 !-- Interpolation of e is replaced by the Neumann condition. … … 3701 3682 3702 3683 IF ( rans_mode_parent .AND. rans_mode .AND. rans_tke_e ) THEN 3703 CALL pmci_interp_ 1sto_lr( diss, dissc, kcto, jflo, jfuo, kflo, kfuo, 'r', 's' )3684 CALL pmci_interp_lr( diss, dissc, kcto, jflo, jfuo, kflo, kfuo, 'r', 's' ) 3704 3685 ENDIF 3705 3686 3706 3687 IF ( .NOT. neutral ) THEN 3707 CALL pmci_interp_ 1sto_lr( pt, ptc, kcto, jflo, jfuo, kflo, kfuo, 'r', 's' )3688 CALL pmci_interp_lr( pt, ptc, kcto, jflo, jfuo, kflo, kfuo, 'r', 's' ) 3708 3689 ENDIF 3709 3690 3710 3691 IF ( humidity ) THEN 3711 CALL pmci_interp_ 1sto_lr( q, q_c, kcto, jflo, jfuo, kflo, kfuo, 'r', 's' )3692 CALL pmci_interp_lr( q, q_c, kcto, jflo, jfuo, kflo, kfuo, 'r', 's' ) 3712 3693 3713 3694 IF ( bulk_cloud_model .AND. microphysics_morrison ) THEN 3714 CALL pmci_interp_ 1sto_lr( qc, qcc, kcto, jflo, jfuo, kflo, kfuo, 'r', 's' )3715 CALL pmci_interp_ 1sto_lr( nc, ncc, kcto, jflo, jfuo, kflo, kfuo, 'r', 's' )3695 CALL pmci_interp_lr( qc, qcc, kcto, jflo, jfuo, kflo, kfuo, 'r', 's' ) 3696 CALL pmci_interp_lr( nc, ncc, kcto, jflo, jfuo, kflo, kfuo, 'r', 's' ) 3716 3697 ENDIF 3717 3698 3718 3699 IF ( bulk_cloud_model .AND. microphysics_seifert ) THEN 3719 CALL pmci_interp_ 1sto_lr( qr, qrc, kcto, jflo, jfuo, kflo, kfuo, 'r', 's' )3720 CALL pmci_interp_ 1sto_lr( nr, nrc, kcto, jflo, jfuo, kflo, kfuo, 'r', 's' )3700 CALL pmci_interp_lr( qr, qrc, kcto, jflo, jfuo, kflo, kfuo, 'r', 's' ) 3701 CALL pmci_interp_lr( nr, nrc, kcto, jflo, jfuo, kflo, kfuo, 'r', 's' ) 3721 3702 ENDIF 3722 3703 … … 3724 3705 3725 3706 IF ( passive_scalar ) THEN 3726 CALL pmci_interp_ 1sto_lr( s, sc, kcto, jflo, jfuo, kflo, kfuo, 'r', 's' )3707 CALL pmci_interp_lr( s, sc, kcto, jflo, jfuo, kflo, kfuo, 'r', 's' ) 3727 3708 ENDIF 3728 3709 3729 3710 IF ( air_chemistry .AND. nesting_chem ) THEN 3730 3711 DO n = 1, nspec 3731 CALL pmci_interp_ 1sto_lr( chem_species(n)%conc, chem_spec_c(:,:,:,n),&3732 3712 CALL pmci_interp_lr( chem_species(n)%conc, chem_spec_c(:,:,:,n), & 3713 kcto, jflo, jfuo, kflo, kfuo, 'r', 's' ) 3733 3714 ENDDO 3734 3715 ENDIF … … 3736 3717 IF ( salsa .AND. nesting_salsa ) THEN 3737 3718 DO lb = 1, nbins_aerosol 3738 CALL pmci_interp_ 1sto_lr( aerosol_number(lb)%conc, aerosol_number_c(:,:,:,lb),&3719 CALL pmci_interp_lr( aerosol_number(lb)%conc, aerosol_number_c(:,:,:,lb), & 3739 3720 kcto, jflo, jfuo, kflo, kfuo, 'r', 's' ) 3740 3721 ENDDO 3741 3722 DO lc = 1, nbins_aerosol * ncomponents_mass 3742 CALL pmci_interp_ 1sto_lr( aerosol_mass(lc)%conc, aerosol_mass_c(:,:,:,lc),&3743 3723 CALL pmci_interp_lr( aerosol_mass(lc)%conc, aerosol_mass_c(:,:,:,lc), & 3724 kcto, jflo, jfuo, kflo, kfuo, 'r', 's' ) 3744 3725 ENDDO 3745 3726 IF ( .NOT. salsa_gases_from_chem ) THEN 3746 3727 DO lg = 1, ngases_salsa 3747 CALL pmci_interp_ 1sto_lr( salsa_gas(lg)%conc, salsa_gas_c(:,:,:,lg),&3748 3728 CALL pmci_interp_lr( salsa_gas(lg)%conc, salsa_gas_c(:,:,:,lg), & 3729 kcto, jflo, jfuo, kflo, kfuo, 'r', 's' ) 3749 3730 ENDDO 3750 3731 ENDIF … … 3756 3737 IF ( bc_dirichlet_s ) THEN 3757 3738 3758 CALL pmci_interp_ 1sto_sn( v, vc, kcto, iflo, ifuo, kflo, kfuo, 's', 'v' )3759 CALL pmci_interp_ 1sto_sn( w, wc, kctw, iflo, ifuo, kflw, kfuw, 's', 'w' )3760 CALL pmci_interp_ 1sto_sn( u, uc, kcto, iflu, ifuu, kflo, kfuo, 's', 'u' )3739 CALL pmci_interp_sn( v, vc, kcto, iflo, ifuo, kflo, kfuo, 's', 'v' ) 3740 CALL pmci_interp_sn( w, wc, kctw, iflo, ifuo, kflw, kfuw, 's', 'w' ) 3741 CALL pmci_interp_sn( u, uc, kcto, iflu, ifuu, kflo, kfuo, 's', 'u' ) 3761 3742 3762 3743 IF ( ( rans_mode_parent .AND. rans_mode ) .OR. & 3763 3744 ( .NOT. rans_mode_parent .AND. .NOT. rans_mode .AND. & 3764 3745 .NOT. constant_diffusion ) ) THEN 3765 ! CALL pmci_interp_ 1sto_sn( e, ec, kcto, iflo, ifuo, kflo, kfuo, 's', 'e' )3746 ! CALL pmci_interp_sn( e, ec, kcto, iflo, ifuo, kflo, kfuo, 's', 'e' ) 3766 3747 ! 3767 3748 !-- Interpolation of e is replaced by the Neumann condition. … … 3772 3753 3773 3754 IF ( rans_mode_parent .AND. rans_mode .AND. rans_tke_e ) THEN 3774 CALL pmci_interp_ 1sto_sn( diss, dissc, kcto, iflo, ifuo, kflo, kfuo, 's', 's' )3755 CALL pmci_interp_sn( diss, dissc, kcto, iflo, ifuo, kflo, kfuo, 's', 's' ) 3775 3756 ENDIF 3776 3757 3777 3758 IF ( .NOT. neutral ) THEN 3778 CALL pmci_interp_ 1sto_sn( pt, ptc, kcto, iflo, ifuo, kflo, kfuo, 's', 's' )3759 CALL pmci_interp_sn( pt, ptc, kcto, iflo, ifuo, kflo, kfuo, 's', 's' ) 3779 3760 ENDIF 3780 3761 3781 3762 IF ( humidity ) THEN 3782 CALL pmci_interp_ 1sto_sn( q, q_c, kcto, iflo, ifuo, kflo, kfuo, 's', 's' )3763 CALL pmci_interp_sn( q, q_c, kcto, iflo, ifuo, kflo, kfuo, 's', 's' ) 3783 3764 3784 3765 IF ( bulk_cloud_model .AND. microphysics_morrison ) THEN 3785 CALL pmci_interp_ 1sto_sn( qc, qcc, kcto, iflo, ifuo, kflo, kfuo, 's', 's' )3786 CALL pmci_interp_ 1sto_sn( nc, ncc, kcto, iflo, ifuo, kflo, kfuo, 's', 's' )3766 CALL pmci_interp_sn( qc, qcc, kcto, iflo, ifuo, kflo, kfuo, 's', 's' ) 3767 CALL pmci_interp_sn( nc, ncc, kcto, iflo, ifuo, kflo, kfuo, 's', 's' ) 3787 3768 ENDIF 3788 3769 3789 3770 IF ( bulk_cloud_model .AND. microphysics_seifert ) THEN 3790 CALL pmci_interp_ 1sto_sn( qr, qrc, kcto, iflo, ifuo, kflo, kfuo, 's', 's' )3791 CALL pmci_interp_ 1sto_sn( nr, nrc, kcto, iflo, ifuo, kflo, kfuo, 's', 's' )3771 CALL pmci_interp_sn( qr, qrc, kcto, iflo, ifuo, kflo, kfuo, 's', 's' ) 3772 CALL pmci_interp_sn( nr, nrc, kcto, iflo, ifuo, kflo, kfuo, 's', 's' ) 3792 3773 ENDIF 3793 3774 … … 3795 3776 3796 3777 IF ( passive_scalar ) THEN 3797 CALL pmci_interp_ 1sto_sn( s, sc, kcto, iflo, ifuo, kflo, kfuo, 's', 's' )3778 CALL pmci_interp_sn( s, sc, kcto, iflo, ifuo, kflo, kfuo, 's', 's' ) 3798 3779 ENDIF 3799 3780 3800 3781 IF ( air_chemistry .AND. nesting_chem ) THEN 3801 3782 DO n = 1, nspec 3802 CALL pmci_interp_ 1sto_sn( chem_species(n)%conc, chem_spec_c(:,:,:,n),&3803 3783 CALL pmci_interp_sn( chem_species(n)%conc, chem_spec_c(:,:,:,n), & 3784 kcto, iflo, ifuo, kflo, kfuo, 's', 's' ) 3804 3785 ENDDO 3805 3786 ENDIF … … 3807 3788 IF ( salsa .AND. nesting_salsa ) THEN 3808 3789 DO lb = 1, nbins_aerosol 3809 CALL pmci_interp_ 1sto_sn( aerosol_number(lb)%conc, aerosol_number_c(:,:,:,lb),&3810 3790 CALL pmci_interp_sn( aerosol_number(lb)%conc, aerosol_number_c(:,:,:,lb), & 3791 kcto, iflo, ifuo, kflo, kfuo, 's', 's' ) 3811 3792 ENDDO 3812 3793 DO lc = 1, nbins_aerosol * ncomponents_mass 3813 CALL pmci_interp_ 1sto_sn( aerosol_mass(lc)%conc, aerosol_mass_c(:,:,:,lc),&3814 3794 CALL pmci_interp_sn( aerosol_mass(lc)%conc, aerosol_mass_c(:,:,:,lc), & 3795 kcto, iflo, ifuo, kflo, kfuo, 's', 's' ) 3815 3796 ENDDO 3816 3797 IF ( .NOT. salsa_gases_from_chem ) THEN 3817 3798 DO lg = 1, ngases_salsa 3818 CALL pmci_interp_ 1sto_sn( salsa_gas(lg)%conc, salsa_gas_c(:,:,:,lg),&3819 3799 CALL pmci_interp_sn( salsa_gas(lg)%conc, salsa_gas_c(:,:,:,lg), & 3800 kcto, iflo, ifuo, kflo, kfuo, 's', 's' ) 3820 3801 ENDDO 3821 3802 ENDIF … … 3827 3808 IF ( bc_dirichlet_n ) THEN 3828 3809 3829 CALL pmci_interp_ 1sto_sn( v, vc, kcto, iflo, ifuo, kflo, kfuo, 'n', 'v' )3830 CALL pmci_interp_ 1sto_sn( w, wc, kctw, iflo, ifuo, kflw, kfuw, 'n', 'w' )3831 CALL pmci_interp_ 1sto_sn( u, uc, kcto, iflu, ifuu, kflo, kfuo, 'n', 'u' )3810 CALL pmci_interp_sn( v, vc, kcto, iflo, ifuo, kflo, kfuo, 'n', 'v' ) 3811 CALL pmci_interp_sn( w, wc, kctw, iflo, ifuo, kflw, kfuw, 'n', 'w' ) 3812 CALL pmci_interp_sn( u, uc, kcto, iflu, ifuu, kflo, kfuo, 'n', 'u' ) 3832 3813 3833 3814 IF ( ( rans_mode_parent .AND. rans_mode ) .OR. & 3834 3815 ( .NOT. rans_mode_parent .AND. .NOT. rans_mode .AND. & 3835 3816 .NOT. constant_diffusion ) ) THEN 3836 ! CALL pmci_interp_ 1sto_sn( e, ec, kcto, iflo, ifuo, kflo, kfuo, 'n', 'e' )3817 ! CALL pmci_interp_sn( e, ec, kcto, iflo, ifuo, kflo, kfuo, 'n', 'e' ) 3837 3818 ! 3838 3819 !-- Interpolation of e is replaced by the Neumann condition. … … 3843 3824 3844 3825 IF ( rans_mode_parent .AND. rans_mode .AND. rans_tke_e ) THEN 3845 CALL pmci_interp_ 1sto_sn( diss, dissc, kcto, iflo, ifuo, kflo, kfuo, 'n', 's' )3826 CALL pmci_interp_sn( diss, dissc, kcto, iflo, ifuo, kflo, kfuo, 'n', 's' ) 3846 3827 ENDIF 3847 3828 3848 3829 IF ( .NOT. neutral ) THEN 3849 CALL pmci_interp_ 1sto_sn( pt, ptc, kcto, iflo, ifuo, kflo, kfuo, 'n', 's' )3830 CALL pmci_interp_sn( pt, ptc, kcto, iflo, ifuo, kflo, kfuo, 'n', 's' ) 3850 3831 ENDIF 3851 3832 3852 3833 IF ( humidity ) THEN 3853 CALL pmci_interp_ 1sto_sn( q, q_c, kcto, iflo, ifuo, kflo, kfuo, 'n', 's' )3834 CALL pmci_interp_sn( q, q_c, kcto, iflo, ifuo, kflo, kfuo, 'n', 's' ) 3854 3835 3855 3836 IF ( bulk_cloud_model .AND. microphysics_morrison ) THEN 3856 CALL pmci_interp_ 1sto_sn( qc, qcc, kcto, iflo, ifuo, kflo, kfuo, 'n', 's' )3857 CALL pmci_interp_ 1sto_sn( nc, ncc, kcto, iflo, ifuo, kflo, kfuo, 'n', 's' )3837 CALL pmci_interp_sn( qc, qcc, kcto, iflo, ifuo, kflo, kfuo, 'n', 's' ) 3838 CALL pmci_interp_sn( nc, ncc, kcto, iflo, ifuo, kflo, kfuo, 'n', 's' ) 3858 3839 ENDIF 3859 3840 3860 3841 IF ( bulk_cloud_model .AND. microphysics_seifert ) THEN 3861 CALL pmci_interp_ 1sto_sn( qr, qrc, kcto, iflo, ifuo, kflo, kfuo, 'n', 's' )3862 CALL pmci_interp_ 1sto_sn( nr, nrc, kcto, iflo, ifuo, kflo, kfuo, 'n', 's' )3842 CALL pmci_interp_sn( qr, qrc, kcto, iflo, ifuo, kflo, kfuo, 'n', 's' ) 3843 CALL pmci_interp_sn( nr, nrc, kcto, iflo, ifuo, kflo, kfuo, 'n', 's' ) 3863 3844 ENDIF 3864 3845 … … 3866 3847 3867 3848 IF ( passive_scalar ) THEN 3868 CALL pmci_interp_ 1sto_sn( s, sc, kcto, iflo, ifuo, kflo, kfuo, 'n', 's' )3849 CALL pmci_interp_sn( s, sc, kcto, iflo, ifuo, kflo, kfuo, 'n', 's' ) 3869 3850 ENDIF 3870 3851 3871 3852 IF ( air_chemistry .AND. nesting_chem ) THEN 3872 3853 DO n = 1, nspec 3873 CALL pmci_interp_ 1sto_sn( chem_species(n)%conc, chem_spec_c(:,:,:,n),&3874 3854 CALL pmci_interp_sn( chem_species(n)%conc, chem_spec_c(:,:,:,n), & 3855 kcto, iflo, ifuo, kflo, kfuo, 'n', 's' ) 3875 3856 ENDDO 3876 3857 ENDIF … … 3878 3859 IF ( salsa .AND. nesting_salsa ) THEN 3879 3860 DO lb = 1, nbins_aerosol 3880 CALL pmci_interp_ 1sto_sn( aerosol_number(lb)%conc, aerosol_number_c(:,:,:,lb),&3881 3861 CALL pmci_interp_sn( aerosol_number(lb)%conc, aerosol_number_c(:,:,:,lb), & 3862 kcto, iflo, ifuo, kflo, kfuo, 'n', 's' ) 3882 3863 ENDDO 3883 3864 DO lc = 1, nbins_aerosol * ncomponents_mass 3884 CALL pmci_interp_ 1sto_sn( aerosol_mass(lc)%conc, aerosol_mass_c(:,:,:,lc),&3885 3865 CALL pmci_interp_sn( aerosol_mass(lc)%conc, aerosol_mass_c(:,:,:,lc), & 3866 kcto, iflo, ifuo, kflo, kfuo, 'n', 's' ) 3886 3867 ENDDO 3887 3868 IF ( .NOT. salsa_gases_from_chem ) THEN 3888 3869 DO lg = 1, ngases_salsa 3889 CALL pmci_interp_ 1sto_sn( salsa_gas(lg)%conc, salsa_gas_c(:,:,:,lg),&3890 3870 CALL pmci_interp_sn( salsa_gas(lg)%conc, salsa_gas_c(:,:,:,lg), & 3871 kcto, iflo, ifuo, kflo, kfuo, 'n', 's' ) 3891 3872 ENDDO 3892 3873 ENDIF … … 3898 3879 ! 3899 3880 !-- All PEs are top-border PEs 3900 CALL pmci_interp_ 1sto_t( w, wc, kctw, iflo, ifuo, jflo, jfuo, 'w' )3901 CALL pmci_interp_ 1sto_t( u, uc, kcto, iflu, ifuu, jflo, jfuo, 'u' )3902 CALL pmci_interp_ 1sto_t( v, vc, kcto, iflo, ifuo, jflv, jfuv, 'v' )3881 CALL pmci_interp_t( w, wc, kctw, iflo, ifuo, jflo, jfuo, 'w' ) 3882 CALL pmci_interp_t( u, uc, kcto, iflu, ifuu, jflo, jfuo, 'u' ) 3883 CALL pmci_interp_t( v, vc, kcto, iflo, ifuo, jflv, jfuv, 'v' ) 3903 3884 3904 3885 IF ( ( rans_mode_parent .AND. rans_mode ) .OR. & 3905 3886 ( .NOT. rans_mode_parent .AND. .NOT. rans_mode .AND. & 3906 3887 .NOT. constant_diffusion ) ) THEN 3907 ! CALL pmci_interp_ 1sto_t( e, ec, kcto, iflo, ifuo, jflo, jfuo, 'e' )3888 ! CALL pmci_interp_t( e, ec, kcto, iflo, ifuo, jflo, jfuo, 'e' ) 3908 3889 ! 3909 3890 !-- Interpolation of e is replaced by the Neumann condition. … … 3912 3893 3913 3894 IF ( rans_mode_parent .AND. rans_mode .AND. rans_tke_e ) THEN 3914 CALL pmci_interp_ 1sto_t( diss, dissc, kcto, iflo, ifuo, jflo, jfuo, 's' )3895 CALL pmci_interp_t( diss, dissc, kcto, iflo, ifuo, jflo, jfuo, 's' ) 3915 3896 ENDIF 3916 3897 3917 3898 IF ( .NOT. neutral ) THEN 3918 CALL pmci_interp_ 1sto_t( pt, ptc, kcto, iflo, ifuo, jflo, jfuo, 's' )3899 CALL pmci_interp_t( pt, ptc, kcto, iflo, ifuo, jflo, jfuo, 's' ) 3919 3900 ENDIF 3920 3901 3921 3902 IF ( humidity ) THEN 3922 CALL pmci_interp_ 1sto_t( q, q_c, kcto, iflo, ifuo, jflo, jfuo, 's' )3903 CALL pmci_interp_t( q, q_c, kcto, iflo, ifuo, jflo, jfuo, 's' ) 3923 3904 IF ( bulk_cloud_model .AND. microphysics_morrison ) THEN 3924 CALL pmci_interp_ 1sto_t( qc, qcc, kcto, iflo, ifuo, jflo, jfuo, 's' )3925 CALL pmci_interp_ 1sto_t( nc, ncc, kcto, iflo, ifuo, jflo, jfuo, 's' )3905 CALL pmci_interp_t( qc, qcc, kcto, iflo, ifuo, jflo, jfuo, 's' ) 3906 CALL pmci_interp_t( nc, ncc, kcto, iflo, ifuo, jflo, jfuo, 's' ) 3926 3907 ENDIF 3927 3908 IF ( bulk_cloud_model .AND. microphysics_seifert ) THEN 3928 CALL pmci_interp_ 1sto_t( qr, qrc, kcto, iflo, ifuo, jflo, jfuo, 's' )3929 CALL pmci_interp_ 1sto_t( nr, nrc, kcto, iflo, ifuo, jflo, jfuo, 's' )3909 CALL pmci_interp_t( qr, qrc, kcto, iflo, ifuo, jflo, jfuo, 's' ) 3910 CALL pmci_interp_t( nr, nrc, kcto, iflo, ifuo, jflo, jfuo, 's' ) 3930 3911 ENDIF 3931 3912 ENDIF 3932 3913 3933 3914 IF ( passive_scalar ) THEN 3934 CALL pmci_interp_ 1sto_t( s, sc, kcto, iflo, ifuo, jflo, jfuo, 's' )3915 CALL pmci_interp_t( s, sc, kcto, iflo, ifuo, jflo, jfuo, 's' ) 3935 3916 ENDIF 3936 3917 3937 3918 IF ( air_chemistry .AND. nesting_chem ) THEN 3938 3919 DO n = 1, nspec 3939 CALL pmci_interp_ 1sto_t( chem_species(n)%conc, chem_spec_c(:,:,:,n),&3940 3920 CALL pmci_interp_t( chem_species(n)%conc, chem_spec_c(:,:,:,n), & 3921 kcto, iflo, ifuo, jflo, jfuo, 's' ) 3941 3922 ENDDO 3942 3923 ENDIF … … 3944 3925 IF ( salsa .AND. nesting_salsa ) THEN 3945 3926 DO lb = 1, nbins_aerosol 3946 CALL pmci_interp_ 1sto_t( aerosol_number(lb)%conc, aerosol_number_c(:,:,:,lb),&3947 3927 CALL pmci_interp_t( aerosol_number(lb)%conc, aerosol_number_c(:,:,:,lb), & 3928 kcto, iflo, ifuo, jflo, jfuo, 's' ) 3948 3929 ENDDO 3949 3930 DO lc = 1, nbins_aerosol * ncomponents_mass 3950 CALL pmci_interp_ 1sto_t( aerosol_mass(lc)%conc, aerosol_mass_c(:,:,:,lc),&3951 3931 CALL pmci_interp_t( aerosol_mass(lc)%conc, aerosol_mass_c(:,:,:,lc), & 3932 kcto, iflo, ifuo, jflo, jfuo, 's' ) 3952 3933 ENDDO 3953 3934 IF ( .NOT. salsa_gases_from_chem ) THEN 3954 3935 DO lg = 1, ngases_salsa 3955 CALL pmci_interp_ 1sto_t( salsa_gas(lg)%conc, salsa_gas_c(:,:,:,lg),&3956 3936 CALL pmci_interp_t( salsa_gas(lg)%conc, salsa_gas_c(:,:,:,lg), & 3937 kcto, iflo, ifuo, jflo, jfuo, 's' ) 3957 3938 ENDDO 3958 3939 ENDIF … … 3966 3947 ! Description: 3967 3948 ! ------------ 3968 !> @Todo: Missing subroutine description.3949 !> A wrapper routine for all anterpolation actions. Note that TKE is not anterpolated. 3969 3950 !--------------------------------------------------------------------------------------------------! 3970 3951 SUBROUTINE pmci_anterpolation 3971 3972 ! 3973 !-- A wrapper routine for all anterpolation actions. 3974 !-- Note that TKE is not anterpolated. 3952 3975 3953 IMPLICIT NONE 3976 3954 INTEGER(iwp) :: lb !< Running index for aerosol size bins … … 3980 3958 3981 3959 3982 CALL pmci_anterp_ tophat( u, uc, kcto, iflu, ifuu, jflo, jfuo, kflo, kfuo, ijkfc_u, 'u' )3983 CALL pmci_anterp_ tophat( v, vc, kcto, iflo, ifuo, jflv, jfuv, kflo, kfuo, ijkfc_v, 'v' )3984 CALL pmci_anterp_ tophat( w, wc, kctw, iflo, ifuo, jflo, jfuo, kflw, kfuw, ijkfc_w, 'w' )3960 CALL pmci_anterp_var( u, uc, kcto, iflu, ifuu, jflo, jfuo, kflo, kfuo, ijkfc_u, 'u' ) 3961 CALL pmci_anterp_var( v, vc, kcto, iflo, ifuo, jflv, jfuv, kflo, kfuo, ijkfc_v, 'v' ) 3962 CALL pmci_anterp_var( w, wc, kctw, iflo, ifuo, jflo, jfuo, kflw, kfuw, ijkfc_w, 'w' ) 3985 3963 ! 3986 3964 !-- Anterpolation of TKE and dissipation rate if parent and child are in 3987 3965 !-- RANS mode. 3988 3966 IF ( rans_mode_parent .AND. rans_mode ) THEN 3989 CALL pmci_anterp_ tophat( e, ec, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, 'e' )3967 CALL pmci_anterp_var( e, ec, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, 'e' ) 3990 3968 ! 3991 3969 !-- Anterpolation of dissipation rate only if TKE-e closure is applied. 3992 3970 IF ( rans_tke_e ) THEN 3993 CALL pmci_anterp_ tophat( diss, dissc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo,&3994 3971 CALL pmci_anterp_var( diss, dissc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, & 3972 ijkfc_s, 'diss' ) 3995 3973 ENDIF 3996 3974 … … 3998 3976 3999 3977 IF ( .NOT. neutral ) THEN 4000 CALL pmci_anterp_ tophat( pt, ptc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, 'pt' )3978 CALL pmci_anterp_var( pt, ptc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, 'pt' ) 4001 3979 ENDIF 4002 3980 4003 3981 IF ( humidity ) THEN 4004 3982 4005 CALL pmci_anterp_ tophat( q, q_c, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, 'q' )3983 CALL pmci_anterp_var( q, q_c, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, 'q' ) 4006 3984 4007 3985 IF ( bulk_cloud_model .AND. microphysics_morrison ) THEN 4008 3986 4009 CALL pmci_anterp_tophat( qc, qcc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, & 4010 'qc' ) 4011 4012 CALL pmci_anterp_tophat( nc, ncc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, & 4013 'nc' ) 3987 CALL pmci_anterp_var( qc, qcc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, 'qc' ) 3988 3989 CALL pmci_anterp_var( nc, ncc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, 'nc' ) 4014 3990 4015 3991 ENDIF … … 4017 3993 IF ( bulk_cloud_model .AND. microphysics_seifert ) THEN 4018 3994 4019 CALL pmci_anterp_tophat( qr, qrc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, & 4020 'qr' ) 4021 4022 CALL pmci_anterp_tophat( nr, nrc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, & 4023 'nr' ) 3995 CALL pmci_anterp_var( qr, qrc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, 'qr' ) 3996 3997 CALL pmci_anterp_var( nr, nrc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, 'nr' ) 4024 3998 4025 3999 ENDIF … … 4028 4002 4029 4003 IF ( passive_scalar ) THEN 4030 CALL pmci_anterp_ tophat( s, sc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )4004 CALL pmci_anterp_var( s, sc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, 's' ) 4031 4005 ENDIF 4032 4006 4033 4007 IF ( air_chemistry .AND. nesting_chem ) THEN 4034 4008 DO n = 1, nspec 4035 CALL pmci_anterp_ tophat( chem_species(n)%conc, chem_spec_c(:,:,:,n),&4036 4009 CALL pmci_anterp_var( chem_species(n)%conc, chem_spec_c(:,:,:,n), & 4010 kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, 's' ) 4037 4011 ENDDO 4038 4012 ENDIF … … 4040 4014 IF ( salsa .AND. nesting_salsa ) THEN 4041 4015 DO lb = 1, nbins_aerosol 4042 CALL pmci_anterp_ tophat( aerosol_number(lb)%conc, aerosol_number_c(:,:,:,lb),&4043 4016 CALL pmci_anterp_var( aerosol_number(lb)%conc, aerosol_number_c(:,:,:,lb), & 4017 kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, 's' ) 4044 4018 ENDDO 4045 4019 DO lc = 1, nbins_aerosol * ncomponents_mass 4046 CALL pmci_anterp_ tophat( aerosol_mass(lc)%conc, aerosol_mass_c(:,:,:,lc),&4047 4020 CALL pmci_anterp_var( aerosol_mass(lc)%conc, aerosol_mass_c(:,:,:,lc), & 4021 kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, 's' ) 4048 4022 ENDDO 4049 4023 IF ( .NOT. salsa_gases_from_chem ) THEN 4050 4024 DO lg = 1, ngases_salsa 4051 CALL pmci_anterp_ tophat( salsa_gas(lg)%conc, salsa_gas_c(:,:,:,lg),&4052 4025 CALL pmci_anterp_var( salsa_gas(lg)%conc, salsa_gas_c(:,:,:,lg), & 4026 kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, 's' ) 4053 4027 ENDDO 4054 4028 ENDIF … … 4061 4035 ! Description: 4062 4036 ! ------------ 4063 !> @Todo: Missing subroutine description. 4064 !--------------------------------------------------------------------------------------------------! 4065 SUBROUTINE pmci_interp_1sto_lr( child_array, parent_array, kct, jfl, jfu, kfl, kfu, edge, var ) 4066 ! 4067 !-- Interpolation of ghost-node values used as the child-domain boundary conditions. This subroutine 4068 !-- handles the left and right boundaries. 4037 !> Interpolation of ghost-node values used as the child-domain boundary conditions. This subroutine 4038 !> handles the left and right boundaries. 4039 !--------------------------------------------------------------------------------------------------! 4040 SUBROUTINE pmci_interp_lr( child_array, parent_array, kct, jfl, jfu, kfl, kfu, edge, var ) 4041 4069 4042 IMPLICIT NONE 4070 4043 … … 4293 4266 ENDIF 4294 4267 4295 END SUBROUTINE pmci_interp_ 1sto_lr4268 END SUBROUTINE pmci_interp_lr 4296 4269 4297 4270 … … 4299 4272 ! Description: 4300 4273 ! ------------ 4301 !> @Todo: Missing subroutine description. 4302 !--------------------------------------------------------------------------------------------------! 4303 SUBROUTINE pmci_interp_1sto_sn( child_array, parent_array, kct, ifl, ifu, kfl, kfu, edge, var ) 4304 ! 4305 !-- Interpolation of ghost-node values used as the child-domain boundary conditions. This subroutine 4306 !-- handles the south and north boundaries. 4274 !> Interpolation of ghost-node values used as the child-domain boundary conditions. This subroutine 4275 !> handles the south and north boundaries. 4276 !--------------------------------------------------------------------------------------------------! 4277 SUBROUTINE pmci_interp_sn( child_array, parent_array, kct, ifl, ifu, kfl, kfu, edge, var ) 4278 4307 4279 IMPLICIT NONE 4308 4280 … … 4533 4505 ENDIF 4534 4506 4535 END SUBROUTINE pmci_interp_ 1sto_sn4507 END SUBROUTINE pmci_interp_sn 4536 4508 4537 4509 … … 4539 4511 ! Description: 4540 4512 ! ------------ 4541 !> @Todo: Missing subroutine description. 4542 !--------------------------------------------------------------------------------------------------! 4543 SUBROUTINE pmci_interp_1sto_t( child_array, parent_array, kct, ifl, ifu, jfl, jfu, var ) 4544 ! 4545 !-- Interpolation of ghost-node values used as the child-domain boundary conditions. This subroutine 4546 !-- handles the top boundary. 4513 !> Interpolation of ghost-node values used as the child-domain boundary conditions. This subroutine 4514 !> handles the top boundary. 4515 !--------------------------------------------------------------------------------------------------! 4516 SUBROUTINE pmci_interp_t( child_array, parent_array, kct, ifl, ifu, jfl, jfu, var ) 4517 4547 4518 IMPLICIT NONE 4548 4519 … … 4802 4773 ENDIF 4803 4774 4804 END SUBROUTINE pmci_interp_ 1sto_t4775 END SUBROUTINE pmci_interp_t 4805 4776 4806 4777 … … 4809 4780 ! Description: 4810 4781 ! ------------ 4811 !> @Todo: Missing subroutine description. 4812 !--------------------------------------------------------------------------------------------------! 4813 SUBROUTINE pmci_anterp_tophat( child_array, parent_array, kct, ifl, ifu, jfl, jfu, kfl, kfu, & 4814 ijkfc, var ) 4815 ! 4816 !-- Anterpolation of internal-node values to be used as the parent-domain values. This subroutine is 4817 !-- based on the first-order numerical integration of the child-grid values contained within the 4818 !-- anterpolation cell (Clark & Farley, Journal of the Atmospheric Sciences 41(3), 1984). 4782 !> Anterpolation of internal-node values of one variable to be used as the parent-domain values. 4783 !> This subroutine is based on the first-order numerical integration of the child-grid values 4784 !> contained within the anterpolation cell (Clark & Farley, Journal of the Atmospheric 4785 !> Sciences 41(3), 1984). 4786 !--------------------------------------------------------------------------------------------------! 4787 SUBROUTINE pmci_anterp_var( child_array, parent_array, kct, ifl, ifu, jfl, jfu, kfl, kfu, & 4788 ijkfc, var ) 4819 4789 4820 4790 IMPLICIT NONE … … 4926 4896 ENDDO 4927 4897 4928 END SUBROUTINE pmci_anterp_ tophat4898 END SUBROUTINE pmci_anterp_var 4929 4899 4930 4900 #endif … … 5153 5123 ! Description: 5154 5124 ! ------------ 5155 !> @Todo: Missing subroutine description. 5125 !> Adjust the volume-flow rate through the nested boundaries so that the net volume flow through 5126 !> all boundaries of the current nest domain becomes zero. 5156 5127 !--------------------------------------------------------------------------------------------------! 5157 5128 SUBROUTINE pmci_ensure_nest_mass_conservation 5158 5159 ! 5160 !-- Adjust the volume-flow rate through the nested boundaries so that the net volume flow through 5161 !-- all boundaries of the current nest domain becomes zero. 5129 5162 5130 IMPLICIT NONE 5163 5131 … … 5382 5350 ! Description: 5383 5351 ! ------------ 5384 !> @Todo: Missing subroutine description. 5352 !> Adjust the volume-flow rate through the top boundary so that the net volume flow through 5353 !> all boundaries of the current nest domain becomes zero. 5385 5354 !--------------------------------------------------------------------------------------------------! 5386 5355 SUBROUTINE pmci_ensure_nest_mass_conservation_vertical 5387 5388 ! 5389 !-- Adjust the volume-flow rate through the top boundary so that the net volume flow through all 5390 !-- boundaries of the current nest domain becomes zero. 5356 5391 5357 IMPLICIT NONE 5392 5358
Note: See TracChangeset
for help on using the changeset viewer.
