Changeset 4593 for palm/trunk/SOURCE/surface_mod.f90

Timestamp:

Jul 9, 2020 12:48:18 PM (4 years ago)

Author:

suehring

Message:

Surface flux calculation: Pre-calculate ln(z/z0) at each timestep in order to reduce the number of log-calculations; Bugfix - add missing density to fluxes of passive-scalars, chemistry and cloud-phyiscal quantities at upward-facing surfaces; Move if-statement out of inner loop; Remove unnecessary index referencing

File:

• palm/trunk/SOURCE/surface_mod.f90 (modified) (16 diffs)

palm/trunk/SOURCE/surface_mod.f90

@@ -25 +25 @@
 ! -----------------
 ! $Id$
+! Add arrays for pre-calculated ln(z/z0)
+!
+! 4586 2020-07-01 16:16:43Z gronemeier
 ! renamed Richardson flux number into gradient Richardson number (1D model)
 !
@@ -248 +251 @@
 
        REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  css    !< scaling parameter chemical species
+!
+!--    Pre-defined arrays for ln(z/z0)
+       REAL(wp), DIMENSION(:), ALLOCATABLE ::  ln_z_z0  !< ln(z/z0)
+       REAL(wp), DIMENSION(:), ALLOCATABLE ::  ln_z_z0h !< ln(z/z0h)
+       REAL(wp), DIMENSION(:), ALLOCATABLE ::  ln_z_z0q !< ln(z/z0q)
 !
 !--    Define arrays for surface fluxes
@@ -1281 +1289 @@
     DEALLOCATE ( surfaces%uvw_abs )
 !
+!-- Pre-calculated ln(z/z0)
+    DEALLOCATE ( surfaces%ln_z_z0  )
+    DEALLOCATE ( surfaces%ln_z_z0h )
+    DEALLOCATE ( surfaces%ln_z_z0q )
+!
 !-- Roughness
     DEALLOCATE ( surfaces%z0 )
@@ -1411 +1424 @@
     ALLOCATE ( surfaces%uvw_abs(1:surfaces%ns) )
 !
+!-- Precalculated ln(z/z0)
+    ALLOCATE( surfaces%ln_z_z0(1:surfaces%ns)  )
+    ALLOCATE( surfaces%ln_z_z0h(1:surfaces%ns) )
+    ALLOCATE( surfaces%ln_z_z0q(1:surfaces%ns) )
+!
 !-- Roughness
     ALLOCATE ( surfaces%z0(1:surfaces%ns)  )
@@ -1520 +1538 @@
     !$ACC DELETE(surfaces%z_mo(1:surfaces%ns)) &
     !$ACC DELETE(surfaces%uvw_abs(1:surfaces%ns)) &
+    !$ACC DELETE(surfaces%ln_z_z0(1:surfaces%ns)) &
+    !$ACC DELETE(surfaces%ln_z_z0h(1:surfaces%ns)) &
+    !$ACC DELETE(surfaces%ln_z_z0q(1:surfaces%ns)) &
     !$ACC DELETE(surfaces%z0(1:surfaces%ns)) &
     !$ACC COPYOUT(surfaces%us(1:surfaces%ns)) &
@@ -1561 +1582 @@
     !$ACC COPYIN(surfaces%z_mo(1:surfaces%ns)) &
     !$ACC COPYIN(surfaces%uvw_abs(1:surfaces%ns)) &
+    !$ACC COPYIN(surfaces%ln_z_z0(1:surfaces%ns)) &
+    !$ACC COPYIN(surfaces%ln_z_z0h(1:surfaces%ns)) &
+    !$ACC COPYIN(surfaces%ln_z_z0q(1:surfaces%ns)) &
     !$ACC COPYIN(surfaces%z0(1:surfaces%ns)) &
     !$ACC COPYIN(surfaces%us(1:surfaces%ns)) &
@@ -1830 +1854 @@
     DEALLOCATE ( surfaces%uvw_abs )
 !
+!-- Precalculated ln(z/z0)
+    DEALLOCATE ( surfaces%ln_z_z0  )
+    DEALLOCATE ( surfaces%ln_z_z0h )
+    DEALLOCATE ( surfaces%ln_z_z0q )
+!
 !-- Roughness
     DEALLOCATE ( surfaces%z0 )
     DEALLOCATE ( surfaces%z0h )
     DEALLOCATE ( surfaces%z0q )
-
 !
 !-- Friction velocity
@@ -1879 +1907 @@
 !-- Scaling parameter (cs*) and surface flux of chemical species
     IF ( air_chemistry )  THEN
-          DEALLOCATE ( surfaces%css )
-          DEALLOCATE ( surfaces%cssws )
+       DEALLOCATE ( surfaces%css )
+       DEALLOCATE ( surfaces%cssws )
     ENDIF
 !
@@ -1958 +1986 @@
     ALLOCATE ( surfaces%uvw_abs(1:surfaces%ns) )
 !
+!-- Precalculated ln(z/z0)
+    ALLOCATE( surfaces%ln_z_z0(1:surfaces%ns) )
+    ALLOCATE( surfaces%ln_z_z0h(1:surfaces%ns) )
+    ALLOCATE( surfaces%ln_z_z0q(1:surfaces%ns) )
+!
 !-- Roughness
     ALLOCATE ( surfaces%z0(1:surfaces%ns)  )
@@ -2007 +2040 @@
 !-- Scaling parameter (cs*) and surface flux of chemical species
     IF ( air_chemistry )  THEN
-          ALLOCATE ( surfaces%css(1:nvar,1:surfaces%ns) )
-          ALLOCATE ( surfaces%cssws(1:nvar,1:surfaces%ns) )
+       ALLOCATE ( surfaces%css(1:nvar,1:surfaces%ns) )
+       ALLOCATE ( surfaces%cssws(1:nvar,1:surfaces%ns) )
     ENDIF
 !
@@ -2062 +2095 @@
     !$ACC DELETE(surfaces%k(1:surfaces%ns)) &
     !$ACC DELETE(surfaces%uvw_abs(1:surfaces%ns)) &
+    !$ACC DELETE(surfaces%ln_z_z0(1:surfaces%ns) ) &
+    !$ACC DELETE(surfaces%ln_z_z0h(1:surfaces%ns) ) &
+    !$ACC DELETE(surfaces%ln_z_z0q(1:surfaces%ns) ) &
     !$ACC DELETE(surfaces%z0(1:surfaces%ns)) &
     !$ACC DELETE(surfaces%rib(1:surfaces%ns)) &
@@ -2094 +2130 @@
     !$ACC COPYIN(surfaces%k(1:surfaces%ns)) &
     !$ACC COPYIN(surfaces%uvw_abs(1:surfaces%ns)) &
+    !$ACC COPYIN(surfaces%ln_z_z0(1:surfaces%ns) ) &
+    !$ACC COPYIN(surfaces%ln_z_z0h(1:surfaces%ns) ) &
+    !$ACC COPYIN(surfaces%ln_z_z0q(1:surfaces%ns) ) &
     !$ACC COPYIN(surfaces%z0(1:surfaces%ns)) &
     !$ACC COPYIN(surfaces%rib(1:surfaces%ns)) &
@@ -2569 +2608 @@
     surf%rib(num_h)     = 0.0_wp
     surf%uvw_abs(num_h) = 0.0_wp
+!
+!-- Initialize ln(z/z0)
+    surf%ln_z_z0(num_h)  = LOG( surf%z_mo(num_h) / surf%z0(num_h) )
+    surf%ln_z_z0h(num_h) = LOG( surf%z_mo(num_h) / surf%z0h(num_h) )
+    surf%ln_z_z0q(num_h) = LOG( surf%z_mo(num_h) / surf%z0q(num_h) )
 
     IF ( .NOT. constant_diffusion )  THEN
@@ -2871 +2915 @@
 
     surf%us(num_v)  = 0.0_wp
+!
+!-- Initialize ln(z/z0)
+    surf%ln_z_z0(num_v)  = LOG( surf%z_mo(num_v) / surf%z0(num_v)  )
+    surf%ln_z_z0h(num_v) = LOG( surf%z_mo(num_v) / surf%z0h(num_v) )
+    surf%ln_z_z0q(num_v) = LOG( surf%z_mo(num_v) / surf%z0q(num_v) )
 !
 !-- If required, initialize Obukhov length
@@ -5106 +5155 @@
     ENDIF
     IF ( INDEX( restart_string(1:length), '%cssws' ) /= 0 )  THEN
-       IF ( ALLOCATED( surf_target%cssws )  .AND.  ALLOCATED( surf_file%cssws   ) )  THEN
+       IF ( ALLOCATED( surf_target%cssws )  .AND.  ALLOCATED( surf_file%cssws ) )  THEN
           DO  lsp = 1, nvar
              surf_target%cssws(lsp,m_target) = surf_file%cssws(lsp,m_file)
@@ -5507 +5556 @@
 !
 !-- Redistribute surface elements on its respective type.
-
     DO  l = 0, 2
        CALL restore_surface_elements( surf_def_h(l), surf_h(l) )
-       CALL restore_surface_elements( surf_lsm_h, surf_h(l) )
-       CALL restore_surface_elements( surf_usm_h, surf_h(l) )
     ENDDO
+    CALL restore_surface_elements( surf_lsm_h, surf_h(0) )
+    CALL restore_surface_elements( surf_usm_h, surf_h(0) )
 
     DO  l = 0, 3