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.
domc1d.F90 in trunk/NEMOGCM/NEMO/OPA_SRC/C1D – NEMO

source: trunk/NEMOGCM/NEMO/OPA_SRC/C1D/domc1d.F90 @ 7881

Last change on this file since 7881 was 7646, checked in by timgraham, 7 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: 9.7 KB
Line 
1MODULE domc1d
2   !!======================================================================
3   !!                     ***  MODULE  domc1d  ***
4   !! Ocean Domain : 1D column position from lat/lon namelist specification
5   !!======================================================================
6   !! History :  3.5  !  2013-04  (D. Calvert)  Original code
7   !!----------------------------------------------------------------------
8#if defined key_c1d
9   !!----------------------------------------------------------------------
10   !!   'key_c1d'   :                                      1D Configuration
11   !!----------------------------------------------------------------------
12   !!   dom_c1d     : Determine jpizoom/jpjzoom from a given lat/lon
13   !!----------------------------------------------------------------------
14   USE phycst         ! Physical constants (and par_oce)
15   USE dom_oce , ONLY : nimpp, njmpp ! Shared/distributed memory setting
16   !
17   USE iom            ! I/O library (iom_get)
18   USE in_out_manager ! I/O manager (ctmp1)
19   USE wrk_nemo                      ! Memory allocation
20   USE timing                        ! Timing
21
22   IMPLICIT NONE
23   PRIVATE
24
25   PUBLIC   dom_c1d   ! called in domcfg.F90
26
27   INTEGER ::   jpizoom = 1      !: left bottom (i,j) indices of the zoom
28   INTEGER ::   jpjzoom = 1      !: in data domain indices
29
30   !!----------------------------------------------------------------------
31   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
32   !! $Id$
33   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
34   !!----------------------------------------------------------------------
35CONTAINS
36   
37   SUBROUTINE dom_c1d( plat, plon )
38      !!----------------------------------------------------------------------
39      !!                   ***  ROUTINE dom_c1d  ***
40      !!
41      !! ** Purpose : Recalculate jpizoom/jpjzoom indices from lat/lon point
42      !!
43      !! ** Method  : Calculate global gphit and glamt as for dom_hgr.
44      !!              After, find closest grid point to lat/lon point as for
45      !!              dom_ngb on T grid. From this infer jpizoom and jpjzoom.
46      !!
47      !! ** Action  : Recalculate jpizoom, jpjzoom (indices of C1D zoom)
48      !!----------------------------------------------------------------------
49      REAL(wp), INTENT(in) ::  plat, plon    ! Column latitude &  longitude
50      !
51      INTEGER  ::  ji, jj   ! Dummy loop indices
52      INTEGER  ::  inum     ! Coordinate file handle (case 0)
53      INTEGER  ::  ijeq     ! Index of equator T point (case 4)
54      INTEGER  ::  ios      ! Local integer output status for namelist read
55      INTEGER , DIMENSION(2) ::   iloc   ! Minloc returned indices
56      REAL(wp) ::  zlon                            ! Wraparound longitude
57      REAL(wp) ::  zti, ztj, zarg                  ! Local scalars
58      REAL(wp) ::  glam0, gphi0                    ! Variables corresponding to parameters ppglam0 ppgphi0 set in par_oce
59      REAL(wp) ::  zlam1, zcos_alpha, ze1, ze1deg  ! Case 5 local scalars
60      REAL(wp) ::  zphi1, zsin_alpha, zim05, zjm05 !         
61      REAL(wp) , POINTER, DIMENSION(:,:) ::  gphidta, glamdta, zdist ! Global lat/lon
62      !!
63      NAMELIST/namdom/ nn_bathy, rn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh, rn_hmin,   &
64         &             rn_atfp     , rn_rdt      ,nn_closea , ln_crs,  jphgr_msh, &
65         &             ppglam0, ppgphi0, ppe1_deg, ppe2_deg, ppe1_m, ppe2_m, &
66         &             ppsur, ppa0, ppa1, ppkth, ppacr, ppdzmin, pphmax, ldbletanh, &
67         &             ppa2, ppkth2, ppacr2
68      !!----------------------------------------------------------------------
69
70      IF( nn_timing == 1 )   CALL timing_start('dom_c1d')
71
72      REWIND( numnam_ref )              ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep)
73      READ  ( numnam_ref, namdom, IOSTAT = ios, ERR = 901 )
74901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdom in reference namelist', lwp )
75      !
76      REWIND( numnam_cfg )              ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep)
77      READ  ( numnam_cfg, namdom, IOSTAT = ios, ERR = 902 )
78902   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp )
79
80      CALL wrk_alloc( jpidta,jpjdta,   gphidta, glamdta, zdist )
81
82      ! ============================= !
83      !  Code from dom_hgr:           !
84      !  Calculate global horizontal  !
85      !  mesh, only glamt and gphit   !
86      ! ============================= !
87      !
88      SELECT CASE( jphgr_msh )   ! type of horizontal mesh
89      !
90      CASE ( 0 )                 !  curvilinear coordinate on the sphere read in coordinate.nc file
91         !
92         CALL iom_open( 'coordinates', inum )
93         CALL iom_get( inum, jpdom_unknown, 'glamt', glamdta ) ! mig, mjg undefined at this point
94         CALL iom_get( inum, jpdom_unknown, 'gphit', gphidta ) ! so use jpdom_unknown not jpdom_data
95         CALL iom_close ( inum )
96         !
97      CASE ( 1 )                 ! geographical mesh on the sphere with regular grid-spacing
98         !
99         DO jj = 1, jpjdta
100            DO ji = 1, jpidta
101               zti = FLOAT( ji - 1 + nimpp - 1 )
102               ztj = FLOAT( jj - 1 + njmpp - 1 )
103               !
104               glamdta(ji,jj) = ppglam0 + ppe1_deg * zti
105               gphidta(ji,jj) = ppgphi0 + ppe2_deg * ztj
106            END DO
107         END DO
108         !
109      CASE ( 2:3 )               ! f- or beta-plane with regular grid-spacing
110         !
111         glam0 = 0.e0
112         gphi0 = - ppe2_m * 1.e-3
113         !
114         DO jj = 1, jpjdta
115            DO ji = 1, jpidta
116               glamdta(ji,jj) = glam0 + ppe1_m * 1.e-3 * FLOAT( ji - 1 + nimpp - 1 )
117               gphidta(ji,jj) = gphi0 + ppe2_m * 1.e-3 * FLOAT( jj - 1 + njmpp - 1 )
118            END DO
119         END DO
120         !
121      CASE ( 4 )                 ! geographical mesh on the sphere, isotropic MERCATOR type
122         !
123         IF( ppgphi0 == -90 )   CALL ctl_stop( ' Mercator grid cannot start at south pole !!!! ' )
124         !
125         zarg = rpi / 4. - rpi / 180. * ppgphi0 / 2.
126         ijeq = ABS( 180. / rpi * LOG( COS( zarg ) / SIN( zarg ) ) / ppe1_deg )
127         IF( ppgphi0 > 0 )   ijeq = -ijeq
128         !
129         DO jj = 1, jpjdta
130            DO ji = 1, jpidta
131               zti = FLOAT( ji - 1    + nimpp - 1 )
132               ztj = FLOAT( jj - ijeq + njmpp - 1 )
133               !
134               glamdta(ji,jj) = ppglam0 + ppe1_deg * zti
135               gphidta(ji,jj) = 1. / rad * ASIN ( TANH( ppe1_deg * rad * ztj ) )
136            END DO
137         END DO
138         !
139      CASE ( 5 )                 ! beta-plane with regular grid-spacing and rotated domain (GYRE configuration)
140         !
141         zlam1 = -85
142         zphi1 = 29
143         ze1 = 106000. / REAL( nn_cfg , wp )
144         !
145         zsin_alpha = - SQRT( 2. ) / 2.
146         zcos_alpha =   SQRT( 2. ) / 2.
147         ze1deg = ze1 / (ra * rad)
148         !
149         glam0 = zlam1 + zcos_alpha * ze1deg * FLOAT( jpjdta-2 ) ! Force global
150         gphi0 = zphi1 + zsin_alpha * ze1deg * FLOAT( jpjdta-2 )
151         !
152         DO jj = 1, jpjdta
153            DO ji = 1, jpidta
154               zim05 = FLOAT( ji + nimpp - 1 ) - 1.5
155               zjm05 = FLOAT( jj + njmpp - 1 ) - 1.5
156
157               glamdta(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha
158               gphidta(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha
159            END DO
160         END DO
161         !
162      CASE DEFAULT
163         !
164         WRITE(ctmp1,*) '          bad flag value for jphgr_msh = ', jphgr_msh
165         CALL ctl_stop( ctmp1 )
166         !
167      END SELECT
168
169      ! ============================== !
170      !  Code from dom_ngb:            !
171      !  Calculate the nearest grid    !
172      !  point to the given lat/lon &  !
173      !  update jpizoom and jpjzoom    !
174      ! ============================== !
175
176      zlon         = MOD( plon         + 720., 360. )                                      ! plon    between    0 and 360
177      glamdta(:,:) = MOD( glamdta(:,:) + 720., 360. )                                      ! glamdta between    0 and 360
178      IF( zlon > 270. )   zlon = zlon - 360.                                               ! zlon    between  -90 and 270
179      IF( zlon <  90. )   WHERE( glamdta(:,:) > 180. ) glamdta(:,:) = glamdta(:,:) - 360.  ! glamdta between -180 and 180
180
181      glamdta(:,:) = glamdta(:,:) - zlon
182      gphidta(:,:) = gphidta(:,:) - plat
183      zdist(:,:)   = glamdta(:,:) * glamdta(:,:) + gphidta(:,:) * gphidta(:,:)
184     
185      iloc(:) = MINLOC( zdist(:,:) ) ! No mask; zoom indices freely defined
186      jpizoom = iloc(1) + nimpp - 2  ! Minloc index - 1; want the bottom-left
187      jpjzoom = iloc(2) + njmpp - 2  ! corner index of the zoom domain.
188
189      CALL wrk_dealloc( jpidta,jpjdta,   gphidta, glamdta, zdist )
190
191      IF (lwp) THEN
192         WRITE(numout,*)
193         WRITE(numout,*) 'dom_c1d : compute jpizoom & jpjzoom from global mesh and given coordinates'
194         WRITE(numout,*) '~~~~~~~'
195         WRITE(numout,*) '      column i zoom index             jpizoom = ', jpizoom
196         WRITE(numout,*) '      column j zoom index             jpjzoom = ', jpjzoom
197         WRITE(numout,*)
198      ENDIF
199      !
200      IF( nn_timing == 1 )   CALL timing_stop('dom_c1d')
201      !
202   END SUBROUTINE dom_c1d
203
204#else
205   !!----------------------------------------------------------------------
206   !!   Default option                                  NO 1D Configuration
207   !!----------------------------------------------------------------------
208CONTAINS 
209   SUBROUTINE dom_c1d( plat, plon )     ! Empty routine
210      REAL :: plat, plon
211      WRITE(*,*) 'dom_c1d: You should not have seen this print! error?',plat,plon
212   END SUBROUTINE dom_c1d
213#endif
214
215   !!======================================================================
216END MODULE domc1d
Note: See TracBrowser for help on using the repository browser.