Changeset 2818
- Timestamp:
- 2011-08-08T10:16:41+02:00 (13 years ago)
- Location:
- branches/2011/UKMO_MERCATOR_obc_bdy_merge/NEMOGCM/NEMO/OPA_SRC
- Files:
-
- 5 edited
-
DYN/dynnxt.F90 (modified) (2 diffs)
-
OBC/obcdta.F90 (modified) (2 diffs)
-
OBC/obcdyn2d.F90 (modified) (1 diff)
-
OBC/obcini.F90 (modified) (2 diffs)
-
SBC/fldread.F90 (modified) (13 diffs)
Legend:
- Unmodified
- Added
- Removed
-
branches/2011/UKMO_MERCATOR_obc_bdy_merge/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90
r2800 r2818 30 30 USE domvvl ! variable volume 31 31 USE obc_oce ! ocean open boundary conditions 32 USE obcdyn ! open boundary condition for baroclinic velocities 32 USE obcdta ! ocean open boundary conditions 33 USE obcdyn3d ! ocean open boundary conditions 33 34 USE obcvol ! ocean open boundary condition (obc_vol routines) 34 35 USE in_out_manager ! I/O manager … … 154 155 IF( .NOT. lk_dynspg_flt ) THEN 155 156 156 CALL obc_dyn ( kt )157 CALL obc_dyn3d( kt ) 157 158 158 159 !!$!!gm ERROR - potential BUG: sshn should not be modified at this stage !! ssh_nxt not alrady called -
branches/2011/UKMO_MERCATOR_obc_bdy_merge/NEMOGCM/NEMO/OPA_SRC/OBC/obcdta.F90
r2814 r2818 206 206 ! Update barotropic boundary conditions only 207 207 ! jit is optional argument for fld_read 208 IF( nn_dyn2d(ib_obc) .gt. 0 .and. nn_tides(ib_obc) .ne. 1 ) THEN 209 jend = jstart + 2 210 CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend), jit=jit ) 208 IF( nn_dyn2d(ib_obc) .gt. 0 ) THEN 209 IF( nn_tides(ib_obc) .eq. 1 ) THEN 210 dta_obc(ib_obc)%ssh(:) = 0.0 211 dta_obc(ib_obc)%u2d(:) = 0.0 212 dta_obc(ib_obc)%v2d(:) = 0.0 213 ELSE 214 jend = jstart + 2 215 CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend), jit=jit ) 216 ENDIF 211 217 ENDIF 212 218 IF( nn_tides(ib_obc) .gt. 0 ) THEN … … 217 223 jend = jstart + nb_obc_fld(ib_obc) - 1 218 224 CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend), timeshift=1 ) 225 ENDIF 226 IF( nn_tides(ib_obc) .eq. 1 ) THEN 227 dta_obc(ib_obc)%ssh(:) = 0.0 228 dta_obc(ib_obc)%u2d(:) = 0.0 229 dta_obc(ib_obc)%v2d(:) = 0.0 219 230 ENDIF 220 231 IF( nn_tides(ib_obc) .gt. 0 ) THEN -
branches/2011/UKMO_MERCATOR_obc_bdy_merge/NEMOGCM/NEMO/OPA_SRC/OBC/obcdyn2d.F90
r2814 r2818 129 129 TYPE(OBC_INDEX), INTENT(in) :: idx ! OBC indices 130 130 TYPE(OBC_DATA), INTENT(in) :: dta ! OBC external data 131 REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: pssh132 131 133 132 INTEGER :: jb, igrd ! dummy loop indices -
branches/2011/UKMO_MERCATOR_obc_bdy_merge/NEMOGCM/NEMO/OPA_SRC/OBC/obcini.F90
r2814 r2818 51 51 !! ** Input : obc_init.nc, input file for unstructured open boundaries 52 52 !!---------------------------------------------------------------------- 53 INTEGER :: ib_obc, ii, ij, ik, igrd, ib, ir ! dummy loop indices54 INTEGER :: icount, icountr, ibr_max, ilen1 55 INTEGER :: iw, ie, is, in, inum, id_dummy ! - -56 INTEGER :: igrd_start, igrd_end, jpbdta ! - -57 INTEGER, POINTER :: nbi, nbj, nbr ! short cuts58 REAL , POINTER :: flagu, flagv ! - -59 REAL(wp) :: zefl, zwfl, znfl, zsfl ! local scalars53 INTEGER :: ib_obc, ii, ij, ik, igrd, ib, ir ! dummy loop indices 54 INTEGER :: icount, icountr, ibr_max, ilen1, ibm1 ! local integers 55 INTEGER :: iw, ie, is, in, inum, id_dummy ! - - 56 INTEGER :: igrd_start, igrd_end, jpbdta ! - - 57 INTEGER, POINTER :: nbi, nbj, nbr ! short cuts 58 REAL , POINTER :: flagu, flagv ! - - 59 REAL(wp) :: zefl, zwfl, znfl, zsfl ! local scalars 60 60 INTEGER, DIMENSION (2) :: kdimsz 61 61 INTEGER, DIMENSION(jpbgrd,jp_obc) :: nblendta ! Length of index arrays … … 302 302 idx_obc(ib_obc)%nblenrim(igrd) = 0 303 303 DO ib = 1, nblendta(igrd,ib_obc) 304 ! check that data is in correct order in file 305 ibm1 = MAX(1,ib-1) 306 IF(lwp) THEN ! Since all procs read global data only need to do this check on one proc... 307 IF( nbrdta(ib,igrd,ib_obc) < nbrdta(ibm1,igrd,ib_obc) ) THEN 308 CALL ctl_stop('obc_init : ERROR : boundary data in file must be defined in order of distance from edge nbr.', & 309 'A utility for re-ordering boundary coordinates and data files exists in CDFTOOLS') 310 ENDIF 311 ENDIF 304 312 ! check if point is in local domain 305 313 IF( nbidta(ib,igrd,ib_obc) >= iw .AND. nbidta(ib,igrd,ib_obc) <= ie .AND. & -
branches/2011/UKMO_MERCATOR_obc_bdy_merge/NEMOGCM/NEMO/OPA_SRC/SBC/fldread.F90
r2814 r2818 131 131 LOGICAL :: llnxtmth ! open next month file? 132 132 LOGICAL :: llstop ! stop is the file does not exist 133 LOGICAL :: ll_firstcall ! true if this is the first call to fld_read for this set of fields 133 134 REAL(wp) :: ztinta ! ratio applied to after records when doing time interpolation 134 135 REAL(wp) :: ztintb ! ratio applied to before records when doing time interpolation 135 136 CHARACTER(LEN=1000) :: clfmt ! write format 136 137 !!--------------------------------------------------------------------- 138 ll_firstcall = .false. 139 IF( PRESENT(jit) ) THEN 140 IF(kt == nit000 .and. jit == 1) ll_firstcall = .true. 141 ELSE 142 IF(kt == nit000) ll_firstcall = .true. 143 ENDIF 144 137 145 ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar 138 146 IF( present(jit) ) THEN … … 146 154 imf = SIZE( sd ) 147 155 ! 148 IF( kt == nit000) THEN ! initialization156 IF( ll_firstcall ) THEN ! initialization 149 157 IF( PRESENT(map) ) THEN 150 158 DO jf = 1, imf … … 165 173 DO jf = 1, imf ! --- loop over field --- ! 166 174 167 IF( isecsbc > sd(jf)%nrec_a(2) .OR. kt == nit000) THEN ! read/update the after data?175 IF( isecsbc > sd(jf)%nrec_a(2) .OR. ll_firstcall ) THEN ! read/update the after data? 168 176 169 177 IF( sd(jf)%ln_tint ) THEN ! swap before record field and informations … … 173 181 ENDIF 174 182 175 CALL fld_rec( kn_fsbc, sd(jf) ) ! update record informations 183 IF( PRESENT(jit) ) THEN 184 CALL fld_rec( kn_fsbc, sd(jf), jit=jit ) ! update record informations 185 ELSE 186 CALL fld_rec( kn_fsbc, sd(jf) ) ! update record informations 187 ENDIF 176 188 177 189 ! do we have to change the year/month/week/day of the forcing field?? … … 256 268 ! temporal interpolation weights 257 269 ztinta = REAL( isecsbc - sd(jf)%nrec_b(2), wp ) / REAL( sd(jf)%nrec_a(2) - sd(jf)%nrec_b(2), wp ) 258 IF( PRESENT(map) ) THEN259 IF(lwp) WRITE(numout,*) '============================================'260 IF(lwp) WRITE(numout,*) 'Output from fld_read(map) on timestep ',kt261 IF(lwp) WRITE(numout,*) '============================================'262 IF(lwp) WRITE(numout,*) 'sd(jf)%nrec_b(2), sd(jf)%nrec_a(2), isecsbc, ztinta, ztintb : ',sd(jf)%nrec_b(2),sd(jf)%nrec_a(2),isecsbc,ztinta,ztintb263 ENDIF264 270 ztintb = 1. - ztinta 265 271 !CDIR COLLAPSE … … 433 439 434 440 435 SUBROUTINE fld_rec( kn_fsbc, sdjf, ldbefore )441 SUBROUTINE fld_rec( kn_fsbc, sdjf, ldbefore, jit ) 436 442 !!--------------------------------------------------------------------- 437 443 !! *** ROUTINE fld_rec *** … … 447 453 TYPE(FLD), INTENT(inout) :: sdjf ! input field related variables 448 454 LOGICAL , INTENT(in ), OPTIONAL :: ldbefore ! sent back before record values (default = .FALSE.) 455 INTEGER , INTENT(in ), OPTIONAL :: jit ! index of barotropic subcycle 449 456 ! used only if sdjf%ln_tint = .TRUE. 450 457 !! … … 480 487 ! 481 488 ztmp = REAL( nday, wp ) / REAL( nyear_len(1), wp ) + 0.5 489 IF( PRESENT(jit) ) ztmp = ztmp + jit*rdt/REAL(nn_baro,wp) 482 490 sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/)) 483 491 ! swap at the middle of the year … … 508 516 ! 509 517 ztmp = REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) + 0.5 518 IF( PRESENT(jit) ) ztmp = ztmp + jit*rdt/REAL(nn_baro,wp) 510 519 imth = nmonth + INT( ztmp ) - COUNT((/llbefore/)) 511 520 IF( sdjf%cltype == 'monthly' ) THEN ; sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/)) … … 535 544 ztmp = ztmp + 0.5 * REAL(kn_fsbc - 1, wp) * rdttra(1) ! shift time to be centrered in the middle of sbc time step 536 545 ztmp = ztmp + 0.01 * rdttra(1) ! add 0.01 time step to avoid truncation error 546 IF( PRESENT(jit) ) ztmp = ztmp + jit*rdt/REAL(nn_baro,wp) 537 547 IF( sdjf%ln_tint ) THEN ! time interpolation, shift by 1/2 record 538 548 ! … … 687 697 !!---------------------------------------------------------------------- 688 698 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 689 USE wrk_nemo, ONLY: utmp => wrk_2d_ 4, vtmp => wrk_2d_5 ! 2D workspace699 USE wrk_nemo, ONLY: utmp => wrk_2d_24, vtmp => wrk_2d_25 ! 2D workspace 690 700 !! 691 701 INTEGER , INTENT(in ) :: kt ! ocean time step … … 699 709 !!--------------------------------------------------------------------- 700 710 701 IF(wrk_in_use(2, 4,5) ) THEN711 IF(wrk_in_use(2, 24,25) ) THEN 702 712 CALL ctl_stop('fld_rot: ERROR: requested workspace arrays are unavailable.') ; RETURN 703 713 END IF … … 736 746 END DO 737 747 ! 738 IF(wrk_not_released(2, 4,5) ) CALL ctl_stop('fld_rot: ERROR: failed to release workspace arrays.')748 IF(wrk_not_released(2, 24,25) ) CALL ctl_stop('fld_rot: ERROR: failed to release workspace arrays.') 739 749 ! 740 750 END SUBROUTINE fld_rot
Note: See TracChangeset
for help on using the changeset viewer.
