1 | MODULE 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 : rn_Dt, nsec_day |
---|
12 | USE phycst , ONLY : rpi |
---|
13 | USE tide_mod |
---|
14 | #if defined key_xios |
---|
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 | !!---------------------------------------------------------------------- |
---|
32 | CONTAINS |
---|
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_xios |
---|
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 ) ) / rn_Dt |
---|
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 | |
---|
112 | END MODULE diadetide |
---|