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

source: branches/UKMO/CO6_shelfclimate_fabm/NEMOGCM/NEMO/OPA_SRC/DIA/diatmb.F90 @ 13240

Last change on this file since 13240 was 8672, checked in by hadjt, 7 years ago

Updated diaregmean.F90:

  • outputs BGC variables
  • outputs depth integrated t and s
  • volume integrated t and s
  • volume intergrated heat, salt, volume and mass
  • out puts regional min and max for a region, but only in text file

Updated diatmb.F90

  • uses the dia_calctmb_region_mean function from diaregmean.F90
  • this no longer outputs mid, but does output depth- and volume-integrated t and s.

The version of NEMO appears to work ok with and without FABM, so will be the standard shelf climate version.

03/11/2017 Jonathan Tinker
File size: 10.2 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   USE diaregmean
14
15#if defined key_fabm
16   USE trc
17   USE par_fabm
18#endif
19
20
21   IMPLICIT NONE
22   PRIVATE
23
24   LOGICAL , PUBLIC ::   ln_diatmb     !: Top Middle and Bottom output
25   PUBLIC   dia_tmb_init            ! routine called by nemogcm.F90
26   PUBLIC   dia_tmb                 ! routine called by diawri.F90
27
28   !!----------------------------------------------------------------------
29   !! NEMO/OPA 3.6 , NEMO Consortium (2014)
30   !! $Id$
31   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
32   !!----------------------------------------------------------------------
33CONTAINS
34
35   SUBROUTINE dia_tmb_init 
36      !!---------------------------------------------------------------------------
37      !!                  ***  ROUTINE dia_tmb_init  ***
38      !!     
39      !! ** Purpose: Initialization of tmb namelist
40      !!       
41      !! ** Method : Read namelist
42      !!   History
43      !!   3.6  !  08-14  (E. O'Dea) Routine to initialize dia_tmb
44      !!---------------------------------------------------------------------------
45      !!
46      INTEGER ::   ios                 ! Local integer output status for namelist read
47      !
48      NAMELIST/nam_diatmb/ ln_diatmb
49      !!----------------------------------------------------------------------
50      !
51      REWIND ( numnam_ref )              ! Read Namelist nam_diatmb in reference namelist : TMB diagnostics
52      READ   ( numnam_ref, nam_diatmb, IOSTAT=ios, ERR= 901 )
53901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diatmb in reference namelist', lwp )
54 
55      REWIND( numnam_cfg )              ! Namelist nam_diatmb in configuration namelist  TMB diagnostics
56      READ  ( numnam_cfg, nam_diatmb, IOSTAT = ios, ERR = 902 )
57902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diatmb in configuration namelist', lwp )
58      IF(lwm) WRITE ( numond, nam_diatmb )
59
60      IF(lwp) THEN                   ! Control print
61         WRITE(numout,*)
62         WRITE(numout,*) 'dia_tmb_init : Output Top, Middle, Bottom Diagnostics'
63         WRITE(numout,*) '~~~~~~~~~~~~'
64         WRITE(numout,*) 'Namelist nam_diatmb : set tmb outputs '
65         WRITE(numout,*) 'Switch for TMB diagnostics (T) or not (F)  ln_diatmb  = ', ln_diatmb
66      ENDIF
67
68   END SUBROUTINE dia_tmb_init
69
70   SUBROUTINE dia_calctmb( pinfield,pouttmb )
71      !!---------------------------------------------------------------------
72      !!                  ***  ROUTINE dia_tmb  ***
73      !!                   
74      !! ** Purpose :    Find the Top, Mid and Bottom fields of water Column
75      !!
76      !! ** Method  :   
77      !!      use mbathy to find surface, mid and bottom of model levels
78      !!
79      !! History :
80      !!   3.6  !  08-14  (E. O'Dea) Routine based on dia_wri_foam
81      !!----------------------------------------------------------------------
82      !! * Modules used
83
84      ! Routine to map 3d field to top, middle, bottom
85      IMPLICIT NONE
86
87
88      ! Routine arguments
89      REAL(wp), DIMENSION(jpi, jpj, jpk), INTENT(IN   ) :: pinfield    ! Input 3d field and mask
90      REAL(wp), DIMENSION(jpi, jpj, 3  ), INTENT(  OUT) :: pouttmb     ! Output top, middle, bottom
91
92
93
94      ! Local variables
95      INTEGER :: ji,jj,jk  ! Dummy loop indices
96
97      ! Local Real
98      REAL(wp)                         ::   zmdi  !  set masked values
99
100      zmdi=1.e+20 !missing data indicator for masking
101
102      ! Calculate top
103      pouttmb(:,:,1) = pinfield(:,:,1)*tmask(:,:,1)  + zmdi*(1.0-tmask(:,:,1))
104
105      ! Calculate middle
106      DO jj = 1,jpj
107         DO ji = 1,jpi
108            jk              = max(1,mbathy(ji,jj)/2)
109            pouttmb(ji,jj,2) = pinfield(ji,jj,jk)*tmask(ji,jj,jk)  + zmdi*(1.0-tmask(ji,jj,jk))
110         END DO
111      END DO
112
113      ! Calculate bottom
114      DO jj = 1,jpj
115         DO ji = 1,jpi
116            jk              = max(1,mbathy(ji,jj) )
117            pouttmb(ji,jj,3) = pinfield(ji,jj,jk)*tmask(ji,jj,jk)  + zmdi*(1.0-tmask(ji,jj,jk))
118         END DO
119      END DO
120
121   END SUBROUTINE dia_calctmb
122
123
124
125   SUBROUTINE dia_tmb
126      !!----------------------------------------------------------------------
127      !!                 ***  ROUTINE dia_tmb  ***
128      !! ** Purpose :   Write diagnostics for Top, Mid and Bottom of water Column
129      !!
130      !! ** Method  :   
131      !!      use mbathy to find surface, mid and bottom of model levels
132      !!      calls calctmb to retrieve TMB values before sending to iom_put
133      !!
134      !! History :
135      !!   3.6  !  08-14  (E. O'Dea)
136      !!         
137      !!--------------------------------------------------------------------
138      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwtmb    ! temporary workspace
139      REAL(wp)                            ::   zmdi      ! set masked values
140      INTEGER                             ::   jn      ! set masked values
141#if defined key_fabm
142      INTEGER                             ::     tmp_dummy
143#endif
144      zmdi=1.e+20 !missing data indicator for maskin
145
146      IF (ln_diatmb) THEN
147         CALL wrk_alloc( jpi , jpj, 3 , zwtmb )
148         CALL dia_calctmb(  tsn(:,:,:,jp_tem),zwtmb )
149         !ssh already output but here we output it masked
150         CALL iom_put( "sshnmasked" , sshn(:,:)*tmask(:,:,1) + zmdi*(1.0 - tmask(:,:,1)) )   ! tmb Temperature
151         CALL iom_put( "top_temp" , zwtmb(:,:,1) )    ! tmb Temperature
152         CALL iom_put( "mid_temp" , zwtmb(:,:,2) )    ! tmb Temperature
153         CALL iom_put( "bot_temp" , zwtmb(:,:,3) )    ! tmb Temperature
154         CALL iom_put( "dif_temp" , (zwtmb(:,:,1) - zwtmb(:,:,3))*tmask(:,:,1)+zmdi*(1.0-tmask(:,:,1 ) ) )   ! tmb Temperature
155         
156!         CALL iom_put( "sotrefml" , hmld_tref(:,:) )    ! "T criterion Mixed Layer Depth
157
158         CALL dia_calctmb(  tsn(:,:,:,jp_sal),zwtmb )
159         CALL iom_put( "top_sal" , zwtmb(:,:,1) )    ! tmb Salinity
160         CALL iom_put( "mid_sal" , zwtmb(:,:,2) )    ! tmb Salinity
161         CALL iom_put( "bot_sal" , zwtmb(:,:,3) )    ! tmb Salinity
162         CALL iom_put( "dif_sal" , (zwtmb(:,:,1) - zwtmb(:,:,3))*tmask(:,:,1)+zmdi*(1.0-tmask(:,:,1 ) ) )   ! tmb Salinity
163         
164         CALL dia_calctmb(  un(:,:,:),zwtmb )
165         CALL iom_put( "top_u" , zwtmb(:,:,1) )    ! tmb  U Velocity
166         CALL iom_put( "mid_u" , zwtmb(:,:,2) )    ! tmb  U Velocity
167         CALL iom_put( "bot_u" , zwtmb(:,:,3) )    ! tmb  U Velocity
168         CALL iom_put( "dif_u" , (zwtmb(:,:,1) - zwtmb(:,:,3))*tmask(:,:,1)+zmdi*(1.0-tmask(:,:,1 ) ) )   ! tmb  U Velocity
169         
170!Called in  dynspg_ts.F90        CALL iom_put( "baro_u" , un_b )    ! Barotropic  U Velocity
171
172         CALL dia_calctmb(  vn(:,:,:),zwtmb )
173         CALL iom_put( "top_v" , zwtmb(:,:,1) )    ! tmb  V Velocity
174         CALL iom_put( "mid_v" , zwtmb(:,:,2) )    ! tmb  V Velocity
175         CALL iom_put( "bot_v" , zwtmb(:,:,3) )    ! tmb  V Velocity
176         CALL iom_put( "dif_v" , (zwtmb(:,:,1) - zwtmb(:,:,3))*tmask(:,:,1)+zmdi*(1.0-tmask(:,:,1 ) ) )   ! tmb  V Velocity
177
178         CALL wrk_alloc( jpi , jpj, 3 , zwtmb )
179
180#if defined key_fabm
181         CALL wrk_alloc( jpi , jpj, 6 , zwtmb )
182         DO jn=1,jp_fabm ! State loop
183
184                    ! By default, only use a small sub sample of values.
185                    tmp_dummy = 0
186                    SELECT CASE (trim(ctrcnm(jn)))
187                       CASE ('N1_p') ;      tmp_dummy = 0
188                       CASE ('N3_n') ;      tmp_dummy = 0
189                       CASE ('N4_n') ;      tmp_dummy = 0
190                       CASE ('N5_s') ;      tmp_dummy = 0
191
192                       CASE ('O2_o') ;      tmp_dummy = 0
193                       !CASE ('O3_c') ;      tmp_dummy = 0
194                       !CASE ('O3_bioalk') ; tmp_dummy = 0
195
196                       CASE ('P1_Chl') ;    tmp_dummy = 0
197                       CASE ('P2_Chl') ;    tmp_dummy = 0
198                       CASE ('P3_Chl') ;    tmp_dummy = 0
199                       CASE ('P4_Chl') ;    tmp_dummy = 0
200
201                       CASE ('P1_c') ;      tmp_dummy = 0
202                       CASE ('P2_c') ;      tmp_dummy = 0
203                       CASE ('P3_c') ;      tmp_dummy = 0
204                       CASE ('P4_c') ;      tmp_dummy = 0
205
206                       CASE ('Z4_c') ;      tmp_dummy = 0
207                       CASE ('Z5_c') ;      tmp_dummy = 0
208                       CASE ('Z6_c') ;      tmp_dummy = 0
209                       CASE DEFAULT
210                            tmp_dummy = 1
211                            CYCLE
212                    END SELECT
213
214            CALL dia_calctmb_region_mean( trn(:,:,:,jn),zwtmb )
215            CALL iom_put( "top_"//TRIM(ctrcnm(jn)), zwtmb(:,:,1) )    ! tmb Temperature
216            CALL iom_put( "bot_"//TRIM(ctrcnm(jn)), zwtmb(:,:,2) )    ! tmb Temperature
217            CALL iom_put( "dif_"//TRIM(ctrcnm(jn)), zwtmb(:,:,3) )    ! tmb Temperature
218            CALL iom_put( "zav_"//TRIM(ctrcnm(jn)), zwtmb(:,:,4) )    ! tmb Temperature
219            CALL iom_put( "vol_"//TRIM(ctrcnm(jn)), zwtmb(:,:,5) )    ! tmb Temperature
220
221
222
223            !CALL dia_calctmb(  trn(:,:,:,jn),zwtmb )
224            !CALL iom_put( "top_"//TRIM(ctrcnm(jn)), zwtmb(:,:,1) )    ! tmb Temperature
225            !CALL iom_put( "mid_"//TRIM(ctrcnm(jn)), zwtmb(:,:,2) )    ! tmb Temperature
226            !CALL iom_put( "bot_"//TRIM(ctrcnm(jn)), zwtmb(:,:,3) )    ! tmb Temperature
227            !CALL iom_put( "dif_"//TRIM(ctrcnm(jn)), (zwtmb(:,:,1) - zwtmb(:,:,3))*tmask(:,:,1)+zmdi*(1.0-tmask(:,:,1 ) ) )   ! tmb Temperature 
228         ENDDO ! State loop
229         CALL wrk_dealloc( jpi , jpj, 6 , zwtmb )
230#endif
231         
232!Called in  dynspg_ts.F90       CALL iom_put( "baro_v" , vn_b )    ! Barotropic  V Velocity
233      ELSE
234         CALL ctl_warn('dia_tmb: tmb diagnostic is set to false you should not have seen this')
235      ENDIF
236
237   END SUBROUTINE dia_tmb
238   !!======================================================================
239END MODULE diatmb
Note: See TracBrowser for help on using the repository browser.