[12022] | 1 | MODULE diadetide |
---|
| 2 | !!====================================================================== |
---|
| 3 | !! *** MODULE diadetide *** |
---|
| 4 | !! Computation of weights for daily detided model diagnostics |
---|
| 5 | !!====================================================================== |
---|
| 6 | !! History : ! 2019 (S. Mueller) |
---|
| 7 | !!---------------------------------------------------------------------- |
---|
[14219] | 8 | USE par_oce , ONLY : jpi, jpj |
---|
[12022] | 9 | USE in_out_manager , ONLY : lwp, numout |
---|
| 10 | USE iom , ONLY : iom_put |
---|
[12489] | 11 | USE dom_oce , ONLY : rn_Dt, nsec_day |
---|
[12022] | 12 | USE phycst , ONLY : rpi |
---|
[12122] | 13 | USE tide_mod |
---|
[14219] | 14 | USE par_kind |
---|
[14644] | 15 | #if defined key_xios |
---|
[12022] | 16 | USE xios |
---|
[12344] | 17 | #endif |
---|
[12022] | 18 | |
---|
| 19 | IMPLICIT NONE |
---|
| 20 | PRIVATE |
---|
| 21 | |
---|
| 22 | LOGICAL, PUBLIC :: lk_diadetide |
---|
| 23 | INTEGER :: ndiadetide |
---|
| 24 | REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) :: tdiadetide |
---|
| 25 | |
---|
| 26 | PUBLIC :: dia_detide_init, dia_detide |
---|
| 27 | |
---|
| 28 | !!---------------------------------------------------------------------- |
---|
| 29 | !! NEMO/OCE 4.0 , NEMO Consortium (2019) |
---|
| 30 | !! $Id$ |
---|
| 31 | !! Software governed by the CeCILL license (see ./LICENSE) |
---|
| 32 | !!---------------------------------------------------------------------- |
---|
| 33 | CONTAINS |
---|
| 34 | |
---|
| 35 | SUBROUTINE dia_detide_init |
---|
| 36 | !!---------------------------------------------------------------------- |
---|
| 37 | !! *** ROUTINE dia_detide_init *** |
---|
| 38 | !! |
---|
| 39 | !! ** Purpose : initialisation of the weight computation for daily |
---|
| 40 | !! detided diagnostics (currently M2-detiding only) |
---|
| 41 | !! |
---|
| 42 | !!---------------------------------------------------------------------- |
---|
| 43 | |
---|
[12122] | 44 | REAL(wp) :: zdt |
---|
| 45 | INTEGER :: jn |
---|
| 46 | CHARACTER (LEN=4), DIMENSION(jpmax_harmo) :: ctide_selected = ' n/a ' |
---|
| 47 | TYPE(tide_harmonic), DIMENSION(:), POINTER :: stideconst |
---|
[12022] | 48 | |
---|
[12344] | 49 | lk_diadetide = .FALSE. |
---|
[14644] | 50 | #if defined key_xios |
---|
[12022] | 51 | ! Enquire detiding activation state (test for presence of detiding-related |
---|
| 52 | ! weights field and output file group) |
---|
[12122] | 53 | IF ( xios_is_valid_field( "diadetide_weight" ).AND.xios_is_valid_filegroup( "diadetide_files" ).AND.ln_tide ) THEN |
---|
| 54 | lk_diadetide = .TRUE. |
---|
[12022] | 55 | END IF |
---|
[12344] | 56 | #endif |
---|
[12022] | 57 | |
---|
| 58 | IF (lwp) THEN |
---|
| 59 | WRITE (numout, *) |
---|
| 60 | WRITE (numout, *) 'dia_detide_init : weight computation for daily detided model diagnostics' |
---|
| 61 | WRITE (numout, *) '~~~~~~~~~~~~~~~' |
---|
| 62 | WRITE (numout, *) ' lk_diadetide = ', lk_diadetide |
---|
| 63 | END IF |
---|
| 64 | |
---|
| 65 | IF (lk_diadetide) THEN |
---|
| 66 | ! Retrieve information about M2 tidal constituent |
---|
[12122] | 67 | ctide_selected(1) = 'M2' |
---|
| 68 | CALL tide_init_harmonics(ctide_selected, stideconst) |
---|
| 69 | |
---|
[12022] | 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. |
---|
[12122] | 74 | zdt = 2.0_wp * 2.0_wp * rpi / stideconst(1)%omega |
---|
[12022] | 75 | ndiadetide = FLOOR( zdt / ( zdt - 86400.0_wp ) ) |
---|
| 76 | ! Compute mid-points of the intervals to be included in the detided |
---|
| 77 | ! average |
---|
| 78 | ALLOCATE ( tdiadetide(ndiadetide) ) |
---|
| 79 | DO jn = 1, ndiadetide |
---|
| 80 | tdiadetide(jn) = ( REAL( jn, KIND=wp) - 0.5_wp ) * zdt / REAL( ndiadetide, KIND=wp ) - ( zdt - 86400.0_wp ) * 0.5_wp |
---|
| 81 | END DO |
---|
| 82 | END IF |
---|
| 83 | |
---|
| 84 | END SUBROUTINE dia_detide_init |
---|
| 85 | |
---|
| 86 | SUBROUTINE dia_detide( kt ) |
---|
| 87 | !!---------------------------------------------------------------------- |
---|
| 88 | !! *** ROUTINE dia_detide *** |
---|
| 89 | !! |
---|
| 90 | !! ** Purpose : weight computation for daily detided model diagnostics |
---|
| 91 | !!---------------------------------------------------------------------- |
---|
| 92 | |
---|
| 93 | INTEGER, INTENT(in) :: kt |
---|
| 94 | REAL(wp), DIMENSION(jpi,jpj) :: zwght_2D |
---|
| 95 | REAL(wp) :: zwght, ztmp |
---|
| 96 | INTEGER :: jn |
---|
| 97 | |
---|
| 98 | ! Compute detiding weight at the current time-step; the daily total weight |
---|
| 99 | ! is one, and the daily summation of a diagnosed field multiplied by this |
---|
| 100 | ! weight should provide daily detided averages |
---|
| 101 | zwght = 0.0_wp |
---|
| 102 | DO jn = 1, ndiadetide |
---|
[12489] | 103 | ztmp = ( tdiadetide(jn) - REAL( nsec_day, KIND=wp ) ) / rn_Dt |
---|
[12022] | 104 | IF ( ( ztmp < 0.5_wp ).AND.( ztmp >= -0.5_wp ) ) THEN |
---|
| 105 | zwght = zwght + 1.0_wp / REAL( ndiadetide, KIND=wp ) |
---|
| 106 | END IF |
---|
| 107 | END DO |
---|
| 108 | zwght_2D(:,:) = zwght |
---|
| 109 | CALL iom_put( "diadetide_weight", zwght_2D) |
---|
| 110 | |
---|
| 111 | END SUBROUTINE dia_detide |
---|
| 112 | |
---|
| 113 | END MODULE diadetide |
---|