Changeset 3717 for palm/trunk/SOURCE/boundary_conds.f90

Timestamp:

Feb 5, 2019 5:21:16 PM (6 years ago)

Author:

suehring

Message:

Bugfix, do not set boundary conditions for pt in neutral runs; enable checks + additional checks for virtual measurements

File:

• palm/trunk/SOURCE/boundary_conds.f90 (modified) (3 diffs)

palm/trunk/SOURCE/boundary_conds.f90

@@ -25 +25 @@
 ! -----------------
 ! $Id$
+! Bugfix, do not set boundary conditions for potential temperature in neutral
+! runs.
+! 
+! 3655 2019-01-07 16:51:22Z knoop
 ! OpenACC port for SPEC
 ! 
@@ -235 +239 @@
                humidity, ibc_pt_b, ibc_pt_t, ibc_q_b, ibc_q_t, ibc_s_b,        &
                ibc_s_t, ibc_uv_b, ibc_uv_t, intermediate_timestep_count,       &
-               nesting_offline, nudging, ocean_mode, passive_scalar, rans_mode,&
-               rans_tke_e, tsc, salsa, use_cmax
+               nesting_offline, neutral, nudging, ocean_mode, passive_scalar,  &
+               rans_mode, rans_tke_e, tsc, salsa, use_cmax
 
     USE grid_variables,                                                        &
@@ -328 +332 @@
 !-- the sea surface temperature of the coupled ocean model.
 !-- Dirichlet
-    IF ( ibc_pt_b == 0 )  THEN
-       DO  l = 0, 1
-!
-!--       Set kb, for upward-facing surfaces value at topography top (k-1) is set,
-!--       for downward-facing surfaces at topography bottom (k+1). 
-          kb = MERGE( -1, 1, l == 0 )
-          !$OMP PARALLEL DO PRIVATE( i, j, k )
-          DO  m = 1, bc_h(l)%ns
-             i = bc_h(l)%i(m)            
-             j = bc_h(l)%j(m)
-             k = bc_h(l)%k(m)
-             pt_p(k+kb,j,i) = pt(k+kb,j,i)
-          ENDDO
-       ENDDO
-!
-!-- Neumann, zero-gradient
-    ELSEIF ( ibc_pt_b == 1 )  THEN
-       DO  l = 0, 1
-!
-!--       Set kb, for upward-facing surfaces value at topography top (k-1) is set,
-!--       for downward-facing surfaces at topography bottom (k+1). 
-          kb = MERGE( -1, 1, l == 0 )
-          !$OMP PARALLEL DO PRIVATE( i, j, k )
-          !$ACC PARALLEL LOOP PRIVATE(i, j, k) &
-          !$ACC PRESENT(bc_h, pt_p)
-          DO  m = 1, bc_h(l)%ns
-             i = bc_h(l)%i(m)            
-             j = bc_h(l)%j(m)
-             k = bc_h(l)%k(m)
-             pt_p(k+kb,j,i) = pt_p(k,j,i)
-          ENDDO
-       ENDDO
-    ENDIF
-
-!
-!-- Temperature at top boundary
-    IF ( ibc_pt_t == 0 )  THEN
-        pt_p(nzt+1,:,:) = pt(nzt+1,:,:)
-!
-!--     In case of nudging adjust top boundary to pt which is
-!--     read in from NUDGING-DATA
-        IF ( nudging )  THEN
-           pt_p(nzt+1,:,:) = pt_init(nzt+1)
-        ENDIF
-    ELSEIF ( ibc_pt_t == 1 )  THEN
-        pt_p(nzt+1,:,:) = pt_p(nzt,:,:)
-    ELSEIF ( ibc_pt_t == 2 )  THEN
-        !$ACC KERNELS PRESENT(pt_p, dzu)
-        pt_p(nzt+1,:,:) = pt_p(nzt,:,:) + bc_pt_t_val * dzu(nzt+1)
-        !$ACC END KERNELS
+    IF ( .NOT. neutral )  THEN
+       IF ( ibc_pt_b == 0 )  THEN
+          DO  l = 0, 1
+!      
+!--          Set kb, for upward-facing surfaces value at topography top (k-1)
+!--          is set, for downward-facing surfaces at topography bottom (k+1). 
+             kb = MERGE( -1, 1, l == 0 )
+             !$OMP PARALLEL DO PRIVATE( i, j, k )
+             DO  m = 1, bc_h(l)%ns
+                i = bc_h(l)%i(m)            
+                j = bc_h(l)%j(m)
+                k = bc_h(l)%k(m)
+                pt_p(k+kb,j,i) = pt(k+kb,j,i)
+             ENDDO
+          ENDDO
+!      
+!--    Neumann, zero-gradient
+       ELSEIF ( ibc_pt_b == 1 )  THEN
+          DO  l = 0, 1
+!      
+!--          Set kb, for upward-facing surfaces value at topography top (k-1) 
+!--          is set, for downward-facing surfaces at topography bottom (k+1). 
+             kb = MERGE( -1, 1, l == 0 )
+             !$OMP PARALLEL DO PRIVATE( i, j, k )
+             !$ACC PARALLEL LOOP PRIVATE(i, j, k) &
+             !$ACC PRESENT(bc_h, pt_p)
+             DO  m = 1, bc_h(l)%ns
+                i = bc_h(l)%i(m)            
+                j = bc_h(l)%j(m)
+                k = bc_h(l)%k(m)
+                pt_p(k+kb,j,i) = pt_p(k,j,i)
+             ENDDO
+          ENDDO
+       ENDIF
+       
+!      
+!--    Temperature at top boundary
+       IF ( ibc_pt_t == 0 )  THEN
+           pt_p(nzt+1,:,:) = pt(nzt+1,:,:)
+!      
+!--        In case of nudging adjust top boundary to pt which is
+!--        read in from NUDGING-DATA
+           IF ( nudging )  THEN
+              pt_p(nzt+1,:,:) = pt_init(nzt+1)
+           ENDIF
+       ELSEIF ( ibc_pt_t == 1 )  THEN
+           pt_p(nzt+1,:,:) = pt_p(nzt,:,:)
+       ELSEIF ( ibc_pt_t == 2 )  THEN
+           !$ACC KERNELS PRESENT(pt_p, dzu)
+           pt_p(nzt+1,:,:) = pt_p(nzt,:,:) + bc_pt_t_val * dzu(nzt+1)
+           !$ACC END KERNELS
+       ENDIF
     ENDIF