Changeset 11223 for NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdydta.F90
- Timestamp:
- 2019-07-05T20:53:14+02:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r10984_HPC-13_IRRMANN_BDY_optimization/src/OCE/BDY/bdydta.F90
r10951 r11223 43 43 PUBLIC bdy_dta_init ! routine called by nemogcm.F90 44 44 45 INTEGER, ALLOCATABLE, DIMENSION(:) :: nb_bdy_fld ! Number of fields to update for each boundary set. 46 INTEGER :: nb_bdy_fld_sum ! Total number of fields to update for all boundary sets. 47 LOGICAL, DIMENSION(jp_bdy) :: ln_full_vel_array ! =T => full velocities in 3D boundary conditions 48 ! =F => baroclinic velocities in 3D boundary conditions 45 INTEGER , PARAMETER :: jpbdyfld = 10 ! maximum number of files to read 46 INTEGER , PARAMETER :: jp_bdyssh = 1 ! 47 INTEGER , PARAMETER :: jp_bdyu2d = 2 ! 48 INTEGER , PARAMETER :: jp_bdyv2d = 3 ! 49 INTEGER , PARAMETER :: jp_bdyu3d = 4 ! 50 INTEGER , PARAMETER :: jp_bdyv3d = 5 ! 51 INTEGER , PARAMETER :: jp_bdytem = 6 ! 52 INTEGER , PARAMETER :: jp_bdysal = 7 ! 53 INTEGER , PARAMETER :: jp_bdya_i = 8 ! 54 INTEGER , PARAMETER :: jp_bdyh_i = 9 ! 55 INTEGER , PARAMETER :: jp_bdyh_S = 10 ! 56 ! =F => baroclinic velocities in 3D boundary conditions 49 57 !$AGRIF_DO_NOT_TREAT 50 TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(: ), TARGET :: bf! structure of input fields (file informations, fields read)58 TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:,:), TARGET :: bf ! structure of input fields (file informations, fields read) 51 59 !$AGRIF_END_DO_NOT_TREAT 52 TYPE(MAP_POINTER), ALLOCATABLE, DIMENSION(:) :: nbmap_ptr ! array of pointers to nbmap53 54 #if defined key_si355 INTEGER :: nice_cat ! number of categories in the input file56 INTEGER :: jfld_hti, jfld_hts, jfld_ai ! indices of ice thickness, snow thickness and concentration in bf structure57 INTEGER, DIMENSION(jp_bdy) :: jfld_htit, jfld_htst, jfld_ait58 #endif59 60 60 61 !!---------------------------------------------------------------------- … … 65 66 CONTAINS 66 67 67 SUBROUTINE bdy_dta( kt, jit, time_offset )68 SUBROUTINE bdy_dta( kt, kit, kt_offset ) 68 69 !!---------------------------------------------------------------------- 69 70 !! *** SUBROUTINE bdy_dta *** … … 75 76 !!---------------------------------------------------------------------- 76 77 INTEGER, INTENT(in) :: kt ! ocean time-step index 77 INTEGER, INTENT(in), OPTIONAL :: jit ! subcycle time-step index (for timesplitting option)78 INTEGER, INTENT(in), OPTIONAL :: time_offset ! time offset in units of timesteps. NB. if jit78 INTEGER, INTENT(in), OPTIONAL :: kit ! subcycle time-step index (for timesplitting option) 79 INTEGER, INTENT(in), OPTIONAL :: kt_offset ! time offset in units of timesteps. NB. if kit 79 80 ! ! is present then units = subcycle timesteps. 80 ! ! time_offset = 0 => get data at "now" time level81 ! ! time_offset = -1 => get data at "before" time level82 ! ! time_offset = +1 => get data at "after" time level81 ! ! kt_offset = 0 => get data at "now" time level 82 ! ! kt_offset = -1 => get data at "before" time level 83 ! ! kt_offset = +1 => get data at "after" time level 83 84 ! ! etc. 84 85 ! 85 INTEGER :: jbdy, jfld, jstart, jend, ib, jl ! dummy loop indices 86 INTEGER :: ii, ij, ik, igrd ! local integers 87 INTEGER, DIMENSION(jpbgrd) :: ilen1 88 INTEGER, POINTER, DIMENSION(:) :: nblen, nblenrim ! short cuts 89 TYPE(OBC_DATA), POINTER :: dta ! short cut 86 INTEGER :: jbdy, jfld, jstart, jend, ib, jl ! dummy loop indices 87 INTEGER :: ii, ij, ik, igrd, ipl ! local integers 88 INTEGER, DIMENSION(jpbgrd) :: ilen1 89 INTEGER, DIMENSION(:), POINTER :: nblen, nblenrim ! short cuts 90 TYPE(OBC_DATA) , POINTER :: dta_alias ! short cut 91 TYPE(FLD), DIMENSION(:), POINTER :: bf_alias 90 92 !!--------------------------------------------------------------------------- 91 93 ! … … 94 96 ! Initialise data arrays once for all from initial conditions where required 95 97 !--------------------------------------------------------------------------- 96 IF( kt == nit000 .AND. .NOT.PRESENT( jit) ) THEN98 IF( kt == nit000 .AND. .NOT.PRESENT(kit) ) THEN 97 99 98 100 ! Calculate depth-mean currents 99 101 !----------------------------- 100 102 101 103 DO jbdy = 1, nb_bdy 102 104 ! 103 105 nblen => idx_bdy(jbdy)%nblen 104 106 nblenrim => idx_bdy(jbdy)%nblenrim 105 dta => dta_bdy(jbdy)106 107 ! 107 108 IF( nn_dyn2d_dta(jbdy) == 0 ) THEN 108 109 ilen1(:) = nblen(:) 109 IF( dta %ll_ssh ) THEN110 IF( dta_bdy(jbdy)%lneed_ssh ) THEN 110 111 igrd = 1 111 112 DO ib = 1, ilen1(igrd) … … 113 114 ij = idx_bdy(jbdy)%nbj(ib,igrd) 114 115 dta_bdy(jbdy)%ssh(ib) = sshn(ii,ij) * tmask(ii,ij,1) 115 END DO 116 ENDIF 117 IF( dta %ll_u2d) THEN116 END DO 117 ENDIF 118 IF( dta_bdy(jbdy)%lneed_dyn2d) THEN 118 119 igrd = 2 119 120 DO ib = 1, ilen1(igrd) … … 121 122 ij = idx_bdy(jbdy)%nbj(ib,igrd) 122 123 dta_bdy(jbdy)%u2d(ib) = un_b(ii,ij) * umask(ii,ij,1) 123 END DO 124 ENDIF 125 IF( dta%ll_v2d ) THEN 124 END DO 126 125 igrd = 3 127 126 DO ib = 1, ilen1(igrd) … … 129 128 ij = idx_bdy(jbdy)%nbj(ib,igrd) 130 129 dta_bdy(jbdy)%v2d(ib) = vn_b(ii,ij) * vmask(ii,ij,1) 131 END DO 130 END DO 132 131 ENDIF 133 132 ENDIF … … 135 134 IF( nn_dyn3d_dta(jbdy) == 0 ) THEN 136 135 ilen1(:) = nblen(:) 137 IF( dta %ll_u3d ) THEN136 IF( dta_bdy(jbdy)%lneed_dyn3d ) THEN 138 137 igrd = 2 139 138 DO ib = 1, ilen1(igrd) … … 143 142 dta_bdy(jbdy)%u3d(ib,ik) = ( un(ii,ij,ik) - un_b(ii,ij) ) * umask(ii,ij,ik) 144 143 END DO 145 END DO 146 ENDIF 147 IF( dta%ll_v3d ) THEN 144 END DO 148 145 igrd = 3 149 146 DO ib = 1, ilen1(igrd) … … 152 149 ij = idx_bdy(jbdy)%nbj(ib,igrd) 153 150 dta_bdy(jbdy)%v3d(ib,ik) = ( vn(ii,ij,ik) - vn_b(ii,ij) ) * vmask(ii,ij,ik) 154 155 END DO 151 END DO 152 END DO 156 153 ENDIF 157 154 ENDIF … … 159 156 IF( nn_tra_dta(jbdy) == 0 ) THEN 160 157 ilen1(:) = nblen(:) 161 IF( dta %ll_tem) THEN158 IF( dta_bdy(jbdy)%lneed_tra ) THEN 162 159 igrd = 1 163 160 DO ib = 1, ilen1(igrd) … … 165 162 ii = idx_bdy(jbdy)%nbi(ib,igrd) 166 163 ij = idx_bdy(jbdy)%nbj(ib,igrd) 167 dta_bdy(jbdy)%tem(ib,ik) = tsn(ii,ij,ik,jp_tem) * tmask(ii,ij,ik) 164 dta_bdy(jbdy)%tem(ib,ik) = tsn(ii,ij,ik,jp_bdytem) * tmask(ii,ij,ik) 165 dta_bdy(jbdy)%sal(ib,ik) = tsn(ii,ij,ik,jp_bdysal) * tmask(ii,ij,ik) 168 166 END DO 169 END DO 170 ENDIF 171 IF( dta%ll_sal ) THEN 172 igrd = 1 173 DO ib = 1, ilen1(igrd) 174 DO ik = 1, jpkm1 175 ii = idx_bdy(jbdy)%nbi(ib,igrd) 176 ij = idx_bdy(jbdy)%nbj(ib,igrd) 177 dta_bdy(jbdy)%sal(ib,ik) = tsn(ii,ij,ik,jp_sal) * tmask(ii,ij,ik) 178 END DO 179 END DO 167 END DO 180 168 ENDIF 181 169 ENDIF … … 184 172 IF( nn_ice_dta(jbdy) == 0 ) THEN ! set ice to initial values 185 173 ilen1(:) = nblen(:) 186 IF( dta %ll_a_i) THEN174 IF( dta_bdy(jbdy)%lneed_ice ) THEN 187 175 igrd = 1 188 176 DO jl = 1, jpl … … 191 179 ij = idx_bdy(jbdy)%nbj(ib,igrd) 192 180 dta_bdy(jbdy)%a_i (ib,jl) = a_i(ii,ij,jl) * tmask(ii,ij,1) 193 END DO194 END DO195 ENDIF196 IF( dta%ll_h_i ) THEN197 igrd = 1198 DO jl = 1, jpl199 DO ib = 1, ilen1(igrd)200 ii = idx_bdy(jbdy)%nbi(ib,igrd)201 ij = idx_bdy(jbdy)%nbj(ib,igrd)202 181 dta_bdy(jbdy)%h_i (ib,jl) = h_i(ii,ij,jl) * tmask(ii,ij,1) 203 END DO204 END DO205 ENDIF206 IF( dta%ll_h_s ) THEN207 igrd = 1208 DO jl = 1, jpl209 DO ib = 1, ilen1(igrd)210 ii = idx_bdy(jbdy)%nbi(ib,igrd)211 ij = idx_bdy(jbdy)%nbj(ib,igrd)212 182 dta_bdy(jbdy)%h_s (ib,jl) = h_s(ii,ij,jl) * tmask(ii,ij,1) 213 183 END DO … … 222 192 ! update external data from files 223 193 !-------------------------------- 224 225 jstart = 1 226 DO jbdy = 1, nb_bdy 227 dta => dta_bdy(jbdy) 228 IF( nn_dta(jbdy) == 1 ) THEN ! skip this bit if no external data required 229 230 IF( PRESENT(jit) ) THEN 231 ! Update barotropic boundary conditions only 232 ! jit is optional argument for fld_read and bdytide_update 233 IF( cn_dyn2d(jbdy) /= 'none' ) THEN 234 IF( nn_dyn2d_dta(jbdy) == 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays 235 IF( dta%ll_ssh ) dta%ssh(:) = 0._wp 236 IF( dta%ll_u2d ) dta%u2d(:) = 0._wp 237 IF( dta%ll_u3d ) dta%v2d(:) = 0._wp 238 ENDIF 239 IF (cn_tra(jbdy) /= 'runoff') THEN 240 IF( nn_dyn2d_dta(jbdy) == 1 .OR. nn_dyn2d_dta(jbdy) == 3 ) THEN 241 242 jend = jstart + dta%nread(2) - 1 243 IF( ln_full_vel_array(jbdy) ) THEN 244 CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend), & 245 & kit=jit, kt_offset=time_offset , jpk_bdy=nb_jpk_bdy(jbdy), & 246 & fvl=ln_full_vel_array(jbdy) ) 247 ELSE 248 CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend), & 249 & kit=jit, kt_offset=time_offset ) 250 ENDIF 251 252 ! If full velocities in boundary data then extract barotropic velocities from 3D fields 253 IF( ln_full_vel_array(jbdy) .AND. & 254 & ( nn_dyn2d_dta(jbdy) == 1 .OR. nn_dyn2d_dta(jbdy) == 3 .OR. & 255 & nn_dyn3d_dta(jbdy) == 1 ) )THEN 256 257 igrd = 2 ! zonal velocity 258 dta%u2d(:) = 0._wp 259 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 260 ii = idx_bdy(jbdy)%nbi(ib,igrd) 261 ij = idx_bdy(jbdy)%nbj(ib,igrd) 262 DO ik = 1, jpkm1 263 dta%u2d(ib) = dta%u2d(ib) & 264 & + e3u_n(ii,ij,ik) * umask(ii,ij,ik) * dta%u3d(ib,ik) 265 END DO 266 dta%u2d(ib) = dta%u2d(ib) * r1_hu_n(ii,ij) 267 END DO 268 igrd = 3 ! meridional velocity 269 dta%v2d(:) = 0._wp 270 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 271 ii = idx_bdy(jbdy)%nbi(ib,igrd) 272 ij = idx_bdy(jbdy)%nbj(ib,igrd) 273 DO ik = 1, jpkm1 274 dta%v2d(ib) = dta%v2d(ib) & 275 & + e3v_n(ii,ij,ik) * vmask(ii,ij,ik) * dta%v3d(ib,ik) 276 END DO 277 dta%v2d(ib) = dta%v2d(ib) * r1_hv_n(ii,ij) 278 END DO 279 ENDIF 280 ENDIF 281 IF( nn_dyn2d_dta(jbdy) .ge. 2 ) THEN ! update tidal harmonic forcing 282 CALL bdytide_update( kt=kt, idx=idx_bdy(jbdy), dta=dta, td=tides(jbdy), & 283 & jit=jit, time_offset=time_offset ) 284 ENDIF 285 ENDIF 286 ENDIF 287 ELSE 288 IF (cn_tra(jbdy) == 'runoff') then ! runoff condition 289 jend = nb_bdy_fld(jbdy) 290 CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), & 291 & map=nbmap_ptr(jstart:jend), kt_offset=time_offset ) 292 ! 293 igrd = 2 ! zonal velocity 294 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 295 ii = idx_bdy(jbdy)%nbi(ib,igrd) 296 ij = idx_bdy(jbdy)%nbj(ib,igrd) 297 dta%u2d(ib) = dta%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) ) 298 END DO 299 ! 300 igrd = 3 ! meridional velocity 301 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 302 ii = idx_bdy(jbdy)%nbi(ib,igrd) 303 ij = idx_bdy(jbdy)%nbj(ib,igrd) 304 dta%v2d(ib) = dta%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) ) 305 END DO 306 ELSE 307 IF( nn_dyn2d_dta(jbdy) == 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays 308 IF( dta%ll_ssh ) dta%ssh(:) = 0._wp 309 IF( dta%ll_u2d ) dta%u2d(:) = 0._wp 310 IF( dta%ll_v2d ) dta%v2d(:) = 0._wp 311 ENDIF 312 IF( dta%nread(1) .gt. 0 ) THEN ! update external data 313 jend = jstart + dta%nread(1) - 1 314 CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), & 315 & map=nbmap_ptr(jstart:jend), kt_offset=time_offset, jpk_bdy=nb_jpk_bdy(jbdy), & 316 & fvl=ln_full_vel_array(jbdy) ) 317 ENDIF 318 ! If full velocities in boundary data then split into barotropic and baroclinic data 319 IF( ln_full_vel_array(jbdy) .and. & 320 & ( nn_dyn2d_dta(jbdy) == 1 .OR. nn_dyn2d_dta(jbdy) == 3 .OR. & 321 & nn_dyn3d_dta(jbdy) == 1 ) ) THEN 322 igrd = 2 ! zonal velocity 323 dta%u2d(:) = 0._wp 324 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 325 ii = idx_bdy(jbdy)%nbi(ib,igrd) 326 ij = idx_bdy(jbdy)%nbj(ib,igrd) 327 DO ik = 1, jpkm1 328 dta%u2d(ib) = dta%u2d(ib) & 329 & + e3u_n(ii,ij,ik) * umask(ii,ij,ik) * dta%u3d(ib,ik) 330 END DO 331 dta%u2d(ib) = dta%u2d(ib) * r1_hu_n(ii,ij) 332 DO ik = 1, jpkm1 333 dta%u3d(ib,ik) = dta%u3d(ib,ik) - dta%u2d(ib) 334 END DO 335 END DO 336 igrd = 3 ! meridional velocity 337 dta%v2d(:) = 0._wp 338 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 339 ii = idx_bdy(jbdy)%nbi(ib,igrd) 340 ij = idx_bdy(jbdy)%nbj(ib,igrd) 341 DO ik = 1, jpkm1 342 dta%v2d(ib) = dta%v2d(ib) & 343 & + e3v_n(ii,ij,ik) * vmask(ii,ij,ik) * dta%v3d(ib,ik) 344 END DO 345 dta%v2d(ib) = dta%v2d(ib) * r1_hv_n(ii,ij) 346 DO ik = 1, jpkm1 347 dta%v3d(ib,ik) = dta%v3d(ib,ik) - dta%v2d(ib) 348 END DO 349 END DO 350 ENDIF 351 352 ENDIF 194 195 DO jbdy = 1, nb_bdy 196 197 dta_alias => dta_bdy(jbdy) 198 bf_alias => bf(:,jbdy) 199 200 ! read/update all bdy data 201 ! ------------------------ 202 CALL fld_read( kt, 1, bf_alias, kit = kit, kt_offset = kt_offset ) 203 204 ! apply some corrections in some specific cases... 205 ! -------------------------------------------------- 206 ! 207 ! if runoff condition: change river flow we read (in m3/s) into barotropic velocity (m/s) 208 IF( cn_tra(jbdy) == 'runoff' .AND. TRIM(bf_alias(jp_bdyu2d)%clrootname) /= 'NOT USED' ) THEN ! runoff and we read u/v2d 209 ! 210 igrd = 2 ! zonal flow (m3/s) to barotropic zonal velocity (m/s) 211 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 212 ii = idx_bdy(jbdy)%nbi(ib,igrd) 213 ij = idx_bdy(jbdy)%nbj(ib,igrd) 214 dta_alias%u2d(ib) = dta_alias%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) ) 215 END DO 216 igrd = 3 ! meridional flow (m3/s) to barotropic meridional velocity (m/s) 217 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 218 ii = idx_bdy(jbdy)%nbi(ib,igrd) 219 ij = idx_bdy(jbdy)%nbj(ib,igrd) 220 dta_alias%v2d(ib) = dta_alias%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) ) 221 END DO 222 ENDIF 223 224 ! tidal harmonic forcing ONLY: initialise arrays 225 IF( nn_dyn2d_dta(jbdy) == 2 ) THEN ! we did not read ssh, u/v2d 226 IF( dta_alias%lneed_ssh ) dta_alias%ssh(:) = 0._wp 227 IF( dta_alias%lneed_dyn2d ) dta_alias%u2d(:) = 0._wp 228 IF( dta_alias%lneed_dyn2d ) dta_alias%v2d(:) = 0._wp 229 ENDIF 230 231 ! If full velocities in boundary data, then split it into barotropic and baroclinic component 232 IF( bf_alias(jp_bdyu3d)%ltotvel ) THEN ! if we read 3D total velocity (can be true only if u3d was read) 233 ! 234 igrd = 2 ! zonal velocity 235 dta_alias%u2d(:) = 0._wp ! compute barotrope zonal velocity and put it in u2d 236 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 237 ii = idx_bdy(jbdy)%nbi(ib,igrd) 238 ij = idx_bdy(jbdy)%nbj(ib,igrd) 239 DO ik = 1, jpkm1 240 dta_alias%u2d(ib) = dta_alias%u2d(ib) + e3u_n(ii,ij,ik) * umask(ii,ij,ik) * dta_alias%u3d(ib,ik) 241 END DO 242 dta_alias%u2d(ib) = dta_alias%u2d(ib) * r1_hu_n(ii,ij) 243 DO ik = 1, jpkm1 ! compute barocline zonal velocity and put it in u3d 244 dta_alias%u3d(ib,ik) = dta_alias%u3d(ib,ik) - dta_alias%u2d(ib) 245 END DO 246 END DO 247 igrd = 3 ! meridional velocity 248 dta_alias%v2d(:) = 0._wp ! compute barotrope meridional velocity and put it in v2d 249 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 250 ii = idx_bdy(jbdy)%nbi(ib,igrd) 251 ij = idx_bdy(jbdy)%nbj(ib,igrd) 252 DO ik = 1, jpkm1 253 dta_alias%v2d(ib) = dta_alias%v2d(ib) + e3v_n(ii,ij,ik) * vmask(ii,ij,ik) * dta_alias%v3d(ib,ik) 254 END DO 255 dta_alias%v2d(ib) = dta_alias%v2d(ib) * r1_hv_n(ii,ij) 256 DO ik = 1, jpkm1 ! compute barocline meridional velocity and put it in v3d 257 dta_alias%v3d(ib,ik) = dta_alias%v3d(ib,ik) - dta_alias%v2d(ib) 258 END DO 259 END DO 260 ENDIF ! ltotvel 261 262 ! update tidal harmonic forcing 263 IF( PRESENT(kit) .AND. nn_dyn2d_dta(jbdy) .GE. 2 ) THEN 264 CALL bdytide_update( kt = kt, idx = idx_bdy(jbdy), dta = dta_alias, td = tides(jbdy), & 265 & kit = kit, kt_offset = kt_offset ) 266 ENDIF 267 268 ! atm surface pressure : add inverted barometer effect to ssh if it was read 269 IF ( ln_apr_obc .AND. TRIM(bf_alias(jp_bdyssh)%clrootname) /= 'NOT USED' ) THEN 270 igrd = 1 271 DO ib = 1, idx_bdy(jbdy)%nblenrim(igrd) ! ssh is used only on the rim 272 ii = idx_bdy(jbdy)%nbi(ib,igrd) 273 ij = idx_bdy(jbdy)%nbj(ib,igrd) 274 dta_alias%ssh(ib) = dta_alias%ssh(ib) + ssh_ib(ii,ij) 275 END DO 276 ENDIF 277 353 278 #if defined key_si3 354 ! convert N-cat fields (input) into jpl-cat (output) 355 IF( cn_ice(jbdy) /= 'none' .AND. nn_ice_dta(jbdy) == 1 ) THEN 356 jfld_hti = jfld_htit(jbdy) 357 jfld_hts = jfld_htst(jbdy) 358 jfld_ai = jfld_ait(jbdy) 359 IF ( jpl /= 1 .AND. nice_cat == 1 ) THEN ! case input cat = 1 360 CALL ice_var_itd ( bf(jfld_hti)%fnow(:,1,1), bf(jfld_hts)%fnow(:,1,1), bf(jfld_ai)%fnow(:,1,1), & 361 & dta_bdy(jbdy)%h_i , dta_bdy(jbdy)%h_s , dta_bdy(jbdy)%a_i ) 362 ELSEIF( jpl /= 1 .AND. nice_cat /= 1 .AND. nice_cat /= jpl ) THEN ! case input cat /=1 and /=jpl 363 CALL ice_var_itd2( bf(jfld_hti)%fnow(:,1,:), bf(jfld_hts)%fnow(:,1,:), bf(jfld_ai)%fnow(:,1,:), & 364 & dta_bdy(jbdy)%h_i , dta_bdy(jbdy)%h_s , dta_bdy(jbdy)%a_i ) 365 ENDIF 366 ENDIF 279 ! ice: convert N-cat fields (input) into jpl-cat (output) 280 IF( dta_alias%lneed_ice ) THEN 281 ipl = SIZE(bf_alias(jp_bdya_i)%fnow, 3) 282 IF( ipl /= jpl ) THEN ! ice: convert N-cat fields (input) into jpl-cat (output) 283 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,:), & 284 & dta_alias%h_i , dta_alias%h_s , dta_alias%a_i ) 285 ENDIF 286 ENDIF 367 287 #endif 368 ENDIF369 jstart = jstart + dta%nread(1)370 ENDIF ! nn_dta(jbdy) = 1371 288 END DO ! jbdy 372 373 IF ( ln_apr_obc ) THEN374 DO jbdy = 1, nb_bdy375 IF (cn_tra(jbdy) /= 'runoff')THEN376 igrd = 1 ! meridional velocity377 DO ib = 1, idx_bdy(jbdy)%nblenrim(igrd)378 ii = idx_bdy(jbdy)%nbi(ib,igrd)379 ij = idx_bdy(jbdy)%nbj(ib,igrd)380 dta_bdy(jbdy)%ssh(ib) = dta_bdy(jbdy)%ssh(ib) + ssh_ib(ii,ij)381 END DO382 ENDIF383 END DO384 ENDIF385 289 386 290 IF ( ln_tide ) THEN 387 291 IF (ln_dynspg_ts) THEN ! Fill temporary arrays with slow-varying bdy data 388 DO jbdy = 1, nb_bdy ! Tidal component added in ts loop389 IF ( nn_dyn2d_dta(jbdy) . ge. 2 ) THEN292 DO jbdy = 1, nb_bdy ! Tidal component added in ts loop 293 IF ( nn_dyn2d_dta(jbdy) .GE. 2 ) THEN 390 294 nblen => idx_bdy(jbdy)%nblen 391 295 nblenrim => idx_bdy(jbdy)%nblenrim 392 IF( cn_dyn2d(jbdy) == 'frs' ) THEN; ilen1(:)=nblen(:) ; ELSE ; ilen1(:)=nblenrim(:) ; ENDIF 393 IF ( dta_bdy(jbdy)%ll_ssh ) dta_bdy_s(jbdy)%ssh(1:ilen1(1)) = dta_bdy(jbdy)%ssh(1:ilen1(1)) 394 IF ( dta_bdy(jbdy)%ll_u2d ) dta_bdy_s(jbdy)%u2d(1:ilen1(2)) = dta_bdy(jbdy)%u2d(1:ilen1(2)) 395 IF ( dta_bdy(jbdy)%ll_v2d ) dta_bdy_s(jbdy)%v2d(1:ilen1(3)) = dta_bdy(jbdy)%v2d(1:ilen1(3)) 396 ENDIF 397 END DO 398 ELSE ! Add tides if not split-explicit free surface else this is done in ts loop 399 ! 400 CALL bdy_dta_tides( kt=kt, time_offset=time_offset ) 401 ENDIF 402 ENDIF 403 404 ! 405 IF( ln_timing ) CALL timing_stop('bdy_dta') 406 ! 407 END SUBROUTINE bdy_dta 296 IF( cn_dyn2d(jbdy) == 'frs' ) THEN ; ilen1(:)=nblen(:) ; ELSE ; ilen1(:)=nblenrim(:) ; ENDIF 297 IF ( dta_bdy(jbdy)%lneed_ssh ) dta_bdy_s(jbdy)%ssh(1:ilen1(1)) = dta_bdy(jbdy)%ssh(1:ilen1(1)) 298 IF ( dta_bdy(jbdy)%lneed_dyn2d ) dta_bdy_s(jbdy)%u2d(1:ilen1(2)) = dta_bdy(jbdy)%u2d(1:ilen1(2)) 299 IF ( dta_bdy(jbdy)%lneed_dyn2d ) dta_bdy_s(jbdy)%v2d(1:ilen1(3)) = dta_bdy(jbdy)%v2d(1:ilen1(3)) 300 ENDIF 301 END DO 302 ELSE ! Add tides if not split-explicit free surface else this is done in ts loop 303 ! 304 CALL bdy_dta_tides( kt=kt, kt_offset=kt_offset ) 305 ENDIF 306 ENDIF 307 ! 308 IF( ln_timing ) CALL timing_stop('bdy_dta') 309 ! 310 END SUBROUTINE bdy_dta 408 311 409 312 … … 418 321 !! 419 322 !!---------------------------------------------------------------------- 420 INTEGER :: jbdy, jfld, jstart, jend, ierror, ios ! Local integers 421 ! 323 INTEGER :: jbdy, jfld ! Local integers 324 INTEGER :: ierror, ios ! 325 ! 326 CHARACTER(len=3) :: cl3 ! 422 327 CHARACTER(len=100) :: cn_dir ! Root directory for location of data files 423 CHARACTER(len=100), DIMENSION(nb_bdy) :: cn_dir_array ! Root directory for location of data files424 CHARACTER(len = 256):: clname ! temporary file name425 328 LOGICAL :: ln_full_vel ! =T => full velocities in 3D boundary data 426 329 ! ! =F => baroclinic velocities in 3D boundary data 427 INTEGER :: ilen_global ! Max length required for global bdy dta arrays 428 INTEGER, ALLOCATABLE, DIMENSION(:) :: ilen1, ilen3 ! size of 1st and 3rd dimensions of local arrays 429 INTEGER, ALLOCATABLE, DIMENSION(:) :: ibdy ! bdy set for a particular jfld 430 INTEGER, ALLOCATABLE, DIMENSION(:) :: igrid ! index for grid type (1,2,3 = T,U,V) 431 INTEGER, POINTER, DIMENSION(:) :: nblen, nblenrim ! short cuts 432 TYPE(OBC_DATA), POINTER :: dta ! short cut 433 #if defined key_si3 434 INTEGER :: kndims ! number of dimensions in an array (i.e. 3 = wo ice cat; 4 = w ice cat) 435 INTEGER, DIMENSION(4) :: kdimsz ! size of dimensions 436 INTEGER :: inum,id1 ! local integer 437 #endif 438 TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: blf_i ! array of namelist information structures 439 TYPE(FLD_N) :: bn_tem, bn_sal, bn_u3d, bn_v3d ! 440 TYPE(FLD_N) :: bn_ssh, bn_u2d, bn_v2d ! informations about the fields to be read 441 #if defined key_si3 442 TYPE(FLD_N) :: bn_a_i, bn_h_i, bn_h_s 443 #endif 330 INTEGER :: ipk,ipl ! 331 INTEGER :: idvar ! variable ID 332 INTEGER :: indims ! number of dimensions of the variable 333 INTEGER :: iszdim ! number of dimensions of the variable 334 INTEGER, DIMENSION(4) :: i4dimsz ! size of variable dimensions 335 INTEGER :: igrd ! index for grid type (1,2,3 = T,U,V) 336 LOGICAL :: lluld ! is the variable using the unlimited dimension 337 LOGICAL :: llneed ! 338 LOGICAL :: llread ! 339 TYPE(FLD_N), DIMENSION(1), TARGET :: bn_tem, bn_sal, bn_u3d, bn_v3d ! must be an array to be used with fld_fill 340 TYPE(FLD_N), DIMENSION(1), TARGET :: bn_ssh, bn_u2d, bn_v2d ! informations about the fields to be read 341 TYPE(FLD_N), DIMENSION(1), TARGET :: bn_a_i, bn_h_i, bn_h_s 342 TYPE(FLD_N), DIMENSION(:), POINTER :: bn_alias ! must be an array to be used with fld_fill 343 TYPE(FLD ), DIMENSION(:), POINTER :: bf_alias 344 ! 444 345 NAMELIST/nambdy_dta/ cn_dir, bn_tem, bn_sal, bn_u3d, bn_v3d, bn_ssh, bn_u2d, bn_v2d 445 #if defined key_si3446 346 NAMELIST/nambdy_dta/ bn_a_i, bn_h_i, bn_h_s 447 #endif448 347 NAMELIST/nambdy_dta/ ln_full_vel 449 348 !!--------------------------------------------------------------------------- … … 454 353 IF(lwp) WRITE(numout,*) '' 455 354 456 ! Set nn_dta 457 DO jbdy = 1, nb_bdy 458 nn_dta(jbdy) = MAX( nn_dyn2d_dta (jbdy) & 459 & , nn_dyn3d_dta (jbdy) & 460 & , nn_tra_dta (jbdy) & 461 #if defined key_si3 462 & , nn_ice_dta (jbdy) & 463 #endif 464 ) 465 IF(nn_dta(jbdy) > 1) nn_dta(jbdy) = 1 466 END DO 467 468 ! Work out upper bound of how many fields there are to read in and allocate arrays 469 ! --------------------------------------------------------------------------- 470 ALLOCATE( nb_bdy_fld(nb_bdy) ) 471 nb_bdy_fld(:) = 0 472 DO jbdy = 1, nb_bdy 473 IF( cn_dyn2d(jbdy) /= 'none' .AND. ( nn_dyn2d_dta(jbdy) == 1 .or. nn_dyn2d_dta(jbdy) == 3 ) ) THEN 474 nb_bdy_fld(jbdy) = nb_bdy_fld(jbdy) + 3 475 ENDIF 476 IF( cn_dyn3d(jbdy) /= 'none' .AND. nn_dyn3d_dta(jbdy) == 1 ) THEN 477 nb_bdy_fld(jbdy) = nb_bdy_fld(jbdy) + 2 478 ENDIF 479 IF( cn_tra(jbdy) /= 'none' .AND. nn_tra_dta(jbdy) == 1 ) THEN 480 nb_bdy_fld(jbdy) = nb_bdy_fld(jbdy) + 2 481 ENDIF 482 #if defined key_si3 483 IF( cn_ice(jbdy) /= 'none' .AND. nn_ice_dta(jbdy) == 1 ) THEN 484 nb_bdy_fld(jbdy) = nb_bdy_fld(jbdy) + 3 485 ENDIF 486 #endif 487 IF(lwp) WRITE(numout,*) 'Maximum number of files to open =', nb_bdy_fld(jbdy) 488 END DO 489 490 nb_bdy_fld_sum = SUM( nb_bdy_fld ) 491 492 ALLOCATE( bf(nb_bdy_fld_sum), STAT=ierror ) 355 ALLOCATE( bf(jpbdyfld,nb_bdy), STAT=ierror ) 493 356 IF( ierror > 0 ) THEN 494 357 CALL ctl_stop( 'bdy_dta: unable to allocate bf structure' ) ; RETURN 495 358 ENDIF 496 ALLOCATE( blf_i(nb_bdy_fld_sum), STAT=ierror ) 497 IF( ierror > 0 ) THEN 498 CALL ctl_stop( 'bdy_dta: unable to allocate blf_i structure' ) ; RETURN 499 ENDIF 500 ALLOCATE( nbmap_ptr(nb_bdy_fld_sum), STAT=ierror ) 501 IF( ierror > 0 ) THEN 502 CALL ctl_stop( 'bdy_dta: unable to allocate nbmap_ptr structure' ) ; RETURN 503 ENDIF 504 ALLOCATE( ilen1(nb_bdy_fld_sum), ilen3(nb_bdy_fld_sum) ) 505 ALLOCATE( ibdy(nb_bdy_fld_sum) ) 506 ALLOCATE( igrid(nb_bdy_fld_sum) ) 507 359 bf(:,:)%clrootname = 'NOT USED' ! default definition used as a flag in fld_read to do nothing. 360 bf(:,:)%ltotvel = .FALSE. ! default definition 361 508 362 ! Read namelists 509 363 ! -------------- 510 364 REWIND(numnam_cfg) 511 jfld = 0 512 DO jbdy = 1, nb_bdy 513 IF( nn_dta(jbdy) == 1 ) THEN 514 REWIND(numnam_ref) 515 READ ( numnam_ref, nambdy_dta, IOSTAT = ios, ERR = 901) 516 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_dta in reference namelist', lwp ) 365 DO jbdy = 1, nb_bdy 366 367 WRITE(ctmp1, '(a,i2)') 'BDY number ', jbdy 368 WRITE(ctmp2, '(a,i2)') 'block nambdy_dta number ', jbdy 369 370 ! There is only one nambdy_dta block in namelist_ref -> use it for each bdy so we do a rewind 371 REWIND(numnam_ref) 372 READ ( numnam_ref, nambdy_dta, IOSTAT = ios, ERR = 901) 373 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_dta in reference namelist', lwp ) 374 375 ! by-pass nambdy_dta reading if no input data used in this bdy 376 IF( ( dta_bdy(jbdy)%lneed_dyn2d .AND. MOD(nn_dyn2d_dta(jbdy),2) == 1 ) & 377 & .OR. ( dta_bdy(jbdy)%lneed_dyn3d .AND. nn_dyn3d_dta(jbdy) == 1 ) & 378 & .OR. ( dta_bdy(jbdy)%lneed_tra .AND. nn_tra_dta(jbdy) == 1 ) & 379 & .OR. ( dta_bdy(jbdy)%lneed_ice .AND. nn_ice_dta(jbdy) == 1 ) ) THEN 380 ! WARNING: we don't do a rewind here, each bdy reads its own nambdy_dta block one after another 517 381 READ ( numnam_cfg, nambdy_dta, IOSTAT = ios, ERR = 902 ) 518 382 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nambdy_dta in configuration namelist', lwp ) 519 IF(lwm) WRITE( numond, nambdy_dta ) 520 521 cn_dir_array(jbdy) = cn_dir 522 ln_full_vel_array(jbdy) = ln_full_vel 523 524 nblen => idx_bdy(jbdy)%nblen 525 nblenrim => idx_bdy(jbdy)%nblenrim 526 dta => dta_bdy(jbdy) 527 dta%nread(2) = 0 528 529 ! Only read in necessary fields for this set. 530 ! Important that barotropic variables come first. 531 IF( nn_dyn2d_dta(jbdy) == 1 .or. nn_dyn2d_dta(jbdy) == 3 ) THEN 532 533 IF( dta%ll_ssh ) THEN 534 if(lwp) write(numout,*) '++++++ reading in ssh field' 535 jfld = jfld + 1 536 blf_i(jfld) = bn_ssh 537 ibdy(jfld) = jbdy 538 igrid(jfld) = 1 539 ilen1(jfld) = nblen(igrid(jfld)) 540 ilen3(jfld) = 1 541 dta%nread(2) = dta%nread(2) + 1 542 ENDIF 543 544 IF( dta%ll_u2d .and. .not. ln_full_vel_array(jbdy) ) THEN 545 if(lwp) write(numout,*) '++++++ reading in u2d field' 546 jfld = jfld + 1 547 blf_i(jfld) = bn_u2d 548 ibdy(jfld) = jbdy 549 igrid(jfld) = 2 550 ilen1(jfld) = nblen(igrid(jfld)) 551 ilen3(jfld) = 1 552 dta%nread(2) = dta%nread(2) + 1 553 ENDIF 554 555 IF( dta%ll_v2d .and. .not. ln_full_vel_array(jbdy) ) THEN 556 if(lwp) write(numout,*) '++++++ reading in v2d field' 557 jfld = jfld + 1 558 blf_i(jfld) = bn_v2d 559 ibdy(jfld) = jbdy 560 igrid(jfld) = 3 561 ilen1(jfld) = nblen(igrid(jfld)) 562 ilen3(jfld) = 1 563 dta%nread(2) = dta%nread(2) + 1 564 ENDIF 565 566 ENDIF 567 568 ! read 3D velocities if baroclinic velocities require OR if 569 ! barotropic velocities required and ln_full_vel set to .true. 570 IF( nn_dyn3d_dta(jbdy) == 1 .OR. & 571 & ( ln_full_vel_array(jbdy) .AND. ( nn_dyn2d_dta(jbdy) == 1 .OR. nn_dyn2d_dta(jbdy) == 3 ) ) ) THEN 572 573 IF( dta%ll_u3d .OR. ( ln_full_vel_array(jbdy) .and. dta%ll_u2d ) ) THEN 574 if(lwp) write(numout,*) '++++++ reading in u3d field' 575 jfld = jfld + 1 576 blf_i(jfld) = bn_u3d 577 ibdy(jfld) = jbdy 578 igrid(jfld) = 2 579 ilen1(jfld) = nblen(igrid(jfld)) 580 ilen3(jfld) = jpk 581 IF( ln_full_vel_array(jbdy) .and. dta%ll_u2d ) dta%nread(2) = dta%nread(2) + 1 582 ENDIF 583 584 IF( dta%ll_v3d .OR. ( ln_full_vel_array(jbdy) .and. dta%ll_v2d ) ) THEN 585 if(lwp) write(numout,*) '++++++ reading in v3d field' 586 jfld = jfld + 1 587 blf_i(jfld) = bn_v3d 588 ibdy(jfld) = jbdy 589 igrid(jfld) = 3 590 ilen1(jfld) = nblen(igrid(jfld)) 591 ilen3(jfld) = jpk 592 IF( ln_full_vel_array(jbdy) .and. dta%ll_v2d ) dta%nread(2) = dta%nread(2) + 1 593 ENDIF 594 595 ENDIF 596 597 ! temperature and salinity 598 IF( nn_tra_dta(jbdy) == 1 ) THEN 599 600 IF( dta%ll_tem ) THEN 601 if(lwp) write(numout,*) '++++++ reading in tem field' 602 jfld = jfld + 1 603 blf_i(jfld) = bn_tem 604 ibdy(jfld) = jbdy 605 igrid(jfld) = 1 606 ilen1(jfld) = nblen(igrid(jfld)) 607 ilen3(jfld) = jpk 608 ENDIF 609 610 IF( dta%ll_sal ) THEN 611 if(lwp) write(numout,*) '++++++ reading in sal field' 612 jfld = jfld + 1 613 blf_i(jfld) = bn_sal 614 ibdy(jfld) = jbdy 615 igrid(jfld) = 1 616 ilen1(jfld) = nblen(igrid(jfld)) 617 ilen3(jfld) = jpk 618 ENDIF 619 620 ENDIF 621 622 #if defined key_si3 623 ! sea ice 624 IF( nn_ice_dta(jbdy) == 1 ) THEN 625 ! Test for types of ice input (1cat or Xcat) 626 ! Build file name to find dimensions 627 clname=TRIM( cn_dir )//TRIM(bn_a_i%clname) 628 IF( .NOT. bn_a_i%ln_clim ) THEN 629 WRITE(clname, '(a,"_y",i4.4)' ) TRIM( clname ), nyear ! add year 630 IF( bn_a_i%cltype /= 'yearly' ) WRITE(clname, '(a,"m" ,i2.2)' ) TRIM( clname ), nmonth ! add month 631 ELSE 632 IF( bn_a_i%cltype /= 'yearly' ) WRITE(clname, '(a,"_m",i2.2)' ) TRIM( clname ), nmonth ! add month 633 ENDIF 634 IF( bn_a_i%cltype == 'daily' .OR. bn_a_i%cltype(1:4) == 'week' ) & 635 & WRITE(clname, '(a,"d" ,i2.2)' ) TRIM( clname ), nday ! add day 383 IF(lwm) WRITE( numond, nambdy_dta ) 384 ENDIF 385 386 ! get the number of ice categories in bdy data file (use a_i information to do this) 387 ipl = jpl ! default definition 388 IF( dta_bdy(jbdy)%lneed_ice ) THEN ! if we need ice bdy data 389 IF( nn_ice_dta(jbdy) == 1 ) THEN ! if we get ice bdy data from netcdf file 390 CALL fld_fill( bf(jp_bdya_i,jbdy:jbdy), bn_a_i, cn_dir, 'bdy_dta', 'a_i'//' '//ctmp1, ctmp2 ) ! use namelist info 391 CALL fld_clopn( bf(jp_bdya_i,jbdy), nyear, nmonth, nday ) ! not a problem when we call it again after 392 idvar = iom_varid( bf(jp_bdya_i,jbdy)%num, bf(jp_bdya_i,jbdy)%clvar, kndims=indims, kdimsz=i4dimsz, lduld=lluld ) 393 IF( indims == 4 .OR. ( indims == 3 .AND. .NOT. lluld ) ) THEN ; ipl = i4dimsz(3) ! xylt or xyl 394 ELSE ; ipl = 1 ! xy or xyt 395 ENDIF 396 ENDIF 397 ENDIF 398 399 DO jfld = 1, jpbdyfld 400 401 ! ===================== 402 ! ssh 403 ! ===================== 404 IF( jfld == jp_bdyssh ) THEN 405 cl3 = 'ssh' 406 igrd = 1 ! T point 407 ipk = 1 ! surface data 408 llneed = dta_bdy(jbdy)%lneed_ssh ! dta_bdy(jbdy)%ssh will be needed 409 llread = MOD(nn_dyn2d_dta(jbdy),2) == 1 ! get data from NetCDF file 410 bf_alias => bf(jp_bdyssh,jbdy:jbdy) ! alias for ssh structure of bdy number jbdy 411 bn_alias => bn_ssh ! alias for ssh structure of nambdy_dta 412 ENDIF 413 ! ===================== 414 ! dyn2d 415 ! ===================== 416 IF( jfld == jp_bdyu2d ) THEN 417 cl3 = 'u2d' 418 igrd = 2 ! U point 419 ipk = 1 ! surface data 420 llneed = dta_bdy(jbdy)%lneed_dyn2d ! dta_bdy(jbdy)%ssh will be needed 421 llread = .NOT. ln_full_vel .AND. MOD(nn_dyn2d_dta(jbdy),2) == 1 ! don't get u2d from u3d and read NetCDF file 422 bf_alias => bf(jp_bdyu2d,jbdy:jbdy) ! alias for u2d structure of bdy number jbdy 423 bn_alias => bn_u2d ! alias for u2d structure of nambdy_dta 424 ENDIF 425 IF( jfld == jp_bdyv2d ) THEN 426 cl3 = 'v2d' 427 igrd = 3 ! V point 428 ipk = 1 ! surface data 429 llneed = dta_bdy(jbdy)%lneed_dyn2d ! dta_bdy(jbdy)%ssh will be needed 430 llread = .NOT. ln_full_vel .AND. MOD(nn_dyn2d_dta(jbdy),2) == 1 ! don't get v2d from v3d and read NetCDF file 431 bf_alias => bf(jp_bdyv2d,jbdy:jbdy) ! alias for v2d structure of bdy number jbdy 432 bn_alias => bn_v2d ! alias for v2d structure of nambdy_dta 433 ENDIF 434 ! ===================== 435 ! dyn3d 436 ! ===================== 437 IF( jfld == jp_bdyu3d ) THEN 438 cl3 = 'u3d' 439 igrd = 2 ! U point 440 ipk = jpk ! 3d data 441 llneed = dta_bdy(jbdy)%lneed_dyn3d .OR. & ! dta_bdy(jbdy)%u3d will be needed 442 & ( dta_bdy(jbdy)%lneed_dyn2d .AND. ln_full_vel ) ! u3d needed to compute u2d 443 llread = nn_dyn3d_dta(jbdy) == 1 ! get data from NetCDF file 444 bf_alias => bf(jp_bdyu3d,jbdy:jbdy) ! alias for u3d structure of bdy number jbdy 445 bn_alias => bn_u3d ! alias for u3d structure of nambdy_dta 446 ENDIF 447 IF( jfld == jp_bdyv3d ) THEN 448 cl3 = 'v3d' 449 igrd = 3 ! V point 450 ipk = jpk ! 3d data 451 llneed = dta_bdy(jbdy)%lneed_dyn3d .OR. & ! dta_bdy(jbdy)%v3d will be needed 452 & ( dta_bdy(jbdy)%lneed_dyn2d .AND. ln_full_vel ) ! v3d needed to compute v2d 453 llread = nn_dyn3d_dta(jbdy) == 1 ! get data from NetCDF file 454 bf_alias => bf(jp_bdyv3d,jbdy:jbdy) ! alias for v3d structure of bdy number jbdy 455 bn_alias => bn_v3d ! alias for v3d structure of nambdy_dta 456 ENDIF 457 458 ! ===================== 459 ! tra 460 ! ===================== 461 IF( jfld == jp_bdytem ) THEN 462 cl3 = 'tem' 463 igrd = 1 ! T point 464 ipk = jpk ! 3d data 465 llneed = dta_bdy(jbdy)%lneed_tra ! dta_bdy(jbdy)%tem will be needed 466 llread = nn_tra_dta(jbdy) == 1 ! get data from NetCDF file 467 bf_alias => bf(jp_bdytem,jbdy:jbdy) ! alias for ssh structure of bdy number jbdy 468 bn_alias => bn_tem ! alias for ssh structure of nambdy_dta 469 ENDIF 470 IF( jfld == jp_bdysal ) THEN 471 cl3 = 'sal' 472 igrd = 1 ! T point 473 ipk = jpk ! 3d data 474 llneed = dta_bdy(jbdy)%lneed_tra ! dta_bdy(jbdy)%sal will be needed 475 llread = nn_tra_dta(jbdy) == 1 ! get data from NetCDF file 476 bf_alias => bf(jp_bdysal,jbdy:jbdy) ! alias for ssh structure of bdy number jbdy 477 bn_alias => bn_sal ! alias for ssh structure of nambdy_dta 478 ENDIF 479 480 ! ===================== 481 ! ice 482 ! ===================== 483 IF( jfld == jp_bdya_i ) THEN 484 cl3 = 'a_i' 485 igrd = 1 ! T point 486 ipk = ipl ! 487 llneed = dta_bdy(jbdy)%lneed_ice ! dta_bdy(jbdy)%a_i will be needed 488 llread = nn_ice_dta(jbdy) == 1 ! get data from NetCDF file 489 bf_alias => bf(jp_bdya_i,jbdy:jbdy) ! alias for ssh structure of bdy number jbdy 490 bn_alias => bn_a_i ! alias for ssh structure of nambdy_dta 491 ENDIF 492 IF( jfld == jp_bdyh_i ) THEN 493 cl3 = 'h_i' 494 igrd = 1 ! T point 495 ipk = ipl ! 496 llneed = dta_bdy(jbdy)%lneed_ice ! dta_bdy(jbdy)%h_i will be needed 497 llread = nn_ice_dta(jbdy) == 1 ! get data from NetCDF file 498 bf_alias => bf(jp_bdyh_i,jbdy:jbdy) ! alias for ssh structure of bdy number jbdy 499 bn_alias => bn_h_i ! alias for ssh structure of nambdy_dta 500 ENDIF 501 IF( jfld == jp_bdyh_s ) THEN 502 cl3 = 'h_s' 503 igrd = 1 ! T point 504 ipk = ipl ! 505 llneed = dta_bdy(jbdy)%lneed_ice ! dta_bdy(jbdy)%h_s will be needed 506 llread = nn_ice_dta(jbdy) == 1 ! get data from NetCDF file 507 bf_alias => bf(jp_bdyh_s,jbdy:jbdy) ! alias for ssh structure of bdy number jbdy 508 bn_alias => bn_h_s ! alias for ssh structure of nambdy_dta 509 ENDIF 510 511 512 IF( llneed ) THEN ! dta_bdy(jbdy)%xxx will be needed 513 ! ! -> must be associated with an allocated target 514 iszdim = idx_bdy(jbdy)%nblen(igrd) ! length of this bdy on this MPI processus 515 ALLOCATE( bf_alias(1)%fnow( iszdim, 1, ipk ) ) ! allocate the target 636 516 ! 637 CALL iom_open ( clname, inum ) 638 id1 = iom_varid( inum, bn_a_i%clvar, kdimsz=kdimsz, kndims=kndims, ldstop = .FALSE. ) 639 CALL iom_close ( inum ) 640 641 IF ( kndims == 4 ) THEN 642 nice_cat = kdimsz(4) ! Xcat input 643 ELSE 644 nice_cat = 1 ! 1cat input 645 ENDIF 646 ! End test 647 648 IF( dta%ll_a_i ) THEN 649 jfld = jfld + 1 650 blf_i(jfld) = bn_a_i 651 ibdy(jfld) = jbdy 652 igrid(jfld) = 1 653 ilen1(jfld) = nblen(igrid(jfld)) 654 ilen3(jfld) = nice_cat 655 ENDIF 656 657 IF( dta%ll_h_i ) THEN 658 jfld = jfld + 1 659 blf_i(jfld) = bn_h_i 660 ibdy(jfld) = jbdy 661 igrid(jfld) = 1 662 ilen1(jfld) = nblen(igrid(jfld)) 663 ilen3(jfld) = nice_cat 664 ENDIF 665 666 IF( dta%ll_h_s ) THEN 667 jfld = jfld + 1 668 blf_i(jfld) = bn_h_s 669 ibdy(jfld) = jbdy 670 igrid(jfld) = 1 671 ilen1(jfld) = nblen(igrid(jfld)) 672 ilen3(jfld) = nice_cat 673 ENDIF 674 675 ENDIF 676 #endif 677 ! Recalculate field counts 678 !------------------------- 679 IF( jbdy == 1 ) THEN 680 nb_bdy_fld_sum = 0 681 nb_bdy_fld(jbdy) = jfld 682 nb_bdy_fld_sum = jfld 683 ELSE 684 nb_bdy_fld(jbdy) = jfld - nb_bdy_fld_sum 685 nb_bdy_fld_sum = nb_bdy_fld_sum + nb_bdy_fld(jbdy) 686 ENDIF 687 688 dta%nread(1) = nb_bdy_fld(jbdy) 689 690 ENDIF ! nn_dta == 1 691 ENDDO ! jbdy 692 693 DO jfld = 1, nb_bdy_fld_sum 694 ALLOCATE( bf(jfld)%fnow(ilen1(jfld),1,ilen3(jfld)) ) 695 IF( blf_i(jfld)%ln_tint ) ALLOCATE( bf(jfld)%fdta(ilen1(jfld),1,ilen3(jfld),2) ) 696 nbmap_ptr(jfld)%ptr => idx_bdy(ibdy(jfld))%nbmap(:,igrid(jfld)) 697 nbmap_ptr(jfld)%ll_unstruc = ln_coords_file(ibdy(jfld)) 698 ENDDO 699 700 ! fill bf with blf_i and control print 701 !------------------------------------- 702 jstart = 1 703 DO jbdy = 1, nb_bdy 704 jend = jstart - 1 + nb_bdy_fld(jbdy) 705 CALL fld_fill( bf(jstart:jend), blf_i(jstart:jend), cn_dir_array(jbdy), 'bdy_dta', & 706 & 'open boundary conditions', 'nambdy_dta' ) 707 jstart = jend + 1 708 ENDDO 709 710 DO jfld = 1, nb_bdy_fld_sum 711 bf(jfld)%igrd = igrid(jfld) 712 bf(jfld)%ibdy = ibdy(jfld) 713 ENDDO 714 715 ! Initialise local boundary data arrays 716 ! nn_xxx_dta=0 : allocate space - will be filled from initial conditions later 717 ! nn_xxx_dta=1 : point to "fnow" arrays 718 !------------------------------------- 719 720 jfld = 0 721 DO jbdy=1, nb_bdy 722 723 nblen => idx_bdy(jbdy)%nblen 724 dta => dta_bdy(jbdy) 725 726 if(lwp) then 727 write(numout,*) '++++++ dta%ll_ssh = ',dta%ll_ssh 728 write(numout,*) '++++++ dta%ll_u2d = ',dta%ll_u2d 729 write(numout,*) '++++++ dta%ll_v2d = ',dta%ll_v2d 730 write(numout,*) '++++++ dta%ll_u3d = ',dta%ll_u3d 731 write(numout,*) '++++++ dta%ll_v3d = ',dta%ll_v3d 732 write(numout,*) '++++++ dta%ll_tem = ',dta%ll_tem 733 write(numout,*) '++++++ dta%ll_sal = ',dta%ll_sal 734 endif 735 736 IF ( nn_dyn2d_dta(jbdy) == 0 .or. nn_dyn2d_dta(jbdy) == 2 ) THEN 737 if(lwp) write(numout,*) '++++++ dta%ssh/u2d/u3d allocated space' 738 IF( dta%ll_ssh ) ALLOCATE( dta%ssh(nblen(1)) ) 739 IF( dta%ll_u2d ) ALLOCATE( dta%u2d(nblen(2)) ) 740 IF( dta%ll_v2d ) ALLOCATE( dta%v2d(nblen(3)) ) 741 ENDIF 742 IF ( nn_dyn2d_dta(jbdy) == 1 .or. nn_dyn2d_dta(jbdy) == 3 ) THEN 743 IF( dta%ll_ssh ) THEN 744 if(lwp) write(numout,*) '++++++ dta%ssh pointing to fnow' 745 jfld = jfld + 1 746 dta%ssh => bf(jfld)%fnow(:,1,1) 747 ENDIF 748 IF ( dta%ll_u2d ) THEN 749 IF ( ln_full_vel_array(jbdy) ) THEN 750 if(lwp) write(numout,*) '++++++ dta%u2d allocated space' 751 ALLOCATE( dta%u2d(nblen(2)) ) 752 ELSE 753 if(lwp) write(numout,*) '++++++ dta%u2d pointing to fnow' 754 jfld = jfld + 1 755 dta%u2d => bf(jfld)%fnow(:,1,1) 756 ENDIF 757 ENDIF 758 IF ( dta%ll_v2d ) THEN 759 IF ( ln_full_vel_array(jbdy) ) THEN 760 if(lwp) write(numout,*) '++++++ dta%v2d allocated space' 761 ALLOCATE( dta%v2d(nblen(3)) ) 762 ELSE 763 if(lwp) write(numout,*) '++++++ dta%v2d pointing to fnow' 764 jfld = jfld + 1 765 dta%v2d => bf(jfld)%fnow(:,1,1) 766 ENDIF 767 ENDIF 768 ENDIF 769 770 IF ( nn_dyn3d_dta(jbdy) == 0 ) THEN 771 if(lwp) write(numout,*) '++++++ dta%u3d/v3d allocated space' 772 IF( dta%ll_u3d ) ALLOCATE( dta_bdy(jbdy)%u3d(nblen(2),jpk) ) 773 IF( dta%ll_v3d ) ALLOCATE( dta_bdy(jbdy)%v3d(nblen(3),jpk) ) 774 ENDIF 775 IF ( nn_dyn3d_dta(jbdy) == 1 .or. & 776 & ( ln_full_vel_array(jbdy) .and. ( nn_dyn2d_dta(jbdy) == 1 .or. nn_dyn2d_dta(jbdy) == 3 ) ) ) THEN 777 IF ( dta%ll_u3d .or. ( ln_full_vel_array(jbdy) .and. dta%ll_u2d ) ) THEN 778 if(lwp) write(numout,*) '++++++ dta%u3d pointing to fnow' 779 jfld = jfld + 1 780 dta_bdy(jbdy)%u3d => bf(jfld)%fnow(:,1,:) 781 ENDIF 782 IF ( dta%ll_v3d .or. ( ln_full_vel_array(jbdy) .and. dta%ll_v2d ) ) THEN 783 if(lwp) write(numout,*) '++++++ dta%v3d pointing to fnow' 784 jfld = jfld + 1 785 dta_bdy(jbdy)%v3d => bf(jfld)%fnow(:,1,:) 786 ENDIF 787 ENDIF 788 789 IF( nn_tra_dta(jbdy) == 0 ) THEN 790 if(lwp) write(numout,*) '++++++ dta%tem/sal allocated space' 791 IF( dta%ll_tem ) ALLOCATE( dta_bdy(jbdy)%tem(nblen(1),jpk) ) 792 IF( dta%ll_sal ) ALLOCATE( dta_bdy(jbdy)%sal(nblen(1),jpk) ) 793 ELSE 794 IF( dta%ll_tem ) THEN 795 if(lwp) write(numout,*) '++++++ dta%tem pointing to fnow' 796 jfld = jfld + 1 797 dta_bdy(jbdy)%tem => bf(jfld)%fnow(:,1,:) 798 ENDIF 799 IF( dta%ll_sal ) THEN 800 if(lwp) write(numout,*) '++++++ dta%sal pointing to fnow' 801 jfld = jfld + 1 802 dta_bdy(jbdy)%sal => bf(jfld)%fnow(:,1,:) 803 ENDIF 804 ENDIF 805 806 #if defined key_si3 807 IF (cn_ice(jbdy) /= 'none') THEN 808 IF( nn_ice_dta(jbdy) == 0 ) THEN 809 ALLOCATE( dta_bdy(jbdy)%a_i(nblen(1),jpl) ) 810 ALLOCATE( dta_bdy(jbdy)%h_i(nblen(1),jpl) ) 811 ALLOCATE( dta_bdy(jbdy)%h_s(nblen(1),jpl) ) 812 ELSE 813 IF ( nice_cat == jpl ) THEN ! case input cat = jpl 814 jfld = jfld + 1 815 dta_bdy(jbdy)%a_i => bf(jfld)%fnow(:,1,:) 816 jfld = jfld + 1 817 dta_bdy(jbdy)%h_i => bf(jfld)%fnow(:,1,:) 818 jfld = jfld + 1 819 dta_bdy(jbdy)%h_s => bf(jfld)%fnow(:,1,:) 820 ELSE ! case input cat = 1 OR (/=1 and /=jpl) 821 jfld_ait(jbdy) = jfld + 1 822 jfld_htit(jbdy) = jfld + 2 823 jfld_htst(jbdy) = jfld + 3 824 jfld = jfld + 3 825 ALLOCATE( dta_bdy(jbdy)%a_i(nblen(1),jpl) ) 826 ALLOCATE( dta_bdy(jbdy)%h_i(nblen(1),jpl) ) 827 ALLOCATE( dta_bdy(jbdy)%h_s(nblen(1),jpl) ) 828 dta_bdy(jbdy)%a_i(:,:) = 0._wp 829 dta_bdy(jbdy)%h_i(:,:) = 0._wp 830 dta_bdy(jbdy)%h_s(:,:) = 0._wp 831 ENDIF 832 833 ENDIF 834 ENDIF 835 #endif 517 IF( llread ) THEN ! get data from NetCDF file 518 CALL fld_fill( bf_alias, bn_alias, cn_dir, 'bdy_dta', cl3//' '//ctmp1, ctmp2 ) ! use namelist info 519 IF( bf_alias(1)%ln_tint ) ALLOCATE( bf_alias(1)%fdta( iszdim, 1, ipk, 2 ) ) 520 bf_alias(1)%imap => idx_bdy(jbdy)%nbmap(1:iszdim,igrd) ! associate the mapping used for this bdy 521 bf_alias(1)%igrd = igrd ! used only for vertical integration of 3D arrays 522 bf_alias(1)%ltotvel = ln_full_vel ! T if u3d is full velocity 523 ENDIF 524 525 ! associate the pointer and get rid of the dimensions with a size equal to 1 526 IF( jfld == jp_bdyssh ) dta_bdy(jbdy)%ssh => bf_alias(1)%fnow(:,1,1) 527 IF( jfld == jp_bdyu2d ) dta_bdy(jbdy)%u2d => bf_alias(1)%fnow(:,1,1) 528 IF( jfld == jp_bdyv2d ) dta_bdy(jbdy)%v2d => bf_alias(1)%fnow(:,1,1) 529 IF( jfld == jp_bdyu3d ) dta_bdy(jbdy)%u3d => bf_alias(1)%fnow(:,1,:) 530 IF( jfld == jp_bdyv3d ) dta_bdy(jbdy)%v3d => bf_alias(1)%fnow(:,1,:) 531 IF( jfld == jp_bdytem ) dta_bdy(jbdy)%tem => bf_alias(1)%fnow(:,1,:) 532 IF( jfld == jp_bdysal ) dta_bdy(jbdy)%sal => bf_alias(1)%fnow(:,1,:) 533 IF( jfld == jp_bdya_i ) THEN 534 IF( ipk == jpl ) THEN ; dta_bdy(jbdy)%a_i => bf_alias(1)%fnow(:,1,:) 535 ELSE ; ALLOCATE( dta_bdy(jbdy)%a_i(iszdim,jpl) ) 536 ENDIF 537 ENDIF 538 IF( jfld == jp_bdyh_i ) THEN 539 IF( ipk == jpl ) THEN ; dta_bdy(jbdy)%h_i => bf_alias(1)%fnow(:,1,:) 540 ELSE ; ALLOCATE( dta_bdy(jbdy)%h_i(iszdim,jpl) ) 541 ENDIF 542 ENDIF 543 IF( jfld == jp_bdyh_s ) THEN 544 IF( ipk == jpl ) THEN ; dta_bdy(jbdy)%h_s => bf_alias(1)%fnow(:,1,:) 545 ELSE ; ALLOCATE( dta_bdy(jbdy)%h_s(iszdim,jpl) ) 546 ENDIF 547 ENDIF 548 ENDIF 549 550 END DO ! jpbdyfld 836 551 ! 837 552 END DO ! jbdy 838 553 ! 839 554 END SUBROUTINE bdy_dta_init 840 555 841 556 !!============================================================================== 842 557 END MODULE bdydta
Note: See TracChangeset
for help on using the changeset viewer.
