Changeset 529 for codes/icosagcm/devel/src/caldyn_kernels_hevi.f90

Timestamp:

01/27/17 16:54:36 (7 years ago)

Author:

dubos

Message:

Updated devel to r526

File:

• codes/icosagcm/devel/src/caldyn_kernels_hevi.f90 (modified) (4 diffs)

codes/icosagcm/devel/src/caldyn_kernels_hevi.f90

@@ -32 +32 @@
           !DIR$ SIMD
           DO ij=ij_begin_ext,ij_end_ext
-             IF(DEC) THEN  ! ps is actually Ms
-                m = mass_dak(l)+(ps(ij)*g+ptop)*mass_dbk(l)
-             ELSE
-                m = mass_dak(l)+ps(ij)*mass_dbk(l)
-             END IF
+             m = mass_dak(l)+(ps(ij)*g+ptop)*mass_dbk(l) ! ps is actually Ms
              rhodz(ij,l) = m/g
           END DO
@@ -69 +65 @@
        !DIR$ SIMD
        DO ij=ij_begin_ext,ij_end_ext
-          IF(DEC) THEN
-             etav= 1./Av(ij+z_up)*(  ne_rup  * u(ij+u_rup,l)         &
-                                   + ne_left * u(ij+t_rup+u_left,l)  &
-                                   - ne_lup  * u(ij+u_lup,l) )                               
-
-             hv =   Riv2(ij,vup)          * rhodz(ij,l)           &
-                  + Riv2(ij+t_rup,vldown) * rhodz(ij+t_rup,l)     &
-                  + Riv2(ij+t_lup,vrdown) * rhodz(ij+t_lup,l)
-             qv(ij+z_up,l) = ( etav+fv(ij+z_up) )/hv
-
-             etav = 1./Av(ij+z_down)*(  ne_ldown * u(ij+u_ldown,l)          &
-                                      + ne_right * u(ij+t_ldown+u_right,l)  &
-                                      - ne_rdown * u(ij+u_rdown,l) )
-             hv =   Riv2(ij,vdown)        * rhodz(ij,l)          &
-                  + Riv2(ij+t_ldown,vrup) * rhodz(ij+t_ldown,l)  &
-                  + Riv2(ij+t_rdown,vlup) * rhodz(ij+t_rdown,l)
-             qv(ij+z_down,l) =( etav+fv(ij+z_down) )/hv
-          ELSE
-             etav= 1./Av(ij+z_up)*(  ne_rup  * u(ij+u_rup,l)        * de(ij+u_rup)         &
-                                   + ne_left * u(ij+t_rup+u_left,l) * de(ij+t_rup+u_left)  &
-                                   - ne_lup  * u(ij+u_lup,l)        * de(ij+u_lup) )                               
-
-             hv =   Riv2(ij,vup)          * rhodz(ij,l)           &
-                  + Riv2(ij+t_rup,vldown) * rhodz(ij+t_rup,l)     &
-                  + Riv2(ij+t_lup,vrdown) * rhodz(ij+t_lup,l)
-             qv(ij+z_up,l) = ( etav+fv(ij+z_up) )/hv
-
-             etav = 1./Av(ij+z_down)*(  ne_ldown * u(ij+u_ldown,l)          * de(ij+u_ldown)          &
-                                      + ne_right * u(ij+t_ldown+u_right,l)  * de(ij+t_ldown+u_right)  &
-                                      - ne_rdown * u(ij+u_rdown,l)          * de(ij+u_rdown) )
-             hv =   Riv2(ij,vdown)        * rhodz(ij,l)          &
-                  + Riv2(ij+t_ldown,vrup) * rhodz(ij+t_ldown,l)  &
-                  + Riv2(ij+t_rdown,vlup) * rhodz(ij+t_rdown,l)
-             qv(ij+z_down,l) =( etav+fv(ij+z_down) )/hv
-          END IF
+          etav= 1./Av(ij+z_up)*(  ne_rup  * u(ij+u_rup,l)   &
+                  + ne_left * u(ij+t_rup+u_left,l)          &
+                  - ne_lup  * u(ij+u_lup,l) )                               
+          hv =   Riv2(ij,vup)          * rhodz(ij,l)        &
+               + Riv2(ij+t_rup,vldown) * rhodz(ij+t_rup,l)  &
+               + Riv2(ij+t_lup,vrdown) * rhodz(ij+t_lup,l)
+          qv(ij+z_up,l) = ( etav+fv(ij+z_up) )/hv
+          
+          etav = 1./Av(ij+z_down)*(  ne_ldown * u(ij+u_ldown,l)   &
+               + ne_right * u(ij+t_ldown+u_right,l)               &
+               - ne_rdown * u(ij+u_rdown,l) )
+          hv =   Riv2(ij,vdown)        * rhodz(ij,l)              &
+               + Riv2(ij+t_ldown,vrup) * rhodz(ij+t_ldown,l)      &
+               + Riv2(ij+t_rdown,vlup) * rhodz(ij+t_rdown,l)
+          qv(ij+z_down,l) =( etav+fv(ij+z_down) )/hv
        ENDDO
 
@@ -649 +625 @@
   END SUBROUTINE compute_caldyn_Coriolis
 
-  SUBROUTINE compute_caldyn_slow_hydro(u,rhodz,hflux,du)
+  SUBROUTINE compute_caldyn_slow_hydro(u,rhodz,hflux,du, zero)
+    LOGICAL, INTENT(IN) :: zero
     REAL(rstd),INTENT(IN)  :: u(3*iim*jjm,llm)    ! prognostic "velocity"
     REAL(rstd),INTENT(IN)  :: rhodz(iim*jjm,llm)
     REAL(rstd),INTENT(OUT) :: hflux(3*iim*jjm,llm) ! hflux in kg/s
-    REAL(rstd),INTENT(OUT) :: du(3*iim*jjm,llm)
+    REAL(rstd),INTENT(INOUT) :: du(3*iim*jjm,llm)
     
     REAL(rstd) :: berni(iim*jjm)  ! Bernoulli function
@@ -690 +667 @@
        ENDDO
        ! Compute du=-grad(Bernoulli)
-       !DIR$ SIMD
-       DO ij=ij_begin,ij_end
+       IF(zero) THEN
+          !DIR$ SIMD
+          DO ij=ij_begin,ij_end
              du(ij+u_right,l) = ne_right*(berni(ij)-berni(ij+t_right))
              du(ij+u_lup,l)   = ne_lup*(berni(ij)-berni(ij+t_lup))
              du(ij+u_ldown,l) = ne_ldown*(berni(ij)-berni(ij+t_ldown))
-       END DO
+          END DO
+       ELSE
+          !DIR$ SIMD
+          DO ij=ij_begin,ij_end
+             du(ij+u_right,l) = du(ij+u_right,l) + &
+                  ne_right*(berni(ij)-berni(ij+t_right))
+             du(ij+u_lup,l)   = du(ij+u_lup,l) + &
+                  ne_lup*(berni(ij)-berni(ij+t_lup))
+             du(ij+u_ldown,l) = du(ij+u_ldown,l) + &
+                  ne_ldown*(berni(ij)-berni(ij+t_ldown))
+          END DO
+       END IF
     END DO