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/UKMO/2015_CO6_CO5_shelfdiagnostic/NEMOGCM/NEMO/OPA_SRC/DIA – NEMO

source: branches/UKMO/2015_CO6_CO5_shelfdiagnostic/NEMOGCM/NEMO/OPA_SRC/DIA/diatmb.F90 @ 5427

Last change on this file since 5427 was 5427, checked in by deazer, 9 years ago

Added back in basic shelf seas diagnostics after removal of svn keywords.
Builds, extracts and mereges and runs as expected from working copy

File size: 7.0 KB
Line 
1MODULE diatmb 
2   !!======================================================================
3   !!                       ***  MODULE  diaharm  ***
4   !! Harmonic analysis of tidal constituents
5   !!======================================================================
6   !! History :  3.6  !  2014  (E O'Dea)  Original code
7   !!----------------------------------------------------------------------
8   USE oce             ! ocean dynamics and tracers variables
9   USE dom_oce         ! ocean space and time domain
10   USE in_out_manager  ! I/O units
11   USE iom             ! I/0 library
12   USE wrk_nemo        ! working arrays
13
14
15   IMPLICIT NONE
16   PRIVATE
17
18   LOGICAL , PUBLIC ::   ln_diatmb     !: Top Middle and Bottom output
19   PUBLIC   dia_tmb_init            ! routine called by nemogcm.F90
20   PUBLIC   dia_tmb                 ! routine called by diawri.F90
21
22   !!----------------------------------------------------------------------
23   !! NEMO/OPA 3.6 , NEMO Consortium (2014)
24   !! $Id$
25   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
26   !!----------------------------------------------------------------------
27CONTAINS
28
29   SUBROUTINE dia_tmb_init 
30      !!---------------------------------------------------------------------------
31      !!                  ***  ROUTINE dia_tmb_init  ***
32      !!     
33      !! ** Purpose: Initialization of tmb namelist
34      !!       
35      !! ** Method : Read namelist
36      !!   History
37      !!   3.6  !  08-14  (E. O'Dea) Routine to initialize dia_tmb
38      !!---------------------------------------------------------------------------
39      !!
40      INTEGER ::   ios                 ! Local integer output status for namelist read
41      !
42      NAMELIST/nam_diatmb/ ln_diatmb
43      !!----------------------------------------------------------------------
44      !
45      REWIND ( numnam_ref )              ! Read Namelist nam_diatmb in reference namelist : TMB diagnostics
46      READ   ( numnam_ref, nam_diatmb, IOSTAT=ios, ERR= 901 )
47901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diatmb in reference namelist', lwp )
48 
49      REWIND( numnam_cfg )              ! Namelist nam_diatmb in configuration namelist  TMB diagnostics
50      READ  ( numnam_cfg, nam_diatmb, IOSTAT = ios, ERR = 902 )
51902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diatmb in configuration namelist', lwp )
52      IF(lwm) WRITE ( numond, nam_diatmb )
53
54      IF(lwp) THEN                   ! Control print
55         WRITE(numout,*)
56         WRITE(numout,*) 'dia_tmb_init : Output Top, Middle, Bottom Diagnostics'
57         WRITE(numout,*) '~~~~~~~~~~~~'
58         WRITE(numout,*) 'Namelist nam_diatmb : set tmb outputs '
59         WRITE(numout,*) 'Switch for TMB diagnostics (T) or not (F)  ln_diatmb  = ', ln_diatmb
60      ENDIF
61
62   END SUBROUTINE dia_tmb_init
63
64   SUBROUTINE dia_calctmb( infield,outtmb )
65      !!---------------------------------------------------------------------
66      !!                  ***  ROUTINE dia_tmb  ***
67      !!                   
68      !! ** Purpose :    Find the Top, Mid and Bottom fields of water Column
69      !!
70      !! ** Method  :   
71      !!      use mbathy to find surface, mid and bottom of model levels
72      !!
73      !! History :
74      !!   3.6  !  08-14  (E. O'Dea) Routine based on dia_wri_foam
75      !!----------------------------------------------------------------------
76      !! * Modules used
77
78      ! Routine to map 3d field to top, middle, bottom
79      IMPLICIT NONE
80
81
82      ! Routine arguments
83      REAL(wp), DIMENSION(jpi, jpj, jpk), INTENT(IN   ) :: infield    ! Input 3d field and mask
84      REAL(wp), DIMENSION(jpi, jpj, 3  ), INTENT(  OUT) :: outtmb     ! Output top, middle, bottom
85
86
87
88      ! Local variables
89      INTEGER :: ji,jj,jk  ! Dummy loop indices
90
91      ! Local Real
92      REAL(wp)                         ::   zmdi  !  set masked values
93
94      zmdi=1.e+20 !missing data indicator for masking
95
96      ! Calculate top
97      outtmb(:,:,1) = infield(:,:,1)*tmask(:,:,1)  + zmdi*(1.0-tmask(:,:,1))
98
99      ! Calculate middle
100      DO ji = 1,jpi
101         DO jj = 1,jpj
102            jk              = max(1,mbathy(ji,jj)/2)
103            outtmb(ji,jj,2) = infield(ji,jj,jk)*tmask(ji,jj,jk)  + zmdi*(1.0-tmask(ji,jj,jk))
104         END DO
105      END DO
106
107      ! Calculate bottom
108      DO ji = 1,jpi
109         DO jj = 1,jpj
110            jk              = max(1,mbathy(ji,jj) - 1)
111            outtmb(ji,jj,3) = infield(ji,jj,jk)*tmask(ji,jj,jk)  + zmdi*(1.0-tmask(ji,jj,jk))
112         END DO
113      END DO
114
115   END SUBROUTINE dia_calctmb
116
117
118
119   SUBROUTINE dia_tmb
120      !!----------------------------------------------------------------------
121      !!                 ***  ROUTINE dia_tmb  ***
122      !! ** Purpose :   Write diagnostics for Top, Mid and Bottom of water Column
123      !!
124      !! ** Method  :   
125      !!      use mbathy to find surface, mid and bottom of model levels
126      !!      calls calctmb to retrieve TMB values before sending to iom_put
127      !!
128      !! History :
129      !!   3.6  !  08-14  (E. O'Dea)
130      !!         
131      !!--------------------------------------------------------------------
132      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwtmb    ! temporary workspace
133      REAL(wp)                         ::   zmdi      ! set masked values
134
135      zmdi=1.e+20 !missing data indicator for maskin
136
137      IF (ln_diatmb) THEN
138         CALL wrk_alloc( jpi , jpj, 3 , zwtmb )
139         CALL dia_calctmb(  tsn(:,:,:,jp_tem),zwtmb )
140         !ssh already output but here we output it masked
141         CALL iom_put( "sshnmasked" , sshn(:,:)*tmask(:,:,1) + zmdi*(1.0 - tmask(:,:,1)) )   ! tmb Temperature
142         CALL iom_put( "top_temp" , zwtmb(:,:,1) )    ! tmb Temperature
143         CALL iom_put( "mid_temp" , zwtmb(:,:,2) )    ! tmb Temperature
144         CALL iom_put( "bot_temp" , zwtmb(:,:,3) )    ! tmb Temperature
145!         CALL iom_put( "sotrefml" , hmld_tref(:,:) )    ! "T criterion Mixed Layer Depth
146
147         CALL dia_calctmb(  tsn(:,:,:,jp_sal),zwtmb )
148         CALL iom_put( "top_sal" , zwtmb(:,:,1) )    ! tmb Salinity
149         CALL iom_put( "mid_sal" , zwtmb(:,:,2) )    ! tmb Salinity
150         CALL iom_put( "bot_sal" , zwtmb(:,:,3) )    ! tmb Salinity
151
152         CALL dia_calctmb(  un(:,:,:),zwtmb )
153         CALL iom_put( "top_u" , zwtmb(:,:,1) )    ! tmb  U Velocity
154         CALL iom_put( "mid_u" , zwtmb(:,:,2) )    ! tmb  U Velocity
155         CALL iom_put( "bot_u" , zwtmb(:,:,3) )    ! tmb  U Velocity
156!Called in  dynspg_ts.F90        CALL iom_put( "baro_u" , un_b )    ! Barotropic  U Velocity
157
158         CALL dia_calctmb(  vn(:,:,:),zwtmb )
159         CALL iom_put( "top_v" , zwtmb(:,:,1) )    ! tmb  V Velocity
160         CALL iom_put( "mid_v" , zwtmb(:,:,2) )    ! tmb  V Velocity
161         CALL iom_put( "bot_v" , zwtmb(:,:,3) )    ! tmb  V Velocity
162!Called in  dynspg_ts.F90       CALL iom_put( "baro_v" , vn_b )    ! Barotropic  V Velocity
163      ELSE
164         CALL ctl_warn('dia_tmb: tmb diagnostic is set to false you should not have seen this')
165      ENDIF
166
167   END SUBROUTINE dia_tmb
168   !!======================================================================
169END MODULE diatmb
Note: See TracBrowser for help on using the repository browser.