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 7646 for trunk/NEMOGCM/NEMO/OPA_SRC/lib_fortran.F90 – NEMO

Ignore:
Timestamp:
2017-02-06T10:25:03+01:00 (7 years ago)
Author:
timgraham
Message:

Merge of dev_merge_2016 into trunk. UPDATE TO ARCHFILES NEEDED for XIOS2.
LIM_SRC_s/limrhg.F90 to follow in next commit due to change of kind (I'm unable to do it in this commit).
Merged using the following steps:

1) svn merge --reintegrate ​svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk .
2) Resolve minor conflicts in sette.sh and namelist_cfg for ORCA2LIM3 (due to a change in trunk after branch was created)
3) svn commit
4) svn switch ​svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
5) svn merge ​svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2016/dev_merge_2016 .
6) At this stage I checked out a clean copy of the branch to compare against what is about to be committed to the trunk.
6) svn commit #Commit code to the trunk

In this commit I have also reverted a change to Fcheck_archfile.sh which was causing problems on the Paris machine.

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMOGCM/NEMO/OPA_SRC/lib_fortran.F90

    r6140 r7646  
    77   !!            3.4  !  2013-06  (C. Rousset)  add glob_min, glob_max  
    88   !!                                           + 3d dim. of input is fexible (jpk, jpl...)  
     9   !!            4.0  !  2016-06  (T. Lovato)  double precision global sum by default  
    910   !!---------------------------------------------------------------------- 
    1011 
    … …  
    2526 
    2627   PUBLIC   glob_sum      ! used in many places (masked with tmask_i) 
    27    PUBLIC   glob_sum_full ! used in many places (masked with tmask_h, ie omly over the halos) 
     28   PUBLIC   glob_sum_full ! used in many places (masked with tmask_h, ie only over the halos) 
    2829   PUBLIC   DDPDD         ! also used in closea module 
    2930   PUBLIC   glob_min, glob_max 
    … …  
    6162CONTAINS 
    6263 
    63 #if ! defined key_mpp_rep 
    64    ! --- SUM --- 
    65  
    66    FUNCTION glob_sum_1d( ptab, kdim ) 
    67       !!----------------------------------------------------------------------- 
    68       !!                  ***  FUNCTION  glob_sum_1D  *** 
    69       !! 
    70       !! ** Purpose : perform a masked sum on the inner global domain of a 1D array 
    71       !!----------------------------------------------------------------------- 
    72       INTEGER :: kdim 
    73       REAL(wp), INTENT(in), DIMENSION(kdim) ::   ptab        ! input 1D array 
    74       REAL(wp)                              ::   glob_sum_1d ! global sum 
    75       !!----------------------------------------------------------------------- 
    76       ! 
    77       glob_sum_1d = SUM( ptab(:) ) 
    78       IF( lk_mpp )   CALL mpp_sum( glob_sum_1d ) 
    79       ! 
    80    END FUNCTION glob_sum_1d 
    81  
    82    FUNCTION glob_sum_2d( ptab ) 
    83       !!----------------------------------------------------------------------- 
    84       !!                  ***  FUNCTION  glob_sum_2D  *** 
    85       !! 
    86       !! ** Purpose : perform a masked sum on the inner global domain of a 2D array 
    87       !!----------------------------------------------------------------------- 
    88       REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab          ! input 2D array 
    89       REAL(wp)                             ::   glob_sum_2d   ! global masked sum 
    90       !!----------------------------------------------------------------------- 
    91       ! 
    92       glob_sum_2d = SUM( ptab(:,:)*tmask_i(:,:) ) 
    93       IF( lk_mpp )   CALL mpp_sum( glob_sum_2d ) 
    94       ! 
    95    END FUNCTION glob_sum_2d 
    96  
    97  
    98    FUNCTION glob_sum_3d( ptab ) 
    99       !!----------------------------------------------------------------------- 
    100       !!                  ***  FUNCTION  glob_sum_3D  *** 
    101       !! 
    102       !! ** Purpose : perform a masked sum on the inner global domain of a 3D array 
    103       !!----------------------------------------------------------------------- 
    104       REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab          ! input 3D array 
    105       REAL(wp)                               ::   glob_sum_3d   ! global masked sum 
    106       !! 
    107       INTEGER :: jk 
    108       INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab 
    109       !!----------------------------------------------------------------------- 
    110       ! 
    111       ijpk = SIZE(ptab,3) 
    112       ! 
    113       glob_sum_3d = 0.e0 
    114       DO jk = 1, ijpk 
    115          glob_sum_3d = glob_sum_3d + SUM( ptab(:,:,jk)*tmask_i(:,:) ) 
    116       END DO 
    117       IF( lk_mpp )   CALL mpp_sum( glob_sum_3d ) 
    118       ! 
    119    END FUNCTION glob_sum_3d 
    120  
    121  
    122    FUNCTION glob_sum_2d_a( ptab1, ptab2 ) 
    123       !!----------------------------------------------------------------------- 
    124       !!                  ***  FUNCTION  glob_sum_2D _a *** 
    125       !! 
    126       !! ** Purpose : perform a masked sum on the inner global domain of two 2D array 
    127       !!----------------------------------------------------------------------- 
    128       REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab1, ptab2    ! input 2D array 
    129       REAL(wp)            , DIMENSION(2)   ::   glob_sum_2d_a   ! global masked sum 
    130       !!----------------------------------------------------------------------- 
    131       ! 
    132       glob_sum_2d_a(1) = SUM( ptab1(:,:)*tmask_i(:,:) ) 
    133       glob_sum_2d_a(2) = SUM( ptab2(:,:)*tmask_i(:,:) ) 
    134       IF( lk_mpp )   CALL mpp_sum( glob_sum_2d_a, 2 ) 
    135       ! 
    136    END FUNCTION glob_sum_2d_a 
    137  
    138  
    139    FUNCTION glob_sum_3d_a( ptab1, ptab2 ) 
    140       !!----------------------------------------------------------------------- 
    141       !!                  ***  FUNCTION  glob_sum_3D_a *** 
    142       !! 
    143       !! ** Purpose : perform a masked sum on the inner global domain of two 3D array 
    144       !!----------------------------------------------------------------------- 
    145       REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab1, ptab2    ! input 3D array 
    146       REAL(wp)            , DIMENSION(2)     ::   glob_sum_3d_a   ! global masked sum 
    147       !! 
    148       INTEGER :: jk 
    149       INTEGER :: ijpk ! local variable: size of the 3d dimension of ptab 
    150       !!----------------------------------------------------------------------- 
    151       ! 
    152       ijpk = SIZE(ptab1,3) 
    153       ! 
    154       glob_sum_3d_a(:) = 0.e0 
    155       DO jk = 1, ijpk 
    156          glob_sum_3d_a(1) = glob_sum_3d_a(1) + SUM( ptab1(:,:,jk)*tmask_i(:,:) ) 
    157          glob_sum_3d_a(2) = glob_sum_3d_a(2) + SUM( ptab2(:,:,jk)*tmask_i(:,:) ) 
    158       END DO 
    159       IF( lk_mpp )   CALL mpp_sum( glob_sum_3d_a, 2 ) 
    160       ! 
    161    END FUNCTION glob_sum_3d_a 
    162  
    163    FUNCTION glob_sum_full_2d( ptab ) 
    164       !!---------------------------------------------------------------------- 
    165       !!                  ***  FUNCTION  glob_sum_full_2d *** 
    166       !! 
    167       !! ** Purpose : perform a sum in calling DDPDD routine (nomask) 
    168       !!---------------------------------------------------------------------- 
    169       REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab 
    170       REAL(wp)                             ::   glob_sum_full_2d   ! global sum 
    171       !! 
    172       !!----------------------------------------------------------------------- 
    173       ! 
    174       glob_sum_full_2d = SUM( ptab(:,:) * tmask_h(:,:) ) 
    175       IF( lk_mpp )   CALL mpp_sum( glob_sum_full_2d ) 
    176       ! 
    177    END FUNCTION glob_sum_full_2d 
    178  
    179    FUNCTION glob_sum_full_3d( ptab ) 
    180       !!---------------------------------------------------------------------- 
    181       !!                  ***  FUNCTION  glob_sum_full_3d *** 
    182       !! 
    183       !! ** Purpose : perform a sum on a 3D array in calling DDPDD routine (nomask) 
    184       !!---------------------------------------------------------------------- 
    185       REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab 
    186       REAL(wp)                               ::   glob_sum_full_3d   ! global sum 
    187       !! 
    188       INTEGER    ::   ji, jj, jk   ! dummy loop indices 
    189       INTEGER    ::   ijpk ! local variables: size of ptab 
    190       !!----------------------------------------------------------------------- 
    191       ! 
    192       ijpk = SIZE(ptab,3) 
    193       ! 
    194       glob_sum_full_3d = 0.e0 
    195       DO jk = 1, ijpk 
    196          glob_sum_full_3d = glob_sum_full_3d + SUM( ptab(:,:,jk) * tmask_h(:,:) ) 
    197       END DO 
    198       IF( lk_mpp )   CALL mpp_sum( glob_sum_full_3d ) 
    199       ! 
    200    END FUNCTION glob_sum_full_3d 
    201  
    202  
    203 #else   
    204    !!---------------------------------------------------------------------- 
    205    !!   'key_mpp_rep'                                   MPP reproducibility 
    206    !!---------------------------------------------------------------------- 
    207     
    20864   ! --- SUM --- 
    20965   FUNCTION glob_sum_1d( ptab, kdim ) 
    … …  
    417273   END FUNCTION glob_sum_full_3d 
    418274 
    419  
    420  
    421 #endif 
    422  
    423275   ! --- MIN --- 
    424276   FUNCTION glob_min_2d( ptab )  
Note: See TracChangeset for help on using the changeset viewer.