[12022] | 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 |
---|
[12489] | 11 | USE dom_oce , ONLY : rn_Dt, nsec_day |
---|
[12022] | 12 | USE phycst , ONLY : rpi |
---|
[12122] | 13 | USE tide_mod |
---|
[12344] | 14 | #if defined key_iomput |
---|
[12022] | 15 | USE xios |
---|
[12344] | 16 | #endif |
---|
[12022] | 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 | |
---|
[12122] | 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 |
---|
[12022] | 47 | |
---|
[12344] | 48 | lk_diadetide = .FALSE. |
---|
| 49 | #if defined key_iomput |
---|
[12022] | 50 | ! Enquire detiding activation state (test for presence of detiding-related |
---|
| 51 | ! weights field and output file group) |
---|
[12122] | 52 | IF ( xios_is_valid_field( "diadetide_weight" ).AND.xios_is_valid_filegroup( "diadetide_files" ).AND.ln_tide ) THEN |
---|
| 53 | lk_diadetide = .TRUE. |
---|
[12022] | 54 | END IF |
---|
[12344] | 55 | #endif |
---|
[12022] | 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 |
---|
[12122] | 66 | ctide_selected(1) = 'M2' |
---|
| 67 | CALL tide_init_harmonics(ctide_selected, stideconst) |
---|
| 68 | |
---|
[12022] | 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. |
---|
[12122] | 73 | zdt = 2.0_wp * 2.0_wp * rpi / stideconst(1)%omega |
---|
[12022] | 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 |
---|
[12489] | 102 | ztmp = ( tdiadetide(jn) - REAL( nsec_day, KIND=wp ) ) / rn_Dt |
---|
[12022] | 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 |
---|