- Timestamp:
- 2020-05-14T21:46:00+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/BDY/bdydta.F90 (modified) (26 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser
- Property svn:externals
-
old new 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 9 # SETTE 10 ^/utils/CI/sette@HEAD sette
-
- Property svn:externals
-
NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/BDY/bdydta.F90
r12178 r12928 23 23 USE phycst ! physical constants 24 24 USE sbcapr ! atmospheric pressure forcing 25 USE sbctide ! Tidal forcing or not25 USE tide_mod, ONLY: ln_tide ! tidal forcing 26 26 USE bdy_oce ! ocean open boundary conditions 27 27 USE bdytides ! tidal forcing at boundaries … … 68 68 !$AGRIF_END_DO_NOT_TREAT 69 69 70 !! * Substitutions 71 # include "do_loop_substitute.h90" 70 72 !!---------------------------------------------------------------------- 71 73 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 75 77 CONTAINS 76 78 77 SUBROUTINE bdy_dta( kt, kit, kt_offset)79 SUBROUTINE bdy_dta( kt, Kmm ) 78 80 !!---------------------------------------------------------------------- 79 81 !! *** SUBROUTINE bdy_dta *** … … 85 87 !!---------------------------------------------------------------------- 86 88 INTEGER, INTENT(in) :: kt ! ocean time-step index 87 INTEGER, INTENT(in), OPTIONAL :: kit ! subcycle time-step index (for timesplitting option) 88 INTEGER, INTENT(in), OPTIONAL :: kt_offset ! time offset in units of timesteps. NB. if kit 89 ! ! is present then units = subcycle timesteps. 90 ! ! kt_offset = 0 => get data at "now" time level 91 ! ! kt_offset = -1 => get data at "before" time level 92 ! ! kt_offset = +1 => get data at "after" time level 93 ! ! etc. 89 INTEGER, INTENT(in) :: Kmm ! ocean time level index 94 90 ! 95 91 INTEGER :: jbdy, jfld, jstart, jend, ib, jl ! dummy loop indices 96 92 INTEGER :: ii, ij, ik, igrd, ipl ! local integers 97 INTEGER, DIMENSION(jpbgrd) :: ilen198 INTEGER, DIMENSION(:), POINTER :: nblen, nblenrim ! short cuts99 93 TYPE(OBC_DATA) , POINTER :: dta_alias ! short cut 100 94 TYPE(FLD), DIMENSION(:), POINTER :: bf_alias … … 105 99 ! Initialise data arrays once for all from initial conditions where required 106 100 !--------------------------------------------------------------------------- 107 IF( kt == nit000 .AND. .NOT.PRESENT(kit)) THEN101 IF( kt == nit000 ) THEN 108 102 109 103 ! Calculate depth-mean currents … … 112 106 DO jbdy = 1, nb_bdy 113 107 ! 114 nblen => idx_bdy(jbdy)%nblen115 nblenrim => idx_bdy(jbdy)%nblenrim116 !117 108 IF( nn_dyn2d_dta(jbdy) == 0 ) THEN 118 ilen1(:) = nblen(:)119 109 IF( dta_bdy(jbdy)%lneed_ssh ) THEN 120 110 igrd = 1 121 DO ib = 1, i len1(igrd)111 DO ib = 1, idx_bdy(jbdy)%nblenrim(igrd) ! ssh is allocated and used only on the rim 122 112 ii = idx_bdy(jbdy)%nbi(ib,igrd) 123 113 ij = idx_bdy(jbdy)%nbj(ib,igrd) 124 dta_bdy(jbdy)%ssh(ib) = ssh n(ii,ij) * tmask(ii,ij,1)114 dta_bdy(jbdy)%ssh(ib) = ssh(ii,ij,Kmm) * tmask(ii,ij,1) 125 115 END DO 126 116 ENDIF 127 IF( dta_bdy(jbdy)%lneed_dyn2d) THEN117 IF( ASSOCIATED(dta_bdy(jbdy)%u2d) ) THEN ! no SIZE with a unassociated pointer. v2d and u2d can differ on subdomain 128 118 igrd = 2 129 DO ib = 1, ilen1(igrd)119 DO ib = 1, SIZE(dta_bdy(jbdy)%u2d) ! u2d is used either over the whole bdy or only on the rim 130 120 ii = idx_bdy(jbdy)%nbi(ib,igrd) 131 121 ij = idx_bdy(jbdy)%nbj(ib,igrd) 132 dta_bdy(jbdy)%u2d(ib) = u n_b(ii,ij) * umask(ii,ij,1)122 dta_bdy(jbdy)%u2d(ib) = uu_b(ii,ij,Kmm) * umask(ii,ij,1) 133 123 END DO 124 ENDIF 125 IF( ASSOCIATED(dta_bdy(jbdy)%v2d) ) THEN ! no SIZE with a unassociated pointer. v2d and u2d can differ on subdomain 134 126 igrd = 3 135 DO ib = 1, ilen1(igrd)127 DO ib = 1, SIZE(dta_bdy(jbdy)%v2d) ! v2d is used either over the whole bdy or only on the rim 136 128 ii = idx_bdy(jbdy)%nbi(ib,igrd) 137 129 ij = idx_bdy(jbdy)%nbj(ib,igrd) 138 dta_bdy(jbdy)%v2d(ib) = v n_b(ii,ij) * vmask(ii,ij,1)130 dta_bdy(jbdy)%v2d(ib) = vv_b(ii,ij,Kmm) * vmask(ii,ij,1) 139 131 END DO 140 132 ENDIF … … 142 134 ! 143 135 IF( nn_dyn3d_dta(jbdy) == 0 ) THEN 144 ilen1(:) = nblen(:)145 136 IF( dta_bdy(jbdy)%lneed_dyn3d ) THEN 146 137 igrd = 2 147 DO ib = 1, i len1(igrd)138 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 148 139 DO ik = 1, jpkm1 149 140 ii = idx_bdy(jbdy)%nbi(ib,igrd) 150 141 ij = idx_bdy(jbdy)%nbj(ib,igrd) 151 dta_bdy(jbdy)%u3d(ib,ik) = ( u n(ii,ij,ik) - un_b(ii,ij) ) * umask(ii,ij,ik)142 dta_bdy(jbdy)%u3d(ib,ik) = ( uu(ii,ij,ik,Kmm) - uu_b(ii,ij,Kmm) ) * umask(ii,ij,ik) 152 143 END DO 153 144 END DO 154 145 igrd = 3 155 DO ib = 1, i len1(igrd)146 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 156 147 DO ik = 1, jpkm1 157 148 ii = idx_bdy(jbdy)%nbi(ib,igrd) 158 149 ij = idx_bdy(jbdy)%nbj(ib,igrd) 159 dta_bdy(jbdy)%v3d(ib,ik) = ( v n(ii,ij,ik) - vn_b(ii,ij) ) * vmask(ii,ij,ik)150 dta_bdy(jbdy)%v3d(ib,ik) = ( vv(ii,ij,ik,Kmm) - vv_b(ii,ij,Kmm) ) * vmask(ii,ij,ik) 160 151 END DO 161 152 END DO … … 164 155 165 156 IF( nn_tra_dta(jbdy) == 0 ) THEN 166 ilen1(:) = nblen(:)167 157 IF( dta_bdy(jbdy)%lneed_tra ) THEN 168 158 igrd = 1 169 DO ib = 1, i len1(igrd)159 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 170 160 DO ik = 1, jpkm1 171 161 ii = idx_bdy(jbdy)%nbi(ib,igrd) 172 162 ij = idx_bdy(jbdy)%nbj(ib,igrd) 173 dta_bdy(jbdy)%tem(ib,ik) = ts n(ii,ij,ik,jp_bdytem) * tmask(ii,ij,ik)174 dta_bdy(jbdy)%sal(ib,ik) = ts n(ii,ij,ik,jp_bdysal) * tmask(ii,ij,ik)163 dta_bdy(jbdy)%tem(ib,ik) = ts(ii,ij,ik,jp_tem,Kmm) * tmask(ii,ij,ik) 164 dta_bdy(jbdy)%sal(ib,ik) = ts(ii,ij,ik,jp_sal,Kmm) * tmask(ii,ij,ik) 175 165 END DO 176 166 END DO … … 180 170 #if defined key_si3 181 171 IF( nn_ice_dta(jbdy) == 0 ) THEN ! set ice to initial values 182 ilen1(:) = nblen(:)183 172 IF( dta_bdy(jbdy)%lneed_ice ) THEN 184 173 igrd = 1 185 174 DO jl = 1, jpl 186 DO ib = 1, i len1(igrd)175 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 187 176 ii = idx_bdy(jbdy)%nbi(ib,igrd) 188 177 ij = idx_bdy(jbdy)%nbj(ib,igrd) … … 216 205 ! read/update all bdy data 217 206 ! ------------------------ 218 CALL fld_read( kt, 1, bf_alias, kit = kit, kt_offset = kt_offset )219 207 ! BDY: use pt_offset=0.5 as applied at the end of the step and fldread is referenced at the middle of the step 208 CALL fld_read( kt, 1, bf_alias, pt_offset = 0.5_wp, Kmm = Kmm ) 220 209 ! apply some corrections in some specific cases... 221 210 ! -------------------------------------------------- 222 211 ! 223 212 ! if runoff condition: change river flow we read (in m3/s) into barotropic velocity (m/s) 224 IF( cn_tra(jbdy) == 'runoff' .AND. TRIM(bf_alias(jp_bdyu2d)%clrootname) /= 'NOT USED' ) THEN ! runoff and we read u/v2d213 IF( cn_tra(jbdy) == 'runoff' ) THEN ! runoff 225 214 ! 226 igrd = 2 ! zonal flow (m3/s) to barotropic zonal velocity (m/s) 227 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 228 ii = idx_bdy(jbdy)%nbi(ib,igrd) 229 ij = idx_bdy(jbdy)%nbj(ib,igrd) 230 dta_alias%u2d(ib) = dta_alias%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) ) 231 END DO 232 igrd = 3 ! meridional flow (m3/s) to barotropic meridional velocity (m/s) 233 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 234 ii = idx_bdy(jbdy)%nbi(ib,igrd) 235 ij = idx_bdy(jbdy)%nbj(ib,igrd) 236 dta_alias%v2d(ib) = dta_alias%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) ) 237 END DO 215 IF( ASSOCIATED(dta_bdy(jbdy)%u2d) ) THEN ! no SIZE with a unassociated pointer. v2d and u2d can differ on subdomain 216 igrd = 2 ! zonal flow (m3/s) to barotropic zonal velocity (m/s) 217 DO ib = 1, SIZE(dta_alias%u2d) ! u2d is used either over the whole bdy or only on the rim 218 ii = idx_bdy(jbdy)%nbi(ib,igrd) 219 ij = idx_bdy(jbdy)%nbj(ib,igrd) 220 dta_alias%u2d(ib) = dta_alias%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) ) 221 END DO 222 ENDIF 223 IF( ASSOCIATED(dta_bdy(jbdy)%v2d) ) THEN ! no SIZE with a unassociated pointer. v2d and u2d can differ on subdomain 224 igrd = 3 ! meridional flow (m3/s) to barotropic meridional velocity (m/s) 225 DO ib = 1, SIZE(dta_alias%v2d) ! v2d is used either over the whole bdy or only on the rim 226 ii = idx_bdy(jbdy)%nbi(ib,igrd) 227 ij = idx_bdy(jbdy)%nbj(ib,igrd) 228 dta_alias%v2d(ib) = dta_alias%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) ) 229 END DO 230 ENDIF 238 231 ENDIF 239 232 240 233 ! tidal harmonic forcing ONLY: initialise arrays 241 234 IF( nn_dyn2d_dta(jbdy) == 2 ) THEN ! we did not read ssh, u/v2d 242 IF( dta_alias%lneed_ssh) dta_alias%ssh(:) = 0._wp243 IF( dta_alias%lneed_dyn2d) dta_alias%u2d(:) = 0._wp244 IF( dta_alias%lneed_dyn2d) dta_alias%v2d(:) = 0._wp235 IF( ASSOCIATED(dta_alias%ssh) ) dta_alias%ssh(:) = 0._wp 236 IF( ASSOCIATED(dta_alias%u2d) ) dta_alias%u2d(:) = 0._wp 237 IF( ASSOCIATED(dta_alias%v2d) ) dta_alias%v2d(:) = 0._wp 245 238 ENDIF 246 239 … … 249 242 ! 250 243 igrd = 2 ! zonal velocity 251 dta_alias%u2d(:) = 0._wp ! compute barotrope zonal velocity and put it in u2d252 244 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 253 245 ii = idx_bdy(jbdy)%nbi(ib,igrd) 254 246 ij = idx_bdy(jbdy)%nbj(ib,igrd) 247 dta_alias%u2d(ib) = 0._wp ! compute barotrope zonal velocity and put it in u2d 255 248 DO ik = 1, jpkm1 256 dta_alias%u2d(ib) = dta_alias%u2d(ib) + e3u _n(ii,ij,ik) * umask(ii,ij,ik) * dta_alias%u3d(ib,ik)249 dta_alias%u2d(ib) = dta_alias%u2d(ib) + e3u(ii,ij,ik,Kmm) * umask(ii,ij,ik) * dta_alias%u3d(ib,ik) 257 250 END DO 258 dta_alias%u2d(ib) = dta_alias%u2d(ib) * r1_hu _n(ii,ij)251 dta_alias%u2d(ib) = dta_alias%u2d(ib) * r1_hu(ii,ij,Kmm) 259 252 DO ik = 1, jpkm1 ! compute barocline zonal velocity and put it in u3d 260 253 dta_alias%u3d(ib,ik) = dta_alias%u3d(ib,ik) - dta_alias%u2d(ib) … … 262 255 END DO 263 256 igrd = 3 ! meridional velocity 264 dta_alias%v2d(:) = 0._wp ! compute barotrope meridional velocity and put it in v2d265 257 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 266 258 ii = idx_bdy(jbdy)%nbi(ib,igrd) 267 259 ij = idx_bdy(jbdy)%nbj(ib,igrd) 260 dta_alias%v2d(ib) = 0._wp ! compute barotrope meridional velocity and put it in v2d 268 261 DO ik = 1, jpkm1 269 dta_alias%v2d(ib) = dta_alias%v2d(ib) + e3v _n(ii,ij,ik) * vmask(ii,ij,ik) * dta_alias%v3d(ib,ik)262 dta_alias%v2d(ib) = dta_alias%v2d(ib) + e3v(ii,ij,ik,Kmm) * vmask(ii,ij,ik) * dta_alias%v3d(ib,ik) 270 263 END DO 271 dta_alias%v2d(ib) = dta_alias%v2d(ib) * r1_hv _n(ii,ij)264 dta_alias%v2d(ib) = dta_alias%v2d(ib) * r1_hv(ii,ij,Kmm) 272 265 DO ik = 1, jpkm1 ! compute barocline meridional velocity and put it in v3d 273 266 dta_alias%v3d(ib,ik) = dta_alias%v3d(ib,ik) - dta_alias%v2d(ib) … … 275 268 END DO 276 269 ENDIF ! ltotvel 277 278 ! update tidal harmonic forcing279 IF( PRESENT(kit) .AND. nn_dyn2d_dta(jbdy) .GE. 2 ) THEN280 CALL bdytide_update( kt = kt, idx = idx_bdy(jbdy), dta = dta_alias, td = tides(jbdy), &281 & kit = kit, kt_offset = kt_offset )282 ENDIF283 270 284 271 ! atm surface pressure : add inverted barometer effect to ssh if it was read … … 293 280 294 281 #if defined key_si3 295 IF( dta_alias%lneed_ice ) THEN282 IF( dta_alias%lneed_ice .AND. idx_bdy(jbdy)%nblen(1) > 0 ) THEN 296 283 ! fill temperature and salinity arrays 297 284 IF( TRIM(bf_alias(jp_bdyt_i)%clrootname) == 'NOT USED' ) bf_alias(jp_bdyt_i)%fnow(:,1,:) = rice_tem (jbdy) … … 302 289 & bf_alias(jp_bdya_i)%fnow(:,1,:) ! ( a_ip = rice_apnd * a_i ) 303 290 IF( TRIM(bf_alias(jp_bdyhip)%clrootname) == 'NOT USED' ) bf_alias(jp_bdyhip)%fnow(:,1,:) = rice_hpnd(jbdy) 291 292 ! if T_i is read and not T_su, set T_su = T_i 293 IF( TRIM(bf_alias(jp_bdyt_i)%clrootname) /= 'NOT USED' .AND. TRIM(bf_alias(jp_bdytsu)%clrootname) == 'NOT USED' ) & 294 & bf_alias(jp_bdytsu)%fnow(:,1,:) = bf_alias(jp_bdyt_i)%fnow(:,1,:) 295 ! if T_s is read and not T_su, set T_su = T_s 296 IF( TRIM(bf_alias(jp_bdyt_s)%clrootname) /= 'NOT USED' .AND. TRIM(bf_alias(jp_bdytsu)%clrootname) == 'NOT USED' ) & 297 & bf_alias(jp_bdytsu)%fnow(:,1,:) = bf_alias(jp_bdyt_s)%fnow(:,1,:) 298 ! if T_i is read and not T_s, set T_s = T_i 299 IF( TRIM(bf_alias(jp_bdyt_i)%clrootname) /= 'NOT USED' .AND. TRIM(bf_alias(jp_bdyt_s)%clrootname) == 'NOT USED' ) & 300 & bf_alias(jp_bdyt_s)%fnow(:,1,:) = bf_alias(jp_bdyt_i)%fnow(:,1,:) 301 ! if T_su is read and not T_s, set T_s = T_su 302 IF( TRIM(bf_alias(jp_bdytsu)%clrootname) /= 'NOT USED' .AND. TRIM(bf_alias(jp_bdyt_s)%clrootname) == 'NOT USED' ) & 303 & bf_alias(jp_bdyt_s)%fnow(:,1,:) = bf_alias(jp_bdytsu)%fnow(:,1,:) 304 304 ! if T_su is read and not T_i, set T_i = (T_su + T_freeze)/2 305 305 IF( TRIM(bf_alias(jp_bdytsu)%clrootname) /= 'NOT USED' .AND. TRIM(bf_alias(jp_bdyt_i)%clrootname) == 'NOT USED' ) & 306 306 & bf_alias(jp_bdyt_i)%fnow(:,1,:) = 0.5_wp * ( bf_alias(jp_bdytsu)%fnow(:,1,:) + 271.15 ) 307 ! if T_su is read and not T_s, set T_s = T_su308 IF( TRIM(bf_alias(jp_bdytsu)%clrootname) /= 'NOT USED' .AND. TRIM(bf_alias(jp_bdyt_s)%clrootname) == 'NOT USED' ) &309 & bf_alias(jp_bdyt_s)%fnow(:,1,:) = bf_alias(jp_bdytsu)%fnow(:,1,:)310 ! if T_s is read and not T_su, set T_su = T_s311 IF( TRIM(bf_alias(jp_bdyt_s)%clrootname) /= 'NOT USED' .AND. TRIM(bf_alias(jp_bdytsu)%clrootname) == 'NOT USED' ) &312 & bf_alias(jp_bdytsu)%fnow(:,1,:) = bf_alias(jp_bdyt_s)%fnow(:,1,:)313 307 ! if T_s is read and not T_i, set T_i = (T_s + T_freeze)/2 314 308 IF( TRIM(bf_alias(jp_bdyt_s)%clrootname) /= 'NOT USED' .AND. TRIM(bf_alias(jp_bdyt_i)%clrootname) == 'NOT USED' ) & … … 341 335 DO jbdy = 1, nb_bdy ! Tidal component added in ts loop 342 336 IF ( nn_dyn2d_dta(jbdy) .GE. 2 ) THEN 343 nblen => idx_bdy(jbdy)%nblen 344 nblenrim => idx_bdy(jbdy)%nblenrim 345 IF( cn_dyn2d(jbdy) == 'frs' ) THEN ; ilen1(:)=nblen(:) ; ELSE ; ilen1(:)=nblenrim(:) ; ENDIF 346 IF ( dta_bdy(jbdy)%lneed_ssh ) dta_bdy_s(jbdy)%ssh(1:ilen1(1)) = dta_bdy(jbdy)%ssh(1:ilen1(1)) 347 IF ( dta_bdy(jbdy)%lneed_dyn2d ) dta_bdy_s(jbdy)%u2d(1:ilen1(2)) = dta_bdy(jbdy)%u2d(1:ilen1(2)) 348 IF ( dta_bdy(jbdy)%lneed_dyn2d ) dta_bdy_s(jbdy)%v2d(1:ilen1(3)) = dta_bdy(jbdy)%v2d(1:ilen1(3)) 349 ENDIF 350 END DO 351 ELSE ! Add tides if not split-explicit free surface else this is done in ts loop 352 ! 353 CALL bdy_dta_tides( kt=kt, kt_offset=kt_offset ) 354 ENDIF 337 IF( ASSOCIATED(dta_bdy(jbdy)%ssh) ) dta_bdy_s(jbdy)%ssh(:) = dta_bdy(jbdy)%ssh(:) 338 IF( ASSOCIATED(dta_bdy(jbdy)%u2d) ) dta_bdy_s(jbdy)%u2d(:) = dta_bdy(jbdy)%u2d(:) 339 IF( ASSOCIATED(dta_bdy(jbdy)%v2d) ) dta_bdy_s(jbdy)%v2d(:) = dta_bdy(jbdy)%v2d(:) 340 ENDIF 341 END DO 342 ELSE ! Add tides if not split-explicit free surface else this is done in ts loop 343 ! 344 CALL bdy_dta_tides( kt=kt, pt_offset = 1._wp ) 355 345 ENDIF 356 ! 357 IF( ln_timing ) CALL timing_stop('bdy_dta') 358 ! 359 END SUBROUTINE bdy_dta 360 346 ENDIF 347 ! 348 IF( ln_timing ) CALL timing_stop('bdy_dta') 349 ! 350 END SUBROUTINE bdy_dta 351 361 352 362 353 SUBROUTINE bdy_dta_init … … 373 364 INTEGER :: ierror, ios ! 374 365 ! 366 INTEGER :: nbdy_rdstart, nbdy_loc 367 CHARACTER(LEN=50) :: cerrmsg ! error string 375 368 CHARACTER(len=3) :: cl3 ! 376 369 CHARACTER(len=100) :: cn_dir ! Root directory for location of data files … … 388 381 LOGICAL :: llneed ! 389 382 LOGICAL :: llread ! 383 LOGICAL :: llfullbdy ! 390 384 TYPE(FLD_N), DIMENSION(1), TARGET :: bn_tem, bn_sal, bn_u3d, bn_v3d ! must be an array to be used with fld_fill 391 385 TYPE(FLD_N), DIMENSION(1), TARGET :: bn_ssh, bn_u2d, bn_v2d ! informations about the fields to be read … … 415 409 ! Read namelists 416 410 ! -------------- 417 REWIND(numnam_cfg)411 nbdy_rdstart = 1 418 412 DO jbdy = 1, nb_bdy 419 413 … … 421 415 WRITE(ctmp2, '(a,i2)') 'block nambdy_dta number ', jbdy 422 416 423 ! There is only one nambdy_dta block in namelist_ref -> use it for each bdy so we do a rewind 424 REWIND(numnam_ref) 417 ! There is only one nambdy_dta block in namelist_ref -> use it for each bdy so we read from the beginning 425 418 READ ( numnam_ref, nambdy_dta, IOSTAT = ios, ERR = 901) 426 419 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_dta in reference namelist' ) … … 431 424 & .OR. ( dta_bdy(jbdy)%lneed_tra .AND. nn_tra_dta(jbdy) == 1 ) & 432 425 & .OR. ( dta_bdy(jbdy)%lneed_ice .AND. nn_ice_dta(jbdy) == 1 ) ) THEN 433 ! WARNING: we don't do a rewind here, each bdy reads its own nambdy_dta block one after another 434 READ ( numnam_cfg, nambdy_dta, IOSTAT = ios, ERR = 902 ) 426 ! 427 ! Need to support possibility of reading more than one 428 ! nambdy_dta from the namelist_cfg internal file. 429 ! Do this by finding the jbdy'th occurence of nambdy_dta in the 430 ! character buffer as the starting point. 431 ! 432 nbdy_loc = INDEX( numnam_cfg( nbdy_rdstart: ), 'nambdy_dta' ) 433 IF( nbdy_loc .GT. 0 ) THEN 434 nbdy_rdstart = nbdy_rdstart + nbdy_loc 435 ELSE 436 WRITE(cerrmsg,'(A,I4,A)') 'Error: entry number ',jbdy,' of nambdy_dta not found' 437 ios = -1 438 CALL ctl_nam ( ios , cerrmsg ) 439 ENDIF 440 READ ( numnam_cfg( MAX( 1, nbdy_rdstart - 2 ): ), nambdy_dta, IOSTAT = ios, ERR = 902) 435 441 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nambdy_dta in configuration namelist' ) 436 442 IF(lwm) WRITE( numond, nambdy_dta ) … … 442 448 IF( nn_ice_dta(jbdy) == 1 ) THEN ! if we get ice bdy data from netcdf file 443 449 CALL fld_fill( bf(jp_bdya_i,jbdy:jbdy), bn_a_i, cn_dir, 'bdy_dta', 'a_i'//' '//ctmp1, ctmp2 ) ! use namelist info 444 CALL fld_clopn( bf(jp_bdya_i,jbdy), nyear, nmonth, nday ) ! not a problem when we call it again after 450 CALL fld_def( bf(jp_bdya_i,jbdy) ) 451 CALL iom_open( bf(jp_bdya_i,jbdy)%clname, bf(jp_bdya_i,jbdy)%num ) 445 452 idvar = iom_varid( bf(jp_bdya_i,jbdy)%num, bf(jp_bdya_i,jbdy)%clvar, kndims=indims, kdimsz=i4dimsz, lduld=lluld ) 446 453 IF( indims == 4 .OR. ( indims == 3 .AND. .NOT. lluld ) ) THEN ; ipl = i4dimsz(3) ! xylt or xyl 447 454 ELSE ; ipl = 1 ! xy or xyt 448 455 ENDIF 456 CALL iom_close( bf(jp_bdya_i,jbdy)%num ) 457 bf(jp_bdya_i,jbdy)%clrootname = 'NOT USED' ! reset to default value as this subdomain may not need to read this bdy 449 458 ENDIF 450 459 ENDIF … … 487 496 igrd = 2 ! U point 488 497 ipk = 1 ! surface data 489 llneed = dta_bdy(jbdy)%lneed_dyn2d ! dta_bdy(jbdy)% sshwill be needed498 llneed = dta_bdy(jbdy)%lneed_dyn2d ! dta_bdy(jbdy)%u2d will be needed 490 499 llread = .NOT. ln_full_vel .AND. MOD(nn_dyn2d_dta(jbdy),2) == 1 ! don't get u2d from u3d and read NetCDF file 491 500 bf_alias => bf(jp_bdyu2d,jbdy:jbdy) ! alias for u2d structure of bdy number jbdy 492 501 bn_alias => bn_u2d ! alias for u2d structure of nambdy_dta 493 IF( ln_full_vel ) THEN ; iszdim = idx_bdy(jbdy)%nblen(igrd) ! will be computed from u3d -> need on the full bdy 494 ELSE ; iszdim = idx_bdy(jbdy)%nblenrim(igrd) ! used only on the rim 502 llfullbdy = ln_full_vel .OR. cn_dyn2d(jbdy) == 'frs' ! need u2d over the whole bdy or only over the rim? 503 IF( llfullbdy ) THEN ; iszdim = idx_bdy(jbdy)%nblen(igrd) 504 ELSE ; iszdim = idx_bdy(jbdy)%nblenrim(igrd) 495 505 ENDIF 496 506 ENDIF … … 499 509 igrd = 3 ! V point 500 510 ipk = 1 ! surface data 501 llneed = dta_bdy(jbdy)%lneed_dyn2d ! dta_bdy(jbdy)% sshwill be needed511 llneed = dta_bdy(jbdy)%lneed_dyn2d ! dta_bdy(jbdy)%v2d will be needed 502 512 llread = .NOT. ln_full_vel .AND. MOD(nn_dyn2d_dta(jbdy),2) == 1 ! don't get v2d from v3d and read NetCDF file 503 513 bf_alias => bf(jp_bdyv2d,jbdy:jbdy) ! alias for v2d structure of bdy number jbdy 504 514 bn_alias => bn_v2d ! alias for v2d structure of nambdy_dta 505 IF( ln_full_vel ) THEN ; iszdim = idx_bdy(jbdy)%nblen(igrd) ! will be computed from v3d -> need on the full bdy 506 ELSE ; iszdim = idx_bdy(jbdy)%nblenrim(igrd) ! used only on the rim 515 llfullbdy = ln_full_vel .OR. cn_dyn2d(jbdy) == 'frs' ! need v2d over the whole bdy or only over the rim? 516 IF( llfullbdy ) THEN ; iszdim = idx_bdy(jbdy)%nblen(igrd) 517 ELSE ; iszdim = idx_bdy(jbdy)%nblenrim(igrd) 507 518 ENDIF 508 519 ENDIF … … 615 626 ENDIF 616 627 617 IF( llneed ) THEN! dta_bdy(jbdy)%xxx will be needed628 IF( llneed .AND. iszdim > 0 ) THEN ! dta_bdy(jbdy)%xxx will be needed 618 629 ! ! -> must be associated with an allocated target 619 630 ALLOCATE( bf_alias(1)%fnow( iszdim, 1, ipk ) ) ! allocate the target … … 624 635 bf_alias(1)%imap => idx_bdy(jbdy)%nbmap(1:iszdim,igrd) ! associate the mapping used for this bdy 625 636 bf_alias(1)%igrd = igrd ! used only for vertical integration of 3D arrays 637 bf_alias(1)%ibdy = jbdy ! " " " " " " " " 626 638 bf_alias(1)%ltotvel = ln_full_vel ! T if u3d is full velocity 627 639 bf_alias(1)%lzint = ln_zinterp ! T if it requires a vertical interpolation
Note: See TracChangeset
for help on using the changeset viewer.
