Ignore:
Timestamp:
2012-11-16T17:18:17+01:00 (9 years ago)
Author:
cbricaud
Message:

add modification from dev_r3327_MERCATOR1_BDY branch in dev_MERCATOR_2012_rev3555 branch

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2012/dev_MERCATOR_2012_rev3555/NEMOGCM/NEMO/OPA_SRC/BDY/bdytra.F90

    r3294 r3583  
    2323   USE in_out_manager  ! I/O manager 
    2424 
     25 
    2526   IMPLICIT NONE 
    2627   PRIVATE 
    2728 
    2829   PUBLIC bdy_tra      ! routine called in tranxt.F90  
     30   PUBLIC bdy_tra_dmp  ! routine called in step.F90  
    2931 
    3032   !!---------------------------------------------------------------------- 
     
    5355         CASE(jp_frs) 
    5456            CALL bdy_tra_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 
     57         CASE(2) 
     58            CALL bdy_tra_spe( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 
     59         CASE(3) 
     60            CALL bdy_tra_nmn( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 
     61         CASE(4) 
     62            CALL bdy_tra_rnf( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt ) 
    5563         CASE DEFAULT 
    5664            CALL ctl_stop( 'bdy_tra : unrecognised option for open boundaries for T and S' ) 
    5765         END SELECT 
    5866      ENDDO 
     67      ! 
     68      ! Boundary points should be updated 
     69      IF (nb_bdy>0) CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. ) 
     70      IF (nb_bdy>0) CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. ) 
    5971 
    6072   END SUBROUTINE bdy_tra 
     
    90102      END DO  
    91103      ! 
    92       CALL lbc_lnk( tsa(:,:,:,jp_tem), 'T', 1. )   ; CALL lbc_lnk( tsa(:,:,:,jp_sal), 'T', 1. )    ! Boundary points should be updated 
    93       ! 
    94104      IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 
    95105      ! 
     
    97107      ! 
    98108   END SUBROUTINE bdy_tra_frs 
    99     
     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. 
     115      !!  
     116      !!---------------------------------------------------------------------- 
     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 .eq. 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   SUBROUTINE bdy_tra_nmn( idx, dta, kt ) 
     145      !!---------------------------------------------------------------------- 
     146      !!                 ***  SUBROUTINE bdy_tra_nmn  *** 
     147      !!                     
     148      !! ** Purpose : Duplicate the value for tracers at open boundaries. 
     149      !!  
     150      !!---------------------------------------------------------------------- 
     151      INTEGER,         INTENT(in) ::   kt 
     152      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
     153      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data 
     154      !!  
     155      REAL(wp) ::   zwgt           ! boundary weight 
     156      INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
     157      INTEGER  ::   ii, ij,zcoef, zcoef1,zcoef2, ip, jp   ! 2D addresses 
     158      !!---------------------------------------------------------------------- 
     159      ! 
     160      IF( nn_timing == 1 ) CALL timing_start('bdy_tra_nmn') 
     161      ! 
     162      igrd = 1                       ! Everything is at T-points here 
     163      DO ib = 1, idx%nblenrim(igrd) 
     164         ii = idx%nbi(ib,igrd) 
     165         ij = idx%nbj(ib,igrd) 
     166         DO ik = 1, jpkm1 
     167            ! search the sense of the gradient 
     168            zcoef1 = bdytmask(ii-1,ij  ) +  bdytmask(ii+1,ij  ) 
     169            zcoef2 = bdytmask(ii  ,ij-1) +  bdytmask(ii  ,ij+1) 
     170            IF ( zcoef1+zcoef2 == 0) THEN 
     171               ! corner 
     172               zcoef = tmask(ii-1,ij,ik) + tmask(ii+1,ij,ik) +  tmask(ii,ij-1,ik) +  tmask(ii,ij+1,ik) 
     173               tsa(ii,ij,ik,jp_tem) = tsa(ii-1,ij  ,ik,jp_tem) * tmask(ii-1,ij  ,ik) + & 
     174                 &                    tsa(ii+1,ij  ,ik,jp_tem) * tmask(ii+1,ij  ,ik) + & 
     175                 &                    tsa(ii  ,ij-1,ik,jp_tem) * tmask(ii  ,ij-1,ik) + & 
     176                 &                    tsa(ii  ,ij+1,ik,jp_tem) * tmask(ii  ,ij+1,ik) 
     177               tsa(ii,ij,ik,jp_tem) = ( tsa(ii,ij,ik,jp_tem) / MAX( 1, zcoef) ) * tmask(ii,ij,ik) 
     178               tsa(ii,ij,ik,jp_sal) = tsa(ii-1,ij  ,ik,jp_sal) * tmask(ii-1,ij  ,ik) + & 
     179                 &                    tsa(ii+1,ij  ,ik,jp_sal) * tmask(ii+1,ij  ,ik) + & 
     180                 &                    tsa(ii  ,ij-1,ik,jp_sal) * tmask(ii  ,ij-1,ik) + & 
     181                 &                    tsa(ii  ,ij+1,ik,jp_sal) * tmask(ii  ,ij+1,ik) 
     182               tsa(ii,ij,ik,jp_sal) = ( tsa(ii,ij,ik,jp_sal) / MAX( 1, zcoef) ) * tmask(ii,ij,ik) 
     183            ELSE 
     184               ip = bdytmask(ii+1,ij  ) - bdytmask(ii-1,ij  ) 
     185               jp = bdytmask(ii  ,ij+1) - bdytmask(ii  ,ij-1) 
     186               tsa(ii,ij,ik,jp_tem) = tsa(ii+ip,ij+jp,ik,jp_tem) * tmask(ii+ip,ij+jp,ik) 
     187               tsa(ii,ij,ik,jp_sal) = tsa(ii+ip,ij+jp,ik,jp_sal) * tmask(ii+ip,ij+jp,ik) 
     188            ENDIF 
     189         END DO 
     190      END DO 
     191      ! 
     192      IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 
     193      ! 
     194      IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_nmn') 
     195      ! 
     196   END SUBROUTINE bdy_tra_nmn 
     197 
     198   SUBROUTINE bdy_tra_rnf( idx, dta, kt ) 
     199      !!---------------------------------------------------------------------- 
     200      !!                 ***  SUBROUTINE bdy_tra_rnf  *** 
     201      !!                     
     202      !! ** Purpose : Apply the runoff values for tracers at open boundaries: 
     203      !!                  - specified to 0.1 PSU for the salinity 
     204      !!                  - duplicate the value for the temperature 
     205      !!  
     206      !!---------------------------------------------------------------------- 
     207      INTEGER,         INTENT(in) ::   kt 
     208      TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
     209      TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data 
     210      !!  
     211      REAL(wp) ::   zwgt           ! boundary weight 
     212      INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
     213      INTEGER  ::   ii, ij, ip, jp ! 2D addresses 
     214      !!---------------------------------------------------------------------- 
     215      ! 
     216      IF( nn_timing == 1 ) CALL timing_start('bdy_tra_rnf') 
     217      ! 
     218      igrd = 1                       ! Everything is at T-points here 
     219      DO ib = 1, idx%nblenrim(igrd) 
     220         ii = idx%nbi(ib,igrd) 
     221         ij = idx%nbj(ib,igrd) 
     222         DO ik = 1, jpkm1 
     223            ip = bdytmask(ii+1,ij  ) - bdytmask(ii-1,ij  ) 
     224            jp = bdytmask(ii  ,ij+1) - bdytmask(ii  ,ij-1) 
     225            tsa(ii,ij,ik,jp_tem) = tsa(ii+ip,ij+jp,ik,jp_tem) * tmask(ii,ij,ik) 
     226            tsa(ii,ij,ik,jp_sal) =                        0.1 * tmask(ii,ij,ik) 
     227         END DO 
     228      END DO 
     229      ! 
     230      IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 
     231      ! 
     232      IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_rnf') 
     233      ! 
     234   END SUBROUTINE bdy_tra_rnf 
     235 
     236   SUBROUTINE bdy_tra_dmp( kt ) 
     237      !!---------------------------------------------------------------------- 
     238      !!                 ***  SUBROUTINE bdy_tra_dmp  *** 
     239      !!                     
     240      !! ** Purpose : Apply damping for tracers at open boundaries. 
     241      !!  
     242      !!---------------------------------------------------------------------- 
     243      INTEGER,         INTENT(in) ::   kt 
     244      !!  
     245      REAL(wp) ::   zwgt           ! boundary weight 
     246      REAL(wp) ::   zta, zsa, ztime 
     247      INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
     248      INTEGER  ::   ii, ij         ! 2D addresses 
     249      INTEGER  ::   ib_bdy         ! Loop index 
     250      !!---------------------------------------------------------------------- 
     251      ! 
     252      IF( nn_timing == 1 ) CALL timing_start('bdy_tra_dmp') 
     253      ! 
     254      DO ib_bdy=1, nb_bdy 
     255         IF ( ln_tra_dmp(ib_bdy) ) THEN 
     256            igrd = 1                       ! Everything is at T-points here 
     257            DO ib = 1, idx_bdy(ib_bdy)%nblen(igrd) 
     258               ii = idx_bdy(ib_bdy)%nbi(ib,igrd) 
     259               ij = idx_bdy(ib_bdy)%nbj(ib,igrd) 
     260               zwgt = idx_bdy(ib_bdy)%nbd(ib,igrd) 
     261               DO ik = 1, jpkm1 
     262                  zta = zwgt * ( dta_bdy(ib_bdy)%tem(ib,ik) - tsb(ii,ij,ik,jp_tem) ) * tmask(ii,ij,ik) 
     263                  zsa = zwgt * ( dta_bdy(ib_bdy)%sal(ib,ik) - tsb(ii,ij,ik,jp_sal) ) * tmask(ii,ij,ik) 
     264                  tsa(ii,ij,ik,jp_tem) = tsa(ii,ij,ik,jp_tem) + zta 
     265                  tsa(ii,ij,ik,jp_sal) = tsa(ii,ij,ik,jp_sal) + zsa 
     266               END DO 
     267            END DO 
     268         ENDIF 
     269      ENDDO 
     270      ! 
     271      IF( nn_timing == 1 ) CALL timing_stop('bdy_tra_dmp') 
     272      ! 
     273   END SUBROUTINE bdy_tra_dmp 
     274  
    100275#else 
    101276   !!---------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.