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

source: branches/2015/dev_r5803_NOC_WAD/NEMOGCM/NEMO/OPA_SRC/DOM/domngb.F90 @ 5870

Last change on this file since 5870 was 5870, checked in by acc, 8 years ago

Branch 2015/dev_r5803_NOC_WAD. Merge in trunk changes from 5803 to 5869 in preparation for merge. Also tidied and reorganised some wetting and drying code. Renamed wadlmt.F90 to wetdry.F90. Wetting drying code changes restricted to domzgr.F90, domvvl.F90 nemogcm.F90 sshwzv.F90, dynspg_ts.F90, wetdry.F90 and dynhpg.F90. Code passes full SETTE tests with ln_wd=.false.. Still awaiting test case for checking with ln_wd=.false.
  • Property svn:keywords set to Id
File size: 4.0 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 in_out_manager ! I/O manager
14   USE lib_mpp        ! for mppsum
15   USE wrk_nemo       ! Memory allocation
16   USE timing         ! Timing
17
18   IMPLICIT NONE
19   PRIVATE
20
21   PUBLIC   dom_ngb   ! routine called in iom.F90 module
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      REAL(wp)        , INTENT(in   ) ::   plon, plat   ! longitude,latitude of the point
40      INTEGER         , INTENT(  out) ::   kii, kjj     ! i-,j-index of the closes grid point
41      CHARACTER(len=1), INTENT(in   ) ::   cdgrid       ! grid name 'T', 'U', 'V', 'W'
42      !
43      INTEGER , DIMENSION(2) ::   iloc
44      REAL(wp)               ::   zlon, zmini
45      REAL(wp), POINTER, DIMENSION(:,:) ::  zglam, zgphi, zmask, zdist
46      !!--------------------------------------------------------------------
47      !
48      IF( nn_timing == 1 )  CALL timing_start('dom_ngb')
49      !
50      CALL wrk_alloc( jpi,jpj,   zglam, zgphi, zmask, zdist )
51      !
52      zmask(:,:) = 0._wp
53      SELECT CASE( cdgrid )
54      CASE( 'U' )  ; zglam(:,:) = glamu(:,:) ; zgphi(:,:) = gphiu(:,:) ; zmask(nldi:nlei,nldj:nlej) = umask(nldi:nlei,nldj:nlej,1)
55      CASE( 'V' )  ; zglam(:,:) = glamv(:,:) ; zgphi(:,:) = gphiv(:,:) ; zmask(nldi:nlei,nldj:nlej) = vmask(nldi:nlei,nldj:nlej,1)
56      CASE( 'F' )  ; zglam(:,:) = glamf(:,:) ; zgphi(:,:) = gphif(:,:) ; zmask(nldi:nlei,nldj:nlej) = fmask(nldi:nlei,nldj:nlej,1)
57      CASE DEFAULT ; zglam(:,:) = glamt(:,:) ; zgphi(:,:) = gphit(:,:) ; zmask(nldi:nlei,nldj:nlej) = tmask(nldi:nlei,nldj:nlej,1)
58      END SELECT
59
60      zlon       = MOD( plon       + 720., 360. )                                     ! plon between    0 and 360
61      zglam(:,:) = MOD( zglam(:,:) + 720., 360. )                                     ! glam between    0 and 360
62      IF( zlon > 270. )   zlon = zlon - 360.                                          ! zlon between  -90 and 270
63      IF( zlon <  90. )   WHERE( zglam(:,:) > 180. ) zglam(:,:) = zglam(:,:) - 360.   ! glam between -180 and 180
64
65      zglam(:,:) = zglam(:,:) - zlon
66      zgphi(:,:) = zgphi(:,:) - plat
67      zdist(:,:) = zglam(:,:) * zglam(:,:) + zgphi(:,:) * zgphi(:,:)
68     
69      IF( lk_mpp ) THEN 
70         CALL mpp_minloc( zdist(:,:), zmask, zmini, kii, kjj)
71      ELSE
72         iloc(:) = MINLOC( zdist(:,:), mask = zmask(:,:) == 1.e0 )
73         kii = iloc(1) + nimpp - 1
74         kjj = iloc(2) + njmpp - 1
75      ENDIF
76      !
77      CALL wrk_dealloc( jpi,jpj,   zglam, zgphi, zmask, zdist )
78      !
79      IF( nn_timing == 1 )  CALL timing_stop('dom_ngb')
80      !
81   END SUBROUTINE dom_ngb
82
83   !!======================================================================
84END MODULE domngb
Note: See TracBrowser for help on using the repository browser.