loop permute, to help better memory access, vectorization

dyn_em/module_advect_em.F

@@ -4146,8 +4146,8 @@ SUBROUTINE advect_scalar   ( field, field_old, tendency,    &
 
    IF( (config_flags%open_ys) .and. (jts == jds) ) THEN
 
-       DO i = i_start, i_end
        DO k = kts, ktf
+       DO i = i_start, i_end
          vb = MIN( 0.5*(rv(i,k,jts)+rv(i,k,jts+1)), 0. )
          tendency(i,k,jts) = tendency(i,k,jts)                     &
                - rdy*(                                             &
@@ -4162,8 +4162,8 @@ SUBROUTINE advect_scalar   ( field, field_old, tendency,    &
 
    IF( (config_flags%open_ye) .and. (jte == jde)) THEN
 
-       DO i = i_start, i_end
        DO k = kts, ktf
+       DO i = i_start, i_end
          vb = MAX( 0.5*(rv(i,k,jte-1)+rv(i,k,jte)), 0. )
          tendency(i,k,j_end) = tendency(i,k,j_end)                   &
                - rdy*(                                               &
@@ -7297,8 +7297,8 @@ SUBROUTINE advect_scalar_pd   ( field, field_old, tendency,    &
 
    IF( (config_flags%open_ys) .and. (jts == jds) ) THEN
 
-       DO i = i_start, i_end
        DO k = kts, ktf
+       DO i = i_start, i_end
          vb = MIN( 0.5*(rv(i,k,jts)+rv(i,k,jts+1)), 0. )
          tendency(i,k,jts) = tendency(i,k,jts)                     &
                - rdy*(                                             &
@@ -7313,8 +7313,8 @@ SUBROUTINE advect_scalar_pd   ( field, field_old, tendency,    &
 
    IF( (config_flags%open_ye) .and. (jte == jde)) THEN
 
-       DO i = i_start, i_end
        DO k = kts, ktf
+       DO i = i_start, i_end
          vb = MAX( 0.5*(rv(i,k,jte-1)+rv(i,k,jte)), 0. )
          tendency(i,k,j_end) = tendency(i,k,j_end)                   &
                - rdy*(                                               &
@@ -7330,8 +7330,8 @@ SUBROUTINE advect_scalar_pd   ( field, field_old, tendency,    &
    IF( (config_flags%polar) .and. (jts == jds) ) THEN
 
        ! Assuming rv(i,k,jds) = 0.
-       DO i = i_start, i_end
        DO k = kts, ktf
+       DO i = i_start, i_end
          vb = MIN( 0.5*rv(i,k,jts+1), 0. )
          tendency(i,k,jts) = tendency(i,k,jts)                     &
                - rdy*(                                             &
@@ -7347,8 +7347,8 @@ SUBROUTINE advect_scalar_pd   ( field, field_old, tendency,    &
    IF( (config_flags%polar) .and. (jte == jde)) THEN
 
        ! Assuming rv(i,k,jde) = 0.
-       DO i = i_start, i_end
        DO k = kts, ktf
+       DO i = i_start, i_end
          vb = MAX( 0.5*rv(i,k,jte-1), 0. )
          tendency(i,k,j_end) = tendency(i,k,j_end)                   &
                - rdy*(                                               &
@@ -7412,6 +7412,9 @@ SUBROUTINE advect_scalar_pd   ( field, field_old, tendency,    &
            fqzl(i,k,j) = mu*(dz/dt)*flux_upwind(field_old(i,k-1,j), field_old(i,k,j  ), cr)
            fqz(i,k,j)=rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
            fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
+         ENDDO
+
+         DO i = i_start, i_end
 
            k=kts+2
            dz = 2./(rdzw(k)+rdzw(k-1))
@@ -7424,6 +7427,9 @@ SUBROUTINE advect_scalar_pd   ( field, field_old, tendency,    &
                    field(i,k-2,j), field(i,k-1,j),      &
                    field(i,k  ,j), field(i,k+1,j),  -vel )
            fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
+         ENDDO
+
+         DO i = i_start, i_end
 
            k=ktf-1
            dz = 2./(rdzw(k)+rdzw(k-1))
@@ -7436,6 +7442,9 @@ SUBROUTINE advect_scalar_pd   ( field, field_old, tendency,    &
                    field(i,k-2,j), field(i,k-1,j),      &
                    field(i,k  ,j), field(i,k+1,j),  -vel )
            fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
+         ENDDO
+
+         DO i = i_start, i_end
 
            k=ktf
            dz = 2./(rdzw(k)+rdzw(k-1))
@@ -7485,6 +7494,9 @@ SUBROUTINE advect_scalar_pd   ( field, field_old, tendency,    &
            fqzl(i,k,j) = mu*(dz/dt)*flux_upwind(field_old(i,k-1,j), field_old(i,k,j  ), cr)
            fqz(i,k,j)=rom(i,k,j)*(fzm(k)*field(i,k,j)+fzp(k)*field(i,k-1,j))
            fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
+         ENDDO
+
+         DO i = i_start, i_end
 
            k=kts+2
            dz = 2./(rdzw(k)+rdzw(k-1))
@@ -7497,6 +7509,9 @@ SUBROUTINE advect_scalar_pd   ( field, field_old, tendency,    &
                    field(i,k-2,j), field(i,k-1,j),      &
                    field(i,k  ,j), field(i,k+1,j),  -vel )
            fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
+         ENDDO
+
+         DO i = i_start, i_end
 
            k=ktf-1
            dz = 2./(rdzw(k)+rdzw(k-1))
@@ -7509,6 +7524,9 @@ SUBROUTINE advect_scalar_pd   ( field, field_old, tendency,    &
                    field(i,k-2,j), field(i,k-1,j),      &
                    field(i,k  ,j), field(i,k+1,j),  -vel )
            fqz(i,k,j) = fqz(i,k,j) - fqzl(i,k,j)
+         ENDDO
+
+         DO i = i_start, i_end
 
            k=ktf
            dz = 2./(rdzw(k)+rdzw(k-1))

dyn_em/module_big_step_utilities_em.F

@@ -5105,8 +5105,8 @@ SUBROUTINE phy_prep_part2 ( config_flags,                          &
    IF (config_flags%cu_physics .gt. 0) THEN
 
       DO J=j_start,j_end
-      DO I=i_start,i_end
       DO K=k_start,k_end
+      DO I=i_start,i_end
          RUCUTEN(I,K,J) =RUCUTEN(I,K,J)/(c1(k)*MUT(I,J)+c2(k))
          RVCUTEN(I,K,J) =RVCUTEN(I,K,J)/(c1(k)*MUT(I,J)+c2(k))
          RTHCUTEN(I,K,J)=RTHCUTEN(I,K,J)/(c1(k)*MUT(I,J)+c2(k))
@@ -5116,8 +5116,8 @@ SUBROUTINE phy_prep_part2 ( config_flags,                          &
 
       IF (P_QV .ge. PARAM_FIRST_SCALAR)THEN
          DO J=j_start,j_end
-         DO I=i_start,i_end
          DO K=k_start,k_end
+         DO I=i_start,i_end
             RQVCUTEN(I,K,J)=RQVCUTEN(I,K,J)/(c1(k)*MUT(I,J)+c2(k))
          ENDDO
          ENDDO
@@ -5126,8 +5126,8 @@ SUBROUTINE phy_prep_part2 ( config_flags,                          &
 
       IF (P_QC .ge. PARAM_FIRST_SCALAR)THEN
          DO J=j_start,j_end
-         DO I=i_start,i_end
          DO K=k_start,k_end
+         DO I=i_start,i_end
             RQCCUTEN(I,K,J)=RQCCUTEN(I,K,J)/(c1(k)*MUT(I,J)+c2(k))
          ENDDO
          ENDDO
@@ -5136,8 +5136,8 @@ SUBROUTINE phy_prep_part2 ( config_flags,                          &
 
       IF (P_QR .ge. PARAM_FIRST_SCALAR)THEN
          DO J=j_start,j_end
-         DO I=i_start,i_end
          DO K=k_start,k_end
+         DO I=i_start,i_end
             RQRCUTEN(I,K,J)=RQRCUTEN(I,K,J)/(c1(k)*MUT(I,J)+c2(k))
          ENDDO
          ENDDO
@@ -5146,8 +5146,8 @@ SUBROUTINE phy_prep_part2 ( config_flags,                          &
 
       IF (P_QI .ge. PARAM_FIRST_SCALAR)THEN
          DO J=j_start,j_end
-         DO I=i_start,i_end
          DO K=k_start,k_end
+         DO I=i_start,i_end
             RQICUTEN(I,K,J)=RQICUTEN(I,K,J)/(c1(k)*MUT(I,J)+c2(k))
          ENDDO
          ENDDO
@@ -5156,8 +5156,8 @@ SUBROUTINE phy_prep_part2 ( config_flags,                          &
 
       IF(P_QS .ge. PARAM_FIRST_SCALAR)THEN
          DO J=j_start,j_end
-         DO I=i_start,i_end
          DO K=k_start,k_end
+         DO I=i_start,i_end
             RQSCUTEN(I,K,J)=RQSCUTEN(I,K,J)/(c1(k)*MUT(I,J)+c2(k))
          ENDDO
          ENDDO
@@ -5169,8 +5169,8 @@ SUBROUTINE phy_prep_part2 ( config_flags,                          &
    IF (config_flags%shcu_physics .gt. 0) THEN
 
       DO J=j_start,j_end
-      DO I=i_start,i_end
       DO K=k_start,k_end
+      DO I=i_start,i_end
          RUSHTEN(I,K,J) =RUSHTEN(I,K,J)/(c1(k)*MUT(I,J)+c2(k))
          RVSHTEN(I,K,J) =RVSHTEN(I,K,J)/(c1(k)*MUT(I,J)+c2(k))
          RTHSHTEN(I,K,J)=RTHSHTEN(I,K,J)/(c1(k)*MUT(I,J)+c2(k))
@@ -5180,8 +5180,8 @@ SUBROUTINE phy_prep_part2 ( config_flags,                          &
 
       IF (P_QV .ge. PARAM_FIRST_SCALAR)THEN
          DO J=j_start,j_end
-         DO I=i_start,i_end
          DO K=k_start,k_end
+         DO I=i_start,i_end
             RQVSHTEN(I,K,J)=RQVSHTEN(I,K,J)/(c1(k)*MUT(I,J)+c2(k))
          ENDDO
          ENDDO
@@ -5190,8 +5190,8 @@ SUBROUTINE phy_prep_part2 ( config_flags,                          &
 
       IF (P_QC .ge. PARAM_FIRST_SCALAR)THEN
          DO J=j_start,j_end
-         DO I=i_start,i_end
          DO K=k_start,k_end
+         DO I=i_start,i_end
             RQCSHTEN(I,K,J)=RQCSHTEN(I,K,J)/(c1(k)*MUT(I,J)+c2(k))
          ENDDO
          ENDDO
@@ -5200,8 +5200,8 @@ SUBROUTINE phy_prep_part2 ( config_flags,                          &
 
       IF (P_QR .ge. PARAM_FIRST_SCALAR)THEN
          DO J=j_start,j_end
-         DO I=i_start,i_end
          DO K=k_start,k_end
+         DO I=i_start,i_end
             RQRSHTEN(I,K,J)=RQRSHTEN(I,K,J)/(c1(k)*MUT(I,J)+c2(k))
          ENDDO
          ENDDO
@@ -5210,8 +5210,8 @@ SUBROUTINE phy_prep_part2 ( config_flags,                          &
 
       IF (P_QI .ge. PARAM_FIRST_SCALAR)THEN
          DO J=j_start,j_end
-         DO I=i_start,i_end
          DO K=k_start,k_end
+         DO I=i_start,i_end
             RQISHTEN(I,K,J)=RQISHTEN(I,K,J)/(c1(k)*MUT(I,J)+c2(k))
          ENDDO
          ENDDO
@@ -5220,8 +5220,8 @@ SUBROUTINE phy_prep_part2 ( config_flags,                          &
 
       IF(P_QS .ge. PARAM_FIRST_SCALAR)THEN
          DO J=j_start,j_end
-         DO I=i_start,i_end
          DO K=k_start,k_end
+         DO I=i_start,i_end
             RQSSHTEN(I,K,J)=RQSSHTEN(I,K,J)/(c1(k)*MUT(I,J)+c2(k))
          ENDDO
          ENDDO
@@ -5230,8 +5230,8 @@ SUBROUTINE phy_prep_part2 ( config_flags,                          &
 
       IF(P_QG .ge. PARAM_FIRST_SCALAR)THEN
          DO J=j_start,j_end
-         DO I=i_start,i_end
          DO K=k_start,k_end
+         DO I=i_start,i_end
             RQGSHTEN(I,K,J)=RQGSHTEN(I,K,J)/(c1(k)*MUT(I,J)+c2(k))
          ENDDO
          ENDDO
@@ -5296,8 +5296,8 @@ SUBROUTINE phy_prep_part2 ( config_flags,                          &
 
       IF (P_QV .ge. PARAM_FIRST_SCALAR)THEN
          DO J=j_start,j_end
-         DO I=i_start,i_end
-            DO K=k_start,k_end
+         DO K=k_start,k_end
+            DO I=i_start,i_end
                RQVFTEN(I,K,J)=RQVFTEN(I,K,J)/(c1(k)*MUT(I,J)+c2(k))
             ENDDO
          ENDDO
@@ -5312,8 +5312,8 @@ SUBROUTINE phy_prep_part2 ( config_flags,                          &
       ( config_flags%cu_physics == NTIEDTKESCHEME )) THEN
 
       DO J=j_start,j_end
-      DO I=i_start,i_end
-         DO K=k_start,k_end
+      DO K=k_start,k_end
+         DO I=i_start,i_end
             RTHFTEN(I,K,J)=RTHFTEN(I,K,J)/(c1(k)*MUT(I,J)+c2(k))
          ENDDO
       ENDDO
@@ -5322,8 +5322,8 @@ SUBROUTINE phy_prep_part2 ( config_flags,                          &
 !  If using moist theta, get dry theta tendency for CPSs
       IF ( config_flags%use_theta_m == 1 ) THEN
          DO J=j_start,j_end
-         DO I=i_start,i_end
-            DO K=k_start,k_end
+         DO K=k_start,k_end
+            DO I=i_start,i_end
                th_phy(i,k,j) = (t_new(i,k,j) + t0) / (1. + (R_v/R_d) * qv(i,k,j))
                rthften(i,k,j) = th_phy(i,k,j)/(t_new(i,k,j)+t0) *          &
                                (rthften(i,k,j) - (R_v/R_d) * th_phy(i,k,j) * rqvften(i,k,j))

dyn_em/module_em.F

@@ -2208,8 +2208,8 @@ SUBROUTINE calculate_phy_tend (config_flags,c1,c2,                     &
    IF (config_flags%cu_physics .gt. 0) THEN
 
       DO J=jts,jtf
-      DO I=its,itf
       DO K=kts,ktf
+      DO I=its,itf
          RUCUTEN(I,K,J) =(c1(k)*mut(I,J)+c2(k))*RUCUTEN(I,K,J)
          RVCUTEN(I,K,J) =(c1(k)*mut(I,J)+c2(k))*RVCUTEN(I,K,J)
          RTHCUTEN(I,K,J)=(c1(k)*mut(I,J)+c2(k))*RTHCUTEN(I,K,J)
@@ -2220,8 +2220,8 @@ SUBROUTINE calculate_phy_tend (config_flags,c1,c2,                     &
 
       IF (P_QC .ge. PARAM_FIRST_SCALAR)THEN
          DO J=jts,jtf
-         DO I=its,itf
          DO K=kts,ktf
+         DO I=its,itf
             RQCCUTEN(I,K,J)=(c1(k)*mut(I,J)+c2(k))*RQCCUTEN(I,K,J)
          ENDDO
          ENDDO
@@ -2230,8 +2230,8 @@ SUBROUTINE calculate_phy_tend (config_flags,c1,c2,                     &
 
       IF (P_QR .ge. PARAM_FIRST_SCALAR)THEN
          DO J=jts,jtf
-         DO I=its,itf
          DO K=kts,ktf
+         DO I=its,itf
             RQRCUTEN(I,K,J)=(c1(k)*mut(I,J)+c2(k))*RQRCUTEN(I,K,J)
          ENDDO
          ENDDO
@@ -2240,8 +2240,8 @@ SUBROUTINE calculate_phy_tend (config_flags,c1,c2,                     &
 
       IF (P_QI .ge. PARAM_FIRST_SCALAR)THEN
          DO J=jts,jtf
-         DO I=its,itf
          DO K=kts,ktf
+         DO I=its,itf
             RQICUTEN(I,K,J)=(c1(k)*mut(I,J)+c2(k))*RQICUTEN(I,K,J)
          ENDDO
          ENDDO
@@ -2250,8 +2250,8 @@ SUBROUTINE calculate_phy_tend (config_flags,c1,c2,                     &
 
       IF(P_QS .ge. PARAM_FIRST_SCALAR)THEN
          DO J=jts,jtf
-         DO I=its,itf
          DO K=kts,ktf
+         DO I=its,itf
             RQSCUTEN(I,K,J)=(c1(k)*mut(I,J)+c2(k))*RQSCUTEN(I,K,J)
          ENDDO
          ENDDO
@@ -2265,8 +2265,8 @@ SUBROUTINE calculate_phy_tend (config_flags,c1,c2,                     &
    IF (config_flags%shcu_physics .gt. 0) THEN
 
       DO J=jts,jtf
-      DO I=its,itf
       DO K=kts,ktf
+      DO I=its,itf
          RUSHTEN(I,K,J) =(c1(k)*mut(I,J)+c2(k))*RUSHTEN(I,K,J)
          RVSHTEN(I,K,J) =(c1(k)*mut(I,J)+c2(k))*RVSHTEN(I,K,J)
          RTHSHTEN(I,K,J)=(c1(k)*mut(I,J)+c2(k))*RTHSHTEN(I,K,J)
@@ -2277,8 +2277,8 @@ SUBROUTINE calculate_phy_tend (config_flags,c1,c2,                     &
 
       IF (P_QC .ge. PARAM_FIRST_SCALAR)THEN
          DO J=jts,jtf
-         DO I=its,itf
          DO K=kts,ktf
+         DO I=its,itf
             RQCSHTEN(I,K,J)=(c1(k)*mut(I,J)+c2(k))*RQCSHTEN(I,K,J)
          ENDDO
          ENDDO
@@ -2287,8 +2287,8 @@ SUBROUTINE calculate_phy_tend (config_flags,c1,c2,                     &
 
       IF (P_QR .ge. PARAM_FIRST_SCALAR)THEN
          DO J=jts,jtf
-         DO I=its,itf
          DO K=kts,ktf
+         DO I=its,itf
             RQRSHTEN(I,K,J)=(c1(k)*mut(I,J)+c2(k))*RQRSHTEN(I,K,J)
          ENDDO
          ENDDO
@@ -2297,8 +2297,8 @@ SUBROUTINE calculate_phy_tend (config_flags,c1,c2,                     &
 
       IF (P_QI .ge. PARAM_FIRST_SCALAR)THEN
          DO J=jts,jtf
-         DO I=its,itf
          DO K=kts,ktf
+         DO I=its,itf
             RQISHTEN(I,K,J)=(c1(k)*mut(I,J)+c2(k))*RQISHTEN(I,K,J)
          ENDDO
          ENDDO
@@ -2307,8 +2307,8 @@ SUBROUTINE calculate_phy_tend (config_flags,c1,c2,                     &
 
       IF(P_QS .ge. PARAM_FIRST_SCALAR)THEN
          DO J=jts,jtf
-         DO I=its,itf
          DO K=kts,ktf
+         DO I=its,itf
             RQSSHTEN(I,K,J)=(c1(k)*mut(I,J)+c2(k))*RQSSHTEN(I,K,J)
          ENDDO
          ENDDO
@@ -2317,8 +2317,8 @@ SUBROUTINE calculate_phy_tend (config_flags,c1,c2,                     &
 
       IF(P_QG .ge. PARAM_FIRST_SCALAR)THEN
          DO J=jts,jtf
-         DO I=its,itf
          DO K=kts,ktf
+         DO I=its,itf
             RQGSHTEN(I,K,J)=(c1(k)*mut(I,J)+c2(k))*RQGSHTEN(I,K,J)
          ENDDO
          ENDDO