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

Ignore:
Timestamp:
2015-12-21T12:35:23+01:00 (8 years ago)
Author:
timgraham
Message:

Merge of branches/2015/dev_merge_2015 back into trunk. Merge excludes NEMOGCM/TOOLS/OBSTOOLS/ for now due to issues with the change of file type. Will sort these manually with further commits.

Branch merged as follows:
In the working copy of branch ran:
svn merge svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk@HEAD
Small conflicts due to bug fixes applied to trunk since the dev_merge_2015 was copied. Bug fixes were applied to the branch as well so these were easy to resolve.
Branch committed at this stage

In working copy run:
svn switch svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
to switch working copy

Run:
svn merge --reintegrate svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2015/dev_merge_2015
to merge the branch into the trunk and then commit - no conflicts at this stage.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/OPA_SRC/lib_fortran.F90

    r4161 r6140  
    2424   PRIVATE 
    2525 
    26    PUBLIC   glob_sum   ! used in many places 
    27    PUBLIC   DDPDD      ! also used in closea module 
     26   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   DDPDD         ! also used in closea module 
    2829   PUBLIC   glob_min, glob_max 
    2930#if defined key_nosignedzero 
     
    3435      MODULE PROCEDURE glob_sum_1d, glob_sum_2d, glob_sum_3d, & 
    3536         &             glob_sum_2d_a, glob_sum_3d_a 
     37   END INTERFACE 
     38   INTERFACE glob_sum_full 
     39      MODULE PROCEDURE glob_sum_full_2d, glob_sum_full_3d 
    3640   END INTERFACE 
    3741   INTERFACE glob_min 
     
    156160      ! 
    157161   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 
    158202 
    159203#else   
     
    314358   END FUNCTION glob_sum_3d_a    
    315359 
     360   FUNCTION glob_sum_full_2d( ptab ) 
     361      !!---------------------------------------------------------------------- 
     362      !!                  ***  FUNCTION  glob_sum_full_2d *** 
     363      !! 
     364      !! ** Purpose : perform a sum in calling DDPDD routine 
     365      !!---------------------------------------------------------------------- 
     366      REAL(wp), INTENT(in), DIMENSION(:,:) ::   ptab 
     367      REAL(wp)                             ::   glob_sum_full_2d   ! global sum (nomask) 
     368      !! 
     369      COMPLEX(wp)::   ctmp 
     370      REAL(wp)   ::   ztmp 
     371      INTEGER    ::   ji, jj   ! dummy loop indices 
     372      !!----------------------------------------------------------------------- 
     373      ! 
     374      ztmp = 0.e0 
     375      ctmp = CMPLX( 0.e0, 0.e0, wp ) 
     376      DO jj = 1, jpj 
     377         DO ji =1, jpi 
     378         ztmp =  ptab(ji,jj) * tmask_h(ji,jj)  
     379         CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
     380         END DO 
     381      END DO 
     382      IF( lk_mpp )   CALL mpp_sum( ctmp )   ! sum over the global domain 
     383      glob_sum_full_2d = REAL(ctmp,wp) 
     384      ! 
     385   END FUNCTION glob_sum_full_2d 
     386 
     387   FUNCTION glob_sum_full_3d( ptab ) 
     388      !!---------------------------------------------------------------------- 
     389      !!                  ***  FUNCTION  glob_sum_full_3d *** 
     390      !! 
     391      !! ** Purpose : perform a sum on a 3D array in calling DDPDD routine 
     392      !!---------------------------------------------------------------------- 
     393      REAL(wp), INTENT(in), DIMENSION(:,:,:) ::   ptab 
     394      REAL(wp)                               ::   glob_sum_full_3d   ! global sum (nomask) 
     395      !! 
     396      COMPLEX(wp)::   ctmp 
     397      REAL(wp)   ::   ztmp 
     398      INTEGER    ::   ji, jj, jk   ! dummy loop indices 
     399      INTEGER    ::   ijpk ! local variables: size of ptab 
     400      !!----------------------------------------------------------------------- 
     401      ! 
     402      ijpk = SIZE(ptab,3) 
     403      ! 
     404      ztmp = 0.e0 
     405      ctmp = CMPLX( 0.e0, 0.e0, wp ) 
     406      DO jk = 1, ijpk 
     407         DO jj = 1, jpj 
     408            DO ji =1, jpi 
     409            ztmp =  ptab(ji,jj,jk) * tmask_h(ji,jj) 
     410            CALL DDPDD( CMPLX( ztmp, 0.e0, wp ), ctmp ) 
     411            END DO 
     412         END DO 
     413      END DO 
     414      IF( lk_mpp )   CALL mpp_sum( ctmp )   ! sum over the global domain 
     415      glob_sum_full_3d = REAL(ctmp,wp) 
     416      ! 
     417   END FUNCTION glob_sum_full_3d 
     418 
     419 
     420 
    316421#endif 
    317422 
Note: See TracChangeset for help on using the changeset viewer.