- Timestamp:
- 2019-03-29T13:54:25+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
r10800 r10811 21 21 PUBLIC tide_init 22 22 PUBLIC tide_harmo ! called by tideini and diaharm modules 23 PUBLIC tide_init_ Wave ! called by tideini and diaharm modules23 PUBLIC tide_init_components ! called internally and by module diaharm 24 24 PUBLIC tide_init_load 25 25 PUBLIC tide_init_potential 26 26 PUBLIC upd_tide ! called in dynspg_... modules 27 27 28 INTEGER, PUBLIC, PARAMETER :: jpmax_harmo = 19 !: maximum number of harmonic28 INTEGER, PUBLIC, PARAMETER :: jpmax_harmo = 64 !: maximum number of harmonic components 29 29 30 30 TYPE, PUBLIC :: tide 31 CHARACTER(LEN=4) :: cname_tide 31 CHARACTER(LEN=4) :: cname_tide = '' 32 32 REAL(wp) :: equitide 33 33 INTEGER :: nutide … … 37 37 END TYPE tide 38 38 39 TYPE(tide), PUBLIC, DIMENSION( jpmax_harmo) :: Wave !:39 TYPE(tide), PUBLIC, DIMENSION(:), POINTER :: tide_components !: Array of selected tidal component parameters 40 40 41 41 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:) :: omega_tide !: … … 49 49 LOGICAL , PUBLIC :: ln_scal_load !: 50 50 LOGICAL , PUBLIC :: ln_tide_ramp !: 51 INTEGER , PUBLIC :: nb_harmo !: 51 INTEGER , PUBLIC :: nb_harmo !: Number of active tidal components 52 52 INTEGER , PUBLIC :: kt_tide !: 53 53 REAL(wp), PUBLIC :: rn_tide_ramp_dt !: … … 55 55 CHARACTER(lc), PUBLIC :: cn_tide_load !: 56 56 REAL(wp) :: rn_tide_gamma ! Tidal tilt factor 57 58 INTEGER , PUBLIC, ALLOCATABLE, DIMENSION(:) :: ntide !:59 57 60 58 REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: pot_astro !: tidal potential … … 79 77 !!---------------------------------------------------------------------- 80 78 INTEGER :: ji, jk 81 CHARACTER(LEN=4), DIMENSION(jpmax_harmo) :: sn_tide_cnames 79 CHARACTER(LEN=4), DIMENSION(jpmax_harmo) :: sn_tide_cnames ! Names of selected tidal components 82 80 INTEGER :: ios ! Local integer output status for namelist read 83 81 ! … … 86 84 !!---------------------------------------------------------------------- 87 85 ! 86 ! Initialise all array elements of sn_tide_cnames, as some of them 87 ! typically do not appear in namelist_ref or namelist_cfg 88 sn_tide_cnames(:) = '' 88 89 ! Read Namelist nam_tide 89 90 REWIND( numnam_ref ) ! Namelist nam_tide in reference namelist : Tides … … 120 121 ENDIF 121 122 ! 122 CALL tide_init_Wave 123 ! 124 nb_harmo=0 125 DO jk = 1, jpmax_harmo 126 DO ji = 1,jpmax_harmo 127 IF( TRIM(sn_tide_cnames(jk)) == Wave(ji)%cname_tide ) nb_harmo = nb_harmo + 1 128 END DO 129 END DO 123 ! Initialise array of selected tidal components 124 CALL tide_init_components(sn_tide_cnames, tide_components) 125 ! Number of active tidal components 126 nb_harmo = size(tide_components) 130 127 ! 131 128 ! Ensure that tidal components have been set in namelist_cfg … … 143 140 & CALL ctl_stop('rn_tide_ramp_dt must be positive') 144 141 ! 145 ALLOCATE( ntide(nb_harmo) )146 DO jk = 1, nb_harmo147 DO ji = 1, jpmax_harmo148 IF( TRIM(sn_tide_cnames(jk)) == Wave(ji)%cname_tide ) THEN149 ntide(jk) = ji150 EXIT151 ENDIF152 END DO153 END DO154 !155 142 ALLOCATE( omega_tide(nb_harmo), v0tide (nb_harmo), & 156 143 & utide (nb_harmo), ftide (nb_harmo) ) … … 168 155 169 156 170 SUBROUTINE tide_init_Wave 171 # include "tide.h90" 172 END SUBROUTINE tide_init_Wave 157 SUBROUTINE tide_init_components(pcnames, ptide_comp) 158 !!---------------------------------------------------------------------- 159 !! *** ROUTINE tide_init_components *** 160 !! 161 !! Returns pointer to array of variables of type 'tide' that contain 162 !! information about the selected tidal components 163 !! ---------------------------------------------------------------------- 164 CHARACTER(LEN=4), DIMENSION(jpmax_harmo), INTENT(in) :: pcnames ! Names of selected components 165 TYPE(tide), POINTER, DIMENSION(:), INTENT(out) :: ptide_comp ! Selected components 166 INTEGER, ALLOCATABLE, DIMENSION(:) :: kcomppos ! Indices of selected components 167 INTEGER :: kcomp, jk, ji ! Miscellaneous integers 168 TYPE(tide), POINTER, DIMENSION(:) :: tide_components ! All available components 169 170 ! Populate local array with information about all available tidal 171 ! components 172 ! 173 ! Note, here 'tide_components' locally overrides the global module 174 ! variable of the same name to enable the use of the global name in the 175 ! include file that contains the initialisation of elements of array 176 ! 'tide_components' 177 ALLOCATE(tide_components(jpmax_harmo), kcomppos(jpmax_harmo)) 178 ! Initialise array of indices of the selected componenents 179 kcomppos(:) = 0 180 ! Include tidal component parameters for all available components 181 #include "tide.h90" 182 183 ! Identify the selected components that are availble 184 kcomp = 0 185 DO jk = 1, jpmax_harmo 186 IF (TRIM(pcnames(jk)) /= '') THEN 187 DO ji = 1, jpmax_harmo 188 IF (TRIM(pcnames(jk)) == tide_components(ji)%cname_tide) THEN 189 kcomp = kcomp + 1 190 WRITE(numout, '(10X,"Tidal component #",I2.2,36X,"= ",A4)') kcomp, pcnames(jk) 191 kcomppos(kcomp) = ji 192 EXIT 193 END IF 194 END DO 195 END IF 196 END DO 197 198 ! Allocate and populate reduced list of components 199 ALLOCATE(ptide_comp(kcomp)) 200 DO jk = 1, kcomp 201 ptide_comp(jk) = tide_components(kcomppos(jk)) 202 END DO 203 204 ! Release local array of available components and list of selected 205 ! components 206 DEALLOCATE(tide_components, kcomppos) 207 208 END SUBROUTINE tide_init_components 173 209 174 210 … … 182 218 183 219 DO jk = 1, nb_harmo 184 zcons = rn_tide_gamma * Wave(ntide(jk))%equitide * ftide(jk)220 zcons = rn_tide_gamma * tide_components(jk)%equitide * ftide(jk) 185 221 DO ji = 1, jpi 186 222 DO jj = 1, jpj … … 189 225 zlat = gphit(ji,jj)*rad !! latitude en radian 190 226 zlon = glamt(ji,jj)*rad !! longitude en radian 191 ztmp = v0tide(jk) + utide(jk) + Wave(ntide(jk))%nutide * zlon227 ztmp = v0tide(jk) + utide(jk) + tide_components(jk)%nutide * zlon 192 228 ! le potentiel est composé des effets des astres: 193 IF ( Wave(ntide(jk))%nutide == 1 ) THEN ; zcs = zcons * SIN( 2._wp*zlat )194 ELSEIF( Wave(ntide(jk))%nutide == 2 ) THEN ; zcs = zcons * COS( zlat )**2229 IF ( tide_components(jk)%nutide == 1 ) THEN ; zcs = zcons * SIN( 2._wp*zlat ) 230 ELSEIF( tide_components(jk)%nutide == 2 ) THEN ; zcs = zcons * COS( zlat )**2 195 231 ELSE ; zcs = 0._wp 196 232 ENDIF … … 225 261 ! 226 262 DO itide = 1, nb_harmo 227 CALL iom_get ( inum, jpdom_data,TRIM( Wave(ntide(itide))%cname_tide)//'_z1', ztr(:,:) )228 CALL iom_get ( inum, jpdom_data,TRIM( Wave(ntide(itide))%cname_tide)//'_z2', zti(:,:) )263 CALL iom_get ( inum, jpdom_data,TRIM(tide_components(itide)%cname_tide)//'_z1', ztr(:,:) ) 264 CALL iom_get ( inum, jpdom_data,TRIM(tide_components(itide)%cname_tide)//'_z2', zti(:,:) ) 229 265 ! 230 266 DO ji=1,jpi … … 241 277 242 278 243 SUBROUTINE tide_harmo( pomega, pvt, put , pcor, ktide ,kc) 244 !!---------------------------------------------------------------------- 245 !!---------------------------------------------------------------------- 246 INTEGER , DIMENSION(kc), INTENT(in ) :: ktide ! Indice of tidal constituents 279 SUBROUTINE tide_harmo( pomega, pvt, put , pcor, kc) 280 !!---------------------------------------------------------------------- 281 !!---------------------------------------------------------------------- 247 282 INTEGER , INTENT(in ) :: kc ! Total number of tidal constituents 248 283 REAL(wp), DIMENSION(kc), INTENT(out) :: pomega ! pulsation in radians/s … … 251 286 ! 252 287 CALL astronomic_angle 253 CALL tide_pulse( pomega, k tide ,kc )254 CALL tide_vuf ( pvt, put, pcor, k tide ,kc )288 CALL tide_pulse( pomega, kc ) 289 CALL tide_vuf ( pvt, put, pcor, kc ) 255 290 ! 256 291 END SUBROUTINE tide_harmo … … 348 383 349 384 350 SUBROUTINE tide_pulse( pomega, k tide ,kc )385 SUBROUTINE tide_pulse( pomega, kc ) 351 386 !!---------------------------------------------------------------------- 352 387 !! *** ROUTINE tide_pulse *** … … 355 390 !!---------------------------------------------------------------------- 356 391 INTEGER , INTENT(in ) :: kc ! Total number of tidal constituents 357 INTEGER , DIMENSION(kc), INTENT(in ) :: ktide ! Indice of tidal constituents358 392 REAL(wp), DIMENSION(kc), INTENT(out) :: pomega ! pulsation in radians/s 359 393 ! … … 371 405 ! 372 406 DO jh = 1, kc 373 pomega(jh) = ( zomega_T * Wave( ktide(jh))%nT &374 & + zomega_s * Wave( ktide(jh))%ns &375 & + zomega_h * Wave( ktide(jh))%nh &376 & + zomega_p * Wave( ktide(jh))%np &377 & + zomega_p1* Wave( ktide(jh))%np1 ) * zscale407 pomega(jh) = ( zomega_T * tide_components( jh )%nT & 408 & + zomega_s * tide_components( jh )%ns & 409 & + zomega_h * tide_components( jh )%nh & 410 & + zomega_p * tide_components( jh )%np & 411 & + zomega_p1* tide_components( jh )%np1 ) * zscale 378 412 END DO 379 413 ! … … 381 415 382 416 383 SUBROUTINE tide_vuf( pvt, put, pcor, k tide ,kc )417 SUBROUTINE tide_vuf( pvt, put, pcor, kc ) 384 418 !!---------------------------------------------------------------------- 385 419 !! *** ROUTINE tide_vuf *** … … 392 426 !!---------------------------------------------------------------------- 393 427 INTEGER , INTENT(in ) :: kc ! Total number of tidal constituents 394 INTEGER , DIMENSION(kc), INTENT(in ) :: ktide ! Indice of tidal constituents395 428 REAL(wp), DIMENSION(kc), INTENT(out) :: pvt, put, pcor ! 396 429 ! … … 401 434 ! Phase of the tidal potential relative to the Greenwhich 402 435 ! meridian (e.g. the position of the fictuous celestial body). Units are radian: 403 pvt(jh) = sh_T * Wave( ktide(jh))%nT &404 & + sh_s * Wave( ktide(jh))%ns &405 & + sh_h * Wave( ktide(jh))%nh &406 & + sh_p * Wave( ktide(jh))%np &407 & + sh_p1* Wave( ktide(jh))%np1 &408 & + Wave( ktide(jh))%shift * rad436 pvt(jh) = sh_T * tide_components( jh )%nT & 437 & + sh_s * tide_components( jh )%ns & 438 & + sh_h * tide_components( jh )%nh & 439 & + sh_p * tide_components( jh )%np & 440 & + sh_p1* tide_components( jh )%np1 & 441 & + tide_components( jh )%shift * rad 409 442 ! 410 443 ! Phase correction u due to nodal motion. Units are radian: 411 put(jh) = sh_xi * Wave( ktide(jh))%nksi &412 & + sh_nu * Wave( ktide(jh))%nnu0 &413 & + sh_nuprim * Wave( ktide(jh))%nnu1 &414 & + sh_nusec * Wave( ktide(jh))%nnu2 &415 & + sh_R * Wave( ktide(jh))%R444 put(jh) = sh_xi * tide_components( jh )%nksi & 445 & + sh_nu * tide_components( jh )%nnu0 & 446 & + sh_nuprim * tide_components( jh )%nnu1 & 447 & + sh_nusec * tide_components( jh )%nnu2 & 448 & + sh_R * tide_components( jh )%R 416 449 417 450 ! Nodal correction factor: 418 pcor(jh) = nodal_factort( Wave( ktide(jh))%nformula )451 pcor(jh) = nodal_factort( tide_components( jh )%nformula ) 419 452 END DO 420 453 !
Note: See TracChangeset
for help on using the changeset viewer.