- Timestamp:
- 2020-04-23T15:14:45+02:00 (4 years ago)
- File:
-
- 1 moved
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DOM/domutl.F90
r12766 r12807 1 MODULE dom ngb1 MODULE domutl 2 2 !!====================================================================== 3 !! *** MODULE dom ngb***4 !! Grid search: find the closest grid point from a given on/lat position3 !! *** MODULE domutl *** 4 !! Grid utilities: 5 5 !!====================================================================== 6 !! History : 3.2 ! 2009-11(S. Masson) Original code6 !! History : 4.2 ! 2020-04 (S. Masson) Original code 7 7 !!---------------------------------------------------------------------- 8 8 9 9 !!---------------------------------------------------------------------- 10 10 !! dom_ngb : find the closest grid point from a given lon/lat position 11 !! dom_uniq : identify unique point of a grid (TUVF) 11 12 !!---------------------------------------------------------------------- 13 ! 12 14 USE dom_oce ! ocean space and time domain 13 15 ! 14 16 USE in_out_manager ! I/O manager 17 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 15 18 USE lib_mpp ! for mppsum 16 19 … … 18 21 PRIVATE 19 22 20 PUBLIC dom_ngb ! routine called in iom.F90 module 23 PUBLIC dom_ngb ! routine called in iom.F90 module 24 PUBLIC dom_uniq ! Called by dommsk and domwri 21 25 22 26 !!---------------------------------------------------------------------- 23 !! NEMO/OCE 4. 0 , NEMO Consortium (2018)27 !! NEMO/OCE 4.2 , NEMO Consortium (2020) 24 28 !! $Id$ 25 29 !! Software governed by the CeCILL license (see ./LICENSE) … … 47 51 !!-------------------------------------------------------------------- 48 52 ! 49 zmask(:,:) = 0._wp50 53 ik = 1 51 54 IF ( PRESENT(kkk) ) ik=kkk 55 ! 56 CALL dom_uniq(zmask,cdgrid) 57 ! 52 58 SELECT CASE( cdgrid ) 53 CASE( 'U' ) ; zglam(:,:) = glamu(:,:) ; zgphi(:,:) = gphiu(:,:) ; zmask(nldi:nlei,nldj:nlej) = umask(nldi:nlei,nldj:nlej,ik)54 CASE( 'V' ) ; zglam(:,:) = glamv(:,:) ; zgphi(:,:) = gphiv(:,:) ; zmask(nldi:nlei,nldj:nlej) = vmask(nldi:nlei,nldj:nlej,ik)55 CASE( 'F' ) ; zglam(:,:) = glamf(:,:) ; zgphi(:,:) = gphif(:,:) ; zmask(nldi:nlei,nldj:nlej) = fmask(nldi:nlei,nldj:nlej,ik)56 CASE DEFAULT ; zglam(:,:) = glamt(:,:) ; zgphi(:,:) = gphit(:,:) ; zmask(nldi:nlei,nldj:nlej) = tmask(nldi:nlei,nldj:nlej,ik)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) 57 63 END SELECT 58 64 ! 59 65 zlon = MOD( plon + 720., 360. ) ! plon between 0 and 360 60 66 zglam(:,:) = MOD( zglam(:,:) + 720., 360. ) ! glam between 0 and 360 … … 77 83 END SUBROUTINE dom_ngb 78 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 79 118 !!====================================================================== 80 END MODULE dom ngb119 END MODULE domutl
Note: See TracChangeset
for help on using the changeset viewer.