Ignore:
Timestamp:
2019-12-09T12:29:10+01:00 (8 months ago)
Author:
smueller
Message:

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

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r11879_ENHANCE-05_SimonM-Harmonic_Analysis/src/OCE/DIA/diamlr.F90

    r12097 r12122  
    1414   USE timing         , ONLY :   timing_start, timing_stop 
    1515   USE xios 
    16    USE tide_mod       , ONLY :   tide_harmo, jpmax_harmo, Wave 
     16   USE tide_mod 
    1717 
    1818   IMPLICIT NONE 
     
    7878      INTEGER                                     ::   jl, jm, jn 
    7979      INTEGER                                     ::   itide                       ! Number of available tidal components 
    80       INTEGER,  ALLOCATABLE, DIMENSION(:)         ::   itide_const                 ! Index list of selected tidal constituents 
    81       REAL(wp), ALLOCATABLE, DIMENSION(:)         ::   ztide_omega, ztide_u,   &   ! Tidal frequency, phase, nodal correction 
    82          &                                             ztide_v, ztide_f 
    8380      REAL(wp)                                    ::   ztide_phase                 ! Tidal-constituent phase at adatrj=0 
     81      CHARACTER (LEN=4), DIMENSION(jpmax_harmo)   ::   ctide_selected = ' n/a ' 
     82      TYPE(tide_harmonic), DIMENSION(:), POINTER  ::   stideconst 
    8483 
    8584      IF(lwp) THEN 
     
    138137         ifld = 0 
    139138         ! 
    140          ! Retrieve information (frequency, phase, nodal correction) about all 
    141          ! available tidal constituents for placeholder substitution below 
    142          itide = jpmax_harmo 
    143          ALLOCATE(itide_const(itide), ztide_omega(itide), ztide_u(itide), ztide_v(itide), ztide_f(itide)) 
    144          DO jn = 1, itide 
    145             itide_const(jn) = jn   ! Select all available tidal constituents 
    146          END DO 
    147          CALL tide_harmo( ztide_omega, ztide_v, ztide_u, ztide_f, itide_const, itide ) 
     139         IF ( ln_tide ) THEN 
     140            ! Retrieve information (frequency, phase, nodal correction) about all 
     141            ! available tidal constituents for placeholder substitution below 
     142            ctide_selected(1:34) = (/ 'Mf', 'Mm', 'Ssa', 'Mtm', 'Msf',    & 
     143               &                      'Msqm', 'Sa', 'K1', 'O1', 'P1',     & 
     144               &                      'Q1', 'J1', 'S1', 'M2', 'S2', 'N2', & 
     145               &                      'K2', 'nu2', 'mu2', '2N2', 'L2',    & 
     146               &                      'T2', 'eps2', 'lam2', 'R2', 'M3',   & 
     147               &                      'MKS2', 'MN4', 'MS4', 'M4', 'N4',   & 
     148               &                      'S4', 'M6', 'M8' /) 
     149            CALL tide_init_harmonics(ctide_selected, stideconst) 
     150            itide = size(stideconst) 
     151         ELSE 
     152            itide = 0 
     153         ENDIF 
    148154          
    149155         DO jm = 1, jpscanmax 
     
    165171                  ! parameters (amplitudes, angular veloccities, nodal phase 
    166172                  ! correction) with values that have been obtained from the 
    167                   ! tidal-forcing implementation 
     173                  ! tidal-forcing implementation (if enabled) 
    168174                  DO jn = 1, itide 
    169175                     ! Compute phase of tidal constituent (incl. current nodal 
    170176                     ! correction) at the start of the model run (i.e. for 
    171177                     ! adatrj=0) 
    172                      ztide_phase = MOD( ztide_u(jn) +  ztide_v(jn) - adatrj * 86400.0_wp * ztide_omega(jn), 2.0_wp * rpi ) 
    173                      clrepl = "__TDE_"//TRIM( Wave(jn)%cname_tide )//"_omega__" 
     178                     ztide_phase = MOD( stideconst(jn)%u +  stideconst(jn)%v0 - adatrj * 86400.0_wp * stideconst(jn)%omega, & 
     179                        & 2.0_wp * rpi ) 
     180                     clrepl = "__TDE_"//TRIM( stideconst(jn)%cname_tide )//"_omega__" 
    174181                     DO WHILE ( INDEX( clxatt_expr, TRIM( clrepl ) ) > 0 ) 
    175                         WRITE (clfloat, '(e25.18)') ztide_omega(jn) 
     182                        WRITE (clfloat, '(e25.18)') stideconst(jn)%omega 
    176183                        jl = INDEX( clxatt_expr, TRIM( clrepl ) ) 
    177184                        clxatt_expr = clxatt_expr(1:jl - 1)//clfloat//   & 
    178185                           &          clxatt_expr(jl + LEN( TRIM( clrepl ) ):LEN( TRIM( clxatt_expr ) )) 
    179186                     END DO 
    180                      clrepl = "__TDE_"//TRIM( Wave(jn)%cname_tide )//"_phase__" 
     187                     clrepl = "__TDE_"//TRIM( stideconst(jn)%cname_tide )//"_phase__" 
    181188                     DO WHILE ( INDEX( clxatt_expr, TRIM( clrepl ) ) > 0 ) 
    182189                        WRITE (clfloat, '(e25.18)') ztide_phase 
     
    185192                           &          clxatt_expr(jl + LEN( TRIM( clrepl ) ):LEN( TRIM( clxatt_expr ) )) 
    186193                     END DO 
    187                      clrepl = "__TDE_"//TRIM( Wave(jn)%cname_tide )//"_amplitude__" 
     194                     clrepl = "__TDE_"//TRIM( stideconst(jn)%cname_tide )//"_amplitude__" 
    188195                     DO WHILE (INDEX( clxatt_expr, TRIM( clrepl ) ) > 0 ) 
    189                         WRITE (clfloat, '(e25.18)') ztide_f(jn) 
     196                        WRITE (clfloat, '(e25.18)') stideconst(jn)%f 
    190197                        jl = INDEX( clxatt_expr, TRIM( clrepl ) ) 
    191198                        clxatt_expr = clxatt_expr(1:jl - 1)//clfloat//   & 
     
    236243 
    237244         END DO 
    238  
    239          ! Release tidal data 
    240          DEALLOCATE( itide_const, ztide_omega, ztide_u, ztide_v, ztide_f ) 
    241245 
    242246         ! Output number of active regressors and fields selected for analysis 
Note: See TracChangeset for help on using the changeset viewer.