Changeset 7900 for branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

Timestamp:

2017-04-12T11:48:20+02:00 (7 years ago)

Author:

glong

Message:

Comment changes to dynhpg.F90, moved halo exchange to 2d method from 3d method in divcur.F90 and picked off spg and wind stress in dynspg_ts.F90

File:

• branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90 (modified) (8 diffs)

branches/UKMO/GO6_dyn_vrt_diag/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

@@ -150 +150 @@
       REAL(wp) ::   zx1, zy1, zx2, zy2         !   -      -
       REAL(wp) ::   z1_12, z1_8, z1_4, z1_2    !   -      -
-      REAL(wp) ::   zu_spg, zv_spg             !   -      -
       REAL(wp) ::   zhura, zhvra               !   -      -
       REAL(wp) ::   za0, za1, za2, za3           !   -      -
@@ -159 +158 @@
       REAL(wp), POINTER, DIMENSION(:,:) :: zhup2_e, zhvp2_e, zhust_e, zhvst_e
       REAL(wp), POINTER, DIMENSION(:,:) :: zsshu_a, zsshv_a
+      REAL(wp), POINTER, DIMENSION(:,:) :: zu_dia, zv_dia, zu_wfrc, zv_wfrc
+      REAL(wp), POINTER, DIMENSION(:,:) :: zu_spg, zv_spg
       REAL(wp), POINTER, DIMENSION(:,:) :: zhf
       !!----------------------------------------------------------------------
@@ -170 +171 @@
       CALL wrk_alloc( jpi, jpj, zhup2_e, zhvp2_e, zhust_e, zhvst_e)
       CALL wrk_alloc( jpi, jpj, zsshu_a, zsshv_a                                   )
+      CALL wrk_alloc( jpi, jpj, zu_dia, zv_dia, zu_wfrc, zv_wfrc                   )
+      CALL wrk_alloc( jpi, jpj, zu_spg, zv_spg                                     )
       CALL wrk_alloc( jpi, jpj, zhf )
       !
@@ -397 +400 @@
       END DO 
       !
+      !                                         ! Set zu_dia for use in dyn_vrt_dia
+      zu_dia(:,:) = zu_frc(:,:)
+      zv_dia(:,:) = zv_frc(:,:)
+      !
       !                 ! Add bottom stress contribution from baroclinic velocities:      
       IF (ln_bt_fw) THEN
@@ -423 +430 @@
       !       
       IF (ln_bt_fw) THEN                        ! Add wind forcing
-         zu_frc(:,:) =  zu_frc(:,:) + zraur * utau(:,:) * hur(:,:)
-         zv_frc(:,:) =  zv_frc(:,:) + zraur * vtau(:,:) * hvr(:,:)
+         zu_wfrc(:,:) =  zraur * utau(:,:) * hur(:,:)
+         zv_wfrc(:,:) =  zraur * vtau(:,:) * hvr(:,:)
       ELSE
-         zu_frc(:,:) =  zu_frc(:,:) + zraur * z1_2 * ( utau_b(:,:) + utau(:,:) ) * hur(:,:)
-         zv_frc(:,:) =  zv_frc(:,:) + zraur * z1_2 * ( vtau_b(:,:) + vtau(:,:) ) * hvr(:,:)
+         zu_wfrc(:,:) =  zraur * z1_2 * ( utau_b(:,:) + utau(:,:) ) * hur(:,:)
+         zv_wfrc(:,:) =  zraur * z1_2 * ( vtau_b(:,:) + vtau(:,:) ) * hvr(:,:)
       ENDIF  
+      zu_frc(:,:) = zu_frc(:,:) + zu_wfrc(:,:)
+      zv_frc(:,:) = zv_frc(:,:) + zv_wfrc(:,:)
+
+                                        ! Calculate dia_vor_int & dia_vor_mn if required
+      IF ( ( id_dia_vrt_spg_int == 1 ) .or. (id_dia_vrt_spg_mean == 1 ) ) THEN
+         zu_dia(:,:) = zu_dia(:,:) + zu_wfrc(:,:)
+         zv_dia(:,:) = zv_dia(:,:) + zv_wfrc(:,:)
+         CALL dyn_vrt_dia_2d(zu_dia, zv_dia, id_dia_vrt_spg_int, id_dia_vrt_spg_mean)
+         !     Reset zu_dia for use again later.
+         zu_dia(:,:) = zu_dia(:,:) - zu_wfrc(:,:)
+         zv_dia(:,:) = zv_dia(:,:) - zv_wfrc(:,:)
+      END IF
+      !
       !
       IF ( ln_apr_dyn ) THEN                    ! Add atm pressure forcing
@@ -434 +454 @@
             DO jj = 2, jpjm1              
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zu_spg =  grav * (  ssh_ib (ji+1,jj  ) - ssh_ib (ji,jj) ) /e1u(ji,jj)
-                  zv_spg =  grav * (  ssh_ib (ji  ,jj+1) - ssh_ib (ji,jj) ) /e2v(ji,jj)
-                  zu_frc(ji,jj) = zu_frc(ji,jj) + zu_spg
-                  zv_frc(ji,jj) = zv_frc(ji,jj) + zv_spg
+                  zu_spg(ji,jj) =  grav * (  ssh_ib (ji+1,jj  ) - ssh_ib (ji,jj) ) /e1u(ji,jj)
+                  zv_spg(ji,jj) =  grav * (  ssh_ib (ji  ,jj+1) - ssh_ib (ji,jj) ) /e2v(ji,jj)
                END DO
             END DO
@@ -443 +461 @@
             DO jj = 2, jpjm1              
                DO ji = fs_2, fs_jpim1   ! vector opt.
-                  zu_spg =  grav * z1_2 * (  ssh_ib (ji+1,jj  ) - ssh_ib (ji,jj)    &
+                  zu_spg(ji,jj) =  grav * z1_2 * (  ssh_ib (ji+1,jj  ) - ssh_ib (ji,jj)    &
                       &                    + ssh_ibb(ji+1,jj  ) - ssh_ibb(ji,jj)  ) /e1u(ji,jj)
-                  zv_spg =  grav * z1_2 * (  ssh_ib (ji  ,jj+1) - ssh_ib (ji,jj)    &
+                  zv_spg(ji,jj) =  grav * z1_2 * (  ssh_ib (ji  ,jj+1) - ssh_ib (ji,jj)    &
                       &                    + ssh_ibb(ji  ,jj+1) - ssh_ibb(ji,jj)  ) /e2v(ji,jj)
-                  zu_frc(ji,jj) = zu_frc(ji,jj) + zu_spg
-                  zv_frc(ji,jj) = zv_frc(ji,jj) + zv_spg
                END DO
             END DO
          ENDIF 
-      ENDIF
-      !
-                                                ! Calculate dia_vor_int &
-                                                ! dia_vor_mn if required
-      IF ( ( id_dia_vrt_spg_int == 1 ) .or. (id_dia_vrt_spg_mean == 1 ) ) THEN
-          CALL dyn_vrt_dia_2d(zu_frc, zv_frc, di_dia_vrt_spg_int, id_dia_vrt_spg_mean)
-      END IF
+         zu_frc(:,:) = zu_frc(:,:) + zu_spg(:,:)
+         zv_frc(:,:) = zv_frc(:,:) + zv_spg(:,:)
+                                        ! Calculate dia_vor_int & dia_vor_mn if required
+         IF ( ( id_dia_vrt_spg_int == 1 ) .or. (id_dia_vrt_spg_mean == 1 ) ) THEN
+            zu_dia(:,:) = zu_dia(:,:) + zu_spg(:,:)
+            zv_dia(:,:) = zv_dia(:,:) + zv_spg(:,:)
+            CALL dyn_vrt_dia_2d(zu_dia, zv_dia, id_dia_vrt_spg_int, id_dia_vrt_spg_mean)
+         END IF
+      ENDIF
+      !
       !                                   !* Right-Hand-Side of the barotropic ssh equation
       !                                   ! -----------------------------------------------
@@ -933 +952 @@
       CALL wrk_dealloc( jpi, jpj, zhup2_e, zhvp2_e, zhust_e, zhvst_e )
       CALL wrk_dealloc( jpi, jpj, zsshu_a, zsshv_a                                   )
+      CALL wrk_dealloc( jpi, jpj, zu_dia, zv_dia, zu_wfrc, zv_wfrc                   )
+      CALL wrk_dealloc( jpi, jpj, zu_spg, zv_spg                                     )
       CALL wrk_dealloc( jpi, jpj, zhf )
       !