Changeset 6667 for branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/DIA/diatmb.F90

Timestamp:

2016-06-06T07:57:00+02:00 (8 years ago)

Author:

gm

Message:

#1692 - branch SIMPLIF_2_usrdef: reduced domain_cfg.nc file: GYRE OK using usrdef or reading file

File:

• branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/DIA/diatmb.F90 (modified) (6 diffs)

branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/DIA/diatmb.F90

@@ -4 +4 @@
    !! Harmonic analysis of tidal constituents 
    !!======================================================================
-   !! History :  3.6  !  2014  (E O'Dea)  Original code
+   !! History :  3.6  !  08-2014  (E O'Dea)  Original code
+   !!            3.7  !  05-2016  (G. Madec)  use mbkt, mikt to account for ocean cavities
    !!----------------------------------------------------------------------
    USE oce             ! ocean dynamics and tracers variables
    USE dom_oce         ! ocean space and time domain
+   !
    USE in_out_manager  ! I/O units
    USE iom             ! I/0 library
@@ -31 +33 @@
       !!                  ***  ROUTINE dia_tmb_init  ***
       !!     
-      !! ** Purpose: Initialization of tmb namelist 
+      !! ** Purpose :   Initialization of tmb namelist 
       !!        
-      !! ** Method : Read namelist
-      !!   History
-      !!   3.6  !  08-14  (E. O'Dea) Routine to initialize dia_tmb
+      !! ** Method  :   Read namelist
       !!---------------------------------------------------------------------------
-      !!
       INTEGER ::   ios                 ! Local integer output status for namelist read
       !
@@ -59 +58 @@
          WRITE(numout,*) 'Switch for TMB diagnostics (T) or not (F)  ln_diatmb  = ', ln_diatmb
       ENDIF
-
+      !
    END SUBROUTINE dia_tmb_init
 
-   SUBROUTINE dia_calctmb( pinfield,pouttmb )
+
+   SUBROUTINE dia_calctmb( pfield, ptmb )
       !!---------------------------------------------------------------------
       !!                  ***  ROUTINE dia_tmb  ***
@@ -68 +68 @@
       !! ** Purpose :    Find the Top, Mid and Bottom fields of water Column
       !!
-      !! ** Method  :   
-      !!      use mbathy to find surface, mid and bottom of model levels
+      !! ** Method  :    use mbkt, mikt to find surface, mid and bottom of 
+      !!              model levels due to potential existence of ocean cavities
       !!
-      !! History :
-      !!   3.6  !  08-14  (E. O'Dea) Routine based on dia_wri_foam
       !!----------------------------------------------------------------------
-      !! * Modules used
-
-      ! Routine to map 3d field to top, middle, bottom
-      IMPLICIT NONE
-
-
-      ! Routine arguments
-      REAL(wp), DIMENSION(jpi, jpj, jpk), INTENT(IN   ) :: pinfield    ! Input 3d field and mask
-      REAL(wp), DIMENSION(jpi, jpj, 3  ), INTENT(  OUT) :: pouttmb     ! Output top, middle, bottom
-
-
-
-      ! Local variables
-      INTEGER :: ji,jj,jk  ! Dummy loop indices
-
-      ! Local Real
-      REAL(wp)                         ::   zmdi  !  set masked values
-
-      zmdi=1.e+20 !missing data indicator for masking
-
-      ! Calculate top
-      pouttmb(:,:,1) = pinfield(:,:,1)*tmask(:,:,1)  + zmdi*(1.0-tmask(:,:,1))
-
-      ! Calculate middle
-      DO jj = 1,jpj
-         DO ji = 1,jpi
-            jk              = max(1,mbathy(ji,jj)/2)
-            pouttmb(ji,jj,2) = pinfield(ji,jj,jk)*tmask(ji,jj,jk)  + zmdi*(1.0-tmask(ji,jj,jk))
+      REAL(wp), DIMENSION(jpi, jpj, jpk), INTENT(in   ) :: pfield   ! Input 3d field and mask
+      REAL(wp), DIMENSION(jpi, jpj,  3 ), INTENT(  out) :: ptmb     ! top, middle, bottom extracted from pfield
+      !
+      INTEGER  ::   ji, jj  ! Dummy loop indices
+      INTEGER  ::   itop, imid, ibot  ! local integers
+      REAL(wp) ::   zmdi = 1.e+20_wp  ! land value
+      !!---------------------------------------------------------------------
+      !
+      DO jj = 1, jpj
+         DO ji = 1, jpi
+            itop = mikt(ji,jj)                        ! top    ocean 
+            ibot = mbkt(ji,jj)                        ! bottom ocean 
+            imid =  itop + ( ibot - itop + 1 ) / 2    ! middle ocean          
+            !                    
+            ptmb(ji,jj,1) = pfield(ji,jj,itop)*tmask(ji,jj,itop)  + zmdi*( 1._wp-tmask(ji,jj,itop) )
+            ptmb(ji,jj,2) = pfield(ji,jj,imid)*tmask(ji,jj,imid)  + zmdi*( 1._wp-tmask(ji,jj,imid) )
+            ptmb(ji,jj,3) = pfield(ji,jj,ibot)*tmask(ji,jj,ibot)  + zmdi*( 1._wp-tmask(ji,jj,ibot) )
          END DO
       END DO
-
-      ! Calculate bottom
-      DO jj = 1,jpj
-         DO ji = 1,jpi
-            jk              = max(1,mbathy(ji,jj) - 1)
-            pouttmb(ji,jj,3) = pinfield(ji,jj,jk)*tmask(ji,jj,jk)  + zmdi*(1.0-tmask(ji,jj,jk))
-         END DO
-      END DO
-
+      !
    END SUBROUTINE dia_calctmb
-
 
 
@@ -122 +100 @@
       !! ** Purpose :   Write diagnostics for Top, Mid and Bottom of water Column
       !!
-      !! ** Method  :   
-      !!      use mbathy to find surface, mid and bottom of model levels
+      !! ** Method  :  use mikt,mbkt to find surface, mid and bottom of model levels
       !!      calls calctmb to retrieve TMB values before sending to iom_put
       !!
-      !! History :
-      !!   3.6  !  08-14  (E. O'Dea) 
-      !!         
       !!--------------------------------------------------------------------
-      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwtmb    ! temporary workspace 
-      REAL(wp)                         ::   zmdi      ! set masked values
-
-      zmdi=1.e+20 !missing data indicator for maskin
-
+      REAL(wp) ::   zmdi =1.e+20     ! land value
+      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwtmb    ! workspace 
+      !!--------------------------------------------------------------------
+      !
       IF (ln_diatmb) THEN
-         CALL wrk_alloc( jpi , jpj, 3 , zwtmb )
+         CALL wrk_alloc( jpi,jpj,3   , zwtmb )
          CALL dia_calctmb(  tsn(:,:,:,jp_tem),zwtmb )
          !ssh already output but here we output it masked
-         CALL iom_put( "sshnmasked" , sshn(:,:)*tmask(:,:,1) + zmdi*(1.0 - tmask(:,:,1)) )   ! tmb Temperature
+         CALL iom_put( "sshnmasked" , sshn(:,:)*tmask(:,:,1) + zmdi*(1.0 - tmask(:,:,1)) )
          CALL iom_put( "top_temp" , zwtmb(:,:,1) )    ! tmb Temperature
          CALL iom_put( "mid_temp" , zwtmb(:,:,2) )    ! tmb Temperature
@@ -161 +134 @@
          CALL iom_put( "bot_v" , zwtmb(:,:,3) )    ! tmb  V Velocity
 !Called in  dynspg_ts.F90       CALL iom_put( "baro_v" , vn_b )    ! Barotropic  V Velocity
+         CALL wrk_dealloc( jpi,jpj,3   , zwtmb )
       ELSE
          CALL ctl_warn('dia_tmb: tmb diagnostic is set to false you should not have seen this')
       ENDIF
-
+      !
    END SUBROUTINE dia_tmb
    !!======================================================================