source: trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domngb.F90 @ 7646

Last change on this file since 7646 was 7646, checked in by timgraham, 4 years ago

Merge of dev_merge_2016 into trunk. UPDATE TO ARCHFILES NEEDED for XIOS2.
LIM_SRC_s/limrhg.F90 to follow in next commit due to change of kind (I'm unable to do it in this commit).
Merged using the following steps:

1) svn merge —reintegrate svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk .
2) Resolve minor conflicts in sette.sh and namelist_cfg for ORCA2LIM3 (due to a change in trunk after branch was created)
3) svn commit
4) svn switch svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
5) svn merge svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2016/dev_merge_2016 .
6) At this stage I checked out a clean copy of the branch to compare against what is about to be committed to the trunk.
6) svn commit #Commit code to the trunk

In this commit I have also reverted a change to Fcheck_archfile.sh which was causing problems on the Paris machine.

  • 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 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, kkk )
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      INTEGER         , INTENT(in   ), OPTIONAL :: kkk  ! k-index of the mask level used
42      CHARACTER(len=1), INTENT(in   ) ::   cdgrid       ! grid name 'T', 'U', 'V', 'W'
43      !
44      INTEGER :: ik         ! working level
45      INTEGER , DIMENSION(2) ::   iloc
46      REAL(wp)               ::   zlon, zmini
47      REAL(wp), POINTER, DIMENSION(:,:) ::  zglam, zgphi, zmask, zdist
48      !!--------------------------------------------------------------------
49      !
50      IF( nn_timing == 1 )  CALL timing_start('dom_ngb')
51      !
52      CALL wrk_alloc( jpi,jpj,   zglam, zgphi, zmask, zdist )
53      !
54      zmask(:,:) = 0._wp
55      ik = 1
56      IF ( PRESENT(kkk) ) ik=kkk
57      SELECT CASE( cdgrid )
58      CASE( 'U' )  ; zglam(:,:) = glamu(:,:) ; zgphi(:,:) = gphiu(:,:) ; zmask(nldi:nlei,nldj:nlej) = umask(nldi:nlei,nldj:nlej,ik)
59      CASE( 'V' )  ; zglam(:,:) = glamv(:,:) ; zgphi(:,:) = gphiv(:,:) ; zmask(nldi:nlei,nldj:nlej) = vmask(nldi:nlei,nldj:nlej,ik)
60      CASE( 'F' )  ; zglam(:,:) = glamf(:,:) ; zgphi(:,:) = gphif(:,:) ; zmask(nldi:nlei,nldj:nlej) = fmask(nldi:nlei,nldj:nlej,ik)
61      CASE DEFAULT ; zglam(:,:) = glamt(:,:) ; zgphi(:,:) = gphit(:,:) ; zmask(nldi:nlei,nldj:nlej) = tmask(nldi:nlei,nldj:nlej,ik)
62      END SELECT
63
64      zlon       = MOD( plon       + 720., 360. )                                     ! plon between    0 and 360
65      zglam(:,:) = MOD( zglam(:,:) + 720., 360. )                                     ! glam between    0 and 360
66      IF( zlon > 270. )   zlon = zlon - 360.                                          ! zlon between  -90 and 270
67      IF( zlon <  90. )   WHERE( zglam(:,:) > 180. ) zglam(:,:) = zglam(:,:) - 360.   ! glam between -180 and 180
68      zglam(:,:) = zglam(:,:) - zlon
69
70      zgphi(:,:) = zgphi(:,:) - plat
71      zdist(:,:) = zglam(:,:) * zglam(:,:) + zgphi(:,:) * zgphi(:,:)
72     
73      IF( lk_mpp ) THEN 
74         CALL mpp_minloc( zdist(:,:), zmask, zmini, kii, kjj)
75      ELSE
76         iloc(:) = MINLOC( zdist(:,:), mask = zmask(:,:) == 1.e0 )
77         kii = iloc(1) + nimpp - 1
78         kjj = iloc(2) + njmpp - 1
79      ENDIF
80      !
81      CALL wrk_dealloc( jpi,jpj,   zglam, zgphi, zmask, zdist )
82      !
83      IF( nn_timing == 1 )  CALL timing_stop('dom_ngb')
84      !
85   END SUBROUTINE dom_ngb
86
87   !!======================================================================
88END MODULE domngb
Note: See TracBrowser for help on using the repository browser.