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/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/DIA – NEMO

source: branches/2017/dev_r7881_no_wrk_alloc/NEMOGCM/NEMO/OPA_SRC/DIA/diatmb.F90 @ 7910

Last change on this file since 7910 was 7910, checked in by timgraham, 7 years ago

All wrk_alloc removed
File size: 6.7 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
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/OPA 3.6 , NEMO Consortium (2014)
25   !! $Id:$
26   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
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      IF (ln_diatmb) THEN
110         CALL dia_calctmb(  tsn(:,:,:,jp_tem),zwtmb )
111         !ssh already output but here we output it masked
112         CALL iom_put( "sshnmasked" , sshn(:,:)*tmask(:,:,1) + zmdi*(1.0 - tmask(:,:,1)) )
113         CALL iom_put( "top_temp" , zwtmb(:,:,1) )    ! tmb Temperature
114         CALL iom_put( "mid_temp" , zwtmb(:,:,2) )    ! tmb Temperature
115         CALL iom_put( "bot_temp" , zwtmb(:,:,3) )    ! tmb Temperature
116!         CALL iom_put( "sotrefml" , hmld_tref(:,:) )    ! "T criterion Mixed Layer Depth
117
118         CALL dia_calctmb(  tsn(:,:,:,jp_sal),zwtmb )
119         CALL iom_put( "top_sal" , zwtmb(:,:,1) )    ! tmb Salinity
120         CALL iom_put( "mid_sal" , zwtmb(:,:,2) )    ! tmb Salinity
121         CALL iom_put( "bot_sal" , zwtmb(:,:,3) )    ! tmb Salinity
122
123         CALL dia_calctmb(  un(:,:,:),zwtmb )
124         CALL iom_put( "top_u" , zwtmb(:,:,1) )    ! tmb  U Velocity
125         CALL iom_put( "mid_u" , zwtmb(:,:,2) )    ! tmb  U Velocity
126         CALL iom_put( "bot_u" , zwtmb(:,:,3) )    ! tmb  U Velocity
127!Called in  dynspg_ts.F90        CALL iom_put( "baro_u" , un_b )    ! Barotropic  U Velocity
128
129         CALL dia_calctmb(  vn(:,:,:),zwtmb )
130         CALL iom_put( "top_v" , zwtmb(:,:,1) )    ! tmb  V Velocity
131         CALL iom_put( "mid_v" , zwtmb(:,:,2) )    ! tmb  V Velocity
132         CALL iom_put( "bot_v" , zwtmb(:,:,3) )    ! tmb  V Velocity
133!Called in  dynspg_ts.F90       CALL iom_put( "baro_v" , vn_b )    ! Barotropic  V Velocity
134      ELSE
135         CALL ctl_warn('dia_tmb: tmb diagnostic is set to false you should not have seen this')
136      ENDIF
137      !
138   END SUBROUTINE dia_tmb
139   !!======================================================================
140END MODULE diatmb
Note: See TracBrowser for help on using the repository browser.