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_r11613_ENHANCE-04_namelists_as_internalfiles/src/OCE/DIA – NEMO

source: NEMO/branches/2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles/src/OCE/DIA/diatmb.F90 @ 11671

Last change on this file since 11671 was 11671, checked in by acc, 5 years ago

Branch 2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles. Final, non-substantive changes to complete this branch. These changes remove all REWIND statements on the old namelist fortran units (now character variables for internal files). These changes have been left until last since they are easily repeated via a script and it may be preferable to use the previous revision for merge purposes and reapply these last changes separately. This branch has been fully SETTE tested.
  • 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.