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 11864 for NEMO – NEMO

Changeset 11864 for NEMO


Ignore:
Timestamp:
2019-11-05T23:40:39+01:00 (5 years ago)
Author:
smueller
Message:

Inclusion of string normalisation in subroutine tide_init_components of module tide_mod to permit the selection of tidal constituents irrespective of the capitalisation of their identifiers specified in the namelist (ticket #2194)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r10742_ENHANCE-12_SimonM-Tides/src/OCE/TDE/tide_mod.F90

    r11855 r11864  
    175175      !! information about the selected tidal components 
    176176      !! ---------------------------------------------------------------------- 
    177       CHARACTER(LEN=4),              DIMENSION(jpmax_harmo), INTENT(in)  ::   pcnames         ! Names of selected components 
    178       TYPE(tide),       POINTER,     DIMENSION(:),           INTENT(out) ::   ptide_comp      ! Selected components 
    179       INTEGER,          ALLOCATABLE, DIMENSION(:)                        ::   kcomppos        ! Indices of selected components 
    180       INTEGER                                                            ::   kcomp, jk, ji   ! Miscellaneous integers 
    181       TYPE(tide),       POINTER,     DIMENSION(:)                        ::   tide_components ! All available components 
     177      CHARACTER(LEN=4),              DIMENSION(jpmax_harmo), INTENT(in)  ::   pcnames             ! Names of selected components 
     178      TYPE(tide),       POINTER,     DIMENSION(:),           INTENT(out) ::   ptide_comp          ! Selected components 
     179      INTEGER,          ALLOCATABLE, DIMENSION(:)                        ::   icomppos            ! Indices of selected components 
     180      INTEGER                                                            ::   icomp, jk, jj, ji   ! Miscellaneous integers 
     181      LOGICAL                                                            ::   llmatch             ! Local variables used for 
     182      INTEGER                                                            ::   ic1, ic2            !    string comparison 
     183      TYPE(tide),       POINTER,     DIMENSION(:)                        ::   tide_components     ! All available components 
    182184       
    183185      ! Populate local array with information about all available tidal 
     
    188190      ! include file that contains the initialisation of elements of array 
    189191      ! 'tide_components' 
    190       ALLOCATE(tide_components(jpmax_harmo), kcomppos(jpmax_harmo)) 
     192      ALLOCATE(tide_components(jpmax_harmo), icomppos(jpmax_harmo)) 
    191193      ! Initialise array of indices of the selected componenents 
    192       kcomppos(:) = 0 
     194      icomppos(:) = 0 
    193195      ! Include tidal component parameters for all available components 
    194196      IF (nn_tide_var < 1) THEN 
     
    200202      END IF 
    201203      ! Identify the selected components that are availble 
    202       kcomp = 0 
     204      icomp = 0 
    203205      DO jk = 1, jpmax_harmo 
    204206         IF (TRIM(pcnames(jk)) /= '') THEN 
    205             DO ji = 1, jpmax_harmo 
    206                IF (TRIM(pcnames(jk)) == tide_components(ji)%cname_tide) THEN 
    207                   kcomp = kcomp + 1 
    208                   IF (lwp) WRITE(numout, '(10X,"Tidal component #",I2.2,36X,"= ",A4)') kcomp, pcnames(jk) 
    209                   kcomppos(kcomp) = ji 
     207            DO jj = 1, jpmax_harmo 
     208               ! Find matches between selected and available constituents 
     209               ! (ignore capitalisation unless legacy variant has been selected) 
     210               IF (nn_tide_var < 1) THEN 
     211                  llmatch = (TRIM(pcnames(jk)) == TRIM(tide_components(jj)%cname_tide)) 
     212               ELSE 
     213                  llmatch = .TRUE. 
     214                  ji = MAX(LEN_TRIM(pcnames(jk)), LEN_TRIM(tide_components(jj)%cname_tide)) 
     215                  DO WHILE (llmatch.AND.(ji > 0)) 
     216                     ic1 = IACHAR(pcnames(jk)(ji:ji)) 
     217                     IF ((ic1 >= 97).AND.(ic1 <= 122)) ic1 = ic1 - 32 
     218                     ic2 = IACHAR(tide_components(jj)%cname_tide(ji:ji)) 
     219                     IF ((ic2 >= 97).AND.(ic2 <= 122)) ic2 = ic2 - 32 
     220                     llmatch = (ic1 == ic2) 
     221                     ji = ji - 1 
     222                  END DO 
     223               END IF 
     224               IF (llmatch) THEN 
     225                  ! Count and record the match 
     226                  icomp = icomp + 1 
     227                  icomppos(icomp) = jj 
     228                  ! Set the capitalisation of the tidal constituent identifier 
     229                  ! as specified in the namelist 
     230                  tide_components(jj)%cname_tide = pcnames(jk) 
     231                  IF (lwp) WRITE(numout, '(10X,"Tidal component #",I2.2,36X,"= ",A4)') icomp, tide_components(jj)%cname_tide 
    210232                  EXIT 
    211233               END IF 
    212234            END DO 
     235            IF ((lwp).AND.(jj > jpmax_harmo)) WRITE(numout, '(10X,"Tidal component ",A4," is not available!")') pcnames(jk) 
    213236         END IF 
    214237      END DO 
    215238       
    216239      ! Allocate and populate reduced list of components 
    217       ALLOCATE(ptide_comp(kcomp)) 
    218       DO jk = 1, kcomp 
    219          ptide_comp(jk) = tide_components(kcomppos(jk)) 
     240      ALLOCATE(ptide_comp(icomp)) 
     241      DO jk = 1, icomp 
     242         ptide_comp(jk) = tide_components(icomppos(jk)) 
    220243      END DO 
    221244       
    222245      ! Release local array of available components and list of selected 
    223246      ! components 
    224       DEALLOCATE(tide_components, kcomppos) 
     247      DEALLOCATE(tide_components, icomppos) 
    225248       
    226249   END SUBROUTINE tide_init_components 
Note: See TracChangeset for help on using the changeset viewer.