Changeset 2174 for palm/trunk/SOURCE/pmc_interface_mod.f90
- Timestamp:
- Mar 13, 2017 8:18:57 AM (8 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/pmc_interface_mod.f90 (modified) (19 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/pmc_interface_mod.f90
r2101 r2174 21 21 ! Current revisions: 22 22 ! ------------------ 23 ! 23 ! Added support for cloud physics quantities, syntax layout improvements. Data 24 ! transfer of qc and nc is prepared but currently deactivated until both 25 ! quantities become prognostic variables. 26 ! Some bugfixes. 24 27 ! 25 28 ! Former revisions: … … 121 124 ! Domain nesting interface routines. The low-level inter-domain communication 122 125 ! is conducted by the PMC-library routines. 126 ! 127 ! @todo Remove array_3d variables from USE statements thate not used in the 128 ! routine 129 ! @todo Data transfer of qc and nc is prepared but not activated 123 130 !-------------------------------------------------------------------------------! 124 131 125 132 #if defined( __nopointer ) 126 USE arrays_3d, 127 ONLY: dzu, dzw, e, e_p, pt, pt_p, q, q_p, u, u_p, v, v_p, w, w_p, zu,&128 zw, z0133 USE arrays_3d, & 134 ONLY: dzu, dzw, e, e_p, nr, pt, pt_p, q, q_p, qr, u, u_p, v, v_p, & 135 w, w_p, zu, zw, z0 129 136 #else 130 USE arrays_3d, 131 ONLY: dzu, dzw, e, e_p, e_1, e_2, pt, pt_p, pt_1, pt_2, q, q_p, q_1,&132 q_2, s, s_2, u, u_p, u_1, u_2, v, v_p, v_1, v_2, w, w_p, w_1,&133 w_2, zu, zw, z0137 USE arrays_3d, & 138 ONLY: dzu, dzw, e, e_p, e_1, e_2, nr, nr_2, nr_p, pt, pt_p, pt_1, & 139 pt_2, q, q_p, q_1, q_2, qr, qr_2, s, s_2, u, u_p, u_1, u_2, v, & 140 v_p, v_1, v_2, w, w_p, w_1, w_2, zu, zw, z0 134 141 #endif 135 142 136 143 USE control_parameters, & 137 ONLY: c oupling_char, dt_3d, dz, humidity, message_string,&138 nest_bound_l, nest_bound_r, nest_bound_s, nest_bound_n,&139 nest_ domain, neutral, passive_scalar, simulated_time, &140 topography, volume_flow144 ONLY: cloud_physics, coupling_char, dt_3d, dz, humidity, & 145 message_string, microphysics_seifert, nest_bound_l, nest_bound_r,& 146 nest_bound_s, nest_bound_n, nest_domain, neutral, passive_scalar,& 147 simulated_time, topography, volume_flow 141 148 142 149 USE cpulog, & … … 249 256 REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: vc !: 250 257 REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: wc !: 251 REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: qc !: 258 REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: q_c !: 259 ! REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: qcc !: 260 REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: qrc !: 261 REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: nrc !: 262 ! REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: ncc !: 252 263 REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET :: sc !: 253 264 … … 920 931 CALL pmc_set_dataarray_name( 'coarse', 'w' ,'fine', 'w', ierr ) 921 932 CALL pmc_set_dataarray_name( 'coarse', 'e' ,'fine', 'e', ierr ) 933 922 934 IF ( .NOT. neutral ) THEN 923 935 CALL pmc_set_dataarray_name( 'coarse', 'pt' ,'fine', 'pt', ierr ) 924 936 ENDIF 937 925 938 IF ( humidity ) THEN 939 926 940 CALL pmc_set_dataarray_name( 'coarse', 'q' ,'fine', 'q', ierr ) 927 ENDIF 941 942 IF ( cloud_physics .AND. microphysics_seifert ) THEN 943 ! CALL pmc_set_dataarray_name( 'coarse', 'qc' ,'fine', 'qc', ierr ) 944 CALL pmc_set_dataarray_name( 'coarse', 'qr' ,'fine', 'qr', ierr ) 945 ! CALL pmc_set_dataarray_name( 'coarse', 'nc' ,'fine', 'nc', ierr ) 946 CALL pmc_set_dataarray_name( 'coarse', 'nr' ,'fine', 'nr', ierr ) 947 948 ENDIF 949 950 ENDIF 951 928 952 IF ( passive_scalar ) THEN 929 953 CALL pmc_set_dataarray_name( 'coarse', 's' ,'fine', 's', ierr ) … … 2541 2565 IF ( TRIM(name) == "pt" ) p_3d => pt 2542 2566 IF ( TRIM(name) == "q" ) p_3d => q 2567 ! IF ( TRIM(name) == "qc" ) p_3d => qc 2568 IF ( TRIM(name) == "qr" ) p_3d => qr 2569 IF ( TRIM(name) == "nr" ) p_3d => nr 2570 ! IF ( TRIM(name) == "nc" ) p_3d => nc 2543 2571 IF ( TRIM(name) == "s" ) p_3d => s 2544 2572 ! … … 2573 2601 IF ( TRIM(name) == "pt" ) p_3d_sec => pt_2 2574 2602 IF ( TRIM(name) == "q" ) p_3d_sec => q_2 2603 ! IF ( TRIM(name) == "qc" ) p_3d_sec => qc_2 2604 IF ( TRIM(name) == "qr" ) p_3d_sec => qr_2 2605 IF ( TRIM(name) == "nr" ) p_3d_sec => nr_2 2606 ! IF ( TRIM(name) == "nc" ) p_3d_sec => nc_2 2575 2607 IF ( TRIM(name) == "s" ) p_3d_sec => s_2 2576 2608 … … 2643 2675 p_3d => ptc 2644 2676 ELSEIF ( TRIM( name ) == "q") THEN 2645 IF ( .NOT. ALLOCATED( qc ) ) ALLOCATE( qc(0:nzc+1, js:je, is:ie) ) 2646 p_3d => qc 2677 IF ( .NOT. ALLOCATED( q_c ) ) ALLOCATE( q_c(0:nzc+1, js:je, is:ie) ) 2678 p_3d => q_c 2679 ! ELSEIF ( TRIM( name ) == "qc") THEN 2680 ! IF ( .NOT. ALLOCATED( qcc ) ) ALLOCATE( qcc(0:nzc+1, js:je, is:ie) ) 2681 ! p_3d => qcc 2682 ELSEIF ( TRIM( name ) == "qr") THEN 2683 IF ( .NOT. ALLOCATED( qrc ) ) ALLOCATE( qrc(0:nzc+1, js:je, is:ie) ) 2684 p_3d => qrc 2685 ELSEIF ( TRIM( name ) == "nr") THEN 2686 IF ( .NOT. ALLOCATED( nrc ) ) ALLOCATE( nrc(0:nzc+1, js:je, is:ie) ) 2687 p_3d => nrc 2688 ! ELSEIF ( TRIM( name ) == "nc") THEN 2689 ! IF ( .NOT. ALLOCATED( ncc ) ) ALLOCATE( ncc(0:nzc+1, js:je, is:ie) ) 2690 ! p_3d => ncc 2647 2691 ELSEIF ( TRIM( name ) == "s") THEN 2648 2692 IF ( .NOT. ALLOCATED( sc ) ) ALLOCATE( sc(0:nzc+1, js:je, is:ie) ) … … 2743 2787 CALL pmci_interp_tril_all ( e, ec, ico, jco, kco, r1xo, r2xo, r1yo, & 2744 2788 r2yo, r1zo, r2zo, nzb_s_inner, 'e' ) 2789 2745 2790 IF ( .NOT. neutral ) THEN 2746 2791 CALL pmci_interp_tril_all ( pt, ptc, ico, jco, kco, r1xo, r2xo, & 2747 2792 r1yo, r2yo, r1zo, r2zo, nzb_s_inner, 's' ) 2748 2793 ENDIF 2794 2749 2795 IF ( humidity ) THEN 2750 CALL pmci_interp_tril_all ( q, qc, ico, jco, kco, r1xo, r2xo, r1yo, & 2796 2797 CALL pmci_interp_tril_all ( q, q_c, ico, jco, kco, r1xo, r2xo, r1yo, & 2751 2798 r2yo, r1zo, r2zo, nzb_s_inner, 's' ) 2752 ENDIF 2799 2800 IF ( cloud_physics .AND. microphysics_seifert ) THEN 2801 ! CALL pmci_interp_tril_all ( qc, qcc, ico, jco, kco, r1xo, r2xo, & 2802 ! r1yo, r2yo, r1zo, r2zo, nzb_s_inner, & 2803 ! 's' ) 2804 CALL pmci_interp_tril_all ( qr, qrc, ico, jco, kco, r1xo, r2xo, & 2805 r1yo, r2yo, r1zo, r2zo, nzb_s_inner, & 2806 's' ) 2807 ! CALL pmci_interp_tril_all ( nc, ncc, ico, jco, kco, r1xo, r2xo, & 2808 ! r1yo, r2yo, r1zo, r2zo, nzb_s_inner, & 2809 ! 's' ) 2810 CALL pmci_interp_tril_all ( nr, nrc, ico, jco, kco, r1xo, r2xo, & 2811 r1yo, r2yo, r1zo, r2zo, nzb_s_inner, & 2812 's' ) 2813 ENDIF 2814 2815 ENDIF 2816 2753 2817 IF ( passive_scalar ) THEN 2754 2818 CALL pmci_interp_tril_all ( s, sc, ico, jco, kco, r1xo, r2xo, r1yo, & … … 3378 3442 logc_u_l, logc_ratio_u_l, & 3379 3443 nzt_topo_nestbc_l, 'l', 'u' ) 3444 3380 3445 CALL pmci_interp_tril_lr( v, vc, ico, jcv, kco, r1xo, r2xo, & 3381 3446 r1yv, r2yv, r1zo, r2zo, nzb_v_inner, & 3382 3447 logc_v_l, logc_ratio_v_l, & 3383 3448 nzt_topo_nestbc_l, 'l', 'v' ) 3449 3384 3450 CALL pmci_interp_tril_lr( w, wc, ico, jco, kcw, r1xo, r2xo, & 3385 3451 r1yo, r2yo, r1zw, r2zw, nzb_w_inner, & 3386 3452 logc_w_l, logc_ratio_w_l, & 3387 3453 nzt_topo_nestbc_l, 'l', 'w' ) 3454 3388 3455 CALL pmci_interp_tril_lr( e, ec, ico, jco, kco, r1xo, r2xo, & 3389 3456 r1yo, r2yo, r1zo, r2zo, nzb_s_inner, & 3390 3457 logc_u_l, logc_ratio_u_l, & 3391 3458 nzt_topo_nestbc_l, 'l', 'e' ) 3459 3392 3460 IF ( .NOT. neutral ) THEN 3393 3461 CALL pmci_interp_tril_lr( pt, ptc, ico, jco, kco, r1xo, r2xo, & … … 3396 3464 nzt_topo_nestbc_l, 'l', 's' ) 3397 3465 ENDIF 3466 3398 3467 IF ( humidity ) THEN 3399 CALL pmci_interp_tril_lr( q, qc, ico, jco, kco, r1xo, r2xo, & 3468 3469 CALL pmci_interp_tril_lr( q, q_c, ico, jco, kco, r1xo, r2xo, & 3400 3470 r1yo, r2yo, r1zo, r2zo, nzb_s_inner, & 3401 3471 logc_u_l, logc_ratio_u_l, & 3402 3472 nzt_topo_nestbc_l, 'l', 's' ) 3473 3474 3475 IF ( cloud_physics .AND. microphysics_seifert ) THEN 3476 ! CALL pmci_interp_tril_lr( qc, qcc, ico, jco, kco, r1xo, r2xo,& 3477 ! r1yo, r2yo, r1zo, r2zo, & 3478 ! nzb_s_inner, logc_u_l, & 3479 ! logc_ratio_u_l, nzt_topo_nestbc_l, & 3480 ! 'l', 's' ) 3481 3482 CALL pmci_interp_tril_lr( qr, qrc, ico, jco, kco, r1xo, r2xo,& 3483 r1yo, r2yo, r1zo, r2zo, & 3484 nzb_s_inner, logc_u_l, & 3485 logc_ratio_u_l, nzt_topo_nestbc_l, & 3486 'l', 's' ) 3487 3488 ! CALL pmci_interp_tril_lr( nc, ncc, ico, jco, kco, r1xo, r2xo,& 3489 ! r1yo, r2yo, r1zo, r2zo, & 3490 ! nzb_s_inner, logc_u_l, & 3491 ! logc_ratio_u_l, nzt_topo_nestbc_l, & 3492 ! 'l', 's' ) 3493 3494 CALL pmci_interp_tril_lr( nr, nrc, ico, jco, kco, r1xo, r2xo,& 3495 r1yo, r2yo, r1zo, r2zo, & 3496 nzb_s_inner, logc_u_l, & 3497 logc_ratio_u_l, nzt_topo_nestbc_l, & 3498 'l', 's' ) 3499 ENDIF 3500 3403 3501 ENDIF 3502 3404 3503 IF ( passive_scalar ) THEN 3405 3504 CALL pmci_interp_tril_lr( s, sc, ico, jco, kco, r1xo, r2xo, & … … 3410 3509 3411 3510 IF ( TRIM( nesting_mode ) == 'one-way' ) THEN 3511 3412 3512 CALL pmci_extrap_ifoutflow_lr( u, nzb_u_inner, 'l', 'u' ) 3413 3513 CALL pmci_extrap_ifoutflow_lr( v, nzb_v_inner, 'l', 'v' ) 3414 3514 CALL pmci_extrap_ifoutflow_lr( w, nzb_w_inner, 'l', 'w' ) 3415 3515 CALL pmci_extrap_ifoutflow_lr( e, nzb_s_inner, 'l', 'e' ) 3516 3416 3517 IF ( .NOT. neutral ) THEN 3417 3518 CALL pmci_extrap_ifoutflow_lr( pt,nzb_s_inner, 'l', 's' ) 3418 3519 ENDIF 3520 3419 3521 IF ( humidity ) THEN 3522 3420 3523 CALL pmci_extrap_ifoutflow_lr( q, nzb_s_inner, 'l', 's' ) 3524 3525 IF ( cloud_physics .AND. microphysics_seifert ) THEN 3526 3527 ! CALL pmci_extrap_ifoutflow_lr( qc, nzb_s_inner, 'l', 's' ) 3528 CALL pmci_extrap_ifoutflow_lr( qr, nzb_s_inner, 'l', 's' ) 3529 ! CALL pmci_extrap_ifoutflow_lr( nc, nzb_s_inner, 'l', 's' ) 3530 CALL pmci_extrap_ifoutflow_lr( nr, nzb_s_inner, 'l', 's' ) 3531 3532 ENDIF 3533 3421 3534 ENDIF 3535 3422 3536 IF ( passive_scalar ) THEN 3423 3537 CALL pmci_extrap_ifoutflow_lr( s, nzb_s_inner, 'l', 's' ) 3424 3538 ENDIF 3539 3425 3540 ENDIF 3426 3541 … … 3430 3545 !-- Right border pe 3431 3546 IF ( nest_bound_r ) THEN 3432 CALL pmci_interp_tril_lr( u, uc, icu, jco, kco, r1xu, r2xu, & 3433 r1yo, r2yo, r1zo, r2zo, nzb_u_inner, & 3434 logc_u_r, logc_ratio_u_r, & 3547 3548 CALL pmci_interp_tril_lr( u, uc, icu, jco, kco, r1xu, r2xu, & 3549 r1yo, r2yo, r1zo, r2zo, nzb_u_inner, & 3550 logc_u_r, logc_ratio_u_r, & 3435 3551 nzt_topo_nestbc_r, 'r', 'u' ) 3436 CALL pmci_interp_tril_lr( v, vc, ico, jcv, kco, r1xo, r2xo, & 3437 r1yv, r2yv, r1zo, r2zo, nzb_v_inner, & 3438 logc_v_r, logc_ratio_v_r, & 3552 3553 CALL pmci_interp_tril_lr( v, vc, ico, jcv, kco, r1xo, r2xo, & 3554 r1yv, r2yv, r1zo, r2zo, nzb_v_inner, & 3555 logc_v_r, logc_ratio_v_r, & 3439 3556 nzt_topo_nestbc_r, 'r', 'v' ) 3440 CALL pmci_interp_tril_lr( w, wc, ico, jco, kcw, r1xo, r2xo, & 3441 r1yo, r2yo, r1zw, r2zw, nzb_w_inner, & 3442 logc_w_r, logc_ratio_w_r, & 3557 3558 CALL pmci_interp_tril_lr( w, wc, ico, jco, kcw, r1xo, r2xo, & 3559 r1yo, r2yo, r1zw, r2zw, nzb_w_inner, & 3560 logc_w_r, logc_ratio_w_r, & 3443 3561 nzt_topo_nestbc_r, 'r', 'w' ) 3444 CALL pmci_interp_tril_lr( e, ec, ico, jco, kco, r1xo, r2xo, & 3445 r1yo,r2yo, r1zo, r2zo, nzb_s_inner, & 3446 logc_u_r, logc_ratio_u_r, & 3562 3563 CALL pmci_interp_tril_lr( e, ec, ico, jco, kco, r1xo, r2xo, & 3564 r1yo,r2yo, r1zo, r2zo, nzb_s_inner, & 3565 logc_u_r, logc_ratio_u_r, & 3447 3566 nzt_topo_nestbc_r, 'r', 'e' ) 3567 3448 3568 IF ( .NOT. neutral ) THEN 3449 CALL pmci_interp_tril_lr( pt, ptc, ico, jco, kco, r1xo, r2xo, 3450 r1yo, r2yo, r1zo, r2zo, nzb_s_inner, 3451 logc_u_r, logc_ratio_u_r, 3569 CALL pmci_interp_tril_lr( pt, ptc, ico, jco, kco, r1xo, r2xo, & 3570 r1yo, r2yo, r1zo, r2zo, nzb_s_inner, & 3571 logc_u_r, logc_ratio_u_r, & 3452 3572 nzt_topo_nestbc_r, 'r', 's' ) 3453 3573 ENDIF 3574 3454 3575 IF ( humidity ) THEN 3455 CALL pmci_interp_tril_lr( q, qc, ico, jco, kco, r1xo, r2xo, & 3456 r1yo, r2yo, r1zo, r2zo, nzb_s_inner, & 3457 logc_u_r, logc_ratio_u_r, & 3576 3577 CALL pmci_interp_tril_lr( q, q_c, ico, jco, kco, r1xo, r2xo, & 3578 r1yo, r2yo, r1zo, r2zo, nzb_s_inner, & 3579 logc_u_r, logc_ratio_u_r, & 3580 nzt_topo_nestbc_r, 'r', 's' ) 3581 3582 IF ( cloud_physics .AND. microphysics_seifert ) THEN 3583 3584 ! CALL pmci_interp_tril_lr( qc, qcc, ico, jco, kco, r1xo, & 3585 ! r2xo, r1yo, r2yo, r1zo, r2zo, & 3586 ! nzb_s_inner, logc_u_r, & 3587 ! logc_ratio_u_r, nzt_topo_nestbc_r,& 3588 ! 'r', 's' ) 3589 3590 CALL pmci_interp_tril_lr( qr, qrc, ico, jco, kco, r1xo, & 3591 r2xo, r1yo, r2yo, r1zo, r2zo, & 3592 nzb_s_inner, logc_u_r, & 3593 logc_ratio_u_r, nzt_topo_nestbc_r,& 3594 'r', 's' ) 3595 3596 ! CALL pmci_interp_tril_lr( nc, ncc, ico, jco, kco, r1xo, & 3597 ! r2xo, r1yo, r2yo, r1zo, r2zo, & 3598 ! nzb_s_inner, logc_u_r, & 3599 ! logc_ratio_u_r, nzt_topo_nestbc_r,& 3600 ! 'r', 's' ) 3601 3602 CALL pmci_interp_tril_lr( nr, nrc, ico, jco, kco, r1xo, & 3603 r2xo, r1yo, r2yo, r1zo, r2zo, & 3604 nzb_s_inner, logc_u_r, & 3605 logc_ratio_u_r, nzt_topo_nestbc_r,& 3606 'r', 's' ) 3607 3608 ENDIF 3609 3610 ENDIF 3611 3612 IF ( passive_scalar ) THEN 3613 CALL pmci_interp_tril_lr( s, sc, ico, jco, kco, r1xo, r2xo, & 3614 r1yo, r2yo, r1zo, r2zo, nzb_s_inner, & 3615 logc_u_r, logc_ratio_u_r, & 3458 3616 nzt_topo_nestbc_r, 'r', 's' ) 3459 3617 ENDIF 3460 IF ( passive_scalar ) THEN3461 CALL pmci_interp_tril_lr( s, sc, ico, jco, kco, r1xo, r2xo, &3462 r1yo, r2yo, r1zo, r2zo, nzb_s_inner, &3463 logc_u_r, logc_ratio_u_r, &3464 nzt_topo_nestbc_r, 'r', 's' )3465 ENDIF3466 3618 3467 3619 IF ( TRIM( nesting_mode ) == 'one-way' ) THEN 3620 3468 3621 CALL pmci_extrap_ifoutflow_lr( u, nzb_u_inner, 'r', 'u' ) 3469 3622 CALL pmci_extrap_ifoutflow_lr( v, nzb_v_inner, 'r', 'v' ) 3470 3623 CALL pmci_extrap_ifoutflow_lr( w, nzb_w_inner, 'r', 'w' ) 3471 3624 CALL pmci_extrap_ifoutflow_lr( e, nzb_s_inner, 'r', 'e' ) 3625 3472 3626 IF ( .NOT. neutral ) THEN 3473 3627 CALL pmci_extrap_ifoutflow_lr( pt,nzb_s_inner, 'r', 's' ) 3474 3628 ENDIF 3629 3475 3630 IF ( humidity ) THEN 3631 3476 3632 CALL pmci_extrap_ifoutflow_lr( q, nzb_s_inner, 'r', 's' ) 3633 3634 IF ( cloud_physics .AND. microphysics_seifert ) THEN 3635 ! CALL pmci_extrap_ifoutflow_lr( qc, nzb_s_inner, 'r', 's' ) 3636 CALL pmci_extrap_ifoutflow_lr( qr, nzb_s_inner, 'r', 's' ) 3637 ! CALL pmci_extrap_ifoutflow_lr( nc, nzb_s_inner, 'r', 's' ) 3638 CALL pmci_extrap_ifoutflow_lr( nr, nzb_s_inner, 'r', 's' ) 3639 ENDIF 3640 3477 3641 ENDIF 3642 3478 3643 IF ( passive_scalar ) THEN 3479 3644 CALL pmci_extrap_ifoutflow_lr( s, nzb_s_inner, 'r', 's' ) … … 3486 3651 !-- South border pe 3487 3652 IF ( nest_bound_s ) THEN 3488 CALL pmci_interp_tril_sn( u, uc, icu, jco, kco, r1xu, r2xu, 3489 r1yo, r2yo, r1zo, r2zo, nzb_u_inner, 3490 logc_u_s, logc_ratio_u_s, 3653 CALL pmci_interp_tril_sn( u, uc, icu, jco, kco, r1xu, r2xu, & 3654 r1yo, r2yo, r1zo, r2zo, nzb_u_inner, & 3655 logc_u_s, logc_ratio_u_s, & 3491 3656 nzt_topo_nestbc_s, 's', 'u' ) 3492 CALL pmci_interp_tril_sn( v, vc, ico, jcv, kco, r1xo, r2xo, & 3493 r1yv, r2yv, r1zo, r2zo, nzb_v_inner, & 3494 logc_v_s, logc_ratio_v_s, & 3657 3658 CALL pmci_interp_tril_sn( v, vc, ico, jcv, kco, r1xo, r2xo, & 3659 r1yv, r2yv, r1zo, r2zo, nzb_v_inner, & 3660 logc_v_s, logc_ratio_v_s, & 3495 3661 nzt_topo_nestbc_s, 's', 'v' ) 3496 CALL pmci_interp_tril_sn( w, wc, ico, jco, kcw, r1xo, r2xo, & 3497 r1yo, r2yo, r1zw, r2zw, nzb_w_inner, & 3498 logc_w_s, logc_ratio_w_s, & 3662 3663 CALL pmci_interp_tril_sn( w, wc, ico, jco, kcw, r1xo, r2xo, & 3664 r1yo, r2yo, r1zw, r2zw, nzb_w_inner, & 3665 logc_w_s, logc_ratio_w_s, & 3499 3666 nzt_topo_nestbc_s, 's','w' ) 3500 CALL pmci_interp_tril_sn( e, ec, ico, jco, kco, r1xo, r2xo, & 3501 r1yo, r2yo, r1zo, r2zo, nzb_s_inner, & 3502 logc_u_s, logc_ratio_u_s, & 3667 3668 CALL pmci_interp_tril_sn( e, ec, ico, jco, kco, r1xo, r2xo, & 3669 r1yo, r2yo, r1zo, r2zo, nzb_s_inner, & 3670 logc_u_s, logc_ratio_u_s, & 3503 3671 nzt_topo_nestbc_s, 's', 'e' ) 3672 3504 3673 IF ( .NOT. neutral ) THEN 3505 CALL pmci_interp_tril_sn( pt, ptc, ico, jco, kco, r1xo, r2xo, 3506 r1yo, r2yo, r1zo, r2zo, nzb_s_inner, 3507 logc_u_s, logc_ratio_u_s, 3674 CALL pmci_interp_tril_sn( pt, ptc, ico, jco, kco, r1xo, r2xo, & 3675 r1yo, r2yo, r1zo, r2zo, nzb_s_inner, & 3676 logc_u_s, logc_ratio_u_s, & 3508 3677 nzt_topo_nestbc_s, 's', 's' ) 3509 3678 ENDIF 3679 3510 3680 IF ( humidity ) THEN 3511 CALL pmci_interp_tril_sn( q, qc, ico, jco, kco, r1xo, r2xo, & 3512 r1yo,r2yo, r1zo, r2zo, nzb_s_inner, & 3513 logc_u_s, logc_ratio_u_s, & 3681 3682 CALL pmci_interp_tril_sn( q, q_c, ico, jco, kco, r1xo, r2xo, & 3683 r1yo,r2yo, r1zo, r2zo, nzb_s_inner, & 3684 logc_u_s, logc_ratio_u_s, & 3685 nzt_topo_nestbc_s, 's', 's' ) 3686 3687 IF ( cloud_physics .AND. microphysics_seifert ) THEN 3688 3689 ! CALL pmci_interp_tril_sn( qc, qcc, ico, jco, kco, r1xo, & 3690 ! r2xo, r1yo,r2yo, r1zo, r2zo, & 3691 ! nzb_s_inner, logc_u_s, & 3692 ! logc_ratio_u_s, nzt_topo_nestbc_s,& 3693 ! 's', 's' ) 3694 3695 CALL pmci_interp_tril_sn( qr, qrc, ico, jco, kco, r1xo, & 3696 r2xo, r1yo,r2yo, r1zo, r2zo, & 3697 nzb_s_inner, logc_u_s, & 3698 logc_ratio_u_s, nzt_topo_nestbc_s,& 3699 's', 's' ) 3700 3701 ! CALL pmci_interp_tril_sn( nc, ncc, ico, jco, kco, r1xo, & 3702 ! r2xo, r1yo,r2yo, r1zo, r2zo, & 3703 ! nzb_s_inner, logc_u_s, & 3704 ! logc_ratio_u_s, nzt_topo_nestbc_s,& 3705 ! 's', 's' ) 3706 3707 CALL pmci_interp_tril_sn( nr, nrc, ico, jco, kco, r1xo, & 3708 r2xo, r1yo,r2yo, r1zo, r2zo, & 3709 nzb_s_inner, logc_u_s, & 3710 logc_ratio_u_s, nzt_topo_nestbc_s,& 3711 's', 's' ) 3712 3713 ENDIF 3714 3715 ENDIF 3716 3717 IF ( passive_scalar ) THEN 3718 CALL pmci_interp_tril_sn( s, sc, ico, jco, kco, r1xo, r2xo, & 3719 r1yo,r2yo, r1zo, r2zo, nzb_s_inner, & 3720 logc_u_s, logc_ratio_u_s, & 3514 3721 nzt_topo_nestbc_s, 's', 's' ) 3515 3722 ENDIF 3516 IF ( passive_scalar ) THEN3517 CALL pmci_interp_tril_sn( s, sc, ico, jco, kco, r1xo, r2xo, &3518 r1yo,r2yo, r1zo, r2zo, nzb_s_inner, &3519 logc_u_s, logc_ratio_u_s, &3520 nzt_topo_nestbc_s, 's', 's' )3521 ENDIF3522 3723 3523 3724 IF ( TRIM( nesting_mode ) == 'one-way' ) THEN 3725 3524 3726 CALL pmci_extrap_ifoutflow_sn( u, nzb_u_inner, 's', 'u' ) 3525 3727 CALL pmci_extrap_ifoutflow_sn( v, nzb_v_inner, 's', 'v' ) 3526 3728 CALL pmci_extrap_ifoutflow_sn( w, nzb_w_inner, 's', 'w' ) 3527 3729 CALL pmci_extrap_ifoutflow_sn( e, nzb_s_inner, 's', 'e' ) 3730 3528 3731 IF ( .NOT. neutral ) THEN 3529 3732 CALL pmci_extrap_ifoutflow_sn( pt,nzb_s_inner, 's', 's' ) 3530 3733 ENDIF 3734 3531 3735 IF ( humidity ) THEN 3736 3532 3737 CALL pmci_extrap_ifoutflow_sn( q, nzb_s_inner, 's', 's' ) 3738 3739 IF ( cloud_physics .AND. microphysics_seifert ) THEN 3740 ! CALL pmci_extrap_ifoutflow_sn( qc, nzb_s_inner, 's', 's' ) 3741 CALL pmci_extrap_ifoutflow_sn( qr, nzb_s_inner, 's', 's' ) 3742 ! CALL pmci_extrap_ifoutflow_sn( nc, nzb_s_inner, 's', 's' ) 3743 CALL pmci_extrap_ifoutflow_sn( nr, nzb_s_inner, 's', 's' ) 3744 3745 ENDIF 3746 3533 3747 ENDIF 3748 3534 3749 IF ( passive_scalar ) THEN 3535 3750 CALL pmci_extrap_ifoutflow_sn( s, nzb_s_inner, 's', 's' ) 3536 3751 ENDIF 3752 3537 3753 ENDIF 3538 3754 … … 3542 3758 !-- North border pe 3543 3759 IF ( nest_bound_n ) THEN 3544 CALL pmci_interp_tril_sn( u, uc, icu, jco, kco, r1xu, r2xu, & 3545 r1yo, r2yo, r1zo, r2zo, nzb_u_inner, & 3546 logc_u_n, logc_ratio_u_n, & 3760 3761 CALL pmci_interp_tril_sn( u, uc, icu, jco, kco, r1xu, r2xu, & 3762 r1yo, r2yo, r1zo, r2zo, nzb_u_inner, & 3763 logc_u_n, logc_ratio_u_n, & 3547 3764 nzt_topo_nestbc_n, 'n', 'u' ) 3548 CALL pmci_interp_tril_sn( v, vc, ico, jcv, kco, r1xo, r2xo, 3549 r1yv, r2yv, r1zo, r2zo, nzb_v_inner, 3550 logc_v_n, logc_ratio_v_n, 3765 CALL pmci_interp_tril_sn( v, vc, ico, jcv, kco, r1xo, r2xo, & 3766 r1yv, r2yv, r1zo, r2zo, nzb_v_inner, & 3767 logc_v_n, logc_ratio_v_n, & 3551 3768 nzt_topo_nestbc_n, 'n', 'v' ) 3552 CALL pmci_interp_tril_sn( w, wc, ico, jco, kcw, r1xo, r2xo, 3553 r1yo, r2yo, r1zw, r2zw, nzb_w_inner, 3554 logc_w_n, logc_ratio_w_n, 3769 CALL pmci_interp_tril_sn( w, wc, ico, jco, kcw, r1xo, r2xo, & 3770 r1yo, r2yo, r1zw, r2zw, nzb_w_inner, & 3771 logc_w_n, logc_ratio_w_n, & 3555 3772 nzt_topo_nestbc_n, 'n', 'w' ) 3556 CALL pmci_interp_tril_sn( e, ec, ico, jco, kco, r1xo, r2xo, 3557 r1yo, r2yo, r1zo, r2zo, nzb_s_inner, 3558 logc_u_n, logc_ratio_u_n, 3773 CALL pmci_interp_tril_sn( e, ec, ico, jco, kco, r1xo, r2xo, & 3774 r1yo, r2yo, r1zo, r2zo, nzb_s_inner, & 3775 logc_u_n, logc_ratio_u_n, & 3559 3776 nzt_topo_nestbc_n, 'n', 'e' ) 3777 3560 3778 IF ( .NOT. neutral ) THEN 3561 CALL pmci_interp_tril_sn( pt, ptc, ico, jco, kco, r1xo, r2xo, 3562 r1yo, r2yo, r1zo, r2zo, nzb_s_inner, 3563 logc_u_n, logc_ratio_u_n, 3779 CALL pmci_interp_tril_sn( pt, ptc, ico, jco, kco, r1xo, r2xo, & 3780 r1yo, r2yo, r1zo, r2zo, nzb_s_inner, & 3781 logc_u_n, logc_ratio_u_n, & 3564 3782 nzt_topo_nestbc_n, 'n', 's' ) 3565 3783 ENDIF 3784 3566 3785 IF ( humidity ) THEN 3567 CALL pmci_interp_tril_sn( q, qc, ico, jco, kco, r1xo, r2xo, & 3568 r1yo, r2yo, r1zo, r2zo, nzb_s_inner, & 3569 logc_u_n, logc_ratio_u_n, & 3786 3787 CALL pmci_interp_tril_sn( q, q_c, ico, jco, kco, r1xo, r2xo, & 3788 r1yo, r2yo, r1zo, r2zo, nzb_s_inner, & 3789 logc_u_n, logc_ratio_u_n, & 3790 nzt_topo_nestbc_n, 'n', 's' ) 3791 3792 IF ( cloud_physics .AND. microphysics_seifert ) THEN 3793 3794 ! CALL pmci_interp_tril_sn( qc, qcc, ico, jco, kco, r1xo, & 3795 ! r2xo, r1yo, r2yo, r1zo, r2zo, & 3796 ! nzb_s_inner, logc_u_n, & 3797 ! logc_ratio_u_n, nzt_topo_nestbc_n,& 3798 ! 'n', 's' ) 3799 3800 CALL pmci_interp_tril_sn( qr, qrc, ico, jco, kco, r1xo, & 3801 r2xo, r1yo, r2yo, r1zo, r2zo, & 3802 nzb_s_inner, logc_u_n, & 3803 logc_ratio_u_n, nzt_topo_nestbc_n,& 3804 'n', 's' ) 3805 3806 ! CALL pmci_interp_tril_sn( nc, ncc, ico, jco, kco, r1xo, & 3807 ! r2xo, r1yo, r2yo, r1zo, r2zo, & 3808 ! nzb_s_inner, logc_u_n, & 3809 ! logc_ratio_u_n, nzt_topo_nestbc_n,& 3810 ! 'n', 's' ) 3811 3812 CALL pmci_interp_tril_sn( nr, nrc, ico, jco, kco, r1xo, & 3813 r2xo, r1yo, r2yo, r1zo, r2zo, & 3814 nzb_s_inner, logc_u_n, & 3815 logc_ratio_u_n, nzt_topo_nestbc_n,& 3816 'n', 's' ) 3817 3818 ENDIF 3819 3820 ENDIF 3821 3822 IF ( passive_scalar ) THEN 3823 CALL pmci_interp_tril_sn( s, sc, ico, jco, kco, r1xo, r2xo, & 3824 r1yo, r2yo, r1zo, r2zo, nzb_s_inner, & 3825 logc_u_n, logc_ratio_u_n, & 3570 3826 nzt_topo_nestbc_n, 'n', 's' ) 3571 3827 ENDIF 3572 IF ( passive_scalar ) THEN3573 CALL pmci_interp_tril_sn( s, sc, ico, jco, kco, r1xo, r2xo, &3574 r1yo, r2yo, r1zo, r2zo, nzb_s_inner, &3575 logc_u_n, logc_ratio_u_n, &3576 nzt_topo_nestbc_n, 'n', 's' )3577 ENDIF3578 3828 3579 3829 IF ( TRIM( nesting_mode ) == 'one-way' ) THEN 3830 3580 3831 CALL pmci_extrap_ifoutflow_sn( u, nzb_u_inner, 'n', 'u' ) 3581 3832 CALL pmci_extrap_ifoutflow_sn( v, nzb_v_inner, 'n', 'v' ) 3582 3833 CALL pmci_extrap_ifoutflow_sn( w, nzb_w_inner, 'n', 'w' ) 3583 3834 CALL pmci_extrap_ifoutflow_sn( e, nzb_s_inner, 'n', 'e' ) 3835 3584 3836 IF ( .NOT. neutral ) THEN 3585 3837 CALL pmci_extrap_ifoutflow_sn( pt,nzb_s_inner, 'n', 's' ) 3586 3838 ENDIF 3839 3587 3840 IF ( humidity ) THEN 3841 3588 3842 CALL pmci_extrap_ifoutflow_sn( q, nzb_s_inner, 'n', 's' ) 3843 3844 IF ( cloud_physics .AND. microphysics_seifert ) THEN 3845 ! CALL pmci_extrap_ifoutflow_sn( qc, nzb_s_inner, 'n', 's' ) 3846 CALL pmci_extrap_ifoutflow_sn( qr, nzb_s_inner, 'n', 's' ) 3847 ! CALL pmci_extrap_ifoutflow_sn( nc, nzb_s_inner, 'n', 's' ) 3848 CALL pmci_extrap_ifoutflow_sn( nr, nzb_s_inner, 'n', 's' ) 3849 ENDIF 3850 3589 3851 ENDIF 3852 3590 3853 IF ( passive_scalar ) THEN 3591 3854 CALL pmci_extrap_ifoutflow_sn( s, nzb_s_inner, 'n', 's' ) … … 3600 3863 ! 3601 3864 !-- All PEs are top-border PEs 3602 CALL pmci_interp_tril_t( u, uc, icu, jco, kco, r1xu, r2xu, r1yo, 3865 CALL pmci_interp_tril_t( u, uc, icu, jco, kco, r1xu, r2xu, r1yo, & 3603 3866 r2yo, r1zo, r2zo, 'u' ) 3604 CALL pmci_interp_tril_t( v, vc, ico, jcv, kco, r1xo, r2xo, r1yv, 3867 CALL pmci_interp_tril_t( v, vc, ico, jcv, kco, r1xo, r2xo, r1yv, & 3605 3868 r2yv, r1zo, r2zo, 'v' ) 3606 CALL pmci_interp_tril_t( w, wc, ico, jco, kcw, r1xo, r2xo, r1yo, 3869 CALL pmci_interp_tril_t( w, wc, ico, jco, kcw, r1xo, r2xo, r1yo, & 3607 3870 r2yo, r1zw, r2zw, 'w' ) 3608 CALL pmci_interp_tril_t( e, ec, ico, jco, kco, r1xo, r2xo, r1yo, 3871 CALL pmci_interp_tril_t( e, ec, ico, jco, kco, r1xo, r2xo, r1yo, & 3609 3872 r2yo, r1zo, r2zo, 'e' ) 3873 3610 3874 IF ( .NOT. neutral ) THEN 3611 CALL pmci_interp_tril_t( pt, ptc, ico, jco, kco, r1xo, r2xo, r1yo, 3875 CALL pmci_interp_tril_t( pt, ptc, ico, jco, kco, r1xo, r2xo, r1yo, & 3612 3876 r2yo, r1zo, r2zo, 's' ) 3613 3877 ENDIF 3878 3614 3879 IF ( humidity ) THEN 3615 CALL pmci_interp_tril_t( q, qc, ico, jco, kco, r1xo, r2xo, r1yo, & 3880 3881 CALL pmci_interp_tril_t( q, q_c, ico, jco, kco, r1xo, r2xo, r1yo, & 3616 3882 r2yo, r1zo, r2zo, 's' ) 3617 ENDIF 3883 3884 IF ( cloud_physics .AND. microphysics_seifert ) THEN 3885 3886 ! CALL pmci_interp_tril_t( qc, qcc, ico, jco, kco, r1xo, r2xo, r1yo,& 3887 ! r2yo, r1zo, r2zo, 's' ) 3888 3889 CALL pmci_interp_tril_t( qr, qrc, ico, jco, kco, r1xo, r2xo, r1yo,& 3890 r2yo, r1zo, r2zo, 's' ) 3891 3892 ! CALL pmci_interp_tril_t( nc, ncc, ico, jco, kco, r1xo, r2xo, r1yo,& 3893 ! r2yo, r1zo, r2zo, 's' ) 3894 3895 CALL pmci_interp_tril_t( nr, nrc, ico, jco, kco, r1xo, r2xo, r1yo,& 3896 r2yo, r1zo, r2zo, 's' ) 3897 3898 ENDIF 3899 3900 ENDIF 3901 3618 3902 IF ( passive_scalar ) THEN 3619 CALL pmci_interp_tril_t( s, sc, ico, jco, kco, r1xo, r2xo, r1yo, 3903 CALL pmci_interp_tril_t( s, sc, ico, jco, kco, r1xo, r2xo, r1yo, & 3620 3904 r2yo, r1zo, r2zo, 's' ) 3621 3905 ENDIF 3622 3906 3623 3907 IF ( TRIM( nesting_mode ) == 'one-way' ) THEN 3908 3624 3909 CALL pmci_extrap_ifoutflow_t( u, 'u' ) 3625 3910 CALL pmci_extrap_ifoutflow_t( v, 'v' ) 3626 3911 CALL pmci_extrap_ifoutflow_t( w, 'w' ) 3627 3912 CALL pmci_extrap_ifoutflow_t( e, 'e' ) 3913 3628 3914 IF ( .NOT. neutral ) THEN 3629 3915 CALL pmci_extrap_ifoutflow_t( pt, 's' ) 3630 3916 ENDIF 3917 3631 3918 IF ( humidity ) THEN 3919 3632 3920 CALL pmci_extrap_ifoutflow_t( q, 's' ) 3921 3922 IF ( cloud_physics .AND. microphysics_seifert ) THEN 3923 ! CALL pmci_extrap_ifoutflow_t( qc, 's' ) 3924 CALL pmci_extrap_ifoutflow_t( qr, 's' ) 3925 ! CALL pmci_extrap_ifoutflow_t( nc, 's' ) 3926 CALL pmci_extrap_ifoutflow_t( nr, 's' ) 3927 3928 ENDIF 3929 3633 3930 ENDIF 3931 3634 3932 IF ( passive_scalar ) THEN 3635 3933 CALL pmci_extrap_ifoutflow_t( s, 's' ) 3636 3934 ENDIF 3935 3637 3936 ENDIF 3638 3937 … … 3648 3947 IMPLICIT NONE 3649 3948 3650 CALL pmci_anterp_tophat( u, uc, kctu, iflu, ifuu, jflo, jfuo, kflo, 3949 CALL pmci_anterp_tophat( u, uc, kctu, iflu, ifuu, jflo, jfuo, kflo, & 3651 3950 kfuo, ijfc_u, 'u' ) 3652 CALL pmci_anterp_tophat( v, vc, kctu, iflo, ifuo, jflv, jfuv, kflo, 3951 CALL pmci_anterp_tophat( v, vc, kctu, iflo, ifuo, jflv, jfuv, kflo, & 3653 3952 kfuo, ijfc_v, 'v' ) 3654 CALL pmci_anterp_tophat( w, wc, kctw, iflo, ifuo, jflo, jfuo, kflw, 3953 CALL pmci_anterp_tophat( w, wc, kctw, iflo, ifuo, jflo, jfuo, kflw, & 3655 3954 kfuw, ijfc_s, 'w' ) 3955 3656 3956 IF ( .NOT. neutral ) THEN 3657 CALL pmci_anterp_tophat( pt, ptc, kctu, iflo, ifuo, jflo, jfuo, kflo, 3957 CALL pmci_anterp_tophat( pt, ptc, kctu, iflo, ifuo, jflo, jfuo, kflo, & 3658 3958 kfuo, ijfc_s, 's' ) 3659 3959 ENDIF 3960 3660 3961 IF ( humidity ) THEN 3661 CALL pmci_anterp_tophat( q, qc, kctu, iflo, ifuo, jflo, jfuo, kflo, & 3962 3963 CALL pmci_anterp_tophat( q, q_c, kctu, iflo, ifuo, jflo, jfuo, kflo, & 3662 3964 kfuo, ijfc_s, 's' ) 3965 3966 IF ( cloud_physics .AND. microphysics_seifert ) THEN 3967 3968 ! CALL pmci_anterp_tophat( qc, qcc, kctu, iflo, ifuo, jflo, jfuo, & 3969 ! kflo, kfuo, ijfc_s, 's' ) 3970 3971 CALL pmci_anterp_tophat( qr, qrc, kctu, iflo, ifuo, jflo, jfuo, & 3972 kflo, kfuo, ijfc_s, 's' ) 3973 3974 ! CALL pmci_anterp_tophat( nc, ncc, kctu, iflo, ifuo, jflo, jfuo, & 3975 ! kflo, kfuo, ijfc_s, 's' ) 3976 3977 CALL pmci_anterp_tophat( nr, nrc, kctu, iflo, ifuo, jflo, jfuo, & 3978 kflo, kfuo, ijfc_s, 's' ) 3979 3980 ENDIF 3981 3663 3982 ENDIF 3983 3664 3984 IF ( passive_scalar ) THEN 3665 CALL pmci_anterp_tophat( s, sc, kctu, iflo, ifuo, jflo, jfuo, kflo, 3985 CALL pmci_anterp_tophat( s, sc, kctu, iflo, ifuo, jflo, jfuo, kflo, & 3666 3986 kfuo, ijfc_s, 's' ) 3667 3987 ENDIF … … 4389 4709 INTEGER(iwp) :: k !: Fine-grid index 4390 4710 INTEGER(iwp) :: kk !: Coarse-grid index 4391 INTEGER(iwp) :: kcb 4711 INTEGER(iwp) :: kcb = 0 !: 4392 4712 INTEGER(iwp) :: nfc !: 4393 4713 … … 4458 4778 jcnm = jcn - nhln 4459 4779 ENDIF 4460 kcb = 04461 4780 ENDIF 4462 4781 … … 4485 4804 ! 4486 4805 !-- Block out the fine-grid corner patches from the anterpolation 4487 IF ( ( ifl(ii) < nxl ) .OR. ( ifu(ii) > nxr ) ) THEN4488 IF ( ( jfl(jj) < nys ) .OR. ( jfu(jj) > nyn ) ) THEN4489 fra = 0.0_wp4490 ENDIF4491 ENDIF4806 ! IF ( ( ifl(ii) < nxl ) .OR. ( ifu(ii) > nxr ) ) THEN 4807 ! IF ( ( jfl(jj) < nys ) .OR. ( jfu(jj) > nyn ) ) THEN 4808 ! fra = 0.0_wp 4809 ! ENDIF 4810 ! ENDIF 4492 4811 4493 4812 fc(kk,jj,ii) = ( 1.0_wp - fra ) * fc(kk,jj,ii) + &
Note: See TracChangeset
for help on using the changeset viewer.
