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.
dia25h.F90 in branches/UKMO/AMM15_v3_6_STABLE_package_collate/NEMOGCM/NEMO/OPA_SRC/DIA – NEMO

source: branches/UKMO/AMM15_v3_6_STABLE_package_collate/NEMOGCM/NEMO/OPA_SRC/DIA/dia25h.F90 @ 10390

Last change on this file since 10390 was 10390, checked in by dford, 5 years ago

Add 25-hour mean and top-middle-bottom diagnostics for all variables available through FABM, and set up indices for specific variables for easier access by OBS/ASM. See internal Met Office NEMO ticket 760.

File size: 20.8 KB
RevLine 
[8059]1MODULE dia25h 
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 diainsitutem, ONLY: rinsitu_t, theta2t
11   USE in_out_manager  ! I/O units
12   USE iom             ! I/0 library
13   USE wrk_nemo        ! working arrays
14#if defined key_zdftke 
15   USE zdftke, ONLY: en
16#endif
17   USE zdf_oce, ONLY: avt, avm
18#if defined key_zdfgls
19   USE zdfgls, ONLY: mxln
20   USE zdf_oce, ONLY: en
21#endif
[8561]22   USE diatmb
[10390]23#if defined key_fabm
24   USE trc, ONLY: trn
25   USE par_fabm
26   USE st2d_fabm, ONLY: fabm_st2dn
27   USE fabm, ONLY: fabm_get_interior_diagnostic_data, &
28      &            fabm_get_horizontal_diagnostic_data
29#endif
[8059]30
31   IMPLICIT NONE
32   PRIVATE
33
34   LOGICAL , PUBLIC ::   ln_dia25h     !:  25h mean output
35   PUBLIC   dia_25h_init               ! routine called by nemogcm.F90
36   PUBLIC   dia_25h                    ! routine called by diawri.F90
37
38  !! * variables for calculating 25-hourly means
39   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   tn_25h  , sn_25h, rinsitu_t_25h 
[8561]40   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:)   ::   sshn_25h, insitu_bot_25h, temp_bot_25h 
[8059]41   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   un_25h  , vn_25h  , wn_25h
42   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   avt_25h , avm_25h
43#if defined key_zdfgls || key_zdftke
44   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   en_25h
45#endif
46#if defined key_zdfgls 
47   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:) ::   rmxln_25h
48#endif
[10390]49#if defined key_fabm
50   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:,:) :: fabm_25h
51   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:,:) :: fabm_3d_25h
52   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:)   :: fabm_surface_25h
53   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:)   :: fabm_bottom_25h
54   REAL(wp),SAVE, ALLOCATABLE,   DIMENSION(:,:,:)   :: fabm_2d_25h
55#endif
[8059]56   INTEGER, SAVE :: cnt_25h     ! Counter for 25 hour means
57
58
59
60   !!----------------------------------------------------------------------
61   !! NEMO/OPA 3.6 , NEMO Consortium (2014)
62   !! $Id$
63   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
64   !!----------------------------------------------------------------------
65CONTAINS
66
67   SUBROUTINE dia_25h_init 
68      !!---------------------------------------------------------------------------
69      !!                  ***  ROUTINE dia_25h_init  ***
70      !!     
71      !! ** Purpose: Initialization of 25h mean namelist
72      !!       
73      !! ** Method : Read namelist
74      !!   History
75      !!   3.6  !  08-14  (E. O'Dea) Routine to initialize dia_25h
76      !!---------------------------------------------------------------------------
77      !!
78      INTEGER ::   ios                 ! Local integer output status for namelist read
79      INTEGER ::   ierror              ! Local integer for memory allocation
[10390]80      INTEGER ::   jn                  ! Loop counter
[8561]81      REAL(wp), DIMENSION(jpi,jpj,3)   ::   zwtmb                                 ! temporary workspace
[8059]82      !
83      NAMELIST/nam_dia25h/ ln_dia25h
84      !!----------------------------------------------------------------------
85      !
86      REWIND ( numnam_ref )              ! Read Namelist nam_dia25h in reference namelist : 25hour mean diagnostics
87      READ   ( numnam_ref, nam_dia25h, IOSTAT=ios, ERR= 901 )
88901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_dia25h in reference namelist', lwp )
89
90      REWIND( numnam_cfg )              ! Namelist nam_dia25h in configuration namelist  25hour diagnostics
91      READ  ( numnam_cfg, nam_dia25h, IOSTAT = ios, ERR = 902 )
92902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nam_dia25h in configuration namelist', lwp )
93      IF(lwm) WRITE ( numond, nam_dia25h )
94
95      IF(lwp) THEN                   ! Control print
96         WRITE(numout,*)
97         WRITE(numout,*) 'dia_25h_init : Output 25 hour mean diagnostics'
98         WRITE(numout,*) '~~~~~~~~~~~~'
99         WRITE(numout,*) 'Namelist nam_dia25h : set 25h outputs '
100         WRITE(numout,*) 'Switch for 25h diagnostics (T) or not (F)  ln_dia25h  = ', ln_dia25h
101      ENDIF
102      IF( .NOT. ln_dia25h )   RETURN
103      ! ------------------- !
104      ! 1 - Allocate memory !
105      ! ------------------- !
106      ALLOCATE( tn_25h(jpi,jpj,jpk), STAT=ierror )
107      IF( ierror > 0 ) THEN
108         CALL ctl_stop( 'dia_25h: unable to allocate tn_25h' )   ;   RETURN
109      ENDIF
110      ALLOCATE( sn_25h(jpi,jpj,jpk), STAT=ierror )
111      IF( ierror > 0 ) THEN
112         CALL ctl_stop( 'dia_25h: unable to allocate sn_25h' )   ;   RETURN
113      ENDIF
114      ALLOCATE( rinsitu_t_25h(jpi,jpj,jpk), STAT=ierror )
115      IF( ierror > 0 ) THEN
116         CALL ctl_stop( 'dia_25h: unable to allocate rinsitu_t_25h' )   ;   RETURN
117      ENDIF
[8561]118      ALLOCATE( insitu_bot_25h(jpi,jpj), STAT=ierror )
119      IF( ierror > 0 ) THEN
120         CALL ctl_stop( 'dia_25h: unable to allocate insitu_bot_25h' )   ;   RETURN
121      ENDIF     
122      ALLOCATE( temp_bot_25h(jpi,jpj), STAT=ierror )
123      IF( ierror > 0 ) THEN
124         CALL ctl_stop( 'dia_25h: unable to allocate temp_bot_25h' )   ;   RETURN
125      ENDIF                           
[8059]126      ALLOCATE( un_25h(jpi,jpj,jpk), STAT=ierror )
127      IF( ierror > 0 ) THEN
128         CALL ctl_stop( 'dia_25h: unable to allocate un_25h' )   ;   RETURN
129      ENDIF
130      ALLOCATE( vn_25h(jpi,jpj,jpk), STAT=ierror )
131      IF( ierror > 0 ) THEN
132         CALL ctl_stop( 'dia_25h: unable to allocate vn_25h' )   ;   RETURN
133      ENDIF
134      ALLOCATE( wn_25h(jpi,jpj,jpk), STAT=ierror )
135      IF( ierror > 0 ) THEN
136         CALL ctl_stop( 'dia_25h: unable to allocate wn_25h' )   ;   RETURN
137      ENDIF
138      ALLOCATE( avt_25h(jpi,jpj,jpk), STAT=ierror )
139      IF( ierror > 0 ) THEN
140         CALL ctl_stop( 'dia_25h: unable to allocate avt_25h' )   ;   RETURN
141      ENDIF
142      ALLOCATE( avm_25h(jpi,jpj,jpk), STAT=ierror )
143      IF( ierror > 0 ) THEN
144         CALL ctl_stop( 'dia_25h: unable to allocate avm_25h' )   ;   RETURN
145      ENDIF
146# if defined key_zdfgls || defined key_zdftke
147      ALLOCATE( en_25h(jpi,jpj,jpk), STAT=ierror )
148      IF( ierror > 0 ) THEN
149         CALL ctl_stop( 'dia_25h: unable to allocate en_25h' )   ;   RETURN
150      ENDIF
151#endif
152# if defined key_zdfgls 
153      ALLOCATE( rmxln_25h(jpi,jpj,jpk), STAT=ierror )
154      IF( ierror > 0 ) THEN
155         CALL ctl_stop( 'dia_25h: unable to allocate rmxln_25h' )   ;   RETURN
156      ENDIF
157#endif
158      ALLOCATE( sshn_25h(jpi,jpj), STAT=ierror )
159      IF( ierror > 0 ) THEN
160         CALL ctl_stop( 'dia_25h: unable to allocate sshn_25h' )   ;   RETURN
161      ENDIF
[10390]162#if defined key_fabm
163      ALLOCATE( fabm_25h(jpi,jpj,jpk,jp_fabm), STAT=ierror )
164      IF( ierror > 0 ) THEN
165         CALL ctl_stop( 'dia_25h: unable to allocate fabm_25h' )   ;   RETURN
166      ENDIF
167      ALLOCATE( fabm_3d_25h(jpi,jpj,jpk,jp_fabm_3d), STAT=ierror )
168      IF( ierror > 0 ) THEN
169         CALL ctl_stop( 'dia_25h: unable to allocate fabm_3d_25h' )   ;   RETURN
170      ENDIF
171      ALLOCATE( fabm_surface_25h(jpi,jpj,jp_fabm_surface), STAT=ierror )
172      IF( ierror > 0 ) THEN
173         CALL ctl_stop( 'dia_25h: unable to allocate fabm_surface_25h' )   ;   RETURN
174      ENDIF
175      ALLOCATE( fabm_bottom_25h(jpi,jpj,jp_fabm_bottom), STAT=ierror )
176      IF( ierror > 0 ) THEN
177         CALL ctl_stop( 'dia_25h: unable to allocate fabm_bottom_25h' )   ;   RETURN
178      ENDIF
179      ALLOCATE( fabm_2d_25h(jpi,jpj,jp_fabm_2d), STAT=ierror )
180      IF( ierror > 0 ) THEN
181         CALL ctl_stop( 'dia_25h: unable to allocate fabm_2d_25h' )   ;   RETURN
182      ENDIF
183#endif 
[8059]184      ! ------------------------- !
185      ! 2 - Assign Initial Values !
186      ! ------------------------- !
187      cnt_25h = 1  ! sets the first value of sum at timestep 1 (note - should strictly be at timestep zero so before values used where possible)
188      tn_25h(:,:,:) = tsb(:,:,:,jp_tem)
189      sn_25h(:,:,:) = tsb(:,:,:,jp_sal)
190      CALL theta2t
191      rinsitu_t_25h(:,:,:) = rinsitu_t(:,:,:)
[8561]192      CALL dia_calctmb( rinsitu_t(:,:,:),zwtmb )
193      insitu_bot_25h(:,:) = zwtmb(:,:,3)
194      CALL dia_calctmb( tn_25h(:,:,:),zwtmb )
195      temp_bot_25h(:,:) = zwtmb(:,:,3)
[8059]196      sshn_25h(:,:) = sshb(:,:)
197      un_25h(:,:,:) = ub(:,:,:)
198      vn_25h(:,:,:) = vb(:,:,:)
199      wn_25h(:,:,:) = wn(:,:,:)
200      avt_25h(:,:,:) = avt(:,:,:)
201      avm_25h(:,:,:) = avm(:,:,:)
202# if defined key_zdfgls || defined key_zdftke
203         en_25h(:,:,:) = en(:,:,:)
204#endif
205# if defined key_zdfgls
206         rmxln_25h(:,:,:) = mxln(:,:,:)
207#endif
[10390]208#if defined key_fabm
209      DO jn = 1, jp_fabm
210         fabm_25h(:,:,:,jn) = trn(:,:,:,jp_fabm_m1+jn)
211      END DO
212      DO jn = 1, jp_fabm_3d
213         fabm_3d_25h(:,:,:,jn) = fabm_get_interior_diagnostic_data(model, jn)
214      END DO
215      DO jn = 1, jp_fabm_surface
216         fabm_surface_25h(:,:,jn) = fabm_st2dn(:,:,jn)
217      END DO
218      DO jn = 1, jp_fabm_bottom
219         fabm_bottom_25h(:,:,jn) = fabm_st2dn(:,:,jp_fabm_surface+jn)
220      END DO
221      DO jn = 1, jp_fabm_2d
222         fabm_2d_25h(:,:,jn) = fabm_get_horizontal_diagnostic_data(model,jn)
223      END DO
224#endif
[8059]225#if defined key_lim3 || defined key_lim2
226         CALL ctl_stop('STOP', 'dia_25h not setup yet to do tidemean ice')
227#endif 
228
229      ! -------------------------- !
230      ! 3 - Return to dia_wri      !
231      ! -------------------------- !
232
233
234   END SUBROUTINE dia_25h_init
235
236
237   SUBROUTINE dia_25h( kt ) 
238      !!----------------------------------------------------------------------
239      !!                 ***  ROUTINE dia_25h  ***
240      !!         
241      !!
242      !!--------------------------------------------------------------------
243      !!                   
244      !! ** Purpose :   Write diagnostics with M2/S2 tide removed
245      !!
246      !! ** Method  :   
247      !!      25hr mean outputs for shelf seas
248      !!
249      !! History :
250      !!   ?.0  !  07-04  (A. Hines) New routine, developed from dia_wri_foam
251      !!   3.4  !  02-13  (J. Siddorn) Routine taken from old dia_wri_foam
252      !!   3.6  !  08-14  (E. O'Dea) adapted for VN3.6
253      !!----------------------------------------------------------------------
254      !! * Modules used
255
256      IMPLICIT NONE
257
258      !! * Arguments
259      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index
260
261
262      !! * Local declarations
[10390]263      INTEGER ::   ji, jj, jk, jn
[8059]264
265      LOGICAL ::   ll_print = .FALSE.    ! =T print and flush numout
266      REAL(wp)                         ::   zsto, zout, zmax, zjulian, zdt, zmdi  ! temporary reals
267      INTEGER                          ::   i_steps                               ! no of timesteps per hour
268      REAL(wp), DIMENSION(jpi,jpj    ) ::   zw2d, un_dm, vn_dm                    ! temporary workspace
269      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zw3d                                  ! temporary workspace
270      REAL(wp), DIMENSION(jpi,jpj,3)   ::   zwtmb                                 ! temporary workspace
271      INTEGER                          ::   iyear0, nimonth0,iday0                ! start year,imonth,day
272
273      !!----------------------------------------------------------------------
274
275      ! 0. Initialisation
276      ! -----------------
277      ! Define frequency of summing to create 25 h mean
278      zdt = rdt
279      IF( nacc == 1 ) zdt = rdtmin
280
281      IF( MOD( 3600,INT(zdt) ) == 0 ) THEN
282         i_steps = 3600/INT(zdt)
283      ELSE
284         CALL ctl_stop('STOP', 'dia_wri_tide: timestep must give MOD(3600,rdt) = 0 otherwise no hourly values are possible')
285      ENDIF
286
287#if defined key_lim3 || defined key_lim2
288      CALL ctl_stop('STOP', 'dia_wri_tide not setup yet to do tidemean ice')
289#endif
290
291      ! local variable for debugging
292      ll_print = ll_print .AND. lwp
293
294      ! Sum of 25 hourly instantaneous values to give a 25h mean from 24hours
295      ! every day
296      IF( MOD( kt, i_steps ) == 0  .and. kt .ne. nn_it000 ) THEN
297
298         IF (lwp) THEN
299              WRITE(numout,*) 'dia_wri_tide : Summing instantaneous hourly diagnostics at timestep ',kt
300              WRITE(numout,*) '~~~~~~~~~~~~ '
301         ENDIF
302
303         tn_25h(:,:,:)        = tn_25h(:,:,:) + tsn(:,:,:,jp_tem)
304         sn_25h(:,:,:)        = sn_25h(:,:,:) + tsn(:,:,:,jp_sal)
305         CALL theta2t
306         rinsitu_t_25h(:,:,:)  = rinsitu_t_25h(:,:,:) + rinsitu_t(:,:,:)
[8561]307         CALL dia_calctmb( rinsitu_t(:,:,:),zwtmb )
308         insitu_bot_25h(:,:)  = insitu_bot_25h(:,:) + zwtmb(:,:,3)
309         zw3d(:,:,:)          = tsn(:,:,:,jp_tem)
310         CALL dia_calctmb( zw3d,zwtmb )
311         temp_bot_25h(:,:)    = temp_bot_25h(:,:) + zwtmb(:,:,3)
[8059]312         sshn_25h(:,:)        = sshn_25h(:,:) + sshn (:,:)
313         un_25h(:,:,:)        = un_25h(:,:,:) + un(:,:,:)
314         vn_25h(:,:,:)        = vn_25h(:,:,:) + vn(:,:,:)
315         wn_25h(:,:,:)        = wn_25h(:,:,:) + wn(:,:,:)
316         avt_25h(:,:,:)       = avt_25h(:,:,:) + avt(:,:,:)
317         avm_25h(:,:,:)       = avm_25h(:,:,:) + avm(:,:,:)
318# if defined key_zdfgls || defined key_zdftke
319         en_25h(:,:,:)        = en_25h(:,:,:) + en(:,:,:)
320#endif
321# if defined key_zdfgls
322         rmxln_25h(:,:,:)      = rmxln_25h(:,:,:) + mxln(:,:,:)
323#endif
[10390]324#if defined key_fabm
325      DO jn = 1, jp_fabm
326         fabm_25h(:,:,:,jn) = fabm_25h(:,:,:,jn) + trn(:,:,:,jp_fabm_m1+jn)
327      END DO
328      DO jn = 1, jp_fabm_3d
329         fabm_3d_25h(:,:,:,jn) = fabm_3d_25h(:,:,:,jn) + fabm_get_interior_diagnostic_data(model, jn)
330      END DO
331      DO jn = 1, jp_fabm_surface
332         fabm_surface_25h(:,:,jn) = fabm_surface_25h(:,:,jn) + fabm_st2dn(:,:,jn)
333      END DO
334      DO jn = 1, jp_fabm_bottom
335         fabm_bottom_25h(:,:,jn) = fabm_bottom_25h(:,:,jn) + fabm_st2dn(:,:,jp_fabm_surface+jn)
336      END DO
337      DO jn = 1, jp_fabm_2d
338         fabm_2d_25h(:,:,jn) = fabm_2d_25h(:,:,jn) + fabm_get_horizontal_diagnostic_data(model,jn)
339      END DO
340#endif
[8059]341         cnt_25h = cnt_25h + 1
342
343         IF (lwp) THEN
344            WRITE(numout,*) 'dia_tide : Summed the following number of hourly values so far',cnt_25h
345         ENDIF
346
347      ENDIF ! MOD( kt, i_steps ) == 0
348
349         ! Write data for 25 hour mean output streams
350      IF( cnt_25h .EQ. 25 .AND.  MOD( kt, i_steps*24) == 0 .AND. kt .NE. nn_it000 ) THEN
351
352            IF(lwp) THEN
353               WRITE(numout,*) 'dia_wri_tide : Writing 25 hour mean tide diagnostics at timestep', kt
354               WRITE(numout,*) '~~~~~~~~~~~~ '
355            ENDIF
356
357            tn_25h(:,:,:)        = tn_25h(:,:,:) / 25.0_wp
358            sn_25h(:,:,:)        = sn_25h(:,:,:) / 25.0_wp
359            rinsitu_t_25h(:,:,:)  = rinsitu_t_25h(:,:,:) / 25.0_wp
[8561]360            insitu_bot_25h(:,:)  = insitu_bot_25h(:,:) / 25.0_wp 
361            temp_bot_25h(:,:)    = temp_bot_25h(:,:) /25.0_wp
[8059]362            sshn_25h(:,:)        = sshn_25h(:,:) / 25.0_wp
363            un_25h(:,:,:)        = un_25h(:,:,:) / 25.0_wp
364            vn_25h(:,:,:)        = vn_25h(:,:,:) / 25.0_wp
365            wn_25h(:,:,:)        = wn_25h(:,:,:) / 25.0_wp
366            avt_25h(:,:,:)       = avt_25h(:,:,:) / 25.0_wp
367            avm_25h(:,:,:)       = avm_25h(:,:,:) / 25.0_wp
368# if defined key_zdfgls || defined key_zdftke
369            en_25h(:,:,:)        = en_25h(:,:,:) / 25.0_wp
370#endif
371# if defined key_zdfgls
372            rmxln_25h(:,:,:)       = rmxln_25h(:,:,:) / 25.0_wp
373#endif
[10390]374#if defined key_fabm
375            fabm_25h(:,:,:,:)       = fabm_25h(:,:,:,:)       / 25.0_wp
376            fabm_3d_25h(:,:,:,:)    = fabm_3d_25h(:,:,:,:)    / 25.0_wp
377            fabm_surface_25h(:,:,:) = fabm_surface_25h(:,:,:) / 25.0_wp
378            fabm_bottom_25h(:,:,:)  = fabm_bottom_25h(:,:,:)  / 25.0_wp
379            fabm_2d_25h(:,:,:)      = fabm_2d_25h(:,:,:)      / 25.0_wp
380#endif
[8059]381
382            IF (lwp)  WRITE(numout,*) 'dia_wri_tide : Mean calculated by dividing 25 hour sums and writing output'
383            zmdi=1.e+20 !missing data indicator for masking
384            ! write tracers (instantaneous)
385            zw3d(:,:,:) = tn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
386            CALL iom_put("temper25h", zw3d)   ! potential temperature
387            CALL theta2t                                                                    ! calculate insitu temp
388            zw3d(:,:,:) = rinsitu_t_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
389            CALL iom_put("tempis25h", zw3d)   ! in-situ temperature
[8561]390            zw2d(:,:) = insitu_bot_25h(:,:)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1))
391            CALL iom_put("tempisbot25h", zw2d) ! bottom in-situ temperature
392            zw2d(:,:) = temp_bot_25h(:,:)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1))
393            CALL iom_put("temperbot25h",zw2d) ! bottom potential temperature
[8059]394            zw3d(:,:,:) = sn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
395            CALL iom_put( "salin25h", zw3d  )   ! salinity
396            zw2d(:,:) = sshn_25h(:,:)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1))
397            CALL iom_put( "ssh25h", zw2d )   ! sea surface
398
[10390]399#if defined key_fabm
400            ! Write ERSEM variables
401            DO jn = 1, jp_fabm
402               zw3d(:,:,:) = fabm_25h(:,:,:,jn)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
403               CALL iom_put( TRIM(model%state_variables(jn)%name)//"25h", zw3d  )
404            END DO
405            DO jn = 1, jp_fabm_3d
406               zw3d(:,:,:) = fabm_3d_25h(:,:,:,jn)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
407               CALL iom_put( TRIM(model%diagnostic_variables(jn)%name)//"25h", zw3d  )
408            END DO
409            DO jn = 1, jp_fabm_surface
410               zw2d(:,:) = fabm_surface_25h(:,:,jn)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1))
411               CALL iom_put( TRIM(model%surface_state_variables(jn)%name)//"25h", zw2d  )
412            END DO
413            DO jn = 1, jp_fabm_bottom
414               zw2d(:,:) = fabm_bottom_25h(:,:,jn)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1))
415               CALL iom_put( TRIM(model%bottom_state_variables(jn)%name)//"25h", zw2d  )
416            END DO
417            DO jn = 1, jp_fabm_2d
418               zw2d(:,:) = fabm_2d_25h(:,:,jn)*tmask(:,:,1) + zmdi*(1.0-tmask(:,:,1))
419               CALL iom_put( TRIM(model%horizontal_diagnostic_variables(jn)%name)//"25h", zw2d  )
420            END DO
421#endif
[8059]422
423            ! Write velocities (instantaneous)
424            zw3d(:,:,:) = un_25h(:,:,:)*umask(:,:,:) + zmdi*(1.0-umask(:,:,:))
425            CALL iom_put("vozocrtx25h", zw3d)    ! i-current
426            zw3d(:,:,:) = vn_25h(:,:,:)*vmask(:,:,:) + zmdi*(1.0-vmask(:,:,:))
427            CALL iom_put("vomecrty25h", zw3d  )   ! j-current
428
429            zw3d(:,:,:) = wn_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
430            CALL iom_put("vomecrtz25h", zw3d )   ! k-current
431            zw3d(:,:,:) = avt_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
432            CALL iom_put("avt25h", zw3d )   ! diffusivity
433            zw3d(:,:,:) = avm_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
434            CALL iom_put("avm25h", zw3d)   ! viscosity
435#if defined key_zdftke || defined key_zdfgls 
436!           zw3d(:,:,:) = en_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
437!           CALL iom_put("tke25h", zw3d)   ! tke
438#endif
439#if defined key_zdfgls 
440!           zw3d(:,:,:) = rmxln_25h(:,:,:)*tmask(:,:,:) + zmdi*(1.0-tmask(:,:,:))
441!           CALL iom_put( "mxln25h",zw3d)
442#endif
443
444            ! After the write reset the values to cnt=1 and sum values equal current value
445            tn_25h(:,:,:) = tsn(:,:,:,jp_tem)
446            sn_25h(:,:,:) = tsn(:,:,:,jp_sal)
447            CALL theta2t
448            rinsitu_t_25h(:,:,:) = rinsitu_t(:,:,:)
[8561]449            CALL dia_calctmb( rinsitu_t(:,:,:),zwtmb )
450            insitu_bot_25h(:,:) = zwtmb(:,:,3)
451            CALL dia_calctmb( tn_25h(:,:,:),zwtmb)
452            temp_bot_25h(:,:) = zwtmb(:,:,3)
[8059]453            sshn_25h(:,:) = sshn (:,:)
454            un_25h(:,:,:) = un(:,:,:)
455            vn_25h(:,:,:) = vn(:,:,:)
456            wn_25h(:,:,:) = wn(:,:,:)
457            avt_25h(:,:,:) = avt(:,:,:)
458            avm_25h(:,:,:) = avm(:,:,:)
459# if defined key_zdfgls || defined key_zdftke
460            en_25h(:,:,:) = en(:,:,:)
461#endif
462# if defined key_zdfgls
463            rmxln_25h(:,:,:) = mxln(:,:,:)
464#endif
[10390]465#if defined key_fabm
466      DO jn = 1, jp_fabm
467         fabm_25h(:,:,:,jn) = trn(:,:,:,jp_fabm_m1+jn)
468      END DO
469      DO jn = 1, jp_fabm_3d
470         fabm_3d_25h(:,:,:,jn) = fabm_get_interior_diagnostic_data(model, jn)
471      END DO
472      DO jn = 1, jp_fabm_surface
473         fabm_surface_25h(:,:,jn) = fabm_st2dn(:,:,jn)
474      END DO
475      DO jn = 1, jp_fabm_bottom
476         fabm_bottom_25h(:,:,jn) = fabm_st2dn(:,:,jp_fabm_surface+jn)
477      END DO
478      DO jn = 1, jp_fabm_2d
479         fabm_2d_25h(:,:,jn) = fabm_get_horizontal_diagnostic_data(model,jn)
480      END DO
481#endif
[8059]482            cnt_25h = 1
483            IF (lwp)  WRITE(numout,*) 'dia_wri_tide : After 25hr mean write, reset sum to current value and cnt_25h to one for overlapping average',cnt_25h
484
485      ENDIF !  cnt_25h .EQ. 25 .AND.  MOD( kt, i_steps * 24) == 0 .AND. kt .NE. nn_it000
486
487
488   END SUBROUTINE dia_25h 
489
490   !!======================================================================
491END MODULE dia25h
Note: See TracBrowser for help on using the repository browser.