Changeset 387 for codes/icosagcm/trunk/src/hevi_scheme.f90

Timestamp:

05/28/16 00:32:21 (8 years ago)

Author:

dubos

Message:

Infrastructure for multiple dynamical tracers - tested with JW06 and moist baroclinic wave

File:

• codes/icosagcm/trunk/src/hevi_scheme.f90 (modified) (4 diffs)

codes/icosagcm/trunk/src/hevi_scheme.f90

@@ -80 +80 @@
              CALL update_2D(bjl(l,j), f_ps, f_dps_slow(:,l))
           ELSE
-             CALL update(bjl(l,j), f_mass, f_dmass_slow(:,l))
+             CALL update_3D(bjl(l,j), f_mass, f_dmass_slow(:,l))
           END IF
-          CALL update(bjl(l,j), f_theta_rhodz, f_dtheta_rhodz_slow(:,l))
-          CALL update(bjl(l,j), f_u, f_du_slow(:,l))
-          CALL update(cjl(l,j), f_u, f_du_fast(:,l))
+          CALL update_4D(bjl(l,j), f_theta_rhodz, f_dtheta_rhodz_slow(:,l))
+          CALL update_3D(bjl(l,j), f_u, f_du_slow(:,l))
+          CALL update_3D(cjl(l,j), f_u, f_du_fast(:,l))
           IF(.NOT. hydrostatic) THEN
-             CALL update(bjl(l,j), f_W, f_dW_slow(:,l))
-             CALL update(cjl(l,j), f_W, f_dW_fast(:,l))
-             CALL update(bjl(l,j), f_geopot, f_dPhi_slow(:,l))
-             CALL update(cjl(l,j), f_geopot, f_dPhi_fast(:,l))
+             CALL update_3D(bjl(l,j), f_W, f_dW_slow(:,l))
+             CALL update_3D(cjl(l,j), f_W, f_dW_fast(:,l))
+             CALL update_3D(bjl(l,j), f_geopot, f_dPhi_slow(:,l))
+             CALL update_3D(cjl(l,j), f_geopot, f_dPhi_fast(:,l))
           END IF
        END DO
@@ -96 +96 @@
   END SUBROUTINE HEVI_scheme
   
-  SUBROUTINE update(w, f_y, f_dy)
+  SUBROUTINE update_4D(w, f_y, f_dy)
+    USE dimensions
+    USE grid_param, ONLY : nqdyn
+    REAL(rstd) :: w
+    TYPE(t_field) :: f_y(:), f_dy(:)
+    REAL(rstd), POINTER :: y(:,:,:), dy(:,:,:)
+    INTEGER :: ind, iq
+    IF(w /= 0.) THEN
+       DO ind=1,ndomain
+          IF (.NOT. assigned_domain(ind)) CYCLE
+          CALL swap_dimensions(ind)
+          dy=f_dy(ind); y=f_y(ind)
+          DO iq=1,nqdyn
+             CALL compute_update_3D(w,y(:,:,iq),dy(:,:,iq))
+          END DO
+       ENDDO
+    END IF
+  END SUBROUTINE update_4D
+    
+  SUBROUTINE update_3D(w, f_y, f_dy)
     USE dimensions
     REAL(rstd) :: w
@@ -107 +126 @@
           CALL swap_dimensions(ind)
           dy=f_dy(ind); y=f_y(ind)
-          CALL compute_update(w,y,dy)
+          CALL compute_update_3D(w,y,dy)
        ENDDO
     END IF
-  END SUBROUTINE update
+  END SUBROUTINE update_3D
     
-  SUBROUTINE compute_update(w, y, dy)
+  SUBROUTINE compute_update_3D(w, y, dy)
     USE omp_para
     USE disvert_mod
@@ -123 +142 @@
        y(:,l)=y(:,l)+w*dy(:,l)
     ENDDO
-  END SUBROUTINE compute_update
+  END SUBROUTINE compute_update_3D
   
   SUBROUTINE update_2D(w, f_y, f_dy)