- Timestamp:
- 2011-08-25T18:24:45+02:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/UKMO_MERCATOR_obc_bdy_merge/NEMOGCM/NEMO/OPA_SRC/OBC/obcdta.F90
r2818 r2831 80 80 END IF 81 81 82 ! for nn_dtactl = 0, initialise data arrays once for all 83 ! from initial conditions 84 !------------------------------------------------------- 82 ! Initialise data arrays once for all from initial conditions where required 83 !--------------------------------------------------------------------------- 85 84 IF( kt .eq. nit000 .and. .not. PRESENT(jit) ) THEN 86 85 … … 101 100 102 101 DO ib_obc = 1, nb_obc 103 IF( nn_dtactl(ib_obc) .eq. 0 ) THEN 104 105 nblen => idx_obc(ib_obc)%nblen 106 nblenrim => idx_obc(ib_obc)%nblenrim 107 108 IF( nn_dyn2d(ib_obc) .gt. 0 ) THEN 109 IF( nn_dyn2d(ib_obc) .eq. jp_frs ) THEN 110 ilen1(:) = nblen(:) 111 ELSE 112 ilen1(:) = nblenrim(:) 113 ENDIF 114 igrd = 1 115 DO ib = 1, ilen1(igrd) 102 103 nblen => idx_obc(ib_obc)%nblen 104 nblenrim => idx_obc(ib_obc)%nblenrim 105 106 IF( nn_dyn2d(ib_obc) .gt. 0 .and. nn_dyn2d_dta(ib_obc) .eq. 0 ) THEN 107 IF( nn_dyn2d(ib_obc) .eq. jp_frs ) THEN 108 ilen1(:) = nblen(:) 109 ELSE 110 ilen1(:) = nblenrim(:) 111 ENDIF 112 igrd = 1 113 DO ib = 1, ilen1(igrd) 114 ii = idx_obc(ib_obc)%nbi(ib,igrd) 115 ij = idx_obc(ib_obc)%nbj(ib,igrd) 116 dta_obc(ib_obc)%ssh(ib) = sshn(ii,ij) * tmask(ii,ij,1) 117 END DO 118 igrd = 2 119 DO ib = 1, ilen1(igrd) 120 ii = idx_obc(ib_obc)%nbi(ib,igrd) 121 ij = idx_obc(ib_obc)%nbj(ib,igrd) 122 dta_obc(ib_obc)%u2d(ib) = pu2d(ii,ij) * umask(ii,ij,1) 123 END DO 124 igrd = 3 125 DO ib = 1, ilen1(igrd) 126 ii = idx_obc(ib_obc)%nbi(ib,igrd) 127 ij = idx_obc(ib_obc)%nbj(ib,igrd) 128 dta_obc(ib_obc)%v2d(ib) = pv2d(ii,ij) * vmask(ii,ij,1) 129 END DO 130 ENDIF 131 132 IF( nn_dyn3d(ib_obc) .gt. 0 .and. nn_dyn3d_dta(ib_obc) .eq. 0 ) THEN 133 IF( nn_dyn3d(ib_obc) .eq. jp_frs ) THEN 134 ilen1(:) = nblen(:) 135 ELSE 136 ilen1(:) = nblenrim(:) 137 ENDIF 138 igrd = 2 139 DO ib = 1, ilen1(igrd) 140 DO ik = 1, jpkm1 116 141 ii = idx_obc(ib_obc)%nbi(ib,igrd) 117 142 ij = idx_obc(ib_obc)%nbj(ib,igrd) 118 dta_obc(ib_obc)%ssh(ib) = sshn(ii,ij) * tmask(ii,ij,1) 119 END DO 120 igrd = 2 121 DO ib = 1, ilen1(igrd) 143 dta_obc(ib_obc)%u3d(ib,ik) = ( un(ii,ij,ik) - pu2d(ii,ij) ) * umask(ii,ij,ik) 144 END DO 145 END DO 146 igrd = 3 147 DO ib = 1, ilen1(igrd) 148 DO ik = 1, jpkm1 122 149 ii = idx_obc(ib_obc)%nbi(ib,igrd) 123 150 ij = idx_obc(ib_obc)%nbj(ib,igrd) 124 dta_obc(ib_obc)%u2d(ib) = pu2d(ii,ij) * umask(ii,ij,1) 125 END DO 126 igrd = 3 127 DO ib = 1, ilen1(igrd) 151 dta_obc(ib_obc)%v3d(ib,ik) = ( vn(ii,ij,ik) - pv2d(ii,ij) ) * vmask(ii,ij,ik) 152 END DO 153 END DO 154 ENDIF 155 156 IF( nn_tra(ib_obc) .gt. 0 .and. nn_tra_dta(ib_obc) .eq. 0 ) THEN 157 IF( nn_tra(ib_obc) .eq. jp_frs ) THEN 158 ilen1(:) = nblen(:) 159 ELSE 160 ilen1(:) = nblenrim(:) 161 ENDIF 162 igrd = 1 ! Everything is at T-points here 163 DO ib = 1, ilen1(igrd) 164 DO ik = 1, jpkm1 128 165 ii = idx_obc(ib_obc)%nbi(ib,igrd) 129 166 ij = idx_obc(ib_obc)%nbj(ib,igrd) 130 dta_obc(ib_obc)%v2d(ib) = pv2d(ii,ij) * vmask(ii,ij,1) 131 END DO 132 ENDIF 133 134 IF( nn_dyn3d(ib_obc) .gt. 0 ) THEN 135 IF( nn_dyn3d(ib_obc) .eq. jp_frs ) THEN 136 ilen1(:) = nblen(:) 137 ELSE 138 ilen1(:) = nblenrim(:) 139 ENDIF 140 igrd = 2 141 DO ib = 1, ilen1(igrd) 142 DO ik = 1, jpkm1 143 ii = idx_obc(ib_obc)%nbi(ib,igrd) 144 ij = idx_obc(ib_obc)%nbj(ib,igrd) 145 dta_obc(ib_obc)%u3d(ib,ik) = ( un(ii,ij,ik) - pu2d(ii,ij) ) * umask(ii,ij,ik) 146 END DO 147 END DO 148 igrd = 3 149 DO ib = 1, ilen1(igrd) 150 DO ik = 1, jpkm1 151 ii = idx_obc(ib_obc)%nbi(ib,igrd) 152 ij = idx_obc(ib_obc)%nbj(ib,igrd) 153 dta_obc(ib_obc)%v3d(ib,ik) = ( vn(ii,ij,ik) - pv2d(ii,ij) ) * vmask(ii,ij,ik) 154 END DO 155 END DO 156 ENDIF 157 158 IF( nn_tra(ib_obc) .gt. 0 ) THEN 159 IF( nn_tra(ib_obc) .eq. jp_frs ) THEN 160 ilen1(:) = nblen(:) 161 ELSE 162 ilen1(:) = nblenrim(:) 163 ENDIF 164 igrd = 1 ! Everything is at T-points here 165 DO ib = 1, ilen1(igrd) 166 DO ik = 1, jpkm1 167 ii = idx_obc(ib_obc)%nbi(ib,igrd) 168 ij = idx_obc(ib_obc)%nbj(ib,igrd) 169 dta_obc(ib_obc)%tem(ib,ik) = tn(ii,ij,ik) * tmask(ii,ij,ik) 170 dta_obc(ib_obc)%sal(ib,ik) = sn(ii,ij,ik) * tmask(ii,ij,ik) 171 END DO 172 END DO 173 ENDIF 174 175 #if defined key_lim2 176 IF( nn_ice_lim2(ib_obc) .gt. 0 ) THEN 177 IF( nn_ice_lim2(ib_obc) .eq. jp_frs ) THEN 178 ilen1(:) = nblen(:) 179 ELSE 180 ilen1(:) = nblenrim(:) 181 ENDIF 182 igrd = 1 ! Everything is at T-points here 183 DO ib = 1, ilen1(igrd) 184 ii = idx_obc(ib_obc)%nbi(ib,igrd) 185 ij = idx_obc(ib_obc)%nbj(ib,igrd) 186 dta_obc(ib_obc)%frld(ib) = frld(ii,ij) * tmask(ii,ij,1) 187 dta_obc(ib_obc)%hicif(ib) = hicif(ii,ij) * tmask(ii,ij,1) 188 dta_obc(ib_obc)%hsnif(ib) = hsnif(ii,ij) * tmask(ii,ij,1) 189 END DO 190 ENDIF 191 #endif 192 193 ENDIF 194 ENDDO 195 196 ENDIF 197 198 ! for nn_dtactl = 1, update external data from files 199 !--------------------------------------------------- 167 dta_obc(ib_obc)%tem(ib,ik) = tn(ii,ij,ik) * tmask(ii,ij,ik) 168 dta_obc(ib_obc)%sal(ib,ik) = sn(ii,ij,ik) * tmask(ii,ij,ik) 169 END DO 170 END DO 171 ENDIF 172 173 #if defined key_lim2 174 IF( nn_ice_lim2(ib_obc) .gt. 0 .and. nn_ice_lim2_dta(ib_obc) .eq. 0 ) THEN 175 IF( nn_ice_lim2(ib_obc) .eq. jp_frs ) THEN 176 ilen1(:) = nblen(:) 177 ELSE 178 ilen1(:) = nblenrim(:) 179 ENDIF 180 igrd = 1 ! Everything is at T-points here 181 DO ib = 1, ilen1(igrd) 182 ii = idx_obc(ib_obc)%nbi(ib,igrd) 183 ij = idx_obc(ib_obc)%nbj(ib,igrd) 184 dta_obc(ib_obc)%frld(ib) = frld(ii,ij) * tmask(ii,ij,1) 185 dta_obc(ib_obc)%hicif(ib) = hicif(ii,ij) * tmask(ii,ij,1) 186 dta_obc(ib_obc)%hsnif(ib) = hsnif(ii,ij) * tmask(ii,ij,1) 187 END DO 188 ENDIF 189 #endif 190 191 ENDDO ! ib_obc 192 193 ENDIF ! kt .eq. nit000 194 195 ! update external data from files 196 !-------------------------------- 200 197 201 198 jstart = 1 202 199 DO ib_obc = 1, nb_obc 203 IF( nn_dta ctl(ib_obc) .eq. 1 ) THEN200 IF( nn_dta(ib_obc) .eq. 1 ) THEN ! skip this bit if no external data required 204 201 205 202 IF( PRESENT(jit) ) THEN 206 203 ! Update barotropic boundary conditions only 207 204 ! jit is optional argument for fld_read 208 IF( nn_dyn2d(ib_obc) .gt. 0 ) THEN205 IF( nn_dyn2d(ib_obc) .gt. 0 .and. nn_dyn2d_dta(ib_obc) .eq. 1 ) THEN 209 206 IF( nn_tides(ib_obc) .eq. 1 ) THEN 210 207 dta_obc(ib_obc)%ssh(:) = 0.0 … … 240 237 ! time as the dynspg_ts option). 241 238 242 IF( ln_full_vel_array(ib_obc) ) THEN 239 IF( ln_full_vel_array(ib_obc) .and. & 240 & ( nn_dyn2d_dta(ib_obc) .eq. 1 .or. nn_dyn3d_dta(ib_obc) .eq. 1 ) ) THEN 243 241 244 242 igrd = 2 ! zonal velocity … … 274 272 ENDIF 275 273 276 END IF ! nn_dta ctl(ib_obc) = 1274 END IF ! nn_dta(ib_obc) = 1 277 275 END DO ! ib_obc 278 276 … … 319 317 !!--------------------------------------------------------------------------- 320 318 319 ! Set nn_dta 320 DO ib_obc = 1, nb_obc 321 nn_dta(ib_obc) = MAX( nn_dyn2d_dta(ib_obc) & 322 ,nn_dyn3d_dta(ib_obc) & 323 ,nn_tra_dta(ib_obc) & 324 #if defined key_ice_lim2 325 ,nn_ice_lim2_dta(ib_obc) & 326 #endif 327 ) 328 END DO 329 321 330 ! Work out upper bound of how many fields there are to read in and allocate arrays 322 331 ! --------------------------------------------------------------------------- … … 324 333 nb_obc_fld(:) = 0 325 334 DO ib_obc = 1, nb_obc 326 IF( nn_dtactl(ib_obc) .eq. 1 ) THEN 327 IF( nn_dyn2d(ib_obc) .gt. 0 ) THEN 328 nb_obc_fld(ib_obc) = nb_obc_fld(ib_obc) + 3 329 ENDIF 330 IF( nn_dyn3d(ib_obc) .gt. 0 ) THEN 331 nb_obc_fld(ib_obc) = nb_obc_fld(ib_obc) + 2 332 ENDIF 333 IF( nn_tra(ib_obc) .gt. 0 ) THEN 334 nb_obc_fld(ib_obc) = nb_obc_fld(ib_obc) + 2 335 ENDIF 336 #if defined key_lim2 337 IF( nn_ice_lim2(ib_obc) .gt. 0 ) THEN 338 nb_obc_fld(ib_obc) = nb_obc_fld(ib_obc) + 3 339 ENDIF 335 IF( nn_dyn2d(ib_obc) .gt. 0 .and. nn_dyn2d_dta(ib_obc) .eq. 1 ) THEN 336 nb_obc_fld(ib_obc) = nb_obc_fld(ib_obc) + 3 337 ENDIF 338 IF( nn_dyn3d(ib_obc) .gt. 0 .and. nn_dyn3d_dta(ib_obc) .eq. 1 ) THEN 339 nb_obc_fld(ib_obc) = nb_obc_fld(ib_obc) + 2 340 ENDIF 341 IF( nn_tra(ib_obc) .gt. 0 .and. nn_tra_dta(ib_obc) .eq. 1 ) THEN 342 nb_obc_fld(ib_obc) = nb_obc_fld(ib_obc) + 2 343 ENDIF 344 #if defined key_lim2 345 IF( nn_ice_lim2(ib_obc) .gt. 0 .and. nn_ice_lim2_dta(ib_obc) .eq. 1 ) THEN 346 nb_obc_fld(ib_obc) = nb_obc_fld(ib_obc) + 3 347 ENDIF 340 348 #endif 341 ENDIF342 349 ENDDO 343 350 … … 365 372 jfld = 0 366 373 DO ib_obc = 1, nb_obc 367 IF( nn_dta ctl(ib_obc) .eq. 1 ) THEN374 IF( nn_dta(ib_obc) .eq. 1 ) THEN 368 375 ! set file information 369 376 cn_dir = './' ! directory in which the model is executed … … 401 408 ! Only read in necessary fields for this set. 402 409 ! Important that barotropic variables come first. 403 IF( nn_dyn2d(ib_obc) .gt. 0 ) THEN410 IF( nn_dyn2d(ib_obc) .gt. 0 .and. nn_dyn2d_dta(ib_obc) .eq. 1 ) THEN 404 411 405 412 IF( nn_dyn2d(ib_obc) .ne. jp_frs .and. nn_tides(ib_obc) .ne. 1) THEN … … 441 448 442 449 ! baroclinic velocities 443 IF( nn_dyn3d(ib_obc) .gt. 0.or. &444 ( ln_full_vel_array(ib_obc) .and. nn_dyn2d(ib_obc) .gt. 0 ) ) THEN450 IF( ( nn_dyn3d(ib_obc) .gt. 0 .and. nn_dyn3d_dta(ib_obc) .eq. 1 ) .or. & 451 ( ln_full_vel_array(ib_obc) .and. nn_dyn2d(ib_obc) .gt. 0 .and. nn_dyn2d_dta(ib_obc) .eq. 1 ) ) THEN 445 452 446 453 jfld = jfld + 1 … … 469 476 470 477 ! temperature and salinity 471 IF( nn_tra(ib_obc) .gt. 0 ) THEN478 IF( nn_tra(ib_obc) .gt. 0 .and. nn_tra_dta(ib_obc) .eq. 1 ) THEN 472 479 473 480 jfld = jfld + 1 … … 497 504 #if defined key_lim2 498 505 ! sea ice 499 IF( nn_ tra(ib_obc) .gt. 0) THEN506 IF( nn_ice_lim2(ib_obc) .gt. 0 .and. nn_ice_lim2_dta(ib_obc) .eq. 1 ) THEN 500 507 501 508 jfld = jfld + 1 … … 545 552 ENDIF 546 553 547 ENDIF ! nn_dta ctl.eq. 1554 ENDIF ! nn_dta .eq. 1 548 555 ENDDO ! ib_obc 549 556 … … 565 572 566 573 ! Initialise local boundary data arrays 567 ! nn_ dtactl=0 : allocate space - will be filled from initial conditions later568 ! nn_ dtactl=1 : point to "fnow" arrays574 ! nn_xxx_dta=0 : allocate space - will be filled from initial conditions later 575 ! nn_xxx_dta=1 : point to "fnow" arrays 569 576 !------------------------------------- 570 577 … … 575 582 nblenrim => idx_obc(ib_obc)%nblenrim 576 583 577 IF( nn_dtactl(ib_obc) .eq. 0 ) THEN 578 579 ! nn_dtactl = 0 580 ! Allocate space 581 !--------------- 582 IF (nn_dyn2d(ib_obc) .gt. 0) THEN 584 IF (nn_dyn2d(ib_obc) .gt. 0) THEN 585 IF( nn_dyn2d_dta(ib_obc) .eq. 0 .or. ln_full_vel_array(ib_obc) .or. nn_tides(ib_obc) .eq. 1 ) THEN 583 586 IF( nn_dyn2d(ib_obc) .eq. jp_frs ) THEN 584 587 ilen0(1:3) = nblen(1:3) … … 589 592 ALLOCATE( dta_obc(ib_obc)%u2d(ilen0(2)) ) 590 593 ALLOCATE( dta_obc(ib_obc)%v2d(ilen0(3)) ) 591 ENDIF 592 IF (nn_dyn3d(ib_obc) .gt. 0) THEN 593 IF( nn_dyn3d(ib_obc) .eq. jp_frs ) THEN 594 ilen0(1:3) = nblen(1:3) 595 ELSE 596 ilen0(1:3) = nblenrim(1:3) 597 ENDIF 598 ALLOCATE( dta_obc(ib_obc)%u3d(ilen0(2),jpk) ) 599 ALLOCATE( dta_obc(ib_obc)%v3d(ilen0(3),jpk) ) 600 ENDIF 601 IF (nn_tra(ib_obc) .gt. 0) THEN 594 ELSE 595 IF( nn_dyn2d(ib_obc) .ne. jp_frs ) THEN 596 jfld = jfld + 1 597 dta_obc(ib_obc)%ssh => bf(jfld)%fnow(:,1,1) 598 ENDIF 599 jfld = jfld + 1 600 dta_obc(ib_obc)%u2d => bf(jfld)%fnow(:,1,1) 601 jfld = jfld + 1 602 dta_obc(ib_obc)%v2d => bf(jfld)%fnow(:,1,1) 603 ENDIF 604 ENDIF 605 606 IF ( nn_dyn3d(ib_obc) .gt. 0 .and. nn_dyn3d_dta(ib_obc) .eq. 0 ) THEN 607 IF( nn_dyn3d(ib_obc) .eq. jp_frs ) THEN 608 ilen0(1:3) = nblen(1:3) 609 ELSE 610 ilen0(1:3) = nblenrim(1:3) 611 ENDIF 612 ALLOCATE( dta_obc(ib_obc)%u3d(ilen0(2),jpk) ) 613 ALLOCATE( dta_obc(ib_obc)%v3d(ilen0(3),jpk) ) 614 ENDIF 615 IF ( ( nn_dyn3d(ib_obc) .gt. 0 .and. nn_dyn3d_dta(ib_obc) .eq. 1 ).or. & 616 & ( ln_full_vel_array(ib_obc) .and. nn_dyn2d(ib_obc) .gt. 0 ) ) THEN 617 jfld = jfld + 1 618 dta_obc(ib_obc)%u3d => bf(jfld)%fnow(:,1,:) 619 jfld = jfld + 1 620 dta_obc(ib_obc)%v3d => bf(jfld)%fnow(:,1,:) 621 ENDIF 622 623 IF (nn_tra(ib_obc) .gt. 0) THEN 624 IF( nn_tra_dta(ib_obc) .eq. 0 ) THEN 602 625 IF( nn_tra(ib_obc) .eq. jp_frs ) THEN 603 626 ilen0(1:3) = nblen(1:3) … … 607 630 ALLOCATE( dta_obc(ib_obc)%tem(ilen0(1),jpk) ) 608 631 ALLOCATE( dta_obc(ib_obc)%sal(ilen0(1),jpk) ) 609 ENDIF 610 #if defined key_lim2 611 IF (nn_ice_lim2(ib_obc) .gt. 0) THEN 632 ELSE 633 jfld = jfld + 1 634 dta_obc(ib_obc)%tem => bf(jfld)%fnow(:,1,:) 635 jfld = jfld + 1 636 dta_obc(ib_obc)%sal => bf(jfld)%fnow(:,1,:) 637 ENDIF 638 ENDIF 639 640 #if defined key_lim2 641 IF (nn_ice_lim2(ib_obc) .gt. 0) THEN 642 IF( nn_ice_lim2_dta(ib_obc) .eq. 0 ) THEN 612 643 IF( nn_ice_lim2(ib_obc) .eq. jp_frs ) THEN 613 644 ilen0(1:3) = nblen(1:3) … … 618 649 ALLOCATE( dta_obc(ib_obc)%u2d(ilen0(1)) ) 619 650 ALLOCATE( dta_obc(ib_obc)%v2d(ilen0(1)) ) 620 ENDIF 621 #endif 622 623 ELSE 624 625 ! nn_dtactl = 1 626 ! Set boundary data arrays to point to "fnow" arrays 627 !--------------------------------------------------- 628 IF (nn_dyn2d(ib_obc) .gt. 0) THEN 629 IF( nn_dyn2d(ib_obc) .ne. jp_frs .and. nn_tides(ib_obc) .ne. 1 ) THEN 630 jfld = jfld + 1 631 dta_obc(ib_obc)%ssh => bf(jfld)%fnow(:,1,1) 632 ENDIF 633 IF( ln_full_vel_array(ib_obc) .or. nn_tides(ib_obc) .eq. 1 ) THEN 634 ! In this case we need space but we aren't reading it 635 ! directly from the external file. 636 IF( nn_dyn2d(ib_obc) .eq. jp_frs ) THEN 637 ilen0(:) = nblen(:) 638 ELSE 639 ilen0(:) = nblenrim(:) 640 ENDIF 641 IF( nn_tides(ib_obc) .eq. 1 ) ALLOCATE( dta_obc(ib_obc)%ssh(ilen0(1)) ) 642 ALLOCATE( dta_obc(ib_obc)%u2d(ilen0(2)) ) 643 ALLOCATE( dta_obc(ib_obc)%v2d(ilen0(3)) ) 644 ELSE 645 jfld = jfld + 1 646 dta_obc(ib_obc)%u2d => bf(jfld)%fnow(:,1,1) 647 jfld = jfld + 1 648 dta_obc(ib_obc)%v2d => bf(jfld)%fnow(:,1,1) 649 ENDIF 650 ENDIF 651 IF (nn_dyn3d(ib_obc) .gt. 0 .or. & 652 & ( ln_full_vel_array(ib_obc) .and. nn_dyn2d(ib_obc) .gt. 0 ) ) THEN 653 jfld = jfld + 1 654 dta_obc(ib_obc)%u3d => bf(jfld)%fnow(:,1,:) 655 jfld = jfld + 1 656 dta_obc(ib_obc)%v3d => bf(jfld)%fnow(:,1,:) 657 ENDIF 658 IF (nn_tra(ib_obc) .gt. 0) THEN 659 jfld = jfld + 1 660 dta_obc(ib_obc)%tem => bf(jfld)%fnow(:,1,:) 661 jfld = jfld + 1 662 dta_obc(ib_obc)%sal => bf(jfld)%fnow(:,1,:) 663 ENDIF 664 #if defined key_lim2 665 IF (nn_ice_lim2(ib_obc) .gt. 0) THEN 651 ELSE 666 652 jfld = jfld + 1 667 653 dta_obc(ib_obc)%frld => bf(jfld)%fnow(:,1,1) … … 671 657 dta_obc(ib_obc)%hsnif => bf(jfld)%fnow(:,1,1) 672 658 ENDIF 673 #endif 674 675 ENDIF ! nn_dtactl .eq. 0 659 ENDIF 660 #endif 676 661 677 662 ENDDO ! ib_obc
Note: See TracChangeset
for help on using the changeset viewer.