Changeset 11822 for NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/BDY/bdydta.F90
- Timestamp:
- 2019-10-29T11:41:36+01:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/BDY/bdydta.F90
r11480 r11822 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, Kmm, time_offset )77 SUBROUTINE bdy_dta( kt, Kmm, kit, kt_offset ) 68 78 !!---------------------------------------------------------------------- 69 79 !! *** SUBROUTINE bdy_dta *** … … 76 86 INTEGER, INTENT(in) :: kt ! ocean time-step index 77 87 INTEGER, INTENT(in) :: Kmm ! ocean time level index 78 INTEGER, INTENT(in), OPTIONAL :: time_offset ! time offset in units of timesteps. NB. if jit 88 INTEGER, INTENT(in), OPTIONAL :: kit ! subcycle time-step index (for timesplitting option) 89 INTEGER, INTENT(in), OPTIONAL :: kt_offset ! time offset in units of timesteps. NB. if kit 79 90 ! ! 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 level91 ! ! kt_offset = 0 => get data at "now" time level 92 ! ! kt_offset = -1 => get data at "before" time level 93 ! ! kt_offset = +1 => get data at "after" time level 83 94 ! ! etc. 84 95 ! 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 96 INTEGER :: jbdy, jfld, jstart, jend, ib, jl ! dummy loop indices 97 INTEGER :: ii, ij, ik, igrd, ipl ! local integers 98 INTEGER, DIMENSION(jpbgrd) :: ilen1 99 INTEGER, DIMENSION(:), POINTER :: nblen, nblenrim ! short cuts 100 TYPE(OBC_DATA) , POINTER :: dta_alias ! short cut 101 TYPE(FLD), DIMENSION(:), POINTER :: bf_alias 90 102 !!--------------------------------------------------------------------------- 91 103 ! … … 94 106 ! Initialise data arrays once for all from initial conditions where required 95 107 !--------------------------------------------------------------------------- 96 IF( kt == nit000 ) THEN108 IF( kt == nit000 .AND. .NOT.PRESENT(kit) ) THEN 97 109 98 110 ! Calculate depth-mean currents 99 111 !----------------------------- 100 112 101 113 DO jbdy = 1, nb_bdy 102 114 ! 103 115 nblen => idx_bdy(jbdy)%nblen 104 116 nblenrim => idx_bdy(jbdy)%nblenrim 105 dta => dta_bdy(jbdy)106 117 ! 107 118 IF( nn_dyn2d_dta(jbdy) == 0 ) THEN 108 119 ilen1(:) = nblen(:) 109 IF( dta %ll_ssh ) THEN120 IF( dta_bdy(jbdy)%lneed_ssh ) THEN 110 121 igrd = 1 111 122 DO ib = 1, ilen1(igrd) … … 113 124 ij = idx_bdy(jbdy)%nbj(ib,igrd) 114 125 dta_bdy(jbdy)%ssh(ib) = ssh(ii,ij,Kmm) * tmask(ii,ij,1) 115 END DO 116 ENDIF 117 IF( dta %ll_u2d) THEN126 END DO 127 ENDIF 128 IF( dta_bdy(jbdy)%lneed_dyn2d) THEN 118 129 igrd = 2 119 130 DO ib = 1, ilen1(igrd) … … 121 132 ij = idx_bdy(jbdy)%nbj(ib,igrd) 122 133 dta_bdy(jbdy)%u2d(ib) = uu_b(ii,ij,Kmm) * umask(ii,ij,1) 123 END DO 124 ENDIF 125 IF( dta%ll_v2d ) THEN 134 END DO 126 135 igrd = 3 127 136 DO ib = 1, ilen1(igrd) … … 129 138 ij = idx_bdy(jbdy)%nbj(ib,igrd) 130 139 dta_bdy(jbdy)%v2d(ib) = vv_b(ii,ij,Kmm) * vmask(ii,ij,1) 131 END DO 140 END DO 132 141 ENDIF 133 142 ENDIF … … 135 144 IF( nn_dyn3d_dta(jbdy) == 0 ) THEN 136 145 ilen1(:) = nblen(:) 137 IF( dta %ll_u3d ) THEN146 IF( dta_bdy(jbdy)%lneed_dyn3d ) THEN 138 147 igrd = 2 139 148 DO ib = 1, ilen1(igrd) … … 143 152 dta_bdy(jbdy)%u3d(ib,ik) = ( uu(ii,ij,ik,Kmm) - uu_b(ii,ij,Kmm) ) * umask(ii,ij,ik) 144 153 END DO 145 END DO 146 ENDIF 147 IF( dta%ll_v3d ) THEN 154 END DO 148 155 igrd = 3 149 156 DO ib = 1, ilen1(igrd) … … 152 159 ij = idx_bdy(jbdy)%nbj(ib,igrd) 153 160 dta_bdy(jbdy)%v3d(ib,ik) = ( vv(ii,ij,ik,Kmm) - vv_b(ii,ij,Kmm) ) * vmask(ii,ij,ik) 154 155 END DO 161 END DO 162 END DO 156 163 ENDIF 157 164 ENDIF … … 159 166 IF( nn_tra_dta(jbdy) == 0 ) THEN 160 167 ilen1(:) = nblen(:) 161 IF( dta %ll_tem) THEN168 IF( dta_bdy(jbdy)%lneed_tra ) THEN 162 169 igrd = 1 163 170 DO ib = 1, ilen1(igrd) … … 165 172 ii = idx_bdy(jbdy)%nbi(ib,igrd) 166 173 ij = idx_bdy(jbdy)%nbj(ib,igrd) 167 dta_bdy(jbdy)%tem(ib,ik) = ts(ii,ij,ik,jp_tem,Kmm) * tmask(ii,ij,ik) 174 dta_bdy(jbdy)%tem(ib,ik) = ts(ii,ij,ik,jp_bdytem,Kmm) * tmask(ii,ij,ik) 175 dta_bdy(jbdy)%sal(ib,ik) = ts(ii,ij,ik,jp_bdysal,Kmm) * tmask(ii,ij,ik) 168 176 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) = ts(ii,ij,ik,jp_sal,Kmm) * tmask(ii,ij,ik) 178 END DO 179 END DO 177 END DO 180 178 ENDIF 181 179 ENDIF … … 184 182 IF( nn_ice_dta(jbdy) == 0 ) THEN ! set ice to initial values 185 183 ilen1(:) = nblen(:) 186 IF( dta %ll_a_i) THEN184 IF( dta_bdy(jbdy)%lneed_ice ) THEN 187 185 igrd = 1 188 186 DO jl = 1, jpl … … 190 188 ii = idx_bdy(jbdy)%nbi(ib,igrd) 191 189 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) 190 dta_bdy(jbdy)%a_i(ib,jl) = a_i (ii,ij,jl) * tmask(ii,ij,1) 191 dta_bdy(jbdy)%h_i(ib,jl) = h_i (ii,ij,jl) * tmask(ii,ij,1) 192 dta_bdy(jbdy)%h_s(ib,jl) = h_s (ii,ij,jl) * tmask(ii,ij,1) 193 dta_bdy(jbdy)%t_i(ib,jl) = SUM(t_i (ii,ij,:,jl)) * r1_nlay_i * tmask(ii,ij,1) 194 dta_bdy(jbdy)%t_s(ib,jl) = SUM(t_s (ii,ij,:,jl)) * r1_nlay_s * tmask(ii,ij,1) 195 dta_bdy(jbdy)%tsu(ib,jl) = t_su(ii,ij,jl) * tmask(ii,ij,1) 196 dta_bdy(jbdy)%s_i(ib,jl) = s_i (ii,ij,jl) * tmask(ii,ij,1) 197 ! melt ponds 198 dta_bdy(jbdy)%aip(ib,jl) = a_ip(ii,ij,jl) * tmask(ii,ij,1) 199 dta_bdy(jbdy)%hip(ib,jl) = h_ip(ii,ij,jl) * tmask(ii,ij,1) 213 200 END DO 214 201 END DO … … 222 209 ! update external data from files 223 210 !-------------------------------- 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 IF (cn_tra(jbdy) == 'runoff') then ! runoff condition 230 jend = nb_bdy_fld(jbdy) 231 CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), & 232 & map=nbmap_ptr(jstart:jend), kt_offset=time_offset ) 233 ! 234 igrd = 2 ! zonal velocity 235 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 236 ii = idx_bdy(jbdy)%nbi(ib,igrd) 237 ij = idx_bdy(jbdy)%nbj(ib,igrd) 238 dta%u2d(ib) = dta%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) ) 211 212 DO jbdy = 1, nb_bdy 213 214 dta_alias => dta_bdy(jbdy) 215 bf_alias => bf(:,jbdy) 216 217 ! read/update all bdy data 218 ! ------------------------ 219 CALL fld_read( kt, 1, bf_alias, kit = kit, kt_offset = kt_offset ) 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(ii,ij,ik,Kmm) * umask(ii,ij,ik) * dta_alias%u3d(ib,ik) 239 257 END DO 240 ! 241 igrd = 3 ! meridional velocity 242 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 243 ii = idx_bdy(jbdy)%nbi(ib,igrd) 244 ij = idx_bdy(jbdy)%nbj(ib,igrd) 245 dta%v2d(ib) = dta%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) ) 258 dta_alias%u2d(ib) = dta_alias%u2d(ib) * r1_hu(ii,ij,Kmm) 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) 246 261 END DO 247 ELSE 248 IF( nn_dyn2d_dta(jbdy) == 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays 249 IF( dta%ll_ssh ) dta%ssh(:) = 0._wp 250 IF( dta%ll_u2d ) dta%u2d(:) = 0._wp 251 IF( dta%ll_v2d ) dta%v2d(:) = 0._wp 252 ENDIF 253 IF( dta%nread(1) .gt. 0 ) THEN ! update external data 254 jend = jstart + dta%nread(1) - 1 255 CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), & 256 & map=nbmap_ptr(jstart:jend), kt_offset=time_offset, jpk_bdy=nb_jpk_bdy, & 257 & fvl=ln_full_vel_array(jbdy), Kmm=Kmm ) 258 ENDIF 259 ! If full velocities in boundary data then split into barotropic and baroclinic data 260 IF( ln_full_vel_array(jbdy) .and. & 261 & ( nn_dyn2d_dta(jbdy) == 1 .OR. nn_dyn2d_dta(jbdy) == 3 .OR. & 262 & nn_dyn3d_dta(jbdy) == 1 ) ) THEN 263 igrd = 2 ! zonal velocity 264 dta%u2d(:) = 0._wp 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%u2d(ib) = dta%u2d(ib) & 270 & + e3u(ii,ij,ik,Kmm) * umask(ii,ij,ik) * dta%u3d(ib,ik) 271 END DO 272 dta%u2d(ib) = dta%u2d(ib) * r1_hu(ii,ij,Kmm) 273 DO ik = 1, jpkm1 274 dta%u3d(ib,ik) = dta%u3d(ib,ik) - dta%u2d(ib) 275 END DO 276 END DO 277 igrd = 3 ! meridional velocity 278 dta%v2d(:) = 0._wp 279 DO ib = 1, idx_bdy(jbdy)%nblen(igrd) 280 ii = idx_bdy(jbdy)%nbi(ib,igrd) 281 ij = idx_bdy(jbdy)%nbj(ib,igrd) 282 DO ik = 1, jpkm1 283 dta%v2d(ib) = dta%v2d(ib) & 284 & + e3v(ii,ij,ik,Kmm) * vmask(ii,ij,ik) * dta%v3d(ib,ik) 285 END DO 286 dta%v2d(ib) = dta%v2d(ib) * r1_hv(ii,ij,Kmm) 287 DO ik = 1, jpkm1 288 dta%v3d(ib,ik) = dta%v3d(ib,ik) - dta%v2d(ib) 289 END DO 290 END DO 291 ENDIF 292 293 ENDIF 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(ii,ij,ik,Kmm) * vmask(ii,ij,ik) * dta_alias%v3d(ib,ik) 270 END DO 271 dta_alias%v2d(ib) = dta_alias%v2d(ib) * r1_hv(ii,ij,Kmm) 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 294 294 #if defined key_si3 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 295 323 ! convert N-cat fields (input) into jpl-cat (output) 296 IF( cn_ice(jbdy) /= 'none' .AND. nn_ice_dta(jbdy) == 1 ) THEN297 jfld_hti = jfld_htit(jbdy)298 jfld_hts = jfld_htst(jbdy)299 jfld_ai = jfld_ait(jbdy)300 IF ( jpl /= 1 .AND. nice_cat == 1 ) THEN ! case input cat = 1301 CALL ice_var_itd ( bf(jfld_hti)%fnow(:,1,1), bf(jfld_hts)%fnow(:,1,1), bf(jfld_ai)%fnow(:,1,1), &302 & dta_bdy(jbdy)%h_i , dta_bdy(jbdy)%h_s , dta_bdy(jbdy)%a_i )303 ELSEIF( jpl /= 1 .AND. nice_cat /= 1 .AND. nice_cat /= jpl ) THEN ! case input cat /=1 and /=jpl304 CALL ice_var_itd2( bf(jfld_hti)%fnow(:,1,:), bf(jfld_hts)%fnow(:,1,:), bf(jfld_ai)%fnow(:,1,:), &305 & dta_bdy(jbdy)%h_i , dta_bdy(jbdy)%h_s , dta_bdy(jbdy)%a_i)306 307 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 308 336 #endif 309 jstart = jstart + dta%nread(1)310 ENDIF ! nn_dta(jbdy) = 1311 337 END DO ! jbdy 312 313 IF ( ln_apr_obc ) THEN314 DO jbdy = 1, nb_bdy315 IF (cn_tra(jbdy) /= 'runoff')THEN316 igrd = 1 ! meridional velocity317 DO ib = 1, idx_bdy(jbdy)%nblenrim(igrd)318 ii = idx_bdy(jbdy)%nbi(ib,igrd)319 ij = idx_bdy(jbdy)%nbj(ib,igrd)320 dta_bdy(jbdy)%ssh(ib) = dta_bdy(jbdy)%ssh(ib) + ssh_ib(ii,ij)321 END DO322 ENDIF323 END DO324 ENDIF325 338 326 339 IF ( ln_tide ) THEN 327 340 IF (ln_dynspg_ts) THEN ! Fill temporary arrays with slow-varying bdy data 328 DO jbdy = 1, nb_bdy ! Tidal component added in ts loop329 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 330 343 nblen => idx_bdy(jbdy)%nblen 331 344 nblenrim => idx_bdy(jbdy)%nblenrim 332 IF( cn_dyn2d(jbdy) == 'frs' ) THEN; ilen1(:)=nblen(:) ; ELSE ; ilen1(:)=nblenrim(:) ; ENDIF 333 IF ( dta_bdy(jbdy)%ll_ssh ) dta_bdy_s(jbdy)%ssh(1:ilen1(1)) = dta_bdy(jbdy)%ssh(1:ilen1(1)) 334 IF ( dta_bdy(jbdy)%ll_u2d ) dta_bdy_s(jbdy)%u2d(1:ilen1(2)) = dta_bdy(jbdy)%u2d(1:ilen1(2)) 335 IF ( dta_bdy(jbdy)%ll_v2d ) dta_bdy_s(jbdy)%v2d(1:ilen1(3)) = dta_bdy(jbdy)%v2d(1:ilen1(3)) 336 ENDIF 337 END DO 338 ELSE ! Add tides if not split-explicit free surface else this is done in ts loop 339 ! 340 CALL bdy_dta_tides( kt=kt, time_offset=time_offset ) 341 ENDIF 342 ENDIF 343 344 ! 345 IF( ln_timing ) CALL timing_stop('bdy_dta') 346 ! 347 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 348 360 349 361 … … 358 370 !! 359 371 !!---------------------------------------------------------------------- 360 INTEGER :: jbdy, jfld, jstart, jend, ierror, ios ! Local integers 372 INTEGER :: jbdy, jfld ! Local integers 373 INTEGER :: ierror, ios ! 361 374 ! 375 CHARACTER(len=3) :: cl3 ! 362 376 CHARACTER(len=100) :: cn_dir ! Root directory for location of data files 363 CHARACTER(len=100), DIMENSION(nb_bdy) :: cn_dir_array ! Root directory for location of data files364 CHARACTER(len = 256):: clname ! temporary file name365 377 LOGICAL :: ln_full_vel ! =T => full velocities in 3D boundary data 366 378 ! ! =F => baroclinic velocities in 3D boundary data 367 INTEGER :: ilen_global ! Max length required for global bdy dta arrays368 INTEGER, ALLOCATABLE, DIMENSION(:) :: ilen1, ilen3 ! size of 1st and 3rd dimensions of local arrays369 INTEGER , ALLOCATABLE, DIMENSION(:) :: ibdy ! bdy set for a particular jfld370 INTEGER , ALLOCATABLE, DIMENSION(:) :: igrid ! index for grid type (1,2,3 = T,U,V)371 INTEGER , POINTER, DIMENSION(:) :: nblen, nblenrim ! short cuts372 TYPE(OBC_DATA), POINTER :: dta ! short cut373 #if defined key_si3 374 INTEGER :: kndims ! number of dimensions in an array (i.e. 3 = wo ice cat; 4 = w ice cat)375 INTEGER, DIMENSION(4) :: kdimsz ! size of dimensions376 INTEGER :: inum,id1 ! local integer377 #endif 378 TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: blf_i ! array of namelist information structures379 TYPE(FLD_N) :: bn_tem, bn_sal, bn_u3d, bn_v3d !380 TYPE(FLD_N) :: bn_ssh, bn_u2d, bn_v2d ! informations about the fields to be read381 #if defined key_si3 382 TYPE(FLD _N) :: bn_a_i, bn_h_i, bn_h_s383 #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 ! 384 396 NAMELIST/nambdy_dta/ cn_dir, bn_tem, bn_sal, bn_u3d, bn_v3d, bn_ssh, bn_u2d, bn_v2d 385 #if defined key_si3 386 NAMELIST/nambdy_dta/ bn_a_i, bn_h_i, bn_h_s 387 #endif 388 NAMELIST/nambdy_dta/ ln_full_vel, nb_jpk_bdy 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 389 400 !!--------------------------------------------------------------------------- 390 401 ! … … 394 405 IF(lwp) WRITE(numout,*) '' 395 406 396 ! Set nn_dta 397 DO jbdy = 1, nb_bdy 398 nn_dta(jbdy) = MAX( nn_dyn2d_dta (jbdy) & 399 & , nn_dyn3d_dta (jbdy) & 400 & , nn_tra_dta (jbdy) & 401 #if defined key_si3 402 & , nn_ice_dta (jbdy) & 403 #endif 404 ) 405 IF(nn_dta(jbdy) > 1) nn_dta(jbdy) = 1 406 END DO 407 408 ! Work out upper bound of how many fields there are to read in and allocate arrays 409 ! --------------------------------------------------------------------------- 410 ALLOCATE( nb_bdy_fld(nb_bdy) ) 411 nb_bdy_fld(:) = 0 412 DO jbdy = 1, nb_bdy 413 IF( cn_dyn2d(jbdy) /= 'none' .AND. ( nn_dyn2d_dta(jbdy) == 1 .or. nn_dyn2d_dta(jbdy) == 3 ) ) THEN 414 nb_bdy_fld(jbdy) = nb_bdy_fld(jbdy) + 3 415 ENDIF 416 IF( cn_dyn3d(jbdy) /= 'none' .AND. nn_dyn3d_dta(jbdy) == 1 ) THEN 417 nb_bdy_fld(jbdy) = nb_bdy_fld(jbdy) + 2 418 ENDIF 419 IF( cn_tra(jbdy) /= 'none' .AND. nn_tra_dta(jbdy) == 1 ) THEN 420 nb_bdy_fld(jbdy) = nb_bdy_fld(jbdy) + 2 421 ENDIF 422 #if defined key_si3 423 IF( cn_ice(jbdy) /= 'none' .AND. nn_ice_dta(jbdy) == 1 ) THEN 424 nb_bdy_fld(jbdy) = nb_bdy_fld(jbdy) + 3 425 ENDIF 426 #endif 427 IF(lwp) WRITE(numout,*) 'Maximum number of files to open =', nb_bdy_fld(jbdy) 428 END DO 429 430 nb_bdy_fld_sum = SUM( nb_bdy_fld ) 431 432 ALLOCATE( bf(nb_bdy_fld_sum), STAT=ierror ) 407 ALLOCATE( bf(jpbdyfld,nb_bdy), STAT=ierror ) 433 408 IF( ierror > 0 ) THEN 434 409 CALL ctl_stop( 'bdy_dta: unable to allocate bf structure' ) ; RETURN 435 410 ENDIF 436 ALLOCATE( blf_i(nb_bdy_fld_sum), STAT=ierror ) 437 IF( ierror > 0 ) THEN 438 CALL ctl_stop( 'bdy_dta: unable to allocate blf_i structure' ) ; RETURN 439 ENDIF 440 ALLOCATE( nbmap_ptr(nb_bdy_fld_sum), STAT=ierror ) 441 IF( ierror > 0 ) THEN 442 CALL ctl_stop( 'bdy_dta: unable to allocate nbmap_ptr structure' ) ; RETURN 443 ENDIF 444 ALLOCATE( ilen1(nb_bdy_fld_sum), ilen3(nb_bdy_fld_sum) ) 445 ALLOCATE( ibdy(nb_bdy_fld_sum) ) 446 ALLOCATE( igrid(nb_bdy_fld_sum) ) 447 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 448 415 ! Read namelists 449 416 ! -------------- 450 REWIND(numnam_ref)451 417 REWIND(numnam_cfg) 452 jfld = 0 453 DO jbdy = 1, nb_bdy 454 IF( nn_dta(jbdy) == 1 ) THEN 455 READ ( numnam_ref, nambdy_dta, IOSTAT = ios, ERR = 901) 456 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 457 434 READ ( numnam_cfg, nambdy_dta, IOSTAT = ios, ERR = 902 ) 458 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nambdy_dta in configuration namelist', lwp ) 459 IF(lwm) WRITE( numond, nambdy_dta ) 460 461 cn_dir_array(jbdy) = cn_dir 462 ln_full_vel_array(jbdy) = ln_full_vel 463 464 nblen => idx_bdy(jbdy)%nblen 465 nblenrim => idx_bdy(jbdy)%nblenrim 466 dta => dta_bdy(jbdy) 467 dta%nread(2) = 0 468 469 ! Only read in necessary fields for this set. 470 ! Important that barotropic variables come first. 471 IF( nn_dyn2d_dta(jbdy) == 1 .or. nn_dyn2d_dta(jbdy) == 3 ) THEN 472 473 IF( dta%ll_ssh ) THEN 474 if(lwp) write(numout,*) '++++++ reading in ssh field' 475 jfld = jfld + 1 476 blf_i(jfld) = bn_ssh 477 ibdy(jfld) = jbdy 478 igrid(jfld) = 1 479 ilen1(jfld) = nblen(igrid(jfld)) 480 ilen3(jfld) = 1 481 dta%nread(2) = dta%nread(2) + 1 482 ENDIF 483 484 IF( dta%ll_u2d .and. .not. ln_full_vel_array(jbdy) ) THEN 485 if(lwp) write(numout,*) '++++++ reading in u2d field' 486 jfld = jfld + 1 487 blf_i(jfld) = bn_u2d 488 ibdy(jfld) = jbdy 489 igrid(jfld) = 2 490 ilen1(jfld) = nblen(igrid(jfld)) 491 ilen3(jfld) = 1 492 dta%nread(2) = dta%nread(2) + 1 493 ENDIF 494 495 IF( dta%ll_v2d .and. .not. ln_full_vel_array(jbdy) ) THEN 496 if(lwp) write(numout,*) '++++++ reading in v2d field' 497 jfld = jfld + 1 498 blf_i(jfld) = bn_v2d 499 ibdy(jfld) = jbdy 500 igrid(jfld) = 3 501 ilen1(jfld) = nblen(igrid(jfld)) 502 ilen3(jfld) = 1 503 dta%nread(2) = dta%nread(2) + 1 504 ENDIF 505 506 ENDIF 507 508 ! read 3D velocities if baroclinic velocities require OR if 509 ! barotropic velocities required and ln_full_vel set to .true. 510 IF( nn_dyn3d_dta(jbdy) == 1 .OR. & 511 & ( ln_full_vel_array(jbdy) .AND. ( nn_dyn2d_dta(jbdy) == 1 .OR. nn_dyn2d_dta(jbdy) == 3 ) ) ) THEN 512 513 IF( dta%ll_u3d .OR. ( ln_full_vel_array(jbdy) .and. dta%ll_u2d ) ) THEN 514 if(lwp) write(numout,*) '++++++ reading in u3d field' 515 jfld = jfld + 1 516 blf_i(jfld) = bn_u3d 517 ibdy(jfld) = jbdy 518 igrid(jfld) = 2 519 ilen1(jfld) = nblen(igrid(jfld)) 520 ilen3(jfld) = jpk 521 IF( ln_full_vel_array(jbdy) .and. dta%ll_u2d ) dta%nread(2) = dta%nread(2) + 1 522 ENDIF 523 524 IF( dta%ll_v3d .OR. ( ln_full_vel_array(jbdy) .and. dta%ll_v2d ) ) THEN 525 if(lwp) write(numout,*) '++++++ reading in v3d field' 526 jfld = jfld + 1 527 blf_i(jfld) = bn_v3d 528 ibdy(jfld) = jbdy 529 igrid(jfld) = 3 530 ilen1(jfld) = nblen(igrid(jfld)) 531 ilen3(jfld) = jpk 532 IF( ln_full_vel_array(jbdy) .and. dta%ll_v2d ) dta%nread(2) = dta%nread(2) + 1 533 ENDIF 534 535 ENDIF 536 537 ! temperature and salinity 538 IF( nn_tra_dta(jbdy) == 1 ) THEN 539 540 IF( dta%ll_tem ) THEN 541 if(lwp) write(numout,*) '++++++ reading in tem field' 542 jfld = jfld + 1 543 blf_i(jfld) = bn_tem 544 ibdy(jfld) = jbdy 545 igrid(jfld) = 1 546 ilen1(jfld) = nblen(igrid(jfld)) 547 ilen3(jfld) = jpk 548 ENDIF 549 550 IF( dta%ll_sal ) THEN 551 if(lwp) write(numout,*) '++++++ reading in sal field' 552 jfld = jfld + 1 553 blf_i(jfld) = bn_sal 554 ibdy(jfld) = jbdy 555 igrid(jfld) = 1 556 ilen1(jfld) = nblen(igrid(jfld)) 557 ilen3(jfld) = jpk 558 ENDIF 559 560 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 561 451 562 452 #if defined key_si3 563 ! sea ice 564 IF( nn_ice_dta(jbdy) == 1 ) THEN 565 ! Test for types of ice input (1cat or Xcat) 566 ! Build file name to find dimensions 567 clname=TRIM( cn_dir )//TRIM(bn_a_i%clname) 568 IF( .NOT. bn_a_i%ln_clim ) THEN 569 WRITE(clname, '(a,"_y",i4.4)' ) TRIM( clname ), nyear ! add year 570 IF( bn_a_i%cltype /= 'yearly' ) WRITE(clname, '(a,"m" ,i2.2)' ) TRIM( clname ), nmonth ! add month 571 ELSE 572 IF( bn_a_i%cltype /= 'yearly' ) WRITE(clname, '(a,"_m",i2.2)' ) TRIM( clname ), nmonth ! add month 573 ENDIF 574 IF( bn_a_i%cltype == 'daily' .OR. bn_a_i%cltype(1:4) == 'week' ) & 575 & 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 576 620 ! 577 CALL iom_open ( clname, inum ) 578 id1 = iom_varid( inum, bn_a_i%clvar, kdimsz=kdimsz, kndims=kndims, ldstop = .FALSE. ) 579 CALL iom_close ( inum ) 580 581 IF ( kndims == 4 ) THEN 582 nice_cat = kdimsz(4) ! Xcat input 583 ELSE 584 nice_cat = 1 ! 1cat input 585 ENDIF 586 ! End test 587 588 IF( dta%ll_a_i ) THEN 589 jfld = jfld + 1 590 blf_i(jfld) = bn_a_i 591 ibdy(jfld) = jbdy 592 igrid(jfld) = 1 593 ilen1(jfld) = nblen(igrid(jfld)) 594 ilen3(jfld) = nice_cat 595 ENDIF 596 597 IF( dta%ll_h_i ) THEN 598 jfld = jfld + 1 599 blf_i(jfld) = bn_h_i 600 ibdy(jfld) = jbdy 601 igrid(jfld) = 1 602 ilen1(jfld) = nblen(igrid(jfld)) 603 ilen3(jfld) = nice_cat 604 ENDIF 605 606 IF( dta%ll_h_s ) THEN 607 jfld = jfld + 1 608 blf_i(jfld) = bn_h_s 609 ibdy(jfld) = jbdy 610 igrid(jfld) = 1 611 ilen1(jfld) = nblen(igrid(jfld)) 612 ilen3(jfld) = nice_cat 613 ENDIF 614 615 ENDIF 616 #endif 617 ! Recalculate field counts 618 !------------------------- 619 IF( jbdy == 1 ) THEN 620 nb_bdy_fld_sum = 0 621 nb_bdy_fld(jbdy) = jfld 622 nb_bdy_fld_sum = jfld 623 ELSE 624 nb_bdy_fld(jbdy) = jfld - nb_bdy_fld_sum 625 nb_bdy_fld_sum = nb_bdy_fld_sum + nb_bdy_fld(jbdy) 626 ENDIF 627 628 dta%nread(1) = nb_bdy_fld(jbdy) 629 630 ENDIF ! nn_dta == 1 631 ENDDO ! jbdy 632 633 DO jfld = 1, nb_bdy_fld_sum 634 ALLOCATE( bf(jfld)%fnow(ilen1(jfld),1,ilen3(jfld)) ) 635 IF( blf_i(jfld)%ln_tint ) ALLOCATE( bf(jfld)%fdta(ilen1(jfld),1,ilen3(jfld),2) ) 636 nbmap_ptr(jfld)%ptr => idx_bdy(ibdy(jfld))%nbmap(:,igrid(jfld)) 637 nbmap_ptr(jfld)%ll_unstruc = ln_coords_file(ibdy(jfld)) 638 ENDDO 639 640 ! fill bf with blf_i and control print 641 !------------------------------------- 642 jstart = 1 643 DO jbdy = 1, nb_bdy 644 jend = jstart - 1 + nb_bdy_fld(jbdy) 645 CALL fld_fill( bf(jstart:jend), blf_i(jstart:jend), cn_dir_array(jbdy), 'bdy_dta', & 646 & 'open boundary conditions', 'nambdy_dta' ) 647 jstart = jend + 1 648 ENDDO 649 650 DO jfld = 1, nb_bdy_fld_sum 651 bf(jfld)%igrd = igrid(jfld) 652 bf(jfld)%ibdy = ibdy(jfld) 653 ENDDO 654 655 ! Initialise local boundary data arrays 656 ! nn_xxx_dta=0 : allocate space - will be filled from initial conditions later 657 ! nn_xxx_dta=1 : point to "fnow" arrays 658 !------------------------------------- 659 660 jfld = 0 661 DO jbdy=1, nb_bdy 662 663 nblen => idx_bdy(jbdy)%nblen 664 dta => dta_bdy(jbdy) 665 666 if(lwp) then 667 write(numout,*) '++++++ dta%ll_ssh = ',dta%ll_ssh 668 write(numout,*) '++++++ dta%ll_u2d = ',dta%ll_u2d 669 write(numout,*) '++++++ dta%ll_v2d = ',dta%ll_v2d 670 write(numout,*) '++++++ dta%ll_u3d = ',dta%ll_u3d 671 write(numout,*) '++++++ dta%ll_v3d = ',dta%ll_v3d 672 write(numout,*) '++++++ dta%ll_tem = ',dta%ll_tem 673 write(numout,*) '++++++ dta%ll_sal = ',dta%ll_sal 674 endif 675 676 IF ( nn_dyn2d_dta(jbdy) == 0 .or. nn_dyn2d_dta(jbdy) == 2 ) THEN 677 if(lwp) write(numout,*) '++++++ dta%ssh/u2d/u3d allocated space' 678 IF( dta%ll_ssh ) ALLOCATE( dta%ssh(nblen(1)) ) 679 IF( dta%ll_u2d ) ALLOCATE( dta%u2d(nblen(2)) ) 680 IF( dta%ll_v2d ) ALLOCATE( dta%v2d(nblen(3)) ) 681 ENDIF 682 IF ( nn_dyn2d_dta(jbdy) == 1 .or. nn_dyn2d_dta(jbdy) == 3 ) THEN 683 IF( dta%ll_ssh ) THEN 684 if(lwp) write(numout,*) '++++++ dta%ssh pointing to fnow' 685 jfld = jfld + 1 686 dta%ssh => bf(jfld)%fnow(:,1,1) 687 ENDIF 688 IF ( dta%ll_u2d ) THEN 689 IF ( ln_full_vel_array(jbdy) ) THEN 690 if(lwp) write(numout,*) '++++++ dta%u2d allocated space' 691 ALLOCATE( dta%u2d(nblen(2)) ) 692 ELSE 693 if(lwp) write(numout,*) '++++++ dta%u2d pointing to fnow' 694 jfld = jfld + 1 695 dta%u2d => bf(jfld)%fnow(:,1,1) 696 ENDIF 697 ENDIF 698 IF ( dta%ll_v2d ) THEN 699 IF ( ln_full_vel_array(jbdy) ) THEN 700 if(lwp) write(numout,*) '++++++ dta%v2d allocated space' 701 ALLOCATE( dta%v2d(nblen(3)) ) 702 ELSE 703 if(lwp) write(numout,*) '++++++ dta%v2d pointing to fnow' 704 jfld = jfld + 1 705 dta%v2d => bf(jfld)%fnow(:,1,1) 706 ENDIF 707 ENDIF 708 ENDIF 709 710 IF ( nn_dyn3d_dta(jbdy) == 0 ) THEN 711 if(lwp) write(numout,*) '++++++ dta%u3d/v3d allocated space' 712 IF( dta%ll_u3d ) ALLOCATE( dta_bdy(jbdy)%u3d(nblen(2),jpk) ) 713 IF( dta%ll_v3d ) ALLOCATE( dta_bdy(jbdy)%v3d(nblen(3),jpk) ) 714 ENDIF 715 IF ( nn_dyn3d_dta(jbdy) == 1 .or. & 716 & ( ln_full_vel_array(jbdy) .and. ( nn_dyn2d_dta(jbdy) == 1 .or. nn_dyn2d_dta(jbdy) == 3 ) ) ) THEN 717 IF ( dta%ll_u3d .or. ( ln_full_vel_array(jbdy) .and. dta%ll_u2d ) ) THEN 718 if(lwp) write(numout,*) '++++++ dta%u3d pointing to fnow' 719 jfld = jfld + 1 720 dta_bdy(jbdy)%u3d => bf(jfld)%fnow(:,1,:) 721 ENDIF 722 IF ( dta%ll_v3d .or. ( ln_full_vel_array(jbdy) .and. dta%ll_v2d ) ) THEN 723 if(lwp) write(numout,*) '++++++ dta%v3d pointing to fnow' 724 jfld = jfld + 1 725 dta_bdy(jbdy)%v3d => bf(jfld)%fnow(:,1,:) 726 ENDIF 727 ENDIF 728 729 IF( nn_tra_dta(jbdy) == 0 ) THEN 730 if(lwp) write(numout,*) '++++++ dta%tem/sal allocated space' 731 IF( dta%ll_tem ) ALLOCATE( dta_bdy(jbdy)%tem(nblen(1),jpk) ) 732 IF( dta%ll_sal ) ALLOCATE( dta_bdy(jbdy)%sal(nblen(1),jpk) ) 733 ELSE 734 IF( dta%ll_tem ) THEN 735 if(lwp) write(numout,*) '++++++ dta%tem pointing to fnow' 736 jfld = jfld + 1 737 dta_bdy(jbdy)%tem => bf(jfld)%fnow(:,1,:) 738 ENDIF 739 IF( dta%ll_sal ) THEN 740 if(lwp) write(numout,*) '++++++ dta%sal pointing to fnow' 741 jfld = jfld + 1 742 dta_bdy(jbdy)%sal => bf(jfld)%fnow(:,1,:) 743 ENDIF 744 ENDIF 745 746 #if defined key_si3 747 IF (cn_ice(jbdy) /= 'none') THEN 748 IF( nn_ice_dta(jbdy) == 0 ) THEN 749 ALLOCATE( dta_bdy(jbdy)%a_i(nblen(1),jpl) ) 750 ALLOCATE( dta_bdy(jbdy)%h_i(nblen(1),jpl) ) 751 ALLOCATE( dta_bdy(jbdy)%h_s(nblen(1),jpl) ) 752 ELSE 753 IF ( nice_cat == jpl ) THEN ! case input cat = jpl 754 jfld = jfld + 1 755 dta_bdy(jbdy)%a_i => bf(jfld)%fnow(:,1,:) 756 jfld = jfld + 1 757 dta_bdy(jbdy)%h_i => bf(jfld)%fnow(:,1,:) 758 jfld = jfld + 1 759 dta_bdy(jbdy)%h_s => bf(jfld)%fnow(:,1,:) 760 ELSE ! case input cat = 1 OR (/=1 and /=jpl) 761 jfld_ait(jbdy) = jfld + 1 762 jfld_htit(jbdy) = jfld + 2 763 jfld_htst(jbdy) = jfld + 3 764 jfld = jfld + 3 765 ALLOCATE( dta_bdy(jbdy)%a_i(nblen(1),jpl) ) 766 ALLOCATE( dta_bdy(jbdy)%h_i(nblen(1),jpl) ) 767 ALLOCATE( dta_bdy(jbdy)%h_s(nblen(1),jpl) ) 768 dta_bdy(jbdy)%a_i(:,:) = 0._wp 769 dta_bdy(jbdy)%h_i(:,:) = 0._wp 770 dta_bdy(jbdy)%h_s(:,:) = 0._wp 771 ENDIF 772 773 ENDIF 774 ENDIF 775 #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)%ltotvel = ln_full_vel ! T if u3d is full velocity 627 bf_alias(1)%lzint = ln_zinterp ! T if it requires a vertical interpolation 628 ENDIF 629 630 ! associate the pointer and get rid of the dimensions with a size equal to 1 631 IF( jfld == jp_bdyssh ) dta_bdy(jbdy)%ssh => bf_alias(1)%fnow(:,1,1) 632 IF( jfld == jp_bdyu2d ) dta_bdy(jbdy)%u2d => bf_alias(1)%fnow(:,1,1) 633 IF( jfld == jp_bdyv2d ) dta_bdy(jbdy)%v2d => bf_alias(1)%fnow(:,1,1) 634 IF( jfld == jp_bdyu3d ) dta_bdy(jbdy)%u3d => bf_alias(1)%fnow(:,1,:) 635 IF( jfld == jp_bdyv3d ) dta_bdy(jbdy)%v3d => bf_alias(1)%fnow(:,1,:) 636 IF( jfld == jp_bdytem ) dta_bdy(jbdy)%tem => bf_alias(1)%fnow(:,1,:) 637 IF( jfld == jp_bdysal ) dta_bdy(jbdy)%sal => bf_alias(1)%fnow(:,1,:) 638 IF( jfld == jp_bdya_i ) THEN 639 IF( ipk == jpl ) THEN ; dta_bdy(jbdy)%a_i => bf_alias(1)%fnow(:,1,:) 640 ELSE ; ALLOCATE( dta_bdy(jbdy)%a_i(iszdim,jpl) ) 641 ENDIF 642 ENDIF 643 IF( jfld == jp_bdyh_i ) THEN 644 IF( ipk == jpl ) THEN ; dta_bdy(jbdy)%h_i => bf_alias(1)%fnow(:,1,:) 645 ELSE ; ALLOCATE( dta_bdy(jbdy)%h_i(iszdim,jpl) ) 646 ENDIF 647 ENDIF 648 IF( jfld == jp_bdyh_s ) THEN 649 IF( ipk == jpl ) THEN ; dta_bdy(jbdy)%h_s => bf_alias(1)%fnow(:,1,:) 650 ELSE ; ALLOCATE( dta_bdy(jbdy)%h_s(iszdim,jpl) ) 651 ENDIF 652 ENDIF 653 IF( jfld == jp_bdyt_i ) THEN 654 IF( ipk == jpl ) THEN ; dta_bdy(jbdy)%t_i => bf_alias(1)%fnow(:,1,:) 655 ELSE ; ALLOCATE( dta_bdy(jbdy)%t_i(iszdim,jpl) ) 656 ENDIF 657 ENDIF 658 IF( jfld == jp_bdyt_s ) THEN 659 IF( ipk == jpl ) THEN ; dta_bdy(jbdy)%t_s => bf_alias(1)%fnow(:,1,:) 660 ELSE ; ALLOCATE( dta_bdy(jbdy)%t_s(iszdim,jpl) ) 661 ENDIF 662 ENDIF 663 IF( jfld == jp_bdytsu ) THEN 664 IF( ipk == jpl ) THEN ; dta_bdy(jbdy)%tsu => bf_alias(1)%fnow(:,1,:) 665 ELSE ; ALLOCATE( dta_bdy(jbdy)%tsu(iszdim,jpl) ) 666 ENDIF 667 ENDIF 668 IF( jfld == jp_bdys_i ) THEN 669 IF( ipk == jpl ) THEN ; dta_bdy(jbdy)%s_i => bf_alias(1)%fnow(:,1,:) 670 ELSE ; ALLOCATE( dta_bdy(jbdy)%s_i(iszdim,jpl) ) 671 ENDIF 672 ENDIF 673 IF( jfld == jp_bdyaip ) THEN 674 IF( ipk == jpl ) THEN ; dta_bdy(jbdy)%aip => bf_alias(1)%fnow(:,1,:) 675 ELSE ; ALLOCATE( dta_bdy(jbdy)%aip(iszdim,jpl) ) 676 ENDIF 677 ENDIF 678 IF( jfld == jp_bdyhip ) THEN 679 IF( ipk == jpl ) THEN ; dta_bdy(jbdy)%hip => bf_alias(1)%fnow(:,1,:) 680 ELSE ; ALLOCATE( dta_bdy(jbdy)%hip(iszdim,jpl) ) 681 ENDIF 682 ENDIF 683 ENDIF 684 685 END DO ! jpbdyfld 776 686 ! 777 687 END DO ! jbdy 778 688 ! 779 689 END SUBROUTINE bdy_dta_init 780 690 781 691 !!============================================================================== 782 692 END MODULE bdydta
Note: See TracChangeset
for help on using the changeset viewer.
