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 9890 for NEMO/trunk – NEMO

Changeset 9890 for NEMO/trunk


Ignore:
Timestamp:
2018-07-06T15:05:45+02:00 (6 years ago)
Author:
clem
Message:

group mpp communications for bdy ice

Location:
NEMO/trunk/src/OCE
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • NEMO/trunk/src/OCE/BDY/bdyice.F90

    r9888 r9890  
    5050      !!                  ***  SUBROUTINE bdy_ice  *** 
    5151      !! 
    52       !! ** Purpose : - Apply open boundary conditions for ice (SI3) 
     52      !! ** Purpose : Apply open boundary conditions for sea ice 
    5353      !! 
    5454      !!---------------------------------------------------------------------- 
    5555      INTEGER, INTENT(in) ::   kt   ! Main time step counter 
    5656      ! 
    57       INTEGER ::   ib_bdy   ! Loop index 
     57      INTEGER ::   jbdy   ! BDY set index 
    5858      !!---------------------------------------------------------------------- 
    5959      ! 
     
    6262      CALL ice_var_glo2eqv 
    6363      ! 
    64       DO ib_bdy = 1, nb_bdy 
    65          ! 
    66          SELECT CASE( cn_ice(ib_bdy) ) 
     64      DO jbdy = 1, nb_bdy 
     65         ! 
     66         SELECT CASE( cn_ice(jbdy) ) 
    6767         CASE('none')   ;   CYCLE 
    68          CASE('frs' )   ;   CALL bdy_ice_frs( idx_bdy(ib_bdy), dta_bdy(ib_bdy), kt, ib_bdy ) 
     68         CASE('frs' )   ;   CALL bdy_ice_frs( idx_bdy(jbdy), dta_bdy(jbdy), kt, jbdy ) 
    6969         CASE DEFAULT 
    7070            CALL ctl_stop( 'bdy_ice : unrecognised option for open boundaries for ice fields' ) 
     
    8484 
    8585 
    86    SUBROUTINE bdy_ice_frs( idx, dta, kt, ib_bdy ) 
     86   SUBROUTINE bdy_ice_frs( idx, dta, kt, jbdy ) 
    8787      !!------------------------------------------------------------------------------ 
    8888      !!                 ***  SUBROUTINE bdy_ice_frs  *** 
    8989      !!                     
    90       !! ** Purpose : Apply the Flow Relaxation Scheme for sea-ice fields in the case  
    91       !!              of unstructured open boundaries. 
     90      !! ** Purpose : Apply the Flow Relaxation Scheme for sea-ice fields 
    9291      !!  
    9392      !! Reference : Engedahl H., 1995: Use of the flow relaxation scheme in a three- 
     
    9796      TYPE(OBC_DATA),  INTENT(in) ::   dta     ! OBC external data 
    9897      INTEGER,         INTENT(in) ::   kt      ! main time-step counter 
    99       INTEGER,         INTENT(in) ::   ib_bdy  ! BDY set index 
     98      INTEGER,         INTENT(in) ::   jbdy    ! BDY set index 
    10099      ! 
    101100      INTEGER  ::   jpbound            ! 0 = incoming ice 
    102101      !                                ! 1 = outgoing ice 
    103       INTEGER  ::   jb, jk, jgrd, jl   ! dummy loop indices 
    104       INTEGER  ::   ji, jj, ii, ij     ! local scalar 
     102      INTEGER  ::   i_bdy, jgrd        ! dummy loop indices 
     103      INTEGER  ::   ji, jj, jk, jl, ib, jb 
    105104      REAL(wp) ::   zwgt, zwgt1        ! local scalar 
    106105      REAL(wp) ::   ztmelts, zdh 
     
    110109      ! 
    111110      DO jl = 1, jpl 
    112          DO jb = 1, idx%nblenrim(jgrd) 
    113             ji    = idx%nbi(jb,jgrd) 
    114             jj    = idx%nbj(jb,jgrd) 
    115             zwgt  = idx%nbw(jb,jgrd) 
    116             zwgt1 = 1.e0 - idx%nbw(jb,jgrd) 
    117             a_i(ji,jj,jl) = ( a_i(ji,jj,jl) * zwgt1 + dta%a_i(jb,jl) * zwgt ) * tmask(ji,jj,1)  ! Leads fraction  
    118             h_i(ji,jj,jl) = ( h_i(ji,jj,jl) * zwgt1 + dta%h_i(jb,jl) * zwgt ) * tmask(ji,jj,1)  ! Ice depth  
    119             h_s(ji,jj,jl) = ( h_s(ji,jj,jl) * zwgt1 + dta%h_s(jb,jl) * zwgt ) * tmask(ji,jj,1)  ! Snow depth 
     111         DO i_bdy = 1, idx%nblenrim(jgrd) 
     112            ji    = idx%nbi(i_bdy,jgrd) 
     113            jj    = idx%nbj(i_bdy,jgrd) 
     114            zwgt  = idx%nbw(i_bdy,jgrd) 
     115            zwgt1 = 1.e0 - idx%nbw(i_bdy,jgrd) 
     116            a_i(ji,jj,jl) = ( a_i(ji,jj,jl) * zwgt1 + dta%a_i(i_bdy,jl) * zwgt ) * tmask(ji,jj,1)  ! Leads fraction  
     117            h_i(ji,jj,jl) = ( h_i(ji,jj,jl) * zwgt1 + dta%h_i(i_bdy,jl) * zwgt ) * tmask(ji,jj,1)  ! Ice depth  
     118            h_s(ji,jj,jl) = ( h_s(ji,jj,jl) * zwgt1 + dta%h_s(i_bdy,jl) * zwgt ) * tmask(ji,jj,1)  ! Snow depth 
    120119 
    121120            ! ----------------- 
     
    135134 
    136135         ENDDO 
    137          CALL lbc_bdy_lnk( a_i(:,:,jl), 'T', 1., ib_bdy ) 
    138          CALL lbc_bdy_lnk( h_i(:,:,jl), 'T', 1., ib_bdy ) 
    139          CALL lbc_bdy_lnk( h_s(:,:,jl), 'T', 1., ib_bdy ) 
    140136      ENDDO 
     137      CALL lbc_bdy_lnk( a_i(:,:,:), 'T', 1., jbdy ) 
     138      CALL lbc_bdy_lnk( h_i(:,:,:), 'T', 1., jbdy ) 
     139      CALL lbc_bdy_lnk( h_s(:,:,:), 'T', 1., jbdy ) 
    141140 
    142141      DO jl = 1, jpl 
    143          DO jb = 1, idx%nblenrim(jgrd) 
    144             ji    = idx%nbi(jb,jgrd) 
    145             jj    = idx%nbj(jb,jgrd) 
     142         DO i_bdy = 1, idx%nblenrim(jgrd) 
     143            ji = idx%nbi(i_bdy,jgrd) 
     144            jj = idx%nbj(i_bdy,jgrd) 
    146145 
    147146            ! condition on ice thickness depends on the ice velocity 
    148147            ! if velocity is outward (strictly), then ice thickness, volume... must be equal to adjacent values 
    149             jpbound = 0   ;   ii = ji   ;   ij = jj 
    150             ! 
    151             IF( u_ice(ji+1,jj  ) < 0. .AND. umask(ji-1,jj  ,1) == 0. ) jpbound = 1; ii = ji+1; ij = jj 
    152             IF( u_ice(ji-1,jj  ) > 0. .AND. umask(ji+1,jj  ,1) == 0. ) jpbound = 1; ii = ji-1; ij = jj 
    153             IF( v_ice(ji  ,jj+1) < 0. .AND. vmask(ji  ,jj-1,1) == 0. ) jpbound = 1; ii = ji  ; ij = jj+1 
    154             IF( v_ice(ji  ,jj-1) > 0. .AND. vmask(ji  ,jj+1,1) == 0. ) jpbound = 1; ii = ji  ; ij = jj-1 
    155             ! 
    156             IF( nn_ice_dta(ib_bdy) == 0 ) jpbound = 0; ii = ji; ij = jj   ! case ice boundaries = initial conditions 
    157             !                                                             !      do not make state variables dependent on velocity 
    158             ! 
    159             IF( a_i(ii,ij,jl) > 0._wp ) THEN   ! there is ice at the boundary 
    160                ! 
    161                a_i(ji,jj,jl) = a_i(ii,ij,jl) ! concentration 
    162                h_i(ji,jj,jl) = h_i(ii,ij,jl) ! thickness ice 
    163                h_s(ji,jj,jl) = h_s(ii,ij,jl) ! thickness snw 
     148            jpbound = 0   ;   ib = ji   ;   jb = jj 
     149            ! 
     150            IF( u_ice(ji+1,jj  ) < 0. .AND. umask(ji-1,jj  ,1) == 0. )   jpbound = 1 ; ib = ji+1 ; jb = jj 
     151            IF( u_ice(ji-1,jj  ) > 0. .AND. umask(ji+1,jj  ,1) == 0. )   jpbound = 1 ; ib = ji-1 ; jb = jj 
     152            IF( v_ice(ji  ,jj+1) < 0. .AND. vmask(ji  ,jj-1,1) == 0. )   jpbound = 1 ; ib = ji   ; jb = jj+1 
     153            IF( v_ice(ji  ,jj-1) > 0. .AND. vmask(ji  ,jj+1,1) == 0. )   jpbound = 1 ; ib = ji   ; jb = jj-1 
     154            ! 
     155            IF( nn_ice_dta(jbdy) == 0 )   jpbound = 0 ; ib = ji ; jb = jj   ! case ice boundaries = initial conditions 
     156            !                                                               !      do not make state variables dependent on velocity 
     157            ! 
     158            IF( a_i(ib,jb,jl) > 0._wp ) THEN   ! there is ice at the boundary 
     159               ! 
     160               a_i(ji,jj,jl) = a_i(ib,jb,jl) ! concentration 
     161               h_i(ji,jj,jl) = h_i(ib,jb,jl) ! thickness ice 
     162               h_s(ji,jj,jl) = h_s(ib,jb,jl) ! thickness snw 
    164163               ! 
    165164               SELECT CASE( jpbound ) 
     
    167166               CASE( 0 )   ! velocity is inward 
    168167                  ! 
    169                   oa_i(ji,jj,  jl) = rn_ice_age(ib_bdy) * a_i(ji,jj,jl) ! age 
    170                   a_ip(ji,jj,  jl) = 0._wp                              ! pond concentration 
    171                   v_ip(ji,jj,  jl) = 0._wp                              ! pond volume 
    172                   t_su(ji,jj,  jl) = rn_ice_tem(ib_bdy)                 ! temperature surface 
    173                   t_s (ji,jj,:,jl) = rn_ice_tem(ib_bdy)                 ! temperature snw 
    174                   t_i (ji,jj,:,jl) = rn_ice_tem(ib_bdy)                 ! temperature ice 
    175                   s_i (ji,jj,  jl) = rn_ice_sal(ib_bdy)                 ! salinity 
    176                   sz_i(ji,jj,:,jl) = rn_ice_sal(ib_bdy)                 ! salinity profile 
     168                  oa_i(ji,jj,  jl) = rn_ice_age(jbdy) * a_i(ji,jj,jl) ! age 
     169                  a_ip(ji,jj,  jl) = 0._wp                            ! pond concentration 
     170                  v_ip(ji,jj,  jl) = 0._wp                            ! pond volume 
     171                  t_su(ji,jj,  jl) = rn_ice_tem(jbdy)                 ! temperature surface 
     172                  t_s (ji,jj,:,jl) = rn_ice_tem(jbdy)                 ! temperature snw 
     173                  t_i (ji,jj,:,jl) = rn_ice_tem(jbdy)                 ! temperature ice 
     174                  s_i (ji,jj,  jl) = rn_ice_sal(jbdy)                 ! salinity 
     175                  sz_i(ji,jj,:,jl) = rn_ice_sal(jbdy)                 ! salinity profile 
    177176                  ! 
    178177               CASE( 1 )   ! velocity is outward 
    179178                  ! 
    180                   oa_i(ji,jj,  jl) = oa_i(ii,ij,  jl) ! age 
    181                   a_ip(ji,jj,  jl) = a_ip(ii,ij,  jl) ! pond concentration 
    182                   v_ip(ji,jj,  jl) = v_ip(ii,ij,  jl) ! pond volume 
    183                   t_su(ji,jj,  jl) = t_su(ii,ij,  jl) ! temperature surface 
    184                   t_s (ji,jj,:,jl) = t_s (ii,ij,:,jl) ! temperature snw 
    185                   t_i (ji,jj,:,jl) = t_i (ii,ij,:,jl) ! temperature ice 
    186                   s_i (ji,jj,  jl) = s_i (ii,ij,  jl) ! salinity 
    187                   sz_i(ji,jj,:,jl) = sz_i(ii,ij,:,jl) ! salinity profile 
     179                  oa_i(ji,jj,  jl) = oa_i(ib,jb,  jl) ! age 
     180                  a_ip(ji,jj,  jl) = a_ip(ib,jb,  jl) ! pond concentration 
     181                  v_ip(ji,jj,  jl) = v_ip(ib,jb,  jl) ! pond volume 
     182                  t_su(ji,jj,  jl) = t_su(ib,jb,  jl) ! temperature surface 
     183                  t_s (ji,jj,:,jl) = t_s (ib,jb,:,jl) ! temperature snw 
     184                  t_i (ji,jj,:,jl) = t_i (ib,jb,:,jl) ! temperature ice 
     185                  s_i (ji,jj,  jl) = s_i (ib,jb,  jl) ! salinity 
     186                  sz_i(ji,jj,:,jl) = sz_i(ib,jb,:,jl) ! salinity profile 
    188187                  ! 
    189188               END SELECT 
     
    243242         END DO 
    244243         ! 
    245          CALL lbc_bdy_lnk( a_i (:,:,jl), 'T', 1., ib_bdy ) 
    246          CALL lbc_bdy_lnk( h_i (:,:,jl), 'T', 1., ib_bdy ) 
    247          CALL lbc_bdy_lnk( h_s (:,:,jl), 'T', 1., ib_bdy ) 
    248          CALL lbc_bdy_lnk( oa_i(:,:,jl), 'T', 1., ib_bdy ) 
    249          CALL lbc_bdy_lnk( a_ip(:,:,jl), 'T', 1., ib_bdy ) 
    250          CALL lbc_bdy_lnk( v_ip(:,:,jl), 'T', 1., ib_bdy ) 
    251          CALL lbc_bdy_lnk( s_i (:,:,jl), 'T', 1., ib_bdy ) 
    252          CALL lbc_bdy_lnk( t_su(:,:,jl), 'T', 1., ib_bdy ) 
    253          CALL lbc_bdy_lnk( v_i (:,:,jl), 'T', 1., ib_bdy ) 
    254          CALL lbc_bdy_lnk( v_s (:,:,jl), 'T', 1., ib_bdy ) 
    255          CALL lbc_bdy_lnk( sv_i(:,:,jl), 'T', 1., ib_bdy ) 
    256           DO jk = 1, nlay_s 
    257             CALL lbc_bdy_lnk(t_s(:,:,jk,jl), 'T', 1., ib_bdy ) 
    258             CALL lbc_bdy_lnk(e_s(:,:,jk,jl), 'T', 1., ib_bdy ) 
    259          END DO 
    260          DO jk = 1, nlay_i 
    261             CALL lbc_bdy_lnk(t_i(:,:,jk,jl), 'T', 1., ib_bdy ) 
    262             CALL lbc_bdy_lnk(e_i(:,:,jk,jl), 'T', 1., ib_bdy ) 
    263          END DO 
    264          ! 
    265244      END DO ! jl 
     245 
     246      CALL lbc_bdy_lnk( a_i (:,:,:)  , 'T', 1., jbdy ) 
     247      CALL lbc_bdy_lnk( h_i (:,:,:)  , 'T', 1., jbdy ) 
     248      CALL lbc_bdy_lnk( h_s (:,:,:)  , 'T', 1., jbdy ) 
     249      CALL lbc_bdy_lnk( oa_i(:,:,:)  , 'T', 1., jbdy ) 
     250      CALL lbc_bdy_lnk( a_ip(:,:,:)  , 'T', 1., jbdy ) 
     251      CALL lbc_bdy_lnk( v_ip(:,:,:)  , 'T', 1., jbdy ) 
     252      CALL lbc_bdy_lnk( s_i (:,:,:)  , 'T', 1., jbdy ) 
     253      CALL lbc_bdy_lnk( t_su(:,:,:)  , 'T', 1., jbdy ) 
     254      CALL lbc_bdy_lnk( v_i (:,:,:)  , 'T', 1., jbdy ) 
     255      CALL lbc_bdy_lnk( v_s (:,:,:)  , 'T', 1., jbdy ) 
     256      CALL lbc_bdy_lnk( sv_i(:,:,:)  , 'T', 1., jbdy ) 
     257      CALL lbc_bdy_lnk( t_s (:,:,:,:), 'T', 1., jbdy ) 
     258      CALL lbc_bdy_lnk( e_s (:,:,:,:), 'T', 1., jbdy ) 
     259      CALL lbc_bdy_lnk( t_i (:,:,:,:), 'T', 1., jbdy ) 
     260      CALL lbc_bdy_lnk( e_i (:,:,:,:), 'T', 1., jbdy ) 
    266261      !       
    267262   END SUBROUTINE bdy_ice_frs 
     
    272267      !!                 ***  SUBROUTINE bdy_ice_dyn  *** 
    273268      !!                     
    274       !! ** Purpose : Apply dynamics boundary conditions for sea-ice in the cas of unstructured open boundaries. 
    275       !!              u_ice and v_ice are equal to the value of the adjacent grid point if this latter is not ice free 
    276       !!              if adjacent grid point is ice free, then u_ice and v_ice are equal to ocean velocities 
     269      !! ** Purpose : Apply dynamics boundary conditions for sea-ice. 
    277270      !! 
    278       !! 2013-06 : C. Rousset 
     271      !! ** Method :  if this adjacent grid point is not ice free, then u_ice and v_ice take its value 
     272      !!              if                          is     ice free, then u_ice and v_ice are unchanged by BDY 
     273      !!                                                           they keep values calculated in rheology 
     274      !! 
    279275      !!------------------------------------------------------------------------------ 
    280276      CHARACTER(len=1), INTENT(in)  ::   cd_type   ! nature of velocity grid-points 
    281277      ! 
    282       INTEGER  ::   jb, jgrd           ! dummy loop indices 
    283       INTEGER  ::   ji, jj             ! local scalar 
    284       INTEGER  ::   ib_bdy             ! Loop index 
     278      INTEGER  ::   i_bdy, jgrd      ! dummy loop indices 
     279      INTEGER  ::   ji, jj           ! local scalar 
     280      INTEGER  ::   jbdy             ! BDY set index 
    285281      REAL(wp) ::   zmsk1, zmsk2, zflag 
    286282      !!------------------------------------------------------------------------------ 
    287283      ! 
    288       DO ib_bdy=1, nb_bdy 
    289          ! 
    290          SELECT CASE( cn_ice(ib_bdy) ) 
     284      DO jbdy=1, nb_bdy 
     285         ! 
     286         SELECT CASE( cn_ice(jbdy) ) 
    291287         ! 
    292288         CASE('none') 
     
    295291         CASE('frs') 
    296292            ! 
    297             IF( nn_ice_dta(ib_bdy) == 0 ) CYCLE            ! case ice boundaries = initial conditions  
    298             !                                              !      do not change ice velocity (it is only computed by rheology) 
     293            IF( nn_ice_dta(jbdy) == 0 ) CYCLE            ! case ice boundaries = initial conditions  
     294            !                                            !      do not change ice velocity (it is only computed by rheology) 
    299295            SELECT CASE ( cd_type ) 
    300296            !      
    301297            CASE ( 'U' )   
    302298               jgrd = 2      ! u velocity 
    303                DO jb = 1, idx_bdy(ib_bdy)%nblenrim(jgrd) 
    304                   ji    = idx_bdy(ib_bdy)%nbi(jb,jgrd) 
    305                   jj    = idx_bdy(ib_bdy)%nbj(jb,jgrd) 
    306                   zflag = idx_bdy(ib_bdy)%flagu(jb,jgrd) 
     299               DO i_bdy = 1, idx_bdy(jbdy)%nblenrim(jgrd) 
     300                  ji    = idx_bdy(jbdy)%nbi(i_bdy,jgrd) 
     301                  jj    = idx_bdy(jbdy)%nbj(i_bdy,jgrd) 
     302                  zflag = idx_bdy(jbdy)%flagu(i_bdy,jgrd) 
    307303                  ! 
    308304                  IF ( ABS( zflag ) == 1. ) THEN  ! eastern and western boundaries 
     
    320316                  ! 
    321317               END DO 
    322                CALL lbc_bdy_lnk( u_ice(:,:), 'U', -1., ib_bdy ) 
     318               CALL lbc_bdy_lnk( u_ice(:,:), 'U', -1., jbdy ) 
    323319               ! 
    324320            CASE ( 'V' ) 
    325321               jgrd = 3      ! v velocity 
    326                DO jb = 1, idx_bdy(ib_bdy)%nblenrim(jgrd) 
    327                   ji    = idx_bdy(ib_bdy)%nbi(jb,jgrd) 
    328                   jj    = idx_bdy(ib_bdy)%nbj(jb,jgrd) 
    329                   zflag = idx_bdy(ib_bdy)%flagv(jb,jgrd) 
     322               DO i_bdy = 1, idx_bdy(jbdy)%nblenrim(jgrd) 
     323                  ji    = idx_bdy(jbdy)%nbi(i_bdy,jgrd) 
     324                  jj    = idx_bdy(jbdy)%nbj(i_bdy,jgrd) 
     325                  zflag = idx_bdy(jbdy)%flagv(i_bdy,jgrd) 
    330326                  ! 
    331327                  IF ( ABS( zflag ) == 1. ) THEN  ! northern and southern boundaries 
     
    343339                  ! 
    344340               END DO 
    345                CALL lbc_bdy_lnk( v_ice(:,:), 'V', -1., ib_bdy ) 
     341               CALL lbc_bdy_lnk( v_ice(:,:), 'V', -1., jbdy ) 
    346342               ! 
    347343            END SELECT 
  • NEMO/trunk/src/OCE/LBC/lbclnk.F90

    r9799 r9890  
    3838   ! 
    3939   INTERFACE lbc_bdy_lnk 
    40       MODULE PROCEDURE mpp_lnk_bdy_2d, mpp_lnk_bdy_3d 
     40      MODULE PROCEDURE mpp_lnk_bdy_2d, mpp_lnk_bdy_3d, mpp_lnk_bdy_4d 
    4141   END INTERFACE 
    4242   ! 
  • NEMO/trunk/src/OCE/LBC/lib_mpp.F90

    r9667 r9890  
    8888   PUBLIC   mppsize 
    8989   PUBLIC   mppsend, mpprecv                          ! needed by TAM and ICB routines 
    90    PUBLIC   mpp_lnk_bdy_2d, mpp_lnk_bdy_3d 
     90   PUBLIC   mpp_lnk_bdy_2d, mpp_lnk_bdy_3d, mpp_lnk_bdy_4d 
    9191   PUBLIC   mpprank 
    9292    
     
    456456   !                       !==  4D array and array of 4D pointer  ==! 
    457457   ! 
    458 !!#  define DIM_4d 
    459 !!#     define ROUTINE_BDY           mpp_lnk_bdy_4d 
    460 !!#     include "mpp_bdy_generic.h90" 
    461 !!#     undef ROUTINE_BDY 
    462 !!#  undef DIM_4d 
     458#  define DIM_4d 
     459#     define ROUTINE_BDY           mpp_lnk_bdy_4d 
     460#     include "mpp_bdy_generic.h90" 
     461#     undef ROUTINE_BDY 
     462#  undef DIM_4d 
    463463 
    464464   !!---------------------------------------------------------------------- 
  • NEMO/trunk/src/OCE/timing.F90

    r9598 r9890  
    211211         WRITE(numtime,*) '                             NEMO team' 
    212212         WRITE(numtime,*) '                  Ocean General Circulation Model' 
    213          WRITE(numtime,*) '                        version 3.6  (2015) ' 
     213         WRITE(numtime,*) '                        version 4.0  (2018) ' 
    214214         WRITE(numtime,*) 
    215215         WRITE(numtime,*) '                        Timing Informations ' 
Note: See TracChangeset for help on using the changeset viewer.