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 @ 187

Last change on this file since 187 was 187, checked in by opalod, 19 years ago

CL + CE : UPDATE129 : for use of tracer component
  • 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 45deg and ze1=106.e+3 / jp_cfg forced -> zlam1 = -85deg, zphi1 = 29degN
312         zlam1 = -85
313         zphi1 = 29
314         ! resolution in meters
315         ze1 = 106000. / FLOAT(jp_cfg)           
316         ! benchmark: forced the resolution to be about 100 km
317         IF( nbench /= 0 )   ze1 = 106000.e0     
318         zsin_alpha = - SQRT( 2. ) / 2.
319         zcos_alpha =   SQRT( 2. ) / 2.
320         ze1deg = ze1 / (ra * rad)
321         IF( nbench /= 0 )   ze1deg = ze1deg / FLOAT(jp_cfg)        ! benchmark: keep the lat/+lon
322         !                                                          ! at the right jp_cfg resolution
323         glam0 = zlam1 + zcos_alpha * ze1deg * FLOAT( jpjglo-2 )
324         gphi0 = zphi1 + zsin_alpha * ze1deg * FLOAT( jpjglo-2 )
325
326         IF(lwp) WRITE(numout,*) 'ze1', ze1, 'cosalpha', zcos_alpha, 'sinalpha', zsin_alpha
327         IF(lwp) WRITE(numout,*) 'ze1deg', ze1deg, 'glam0', glam0, 'gphi0', gphi0
328
329         DO jj = 1, jpj
330           DO ji = 1, jpi
331             zim1 = FLOAT( ji + nimpp - 1 ) - 1.   ;   zim05 = FLOAT( ji + nimpp - 1 ) - 1.5
332             zjm1 = FLOAT( jj + njmpp - 1 ) - 1.   ;   zjm05 = FLOAT( jj + njmpp - 1 ) - 1.5
333
334             glamf(ji,jj) = glam0 + zim1  * ze1deg * zcos_alpha + zjm1  * ze1deg * zsin_alpha
335             gphif(ji,jj) = gphi0 - zim1  * ze1deg * zsin_alpha + zjm1  * ze1deg * zcos_alpha
336
337             glamt(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha
338             gphit(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha
339
340             glamu(ji,jj) = glam0 + zim1  * ze1deg * zcos_alpha + zjm05 * ze1deg * zsin_alpha
341             gphiu(ji,jj) = gphi0 - zim1  * ze1deg * zsin_alpha + zjm05 * ze1deg * zcos_alpha
342
343             glamv(ji,jj) = glam0 + zim05 * ze1deg * zcos_alpha + zjm1  * ze1deg * zsin_alpha
344             gphiv(ji,jj) = gphi0 - zim05 * ze1deg * zsin_alpha + zjm1  * ze1deg * zcos_alpha
345           END DO
346          END DO
347
348         ! Horizontal scale factors (in meters)
349         !                              ======
350         e1t(:,:) =  ze1     ;      e2t(:,:) = ze1
351         e1u(:,:) =  ze1     ;      e2u(:,:) = ze1
352         e1v(:,:) =  ze1     ;      e2v(:,:) = ze1
353         e1f(:,:) =  ze1     ;      e2f(:,:) = ze1
354
355      CASE DEFAULT
356         IF(lwp) WRITE(numout,cform_err)
357         IF(lwp) WRITE(numout,*) '          bad flag value for jphgr_msh = ', jphgr_msh
358         nstop = nstop + 1
359
360      END SELECT
361
362
363      ! Control printing : Grid informations (if not restart)
364      ! ----------------
365
366      IF(lwp .AND. .NOT.ln_rstart ) THEN
367         WRITE(numout,*)
368         WRITE(numout,*) '          longitude and e1 scale factors'
369         WRITE(numout,*) '          ------------------------------'
370         WRITE(numout,9300) ( ji, glamt(ji,1), glamu(ji,1),   &
371            glamv(ji,1), glamf(ji,1),   &
372            e1t(ji,1), e1u(ji,1),   &
373            e1v(ji,1), e1f(ji,1), ji = 1, jpi,10)
3749300     FORMAT( 1x, i4, f8.2,1x, f8.2,1x, f8.2,1x, f8.2, 1x,    &
375            f19.10, 1x, f19.10, 1x, f19.10, 1x, f19.10 )
376         
377         WRITE(numout,*)
378         WRITE(numout,*) '          latitude and e2 scale factors'
379         WRITE(numout,*) '          -----------------------------'
380         WRITE(numout,9300) ( jj, gphit(1,jj), gphiu(1,jj),   &
381            &                     gphiv(1,jj), gphif(1,jj),   &
382            &                     e2t  (1,jj), e2u  (1,jj),   &
383            &                     e2v  (1,jj), e2f  (1,jj), jj = 1, jpj, 10 )
384      ENDIF
385
386     
387      IF( nprint == 1 .AND. lwp ) THEN
388         WRITE(numout,*) '          e1u e2u '
389         CALL prihre( e1u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
390         CALL prihre( e2u,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
391         WRITE(numout,*) '          e1v e2v  '
392         CALL prihre( e1v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
393         CALL prihre( e2v,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
394         WRITE(numout,*) '          e1f e2f  '
395         CALL prihre( e1f,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
396         CALL prihre( e2f,jpi,jpj,jpi-5,jpi,1,jpj-5,jpj,1,0.,numout )
397      ENDIF
398
399
400      ! ================= !
401      !  Coriolis factor  !
402      ! ================= !
403
404      SELECT CASE( jphgr_msh )   ! type of horizontal mesh
405
406      CASE ( 0, 1, 4 )               ! mesh on the sphere
407
408         ff(:,:) = 2. * omega * SIN( rad * gphif(:,:) ) 
409
410      CASE ( 2 )                     ! f-plane at ppgphi0
411
412         ff(:,:) = 2. * omega * SIN( rad * ppgphi0 )
413
414         IF(lwp) WRITE(numout,*) '          f-plane: Coriolis parameter = constant = ', ff(1,1)
415
416      CASE ( 3 )                     ! beta-plane
417
418         zbeta   = 2. * omega * COS( rad * ppgphi0 ) / ra                       ! beta at latitude ppgphi0
419         zphi0   = ppgphi0 - FLOAT( jpjglo/2) * ppe2_m / ( ra * rad )           ! latitude of the first row F-points
420         zf0     = 2. * omega * SIN( rad * zphi0 )                              ! compute f0 1st point south
421
422         ff(:,:) = ( zf0  + zbeta * gphif(:,:) * 1.e+3 )                        ! f = f0 +beta* y ( y=0 at south)
423       
424         IF(lwp) WRITE(numout,*) 
425         IF(lwp) WRITE(numout,*) ' Beta-plane: Beta parameter = constant = ', ff(1,1)
426         IF(lwp) WRITE(numout,*) ' Coriolis parameter varies from ', ff(1,1),' to ', ff(1,jpj)
427
428      CASE ( 5 )                     ! beta-plane and rotated domain
429
430         zbeta = 2. * omega * COS( rad * ppgphi0 ) / ra                     ! beta at latitude ppgphi0
431         zphi0 = 15.e0                                                      ! latitude of the first row F-points
432         zf0   = 2. * omega * SIN( rad * zphi0 )                            ! compute f0 1st point south
433
434         ff(:,:) = ( zf0 + zbeta * ABS( gphif(:,:) - zphi0 ) * rad * ra )   ! f = f0 +beta* y ( y=0 at south)
435
436         IF(lwp) WRITE(numout,*) '          Beta-plane: Beta parameter = constant = ', ff(1,1)
437         IF(lwp) WRITE(numout,*) '                      Coriolis parameter varies from ', ff(1,1),' to ', ff(1,jpj)
438
439      END SELECT
440
441
442      ! Control of domain for symetrical condition
443      ! ------------------------------------------
444      ! The equator line must be the latitude coordinate axe
445
446      IF( nperio == 2 ) THEN
447         znorme = SQRT( SUM( gphiu(:,2) * gphiu(:,2) ) ) / FLOAT( jpi )
448         IF( znorme > 1.e-13 ) THEN
449            IF(lwp) WRITE(numout,cform_err)
450            IF(lwp) WRITE(numout,*) ' ===>>>> : symmetrical condition: rerun with good equator line'
451            nstop = nstop + 1
452         ENDIF
453      ENDIF
454
455   END SUBROUTINE dom_hgr
456
457
458   SUBROUTINE hgr_read
459      !!---------------------------------------------------------------------
460      !!              ***  ROUTINE hgr_read  ***
461      !!
462      !! ** Purpose :   Read a coordinate file in NetCDF format
463      !!
464      !! ** Method  :   The mesh file has been defined trough a analytical
465      !!      or semi-analytical method. It is read in a NetCDF file.
466      !!     
467      !! References :
468      !!      Marti, Madec and Delecluse, 1992, JGR, 97, 12,763-12,766.
469      !!      Madec, Imbard, 1996, Clim. Dyn., 12, 381-388.
470      !!
471      !! History :
472      !!        !         (O. Marti)  Original code
473      !!        !  91-03  (G. Madec)
474      !!        !  92-07  (M. Imbard)
475      !!        !  99-11  (M. Imbard) NetCDF format with IOIPSL
476      !!        !  00-08  (D. Ludicone) Reduced section at Bab el Mandeb
477      !!   8.5  !  02-06  (G. Madec)  F90: Free form
478      !!----------------------------------------------------------------------
479      !! * Modules used
480      USE ioipsl
481
482      !! * Local declarations
483      LOGICAL ::   llog = .FALSE.
484      CHARACTER(len=21) ::   clname = 'coordinates'
485      INTEGER  ::   ji, jj              ! dummy loop indices
486      INTEGER  ::   inum                ! temporary logical unit
487      INTEGER  ::   ilev, itime         ! temporary integers
488      REAL(wp) ::   zdt, zdate0         ! temporary scalars
489      REAL(wp) ::   zdept(1)            ! temporary workspace
490      REAL(wp), DIMENSION(jpidta,jpjdta) ::   &
491         zlamt, zphit, zdta             ! temporary workspace (NetCDF read)
492      !!----------------------------------------------------------------------
493
494
495      ! 1. Read of the grid coordinates and scale factors
496      ! -------------------------------------------------
497
498      IF(lwp) THEN
499         WRITE(numout,*)
500         WRITE(numout,*) 'hgr_read : read the horizontal coordinates'
501         WRITE(numout,*) '~~~~~~~~~~~      jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpk = ', jpk
502      ENDIF
503
504      ! read the file
505      itime = 0
506      ilev = 1   
507      zlamt(:,:) = 0.e0
508      zphit(:,:) = 0.e0
509      CALL restini( clname, jpidta, jpjdta, zlamt , zphit,   &
510         &                  ilev  , zdept , clname,          &
511         &                  itime , zdate0, zdt   , inum )
512
513      CALL restget( inum, 'glamt', jpidta, jpjdta, 1, 0, llog, zdta )
514      DO jj = 1, nlcj
515         DO ji = 1, nlci
516            glamt(ji,jj) = zdta(mig(ji),mjg(jj))
517         END DO
518      END DO
519      CALL restget( inum, 'glamu', jpidta, jpjdta, 1, 0, llog, zdta )
520      DO jj = 1, nlcj
521         DO ji = 1, nlci
522            glamu(ji,jj) = zdta(mig(ji),mjg(jj))                   
523         END DO
524      END DO
525      CALL restget( inum, 'glamv', jpidta, jpjdta, 1, 0, llog, zdta )
526      DO jj = 1, nlcj
527         DO ji = 1, nlci
528            glamv(ji,jj) = zdta(mig(ji),mjg(jj))                   
529         END DO
530      END DO
531      CALL restget( inum, 'glamf', jpidta, jpjdta, 1, 0, llog, zdta )
532      DO jj = 1, nlcj
533         DO ji = 1, nlci
534            glamf(ji,jj) = zdta(mig(ji),mjg(jj))                   
535         END DO
536      END DO
537      CALL restget( inum, 'gphit', jpidta, jpjdta, 1, 0, llog, zdta )
538      DO jj = 1, nlcj
539         DO ji = 1, nlci
540            gphit(ji,jj) = zdta(mig(ji),mjg(jj))                   
541         END DO
542      END DO
543      CALL restget( inum, 'gphiu', jpidta, jpjdta, 1, 0, llog, zdta )
544      DO jj = 1, nlcj
545         DO ji = 1, nlci
546            gphiu(ji,jj) = zdta(mig(ji),mjg(jj))                   
547         END DO
548      END DO
549      CALL restget( inum, 'gphiv', jpidta, jpjdta, 1, 0, llog, zdta )
550      DO jj = 1, nlcj
551         DO ji = 1, nlci
552            gphiv(ji,jj) = zdta(mig(ji),mjg(jj))                   
553         END DO
554      END DO
555      CALL restget( inum, 'gphif', jpidta, jpjdta, 1, 0, llog, zdta )
556      DO jj = 1, nlcj
557         DO ji = 1, nlci
558            gphif(ji,jj) = zdta(mig(ji),mjg(jj))                   
559         END DO
560      END DO
561      CALL restget( inum, 'e1t', jpidta, jpjdta, 1, 0, llog, zdta )
562      DO jj = 1, nlcj
563         DO ji = 1, nlci
564            e1t  (ji,jj) = zdta(mig(ji),mjg(jj))                   
565         END DO
566      END DO
567      CALL restget( inum, 'e1u', jpidta, jpjdta, 1, 0, llog, zdta )
568      DO jj = 1, nlcj
569         DO ji = 1, nlci
570            e1u  (ji,jj) = zdta(mig(ji),mjg(jj))                   
571         END DO
572      END DO
573      CALL restget( inum, 'e1v', jpidta, jpjdta, 1, 0, llog, zdta )
574      DO jj = 1, nlcj
575         DO ji = 1, nlci
576            e1v  (ji,jj) = zdta(mig(ji),mjg(jj))                   
577         END DO
578      END DO
579      CALL restget( inum, 'e1f', jpidta, jpjdta, 1, 0, llog, zdta )
580      DO jj = 1, nlcj
581         DO ji = 1, nlci
582            e1f  (ji,jj) = zdta(mig(ji),mjg(jj))                   
583         END DO
584      END DO
585      CALL restget( inum, 'e2t', jpidta, jpjdta, 1, 0, llog, zdta )
586      DO jj = 1, nlcj
587         DO ji = 1, nlci
588            e2t  (ji,jj) = zdta(mig(ji),mjg(jj))                   
589         END DO
590      END DO
591      CALL restget( inum, 'e2u', jpidta, jpjdta, 1, 0, llog, zdta )
592      DO jj = 1, nlcj
593         DO ji = 1, nlci
594            e2u  (ji,jj) = zdta(mig(ji),mjg(jj))                   
595         END DO
596      END DO
597      CALL restget( inum, 'e2v', jpidta, jpjdta, 1, 0, llog, zdta )
598      DO jj = 1, nlcj
599         DO ji = 1, nlci
600            e2v  (ji,jj) = zdta(mig(ji),mjg(jj))                   
601         END DO
602      END DO
603      CALL restget( inum, 'e2f', jpidta, jpjdta, 1, 0, llog, zdta )
604      DO jj = 1, nlcj
605         DO ji = 1, nlci
606            e2f  (ji,jj) = zdta(mig(ji),mjg(jj))                   
607         END DO
608      END DO
609
610      CALL restclo( inum )
611
612      ! set extra rows add in mpp to none zero values
613      DO jj = nlcj+1, jpj
614         DO ji = 1, nlci
615            glamt(ji,jj) = glamt(ji,1)   ;   gphit(ji,jj) = gphit(ji,1)
616            glamu(ji,jj) = glamu(ji,1)   ;   gphiu(ji,jj) = gphiu(ji,1)
617            glamv(ji,jj) = glamv(ji,1)   ;   gphiv(ji,jj) = gphiv(ji,1)
618            glamf(ji,jj) = glamf(ji,1)   ;   gphif(ji,jj) = gphif(ji,1)
619            e1t  (ji,jj) = e1t  (ji,1)   ;   e2t  (ji,jj) = e2t  (ji,1)
620            e1u  (ji,jj) = e1u  (ji,1)   ;   e2u  (ji,jj) = e2u  (ji,1)
621            e1v  (ji,jj) = e1v  (ji,1)   ;   e2v  (ji,jj) = e2v  (ji,1)
622            e1f  (ji,jj) = e1f  (ji,1)   ;   e2f  (ji,jj) = e2f  (ji,1)
623         END DO
624      END DO
625
626      ! set extra columns add in mpp to none zero values
627      DO ji = nlci+1, jpi
628         glamt(ji,:) = glamt(1,:)   ;   gphit(ji,:) = gphit(1,:)
629         glamu(ji,:) = glamu(1,:)   ;   gphiu(ji,:) = gphiu(1,:)
630         glamv(ji,:) = glamv(1,:)   ;   gphiv(ji,:) = gphiv(1,:)
631         glamf(ji,:) = glamf(1,:)   ;   gphif(ji,:) = gphif(1,:)
632         e1t  (ji,:) = e1t  (1,:)   ;   e2t  (ji,:) = e2t  (1,:)
633         e1u  (ji,:) = e1u  (1,:)   ;   e2u  (ji,:) = e2u  (1,:)
634         e1v  (ji,:) = e1v  (1,:)   ;   e2v  (ji,:) = e2v  (1,:)
635         e1f  (ji,:) = e1f  (1,:)   ;   e2f  (ji,:) = e2f  (1,:)
636      END DO
637
638   END SUBROUTINE hgr_read
639
640
641   SUBROUTINE hgr_read_fdir
642      !!----------------------------------------------------------------------
643      !!                 ***  ROUTINE hgr_read_fdir  ***
644      !!
645      !!----------------------------------------------------------------------
646      !! * Local declarations
647      CHARACTER (len=5) ::   clfield
648      CHARACTER(len=21) ::   clname = 'coordinates'
649      INTEGER ::   ji, jj         ! dummy loop indices
650      INTEGER ::   inumcoo = 11   ! logical unit for coordinate file
651      INTEGER ::   ijpi, ijpj     ! temporary integers
652      REAL(wp), DIMENSION(jpi,jpj) ::   zdta   ! temporary workspace
653      !!----------------------------------------------------------------------
654
655
656      ! 1. Read of the grid coordinates and scale factors
657      ! -------------------------------------------------
658
659      IF(lwp) THEN
660         WRITE(numout,*)
661         WRITE(numout,*) 'hgrcoo : read the horizontal coordinates'
662         WRITE(numout,*) '~~~~~~'
663         WRITE(numout,*) '         jpiglo jpjglo jpk : ', jpiglo, jpjglo, jpk
664      ENDIF
665
666      ! open the file
667          CALL ctlopn( inumcoo, clname, 'OLD', 'UNFORMATTED', 'SEQUENTIAL',   &
668                       1      , numout       , lwp  , 1                            )
669
670      ! read the file
671      READ(inumcoo) ijpi,ijpj
672      IF( (ijpi /= jpidta) .OR. (ijpj /= jpjdta) ) THEN
673         IF(lwp) THEN
674            WRITE(numout,*)
675            WRITE(numout,*) '         inconsitency in reading coordinate file, unit=',inumcoo
676            WRITE(numout,*) '            jpidta = ',jpidta  ,' jpi  read = ',ijpi
677            WRITE(numout,*) '            jpjdta = ',jpjdta  ,' jpj  read = ',ijpj
678            WRITE(numout,*)
679         ENDIF
680         nstop = nstop + 1
681      ENDIF
682
683      READ(inumcoo) clfield, zdta
684      IF( clfield /= 'GLAMT' ) THEN
685         IF(lwp) THEN
686            WRITE(numout,cform_err)
687            WRITE(numout,*) 'hgrcoo: bad read',clfield,' GLAMT'
688         ENDIF
689         nstop = nstop + 1
690      ENDIF
691      DO jj = 1, nlcj
692         DO ji = 1, nlci
693            glamt(ji,jj) = zdta(mig(ji),mjg(jj))
694         END DO
695      END DO
696      READ(inumcoo) clfield, zdta
697      IF(clfield /= 'GLAMU') THEN
698         IF(lwp) THEN
699            WRITE(numout,cform_err)
700            WRITE(numout,*) 'hgrcoo: bad read',clfield,' GLAMU'
701         ENDIF
702         nstop = nstop + 1
703      ENDIF
704      DO jj = 1, nlcj
705         DO ji = 1, nlci
706            glamu(ji,jj) = zdta(mig(ji),mjg(jj))                   
707         END DO
708      END DO
709      READ(inumcoo) clfield, zdta
710      IF(clfield /= 'GLAMV') THEN
711         IF(lwp) THEN
712            WRITE(numout,cform_err)
713            WRITE(numout,*) 'hgrcoo: bad read',clfield,' GLAMV'
714         ENDIF
715         nstop = nstop + 1
716      ENDIF
717      DO jj = 1, nlcj
718         DO ji = 1, nlci
719            glamv(ji,jj) = zdta(mig(ji),mjg(jj))                   
720         END DO
721      END DO
722      READ(inumcoo) clfield, zdta
723      IF(clfield /= 'GLAMF') THEN
724         IF(lwp) THEN
725            WRITE(numout,cform_err)
726            WRITE(numout,*) 'hgrcoo: bad read',clfield,' GLAMF'
727         ENDIF
728         nstop = nstop + 1
729      ENDIF
730      DO jj = 1, nlcj
731         DO ji = 1, nlci
732            glamf(ji,jj) = zdta(mig(ji),mjg(jj))                   
733         END DO
734      END DO
735      READ(inumcoo) clfield, zdta
736      IF(clfield /= 'GPHIT') THEN
737         IF(lwp) THEN
738            WRITE(numout,cform_err)
739            WRITE(numout,*) 'hgrcoo: bad read',clfield,' GPHIT'
740         ENDIF
741         nstop = nstop + 1
742      ENDIF
743      DO jj = 1, nlcj
744         DO ji = 1, nlci
745            gphit(ji,jj) = zdta(mig(ji),mjg(jj))                   
746         END DO
747      END DO
748      READ(inumcoo) clfield, zdta
749      IF(clfield /= 'GPHIU') THEN
750         IF(lwp) THEN
751            WRITE(numout,cform_err)
752            WRITE(numout,*) 'hgrcoo: bad read',clfield,' GPHIU'
753         ENDIF
754         nstop = nstop + 1
755      ENDIF
756      DO jj = 1, nlcj
757         DO ji = 1, nlci
758            gphiu(ji,jj) = zdta(mig(ji),mjg(jj))                   
759         END DO
760      END DO
761      READ(inumcoo) clfield, zdta
762      IF(clfield /= 'GPHIV') THEN
763         IF(lwp) THEN
764            WRITE(numout,cform_err)
765            WRITE(numout,*) 'hgrcoo: bad read',clfield,' GPHIV'
766         ENDIF
767         nstop = nstop + 1
768      ENDIF
769      DO jj = 1, nlcj
770         DO ji = 1, nlci
771            gphiv(ji,jj) = zdta(mig(ji),mjg(jj))                   
772         END DO
773      END DO
774      READ(inumcoo) clfield, zdta
775      IF(clfield /= 'GPHIF') THEN
776         IF(lwp) THEN
777            WRITE(numout,cform_err)
778            WRITE(numout,*) 'hgrcoo: bad read',clfield,' GPHIF'
779         ENDIF
780         nstop = nstop + 1
781      ENDIF
782      DO jj = 1, nlcj
783         DO ji = 1, nlci
784            gphif(ji,jj) = zdta(mig(ji),mjg(jj))                   
785         END DO
786      END DO
787      READ(inumcoo) clfield, zdta
788      IF(clfield /= 'E1T  ') THEN
789         IF(lwp) THEN
790            WRITE(numout,cform_err)
791            WRITE(numout,*) 'hgrcoo: bad read',clfield,' E1T  '
792         ENDIF
793         nstop = nstop + 1
794      ENDIF
795      DO jj = 1, nlcj
796         DO ji = 1, nlci
797            e1t  (ji,jj) = zdta(mig(ji),mjg(jj))                   
798         END DO
799      END DO
800      READ(inumcoo) clfield, zdta
801      IF(clfield /= 'E1U  ') THEN
802         IF(lwp) THEN
803            WRITE(numout,cform_err)
804            WRITE(numout,*) 'hgrcoo: bad read',clfield,' E1U  '
805         ENDIF
806         nstop = nstop + 1
807      ENDIF
808      DO jj = 1, nlcj
809         DO ji = 1, nlci
810            e1u  (ji,jj) = zdta(mig(ji),mjg(jj))                   
811         END DO
812      END DO
813      READ(inumcoo) clfield, zdta
814      IF(clfield /= 'E1V  ') THEN
815         IF(lwp) THEN
816            WRITE(numout,cform_err)
817            WRITE(numout,*) 'hgrcoo: bad read',clfield,' E1V  '
818         ENDIF
819         nstop = nstop + 1
820      ENDIF
821      DO jj = 1, nlcj
822         DO ji = 1, nlci
823            e1v  (ji,jj) = zdta(mig(ji),mjg(jj))                   
824         END DO
825      END DO
826      READ(inumcoo) clfield, zdta
827      IF(clfield /= 'E1F  ') THEN
828         IF(lwp) THEN
829            WRITE(numout,cform_err)
830            WRITE(numout,*) 'hgrcoo: bad read',clfield,' E1F  '
831         ENDIF
832         nstop = nstop + 1
833      ENDIF
834      DO jj = 1, nlcj
835         DO ji = 1, nlci
836            e1f  (ji,jj) = zdta(mig(ji),mjg(jj))                   
837         END DO
838      END DO
839      READ(inumcoo) clfield, zdta
840      IF(clfield /= 'E2T  ') THEN
841         IF(lwp) THEN
842            WRITE(numout,cform_err)
843            WRITE(numout,*) 'hgrcoo: bad read',clfield,' E2T  '
844         ENDIF
845         nstop = nstop + 1
846      ENDIF
847      DO jj = 1, nlcj
848         DO ji = 1, nlci
849            e2t  (ji,jj) = zdta(mig(ji),mjg(jj))                   
850         END DO
851      END DO
852      READ(inumcoo) clfield, zdta
853      IF(clfield /= 'E2U  ') THEN
854         IF(lwp) THEN
855            WRITE(numout,cform_err)
856            WRITE(numout,*) 'hgrcoo: bad read',clfield,' E2U  '
857         ENDIF
858         nstop = nstop + 1
859      ENDIF
860      DO jj = 1, nlcj
861         DO ji = 1, nlci
862            e2u  (ji,jj) = zdta(mig(ji),mjg(jj))                   
863         END DO
864      END DO
865      READ(inumcoo) clfield, zdta
866      IF(clfield /= 'E2V  ') THEN
867         IF(lwp) THEN
868            WRITE(numout,cform_err)
869            WRITE(numout,*) 'hgrcoo: bad read',clfield,' E2V  '
870         ENDIF
871         nstop = nstop + 1
872      ENDIF
873      DO jj = 1, nlcj
874         DO ji = 1, nlci
875            e2v  (ji,jj) = zdta(mig(ji),mjg(jj))                   
876         END DO
877      END DO
878      READ(inumcoo) clfield, zdta
879      IF(clfield /= 'E2F  ') THEN
880         IF(lwp) THEN
881            WRITE(numout,cform_err)
882            WRITE(numout,*) 'hgrcoo: bad read',clfield,' E2F  '
883         ENDIF
884         nstop = nstop + 1
885      ENDIF
886      DO jj = 1, nlcj
887         DO ji = 1, nlci
888            e2f  (ji,jj) = zdta(mig(ji),mjg(jj))                   
889         END DO
890      END DO
891
892      CLOSE( inumcoo )
893
894      ! set extra rows add in mpp to none zero values
895      DO jj = nlcj+1, jpj
896         DO ji = 1, nlci
897            glamt(ji,jj) = glamt(ji,1)   ;   gphit(ji,jj) = gphit(ji,1)
898            glamu(ji,jj) = glamu(ji,1)   ;   gphiu(ji,jj) = gphiu(ji,1)
899            glamv(ji,jj) = glamv(ji,1)   ;   gphiv(ji,jj) = gphiv(ji,1)
900            glamf(ji,jj) = glamf(ji,1)   ;   gphif(ji,jj) = gphif(ji,1)
901            e1t  (ji,jj) = e1t  (ji,1)   ;   e2t  (ji,jj) = e2t  (ji,1)
902            e1u  (ji,jj) = e1u  (ji,1)   ;   e2u  (ji,jj) = e2u  (ji,1)
903            e1v  (ji,jj) = e1v  (ji,1)   ;   e2v  (ji,jj) = e2v  (ji,1)
904            e1f  (ji,jj) = e1f  (ji,1)   ;   e2f  (ji,jj) = e2f  (ji,1)
905         END DO
906      END DO
907
908      ! set extra columns add in mpp to none zero values
909      DO ji = nlci+1, jpi
910         glamt(ji,:) = glamt(1,:)   ;   gphit(ji,:) = gphit(1,:)
911         glamu(ji,:) = glamu(1,:)   ;   gphiu(ji,:) = gphiu(1,:)
912         glamv(ji,:) = glamv(1,:)   ;   gphiv(ji,:) = gphiv(1,:)
913         glamf(ji,:) = glamf(1,:)   ;   gphif(ji,:) = gphif(1,:)
914         e1t  (ji,:) = e1t  (1,:)   ;   e2t  (ji,:) = e2t  (1,:)
915         e1u  (ji,:) = e1u  (1,:)   ;   e2u  (ji,:) = e2u  (1,:)
916         e1v  (ji,:) = e1v  (1,:)   ;   e2v  (ji,:) = e2v  (1,:)
917         e1f  (ji,:) = e1f  (1,:)   ;   e2f  (ji,:) = e2f  (1,:)
918      END DO
919
920   END SUBROUTINE hgr_read_fdir
921
922   !!======================================================================
923END MODULE domhgr
Note: See TracBrowser for help on using the repository browser.