Changeset 2037 for palm/trunk/SOURCE/surface_layer_fluxes_mod.f90

Timestamp:

Oct 26, 2016 11:15:40 AM (8 years ago)

Author:

knoop

Message:

Anelastic approximation implemented

File:

• palm/trunk/SOURCE/surface_layer_fluxes_mod.f90 (modified) (9 diffs)

palm/trunk/SOURCE/surface_layer_fluxes_mod.f90

@@ -20 +20 @@
 ! Current revisions:
 ! ------------------
-! 
+! Anelastic approximation implemented
 ! 
 ! Former revisions:
@@ -158 +158 @@
         ONLY:  e, kh, nr, nrs, nrsws, ol, pt, q, ql, qr, qrs, qrsws, qs, qsws, &
                s, shf, ss, ssws, ts, u, us, usws, v, vpt, vsws, zu, zw, z0,    &
-               z0h, z0q
+               z0h, z0q, drho_air_zw, rho_air_zw
 
     USE cloud_parameters,                                                      &
@@ -540 +540 @@
                       rib(j,i) = - g * z_mo * ( ( 1.0_wp + 0.61_wp             &
                                  * q(k+1,j,i) ) * shf(j,i) + 0.61_wp           &
-                                 * pt(k+1,j,i) * qsws(j,i) )   &
+                                 * pt(k+1,j,i) * qsws(j,i) ) * drho_air_zw(k)  &
                                  / ( uv_total(j,i)**3 * vpt(k+1,j,i) * kappa**2&
                                  + 1.0E-20_wp)
                    ELSE
-                      rib(j,i) = - g * z_mo * shf(j,i)                         &
+                      rib(j,i) = - g * z_mo * shf(j,i) * drho_air_zw(k)        &
                            / ( uv_total(j,i)**3 * pt(k+1,j,i) * kappa**2       &
                            + 1.0E-20_wp )
@@ -828 +828 @@
 !--       For a given heat flux in the surface layer:
           !$OMP PARALLEL DO
-          !$acc kernels loop private( j )
+          !$acc kernels loop private( j, k )
           DO  i = nxlg, nxrg
              DO  j = nysg, nyng
-                ts(j,i) = -shf(j,i) / ( us(j,i) + 1E-30_wp )
+                k   = nzb_s_inner(j,i)
+                ts(j,i) = -shf(j,i) * drho_air_zw(k) / ( us(j,i) + 1E-30_wp )
 !
 !--             ts must be limited, because otherwise overflow may occur in case
@@ -888 +889 @@
              DO  i = nxlg, nxrg
                 DO  j = nysg, nyng
-                   qs(j,i) = -qsws(j,i) / ( us(j,i) + 1E-30_wp )
+                   k   = nzb_s_inner(j,i)
+                   qs(j,i) = -qsws(j,i) * drho_air_zw(k) / ( us(j,i) + 1E-30_wp )
                 ENDDO
              ENDDO
@@ -1025 +1027 @@
                                      + psi_m( z0(j,i) / ol_mid ) )
 
-             usws(j,i) = -usws(j,i) * 0.5_wp * ( us(j,i-1) + us(j,i) )
+             usws(j,i) = -usws(j,i) * 0.5_wp * ( us(j,i-1) + us(j,i) )         &
+                                    * rho_air_zw(k)
           ENDDO
        ENDDO
@@ -1052 +1055 @@
                                      + psi_m( z0(j,i) / ol_mid ) )
 
-             vsws(j,i) = -vsws(j,i) * 0.5_wp * ( us(j,i-1) + us(j,i) )
+             vsws(j,i) = -vsws(j,i) * 0.5_wp * ( us(j,i-1) + us(j,i) )         &
+                                    * rho_air_zw(k)
 
           ENDDO
@@ -1074 +1078 @@
              !$acc loop independent
              DO  j = nysg, nyng
-                shf(j,i) = -ts(j,i) * us(j,i)
+                k   = nzb_s_inner(j,i)
+                shf(j,i) = -ts(j,i) * us(j,i) * rho_air_zw(k)
              ENDDO
           ENDDO
@@ -1090 +1095 @@
              !$acc loop independent
              DO  j = nysg, nyng
-                qsws(j,i) = -qs(j,i) * us(j,i)
+                k   = nzb_s_inner(j,i)
+                qsws(j,i) = -qs(j,i) * us(j,i) * rho_air_zw(k)
              ENDDO
           ENDDO