Changeset 3880 for palm/trunk/SOURCE
- Timestamp:
- Apr 8, 2019 9:43:02 PM (6 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 4 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/Makefile
r3877 r3880 1513 1513 buoyancy.o \ 1514 1514 chemistry_model_mod.o \ 1515 chem_gasphase_mod.o \1516 chem_modules.o \1517 chem_photolysis_mod.o \1518 1515 coriolis.o \ 1519 1516 cpulog_mod.o \ -
palm/trunk/SOURCE/chemistry_model_mod.f90
r3879 r3880 285 285 MODULE chemistry_model_mod 286 286 287 USE advec_s_pw_mod, & 288 ONLY: advec_s_pw 289 290 USE advec_s_up_mod, & 291 ONLY: advec_s_up 292 293 USE advec_ws, & 294 ONLY: advec_s_ws 295 296 USE diffusion_s_mod, & 297 ONLY: diffusion_s 298 287 299 USE kinds, & 288 300 ONLY: iwp, wp 289 301 290 302 USE indices, & 291 ONLY: nbgp, n z, nzb, nzt, nysg, nyng, nxlg, nxrg, nys, nyn, nx, nxl, nxr, ny, wall_flags_0303 ONLY: nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nz, nzb, nzt, wall_flags_0 292 304 293 305 USE pegrid, & … … 319 331 USE statistics 320 332 333 USE surface_mod, & 334 ONLY: surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v 335 321 336 IMPLICIT NONE 337 322 338 PRIVATE 323 339 SAVE … … 614 630 SUBROUTINE chem_3d_data_averaging( mode, variable ) 615 631 632 616 633 USE control_parameters 617 618 USE indices619 620 USE kinds621 622 USE surface_mod, &623 ONLY: surf_def_h, surf_lsm_h, surf_usm_h624 625 IMPLICIT NONE626 634 627 635 CHARACTER (LEN=*) :: mode !< … … 736 744 ONLY: bc_radiation_l, bc_radiation_n, bc_radiation_r, bc_radiation_s 737 745 738 USE indices, &739 ONLY: nxl, nxr, nzt740 741 746 USE arrays_3d, & 742 747 ONLY: dzu … … 873 878 ! ------------ 874 879 !> Boundary conditions for prognostic variables in chemistry: decycling in the 875 !> x-direction 880 !> x-direction- 881 !> Decycling of chemistry variables: Dirichlet BCs with cyclic is frequently not 882 !> approproate for chemicals compounds since they may accumulate too much. 883 !> If no proper boundary conditions from a DYNAMIC input file are available, 884 !> de-cycling applies the initial profiles at the inflow boundaries for 885 !> Dirichlet boundary conditions 876 886 !------------------------------------------------------------------------------! 877 887 SUBROUTINE chem_boundary_conds_decycle() 878 ! 879 !-- Decycling of chemistry variables: Dirichlet BCs with cyclic is frequently not 880 !-- approproate for chemicals compounds since they may accumulate too much. 881 !-- If no proper boundary conditions from a DYNAMIC input file are available, 882 !-- de-cycling applies the initial profiles at the inflow boundaries for 883 !-- Dirichlet boundary conditions 884 885 IMPLICIT NONE 888 889 886 890 INTEGER(iwp) :: boundary !< 887 891 INTEGER(iwp) :: ee !< … … 1060 1064 SUBROUTINE chem_check_data_output( var, unit, i, ilen, k ) 1061 1065 1062 IMPLICIT NONE1063 1066 1064 1067 CHARACTER (LEN=*) :: unit !< … … 1129 1132 1130 1133 USE arrays_3d 1134 1131 1135 USE control_parameters, & 1132 1136 ONLY: data_output_pr, message_string 1133 USE indices 1137 1134 1138 USE profil_parameter 1139 1135 1140 USE statistics 1136 1141 1137 1138 IMPLICIT NONE1139 1142 1140 1143 CHARACTER (LEN=*) :: unit !< … … 1180 1183 SUBROUTINE chem_check_parameters 1181 1184 1182 IMPLICIT NONE1183 1185 1184 1186 LOGICAL :: found … … 1280 1282 two_d, nzb_do, nzt_do, fill_value ) 1281 1283 1282 USE indices1283 1284 USE kinds1285 1286 IMPLICIT NONE1287 1284 1288 1285 CHARACTER (LEN=*) :: grid !< … … 1364 1361 SUBROUTINE chem_data_output_3d( av, variable, found, local_pf, fill_value, nzb_do, nzt_do ) 1365 1362 1366 USE indices1367 1368 USE kinds1369 1363 1370 1364 USE surface_mod 1371 1372 1373 IMPLICIT NONE1374 1365 1375 1366 CHARACTER (LEN=*) :: variable !< … … 1478 1469 SUBROUTINE chem_data_output_mask( av, variable, found, local_pf ) 1479 1470 1471 1480 1472 USE control_parameters 1481 USE indices 1482 USE kinds 1473 1483 1474 USE surface_mod, & 1484 1475 ONLY: get_topography_top_index_ji 1485 1476 1486 IMPLICIT NONE1487 1477 1488 1478 CHARACTER(LEN=5) :: grid !< flag to distinquish between staggered grids … … 1607 1597 SUBROUTINE chem_define_netcdf_grid( var, found, grid_x, grid_y, grid_z ) 1608 1598 1609 IMPLICIT NONE1610 1599 1611 1600 CHARACTER (LEN=*), INTENT(IN) :: var !< … … 1639 1628 SUBROUTINE chem_header( io ) 1640 1629 1641 IMPLICIT NONE1642 1630 1643 1631 INTEGER(iwp), INTENT(IN) :: io !< Unit of the output file … … 1763 1751 ONLY: init_3d 1764 1752 1765 IMPLICIT NONE1766 1753 1767 1754 INTEGER(iwp) :: i !< running index x dimension … … 1809 1796 netcdf_data_input_chemistry_data 1810 1797 1811 IMPLICIT NONE1812 1798 ! 1813 1799 !-- Local variables … … 1970 1956 USE chem_modules 1971 1957 1972 IMPLICIT NONE1973 1958 ! 1974 1959 !-- Local variables … … 2053 2038 ONLY: dt_3d, intermediate_timestep_count, time_since_reference_point 2054 2039 2055 IMPLICIT NONE2056 2040 2057 2041 INTEGER,INTENT(IN) :: i … … 2163 2147 USE control_parameters 2164 2148 2165 USE kinds2166 2149 USE pegrid 2167 2150 USE statistics 2168 2151 2169 IMPLICIT NONE2170 2152 2171 2153 CHARACTER (LEN=80) :: line !< dummy string that contains the current line of the parameter file … … 2477 2459 !> prognostic_equations. 2478 2460 !------------------------------------------------------------------------------! 2479 SUBROUTINE chem_prognostic_equations( cs_scalar_p, cs_scalar, tcs_scalar_m, & 2480 pr_init_cs, ilsp ) 2481 2482 USE advec_s_pw_mod, & 2483 ONLY: advec_s_pw 2484 USE advec_s_up_mod, & 2485 ONLY: advec_s_up 2486 USE advec_ws, & 2487 ONLY: advec_s_ws 2488 USE diffusion_s_mod, & 2489 ONLY: diffusion_s 2490 USE indices, & 2491 ONLY: nxl, nxr, nyn, nys, wall_flags_0 2492 USE pegrid 2493 USE surface_mod, & 2494 ONLY: surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, & 2495 surf_usm_v 2496 2497 IMPLICIT NONE 2461 SUBROUTINE chem_prognostic_equations() 2462 2498 2463 2499 2464 INTEGER :: i !< running index … … 2501 2466 INTEGER :: k !< running index 2502 2467 2503 INTEGER(iwp) ,INTENT(IN) :: ilsp!<2504 2505 REAL(wp), DIMENSION(0:nz+1) :: pr_init_cs !< 2506 2507 REAL(wp), DIMENSION(:,:,:), POINTER :: cs_scalar !< 2508 REAL(wp), DIMENSION(:,:,:), POINTER :: cs_scalar_p !<2509 REAL(wp), DIMENSION(:,:,:), POINTER :: tcs_scalar_m !< 2510 2511 2512 ! 2513 !-- Tendency terms for chemical species2514 tend = 0.0_wp2515 ! 2516 !-- Advection terms 2517 IF ( timestep_scheme(1:5) == 'runge' ) THEN2518 IF ( ws_scheme_sca ) THEN2519 CALL advec_s_ws( cs_scalar, 'kc' )2468 INTEGER(iwp) :: ilsp !< 2469 2470 2471 CALL cpu_log( log_point_s(25), 'chem.advec+diff+prog', 'start' ) 2472 2473 DO ilsp = 1, nspec 2474 ! 2475 !-- Tendency terms for chemical species 2476 tend = 0.0_wp 2477 ! 2478 !-- Advection terms 2479 IF ( timestep_scheme(1:5) == 'runge' ) THEN 2480 IF ( ws_scheme_sca ) THEN 2481 CALL advec_s_ws( chem_species(ilsp)%conc, 'kc' ) 2482 ELSE 2483 CALL advec_s_pw( chem_species(ilsp)%conc ) 2484 ENDIF 2520 2485 ELSE 2521 CALL advec_s_ pw( cs_scalar)2486 CALL advec_s_up( chem_species(ilsp)%conc ) 2522 2487 ENDIF 2523 ELSE 2524 CALL advec_s_up( cs_scalar)2525 ENDIF2526 ! 2527 !-- Diffusion terms (the last three arguments are zero) 2528 CALL diffusion_s( cs_scalar,&2529 surf_def_h(0)%cssws(ilsp,:),&2530 surf_def_h(1)%cssws(ilsp,:),&2531 surf_def_h(2)%cssws(ilsp,:),&2532 surf_lsm_h%cssws(ilsp,:),&2533 surf_usm_h%cssws(ilsp,:),&2534 surf_def_v(0)%cssws(ilsp,:),&2535 surf_def_v(1)%cssws(ilsp,:),&2536 surf_def_v(2)%cssws(ilsp,:),&2537 surf_def_v(3)%cssws(ilsp,:),&2538 surf_lsm_v(0)%cssws(ilsp,:),&2539 surf_lsm_v(1)%cssws(ilsp,:),&2540 surf_lsm_v(2)%cssws(ilsp,:),&2541 surf_lsm_v(3)%cssws(ilsp,:),&2542 surf_usm_v(0)%cssws(ilsp,:), &2543 surf_usm_v(1)%cssws(ilsp,:), & 2544 surf_usm_v(2)%cssws(ilsp,:), & 2545 surf_usm_v(3)%cssws(ilsp,:) )2546 ! 2547 !-- Prognostic equation for chemical species 2548 DO i = nxl, nxr2549 DO j = nys, nyn2550 DO k = nzb+1, nzt2551 cs_scalar_p(k,j,i) = cs_scalar(k,j,i)&2552 + ( dt_3d *&2553 ( tsc(2) * tend(k,j,i)&2554 + tsc(3) * tcs_scalar_m(k,j,i)&2555 ) &2556 - tsc(5) * rdf_sc(k) &2557 * ( cs_scalar(k,j,i) - pr_init_cs(k) ) & 2558 ) &2559 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )2560 2561 IF ( cs_scalar_p(k,j,i) < 0.0_wp ) cs_scalar_p(k,j,i) = 0.1_wp * cs_scalar(k,j,i)2488 ! 2489 !-- Diffusion terms (the last three arguments are zero) 2490 CALL diffusion_s( chem_species(ilsp)%conc, & 2491 surf_def_h(0)%cssws(ilsp,:), & 2492 surf_def_h(1)%cssws(ilsp,:), & 2493 surf_def_h(2)%cssws(ilsp,:), & 2494 surf_lsm_h%cssws(ilsp,:), & 2495 surf_usm_h%cssws(ilsp,:), & 2496 surf_def_v(0)%cssws(ilsp,:), & 2497 surf_def_v(1)%cssws(ilsp,:), & 2498 surf_def_v(2)%cssws(ilsp,:), & 2499 surf_def_v(3)%cssws(ilsp,:), & 2500 surf_lsm_v(0)%cssws(ilsp,:), & 2501 surf_lsm_v(1)%cssws(ilsp,:), & 2502 surf_lsm_v(2)%cssws(ilsp,:), & 2503 surf_lsm_v(3)%cssws(ilsp,:), & 2504 surf_usm_v(0)%cssws(ilsp,:), & 2505 surf_usm_v(1)%cssws(ilsp,:), & 2506 surf_usm_v(2)%cssws(ilsp,:), & 2507 surf_usm_v(3)%cssws(ilsp,:) ) 2508 ! 2509 !-- Prognostic equation for chemical species 2510 DO i = nxl, nxr 2511 DO j = nys, nyn 2512 DO k = nzb+1, nzt 2513 chem_species(ilsp)%conc_p(k,j,i) = chem_species(ilsp)%conc(k,j,i) & 2514 + ( dt_3d * & 2515 ( tsc(2) * tend(k,j,i) & 2516 + tsc(3) * chem_species(ilsp)%tconc_m(k,j,i) & 2517 ) & 2518 - tsc(5) * rdf_sc(k) & 2519 * ( chem_species(ilsp)%conc(k,j,i) - chem_species(ilsp)%conc_pr_init(k) ) & 2520 ) & 2521 * MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) 2522 2523 IF ( chem_species(ilsp)%conc_p(k,j,i) < 0.0_wp ) THEN 2524 chem_species(ilsp)%conc_p(k,j,i) = 0.1_wp * chem_species(ilsp)%conc(k,j,i) 2525 ENDIF 2526 ENDDO 2562 2527 ENDDO 2563 2528 ENDDO 2564 ENDDO 2565 ! 2566 !-- Calculate tendencies for the next Runge-Kutta step 2567 IF ( timestep_scheme(1:5) == 'runge') THEN2568 IF ( intermediate_timestep_count == 1 ) THEN2569 DO i = nxl, nxr2570 DO j = nys, nyn2571 DO k = nzb+1, nzt2572 tcs_scalar_m(k,j,i) = tend(k,j,i)2529 ! 2530 !-- Calculate tendencies for the next Runge-Kutta step 2531 IF ( timestep_scheme(1:5) == 'runge' ) THEN 2532 IF ( intermediate_timestep_count == 1 ) THEN 2533 DO i = nxl, nxr 2534 DO j = nys, nyn 2535 DO k = nzb+1, nzt 2536 chem_species(ilsp)%tconc_m(k,j,i) = tend(k,j,i) 2537 ENDDO 2573 2538 ENDDO 2574 2539 ENDDO 2575 E NDDO2576 ELSEIF ( intermediate_timestep_count < &2577 intermediate_timestep_count_max ) THEN2578 DO i = nxl, nxr2579 DO j = nys, nyn2580 DO k = nzb+1, nzt2581 tcs_scalar_m(k,j,i) = - 9.5625_wp * tend(k,j,i) &2582 + 5.3125_wp * tcs_scalar_m(k,j,i)2540 ELSEIF ( intermediate_timestep_count < & 2541 intermediate_timestep_count_max ) THEN 2542 DO i = nxl, nxr 2543 DO j = nys, nyn 2544 DO k = nzb+1, nzt 2545 chem_species(ilsp)%tconc_m(k,j,i) = - 9.5625_wp * tend(k,j,i) & 2546 + 5.3125_wp * chem_species(ilsp)%tconc_m(k,j,i) 2547 ENDDO 2583 2548 ENDDO 2584 2549 ENDDO 2585 END DO2550 ENDIF 2586 2551 ENDIF 2587 ENDIF 2552 2553 ENDDO 2554 2555 CALL cpu_log( log_point_s(25), 'chem.advec+diff+prog', 'stop' ) 2588 2556 2589 2557 END SUBROUTINE chem_prognostic_equations … … 2598 2566 !> prognostic_equations. 2599 2567 !------------------------------------------------------------------------------! 2600 SUBROUTINE chem_prognostic_equations_ij( cs_scalar_p, cs_scalar, tcs_scalar_m, & 2601 pr_init_cs, i, j, i_omp_start, tn, ilsp, flux_s_cs, diss_s_cs, & 2602 flux_l_cs, diss_l_cs ) 2603 USE pegrid 2604 USE advec_ws, & 2605 ONLY: advec_s_ws 2606 USE advec_s_pw_mod, & 2607 ONLY: advec_s_pw 2608 USE advec_s_up_mod, & 2609 ONLY: advec_s_up 2610 USE diffusion_s_mod, & 2611 ONLY: diffusion_s 2612 USE indices, & 2613 ONLY: wall_flags_0 2614 USE surface_mod, & 2615 ONLY: surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h, surf_usm_v 2616 2617 2618 IMPLICIT NONE 2619 2620 REAL(wp), DIMENSION(:,:,:), POINTER :: cs_scalar_p, cs_scalar, tcs_scalar_m 2621 2622 INTEGER(iwp),INTENT(IN) :: i, j, i_omp_start, tn, ilsp 2623 REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) :: flux_s_cs !< 2624 REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1) :: diss_s_cs !< 2625 REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) :: flux_l_cs !< 2626 REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) :: diss_l_cs !< 2627 REAL(wp), DIMENSION(0:nz+1) :: pr_init_cs !< 2628 2568 SUBROUTINE chem_prognostic_equations_ij( i, j, i_omp_start, tn ) 2569 2570 2571 INTEGER(iwp),INTENT(IN) :: i, j, i_omp_start, tn 2572 INTEGER(iwp) :: ilsp 2629 2573 ! 2630 2574 !-- local variables 2631 2575 2632 2576 INTEGER :: k 2577 2578 DO ilsp = 1, nspec 2633 2579 ! 2634 2580 !-- Tendency-terms for chem spcs. 2635 tend(:,j,i) = 0.0_wp 2636 ! 2637 !-- Advection terms 2638 IF ( timestep_scheme(1:5) == 'runge' ) THEN 2639 IF ( ws_scheme_sca ) THEN 2640 CALL advec_s_ws( i, j, cs_scalar, 'kc', flux_s_cs, diss_s_cs, & 2641 flux_l_cs, diss_l_cs, i_omp_start, tn ) 2581 tend(:,j,i) = 0.0_wp 2582 ! 2583 !-- Advection terms 2584 IF ( timestep_scheme(1:5) == 'runge' ) THEN 2585 IF ( ws_scheme_sca ) THEN 2586 CALL advec_s_ws( i, j, chem_species(ilsp)%conc, 'kc', chem_species(ilsp)%flux_s_cs, & 2587 chem_species(ilsp)%diss_s_cs, chem_species(ilsp)%flux_l_cs, & 2588 chem_species(ilsp)%diss_l_cs, i_omp_start, tn ) 2589 ELSE 2590 CALL advec_s_pw( i, j, chem_species(ilsp)%conc ) 2591 ENDIF 2642 2592 ELSE 2643 CALL advec_s_ pw( i, j, cs_scalar)2593 CALL advec_s_up( i, j, chem_species(ilsp)%conc ) 2644 2594 ENDIF 2645 ELSE 2646 CALL advec_s_up( i, j, cs_scalar ) 2647 ENDIF 2648 ! 2649 !-- Diffusion terms (the last three arguments are zero) 2650 2651 CALL diffusion_s( i, j, cs_scalar, & 2652 surf_def_h(0)%cssws(ilsp,:), surf_def_h(1)%cssws(ilsp,:), & 2653 surf_def_h(2)%cssws(ilsp,:), & 2654 surf_lsm_h%cssws(ilsp,:), surf_usm_h%cssws(ilsp,:), & 2655 surf_def_v(0)%cssws(ilsp,:), surf_def_v(1)%cssws(ilsp,:), & 2656 surf_def_v(2)%cssws(ilsp,:), surf_def_v(3)%cssws(ilsp,:), & 2657 surf_lsm_v(0)%cssws(ilsp,:), surf_lsm_v(1)%cssws(ilsp,:), & 2658 surf_lsm_v(2)%cssws(ilsp,:), surf_lsm_v(3)%cssws(ilsp,:), & 2659 surf_usm_v(0)%cssws(ilsp,:), surf_usm_v(1)%cssws(ilsp,:), & 2660 surf_usm_v(2)%cssws(ilsp,:), surf_usm_v(3)%cssws(ilsp,:) ) 2661 ! 2662 !-- Prognostic equation for chem spcs 2663 DO k = nzb+1, nzt 2664 cs_scalar_p(k,j,i) = cs_scalar(k,j,i) + ( dt_3d * & 2665 ( tsc(2) * tend(k,j,i) + & 2666 tsc(3) * tcs_scalar_m(k,j,i) ) & 2667 - tsc(5) * rdf_sc(k) & 2668 * ( cs_scalar(k,j,i) - pr_init_cs(k) ) & 2669 ) & 2670 * MERGE( 1.0_wp, 0.0_wp, & 2671 BTEST( wall_flags_0(k,j,i), 0 ) & 2672 ) 2673 2674 IF ( cs_scalar_p(k,j,i) < 0.0_wp ) cs_scalar_p(k,j,i) = 0.1_wp * cs_scalar(k,j,i) !FKS6 2595 ! 2596 !-- Diffusion terms (the last three arguments are zero) 2597 2598 CALL diffusion_s( i, j, chem_species(ilsp)%conc, & 2599 surf_def_h(0)%cssws(ilsp,:), surf_def_h(1)%cssws(ilsp,:), & 2600 surf_def_h(2)%cssws(ilsp,:), & 2601 surf_lsm_h%cssws(ilsp,:), surf_usm_h%cssws(ilsp,:), & 2602 surf_def_v(0)%cssws(ilsp,:), surf_def_v(1)%cssws(ilsp,:), & 2603 surf_def_v(2)%cssws(ilsp,:), surf_def_v(3)%cssws(ilsp,:), & 2604 surf_lsm_v(0)%cssws(ilsp,:), surf_lsm_v(1)%cssws(ilsp,:), & 2605 surf_lsm_v(2)%cssws(ilsp,:), surf_lsm_v(3)%cssws(ilsp,:), & 2606 surf_usm_v(0)%cssws(ilsp,:), surf_usm_v(1)%cssws(ilsp,:), & 2607 surf_usm_v(2)%cssws(ilsp,:), surf_usm_v(3)%cssws(ilsp,:) ) 2608 ! 2609 !-- Prognostic equation for chem spcs 2610 DO k = nzb+1, nzt 2611 chem_species(ilsp)%conc_p(k,j,i) = chem_species(ilsp)%conc(k,j,i) + ( dt_3d * & 2612 ( tsc(2) * tend(k,j,i) + & 2613 tsc(3) * chem_species(ilsp)%tconc_m(k,j,i) ) & 2614 - tsc(5) * rdf_sc(k) & 2615 * ( chem_species(ilsp)%conc(k,j,i) - chem_species(ilsp)%conc_pr_init(k) ) & 2616 ) & 2617 * MERGE( 1.0_wp, 0.0_wp, & 2618 BTEST( wall_flags_0(k,j,i), 0 ) & 2619 ) 2620 2621 IF ( chem_species(ilsp)%conc_p(k,j,i) < 0.0_wp ) THEN 2622 chem_species(ilsp)%conc_p(k,j,i) = 0.1_wp * chem_species(ilsp)%conc(k,j,i) !FKS6 2623 ENDIF 2624 ENDDO 2625 ! 2626 !-- Calculate tendencies for the next Runge-Kutta step 2627 IF ( timestep_scheme(1:5) == 'runge' ) THEN 2628 IF ( intermediate_timestep_count == 1 ) THEN 2629 DO k = nzb+1, nzt 2630 chem_species(ilsp)%tconc_m(k,j,i) = tend(k,j,i) 2631 ENDDO 2632 ELSEIF ( intermediate_timestep_count < & 2633 intermediate_timestep_count_max ) THEN 2634 DO k = nzb+1, nzt 2635 chem_species(ilsp)%tconc_m(k,j,i) = -9.5625_wp * tend(k,j,i) + & 2636 5.3125_wp * chem_species(ilsp)%tconc_m(k,j,i) 2637 ENDDO 2638 ENDIF 2639 ENDIF 2640 2675 2641 ENDDO 2676 !2677 !-- Calculate tendencies for the next Runge-Kutta step2678 IF ( timestep_scheme(1:5) == 'runge' ) THEN2679 IF ( intermediate_timestep_count == 1 ) THEN2680 DO k = nzb+1, nzt2681 tcs_scalar_m(k,j,i) = tend(k,j,i)2682 ENDDO2683 ELSEIF ( intermediate_timestep_count < &2684 intermediate_timestep_count_max ) THEN2685 DO k = nzb+1, nzt2686 tcs_scalar_m(k,j,i) = -9.5625_wp * tend(k,j,i) + &2687 5.3125_wp * tcs_scalar_m(k,j,i)2688 ENDDO2689 ENDIF2690 ENDIF2691 2642 2692 2643 END SUBROUTINE chem_prognostic_equations_ij … … 2704 2655 USE control_parameters 2705 2656 2706 USE indices2707 2708 USE pegrid2709 2710 IMPLICIT NONE2711 2657 2712 2658 CHARACTER (LEN=20) :: spc_name_av !< … … 2778 2724 2779 2725 USE arrays_3d 2780 USE indices 2781 USE kinds 2782 USE pegrid 2726 2783 2727 USE statistics 2784 2728 2785 IMPLICIT NONE2786 2729 2787 2730 CHARACTER (LEN=*) :: mode !< … … 2837 2780 SUBROUTINE chem_swap_timelevel( level ) 2838 2781 2839 IMPLICIT NONE2840 2782 2841 2783 INTEGER(iwp), INTENT(IN) :: level … … 2868 2810 SUBROUTINE chem_wrd_local 2869 2811 2870 2871 IMPLICIT NONE2872 2812 2873 2813 INTEGER(iwp) :: lsp !< running index for chem spcs. … … 2953 2893 ONLY: cos_zenith 2954 2894 2955 2956 IMPLICIT NONE2957 2895 2958 2896 INTEGER(iwp), INTENT(IN) :: i … … 4470 4408 !-- calc_stom_o3flux, frac_sto_o3_lu, fac_surface_area_2_PLA) 4471 4409 4472 IMPLICIT NONE4473 4410 4474 4411 CHARACTER(LEN=*), INTENT(IN) :: compnam !< component name … … 4638 4575 SUBROUTINE rc_special( icmp, compnam, lu, t, nwet, rc_tot, ready, ccomp_tot ) 4639 4576 4640 IMPLICIT NONE4641 4577 4642 4578 CHARACTER(LEN=*), INTENT(IN) :: compnam !< component name … … 4710 4646 SUBROUTINE rc_gw( compnam, iratns, t, rh, nwet, sai_present, sai, gw ) 4711 4647 4712 IMPLICIT NONE4713 4648 ! 4714 4649 !-- Input/output variables: … … 4763 4698 SUBROUTINE rw_so2( t, nwet, rh, iratns, sai_present, gw ) 4764 4699 4765 IMPLICIT NONE4766 4700 ! 4767 4701 !-- Input/output variables: … … 4835 4769 SUBROUTINE rw_nh3_sutton( tsurf, rh,sai_present, gw ) 4836 4770 4837 IMPLICIT NONE4838 4771 ! 4839 4772 !-- Input/output variables: … … 4883 4816 SUBROUTINE rw_constant( rw_val, sai_present, gw ) 4884 4817 4885 IMPLICIT NONE4886 4818 ! 4887 4819 !-- Input/output variables: … … 4909 4841 SUBROUTINE rc_gstom( icmp, compnam, lu, lai_present, lai, solar_rad, sinphi, t, rh, diffusivity, gstom, p ) 4910 4842 4911 IMPLICIT NONE4912 4843 ! 4913 4844 !-- input/output variables: … … 5006 4937 !> 8 = other GR = grassland 5007 4938 !> 9 = desert DE = desert 5008 5009 IMPLICIT NONE5010 4939 ! 5011 4940 !-- Emberson specific declarations … … 5144 5073 SUBROUTINE par_dir_diff( solar_rad, sinphi, pres, pres_0, par_dir, par_diff ) 5145 5074 5146 IMPLICIT NONE5147 5075 5148 5076 REAL(wp), INTENT(IN) :: solar_rad !< solar radiation, dirict+diffuse (W m-2) … … 5211 5139 SUBROUTINE rc_get_vpd( temp, rh, vpd ) 5212 5140 5213 IMPLICIT NONE5214 5141 ! 5215 5142 !-- Input/output variables: … … 5242 5169 SUBROUTINE rc_gsoil_eff( icmp, lu, sai, ust, nwet, t, gsoil_eff ) 5243 5170 5244 IMPLICIT NONE5245 5171 ! 5246 5172 !-- Input/output variables: … … 5333 5259 !------------------------------------------------------------------- 5334 5260 SUBROUTINE rc_rinc( lu, sai, ust, rinc ) 5335 5336 IMPLICIT NONE5337 5261 5338 5262 ! … … 5376 5300 !------------------------------------------------------------------- 5377 5301 SUBROUTINE rc_rctot( gstom, gsoil_eff, gw, gc_tot, rc_tot ) 5378 5379 IMPLICIT NONE5380 5302 5381 5303 ! … … 5463 5385 ! SUBROUTINE rc_comp_point_rc_eff( ccomp_tot, conc_ijk_ugm3, ra, rb, rc_tot, rc_eff ) 5464 5386 ! 5465 ! IMPLICIT NONE5466 5387 ! 5467 5388 !!-- Input/output variables: … … 5522 5443 ELEMENTAL FUNCTION sedimentation_velocity( rhopart, partsize, slipcor, visc ) RESULT( vs ) 5523 5444 5524 IMPLICIT NONE5525 5526 5445 ! 5527 5446 !-- in/out … … 5548 5467 SUBROUTINE drydepo_aero_zhang_vd( vd, rs, vs1, partsize, slipcor, nwet, tsurf, dens1, viscos1, & 5549 5468 luc, ftop_lu, ustar ) 5550 5551 IMPLICIT NONE5552 5469 5553 5470 ! … … 5652 5569 !------------------------------------------------------------------------------------- 5653 5570 SUBROUTINE get_rb_cell( is_water, z0h, ustar, diffusivity, rb ) 5654 5655 5656 IMPLICIT NONE5657 5571 5658 5572 ! … … 5712 5626 ELEMENTAL FUNCTION watervaporpartialpressure( q, p ) RESULT( p_w ) 5713 5627 5714 IMPLICIT NONE5715 5716 5628 ! 5717 5629 !-- in/out … … 5753 5665 ELEMENTAL FUNCTION saturationvaporpressure( t ) RESULT( e_sat_w ) 5754 5666 5755 5756 IMPLICIT NONE5757 5758 5667 ! 5759 5668 !-- in/out … … 5782 5691 ELEMENTAL FUNCTION relativehumidity_from_specifichumidity( q, t, p ) RESULT( rh ) 5783 5692 5784 5785 IMPLICIT NONE5786 5787 5693 ! 5788 5694 !-- in/out -
palm/trunk/SOURCE/module_interface.f90
r3878 r3880 168 168 chem_actions, & 169 169 chem_non_transport_physics, & 170 chem_prognostic_equations, & 170 171 chem_swap_timelevel, & 171 172 chem_3d_data_averaging, & … … 970 971 971 972 IF ( bulk_cloud_model ) CALL bcm_prognostic_equations() 973 IF ( air_chemistry ) CALL chem_prognostic_equations() 972 974 IF ( gust_module_enabled ) CALL gust_prognostic_equations() 973 975 IF ( ocean_mode ) CALL ocean_prognostic_equations() … … 993 995 994 996 IF ( bulk_cloud_model ) CALL bcm_prognostic_equations( i, j, i_omp_start, tn ) 997 IF ( air_chemistry ) CALL chem_prognostic_equations( i, j, i_omp_start, tn ) 995 998 IF ( gust_module_enabled ) CALL gust_prognostic_equations( i, j, i_omp_start, tn ) 996 999 IF ( ocean_mode ) CALL ocean_prognostic_equations( i, j, i_omp_start, tn ) -
palm/trunk/SOURCE/prognostic_equations.f90
r3879 r3880 387 387 ONLY: buoyancy 388 388 389 USE chem_modules, &390 ONLY: chem_gasphase_on, deposition_dry, chem_species391 392 USE chem_gasphase_mod, &393 ONLY: nspec, spc_names394 395 389 USE chemistry_model_mod, & 396 ONLY: chem_boundary_conds_decycle , chem_prognostic_equations390 ONLY: chem_boundary_conds_decycle 397 391 398 392 USE control_parameters, & … … 518 512 519 513 LOGICAL :: loop_start !< 520 INTEGER(iwp) :: lsp521 514 522 515 … … 1113 1106 CALL module_interface_prognostic_equations( i, j, i_omp_start, tn ) 1114 1107 1115 !1116 !-- Calculate prognostic equation for chemical quantites1117 IF ( air_chemistry ) THEN1118 !> TODO: remove time measurement since it slows down performance because it will be called extremely often1119 !1120 !-- Loop over chemical species1121 DO lsp = 1, nspec1122 CALL chem_prognostic_equations( chem_species(lsp)%conc_p, &1123 chem_species(lsp)%conc, &1124 chem_species(lsp)%tconc_m, &1125 chem_species(lsp)%conc_pr_init, &1126 i, j, i_omp_start, tn, lsp, &1127 chem_species(lsp)%flux_s_cs, &1128 chem_species(lsp)%diss_s_cs, &1129 chem_species(lsp)%flux_l_cs, &1130 chem_species(lsp)%diss_l_cs )1131 ENDDO1132 1133 ENDIF ! Chemical equations1134 1135 1108 ENDDO ! loop over j 1136 1109 ENDDO ! loop over i … … 1160 1133 INTEGER(iwp) :: j !< 1161 1134 INTEGER(iwp) :: k !< 1162 INTEGER(iwp) :: lsp !< running index for chemical species1163 1135 1164 1136 REAL(wp) :: sbt !< … … 1895 1867 CALL module_interface_prognostic_equations() 1896 1868 1897 !1898 !-- Calculate prognostic equation for chemical quantites1899 IF ( air_chemistry ) THEN1900 CALL cpu_log( log_point_s(25), 'chem.advec+diff+prog', 'start' )1901 !1902 !-- Loop over chemical species1903 DO lsp = 1, nspec1904 CALL chem_prognostic_equations( chem_species(lsp)%conc_p, &1905 chem_species(lsp)%conc, &1906 chem_species(lsp)%tconc_m, &1907 chem_species(lsp)%conc_pr_init, &1908 lsp )1909 ENDDO1910 1911 CALL cpu_log( log_point_s(25), 'chem.advec+diff+prog', 'stop' )1912 ENDIF ! Chemicals equations1913 1914 1869 END SUBROUTINE prognostic_equations_vector 1915 1870
Note: See TracChangeset
for help on using the changeset viewer.