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 branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/DIA – NEMO

source: branches/2016/dev_r6409_SIMPLIF_2_usrdef/NEMOGCM/NEMO/OPA_SRC/DIA/diatmb.F90 @ 6667

Last change on this file since 6667 was 6667, checked in by gm, 9 years ago

#1692 - branch SIMPLIF_2_usrdef: reduced domain_cfg.nc file: GYRE OK using usrdef or reading file
File size: 6.8 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 wrk_nemo        ! working arrays
15
16
17   IMPLICIT NONE
18   PRIVATE
19
20   LOGICAL , PUBLIC ::   ln_diatmb     !: Top Middle and Bottom output
21   PUBLIC   dia_tmb_init            ! routine called by nemogcm.F90
22   PUBLIC   dia_tmb                 ! routine called by diawri.F90
23
24   !!----------------------------------------------------------------------
25   !! NEMO/OPA 3.6 , NEMO Consortium (2014)
26   !! $Id:$
27   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
28   !!----------------------------------------------------------------------
29CONTAINS
30
31   SUBROUTINE dia_tmb_init 
32      !!---------------------------------------------------------------------------
33      !!                  ***  ROUTINE dia_tmb_init  ***
34      !!     
35      !! ** Purpose :   Initialization of tmb namelist
36      !!       
37      !! ** Method  :   Read namelist
38      !!---------------------------------------------------------------------------
39      INTEGER ::   ios                 ! Local integer output status for namelist read
40      !
41      NAMELIST/nam_diatmb/ ln_diatmb
42      !!----------------------------------------------------------------------
43      !
44      REWIND ( numnam_ref )              ! Read Namelist nam_diatmb in reference namelist : TMB diagnostics
45      READ   ( numnam_ref, nam_diatmb, IOSTAT=ios, ERR= 901 )
46901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diatmb in reference namelist', lwp )
47 
48      REWIND( numnam_cfg )              ! Namelist nam_diatmb in configuration namelist  TMB diagnostics
49      READ  ( numnam_cfg, nam_diatmb, IOSTAT = ios, ERR = 902 )
50902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diatmb in configuration namelist', lwp )
51      IF(lwm) WRITE ( numond, nam_diatmb )
52
53      IF(lwp) THEN                   ! Control print
54         WRITE(numout,*)
55         WRITE(numout,*) 'dia_tmb_init : Output Top, Middle, Bottom Diagnostics'
56         WRITE(numout,*) '~~~~~~~~~~~~'
57         WRITE(numout,*) 'Namelist nam_diatmb : set tmb outputs '
58         WRITE(numout,*) 'Switch for TMB diagnostics (T) or not (F)  ln_diatmb  = ', ln_diatmb
59      ENDIF
60      !
61   END SUBROUTINE dia_tmb_init
62
63
64   SUBROUTINE dia_calctmb( pfield, ptmb )
65      !!---------------------------------------------------------------------
66      !!                  ***  ROUTINE dia_tmb  ***
67      !!                   
68      !! ** Purpose :    Find the Top, Mid and Bottom fields of water Column
69      !!
70      !! ** Method  :    use mbkt, mikt to find surface, mid and bottom of
71      !!              model levels due to potential existence of ocean cavities
72      !!
73      !!----------------------------------------------------------------------
74      REAL(wp), DIMENSION(jpi, jpj, jpk), INTENT(in   ) :: pfield   ! Input 3d field and mask
75      REAL(wp), DIMENSION(jpi, jpj,  3 ), INTENT(  out) :: ptmb     ! top, middle, bottom extracted from pfield
76      !
77      INTEGER  ::   ji, jj  ! Dummy loop indices
78      INTEGER  ::   itop, imid, ibot  ! local integers
79      REAL(wp) ::   zmdi = 1.e+20_wp  ! land value
80      !!---------------------------------------------------------------------
81      !
82      DO jj = 1, jpj
83         DO ji = 1, jpi
84            itop = mikt(ji,jj)                        ! top    ocean
85            ibot = mbkt(ji,jj)                        ! bottom ocean
86            imid =  itop + ( ibot - itop + 1 ) / 2    ! middle ocean         
87            !                   
88            ptmb(ji,jj,1) = pfield(ji,jj,itop)*tmask(ji,jj,itop)  + zmdi*( 1._wp-tmask(ji,jj,itop) )
89            ptmb(ji,jj,2) = pfield(ji,jj,imid)*tmask(ji,jj,imid)  + zmdi*( 1._wp-tmask(ji,jj,imid) )
90            ptmb(ji,jj,3) = pfield(ji,jj,ibot)*tmask(ji,jj,ibot)  + zmdi*( 1._wp-tmask(ji,jj,ibot) )
91         END DO
92      END DO
93      !
94   END SUBROUTINE dia_calctmb
95
96
97   SUBROUTINE dia_tmb
98      !!----------------------------------------------------------------------
99      !!                 ***  ROUTINE dia_tmb  ***
100      !! ** Purpose :   Write diagnostics for Top, Mid and Bottom of water Column
101      !!
102      !! ** Method  :  use mikt,mbkt to find surface, mid and bottom of model levels
103      !!      calls calctmb to retrieve TMB values before sending to iom_put
104      !!
105      !!--------------------------------------------------------------------
106      REAL(wp) ::   zmdi =1.e+20     ! land value
107      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwtmb    ! workspace
108      !!--------------------------------------------------------------------
109      !
110      IF (ln_diatmb) THEN
111         CALL wrk_alloc( jpi,jpj,3   , zwtmb )
112         CALL dia_calctmb(  tsn(:,:,:,jp_tem),zwtmb )
113         !ssh already output but here we output it masked
114         CALL iom_put( "sshnmasked" , sshn(:,:)*tmask(:,:,1) + zmdi*(1.0 - tmask(:,:,1)) )
115         CALL iom_put( "top_temp" , zwtmb(:,:,1) )    ! tmb Temperature
116         CALL iom_put( "mid_temp" , zwtmb(:,:,2) )    ! tmb Temperature
117         CALL iom_put( "bot_temp" , zwtmb(:,:,3) )    ! tmb Temperature
118!         CALL iom_put( "sotrefml" , hmld_tref(:,:) )    ! "T criterion Mixed Layer Depth
119
120         CALL dia_calctmb(  tsn(:,:,:,jp_sal),zwtmb )
121         CALL iom_put( "top_sal" , zwtmb(:,:,1) )    ! tmb Salinity
122         CALL iom_put( "mid_sal" , zwtmb(:,:,2) )    ! tmb Salinity
123         CALL iom_put( "bot_sal" , zwtmb(:,:,3) )    ! tmb Salinity
124
125         CALL dia_calctmb(  un(:,:,:),zwtmb )
126         CALL iom_put( "top_u" , zwtmb(:,:,1) )    ! tmb  U Velocity
127         CALL iom_put( "mid_u" , zwtmb(:,:,2) )    ! tmb  U Velocity
128         CALL iom_put( "bot_u" , zwtmb(:,:,3) )    ! tmb  U Velocity
129!Called in  dynspg_ts.F90        CALL iom_put( "baro_u" , un_b )    ! Barotropic  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!Called in  dynspg_ts.F90       CALL iom_put( "baro_v" , vn_b )    ! Barotropic  V Velocity
136         CALL wrk_dealloc( jpi,jpj,3   , zwtmb )
137      ELSE
138         CALL ctl_warn('dia_tmb: tmb diagnostic is set to false you should not have seen this')
139      ENDIF
140      !
141   END SUBROUTINE dia_tmb
142   !!======================================================================
143END MODULE diatmb
Note: See TracBrowser for help on using the repository browser.