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 7646 for trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90 – NEMO

Ignore:
Timestamp:
2017-02-06T10:25:03+01:00 (7 years ago)
Author:
timgraham
Message:

Merge of dev_merge_2016 into trunk. UPDATE TO ARCHFILES NEEDED for XIOS2.
LIM_SRC_s/limrhg.F90 to follow in next commit due to change of kind (I'm unable to do it in this commit).
Merged using the following steps:

1) svn merge --reintegrate ​svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk .
2) Resolve minor conflicts in sette.sh and namelist_cfg for ORCA2LIM3 (due to a change in trunk after branch was created)
3) svn commit
4) svn switch ​svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
5) svn merge ​svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2016/dev_merge_2016 .
6) At this stage I checked out a clean copy of the branch to compare against what is about to be committed to the trunk.
6) svn commit #Commit code to the trunk

In this commit I have also reverted a change to Fcheck_archfile.sh which was causing problems on the Paris machine.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90

    r6140 r7646  
    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 #if defined key_bdy 
    12    !!---------------------------------------------------------------------- 
    13    !!   'key_bdy'                     Unstructured Open Boundary Conditions 
    14    !!---------------------------------------------------------------------- 
    15    !!   bdy_tra            : Apply open boundary conditions to T and S 
    16    !!   bdy_tra_frs        : Apply Flow Relaxation Scheme 
     12   !!   bdy_tra       : Apply open boundary conditions & damping to T and S 
    1713   !!---------------------------------------------------------------------- 
    1814   USE oce            ! ocean dynamics and tracers variables 
    … …  
    2016   USE bdy_oce        ! ocean open boundary conditions 
    2117   USE bdylib         ! for orlanski library routines 
    22    USE bdydta   , ONLY:   bf   !  
    2318   ! 
    2419   USE in_out_manager ! I/O manager 
    … …  
    2924   PRIVATE 
    3025 
     26   ! Local structure to rearrange tracers data 
     27   TYPE, PUBLIC ::   ztrabdy 
     28      REAL(wp), POINTER, DIMENSION(:,:) ::  tra 
     29   END TYPE 
     30 
    3131   PUBLIC   bdy_tra      ! called in tranxt.F90  
    3232   PUBLIC   bdy_tra_dmp  ! called in step.F90  
    3333 
    3434   !!---------------------------------------------------------------------- 
    35    !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
     35   !! NEMO/OPA 4.0, NEMO Consortium (2016) 
    3636   !! $Id$  
    3737   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    4848      INTEGER, INTENT(in) ::   kt   ! Main time step counter 
    4949      ! 
    50       INTEGER ::   ib_bdy   ! Loop index 
     50      INTEGER                        :: ib_bdy, jn, igrd   ! Loop indeces 
     51      TYPE(ztrabdy), DIMENSION(jpts) :: zdta               ! Temporary data structure 
    5152      !!---------------------------------------------------------------------- 
     53      igrd = 1  
    5254 
    5355      DO ib_bdy=1, nb_bdy 
    5456         ! 
    55          SELECT CASE( cn_tra(ib_bdy) ) 
    56          CASE('none'        )   ;   CYCLE 
    57          CASE('frs'         )   ;   CALL bdy_tra_frs     ( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 
    58          CASE('specified'   )   ;   CALL bdy_tra_spe     ( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 
    59          CASE('neumann'     )   ;   CALL bdy_tra_nmn     ( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 
    60          CASE('orlanski'    )   ;   CALL bdy_tra_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ll_npo=.false. ) 
    61          CASE('orlanski_npo')   ;   CALL bdy_tra_orlanski( idx_bdy(ib_bdy), dta_bdy(ib_bdy), ll_npo=.true. ) 
    62          CASE('runoff'      )   ;   CALL bdy_tra_rnf     ( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 
    63          CASE DEFAULT           ;   CALL ctl_stop( 'bdy_tra : unrecognised option for open boundaries for T and S' ) 
    64          END SELECT 
    65          ! Boundary points should be updated 
    66          CALL lbc_bdy_lnk( tsa(:,:,:,jp_tem), 'T', 1., ib_bdy ) 
    67          CALL lbc_bdy_lnk( tsa(:,:,:,jp_sal), 'T', 1., ib_bdy ) 
     57         zdta(1)%tra => dta_bdy(ib_bdy)%tem 
     58         zdta(2)%tra => dta_bdy(ib_bdy)%sal 
     59         ! 
     60         DO jn = 1, jpts 
     61            ! 
     62            SELECT CASE( TRIM(cn_tra(ib_bdy)) ) 
     63            CASE('none'        )   ;   CYCLE 
     64            CASE('frs'         )   ;   CALL bdy_frs ( idx_bdy(ib_bdy),                tsa(:,:,:,jn), zdta(jn)%tra ) 
     65            CASE('specified'   )   ;   CALL bdy_spe ( idx_bdy(ib_bdy),                tsa(:,:,:,jn), zdta(jn)%tra ) 
     66            CASE('neumann'     )   ;   CALL bdy_nmn ( idx_bdy(ib_bdy), igrd         , tsa(:,:,:,jn)               ) 
     67            CASE('orlanski'    )   ;   CALL bdy_orl ( idx_bdy(ib_bdy), tsb(:,:,:,jn), tsa(:,:,:,jn), zdta(jn)%tra, ll_npo=.false. ) 
     68            CASE('orlanski_npo')   ;   CALL bdy_orl ( idx_bdy(ib_bdy), tsb(:,:,:,jn), tsa(:,:,:,jn), zdta(jn)%tra, ll_npo=.true. ) 
     69            CASE('runoff'      )   ;   CALL bdy_rnf ( idx_bdy(ib_bdy),                tsa(:,:,:,jn),               jn ) 
     70            CASE DEFAULT           ;   CALL ctl_stop( 'bdy_tra : unrecognised option for open boundaries for T and S' ) 
     71            END SELECT 
     72            ! Boundary points should be updated 
     73            CALL lbc_bdy_lnk( tsa(:,:,:,jn), 'T', 1., ib_bdy ) 
     74            !  
     75         END DO 
    6876      END DO 
    6977      ! 
    7078   END SUBROUTINE bdy_tra 
    7179 
    72  
    73    SUBROUTINE bdy_tra_frs( idx, dta, kt ) 
     80   SUBROUTINE bdy_rnf( idx, pta, jpa ) 
    7481      !!---------------------------------------------------------------------- 
    75       !!                 ***  SUBROUTINE bdy_tra_frs  *** 
     82      !!                 ***  SUBROUTINE bdy_rnf  *** 
    7683      !!                     
    77       !! ** Purpose : Apply the Flow Relaxation Scheme for tracers at open boundaries. 
    78       !!  
    79       !! Reference : Engedahl H., 1995, Tellus, 365-382. 
    80       !!---------------------------------------------------------------------- 
    81       INTEGER,         INTENT(in) ::   kt    ! 
    82       TYPE(OBC_INDEX), INTENT(in) ::   idx   ! OBC indices 
    83       TYPE(OBC_DATA),  INTENT(in) ::   dta   ! OBC external data 
    84       ! 
    85       REAL(wp) ::   zwgt           ! boundary weight 
    86       INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
    87       INTEGER  ::   ii, ij         ! 2D addresses 
    88       !!---------------------------------------------------------------------- 
    89       ! 
    90       IF( nn_timing == 1 )   CALL timing_start('bdy_tra_frs') 
    91       ! 
    92       igrd = 1                       ! Everything is at T-points here 
    93       DO ib = 1, idx%nblen(igrd) 
    94          DO ik = 1, jpkm1 
    95             ii = idx%nbi(ib,igrd) 
    96             ij = idx%nbj(ib,igrd) 
    97             zwgt = idx%nbw(ib,igrd) 
    98             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)          
    99             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) 
    100          END DO 
    101       END DO  
    102       ! 
    103       IF( kt .eq. nit000 )   CLOSE( unit = 102 ) 
    104       ! 
    105       IF( nn_timing == 1 )   CALL timing_stop('bdy_tra_frs') 
    106       ! 
    107    END SUBROUTINE bdy_tra_frs 
    108  
    109  
    110    SUBROUTINE bdy_tra_spe( idx, dta, kt ) 
    111       !!---------------------------------------------------------------------- 
    112       !!                 ***  SUBROUTINE bdy_tra_frs  *** 
    113       !!                     
    114       !! ** Purpose : Apply a specified value for tracers at open boundaries. 
     84      !! ** Purpose : Specialized routine to apply TRA runoff values at OBs: 
     85      !!                  - duplicate the neighbour value for the temperature 
     86      !!                  - specified to 0.1 PSU for the salinity 
    11587      !!  
    11688      !!---------------------------------------------------------------------- 
    117       INTEGER,         INTENT(in) ::   kt    ! 
    118       TYPE(OBC_INDEX), INTENT(in) ::   idx   ! OBC indices 
    119       TYPE(OBC_DATA),  INTENT(in) ::   dta   ! OBC external data 
    120       ! 
    121       REAL(wp) ::   zwgt           ! boundary weight 
    122       INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
    123       INTEGER  ::   ii, ij         ! 2D addresses 
    124       !!---------------------------------------------------------------------- 
    125       ! 
    126       IF( nn_timing == 1 ) CALL timing_start('bdy_tra_spe') 
    127       ! 
    128       igrd = 1                       ! Everything is at T-points here 
    129       DO ib = 1, idx%nblenrim(igrd) 
    130          ii = idx%nbi(ib,igrd) 
    131          ij = idx%nbj(ib,igrd) 
    132          DO ik = 1, jpkm1 
    133             tsa(ii,ij,ik,jp_tem) = dta%tem(ib,ik) * tmask(ii,ij,ik) 
    134             tsa(ii,ij,ik,jp_sal) = dta%sal(ib,ik) * tmask(ii,ij,ik) 
    135          END DO 
    136       END DO 
    137       ! 
    138       IF( kt == nit000 )   CLOSE( unit = 102 ) 
    139       ! 
    140       IF( nn_timing == 1 )   CALL timing_stop('bdy_tra_spe') 
    141       ! 
    142    END SUBROUTINE bdy_tra_spe 
    143  
    144  
    145    SUBROUTINE bdy_tra_nmn( idx, dta, kt ) 
    146       !!---------------------------------------------------------------------- 
    147       !!                 ***  SUBROUTINE bdy_tra_nmn  *** 
    148       !!                     
    149       !! ** Purpose : Duplicate the value for tracers at open boundaries. 
    150       !!  
    151       !!---------------------------------------------------------------------- 
    152       INTEGER,         INTENT(in) ::   kt    !  
    153       TYPE(OBC_INDEX), INTENT(in) ::   idx   ! OBC indices 
    154       TYPE(OBC_DATA) , INTENT(in) ::   dta   ! OBC external data 
    155       ! 
    156       REAL(wp) ::   zwgt           ! boundary weight 
    157       INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
    158       INTEGER  ::   ii, ij,zcoef, zcoef1,zcoef2, ip, jp   ! 2D addresses 
    159       !!---------------------------------------------------------------------- 
    160       ! 
    161       IF( nn_timing == 1 )   CALL timing_start('bdy_tra_nmn') 
    162       ! 
    163       igrd = 1                       ! Everything is at T-points here 
    164       DO ib = 1, idx%nblenrim(igrd) 
    165          ii = idx%nbi(ib,igrd) 
    166          ij = idx%nbj(ib,igrd) 
    167          DO ik = 1, jpkm1 
    168             ! search the sense of the gradient 
    169             zcoef1 = bdytmask(ii-1,ij  ) +  bdytmask(ii+1,ij  ) 
    170             zcoef2 = bdytmask(ii  ,ij-1) +  bdytmask(ii  ,ij+1) 
    171             IF ( zcoef1+zcoef2 == 0) THEN 
    172                ! corner 
    173                zcoef = tmask(ii-1,ij,ik) + tmask(ii+1,ij,ik) +  tmask(ii,ij-1,ik) +  tmask(ii,ij+1,ik) 
    174                tsa(ii,ij,ik,jp_tem) = tsa(ii-1,ij  ,ik,jp_tem) * tmask(ii-1,ij  ,ik) + & 
    175                  &                    tsa(ii+1,ij  ,ik,jp_tem) * tmask(ii+1,ij  ,ik) + & 
    176                  &                    tsa(ii  ,ij-1,ik,jp_tem) * tmask(ii  ,ij-1,ik) + & 
    177                  &                    tsa(ii  ,ij+1,ik,jp_tem) * tmask(ii  ,ij+1,ik) 
    178                tsa(ii,ij,ik,jp_tem) = ( tsa(ii,ij,ik,jp_tem) / MAX( 1, zcoef) ) * tmask(ii,ij,ik) 
    179                tsa(ii,ij,ik,jp_sal) = tsa(ii-1,ij  ,ik,jp_sal) * tmask(ii-1,ij  ,ik) + & 
    180                  &                    tsa(ii+1,ij  ,ik,jp_sal) * tmask(ii+1,ij  ,ik) + & 
    181                  &                    tsa(ii  ,ij-1,ik,jp_sal) * tmask(ii  ,ij-1,ik) + & 
    182                  &                    tsa(ii  ,ij+1,ik,jp_sal) * tmask(ii  ,ij+1,ik) 
    183                tsa(ii,ij,ik,jp_sal) = ( tsa(ii,ij,ik,jp_sal) / MAX( 1, zcoef) ) * tmask(ii,ij,ik) 
    184             ELSE 
    185                ip = bdytmask(ii+1,ij  ) - bdytmask(ii-1,ij  ) 
    186                jp = bdytmask(ii  ,ij+1) - bdytmask(ii  ,ij-1) 
    187                tsa(ii,ij,ik,jp_tem) = tsa(ii+ip,ij+jp,ik,jp_tem) * tmask(ii+ip,ij+jp,ik) 
    188                tsa(ii,ij,ik,jp_sal) = tsa(ii+ip,ij+jp,ik,jp_sal) * tmask(ii+ip,ij+jp,ik) 
    189             ENDIF 
    190          END DO 
    191       END DO 
    192       ! 
    193       IF( kt == nit000 )   CLOSE( unit = 102 ) 
    194       ! 
    195       IF( nn_timing == 1 )   CALL timing_stop('bdy_tra_nmn') 
    196       ! 
    197    END SUBROUTINE bdy_tra_nmn 
    198   
    199  
    200    SUBROUTINE bdy_tra_orlanski( idx, dta, ll_npo ) 
    201       !!---------------------------------------------------------------------- 
    202       !!                 ***  SUBROUTINE bdy_tra_orlanski  *** 
    203       !!              
    204       !!              - Apply Orlanski radiation to temperature and salinity.  
    205       !!              - Wrapper routine for bdy_orlanski_3d 
    206       !!  
    207       !! 
    208       !! References:  Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001)     
    209       !!---------------------------------------------------------------------- 
    210       TYPE(OBC_INDEX), INTENT(in) ::   idx     ! OBC indices 
    211       TYPE(OBC_DATA) , INTENT(in) ::   dta     ! OBC external data 
    212       LOGICAL        , INTENT(in) ::   ll_npo  ! switch for NPO version 
    213       ! 
    214       INTEGER  ::   igrd                                    ! grid index 
    215       !!---------------------------------------------------------------------- 
    216       ! 
    217       IF( nn_timing == 1 ) CALL timing_start('bdy_tra_orlanski') 
    218       ! 
    219       igrd = 1      ! Orlanski bc on temperature;  
    220       !             
    221       CALL bdy_orlanski_3d( idx, igrd, tsb(:,:,:,jp_tem), tsa(:,:,:,jp_tem), dta%tem, ll_npo ) 
    222  
    223       igrd = 1      ! Orlanski bc on salinity; 
    224       !   
    225       CALL bdy_orlanski_3d( idx, igrd, tsb(:,:,:,jp_sal), tsa(:,:,:,jp_sal), dta%sal, ll_npo ) 
    226       ! 
    227       IF( nn_timing == 1 )   CALL timing_stop('bdy_tra_orlanski') 
    228       ! 
    229    END SUBROUTINE bdy_tra_orlanski 
    230  
    231  
    232    SUBROUTINE bdy_tra_rnf( idx, dta, kt ) 
    233       !!---------------------------------------------------------------------- 
    234       !!                 ***  SUBROUTINE bdy_tra_rnf  *** 
    235       !!                     
    236       !! ** Purpose : Apply the runoff values for tracers at open boundaries: 
    237       !!                  - specified to 0.1 PSU for the salinity 
    238       !!                  - duplicate the value for the temperature 
    239       !!  
    240       !!---------------------------------------------------------------------- 
    241       INTEGER        , INTENT(in) ::   kt    !  
    242       TYPE(OBC_INDEX), INTENT(in) ::   idx   ! OBC indices 
    243       TYPE(OBC_DATA) , INTENT(in) ::   dta   ! OBC external data 
     89      TYPE(OBC_INDEX),                     INTENT(in) ::   idx  ! OBC indices 
     90      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pta  ! tracer trend 
     91      INTEGER,                             INTENT(in) ::   jpa  ! TRA index 
    24492      ! 
    24593      REAL(wp) ::   zwgt           ! boundary weight 
    … …  
    24896      !!---------------------------------------------------------------------- 
    24997      ! 
    250       IF( nn_timing == 1 )   CALL timing_start('bdy_tra_rnf') 
     98      IF( nn_timing == 1 )   CALL timing_start('bdy_rnf') 
    25199      ! 
    252100      igrd = 1                       ! Everything is at T-points here 
    … …  
    257105            ip = bdytmask(ii+1,ij  ) - bdytmask(ii-1,ij  ) 
    258106            jp = bdytmask(ii  ,ij+1) - bdytmask(ii  ,ij-1) 
    259             tsa(ii,ij,ik,jp_tem) = tsa(ii+ip,ij+jp,ik,jp_tem) * tmask(ii,ij,ik) 
    260             tsa(ii,ij,ik,jp_sal) =                        0.1 * tmask(ii,ij,ik) 
     107            if (jpa == jp_tem) pta(ii,ij,ik) = pta(ii+ip,ij+jp,ik) * tmask(ii,ij,ik) 
     108            if (jpa == jp_sal) pta(ii,ij,ik) =                 0.1 * tmask(ii,ij,ik) 
    261109         END DO 
    262110      END DO 
    263111      ! 
    264       IF( kt == nit000 )   CLOSE( unit = 102 ) 
     112      IF( nn_timing == 1 )   CALL timing_stop('bdy_rnf') 
    265113      ! 
    266       IF( nn_timing == 1 )   CALL timing_stop('bdy_tra_rnf') 
    267       ! 
    268    END SUBROUTINE bdy_tra_rnf 
    269  
     114   END SUBROUTINE bdy_rnf 
    270115 
    271116   SUBROUTINE bdy_tra_dmp( kt ) 
    … …  
    308153   END SUBROUTINE bdy_tra_dmp 
    309154  
    310 #else 
    311    !!---------------------------------------------------------------------- 
    312    !!   Dummy module                   NO Unstruct Open Boundary Conditions 
    313    !!---------------------------------------------------------------------- 
    314 CONTAINS 
    315    SUBROUTINE bdy_tra(kt)      ! Empty routine 
    316       WRITE(*,*) 'bdy_tra: You should not have seen this print! error?', kt 
    317    END SUBROUTINE bdy_tra 
    318  
    319    SUBROUTINE bdy_tra_dmp(kt)      ! Empty routine 
    320       WRITE(*,*) 'bdy_tra_dmp: You should not have seen this print! error?', kt 
    321    END SUBROUTINE bdy_tra_dmp 
    322 #endif 
    323  
    324155   !!====================================================================== 
    325156END MODULE bdytra 
Note: See TracChangeset for help on using the changeset viewer.