Changeset 11961
- Timestamp:
- 2019-11-25T20:40:46+01:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11879_ENHANCE-05_SimonM-Harmonic_Analysis/src/OCE/DIA/diamlr.F90
r11950 r11961 63 63 TYPE(xios_field) :: slxhdl_fld 64 64 TYPE(xios_file) :: slxhdl_fil 65 LOGICAL :: slxatt_enabled66 CHARACTER(LEN=256) :: slxatt_expr67 CHARACTER(LEN=32) :: slxatt_name1, slxatt_name268 CHARACTER(LEN=32) :: slxatt_gridref, slxatt_fieldref65 LOGICAL :: llxatt_enabled 66 CHARACTER(LEN=256) :: clxatt_expr 67 CHARACTER(LEN=32) :: clxatt_name1, clxatt_name2 68 CHARACTER(LEN=32) :: clxatt_gridref, clxatt_fieldref 69 69 INTEGER, PARAMETER :: jpscanmax = 999 70 70 INTEGER :: ireg, ifld … … 155 155 ! Retrieve pre-configured value of "enabled" attribute and 156 156 ! regressor expression 157 CALL xios_get_attr ( slxhdl_regs(ireg+1), enabled= slxatt_enabled, expr=slxatt_expr )157 CALL xios_get_attr ( slxhdl_regs(ireg+1), enabled=llxatt_enabled, expr=clxatt_expr ) 158 158 ! If enabled, keep handle in list of active regressors; also 159 159 ! substitute placeholders for tidal frequencies, phases, and 160 160 ! nodal corrections in regressor expressions 161 IF ( slxatt_enabled ) THEN161 IF ( llxatt_enabled ) THEN 162 162 163 163 ! Substitution of placeholders for tidal-constituent … … 171 171 ztide_phase = MOD( ztide_u(jn) + ztide_v(jn) - adatrj * 86400.0_wp * ztide_omega(jn), 2.0_wp * rpi ) 172 172 clrepl = "__TDE_"//TRIM( Wave(jn)%cname_tide )//"_omega__" 173 DO WHILE ( INDEX( slxatt_expr, TRIM( clrepl ) ) > 0 )173 DO WHILE ( INDEX( clxatt_expr, TRIM( clrepl ) ) > 0 ) 174 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 ) )) 175 jl = INDEX( clxatt_expr, TRIM( clrepl ) ) 176 clxatt_expr = clxatt_expr(1:jl - 1)//clfloat// & 177 & clxatt_expr(jl + LEN( TRIM( clrepl ) ):LEN( TRIM( clxatt_expr ) )) 177 178 END DO 178 179 clrepl = "__TDE_"//TRIM( Wave(jn)%cname_tide )//"_phase__" 179 DO WHILE ( INDEX( slxatt_expr, TRIM( clrepl ) ) > 0 )180 DO WHILE ( INDEX( clxatt_expr, TRIM( clrepl ) ) > 0 ) 180 181 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 ) )) 182 jl = INDEX( clxatt_expr, TRIM( clrepl ) ) 183 clxatt_expr = clxatt_expr(1:jl - 1)//clfloat// & 184 & clxatt_expr(jl + LEN( TRIM( clrepl ) ):LEN( TRIM( clxatt_expr ) )) 183 185 END DO 184 186 clrepl = "__TDE_"//TRIM( Wave(jn)%cname_tide )//"_amplitude__" 185 DO WHILE (INDEX( slxatt_expr, TRIM( clrepl ) ) > 0 )187 DO WHILE (INDEX( clxatt_expr, TRIM( clrepl ) ) > 0 ) 186 188 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 jl = INDEX( clxatt_expr, TRIM( clrepl ) ) 190 clxatt_expr = clxatt_expr(1:jl - 1)//clfloat// & 191 & clxatt_expr(jl + LEN( TRIM( clrepl ) ):LEN( TRIM( clxatt_expr ) )) 189 192 END DO 190 193 END DO … … 193 196 ! with field id to enable id string retrieval from stored handle 194 197 ! 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 ) )198 CALL xios_set_attr ( slxhdl_regs(ireg+1), name="diamlr_r"//cl3i, expr=TRIM( clxatt_expr ) ) 196 199 197 200 ireg = ireg + 1 ! Accept regressor in list of active regressors … … 205 208 CALL xios_get_handle( "diamlr_f"//cl3i, slxhdl_flds(ifld+1) ) 206 209 ! Retrieve pre-configured value of "enabled" attribute 207 CALL xios_get_attr ( slxhdl_flds(ifld+1), enabled= slxatt_enabled )210 CALL xios_get_attr ( slxhdl_flds(ifld+1), enabled=llxatt_enabled ) 208 211 ! If enabled, keep handle in list of fields selected for analysis 209 IF ( slxatt_enabled ) THEN212 IF ( llxatt_enabled ) THEN 210 213 211 214 ! Set name attribute (and overwrite possible pre-configured name) … … 238 241 ! 3-dimensional versions are simply obtained via grid 239 242 ! transformations from the 2-dimensional version. 240 CALL xios_get_attr ( slxhdl_regs( jm ), name= slxatt_name1, expr=slxatt_expr, enabled=slxatt_enabled )241 CALL xios_add_child ( slxhdl_fldgrp, slxhdl_fld, TRIM( slxatt_name1 )//"_2D" )242 CALL xios_set_attr ( slxhdl_fld, expr=TRIM( slxatt_expr ), grid_ref="diamlr_grid_2D", &243 & field_ref="diamlr_time", enabled= slxatt_enabled )244 CALL xios_add_child ( slxhdl_fldgrp, slxhdl_fld, TRIM( slxatt_name1 )//"_3D")243 CALL xios_get_attr ( slxhdl_regs( jm ), name=clxatt_name1, expr=clxatt_expr, enabled=llxatt_enabled ) 244 CALL xios_add_child ( slxhdl_fldgrp, slxhdl_fld, TRIM( clxatt_name1 )//"_2D" ) 245 CALL xios_set_attr ( slxhdl_fld, expr=TRIM( clxatt_expr ), grid_ref="diamlr_grid_2D", & 246 & field_ref="diamlr_time", enabled=llxatt_enabled ) 247 CALL xios_add_child ( slxhdl_fldgrp, slxhdl_fld, TRIM( clxatt_name1 )//"_3D") 245 248 CALL xios_set_attr ( slxhdl_fld, expr="this", grid_ref="diamlr_grid_2D_to_3D", & 246 & field_ref=TRIM( slxatt_name1 )//"_2D", enabled=slxatt_enabled)249 & field_ref=TRIM( clxatt_name1 )//"_2D", enabled=llxatt_enabled) 247 250 CALL xios_set_attr ( slxhdl_regs(jm), expr="this", grid_ref="diamlr_grid_2D_to_scalar", & 248 & field_ref=TRIM( slxatt_name1 )//"_2D", enabled=slxatt_enabled)251 & field_ref=TRIM( clxatt_name1 )//"_2D", enabled=llxatt_enabled) 249 252 250 253 ! ii) set up definitions for the output of scalar products with 251 254 ! itself and with other active regressors 252 CALL xios_get_attr ( slxhdl_regs(jm), name= slxatt_name1 )255 CALL xios_get_attr ( slxhdl_regs(jm), name=clxatt_name1 ) 253 256 CALL xios_get_handle( "diamlr_file_scalar", slxhdl_fil) 254 257 DO jn = 1, jm 255 258 ! Field for product between regressors 256 CALL xios_get_attr ( slxhdl_regs(jn), name= slxatt_name2, enabled=slxatt_enabled )257 CALL xios_add_child ( slxhdl_fldgrp, slxhdl_fld, TRIM( slxatt_name1 )//"."//TRIM( slxatt_name2 ) )259 CALL xios_get_attr ( slxhdl_regs(jn), name=clxatt_name2, enabled=llxatt_enabled ) 260 CALL xios_add_child ( slxhdl_fldgrp, slxhdl_fld, TRIM( clxatt_name1 )//"."//TRIM( clxatt_name2 ) ) 258 261 ! Set appropriate name attribute to avoid the possibility of 259 262 ! using an inappropriate inherited name attribute as the variable 260 263 ! name in the output file 261 CALL xios_set_attr ( slxhdl_fld, name=TRIM( slxatt_name1 )//"."//TRIM( slxatt_name2 ), &262 & grid_ref="diamlr_grid_scalar", expr="this * "//TRIM( slxatt_name2 ), &263 & field_ref=TRIM( slxatt_name1 ), enabled=slxatt_enabled, operation="accumulate")264 CALL xios_set_attr ( slxhdl_fld, name=TRIM( clxatt_name1 )//"."//TRIM( clxatt_name2 ), & 265 & grid_ref="diamlr_grid_scalar", expr="this * "//TRIM( clxatt_name2 ), & 266 & field_ref=TRIM( clxatt_name1 ), enabled=llxatt_enabled, operation="accumulate") 264 267 ! Add regressor-product field to output file 265 CALL xios_add_child ( slxhdl_fil, slxhdl_fld, TRIM( slxatt_name1 )//"."//TRIM( slxatt_name2 ) )268 CALL xios_add_child ( slxhdl_fil, slxhdl_fld, TRIM( clxatt_name1 )//"."//TRIM( clxatt_name2 ) ) 266 269 END DO 267 270 … … 269 272 ! fields selected for analysis 270 273 DO jn = 1, ifld 271 CALL xios_get_attr( slxhdl_flds(jn), name= slxatt_name2, grid_ref=slxatt_gridref, field_ref=slxatt_fieldref )274 CALL xios_get_attr( slxhdl_flds(jn), name=clxatt_name2, grid_ref=clxatt_gridref, field_ref=clxatt_fieldref ) 272 275 clgt="T" 273 IF ( INDEX( slxatt_gridref, "_U_" ) > 0 ) clgt="U"274 IF ( INDEX( slxatt_gridref, "_V_" ) > 0 ) clgt="V"275 IF ( INDEX( slxatt_gridref, "_W_" ) > 0 ) clgt="W"276 IF ( INDEX( clxatt_gridref, "_U_" ) > 0 ) clgt="U" 277 IF ( INDEX( clxatt_gridref, "_V_" ) > 0 ) clgt="V" 278 IF ( INDEX( clxatt_gridref, "_W_" ) > 0 ) clgt="W" 276 279 clgd="2D" 277 IF ( INDEX( slxatt_gridref, "_3D" ) > 0 ) clgd="3D"278 CALL xios_add_child ( slxhdl_fldgrp, slxhdl_fld, TRIM( slxatt_name2 )//"."//TRIM( slxatt_name1 ) )280 IF ( INDEX( clxatt_gridref, "_3D" ) > 0 ) clgd="3D" 281 CALL xios_add_child ( slxhdl_fldgrp, slxhdl_fld, TRIM( clxatt_name2 )//"."//TRIM( clxatt_name1 ) ) 279 282 ! Set appropriate name attribute to avoid the possibility of 280 283 ! using an inappropriate inherited name attribute as the variable 281 284 ! name in the output file 282 CALL xios_set_attr ( slxhdl_fld, name=TRIM( slxatt_name2 )//"."//TRIM( slxatt_name1 ), &283 & expr="this * "//TRIM( slxatt_fieldref ), grid_ref="diamlr_grid_"//clgd, &284 & field_ref=TRIM( slxatt_name1 )//"_"//clgd, enabled=slxatt_enabled, operation="accumulate" )285 CALL xios_set_attr ( slxhdl_fld, name=TRIM( clxatt_name2 )//"."//TRIM( clxatt_name1 ), & 286 & expr="this * "//TRIM( clxatt_fieldref ), grid_ref="diamlr_grid_"//clgd, & 287 & field_ref=TRIM( clxatt_name1 )//"_"//clgd, enabled=llxatt_enabled, operation="accumulate" ) 285 288 CALL xios_get_handle( "diamlr_file_grid_"//clgt, slxhdl_fil ) 286 CALL xios_add_child ( slxhdl_fil, slxhdl_fld, TRIM( slxatt_name2 )//"."//TRIM( slxatt_name1 ) )289 CALL xios_add_child ( slxhdl_fil, slxhdl_fld, TRIM( clxatt_name2 )//"."//TRIM( clxatt_name1 ) ) 287 290 END DO 288 291
Note: See TracChangeset
for help on using the changeset viewer.
