- Timestamp:
- 2019-11-05T23:40:39+01:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r10742_ENHANCE-12_SimonM-Tides/src/OCE/TDE/tide_mod.F90
r11855 r11864 175 175 !! information about the selected tidal components 176 176 !! ---------------------------------------------------------------------- 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 182 184 183 185 ! Populate local array with information about all available tidal … … 188 190 ! include file that contains the initialisation of elements of array 189 191 ! 'tide_components' 190 ALLOCATE(tide_components(jpmax_harmo), kcomppos(jpmax_harmo))192 ALLOCATE(tide_components(jpmax_harmo), icomppos(jpmax_harmo)) 191 193 ! Initialise array of indices of the selected componenents 192 kcomppos(:) = 0194 icomppos(:) = 0 193 195 ! Include tidal component parameters for all available components 194 196 IF (nn_tide_var < 1) THEN … … 200 202 END IF 201 203 ! Identify the selected components that are availble 202 kcomp = 0204 icomp = 0 203 205 DO jk = 1, jpmax_harmo 204 206 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 210 232 EXIT 211 233 END IF 212 234 END DO 235 IF ((lwp).AND.(jj > jpmax_harmo)) WRITE(numout, '(10X,"Tidal component ",A4," is not available!")') pcnames(jk) 213 236 END IF 214 237 END DO 215 238 216 239 ! Allocate and populate reduced list of components 217 ALLOCATE(ptide_comp( kcomp))218 DO jk = 1, kcomp219 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)) 220 243 END DO 221 244 222 245 ! Release local array of available components and list of selected 223 246 ! components 224 DEALLOCATE(tide_components, kcomppos)247 DEALLOCATE(tide_components, icomppos) 225 248 226 249 END SUBROUTINE tide_init_components
Note: See TracChangeset
for help on using the changeset viewer.