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

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

Modifications to make modules diadetide and diamlr compilable and compatible with module tide_mod (tickets #2175 and #2194)

File size: 4.5 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
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      REAL(wp)                                   ::   zdt
42      INTEGER                                    ::   jn
43      CHARACTER (LEN=4), DIMENSION(jpmax_harmo)  ::   ctide_selected = ' n/a '
44      TYPE(tide_harmonic), DIMENSION(:), POINTER ::   stideconst
45
46      ! Enquire detiding activation state (test for presence of detiding-related
47      ! weights field and output file group)
48      IF ( xios_is_valid_field( "diadetide_weight" ).AND.xios_is_valid_filegroup( "diadetide_files" ).AND.ln_tide ) THEN
49         lk_diadetide = .TRUE.
50      ELSE
51         lk_diadetide = .FALSE.
52      END IF
53
54      IF (lwp) THEN
55         WRITE (numout, *)
56         WRITE (numout, *) 'dia_detide_init : weight computation for daily detided model diagnostics'
57         WRITE (numout, *) '~~~~~~~~~~~~~~~'
58         WRITE (numout, *) '                  lk_diadetide = ', lk_diadetide
59      END IF
60
61      IF (lk_diadetide) THEN
62         ! Retrieve information about M2 tidal constituent
63         ctide_selected(1) = 'M2'
64         CALL tide_init_harmonics(ctide_selected, stideconst) 
65
66         ! For M2, twice the tidal period spans slightly more than one full
67         ! day. Compute the maximum number of equal intervals that span exactly
68         ! twice the tidal period *and* whose mid-points fall within a 24-hour
69         ! period from midnight to midnight.
70         zdt = 2.0_wp * 2.0_wp * rpi / stideconst(1)%omega
71         ndiadetide = FLOOR( zdt / ( zdt - 86400.0_wp ) )
72         ! Compute mid-points of the intervals to be included in the detided
73         ! average
74         ALLOCATE ( tdiadetide(ndiadetide) )
75         DO jn = 1, ndiadetide
76            tdiadetide(jn) = ( REAL( jn, KIND=wp) - 0.5_wp ) * zdt / REAL( ndiadetide, KIND=wp ) - ( zdt - 86400.0_wp ) * 0.5_wp
77         END DO
78      END IF
79
80   END SUBROUTINE dia_detide_init
81
82   SUBROUTINE dia_detide( kt )
83      !!----------------------------------------------------------------------
84      !!                  ***  ROUTINE dia_detide  ***
85      !!
86      !! ** Purpose : weight computation for daily detided model diagnostics
87      !!----------------------------------------------------------------------
88
89      INTEGER, INTENT(in)          ::   kt
90      REAL(wp), DIMENSION(jpi,jpj) ::   zwght_2D
91      REAL(wp)                     ::   zwght, ztmp
92      INTEGER                      ::   jn
93
94      ! Compute detiding weight at the current time-step; the daily total weight
95      ! is one, and the daily summation of a diagnosed field multiplied by this
96      ! weight should provide daily detided averages
97      zwght = 0.0_wp
98      DO jn = 1, ndiadetide
99         ztmp = ( tdiadetide(jn) - REAL( nsec_day, KIND=wp ) ) / rdt
100         IF ( ( ztmp < 0.5_wp ).AND.( ztmp >= -0.5_wp ) ) THEN
101            zwght = zwght + 1.0_wp / REAL( ndiadetide, KIND=wp )
102         END IF
103      END DO
104      zwght_2D(:,:) = zwght
105      CALL iom_put( "diadetide_weight", zwght_2D)
106
107   END SUBROUTINE dia_detide
108
109END MODULE diadetide
Note: See TracBrowser for help on using the repository browser.