source: branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/OPA_SRC/DOM/domngb.F90 @ 11738

Last change on this file since 11738 was 11738, checked in by marc, 14 months ago

The Dr Hook changes from my perl code.

File size: 4.4 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
[3294]13   USE in_out_manager ! I/O manager
[2715]14   USE lib_mpp        ! for mppsum
[3294]15   USE wrk_nemo       ! Memory allocation
16   USE timing         ! Timing
[1725]17
[11738]18   USE yomhook, ONLY: lhook, dr_hook
19   USE parkind1, ONLY: jprb, jpim
20
[1725]21   IMPLICIT NONE
22   PRIVATE
23
[2715]24   PUBLIC   dom_ngb   ! routine called in iom.F90 module
[1725]25
26   !!----------------------------------------------------------------------
[2528]27   !! NEMO/OPA 3.3 , NEMO Consortium (2010)
[6486]28   !! $Id$
[2715]29   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
[1725]30   !!----------------------------------------------------------------------
31CONTAINS
32
33   SUBROUTINE dom_ngb( plon, plat, kii, kjj, cdgrid )
34      !!----------------------------------------------------------------------
35      !!                    ***  ROUTINE dom_ngb  ***
36      !!
[2715]37      !! ** Purpose :   find the closest grid point from a given lon/lat position
[1725]38      !!
39      !! ** Method  :   look for minimum distance in cylindrical projection
40      !!                -> not good if located at too high latitude...
41      !!----------------------------------------------------------------------
[2715]42      !
[1725]43      REAL(wp)        , INTENT(in   ) ::   plon, plat   ! longitude,latitude of the point
44      INTEGER         , INTENT(  out) ::   kii, kjj     ! i-,j-index of the closes grid point
45      CHARACTER(len=1), INTENT(in   ) ::   cdgrid       ! grid name 'T', 'U', 'V', 'W'
[2715]46      !
47      INTEGER , DIMENSION(2) ::   iloc
48      REAL(wp)               ::   zlon, zmini
[3294]49      REAL(wp), POINTER, DIMENSION(:,:) ::  zglam, zgphi, zmask, zdist
[11738]50      INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
51      INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
52      REAL(KIND=jprb)               :: zhook_handle
53
54      CHARACTER(LEN=*), PARAMETER :: RoutineName='DOM_NGB'
55
56      IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
57
[1725]58      !!--------------------------------------------------------------------
[2715]59      !
[3294]60      IF( nn_timing == 1 )  CALL timing_start('dom_ngb')
[2715]61      !
[3294]62      CALL wrk_alloc( jpi, jpj, zglam, zgphi, zmask, zdist )
63      !
[2715]64      zmask(:,:) = 0._wp
[1725]65      SELECT CASE( cdgrid )
66      CASE( 'U' )  ; zglam(:,:) = glamu(:,:) ; zgphi(:,:) = gphiu(:,:) ; zmask(nldi:nlei,nldj:nlej) = umask(nldi:nlei,nldj:nlej,1)
67      CASE( 'V' )  ; zglam(:,:) = glamv(:,:) ; zgphi(:,:) = gphiv(:,:) ; zmask(nldi:nlei,nldj:nlej) = vmask(nldi:nlei,nldj:nlej,1)
68      CASE( 'F' )  ; zglam(:,:) = glamf(:,:) ; zgphi(:,:) = gphif(:,:) ; zmask(nldi:nlei,nldj:nlej) = fmask(nldi:nlei,nldj:nlej,1)
69      CASE DEFAULT ; zglam(:,:) = glamt(:,:) ; zgphi(:,:) = gphit(:,:) ; zmask(nldi:nlei,nldj:nlej) = tmask(nldi:nlei,nldj:nlej,1)
70      END SELECT
71
72      zlon       = MOD( plon       + 720., 360. )                                     ! plon between    0 and 360
73      zglam(:,:) = MOD( zglam(:,:) + 720., 360. )                                     ! glam between    0 and 360
74      IF( zlon > 270. )   zlon = zlon - 360.                                          ! zlon between  -90 and 270
75      IF( zlon <  90. )   WHERE( zglam(:,:) > 180. ) zglam(:,:) = zglam(:,:) - 360.   ! glam between -180 and 180
76
77      zglam(:,:) = zglam(:,:) - zlon
78      zgphi(:,:) = zgphi(:,:) - plat
79      zdist(:,:) = zglam(:,:) * zglam(:,:) + zgphi(:,:) * zgphi(:,:)
80     
81      IF( lk_mpp ) THEN 
82         CALL mpp_minloc( zdist(:,:), zmask, zmini, kii, kjj)
83      ELSE
84         iloc(:) = MINLOC( zdist(:,:), mask = zmask(:,:) == 1.e0 )
85         kii = iloc(1) + nimpp - 1
86         kjj = iloc(2) + njmpp - 1
87      ENDIF
[2715]88      !
[3294]89      CALL wrk_dealloc( jpi, jpj, zglam, zgphi, zmask, zdist )
[2715]90      !
[3294]91      IF( nn_timing == 1 )  CALL timing_stop('dom_ngb')
92      !
[11738]93      IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
[1725]94   END SUBROUTINE dom_ngb
95
96   !!======================================================================
97END MODULE domngb
Note: See TracBrowser for help on using the repository browser.