source: NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DOM/domutl.F90 @ 12807

Last change on this file since 12807 was 12807, checked in by smasson, 10 months ago

Extra_Halo: input file only over inner domain + new variables names, see #2366

  • Property svn:keywords set to Id
File size: 5.8 KB
Line 
1MODULE domutl
2   !!======================================================================
3   !!                       ***  MODULE  domutl  ***
4   !! Grid utilities:
5   !!======================================================================
6   !! History : 4.2  !  2020-04  (S. Masson)  Original code
7   !!----------------------------------------------------------------------
8
9   !!----------------------------------------------------------------------
10   !!   dom_ngb       : find the closest grid point from a given lon/lat position
11   !!   dom_uniq      : identify unique point of a grid (TUVF)
12   !!----------------------------------------------------------------------
13   !
14   USE dom_oce        ! ocean space and time domain
15   !
16   USE in_out_manager ! I/O manager
17   USE lbclnk         ! ocean lateral boundary conditions (or mpp link)
18   USE lib_mpp        ! for mppsum
19
20   IMPLICIT NONE
21   PRIVATE
22
23   PUBLIC dom_ngb    ! routine called in iom.F90 module
24   PUBLIC dom_uniq   ! Called by dommsk and domwri
25
26   !!----------------------------------------------------------------------
27   !! NEMO/OCE 4.2 , NEMO Consortium (2020)
28   !! $Id$
29   !! Software governed by the CeCILL license (see ./LICENSE)
30   !!----------------------------------------------------------------------
31CONTAINS
32
33   SUBROUTINE dom_ngb( plon, plat, kii, kjj, cdgrid, kkk )
34      !!----------------------------------------------------------------------
35      !!                    ***  ROUTINE dom_ngb  ***
36      !!
37      !! ** Purpose :   find the closest grid point from a given lon/lat position
38      !!
39      !! ** Method  :   look for minimum distance in cylindrical projection
40      !!                -> not good if located at too high latitude...
41      !!----------------------------------------------------------------------
42      REAL(wp)        , INTENT(in   ) ::   plon, plat   ! longitude,latitude of the point
43      INTEGER         , INTENT(  out) ::   kii, kjj     ! i-,j-index of the closes grid point
44      INTEGER         , INTENT(in   ), OPTIONAL :: kkk  ! k-index of the mask level used
45      CHARACTER(len=1), INTENT(in   ) ::   cdgrid       ! grid name 'T', 'U', 'V', 'W'
46      !
47      INTEGER :: ik         ! working level
48      INTEGER , DIMENSION(2) ::   iloc
49      REAL(wp)               ::   zlon, zmini
50      REAL(wp), DIMENSION(jpi,jpj) ::   zglam, zgphi, zmask, zdist
51      !!--------------------------------------------------------------------
52      !
53      ik = 1
54      IF ( PRESENT(kkk) ) ik=kkk
55      !
56      CALL dom_uniq(zmask,cdgrid)
57      !
58      SELECT CASE( cdgrid )
59      CASE( 'U' )    ;   zglam(:,:) = glamu(:,:)   ;   zgphi(:,:) = gphiu(:,:)   ;   zmask(:,:) = zmask(:,:) * umask(:,:,ik)
60      CASE( 'V' )    ;   zglam(:,:) = glamv(:,:)   ;   zgphi(:,:) = gphiv(:,:)   ;   zmask(:,:) = zmask(:,:) * vmask(:,:,ik)
61      CASE( 'F' )    ;   zglam(:,:) = glamf(:,:)   ;   zgphi(:,:) = gphif(:,:)   ;   zmask(:,:) = zmask(:,:) * fmask(:,:,ik)
62      CASE DEFAULT   ;   zglam(:,:) = glamt(:,:)   ;   zgphi(:,:) = gphit(:,:)   ;   zmask(:,:) = zmask(:,:) * tmask(:,:,ik)
63      END SELECT
64      !
65      zlon       = MOD( plon       + 720., 360. )                                     ! plon between    0 and 360
66      zglam(:,:) = MOD( zglam(:,:) + 720., 360. )                                     ! glam between    0 and 360
67      IF( zlon > 270. )   zlon = zlon - 360.                                          ! zlon between  -90 and 270
68      IF( zlon <  90. )   WHERE( zglam(:,:) > 180. ) zglam(:,:) = zglam(:,:) - 360.   ! glam between -180 and 180
69      zglam(:,:) = zglam(:,:) - zlon
70
71      zgphi(:,:) = zgphi(:,:) - plat
72      zdist(:,:) = zglam(:,:) * zglam(:,:) + zgphi(:,:) * zgphi(:,:)
73     
74      IF( lk_mpp ) THEN 
75         CALL mpp_minloc( 'domngb', zdist(:,:), zmask, zmini, iloc)
76         kii = iloc(1) ; kjj = iloc(2)
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   END SUBROUTINE dom_ngb
84
85
86   SUBROUTINE dom_uniq( puniq, cdgrd )
87      !!----------------------------------------------------------------------
88      !!                  ***  ROUTINE dom_uniq  ***
89      !!                   
90      !! ** Purpose :   identify unique point of a grid (TUVF)
91      !!
92      !! ** Method  :   1) aplly lbc_lnk on an array with different values for each element
93      !!                2) check which elements have been changed
94      !!----------------------------------------------------------------------
95      CHARACTER(len=1)        , INTENT(in   ) ::   cdgrd   !
96      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   puniq   !
97      !
98      REAL(wp)                       ::  zshift   ! shift value link to the process number
99      INTEGER                        ::  ji       ! dummy loop indices
100      LOGICAL , DIMENSION(jpi,jpj,1) ::   lluniq  ! store whether each point is unique or not
101      REAL(wp), DIMENSION(jpi,jpj  ) ::   ztstref
102      !!----------------------------------------------------------------------
103      !
104      ! build an array with different values for each element
105      ! in mpp: make sure that these values are different even between process
106      ! -> apply a shift value according to the process number
107      zshift = jpimax * jpjmax * ( narea - 1 )
108      ztstref(:,:) = RESHAPE( (/ (zshift + REAL(ji,wp), ji = 1, jpi*jpj) /), (/ jpi, jpj /) )
109      !
110      puniq(:,:) = ztstref(:,:)                    ! default definition
111      CALL lbc_lnk( 'domwri', puniq, cdgrd, 1. )   ! apply boundary conditions
112      lluniq(:,:,1) = puniq(:,:) == ztstref(:,:)   ! check which values have not been changed
113      !
114      puniq(:,:) = REAL( COUNT( lluniq(:,:,:), dim = 3 ), wp )
115      !
116   END SUBROUTINE dom_uniq
117   
118   !!======================================================================
119END MODULE domutl
Note: See TracBrowser for help on using the repository browser.