New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 11961 – NEMO

Changeset 11961


Ignore:
Timestamp:
2019-11-25T20:40:46+01:00 (4 years ago)
Author:
smueller
Message:

Adjustments to variable names and overlong lines (ticket #2175)

File:
1 edited

Legend:

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

    r11950 r11961  
    6363      TYPE(xios_field)                            ::   slxhdl_fld 
    6464      TYPE(xios_file)                             ::   slxhdl_fil 
    65       LOGICAL                                     ::   slxatt_enabled 
    66       CHARACTER(LEN=256)                          ::   slxatt_expr 
    67       CHARACTER(LEN=32)                           ::   slxatt_name1,   slxatt_name2 
    68       CHARACTER(LEN=32)                           ::   slxatt_gridref, slxatt_fieldref 
     65      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 
    6969      INTEGER, PARAMETER                          ::   jpscanmax = 999 
    7070      INTEGER                                     ::   ireg, ifld 
     
    155155               ! Retrieve pre-configured value of "enabled" attribute and 
    156156               ! 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 ) 
    158158               ! If enabled, keep handle in list of active regressors; also 
    159159               ! substitute placeholders for tidal frequencies, phases, and 
    160160               ! nodal corrections in regressor expressions 
    161                IF ( slxatt_enabled ) THEN 
     161               IF ( llxatt_enabled ) THEN 
    162162 
    163163                  ! Substitution of placeholders for tidal-constituent 
     
    171171                     ztide_phase = MOD( ztide_u(jn) +  ztide_v(jn) - adatrj * 86400.0_wp * ztide_omega(jn), 2.0_wp * rpi ) 
    172172                     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 ) 
    174174                        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 ) )) 
    177178                     END DO 
    178179                     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 ) 
    180181                        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 ) )) 
    183185                     END DO 
    184186                     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 ) 
    186188                        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 ) )) 
    189192                     END DO 
    190193                  END DO 
     
    193196                  ! with field id to enable id string retrieval from stored handle 
    194197                  ! 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 ) ) 
    196199 
    197200                  ireg = ireg + 1   ! Accept regressor in list of active regressors 
     
    205208               CALL xios_get_handle( "diamlr_f"//cl3i, slxhdl_flds(ifld+1) ) 
    206209               ! 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 ) 
    208211               ! If enabled, keep handle in list of fields selected for analysis 
    209                IF ( slxatt_enabled ) THEN 
     212               IF ( llxatt_enabled ) THEN 
    210213                   
    211214                  ! Set name attribute (and overwrite possible pre-configured name) 
     
    238241            !      3-dimensional versions are simply obtained via grid 
    239242            !      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") 
    245248            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) 
    247250            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) 
    249252 
    250253            !  ii) set up definitions for the output of scalar products with 
    251254            !      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 ) 
    253256            CALL xios_get_handle( "diamlr_file_scalar", slxhdl_fil) 
    254257            DO jn = 1, jm 
    255258               ! 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 ) ) 
    258261               ! Set appropriate name attribute to avoid the possibility of 
    259262               ! using an inappropriate inherited name attribute as the variable 
    260263               ! 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") 
    264267               ! 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 ) ) 
    266269            END DO 
    267270 
     
    269272            !      fields selected for analysis 
    270273            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 ) 
    272275               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" 
    276279               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 ) ) 
    279282               ! Set appropriate name attribute to avoid the possibility of 
    280283               ! using an inappropriate inherited name attribute as the variable 
    281284               ! 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" ) 
    285288               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 ) ) 
    287290            END DO 
    288291 
Note: See TracChangeset for help on using the changeset viewer.