Changeset 3879 for palm/trunk/SOURCE/chemistry_model_mod.f90
- Timestamp:
- Apr 8, 2019 8:25:23 PM (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
palm/trunk/SOURCE/chemistry_model_mod.f90
r3878 r3879 289 289 290 290 USE indices, & 291 ONLY: n z, nzb, nzt, nysg, nyng, nxlg, nxrg, nys, nyn, nx, nxl, nxr, ny, wall_flags_0291 ONLY: nbgp, nz, nzb, nzt, nysg, nyng, nxlg, nxrg, nys, nyn, nx, nxl, nxr, ny, wall_flags_0 292 292 293 293 USE pegrid, & … … 429 429 INTERFACE chem_boundary_conds 430 430 MODULE PROCEDURE chem_boundary_conds 431 END INTERFACE chem_boundary_conds 432 433 INTERFACE chem_boundary_conds_decycle 431 434 MODULE PROCEDURE chem_boundary_conds_decycle 432 END INTERFACE chem_boundary_conds 435 END INTERFACE chem_boundary_conds_decycle 433 436 434 437 INTERFACE chem_check_data_output … … 585 588 586 589 587 PUBLIC chem_3d_data_averaging, chem_boundary_conds, chem_check_data_output, & 590 PUBLIC chem_3d_data_averaging, chem_boundary_conds, & 591 chem_boundary_conds_decycle, chem_check_data_output, & 588 592 chem_check_data_output_pr, chem_check_parameters, & 589 593 chem_data_output_2d, chem_data_output_3d, chem_data_output_mask, & … … 871 875 !> x-direction 872 876 !------------------------------------------------------------------------------! 873 SUBROUTINE chem_boundary_conds_decycle( cs_3d, cs_pr_init)877 SUBROUTINE chem_boundary_conds_decycle() 874 878 ! 875 879 !-- Decycling of chemistry variables: Dirichlet BCs with cyclic is frequently not … … 887 891 INTEGER(iwp) :: k !< 888 892 INTEGER(iwp) :: ss !< 893 INTEGER(iwp) :: lsp !< 894 INTEGER(iwp) :: lsp_usr !< 889 895 REAL(wp), DIMENSION(nzb:nzt+1) :: cs_pr_init 890 896 REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: cs_3d 891 897 REAL(wp) :: flag !< flag to mask topography grid points 892 898 893 flag = 0.0_wp 894 ! 895 !-- Left and right boundaries 896 IF ( decycle_chem_lr .AND. bc_lr_cyc ) THEN 897 898 DO boundary = 1, 2 899 900 IF ( decycle_method(boundary) == 'dirichlet' ) THEN 901 ! 902 !-- Initial profile is copied to ghost and first three layers 903 ss = 1 904 ee = 0 905 IF ( boundary == 1 .AND. nxl == 0 ) THEN 906 ss = nxlg 907 ee = nxl+2 908 ELSEIF ( boundary == 2 .AND. nxr == nx ) THEN 909 ss = nxr-2 910 ee = nxrg 899 CALL cpu_log( log_point_s(84), 'chem.exch-horiz', 'start' ) 900 901 DO lsp = 1, nspec 902 903 CALL exchange_horiz( chem_species(lsp)%conc_p, nbgp ) 904 lsp_usr = 1 905 DO WHILE ( TRIM( cs_name( lsp_usr ) ) /= 'novalue' ) 906 IF ( TRIM(chem_species(lsp)%name) == TRIM(cs_name(lsp_usr)) ) THEN 907 908 cs_3d = chem_species(lsp)%conc_p 909 cs_pr_init = chem_species(lsp)%conc_pr_init 910 911 flag = 0.0_wp 912 ! 913 !-- Left and right boundaries 914 IF ( decycle_chem_lr .AND. bc_lr_cyc ) THEN 915 916 DO boundary = 1, 2 917 918 IF ( decycle_method(boundary) == 'dirichlet' ) THEN 919 ! 920 !-- Initial profile is copied to ghost and first three layers 921 ss = 1 922 ee = 0 923 IF ( boundary == 1 .AND. nxl == 0 ) THEN 924 ss = nxlg 925 ee = nxl+2 926 ELSEIF ( boundary == 2 .AND. nxr == nx ) THEN 927 ss = nxr-2 928 ee = nxrg 929 ENDIF 930 931 DO i = ss, ee 932 DO j = nysg, nyng 933 DO k = nzb+1, nzt 934 flag = MERGE( 1.0_wp, 0.0_wp, & 935 BTEST( wall_flags_0(k,j,i), 0 ) ) 936 cs_3d(k,j,i) = cs_pr_init(k) * flag 937 ENDDO 938 ENDDO 939 ENDDO 940 941 ELSEIF ( decycle_method(boundary) == 'neumann' ) THEN 942 ! 943 !-- The value at the boundary is copied to the ghost layers to simulate 944 !-- an outlet with zero gradient 945 ss = 1 946 ee = 0 947 IF ( boundary == 1 .AND. nxl == 0 ) THEN 948 ss = nxlg 949 ee = nxl-1 950 copied = nxl 951 ELSEIF ( boundary == 2 .AND. nxr == nx ) THEN 952 ss = nxr+1 953 ee = nxrg 954 copied = nxr 955 ENDIF 956 957 DO i = ss, ee 958 DO j = nysg, nyng 959 DO k = nzb+1, nzt 960 flag = MERGE( 1.0_wp, 0.0_wp, & 961 BTEST( wall_flags_0(k,j,i), 0 ) ) 962 cs_3d(k,j,i) = cs_3d(k,j,copied) * flag 963 ENDDO 964 ENDDO 965 ENDDO 966 967 ELSE 968 WRITE(message_string,*) & 969 'unknown decycling method: decycle_method (', & 970 boundary, ') ="' // TRIM( decycle_method(boundary) ) // '"' 971 CALL message( 'chem_boundary_conds_decycle', 'CM0431', & 972 1, 2, 0, 6, 0 ) 973 ENDIF 974 ENDDO 911 975 ENDIF 912 913 DO i = ss, ee 914 DO j = nysg, nyng 915 DO k = nzb+1, nzt 916 flag = MERGE( 1.0_wp, 0.0_wp, & 917 BTEST( wall_flags_0(k,j,i), 0 ) ) 918 cs_3d(k,j,i) = cs_pr_init(k) * flag 919 ENDDO 976 ! 977 !-- South and north boundaries 978 IF ( decycle_chem_ns .AND. bc_ns_cyc ) THEN 979 980 DO boundary = 3, 4 981 982 IF ( decycle_method(boundary) == 'dirichlet' ) THEN 983 ! 984 !-- Initial profile is copied to ghost and first three layers 985 ss = 1 986 ee = 0 987 IF ( boundary == 3 .AND. nys == 0 ) THEN 988 ss = nysg 989 ee = nys+2 990 ELSEIF ( boundary == 4 .AND. nyn == ny ) THEN 991 ss = nyn-2 992 ee = nyng 993 ENDIF 994 995 DO i = nxlg, nxrg 996 DO j = ss, ee 997 DO k = nzb+1, nzt 998 flag = MERGE( 1.0_wp, 0.0_wp, & 999 BTEST( wall_flags_0(k,j,i), 0 ) ) 1000 cs_3d(k,j,i) = cs_pr_init(k) * flag 1001 ENDDO 1002 ENDDO 1003 ENDDO 1004 1005 1006 ELSEIF ( decycle_method(boundary) == 'neumann' ) THEN 1007 ! 1008 !-- The value at the boundary is copied to the ghost layers to simulate 1009 !-- an outlet with zero gradient 1010 ss = 1 1011 ee = 0 1012 IF ( boundary == 3 .AND. nys == 0 ) THEN 1013 ss = nysg 1014 ee = nys-1 1015 copied = nys 1016 ELSEIF ( boundary == 4 .AND. nyn == ny ) THEN 1017 ss = nyn+1 1018 ee = nyng 1019 copied = nyn 1020 ENDIF 1021 1022 DO i = nxlg, nxrg 1023 DO j = ss, ee 1024 DO k = nzb+1, nzt 1025 flag = MERGE( 1.0_wp, 0.0_wp, & 1026 BTEST( wall_flags_0(k,j,i), 0 ) ) 1027 cs_3d(k,j,i) = cs_3d(k,copied,i) * flag 1028 ENDDO 1029 ENDDO 1030 ENDDO 1031 1032 ELSE 1033 WRITE(message_string,*) & 1034 'unknown decycling method: decycle_method (', & 1035 boundary, ') ="' // TRIM( decycle_method(boundary) ) // '"' 1036 CALL message( 'chem_boundary_conds_decycle', 'CM0432', & 1037 1, 2, 0, 6, 0 ) 1038 ENDIF 920 1039 ENDDO 921 ENDDO922 923 ELSEIF ( decycle_method(boundary) == 'neumann' ) THEN924 !925 !-- The value at the boundary is copied to the ghost layers to simulate926 !-- an outlet with zero gradient927 ss = 1928 ee = 0929 IF ( boundary == 1 .AND. nxl == 0 ) THEN930 ss = nxlg931 ee = nxl-1932 copied = nxl933 ELSEIF ( boundary == 2 .AND. nxr == nx ) THEN934 ss = nxr+1935 ee = nxrg936 copied = nxr937 1040 ENDIF 938 1041 939 DO i = ss, ee940 DO j = nysg, nyng941 DO k = nzb+1, nzt942 flag = MERGE( 1.0_wp, 0.0_wp, &943 BTEST( wall_flags_0(k,j,i), 0 ) )944 cs_3d(k,j,i) = cs_3d(k,j,copied) * flag945 ENDDO946 ENDDO947 ENDDO948 949 ELSE950 WRITE(message_string,*) &951 'unknown decycling method: decycle_method (', &952 boundary, ') ="' // TRIM( decycle_method(boundary) ) // '"'953 CALL message( 'chem_boundary_conds_decycle', 'CM0431', &954 1, 2, 0, 6, 0 )955 1042 ENDIF 1043 1044 lsp_usr = lsp_usr + 1 1045 956 1046 ENDDO 957 ENDIF 958 ! 959 !-- South and north boundaries 960 IF ( decycle_chem_ns .AND. bc_ns_cyc ) THEN 961 962 DO boundary = 3, 4 963 964 IF ( decycle_method(boundary) == 'dirichlet' ) THEN 965 ! 966 !-- Initial profile is copied to ghost and first three layers 967 ss = 1 968 ee = 0 969 IF ( boundary == 3 .AND. nys == 0 ) THEN 970 ss = nysg 971 ee = nys+2 972 ELSEIF ( boundary == 4 .AND. nyn == ny ) THEN 973 ss = nyn-2 974 ee = nyng 975 ENDIF 976 977 DO i = nxlg, nxrg 978 DO j = ss, ee 979 DO k = nzb+1, nzt 980 flag = MERGE( 1.0_wp, 0.0_wp, & 981 BTEST( wall_flags_0(k,j,i), 0 ) ) 982 cs_3d(k,j,i) = cs_pr_init(k) * flag 983 ENDDO 984 ENDDO 985 ENDDO 986 987 988 ELSEIF ( decycle_method(boundary) == 'neumann' ) THEN 989 ! 990 !-- The value at the boundary is copied to the ghost layers to simulate 991 !-- an outlet with zero gradient 992 ss = 1 993 ee = 0 994 IF ( boundary == 3 .AND. nys == 0 ) THEN 995 ss = nysg 996 ee = nys-1 997 copied = nys 998 ELSEIF ( boundary == 4 .AND. nyn == ny ) THEN 999 ss = nyn+1 1000 ee = nyng 1001 copied = nyn 1002 ENDIF 1003 1004 DO i = nxlg, nxrg 1005 DO j = ss, ee 1006 DO k = nzb+1, nzt 1007 flag = MERGE( 1.0_wp, 0.0_wp, & 1008 BTEST( wall_flags_0(k,j,i), 0 ) ) 1009 cs_3d(k,j,i) = cs_3d(k,copied,i) * flag 1010 ENDDO 1011 ENDDO 1012 ENDDO 1013 1014 ELSE 1015 WRITE(message_string,*) & 1016 'unknown decycling method: decycle_method (', & 1017 boundary, ') ="' // TRIM( decycle_method(boundary) ) // '"' 1018 CALL message( 'chem_boundary_conds_decycle', 'CM0432', & 1019 1, 2, 0, 6, 0 ) 1020 ENDIF 1021 ENDDO 1022 ENDIF 1047 1048 ENDDO 1049 1050 CALL cpu_log( log_point_s(84), 'chem.exch-horiz', 'stop' ) 1051 1023 1052 END SUBROUTINE chem_boundary_conds_decycle 1024 1053
Note: See TracChangeset
for help on using the changeset viewer.