New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
diatmb.F90 in NEMO/branches/UKMO/dev_10448_WAD_SBC_BUGFIX/src/OCE/DIA – NEMO

source: NEMO/branches/UKMO/dev_10448_WAD_SBC_BUGFIX/src/OCE/DIA/diatmb.F90 @ 10456

Last change on this file since 10456 was 10456, checked in by deazer, 5 years ago

Added option to taper sbc fluxes near very shallow water when using WAD
Corrected some IO bugs in dia25h, diatmb for WAD case.
User has control of the tapering. At what depth to start it, and at what fraction to start
the tanh tapering. At the WAD limit SBC is turned off completely.
Dry cells do not have any communication with the atmosphere
To DO: Documentation update.
Although not all sette tests are passed (AGRIF etc.)
it does no worse than the trunk at the revision the branch is made
  • Property svn:keywords set to Id
File size: 6.4 KB
Line 
1MODULE diatmb 
2   !!======================================================================
3   !!                       ***  MODULE  diaharm  ***
4   !! Harmonic analysis of tidal constituents
5   !!======================================================================
6   !! History :  3.6  !  08-2014  (E O'Dea)  Original code
7   !!            3.7  !  05-2016  (G. Madec)  use mbkt, mikt to account for ocean cavities
8   !!----------------------------------------------------------------------
9   USE oce             ! ocean dynamics and tracers variables
10   USE dom_oce         ! ocean space and time domain
11   !
12   USE in_out_manager  ! I/O units
13   USE iom             ! I/0 library
14   USE wet_dry
15
16   IMPLICIT NONE
17   PRIVATE
18
19   LOGICAL , PUBLIC ::   ln_diatmb     !: Top Middle and Bottom output
20   PUBLIC   dia_tmb_init            ! routine called by nemogcm.F90
21   PUBLIC   dia_tmb                 ! routine called by diawri.F90
22
23   !!----------------------------------------------------------------------
24   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
25   !! $Id$
26   !! Software governed by the CeCILL license (see ./LICENSE)
27   !!----------------------------------------------------------------------
28CONTAINS
29
30   SUBROUTINE dia_tmb_init 
31      !!---------------------------------------------------------------------------
32      !!                  ***  ROUTINE dia_tmb_init  ***
33      !!     
34      !! ** Purpose :   Initialization of tmb namelist
35      !!       
36      !! ** Method  :   Read namelist
37      !!---------------------------------------------------------------------------
38      INTEGER ::   ios                 ! Local integer output status for namelist read
39      !
40      NAMELIST/nam_diatmb/ ln_diatmb
41      !!----------------------------------------------------------------------
42      !
43      REWIND( numnam_ref )              ! Read Namelist nam_diatmb in reference namelist : TMB diagnostics
44      READ  ( numnam_ref, nam_diatmb, IOSTAT=ios, ERR= 901 )
45901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diatmb in reference namelist', lwp )
46 
47      REWIND( numnam_cfg )              ! Namelist nam_diatmb in configuration namelist  TMB diagnostics
48      READ  ( numnam_cfg, nam_diatmb, IOSTAT = ios, ERR = 902 )
49902   IF( ios >  0 ) CALL ctl_nam ( ios , 'nam_diatmb in configuration namelist', lwp )
50      IF(lwm) WRITE ( numond, nam_diatmb )
51
52      IF(lwp) THEN                   ! Control print
53         WRITE(numout,*)
54         WRITE(numout,*) 'dia_tmb_init : Output Top, Middle, Bottom Diagnostics'
55         WRITE(numout,*) '~~~~~~~~~~~~'
56         WRITE(numout,*) '   Namelist nam_diatmb : set tmb outputs '
57         WRITE(numout,*) '      Switch for TMB diagnostics (T) or not (F)  ln_diatmb  = ', ln_diatmb
58      ENDIF
59      !
60   END SUBROUTINE dia_tmb_init
61
62
63   SUBROUTINE dia_calctmb( pfield, ptmb )
64      !!---------------------------------------------------------------------
65      !!                  ***  ROUTINE dia_tmb  ***
66      !!                   
67      !! ** Purpose :    Find the Top, Mid and Bottom fields of water Column
68      !!
69      !! ** Method  :    use mbkt, mikt to find surface, mid and bottom of
70      !!              model levels due to potential existence of ocean cavities
71      !!
72      !!----------------------------------------------------------------------
73      REAL(wp), DIMENSION(jpi, jpj, jpk), INTENT(in   ) ::   pfield   ! Input 3D field and mask
74      REAL(wp), DIMENSION(jpi, jpj,  3 ), INTENT(  out) ::   ptmb     ! top, middle, bottom extracted from pfield
75      !
76      INTEGER ::   ji, jj   ! Dummy loop indices
77      INTEGER ::   itop, imid, ibot   ! local integers
78      REAL(wp)::   zmdi = 1.e+20_wp   ! land value
79      !!---------------------------------------------------------------------
80      !
81      DO jj = 1, jpj
82         DO ji = 1, jpi
83            itop = mikt(ji,jj)                        ! top    ocean
84            ibot = mbkt(ji,jj)                        ! bottom ocean
85            imid =  itop + ( ibot - itop + 1 ) / 2    ! middle ocean         
86            !                   
87            ptmb(ji,jj,1) = pfield(ji,jj,itop)*tmask(ji,jj,itop) + zmdi*( 1._wp-tmask(ji,jj,itop) )
88            ptmb(ji,jj,2) = pfield(ji,jj,imid)*tmask(ji,jj,imid) + zmdi*( 1._wp-tmask(ji,jj,imid) )
89            ptmb(ji,jj,3) = pfield(ji,jj,ibot)*tmask(ji,jj,ibot) + zmdi*( 1._wp-tmask(ji,jj,ibot) )
90         END DO
91      END DO
92      !
93   END SUBROUTINE dia_calctmb
94
95
96   SUBROUTINE dia_tmb
97      !!----------------------------------------------------------------------
98      !!                 ***  ROUTINE dia_tmb  ***
99      !! ** Purpose :   Write diagnostics for Top, Mid and Bottom of water Column
100      !!
101      !! ** Method  :  use mikt,mbkt to find surface, mid and bottom of model levels
102      !!      calls calctmb to retrieve TMB values before sending to iom_put
103      !!
104      !!--------------------------------------------------------------------
105      REAL(wp) ::   zmdi =1.e+20     ! land value
106      REAL(wp), DIMENSION(jpi,jpj,3) :: zwtmb    ! workspace
107      !!--------------------------------------------------------------------
108      !
109      CALL dia_calctmb( tsn(:,:,:,jp_tem), zwtmb )
110      !ssh already output but here we output it masked
111      IF( ll_wd ) THEN
112         CALL iom_put( "sshnmasked", (sshn(:,:)+ssh_ref)*tmask(:,:,1) + zmdi*(1.0 - tmask(:,:,1)) )
113      ELSE
114         CALL iom_put( "sshnmasked", sshn(:,:)*tmask(:,:,1) + zmdi*(1.0 - tmask(:,:,1)) )
115      ENDIF
116
117      CALL iom_put( "top_temp"  , zwtmb(:,:,1) )    ! tmb Temperature
118      CALL iom_put( "mid_temp"  , zwtmb(:,:,2) )    ! tmb Temperature
119      CALL iom_put( "bot_temp"  , zwtmb(:,:,3) )    ! tmb Temperature
120      !
121      CALL dia_calctmb( tsn(:,:,:,jp_sal), zwtmb )
122      CALL iom_put( "top_sal"   , zwtmb(:,:,1) )    ! tmb Salinity
123      CALL iom_put( "mid_sal"   , zwtmb(:,:,2) )    ! tmb Salinity
124      CALL iom_put( "bot_sal"   , zwtmb(:,:,3) )    ! tmb Salinity
125      !
126      CALL dia_calctmb( un(:,:,:), zwtmb )
127      CALL iom_put( "top_u"     , zwtmb(:,:,1) )    ! tmb  U Velocity
128      CALL iom_put( "mid_u"     , zwtmb(:,:,2) )    ! tmb  U Velocity
129      CALL iom_put( "bot_u"     , zwtmb(:,:,3) )    ! tmb  U Velocity
130      !
131      CALL dia_calctmb( vn(:,:,:), zwtmb )
132      CALL iom_put( "top_v"     , zwtmb(:,:,1) )    ! tmb  V Velocity
133      CALL iom_put( "mid_v"     , zwtmb(:,:,2) )    ! tmb  V Velocity
134      CALL iom_put( "bot_v"     , zwtmb(:,:,3) )    ! tmb  V Velocity
135      !
136   END SUBROUTINE dia_tmb
137
138   !!======================================================================
139END MODULE diatmb
Note: See TracBrowser for help on using the repository browser.