source: NEMO/branches/2019/dev_r11879_ENHANCE-05_SimonM-Harmonic_Analysis/src/OCE/DIA/diadetide.F90 @ 12022

Last change on this file since 12022 was 12022, checked in by smueller, 7 months ago

Alternative implementation for the computation of daily detided averages (currently M2-detided averages only) of model diagnostics (ticket #2175)

File size: 4.9 KB
Line 
1MODULE diadetide
2   !!======================================================================
3   !!                      ***  MODULE diadetide  ***
4   !! Computation of weights for daily detided model diagnostics
5   !!======================================================================
6   !! History :       !  2019  (S. Mueller)
7   !!----------------------------------------------------------------------
8   USE par_oce        , ONLY :   wp, jpi, jpj
9   USE in_out_manager , ONLY :   lwp, numout
10   USE iom            , ONLY :   iom_put
11   USE dom_oce        , ONLY :   rdt, nsec_day
12   USE phycst         , ONLY :   rpi
13   USE tide_mod       , ONLY :   tide_harmo, jpmax_harmo, Wave
14   USE xios
15
16   IMPLICIT NONE
17   PRIVATE
18
19   LOGICAL, PUBLIC                               ::   lk_diadetide
20   INTEGER                                       ::   ndiadetide
21   REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::   tdiadetide
22
23   PUBLIC ::   dia_detide_init, dia_detide
24
25   !!----------------------------------------------------------------------
26   !! NEMO/OCE 4.0 , NEMO Consortium (2019)
27   !! $Id$
28   !! Software governed by the CeCILL license (see ./LICENSE)
29   !!----------------------------------------------------------------------
30CONTAINS
31
32   SUBROUTINE dia_detide_init
33      !!----------------------------------------------------------------------
34      !!               ***  ROUTINE dia_detide_init  ***
35      !!
36      !! ** Purpose : initialisation of the weight computation for daily
37      !!              detided diagnostics (currently M2-detiding only)
38      !!
39      !!----------------------------------------------------------------------
40
41      LOGICAL                             ::   llxatt_enabled
42      INTEGER, ALLOCATABLE, DIMENSION(:)  ::   itide                                    ! Tidal-constituent index
43      REAL(wp), ALLOCATABLE, DIMENSION(:) ::   ztide_omega, ztide_u, ztide_v, ztide_f   ! Tidal-constituent parameters
44      REAL(wp)                            ::   zdt
45      INTEGER                             ::   jn
46
47      ! Enquire detiding activation state (test for presence of detiding-related
48      ! weights field and output file group)
49      IF ( xios_is_valid_field( "diadetide_weight" ).AND.xios_is_valid_filegroup( "diadetide_files" ) ) THEN
50         llxatt_enabled = .TRUE.
51      ELSE
52         llxatt_enabled = .FALSE.
53      END IF
54      lk_diadetide = llxatt_enabled
55
56      IF (lwp) THEN
57         WRITE (numout, *)
58         WRITE (numout, *) 'dia_detide_init : weight computation for daily detided model diagnostics'
59         WRITE (numout, *) '~~~~~~~~~~~~~~~'
60         WRITE (numout, *) '                  lk_diadetide = ', lk_diadetide
61      END IF
62
63      IF (lk_diadetide) THEN
64         ! Retrieve information about M2 tidal constituent
65         ALLOCATE( ztide_omega(1), ztide_v(1), ztide_u(1), ztide_f(1), itide(1) )
66         DO jn = 1, jpmax_harmo
67            IF (TRIM( Wave(jn)%cname_tide ) == 'M2') itide(1) = jn
68         END DO
69         CALL tide_harmo( ztide_omega, ztide_v, ztide_u, ztide_f, itide, 1 )
70         ! For M2, twice the tidal period spans slightly more than one full
71         ! day. Compute the maximum number of equal intervals that span exactly
72         ! twice the tidal period *and* whose mid-points fall within a 24-hour
73         ! period from midnight to midnight.
74         zdt = Wave(itide(1))%nt * 2.0_wp * rpi / ztide_omega(1)
75         ndiadetide = FLOOR( zdt / ( zdt - 86400.0_wp ) )
76         DEALLOCATE( ztide_omega, ztide_v, ztide_u, ztide_f, itide )
77         ! Compute mid-points of the intervals to be included in the detided
78         ! average
79         ALLOCATE ( tdiadetide(ndiadetide) )
80         DO jn = 1, ndiadetide
81            tdiadetide(jn) = ( REAL( jn, KIND=wp) - 0.5_wp ) * zdt / REAL( ndiadetide, KIND=wp ) - ( zdt - 86400.0_wp ) * 0.5_wp
82         END DO
83      END IF
84
85   END SUBROUTINE dia_detide_init
86
87   SUBROUTINE dia_detide( kt )
88      !!----------------------------------------------------------------------
89      !!                  ***  ROUTINE dia_detide  ***
90      !!
91      !! ** Purpose : weight computation for daily detided model diagnostics
92      !!----------------------------------------------------------------------
93
94      INTEGER, INTENT(in)          ::   kt
95      REAL(wp), DIMENSION(jpi,jpj) ::   zwght_2D
96      REAL(wp)                     ::   zwght, ztmp
97      INTEGER                      ::   jn
98
99      ! Compute detiding weight at the current time-step; the daily total weight
100      ! is one, and the daily summation of a diagnosed field multiplied by this
101      ! weight should provide daily detided averages
102      zwght = 0.0_wp
103      DO jn = 1, ndiadetide
104         ztmp = ( tdiadetide(jn) - REAL( nsec_day, KIND=wp ) ) / rdt
105         IF ( ( ztmp < 0.5_wp ).AND.( ztmp >= -0.5_wp ) ) THEN
106            zwght = zwght + 1.0_wp / REAL( ndiadetide, KIND=wp )
107         END IF
108      END DO
109      zwght_2D(:,:) = zwght
110      CALL iom_put( "diadetide_weight", zwght_2D)
111
112   END SUBROUTINE dia_detide
113
114END MODULE diadetide
Note: See TracBrowser for help on using the repository browser.