Changeset 14058 for NEMO/branches/2020/dev_r13723_KERNEL-01_Amy_Mike_newHPGschemes/tests/BENCH/MY_SRC/usrdef_istate.F90

Timestamp:

2020-12-03T16:53:41+01:00 (3 years ago)

Author:

ayoung

Message:

Updating to trunk revision 14057. No conflicts since last sette test. Ticket #2480.

File:

• NEMO/branches/2020/dev_r13723_KERNEL-01_Amy_Mike_newHPGschemes/tests/BENCH/MY_SRC/usrdef_istate.F90 (modified) (6 diffs)

NEMO/branches/2020/dev_r13723_KERNEL-01_Amy_Mike_newHPGschemes/tests/BENCH/MY_SRC/usrdef_istate.F90

@@ -26 +26 @@
    PRIVATE
 
-   PUBLIC   usr_def_istate   ! called by istate.F90
+   PUBLIC   usr_def_istate       ! called by istate.F90
+   PUBLIC   usr_def_istate_ssh   ! called by domqco.F90
 
    !! * Substitutions
@@ -37 +38 @@
 CONTAINS
   
-   SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv, pssh )
+   SUBROUTINE usr_def_istate( pdept, ptmask, pts, pu, pv ) !!st, pssh )
       !!----------------------------------------------------------------------
       !!                   ***  ROUTINE usr_def_istate  ***
@@ -52 +53 @@
       REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pu      ! i-component of the velocity  [m/s] 
       REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(  out) ::   pv      ! j-component of the velocity  [m/s] 
-      REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height
+!!st      REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height
       !
       REAL(wp), DIMENSION(jpi,jpj) ::   z2d   ! 2D workspace
@@ -79 +80 @@
       !
       ! sea level:
-      pssh(:,:) = z2d(:,:)                                                ! +/- 0.05 m
+!!st      pssh(:,:) = z2d(:,:)                                                ! +/- 0.05 m
       !
       DO_3D( 0, 0, 0, 0, 1, jpkm1 )
@@ -95 +96 @@
       pv( :,:,jpk  ) = 0._wp
       !
-      CALL lbc_lnk('usrdef_istate', pssh, 'T',  1. )            ! apply boundary conditions
+!!st      CALL lbc_lnk('usrdef_istate', pssh, 'T',  1. )            ! apply boundary conditions
       CALL lbc_lnk('usrdef_istate',  pts, 'T',  1. )            ! apply boundary conditions
       CALL lbc_lnk('usrdef_istate',   pu, 'U', -1. )            ! apply boundary conditions
@@ -102 +103 @@
    END SUBROUTINE usr_def_istate
 
+
+   SUBROUTINE usr_def_istate_ssh( ptmask, pssh )
+      !!----------------------------------------------------------------------
+      !!                   ***  ROUTINE usr_def_istate_ssh  ***
+      !! 
+      !! ** Purpose :   Initialization of ssh
+      !!                Here BENCH configuration 
+      !!
+      !! ** Method  :   Set ssh
+      !!----------------------------------------------------------------------
+      REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   ptmask  ! t-point ocean mask   [m]
+      REAL(wp), DIMENSION(jpi,jpj)         , INTENT(  out) ::   pssh    ! sea-surface height   [m]
+      !
+      INTEGER  ::   ji, jj
+      INTEGER  ::   igloi, igloj   ! to be removed in the future, see usr_def_istate comment 
+      !!----------------------------------------------------------------------
+      !
+      IF(lwp) WRITE(numout,*)
+      IF(lwp) WRITE(numout,*) 'usr_def_istate_ssh : BENCH configuration, analytical definition of initial ssh'
+      !
+      igloi = Ni0glo + 2 * COUNT( (/ jperio == 1 .OR. jperio == 4 .OR. jperio == 6 .OR. jperio == 7 /) )
+      igloj = Nj0glo + 2 * COUNT( (/ jperio == 2 .OR. jperio == 7 /) ) + 1 * COUNT( (/ jperio >= 4 .AND. jperio <= 6 /) )
+      ! sea level:  +/- 0.05 m
+      DO_2D( 0, 0, 0, 0 )
+         pssh(ji,jj) = 0.1 * ( 0.5 - REAL( mig0_oldcmp(ji) + (mjg0_oldcmp(jj)-1) * igloi, wp ) / REAL( igloi * igloj, wp ) )
+      END_2D
+      !
+      CALL lbc_lnk('usrdef_istate', pssh, 'T',  1. )            ! apply boundary conditions
+      !
+   END SUBROUTINE usr_def_istate_ssh
+   
    !!======================================================================
 END MODULE usrdef_istate