Ignore:
Timestamp:
Oct 24, 2019 1:40:54 PM (20 months ago)
Author:
monakurppa
Message:

Add logical switched nesting_chem and nesting_offline_chem

File:
1 edited

Legend:

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

    r4272 r4273  
    2727! -----------------
    2828! $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
    2933! Further modularization of boundary conditions: moved boundary conditions to
    3034! respective modules
     
    859863 SUBROUTINE chem_boundary_conds_decycle( cs_3d, cs_pr_init )
    860864
    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
    10051010
    10061011
     
    11751180       message_string = 'Incorrect chemistry mechanism selected, check spelling in namelist and/or chem_gasphase_mod'
    11761181       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'
    11771188    ENDIF
    11781189!
     
    16811692       WRITE ( io, 11 )  docsinit_chr
    16821693    ENDIF
     1694
     1695    IF ( nesting_chem )  WRITE( io, 12 )  nesting_chem
     1696    IF ( nesting_offline_chem )  WRITE( io, 13 )  nesting_offline_chem
    16831697!
    16841698!-- number of variable and fix chemical species and number of reactions
     
    1703171710  FORMAT (/'    ',A) 
    1704171811  FORMAT (/'    ',A)
     171912  FORMAT (/'   Nesting for chemistry variables: ', L1 )
     172013  FORMAT (/'   Offline nesting for chemistry variables: ', L1 )
    17051721!
    17061722!
     
    22672283         mode_emis,                        &
    22682284         my_steps,                         &
     2285         nesting_chem,                     &
     2286         nesting_offline_chem,             &
    22692287         rcntrl,                           &
    22702288         side_street_id,                   &
Note: See TracChangeset for help on using the changeset viewer.