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 12377 for NEMO/trunk/src/OCE/lib_fortran.F90 – NEMO

Ignore:
Timestamp:
2020-02-12T15:39:06+01:00 (4 years ago)
Author:
acc
Message:

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

​svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
​svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

Location:
NEMO/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/trunk

    • Property svn:externals

      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         5^/vendors/AGRIF/dev_r11615_ENHANCE-04_namelists_as_internalfiles_agrif@HEAD      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 

  • NEMO/trunk/src/OCE/lib_fortran.F90

    r10425 r12377  
    6363#endif 
    6464 
     65   !! * Substitutions 
     66#  include "do_loop_substitute.h90" 
    6567   !!---------------------------------------------------------------------- 
    6668   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    215217      IF( SIZE(p2d,2) /= jpj ) CALL ctl_stop( 'STOP', 'wrong call of sum3x3_2d, the second dimension is not equal to jpj' )  
    216218      ! 
    217       DO jj = 1, jpj 
    218          DO ji = 1, jpi  
     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 
     221            ji2 = MIN(mig(ji)+2, jpiglo) - nimpp + 1                  ! right position of the box 
     222            jj2 = MIN(mjg(jj)+2, jpjglo) - njmpp + 1                  ! upper position of the box 
     223            IF( ji2 <= jpi .AND. jj2 <= jpj ) THEN                    ! the box is fully included in the local mpi domain 
     224               p2d(ji:ji2,jj:jj2) = SUM(p2d(ji:ji2,jj:jj2)) 
     225            ENDIF 
     226         ENDIF 
     227      END_2D 
     228      CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1. ) 
     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      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. ) 
     246 
     247   END SUBROUTINE sum3x3_2d 
     248 
     249   SUBROUTINE sum3x3_3d( p3d ) 
     250      !!----------------------------------------------------------------------- 
     251      !!                  ***  routine sum3x3_3d  *** 
     252      !! 
     253      !! ** Purpose : sum over 3x3 boxes 
     254      !!---------------------------------------------------------------------- 
     255      REAL(wp), DIMENSION (:,:,:), INTENT(inout) ::   p3d 
     256      ! 
     257      INTEGER ::   ji, ji2, jj, jj2, jn     ! dummy loop indices 
     258      INTEGER ::   ipn                      ! Third dimension size 
     259      !!---------------------------------------------------------------------- 
     260      ! 
     261      IF( SIZE(p3d,1) /= jpi ) CALL ctl_stop( 'STOP', 'wrong call of sum3x3_3d, the first dimension is not equal to jpi' )  
     262      IF( SIZE(p3d,2) /= jpj ) CALL ctl_stop( 'STOP', 'wrong call of sum3x3_3d, the second dimension is not equal to jpj' )  
     263      ipn = SIZE(p3d,3) 
     264      ! 
     265      DO jn = 1, ipn 
     266         DO_2D_11_11 
    219267            IF( MOD(mig(ji), 3) == 1 .AND. MOD(mjg(jj), 3) == 1 ) THEN   ! bottom left corber of a 3x3 box 
    220268               ji2 = MIN(mig(ji)+2, jpiglo) - nimpp + 1                  ! right position of the box 
    221269               jj2 = MIN(mjg(jj)+2, jpjglo) - njmpp + 1                  ! upper position of the box 
    222270               IF( ji2 <= jpi .AND. jj2 <= jpj ) THEN                    ! the box is fully included in the local mpi domain 
    223                   p2d(ji:ji2,jj:jj2) = SUM(p2d(ji:ji2,jj:jj2)) 
     271                  p3d(ji:ji2,jj:jj2,jn) = SUM(p3d(ji:ji2,jj:jj2,jn)) 
    224272               ENDIF 
    225273            ENDIF 
    226          END DO 
    227       END DO 
    228       CALL lbc_lnk( 'lib_fortran', p2d, 'T', 1. ) 
    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       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. ) 
    246  
    247    END SUBROUTINE sum3x3_2d 
    248  
    249    SUBROUTINE sum3x3_3d( p3d ) 
    250       !!----------------------------------------------------------------------- 
    251       !!                  ***  routine sum3x3_3d  *** 
    252       !! 
    253       !! ** Purpose : sum over 3x3 boxes 
    254       !!---------------------------------------------------------------------- 
    255       REAL(wp), DIMENSION (:,:,:), INTENT(inout) ::   p3d 
    256       ! 
    257       INTEGER ::   ji, ji2, jj, jj2, jn     ! dummy loop indices 
    258       INTEGER ::   ipn                      ! Third dimension size 
    259       !!---------------------------------------------------------------------- 
    260       ! 
    261       IF( SIZE(p3d,1) /= jpi ) CALL ctl_stop( 'STOP', 'wrong call of sum3x3_3d, the first dimension is not equal to jpi' )  
    262       IF( SIZE(p3d,2) /= jpj ) CALL ctl_stop( 'STOP', 'wrong call of sum3x3_3d, the second dimension is not equal to jpj' )  
    263       ipn = SIZE(p3d,3) 
    264       ! 
    265       DO jn = 1, ipn 
    266          DO jj = 1, jpj 
    267             DO ji = 1, jpi  
    268                IF( MOD(mig(ji), 3) == 1 .AND. MOD(mjg(jj), 3) == 1 ) THEN   ! bottom left corber of a 3x3 box 
    269                   ji2 = MIN(mig(ji)+2, jpiglo) - nimpp + 1                  ! right position of the box 
    270                   jj2 = MIN(mjg(jj)+2, jpjglo) - njmpp + 1                  ! upper position of the box 
    271                   IF( ji2 <= jpi .AND. jj2 <= jpj ) THEN                    ! the box is fully included in the local mpi domain 
    272                      p3d(ji:ji2,jj:jj2,jn) = SUM(p3d(ji:ji2,jj:jj2,jn)) 
    273                   ENDIF 
    274                ENDIF 
    275             END DO 
    276          END DO 
     274         END_2D 
    277275      END DO 
    278276      CALL lbc_lnk( 'lib_fortran', p3d, 'T', 1. ) 
Note: See TracChangeset for help on using the changeset viewer.