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.
diadetide.F90 in NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DIA – NEMO

source: NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/DIA/diadetide.F90 @ 12344

Last change on this file since 12344 was 12344, checked in by acc, 4 years ago

Branch dev_r11943_MERGE_2019. Fixed ticket #2373. Changes to enable compilation without key_iomput

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