Changeset 7058


Ignore:
Timestamp:
2016-10-20T15:19:01+02:00 (4 years ago)
Author:
lovato
Message:

#1783 - trunk: Generalize the open boundary schemes and revise TRA and TRC BDY wrappers

Location:
branches/2016/dev_r6522_SIMPLIF_3/NEMOGCM/NEMO
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • branches/2016/dev_r6522_SIMPLIF_3/NEMOGCM/NEMO/OPA_SRC/BDY/bdylib.F90

    r6862 r7058  
    55   !!====================================================================== 
    66   !! History :  3.6  !  2013     (D. Storkey) original code 
     7   !!            4.0  !  2014     (T. Lovato) Generalize OBC structure 
    78   !!---------------------------------------------------------------------- 
    89   !!---------------------------------------------------------------------- 
     
    2223   PRIVATE 
    2324 
    24    PUBLIC   bdy_orlanski_2d     ! routine called where? 
    25    PUBLIC   bdy_orlanski_3d     ! routine called where? 
     25   PUBLIC   bdy_frs, bdy_spe, bdy_nmn, bdy_orl 
     26   PUBLIC   bdy_orlanski_2d 
     27   PUBLIC   bdy_orlanski_3d 
    2628 
    2729   !!---------------------------------------------------------------------- 
    28    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     30   !! NEMO/OPA 4.0 , NEMO Consortium (2016) 
    2931   !! $Id$  
    3032   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    3133   !!---------------------------------------------------------------------- 
    3234CONTAINS 
     35 
     36   SUBROUTINE bdy_frs( idx, pta, dta ) 
     37      !!---------------------------------------------------------------------- 
     38      !!                 ***  SUBROUTINE bdy_frs  *** 
     39      !! 
     40      !! ** Purpose : Apply the Flow Relaxation Scheme for tracers at open boundaries. 
     41      !! 
     42      !! Reference : Engedahl H., 1995, Tellus, 365-382. 
     43      !!---------------------------------------------------------------------- 
     44      TYPE(OBC_INDEX),                     INTENT(in) ::   idx  ! OBC indices 
     45      REAL(wp), DIMENSION(:,:),            INTENT(in) ::   dta  ! OBC external data 
     46      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pta  ! tracer trend 
     47      !! 
     48      REAL(wp) ::   zwgt           ! boundary weight 
     49      INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
     50      INTEGER  ::   ii, ij         ! 2D addresses 
     51      !!---------------------------------------------------------------------- 
     52      ! 
     53      IF( nn_timing == 1 ) CALL timing_start('bdy_frs') 
     54      !  
     55      igrd = 1                       ! Everything is at T-points here 
     56      DO ib = 1, idx%nblen(igrd) 
     57         DO ik = 1, jpkm1 
     58            ii = idx%nbi(ib,igrd)  
     59            ij = idx%nbj(ib,igrd) 
     60            zwgt = idx%nbw(ib,igrd) 
     61            pta(ii,ij,ik) = ( pta(ii,ij,ik) + zwgt * (dta(ib,ik) - pta(ii,ij,ik) ) ) * tmask(ii,ij,ik) 
     62         END DO 
     63      END DO 
     64      ! 
     65      IF( nn_timing == 1 ) CALL timing_stop('bdy_frs') 
     66      ! 
     67   END SUBROUTINE bdy_frs 
     68 
     69   SUBROUTINE bdy_spe( idx, pta, dta ) 
     70      !!---------------------------------------------------------------------- 
     71      !!                 ***  SUBROUTINE bdy_spe  *** 
     72      !! 
     73      !! ** Purpose : Apply a specified value for tracers at open boundaries. 
     74      !! 
     75      !!---------------------------------------------------------------------- 
     76      TYPE(OBC_INDEX),                     INTENT(in) ::   idx  ! OBC indices 
     77      REAL(wp), DIMENSION(:,:),            INTENT(in) ::   dta  ! OBC external data 
     78      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pta  ! tracer trend 
     79      !! 
     80      REAL(wp) ::   zwgt           ! boundary weight 
     81      INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
     82      INTEGER  ::   ii, ij         ! 2D addresses 
     83      !!---------------------------------------------------------------------- 
     84      ! 
     85      IF( nn_timing == 1 ) CALL timing_start('bdy_spe') 
     86      ! 
     87      igrd = 1                       ! Everything is at T-points here 
     88      DO ib = 1, idx%nblenrim(igrd) 
     89         ii = idx%nbi(ib,igrd) 
     90         ij = idx%nbj(ib,igrd) 
     91         DO ik = 1, jpkm1 
     92            pta(ii,ij,ik) = dta(ib,ik) * tmask(ii,ij,ik) 
     93         END DO 
     94      END DO 
     95      ! 
     96      IF( nn_timing == 1 ) CALL timing_stop('bdy_spe') 
     97      ! 
     98   END SUBROUTINE bdy_spe 
     99 
     100   SUBROUTINE bdy_nmn( idx, pta ) 
     101      !!---------------------------------------------------------------------- 
     102      !!                 ***  SUBROUTINE bdy_nmn  *** 
     103      !! 
     104      !! ** Purpose : Duplicate the value for tracers at open boundaries. 
     105      !! 
     106      !!---------------------------------------------------------------------- 
     107      TYPE(OBC_INDEX),                     INTENT(in) ::   idx  ! OBC indices 
     108      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pta  ! tracer trend 
     109      !! 
     110      REAL(wp) ::   zwgt           ! boundary weight 
     111      INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
     112      INTEGER  ::   ii, ij, zcoef, zcoef1, zcoef2, ip, jp   ! 2D addresses 
     113      !!---------------------------------------------------------------------- 
     114      ! 
     115      IF( nn_timing == 1 ) CALL timing_start('bdy_nmn') 
     116      ! 
     117      igrd = 1                       ! Everything is at T-points here 
     118      DO ib = 1, idx%nblenrim(igrd) 
     119         ii = idx%nbi(ib,igrd) 
     120         ij = idx%nbj(ib,igrd) 
     121         DO ik = 1, jpkm1 
     122            ! search the sense of the gradient 
     123            zcoef1 = bdytmask(ii-1,ij  ) +  bdytmask(ii+1,ij  ) 
     124            zcoef2 = bdytmask(ii  ,ij-1) +  bdytmask(ii  ,ij+1) 
     125            IF ( zcoef1+zcoef2 == 0) THEN 
     126               ! corner 
     127               zcoef = tmask(ii-1,ij,ik) + tmask(ii+1,ij,ik) +  tmask(ii,ij-1,ik) +  tmask(ii,ij+1,ik) 
     128               pta(ii,ij,ik) = pta(ii-1,ij  ,ik) * tmask(ii-1,ij  ,ik) + & 
     129                 &             pta(ii+1,ij  ,ik) * tmask(ii+1,ij  ,ik) + & 
     130                 &             pta(ii  ,ij-1,ik) * tmask(ii  ,ij-1,ik) + & 
     131                 &             pta(ii  ,ij+1,ik) * tmask(ii  ,ij+1,ik) 
     132               pta(ii,ij,ik) = ( pta(ii,ij,ik) / MAX( 1, zcoef) ) * tmask(ii,ij,ik) 
     133            ELSE 
     134               ip = bdytmask(ii+1,ij  ) - bdytmask(ii-1,ij  ) 
     135               jp = bdytmask(ii  ,ij+1) - bdytmask(ii  ,ij-1) 
     136               pta(ii,ij,ik) = pta(ii+ip,ij+jp,ik) * tmask(ii+ip,ij+jp,ik) 
     137            ENDIF 
     138         END DO 
     139      END DO 
     140      ! 
     141      IF( nn_timing == 1 ) CALL timing_stop('bdy_nmn') 
     142      ! 
     143   END SUBROUTINE bdy_nmn 
     144 
     145   SUBROUTINE bdy_orl( idx, ptb, pta, dta, ll_npo ) 
     146      !!---------------------------------------------------------------------- 
     147      !!                 ***  SUBROUTINE bdy_orl  *** 
     148      !! 
     149      !! ** Purpose : Apply Orlanski radiation for tracers at open boundaries. 
     150      !!              This is a wrapper routine for bdy_orlanski_3d below 
     151      !! 
     152      !!---------------------------------------------------------------------- 
     153      TYPE(OBC_INDEX),                     INTENT(in) ::   idx  ! OBC indices 
     154      REAL(wp), DIMENSION(:,:),            INTENT(in) ::   dta  ! OBC external data 
     155      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   ptb  ! before tracer field 
     156      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pta  ! tracer trend 
     157      LOGICAL,                             INTENT(in) ::   ll_npo  ! switch for NPO version 
     158      !! 
     159      INTEGER  ::   igrd                                    ! grid index 
     160      !!---------------------------------------------------------------------- 
     161      ! 
     162      IF( nn_timing == 1 ) CALL timing_start('bdy_orl') 
     163      ! 
     164      igrd = 1                       ! Everything is at T-points here 
     165      ! 
     166      CALL bdy_orlanski_3d( idx, igrd, ptb(:,:,:), pta(:,:,:), dta, ll_npo ) 
     167      ! 
     168      IF( nn_timing == 1 ) CALL timing_stop('bdy_orl') 
     169      ! 
     170   END SUBROUTINE bdy_orl 
    33171 
    34172   SUBROUTINE bdy_orlanski_2d( idx, igrd, phib, phia, phi_ext, ll_npo ) 
  • branches/2016/dev_r6522_SIMPLIF_3/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90

    r6862 r7058  
    88   !!            3.4  !  2011     (D. Storkey) rewrite in preparation for OBC-BDY merge 
    99   !!            3.5  !  2012     (S. Mocavero, I. Epicoco) Optimization of BDY communications 
     10   !!            4.0  !  2016     (T. Lovato) Generalize OBC structure 
    1011   !!---------------------------------------------------------------------- 
    11    !!   bdy_tra            : Apply open boundary conditions to T and S 
    12    !!   bdy_tra_frs        : Apply Flow Relaxation Scheme 
     12   !!   bdy_tra       : Apply open boundary conditions & damping to T and S 
    1313   !!---------------------------------------------------------------------- 
    1414   USE oce            ! ocean dynamics and tracers variables 
     
    1616   USE bdy_oce        ! ocean open boundary conditions 
    1717   USE bdylib         ! for orlanski library routines 
    18    USE bdydta   , ONLY:   bf   !  
    1918   ! 
    2019   USE in_out_manager ! I/O manager 
     
    2524   PRIVATE 
    2625 
     26   ! Local structure to rearrange tracers data 
     27   TYPE, PUBLIC ::   ztrabdy 
     28      REAL(wp), POINTER, DIMENSION(:,:) ::  tra 
     29   END TYPE 
     30 
    2731   PUBLIC   bdy_tra      ! called in tranxt.F90  
    2832   PUBLIC   bdy_tra_dmp  ! called in step.F90  
    2933 
    3034   !!---------------------------------------------------------------------- 
    31    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     35   !! NEMO/OPA 4.0, NEMO Consortium (2016) 
    3236   !! $Id$  
    3337   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     
    4448      INTEGER, INTENT(in) ::   kt   ! Main time step counter 
    4549      ! 
    46       INTEGER ::   ib_bdy   ! Loop index 
     50      INTEGER                        :: ib_bdy, jn   ! Loop indeces 
     51      TYPE(ztrabdy), DIMENSION(jpts) :: zdta         ! Temporary data structure 
    4752      !!---------------------------------------------------------------------- 
    4853 
    4954      DO ib_bdy=1, nb_bdy 
    5055         ! 
    51          SELECT CASE( cn_tra(ib_bdy) ) 
    52          CASE('none'        )   ;   CYCLE 
    53          CASE('frs'         )   ;   CALL bdy_tra_frs     ( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 
    54          CASE('specified'   )   ;   CALL bdy_tra_spe     ( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 
    55          CASE('neumann'     )   ;   CALL bdy_tra_nmn     ( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 
    56          CASE('orlanski'    )   ;   CALL bdy_tra_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ll_npo=.false. ) 
    57          CASE('orlanski_npo')   ;   CALL bdy_tra_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ll_npo=.true. ) 
    58          CASE('runoff'      )   ;   CALL bdy_tra_rnf     ( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 
    59          CASE DEFAULT           ;   CALL ctl_stop( 'bdy_tra : unrecognised option for open boundaries for T and S' ) 
    60          END SELECT 
    61          ! Boundary points should be updated 
    62          CALL lbc_bdy_lnk( tsa(:,:,:,jp_tem), 'T', 1., ib_bdy ) 
    63          CALL lbc_bdy_lnk( tsa(:,:,:,jp_sal), 'T', 1., ib_bdy ) 
     56         zdta(1)%tra => dta_bdy(ib_bdy)%tem 
     57         zdta(2)%tra => dta_bdy(ib_bdy)%sal 
     58         ! 
     59         DO jn = 1, jpts 
     60            ! 
     61            SELECT CASE( cn_tra(ib_bdy) ) 
     62            CASE('none'        )   ;   CYCLE 
     63            CASE('frs'         )   ;   CALL bdy_frs ( idx_bdy(ib_bdy),                tsa(:,:,:,jn), zdta(jn)%tra ) 
     64            CASE('specified'   )   ;   CALL bdy_spe ( idx_bdy(ib_bdy),                tsa(:,:,:,jn), zdta(jn)%tra ) 
     65            CASE('neumann'     )   ;   CALL bdy_nmn ( idx_bdy(ib_bdy),                tsa(:,:,:,jn)               ) 
     66            CASE('orlanski'    )   ;   CALL bdy_orl ( idx_bdy(ib_bdy), tsb(:,:,:,jn), tsa(:,:,:,jn), zdta(jn)%tra, ll_npo=.false. ) 
     67            CASE('orlanski_npo')   ;   CALL bdy_orl ( idx_bdy(ib_bdy), tsb(:,:,:,jn), tsa(:,:,:,jn), zdta(jn)%tra, ll_npo=.true. ) 
     68            CASE('runoff'      )   ;   CALL bdy_rnf ( idx_bdy(ib_bdy),                tsa(:,:,:,jn),               jn ) 
     69            CASE DEFAULT           ;   CALL ctl_stop( 'bdy_tra : unrecognised option for open boundaries for T and S' ) 
     70            END SELECT 
     71            ! Boundary points should be updated 
     72            CALL lbc_bdy_lnk( tsa(:,:,:,jn), 'T', 1., ib_bdy ) 
     73            !  
     74         END DO 
    6475      END DO 
    6576      ! 
    6677   END SUBROUTINE bdy_tra 
    6778 
    68  
    69    SUBROUTINE bdy_tra_frs( idx, dta, kt ) 
     79   SUBROUTINE bdy_rnf( idx, pta, jpa ) 
    7080      !!---------------------------------------------------------------------- 
    71       !!                 ***  SUBROUTINE bdy_tra_frs  *** 
     81      !!                 ***  SUBROUTINE bdy_rnf  *** 
    7282      !!                     
    73       !! ** Purpose : Apply the Flow Relaxation Scheme for tracers at open boundaries. 
    74       !!  
    75       !! Reference : Engedahl H., 1995, Tellus, 365-382. 
    76       !!---------------------------------------------------------------------- 
    77       INTEGER,         INTENT(in) ::   kt    ! 
    78       TYPE(OBC_INDEX), INTENT(in) ::   idx   ! OBC indices 
    79       TYPE(OBC_DATA),  INTENT(in) ::   dta   ! OBC external data 
    80       ! 
    81       REAL(wp) ::   zwgt           ! boundary weight 
    82       INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
    83       INTEGER  ::   ii, ij         ! 2D addresses 
    84       !!---------------------------------------------------------------------- 
    85       ! 
    86       IF( nn_timing == 1 )   CALL timing_start('bdy_tra_frs') 
    87       ! 
    88       igrd = 1                       ! Everything is at T-points here 
    89       DO ib = 1, idx%nblen(igrd) 
    90          DO ik = 1, jpkm1 
    91             ii = idx%nbi(ib,igrd) 
    92             ij = idx%nbj(ib,igrd) 
    93             zwgt = idx%nbw(ib,igrd) 
    94             tsa(ii,ij,ik,jp_tem) = ( tsa(ii,ij,ik,jp_tem) + zwgt * ( dta%tem(ib,ik) - tsa(ii,ij,ik,jp_tem) ) ) * tmask(ii,ij,ik)          
    95             tsa(ii,ij,ik,jp_sal) = ( tsa(ii,ij,ik,jp_sal) + zwgt * ( dta%sal(ib,ik) - tsa(ii,ij,ik,jp_sal) ) ) * tmask(ii,ij,ik) 
    96          END DO 
    97       END DO  
    98       ! 
    99       IF( kt .eq. nit000 )   CLOSE( unit = 102 ) 
    100       ! 
    101       IF( nn_timing == 1 )   CALL timing_stop('bdy_tra_frs') 
    102       ! 
    103    END SUBROUTINE bdy_tra_frs 
    104  
    105  
    106    SUBROUTINE bdy_tra_spe( idx, dta, kt ) 
    107       !!---------------------------------------------------------------------- 
    108       !!                 ***  SUBROUTINE bdy_tra_frs  *** 
    109       !!                     
    110       !! ** Purpose : Apply a specified value for tracers at open boundaries. 
     83      !! ** Purpose : Specialized routine to apply TRA runoff values at OBs: 
     84      !!                  - duplicate the neighbour value for the temperature 
     85      !!                  - specified to 0.1 PSU for the salinity 
    11186      !!  
    11287      !!---------------------------------------------------------------------- 
    113       INTEGER,         INTENT(in) ::   kt    ! 
    114       TYPE(OBC_INDEX), INTENT(in) ::   idx   ! OBC indices 
    115       TYPE(OBC_DATA),  INTENT(in) ::   dta   ! OBC external data 
    116       ! 
    117       REAL(wp) ::   zwgt           ! boundary weight 
    118       INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
    119       INTEGER  ::   ii, ij         ! 2D addresses 
    120       !!---------------------------------------------------------------------- 
    121       ! 
    122       IF( nn_timing == 1 ) CALL timing_start('bdy_tra_spe') 
    123       ! 
    124       igrd = 1                       ! Everything is at T-points here 
    125       DO ib = 1, idx%nblenrim(igrd) 
    126          ii = idx%nbi(ib,igrd) 
    127          ij = idx%nbj(ib,igrd) 
    128          DO ik = 1, jpkm1 
    129             tsa(ii,ij,ik,jp_tem) = dta%tem(ib,ik) * tmask(ii,ij,ik) 
    130             tsa(ii,ij,ik,jp_sal) = dta%sal(ib,ik) * tmask(ii,ij,ik) 
    131          END DO 
    132       END DO 
    133       ! 
    134       IF( kt == nit000 )   CLOSE( unit = 102 ) 
    135       ! 
    136       IF( nn_timing == 1 )   CALL timing_stop('bdy_tra_spe') 
    137       ! 
    138    END SUBROUTINE bdy_tra_spe 
    139  
    140  
    141    SUBROUTINE bdy_tra_nmn( idx, dta, kt ) 
    142       !!---------------------------------------------------------------------- 
    143       !!                 ***  SUBROUTINE bdy_tra_nmn  *** 
    144       !!                     
    145       !! ** Purpose : Duplicate the value for tracers at open boundaries. 
    146       !!  
    147       !!---------------------------------------------------------------------- 
    148       INTEGER,         INTENT(in) ::   kt    !  
    149       TYPE(OBC_INDEX), INTENT(in) ::   idx   ! OBC indices 
    150       TYPE(OBC_DATA) , INTENT(in) ::   dta   ! OBC external data 
    151       ! 
    152       REAL(wp) ::   zwgt           ! boundary weight 
    153       INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
    154       INTEGER  ::   ii, ij,zcoef, zcoef1,zcoef2, ip, jp   ! 2D addresses 
    155       !!---------------------------------------------------------------------- 
    156       ! 
    157       IF( nn_timing == 1 )   CALL timing_start('bdy_tra_nmn') 
    158       ! 
    159       igrd = 1                       ! Everything is at T-points here 
    160       DO ib = 1, idx%nblenrim(igrd) 
    161          ii = idx%nbi(ib,igrd) 
    162          ij = idx%nbj(ib,igrd) 
    163          DO ik = 1, jpkm1 
    164             ! search the sense of the gradient 
    165             zcoef1 = bdytmask(ii-1,ij  ) +  bdytmask(ii+1,ij  ) 
    166             zcoef2 = bdytmask(ii  ,ij-1) +  bdytmask(ii  ,ij+1) 
    167             IF ( zcoef1+zcoef2 == 0) THEN 
    168                ! corner 
    169                zcoef = tmask(ii-1,ij,ik) + tmask(ii+1,ij,ik) +  tmask(ii,ij-1,ik) +  tmask(ii,ij+1,ik) 
    170                tsa(ii,ij,ik,jp_tem) = tsa(ii-1,ij  ,ik,jp_tem) * tmask(ii-1,ij  ,ik) + & 
    171                  &                    tsa(ii+1,ij  ,ik,jp_tem) * tmask(ii+1,ij  ,ik) + & 
    172                  &                    tsa(ii  ,ij-1,ik,jp_tem) * tmask(ii  ,ij-1,ik) + & 
    173                  &                    tsa(ii  ,ij+1,ik,jp_tem) * tmask(ii  ,ij+1,ik) 
    174                tsa(ii,ij,ik,jp_tem) = ( tsa(ii,ij,ik,jp_tem) / MAX( 1, zcoef) ) * tmask(ii,ij,ik) 
    175                tsa(ii,ij,ik,jp_sal) = tsa(ii-1,ij  ,ik,jp_sal) * tmask(ii-1,ij  ,ik) + & 
    176                  &                    tsa(ii+1,ij  ,ik,jp_sal) * tmask(ii+1,ij  ,ik) + & 
    177                  &                    tsa(ii  ,ij-1,ik,jp_sal) * tmask(ii  ,ij-1,ik) + & 
    178                  &                    tsa(ii  ,ij+1,ik,jp_sal) * tmask(ii  ,ij+1,ik) 
    179                tsa(ii,ij,ik,jp_sal) = ( tsa(ii,ij,ik,jp_sal) / MAX( 1, zcoef) ) * tmask(ii,ij,ik) 
    180             ELSE 
    181                ip = bdytmask(ii+1,ij  ) - bdytmask(ii-1,ij  ) 
    182                jp = bdytmask(ii  ,ij+1) - bdytmask(ii  ,ij-1) 
    183                tsa(ii,ij,ik,jp_tem) = tsa(ii+ip,ij+jp,ik,jp_tem) * tmask(ii+ip,ij+jp,ik) 
    184                tsa(ii,ij,ik,jp_sal) = tsa(ii+ip,ij+jp,ik,jp_sal) * tmask(ii+ip,ij+jp,ik) 
    185             ENDIF 
    186          END DO 
    187       END DO 
    188       ! 
    189       IF( kt == nit000 )   CLOSE( unit = 102 ) 
    190       ! 
    191       IF( nn_timing == 1 )   CALL timing_stop('bdy_tra_nmn') 
    192       ! 
    193    END SUBROUTINE bdy_tra_nmn 
    194   
    195  
    196    SUBROUTINE bdy_tra_orlanski( idx, dta, ll_npo ) 
    197       !!---------------------------------------------------------------------- 
    198       !!                 ***  SUBROUTINE bdy_tra_orlanski  *** 
    199       !!              
    200       !!              - Apply Orlanski radiation to temperature and salinity.  
    201       !!              - Wrapper routine for bdy_orlanski_3d 
    202       !!  
    203       !! 
    204       !! References:  Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001)     
    205       !!---------------------------------------------------------------------- 
    206       TYPE(OBC_INDEX), INTENT(in) ::   idx     ! OBC indices 
    207       TYPE(OBC_DATA) , INTENT(in) ::   dta     ! OBC external data 
    208       LOGICAL        , INTENT(in) ::   ll_npo  ! switch for NPO version 
    209       ! 
    210       INTEGER  ::   igrd                                    ! grid index 
    211       !!---------------------------------------------------------------------- 
    212       ! 
    213       IF( nn_timing == 1 ) CALL timing_start('bdy_tra_orlanski') 
    214       ! 
    215       igrd = 1      ! Orlanski bc on temperature;  
    216       !             
    217       CALL bdy_orlanski_3d( idx, igrd, tsb(:,:,:,jp_tem), tsa(:,:,:,jp_tem), dta%tem, ll_npo ) 
    218  
    219       igrd = 1      ! Orlanski bc on salinity; 
    220       !   
    221       CALL bdy_orlanski_3d( idx, igrd, tsb(:,:,:,jp_sal), tsa(:,:,:,jp_sal), dta%sal, ll_npo ) 
    222       ! 
    223       IF( nn_timing == 1 )   CALL timing_stop('bdy_tra_orlanski') 
    224       ! 
    225    END SUBROUTINE bdy_tra_orlanski 
    226  
    227  
    228    SUBROUTINE bdy_tra_rnf( idx, dta, kt ) 
    229       !!---------------------------------------------------------------------- 
    230       !!                 ***  SUBROUTINE bdy_tra_rnf  *** 
    231       !!                     
    232       !! ** Purpose : Apply the runoff values for tracers at open boundaries: 
    233       !!                  - specified to 0.1 PSU for the salinity 
    234       !!                  - duplicate the value for the temperature 
    235       !!  
    236       !!---------------------------------------------------------------------- 
    237       INTEGER        , INTENT(in) ::   kt    !  
    238       TYPE(OBC_INDEX), INTENT(in) ::   idx   ! OBC indices 
    239       TYPE(OBC_DATA) , INTENT(in) ::   dta   ! OBC external data 
     88      TYPE(OBC_INDEX),                     INTENT(in) ::   idx  ! OBC indices 
     89      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pta  ! tracer trend 
     90      INTEGER,                             INTENT(in) ::   jpa  ! TRA index 
    24091      ! 
    24192      REAL(wp) ::   zwgt           ! boundary weight 
     
    24495      !!---------------------------------------------------------------------- 
    24596      ! 
    246       IF( nn_timing == 1 )   CALL timing_start('bdy_tra_rnf') 
     97      IF( nn_timing == 1 )   CALL timing_start('bdy_rnf') 
    24798      ! 
    24899      igrd = 1                       ! Everything is at T-points here 
     
    253104            ip = bdytmask(ii+1,ij  ) - bdytmask(ii-1,ij  ) 
    254105            jp = bdytmask(ii  ,ij+1) - bdytmask(ii  ,ij-1) 
    255             tsa(ii,ij,ik,jp_tem) = tsa(ii+ip,ij+jp,ik,jp_tem) * tmask(ii,ij,ik) 
    256             tsa(ii,ij,ik,jp_sal) =                        0.1 * tmask(ii,ij,ik) 
     106            if (jpa == jp_tem) pta(ii,ij,ik) = pta(ii+ip,ij+jp,ik) * tmask(ii,ij,ik) 
     107            if (jpa == jp_sal) pta(ii,ij,ik) =                 0.1 * tmask(ii,ij,ik) 
    257108         END DO 
    258109      END DO 
    259110      ! 
    260       IF( kt == nit000 )   CLOSE( unit = 102 ) 
     111      IF( nn_timing == 1 )   CALL timing_stop('bdy_rnf') 
    261112      ! 
    262       IF( nn_timing == 1 )   CALL timing_stop('bdy_tra_rnf') 
    263       ! 
    264    END SUBROUTINE bdy_tra_rnf 
    265  
     113   END SUBROUTINE bdy_rnf 
    266114 
    267115   SUBROUTINE bdy_tra_dmp( kt ) 
  • branches/2016/dev_r6522_SIMPLIF_3/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfric.F90

    r6489 r7058  
    202202         DO jj = 2, jpjm1 
    203203            DO ji = fs_2, fs_jpim1 
    204                IF( fsdept(ji,jj,jk) < ekm_dep(ji,jj) ) THEN 
     204               IF( gdept_n(ji,jj,jk) < ekm_dep(ji,jj) ) THEN 
    205205                  avmv(ji,jj,jk) = MAX( avmv(ji,jj,jk), rn_wvmix ) 
    206206                  avmu(ji,jj,jk) = MAX( avmu(ji,jj,jk), rn_wvmix ) 
  • branches/2016/dev_r6522_SIMPLIF_3/NEMOGCM/NEMO/TOP_SRC/trcbdy.F90

    r6862 r7058  
    99   !!            3.5  !  2012     (S. Mocavero, I. Epicoco) Optimization of BDY communications 
    1010   !!            3.6  !  2015     (T. Lovato) Adapt BDY for tracers in TOP component 
     11   !!            4.0  !  2016     (T. Lovato) Generalize OBC structure 
    1112   !!---------------------------------------------------------------------- 
    1213#if defined key_top 
    1314   !!---------------------------------------------------------------------- 
    14    !!   trc_bdy            : Apply open boundary conditions to T and S 
    15    !!   trc_bdy_frs        : Apply Flow Relaxation Scheme 
     15   !!   trc_bdy       : Apply open boundary conditions & damping to tracers 
    1616   !!---------------------------------------------------------------------- 
    1717   USE timing                       ! Timing 
     
    2222   USE lbclnk                       ! ocean lateral boundary conditions (or mpp link) 
    2323   USE in_out_manager               ! I/O manager 
    24    USE bdy_oce, only: idx_bdy, OBC_INDEX, BDYTMASK, ln_bdy       ! ocean open boundary conditions 
     24   USE bdy_oce, only: idx_bdy       ! ocean open boundary conditions 
    2525 
    2626   IMPLICIT NONE 
    2727   PRIVATE 
     28 
     29   ! Local structure to rearrange tracers data 
     30   TYPE, PUBLIC ::   ztrcbdy 
     31      REAL(wp), POINTER, DIMENSION(:,:) ::  trc 
     32      REAL(wp), POINTER                 ::  fac 
     33   END TYPE 
    2834 
    2935   PUBLIC trc_bdy      ! routine called in trcnxt.F90  
     
    3137 
    3238   !!---------------------------------------------------------------------- 
    33    !! NEMO/OPA 3.6 , NEMO Consortium (2015) 
     39   !! NEMO/OPA 4.0 , NEMO Consortium (2016) 
    3440   !! $Id$  
    3541   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
     
    4147      !!                  ***  SUBROUTINE trc_bdy  *** 
    4248      !! 
    43       !! ** Purpose : - Apply open boundary conditions for tracers in TOP component 
    44       !!                and scale the tracer data 
     49      !! ** Purpose : - Apply open boundary conditions for TOP tracers 
    4550      !! 
    4651      !!---------------------------------------------------------------------- 
     
    4853      !! 
    4954      INTEGER               :: ib_bdy, jn ! Loop indeces 
     55      TYPE(ztrcbdy)         :: zdta       ! Temporary data structure 
    5056      !!---------------------------------------------------------------------- 
    5157      ! 
    5258      IF( nn_timing == 1 ) CALL timing_start('trc_bdy') 
    5359      ! 
    54       DO jn = 1, jptra 
    55          DO ib_bdy=1, nb_bdy 
    56  
    57             SELECT CASE( trcdta_bdy(jn,ib_bdy)%cn_obc ) 
    58             CASE('none') 
    59                CYCLE 
    60             CASE('frs') 
    61                CALL bdy_trc_frs( jn, idx_bdy(ib_bdy), trcdta_bdy(jn,ib_bdy), kt ) 
    62             CASE('specified') 
    63                CALL bdy_trc_spe( jn, idx_bdy(ib_bdy), trcdta_bdy(jn,ib_bdy), kt ) 
    64             CASE('neumann') 
    65                CALL bdy_trc_nmn( jn, idx_bdy(ib_bdy), trcdta_bdy(jn,ib_bdy), kt ) 
    66             CASE('orlanski') 
    67                CALL bdy_trc_orlanski( jn, idx_bdy(ib_bdy), trcdta_bdy(jn,ib_bdy), ll_npo=.false. ) 
    68             CASE('orlanski_npo') 
    69                CALL bdy_trc_orlanski( jn, idx_bdy(ib_bdy), trcdta_bdy(jn,ib_bdy), ll_npo=.true. ) 
    70             CASE DEFAULT 
    71                CALL ctl_stop( 'trc_bdy : unrecognised option for open boundaries for passive tracers' ) 
     60      DO ib_bdy=1, nb_bdy 
     61         DO jn = 1, jptra 
     62            ! 
     63            zdta%trc => trcdta_bdy(jn,ib_bdy)%trc  
     64            zdta%fac => trcdta_bdy(jn,ib_bdy)%rn_fac 
     65            ! 
     66            SELECT CASE( TRIM(trcdta_bdy(jn,ib_bdy)%cn_obc) ) 
     67            CASE('none'        )   ;   CYCLE 
     68            CASE('frs'         )   ;   CALL bdy_frs( idx_bdy(ib_bdy),                tra(:,:,:,jn), zdta%trc*zdta%fac ) 
     69            CASE('specified'   )   ;   CALL bdy_spe( idx_bdy(ib_bdy),                tra(:,:,:,jn), zdta%trc*zdta%fac ) 
     70            CASE('neumann'     )   ;   CALL bdy_nmn( idx_bdy(ib_bdy),                tra(:,:,:,jn) ) 
     71            CASE('orlanski'    )   ;   CALL bdy_orl( idx_bdy(ib_bdy), trb(:,:,:,jn), tra(:,:,:,jn), zdta%trc*zdta%fac, ll_npo=.false. ) 
     72            CASE('orlanski_npo')   ;   CALL bdy_orl( idx_bdy(ib_bdy), trb(:,:,:,jn), tra(:,:,:,jn), zdta%trc*zdta%fac, ll_npo=.true. ) 
     73            CASE DEFAULT           ;   CALL ctl_stop( 'trc_bdy : unrecognised option for open boundaries for passive tracers' ) 
    7274            END SELECT 
    73  
    7475            ! Boundary points should be updated 
    7576            CALL lbc_bdy_lnk( tra(:,:,:,jn), 'T', 1., ib_bdy ) 
    76  
    77          ENDDO 
    78       ENDDO 
     77            ! 
     78         END DO 
     79      END DO 
    7980      ! 
    8081      IF( nn_timing == 1 ) CALL timing_stop('trc_bdy') 
    8182 
    8283   END SUBROUTINE trc_bdy 
    83  
    84    SUBROUTINE bdy_trc_frs( jn, idx, dta, kt ) 
    85       !!---------------------------------------------------------------------- 
    86       !!                 ***  SUBROUTINE bdy_trc_frs  *** 
    87       !!                     
    88       !! ** Purpose : Apply the Flow Relaxation Scheme for tracers at open boundaries. 
    89       !!  
    90       !! Reference : Engedahl H., 1995, Tellus, 365-382. 
    91       !!---------------------------------------------------------------------- 
    92       INTEGER,         INTENT(in) ::   kt 
    93       INTEGER,         INTENT(in) ::   jn   ! Tracer index 
    94       TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
    95       TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data 
    96       !!  
    97       REAL(wp) ::   zwgt           ! boundary weight 
    98       INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
    99       INTEGER  ::   ii, ij         ! 2D addresses 
    100       !!---------------------------------------------------------------------- 
    101       ! 
    102       IF( nn_timing == 1 ) CALL timing_start('bdy_trc_frs') 
    103       !  
    104       igrd = 1                       ! Everything is at T-points here 
    105       DO ib = 1, idx%nblen(igrd) 
    106          DO ik = 1, jpkm1 
    107             ii = idx%nbi(ib,igrd) 
    108             ij = idx%nbj(ib,igrd) 
    109             zwgt = idx%nbw(ib,igrd) 
    110             tra(ii,ij,ik,jn) = ( tra(ii,ij,ik,jn) + zwgt * ( ( dta%trc(ib,ik) * dta%rn_fac)  &  
    111                         &  - tra(ii,ij,ik,jn) ) ) * tmask(ii,ij,ik) 
    112          END DO 
    113       END DO  
    114       ! 
    115       IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 
    116       ! 
    117       IF( nn_timing == 1 ) CALL timing_stop('bdy_trc_frs') 
    118       ! 
    119    END SUBROUTINE bdy_trc_frs 
    120    
    121    SUBROUTINE bdy_trc_spe( jn, idx, dta, kt ) 
    122       !!---------------------------------------------------------------------- 
    123       !!                 ***  SUBROUTINE bdy_trc_frs  *** 
    124       !!                     
    125       !! ** Purpose : Apply a specified value for tracers at open boundaries. 
    126       !!  
    127       !!---------------------------------------------------------------------- 
    128       INTEGER,         INTENT(in) ::   kt 
    129       INTEGER,         INTENT(in) ::   jn   ! Tracer index 
    130       TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
    131       TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data 
    132       !!  
    133       REAL(wp) ::   zwgt           ! boundary weight 
    134       INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
    135       INTEGER  ::   ii, ij         ! 2D addresses 
    136       !!---------------------------------------------------------------------- 
    137       ! 
    138       IF( nn_timing == 1 ) CALL timing_start('bdy_trc_spe') 
    139       ! 
    140       igrd = 1                       ! Everything is at T-points here 
    141       DO ib = 1, idx%nblenrim(igrd) 
    142          ii = idx%nbi(ib,igrd) 
    143          ij = idx%nbj(ib,igrd) 
    144          DO ik = 1, jpkm1 
    145             tra(ii,ij,ik,jn) = dta%trc(ib,ik) * dta%rn_fac * tmask(ii,ij,ik) 
    146          END DO 
    147       END DO 
    148       ! 
    149       IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 
    150       ! 
    151       IF( nn_timing == 1 ) CALL timing_stop('bdy_trc_spe') 
    152       ! 
    153    END SUBROUTINE bdy_trc_spe 
    154  
    155    SUBROUTINE bdy_trc_nmn( jn, idx, dta, kt ) 
    156       !!---------------------------------------------------------------------- 
    157       !!                 ***  SUBROUTINE bdy_trc_nmn  *** 
    158       !!                     
    159       !! ** Purpose : Duplicate the value for tracers at open boundaries. 
    160       !!  
    161       !!---------------------------------------------------------------------- 
    162       INTEGER,         INTENT(in) ::   kt 
    163       INTEGER,         INTENT(in) ::   jn   ! Tracer index 
    164       TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
    165       TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data 
    166       !!  
    167       REAL(wp) ::   zwgt           ! boundary weight 
    168       INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
    169       INTEGER  ::   ii, ij, zcoef, zcoef1, zcoef2, ip, jp   ! 2D addresses 
    170       !!---------------------------------------------------------------------- 
    171       ! 
    172       IF( nn_timing == 1 ) CALL timing_start('bdy_trc_nmn') 
    173       ! 
    174       igrd = 1                       ! Everything is at T-points here 
    175       DO ib = 1, idx%nblenrim(igrd) 
    176          ii = idx%nbi(ib,igrd) 
    177          ij = idx%nbj(ib,igrd) 
    178          DO ik = 1, jpkm1 
    179             ! search the sense of the gradient 
    180             zcoef1 = bdytmask(ii-1,ij  ) +  bdytmask(ii+1,ij  ) 
    181             zcoef2 = bdytmask(ii  ,ij-1) +  bdytmask(ii  ,ij+1) 
    182             IF ( zcoef1+zcoef2 == 0) THEN 
    183                ! corner 
    184                zcoef = tmask(ii-1,ij,ik) + tmask(ii+1,ij,ik) +  tmask(ii,ij-1,ik) +  tmask(ii,ij+1,ik) 
    185                tra(ii,ij,ik,jn) = tra(ii-1,ij  ,ik,jn) * tmask(ii-1,ij  ,ik) + & 
    186                  &                tra(ii+1,ij  ,ik,jn) * tmask(ii+1,ij  ,ik) + & 
    187                  &                tra(ii  ,ij-1,ik,jn) * tmask(ii  ,ij-1,ik) + & 
    188                  &                tra(ii  ,ij+1,ik,jn) * tmask(ii  ,ij+1,ik) 
    189                tra(ii,ij,ik,jn) = ( tra(ii,ij,ik,jn) / MAX( 1, zcoef) ) * tmask(ii,ij,ik) 
    190             ELSE 
    191                ip = bdytmask(ii+1,ij  ) - bdytmask(ii-1,ij  ) 
    192                jp = bdytmask(ii  ,ij+1) - bdytmask(ii  ,ij-1) 
    193                tra(ii,ij,ik,jn) = tra(ii+ip,ij+jp,ik,jn) * tmask(ii+ip,ij+jp,ik) 
    194             ENDIF 
    195          END DO 
    196       END DO 
    197       ! 
    198       IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 
    199       ! 
    200       IF( nn_timing == 1 ) CALL timing_stop('bdy_trc_nmn') 
    201       ! 
    202    END SUBROUTINE bdy_trc_nmn 
    203   
    204  
    205    SUBROUTINE bdy_trc_orlanski( jn, idx, dta, ll_npo ) 
    206       !!---------------------------------------------------------------------- 
    207       !!                 ***  SUBROUTINE bdy_trc_orlanski  *** 
    208       !!              
    209       !!              - Apply Orlanski radiation to tracers of TOP component.  
    210       !!              - Wrapper routine for bdy_orlanski_3d 
    211       !!  
    212       !! 
    213       !! References:  Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001)     
    214       !!---------------------------------------------------------------------- 
    215       INTEGER,                      INTENT(in) ::   jn      ! Tracer index 
    216       TYPE(OBC_INDEX),              INTENT(in) ::   idx     ! OBC indices 
    217       TYPE(OBC_DATA),               INTENT(in) ::   dta     ! OBC external data 
    218       LOGICAL,                      INTENT(in) ::   ll_npo  ! switch for NPO version 
    219  
    220       INTEGER  ::   igrd                                    ! grid index 
    221       !!---------------------------------------------------------------------- 
    222  
    223       IF( nn_timing == 1 ) CALL timing_start('bdy_trc_orlanski') 
    224       ! 
    225       igrd = 1      ! Orlanski bc on tracers;  
    226       !             
    227       CALL bdy_orlanski_3d( idx, igrd, trb(:,:,:,jn), tra(:,:,:,jn), (dta%trc * dta%rn_fac), ll_npo ) 
    228       ! 
    229       IF( nn_timing == 1 ) CALL timing_stop('bdy_trc_orlanski') 
    230       ! 
    231  
    232    END SUBROUTINE bdy_trc_orlanski 
    23384 
    23485   SUBROUTINE trc_bdy_dmp( kt ) 
  • branches/2016/dev_r6522_SIMPLIF_3/NEMOGCM/NEMO/TOP_SRC/trcsub.F90

    r6862 r7058  
    499499      z1_rau0 = 0.5 / rau0 
    500500      ssha(:,:) = (  sshb(:,:) - z2dt * ( z1_rau0 * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) )  ) * tmask(:,:,1) 
    501 #if ! defined key_dynspg_ts 
     501 
     502      IF( .NOT.ln_dynspg_ts ) THEN 
    502503      ! These lines are not necessary with time splitting since 
    503504      ! boundary condition on sea level is set during ts loop 
     
    505506      CALL agrif_ssh( kt ) 
    506507#endif 
    507       IF( ln_bdy ) THEN 
    508          ssha(:,:) = ssha(:,:) * bdytmask(:,:) 
    509          CALL lbc_lnk( ssha, 'T', 1. )  
    510       ENDIF 
    511 #endif 
     508         IF( ln_bdy ) THEN 
     509            ssha(:,:) = ssha(:,:) * bdytmask(:,:) 
     510            CALL lbc_lnk( ssha, 'T', 1. )  
     511         ENDIF 
     512      ENDIF 
    512513      ! 
    513514      !                                           !------------------------------! 
Note: See TracChangeset for help on using the changeset viewer.