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.
make_domain_cfg.f90.old in branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/TOOLS/DOMAINcfg/src – NEMO

source: branches/2016/dev_r6409_SIMPLIF_2_usrdef_tools/NEMOGCM/TOOLS/DOMAINcfg/src/make_domain_cfg.f90.old @ 6881

Last change on this file since 6881 was 6881, checked in by flavoni, 8 years ago

first commit to create in TOOLS domain_cfg.nc files
File size: 24.4 KB
Line 
1PROGRAM make_domain_cfg
2   !!======================================================================
3   !!                       ***  PROGRAM make_domain ***
4   !!======================================================================
5   !!
6   !!----------------------------------------------------------------------
7
8   USE step_oce       ! module used in the ocean time stepping module (step.F90)
9   USE domcfg         ! domain configuration               (dom_cfg routine)
10   USE mppini         ! shared/distributed memory setting (mpp_init routine)
11   USE domain         ! domain initialization             (dom_init routine)
12   USE phycst         ! physical constant                  (par_cst routine)
13   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
14   USE lib_mpp        ! distributed memory computing
15   USE xios           ! xIOserver
16   USE lbcnfd , ONLY  : isendto, nsndto, nfsloop, nfeloop   ! Setup of north fold exchanges
17
18   IMPLICIT NONE
19   PRIVATE
20
21   PUBLIC   nemo_gcm    ! called by model.F90
22   PUBLIC   nemo_init   ! needed by AGRIF
23   PUBLIC   nemo_alloc  ! needed by TAM
24
25   CHARACTER(lc) ::   cform_aaa="( /, 'AAAAAAAA', / ) "     ! flag for output listing
26
27   !!----------------------------------------------------------------------
28   !! NEMO/OPA 3.7 , NEMO Consortium (2015)
29   !! $Id: nemogcm.F90 6827 2016-08-01 13:37:15Z flavoni $
30   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
31   !!----------------------------------------------------------------------
32CONTAINS
33
34   SUBROUTINE nemo_gcm
35      !!----------------------------------------------------------------------
36      !!                     ***  ROUTINE nemo_gcm  ***
37      !!
38      !! ** Purpose :   NEMO solves the primitive equations on an orthogonal
39      !!              curvilinear mesh on the sphere.
40      !!
41      !! ** Method  : - model general initialization
42      !!              - launch the time-stepping (stp routine)
43      !!              - finalize the run by closing files and communications
44      !!
45      !! References : Madec, Delecluse, Imbard, and Levy, 1997:  internal report, IPSL.
46      !!              Madec, 2008, internal report, IPSL.
47      !!----------------------------------------------------------------------
48      INTEGER ::   istp       ! time step index
49      !!----------------------------------------------------------------------
50      !
51      CALL nemo_init               !==  Initialisations  ==!
52      !                            !-----------------------!
53      ! check that all process are still there... If some process have an error,
54      ! they will never enter in step and other processes will wait until the end of the cpu time!
55      IF( lk_mpp )   CALL mpp_max( nstop )
56
57      IF(lwp) WRITE(numout,cform_aaa)   ! Flag AAAAAAA
58
59      !                            !-----------------------!
60      !                            !==  finalize the run  ==!
61      !                            !------------------------!
62      !
63      IF( nstop /= 0 .AND. lwp ) THEN   ! error print
64         WRITE(numout,cform_err)
65         WRITE(numout,*) nstop, ' error have been found'
66      ENDIF
67      !
68      IF( nn_timing == 1 )   CALL timing_finalize
69      !
70      CALL nemo_closefile
71      !
72      CALL xios_finalize                  ! end mpp communications with xios
73      !
74   END SUBROUTINE nemo_gcm
75
76
77   SUBROUTINE nemo_init
78      !!----------------------------------------------------------------------
79      !!                     ***  ROUTINE nemo_init  ***
80      !!
81      !! ** Purpose :   initialization of the NEMO GCM
82      !!----------------------------------------------------------------------
83      INTEGER ::   ji            ! dummy loop indices
84      INTEGER ::   ilocal_comm   ! local integer
85      INTEGER ::   ios
86      CHARACTER(len=80), DIMENSION(16) ::   cltxt
87      !
88      NAMELIST/namctl/ ln_ctl  , nn_print, nn_ictls, nn_ictle,   &
89         &             nn_isplt, nn_jsplt, nn_jctls, nn_jctle,   &
90         &             nn_bench, nn_timing, nn_diacfl
91      NAMELIST/namcfg/ cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, &
92         &             jpizoom, jpjzoom, jperio, ln_use_jattr
93      !!----------------------------------------------------------------------
94      !
95      cltxt = ''
96      cxios_context = 'nemo'
97      !
98      !                             ! Open reference namelist and configuration namelist files
99      CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
100      CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
101      !
102      REWIND( numnam_ref )              ! Namelist namctl in reference namelist : Control prints & Benchmark
103      READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 )
104901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. )
105
106      REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist : Control prints & Benchmark
107      READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 )
108902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. )
109
110      !
111      REWIND( numnam_ref )              ! Namelist namcfg in reference namelist : Control prints & Benchmark
112      READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 )
113903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. )
114
115      REWIND( numnam_cfg )              ! Namelist namcfg in confguration namelist : Control prints & Benchmark
116      READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 )
117904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )   
118
119      !
120      !                             !--------------------------------------------!
121      !                             !  set communicator & select the local node  !
122      !                             !  NB: mynode also opens output.namelist.dyn !
123      !                             !      on unit number numond on first proc   !
124      !                             !--------------------------------------------!
125      ! Nodes selection (control print return in cltxt)
126      narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )
127      !
128      narea = narea + 1                                     ! mynode return the rank of proc (0 --> jpnij -1 )
129
130      lwm = (narea == 1)                                    ! control of output namelists
131      lwp = (narea == 1) .OR. ln_ctl                        ! control of all listing output print
132
133      IF(lwm) THEN
134         ! write merged namelists from earlier to output namelist now that the
135         ! file has been opened in call to mynode. nammpp has already been
136         ! written in mynode (if lk_mpp_mpi)
137         WRITE( numond, namctl )
138         WRITE( numond, namcfg )
139      ENDIF
140
141      ! If dimensions of processor grid weren't specified in the namelist file
142      ! then we calculate them here now that we have our communicator size
143      IF( jpni < 1 .OR. jpnj < 1 ) THEN
144      IF( Agrif_Root() )   CALL nemo_partition( mppsize )
145      ENDIF
146
147      ! Calculate domain dimensions given calculated jpni and jpnj
148      ! This used to be done in par_oce.F90 when they were parameters rather than variables
149      IF( Agrif_Root() ) THEN
150         jpi = ( jpiglo     -2*jpreci + (jpni-1) ) / jpni + 2*jpreci    ! first  dim.
151         jpj = ( jpjglo     -2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj    ! second dim.
152      ENDIF         
153         jpk = jpkdta                                             ! third dim
154      !
155         jpim1 = jpi-1                                            ! inner domain indices
156         jpjm1 = jpj-1                                            !   "           "
157         jpkm1 = jpk-1                                            !   "           "
158         jpij  = jpi*jpj                                          !  jpi x j
159
160      IF(lwp) THEN                            ! open listing units
161         !
162         CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
163         !
164         WRITE(numout,*)
165         WRITE(numout,*) '   CNRS - NERC - Met OFFICE - MERCATOR-ocean - INGV - CMCC'
166         WRITE(numout,*) '                       NEMO team'
167         WRITE(numout,*) '            Ocean General Circulation Model'
168         WRITE(numout,*) '                  version 3.7  (2015) '
169         WRITE(numout,*)
170         WRITE(numout,*)
171         DO ji = 1, SIZE(cltxt)
172            IF( TRIM(cltxt(ji)) /= '' )   WRITE(numout,*) cltxt(ji)      ! control print of mynode
173         END DO
174         WRITE(numout,cform_aaa)                                         ! Flag AAAAAAA
175         !
176      ENDIF
177
178      ! Now we know the dimensions of the grid and numout has been set we can
179      ! allocate arrays
180      CALL nemo_alloc()
181
182      !                             !-------------------------------!
183      !                             !  NEMO general initialization  !
184      !                             !-------------------------------!
185
186      CALL nemo_ctl                          ! Control prints & Benchmark
187
188      !                                      ! Domain decomposition
189      IF( jpni*jpnj == jpnij ) THEN   ;   CALL mpp_init      ! standard cutting out
190      ELSE                            ;   CALL mpp_init2     ! eliminate land processors
191      ENDIF
192      !
193      IF( nn_timing == 1 )  CALL timing_init
194      !
195      !                                      ! General initialization
196                            CALL     phy_cst    ! Physical constants
197                            CALL     eos_init   ! Equation of state
198                            CALL     dom_cfg    ! Domain configuration
199                            CALL     dom_init   ! Domain
200      IF( ln_ctl        )   CALL prt_ctl_init   ! Print control
201      !
202   END SUBROUTINE nemo_init
203
204
205   SUBROUTINE nemo_ctl
206      !!----------------------------------------------------------------------
207      !!                     ***  ROUTINE nemo_ctl  ***
208      !!
209      !! ** Purpose :   control print setting
210      !!
211      !! ** Method  : - print namctl information and check some consistencies
212      !!----------------------------------------------------------------------
213      !
214      IF(lwp) THEN                  ! control print
215         WRITE(numout,*)
216         WRITE(numout,*) 'nemo_ctl: Control prints & Benchmark'
217         WRITE(numout,*) '~~~~~~~ '
218         WRITE(numout,*) '   Namelist namctl'
219         WRITE(numout,*) '      run control (for debugging)     ln_ctl     = ', ln_ctl
220         WRITE(numout,*) '      level of print                  nn_print   = ', nn_print
221         WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls
222         WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle
223         WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls
224         WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle
225         WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt
226         WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt
227         WRITE(numout,*) '      benchmark parameter (0/1)       nn_bench   = ', nn_bench
228         WRITE(numout,*) '      timing activated    (0/1)       nn_timing  = ', nn_timing
229      ENDIF
230      !
231      nprint    = nn_print          ! convert DOCTOR namelist names into OLD names
232      nictls    = nn_ictls
233      nictle    = nn_ictle
234      njctls    = nn_jctls
235      njctle    = nn_jctle
236      isplt     = nn_isplt
237      jsplt     = nn_jsplt
238      nbench    = nn_bench
239
240      IF(lwp) THEN                  ! control print
241         WRITE(numout,*)
242         WRITE(numout,*) 'namcfg  : configuration initialization through namelist read'
243         WRITE(numout,*) '~~~~~~~ '
244         WRITE(numout,*) '   Namelist namcfg'
245         WRITE(numout,*) '      configuration name                               cp_cfg  = ', TRIM(cp_cfg)
246         WRITE(numout,*) '      configuration zoom name                          cp_cfz  = ', TRIM(cp_cfz)
247         WRITE(numout,*) '      configuration resolution                         jp_cfg  = ', jp_cfg
248         WRITE(numout,*) '      1st lateral dimension ( >= jpiglo )              jpidta  = ', jpidta
249         WRITE(numout,*) '      2nd    "         "    ( >= jpjglo )              jpjdta  = ', jpjdta
250         WRITE(numout,*) '      3nd    "         "                               jpkdta  = ', jpkdta
251         WRITE(numout,*) '      1st dimension of global domain in i              jpiglo  = ', jpiglo
252         WRITE(numout,*) '      2nd    -                  -    in j              jpjglo  = ', jpjglo
253         WRITE(numout,*) '      left bottom i index of the zoom (in data domain) jpizoom = ', jpizoom
254         WRITE(numout,*) '      left bottom j index of the zoom (in data domain) jpizoom = ', jpjzoom
255         WRITE(numout,*) '      lateral cond. type (between 0 and 6)             jperio  = ', jperio   
256         WRITE(numout,*) '      use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr
257      ENDIF
258      !                             ! Parameter control
259      !
260      IF( ln_ctl ) THEN                 ! sub-domain area indices for the control prints
261         IF( lk_mpp .AND. jpnij > 1 ) THEN
262            isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain
263         ELSE
264            IF( isplt == 1 .AND. jsplt == 1  ) THEN
265               CALL ctl_warn( ' - isplt & jsplt are equal to 1',   &
266                  &           ' - the print control will be done over the whole domain' )
267            ENDIF
268            ijsplt = isplt * jsplt            ! total number of processors ijsplt
269         ENDIF
270         IF(lwp) WRITE(numout,*)'          - The total number of processors over which the'
271         IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt
272         !
273         !                              ! indices used for the SUM control
274         IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area
275            lsp_area = .FALSE.
276         ELSE                                             ! print control done over a specific  area
277            lsp_area = .TRUE.
278            IF( nictls < 1 .OR. nictls > jpiglo )   THEN
279               CALL ctl_warn( '          - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )
280               nictls = 1
281            ENDIF
282            IF( nictle < 1 .OR. nictle > jpiglo )   THEN
283               CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )
284               nictle = jpiglo
285            ENDIF
286            IF( njctls < 1 .OR. njctls > jpjglo )   THEN
287               CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )
288               njctls = 1
289            ENDIF
290            IF( njctle < 1 .OR. njctle > jpjglo )   THEN
291               CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )
292               njctle = jpjglo
293            ENDIF
294         ENDIF
295      ENDIF
296      !
297      IF( 1_wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ',  &
298         &                                               'f2003 standard. '                              ,  &
299         &                                               'Compile with key_nosignedzero enabled' )
300      !
301   END SUBROUTINE nemo_ctl
302
303
304   SUBROUTINE nemo_closefile
305      !!----------------------------------------------------------------------
306      !!                     ***  ROUTINE nemo_closefile  ***
307      !!
308      !! ** Purpose :   Close the files
309      !!----------------------------------------------------------------------
310      !
311      IF( lk_mpp )   CALL mppsync
312      !
313      CALL iom_close                                 ! close all input/output files managed by iom_*
314      !
315      IF( numstp          /= -1 )   CLOSE( numstp          )   ! time-step file
316      IF( numsol          /= -1 )   CLOSE( numsol          )   ! solver file
317      IF( numnam_ref      /= -1 )   CLOSE( numnam_ref      )   ! oce reference namelist
318      IF( numnam_cfg      /= -1 )   CLOSE( numnam_cfg      )   ! oce configuration namelist
319      IF( lwm.AND.numond  /= -1 )   CLOSE( numond          )   ! oce output namelist
320      IF( numnam_ice_ref  /= -1 )   CLOSE( numnam_ice_ref  )   ! ice reference namelist
321      IF( numnam_ice_cfg  /= -1 )   CLOSE( numnam_ice_cfg  )   ! ice configuration namelist
322      IF( lwm.AND.numoni  /= -1 )   CLOSE( numoni          )   ! ice output namelist
323      IF( numevo_ice      /= -1 )   CLOSE( numevo_ice      )   ! ice variables (temp. evolution)
324      IF( numout          /=  6 )   CLOSE( numout          )   ! standard model output file
325      IF( numdct_vol      /= -1 )   CLOSE( numdct_vol      )   ! volume transports
326      IF( numdct_heat     /= -1 )   CLOSE( numdct_heat     )   ! heat transports
327      IF( numdct_salt     /= -1 )   CLOSE( numdct_salt     )   ! salt transports
328      !
329      numout = 6                                     ! redefine numout in case it is used after this point...
330      !
331   END SUBROUTINE nemo_closefile
332
333
334   SUBROUTINE nemo_alloc
335      !!----------------------------------------------------------------------
336      !!                     ***  ROUTINE nemo_alloc  ***
337      !!
338      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules
339      !!
340      !! ** Method  :
341      !!----------------------------------------------------------------------
342      USE dom_oce   , ONLY: dom_oce_alloc
343      !
344      INTEGER :: ierr
345      !!----------------------------------------------------------------------
346      !
347      ierr =        oce_alloc       ()          ! ocean
348      ierr = ierr + dom_oce_alloc   ()          ! ocean domain
349      !
350      IF( lk_mpp    )   CALL mpp_sum( ierr )
351      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'nemo_alloc : unable to allocate standard ocean arrays' )
352      !
353   END SUBROUTINE nemo_alloc
354
355
356   SUBROUTINE nemo_partition( num_pes )
357      !!----------------------------------------------------------------------
358      !!                 ***  ROUTINE nemo_partition  ***
359      !!
360      !! ** Purpose :
361      !!
362      !! ** Method  :
363      !!----------------------------------------------------------------------
364      INTEGER, INTENT(in) ::   num_pes   ! The number of MPI processes we have
365      !
366      INTEGER, PARAMETER :: nfactmax = 20
367      INTEGER :: nfact ! The no. of factors returned
368      INTEGER :: ierr  ! Error flag
369      INTEGER :: ji
370      INTEGER :: idiff, mindiff, imin ! For choosing pair of factors that are closest in value
371      INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors
372      !!----------------------------------------------------------------------
373      !
374      ierr = 0
375      !
376      CALL factorise( ifact, nfactmax, nfact, num_pes, ierr )
377      !
378      IF( nfact <= 1 ) THEN
379         WRITE (numout, *) 'WARNING: factorisation of number of PEs failed'
380         WRITE (numout, *) '       : using grid of ',num_pes,' x 1'
381         jpnj = 1
382         jpni = num_pes
383      ELSE
384         ! Search through factors for the pair that are closest in value
385         mindiff = 1000000
386         imin    = 1
387         DO ji = 1, nfact-1, 2
388            idiff = ABS( ifact(ji) - ifact(ji+1) )
389            IF( idiff < mindiff ) THEN
390               mindiff = idiff
391               imin = ji
392            ENDIF
393         END DO
394         jpnj = ifact(imin)
395         jpni = ifact(imin + 1)
396      ENDIF
397      !
398      jpnij = jpni*jpnj
399      !
400   END SUBROUTINE nemo_partition
401
402
403   SUBROUTINE factorise( kfax, kmaxfax, knfax, kn, kerr )
404      !!----------------------------------------------------------------------
405      !!                     ***  ROUTINE factorise  ***
406      !!
407      !! ** Purpose :   return the prime factors of n.
408      !!                knfax factors are returned in array kfax which is of
409      !!                maximum dimension kmaxfax.
410      !! ** Method  :
411      !!----------------------------------------------------------------------
412      INTEGER                    , INTENT(in   ) ::   kn, kmaxfax
413      INTEGER                    , INTENT(  out) ::   kerr, knfax
414      INTEGER, DIMENSION(kmaxfax), INTENT(  out) ::   kfax
415      !
416      INTEGER :: ifac, jl, inu
417      INTEGER, PARAMETER :: ntest = 14
418      INTEGER, DIMENSION(ntest) ::   ilfax
419      !!----------------------------------------------------------------------
420      !
421      ! lfax contains the set of allowed factors.
422      ilfax(:) = (/(2**jl,jl=ntest,1,-1)/)
423      !
424      ! Clear the error flag and initialise output vars
425      kerr  = 0
426      kfax  = 1
427      knfax = 0
428      !
429      ! Find the factors of n.
430      IF( kn == 1 )   GOTO 20
431
432      ! nu holds the unfactorised part of the number.
433      ! knfax holds the number of factors found.
434      ! l points to the allowed factor list.
435      ! ifac holds the current factor.
436      !
437      inu   = kn
438      knfax = 0
439      !
440      DO jl = ntest, 1, -1
441         !
442         ifac = ilfax(jl)
443         IF( ifac > inu )   CYCLE
444
445         ! Test whether the factor will divide.
446
447         IF( MOD(inu,ifac) == 0 ) THEN
448            !
449            knfax = knfax + 1            ! Add the factor to the list
450            IF( knfax > kmaxfax ) THEN
451               kerr = 6
452               write (*,*) 'FACTOR: insufficient space in factor array ', knfax
453               return
454            ENDIF
455            kfax(knfax) = ifac
456            ! Store the other factor that goes with this one
457            knfax = knfax + 1
458            kfax(knfax) = inu / ifac
459            !WRITE (*,*) 'ARPDBG, factors ',knfax-1,' & ',knfax,' are ', kfax(knfax-1),' and ',kfax(knfax)
460         ENDIF
461         !
462      END DO
463      !
464   20 CONTINUE      ! Label 20 is the exit point from the factor search loop.
465      !
466   END SUBROUTINE factorise
467
468
469   SUBROUTINE nemo_northcomms
470      !!----------------------------------------------------------------------
471      !!                     ***  ROUTINE  nemo_northcomms  ***
472      !! ** Purpose :   Setup for north fold exchanges with explicit
473      !!                point-to-point messaging
474      !!
475      !! ** Method :   Initialization of the northern neighbours lists.
476      !!----------------------------------------------------------------------
477      !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE)
478      !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC)
479      !!----------------------------------------------------------------------
480      INTEGER  ::   sxM, dxM, sxT, dxT, jn
481      INTEGER  ::   njmppmax
482      !!----------------------------------------------------------------------
483      !
484      njmppmax = MAXVAL( njmppt )
485      !
486      !initializes the north-fold communication variables
487      isendto(:) = 0
488      nsndto     = 0
489      !
490      !if I am a process in the north
491      IF ( njmpp == njmppmax ) THEN
492          !sxM is the first point (in the global domain) needed to compute the
493          !north-fold for the current process
494          sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1
495          !dxM is the last point (in the global domain) needed to compute the
496          !north-fold for the current process
497          dxM = jpiglo - nimppt(narea) + 2
498
499          !loop over the other north-fold processes to find the processes
500          !managing the points belonging to the sxT-dxT range
501 
502          DO jn = 1, jpni
503                !sxT is the first point (in the global domain) of the jn
504                !process
505                sxT = nfiimpp(jn, jpnj)
506                !dxT is the last point (in the global domain) of the jn
507                !process
508                dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1
509                IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN
510                   nsndto = nsndto + 1
511                     isendto(nsndto) = jn
512                ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN
513                   nsndto = nsndto + 1
514                     isendto(nsndto) = jn
515                ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN
516                   nsndto = nsndto + 1
517                     isendto(nsndto) = jn
518                END IF
519          END DO
520          nfsloop = 1
521          nfeloop = nlci
522          DO jn = 2,jpni-1
523           IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN
524              IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN
525                 nfsloop = nldi
526              ENDIF
527              IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN
528                 nfeloop = nlei
529              ENDIF
530           ENDIF
531        END DO
532
533      ENDIF
534      l_north_nogather = .TRUE.
535   END SUBROUTINE nemo_northcomms
536
537
538   !!======================================================================
539END PROGRAM make_domain_cfg
Note: See TracBrowser for help on using the repository browser.