Changeset 11950


Ignore:
Timestamp:
2019-11-22T16:44:46+01:00 (9 months ago)
Author:
smueller
Message:

Addition of a placeholder substitution mechanism for the inclusion of tidal-constituent parameters, which are available from the tidal-forcing implementation, in regressor expressions for multiple-linear-regression analysis (see ticket #2175)

File:
1 edited

Legend:

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

    r11942 r11950  
    88 
    99   USE par_oce        , ONLY :   wp, jpi, jpj 
     10   USE phycst         , ONLY :   rpi 
    1011   USE in_out_manager , ONLY :   lwp, numout, ln_timing 
    1112   USE iom            , ONLY :   iom_put, iom_use, iom_update_file_name 
     
    1314   USE timing         , ONLY :   timing_start, timing_stop 
    1415   USE xios 
     16   USE tide_mod       , ONLY :   tide_harmo, jpmax_harmo, Wave 
    1517 
    1618   IMPLICIT NONE 
     
    7173      CHARACTER(LEN=1)                            ::   clgt 
    7274      CHARACTER(LEN=2)                            ::   clgd 
    73       INTEGER                                     ::   jm, jn 
     75      CHARACTER(LEN=25)                           ::   clfloat 
     76      CHARACTER(LEN=32)                           ::   clrepl 
     77      INTEGER                                     ::   jl, jm, jn 
     78      INTEGER                                     ::   itide                       ! Number of available tidal components 
     79      INTEGER,  ALLOCATABLE, DIMENSION(:)         ::   itide_const                 ! Index list of selected tidal constituents 
     80      REAL(wp), ALLOCATABLE, DIMENSION(:)         ::   ztide_omega, ztide_u,   &   ! Tidal frequency, phase, nodal correction 
     81         &                                             ztide_v, ztide_f 
     82      REAL(wp)                                    ::   ztide_phase                 ! Tidal-constituent phase at adatrj=0 
    7483 
    7584      IF(lwp) THEN 
     
    121130         ! Compile lists of active regressors and of fields selected for 
    122131         ! analysis (fields "diamlr_r<nnn>" and "diamlr_f<nnn>", where <nnn> is 
    123          ! a 3-digit integer) 
     132         ! a 3-digit integer); also carry out placeholder substitution of tidal 
     133         ! parameters in regressor expressions 
     134         ! 
    124135         ALLOCATE( slxhdl_regs( jpscanmax ), slxhdl_flds( jpscanmax ) ) 
    125136         ireg = 0 
    126137         ifld = 0 
     138         ! 
     139         ! Retrieve information (frequency, phase, nodal correction) about all 
     140         ! available tidal constituents for placeholder substitution below 
     141         itide = jpmax_harmo 
     142         ALLOCATE(itide_const(itide), ztide_omega(itide), ztide_u(itide), ztide_v(itide), ztide_f(itide)) 
     143         DO jn = 1, itide 
     144            itide_const(jn) = jn   ! Select all available tidal constituents 
     145         END DO 
     146         CALL tide_harmo( ztide_omega, ztide_v, ztide_u, ztide_f, itide_const, itide ) 
     147          
    127148         DO jm = 1, jpscanmax 
    128149            WRITE (cl3i, '(i3.3)') jm 
     
    130151            ! Look for regressor 
    131152            IF ( xios_is_valid_field( "diamlr_r"//cl3i ) ) THEN 
     153 
    132154               CALL xios_get_handle( "diamlr_r"//cl3i, slxhdl_regs(ireg+1) ) 
    133                ! Set name attribute (and overwrite possible pre-configured name) 
    134                ! with field id to enable id string retrieval from stored handle 
    135                ! below 
    136                CALL xios_set_attr  ( slxhdl_regs(ireg+1), name="diamlr_r"//cl3i ) 
    137                ! Retrieve pre-configured value of "enabled" attribute 
    138                CALL xios_get_attr  ( slxhdl_regs(ireg+1), enabled=slxatt_enabled ) 
    139                ! If enabled, keep handle in list of activ regressors 
    140                IF ( slxatt_enabled ) ireg = ireg + 1 
     155               ! Retrieve pre-configured value of "enabled" attribute and 
     156               ! regressor expression 
     157               CALL xios_get_attr  ( slxhdl_regs(ireg+1), enabled=slxatt_enabled, expr=slxatt_expr ) 
     158               ! If enabled, keep handle in list of active regressors; also 
     159               ! substitute placeholders for tidal frequencies, phases, and 
     160               ! nodal corrections in regressor expressions 
     161               IF ( slxatt_enabled ) THEN 
     162 
     163                  ! Substitution of placeholders for tidal-constituent 
     164                  ! parameters (amplitudes, angular veloccities, nodal phase 
     165                  ! correction) with values that have been obtained from the 
     166                  ! tidal-forcing implementation 
     167                  DO jn = 1, itide 
     168                     ! Compute phase of tidal constituent (incl. current nodal 
     169                     ! correction) at the start of the model run (i.e. for 
     170                     ! adatrj=0) 
     171                     ztide_phase = MOD( ztide_u(jn) +  ztide_v(jn) - adatrj * 86400.0_wp * ztide_omega(jn), 2.0_wp * rpi ) 
     172                     clrepl = "__TDE_"//TRIM( Wave(jn)%cname_tide )//"_omega__" 
     173                     DO WHILE ( INDEX( slxatt_expr, TRIM( clrepl ) ) > 0 ) 
     174                        WRITE (clfloat, '(e25.18)') ztide_omega(jn) 
     175                        jl = INDEX( slxatt_expr, TRIM( clrepl ) ) 
     176                        slxatt_expr = slxatt_expr(1:jl - 1)//clfloat//slxatt_expr(jl + LEN( TRIM( clrepl ) ):LEN( TRIM( slxatt_expr ) )) 
     177                     END DO 
     178                     clrepl = "__TDE_"//TRIM( Wave(jn)%cname_tide )//"_phase__" 
     179                     DO WHILE ( INDEX( slxatt_expr, TRIM( clrepl ) ) > 0 ) 
     180                        WRITE (clfloat, '(e25.18)') ztide_phase 
     181                        jl = INDEX( slxatt_expr, TRIM( clrepl ) ) 
     182                        slxatt_expr = slxatt_expr(1:jl - 1)//clfloat//slxatt_expr(jl + LEN( TRIM( clrepl ) ):LEN( TRIM( slxatt_expr ) )) 
     183                     END DO 
     184                     clrepl = "__TDE_"//TRIM( Wave(jn)%cname_tide )//"_amplitude__" 
     185                     DO WHILE (INDEX( slxatt_expr, TRIM( clrepl ) ) > 0 ) 
     186                        WRITE (clfloat, '(e25.18)') ztide_f(jn) 
     187                        jl = INDEX( slxatt_expr, TRIM( clrepl ) ) 
     188                        slxatt_expr = slxatt_expr(1:jl - 1)//clfloat//slxatt_expr(jl + LEN( TRIM( clrepl ) ):LEN( TRIM( slxatt_expr ) )) 
     189                     END DO 
     190                  END DO 
     191 
     192                  ! Set name attribute (and overwrite possible pre-configured name) 
     193                  ! with field id to enable id string retrieval from stored handle 
     194                  ! below; also re-set expression with possible substitutions 
     195                  CALL xios_set_attr  ( slxhdl_regs(ireg+1), name="diamlr_r"//cl3i, expr=TRIM( slxatt_expr ) ) 
     196 
     197                  ireg = ireg + 1   ! Accept regressor in list of active regressors 
     198 
     199               END IF 
    141200            END IF 
    142201 
    143202            ! Look for field 
    144203            IF ( xios_is_valid_field( "diamlr_f"//cl3i ) ) THEN 
     204 
    145205               CALL xios_get_handle( "diamlr_f"//cl3i, slxhdl_flds(ifld+1) ) 
    146                ! Set name attribute (and overwrite possible pre-configured name) 
    147                ! with field id to enable id string retrieval from stored handle 
    148                ! below 
    149                CALL xios_set_attr  ( slxhdl_flds(ifld+1), name="diamlr_f"//cl3i ) 
    150206               ! Retrieve pre-configured value of "enabled" attribute 
    151207               CALL xios_get_attr  ( slxhdl_flds(ifld+1), enabled=slxatt_enabled ) 
    152208               ! If enabled, keep handle in list of fields selected for analysis 
    153                IF ( slxatt_enabled ) ifld = ifld + 1 
     209               IF ( slxatt_enabled ) THEN 
     210                   
     211                  ! Set name attribute (and overwrite possible pre-configured name) 
     212                  ! with field id to enable id string retrieval from stored handle 
     213                  ! below 
     214                  CALL xios_set_attr  ( slxhdl_flds(ifld+1), name="diamlr_f"//cl3i ) 
     215 
     216                  ifld = ifld + 1   ! Accept field in list of fields selected for analysis 
     217 
     218               END IF 
    154219            END IF 
    155220 
    156221         END DO 
     222 
     223         ! Release tidal data 
     224         DEALLOCATE( itide_const, ztide_omega, ztide_u, ztide_v, ztide_f ) 
     225 
     226         ! Output number of active regressors and fields selected for analysis 
    157227         IF ( lwp ) WRITE(numout,'(a,i3,a)' ) 'diamlr: ', ireg, ' active regressors found' 
    158228         IF ( lwp ) WRITE(numout,'(a,i3,a)' ) 'diamlr: ', ifld, ' fields selected for analysis' 
     
    219289         END DO 
    220290 
     291         ! Release list of active regressors and fields selected for analysis 
     292         DEALLOCATE( slxhdl_regs, slxhdl_flds ) 
     293 
    221294      END IF 
    222295 
    223       ! Release list of active regressors and fields selected for analysis 
    224       DEALLOCATE( slxhdl_regs, slxhdl_flds ) 
    225        
    226296   END SUBROUTINE dia_mlr_iom_init 
    227297 
     
    234304      !!---------------------------------------------------------------------- 
    235305 
    236       REAL, DIMENSION(jpi,jpj) ::   zadatrj2d 
     306      REAL(wp), DIMENSION(jpi,jpj) ::   zadatrj2d 
    237307 
    238308      IF( ln_timing )   CALL timing_start('dia_mlr') 
Note: See TracChangeset for help on using the changeset viewer.