Changeset 3929
- Timestamp:
- Apr 24, 2019 12:52:08 PM (6 years ago)
- Location:
- palm/trunk/SOURCE
- Files:
-
- 4 edited
-
chemistry_model_mod.f90 (modified) (23 diffs)
-
module_interface.f90 (modified) (3 diffs)
-
prognostic_equations.f90 (modified) (3 diffs)
-
time_integration.f90 (modified) (6 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/chemistry_model_mod.f90
r3898 r3929 26 26 ! Former revisions: 27 27 ! ----------------- 28 ! $Id: chemistry_model_mod.f90 3784 2019-03-05 14:16:20Z banzhafs 28 ! $Id$ 29 ! Correct/complete module_interface introduction for chemistry model 30 ! Add subroutine chem_exchange_horiz_bounds 31 ! Bug fix deposition 32 ! 33 ! 3784 2019-03-05 14:16:20Z banzhafs 29 34 ! 2D output of emission fluxes 30 35 ! … … 324 329 debug_output, & 325 330 dt_3d, humidity, initializing_actions, message_string, & 326 omega, tsc, intermediate_timestep_count, intermediate_timestep_count_max,&331 omega, tsc, intermediate_timestep_count, intermediate_timestep_count_max, & 327 332 max_pr_user, timestep_scheme, use_prescribed_profile_data, ws_scheme_sca, air_chemistry 328 333 … … 458 463 INTERFACE chem_boundary_conds 459 464 MODULE PROCEDURE chem_boundary_conds 465 MODULE PROCEDURE chem_boundary_conds_decycle 460 466 END INTERFACE chem_boundary_conds 461 462 INTERFACE chem_boundary_conds_decycle463 MODULE PROCEDURE chem_boundary_conds_decycle464 END INTERFACE chem_boundary_conds_decycle465 467 466 468 INTERFACE chem_check_data_output … … 526 528 END INTERFACE chem_non_transport_physics 527 529 528 INTERFACE chem_exchange_horiz 529 MODULE PROCEDURE chem_exchange_horiz 530 END INTERFACE chem_exchange_horiz 530 INTERFACE chem_exchange_horiz_bounds 531 MODULE PROCEDURE chem_exchange_horiz_bounds 532 END INTERFACE chem_exchange_horiz_bounds 531 533 532 534 INTERFACE chem_prognostic_equations … … 629 631 chem_actions, chem_prognostic_equations, chem_rrd_local, & 630 632 chem_statistics, chem_swap_timelevel, chem_wrd_local, chem_depo, & 631 chem_non_transport_physics, chem_exchange_horiz 633 chem_non_transport_physics, chem_exchange_horiz_bounds 632 634 633 635 CONTAINS … … 902 904 !> Dirichlet boundary conditions 903 905 !------------------------------------------------------------------------------! 904 SUBROUTINE chem_boundary_conds_decycle() 905 906 907 INTEGER(iwp) :: boundary !< 908 INTEGER(iwp) :: ee !< 909 INTEGER(iwp) :: copied !< 910 INTEGER(iwp) :: i !< 911 INTEGER(iwp) :: j !< 912 INTEGER(iwp) :: k !< 913 INTEGER(iwp) :: ss !< 914 INTEGER(iwp) :: lsp !< 915 INTEGER(iwp) :: lsp_usr !< 916 REAL(wp), DIMENSION(nzb:nzt+1) :: cs_pr_init 917 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: cs_3d 918 REAL(wp) :: flag !< flag to mask topography grid points 919 920 CALL cpu_log( log_point_s(84), 'chem.exch-horiz', 'start' ) 921 922 DO lsp = 1, nspec 923 924 CALL exchange_horiz( chem_species(lsp)%conc, nbgp ) 925 lsp_usr = 1 926 DO WHILE ( TRIM( cs_name( lsp_usr ) ) /= 'novalue' ) 927 IF ( TRIM(chem_species(lsp)%name) == TRIM(cs_name(lsp_usr)) ) THEN 928 929 cs_3d = chem_species(lsp)%conc_p 930 cs_pr_init = chem_species(lsp)%conc_pr_init 931 932 flag = 0.0_wp 933 ! 934 !-- Left and right boundaries 935 IF ( decycle_chem_lr .AND. bc_lr_cyc ) THEN 936 937 DO boundary = 1, 2 938 939 IF ( decycle_method(boundary) == 'dirichlet' ) THEN 940 ! 941 !-- Initial profile is copied to ghost and first three layers 942 ss = 1 943 ee = 0 944 IF ( boundary == 1 .AND. nxl == 0 ) THEN 945 ss = nxlg 946 ee = nxl+2 947 ELSEIF ( boundary == 2 .AND. nxr == nx ) THEN 948 ss = nxr-2 949 ee = nxrg 950 ENDIF 951 952 DO i = ss, ee 953 DO j = nysg, nyng 954 DO k = nzb+1, nzt 955 flag = MERGE( 1.0_wp, 0.0_wp, & 956 BTEST( wall_flags_0(k,j,i), 0 ) ) 957 cs_3d(k,j,i) = cs_pr_init(k) * flag 958 ENDDO 959 ENDDO 960 ENDDO 961 962 ELSEIF ( decycle_method(boundary) == 'neumann' ) THEN 963 ! 964 !-- The value at the boundary is copied to the ghost layers to simulate 965 !-- an outlet with zero gradient 966 ss = 1 967 ee = 0 968 IF ( boundary == 1 .AND. nxl == 0 ) THEN 969 ss = nxlg 970 ee = nxl-1 971 copied = nxl 972 ELSEIF ( boundary == 2 .AND. nxr == nx ) THEN 973 ss = nxr+1 974 ee = nxrg 975 copied = nxr 976 ENDIF 977 978 DO i = ss, ee 979 DO j = nysg, nyng 980 DO k = nzb+1, nzt 981 flag = MERGE( 1.0_wp, 0.0_wp, & 982 BTEST( wall_flags_0(k,j,i), 0 ) ) 983 cs_3d(k,j,i) = cs_3d(k,j,copied) * flag 984 ENDDO 985 ENDDO 986 ENDDO 987 988 ELSE 989 WRITE(message_string,*) & 990 'unknown decycling method: decycle_method (', & 991 boundary, ') ="' // TRIM( decycle_method(boundary) ) // '"' 992 CALL message( 'chem_boundary_conds_decycle', 'CM0431', & 993 1, 2, 0, 6, 0 ) 994 ENDIF 995 ENDDO 996 ENDIF 997 ! 998 !-- South and north boundaries 999 IF ( decycle_chem_ns .AND. bc_ns_cyc ) THEN 1000 1001 DO boundary = 3, 4 1002 1003 IF ( decycle_method(boundary) == 'dirichlet' ) THEN 1004 ! 1005 !-- Initial profile is copied to ghost and first three layers 1006 ss = 1 1007 ee = 0 1008 IF ( boundary == 3 .AND. nys == 0 ) THEN 1009 ss = nysg 1010 ee = nys+2 1011 ELSEIF ( boundary == 4 .AND. nyn == ny ) THEN 1012 ss = nyn-2 1013 ee = nyng 1014 ENDIF 1015 1016 DO i = nxlg, nxrg 1017 DO j = ss, ee 1018 DO k = nzb+1, nzt 1019 flag = MERGE( 1.0_wp, 0.0_wp, & 1020 BTEST( wall_flags_0(k,j,i), 0 ) ) 1021 cs_3d(k,j,i) = cs_pr_init(k) * flag 1022 ENDDO 1023 ENDDO 1024 ENDDO 1025 1026 1027 ELSEIF ( decycle_method(boundary) == 'neumann' ) THEN 1028 ! 1029 !-- The value at the boundary is copied to the ghost layers to simulate 1030 !-- an outlet with zero gradient 1031 ss = 1 1032 ee = 0 1033 IF ( boundary == 3 .AND. nys == 0 ) THEN 1034 ss = nysg 1035 ee = nys-1 1036 copied = nys 1037 ELSEIF ( boundary == 4 .AND. nyn == ny ) THEN 1038 ss = nyn+1 1039 ee = nyng 1040 copied = nyn 1041 ENDIF 1042 1043 DO i = nxlg, nxrg 1044 DO j = ss, ee 1045 DO k = nzb+1, nzt 1046 flag = MERGE( 1.0_wp, 0.0_wp, & 1047 BTEST( wall_flags_0(k,j,i), 0 ) ) 1048 cs_3d(k,j,i) = cs_3d(k,copied,i) * flag 1049 ENDDO 1050 ENDDO 1051 ENDDO 1052 1053 ELSE 1054 WRITE(message_string,*) & 1055 'unknown decycling method: decycle_method (', & 1056 boundary, ') ="' // TRIM( decycle_method(boundary) ) // '"' 1057 CALL message( 'chem_boundary_conds_decycle', 'CM0432', & 1058 1, 2, 0, 6, 0 ) 1059 ENDIF 1060 ENDDO 1061 ENDIF 1062 1063 ENDIF 1064 1065 lsp_usr = lsp_usr + 1 1066 1067 ENDDO 1068 1069 ENDDO 1070 1071 CALL cpu_log( log_point_s(84), 'chem.exch-horiz', 'stop' ) 906 SUBROUTINE chem_boundary_conds_decycle( cs_3d, cs_pr_init ) 907 908 909 INTEGER(iwp) :: boundary !< 910 INTEGER(iwp) :: ee !< 911 INTEGER(iwp) :: copied !< 912 INTEGER(iwp) :: i !< 913 INTEGER(iwp) :: j !< 914 INTEGER(iwp) :: k !< 915 INTEGER(iwp) :: ss !< 916 917 REAL(wp), DIMENSION(nzb:nzt+1) :: cs_pr_init 918 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: cs_3d 919 REAL(wp) :: flag !< flag to mask topography grid points 920 921 922 flag = 0.0_wp 923 ! 924 !-- Left and right boundaries 925 IF ( decycle_chem_lr .AND. bc_lr_cyc ) THEN 926 927 DO boundary = 1, 2 928 929 IF ( decycle_method(boundary) == 'dirichlet' ) THEN 930 ! 931 !-- Initial profile is copied to ghost and first three layers 932 ss = 1 933 ee = 0 934 IF ( boundary == 1 .AND. nxl == 0 ) THEN 935 ss = nxlg 936 ee = nxl+2 937 ELSEIF ( boundary == 2 .AND. nxr == nx ) THEN 938 ss = nxr-2 939 ee = nxrg 940 ENDIF 941 942 DO i = ss, ee 943 DO j = nysg, nyng 944 DO k = nzb+1, nzt 945 flag = MERGE( 1.0_wp, 0.0_wp, & 946 BTEST( wall_flags_0(k,j,i), 0 ) ) 947 cs_3d(k,j,i) = cs_pr_init(k) * flag 948 ENDDO 949 ENDDO 950 ENDDO 951 952 ELSEIF ( decycle_method(boundary) == 'neumann' ) THEN 953 ! 954 !-- The value at the boundary is copied to the ghost layers to simulate 955 !-- an outlet with zero gradient 956 ss = 1 957 ee = 0 958 IF ( boundary == 1 .AND. nxl == 0 ) THEN 959 ss = nxlg 960 ee = nxl-1 961 copied = nxl 962 ELSEIF ( boundary == 2 .AND. nxr == nx ) THEN 963 ss = nxr+1 964 ee = nxrg 965 copied = nxr 966 ENDIF 967 968 DO i = ss, ee 969 DO j = nysg, nyng 970 DO k = nzb+1, nzt 971 flag = MERGE( 1.0_wp, 0.0_wp, & 972 BTEST( wall_flags_0(k,j,i), 0 ) ) 973 cs_3d(k,j,i) = cs_3d(k,j,copied) * flag 974 ENDDO 975 ENDDO 976 ENDDO 977 978 ELSE 979 WRITE(message_string,*) & 980 'unknown decycling method: decycle_method (', & 981 boundary, ') ="' // TRIM( decycle_method(boundary) ) // '"' 982 CALL message( 'chem_boundary_conds_decycle', 'CM0431', & 983 1, 2, 0, 6, 0 ) 984 ENDIF 985 ENDDO 986 ENDIF 987 ! 988 !-- South and north boundaries 989 IF ( decycle_chem_ns .AND. bc_ns_cyc ) THEN 990 991 DO boundary = 3, 4 992 993 IF ( decycle_method(boundary) == 'dirichlet' ) THEN 994 ! 995 !-- Initial profile is copied to ghost and first three layers 996 ss = 1 997 ee = 0 998 IF ( boundary == 3 .AND. nys == 0 ) THEN 999 ss = nysg 1000 ee = nys+2 1001 ELSEIF ( boundary == 4 .AND. nyn == ny ) THEN 1002 ss = nyn-2 1003 ee = nyng 1004 ENDIF 1005 1006 DO i = nxlg, nxrg 1007 DO j = ss, ee 1008 DO k = nzb+1, nzt 1009 flag = MERGE( 1.0_wp, 0.0_wp, & 1010 BTEST( wall_flags_0(k,j,i), 0 ) ) 1011 cs_3d(k,j,i) = cs_pr_init(k) * flag 1012 ENDDO 1013 ENDDO 1014 ENDDO 1015 1016 1017 ELSEIF ( decycle_method(boundary) == 'neumann' ) THEN 1018 ! 1019 !-- The value at the boundary is copied to the ghost layers to simulate 1020 !-- an outlet with zero gradient 1021 ss = 1 1022 ee = 0 1023 IF ( boundary == 3 .AND. nys == 0 ) THEN 1024 ss = nysg 1025 ee = nys-1 1026 copied = nys 1027 ELSEIF ( boundary == 4 .AND. nyn == ny ) THEN 1028 ss = nyn+1 1029 ee = nyng 1030 copied = nyn 1031 ENDIF 1032 1033 DO i = nxlg, nxrg 1034 DO j = ss, ee 1035 DO k = nzb+1, nzt 1036 flag = MERGE( 1.0_wp, 0.0_wp, & 1037 BTEST( wall_flags_0(k,j,i), 0 ) ) 1038 cs_3d(k,j,i) = cs_3d(k,copied,i) * flag 1039 ENDDO 1040 ENDDO 1041 ENDDO 1042 1043 ELSE 1044 WRITE(message_string,*) & 1045 'unknown decycling method: decycle_method (', & 1046 boundary, ') ="' // TRIM( decycle_method(boundary) ) // '"' 1047 CALL message( 'chem_boundary_conds_decycle', 'CM0432', & 1048 1, 2, 0, 6, 0 ) 1049 ENDIF 1050 ENDDO 1051 ENDIF 1052 1072 1053 1073 1054 END SUBROUTINE chem_boundary_conds_decycle … … 2422 2403 !> Call for all grid points 2423 2404 !------------------------------------------------------------------------------! 2424 SUBROUTINE chem_non_transport_physics() 2425 2426 2427 INTEGER(iwp) :: i !< 2428 INTEGER(iwp) :: j !< 2429 2430 ! 2431 !-- Calculation of chemical reactions and deposition. 2432 IF ( chem_gasphase_on ) THEN 2433 2434 IF ( intermediate_timestep_count == 1 .OR. call_chem_at_all_substeps ) THEN 2435 2436 CALL cpu_log( log_point_s(19), 'chem.reactions', 'start' ) 2437 !$OMP PARALLEL PRIVATE (i,j) 2438 !$OMP DO schedule(static,1) 2439 DO i = nxl, nxr 2440 DO j = nys, nyn 2441 CALL chem_integrate( i, j ) 2442 ENDDO 2443 ENDDO 2444 !$OMP END PARALLEL 2445 CALL cpu_log( log_point_s(19), 'chem.reactions', 'stop' ) 2446 2447 IF ( deposition_dry ) THEN 2448 CALL cpu_log( log_point_s(24), 'chem.deposition', 'start' ) 2449 DO i = nxl, nxr 2450 DO j = nys, nyn 2451 CALL chem_depo( i, j ) 2452 ENDDO 2453 ENDDO 2454 CALL cpu_log( log_point_s(24), 'chem.deposition', 'stop' ) 2455 ENDIF 2456 2457 ENDIF 2458 2459 ENDIF 2460 2461 END SUBROUTINE chem_non_transport_physics 2405 SUBROUTINE chem_non_transport_physics() 2406 2407 2408 INTEGER(iwp) :: i !< 2409 INTEGER(iwp) :: j !< 2410 2411 ! 2412 !-- Calculation of chemical reactions and deposition. 2413 2414 2415 IF ( intermediate_timestep_count == 1 .OR. call_chem_at_all_substeps ) THEN 2416 2417 IF ( chem_gasphase_on ) THEN 2418 CALL cpu_log( log_point_s(19), 'chem.reactions', 'start' ) 2419 !$OMP PARALLEL PRIVATE (i,j) 2420 !$OMP DO schedule(static,1) 2421 DO i = nxl, nxr 2422 DO j = nys, nyn 2423 CALL chem_integrate( i, j ) 2424 ENDDO 2425 ENDDO 2426 !$OMP END PARALLEL 2427 CALL cpu_log( log_point_s(19), 'chem.reactions', 'stop' ) 2428 ENDIF 2429 2430 IF ( deposition_dry ) THEN 2431 CALL cpu_log( log_point_s(24), 'chem.deposition', 'start' ) 2432 DO i = nxl, nxr 2433 DO j = nys, nyn 2434 CALL chem_depo( i, j ) 2435 ENDDO 2436 ENDDO 2437 CALL cpu_log( log_point_s(24), 'chem.deposition', 'stop' ) 2438 ENDIF 2439 2440 ENDIF 2441 2442 2443 2444 END SUBROUTINE chem_non_transport_physics 2462 2445 2463 2446 … … 2470 2453 2471 2454 2472 2473 2455 INTEGER(iwp), INTENT(IN) :: i !< grid index in x-direction 2456 INTEGER(iwp), INTENT(IN) :: j !< grid index in y-direction 2474 2457 2475 2458 ! 2476 2459 !-- Calculation of chemical reactions and deposition. 2477 IF ( chem_gasphase_on ) THEN 2478 2479 IF ( intermediate_timestep_count == 1 .OR. call_chem_at_all_substeps ) THEN 2480 2481 CALL cpu_log( log_point_s(19), 'chem.reactions', 'start' ) 2482 CALL chem_integrate( i, j ) 2483 CALL cpu_log( log_point_s(19), 'chem.reactions', 'stop' ) 2484 2485 IF ( deposition_dry ) THEN 2486 CALL cpu_log( log_point_s(24), 'chem.deposition', 'start' ) 2487 CALL chem_depo( i, j ) 2488 CALL cpu_log( log_point_s(24), 'chem.deposition', 'stop' ) 2489 ENDIF 2490 2491 ENDIF 2492 2493 ENDIF 2460 2461 2462 IF ( intermediate_timestep_count == 1 .OR. call_chem_at_all_substeps ) THEN 2463 2464 IF ( chem_gasphase_on ) THEN 2465 CALL cpu_log( log_point_s(19), 'chem.reactions', 'start' ) 2466 CALL chem_integrate( i, j ) 2467 CALL cpu_log( log_point_s(19), 'chem.reactions', 'stop' ) 2468 ENDIF 2469 2470 IF ( deposition_dry ) THEN 2471 CALL cpu_log( log_point_s(24), 'chem.deposition', 'start' ) 2472 CALL chem_depo( i, j ) 2473 CALL cpu_log( log_point_s(24), 'chem.deposition', 'stop' ) 2474 ENDIF 2475 2476 ENDIF 2477 2478 2494 2479 2495 2480 END SUBROUTINE chem_non_transport_physics_ij … … 2500 2485 !> routine for exchange horiz of chemical quantities 2501 2486 !------------------------------------------------------------------------------! 2502 SUBROUTINE chem_exchange_horiz 2503 2504 2505 END SUBROUTINE chem_exchange_horiz 2487 SUBROUTINE chem_exchange_horiz_bounds 2488 2489 INTEGER(iwp) :: lsp !< 2490 INTEGER(iwp) :: lsp_usr !< 2491 2492 ! 2493 !-- Loop over chemical species 2494 CALL cpu_log( log_point_s(84), 'chem.exch-horiz', 'start' ) 2495 DO lsp = 1, nvar 2496 CALL exchange_horiz( chem_species(lsp)%conc, nbgp ) 2497 lsp_usr = 1 2498 DO WHILE ( TRIM( cs_name( lsp_usr ) ) /= 'novalue' ) 2499 IF ( TRIM(chem_species(lsp)%name) == TRIM(cs_name(lsp_usr)) ) THEN 2500 2501 CALL chem_boundary_conds( chem_species(lsp)%conc_p, & 2502 chem_species(lsp)%conc_pr_init ) 2503 2504 ENDIF 2505 lsp_usr = lsp_usr +1 2506 ENDDO 2507 2508 2509 ENDDO 2510 CALL cpu_log( log_point_s(84), 'chem.exch-horiz', 'stop' ) 2511 2512 2513 END SUBROUTINE chem_exchange_horiz_bounds 2506 2514 2507 2515 … … 2526 2534 CALL cpu_log( log_point_s(25), 'chem.advec+diff+prog', 'start' ) 2527 2535 2528 DO ilsp = 1, n spec2536 DO ilsp = 1, nvar 2529 2537 ! 2530 2538 !-- Tendency terms for chemical species … … 2631 2639 INTEGER :: k 2632 2640 2633 DO ilsp = 1, n spec2641 DO ilsp = 1, nvar 2634 2642 ! 2635 2643 !-- Tendency-terms for chem spcs. … … 2878 2886 2879 2887 2880 !!! sB remove blanks again later !!!2881 2882 2883 2884 2885 2886 2887 2888 2889 2890 2891 2892 2893 2894 2895 2896 2897 2898 2899 2900 2901 2902 2903 2904 2905 2906 2907 2908 2909 2910 2911 2912 2913 2914 2915 2916 2917 2918 2919 2888 !-------------------------------------------------------------------------------! 2920 2889 ! Description: … … 2953 2922 INTEGER(iwp) :: k !< matching k to surface m at i,j 2954 2923 INTEGER(iwp) :: lsp !< running index for chem spcs. 2955 INTEGER(iwp) :: lu _palm!< index of PALM LSM vegetation_type at current surface element2924 INTEGER(iwp) :: luv_palm !< index of PALM LSM vegetation_type at current surface element 2956 2925 INTEGER(iwp) :: lup_palm !< index of PALM LSM pavement_type at current surface element 2957 2926 INTEGER(iwp) :: luw_palm !< index of PALM LSM water_type at current surface element … … 2959 2928 INTEGER(iwp) :: lug_palm !< index of PALM USM green walls/roofs at current surface element 2960 2929 INTEGER(iwp) :: lud_palm !< index of PALM USM windows at current surface element 2961 INTEGER(iwp) :: lu _dep !< matching DEPAC LU to lu_palm2930 INTEGER(iwp) :: luv_dep !< matching DEPAC LU to luv_palm 2962 2931 INTEGER(iwp) :: lup_dep !< matching DEPAC LU to lup_palm 2963 2932 INTEGER(iwp) :: luw_dep !< matching DEPAC LU to luw_palm … … 3254 3223 ! 3255 3224 !-- Initialize lu's 3256 lu _palm = 03257 lu _dep = 03225 luv_palm = 0 3226 luv_dep = 0 3258 3227 lup_palm = 0 3259 3228 lup_dep = 0 … … 3268 3237 !-- Get land use for i,j and assign to DEPAC lu 3269 3238 IF ( surf_lsm_h%frac(ind_veg_wall,m) > 0 ) THEN 3270 lu _palm = surf_lsm_h%vegetation_type(m)3271 IF ( lu _palm == ind_luv_user ) THEN3239 luv_palm = surf_lsm_h%vegetation_type(m) 3240 IF ( luv_palm == ind_luv_user ) THEN 3272 3241 message_string = 'No vegetation type defined. Please define vegetation type to enable deposition calculation' 3273 3242 CALL message( 'chem_depo', 'CM0451', 1, 2, 0, 6, 0 ) 3274 ELSEIF ( lu _palm == ind_luv_b_soil ) THEN3275 lu _dep = 93276 ELSEIF ( lu _palm == ind_luv_mixed_crops ) THEN3277 lu _dep = 23278 ELSEIF ( lu _palm == ind_luv_s_grass ) THEN3279 lu _dep = 13280 ELSEIF ( lu _palm == ind_luv_ev_needle_trees ) THEN3281 lu _dep = 43282 ELSEIF ( lu _palm == ind_luv_de_needle_trees ) THEN3283 lu _dep = 43284 ELSEIF ( lu _palm == ind_luv_ev_broad_trees ) THEN3285 lu _dep = 123286 ELSEIF ( lu _palm == ind_luv_de_broad_trees ) THEN3287 lu _dep = 53288 ELSEIF ( lu _palm == ind_luv_t_grass ) THEN3289 lu _dep = 13290 ELSEIF ( lu _palm == ind_luv_desert ) THEN3291 lu _dep = 93292 ELSEIF ( lu _palm == ind_luv_tundra ) THEN3293 lu _dep = 83294 ELSEIF ( lu _palm == ind_luv_irr_crops ) THEN3295 lu _dep = 23296 ELSEIF ( lu _palm == ind_luv_semidesert ) THEN3297 lu _dep = 83298 ELSEIF ( lu _palm == ind_luv_ice ) THEN3299 lu _dep = 103300 ELSEIF ( lu _palm == ind_luv_marsh ) THEN3301 lu _dep = 83302 ELSEIF ( lu _palm == ind_luv_ev_shrubs ) THEN3303 lu _dep = 143304 ELSEIF ( lu _palm == ind_luv_de_shrubs ) THEN3305 lu _dep = 143306 ELSEIF ( lu _palm == ind_luv_mixed_forest ) THEN3307 lu _dep = 43308 ELSEIF ( lu _palm == ind_luv_intrup_forest ) THEN3309 lu _dep = 83243 ELSEIF ( luv_palm == ind_luv_b_soil ) THEN 3244 luv_dep = 9 3245 ELSEIF ( luv_palm == ind_luv_mixed_crops ) THEN 3246 luv_dep = 2 3247 ELSEIF ( luv_palm == ind_luv_s_grass ) THEN 3248 luv_dep = 1 3249 ELSEIF ( luv_palm == ind_luv_ev_needle_trees ) THEN 3250 luv_dep = 4 3251 ELSEIF ( luv_palm == ind_luv_de_needle_trees ) THEN 3252 luv_dep = 4 3253 ELSEIF ( luv_palm == ind_luv_ev_broad_trees ) THEN 3254 luv_dep = 12 3255 ELSEIF ( luv_palm == ind_luv_de_broad_trees ) THEN 3256 luv_dep = 5 3257 ELSEIF ( luv_palm == ind_luv_t_grass ) THEN 3258 luv_dep = 1 3259 ELSEIF ( luv_palm == ind_luv_desert ) THEN 3260 luv_dep = 9 3261 ELSEIF ( luv_palm == ind_luv_tundra ) THEN 3262 luv_dep = 8 3263 ELSEIF ( luv_palm == ind_luv_irr_crops ) THEN 3264 luv_dep = 2 3265 ELSEIF ( luv_palm == ind_luv_semidesert ) THEN 3266 luv_dep = 8 3267 ELSEIF ( luv_palm == ind_luv_ice ) THEN 3268 luv_dep = 10 3269 ELSEIF ( luv_palm == ind_luv_marsh ) THEN 3270 luv_dep = 8 3271 ELSEIF ( luv_palm == ind_luv_ev_shrubs ) THEN 3272 luv_dep = 14 3273 ELSEIF ( luv_palm == ind_luv_de_shrubs ) THEN 3274 luv_dep = 14 3275 ELSEIF ( luv_palm == ind_luv_mixed_forest ) THEN 3276 luv_dep = 4 3277 ELSEIF ( luv_palm == ind_luv_intrup_forest ) THEN 3278 luv_dep = 8 3310 3279 ENDIF 3311 3280 ENDIF … … 3320 3289 ELSEIF ( lup_palm == ind_lup_asph ) THEN 3321 3290 lup_dep = 9 3322 ELSEIF ( lup_palm == 3291 ELSEIF ( lup_palm == ind_lup_conc ) THEN 3323 3292 lup_dep = 9 3324 ELSEIF ( lup_palm == 3293 ELSEIF ( lup_palm == ind_lup_sett ) THEN 3325 3294 lup_dep = 9 3326 3295 ELSEIF ( lup_palm == ind_lup_pav_stones ) THEN … … 3411 3380 IF ( surf_lsm_h%frac(ind_veg_wall,m) > 0 ) THEN 3412 3381 3382 ! 3383 !-- No vegetation on bare soil, desert or ice: 3384 IF ( ( luv_palm == ind_luv_b_soil ) .OR. & 3385 ( luv_palm == ind_luv_desert ) .OR. & 3386 ( luv_palm == ind_luv_ice ) ) THEN 3387 3388 lai = 0.0_wp 3389 sai = 0.0_wp 3390 3391 ENDIF 3392 3413 3393 slinnfac = 1.0_wp 3414 3394 ! … … 3436 3416 particle_pars(ind_p_slip, part_type), & 3437 3417 nwet, temp_tmp, dens, visc, & 3438 lu _dep, &3418 luv_dep, & 3439 3419 r_aero_surf, ustar_surf ) 3440 3420 … … 3457 3437 particle_pars(ind_p_slip, part_type), & 3458 3438 nwet, temp_tmp, dens, visc, & 3459 lu _dep , &3439 luv_dep , & 3460 3440 r_aero_surf, ustar_surf ) 3461 3441 … … 3508 3488 ! 3509 3489 !-- Get quasi-laminar boundary layer resistance rb: 3510 CALL get_rb_cell( (lu _dep == ilu_water_sea) .OR. (lu_dep == ilu_water_inland), &3490 CALL get_rb_cell( (luv_dep == ilu_water_sea) .OR. (luv_dep == ilu_water_inland), & 3511 3491 z0h_surf, ustar_surf, diffusivity, & 3512 3492 rb ) … … 3514 3494 !-- Get rc_tot 3515 3495 CALL drydepos_gas_depac( spc_names(lsp), day_of_year, latitude, ts, ustar_surf, solar_rad, cos_zenith, & 3516 rh_surf, lai, sai, nwet, lu _dep, 2, rc_tot, ccomp_tot(lsp), hyp(nzb), conc_ijk_ugm3, diffusivity, &3496 rh_surf, lai, sai, nwet, luv_dep, 2, rc_tot, ccomp_tot(lsp), hyp(nzb), conc_ijk_ugm3, diffusivity, & 3517 3497 r_aero_surf , rb ) 3518 3498 ! … … 4151 4131 IF ( surf_usm_h%frac(ind_pav_green,m) > 0 ) THEN 4152 4132 4133 ! 4134 !-- No vegetation on bare soil, desert or ice: 4135 IF ( ( lug_palm == ind_luv_b_soil ) .OR. & 4136 ( lug_palm == ind_luv_desert ) .OR. & 4137 ( lug_palm == ind_luv_ice ) ) THEN 4138 4139 lai = 0.0_wp 4140 sai = 0.0_wp 4141 4142 ENDIF 4143 4144 4153 4145 slinnfac = 1.0_wp 4154 4146 ! -
palm/trunk/SOURCE/module_interface.f90
r3887 r3929 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Correct/complete module_interface introduction for chemistry model 28 ! 29 ! 3887 2019 -04-12 08:47:41Z schwenkel 27 30 ! Changes related to global restructuring of location messages and introduction 28 31 ! of additional debug messages 29 ! 30 ! 3880 2019 -04-08 21:43:02Z knoop32 ! 33 ! 3880 2019 -04-08 21:43:02Z knoop 31 34 ! Add a call for salsa_prognostic_equations 32 35 ! … … 168 171 chem_check_data_output_pr, & 169 172 chem_check_data_output, & 173 chem_exchange_horiz_bounds, & 170 174 chem_init_arrays, & 171 175 chem_init, & … … 988 992 989 993 IF ( bulk_cloud_model ) CALL bcm_exchange_horiz() 990 994 IF ( air_chemistry ) CALL chem_exchange_horiz_bounds() 991 995 992 996 END SUBROUTINE module_interface_exchange_horiz -
palm/trunk/SOURCE/prognostic_equations.f90
r3899 r3929 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Correct/complete module_interface introduction for chemistry model 28 ! 29 ! 3899 2019-04-16 14:05:27Z monakurppa 27 30 ! Corrections in the OpenMP version of salsa 28 ! 29 ! 3887 2019 -04-12 08:47:41Z schwenkel31 ! 32 ! 3887 2019 -04-12 08:47:41Z schwenkel 30 33 ! Implicit Bugfix for chemistry model, loop for non_transport_physics over 31 34 ! ghost points is avoided. Instead introducing module_interface_exchange_horiz. … … 401 404 ONLY: buoyancy 402 405 403 USE chemistry_model_mod, &404 ONLY: chem_boundary_conds_decycle405 406 406 USE control_parameters, & 407 ONLY: air_chemistry, constant_diffusion,&407 ONLY: constant_diffusion, & 408 408 debug_output, debug_string, & 409 409 dp_external, dp_level_ind_b, dp_smooth_factor, dpdxy, dt_3d, & … … 554 554 !$OMP END PARALLEL 555 555 556 IF ( air_chemistry ) CALL chem_boundary_conds_decycle557 556 ! 558 557 !-- Run SALSA and aerosol dynamic processes. SALSA is run with a longer time -
palm/trunk/SOURCE/time_integration.f90
r3885 r3929 25 25 ! ----------------- 26 26 ! $Id$ 27 ! Reverse changes back from revision 3878: use chem_boundary_conds instead of 28 ! chem_boundary_conds_decycle 29 ! 30 ! 31 ! 3885 2019-04-11 11:29:34Z kanani 27 32 ! Changes related to global restructuring of location messages and introduction 28 33 ! of additional debug messages 29 ! 34 ! 30 35 ! 3879 2019-04-08 20:25:23Z knoop 31 36 ! Moved wtm_forces to module_interface_actions … … 510 515 511 516 USE chem_gasphase_mod, & 512 ONLY: n spec517 ONLY: nvar 513 518 514 519 USE chem_modules, & 515 ONLY: bc_cs_t_val, emissions_anthropogenic, nspec_out, chem_species520 ONLY: bc_cs_t_val, chem_species, cs_name, emissions_anthropogenic, nspec_out 516 521 517 522 USE chemistry_model_mod, & 518 ONLY: chem_boundary_conds _decycle523 ONLY: chem_boundary_conds 519 524 520 525 USE control_parameters, & … … 684 689 INTEGER(iwp) :: icc !< additional index for aerosol mass bins 685 690 INTEGER(iwp) :: ig !< index for salsa gases 691 INTEGER(iwp) :: lsp 692 INTEGER(iwp) :: lsp_usr !< 686 693 INTEGER(iwp) :: n !< loop counter for chemistry species 687 694 … … 861 868 bc_q_t_val = ( q_init(nzt+1) - q_init(nzt) ) / dzu(nzt+1) 862 869 IF ( air_chemistry ) THEN 863 DO n = 1, nspec864 bc_cs_t_val = ( chem_species( n)%conc_pr_init(nzt+1) &865 - chem_species( n)%conc_pr_init(nzt) ) &870 DO lsp = 1, nvar 871 bc_cs_t_val = ( chem_species(lsp)%conc_pr_init(nzt+1) & 872 - chem_species(lsp)%conc_pr_init(nzt) ) & 866 873 / dzu(nzt+1) 867 874 ENDDO … … 1038 1045 ENDIF 1039 1046 IF ( passive_scalar ) CALL exchange_horiz( s_p, nbgp ) 1040 IF ( air_chemistry ) CALL chem_boundary_conds_decycle 1047 IF ( air_chemistry ) THEN 1048 DO lsp = 1, nvar 1049 CALL exchange_horiz( chem_species(lsp)%conc_p, nbgp ) 1050 ! 1051 !-- kanani: Push chem_boundary_conds after CALL boundary_conds 1052 lsp_usr = 1 1053 DO WHILE ( TRIM( cs_name( lsp_usr ) ) /= 'novalue' ) 1054 IF ( TRIM(chem_species(lsp)%name) == TRIM(cs_name(lsp_usr)) ) THEN 1055 CALL chem_boundary_conds( chem_species(lsp)%conc_p, & 1056 chem_species(lsp)%conc_pr_init ) 1057 ENDIF 1058 lsp_usr = lsp_usr + 1 1059 ENDDO 1060 ENDDO 1061 ENDIF 1041 1062 1042 1063 IF ( salsa .AND. time_since_reference_point >= skip_time_do_salsa ) THEN … … 1121 1142 1122 1143 IF ( air_chemistry ) THEN 1123 DO n = 1, n spec1144 DO n = 1, nvar 1124 1145 CALL exchange_horiz( chem_species(n)%conc, nbgp ) 1125 1146 ENDDO
Note: See TracChangeset
for help on using the changeset viewer.
