Changeset 2236 for branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY
- Timestamp:
- 2010-10-12T20:49:32+02:00 (14 years ago)
- Location:
- branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY
- Files:
-
- 8 edited
- 1 copied
-
bdy_oce.F90 (modified) (4 diffs, 1 prop)
-
bdy_par.F90 (modified) (3 diffs, 1 prop)
-
bdydta.F90 (modified) (47 diffs, 1 prop)
-
bdydyn.F90 (modified) (6 diffs, 1 prop)
-
bdyice.F90 (copied) (copied from branches/DEV_r2191_3partymerge2010/NEMO/OPA_SRC/BDY/bdyice.F90)
-
bdyini.F90 (modified) (20 diffs, 1 prop)
-
bdytides.F90 (modified) (12 diffs, 1 prop)
-
bdytra.F90 (modified) (2 diffs, 1 prop)
-
bdyvol.F90 (modified) (6 diffs, 1 prop)
Legend:
- Unmodified
- Added
- Removed
-
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY/bdy_oce.F90
- Property svn:executable deleted
r1170 r2236 6 6 !! History : 1.0 ! 2001-05 (J. Chanut, A. Sellar) Original code 7 7 !! 3.0 ! 2008-04 (NEMO team) add in the reference version 8 !! 3.3 ! 2010-09 (D. Storkey) add ice boundary conditions 8 9 !!---------------------------------------------------------------------- 9 10 #if defined key_bdy … … 54 55 !! Unstructured open boundary data variables 55 56 !!---------------------------------------------------------------------- 56 INTEGER, DIMENSION(jpbgrd) :: nblen 57 INTEGER, DIMENSION(jpbgrd) :: nblenrim 58 INTEGER, DIMENSION(jpbgrd) :: nblendta 57 INTEGER, DIMENSION(jpbgrd) :: nblen = 0 !: Size of bdy data on a proc for each grid type 58 INTEGER, DIMENSION(jpbgrd) :: nblenrim = 0 !: Size of bdy data on a proc for first rim ind 59 INTEGER, DIMENSION(jpbgrd) :: nblendta = 0 !: Size of bdy data in file 59 60 60 61 INTEGER, DIMENSION(jpbdim,jpbgrd) :: nbi, nbj !: i and j indices of bdy dta … … 73 74 REAL(wp), DIMENSION(jpbdim) :: sshtide !: Tidal boundary array : SSH 74 75 REAL(wp), DIMENSION(jpbdim) :: utide, vtide !: Tidal boundary array : U and V 76 #if defined key_lim2 77 REAL(wp), DIMENSION(jpbdim) :: & 78 frld_bdy, hicif_bdy, & !: Now clim of ice leads fraction, ice 79 hsnif_bdy !: thickness and snow thickness 80 #endif 75 81 76 82 #else … … 84 90 !! NEMO/OPA 3.0 , LOCEAN-IPSL (2008) 85 91 !! $Id$ 86 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)92 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 87 93 !!====================================================================== 88 94 END MODULE bdy_oce -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY/bdy_par.F90
- Property svn:executable deleted
r1146 r2236 6 6 !! History : 1.0 ! 2005-01 (J. Chanut, A. Sellar) Original code 7 7 !! 3.0 ! 2008-04 (NEMO team) add in the reference version 8 !! 3.3 ! 2010-09 (D. Storkey and E. O'Dea) update for Shelf configurations 8 9 !!---------------------------------------------------------------------- 9 #if defined key_bdy10 #if defined key_bdy 10 11 !!---------------------------------------------------------------------- 11 12 !! 'key_bdy' : Unstructured Open Boundary Condition … … 15 16 PUBLIC 16 17 17 18 LOGICAL, PUBLIC, PARAMETER :: lk_bdy = .TRUE. !: Unstructured Ocean Boundary Condition flag 19 INTEGER, PUBLIC, PARAMETER :: jpbdta = 5000 !: Max length of bdy field in file 20 INTEGER, PUBLIC, PARAMETER :: jpbdim = 5000 !: Max length of bdy field on a processor 21 INTEGER, PUBLIC, PARAMETER :: jpbtime = 1000 !: Max number of time dumps per file 22 INTEGER, PUBLIC, PARAMETER :: jpbgrd = 3 !: Number of horizontal grid types used (T, u, v, f) 18 LOGICAL, PUBLIC, PARAMETER :: lk_bdy = .TRUE. !: Unstructured Ocean Boundary Condition flag 19 INTEGER, PUBLIC, PARAMETER :: jpbdta = 20000 !: Max length of bdy field in file 20 INTEGER, PUBLIC, PARAMETER :: jpbdim = 20000 !: Max length of bdy field on a processor 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) 23 23 #else 24 24 !!---------------------------------------------------------------------- … … 29 29 30 30 !!---------------------------------------------------------------------- 31 !! NEMO/OPA 3. 0 , LOCEAN-IPSL (2008)31 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 32 32 !! $Id$ 33 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)33 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 34 34 !!====================================================================== 35 35 END MODULE bdy_par -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY/bdydta.F90
- Property svn:executable deleted
r1715 r2236 8 8 !! - ! 2007-07 (D. Storkey) add bdy_dta_bt 9 9 !! 3.0 ! 2008-04 (NEMO team) add in the reference version 10 !! 3.3 ! 2010-09 (E.O'Dea) modifications for Shelf configurations 11 !! 3.3 ! 2010-09 (D.Storkey) add ice boundary conditions 10 12 !!---------------------------------------------------------------------- 11 13 #if defined key_bdy … … 14 16 !!---------------------------------------------------------------------- 15 17 !! bdy_dta : read u, v, t, s data along open boundaries 16 !! bdy_dta_bt : read depth-mean velocities and elevation along open 17 !! boundaries 18 !! bdy_dta_bt : read depth-mean velocities and elevation along open boundaries 18 19 !!---------------------------------------------------------------------- 19 20 USE oce ! ocean dynamics and tracers … … 25 26 USE ioipsl 26 27 USE in_out_manager ! I/O logical units 28 #if defined key_lim2 29 USE ice_2 30 #endif 27 31 28 32 IMPLICIT NONE … … 32 36 PUBLIC bdy_dta_bt 33 37 34 INTEGER :: numbdyt, numbdyu, numbdyv !: logical units for T-, U-, & V-points data file, resp. 35 INTEGER :: ntimes_bdy !: exact number of time dumps in data files 36 INTEGER :: nbdy_b, nbdy_a !: record of bdy data file for before and after model time step 37 INTEGER :: numbdyt_bt, numbdyu_bt, numbdyv_bt !: logical unit for T-, U- & V-points data file, resp. 38 INTEGER :: ntimes_bdy_bt !: exact number of time dumps in data files 39 INTEGER :: nbdy_b_bt, nbdy_a_bt !: record of bdy data file for before and after model time step 40 41 INTEGER, DIMENSION (jpbtime) :: istep, istep_bt !: time array in seconds in each data file 42 43 REAL(wp) :: zoffset !: time offset between time origin in file & start time of model run 44 45 REAL(wp), DIMENSION(jpbdim,jpk,2) :: tbdydta, sbdydta !: time interpolated values of T and S bdy data 46 REAL(wp), DIMENSION(jpbdim,jpk,2) :: ubdydta, vbdydta !: time interpolated values of U and V bdy data 47 REAL(wp), DIMENSION(jpbdim,2) :: ubtbdydta, vbtbdydta !: Arrays used for time interpolation of bdy data 48 REAL(wp), DIMENSION(jpbdim,2) :: sshbdydta !: bdy data of ssh 38 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 53 54 #if defined key_lim2 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 ! } 58 #endif 49 59 50 60 !!---------------------------------------------------------------------- 51 !! NEMO/OPA 3. 0 , LOCEAN-IPSL (2008)61 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 52 62 !! $Id$ 53 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)63 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 54 64 !!---------------------------------------------------------------------- 55 56 65 CONTAINS 57 66 … … 67 76 !! the file. If so read it in. Time interpolate. 68 77 !!---------------------------------------------------------------------- 69 INTEGER, INTENT( in ) :: kt 78 INTEGER, INTENT( in ) :: kt ! ocean time-step index (for timesplitting option, otherwise zero) 70 79 !! 71 80 CHARACTER(LEN=80), DIMENSION(3) :: clfile ! names of input files … … 79 88 INTEGER :: itimer, totime 80 89 INTEGER :: ii, ij ! array addresses 81 INTEGER :: ipi, ipj, ipk, inum ! temporaryintegers (NetCDF read)90 INTEGER :: ipi, ipj, ipk, inum ! local integers (NetCDF read) 82 91 INTEGER :: iyear0, imonth0, iday0 83 92 INTEGER :: ihours0, iminutes0, isec0 … … 91 100 !!--------------------------------------------------------------------------- 92 101 93 IF( ln_bdy_dyn_frs .OR. ln_bdy_tra_frs ) THEN ! If these are both false then this routine 94 ! 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 95 105 96 106 ! -------------------- ! … … 102 112 ! Some time variables for monthly climatological forcing: 103 113 ! ******************************************************* 104 !!gm here use directely daymod variables 114 115 !!gm here use directely daymod calendar variables 105 116 106 117 iman = INT( raamo ) ! Number of months in a year … … 121 132 ! !-------------------! 122 133 istep(:) = 0 123 nbdy_b 124 nbdy_a 134 nbdy_b = 0 135 nbdy_a = 0 125 136 126 137 ! Get time information from bdy data file … … 151 162 igrd_start = 1 152 163 igrd_end = 3 153 IF(.NOT. ln_bdy_tra_frs .AND. .NOT. ln_bdy_ice_frs) THEN 154 ! No T-grid file. 164 IF(.NOT. ln_bdy_tra_frs .AND. .NOT. ln_bdy_ice_frs) THEN ! No T-grid file. 155 165 igrd_start = 2 156 ELSEIF ( .NOT. ln_bdy_dyn_frs ) THEN 157 ! No U-grid or V-grid file. 166 ELSEIF ( .NOT. ln_bdy_dyn_frs ) THEN ! No U-grid or V-grid file. 158 167 igrd_end = 1 159 168 ENDIF … … 165 174 166 175 SELECT CASE( igrd ) 167 CASE (1) 168 numbdyt = inum 169 CASE (2) 170 numbdyu = inum 171 CASE (3) 172 numbdyv = inum 176 CASE (1) ; numbdyt = inum 177 CASE (2) ; numbdyu = inum 178 CASE (3) ; numbdyv = inum 173 179 END SELECT 174 180 … … 196 202 IF(lwp) WRITE(numout,*) 'offset: ',zoffset 197 203 IF(lwp) WRITE(numout,*) 'totime: ',totime 198 IF(lwp) WRITE(numout,*) 'zstepr: ',zstepr 204 IF(lwp) WRITE(numout,*) 'zstepr: ',zstepr(1:ntimes_bdy) 199 205 200 206 ! Check that there are not too many times in the file. … … 205 211 206 212 ! Check that time array increases: 207 208 213 it = 1 209 DO WHILE( zstepr(it+1) > zstepr(it) .AND. it /= ntimes_bdy - 1 ) 210 it = it + 1214 DO WHILE( zstepr(it+1) > zstepr(it) .AND. it /= ntimes_bdy - 1 ) 215 it = it + 1 211 216 END DO 212 213 IF( it .NE.ntimes_bdy-1 .AND. ntimes_bdy > 1 ) THEN217 ! 218 IF( it /= ntimes_bdy-1 .AND. ntimes_bdy > 1 ) THEN 214 219 WRITE(ctmp1,*) 'Check file: ', clfile(igrd) 215 220 CALL ctl_stop( 'Time array in unstructured boundary data files', & … … 227 232 END IF 228 233 ! 229 IF ( igrd == 1 ) THEN 230 ntimes_bdyt = ntimes_bdy 231 zoffsett = zoffset 232 istept(:) = INT( zstepr(:) + zoffset ) 233 ELSEIF(igrd == 2 ) THEN 234 ntimes_bdyu = ntimes_bdy 235 zoffsetu = zoffset 236 istepu(:) = INT( zstepr(:) + zoffset ) 237 ELSEIF(igrd == 3 ) THEN 238 ntimes_bdyv = ntimes_bdy 239 zoffsetv = zoffset 240 istepv(:) = INT( zstepr(:) + zoffset ) 241 ENDIF 234 SELECT CASE( igrd ) 235 CASE (1) 236 ntimes_bdyt = ntimes_bdy 237 zoffsett = zoffset 238 istept(:) = INT( zstepr(:) + zoffset ) 239 numbdyt = inum 240 CASE (2) 241 ntimes_bdyu = ntimes_bdy 242 zoffsetu = zoffset 243 istepu(:) = INT( zstepr(:) + zoffset ) 244 numbdyu = inum 245 CASE (3) 246 ntimes_bdyv = ntimes_bdy 247 zoffsetv = zoffset 248 istepv(:) = INT( zstepr(:) + zoffset ) 249 numbdyv = inum 250 END SELECT 242 251 ! 243 252 END DO ! end loop over T, U & V grid … … 259 268 ENDIF 260 269 261 IF( igrd_start == 1 ) THEN 262 istep(:) = istept(:) 263 ELSE 264 istep(:) = istepu(:) 270 IF( igrd_start == 1 ) THEN ; istep(:) = istept(:) 271 ELSE ; istep(:) = istepu(:) 265 272 ENDIF 266 273 … … 287 294 it = 1 288 295 DO WHILE( istep(it+1) <= 0 .AND. it <= ntimes_bdy - 1 ) 289 it = it + 1296 it = it + 1 290 297 END DO 291 298 nbdy_b = it 292 299 ! 293 WRITE(numout,*) 'Time offset is ',zoffset294 WRITE(numout,*) 'First record to read is ',nbdy_b300 IF(lwp) WRITE(numout,*) 'Time offset is ',zoffset 301 IF(lwp) WRITE(numout,*) 'First record to read is ',nbdy_b 295 302 296 303 ENDIF ! endif (nbdy_dta == 1) … … 300 307 ! ***************************************************************** 301 308 302 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 303 310 ! 304 311 IF (ln_bdy_tra_frs) THEN 305 igrd = 1 ! T-points data306 DO ib = 1, nblen(igrd)307 ii = nbi(ib,igrd)308 ij = nbj(ib,igrd)309 DO ik = 1, jpkm1310 tbdy(ib,ik) = tn(ii, ij,ik)311 sbdy(ib,ik) = sn(ii, ij,ik)312 ENDDO313 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 314 321 ENDIF 315 322 316 323 IF(ln_bdy_dyn_frs) THEN 317 igrd = 2 ! U-points data318 DO ib = 1, nblen(igrd)319 ii = nbi(ib,igrd)320 ij = nbj(ib,igrd)321 DO ik = 1, jpkm1322 ubdy(ib,ik) = un(ii, ij, ik)323 ENDDO324 END DO325 326 igrd = 3 ! V-points data327 DO ib = 1, nblen(igrd)328 ii = nbi(ib,igrd)329 ij = nbj(ib,igrd)330 DO ik = 1, jpkm1331 vbdy(ib,ik) = vn(ii, ij, ik)332 ENDDO333 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 334 341 ENDIF 335 342 ! 343 #if defined key_lim2 344 IF( ln_bdy_ice_frs ) THEN 345 igrd = 1 ! T-points data 346 DO ib = 1, nblen(igrd) 347 frld_bdy (ib) = frld(nbi(ib,igrd), nbj(ib,igrd)) 348 hicif_bdy(ib) = hicif(nbi(ib,igrd), nbj(ib,igrd)) 349 hsnif_bdy(ib) = hsnif(nbi(ib,igrd), nbj(ib,igrd)) 350 END DO 351 ENDIF 352 #endif 336 353 ELSEIF( nbdy_dta == 1 ) THEN ! Set first record in the climatological case: 337 354 ! … … 352 369 353 370 IF(ln_bdy_tra_frs) THEN 371 ! 354 372 igrd = 1 ! Temperature 355 373 IF( nblendta(igrd) <= 0 ) THEN … … 357 375 nblendta(igrd) = iom_file(numbdyt)%dimsz(1,idvar) 358 376 ENDIF 359 WRITE(numout,*) 'Dim size for votemper is ', nblendta(igrd)377 IF(lwp) WRITE(numout,*) 'Dim size for votemper is ', nblendta(igrd) 360 378 ipi = nblendta(igrd) 361 379 CALL iom_get ( numbdyt, jpdom_unknown, 'votemper', zdta(1:ipi,1:ipj,1:ipk), nbdy_a ) 362 380 ! 363 381 DO ib = 1, nblen(igrd) 364 382 DO ik = 1, jpkm1 … … 372 390 nblendta(igrd) = iom_file(numbdyt)%dimsz(1,idvar) 373 391 ENDIF 374 WRITE(numout,*) 'Dim size for vosaline is ', nblendta(igrd)392 IF(lwp) WRITE(numout,*) 'Dim size for vosaline is ', nblendta(igrd) 375 393 ipi = nblendta(igrd) 376 394 CALL iom_get ( numbdyt, jpdom_unknown, 'vosaline', zdta(1:ipi,1:ipj,1:ipk), nbdy_a ) 377 395 ! 378 396 DO ib = 1, nblen(igrd) 379 397 DO ik = 1, jpkm1 … … 383 401 ENDIF ! ln_bdy_tra_frs 384 402 385 IF( ln_bdy_dyn_frs) THEN386 403 IF( ln_bdy_dyn_frs ) THEN 404 ! 387 405 igrd = 2 ! u-velocity 388 406 IF ( nblendta(igrd) .le. 0 ) THEN … … 390 408 nblendta(igrd) = iom_file(numbdyu)%dimsz(1,idvar) 391 409 ENDIF 392 WRITE(numout,*) 'Dim size for vozocrtx is ', nblendta(igrd)410 IF(lwp) WRITE(numout,*) 'Dim size for vozocrtx is ', nblendta(igrd) 393 411 ipi = nblendta(igrd) 394 412 CALL iom_get ( numbdyu, jpdom_unknown,'vozocrtx',zdta(1:ipi,1:ipj,1:ipk),nbdy_a ) … … 404 422 nblendta(igrd) = iom_file(numbdyv)%dimsz(1,idvar) 405 423 ENDIF 406 WRITE(numout,*) 'Dim size for vomecrty is ', nblendta(igrd)424 IF(lwp) WRITE(numout,*) 'Dim size for vomecrty is ', nblendta(igrd) 407 425 ipi = nblendta(igrd) 408 426 CALL iom_get ( numbdyv, jpdom_unknown,'vomecrty',zdta(1:ipi,1:ipj,1:ipk),nbdy_a ) … … 414 432 ENDIF ! ln_bdy_dyn_frs 415 433 416 417 IF ((.NOT.ln_bdy_clim) .AND. (istep(1) > 0)) THEN 418 ! First data time is after start of run 419 ! Put first value in both time levels 434 #if defined key_lim2 435 IF( ln_bdy_ice_frs ) THEN 436 ! 437 igrd=1 ! leads fraction 438 IF(lwp) WRITE(numout,*) 'Dim size for ildsconc is ',nblendta(igrd) 439 ipi=nblendta(igrd) 440 CALL iom_get ( numbdyt, jpdom_unknown,'ildsconc',zdta(1:ipi,:,1),nbdy_a ) 441 DO ib=1, nblen(igrd) 442 frld_bdydta(ib,2) = zdta(nbmap(ib,igrd),1,1) 443 END DO 444 ! 445 igrd=1 ! ice thickness 446 IF(lwp) WRITE(numout,*) 'Dim size for iicethic is ',nblendta(igrd) 447 ipi=nblendta(igrd) 448 CALL iom_get ( numbdyt, jpdom_unknown,'iicethic',zdta(1:ipi,:,1),nbdy_a ) 449 DO ib=1, nblen(igrd) 450 hicif_bdydta(ib,2) = zdta(nbmap(ib,igrd),1,1) 451 END DO 452 ! 453 igrd=1 ! snow thickness 454 IF(lwp) WRITE(numout,*) 'Dim size for isnowthi is ',nblendta(igrd) 455 ipi=nblendta(igrd) 456 CALL iom_get ( numbdyt, jpdom_unknown,'isnowthi',zdta(1:ipi,:,1),nbdy_a ) 457 DO ib=1, nblen(igrd) 458 hsnif_bdydta(ib,2) = zdta(nbmap(ib,igrd),1,1) 459 END DO 460 ENDIF ! just if ln_bdy_ice_frs is set 461 #endif 462 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 420 531 nbdy_b = nbdy_a 421 532 IF(ln_bdy_tra_frs) THEN 422 tbdydta(:,:,1) =tbdydta(:,:,2)423 sbdydta(:,:,1) =sbdydta(:,:,2)533 tbdydta(:,:,1) = tbdydta(:,:,2) 534 sbdydta(:,:,1) = sbdydta(:,:,2) 424 535 ENDIF 425 536 IF(ln_bdy_dyn_frs) THEN 426 ubdydta(:,:,1) = ubdydta(:,:,2) 427 vbdydta(:,:,1) = vbdydta(:,:,2) 428 ENDIF 429 END IF 430 431 END IF ! nbdy_dta == 0/1 432 433 ! In the case of constant boundary forcing fill bdy arrays once for all 434 IF ((ln_bdy_clim).AND.(ntimes_bdy==1)) THEN 435 IF(ln_bdy_tra_frs) THEN 436 tbdy (:,:) = tbdydta (:,:,2) 437 sbdy (:,:) = sbdydta (:,:,2) 438 ENDIF 439 IF(ln_bdy_dyn_frs) THEN 440 ubdy (:,:) = ubdydta (:,:,2) 441 vbdy (:,:) = vbdydta (:,:,2) 442 ENDIF 443 444 IF(ln_bdy_tra_frs .or. ln_bdy_ice_frs) CALL iom_close( numbdyt ) 445 IF(ln_bdy_dyn_frs) CALL iom_close( numbdyu ) 446 IF(ln_bdy_dyn_frs) CALL iom_close( numbdyv ) 447 END IF 448 449 ENDIF ! End if nit000 450 451 452 ! !---------------------! 453 ! ! at each time step ! 454 ! !---------------------! 455 456 IF( nbdy_dta == 1 .AND. ntimes_bdy > 1 ) THEN 457 ! 458 ! Read one more record if necessary 459 !********************************** 460 461 IF( ln_bdy_clim .AND. imois /= nbdy_b ) THEN ! remember that nbdy_b=0 for kt=nit000 462 nbdy_b = imois 463 nbdy_a = imois + 1 464 nbdy_b = MOD( nbdy_b, iman ) ; IF( nbdy_b == 0 ) nbdy_b = iman 465 nbdy_a = MOD( nbdy_a, iman ) ; IF( nbdy_a == 0 ) nbdy_a = iman 466 lect=.true. 467 ELSEIF( .NOT.ln_bdy_clim .AND. itimer >= istep(nbdy_a) ) THEN 468 469 IF ( nbdy_a < ntimes_bdy ) THEN 470 nbdy_b = nbdy_a 471 nbdy_a = nbdy_a + 1 472 lect =.true. 473 ELSE 474 ! We have reached the end of the file 475 ! put the last data time into both time levels 476 nbdy_b = nbdy_a 477 IF(ln_bdy_tra_frs) THEN 478 tbdydta(:,:,1) = tbdydta(:,:,2) 479 sbdydta(:,:,1) = sbdydta(:,:,2) 480 ENDIF 481 IF(ln_bdy_dyn_frs) THEN 482 ubdydta(:,:,1) = ubdydta(:,:,2) 483 vbdydta(:,:,1) = vbdydta(:,:,2) 484 ENDIF 537 ubdydta(:,:,1) = ubdydta(:,:,2) 538 vbdydta(:,:,1) = vbdydta(:,:,2) 539 ENDIF 540 #if defined key_lim2 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 546 #endif 485 547 END IF ! nbdy_a < ntimes_bdy 486 548 ! 487 549 END IF 488 550 489 IF( lect ) THEN 490 ! Swap arrays 491 IF(ln_bdy_tra_frs) THEN 551 IF( lect ) THEN ! Swap arrays 552 IF( ln_bdy_tra_frs ) THEN 492 553 tbdydta(:,:,1) = tbdydta(:,:,2) 493 554 sbdydta(:,:,1) = sbdydta(:,:,2) 494 555 ENDIF 495 IF( ln_bdy_dyn_frs) THEN556 IF( ln_bdy_dyn_frs ) THEN 496 557 ubdydta(:,:,1) = ubdydta(:,:,2) 497 558 vbdydta(:,:,1) = vbdydta(:,:,2) 498 559 ENDIF 499 560 #if defined key_lim2 561 IF( ln_bdy_ice_frs ) THEN 562 frld_bdydta (:,1) = frld_bdydta (:,2) 563 hicif_bdydta(:,1) = hicif_bdydta(:,2) 564 hsnif_bdydta(:,1) = hsnif_bdydta(:,2) 565 ENDIF 566 #endif 500 567 ! read another set 501 568 ipj = 1 502 569 ipk = jpk 503 570 504 IF( ln_bdy_tra_frs) THEN571 IF( ln_bdy_tra_frs ) THEN 505 572 ! 506 573 igrd = 1 ! temperature … … 543 610 END DO 544 611 ENDIF ! ln_bdy_dyn_frs 545 612 ! 613 #if defined key_lim2 614 IF(ln_bdy_ice_frs) THEN 615 ! 616 igrd = 1 ! ice concentration 617 ipi=nblendta(igrd) 618 CALL iom_get ( numbdyt, jpdom_unknown,'ildsconc',zdta(1:ipi,:,1),nbdy_a ) 619 DO ib=1, nblen(igrd) 620 frld_bdydta(ib,2) = zdta( nbmap(ib,igrd), 1, 1 ) 621 END DO 622 ! 623 igrd=1 ! ice thickness 624 ipi=nblendta(igrd) 625 CALL iom_get ( numbdyt, jpdom_unknown,'iicethic',zdta(1:ipi,:,1),nbdy_a ) 626 DO ib=1, nblen(igrd) 627 hicif_bdydta(ib,2) = zdta( nbmap(ib,igrd), 1, 1 ) 628 END DO 629 ! 630 igrd=1 ! snow thickness 631 ipi=nblendta(igrd) 632 CALL iom_get ( numbdyt, jpdom_unknown,'isnowthi',zdta(1:ipi,:,1),nbdy_a ) 633 DO ib=1, nblen(igrd) 634 hsnif_bdydta(ib,2) = zdta( nbmap(ib,igrd), 1, 1 ) 635 END DO 636 ENDIF ! ln_bdy_ice_frs 637 #endif 546 638 ! 547 639 IF(lwp) WRITE(numout,*) 'bdy_dta : first record file used nbdy_b ',nbdy_b … … 559 651 ! ******************** 560 652 ! 561 IF( ln_bdy_clim ) THEN ; zxy = REAL( nday , wp ) / REAL( nmonth_len(nbdy_b), wp ) + 0.5 - i15 562 ELSE ; zxy = REAL( istep(nbdy_b) - itimer, wp ) / REAL( istep(nbdy_b) - istep(nbdy_a), wp ) 653 IF( ln_bdy_clim ) THEN ; zxy = REAL( nday ) / REAL( nmonth_len(nbdy_b) ) + 0.5 - i15 654 ELSEIF( istep(nbdy_b) == istep(nbdy_a) ) THEN 655 zxy = 0.0_wp 656 ELSE ; zxy = REAL( istep(nbdy_b) - itimer ) / REAL( istep(nbdy_b) - istep(nbdy_a) ) 563 657 END IF 564 658 … … 589 683 ENDIF 590 684 685 #if defined key_lim2 686 IF(ln_bdy_ice_frs) THEN 687 igrd=1 688 DO ib=1, nblen(igrd) 689 frld_bdy(ib) = zxy * frld_bdydta(ib,2) + (1.-zxy) * frld_bdydta(ib,1) 690 hicif_bdy(ib) = zxy * hicif_bdydta(ib,2) + (1.-zxy) * hicif_bdydta(ib,1) 691 hsnif_bdy(ib) = zxy * hsnif_bdydta(ib,2) + (1.-zxy) * hsnif_bdydta(ib,1) 692 END DO 693 ENDIF ! just if ln_bdy_ice_frs is true 694 #endif 695 591 696 END IF !end if ((nbdy_dta==1).AND.(ntimes_bdy>1)) 592 697 … … 602 707 ! 603 708 ENDIF ! ln_bdy_dyn_frs .OR. ln_bdy_tra_frs 604 709 ! 605 710 END SUBROUTINE bdy_dta 606 711 607 712 608 SUBROUTINE bdy_dta_bt( kt, jit )713 SUBROUTINE bdy_dta_bt( kt, jit, icycl ) 609 714 !!--------------------------------------------------------------------------- 610 715 !! *** SUBROUTINE bdy_dta_bt *** … … 620 725 INTEGER, INTENT( in ) :: kt ! ocean time-step index 621 726 INTEGER, INTENT( in ) :: jit ! barotropic time step index 727 INTEGER, INTENT( in ) :: icycl ! number of cycles need for final file close 622 728 ! ! (for timesplitting option, otherwise zero) 623 729 !! … … 639 745 REAL(wp), DIMENSION(jpbtime) :: zstepr ! REAL time array from data files 640 746 REAL(wp), DIMENSION(jpbdta,1) :: zdta ! temporary array for data fields 641 CHARACTER(LEN=80), DIMENSION( 3) :: clfile747 CHARACTER(LEN=80), DIMENSION(6) :: clfile 642 748 CHARACTER(LEN=70 ) :: clunits ! units attribute of time coordinate 643 749 !!--------------------------------------------------------------------------- … … 688 794 689 795 ! !-------------------! 690 IF( kt == nit000 ) THEN! First call only !796 IF( kt == nit000 .and. jit ==2 ) THEN ! First call only ! 691 797 ! !-------------------! 692 798 istep_bt(:) = 0 … … 712 818 ! necessary time dumps in file are included 713 819 714 clfile( 1) = filbdy_data_bt_T715 clfile( 2) = filbdy_data_bt_U716 clfile( 3) = filbdy_data_bt_V717 718 DO igrd = 1,3820 clfile(4) = filbdy_data_bt_T 821 clfile(5) = filbdy_data_bt_U 822 clfile(6) = filbdy_data_bt_V 823 824 DO igrd = 4,6 719 825 720 826 CALL iom_open( clfile(igrd), inum ) 721 CALL iom_gettime( inum, zstepr, kntime=ntimes_bdy , cdunits=clunits )827 CALL iom_gettime( inum, zstepr, kntime=ntimes_bdy_bt, cdunits=clunits ) 722 828 723 829 SELECT CASE( igrd ) 724 CASE ( 1)725 numbdyt = inum726 CASE ( 2)727 numbdyu = inum728 CASE ( 3)729 numbdyv = inum830 CASE (4) 831 numbdyt_bt = inum 832 CASE (5) 833 numbdyu_bt = inum 834 CASE (6) 835 numbdyv_bt = inum 730 836 END SELECT 731 837 … … 757 863 758 864 ! Check that time array increases (or interp will fail): 759 DO it = 2, ntimes_bdy 865 DO it = 2, ntimes_bdy_bt 760 866 IF ( zstepr(it-1) >= zstepr(it) ) THEN 761 867 CALL ctl_stop('Time array in unstructured boundary data file', & … … 778 884 ! The same applies to the last time level: see setting of lect below. 779 885 780 IF ( ntimes_bdy == 1 ) CALL ctl_stop( &886 IF ( ntimes_bdy_bt == 1 ) CALL ctl_stop( & 781 887 'There is only one time dump in data files', & 782 888 'Set ln_bdy_clim=.true. in namelist for constant bdy forcing.' ) 783 889 784 890 zinterval_s = zstepr(2) - zstepr(1) 785 zinterval_e = zstepr(ntimes_bdy) - zstepr(ntimes_bdy-1) 786 787 IF ( zstepr(1) - zinterval_s / 2.0 > 0 ) THEN 788 IF(lwp) WRITE(numout,*) 'First bdy time relative to nit000:', zstepr(1) 789 IF(lwp) WRITE(numout,*) 'Interval between first two times: ', zinterval_s 790 CALL ctl_stop( 'First data time is after start of run', & 791 'by more than half a meaning period', & 792 'Check file: ' // TRIM(clfile(igrd)) ) 891 zinterval_e = zstepr(ntimes_bdy_bt) - zstepr(ntimes_bdy_bt-1) 892 893 IF( zstepr(1) + zoffset > 0 ) THEN 894 WRITE(ctmp1,*) 'Check file: ', clfile(igrd) 895 CALL ctl_stop( 'First time dump in bdy file is after model initial time', ctmp1 ) 793 896 END IF 794 795 IF ( zstepr(ntimes_bdy) + zinterval_e / 2.0 < totime ) THEN 796 IF(lwp) WRITE(numout,*) 'Last bdy time relative to nit000:', zstepr(ntimes_bdy) 797 IF(lwp) WRITE(numout,*) 'Interval between last two times: ', zinterval_e 798 CALL ctl_stop( 'Last data time is before end of run', & 799 'by more than half a meaning period', & 800 'Check file: ' // TRIM(clfile(igrd)) ) 897 IF( zstepr(ntimes_bdy_bt) + zoffset < totime ) THEN 898 WRITE(ctmp1,*) 'Check file: ', clfile(igrd) 899 CALL ctl_stop( 'Last time dump in bdy file is before model final time', ctmp1 ) 801 900 END IF 802 803 901 END IF ! .NOT. ln_bdy_clim 804 902 805 IF ( igrd .EQ. 1) THEN903 IF ( igrd .EQ. 4) THEN 806 904 ntimes_bdyt = ntimes_bdy_bt 807 905 zoffsett = zoffset 808 906 istept(:) = INT( zstepr(:) + zoffset ) 809 ELSE IF (igrd .EQ. 2) THEN907 ELSE IF (igrd .EQ. 5) THEN 810 908 ntimes_bdyu = ntimes_bdy_bt 811 909 zoffsetu = zoffset 812 910 istepu(:) = INT( zstepr(:) + zoffset ) 813 ELSE IF (igrd .EQ. 3) THEN911 ELSE IF (igrd .EQ. 6) THEN 814 912 ntimes_bdyv = ntimes_bdy_bt 815 913 zoffsetv = zoffset … … 865 963 nbdy_b_bt = it 866 964 867 WRITE(numout,*) 'Time offset is ',zoffset868 WRITE(numout,*) 'First record to read is ',nbdy_b_bt965 IF(lwp) WRITE(numout,*) 'Time offset is ',zoffset 966 IF(lwp) WRITE(numout,*) 'First record to read is ',nbdy_b_bt 869 967 870 968 ENDIF ! endif (nbdy_dta == 1) … … 875 973 IF ( nbdy_dta == 0) THEN 876 974 ! boundary data arrays are filled with initial conditions 877 igrd = 2! U-points data975 igrd = 5 ! U-points data 878 976 DO ib = 1, nblen(igrd) 879 977 ubtbdy(ib) = un(nbi(ib,igrd), nbj(ib,igrd), 1) 880 978 END DO 881 979 882 igrd = 3! V-points data980 igrd = 6 ! V-points data 883 981 DO ib = 1, nblen(igrd) 884 982 vbtbdy(ib) = vn(nbi(ib,igrd), nbj(ib,igrd), 1) 885 983 END DO 886 984 887 igrd = 1! T-points data985 igrd = 4 ! T-points data 888 986 DO ib = 1, nblen(igrd) 889 987 sshbdy(ib) = sshn(nbi(ib,igrd), nbj(ib,igrd)) … … 910 1008 ! Read first record: 911 1009 ipj=1 912 igrd= 11010 igrd=4 913 1011 ipi=nblendta(igrd) 914 1012 915 1013 ! ssh 916 igrd= 11014 igrd=4 917 1015 IF ( nblendta(igrd) .le. 0 ) THEN 918 1016 idvar = iom_varid( numbdyt_bt,'sossheig' ) … … 929 1027 930 1028 ! u-velocity 931 igrd= 21029 igrd=5 932 1030 IF ( nblendta(igrd) .le. 0 ) THEN 933 1031 idvar = iom_varid( numbdyu_bt,'vobtcrtx' ) … … 944 1042 945 1043 ! v-velocity 946 igrd= 31044 igrd=6 947 1045 IF ( nblendta(igrd) .le. 0 ) THEN 948 1046 idvar = iom_varid( numbdyv_bt,'vobtcrty' ) … … 1010 1108 ipj=1 1011 1109 ipk=jpk 1012 igrd= 11110 igrd=4 1013 1111 ipi=nblendta(igrd) 1014 1112 1015 1113 1016 1114 ! ssh 1017 igrd= 11115 igrd=4 1018 1116 ipi=nblendta(igrd) 1019 1117 … … 1025 1123 1026 1124 ! u-velocity 1027 igrd= 21125 igrd=5 1028 1126 ipi=nblendta(igrd) 1029 1127 … … 1035 1133 1036 1134 ! v-velocity 1037 igrd= 31135 igrd=6 1038 1136 ipi=nblendta(igrd) 1039 1137 … … 1064 1162 END IF 1065 1163 1066 igrd= 11164 igrd=4 1067 1165 DO ib=1, nblen(igrd) 1068 1166 sshbdy(ib) = zxy * sshbdydta(ib,2) + & … … 1070 1168 END DO 1071 1169 1072 igrd= 21170 igrd=5 1073 1171 DO ib=1, nblen(igrd) 1074 1172 ubtbdy(ib) = zxy * ubtbdydta(ib,2) + & … … 1076 1174 END DO 1077 1175 1078 igrd= 31176 igrd=6 1079 1177 DO ib=1, nblen(igrd) 1080 1178 vbtbdy(ib) = zxy * vbtbdydta(ib,2) + & … … 1090 1188 1091 1189 ! Closing of the 3 files 1092 IF( kt == nitend ) THEN1190 IF( kt == nitend .and. jit == icycl ) THEN 1093 1191 CALL iom_close( numbdyt_bt ) 1094 1192 CALL iom_close( numbdyu_bt ) … … 1109 1207 WRITE(*,*) 'bdy_dta: You should not have seen this print! error?', kt 1110 1208 END SUBROUTINE bdy_dta 1111 SUBROUTINE bdy_dta_bt( kt, kit ) ! Empty routine1209 SUBROUTINE bdy_dta_bt( kt, kit, icycle ) ! Empty routine 1112 1210 WRITE(*,*) 'bdy_dta: You should not have seen this print! error?', kt, kit 1113 1211 END SUBROUTINE bdy_dta_bt -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY/bdydyn.F90
- Property svn:executable deleted
r1740 r2236 8 8 !! 3.0 ! 2008-04 (NEMO team) add in the reference version 9 9 !! 3.2 ! 2008-04 (R. Benshila) consider velocity instead of transport 10 !! 3.3 ! 2010-09 (E.O'Dea) modifications for Shelf configurations 11 !! 3.3 ! 2010-09 (D.Storkey) add ice boundary conditions 10 12 !!---------------------------------------------------------------------- 11 13 #if defined key_bdy … … 34 36 35 37 !!---------------------------------------------------------------------- 36 !! NEMO/OPA 3. 0 , LOCEAN-IPSL (2008)38 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 37 39 !! $Id$ 38 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)40 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 39 41 !!---------------------------------------------------------------------- 40 41 42 CONTAINS 42 43 … … 54 55 INTEGER, INTENT( in ) :: kt ! Main time step counter 55 56 !! 56 INTEGER :: ib, ik, igrd! dummy loop indices57 INTEGER :: ii, ij ! 2D addresses58 REAL(wp) :: zwgt 57 INTEGER :: jb, jk ! dummy loop indices 58 INTEGER :: ii, ij, igrd ! local integers 59 REAL(wp) :: zwgt ! boundary weight 59 60 !!---------------------------------------------------------------------- 60 61 ! 61 IF(ln_bdy_dyn_frs) THEN ! If this is false, then this routine does nothing.62 62 IF(ln_bdy_dyn_frs) THEN ! If this is false, then this routine does nothing. 63 ! 63 64 IF( kt == nit000 ) THEN 64 65 IF(lwp) WRITE(numout,*) … … 68 69 ! 69 70 igrd = 2 ! Relaxation of zonal velocity 70 DO ib = 1, nblen(igrd)71 DO ik = 1, jpkm172 ii = nbi(ib,igrd)73 ij = nbj(ib,igrd)74 zwgt = nbw( ib,igrd)75 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) 76 77 END DO 77 78 END DO 78 79 ! 79 80 igrd = 3 ! Relaxation of meridional velocity 80 DO ib = 1, nblen(igrd)81 DO ik = 1, jpkm182 ii = nbi(ib,igrd)83 ij = nbj(ib,igrd)84 zwgt = nbw( ib,igrd)85 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) 86 87 END DO 87 88 END DO 88 ! 89 CALL lbc_lnk( ua, 'U', -1. ) ! Boundary points should be updated 90 CALL lbc_lnk( va, 'V', -1. ) ! 89 CALL lbc_lnk( ua, 'U', -1. ) ; CALL lbc_lnk( va, 'V', -1. ) ! Boundary points should be updated 91 90 ! 92 91 ENDIF ! ln_bdy_dyn_frs 93 92 ! 94 93 END SUBROUTINE bdy_dyn_frs 95 94 96 95 97 #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 98 102 !! Option to use Flather with dynspg_flt not coded yet... 103 99 104 SUBROUTINE bdy_dyn_fla( pssh ) 100 105 !!---------------------------------------------------------------------- … … 119 124 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pssh 120 125 121 INTEGER :: ib, igrd ! dummy loop indices126 INTEGER :: jb, igrd ! dummy loop indices 122 127 INTEGER :: ii, ij, iim1, iip1, ijm1, ijp1 ! 2D addresses 123 128 REAL(wp) :: zcorr ! Flather correction … … 132 137 133 138 ! Fill temporary array with ssh data (here spgu): 134 igrd = 1139 igrd = 4 135 140 spgu(:,:) = 0.0 136 DO ib = 1, nblenrim(igrd)137 ii = nbi( ib,igrd)138 ij = nbj( ib,igrd)139 IF( ln_bdy_dyn_fla ) spgu(ii, ij) = sshbdy( ib)140 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) 141 146 END DO 142 147 ! 143 igrd = 2! Flather bc on u-velocity;148 igrd = 5 ! Flather bc on u-velocity; 144 149 ! ! remember that flagu=-1 if normal velocity direction is outward 145 150 ! ! I think we should rather use after ssh ? 146 DO ib = 1, nblenrim(igrd)147 ii = nbi( ib,igrd)148 ij = nbj( ib,igrd)149 iim1 = ii + MAX( 0, INT( flagu( ib) ) ) ! T pts i-indice inside the boundary150 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 151 156 ! 152 zcorr = - flagu( ib) * SQRT( grav * hur_e(ii, ij) ) * ( pssh(iim1, ij) - spgu(iip1,ij) )153 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) 154 159 ua_e(ii,ij) = zforc + zcorr * umask(ii,ij,1) 155 160 END DO 156 161 ! 157 igrd = 3! Flather bc on v-velocity162 igrd = 6 ! Flather bc on v-velocity 158 163 ! ! remember that flagv=-1 if normal velocity direction is outward 159 DO ib = 1, nblenrim(igrd)160 ii = nbi( ib,igrd)161 ij = nbj( ib,igrd)162 ijm1 = ij + MAX( 0, INT( flagv( ib) ) ) ! T pts j-indice inside the boundary163 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 164 169 ! 165 zcorr = - flagv( ib) * SQRT( grav * hvr_e(ii, ij) ) * ( pssh(ii, ijm1) - spgu(ii,ijp1) )166 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) 167 172 va_e(ii,ij) = zforc + zcorr * vmask(ii,ij,1) 168 173 END DO 174 CALL lbc_lnk( ua_e, 'U', -1. ) ! Boundary points should be updated 175 CALL lbc_lnk( va_e, 'V', -1. ) ! 169 176 ! 170 177 ENDIF ! ln_bdy_dyn_fla .or. ln_bdy_tides -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY/bdyini.F90
- Property svn:executable deleted
r1528 r2236 8 8 !! - ! 2007-01 (D. Storkey) Tidal forcing 9 9 !! 3.0 ! 2008-04 (NEMO team) add in the reference version 10 !! 3.3 ! 2010-09 (E.O'Dea) updates for Shelf configurations 11 !! 3.3 ! 2010-09 (D.Storkey) add ice boundary conditions 10 12 !!---------------------------------------------------------------------- 11 13 #if defined key_bdy … … 17 19 USE oce ! ocean dynamics and tracers variables 18 20 USE dom_oce ! ocean space and time domain 21 USE obc_par ! ocean open boundary conditions 19 22 USE bdy_oce ! unstructured open boundary conditions 20 23 USE bdytides ! tides at open boundaries initialization (tide_init routine) … … 30 33 31 34 !!---------------------------------------------------------------------- 32 !! NEMO/OPA 3. 0 , LOCEAN-IPSL (2008)35 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 33 36 !! $Id$ 34 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt) 35 !!--------------------------------------------------------------------------------- 36 37 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 38 !!---------------------------------------------------------------------- 37 39 CONTAINS 38 40 … … 48 50 !! 49 51 !! ** Input : bdy_init.nc, input file for unstructured open boundaries 50 !!51 52 !!---------------------------------------------------------------------- 52 53 INTEGER :: ii, ij, ik, igrd, ib, ir ! dummy loop indices … … 54 55 INTEGER :: ib_len, ibr_max 55 56 INTEGER :: iw, ie, is, in 56 INTEGER :: inum ! temporarylogical unit57 INTEGER :: id_dummy ! temporaryintegers57 INTEGER :: inum ! local logical unit 58 INTEGER :: id_dummy ! local integers 58 59 INTEGER :: igrd_start, igrd_end ! start and end of loops on igrd 59 60 INTEGER, DIMENSION (2) :: kdimsz … … 63 64 REAL(wp) , DIMENSION(jpidta,jpjdta) :: zmask ! global domain mask 64 65 REAL(wp) , DIMENSION(jpbdta,1) :: zdta ! temporary array 65 CHARACTER(LEN=80),DIMENSION( 3) :: clfile66 CHARACTER(LEN=80),DIMENSION(6) :: clfile 66 67 !! 67 68 NAMELIST/nambdy/filbdy_mask, filbdy_data_T, filbdy_data_U, filbdy_data_V, & 69 & filbdy_data_bt_T, filbdy_data_bt_U, filbdy_data_bt_V, & 68 70 & ln_bdy_tides, ln_bdy_clim, ln_bdy_vol, ln_bdy_mask, & 69 & ln_bdy_dyn_fla, ln_bdy_dyn_frs, ln_bdy_tra_frs, 70 & nbdy_dta , nb_rimwidth, volbdy71 & ln_bdy_dyn_fla, ln_bdy_dyn_frs, ln_bdy_tra_frs,ln_bdy_ice_frs, & 72 & nbdy_dta, nb_rimwidth, volbdy 71 73 !!---------------------------------------------------------------------- 72 74 … … 75 77 IF(lwp) WRITE(numout,*) '~~~~~~~~' 76 78 ! 77 IF( jperio /= 0 ) CALL ctl_stop( 'Cyclic or symmetric,', & 78 ' and unstructured open boundary condition are not compatible' ) 79 80 #if defined key_obc 81 CALL ctl_stop( 'Straight open boundaries,', & 82 ' and unstructured open boundaries are not compatible' ) 83 #endif 84 85 ! 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 86 85 ! --------------------------- 87 REWIND( numnam ) 86 REWIND( numnam ) ! Read namelist parameters 88 87 READ ( numnam, nambdy ) 89 88 90 ! control prints89 ! ! control prints 91 90 IF(lwp) WRITE(numout,*) ' nambdy' 92 91 93 ! Check nbdy_dta value92 ! ! check type of data used (nbdy_dta value) 94 93 IF(lwp) WRITE(numout,*) 'nbdy_dta =', nbdy_dta 95 IF(lwp) WRITE(numout,*) ' ' 96 SELECT CASE( nbdy_dta ) 97 CASE( 0 ) 98 IF(lwp) WRITE(numout,*) ' initial state used for bdy data' 99 CASE( 1 ) 100 IF(lwp) WRITE(numout,*) ' boundary data taken from file' 101 CASE DEFAULT 102 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' ) 103 99 END SELECT 104 100 105 IF(lwp) WRITE(numout,*) ' '101 IF(lwp) WRITE(numout,*) 106 102 IF(lwp) WRITE(numout,*) 'Boundary rim width for the FRS nb_rimwidth = ', nb_rimwidth 107 103 108 IF(lwp) WRITE(numout,*) ' ' 109 IF(lwp) WRITE(numout,*) ' volbdy = ', volbdy 110 111 IF (ln_bdy_vol) THEN 112 SELECT CASE ( volbdy ) ! Check volbdy value 113 CASE( 1 ) 114 IF(lwp) WRITE(numout,*) ' The total volume will be constant' 115 CASE( 0 ) 116 IF(lwp) WRITE(numout,*) ' The total volume will vary according' 117 IF(lwp) WRITE(numout,*) ' to the surface E-P flux' 118 CASE DEFAULT 119 CALL ctl_stop( 'volbdy must be 0 or 1' ) 120 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,*) 121 114 ELSE 122 IF(lwp) WRITE(numout,*) 'No volume correction with unstructured open boundaries' 123 IF(lwp) WRITE(numout,*) ' ' 124 ENDIF 125 126 IF (ln_bdy_tides) THEN 127 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 128 120 IF(lwp) WRITE(numout,*) 'Tidal harmonic forcing at unstructured open boundaries' 129 IF(lwp) WRITE(numout,*) ' ' 130 ENDIF 131 132 IF (ln_bdy_dyn_fla) THEN 133 IF(lwp) WRITE(numout,*) ' ' 121 IF(lwp) WRITE(numout,*) 122 ENDIF 123 124 IF( ln_bdy_dyn_fla ) THEN 134 125 IF(lwp) WRITE(numout,*) 'Flather condition on U, V at unstructured open boundaries' 135 IF(lwp) WRITE(numout,*) ' ' 136 ENDIF 137 138 IF (ln_bdy_dyn_frs) THEN 139 IF(lwp) WRITE(numout,*) ' ' 126 IF(lwp) WRITE(numout,*) 127 ENDIF 128 129 IF( ln_bdy_dyn_frs ) THEN 140 130 IF(lwp) WRITE(numout,*) 'FRS condition on U and V at unstructured open boundaries' 141 IF(lwp) WRITE(numout,*) ' ' 142 ENDIF 143 144 IF (ln_bdy_tra_frs) THEN 145 IF(lwp) WRITE(numout,*) ' ' 131 IF(lwp) WRITE(numout,*) 132 ENDIF 133 134 IF( ln_bdy_tra_frs ) THEN 146 135 IF(lwp) WRITE(numout,*) 'FRS condition on T & S fields at unstructured open boundaries' 147 IF(lwp) WRITE(numout,*) ' ' 148 ENDIF 149 150 ! Read tides namelist 151 ! ------------------------ 152 IF( ln_bdy_tides ) CALL tide_init 136 IF(lwp) WRITE(numout,*) 137 ENDIF 138 139 IF( ln_bdy_ice_frs ) THEN 140 IF(lwp) WRITE(numout,*) 'FRS condition on ice fields at unstructured open boundaries' 141 IF(lwp) WRITE(numout,*) 142 ENDIF 143 144 IF( ln_bdy_tides ) CALL tide_init ! Read tides namelist 145 153 146 154 147 ! Read arrays defining unstructured open boundaries … … 160 153 ! = 0 elsewhere 161 154 162 IF( cp_cfg == "eel" .AND. jp_cfg == 5 ) THEN 155 IF( cp_cfg == "eel" .AND. jp_cfg == 5 ) THEN ! EEL configuration at 5km resolution 163 156 zmask( : ,:) = 0.e0 164 157 zmask(jpizoom+1:jpizoom+jpiglo-2,:) = 1.e0 165 ELSE IF 158 ELSE IF( ln_bdy_mask ) THEN 166 159 CALL iom_open( filbdy_mask, inum ) 167 160 CALL iom_get ( inum, jpdom_data, 'bdy_msk', zmask(:,:) ) … … 171 164 ENDIF 172 165 173 ! Save mask over local domain 174 DO ij = 1, nlcj 166 DO ij = 1, nlcj ! Save mask over local domain 175 167 DO ii = 1, nlci 176 168 bdytmask(ii,ij) = zmask( mig(ii), mjg(ij) ) … … 187 179 END DO 188 180 END DO 189 190 ! Lateral boundary conditions 191 CALL lbc_lnk( bdyumask(:,:), 'U', 1. ) 192 CALL lbc_lnk( bdyvmask(:,:), 'V', 1. ) 181 CALL lbc_lnk( bdyumask(:,:), 'U', 1. ) ; CALL lbc_lnk( bdyvmask(:,:), 'V', 1. ) ! Lateral boundary cond. 182 193 183 194 184 ! Read discrete distance and mapping indices … … 200 190 IF( cp_cfg == "eel" .AND. jp_cfg == 5 ) THEN 201 191 icount = 0 202 ! Define west boundary (from ii=2 to ii=1+nb_rimwidth): 203 DO ir = 1, nb_rimwidth 192 DO ir = 1, nb_rimwidth ! Define west boundary (from ii=2 to ii=1+nb_rimwidth): 204 193 DO ij = 3, jpjglo-2 205 icount =icount+1194 icount = icount + 1 206 195 nbidta(icount,:) = ir + 1 + (jpizoom-1) 207 nbjdta(icount,:) = ij + (jpjzoom-1)196 nbjdta(icount,:) = ij + (jpjzoom-1) 208 197 nbrdta(icount,:) = ir 209 198 END DO 210 199 END DO 211 212 ! Define east boundary (from ii=jpiglo-1 to ii=jpiglo-nb_rimwidth): 213 DO ir=1,nb_rimwidth 200 ! 201 DO ir = 1, nb_rimwidth ! Define east boundary (from ii=jpiglo-1 to ii=jpiglo-nb_rimwidth): 214 202 DO ij=3,jpjglo-2 215 icount =icount+1203 icount = icount + 1 216 204 nbidta(icount,:) = jpiglo-ir + (jpizoom-1) 217 205 nbidta(icount,2) = jpiglo-ir-1 + (jpizoom-1) ! special case for u points … … 220 208 END DO 221 209 END DO 222 210 ! 223 211 ELSE ! Read indices and distances in unstructured boundary data files 224 225 IF( ln_bdy_tides ) THEN 226 ! Read tides input files for preference in case there are 227 ! no bdydata files. 228 clfile(1) = TRIM(filtide)//TRIM(tide_cpt(1))//'_grid_T.nc' 229 clfile(2) = TRIM(filtide)//TRIM(tide_cpt(1))//'_grid_U.nc' 230 clfile(3) = TRIM(filtide)//TRIM(tide_cpt(1))//'_grid_V.nc' 231 ELSE 212 ! 213 IF( ln_bdy_tides ) THEN ! Read tides input files for preference in case there are no bdydata files 214 clfile(4) = TRIM(filtide)//TRIM(tide_cpt(1))//'_grid_T.nc' 215 clfile(5) = TRIM(filtide)//TRIM(tide_cpt(1))//'_grid_U.nc' 216 clfile(6) = TRIM(filtide)//TRIM(tide_cpt(1))//'_grid_V.nc' 217 ENDIF 218 IF( ln_bdy_dyn_fla .AND. .NOT. ln_bdy_tides ) THEN 219 clfile(4) = filbdy_data_bt_T 220 clfile(5) = filbdy_data_bt_U 221 clfile(6) = filbdy_data_bt_V 222 ENDIF 223 224 IF( ln_bdy_tra_frs ) THEN 232 225 clfile(1) = 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 ! 229 ENDIF 230 ENDIF 231 IF( ln_bdy_dyn_frs ) THEN 232 IF( .NOT. ln_bdy_tra_frs ) clfile(1) = filbdy_data_U ! Dummy Read 233 233 clfile(2) = filbdy_data_U 234 clfile(3) = filbdy_data_V 235 ENDIF 236 237 ! how many files are we to read in?238 igrd_start = 1239 igrd_end = 3240 IF( .NOT. ln_bdy_tides ) THEN241 IF(.NOT. (ln_bdy_dyn_fla) .AND..NOT. (ln_bdy_tra_frs)) THEN242 ! No T-grid file.243 igrd_start = 2244 ELSEIF ( .NOT. ln_bdy_dyn_frs .AND..NOT. ln_bdy_dyn_fla ) THEN245 ! No U-grid or V-grid file.246 igrd_end = 1247 ENDIF234 clfile(3) = filbdy_data_V 235 ENDIF 236 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 242 ENDIF 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 248 248 ENDIF 249 249 … … 251 251 CALL iom_open( clfile(igrd), inum ) 252 252 id_dummy = iom_varid( inum, 'nbidta', kdimsz=kdimsz ) 253 WRITE(numout,*) 'kdimsz : ',kdimsz253 IF(lwp) WRITE(numout,*) 'kdimsz : ',kdimsz 254 254 ib_len = kdimsz(1) 255 IF( ib_len > jpbdta) CALL ctl_stop( & 256 'Boundary data array in file too long.', & 257 'File :', TRIM(clfile(igrd)), & 258 '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.' ) 259 257 260 258 CALL iom_get( inum, jpdom_unknown, 'nbidta', zdta(1:ib_len,:) ) … … 264 262 CALL iom_get( inum, jpdom_unknown, 'nbjdta', zdta(1:ib_len,:) ) 265 263 DO ii = 1,ib_len 266 nbjdta(ii,igrd) = INT( zdta(ii,1) )267 END DO 268 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,:) ) 269 267 DO ii = 1,ib_len 270 nbrdta(ii,igrd) = INT( zdta(ii,1) )268 nbrdta(ii,igrd) = INT( zdta(ii,1) ) 271 269 END DO 272 270 CALL iom_close( inum ) 273 271 274 ! Check that rimwidth in file is big enough:275 ibr_max = MAXVAL( nbrdta(:,igrd) )276 IF(lwp) WRITE(numout,*)277 IF(lwp) WRITE(numout,*) ' Maximum rimwidth in file is ', ibr_max278 IF(lwp) WRITE(numout,*) ' nb_rimwidth from namelist is ', nb_rimwidth279 IF (ibr_max < nb_rimwidth) CALL ctl_stop( &280 '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' ) 278 ENDIF !Check igrd < 4 281 279 ! 282 280 END DO … … 293 291 294 292 DO igrd = igrd_start, igrd_end 295 icount = 0296 icountr = 0297 nblen(igrd) = 0298 nblenrim(igrd) = 0299 nblendta(igrd) = 0300 DO ir=1, nb_rimwidth301 DO ib = 1, jpbdta302 ! check if point is in local domain and equals ir303 IF( nbidta(ib,igrd) >= iw .AND. nbidta(ib,igrd) <= ie .AND. &304 & nbjdta(ib,igrd) >= is .AND. nbjdta(ib,igrd) <= in .AND. &305 & nbrdta(ib,igrd) == ir ) THEN306 !307 icount = icount + 1308 !309 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 310 308 IF (icount > jpbdim) THEN 311 309 IF(lwp) WRITE(numout,*) 'bdy_ini: jpbdim too small' … … 328 326 DO igrd = igrd_start, igrd_end 329 327 DO ib = 1, nblen(igrd) 330 ! tanh formulation 331 nbw(ib,igrd) = 1.- TANH( FLOAT( nbr(ib,igrd) - 1 ) *0.5 ) 332 ! quadratic 333 ! nbw(ib,igrd) = (FLOAT(nb_rimwidth+1-nbr(ib,igrd))/FLOAT(nb_rimwidth))**2 334 ! linear 335 ! 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 336 331 END DO 337 332 END DO … … 384 379 385 380 ! Lateral boundary conditions 386 CALL lbc_lnk( fmask , 'F', 1. ) 387 CALL lbc_lnk( bdytmask(:,:), 'T', 1. ) 388 CALL lbc_lnk( bdyumask(:,:), 'U', 1. ) 389 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. ) 390 383 391 384 IF( ln_bdy_vol .OR. ln_bdy_dyn_fla ) THEN ! Indices and directions of rim velocity components … … 437 430 ! Compute total lateral surface for volume correction: 438 431 ! ---------------------------------------------------- 439 440 432 bdysurftot = 0.e0 441 433 IF( ln_bdy_vol ) THEN … … 455 447 & * tmask_i(nbi(ib,igrd),nbj(ib,igrd)+1) 456 448 END DO 457 449 ! 458 450 IF( lk_mpp ) CALL mpp_sum( bdysurftot ) ! sum over the global domain 459 451 END IF … … 468 460 ubtbdy(:) = 0.e0 469 461 vbtbdy(:) = 0.e0 462 #if defined key_lim2 463 frld_bdy(:) = 0.e0 464 hicif_bdy(:) = 0.e0 465 hsnif_bdy(:) = 0.e0 466 #endif 470 467 471 468 ! Read in tidal constituents and adjust for model start time -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY/bdytides.F90
- Property svn:executable deleted
r1715 r2236 7 7 !! 2.3 ! 2008-01 (J.Holt) Add date correction. Origins POLCOMS v6.3 2007 8 8 !! 3.0 ! 2008-04 (NEMO team) add in the reference version 9 !! 3.3 ! 2010-09 (D.Storkey and E.O'Dea) bug fixes 9 10 !!---------------------------------------------------------------------- 10 11 #if defined key_bdy … … 31 32 USE bdy_par ! Unstructured boundary parameters 32 33 USE bdy_oce ! ocean open boundary conditions 34 USE daymod ! calendar 33 35 34 36 IMPLICIT NONE … … 39 41 PUBLIC tide_update ! routine called in bdydyn 40 42 41 LOGICAL, PUBLIC :: ln_tide_date !: =T correct tide phases and amplitude for model start date 42 43 INTEGER, PARAMETER :: jptides_max = 15 !: Max number of tidal contituents 44 INTEGER :: ntide !: Actual number of tidal constituents 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 45 INTEGER, PUBLIC :: ntide !: Actual number of tidal constituents 45 46 46 47 CHARACTER(len=80), PUBLIC :: filtide !: Filename root for tidal input files 47 48 CHARACTER(len= 4), PUBLIC, DIMENSION(jptides_max) :: tide_cpt !: Names of tidal components used. 48 49 49 INTEGER , DIMENSION(jptides_max) :: nindx !: ???50 REAL(wp), DIMENSION(jptides_max) :: 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) 51 52 52 REAL(wp), DIMENSION(jpbdim,jptides_max) :: ssh1, ssh2 ! :Tidal constituents : SSH53 REAL(wp), DIMENSION(jpbdim,jptides_max) :: u1 , u2 ! :Tidal constituents : U54 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 55 56 56 57 !!---------------------------------------------------------------------- 57 !! NEMO/OPA 3. 0 , LOCEAN-IPSL (2008)58 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 58 59 !! $Id$ 59 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)60 !! Software governed by the CeCILL licence (NEMOGCM/License_CeCILL.txt) 60 61 !!---------------------------------------------------------------------- 61 62 62 CONTAINS 63 63 … … 87 87 ! ! Count number of components specified 88 88 ntide = jptides_max 89 itide = 1 90 DO WHILE( tide_cpt(itide) /= '' ) 91 ntide = itide 92 itide = itide + 1 89 DO itide = 1, jptides_max 90 IF( tide_cpt(itide) == '' ) THEN 91 ntide = itide-1 92 exit 93 ENDIF 93 94 END DO 95 94 96 ! ! find constituents in standard list 95 97 DO itide = 1, ntide … … 145 147 CHARACTER(len=80) :: clfile ! full file name for tidal input file 146 148 INTEGER :: ipi, ipj, inum, idvar ! temporary integers (netcdf read) 147 INTEGER, DIMENSION( 3) :: lendta=0 ! length of data in the file (note may be different from nblendta!)149 INTEGER, DIMENSION(6) :: lendta=0 ! length of data in the file (note may be different from nblendta!) 148 150 REAL(wp) :: z_arg, z_atde, z_btde, z1t, z2t 149 151 REAL(wp), DIMENSION(jpbdta,1) :: zdta ! temporary array for data fields … … 161 163 IF(lwp) WRITE(numout,*) 'Reading data from file ', clfile 162 164 CALL iom_open( clfile, inum ) 163 igrd = 1165 igrd = 4 164 166 IF( nblendta(igrd) <= 0 ) THEN 165 167 idvar = iom_varid( inum,'z1' ) … … 183 185 IF(lwp) WRITE(numout,*) 'Reading data from file ', clfile 184 186 CALL iom_open( clfile, inum ) 185 igrd = 2187 igrd = 5 186 188 IF( lendta(igrd) <= 0 ) THEN 187 189 idvar = iom_varid( inum,'u1' ) … … 204 206 if(lwp) write(numout,*) 'Reading data from file ', clfile 205 207 CALL iom_open( clfile, inum ) 206 igrd = 3208 igrd = 6 207 209 IF( lendta(igrd) <= 0 ) THEN 208 210 idvar = iom_varid( inum,'v1' ) … … 252 254 ENDIF 253 255 ! ! elevation 254 igrd = 1256 igrd = 4 255 257 DO ib = 1, nblenrim(igrd) 256 258 z1t = z_atde * ssh1(ib,itide) + z_btde * ssh2(ib,itide) … … 260 262 END DO 261 263 ! ! u 262 igrd = 2264 igrd = 5 263 265 DO ib = 1, nblenrim(igrd) 264 266 z1t = z_atde * u1(ib,itide) + z_btde * u2(ib,itide) … … 268 270 END DO 269 271 ! ! v 270 igrd = 3272 igrd = 6 271 273 DO ib = 1, nblenrim(igrd) 272 274 z1t = z_atde * v1(ib,itide) + z_btde * v2(ib,itide) … … 320 322 ! 321 323 DO itide = 1, ntide 322 igrd= 1! SSH on tracer grid.324 igrd=4 ! SSH on tracer grid. 323 325 DO ib = 1, nblenrim(igrd) 324 326 sshtide(ib) =sshtide(ib)+ ssh1(ib,itide)*z_cost(itide) + ssh2(ib,itide)*z_sist(itide) 325 327 ! if(lwp) write(numout,*) 'z',ib,itide,sshtide(ib), ssh1(ib,itide),ssh2(ib,itide) 326 328 END DO 327 igrd= 2! U grid329 igrd=5 ! U grid 328 330 DO ib=1, nblenrim(igrd) 329 331 utide(ib) = utide(ib)+ u1(ib,itide)*z_cost(itide) + u2(ib,itide)*z_sist(itide) 330 332 ! if(lwp) write(numout,*) 'u',ib,itide,utide(ib), u1(ib,itide),u2(ib,itide) 331 333 END DO 332 igrd= 3! V grid334 igrd=6 ! V grid 333 335 DO ib=1, nblenrim(igrd) 334 336 vtide(ib) = vtide(ib)+ v1(ib,itide)*z_cost(itide) + v2(ib,itide)*z_sist(itide) -
branches/DEV_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY/bdytra.F90
- Property svn:executable deleted
r1146 r2236 25 25 26 26 !!---------------------------------------------------------------------- 27 !! NEMO/OPA 3. 0 , LOCEAN-IPSL (2008)27 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 28 28 !! $Id$ 29 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)29 !! Software governed by the CeCILL licence (NEMOGCM/License_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_r2106_LOCEAN2010/NEMO/OPA_SRC/BDY/bdyvol.F90
- Property svn:executable deleted
r2000 r2236 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 !! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)34 !! Software governed by the CeCILL licence (NEMOGCM/License_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 … … 84 83 ! Calculate the cumulate surface Flux z_cflxemp (m3/s) over all the domain 85 84 ! ----------------------------------------------------------------------- 86 z_cflxemp = 0.e0 87 zraur = 1.e0 / rau0 88 z_cflxemp = SUM ( ( emp(:,:)-rnf(:,:) ) * bdytmask(:,:) * e1t(:,:) * e2t(:,:) * zraur ) 89 IF( lk_mpp ) CALL mpp_sum( z_cflxemp ) ! sum over the global domain 85 z_cflxemp = SUM ( ( emp(:,:)-rnf(:,:) ) * bdytmask(:,:) * e1t(:,:) * e2t(:,:) ) / rau0 86 IF( lk_mpp ) CALL mpp_sum( z_cflxemp ) ! sum over the global domain 90 87 91 ! Barotropic velocitythrough the unstructured open boundary92 ! ------------------------------------------------ ----------88 ! Transport through the unstructured open boundary 89 ! ------------------------------------------------ 93 90 zubtpecor = 0.e0 94 91 jgrd = 2 ! cumulate u component contribution first … … 112 109 ! The normal velocity correction 113 110 ! ------------------------------ 114 IF (volbdy==1) THEN ; zubtpecor = ( zubtpecor - z_cflxemp) / bdysurftot115 ELSE ; zubtpecor = zubtpecor / bdysurftot111 IF( volbdy==1 ) THEN ; zubtpecor = ( zubtpecor - z_cflxemp) / bdysurftot 112 ELSE ; zubtpecor = zubtpecor / bdysurftot 116 113 END IF 117 114 … … 141 138 ! Check the cumulated transport through unstructured OBC once barotropic velocities corrected 142 139 ! ------------------------------------------------------ 143 144 140 IF( lwp .AND. MOD( kt, nwrite ) == 0) THEN 145 141 IF(lwp) WRITE(numout,*)
Note: See TracChangeset
for help on using the changeset viewer.
