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

source: branches/UKMO/AMM15_v3_6_STABLE_package_collate_utils366_fabmv1/NEMOGCM/NEMO/OPA_SRC/DIA/diatmb.F90 @ 13451

Last change on this file since 13451 was 13451, checked in by dford, 4 years ago

Modifications to accommodate interaction between NEMO-FABM coupler only saving diagnostics requested in iodef.xml, and the assimilation and 25h/tmb diagnostic code.

File size: 8.3 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#if defined key_fabm
14   USE trc, ONLY: trn
15   USE par_fabm
16#endif
17
18
19   IMPLICIT NONE
20   PRIVATE
21
22   LOGICAL , PUBLIC ::   ln_diatmb     !: Top Middle and Bottom output
23   PUBLIC   dia_tmb_init            ! routine called by nemogcm.F90
24   PUBLIC   dia_tmb                 ! routine called by diawri.F90
25   PUBLIC   dia_calctmb             ! routine called by dia25h.F90
26
27   !!----------------------------------------------------------------------
28   !! NEMO/OPA 3.6 , NEMO Consortium (2014)
29   !! $Id$
30   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
31   !!----------------------------------------------------------------------
32CONTAINS
33
34   SUBROUTINE dia_tmb_init 
35      !!---------------------------------------------------------------------------
36      !!                  ***  ROUTINE dia_tmb_init  ***
37      !!     
38      !! ** Purpose: Initialization of tmb namelist
39      !!       
40      !! ** Method : Read namelist
41      !!   History
42      !!   3.6  !  08-14  (E. O'Dea) Routine to initialize dia_tmb
43      !!---------------------------------------------------------------------------
44      !!
45      INTEGER ::   ios                 ! Local integer output status for namelist read
46      !
47      NAMELIST/nam_diatmb/ ln_diatmb
48      !!----------------------------------------------------------------------
49      !
50      REWIND ( numnam_ref )              ! Read Namelist nam_diatmb in reference namelist : TMB diagnostics
51      READ   ( numnam_ref, nam_diatmb, IOSTAT=ios, ERR= 901 )
52901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diatmb in reference namelist', lwp )
53 
54      REWIND( numnam_cfg )              ! Namelist nam_diatmb in configuration namelist  TMB diagnostics
55      READ  ( numnam_cfg, nam_diatmb, IOSTAT = ios, ERR = 902 )
56902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_diatmb in configuration namelist', lwp )
57      IF(lwm) WRITE ( numond, nam_diatmb )
58
59      IF(lwp) THEN                   ! Control print
60         WRITE(numout,*)
61         WRITE(numout,*) 'dia_tmb_init : Output Top, Middle, Bottom Diagnostics'
62         WRITE(numout,*) '~~~~~~~~~~~~'
63         WRITE(numout,*) 'Namelist nam_diatmb : set tmb outputs '
64         WRITE(numout,*) 'Switch for TMB diagnostics (T) or not (F)  ln_diatmb  = ', ln_diatmb
65      ENDIF
66
67   END SUBROUTINE dia_tmb_init
68
69   SUBROUTINE dia_calctmb( pinfield,pouttmb )
70      !!---------------------------------------------------------------------
71      !!                  ***  ROUTINE dia_tmb  ***
72      !!                   
73      !! ** Purpose :    Find the Top, Mid and Bottom fields of water Column
74      !!
75      !! ** Method  :   
76      !!      use mbathy to find surface, mid and bottom of model levels
77      !!
78      !! History :
79      !!   3.6  !  08-14  (E. O'Dea) Routine based on dia_wri_foam
80      !!----------------------------------------------------------------------
81      !! * Modules used
82
83      ! Routine to map 3d field to top, middle, bottom
84      IMPLICIT NONE
85
86
87      ! Routine arguments
88      REAL(wp), DIMENSION(jpi, jpj, jpk), INTENT(IN   ) :: pinfield    ! Input 3d field and mask
89      REAL(wp), DIMENSION(jpi, jpj, 3  ), INTENT(  OUT) :: pouttmb     ! Output top, middle, bottom
90
91
92
93      ! Local variables
94      INTEGER :: ji,jj,jk  ! Dummy loop indices
95
96      ! Local Real
97      REAL(wp)                         ::   zmdi  !  set masked values
98
99      zmdi=1.e+20 !missing data indicator for masking
100
101      ! Calculate top
102      pouttmb(:,:,1) = pinfield(:,:,1)*tmask(:,:,1)  + zmdi*(1.0-tmask(:,:,1))
103
104      ! Calculate middle
105      DO jj = 1,jpj
106         DO ji = 1,jpi
107            jk              = max(1,mbathy(ji,jj)/2)
108            pouttmb(ji,jj,2) = pinfield(ji,jj,jk)*tmask(ji,jj,jk)  + zmdi*(1.0-tmask(ji,jj,jk))
109         END DO
110      END DO
111
112      ! Calculate bottom
113      DO jj = 1,jpj
114         DO ji = 1,jpi
115            jk              = max(1,mbathy(ji,jj) )
116            pouttmb(ji,jj,3) = pinfield(ji,jj,jk)*tmask(ji,jj,jk)  + zmdi*(1.0-tmask(ji,jj,jk))
117         END DO
118      END DO
119
120   END SUBROUTINE dia_calctmb
121
122
123
124   SUBROUTINE dia_tmb
125      !!----------------------------------------------------------------------
126      !!                 ***  ROUTINE dia_tmb  ***
127      !! ** Purpose :   Write diagnostics for Top, Mid and Bottom of water Column
128      !!
129      !! ** Method  :   
130      !!      use mbathy to find surface, mid and bottom of model levels
131      !!      calls calctmb to retrieve TMB values before sending to iom_put
132      !!
133      !! History :
134      !!   3.6  !  08-14  (E. O'Dea)
135      !!         
136      !!--------------------------------------------------------------------
137      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwtmb    ! temporary workspace
138      REAL(wp)                         ::   zmdi      ! set masked values
139      INTEGER                          ::   jn        ! loop counter
140
141      zmdi=1.e+20 !missing data indicator for maskin
142
143      IF (ln_diatmb) THEN
144         CALL wrk_alloc( jpi , jpj, 3 , zwtmb )
145         CALL dia_calctmb(  tsn(:,:,:,jp_tem),zwtmb )
146         !ssh already output but here we output it masked
147         CALL iom_put( "sshnmasked" , sshn(:,:)*tmask(:,:,1) + zmdi*(1.0 - tmask(:,:,1)) )   ! tmb Temperature
148         CALL iom_put( "top_temp" , zwtmb(:,:,1) )    ! tmb Temperature
149         CALL iom_put( "mid_temp" , zwtmb(:,:,2) )    ! tmb Temperature
150         CALL iom_put( "bot_temp" , zwtmb(:,:,3) )    ! tmb Temperature
151!         CALL iom_put( "sotrefml" , hmld_tref(:,:) )    ! "T criterion Mixed Layer Depth
152
153         CALL dia_calctmb(  tsn(:,:,:,jp_sal),zwtmb )
154         CALL iom_put( "top_sal" , zwtmb(:,:,1) )    ! tmb Salinity
155         CALL iom_put( "mid_sal" , zwtmb(:,:,2) )    ! tmb Salinity
156         CALL iom_put( "bot_sal" , zwtmb(:,:,3) )    ! tmb Salinity
157
158         CALL dia_calctmb(  un(:,:,:),zwtmb )
159         CALL iom_put( "top_u" , zwtmb(:,:,1) )    ! tmb  U Velocity
160         CALL iom_put( "mid_u" , zwtmb(:,:,2) )    ! tmb  U Velocity
161         CALL iom_put( "bot_u" , zwtmb(:,:,3) )    ! tmb  U Velocity
162!Called in  dynspg_ts.F90        CALL iom_put( "baro_u" , un_b )    ! Barotropic  U Velocity
163
164         CALL dia_calctmb(  vn(:,:,:),zwtmb )
165         CALL iom_put( "top_v" , zwtmb(:,:,1) )    ! tmb  V Velocity
166         CALL iom_put( "mid_v" , zwtmb(:,:,2) )    ! tmb  V Velocity
167         CALL iom_put( "bot_v" , zwtmb(:,:,3) )    ! tmb  V Velocity
168!Called in  dynspg_ts.F90       CALL iom_put( "baro_v" , vn_b )    ! Barotropic  V Velocity
169
170#if defined key_fabm
171         DO jn = 1, jp_fabm
172            CALL dia_calctmb( trn(:,:,:,jp_fabm_m1+jn), zwtmb )
173            CALL iom_put( "top_"//TRIM(model%interior_state_variables(jn)%name) , zwtmb(:,:,1) )
174            CALL iom_put( "mid_"//TRIM(model%interior_state_variables(jn)%name) , zwtmb(:,:,2) )
175            CALL iom_put( "bot_"//TRIM(model%interior_state_variables(jn)%name) , zwtmb(:,:,3) )
176         END DO
177         DO jn = 1, jp_fabm_3d
178            IF ( iom_use('top_'//TRIM(model%interior_diagnostic_variables(jn)%name)) .OR. &
179               & iom_use('mid_'//TRIM(model%interior_diagnostic_variables(jn)%name)) .OR. &
180               & iom_use('bot_'//TRIM(model%interior_diagnostic_variables(jn)%name)) ) THEN
181               CALL dia_calctmb( model%get_interior_diagnostic_data(jn), zwtmb )
182               CALL iom_put( "top_"//TRIM(model%interior_diagnostic_variables(jn)%name) , zwtmb(:,:,1) )
183               CALL iom_put( "mid_"//TRIM(model%interior_diagnostic_variables(jn)%name) , zwtmb(:,:,2) )
184               CALL iom_put( "bot_"//TRIM(model%interior_diagnostic_variables(jn)%name) , zwtmb(:,:,3) )
185            ENDIF
186         END DO
187#endif
188      ELSE
189         CALL ctl_warn('dia_tmb: tmb diagnostic is set to false you should not have seen this')
190      ENDIF
191
192   END SUBROUTINE dia_tmb
193   !!======================================================================
194END MODULE diatmb
Note: See TracBrowser for help on using the repository browser.