Changeset 11831 for NEMO/branches/2019/dev_r11085_ASINTER-05_Brodeau_Advanced_Bulk/src/OCE/BDY/bdydta.F90
- Timestamp:
- 2019-10-29T18:14:49+01:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11085_ASINTER-05_Brodeau_Advanced_Bulk/src/OCE/BDY/bdydta.F90
r10951 r11831 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 = 16 ! 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 INTEGER , PARAMETER :: jp_bdyt_i = 11 ! 57 INTEGER , PARAMETER :: jp_bdyt_s = 12 ! 58 INTEGER , PARAMETER :: jp_bdytsu = 13 ! 59 INTEGER , PARAMETER :: jp_bdys_i = 14 ! 60 INTEGER , PARAMETER :: jp_bdyaip = 15 ! 61 INTEGER , PARAMETER :: jp_bdyhip = 16 ! 62 #if ! defined key_si3 63 INTEGER , PARAMETER :: jpl = 1 64 #endif 65 49 66 !$AGRIF_DO_NOT_TREAT 50 TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(: ), TARGET :: bf! structure of input fields (file informations, fields read)67 TYPE(FLD), PUBLIC, ALLOCATABLE, DIMENSION(:,:), TARGET :: bf ! structure of input fields (file informations, fields read) 51 68 !$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 69 60 70 !!---------------------------------------------------------------------- … … 65 75 CONTAINS 66 76 67 SUBROUTINE bdy_dta( kt, jit, time_offset )77 SUBROUTINE bdy_dta( kt, kit, kt_offset ) 68 78 !!---------------------------------------------------------------------- 69 79 !! *** SUBROUTINE bdy_dta *** … … 75 85 !!---------------------------------------------------------------------- 76 86 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 jit87 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 79 89 ! ! 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 level90 ! ! 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 83 93 ! ! etc. 84 94 ! 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 95 INTEGER :: jbdy, jfld, jstart, jend, ib, jl ! dummy loop indices 96 INTEGER :: ii, ij, ik, igrd, ipl ! local integers 97 INTEGER, DIMENSION(jpbgrd) :: ilen1 98 INTEGER, DIMENSION(:), POINTER :: nblen, nblenrim ! short cuts 99 TYPE(OBC_DATA) , POINTER :: dta_alias ! short cut 100 TYPE(FLD), DIMENSION(:), POINTER :: bf_alias 90 101 !!--------------------------------------------------------------------------- 91 102 ! … … 94 105 ! Initialise data arrays once for all from initial conditions where required 95 106 !--------------------------------------------------------------------------- 96 IF( kt == nit000 .AND. .NOT.PRESENT( jit) ) THEN107 IF( kt == nit000 .AND. .NOT.PRESENT(kit) ) THEN 97 108 98 109 ! Calculate depth-mean currents 99 110 !----------------------------- 100 111 101 112 DO jbdy = 1, nb_bdy 102 113 ! 103 114 nblen => idx_bdy(jbdy)%nblen 104 115 nblenrim => idx_bdy(jbdy)%nblenrim 105 dta => dta_bdy(jbdy)106 116 ! 107 117 IF( nn_dyn2d_dta(jbdy) == 0 ) THEN 108 118 ilen1(:) = nblen(:) 109 IF( dta %ll_ssh ) THEN119 IF( dta_bdy(jbdy)%lneed_ssh ) THEN 110 120 igrd = 1 111 121 DO ib = 1, ilen1(igrd) … … 113 123 ij = idx_bdy(jbdy)%nbj(ib,igrd) 114 124 dta_bdy(jbdy)%ssh(ib) = sshn(ii,ij) * tmask(ii,ij,1) 115 END DO 116 ENDIF 117 IF( dta %ll_u2d) THEN125 END DO 126 ENDIF 127 IF( dta_bdy(jbdy)%lneed_dyn2d) THEN 118 128 igrd = 2 119 129 DO ib = 1, ilen1(igrd) … … 121 131 ij = idx_bdy(jbdy)%nbj(ib,igrd) 122 132 dta_bdy(jbdy)%u2d(ib) = un_b(ii,ij) * umask(ii,ij,1) 123 END DO 124 ENDIF 125 IF( dta%ll_v2d ) THEN 133 END DO 126 134 igrd = 3 127 135 DO ib = 1, ilen1(igrd) … … 129 137 ij = idx_bdy(jbdy)%nbj(ib,igrd) 130 138 dta_bdy(jbdy)%v2d(ib) = vn_b(ii,ij) * vmask(ii,ij,1) 131 END DO 139 END DO 132 140 ENDIF 133 141 ENDIF … … 135 143 IF( nn_dyn3d_dta(jbdy) == 0 ) THEN 136 144 ilen1(:) = nblen(:) 137 IF( dta %ll_u3d ) THEN145 IF( dta_bdy(jbdy)%lneed_dyn3d ) THEN 138 146 igrd = 2 139 147 DO ib = 1, ilen1(igrd) … … 143 151 dta_bdy(jbdy)%u3d(ib,ik) = ( un(ii,ij,ik) - un_b(ii,ij) ) * umask(ii,ij,ik) 144 152 END DO 145 END DO 146 ENDIF 147 IF( dta%ll_v3d ) THEN 153 END DO 148 154 igrd = 3 149 155 DO ib = 1, ilen1(igrd) … … 152 158 ij = idx_bdy(jbdy)%nbj(ib,igrd) 153 159 dta_bdy(jbdy)%v3d(ib,ik) = ( vn(ii,ij,ik) - vn_b(ii,ij) ) * vmask(ii,ij,ik) 154 155 END DO 160 END DO 161 END DO 156 162 ENDIF 157 163 ENDIF … … 159 165 IF( nn_tra_dta(jbdy) == 0 ) THEN 160 166 ilen1(:) = nblen(:) 161 IF( dta %ll_tem) THEN167 IF( dta_bdy(jbdy)%lneed_tra ) THEN 162 168 igrd = 1 163 169 DO ib = 1, ilen1(igrd) … … 165 171 ii = idx_bdy(jbdy)%nbi(ib,igrd) 166 172 ij = idx_bdy(jbdy)%nbj(ib,igrd) 167 dta_bdy(jbdy)%tem(ib,ik) = tsn(ii,ij,ik,jp_tem) * tmask(ii,ij,ik) 173 dta_bdy(jbdy)%tem(ib,ik) = tsn(ii,ij,ik,jp_bdytem) * tmask(ii,ij,ik) 174 dta_bdy(jbdy)%sal(ib,ik) = tsn(ii,ij,ik,jp_bdysal) * tmask(ii,ij,ik) 168 175 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 176 END DO 180 177 ENDIF 181 178 ENDIF … … 184 181 IF( nn_ice_dta(jbdy) == 0 ) THEN ! set ice to initial values 185 182 ilen1(:) = nblen(:) 186 IF( dta %ll_a_i) THEN183 IF( dta_bdy(jbdy)%lneed_ice ) THEN 187 184 igrd = 1 188 185 DO jl = 1, jpl … … 190 187 ii = idx_bdy(jbdy)%nbi(ib,igrd) 191 188 ij = idx_bdy(jbdy)%nbj(ib,igrd) 192 dta_bdy(jbdy)%a_i (ib,jl) = a_i(ii,ij,jl) * tmask(ii,ij,1) 193 END DO 194 END DO 195 ENDIF 196 IF( dta%ll_h_i ) THEN 197 igrd = 1 198 DO jl = 1, jpl 199 DO ib = 1, ilen1(igrd) 200 ii = idx_bdy(jbdy)%nbi(ib,igrd) 201 ij = idx_bdy(jbdy)%nbj(ib,igrd) 202 dta_bdy(jbdy)%h_i (ib,jl) = h_i(ii,ij,jl) * tmask(ii,ij,1) 203 END DO 204 END DO 205 ENDIF 206 IF( dta%ll_h_s ) THEN 207 igrd = 1 208 DO jl = 1, jpl 209 DO ib = 1, ilen1(igrd) 210 ii = idx_bdy(jbdy)%nbi(ib,igrd) 211 ij = idx_bdy(jbdy)%nbj(ib,igrd) 212 dta_bdy(jbdy)%h_s (ib,jl) = h_s(ii,ij,jl) * tmask(ii,ij,1) 189 dta_bdy(jbdy)%a_i(ib,jl) = a_i (ii,ij,jl) * tmask(ii,ij,1) 190 dta_bdy(jbdy)%h_i(ib,jl) = h_i (ii,ij,jl) * tmask(ii,ij,1) 191 dta_bdy(jbdy)%h_s(ib,jl) = h_s (ii,ij,jl) * tmask(ii,ij,1) 192 dta_bdy(jbdy)%t_i(ib,jl) = SUM(t_i (ii,ij,:,jl)) * r1_nlay_i * tmask(ii,ij,1) 193 dta_bdy(jbdy)%t_s(ib,jl) = SUM(t_s (ii,ij,:,jl)) * r1_nlay_s * tmask(ii,ij,1) 194 dta_bdy(jbdy)%tsu(ib,jl) = t_su(ii,ij,jl) * tmask(ii,ij,1) 195 dta_bdy(jbdy)%s_i(ib,jl) = s_i (ii,ij,jl) * tmask(ii,ij,1) 196 ! melt ponds 197 dta_bdy(jbdy)%aip(ib,jl) = a_ip(ii,ij,jl) * tmask(ii,ij,1) 198 dta_bdy(jbdy)%hip(ib,jl) = h_ip(ii,ij,jl) * tmask(ii,ij,1) 213 199 END DO 214 200 END DO … … 222 208 ! update external data from files 223 209 !-------------------------------- 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 210 211 DO jbdy = 1, nb_bdy 212 213 dta_alias => dta_bdy(jbdy) 214 bf_alias => bf(:,jbdy) 215 216 ! read/update all bdy data 217 ! ------------------------ 218 CALL fld_read( kt, 1, bf_alias, kit = kit, kt_offset = kt_offset ) 219 220 ! apply some corrections in some specific cases... 221 ! -------------------------------------------------- 222 ! 223 ! 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/v2d 225 ! 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 238 ENDIF 239 240 ! tidal harmonic forcing ONLY: initialise arrays 241 IF( nn_dyn2d_dta(jbdy) == 2 ) THEN ! we did not read ssh, u/v2d 242 IF( dta_alias%lneed_ssh ) dta_alias%ssh(:) = 0._wp 243 IF( dta_alias%lneed_dyn2d ) dta_alias%u2d(:) = 0._wp 244 IF( dta_alias%lneed_dyn2d ) dta_alias%v2d(:) = 0._wp 245 ENDIF 246 247 ! If full velocities in boundary data, then split it into barotropic and baroclinic component 248 IF( bf_alias(jp_bdyu3d)%ltotvel ) THEN ! if we read 3D total velocity (can be true only if u3d was read) 249 ! 250 igrd = 2 ! zonal velocity 251 dta_alias%u2d(:) = 0._wp ! compute barotrope zonal velocity and put it in u2d 252 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 253 ii = idx_bdy(jbdy)%nbi(ib,igrd) 254 ij = idx_bdy(jbdy)%nbj(ib,igrd) 255 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) 257 END DO 258 dta_alias%u2d(ib) = dta_alias%u2d(ib) * r1_hu_n(ii,ij) 259 DO ik = 1, jpkm1 ! compute barocline zonal velocity and put it in u3d 260 dta_alias%u3d(ib,ik) = dta_alias%u3d(ib,ik) - dta_alias%u2d(ib) 261 END DO 262 END DO 263 igrd = 3 ! meridional velocity 264 dta_alias%v2d(:) = 0._wp ! compute barotrope meridional velocity and put it in v2d 265 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 266 ii = idx_bdy(jbdy)%nbi(ib,igrd) 267 ij = idx_bdy(jbdy)%nbj(ib,igrd) 268 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) 270 END DO 271 dta_alias%v2d(ib) = dta_alias%v2d(ib) * r1_hv_n(ii,ij) 272 DO ik = 1, jpkm1 ! compute barocline meridional velocity and put it in v3d 273 dta_alias%v3d(ib,ik) = dta_alias%v3d(ib,ik) - dta_alias%v2d(ib) 274 END DO 275 END DO 276 ENDIF ! ltotvel 277 278 ! update tidal harmonic forcing 279 IF( PRESENT(kit) .AND. nn_dyn2d_dta(jbdy) .GE. 2 ) THEN 280 CALL bdytide_update( kt = kt, idx = idx_bdy(jbdy), dta = dta_alias, td = tides(jbdy), & 281 & kit = kit, kt_offset = kt_offset ) 282 ENDIF 283 284 ! atm surface pressure : add inverted barometer effect to ssh if it was read 285 IF ( ln_apr_obc .AND. TRIM(bf_alias(jp_bdyssh)%clrootname) /= 'NOT USED' ) THEN 286 igrd = 1 287 DO ib = 1, idx_bdy(jbdy)%nblenrim(igrd) ! ssh is used only on the rim 288 ii = idx_bdy(jbdy)%nbi(ib,igrd) 289 ij = idx_bdy(jbdy)%nbj(ib,igrd) 290 dta_alias%ssh(ib) = dta_alias%ssh(ib) + ssh_ib(ii,ij) 291 END DO 292 ENDIF 293 353 294 #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 295 IF( dta_alias%lneed_ice ) THEN 296 ! fill temperature and salinity arrays 297 IF( TRIM(bf_alias(jp_bdyt_i)%clrootname) == 'NOT USED' ) bf_alias(jp_bdyt_i)%fnow(:,1,:) = rice_tem (jbdy) 298 IF( TRIM(bf_alias(jp_bdyt_s)%clrootname) == 'NOT USED' ) bf_alias(jp_bdyt_s)%fnow(:,1,:) = rice_tem (jbdy) 299 IF( TRIM(bf_alias(jp_bdytsu)%clrootname) == 'NOT USED' ) bf_alias(jp_bdytsu)%fnow(:,1,:) = rice_tem (jbdy) 300 IF( TRIM(bf_alias(jp_bdys_i)%clrootname) == 'NOT USED' ) bf_alias(jp_bdys_i)%fnow(:,1,:) = rice_sal (jbdy) 301 IF( TRIM(bf_alias(jp_bdyaip)%clrootname) == 'NOT USED' ) bf_alias(jp_bdyaip)%fnow(:,1,:) = rice_apnd(jbdy) * & ! rice_apnd is the pond fraction 302 & bf_alias(jp_bdya_i)%fnow(:,1,:) ! ( a_ip = rice_apnd * a_i ) 303 IF( TRIM(bf_alias(jp_bdyhip)%clrootname) == 'NOT USED' ) bf_alias(jp_bdyhip)%fnow(:,1,:) = rice_hpnd(jbdy) 304 ! if T_su is read and not T_i, set T_i = (T_su + T_freeze)/2 305 IF( TRIM(bf_alias(jp_bdytsu)%clrootname) /= 'NOT USED' .AND. TRIM(bf_alias(jp_bdyt_i)%clrootname) == 'NOT USED' ) & 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_su 308 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_s 311 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 ! if T_s is read and not T_i, set T_i = (T_s + T_freeze)/2 314 IF( TRIM(bf_alias(jp_bdyt_s)%clrootname) /= 'NOT USED' .AND. TRIM(bf_alias(jp_bdyt_i)%clrootname) == 'NOT USED' ) & 315 & bf_alias(jp_bdyt_i)%fnow(:,1,:) = 0.5_wp * ( bf_alias(jp_bdyt_s)%fnow(:,1,:) + 271.15 ) 316 317 ! make sure ponds = 0 if no ponds scheme 318 IF ( .NOT.ln_pnd ) THEN 319 bf_alias(jp_bdyaip)%fnow(:,1,:) = 0._wp 320 bf_alias(jp_bdyhip)%fnow(:,1,:) = 0._wp 321 ENDIF 322 323 ! convert N-cat fields (input) into jpl-cat (output) 324 ipl = SIZE(bf_alias(jp_bdya_i)%fnow, 3) 325 IF( ipl /= jpl ) THEN ! ice: convert N-cat fields (input) into jpl-cat (output) 326 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,:), & 327 & dta_alias%h_i , dta_alias%h_s , dta_alias%a_i , & 328 & bf_alias(jp_bdyt_i)%fnow(:,1,:), bf_alias(jp_bdyt_s)%fnow(:,1,:), & 329 & bf_alias(jp_bdytsu)%fnow(:,1,:), bf_alias(jp_bdys_i)%fnow(:,1,:), & 330 & bf_alias(jp_bdyaip)%fnow(:,1,:), bf_alias(jp_bdyhip)%fnow(:,1,:), & 331 & dta_alias%t_i , dta_alias%t_s , & 332 & dta_alias%tsu , dta_alias%s_i , & 333 & dta_alias%aip , dta_alias%hip ) 334 ENDIF 335 ENDIF 367 336 #endif 368 ENDIF369 jstart = jstart + dta%nread(1)370 ENDIF ! nn_dta(jbdy) = 1371 337 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 338 386 339 IF ( ln_tide ) THEN 387 340 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 ) THEN341 DO jbdy = 1, nb_bdy ! Tidal component added in ts loop 342 IF ( nn_dyn2d_dta(jbdy) .GE. 2 ) THEN 390 343 nblen => idx_bdy(jbdy)%nblen 391 344 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 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 355 ENDIF 356 ! 357 IF( ln_timing ) CALL timing_stop('bdy_dta') 358 ! 359 END SUBROUTINE bdy_dta 408 360 409 361 … … 418 370 !! 419 371 !!---------------------------------------------------------------------- 420 INTEGER :: jbdy, jfld, jstart, jend, ierror, ios ! Local integers 372 INTEGER :: jbdy, jfld ! Local integers 373 INTEGER :: ierror, ios ! 421 374 ! 375 CHARACTER(len=3) :: cl3 ! 422 376 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 377 LOGICAL :: ln_full_vel ! =T => full velocities in 3D boundary data 426 378 ! ! =F => baroclinic velocities in 3D boundary data 427 INTEGER :: ilen_global ! Max length required for global bdy dta arrays428 INTEGER, ALLOCATABLE, DIMENSION(:) :: ilen1, ilen3 ! size of 1st and 3rd dimensions of local arrays429 INTEGER , ALLOCATABLE, DIMENSION(:) :: ibdy ! bdy set for a particular jfld430 INTEGER , ALLOCATABLE, DIMENSION(:) :: igrid ! index for grid type (1,2,3 = T,U,V)431 INTEGER , POINTER, DIMENSION(:) :: nblen, nblenrim ! short cuts432 TYPE(OBC_DATA), POINTER :: dta ! short cut433 #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 dimensions436 INTEGER :: inum,id1 ! local integer437 #endif 438 TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: blf_i ! array of namelist information structures439 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 read441 #if defined key_si3 442 TYPE(FLD _N) :: bn_a_i, bn_h_i, bn_h_s443 #endif 379 LOGICAL :: ln_zinterp ! =T => requires a vertical interpolation of the bdydta 380 REAL(wp) :: rn_ice_tem, rn_ice_sal, rn_ice_age, rn_ice_apnd, rn_ice_hpnd 381 INTEGER :: ipk,ipl ! 382 INTEGER :: idvar ! variable ID 383 INTEGER :: indims ! number of dimensions of the variable 384 INTEGER :: iszdim ! number of dimensions of the variable 385 INTEGER, DIMENSION(4) :: i4dimsz ! size of variable dimensions 386 INTEGER :: igrd ! index for grid type (1,2,3 = T,U,V) 387 LOGICAL :: lluld ! is the variable using the unlimited dimension 388 LOGICAL :: llneed ! 389 LOGICAL :: llread ! 390 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 TYPE(FLD_N), DIMENSION(1), TARGET :: bn_ssh, bn_u2d, bn_v2d ! informations about the fields to be read 392 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 393 TYPE(FLD_N), DIMENSION(:), POINTER :: bn_alias ! must be an array to be used with fld_fill 394 TYPE(FLD ), DIMENSION(:), POINTER :: bf_alias 395 ! 444 396 NAMELIST/nambdy_dta/ cn_dir, bn_tem, bn_sal, bn_u3d, bn_v3d, bn_ssh, bn_u2d, bn_v2d 445 #if defined key_si3 446 NAMELIST/nambdy_dta/ bn_a_i, bn_h_i, bn_h_s 447 #endif 448 NAMELIST/nambdy_dta/ ln_full_vel 397 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_hip 398 NAMELIST/nambdy_dta/ rn_ice_tem, rn_ice_sal, rn_ice_age, rn_ice_apnd, rn_ice_hpnd 399 NAMELIST/nambdy_dta/ ln_full_vel, ln_zinterp 449 400 !!--------------------------------------------------------------------------- 450 401 ! … … 454 405 IF(lwp) WRITE(numout,*) '' 455 406 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 ) 407 ALLOCATE( bf(jpbdyfld,nb_bdy), STAT=ierror ) 493 408 IF( ierror > 0 ) THEN 494 409 CALL ctl_stop( 'bdy_dta: unable to allocate bf structure' ) ; RETURN 495 410 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 411 bf(:,:)%clrootname = 'NOT USED' ! default definition used as a flag in fld_read to do nothing. 412 bf(:,:)%lzint = .FALSE. ! default definition 413 bf(:,:)%ltotvel = .FALSE. ! default definition 414 508 415 ! Read namelists 509 416 ! -------------- 510 417 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 ) 418 DO jbdy = 1, nb_bdy 419 420 WRITE(ctmp1, '(a,i2)') 'BDY number ', jbdy 421 WRITE(ctmp2, '(a,i2)') 'block nambdy_dta number ', jbdy 422 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) 425 READ ( numnam_ref, nambdy_dta, IOSTAT = ios, ERR = 901) 426 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_dta in reference namelist' ) 427 428 ! by-pass nambdy_dta reading if no input data used in this bdy 429 IF( ( dta_bdy(jbdy)%lneed_dyn2d .AND. MOD(nn_dyn2d_dta(jbdy),2) == 1 ) & 430 & .OR. ( dta_bdy(jbdy)%lneed_dyn3d .AND. nn_dyn3d_dta(jbdy) == 1 ) & 431 & .OR. ( dta_bdy(jbdy)%lneed_tra .AND. nn_tra_dta(jbdy) == 1 ) & 432 & .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 517 434 READ ( numnam_cfg, nambdy_dta, IOSTAT = ios, ERR = 902 ) 518 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 435 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nambdy_dta in configuration namelist' ) 436 IF(lwm) WRITE( numond, nambdy_dta ) 437 ENDIF 438 439 ! get the number of ice categories in bdy data file (use a_i information to do this) 440 ipl = jpl ! default definition 441 IF( dta_bdy(jbdy)%lneed_ice ) THEN ! if we need ice bdy data 442 IF( nn_ice_dta(jbdy) == 1 ) THEN ! if we get ice bdy data from netcdf file 443 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 445 idvar = iom_varid( bf(jp_bdya_i,jbdy)%num, bf(jp_bdya_i,jbdy)%clvar, kndims=indims, kdimsz=i4dimsz, lduld=lluld ) 446 IF( indims == 4 .OR. ( indims == 3 .AND. .NOT. lluld ) ) THEN ; ipl = i4dimsz(3) ! xylt or xyl 447 ELSE ; ipl = 1 ! xy or xyt 448 ENDIF 449 ENDIF 450 ENDIF 621 451 622 452 #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 453 IF( .NOT.ln_pnd ) THEN 454 rn_ice_apnd = 0. ; rn_ice_hpnd = 0. 455 CALL ctl_warn( 'rn_ice_apnd & rn_ice_hpnd = 0 when no ponds' ) 456 ENDIF 457 #endif 458 459 ! temp, salt, age and ponds of incoming ice 460 rice_tem (jbdy) = rn_ice_tem 461 rice_sal (jbdy) = rn_ice_sal 462 rice_age (jbdy) = rn_ice_age 463 rice_apnd(jbdy) = rn_ice_apnd 464 rice_hpnd(jbdy) = rn_ice_hpnd 465 466 467 DO jfld = 1, jpbdyfld 468 469 ! ===================== 470 ! ssh 471 ! ===================== 472 IF( jfld == jp_bdyssh ) THEN 473 cl3 = 'ssh' 474 igrd = 1 ! T point 475 ipk = 1 ! surface data 476 llneed = dta_bdy(jbdy)%lneed_ssh ! dta_bdy(jbdy)%ssh will be needed 477 llread = MOD(nn_dyn2d_dta(jbdy),2) == 1 ! get data from NetCDF file 478 bf_alias => bf(jp_bdyssh,jbdy:jbdy) ! alias for ssh structure of bdy number jbdy 479 bn_alias => bn_ssh ! alias for ssh structure of nambdy_dta 480 iszdim = idx_bdy(jbdy)%nblenrim(igrd) ! length of this bdy on this MPI processus : used only on the rim 481 ENDIF 482 ! ===================== 483 ! dyn2d 484 ! ===================== 485 IF( jfld == jp_bdyu2d ) THEN 486 cl3 = 'u2d' 487 igrd = 2 ! U point 488 ipk = 1 ! surface data 489 llneed = dta_bdy(jbdy)%lneed_dyn2d ! dta_bdy(jbdy)%ssh will be needed 490 llread = .NOT. ln_full_vel .AND. MOD(nn_dyn2d_dta(jbdy),2) == 1 ! don't get u2d from u3d and read NetCDF file 491 bf_alias => bf(jp_bdyu2d,jbdy:jbdy) ! alias for u2d structure of bdy number jbdy 492 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 495 ENDIF 496 ENDIF 497 IF( jfld == jp_bdyv2d ) THEN 498 cl3 = 'v2d' 499 igrd = 3 ! V point 500 ipk = 1 ! surface data 501 llneed = dta_bdy(jbdy)%lneed_dyn2d ! dta_bdy(jbdy)%ssh will be needed 502 llread = .NOT. ln_full_vel .AND. MOD(nn_dyn2d_dta(jbdy),2) == 1 ! don't get v2d from v3d and read NetCDF file 503 bf_alias => bf(jp_bdyv2d,jbdy:jbdy) ! alias for v2d structure of bdy number jbdy 504 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 507 ENDIF 508 ENDIF 509 ! ===================== 510 ! dyn3d 511 ! ===================== 512 IF( jfld == jp_bdyu3d ) THEN 513 cl3 = 'u3d' 514 igrd = 2 ! U point 515 ipk = jpk ! 3d data 516 llneed = dta_bdy(jbdy)%lneed_dyn3d .OR. & ! dta_bdy(jbdy)%u3d will be needed 517 & ( dta_bdy(jbdy)%lneed_dyn2d .AND. ln_full_vel ) ! u3d needed to compute u2d 518 llread = nn_dyn3d_dta(jbdy) == 1 ! get data from NetCDF file 519 bf_alias => bf(jp_bdyu3d,jbdy:jbdy) ! alias for u3d structure of bdy number jbdy 520 bn_alias => bn_u3d ! alias for u3d structure of nambdy_dta 521 iszdim = idx_bdy(jbdy)%nblen(igrd) ! length of this bdy on this MPI processus 522 ENDIF 523 IF( jfld == jp_bdyv3d ) THEN 524 cl3 = 'v3d' 525 igrd = 3 ! V point 526 ipk = jpk ! 3d data 527 llneed = dta_bdy(jbdy)%lneed_dyn3d .OR. & ! dta_bdy(jbdy)%v3d will be needed 528 & ( dta_bdy(jbdy)%lneed_dyn2d .AND. ln_full_vel ) ! v3d needed to compute v2d 529 llread = nn_dyn3d_dta(jbdy) == 1 ! get data from NetCDF file 530 bf_alias => bf(jp_bdyv3d,jbdy:jbdy) ! alias for v3d structure of bdy number jbdy 531 bn_alias => bn_v3d ! alias for v3d structure of nambdy_dta 532 iszdim = idx_bdy(jbdy)%nblen(igrd) ! length of this bdy on this MPI processus 533 ENDIF 534 535 ! ===================== 536 ! tra 537 ! ===================== 538 IF( jfld == jp_bdytem ) THEN 539 cl3 = 'tem' 540 igrd = 1 ! T point 541 ipk = jpk ! 3d data 542 llneed = dta_bdy(jbdy)%lneed_tra ! dta_bdy(jbdy)%tem will be needed 543 llread = nn_tra_dta(jbdy) == 1 ! get data from NetCDF file 544 bf_alias => bf(jp_bdytem,jbdy:jbdy) ! alias for ssh structure of bdy number jbdy 545 bn_alias => bn_tem ! alias for ssh structure of nambdy_dta 546 iszdim = idx_bdy(jbdy)%nblen(igrd) ! length of this bdy on this MPI processus 547 ENDIF 548 IF( jfld == jp_bdysal ) THEN 549 cl3 = 'sal' 550 igrd = 1 ! T point 551 ipk = jpk ! 3d data 552 llneed = dta_bdy(jbdy)%lneed_tra ! dta_bdy(jbdy)%sal will be needed 553 llread = nn_tra_dta(jbdy) == 1 ! get data from NetCDF file 554 bf_alias => bf(jp_bdysal,jbdy:jbdy) ! alias for ssh structure of bdy number jbdy 555 bn_alias => bn_sal ! alias for ssh structure of nambdy_dta 556 iszdim = idx_bdy(jbdy)%nblen(igrd) ! length of this bdy on this MPI processus 557 ENDIF 558 559 ! ===================== 560 ! ice 561 ! ===================== 562 IF( jfld == jp_bdya_i .OR. jfld == jp_bdyh_i .OR. jfld == jp_bdyh_s .OR. & 563 & jfld == jp_bdyt_i .OR. jfld == jp_bdyt_s .OR. jfld == jp_bdytsu .OR. & 564 & jfld == jp_bdys_i .OR. jfld == jp_bdyaip .OR. jfld == jp_bdyhip ) THEN 565 igrd = 1 ! T point 566 ipk = ipl ! jpl-cat data 567 llneed = dta_bdy(jbdy)%lneed_ice ! ice will be needed 568 llread = nn_ice_dta(jbdy) == 1 ! get data from NetCDF file 569 iszdim = idx_bdy(jbdy)%nblen(igrd) ! length of this bdy on this MPI processus 570 ENDIF 571 IF( jfld == jp_bdya_i ) THEN 572 cl3 = 'a_i' 573 bf_alias => bf(jp_bdya_i,jbdy:jbdy) ! alias for a_i structure of bdy number jbdy 574 bn_alias => bn_a_i ! alias for a_i structure of nambdy_dta 575 ENDIF 576 IF( jfld == jp_bdyh_i ) THEN 577 cl3 = 'h_i' 578 bf_alias => bf(jp_bdyh_i,jbdy:jbdy) ! alias for h_i structure of bdy number jbdy 579 bn_alias => bn_h_i ! alias for h_i structure of nambdy_dta 580 ENDIF 581 IF( jfld == jp_bdyh_s ) THEN 582 cl3 = 'h_s' 583 bf_alias => bf(jp_bdyh_s,jbdy:jbdy) ! alias for h_s structure of bdy number jbdy 584 bn_alias => bn_h_s ! alias for h_s structure of nambdy_dta 585 ENDIF 586 IF( jfld == jp_bdyt_i ) THEN 587 cl3 = 't_i' 588 bf_alias => bf(jp_bdyt_i,jbdy:jbdy) ! alias for t_i structure of bdy number jbdy 589 bn_alias => bn_t_i ! alias for t_i structure of nambdy_dta 590 ENDIF 591 IF( jfld == jp_bdyt_s ) THEN 592 cl3 = 't_s' 593 bf_alias => bf(jp_bdyt_s,jbdy:jbdy) ! alias for t_s structure of bdy number jbdy 594 bn_alias => bn_t_s ! alias for t_s structure of nambdy_dta 595 ENDIF 596 IF( jfld == jp_bdytsu ) THEN 597 cl3 = 'tsu' 598 bf_alias => bf(jp_bdytsu,jbdy:jbdy) ! alias for tsu structure of bdy number jbdy 599 bn_alias => bn_tsu ! alias for tsu structure of nambdy_dta 600 ENDIF 601 IF( jfld == jp_bdys_i ) THEN 602 cl3 = 's_i' 603 bf_alias => bf(jp_bdys_i,jbdy:jbdy) ! alias for s_i structure of bdy number jbdy 604 bn_alias => bn_s_i ! alias for s_i structure of nambdy_dta 605 ENDIF 606 IF( jfld == jp_bdyaip ) THEN 607 cl3 = 'aip' 608 bf_alias => bf(jp_bdyaip,jbdy:jbdy) ! alias for aip structure of bdy number jbdy 609 bn_alias => bn_aip ! alias for aip structure of nambdy_dta 610 ENDIF 611 IF( jfld == jp_bdyhip ) THEN 612 cl3 = 'hip' 613 bf_alias => bf(jp_bdyhip,jbdy:jbdy) ! alias for hip structure of bdy number jbdy 614 bn_alias => bn_hip ! alias for hip structure of nambdy_dta 615 ENDIF 616 617 IF( llneed ) THEN ! dta_bdy(jbdy)%xxx will be needed 618 ! ! -> must be associated with an allocated target 619 ALLOCATE( bf_alias(1)%fnow( iszdim, 1, ipk ) ) ! allocate the target 636 620 ! 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 621 IF( llread ) THEN ! get data from NetCDF file 622 CALL fld_fill( bf_alias, bn_alias, cn_dir, 'bdy_dta', cl3//' '//ctmp1, ctmp2 ) ! use namelist info 623 IF( bf_alias(1)%ln_tint ) ALLOCATE( bf_alias(1)%fdta( iszdim, 1, ipk, 2 ) ) 624 bf_alias(1)%imap => idx_bdy(jbdy)%nbmap(1:iszdim,igrd) ! associate the mapping used for this bdy 625 bf_alias(1)%igrd = igrd ! used only for vertical integration of 3D arrays 626 bf_alias(1)%ibdy = jbdy ! " " " " " " " " 627 bf_alias(1)%ltotvel = ln_full_vel ! T if u3d is full velocity 628 bf_alias(1)%lzint = ln_zinterp ! T if it requires a vertical interpolation 629 ENDIF 630 631 ! associate the pointer and get rid of the dimensions with a size equal to 1 632 IF( jfld == jp_bdyssh ) dta_bdy(jbdy)%ssh => bf_alias(1)%fnow(:,1,1) 633 IF( jfld == jp_bdyu2d ) dta_bdy(jbdy)%u2d => bf_alias(1)%fnow(:,1,1) 634 IF( jfld == jp_bdyv2d ) dta_bdy(jbdy)%v2d => bf_alias(1)%fnow(:,1,1) 635 IF( jfld == jp_bdyu3d ) dta_bdy(jbdy)%u3d => bf_alias(1)%fnow(:,1,:) 636 IF( jfld == jp_bdyv3d ) dta_bdy(jbdy)%v3d => bf_alias(1)%fnow(:,1,:) 637 IF( jfld == jp_bdytem ) dta_bdy(jbdy)%tem => bf_alias(1)%fnow(:,1,:) 638 IF( jfld == jp_bdysal ) dta_bdy(jbdy)%sal => bf_alias(1)%fnow(:,1,:) 639 IF( jfld == jp_bdya_i ) THEN 640 IF( ipk == jpl ) THEN ; dta_bdy(jbdy)%a_i => bf_alias(1)%fnow(:,1,:) 641 ELSE ; ALLOCATE( dta_bdy(jbdy)%a_i(iszdim,jpl) ) 642 ENDIF 643 ENDIF 644 IF( jfld == jp_bdyh_i ) THEN 645 IF( ipk == jpl ) THEN ; dta_bdy(jbdy)%h_i => bf_alias(1)%fnow(:,1,:) 646 ELSE ; ALLOCATE( dta_bdy(jbdy)%h_i(iszdim,jpl) ) 647 ENDIF 648 ENDIF 649 IF( jfld == jp_bdyh_s ) THEN 650 IF( ipk == jpl ) THEN ; dta_bdy(jbdy)%h_s => bf_alias(1)%fnow(:,1,:) 651 ELSE ; ALLOCATE( dta_bdy(jbdy)%h_s(iszdim,jpl) ) 652 ENDIF 653 ENDIF 654 IF( jfld == jp_bdyt_i ) THEN 655 IF( ipk == jpl ) THEN ; dta_bdy(jbdy)%t_i => bf_alias(1)%fnow(:,1,:) 656 ELSE ; ALLOCATE( dta_bdy(jbdy)%t_i(iszdim,jpl) ) 657 ENDIF 658 ENDIF 659 IF( jfld == jp_bdyt_s ) THEN 660 IF( ipk == jpl ) THEN ; dta_bdy(jbdy)%t_s => bf_alias(1)%fnow(:,1,:) 661 ELSE ; ALLOCATE( dta_bdy(jbdy)%t_s(iszdim,jpl) ) 662 ENDIF 663 ENDIF 664 IF( jfld == jp_bdytsu ) THEN 665 IF( ipk == jpl ) THEN ; dta_bdy(jbdy)%tsu => bf_alias(1)%fnow(:,1,:) 666 ELSE ; ALLOCATE( dta_bdy(jbdy)%tsu(iszdim,jpl) ) 667 ENDIF 668 ENDIF 669 IF( jfld == jp_bdys_i ) THEN 670 IF( ipk == jpl ) THEN ; dta_bdy(jbdy)%s_i => bf_alias(1)%fnow(:,1,:) 671 ELSE ; ALLOCATE( dta_bdy(jbdy)%s_i(iszdim,jpl) ) 672 ENDIF 673 ENDIF 674 IF( jfld == jp_bdyaip ) THEN 675 IF( ipk == jpl ) THEN ; dta_bdy(jbdy)%aip => bf_alias(1)%fnow(:,1,:) 676 ELSE ; ALLOCATE( dta_bdy(jbdy)%aip(iszdim,jpl) ) 677 ENDIF 678 ENDIF 679 IF( jfld == jp_bdyhip ) THEN 680 IF( ipk == jpl ) THEN ; dta_bdy(jbdy)%hip => bf_alias(1)%fnow(:,1,:) 681 ELSE ; ALLOCATE( dta_bdy(jbdy)%hip(iszdim,jpl) ) 682 ENDIF 683 ENDIF 684 ENDIF 685 686 END DO ! jpbdyfld 836 687 ! 837 688 END DO ! jbdy 838 689 ! 839 690 END SUBROUTINE bdy_dta_init 840 691 841 692 !!============================================================================== 842 693 END MODULE bdydta
Note: See TracChangeset
for help on using the changeset viewer.
