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 13899 for NEMO/branches/2020/tickets_icb_1900/src/OCE/lib_fortran.F90 – NEMO

Ignore:
Timestamp:
2020-11-27T17:26:33+01:00 (4 years ago)
Author:
mathiot
Message:

ticket #1900: update branch to trunk and add ICB test case

Location:
NEMO/branches/2020/tickets_icb_1900
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/tickets_icb_1900

    • Property svn:externals

      •  

        old new  
        22^/utils/build/makenemo@HEAD   makenemo 
        33^/utils/build/mk@HEAD         mk 
        4 ^/utils/tools/@HEAD           tools 
         4^/utils/tools@HEAD            tools 
        55^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        … …  
        88 
        99# SETTE 
        10 ^/utils/CI/sette@12931        sette 
         10^/utils/CI/sette@13559        sette 

  • NEMO/branches/2020/tickets_icb_1900/src/OCE/lib_fortran.F90

    r13226 r13899  
    217217      IF( SIZE(p2d,2) /= jpj ) CALL ctl_stop( 'STOP', 'wrong call of sum3x3_2d, the second dimension is not equal to jpj' )  
    218218      ! 
    219       DO_2D_11_11 
    220          IF( MOD(mig(ji), 3) == 1 .AND. MOD(mjg(jj), 3) == 1 ) THEN   ! bottom left corber of a 3x3 box 
     219      ! work over the whole domain (guarantees all internal cells are set when nn_hls=2) 
     220      ! 
     221      DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     222         IF( MOD(mig(ji), 3) == MOD(nn_hls, 3) .AND.   & 
     223           & MOD(mjg(jj), 3) == MOD(nn_hls, 3)         ) THEN         ! bottom left corner of a 3x3 box 
    221224            ji2 = MIN(mig(ji)+2, jpiglo) - nimpp + 1                  ! right position of the box 
    222225            jj2 = MIN(mjg(jj)+2, jpjglo) - njmpp + 1                  ! upper position of the box 
    … …  
    227230      END_2D 
    228231      CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1.0_wp ) 
    229       IF( nbondi /= -1 ) THEN 
    230          IF( MOD(mig(    1), 3) == 1 )   p2d(    1,:) = p2d(    2,:) 
    231          IF( MOD(mig(    1), 3) == 2 )   p2d(    2,:) = p2d(    1,:) 
     232      ! no need for 2nd exchange when nn_hls = 2 
     233      IF( nn_hls /= 2 ) THEN 
     234         IF( nbondi /= -1 ) THEN 
     235            IF( MOD(mig(    1), 3) == 1 )   p2d(    1,:) = p2d(    2,:) 
     236            IF( MOD(mig(    1), 3) == 2 )   p2d(    2,:) = p2d(    1,:) 
     237         ENDIF 
     238         IF( nbondi /=  1 ) THEN 
     239            IF( MOD(mig(jpi-2), 3) == 1 )   p2d(  jpi,:) = p2d(jpi-1,:) 
     240            IF( MOD(mig(jpi-2), 3) == 0 )   p2d(jpi-1,:) = p2d(  jpi,:) 
     241         ENDIF 
     242         IF( nbondj /= -1 ) THEN 
     243            IF( MOD(mjg(    1), 3) == 1 )   p2d(:,    1) = p2d(:,    2) 
     244            IF( MOD(mjg(    1), 3) == 2 )   p2d(:,    2) = p2d(:,    1) 
     245         ENDIF 
     246         IF( nbondj /=  1 ) THEN 
     247            IF( MOD(mjg(jpj-2), 3) == 1 )   p2d(:,  jpj) = p2d(:,jpj-1) 
     248            IF( MOD(mjg(jpj-2), 3) == 0 )   p2d(:,jpj-1) = p2d(:,  jpj) 
     249         ENDIF 
     250         CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1.0_wp ) 
    232251      ENDIF 
    233       IF( nbondi /=  1 ) THEN 
    234          IF( MOD(mig(jpi-2), 3) == 1 )   p2d(  jpi,:) = p2d(jpi-1,:) 
    235          IF( MOD(mig(jpi-2), 3) == 0 )   p2d(jpi-1,:) = p2d(  jpi,:) 
    236       ENDIF 
    237       IF( nbondj /= -1 ) THEN 
    238          IF( MOD(mjg(    1), 3) == 1 )   p2d(:,    1) = p2d(:,    2) 
    239          IF( MOD(mjg(    1), 3) == 2 )   p2d(:,    2) = p2d(:,    1) 
    240       ENDIF 
    241       IF( nbondj /=  1 ) THEN 
    242          IF( MOD(mjg(jpj-2), 3) == 1 )   p2d(:,  jpj) = p2d(:,jpj-1) 
    243          IF( MOD(mjg(jpj-2), 3) == 0 )   p2d(:,jpj-1) = p2d(:,  jpj) 
    244       ENDIF 
    245       CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1.0_wp ) 
    246252 
    247253   END SUBROUTINE sum3x3_2d 
    … …  
    264270      ! 
    265271      DO jn = 1, ipn 
    266          DO_2D_11_11 
    267             IF( MOD(mig(ji), 3) == 1 .AND. MOD(mjg(jj), 3) == 1 ) THEN   ! bottom left corber of a 3x3 box 
     272         ! 
     273         ! work over the whole domain (guarantees all internal cells are set when nn_hls=2) 
     274         ! 
     275         DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 
     276            IF( MOD(mig(ji), 3) == MOD(nn_hls, 3) .AND.   & 
     277              & MOD(mjg(jj), 3) == MOD(nn_hls, 3)         ) THEN         ! bottom left corner of a 3x3 box 
    268278               ji2 = MIN(mig(ji)+2, jpiglo) - nimpp + 1                  ! right position of the box 
    269279               jj2 = MIN(mjg(jj)+2, jpjglo) - njmpp + 1                  ! upper position of the box 
    … …  
    275285      END DO 
    276286      CALL lbc_lnk( 'lib_fortran', p3d, 'T', 1.0_wp ) 
    277       IF( nbondi /= -1 ) THEN 
    278          IF( MOD(mig(    1), 3) == 1 )   p3d(    1,:,:) = p3d(    2,:,:) 
    279          IF( MOD(mig(    1), 3) == 2 )   p3d(    2,:,:) = p3d(    1,:,:) 
     287      ! no need for 2nd exchange when nn_hls = 2 
     288      IF( nn_hls /= 2 ) THEN 
     289         IF( nbondi /= -1 ) THEN 
     290            IF( MOD(mig(    1), 3) == 1 )   p3d(    1,:,:) = p3d(    2,:,:) 
     291            IF( MOD(mig(    1), 3) == 2 )   p3d(    2,:,:) = p3d(    1,:,:) 
     292         ENDIF 
     293         IF( nbondi /=  1 ) THEN 
     294            IF( MOD(mig(jpi-2), 3) == 1 )   p3d(  jpi,:,:) = p3d(jpi-1,:,:) 
     295            IF( MOD(mig(jpi-2), 3) == 0 )   p3d(jpi-1,:,:) = p3d(  jpi,:,:) 
     296         ENDIF 
     297         IF( nbondj /= -1 ) THEN 
     298            IF( MOD(mjg(    1), 3) == 1 )   p3d(:,    1,:) = p3d(:,    2,:) 
     299            IF( MOD(mjg(    1), 3) == 2 )   p3d(:,    2,:) = p3d(:,    1,:) 
     300         ENDIF 
     301         IF( nbondj /=  1 ) THEN 
     302            IF( MOD(mjg(jpj-2), 3) == 1 )   p3d(:,  jpj,:) = p3d(:,jpj-1,:) 
     303            IF( MOD(mjg(jpj-2), 3) == 0 )   p3d(:,jpj-1,:) = p3d(:,  jpj,:) 
     304         ENDIF 
     305         CALL lbc_lnk( 'lib_fortran', p3d, 'T', 1.0_wp ) 
    280306      ENDIF 
    281       IF( nbondi /=  1 ) THEN 
    282          IF( MOD(mig(jpi-2), 3) == 1 )   p3d(  jpi,:,:) = p3d(jpi-1,:,:) 
    283          IF( MOD(mig(jpi-2), 3) == 0 )   p3d(jpi-1,:,:) = p3d(  jpi,:,:) 
    284       ENDIF 
    285       IF( nbondj /= -1 ) THEN 
    286          IF( MOD(mjg(    1), 3) == 1 )   p3d(:,    1,:) = p3d(:,    2,:) 
    287          IF( MOD(mjg(    1), 3) == 2 )   p3d(:,    2,:) = p3d(:,    1,:) 
    288       ENDIF 
    289       IF( nbondj /=  1 ) THEN 
    290          IF( MOD(mjg(jpj-2), 3) == 1 )   p3d(:,  jpj,:) = p3d(:,jpj-1,:) 
    291          IF( MOD(mjg(jpj-2), 3) == 0 )   p3d(:,jpj-1,:) = p3d(:,  jpj,:) 
    292       ENDIF 
    293       CALL lbc_lnk( 'lib_fortran', p3d, 'T', 1.0_wp ) 
    294307 
    295308   END SUBROUTINE sum3x3_3d 
Note: See TracChangeset for help on using the changeset viewer.