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.
domhgr.F90 in trunk/NEMO/OPA_SRC/DOM – NEMO

source: trunk/NEMO/OPA_SRC/DOM/domhgr.F90 @ 145

Last change on this file since 145 was 93, checked in by opalod, 20 years ago

CT : UPDATE060 : A new configuration, named GYRE, has been added.
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 38.8 KB
Line 
1MODULE domhgr
2   !!==============================================================================
3   !!                       ***  MODULE domhgr   ***
4   !! Ocean initialization : domain initialization
5   !!==============================================================================
6
7   !!----------------------------------------------------------------------
8   !!   dom_hgr        : initialize the horizontal mesh
9   !!   hgr_read       : read "coordinate" NetCDF file
10   !!   hgr_read_fdir  : read "coordinate" direct access file
11   !!----------------------------------------------------------------------
12   !! * Modules used
13   USE dom_oce         ! ocean space and time domain
14   USE phycst          ! physical constants
15   USE in_out_manager  ! I/O manager
16
17   IMPLICIT NONE
18   PRIVATE
19
20   !! * Module variables
21   REAL(wp) ::   glam0, gphi0           ! variables corresponding to parameters
22      !                                 ! ppglam0 ppgphi0 set in par_oce
23
24   !! * Routine accessibility
25   PUBLIC dom_hgr        ! called by domain.F90
26   !!----------------------------------------------------------------------
27   !!   OPA 9.0 , LODYC-IPSL   (2003)
28   !!----------------------------------------------------------------------
29
30CONTAINS
31
32   SUBROUTINE dom_hgr
33      !!----------------------------------------------------------------------
34      !!                  ***  ROUTINE dom_hgr  ***
35      !!
36      !! ** Purpose :   Compute the geographical position (in degre) of the
37      !!      model grid-points,  the horizontal scale factors (in meters) and
38      !!      the Coriolis factor (in s-1).
39      !!
40      !! ** Method  :   The geographical position of the model grid-points is
41      !!      defined from analytical functions, fslam and fsphi, the deriva-
42      !!      tives of which gives the horizontal scale factors e1,e2.
43      !!      Defining two function fslam and fsphi and their derivatives in
44      !!      the two horizontal directions (fse1 and fse2), the model grid-
45      !!      point position and scale factors are given by:
46      !!         t-point:
47      !!      glamt(i,j) = fslam(i    ,j    )   e1t(i,j) = fse1(i    ,j    )
48      !!      gphit(i,j) = fsphi(i    ,j    )   e2t(i,j) = fse2(i    ,j    )
49      !!         u-point:
50      !!      glamu(i,j) = fslam(i+1/2,j    )   e1u(i,j) = fse1(i+1/2,j    )
51      !!      gphiu(i,j) = fsphi(i+1/2,j    )   e2u(i,j) = fse2(i+1/2,j    )
52      !!         v-point:
53      !!      glamv(i,j) = fslam(i    ,j+1/2)   e1v(i,j) = fse1(i    ,j+1/2)
54      !!      gphiv(i,j) = fsphi(i    ,j+1/2)   e2v(i,j) = fse2(i    ,j+1/2)
55      !!            f-point:
56      !!      glamf(i,j) = fslam(i+1/2,j+1/2)   e1f(i,j) = fse1(i+1/2,j+1/2)
57      !!      gphif(i,j) = fsphi(i+1/2,j+1/2)   e2f(i,j) = fse2(i+1/2,j+1/2)
58      !!      Where fse1 and fse2 are defined by:
59      !!         fse1(i,j) = ra * rad * SQRT( (cos(phi) di(fslam))**2
60      !!                                     +          di(fsphi) **2 )(i,j)
61      !!         fse2(i,j) = ra * rad * SQRT( (cos(phi) dj(fslam))**2
62      !!                                     +          dj(fsphi) **2 )(i,j)
63      !!
64      !!        The coriolis factor is given at z-point by:
65      !!                     ff = 2.*omega*sin(gphif)      (in s-1)
66      !!
67      !!        This routine is given as an example, it must be modified
68      !!      following the user s desiderata. nevertheless, the output as
69      !!      well as the way to compute the model grid-point position and
70      !!      horizontal scale factors must be respected in order to insure
71      !!      second order accuracy schemes.
72      !!
73      !! N.B. If the domain is periodic, verify that scale factors are also
74      !!      periodic, and the coriolis term again.
75      !!
76      !! ** Action  : - define  glamt, glamu, glamv, glamf: longitude of t-,
77      !!                u-, v- and f-points (in degre)
78      !!              - define  gphit, gphiu, gphiv, gphit: latitude  of t-,
79      !!               u-, v-  and f-points (in degre)
80      !!        define e1t, e2t, e1u, e2u, e1v, e2v, e1f, e2f: horizontal
81      !!      scale factors (in meters) at t-, u-, v-, and f-points.
82      !!        define ff: coriolis factor at f-point
83      !!
84      !! References :
85      !!      Marti, Madec and Delecluse, 1992, j. geophys. res., in press.
86      !!
87      !! History :
88      !!        !  88-03  (G. Madec)
89      !!        !  91-11  (G. Madec)
90      !!        !  92-06  (M. Imbard)
91      !!        !  96-01  (G. Madec)  terrain following coordinates
92      !!        !  97-02  (G. Madec)  print mesh informations
93      !!        !  01-09  (M. Levy)  eel config: grid in km, beta-plane
94      !!   8.5  !  02-08  (G. Madec)  F90: Free form and module, namelist
95      !!   9.0  !  04-01  (A.M. Treguier, J.M. Molines) Case 4 (Mercator mesh)
96      !!                  use of parameters in par_CONFIG-Rxx.h90, not in namelist
97      !!        !  04-05  (A. Koch-Larrouy) Add Gyre configuration
98      !!----------------------------------------------------------------------
99      !! * local declarations
100      INTEGER  ::   ji, jj              ! dummy loop indices
101      INTEGER  ::   ii0, ii1, ij0, ij1  ! temporary integers
102      INTEGER  ::   ijeq                ! index of equator T point (used in case 4)
103      REAL(wp) ::   &
104         zti, zui, zvi, zfi,         &  ! temporary scalars
105         ztj, zuj, zvj, zfj,         &  !
106         zphi0, zbeta, znorme,       &  !
107         zarg, zf0
108      REAL(wp) ::   &
109         zlam1, zcos_alpha, zim1 , zjm1 , ze1, ze1deg,   &
110         zphi1, zsin_alpha, zim05, zjm05
111      !!----------------------------------------------------------------------
112
113      IF(lwp) THEN
114         WRITE(numout,*)
115         WRITE(numout,*) 'dom_hgr : define the horizontal mesh from ithe following par_oce parameters '
116         WRITE(numout,*) '~~~~~~~      type of horizontal mesh           jphgr_msh = ', jphgr_msh
117         WRITE(numout,*) '             position of the first row and     ppglam0  = ', ppglam0
118         WRITE(numout,*) '             column grid-point (degrees)       ppgphi0  = ', ppgphi0
119         WRITE(numout,*) '             zonal      grid-spacing (degrees) ppe1_deg = ', ppe1_deg
120         WRITE(numout,*) '             meridional grid-spacing (degrees) ppe2_deg = ', ppe2_deg
121         WRITE(numout,*) '             zonal      grid-spacing (meters)  ppe1_m   = ', ppe1_m 
122         WRITE(numout,*) '             meridional grid-spacing (meters)  ppe2_m   = ', ppe2_m 
123      ENDIF
124
125
126      SELECT CASE( jphgr_msh )   ! type of horizontal mesh
127
128      CASE ( 0 )                     !  curvilinear coordinate on the sphere read in coordinate.nc file
129
130         IF(lwp) WRITE(numout,*)
131         IF(lwp) WRITE(numout,*) '          curvilinear coordinate on the sphere read in "coordinate" file'
132#if defined key_fdir
133         CALL hgr_read_fdir      ! 'key_fdir'       :   direct access file
134#else
135         CALL hgr_read           ! Defaultl option  :   NetCDF file
136#endif
137
138         !                                                ! =====================
139         IF( cp_cfg == "orca" .AND. jp_cfg == 2 ) THEN    ! ORCA R2 configuration
140            !                                             ! =====================
141            IF( n_cla == 0 ) THEN
142               ii0 = 160   ;   ii1 = 161        ! Bab el Mandeb (e2u = 18 km)
143               ij0 =  88   ;   ij1 =  88   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  18.e3
144               IF(lwp) WRITE(numout,*)
145               IF(lwp) WRITE(numout,*) '             orca_r2: Bab el Mandeb: e2u reduced to 18 km'
146            ENDIF
147
148            ii0 = 145   ;   ii1 = 146        ! Sound Strait (e2u = 15 km)
149            ij0 = 116   ;   ij1 = 116   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  15.e3
150            IF(lwp) WRITE(numout,*)
151            IF(lwp) WRITE(numout,*) '             orca_r2: Reduced e2u at the Sound Strait'
152            !
153         ENDIF
154
155         !                                                ! ======================
156         IF( cp_cfg == "orca" .AND. jp_cfg == 05 ) THEN   ! ORCA R05 configuration
157            !                                             ! ======================
158            ii0 = 563   ;   ii1 = 564        ! Gibraltar Strait (e2u = 20 km)
159            ij0 = 327   ;   ij1 = 327   ;   e2u( mi0(ii0):mi1(ii1) , mj0(ij0):mj1(ij1) ) =  20.e3
160            IF(lwp) WRITE(numout,*)
161            IF(lwp) WRITE(numout,*) '             orca_r05: Reduced e2u at the Gibraltar Strait'
162            !
163         ENDIF
164
165
166         ! N.B. :  General case, lat and long function of both i and j indices:
167         !     e1t(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphit(ji,jj) ) * fsdila( zti, ztj ) )**2   &
168         !                                  + (                           fsdiph( zti, ztj ) )**2  )
169         !     e1u(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphiu(ji,jj) ) * fsdila( zui, zuj ) )**2   &
170         !                                  + (                           fsdiph( zui, zuj ) )**2  )
171         !     e1v(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphiv(ji,jj) ) * fsdila( zvi, zvj ) )**2   &
172         !                                  + (                           fsdiph( zvi, zvj ) )**2  )
173         !     e1f(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphif(ji,jj) ) * fsdila( zfi, zfj ) )**2   &
174         !                                  + (                           fsdiph( zfi, zfj ) )**2  )
175         !
176         !     e2t(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphit(ji,jj) ) * fsdjla( zti, ztj ) )**2   &
177         !                                  + (                           fsdjph( zti, ztj ) )**2  )
178         !     e2u(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphiu(ji,jj) ) * fsdjla( zui, zuj ) )**2   &
179         !                                  + (                           fsdjph( zui, zuj ) )**2  )
180         !     e2v(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphiv(ji,jj) ) * fsdjla( zvi, zvj ) )**2   &
181         !                                  + (                           fsdjph( zvi, zvj ) )**2  )
182         !     e2f(ji,jj) = ra * rad * SQRT(  ( cos( rad*gphif(ji,jj) ) * fsdjla( zfi, zfj ) )**2   &
183         !                                  + (                           fsdjph( zfi, zfj ) )**2  )
184
185
186      CASE ( 1 )                     ! geographical mesh on the sphere with regular grid-spacing
187
188         IF(lwp) WRITE(numout,*)
189         IF(lwp) WRITE(numout,*) '          geographical mesh on the sphere with regular grid-spacing'
190         IF(lwp) WRITE(numout,*) '          given by ppe1_deg and ppe2_deg' 
191
192         DO jj = 1, jpj
193            DO ji = 1, jpi
194               zti = FLOAT( ji - 1 + nimpp - 1 )         ;   ztj = FLOAT( jj - 1 + njmpp - 1 )
195               zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5   ;   zuj = FLOAT( jj - 1 + njmpp - 1 )
196               zvi = FLOAT( ji - 1 + nimpp - 1 )         ;   zvj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5
197               zfi = FLOAT( ji - 1 + nimpp - 1 ) + 0.5   ;   zfj = FLOAT( jj - 1 + njmpp - 1 ) + 0.5
198         ! Longitude
199               glamt(ji,jj) = ppglam0 + ppe1_deg * zti
200               glamu(ji,jj) = ppglam0 + ppe1_deg * zui
201               glamv(ji,jj) = ppglam0 + ppe1_deg * zvi
202               glamf(ji,jj) = ppglam0 + ppe1_deg * zfi
203         ! Latitude
204               gphit(ji,jj) = ppgphi0 + ppe2_deg * ztj
205               gphiu(ji,jj) = ppgphi0 + ppe2_deg * zuj
206               gphiv(ji,jj) = ppgphi0 + ppe2_deg * zvj
207               gphif(ji,jj) = ppgphi0 + ppe2_deg * zfj
208         ! e1
209               e1t(ji,jj) = ra * rad * COS( rad * gphit(ji,jj) ) * ppe1_deg
210               e1u(ji,jj) = ra * rad * COS( rad * gphiu(ji,jj) ) * ppe1_deg
211               e1v(ji,jj) = ra * rad * COS( rad * gphiv(ji,jj) ) * ppe1_deg
212               e1f(ji,jj) = ra * rad * COS( rad * gphif(ji,jj) ) * ppe1_deg
213         ! e2
214               e2t(ji,jj) = ra * rad * ppe2_deg
215               e2u(ji,jj) = ra * rad * ppe2_deg
216               e2v(ji,jj) = ra * rad * ppe2_deg
217               e2f(ji,jj) = ra * rad * ppe2_deg
218            END DO
219         END DO
220
221
222      CASE ( 2:3 )                   ! f- or beta-plane with regular grid-spacing
223
224         IF(lwp) WRITE(numout,*)
225         IF(lwp) WRITE(numout,*) '          f- or beta-plane with regular grid-spacing'
226         IF(lwp) WRITE(numout,*) '          given by ppe1_m and ppe2_m' 
227
228         ! Position coordinates (in kilometers)
229         !                          ==========
230         glam0 = 0.e0
231         gphi0 = - ppe2_m * 1.e-3
232         DO jj = 1, jpj
233            DO ji = 1, jpi
234               glamt(ji,jj) = glam0 + ppe1_m * 1.e-3 * ( FLOAT( ji - 1 + nimpp - 1 )       )
235               glamu(ji,jj) = glam0 + ppe1_m * 1.e-3 * ( FLOAT( ji - 1 + nimpp - 1 ) + 0.5 )
236               glamv(ji,jj) = glamt(ji,jj)
237               glamf(ji,jj) = glamu(ji,jj)
238   
239               gphit(ji,jj) = gphi0 + ppe2_m * 1.e-3 * ( FLOAT( jj - 1 + njmpp - 1 )       )
240               gphiu(ji,jj) = gphit(ji,jj)
241               gphiv(ji,jj) = gphi0 + ppe2_m * 1.e-3 * ( FLOAT( jj - 1 + njmpp - 1 ) + 0.5 )
242               gphif(ji,jj) = gphiv(ji,jj)
243            END DO
244         END DO
245
246         ! Horizontal scale factors (in meters)
247         !                              ======
248         e1t(:,:) = ppe1_m      ;      e2t(:,:) = ppe2_m
249         e1u(:,:) = ppe1_m      ;      e2u(:,:) = ppe2_m
250         e1v(:,:) = ppe1_m      ;      e2v(:,:) = ppe2_m
251         e1f(:,:) = ppe1_m      ;      e2f(:,:) = ppe2_m
252
253      CASE ( 4 )                     ! geographical mesh on the sphere, isotropic MERCATOR type
254
255         IF(lwp) WRITE(numout,*)
256         IF(lwp) WRITE(numout,*) '          geographical mesh on the sphere, MERCATOR type'
257         IF(lwp) WRITE(numout,*) '          longitudinal/latitudinal spacing given by ppe1_deg'
258         IF ( ppgphi0 == -90 ) THEN
259                IF(lwp) WRITE(numout,*) ' Mercator grid cannot start at south pole !!!! '
260                IF(lwp) WRITE(numout,*) ' We stop '
261                STOP
262         ENDIF
263
264         !  Find index corresponding to the equator, given the grid spacing e1_deg
265         !  and the (approximate) southern latitude ppgphi0.
266         !  This way we ensure that the equator is at a "T / U" point, when in the domain.
267         !  The formula should work even if the equator is outside the domain.
268         zarg = rpi / 4. - rpi / 180. * ppgphi0 / 2.
269         ijeq = ABS( 180./rpi * LOG( COS( zarg ) / SIN( zarg ) ) / ppe1_deg )
270
271         IF(lwp) WRITE(numout,*) '          Index of the equator on the MERCATOR grid:', ijeq
272
273         DO jj = 1, jpj
274            DO ji = 1, jpi
275               zti = FLOAT( ji - 1 + nimpp - 1 )         ;   ztj = FLOAT( jj - ijeq + njmpp - 1 )
276               zui = FLOAT( ji - 1 + nimpp - 1 ) + 0.5   ;   zuj = FLOAT( jj - ijeq + njmpp - 1 )
277               zvi = FLOAT( ji - 1 + nimpp - 1 )         ;   zvj = FLOAT( jj - ijeq + njmpp - 1 ) + 0.5
278               zfi = FLOAT( ji - 1 + nimpp - 1 ) + 0.5   ;   zfj = FLOAT( jj - ijeq + njmpp - 1 ) + 0.5
279         ! Longitude
280               glamt(ji,jj) = ppglam0 + ppe1_deg * zti
281               glamu(ji,jj) = ppglam0 + ppe1_deg * zui
282               glamv(ji,jj) = ppglam0 + ppe1_deg * zvi
283               glamf(ji,jj) = ppglam0 + ppe1_deg * zfi
284         ! Latitude
285               gphit(ji,jj) = 1./rad * ASIN ( TANH( ppe1_deg *rad* ztj ) )
286               gphiu(ji,jj) = 1./rad * ASIN ( TANH( ppe1_deg *rad* zuj ) )
287               gphiv(ji,jj) = 1./rad * ASIN ( TANH( ppe1_deg *rad* zvj ) )
288               gphif(ji,jj) = 1./rad * ASIN ( TANH( ppe1_deg *rad* zfj ) )
289         ! e1
290               e1t(ji,jj) = ra * rad * COS( rad * gphit(ji,jj) ) * ppe1_deg
291               e1u(ji,jj) = ra * rad * COS( rad * gphiu(ji,jj) ) * ppe1_deg
292               e1v(ji,jj) = ra * rad * COS( rad * gphiv(ji,jj) ) * ppe1_deg
293               e1f(ji,jj) = ra * rad * COS( rad * gphif(ji,jj) ) * ppe1_deg
294         ! e2
295               e2t(ji,jj) = ra * rad * COS( rad * gphit(ji,jj) ) * ppe1_deg
296               e2u(ji,jj) = ra * rad * COS( rad * gphiu(ji,jj) ) * ppe1_deg
297               e2v(ji,jj) = ra * rad * COS( rad * gphiv(ji,jj) ) * ppe1_deg
298               e2f(ji,jj) = ra * rad * COS( rad * gphif(ji,jj) ) * ppe1_deg
299            END DO
300         END DO
301
302      CASE ( 5 )                   ! beta-plane with regular grid-spacing and rotated domain (GYRE configuration)
303
304         IF(lwp) WRITE(numout,*)
305         IF(lwp) WRITE(numout,*) '          beta-plane with regular grid-spacing and rotated domain (GYRE configuration)'
306         IF(lwp) WRITE(numout,*) '          given by ppe1_m and ppe2_m'
307
308         ! Position coordinates (in kilometers)
309         !                          ==========
310
311         ! angle 45° and ze1=106.e+3 / jp_cfg forced -> zlam1 = -85°, zphi1 = 29°N
312         zlam1 = -85
313         zphi1 = 29
314         ze1 = 106000. / FLOAT(jp_cfg)            ! resolution in meters
315         IF( nbench /= 0 )   ze1 = 106000.e0     ! benchmark: forced the resolution to be about 100 km
316         zsin_alpha = - SQRT( 2. ) / 2.
317         zcos_alpha =   SQRT( 2. ) / 2.
318         ze1deg = ze1 / (ra * rad)
319         IF( nbench /= 0 )   ze1deg = ze1deg / FLOAT(jp_cfg)        ! benchmark: keep the lat/+lon
320         !                                                           ! at the right jp_cfg resolution
321         glam0 = zlam1 + zcos_alpha * ze1deg * FLOAT( jpjglo-2 )
322         gphi0 = zphi1 + zsin_alpha * ze1deg * FLOAT( jpjglo-2 )
323
324         IF(lwp) WRITE(numout,*) 'ze1', ze1, 'cosalpha', zcos_alpha, 'sinalpha', zsin_alpha
325         IF(lwp) WRITE(numout,*) 'ze1deg', ze1deg, 'glam0', glam0, 'gphi0', gphi0
326
327         DO jj = 1, jpj
328           DO ji = 1, jpi
329             zim1 = FLOAT( ji + nimpp - 1 ) - 1.   ;   zim05 = FLOAT( ji + nimpp - 1 ) - 1.5
330             zjm1 = FLOAT( jj + njmpp - 1 ) - 1.   ;   zjm05 = FLOAT( jj + njmpp - 1 ) - 1.5
331
332             glamf(ji,jj) = glam0 + zim1  * ze1deg * zcos_alpha + zjm1  * ze1deg * zsin_alpha
333             gphif(ji,jj) = gphi0 - zim1  * ze1deg * zsin_alpha + zjm1  * ze1deg * zcos_alpha
334
335             glamt(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha
336             gphit(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha
337
338             glamu(ji,jj) = glam0 + zim1  * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha
339             gphiu(ji,jj) = gphi0 - zim1  * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha
340
341             glamv(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm1  * ze1deg * zsin_alpha
342             gphiv(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm1  * ze1deg * zcos_alpha
343           END DO
344          END DO
345
346         ! Horizontal scale factors (in meters)
347         !                              ======
348         e1t(:,:) =  ze1     ;      e2t(:,:) = ze1
349         e1u(:,:) =  ze1     ;      e2u(:,:) = ze1
350         e1v(:,:) =  ze1     ;      e2v(:,:) = ze1
351         e1f(:,:) =  ze1     ;      e2f(:,:) = ze1
352
353      CASE DEFAULT
354         IF(lwp) WRITE(numout,cform_err)
355         IF(lwp) WRITE(numout,*) '          bad flag value for jphgr_msh = ', jphgr_msh
356         nstop = nstop + 1
357
358      END SELECT
359
360
361      ! Control printing : Grid informations (if not restart)
362      ! ----------------
363
364      IF(lwp .AND. .NOT.ln_rstart ) THEN
365         WRITE(numout,*)
366         WRITE(numout,*) '          longitude and e1 scale factors'
367         WRITE(numout,*) '          ------------------------------'
368         WRITE(numout,9300) ( ji, glamt(ji,1), glamu(ji,1),   &
369            glamv(ji,1), glamf(ji,1),   &
370            e1t(ji,1), e1u(ji,1),   &
371            e1v(ji,1), e1f(ji,1), ji = 1, jpi,10)
3729300     FORMAT( 1x, i4, f8.2,1x, f8.2,1x, f8.2,1x, f8.2, 1x,    &
373            f19.10, 1x, f19.10, 1x, f19.10, 1x, f19.10 )
374         
375         WRITE(numout,*)
376         WRITE(numout,*) '          latitude and e2 scale factors'
377         WRITE(numout,*) '          -----------------------------'
378         WRITE(numout,9300) ( jj, gphit(1,jj), gphiu(1,jj),   &
379            &                     gphiv(1,jj), gphif(1,jj),   &
380            &                     e2t  (1,jj), e2u  (1,jj),   &
381            &                     e2v  (1,jj), e2f  (1,jj), jj = 1, jpj, 10 )
382      ENDIF
383
384     
385      IF( nprint == 1 .AND. lwp ) THEN
386         WRITE(numout,*) '          e1u e2u '
387         CALL prihre( e1u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
388         CALL prihre( e2u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
389         WRITE(numout,*) '          e1v e2v  '
390         CALL prihre( e1v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
391         CALL prihre( e2v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
392         WRITE(numout,*) '          e1f e2f  '
393         CALL prihre( e1f,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
394         CALL prihre( e2f,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
395      ENDIF
396
397
398      ! ================= !
399      !  Coriolis factor  !
400      ! ================= !
401
402      SELECT CASE( jphgr_msh )   ! type of horizontal mesh
403
404      CASE ( 0, 1, 4 )               ! mesh on the sphere
405
406         ff(:,:) = 2. * omega * SIN( rad * gphif(:,:) ) 
407
408      CASE ( 2 )                     ! f-plane at ppgphi0
409
410         ff(:,:) = 2. * omega * SIN( rad * ppgphi0 )
411
412         IF(lwp) WRITE(numout,*) '          f-plane: Coriolis parameter = constant = ', ff(1,1)
413
414      CASE ( 3 )                     ! beta-plane
415
416         zbeta   = 2. * omega * COS( rad * ppgphi0 ) / ra                     ! beta at latitude ppgphi0
417         zphi0   = ppgphi0 - FLOAT( jpjglo/2) * ppe2_m *1.e-3  / ( ra * rad ) ! latitude of the first row F-points
418         zf0     = 2. * omega * SIN( rad * zphi0 )                            ! compute f0 1st point south
419
420         ff(:,:) = ( zf0  + zbeta * gphif(:,:) * 1.e+3 )                      ! f = f0 +beta* y ( y=0 at south)
421
422         IF(lwp) WRITE(numout,*) '          Beta-plane: Beta parameter = constant = ', ff(1,1)
423         IF(lwp) WRITE(numout,*) '                      Coriolis parameter varies from ', ff(1,1),' to ', ff(1,jpj)
424
425      CASE ( 5 )                     ! beta-plane and rotated domain
426
427         zbeta = 2. * omega * COS( rad * ppgphi0 ) / ra                     ! beta at latitude ppgphi0
428         zphi0 = 15.e0                                                      ! latitude of the first row F-points
429         zf0   = 2. * omega * SIN( rad * zphi0 )                            ! compute f0 1st point south
430
431         ff(:,:) = ( zf0 + zbeta * ABS( gphif(:,:) - zphi0 ) * rad * ra )   ! f = f0 +beta* y ( y=0 at south)
432
433         IF(lwp) WRITE(numout,*) '          Beta-plane: Beta parameter = constant = ', ff(1,1)
434         IF(lwp) WRITE(numout,*) '                      Coriolis parameter varies from ', ff(1,1),' to ', ff(1,jpj)
435
436      END SELECT
437
438
439      ! Control of domain for symetrical condition
440      ! ------------------------------------------
441      ! The equator line must be the latitude coordinate axe
442
443      IF( nperio == 2 ) THEN
444         znorme = SQRT( SUM( gphiu(:,2) * gphiu(:,2) ) ) / FLOAT( jpi )
445         IF( znorme > 1.e-13 ) THEN
446            IF(lwp) WRITE(numout,cform_err)
447            IF(lwp) WRITE(numout,*) ' ===>>>> : symmetrical condition: rerun with good equator line'
448            nstop = nstop + 1
449         ENDIF
450      ENDIF
451
452   END SUBROUTINE dom_hgr
453
454
455   SUBROUTINE hgr_read
456      !!---------------------------------------------------------------------
457      !!              ***  ROUTINE hgr_read  ***
458      !!
459      !! ** Purpose :   Read a coordinate file in NetCDF format
460      !!
461      !! ** Method  :   The mesh file has been defined trough a analytical
462      !!      or semi-analytical method. It is read in a NetCDF file.
463      !!     
464      !! References :
465      !!      Marti, Madec and Delecluse, 1992, JGR, 97, 12,763-12,766.
466      !!      Madec, Imbard, 1996, Clim. Dyn., 12, 381-388.
467      !!
468      !! History :
469      !!        !         (O. Marti)  Original code
470      !!        !  91-03  (G. Madec)
471      !!        !  92-07  (M. Imbard)
472      !!        !  99-11  (M. Imbard) NetCDF format with IOIPSL
473      !!        !  00-08  (D. Ludicone) Reduced section at Bab el Mandeb
474      !!   8.5  !  02-06  (G. Madec)  F90: Free form
475      !!----------------------------------------------------------------------
476      !! * Modules used
477      USE ioipsl
478
479      !! * Local declarations
480      LOGICAL ::   llog = .FALSE.
481      CHARACTER(len=21) ::   clname = 'coordinates'
482      INTEGER  ::   ji, jj              ! dummy loop indices
483      INTEGER  ::   inum                ! temporary logical unit
484      INTEGER  ::   ilev, itime         ! temporary integers
485      REAL(wp) ::   zdt, zdate0         ! temporary scalars
486      REAL(wp) ::   zdept(1)            ! temporary workspace
487      REAL(wp), DIMENSION(jpidta,jpjdta) ::   &
488         zlamt, zphit, zdta             ! temporary workspace (NetCDF read)
489      !!----------------------------------------------------------------------
490
491
492      ! 1. Read of the grid coordinates and scale factors
493      ! -------------------------------------------------
494
495      IF(lwp) THEN
496         WRITE(numout,*)
497         WRITE(numout,*) 'hgr_read : read the horizontal coordinates'
498         WRITE(numout,*) '~~~~~~~~~~~      jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpk = ', jpk
499      ENDIF
500
501      ! read the file
502      itime = 0
503      ilev = 1   
504      zlamt(:,:) = 0.e0
505      zphit(:,:) = 0.e0
506      CALL restini( clname, jpidta, jpjdta, zlamt , zphit,   &
507         &                  ilev  , zdept , clname,          &
508         &                  itime , zdate0, zdt   , inum )
509
510      CALL restget( inum, 'glamt', jpidta, jpjdta, 1, 0, llog, zdta )
511      DO jj = 1, nlcj
512         DO ji = 1, nlci
513            glamt(ji,jj) = zdta(mig(ji),mjg(jj))
514         END DO
515      END DO
516      CALL restget( inum, 'glamu', jpidta, jpjdta, 1, 0, llog, zdta )
517      DO jj = 1, nlcj
518         DO ji = 1, nlci
519            glamu(ji,jj) = zdta(mig(ji),mjg(jj))                   
520         END DO
521      END DO
522      CALL restget( inum, 'glamv', jpidta, jpjdta, 1, 0, llog, zdta )
523      DO jj = 1, nlcj
524         DO ji = 1, nlci
525            glamv(ji,jj) = zdta(mig(ji),mjg(jj))                   
526         END DO
527      END DO
528      CALL restget( inum, 'glamf', jpidta, jpjdta, 1, 0, llog, zdta )
529      DO jj = 1, nlcj
530         DO ji = 1, nlci
531            glamf(ji,jj) = zdta(mig(ji),mjg(jj))                   
532         END DO
533      END DO
534      CALL restget( inum, 'gphit', jpidta, jpjdta, 1, 0, llog, zdta )
535      DO jj = 1, nlcj
536         DO ji = 1, nlci
537            gphit(ji,jj) = zdta(mig(ji),mjg(jj))                   
538         END DO
539      END DO
540      CALL restget( inum, 'gphiu', jpidta, jpjdta, 1, 0, llog, zdta )
541      DO jj = 1, nlcj
542         DO ji = 1, nlci
543            gphiu(ji,jj) = zdta(mig(ji),mjg(jj))                   
544         END DO
545      END DO
546      CALL restget( inum, 'gphiv', jpidta, jpjdta, 1, 0, llog, zdta )
547      DO jj = 1, nlcj
548         DO ji = 1, nlci
549            gphiv(ji,jj) = zdta(mig(ji),mjg(jj))                   
550         END DO
551      END DO
552      CALL restget( inum, 'gphif', jpidta, jpjdta, 1, 0, llog, zdta )
553      DO jj = 1, nlcj
554         DO ji = 1, nlci
555            gphif(ji,jj) = zdta(mig(ji),mjg(jj))                   
556         END DO
557      END DO
558      CALL restget( inum, 'e1t', jpidta, jpjdta, 1, 0, llog, zdta )
559      DO jj = 1, nlcj
560         DO ji = 1, nlci
561            e1t  (ji,jj) = zdta(mig(ji),mjg(jj))                   
562         END DO
563      END DO
564      CALL restget( inum, 'e1u', jpidta, jpjdta, 1, 0, llog, zdta )
565      DO jj = 1, nlcj
566         DO ji = 1, nlci
567            e1u  (ji,jj) = zdta(mig(ji),mjg(jj))                   
568         END DO
569      END DO
570      CALL restget( inum, 'e1v', jpidta, jpjdta, 1, 0, llog, zdta )
571      DO jj = 1, nlcj
572         DO ji = 1, nlci
573            e1v  (ji,jj) = zdta(mig(ji),mjg(jj))                   
574         END DO
575      END DO
576      CALL restget( inum, 'e1f', jpidta, jpjdta, 1, 0, llog, zdta )
577      DO jj = 1, nlcj
578         DO ji = 1, nlci
579            e1f  (ji,jj) = zdta(mig(ji),mjg(jj))                   
580         END DO
581      END DO
582      CALL restget( inum, 'e2t', jpidta, jpjdta, 1, 0, llog, zdta )
583      DO jj = 1, nlcj
584         DO ji = 1, nlci
585            e2t  (ji,jj) = zdta(mig(ji),mjg(jj))                   
586         END DO
587      END DO
588      CALL restget( inum, 'e2u', jpidta, jpjdta, 1, 0, llog, zdta )
589      DO jj = 1, nlcj
590         DO ji = 1, nlci
591            e2u  (ji,jj) = zdta(mig(ji),mjg(jj))                   
592         END DO
593      END DO
594      CALL restget( inum, 'e2v', jpidta, jpjdta, 1, 0, llog, zdta )
595      DO jj = 1, nlcj
596         DO ji = 1, nlci
597            e2v  (ji,jj) = zdta(mig(ji),mjg(jj))                   
598         END DO
599      END DO
600      CALL restget( inum, 'e2f', jpidta, jpjdta, 1, 0, llog, zdta )
601      DO jj = 1, nlcj
602         DO ji = 1, nlci
603            e2f  (ji,jj) = zdta(mig(ji),mjg(jj))                   
604         END DO
605      END DO
606
607      CALL restclo( inum )
608
609      ! set extra rows add in mpp to none zero values
610      DO jj = nlcj+1, jpj
611         DO ji = 1, nlci
612            glamt(ji,jj) = glamt(ji,1)   ;   gphit(ji,jj) = gphit(ji,1)
613            glamu(ji,jj) = glamu(ji,1)   ;   gphiu(ji,jj) = gphiu(ji,1)
614            glamv(ji,jj) = glamv(ji,1)   ;   gphiv(ji,jj) = gphiv(ji,1)
615            glamf(ji,jj) = glamf(ji,1)   ;   gphif(ji,jj) = gphif(ji,1)
616            e1t  (ji,jj) = e1t  (ji,1)   ;   e2t  (ji,jj) = e2t  (ji,1)
617            e1u  (ji,jj) = e1u  (ji,1)   ;   e2u  (ji,jj) = e2u  (ji,1)
618            e1v  (ji,jj) = e1v  (ji,1)   ;   e2v  (ji,jj) = e2v  (ji,1)
619            e1f  (ji,jj) = e1f  (ji,1)   ;   e2f  (ji,jj) = e2f  (ji,1)
620         END DO
621      END DO
622
623      ! set extra columns add in mpp to none zero values
624      DO ji = nlci+1, jpi
625         glamt(ji,:) = glamt(1,:)   ;   gphit(ji,:) = gphit(1,:)
626         glamu(ji,:) = glamu(1,:)   ;   gphiu(ji,:) = gphiu(1,:)
627         glamv(ji,:) = glamv(1,:)   ;   gphiv(ji,:) = gphiv(1,:)
628         glamf(ji,:) = glamf(1,:)   ;   gphif(ji,:) = gphif(1,:)
629         e1t  (ji,:) = e1t  (1,:)   ;   e2t  (ji,:) = e2t  (1,:)
630         e1u  (ji,:) = e1u  (1,:)   ;   e2u  (ji,:) = e2u  (1,:)
631         e1v  (ji,:) = e1v  (1,:)   ;   e2v  (ji,:) = e2v  (1,:)
632         e1f  (ji,:) = e1f  (1,:)   ;   e2f  (ji,:) = e2f  (1,:)
633      END DO
634
635   END SUBROUTINE hgr_read
636
637
638   SUBROUTINE hgr_read_fdir
639      !!----------------------------------------------------------------------
640      !!                 ***  ROUTINE hgr_read_fdir  ***
641      !!
642      !!----------------------------------------------------------------------
643      !! * Local declarations
644      CHARACTER (len=5) ::   clfield
645      CHARACTER(len=21) ::   clname = 'coordinates'
646      INTEGER ::   ji, jj         ! dummy loop indices
647      INTEGER ::   inumcoo = 11   ! logical unit for coordinate file
648      INTEGER ::   ijpi, ijpj     ! temporary integers
649      REAL(wp), DIMENSION(jpi,jpj) ::   zdta   ! temporary workspace
650      !!----------------------------------------------------------------------
651
652
653      ! 1. Read of the grid coordinates and scale factors
654      ! -------------------------------------------------
655
656      IF(lwp) THEN
657         WRITE(numout,*)
658         WRITE(numout,*) 'hgrcoo : read the horizontal coordinates'
659         WRITE(numout,*) '~~~~~~'
660         WRITE(numout,*) '         jpiglo jpjglo jpk : ', jpiglo, jpjglo, jpk
661      ENDIF
662
663      ! open the file
664          CALL ctlopn( inumcoo, clname, 'OLD', 'UNFORMATTED', 'SEQUENTIAL',   &
665                       1      , numout       , lwp  , 1                            )
666
667      ! read the file
668      READ(inumcoo) ijpi,ijpj
669      IF( (ijpi /= jpidta) .OR. (ijpj /= jpjdta) ) THEN
670         IF(lwp) THEN
671            WRITE(numout,*)
672            WRITE(numout,*) '         inconsitency in reading coordinate file, unit=',inumcoo
673            WRITE(numout,*) '            jpidta = ',jpidta  ,' jpi  read = ',ijpi
674            WRITE(numout,*) '            jpjdta = ',jpjdta  ,' jpj  read = ',ijpj
675            WRITE(numout,*)
676         ENDIF
677         nstop = nstop + 1
678      ENDIF
679
680      READ(inumcoo) clfield, zdta
681      IF( clfield /= 'GLAMT' ) THEN
682         IF(lwp) THEN
683            WRITE(numout,cform_err)
684            WRITE(numout,*) 'hgrcoo: bad read',clfield,' GLAMT'
685         ENDIF
686         nstop = nstop + 1
687      ENDIF
688      DO jj = 1, nlcj
689         DO ji = 1, nlci
690            glamt(ji,jj) = zdta(mig(ji),mjg(jj))
691         END DO
692      END DO
693      READ(inumcoo) clfield, zdta
694      IF(clfield /= 'GLAMU') THEN
695         IF(lwp) THEN
696            WRITE(numout,cform_err)
697            WRITE(numout,*) 'hgrcoo: bad read',clfield,' GLAMU'
698         ENDIF
699         nstop = nstop + 1
700      ENDIF
701      DO jj = 1, nlcj
702         DO ji = 1, nlci
703            glamu(ji,jj) = zdta(mig(ji),mjg(jj))                   
704         END DO
705      END DO
706      READ(inumcoo) clfield, zdta
707      IF(clfield /= 'GLAMV') THEN
708         IF(lwp) THEN
709            WRITE(numout,cform_err)
710            WRITE(numout,*) 'hgrcoo: bad read',clfield,' GLAMV'
711         ENDIF
712         nstop = nstop + 1
713      ENDIF
714      DO jj = 1, nlcj
715         DO ji = 1, nlci
716            glamv(ji,jj) = zdta(mig(ji),mjg(jj))                   
717         END DO
718      END DO
719      READ(inumcoo) clfield, zdta
720      IF(clfield /= 'GLAMF') THEN
721         IF(lwp) THEN
722            WRITE(numout,cform_err)
723            WRITE(numout,*) 'hgrcoo: bad read',clfield,' GLAMF'
724         ENDIF
725         nstop = nstop + 1
726      ENDIF
727      DO jj = 1, nlcj
728         DO ji = 1, nlci
729            glamf(ji,jj) = zdta(mig(ji),mjg(jj))                   
730         END DO
731      END DO
732      READ(inumcoo) clfield, zdta
733      IF(clfield /= 'GPHIT') THEN
734         IF(lwp) THEN
735            WRITE(numout,cform_err)
736            WRITE(numout,*) 'hgrcoo: bad read',clfield,' GPHIT'
737         ENDIF
738         nstop = nstop + 1
739      ENDIF
740      DO jj = 1, nlcj
741         DO ji = 1, nlci
742            gphit(ji,jj) = zdta(mig(ji),mjg(jj))                   
743         END DO
744      END DO
745      READ(inumcoo) clfield, zdta
746      IF(clfield /= 'GPHIU') THEN
747         IF(lwp) THEN
748            WRITE(numout,cform_err)
749            WRITE(numout,*) 'hgrcoo: bad read',clfield,' GPHIU'
750         ENDIF
751         nstop = nstop + 1
752      ENDIF
753      DO jj = 1, nlcj
754         DO ji = 1, nlci
755            gphiu(ji,jj) = zdta(mig(ji),mjg(jj))                   
756         END DO
757      END DO
758      READ(inumcoo) clfield, zdta
759      IF(clfield /= 'GPHIV') THEN
760         IF(lwp) THEN
761            WRITE(numout,cform_err)
762            WRITE(numout,*) 'hgrcoo: bad read',clfield,' GPHIV'
763         ENDIF
764         nstop = nstop + 1
765      ENDIF
766      DO jj = 1, nlcj
767         DO ji = 1, nlci
768            gphiv(ji,jj) = zdta(mig(ji),mjg(jj))                   
769         END DO
770      END DO
771      READ(inumcoo) clfield, zdta
772      IF(clfield /= 'GPHIF') THEN
773         IF(lwp) THEN
774            WRITE(numout,cform_err)
775            WRITE(numout,*) 'hgrcoo: bad read',clfield,' GPHIF'
776         ENDIF
777         nstop = nstop + 1
778      ENDIF
779      DO jj = 1, nlcj
780         DO ji = 1, nlci
781            gphif(ji,jj) = zdta(mig(ji),mjg(jj))                   
782         END DO
783      END DO
784      READ(inumcoo) clfield, zdta
785      IF(clfield /= 'E1T  ') THEN
786         IF(lwp) THEN
787            WRITE(numout,cform_err)
788            WRITE(numout,*) 'hgrcoo: bad read',clfield,' E1T  '
789         ENDIF
790         nstop = nstop + 1
791      ENDIF
792      DO jj = 1, nlcj
793         DO ji = 1, nlci
794            e1t  (ji,jj) = zdta(mig(ji),mjg(jj))                   
795         END DO
796      END DO
797      READ(inumcoo) clfield, zdta
798      IF(clfield /= 'E1U  ') THEN
799         IF(lwp) THEN
800            WRITE(numout,cform_err)
801            WRITE(numout,*) 'hgrcoo: bad read',clfield,' E1U  '
802         ENDIF
803         nstop = nstop + 1
804      ENDIF
805      DO jj = 1, nlcj
806         DO ji = 1, nlci
807            e1u  (ji,jj) = zdta(mig(ji),mjg(jj))                   
808         END DO
809      END DO
810      READ(inumcoo) clfield, zdta
811      IF(clfield /= 'E1V  ') THEN
812         IF(lwp) THEN
813            WRITE(numout,cform_err)
814            WRITE(numout,*) 'hgrcoo: bad read',clfield,' E1V  '
815         ENDIF
816         nstop = nstop + 1
817      ENDIF
818      DO jj = 1, nlcj
819         DO ji = 1, nlci
820            e1v  (ji,jj) = zdta(mig(ji),mjg(jj))                   
821         END DO
822      END DO
823      READ(inumcoo) clfield, zdta
824      IF(clfield /= 'E1F  ') THEN
825         IF(lwp) THEN
826            WRITE(numout,cform_err)
827            WRITE(numout,*) 'hgrcoo: bad read',clfield,' E1F  '
828         ENDIF
829         nstop = nstop + 1
830      ENDIF
831      DO jj = 1, nlcj
832         DO ji = 1, nlci
833            e1f  (ji,jj) = zdta(mig(ji),mjg(jj))                   
834         END DO
835      END DO
836      READ(inumcoo) clfield, zdta
837      IF(clfield /= 'E2T  ') THEN
838         IF(lwp) THEN
839            WRITE(numout,cform_err)
840            WRITE(numout,*) 'hgrcoo: bad read',clfield,' E2T  '
841         ENDIF
842         nstop = nstop + 1
843      ENDIF
844      DO jj = 1, nlcj
845         DO ji = 1, nlci
846            e2t  (ji,jj) = zdta(mig(ji),mjg(jj))                   
847         END DO
848      END DO
849      READ(inumcoo) clfield, zdta
850      IF(clfield /= 'E2U  ') THEN
851         IF(lwp) THEN
852            WRITE(numout,cform_err)
853            WRITE(numout,*) 'hgrcoo: bad read',clfield,' E2U  '
854         ENDIF
855         nstop = nstop + 1
856      ENDIF
857      DO jj = 1, nlcj
858         DO ji = 1, nlci
859            e2u  (ji,jj) = zdta(mig(ji),mjg(jj))                   
860         END DO
861      END DO
862      READ(inumcoo) clfield, zdta
863      IF(clfield /= 'E2V  ') THEN
864         IF(lwp) THEN
865            WRITE(numout,cform_err)
866            WRITE(numout,*) 'hgrcoo: bad read',clfield,' E2V  '
867         ENDIF
868         nstop = nstop + 1
869      ENDIF
870      DO jj = 1, nlcj
871         DO ji = 1, nlci
872            e2v  (ji,jj) = zdta(mig(ji),mjg(jj))                   
873         END DO
874      END DO
875      READ(inumcoo) clfield, zdta
876      IF(clfield /= 'E2F  ') THEN
877         IF(lwp) THEN
878            WRITE(numout,cform_err)
879            WRITE(numout,*) 'hgrcoo: bad read',clfield,' E2F  '
880         ENDIF
881         nstop = nstop + 1
882      ENDIF
883      DO jj = 1, nlcj
884         DO ji = 1, nlci
885            e2f  (ji,jj) = zdta(mig(ji),mjg(jj))                   
886         END DO
887      END DO
888
889      CLOSE( inumcoo )
890
891      ! set extra rows add in mpp to none zero values
892      DO jj = nlcj+1, jpj
893         DO ji = 1, nlci
894            glamt(ji,jj) = glamt(ji,1)   ;   gphit(ji,jj) = gphit(ji,1)
895            glamu(ji,jj) = glamu(ji,1)   ;   gphiu(ji,jj) = gphiu(ji,1)
896            glamv(ji,jj) = glamv(ji,1)   ;   gphiv(ji,jj) = gphiv(ji,1)
897            glamf(ji,jj) = glamf(ji,1)   ;   gphif(ji,jj) = gphif(ji,1)
898            e1t  (ji,jj) = e1t  (ji,1)   ;   e2t  (ji,jj) = e2t  (ji,1)
899            e1u  (ji,jj) = e1u  (ji,1)   ;   e2u  (ji,jj) = e2u  (ji,1)
900            e1v  (ji,jj) = e1v  (ji,1)   ;   e2v  (ji,jj) = e2v  (ji,1)
901            e1f  (ji,jj) = e1f  (ji,1)   ;   e2f  (ji,jj) = e2f  (ji,1)
902         END DO
903      END DO
904
905      ! set extra columns add in mpp to none zero values
906      DO ji = nlci+1, jpi
907         glamt(ji,:) = glamt(1,:)   ;   gphit(ji,:) = gphit(1,:)
908         glamu(ji,:) = glamu(1,:)   ;   gphiu(ji,:) = gphiu(1,:)
909         glamv(ji,:) = glamv(1,:)   ;   gphiv(ji,:) = gphiv(1,:)
910         glamf(ji,:) = glamf(1,:)   ;   gphif(ji,:) = gphif(1,:)
911         e1t  (ji,:) = e1t  (1,:)   ;   e2t  (ji,:) = e2t  (1,:)
912         e1u  (ji,:) = e1u  (1,:)   ;   e2u  (ji,:) = e2u  (1,:)
913         e1v  (ji,:) = e1v  (1,:)   ;   e2v  (ji,:) = e2v  (1,:)
914         e1f  (ji,:) = e1f  (1,:)   ;   e2f  (ji,:) = e2f  (1,:)
915      END DO
916
917   END SUBROUTINE hgr_read_fdir
918
919   !!======================================================================
920END MODULE domhgr
Note: See TracBrowser for help on using the repository browser.