source: trunk/NEMOGCM/NEMO/SAS_SRC/nemogcm.F90 @ 5510

Last change on this file since 5510 was 5510, checked in by clem, 6 years ago

enable the use of BDY with ice (LIM3) in case of SAS. Calls to bdy had to be added in SAS eventhough it is not very clean. This is something that needs to be rethought in the future but it does the job for now

  • Property svn:keywords set to Id
File size: 33.7 KB
Line 
1MODULE nemogcm
2   !!======================================================================
3   !!                       ***  MODULE nemogcm   ***
4   !! Ocean system   : NEMO GCM (ocean dynamics, on-line tracers, biochemistry and sea-ice)
5   !!======================================================================
6   !! History :  OPA  ! 1990-10  (C. Levy, G. Madec)  Original code
7   !!            7.0  ! 1991-11  (M. Imbard, C. Levy, G. Madec)
8   !!            7.1  ! 1993-03  (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar,
9   !!                             P. Delecluse, C. Perigaud, G. Caniaux, B. Colot, C. Maes) release 7.1
10   !!             -   ! 1992-06  (L.Terray)  coupling implementation
11   !!             -   ! 1993-11  (M.A. Filiberti) IGLOO sea-ice
12   !!            8.0  ! 1996-03  (M. Imbard, C. Levy, G. Madec, O. Marti, M. Guyon, A. Lazar,
13   !!                             P. Delecluse, L.Terray, M.A. Filiberti, J. Vialar, A.M. Treguier, M. Levy) release 8.0
14   !!            8.1  ! 1997-06  (M. Imbard, G. Madec)
15   !!            8.2  ! 1999-11  (M. Imbard, H. Goosse)  LIM sea-ice model
16   !!                 ! 1999-12  (V. Thierry, A-M. Treguier, M. Imbard, M-A. Foujols)  OPEN-MP
17   !!                 ! 2000-07  (J-M Molines, M. Imbard)  Open Boundary Conditions  (CLIPPER)
18   !!   NEMO     1.0  ! 2002-08  (G. Madec)  F90: Free form and modules
19   !!             -   ! 2004-06  (R. Redler, NEC CCRLE, Germany) add OASIS[3/4] coupled interfaces
20   !!             -   ! 2004-08  (C. Talandier) New trends organization
21   !!             -   ! 2005-06  (C. Ethe) Add the 1D configuration possibility
22   !!             -   ! 2005-11  (V. Garnier) Surface pressure gradient organization
23   !!             -   ! 2006-03  (L. Debreu, C. Mazauric)  Agrif implementation
24   !!             -   ! 2006-04  (G. Madec, R. Benshila)  Step reorganization
25   !!             -   ! 2007-07  (J. Chanut, A. Sellar) Unstructured open boundaries (BDY)
26   !!            3.2  ! 2009-08  (S. Masson)  open/write in the listing file in mpp
27   !!            3.3  ! 2010-05  (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface
28   !!             -   ! 2010-10  (C. Ethe, G. Madec) reorganisation of initialisation phase
29   !!            3.3.1! 2011-01  (A. R. Porter, STFC Daresbury) dynamical allocation
30   !!            3.4  ! 2011-11  (C. Harris) decomposition changes for running with CICE
31   !!----------------------------------------------------------------------
32
33   !!----------------------------------------------------------------------
34   !!   nemo_gcm       : solve ocean dynamics, tracer, biogeochemistry and/or sea-ice
35   !!   nemo_init      : initialization of the NEMO system
36   !!   nemo_ctl       : initialisation of the contol print
37   !!   nemo_closefile : close remaining open files
38   !!   nemo_alloc     : dynamical allocation
39   !!   nemo_partition : calculate MPP domain decomposition
40   !!   factorise      : calculate the factors of the no. of MPI processes
41   !!----------------------------------------------------------------------
42   USE step_oce        ! module used in the ocean time stepping module
43   USE sbc_oce         ! surface boundary condition: ocean
44   USE domcfg          ! domain configuration               (dom_cfg routine)
45   USE daymod          ! calendar
46   USE mppini          ! shared/distributed memory setting (mpp_init routine)
47   USE domain          ! domain initialization             (dom_init routine)
48   USE phycst          ! physical constant                  (par_cst routine)
49   USE step            ! NEMO time-stepping                 (stp     routine)
50   USE lib_mpp         ! distributed memory computing
51#if defined key_nosignedzero
52   USE lib_fortran     ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
53#endif
54#if defined key_iomput
55   USE xios
56#endif
57   USE cpl_oasis3
58   USE sbcssm
59   USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges
60   USE icbstp          ! handle bergs, calving, themodynamics and transport
61#if defined key_bdy
62   USE bdyini          ! open boundary cond. setting       (bdy_init routine). clem: mandatory for LIM3
63   USE bdydta          ! open boundary cond. setting   (bdy_dta_init routine). clem: mandatory for LIM3
64#endif
65   USE bdy_par
66
67   IMPLICIT NONE
68   PRIVATE
69
70   PUBLIC   nemo_gcm    ! called by model.F90
71   PUBLIC   nemo_init   ! needed by AGRIF
72
73   CHARACTER(lc) ::   cform_aaa="( /, 'AAAAAAAA', / ) "     ! flag for output listing
74
75   !!----------------------------------------------------------------------
76   !! NEMO/OPA 4.0 , NEMO Consortium (2011)
77   !! $Id$
78   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt)
79   !!----------------------------------------------------------------------
80CONTAINS
81
82   SUBROUTINE nemo_gcm
83      !!----------------------------------------------------------------------
84      !!                     ***  ROUTINE nemo_gcm  ***
85      !!
86      !! ** Purpose :   NEMO solves the primitive equations on an orthogonal
87      !!              curvilinear mesh on the sphere.
88      !!
89      !! ** Method  : - model general initialization
90      !!              - launch the time-stepping (stp routine)
91      !!              - finalize the run by closing files and communications
92      !!
93      !! References : Madec, Delecluse, Imbard, and Levy, 1997:  internal report, IPSL.
94      !!              Madec, 2008, internal report, IPSL.
95      !!----------------------------------------------------------------------
96      INTEGER ::   istp       ! time step index
97      !!----------------------------------------------------------------------
98      !
99#if defined key_agrif
100      CALL Agrif_Init_Grids()      ! AGRIF: set the meshes
101#endif
102
103      !                            !-----------------------!
104      CALL nemo_init               !==  Initialisations  ==!
105      !                            !-----------------------!
106#if defined key_agrif
107      CALL Agrif_Declare_Var_dom   ! AGRIF: set the meshes for DOM
108      CALL Agrif_Declare_Var       !  "      "   "   "      "  DYN/TRA
109# if defined key_top
110      CALL Agrif_Declare_Var_top   !  "      "   "   "      "  TOP
111# endif
112# if defined key_lim2
113      CALL Agrif_Declare_Var_lim2  !  "      "   "   "      "  LIM
114# endif
115#endif
116      ! check that all process are still there... If some process have an error,
117      ! they will never enter in step and other processes will wait until the end of the cpu time!
118      IF( lk_mpp )   CALL mpp_max( nstop )
119
120      IF(lwp) WRITE(numout,cform_aaa)   ! Flag AAAAAAA
121
122      !                            !-----------------------!
123      !                            !==   time stepping   ==!
124      !                            !-----------------------!
125      istp = nit000
126       
127      DO WHILE ( istp <= nitend .AND. nstop == 0 )
128#if defined key_agrif
129         CALL Agrif_Step( stp )           ! AGRIF: time stepping
130#else
131         CALL stp( istp )                 ! standard time stepping
132#endif
133         istp = istp + 1
134         IF( lk_mpp )   CALL mpp_max( nstop )
135      END DO
136      !
137      IF( ln_icebergs )   CALL icb_end( nitend )
138
139      !                            !------------------------!
140      !                            !==  finalize the run  ==!
141      !                            !------------------------!
142      IF(lwp) WRITE(numout,cform_aaa)   ! Flag AAAAAAA
143      !
144      IF( nstop /= 0 .AND. lwp ) THEN   ! error print
145         WRITE(numout,cform_err)
146         WRITE(numout,*) nstop, ' error have been found' 
147      ENDIF
148      !
149#if defined key_agrif
150      CALL Agrif_ParentGrid_To_ChildGrid()
151      IF( nn_timing == 1 )   CALL timing_finalize
152      CALL Agrif_ChildGrid_To_ParentGrid()
153#endif
154      IF( nn_timing == 1 )   CALL timing_finalize
155      !
156      CALL nemo_closefile
157      !
158#if defined key_iomput
159      CALL xios_finalize                ! end mpp communications with xios
160      IF( lk_oasis ) CALL cpl_finalize    ! end coupling and mpp communications with OASIS
161#else
162      IF( lk_oasis ) THEN
163         CALL cpl_finalize              ! end coupling and mpp communications with OASIS
164      ELSE
165         IF( lk_mpp )   CALL mppstop    ! end mpp communications
166      ENDIF
167#endif
168      !
169   END SUBROUTINE nemo_gcm
170
171
172   SUBROUTINE nemo_init
173      !!----------------------------------------------------------------------
174      !!                     ***  ROUTINE nemo_init  ***
175      !!
176      !! ** Purpose :   initialization of the NEMO GCM
177      !!----------------------------------------------------------------------
178      INTEGER ::   ji            ! dummy loop indices
179      INTEGER ::   ilocal_comm   ! local integer     
180      INTEGER ::   ios
181      CHARACTER(len=80), DIMENSION(16) ::   cltxt
182      CHARACTER(len=80) ::   clname
183      !
184      NAMELIST/namctl/ ln_ctl  , nn_print, nn_ictls, nn_ictle,   &
185         &             nn_isplt, nn_jsplt, nn_jctls, nn_jctle,   &
186         &             nn_bench, nn_timing
187      NAMELIST/namcfg/ cp_cfg, cp_cfz, jp_cfg, jpidta, jpjdta, jpkdta, jpiglo, jpjglo, &
188         &             jpizoom, jpjzoom, jperio, ln_use_jattr
189      !!----------------------------------------------------------------------
190      !
191      cltxt = ''
192      !
193      !                             ! Open reference namelist and configuration namelist files
194      IF( lk_oasis ) THEN
195         CALL ctl_opn( numnam_ref, 'namelist_sas_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
196         CALL ctl_opn( numnam_cfg, 'namelist_sas_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
197         cxios_context = 'sas'
198         clname = 'output.namelist_sas.dyn'
199      ELSE
200         CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
201         CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
202         cxios_context = 'nemo'
203         clname = 'output.namelist.dyn'
204   ENDIF
205      !
206      REWIND( numnam_ref )              ! Namelist namctl in reference namelist : Control prints & Benchmark
207      READ  ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 )
208901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. )
209
210      REWIND( numnam_cfg )              ! Namelist namctl in confguration namelist : Control prints & Benchmark
211      READ  ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 )
212902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. )
213
214      !
215      REWIND( numnam_ref )              ! Namelist namcfg in reference namelist : Control prints & Benchmark
216      READ  ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 )
217903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. )
218
219      REWIND( numnam_cfg )              ! Namelist namcfg in confguration namelist : Control prints & Benchmark
220      READ  ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 )
221904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )   
222
223! Force values for AGRIF zoom (cf. agrif_user.F90)
224#if defined key_agrif
225   IF( .NOT. Agrif_Root() ) THEN
226      jpiglo  = nbcellsx + 2 + 2*nbghostcells
227      jpjglo  = nbcellsy + 2 + 2*nbghostcells
228      jpi     = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci
229      jpj     = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj
230      jpidta  = jpiglo
231      jpjdta  = jpjglo
232      jpizoom = 1
233      jpjzoom = 1
234      nperio  = 0
235      jperio  = 0
236      ln_use_jattr = .false.
237   ENDIF
238#endif
239      !
240      !                             !--------------------------------------------!
241      !                             !  set communicator & select the local node  !
242      !                             !  NB: mynode also opens output.namelist.dyn !
243      !                             !      on unit number numond on first proc   !
244      !                             !--------------------------------------------!
245#if defined key_iomput
246      IF( Agrif_Root() ) THEN
247         IF( lk_oasis ) THEN
248            CALL cpl_init( "sas", ilocal_comm )                          ! nemo local communicator given by oasis
249            CALL xios_initialize( "not used",local_comm=ilocal_comm )    ! send nemo communicator to xios
250         ELSE
251            CALL xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm )        ! nemo local communicator given by xios
252         ENDIF
253      ENDIF
254      narea = mynode ( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )  ! Nodes selection
255#else
256      IF( lk_oasis ) THEN
257         IF( Agrif_Root() ) THEN
258            CALL cpl_init( "sas", ilocal_comm )                          ! nemo local communicator given by oasis
259         ENDIF
260         narea = mynode( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )   ! Nodes selection (control print return in cltxt)
261      ELSE
262         ilocal_comm = 0
263         narea = mynode( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop )                ! Nodes selection (control print return in cltxt)
264      ENDIF
265#endif
266      narea = narea + 1                                     ! mynode return the rank of proc (0 --> jpnij -1 )
267
268      lwm = (narea == 1)                                    ! control of output namelists
269      lwp = (narea == 1) .OR. ln_ctl                        ! control of all listing output print
270
271      IF(lwm) THEN
272         ! write merged namelists from earlier to output namelist now that the
273         ! file has been opened in call to mynode. nammpp has already been
274         ! written in mynode (if lk_mpp_mpi)
275         WRITE( numond, namctl )
276         WRITE( numond, namcfg )
277      ENDIF
278
279      ! If dimensions of processor grid weren't specified in the namelist file
280      ! then we calculate them here now that we have our communicator size
281      IF( (jpni < 1) .OR. (jpnj < 1) )THEN
282#if   defined key_mpp_mpi
283         IF( Agrif_Root() ) CALL nemo_partition(mppsize)
284#else
285         jpni  = 1
286         jpnj  = 1
287         jpnij = jpni*jpnj
288#endif
289      END IF
290
291      ! Calculate domain dimensions given calculated jpni and jpnj
292      ! This used to be done in par_oce.F90 when they were parameters rather
293      ! than variables
294      IF( Agrif_Root() ) THEN
295#if defined key_nemocice_decomp
296         jpi = ( nx_global+2-2*jpreci + (jpni-1) ) / jpni + 2*jpreci ! first  dim.
297         jpj = ( ny_global+2-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj ! second dim.
298#else
299         jpi = ( jpiglo-2*jpreci + (jpni-1) ) / jpni + 2*jpreci   ! first  dim.
300         jpj = ( jpjglo-2*jprecj + (jpnj-1) ) / jpnj + 2*jprecj   ! second dim.
301#endif
302      ENDIF
303         jpk = jpkdta                                             ! third dim
304         jpim1 = jpi-1                                            ! inner domain indices
305         jpjm1 = jpj-1                                            !   "           "
306         jpkm1 = jpk-1                                            !   "           "
307         jpij  = jpi*jpj                                          !  jpi x j
308
309      IF(lwp) THEN                            ! open listing units
310         !
311         IF( lk_oasis ) THEN
312            CALL ctl_opn( numout,   'sas.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
313         ELSE
314            CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
315         ENDIF
316         !
317         WRITE(numout,*)
318         WRITE(numout,*) '   CNRS - NERC - Met OFFICE - MERCATOR-ocean - INGV - CMCC'
319         WRITE(numout,*) '                       NEMO team'
320         WRITE(numout,*) '            Ocean General Circulation Model'
321         WRITE(numout,*) '                  version 3.6  (2015) '
322         WRITE(numout,*) '             StandAlone Surface version (SAS) '
323         WRITE(numout,*)
324         WRITE(numout,*)
325         DO ji = 1, SIZE(cltxt) 
326            IF( TRIM(cltxt(ji)) /= '' )   WRITE(numout,*) cltxt(ji)      ! control print of mynode
327         END DO
328         WRITE(numout,cform_aaa)                                         ! Flag AAAAAAA
329         !
330      ENDIF
331
332      ! Now we know the dimensions of the grid and numout has been set we can
333      ! allocate arrays
334      CALL nemo_alloc()
335
336      !                             !-------------------------------!
337      !                             !  NEMO general initialization  !
338      !                             !-------------------------------!
339
340      CALL nemo_ctl                          ! Control prints & Benchmark
341
342      !                                      ! Domain decomposition
343      IF( jpni*jpnj == jpnij ) THEN   ;   CALL mpp_init      ! standard cutting out
344      ELSE                            ;   CALL mpp_init2     ! eliminate land processors
345      ENDIF
346      !
347      IF( nn_timing == 1 )  CALL timing_init
348      !
349      !                                     ! General initialization
350                            CALL phy_cst    ! Physical constants
351                            CALL eos_init   ! Equation of state
352                            CALL dom_cfg    ! Domain configuration
353                            CALL dom_init   ! Domain
354
355      IF( ln_nnogather )    CALL nemo_northcomms   ! Initialise the northfold neighbour lists (must be done after the masks are defined)
356
357      IF( ln_ctl        )   CALL prt_ctl_init   ! Print control
358                            CALL day_init   ! model calendar (using both namelist and restart infos)
359
360                            CALL sbc_init   ! Forcings : surface module
361                           
362      ! ==> clem: open boundaries init. is mandatory for LIM3 because ice BDY is not decoupled from 
363      !           the environment of ocean BDY. Therefore bdy is called in both OPA and SAS modules.
364      !           This is not clean and should be changed in the future.
365      IF( lk_bdy        )   CALL     bdy_init
366      IF( lk_bdy        )   CALL bdy_dta_init
367      ! ==>
368     
369      IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler
370      !
371   END SUBROUTINE nemo_init
372
373
374   SUBROUTINE nemo_ctl
375      !!----------------------------------------------------------------------
376      !!                     ***  ROUTINE nemo_ctl  ***
377      !!
378      !! ** Purpose :   control print setting
379      !!
380      !! ** Method  : - print namctl information and check some consistencies
381      !!----------------------------------------------------------------------
382      !
383      IF(lwp) THEN                  ! control print
384         WRITE(numout,*)
385         WRITE(numout,*) 'nemo_ctl: Control prints & Benchmark'
386         WRITE(numout,*) '~~~~~~~ '
387         WRITE(numout,*) '   Namelist namctl'
388         WRITE(numout,*) '      run control (for debugging)     ln_ctl     = ', ln_ctl
389         WRITE(numout,*) '      level of print                  nn_print   = ', nn_print
390         WRITE(numout,*) '      Start i indice for SUM control  nn_ictls   = ', nn_ictls
391         WRITE(numout,*) '      End i indice for SUM control    nn_ictle   = ', nn_ictle
392         WRITE(numout,*) '      Start j indice for SUM control  nn_jctls   = ', nn_jctls
393         WRITE(numout,*) '      End j indice for SUM control    nn_jctle   = ', nn_jctle
394         WRITE(numout,*) '      number of proc. following i     nn_isplt   = ', nn_isplt
395         WRITE(numout,*) '      number of proc. following j     nn_jsplt   = ', nn_jsplt
396         WRITE(numout,*) '      benchmark parameter (0/1)       nn_bench   = ', nn_bench
397      ENDIF
398      !
399      nprint    = nn_print          ! convert DOCTOR namelist names into OLD names
400      nictls    = nn_ictls
401      nictle    = nn_ictle
402      njctls    = nn_jctls
403      njctle    = nn_jctle
404      isplt     = nn_isplt
405      jsplt     = nn_jsplt
406      nbench    = nn_bench
407
408      IF(lwp) THEN                  ! control print
409         WRITE(numout,*)
410         WRITE(numout,*) 'namcfg  : configuration initialization through namelist read'
411         WRITE(numout,*) '~~~~~~~ '
412         WRITE(numout,*) '   Namelist namcfg'
413         WRITE(numout,*) '      configuration name              cp_cfg      = ', TRIM(cp_cfg)
414         WRITE(numout,*) '      configuration zoom name         cp_cfz      = ', TRIM(cp_cfz)
415         WRITE(numout,*) '      configuration resolution        jp_cfg      = ', jp_cfg
416         WRITE(numout,*) '      1st lateral dimension ( >= jpi ) jpidta     = ', jpidta
417         WRITE(numout,*) '      2nd    "         "    ( >= jpj ) jpjdta     = ', jpjdta
418         WRITE(numout,*) '      3nd    "         "               jpkdta     = ', jpkdta
419         WRITE(numout,*) '      1st dimension of global domain in i jpiglo  = ', jpiglo
420         WRITE(numout,*) '      2nd    -                  -    in j jpjglo  = ', jpjglo
421         WRITE(numout,*) '      left bottom i index of the zoom (in data domain) jpizoom = ', jpizoom
422         WRITE(numout,*) '      left bottom j index of the zoom (in data domain) jpizoom = ', jpjzoom
423         WRITE(numout,*) '      lateral cond. type (between 0 and 6) jperio = ', jperio   
424         WRITE(numout,*) '      use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr
425      ENDIF
426      !                             ! Parameter control
427      !
428      IF( ln_ctl ) THEN                 ! sub-domain area indices for the control prints
429         IF( lk_mpp .AND. jpnij > 1 ) THEN
430            isplt = jpni   ;   jsplt = jpnj   ;   ijsplt = jpni*jpnj   ! the domain is forced to the real split domain
431         ELSE
432            IF( isplt == 1 .AND. jsplt == 1  ) THEN
433               CALL ctl_warn( ' - isplt & jsplt are equal to 1',   &
434                  &           ' - the print control will be done over the whole domain' )
435            ENDIF
436            ijsplt = isplt * jsplt            ! total number of processors ijsplt
437         ENDIF
438         IF(lwp) WRITE(numout,*)'          - The total number of processors over which the'
439         IF(lwp) WRITE(numout,*)'            print control will be done is ijsplt : ', ijsplt
440         !
441         !                              ! indices used for the SUM control
442         IF( nictls+nictle+njctls+njctle == 0 )   THEN    ! print control done over the default area
443            lsp_area = .FALSE.                       
444         ELSE                                             ! print control done over a specific  area
445            lsp_area = .TRUE.
446            IF( nictls < 1 .OR. nictls > jpiglo )   THEN
447               CALL ctl_warn( '          - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )
448               nictls = 1
449            ENDIF
450            IF( nictle < 1 .OR. nictle > jpiglo )   THEN
451               CALL ctl_warn( '          - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )
452               nictle = jpiglo
453            ENDIF
454            IF( njctls < 1 .OR. njctls > jpjglo )   THEN
455               CALL ctl_warn( '          - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )
456               njctls = 1
457            ENDIF
458            IF( njctle < 1 .OR. njctle > jpjglo )   THEN
459               CALL ctl_warn( '          - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )
460               njctle = jpjglo
461            ENDIF
462         ENDIF
463      ENDIF
464      !
465      IF( nbench == 1 ) THEN              ! Benchmark
466         SELECT CASE ( cp_cfg )
467         CASE ( 'gyre' )   ;   CALL ctl_warn( ' The Benchmark is activated ' )
468         CASE DEFAULT      ;   CALL ctl_stop( ' The Benchmark is based on the GYRE configuration:',   &
469            &                                 ' cp_cfg="gyre" in namelist &namcfg or set nbench = 0' )
470         END SELECT
471      ENDIF
472      !
473      IF( 1_wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ',  &
474         &                                               'f2003 standard. '                              ,  &
475         &                                               'Compile with key_nosignedzero enabled' )
476      !
477   END SUBROUTINE nemo_ctl
478
479
480   SUBROUTINE nemo_closefile
481      !!----------------------------------------------------------------------
482      !!                     ***  ROUTINE nemo_closefile  ***
483      !!
484      !! ** Purpose :   Close the files
485      !!----------------------------------------------------------------------
486      !
487      IF( lk_mpp )   CALL mppsync
488      !
489      CALL iom_close                                 ! close all input/output files managed by iom_*
490      !
491      IF( numstp          /= -1 )   CLOSE( numstp      )   ! time-step file     
492      IF( numnam_ref      /= -1 )   CLOSE( numnam_ref      )   ! oce reference namelist
493      IF( numnam_cfg      /= -1 )   CLOSE( numnam_cfg      )   ! oce configuration namelist
494      IF( lwm.AND.numond  /= -1 )   CLOSE( numond          )   ! oce output namelist
495      IF( numnam_ice_ref  /= -1 )   CLOSE( numnam_ice_ref  )   ! ice reference namelist
496      IF( numnam_ice_cfg  /= -1 )   CLOSE( numnam_ice_cfg  )   ! ice configuration namelist
497      IF( lwm.AND.numoni  /= -1 )   CLOSE( numoni          )   ! ice output namelist
498      IF( numevo_ice      /= -1 )   CLOSE( numevo_ice  )   ! ice variables (temp. evolution)
499      IF( numout          /=  6 )   CLOSE( numout      )   ! standard model output file
500      !
501      numout = 6                                     ! redefine numout in case it is used after this point...
502      !
503   END SUBROUTINE nemo_closefile
504
505
506   SUBROUTINE nemo_alloc
507      !!----------------------------------------------------------------------
508      !!                     ***  ROUTINE nemo_alloc  ***
509      !!
510      !! ** Purpose :   Allocate all the dynamic arrays of the OPA modules
511      !!
512      !! ** Method  :
513      !!----------------------------------------------------------------------
514      USE diawri    , ONLY: dia_wri_alloc
515      USE dom_oce   , ONLY: dom_oce_alloc
516#if defined key_bdy   
517      USE bdy_oce   , ONLY: bdy_oce_alloc
518      USE oce         ! clem: mandatory for LIM3 because needed for bdy arrays
519#else
520      USE oce       , ONLY : sshn, sshb, snwice_mass, snwice_mass_b, snwice_fmass
521#endif
522      !
523      INTEGER :: ierr,ierr1,ierr2,ierr3,ierr4,ierr5,ierr6
524      INTEGER :: jpm
525      !!----------------------------------------------------------------------
526      !
527      ierr =        dia_wri_alloc   ()
528      ierr = ierr + dom_oce_alloc   ()          ! ocean domain
529#if defined key_bdy
530      ierr = ierr + bdy_oce_alloc   ()          ! bdy masks (incl. initialization)
531      ierr = ierr + oce_alloc       ()          ! (tsn...)
532#endif
533
534#if ! defined key_bdy
535       ALLOCATE( snwice_mass(jpi,jpj)  , snwice_mass_b(jpi,jpj),             &
536         &      snwice_fmass(jpi,jpj)  , STAT= ierr1 )
537      !
538      ! lim code currently uses surface temperature and salinity in tsn array for initialisation
539      ! and ub, vb arrays in ice dynamics, so allocate enough of arrays to use
540      ! clem: should not be needed. To be checked out
541      jpm = MAX(jp_tem, jp_sal)
542      ALLOCATE( tsn(jpi,jpj,1,jpm)  , STAT=ierr2 )
543      ALLOCATE( ub(jpi,jpj,1)       , STAT=ierr3 )
544      ALLOCATE( vb(jpi,jpj,1)       , STAT=ierr4 )
545      ALLOCATE( tsb(jpi,jpj,1,jpm)  , STAT=ierr5 )
546      ALLOCATE( sshn(jpi,jpj)       , STAT=ierr6 )
547      ierr = ierr + ierr1 + ierr2 + ierr3 + ierr4 + ierr5 + ierr6 
548#endif
549      !
550      IF( lk_mpp    )   CALL mpp_sum( ierr )
551      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'nemo_alloc : unable to allocate standard ocean arrays' )
552      !
553   END SUBROUTINE nemo_alloc
554
555
556   SUBROUTINE nemo_partition( num_pes )
557      !!----------------------------------------------------------------------
558      !!                 ***  ROUTINE nemo_partition  ***
559      !!
560      !! ** Purpose :   
561      !!
562      !! ** Method  :
563      !!----------------------------------------------------------------------
564      INTEGER, INTENT(in) :: num_pes ! The number of MPI processes we have
565      !
566      INTEGER, PARAMETER :: nfactmax = 20
567      INTEGER :: nfact ! The no. of factors returned
568      INTEGER :: ierr  ! Error flag
569      INTEGER :: ji
570      INTEGER :: idiff, mindiff, imin ! For choosing pair of factors that are closest in value
571      INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors
572      !!----------------------------------------------------------------------
573      !
574      ierr = 0
575      !
576      CALL factorise( ifact, nfactmax, nfact, num_pes, ierr )
577      !
578      IF( nfact <= 1 ) THEN
579         WRITE (numout, *) 'WARNING: factorisation of number of PEs failed'
580         WRITE (numout, *) '       : using grid of ',num_pes,' x 1'
581         jpnj = 1
582         jpni = num_pes
583      ELSE
584         ! Search through factors for the pair that are closest in value
585         mindiff = 1000000
586         imin    = 1
587         DO ji = 1, nfact-1, 2
588            idiff = ABS( ifact(ji) - ifact(ji+1) )
589            IF( idiff < mindiff ) THEN
590               mindiff = idiff
591               imin = ji
592            ENDIF
593         END DO
594         jpnj = ifact(imin)
595         jpni = ifact(imin + 1)
596      ENDIF
597      !
598      jpnij = jpni*jpnj
599      !
600   END SUBROUTINE nemo_partition
601
602
603   SUBROUTINE factorise( kfax, kmaxfax, knfax, kn, kerr )
604      !!----------------------------------------------------------------------
605      !!                     ***  ROUTINE factorise  ***
606      !!
607      !! ** Purpose :   return the prime factors of n.
608      !!                knfax factors are returned in array kfax which is of
609      !!                maximum dimension kmaxfax.
610      !! ** Method  :
611      !!----------------------------------------------------------------------
612      INTEGER                    , INTENT(in   ) ::   kn, kmaxfax
613      INTEGER                    , INTENT(  out) ::   kerr, knfax
614      INTEGER, DIMENSION(kmaxfax), INTENT(  out) ::   kfax
615      !
616      INTEGER :: ifac, jl, inu
617      INTEGER, PARAMETER :: ntest = 14
618      INTEGER :: ilfax(ntest)
619      !
620      ! lfax contains the set of allowed factors.
621      data (ilfax(jl),jl=1,ntest) / 16384, 8192, 4096, 2048, 1024, 512, 256,  &
622         &                            128,   64,   32,   16,    8,   4,   2  /
623      !!----------------------------------------------------------------------
624
625      ! Clear the error flag and initialise output vars
626      kerr = 0
627      kfax = 1
628      knfax = 0
629
630      ! Find the factors of n.
631      IF( kn == 1 )   GOTO 20
632
633      ! nu holds the unfactorised part of the number.
634      ! knfax holds the number of factors found.
635      ! l points to the allowed factor list.
636      ! ifac holds the current factor.
637
638      inu   = kn
639      knfax = 0
640
641      DO jl = ntest, 1, -1
642         !
643         ifac = ilfax(jl)
644         IF( ifac > inu )   CYCLE
645
646         ! Test whether the factor will divide.
647
648         IF( MOD(inu,ifac) == 0 ) THEN
649            !
650            knfax = knfax + 1            ! Add the factor to the list
651            IF( knfax > kmaxfax ) THEN
652               kerr = 6
653               write (*,*) 'FACTOR: insufficient space in factor array ', knfax
654               return
655            ENDIF
656            kfax(knfax) = ifac
657            ! Store the other factor that goes with this one
658            knfax = knfax + 1
659            kfax(knfax) = inu / ifac
660            !WRITE (*,*) 'ARPDBG, factors ',knfax-1,' & ',knfax,' are ', kfax(knfax-1),' and ',kfax(knfax)
661         ENDIF
662         !
663      END DO
664
665   20 CONTINUE      ! Label 20 is the exit point from the factor search loop.
666      !
667   END SUBROUTINE factorise
668
669#if defined key_mpp_mpi
670   SUBROUTINE nemo_northcomms
671      !!======================================================================
672      !!                     ***  ROUTINE  nemo_northcomms  ***
673      !! nemo_northcomms    :  Setup for north fold exchanges with explicit
674      !!                       point-to-point messaging
675      !!=====================================================================
676      !!----------------------------------------------------------------------
677      !!
678      !! ** Purpose :   Initialization of the northern neighbours lists.
679      !!----------------------------------------------------------------------
680      !!    1.0  ! 2011-10  (A. C. Coward, NOCS & J. Donners, PRACE)
681      !!    2.0  ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC)
682      !!----------------------------------------------------------------------
683
684      INTEGER  ::   sxM, dxM, sxT, dxT, jn
685      INTEGER  ::   njmppmax
686
687      njmppmax = MAXVAL( njmppt )
688   
689      !initializes the north-fold communication variables
690      isendto(:) = 0
691      nsndto = 0
692
693      !if I am a process in the north
694      IF ( njmpp == njmppmax ) THEN
695          !sxM is the first point (in the global domain) needed to compute the
696          !north-fold for the current process
697          sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1
698          !dxM is the last point (in the global domain) needed to compute the
699          !north-fold for the current process
700          dxM = jpiglo - nimppt(narea) + 2
701
702          !loop over the other north-fold processes to find the processes
703          !managing the points belonging to the sxT-dxT range
704 
705          DO jn = 1, jpni
706                !sxT is the first point (in the global domain) of the jn
707                !process
708                sxT = nfiimpp(jn, jpnj)
709                !dxT is the last point (in the global domain) of the jn
710                !process
711                dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1
712                IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN
713                   nsndto = nsndto + 1
714                     isendto(nsndto) = jn
715                ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN
716                   nsndto = nsndto + 1
717                   isendto(nsndto) = jn
718                ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN
719                   nsndto = nsndto + 1
720                   isendto(nsndto) = jn
721                END IF
722          END DO
723          nfsloop = 1
724          nfeloop = nlci
725          DO jn = 2,jpni-1
726           IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN
727              IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN
728                 nfsloop = nldi
729              ENDIF
730              IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN
731                 nfeloop = nlei
732              ENDIF
733           ENDIF
734        END DO
735
736      ENDIF
737      l_north_nogather = .TRUE.
738   END SUBROUTINE nemo_northcomms
739
740#else
741   SUBROUTINE nemo_northcomms      ! Dummy routine
742      WRITE(*,*) 'nemo_northcomms: You should not have seen this print! error?'
743   END SUBROUTINE nemo_northcomms
744#endif
745   !!======================================================================
746END MODULE nemogcm
Note: See TracBrowser for help on using the repository browser.