New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 4254 – NEMO

Changeset 4254


Ignore:
Timestamp:
2013-11-19T15:37:49+01:00 (10 years ago)
Author:
acc
Message:

Branch 2013/dev_r3858_NOC_ZTC, #863. Merge in final changes from the dev_r3867_MERCATOR1_DYN branch; mainly AGRIF and BDY compatibility

Location:
branches/2013/dev_r3858_NOC_ZTC/NEMOGCM
Files:
26 edited

Legend:

Unmodified
Added
Removed

  • branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/CONFIG/AMM12/EXP00/namelist

    r3795 r4254  
    3535                           !    = 1 nn_date0 read in namelist ; nn_it000 : check consistancy between namelist and restart 
    3636                           !    = 2 nn_date0 read in restart  ; nn_it000 : check consistancy between namelist and restart 
    37    cn_ocerst_in  = "restart"   !  suffix of ocean restart name (input) 
     37   cn_ocerst_in  = "amm12_restart_oce"   !  suffix of ocean restart name (input) 
    3838   cn_ocerst_out = "restart"   !  suffix of ocean restart name (output) 
    3939   nn_istate   =       1   !  output the initial state (1) or not (0) 
    … …  
    446446    ln_mask_file = .false.                !  =T : read mask from file 
    447447    cn_mask_file = ''                     !  name of mask file (if ln_mask_file=.TRUE.) 
    448     nn_dyn2d      =  2                    !  boundary conditions for barotropic fields 
     448    cn_dyn2d      =  'flather'            !  boundary conditions for barotropic fields 
    449449    nn_dyn2d_dta  =  3                    !  = 0, bdy data are equal to the initial state 
    450450                                          !  = 1, bdy data are read in 'bdydata   .nc' files 
    451451                                          !  = 2, use tidal harmonic forcing data from files 
    452452                                          !  = 3, use external data AND tidal harmonic forcing 
    453     nn_dyn3d      =  0                    !  boundary conditions for baroclinic velocities 
     453    cn_dyn3d      =  'none'               !  boundary conditions for baroclinic velocities 
    454454    nn_dyn3d_dta  =  0                    !  = 0, bdy data are equal to the initial state 
    455                            !  = 1, bdy data are read in 'bdydata   .nc' files 
    456     nn_tra        =  1                    !  boundary conditions for T and S 
     455                                          !  = 1, bdy data are read in 'bdydata   .nc' files 
     456    cn_tra        =  'frs'                !  boundary conditions for T and S 
    457457    nn_tra_dta    =  1                    !  = 0, bdy data are equal to the initial state 
    458                            !  = 1, bdy data are read in 'bdydata   .nc' files 
    459     nn_rimwidth  = 10                      !  width of the relaxation zone 
     458                                          !  = 1, bdy data are read in 'bdydata   .nc' files 
     459    nn_rimwidth  = 10                     !  width of the relaxation zone 
    460460    ln_vol     = .false.                  !  total volume correction (see nn_volctl parameter) 
    461461    nn_volctl  = 1                        !  = 0, the total water flux across open boundaries is zero 

  • branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/CONFIG/GYRE/EXP00/namelist

    r3795 r4254  
    453453    ln_mask_file = .false.                !  =T : read mask from file 
    454454    cn_mask_file = ''                     !  name of mask file (if ln_mask_file=.TRUE.) 
    455     nn_dyn2d      =  2                    !  boundary conditions for barotropic fields 
     455    cn_dyn2d      =  'none'               !  boundary conditions for barotropic fields 
    456456    nn_dyn2d_dta  =  3                    !  = 0, bdy data are equal to the initial state 
    457457                                          !  = 1, bdy data are read in 'bdydata   .nc' files 
    458458                                          !  = 2, use tidal harmonic forcing data from files 
    459459                                          !  = 3, use external data AND tidal harmonic forcing 
    460     nn_dyn3d      =  0                    !  boundary conditions for baroclinic velocities 
     460    cn_dyn3d      =  'none'               !  boundary conditions for baroclinic velocities 
    461461    nn_dyn3d_dta  =  0                    !  = 0, bdy data are equal to the initial state 
    462                            !  = 1, bdy data are read in 'bdydata   .nc' files 
    463     nn_tra        =  1                    !  boundary conditions for T and S 
     462                                          !  = 1, bdy data are read in 'bdydata   .nc' files 
     463    cn_tra        =  'none'               !  boundary conditions for T and S 
    464464    nn_tra_dta    =  1                    !  = 0, bdy data are equal to the initial state 
    465                            !  = 1, bdy data are read in 'bdydata   .nc' files 
    466     nn_rimwidth  = 10                      !  width of the relaxation zone 
     465                                          !  = 1, bdy data are read in 'bdydata   .nc' files 
     466    nn_rimwidth  = 10                     !  width of the relaxation zone 
    467467    ln_vol     = .false.                  !  total volume correction (see nn_volctl parameter) 
    468468    nn_volctl  = 1                        !  = 0, the total water flux across open boundaries is zero 

  • branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/CONFIG/GYRE_BFM/EXP00/namelist

    r3815 r4254  
    453453    ln_mask_file = .false.                !  =T : read mask from file 
    454454    cn_mask_file = ''                     !  name of mask file (if ln_mask_file=.TRUE.) 
    455     nn_dyn2d      =  2                    !  boundary conditions for barotropic fields 
     455    cn_dyn2d      =  'none'               !  boundary conditions for barotropic fields 
    456456    nn_dyn2d_dta  =  3                    !  = 0, bdy data are equal to the initial state 
    457457                                          !  = 1, bdy data are read in 'bdydata   .nc' files 
    458458                                          !  = 2, use tidal harmonic forcing data from files 
    459459                                          !  = 3, use external data AND tidal harmonic forcing 
    460     nn_dyn3d      =  0                    !  boundary conditions for baroclinic velocities 
     460    cn_dyn3d      =  'none'               !  boundary conditions for baroclinic velocities 
    461461    nn_dyn3d_dta  =  0                    !  = 0, bdy data are equal to the initial state 
    462                            !  = 1, bdy data are read in 'bdydata   .nc' files 
    463     nn_tra        =  1                    !  boundary conditions for T and S 
     462                                          !  = 1, bdy data are read in 'bdydata   .nc' files 
     463    cn_tra        =  'none'               !  boundary conditions for T and S 
    464464    nn_tra_dta    =  1                    !  = 0, bdy data are equal to the initial state 
    465                            !  = 1, bdy data are read in 'bdydata   .nc' files 
    466     nn_rimwidth  = 10                      !  width of the relaxation zone 
     465                                          !  = 1, bdy data are read in 'bdydata   .nc' files 
     466    nn_rimwidth  = 10                     !  width of the relaxation zone 
    467467    ln_vol     = .false.                  !  total volume correction (see nn_volctl parameter) 
    468468    nn_volctl  = 1                        !  = 0, the total water flux across open boundaries is zero 

  • branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/CONFIG/ORCA2_LIM/EXP00/namelist

    r3890 r4254  
    306306 
    307307   cn_dir      = './'       !  root directory for the location of the bulk files 
    308    rn_pref     = 101000.e0 !  reference atmospheric pressure   [N/m2]/ 
     308   rn_pref     = 101000._wp !  reference atmospheric pressure   [N/m2]/ 
    309309   ln_ref_apr  = .false.    !  ref. pressure: global mean Patm (T) or a constant (F) 
    310310   ln_apr_obc  = .false.    !  inverse barometer added to OBC ssh data 
    … …  
    448448    ln_mask_file = .false.                !  =T : read mask from file 
    449449    cn_mask_file = ''                     !  name of mask file (if ln_mask_file=.TRUE.) 
    450     nn_dyn2d      =  2                    !  boundary conditions for barotropic fields 
     450    cn_dyn2d      =  'none'               !  boundary conditions for barotropic fields 
    451451    nn_dyn2d_dta  =  3                    !  = 0, bdy data are equal to the initial state 
    452452                                          !  = 1, bdy data are read in 'bdydata   .nc' files 
    453453                                          !  = 2, use tidal harmonic forcing data from files 
    454454                                          !  = 3, use external data AND tidal harmonic forcing 
    455     nn_dyn3d      =  0                    !  boundary conditions for baroclinic velocities 
     455    cn_dyn3d      =  'none'               !  boundary conditions for baroclinic velocities 
    456456    nn_dyn3d_dta  =  0                    !  = 0, bdy data are equal to the initial state 
    457                            !  = 1, bdy data are read in 'bdydata   .nc' files 
    458     nn_tra        =  1                    !  boundary conditions for T and S 
     457                                          !  = 1, bdy data are read in 'bdydata   .nc' files 
     458    cn_tra        =  'none'               !  boundary conditions for T and S 
    459459    nn_tra_dta    =  1                    !  = 0, bdy data are equal to the initial state 
    460                            !  = 1, bdy data are read in 'bdydata   .nc' files 
    461     nn_rimwidth  = 10                      !  width of the relaxation zone 
     460                                          !  = 1, bdy data are read in 'bdydata   .nc' files 
     461    nn_rimwidth  = 10                     !  width of the relaxation zone 
    462462    ln_vol     = .false.                  !  total volume correction (see nn_volctl parameter) 
    463463    nn_volctl  = 1                        !  = 0, the total water flux across open boundaries is zero 

  • branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/CONFIG/ORCA2_LIM_CFC_C14b/EXP00/namelist

    r3795 r4254  
    318318   rn_alphdi   =    0.72   !  (Pyane, 1972) 
    319319/ 
    320  
     320!----------------------------------------------------------------------- 
     321&namberg       !   iceberg parameters 
     322!----------------------------------------------------------------------- 
     323      ln_icebergs              = .false. 
     324      ln_bergdia               = .true.               ! Calculate budgets 
     325      nn_verbose_level         = 1                    ! Turn on more verbose output if level > 0 
     326      nn_verbose_write         = 15                   ! Timesteps between verbose messages 
     327      nn_sample_rate           = 1                    ! Timesteps between sampling for trajectory storage 
     328                                                      ! Initial mass required for an iceberg of each class 
     329      rn_initial_mass          = 8.8e7, 4.1e8, 3.3e9, 1.8e10, 3.8e10, 7.5e10, 1.2e11, 2.2e11, 3.9e11, 7.4e11 
     330                                                      ! Proportion of calving mass to apportion to each class   
     331      rn_distribution          = 0.24, 0.12, 0.15, 0.18, 0.12, 0.07, 0.03, 0.03, 0.03, 0.02 
     332                                                      ! Ratio between effective and real iceberg mass (non-dim) 
     333                                                      ! i.e. number of icebergs represented at a point          
     334      rn_mass_scaling          = 2000, 200, 50, 20, 10, 5, 2, 1, 1, 1 
     335                                                      ! thickness of newly calved bergs (m) 
     336      rn_initial_thickness     = 40., 67., 133., 175., 250., 250., 250., 250., 250., 250. 
     337      rn_rho_bergs             = 850.                 ! Density of icebergs 
     338      rn_LoW_ratio             = 1.5                  ! Initial ratio L/W for newly calved icebergs 
     339      ln_operator_splitting    = .true.               ! Use first order operator splitting for thermodynamics 
     340      rn_bits_erosion_fraction = 0.                   ! Fraction of erosion melt flux to divert to bergy bits 
     341      rn_sicn_shift            = 0.                   ! Shift of sea-ice concn in erosion flux (0<sicn_shift<1) 
     342      ln_passive_mode          = .false.              ! iceberg - ocean decoupling    
     343      nn_test_icebergs         =  10                  ! Create test icebergs of this class (-1 = no) 
     344                                                      ! Put a test iceberg at each gridpoint in box (lon1,lon2,lat1,lat2) 
     345      rn_test_box              = 108.0,  116.0, -66.0, -58.0 
     346      rn_speed_limit           = 0.                   ! CFL speed limit for a berg    
     347 
     348               ! filename ! freq (hours) ! variable ! time interp. ! clim  !'yearly' or ! weights  ! rotation ! 
     349               !          ! (<0  months) !   name   !  (logical)   ! (T/F) ! 'monthly'  ! filename ! pairing  ! 
     350      sn_icb =  'calving' ,     -1       , 'calvingmask',  .true.      , .true., 'yearly'   , ' '      , ' ' 
     351    
     352      cn_dir = './'  
     353/ 
    321354!!====================================================================== 
    322355!!               ***  Lateral boundary condition  *** 
    … …  
    396429    ln_mask_file = .false.                !  =T : read mask from file 
    397430    cn_mask_file = ''                     !  name of mask file (if ln_mask_file=.TRUE.) 
    398     nn_dyn2d      =  2                    !  boundary conditions for barotropic fields 
     431    cn_dyn2d      =  'none'               !  boundary conditions for barotropic fields 
    399432    nn_dyn2d_dta  =  3                    !  = 0, bdy data are equal to the initial state 
    400433                                          !  = 1, bdy data are read in 'bdydata   .nc' files 
    401434                                          !  = 2, use tidal harmonic forcing data from files 
    402435                                          !  = 3, use external data AND tidal harmonic forcing 
    403     nn_dyn3d      =  0                    !  boundary conditions for baroclinic velocities 
     436    cn_dyn3d      =  'none'               !  boundary conditions for baroclinic velocities 
    404437    nn_dyn3d_dta  =  0                    !  = 0, bdy data are equal to the initial state 
    405                            !  = 1, bdy data are read in 'bdydata   .nc' files 
    406     nn_tra        =  1                    !  boundary conditions for T and S 
     438                                          !  = 1, bdy data are read in 'bdydata   .nc' files 
     439    cn_tra        =  'none'               !  boundary conditions for T and S 
    407440    nn_tra_dta    =  1                    !  = 0, bdy data are equal to the initial state 
    408                            !  = 1, bdy data are read in 'bdydata   .nc' files 
    409     nn_rimwidth  = 10                      !  width of the relaxation zone 
     441                                          !  = 1, bdy data are read in 'bdydata   .nc' files 
     442    nn_rimwidth  = 10                     !  width of the relaxation zone 
    410443    ln_vol     = .false.                  !  total volume correction (see nn_volctl parameter) 
    411444    nn_volctl  = 1                        !  = 0, the total water flux across open boundaries is zero 

  • branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/CONFIG/ORCA2_OFF_PISCES/EXP00/namelist

    r3795 r4254  
    429429    ln_mask_file = .false.                !  =T : read mask from file 
    430430    cn_mask_file = ''                     !  name of mask file (if ln_mask_file=.TRUE.) 
    431     nn_dyn2d      =  2                    !  boundary conditions for barotropic fields 
     431    cn_dyn2d      =  'none'               !  boundary conditions for barotropic fields 
    432432    nn_dyn2d_dta  =  3                    !  = 0, bdy data are equal to the initial state 
    433433                                          !  = 1, bdy data are read in 'bdydata   .nc' files 
    434434                                          !  = 2, use tidal harmonic forcing data from files 
    435435                                          !  = 3, use external data AND tidal harmonic forcing 
    436     nn_dyn3d      =  0                    !  boundary conditions for baroclinic velocities 
     436    cn_dyn3d      =  'none'               !  boundary conditions for baroclinic velocities 
    437437    nn_dyn3d_dta  =  0                    !  = 0, bdy data are equal to the initial state 
    438                            !  = 1, bdy data are read in 'bdydata   .nc' files 
    439     nn_tra        =  1                    !  boundary conditions for T and S 
     438                                          !  = 1, bdy data are read in 'bdydata   .nc' files 
     439    cn_tra        =  'none'               !  boundary conditions for T and S 
    440440    nn_tra_dta    =  1                    !  = 0, bdy data are equal to the initial state 
    441                            !  = 1, bdy data are read in 'bdydata   .nc' files 
    442     nn_rimwidth  = 10                      !  width of the relaxation zone 
     441                                          !  = 1, bdy data are read in 'bdydata   .nc' files 
     442    nn_rimwidth  = 10                     !  width of the relaxation zone 
    443443    ln_vol     = .false.                  !  total volume correction (see nn_volctl parameter) 
    444444    nn_volctl  = 1                        !  = 0, the total water flux across open boundaries is zero 

  • branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/CONFIG/ORCA2_SAS_LIM/EXP00/namelist

    r3795 r4254  
    445445    ln_mask_file = .false.                !  =T : read mask from file 
    446446    cn_mask_file = ''                     !  name of mask file (if ln_mask_file=.TRUE.) 
    447     nn_dyn2d      =  2                    !  boundary conditions for barotropic fields 
     447    cn_dyn2d      =  'none'               !  boundary conditions for barotropic fields 
    448448    nn_dyn2d_dta  =  3                    !  = 0, bdy data are equal to the initial state 
    449449                                          !  = 1, bdy data are read in 'bdydata   .nc' files 
    450450                                          !  = 2, use tidal harmonic forcing data from files 
    451451                                          !  = 3, use external data AND tidal harmonic forcing 
    452     nn_dyn3d      =  0                    !  boundary conditions for baroclinic velocities 
     452    cn_dyn3d      =  'none'               !  boundary conditions for baroclinic velocities 
    453453    nn_dyn3d_dta  =  0                    !  = 0, bdy data are equal to the initial state 
    454                            !  = 1, bdy data are read in 'bdydata   .nc' files 
    455     nn_tra        =  1                    !  boundary conditions for T and S 
     454                                          !  = 1, bdy data are read in 'bdydata   .nc' files 
     455    cn_tra        =  'none'               !  boundary conditions for T and S 
    456456    nn_tra_dta    =  1                    !  = 0, bdy data are equal to the initial state 
    457                            !  = 1, bdy data are read in 'bdydata   .nc' files 
    458     nn_rimwidth  = 10                      !  width of the relaxation zone 
     457                                          !  = 1, bdy data are read in 'bdydata   .nc' files 
     458    nn_rimwidth  = 10                     !  width of the relaxation zone 
    459459    ln_vol     = .false.                  !  total volume correction (see nn_volctl parameter) 
    460460    nn_volctl  = 1                        !  = 0, the total water flux across open boundaries is zero 

  • branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/NST_SRC/agrif_oce.F90

    r3680 r4254  
    4040   INTEGER :: e1u_id, e2v_id, sshn_id, gcb_id 
    4141   INTEGER :: trn_id, trb_id, tra_id 
     42   INTEGER :: unb_id, vnb_id 
    4243 
    4344   !!---------------------------------------------------------------------- 

  • branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90

    r3294 r4254  
    2727   USE agrif_opa_sponge 
    2828   USE lib_mpp 
    29    USE wrk_nemo   
     29   USE wrk_nemo 
     30   USE dynspg_oce   
    3031 
    3132   IMPLICIT NONE 
    3233   PRIVATE 
     34 
     35   ! Barotropic arrays used to store open boundary data during 
     36   ! time-splitting loop: 
     37   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_w, vbdy_w, hbdy_w 
     38   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_e, vbdy_e, hbdy_e 
     39   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_n, vbdy_n, hbdy_n 
     40   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  ubdy_s, vbdy_s, hbdy_s 
    3341     
    34    PUBLIC   Agrif_tra, Agrif_dyn, Agrif_ssh, interpu, interpv 
     42   PUBLIC   Agrif_tra, Agrif_dyn, Agrif_ssh, Agrif_dyn_ts, Agrif_ssh_ts 
     43   PUBLIC   interpu, interpv, interpunb, interpvnb, interpsshn 
    3544 
    3645#  include "domzgr_substitute.h90"   
    … …  
    169178      REAL(wp) :: timeref 
    170179      REAL(wp) :: z2dt, znugdt 
    171       REAL(wp) :: zrhox, rhoy 
     180      REAL(wp) :: zrhox, zrhoy 
    172181      REAL(wp), POINTER, DIMENSION(:,:,:) :: zua, zva 
    173182      REAL(wp), POINTER, DIMENSION(:,:) :: spgv1, spgu1, zua2d, zva2d 
    … …  
    180189 
    181190      zrhox = Agrif_Rhox() 
    182       rhoy = Agrif_Rhoy() 
     191      zrhoy = Agrif_Rhoy() 
    183192 
    184193      timeref = 1. 
    … …  
    201210      zva2d = 0. 
    202211 
     212#if defined key_dynspg_flt 
    203213      Agrif_SpecialValue=0. 
    204214      Agrif_UseSpecialValue = ln_spc_dyn 
    205215      CALL Agrif_Bc_variable(zua2d,e1u_id,calledweight=1.,procname=interpu2d) 
    206216      CALL Agrif_Bc_variable(zva2d,e2v_id,calledweight=1.,procname=interpv2d) 
     217#endif 
    207218      Agrif_UseSpecialValue = .FALSE. 
    208219 
    … …  
    210221      IF((nbondi == -1).OR.(nbondi == 2)) THEN 
    211222 
     223#if defined key_dynspg_flt 
    212224         DO jj=1,jpj 
    213             laplacu(2,jj) = timeref * (zua2d(2,jj)/(rhoy*e2u(2,jj)))*umask(2,jj,1) 
    214          END DO 
    215  
    216          DO jk=1,jpkm1 
    217             DO jj=1,jpj 
    218                ua(1:2,jj,jk) = (zua(1:2,jj,jk)/(rhoy*e2u(1:2,jj))) 
     225            laplacu(2,jj) = timeref * (zua2d(2,jj)/(zrhoy*e2u(2,jj)))*umask(2,jj,1) 
     226         END DO 
     227#endif 
     228 
     229         DO jk=1,jpkm1 
     230            DO jj=1,jpj 
     231               ua(1:2,jj,jk) = (zua(1:2,jj,jk)/(zrhoy*e2u(1:2,jj))) 
    219232               ua(1:2,jj,jk) = ua(1:2,jj,jk) / fse3u(1:2,jj,jk) 
    220233            END DO 
    221234         END DO 
    222235 
     236#if defined key_dynspg_flt 
    223237         DO jk=1,jpkm1 
    224238            DO jj=1,jpj 
    … …  
    240254            ENDIF 
    241255         END DO 
     256#else 
     257         spgu(2,:) = ua_b(2,:) 
     258#endif 
    242259 
    243260         DO jk=1,jpkm1 
    … …  
    278295 
    279296      IF((nbondi == 1).OR.(nbondi == 2)) THEN 
    280  
     297#if defined key_dynspg_flt 
    281298         DO jj=1,jpj 
    282             laplacu(nlci-2,jj) = timeref * (zua2d(nlci-2,jj)/(rhoy*e2u(nlci-2,jj))) 
    283          END DO 
    284  
    285          DO jk=1,jpkm1 
    286             DO jj=1,jpj 
    287                ua(nlci-2:nlci-1,jj,jk) = (zua(nlci-2:nlci-1,jj,jk)/(rhoy*e2u(nlci-2:nlci-1,jj))) 
     299            laplacu(nlci-2,jj) = timeref * (zua2d(nlci-2,jj)/(zrhoy*e2u(nlci-2,jj))) 
     300         END DO 
     301#endif 
     302 
     303         DO jk=1,jpkm1 
     304            DO jj=1,jpj 
     305               ua(nlci-2:nlci-1,jj,jk) = (zua(nlci-2:nlci-1,jj,jk)/(zrhoy*e2u(nlci-2:nlci-1,jj))) 
    288306 
    289307               ua(nlci-2:nlci-1,jj,jk) = ua(nlci-2:nlci-1,jj,jk) / fse3u(nlci-2:nlci-1,jj,jk) 
    … …  
    292310         END DO 
    293311 
     312#if defined key_dynspg_flt 
    294313         DO jk=1,jpkm1 
    295314            DO jj=1,jpj 
    … …  
    312331            ENDIF 
    313332         END DO 
     333#else 
     334         spgu(nlci-2,:) = ua_b(nlci-2,:) 
     335#endif 
    314336 
    315337         DO jk=1,jpkm1 
    … …  
    353375      IF((nbondj == -1).OR.(nbondj == 2)) THEN 
    354376 
     377#if defined key_dynspg_flt 
    355378         DO ji=1,jpi 
    356379            laplacv(ji,2) = timeref * (zva2d(ji,2)/(zrhox*e1v(ji,2))) 
    357380         END DO 
     381#endif 
    358382 
    359383         DO jk=1,jpkm1 
    … …  
    364388         END DO 
    365389 
     390#if defined key_dynspg_flt 
    366391         DO jk=1,jpkm1 
    367392            DO ji=1,jpi 
    … …  
    383408            ENDIF 
    384409         END DO 
     410#else 
     411         spgv(:,2)=va_b(:,2) 
     412#endif 
    385413 
    386414         DO jk=1,jpkm1 
    … …  
    413441         DO jk=1,jpkm1 
    414442            DO ji=1,jpi 
    415                ua(ji,2,jk) = (zua(ji,2,jk)/(rhoy*e2u(ji,2)))*umask(ji,2,jk)  
     443               ua(ji,2,jk) = (zua(ji,2,jk)/(zrhoy*e2u(ji,2)))*umask(ji,2,jk)  
    416444               ua(ji,2,jk) = ua(ji,2,jk) / fse3u(ji,2,jk) 
    417445            END DO 
    … …  
    422450      IF((nbondj == 1).OR.(nbondj == 2)) THEN 
    423451 
     452#if defined key_dynspg_flt 
    424453         DO ji=1,jpi 
    425454            laplacv(ji,nlcj-2) = timeref * (zva2d(ji,nlcj-2)/(zrhox*e1v(ji,nlcj-2))) 
    426455         END DO 
     456#endif 
    427457 
    428458         DO jk=1,jpkm1 
    … …  
    433463         END DO 
    434464 
     465#if defined key_dynspg_flt 
    435466         DO jk=1,jpkm1 
    436467            DO ji=1,jpi 
    … …  
    438469            END DO 
    439470         END DO 
    440  
    441471 
    442472         spgv(:,nlcj-2)=0. 
    … …  
    453483            ENDIF 
    454484         END DO 
     485#else 
     486         spgv(:,nlcj-2)=va_b(:,nlcj-2) 
     487#endif 
    455488 
    456489         DO jk=1,jpkm1 
    … …  
    483516         DO jk=1,jpkm1 
    484517            DO ji=1,jpi 
    485                ua(ji,nlcj-1,jk) = (zua(ji,nlcj-1,jk)/(rhoy*e2u(ji,nlcj-1)))*umask(ji,nlcj-1,jk) 
     518               ua(ji,nlcj-1,jk) = (zua(ji,nlcj-1,jk)/(zrhoy*e2u(ji,nlcj-1)))*umask(ji,nlcj-1,jk) 
    486519               ua(ji,nlcj-1,jk) = ua(ji,nlcj-1,jk) / fse3u(ji,nlcj-1,jk) 
    487520            END DO 
    … …  
    495528   END SUBROUTINE Agrif_dyn 
    496529 
     530   SUBROUTINE Agrif_dyn_ts( kt, jn ) 
     531      !!---------------------------------------------------------------------- 
     532      !!                  ***  ROUTINE Agrif_dyn_ts  *** 
     533      !!----------------------------------------------------------------------   
     534      !!  
     535      INTEGER, INTENT(in) ::   kt, jn 
     536      !! 
     537      INTEGER :: ji, jj 
     538      REAL(wp) :: zrhox, zrhoy 
     539      REAL(wp), POINTER, DIMENSION(:,:) :: spgv1, spgu1 
     540      REAL(wp), POINTER, DIMENSION(:,:) :: zunb, zvnb, zsshn 
     541      !!----------------------------------------------------------------------   
     542 
     543      IF( Agrif_Root() )   RETURN 
     544 
     545      IF ((kt==nit000).AND.(jn==1)) THEN 
     546         ALLOCATE( ubdy_w(jpj), vbdy_w(jpj), hbdy_w(jpj)) 
     547         ALLOCATE( ubdy_e(jpj), vbdy_e(jpj), hbdy_e(jpj)) 
     548         ALLOCATE( ubdy_n(jpi), vbdy_n(jpi), hbdy_n(jpi)) 
     549         ALLOCATE( ubdy_s(jpi), vbdy_s(jpi), hbdy_s(jpi)) 
     550      ENDIF 
     551 
     552      IF (jn==1) THEN  
     553         ! Fill boundary arrays at each baroclinic step  
     554         ! with Parent grid barotropic fluxes and sea level 
     555         ! 
     556         CALL wrk_alloc( jpi, jpj, zunb, zvnb, zsshn ) 
     557 
     558         zrhox = Agrif_Rhox() 
     559         zrhoy = Agrif_Rhoy() 
     560 
     561!alt         Agrif_SpecialValue    = 0.e0 
     562!alt         Agrif_UseSpecialValue = .TRUE. 
     563!alt         CALL Agrif_Bc_variable(zsshn, sshn_id, procname=interpsshn ) 
     564!alt         Agrif_UseSpecialValue = .FALSE. 
     565 
     566         Agrif_SpecialValue=0. 
     567         Agrif_UseSpecialValue = ln_spc_dyn 
     568         zunb(:,:) = 0._wp ; zvnb(:,:) = 0._wp 
     569         CALL Agrif_Bc_variable(zunb,unb_id,procname=interpunb) 
     570         CALL Agrif_Bc_variable(zvnb,vnb_id,procname=interpvnb) 
     571         Agrif_UseSpecialValue = .FALSE. 
     572 
     573         IF((nbondi == -1).OR.(nbondi == 2)) THEN 
     574            DO jj=1,jpj 
     575               ubdy_w(jj) = (zunb(2,jj)/(zrhoy*e2u(2,jj))) 
     576               vbdy_w(jj) = (zvnb(2,jj)/(zrhox*e1v(2,jj))) 
     577               hbdy_w(jj) = zsshn(2,jj) 
     578            END DO 
     579         ENDIF 
     580 
     581         IF((nbondi == 1).OR.(nbondi == 2)) THEN 
     582            DO jj=1,jpj 
     583               ubdy_e(jj) = zunb(nlci-2,jj)/(zrhoy*e2u(nlci-2,jj)) 
     584               vbdy_e(jj) = zvnb(nlci-1,jj)/(zrhox*e1v(nlci-1,jj)) 
     585               hbdy_e(jj) = zsshn(nlci-1,jj) 
     586            END DO 
     587         ENDIF 
     588 
     589         IF((nbondj == -1).OR.(nbondj == 2)) THEN 
     590            DO ji=1,jpi 
     591               ubdy_s(ji) = zunb(ji,2)/(zrhoy*e2u(ji,2)) 
     592               vbdy_s(ji) = zvnb(ji,2)/(zrhox*e1v(ji,2)) 
     593               hbdy_s(ji) = zsshn(ji,2) 
     594            END DO 
     595         ENDIF 
     596 
     597         IF((nbondj == 1).OR.(nbondj == 2)) THEN 
     598            DO ji=1,jpi 
     599               ubdy_n(ji) = zunb(ji,nlcj-1)/(zrhoy*e2u(ji,nlcj-1)) 
     600               vbdy_n(ji) = zvnb(ji,nlcj-2)/(zrhox*e1v(ji,nlcj-2)) 
     601               hbdy_n(ji) = zsshn(ji,nlcj-1) 
     602            END DO 
     603         ENDIF 
     604 
     605         CALL wrk_dealloc( jpi, jpj, zunb, zvnb, zsshn ) 
     606      ENDIF ! jn==1 
     607 
     608      ! Then update velocities at each barotropic time step 
     609      IF((nbondi == -1).OR.(nbondi == 2)) THEN 
     610         DO jj=1,jpj 
     611            va_e(2,jj) = vbdy_w(jj) * hvr_e(2,jj) 
     612! Specified fluxes: 
     613            ua_e(2,jj) = ubdy_w(jj) * hur_e(2,jj) 
     614! Characteristics method: 
     615!alt            ua_e(2,jj) = 0.5_wp * ( ubdy_w(jj) * hur_e(2,jj) + ua_e(3,jj) & 
     616!alt                       &           - sqrt(grav * hur_e(2,jj)) * (sshn_e(3,jj) - hbdy_w(jj)) ) 
     617         END DO 
     618      ENDIF 
     619 
     620      IF((nbondi == 1).OR.(nbondi == 2)) THEN 
     621         DO jj=1,jpj 
     622            va_e(nlci-1,jj) = vbdy_e(jj) * hvr_e(nlci-1,jj) 
     623! Specified fluxes: 
     624            ua_e(nlci-2,jj) = ubdy_e(jj) * hur_e(nlci-2,jj) 
     625! Characteristics method: 
     626!alt            ua_e(nlci-2,jj) = 0.5_wp * ( ubdy_e(jj) * hur_e(nlci-2,jj) + ua_e(nlci-3,jj) & 
     627!alt                            &           + sqrt(grav * hur_e(nlci-2,jj)) * (sshn_e(nlci-2,jj) - hbdy_e(jj)) ) 
     628         END DO 
     629      ENDIF 
     630 
     631      IF((nbondj == -1).OR.(nbondj == 2)) THEN 
     632         DO ji=1,jpi 
     633            ua_e(ji,2) = ubdy_s(ji) * hur_e(ji,2) 
     634! Specified fluxes: 
     635            va_e(ji,2) = vbdy_s(ji) * hvr_e(ji,2) 
     636! Characteristics method: 
     637!alt            va_e(ji,2) = 0.5_wp * ( vbdy_s(ji) * hvr_e(ji,2) + va_e(ji,3) & 
     638!alt                       &           - sqrt(grav * hvr_e(ji,2)) * (sshn_e(ji,3) - hbdy_s(ji)) ) 
     639         END DO 
     640      ENDIF 
     641 
     642      IF((nbondj == 1).OR.(nbondj == 2)) THEN 
     643         DO ji=1,jpi 
     644            ua_e(ji,nlcj-1) = ubdy_n(ji) * hur_e(ji,nlcj-1) 
     645! Specified fluxes: 
     646            va_e(ji,nlcj-2) = vbdy_n(ji) * hvr_e(ji,nlcj-2) 
     647! Characteristics method: 
     648!alt            va_e(ji,nlcj-2) = 0.5_wp * ( vbdy_n(ji) * hvr_e(ji,nlcj-2)  + va_e(ji,nlcj-3) & 
     649!alt                            &           + sqrt(grav * hvr_e(ji,nlcj-2)) * (sshn_e(ji,nlcj-2) - hbdy_n(ji)) ) 
     650         END DO 
     651      ENDIF 
     652      ! 
     653   END SUBROUTINE Agrif_dyn_ts 
    497654 
    498655   SUBROUTINE Agrif_ssh( kt ) 
    … …  
    518675 
    519676      IF((nbondj == -1).OR.(nbondj == 2)) THEN 
    520          ssha(:,2)=sshn(:,3) 
    521          sshn(:,2)=sshb(:,3) 
     677         ssha(:,2)=ssha(:,3) 
     678         sshn(:,2)=sshn(:,3) 
    522679      ENDIF 
    523680 
    524681      IF((nbondj == 1).OR.(nbondj == 2)) THEN 
    525682         ssha(:,nlcj-1)=ssha(:,nlcj-2) 
    526          ssha(:,nlcj-1)=sshn(:,nlcj-2)                 
     683         sshn(:,nlcj-1)=sshn(:,nlcj-2)                 
    527684      ENDIF 
    528685 
    529686   END SUBROUTINE Agrif_ssh 
    530687 
     688   SUBROUTINE Agrif_ssh_ts( kt ) 
     689      !!---------------------------------------------------------------------- 
     690      !!                  ***  ROUTINE Agrif_ssh_ts  *** 
     691      !!----------------------------------------------------------------------   
     692      INTEGER, INTENT(in) ::   kt 
     693      !! 
     694      !!----------------------------------------------------------------------   
     695 
     696      IF((nbondi == -1).OR.(nbondi == 2)) THEN 
     697         ssha_e(2,:) = ssha_e(3,:) 
     698      ENDIF 
     699 
     700      IF((nbondi == 1).OR.(nbondi == 2)) THEN 
     701         ssha_e(nlci-1,:) = ssha_e(nlci-2,:)     
     702      ENDIF 
     703 
     704      IF((nbondj == -1).OR.(nbondj == 2)) THEN 
     705         ssha_e(:,2) = ssha_e(:,3) 
     706      ENDIF 
     707 
     708      IF((nbondj == 1).OR.(nbondj == 2)) THEN 
     709         ssha_e(:,nlcj-1) = ssha_e(:,nlcj-2)             
     710      ENDIF 
     711 
     712   END SUBROUTINE Agrif_ssh_ts 
     713 
     714   SUBROUTINE interpsshn(tabres,i1,i2,j1,j2) 
     715      !!---------------------------------------------------------------------- 
     716      !!                  ***  ROUTINE interpsshn  *** 
     717      !!----------------------------------------------------------------------   
     718      INTEGER, INTENT(in) :: i1,i2,j1,j2 
     719      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
     720      !! 
     721      INTEGER :: ji,jj 
     722      !!----------------------------------------------------------------------   
     723 
     724      tabres(i1:i2,j1:j2) = sshn(i1:i2,j1:j2) 
     725 
     726   END SUBROUTINE interpsshn 
    531727 
    532728   SUBROUTINE interpu(tabres,i1,i2,j1,j2,k1,k2) 
    … …  
    611807 
    612808   END SUBROUTINE interpv2d 
     809 
     810   SUBROUTINE interpunb(tabres,i1,i2,j1,j2) 
     811      !!---------------------------------------------------------------------- 
     812      !!                  ***  ROUTINE interpunb  *** 
     813      !!----------------------------------------------------------------------   
     814      INTEGER, INTENT(in) :: i1,i2,j1,j2 
     815      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
     816      !! 
     817      INTEGER :: ji,jj,jk 
     818      !!----------------------------------------------------------------------   
     819 
     820      tabres(:,:) = 0.e0 
     821      DO jk=1,jpkm1 
     822         DO jj=j1,j2 
     823            DO ji=i1,i2 
     824               tabres(ji,jj) = tabres(ji,jj) + e2u(ji,jj) * un(ji,jj,jk) & 
     825                  * umask(ji,jj,jk) * fse3u(ji,jj,jk) 
     826            END DO 
     827         END DO 
     828      END DO 
     829 
     830   END SUBROUTINE interpunb 
     831 
     832   SUBROUTINE interpvnb(tabres,i1,i2,j1,j2) 
     833      !!---------------------------------------------------------------------- 
     834      !!                  ***  ROUTINE interpvnb  *** 
     835      !!----------------------------------------------------------------------   
     836      INTEGER, INTENT(in) :: i1,i2,j1,j2 
     837      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: tabres 
     838      !! 
     839      INTEGER :: ji,jj,jk 
     840      !!----------------------------------------------------------------------   
     841 
     842      tabres(:,:) = 0.e0 
     843      DO jk=1,jpkm1 
     844         DO jj=j1,j2 
     845            DO ji=i1,i2 
     846               tabres(ji,jj) = tabres(ji,jj) + e1v(ji,jj) * vn(ji,jj,jk) & 
     847                  * vmask(ji,jj,jk) * fse3v(ji,jj,jk) 
     848            END DO 
     849         END DO 
     850      END DO 
     851 
     852   END SUBROUTINE interpvnb 
    613853 
    614854#else 

  • branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90

    r3651 r4254  
    2929      REAL   , POINTER, DIMENSION(:,:)   ::  nbw 
    3030      REAL   , POINTER, DIMENSION(:,:)   ::  nbd 
    31       REAL   , POINTER, DIMENSION(:)     ::  flagu 
    32       REAL   , POINTER, DIMENSION(:)     ::  flagv 
     31      REAL   , POINTER, DIMENSION(:,:)   ::  nbdout 
     32      REAL   , POINTER, DIMENSION(:,:)   ::  flagu 
     33      REAL   , POINTER, DIMENSION(:,:)   ::  flagv 
    3334   END TYPE OBC_INDEX 
    3435 
     36   !! Logicals in OBC_DATA structure are true if the chosen algorithm requires this 
     37   !! field as external data. If true the data can come from external files 
     38   !! or model initial conditions. If false then no "external" data array 
     39   !! is required for this field.  
     40 
    3541   TYPE, PUBLIC ::   OBC_DATA     !: Storage for external data 
     42      INTEGER,       DIMENSION(2)     ::  nread 
     43      LOGICAL                         ::  ll_ssh 
     44      LOGICAL                         ::  ll_u2d 
     45      LOGICAL                         ::  ll_v2d 
     46      LOGICAL                         ::  ll_u3d 
     47      LOGICAL                         ::  ll_v3d 
     48      LOGICAL                         ::  ll_tem 
     49      LOGICAL                         ::  ll_sal 
    3650      REAL, POINTER, DIMENSION(:)     ::  ssh 
    3751      REAL, POINTER, DIMENSION(:)     ::  u2d 
    … …  
    4256      REAL, POINTER, DIMENSION(:,:)   ::  sal 
    4357#if defined key_lim2 
     58      LOGICAL                         ::  ll_frld 
     59      LOGICAL                         ::  ll_hicif 
     60      LOGICAL                         ::  ll_hsnif 
    4461      REAL, POINTER, DIMENSION(:)     ::  frld 
    4562      REAL, POINTER, DIMENSION(:)     ::  hicif 
    … …  
    6380   INTEGER                    ::   nn_volctl                !: = 0 the total volume will have the variability of the surface Flux E-P  
    6481   !                                                        !  = 1 the volume will be constant during all the integration. 
    65    INTEGER, DIMENSION(jp_bdy) ::   nn_dyn2d                 ! Choice of boundary condition for barotropic variables (U,V,SSH) 
    66    INTEGER, DIMENSION(jp_bdy) ::   nn_dyn2d_dta           !: = 0 use the initial state as bdy dta ;  
     82   CHARACTER(len=20), DIMENSION(jp_bdy) ::   cn_dyn2d       ! Choice of boundary condition for barotropic variables (U,V,SSH) 
     83   INTEGER, DIMENSION(jp_bdy)           ::   nn_dyn2d_dta   !: = 0 use the initial state as bdy dta ;  
    6784                                                            !: = 1 read it in a NetCDF file 
    6885                                                            !: = 2 read tidal harmonic forcing from a NetCDF file 
    6986                                                            !: = 3 read external data AND tidal harmonic forcing from NetCDF files 
    70    INTEGER, DIMENSION(jp_bdy) ::   nn_dyn3d                 ! Choice of boundary condition for baroclinic velocities  
    71    INTEGER, DIMENSION(jp_bdy) ::   nn_dyn3d_dta           !: = 0 use the initial state as bdy dta ;  
     87   CHARACTER(len=20), DIMENSION(jp_bdy) ::   cn_dyn3d       ! Choice of boundary condition for baroclinic velocities  
     88   INTEGER, DIMENSION(jp_bdy)           ::   nn_dyn3d_dta   !: = 0 use the initial state as bdy dta ;  
    7289                                                            !: = 1 read it in a NetCDF file 
    73    INTEGER, DIMENSION(jp_bdy) ::   nn_tra                   ! Choice of boundary condition for active tracers (T and S) 
    74    INTEGER, DIMENSION(jp_bdy) ::   nn_tra_dta             !: = 0 use the initial state as bdy dta ;  
     90   CHARACTER(len=20), DIMENSION(jp_bdy) ::   cn_tra         ! Choice of boundary condition for active tracers (T and S) 
     91   INTEGER, DIMENSION(jp_bdy)           ::   nn_tra_dta     !: = 0 use the initial state as bdy dta ;  
    7592                                                            !: = 1 read it in a NetCDF file 
    7693   LOGICAL, DIMENSION(jp_bdy) ::   ln_tra_dmp               !: =T Tracer damping 
    7794   LOGICAL, DIMENSION(jp_bdy) ::   ln_dyn3d_dmp             !: =T Baroclinic velocity damping 
    7895   REAL,    DIMENSION(jp_bdy) ::   rn_time_dmp              !: Damping time scale in days 
     96   REAL,    DIMENSION(jp_bdy) ::   rn_time_dmp_out          !: Damping time scale in days at radiation outflow points 
    7997 
    8098#if defined key_lim2 
    81    INTEGER, DIMENSION(jp_bdy) ::   nn_ice_lim2              ! Choice of boundary condition for sea ice variables  
    82    INTEGER, DIMENSION(jp_bdy) ::   nn_ice_lim2_dta          !: = 0 use the initial state as bdy dta ;  
    83                                                             !: = 1 read it in a NetCDF file 
     99   CHARACTER(len=20), DIMENSION(jp_bdy) ::   nn_ice_lim2      ! Choice of boundary condition for sea ice variables  
     100   INTEGER, DIMENSION(jp_bdy)           ::   nn_ice_lim2_dta  !: = 0 use the initial state as bdy dta ;  
     101                                                              !: = 1 read it in a NetCDF file 
    84102#endif 
    85103   ! 
    … …  
    88106   !! Global variables 
    89107   !!---------------------------------------------------------------------- 
    90    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bdytmask   !: Mask defining computational domain at T-points 
    91    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bdyumask   !: Mask defining computational domain at U-points 
    92    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bdyvmask   !: Mask defining computational domain at V-points 
     108   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   bdytmask   !: Mask defining computational domain at T-points 
     109   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   bdyumask   !: Mask defining computational domain at U-points 
     110   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   bdyvmask   !: Mask defining computational domain at V-points 
    93111 
    94112   REAL(wp)                                    ::   bdysurftot !: Lateral surface of unstructured open boundary 
    95113 
    96    REAL(wp), POINTER, DIMENSION(:,:)           ::   pssh       !:  
    97    REAL(wp), POINTER, DIMENSION(:,:)           ::   phur       !:  
    98    REAL(wp), POINTER, DIMENSION(:,:)           ::   phvr       !: Pointers for barotropic fields  
    99    REAL(wp), POINTER, DIMENSION(:,:)           ::   pu2d       !:  
    100    REAL(wp), POINTER, DIMENSION(:,:)           ::   pv2d       !:  
     114   REAL(wp), POINTER, DIMENSION(:,:)           ::   pssh                  !:  
     115   REAL(wp), POINTER, DIMENSION(:,:)           ::   phur                  !:  
     116   REAL(wp), POINTER, DIMENSION(:,:)           ::   phvr                  !: Pointers for barotropic fields  
     117   REAL(wp), POINTER, DIMENSION(:,:)           ::   pub2d, pun2d, pua2d   !:  
     118   REAL(wp), POINTER, DIMENSION(:,:)           ::   pvb2d, pvn2d, pva2d   !:  
    101119 
    102120   !!---------------------------------------------------------------------- 
    … …  
    109127   REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), TARGET ::   dta_global2       !: workspace for reading in global data arrays (struct. bdy) 
    110128   TYPE(OBC_INDEX), DIMENSION(jp_bdy), TARGET      ::   idx_bdy           !: bdy indices (local process) 
    111    TYPE(OBC_DATA) , DIMENSION(jp_bdy)              ::   dta_bdy           !: bdy external data (local process) 
     129   TYPE(OBC_DATA) , DIMENSION(jp_bdy), TARGET      ::   dta_bdy           !: bdy external data (local process) 
    112130 
    113131   !!---------------------------------------------------------------------- 
    … …  
    125143      !!---------------------------------------------------------------------- 
    126144      ! 
    127       ALLOCATE( bdytmask(jpi,jpj) , bdyumask(jpi,jpj), bdyvmask(jpi,jpj),                    &   
     145      ALLOCATE( bdytmask(jpi,jpj) , bdyumask(jpi,jpj), bdyvmask(jpi,jpj),     &   
    128146         &      STAT=bdy_oce_alloc ) 
    129147         ! 

  • branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_par.F90

    r3294 r4254  
    2323# endif 
    2424   INTEGER, PUBLIC, PARAMETER ::   jp_bdy  = 10       !: Maximum number of bdy sets 
    25    INTEGER, PUBLIC, PARAMETER ::   jpbtime = 1000     !: Max number of time dumps per file 
    2625   INTEGER, PUBLIC, PARAMETER ::   jpbgrd  = 3        !: Number of horizontal grid types used  (T, U, V) 
    2726 
    28    !! Flags for choice of schemes 
    29    INTEGER, PUBLIC, PARAMETER ::   jp_none         = 0        !: Flag for no open boundary condition 
    30    INTEGER, PUBLIC, PARAMETER ::   jp_frs          = 1        !: Flag for Flow Relaxation Scheme 
    31    INTEGER, PUBLIC, PARAMETER ::   jp_flather      = 2        !: Flag for Flather 
    3227#else 
    3328   !!---------------------------------------------------------------------- 

  • branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90

    r4105 r4254  
    8181      INTEGER,          DIMENSION(jpbgrd) ::   ilen1  
    8282      INTEGER, POINTER, DIMENSION(:)      ::   nblen, nblenrim  ! short cuts 
     83      TYPE(OBC_DATA), POINTER             ::   dta              ! short cut 
    8384      !! 
    8485      !!--------------------------------------------------------------------------- 
    … …  
    9293         ! Calculate depth-mean currents 
    9394         !----------------------------- 
    94          CALL wrk_alloc(jpi,jpj,pu2d,pv2d)  
    95  
    96          pu2d(:,:) = 0._wp 
    97          pv2d(:,:) = 0._wp 
    98  
     95         CALL wrk_alloc(jpi,jpj,pun2d,pvn2d)  
     96 
     97         pun2d(:,:) = 0.e0 
     98         pvn2d(:,:) = 0.e0 
    9999         DO ik = 1, jpkm1   !! Vertically integrated momentum trends 
    100              pu2d(:,:) = pu2d(:,:) + fse3u(:,:,ik) * umask(:,:,ik) * un(:,:,ik) 
    101              pv2d(:,:) = pv2d(:,:) + fse3v(:,:,ik) * vmask(:,:,ik) * vn(:,:,ik) 
     100             pun2d(:,:) = pun2d(:,:) + fse3u(:,:,ik) * umask(:,:,ik) * un(:,:,ik) 
     101             pvn2d(:,:) = pvn2d(:,:) + fse3v(:,:,ik) * vmask(:,:,ik) * vn(:,:,ik) 
    102102         END DO 
    103          pu2d(:,:) = pu2d(:,:) * hur(:,:) 
    104          pv2d(:,:) = pv2d(:,:) * hvr(:,:) 
     103         pun2d(:,:) = pun2d(:,:) * hur(:,:) 
     104         pvn2d(:,:) = pvn2d(:,:) * hvr(:,:) 
    105105          
    106106         DO ib_bdy = 1, nb_bdy 
    … …  
    108108            nblen => idx_bdy(ib_bdy)%nblen 
    109109            nblenrim => idx_bdy(ib_bdy)%nblenrim 
    110  
    111             IF( nn_dyn2d(ib_bdy) .gt. 0 .and. nn_dyn2d_dta(ib_bdy) .eq. 0 ) THEN  
     110            dta => dta_bdy(ib_bdy) 
     111 
     112            IF( nn_dyn2d_dta(ib_bdy) .eq. 0 ) THEN  
    112113               ilen1(:) = nblen(:) 
    113                igrd = 1 
    114                DO ib = 1, ilen1(igrd) 
    115                   ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    116                   ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    117                   dta_bdy(ib_bdy)%ssh(ib) = sshn(ii,ij) * tmask(ii,ij,1)          
    118                END DO  
    119                igrd = 2 
    120                DO ib = 1, ilen1(igrd) 
    121                   ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    122                   ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    123                   dta_bdy(ib_bdy)%u2d(ib) = pu2d(ii,ij) * umask(ii,ij,1)          
    124                END DO  
    125                igrd = 3 
    126                DO ib = 1, ilen1(igrd) 
    127                   ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    128                   ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    129                   dta_bdy(ib_bdy)%v2d(ib) = pv2d(ii,ij) * vmask(ii,ij,1)          
    130                END DO  
    131             ENDIF 
    132  
    133             IF( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 0 ) THEN  
    134                ilen1(:) = nblen(:) 
    135                igrd = 2  
    136                DO ib = 1, ilen1(igrd) 
    137                   DO ik = 1, jpkm1 
     114               IF( dta%ll_ssh ) THEN  
     115                  igrd = 1 
     116                  DO ib = 1, ilen1(igrd) 
    138117                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    139118                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    140                      dta_bdy(ib_bdy)%u3d(ib,ik) =  ( un(ii,ij,ik) - pu2d(ii,ij) ) * umask(ii,ij,ik)          
    141                   END DO 
    142                END DO  
    143                igrd = 3  
    144                DO ib = 1, ilen1(igrd) 
    145                   DO ik = 1, jpkm1 
     119                     dta_bdy(ib_bdy)%ssh(ib) = sshn(ii,ij) * tmask(ii,ij,1)          
     120                  END DO  
     121               END IF 
     122               IF( dta%ll_u2d ) THEN  
     123                  igrd = 2 
     124                  DO ib = 1, ilen1(igrd) 
    146125                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    147126                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    148                      dta_bdy(ib_bdy)%v3d(ib,ik) =  ( vn(ii,ij,ik) - pv2d(ii,ij) ) * vmask(ii,ij,ik)          
    149                      END DO 
    150                END DO  
    151             ENDIF 
    152  
    153             IF( nn_tra(ib_bdy) .gt. 0 .and. nn_tra_dta(ib_bdy) .eq. 0 ) THEN  
    154                ilen1(:) = nblen(:) 
    155                igrd = 1                       ! Everything is at T-points here 
    156                DO ib = 1, ilen1(igrd) 
    157                   DO ik = 1, jpkm1 
     127                     dta_bdy(ib_bdy)%u2d(ib) = pun2d(ii,ij) * umask(ii,ij,1)          
     128                  END DO  
     129               END IF 
     130               IF( dta%ll_v2d ) THEN  
     131                  igrd = 3 
     132                  DO ib = 1, ilen1(igrd) 
    158133                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    159134                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    160                      dta_bdy(ib_bdy)%tem(ib,ik) = tsn(ii,ij,ik,jp_tem) * tmask(ii,ij,ik)          
    161                      dta_bdy(ib_bdy)%sal(ib,ik) = tsn(ii,ij,ik,jp_sal) * tmask(ii,ij,ik)          
    162                   END DO 
    163                END DO  
    164             ENDIF 
    165  
    166 #if defined key_lim2 
    167             IF( nn_ice_lim2(ib_bdy) .gt. 0 .and. nn_ice_lim2_dta(ib_bdy) .eq. 0 ) THEN  
     135                     dta_bdy(ib_bdy)%v2d(ib) = pvn2d(ii,ij) * vmask(ii,ij,1)          
     136                  END DO  
     137               END IF 
     138            ENDIF 
     139 
     140            IF( nn_dyn3d_dta(ib_bdy) .eq. 0 ) THEN  
    168141               ilen1(:) = nblen(:) 
    169                igrd = 1                       ! Everything is at T-points here 
    170                DO ib = 1, ilen1(igrd) 
    171                   ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    172                   ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    173                   dta_bdy(ib_bdy)%frld(ib) = frld(ii,ij) * tmask(ii,ij,1)          
    174                   dta_bdy(ib_bdy)%hicif(ib) = hicif(ii,ij) * tmask(ii,ij,1)          
    175                   dta_bdy(ib_bdy)%hsnif(ib) = hsnif(ii,ij) * tmask(ii,ij,1)          
    176                END DO  
     142               IF( dta%ll_u3d ) THEN  
     143                  igrd = 2  
     144                  DO ib = 1, ilen1(igrd) 
     145                     DO ik = 1, jpkm1 
     146                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     147                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     148                        dta_bdy(ib_bdy)%u3d(ib,ik) =  ( un(ii,ij,ik) - pun2d(ii,ij) ) * umask(ii,ij,ik)          
     149                     END DO 
     150                  END DO  
     151               END IF 
     152               IF( dta%ll_v3d ) THEN  
     153                  igrd = 3  
     154                  DO ib = 1, ilen1(igrd) 
     155                     DO ik = 1, jpkm1 
     156                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     157                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     158                        dta_bdy(ib_bdy)%v3d(ib,ik) =  ( vn(ii,ij,ik) - pvn2d(ii,ij) ) * vmask(ii,ij,ik)          
     159                        END DO 
     160                  END DO  
     161               END IF 
     162            ENDIF 
     163 
     164            IF( nn_tra_dta(ib_bdy) .eq. 0 ) THEN  
     165               ilen1(:) = nblen(:) 
     166               IF( dta%ll_tem ) THEN 
     167                  igrd = 1  
     168                  DO ib = 1, ilen1(igrd) 
     169                     DO ik = 1, jpkm1 
     170                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     171                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     172                        dta_bdy(ib_bdy)%tem(ib,ik) = tsn(ii,ij,ik,jp_tem) * tmask(ii,ij,ik)          
     173                     END DO 
     174                  END DO  
     175               END IF 
     176               IF( dta%ll_sal ) THEN 
     177                  igrd = 1  
     178                  DO ib = 1, ilen1(igrd) 
     179                     DO ik = 1, jpkm1 
     180                        ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     181                        ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     182                        dta_bdy(ib_bdy)%sal(ib,ik) = tsn(ii,ij,ik,jp_sal) * tmask(ii,ij,ik)          
     183                     END DO 
     184                  END DO  
     185               END IF 
     186            ENDIF 
     187 
     188#if defined key_lim2 
     189            IF( nn_ice_lim2_dta(ib_bdy) .eq. 0 ) THEN  
     190               ilen1(:) = nblen(:) 
     191               IF( dta%ll_frld ) THEN 
     192                  igrd = 1  
     193                  DO ib = 1, ilen1(igrd) 
     194                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     195                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     196                     dta_bdy(ib_bdy)%frld(ib) = frld(ii,ij) * tmask(ii,ij,1)          
     197                  END DO  
     198               END IF 
     199               IF( dta%ll_hicif ) THEN 
     200                  igrd = 1  
     201                  DO ib = 1, ilen1(igrd) 
     202                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     203                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     204                     dta_bdy(ib_bdy)%hicif(ib) = hicif(ii,ij) * tmask(ii,ij,1)          
     205                  END DO  
     206               END IF 
     207               IF( dta%ll_hsnif ) THEN 
     208                  igrd = 1  
     209                  DO ib = 1, ilen1(igrd) 
     210                     ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     211                     ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     212                     dta_bdy(ib_bdy)%hsnif(ib) = hsnif(ii,ij) * tmask(ii,ij,1)          
     213                  END DO  
     214               END IF 
    177215            ENDIF 
    178216#endif 
    … …  
    180218         ENDDO ! ib_bdy 
    181219 
    182          CALL wrk_dealloc(jpi,jpj,pu2d,pv2d)  
     220         CALL wrk_dealloc(jpi,jpj,pun2d,pvn2d)  
    183221 
    184222      ENDIF ! kt .eq. nit000 
    … …  
    189227      jstart = 1 
    190228      DO ib_bdy = 1, nb_bdy    
     229         dta => dta_bdy(ib_bdy) 
    191230         IF( nn_dta(ib_bdy) .eq. 1 ) THEN ! skip this bit if no external data required 
    192231       
    … …  
    194233               ! Update barotropic boundary conditions only 
    195234               ! jit is optional argument for fld_read and bdytide_update 
    196                IF( nn_dyn2d(ib_bdy) .gt. 0 ) THEN 
     235               IF( cn_dyn2d(ib_bdy) /= 'none' ) THEN 
    197236                  IF( nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays 
    198                      dta_bdy(ib_bdy)%ssh(:) = 0._wp 
    199                      dta_bdy(ib_bdy)%u2d(:) = 0._wp 
    200                      dta_bdy(ib_bdy)%v2d(:) = 0._wp 
     237                     IF( dta%ll_ssh ) dta%ssh(:) = 0.0 
     238                     IF( dta%ll_u2d ) dta%u2d(:) = 0.0 
     239                     IF( dta%ll_u3d ) dta%v2d(:) = 0.0 
    201240                  ENDIF 
    202                   IF (nn_tra(ib_bdy).ne.4) THEN 
    203                      IF( nn_dyn2d_dta(ib_bdy) .EQ. 1 .OR. nn_dyn2d_dta(ib_bdy) .EQ. 3 .OR.  & 
    204                        & (ln_full_vel_array(ib_bdy) .AND. nn_dyn3d_dta(ib_bdy).eq.1) )THEN 
    205  
    206                         ! For the runoff case, no need to update the forcing (already done in the baroclinic part) 
    207                         jend = nb_bdy_fld(ib_bdy) 
    208                         IF ( nn_tra(ib_bdy) .GT. 0 .AND. nn_tra_dta(ib_bdy) .GE. 1 ) jend = jend - 2 
     241                  IF (cn_tra(ib_bdy) /= 'runoff') THEN 
     242                     IF( nn_dyn2d_dta(ib_bdy) .EQ. 1 .OR. nn_dyn2d_dta(ib_bdy) .EQ. 3 ) THEN 
     243 
     244                        jend = jstart + dta%nread(2) - 1 
    209245                        CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), map=nbmap_ptr(jstart:jend),  & 
    210246                                     & kit=jit, kt_offset=time_offset ) 
    211                         IF ( nn_tra(ib_bdy) .GT. 0 .AND. nn_tra_dta(ib_bdy) .GE. 1 ) jend = jend + 2 
    212  
    213                         ! If full velocities in boundary data then split into barotropic and baroclinic data 
     247 
     248                        ! If full velocities in boundary data then extract barotropic velocities from 3D fields 
    214249                        IF( ln_full_vel_array(ib_bdy) .AND.                                             & 
    215250                          &    ( nn_dyn2d_dta(ib_bdy) .EQ. 1 .OR. nn_dyn2d_dta(ib_bdy) .EQ. 3 .OR.  & 
    … …  
    217252 
    218253                           igrd = 2                      ! zonal velocity 
    219                            dta_bdy(ib_bdy)%u2d(:) = 0._wp 
     254                           dta%u2d(:) = 0.0 
    220255                           DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 
    221256                              ii   = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    222257                              ij   = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    223258                              DO ik = 1, jpkm1 
    224                                  dta_bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) & 
    225                        &                          + fse3u(ii,ij,ik) * umask(ii,ij,ik) * dta_bdy(ib_bdy)%u3d(ib,ik) 
     259                                 dta%u2d(ib) = dta%u2d(ib) & 
     260                       &                          + fse3u(ii,ij,ik) * umask(ii,ij,ik) * dta%u3d(ib,ik) 
    226261                              END DO 
    227                               dta_bdy(ib_bdy)%u2d(ib) =  dta_bdy(ib_bdy)%u2d(ib) * hur(ii,ij) 
    228                               DO ik = 1, jpkm1 
    229                                  dta_bdy(ib_bdy)%u3d(ib,ik) = dta_bdy(ib_bdy)%u3d(ib,ik) - dta_bdy(ib_bdy)%u2d(ib) 
    230                               END DO 
     262                              dta%u2d(ib) =  dta%u2d(ib) * hur(ii,ij) 
    231263                           END DO 
    232264                           igrd = 3                      ! meridional velocity 
    233                            dta_bdy(ib_bdy)%v2d(:) = 0._wp 
     265                           dta%v2d(:) = 0.0 
    234266                           DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 
    235267                              ii   = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    236268                              ij   = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    237269                              DO ik = 1, jpkm1 
    238                                  dta_bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) & 
    239                        &                       + fse3v(ii,ij,ik) * vmask(ii,ij,ik) * dta_bdy(ib_bdy)%v3d(ib,ik) 
     270                                 dta%v2d(ib) = dta%v2d(ib) & 
     271                       &                       + fse3v(ii,ij,ik) * vmask(ii,ij,ik) * dta%v3d(ib,ik) 
    240272                              END DO 
    241                               dta_bdy(ib_bdy)%v2d(ib) =  dta_bdy(ib_bdy)%v2d(ib) * hvr(ii,ij) 
    242                               DO ik = 1, jpkm1 
    243                                  dta_bdy(ib_bdy)%v3d(ib,ik) = dta_bdy(ib_bdy)%v3d(ib,ik) - dta_bdy(ib_bdy)%v2d(ib) 
    244                               END DO 
     273                              dta%v2d(ib) =  dta%v2d(ib) * hvr(ii,ij) 
    245274                           END DO 
    246275                        ENDIF                     
    247276                     ENDIF 
    248277                     IF( nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN ! update tidal harmonic forcing 
    249                         CALL bdytide_update( kt=kt, idx=idx_bdy(ib_bdy), dta=dta_bdy(ib_bdy), td=tides(ib_bdy),   &  
     278                        CALL bdytide_update( kt=kt, idx=idx_bdy(ib_bdy), dta=dta, td=tides(ib_bdy),   &  
    250279                          &                 jit=jit, time_offset=time_offset ) 
    251280                     ENDIF 
    … …  
    253282               ENDIF 
    254283            ELSE 
    255                IF (nn_tra(ib_bdy).eq.4) then      ! runoff condition 
     284               IF (cn_tra(ib_bdy) == 'runoff') then      ! runoff condition 
    256285                  jend = nb_bdy_fld(ib_bdy) 
    257286                  CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend),  & 
    … …  
    262291                     ii   = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    263292                     ij   = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    264                      dta_bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) ) 
     293                     dta%u2d(ib) = dta%u2d(ib) / ( e2u(ii,ij) * hu_0(ii,ij) ) 
    265294                  END DO 
    266295                  ! 
    … …  
    269298                     ii   = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    270299                     ij   = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    271                      dta_bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) ) 
     300                     dta%v2d(ib) = dta%v2d(ib) / ( e1v(ii,ij) * hv_0(ii,ij) ) 
    272301                  END DO 
    273302               ELSE 
    274                   IF( nn_dyn2d(ib_bdy) .gt. 0 .and. nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays 
    275                      dta_bdy(ib_bdy)%ssh(:) = 0._wp 
    276                      dta_bdy(ib_bdy)%u2d(:) = 0._wp 
    277                      dta_bdy(ib_bdy)%v2d(:) = 0._wp 
     303                  IF( nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN ! tidal harmonic forcing ONLY: initialise arrays 
     304                     IF( dta%ll_ssh ) dta%ssh(:) = 0.0 
     305                     IF( dta%ll_u2d ) dta%u2d(:) = 0.0 
     306                     IF( dta%ll_v2d ) dta%v2d(:) = 0.0 
    278307                  ENDIF 
    279                   IF( nb_bdy_fld(ib_bdy) .gt. 0 ) THEN ! update external data 
    280                      jend = nb_bdy_fld(ib_bdy) 
     308                  IF( dta%nread(1) .gt. 0 ) THEN ! update external data 
     309                     jend = jstart + dta%nread(1) - 1 
    281310                     CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), & 
    282311                                  & map=nbmap_ptr(jstart:jend), kt_offset=time_offset ) 
    … …  
    287316                    &   nn_dyn3d_dta(ib_bdy) .EQ. 1 ) ) THEN 
    288317                     igrd = 2                      ! zonal velocity 
    289                      dta_bdy(ib_bdy)%u2d(:) = 0._wp 
     318                     dta%u2d(:) = 0.0 
    290319                     DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 
    291320                        ii   = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    292321                        ij   = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    293322                        DO ik = 1, jpkm1 
    294                            dta_bdy(ib_bdy)%u2d(ib) = dta_bdy(ib_bdy)%u2d(ib) & 
    295                  &                       + fse3u(ii,ij,ik) * umask(ii,ij,ik) * dta_bdy(ib_bdy)%u3d(ib,ik) 
     323                           dta%u2d(ib) = dta%u2d(ib) & 
     324                 &                       + fse3u(ii,ij,ik) * umask(ii,ij,ik) * dta%u3d(ib,ik) 
    296325                        END DO 
    297                         dta_bdy(ib_bdy)%u2d(ib) =  dta_bdy(ib_bdy)%u2d(ib) * hur(ii,ij) 
     326                        dta%u2d(ib) =  dta%u2d(ib) * hur(ii,ij) 
    298327                        DO ik = 1, jpkm1 
    299                            dta_bdy(ib_bdy)%u3d(ib,ik) = dta_bdy(ib_bdy)%u3d(ib,ik) - dta_bdy(ib_bdy)%u2d(ib) 
     328                           dta%u3d(ib,ik) = dta%u3d(ib,ik) - dta%u2d(ib) 
    300329                        END DO 
    301330                     END DO 
    302331                     igrd = 3                      ! meridional velocity 
    303                      dta_bdy(ib_bdy)%v2d(:) = 0._wp 
     332                     dta%v2d(:) = 0.0 
    304333                     DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 
    305334                        ii   = idx_bdy(ib_bdy)%nbi(ib,igrd) 
    306335                        ij   = idx_bdy(ib_bdy)%nbj(ib,igrd) 
    307336                        DO ik = 1, jpkm1 
    308                            dta_bdy(ib_bdy)%v2d(ib) = dta_bdy(ib_bdy)%v2d(ib) & 
    309                  &                       + fse3v(ii,ij,ik) * vmask(ii,ij,ik) * dta_bdy(ib_bdy)%v3d(ib,ik) 
     337                           dta%v2d(ib) = dta%v2d(ib) & 
     338                 &                       + fse3v(ii,ij,ik) * vmask(ii,ij,ik) * dta%v3d(ib,ik) 
    310339                        END DO 
    311                         dta_bdy(ib_bdy)%v2d(ib) =  dta_bdy(ib_bdy)%v2d(ib) * hvr(ii,ij) 
     340                        dta%v2d(ib) =  dta%v2d(ib) * hvr(ii,ij) 
    312341                        DO ik = 1, jpkm1 
    313                            dta_bdy(ib_bdy)%v3d(ib,ik) = dta_bdy(ib_bdy)%v3d(ib,ik) - dta_bdy(ib_bdy)%v2d(ib) 
     342                           dta%v3d(ib,ik) = dta%v3d(ib,ik) - dta%v2d(ib) 
    314343                        END DO 
    315344                     END DO 
    316345                  ENDIF 
    317                ENDIF 
    318             ENDIF 
    319             jstart = jend+1 
     346 
     347               ENDIF 
     348            ENDIF 
     349            jstart = jstart + dta%nread(1) 
    320350         END IF ! nn_dta(ib_bdy) = 1 
    321351      END DO  ! ib_bdy 
    322352 
     353      ! bg jchanut tschanges 
    323354#if defined key_tide 
    324355      ! Add tides if not split-explicit free surface else this is done in ts loop 
    325356      IF (.NOT.lk_dynspg_ts) CALL bdy_dta_tides( kt=kt, time_offset=time_offset ) 
    326357#endif 
     358      ! end jchanut tschanges 
     359 
    327360      IF ( ln_apr_obc ) THEN 
    328361         DO ib_bdy = 1, nb_bdy 
    329             IF (nn_tra(ib_bdy).NE.4)THEN 
     362            IF (cn_tra(ib_bdy) /= 'runoff')THEN 
    330363               igrd = 1                      ! meridional velocity 
    331364               DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd) 
    … …  
    350383      !!                for open boundary conditions 
    351384      !! 
    352       !! ** Method  :   Use fldread.F90 
     385      !! ** Method  :    
    353386      !!                 
    354387      !!---------------------------------------------------------------------- 
    … …  
    362395                                                                ! =F => baroclinic velocities in 3D boundary data 
    363396      INTEGER                                ::   ilen_global   ! Max length required for global bdy dta arrays 
    364       INTEGER,              DIMENSION(jpbgrd) ::  ilen0         ! size of local arrays 
    365397      INTEGER, ALLOCATABLE, DIMENSION(:)     ::   ilen1, ilen3  ! size of 1st and 3rd dimensions of local arrays 
    366398      INTEGER, ALLOCATABLE, DIMENSION(:)     ::   ibdy           ! bdy set for a particular jfld 
    367399      INTEGER, ALLOCATABLE, DIMENSION(:)     ::   igrid         ! index for grid type (1,2,3 = T,U,V) 
    368400      INTEGER, POINTER, DIMENSION(:)         ::   nblen, nblenrim  ! short cuts 
     401      TYPE(OBC_DATA), POINTER                ::   dta           ! short cut 
    369402      TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) ::   blf_i         !  array of namelist information structures 
    370403      TYPE(FLD_N) ::   bn_tem, bn_sal, bn_u3d, bn_v3d   !  
    … …  
    404437      nb_bdy_fld(:) = 0 
    405438      DO ib_bdy = 1, nb_bdy          
    406          IF( nn_dyn2d(ib_bdy) .gt. 0 .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) THEN 
     439         IF( cn_dyn2d(ib_bdy) /= 'none' .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) THEN 
    407440            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 3 
    408441         ENDIF 
    409          IF( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 1 ) THEN 
     442         IF( cn_dyn3d(ib_bdy) /= 'none' .and. nn_dyn3d_dta(ib_bdy) .eq. 1 ) THEN 
    410443            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 2 
    411444         ENDIF 
    412          IF( nn_tra(ib_bdy) .gt. 0 .and. nn_tra_dta(ib_bdy) .eq. 1  ) THEN 
     445         IF( cn_tra(ib_bdy) /= 'none' .and. nn_tra_dta(ib_bdy) .eq. 1  ) THEN 
    413446            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 2 
    414447         ENDIF 
    415448#if defined key_lim2 
    416          IF( nn_ice_lim2(ib_bdy) .gt. 0 .and. nn_ice_lim2_dta(ib_bdy) .eq. 1  ) THEN 
     449         IF( cn_ice_lim2(ib_bdy) /= 'none' .and. nn_ice_lim2_dta(ib_bdy) .eq. 1  ) THEN 
    417450            nb_bdy_fld(ib_bdy) = nb_bdy_fld(ib_bdy) + 3 
    418451         ENDIF 
    … …  
    472505            nblen => idx_bdy(ib_bdy)%nblen 
    473506            nblenrim => idx_bdy(ib_bdy)%nblenrim 
     507            dta => dta_bdy(ib_bdy) 
     508            dta%nread(2) = 0 
    474509 
    475510            ! Only read in necessary fields for this set. 
    476511            ! Important that barotropic variables come first. 
    477             IF( nn_dyn2d(ib_bdy) .gt. 0 .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) THEN  
    478  
    479                IF( nn_dyn2d(ib_bdy) .ne. jp_frs .and. nn_tra(ib_bdy) .ne. 4 ) THEN ! runoff condition : no ssh reading 
     512            IF( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) THEN  
     513 
     514               IF( dta%ll_ssh ) THEN  
     515                  if(lwp) write(numout,*) '++++++ reading in ssh field' 
    480516                  jfld = jfld + 1 
    481517                  blf_i(jfld) = bn_ssh 
    … …  
    484520                  ilen1(jfld) = nblen(igrid(jfld)) 
    485521                  ilen3(jfld) = 1 
    486                ENDIF 
    487  
    488                IF( .not. ln_full_vel_array(ib_bdy) ) THEN 
     522                  dta%nread(2) = dta%nread(2) + 1 
     523               ENDIF 
     524 
     525               IF( dta%ll_u2d .and. .not. ln_full_vel_array(ib_bdy) ) THEN 
     526                  if(lwp) write(numout,*) '++++++ reading in u2d field' 
    489527                  jfld = jfld + 1 
    490528                  blf_i(jfld) = bn_u2d 
    … …  
    493531                  ilen1(jfld) = nblen(igrid(jfld)) 
    494532                  ilen3(jfld) = 1 
    495  
     533                  dta%nread(2) = dta%nread(2) + 1 
     534               ENDIF 
     535 
     536               IF( dta%ll_v2d .and. .not. ln_full_vel_array(ib_bdy) ) THEN 
     537                  if(lwp) write(numout,*) '++++++ reading in v2d field' 
    496538                  jfld = jfld + 1 
    497539                  blf_i(jfld) = bn_v2d 
    … …  
    500542                  ilen1(jfld) = nblen(igrid(jfld)) 
    501543                  ilen3(jfld) = 1 
    502                ENDIF 
    503  
    504             ENDIF 
    505  
    506             ! baroclinic velocities 
    507             IF( ( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 1 ) .or. & 
    508            &      ( ln_full_vel_array(ib_bdy) .and. nn_dyn2d(ib_bdy) .gt. 0 .and.  & 
    509            &        ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) ) THEN 
    510  
    511                jfld = jfld + 1 
    512                blf_i(jfld) = bn_u3d 
    513                ibdy(jfld) = ib_bdy 
    514                igrid(jfld) = 2 
    515                ilen1(jfld) = nblen(igrid(jfld)) 
    516                ilen3(jfld) = jpk 
    517  
    518                jfld = jfld + 1 
    519                blf_i(jfld) = bn_v3d 
    520                ibdy(jfld) = ib_bdy 
    521                igrid(jfld) = 3 
    522                ilen1(jfld) = nblen(igrid(jfld)) 
    523                ilen3(jfld) = jpk 
     544                  dta%nread(2) = dta%nread(2) + 1 
     545               ENDIF 
     546 
     547            ENDIF 
     548 
     549            ! read 3D velocities if baroclinic velocities require OR if 
     550            ! barotropic velocities required and ln_full_vel set to .true. 
     551            IF( nn_dyn3d_dta(ib_bdy) .eq. 1 .or. & 
     552           &  ( ln_full_vel_array(ib_bdy) .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) ) THEN 
     553 
     554               IF( dta%ll_u3d .or. ( ln_full_vel_array(ib_bdy) .and. dta%ll_u2d ) ) THEN 
     555                  if(lwp) write(numout,*) '++++++ reading in u3d field' 
     556                  jfld = jfld + 1 
     557                  blf_i(jfld) = bn_u3d 
     558                  ibdy(jfld) = ib_bdy 
     559                  igrid(jfld) = 2 
     560                  ilen1(jfld) = nblen(igrid(jfld)) 
     561                  ilen3(jfld) = jpk 
     562                  IF( ln_full_vel_array(ib_bdy) .and. dta%ll_u2d ) dta%nread(2) = dta%nread(2) + 1 
     563               ENDIF 
     564 
     565               IF( dta%ll_v3d .or. ( ln_full_vel_array(ib_bdy) .and. dta%ll_v2d ) ) THEN 
     566                  if(lwp) write(numout,*) '++++++ reading in v3d field' 
     567                  jfld = jfld + 1 
     568                  blf_i(jfld) = bn_v3d 
     569                  ibdy(jfld) = ib_bdy 
     570                  igrid(jfld) = 3 
     571                  ilen1(jfld) = nblen(igrid(jfld)) 
     572                  ilen3(jfld) = jpk 
     573                  IF( ln_full_vel_array(ib_bdy) .and. dta%ll_v2d ) dta%nread(2) = dta%nread(2) + 1 
     574               ENDIF 
    524575 
    525576            ENDIF 
    526577 
    527578            ! temperature and salinity 
    528             IF( nn_tra(ib_bdy) .gt. 0 .and. nn_tra_dta(ib_bdy) .eq. 1 ) THEN 
    529  
    530                jfld = jfld + 1 
    531                blf_i(jfld) = bn_tem 
    532                ibdy(jfld) = ib_bdy 
    533                igrid(jfld) = 1 
    534                ilen1(jfld) = nblen(igrid(jfld)) 
    535                ilen3(jfld) = jpk 
    536  
    537                jfld = jfld + 1 
    538                blf_i(jfld) = bn_sal 
    539                ibdy(jfld) = ib_bdy 
    540                igrid(jfld) = 1 
    541                ilen1(jfld) = nblen(igrid(jfld)) 
    542                ilen3(jfld) = jpk 
     579            IF( nn_tra_dta(ib_bdy) .eq. 1 ) THEN 
     580 
     581               IF( dta%ll_tem ) THEN 
     582                  if(lwp) write(numout,*) '++++++ reading in tem field' 
     583                  jfld = jfld + 1 
     584                  blf_i(jfld) = bn_tem 
     585                  ibdy(jfld) = ib_bdy 
     586                  igrid(jfld) = 1 
     587                  ilen1(jfld) = nblen(igrid(jfld)) 
     588                  ilen3(jfld) = jpk 
     589               ENDIF 
     590 
     591               IF( dta%ll_sal ) THEN 
     592                  if(lwp) write(numout,*) '++++++ reading in sal field' 
     593                  jfld = jfld + 1 
     594                  blf_i(jfld) = bn_sal 
     595                  ibdy(jfld) = ib_bdy 
     596                  igrid(jfld) = 1 
     597                  ilen1(jfld) = nblen(igrid(jfld)) 
     598                  ilen3(jfld) = jpk 
     599               ENDIF 
    543600 
    544601            ENDIF 
    … …  
    546603#if defined key_lim2 
    547604            ! sea ice 
    548             IF( nn_ice_lim2(ib_bdy) .gt. 0 .and. nn_ice_lim2_dta(ib_bdy) .eq. 1 ) THEN 
    549  
    550                jfld = jfld + 1 
    551                blf_i(jfld) = bn_frld 
    552                ibdy(jfld) = ib_bdy 
    553                igrid(jfld) = 1 
    554                ilen1(jfld) = nblen(igrid(jfld)) 
    555                ilen3(jfld) = 1 
    556  
    557                jfld = jfld + 1 
    558                blf_i(jfld) = bn_hicif 
    559                ibdy(jfld) = ib_bdy 
    560                igrid(jfld) = 1 
    561                ilen1(jfld) = nblen(igrid(jfld)) 
    562                ilen3(jfld) = 1 
    563  
    564                jfld = jfld + 1 
    565                blf_i(jfld) = bn_hsnif 
    566                ibdy(jfld) = ib_bdy 
    567                igrid(jfld) = 1 
    568                ilen1(jfld) = nblen(igrid(jfld)) 
    569                ilen3(jfld) = 1 
     605            IF( nn_ice_lim2_dta(ib_bdy) .eq. 1 ) THEN 
     606 
     607               IF( dta%ll_frld ) THEN 
     608                  jfld = jfld + 1 
     609                  blf_i(jfld) = bn_frld 
     610                  ibdy(jfld) = ib_bdy 
     611                  igrid(jfld) = 1 
     612                  ilen1(jfld) = nblen(igrid(jfld)) 
     613                  ilen3(jfld) = 1 
     614               ENDIF 
     615 
     616               IF( dta%ll_hicif ) THEN 
     617                  jfld = jfld + 1 
     618                  blf_i(jfld) = bn_hicif 
     619                  ibdy(jfld) = ib_bdy 
     620                  igrid(jfld) = 1 
     621                  ilen1(jfld) = nblen(igrid(jfld)) 
     622                  ilen3(jfld) = 1 
     623               ENDIF 
     624 
     625               IF( dta%ll_hsnif ) THEN 
     626                  jfld = jfld + 1 
     627                  blf_i(jfld) = bn_hsnif 
     628                  ibdy(jfld) = ib_bdy 
     629                  igrid(jfld) = 1 
     630                  ilen1(jfld) = nblen(igrid(jfld)) 
     631                  ilen3(jfld) = 1 
     632               ENDIF 
    570633 
    571634            ENDIF 
    … …  
    582645            ENDIF 
    583646 
     647            dta%nread(1) = nb_bdy_fld(ib_bdy) 
     648 
    584649         ENDIF ! nn_dta .eq. 1 
    585650      ENDDO ! ib_bdy 
    … …  
    610675 
    611676         nblen => idx_bdy(ib_bdy)%nblen 
    612          nblenrim => idx_bdy(ib_bdy)%nblenrim 
    613  
    614          IF (nn_dyn2d(ib_bdy) .gt. 0) THEN 
    615             IF( nn_dyn2d_dta(ib_bdy) .eq. 0 .or. nn_dyn2d_dta(ib_bdy) .eq. 2 .or. ln_full_vel_array(ib_bdy) ) THEN 
    616                ilen0(1:3) = nblen(1:3) 
    617                ALLOCATE( dta_bdy(ib_bdy)%u2d(ilen0(2)) ) 
    618                ALLOCATE( dta_bdy(ib_bdy)%v2d(ilen0(3)) ) 
    619                IF ( nn_dyn2d(ib_bdy) .ne. jp_frs .and. (nn_dyn2d_dta(ib_bdy).eq.1.or.nn_dyn2d_dta(ib_bdy).eq.3) ) THEN 
    620                   jfld = jfld + 1 
    621                   dta_bdy(ib_bdy)%ssh => bf(jfld)%fnow(:,1,1) 
     677         dta => dta_bdy(ib_bdy) 
     678 
     679         if(lwp) then 
     680            write(numout,*) '++++++ dta%ll_ssh = ',dta%ll_ssh 
     681            write(numout,*) '++++++ dta%ll_u2d = ',dta%ll_u2d 
     682            write(numout,*) '++++++ dta%ll_v2d = ',dta%ll_v2d 
     683            write(numout,*) '++++++ dta%ll_u3d = ',dta%ll_u3d 
     684            write(numout,*) '++++++ dta%ll_v3d = ',dta%ll_v3d 
     685            write(numout,*) '++++++ dta%ll_tem = ',dta%ll_tem 
     686            write(numout,*) '++++++ dta%ll_sal = ',dta%ll_sal 
     687         endif 
     688 
     689         IF ( nn_dyn2d_dta(ib_bdy) .eq. 0 .or. nn_dyn2d_dta(ib_bdy) .eq. 2 ) THEN 
     690            if(lwp) write(numout,*) '++++++ dta%ssh/u2d/u3d allocated space' 
     691            IF( dta%ll_ssh ) ALLOCATE( dta%ssh(nblen(1)) ) 
     692            IF( dta%ll_u2d ) ALLOCATE( dta%u2d(nblen(2)) ) 
     693            IF( dta%ll_v2d ) ALLOCATE( dta%v2d(nblen(3)) ) 
     694         ENDIF 
     695         IF ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) THEN 
     696            IF( dta%ll_ssh ) THEN 
     697               if(lwp) write(numout,*) '++++++ dta%ssh pointing to fnow' 
     698               jfld = jfld + 1 
     699               dta%ssh => bf(jfld)%fnow(:,1,1) 
     700            ENDIF 
     701            IF ( dta%ll_u2d ) THEN 
     702               IF ( ln_full_vel_array(ib_bdy) ) THEN 
     703                  if(lwp) write(numout,*) '++++++ dta%u2d allocated space' 
     704                  ALLOCATE( dta%u2d(nblen(2)) ) 
    622705               ELSE 
    623                   ALLOCATE( dta_bdy(ib_bdy)%ssh(nblen(1)) ) 
    624                ENDIF 
    625             ELSE 
    626                IF( nn_dyn2d(ib_bdy) .ne. jp_frs ) THEN 
    627                   jfld = jfld + 1 
    628                   dta_bdy(ib_bdy)%ssh => bf(jfld)%fnow(:,1,1) 
    629                ENDIF 
     706                  if(lwp) write(numout,*) '++++++ dta%u2d pointing to fnow' 
     707                  jfld = jfld + 1 
     708                  dta%u2d => bf(jfld)%fnow(:,1,1) 
     709               ENDIF 
     710            ENDIF 
     711            IF ( dta%ll_v2d ) THEN 
     712               IF ( ln_full_vel_array(ib_bdy) ) THEN 
     713                  if(lwp) write(numout,*) '++++++ dta%v2d allocated space' 
     714                  ALLOCATE( dta%v2d(nblen(3)) ) 
     715               ELSE 
     716                  if(lwp) write(numout,*) '++++++ dta%v2d pointing to fnow' 
     717                  jfld = jfld + 1 
     718                  dta%v2d => bf(jfld)%fnow(:,1,1) 
     719               ENDIF 
     720            ENDIF 
     721         ENDIF 
     722 
     723         IF ( nn_dyn3d_dta(ib_bdy) .eq. 0 ) THEN 
     724            if(lwp) write(numout,*) '++++++ dta%u3d/v3d allocated space' 
     725            IF( dta%ll_u3d ) ALLOCATE( dta_bdy(ib_bdy)%u3d(nblen(2),jpk) ) 
     726            IF( dta%ll_v3d ) ALLOCATE( dta_bdy(ib_bdy)%v3d(nblen(3),jpk) ) 
     727         ENDIF 
     728         IF ( nn_dyn3d_dta(ib_bdy) .eq. 1 .or. & 
     729           &  ( ln_full_vel_array(ib_bdy) .and. ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) ) THEN 
     730            IF ( dta%ll_u3d .or. ( ln_full_vel_array(ib_bdy) .and. dta%ll_u2d ) ) THEN 
     731               if(lwp) write(numout,*) '++++++ dta%u3d pointing to fnow' 
    630732               jfld = jfld + 1 
    631                dta_bdy(ib_bdy)%u2d => bf(jfld)%fnow(:,1,1) 
     733               dta_bdy(ib_bdy)%u3d => bf(jfld)%fnow(:,1,:) 
     734            ENDIF 
     735            IF ( dta%ll_v3d .or. ( ln_full_vel_array(ib_bdy) .and. dta%ll_v2d ) ) THEN 
     736               if(lwp) write(numout,*) '++++++ dta%v3d pointing to fnow' 
    632737               jfld = jfld + 1 
    633                dta_bdy(ib_bdy)%v2d => bf(jfld)%fnow(:,1,1) 
    634             ENDIF 
    635          ENDIF 
    636  
    637          IF ( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 0 ) THEN 
    638             ilen0(1:3) = nblen(1:3) 
    639             ALLOCATE( dta_bdy(ib_bdy)%u3d(ilen0(2),jpk) ) 
    640             ALLOCATE( dta_bdy(ib_bdy)%v3d(ilen0(3),jpk) ) 
    641          ENDIF 
    642          IF ( ( nn_dyn3d(ib_bdy) .gt. 0 .and. nn_dyn3d_dta(ib_bdy) .eq. 1 ).or. & 
    643            &  ( ln_full_vel_array(ib_bdy) .and. nn_dyn2d(ib_bdy) .gt. 0 .and.   & 
    644            &    ( nn_dyn2d_dta(ib_bdy) .eq. 1 .or. nn_dyn2d_dta(ib_bdy) .eq. 3 ) ) ) THEN 
    645             jfld = jfld + 1 
    646             dta_bdy(ib_bdy)%u3d => bf(jfld)%fnow(:,1,:) 
    647             jfld = jfld + 1 
    648             dta_bdy(ib_bdy)%v3d => bf(jfld)%fnow(:,1,:) 
    649          ENDIF 
    650  
    651          IF (nn_tra(ib_bdy) .gt. 0) THEN 
    652             IF( nn_tra_dta(ib_bdy) .eq. 0 ) THEN 
    653                ilen0(1:3) = nblen(1:3) 
    654                ALLOCATE( dta_bdy(ib_bdy)%tem(ilen0(1),jpk) ) 
    655                ALLOCATE( dta_bdy(ib_bdy)%sal(ilen0(1),jpk) ) 
    656             ELSE 
     738               dta_bdy(ib_bdy)%v3d => bf(jfld)%fnow(:,1,:) 
     739            ENDIF 
     740         ENDIF 
     741 
     742         IF( nn_tra_dta(ib_bdy) .eq. 0 ) THEN 
     743            if(lwp) write(numout,*) '++++++ dta%tem/sal allocated space' 
     744            IF( dta%ll_tem ) ALLOCATE( dta_bdy(ib_bdy)%tem(nblen(1),jpk) ) 
     745            IF( dta%ll_sal ) ALLOCATE( dta_bdy(ib_bdy)%sal(nblen(1),jpk) ) 
     746         ELSE 
     747            IF( dta%ll_tem ) THEN 
     748               if(lwp) write(numout,*) '++++++ dta%tem pointing to fnow' 
    657749               jfld = jfld + 1 
    658750               dta_bdy(ib_bdy)%tem => bf(jfld)%fnow(:,1,:) 
     751            ENDIF 
     752            IF( dta%ll_sal ) THEN  
     753               if(lwp) write(numout,*) '++++++ dta%sal pointing to fnow' 
    659754               jfld = jfld + 1 
    660755               dta_bdy(ib_bdy)%sal => bf(jfld)%fnow(:,1,:) 
    … …  
    665760         IF (nn_ice_lim2(ib_bdy) .gt. 0) THEN 
    666761            IF( nn_ice_lim2_dta(ib_bdy) .eq. 0 ) THEN 
    667                ilen0(1:3) = nblen(1:3) 
    668                ALLOCATE( dta_bdy(ib_bdy)%frld(ilen0(1)) ) 
    669                ALLOCATE( dta_bdy(ib_bdy)%hicif(ilen0(1)) ) 
    670                ALLOCATE( dta_bdy(ib_bdy)%hsnif(ilen0(1)) ) 
     762               ALLOCATE( dta_bdy(ib_bdy)%frld(nblen(1)) ) 
     763               ALLOCATE( dta_bdy(ib_bdy)%hicif(nblen(1)) ) 
     764               ALLOCATE( dta_bdy(ib_bdy)%hsnif(nblen(1)) ) 
    671765            ELSE 
    672766               jfld = jfld + 1 

  • branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90

    r4105 r4254  
    3030   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    3131   USE in_out_manager  ! 
    32    USE domvvl          ! variable volume 
     32   USE domvvl 
    3333 
    3434   IMPLICIT NONE 
    … …  
    5757      LOGICAL, INTENT( in ), OPTIONAL :: dyn3d_only       ! T => only update baroclinic velocities 
    5858      !! 
    59       INTEGER               :: jk,ii,ij,ib,igrd     ! Loop counter 
    60       LOGICAL               :: ll_dyn2d, ll_dyn3d   
     59      INTEGER               :: jk,ii,ij,ib_bdy,ib,igrd     ! Loop counter 
     60      LOGICAL               :: ll_dyn2d, ll_dyn3d, ll_orlanski 
    6161      !! 
    6262 
    … …  
    7070      ENDIF 
    7171 
     72      ll_orlanski = .false. 
     73      DO ib_bdy = 1, nb_bdy 
     74         IF ( cn_dyn2d(ib_bdy) == 'orlanski' .or. cn_dyn2d(ib_bdy) == 'orlanski_npo' & 
     75     &   .or. cn_dyn3d(ib_bdy) == 'orlanski' .or. cn_dyn3d(ib_bdy) == 'orlanski_npo') ll_orlanski = .true. 
     76      ENDDO 
     77 
    7278      !------------------------------------------------------- 
    7379      ! Set pointers 
    … …  
    7783      phur => hur 
    7884      phvr => hvr 
    79       CALL wrk_alloc(jpi,jpj,pu2d,pv2d)  
     85      CALL wrk_alloc(jpi,jpj,pua2d,pva2d)  
     86      IF ( ll_orlanski ) CALL wrk_alloc(jpi,jpj,pub2d,pvb2d)  
    8087 
    8188      !------------------------------------------------------- 
    … …  
    8390      !------------------------------------------------------- 
    8491 
    85       pu2d(:,:) = 0._wp 
    86       pv2d(:,:) = 0._wp 
    87       ! bg jchanut tschanges (not specifically related to ts; this is a bug) 
     92      ! "After" velocities:  
     93 
     94      pua2d(:,:) = 0.e0 
     95      pva2d(:,:) = 0.e0 
     96       
    8897      IF (lk_vvl) THEN 
    89          DO jk = 1, jpkm1   !! Vertically integrated momentum trends 
    90             pu2d(:,:) = pu2d(:,:) + fse3u_a(:,:,jk) * umask(:,:,jk) * ua(:,:,jk) 
    91             pv2d(:,:) = pv2d(:,:) + fse3v_a(:,:,jk) * vmask(:,:,jk) * va(:,:,jk) 
     98         DO jk = 1, jpkm1 
     99            pua2d(:,:) = pua2d(:,:) + fse3u_a(:,:,jk) * umask(:,:,jk) * ua(:,:,jk) 
     100            pva2d(:,:) = pva2d(:,:) + fse3v_a(:,:,jk) * vmask(:,:,jk) * va(:,:,jk) 
    92101         END DO 
    93          pu2d(:,:) = pu2d(:,:) / ( hu_0(:,:) + sshu_a(:,:) + 1._wp - umask(:,:,1) ) 
    94          pv2d(:,:) = pv2d(:,:) / ( hv_0(:,:) + sshv_a(:,:) + 1._wp - vmask(:,:,1) ) 
    95       ! end jchanut tschanges 
     102         pua2d(:,:) = pua2d(:,:) / ( hu_0(:,:) + sshu_a(:,:) + 1._wp - umask(:,:,1) )  
     103         pva2d(:,:) = pva2d(:,:) / ( hv_0(:,:) + sshv_a(:,:) + 1._wp - vmask(:,:,1) ) 
    96104      ELSE 
    97          DO jk = 1, jpkm1   !! Vertically integrated momentum trends 
    98             pu2d(:,:) = pu2d(:,:) + fse3u(:,:,jk) * umask(:,:,jk) * ua(:,:,jk) 
    99             pv2d(:,:) = pv2d(:,:) + fse3v(:,:,jk) * vmask(:,:,jk) * va(:,:,jk) 
     105         DO jk = 1, jpkm1 
     106            pua2d(:,:) = pua2d(:,:) + fse3u(:,:,jk) * umask(:,:,jk) * ua(:,:,jk) 
     107            pva2d(:,:) = pva2d(:,:) + fse3v(:,:,jk) * vmask(:,:,jk) * va(:,:,jk) 
    100108         END DO 
    101          pu2d(:,:) = pu2d(:,:) * phur(:,:) 
    102          pv2d(:,:) = pv2d(:,:) * phvr(:,:) 
     109         pua2d(:,:) = pua2d(:,:) * phur(:,:) 
     110         pva2d(:,:) = pva2d(:,:) * phvr(:,:) 
    103111      ENDIF 
    104112 
    105113      DO jk = 1 , jpkm1 
    106          ua(:,:,jk) = ua(:,:,jk) - pu2d(:,:) * umask(:,:,jk) 
    107          va(:,:,jk) = va(:,:,jk) - pv2d(:,:) * vmask(:,:,jk) 
     114         ua(:,:,jk) = ua(:,:,jk) - pua2d(:,:) 
     115         va(:,:,jk) = va(:,:,jk) - pva2d(:,:) 
    108116      END DO 
     117 
     118      ! "Before" velocities (required for Orlanski condition):  
     119 
     120      IF ( ll_orlanski ) THEN           
     121         pub2d(:,:) = 0.e0 
     122         pvb2d(:,:) = 0.e0 
     123 
     124         IF (lk_vvl) THEN 
     125            DO jk = 1, jpkm1   !! Vertically integrated momentum trends 
     126               pub2d(:,:) = pub2d(:,:) + fse3u_b(:,:,jk) * umask(:,:,jk) * ub(:,:,jk) 
     127               pvb2d(:,:) = pvb2d(:,:) + fse3v_b(:,:,jk) * vmask(:,:,jk) * vb(:,:,jk) 
     128            END DO 
     129            pub2d(:,:) = pub2d(:,:) / ( hu_0(:,:) + sshu_b(:,:) + 1._wp - umask(:,:,1) )  
     130            pvb2d(:,:) = pvb2d(:,:) / ( hv_0(:,:) + sshv_b(:,:) + 1._wp - vmask(:,:,1) ) 
     131         ELSE 
     132            DO jk = 1, jpkm1   !! Vertically integrated momentum trends 
     133               pub2d(:,:) = pub2d(:,:) + fse3u(:,:,jk) * umask(:,:,jk) * ub(:,:,jk) 
     134               pvb2d(:,:) = pvb2d(:,:) + fse3v(:,:,jk) * vmask(:,:,jk) * vb(:,:,jk) 
     135            END DO 
     136            pub2d(:,:) = pub2d(:,:) * phur(:,:) 
     137            pvb2d(:,:) = pvb2d(:,:) * phvr(:,:) 
     138         ENDIF 
     139 
     140         DO jk = 1 , jpkm1 
     141            ub(:,:,jk) = ub(:,:,jk) - pub2d(:,:) 
     142            vb(:,:,jk) = vb(:,:,jk) - pvb2d(:,:) 
     143         END DO 
     144      END IF 
    109145 
    110146      !------------------------------------------------------- 
    … …  
    122158 
    123159      DO jk = 1 , jpkm1 
    124          ua(:,:,jk) = ( ua(:,:,jk) + pu2d(:,:) ) * umask(:,:,jk) 
    125          va(:,:,jk) = ( va(:,:,jk) + pv2d(:,:) ) * vmask(:,:,jk) 
     160         ua(:,:,jk) = ( ua(:,:,jk) + pua2d(:,:) ) * umask(:,:,jk) 
     161         va(:,:,jk) = ( va(:,:,jk) + pva2d(:,:) ) * vmask(:,:,jk) 
    126162      END DO 
    127163 
    128       CALL wrk_dealloc(jpi,jpj,pu2d,pv2d)  
     164      IF ( ll_orlanski ) THEN 
     165         DO jk = 1 , jpkm1 
     166            ub(:,:,jk) = ( ub(:,:,jk) + pub2d(:,:) ) * umask(:,:,jk) 
     167            vb(:,:,jk) = ( vb(:,:,jk) + pvb2d(:,:) ) * vmask(:,:,jk) 
     168         END DO 
     169      END IF 
     170 
     171      CALL wrk_dealloc(jpi,jpj,pua2d,pva2d)  
     172      IF ( ll_orlanski ) CALL wrk_dealloc(jpi,jpj,pub2d,pvb2d)  
    129173 
    130174      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn') 

  • branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90

    r4105 r4254  
    1212   !!   'key_bdy' :                    Unstructured Open Boundary Condition 
    1313   !!---------------------------------------------------------------------- 
    14    !!   bdy_dyn2d      : Apply open boundary conditions to barotropic variables. 
    15    !!   bdy_dyn2d_fla    : Apply Flather condition 
     14   !!   bdy_dyn2d          : Apply open boundary conditions to barotropic variables. 
     15   !!   bdy_dyn2d_frs      : Apply Flow Relaxation Scheme  
     16   !!   bdy_dyn2d_fla      : Apply Flather condition 
     17   !!   bdy_dyn2d_orlanski : Orlanski Radiation 
     18   !!   bdy_ssh            : Duplicate sea level across open boundaries 
    1619   !!---------------------------------------------------------------------- 
    1720   USE timing          ! Timing 
    … …  
    1922   USE dom_oce         ! ocean space and time domain 
    2023   USE bdy_oce         ! ocean open boundary conditions 
     24   USE bdylib          ! BDY library routines 
    2125   USE dynspg_oce      ! for barotropic variables 
    2226   USE phycst          ! physical constants 
    … …  
    2731   PRIVATE 
    2832 
    29    PUBLIC   bdy_dyn2d     ! routine called in dynspg_ts and bdy_dyn 
     33   PUBLIC   bdy_dyn2d   ! routine called in dynspg_ts and bdy_dyn 
    3034   PUBLIC   bdy_ssh       ! routine called in dynspg_ts or sshwzv 
    3135 
    … …  
    5054      DO ib_bdy=1, nb_bdy 
    5155 
    52          SELECT CASE( nn_dyn2d(ib_bdy) ) 
    53          CASE(jp_none) 
     56         SELECT CASE( cn_dyn2d(ib_bdy) ) 
     57         CASE('none') 
    5458            CYCLE 
    55          CASE(jp_frs) 
     59         CASE('frs') 
    5660            CALL bdy_dyn2d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy ) 
    57          CASE(jp_flather) 
     61         CASE('flather') 
    5862            CALL bdy_dyn2d_fla( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy ) 
     63         CASE('orlanski') 
     64            CALL bdy_dyn2d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.false. ) 
     65         CASE('orlanski_npo') 
     66            CALL bdy_dyn2d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.true. ) 
    5967         CASE DEFAULT 
    6068            CALL ctl_stop( 'bdy_dyn2d : unrecognised option for open boundaries for barotropic variables' ) 
    … …  
    9199         ij   = idx%nbj(jb,igrd) 
    92100         zwgt = idx%nbw(jb,igrd) 
    93          pu2d(ii,ij) = ( pu2d(ii,ij) + zwgt * ( dta%u2d(jb) - pu2d(ii,ij) ) ) * umask(ii,ij,1) 
     101         pua2d(ii,ij) = ( pua2d(ii,ij) + zwgt * ( dta%u2d(jb) - pua2d(ii,ij) ) ) * umask(ii,ij,1) 
    94102      END DO 
    95103      ! 
    … …  
    99107         ij   = idx%nbj(jb,igrd) 
    100108         zwgt = idx%nbw(jb,igrd) 
    101          pv2d(ii,ij) = ( pv2d(ii,ij) + zwgt * ( dta%v2d(jb) - pv2d(ii,ij) ) ) * vmask(ii,ij,1) 
     109         pva2d(ii,ij) = ( pva2d(ii,ij) + zwgt * ( dta%v2d(jb) - pva2d(ii,ij) ) ) * vmask(ii,ij,1) 
    102110      END DO  
    103       CALL lbc_bdy_lnk( pu2d, 'U', -1., ib_bdy )  
    104       CALL lbc_bdy_lnk( pv2d, 'V', -1., ib_bdy)   ! Boundary points should be updated 
     111      CALL lbc_bdy_lnk( pua2d, 'U', -1., ib_bdy )  
     112      CALL lbc_bdy_lnk( pva2d, 'V', -1., ib_bdy)   ! Boundary points should be updated 
    105113      ! 
    106114      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn2d_frs') 
    … …  
    135143      INTEGER  ::   jb, igrd                         ! dummy loop indices 
    136144      INTEGER  ::   ii, ij, iim1, iip1, ijm1, ijp1   ! 2D addresses 
     145      REAL(wp), POINTER :: flagu, flagv              ! short cuts 
    137146      REAL(wp) ::   zcorr                            ! Flather correction 
    138147      REAL(wp) ::   zforc                            ! temporary scalar 
    … …  
    152161      ! Fill temporary array with ssh data (here spgu): 
    153162      igrd = 1 
    154       spgu(:,:) = 0._wp 
     163      spgu(:,:) = 0.0 
    155164      DO jb = 1, idx%nblenrim(igrd) 
    156165         ii = idx%nbi(jb,igrd) 
    … …  
    165174         ii  = idx%nbi(jb,igrd) 
    166175         ij  = idx%nbj(jb,igrd)  
    167          iim1 = ii + MAX( 0, INT( idx%flagu(jb) ) )   ! T pts i-indice inside the boundary 
    168          iip1 = ii - MIN( 0, INT( idx%flagu(jb) ) )   ! T pts i-indice outside the boundary  
     176         flagu => idx%flagu(jb,igrd) 
     177         iim1 = ii + MAX( 0, INT( flagu ) )   ! T pts i-indice inside the boundary 
     178         iip1 = ii - MIN( 0, INT( flagu ) )   ! T pts i-indice outside the boundary  
    169179         ! 
    170          zcorr = - idx%flagu(jb) * SQRT( grav * phur(ii, ij) ) * ( pssh(iim1, ij) - spgu(iip1,ij) ) 
    171          ! bg jchanut tschanges: Set zflag to 0 below to revert to Flather scheme 
    172 !!         zforc = dta%u2d(jb) 
    173          zflag = ABS(idx%flagu(jb)) 
    174          iim1 = ii + idx%flagu(jb) 
    175          zforc = dta%u2d(jb) * (1._wp - z1_2*zflag) + z1_2 * zflag * pu2d(iim1,ij) 
    176          pu2d(ii,ij) = zforc + (1._wp - z1_2*zflag) * zcorr * umask(ii,ij,1)  
    177          ! end jchanut tschanges 
     180         zcorr = - flagu * SQRT( grav * phur(ii, ij) ) * ( pssh(iim1, ij) - spgu(iip1,ij) ) 
     181 
     182         ! jchanut tschanges: Set zflag to 0 below to revert to Flather scheme 
     183         ! Use characteristics method instead 
     184         zflag = ABS(flagu) 
     185         zforc = dta%u2d(jb) * (1._wp - z1_2*zflag) + z1_2 * zflag * pua2d(iim1,ij) 
     186         pua2d(ii,ij) = zforc + (1._wp - z1_2*zflag) * zcorr * umask(ii,ij,1)  
    178187      END DO 
    179188      ! 
    … …  
    183192         ii  = idx%nbi(jb,igrd) 
    184193         ij  = idx%nbj(jb,igrd)  
    185          ijm1 = ij + MAX( 0, INT( idx%flagv(jb) ) )   ! T pts j-indice inside the boundary 
    186          ijp1 = ij - MIN( 0, INT( idx%flagv(jb) ) )   ! T pts j-indice outside the boundary  
     194         flagv => idx%flagv(jb,igrd) 
     195         ijm1 = ij + MAX( 0, INT( flagv ) )   ! T pts j-indice inside the boundary 
     196         ijp1 = ij - MIN( 0, INT( flagv ) )   ! T pts j-indice outside the boundary  
    187197         ! 
    188          zcorr = - idx%flagv(jb) * SQRT( grav * phvr(ii, ij) ) * ( pssh(ii, ijm1) - spgu(ii,ijp1) ) 
    189          ! bg jchanut tschanges: Set zflag to 0 below to revert to std Flather scheme 
    190 !!         zforc = dta%v2d(jb) 
    191          zflag = ABS(idx%flagv(jb)) 
    192          ijm1 = ij + idx%flagv(jb) 
    193          zforc = dta%v2d(jb) * (1._wp - z1_2*zflag) + z1_2 * zflag * pv2d(ii,ijm1) 
    194          pv2d(ii,ij) = zforc + (1._wp - z1_2*zflag) * zcorr * vmask(ii,ij,1) 
    195          ! end jchanut tschanges 
    196       END DO 
    197       CALL lbc_bdy_lnk( pu2d, 'U', -1., ib_bdy )   ! Boundary points should be updated 
    198       CALL lbc_bdy_lnk( pv2d, 'V', -1., ib_bdy )   ! 
     198         zcorr = - flagv * SQRT( grav * phvr(ii, ij) ) * ( pssh(ii, ijm1) - spgu(ii,ijp1) ) 
     199 
     200         ! jchanut tschanges: Set zflag to 0 below to revert to std Flather scheme 
     201         ! Use characteristics method instead 
     202         zflag = ABS(flagv) 
     203         zforc  = dta%v2d(jb) * (1._wp - z1_2*zflag) + z1_2 * zflag * pva2d(ii,ijm1) 
     204         pva2d(ii,ij) = zforc + (1._wp - z1_2*zflag) * zcorr * vmask(ii,ij,1) 
     205      END DO 
     206      CALL lbc_bdy_lnk( pua2d, 'U', -1., ib_bdy )   ! Boundary points should be updated 
     207      CALL lbc_bdy_lnk( pva2d, 'V', -1., ib_bdy )   ! 
    199208      ! 
    200209      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn2d_fla') 
    201210      ! 
    202211   END SUBROUTINE bdy_dyn2d_fla 
     212 
     213 
     214   SUBROUTINE bdy_dyn2d_orlanski( idx, dta, ib_bdy, ll_npo ) 
     215      !!---------------------------------------------------------------------- 
     216      !!                 ***  SUBROUTINE bdy_dyn2d_orlanski  *** 
     217      !!              
     218      !!              - Apply Orlanski radiation condition adaptively: 
     219      !!                  - radiation plus weak nudging at outflow points 
     220      !!                  - no radiation and strong nudging at inflow points 
     221      !!  
     222      !! 
     223      !! References:  Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001)     
     224      !!---------------------------------------------------------------------- 
     225      TYPE(OBC_INDEX),              INTENT(in) ::   idx  ! OBC indices 
     226      TYPE(OBC_DATA),               INTENT(in) ::   dta  ! OBC external data 
     227      INTEGER,                      INTENT(in) ::   ib_bdy  ! number of current open boundary set 
     228      LOGICAL,                      INTENT(in) ::   ll_npo  ! flag for NPO version 
     229 
     230      INTEGER  ::   ib, igrd                               ! dummy loop indices 
     231      INTEGER  ::   ii, ij, iibm1, ijbm1                   ! indices 
     232      !!---------------------------------------------------------------------- 
     233 
     234      IF( nn_timing == 1 ) CALL timing_start('bdy_dyn2d_orlanski') 
     235      ! 
     236      igrd = 2      ! Orlanski bc on u-velocity;  
     237      !             
     238      CALL bdy_orlanski_2d( idx, igrd, pub2d, pua2d, dta%u2d, ll_npo ) 
     239 
     240      igrd = 3      ! Orlanski bc on v-velocity 
     241      !   
     242      CALL bdy_orlanski_2d( idx, igrd, pvb2d, pva2d, dta%v2d, ll_npo ) 
     243      ! 
     244      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn2d_orlanski') 
     245      ! 
     246      CALL lbc_bdy_lnk( pua2d, 'U', -1., ib_bdy )   ! Boundary points should be updated 
     247      CALL lbc_bdy_lnk( pva2d, 'V', -1., ib_bdy )   ! 
     248      ! 
     249      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn2d_orlanski') 
     250      ! 
     251   END SUBROUTINE bdy_dyn2d_orlanski 
    203252 
    204253   SUBROUTINE bdy_ssh( zssh ) 
    … …  
    248297 
    249298   END SUBROUTINE bdy_ssh 
     299 
    250300#else 
    251301   !!---------------------------------------------------------------------- 
    … …  
    257307      WRITE(*,*) 'bdy_dyn2d: You should not have seen this print! error?', kt 
    258308   END SUBROUTINE bdy_dyn2d 
     309 
    259310#endif 
    260311 
    261312   !!====================================================================== 
    262313END MODULE bdydyn2d 
     314 

  • branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn3d.F90

    r3703 r4254  
    1919   USE dom_oce         ! ocean space and time domain 
    2020   USE bdy_oce         ! ocean open boundary conditions 
     21   USE bdylib          ! for orlanski library routines 
    2122   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    2223   USE in_out_manager  ! 
    … …  
    5253      DO ib_bdy=1, nb_bdy 
    5354 
    54 !!$         IF ( using Orlanski radiation conditions ) THEN  
    55 !!$            CALL bdy_rad( kt,  bdyidx(ib_bdy) ) 
    56 !!$         ENDIF 
    57  
    58          SELECT CASE( nn_dyn3d(ib_bdy) ) 
    59          CASE(jp_none) 
     55         SELECT CASE( cn_dyn3d(ib_bdy) ) 
     56         CASE('none') 
    6057            CYCLE 
    61          CASE(jp_frs) 
     58         CASE('frs') 
    6259            CALL bdy_dyn3d_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 
    63          CASE(2) 
     60         CASE('specified') 
    6461            CALL bdy_dyn3d_spe( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 
    65          CASE(3) 
     62         CASE('zero') 
    6663            CALL bdy_dyn3d_zro( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 
     64         CASE('orlanski') 
     65            CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.false. ) 
     66         CASE('orlanski_npo') 
     67            CALL bdy_dyn3d_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy, ll_npo=.true. ) 
    6768         CASE DEFAULT 
    6869            CALL ctl_stop( 'bdy_dyn3d : unrecognised option for open boundaries for baroclinic velocities' ) 
    … …  
    109110         END DO 
    110111      END DO 
    111       CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy )   ;   CALL lbc_bdy_lnk( va, 'V', -1.,ib_bdy )   ! Boundary points should be updated 
     112      CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy )   ! Boundary points should be updated   
     113      CALL lbc_bdy_lnk( va, 'V', -1., ib_bdy )    
    112114      ! 
    113115      IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 
    … …  
    204206         END DO 
    205207      END DO  
    206       CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy )   ;   CALL lbc_bdy_lnk( va, 'V', -1.,ib_bdy )   ! Boundary points should be updated 
     208      CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy )    ! Boundary points should be updated 
     209      CALL lbc_bdy_lnk( va, 'V', -1., ib_bdy )    
    207210      ! 
    208211      IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 
    … …  
    211214 
    212215   END SUBROUTINE bdy_dyn3d_frs 
     216 
     217   SUBROUTINE bdy_dyn3d_orlanski( idx, dta, ib_bdy, ll_npo ) 
     218      !!---------------------------------------------------------------------- 
     219      !!                 ***  SUBROUTINE bdy_dyn3d_orlanski  *** 
     220      !!              
     221      !!              - Apply Orlanski radiation to baroclinic velocities.  
     222      !!              - Wrapper routine for bdy_orlanski_3d 
     223      !!  
     224      !! 
     225      !! References:  Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001)     
     226      !!---------------------------------------------------------------------- 
     227      TYPE(OBC_INDEX),              INTENT(in) ::   idx  ! OBC indices 
     228      TYPE(OBC_DATA),               INTENT(in) ::   dta  ! OBC external data 
     229      INTEGER,                      INTENT(in) ::   ib_bdy  ! BDY set index 
     230      LOGICAL,                      INTENT(in) ::   ll_npo  ! switch for NPO version 
     231 
     232      INTEGER  ::   jb, igrd                               ! dummy loop indices 
     233      !!---------------------------------------------------------------------- 
     234 
     235      IF( nn_timing == 1 ) CALL timing_start('bdy_dyn3d_orlanski') 
     236      ! 
     237      !! Note that at this stage the ub and ua arrays contain the baroclinic velocities.  
     238      ! 
     239      igrd = 2      ! Orlanski bc on u-velocity;  
     240      !             
     241      CALL bdy_orlanski_3d( idx, igrd, ub, ua, dta%u3d, ll_npo ) 
     242 
     243      igrd = 3      ! Orlanski bc on v-velocity 
     244      !   
     245      CALL bdy_orlanski_3d( idx, igrd, vb, va, dta%v3d, ll_npo ) 
     246      ! 
     247      CALL lbc_bdy_lnk( ua, 'U', -1., ib_bdy )    ! Boundary points should be updated 
     248      CALL lbc_bdy_lnk( va, 'V', -1., ib_bdy )    
     249      ! 
     250      IF( nn_timing == 1 ) CALL timing_stop('bdy_dyn3d_orlanski') 
     251      ! 
     252   END SUBROUTINE bdy_dyn3d_orlanski 
     253 
    213254 
    214255   SUBROUTINE bdy_dyn3d_dmp( kt ) 
    … …  
    232273      ! Remove barotropic part from before velocity 
    233274      !------------------------------------------------------- 
    234       CALL wrk_alloc(jpi,jpj,pu2d,pv2d)  
    235  
    236       pu2d(:,:) = 0.e0 
    237       pv2d(:,:) = 0.e0 
     275      CALL wrk_alloc(jpi,jpj,pub2d,pvb2d)  
     276 
     277      pub2d(:,:) = 0.e0 
     278      pvb2d(:,:) = 0.e0 
    238279 
    239280      DO jk = 1, jpkm1 
    240281#if defined key_vvl 
    241          pu2d(:,:) = pu2d(:,:) + fse3u_b(:,:,jk)* ub(:,:,jk)   *umask(:,:,jk)  
    242          pv2d(:,:) = pv2d(:,:) + fse3v_b(:,:,jk)* vb(:,:,jk)   *vmask(:,:,jk) 
     282         pub2d(:,:) = pub2d(:,:) + fse3u_b(:,:,jk)* ub(:,:,jk)   *umask(:,:,jk)  
     283         pvb2d(:,:) = pvb2d(:,:) + fse3v_b(:,:,jk)* vb(:,:,jk)   *vmask(:,:,jk) 
    243284#else 
    244          pu2d(:,:) = pu2d(:,:) + fse3u_0(:,:,jk) * ub(:,:,jk)  * umask(:,:,jk) 
    245          pv2d(:,:) = pv2d(:,:) + fse3v_0(:,:,jk) * vb(:,:,jk)  * vmask(:,:,jk) 
     285         pub2d(:,:) = pub2d(:,:) + fse3u_0(:,:,jk) * ub(:,:,jk)  * umask(:,:,jk) 
     286         pvb2d(:,:) = pvb2d(:,:) + fse3v_0(:,:,jk) * vb(:,:,jk)  * vmask(:,:,jk) 
    246287#endif 
    247288      END DO 
    248289 
    249290      IF( lk_vvl ) THEN 
    250          pu2d(:,:) = pu2d(:,:) * umask(:,:,1) / ( hu_0(:,:) + sshu_b(:,:) + 1._wp - umask(:,:,1) ) 
    251          pv2d(:,:) = pv2d(:,:) * vmask(:,:,1) / ( hv_0(:,:) + sshv_b(:,:) + 1._wp - vmask(:,:,1) ) 
     291         pub2d(:,:) = pub2d(:,:) * umask(:,:,1) / ( hu_0(:,:) + sshu_b(:,:) + 1._wp - umask(:,:,1) ) 
     292         pvb2d(:,:) = pvb2d(:,:) * vmask(:,:,1) / ( hv_0(:,:) + sshv_b(:,:) + 1._wp - vmask(:,:,1) ) 
    252293      ELSE 
    253          pu2d(:,:) = pv2d(:,:) * hur(:,:) 
    254          pv2d(:,:) = pu2d(:,:) * hvr(:,:) 
     294         pub2d(:,:) = pvb2d(:,:) * hur(:,:) 
     295         pvb2d(:,:) = pub2d(:,:) * hvr(:,:) 
    255296      ENDIF 
    256297 
    257298      DO ib_bdy=1, nb_bdy 
    258          IF ( ln_dyn3d_dmp(ib_bdy).and.nn_dyn3d(ib_bdy).gt.0 ) THEN 
     299         IF ( ln_dyn3d_dmp(ib_bdy) .and. cn_dyn3d(ib_bdy) /= 'none' ) THEN 
    259300            igrd = 2                      ! Relaxation of zonal velocity 
    260301            DO jb = 1, idx_bdy(ib_bdy)%nblen(igrd) 
    … …  
    264305               DO jk = 1, jpkm1 
    265306                  ua(ii,ij,jk) = ( ua(ii,ij,jk) + zwgt * ( dta_bdy(ib_bdy)%u3d(jb,jk) - & 
    266                                    ub(ii,ij,jk) + pu2d(ii,ij)) ) * umask(ii,ij,jk) 
     307                                   ub(ii,ij,jk) + pub2d(ii,ij)) ) * umask(ii,ij,jk) 
    267308               END DO 
    268309            END DO 
    … …  
    275316               DO jk = 1, jpkm1 
    276317                  va(ii,ij,jk) = ( va(ii,ij,jk) + zwgt * ( dta_bdy(ib_bdy)%v3d(jb,jk) -  & 
    277                                    vb(ii,ij,jk) + pv2d(ii,ij)) ) * vmask(ii,ij,jk) 
     318                                   vb(ii,ij,jk) + pvb2d(ii,ij)) ) * vmask(ii,ij,jk) 
    278319               END DO 
    279320            END DO 
    … …  
    281322      ENDDO 
    282323      ! 
    283       CALL wrk_dealloc(jpi,jpj,pu2d,pv2d)  
     324      CALL wrk_dealloc(jpi,jpj,pub2d,pvb2d)  
    284325      ! 
    285326      CALL lbc_lnk( ua, 'U', -1. )   ;   CALL lbc_lnk( va, 'V', -1. )   ! Boundary points should be updated 

  • branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim2.F90

    r3680 r4254  
    3232   !!---------------------------------------------------------------------- 
    3333   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    34    !! $Id: bdyice.F90 2715 2011-03-30 15:58:35Z rblod $ 
     34   !! $Id: bdyice_lim2.F90 4223 2013-11-15 17:21:46Z cbricaud $ 
    3535   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3636   !!---------------------------------------------------------------------- 
    … …  
    5050      DO ib_bdy=1, nb_bdy 
    5151 
    52          SELECT CASE( nn_ice_lim2(ib_bdy) ) 
    53          CASE(jp_none) 
     52         SELECT CASE( cn_ice_lim2(ib_bdy) ) 
     53         CASE('none') 
    5454            CYCLE 
    55          CASE(jp_frs) 
     55         CASE('frs') 
    5656            CALL bdy_ice_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ib_bdy ) 
    5757         CASE DEFAULT 
    … …  
    7676      INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index 
    7777      !! 
    78       INTEGER  ::   jb, jk, jgrd   ! dummy loop indices 
     78      INTEGER  ::   jb, jgrd   ! dummy loop indices 
    7979      INTEGER  ::   ii, ij         ! local scalar 
    8080      REAL(wp) ::   zwgt, zwgt1    ! local scalar 
    … …  
    8686      ! 
    8787      DO jb = 1, idx%nblen(jgrd) 
    88          DO jk = 1, jpkm1 
    8988            ii    = idx%nbi(jb,jgrd) 
    9089            ij    = idx%nbj(jb,jgrd) 
    … …  
    9493            hicif(ii,ij) = ( hicif(ii,ij) * zwgt1 + dta%hicif(jb) * zwgt ) * tmask(ii,ij,1)     ! Ice depth  
    9594            hsnif(ii,ij) = ( hsnif(ii,ij) * zwgt1 + dta%hsnif(jb) * zwgt ) * tmask(ii,ij,1)     ! Snow depth 
    96          END DO 
    9795      END DO  
    9896      CALL lbc_bdy_lnk( frld, 'T', 1., ib_bdy )                                         ! lateral boundary conditions 

  • branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90

    r4105 r4254  
    2121   !!   bdy_init       : Initialization of unstructured open boundaries 
    2222   !!---------------------------------------------------------------------- 
     23   USE wrk_nemo        ! Memory Allocation 
    2324   USE timing          ! Timing 
    2425   USE oce             ! ocean dynamics and tracers variables 
    … …  
    7980      INTEGER  ::   jpbdtau, jpbdtas                       !   -       - 
    8081      INTEGER  ::   ib_bdy1, ib_bdy2, ib1, ib2             !   -       - 
     82      INTEGER  ::   i_offset, j_offset                     !   -       - 
    8183      INTEGER, POINTER  ::  nbi, nbj, nbr                  ! short cuts 
    82       REAL   , POINTER  ::  flagu, flagv                   !    -   - 
     84      REAL(wp), POINTER  ::  flagu, flagv                  !    -   - 
     85      REAL(wp), POINTER, DIMENSION(:,:)       ::   pmask    ! pointer to 2D mask fields 
    8386      REAL(wp) ::   zefl, zwfl, znfl, zsfl                 ! local scalars 
    8487      INTEGER, DIMENSION (2)                  ::   kdimsz 
    … …  
    9093      INTEGER :: com_east_b, com_west_b, com_south_b, com_north_b  ! Flags for boundaries receiving 
    9194      INTEGER :: iw_b(4), ie_b(4), is_b(4), in_b(4)                ! Arrays for neighbours coordinates 
     95      REAL(wp), POINTER, DIMENSION(:,:)       ::   zfmask  ! temporary fmask array excluding coastal boundary condition (shlat) 
    9296 
    9397      !! 
    94       NAMELIST/nambdy/ nb_bdy, ln_coords_file, cn_coords_file,             & 
    95          &             ln_mask_file, cn_mask_file, nn_dyn2d, nn_dyn2d_dta, & 
    96          &             nn_dyn3d, nn_dyn3d_dta, nn_tra, nn_tra_dta,         &   
    97          &             ln_tra_dmp, ln_dyn3d_dmp, rn_time_dmp,             & 
     98      NAMELIST/nambdy/ nb_bdy, ln_coords_file, cn_coords_file,                 & 
     99         &             ln_mask_file, cn_mask_file, cn_dyn2d, nn_dyn2d_dta,    & 
     100         &             cn_dyn3d, nn_dyn3d_dta, cn_tra, nn_tra_dta,             &   
     101         &             ln_tra_dmp, ln_dyn3d_dmp, rn_time_dmp, rn_time_dmp_out, & 
    98102#if defined key_lim2 
    99          &             nn_ice_lim2, nn_ice_lim2_dta,                       & 
     103         &             cn_ice_lim2, nn_ice_lim2_dta,                           & 
    100104#endif 
    101105         &             ln_vol, nn_volctl, nn_rimwidth 
    … …  
    128132      ln_mask_file      = .false. 
    129133      cn_mask_file(:)   = '' 
    130       nn_dyn2d(:)       = 0 
     134      cn_dyn2d(:)       = '' 
    131135      nn_dyn2d_dta(:)   = -1  ! uninitialised flag 
    132       nn_dyn3d(:)       = 0 
     136      cn_dyn3d(:)       = '' 
    133137      nn_dyn3d_dta(:)   = -1  ! uninitialised flag 
    134       nn_tra(:)         = 0 
     138      cn_tra(:)         = '' 
    135139      nn_tra_dta(:)     = -1  ! uninitialised flag 
    136140      ln_tra_dmp(:)     = .false. 
    … …  
    138142      rn_time_dmp(:)    = 1. 
    139143#if defined key_lim2 
    140       nn_ice_lim2(:)    = 0 
     144      cn_ice_lim2(:)    = '' 
    141145      nn_ice_lim2_dta(:)= -1  ! uninitialised flag 
    142146#endif 
    … …  
    161165 
    162166      DO ib_bdy = 1,nb_bdy 
    163         icount = 0 ! flag to set max rimwidth to 1 if no relaxation 
    164167        IF(lwp) WRITE(numout,*) ' '  
    165168        IF(lwp) WRITE(numout,*) '------ Open boundary data set ',ib_bdy,'------'  
    … …  
    173176 
    174177        IF(lwp) WRITE(numout,*) 'Boundary conditions for barotropic solution:  ' 
    175         SELECT CASE( nn_dyn2d(ib_bdy) )                   
    176           CASE(jp_none)         ;   IF(lwp) WRITE(numout,*) '      no open boundary condition'         
    177           CASE(jp_frs)          ;   IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
    178           icount = icount + 1 
    179           CASE(jp_flather)      ;   IF(lwp) WRITE(numout,*) '      Flather radiation condition' 
    180           CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for nn_dyn2d' ) 
     178        SELECT CASE( cn_dyn2d(ib_bdy) )                   
     179          CASE('none')          
     180             IF(lwp) WRITE(numout,*) '      no open boundary condition'         
     181             dta_bdy(ib_bdy)%ll_ssh = .false. 
     182             dta_bdy(ib_bdy)%ll_u2d = .false. 
     183             dta_bdy(ib_bdy)%ll_v2d = .false. 
     184          CASE('frs')           
     185             IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
     186             dta_bdy(ib_bdy)%ll_ssh = .false. 
     187             dta_bdy(ib_bdy)%ll_u2d = .true. 
     188             dta_bdy(ib_bdy)%ll_v2d = .true. 
     189          CASE('flather')       
     190             IF(lwp) WRITE(numout,*) '      Flather radiation condition' 
     191             dta_bdy(ib_bdy)%ll_ssh = .true. 
     192             dta_bdy(ib_bdy)%ll_u2d = .true. 
     193             dta_bdy(ib_bdy)%ll_v2d = .true. 
     194          CASE('orlanski')      
     195             IF(lwp) WRITE(numout,*) '      Orlanski (fully oblique) radiation condition with adaptive nudging' 
     196             dta_bdy(ib_bdy)%ll_ssh = .false. 
     197             dta_bdy(ib_bdy)%ll_u2d = .true. 
     198             dta_bdy(ib_bdy)%ll_v2d = .true. 
     199          CASE('orlanski_npo')  
     200             IF(lwp) WRITE(numout,*) '      Orlanski (NPO) radiation condition with adaptive nudging' 
     201             dta_bdy(ib_bdy)%ll_ssh = .false. 
     202             dta_bdy(ib_bdy)%ll_u2d = .true. 
     203             dta_bdy(ib_bdy)%ll_v2d = .true. 
     204          CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for cn_dyn2d' ) 
    181205        END SELECT 
    182         IF( nn_dyn2d(ib_bdy) .gt. 0 ) THEN 
     206        IF( cn_dyn2d(ib_bdy) /= 'none' ) THEN 
    183207           SELECT CASE( nn_dyn2d_dta(ib_bdy) )                   !  
    184208              CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      initial state used for bdy data'         
    … …  
    195219 
    196220        IF(lwp) WRITE(numout,*) 'Boundary conditions for baroclinic velocities:  ' 
    197         SELECT CASE( nn_dyn3d(ib_bdy) )                   
    198           CASE(jp_none)  ;   IF(lwp) WRITE(numout,*) '      no open boundary condition'         
    199           CASE(jp_frs)   ;   IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
    200           icount = icount + 1 
    201           CASE( 2 )      ;   IF(lwp) WRITE(numout,*) '      Specified value' 
    202           CASE( 3 )      ;   IF(lwp) WRITE(numout,*) '      Zero baroclinic velocities (runoff case)' 
    203           CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for nn_dyn3d' ) 
     221        SELECT CASE( cn_dyn3d(ib_bdy) )                   
     222          CASE('none') 
     223             IF(lwp) WRITE(numout,*) '      no open boundary condition'         
     224             dta_bdy(ib_bdy)%ll_u3d = .false. 
     225             dta_bdy(ib_bdy)%ll_v3d = .false. 
     226          CASE('frs')        
     227             IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
     228             dta_bdy(ib_bdy)%ll_u3d = .true. 
     229             dta_bdy(ib_bdy)%ll_v3d = .true. 
     230          CASE('specified') 
     231             IF(lwp) WRITE(numout,*) '      Specified value' 
     232             dta_bdy(ib_bdy)%ll_u3d = .true. 
     233             dta_bdy(ib_bdy)%ll_v3d = .true. 
     234          CASE('zero') 
     235             IF(lwp) WRITE(numout,*) '      Zero baroclinic velocities (runoff case)' 
     236             dta_bdy(ib_bdy)%ll_u3d = .false. 
     237             dta_bdy(ib_bdy)%ll_v3d = .false. 
     238          CASE('orlanski') 
     239             IF(lwp) WRITE(numout,*) '      Orlanski (fully oblique) radiation condition with adaptive nudging' 
     240             dta_bdy(ib_bdy)%ll_u3d = .true. 
     241             dta_bdy(ib_bdy)%ll_v3d = .true. 
     242          CASE('orlanski_npo') 
     243             IF(lwp) WRITE(numout,*) '      Orlanski (NPO) radiation condition with adaptive nudging' 
     244             dta_bdy(ib_bdy)%ll_u3d = .true. 
     245             dta_bdy(ib_bdy)%ll_v3d = .true. 
     246          CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for cn_dyn3d' ) 
    204247        END SELECT 
    205         IF( nn_dyn3d(ib_bdy) .gt. 0 ) THEN 
     248        IF( cn_dyn3d(ib_bdy) /= 'none' ) THEN 
    206249           SELECT CASE( nn_dyn3d_dta(ib_bdy) )                   !  
    207250              CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      initial state used for bdy data'         
    … …  
    212255 
    213256        IF ( ln_dyn3d_dmp(ib_bdy) ) THEN 
    214            IF ( nn_dyn3d(ib_bdy).EQ.0 ) THEN 
     257           IF ( cn_dyn3d(ib_bdy) == 'none' ) THEN 
    215258              IF(lwp) WRITE(numout,*) 'No open boundary condition for baroclinic velocities: ln_dyn3d_dmp is set to .false.' 
    216259              ln_dyn3d_dmp(ib_bdy)=.false. 
    217            ELSEIF ( nn_dyn3d(ib_bdy).EQ.1 ) THEN 
     260           ELSEIF ( cn_dyn3d(ib_bdy) == 'frs' ) THEN 
    218261              CALL ctl_stop( 'Use FRS OR relaxation' ) 
    219262           ELSE 
    220               icount = icount + 1 
    221263              IF(lwp) WRITE(numout,*) '      + baroclinic velocities relaxation zone' 
    222264              IF(lwp) WRITE(numout,*) '      Damping time scale: ',rn_time_dmp(ib_bdy),' days' 
    223265              IF((lwp).AND.rn_time_dmp(ib_bdy)<0) CALL ctl_stop( 'Time scale must be positive' ) 
     266              dta_bdy(ib_bdy)%ll_u3d = .true. 
     267              dta_bdy(ib_bdy)%ll_v3d = .true. 
    224268           ENDIF 
    225269        ELSE 
    … …  
    229273 
    230274        IF(lwp) WRITE(numout,*) 'Boundary conditions for temperature and salinity:  ' 
    231         SELECT CASE( nn_tra(ib_bdy) )                   
    232           CASE(jp_none)  ;   IF(lwp) WRITE(numout,*) '      no open boundary condition'         
    233           CASE(jp_frs)   ;   IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
    234           icount = icount + 1 
    235           CASE( 2 )      ;   IF(lwp) WRITE(numout,*) '      Specified value' 
    236           CASE( 3 )      ;   IF(lwp) WRITE(numout,*) '      Neumann conditions' 
    237           CASE( 4 )      ;   IF(lwp) WRITE(numout,*) '      Runoff conditions : Neumann for T and specified to 0.1 for salinity' 
    238           CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for nn_tra' ) 
     275        SELECT CASE( cn_tra(ib_bdy) )                   
     276          CASE('none') 
     277             IF(lwp) WRITE(numout,*) '      no open boundary condition'         
     278             dta_bdy(ib_bdy)%ll_tem = .false. 
     279             dta_bdy(ib_bdy)%ll_sal = .false. 
     280          CASE('frs') 
     281             IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
     282             dta_bdy(ib_bdy)%ll_tem = .true. 
     283             dta_bdy(ib_bdy)%ll_sal = .true. 
     284          CASE('specified') 
     285             IF(lwp) WRITE(numout,*) '      Specified value' 
     286             dta_bdy(ib_bdy)%ll_tem = .true. 
     287             dta_bdy(ib_bdy)%ll_sal = .true. 
     288          CASE('neumann') 
     289             IF(lwp) WRITE(numout,*) '      Neumann conditions' 
     290             dta_bdy(ib_bdy)%ll_tem = .false. 
     291             dta_bdy(ib_bdy)%ll_sal = .false. 
     292          CASE('runoff') 
     293             IF(lwp) WRITE(numout,*) '      Runoff conditions : Neumann for T and specified to 0.1 for salinity' 
     294             dta_bdy(ib_bdy)%ll_tem = .false. 
     295             dta_bdy(ib_bdy)%ll_sal = .false. 
     296          CASE('orlanski') 
     297             IF(lwp) WRITE(numout,*) '      Orlanski (fully oblique) radiation condition with adaptive nudging' 
     298             dta_bdy(ib_bdy)%ll_tem = .true. 
     299             dta_bdy(ib_bdy)%ll_sal = .true. 
     300          CASE('orlanski_npo') 
     301             IF(lwp) WRITE(numout,*) '      Orlanski (NPO) radiation condition with adaptive nudging' 
     302             dta_bdy(ib_bdy)%ll_tem = .true. 
     303             dta_bdy(ib_bdy)%ll_sal = .true. 
     304          CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for cn_tra' ) 
    239305        END SELECT 
    240         IF( nn_tra(ib_bdy) .gt. 0 ) THEN 
     306        IF( cn_tra(ib_bdy) /= 'none' ) THEN 
    241307           SELECT CASE( nn_tra_dta(ib_bdy) )                   !  
    242308              CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      initial state used for bdy data'         
    … …  
    247313 
    248314        IF ( ln_tra_dmp(ib_bdy) ) THEN 
    249            IF ( nn_tra(ib_bdy).EQ.0 ) THEN 
     315           IF ( cn_tra(ib_bdy) == 'none' ) THEN 
    250316              IF(lwp) WRITE(numout,*) 'No open boundary condition for tracers: ln_tra_dmp is set to .false.' 
    251317              ln_tra_dmp(ib_bdy)=.false. 
    252            ELSEIF ( nn_tra(ib_bdy).EQ.1 ) THEN 
     318           ELSEIF ( cn_tra(ib_bdy) == 'frs' ) THEN 
    253319              CALL ctl_stop( 'Use FRS OR relaxation' ) 
    254320           ELSE 
    255               icount = icount + 1 
    256321              IF(lwp) WRITE(numout,*) '      + T/S relaxation zone' 
    257322              IF(lwp) WRITE(numout,*) '      Damping time scale: ',rn_time_dmp(ib_bdy),' days' 
     323              IF(lwp) WRITE(numout,*) '      Outflow damping time scale: ',rn_time_dmp_out(ib_bdy),' days' 
    258324              IF((lwp).AND.rn_time_dmp(ib_bdy)<0) CALL ctl_stop( 'Time scale must be positive' ) 
     325              dta_bdy(ib_bdy)%ll_tem = .true. 
     326              dta_bdy(ib_bdy)%ll_sal = .true. 
    259327           ENDIF 
    260328        ELSE 
    … …  
    265333#if defined key_lim2 
    266334        IF(lwp) WRITE(numout,*) 'Boundary conditions for sea ice:  ' 
    267         SELECT CASE( nn_ice_lim2(ib_bdy) )                   
    268           CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      no open boundary condition'         
    269           CASE( 1 )      ;   IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
    270           icount = icount + 1 
    271           CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for nn_tra' ) 
     335        SELECT CASE( cn_ice_lim2(ib_bdy) )                   
     336          CASE('none') 
     337             IF(lwp) WRITE(numout,*) '      no open boundary condition'         
     338             dta_bdy(ib_bdy)%ll_frld  = .false. 
     339             dta_bdy(ib_bdy)%ll_hicif = .false. 
     340             dta_bdy(ib_bdy)%ll_hsnif = .false. 
     341          CASE('frs') 
     342             IF(lwp) WRITE(numout,*) '      Flow Relaxation Scheme' 
     343             dta_bdy(ib_bdy)%ll_frld  = .true. 
     344             dta_bdy(ib_bdy)%ll_hicif = .true. 
     345             dta_bdy(ib_bdy)%ll_hsnif = .true. 
     346          CASE DEFAULT   ;   CALL ctl_stop( 'unrecognised value for cn_ice_lim2' ) 
    272347        END SELECT 
    273         IF( nn_ice_lim2(ib_bdy) .gt. 0 ) THEN  
     348        IF( cn_ice_lim2(ib_bdy) /= 'none' ) THEN  
    274349           SELECT CASE( nn_ice_lim2_dta(ib_bdy) )                   !  
    275350              CASE( 0 )      ;   IF(lwp) WRITE(numout,*) '      initial state used for bdy data'         
    … …  
    280355        IF(lwp) WRITE(numout,*) 
    281356#endif 
    282         IF ( icount>0 ) THEN 
    283            IF(lwp) WRITE(numout,*) '      Width of relaxation zone = ', nn_rimwidth(ib_bdy) 
    284            IF(lwp) WRITE(numout,*) 
    285         ELSE 
    286            nn_rimwidth(ib_bdy) = 1 ! no relaxation 
    287         ENDIF 
     357 
     358        IF(lwp) WRITE(numout,*) '      Width of relaxation zone = ', nn_rimwidth(ib_bdy) 
     359        IF(lwp) WRITE(numout,*) 
    288360 
    289361      ENDDO 
    … …  
    456528         ENDIF  
    457529 
    458       ENDDO      
     530      ENDDO       
    459531     
    460532      ! 2. Now fill indices corresponding to straight open boundary arrays: 
    … …  
    754826               IF(lwp) THEN         ! Since all procs read global data only need to do this check on one proc... 
    755827                  IF( nbrdta(ib,igrd,ib_bdy) < nbrdta(ibm1,igrd,ib_bdy) ) THEN 
    756                      CALL ctl_stop('bdy_init : ERROR : boundary data in file  & 
    757                                     must be defined in order of distance from edge nbr.', & 
    758                                    'A utility for re-ordering boundary coordinates and data & 
    759                                     files exists in the TOOLS/OBC directory') 
     828                     CALL ctl_stop('bdy_init : ERROR : boundary data in file must be defined in order of distance from edge nbr.', & 
     829                                   'A utility for re-ordering boundary coordinates and data files exists in the TOOLS/OBC directory') 
    760830                  ENDIF     
    761831               ENDIF 
    762832               ! check if point is in local domain 
    763833               IF(  nbidta(ib,igrd,ib_bdy) >= iw .AND. nbidta(ib,igrd,ib_bdy) <= ie .AND.   & 
    764                   & nbjdta(ib,igrd,ib_bdy) >= is .AND. nbjdta(ib,igrd,ib_bdy) <= in .AND.   & 
    765                   & nbrdta(ib,igrd,ib_bdy) <= nn_rimwidth(ib_bdy)     ) THEN       
     834                  & nbjdta(ib,igrd,ib_bdy) >= is .AND. nbjdta(ib,igrd,ib_bdy) <= in       ) THEN 
    766835                  ! 
    767836                  icount = icount  + 1 
    … …  
    776845         ! Allocate index arrays for this boundary set 
    777846         !-------------------------------------------- 
    778  
    779          ilen1 = MAXVAL(idx_bdy(ib_bdy)%nblen(1:jpbgrd)) 
    780          ilen1 = MAX(1,ilen1) 
     847         ilen1 = MAXVAL(idx_bdy(ib_bdy)%nblen(:)) 
    781848         ALLOCATE( idx_bdy(ib_bdy)%nbi(ilen1,jpbgrd) ) 
    782849         ALLOCATE( idx_bdy(ib_bdy)%nbj(ilen1,jpbgrd) ) 
    783850         ALLOCATE( idx_bdy(ib_bdy)%nbr(ilen1,jpbgrd) ) 
    784851         ALLOCATE( idx_bdy(ib_bdy)%nbd(ilen1,jpbgrd) ) 
     852         ALLOCATE( idx_bdy(ib_bdy)%nbdout(ilen1,jpbgrd) ) 
    785853         ALLOCATE( idx_bdy(ib_bdy)%nbmap(ilen1,jpbgrd) ) 
    786854         ALLOCATE( idx_bdy(ib_bdy)%nbw(ilen1,jpbgrd) ) 
    787          ALLOCATE( idx_bdy(ib_bdy)%flagu(ilen1) ) 
    788          ALLOCATE( idx_bdy(ib_bdy)%flagv(ilen1) ) 
     855         ALLOCATE( idx_bdy(ib_bdy)%flagu(ilen1,jpbgrd) ) 
     856         ALLOCATE( idx_bdy(ib_bdy)%flagv(ilen1,jpbgrd) ) 
    789857 
    790858         ! Dispatch mapping indices and discrete distances on each processor 
    … …  
    9541022            ENDDO 
    9551023         ENDDO  
     1024 
    9561025         ! definition of the i- and j- direction local boundaries arrays 
    9571026         ! used for sending the boudaries 
    … …  
    10081077               idx_bdy(ib_bdy)%nbd(ib,igrd) = 1. / ( rn_time_dmp(ib_bdy) * rday ) &  
    10091078               & *(FLOAT(nn_rimwidth(ib_bdy)+1-nbr)/FLOAT(nn_rimwidth(ib_bdy)))**2.   ! quadratic 
     1079               idx_bdy(ib_bdy)%nbdout(ib,igrd) = 1. / ( rn_time_dmp_out(ib_bdy) * rday ) &  
     1080               & *(FLOAT(nn_rimwidth(ib_bdy)+1-nbr)/FLOAT(nn_rimwidth(ib_bdy)))**2.   ! quadratic 
    10101081            END DO 
    10111082         END DO  
    … …  
    10211092      ! bdytmask = 1  on the computational domain AND on open boundaries 
    10221093      !          = 0  elsewhere    
    1023       bdytmask(:,:) = 1.e0 
    1024       bdyumask(:,:) = 1.e0 
    1025       bdyvmask(:,:) = 1.e0 
    1026  
     1094  
    10271095      IF( ln_mask_file ) THEN 
    10281096         CALL iom_open( cn_mask_file, inum ) 
    … …  
    10691137       
    10701138      bdytmask(:,:) = tmask(:,:,1) 
     1139      IF( .not. ln_mask_file ) THEN 
     1140         ! If .not. ln_mask_file then we need to derive mask on U and V grid  
     1141         ! from mask on T grid here. 
     1142         bdyumask(:,:) = 0.e0 
     1143         bdyvmask(:,:) = 0.e0 
     1144         DO ij=1, jpjm1 
     1145            DO ii=1, jpim1 
     1146               bdyumask(ii,ij)=bdytmask(ii,ij)*bdytmask(ii+1, ij ) 
     1147               bdyvmask(ii,ij)=bdytmask(ii,ij)*bdytmask(ii  ,ij+1)   
     1148            END DO 
     1149         END DO 
     1150         CALL lbc_lnk( bdyumask(:,:), 'U', 1. )   ;   CALL lbc_lnk( bdyvmask(:,:), 'V', 1. )      ! Lateral boundary cond. 
     1151      ENDIF 
    10711152 
    10721153      ! bdy masks and bmask are now set to zero on boundary points: 
    … …  
    10991180      ENDDO 
    11001181 
     1182      ! For the flagu/flagv calculation below we require a version of fmask without 
     1183      ! the land boundary condition (shlat) included: 
     1184      CALL wrk_alloc(jpi,jpj,zfmask)  
     1185      DO ij = 2, jpjm1 
     1186         DO ii = 2, jpim1 
     1187            zfmask(ii,ij) = tmask(ii,ij  ,1) * tmask(ii+1,ij  ,1)   & 
     1188           &              * tmask(ii,ij+1,1) * tmask(ii+1,ij+1,1) 
     1189         END DO       
     1190      END DO 
     1191 
    11011192      ! Lateral boundary conditions 
     1193      CALL lbc_lnk( zfmask       , 'F', 1. ) 
    11021194      CALL lbc_lnk( fmask        , 'F', 1. )   ;   CALL lbc_lnk( bdytmask(:,:), 'T', 1. ) 
    11031195      CALL lbc_lnk( bdyumask(:,:), 'U', 1. )   ;   CALL lbc_lnk( bdyvmask(:,:), 'V', 1. ) 
    … …  
    11051197      DO ib_bdy = 1, nb_bdy       ! Indices and directions of rim velocity components 
    11061198 
    1107          idx_bdy(ib_bdy)%flagu(:) = 0.e0 
    1108          idx_bdy(ib_bdy)%flagv(:) = 0.e0 
     1199         idx_bdy(ib_bdy)%flagu(:,:) = 0.e0 
     1200         idx_bdy(ib_bdy)%flagv(:,:) = 0.e0 
    11091201         icount = 0  
    11101202 
    1111          !flagu = -1 : u component is normal to the dynamical boundary but its direction is outward 
    1112          !flagu =  0 : u is tangential 
    1113          !flagu =  1 : u is normal to the boundary and is direction is inward 
     1203         ! Calculate relationship of U direction to the local orientation of the boundary 
     1204         ! flagu = -1 : u component is normal to the dynamical boundary and its direction is outward 
     1205         ! flagu =  0 : u is tangential 
     1206         ! flagu =  1 : u is normal to the boundary and is direction is inward 
    11141207   
    1115          igrd = 2      ! u-component  
    1116          DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)   
    1117             nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 
    1118             nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 
    1119             zefl = bdytmask(nbi  ,nbj) 
    1120             zwfl = bdytmask(nbi+1,nbj) 
    1121             IF( zefl + zwfl == 2 ) THEN 
    1122                icount = icount + 1 
    1123             ELSE 
    1124                idx_bdy(ib_bdy)%flagu(ib)=-zefl+zwfl 
    1125             ENDIF 
     1208         DO igrd = 1,jpbgrd  
     1209            SELECT CASE( igrd ) 
     1210               CASE( 1 ) 
     1211                  pmask => umask(:,:,1) 
     1212                  i_offset = 0 
     1213               CASE( 2 )  
     1214                  pmask => bdytmask 
     1215                  i_offset = 1 
     1216               CASE( 3 )  
     1217                  pmask => zfmask(:,:) 
     1218                  i_offset = 0 
     1219            END SELECT  
     1220            icount = 0 
     1221            DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)   
     1222               nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 
     1223               nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 
     1224               zefl = pmask(nbi+i_offset-1,nbj) 
     1225               zwfl = pmask(nbi+i_offset,nbj) 
     1226               ! This error check only works if you are using the bdyXmask arrays 
     1227               IF( i_offset == 1 .and. zefl + zwfl == 2 ) THEN 
     1228                  icount = icount + 1 
     1229                  IF(lwp) WRITE(numout,*) 'Problem with igrd = ',igrd,' at (global) nbi, nbj : ',mig(nbi),mjg(nbj) 
     1230               ELSE 
     1231                  idx_bdy(ib_bdy)%flagu(ib,igrd) = -zefl + zwfl 
     1232               ENDIF 
     1233            END DO 
     1234            IF( icount /= 0 ) THEN 
     1235               IF(lwp) WRITE(numout,*) 
     1236               IF(lwp) WRITE(numout,*) ' E R R O R : Some ',cgrid(igrd),' grid points,',   & 
     1237                  ' are not boundary points (flagu calculation). Check nbi, nbj, indices for boundary set ',ib_bdy 
     1238               IF(lwp) WRITE(numout,*) ' ========== ' 
     1239               IF(lwp) WRITE(numout,*) 
     1240               nstop = nstop + 1 
     1241            ENDIF  
    11261242         END DO 
    11271243 
    1128          !flagv = -1 : u component is normal to the dynamical boundary but its direction is outward 
    1129          !flagv =  0 : u is tangential 
    1130          !flagv =  1 : u is normal to the boundary and is direction is inward 
    1131  
    1132          igrd = 3      ! v-component 
    1133          DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)   
    1134             nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 
    1135             nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 
    1136             znfl = bdytmask(nbi,nbj  ) 
    1137             zsfl = bdytmask(nbi,nbj+1) 
    1138             IF( znfl + zsfl == 2 ) THEN 
    1139                icount = icount + 1 
    1140             ELSE 
    1141                idx_bdy(ib_bdy)%flagv(ib) = -znfl + zsfl 
    1142             END IF 
     1244         ! Calculate relationship of V direction to the local orientation of the boundary 
     1245         ! flagv = -1 : v component is normal to the dynamical boundary but its direction is outward 
     1246         ! flagv =  0 : v is tangential 
     1247         ! flagv =  1 : v is normal to the boundary and is direction is inward 
     1248 
     1249         DO igrd = 1,jpbgrd  
     1250            SELECT CASE( igrd ) 
     1251               CASE( 1 ) 
     1252                  pmask => vmask(:,:,1) 
     1253                  j_offset = 0 
     1254               CASE( 2 ) 
     1255                  pmask => zfmask(:,:) 
     1256                  j_offset = 0 
     1257               CASE( 3 ) 
     1258                  pmask => bdytmask 
     1259                  j_offset = 1 
     1260            END SELECT  
     1261            icount = 0 
     1262            DO ib = 1, idx_bdy(ib_bdy)%nblenrim(igrd)   
     1263               nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 
     1264               nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 
     1265               znfl = pmask(nbi,nbj+j_offset-1  ) 
     1266               zsfl = pmask(nbi,nbj+j_offset) 
     1267               ! This error check only works if you are using the bdyXmask arrays 
     1268               IF( j_offset == 1 .and. znfl + zsfl == 2 ) THEN 
     1269                  IF(lwp) WRITE(numout,*) 'Problem with igrd = ',igrd,' at (global) nbi, nbj : ',mig(nbi),mjg(nbj) 
     1270                  icount = icount + 1 
     1271               ELSE 
     1272                  idx_bdy(ib_bdy)%flagv(ib,igrd) = -znfl + zsfl 
     1273               END IF 
     1274            END DO 
     1275            IF( icount /= 0 ) THEN 
     1276               IF(lwp) WRITE(numout,*) 
     1277               IF(lwp) WRITE(numout,*) ' E R R O R : Some ',cgrid(igrd),' grid points,',   & 
     1278                  ' are not boundary points (flagv calculation). Check nbi, nbj, indices for boundary set ',ib_bdy 
     1279               IF(lwp) WRITE(numout,*) ' ========== ' 
     1280               IF(lwp) WRITE(numout,*) 
     1281               nstop = nstop + 1 
     1282            ENDIF  
    11431283         END DO 
    11441284 
    1145          IF( icount /= 0 ) THEN 
    1146             IF(lwp) WRITE(numout,*) 
    1147             IF(lwp) WRITE(numout,*) ' E R R O R : Some data velocity points,',   & 
    1148                ' are not boundary points. Check nbi, nbj, indices for boundary set ',ib_bdy 
    1149             IF(lwp) WRITE(numout,*) ' ========== ' 
    1150             IF(lwp) WRITE(numout,*) 
    1151             nstop = nstop + 1 
    1152          ENDIF  
    1153      
    1154       ENDDO 
     1285      END DO 
    11551286 
    11561287      ! Compute total lateral surface for volume correction: 
    … …  
    11641295               nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 
    11651296               nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 
    1166                flagu => idx_bdy(ib_bdy)%flagu(ib) 
     1297               flagu => idx_bdy(ib_bdy)%flagu(ib,igrd) 
    11671298               bdysurftot = bdysurftot + hu     (nbi  , nbj)                           & 
    11681299                  &                    * e2u    (nbi  , nbj) * ABS( flagu ) & 
    … …  
    11771308               nbi => idx_bdy(ib_bdy)%nbi(ib,igrd) 
    11781309               nbj => idx_bdy(ib_bdy)%nbj(ib,igrd) 
    1179                flagv => idx_bdy(ib_bdy)%flagv(ib) 
     1310               flagv => idx_bdy(ib_bdy)%flagv(ib,igrd) 
    11801311               bdysurftot = bdysurftot + hv     (nbi, nbj  )                           & 
    11811312                  &                    * e1v    (nbi, nbj  ) * ABS( flagv ) & 
    … …  
    11931324         DEALLOCATE(nbidta, nbjdta, nbrdta) 
    11941325      ENDIF 
     1326 
     1327      CALL wrk_dealloc(jpi,jpj,zfmask)  
    11951328 
    11961329      IF( nn_timing == 1 ) CALL timing_stop('bdy_init') 
    … …  
    15871720      itest = 0 
    15881721 
    1589       IF (nn_dyn2d(ib1)/=nn_dyn2d(ib2)) itest = itest + 1 
    1590       IF (nn_dyn3d(ib1)/=nn_dyn3d(ib2)) itest = itest + 1 
    1591       IF (nn_tra(ib1)/=nn_tra(ib2)) itest = itest + 1 
     1722      IF (cn_dyn2d(ib1)/=cn_dyn2d(ib2)) itest = itest + 1 
     1723      IF (cn_dyn3d(ib1)/=cn_dyn3d(ib2)) itest = itest + 1 
     1724      IF (cn_tra(ib1)/=cn_tra(ib2)) itest = itest + 1 
    15921725      ! 
    15931726      IF (nn_dyn2d_dta(ib1)/=nn_dyn2d_dta(ib2)) itest = itest + 1 

  • branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90

    r4105 r4254  
    132132            ! JC: If FRS scheme is used, we assume that tidal is needed over the whole 
    133133            ! relaxation area       
    134             IF( nn_dyn2d(ib_bdy) .eq. jp_frs ) THEN 
     134            IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN 
    135135               ilen0(:)=nblen(:) 
    136136            ELSE 
    … …  
    414414 
    415415         ! line below should be simplified (runoff case) 
    416          IF (( nn_dyn2d_dta(ib_bdy) .ge. 2 ).AND.(nn_tra(ib_bdy).NE.4)) THEN 
     416!! CHANUT: TO BE SORTED OUT 
     417!!         IF (( nn_dyn2d_dta(ib_bdy) .ge. 2 ).AND.(nn_tra(ib_bdy).NE.4)) THEN 
     418         IF ( nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN 
    417419 
    418420            nblen(1:jpbgrd) = idx_bdy(ib_bdy)%nblen(1:jpbgrd) 
    419421            nblenrim(1:jpbgrd) = idx_bdy(ib_bdy)%nblenrim(1:jpbgrd) 
    420422 
    421             IF( nn_dyn2d(ib_bdy) .eq. jp_frs ) THEN 
     423            IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN 
    422424               ilen0(:)=nblen(:) 
    423425            ELSE 
    … …  
    604606   !!====================================================================== 
    605607END MODULE bdytides 
     608 

  • branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90

    r3777 r4254  
    2020   USE dom_oce         ! ocean space and time domain variables  
    2121   USE bdy_oce         ! ocean open boundary conditions 
     22   USE bdylib          ! for orlanski library routines 
    2223   USE bdydta, ONLY:   bf 
    2324   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 
    … …  
    5152      DO ib_bdy=1, nb_bdy 
    5253 
    53          SELECT CASE( nn_tra(ib_bdy) ) 
    54          CASE(jp_none) 
     54         SELECT CASE( cn_tra(ib_bdy) ) 
     55         CASE('none') 
    5556            CYCLE 
    56          CASE(jp_frs) 
     57         CASE('frs') 
    5758            CALL bdy_tra_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 
    58          CASE(2) 
     59         CASE('specified') 
    5960            CALL bdy_tra_spe( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 
    60          CASE(3) 
     61         CASE('neumann') 
    6162            CALL bdy_tra_nmn( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 
    62          CASE(4) 
     63         CASE('orlanski') 
     64            CALL bdy_tra_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ll_npo=.false. ) 
     65         CASE('orlanski_npo') 
     66            CALL bdy_tra_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ll_npo=.true. ) 
     67         CASE('runoff') 
    6368            CALL bdy_tra_rnf( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 
    6469         CASE DEFAULT 
    … …  
    196201      ! 
    197202   END SUBROUTINE bdy_tra_nmn 
     203  
     204 
     205   SUBROUTINE bdy_tra_orlanski( idx, dta, ll_npo ) 
     206      !!---------------------------------------------------------------------- 
     207      !!                 ***  SUBROUTINE bdy_tra_orlanski  *** 
     208      !!              
     209      !!              - Apply Orlanski radiation to temperature and salinity.  
     210      !!              - Wrapper routine for bdy_orlanski_3d 
     211      !!  
     212      !! 
     213      !! References:  Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001)     
     214      !!---------------------------------------------------------------------- 
     215      TYPE(OBC_INDEX),              INTENT(in) ::   idx  ! OBC indices 
     216      TYPE(OBC_DATA),               INTENT(in) ::   dta  ! OBC external data 
     217      LOGICAL,                      INTENT(in) ::   ll_npo  ! switch for NPO version 
     218 
     219      INTEGER  ::   igrd                                    ! grid index 
     220      !!---------------------------------------------------------------------- 
     221 
     222      IF( nn_timing == 1 ) CALL timing_start('bdy_tra_orlanski') 
     223      ! 
     224      igrd = 1      ! Orlanski bc on temperature;  
     225      !             
     226      CALL bdy_orlanski_3d( idx, igrd, tsb(:,:,:,jp_tem), tsa(:,:,:,jp_tem), dta%tem, ll_npo ) 
     227 
     228      igrd = 1      ! Orlanski bc on salinity; 
     229      !   
     230      CALL bdy_orlanski_3d( idx, igrd, tsb(:,:,:,jp_sal), tsa(:,:,:,jp_sal), dta%sal, ll_npo ) 
     231      ! 
     232      IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_orlanski') 
     233      ! 
     234 
     235   END SUBROUTINE bdy_tra_orlanski 
     236 
    198237 
    199238   SUBROUTINE bdy_tra_rnf( idx, dta, kt ) 

  • branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90

    r3294 r4254  
    104104               ii = idx%nbi(jb,jgrd) 
    105105               ij = idx%nbj(jb,jgrd) 
    106                zubtpecor = zubtpecor + idx%flagu(jb) * ua(ii,ij, jk) * e2u(ii,ij) * fse3u(ii,ij,jk) 
     106               zubtpecor = zubtpecor + idx%flagu(jb,jgrd) * ua(ii,ij, jk) * e2u(ii,ij) * fse3u(ii,ij,jk) 
    107107            END DO 
    108108         END DO 
    … …  
    112112               ii = idx%nbi(jb,jgrd) 
    113113               ij = idx%nbj(jb,jgrd) 
    114                zubtpecor = zubtpecor + idx%flagv(jb) * va(ii,ij, jk) * e1v(ii,ij) * fse3v(ii,ij,jk)  
     114               zubtpecor = zubtpecor + idx%flagv(jb,jgrd) * va(ii,ij, jk) * e1v(ii,ij) * fse3v(ii,ij,jk)  
    115115            END DO 
    116116         END DO 
    … …  
    136136               ii = idx%nbi(jb,jgrd) 
    137137               ij = idx%nbj(jb,jgrd) 
    138                ua(ii,ij,jk) = ua(ii,ij,jk) - idx%flagu(jb) * zubtpecor * umask(ii,ij,jk) 
    139                ztranst = ztranst + idx%flagu(jb) * ua(ii,ij,jk) * e2u(ii,ij) * fse3u(ii,ij,jk) 
     138               ua(ii,ij,jk) = ua(ii,ij,jk) - idx%flagu(jb,jgrd) * zubtpecor * umask(ii,ij,jk) 
     139               ztranst = ztranst + idx%flagu(jb,jgrd) * ua(ii,ij,jk) * e2u(ii,ij) * fse3u(ii,ij,jk) 
    140140            END DO 
    141141         END DO 
    … …  
    145145               ii = idx%nbi(jb,jgrd) 
    146146               ij = idx%nbj(jb,jgrd) 
    147                va(ii,ij,jk) = va(ii,ij,jk) -idx%flagv(jb) * zubtpecor * vmask(ii,ij,jk) 
    148                ztranst = ztranst + idx%flagv(jb) * va(ii,ij,jk) * e1v(ii,ij) * fse3v(ii,ij,jk) 
     147               va(ii,ij,jk) = va(ii,ij,jk) -idx%flagv(jb,jgrd) * zubtpecor * vmask(ii,ij,jk) 
     148               ztranst = ztranst + idx%flagv(jb,jgrd) * va(ii,ij,jk) * e1v(ii,ij) * fse3v(ii,ij,jk) 
    149149            END DO 
    150150         END DO 

  • branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90

    r3865 r4254  
    117117   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  gphit, gphiu   !: latitude  of t-, u-, v- and f-points (degre) 
    118118   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  gphiv, gphif   !: 
    119    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  e1t, e2t       !: horizontal scale factors at t-point (m) 
    120    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  e1u, e2u       !: horizontal scale factors at u-point (m) 
    121    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  e1v, e2v       !: horizontal scale factors at v-point (m) 
    122    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  e1f, e2f       !: horizontal scale factors at f-point (m) 
     119   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::  e1t, e2t       !: horizontal scale factors at t-point (m) 
     120   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::  e1u, e2u       !: horizontal scale factors at u-point (m) 
     121   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::  e1v, e2v       !: horizontal scale factors at v-point (m) 
     122   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::  e1f, e2f       !: horizontal scale factors at f-point (m) 
    123123   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  e1e2t          !: surface at t-point (m2) 
    124124   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ff             !: coriolis factor (2.*omega*sin(yphi) ) (s-1) 
    … …  
    203203   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   bmask              !: land/ocean mask of barotropic stream function 
    204204 
    205    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tmask, umask, vmask, fmask   !: land/ocean mask at T-, U-, V- and F-pts 
     205   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: tmask, umask, vmask, fmask   !: land/ocean mask at T-, U-, V- and F-pts 
    206206 
    207207   REAL(wp), PUBLIC, DIMENSION(jpiglo) ::   tpol, fpol                         !: north fold mask (jperio= 3 or 4) 

  • branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/DOM/domvvl.F90

    r3951 r4254  
    930930      !!  
    931931      !                                                ! ===================== 
    932       IF( cp_cfg == "orca" .AND. jp_cfg == 3 ) THEN    ! ORCA R2 configuration 
     932      IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration 
    933933         !                                             ! ===================== 
    934934      !! acc 

  • branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_oce.F90

    r3294 r4254  
    3939   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   hur_e , hvr_e    ! inverse of hu_e and hv_e 
    4040   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:), TARGET ::   sshn_b           ! before field without time-filter 
     41   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ua_b, va_b     ! after  averaged velocities 
     42   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   un_b, vn_b     ! now    averaged velocities 
     43   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ub_b, vb_b     ! before averaged velocities 
     44   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   un_adv, vn_adv ! Advection vel. at "now" barocl. step 
     45   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ub2_b,  vb2_b  ! Advection vel. at "now-0.5" barocl. step 
    4146 
    4247   !!---------------------------------------------------------------------- 
    … …  
    5358      ALLOCATE( sshn_e(jpi,jpj) , ua_e(jpi,jpj) , hu_e(jpi,jpj) , hur_e(jpi,jpj) ,      & 
    5459         &      ssha_e(jpi,jpj) , va_e(jpi,jpj) , hv_e(jpi,jpj) , hvr_e(jpi,jpj) ,      & 
     60         &      ub_b(jpi,jpj)   , vb_b(jpi,jpj) , un_b(jpi,jpj) , vn_b(jpi,jpj)  ,      & 
     61         &      ua_b(jpi,jpj)   , va_b(jpi,jpj)                                  ,      &  
     62         &      ub2_b(jpi,jpj)  , vb2_b(jpi,jpj)                                 ,      & 
     63         &      un_adv(jpi,jpj) , vn_adv(jpi,jpj)                                ,      & 
    5564         &      sshn_b(jpi,jpj)                                                  , STAT = dynspg_oce_alloc ) 
    5665         ! 

  • branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_ts.F90

    r4246 r4254  
    4343   USE sbcapr          ! surface boundary condition: atmospheric pressure 
    4444   USE dynadv, ONLY: ln_dynadv_vec 
     45#if defined key_agrif 
     46   USE agrif_opa_interp ! agrif 
     47#endif 
    4548 
    4649 
    … …  
    105108      ierr(:) = 0 
    106109 
    107       ALLOCATE( ub_b(jpi,jpj)  , vb_b(jpi,jpj)   , & 
    108          &      un_b(jpi,jpj)  , vn_b(jpi,jpj)   , & 
    109          &      ua_b(jpi,jpj)  , va_b(jpi,jpj)   , & 
    110          &      un_adv(jpi,jpj), vn_adv(jpi,jpj) , & 
    111          &      sshb_e(jpi,jpj), sshbb_e(jpi,jpj), & 
     110      ALLOCATE( sshb_e(jpi,jpj), sshbb_e(jpi,jpj), & 
    112111         &      ub_e(jpi,jpj)  , vb_e(jpi,jpj)   , & 
    113          &      ubb_e(jpi,jpj) , vbb_e(jpi,jpj)  , & 
    114          &      wgtbtp1(3*nn_baro), wgtbtp2(3*nn_baro), &  
    115          &      zwz(jpi,jpj), STAT= ierr(1) ) 
    116  
    117       IF( ln_bt_fw )      ALLOCATE( ub2_b(jpi,jpj), vb2_b(jpi,jpj), STAT=ierr(2) ) 
     112         &      ubb_e(jpi,jpj) , vbb_e(jpi,jpj)  , STAT= ierr(1) ) 
     113 
     114      ALLOCATE( wgtbtp1(3*nn_baro), wgtbtp2(3*nn_baro), zwz(jpi,jpj), STAT= ierr(2) ) 
    118115 
    119116      IF( ln_dynvor_een ) ALLOCATE( ftnw(jpi,jpj) , ftne(jpi,jpj) , &  
    … …  
    626623         IF (lk_bdy) CALL bdy_ssh( ssha_e ) 
    627624#endif 
     625#if defined key_agrif 
     626         IF( .NOT.Agrif_Root() ) CALL agrif_ssh_ts( jn ) 
     627#endif 
    628628         !   
    629629         ! Sea Surface Height at u-,v-points (vvl case only) 
    … …  
    815815         phur => hur_e 
    816816         phvr => hvr_e 
    817          pu2d => ua_e 
    818          pv2d => va_e 
     817         pua2d => ua_e 
     818         pva2d => va_e 
     819         pub2d => zun_e 
     820         pvb2d => zvn_e 
    819821                                       
    820822         IF( lk_bdy )   CALL bdy_dyn2d( kt )               ! open boundaries 
     823#endif 
     824#if defined key_agrif 
     825         IF( .NOT.Agrif_Root() ) CALL agrif_dyn_ts( kt, jn ) ! Agrif 
    821826#endif 
    822827         !                                             !* Swap 

  • branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90

    r4250 r4254  
    3131   USE obc_oce 
    3232   USE bdy_oce 
     33   USE bdy_par          
     34   USE bdydyn2d        ! bdy_ssh routine 
    3335   USE diaar5, ONLY:   lk_diaar5 
    3436   USE iom 
    … …  
    125127#endif 
    126128#if defined key_bdy 
    127       ssha(:,:) = ssha(:,:) * bdytmask(:,:) 
    128       CALL lbc_lnk( ssha, 'T', 1. )  
    129 #endif 
     129      ! bg jchanut tschanges 
     130      ! These lines are not necessary with time splitting since 
     131      ! boundary condition on sea level is set during ts loop 
     132      IF (lk_bdy) THEN 
     133         CALL lbc_lnk( ssha, 'T', 1. ) ! Not sure that's necessary 
     134         CALL bdy_ssh( ssha ) ! Duplicate sea level across open boundaries 
     135      ENDIF 
     136#endif 
     137      ! end jchanut tschanges 
    130138#if defined key_asminc 
    131139      !                                                ! Include the IAU weighted SSH increment 

  • branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/SETTE/sette.sh

    r3708 r4254  
    594594    set_namelist namelist ln_ctl .false. 
    595595    set_namelist namelist ln_clobber .true. 
    596     set_namelist namelist nn_dyn2d 2 
    597     set_namelist namelist nn_tra_dta 0 
    598596    set_namelist namelist cn_ocerst_in \"amm12.restart_20070101\" 
    599597    set_namelist namelist jpni 8 
    … …  
    612610    set_namelist namelist ln_ctl .false. 
    613611    set_namelist namelist ln_clobber .true. 
    614     set_namelist namelist nn_dyn2d 2 
    615     set_namelist namelist nn_tra_dta 0 
    616612    set_namelist namelist jpni 8 
    617613    set_namelist namelist jpnj 4 
    … …  
    649645    set_namelist namelist ln_ctl .false. 
    650646    set_namelist namelist ln_clobber .true. 
    651     set_namelist namelist nn_dyn2d 2 
    652     set_namelist namelist nn_tra_dta 0 
    653647    set_namelist namelist cn_ocerst_in \"amm12.restart_20070101\" 
    654648    set_namelist namelist jpni 8 
    … …  
    668662    set_namelist namelist nn_fwb 0 
    669663    set_namelist namelist ln_ctl .false. 
    670     set_namelist namelist nn_dyn2d 2 
    671     set_namelist namelist nn_tra_dta 0 
    672664    set_namelist namelist ln_clobber .true. 
    673665    set_namelist namelist cn_ocerst_in \"amm12.restart_20070101\" 
Note: See TracChangeset for help on using the changeset viewer.