Changeset 3600 for branches/2012/dev_UKMO_2012/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90

Timestamp:

2012-11-19T14:59:22+01:00 (11 years ago)

Author:

rfurner

Message:

Changes from branch dev_r3435_UKMO7_SCOORDS revision 3435 to 3507 merged in

File:

• branches/2012/dev_UKMO_2012/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90 (modified) (3 diffs)

branches/2012/dev_UKMO_2012/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90

@@ -36 +36 @@
    USE dyncor_c1d      ! Coriolis term (c1d case)         (cor_c1d routine)
    USE timing          ! Timing
+   USE lbclnk          ! ocean lateral boundary condition (or mpp link)
 
    IMPLICIT NONE
@@ -84 +85 @@
                              CALL dom_zgr      ! Vertical mesh and bathymetry
                              CALL dom_msk      ! Masks
+      IF( ln_sco )           CALL dom_stiff    ! Maximum stiffness ratio/hydrostatic consistency
       IF( lk_vvl         )   CALL dom_vvl      ! Vertical variable mesh
       !
@@ -322 +324 @@
    END SUBROUTINE dom_ctl
 
+   SUBROUTINE dom_stiff
+      !!----------------------------------------------------------------------
+      !!                  ***  ROUTINE dom_stiff  ***
+      !!                     
+      !! ** Purpose :   Diagnose maximum grid stiffness/hydrostatic consistency
+      !!
+      !! ** Method  :   Compute Haney (1991) hydrostatic condition ratio
+      !!                Save the maximum in the vertical direction
+      !!                (this number is only relevant in s-coordinates)
+      !!
+      !!                Haney, R. L., 1991: On the pressure gradient force
+      !!                over steep topography in sigma coordinate ocean models. 
+      !!                J. Phys. Oceanogr., 21, 610???619.
+      !!----------------------------------------------------------------------
+      INTEGER  ::   ji, jj, jk 
+      REAL(wp) ::   zrxmax
+      REAL(wp), DIMENSION(4) :: zr1
+      !!----------------------------------------------------------------------
+      rx1(:,:) = 0.e0
+      zrxmax   = 0.e0
+      zr1(:)   = 0.e0
+      
+      DO ji = 2, jpim1
+         DO jj = 2, jpjm1
+            DO jk = 1, jpkm1
+               zr1(1) = umask(ji-1,jj  ,jk) *abs( (gdepw(ji  ,jj  ,jk  )-gdepw(ji-1,jj  ,jk  )  & 
+                    &                         +gdepw(ji  ,jj  ,jk+1)-gdepw(ji-1,jj  ,jk+1)) &
+                    &                        /(gdepw(ji  ,jj  ,jk  )+gdepw(ji-1,jj  ,jk  )  &
+                    &                         -gdepw(ji  ,jj  ,jk+1)-gdepw(ji-1,jj  ,jk+1) + rsmall) )
+               zr1(2) = umask(ji  ,jj  ,jk) *abs( (gdepw(ji+1,jj  ,jk  )-gdepw(ji  ,jj  ,jk  )  &
+                    &                         +gdepw(ji+1,jj  ,jk+1)-gdepw(ji  ,jj  ,jk+1)) &
+                    &                        /(gdepw(ji+1,jj  ,jk  )+gdepw(ji  ,jj  ,jk  )  &
+                    &                         -gdepw(ji+1,jj  ,jk+1)-gdepw(ji  ,jj  ,jk+1) + rsmall) )
+               zr1(3) = vmask(ji  ,jj  ,jk) *abs( (gdepw(ji  ,jj+1,jk  )-gdepw(ji  ,jj  ,jk  )  &
+                    &                         +gdepw(ji  ,jj+1,jk+1)-gdepw(ji  ,jj  ,jk+1)) &
+                    &                        /(gdepw(ji  ,jj+1,jk  )+gdepw(ji  ,jj  ,jk  )  &
+                    &                         -gdepw(ji  ,jj+1,jk+1)-gdepw(ji  ,jj  ,jk+1) + rsmall) )
+               zr1(4) = vmask(ji  ,jj-1,jk) *abs( (gdepw(ji  ,jj  ,jk  )-gdepw(ji  ,jj-1,jk  )  &
+                    &                         +gdepw(ji  ,jj  ,jk+1)-gdepw(ji  ,jj-1,jk+1)) &
+                    &                        /(gdepw(ji  ,jj  ,jk  )+gdepw(ji  ,jj-1,jk  )  &
+                    &                         -gdepw(ji,  jj  ,jk+1)-gdepw(ji  ,jj-1,jk+1) + rsmall) )
+               zrxmax = MAXVAL(zr1(1:4))
+               rx1(ji,jj) = MAX(rx1(ji,jj), zrxmax)
+            END DO
+         END DO
+      END DO
+
+      CALL lbc_lnk( rx1, 'T', 1. )
+
+      zrxmax = MAXVAL(rx1)
+
+      IF( lk_mpp )   CALL mpp_max( zrxmax ) ! max over the global domain
+
+      IF(lwp) THEN
+         WRITE(numout,*)
+         WRITE(numout,*) 'dom_stiff : maximum grid stiffness ratio: ', zrxmax
+         WRITE(numout,*) '~~~~~~~~~'
+      ENDIF
+
+   END SUBROUTINE dom_stiff
+
+
+
    !!======================================================================
 END MODULE domain