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

source: branches/UKMO/r6232_collate_bgc_diagnostics/NEMOGCM/NEMO/OPA_SRC/DIA/dia25h.F90 @ 11137

Last change on this file since 11137 was 11137, checked in by jcastill, 5 years ago

Add missing files

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