Changeset 3929 for palm/trunk/SOURCE


Ignore:
Timestamp:
Apr 24, 2019 12:52:08 PM (6 years ago)
Author:
banzhafs
Message:

Correct/complete module_interface introduction for chemistry model and bug fix in chem_depo subroutine

Location:
palm/trunk/SOURCE
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/chemistry_model_mod.f90

    r3898 r3929  
    2626! Former revisions:
    2727! -----------------
    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
    2934! 2D output of emission fluxes
    3035!
     
    324329                debug_output,                                                                      &
    325330                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,          &
    327332         max_pr_user, timestep_scheme, use_prescribed_profile_data, ws_scheme_sca, air_chemistry
    328333
     
    458463    INTERFACE chem_boundary_conds
    459464       MODULE PROCEDURE chem_boundary_conds
     465       MODULE PROCEDURE chem_boundary_conds_decycle
    460466    END INTERFACE chem_boundary_conds
    461 
    462     INTERFACE chem_boundary_conds_decycle
    463        MODULE PROCEDURE chem_boundary_conds_decycle
    464     END INTERFACE chem_boundary_conds_decycle
    465467
    466468    INTERFACE chem_check_data_output
     
    526528    END INTERFACE chem_non_transport_physics
    527529   
    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   
    531533
    532534    INTERFACE chem_prognostic_equations
     
    629631         chem_actions, chem_prognostic_equations, chem_rrd_local,             &
    630632         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
    632634
    633635 CONTAINS
     
    902904!> Dirichlet boundary conditions
    903905!------------------------------------------------------------------------------!
    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
    10721053
    10731054 END SUBROUTINE chem_boundary_conds_decycle
     
    24222403!> Call for all grid points
    24232404!------------------------------------------------------------------------------!
    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
    24622445
    24632446
     
    24702453
    24712454
    2472     INTEGER(iwp), INTENT(IN) ::  i  !< grid index in x-direction
    2473     INTEGER(iwp), INTENT(IN) ::  j  !< grid index in y-direction
     2455   INTEGER(iwp), INTENT(IN) ::  i  !< grid index in x-direction
     2456   INTEGER(iwp), INTENT(IN) ::  j  !< grid index in y-direction
    24742457
    24752458!
    24762459!-- 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
    24942479
    24952480 END SUBROUTINE chem_non_transport_physics_ij
     
    25002485!> routine for exchange horiz of chemical quantities 
    25012486!------------------------------------------------------------------------------!
    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
    25062514
    25072515 
     
    25262534    CALL cpu_log( log_point_s(25), 'chem.advec+diff+prog', 'start' )
    25272535
    2528     DO  ilsp = 1, nspec
     2536    DO  ilsp = 1, nvar
    25292537!
    25302538!--    Tendency terms for chemical species
     
    26312639    INTEGER :: k
    26322640
    2633     DO  ilsp = 1, nspec
     2641    DO  ilsp = 1, nvar
    26342642!
    26352643!--    Tendency-terms for chem spcs.
     
    28782886
    28792887
    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 
    29192888!-------------------------------------------------------------------------------!
    29202889! Description:
     
    29532922    INTEGER(iwp) ::  k                             !< matching k to surface m at i,j
    29542923    INTEGER(iwp) ::  lsp                           !< running index for chem spcs.
    2955     INTEGER(iwp) ::  lu_palm                       !< index of PALM LSM vegetation_type at current surface element
     2924    INTEGER(iwp) ::  luv_palm                      !< index of PALM LSM vegetation_type at current surface element
    29562925    INTEGER(iwp) ::  lup_palm                      !< index of PALM LSM pavement_type at current surface element
    29572926    INTEGER(iwp) ::  luw_palm                      !< index of PALM LSM water_type at current surface element
     
    29592928    INTEGER(iwp) ::  lug_palm                      !< index of PALM USM green walls/roofs at current surface element
    29602929    INTEGER(iwp) ::  lud_palm                      !< index of PALM USM windows at current surface element
    2961     INTEGER(iwp) ::  lu_dep                        !< matching DEPAC LU to lu_palm
     2930    INTEGER(iwp) ::  luv_dep                       !< matching DEPAC LU to luv_palm
    29622931    INTEGER(iwp) ::  lup_dep                       !< matching DEPAC LU to lup_palm
    29632932    INTEGER(iwp) ::  luw_dep                       !< matching DEPAC LU to luw_palm
     
    32543223!
    32553224!--    Initialize lu's
    3256        lu_palm = 0
    3257        lu_dep = 0
     3225       luv_palm = 0
     3226       luv_dep = 0
    32583227       lup_palm = 0
    32593228       lup_dep = 0
     
    32683237!--    Get land use for i,j and assign to DEPAC lu
    32693238       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 )  THEN
     3239          luv_palm = surf_lsm_h%vegetation_type(m)
     3240          IF ( luv_palm == ind_luv_user )  THEN
    32723241             message_string = 'No vegetation type defined. Please define vegetation type to enable deposition calculation'
    32733242             CALL message( 'chem_depo', 'CM0451', 1, 2, 0, 6, 0 )
    3274           ELSEIF ( lu_palm == ind_luv_b_soil )  THEN
    3275              lu_dep = 9
    3276           ELSEIF ( lu_palm == ind_luv_mixed_crops )  THEN
    3277              lu_dep = 2
    3278           ELSEIF ( lu_palm == ind_luv_s_grass )  THEN
    3279              lu_dep = 1
    3280           ELSEIF ( lu_palm == ind_luv_ev_needle_trees )  THEN
    3281              lu_dep = 4
    3282           ELSEIF ( lu_palm == ind_luv_de_needle_trees )  THEN
    3283              lu_dep = 4
    3284           ELSEIF ( lu_palm == ind_luv_ev_broad_trees )  THEN
    3285              lu_dep = 12
    3286           ELSEIF ( lu_palm == ind_luv_de_broad_trees )  THEN
    3287              lu_dep = 5
    3288           ELSEIF ( lu_palm == ind_luv_t_grass )  THEN
    3289              lu_dep = 1
    3290           ELSEIF ( lu_palm == ind_luv_desert )  THEN
    3291              lu_dep = 9
    3292           ELSEIF ( lu_palm == ind_luv_tundra )  THEN
    3293              lu_dep = 8
    3294           ELSEIF ( lu_palm == ind_luv_irr_crops )  THEN
    3295              lu_dep = 2
    3296           ELSEIF ( lu_palm == ind_luv_semidesert )  THEN
    3297              lu_dep = 8
    3298           ELSEIF ( lu_palm == ind_luv_ice )  THEN
    3299              lu_dep = 10
    3300           ELSEIF ( lu_palm == ind_luv_marsh )  THEN
    3301              lu_dep = 8
    3302           ELSEIF ( lu_palm == ind_luv_ev_shrubs )  THEN
    3303              lu_dep = 14
    3304           ELSEIF ( lu_palm == ind_luv_de_shrubs )  THEN
    3305              lu_dep = 14
    3306           ELSEIF ( lu_palm == ind_luv_mixed_forest )  THEN
    3307              lu_dep = 4
    3308           ELSEIF ( lu_palm == ind_luv_intrup_forest )  THEN
    3309              lu_dep = 8     
     3243          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     
    33103279          ENDIF
    33113280       ENDIF
     
    33203289          ELSEIF ( lup_palm == ind_lup_asph )  THEN
    33213290             lup_dep = 9
    3322           ELSEIF ( lup_palm ==  ind_lup_conc )  THEN
     3291          ELSEIF ( lup_palm == ind_lup_conc )  THEN
    33233292             lup_dep = 9
    3324           ELSEIF ( lup_palm ==  ind_lup_sett )  THEN
     3293          ELSEIF ( lup_palm == ind_lup_sett )  THEN
    33253294             lup_dep = 9
    33263295          ELSEIF ( lup_palm == ind_lup_pav_stones )  THEN
     
    34113380       IF ( surf_lsm_h%frac(ind_veg_wall,m) > 0 )  THEN
    34123381
     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         
    34133393          slinnfac = 1.0_wp
    34143394!
     
    34363416                     particle_pars(ind_p_slip, part_type), &
    34373417                     nwet, temp_tmp, dens, visc, &
    3438                      lu_dep,  &
     3418                     luv_dep,  &
    34393419                     r_aero_surf, ustar_surf )
    34403420
     
    34573437                     particle_pars(ind_p_slip, part_type), &
    34583438                     nwet, temp_tmp, dens, visc, &
    3459                      lu_dep , &
     3439                     luv_dep , &
    34603440                     r_aero_surf, ustar_surf )
    34613441
     
    35083488!
    35093489!--             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), &
    35113491                     z0h_surf, ustar_surf, diffusivity, &
    35123492                     rb )
     
    35143494!--             Get rc_tot
    35153495                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, &
    35173497                     r_aero_surf , rb )
    35183498!
     
    41514131       IF ( surf_usm_h%frac(ind_pav_green,m) > 0 )  THEN
    41524132
     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         
    41534145          slinnfac = 1.0_wp
    41544146!
  • palm/trunk/SOURCE/module_interface.f90

    r3887 r3929  
    2525! -----------------
    2626! $Id$
     27! Correct/complete module_interface introduction for chemistry model
     28!
     29! 3887 2019 -04-12 08:47:41Z schwenkel
    2730! Changes related to global restructuring of location messages and introduction
    2831! of additional debug messages
    29 !
    30 ! 3880 2019-04-08 21:43:02Z knoop
     32!  
     33! 3880 2019 -04-08 21:43:02Z knoop
    3134! Add a call for salsa_prognostic_equations
    3235!
     
    168171              chem_check_data_output_pr,                                       &
    169172              chem_check_data_output,                                          &
     173              chem_exchange_horiz_bounds,                                      &
    170174              chem_init_arrays,                                                &
    171175              chem_init,                                                       &
     
    988992
    989993    IF ( bulk_cloud_model    )  CALL bcm_exchange_horiz()
    990 
     994    IF ( air_chemistry       )  CALL chem_exchange_horiz_bounds()
    991995
    992996 END SUBROUTINE module_interface_exchange_horiz
  • palm/trunk/SOURCE/prognostic_equations.f90

    r3899 r3929  
    2525! -----------------
    2626! $Id$
     27! Correct/complete module_interface introduction for chemistry model
     28!
     29! 3899 2019-04-16 14:05:27Z monakurppa
    2730! Corrections in the OpenMP version of salsa
    28 ! 
    29 ! 3887 2019-04-12 08:47:41Z schwenkel
     31!
     32! 3887 2019 -04-12 08:47:41Z schwenkel
    3033! Implicit Bugfix for chemistry model, loop for non_transport_physics over
    3134! ghost points is avoided. Instead introducing module_interface_exchange_horiz.
     
    401404        ONLY:  buoyancy
    402405
    403     USE chemistry_model_mod,                                                   &
    404         ONLY:  chem_boundary_conds_decycle
    405 
    406406    USE control_parameters,                                                    &
    407         ONLY:  air_chemistry, constant_diffusion,                              &
     407        ONLY:  constant_diffusion,                                             &
    408408               debug_output, debug_string,                                     &
    409409               dp_external, dp_level_ind_b, dp_smooth_factor, dpdxy, dt_3d,    &
     
    554554    !$OMP END PARALLEL
    555555
    556     IF ( air_chemistry )  CALL chem_boundary_conds_decycle
    557556!
    558557!-- Run SALSA and aerosol dynamic processes. SALSA is run with a longer time
  • palm/trunk/SOURCE/time_integration.f90

    r3885 r3929  
    2525! -----------------
    2626! $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
    2732! Changes related to global restructuring of location messages and introduction
    2833! of additional debug messages
    29 ! 
     34!
    3035! 3879 2019-04-08 20:25:23Z knoop
    3136! Moved wtm_forces to module_interface_actions
     
    510515
    511516    USE chem_gasphase_mod,                                                                         &
    512         ONLY:  nspec
     517        ONLY:  nvar
    513518
    514519    USE chem_modules,                                                                              &
    515         ONLY:  bc_cs_t_val, emissions_anthropogenic, nspec_out, chem_species
     520        ONLY:  bc_cs_t_val, chem_species, cs_name, emissions_anthropogenic, nspec_out
    516521
    517522    USE chemistry_model_mod,                                                                       &
    518         ONLY:  chem_boundary_conds_decycle
     523        ONLY:  chem_boundary_conds
    519524
    520525    USE control_parameters,                                                                        &
     
    684689    INTEGER(iwp)      ::  icc       !< additional index for aerosol mass bins
    685690    INTEGER(iwp)      ::  ig        !< index for salsa gases
     691    INTEGER(iwp)      ::  lsp
     692    INTEGER(iwp)      ::  lsp_usr   !<
    686693    INTEGER(iwp)      ::  n         !< loop counter for chemistry species
    687694
     
    861868           bc_q_t_val  = ( q_init(nzt+1) - q_init(nzt) ) / dzu(nzt+1)
    862869           IF ( air_chemistry )  THEN
    863               DO  n = 1, nspec
    864                  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) )                            &
    866873                               / dzu(nzt+1)
    867874              ENDDO
     
    10381045          ENDIF
    10391046          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
    10411062
    10421063          IF ( salsa  .AND.  time_since_reference_point >= skip_time_do_salsa )  THEN
     
    11211142
    11221143                IF ( air_chemistry )  THEN
    1123                    DO  n = 1, nspec
     1144                   DO  n = 1, nvar
    11241145                      CALL exchange_horiz( chem_species(n)%conc, nbgp )
    11251146                   ENDDO
Note: See TracChangeset for help on using the changeset viewer.