Changeset 3274 for palm/trunk/SOURCE/calc_radiation.f90

Timestamp:

Sep 24, 2018 3:42:55 PM (6 years ago)

Author:

knoop

Message:

Modularization of all bulk cloud physics code components

File:

• palm/trunk/SOURCE/calc_radiation.f90 (modified) (12 diffs)

palm/trunk/SOURCE/calc_radiation.f90

@@ -25 +25 @@
 ! -----------------
 ! $Id$
+! Modularization of all bulk cloud physics code components
+! 
+! 2718 2018-01-02 08:49:38Z maronga
 ! Corrected "Former revisions" section
 ! 
@@ -77 +80 @@
  MODULE calc_radiation_mod
  
+
+    USE arrays_3d,                                                             &
+        ONLY:  dzw, pt, ql, tend, d_exner, exner
+
+    USE basic_constants_and_equations_mod,                                     &
+        ONLY:  c_p, lv_d_cp, sigma_sb
+
+    USE control_parameters,                                                    &
+        ONLY:  rho_surface
+
+    USE indices,                                                               &
+        ONLY:  nxl, nxr, nyn, nys, nzb, nzt, wall_flags_0
+
     USE kinds
-    
+
+    USE pegrid
+
     PRIVATE
     PUBLIC calc_radiation
-    
+
     LOGICAL, SAVE ::  first_call = .TRUE. !<
-    REAL(wp), SAVE ::  sigma = 5.67E-08_wp   !<
 
     REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE ::  lwp_ground         !<
@@ -103 +120 @@
 !------------------------------------------------------------------------------!
     SUBROUTINE calc_radiation
-
-       USE arrays_3d,                                                          &
-           ONLY:  dzw, pt, ql, tend
-
-       USE cloud_parameters,                                                   &
-           ONLY:  cp, l_d_cp, pt_d_t, t_d_pt
-
-       USE control_parameters,                                                 &
-           ONLY:  rho_surface
-
-       USE indices,                                                            &
-           ONLY:  nxl, nxr, nyn, nys, nzb, nzt, wall_flags_0
-
-       USE kinds
-
-       USE pegrid
-
 
        IMPLICIT NONE
@@ -159 +159 @@
              lwp_top(nzt+1)  = rho_surface * ql(nzt+1,j,i) * dzw(nzt+1)
 
-             temperature     = pt(nzb,j,i) * t_d_pt(nzb) + l_d_cp * ql(nzb,j,i)
-             blackbody_emission(nzb) = sigma * temperature**4
+             temperature     = pt(nzb,j,i) * exner(nzb) + lv_d_cp * ql(nzb,j,i)
+             blackbody_emission(nzb) = sigma_sb * temperature**4
 
              DO  k = nzb+1, nzt
@@ -171 +171 @@
                                   rho_surface * ql(k_help,j,i) * dzw(k_help)
 
-                temperature     = pt(k,j,i) * t_d_pt(k) + l_d_cp * ql(k,j,i)
-                blackbody_emission(k) = sigma * temperature**4                 &
+                temperature     = pt(k,j,i) * exner(k) + lv_d_cp * ql(k,j,i)
+                blackbody_emission(k) = sigma_sb * temperature**4              &
                                       * MERGE( 1.0_wp, 0.0_wp,                 &
                                                BTEST( wall_flags_0(k,j,i), 0 ) )
@@ -182 +182 @@
              lwp_top(nzb)      = lwp_top(nzb+1)
 
-             temperature       = pt(nzt+1,j,i) * t_d_pt(nzt+1) + l_d_cp *      &
+             temperature       = pt(nzt+1,j,i) * exner(nzt+1) + lv_d_cp *      &
                                  ql(nzt+1,j,i)
-             blackbody_emission(nzt+1) = sigma * temperature**4
+             blackbody_emission(nzt+1) = sigma_sb * temperature**4
 
 !
@@ -232 +232 @@
 !--                Compute tendency term         
                    tend(k,j,i) = tend(k,j,i) -                                 &
-                                ( pt_d_t(k) / ( rho_surface * cp ) *           &
+                                ( d_exner(k) / ( rho_surface * c_p ) *         &
                                   ( df_p - df_m ) / dzw(k) )                   &
                                       * MERGE( 1.0_wp, 0.0_wp,                 &
@@ -253 +253 @@
     SUBROUTINE calc_radiation_ij( i, j )
 
-       USE arrays_3d,                                                          &
-           ONLY:  dzw, pt, ql, tend
-
-       USE cloud_parameters,                                                   &
-           ONLY:  cp, l_d_cp, pt_d_t, t_d_pt
-
-       USE control_parameters,                                                 &
-           ONLY:  rho_surface
-
-       USE indices,                                                            &
-           ONLY:  nzb, nzt, wall_flags_0
-
-       USE kinds
-
-       USE pegrid
-
-   
        IMPLICIT NONE
 
@@ -305 +288 @@
        lwp_top(nzt+1)  = rho_surface * ql(nzt+1,j,i) * dzw(nzt+1)
 
-       temperature     = pt(nzb,j,i) * t_d_pt(nzb) + l_d_cp * ql(nzb,j,i)
-       blackbody_emission(nzb) = sigma * temperature**4
+       temperature     = pt(nzb,j,i) * exner(nzb) + lv_d_cp * ql(nzb,j,i)
+       blackbody_emission(nzb) = sigma_sb * temperature**4
 
        DO  k = nzb+1, nzt
@@ -315 +298 @@
                             rho_surface * ql(k_help,j,i) * dzw(k_help)
 
-          temperature     = pt(k,j,i) * t_d_pt(k) + l_d_cp * ql(k,j,i)
-          blackbody_emission(k) = sigma * temperature**4                       &
+          temperature     = pt(k,j,i) * exner(k) + lv_d_cp * ql(k,j,i)
+          blackbody_emission(k) = sigma_sb * temperature**4                    &
                                       * MERGE( 1.0_wp, 0.0_wp,                 &
                                                BTEST( wall_flags_0(k,j,i), 0 ) )
@@ -325 +308 @@
        lwp_top(nzb)      = lwp_top(nzb+1)
 
-       temperature       = pt(nzt+1,j,i) * t_d_pt(nzt+1) + l_d_cp *            &
+       temperature       = pt(nzt+1,j,i) * exner(nzt+1) + lv_d_cp *            &
                            ql(nzt+1,j,i)
-       blackbody_emission(nzt+1) = sigma * temperature**4
+       blackbody_emission(nzt+1) = sigma_sb * temperature**4
 
 !
@@ -370 +353 @@
 !
 !--          Compute tendency term         
-             tend(k,j,i) = tend(k,j,i) - ( pt_d_t(k) / ( rho_surface * cp ) *  &
-                                         ( df_p - df_m ) / dzw(k) )            &
+             tend(k,j,i) = tend(k,j,i) - ( d_exner(k) / ( rho_surface * c_p )  &
+                                      *  ( df_p - df_m ) / dzw(k) )            &
                                       * MERGE( 1.0_wp, 0.0_wp,                 &
                                                BTEST( wall_flags_0(k,j,i), 0 ) )