Changeset 2155 for palm/trunk/SOURCE/prognostic_equations.f90

Timestamp:

Feb 21, 2017 9:57:40 AM (7 years ago)

Author:

hoffmann

Message:

bugfix in cloud microphysics

File:

• palm/trunk/SOURCE/prognostic_equations.f90 (modified) (44 diffs)

palm/trunk/SOURCE/prognostic_equations.f90

@@ -20 +20 @@
 ! Current revisions:
 ! ------------------
-! 
-! 
+! Bugfix in the calculation of microphysical quantities on ghost points.
+!
 ! Former revisions:
 ! -----------------
@@ -28 +28 @@
 ! 2118 2017-01-17 16:38:49Z raasch
 ! OpenACC version of subroutine removed
-! 
+!
 ! 2031 2016-10-21 15:11:58Z knoop
 ! renamed variable rho to rho_ocean
-! 
+!
 ! 2011 2016-09-19 17:29:57Z kanani
 ! Flag urban_surface is now defined in module control_parameters.
-! 
+!
 ! 2007 2016-08-24 15:47:17Z kanani
 ! Added pt tendency calculation based on energy balance at urban surfaces
 ! (new urban surface model)
-! 
+!
 ! 2000 2016-08-20 18:09:15Z knoop
 ! Forced header and separation lines into 80 columns
-! 
+!
 ! 1976 2016-07-27 13:28:04Z maronga
 ! Simplied calls to radiation model
-! 
+!
 ! 1960 2016-07-12 16:34:24Z suehring
 ! Separate humidity and passive scalar
-! 
+!
 ! 1914 2016-05-26 14:44:07Z witha
 ! Added calls for wind turbine model
@@ -53 +53 @@
 ! 1873 2016-04-18 14:50:06Z maronga
 ! Module renamed (removed _mod)
-! 
+!
 ! 1850 2016-04-08 13:29:27Z maronga
 ! Module renamed
-! 
+!
 ! 1826 2016-04-07 12:01:39Z maronga
 ! Renamed canopy model calls.
-! 
+!
 ! 1822 2016-04-07 07:49:42Z hoffmann
 ! Kessler microphysics scheme moved to microphysics.
 !
 ! 1757 2016-02-22 15:49:32Z maronga
-! 
+!
 ! 1691 2015-10-26 16:17:44Z maronga
 ! Added optional model spin-up without radiation / land surface model calls.
 ! Formatting corrections.
-! 
+!
 ! 1682 2015-10-07 23:56:08Z knoop
-! Code annotations made doxygen readable 
-! 
+! Code annotations made doxygen readable
+!
 ! 1585 2015-04-30 07:05:52Z maronga
 ! Added call for temperature tendency calculation due to radiative flux divergence
-! 
+!
 ! 1517 2015-01-07 19:12:25Z hoffmann
 ! advec_s_bc_mod addded, since advec_s_bc is now a module
@@ -80 +80 @@
 ! 1496 2014-12-02 17:25:50Z maronga
 ! Renamed "radiation" -> "cloud_top_radiation"
-! 
+!
 ! 1484 2014-10-21 10:53:05Z kanani
 ! Changes due to new module structure of the plant canopy model:
@@ -86 +86 @@
 ! Removed double-listing of use_upstream_for_tke in ONLY-list of module
 ! control_parameters
-! 
+!
 ! 1409 2014-05-23 12:11:32Z suehring
-! Bugfix: i_omp_start changed for advec_u_ws at left inflow and outflow boundary. 
+! Bugfix: i_omp_start changed for advec_u_ws at left inflow and outflow boundary.
 ! This ensures that left-hand side fluxes are also calculated for nxl in that
-! case, even though the solution at nxl is overwritten in boundary_conds() 
-! 
+! case, even though the solution at nxl is overwritten in boundary_conds()
+!
 ! 1398 2014-05-07 11:15:00Z heinze
 ! Rayleigh-damping for horizontal velocity components changed: instead of damping
-! against ug and vg, damping against u_init and v_init is used to allow for a 
+! against ug and vg, damping against u_init and v_init is used to allow for a
 ! homogenized treatment in case of nudging
-! 
+!
 ! 1380 2014-04-28 12:40:45Z heinze
-! Change order of calls for scalar prognostic quantities: 
-! ls_advec -> nudging -> subsidence since initial profiles 
-! 
+! Change order of calls for scalar prognostic quantities:
+! ls_advec -> nudging -> subsidence since initial profiles
+!
 ! 1374 2014-04-25 12:55:07Z raasch
 ! missing variables added to ONLY lists
-! 
+!
 ! 1365 2014-04-22 15:03:56Z boeske
-! Calls of ls_advec for large scale advection added, 
+! Calls of ls_advec for large scale advection added,
 ! subroutine subsidence is only called if use_subsidence_tendencies = .F.,
 ! new argument ls_index added to the calls of subsidence
 ! +ls_index
-! 
+!
 ! 1361 2014-04-16 15:17:48Z hoffmann
 ! Two-moment microphysics moved to the start of prognostic equations. This makes
@@ -117 +117 @@
 !
 ! Two-moment cloud physics added for vector and accelerator optimization.
-! 
+!
 ! 1353 2014-04-08 15:21:23Z heinze
 ! REAL constants provided with KIND-attribute
-! 
+!
 ! 1337 2014-03-25 15:11:48Z heinze
 ! Bugfix: REAL constants provided with KIND-attribute
-! 
+!
 ! 1332 2014-03-25 11:59:43Z suehring
-! Bugfix: call advec_ws or advec_pw for TKE only if NOT use_upstream_for_tke 
-! 
+! Bugfix: call advec_ws or advec_pw for TKE only if NOT use_upstream_for_tke
+!
 ! 1330 2014-03-24 17:29:32Z suehring
-! In case of SGS-particle velocity advection of TKE is also allowed with 
+! In case of SGS-particle velocity advection of TKE is also allowed with
 ! dissipative 5th-order scheme.
 !
@@ -161 +161 @@
 !
 ! 1115 2013-03-26 18:16:16Z hoffmann
-! optimized cloud physics: calculation of microphysical tendencies transfered 
+! optimized cloud physics: calculation of microphysical tendencies transfered
 ! to microphysics.f90; qr and nr are only calculated if precipitation is required
 !
@@ -211 +211 @@
  MODULE prognostic_equations_mod
 
- 
+
 
     USE arrays_3d,                                                             &
@@ -225 +225 @@
                te_m, tnr_m, tpt_m, tq_m, tqr_m, ts_m, tsa_m, tswst, tu_m, tv_m,&
                tw_m, u, ug, u_init, u_p, v, vg, vpt, v_init, v_p, w, w_p
-        
+
     USE control_parameters,                                                    &
         ONLY:  call_microphysics_at_all_substeps, cloud_physics,               &
@@ -249 +249 @@
 
     USE indices,                                                               &
-        ONLY:  nxl, nxlu, nxr, nyn, nys, nysv, nzb_s_inner, nzb_u_inner,       &
-               nzb_v_inner, nzb_w_inner, nzt
+        ONLY:  nxl, nxlg, nxlu, nxr, nxrg, nyn, nyng, nys, nysg, nysv,         &
+               nzb_s_inner, nzb_u_inner, nzb_v_inner, nzb_w_inner, nzt
 
     USE advec_ws,                                                              &
@@ -287 +287 @@
     USE calc_radiation_mod,                                                    &
         ONLY:  calc_radiation
-  
+
     USE coriolis_mod,                                                          &
         ONLY:  coriolis
@@ -370 +370 @@
 !> (Optimized to avoid cache missings, i.e. for Power4/5-architectures.)
 !------------------------------------------------------------------------------!
- 
+
  SUBROUTINE prognostic_equations_cache
 
@@ -382 +382 @@
     INTEGER(iwp) ::  omp_get_thread_num  !<
     INTEGER(iwp) ::  tn = 0              !<
-    
+
     LOGICAL      ::  loop_start          !<
 
@@ -394 +394 @@
 !$OMP PARALLEL private (i,i_omp_start,j,k,loop_start,tn)
 
-!$  tn = omp_get_thread_num() 
+!$  tn = omp_get_thread_num()
     loop_start = .TRUE.
 !$OMP DO
+
+!
+!-- If required, calculate cloud microphysics
+    IF ( cloud_physics  .AND.  .NOT. microphysics_sat_adjust  .AND.            &
+         ( intermediate_timestep_count == 1  .OR.                              &
+           call_microphysics_at_all_substeps )                                 &
+       )  THEN
+       DO  i = nxlg, nxrg
+          DO  j = nysg, nyng
+             CALL microphysics_control( i, j )
+           END DO
+       END DO
+    ENDIF
+
     DO  i = nxl, nxr
 
@@ -404 +418 @@
        IF ( loop_start )  THEN
           loop_start  = .FALSE.
-          i_omp_start = i 
+          i_omp_start = i
        ENDIF
 
        DO  j = nys, nyn
-!
-!--       If required, calculate cloud microphysics
-          IF ( cloud_physics  .AND.  .NOT. microphysics_sat_adjust  .AND.      &
-               ( intermediate_timestep_count == 1  .OR.                        &
-                 call_microphysics_at_all_substeps )                           &
-             )  THEN
-             CALL microphysics_control( i, j )
-          ENDIF
 !
 !--       Tendency terms for u-velocity component
@@ -424 +430 @@
                 IF ( ws_scheme_mom )  THEN
                    CALL advec_u_ws( i, j, i_omp_start, tn )
-                ELSE 
+                ELSE
                    CALL advec_u_pw( i, j )
-                ENDIF 
+                ENDIF
              ELSE
                 CALL advec_u_up( i, j )
@@ -490 +496 @@
                 IF ( ws_scheme_mom )  THEN
                     CALL advec_v_ws( i, j, i_omp_start, tn )
-                ELSE 
+                ELSE
                     CALL advec_v_pw( i, j )
                 ENDIF
@@ -501 +507 @@
 !
 !--          Drag by plant canopy
-             IF ( plant_canopy )  CALL pcm_tendency( i, j, 2 )        
+             IF ( plant_canopy )  CALL pcm_tendency( i, j, 2 )
 
 !
@@ -551 +557 @@
              IF ( ws_scheme_mom )  THEN
                 CALL advec_w_ws( i, j, i_omp_start, tn )
-             ELSE 
+             ELSE
                 CALL advec_w_pw( i, j )
              END IF
@@ -646 +652 @@
              IF ( large_scale_forcing )  THEN
                 CALL ls_advec( i, j, simulated_time, 'pt' )
-             ENDIF     
+             ENDIF
 
 !
 !--          Nudging
-             IF ( nudging )  CALL nudge( i, j, simulated_time, 'pt' ) 
+             IF ( nudging )  CALL nudge( i, j, simulated_time, 'pt' )
 
 !
@@ -708 +714 @@
                     CALL advec_s_ws( i, j, sa, 'sa', flux_s_sa,  &
                                 diss_s_sa, flux_l_sa, diss_l_sa, i_omp_start, tn  )
-                ELSE 
+                ELSE
                     CALL advec_s_pw( i, j, sa )
                 ENDIF
@@ -760 +766 @@
              THEN
                 IF ( ws_scheme_sca )  THEN
-                   CALL advec_s_ws( i, j, q, 'q', flux_s_q, & 
+                   CALL advec_s_ws( i, j, q, 'q', flux_s_q, &
                                 diss_s_q, flux_l_q, diss_l_q, i_omp_start, tn )
-                ELSE 
+                ELSE
                    CALL advec_s_pw( i, j, q )
                 ENDIF
@@ -782 +788 @@
 !
 !--          Nudging
-             IF ( nudging )  CALL nudge( i, j, simulated_time, 'q' ) 
+             IF ( nudging )  CALL nudge( i, j, simulated_time, 'q' )
 
 !
@@ -820 +826 @@
 
 !
-!--          If required, calculate prognostic equations for rain water content 
+!--          If required, calculate prognostic equations for rain water content
 !--          and rain drop concentration
              IF ( cloud_physics  .AND.  microphysics_seifert )  THEN
@@ -829 +835 @@
                 THEN
                    IF ( ws_scheme_sca )  THEN
-                      CALL advec_s_ws( i, j, qr, 'qr', flux_s_qr,       & 
+                      CALL advec_s_ws( i, j, qr, 'qr', flux_s_qr,       &
                                        diss_s_qr, flux_l_qr, diss_l_qr, &
                                        i_omp_start, tn )
-                   ELSE 
+                   ELSE
                       CALL advec_s_pw( i, j, qr )
                    ENDIF
@@ -869 +875 @@
                 IF ( timestep_scheme(1:5) == 'runge' )  THEN
                    IF ( ws_scheme_sca )  THEN
-                      CALL advec_s_ws( i, j, nr, 'nr', flux_s_nr,    & 
+                      CALL advec_s_ws( i, j, nr, 'nr', flux_s_nr,    &
                                     diss_s_nr, flux_l_nr, diss_l_nr, &
                                     i_omp_start, tn )
-                   ELSE 
+                   ELSE
                       CALL advec_s_pw( i, j, nr )
                    ENDIF
@@ -907 +913 @@
 
           ENDIF
-          
+
 !
 !--       If required, compute prognostic equation for scalar
@@ -917 +923 @@
              THEN
                 IF ( ws_scheme_sca )  THEN
-                   CALL advec_s_ws( i, j, s, 's', flux_s_s, & 
+                   CALL advec_s_ws( i, j, s, 's', flux_s_s, &
                                 diss_s_s, flux_l_s, diss_l_s, i_omp_start, tn )
-                ELSE 
+                ELSE
                    CALL advec_s_pw( i, j, s )
                 ENDIF
@@ -939 +945 @@
 !
 !--          Nudging, still need to be extended for scalars
-!              IF ( nudging )  CALL nudge( i, j, simulated_time, 's' ) 
+!              IF ( nudging )  CALL nudge( i, j, simulated_time, 's' )
 
 !
 !--          If required compute influence of large-scale subsidence/ascent.
-!--          Note, the last argument is of no meaning in this case, as it is 
-!--          only used in conjunction with large_scale_forcing, which is to 
+!--          Note, the last argument is of no meaning in this case, as it is
+!--          only used in conjunction with large_scale_forcing, which is to
 !--          date not implemented for scalars.
              IF ( large_scale_subsidence  .AND.                                &
@@ -980 +986 @@
              ENDIF
 
-          ENDIF          
-!
-!--       If required, compute prognostic equation for turbulent kinetic 
+          ENDIF
+!
+!--       If required, compute prognostic equation for turbulent kinetic
 !--       energy (TKE)
           IF ( .NOT. constant_diffusion )  THEN
@@ -990 +996 @@
              tend(:,j,i) = 0.0_wp
              IF ( timestep_scheme(1:5) == 'runge'  &
-                 .AND.  .NOT. use_upstream_for_tke )  THEN 
+                 .AND.  .NOT. use_upstream_for_tke )  THEN
                  IF ( ws_scheme_sca )  THEN
                      CALL advec_s_ws( i, j, e, 'e', flux_s_e, diss_s_e, &
@@ -1013 +1019 @@
 !
 !--          Additional sink term for flows through plant canopies
-             IF ( plant_canopy )  CALL pcm_tendency( i, j, 6 ) 
+             IF ( plant_canopy )  CALL pcm_tendency( i, j, 6 )
 
              CALL user_actions( i, j, 'e-tendency' )
@@ -1061 +1067 @@
 !> Version for vector machines
 !------------------------------------------------------------------------------!
- 
+
  SUBROUTINE prognostic_equations_vector
 
@@ -1176 +1182 @@
        IF ( ws_scheme_mom )  THEN
           CALL advec_v_ws
-       ELSE 
+       ELSE
           CALL advec_v_pw
        END IF
@@ -1389 +1395 @@
 !
 !--    Nudging
-       IF ( nudging )  CALL nudge( simulated_time, 'pt' ) 
+       IF ( nudging )  CALL nudge( simulated_time, 'pt' )
 
 !
@@ -1485 +1491 @@
 
        CALL diffusion_s( sa, saswsb, saswst, wall_salinityflux )
-       
+
        CALL user_actions( 'sa-tendency' )
 
@@ -1573 +1579 @@
 
        CALL diffusion_s( q, qsws, qswst, wall_qflux )
-       
+
 !
 !--    Sink or source of humidity due to canopy elements
@@ -1586 +1592 @@
 !
 !--    Nudging
-       IF ( nudging )  CALL nudge( simulated_time, 'q' ) 
+       IF ( nudging )  CALL nudge( simulated_time, 'q' )
 
 !
@@ -1637 +1643 @@
 
 !
-!--    If required, calculate prognostic equations for rain water content 
+!--    If required, calculate prognostic equations for rain water content
 !--    and rain drop concentration
        IF ( cloud_physics  .AND.  microphysics_seifert )  THEN
@@ -1675 +1681 @@
           CALL diffusion_s( qr, qrsws, qrswst, wall_qrflux )
 
-          CALL user_actions( 'qr-tendency' )
-
 !
 !--       Prognostic equation for rain water content
@@ -1828 +1832 @@
 
        CALL diffusion_s( s, ssws, sswst, wall_sflux )
-       
+
 !
 !--    Sink or source of humidity due to canopy elements
@@ -1841 +1845 @@
 !
 !--    Nudging. Not implemented for scalars so far.
-!        IF ( nudging )  CALL nudge( simulated_time, 'q' ) 
+!        IF ( nudging )  CALL nudge( simulated_time, 'q' )
 
 !
@@ -1895 +1899 @@
     ENDIF
 !
-!-- If required, compute prognostic equation for turbulent kinetic 
+!-- If required, compute prognostic equation for turbulent kinetic
 !-- energy (TKE)
     IF ( .NOT. constant_diffusion )  THEN
@@ -1927 +1931 @@
                 IF ( ws_scheme_sca )  THEN
                    CALL advec_s_ws( e, 'e' )
-                ELSE 
+                ELSE
                    CALL advec_s_pw( e )
                 ENDIF