Changeset 4273 for palm/trunk/SOURCE/chemistry_model_mod.f90
- Timestamp:
- Oct 24, 2019 1:40:54 PM (5 years ago)
- File:
-
- 1 edited
-
palm/trunk/SOURCE/chemistry_model_mod.f90 (modified) (6 diffs)
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/chemistry_model_mod.f90
r4272 r4273 27 27 ! ----------------- 28 28 ! $Id$ 29 ! Add logical switches nesting_chem and nesting_offline_chem (both .TRUE. 30 ! by default) 31 ! 32 ! 4272 2019-10-23 15:18:57Z schwenkel 29 33 ! Further modularization of boundary conditions: moved boundary conditions to 30 34 ! respective modules … … 859 863 SUBROUTINE chem_boundary_conds_decycle( cs_3d, cs_pr_init ) 860 864 861 862 INTEGER(iwp) :: boundary !< 863 INTEGER(iwp) :: ee !< 864 INTEGER(iwp) :: copied !< 865 INTEGER(iwp) :: i !< 866 INTEGER(iwp) :: j !< 867 INTEGER(iwp) :: k !< 868 INTEGER(iwp) :: ss !< 869 870 REAL(wp), DIMENSION(nzb:nzt+1) :: cs_pr_init 871 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: cs_3d 872 REAL(wp) :: flag !< flag to mask topography grid points 873 874 875 flag = 0.0_wp 876 ! 877 !-- Left and right boundaries 878 IF ( decycle_chem_lr .AND. bc_lr_cyc ) THEN 879 880 DO boundary = 1, 2 881 882 IF ( decycle_method(boundary) == 'dirichlet' ) THEN 883 ! 884 !-- Initial profile is copied to ghost and first three layers 885 ss = 1 886 ee = 0 887 IF ( boundary == 1 .AND. nxl == 0 ) THEN 888 ss = nxlg 889 ee = nxl-1 890 ELSEIF ( boundary == 2 .AND. nxr == nx ) THEN 891 ss = nxr+1 892 ee = nxrg 893 ENDIF 894 895 DO i = ss, ee 896 DO j = nysg, nyng 897 DO k = nzb+1, nzt 898 flag = MERGE( 1.0_wp, 0.0_wp, & 899 BTEST( wall_flags_0(k,j,i), 0 ) ) 900 cs_3d(k,j,i) = cs_pr_init(k) * flag 901 ENDDO 902 ENDDO 903 ENDDO 904 905 ELSEIF ( decycle_method(boundary) == 'neumann' ) THEN 906 ! 907 !-- The value at the boundary is copied to the ghost layers to simulate 908 !-- an outlet with zero gradient 909 ss = 1 910 ee = 0 911 IF ( boundary == 1 .AND. nxl == 0 ) THEN 912 ss = nxlg 913 ee = nxl-1 914 copied = nxl 915 ELSEIF ( boundary == 2 .AND. nxr == nx ) THEN 916 ss = nxr+1 917 ee = nxrg 918 copied = nxr 919 ENDIF 920 921 DO i = ss, ee 922 DO j = nysg, nyng 923 DO k = nzb+1, nzt 924 flag = MERGE( 1.0_wp, 0.0_wp, & 925 BTEST( wall_flags_0(k,j,i), 0 ) ) 926 cs_3d(k,j,i) = cs_3d(k,j,copied) * flag 927 ENDDO 928 ENDDO 929 ENDDO 930 931 ELSE 932 WRITE(message_string,*) & 933 'unknown decycling method: decycle_method (', & 934 boundary, ') ="' // TRIM( decycle_method(boundary) ) // '"' 935 CALL message( 'chem_boundary_conds_decycle', 'CM0431', & 936 1, 2, 0, 6, 0 ) 937 ENDIF 938 ENDDO 939 ENDIF 940 ! 941 !-- South and north boundaries 942 IF ( decycle_chem_ns .AND. bc_ns_cyc ) THEN 943 944 DO boundary = 3, 4 945 946 IF ( decycle_method(boundary) == 'dirichlet' ) THEN 947 ! 948 !-- Initial profile is copied to ghost and first three layers 949 ss = 1 950 ee = 0 951 IF ( boundary == 3 .AND. nys == 0 ) THEN 952 ss = nysg 953 ee = nys-1 954 ELSEIF ( boundary == 4 .AND. nyn == ny ) THEN 955 ss = nyn+1 956 ee = nyng 957 ENDIF 958 959 DO i = nxlg, nxrg 960 DO j = ss, ee 961 DO k = nzb+1, nzt 962 flag = MERGE( 1.0_wp, 0.0_wp, & 963 BTEST( wall_flags_0(k,j,i), 0 ) ) 964 cs_3d(k,j,i) = cs_pr_init(k) * flag 965 ENDDO 966 ENDDO 967 ENDDO 968 969 970 ELSEIF ( decycle_method(boundary) == 'neumann' ) THEN 971 ! 972 !-- The value at the boundary is copied to the ghost layers to simulate 973 !-- an outlet with zero gradient 974 ss = 1 975 ee = 0 976 IF ( boundary == 3 .AND. nys == 0 ) THEN 977 ss = nysg 978 ee = nys-1 979 copied = nys 980 ELSEIF ( boundary == 4 .AND. nyn == ny ) THEN 981 ss = nyn+1 982 ee = nyng 983 copied = nyn 984 ENDIF 985 986 DO i = nxlg, nxrg 987 DO j = ss, ee 988 DO k = nzb+1, nzt 989 flag = MERGE( 1.0_wp, 0.0_wp, & 990 BTEST( wall_flags_0(k,j,i), 0 ) ) 991 cs_3d(k,j,i) = cs_3d(k,copied,i) * flag 992 ENDDO 993 ENDDO 994 ENDDO 995 996 ELSE 997 WRITE(message_string,*) & 998 'unknown decycling method: decycle_method (', & 999 boundary, ') ="' // TRIM( decycle_method(boundary) ) // '"' 1000 CALL message( 'chem_boundary_conds_decycle', 'CM0432', & 1001 1, 2, 0, 6, 0 ) 1002 ENDIF 1003 ENDDO 1004 ENDIF 865 USE control_parameters, & 866 ONLY: nesting_offline 867 868 INTEGER(iwp) :: boundary !< 869 INTEGER(iwp) :: ee !< 870 INTEGER(iwp) :: copied !< 871 INTEGER(iwp) :: i !< 872 INTEGER(iwp) :: j !< 873 INTEGER(iwp) :: k !< 874 INTEGER(iwp) :: ss !< 875 876 REAL(wp), DIMENSION(nzb:nzt+1) :: cs_pr_init 877 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: cs_3d 878 REAL(wp) :: flag !< flag to mask topography grid points 879 880 881 flag = 0.0_wp 882 ! 883 !-- Skip input if forcing from a larger-scale model is applied 884 IF ( nesting_offline .AND. nesting_offline_chem ) RETURN 885 ! 886 !-- Left and right boundaries 887 IF ( decycle_chem_lr .AND. bc_lr_cyc ) THEN 888 889 DO boundary = 1, 2 890 891 IF ( decycle_method(boundary) == 'dirichlet' ) THEN 892 ! 893 !-- Initial profile is copied to ghost and first three layers 894 ss = 1 895 ee = 0 896 IF ( boundary == 1 .AND. nxl == 0 ) THEN 897 ss = nxlg 898 ee = nxl-1 899 ELSEIF ( boundary == 2 .AND. nxr == nx ) THEN 900 ss = nxr+1 901 ee = nxrg 902 ENDIF 903 904 DO i = ss, ee 905 DO j = nysg, nyng 906 DO k = nzb+1, nzt 907 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) 908 cs_3d(k,j,i) = cs_pr_init(k) * flag 909 ENDDO 910 ENDDO 911 ENDDO 912 913 ELSEIF ( decycle_method(boundary) == 'neumann' ) THEN 914 ! 915 !-- The value at the boundary is copied to the ghost layers to simulate 916 !-- an outlet with zero gradient 917 ss = 1 918 ee = 0 919 IF ( boundary == 1 .AND. nxl == 0 ) THEN 920 ss = nxlg 921 ee = nxl-1 922 copied = nxl 923 ELSEIF ( boundary == 2 .AND. nxr == nx ) THEN 924 ss = nxr+1 925 ee = nxrg 926 copied = nxr 927 ENDIF 928 929 DO i = ss, ee 930 DO j = nysg, nyng 931 DO k = nzb+1, nzt 932 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) 933 cs_3d(k,j,i) = cs_3d(k,j,copied) * flag 934 ENDDO 935 ENDDO 936 ENDDO 937 938 ELSE 939 WRITE(message_string,*) & 940 'unknown decycling method: decycle_method (', & 941 boundary, ') ="' // TRIM( decycle_method(boundary) ) // '"' 942 CALL message( 'chem_boundary_conds_decycle', 'CM0431', & 943 1, 2, 0, 6, 0 ) 944 ENDIF 945 ENDDO 946 ENDIF 947 ! 948 !-- South and north boundaries 949 IF ( decycle_chem_ns .AND. bc_ns_cyc ) THEN 950 951 DO boundary = 3, 4 952 953 IF ( decycle_method(boundary) == 'dirichlet' ) THEN 954 ! 955 !-- Initial profile is copied to ghost and first three layers 956 ss = 1 957 ee = 0 958 IF ( boundary == 3 .AND. nys == 0 ) THEN 959 ss = nysg 960 ee = nys-1 961 ELSEIF ( boundary == 4 .AND. nyn == ny ) THEN 962 ss = nyn+1 963 ee = nyng 964 ENDIF 965 966 DO i = nxlg, nxrg 967 DO j = ss, ee 968 DO k = nzb+1, nzt 969 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) 970 cs_3d(k,j,i) = cs_pr_init(k) * flag 971 ENDDO 972 ENDDO 973 ENDDO 974 975 976 ELSEIF ( decycle_method(boundary) == 'neumann' ) THEN 977 ! 978 !-- The value at the boundary is copied to the ghost layers to simulate 979 !-- an outlet with zero gradient 980 ss = 1 981 ee = 0 982 IF ( boundary == 3 .AND. nys == 0 ) THEN 983 ss = nysg 984 ee = nys-1 985 copied = nys 986 ELSEIF ( boundary == 4 .AND. nyn == ny ) THEN 987 ss = nyn+1 988 ee = nyng 989 copied = nyn 990 ENDIF 991 992 DO i = nxlg, nxrg 993 DO j = ss, ee 994 DO k = nzb+1, nzt 995 flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) 996 cs_3d(k,j,i) = cs_3d(k,copied,i) * flag 997 ENDDO 998 ENDDO 999 ENDDO 1000 1001 ELSE 1002 WRITE(message_string,*) & 1003 'unknown decycling method: decycle_method (', & 1004 boundary, ') ="' // TRIM( decycle_method(boundary) ) // '"' 1005 CALL message( 'chem_boundary_conds_decycle', 'CM0432', & 1006 1, 2, 0, 6, 0 ) 1007 ENDIF 1008 ENDDO 1009 ENDIF 1005 1010 1006 1011 … … 1175 1180 message_string = 'Incorrect chemistry mechanism selected, check spelling in namelist and/or chem_gasphase_mod' 1176 1181 CALL message( 'chem_check_parameters', 'CM0462', 1, 2, 0, 6, 0 ) 1182 ENDIF 1183 ! 1184 !-- If nesting_chem = .F., set top boundary condition to its default value 1185 IF ( .NOT. nesting_chem .AND. ibc_cs_t == 3 ) THEN 1186 ibc_cs_t = 2 1187 bc_cs_t = 'initial_gradient' 1177 1188 ENDIF 1178 1189 ! … … 1681 1692 WRITE ( io, 11 ) docsinit_chr 1682 1693 ENDIF 1694 1695 IF ( nesting_chem ) WRITE( io, 12 ) nesting_chem 1696 IF ( nesting_offline_chem ) WRITE( io, 13 ) nesting_offline_chem 1683 1697 ! 1684 1698 !-- number of variable and fix chemical species and number of reactions … … 1703 1717 10 FORMAT (/' ',A) 1704 1718 11 FORMAT (/' ',A) 1719 12 FORMAT (/' Nesting for chemistry variables: ', L1 ) 1720 13 FORMAT (/' Offline nesting for chemistry variables: ', L1 ) 1705 1721 ! 1706 1722 ! … … 2267 2283 mode_emis, & 2268 2284 my_steps, & 2285 nesting_chem, & 2286 nesting_offline_chem, & 2269 2287 rcntrl, & 2270 2288 side_street_id, &
Note: See TracChangeset
for help on using the changeset viewer.
