Changeset 367
- Timestamp:
- 2005-12-28T10:25:10+01:00 (19 years ago)
- Location:
- trunk/NEMO/OPA_SRC
- Files:
-
- 3 added
- 22 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/DOM/dommsk.F90
r359 r367 18 18 USE lib_mpp 19 19 USE solisl ! ??? 20 USE dynspg 20 USE dynspg_oce ! choice/control of key cpp for surface pressure gradient 21 21 22 22 IMPLICIT NONE -
trunk/NEMO/OPA_SRC/DYN/dynnxt.F90
r359 r367 12 12 USE dom_oce ! ocean space and time domain 13 13 USE in_out_manager ! I/O manager 14 USE obc_oce ! ocean open boundary conditions 14 15 USE obcdyn ! open boundary condition for momentum (obc_dyn routine) 16 USE obcdyn_bt ! 2D open boundary condition for momentum (obc_dyn_bt routine) 17 USE obcvol ! ocean open boundary condition (obc_vol routines) 18 USE dynspg_oce ! type of surface pressure gradient 15 19 USE lbclnk ! lateral boundary condition (or mpp link) 16 20 USE prtctl ! Print control … … 105 109 ! Update (ua,va) along open boundaries (only in the rigid-lid case) 106 110 CALL obc_dyn( kt ) 111 112 IF ( lk_dynspg_exp .OR. lk_dynspg_ts ) THEN 113 !Flather boundary condition : 114 ! - Update sea surface height on each open boundary 115 ! sshn (= after ssh) for explicit case 116 ! sshn_b (= after ssha_b) for time-splitting case 117 ! - Correct the barotropic velocities 118 CALL obc_dyn_bt( kt ) 119 120 !Boundary conditions on sshn ( after ssh) 121 CALL lbc_lnk( sshn, 'T', 1. ) 122 123 IF(ln_ctl) THEN ! print sum trends (used for debugging) 124 CALL prt_ctl(tab2d_1=sshn, clinfo1=' ssh : ', mask1=tmask) 125 ENDIF 126 127 IF ( ln_vol_cst ) CALL obc_vol( kt ) 128 129 ENDIF 130 107 131 ! ! =============== 108 132 DO jk = 1, jpkm1 ! Horizontal slab -
trunk/NEMO/OPA_SRC/DYN/dynspg.F90
r359 r367 12 12 USE oce ! ocean dynamics and tracers variables 13 13 USE dom_oce ! ocean space and time domain variables 14 USE obc_oce ! ocean open boundary conditions 15 USE dynspg_oce ! surface pressure gradient variables 14 16 USE dynspg_exp ! surface pressure gradient (dyn_spg_exp routine) 15 17 USE dynspg_ts ! surface pressure gradient (dyn_spg_ts routine) … … 27 29 !! * Accessibility 28 30 PUBLIC dyn_spg ! routine called by step module 29 30 !! * Public variables31 #if defined key_dynspg_exp || defined key_esopa32 LOGICAL, PUBLIC, PARAMETER :: lk_dynspg_exp = .TRUE. !: Explicit free surface flag33 #else34 LOGICAL, PUBLIC, PARAMETER :: lk_dynspg_exp = .FALSE. !: Explicit free surface flag35 #endif36 #if defined key_dynspg_ts || defined key_esopa37 LOGICAL, PUBLIC, PARAMETER :: lk_dynspg_ts = .TRUE. !: Free surface with time splitting flag38 #else39 LOGICAL, PUBLIC, PARAMETER :: lk_dynspg_ts = .FALSE. !: Free surface with time splitting flag40 #endif41 #if defined key_dynspg_flt || defined key_esopa42 LOGICAL, PUBLIC, PARAMETER :: lk_dynspg_flt = .TRUE. !: Filtered free surface cst volume flag43 #else44 LOGICAL, PUBLIC, PARAMETER :: lk_dynspg_flt = .FALSE. !: Filtered free surface cst volume flag45 #endif46 #if defined key_dynspg_rl47 LOGICAL, PUBLIC, PARAMETER :: lk_dynspg_rl = .TRUE. !: Rigid-lid flag48 #else49 LOGICAL, PUBLIC, PARAMETER :: lk_dynspg_rl = .FALSE. !: Rigid-lid flag50 #endif51 31 52 32 !! * module variables … … 208 188 ENDIF 209 189 190 #if key_obc 191 ! Conservation of ocean volume (key_dynspg_flt) 192 ! --------------------------------------------- 193 IF( lk_dynspg_flt ) ln_vol_cst = .true. 194 195 ! Application of Flather's algorithm at open boundaries 196 ! ----------------------------------------------------- 197 IF( lk_dynspg_flt ) ln_obc_fla = .false. 198 IF( lk_dynspg_exp ) ln_obc_fla = .true. 199 IF( lk_dynspg_ts ) ln_obc_fla = .true. 200 #endif 201 210 202 END SUBROUTINE dyn_spg_ctl 211 203 -
trunk/NEMO/OPA_SRC/DYN/dynspg_exp.F90
r359 r367 20 20 USE ocesbc ! ocean surface boundary condition 21 21 USE obc_oce ! Lateral open boundary condition 22 USE obcdta ! open boundary condition data (obc_dta_bt routine) 22 23 USE lib_mpp ! distributed memory computing library 23 24 USE lbclnk ! ocean lateral boundary conditions (or mpp link) … … 101 102 ENDIF 102 103 103 ! 0. Local constant initialization 104 ! -------------------------------- 104 ! 0. Initialization 105 ! ----------------- 106 ! read or estimate sea surface height and vertically integrated velocities 107 IF( lk_obc ) CALL obc_dta_bt( kt, 0 ) 105 108 z2dt = 2. * rdt ! time step: leap-frog 106 109 IF( neuler == 0 .AND. kt == nit000 ) z2dt = rdt ! time step: Euler if restart from rest … … 179 182 ENDIF 180 183 181 ! Boundary conditions on sshn182 CALL lbc_lnk( sshn, 'T', 1. )184 ! Boundary conditions on sshn 185 IF( .NOT. lk_obc ) CALL lbc_lnk( sshn, 'T', 1. ) 183 186 184 187 IF(ln_ctl) THEN ! print sum trends (used for debugging) -
trunk/NEMO/OPA_SRC/DYN/dynspg_ts.F90
r363 r367 17 17 USE phycst ! physical constants 18 18 USE ocesbc ! ocean surface boundary condition 19 USE obcdta ! open boundary condition data 20 USE obcfla ! Flather open boundary condition 19 21 USE dynvor ! vorticity term 20 22 USE obc_oce ! Lateral open boundary condition … … 22 24 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 23 25 USE prtctl ! Print control 26 USE dynspg_oce ! surface pressure gradient variables 24 27 USE in_out_manager ! I/O manager 25 28 … … 29 32 !! * Accessibility 30 33 PUBLIC dyn_spg_ts ! routine called by step.F90 31 32 !! * Module variables33 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: & ! variables averaged over the barotropic loop34 sshn_b, sshb_b, & ! sea surface heigth (now, before)35 un_b , vn_b ! vertically integrated horizontal velocities (now)36 34 37 35 !! * Substitutions … … 61 59 !! surface gradient and the Coriolis force are updated within 62 60 !! the barotropic integration. 63 !! -2- Barotropic loop : updates of sea surface height ( zssha_e) and64 !! barotropic transports ( zua_e and zva_e) through barotropic61 !! -2- Barotropic loop : updates of sea surface height (ssha_e) and 62 !! barotropic transports (ua_e and va_e) through barotropic 65 63 !! momentum and continuity integration. Barotropic former 66 64 !! variables are time averaging over the full barotropic cycle … … 97 95 zssha_b, zua_b, zva_b, & ! " " 98 96 zsshb_e, zub_e, zvb_e, & ! " " 99 zsshn_e, zun_e, zvn_e, & ! " " 100 zssha_e, zua_e, zva_e ! " " 97 zun_e, zvn_e ! " " 101 98 REAL(wp), DIMENSION(jpi,jpj),SAVE :: & 102 99 ztnw, ztne, ztsw, ztse … … 105 102 ! Arrays initialization 106 103 ! --------------------- 107 zua_b(:,:) = 0.e0 ; zub_e(:,:) = 0.e0 ; zun_e(:,:) = 0.e0 ; zua_e(:,:) = 0.e0108 zva_b(:,:) = 0.e0 ; zvb_e(:,:) = 0.e0 ; zvn_e(:,:) = 0.e0 ; zva_e(:,:) = 0.e0104 zua_b(:,:) = 0.e0 ; zub_e(:,:) = 0.e0 ; zun_e(:,:) = 0.e0 105 zva_b(:,:) = 0.e0 ; zvb_e(:,:) = 0.e0 ; zvn_e(:,:) = 0.e0 109 106 zhdiv(:,:) = 0.e0 110 107 … … 138 135 ENDIF 139 136 ENDIF 140 zssha_e(:,:) = sshn(:,:)141 zua_e (:,:)= un_b(:,:)142 zva_e (:,:)= vn_b(:,:)137 ssha_e(:,:) = sshn(:,:) 138 ua_e(:,:) = un_b(:,:) 139 va_e(:,:) = vn_b(:,:) 143 140 144 141 IF( ln_dynvor_een ) THEN … … 278 275 ! variables for the barotropic equations 279 276 zsshb_e(:,:) = sshn_b(:,:) ! (barotropic) sea surface height (before and now) 280 zsshn_e(:,:) = sshn_b(:,:) 281 zub_e(:,:) = un_b(:,:) ! barotropic transports issued from the barotropic equations (before and now) 282 zvb_e(:,:) = vn_b(:,:) 283 zun_e(:,:) = un_b(:,:) 284 zvn_e(:,:) = vn_b(:,:) 285 zssha_b(:,:) = sshn(:,:) ! time averaged variables over all sub-timesteps 286 zua_b(:,:) = un_b(:,:) 287 zva_b(:,:) = vn_b(:,:) 277 sshn_e (:,:) = sshn_b(:,:) 278 zub_e (:,:) = un_b (:,:) ! barotropic transports issued from the barotropic equations (before and now) 279 zvb_e (:,:) = vn_b (:,:) 280 zun_e (:,:) = un_b (:,:) 281 zvn_e (:,:) = vn_b (:,:) 282 zssha_b(:,:) = sshn (:,:) ! time averaged variables over all sub-timesteps 283 zua_b (:,:) = un_b (:,:) 284 zva_b (:,:) = vn_b (:,:) 285 286 ! set ssh corrections to 0 287 ! ssh corrections are applied to normal velocities (Flather's algorithm) and averaged over the barotropic loop 288 #if defined key_obc 289 IF( lp_obc_east ) sshfoe_b(:,:) = 0.e0 290 IF( lp_obc_west ) sshfow_b(:,:) = 0.e0 291 IF( lp_obc_south ) sshfos_b(:,:) = 0.e0 292 IF( lp_obc_north ) sshfon_b(:,:) = 0.e0 293 #endif 288 294 289 295 ! Barotropic integration over 2 baroclinic time steps … … 296 302 z2dt_e = 2. * rdtbt 297 303 IF ( jit == 1 ) z2dt_e = rdtbt 304 305 ! Time interpolation of open boundary condition data 306 IF( lk_obc ) CALL obc_dta_bt( kt, jit ) 298 307 299 308 ! Horizontal divergence of barotropic transports … … 312 321 ! open boundaries (div must be zero behind the open boundary) 313 322 ! mpp remark: The zeroing of hdiv can probably be extended to 1->jpi/jpj for the correct row/column 314 IF( lp_obc_east ) zhdiv(nie0p1:nie1p1,nje0 :nje1) = 0.e0 ! east315 IF( lp_obc_west ) zhdiv(niw0 :niw1 ,njw0 :njw1) = 0.e0 ! west316 IF( lp_obc_north ) zhdiv(nin0 :nin1 ,njn0p1:njn1p1) = 0.e0 ! north317 IF( lp_obc_south ) zhdiv(nis0 :nis1 ,njs0 :njs1) = 0.e0 ! south323 IF( lp_obc_east ) zhdiv(nie0p1:nie1p1,nje0 :nje1) = 0.e0 ! east 324 IF( lp_obc_west ) zhdiv(niw0 :niw1 ,njw0 :njw1) = 0.e0 ! west 325 IF( lp_obc_north ) zhdiv(nin0 :nin1 ,njn0p1:njn1p1) = 0.e0 ! north 326 IF( lp_obc_south ) zhdiv(nis0 :nis1 ,njs0 :njs1) = 0.e0 ! south 318 327 #endif 319 328 … … 322 331 DO jj = 2, jpjm1 323 332 DO ji = fs_2, fs_jpim1 ! vector opt. 324 zssha_e(ji,jj) = ( zsshb_e(ji,jj) - z2dt_e * ( zraur * emp(ji,jj) &333 ssha_e(ji,jj) = ( zsshb_e(ji,jj) - z2dt_e * ( zraur * emp(ji,jj) & 325 334 & + zhdiv(ji,jj) ) ) * tmask(ji,jj,1) 326 335 END DO … … 336 345 DO ji = fs_2, fs_jpim1 ! vector opt. 337 346 ! surface pressure gradient 338 zspgu = -grav * ( zsshn_e(ji+1,jj) - zsshn_e(ji,jj) ) * hu(ji,jj) / e1u(ji,jj)339 zspgv = -grav * ( zsshn_e(ji,jj+1) - zsshn_e(ji,jj) ) * hv(ji,jj) / e2v(ji,jj)347 zspgu = -grav * ( sshn_e(ji+1,jj) - sshn_e(ji,jj) ) * hu(ji,jj) / e1u(ji,jj) 348 zspgv = -grav * ( sshn_e(ji,jj+1) - sshn_e(ji,jj) ) * hv(ji,jj) / e2v(ji,jj) 340 349 ! energy conserving formulation for planetary vorticity term 341 350 zy1 = ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) ) / e1u(ji,jj) … … 346 355 zcvbt =-zfact2 * ( ff(ji-1,jj ) * zx1 + ff(ji,jj) * zx2 ) 347 356 ! after transports 348 zua_e(ji,jj) = ( zub_e(ji,jj) + z2dt_e * ( zcubt + zspgu + zua(ji,jj) ) ) * umask(ji,jj,1)349 zva_e(ji,jj) = ( zvb_e(ji,jj) + z2dt_e * ( zcvbt + zspgv + zva(ji,jj) ) ) * vmask(ji,jj,1)357 ua_e(ji,jj) = ( zub_e(ji,jj) + z2dt_e * ( zcubt + zspgu + zua(ji,jj) ) ) * umask(ji,jj,1) 358 va_e(ji,jj) = ( zvb_e(ji,jj) + z2dt_e * ( zcvbt + zspgv + zva(ji,jj) ) ) * vmask(ji,jj,1) 350 359 END DO 351 360 END DO … … 355 364 DO ji = fs_2, fs_jpim1 ! vector opt. 356 365 ! surface pressure gradient 357 zspgu = -grav * ( zsshn_e(ji+1,jj) - zsshn_e(ji,jj) ) * hu(ji,jj) / e1u(ji,jj)358 zspgv = -grav * ( zsshn_e(ji,jj+1) - zsshn_e(ji,jj) ) * hv(ji,jj) / e2v(ji,jj)366 zspgu = -grav * ( sshn_e(ji+1,jj) - sshn_e(ji,jj) ) * hu(ji,jj) / e1u(ji,jj) 367 zspgv = -grav * ( sshn_e(ji,jj+1) - sshn_e(ji,jj) ) * hv(ji,jj) / e2v(ji,jj) 359 368 ! enstrophy conserving formulation for planetary vorticity term 360 369 zy1 = zfact1 * ( zwy(ji ,jj-1) + zwy(ji+1,jj-1) & … … 365 374 zcvbt = zx1 * ( ff(ji-1,jj ) + ff(ji,jj) ) 366 375 ! after transports 367 zua_e(ji,jj) = ( zub_e(ji,jj) + z2dt_e * ( zcubt + zspgu + zua(ji,jj) ) ) * umask(ji,jj,1)368 zva_e(ji,jj) = ( zvb_e(ji,jj) + z2dt_e * ( zcvbt + zspgv + zva(ji,jj) ) ) * vmask(ji,jj,1)376 ua_e(ji,jj) = ( zub_e(ji,jj) + z2dt_e * ( zcubt + zspgu + zua(ji,jj) ) ) * umask(ji,jj,1) 377 va_e(ji,jj) = ( zvb_e(ji,jj) + z2dt_e * ( zcvbt + zspgv + zva(ji,jj) ) ) * vmask(ji,jj,1) 369 378 END DO 370 379 END DO … … 375 384 DO ji = fs_2, fs_jpim1 ! vector opt. 376 385 ! surface pressure gradient 377 zspgu = -grav * ( zsshn_e(ji+1,jj) - zsshn_e(ji,jj) ) * hu(ji,jj) / e1u(ji,jj)378 zspgv = -grav * ( zsshn_e(ji,jj+1) - zsshn_e(ji,jj) ) * hv(ji,jj) / e2v(ji,jj)386 zspgu = -grav * ( sshn_e(ji+1,jj) - sshn_e(ji,jj) ) * hu(ji,jj) / e1u(ji,jj) 387 zspgv = -grav * ( sshn_e(ji,jj+1) - sshn_e(ji,jj) ) * hv(ji,jj) / e2v(ji,jj) 379 388 ! energy/enstrophy conserving formulation for planetary vorticity term 380 389 zcubt = + zfac25 / e1u(ji,jj) * ( ztne(ji,jj ) * zwy(ji ,jj ) + ztnw(ji+1,jj) * zwy(ji+1,jj ) & … … 383 392 & + ztnw(ji,jj ) * zwx(ji-1,jj ) + ztne(ji,jj ) * zwx(ji ,jj ) ) 384 393 ! after transports 385 zua_e(ji,jj) = ( zub_e(ji,jj) + z2dt_e * ( zcubt + zspgu + zua(ji,jj) ) ) * umask(ji,jj,1)386 zva_e(ji,jj) = ( zvb_e(ji,jj) + z2dt_e * ( zcvbt + zspgv + zva(ji,jj) ) ) * vmask(ji,jj,1)394 ua_e(ji,jj) = ( zub_e(ji,jj) + z2dt_e * ( zcubt + zspgu + zua(ji,jj) ) ) * umask(ji,jj,1) 395 va_e(ji,jj) = ( zvb_e(ji,jj) + z2dt_e * ( zcvbt + zspgv + zva(ji,jj) ) ) * vmask(ji,jj,1) 387 396 END DO 388 397 END DO 389 398 ENDIF 390 399 391 ! ... Boundary conditions on zua_e, zva_e, zssha_e 392 CALL lbc_lnk( zua_e, 'U', -1. ) 393 CALL lbc_lnk( zva_e, 'V', -1. ) 394 CALL lbc_lnk( zssha_e, 'T', 1. ) 400 ! Flather's boundary condition for the barotropic loop : 401 ! - Update sea surface height on each open boundary 402 ! - Correct the barotropic transports 403 IF( lk_obc ) CALL obc_fla_ts( kt ) 404 405 406 ! ... Boundary conditions on ua_e, va_e, ssha_e 407 CALL lbc_lnk( ua_e , 'U', -1. ) 408 CALL lbc_lnk( va_e , 'V', -1. ) 409 CALL lbc_lnk( ssha_e, 'T', 1. ) 395 410 396 411 ! temporal sum 397 412 !------------- 398 zssha_b(:,:) = zssha_b(:,:) + zssha_e(:,:)399 zua_b (:,:) = zua_b (:,:) + zua_e (:,:)400 zva_b (:,:) = zva_b (:,:) + zva_e (:,:)413 zssha_b(:,:) = zssha_b(:,:) + ssha_e(:,:) 414 zua_b (:,:) = zua_b (:,:) + ua_e (:,:) 415 zva_b (:,:) = zva_b (:,:) + va_e (:,:) 401 416 402 417 ! Time filter and swap of dynamics arrays 403 418 ! --------------------------------------- 404 419 IF( neuler == 0 .AND. kt == nit000 ) THEN ! Euler (forward) time stepping 405 zsshb_e(:,:) = zsshn_e(:,:)406 zub_e (:,:) = zun_e 407 zvb_e (:,:) = zvn_e 408 zsshn_e(:,:) = zssha_e(:,:)409 zun_e (:,:) = zua_e (:,:)410 zvn_e (:,:) = zva_e (:,:)420 zsshb_e(:,:) = sshn_e(:,:) 421 zub_e (:,:) = zun_e (:,:) 422 zvb_e (:,:) = zvn_e (:,:) 423 sshn_e (:,:) = ssha_e(:,:) 424 zun_e (:,:) = ua_e (:,:) 425 zvn_e (:,:) = va_e (:,:) 411 426 ELSE ! Asselin filtering 412 zsshb_e(:,:) = atfp * ( zsshb_e(:,:) + zssha_e(:,:) ) + atfp1 * zsshn_e(:,:)413 zub_e (:,:) = atfp * ( zub_e (:,:) + zua_e (:,:) ) + atfp1 * zun_e (:,:)414 zvb_e (:,:) = atfp * ( zvb_e (:,:) + zva_e (:,:) ) + atfp1 * zvn_e (:,:)415 zsshn_e(:,:) = zssha_e(:,:)416 zun_e (:,:) = zua_e (:,:)417 zvn_e (:,:) = zva_e (:,:)427 zsshb_e(:,:) = atfp * ( zsshb_e(:,:) + ssha_e(:,:) ) + atfp1 * sshn_e(:,:) 428 zub_e (:,:) = atfp * ( zub_e (:,:) + ua_e (:,:) ) + atfp1 * zun_e (:,:) 429 zvb_e (:,:) = atfp * ( zvb_e (:,:) + va_e (:,:) ) + atfp1 * zvn_e (:,:) 430 sshn_e (:,:) = ssha_e(:,:) 431 zun_e (:,:) = ua_e (:,:) 432 zvn_e (:,:) = va_e (:,:) 418 433 ENDIF 419 434 … … 426 441 zcoef = 1.e0 / ( FLOAT( icycle +1 ) ) 427 442 zssha_b(:,:) = zcoef * zssha_b(:,:) 428 zua_b (:,:) = zcoef * zua_b (:,:) 429 zva_b (:,:) = zcoef * zva_b (:,:) 443 zua_b (:,:) = zcoef * zua_b (:,:) 444 zva_b (:,:) = zcoef * zva_b (:,:) 445 #if defined key_obc 446 IF( lp_obc_east ) sshfoe_b(:,:) = zcoef * sshfoe_b(:,:) 447 IF( lp_obc_west ) sshfow_b(:,:) = zcoef * sshfow_b(:,:) 448 IF( lp_obc_north ) sshfon_b(:,:) = zcoef * sshfon_b(:,:) 449 IF( lp_obc_south ) sshfos_b(:,:) = zcoef * sshfos_b(:,:) 450 #endif 430 451 431 452 … … 448 469 ! open boundaries (div must be zero behind the open boundary) 449 470 ! mpp remark: The zeroing of hdiv can probably be extended to 1->jpi/jpj for the correct row/column 450 IF( lp_obc_east ) zhdiv(nie0p1:nie1p1,nje0 :nje1) = 0.e0! east451 IF( lp_obc_west ) zhdiv(niw0 :niw1 ,njw0 :njw1) = 0.e0! west471 IF( lp_obc_east ) zhdiv(nie0p1:nie1p1,nje0 :nje1) = 0.e0 ! east 472 IF( lp_obc_west ) zhdiv(niw0 :niw1 ,njw0 :njw1) = 0.e0 ! west 452 473 IF( lp_obc_north ) zhdiv(nin0 :nin1 ,njn0p1:njn1p1) = 0.e0 ! north 453 IF( lp_obc_south ) zhdiv(nis0 :nis1 ,njs0 :njs1) = 0.e0! south474 IF( lp_obc_south ) zhdiv(nis0 :nis1 ,njs0 :njs1) = 0.e0 ! south 454 475 #endif 455 476 … … 460 481 461 482 ! ... Boundary conditions on sshn 462 CALL lbc_lnk( sshn, 'T', 1. )483 IF( .NOT. lk_obc ) CALL lbc_lnk( sshn, 'T', 1. ) 463 484 464 485 -
trunk/NEMO/OPA_SRC/OBC/obc_oce.F90
r353 r367 40 40 !!-------------------------------------- 41 41 INTEGER :: & !: * namelist ??? * 42 nbobc = 1, & !: number of open boundaries ( 1=< nbobc =< 4 )43 nobc_dta = 0 , &!: = 0 use the initial state as obc data42 nbobc = 2 , & !: number of open boundaries ( 1=< nbobc =< 4 ) 43 nobc_dta = 0 !: = 0 use the initial state as obc data 44 44 ! ! = 1 read obc data in obcxxx.dta files 45 45 46 46 LOGICAL :: ln_obc_clim = .true. !: obc data files are climatological 47 LOGICAL :: ln_obc_fla = .false. !: Flather open boundary condition not used 48 LOGICAL :: ln_vol_cst = .true. !: Conservation of the whole volume 47 49 48 50 REAL(wp) :: & !!: open boundary namelist (namobc) … … 117 119 118 120 REAL(wp), DIMENSION(jpjed:jpjef) :: & !: 119 bfoe !: now climatology of the east boundary barotropic stream function 121 bfoe, & !: now climatology of the east boundary barotropic stream function 122 sshfoe, & !: now climatology of the east boundary sea surface height 123 ubtfoe,vbtfoe !: now climatology of the east boundary barotropic transport 120 124 121 125 REAL(wp), DIMENSION(jpj,jpk) :: & !: … … 124 128 uclie !: baroclinic componant of the zonal velocity after radiation 125 129 ! ! in the obcdyn.F90 routine 130 131 REAL(wp), DIMENSION(jpjed:jpjef,jpj) :: & !: 132 sshfoe_b !: east boundary ssh correction averaged over the barotropic loop 133 !: (if Flather's algoritm applied at open boundary) 134 135 REAL(wp), DIMENSION(jpjed:jpjef,0:jptobc+1) :: & !: 136 sshedta, ubtedta !: array used for interpolating monthly data on the east boundary 126 137 127 138 REAL(wp), DIMENSION(jpjed:jpjef,jpk,jptobc) :: & !: … … 168 179 169 180 REAL(wp), DIMENSION(jpjwd:jpjwf) :: & !: 170 bfow !: now climatology of the west boundary barotropic stream function 181 bfow, & !: now climatology of the west boundary barotropic stream function 182 sshfow, & !: now climatology of the west boundary sea surface height 183 ubtfow,vbtfow !: now climatology of the west boundary barotropic transport 171 184 172 185 REAL(wp), DIMENSION(jpj,jpk) :: & !: … … 175 188 ucliw !: baroclinic componant of the zonal velocity after the radiation 176 189 ! ! in the obcdyn.F90 routine 190 191 REAL(wp), DIMENSION(jpjwd:jpjwf,jpj) :: & !: 192 sshfow_b !: west boundary ssh correction averaged over the barotropic loop 193 !: (if Flather's algoritm applied at open boundary) 194 195 REAL(wp), DIMENSION(jpjwd:jpjwf,0:jptobc+1) :: & !: 196 sshwdta, ubtwdta !: array used for interpolating monthly data on the west boundary 177 197 178 198 REAL(wp), DIMENSION(jpjwd:jpjwf,jpk,jptobc) :: & !: … … 220 240 221 241 REAL(wp), DIMENSION(jpind:jpinf) :: & !: 222 bfon !: now climatology of the north boundary barotropic stream function 242 bfon, & !: now climatology of the north boundary barotropic stream function 243 sshfon, & !: now climatology of the north boundary sea surface height 244 ubtfon,vbtfon !: now climatology of the north boundary barotropic transport 223 245 224 246 REAL(wp), DIMENSION(jpi,jpk) :: & !: … … 227 249 vclin !: baroclinic componant of the meridian velocity after the radiation 228 250 ! ! in yhe obcdyn.F90 routine 251 252 REAL(wp), DIMENSION(jpind:jpinf,jpj) :: & !: 253 sshfon_b !: north boundary ssh correction averaged over the barotropic loop 254 !: (if Flather's algoritm applied at open boundary) 255 256 REAL(wp), DIMENSION(jpind:jpinf,0:jptobc+1) :: & !: 257 sshndta, vbtndta !: array used for interpolating monthly data on the north boundary 229 258 230 259 REAL(wp), DIMENSION(jpind:jpinf,jpk,jptobc) :: & !: … … 271 300 272 301 REAL(wp), DIMENSION(jpisd:jpisf) :: & !: 273 bfos !: now climatology of the south boundary barotropic stream function 302 bfos, & !: now climatology of the south boundary barotropic stream function 303 sshfos, & !: now climatology of the south boundary sea surface height 304 ubtfos,vbtfos !: now climatology of the south boundary barotropic transport 274 305 275 306 REAL(wp), DIMENSION(jpi,jpk) :: & !: … … 278 309 vclis !: baroclinic componant of the meridian velocity after the radiation 279 310 ! ! in the obcdyn.F90 routine 311 312 REAL(wp), DIMENSION(jpisd:jpisf,jpj) :: & !: 313 sshfos_b !: south boundary ssh correction averaged over the barotropic loop 314 !: (if Flather's algoritm applied at open boundary) 315 316 REAL(wp), DIMENSION(jpisd:jpisf,0:jptobc+1) :: & !: 317 sshsdta, vbtsdta !: array used for interpolating monthly data on the south boundary 280 318 281 319 REAL(wp), DIMENSION(jpisd:jpisf,jpk,jptobc) :: & !: -
trunk/NEMO/OPA_SRC/OBC/obccli.F90
r247 r367 4 4 !! Ocean dynamics: Baroclinic componant of velocities on each open boundary 5 5 !!=================================================================================== 6 #if defined key_obc && ! defined key_dynspg_fsc6 #if defined key_obc && defined key_dynspg_rl 7 7 !!----------------------------------------------------------------------------------- 8 8 !! 'key_obc' and 9 !! 'key_dynspg_ fsc'9 !! 'key_dynspg_rl' 10 10 !!----------------------------------------------------------------------------------- 11 11 !! obc_cli_dyn : Compute the baroclinic componant after the radiation phase -
trunk/NEMO/OPA_SRC/OBC/obcdta.F90
r353 r367 20 20 USE in_out_manager ! I/O logical units 21 21 USE lib_mpp ! distributed memory computing 22 USE dynspg_ rl !22 USE dynspg_oce ! choice/control of key cpp for surface pressure gradient 23 23 USE ioipsl 24 25 26 # if ! defined key_dynspg_fsc 24 # if defined key_dynspg_rl 27 25 USE obccli 28 26 # endif … … 31 29 PRIVATE 32 30 33 !! * Accessibility31 !! * Accessibility 34 32 PUBLIC obc_dta ! routines called by step.F90 33 PUBLIC obc_dta_bt ! routines called by dynspg_ts.F90 35 34 36 35 !! * Shared module variables 37 36 INTEGER :: & 38 nlecto = 0, & ! switch for the first read 39 ntobc1 , & ! first record used 40 ntobc2 ! second record used 41 37 nlecto, & ! switch for the first read 38 ntobc1, & ! first record used 39 ntobc2, & ! second record used 40 itobc ! number of time steps in OBC files 41 42 REAL(wp), DIMENSION(:), ALLOCATABLE :: ztcobc ! time_counter variable of BCs 43 42 44 !! * Substitutions 45 # include "domzgr_substitute.h90" 43 46 # include "obc_vectopt_loop_substitute.h90" 44 47 !!--------------------------------------------------------------------------------- 45 48 !! OPA 9.0 , LODYC-IPSL (2003) 49 !! $Header$ 50 !! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt 46 51 !!--------------------------------------------------------------------------------- 47 52 … … 82 87 INTEGER :: isrel ! number of seconds since 1/1/1992 83 88 INTEGER, SAVE :: itobce, itobcw, & ! number of time steps in OBC files 84 itobcs, itobcn, & ! " " " " 85 itobc 89 itobcs, itobcn ! " " " " 86 90 INTEGER :: ikprint ! frequency for printouts. 87 91 INTEGER :: fid_e, fid_w, fid_n, fid_s, fid ! file identifiers … … 91 95 start, & ! starting index read 92 96 count ! number of indices to be read 93 ! time_counter variable of BCs94 REAL(wp),DIMENSION(:),ALLOCATABLE :: ztcobc95 97 96 98 CHARACTER(LEN=25) :: f_name,v_name … … 112 114 IF( kt == nit000 ) THEN 113 115 116 nlecto = 0 117 114 118 IF(lwp) WRITE(numout,*) 115 119 IF(lwp) WRITE(numout,*) 'obc_dta : find boundary data' … … 219 223 ! 1.1 Tangential velocities set to zero 220 224 ! -------------------------------------- 221 IF( lp_obc_east ) vfoe = 0. 0222 IF( lp_obc_west ) vfow = 0. 0223 IF( lp_obc_south ) ufos = 0. 0224 IF( lp_obc_north ) ufon = 0. 0225 IF( lp_obc_east ) vfoe = 0.e0 226 IF( lp_obc_west ) vfow = 0.e0 227 IF( lp_obc_south ) ufos = 0.e0 228 IF( lp_obc_north ) ufon = 0.e0 225 229 226 230 ! 1.2 Data temperature, salinity, normal velocities set to zero … … 344 348 itimo = imois 345 349 ELSE 346 IF(lwp) WRITE(numout,*) 'data other than constant or monthly not written yet' 347 STOP 350 IF(lwp) WRITE(numout,*) 'data other than constant or monthly',kt 351 iman = itobc 352 itimo = FLOOR( kt*rdt / (ztcobc(2)-ztcobc(1)) ) 353 isrel = kt*rdt 348 354 ENDIF 349 355 ENDIF … … 370 376 ENDIF 371 377 ELSE 372 !!!!!!!!!!!!!ATTENTION el: A verifier en fction de la convention choisie pour 373 !!!!!!!!!!!!! le codage de nyear, pour les runs interannuels !!!!!!!!!!!!!! 374 !!! attention if ln_obc_clim is true, go back to jan 1st after december 31st 375 iyrel=nyear-1991 376 IF( ( iyrel < 1 ) .OR. ( iyrel > 13 ) ) THEN 377 IF( lwp ) WRITE(numout,*) 'Pb OBCDTA : iyrel' 378 STOP 379 ENDIF 380 ! Compute nb of seconds from 1/1/1992 00:00 : 381 isrel=(365*(iyrel-1)+nday_year)*86400 382 IF( lwp ) THEN 383 WRITE(numout,*)'Nbre de secondes ecoulees depuis le 1/1/1992:' 384 WRITE(numout,*) isrel 385 ENDIF 386 387 ! need to calculate here ntobc1 and ntobc2, the two time steps to be read 388 378 isrel=kt*rdt 379 ntobc1 = itimo ! first file record used 380 ntobc2 = ntobc1 + 1 ! last file record used 381 ntobc1 = MOD( ntobc1, iman ) 382 IF( ntobc1 == 0 ) ntobc1 = iman 383 ntobc2 = MOD( ntobc2, iman ) 384 IF( ntobc2 == 0 ) ntobc2 = iman 385 IF(lwp) WRITE(numout,*) ' read obc first record file used ntobc1 ', ntobc1 386 IF(lwp) WRITE(numout,*) ' read obc last record file used ntobc2 ', ntobc2 389 387 ENDIF 390 388 ! ======================= ! … … 395 393 ! ... initialise the sedta, tedta, uedta arrays 396 394 CALL flioopfd ('obceast_TS.nc',fid_e) 397 CALL obc_dta_gv (fid_e,'y','vosaline', sedta(:,:,1),jpjef-jpjed+1,jpk,ntobc1)398 CALL obc_dta_gv (fid_e,'y','vosaline', sedta(:,:,2),jpjef-jpjed+1,jpk,ntobc2)399 CALL obc_dta_gv (fid_e,'y','votemper', tedta(:,:,1),jpjef-jpjed+1,jpk,ntobc1)400 CALL obc_dta_gv (fid_e,'y','votemper', tedta(:,:,2),jpjef-jpjed+1,jpk,ntobc2)401 CALL flioclo (fid_e) 402 403 CALL flioopfd ('obceast_U.nc',fid_e) 404 CALL obc_dta_gv (fid_e,'y','vozocrtx', uedta(:,:,1),jpjef-jpjed+1,jpk,ntobc1)405 CALL obc_dta_gv (fid_e,'y','vozocrtx', uedta(:,:,2),jpjef-jpjed+1,jpk,ntobc2)395 CALL obc_dta_gv (fid_e,'y','vosaline',jpjef-jpjed+1,ntobc1,pdta_3D=sedta(:,:,1)) 396 CALL obc_dta_gv (fid_e,'y','vosaline',jpjef-jpjed+1,ntobc2,pdta_3D=sedta(:,:,2)) 397 CALL obc_dta_gv (fid_e,'y','votemper',jpjef-jpjed+1,ntobc1,pdta_3D=tedta(:,:,1)) 398 CALL obc_dta_gv (fid_e,'y','votemper',jpjef-jpjed+1,ntobc2,pdta_3D=tedta(:,:,2)) 399 CALL flioclo (fid_e) 400 401 CALL flioopfd ('obceast_U.nc',fid_e) 402 CALL obc_dta_gv (fid_e,'y','vozocrtx',jpjef-jpjed+1,ntobc1,pdta_3D=uedta(:,:,1)) 403 CALL obc_dta_gv (fid_e,'y','vozocrtx',jpjef-jpjed+1,ntobc2,pdta_3D=uedta(:,:,2)) 406 404 CALL flioclo (fid_e) 407 405 ! Usually printout is done only once at kt = nit000, … … 429 427 ! ... initialise the swdta, twdta, uwdta arrays 430 428 CALL flioopfd ('obcwest_TS.nc',fid_w) 431 CALL obc_dta_gv (fid_w,'y','vosaline', swdta(:,:,1),jpjwf-jpjwd+1,jpk,ntobc1)432 CALL obc_dta_gv (fid_w,'y','vosaline', swdta(:,:,2),jpjwf-jpjwd+1,jpk,ntobc2)433 CALL obc_dta_gv (fid_w,'y','votemper', twdta(:,:,1),jpjwf-jpjwd+1,jpk,ntobc1)434 CALL obc_dta_gv (fid_w,'y','votemper', twdta(:,:,2),jpjwf-jpjwd+1,jpk,ntobc2)435 CALL flioclo (fid_w) 436 437 CALL flioopfd ('obcwest_U.nc',fid_w) 438 CALL obc_dta_gv (fid_w,'y','vozocrtx', uwdta(:,:,1),jpjwf-jpjwd+1,jpk,ntobc1)439 CALL obc_dta_gv (fid_w,'y','vozocrtx', uwdta(:,:,2),jpjwf-jpjwd+1,jpk,ntobc2)429 CALL obc_dta_gv (fid_w,'y','vosaline',jpjwf-jpjwd+1,ntobc1,pdta_3D=swdta(:,:,1)) 430 CALL obc_dta_gv (fid_w,'y','vosaline',jpjwf-jpjwd+1,ntobc2,pdta_3D=swdta(:,:,2)) 431 CALL obc_dta_gv (fid_w,'y','votemper',jpjwf-jpjwd+1,ntobc1,pdta_3D=twdta(:,:,1)) 432 CALL obc_dta_gv (fid_w,'y','votemper',jpjwf-jpjwd+1,ntobc2,pdta_3D=twdta(:,:,2)) 433 CALL flioclo (fid_w) 434 435 CALL flioopfd ('obcwest_U.nc',fid_w) 436 CALL obc_dta_gv (fid_w,'y','vozocrtx',jpjwf-jpjwd+1,ntobc1,pdta_3D=uwdta(:,:,1)) 437 CALL obc_dta_gv (fid_w,'y','vozocrtx',jpjwf-jpjwd+1,ntobc2,pdta_3D=uwdta(:,:,2)) 440 438 CALL flioclo (fid_w) 441 439 … … 460 458 IF( lp_obc_north ) THEN 461 459 CALL flioopfd ('obcnorth_TS.nc',fid_n) 462 CALL obc_dta_gv (fid_n,'x','vosaline', sndta(:,:,1),jpinf-jpind+1,jpk,ntobc1)463 CALL obc_dta_gv (fid_n,'x','vosaline', sndta(:,:,2),jpinf-jpind+1,jpk,ntobc2)464 CALL obc_dta_gv (fid_n,'x','votemper', tndta(:,:,1),jpinf-jpind+1,jpk,ntobc1)465 CALL obc_dta_gv (fid_n,'x','votemper', tndta(:,:,2),jpinf-jpind+1,jpk,ntobc2)466 CALL flioclo (fid_n) 467 468 CALL flioopfd ('obcnorth_V.nc',fid_n) 469 CALL obc_dta_gv (fid_n,'x','vomecrty', vndta(:,:,1),jpinf-jpind+1,jpk,ntobc1)470 CALL obc_dta_gv (fid_n,'x','vomecrty', vndta(:,:,2),jpinf-jpind+1,jpk,ntobc2)460 CALL obc_dta_gv (fid_n,'x','vosaline',jpinf-jpind+1,ntobc1,pdta_3D=sndta(:,:,1)) 461 CALL obc_dta_gv (fid_n,'x','vosaline',jpinf-jpind+1,ntobc2,pdta_3D=sndta(:,:,2)) 462 CALL obc_dta_gv (fid_n,'x','votemper',jpinf-jpind+1,ntobc1,pdta_3D=tndta(:,:,1)) 463 CALL obc_dta_gv (fid_n,'x','votemper',jpinf-jpind+1,ntobc2,pdta_3D=tndta(:,:,2)) 464 CALL flioclo (fid_n) 465 466 CALL flioopfd ('obcnorth_V.nc',fid_n) 467 CALL obc_dta_gv (fid_n,'x','vomecrty',jpinf-jpind+1,ntobc1,pdta_3D=vndta(:,:,1)) 468 CALL obc_dta_gv (fid_n,'x','vomecrty',jpinf-jpind+1,ntobc2,pdta_3D=vndta(:,:,2)) 471 469 CALL flioclo (fid_n) 472 470 … … 491 489 IF( lp_obc_south ) THEN 492 490 CALL flioopfd ('obcsouth_TS.nc',fid_s) 493 CALL obc_dta_gv (fid_s,'x','vosaline', ssdta(:,:,1),jpisf-jpisd+1,jpk,ntobc1)494 CALL obc_dta_gv (fid_s,'x','vosaline', ssdta(:,:,2),jpisf-jpisd+1,jpk,ntobc2)495 CALL obc_dta_gv (fid_s,'x','votemper', tsdta(:,:,1),jpisf-jpisd+1,jpk,ntobc1)496 CALL obc_dta_gv (fid_s,'x','votemper', tsdta(:,:,2),jpisf-jpisd+1,jpk,ntobc2)497 CALL flioclo (fid_s) 498 499 CALL flioopfd ('obcsouth_V.nc',fid_s) 500 CALL obc_dta_gv (fid_s,'x','vomecrty', vsdta(:,:,1),jpisf-jpisd+1,jpk,ntobc1)501 CALL obc_dta_gv (fid_s,'x','vomecrty', vsdta(:,:,2),jpisf-jpisd+1,jpk,ntobc2)491 CALL obc_dta_gv (fid_s,'x','vosaline',jpisf-jpisd+1,ntobc1,pdta_3D=ssdta(:,:,1)) 492 CALL obc_dta_gv (fid_s,'x','vosaline',jpisf-jpisd+1,ntobc2,pdta_3D=ssdta(:,:,2)) 493 CALL obc_dta_gv (fid_s,'x','votemper',jpisf-jpisd+1,ntobc1,pdta_3D=tsdta(:,:,1)) 494 CALL obc_dta_gv (fid_s,'x','votemper',jpisf-jpisd+1,ntobc2,pdta_3D=tsdta(:,:,2)) 495 CALL flioclo (fid_s) 496 497 CALL flioopfd ('obcsouth_V.nc',fid_s) 498 CALL obc_dta_gv (fid_s,'x','vomecrty',jpisf-jpisd+1,ntobc1,pdta_3D=vsdta(:,:,1)) 499 CALL obc_dta_gv (fid_s,'x','vomecrty',jpisf-jpisd+1,ntobc2,pdta_3D=vsdta(:,:,2)) 502 500 CALL flioclo (fid_s) 503 501 … … 519 517 ENDIF 520 518 ENDIF 521 522 ENDIF ! end of the test on the condition to read or not the files 519 520 ELSE 521 522 nlecto = 0 ! no reading of OBC barotropic data 523 524 ENDIF ! end of the test on the condition to read or not the files 523 525 524 526 ! 3. Call at every time step : … … 596 598 END SUBROUTINE obc_dta 597 599 598 # if defined key_dynspg_ fsc600 # if defined key_dynspg_rl 599 601 !!----------------------------------------------------------------------------- 600 !! 'key_dynspg_fsc' free surface with constant volume 601 !!----------------------------------------------------------------------------- 602 SUBROUTINE obc_dta_psi ( kt ) ! Empty routine 603 !! * Arguments 604 INTEGER,INTENT(in) :: kt 605 WRITE(*,*) 'obc_dta_psi: You should not have seen this print! error?', kt 606 END SUBROUTINE obc_dta_psi 607 #else 608 !!----------------------------------------------------------------------------- 609 !! Default option Rigid-lid 602 !! Rigid-lid 610 603 !!----------------------------------------------------------------------------- 611 604 … … 636 629 !! ! 97-08 (G. Madec, J.M. Molines) 637 630 !! 8.5 ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90 631 !! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization 638 632 !!---------------------------------------------------------------------------- 639 633 !! * Arguments … … 684 678 IF( nbobc > 1 ) THEN 685 679 DO jnic = 1,nbobc - 1 686 gcbic(jnic) = 0. 680 gcbic(jnic) = 0.e0 687 681 ip=mnic(0,jnic) 688 682 DO jip = 1,ip … … 742 736 IF( lpsouthobc) THEN 743 737 744 IF( kt == nit000 .OR.kt <= kbsfstart ) THEN738 IF( kt == nit000 .OR. kt <= kbsfstart ) THEN 745 739 OPEN(inum,file='obcsouthbsf.dta') 746 740 READ(inum,*) … … 759 753 760 754 IF( lpnorthobc) THEN 761 IF( kt == nit000 .OR.kt <= kbsfstart ) THEN755 IF( kt == nit000 .OR. kt <= kbsfstart ) THEN 762 756 OPEN(inum,file='obcnorthbsf.dta') 763 757 READ(inum,*) … … 776 770 777 771 END SUBROUTINE obc_dta_psi 778 772 #else 773 !!----------------------------------------------------------------------------- 774 !! Default option 775 !!----------------------------------------------------------------------------- 776 SUBROUTINE obc_dta_psi ( kt ) ! Empty routine 777 !! * Arguments 778 INTEGER,INTENT(in) :: kt 779 WRITE(*,*) 'obc_dta_psi: You should not have seen this print! error?', kt 780 END SUBROUTINE obc_dta_psi 779 781 # endif 780 782 781 SUBROUTINE obc_dta_gv (ifid,cldim,clobc,pdta,kobcij,kobck,ktobc) 783 784 #if defined key_dynspg_ts || defined key_dynspg_exp 785 SUBROUTINE obc_dta_bt( kt, kbt ) 786 !!--------------------------------------------------------------------------- 787 !! *** SUBROUTINE obc_dta *** 788 !! 789 !! ** Purpose : time interpolation of barotropic data for time-splitting scheme 790 !! Data at the boundary must be in m2/s 791 !! 792 !! History : 793 !! 9.0 ! 05-11 (V. garnier) Original code 794 !!--------------------------------------------------------------------------- 795 !! * Arguments 796 INTEGER, INTENT( in ) :: kt ! ocean time-step index 797 INTEGER, INTENT( in ) :: kbt ! barotropic ocean time-step index 798 799 !! * Local declarations 800 INTEGER :: ji, jj, jk, ii, ij ! dummy loop indices 801 INTEGER :: fid_e, fid_w, fid_n, fid_s, fid ! file identifiers 802 INTEGER :: itimo, iman, imois, i15 803 INTEGER :: ntobcm, ntobcp, itimom, itimop 804 REAL(wp) :: zxy 805 INTEGER :: isrel, ikt ! number of seconds since 1/1/1992 806 INTEGER :: ikprint ! frequency for printouts. 807 808 !!--------------------------------------------------------------------------- 809 810 ! 1. First call: check time frames available in files. 811 ! ------------------------------------------------------- 812 813 IF( kt == nit000 ) THEN 814 815 ! 1.1 Barotropic tangential velocities set to zero 816 ! ------------------------------------------------- 817 IF( lp_obc_east ) vbtfoe(:) = 0.e0 818 IF( lp_obc_west ) vbtfow(:) = 0.e0 819 IF( lp_obc_south ) ubtfos(:) = 0.e0 820 IF( lp_obc_north ) ubtfon(:) = 0.e0 821 822 ! 1.2 Sea surface height and normal barotropic velocities set to zero 823 ! or initial conditions if nobc_dta == 0 824 ! -------------------------------------------------------------------- 825 826 IF( lp_obc_east ) THEN 827 ! initialisation to zero 828 sshedta(:,:) = 0.e0 829 ubtedta(:,:) = 0.e0 830 ! ! ================== ! 831 IF( nobc_dta == 0 ) THEN ! initial state used ! 832 ! ! ================== ! 833 ! Fills sedta, tedta, uedta (global arrays) 834 ! Remark: this works for njzoom = 1. Should the definition of ij include njzoom? 835 DO ji = nie0, nie1 836 DO jj = nje0p1, nje1m1 837 ij = jj -1 + njmpp 838 sshedta(ij,1) = sshn(ji+1,jj) * tmask(ji+1,jj,1) 839 END DO 840 END DO 841 ENDIF 842 ENDIF 843 844 IF( lp_obc_west) THEN 845 ! initialisation to zero 846 sshwdta(:,:) = 0.e0 847 ubtwdta(:,:) = 0.e0 848 ! ! ================== ! 849 IF( nobc_dta == 0 ) THEN ! initial state used ! 850 ! ! ================== ! 851 ! Fills swdta, twdta, uwdta (global arrays) 852 ! Remark: this works for njzoom = 1. Should the definition of ij include njzoom? 853 DO ji = niw0, niw1 854 DO jj = njw0p1, njw1m1 855 ij = jj -1 + njmpp 856 sshwdta(ij,1) = sshn(ji,jj) * tmask(ji,jj,1) 857 END DO 858 END DO 859 ENDIF 860 ENDIF 861 862 IF( lp_obc_north) THEN 863 ! initialisation to zero 864 sshndta(:,:) = 0.e0 865 vbtndta(:,:) = 0.e0 866 ! ! ================== ! 867 IF( nobc_dta == 0 ) THEN ! initial state used ! 868 ! ! ================== ! 869 ! Fills sndta, tndta, vndta (global arrays) 870 ! Remark: this works for njzoom = 1. Should the definition of ij include njzoom? 871 DO jj = njn0, njn1 872 DO ji = nin0p1, nin1m1 873 DO jk = 1, jpkm1 874 ii = ji -1 + nimpp 875 vbtndta(ii,1) = vbtndta(ii,1) + vndta(ii,jk,1)*fse3v(ji,jj,jk) 876 END DO 877 sshndta(ii,1) = sshn(ii,jj+1) * tmask(ji,jj+1,1) 878 END DO 879 END DO 880 ENDIF 881 ENDIF 882 883 IF( lp_obc_south) THEN 884 ! initialisation to zero 885 ssdta(:,:,:) = 0.e0 886 tsdta(:,:,:) = 0.e0 887 vsdta(:,:,:) = 0.e0 888 sshsdta(:,:) = 0.e0 889 vbtsdta(:,:) = 0.e0 890 ! ! ================== ! 891 IF( nobc_dta == 0 ) THEN ! initial state used ! 892 ! ! ================== ! 893 ! Fills ssdta, tsdta, vsdta (global arrays) 894 ! Remark: this works for njzoom = 1. Should the definition of ij include njzoom? 895 DO jj = njs0, njs1 896 DO ji = nis0p1, nis1m1 897 DO jk = 1, jpkm1 898 ii = ji -1 + nimpp 899 vbtsdta(ii,1) = vbtsdta(ii,1) + vsdta(ii,jk,1)*fse3v(ji,jj,jk) 900 END DO 901 sshsdta(ii,1) = sshn(ji,jj) * tmask(ii,jj,1) 902 END DO 903 END DO 904 ENDIF 905 ENDIF 906 907 ENDIF ! END IF kt == nit000 908 909 !!------------------------------------------------------------------------------------ 910 ! 2. Initialize the time we are at. Does this every time the routine is called, 911 ! excepted when nobc_dta = 0 912 ! 913 IF( nobc_dta == 0) THEN 914 itimo = 1 915 zxy = 0 916 ELSE 917 IF(itobc == 1) THEN 918 itimo = 1 919 ELSE IF (itobc == 12) THEN ! BC are monthly 920 ! we assume we have climatology in that case 921 iman = 12 922 i15 = nday / 16 923 imois = nmonth + i15 - 1 924 IF( imois == 0 ) imois = iman 925 itimo = imois 926 ELSE 927 IF(lwp) WRITE(numout,*) 'data other than constant or monthly',kt 928 iman = itobc 929 itimo = FLOOR( kt*rdt / ztcobc(1)) 930 isrel=kt*rdt 931 ENDIF 932 ENDIF 933 934 ! 2. Read two records in the file if necessary 935 ! --------------------------------------------- 936 937 IF( nobc_dta == 1 .AND. nlecto == 1 ) THEN 938 939 IF( lp_obc_east ) THEN 940 ! ... Read datafile and set sea surface height and barotropic velocity 941 ! ... initialise the sshedta, ubtedta arrays 942 sshedta(:,0) = sshedta(:,1) 943 ubtedta(:,0) = ubtedta(:,1) 944 CALL flioopfd ('obceast_TS.nc',fid_e) 945 CALL obc_dta_gv (fid_e,'y','vossurfh',jpjef-jpjed+1,ntobc1,pdta_2D=sshedta(:,1)) 946 CALL obc_dta_gv (fid_e,'y','vossurfh',jpjef-jpjed+1,ntobc2,pdta_2D=sshedta(:,2)) 947 IF( lk_dynspg_ts ) THEN 948 CALL obc_dta_gv (fid_e,'y','vossurfh',jpjef-jpjed+1,ntobc2+1,pdta_2D=sshedta(:,3)) 949 ENDIF 950 CALL flioclo (fid_e) 951 952 CALL flioopfd ('obceast_U.nc',fid_e) 953 CALL obc_dta_gv (fid_e,'y','vozoubt',jpjef-jpjed+1,ntobc1,pdta_2D=ubtedta(:,1)) 954 CALL obc_dta_gv (fid_e,'y','vozoubt',jpjef-jpjed+1,ntobc2,pdta_2D=ubtedta(:,2)) 955 IF( lk_dynspg_ts ) THEN 956 CALL obc_dta_gv (fid_e,'y','vozoubt',jpjef-jpjed+1,ntobc2+1,pdta_2D=ubtedta(:,3)) 957 ENDIF 958 CALL flioclo (fid_e) 959 960 ! ... Usually printout is done only once at kt = nit000, unless nprint (namelist) > 1 961 IF( lwp .AND. ( kt == nit000 .OR. nprint /= 0 ) ) THEN 962 WRITE(numout,*) 963 WRITE(numout,*) ' Read East OBC barotropic data records ', ntobc1, ntobc2 964 ikprint = (jpjef-jpjed+1)/20 +1 965 WRITE(numout,*) 966 WRITE(numout,*) ' Sea surface height record 1' 967 CALL prihre( sshedta(:,1), jpjef-jpjed+1, 1, 1, jpjef-jpjed+1, ikprint, 1, 1, -3, 1., numout ) 968 WRITE(numout,*) 969 WRITE(numout,*) ' Normal transport (m2/s) record 1',ikprint 970 CALL prihre( ubtedta(:,1), jpjef-jpjed+1, 1, 1, jpjef-jpjed+1, ikprint, 1, 1, -3, 1., numout ) 971 ENDIF 972 ENDIF 973 974 IF( lp_obc_west ) THEN 975 ! ... Read datafile and set temperature, salinity and normal velocity 976 ! ... initialise the swdta, twdta, uwdta arrays 977 sshwdta(:,0) = sshwdta(:,1) 978 ubtwdta(:,0) = ubtwdta(:,1) 979 CALL flioopfd ('obcwest_TS.nc',fid_w) 980 CALL obc_dta_gv (fid_w,'y','vossurfh',jpjwf-jpjwd+1,ntobc1,pdta_2D=sshwdta(:,1)) 981 CALL obc_dta_gv (fid_w,'y','vossurfh',jpjwf-jpjwd+1,ntobc2,pdta_2D=sshwdta(:,2)) 982 IF( lk_dynspg_ts ) THEN 983 CALL obc_dta_gv (fid_w,'y','vossurfh',jpjwf-jpjwd+1,ntobc2+1,pdta_2D=sshwdta(:,3)) 984 ENDIF 985 CALL flioclo (fid_w) 986 987 CALL flioopfd ('obcwest_U.nc',fid_w) 988 CALL obc_dta_gv (fid_w,'y','vozoubt',jpjwf-jpjwd+1,ntobc1,pdta_2D=ubtwdta(:,1)) 989 CALL obc_dta_gv (fid_w,'y','vozoubt',jpjwf-jpjwd+1,ntobc2,pdta_2D=ubtwdta(:,2)) 990 IF( lk_dynspg_ts ) THEN 991 CALL obc_dta_gv (fid_w,'y','vozoubt',jpjwf-jpjwd+1,ntobc2+1,pdta_2D=ubtwdta(:,3)) 992 ENDIF 993 CALL flioclo (fid_w) 994 995 ! ... Usually printout is done only once at kt = nit000, unless nprint (namelist) > 1 996 IF( lwp .AND. ( kt == nit000 .OR. nprint /= 0 ) ) THEN 997 WRITE(numout,*) 998 WRITE(numout,*) ' Read West OBC barotropic data records ', ntobc1, ntobc2 999 ikprint = (jpjwf-jpjwd+1)/20 +1 1000 WRITE(numout,*) 1001 WRITE(numout,*) ' Sea surface height record 1 - printout surface level' 1002 CALL prihre( sshwdta(:,1), jpjwf-jpjwd+1, 1, 1, jpjwf-jpjwd+1, ikprint, 1, 1, -3, 1., numout ) 1003 WRITE(numout,*) 1004 WRITE(numout,*) ' Normal transport (m2/s) record 1' 1005 CALL prihre( ubtwdta(:,1), jpjwf-jpjwd+1, 1, 1, jpjwf-jpjwd+1, ikprint, 1, 1, -3, 1., numout ) 1006 ENDIF 1007 ENDIF 1008 1009 IF( lp_obc_north) THEN 1010 ! ... Read datafile and set sea surface height and barotropic velocity 1011 ! ... initialise the sshndta, ubtndta arrays 1012 sshndta(:,0) = sshndta(:,1) 1013 vbtndta(:,0) = vbtndta(:,1) 1014 CALL flioopfd ('obcnorth_TS.nc',fid_n) 1015 CALL obc_dta_gv (fid_n,'x','vossurfh',jpinf-jpind+1,ntobc1,pdta_2D=sshndta(:,1)) 1016 CALL obc_dta_gv (fid_n,'x','vossurfh',jpinf-jpind+1,ntobc2,pdta_2D=sshndta(:,2)) 1017 IF( lk_dynspg_ts ) THEN 1018 CALL obc_dta_gv (fid_n,'x','vossurfh',jpinf-jpind+1,ntobc2+1,pdta_2D=sshndta(:,3)) 1019 ENDIF 1020 CALL flioclo (fid_n) 1021 1022 CALL flioopfd ('obcnorth_V.nc',fid_n) 1023 CALL obc_dta_gv (fid_n,'x','vomevbt',jpinf-jpind+1,ntobc1,pdta_2D=vbtndta(:,1)) 1024 CALL obc_dta_gv (fid_n,'x','vomevbt',jpinf-jpind+1,ntobc2,pdta_2D=vbtndta(:,2)) 1025 IF( lk_dynspg_ts ) THEN 1026 CALL obc_dta_gv (fid_n,'x','vomevbt',jpinf-jpind+1,ntobc2+1,pdta_2D=vbtndta(:,3)) 1027 ENDIF 1028 CALL flioclo (fid_n) 1029 1030 ! ... Usually printout is done only once at kt = nit000, unless nprint (namelist) > 1 1031 IF( lwp .AND. ( kt == nit000 .OR. nprint /= 0 ) ) THEN 1032 WRITE(numout,*) 1033 WRITE(numout,*) ' Read North OBC barotropic data records ', ntobc1, ntobc2 1034 ikprint = (jpinf-jpind+1)/20 +1 1035 WRITE(numout,*) 1036 WRITE(numout,*) ' Sea surface height record 1 - printout surface level' 1037 CALL prihre( sshndta(:,1), jpinf-jpind+1, 1, 1, jpinf-jpind+1, ikprint, 1, 1, -3, 1., numout ) 1038 WRITE(numout,*) 1039 WRITE(numout,*) ' Normal transport (m2/s) record 1' 1040 CALL prihre( vbtndta(:,1), jpinf-jpind+1, 1, 1, jpinf-jpind+1, ikprint, 1, 1, -3, 1., numout ) 1041 ENDIF 1042 ENDIF 1043 1044 IF( lp_obc_south) THEN 1045 ! ... Read datafile and set sea surface height and barotropic velocity 1046 ! ... initialise the sshsdta, ubtsdta arrays 1047 sshsdta(:,0) = sshsdta(:,1) 1048 vbtsdta(:,0) = vbtsdta(:,1) 1049 CALL flioopfd ('obcsouth_TS.nc',fid_s) 1050 CALL obc_dta_gv (fid_s,'x','vossurfh',jpisf-jpisd+1,ntobc1,pdta_2D=sshsdta(:,1)) 1051 CALL obc_dta_gv (fid_s,'x','vossurfh',jpisf-jpisd+1,ntobc2,pdta_2D=sshsdta(:,2)) 1052 IF( lk_dynspg_ts ) THEN 1053 CALL obc_dta_gv (fid_s,'x','vossurfh',jpisf-jpisd+1,ntobc2+1,pdta_2D=sshsdta(:,3)) 1054 ENDIF 1055 CALL flioclo (fid_s) 1056 1057 CALL flioopfd ('obcsouth_V.nc',fid_s) 1058 CALL obc_dta_gv (fid_s,'x','vomevbt',jpisf-jpisd+1,ntobc1,pdta_2D=vbtsdta(:,1)) 1059 CALL obc_dta_gv (fid_s,'x','vomevbt',jpisf-jpisd+1,ntobc2,pdta_2D=vbtsdta(:,2)) 1060 IF( lk_dynspg_ts ) THEN 1061 CALL obc_dta_gv (fid_s,'x','vomevbt',jpisf-jpisd+1,ntobc2+1,pdta_2D=vbtsdta(:,3)) 1062 ENDIF 1063 CALL flioclo (fid_s) 1064 1065 ! ... Usually printout is done only once at kt = nit000, unless nprint (namelist) > 1 1066 IF( lwp .AND. ( kt == nit000 .OR. nprint /= 0 ) ) THEN 1067 WRITE(numout,*) 1068 WRITE(numout,*) ' Read South OBC barotropic data records ', ntobc1, ntobc2 1069 ikprint = (jpisf-jpisd+1)/20 +1 1070 WRITE(numout,*) 1071 WRITE(numout,*) ' Sea surface height record 1 - printout surface level' 1072 CALL prihre( sshsdta(:,1), jpisf-jpisd+1, 1, 1, jpisf-jpisd+1, ikprint, 1, 1, -3, 1., numout ) 1073 WRITE(numout,*) 1074 WRITE(numout,*) ' Normal transport (m2/s) record 1' 1075 CALL prihre( vbtsdta(:,1), jpisf-jpisd+1, 1, 1, jpisf-jpisd+1, ikprint, 1, 1, -3, 1., numout ) 1076 ENDIF 1077 ENDIF 1078 1079 ENDIF ! end of the test on the condition to read or not the files 1080 1081 ! 3. Call at every time step : Linear interpolation of BCs to current time step 1082 ! ---------------------------------------------------------------------- 1083 1084 IF( lk_dynspg_ts ) THEN 1085 isrel = (kt-1)*rdt + kbt*rdtbt 1086 1087 IF( nobc_dta == 1 ) THEN 1088 isrel = (kt-1)*rdt + kbt*rdtbt 1089 itimo = FLOOR( kt*rdt / (ztcobc(2)-ztcobc(1)) ) 1090 itimom = FLOOR( (kt-1)*rdt / (ztcobc(2)-ztcobc(1)) ) 1091 itimop = FLOOR( (kt+1)*rdt / (ztcobc(2)-ztcobc(1)) ) 1092 IF( itimom == itimo .AND. itimop == itimo ) THEN 1093 ntobcm = ntobc1 1094 ntobcp = ntobc2 1095 1096 ELSEIF ( itimom <= itimo .AND. itimop == itimo ) THEN 1097 IF( FLOOR( isrel / (ztcobc(2)-ztcobc(1)) ) < itimo ) THEN 1098 ntobcm = ntobc1-1 1099 ntobcp = ntobc2-1 1100 ELSE 1101 ntobcm = ntobc1 1102 ntobcp = ntobc2 1103 ENDIF 1104 1105 ELSEIF ( itimom == itimo .AND. itimop >= itimo ) THEN 1106 IF( FLOOR( isrel / (ztcobc(2)-ztcobc(1)) ) < itimop ) THEN 1107 ntobcm = ntobc1 1108 ntobcp = ntobc2 1109 ELSE 1110 ntobcm = ntobc1+1 1111 ntobcp = ntobc2+1 1112 ENDIF 1113 1114 ELSEIF ( itimom == itimo-1 .AND. itimop == itimo+1 ) THEN 1115 IF( FLOOR( isrel / (ztcobc(2)-ztcobc(1)) ) < itimo ) THEN 1116 ntobcm = ntobc1-1 1117 ntobcp = ntobc2-1 1118 ELSEIF ( FLOOR( isrel / (ztcobc(2)-ztcobc(1)) ) < itimop ) THEN 1119 ntobcm = ntobc1 1120 ntobcp = ntobc2 1121 ELSEIF ( FLOOR( isrel / (ztcobc(2)-ztcobc(1)) ) == itimop ) THEN 1122 ntobcm = ntobc1+1 1123 ntobcp = ntobc2+2 1124 ELSE 1125 IF(lwp) WRITE(numout, *) 'obc_dta_bt: You should not have seen this print! error 1?' 1126 ENDIF 1127 ELSE 1128 IF(lwp) WRITE(numout, *) 'obc_dta_bt: You should not have seen this print! error 2?' 1129 ENDIF 1130 1131 ENDIF 1132 1133 ELSE IF( lk_dynspg_exp ) THEN 1134 isrel=kt*rdt 1135 ntobcm = ntobc1 1136 ntobcp = ntobc2 1137 ENDIF 1138 1139 IF( itobc == 1 .OR. nobc_dta == 0 ) THEN 1140 zxy = 0.e0 1141 ELSE IF( itobc == 12 ) THEN 1142 zxy = FLOAT( nday + 15 - 30 * i15 ) / 30. 1143 ELSE 1144 zxy = (ztcobc(ntobcm)-FLOAT(isrel)) / (ztcobc(ntobcm)-ztcobc(ntobcp)) 1145 ENDIF 1146 1147 IF( lp_obc_east ) THEN ! fills sshfoe, ubtfoe (local to each processor) 1148 DO jj = nje0p1, nje1m1 1149 ij = jj -1 + njmpp 1150 sshfoe(jj) = ( zxy * sshedta(ij,2) + (1.-zxy) * sshedta(ij,1) ) * temsk(jj,1) 1151 ubtfoe(jj) = ( zxy * ubtedta(ij,2) + (1.-zxy) * ubtedta(ij,1) ) * uemsk(jj,1) 1152 END DO 1153 ENDIF 1154 1155 IF( lp_obc_west) THEN ! fills sshfow, ubtfow (local to each processor) 1156 DO jj = njw0p1, njw1m1 1157 ij = jj -1 + njmpp 1158 sshfow(jj) = ( zxy * sshwdta(ij,2) + (1.-zxy) * sshwdta(ij,1) ) * twmsk(jj,1) 1159 ubtfow(jj) = ( zxy * ubtwdta(ij,2) + (1.-zxy) * ubtwdta(ij,1) ) * uwmsk(jj,1) 1160 END DO 1161 ENDIF 1162 1163 IF( lp_obc_north) THEN ! fills sshfon, vbtfon (local to each processor) 1164 DO ji = nin0p1, nin1m1 1165 ii = ji -1 + nimpp 1166 sshfon(ji) = ( zxy * sshndta(ii,2) + (1.-zxy) * sshndta(ii,1) ) * tnmsk(ji,1) 1167 vbtfon(ji) = ( zxy * vbtndta(ii,2) + (1.-zxy) * vbtndta(ii,1) ) * vnmsk(ji,1) 1168 END DO 1169 ENDIF 1170 1171 IF( lp_obc_south) THEN ! fills sshfos, vbtfos (local to each processor) 1172 DO ji = nis0p1, nis1m1 1173 ii = ji -1 + nimpp 1174 sshfos(ji) = ( zxy * sshsdta(ii,2) + (1.-zxy) * sshsdta(ii,1) ) * tsmsk(ji,1) 1175 vbtfos(ji) = ( zxy * vbtsdta(ii,2) + (1.-zxy) * vbtsdta(ii,1) ) * vsmsk(ji,1) 1176 END DO 1177 ENDIF 1178 1179 END SUBROUTINE obc_dta_bt 1180 1181 #else 1182 !!----------------------------------------------------------------------------- 1183 !! Default option 1184 !!----------------------------------------------------------------------------- 1185 SUBROUTINE obc_dta_bt ( kt, kbt ) ! Empty routine 1186 !! * Arguments 1187 INTEGER,INTENT(in) :: kt 1188 INTEGER, INTENT( in ) :: kbt ! barotropic ocean time-step index 1189 WRITE(*,*) 'obc_dta_bt: You should not have seen this print! error?', kt 1190 END SUBROUTINE obc_dta_bt 1191 #endif 1192 1193 1194 SUBROUTINE obc_dta_gv (ifid,cldim,clobc,kobcij,ktobc,pdta_2D,pdta_3D) 782 1195 !!----------------------------------------------------------------------------- 783 1196 !! *** SUBROUTINE obc_dta_gv *** 784 1197 !! 785 !! ** Purpose : Read a OBC forcing field from netcdf file1198 !! ** Purpose : Read an OBC forcing field from netcdf file 786 1199 !! Input file are supposed to be 3D e.g. 787 1200 !! - for a South or North OB : longitude x depth x time … … 794 1207 !! * Arguments 795 1208 INTEGER, INTENT(IN) :: & 796 ifid ,& ! netcdf file name identifier1209 ifid , & ! netcdf file name identifier 797 1210 kobcij, & ! Horizontal (i or j) dimension of the array 798 kobck, & ! vertical dimension799 1211 ktobc ! starting time index read 800 1212 CHARACTER(LEN=*), INTENT(IN) :: & 801 1213 cldim, & ! dimension along which is the open boundary ('x' or 'y') 802 1214 clobc ! name of the netcdf variable read 803 REAL, DIMENSION(kobcij,kobck,1), INTENT(OUT) :: & 804 pdta ! 3D array of OBC forcing field 1215 REAL, DIMENSION(kobcij,jpk,1), INTENT(OUT), OPTIONAL :: & 1216 pdta_3D ! 3D array of OBC forcing field 1217 REAL, DIMENSION(kobcij,1), INTENT(OUT), OPTIONAL :: & 1218 pdta_2D ! 3D array of OBC forcing field 805 1219 806 1220 !! * Local declarations … … 814 1228 IF( l_exv ) THEN 815 1229 ! checks the number of dimensions 816 IF( indim == 3 ) THEN 817 istart(1:3) = (/ 1, 1, ktobc /) 818 icount(1:3) = (/ kobcij, kobck, 1 /) 819 CALL fliogetv (ifid,TRIM(clobc),pdta,start=istart(1:3),count=icount(1:3)) 1230 IF( indim == 2 ) THEN 1231 istart(1:2) = (/ 1 , ktobc /) 1232 icount(1:2) = (/ kobcij, 1 /) 1233 CALL fliogetv (ifid,TRIM(clobc),pdta_2D,start=istart(1:2),count=icount(1:2)) 1234 ELSE IF( indim == 3 ) THEN 1235 istart(1:3) = (/ 1 , 1 , ktobc /) 1236 icount(1:3) = (/ kobcij, jpk , 1 /) 1237 CALL fliogetv (ifid,TRIM(clobc),pdta_3D,start=istart(1:3),count=icount(1:3)) 820 1238 ELSE IF( indim == 4 ) THEN 821 1239 istart(1:4) = (/ 1, 1, 1, ktobc /) 822 1240 IF( TRIM(cldim) == 'y' ) THEN 823 icount(1:4) = (/ 1 , kobcij, kobck, 1 /)1241 icount(1:4) = (/ 1 , kobcij, jpk , 1 /) 824 1242 ELSE 825 icount(1:4) = (/ kobcij, 1 , kobck, 1 /)1243 icount(1:4) = (/ kobcij, 1 , jpk , 1 /) 826 1244 ENDIF 827 1245 ALLOCATE (v_tmp_4(icount(1),icount(2),icount(3),icount(4))) 828 1246 CALL fliogetv (ifid,TRIM(clobc),v_tmp_4,start=istart(1:4),count=icount(1:4)) 829 1247 IF( TRIM(cldim) == 'y' ) THEN 830 pdta (1:kobcij,1:kobck,1:1) = v_tmp_4(1,1:kobcij,1:kobck,1:1)1248 pdta_3D(1:kobcij,1:jpk,1:1) = v_tmp_4(1,1:kobcij,1:jpk,1:1) 831 1249 ELSE 832 pdta (1:kobcij,1:kobck,1:1) = v_tmp_4(1:kobcij,1,1:kobck,1:1)1250 pdta_3D(1:kobcij,1:jpk,1:1) = v_tmp_4(1:kobcij,1,1:jpk,1:1) 833 1251 ENDIF 834 1252 DEALLOCATE (v_tmp_4) -
trunk/NEMO/OPA_SRC/OBC/obcdyn.F90
r247 r367 22 22 USE lbclnk ! ??? 23 23 USE lib_mpp ! ??? 24 USE dynspg_oce ! choice/control of key cpp for surface pressure gradient 24 25 USE obccli ! ocean open boundary conditions: climatology 25 26 USE in_out_manager ! I/O manager … … 29 30 30 31 !! * Accessibility 31 PUBLIC obc_dyn ! routine called in dynspg_f sc(free surface case)32 PUBLIC obc_dyn ! routine called in dynspg_flt (free surface case) 32 33 ! routine called in dynnxt.F90 (rigid lid case) 33 34 … … 57 58 !! ** Purpose : 58 59 !! Compute dynamics (u,v) at the open boundaries. 59 !! if defined key_dynspg_f sc:60 !! this routine is called by dynspg_f scand updates60 !! if defined key_dynspg_flt: 61 !! this routine is called by dynspg_flt and updates 61 62 !! ua, va which are the actual velocities (not trends) 62 63 !! else (rigid lid case) , … … 74 75 !! ! 97-07 (G. Madec, J.-M. Molines) addition 75 76 !! 8.5 ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90 77 !! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization 76 78 !!---------------------------------------------------------------------- 77 79 !! * Arguments … … 132 134 !! ! 00-06 (J.-M. Molines) 133 135 !! 8.5 ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90 136 !! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization 134 137 !!------------------------------------------------------------------------------ 135 138 !! * Arguments … … 144 147 ! -------------------------------------------------------- 145 148 146 IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbceast ) THEN149 IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbceast .OR. lk_dynspg_exp ) THEN 147 150 148 151 ! 1.1 U zonal velocity … … 151 154 DO jk = 1, jpkm1 152 155 DO jj = 1, jpj 153 # if defined key_dynspg_fsc 154 ua(ji,jj,jk) = ua(ji,jj,jk) * (1.-uemsk(jj,jk)) + & 155 uemsk(jj,jk)*ufoe(jj,jk) 156 # else 156 # if defined key_dynspg_rl 157 157 ua(ji,jj,jk) = ua(ji,jj,jk) * (1.-uemsk(jj,jk)) + & 158 158 uemsk(jj,jk)*( ufoe(jj,jk) - hur (ji,jj) / e2u (ji,jj) & 159 159 * ( bsfn(ji,jj) - bsfn(ji,jj-1) ) ) 160 # else 161 ua(ji,jj,jk) = ua(ji,jj,jk) * (1.-uemsk(jj,jk)) + & 162 uemsk(jj,jk)*ufoe(jj,jk) 160 163 # endif 161 164 END DO … … 220 223 END DO 221 224 END DO 222 # if ! defined key_dynspg_fsc225 # if defined key_dynspg_rl 223 226 ! ... ua must be a baroclinic velocity uclie() 224 227 CALL obc_cli( ua, uclie, nie0, nie1, 0, jpj ) … … 294 297 !! ! 00-06 (J.-M. Molines) 295 298 !! 8.5 ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90 299 !! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization 296 300 !!------------------------------------------------------------------------------ 297 301 !! * Arguments … … 306 310 ! -------------------------------------------------------- 307 311 308 IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbcwest ) THEN312 IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbcwest .OR. lk_dynspg_exp ) THEN 309 313 310 314 ! 1.1 U zonal velocity … … 313 317 DO jk = 1, jpkm1 314 318 DO jj = 1, jpj 315 # if defined key_dynspg_fsc 316 ua(ji,jj,jk) = ua(ji,jj,jk) * (1.-uwmsk(jj,jk)) + & 317 uwmsk(jj,jk)*ufow(jj,jk) 318 # else 319 # if defined key_dynspg_rl 319 320 ua(ji,jj,jk) = ua(ji,jj,jk) * (1.-uwmsk(jj,jk)) + & 320 321 uwmsk(jj,jk)*( ufow(jj,jk) - hur (ji,jj) / e2u (ji,jj) & 321 322 * ( bsfn(ji,jj) - bsfn(ji,jj-1) ) ) 323 # else 324 ua(ji,jj,jk) = ua(ji,jj,jk) * (1.-uwmsk(jj,jk)) + & 325 uwmsk(jj,jk)*ufow(jj,jk) 322 326 # endif 323 327 END DO … … 381 385 END DO 382 386 END DO 383 # if ! defined key_dynspg_fsc387 # if defined key_dynspg_rl 384 388 ! ... ua must be a baroclinic velocity ucliw() 385 389 CALL obc_cli( ua, ucliw, niw0, niw1, 0, jpj ) … … 454 458 !! ! 00-06 (J.-M. Molines) 455 459 !! 8.5 ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90 460 !! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization 456 461 !!------------------------------------------------------------------------------ 457 462 !! * Arguments … … 466 471 ! --------------------------------------------------------- 467 472 468 IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbcnorth ) THEN473 IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbcnorth .OR. lk_dynspg_exp ) THEN 469 474 470 475 ! 1.1 U zonal velocity … … 484 489 DO jk = 1, jpkm1 485 490 DO ji = 1, jpi 486 # if defined key_dynspg_fsc 487 va(ji,jj,jk)= va(ji,jj,jk) * (1.-vnmsk(ji,jk)) + & 488 vfon(ji,jk)*vnmsk(ji,jk) 489 # else 491 # if defined key_dynspg_rl 490 492 va(ji,jj,jk)= va(ji,jj,jk) * (1.-vnmsk(ji,jk)) + & 491 493 vnmsk(ji,jk) * ( vfon(ji,jk) + hvr (ji,jj) / e1v (ji,jj) & 492 494 * ( bsfn(ji,jj) - bsfn(ji-1,jj) ) ) 495 # else 496 va(ji,jj,jk)= va(ji,jj,jk) * (1.-vnmsk(ji,jk)) + & 497 vfon(ji,jk)*vnmsk(ji,jk) 493 498 # endif 494 499 END DO … … 590 595 END DO 591 596 END DO 592 # if ! defined key_dynspg_fsc597 # if defined key_dynspg_rl 593 598 ! ... va must be a baroclinic velocity vclin() 594 599 CALL obc_cli( va, vclin, njn0, njn1, 1, jpi ) … … 625 630 !! ! 00-06 (J.-M. Molines) 626 631 !! 8.5 ! 02-10 (C. Talandier, A-M. Treguier) Free surface, F90 632 !! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization 627 633 !!------------------------------------------------------------------------------ 628 634 !! * Arguments … … 640 646 ! --------------------------------------------------------- 641 647 642 IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbcsouth ) THEN648 IF( ( kt < nit000+3 .AND. .NOT.ln_rstart ) .OR. lfbcsouth .OR. lk_dynspg_exp ) THEN 643 649 644 650 ! 1.1 U zonal velocity … … 658 664 DO jk = 1, jpkm1 659 665 DO ji = 1, jpi 660 # if defined key_dynspg_fsc 661 va(ji,jj,jk)= va(ji,jj,jk) * (1.-vsmsk(ji,jk)) + & 662 vsmsk(ji,jk) * vfos(ji,jk) 663 # else 666 # if defined key_dynspg_rl 664 667 va(ji,jj,jk)= va(ji,jj,jk) * (1.-vsmsk(ji,jk)) + & 665 668 vsmsk(ji,jk) * (vfos(ji,jk) + hvr (ji,jj) / e1v (ji,jj) & 666 669 * ( bsfn(ji,jj) - bsfn(ji-1,jj) ) ) 670 # else 671 va(ji,jj,jk)= va(ji,jj,jk) * (1.-vsmsk(ji,jk)) + & 672 vsmsk(ji,jk) * vfos(ji,jk) 667 673 # endif 668 674 END DO … … 758 764 END DO 759 765 END DO 760 # if ! defined key_dynspg_fsc766 # if defined key_dynspg_rl 761 767 ! ... va must be a baroclinic velocity vclis() 762 768 CALL obc_cli( va, vclis, njs0, njs1, 1, jpi ) -
trunk/NEMO/OPA_SRC/OBC/obcini.F90
r353 r367 55 55 !! ! 97-11 (J.M. Molines) 56 56 !! 8.5 ! 02-11 (C. Talandier, A-M. Treguier) Free surface, F90 57 !! 9.0 ! 05-11 (V. Garnier) Surface pressure gradient organization 57 58 !!---------------------------------------------------------------------- 58 59 !! * Modules used … … 69 70 & rdpeob, rdpwob, rdpnob, rdpsob, & 70 71 & zbsic1, zbsic2, zbsic3, & 71 & nbic, volemp, nobc_dta, ln_obc_clim 72 & nbic, volemp, nobc_dta, & 73 & ln_obc_clim, ln_vol_cst, ln_obc_fla 72 74 !!---------------------------------------------------------------------- 73 75 … … 135 137 IF(lwp) WRITE(numout,*) ' initial state used (=0) ' 136 138 IF(lwp) WRITE(numout,*) ' climatology (true) or not:', ln_obc_clim 139 IF(lwp) WRITE(numout,*) ' ' 140 IF(lwp) WRITE(numout,*) ' WARNING ' 141 IF(lwp) WRITE(numout,*) ' Flather"s algorithm is applied with explicit free surface scheme ' 142 IF(lwp) WRITE(numout,*) ' or with free surface time-splitting scheme ' 143 IF(lwp) WRITE(numout,*) ' Nor radiation neither relaxation is allowed with explicit free surface scheme: ' 144 IF(lwp) WRITE(numout,*) ' Radiation and/or relaxation is allowed with free surface time-splitting scheme ' 145 IF(lwp) WRITE(numout,*) ' depending of the choice of rdpXin = rdpXob = 0. for open boundaries ' 146 IF(lwp) WRITE(numout,*) ' ' 147 IF(lwp) WRITE(numout,*) ' For the rigid-lid case or the filtered free surface case, ' 148 IF(lwp) WRITE(numout,*) ' radiation, relaxation or presciption of data can be applied ' 137 149 IF( lwp.AND.lp_obc_east ) THEN 138 150 WRITE(numout,*) ' East open boundary :' … … 317 329 !... (jpjed,jpjefm1),jpieob 318 330 DO jj = nje0, nje1m1 319 # if defined key_dynspg_fsc 331 # if defined key_dynspg_rl 332 DO ji = nie0, nie1 333 # else 320 334 DO ji = nie0p1, nie1p1 321 # else322 DO ji = nie0, nie1323 335 # endif 324 336 bmask(ji,jj) = 0.e0 … … 368 380 IF( lp_obc_north ) THEN 369 381 ! ... jpjnob,(jpind,jpisfm1) 370 # if defined key_dynspg_fsc 382 # if defined key_dynspg_rl 383 DO jj = njn0, njn1 384 # else 371 385 DO jj = njn0p1, njn1p1 372 # else373 DO jj = njn0, njn1374 386 # endif 375 387 DO ji = nin0, nin1m1 … … 418 430 END IF 419 431 420 # if defined key_dynspg_f sc432 # if defined key_dynspg_flt 421 433 422 434 ! ... Initialize obcumask and obcvmask for the Force filtering 423 ! boundary condition in dynspg_f sc435 ! boundary condition in dynspg_flt 424 436 obcumask(:,:) = umask(:,:,1) 425 437 obcvmask(:,:) = vmask(:,:,1) … … 502 514 END IF 503 515 504 ! 3.1 Total lateral surface for each open boundary 505 ! ------------------------------------------------ 506 507 obcsurftot = 0.e0 508 509 IF( lp_obc_west ) THEN ! ... West open boundary vertical surface 510 DO ji = niw0, niw1 511 DO jj = 1, jpj 512 obcsurftot = obcsurftot+hu(ji,jj)*e2u(ji,jj)*uwmsk(jj,1) 513 END DO 514 END DO 515 END IF 516 517 IF( lp_obc_east ) THEN ! ... East open boundary vertical surface 518 DO ji = nie0, nie1 519 DO jj = 1, jpj 520 obcsurftot = obcsurftot+hu(ji,jj)*e2u(ji,jj)*uemsk(jj,1) 521 END DO 522 END DO 523 END IF 524 525 IF( lp_obc_north ) THEN ! ... North open boundary vertical surface 526 DO jj = njn0, njn1 527 DO ji = 1, jpi 528 obcsurftot = obcsurftot+hv(ji,jj)*e1v(ji,jj)*vnmsk(ji,1) 529 END DO 530 END DO 531 END IF 532 533 IF( lp_obc_south ) THEN ! ... South open boundary vertical surface 534 DO jj = njs0, njs1 535 DO ji = 1, jpi 536 obcsurftot = obcsurftot+hv(ji,jj)*e1v(ji,jj)*vsmsk(ji,1) 537 END DO 538 END DO 539 END IF 540 IF( lk_mpp ) CALL mpp_sum( obcsurftot ) ! sum over the global domain 541 516 # endif 517 518 # if ! defined key_dynspg_rl 519 520 IF ( ln_vol_cst ) THEN 521 522 ! 3.1 Total lateral surface for each open boundary 523 ! ------------------------------------------------ 524 525 ! ... West open boundary surface 526 IF( lp_obc_west ) THEN 527 DO ji = niw0, niw1 528 DO jj = 1, jpj 529 obcsurftot = obcsurftot+hu(ji,jj)*e2u(ji,jj)*uwmsk(jj,1) 530 END DO 531 END DO 532 END IF 533 534 ! ... East open boundary surface 535 IF( lp_obc_east ) THEN 536 DO ji = nie0, nie1 537 DO jj = 1, jpj 538 obcsurftot = obcsurftot+hu(ji,jj)*e2u(ji,jj)*uemsk(jj,1) 539 END DO 540 END DO 541 END IF 542 543 ! ... North open boundary vertical surface 544 IF( lp_obc_north ) THEN 545 DO jj = njn0, njn1 546 DO ji = 1, jpi 547 obcsurftot = obcsurftot+hv(ji,jj)*e1v(ji,jj)*vnmsk(ji,1) 548 END DO 549 END DO 550 END IF 551 552 ! ... South open boundary vertical surface 553 IF( lp_obc_south ) THEN 554 DO jj = njs0, njs1 555 DO ji = 1, jpi 556 obcsurftot = obcsurftot+hv(ji,jj)*e1v(ji,jj)*vsmsk(ji,1) 557 END DO 558 END DO 559 END IF 560 IF( lk_mpp ) CALL mpp_sum( obcsurftot ) ! sum over the global domain 561 ENDIF 542 562 # endif 543 563 … … 712 732 END IF 713 733 714 # if ! defined key_dynspg_fsc734 # if defined key_dynspg_rl 715 735 ! 7. Isolated coastline arrays initialization (rigid lid case only) 716 736 ! ----------------------------------------------------------------- -
trunk/NEMO/OPA_SRC/OBC/obcrad.F90
r247 r367 134 134 ! ... fields nit <== now (kt+1) 135 135 ! ... Total or baroclinic velocity at b, bm and bm2 136 # if ! defined key_dynspg_fsc136 # if defined key_dynspg_rl 137 137 zucb = uclie(jj,jk) 138 138 # else 139 139 zucb = un(ji,jj,jk) 140 140 # endif 141 # if ! defined key_dynspg_fsc141 # if defined key_dynspg_rl 142 142 zucbm = un(ji-1,jj,jk) + hur(ji-1,jj) / e2u(ji-1,jj) & 143 143 * ( bsfn(ji-1,jj) - bsfn(ji-1,jj-1) ) … … 145 145 zucbm = un(ji-1,jj,jk) 146 146 # endif 147 # if ! defined key_dynspg_fsc147 # if defined key_dynspg_rl 148 148 zucbm2 = un(ji-2,jj,jk) + hur(ji-2,jj) / e2u(ji-2,jj) & 149 149 * ( bsfn(ji-2,jj) - bsfn(ji-2,jj-1) ) … … 412 412 uwbnd(jj,jk,nibm2,nitm) = uwbnd(jj,jk,nibm2,nit)*uwmsk(jj,jk) 413 413 ! ... total or baroclinic velocity at b, bm and bm2 414 # if ! defined key_dynspg_fsc414 # if defined key_dynspg_rl 415 415 zucb = ucliw(jj,jk) 416 416 # else 417 417 zucb = un (ji,jj,jk) 418 418 # endif 419 # if ! defined key_dynspg_fsc419 # if defined key_dynspg_rl 420 420 zucbm = un (ji+1,jj,jk) + hur (ji+1,jj) / e2u (ji+1,jj) & 421 421 * ( bsfn(ji+1,jj) - bsfn(ji+1,jj-1) ) … … 423 423 zucbm = un (ji+1,jj,jk) 424 424 # endif 425 # if ! defined key_dynspg_fsc425 # if defined key_dynspg_rl 426 426 zucbm2 = un (ji+2,jj,jk) + hur (ji+2,jj) / e2u (ji+2,jj) & 427 427 * ( bsfn(ji+2,jj) - bsfn(ji+2,jj-1) ) … … 738 738 ! ... fields nit <== now (kt+1) 739 739 ! ... total or baroclinic velocity at b, bm and bm2 740 # if ! defined key_dynspg_fsc740 # if defined key_dynspg_rl 741 741 zvcb = vclin(ji,jk) 742 742 # else 743 743 zvcb = vn (ji,jj,jk) 744 744 # endif 745 # if ! defined key_dynspg_fsc745 # if defined key_dynspg_rl 746 746 zvcbm = vn (ji,jj-1,jk) - hvr (ji,jj-1) / e1v (ji,jj-1) & 747 747 * ( bsfn(ji,jj-1) - bsfn(ji-1,jj-1) ) … … 749 749 zvcbm = vn (ji,jj-1,jk) 750 750 # endif 751 # if ! defined key_dynspg_fsc751 # if defined key_dynspg_rl 752 752 zvcbm2 = vn (ji,jj-2,jk) - hvr (ji,jj-2) / e1v (ji,jj-2) & 753 753 * ( bsfn(ji,jj-2) - bsfn(ji-1,jj-2) ) … … 1026 1026 vsbnd(ji,jk,nibm2,nitm) = vsbnd(ji,jk,nibm2,nit)*vsmsk(ji,jk) 1027 1027 ! ... total or baroclinic velocity at b, bm and bm2 1028 # if ! defined key_dynspg_fsc1028 # if defined key_dynspg_rl 1029 1029 zvcb = vclis(ji,jk) 1030 1030 # else 1031 1031 zvcb = vn (ji,jj,jk) 1032 1032 # endif 1033 # if ! defined key_dynspg_fsc1033 # if defined key_dynspg_rl 1034 1034 zvcbm = vn (ji,jj+1,jk) - hvr (ji,jj+1) / e1v (ji,jj+1) & 1035 1035 * ( bsfn(ji,jj+1) - bsfn(ji-1,jj+1) ) … … 1037 1037 zvcbm = vn (ji,jj+1,jk) 1038 1038 # endif 1039 # if ! defined key_dynspg_fsc1039 # if defined key_dynspg_rl 1040 1040 zvcbm2 = vn (ji,jj+2,jk) - hvr (ji,jj+2) / e1v (ji,jj+2) & 1041 1041 * ( bsfn(ji,jj+2) - bsfn(ji-1,jj+2) ) -
trunk/NEMO/OPA_SRC/OBC/obcrst.F90
r247 r367 130 130 PRINT *,'Narea =',narea,' write jrec =2 east' 131 131 WRITE(inum,REC=jrec) & 132 # if ! defined key_dynspg_fsc132 # if defined key_dynspg_rl 133 133 (( bebnd(jfoe, jb,jt), jb=1,3),jt=1,3), & 134 134 # endif … … 145 145 jrec = 2 + jj + njmpp -1 -jpjed 146 146 WRITE (inum,REC=jrec) & 147 # if ! defined key_dynspg_fsc147 # if defined key_dynspg_rl 148 148 (( bebnd(jfoe, jb,jt), jb=1,3),jt=1,3), & 149 149 # endif … … 175 175 PRINT *,'Narea =',narea,' write jrec =',jrec,' west' 176 176 WRITE (inum,REC=jrec) & 177 # if ! defined key_dynspg_fsc177 # if defined key_dynspg_rl 178 178 (( bwbnd(jfow, jb,jt), jb=1,3),jt=1,3), & 179 179 # endif … … 190 190 jrec = 3 + jpjef -jpjed + jj + njmpp -1 -jpjwd 191 191 WRITE (inum,REC=jrec) & 192 # if ! defined key_dynspg_fsc192 # if defined key_dynspg_rl 193 193 (( bwbnd(jfow, jb,jt), jb=1,3),jt=1,3), & 194 194 # endif … … 219 219 ifon = jpind -nimpp +1 220 220 WRITE (inum,REC=jrec) & 221 # if ! defined key_dynspg_fsc221 # if defined key_dynspg_rl 222 222 (( bnbnd(ifon, jb,jt), jb=1,3),jt=1,3), & 223 223 # endif … … 234 234 jrec = 4 + jpjef -jpjed + jpjwf -jpjwd +ji + nimpp -1 -jpind 235 235 WRITE (inum,REC=jrec) & 236 # if ! defined key_dynspg_fsc236 # if defined key_dynspg_rl 237 237 (( bnbnd(ifon, jb,jt), jb=1,3),jt=1,3), & 238 238 # endif … … 264 264 ifos = jpisd -nimpp + 1 265 265 WRITE (inum,REC=jrec) & 266 # if ! defined key_dynspg_fsc266 # if defined key_dynspg_rl 267 267 (( bsbnd(ifos, jb,jt), jb=1,3),jt=1,3), & 268 268 # endif … … 280 280 ji + nimpp -1 -jpisd 281 281 WRITE (inum,REC=jrec) & 282 # if ! defined key_dynspg_fsc282 # if defined key_dynspg_rl 283 283 (( bsbnd(ifos, jb,jt), jb=1,3),jt=1,3), & 284 284 # endif … … 520 520 jfoe = jpjed -njmpp + 1 521 521 READ (inum,REC=jrec) & 522 # if ! defined key_dynspg_fsc522 # if defined key_dynspg_rl 523 523 (( bebnd(jfoe, jb,jt), jb=1,3),jt=1,3), & 524 524 # endif … … 535 535 jrec = 2 + jj + njmpp -1 -jpjed 536 536 READ (inum,REC=jrec) & 537 # if ! defined key_dynspg_fsc537 # if defined key_dynspg_rl 538 538 (( bebnd(jfoe, jb,jt), jb=1,3),jt=1,3), & 539 539 # endif … … 562 562 jfow = jpjwd -njmpp + 1 563 563 READ (inum,REC=jrec) & 564 # if ! defined key_dynspg_fsc564 # if defined key_dynspg_rl 565 565 (( bwbnd(jfow, jb,jt), jb=1,3),jt=1,3), & 566 566 # endif … … 577 577 jrec = 3 + jpjef -jpjed + jj + njmpp -1 -jpjwd 578 578 READ (inum,REC=jrec) & 579 # if ! defined key_dynspg_fsc579 # if defined key_dynspg_rl 580 580 (( bwbnd(jfow, jb,jt), jb=1,3),jt=1,3), & 581 581 # endif … … 604 604 ifon = jpind -nimpp +1 605 605 READ (inum,REC=jrec) & 606 # if ! defined key_dynspg_fsc606 # if defined key_dynspg_rl 607 607 (( bnbnd(ifon, jb,jt), jb=1,3),jt=1,3), & 608 608 # endif … … 619 619 jrec = 4 + jpjef -jpjed + jpjwf -jpjwd +ji + nimpp -1 -jpind 620 620 READ (inum,REC=jrec) & 621 # if ! defined key_dynspg_fsc621 # if defined key_dynspg_rl 622 622 (( bnbnd(ifon, jb,jt), jb=1,3),jt=1,3), & 623 623 # endif … … 646 646 ifos = jpisd -nimpp + 1 647 647 READ (inum,REC=jrec) & 648 # if ! defined key_dynspg_fsc648 # if defined key_dynspg_rl 649 649 (( bsbnd(ifos, jb,jt), jb=1,3),jt=1,3), & 650 650 # endif … … 662 662 ji + nimpp -1 -jpisd 663 663 READ (inum,REC=jrec) & 664 # if ! defined key_dynspg_fsc664 # if defined key_dynspg_rl 665 665 (( bsbnd(ifos, jb,jt), jb=1,3),jt=1,3), & 666 666 # endif … … 680 680 IF( lk_mpp ) THEN 681 681 IF( lp_obc_east ) THEN 682 # if ! defined key_dynspg_fsc682 # if defined key_dynspg_rl 683 683 CALL mppobc(bebnd,jpjed,jpjef,jpieob,3*3,2,jpj) 684 684 # endif … … 689 689 ENDIF 690 690 IF( lp_obc_west ) THEN 691 # if ! defined key_dynspg_fsc691 # if defined key_dynspg_rl 692 692 CALL mppobc(bwbnd,jpjwd,jpjwf,jpiwob,3*3,2,jpj) 693 693 # endif … … 698 698 ENDIF 699 699 IF( lp_obc_north ) THEN 700 # if ! defined key_dynspg_fsc700 # if defined key_dynspg_rl 701 701 CALL mppobc(bnbnd,jpind,jpinf,jpjnob ,3*3 ,1,jpi) 702 702 # endif … … 707 707 ENDIF 708 708 IF( lp_obc_south ) THEN 709 # if ! defined key_dynspg_fsc709 # if defined key_dynspg_rl 710 710 CALL mppobc(bsbnd,jpisd,jpisf,jpjsob, 3*3,1,jpi) 711 711 # endif -
trunk/NEMO/OPA_SRC/OBC/obcvol.F90
r247 r367 4 4 !! Ocean dynamic : Volume constraint when OBC and Free surface are used 5 5 !!================================================================================= 6 #if defined key_obc && defined key_dynspg_fsc6 #if defined key_obc && ! defined key_dynspg_rl 7 7 !!--------------------------------------------------------------------------------- 8 8 !! 'key_obc' and open boundary conditions 9 !! 'key_dynspg_f sc' constant volume free surface9 !! 'key_dynspg_flt' constant volume free surface 10 10 !!--------------------------------------------------------------------------------- 11 11 !! * Modules used … … 22 22 23 23 !! * Accessibility 24 PUBLIC obc_vol ! routine called by dynspg_f sc.h9024 PUBLIC obc_vol ! routine called by dynspg_flt 25 25 26 26 !! * Substitutions … … 40 40 !! 41 41 !! ** Purpose : 42 !! This routine is called in dynspg_f scto control42 !! This routine is called in dynspg_flt to control 43 43 !! the volume of the system. A correction velocity is calculated 44 44 !! to correct the total transport through the OBC. -
trunk/NEMO/OPA_SRC/SOL/solver.F90
r359 r367 19 19 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 20 20 USE lib_mpp 21 USE dynspg 21 USE dynspg_oce ! choice/control of key cpp for surface pressure gradient 22 22 23 23 IMPLICIT NONE -
trunk/NEMO/OPA_SRC/TRA/traadv_cen2.F90
r359 r367 22 22 USE in_out_manager ! I/O manager 23 23 USE diaptr ! poleward transport diagnostics 24 USE dynspg 24 USE dynspg_oce ! choice/control of key cpp for surface pressure gradient 25 25 USE prtctl ! Print control 26 26 -
trunk/NEMO/OPA_SRC/TRA/traadv_muscl.F90
r359 r367 15 15 USE trdmod_oce ! ocean variables trends 16 16 USE in_out_manager ! I/O manager 17 USE dynspg 17 USE dynspg_oce ! choice/control of key cpp for surface pressure gradient 18 18 USE trabbl ! tracers: bottom boundary layer 19 19 USE lib_mpp ! distribued memory computing -
trunk/NEMO/OPA_SRC/TRA/traadv_muscl2.F90
r359 r367 15 15 USE trdmod_oce ! ocean variables trends 16 16 USE in_out_manager ! I/O manager 17 USE dynspg 17 USE dynspg_oce ! choice/control of key cpp for surface pressure gradient 18 18 USE trabbl ! tracers: bottom boundary layer 19 19 USE lib_mpp -
trunk/NEMO/OPA_SRC/TRA/traadv_tvd.F90
r359 r367 17 17 USE trdmod_oce ! ocean variables trends 18 18 USE in_out_manager ! I/O manager 19 USE dynspg 19 USE dynspg_oce ! choice/control of key cpp for surface pressure gradient 20 20 USE trabbl ! Advective term of BBL 21 21 USE lib_mpp -
trunk/NEMO/OPA_SRC/opa.F90
r359 r367 47 47 48 48 USE step ! OPA time-stepping (stp routine) 49 USE dynspg 49 USE dynspg_oce ! Control choice of surface pressure gradient schemes 50 50 USE prtctl ! Print control (prt_ctl_init routine) 51 51 USE ini1d ! re-initialization of u-v mask for the 1D configuration -
trunk/NEMO/OPA_SRC/restart.F90
r359 r367 21 21 USE blk_oce ! bulk variables 22 22 USE flx_oce ! sea-ice/ocean forcings variables 23 USE dynspg ! choice/control of key cpp for surface pressure gradient 24 USE dynspg_ts ! free surface time splitting scheme variables 23 USE dynspg_oce ! free surface time splitting scheme variables 25 24 USE cpl_oce, ONLY : lk_cpl ! 26 25 -
trunk/NEMO/OPA_SRC/step.F90
r359 r367 35 35 USE dynhpg ! hydrostatic pressure grad. (dyn_hpg routine) 36 36 USE dynhpg_atsk ! hydrostatic pressure grad. (dyn_hpg_atsk routine) 37 USE dynspg_oce ! surface pressure gradient (dyn_spg routine) 37 38 USE dynspg ! surface pressure gradient (dyn_spg routine) 38 39 USE dynkeg ! kinetic energy gradient (dyn_keg routine) -
trunk/NEMO/OPA_SRC/stpctl.F90
r359 r367 17 17 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 18 18 USE lib_mpp ! distributed memory computing 19 USE dynspg 19 USE dynspg_oce ! pressure gradient schemes 20 20 21 21 IMPLICIT NONE
Note: See TracChangeset
for help on using the changeset viewer.