- Timestamp:
- 2020-09-14T17:40:34+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/BDY/bdydta.F90 (modified) (8 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
- Property svn:externals
-
old new 3 3 ^/utils/build/mk@HEAD mk 4 4 ^/utils/tools@HEAD tools 5 ^/vendors/AGRIF/dev @HEADext/AGRIF5 ^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS ext/AGRIF 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 9 # SETTE 10 ^/utils/CI/sette@13382 sette
-
- Property svn:externals
-
NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/BDY/bdydta.F90
r11229 r13463 23 23 USE phycst ! physical constants 24 24 USE sbcapr ! atmospheric pressure forcing 25 USE sbctide ! Tidal forcing or not25 USE tide_mod, ONLY: ln_tide ! tidal forcing 26 26 USE bdy_oce ! ocean open boundary conditions 27 27 USE bdytides ! tidal forcing at boundaries … … 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 nbmap 53 54 #if defined key_si3 55 INTEGER :: nice_cat ! number of categories in the input file 56 INTEGER :: jfld_hti, jfld_hts, jfld_ai ! indices of ice thickness, snow thickness and concentration in bf structure 57 INTEGER, DIMENSION(jp_bdy) :: jfld_htit, jfld_htst, jfld_ait 58 #endif 59 69 70 !! * Substitutions 71 # include "do_loop_substitute.h90" 72 # include "domzgr_substitute.h90" 60 73 !!---------------------------------------------------------------------- 61 74 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 65 78 CONTAINS 66 79 67 SUBROUTINE bdy_dta( kt, jit, time_offset)80 SUBROUTINE bdy_dta( kt, Kmm ) 68 81 !!---------------------------------------------------------------------- 69 82 !! *** SUBROUTINE bdy_dta *** … … 75 88 !!---------------------------------------------------------------------- 76 89 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 jit 79 ! ! is present then units = subcycle timesteps. 80 ! ! time_offset = 0 => get data at "now" time level 81 ! ! time_offset = -1 => get data at "before" time level 82 ! ! time_offset = +1 => get data at "after" time level 83 ! ! etc. 84 ! 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 90 INTEGER, INTENT(in) :: Kmm ! ocean time level index 91 ! 92 INTEGER :: jbdy, jfld, jstart, jend, ib, jl ! dummy loop indices 93 INTEGER :: ii, ij, ik, igrd, ipl ! local integers 94 TYPE(OBC_DATA) , POINTER :: dta_alias ! short cut 95 TYPE(FLD), DIMENSION(:), POINTER :: bf_alias 90 96 !!--------------------------------------------------------------------------- 91 97 ! … … 94 100 ! Initialise data arrays once for all from initial conditions where required 95 101 !--------------------------------------------------------------------------- 96 IF( kt == nit000 .AND. .NOT.PRESENT(jit)) THEN102 IF( kt == nit000 ) THEN 97 103 98 104 ! Calculate depth-mean currents 99 105 !----------------------------- 100 106 101 107 DO jbdy = 1, nb_bdy 102 108 ! 103 nblen => idx_bdy(jbdy)%nblen104 nblenrim => idx_bdy(jbdy)%nblenrim105 dta => dta_bdy(jbdy)106 !107 109 IF( nn_dyn2d_dta(jbdy) == 0 ) THEN 108 ilen1(:) = nblen(:) 109 IF( dta%ll_ssh ) THEN 110 IF( dta_bdy(jbdy)%lneed_ssh ) THEN 110 111 igrd = 1 111 DO ib = 1, i len1(igrd)112 DO ib = 1, idx_bdy(jbdy)%nblenrim(igrd) ! ssh is allocated and used only on the rim 112 113 ii = idx_bdy(jbdy)%nbi(ib,igrd) 113 114 ij = idx_bdy(jbdy)%nbj(ib,igrd) 114 dta_bdy(jbdy)%ssh(ib) = ssh n(ii,ij) * tmask(ii,ij,1)115 END DO 116 ENDIF 117 IF( dta%ll_u2d ) THEN115 dta_bdy(jbdy)%ssh(ib) = ssh(ii,ij,Kmm) * tmask(ii,ij,1) 116 END DO 117 ENDIF 118 IF( ASSOCIATED(dta_bdy(jbdy)%u2d) ) THEN ! no SIZE with a unassociated pointer. v2d and u2d can differ on subdomain 118 119 igrd = 2 119 DO ib = 1, ilen1(igrd)120 DO ib = 1, SIZE(dta_bdy(jbdy)%u2d) ! u2d is used either over the whole bdy or only on the rim 120 121 ii = idx_bdy(jbdy)%nbi(ib,igrd) 121 122 ij = idx_bdy(jbdy)%nbj(ib,igrd) 122 dta_bdy(jbdy)%u2d(ib) = u n_b(ii,ij) * umask(ii,ij,1)123 END DO 124 ENDIF 125 IF( dta%ll_v2d ) THEN123 dta_bdy(jbdy)%u2d(ib) = uu_b(ii,ij,Kmm) * umask(ii,ij,1) 124 END DO 125 ENDIF 126 IF( ASSOCIATED(dta_bdy(jbdy)%v2d) ) THEN ! no SIZE with a unassociated pointer. v2d and u2d can differ on subdomain 126 127 igrd = 3 127 DO ib = 1, ilen1(igrd)128 DO ib = 1, SIZE(dta_bdy(jbdy)%v2d) ! v2d is used either over the whole bdy or only on the rim 128 129 ii = idx_bdy(jbdy)%nbi(ib,igrd) 129 130 ij = idx_bdy(jbdy)%nbj(ib,igrd) 130 dta_bdy(jbdy)%v2d(ib) = v n_b(ii,ij) * vmask(ii,ij,1)131 END DO 131 dta_bdy(jbdy)%v2d(ib) = vv_b(ii,ij,Kmm) * vmask(ii,ij,1) 132 END DO 132 133 ENDIF 133 134 ENDIF 134 135 ! 135 136 IF( nn_dyn3d_dta(jbdy) == 0 ) THEN 136 ilen1(:) = nblen(:) 137 IF( dta%ll_u3d ) THEN 137 IF( dta_bdy(jbdy)%lneed_dyn3d ) THEN 138 138 igrd = 2 139 DO ib = 1, i len1(igrd)139 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 140 140 DO ik = 1, jpkm1 141 141 ii = idx_bdy(jbdy)%nbi(ib,igrd) 142 142 ij = idx_bdy(jbdy)%nbj(ib,igrd) 143 dta_bdy(jbdy)%u3d(ib,ik) = ( u n(ii,ij,ik) - un_b(ii,ij) ) * umask(ii,ij,ik)143 dta_bdy(jbdy)%u3d(ib,ik) = ( uu(ii,ij,ik,Kmm) - uu_b(ii,ij,Kmm) ) * umask(ii,ij,ik) 144 144 END DO 145 END DO 146 ENDIF 147 IF( dta%ll_v3d ) THEN 145 END DO 148 146 igrd = 3 149 DO ib = 1, i len1(igrd)147 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 150 148 DO ik = 1, jpkm1 151 149 ii = idx_bdy(jbdy)%nbi(ib,igrd) 152 150 ij = idx_bdy(jbdy)%nbj(ib,igrd) 153 dta_bdy(jbdy)%v3d(ib,ik) = ( v n(ii,ij,ik) - vn_b(ii,ij) ) * vmask(ii,ij,ik)154 155 END DO 151 dta_bdy(jbdy)%v3d(ib,ik) = ( vv(ii,ij,ik,Kmm) - vv_b(ii,ij,Kmm) ) * vmask(ii,ij,ik) 152 END DO 153 END DO 156 154 ENDIF 157 155 ENDIF 158 156 159 157 IF( nn_tra_dta(jbdy) == 0 ) THEN 160 ilen1(:) = nblen(:) 161 IF( dta%ll_tem ) THEN 158 IF( dta_bdy(jbdy)%lneed_tra ) THEN 162 159 igrd = 1 163 DO ib = 1, i len1(igrd)160 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 164 161 DO ik = 1, jpkm1 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) = ts(ii,ij,ik,jp_tem,Kmm) * tmask(ii,ij,ik) 165 dta_bdy(jbdy)%sal(ib,ik) = ts(ii,ij,ik,jp_sal,Kmm) * 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 167 END DO 168 ENDIF 169 ENDIF 170 171 #if defined key_si3 172 IF( nn_ice_dta(jbdy) == 0 ) THEN ! set ice to initial values 173 IF( dta_bdy(jbdy)%lneed_ice ) THEN 174 igrd = 1 175 DO jl = 1, jpl 176 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 175 177 ii = idx_bdy(jbdy)%nbi(ib,igrd) 176 178 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 180 ENDIF 181 ENDIF 182 183 #if defined key_si3 184 IF( nn_ice_dta(jbdy) == 0 ) THEN ! set ice to initial values 185 ilen1(:) = nblen(:) 186 IF( dta%ll_a_i ) THEN 187 igrd = 1 188 DO jl = 1, jpl 189 DO ib = 1, ilen1(igrd) 190 ii = idx_bdy(jbdy)%nbi(ib,igrd) 191 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) 179 dta_bdy(jbdy)%a_i(ib,jl) = a_i (ii,ij,jl) * tmask(ii,ij,1) 180 dta_bdy(jbdy)%h_i(ib,jl) = h_i (ii,ij,jl) * tmask(ii,ij,1) 181 dta_bdy(jbdy)%h_s(ib,jl) = h_s (ii,ij,jl) * tmask(ii,ij,1) 182 dta_bdy(jbdy)%t_i(ib,jl) = SUM(t_i (ii,ij,:,jl)) * r1_nlay_i * tmask(ii,ij,1) 183 dta_bdy(jbdy)%t_s(ib,jl) = SUM(t_s (ii,ij,:,jl)) * r1_nlay_s * tmask(ii,ij,1) 184 dta_bdy(jbdy)%tsu(ib,jl) = t_su(ii,ij,jl) * tmask(ii,ij,1) 185 dta_bdy(jbdy)%s_i(ib,jl) = s_i (ii,ij,jl) * tmask(ii,ij,1) 186 ! melt ponds 187 dta_bdy(jbdy)%aip(ib,jl) = a_ip(ii,ij,jl) * tmask(ii,ij,1) 188 dta_bdy(jbdy)%hip(ib,jl) = h_ip(ii,ij,jl) * tmask(ii,ij,1) 213 189 END DO 214 190 END DO … … 222 198 ! update external data from files 223 199 !-------------------------------- 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 353 #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 CALL ice_var_itd( bf(jfld_hti)%fnow(:,1,:), bf(jfld_hts)%fnow(:,1,:), bf(jfld_ai)%fnow(:,1,:), & 360 & dta_bdy(jbdy)%h_i , dta_bdy(jbdy)%h_s , dta_bdy(jbdy)%a_i ) 361 ENDIF 362 #endif 363 ENDIF 364 jstart = jstart + dta%nread(1) 365 ENDIF ! nn_dta(jbdy) = 1 366 END DO ! jbdy 367 368 IF ( ln_apr_obc ) THEN 369 DO jbdy = 1, nb_bdy 370 IF (cn_tra(jbdy) /= 'runoff')THEN 371 igrd = 1 ! meridional velocity 372 DO ib = 1, idx_bdy(jbdy)%nblenrim(igrd) 200 201 DO jbdy = 1, nb_bdy 202 203 dta_alias => dta_bdy(jbdy) 204 bf_alias => bf(:,jbdy) 205 206 ! read/update all bdy data 207 ! ------------------------ 208 ! BDY: use pt_offset=0.5 as applied at the end of the step and fldread is referenced at the middle of the step 209 CALL fld_read( kt, 1, bf_alias, pt_offset = 0.5_wp, Kmm = Kmm ) 210 ! apply some corrections in some specific cases... 211 ! -------------------------------------------------- 212 ! 213 ! if runoff condition: change river flow we read (in m3/s) into barotropic velocity (m/s) 214 IF( cn_tra(jbdy) == 'runoff' ) THEN ! runoff 215 ! 216 IF( ASSOCIATED(dta_bdy(jbdy)%u2d) ) THEN ! no SIZE with a unassociated pointer. v2d and u2d can differ on subdomain 217 igrd = 2 ! zonal flow (m3/s) to barotropic zonal velocity (m/s) 218 DO ib = 1, SIZE(dta_alias%u2d) ! u2d is used either over the whole bdy or only on the rim 373 219 ii = idx_bdy(jbdy)%nbi(ib,igrd) 374 220 ij = idx_bdy(jbdy)%nbj(ib,igrd) 375 dta_ bdy(jbdy)%ssh(ib) = dta_bdy(jbdy)%ssh(ib) + ssh_ib(ii,ij)221 dta_alias%u2d(ib) = dta_alias%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) ) 376 222 END DO 377 223 ENDIF 378 END DO 379 ENDIF 224 IF( ASSOCIATED(dta_bdy(jbdy)%v2d) ) THEN ! no SIZE with a unassociated pointer. v2d and u2d can differ on subdomain 225 igrd = 3 ! meridional flow (m3/s) to barotropic meridional velocity (m/s) 226 DO ib = 1, SIZE(dta_alias%v2d) ! v2d is used either over the whole bdy or only on the rim 227 ii = idx_bdy(jbdy)%nbi(ib,igrd) 228 ij = idx_bdy(jbdy)%nbj(ib,igrd) 229 dta_alias%v2d(ib) = dta_alias%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) ) 230 END DO 231 ENDIF 232 ENDIF 233 234 ! tidal harmonic forcing ONLY: initialise arrays 235 IF( nn_dyn2d_dta(jbdy) == 2 ) THEN ! we did not read ssh, u/v2d 236 IF( ASSOCIATED(dta_alias%ssh) ) dta_alias%ssh(:) = 0._wp 237 IF( ASSOCIATED(dta_alias%u2d) ) dta_alias%u2d(:) = 0._wp 238 IF( ASSOCIATED(dta_alias%v2d) ) dta_alias%v2d(:) = 0._wp 239 ENDIF 240 241 ! If full velocities in boundary data, then split it into barotropic and baroclinic component 242 IF( bf_alias(jp_bdyu3d)%ltotvel ) THEN ! if we read 3D total velocity (can be true only if u3d was read) 243 ! 244 igrd = 2 ! zonal velocity 245 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 246 ii = idx_bdy(jbdy)%nbi(ib,igrd) 247 ij = idx_bdy(jbdy)%nbj(ib,igrd) 248 dta_alias%u2d(ib) = 0._wp ! compute barotrope zonal velocity and put it in u2d 249 DO ik = 1, jpkm1 250 dta_alias%u2d(ib) = dta_alias%u2d(ib) & 251 & + e3u(ii,ij,ik,Kmm) * umask(ii,ij,ik) * dta_alias%u3d(ib,ik) 252 END DO 253 dta_alias%u2d(ib) = dta_alias%u2d(ib) * r1_hu(ii,ij,Kmm) 254 DO ik = 1, jpkm1 ! compute barocline zonal velocity and put it in u3d 255 dta_alias%u3d(ib,ik) = dta_alias%u3d(ib,ik) - dta_alias%u2d(ib) 256 END DO 257 END DO 258 igrd = 3 ! meridional velocity 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 dta_alias%v2d(ib) = 0._wp ! compute barotrope meridional velocity and put it in v2d 263 DO ik = 1, jpkm1 264 dta_alias%v2d(ib) = dta_alias%v2d(ib) & 265 & + e3v(ii,ij,ik,Kmm) * vmask(ii,ij,ik) * dta_alias%v3d(ib,ik) 266 END DO 267 dta_alias%v2d(ib) = dta_alias%v2d(ib) * r1_hv(ii,ij,Kmm) 268 DO ik = 1, jpkm1 ! compute barocline meridional velocity and put it in v3d 269 dta_alias%v3d(ib,ik) = dta_alias%v3d(ib,ik) - dta_alias%v2d(ib) 270 END DO 271 END DO 272 ENDIF ! ltotvel 273 274 ! atm surface pressure : add inverted barometer effect to ssh if it was read 275 IF ( ln_apr_obc .AND. TRIM(bf_alias(jp_bdyssh)%clrootname) /= 'NOT USED' ) THEN 276 igrd = 1 277 DO ib = 1, idx_bdy(jbdy)%nblenrim(igrd) ! ssh is used only on the rim 278 ii = idx_bdy(jbdy)%nbi(ib,igrd) 279 ij = idx_bdy(jbdy)%nbj(ib,igrd) 280 dta_alias%ssh(ib) = dta_alias%ssh(ib) + ssh_ib(ii,ij) 281 END DO 282 ENDIF 283 284 #if defined key_si3 285 IF( dta_alias%lneed_ice .AND. idx_bdy(jbdy)%nblen(1) > 0 ) THEN 286 ! fill temperature and salinity arrays 287 IF( TRIM(bf_alias(jp_bdyt_i)%clrootname) == 'NOT USED' ) bf_alias(jp_bdyt_i)%fnow(:,1,:) = rice_tem (jbdy) 288 IF( TRIM(bf_alias(jp_bdyt_s)%clrootname) == 'NOT USED' ) bf_alias(jp_bdyt_s)%fnow(:,1,:) = rice_tem (jbdy) 289 IF( TRIM(bf_alias(jp_bdytsu)%clrootname) == 'NOT USED' ) bf_alias(jp_bdytsu)%fnow(:,1,:) = rice_tem (jbdy) 290 IF( TRIM(bf_alias(jp_bdys_i)%clrootname) == 'NOT USED' ) bf_alias(jp_bdys_i)%fnow(:,1,:) = rice_sal (jbdy) 291 IF( TRIM(bf_alias(jp_bdyaip)%clrootname) == 'NOT USED' ) bf_alias(jp_bdyaip)%fnow(:,1,:) = rice_apnd(jbdy) * & ! rice_apnd is the pond fraction 292 & bf_alias(jp_bdya_i)%fnow(:,1,:) ! ( a_ip = rice_apnd * a_i ) 293 IF( TRIM(bf_alias(jp_bdyhip)%clrootname) == 'NOT USED' ) bf_alias(jp_bdyhip)%fnow(:,1,:) = rice_hpnd(jbdy) 294 295 ! if T_i is read and not T_su, set T_su = T_i 296 IF( TRIM(bf_alias(jp_bdyt_i)%clrootname) /= 'NOT USED' .AND. TRIM(bf_alias(jp_bdytsu)%clrootname) == 'NOT USED' ) & 297 & bf_alias(jp_bdytsu)%fnow(:,1,:) = bf_alias(jp_bdyt_i)%fnow(:,1,:) 298 ! if T_s is read and not T_su, set T_su = T_s 299 IF( TRIM(bf_alias(jp_bdyt_s)%clrootname) /= 'NOT USED' .AND. TRIM(bf_alias(jp_bdytsu)%clrootname) == 'NOT USED' ) & 300 & bf_alias(jp_bdytsu)%fnow(:,1,:) = bf_alias(jp_bdyt_s)%fnow(:,1,:) 301 ! if T_i is read and not T_s, set T_s = T_i 302 IF( TRIM(bf_alias(jp_bdyt_i)%clrootname) /= 'NOT USED' .AND. TRIM(bf_alias(jp_bdyt_s)%clrootname) == 'NOT USED' ) & 303 & bf_alias(jp_bdyt_s)%fnow(:,1,:) = bf_alias(jp_bdyt_i)%fnow(:,1,:) 304 ! if T_su is read and not T_s, set T_s = T_su 305 IF( TRIM(bf_alias(jp_bdytsu)%clrootname) /= 'NOT USED' .AND. TRIM(bf_alias(jp_bdyt_s)%clrootname) == 'NOT USED' ) & 306 & bf_alias(jp_bdyt_s)%fnow(:,1,:) = bf_alias(jp_bdytsu)%fnow(:,1,:) 307 ! if T_su is read and not T_i, set T_i = (T_su + T_freeze)/2 308 IF( TRIM(bf_alias(jp_bdytsu)%clrootname) /= 'NOT USED' .AND. TRIM(bf_alias(jp_bdyt_i)%clrootname) == 'NOT USED' ) & 309 & bf_alias(jp_bdyt_i)%fnow(:,1,:) = 0.5_wp * ( bf_alias(jp_bdytsu)%fnow(:,1,:) + 271.15 ) 310 ! if T_s is read and not T_i, set T_i = (T_s + T_freeze)/2 311 IF( TRIM(bf_alias(jp_bdyt_s)%clrootname) /= 'NOT USED' .AND. TRIM(bf_alias(jp_bdyt_i)%clrootname) == 'NOT USED' ) & 312 & bf_alias(jp_bdyt_i)%fnow(:,1,:) = 0.5_wp * ( bf_alias(jp_bdyt_s)%fnow(:,1,:) + 271.15 ) 313 314 ! make sure ponds = 0 if no ponds scheme 315 IF ( .NOT.ln_pnd ) THEN 316 bf_alias(jp_bdyaip)%fnow(:,1,:) = 0._wp 317 bf_alias(jp_bdyhip)%fnow(:,1,:) = 0._wp 318 ENDIF 319 320 ! convert N-cat fields (input) into jpl-cat (output) 321 ipl = SIZE(bf_alias(jp_bdya_i)%fnow, 3) 322 IF( ipl /= jpl ) THEN ! ice: convert N-cat fields (input) into jpl-cat (output) 323 CALL ice_var_itd( bf_alias(jp_bdyh_i)%fnow(:,1,:), bf_alias(jp_bdyh_s)%fnow(:,1,:), bf_alias(jp_bdya_i)%fnow(:,1,:), & 324 & dta_alias%h_i , dta_alias%h_s , dta_alias%a_i , & 325 & bf_alias(jp_bdyt_i)%fnow(:,1,:), bf_alias(jp_bdyt_s)%fnow(:,1,:), & 326 & bf_alias(jp_bdytsu)%fnow(:,1,:), bf_alias(jp_bdys_i)%fnow(:,1,:), & 327 & bf_alias(jp_bdyaip)%fnow(:,1,:), bf_alias(jp_bdyhip)%fnow(:,1,:), & 328 & dta_alias%t_i , dta_alias%t_s , & 329 & dta_alias%tsu , dta_alias%s_i , & 330 & dta_alias%aip , dta_alias%hip ) 331 ENDIF 332 ENDIF 333 #endif 334 END DO ! jbdy 380 335 381 336 IF ( ln_tide ) THEN 382 337 IF (ln_dynspg_ts) THEN ! Fill temporary arrays with slow-varying bdy data 383 DO jbdy = 1, nb_bdy ! Tidal component added in ts loop 384 IF ( nn_dyn2d_dta(jbdy) .ge. 2 ) THEN 385 nblen => idx_bdy(jbdy)%nblen 386 nblenrim => idx_bdy(jbdy)%nblenrim 387 IF( cn_dyn2d(jbdy) == 'frs' ) THEN; ilen1(:)=nblen(:) ; ELSE ; ilen1(:)=nblenrim(:) ; ENDIF 388 IF ( dta_bdy(jbdy)%ll_ssh ) dta_bdy_s(jbdy)%ssh(1:ilen1(1)) = dta_bdy(jbdy)%ssh(1:ilen1(1)) 389 IF ( dta_bdy(jbdy)%ll_u2d ) dta_bdy_s(jbdy)%u2d(1:ilen1(2)) = dta_bdy(jbdy)%u2d(1:ilen1(2)) 390 IF ( dta_bdy(jbdy)%ll_v2d ) dta_bdy_s(jbdy)%v2d(1:ilen1(3)) = dta_bdy(jbdy)%v2d(1:ilen1(3)) 338 DO jbdy = 1, nb_bdy ! Tidal component added in ts loop 339 IF ( nn_dyn2d_dta(jbdy) .GE. 2 ) THEN 340 IF( ASSOCIATED(dta_bdy(jbdy)%ssh) ) dta_bdy_s(jbdy)%ssh(:) = dta_bdy(jbdy)%ssh(:) 341 IF( ASSOCIATED(dta_bdy(jbdy)%u2d) ) dta_bdy_s(jbdy)%u2d(:) = dta_bdy(jbdy)%u2d(:) 342 IF( ASSOCIATED(dta_bdy(jbdy)%v2d) ) dta_bdy_s(jbdy)%v2d(:) = dta_bdy(jbdy)%v2d(:) 391 343 ENDIF 392 344 END DO 393 345 ELSE ! Add tides if not split-explicit free surface else this is done in ts loop 394 346 ! 395 CALL bdy_dta_tides( kt=kt, time_offset=time_offset)347 CALL bdy_dta_tides( kt=kt, pt_offset = 1._wp ) 396 348 ENDIF 397 349 ENDIF 398 399 350 ! 400 351 IF( ln_timing ) CALL timing_stop('bdy_dta') 401 352 ! 402 353 END SUBROUTINE bdy_dta 403 354 404 355 405 356 SUBROUTINE bdy_dta_init … … 413 364 !! 414 365 !!---------------------------------------------------------------------- 415 INTEGER :: jbdy, jfld, jstart, jend, ierror, ios ! Local integers 416 ! 366 INTEGER :: jbdy, jfld ! Local integers 367 INTEGER :: ierror, ios ! 368 ! 369 INTEGER :: nbdy_rdstart, nbdy_loc 370 CHARACTER(LEN=50) :: cerrmsg ! error string 371 CHARACTER(len=3) :: cl3 ! 417 372 CHARACTER(len=100) :: cn_dir ! Root directory for location of data files 418 CHARACTER(len=100), DIMENSION(nb_bdy) :: cn_dir_array ! Root directory for location of data files419 CHARACTER(len = 256):: clname ! temporary file name420 373 LOGICAL :: ln_full_vel ! =T => full velocities in 3D boundary data 421 374 ! ! =F => baroclinic velocities in 3D boundary data 422 INTEGER :: ilen_global ! Max length required for global bdy dta arrays 423 INTEGER, ALLOCATABLE, DIMENSION(:) :: ilen1, ilen3 ! size of 1st and 3rd dimensions of local arrays 424 INTEGER, ALLOCATABLE, DIMENSION(:) :: ibdy ! bdy set for a particular jfld 425 INTEGER, ALLOCATABLE, DIMENSION(:) :: igrid ! index for grid type (1,2,3 = T,U,V) 426 INTEGER, POINTER, DIMENSION(:) :: nblen, nblenrim ! short cuts 427 TYPE(OBC_DATA), POINTER :: dta ! short cut 428 #if defined key_si3 429 INTEGER :: kndims ! number of dimensions in an array (i.e. 3 = wo ice cat; 4 = w ice cat) 430 INTEGER, DIMENSION(4) :: kdimsz ! size of dimensions 431 INTEGER :: inum,id1 ! local integer 432 #endif 433 TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: blf_i ! array of namelist information structures 434 TYPE(FLD_N) :: bn_tem, bn_sal, bn_u3d, bn_v3d ! 435 TYPE(FLD_N) :: bn_ssh, bn_u2d, bn_v2d ! informations about the fields to be read 436 #if defined key_si3 437 TYPE(FLD_N) :: bn_a_i, bn_h_i, bn_h_s 438 #endif 375 LOGICAL :: ln_zinterp ! =T => requires a vertical interpolation of the bdydta 376 REAL(wp) :: rn_ice_tem, rn_ice_sal, rn_ice_age, rn_ice_apnd, rn_ice_hpnd 377 INTEGER :: ipk,ipl ! 378 INTEGER :: idvar ! variable ID 379 INTEGER :: indims ! number of dimensions of the variable 380 INTEGER :: iszdim ! number of dimensions of the variable 381 INTEGER, DIMENSION(4) :: i4dimsz ! size of variable dimensions 382 INTEGER :: igrd ! index for grid type (1,2,3 = T,U,V) 383 LOGICAL :: lluld ! is the variable using the unlimited dimension 384 LOGICAL :: llneed ! 385 LOGICAL :: llread ! 386 LOGICAL :: llfullbdy ! 387 TYPE(FLD_N), DIMENSION(1), TARGET :: bn_tem, bn_sal, bn_u3d, bn_v3d ! must be an array to be used with fld_fill 388 TYPE(FLD_N), DIMENSION(1), TARGET :: bn_ssh, bn_u2d, bn_v2d ! informations about the fields to be read 389 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 390 TYPE(FLD_N), DIMENSION(:), POINTER :: bn_alias ! must be an array to be used with fld_fill 391 TYPE(FLD ), DIMENSION(:), POINTER :: bf_alias 392 ! 439 393 NAMELIST/nambdy_dta/ cn_dir, bn_tem, bn_sal, bn_u3d, bn_v3d, bn_ssh, bn_u2d, bn_v2d 440 #if defined key_si3 441 NAMELIST/nambdy_dta/ bn_a_i, bn_h_i, bn_h_s 442 #endif 443 NAMELIST/nambdy_dta/ ln_full_vel 394 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 395 NAMELIST/nambdy_dta/ rn_ice_tem, rn_ice_sal, rn_ice_age, rn_ice_apnd, rn_ice_hpnd 396 NAMELIST/nambdy_dta/ ln_full_vel, ln_zinterp 444 397 !!--------------------------------------------------------------------------- 445 398 ! … … 449 402 IF(lwp) WRITE(numout,*) '' 450 403 451 ! Set nn_dta 452 DO jbdy = 1, nb_bdy 453 nn_dta(jbdy) = MAX( nn_dyn2d_dta (jbdy) & 454 & , nn_dyn3d_dta (jbdy) & 455 & , nn_tra_dta (jbdy) & 456 #if defined key_si3 457 & , nn_ice_dta (jbdy) & 458 #endif 459 ) 460 IF(nn_dta(jbdy) > 1) nn_dta(jbdy) = 1 461 END DO 462 463 ! Work out upper bound of how many fields there are to read in and allocate arrays 464 ! --------------------------------------------------------------------------- 465 ALLOCATE( nb_bdy_fld(nb_bdy) ) 466 nb_bdy_fld(:) = 0 467 DO jbdy = 1, nb_bdy 468 IF( cn_dyn2d(jbdy) /= 'none' .AND. ( nn_dyn2d_dta(jbdy) == 1 .or. nn_dyn2d_dta(jbdy) == 3 ) ) THEN 469 nb_bdy_fld(jbdy) = nb_bdy_fld(jbdy) + 3 470 ENDIF 471 IF( cn_dyn3d(jbdy) /= 'none' .AND. nn_dyn3d_dta(jbdy) == 1 ) THEN 472 nb_bdy_fld(jbdy) = nb_bdy_fld(jbdy) + 2 473 ENDIF 474 IF( cn_tra(jbdy) /= 'none' .AND. nn_tra_dta(jbdy) == 1 ) THEN 475 nb_bdy_fld(jbdy) = nb_bdy_fld(jbdy) + 2 476 ENDIF 477 #if defined key_si3 478 IF( cn_ice(jbdy) /= 'none' .AND. nn_ice_dta(jbdy) == 1 ) THEN 479 nb_bdy_fld(jbdy) = nb_bdy_fld(jbdy) + 3 480 ENDIF 481 #endif 482 IF(lwp) WRITE(numout,*) 'Maximum number of files to open =', nb_bdy_fld(jbdy) 483 END DO 484 485 nb_bdy_fld_sum = SUM( nb_bdy_fld ) 486 487 ALLOCATE( bf(nb_bdy_fld_sum), STAT=ierror ) 404 ALLOCATE( bf(jpbdyfld,nb_bdy), STAT=ierror ) 488 405 IF( ierror > 0 ) THEN 489 406 CALL ctl_stop( 'bdy_dta: unable to allocate bf structure' ) ; RETURN 490 407 ENDIF 491 ALLOCATE( blf_i(nb_bdy_fld_sum), STAT=ierror ) 492 IF( ierror > 0 ) THEN 493 CALL ctl_stop( 'bdy_dta: unable to allocate blf_i structure' ) ; RETURN 494 ENDIF 495 ALLOCATE( nbmap_ptr(nb_bdy_fld_sum), STAT=ierror ) 496 IF( ierror > 0 ) THEN 497 CALL ctl_stop( 'bdy_dta: unable to allocate nbmap_ptr structure' ) ; RETURN 498 ENDIF 499 ALLOCATE( ilen1(nb_bdy_fld_sum), ilen3(nb_bdy_fld_sum) ) 500 ALLOCATE( ibdy(nb_bdy_fld_sum) ) 501 ALLOCATE( igrid(nb_bdy_fld_sum) ) 502 408 bf(:,:)%clrootname = 'NOT USED' ! default definition used as a flag in fld_read to do nothing. 409 bf(:,:)%lzint = .FALSE. ! default definition 410 bf(:,:)%ltotvel = .FALSE. ! default definition 411 503 412 ! Read namelists 504 413 ! -------------- 505 REWIND(numnam_cfg) 506 jfld = 0 507 DO jbdy = 1, nb_bdy 508 IF( nn_dta(jbdy) == 1 ) THEN 509 REWIND(numnam_ref) 510 READ ( numnam_ref, nambdy_dta, IOSTAT = ios, ERR = 901) 511 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_dta in reference namelist', lwp ) 512 READ ( numnam_cfg, nambdy_dta, IOSTAT = ios, ERR = 902 ) 513 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nambdy_dta in configuration namelist', lwp ) 514 IF(lwm) WRITE( numond, nambdy_dta ) 515 516 cn_dir_array(jbdy) = cn_dir 517 ln_full_vel_array(jbdy) = ln_full_vel 518 519 nblen => idx_bdy(jbdy)%nblen 520 nblenrim => idx_bdy(jbdy)%nblenrim 521 dta => dta_bdy(jbdy) 522 dta%nread(2) = 0 523 524 ! Only read in necessary fields for this set. 525 ! Important that barotropic variables come first. 526 IF( nn_dyn2d_dta(jbdy) == 1 .or. nn_dyn2d_dta(jbdy) == 3 ) THEN 527 528 IF( dta%ll_ssh ) THEN 529 if(lwp) write(numout,*) '++++++ reading in ssh field' 530 jfld = jfld + 1 531 blf_i(jfld) = bn_ssh 532 ibdy(jfld) = jbdy 533 igrid(jfld) = 1 534 ilen1(jfld) = nblen(igrid(jfld)) 535 ilen3(jfld) = 1 536 dta%nread(2) = dta%nread(2) + 1 537 ENDIF 538 539 IF( dta%ll_u2d .and. .not. ln_full_vel_array(jbdy) ) THEN 540 if(lwp) write(numout,*) '++++++ reading in u2d field' 541 jfld = jfld + 1 542 blf_i(jfld) = bn_u2d 543 ibdy(jfld) = jbdy 544 igrid(jfld) = 2 545 ilen1(jfld) = nblen(igrid(jfld)) 546 ilen3(jfld) = 1 547 dta%nread(2) = dta%nread(2) + 1 548 ENDIF 549 550 IF( dta%ll_v2d .and. .not. ln_full_vel_array(jbdy) ) THEN 551 if(lwp) write(numout,*) '++++++ reading in v2d field' 552 jfld = jfld + 1 553 blf_i(jfld) = bn_v2d 554 ibdy(jfld) = jbdy 555 igrid(jfld) = 3 556 ilen1(jfld) = nblen(igrid(jfld)) 557 ilen3(jfld) = 1 558 dta%nread(2) = dta%nread(2) + 1 559 ENDIF 560 561 ENDIF 562 563 ! read 3D velocities if baroclinic velocities require OR if 564 ! barotropic velocities required and ln_full_vel set to .true. 565 IF( nn_dyn3d_dta(jbdy) == 1 .OR. & 566 & ( ln_full_vel_array(jbdy) .AND. ( nn_dyn2d_dta(jbdy) == 1 .OR. nn_dyn2d_dta(jbdy) == 3 ) ) ) THEN 567 568 IF( dta%ll_u3d .OR. ( ln_full_vel_array(jbdy) .and. dta%ll_u2d ) ) THEN 569 if(lwp) write(numout,*) '++++++ reading in u3d field' 570 jfld = jfld + 1 571 blf_i(jfld) = bn_u3d 572 ibdy(jfld) = jbdy 573 igrid(jfld) = 2 574 ilen1(jfld) = nblen(igrid(jfld)) 575 ilen3(jfld) = jpk 576 IF( ln_full_vel_array(jbdy) .and. dta%ll_u2d ) dta%nread(2) = dta%nread(2) + 1 577 ENDIF 578 579 IF( dta%ll_v3d .OR. ( ln_full_vel_array(jbdy) .and. dta%ll_v2d ) ) THEN 580 if(lwp) write(numout,*) '++++++ reading in v3d field' 581 jfld = jfld + 1 582 blf_i(jfld) = bn_v3d 583 ibdy(jfld) = jbdy 584 igrid(jfld) = 3 585 ilen1(jfld) = nblen(igrid(jfld)) 586 ilen3(jfld) = jpk 587 IF( ln_full_vel_array(jbdy) .and. dta%ll_v2d ) dta%nread(2) = dta%nread(2) + 1 588 ENDIF 589 590 ENDIF 591 592 ! temperature and salinity 593 IF( nn_tra_dta(jbdy) == 1 ) THEN 594 595 IF( dta%ll_tem ) THEN 596 if(lwp) write(numout,*) '++++++ reading in tem field' 597 jfld = jfld + 1 598 blf_i(jfld) = bn_tem 599 ibdy(jfld) = jbdy 600 igrid(jfld) = 1 601 ilen1(jfld) = nblen(igrid(jfld)) 602 ilen3(jfld) = jpk 603 ENDIF 604 605 IF( dta%ll_sal ) THEN 606 if(lwp) write(numout,*) '++++++ reading in sal field' 607 jfld = jfld + 1 608 blf_i(jfld) = bn_sal 609 ibdy(jfld) = jbdy 610 igrid(jfld) = 1 611 ilen1(jfld) = nblen(igrid(jfld)) 612 ilen3(jfld) = jpk 613 ENDIF 614 615 ENDIF 414 nbdy_rdstart = 1 415 DO jbdy = 1, nb_bdy 416 417 WRITE(ctmp1, '(a,i2)') 'BDY number ', jbdy 418 WRITE(ctmp2, '(a,i2)') 'block nambdy_dta number ', jbdy 419 420 ! There is only one nambdy_dta block in namelist_ref -> use it for each bdy so we read from the beginning 421 READ ( numnam_ref, nambdy_dta, IOSTAT = ios, ERR = 901) 422 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambdy_dta in reference namelist' ) 423 424 ! by-pass nambdy_dta reading if no input data used in this bdy 425 IF( ( dta_bdy(jbdy)%lneed_dyn2d .AND. MOD(nn_dyn2d_dta(jbdy),2) == 1 ) & 426 & .OR. ( dta_bdy(jbdy)%lneed_dyn3d .AND. nn_dyn3d_dta(jbdy) == 1 ) & 427 & .OR. ( dta_bdy(jbdy)%lneed_tra .AND. nn_tra_dta(jbdy) == 1 ) & 428 & .OR. ( dta_bdy(jbdy)%lneed_ice .AND. nn_ice_dta(jbdy) == 1 ) ) THEN 429 ! 430 ! Need to support possibility of reading more than one 431 ! nambdy_dta from the namelist_cfg internal file. 432 ! Do this by finding the jbdy'th occurence of nambdy_dta in the 433 ! character buffer as the starting point. 434 ! 435 nbdy_loc = INDEX( numnam_cfg( nbdy_rdstart: ), 'nambdy_dta' ) 436 IF( nbdy_loc .GT. 0 ) THEN 437 nbdy_rdstart = nbdy_rdstart + nbdy_loc 438 ELSE 439 WRITE(cerrmsg,'(A,I4,A)') 'Error: entry number ',jbdy,' of nambdy_dta not found' 440 ios = -1 441 CALL ctl_nam ( ios , cerrmsg ) 442 ENDIF 443 READ ( numnam_cfg( MAX( 1, nbdy_rdstart - 2 ): ), nambdy_dta, IOSTAT = ios, ERR = 902) 444 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nambdy_dta in configuration namelist' ) 445 IF(lwm) WRITE( numond, nambdy_dta ) 446 ENDIF 447 448 ! get the number of ice categories in bdy data file (use a_i information to do this) 449 ipl = jpl ! default definition 450 IF( dta_bdy(jbdy)%lneed_ice ) THEN ! if we need ice bdy data 451 IF( nn_ice_dta(jbdy) == 1 ) THEN ! if we get ice bdy data from netcdf file 452 CALL fld_fill( bf(jp_bdya_i,jbdy:jbdy), bn_a_i, cn_dir, 'bdy_dta', 'a_i'//' '//ctmp1, ctmp2 ) ! use namelist info 453 CALL fld_def( bf(jp_bdya_i,jbdy) ) 454 CALL iom_open( bf(jp_bdya_i,jbdy)%clname, bf(jp_bdya_i,jbdy)%num ) 455 idvar = iom_varid( bf(jp_bdya_i,jbdy)%num, bf(jp_bdya_i,jbdy)%clvar, kndims=indims, kdimsz=i4dimsz, lduld=lluld ) 456 IF( indims == 4 .OR. ( indims == 3 .AND. .NOT. lluld ) ) THEN ; ipl = i4dimsz(3) ! xylt or xyl 457 ELSE ; ipl = 1 ! xy or xyt 458 ENDIF 459 CALL iom_close( bf(jp_bdya_i,jbdy)%num ) 460 bf(jp_bdya_i,jbdy)%clrootname = 'NOT USED' ! reset to default value as this subdomain may not need to read this bdy 461 ENDIF 462 ENDIF 616 463 617 464 #if defined key_si3 618 ! sea ice 619 IF( nn_ice_dta(jbdy) == 1 ) THEN 620 ! Test for types of ice input (1cat or Xcat) 621 ! Build file name to find dimensions 622 clname=TRIM( cn_dir )//TRIM(bn_a_i%clname) 623 IF( .NOT. bn_a_i%ln_clim ) THEN 624 WRITE(clname, '(a,"_y",i4.4)' ) TRIM( clname ), nyear ! add year 625 IF( bn_a_i%cltype /= 'yearly' ) WRITE(clname, '(a,"m" ,i2.2)' ) TRIM( clname ), nmonth ! add month 626 ELSE 627 IF( bn_a_i%cltype /= 'yearly' ) WRITE(clname, '(a,"_m",i2.2)' ) TRIM( clname ), nmonth ! add month 628 ENDIF 629 IF( bn_a_i%cltype == 'daily' .OR. bn_a_i%cltype(1:4) == 'week' ) & 630 & WRITE(clname, '(a,"d" ,i2.2)' ) TRIM( clname ), nday ! add day 631 ! 632 CALL iom_open ( clname, inum ) 633 id1 = iom_varid( inum, bn_a_i%clvar, kdimsz=kdimsz, kndims=kndims, ldstop = .FALSE. ) 634 CALL iom_close ( inum ) 635 636 IF ( kndims == 4 ) THEN 637 nice_cat = kdimsz(4) ! Xcat input 638 ELSE 639 nice_cat = 1 ! 1cat input 640 ENDIF 641 ! End test 642 643 IF( dta%ll_a_i ) THEN 644 jfld = jfld + 1 645 blf_i(jfld) = bn_a_i 646 ibdy(jfld) = jbdy 647 igrid(jfld) = 1 648 ilen1(jfld) = nblen(igrid(jfld)) 649 ilen3(jfld) = nice_cat 650 ENDIF 651 652 IF( dta%ll_h_i ) THEN 653 jfld = jfld + 1 654 blf_i(jfld) = bn_h_i 655 ibdy(jfld) = jbdy 656 igrid(jfld) = 1 657 ilen1(jfld) = nblen(igrid(jfld)) 658 ilen3(jfld) = nice_cat 659 ENDIF 660 661 IF( dta%ll_h_s ) THEN 662 jfld = jfld + 1 663 blf_i(jfld) = bn_h_s 664 ibdy(jfld) = jbdy 665 igrid(jfld) = 1 666 ilen1(jfld) = nblen(igrid(jfld)) 667 ilen3(jfld) = nice_cat 668 ENDIF 669 670 ENDIF 671 #endif 672 ! Recalculate field counts 673 !------------------------- 674 IF( jbdy == 1 ) THEN 675 nb_bdy_fld_sum = 0 676 nb_bdy_fld(jbdy) = jfld 677 nb_bdy_fld_sum = jfld 678 ELSE 679 nb_bdy_fld(jbdy) = jfld - nb_bdy_fld_sum 680 nb_bdy_fld_sum = nb_bdy_fld_sum + nb_bdy_fld(jbdy) 681 ENDIF 682 683 dta%nread(1) = nb_bdy_fld(jbdy) 684 685 ENDIF ! nn_dta == 1 686 ENDDO ! jbdy 687 688 DO jfld = 1, nb_bdy_fld_sum 689 ALLOCATE( bf(jfld)%fnow(ilen1(jfld),1,ilen3(jfld)) ) 690 IF( blf_i(jfld)%ln_tint ) ALLOCATE( bf(jfld)%fdta(ilen1(jfld),1,ilen3(jfld),2) ) 691 nbmap_ptr(jfld)%ptr => idx_bdy(ibdy(jfld))%nbmap(:,igrid(jfld)) 692 nbmap_ptr(jfld)%ll_unstruc = ln_coords_file(ibdy(jfld)) 693 ENDDO 694 695 ! fill bf with blf_i and control print 696 !------------------------------------- 697 jstart = 1 698 DO jbdy = 1, nb_bdy 699 jend = jstart - 1 + nb_bdy_fld(jbdy) 700 CALL fld_fill( bf(jstart:jend), blf_i(jstart:jend), cn_dir_array(jbdy), 'bdy_dta', & 701 & 'open boundary conditions', 'nambdy_dta' ) 702 jstart = jend + 1 703 ENDDO 704 705 DO jfld = 1, nb_bdy_fld_sum 706 bf(jfld)%igrd = igrid(jfld) 707 bf(jfld)%ibdy = ibdy(jfld) 708 ENDDO 709 710 ! Initialise local boundary data arrays 711 ! nn_xxx_dta=0 : allocate space - will be filled from initial conditions later 712 ! nn_xxx_dta=1 : point to "fnow" arrays 713 !------------------------------------- 714 715 jfld = 0 716 DO jbdy=1, nb_bdy 717 718 nblen => idx_bdy(jbdy)%nblen 719 dta => dta_bdy(jbdy) 720 721 if(lwp) then 722 write(numout,*) '++++++ dta%ll_ssh = ',dta%ll_ssh 723 write(numout,*) '++++++ dta%ll_u2d = ',dta%ll_u2d 724 write(numout,*) '++++++ dta%ll_v2d = ',dta%ll_v2d 725 write(numout,*) '++++++ dta%ll_u3d = ',dta%ll_u3d 726 write(numout,*) '++++++ dta%ll_v3d = ',dta%ll_v3d 727 write(numout,*) '++++++ dta%ll_tem = ',dta%ll_tem 728 write(numout,*) '++++++ dta%ll_sal = ',dta%ll_sal 729 endif 730 731 IF ( nn_dyn2d_dta(jbdy) == 0 .or. nn_dyn2d_dta(jbdy) == 2 ) THEN 732 if(lwp) write(numout,*) '++++++ dta%ssh/u2d/u3d allocated space' 733 IF( dta%ll_ssh ) ALLOCATE( dta%ssh(nblen(1)) ) 734 IF( dta%ll_u2d ) ALLOCATE( dta%u2d(nblen(2)) ) 735 IF( dta%ll_v2d ) ALLOCATE( dta%v2d(nblen(3)) ) 736 ENDIF 737 IF ( nn_dyn2d_dta(jbdy) == 1 .or. nn_dyn2d_dta(jbdy) == 3 ) THEN 738 IF( dta%ll_ssh ) THEN 739 if(lwp) write(numout,*) '++++++ dta%ssh pointing to fnow' 740 jfld = jfld + 1 741 dta%ssh => bf(jfld)%fnow(:,1,1) 742 ENDIF 743 IF ( dta%ll_u2d ) THEN 744 IF ( ln_full_vel_array(jbdy) ) THEN 745 if(lwp) write(numout,*) '++++++ dta%u2d allocated space' 746 ALLOCATE( dta%u2d(nblen(2)) ) 747 ELSE 748 if(lwp) write(numout,*) '++++++ dta%u2d pointing to fnow' 749 jfld = jfld + 1 750 dta%u2d => bf(jfld)%fnow(:,1,1) 751 ENDIF 752 ENDIF 753 IF ( dta%ll_v2d ) THEN 754 IF ( ln_full_vel_array(jbdy) ) THEN 755 if(lwp) write(numout,*) '++++++ dta%v2d allocated space' 756 ALLOCATE( dta%v2d(nblen(3)) ) 757 ELSE 758 if(lwp) write(numout,*) '++++++ dta%v2d pointing to fnow' 759 jfld = jfld + 1 760 dta%v2d => bf(jfld)%fnow(:,1,1) 761 ENDIF 762 ENDIF 763 ENDIF 764 765 IF ( nn_dyn3d_dta(jbdy) == 0 ) THEN 766 if(lwp) write(numout,*) '++++++ dta%u3d/v3d allocated space' 767 IF( dta%ll_u3d ) ALLOCATE( dta_bdy(jbdy)%u3d(nblen(2),jpk) ) 768 IF( dta%ll_v3d ) ALLOCATE( dta_bdy(jbdy)%v3d(nblen(3),jpk) ) 769 ENDIF 770 IF ( nn_dyn3d_dta(jbdy) == 1 .or. & 771 & ( ln_full_vel_array(jbdy) .and. ( nn_dyn2d_dta(jbdy) == 1 .or. nn_dyn2d_dta(jbdy) == 3 ) ) ) THEN 772 IF ( dta%ll_u3d .or. ( ln_full_vel_array(jbdy) .and. dta%ll_u2d ) ) THEN 773 if(lwp) write(numout,*) '++++++ dta%u3d pointing to fnow' 774 jfld = jfld + 1 775 dta_bdy(jbdy)%u3d => bf(jfld)%fnow(:,1,:) 776 ENDIF 777 IF ( dta%ll_v3d .or. ( ln_full_vel_array(jbdy) .and. dta%ll_v2d ) ) THEN 778 if(lwp) write(numout,*) '++++++ dta%v3d pointing to fnow' 779 jfld = jfld + 1 780 dta_bdy(jbdy)%v3d => bf(jfld)%fnow(:,1,:) 781 ENDIF 782 ENDIF 783 784 IF( nn_tra_dta(jbdy) == 0 ) THEN 785 if(lwp) write(numout,*) '++++++ dta%tem/sal allocated space' 786 IF( dta%ll_tem ) ALLOCATE( dta_bdy(jbdy)%tem(nblen(1),jpk) ) 787 IF( dta%ll_sal ) ALLOCATE( dta_bdy(jbdy)%sal(nblen(1),jpk) ) 788 ELSE 789 IF( dta%ll_tem ) THEN 790 if(lwp) write(numout,*) '++++++ dta%tem pointing to fnow' 791 jfld = jfld + 1 792 dta_bdy(jbdy)%tem => bf(jfld)%fnow(:,1,:) 793 ENDIF 794 IF( dta%ll_sal ) THEN 795 if(lwp) write(numout,*) '++++++ dta%sal pointing to fnow' 796 jfld = jfld + 1 797 dta_bdy(jbdy)%sal => bf(jfld)%fnow(:,1,:) 798 ENDIF 799 ENDIF 800 801 #if defined key_si3 802 IF (cn_ice(jbdy) /= 'none') THEN 803 IF( nn_ice_dta(jbdy) == 0 ) THEN 804 ALLOCATE( dta_bdy(jbdy)%a_i(nblen(1),jpl) ) 805 ALLOCATE( dta_bdy(jbdy)%h_i(nblen(1),jpl) ) 806 ALLOCATE( dta_bdy(jbdy)%h_s(nblen(1),jpl) ) 807 ELSE 808 IF ( nice_cat == jpl ) THEN ! case input cat = jpl 809 jfld = jfld + 1 810 dta_bdy(jbdy)%a_i => bf(jfld)%fnow(:,1,:) 811 jfld = jfld + 1 812 dta_bdy(jbdy)%h_i => bf(jfld)%fnow(:,1,:) 813 jfld = jfld + 1 814 dta_bdy(jbdy)%h_s => bf(jfld)%fnow(:,1,:) 815 ELSE ! case input cat = 1 OR (/=1 and /=jpl) 816 jfld_ait(jbdy) = jfld + 1 817 jfld_htit(jbdy) = jfld + 2 818 jfld_htst(jbdy) = jfld + 3 819 jfld = jfld + 3 820 ALLOCATE( dta_bdy(jbdy)%a_i(nblen(1),jpl) ) 821 ALLOCATE( dta_bdy(jbdy)%h_i(nblen(1),jpl) ) 822 ALLOCATE( dta_bdy(jbdy)%h_s(nblen(1),jpl) ) 823 dta_bdy(jbdy)%a_i(:,:) = 0._wp 824 dta_bdy(jbdy)%h_i(:,:) = 0._wp 825 dta_bdy(jbdy)%h_s(:,:) = 0._wp 826 ENDIF 827 828 ENDIF 465 IF( .NOT.ln_pnd ) THEN 466 rn_ice_apnd = 0. ; rn_ice_hpnd = 0. 467 CALL ctl_warn( 'rn_ice_apnd & rn_ice_hpnd = 0 when no ponds' ) 829 468 ENDIF 830 469 #endif 470 471 ! temp, salt, age and ponds of incoming ice 472 rice_tem (jbdy) = rn_ice_tem 473 rice_sal (jbdy) = rn_ice_sal 474 rice_age (jbdy) = rn_ice_age 475 rice_apnd(jbdy) = rn_ice_apnd 476 rice_hpnd(jbdy) = rn_ice_hpnd 477 478 479 DO jfld = 1, jpbdyfld 480 481 ! ===================== 482 ! ssh 483 ! ===================== 484 IF( jfld == jp_bdyssh ) THEN 485 cl3 = 'ssh' 486 igrd = 1 ! T point 487 ipk = 1 ! surface data 488 llneed = dta_bdy(jbdy)%lneed_ssh ! dta_bdy(jbdy)%ssh will be needed 489 llread = MOD(nn_dyn2d_dta(jbdy),2) == 1 ! get data from NetCDF file 490 bf_alias => bf(jp_bdyssh,jbdy:jbdy) ! alias for ssh structure of bdy number jbdy 491 bn_alias => bn_ssh ! alias for ssh structure of nambdy_dta 492 iszdim = idx_bdy(jbdy)%nblenrim(igrd) ! length of this bdy on this MPI processus : used only on the rim 493 ENDIF 494 ! ===================== 495 ! dyn2d 496 ! ===================== 497 IF( jfld == jp_bdyu2d ) THEN 498 cl3 = 'u2d' 499 igrd = 2 ! U point 500 ipk = 1 ! surface data 501 llneed = dta_bdy(jbdy)%lneed_dyn2d ! dta_bdy(jbdy)%u2d will be needed 502 llread = .NOT. ln_full_vel .AND. MOD(nn_dyn2d_dta(jbdy),2) == 1 ! don't get u2d from u3d and read NetCDF file 503 bf_alias => bf(jp_bdyu2d,jbdy:jbdy) ! alias for u2d structure of bdy number jbdy 504 bn_alias => bn_u2d ! alias for u2d structure of nambdy_dta 505 llfullbdy = ln_full_vel .OR. cn_dyn2d(jbdy) == 'frs' ! need u2d over the whole bdy or only over the rim? 506 IF( llfullbdy ) THEN ; iszdim = idx_bdy(jbdy)%nblen(igrd) 507 ELSE ; iszdim = idx_bdy(jbdy)%nblenrim(igrd) 508 ENDIF 509 ENDIF 510 IF( jfld == jp_bdyv2d ) THEN 511 cl3 = 'v2d' 512 igrd = 3 ! V point 513 ipk = 1 ! surface data 514 llneed = dta_bdy(jbdy)%lneed_dyn2d ! dta_bdy(jbdy)%v2d will be needed 515 llread = .NOT. ln_full_vel .AND. MOD(nn_dyn2d_dta(jbdy),2) == 1 ! don't get v2d from v3d and read NetCDF file 516 bf_alias => bf(jp_bdyv2d,jbdy:jbdy) ! alias for v2d structure of bdy number jbdy 517 bn_alias => bn_v2d ! alias for v2d structure of nambdy_dta 518 llfullbdy = ln_full_vel .OR. cn_dyn2d(jbdy) == 'frs' ! need v2d over the whole bdy or only over the rim? 519 IF( llfullbdy ) THEN ; iszdim = idx_bdy(jbdy)%nblen(igrd) 520 ELSE ; iszdim = idx_bdy(jbdy)%nblenrim(igrd) 521 ENDIF 522 ENDIF 523 ! ===================== 524 ! dyn3d 525 ! ===================== 526 IF( jfld == jp_bdyu3d ) THEN 527 cl3 = 'u3d' 528 igrd = 2 ! U point 529 ipk = jpk ! 3d data 530 llneed = dta_bdy(jbdy)%lneed_dyn3d .OR. & ! dta_bdy(jbdy)%u3d will be needed 531 & ( dta_bdy(jbdy)%lneed_dyn2d .AND. ln_full_vel ) ! u3d needed to compute u2d 532 llread = nn_dyn3d_dta(jbdy) == 1 ! get data from NetCDF file 533 bf_alias => bf(jp_bdyu3d,jbdy:jbdy) ! alias for u3d structure of bdy number jbdy 534 bn_alias => bn_u3d ! alias for u3d structure of nambdy_dta 535 iszdim = idx_bdy(jbdy)%nblen(igrd) ! length of this bdy on this MPI processus 536 ENDIF 537 IF( jfld == jp_bdyv3d ) THEN 538 cl3 = 'v3d' 539 igrd = 3 ! V point 540 ipk = jpk ! 3d data 541 llneed = dta_bdy(jbdy)%lneed_dyn3d .OR. & ! dta_bdy(jbdy)%v3d will be needed 542 & ( dta_bdy(jbdy)%lneed_dyn2d .AND. ln_full_vel ) ! v3d needed to compute v2d 543 llread = nn_dyn3d_dta(jbdy) == 1 ! get data from NetCDF file 544 bf_alias => bf(jp_bdyv3d,jbdy:jbdy) ! alias for v3d structure of bdy number jbdy 545 bn_alias => bn_v3d ! alias for v3d structure of nambdy_dta 546 iszdim = idx_bdy(jbdy)%nblen(igrd) ! length of this bdy on this MPI processus 547 ENDIF 548 549 ! ===================== 550 ! tra 551 ! ===================== 552 IF( jfld == jp_bdytem ) THEN 553 cl3 = 'tem' 554 igrd = 1 ! T point 555 ipk = jpk ! 3d data 556 llneed = dta_bdy(jbdy)%lneed_tra ! dta_bdy(jbdy)%tem will be needed 557 llread = nn_tra_dta(jbdy) == 1 ! get data from NetCDF file 558 bf_alias => bf(jp_bdytem,jbdy:jbdy) ! alias for ssh structure of bdy number jbdy 559 bn_alias => bn_tem ! alias for ssh structure of nambdy_dta 560 iszdim = idx_bdy(jbdy)%nblen(igrd) ! length of this bdy on this MPI processus 561 ENDIF 562 IF( jfld == jp_bdysal ) THEN 563 cl3 = 'sal' 564 igrd = 1 ! T point 565 ipk = jpk ! 3d data 566 llneed = dta_bdy(jbdy)%lneed_tra ! dta_bdy(jbdy)%sal will be needed 567 llread = nn_tra_dta(jbdy) == 1 ! get data from NetCDF file 568 bf_alias => bf(jp_bdysal,jbdy:jbdy) ! alias for ssh structure of bdy number jbdy 569 bn_alias => bn_sal ! alias for ssh structure of nambdy_dta 570 iszdim = idx_bdy(jbdy)%nblen(igrd) ! length of this bdy on this MPI processus 571 ENDIF 572 573 ! ===================== 574 ! ice 575 ! ===================== 576 IF( jfld == jp_bdya_i .OR. jfld == jp_bdyh_i .OR. jfld == jp_bdyh_s .OR. & 577 & jfld == jp_bdyt_i .OR. jfld == jp_bdyt_s .OR. jfld == jp_bdytsu .OR. & 578 & jfld == jp_bdys_i .OR. jfld == jp_bdyaip .OR. jfld == jp_bdyhip ) THEN 579 igrd = 1 ! T point 580 ipk = ipl ! jpl-cat data 581 llneed = dta_bdy(jbdy)%lneed_ice ! ice will be needed 582 llread = nn_ice_dta(jbdy) == 1 ! get data from NetCDF file 583 iszdim = idx_bdy(jbdy)%nblen(igrd) ! length of this bdy on this MPI processus 584 ENDIF 585 IF( jfld == jp_bdya_i ) THEN 586 cl3 = 'a_i' 587 bf_alias => bf(jp_bdya_i,jbdy:jbdy) ! alias for a_i structure of bdy number jbdy 588 bn_alias => bn_a_i ! alias for a_i structure of nambdy_dta 589 ENDIF 590 IF( jfld == jp_bdyh_i ) THEN 591 cl3 = 'h_i' 592 bf_alias => bf(jp_bdyh_i,jbdy:jbdy) ! alias for h_i structure of bdy number jbdy 593 bn_alias => bn_h_i ! alias for h_i structure of nambdy_dta 594 ENDIF 595 IF( jfld == jp_bdyh_s ) THEN 596 cl3 = 'h_s' 597 bf_alias => bf(jp_bdyh_s,jbdy:jbdy) ! alias for h_s structure of bdy number jbdy 598 bn_alias => bn_h_s ! alias for h_s structure of nambdy_dta 599 ENDIF 600 IF( jfld == jp_bdyt_i ) THEN 601 cl3 = 't_i' 602 bf_alias => bf(jp_bdyt_i,jbdy:jbdy) ! alias for t_i structure of bdy number jbdy 603 bn_alias => bn_t_i ! alias for t_i structure of nambdy_dta 604 ENDIF 605 IF( jfld == jp_bdyt_s ) THEN 606 cl3 = 't_s' 607 bf_alias => bf(jp_bdyt_s,jbdy:jbdy) ! alias for t_s structure of bdy number jbdy 608 bn_alias => bn_t_s ! alias for t_s structure of nambdy_dta 609 ENDIF 610 IF( jfld == jp_bdytsu ) THEN 611 cl3 = 'tsu' 612 bf_alias => bf(jp_bdytsu,jbdy:jbdy) ! alias for tsu structure of bdy number jbdy 613 bn_alias => bn_tsu ! alias for tsu structure of nambdy_dta 614 ENDIF 615 IF( jfld == jp_bdys_i ) THEN 616 cl3 = 's_i' 617 bf_alias => bf(jp_bdys_i,jbdy:jbdy) ! alias for s_i structure of bdy number jbdy 618 bn_alias => bn_s_i ! alias for s_i structure of nambdy_dta 619 ENDIF 620 IF( jfld == jp_bdyaip ) THEN 621 cl3 = 'aip' 622 bf_alias => bf(jp_bdyaip,jbdy:jbdy) ! alias for aip structure of bdy number jbdy 623 bn_alias => bn_aip ! alias for aip structure of nambdy_dta 624 ENDIF 625 IF( jfld == jp_bdyhip ) THEN 626 cl3 = 'hip' 627 bf_alias => bf(jp_bdyhip,jbdy:jbdy) ! alias for hip structure of bdy number jbdy 628 bn_alias => bn_hip ! alias for hip structure of nambdy_dta 629 ENDIF 630 631 IF( llneed .AND. iszdim > 0 ) THEN ! dta_bdy(jbdy)%xxx will be needed 632 ! ! -> must be associated with an allocated target 633 ALLOCATE( bf_alias(1)%fnow( iszdim, 1, ipk ) ) ! allocate the target 634 ! 635 IF( llread ) THEN ! get data from NetCDF file 636 CALL fld_fill( bf_alias, bn_alias, cn_dir, 'bdy_dta', cl3//' '//ctmp1, ctmp2 ) ! use namelist info 637 IF( bf_alias(1)%ln_tint ) ALLOCATE( bf_alias(1)%fdta( iszdim, 1, ipk, 2 ) ) 638 bf_alias(1)%imap => idx_bdy(jbdy)%nbmap(1:iszdim,igrd) ! associate the mapping used for this bdy 639 bf_alias(1)%igrd = igrd ! used only for vertical integration of 3D arrays 640 bf_alias(1)%ibdy = jbdy ! " " " " " " " " 641 bf_alias(1)%ltotvel = ln_full_vel ! T if u3d is full velocity 642 bf_alias(1)%lzint = ln_zinterp ! T if it requires a vertical interpolation 643 ENDIF 644 645 ! associate the pointer and get rid of the dimensions with a size equal to 1 646 IF( jfld == jp_bdyssh ) dta_bdy(jbdy)%ssh => bf_alias(1)%fnow(:,1,1) 647 IF( jfld == jp_bdyu2d ) dta_bdy(jbdy)%u2d => bf_alias(1)%fnow(:,1,1) 648 IF( jfld == jp_bdyv2d ) dta_bdy(jbdy)%v2d => bf_alias(1)%fnow(:,1,1) 649 IF( jfld == jp_bdyu3d ) dta_bdy(jbdy)%u3d => bf_alias(1)%fnow(:,1,:) 650 IF( jfld == jp_bdyv3d ) dta_bdy(jbdy)%v3d => bf_alias(1)%fnow(:,1,:) 651 IF( jfld == jp_bdytem ) dta_bdy(jbdy)%tem => bf_alias(1)%fnow(:,1,:) 652 IF( jfld == jp_bdysal ) dta_bdy(jbdy)%sal => bf_alias(1)%fnow(:,1,:) 653 IF( jfld == jp_bdya_i ) THEN 654 IF( ipk == jpl ) THEN ; dta_bdy(jbdy)%a_i => bf_alias(1)%fnow(:,1,:) 655 ELSE ; ALLOCATE( dta_bdy(jbdy)%a_i(iszdim,jpl) ) 656 ENDIF 657 ENDIF 658 IF( jfld == jp_bdyh_i ) THEN 659 IF( ipk == jpl ) THEN ; dta_bdy(jbdy)%h_i => bf_alias(1)%fnow(:,1,:) 660 ELSE ; ALLOCATE( dta_bdy(jbdy)%h_i(iszdim,jpl) ) 661 ENDIF 662 ENDIF 663 IF( jfld == jp_bdyh_s ) THEN 664 IF( ipk == jpl ) THEN ; dta_bdy(jbdy)%h_s => bf_alias(1)%fnow(:,1,:) 665 ELSE ; ALLOCATE( dta_bdy(jbdy)%h_s(iszdim,jpl) ) 666 ENDIF 667 ENDIF 668 IF( jfld == jp_bdyt_i ) THEN 669 IF( ipk == jpl ) THEN ; dta_bdy(jbdy)%t_i => bf_alias(1)%fnow(:,1,:) 670 ELSE ; ALLOCATE( dta_bdy(jbdy)%t_i(iszdim,jpl) ) 671 ENDIF 672 ENDIF 673 IF( jfld == jp_bdyt_s ) THEN 674 IF( ipk == jpl ) THEN ; dta_bdy(jbdy)%t_s => bf_alias(1)%fnow(:,1,:) 675 ELSE ; ALLOCATE( dta_bdy(jbdy)%t_s(iszdim,jpl) ) 676 ENDIF 677 ENDIF 678 IF( jfld == jp_bdytsu ) THEN 679 IF( ipk == jpl ) THEN ; dta_bdy(jbdy)%tsu => bf_alias(1)%fnow(:,1,:) 680 ELSE ; ALLOCATE( dta_bdy(jbdy)%tsu(iszdim,jpl) ) 681 ENDIF 682 ENDIF 683 IF( jfld == jp_bdys_i ) THEN 684 IF( ipk == jpl ) THEN ; dta_bdy(jbdy)%s_i => bf_alias(1)%fnow(:,1,:) 685 ELSE ; ALLOCATE( dta_bdy(jbdy)%s_i(iszdim,jpl) ) 686 ENDIF 687 ENDIF 688 IF( jfld == jp_bdyaip ) THEN 689 IF( ipk == jpl ) THEN ; dta_bdy(jbdy)%aip => bf_alias(1)%fnow(:,1,:) 690 ELSE ; ALLOCATE( dta_bdy(jbdy)%aip(iszdim,jpl) ) 691 ENDIF 692 ENDIF 693 IF( jfld == jp_bdyhip ) THEN 694 IF( ipk == jpl ) THEN ; dta_bdy(jbdy)%hip => bf_alias(1)%fnow(:,1,:) 695 ELSE ; ALLOCATE( dta_bdy(jbdy)%hip(iszdim,jpl) ) 696 ENDIF 697 ENDIF 698 ENDIF 699 700 END DO ! jpbdyfld 831 701 ! 832 702 END DO ! jbdy 833 703 ! 834 704 END SUBROUTINE bdy_dta_init 835 705 836 706 !!============================================================================== 837 707 END MODULE bdydta
Note: See TracChangeset
for help on using the changeset viewer.
