- Timestamp:
- 2018-01-06T15:18:23+01:00 (6 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2017/dev_merge_2017/NEMOGCM/NEMO/OPA_SRC/ICB/icbdyn.F90
r5215 r9190 1 1 MODULE icbdyn 2 3 2 !!====================================================================== 4 3 !! *** MODULE icbdyn *** 5 4 !! Iceberg: time stepping routine for iceberg tracking 6 5 !!====================================================================== 7 !! History : 3.3.1 ! 2010-01 (Martin&Adcroft) Original code 8 !! - ! 2011-03 (Madec) Part conversion to NEMO form 9 !! - ! Removal of mapping from another grid 10 !! - ! 2011-04 (Alderson) Split into separate modules 11 !! - ! 2011-05 (Alderson) Replace broken grounding routine 12 !! - ! with one of Gurvan's suggestions (just like 13 !! - ! the broken one) 6 !! History : 3.3 ! 2010-01 (Martin&Adcroft) Original code 7 !! - ! 2011-03 (Madec) Part conversion to NEMO form 8 !! - ! Removal of mapping from another grid 9 !! - ! 2011-04 (Alderson) Split into separate modules 10 !! - ! 2011-05 (Alderson) Replace broken grounding routine with one of 11 !! - ! Gurvan's suggestions (just like the broken one) 14 12 !!---------------------------------------------------------------------- 15 13 USE par_oce ! NEMO parameters … … 41 39 !! ** Method : - See Martin & Adcroft, Ocean Modelling 34, 2010 42 40 !!---------------------------------------------------------------------- 43 REAL(wp) :: zuvel1 , zvvel1 , zu1, zv1, zax1, zay1, zxi1 , zyj1 44 REAL(wp) :: zuvel2 , zvvel2 , zu2, zv2, zax2, zay2, zxi2 , zyj2 45 REAL(wp) :: zuvel3 , zvvel3 , zu3, zv3, zax3, zay3, zxi3 , zyj3 46 REAL(wp) :: zuvel4 , zvvel4 , zu4, zv4, zax4, zay4, zxi4 , zyj4 47 REAL(wp) :: zuvel_n, zvvel_n, zxi_n , zyj_n 48 REAL(wp) :: zdt, zdt_2, zdt_6, ze1, ze2 49 LOGICAL :: ll_bounced 50 TYPE(iceberg), POINTER :: berg 51 TYPE(point) , POINTER :: pt 52 INTEGER :: kt 53 !!---------------------------------------------------------------------- 54 41 INTEGER, INTENT(in) :: kt ! 42 ! 43 LOGICAL :: ll_bounced 44 REAL(wp) :: zuvel1 , zvvel1 , zu1, zv1, zax1, zay1, zxi1 , zyj1 45 REAL(wp) :: zuvel2 , zvvel2 , zu2, zv2, zax2, zay2, zxi2 , zyj2 46 REAL(wp) :: zuvel3 , zvvel3 , zu3, zv3, zax3, zay3, zxi3 , zyj3 47 REAL(wp) :: zuvel4 , zvvel4 , zu4, zv4, zax4, zay4, zxi4 , zyj4 48 REAL(wp) :: zuvel_n, zvvel_n, zxi_n , zyj_n 49 REAL(wp) :: zdt, zdt_2, zdt_6, ze1, ze2 50 TYPE(iceberg), POINTER :: berg 51 TYPE(point) , POINTER :: pt 52 !!---------------------------------------------------------------------- 53 ! 55 54 ! 4th order Runge-Kutta to solve: d/dt X = V, d/dt V = A 56 55 ! with I.C.'s: X=X1 and V=V1 … … 75 74 pt => berg%current_point 76 75 77 ll_bounced = . false.76 ll_bounced = .FALSE. 78 77 79 78 … … 99 98 ! 100 99 CALL icb_ground( zxi2, zxi1, zu1, & 101 &zyj2, zyj1, zv1, ll_bounced )100 & zyj2, zyj1, zv1, ll_bounced ) 102 101 103 102 ! !** A2 = A(X2,V2) … … 115 114 ! 116 115 CALL icb_ground( zxi3, zxi1, zu3, & 117 & zyj3, zyj1, zv3, ll_bounced )116 & zyj3, zyj1, zv3, ll_bounced ) 118 117 119 118 ! !** A3 = A(X3,V3) … … 131 130 132 131 CALL icb_ground( zxi4, zxi1, zu4, & 133 &zyj4, zyj1, zv4, ll_bounced )132 & zyj4, zyj1, zv4, ll_bounced ) 134 133 135 134 ! !** A4 = A(X4,V4) … … 150 149 151 150 CALL icb_ground( zxi_n, zxi1, zuvel_n, & 152 &zyj_n, zyj1, zvvel_n, ll_bounced )151 & zyj_n, zyj1, zvvel_n, ll_bounced ) 153 152 154 153 pt%uvel = zuvel_n !** save in berg structure … … 169 168 170 169 SUBROUTINE icb_ground( pi, pi0, pu, & 171 & 170 & pj, pj0, pv, ld_bounced ) 172 171 !!---------------------------------------------------------------------- 173 172 !! *** ROUTINE icb_ground *** … … 216 215 ibounce_method = 2 217 216 SELECT CASE ( ibounce_method ) 218 219 220 221 222 223 224 225 226 227 228 229 230 231 217 CASE ( 1 ) 218 pi = pi0 219 pj = pj0 220 pu = 0._wp 221 pv = 0._wp 222 CASE ( 2 ) 223 IF( ii0 /= ii ) THEN 224 pi = pi0 ! return back to the initial position 225 pu = 0._wp ! zeroing of velocity in the direction of the grounding 226 ENDIF 227 IF( ij0 /= ij ) THEN 228 pj = pj0 ! return back to the initial position 229 pv = 0._wp ! zeroing of velocity in the direction of the grounding 230 ENDIF 232 231 END SELECT 233 232 ! … … 259 258 ! 260 259 INTEGER :: itloop 261 REAL(wp) :: zuo, zvo, zui, zvi, zua, zva, zuwave, zvwave, zssh_x, zssh_y, zsst, zcn, zhi 260 REAL(wp) :: zuo, zui, zua, zuwave, zssh_x, zsst, zcn, zhi 261 REAL(wp) :: zvo, zvi, zva, zvwave, zssh_y 262 262 REAL(wp) :: zff, zT, zD, zW, zL, zM, zF 263 263 REAL(wp) :: zdrag_ocn, zdrag_atm, zdrag_ice, zwave_rad … … 339 339 zaxe = zaxe - zdrag_ocn*(puvel -zuo) - zdrag_atm*(puvel -zua) -zdrag_ice*(puvel -zui) 340 340 zaye = zaye - zdrag_ocn*(pvvel -zvo) - zdrag_atm*(pvvel -zva) -zdrag_ice*(pvvel -zvi) 341 endif341 ENDIF 342 342 343 343 ! Solve for implicit accelerations … … 349 349 pax = zdetA * ( zA11*zaxe + zA12*zaye ) 350 350 pay = zdetA * ( zA11*zaye - zA12*zaxe ) 351 else351 ELSE 352 352 pax = zaxe ; pay = zaye 353 endif353 ENDIF 354 354 355 355 zuveln = puvel0 + pdt*pax … … 362 362 IF( zspeed > 0._wp ) THEN 363 363 zloc_dx = MIN( pe1, pe2 ) ! minimum grid spacing 364 zspeed_new = zloc_dx / pdt * rn_speed_limit ! Speed limit as a factor of dx / dt364 zspeed_new = zloc_dx / pdt * rn_speed_limit ! Speed limit as a factor of dx / dt 365 365 IF( zspeed_new < zspeed ) THEN 366 366 zuveln = zuveln * ( zspeed_new / zspeed ) ! Scale velocity to reduce speed
Note: See TracChangeset
for help on using the changeset viewer.
