source: NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/OCE/DOM/domngb.F90 @ 10314

Last change on this file since 10314 was 10314, checked in by smasson, 2 years ago

dev_r10164_HPC09_ESIWACE_PREP_MERGE: action 2: add generic glob_min/max/sum and locmin/max, complete timing and report (including bdy and icb), see #2133

  • Property svn:keywords set to Id
File size: 3.9 KB
RevLine 
[1725]1MODULE domngb
2   !!======================================================================
3   !!                       ***  MODULE  domngb  ***
4   !! Grid search:  find the closest grid point from a given on/lat position
5   !!======================================================================
6   !! History : 3.2  !  2009-11  (S. Masson)  Original code
7   !!----------------------------------------------------------------------
8
9   !!----------------------------------------------------------------------
[2715]10   !!   dom_ngb       : find the closest grid point from a given lon/lat position
[1725]11   !!----------------------------------------------------------------------
[2715]12   USE dom_oce        ! ocean space and time domain
[9019]13   !
[3294]14   USE in_out_manager ! I/O manager
[2715]15   USE lib_mpp        ! for mppsum
[1725]16
17   IMPLICIT NONE
18   PRIVATE
19
[2715]20   PUBLIC   dom_ngb   ! routine called in iom.F90 module
[1725]21
22   !!----------------------------------------------------------------------
[9598]23   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
[1725]24   !! $Id$
[10068]25   !! Software governed by the CeCILL license (see ./LICENSE)
[1725]26   !!----------------------------------------------------------------------
27CONTAINS
28
[6140]29   SUBROUTINE dom_ngb( plon, plat, kii, kjj, cdgrid, kkk )
[1725]30      !!----------------------------------------------------------------------
31      !!                    ***  ROUTINE dom_ngb  ***
32      !!
[2715]33      !! ** Purpose :   find the closest grid point from a given lon/lat position
[1725]34      !!
35      !! ** Method  :   look for minimum distance in cylindrical projection
36      !!                -> not good if located at too high latitude...
37      !!----------------------------------------------------------------------
38      REAL(wp)        , INTENT(in   ) ::   plon, plat   ! longitude,latitude of the point
39      INTEGER         , INTENT(  out) ::   kii, kjj     ! i-,j-index of the closes grid point
[6140]40      INTEGER         , INTENT(in   ), OPTIONAL :: kkk  ! k-index of the mask level used
[1725]41      CHARACTER(len=1), INTENT(in   ) ::   cdgrid       ! grid name 'T', 'U', 'V', 'W'
[2715]42      !
[6140]43      INTEGER :: ik         ! working level
[2715]44      INTEGER , DIMENSION(2) ::   iloc
45      REAL(wp)               ::   zlon, zmini
[9019]46      REAL(wp), DIMENSION(jpi,jpj) ::   zglam, zgphi, zmask, zdist
[1725]47      !!--------------------------------------------------------------------
[2715]48      !
49      zmask(:,:) = 0._wp
[6140]50      ik = 1
51      IF ( PRESENT(kkk) ) ik=kkk
[1725]52      SELECT CASE( cdgrid )
[6140]53      CASE( 'U' )  ; zglam(:,:) = glamu(:,:) ; zgphi(:,:) = gphiu(:,:) ; zmask(nldi:nlei,nldj:nlej) = umask(nldi:nlei,nldj:nlej,ik)
54      CASE( 'V' )  ; zglam(:,:) = glamv(:,:) ; zgphi(:,:) = gphiv(:,:) ; zmask(nldi:nlei,nldj:nlej) = vmask(nldi:nlei,nldj:nlej,ik)
55      CASE( 'F' )  ; zglam(:,:) = glamf(:,:) ; zgphi(:,:) = gphif(:,:) ; zmask(nldi:nlei,nldj:nlej) = fmask(nldi:nlei,nldj:nlej,ik)
56      CASE DEFAULT ; zglam(:,:) = glamt(:,:) ; zgphi(:,:) = gphit(:,:) ; zmask(nldi:nlei,nldj:nlej) = tmask(nldi:nlei,nldj:nlej,ik)
[1725]57      END SELECT
58
[7646]59      zlon       = MOD( plon       + 720., 360. )                                     ! plon between    0 and 360
60      zglam(:,:) = MOD( zglam(:,:) + 720., 360. )                                     ! glam between    0 and 360
61      IF( zlon > 270. )   zlon = zlon - 360.                                          ! zlon between  -90 and 270
62      IF( zlon <  90. )   WHERE( zglam(:,:) > 180. ) zglam(:,:) = zglam(:,:) - 360.   ! glam between -180 and 180
63      zglam(:,:) = zglam(:,:) - zlon
[1725]64
65      zgphi(:,:) = zgphi(:,:) - plat
66      zdist(:,:) = zglam(:,:) * zglam(:,:) + zgphi(:,:) * zgphi(:,:)
67     
68      IF( lk_mpp ) THEN 
[10314]69         CALL mpp_minloc( 'domngb', zdist(:,:), zmask, zmini, iloc)
70         kii = iloc(1) ; kjj = iloc(2)
[1725]71      ELSE
72         iloc(:) = MINLOC( zdist(:,:), mask = zmask(:,:) == 1.e0 )
73         kii = iloc(1) + nimpp - 1
74         kjj = iloc(2) + njmpp - 1
75      ENDIF
[2715]76      !
[1725]77   END SUBROUTINE dom_ngb
78
79   !!======================================================================
80END MODULE domngb
Note: See TracBrowser for help on using the repository browser.