Ignore:
Timestamp:
Feb 21, 2017 9:57:40 AM (5 years ago)
Author:
hoffmann
Message:

bugfix in cloud microphysics

File:
1 edited

Legend:

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

    r2119 r2155  
    2020! Current revisions:
    2121! ------------------
    22 !
    23 ! 
     22! Bugfix in the calculation of microphysical quantities on ghost points.
     23!
    2424! Former revisions:
    2525! -----------------
     
    2828! 2118 2017-01-17 16:38:49Z raasch
    2929! OpenACC version of subroutine removed
    30 ! 
     30!
    3131! 2031 2016-10-21 15:11:58Z knoop
    3232! renamed variable rho to rho_ocean
    33 ! 
     33!
    3434! 2011 2016-09-19 17:29:57Z kanani
    3535! Flag urban_surface is now defined in module control_parameters.
    36 ! 
     36!
    3737! 2007 2016-08-24 15:47:17Z kanani
    3838! Added pt tendency calculation based on energy balance at urban surfaces
    3939! (new urban surface model)
    40 ! 
     40!
    4141! 2000 2016-08-20 18:09:15Z knoop
    4242! Forced header and separation lines into 80 columns
    43 ! 
     43!
    4444! 1976 2016-07-27 13:28:04Z maronga
    4545! Simplied calls to radiation model
    46 ! 
     46!
    4747! 1960 2016-07-12 16:34:24Z suehring
    4848! Separate humidity and passive scalar
    49 ! 
     49!
    5050! 1914 2016-05-26 14:44:07Z witha
    5151! Added calls for wind turbine model
     
    5353! 1873 2016-04-18 14:50:06Z maronga
    5454! Module renamed (removed _mod)
    55 ! 
     55!
    5656! 1850 2016-04-08 13:29:27Z maronga
    5757! Module renamed
    58 ! 
     58!
    5959! 1826 2016-04-07 12:01:39Z maronga
    6060! Renamed canopy model calls.
    61 ! 
     61!
    6262! 1822 2016-04-07 07:49:42Z hoffmann
    6363! Kessler microphysics scheme moved to microphysics.
    6464!
    6565! 1757 2016-02-22 15:49:32Z maronga
    66 ! 
     66!
    6767! 1691 2015-10-26 16:17:44Z maronga
    6868! Added optional model spin-up without radiation / land surface model calls.
    6969! Formatting corrections.
    70 ! 
     70!
    7171! 1682 2015-10-07 23:56:08Z knoop
    72 ! Code annotations made doxygen readable 
    73 ! 
     72! Code annotations made doxygen readable
     73!
    7474! 1585 2015-04-30 07:05:52Z maronga
    7575! Added call for temperature tendency calculation due to radiative flux divergence
    76 ! 
     76!
    7777! 1517 2015-01-07 19:12:25Z hoffmann
    7878! advec_s_bc_mod addded, since advec_s_bc is now a module
     
    8080! 1496 2014-12-02 17:25:50Z maronga
    8181! Renamed "radiation" -> "cloud_top_radiation"
    82 ! 
     82!
    8383! 1484 2014-10-21 10:53:05Z kanani
    8484! Changes due to new module structure of the plant canopy model:
     
    8686! Removed double-listing of use_upstream_for_tke in ONLY-list of module
    8787! control_parameters
    88 ! 
     88!
    8989! 1409 2014-05-23 12:11:32Z suehring
    90 ! Bugfix: i_omp_start changed for advec_u_ws at left inflow and outflow boundary. 
     90! Bugfix: i_omp_start changed for advec_u_ws at left inflow and outflow boundary.
    9191! This ensures that left-hand side fluxes are also calculated for nxl in that
    92 ! case, even though the solution at nxl is overwritten in boundary_conds() 
    93 ! 
     92! case, even though the solution at nxl is overwritten in boundary_conds()
     93!
    9494! 1398 2014-05-07 11:15:00Z heinze
    9595! Rayleigh-damping for horizontal velocity components changed: instead of damping
    96 ! against ug and vg, damping against u_init and v_init is used to allow for a 
     96! against ug and vg, damping against u_init and v_init is used to allow for a
    9797! homogenized treatment in case of nudging
    98 ! 
     98!
    9999! 1380 2014-04-28 12:40:45Z heinze
    100 ! Change order of calls for scalar prognostic quantities: 
    101 ! ls_advec -> nudging -> subsidence since initial profiles 
    102 ! 
     100! Change order of calls for scalar prognostic quantities:
     101! ls_advec -> nudging -> subsidence since initial profiles
     102!
    103103! 1374 2014-04-25 12:55:07Z raasch
    104104! missing variables added to ONLY lists
    105 ! 
     105!
    106106! 1365 2014-04-22 15:03:56Z boeske
    107 ! Calls of ls_advec for large scale advection added, 
     107! Calls of ls_advec for large scale advection added,
    108108! subroutine subsidence is only called if use_subsidence_tendencies = .F.,
    109109! new argument ls_index added to the calls of subsidence
    110110! +ls_index
    111 ! 
     111!
    112112! 1361 2014-04-16 15:17:48Z hoffmann
    113113! Two-moment microphysics moved to the start of prognostic equations. This makes
     
    117117!
    118118! Two-moment cloud physics added for vector and accelerator optimization.
    119 ! 
     119!
    120120! 1353 2014-04-08 15:21:23Z heinze
    121121! REAL constants provided with KIND-attribute
    122 ! 
     122!
    123123! 1337 2014-03-25 15:11:48Z heinze
    124124! Bugfix: REAL constants provided with KIND-attribute
    125 ! 
     125!
    126126! 1332 2014-03-25 11:59:43Z suehring
    127 ! Bugfix: call advec_ws or advec_pw for TKE only if NOT use_upstream_for_tke 
    128 ! 
     127! Bugfix: call advec_ws or advec_pw for TKE only if NOT use_upstream_for_tke
     128!
    129129! 1330 2014-03-24 17:29:32Z suehring
    130 ! In case of SGS-particle velocity advection of TKE is also allowed with 
     130! In case of SGS-particle velocity advection of TKE is also allowed with
    131131! dissipative 5th-order scheme.
    132132!
     
    161161!
    162162! 1115 2013-03-26 18:16:16Z hoffmann
    163 ! optimized cloud physics: calculation of microphysical tendencies transfered 
     163! optimized cloud physics: calculation of microphysical tendencies transfered
    164164! to microphysics.f90; qr and nr are only calculated if precipitation is required
    165165!
     
    211211 MODULE prognostic_equations_mod
    212212
    213  
     213
    214214
    215215    USE arrays_3d,                                                             &
     
    225225               te_m, tnr_m, tpt_m, tq_m, tqr_m, ts_m, tsa_m, tswst, tu_m, tv_m,&
    226226               tw_m, u, ug, u_init, u_p, v, vg, vpt, v_init, v_p, w, w_p
    227        
     227
    228228    USE control_parameters,                                                    &
    229229        ONLY:  call_microphysics_at_all_substeps, cloud_physics,               &
     
    249249
    250250    USE indices,                                                               &
    251         ONLY:  nxl, nxlu, nxr, nyn, nys, nysv, nzb_s_inner, nzb_u_inner,       &
    252                nzb_v_inner, nzb_w_inner, nzt
     251        ONLY:  nxl, nxlg, nxlu, nxr, nxrg, nyn, nyng, nys, nysg, nysv,         &
     252               nzb_s_inner, nzb_u_inner, nzb_v_inner, nzb_w_inner, nzt
    253253
    254254    USE advec_ws,                                                              &
     
    287287    USE calc_radiation_mod,                                                    &
    288288        ONLY:  calc_radiation
    289  
     289
    290290    USE coriolis_mod,                                                          &
    291291        ONLY:  coriolis
     
    370370!> (Optimized to avoid cache missings, i.e. for Power4/5-architectures.)
    371371!------------------------------------------------------------------------------!
    372  
     372
    373373 SUBROUTINE prognostic_equations_cache
    374374
     
    382382    INTEGER(iwp) ::  omp_get_thread_num  !<
    383383    INTEGER(iwp) ::  tn = 0              !<
    384    
     384
    385385    LOGICAL      ::  loop_start          !<
    386386
     
    394394!$OMP PARALLEL private (i,i_omp_start,j,k,loop_start,tn)
    395395
    396 !$  tn = omp_get_thread_num() 
     396!$  tn = omp_get_thread_num()
    397397    loop_start = .TRUE.
    398398!$OMP DO
     399
     400!
     401!-- If required, calculate cloud microphysics
     402    IF ( cloud_physics  .AND.  .NOT. microphysics_sat_adjust  .AND.            &
     403         ( intermediate_timestep_count == 1  .OR.                              &
     404           call_microphysics_at_all_substeps )                                 &
     405       )  THEN
     406       DO  i = nxlg, nxrg
     407          DO  j = nysg, nyng
     408             CALL microphysics_control( i, j )
     409           END DO
     410       END DO
     411    ENDIF
     412
    399413    DO  i = nxl, nxr
    400414
     
    404418       IF ( loop_start )  THEN
    405419          loop_start  = .FALSE.
    406           i_omp_start = i 
     420          i_omp_start = i
    407421       ENDIF
    408422
    409423       DO  j = nys, nyn
    410 !
    411 !--       If required, calculate cloud microphysics
    412           IF ( cloud_physics  .AND.  .NOT. microphysics_sat_adjust  .AND.      &
    413                ( intermediate_timestep_count == 1  .OR.                        &
    414                  call_microphysics_at_all_substeps )                           &
    415              )  THEN
    416              CALL microphysics_control( i, j )
    417           ENDIF
    418424!
    419425!--       Tendency terms for u-velocity component
     
    424430                IF ( ws_scheme_mom )  THEN
    425431                   CALL advec_u_ws( i, j, i_omp_start, tn )
    426                 ELSE 
     432                ELSE
    427433                   CALL advec_u_pw( i, j )
    428                 ENDIF 
     434                ENDIF
    429435             ELSE
    430436                CALL advec_u_up( i, j )
     
    490496                IF ( ws_scheme_mom )  THEN
    491497                    CALL advec_v_ws( i, j, i_omp_start, tn )
    492                 ELSE 
     498                ELSE
    493499                    CALL advec_v_pw( i, j )
    494500                ENDIF
     
    501507!
    502508!--          Drag by plant canopy
    503              IF ( plant_canopy )  CALL pcm_tendency( i, j, 2 )       
     509             IF ( plant_canopy )  CALL pcm_tendency( i, j, 2 )
    504510
    505511!
     
    551557             IF ( ws_scheme_mom )  THEN
    552558                CALL advec_w_ws( i, j, i_omp_start, tn )
    553              ELSE 
     559             ELSE
    554560                CALL advec_w_pw( i, j )
    555561             END IF
     
    646652             IF ( large_scale_forcing )  THEN
    647653                CALL ls_advec( i, j, simulated_time, 'pt' )
    648              ENDIF     
     654             ENDIF
    649655
    650656!
    651657!--          Nudging
    652              IF ( nudging )  CALL nudge( i, j, simulated_time, 'pt' ) 
     658             IF ( nudging )  CALL nudge( i, j, simulated_time, 'pt' )
    653659
    654660!
     
    708714                    CALL advec_s_ws( i, j, sa, 'sa', flux_s_sa,  &
    709715                                diss_s_sa, flux_l_sa, diss_l_sa, i_omp_start, tn  )
    710                 ELSE 
     716                ELSE
    711717                    CALL advec_s_pw( i, j, sa )
    712718                ENDIF
     
    760766             THEN
    761767                IF ( ws_scheme_sca )  THEN
    762                    CALL advec_s_ws( i, j, q, 'q', flux_s_q, & 
     768                   CALL advec_s_ws( i, j, q, 'q', flux_s_q, &
    763769                                diss_s_q, flux_l_q, diss_l_q, i_omp_start, tn )
    764                 ELSE 
     770                ELSE
    765771                   CALL advec_s_pw( i, j, q )
    766772                ENDIF
     
    782788!
    783789!--          Nudging
    784              IF ( nudging )  CALL nudge( i, j, simulated_time, 'q' ) 
     790             IF ( nudging )  CALL nudge( i, j, simulated_time, 'q' )
    785791
    786792!
     
    820826
    821827!
    822 !--          If required, calculate prognostic equations for rain water content 
     828!--          If required, calculate prognostic equations for rain water content
    823829!--          and rain drop concentration
    824830             IF ( cloud_physics  .AND.  microphysics_seifert )  THEN
     
    829835                THEN
    830836                   IF ( ws_scheme_sca )  THEN
    831                       CALL advec_s_ws( i, j, qr, 'qr', flux_s_qr,       & 
     837                      CALL advec_s_ws( i, j, qr, 'qr', flux_s_qr,       &
    832838                                       diss_s_qr, flux_l_qr, diss_l_qr, &
    833839                                       i_omp_start, tn )
    834                    ELSE 
     840                   ELSE
    835841                      CALL advec_s_pw( i, j, qr )
    836842                   ENDIF
     
    869875                IF ( timestep_scheme(1:5) == 'runge' )  THEN
    870876                   IF ( ws_scheme_sca )  THEN
    871                       CALL advec_s_ws( i, j, nr, 'nr', flux_s_nr,    & 
     877                      CALL advec_s_ws( i, j, nr, 'nr', flux_s_nr,    &
    872878                                    diss_s_nr, flux_l_nr, diss_l_nr, &
    873879                                    i_omp_start, tn )
    874                    ELSE 
     880                   ELSE
    875881                      CALL advec_s_pw( i, j, nr )
    876882                   ENDIF
     
    907913
    908914          ENDIF
    909          
     915
    910916!
    911917!--       If required, compute prognostic equation for scalar
     
    917923             THEN
    918924                IF ( ws_scheme_sca )  THEN
    919                    CALL advec_s_ws( i, j, s, 's', flux_s_s, & 
     925                   CALL advec_s_ws( i, j, s, 's', flux_s_s, &
    920926                                diss_s_s, flux_l_s, diss_l_s, i_omp_start, tn )
    921                 ELSE 
     927                ELSE
    922928                   CALL advec_s_pw( i, j, s )
    923929                ENDIF
     
    939945!
    940946!--          Nudging, still need to be extended for scalars
    941 !              IF ( nudging )  CALL nudge( i, j, simulated_time, 's' ) 
     947!              IF ( nudging )  CALL nudge( i, j, simulated_time, 's' )
    942948
    943949!
    944950!--          If required compute influence of large-scale subsidence/ascent.
    945 !--          Note, the last argument is of no meaning in this case, as it is 
    946 !--          only used in conjunction with large_scale_forcing, which is to 
     951!--          Note, the last argument is of no meaning in this case, as it is
     952!--          only used in conjunction with large_scale_forcing, which is to
    947953!--          date not implemented for scalars.
    948954             IF ( large_scale_subsidence  .AND.                                &
     
    980986             ENDIF
    981987
    982           ENDIF         
    983 !
    984 !--       If required, compute prognostic equation for turbulent kinetic 
     988          ENDIF
     989!
     990!--       If required, compute prognostic equation for turbulent kinetic
    985991!--       energy (TKE)
    986992          IF ( .NOT. constant_diffusion )  THEN
     
    990996             tend(:,j,i) = 0.0_wp
    991997             IF ( timestep_scheme(1:5) == 'runge'  &
    992                  .AND.  .NOT. use_upstream_for_tke )  THEN 
     998                 .AND.  .NOT. use_upstream_for_tke )  THEN
    993999                 IF ( ws_scheme_sca )  THEN
    9941000                     CALL advec_s_ws( i, j, e, 'e', flux_s_e, diss_s_e, &
     
    10131019!
    10141020!--          Additional sink term for flows through plant canopies
    1015              IF ( plant_canopy )  CALL pcm_tendency( i, j, 6 ) 
     1021             IF ( plant_canopy )  CALL pcm_tendency( i, j, 6 )
    10161022
    10171023             CALL user_actions( i, j, 'e-tendency' )
     
    10611067!> Version for vector machines
    10621068!------------------------------------------------------------------------------!
    1063  
     1069
    10641070 SUBROUTINE prognostic_equations_vector
    10651071
     
    11761182       IF ( ws_scheme_mom )  THEN
    11771183          CALL advec_v_ws
    1178        ELSE 
     1184       ELSE
    11791185          CALL advec_v_pw
    11801186       END IF
     
    13891395!
    13901396!--    Nudging
    1391        IF ( nudging )  CALL nudge( simulated_time, 'pt' ) 
     1397       IF ( nudging )  CALL nudge( simulated_time, 'pt' )
    13921398
    13931399!
     
    14851491
    14861492       CALL diffusion_s( sa, saswsb, saswst, wall_salinityflux )
    1487        
     1493
    14881494       CALL user_actions( 'sa-tendency' )
    14891495
     
    15731579
    15741580       CALL diffusion_s( q, qsws, qswst, wall_qflux )
    1575        
     1581
    15761582!
    15771583!--    Sink or source of humidity due to canopy elements
     
    15861592!
    15871593!--    Nudging
    1588        IF ( nudging )  CALL nudge( simulated_time, 'q' ) 
     1594       IF ( nudging )  CALL nudge( simulated_time, 'q' )
    15891595
    15901596!
     
    16371643
    16381644!
    1639 !--    If required, calculate prognostic equations for rain water content 
     1645!--    If required, calculate prognostic equations for rain water content
    16401646!--    and rain drop concentration
    16411647       IF ( cloud_physics  .AND.  microphysics_seifert )  THEN
     
    16751681          CALL diffusion_s( qr, qrsws, qrswst, wall_qrflux )
    16761682
    1677           CALL user_actions( 'qr-tendency' )
    1678 
    16791683!
    16801684!--       Prognostic equation for rain water content
     
    18281832
    18291833       CALL diffusion_s( s, ssws, sswst, wall_sflux )
    1830        
     1834
    18311835!
    18321836!--    Sink or source of humidity due to canopy elements
     
    18411845!
    18421846!--    Nudging. Not implemented for scalars so far.
    1843 !        IF ( nudging )  CALL nudge( simulated_time, 'q' ) 
     1847!        IF ( nudging )  CALL nudge( simulated_time, 'q' )
    18441848
    18451849!
     
    18951899    ENDIF
    18961900!
    1897 !-- If required, compute prognostic equation for turbulent kinetic 
     1901!-- If required, compute prognostic equation for turbulent kinetic
    18981902!-- energy (TKE)
    18991903    IF ( .NOT. constant_diffusion )  THEN
     
    19271931                IF ( ws_scheme_sca )  THEN
    19281932                   CALL advec_s_ws( e, 'e' )
    1929                 ELSE 
     1933                ELSE
    19301934                   CALL advec_s_pw( e )
    19311935                ENDIF
Note: See TracChangeset for help on using the changeset viewer.