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/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM – NEMO

source: branches/dev_r2586_dynamic_mem/NEMOGCM/NEMO/OPA_SRC/DOM/domngb.F90 @ 2633

Last change on this file since 2633 was 2633, checked in by trackstand2, 13 years ago

Renamed wrk_use => wrk_in_use and wrk_release => wrk_not_released
  • Property svn:keywords set to Id
File size: 4.2 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 on/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   !!----------------------------------------------------------------------
21   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
22   !! $Id$
23   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
24   !!----------------------------------------------------------------------
25
26CONTAINS
27
28   SUBROUTINE dom_ngb( plon, plat, kii, kjj, cdgrid )
29      !!----------------------------------------------------------------------
30      !!                    ***  ROUTINE dom_ngb  ***
31      !!
32      !! ** Purpose :   find the closest grid point from a given on/lat position
33      !!
34      !! ** Method  :   look for minimum distance in cylindrical projection
35      !!                -> not good if located at too high latitude...
36      !!
37      !!----------------------------------------------------------------------
38      USE in_out_manager, ONLY: ctl_stop
39      USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released
40      USE wrk_nemo, ONLY: zglam => wrk_2d_2, &
41                          zgphi => wrk_2d_3, &
42                          zmask => wrk_2d_4, &
43                          zdist => wrk_2d_5
44      IMPLICIT none
45      REAL(wp)        , INTENT(in   ) ::   plon, plat   ! longitude,latitude of the point
46      INTEGER         , INTENT(  out) ::   kii, kjj     ! i-,j-index of the closes grid point
47      CHARACTER(len=1), INTENT(in   ) ::   cdgrid       ! grid name 'T', 'U', 'V', 'W'
48      !!
49      INTEGER , DIMENSION(2)        ::   iloc
50      REAL(wp)                      ::   zlon
51      REAL(wp)                      ::   zmini
52      !!--------------------------------------------------------------------
53
54      IF(wrk_in_use(2, 2, 3, 4, 5))THEN
55         CALL ctl_stop('dom_ngb: Requested workspaces already in use.')
56      END IF
57
58      zmask(:,:) = 0.
59      SELECT CASE( cdgrid )
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      END SELECT
65
66      zlon       = MOD( plon       + 720., 360. )                                     ! plon between    0 and 360
67      zglam(:,:) = MOD( zglam(:,:) + 720., 360. )                                     ! glam between    0 and 360
68      IF( zlon > 270. )   zlon = zlon - 360.                                          ! zlon between  -90 and 270
69      IF( zlon <  90. )   WHERE( zglam(:,:) > 180. ) zglam(:,:) = zglam(:,:) - 360.   ! glam between -180 and 180
70
71      zglam(:,:) = zglam(:,:) - zlon
72      zgphi(:,:) = zgphi(:,:) - plat
73      zdist(:,:) = zglam(:,:) * zglam(:,:) + zgphi(:,:) * zgphi(:,:)
74     
75      IF( lk_mpp ) THEN 
76         CALL mpp_minloc( zdist(:,:), zmask, zmini, kii, kjj)
77      ELSE
78         iloc(:) = MINLOC( zdist(:,:), mask = zmask(:,:) == 1.e0 )
79         kii = iloc(1) + nimpp - 1
80         kjj = iloc(2) + njmpp - 1
81      ENDIF
82
83      IF(wrk_not_released(2, 2,3,4,5))THEN
84         CALL ctl_stop('dom_ngb: error releasing workspaces.')
85      ENDIF
86
87   END SUBROUTINE dom_ngb
88
89   !!======================================================================
90END MODULE domngb
Note: See TracBrowser for help on using the repository browser.