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 NEMO/branches/2019/ENHANCE-03_domcfg/src – NEMO

source: NEMO/branches/2019/ENHANCE-03_domcfg/src/domngb.F90 @ 11633

Last change on this file since 11633 was 11633, checked in by mathiot, 4 years ago

modification for in case a domain is a land domain (MINLOC return 0 as indices for the min) (ticket #2143)

File size: 4.6 KB
RevLine 
[6951]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
[11201]13   USE phycst
[10727]14   !
[6951]15   USE in_out_manager ! I/O manager
16   USE lib_mpp        ! for mppsum
17
18   IMPLICIT NONE
19   PRIVATE
20
[11201]21   PUBLIC   dom_ngb   ! routine called in iom.F90 and domclo.F90 module
22   PUBLIC   dist
[6951]23
24   !!----------------------------------------------------------------------
[9598]25   !! NEMO/OCE 4.0 , NEMO Consortium (2018)
[10727]26   !! $Id: domngb.F90 10425 2018-12-19 21:54:16Z smasson $
27   !! Software governed by the CeCILL license (see ./LICENSE)
[6951]28   !!----------------------------------------------------------------------
29CONTAINS
30
[11201]31   SUBROUTINE dom_ngb( plon, plat, kii, kjj, rdist, cdgrid, kkk )
[6951]32      !!----------------------------------------------------------------------
33      !!                    ***  ROUTINE dom_ngb  ***
34      !!
35      !! ** Purpose :   find the closest grid point from a given lon/lat position
36      !!
37      !! ** Method  :   look for minimum distance in cylindrical projection
38      !!                -> not good if located at too high latitude...
39      !!----------------------------------------------------------------------
40      REAL(wp)        , INTENT(in   ) ::   plon, plat   ! longitude,latitude of the point
[11201]41      REAL(wp)        , INTENT(  out) ::   rdist        ! distance between the located point and the source
[6951]42      INTEGER         , INTENT(  out) ::   kii, kjj     ! i-,j-index of the closes grid point
43      INTEGER         , INTENT(in   ), OPTIONAL :: kkk  ! k-index of the mask level used
44      CHARACTER(len=1), INTENT(in   ) ::   cdgrid       ! grid name 'T', 'U', 'V', 'W'
45      !
46      INTEGER :: ik         ! working level
47      INTEGER , DIMENSION(2) ::   iloc
[10727]48      REAL(wp), DIMENSION(jpi,jpj) ::   zglam, zgphi, zmask, zdist
[6951]49      !!--------------------------------------------------------------------
50      !
51      zmask(:,:) = 0._wp
52      ik = 1
53      IF ( PRESENT(kkk) ) ik=kkk
54      SELECT CASE( cdgrid )
55      CASE( 'U' )  ; zglam(:,:) = glamu(:,:) ; zgphi(:,:) = gphiu(:,:) ; zmask(nldi:nlei,nldj:nlej) = umask(nldi:nlei,nldj:nlej,ik)
56      CASE( 'V' )  ; zglam(:,:) = glamv(:,:) ; zgphi(:,:) = gphiv(:,:) ; zmask(nldi:nlei,nldj:nlej) = vmask(nldi:nlei,nldj:nlej,ik)
57      CASE( 'F' )  ; zglam(:,:) = glamf(:,:) ; zgphi(:,:) = gphif(:,:) ; zmask(nldi:nlei,nldj:nlej) = fmask(nldi:nlei,nldj:nlej,ik)
58      CASE DEFAULT ; zglam(:,:) = glamt(:,:) ; zgphi(:,:) = gphit(:,:) ; zmask(nldi:nlei,nldj:nlej) = tmask(nldi:nlei,nldj:nlej,ik)
59      END SELECT
60
[11201]61      zdist = dist(plon, plat, zglam, zgphi)
[11633]62
63      WHERE (zmask(:,:) == 0._wp)
64         zdist(:,:) = HUGE(1._wp)
65      END WHERE
66      zmask = 1._wp
[6951]67     
68      IF( lk_mpp ) THEN 
[11201]69         CALL mpp_minloc( 'domngb', zdist(:,:), zmask, rdist, iloc)
[10727]70         kii = iloc(1) ; kjj = iloc(2)
[6951]71      ELSE
72         iloc(:) = MINLOC( zdist(:,:), mask = zmask(:,:) == 1.e0 )
[11201]73         rdist = MINVAL( zdist(:,:) )
[6951]74         kii = iloc(1) + nimpp - 1
75         kjj = iloc(2) + njmpp - 1
76      ENDIF
77      !
78   END SUBROUTINE dom_ngb
79
[11201]80   FUNCTION dist(plonsrc, platsrc, plontrg, plattrg)
[11633]81      REAL(wp),                     INTENT(in) :: plonsrc, platsrc ! lat/lon of the source point
[11201]82      REAL(wp), DIMENSION(jpi,jpj), INTENT(in) :: plontrg, plattrg ! lat/lon of the target (2d in this case)
83
84      REAL(wp) :: zxs, zys, zzs
85      REAL(wp), DIMENSION(jpi,jpj) :: zxt, zyt, zzt
86
87      REAL(wp), DIMENSION(jpi,jpj) :: dist ! distance between src and trg
88
89      zxs = COS( rad * platsrc ) * COS( rad * plonsrc )
90      zys = COS( rad * platsrc ) * SIN( rad * plonsrc )
91      zzs = SIN( rad * platsrc )
92
93      zxt = COS( rad * plattrg ) * COS( rad * plontrg )
94      zyt = COS( rad * plattrg ) * SIN( rad * plontrg )
95      zzt = SIN( rad * plattrg )
96
97      dist(:,:) = ( zxs - zxt(:,:) )**2   &
98         &      + ( zys - zyt(:,:) )**2   &
99         &      + ( zzs - zzt(:,:) )**2
100
[11633]101      dist(:,:) = ra * SQRT( dist(:,:) )
[11201]102
103   END FUNCTION dist
104
[6951]105   !!======================================================================
106END MODULE domngb
Note: See TracBrowser for help on using the repository browser.