- Timestamp:
- 2019-11-22T16:44:46+01:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11879_ENHANCE-05_SimonM-Harmonic_Analysis/src/OCE/DIA/diamlr.F90
r11942 r11950 8 8 9 9 USE par_oce , ONLY : wp, jpi, jpj 10 USE phycst , ONLY : rpi 10 11 USE in_out_manager , ONLY : lwp, numout, ln_timing 11 12 USE iom , ONLY : iom_put, iom_use, iom_update_file_name … … 13 14 USE timing , ONLY : timing_start, timing_stop 14 15 USE xios 16 USE tide_mod , ONLY : tide_harmo, jpmax_harmo, Wave 15 17 16 18 IMPLICIT NONE … … 71 73 CHARACTER(LEN=1) :: clgt 72 74 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 74 83 75 84 IF(lwp) THEN … … 121 130 ! Compile lists of active regressors and of fields selected for 122 131 ! 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 ! 124 135 ALLOCATE( slxhdl_regs( jpscanmax ), slxhdl_flds( jpscanmax ) ) 125 136 ireg = 0 126 137 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 127 148 DO jm = 1, jpscanmax 128 149 WRITE (cl3i, '(i3.3)') jm … … 130 151 ! Look for regressor 131 152 IF ( xios_is_valid_field( "diamlr_r"//cl3i ) ) THEN 153 132 154 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 141 200 END IF 142 201 143 202 ! Look for field 144 203 IF ( xios_is_valid_field( "diamlr_f"//cl3i ) ) THEN 204 145 205 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 handle148 ! below149 CALL xios_set_attr ( slxhdl_flds(ifld+1), name="diamlr_f"//cl3i )150 206 ! Retrieve pre-configured value of "enabled" attribute 151 207 CALL xios_get_attr ( slxhdl_flds(ifld+1), enabled=slxatt_enabled ) 152 208 ! 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 154 219 END IF 155 220 156 221 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 157 227 IF ( lwp ) WRITE(numout,'(a,i3,a)' ) 'diamlr: ', ireg, ' active regressors found' 158 228 IF ( lwp ) WRITE(numout,'(a,i3,a)' ) 'diamlr: ', ifld, ' fields selected for analysis' … … 219 289 END DO 220 290 291 ! Release list of active regressors and fields selected for analysis 292 DEALLOCATE( slxhdl_regs, slxhdl_flds ) 293 221 294 END IF 222 295 223 ! Release list of active regressors and fields selected for analysis224 DEALLOCATE( slxhdl_regs, slxhdl_flds )225 226 296 END SUBROUTINE dia_mlr_iom_init 227 297 … … 234 304 !!---------------------------------------------------------------------- 235 305 236 REAL , DIMENSION(jpi,jpj) :: zadatrj2d306 REAL(wp), DIMENSION(jpi,jpj) :: zadatrj2d 237 307 238 308 IF( ln_timing ) CALL timing_start('dia_mlr')
Note: See TracChangeset
for help on using the changeset viewer.
