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 12928 for NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/lib_fortran.F90 – NEMO

Ignore:
Timestamp:
2020-05-14T21:46:00+02:00 (4 years ago)
Author:
smueller
Message:

Synchronizing with /NEMO/trunk@12925 (ticket #2170)

Location:
NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser

    • Property svn:externals

      •  

        old new  
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
         8 
         9# SETTE 
         10^/utils/CI/sette@HEAD         sette 

  • NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/lib_fortran.F90

    r10425 r12928  
    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.