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 5948 for branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/OPA_SRC/BDY – NEMO

Ignore:
Timestamp:
2015-11-30T11:47:24+01:00 (8 years ago)
Author:
timgraham
Message:

Merged in head of trunk (r5936)

Location:
branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/OPA_SRC/BDY
Files:
8 edited

Legend:

Unmodified
Added
Removed

  • branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/OPA_SRC/BDY/bdy_oce.F90

    r5947 r5948  
    88   !!            3.3  !  2010-09  (D. Storkey) add ice boundary conditions 
    99   !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge 
    10    !!            3.6  !  2012-01  (C. Rousset) add ice boundary conditions for lim3 
     10   !!            3.6  !  2014-01  (C. Rousset) add ice boundary conditions for lim3 
    1111   !!---------------------------------------------------------------------- 
    1212#if defined key_bdy  
    … …  
    2222 
    2323   TYPE, PUBLIC ::   OBC_INDEX    !: Indices and weights which define the open boundary 
    24       INTEGER,          DIMENSION(jpbgrd) ::  nblen 
    25       INTEGER,          DIMENSION(jpbgrd) ::  nblenrim 
    26       INTEGER, POINTER, DIMENSION(:,:)   ::  nbi 
    27       INTEGER, POINTER, DIMENSION(:,:)   ::  nbj 
    28       INTEGER, POINTER, DIMENSION(:,:)   ::  nbr 
    29       INTEGER, POINTER, DIMENSION(:,:)   ::  nbmap 
    30       REAL(wp)   , POINTER, DIMENSION(:,:)   ::  nbw 
    31       REAL(wp)   , POINTER, DIMENSION(:,:)   ::  nbd 
    32       REAL(wp)   , POINTER, DIMENSION(:,:)   ::  nbdout 
    33       REAL(wp)   , POINTER, DIMENSION(:,:)   ::  flagu 
    34       REAL(wp)   , POINTER, DIMENSION(:,:)   ::  flagv 
     24      INTEGER ,          DIMENSION(jpbgrd) ::  nblen 
     25      INTEGER ,          DIMENSION(jpbgrd) ::  nblenrim 
     26      INTEGER , POINTER, DIMENSION(:,:)    ::  nbi 
     27      INTEGER , POINTER, DIMENSION(:,:)    ::  nbj 
     28      INTEGER , POINTER, DIMENSION(:,:)    ::  nbr 
     29      INTEGER , POINTER, DIMENSION(:,:)    ::  nbmap 
     30      REAL(wp), POINTER, DIMENSION(:,:)    ::  nbw 
     31      REAL(wp), POINTER, DIMENSION(:,:)    ::  nbd 
     32      REAL(wp), POINTER, DIMENSION(:,:)    ::  nbdout 
     33      REAL(wp), POINTER, DIMENSION(:,:)    ::  flagu 
     34      REAL(wp), POINTER, DIMENSION(:,:)    ::  flagv 
    3535   END TYPE OBC_INDEX 
    3636 
    … …  
    4141 
    4242   TYPE, PUBLIC ::   OBC_DATA     !: Storage for external data 
    43       INTEGER,       DIMENSION(2)     ::  nread 
    44       LOGICAL                         ::  ll_ssh 
    45       LOGICAL                         ::  ll_u2d 
    46       LOGICAL                         ::  ll_v2d 
    47       LOGICAL                         ::  ll_u3d 
    48       LOGICAL                         ::  ll_v3d 
    49       LOGICAL                         ::  ll_tem 
    50       LOGICAL                         ::  ll_sal 
    51       REAL(wp), POINTER, DIMENSION(:)     ::  ssh 
    52       REAL(wp), POINTER, DIMENSION(:)     ::  u2d 
    53       REAL(wp), POINTER, DIMENSION(:)     ::  v2d 
    54       REAL(wp), POINTER, DIMENSION(:,:)   ::  u3d 
    55       REAL(wp), POINTER, DIMENSION(:,:)   ::  v3d 
    56       REAL(wp), POINTER, DIMENSION(:,:)   ::  tem 
    57       REAL(wp), POINTER, DIMENSION(:,:)   ::  sal 
     43      INTEGER          , DIMENSION(2)   ::  nread 
     44      LOGICAL                           ::  ll_ssh 
     45      LOGICAL                           ::  ll_u2d 
     46      LOGICAL                           ::  ll_v2d 
     47      LOGICAL                           ::  ll_u3d 
     48      LOGICAL                           ::  ll_v3d 
     49      LOGICAL                           ::  ll_tem 
     50      LOGICAL                           ::  ll_sal 
     51      REAL(wp), POINTER, DIMENSION(:)   ::  ssh 
     52      REAL(wp), POINTER, DIMENSION(:)   ::  u2d 
     53      REAL(wp), POINTER, DIMENSION(:)   ::  v2d 
     54      REAL(wp), POINTER, DIMENSION(:,:) ::  u3d 
     55      REAL(wp), POINTER, DIMENSION(:,:) ::  v3d 
     56      REAL(wp), POINTER, DIMENSION(:,:) ::  tem 
     57      REAL(wp), POINTER, DIMENSION(:,:) ::  sal 
    5858#if defined key_lim2 
    59       LOGICAL                         ::  ll_frld 
    60       LOGICAL                         ::  ll_hicif 
    61       LOGICAL                         ::  ll_hsnif 
    62       REAL(wp), POINTER, DIMENSION(:)     ::  frld 
    63       REAL(wp), POINTER, DIMENSION(:)     ::  hicif 
    64       REAL(wp), POINTER, DIMENSION(:)     ::  hsnif 
     59      LOGICAL                           ::   ll_frld 
     60      LOGICAL                           ::   ll_hicif 
     61      LOGICAL                           ::   ll_hsnif 
     62      REAL(wp), POINTER, DIMENSION(:)   ::   frld 
     63      REAL(wp), POINTER, DIMENSION(:)   ::   hicif 
     64      REAL(wp), POINTER, DIMENSION(:)   ::   hsnif 
    6565#elif defined key_lim3 
    66       LOGICAL                         ::  ll_a_i 
    67       LOGICAL                         ::  ll_ht_i 
    68       LOGICAL                         ::  ll_ht_s 
    69       REAL, POINTER, DIMENSION(:,:)   ::  a_i   !: now ice leads fraction climatology 
    70       REAL, POINTER, DIMENSION(:,:)   ::  ht_i  !: Now ice  thickness climatology 
    71       REAL, POINTER, DIMENSION(:,:)   ::  ht_s  !: now snow thickness 
     66      LOGICAL                           ::   ll_a_i 
     67      LOGICAL                           ::   ll_ht_i 
     68      LOGICAL                           ::   ll_ht_s 
     69      REAL(wp), POINTER, DIMENSION(:,:) ::   a_i    !: now ice leads fraction climatology 
     70      REAL(wp), POINTER, DIMENSION(:,:) ::   ht_i   !: Now ice  thickness climatology 
     71      REAL(wp), POINTER, DIMENSION(:,:) ::   ht_s   !: now snow thickness 
    7272#endif 
    7373   END TYPE OBC_DATA 
    … …  
    9999   INTEGER, DIMENSION(jp_bdy)           ::   nn_tra_dta     !: = 0 use the initial state as bdy dta ;  
    100100                                                            !: = 1 read it in a NetCDF file 
    101    LOGICAL, DIMENSION(jp_bdy) ::   ln_tra_dmp               !: =T Tracer damping 
    102    LOGICAL, DIMENSION(jp_bdy) ::   ln_dyn3d_dmp             !: =T Baroclinic velocity damping 
    103    REAL(wp),    DIMENSION(jp_bdy) ::   rn_time_dmp              !: Damping time scale in days 
    104    REAL(wp),    DIMENSION(jp_bdy) ::   rn_time_dmp_out          !: Damping time scale in days at radiation outflow points 
     101   LOGICAL , DIMENSION(jp_bdy) ::   ln_tra_dmp              !: =T Tracer damping 
     102   LOGICAL , DIMENSION(jp_bdy) ::   ln_dyn3d_dmp            !: =T Baroclinic velocity damping 
     103   REAL(wp), DIMENSION(jp_bdy) ::   rn_time_dmp             !: Damping time scale in days 
     104   REAL(wp), DIMENSION(jp_bdy) ::   rn_time_dmp_out         !: Damping time scale in days at radiation outflow points 
    105105 
    106106   CHARACTER(len=20), DIMENSION(jp_bdy) ::   cn_ice_lim       ! Choice of boundary condition for sea ice variables  
    107    INTEGER, DIMENSION(jp_bdy)           ::   nn_ice_lim_dta   !: = 0 use the initial state as bdy dta ;  
     107   INTEGER , DIMENSION(jp_bdy)          ::   nn_ice_lim_dta   !: = 0 use the initial state as bdy dta ;  
    108108                                                              !: = 1 read it in a NetCDF file 
    109    REAL(wp),    DIMENSION(jp_bdy) ::   rn_ice_tem             !: choice of the temperature of incoming sea ice 
    110    REAL(wp),    DIMENSION(jp_bdy) ::   rn_ice_sal             !: choice of the salinity    of incoming sea ice 
    111    REAL(wp),    DIMENSION(jp_bdy) ::   rn_ice_age             !: choice of the age         of incoming sea ice 
     109   REAL(wp), DIMENSION(jp_bdy) ::   rn_ice_tem              !: choice of the temperature of incoming sea ice 
     110   REAL(wp), DIMENSION(jp_bdy) ::   rn_ice_sal              !: choice of the salinity    of incoming sea ice 
     111   REAL(wp), DIMENSION(jp_bdy) ::   rn_ice_age              !: choice of the age         of incoming sea ice 
    112112   ! 
    113113    

  • branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/OPA_SRC/BDY/bdydta.F90

    r5947 r5948  
    2929   USE iom             ! IOM library 
    3030   USE in_out_manager  ! I/O logical units 
    31    USE dynspg_oce, ONLY: lk_dynspg_ts ! Split-explicit free surface flag 
    3231#if defined key_lim2 
    3332   USE ice_2 
    … …  
    388387      END DO  ! ib_bdy 
    389388 
    390       ! bg jchanut tschanges 
    391389#if defined key_tide 
    392       ! Add tides if not split-explicit free surface else this is done in ts loop 
    393       IF (.NOT.lk_dynspg_ts) CALL bdy_dta_tides( kt=kt, time_offset=time_offset ) 
    394 #endif 
    395       ! end jchanut tschanges 
     390      IF (ln_dynspg_ts) THEN      ! Fill temporary arrays with slow-varying bdy data                            
     391         DO ib_bdy = 1, nb_bdy    ! Tidal component added in ts loop 
     392            IF ( nn_dyn2d_dta(ib_bdy) .ge. 2 ) THEN 
     393               nblen => idx_bdy(ib_bdy)%nblen 
     394               nblenrim => idx_bdy(ib_bdy)%nblenrim 
     395               IF( cn_dyn2d(ib_bdy) == 'frs' ) THEN; ilen1(:)=nblen(:) ; ELSE ; ilen1(:)=nblenrim(:) ; ENDIF  
     396               IF ( dta_bdy(ib_bdy)%ll_ssh ) dta_bdy_s(ib_bdy)%ssh(1:ilen1(1)) = dta_bdy(ib_bdy)%ssh(1:ilen1(1)) 
     397               IF ( dta_bdy(ib_bdy)%ll_u2d ) dta_bdy_s(ib_bdy)%u2d(1:ilen1(2)) = dta_bdy(ib_bdy)%u2d(1:ilen1(2)) 
     398               IF ( dta_bdy(ib_bdy)%ll_v2d ) dta_bdy_s(ib_bdy)%v2d(1:ilen1(3)) = dta_bdy(ib_bdy)%v2d(1:ilen1(3)) 
     399            ENDIF 
     400         END DO 
     401      ELSE ! Add tides if not split-explicit free surface else this is done in ts loop 
     402         ! 
     403         CALL bdy_dta_tides( kt=kt, time_offset=time_offset ) 
     404      ENDIF 
     405#endif 
    396406 
    397407      IF ( ln_apr_obc ) THEN 
    … …  
    423433      !!                 
    424434      !!---------------------------------------------------------------------- 
    425       USE dynspg_oce, ONLY: lk_dynspg_ts 
    426435      !! 
    427436      INTEGER     ::  ib_bdy, jfld, jstart, jend, ierror  ! local indices 
    … …  
    430439      CHARACTER(len=100)                     ::   cn_dir        ! Root directory for location of data files 
    431440      CHARACTER(len=100), DIMENSION(nb_bdy)  ::   cn_dir_array  ! Root directory for location of data files 
     441      CHARACTER(len = 256)::   clname                           ! temporary file name 
    432442      LOGICAL                                ::   ln_full_vel   ! =T => full velocities in 3D boundary data 
    433443                                                                ! =F => baroclinic velocities in 3D boundary data 
    … …  
    669679            ! sea ice 
    670680            IF( nn_ice_lim_dta(ib_bdy) .eq. 1 ) THEN 
    671  
    672681               ! Test for types of ice input (lim2 or lim3)  
    673                CALL iom_open ( bn_a_i%clname, inum ) 
    674                id1 = iom_varid ( inum, bn_a_i%clvar, kdimsz=zdimsz, kndims=zndims, ldstop = .FALSE. ) 
     682               ! Build file name to find dimensions  
     683               clname=TRIM(bn_a_i%clname) 
     684               IF( .NOT. bn_a_i%ln_clim ) THEN    
     685                                                  WRITE(clname, '(a,"_y",i4.4)' ) TRIM( bn_a_i%clname ), nyear    ! add year 
     686                  IF( bn_a_i%cltype /= 'yearly' ) WRITE(clname, '(a,"m" ,i2.2)' ) TRIM( clname        ), nmonth   ! add month 
     687               ELSE 
     688                  IF( bn_a_i%cltype /= 'yearly' ) WRITE(clname, '(a,"_m",i2.2)' ) TRIM( bn_a_i%clname ), nmonth   ! add month 
     689               ENDIF 
     690               IF( bn_a_i%cltype == 'daily' .OR. bn_a_i%cltype(1:4) == 'week' ) & 
     691               &                                  WRITE(clname, '(a,"d" ,i2.2)' ) TRIM( clname        ), nday     ! add day 
     692               ! 
     693               CALL iom_open  ( clname, inum ) 
     694               id1 = iom_varid( inum, bn_a_i%clvar, kdimsz=zdimsz, kndims=zndims, ldstop = .FALSE. ) 
    675695               CALL iom_close ( inum ) 
    676                !CALL fld_clopn ( bn_a_i, nyear, nmonth, nday, ldstop=.TRUE. ) 
    677                !CALL iom_open ( bn_a_i%clname, inum ) 
    678                !id1 = iom_varid ( bn_a_i%num, bn_a_i%clvar, kdimsz=zdimsz, kndims=zndims, ldstop = .FALSE. ) 
     696 
    679697                IF ( zndims == 4 ) THEN 
    680698                 ll_bdylim3 = .TRUE.   ! lim3 input 

  • branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn.F90

    r5947 r5948  
    2424   USE oce             ! ocean dynamics and tracers  
    2525   USE dom_oce         ! ocean space and time domain 
    26    USE dynspg_oce       
    2726   USE bdy_oce         ! ocean open boundary conditions 
    2827   USE bdydyn2d        ! open boundary conditions for barotropic solution 
    … …  
    3534   PRIVATE 
    3635 
    37    PUBLIC   bdy_dyn     ! routine called in dynspg_flt (if lk_dynspg_flt) or  
    38                         ! dyn_nxt (if lk_dynspg_ts or lk_dynspg_exp) 
     36   PUBLIC   bdy_dyn    ! routine called in dyn_nxt 
    3937 
    4038#  include "domzgr_substitute.h90" 

  • branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/OPA_SRC/BDY/bdydyn2d.F90

    r5947 r5948  
    2323   USE bdy_oce         ! ocean open boundary conditions 
    2424   USE bdylib          ! BDY library routines 
    25    USE dynspg_oce      ! for barotropic variables 
    2625   USE phycst          ! physical constants 
    2726   USE lbclnk          ! ocean lateral boundary conditions (or mpp link) 

  • branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/OPA_SRC/BDY/bdyice_lim.F90

    r5947 r5948  
    5959      !! 
    6060      !!---------------------------------------------------------------------- 
    61       INTEGER, INTENT( in ) :: kt     ! Main time step counter 
    62       INTEGER               :: ib_bdy ! Loop index 
    63  
     61      INTEGER, INTENT( in ) ::   kt   ! Main time step counter 
     62      ! 
     63      INTEGER ::   ib_bdy   ! Loop index 
     64      !!---------------------------------------------------------------------- 
     65      ! 
    6466#if defined key_lim3 
    6567      CALL lim_var_glo2eqv 
    6668#endif 
    67  
     69      ! 
    6870      DO ib_bdy=1, nb_bdy 
    69  
     71         ! 
    7072         SELECT CASE( cn_ice_lim(ib_bdy) ) 
    7173         CASE('none') 
    … …  
    7678            CALL ctl_stop( 'bdy_ice_lim : unrecognised option for open boundaries for ice fields' ) 
    7779         END SELECT 
    78  
     80         ! 
    7981      END DO 
    80  
     82      ! 
    8183#if defined key_lim3 
    8284      CALL lim_var_zapsmall 
    8385      CALL lim_var_agg(1) 
    8486#endif 
    85  
     87      ! 
    8688   END SUBROUTINE bdy_ice_lim 
     89 
    8790 
    8891   SUBROUTINE bdy_ice_frs( idx, dta, kt, ib_bdy ) 
    … …  
    9699      !!             dimensional baroclinic ocean model with realistic topography. Tellus, 365-382. 
    97100      !!------------------------------------------------------------------------------ 
    98       TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
    99       TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data 
    100       INTEGER,         INTENT(in) ::   kt   ! main time-step counter 
     101      TYPE(OBC_INDEX), INTENT(in) ::   idx     ! OBC indices 
     102      TYPE(OBC_DATA),  INTENT(in) ::   dta     ! OBC external data 
     103      INTEGER,         INTENT(in) ::   kt      ! main time-step counter 
    101104      INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index 
    102  
     105      ! 
    103106      INTEGER  ::   jpbound            ! 0 = incoming ice 
    104                                        ! 1 = outgoing ice 
     107      !                                ! 1 = outgoing ice 
    105108      INTEGER  ::   jb, jk, jgrd, jl   ! dummy loop indices 
    106109      INTEGER  ::   ji, jj, ii, ij     ! local scalar 
    107110      REAL(wp) ::   zwgt, zwgt1        ! local scalar 
    108111      REAL(wp) ::   ztmelts, zdh 
    109  
    110       !!------------------------------------------------------------------------------ 
    111       ! 
    112       IF( nn_timing == 1 ) CALL timing_start('bdy_ice_frs') 
     112#if  defined key_lim2 && ! defined key_lim2_vp && defined key_agrif 
     113     USE ice_2, vt_s => hsnm 
     114     USE ice_2, vt_i => hicm 
     115#endif 
     116      !!------------------------------------------------------------------------------ 
     117      ! 
     118      IF( nn_timing == 1 )   CALL timing_start('bdy_ice_frs') 
    113119      ! 
    114120      jgrd = 1      ! Everything is at T-points here 
    … …  
    177183            ! condition on ice thickness depends on the ice velocity 
    178184            ! if velocity is outward (strictly), then ice thickness, volume... must be equal to adjacent values 
    179             jpbound = 0; ii = ji; ij = jj; 
    180  
     185            jpbound = 0   ;   ii = ji   ;   ij = jj 
     186            ! 
    181187            IF( u_ice(ji+1,jj  ) < 0. .AND. umask(ji-1,jj  ,1) == 0. ) jpbound = 1; ii = ji+1; ij = jj 
    182188            IF( u_ice(ji-1,jj  ) > 0. .AND. umask(ji+1,jj  ,1) == 0. ) jpbound = 1; ii = ji-1; ij = jj 
    183189            IF( v_ice(ji  ,jj+1) < 0. .AND. vmask(ji  ,jj-1,1) == 0. ) jpbound = 1; ii = ji  ; ij = jj+1 
    184190            IF( v_ice(ji  ,jj-1) > 0. .AND. vmask(ji  ,jj+1,1) == 0. ) jpbound = 1; ii = ji  ; ij = jj-1 
    185  
     191            ! 
    186192            IF( nn_ice_lim_dta(ib_bdy) == 0 ) jpbound = 0; ii = ji; ij = jj   ! case ice boundaries = initial conditions 
    187                                                                               !      do not make state variables dependent on velocity 
    188                 
    189  
     193            !                                                                 !      do not make state variables dependent on velocity 
     194            ! 
    190195            rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ii,ij) - 0.01 ) ) ! 0 if no ice 
    191  
     196            ! 
    192197            ! concentration and thickness 
    193198            a_i (ji,jj,jl) = a_i (ii,ij,jl) * rswitch 
    194199            ht_i(ji,jj,jl) = ht_i(ii,ij,jl) * rswitch 
    195200            ht_s(ji,jj,jl) = ht_s(ii,ij,jl) * rswitch 
    196  
     201            ! 
    197202            ! Ice and snow volumes 
    198203            v_i(ji,jj,jl) = ht_i(ji,jj,jl) * a_i(ji,jj,jl) 
    199204            v_s(ji,jj,jl) = ht_s(ji,jj,jl) * a_i(ji,jj,jl) 
    200  
     205            ! 
    201206            SELECT CASE( jpbound ) 
    202  
    203             CASE( 0 ) ! velocity is inward 
    204  
     207            ! 
     208            CASE( 0 )   ! velocity is inward 
     209               ! 
    205210               ! Ice salinity, age, temperature 
    206211               sm_i(ji,jj,jl)   = rswitch * rn_ice_sal(ib_bdy)  + ( 1.0 - rswitch ) * rn_simin 
    … …  
    214219                  s_i(ji,jj,jk,jl) = rswitch * rn_ice_sal(ib_bdy) + ( 1.0 - rswitch ) * rn_simin 
    215220               END DO 
    216                 
    217             CASE( 1 ) ! velocity is outward 
    218   
     221               ! 
     222            CASE( 1 )   ! velocity is outward 
     223               ! 
    219224               ! Ice salinity, age, temperature 
    220225               sm_i(ji,jj,jl)   = rswitch * sm_i(ii,ij,jl)  + ( 1.0 - rswitch ) * rn_simin 
    … …  
    228233                  s_i(ji,jj,jk,jl) = rswitch * s_i(ii,ij,jk,jl) + ( 1.0 - rswitch ) * rn_simin 
    229234               END DO 
    230  
     235               ! 
    231236            END SELECT 
    232  
    233             ! if salinity is constant, then overwrite rn_ice_sal 
    234             IF( nn_icesal == 1 ) THEN 
    235                sm_i(ji,jj,jl)   = rn_icesal 
     237            ! 
     238            IF( nn_icesal == 1 ) THEN     ! constant salinity : overwrite rn_ice_sal 
     239               sm_i(ji,jj  ,jl) = rn_icesal 
    236240               s_i (ji,jj,:,jl) = rn_icesal 
    237241            ENDIF 
    238  
     242            ! 
    239243            ! contents 
    240244            smv_i(ji,jj,jl)  = MIN( sm_i(ji,jj,jl) , sss_m(ji,jj) ) * v_i(ji,jj,jl) 
    … …  
    255259               e_i(ji,jj,jk,jl) = e_i(ji,jj,jk,jl) * a_i(ji,jj,jl) * ht_i(ji,jj,jl) * r1_nlay_i 
    256260            END DO 
    257  
     261            ! 
    258262         END DO 
    259   
     263         ! 
    260264         CALL lbc_bdy_lnk(  a_i(:,:,jl), 'T', 1., ib_bdy ) 
    261265         CALL lbc_bdy_lnk( ht_i(:,:,jl), 'T', 1., ib_bdy ) 
    … …  
    263267         CALL lbc_bdy_lnk(  v_i(:,:,jl), 'T', 1., ib_bdy ) 
    264268         CALL lbc_bdy_lnk(  v_s(:,:,jl), 'T', 1., ib_bdy ) 
    265   
     269         ! 
    266270         CALL lbc_bdy_lnk( smv_i(:,:,jl), 'T', 1., ib_bdy ) 
    267271         CALL lbc_bdy_lnk(  sm_i(:,:,jl), 'T', 1., ib_bdy ) 
    … …  
    276280            CALL lbc_bdy_lnk(e_i(:,:,jk,jl), 'T', 1., ib_bdy ) 
    277281         END DO 
    278  
     282         ! 
    279283      END DO !jl 
    280      
     284      ! 
    281285#endif 
    282286      !       
    283       IF( nn_timing == 1 ) CALL timing_stop('bdy_ice_frs') 
     287      IF( nn_timing == 1 )   CALL timing_stop('bdy_ice_frs') 
    284288      ! 
    285289   END SUBROUTINE bdy_ice_frs 
    … …  
    296300      !! 2013-06 : C. Rousset 
    297301      !!------------------------------------------------------------------------------ 
    298       !! 
    299302      CHARACTER(len=1), INTENT(in)  ::   cd_type   ! nature of velocity grid-points 
     303      ! 
    300304      INTEGER  ::   jb, jgrd           ! dummy loop indices 
    301305      INTEGER  ::   ji, jj             ! local scalar 
    302306      INTEGER  ::   ib_bdy             ! Loop index 
    303307      REAL(wp) ::   zmsk1, zmsk2, zflag 
    304      !!------------------------------------------------------------------------------ 
     308      !!------------------------------------------------------------------------------ 
    305309      ! 
    306310      IF( nn_timing == 1 ) CALL timing_start('bdy_ice_lim_dyn') 
    … …  
    309313         ! 
    310314         SELECT CASE( cn_ice_lim(ib_bdy) ) 
    311  
     315         ! 
    312316         CASE('none') 
    313  
    314317            CYCLE 
    315              
     318            ! 
    316319         CASE('frs') 
    317              
     320            ! 
    318321            IF( nn_ice_lim_dta(ib_bdy) == 0 ) CYCLE            ! case ice boundaries = initial conditions  
    319                                                                !      do not change ice velocity (it is only computed by rheology) 
    320   
     322            !                                                  !      do not change ice velocity (it is only computed by rheology) 
    321323            SELECT CASE ( cd_type ) 
    322                 
    323             CASE ( 'U' ) 
    324                 
     324            !      
     325            CASE ( 'U' )   
    325326               jgrd = 2      ! u velocity 
    326327               DO jb = 1, idx_bdy(ib_bdy)%nblen(jgrd) 
    … …  
    328329                  jj    = idx_bdy(ib_bdy)%nbj(jb,jgrd) 
    329330                  zflag = idx_bdy(ib_bdy)%flagu(jb,jgrd) 
    330                    
     331                  ! 
    331332                  IF ( ABS( zflag ) == 1. ) THEN  ! eastern and western boundaries 
    332333                     ! one of the two zmsk is always 0 (because of zflag) 
    333334                     zmsk1 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji+1,jj) ) ) ! 0 if no ice 
    334335                     zmsk2 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji-1,jj) ) ) ! 0 if no ice 
    335                       
     336                     !   
    336337                     ! u_ice = u_ice of the adjacent grid point except if this grid point is ice-free (then u_ice = u_oce) 
    337338                     u_ice (ji,jj) = u_ice(ji+1,jj) * 0.5_wp * ABS( zflag + 1._wp ) * zmsk1 + & 
    … …  
    345346                  rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ji,jj) - 0.01_wp ) ) ! 0 if no ice 
    346347                  u_ice(ji,jj) = rswitch * u_ice(ji,jj) 
    347                    
    348                ENDDO 
    349                 
     348                  ! 
     349               END DO 
    350350               CALL lbc_bdy_lnk( u_ice(:,:), 'U', -1., ib_bdy ) 
    351                 
     351               ! 
    352352            CASE ( 'V' ) 
    353                 
    354353               jgrd = 3      ! v velocity 
    355354               DO jb = 1, idx_bdy(ib_bdy)%nblen(jgrd) 
    … …  
    357356                  jj    = idx_bdy(ib_bdy)%nbj(jb,jgrd) 
    358357                  zflag = idx_bdy(ib_bdy)%flagv(jb,jgrd) 
    359                    
     358                  ! 
    360359                  IF ( ABS( zflag ) == 1. ) THEN  ! northern and southern boundaries 
    361360                     ! one of the two zmsk is always 0 (because of zflag) 
    362361                     zmsk1 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji,jj+1) ) ) ! 0 if no ice 
    363362                     zmsk2 = 1._wp - MAX( 0.0_wp, SIGN ( 1.0_wp , - vt_i(ji,jj-1) ) ) ! 0 if no ice 
    364                       
     363                     !   
    365364                     ! u_ice = u_ice of the adjacent grid point except if this grid point is ice-free (then u_ice = u_oce) 
    366365                     v_ice (ji,jj) = v_ice(ji,jj+1) * 0.5_wp * ABS( zflag + 1._wp ) * zmsk1 + & 
    … …  
    374373                  rswitch = MAX( 0.0_wp , SIGN ( 1.0_wp , at_i(ji,jj) - 0.01 ) ) ! 0 if no ice 
    375374                  v_ice(ji,jj) = rswitch * v_ice(ji,jj) 
    376                    
    377                ENDDO 
    378                 
     375                  ! 
     376               END DO 
    379377               CALL lbc_bdy_lnk( v_ice(:,:), 'V', -1., ib_bdy ) 
    380                    
     378               ! 
    381379            END SELECT 
    382              
     380            ! 
    383381         CASE DEFAULT 
    384382            CALL ctl_stop( 'bdy_ice_lim_dyn : unrecognised option for open boundaries for ice fields' ) 
    385383         END SELECT 
    386           
    387       ENDDO 
    388  
     384         ! 
     385      END DO 
     386      ! 
    389387      IF( nn_timing == 1 ) CALL timing_stop('bdy_ice_lim_dyn') 
    390        
     388      ! 
    391389    END SUBROUTINE bdy_ice_lim_dyn 
    392390 

  • branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/OPA_SRC/BDY/bdyini.F90

    r5947 r5948  
    7676      INTEGER  ::   ib_bdy, ii, ij, ik, igrd, ib, ir, iseg ! dummy loop indices 
    7777      INTEGER  ::   icount, icountr, ibr_max, ilen1, ibm1  ! local integers 
    78       INTEGER  ::   iw, ie, is, in, inum, id_dummy         !   -       - 
     78      INTEGER  ::   iwe, ies, iso, ino, inum, id_dummy     !   -       - 
    7979      INTEGER  ::   igrd_start, igrd_end, jpbdta           !   -       - 
    8080      INTEGER  ::   jpbdtau, jpbdtas                       !   -       - 
    … …  
    777777!      is = mjg(1) + 1            ! if monotasking and no zoom, is=2 
    778778!      in = mjg(1) + nlcj-1 - 1   ! if monotasking and no zoom, in=jpjm1       
    779       iw = mig(1) - jpizoom + 2         ! if monotasking and no zoom, iw=2 
    780       ie = mig(1) + nlci - jpizoom - 1  ! if monotasking and no zoom, ie=jpim1 
    781       is = mjg(1) - jpjzoom + 2         ! if monotasking and no zoom, is=2 
    782       in = mjg(1) + nlcj - jpjzoom - 1  ! if monotasking and no zoom, in=jpjm1 
     779      iwe = mig(1) - jpizoom + 2         ! if monotasking and no zoom, iw=2 
     780      ies = mig(1) + nlci - jpizoom - 1  ! if monotasking and no zoom, ie=jpim1 
     781      iso = mjg(1) - jpjzoom + 2         ! if monotasking and no zoom, is=2 
     782      ino = mjg(1) + nlcj - jpjzoom - 1  ! if monotasking and no zoom, in=jpjm1 
    783783 
    784784      ALLOCATE( nbondi_bdy(nb_bdy)) 
    … …  
    853853               ENDIF 
    854854               ! check if point is in local domain 
    855                IF(  nbidta(ib,igrd,ib_bdy) >= iw .AND. nbidta(ib,igrd,ib_bdy) <= ie .AND.   & 
    856                   & nbjdta(ib,igrd,ib_bdy) >= is .AND. nbjdta(ib,igrd,ib_bdy) <= in       ) THEN 
     855               IF(  nbidta(ib,igrd,ib_bdy) >= iwe .AND. nbidta(ib,igrd,ib_bdy) <= ies .AND.   & 
     856                  & nbjdta(ib,igrd,ib_bdy) >= iso .AND. nbjdta(ib,igrd,ib_bdy) <= ino      ) THEN 
    857857                  ! 
    858858                  icount = icount  + 1 
    … …  
    890890         com_south_b = 0 
    891891         com_north_b = 0 
     892 
    892893         DO igrd = 1, jpbgrd 
    893894            icount  = 0 
    … …  
    896897               DO ib = 1, nblendta(igrd,ib_bdy) 
    897898                  ! check if point is in local domain and equals ir 
    898                   IF(  nbidta(ib,igrd,ib_bdy) >= iw .AND. nbidta(ib,igrd,ib_bdy) <= ie .AND.   & 
    899                      & nbjdta(ib,igrd,ib_bdy) >= is .AND. nbjdta(ib,igrd,ib_bdy) <= in .AND.   & 
     899                  IF(  nbidta(ib,igrd,ib_bdy) >= iwe .AND. nbidta(ib,igrd,ib_bdy) <= ies .AND.   & 
     900                     & nbjdta(ib,igrd,ib_bdy) >= iso .AND. nbjdta(ib,igrd,ib_bdy) <= ino .AND.   & 
    900901                     & nbrdta(ib,igrd,ib_bdy) == ir  ) THEN 
    901902                     ! 
    … …  
    15941595            ELSE 
    15951596               ! This is a corner 
    1596                WRITE(numout,*) 'Found a South-West corner at (i,j): ', jpiwob(ib), jpjwdt(ib) 
     1597               IF(lwp) WRITE(numout,*) 'Found a South-West corner at (i,j): ', jpiwob(ib), jpjwdt(ib) 
    15971598               CALL bdy_ctl_corn(npckgw(ib), icornw(ib,1)) 
    15981599               itest=itest+1 
    … …  
    16081609            ELSE 
    16091610               ! This is a corner 
    1610                WRITE(numout,*) 'Found a North-West corner at (i,j): ', jpiwob(ib), jpjwft(ib) 
     1611               IF(lwp) WRITE(numout,*) 'Found a North-West corner at (i,j): ', jpiwob(ib), jpjwft(ib) 
    16111612               CALL bdy_ctl_corn(npckgw(ib), icornw(ib,2)) 
    16121613               itest=itest+1 
    … …  
    16381639            ELSE 
    16391640               ! This is a corner 
    1640                WRITE(numout,*) 'Found a South-East corner at (i,j): ', jpieob(ib)+1, jpjedt(ib) 
     1641               IF(lwp) WRITE(numout,*) 'Found a South-East corner at (i,j): ', jpieob(ib)+1, jpjedt(ib) 
    16411642               CALL bdy_ctl_corn(npckge(ib), icorne(ib,1)) 
    16421643               itest=itest+1 
    … …  
    16521653            ELSE 
    16531654               ! This is a corner 
    1654                WRITE(numout,*) 'Found a North-East corner at (i,j): ', jpieob(ib)+1, jpjeft(ib) 
     1655               IF(lwp) WRITE(numout,*) 'Found a North-East corner at (i,j): ', jpieob(ib)+1, jpjeft(ib) 
    16551656               CALL bdy_ctl_corn(npckge(ib), icorne(ib,2)) 
    16561657               itest=itest+1 

  • branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/OPA_SRC/BDY/bdytides.F90

    r5947 r5948  
    3333!   USE tide_mod       ! Useless ?? 
    3434   USE fldread 
    35    USE dynspg_oce, ONLY: lk_dynspg_ts 
    3635 
    3736   IMPLICIT NONE 
    … …  
    5453   TYPE(TIDES_DATA), PUBLIC, DIMENSION(jp_bdy), TARGET :: tides  !: External tidal harmonics data 
    5554!$AGRIF_END_DO_NOT_TREAT 
    56    TYPE(OBC_DATA)  , PRIVATE, DIMENSION(jp_bdy) :: dta_bdy_s  !: bdy external data (slow component) 
     55   TYPE(OBC_DATA)  , PUBLIC, DIMENSION(jp_bdy) :: dta_bdy_s  !: bdy external data (slow component) 
    5756 
    5857   !!---------------------------------------------------------------------- 
    … …  
    270269            ENDIF 
    271270            ! 
    272             IF ( lk_dynspg_ts ) THEN ! Allocate arrays to save slowly varying boundary data during 
    273                                      ! time splitting integration 
    274                ALLOCATE( dta_bdy_s(ib_bdy)%ssh ( ilen0(1) ) ) 
    275                ALLOCATE( dta_bdy_s(ib_bdy)%u2d ( ilen0(2) ) ) 
    276                ALLOCATE( dta_bdy_s(ib_bdy)%v2d ( ilen0(3) ) ) 
    277                dta_bdy_s(ib_bdy)%ssh(:) = 0.e0 
    278                dta_bdy_s(ib_bdy)%u2d(:) = 0.e0 
    279                dta_bdy_s(ib_bdy)%v2d(:) = 0.e0 
    280             ENDIF 
     271            ! Allocate slow varying data in the case of time splitting: 
     272            ! Do it anyway because at this stage knowledge of free surface scheme is unknown 
     273            ALLOCATE( dta_bdy_s(ib_bdy)%ssh ( ilen0(1) ) ) 
     274            ALLOCATE( dta_bdy_s(ib_bdy)%u2d ( ilen0(2) ) ) 
     275            ALLOCATE( dta_bdy_s(ib_bdy)%v2d ( ilen0(3) ) ) 
     276            dta_bdy_s(ib_bdy)%ssh(:) = 0.e0 
     277            dta_bdy_s(ib_bdy)%u2d(:) = 0.e0 
     278            dta_bdy_s(ib_bdy)%v2d(:) = 0.e0 
    281279            ! 
    282280         ENDIF ! nn_dyn2d_dta(ib_bdy) .ge. 2 
    … …  
    397395      !! 
    398396      LOGICAL  :: lk_first_btstp  ! =.TRUE. if time splitting and first barotropic step 
    399       INTEGER,          DIMENSION(jpbgrd) :: ilen0  
     397      INTEGER, DIMENSION(jpbgrd) :: ilen0  
    400398      INTEGER, DIMENSION(1:jpbgrd) :: nblen, nblenrim  ! short cuts 
    401399      INTEGER  :: itide, ib_bdy, ib, igrd                     ! loop indices 
    … …  
    416414      ! Absolute time from model initialization:    
    417415      IF( PRESENT(kit) ) THEN   
    418          z_arg = ( kt + (kit+0.5_wp*(time_add-1)) / REAL(nn_baro,wp) ) * rdt 
     416         z_arg = ( kt + (kit+time_add-1) / REAL(nn_baro,wp) ) * rdt 
    419417      ELSE                               
    420418         z_arg = ( kt + time_add ) * rdt 
    … …  
    456454            zoff = -kt_tide * rdt ! time offset relative to nodal factor computation time 
    457455            ! 
    458             ! If time splitting, save data at first barotropic iteration 
    459             IF ( PRESENT(kit) ) THEN 
    460                IF ( lk_first_btstp ) THEN ! Save slow varying open boundary data: 
    461                   IF ( dta_bdy(ib_bdy)%ll_ssh ) dta_bdy_s(ib_bdy)%ssh(1:ilen0(1)) = dta_bdy(ib_bdy)%ssh(1:ilen0(1)) 
    462                   IF ( dta_bdy(ib_bdy)%ll_u2d ) dta_bdy_s(ib_bdy)%u2d(1:ilen0(2)) = dta_bdy(ib_bdy)%u2d(1:ilen0(2)) 
    463                   IF ( dta_bdy(ib_bdy)%ll_v2d ) dta_bdy_s(ib_bdy)%v2d(1:ilen0(3)) = dta_bdy(ib_bdy)%v2d(1:ilen0(3)) 
    464  
    465                ELSE ! Initialize arrays from slow varying open boundary data:             
    466                   IF ( dta_bdy(ib_bdy)%ll_ssh ) dta_bdy(ib_bdy)%ssh(1:ilen0(1)) = dta_bdy_s(ib_bdy)%ssh(1:ilen0(1)) 
    467                   IF ( dta_bdy(ib_bdy)%ll_u2d ) dta_bdy(ib_bdy)%u2d(1:ilen0(2)) = dta_bdy_s(ib_bdy)%u2d(1:ilen0(2)) 
    468                   IF ( dta_bdy(ib_bdy)%ll_v2d ) dta_bdy(ib_bdy)%v2d(1:ilen0(3)) = dta_bdy_s(ib_bdy)%v2d(1:ilen0(3)) 
    469                ENDIF 
     456            ! If time splitting, initialize arrays from slow varying open boundary data: 
     457            IF ( PRESENT(kit) ) THEN            
     458               IF ( dta_bdy(ib_bdy)%ll_ssh ) dta_bdy(ib_bdy)%ssh(1:ilen0(1)) = dta_bdy_s(ib_bdy)%ssh(1:ilen0(1)) 
     459               IF ( dta_bdy(ib_bdy)%ll_u2d ) dta_bdy(ib_bdy)%u2d(1:ilen0(2)) = dta_bdy_s(ib_bdy)%u2d(1:ilen0(2)) 
     460               IF ( dta_bdy(ib_bdy)%ll_v2d ) dta_bdy(ib_bdy)%v2d(1:ilen0(3)) = dta_bdy_s(ib_bdy)%v2d(1:ilen0(3)) 
    470461            ENDIF 
    471462            ! 

  • branches/2014/dev_r4650_UKMO12_CFL_diags_take2/NEMOGCM/NEMO/OPA_SRC/BDY/bdyvol.F90

    r5947 r5948  
    1010   !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge 
    1111   !!---------------------------------------------------------------------- 
    12 #if   defined key_bdy   &&   defined key_dynspg_flt 
     12#if   defined key_bdy 
    1313   !!---------------------------------------------------------------------- 
    14    !!   'key_bdy'            AND      unstructured open boundary conditions 
    15    !!   'key_dynspg_flt'                              filtered free surface 
     14   !!   'key_bdy'      unstructured open boundary conditions 
    1615   !!---------------------------------------------------------------------- 
    17    USE timing          ! Timing 
    1816   USE oce             ! ocean dynamics and tracers  
    19    USE sbcisf          ! ice shelf 
     17   USE bdy_oce         ! ocean open boundary conditions 
     18   USE sbc_oce         ! ocean surface boundary conditions 
    2019   USE dom_oce         ! ocean space and time domain  
    2120   USE phycst          ! physical constants 
    22    USE bdy_oce         ! ocean open boundary conditions 
     21   USE sbcisf          ! ice shelf 
     22   ! 
     23   USE in_out_manager  ! I/O manager 
    2324   USE lib_mpp         ! for mppsum 
    24    USE in_out_manager  ! I/O manager 
    25    USE sbc_oce         ! ocean surface boundary conditions 
     25   USE timing          ! Timing 
     26   USE lib_fortran     ! Fortran routines library 
    2627 
    2728   IMPLICIT NONE 
    2829   PRIVATE 
    2930 
    30    PUBLIC bdy_vol        ! routine called by dynspg_flt.h90 
     31   PUBLIC bdy_vol       
    3132 
    3233   !! * Substitutions 
    3334#  include "domzgr_substitute.h90" 
    3435   !!---------------------------------------------------------------------- 
    35    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     36   !! NEMO/OPA 3.6 , NEMO Consortium (2014) 
    3637   !! $Id$ 
    3738   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    4344      !!                      ***  ROUTINE bdyvol  *** 
    4445      !! 
    45       !! ** Purpose :   This routine is called in dynspg_flt to control  
    46       !!      the volume of the system. A correction velocity is calculated 
     46      !! ** Purpose :   This routine controls the volume of the system.  
     47      !!      A correction velocity is calculated 
    4748      !!      to correct the total transport through the unstructured OBC.  
    4849      !!      The total depth used is constant (H0) to be consistent with the  
    … …  
    7879      TYPE(OBC_INDEX), POINTER :: idx 
    7980      !!----------------------------------------------------------------------------- 
    80  
    81       IF( nn_timing == 1 ) CALL timing_start('bdy_vol') 
    82  
     81      ! 
     82      IF( nn_timing == 1 )   CALL timing_start('bdy_vol') 
     83      ! 
    8384      IF( ln_vol ) THEN 
    84  
     85      ! 
    8586      IF( kt == nit000 ) THEN  
    8687         IF(lwp) WRITE(numout,*) 
    … …  
    9192      ! Calculate the cumulate surface Flux z_cflxemp (m3/s) over all the domain 
    9293      ! ----------------------------------------------------------------------- 
    93       z_cflxemp = SUM ( ( emp(:,:)-rnf(:,:)+rdivisf*fwfisf(:,:) ) * bdytmask(:,:) * e1t(:,:) * e2t(:,:) ) / rau0 
     94!!gm replace these lines : 
     95      z_cflxemp = SUM ( ( emp(:,:)-rnf(:,:)+fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:) ) / rau0 
    9496      IF( lk_mpp )   CALL mpp_sum( z_cflxemp )     ! sum over the global domain 
     97!!gm   by : 
     98!!gm      z_cflxemp = glob_sum(  ( emp(:,:)-rnf(:,:)+fwfisf(:,:) ) * bdytmask(:,:) * e1e2t(:,:)  ) / rau0 
     99!!gm 
    95100 
    96101      ! Transport through the unstructured open boundary 
    97102      ! ------------------------------------------------ 
    98       zubtpecor = 0.e0 
     103      zubtpecor = 0._wp 
    99104      DO ib_bdy = 1, nb_bdy 
    100105         idx => idx_bdy(ib_bdy) 
    101  
     106         ! 
    102107         jgrd = 2                               ! cumulate u component contribution first  
    103108         DO jb = 1, idx%nblenrim(jgrd) 
    … …  
    116121            END DO 
    117122         END DO 
    118  
     123         ! 
    119124      END DO 
    120125      IF( lk_mpp )   CALL mpp_sum( zubtpecor )   ! sum over the global domain 
    … …  
    123128      ! ------------------------------ 
    124129      IF( nn_volctl==1 ) THEN   ;   zubtpecor = ( zubtpecor - z_cflxemp) / bdysurftot  
    125       ELSE                   ;   zubtpecor =   zubtpecor             / bdysurftot 
     130      ELSE                      ;   zubtpecor =   zubtpecor             / bdysurftot 
    126131      END IF 
    127132 
    128133      ! Correction of the total velocity on the unstructured boundary to respect the mass flux conservation 
    129134      ! ------------------------------------------------------------- 
    130       ztranst = 0.e0 
     135      ztranst = 0._wp 
    131136      DO ib_bdy = 1, nb_bdy 
    132137         idx => idx_bdy(ib_bdy) 
    133  
     138         ! 
    134139         jgrd = 2                               ! correct u component 
    135140         DO jb = 1, idx%nblenrim(jgrd) 
    … …  
    150155            END DO 
    151156         END DO 
    152  
     157         ! 
    153158      END DO 
    154159      IF( lk_mpp )   CALL mpp_sum( ztranst )   ! sum over the global domain 
    … …  
    169174      ! 
    170175      END IF ! ln_vol 
    171  
     176      ! 
    172177   END SUBROUTINE bdy_vol 
    173178 
Note: See TracChangeset for help on using the changeset viewer.