Changeset 2168 for branches/DEV_r1986_BDY_updates
- Timestamp:
- 2010-10-06T16:19:27+02:00 (14 years ago)
- Location:
- branches/DEV_r1986_BDY_updates/NEMO/OPA_SRC/BDY
- Files:
-
- 8 edited
-
bdy_par.F90 (modified) (3 diffs)
-
bdydta.F90 (modified) (21 diffs)
-
bdydyn.F90 (modified) (7 diffs)
-
bdyice.F90 (modified) (3 diffs)
-
bdyini.F90 (modified) (19 diffs)
-
bdytides.F90 (modified) (3 diffs)
-
bdytra.F90 (modified) (2 diffs)
-
bdyvol.F90 (modified) (6 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/DEV_r1986_BDY_updates/NEMO/OPA_SRC/BDY/bdy_par.F90
r2093 r2168 8 8 !! 3.3 ! 2010-09 (D. Storkey and E. O'Dea) update for Shelf configurations 9 9 !!---------------------------------------------------------------------- 10 #if defined key_bdy10 #if defined key_bdy 11 11 !!---------------------------------------------------------------------- 12 12 !! 'key_bdy' : Unstructured Open Boundary Condition … … 16 16 PUBLIC 17 17 18 19 LOGICAL, PUBLIC, PARAMETER :: lk_bdy = .TRUE. !: Unstructured Ocean Boundary Condition flag 18 LOGICAL, PUBLIC, PARAMETER :: lk_bdy = .TRUE. !: Unstructured Ocean Boundary Condition flag 20 19 INTEGER, PUBLIC, PARAMETER :: jpbdta = 20000 !: Max length of bdy field in file 21 20 INTEGER, PUBLIC, PARAMETER :: jpbdim = 20000 !: Max length of bdy field on a processor 22 INTEGER, PUBLIC, PARAMETER :: jpbtime = 1000 !: Max number of time dumps per file23 INTEGER, PUBLIC, PARAMETER :: jpbgrd = 6 !: Number of horizontal grid types used (T, u, v, f)21 INTEGER, PUBLIC, PARAMETER :: jpbtime = 1000 !: Max number of time dumps per file 22 INTEGER, PUBLIC, PARAMETER :: jpbgrd = 6 !: Number of horizontal grid types used (T, u, v, f) 24 23 #else 25 24 !!---------------------------------------------------------------------- … … 30 29 31 30 !!---------------------------------------------------------------------- 32 !! NEMO/OPA 3. 0 , LOCEAN-IPSL (2008)31 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 33 32 !! $Id$ 34 33 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) -
branches/DEV_r1986_BDY_updates/NEMO/OPA_SRC/BDY/bdydta.F90
r2100 r2168 16 16 !!---------------------------------------------------------------------- 17 17 !! bdy_dta : read u, v, t, s data along open boundaries 18 !! bdy_dta_bt : read depth-mean velocities and elevation along open 19 !! boundaries 18 !! bdy_dta_bt : read depth-mean velocities and elevation along open boundaries 20 19 !!---------------------------------------------------------------------- 21 20 USE oce ! ocean dynamics and tracers … … 37 36 PUBLIC bdy_dta_bt 38 37 39 INTEGER :: numbdyt, numbdyu, numbdyv ! :logical units for T-, U-, & V-points data file, resp.40 INTEGER :: ntimes_bdy ! :exact number of time dumps in data files41 INTEGER :: nbdy_b, nbdy_a ! : record of bdy data file for before and after modeltime step42 INTEGER :: numbdyt_bt, numbdyu_bt, numbdyv_bt ! :logical unit for T-, U- & V-points data file, resp.43 INTEGER :: ntimes_bdy_bt ! :exact number of time dumps in data files44 INTEGER :: nbdy_b_bt, nbdy_a_bt ! : record of bdy data file for before and after modeltime step45 46 INTEGER, DIMENSION (jpbtime) :: istep, istep_bt ! :time array in seconds in each data file47 48 REAL(wp) :: zoffset ! :time offset between time origin in file & start time of model run49 50 REAL(wp), DIMENSION(jpbdim,jpk,2) :: tbdydta, sbdydta ! :time interpolated values of T and S bdy data51 REAL(wp), DIMENSION(jpbdim,jpk,2) :: ubdydta, vbdydta ! :time interpolated values of U and V bdy data52 REAL(wp), DIMENSION(jpbdim,2) :: ubtbdydta, vbtbdydta ! :Arrays used for time interpolation of bdy data53 REAL(wp), DIMENSION(jpbdim,2) :: sshbdydta ! :bdy data of ssh38 INTEGER :: numbdyt, numbdyu, numbdyv ! logical units for T-, U-, & V-points data file, resp. 39 INTEGER :: ntimes_bdy ! exact number of time dumps in data files 40 INTEGER :: nbdy_b, nbdy_a ! record of bdy data file for before and after time step 41 INTEGER :: numbdyt_bt, numbdyu_bt, numbdyv_bt ! logical unit for T-, U- & V-points data file, resp. 42 INTEGER :: ntimes_bdy_bt ! exact number of time dumps in data files 43 INTEGER :: nbdy_b_bt, nbdy_a_bt ! record of bdy data file for before and after time step 44 45 INTEGER, DIMENSION (jpbtime) :: istep, istep_bt ! time array in seconds in each data file 46 47 REAL(wp) :: zoffset ! time offset between time origin in file & start time of model run 48 49 REAL(wp), DIMENSION(jpbdim,jpk,2) :: tbdydta, sbdydta ! time interpolated values of T and S bdy data 50 REAL(wp), DIMENSION(jpbdim,jpk,2) :: ubdydta, vbdydta ! time interpolated values of U and V bdy data 51 REAL(wp), DIMENSION(jpbdim,2) :: ubtbdydta, vbtbdydta ! Arrays used for time interpolation of bdy data 52 REAL(wp), DIMENSION(jpbdim,2) :: sshbdydta ! bdy data of ssh 54 53 55 54 #if defined key_lim2 56 REAL(wp), DIMENSION(jpbdim,2) :: frld_bdydta ! :}57 REAL(wp), DIMENSION(jpbdim,2) :: hicif_bdydta ! : } Arrays used for time interpolation of bdy data for ice variables58 REAL(wp), DIMENSION(jpbdim,2) :: hsnif_bdydta ! :}55 REAL(wp), DIMENSION(jpbdim,2) :: frld_bdydta ! } 56 REAL(wp), DIMENSION(jpbdim,2) :: hicif_bdydta ! } Arrays used for time interp. of ice bdy data 57 REAL(wp), DIMENSION(jpbdim,2) :: hsnif_bdydta ! } 59 58 #endif 60 59 61 60 !!---------------------------------------------------------------------- 62 !! NEMO/OPA 3. 0 , LOCEAN-IPSL (2008)61 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 63 62 !! $Id$ 64 63 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 65 64 !!---------------------------------------------------------------------- 66 67 65 CONTAINS 68 66 … … 78 76 !! the file. If so read it in. Time interpolate. 79 77 !!---------------------------------------------------------------------- 80 INTEGER, INTENT( in ) :: kt 78 INTEGER, INTENT( in ) :: kt ! ocean time-step index (for timesplitting option, otherwise zero) 81 79 !! 82 80 CHARACTER(LEN=80), DIMENSION(3) :: clfile ! names of input files … … 90 88 INTEGER :: itimer, totime 91 89 INTEGER :: ii, ij ! array addresses 92 INTEGER :: ipi, ipj, ipk, inum ! temporaryintegers (NetCDF read)90 INTEGER :: ipi, ipj, ipk, inum ! local integers (NetCDF read) 93 91 INTEGER :: iyear0, imonth0, iday0 94 92 INTEGER :: ihours0, iminutes0, isec0 … … 102 100 !!--------------------------------------------------------------------------- 103 101 104 IF( ln_bdy_dyn_frs .OR. ln_bdy_tra_frs ) THEN ! If these are both false then this routine 105 ! does nothing. 102 103 IF( ln_bdy_dyn_frs .OR. ln_bdy_tra_frs & 104 & .OR. ln_bdy_ice_frs ) THEN ! If these are both false then this routine does nothing 106 105 107 106 ! -------------------- ! … … 113 112 ! Some time variables for monthly climatological forcing: 114 113 ! ******************************************************* 115 !!gm here use directely daymod variables 114 115 !!gm here use directely daymod calendar variables 116 116 117 117 iman = INT( raamo ) ! Number of months in a year … … 132 132 ! !-------------------! 133 133 istep(:) = 0 134 nbdy_b 135 nbdy_a 134 nbdy_b = 0 135 nbdy_a = 0 136 136 137 137 ! Get time information from bdy data file … … 162 162 igrd_start = 1 163 163 igrd_end = 3 164 IF(.NOT. ln_bdy_tra_frs .AND. .NOT. ln_bdy_ice_frs) THEN 165 ! No T-grid file. 164 IF(.NOT. ln_bdy_tra_frs .AND. .NOT. ln_bdy_ice_frs) THEN ! No T-grid file. 166 165 igrd_start = 2 167 ELSEIF ( .NOT. ln_bdy_dyn_frs ) THEN 168 ! No U-grid or V-grid file. 166 ELSEIF ( .NOT. ln_bdy_dyn_frs ) THEN ! No U-grid or V-grid file. 169 167 igrd_end = 1 170 168 ENDIF … … 176 174 177 175 SELECT CASE( igrd ) 178 CASE (1) 179 numbdyt = inum 180 CASE (2) 181 numbdyu = inum 182 CASE (3) 183 numbdyv = inum 176 CASE (1) ; numbdyt = inum 177 CASE (2) ; numbdyu = inum 178 CASE (3) ; numbdyv = inum 184 179 END SELECT 185 180 … … 216 211 217 212 ! Check that time array increases: 218 219 213 it = 1 220 DO WHILE( zstepr(it+1) > zstepr(it) .AND. it /= ntimes_bdy - 1 ) 221 it = it + 1214 DO WHILE( zstepr(it+1) > zstepr(it) .AND. it /= ntimes_bdy - 1 ) 215 it = it + 1 222 216 END DO 223 224 IF( it .NE.ntimes_bdy-1 .AND. ntimes_bdy > 1 ) THEN217 ! 218 IF( it /= ntimes_bdy-1 .AND. ntimes_bdy > 1 ) THEN 225 219 WRITE(ctmp1,*) 'Check file: ', clfile(igrd) 226 220 CALL ctl_stop( 'Time array in unstructured boundary data files', & … … 274 268 ENDIF 275 269 276 IF( igrd_start == 1 ) THEN 277 istep(:) = istept(:) 278 ELSE 279 istep(:) = istepu(:) 270 IF( igrd_start == 1 ) THEN ; istep(:) = istept(:) 271 ELSE ; istep(:) = istepu(:) 280 272 ENDIF 281 273 … … 302 294 it = 1 303 295 DO WHILE( istep(it+1) <= 0 .AND. it <= ntimes_bdy - 1 ) 304 it = it + 1296 it = it + 1 305 297 END DO 306 298 nbdy_b = it … … 315 307 ! ***************************************************************** 316 308 317 IF( nbdy_dta == 0 ) THEN ! boundary data arrays are filled with initial conditions309 IF( nbdy_dta == 0 ) THEN ! boundary data arrays are filled with initial conditions 318 310 ! 319 311 IF (ln_bdy_tra_frs) THEN 320 igrd = 1 ! T-points data321 DO ib = 1, nblen(igrd)322 ii = nbi(ib,igrd)323 ij = nbj(ib,igrd)324 DO ik = 1, jpkm1325 tbdy(ib,ik) = tn(ii, ij,ik)326 sbdy(ib,ik) = sn(ii, ij,ik)327 ENDDO328 END DO312 igrd = 1 ! T-points data 313 DO ib = 1, nblen(igrd) 314 ii = nbi(ib,igrd) 315 ij = nbj(ib,igrd) 316 DO ik = 1, jpkm1 317 tbdy(ib,ik) = tn(ii,ij,ik) 318 sbdy(ib,ik) = sn(ii,ij,ik) 319 END DO 320 END DO 329 321 ENDIF 330 322 331 323 IF(ln_bdy_dyn_frs) THEN 332 igrd = 2 ! U-points data333 DO ib = 1, nblen(igrd)334 ii = nbi(ib,igrd)335 ij = nbj(ib,igrd)336 DO ik = 1, jpkm1337 ubdy(ib,ik) = un(ii, ij, ik)338 ENDDO339 END DO340 341 igrd = 3 ! V-points data342 DO ib = 1, nblen(igrd)343 ii = nbi(ib,igrd)344 ij = nbj(ib,igrd)345 DO ik = 1, jpkm1346 vbdy(ib,ik) = vn(ii, ij, ik)347 ENDDO348 END DO324 igrd = 2 ! U-points data 325 DO ib = 1, nblen(igrd) 326 ii = nbi(ib,igrd) 327 ij = nbj(ib,igrd) 328 DO ik = 1, jpkm1 329 ubdy(ib,ik) = un(ii, ij, ik) 330 END DO 331 END DO 332 ! 333 igrd = 3 ! V-points data 334 DO ib = 1, nblen(igrd) 335 ii = nbi(ib,igrd) 336 ij = nbj(ib,igrd) 337 DO ik = 1, jpkm1 338 vbdy(ib,ik) = vn(ii, ij, ik) 339 END DO 340 END DO 349 341 ENDIF 350 342 ! 351 343 #if defined key_lim2 352 IF (ln_bdy_ice_frs) THEN344 IF( ln_bdy_ice_frs ) THEN 353 345 igrd = 1 ! T-points data 354 346 DO ib = 1, nblen(igrd) 355 frld_bdy (ib)= frld(nbi(ib,igrd), nbj(ib,igrd))347 frld_bdy (ib) = frld(nbi(ib,igrd), nbj(ib,igrd)) 356 348 hicif_bdy(ib) = hicif(nbi(ib,igrd), nbj(ib,igrd)) 357 349 hsnif_bdy(ib) = hsnif(nbi(ib,igrd), nbj(ib,igrd)) … … 377 369 378 370 IF(ln_bdy_tra_frs) THEN 371 ! 379 372 igrd = 1 ! Temperature 380 373 IF( nblendta(igrd) <= 0 ) THEN … … 385 378 ipi = nblendta(igrd) 386 379 CALL iom_get ( numbdyt, jpdom_unknown, 'votemper', zdta(1:ipi,1:ipj,1:ipk), nbdy_a ) 387 380 ! 388 381 DO ib = 1, nblen(igrd) 389 382 DO ik = 1, jpkm1 … … 400 393 ipi = nblendta(igrd) 401 394 CALL iom_get ( numbdyt, jpdom_unknown, 'vosaline', zdta(1:ipi,1:ipj,1:ipk), nbdy_a ) 402 395 ! 403 396 DO ib = 1, nblen(igrd) 404 397 DO ik = 1, jpkm1 … … 408 401 ENDIF ! ln_bdy_tra_frs 409 402 410 IF( ln_bdy_dyn_frs) THEN411 403 IF( ln_bdy_dyn_frs ) THEN 404 ! 412 405 igrd = 2 ! u-velocity 413 406 IF ( nblendta(igrd) .le. 0 ) THEN … … 440 433 441 434 #if defined key_lim2 442 IF( ln_bdy_ice_frs) THEN435 IF( ln_bdy_ice_frs ) THEN 443 436 ! 444 437 igrd=1 ! leads fraction … … 468 461 #endif 469 462 470 IF ((.NOT.ln_bdy_clim) .AND. (istep(1) > 0)) THEN 471 ! First data time is after start of run 472 ! Put first value in both time levels 463 IF( .NOT.ln_bdy_clim .AND. istep(1) > 0 ) THEN ! First data time is after start of run 464 nbdy_b = nbdy_a ! Put first value in both time levels 465 IF( ln_bdy_tra_frs ) THEN 466 tbdydta(:,:,1) = tbdydta(:,:,2) 467 sbdydta(:,:,1) = sbdydta(:,:,2) 468 ENDIF 469 IF( ln_bdy_dyn_frs ) THEN 470 ubdydta(:,:,1) = ubdydta(:,:,2) 471 vbdydta(:,:,1) = vbdydta(:,:,2) 472 ENDIF 473 #if defined key_lim2 474 IF( ln_bdy_ice_frs ) THEN 475 frld_bdydta (:,1) = frld_bdydta(:,2) 476 hicif_bdydta(:,1) = hicif_bdydta(:,2) 477 hsnif_bdydta(:,1) = hsnif_bdydta(:,2) 478 ENDIF 479 #endif 480 END IF 481 ! 482 END IF ! nbdy_dta == 0/1 483 484 ! In the case of constant boundary forcing fill bdy arrays once for all 485 IF( ln_bdy_clim .AND. ntimes_bdy == 1 ) THEN 486 IF( ln_bdy_tra_frs ) THEN 487 tbdy (:,:) = tbdydta (:,:,2) 488 sbdy (:,:) = sbdydta (:,:,2) 489 ENDIF 490 IF( ln_bdy_dyn_frs) THEN 491 ubdy (:,:) = ubdydta (:,:,2) 492 vbdy (:,:) = vbdydta (:,:,2) 493 ENDIF 494 #if defined key_lim2 495 IF( ln_bdy_ice_frs ) THEN 496 frld_bdy (:) = frld_bdydta (:,2) 497 hicif_bdy(:) = hicif_bdydta(:,2) 498 hsnif_bdy(:) = hsnif_bdydta(:,2) 499 ENDIF 500 #endif 501 502 IF( ln_bdy_tra_frs .OR. ln_bdy_ice_frs) CALL iom_close( numbdyt ) 503 IF( ln_bdy_dyn_frs ) CALL iom_close( numbdyu ) 504 IF( ln_bdy_dyn_frs ) CALL iom_close( numbdyv ) 505 END IF 506 ! 507 ENDIF ! End if nit000 508 509 510 ! !---------------------! 511 IF( nbdy_dta == 1 .AND. ntimes_bdy > 1 ) THEN ! at each time step ! 512 ! !---------------------! 513 ! Read one more record if necessary 514 !********************************** 515 516 IF( ln_bdy_clim .AND. imois /= nbdy_b ) THEN ! remember that nbdy_b=0 for kt=nit000 517 nbdy_b = imois 518 nbdy_a = imois + 1 519 nbdy_b = MOD( nbdy_b, iman ) ; IF( nbdy_b == 0 ) nbdy_b = iman 520 nbdy_a = MOD( nbdy_a, iman ) ; IF( nbdy_a == 0 ) nbdy_a = iman 521 lect=.true. 522 ELSEIF( .NOT.ln_bdy_clim .AND. itimer >= istep(nbdy_a) ) THEN 523 524 IF( nbdy_a < ntimes_bdy ) THEN 525 nbdy_b = nbdy_a 526 nbdy_a = nbdy_a + 1 527 lect =.true. 528 ELSE 529 ! We have reached the end of the file 530 ! put the last data time into both time levels 473 531 nbdy_b = nbdy_a 474 532 IF(ln_bdy_tra_frs) THEN 475 tbdydta(:,:,1) =tbdydta(:,:,2)476 sbdydta(:,:,1) =sbdydta(:,:,2)533 tbdydta(:,:,1) = tbdydta(:,:,2) 534 sbdydta(:,:,1) = sbdydta(:,:,2) 477 535 ENDIF 478 536 IF(ln_bdy_dyn_frs) THEN 479 ubdydta(:,:,1) =ubdydta(:,:,2)480 vbdydta(:,:,1) =vbdydta(:,:,2)537 ubdydta(:,:,1) = ubdydta(:,:,2) 538 vbdydta(:,:,1) = vbdydta(:,:,2) 481 539 ENDIF 482 540 #if defined key_lim2 483 IF( ln_bdy_ice_frs ) THEN 484 frld_bdydta (:,1) = frld_bdydta(:,2) 485 hicif_bdydta(:,1) = hicif_bdydta(:,2) 486 hsnif_bdydta(:,1) = hsnif_bdydta(:,2) 487 ENDIF 488 #endif 489 END IF 490 491 END IF ! nbdy_dta == 0/1 492 493 ! In the case of constant boundary forcing fill bdy arrays once for all 494 IF ((ln_bdy_clim).AND.(ntimes_bdy==1)) THEN 495 IF(ln_bdy_tra_frs) THEN 496 tbdy (:,:) = tbdydta (:,:,2) 497 sbdy (:,:) = sbdydta (:,:,2) 498 ENDIF 499 IF(ln_bdy_dyn_frs) THEN 500 ubdy (:,:) = ubdydta (:,:,2) 501 vbdy (:,:) = vbdydta (:,:,2) 502 ENDIF 503 #if defined key_lim2 504 IF(ln_bdy_ice_frs) THEN 505 frld_bdy (:) = frld_bdydta (:,2) 506 hicif_bdy(:) = hicif_bdydta(:,2) 507 hsnif_bdy(:) = hsnif_bdydta(:,2) 508 ENDIF 509 #endif 510 511 IF(ln_bdy_tra_frs .or. ln_bdy_ice_frs) CALL iom_close( numbdyt ) 512 IF(ln_bdy_dyn_frs) CALL iom_close( numbdyu ) 513 IF(ln_bdy_dyn_frs) CALL iom_close( numbdyv ) 514 END IF 515 516 ENDIF ! End if nit000 517 518 519 ! !---------------------! 520 ! ! at each time step ! 521 ! !---------------------! 522 523 IF( nbdy_dta == 1 .AND. ntimes_bdy > 1 ) THEN 524 ! 525 ! Read one more record if necessary 526 !********************************** 527 528 IF( ln_bdy_clim .AND. imois /= nbdy_b ) THEN ! remember that nbdy_b=0 for kt=nit000 529 nbdy_b = imois 530 nbdy_a = imois + 1 531 nbdy_b = MOD( nbdy_b, iman ) ; IF( nbdy_b == 0 ) nbdy_b = iman 532 nbdy_a = MOD( nbdy_a, iman ) ; IF( nbdy_a == 0 ) nbdy_a = iman 533 lect=.true. 534 ELSEIF( .NOT.ln_bdy_clim .AND. itimer >= istep(nbdy_a) ) THEN 535 536 IF ( nbdy_a < ntimes_bdy ) THEN 537 nbdy_b = nbdy_a 538 nbdy_a = nbdy_a + 1 539 lect =.true. 540 ELSE 541 ! We have reached the end of the file 542 ! put the last data time into both time levels 543 nbdy_b = nbdy_a 544 IF(ln_bdy_tra_frs) THEN 545 tbdydta(:,:,1) = tbdydta(:,:,2) 546 sbdydta(:,:,1) = sbdydta(:,:,2) 547 ENDIF 548 IF(ln_bdy_dyn_frs) THEN 549 ubdydta(:,:,1) = ubdydta(:,:,2) 550 vbdydta(:,:,1) = vbdydta(:,:,2) 551 ENDIF 552 #if defined key_lim2 553 IF(ln_bdy_ice_frs) THEN 554 frld_bdydta (:,1) = frld_bdydta (:,2) 555 hicif_bdydta(:,1) = hicif_bdydta(:,2) 556 hsnif_bdydta(:,1) = hsnif_bdydta(:,2) 557 ENDIF 541 IF(ln_bdy_ice_frs) THEN 542 frld_bdydta (:,1) = frld_bdydta (:,2) 543 hicif_bdydta(:,1) = hicif_bdydta(:,2) 544 hsnif_bdydta(:,1) = hsnif_bdydta(:,2) 545 ENDIF 558 546 #endif 559 547 END IF ! nbdy_a < ntimes_bdy 560 548 ! 561 549 END IF 562 550 563 IF( lect ) THEN 564 ! Swap arrays 565 IF(ln_bdy_tra_frs) THEN 551 IF( lect ) THEN ! Swap arrays 552 IF( ln_bdy_tra_frs ) THEN 566 553 tbdydta(:,:,1) = tbdydta(:,:,2) 567 554 sbdydta(:,:,1) = sbdydta(:,:,2) 568 555 ENDIF 569 IF( ln_bdy_dyn_frs) THEN556 IF( ln_bdy_dyn_frs ) THEN 570 557 ubdydta(:,:,1) = ubdydta(:,:,2) 571 558 vbdydta(:,:,1) = vbdydta(:,:,2) 572 559 ENDIF 573 560 #if defined key_lim2 574 IF( ln_bdy_ice_frs) THEN561 IF( ln_bdy_ice_frs ) THEN 575 562 frld_bdydta (:,1) = frld_bdydta (:,2) 576 563 hicif_bdydta(:,1) = hicif_bdydta(:,2) … … 582 569 ipk = jpk 583 570 584 IF( ln_bdy_tra_frs) THEN571 IF( ln_bdy_tra_frs ) THEN 585 572 ! 586 573 igrd = 1 ! temperature … … 720 707 ! 721 708 ENDIF ! ln_bdy_dyn_frs .OR. ln_bdy_tra_frs 722 709 ! 723 710 END SUBROUTINE bdy_dta 724 711 -
branches/DEV_r1986_BDY_updates/NEMO/OPA_SRC/BDY/bdydyn.F90
r2093 r2168 36 36 37 37 !!---------------------------------------------------------------------- 38 !! NEMO/OPA 3. 0 , LOCEAN-IPSL (2008)38 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 39 39 !! $Id$ 40 40 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 41 41 !!---------------------------------------------------------------------- 42 43 42 CONTAINS 44 43 … … 56 55 INTEGER, INTENT( in ) :: kt ! Main time step counter 57 56 !! 58 INTEGER :: ib, ik, igrd! dummy loop indices59 INTEGER :: ii, ij ! 2D addresses60 REAL(wp) :: zwgt 57 INTEGER :: jb, jk ! dummy loop indices 58 INTEGER :: ii, ij, igrd ! local integers 59 REAL(wp) :: zwgt ! boundary weight 61 60 !!---------------------------------------------------------------------- 62 61 ! 63 IF(ln_bdy_dyn_frs) THEN ! If this is false, then this routine does nothing.64 62 IF(ln_bdy_dyn_frs) THEN ! If this is false, then this routine does nothing. 63 ! 65 64 IF( kt == nit000 ) THEN 66 65 IF(lwp) WRITE(numout,*) … … 70 69 ! 71 70 igrd = 2 ! Relaxation of zonal velocity 72 DO ib = 1, nblen(igrd)73 DO ik = 1, jpkm174 ii = nbi(ib,igrd)75 ij = nbj(ib,igrd)76 zwgt = nbw( ib,igrd)77 ua(ii,ij, ik) = ( ua(ii,ij,ik) * ( 1.- zwgt ) + ubdy(ib,ik) * zwgt ) * umask(ii,ij,ik)71 DO jb = 1, nblen(igrd) 72 DO jk = 1, jpkm1 73 ii = nbi(jb,igrd) 74 ij = nbj(jb,igrd) 75 zwgt = nbw(jb,igrd) 76 ua(ii,ij,jk) = ( ua(ii,ij,jk) * ( 1.- zwgt ) + ubdy(jb,jk) * zwgt ) * umask(ii,ij,jk) 78 77 END DO 79 78 END DO 80 79 ! 81 80 igrd = 3 ! Relaxation of meridional velocity 82 DO ib = 1, nblen(igrd)83 DO ik = 1, jpkm184 ii = nbi(ib,igrd)85 ij = nbj(ib,igrd)86 zwgt = nbw( ib,igrd)87 va(ii,ij, ik) = ( va(ii,ij,ik) * ( 1.- zwgt ) + vbdy(ib,ik) * zwgt ) * vmask(ii,ij,ik)81 DO jb = 1, nblen(igrd) 82 DO jk = 1, jpkm1 83 ii = nbi(jb,igrd) 84 ij = nbj(jb,igrd) 85 zwgt = nbw(jb,igrd) 86 va(ii,ij,jk) = ( va(ii,ij,jk) * ( 1.- zwgt ) + vbdy(jb,jk) * zwgt ) * vmask(ii,ij,jk) 88 87 END DO 89 88 END DO 90 ! 91 CALL lbc_lnk( ua, 'U', -1. ) ! Boundary points should be updated 92 CALL lbc_lnk( va, 'V', -1. ) ! 89 CALL lbc_lnk( ua, 'U', -1. ) ; CALL lbc_lnk( va, 'V', -1. ) ! Boundary points should be updated 93 90 ! 94 91 ENDIF ! ln_bdy_dyn_frs 95 92 ! 96 93 END SUBROUTINE bdy_dyn_frs 97 94 98 95 99 #if defined key_dynspg_exp || defined key_dynspg_ts 96 # if defined key_dynspg_exp || defined key_dynspg_ts 97 !!---------------------------------------------------------------------- 98 !! 'key_dynspg_exp' OR explicit sea surface height 99 !! 'key_dynspg_ts ' split-explicit sea surface height 100 !!---------------------------------------------------------------------- 101 100 102 !! Option to use Flather with dynspg_flt not coded yet... 103 101 104 SUBROUTINE bdy_dyn_fla( pssh ) 102 105 !!---------------------------------------------------------------------- … … 121 124 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pssh 122 125 123 INTEGER :: ib, igrd ! dummy loop indices126 INTEGER :: jb, igrd ! dummy loop indices 124 127 INTEGER :: ii, ij, iim1, iip1, ijm1, ijp1 ! 2D addresses 125 128 REAL(wp) :: zcorr ! Flather correction … … 136 139 igrd = 4 137 140 spgu(:,:) = 0.0 138 DO ib = 1, nblenrim(igrd)139 ii = nbi( ib,igrd)140 ij = nbj( ib,igrd)141 IF( ln_bdy_dyn_fla ) spgu(ii, ij) = sshbdy( ib)142 IF( ln_bdy_tides ) spgu(ii, ij) = spgu(ii, ij) + sshtide( ib)141 DO jb = 1, nblenrim(igrd) 142 ii = nbi(jb,igrd) 143 ij = nbj(jb,igrd) 144 IF( ln_bdy_dyn_fla ) spgu(ii, ij) = sshbdy(jb) 145 IF( ln_bdy_tides ) spgu(ii, ij) = spgu(ii, ij) + sshtide(jb) 143 146 END DO 144 147 ! … … 146 149 ! ! remember that flagu=-1 if normal velocity direction is outward 147 150 ! ! I think we should rather use after ssh ? 148 DO ib = 1, nblenrim(igrd)149 ii = nbi( ib,igrd)150 ij = nbj( ib,igrd)151 iim1 = ii + MAX( 0, INT( flagu( ib) ) ) ! T pts i-indice inside the boundary152 iip1 = ii - MIN( 0, INT( flagu( ib) ) ) ! T pts i-indice outside the boundary151 DO jb = 1, nblenrim(igrd) 152 ii = nbi(jb,igrd) 153 ij = nbj(jb,igrd) 154 iim1 = ii + MAX( 0, INT( flagu(jb) ) ) ! T pts i-indice inside the boundary 155 iip1 = ii - MIN( 0, INT( flagu(jb) ) ) ! T pts i-indice outside the boundary 153 156 ! 154 zcorr = - flagu( ib) * SQRT( grav * hur_e(ii, ij) ) * ( pssh(iim1, ij) - spgu(iip1,ij) )155 zforc = ubtbdy( ib) + utide(ib)157 zcorr = - flagu(jb) * SQRT( grav * hur_e(ii, ij) ) * ( pssh(iim1, ij) - spgu(iip1,ij) ) 158 zforc = ubtbdy(jb) + utide(jb) 156 159 ua_e(ii,ij) = zforc + zcorr * umask(ii,ij,1) 157 160 END DO … … 159 162 igrd = 6 ! Flather bc on v-velocity 160 163 ! ! remember that flagv=-1 if normal velocity direction is outward 161 DO ib = 1, nblenrim(igrd)162 ii = nbi( ib,igrd)163 ij = nbj( ib,igrd)164 ijm1 = ij + MAX( 0, INT( flagv( ib) ) ) ! T pts j-indice inside the boundary165 ijp1 = ij - MIN( 0, INT( flagv( ib) ) ) ! T pts j-indice outside the boundary164 DO jb = 1, nblenrim(igrd) 165 ii = nbi(jb,igrd) 166 ij = nbj(jb,igrd) 167 ijm1 = ij + MAX( 0, INT( flagv(jb) ) ) ! T pts j-indice inside the boundary 168 ijp1 = ij - MIN( 0, INT( flagv(jb) ) ) ! T pts j-indice outside the boundary 166 169 ! 167 zcorr = - flagv( ib) * SQRT( grav * hvr_e(ii, ij) ) * ( pssh(ii, ijm1) - spgu(ii,ijp1) )168 zforc = vbtbdy( ib) + vtide(ib)170 zcorr = - flagv(jb) * SQRT( grav * hvr_e(ii, ij) ) * ( pssh(ii, ijm1) - spgu(ii,ijp1) ) 171 zforc = vbtbdy(jb) + vtide(jb) 169 172 va_e(ii,ij) = zforc + zcorr * vmask(ii,ij,1) 170 173 END DO -
branches/DEV_r1986_BDY_updates/NEMO/OPA_SRC/BDY/bdyice.F90
r2093 r2168 1 1 MODULE bdyice 2 !!====================================================================== ===========2 !!====================================================================== 3 3 !! *** MODULE bdyice *** 4 !! Ocean tracers: Flow Relaxation Scheme of sea-ice fields on each open boundary 5 !!================================================================================= 6 #if defined key_bdy && defined key_lim2 7 !!--------------------------------------------------------------------------------- 8 !! 'key_bdy' : Unstructured Open Boundary Conditions 9 !!--------------------------------------------------------------------------------- 4 !! Unstructured Open Boundary Cond. : Flow Relaxation Scheme applied sea-ice 5 !!====================================================================== 6 !! History : 3.3 ! 2010-09 (D. Storkey) Original code 7 !!---------------------------------------------------------------------- 8 #if defined key_bdy && defined key_lim2 9 !!---------------------------------------------------------------------- 10 !! 'key_bdy' and Unstructured Open Boundary Conditions 11 !! 'key_lim2' LIM-2 sea ice model 12 !!---------------------------------------------------------------------- 10 13 !! bdy_ice : Relaxation of tracers on unstructured open boundaries 11 !!--------------------------------------------------------------------------------- 12 !! * Modules used 14 !!---------------------------------------------------------------------- 13 15 USE oce ! ocean dynamics and tracers variables 14 #if defined key_lim215 16 USE ice_2 ! LIM_2 ice variables 16 #endif17 17 USE dom_oce ! ocean space and time domain variables 18 18 USE bdy_oce ! ocean open boundary conditions 19 19 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 20 20 USE in_out_manager ! write to numout file 21 21 22 IMPLICIT NONE 22 23 PRIVATE 23 24 24 !! * Accessibility 25 PUBLIC bdy_ice ! routine called in stp 25 PUBLIC bdy_ice ! routine called in sbcmod 26 26 27 !! * Substitutions 28 29 !!--------------------------------------------------------------------------------- 30 !! OPA 9.0 , LODYC-IPSL (2003) 31 !!--------------------------------------------------------------------------------- 32 27 !!---------------------------------------------------------------------- 28 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 29 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 30 !!---------------------------------------------------------------------- 33 31 CONTAINS 34 32 … … 37 35 !! *** SUBROUTINE bdy_ice *** 38 36 !! 39 !! ** Purpose : Apply the Flow Relaxation Scheme for sea-ice fields in the 40 !! case of unstructured open boundaries. Currently only tested 41 !! for LIM2. 37 !! ** Purpose : Apply the Flow Relaxation Scheme for sea-ice fields in the case 38 !! of unstructured open boundaries. Currently only tested for LIM2. 42 39 !! 43 !! Reference : Engedahl H., 1995: Use of the flow relaxation scheme in 44 !! a three-dimensional baroclinic ocean model with realistic 45 !! topography. Tellus, 365-382. 46 !! History : 47 !! NEMO 3.3 ! 2010-09 (D. Storkey) Original code 40 !! Reference : Engedahl H., 1995: Use of the flow relaxation scheme in a three- 41 !! dimensional baroclinic ocean model with realistic topography. Tellus, 365-382. 48 42 !!------------------------------------------------------------------------------ 49 !! * Arguments 50 INTEGER, INTENT( in ) :: kt 51 52 !! * Local declarations 53 REAL(wp) :: zwgt ! boundary weight 54 INTEGER :: jb, jk, jgrd ! dummy loop indices 55 INTEGER :: ii, ij ! 2D addresses 43 INTEGER, INTENT( in ) :: kt ! model time step index 44 !! 45 INTEGER :: jb, jk, jgrd ! dummy loop indices 46 INTEGER :: ii, ij ! local scalar 47 REAL(wp) :: zwgt, zwgt1 ! local scalar 56 48 !!------------------------------------------------------------------------------ 57 58 jgrd=1 !: Everything is at T-points here 59 60 IF(ln_bdy_ice_frs) THEN 61 62 DO jb = 1, nblen(jgrd) 63 DO jk = 1, jpkm1 64 ii = nbi(jb,jgrd) 65 ij = nbj(jb,jgrd) 66 zwgt = nbw(jb,jgrd) 67 68 ! Leads fraction relaxation at the boundary 69 frld(ii,ij) = ( frld(ii,ij)*(1.-zwgt) + frld_bdy(jb)*zwgt ) & 70 * tmask(ii,ij,1) 71 72 ! Ice depth relaxation at the boundary 73 hicif(ii,ij) = ( hicif(ii,ij)*(1.-zwgt) + hicif_bdy(jb)*zwgt ) & 74 * tmask(ii,ij,1) 75 ! Snow depth relaxation at the boundary 76 hsnif(ii,ij) = ( hsnif(ii,ij)*(1.-zwgt) + hsnif_bdy(jb)*zwgt ) & 77 * tmask(ii,ij,1) 78 79 END DO 80 END DO 81 82 CALL lbc_lnk( frld, 'T', 1. ) ! Boundary points should be updated 83 CALL lbc_lnk( hicif, 'T', 1. ) ! 84 CALL lbc_lnk( hsnif, 'T', 1. ) ! 85 86 ELSE 87 ! we have called this routine without ln_bdy_ice_frs not set 88 IF(kt .EQ. nit000) THEN 89 WRITE(numout,*) 'E R R O R (possible) called bdy_ice when' 90 WRITE(numout,*) 'ln_bdy_ice_frs is false?' 91 ENDIF 92 ENDIF ! if ln_bdy_ice_frs 93 49 ! 50 jgrd = 1 ! Everything is at T-points here 51 ! 52 IF( ln_bdy_ice_frs ) THEN ! update ice fields by relaxation at the boundary 53 DO jb = 1, nblen(jgrd) 54 DO jk = 1, jpkm1 55 ii = nbi(jb,jgrd) 56 ij = nbj(jb,jgrd) 57 zwgt = nbw(jb,jgrd) 58 zwgt1 = 1.e0 - nbw(jb,jgrd) 59 frld (ii,ij) = ( frld (ii,ij) * zwgt1 + frld_bdy (jb) * zwgt ) * tmask(ii,ij,1) ! Leads fraction 60 hicif(ii,ij) = ( hicif(ii,ij) * zwgt1 + hicif_bdy(jb) * zwgt ) * tmask(ii,ij,1) ! Ice depth 61 hsnif(ii,ij) = ( hsnif(ii,ij) * zwgt1 + hsnif_bdy(jb) * zwgt ) * tmask(ii,ij,1) ! Snow depth 62 END DO 63 END DO 64 CALL lbc_lnk( frld, 'T', 1. ) ! lateral boundary conditions 65 CALL lbc_lnk( hicif, 'T', 1. ) ; CALL lbc_lnk( hsnif, 'T', 1. ) 66 ! 67 ELSE ! we have called this routine without ln_bdy_ice_frs not set 68 IF( kt == nit000 ) CALL ctl_warn( 'E R R O R (possible) called bdy_ice when ln_bdy_ice_frs is false?' ) 69 ENDIF 70 ! 94 71 END SUBROUTINE bdy_ice 95 72 #else … … 99 76 CONTAINS 100 77 SUBROUTINE bdy_ice( kt ) ! Empty routine 78 WRITE(*,*) 'bdy_ice: You should not have seen this print! error?', kt 101 79 END SUBROUTINE bdy_ice 102 80 #endif -
branches/DEV_r1986_BDY_updates/NEMO/OPA_SRC/BDY/bdyini.F90
r2093 r2168 19 19 USE oce ! ocean dynamics and tracers variables 20 20 USE dom_oce ! ocean space and time domain 21 USE obc_par ! ocean open boundary conditions 21 22 USE bdy_oce ! unstructured open boundary conditions 22 23 USE bdytides ! tides at open boundaries initialization (tide_init routine) … … 32 33 33 34 !!---------------------------------------------------------------------- 34 !! NEMO/OPA 3. 0 , LOCEAN-IPSL (2008)35 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 35 36 !! $Id$ 36 37 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 37 !!--------------------------------------------------------------------------------- 38 38 !!---------------------------------------------------------------------- 39 39 CONTAINS 40 40 … … 50 50 !! 51 51 !! ** Input : bdy_init.nc, input file for unstructured open boundaries 52 !!53 52 !!---------------------------------------------------------------------- 54 53 INTEGER :: ii, ij, ik, igrd, ib, ir ! dummy loop indices … … 56 55 INTEGER :: ib_len, ibr_max 57 56 INTEGER :: iw, ie, is, in 58 INTEGER :: inum ! temporarylogical unit59 INTEGER :: id_dummy ! temporaryintegers57 INTEGER :: inum ! local logical unit 58 INTEGER :: id_dummy ! local integers 60 59 INTEGER :: igrd_start, igrd_end ! start and end of loops on igrd 61 60 INTEGER, DIMENSION (2) :: kdimsz … … 68 67 !! 69 68 NAMELIST/nambdy/filbdy_mask, filbdy_data_T, filbdy_data_U, filbdy_data_V, & 70 & filbdy_data_bt_T, filbdy_data_bt_U, filbdy_data_bt_V, &69 & filbdy_data_bt_T, filbdy_data_bt_U, filbdy_data_bt_V, & 71 70 & ln_bdy_tides, ln_bdy_clim, ln_bdy_vol, ln_bdy_mask, & 72 71 & ln_bdy_dyn_fla, ln_bdy_dyn_frs, ln_bdy_tra_frs,ln_bdy_ice_frs, & 73 72 & nbdy_dta, nb_rimwidth, volbdy 74 75 73 !!---------------------------------------------------------------------- 76 74 … … 79 77 IF(lwp) WRITE(numout,*) '~~~~~~~~' 80 78 ! 81 IF( jperio /= 0 ) CALL ctl_stop( 'Cyclic or symmetric,', & 82 ' and unstructured open boundary condition are not compatible' ) 83 84 #if defined key_obc 85 CALL ctl_stop( 'Straight open boundaries,', & 86 ' and unstructured open boundaries are not compatible' ) 87 #endif 88 89 ! Read namelist parameters 79 IF( jperio /= 0 ) CALL ctl_stop( 'Cyclic or symmetric,', & 80 & ' and unstructured open boundary condition are not compatible' ) 81 82 IF( lk_obc ) CALL ctl_stop( 'Straight open boundaries,', & 83 & ' and unstructured open boundaries are not compatible' ) 84 90 85 ! --------------------------- 91 REWIND( numnam ) 86 REWIND( numnam ) ! Read namelist parameters 92 87 READ ( numnam, nambdy ) 93 88 94 ! control prints89 ! ! control prints 95 90 IF(lwp) WRITE(numout,*) ' nambdy' 96 91 97 ! Check nbdy_dta value92 ! ! check type of data used (nbdy_dta value) 98 93 IF(lwp) WRITE(numout,*) 'nbdy_dta =', nbdy_dta 99 IF(lwp) WRITE(numout,*) ' ' 100 SELECT CASE( nbdy_dta ) 101 CASE( 0 ) 102 IF(lwp) WRITE(numout,*) ' initial state used for bdy data' 103 CASE( 1 ) 104 IF(lwp) WRITE(numout,*) ' boundary data taken from file' 105 CASE DEFAULT 106 CALL ctl_stop( 'nbdy_dta must be 0 or 1' ) 94 IF(lwp) WRITE(numout,*) 95 SELECT CASE( nbdy_dta ) ! 96 CASE( 0 ) ; IF(lwp) WRITE(numout,*) ' initial state used for bdy data' 97 CASE( 1 ) ; IF(lwp) WRITE(numout,*) ' boundary data taken from file' 98 CASE DEFAULT ; CALL ctl_stop( 'nbdy_dta must be 0 or 1' ) 107 99 END SELECT 108 100 109 IF(lwp) WRITE(numout,*) ' '101 IF(lwp) WRITE(numout,*) 110 102 IF(lwp) WRITE(numout,*) 'Boundary rim width for the FRS nb_rimwidth = ', nb_rimwidth 111 103 112 IF(lwp) WRITE(numout,*) ' ' 113 IF(lwp) WRITE(numout,*) ' volbdy = ', volbdy 114 115 IF (ln_bdy_vol) THEN 116 SELECT CASE ( volbdy ) ! Check volbdy value 117 CASE( 1 ) 118 IF(lwp) WRITE(numout,*) ' The total volume will be constant' 119 CASE( 0 ) 120 IF(lwp) WRITE(numout,*) ' The total volume will vary according' 121 IF(lwp) WRITE(numout,*) ' to the surface E-P flux' 122 CASE DEFAULT 123 CALL ctl_stop( 'volbdy must be 0 or 1' ) 124 END SELECT 104 IF(lwp) WRITE(numout,*) 105 IF(lwp) WRITE(numout,*) ' volbdy = ', volbdy 106 107 IF( ln_bdy_vol ) THEN ! check volume conservation (volbdy value) 108 SELECT CASE ( volbdy ) 109 CASE( 1 ) ; IF(lwp) WRITE(numout,*) ' The total volume will be constant' 110 CASE( 0 ) ; IF(lwp) WRITE(numout,*) ' The total volume will vary according to the surface E-P flux' 111 CASE DEFAULT ; CALL ctl_stop( 'volbdy must be 0 or 1' ) 112 END SELECT 113 IF(lwp) WRITE(numout,*) 125 114 ELSE 126 IF(lwp) WRITE(numout,*) 'No volume correction with unstructured open boundaries' 127 IF(lwp) WRITE(numout,*) ' ' 128 ENDIF 129 130 IF (ln_bdy_tides) THEN 131 IF(lwp) WRITE(numout,*) ' ' 115 IF(lwp) WRITE(numout,*) 'No volume correction with unstructured open boundaries' 116 IF(lwp) WRITE(numout,*) 117 ENDIF 118 119 IF( ln_bdy_tides ) THEN 132 120 IF(lwp) WRITE(numout,*) 'Tidal harmonic forcing at unstructured open boundaries' 133 IF(lwp) WRITE(numout,*) ' ' 134 ENDIF 135 136 IF (ln_bdy_dyn_fla) THEN 137 IF(lwp) WRITE(numout,*) ' ' 121 IF(lwp) WRITE(numout,*) 122 ENDIF 123 124 IF( ln_bdy_dyn_fla ) THEN 138 125 IF(lwp) WRITE(numout,*) 'Flather condition on U, V at unstructured open boundaries' 139 IF(lwp) WRITE(numout,*) ' ' 140 ENDIF 141 142 IF (ln_bdy_dyn_frs) THEN 143 IF(lwp) WRITE(numout,*) ' ' 126 IF(lwp) WRITE(numout,*) 127 ENDIF 128 129 IF( ln_bdy_dyn_frs ) THEN 144 130 IF(lwp) WRITE(numout,*) 'FRS condition on U and V at unstructured open boundaries' 145 IF(lwp) WRITE(numout,*) ' ' 146 ENDIF 147 148 IF (ln_bdy_tra_frs) THEN 149 IF(lwp) WRITE(numout,*) ' ' 131 IF(lwp) WRITE(numout,*) 132 ENDIF 133 134 IF( ln_bdy_tra_frs ) THEN 150 135 IF(lwp) WRITE(numout,*) 'FRS condition on T & S fields at unstructured open boundaries' 151 IF(lwp) WRITE(numout,*) ' ' 152 ENDIF 153 154 IF (ln_bdy_ice_frs) THEN 155 IF(lwp) WRITE(numout,*) ' ' 136 IF(lwp) WRITE(numout,*) 137 ENDIF 138 139 IF( ln_bdy_ice_frs ) THEN 156 140 IF(lwp) WRITE(numout,*) 'FRS condition on ice fields at unstructured open boundaries' 157 IF(lwp) WRITE(numout,*) ' ' 158 ENDIF 159 160 ! Read tides namelist 161 ! ------------------------ 162 IF( ln_bdy_tides ) CALL tide_init 141 IF(lwp) WRITE(numout,*) 142 ENDIF 143 144 IF( ln_bdy_tides ) CALL tide_init ! Read tides namelist 145 163 146 164 147 ! Read arrays defining unstructured open boundaries … … 170 153 ! = 0 elsewhere 171 154 172 IF( cp_cfg == "eel" .AND. jp_cfg == 5 ) THEN 155 IF( cp_cfg == "eel" .AND. jp_cfg == 5 ) THEN ! EEL configuration at 5km resolution 173 156 zmask( : ,:) = 0.e0 174 157 zmask(jpizoom+1:jpizoom+jpiglo-2,:) = 1.e0 175 ELSE IF 158 ELSE IF( ln_bdy_mask ) THEN 176 159 CALL iom_open( filbdy_mask, inum ) 177 160 CALL iom_get ( inum, jpdom_data, 'bdy_msk', zmask(:,:) ) … … 181 164 ENDIF 182 165 183 ! Save mask over local domain 184 DO ij = 1, nlcj 166 DO ij = 1, nlcj ! Save mask over local domain 185 167 DO ii = 1, nlci 186 168 bdytmask(ii,ij) = zmask( mig(ii), mjg(ij) ) … … 197 179 END DO 198 180 END DO 199 200 ! Lateral boundary conditions 201 CALL lbc_lnk( bdyumask(:,:), 'U', 1. ) 202 CALL lbc_lnk( bdyvmask(:,:), 'V', 1. ) 181 CALL lbc_lnk( bdyumask(:,:), 'U', 1. ) ; CALL lbc_lnk( bdyvmask(:,:), 'V', 1. ) ! Lateral boundary cond. 182 203 183 204 184 ! Read discrete distance and mapping indices … … 210 190 IF( cp_cfg == "eel" .AND. jp_cfg == 5 ) THEN 211 191 icount = 0 212 ! Define west boundary (from ii=2 to ii=1+nb_rimwidth): 213 DO ir = 1, nb_rimwidth 192 DO ir = 1, nb_rimwidth ! Define west boundary (from ii=2 to ii=1+nb_rimwidth): 214 193 DO ij = 3, jpjglo-2 215 icount =icount+1194 icount = icount + 1 216 195 nbidta(icount,:) = ir + 1 + (jpizoom-1) 217 nbjdta(icount,:) = ij + (jpjzoom-1)196 nbjdta(icount,:) = ij + (jpjzoom-1) 218 197 nbrdta(icount,:) = ir 219 198 END DO 220 199 END DO 221 222 ! Define east boundary (from ii=jpiglo-1 to ii=jpiglo-nb_rimwidth): 223 DO ir=1,nb_rimwidth 200 ! 201 DO ir = 1, nb_rimwidth ! Define east boundary (from ii=jpiglo-1 to ii=jpiglo-nb_rimwidth): 224 202 DO ij=3,jpjglo-2 225 icount =icount+1203 icount = icount + 1 226 204 nbidta(icount,:) = jpiglo-ir + (jpizoom-1) 227 205 nbidta(icount,2) = jpiglo-ir-1 + (jpizoom-1) ! special case for u points … … 230 208 END DO 231 209 END DO 232 210 ! 233 211 ELSE ! Read indices and distances in unstructured boundary data files 234 235 IF( ln_bdy_tides ) THEN 236 ! Read tides input files for preference in case there are 237 ! no bdydata files. 212 ! 213 IF( ln_bdy_tides ) THEN ! Read tides input files for preference in case there are no bdydata files 238 214 clfile(4) = TRIM(filtide)//TRIM(tide_cpt(1))//'_grid_T.nc' 239 215 clfile(5) = TRIM(filtide)//TRIM(tide_cpt(1))//'_grid_U.nc' 240 216 clfile(6) = TRIM(filtide)//TRIM(tide_cpt(1))//'_grid_V.nc' 241 217 ENDIF 242 IF( ln_bdy_dyn_fla . and. .not. ln_bdy_tides ) THEN218 IF( ln_bdy_dyn_fla .AND. .NOT. ln_bdy_tides ) THEN 243 219 clfile(4) = filbdy_data_bt_T 244 220 clfile(5) = filbdy_data_bt_U … … 248 224 IF( ln_bdy_tra_frs ) THEN 249 225 clfile(1) = filbdy_data_T 250 IF( . not. ln_bdy_dyn_frs ) THEN251 clfile(2) = filbdy_data_T ! Dummy read re read T file for sake of 6 files252 clfile(3) = filbdy_data_T !226 IF( .NOT. ln_bdy_dyn_frs ) THEN 227 clfile(2) = filbdy_data_T ! Dummy read re read T file for sake of 6 files 228 clfile(3) = filbdy_data_T ! 253 229 ENDIF 254 230 ENDIF 255 231 IF( ln_bdy_dyn_frs ) THEN 256 IF( .not. ln_bdy_tra_frs ) THEN 257 clfile(1) = filbdy_data_U ! Dummy Read 258 ENDIF 232 IF( .NOT. ln_bdy_tra_frs ) clfile(1) = filbdy_data_U ! Dummy Read 259 233 clfile(2) = filbdy_data_U 260 234 clfile(3) = filbdy_data_V 261 235 ENDIF 262 236 263 ! how many files are we to read in? 264 IF(ln_bdy_tides .or. ln_bdy_dyn_fla) then 265 igrd_start = 4 237 ! ! how many files are we to read in? 238 IF(ln_bdy_tides .OR. ln_bdy_dyn_fla) igrd_start = 4 239 ! 240 IF(ln_bdy_tra_frs ) THEN ; igrd_start = 1 241 ELSEIF(ln_bdy_dyn_frs) THEN ; igrd_start = 2 266 242 ENDIF 267 268 IF(ln_bdy_tra_frs) then 269 igrd_start = 1 270 ELSEIF(ln_bdy_dyn_frs) then 271 igrd_start = 2 272 ENDIF 273 274 IF( ln_bdy_tra_frs ) then 275 igrd_end = 1 276 ENDIF 277 278 IF(ln_bdy_dyn_fla .or. ln_bdy_tides) THEN 279 igrd_end = 6 280 ELSEIF( ln_bdy_dyn_frs) THEN 281 igrd_end = 3 243 ! 244 IF( ln_bdy_tra_frs ) igrd_end = 1 245 ! 246 IF(ln_bdy_dyn_fla .OR. ln_bdy_tides) THEN ; igrd_end = 6 247 ELSEIF( ln_bdy_dyn_frs ) THEN ; igrd_end = 3 282 248 ENDIF 283 249 … … 287 253 IF(lwp) WRITE(numout,*) 'kdimsz : ',kdimsz 288 254 ib_len = kdimsz(1) 289 IF( ib_len > jpbdta) CALL ctl_stop( & 290 'Boundary data array in file too long.', & 291 'File :', TRIM(clfile(igrd)), & 292 'increase parameter jpbdta.' ) 255 IF( ib_len > jpbdta) CALL ctl_stop( 'Boundary data array in file too long.', & 256 & 'File :', TRIM(clfile(igrd)),'increase parameter jpbdta.' ) 293 257 294 258 CALL iom_get( inum, jpdom_unknown, 'nbidta', zdta(1:ib_len,:) ) … … 298 262 CALL iom_get( inum, jpdom_unknown, 'nbjdta', zdta(1:ib_len,:) ) 299 263 DO ii = 1,ib_len 300 nbjdta(ii,igrd) = INT( zdta(ii,1) )301 END DO 302 CALL iom_get 264 nbjdta(ii,igrd) = INT( zdta(ii,1) ) 265 END DO 266 CALL iom_get( inum, jpdom_unknown, 'nbrdta', zdta(1:ib_len,:) ) 303 267 DO ii = 1,ib_len 304 nbrdta(ii,igrd) = INT( zdta(ii,1) )268 nbrdta(ii,igrd) = INT( zdta(ii,1) ) 305 269 END DO 306 270 CALL iom_close( inum ) 307 271 308 ! Check that rimwidth in file is big enough for Frs case(barotropic is one): 309 IF( igrd < 4) then 310 ibr_max = MAXVAL( nbrdta(:,igrd) ) 311 IF(lwp) WRITE(numout,*) 312 IF(lwp) WRITE(numout,*) ' Maximum rimwidth in file is ', ibr_max 313 IF(lwp) WRITE(numout,*) ' nb_rimwidth from namelist is ', nb_rimwidth 314 IF (ibr_max < nb_rimwidth) CALL ctl_stop( & 315 'nb_rimwidth is larger than maximum rimwidth in file' ) 272 IF( igrd < 4) THEN ! Check that rimwidth in file is big enough for Frs case(barotropic is one): 273 ibr_max = MAXVAL( nbrdta(:,igrd) ) 274 IF(lwp) WRITE(numout,*) 275 IF(lwp) WRITE(numout,*) ' Maximum rimwidth in file is ', ibr_max 276 IF(lwp) WRITE(numout,*) ' nb_rimwidth from namelist is ', nb_rimwidth 277 IF (ibr_max < nb_rimwidth) CALL ctl_stop( 'nb_rimwidth is larger than maximum rimwidth in file' ) 316 278 ENDIF !Check igrd < 4 317 279 ! … … 329 291 330 292 DO igrd = igrd_start, igrd_end 331 icount = 0332 icountr = 0333 nblen(igrd) = 0334 nblenrim(igrd) = 0335 nblendta(igrd) = 0336 DO ir=1, nb_rimwidth337 DO ib = 1, jpbdta338 ! check if point is in local domain and equals ir339 IF( nbidta(ib,igrd) >= iw .AND. nbidta(ib,igrd) <= ie .AND. &340 & nbjdta(ib,igrd) >= is .AND. nbjdta(ib,igrd) <= in .AND. &341 & nbrdta(ib,igrd) == ir ) THEN342 !343 icount = icount + 1344 !345 IF( ir == 1 ) icountr = icountr+1293 icount = 0 294 icountr = 0 295 nblen (igrd) = 0 296 nblenrim(igrd) = 0 297 nblendta(igrd) = 0 298 DO ir=1, nb_rimwidth 299 DO ib = 1, jpbdta 300 ! check if point is in local domain and equals ir 301 IF( nbidta(ib,igrd) >= iw .AND. nbidta(ib,igrd) <= ie .AND. & 302 & nbjdta(ib,igrd) >= is .AND. nbjdta(ib,igrd) <= in .AND. & 303 & nbrdta(ib,igrd) == ir ) THEN 304 ! 305 icount = icount + 1 306 ! 307 IF( ir == 1 ) icountr = icountr+1 346 308 IF (icount > jpbdim) THEN 347 309 IF(lwp) WRITE(numout,*) 'bdy_ini: jpbdim too small' … … 364 326 DO igrd = igrd_start, igrd_end 365 327 DO ib = 1, nblen(igrd) 366 ! tanh formulation 367 nbw(ib,igrd) = 1.- TANH( FLOAT( nbr(ib,igrd) - 1 ) *0.5 ) 368 ! quadratic 369 ! nbw(ib,igrd) = (FLOAT(nb_rimwidth+1-nbr(ib,igrd))/FLOAT(nb_rimwidth))**2 370 ! linear 371 ! nbw(ib,igrd) = FLOAT(nb_rimwidth+1-nbr(ib,igrd))/FLOAT(nb_rimwidth) 328 nbw(ib,igrd) = 1.- TANH( FLOAT( nbr(ib,igrd) - 1 ) *0.5 ) ! tanh formulation 329 ! nbw(ib,igrd) = (FLOAT(nb_rimwidth+1-nbr(ib,igrd))/FLOAT(nb_rimwidth))**2 ! quadratic 330 ! nbw(ib,igrd) = FLOAT(nb_rimwidth+1-nbr(ib,igrd))/FLOAT(nb_rimwidth) ! linear 372 331 END DO 373 332 END DO … … 420 379 421 380 ! Lateral boundary conditions 422 CALL lbc_lnk( fmask , 'F', 1. ) 423 CALL lbc_lnk( bdytmask(:,:), 'T', 1. ) 424 CALL lbc_lnk( bdyumask(:,:), 'U', 1. ) 425 CALL lbc_lnk( bdyvmask(:,:), 'V', 1. ) 381 CALL lbc_lnk( fmask , 'F', 1. ) ; CALL lbc_lnk( bdytmask(:,:), 'T', 1. ) 382 CALL lbc_lnk( bdyumask(:,:), 'U', 1. ) ; CALL lbc_lnk( bdyvmask(:,:), 'V', 1. ) 426 383 427 384 IF( ln_bdy_vol .OR. ln_bdy_dyn_fla ) THEN ! Indices and directions of rim velocity components … … 473 430 ! Compute total lateral surface for volume correction: 474 431 ! ---------------------------------------------------- 475 476 432 bdysurftot = 0.e0 477 433 IF( ln_bdy_vol ) THEN … … 491 447 & * tmask_i(nbi(ib,igrd),nbj(ib,igrd)+1) 492 448 END DO 493 449 ! 494 450 IF( lk_mpp ) CALL mpp_sum( bdysurftot ) ! sum over the global domain 495 451 END IF -
branches/DEV_r1986_BDY_updates/NEMO/OPA_SRC/BDY/bdytides.F90
r2093 r2168 41 41 PUBLIC tide_update ! routine called in bdydyn 42 42 43 LOGICAL, PUBLIC :: ln_tide_date !: =T correct tide phases and amplitude for model start date 44 45 INTEGER, PARAMETER,PUBLIC :: jptides_max = 15 !: Max number of tidal contituents 43 LOGICAL, PUBLIC :: ln_tide_date !: =T correct tide phases and amplitude for model start date 44 INTEGER, PUBLIC, PARAMETER :: jptides_max = 15 !: Max number of tidal contituents 46 45 INTEGER, PUBLIC :: ntide !: Actual number of tidal constituents 47 46 … … 49 48 CHARACTER(len= 4), PUBLIC, DIMENSION(jptides_max) :: tide_cpt !: Names of tidal components used. 50 49 51 INTEGER , DIMENSION(jptides_max), PUBLIC:: nindx !: ???52 REAL(wp), DIMENSION(jptides_max), PUBLIC:: tide_speed !: Phase speed of tidal constituent (deg/hr)50 INTEGER , PUBLIC, DIMENSION(jptides_max) :: nindx !: ??? 51 REAL(wp), PUBLIC, DIMENSION(jptides_max) :: tide_speed !: Phase speed of tidal constituent (deg/hr) 53 52 54 REAL(wp), DIMENSION(jpbdim,jptides_max) :: ssh1, ssh2 ! :Tidal constituents : SSH55 REAL(wp), DIMENSION(jpbdim,jptides_max) :: u1 , u2 ! :Tidal constituents : U56 REAL(wp), DIMENSION(jpbdim,jptides_max) :: v1 , v2 ! :Tidal constituents : V53 REAL(wp), DIMENSION(jpbdim,jptides_max) :: ssh1, ssh2 ! Tidal constituents : SSH 54 REAL(wp), DIMENSION(jpbdim,jptides_max) :: u1 , u2 ! Tidal constituents : U 55 REAL(wp), DIMENSION(jpbdim,jptides_max) :: v1 , v2 ! Tidal constituents : V 57 56 58 57 !!---------------------------------------------------------------------- 59 !! NEMO/OPA 3. 0 , LOCEAN-IPSL (2008)58 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 60 59 !! $Id$ 61 60 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 62 61 !!---------------------------------------------------------------------- 63 64 62 CONTAINS 65 63 … … 88 86 READ ( numnam, nambdy_tide ) 89 87 ! ! Count number of components specified 90 ntide =jptides_max91 doitide = 1, jptides_max92 if ( tide_cpt(itide) == '' ) then88 ntide = jptides_max 89 DO itide = 1, jptides_max 90 IF( tide_cpt(itide) == '' ) THEN 93 91 ntide = itide-1 94 92 exit 95 endif96 enddo93 ENDIF 94 END DO 97 95 98 96 ! ! find constituents in standard list -
branches/DEV_r1986_BDY_updates/NEMO/OPA_SRC/BDY/bdytra.F90
r1146 r2168 25 25 26 26 !!---------------------------------------------------------------------- 27 !! NEMO/OPA 3. 0 , LOCEAN-IPSL (2008)27 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 28 28 !! $Id$ 29 29 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 30 30 !!---------------------------------------------------------------------- 31 32 31 CONTAINS 33 32 … … 48 47 !!---------------------------------------------------------------------- 49 48 ! 50 IF(ln_bdy_tra_frs) THEN ! If this is false, then this routine does nothing. 51 52 IF( kt == nit000 ) THEN 53 IF(lwp) WRITE(numout,*) 54 IF(lwp) WRITE(numout,*) 'bdy_tra : Flow Relaxation Scheme for tracers' 55 IF(lwp) WRITE(numout,*) '~~~~~~~' 56 ENDIF 49 IF(ln_bdy_tra_frs) THEN ! If this is false, then this routine does nothing. 50 ! 51 IF( kt == nit000 ) THEN 52 IF(lwp) WRITE(numout,*) 53 IF(lwp) WRITE(numout,*) 'bdy_tra : Flow Relaxation Scheme for tracers' 54 IF(lwp) WRITE(numout,*) '~~~~~~~' 55 ENDIF 56 ! 57 igrd = 1 ! Everything is at T-points here 58 DO ib = 1, nblen(igrd) 59 DO ik = 1, jpkm1 60 ii = nbi(ib,igrd) 61 ij = nbj(ib,igrd) 62 zwgt = nbw(ib,igrd) 63 ta(ii,ij,ik) = ( ta(ii,ij,ik) * (1.-zwgt) + tbdy(ib,ik) * zwgt ) * tmask(ii,ij,ik) 64 sa(ii,ij,ik) = ( sa(ii,ij,ik) * (1.-zwgt) + sbdy(ib,ik) * zwgt ) * tmask(ii,ij,ik) 65 END DO 66 END DO 67 ! 68 CALL lbc_lnk( ta, 'T', 1. ) ; CALL lbc_lnk( sa, 'T', 1. ) ! Boundary points should be updated 69 ! 70 ENDIF ! ln_bdy_tra_frs 57 71 ! 58 igrd = 1 ! Everything is at T-points here59 DO ib = 1, nblen(igrd)60 DO ik = 1, jpkm161 ii = nbi(ib,igrd)62 ij = nbj(ib,igrd)63 zwgt = nbw(ib,igrd)64 ta(ii,ij,ik) = ( ta(ii,ij,ik) * (1.-zwgt) + tbdy(ib,ik) * zwgt ) * tmask(ii,ij,ik)65 sa(ii,ij,ik) = ( sa(ii,ij,ik) * (1.-zwgt) + sbdy(ib,ik) * zwgt ) * tmask(ii,ij,ik)66 END DO67 END DO68 !69 CALL lbc_lnk( ta, 'T', 1. ) ! Boundary points should be updated70 CALL lbc_lnk( sa, 'T', 1. ) !71 !72 ENDIF ! ln_bdy_tra_frs73 74 72 END SUBROUTINE bdy_tra 75 73 -
branches/DEV_r1986_BDY_updates/NEMO/OPA_SRC/BDY/bdyvol.F90
r1739 r2168 11 11 #if defined key_bdy && defined key_dynspg_flt 12 12 !!---------------------------------------------------------------------- 13 !! 'key_bdy' andunstructured open boundary conditions13 !! 'key_bdy' AND unstructured open boundary conditions 14 14 !! 'key_dynspg_flt' filtered free surface 15 15 !!---------------------------------------------------------------------- … … 30 30 # include "domzgr_substitute.h90" 31 31 !!---------------------------------------------------------------------- 32 !! NEMO/OPA 3. 0 , LOCEAN-IPSL (2008)32 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 33 33 !! $Id$ 34 34 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 35 35 !!---------------------------------------------------------------------- 36 37 36 CONTAINS 38 37 … … 73 72 INTEGER :: ji, jj, jk, jb, jgrd 74 73 INTEGER :: ii, ij 75 REAL(wp) :: zubtpecor, z_cflxemp, ztranst , zraur74 REAL(wp) :: zubtpecor, z_cflxemp, ztranst 76 75 !!----------------------------------------------------------------------------- 77 76 … … 85 84 ! ----------------------------------------------------------------------- 86 85 z_cflxemp = 0.e0 87 zraur = 1.e0 / rau0 88 z_cflxemp = SUM ( emp(:,:) * bdytmask(:,:) * e1t(:,:) * e2t(:,:) * zraur ) 89 IF( lk_mpp ) CALL mpp_sum( z_cflxemp ) ! sum over the global domain 86 z_cflxemp = SUM ( emp(:,:) * bdytmask(:,:) * e1t(:,:) * e2t(:,:) ) / rau0 87 IF( lk_mpp ) CALL mpp_sum( z_cflxemp ) ! sum over the global domain 90 88 91 ! Barotropic velocitythrough the unstructured open boundary92 ! ------------------------------------------------ ----------89 ! Transport through the unstructured open boundary 90 ! ------------------------------------------------ 93 91 zubtpecor = 0.e0 94 92 jgrd = 2 ! cumulate u component contribution first … … 112 110 ! The normal velocity correction 113 111 ! ------------------------------ 114 IF (volbdy==1) THEN ; zubtpecor = ( zubtpecor - z_cflxemp) / bdysurftot115 ELSE ; zubtpecor = zubtpecor / bdysurftot112 IF( volbdy==1 ) THEN ; zubtpecor = ( zubtpecor - z_cflxemp) / bdysurftot 113 ELSE ; zubtpecor = zubtpecor / bdysurftot 116 114 END IF 117 115 … … 141 139 ! Check the cumulated transport through unstructured OBC once barotropic velocities corrected 142 140 ! ------------------------------------------------------ 143 144 141 IF( lwp .AND. MOD( kt, nwrite ) == 0) THEN 145 142 IF(lwp) WRITE(numout,*)
Note: See TracChangeset
for help on using the changeset viewer.
