Changeset 2818


Ignore:
Timestamp:
2011-08-08T10:16:41+02:00 (9 years ago)
Author:
davestorkey
Message:

Bug fixes for the dynspg_ts case.

Location:
branches/2011/UKMO_MERCATOR_obc_bdy_merge/NEMOGCM/NEMO/OPA_SRC
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • branches/2011/UKMO_MERCATOR_obc_bdy_merge/NEMOGCM/NEMO/OPA_SRC/DYN/dynnxt.F90

    r2800 r2818  
    3030   USE domvvl          ! variable volume 
    3131   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 
    3334   USE obcvol          ! ocean open boundary condition (obc_vol routines) 
    3435   USE in_out_manager  ! I/O manager 
     
    154155      IF( .NOT. lk_dynspg_flt ) THEN 
    155156 
    156          CALL obc_dyn( kt ) 
     157         CALL obc_dyn3d( kt ) 
    157158 
    158159!!$!!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  
    206206               ! Update barotropic boundary conditions only 
    207207               ! 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 
    211217               ENDIF 
    212218               IF( nn_tides(ib_obc) .gt. 0 ) THEN 
     
    217223                  jend = jstart + nb_obc_fld(ib_obc) - 1 
    218224                  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 
    219230               ENDIF 
    220231               IF( nn_tides(ib_obc) .gt. 0 ) THEN 
  • branches/2011/UKMO_MERCATOR_obc_bdy_merge/NEMOGCM/NEMO/OPA_SRC/OBC/obcdyn2d.F90

    r2814 r2818  
    129129      TYPE(OBC_INDEX),              INTENT(in) ::   idx  ! OBC indices 
    130130      TYPE(OBC_DATA),               INTENT(in) ::   dta  ! OBC external data 
    131       REAL(wp), DIMENSION(jpi,jpj), INTENT(in) ::   pssh 
    132131 
    133132      INTEGER  ::   jb, igrd                         ! dummy loop indices 
  • branches/2011/UKMO_MERCATOR_obc_bdy_merge/NEMOGCM/NEMO/OPA_SRC/OBC/obcini.F90

    r2814 r2818  
    5151      !! ** Input   :  obc_init.nc, input file for unstructured open boundaries 
    5252      !!----------------------------------------------------------------------       
    53       INTEGER  ::   ib_obc, ii, ij, ik, igrd, ib, ir   ! dummy loop indices 
    54       INTEGER  ::   icount, icountr, ibr_max, ilen1    ! 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 
     53      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 
    6060      INTEGER, DIMENSION (2)                ::   kdimsz 
    6161      INTEGER, DIMENSION(jpbgrd,jp_obc)       ::   nblendta         ! Length of index arrays  
     
    302302            idx_obc(ib_obc)%nblenrim(igrd) = 0 
    303303            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 
    304312               ! check if point is in local domain 
    305313               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  
    131131      LOGICAL  ::   llnxtmth   ! open next month file? 
    132132      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 
    133134      REAL(wp) ::   ztinta     ! ratio applied to after  records when doing time interpolation 
    134135      REAL(wp) ::   ztintb     ! ratio applied to before records when doing time interpolation 
    135136      CHARACTER(LEN=1000) ::   clfmt   ! write format 
    136137      !!--------------------------------------------------------------------- 
     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 
    137145      ! Note that shifting time to be centrered in the middle of sbc time step impacts only nsec_* variables of the calendar  
    138146      IF( present(jit) ) THEN  
     
    146154      imf = SIZE( sd ) 
    147155      ! 
    148       IF( kt == nit000 ) THEN                      ! initialization 
     156      IF( ll_firstcall ) THEN                      ! initialization 
    149157         IF( PRESENT(map) ) THEN 
    150158            DO jf = 1, imf  
     
    165173         DO jf = 1, imf                            ! ---   loop over field   --- ! 
    166174             
    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? 
    168176 
    169177               IF( sd(jf)%ln_tint ) THEN                             ! swap before record field and informations 
     
    173181               ENDIF 
    174182 
    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 
    176188 
    177189               ! do we have to change the year/month/week/day of the forcing field??  
     
    256268               ! temporal interpolation weights 
    257269               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) ) THEN  
    259                   IF(lwp) WRITE(numout,*) '============================================' 
    260                   IF(lwp) WRITE(numout,*) 'Output from fld_read(map) on timestep ',kt 
    261                   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,ztintb 
    263                ENDIF 
    264270               ztintb =  1. - ztinta 
    265271!CDIR COLLAPSE 
     
    433439 
    434440 
    435    SUBROUTINE fld_rec( kn_fsbc, sdjf, ldbefore ) 
     441   SUBROUTINE fld_rec( kn_fsbc, sdjf, ldbefore, jit ) 
    436442      !!--------------------------------------------------------------------- 
    437443      !!                    ***  ROUTINE fld_rec  *** 
     
    447453      TYPE(FLD), INTENT(inout)           ::   sdjf      ! input field related variables 
    448454      LOGICAL  , INTENT(in   ), OPTIONAL ::   ldbefore  ! sent back before record values (default = .FALSE.) 
     455      INTEGER  , INTENT(in   ), OPTIONAL ::   jit       ! index of barotropic subcycle 
    449456                                                        ! used only if sdjf%ln_tint = .TRUE. 
    450457      !! 
     
    480487            !                             
    481488            ztmp = REAL( nday, wp ) / REAL( nyear_len(1), wp ) + 0.5 
     489            IF( PRESENT(jit) ) ztmp = ztmp + jit*rdt/REAL(nn_baro,wp) 
    482490            sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/)) 
    483491            ! swap at the middle of the year 
     
    508516            !                             
    509517            ztmp = REAL( nday, wp ) / REAL( nmonth_len(nmonth), wp ) + 0.5 
     518            IF( PRESENT(jit) ) ztmp = ztmp + jit*rdt/REAL(nn_baro,wp) 
    510519            imth = nmonth + INT( ztmp ) - COUNT((/llbefore/)) 
    511520            IF( sdjf%cltype == 'monthly' ) THEN   ;   sdjf%nrec_a(1) = 1 + INT( ztmp ) - COUNT((/llbefore/)) 
     
    535544         ztmp = ztmp + 0.5 * REAL(kn_fsbc - 1, wp) * rdttra(1)   ! shift time to be centrered in the middle of sbc time step 
    536545         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) 
    537547         IF( sdjf%ln_tint ) THEN                ! time interpolation, shift by 1/2 record 
    538548            ! 
     
    687697      !!---------------------------------------------------------------------- 
    688698      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    689       USE wrk_nemo, ONLY: utmp => wrk_2d_4, vtmp => wrk_2d_5      ! 2D workspace 
     699      USE wrk_nemo, ONLY: utmp => wrk_2d_24, vtmp => wrk_2d_25      ! 2D workspace 
    690700      !! 
    691701      INTEGER  , INTENT(in   )               ::   kt        ! ocean time step 
     
    699709      !!--------------------------------------------------------------------- 
    700710 
    701       IF(wrk_in_use(2, 4,5) ) THEN 
     711      IF(wrk_in_use(2, 24,25) ) THEN 
    702712         CALL ctl_stop('fld_rot: ERROR: requested workspace arrays are unavailable.')   ;   RETURN 
    703713      END IF 
     
    736746       END DO 
    737747      ! 
    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.') 
    739749      ! 
    740750   END SUBROUTINE fld_rot 
Note: See TracChangeset for help on using the changeset viewer.