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/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/DIA – NEMO

source: NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/OCE/DIA/diatmb.F90 @ 12202

Last change on this file since 12202 was 12202, checked in by cetlod, 4 years ago

dev_merge_option2 : merge in dev_r11613_ENHANCE-04_namelists_as_internalfiles
  • Property svn:keywords set to Id
File size: 6.2 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      READ  ( numnam_ref, nam_diatmb, IOSTAT=ios, ERR= 901 )
44901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diatmb in reference namelist' )
45 
46      READ  ( numnam_cfg, nam_diatmb, IOSTAT = ios, ERR = 902 )
47902   IF( ios >  0 ) CALL ctl_nam ( ios , 'nam_diatmb in configuration namelist' )
48      IF(lwm) WRITE ( numond, nam_diatmb )
49
50      IF(lwp) THEN                   ! Control print
51         WRITE(numout,*)
52         WRITE(numout,*) 'dia_tmb_init : Output Top, Middle, Bottom Diagnostics'
53         WRITE(numout,*) '~~~~~~~~~~~~'
54         WRITE(numout,*) '   Namelist nam_diatmb : set tmb outputs '
55         WRITE(numout,*) '      Switch for TMB diagnostics (T) or not (F)  ln_diatmb  = ', ln_diatmb
56      ENDIF
57      !
58   END SUBROUTINE dia_tmb_init
59
60
61   SUBROUTINE dia_calctmb( pfield, ptmb )
62      !!---------------------------------------------------------------------
63      !!                  ***  ROUTINE dia_tmb  ***
64      !!                   
65      !! ** Purpose :    Find the Top, Mid and Bottom fields of water Column
66      !!
67      !! ** Method  :    use mbkt, mikt to find surface, mid and bottom of
68      !!              model levels due to potential existence of ocean cavities
69      !!
70      !!----------------------------------------------------------------------
71      REAL(wp), DIMENSION(jpi, jpj, jpk), INTENT(in   ) ::   pfield   ! Input 3D field and mask
72      REAL(wp), DIMENSION(jpi, jpj,  3 ), INTENT(  out) ::   ptmb     ! top, middle, bottom extracted from pfield
73      !
74      INTEGER ::   ji, jj   ! Dummy loop indices
75      INTEGER ::   itop, imid, ibot   ! local integers
76      REAL(wp)::   zmdi = 1.e+20_wp   ! land value
77      !!---------------------------------------------------------------------
78      !
79      DO jj = 1, jpj
80         DO ji = 1, jpi
81            itop = mikt(ji,jj)                        ! top    ocean
82            ibot = mbkt(ji,jj)                        ! bottom ocean
83            imid =  itop + ( ibot - itop + 1 ) / 2    ! middle ocean         
84            !                   
85            ptmb(ji,jj,1) = pfield(ji,jj,itop)*tmask(ji,jj,itop) + zmdi*( 1._wp-tmask(ji,jj,itop) )
86            ptmb(ji,jj,2) = pfield(ji,jj,imid)*tmask(ji,jj,imid) + zmdi*( 1._wp-tmask(ji,jj,imid) )
87            ptmb(ji,jj,3) = pfield(ji,jj,ibot)*tmask(ji,jj,ibot) + zmdi*( 1._wp-tmask(ji,jj,ibot) )
88         END DO
89      END DO
90      !
91   END SUBROUTINE dia_calctmb
92
93
94   SUBROUTINE dia_tmb
95      !!----------------------------------------------------------------------
96      !!                 ***  ROUTINE dia_tmb  ***
97      !! ** Purpose :   Write diagnostics for Top, Mid and Bottom of water Column
98      !!
99      !! ** Method  :  use mikt,mbkt to find surface, mid and bottom of model levels
100      !!      calls calctmb to retrieve TMB values before sending to iom_put
101      !!
102      !!--------------------------------------------------------------------
103      REAL(wp) ::   zmdi =1.e+20     ! land value
104      REAL(wp), DIMENSION(jpi,jpj,3) :: zwtmb    ! workspace
105      !!--------------------------------------------------------------------
106      !
107      CALL dia_calctmb( tsn(:,:,:,jp_tem), zwtmb )
108      !ssh already output but here we output it masked
109      IF( ll_wd ) THEN
110         CALL iom_put( "sshnmasked", (sshn(:,:)+ssh_ref)*tmask(:,:,1) + zmdi*(1.0 - tmask(:,:,1)) )
111      ELSE
112         CALL iom_put( "sshnmasked", sshn(:,:)*tmask(:,:,1) + zmdi*(1.0 - tmask(:,:,1)) )
113      ENDIF
114
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      !
119      CALL dia_calctmb( tsn(:,:,:,jp_sal), zwtmb )
120      CALL iom_put( "top_sal"   , zwtmb(:,:,1) )    ! tmb Salinity
121      CALL iom_put( "mid_sal"   , zwtmb(:,:,2) )    ! tmb Salinity
122      CALL iom_put( "bot_sal"   , zwtmb(:,:,3) )    ! tmb Salinity
123      !
124      CALL dia_calctmb( un(:,:,:), zwtmb )
125      CALL iom_put( "top_u"     , zwtmb(:,:,1) )    ! tmb  U Velocity
126      CALL iom_put( "mid_u"     , zwtmb(:,:,2) )    ! tmb  U Velocity
127      CALL iom_put( "bot_u"     , zwtmb(:,:,3) )    ! tmb  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      !
134   END SUBROUTINE dia_tmb
135
136   !!======================================================================
137END MODULE diatmb
Note: See TracBrowser for help on using the repository browser.