Changeset 3032 for branches/2011/dev_CMCC/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90

Timestamp:

2011-10-31T15:48:12+01:00 (13 years ago)

Author:

vichi

Message:

ticket #881. Step 2: Added changes from dev_r2855_CMCC3_divd branch

File:

• branches/2011/dev_CMCC/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90 (modified) (6 diffs)

branches/2011/dev_CMCC/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90

@@ -25 +25 @@
    USE oce              ! Dynamics and active tracers defined in memory
    USE divcur           ! Horizontal divergence and relative vorticity
+   USE ldfdyn_oce       ! ocean dynamics: lateral physics
    USE eosbn2           ! Equation of state - in situ and potential density
    USE zpshde           ! Partial step : Horizontal Derivative
@@ -55 +56 @@
    LOGICAL, PUBLIC :: ln_sshinc = .FALSE. !: No sea surface height assimilation increment
    LOGICAL, PUBLIC :: ln_salfix = .FALSE. !: Apply minimum salinity check
+   INTEGER, PUBLIC ::   ndivdmp = 0       !: Apply divergence damping filter ndivdmp times
 
    REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::   t_bkg   , s_bkg      !: Background temperature and salinity
@@ -76 +78 @@
    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::   ssh_bkg, ssh_bkginc   ! Background sea surface height and its increment
 
+   !! * Substitutions
+#  include "domzgr_substitute.h90"
+#  include "ldfdyn_substitute.h90"
+#  include "vectopt_loop_substitute.h90"
+
    !!----------------------------------------------------------------------
    !! NEMO/OPA 3.3 , NEMO Consortium (2010)
@@ -93 +100 @@
       !! ** Action  : 
       !!----------------------------------------------------------------------
+      !!
+      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released, wrk_2d_1
+      USE wrk_nemo, ONLY: hdiv => wrk_2d_1  ! Horizontal divergence
+      !!
+      INTEGER :: ji,jj,jk
       INTEGER :: jt
       INTEGER :: imid
@@ -116 +128 @@
          &                 ln_asmdin, ln_asmiau,                           &
          &                 nitbkg, nitdin, nitiaustr, nitiaufin, niaufn,   &
-         &                 nittrjfrq, ln_salfix, salfixmin
+         &                 nittrjfrq, ln_salfix, salfixmin,                &
+         &                 ndivdmp
       !!----------------------------------------------------------------------
 
@@ -420 +433 @@
 
       !-----------------------------------------------------------------------
+      ! Apply divergence damping filter
+      !-----------------------------------------------------------------------
+
+
+      IF ( ln_dyninc .AND. ndivdmp.gt.0 ) THEN
+
+       IF( wrk_in_use( 2, 1) ) THEN
+         CALL ctl_stop('asm_inc_init : requested workspace for divergence unavailable.')
+       ENDIF
+
+
+       DO  jt = 1, ndivdmp
+
+           DO jk = 1, jpkm1
+
+                  hdiv(:,:) = 0._wp
+
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  hdiv(ji,jj) =   &
+                     (  e2u(ji  ,jj)*fse3u(ji  ,jj,jk) * u_bkginc(ji  ,jj,jk)       &
+                      - e2u(ji-1,jj)*fse3u(ji-1,jj,jk) * u_bkginc(ji-1,jj,jk)       &
+                      + e1v(ji,jj  )*fse3v(ji,jj  ,jk) * v_bkginc(ji,jj  ,jk)       &
+                      - e1v(ji,jj-1)*fse3v(ji,jj-1,jk) * v_bkginc(ji,jj-1,jk)  )    &
+                      / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
+               END DO
+            END DO
+
+            CALL lbc_lnk( hdiv, 'T', 1. )   ! lateral boundary cond. (no sign change)
+
+            DO jj = 2, jpjm1
+               DO ji = fs_2, fs_jpim1   ! vector opt.
+                  u_bkginc(ji,jj,jk) = u_bkginc(ji,jj,jk) + 0.2 * ( e1t(ji+1,jj)*e2t(ji+1,jj) * hdiv(ji+1,jj)   &
+                                                                  - e1t(ji  ,jj)*e2t(ji  ,jj) * hdiv(ji  ,jj) ) &
+                                                                / e1u(ji,jj) * umask(ji,jj,jk) 
+                  v_bkginc(ji,jj,jk) = v_bkginc(ji,jj,jk) + 0.2 * ( e1t(ji,jj+1)*e2t(ji,jj+1) * hdiv(ji,jj+1)   &
+                                                                  - e1t(ji,jj  )*e2t(ji,jj  ) * hdiv(ji,jj  ) ) &
+                                                                / e2v(ji,jj) * vmask(ji,jj,jk) 
+               END DO
+            END DO
+
+           END DO
+
+       END DO
+
+       IF( wrk_not_released( 2, 1) ) THEN
+         CALL ctl_stop('asm_inc_init : failed to release divergence')
+       ENDIF
+
+      ENDIF
+
+
+
+      !-----------------------------------------------------------------------
       ! Allocate and initialize the background state arrays
       !-----------------------------------------------------------------------