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.
domngb.F90 in branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM – NEMO

source: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DOM/domngb.F90 @ 4409

Last change on this file since 4409 was 3211, checked in by spickles2, 12 years ago

Stephen Pickles, 11 Dec 2011

Commit to bring the rest of the DCSE NEMO development branch
in line with the latest development version. This includes
array index re-ordering of all OPA_SRC/.
  • Property svn:keywords set to Id
File size: 4.6 KB
Line 
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   !!----------------------------------------------------------------------
10   !!   dom_ngb       : find the closest grid point from a given lon/lat position
11   !!----------------------------------------------------------------------
12   USE dom_oce        ! ocean space and time domain
13   USE lib_mpp        ! for mppsum
14
15   IMPLICIT NONE
16   PRIVATE
17
18   PUBLIC   dom_ngb   ! routine called in iom.F90 module
19
20   !! * Control permutation of array indices
21#  include "dom_oce_ftrans.h90"
22
23   !!----------------------------------------------------------------------
24   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
25   !! $Id$
26   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
27   !!----------------------------------------------------------------------
28CONTAINS
29
30   SUBROUTINE dom_ngb( plon, plat, kii, kjj, cdgrid )
31      !!----------------------------------------------------------------------
32      !!                    ***  ROUTINE dom_ngb  ***
33      !!
34      !! ** Purpose :   find the closest grid point from a given lon/lat position
35      !!
36      !! ** Method  :   look for minimum distance in cylindrical projection
37      !!                -> not good if located at too high latitude...
38      !!----------------------------------------------------------------------
39      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released
40      USE wrk_nemo, ONLY:   zglam => wrk_2d_2 , zgphi => wrk_2d_3 , zmask => wrk_2d_4 , zdist => wrk_2d_5
41      !
42      REAL(wp)        , INTENT(in   ) ::   plon, plat   ! longitude,latitude of the point
43      INTEGER         , INTENT(  out) ::   kii, kjj     ! i-,j-index of the closes grid point
44      CHARACTER(len=1), INTENT(in   ) ::   cdgrid       ! grid name 'T', 'U', 'V', 'W'
45      !
46      INTEGER , DIMENSION(2) ::   iloc
47      REAL(wp)               ::   zlon, zmini
48      !!--------------------------------------------------------------------
49      !
50      IF( wrk_in_use(2, 2,3,4,5) )   CALL ctl_stop('dom_ngb: Requested workspaces already in use')
51      !
52      zmask(:,:) = 0._wp
53      SELECT CASE( cdgrid )
54#if defined key_z_first
55      CASE( 'U' )  ; zglam(:,:) = glamu(:,:) ; zgphi(:,:) = gphiu(:,:) ; zmask(nldi:nlei,nldj:nlej) = umask_1(nldi:nlei,nldj:nlej)
56      CASE( 'V' )  ; zglam(:,:) = glamv(:,:) ; zgphi(:,:) = gphiv(:,:) ; zmask(nldi:nlei,nldj:nlej) = vmask_1(nldi:nlei,nldj:nlej)
57      CASE( 'F' )  ; zglam(:,:) = glamf(:,:) ; zgphi(:,:) = gphif(:,:) ; zmask(nldi:nlei,nldj:nlej) = fmask_1(nldi:nlei,nldj:nlej)
58      CASE DEFAULT ; zglam(:,:) = glamt(:,:) ; zgphi(:,:) = gphit(:,:) ; zmask(nldi:nlei,nldj:nlej) = tmask_1(nldi:nlei,nldj:nlej)
59#else
60      CASE( 'U' )  ; zglam(:,:) = glamu(:,:) ; zgphi(:,:) = gphiu(:,:) ; zmask(nldi:nlei,nldj:nlej) = umask(nldi:nlei,nldj:nlej,1)
61      CASE( 'V' )  ; zglam(:,:) = glamv(:,:) ; zgphi(:,:) = gphiv(:,:) ; zmask(nldi:nlei,nldj:nlej) = vmask(nldi:nlei,nldj:nlej,1)
62      CASE( 'F' )  ; zglam(:,:) = glamf(:,:) ; zgphi(:,:) = gphif(:,:) ; zmask(nldi:nlei,nldj:nlej) = fmask(nldi:nlei,nldj:nlej,1)
63      CASE DEFAULT ; zglam(:,:) = glamt(:,:) ; zgphi(:,:) = gphit(:,:) ; zmask(nldi:nlei,nldj:nlej) = tmask(nldi:nlei,nldj:nlej,1)
64#endif
65      END SELECT
66
67      zlon       = MOD( plon       + 720., 360. )                                     ! plon between    0 and 360
68      zglam(:,:) = MOD( zglam(:,:) + 720., 360. )                                     ! glam between    0 and 360
69      IF( zlon > 270. )   zlon = zlon - 360.                                          ! zlon between  -90 and 270
70      IF( zlon <  90. )   WHERE( zglam(:,:) > 180. ) zglam(:,:) = zglam(:,:) - 360.   ! glam between -180 and 180
71
72      zglam(:,:) = zglam(:,:) - zlon
73      zgphi(:,:) = zgphi(:,:) - plat
74      zdist(:,:) = zglam(:,:) * zglam(:,:) + zgphi(:,:) * zgphi(:,:)
75     
76      IF( lk_mpp ) THEN 
77         CALL mpp_minloc( zdist(:,:), zmask, zmini, kii, kjj)
78      ELSE
79         iloc(:) = MINLOC( zdist(:,:), mask = zmask(:,:) == 1.e0 )
80         kii = iloc(1) + nimpp - 1
81         kjj = iloc(2) + njmpp - 1
82      ENDIF
83      !
84      IF( wrk_not_released(2, 2,3,4,5) )   CALL ctl_stop('dom_ngb: error releasing workspaces')
85      !
86   END SUBROUTINE dom_ngb
87
88   !!======================================================================
89END MODULE domngb
Note: See TracBrowser for help on using the repository browser.