Changeset 13540 for NEMO/branches/2020/r12377_ticket2386/src/OCE/BDY
- Timestamp:
- 2020-09-29T12:41:06+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/r12377_ticket2386
- Files:
-
- 11 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/r12377_ticket2386
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEADext/AGRIF5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 8 9 9 # SETTE 10 ^/utils/CI/sette@ HEADsette10 ^/utils/CI/sette@13507 sette
-
- Property svn:externals
-
NEMO/branches/2020/r12377_ticket2386/src/OCE/BDY/bdy_oce.F90
r12377 r13540 63 63 REAL(wp), POINTER, DIMENSION(:,:) :: aip !: now ice pond concentration 64 64 REAL(wp), POINTER, DIMENSION(:,:) :: hip !: now ice pond depth 65 REAL(wp), POINTER, DIMENSION(:,:) :: hil !: now ice pond lid depth 65 66 #if defined key_top 66 67 CHARACTER(LEN=20) :: cn_obc !: type of boundary condition to apply … … 115 116 REAL(wp), DIMENSION(jp_bdy) :: rice_apnd !: pond conc. of incoming sea ice 116 117 REAL(wp), DIMENSION(jp_bdy) :: rice_hpnd !: pond thick. of incoming sea ice 118 REAL(wp), DIMENSION(jp_bdy) :: rice_hlid !: pond lid thick. of incoming sea ice 117 119 ! 118 120 !!---------------------------------------------------------------------- -
NEMO/branches/2020/r12377_ticket2386/src/OCE/BDY/bdydta.F90
r12511 r13540 43 43 PUBLIC bdy_dta_init ! routine called by nemogcm.F90 44 44 45 INTEGER , PARAMETER :: jpbdyfld = 1 6! maximum number of files to read45 INTEGER , PARAMETER :: jpbdyfld = 17 ! maximum number of files to read 46 46 INTEGER , PARAMETER :: jp_bdyssh = 1 ! 47 47 INTEGER , PARAMETER :: jp_bdyu2d = 2 ! … … 60 60 INTEGER , PARAMETER :: jp_bdyaip = 15 ! 61 61 INTEGER , PARAMETER :: jp_bdyhip = 16 ! 62 INTEGER , PARAMETER :: jp_bdyhil = 17 ! 62 63 #if ! defined key_si3 63 64 INTEGER , PARAMETER :: jpl = 1 … … 70 71 !! * Substitutions 71 72 # include "do_loop_substitute.h90" 73 # include "domzgr_substitute.h90" 72 74 !!---------------------------------------------------------------------- 73 75 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 91 93 INTEGER :: jbdy, jfld, jstart, jend, ib, jl ! dummy loop indices 92 94 INTEGER :: ii, ij, ik, igrd, ipl ! local integers 93 INTEGER, DIMENSION(jpbgrd) :: ilen194 INTEGER, DIMENSION(:), POINTER :: nblen, nblenrim ! short cuts95 95 TYPE(OBC_DATA) , POINTER :: dta_alias ! short cut 96 96 TYPE(FLD), DIMENSION(:), POINTER :: bf_alias … … 108 108 DO jbdy = 1, nb_bdy 109 109 ! 110 nblen => idx_bdy(jbdy)%nblen111 nblenrim => idx_bdy(jbdy)%nblenrim112 !113 110 IF( nn_dyn2d_dta(jbdy) == 0 ) THEN 114 ilen1(:) = nblen(:)115 111 IF( dta_bdy(jbdy)%lneed_ssh ) THEN 116 112 igrd = 1 117 DO ib = 1, i len1(igrd)113 DO ib = 1, idx_bdy(jbdy)%nblenrim(igrd) ! ssh is allocated and used only on the rim 118 114 ii = idx_bdy(jbdy)%nbi(ib,igrd) 119 115 ij = idx_bdy(jbdy)%nbj(ib,igrd) … … 121 117 END DO 122 118 ENDIF 123 IF( dta_bdy(jbdy)%lneed_dyn2d) THEN119 IF( ASSOCIATED(dta_bdy(jbdy)%u2d) ) THEN ! no SIZE with a unassociated pointer. v2d and u2d can differ on subdomain 124 120 igrd = 2 125 DO ib = 1, ilen1(igrd)121 DO ib = 1, SIZE(dta_bdy(jbdy)%u2d) ! u2d is used either over the whole bdy or only on the rim 126 122 ii = idx_bdy(jbdy)%nbi(ib,igrd) 127 123 ij = idx_bdy(jbdy)%nbj(ib,igrd) 128 124 dta_bdy(jbdy)%u2d(ib) = uu_b(ii,ij,Kmm) * umask(ii,ij,1) 129 125 END DO 126 ENDIF 127 IF( ASSOCIATED(dta_bdy(jbdy)%v2d) ) THEN ! no SIZE with a unassociated pointer. v2d and u2d can differ on subdomain 130 128 igrd = 3 131 DO ib = 1, ilen1(igrd)129 DO ib = 1, SIZE(dta_bdy(jbdy)%v2d) ! v2d is used either over the whole bdy or only on the rim 132 130 ii = idx_bdy(jbdy)%nbi(ib,igrd) 133 131 ij = idx_bdy(jbdy)%nbj(ib,igrd) … … 138 136 ! 139 137 IF( nn_dyn3d_dta(jbdy) == 0 ) THEN 140 ilen1(:) = nblen(:)141 138 IF( dta_bdy(jbdy)%lneed_dyn3d ) THEN 142 139 igrd = 2 143 DO ib = 1, i len1(igrd)140 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 144 141 DO ik = 1, jpkm1 145 142 ii = idx_bdy(jbdy)%nbi(ib,igrd) … … 149 146 END DO 150 147 igrd = 3 151 DO ib = 1, i len1(igrd)148 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 152 149 DO ik = 1, jpkm1 153 150 ii = idx_bdy(jbdy)%nbi(ib,igrd) … … 160 157 161 158 IF( nn_tra_dta(jbdy) == 0 ) THEN 162 ilen1(:) = nblen(:)163 159 IF( dta_bdy(jbdy)%lneed_tra ) THEN 164 160 igrd = 1 165 DO ib = 1, i len1(igrd)161 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 166 162 DO ik = 1, jpkm1 167 163 ii = idx_bdy(jbdy)%nbi(ib,igrd) … … 176 172 #if defined key_si3 177 173 IF( nn_ice_dta(jbdy) == 0 ) THEN ! set ice to initial values 178 ilen1(:) = nblen(:)179 174 IF( dta_bdy(jbdy)%lneed_ice ) THEN 180 175 igrd = 1 181 176 DO jl = 1, jpl 182 DO ib = 1, i len1(igrd)177 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 183 178 ii = idx_bdy(jbdy)%nbi(ib,igrd) 184 179 ij = idx_bdy(jbdy)%nbj(ib,igrd) … … 193 188 dta_bdy(jbdy)%aip(ib,jl) = a_ip(ii,ij,jl) * tmask(ii,ij,1) 194 189 dta_bdy(jbdy)%hip(ib,jl) = h_ip(ii,ij,jl) * tmask(ii,ij,1) 190 dta_bdy(jbdy)%hil(ib,jl) = h_il(ii,ij,jl) * tmask(ii,ij,1) 195 191 END DO 196 192 END DO … … 218 214 ! 219 215 ! if runoff condition: change river flow we read (in m3/s) into barotropic velocity (m/s) 220 IF( cn_tra(jbdy) == 'runoff' .AND. TRIM(bf_alias(jp_bdyu2d)%clrootname) /= 'NOT USED' ) THEN ! runoff and we read u/v2d216 IF( cn_tra(jbdy) == 'runoff' ) THEN ! runoff 221 217 ! 222 igrd = 2 ! zonal flow (m3/s) to barotropic zonal velocity (m/s) 223 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 224 ii = idx_bdy(jbdy)%nbi(ib,igrd) 225 ij = idx_bdy(jbdy)%nbj(ib,igrd) 226 dta_alias%u2d(ib) = dta_alias%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) ) 227 END DO 228 igrd = 3 ! meridional flow (m3/s) to barotropic meridional velocity (m/s) 229 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 230 ii = idx_bdy(jbdy)%nbi(ib,igrd) 231 ij = idx_bdy(jbdy)%nbj(ib,igrd) 232 dta_alias%v2d(ib) = dta_alias%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) ) 233 END DO 218 IF( ASSOCIATED(dta_bdy(jbdy)%u2d) ) THEN ! no SIZE with a unassociated pointer. v2d and u2d can differ on subdomain 219 igrd = 2 ! zonal flow (m3/s) to barotropic zonal velocity (m/s) 220 DO ib = 1, SIZE(dta_alias%u2d) ! u2d is used either over the whole bdy or only on the rim 221 ii = idx_bdy(jbdy)%nbi(ib,igrd) 222 ij = idx_bdy(jbdy)%nbj(ib,igrd) 223 dta_alias%u2d(ib) = dta_alias%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) ) 224 END DO 225 ENDIF 226 IF( ASSOCIATED(dta_bdy(jbdy)%v2d) ) THEN ! no SIZE with a unassociated pointer. v2d and u2d can differ on subdomain 227 igrd = 3 ! meridional flow (m3/s) to barotropic meridional velocity (m/s) 228 DO ib = 1, SIZE(dta_alias%v2d) ! v2d is used either over the whole bdy or only on the rim 229 ii = idx_bdy(jbdy)%nbi(ib,igrd) 230 ij = idx_bdy(jbdy)%nbj(ib,igrd) 231 dta_alias%v2d(ib) = dta_alias%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) ) 232 END DO 233 ENDIF 234 234 ENDIF 235 235 236 236 ! tidal harmonic forcing ONLY: initialise arrays 237 237 IF( nn_dyn2d_dta(jbdy) == 2 ) THEN ! we did not read ssh, u/v2d 238 IF( dta_alias%lneed_ssh) dta_alias%ssh(:) = 0._wp239 IF( dta_alias%lneed_dyn2d) dta_alias%u2d(:) = 0._wp240 IF( dta_alias%lneed_dyn2d) dta_alias%v2d(:) = 0._wp238 IF( ASSOCIATED(dta_alias%ssh) ) dta_alias%ssh(:) = 0._wp 239 IF( ASSOCIATED(dta_alias%u2d) ) dta_alias%u2d(:) = 0._wp 240 IF( ASSOCIATED(dta_alias%v2d) ) dta_alias%v2d(:) = 0._wp 241 241 ENDIF 242 242 … … 245 245 ! 246 246 igrd = 2 ! zonal velocity 247 dta_alias%u2d(:) = 0._wp ! compute barotrope zonal velocity and put it in u2d248 247 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 249 248 ii = idx_bdy(jbdy)%nbi(ib,igrd) 250 249 ij = idx_bdy(jbdy)%nbj(ib,igrd) 250 dta_alias%u2d(ib) = 0._wp ! compute barotrope zonal velocity and put it in u2d 251 251 DO ik = 1, jpkm1 252 dta_alias%u2d(ib) = dta_alias%u2d(ib) + e3u(ii,ij,ik,Kmm) * umask(ii,ij,ik) * dta_alias%u3d(ib,ik) 252 dta_alias%u2d(ib) = dta_alias%u2d(ib) & 253 & + e3u(ii,ij,ik,Kmm) * umask(ii,ij,ik) * dta_alias%u3d(ib,ik) 253 254 END DO 254 255 dta_alias%u2d(ib) = dta_alias%u2d(ib) * r1_hu(ii,ij,Kmm) … … 258 259 END DO 259 260 igrd = 3 ! meridional velocity 260 dta_alias%v2d(:) = 0._wp ! compute barotrope meridional velocity and put it in v2d261 261 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 262 262 ii = idx_bdy(jbdy)%nbi(ib,igrd) 263 263 ij = idx_bdy(jbdy)%nbj(ib,igrd) 264 dta_alias%v2d(ib) = 0._wp ! compute barotrope meridional velocity and put it in v2d 264 265 DO ik = 1, jpkm1 265 dta_alias%v2d(ib) = dta_alias%v2d(ib) + e3v(ii,ij,ik,Kmm) * vmask(ii,ij,ik) * dta_alias%v3d(ib,ik) 266 dta_alias%v2d(ib) = dta_alias%v2d(ib) & 267 & + e3v(ii,ij,ik,Kmm) * vmask(ii,ij,ik) * dta_alias%v3d(ib,ik) 266 268 END DO 267 269 dta_alias%v2d(ib) = dta_alias%v2d(ib) * r1_hv(ii,ij,Kmm) … … 283 285 284 286 #if defined key_si3 285 IF( dta_alias%lneed_ice ) THEN287 IF( dta_alias%lneed_ice .AND. idx_bdy(jbdy)%nblen(1) > 0 ) THEN 286 288 ! fill temperature and salinity arrays 287 289 IF( TRIM(bf_alias(jp_bdyt_i)%clrootname) == 'NOT USED' ) bf_alias(jp_bdyt_i)%fnow(:,1,:) = rice_tem (jbdy) … … 289 291 IF( TRIM(bf_alias(jp_bdytsu)%clrootname) == 'NOT USED' ) bf_alias(jp_bdytsu)%fnow(:,1,:) = rice_tem (jbdy) 290 292 IF( TRIM(bf_alias(jp_bdys_i)%clrootname) == 'NOT USED' ) bf_alias(jp_bdys_i)%fnow(:,1,:) = rice_sal (jbdy) 291 IF( TRIM(bf_alias(jp_bdyaip)%clrootname) == 'NOT USED' ) bf_alias(jp_bdyaip)%fnow(:,1,:) = rice_apnd(jbdy) * &! rice_apnd is the pond fraction292 & bf_alias(jp_bdya_i)%fnow(:,1,:) ! ( a_ip = rice_apnd *a_i )293 IF( TRIM(bf_alias(jp_bdyaip)%clrootname) == 'NOT USED' ) & ! rice_apnd is the pond fraction 294 & bf_alias(jp_bdyaip)%fnow(:,1,:) = rice_apnd(jbdy) * bf_alias(jp_bdya_i)%fnow(:,1,:) ! ( a_ip = rice_apnd*a_i ) 293 295 IF( TRIM(bf_alias(jp_bdyhip)%clrootname) == 'NOT USED' ) bf_alias(jp_bdyhip)%fnow(:,1,:) = rice_hpnd(jbdy) 294 296 IF( TRIM(bf_alias(jp_bdyhil)%clrootname) == 'NOT USED' ) bf_alias(jp_bdyhil)%fnow(:,1,:) = rice_hlid(jbdy) 297 295 298 ! if T_i is read and not T_su, set T_su = T_i 296 299 IF( TRIM(bf_alias(jp_bdyt_i)%clrootname) /= 'NOT USED' .AND. TRIM(bf_alias(jp_bdytsu)%clrootname) == 'NOT USED' ) & … … 316 319 bf_alias(jp_bdyaip)%fnow(:,1,:) = 0._wp 317 320 bf_alias(jp_bdyhip)%fnow(:,1,:) = 0._wp 321 bf_alias(jp_bdyhil)%fnow(:,1,:) = 0._wp 322 ENDIF 323 IF ( .NOT.ln_pnd_lids ) THEN 324 bf_alias(jp_bdyhil)%fnow(:,1,:) = 0._wp 318 325 ENDIF 319 326 … … 321 328 ipl = SIZE(bf_alias(jp_bdya_i)%fnow, 3) 322 329 IF( ipl /= jpl ) THEN ! ice: convert N-cat fields (input) into jpl-cat (output) 323 CALL ice_var_itd( bf_alias(jp_bdyh_i)%fnow(:,1,:), bf_alias(jp_bdyh_s)%fnow(:,1,:), bf_alias(jp_bdya_i)%fnow(:,1,:), & 324 & dta_alias%h_i , dta_alias%h_s , dta_alias%a_i , & 325 & bf_alias(jp_bdyt_i)%fnow(:,1,:), bf_alias(jp_bdyt_s)%fnow(:,1,:), & 326 & bf_alias(jp_bdytsu)%fnow(:,1,:), bf_alias(jp_bdys_i)%fnow(:,1,:), & 327 & bf_alias(jp_bdyaip)%fnow(:,1,:), bf_alias(jp_bdyhip)%fnow(:,1,:), &328 & dta_alias%t_i , dta_alias%t_s , & 329 & dta_alias%tsu , dta_alias%s_i , & 330 & dta_alias%aip , dta_alias%hip )330 CALL ice_var_itd( bf_alias(jp_bdyh_i)%fnow(:,1,:), bf_alias(jp_bdyh_s)%fnow(:,1,:), bf_alias(jp_bdya_i)%fnow(:,1,:), & ! in 331 & dta_alias%h_i , dta_alias%h_s , dta_alias%a_i , & ! out 332 & bf_alias(jp_bdyt_i)%fnow(:,1,:), bf_alias(jp_bdyt_s)%fnow(:,1,:), & ! in (optional) 333 & bf_alias(jp_bdytsu)%fnow(:,1,:), bf_alias(jp_bdys_i)%fnow(:,1,:), & ! in - 334 & bf_alias(jp_bdyaip)%fnow(:,1,:), bf_alias(jp_bdyhip)%fnow(:,1,:), bf_alias(jp_bdyhil)%fnow(:,1,:), & ! in - 335 & dta_alias%t_i , dta_alias%t_s , & ! out - 336 & dta_alias%tsu , dta_alias%s_i , & ! out - 337 & dta_alias%aip , dta_alias%hip , dta_alias%hil ) ! out - 331 338 ENDIF 332 339 ENDIF … … 338 345 DO jbdy = 1, nb_bdy ! Tidal component added in ts loop 339 346 IF ( nn_dyn2d_dta(jbdy) .GE. 2 ) THEN 340 nblen => idx_bdy(jbdy)%nblen 341 nblenrim => idx_bdy(jbdy)%nblenrim 342 IF( cn_dyn2d(jbdy) == 'frs' ) THEN ; ilen1(:)=nblen(:) 343 ELSE ; ilen1(:)=nblenrim(:) 344 ENDIF 345 IF ( dta_bdy(jbdy)%lneed_ssh ) dta_bdy_s(jbdy)%ssh(1:ilen1(1)) = dta_bdy(jbdy)%ssh(1:ilen1(1)) 346 IF ( dta_bdy(jbdy)%lneed_dyn2d ) dta_bdy_s(jbdy)%u2d(1:ilen1(2)) = dta_bdy(jbdy)%u2d(1:ilen1(2)) 347 IF ( dta_bdy(jbdy)%lneed_dyn2d ) dta_bdy_s(jbdy)%v2d(1:ilen1(3)) = dta_bdy(jbdy)%v2d(1:ilen1(3)) 347 IF( ASSOCIATED(dta_bdy(jbdy)%ssh) ) dta_bdy_s(jbdy)%ssh(:) = dta_bdy(jbdy)%ssh(:) 348 IF( ASSOCIATED(dta_bdy(jbdy)%u2d) ) dta_bdy_s(jbdy)%u2d(:) = dta_bdy(jbdy)%u2d(:) 349 IF( ASSOCIATED(dta_bdy(jbdy)%v2d) ) dta_bdy_s(jbdy)%v2d(:) = dta_bdy(jbdy)%v2d(:) 348 350 ENDIF 349 351 END DO 350 352 ELSE ! Add tides if not split-explicit free surface else this is done in ts loop 351 353 ! 352 ! BDY: use pt_offset=1.0 as applied at the end of the step and bdy_dta_tides is referenced at the middle of the step353 354 CALL bdy_dta_tides( kt=kt, pt_offset = 1._wp ) 354 355 ENDIF … … 358 359 ! 359 360 END SUBROUTINE bdy_dta 360 361 361 362 362 363 SUBROUTINE bdy_dta_init … … 380 381 ! ! =F => baroclinic velocities in 3D boundary data 381 382 LOGICAL :: ln_zinterp ! =T => requires a vertical interpolation of the bdydta 382 REAL(wp) :: rn_ice_tem, rn_ice_sal, rn_ice_age, rn_ice_apnd, rn_ice_hpnd 383 REAL(wp) :: rn_ice_tem, rn_ice_sal, rn_ice_age, rn_ice_apnd, rn_ice_hpnd, rn_ice_hlid 383 384 INTEGER :: ipk,ipl ! 384 385 INTEGER :: idvar ! variable ID … … 390 391 LOGICAL :: llneed ! 391 392 LOGICAL :: llread ! 393 LOGICAL :: llfullbdy ! 392 394 TYPE(FLD_N), DIMENSION(1), TARGET :: bn_tem, bn_sal, bn_u3d, bn_v3d ! must be an array to be used with fld_fill 393 395 TYPE(FLD_N), DIMENSION(1), TARGET :: bn_ssh, bn_u2d, bn_v2d ! informations about the fields to be read 394 TYPE(FLD_N), DIMENSION(1), TARGET :: bn_a_i, bn_h_i, bn_h_s, bn_t_i, bn_t_s, bn_tsu, bn_s_i, bn_aip, bn_hip 396 TYPE(FLD_N), DIMENSION(1), TARGET :: bn_a_i, bn_h_i, bn_h_s, bn_t_i, bn_t_s, bn_tsu, bn_s_i, bn_aip, bn_hip, bn_hil 395 397 TYPE(FLD_N), DIMENSION(:), POINTER :: bn_alias ! must be an array to be used with fld_fill 396 398 TYPE(FLD ), DIMENSION(:), POINTER :: bf_alias 397 399 ! 398 NAMELIST/nambdy_dta/ cn_dir, bn_tem, bn_sal, bn_u3d, bn_v3d, bn_ssh, bn_u2d, bn_v2d 399 NAMELIST/nambdy_dta/ bn_a_i, bn_h_i, bn_h_s, bn_t_i, bn_t_s, bn_tsu, bn_s_i, bn_aip, bn_hip400 NAMELIST/nambdy_dta/ rn_ice_tem, rn_ice_sal, rn_ice_age, rn_ice_apnd, rn_ice_hpnd401 NAMELIST/nambdy_dta/ln_full_vel, ln_zinterp400 NAMELIST/nambdy_dta/ cn_dir, bn_tem, bn_sal, bn_u3d, bn_v3d, bn_ssh, bn_u2d, bn_v2d, & 401 & bn_a_i, bn_h_i, bn_h_s, bn_t_i, bn_t_s, bn_tsu, bn_s_i, bn_aip, bn_hip, bn_hil, & 402 & rn_ice_tem, rn_ice_sal, rn_ice_age, rn_ice_apnd, rn_ice_hpnd, rn_ice_hlid, & 403 & ln_full_vel, ln_zinterp 402 404 !!--------------------------------------------------------------------------- 403 405 ! … … 469 471 #if defined key_si3 470 472 IF( .NOT.ln_pnd ) THEN 471 rn_ice_apnd = 0. ; rn_ice_hpnd = 0. 472 CALL ctl_warn( 'rn_ice_apnd & rn_ice_hpnd = 0 when no ponds' ) 473 rn_ice_apnd = 0. ; rn_ice_hpnd = 0. ; rn_ice_hlid = 0. 474 CALL ctl_warn( 'rn_ice_apnd & rn_ice_hpnd = 0 & rn_ice_hlid = 0 when no ponds' ) 475 ENDIF 476 IF( .NOT.ln_pnd_lids ) THEN 477 rn_ice_hlid = 0. 473 478 ENDIF 474 479 #endif … … 480 485 rice_apnd(jbdy) = rn_ice_apnd 481 486 rice_hpnd(jbdy) = rn_ice_hpnd 482 487 rice_hlid(jbdy) = rn_ice_hlid 488 483 489 484 490 DO jfld = 1, jpbdyfld … … 504 510 igrd = 2 ! U point 505 511 ipk = 1 ! surface data 506 llneed = dta_bdy(jbdy)%lneed_dyn2d ! dta_bdy(jbdy)% sshwill be needed512 llneed = dta_bdy(jbdy)%lneed_dyn2d ! dta_bdy(jbdy)%u2d will be needed 507 513 llread = .NOT. ln_full_vel .AND. MOD(nn_dyn2d_dta(jbdy),2) == 1 ! don't get u2d from u3d and read NetCDF file 508 514 bf_alias => bf(jp_bdyu2d,jbdy:jbdy) ! alias for u2d structure of bdy number jbdy 509 515 bn_alias => bn_u2d ! alias for u2d structure of nambdy_dta 510 IF( ln_full_vel ) THEN ; iszdim = idx_bdy(jbdy)%nblen(igrd) ! will be computed from u3d -> need on the full bdy 511 ELSE ; iszdim = idx_bdy(jbdy)%nblenrim(igrd) ! used only on the rim 516 llfullbdy = ln_full_vel .OR. cn_dyn2d(jbdy) == 'frs' ! need u2d over the whole bdy or only over the rim? 517 IF( llfullbdy ) THEN ; iszdim = idx_bdy(jbdy)%nblen(igrd) 518 ELSE ; iszdim = idx_bdy(jbdy)%nblenrim(igrd) 512 519 ENDIF 513 520 ENDIF … … 516 523 igrd = 3 ! V point 517 524 ipk = 1 ! surface data 518 llneed = dta_bdy(jbdy)%lneed_dyn2d ! dta_bdy(jbdy)% sshwill be needed525 llneed = dta_bdy(jbdy)%lneed_dyn2d ! dta_bdy(jbdy)%v2d will be needed 519 526 llread = .NOT. ln_full_vel .AND. MOD(nn_dyn2d_dta(jbdy),2) == 1 ! don't get v2d from v3d and read NetCDF file 520 527 bf_alias => bf(jp_bdyv2d,jbdy:jbdy) ! alias for v2d structure of bdy number jbdy 521 528 bn_alias => bn_v2d ! alias for v2d structure of nambdy_dta 522 IF( ln_full_vel ) THEN ; iszdim = idx_bdy(jbdy)%nblen(igrd) ! will be computed from v3d -> need on the full bdy 523 ELSE ; iszdim = idx_bdy(jbdy)%nblenrim(igrd) ! used only on the rim 529 llfullbdy = ln_full_vel .OR. cn_dyn2d(jbdy) == 'frs' ! need v2d over the whole bdy or only over the rim? 530 IF( llfullbdy ) THEN ; iszdim = idx_bdy(jbdy)%nblen(igrd) 531 ELSE ; iszdim = idx_bdy(jbdy)%nblenrim(igrd) 524 532 ENDIF 525 533 ENDIF … … 579 587 IF( jfld == jp_bdya_i .OR. jfld == jp_bdyh_i .OR. jfld == jp_bdyh_s .OR. & 580 588 & jfld == jp_bdyt_i .OR. jfld == jp_bdyt_s .OR. jfld == jp_bdytsu .OR. & 581 & jfld == jp_bdys_i .OR. jfld == jp_bdyaip .OR. jfld == jp_bdyhip 589 & jfld == jp_bdys_i .OR. jfld == jp_bdyaip .OR. jfld == jp_bdyhip .OR. jfld == jp_bdyhil ) THEN 582 590 igrd = 1 ! T point 583 591 ipk = ipl ! jpl-cat data … … 630 638 bf_alias => bf(jp_bdyhip,jbdy:jbdy) ! alias for hip structure of bdy number jbdy 631 639 bn_alias => bn_hip ! alias for hip structure of nambdy_dta 640 ENDIF 641 IF( jfld == jp_bdyhil ) THEN 642 cl3 = 'hil' 643 bf_alias => bf(jp_bdyhil,jbdy:jbdy) ! alias for hil structure of bdy number jbdy 644 bn_alias => bn_hil ! alias for hil structure of nambdy_dta 632 645 ENDIF 633 646 … … 699 712 ENDIF 700 713 ENDIF 714 IF( jfld == jp_bdyhil ) THEN 715 IF( ipk == jpl ) THEN ; dta_bdy(jbdy)%hil => bf_alias(1)%fnow(:,1,:) 716 ELSE ; ALLOCATE( dta_bdy(jbdy)%hil(iszdim,jpl) ) 717 ENDIF 718 ENDIF 701 719 ENDIF 702 720 -
NEMO/branches/2020/r12377_ticket2386/src/OCE/BDY/bdydyn.F90
r12377 r13540 30 30 PUBLIC bdy_dyn ! routine called in dyn_nxt 31 31 32 !! * Substitutions 33 # include "domzgr_substitute.h90" 32 34 !!---------------------------------------------------------------------- 33 35 !! NEMO/OCE 4.0 , NEMO Consortium (2018) -
NEMO/branches/2020/r12377_ticket2386/src/OCE/BDY/bdydyn2d.F90
r11536 r13540 102 102 END DO 103 103 IF( ANY(llsend2) .OR. ANY(llrecv2) ) THEN ! if need to send/recv in at least one direction 104 CALL lbc_lnk( 'bdydyn2d', pua2d, 'U', -1. , kfillmode=jpfillnothing ,lsend=llsend2, lrecv=llrecv2 )104 CALL lbc_lnk( 'bdydyn2d', pua2d, 'U', -1.0_wp, kfillmode=jpfillnothing ,lsend=llsend2, lrecv=llrecv2 ) 105 105 END IF 106 106 IF( ANY(llsend3) .OR. ANY(llrecv3) ) THEN ! if need to send/recv in at least one direction 107 CALL lbc_lnk( 'bdydyn2d', pva2d, 'V', -1. , kfillmode=jpfillnothing ,lsend=llsend3, lrecv=llrecv3 )107 CALL lbc_lnk( 'bdydyn2d', pva2d, 'V', -1.0_wp, kfillmode=jpfillnothing ,lsend=llsend3, lrecv=llrecv3 ) 108 108 END IF 109 109 ! … … 324 324 IF( nn_hls > 1 .AND. ir == 1 ) CYCLE ! at least 2 halos will be corrected -> no need to correct rim 1 before rim 0 325 325 IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN ! if need to send/recv in at least one direction 326 CALL lbc_lnk( 'bdydyn2d', zssh(:,:,1), 'T', 1. , kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 )326 CALL lbc_lnk( 'bdydyn2d', zssh(:,:,1), 'T', 1.0_wp, kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 327 327 END IF 328 328 END DO -
NEMO/branches/2020/r12377_ticket2386/src/OCE/BDY/bdydyn3d.F90
r12377 r13540 99 99 ! 100 100 IF( ANY(llsend2) .OR. ANY(llrecv2) ) THEN ! if need to send/recv in at least one direction 101 CALL lbc_lnk( 'bdydyn2d', puu(:,:,:,Kaa), 'U', -1. , kfillmode=jpfillnothing ,lsend=llsend2, lrecv=llrecv2 )101 CALL lbc_lnk( 'bdydyn2d', puu(:,:,:,Kaa), 'U', -1.0_wp, kfillmode=jpfillnothing ,lsend=llsend2, lrecv=llrecv2 ) 102 102 END IF 103 103 IF( ANY(llsend3) .OR. ANY(llrecv3) ) THEN ! if need to send/recv in at least one direction 104 CALL lbc_lnk( 'bdydyn2d', pvv(:,:,:,Kaa), 'V', -1. , kfillmode=jpfillnothing ,lsend=llsend3, lrecv=llrecv3 )104 CALL lbc_lnk( 'bdydyn2d', pvv(:,:,:,Kaa), 'V', -1.0_wp, kfillmode=jpfillnothing ,lsend=llsend3, lrecv=llrecv3 ) 105 105 END IF 106 106 END DO ! ir -
NEMO/branches/2020/r12377_ticket2386/src/OCE/BDY/bdyice.F90
r12511 r13540 94 94 IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN ! if need to send/recv in at least one direction 95 95 ! exchange 3d arrays 96 CALL lbc_lnk_multi( 'bdyice', a_i , 'T', 1., h_i , 'T', 1., h_s , 'T', 1., oa_i, 'T', 1.&97 & , a_ip, 'T', 1., v_ip, 'T', 1., s_i , 'T', 1., t_su, 'T', 1.&98 & , v_i , 'T', 1., v_s , 'T', 1., sv_i, 'T', 1.&99 & , kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1)96 CALL lbc_lnk_multi('bdyice', a_i , 'T', 1._wp, h_i , 'T', 1._wp, h_s , 'T', 1._wp, oa_i, 'T', 1._wp & 97 & , s_i , 'T', 1._wp, t_su, 'T', 1._wp, v_i , 'T', 1._wp, v_s , 'T', 1._wp, sv_i, 'T', 1._wp & 98 & , a_ip, 'T', 1._wp, v_ip, 'T', 1._wp, v_il, 'T', 1._wp & 99 & , kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 100 100 ! exchange 4d arrays : third dimension = 1 and then third dimension = jpk 101 CALL lbc_lnk_multi( 'bdyice', t_s , 'T', 1., e_s , 'T', 1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 )102 CALL lbc_lnk_multi( 'bdyice', t_i , 'T', 1., e_i , 'T', 1., kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 )101 CALL lbc_lnk_multi('bdyice', t_s , 'T', 1._wp, e_s , 'T', 1._wp, kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 102 CALL lbc_lnk_multi('bdyice', t_i , 'T', 1._wp, e_i , 'T', 1._wp, kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 103 103 END IF 104 104 END DO ! ir … … 163 163 a_ip(ji,jj, jl) = ( a_ip(ji,jj, jl) * zwgt1 + dta%aip(i_bdy,jl) * zwgt ) * tmask(ji,jj,1) ! Ice pond concentration 164 164 h_ip(ji,jj, jl) = ( h_ip(ji,jj, jl) * zwgt1 + dta%hip(i_bdy,jl) * zwgt ) * tmask(ji,jj,1) ! Ice pond depth 165 h_il(ji,jj, jl) = ( h_il(ji,jj, jl) * zwgt1 + dta%hil(i_bdy,jl) * zwgt ) * tmask(ji,jj,1) ! Ice pond lid depth 165 166 ! 166 167 sz_i(ji,jj,:,jl) = s_i(ji,jj,jl) … … 170 171 a_ip(ji,jj,jl) = 0._wp 171 172 h_ip(ji,jj,jl) = 0._wp 173 h_il(ji,jj,jl) = 0._wp 174 ENDIF 175 176 IF( .NOT.ln_pnd_lids ) THEN 177 h_il(ji,jj,jl) = 0._wp 172 178 ENDIF 173 179 ! … … 231 237 a_ip(ji,jj, jl) = a_ip(ib,jb, jl) 232 238 h_ip(ji,jj, jl) = h_ip(ib,jb, jl) 239 h_il(ji,jj, jl) = h_il(ib,jb, jl) 233 240 ! 234 241 sz_i(ji,jj,:,jl) = sz_i(ib,jb,:,jl) … … 265 272 ! 266 273 ! melt ponds 267 IF( a_i(ji,jj,jl) > epsi10 ) THEN268 a_ip_frac(ji,jj,jl) = a_ip(ji,jj,jl) / a_i (ji,jj,jl)269 ELSE270 a_ip_frac(ji,jj,jl) = 0._wp271 ENDIF272 274 v_ip(ji,jj,jl) = h_ip(ji,jj,jl) * a_ip(ji,jj,jl) 275 v_il(ji,jj,jl) = h_il(ji,jj,jl) * a_ip(ji,jj,jl) 273 276 ! 274 277 ELSE ! no ice at the boundary … … 278 281 h_s (ji,jj, jl) = 0._wp 279 282 oa_i(ji,jj, jl) = 0._wp 280 a_ip(ji,jj, jl) = 0._wp281 v_ip(ji,jj, jl) = 0._wp282 283 t_su(ji,jj, jl) = rt0 283 284 t_s (ji,jj,:,jl) = rt0 284 285 t_i (ji,jj,:,jl) = rt0 285 286 286 a_ip_frac(ji,jj,jl) = 0._wp 287 h_ip (ji,jj,jl) = 0._wp 288 a_ip (ji,jj,jl) = 0._wp 289 v_ip (ji,jj,jl) = 0._wp 287 a_ip(ji,jj,jl) = 0._wp 288 h_ip(ji,jj,jl) = 0._wp 289 h_il(ji,jj,jl) = 0._wp 290 290 291 291 IF( nn_icesal == 1 ) THEN ! if constant salinity … … 303 303 e_s (ji,jj,:,jl) = 0._wp 304 304 e_i (ji,jj,:,jl) = 0._wp 305 v_ip(ji,jj, jl) = 0._wp 306 v_il(ji,jj, jl) = 0._wp 305 307 306 308 ENDIF … … 436 438 END DO 437 439 IF( ANY(llsend2) .OR. ANY(llrecv2) ) THEN ! if need to send/recv in at least one direction 438 CALL lbc_lnk( 'bdyice', u_ice, 'U', -1. , kfillmode=jpfillnothing ,lsend=llsend2, lrecv=llrecv2 )440 CALL lbc_lnk( 'bdyice', u_ice, 'U', -1.0_wp, kfillmode=jpfillnothing ,lsend=llsend2, lrecv=llrecv2 ) 439 441 END IF 440 442 CASE ( 'V' ) … … 450 452 END DO 451 453 IF( ANY(llsend3) .OR. ANY(llrecv3) ) THEN ! if need to send/recv in at least one direction 452 CALL lbc_lnk( 'bdyice', v_ice, 'V', -1. , kfillmode=jpfillnothing ,lsend=llsend3, lrecv=llrecv3 )454 CALL lbc_lnk( 'bdyice', v_ice, 'V', -1.0_wp, kfillmode=jpfillnothing ,lsend=llsend3, lrecv=llrecv3 ) 453 455 END IF 454 456 END SELECT -
NEMO/branches/2020/r12377_ticket2386/src/OCE/BDY/bdyini.F90
r12377 r13540 19 19 USE oce ! ocean dynamics and tracers variables 20 20 USE dom_oce ! ocean space and time domain 21 USE sbc_oce , ONLY: nn_ice 21 22 USE bdy_oce ! unstructured open boundary conditions 22 23 USE bdydta ! open boundary cond. setting (bdy_dta_init routine) 23 24 USE bdytides ! open boundary cond. setting (bdytide_init routine) 24 25 USE tide_mod, ONLY: ln_tide ! tidal forcing 25 USE phycst 26 USE phycst , ONLY: rday 26 27 ! 27 28 USE in_out_manager ! I/O units … … 316 317 dta_bdy(ib_bdy)%lneed_ice = cn_ice(ib_bdy) /= 'none' 317 318 319 IF( dta_bdy(ib_bdy)%lneed_ice .AND. nn_ice /= 2 ) THEN 320 WRITE(ctmp1,*) 'bdy number ', ib_bdy,', needs ice model but nn_ice = ', nn_ice 321 CALL ctl_stop( ctmp1 ) 322 ENDIF 323 318 324 IF( lwp .AND. dta_bdy(ib_bdy)%lneed_ice ) THEN 319 325 SELECT CASE( nn_ice_dta(ib_bdy) ) ! … … 410 416 CALL iom_get( inum, jpdom_unknown, 'nbi'//cgrid(igrd), zz_read(1:nblendta(igrd,ib_bdy),:) ) 411 417 DO ii = 1,nblendta(igrd,ib_bdy) 412 nbidta(ii,igrd,ib_bdy) = NINT( zz_read(ii,1) ) 418 nbidta(ii,igrd,ib_bdy) = NINT( zz_read(ii,1) ) + nn_hls 413 419 END DO 414 420 CALL iom_get( inum, jpdom_unknown, 'nbj'//cgrid(igrd), zz_read(1:nblendta(igrd,ib_bdy),:) ) 415 421 DO ii = 1,nblendta(igrd,ib_bdy) 416 nbjdta(ii,igrd,ib_bdy) = NINT( zz_read(ii,1) ) 422 nbjdta(ii,igrd,ib_bdy) = NINT( zz_read(ii,1) ) + nn_hls 417 423 END DO 418 424 CALL iom_get( inum, jpdom_unknown, 'nbr'//cgrid(igrd), zz_read(1:nblendta(igrd,ib_bdy),:) ) … … 632 638 END DO 633 639 END DO 634 CALL lbc_lnk( 'bdyini', zfmask, 'F', 1. )640 CALL lbc_lnk( 'bdyini', zfmask, 'F', 1.0_wp ) 635 641 636 642 ! Read global 2D mask at T-points: bdytmask … … 648 654 END DO 649 655 END DO 650 CALL lbc_lnk_multi( 'bdyini', bdyumask, 'U', 1. , bdyvmask, 'V', 1. ) ! Lateral boundary cond.656 CALL lbc_lnk_multi( 'bdyini', bdyumask, 'U', 1.0_wp , bdyvmask, 'V', 1.0_wp ) ! Lateral boundary cond. 651 657 652 658 ! bdy masks are now set to zero on rim 0 points: … … 689 695 END DO 690 696 END DO 691 CALL lbc_lnk( 'bdyini', zfmask, 'F', 1. )697 CALL lbc_lnk( 'bdyini', zfmask, 'F', 1.0_wp ) 692 698 693 699 ! bdy masks are now set to zero on rim1 points: … … 865 871 ENDIF 866 872 SELECT CASE( igrd ) 867 CASE( 1 ) ; CALL lbc_lnk( 'bdyini', ztmp, 'T', 1. )868 CASE( 2 ) ; CALL lbc_lnk( 'bdyini', ztmp, 'U', 1. )869 CASE( 3 ) ; CALL lbc_lnk( 'bdyini', ztmp, 'V', 1. )873 CASE( 1 ) ; CALL lbc_lnk( 'bdyini', ztmp, 'T', 1.0_wp ) 874 CASE( 2 ) ; CALL lbc_lnk( 'bdyini', ztmp, 'U', 1.0_wp ) 875 CASE( 3 ) ; CALL lbc_lnk( 'bdyini', ztmp, 'V', 1.0_wp ) 870 876 END SELECT 871 877 DO ib = ibeg, iend … … 913 919 ENDIF 914 920 SELECT CASE( igrd ) 915 CASE( 1 ) ; CALL lbc_lnk( 'bdyini', ztmp, 'T', 1. )916 CASE( 2 ) ; CALL lbc_lnk( 'bdyini', ztmp, 'U', 1. )917 CASE( 3 ) ; CALL lbc_lnk( 'bdyini', ztmp, 'V', 1. )921 CASE( 1 ) ; CALL lbc_lnk( 'bdyini', ztmp, 'T', 1.0_wp ) 922 CASE( 2 ) ; CALL lbc_lnk( 'bdyini', ztmp, 'U', 1.0_wp ) 923 CASE( 3 ) ; CALL lbc_lnk( 'bdyini', ztmp, 'V', 1.0_wp ) 918 924 END SELECT 919 925 DO ib = ibeg, iend … … 1001 1007 END DO 1002 1008 SELECT CASE( igrd ) 1003 CASE( 1 ) ; CALL lbc_lnk( 'bdyini', ztmp, 'T', 1. )1004 CASE( 2 ) ; CALL lbc_lnk( 'bdyini', ztmp, 'U', 1. )1005 CASE( 3 ) ; CALL lbc_lnk( 'bdyini', ztmp, 'V', 1. )1009 CASE( 1 ) ; CALL lbc_lnk( 'bdyini', ztmp, 'T', 1.0_wp ) 1010 CASE( 2 ) ; CALL lbc_lnk( 'bdyini', ztmp, 'U', 1.0_wp ) 1011 CASE( 3 ) ; CALL lbc_lnk( 'bdyini', ztmp, 'V', 1.0_wp ) 1006 1012 END SELECT 1007 1013 DO ib = ibeg, iend … … 1105 1111 CASE( 'N' ) 1106 1112 IF( nbdyind == -1 ) THEN ! Automatic boundary definition: if nbdysegX = -1 1107 nbdyind = jpjglo - 2 ! set boundary to whole side of model domain.1113 nbdyind = Nj0glo - 2 ! set boundary to whole side of model domain. 1108 1114 nbdybeg = 2 1109 nbdyend = jpiglo -11115 nbdyend = Ni0glo -1 1110 1116 ENDIF 1111 1117 nbdysegn = nbdysegn + 1 1112 1118 npckgn(nbdysegn) = kb_bdy ! Save bdy package number 1113 jpjnob(nbdysegn) = nbdyind 1114 jpindt(nbdysegn) = nbdybeg 1115 jpinft(nbdysegn) = nbdyend 1119 jpjnob(nbdysegn) = nbdyind + nn_hls 1120 jpindt(nbdysegn) = nbdybeg + nn_hls 1121 jpinft(nbdysegn) = nbdyend + nn_hls 1116 1122 ! 1117 1123 CASE( 'S' ) … … 1119 1125 nbdyind = 2 ! set boundary to whole side of model domain. 1120 1126 nbdybeg = 2 1121 nbdyend = jpiglo - 11127 nbdyend = Ni0glo - 1 1122 1128 ENDIF 1123 1129 nbdysegs = nbdysegs + 1 1124 1130 npckgs(nbdysegs) = kb_bdy ! Save bdy package number 1125 jpjsob(nbdysegs) = nbdyind 1126 jpisdt(nbdysegs) = nbdybeg 1127 jpisft(nbdysegs) = nbdyend 1131 jpjsob(nbdysegs) = nbdyind + nn_hls 1132 jpisdt(nbdysegs) = nbdybeg + nn_hls 1133 jpisft(nbdysegs) = nbdyend + nn_hls 1128 1134 ! 1129 1135 CASE( 'E' ) 1130 1136 IF( nbdyind == -1 ) THEN ! Automatic boundary definition: if nbdysegX = -1 1131 nbdyind = jpiglo - 2 ! set boundary to whole side of model domain.1137 nbdyind = Ni0glo - 2 ! set boundary to whole side of model domain. 1132 1138 nbdybeg = 2 1133 nbdyend = jpjglo - 11139 nbdyend = Nj0glo - 1 1134 1140 ENDIF 1135 1141 nbdysege = nbdysege + 1 1136 1142 npckge(nbdysege) = kb_bdy ! Save bdy package number 1137 jpieob(nbdysege) = nbdyind 1138 jpjedt(nbdysege) = nbdybeg 1139 jpjeft(nbdysege) = nbdyend 1143 jpieob(nbdysege) = nbdyind + nn_hls 1144 jpjedt(nbdysege) = nbdybeg + nn_hls 1145 jpjeft(nbdysege) = nbdyend + nn_hls 1140 1146 ! 1141 1147 CASE( 'W' ) … … 1143 1149 nbdyind = 2 ! set boundary to whole side of model domain. 1144 1150 nbdybeg = 2 1145 nbdyend = jpjglo - 11151 nbdyend = Nj0glo - 1 1146 1152 ENDIF 1147 1153 nbdysegw = nbdysegw + 1 1148 1154 npckgw(nbdysegw) = kb_bdy ! Save bdy package number 1149 jpiwob(nbdysegw) = nbdyind 1150 jpjwdt(nbdysegw) = nbdybeg 1151 jpjwft(nbdysegw) = nbdyend 1155 jpiwob(nbdysegw) = nbdyind + nn_hls 1156 jpjwdt(nbdysegw) = nbdybeg + nn_hls 1157 jpjwft(nbdysegw) = nbdyend + nn_hls 1152 1158 ! 1153 1159 CASE DEFAULT ; CALL ctl_stop( 'ctypebdy must be N, S, E or W' ) … … 1186 1192 IF(lwp) WRITE(numout,*) 'Number of north segments : ', nbdysegn 1187 1193 IF(lwp) WRITE(numout,*) 'Number of south segments : ', nbdysegs 1194 ! 1188 1195 ! 1. Check bounds 1189 1196 !---------------- … … 1223 1230 IF (jpjwft(ib).gt.jpjglo) CALL ctl_stop( 'End index out of domain' ) 1224 1231 ENDDO 1225 !1226 1232 ! 1227 1233 ! 2. Look for segment crossings … … 1372 1378 DO ji = 1, jpi 1373 1379 DO jj = 1, jpj 1374 IF (((ji + nimpp - 1) == jpiwob(ib)).AND. & 1375 & ((jj + njmpp - 1) == jpjwdt(ib))) ztestmask(1)=tmask(ji,jj,1) 1376 IF (((ji + nimpp - 1) == jpiwob(ib)).AND. & 1377 & ((jj + njmpp - 1) == jpjwft(ib))) ztestmask(2)=tmask(ji,jj,1) 1380 IF( mig(ji) == jpiwob(ib) .AND. mjg(jj) == jpjwdt(ib) ) ztestmask(1) = tmask(ji,jj,1) 1381 IF( mig(ji) == jpiwob(ib) .AND. mjg(jj) == jpjwft(ib) ) ztestmask(2) = tmask(ji,jj,1) 1378 1382 END DO 1379 1383 END DO … … 1410 1414 DO ji = 1, jpi 1411 1415 DO jj = 1, jpj 1412 IF (((ji + nimpp - 1) == jpieob(ib)+1).AND. & 1413 & ((jj + njmpp - 1) == jpjedt(ib))) ztestmask(1)=tmask(ji,jj,1) 1414 IF (((ji + nimpp - 1) == jpieob(ib)+1).AND. & 1415 & ((jj + njmpp - 1) == jpjeft(ib))) ztestmask(2)=tmask(ji,jj,1) 1416 IF( mig(ji) == jpieob(ib)+1 .AND. mjg(jj) == jpjedt(ib) ) ztestmask(1) = tmask(ji,jj,1) 1417 IF( mig(ji) == jpieob(ib)+1 .AND. mjg(jj) == jpjeft(ib) ) ztestmask(2) = tmask(ji,jj,1) 1416 1418 END DO 1417 1419 END DO … … 1448 1450 DO ji = 1, jpi 1449 1451 DO jj = 1, jpj 1450 IF (((jj + njmpp - 1) == jpjsob(ib)).AND. & 1451 & ((ji + nimpp - 1) == jpisdt(ib))) ztestmask(1)=tmask(ji,jj,1) 1452 IF (((jj + njmpp - 1) == jpjsob(ib)).AND. & 1453 & ((ji + nimpp - 1) == jpisft(ib))) ztestmask(2)=tmask(ji,jj,1) 1452 IF( mjg(jj) == jpjsob(ib) .AND. mig(ji) == jpisdt(ib) ) ztestmask(1) = tmask(ji,jj,1) 1453 IF( mjg(jj) == jpjsob(ib) .AND. mig(ji) == jpisft(ib) ) ztestmask(2) = tmask(ji,jj,1) 1454 1454 END DO 1455 1455 END DO … … 1472 1472 DO ji = 1, jpi 1473 1473 DO jj = 1, jpj 1474 IF (((jj + njmpp - 1) == jpjnob(ib)+1).AND. & 1475 & ((ji + nimpp - 1) == jpindt(ib))) ztestmask(1)=tmask(ji,jj,1) 1476 IF (((jj + njmpp - 1) == jpjnob(ib)+1).AND. & 1477 & ((ji + nimpp - 1) == jpinft(ib))) ztestmask(2)=tmask(ji,jj,1) 1474 IF( mjg(jj) == jpjnob(ib)+1 .AND. mig(ji) == jpindt(ib) ) ztestmask(1) = tmask(ji,jj,1) 1475 IF( mjg(jj) == jpjnob(ib)+1 .AND. mig(ji) == jpinft(ib) ) ztestmask(2) = tmask(ji,jj,1) 1478 1476 END DO 1479 1477 END DO -
NEMO/branches/2020/r12377_ticket2386/src/OCE/BDY/bdylib.F90
r12511 r13540 44 44 !!---------------------------------------------------------------------- 45 45 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 46 REAL(wp), DIMENSION(:,:), 46 REAL(wp), DIMENSION(:,:), POINTER, INTENT(in) :: dta ! OBC external data 47 47 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: phia ! tracer trend 48 48 !! … … 73 73 !!---------------------------------------------------------------------- 74 74 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 75 REAL(wp), DIMENSION(:,:), 75 REAL(wp), DIMENSION(:,:), POINTER, INTENT(in) :: dta ! OBC external data 76 76 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: phia ! tracer trend 77 77 !! … … 100 100 !! 101 101 !!---------------------------------------------------------------------- 102 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices103 REAL(wp), DIMENSION(:,:), INTENT(in) :: dta ! OBC external data104 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: phib ! before tracer field105 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: phia ! tracer trend106 LOGICAL , OPTIONAL, INTENT(in) :: lrim0 ! indicate if rim 0 is treated107 LOGICAL , INTENT(in) :: ll_npo ! switch for NPO version102 TYPE(OBC_INDEX), INTENT(in ) :: idx ! OBC indices 103 REAL(wp), DIMENSION(:,:), POINTER, INTENT(in ) :: dta ! OBC external data 104 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: phib ! before tracer field 105 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: phia ! tracer trend 106 LOGICAL , INTENT(in ) :: lrim0 ! indicate if rim 0 is treated 107 LOGICAL , INTENT(in ) :: ll_npo ! switch for NPO version 108 108 !! 109 109 INTEGER :: igrd ! grid index … … 128 128 !! References: Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001) 129 129 !!---------------------------------------------------------------------- 130 TYPE(OBC_INDEX), INTENT(in ) :: idx ! BDY indices131 INTEGER , INTENT(in ) :: igrd ! grid index132 REAL(wp), DIMENSION(:,:), INTENT(in ) :: phib ! model before 2D field133 REAL(wp), DIMENSION(:,:), INTENT(inout) :: phia ! model after 2D field (to be updated)134 REAL(wp), DIMENSION(: ), INTENT(in ) :: phi_ext ! external forcing data135 LOGICAL , OPTIONAL,INTENT(in ) :: lrim0 ! indicate if rim 0 is treated136 LOGICAL , INTENT(in ) :: ll_npo ! switch for NPO version130 TYPE(OBC_INDEX), INTENT(in ) :: idx ! BDY indices 131 INTEGER , INTENT(in ) :: igrd ! grid index 132 REAL(wp), DIMENSION(:,:), INTENT(in ) :: phib ! model before 2D field 133 REAL(wp), DIMENSION(:,:), INTENT(inout) :: phia ! model after 2D field (to be updated) 134 REAL(wp), DIMENSION(: ), POINTER, INTENT(in ) :: phi_ext ! external forcing data 135 LOGICAL , INTENT(in ) :: lrim0 ! indicate if rim 0 is treated 136 LOGICAL , INTENT(in ) :: ll_npo ! switch for NPO version 137 137 ! 138 138 INTEGER :: jb ! dummy loop indices … … 188 188 END SELECT 189 189 ! 190 IF( PRESENT(lrim0) ) THEN 191 IF( lrim0 ) THEN ; ibeg = 1 ; iend = idx%nblenrim0(igrd) ! rim 0 192 ELSE ; ibeg = idx%nblenrim0(igrd)+1 ; iend = idx%nblenrim(igrd) ! rim 1 193 END IF 194 ELSE ; ibeg = 1 ; iend = idx%nblenrim(igrd) ! both 195 END IF 190 IF( lrim0 ) THEN ; ibeg = 1 ; iend = idx%nblenrim0(igrd) ! rim 0 191 ELSE ; ibeg = idx%nblenrim0(igrd)+1 ; iend = idx%nblenrim(igrd) ! rim 1 192 ENDIF 196 193 ! 197 194 DO jb = ibeg, iend … … 249 246 !!$ zdy_centred = phib(iibm1jp1,ijbm1jp1) - phib(iibm1jm1,ijbm1jm1) 250 247 ! upstream differencing for tangential derivatives 251 zsign_ups = sign( 1. , zdt * zdy_centred )248 zsign_ups = sign( 1.0_wp, zdt * zdy_centred ) 252 249 zsign_ups = 0.5*( zsign_ups + abs(zsign_ups) ) 253 250 zdy = zsign_ups * zdy_1 + (1. - zsign_ups) * zdy_2 … … 257 254 zrx = zdt * zdx / ( zex1 * znor2 ) 258 255 !!$ zrx = min(zrx,2.0_wp) 259 zout = sign( 1. , zrx )256 zout = sign( 1.0_wp, zrx ) 260 257 zout = 0.5*( zout + abs(zout) ) 261 258 zwgt = 2.*rn_Dt*( (1.-zout) * idx%nbd(jb,igrd) + zout * idx%nbdout(jb,igrd) ) … … 266 263 & + zwgt * ( phi_ext(jb) - phib(ii,ij) ) ) / ( 1. + zrx ) 267 264 else !! full oblique radiation !! 268 zsign_ups = sign( 1. , zdt * zdy )265 zsign_ups = sign( 1.0_wp, zdt * zdy ) 269 266 zsign_ups = 0.5*( zsign_ups + abs(zsign_ups) ) 270 267 zey = zsign_ups * zey1 + (1.-zsign_ups) * zey2 … … 275 272 & - (1.-zsign_ups) * zry * ( phib(iijp1,ijjp1) - phib(ii ,ij ) ) & 276 273 & + zwgt * ( phi_ext(jb) - phib(ii,ij) ) ) / ( 1. + zrx ) 277 end 274 endif 278 275 phia(ii,ij) = phia(ii,ij) * zmask(ii,ij) 279 276 END DO … … 293 290 !! References: Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001) 294 291 !!---------------------------------------------------------------------- 295 TYPE(OBC_INDEX), INTENT(in ) :: idx ! BDY indices296 INTEGER , INTENT(in ) :: igrd ! grid index297 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: phib ! model before 3D field298 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: phia ! model after 3D field (to be updated)299 REAL(wp), DIMENSION(:,: ), INTENT(in ) :: phi_ext ! external forcing data300 LOGICAL , OPTIONAL,INTENT(in ) :: lrim0 ! indicate if rim 0 is treated301 LOGICAL , INTENT(in ) :: ll_npo ! switch for NPO version292 TYPE(OBC_INDEX), INTENT(in ) :: idx ! BDY indices 293 INTEGER , INTENT(in ) :: igrd ! grid index 294 REAL(wp), DIMENSION(:,:,:), INTENT(in ) :: phib ! model before 3D field 295 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: phia ! model after 3D field (to be updated) 296 REAL(wp), DIMENSION(:,: ), POINTER, INTENT(in ) :: phi_ext ! external forcing data 297 LOGICAL , INTENT(in ) :: lrim0 ! indicate if rim 0 is treated 298 LOGICAL , INTENT(in ) :: ll_npo ! switch for NPO version 302 299 ! 303 300 INTEGER :: jb, jk ! dummy loop indices … … 353 350 END SELECT 354 351 ! 355 IF( PRESENT(lrim0) ) THEN 356 IF( lrim0 ) THEN ; ibeg = 1 ; iend = idx%nblenrim0(igrd) ! rim 0 357 ELSE ; ibeg = idx%nblenrim0(igrd)+1 ; iend = idx%nblenrim(igrd) ! rim 1 358 END IF 359 ELSE ; ibeg = 1 ; iend = idx%nblenrim(igrd) ! both 360 END IF 352 IF( lrim0 ) THEN ; ibeg = 1 ; iend = idx%nblenrim0(igrd) ! rim 0 353 ELSE ; ibeg = idx%nblenrim0(igrd)+1 ; iend = idx%nblenrim(igrd) ! rim 1 354 ENDIF 361 355 ! 362 356 DO jk = 1, jpk … … 414 408 !!$ zdy_centred = phib(iibm1jp1,ijbm1jp1,jk) - phib(iibm1jm1,ijbm1jm1,jk) 415 409 ! upstream differencing for tangential derivatives 416 zsign_ups = sign( 1. , zdt * zdy_centred )410 zsign_ups = sign( 1.0_wp, zdt * zdy_centred ) 417 411 zsign_ups = 0.5*( zsign_ups + abs(zsign_ups) ) 418 412 zdy = zsign_ups * zdy_1 + (1. - zsign_ups) * zdy_2 … … 423 417 zrx = zdt * zdx / ( zex1 * znor2 ) 424 418 !!$ zrx = min(zrx,2.0_wp) 425 zout = sign( 1. , zrx )419 zout = sign( 1.0_wp, zrx ) 426 420 zout = 0.5*( zout + abs(zout) ) 427 421 zwgt = 2.*rn_Dt*( (1.-zout) * idx%nbd(jb,igrd) + zout * idx%nbdout(jb,igrd) ) … … 432 426 & + zwgt * ( phi_ext(jb,jk) - phib(ii,ij,jk) ) ) / ( 1. + zrx ) 433 427 else !! full oblique radiation !! 434 zsign_ups = sign( 1. , zdt * zdy )428 zsign_ups = sign( 1.0_wp, zdt * zdy ) 435 429 zsign_ups = 0.5*( zsign_ups + abs(zsign_ups) ) 436 430 zey = zsign_ups * zey1 + (1.-zsign_ups) * zey2 … … 441 435 & - (1.-zsign_ups) * zry * ( phib(iijp1,ijjp1,jk) - phib(ii ,ij ,jk) ) & 442 436 & + zwgt * ( phi_ext(jb,jk) - phib(ii,ij,jk) ) ) / ( 1. + zrx ) 443 end 437 endif 444 438 phia(ii,ij,jk) = phia(ii,ij,jk) * zmask(ii,ij,jk) 445 439 END DO … … 466 460 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: phia ! model after 3D field (to be updated), must be masked 467 461 TYPE(OBC_INDEX), INTENT(in ) :: idx ! OBC indices 468 LOGICAL , OPTIONAL,INTENT(in ) :: lrim0 ! indicate if rim 0 is treated462 LOGICAL , INTENT(in ) :: lrim0 ! indicate if rim 0 is treated 469 463 !! 470 464 REAL(wp) :: zweight … … 486 480 END SELECT 487 481 ! 488 IF( PRESENT(lrim0) ) THEN 489 IF( lrim0 ) THEN ; ibeg = 1 ; iend = idx%nblenrim0(igrd) ! rim 0 490 ELSE ; ibeg = idx%nblenrim0(igrd)+1 ; iend = idx%nblenrim(igrd) ! rim 1 491 END IF 492 ELSE ; ibeg = 1 ; iend = idx%nblenrim(igrd) ! both 493 END IF 482 IF( lrim0 ) THEN ; ibeg = 1 ; iend = idx%nblenrim0(igrd) ! rim 0 483 ELSE ; ibeg = idx%nblenrim0(igrd)+1 ; iend = idx%nblenrim(igrd) ! rim 1 484 ENDIF 494 485 ! 495 486 DO ib = ibeg, iend -
NEMO/branches/2020/r12377_ticket2386/src/OCE/BDY/bdytides.F90
r12511 r13540 65 65 !! namelist variables 66 66 !!------------------- 67 CHARACTER(len=80) :: filtide ! :Filename root for tidal input files68 LOGICAL :: ln_bdytide_2ddta ! :If true, read 2d harmonic data67 CHARACTER(len=80) :: filtide ! Filename root for tidal input files 68 LOGICAL :: ln_bdytide_2ddta ! If true, read 2d harmonic data 69 69 !! 70 INTEGER :: ib_bdy, itide, ib ! :dummy loop indices71 INTEGER :: ii, ij ! :dummy loop indices70 INTEGER :: ib_bdy, itide, ib ! dummy loop indices 71 INTEGER :: ii, ij ! dummy loop indices 72 72 INTEGER :: inum, igrd 73 INTEGER , DIMENSION(3) :: ilen0 !: length of boundary data (from OBC arrays)73 INTEGER :: isz ! bdy data size 74 74 INTEGER :: ios ! Local integer output status for namelist read 75 75 INTEGER :: nbdy_rdstart, nbdy_loc 76 CHARACTER(LEN=50) :: cerrmsg ! :error string77 CHARACTER(len=80) :: clfile ! :full file name for tidal input file78 REAL(wp),ALLOCATABLE, DIMENSION(:,:,:) :: dta_read ! :work space to read in tidal harmonics data79 REAL(wp),ALLOCATABLE, DIMENSION(:,:) :: ztr, zti ! :" " " " " " " "76 CHARACTER(LEN=50) :: cerrmsg ! error string 77 CHARACTER(len=80) :: clfile ! full file name for tidal input file 78 REAL(wp),ALLOCATABLE, DIMENSION(:,:,:) :: dta_read ! work space to read in tidal harmonics data 79 REAL(wp),ALLOCATABLE, DIMENSION(:,:) :: ztr, zti ! " " " " " " " " 80 80 !! 81 TYPE(TIDES_DATA), POINTER :: td !: local short cut 81 TYPE(TIDES_DATA), POINTER :: td ! local short cut 82 TYPE( OBC_DATA), POINTER :: dta ! local short cut 82 83 !! 83 84 NAMELIST/nambdy_tide/filtide, ln_bdytide_2ddta … … 93 94 IF( nn_dyn2d_dta(ib_bdy) >= 2 ) THEN 94 95 ! 95 td => tides(ib_bdy) 96 96 td => tides(ib_bdy) 97 dta => dta_bdy(ib_bdy) 98 97 99 ! Namelist nambdy_tide : tidal harmonic forcing at open boundaries 98 100 filtide(:) = '' … … 130 132 IF(lwp) WRITE(numout,*) ' ' 131 133 132 ! Allocate space for tidal harmonics data - get size from OBC data arrays 134 ! Allocate space for tidal harmonics data - get size from BDY data arrays 135 ! Allocate also slow varying data in the case of time splitting: 136 ! Do it anyway because at this stage knowledge of free surface scheme is unknown 133 137 ! ----------------------------------------------------------------------- 134 135 ! JC: If FRS scheme is used, we assume that tidal is needed over the whole 136 ! relaxation area 137 IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN ; ilen0(:) = idx_bdy(ib_bdy)%nblen (:) 138 ELSE ; ilen0(:) = idx_bdy(ib_bdy)%nblenrim(:) 139 ENDIF 140 141 ALLOCATE( td%ssh0( ilen0(1), nb_harmo, 2 ) ) 142 ALLOCATE( td%ssh ( ilen0(1), nb_harmo, 2 ) ) 143 144 ALLOCATE( td%u0( ilen0(2), nb_harmo, 2 ) ) 145 ALLOCATE( td%u ( ilen0(2), nb_harmo, 2 ) ) 146 147 ALLOCATE( td%v0( ilen0(3), nb_harmo, 2 ) ) 148 ALLOCATE( td%v ( ilen0(3), nb_harmo, 2 ) ) 149 150 td%ssh0(:,:,:) = 0._wp 151 td%ssh (:,:,:) = 0._wp 152 td%u0 (:,:,:) = 0._wp 153 td%u (:,:,:) = 0._wp 154 td%v0 (:,:,:) = 0._wp 155 td%v (:,:,:) = 0._wp 156 138 IF( ASSOCIATED(dta%ssh) ) THEN ! we use bdy ssh on this mpi subdomain 139 isz = SIZE(dta%ssh) 140 ALLOCATE( td%ssh0( isz, nb_harmo, 2 ), td%ssh( isz, nb_harmo, 2 ), dta_bdy_s(ib_bdy)%ssh( isz ) ) 141 dta_bdy_s(ib_bdy)%ssh(:) = 0._wp ! needed? 142 ENDIF 143 IF( ASSOCIATED(dta%u2d) ) THEN ! we use bdy u2d on this mpi subdomain 144 isz = SIZE(dta%u2d) 145 ALLOCATE( td%u0 ( isz, nb_harmo, 2 ), td%u ( isz, nb_harmo, 2 ), dta_bdy_s(ib_bdy)%u2d( isz ) ) 146 dta_bdy_s(ib_bdy)%u2d(:) = 0._wp ! needed? 147 ENDIF 148 IF( ASSOCIATED(dta%v2d) ) THEN ! we use bdy v2d on this mpi subdomain 149 isz = SIZE(dta%v2d) 150 ALLOCATE( td%v0 ( isz, nb_harmo, 2 ), td%v ( isz, nb_harmo, 2 ), dta_bdy_s(ib_bdy)%v2d( isz ) ) 151 dta_bdy_s(ib_bdy)%v2d(:) = 0._wp ! needed? 152 ENDIF 153 154 ! fill td%ssh0, td%u0, td%v0 155 ! ----------------------------------------------------------------------- 157 156 IF( ln_bdytide_2ddta ) THEN 157 ! 158 158 ! It is assumed that each data file contains all complex harmonic amplitudes 159 159 ! given on the global domain (ie global, jpiglo x jpjglo) … … 162 162 ! 163 163 ! SSH fields 164 clfile = TRIM(filtide)//'_grid_T.nc' 165 CALL iom_open( clfile , inum ) 166 igrd = 1 ! Everything is at T-points here 167 DO itide = 1, nb_harmo 168 CALL iom_get( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_z1', ztr(:,:) ) 169 CALL iom_get( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_z2', zti(:,:) ) 170 DO ib = 1, ilen0(igrd) 171 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 172 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 173 IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj ) CYCLE ! to remove? 174 td%ssh0(ib,itide,1) = ztr(ii,ij) 175 td%ssh0(ib,itide,2) = zti(ii,ij) 176 END DO 177 END DO 178 CALL iom_close( inum ) 164 IF( ASSOCIATED(dta%ssh) ) THEN ! we use bdy ssh on this mpi subdomain 165 clfile = TRIM(filtide)//'_grid_T.nc' 166 CALL iom_open( clfile , inum ) 167 igrd = 1 ! Everything is at T-points here 168 DO itide = 1, nb_harmo 169 CALL iom_get( inum, jpdom_auto, TRIM(tide_harmonics(itide)%cname_tide)//'_z1', ztr(:,:) ) 170 CALL iom_get( inum, jpdom_auto, TRIM(tide_harmonics(itide)%cname_tide)//'_z2', zti(:,:) ) 171 DO ib = 1, SIZE(dta%ssh) 172 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 173 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 174 td%ssh0(ib,itide,1) = ztr(ii,ij) 175 td%ssh0(ib,itide,2) = zti(ii,ij) 176 END DO 177 END DO 178 CALL iom_close( inum ) 179 ENDIF 179 180 ! 180 181 ! U fields 181 clfile = TRIM(filtide)//'_grid_U.nc' 182 CALL iom_open( clfile , inum ) 183 igrd = 2 ! Everything is at U-points here 184 DO itide = 1, nb_harmo 185 CALL iom_get ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_u1', ztr(:,:) ) 186 CALL iom_get ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_u2', zti(:,:) ) 187 DO ib = 1, ilen0(igrd) 188 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 189 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 190 IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj ) CYCLE ! to remove? 191 td%u0(ib,itide,1) = ztr(ii,ij) 192 td%u0(ib,itide,2) = zti(ii,ij) 193 END DO 194 END DO 195 CALL iom_close( inum ) 182 IF( ASSOCIATED(dta%u2d) ) THEN ! we use bdy u2d on this mpi subdomain 183 clfile = TRIM(filtide)//'_grid_U.nc' 184 CALL iom_open( clfile , inum ) 185 igrd = 2 ! Everything is at U-points here 186 DO itide = 1, nb_harmo 187 CALL iom_get(inum, jpdom_auto, TRIM(tide_harmonics(itide)%cname_tide)//'_u1', ztr(:,:),cd_type='U',psgn=-1._wp) 188 CALL iom_get(inum, jpdom_auto, TRIM(tide_harmonics(itide)%cname_tide)//'_u2', zti(:,:),cd_type='U',psgn=-1._wp) 189 DO ib = 1, SIZE(dta%u2d) 190 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 191 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 192 td%u0(ib,itide,1) = ztr(ii,ij) 193 td%u0(ib,itide,2) = zti(ii,ij) 194 END DO 195 END DO 196 CALL iom_close( inum ) 197 ENDIF 196 198 ! 197 199 ! V fields 198 clfile = TRIM(filtide)//'_grid_V.nc' 199 CALL iom_open( clfile , inum ) 200 igrd = 3 ! Everything is at V-points here 201 DO itide = 1, nb_harmo 202 CALL iom_get ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_v1', ztr(:,:) ) 203 CALL iom_get ( inum, jpdom_autoglo, TRIM(tide_harmonics(itide)%cname_tide)//'_v2', zti(:,:) ) 204 DO ib = 1, ilen0(igrd) 205 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 206 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 207 IF( ii == 1 .OR. ii == jpi .OR. ij == 1 .OR. ij == jpj ) CYCLE ! to remove? 208 td%v0(ib,itide,1) = ztr(ii,ij) 209 td%v0(ib,itide,2) = zti(ii,ij) 210 END DO 211 END DO 212 CALL iom_close( inum ) 200 IF( ASSOCIATED(dta%v2d) ) THEN ! we use bdy v2d on this mpi subdomain 201 clfile = TRIM(filtide)//'_grid_V.nc' 202 CALL iom_open( clfile , inum ) 203 igrd = 3 ! Everything is at V-points here 204 DO itide = 1, nb_harmo 205 CALL iom_get(inum, jpdom_auto, TRIM(tide_harmonics(itide)%cname_tide)//'_v1', ztr(:,:),cd_type='V',psgn=-1._wp) 206 CALL iom_get(inum, jpdom_auto, TRIM(tide_harmonics(itide)%cname_tide)//'_v2', zti(:,:),cd_type='V',psgn=-1._wp) 207 DO ib = 1, SIZE(dta%v2d) 208 ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 209 ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 210 td%v0(ib,itide,1) = ztr(ii,ij) 211 td%v0(ib,itide,2) = zti(ii,ij) 212 END DO 213 END DO 214 CALL iom_close( inum ) 215 ENDIF 213 216 ! 214 217 DEALLOCATE( ztr, zti ) … … 218 221 ! Read tidal data only on bdy segments 219 222 ! 220 ALLOCATE( dta_read( MAXVAL( ilen0(1:3)), 1, 1 ) )223 ALLOCATE( dta_read( MAXVAL( idx_bdy(ib_bdy)%nblen(:) ), 1, 1 ) ) 221 224 ! 222 225 ! Open files and read in tidal forcing data … … 225 228 DO itide = 1, nb_harmo 226 229 ! ! SSH fields 227 clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_T.nc' 228 CALL iom_open( clfile, inum ) 229 CALL fld_map( inum, 'z1' , dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) ) 230 td%ssh0(:,itide,1) = dta_read(1:ilen0(1),1,1) 231 CALL fld_map( inum, 'z2' , dta_read(1:ilen0(1),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) ) 232 td%ssh0(:,itide,2) = dta_read(1:ilen0(1),1,1) 233 CALL iom_close( inum ) 230 IF( ASSOCIATED(dta%ssh) ) THEN ! we use bdy ssh on this mpi subdomain 231 isz = SIZE(dta%ssh) 232 clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_T.nc' 233 CALL iom_open( clfile, inum ) 234 CALL fld_map( inum, 'z1', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) ) 235 td%ssh0(:,itide,1) = dta_read(1:isz,1,1) 236 CALL fld_map( inum, 'z2', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,1) ) 237 td%ssh0(:,itide,2) = dta_read(1:isz,1,1) 238 CALL iom_close( inum ) 239 ENDIF 234 240 ! ! U fields 235 clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_U.nc' 236 CALL iom_open( clfile, inum ) 237 CALL fld_map( inum, 'u1' , dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) ) 238 td%u0(:,itide,1) = dta_read(1:ilen0(2),1,1) 239 CALL fld_map( inum, 'u2' , dta_read(1:ilen0(2),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) ) 240 td%u0(:,itide,2) = dta_read(1:ilen0(2),1,1) 241 CALL iom_close( inum ) 241 IF( ASSOCIATED(dta%u2d) ) THEN ! we use bdy u2d on this mpi subdomain 242 isz = SIZE(dta%u2d) 243 clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_U.nc' 244 CALL iom_open( clfile, inum ) 245 CALL fld_map( inum, 'u1', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) ) 246 td%u0(:,itide,1) = dta_read(1:isz,1,1) 247 CALL fld_map( inum, 'u2', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,2) ) 248 td%u0(:,itide,2) = dta_read(1:isz,1,1) 249 CALL iom_close( inum ) 250 ENDIF 242 251 ! ! V fields 243 clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_V.nc' 244 CALL iom_open( clfile, inum ) 245 CALL fld_map( inum, 'v1' , dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) ) 246 td%v0(:,itide,1) = dta_read(1:ilen0(3),1,1) 247 CALL fld_map( inum, 'v2' , dta_read(1:ilen0(3),1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) ) 248 td%v0(:,itide,2) = dta_read(1:ilen0(3),1,1) 249 CALL iom_close( inum ) 252 IF( ASSOCIATED(dta%v2d) ) THEN ! we use bdy v2d on this mpi subdomain 253 isz = SIZE(dta%v2d) 254 clfile = TRIM(filtide)//TRIM(tide_harmonics(itide)%cname_tide)//'_grid_V.nc' 255 CALL iom_open( clfile, inum ) 256 CALL fld_map( inum, 'v1', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) ) 257 td%v0(:,itide,1) = dta_read(1:isz,1,1) 258 CALL fld_map( inum, 'v2', dta_read(1:isz,1:1,1:1) , 1, idx_bdy(ib_bdy)%nbmap(:,3) ) 259 td%v0(:,itide,2) = dta_read(1:isz,1,1) 260 CALL iom_close( inum ) 261 ENDIF 250 262 ! 251 263 END DO ! end loop on tidal components … … 254 266 ! 255 267 ENDIF ! ln_bdytide_2ddta=.true. 256 !257 ! Allocate slow varying data in the case of time splitting:258 ! Do it anyway because at this stage knowledge of free surface scheme is unknown259 ALLOCATE( dta_bdy_s(ib_bdy)%ssh ( ilen0(1) ) )260 ALLOCATE( dta_bdy_s(ib_bdy)%u2d ( ilen0(2) ) )261 ALLOCATE( dta_bdy_s(ib_bdy)%v2d ( ilen0(3) ) )262 dta_bdy_s(ib_bdy)%ssh(:) = 0._wp263 dta_bdy_s(ib_bdy)%u2d(:) = 0._wp264 dta_bdy_s(ib_bdy)%v2d(:) = 0._wp265 268 ! 266 269 ENDIF ! nn_dyn2d_dta(ib_bdy) >= 2 … … 283 286 ! 284 287 LOGICAL :: lk_first_btstp ! =.TRUE. if time splitting and first barotropic step 285 INTEGER :: itide, ib_bdy, ib, igrd ! loop indices 286 INTEGER, DIMENSION(jpbgrd) :: ilen0 287 INTEGER, DIMENSION(1:jpbgrd) :: nblen, nblenrim ! short cuts 288 INTEGER :: itide, ib_bdy, ib ! loop indices 288 289 REAL(wp) :: z_arg, z_sarg, zramp, zoff, z_cost, z_sist, zt_offset 289 290 !!---------------------------------------------------------------------- … … 310 311 IF( nn_dyn2d_dta(ib_bdy) >= 2 ) THEN 311 312 ! 312 nblen(1:jpbgrd) = idx_bdy(ib_bdy)%nblen(1:jpbgrd)313 nblenrim(1:jpbgrd) = idx_bdy(ib_bdy)%nblenrim(1:jpbgrd)314 !315 IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN ; ilen0(:) = nblen (:)316 ELSE ; ilen0(:) = nblenrim(:)317 ENDIF318 !319 313 ! We refresh nodal factors every day below 320 314 ! This should be done somewhere else … … 337 331 ! If time splitting, initialize arrays from slow varying open boundary data: 338 332 IF ( PRESENT(kit) ) THEN 339 IF ( dta_bdy(ib_bdy)%lneed_ssh ) dta_bdy(ib_bdy)%ssh(1:ilen0(1)) = dta_bdy_s(ib_bdy)%ssh(1:ilen0(1))340 IF ( dta_bdy(ib_bdy)%lneed_dyn2d ) dta_bdy(ib_bdy)%u2d(1:ilen0(2)) = dta_bdy_s(ib_bdy)%u2d(1:ilen0(2))341 IF ( dta_bdy(ib_bdy)%lneed_dyn2d ) dta_bdy(ib_bdy)%v2d(1:ilen0(3)) = dta_bdy_s(ib_bdy)%v2d(1:ilen0(3))333 IF ( ASSOCIATED(dta_bdy(ib_bdy)%ssh) ) dta_bdy(ib_bdy)%ssh(:) = dta_bdy_s(ib_bdy)%ssh(:) 334 IF ( ASSOCIATED(dta_bdy(ib_bdy)%u2d) ) dta_bdy(ib_bdy)%u2d(:) = dta_bdy_s(ib_bdy)%u2d(:) 335 IF ( ASSOCIATED(dta_bdy(ib_bdy)%v2d) ) dta_bdy(ib_bdy)%v2d(:) = dta_bdy_s(ib_bdy)%v2d(:) 342 336 ENDIF 343 337 ! … … 349 343 z_sist = zramp * SIN( z_sarg ) 350 344 ! 351 IF ( dta_bdy(ib_bdy)%lneed_ssh ) THEN 352 igrd=1 ! SSH on tracer grid 353 DO ib = 1, ilen0(igrd) 345 IF ( ASSOCIATED(dta_bdy(ib_bdy)%ssh) ) THEN ! SSH on tracer grid 346 DO ib = 1, SIZE(dta_bdy(ib_bdy)%ssh) 354 347 dta_bdy(ib_bdy)%ssh(ib) = dta_bdy(ib_bdy)%ssh(ib) + & 355 348 & ( tides(ib_bdy)%ssh(ib,itide,1)*z_cost + & … … 358 351 ENDIF 359 352 ! 360 IF ( dta_bdy(ib_bdy)%lneed_dyn2d ) THEN 361 igrd=2 ! U grid 362 DO ib = 1, ilen0(igrd) 353 IF ( ASSOCIATED(dta_bdy(ib_bdy)%u2d) ) THEN ! U grid 354 DO ib = 1, SIZE(dta_bdy(ib_bdy)%u2d) 363 355 dta_bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) + & 364 356 & ( tides(ib_bdy)%u(ib,itide,1)*z_cost + & 365 357 & tides(ib_bdy)%u(ib,itide,2)*z_sist ) 366 358 END DO 367 igrd=3 ! V grid 368 DO ib = 1, ilen0(igrd) 359 ENDIF 360 ! 361 IF ( ASSOCIATED(dta_bdy(ib_bdy)%v2d) ) THEN ! V grid 362 DO ib = 1, SIZE(dta_bdy(ib_bdy)%v2d) 369 363 dta_bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) + & 370 364 & ( tides(ib_bdy)%v(ib,itide,1)*z_cost + & … … 372 366 END DO 373 367 ENDIF 368 ! 374 369 END DO 375 END 370 ENDIF 376 371 END DO 377 372 ! … … 386 381 TYPE(TIDES_DATA), INTENT(inout) :: td ! tidal harmonics data 387 382 ! 388 INTEGER :: itide, igrd, ib ! dummy loop indices 389 INTEGER, DIMENSION(1) :: ilen0 ! length of boundary data (from OBC arrays) 383 INTEGER :: itide, isz, ib ! dummy loop indices 390 384 REAL(wp),ALLOCATABLE, DIMENSION(:) :: mod_tide, phi_tide 391 385 !!---------------------------------------------------------------------- 392 386 ! 393 igrd=1 394 ! SSH on tracer grid. 395 ilen0(1) = SIZE(td%ssh0(:,1,1)) 396 ! 397 ALLOCATE( mod_tide(ilen0(igrd)), phi_tide(ilen0(igrd)) ) 398 ! 399 DO itide = 1, nb_harmo 400 DO ib = 1, ilen0(igrd) 401 mod_tide(ib)=SQRT(td%ssh0(ib,itide,1)**2.+td%ssh0(ib,itide,2)**2.) 402 phi_tide(ib)=ATAN2(-td%ssh0(ib,itide,2),td%ssh0(ib,itide,1)) 387 IF( ASSOCIATED(td%ssh0) ) THEN ! SSH on tracer grid. 388 ! 389 isz = SIZE( td%ssh0, dim = 1 ) 390 ALLOCATE( mod_tide(isz), phi_tide(isz) ) 391 ! 392 DO itide = 1, nb_harmo 393 DO ib = 1, isz 394 mod_tide(ib)=SQRT( td%ssh0(ib,itide,1)*td%ssh0(ib,itide,1) + td%ssh0(ib,itide,2)*td%ssh0(ib,itide,2) ) 395 phi_tide(ib)=ATAN2(-td%ssh0(ib,itide,2),td%ssh0(ib,itide,1)) 396 END DO 397 DO ib = 1, isz 398 mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f 399 phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0+tide_harmonics(itide)%u 400 END DO 401 DO ib = 1, isz 402 td%ssh(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib)) 403 td%ssh(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib)) 404 END DO 403 405 END DO 404 DO ib = 1 , ilen0(igrd) 405 mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f 406 phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0+tide_harmonics(itide)%u 407 ENDDO 408 DO ib = 1 , ilen0(igrd) 409 td%ssh(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib)) 410 td%ssh(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib)) 411 ENDDO 412 END DO 413 ! 414 DEALLOCATE( mod_tide, phi_tide ) 406 ! 407 DEALLOCATE( mod_tide, phi_tide ) 408 ! 409 ENDIF 415 410 ! 416 411 END SUBROUTINE tide_init_elevation … … 424 419 TYPE(TIDES_DATA), INTENT(inout) :: td ! tidal harmonics data 425 420 ! 426 INTEGER :: itide, igrd, ib ! dummy loop indices 427 INTEGER, DIMENSION(3) :: ilen0 ! length of boundary data (from OBC arrays) 421 INTEGER :: itide, isz, ib ! dummy loop indices 428 422 REAL(wp),ALLOCATABLE, DIMENSION(:) :: mod_tide, phi_tide 429 423 !!---------------------------------------------------------------------- 430 424 ! 431 ilen0(2) = SIZE(td%u0(:,1,1)) 432 ilen0(3) = SIZE(td%v0(:,1,1)) 433 ! 434 igrd=2 ! U grid. 435 ! 436 ALLOCATE( mod_tide(ilen0(igrd)) , phi_tide(ilen0(igrd)) ) 437 ! 438 DO itide = 1, nb_harmo 439 DO ib = 1, ilen0(igrd) 440 mod_tide(ib)=SQRT(td%u0(ib,itide,1)**2.+td%u0(ib,itide,2)**2.) 441 phi_tide(ib)=ATAN2(-td%u0(ib,itide,2),td%u0(ib,itide,1)) 425 IF( ASSOCIATED(td%u0) ) THEN ! U grid. we use bdy u2d on this mpi subdomain 426 ! 427 isz = SIZE( td%u0, dim = 1 ) 428 ALLOCATE( mod_tide(isz), phi_tide(isz) ) 429 ! 430 DO itide = 1, nb_harmo 431 DO ib = 1, isz 432 mod_tide(ib)=SQRT( td%u0(ib,itide,1)*td%u0(ib,itide,1) + td%u0(ib,itide,2)*td%u0(ib,itide,2) ) 433 phi_tide(ib)=ATAN2(-td%u0(ib,itide,2),td%u0(ib,itide,1)) 434 END DO 435 DO ib = 1, isz 436 mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f 437 phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0 + tide_harmonics(itide)%u 438 END DO 439 DO ib = 1, isz 440 td%u(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib)) 441 td%u(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib)) 442 END DO 442 443 END DO 443 DO ib = 1, ilen0(igrd) 444 mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f 445 phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0 + tide_harmonics(itide)%u 446 ENDDO 447 DO ib = 1, ilen0(igrd) 448 td%u(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib)) 449 td%u(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib)) 450 ENDDO 451 END DO 452 ! 453 DEALLOCATE( mod_tide , phi_tide ) 454 ! 455 igrd=3 ! V grid. 456 ! 457 ALLOCATE( mod_tide(ilen0(igrd)) , phi_tide(ilen0(igrd)) ) 458 459 DO itide = 1, nb_harmo 460 DO ib = 1, ilen0(igrd) 461 mod_tide(ib)=SQRT(td%v0(ib,itide,1)**2.+td%v0(ib,itide,2)**2.) 462 phi_tide(ib)=ATAN2(-td%v0(ib,itide,2),td%v0(ib,itide,1)) 444 ! 445 DEALLOCATE( mod_tide, phi_tide ) 446 ! 447 ENDIF 448 ! 449 IF( ASSOCIATED(td%v0) ) THEN ! V grid. we use bdy u2d on this mpi subdomain 450 ! 451 isz = SIZE( td%v0, dim = 1 ) 452 ALLOCATE( mod_tide(isz), phi_tide(isz) ) 453 ! 454 DO itide = 1, nb_harmo 455 DO ib = 1, isz 456 mod_tide(ib)=SQRT( td%v0(ib,itide,1)*td%v0(ib,itide,1) + td%v0(ib,itide,2)*td%v0(ib,itide,2) ) 457 phi_tide(ib)=ATAN2(-td%v0(ib,itide,2),td%v0(ib,itide,1)) 458 END DO 459 DO ib = 1, isz 460 mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f 461 phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0 + tide_harmonics(itide)%u 462 END DO 463 DO ib = 1, isz 464 td%v(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib)) 465 td%v(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib)) 466 END DO 463 467 END DO 464 DO ib = 1, ilen0(igrd) 465 mod_tide(ib)=mod_tide(ib)*tide_harmonics(itide)%f 466 phi_tide(ib)=phi_tide(ib)+tide_harmonics(itide)%v0 + tide_harmonics(itide)%u 467 ENDDO 468 DO ib = 1, ilen0(igrd) 469 td%v(ib,itide,1)= mod_tide(ib)*COS(phi_tide(ib)) 470 td%v(ib,itide,2)=-mod_tide(ib)*SIN(phi_tide(ib)) 471 ENDDO 472 END DO 473 ! 474 DEALLOCATE( mod_tide, phi_tide ) 475 ! 476 END SUBROUTINE tide_init_velocities 468 ! 469 DEALLOCATE( mod_tide, phi_tide ) 470 ! 471 ENDIF 472 ! 473 END SUBROUTINE tide_init_velocities 477 474 478 475 !!====================================================================== -
NEMO/branches/2020/r12377_ticket2386/src/OCE/BDY/bdytra.F90
r12377 r13540 61 61 IF( ir == 0 ) THEN ; llrim0 = .TRUE. 62 62 ELSE ; llrim0 = .FALSE. 63 END 63 ENDIF 64 64 DO ib_bdy=1, nb_bdy 65 65 ! … … 69 69 DO jn = 1, jpts 70 70 ! 71 SELECT CASE( TRIM(cn_tra(ib_bdy)) )71 SELECT CASE( cn_tra(ib_bdy) ) 72 72 CASE('none' ) ; CYCLE 73 73 CASE('frs' ) ! treat the whole boundary at once 74 IF( ir == 0 ) CALL bdy_frs ( idx_bdy(ib_bdy),pts(:,:,:,jn,Kaa), zdta(jn)%tra )74 IF( ir == 0 ) CALL bdy_frs ( idx_bdy(ib_bdy), pts(:,:,:,jn,Kaa), zdta(jn)%tra ) 75 75 CASE('specified' ) ! treat the whole rim at once 76 IF( ir == 0 ) CALL bdy_spe ( idx_bdy(ib_bdy),pts(:,:,:,jn,Kaa), zdta(jn)%tra )77 CASE('neumann' ) ; CALL bdy_nmn ( idx_bdy(ib_bdy), igrd , pts(:,:,:,jn,Kaa), llrim0 ) ! tsa masked78 CASE('orlanski' ) ; CALL bdy_orl ( idx_bdy(ib_bdy), pts(:,:,:,jn,Kbb), pts(:,:,:,jn,Kaa), &79 & zdta(jn)%tra, llrim0, ll_npo=.false. )80 CASE('orlanski_npo') ; CALL bdy_orl ( idx_bdy(ib_bdy), pts(:,:,:,jn,Kbb), pts(:,:,:,jn,Kaa), &81 & zdta(jn)%tra, llrim0, ll_npo=.true. )82 CASE('runoff' ) ; CALL bdy_rnf ( idx_bdy(ib_bdy), pts(:,:,:,jn,Kaa), jn, llrim0 )76 IF( ir == 0 ) CALL bdy_spe ( idx_bdy(ib_bdy), pts(:,:,:,jn,Kaa), zdta(jn)%tra ) 77 CASE('neumann' ) ; CALL bdy_nmn ( idx_bdy(ib_bdy), igrd , pts(:,:,:,jn,Kaa), llrim0 ) ! tsa masked 78 CASE('orlanski' ) ; CALL bdy_orl ( idx_bdy(ib_bdy), pts(:,:,:,jn,Kbb), pts(:,:,:,jn,Kaa), zdta(jn)%tra, & 79 & llrim0, ll_npo=.FALSE. ) 80 CASE('orlanski_npo') ; CALL bdy_orl ( idx_bdy(ib_bdy), pts(:,:,:,jn,Kbb), pts(:,:,:,jn,Kaa), zdta(jn)%tra, & 81 & llrim0, ll_npo=.TRUE. ) 82 CASE('runoff' ) ; CALL bdy_rnf ( idx_bdy(ib_bdy), pts(:,:,:,jn,Kaa), jn, llrim0 ) 83 83 CASE DEFAULT ; CALL ctl_stop( 'bdy_tra : unrecognised option for open boundaries for T and S' ) 84 84 END SELECT … … 88 88 ! 89 89 IF( nn_hls > 1 .AND. ir == 1 ) CYCLE ! at least 2 halos will be corrected -> no need to correct rim 1 before rim 0 90 IF( nn_hls == 1 ) THEN ; llsend1(:) = .false. ; llrecv1(:) = .false. ; END 90 IF( nn_hls == 1 ) THEN ; llsend1(:) = .false. ; llrecv1(:) = .false. ; ENDIF 91 91 DO ib_bdy=1, nb_bdy 92 SELECT CASE( TRIM(cn_tra(ib_bdy)) )92 SELECT CASE( cn_tra(ib_bdy) ) 93 93 CASE('neumann','runoff') 94 94 llsend1(:) = llsend1(:) .OR. lsend_bdyint(ib_bdy,1,:,ir) ! possibly every direction, T points … … 100 100 END DO 101 101 IF( ANY(llsend1) .OR. ANY(llrecv1) ) THEN ! if need to send/recv in at least one direction 102 CALL lbc_lnk( 'bdytra', pts(:,:,:,jn,Kaa), 'T', 1. , kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 )103 END 102 CALL lbc_lnk( 'bdytra', pts(:,:,:,jn,Kaa), 'T', 1.0_wp, kfillmode=jpfillnothing ,lsend=llsend1, lrecv=llrecv1 ) 103 ENDIF 104 104 ! 105 105 END DO ! ir … … 135 135 pt(ii,ij,1:jpkm1) = 0.1 * tmask(ii,ij,1:jpkm1) 136 136 END DO 137 END 137 ENDIF 138 138 ! 139 139 END SUBROUTINE bdy_rnf
Note: See TracChangeset
for help on using the changeset viewer.