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.

nemogcm.F90 in branches/2017/dev_r8126_ROBUST08_no_ghost/NEMOGCM/NEMO/OPA_SRC – NEMO

Context Navigation

source: branches/2017/dev_r8126_ROBUST08_no_ghost/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90 @ 8758

Last change on this file since 8758 was 8758, checked in by acc, 6 years ago
Branch 2017/dev_r8126_ROBUST08_no_ghost. Changes to eliminate ghost rows and columns. Currently the halo width is still fixed as 1 but a single variable (nn_hls) has been introduced for the halo-size in preparation for allowing this to vary. nn_hls replaces jpreci and jprecj. These changes have passed full SETTE tests but iceberg exchanges across the north-fold remain untested (SETTE tests only release bergs in the SO) and will require further attention. Note layout.dat now reports the jpi and jpj values for the reporting processor only.
Property svn:keywords set to `Id`
File size: 41.4 KB

Rev	Line
[2496]	1	MODULE nemogcm
[2442]	2	!!======================================================================
[2496]	3	!! * MODULE nemogcm *
	4	!! Ocean system : NEMO GCM (ocean dynamics, on-line tracers, biochemistry and sea-ice)
[2442]	5	!!======================================================================
[1593]	6	!! History : OPA ! 1990-10 (C. Levy, G. Madec) Original code
	7	!! 7.0 ! 1991-11 (M. Imbard, C. Levy, G. Madec)
[3764]	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
[1593]	10	!! - ! 1992-06 (L.Terray) coupling implementation
[3764]	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,
[2104]	13	!! P. Delecluse, L.Terray, M.A. Filiberti, J. Vialar, A.M. Treguier, M. Levy) release 8.0
[1593]	14	!! 8.1 ! 1997-06 (M. Imbard, G. Madec)
[3764]	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
[1593]	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
[3764]	27	!! 3.3 ! 2010-05 (K. Mogensen, A. Weaver, M. Martin, D. Lea) Assimilation interface
[2236]	28	!! - ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase
[3294]	29	!! 3.3.1! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation
[5836]	30	!! 3.4 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE) add nemo_northcomms
	31	!! - ! 2011-11 (C. Harris) decomposition changes for running with CICE
	32	!! 3.6 ! 2012-05 (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening
	33	!! - ! 2013-06 (I. Epicoco, S. Mocavero, CMCC) nemo_northcomms: setup avoiding MPI communication
	34	!! - ! 2014-12 (G. Madec) remove KPP scheme and cross-land advection (cla)
[7646]	35	!! 4.0 ! 2016-10 (G. Madec, S. Flavoni) domain configuration / user defined interface
[1593]	36	!!----------------------------------------------------------------------
[3]	37
	38	!!----------------------------------------------------------------------
[6140]	39	!! nemo_gcm : solve ocean dynamics, tracer, biogeochemistry and/or sea-ice
	40	!! nemo_init : initialization of the NEMO system
	41	!! nemo_ctl : initialisation of the contol print
	42	!! nemo_closefile: close remaining open files
	43	!! nemo_alloc : dynamical allocation
	44	!! nemo_partition: calculate MPP domain decomposition
	45	!! factorise : calculate the factors of the no. of MPI processes
[3]	46	!!----------------------------------------------------------------------
[6140]	47	USE step_oce ! module used in the ocean time stepping module (step.F90)
[7646]	48	USE phycst ! physical constant (par_cst routine)
	49	USE domain ! domain initialization (dom_init & dom_cfg routines)
	50	USE usrdef_nam ! user defined configuration
[6140]	51	USE tideini ! tidal components initialization (tide_ini routine)
[7646]	52	USE bdy_oce, ONLY: ln_bdy
[6140]	53	USE bdyini ! open boundary cond. setting (bdy_init routine)
	54	USE istate ! initial state setting (istate_init routine)
	55	USE ldfdyn ! lateral viscosity setting (ldfdyn_init routine)
	56	USE ldftra ! lateral diffusivity setting (ldftra_init routine)
	57	USE zdfini ! vertical physics setting (zdf_init routine)
	58	USE trdini ! dyn/tra trends initialization (trd_init routine)
	59	USE asminc ! assimilation increments
	60	USE asmbkg ! writing out state trajectory
	61	USE diaptr ! poleward transports (dia_ptr_init routine)
	62	USE diadct ! sections transports (dia_dct_init routine)
	63	USE diaobs ! Observation diagnostics (dia_obs_init routine)
	64	USE diacfl ! CFL diagnostics (dia_cfl_init routine)
	65	USE step ! NEMO time-stepping (stp routine)
	66	USE icbini ! handle bergs, initialisation
	67	USE icbstp ! handle bergs, calving, themodynamics and transport
	68	USE cpl_oasis3 ! OASIS3 coupling
	69	USE c1d ! 1D configuration
	70	USE step_c1d ! Time stepping loop for the 1D configuration
	71	USE dyndmp ! Momentum damping
	72	USE stopar ! Stochastic param.: ???
	73	USE stopts ! Stochastic param.: ???
[7646]	74	USE diurnal_bulk ! diurnal bulk SST
	75	USE step_diu ! diurnal bulk SST timestepping (called from here if run offline)
	76	USE crsini ! initialise grid coarsening utility
	77	USE diatmb ! Top,middle,bottom output
	78	USE dia25h ! 25h mean output
	79	USE sbc_oce , ONLY : lk_oasis
	80	USE wet_dry ! Wetting and drying setting (wad_init routine)
[1594]	81	#if defined key_top
[6140]	82	USE trcini ! passive tracer initialisation
[1594]	83	#endif
[7646]	84	#if defined key_nemocice_decomp
	85	USE ice_domain_size, only: nx_global, ny_global
	86	#endif
	87	!
[6140]	88	USE lib_mpp ! distributed memory computing
[7646]	89	USE mppini ! shared/distributed memory setting (mpp_init routine)
	90	USE lbcnfd , ONLY : isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges
	91	USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
[1412]	92	#if defined key_iomput
[6140]	93	USE xios ! xIOserver
[1359]	94	#endif
[268]	95
[2715]	96	IMPLICIT NONE
[3]	97	PRIVATE
	98
[2496]	99	PUBLIC nemo_gcm ! called by model.F90
	100	PUBLIC nemo_init ! needed by AGRIF
[3764]	101	PUBLIC nemo_alloc ! needed by TAM
[467]	102
[2498]	103	CHARACTER(lc) :: cform_aaa="( /, 'AAAAAAAA', / ) " ! flag for output listing
[1593]	104
[3]	105	!!----------------------------------------------------------------------
[7646]	106	!! NEMO/OPA 3.7 , NEMO Consortium (2016)
[2392]	107	!! $Id$
[2329]	108	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[3]	109	!!----------------------------------------------------------------------
	110	CONTAINS
	111
[2496]	112	SUBROUTINE nemo_gcm
[3]	113	!!----------------------------------------------------------------------
[2496]	114	!! * ROUTINE nemo_gcm *
[3]	115	!!
[3764]	116	!! ** Purpose : NEMO solves the primitive equations on an orthogonal
[1593]	117	!! curvilinear mesh on the sphere.
[3]	118	!!
	119	!! ** Method : - model general initialization
	120	!! - launch the time-stepping (stp routine)
[1593]	121	!! - finalize the run by closing files and communications
[3]	122	!!
[2715]	123	!! References : Madec, Delecluse, Imbard, and Levy, 1997: internal report, IPSL.
[1593]	124	!! Madec, 2008, internal report, IPSL.
[3]	125	!!----------------------------------------------------------------------
[7646]	126	INTEGER :: istp ! time step index
[389]	127	!!----------------------------------------------------------------------
[2382]	128	!
[392]	129	#if defined key_agrif
[1593]	130	CALL Agrif_Init_Grids() ! AGRIF: set the meshes
[389]	131	#endif
[7646]	132	!
[1593]	133	! !-----------------------!
[2496]	134	CALL nemo_init !== Initialisations ==!
[1593]	135	! !-----------------------!
[2715]	136	#if defined key_agrif
[3680]	137	CALL Agrif_Declare_Var_dom ! AGRIF: set the meshes for DOM
	138	CALL Agrif_Declare_Var ! " " " " " DYN/TRA
[2715]	139	# if defined key_top
[3680]	140	CALL Agrif_Declare_Var_top ! " " " " " TOP
[2715]	141	# endif
[3680]	142	# if defined key_lim2
[7646]	143	CALL Agrif_Declare_Var_lim2 ! " " " " " LIM2
[3680]	144	# endif
[7646]	145	# if defined key_lim3
	146	CALL Agrif_Declare_Var_lim3 ! " " " " " LIM3
	147	# endif
[2715]	148	#endif
[682]	149	! check that all process are still there... If some process have an error,
	150	! they will never enter in step and other processes will wait until the end of the cpu time!
[900]	151	IF( lk_mpp ) CALL mpp_max( nstop )
[682]	152
[1593]	153	IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA
	154
	155	! !-----------------------!
	156	! !== time stepping ==!
	157	! !-----------------------!
[900]	158	istp = nit000
[2236]	159	#if defined key_c1d
[389]	160	DO WHILE ( istp <= nitend .AND. nstop == 0 )
[900]	161	CALL stp_c1d( istp )
[389]	162	istp = istp + 1
	163	END DO
[2236]	164	#else
	165	IF( lk_asminc ) THEN
	166	IF( ln_bkgwri ) CALL asm_bkg_wri( nit000 - 1 ) ! Output background fields
	167	IF( ln_asmdin ) THEN ! Direct initialization
	168	IF( ln_trainc ) CALL tra_asm_inc( nit000 - 1 ) ! Tracers
[3764]	169	IF( ln_dyninc ) CALL dyn_asm_inc( nit000 - 1 ) ! Dynamics
[2236]	170	IF( ln_sshinc ) CALL ssh_asm_inc( nit000 - 1 ) ! SSH
	171	ENDIF
	172	ENDIF
[3764]	173
[5656]	174	#if defined key_agrif
	175	CALL Agrif_Regrid()
	176	#endif
	177
[389]	178	DO WHILE ( istp <= nitend .AND. nstop == 0 )
[392]	179	#if defined key_agrif
[5656]	180	CALL stp ! AGRIF: time stepping
[389]	181	#else
[6140]	182	IF ( .NOT. ln_diurnal_only ) THEN
	183	CALL stp( istp ) ! standard time stepping
	184	ELSE
	185	CALL stp_diurnal( istp ) ! time step only the diurnal SST
	186	ENDIF
[389]	187	#endif
	188	istp = istp + 1
[900]	189	IF( lk_mpp ) CALL mpp_max( nstop )
[389]	190	END DO
[2236]	191	#endif
	192
[6140]	193	IF( ln_diaobs ) CALL dia_obs_wri
[3609]	194	!
	195	IF( ln_icebergs ) CALL icb_end( nitend )
[3764]	196
[1593]	197	! !------------------------!
	198	! !== finalize the run ==!
	199	! !------------------------!
[7646]	200	IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA
[1593]	201	!
[7646]	202	IF( nstop /= 0 .AND. lwp ) THEN ! error print
[682]	203	WRITE(numout,cform_err)
[3764]	204	WRITE(numout,*) nstop, ' error have been found'
[389]	205	ENDIF
[1593]	206	!
[3294]	207	#if defined key_agrif
[6140]	208	IF( .NOT. Agrif_Root() ) THEN
	209	CALL Agrif_ParentGrid_To_ChildGrid()
	210	IF( ln_diaobs ) CALL dia_obs_wri
[5536]	211	IF( nn_timing == 1 ) CALL timing_finalize
[5836]	212	CALL Agrif_ChildGrid_To_ParentGrid()
[5536]	213	ENDIF
[3294]	214	#endif
	215	IF( nn_timing == 1 ) CALL timing_finalize
	216	!
[2496]	217	CALL nemo_closefile
[4990]	218	!
[3769]	219	#if defined key_iomput
[7646]	220	CALL xios_finalize ! end mpp communications with xios
	221	IF( lk_oasis ) CALL cpl_finalize ! end coupling and mpp communications with OASIS
[532]	222	#else
[5407]	223	IF( lk_oasis ) THEN
[7646]	224	CALL cpl_finalize ! end coupling and mpp communications with OASIS
[4990]	225	ELSE
[7646]	226	IF( lk_mpp ) CALL mppstop ! end mpp communications
[4990]	227	ENDIF
[532]	228	#endif
[900]	229	!
[2496]	230	END SUBROUTINE nemo_gcm
[389]	231
	232
[2496]	233	SUBROUTINE nemo_init
[389]	234	!!----------------------------------------------------------------------
[2496]	235	!! * ROUTINE nemo_init *
[389]	236	!!
[2496]	237	!! ** Purpose : initialization of the NEMO GCM
[389]	238	!!----------------------------------------------------------------------
[7646]	239	INTEGER :: ji ! dummy loop indices
	240	INTEGER :: ios, ilocal_comm ! local integer
[8758]	241	INTEGER :: iiarea, ijarea ! local integers
	242	INTEGER :: iirest, ijrest ! local integers
[7646]	243	CHARACTER(len=120), DIMENSION(30) :: cltxt, cltxt2, clnam
[4990]	244	!
[7646]	245	NAMELIST/namctl/ ln_ctl , nn_print, nn_ictls, nn_ictle, &
	246	& nn_isplt , nn_jsplt, nn_jctls, nn_jctle, &
	247	& nn_timing, nn_diacfl
	248	NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_write_cfg, cn_domcfg_out, ln_use_jattr
[3]	249	!!----------------------------------------------------------------------
[1593]	250	!
[7646]	251	cltxt = ''
	252	cltxt2 = ''
	253	clnam = ''
[5407]	254	cxios_context = 'nemo'
[2496]	255	!
[4147]	256	! ! Open reference namelist and configuration namelist files
	257	CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
	258	CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
[1593]	259	!
[7646]	260	REWIND( numnam_ref ) ! Namelist namctl in reference namelist : Control prints
[4147]	261	READ ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 )
[4289]	262	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. )
[7646]	263	!
	264	REWIND( numnam_cfg ) ! Namelist namctl in confguration namelist
[4147]	265	READ ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 )
[4289]	266	902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. )
[1593]	267	!
[7646]	268	REWIND( numnam_ref ) ! Namelist namcfg in reference namelist : Control prints
[4147]	269	READ ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 )
[4289]	270	903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. )
[4147]	271
	272	REWIND( numnam_cfg ) ! Namelist namcfg in confguration namelist : Control prints & Benchmark
	273	READ ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 )
[4289]	274	904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )
[4309]	275
[7646]	276	! !--------------------------!
	277	! ! Set global domain size ! (control print return in cltxt2)
	278	! !--------------------------!
	279	IF( ln_read_cfg ) THEN ! Read sizes in domain configuration file
	280	CALL domain_cfg ( cltxt2, cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )
	281	!
	282	ELSE ! user-defined namelist
	283	CALL usr_def_nam( cltxt2, clnam, cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )
	284	ENDIF
	285	!
	286	!
[1593]	287	! !--------------------------------------------!
	288	! ! set communicator & select the local node !
[4624]	289	! ! NB: mynode also opens output.namelist.dyn !
	290	! ! on unit number numond on first proc !
[1593]	291	! !--------------------------------------------!
[1412]	292	#if defined key_iomput
[2200]	293	IF( Agrif_Root() ) THEN
[5407]	294	IF( lk_oasis ) THEN
[7646]	295	CALL cpl_init( "oceanx", ilocal_comm ) ! nemo local communicator given by oasis
	296	CALL xios_initialize( "not used" ,local_comm= ilocal_comm ) ! send nemo communicator to xios
[4990]	297	ELSE
[7646]	298	CALL xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm ) ! nemo local communicator given by xios
[4990]	299	ENDIF
[2200]	300	ENDIF
[5407]	301	! Nodes selection (control print return in cltxt)
	302	narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )
[532]	303	#else
[5407]	304	IF( lk_oasis ) THEN
[4990]	305	IF( Agrif_Root() ) THEN
[7646]	306	CALL cpl_init( "oceanx", ilocal_comm ) ! nemo local communicator given by oasis
[4990]	307	ENDIF
[5407]	308	! Nodes selection (control print return in cltxt)
	309	narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop, ilocal_comm )
[4990]	310	ELSE
[7646]	311	ilocal_comm = 0 ! Nodes selection (control print return in cltxt)
[5407]	312	narea = mynode( cltxt, 'output.namelist.dyn', numnam_ref, numnam_cfg, numond , nstop )
[2236]	313	ENDIF
[532]	314	#endif
[7646]	315
[2715]	316	narea = narea + 1 ! mynode return the rank of proc (0 --> jpnij -1 )
[3]	317
[4624]	318	lwm = (narea == 1) ! control of output namelists
[2715]	319	lwp = (narea == 1) .OR. ln_ctl ! control of all listing output print
[1579]	320
[7646]	321	IF(lwm) THEN ! write merged namelists from earlier to output namelist
	322	! ! now that the file has been opened in call to mynode.
	323	! ! NB: nammpp has already been written in mynode (if lk_mpp_mpi)
[4624]	324	WRITE( numond, namctl )
	325	WRITE( numond, namcfg )
[7646]	326	IF( .NOT.ln_read_cfg ) THEN
	327	DO ji = 1, SIZE(clnam)
	328	IF( TRIM(clnam(ji)) /= '' ) WRITE(numond, * ) clnam(ji) ! namusr_def print
	329	END DO
	330	ENDIF
[4624]	331	ENDIF
	332
[3764]	333	! If dimensions of processor grid weren't specified in the namelist file
[2715]	334	! then we calculate them here now that we have our communicator size
[5836]	335	IF( jpni < 1 .OR. jpnj < 1 ) THEN
[2715]	336	#if defined key_mpp_mpi
[5836]	337	IF( Agrif_Root() ) CALL nemo_partition( mppsize )
[2715]	338	#else
	339	jpni = 1
	340	jpnj = 1
	341	jpnij = jpni*jpnj
	342	#endif
[5836]	343	ENDIF
[8758]	344	!
	345	#if defined key_agrif
	346	IF( .NOT. Agrif_Root() ) THEN ! AGRIF children: specific setting (cf. agrif_user.F90)
	347	jpiglo = nbcellsx + 2 + 2*nbghostcells
	348	jpjglo = nbcellsy + 2 + 2*nbghostcells
	349	jpi = ( jpiglo-2nn_hls + (jpni-1+0) ) / jpni + 2nn_hls
	350	jpj = ( jpjglo-2nn_hls + (jpnj-1+0) ) / jpnj + 2nn_hls
	351	jpimax = jpi
	352	jpjmax = jpj
	353	nperio = 0
	354	jperio = 0
	355	ln_use_jattr = .false.
	356	ENDIF
	357	#endif
[2715]	358
[7646]	359	IF( Agrif_Root() ) THEN ! AGRIF mother: specific setting from jpni and jpnj
[8758]	360	iiarea = 1 + MOD( narea - 1 , jpni )
	361	ijarea = 1 + ( narea - 1 ) / jpni
	362	iirest = 1 + MOD( jpiglo - 2*nn_hls - 1 , jpni )
	363	ijrest = 1 + MOD( jpjglo - 2*nn_hls - 1 , jpnj )
[3294]	364	#if defined key_nemocice_decomp
[8758]	365	jpi = ( nx_global+2-2nn_hls + (jpni-1) ) / jpni + 2nn_hls ! first dim.
	366	jpj = ( ny_global+2-2nn_hls + (jpnj-1) ) / jpnj + 2nn_hls ! second dim.
	367	jpimax = jpi
	368	jpjmax = jpj
	369	IF( iiarea == jpni ) jpi = jpiglo - (jpni - 1) * (jpi - 2*nn_hls)
	370	IF( ijarea == jpnj ) jpj = jpjglo - (jpnj - 1) * (jpj - 2*nn_hls)
[3294]	371	#else
[8758]	372	jpi = ( jpiglo -2nn_hls + (jpni-1) ) / jpni + 2nn_hls ! first dim.
	373	jpj = ( jpjglo -2nn_hls + (jpnj-1) ) / jpnj + 2nn_hls ! second dim.
	374	jpimax = jpi
	375	jpjmax = jpj
	376	IF( iiarea > iirest ) jpi = jpi - 1
	377	IF( ijarea > ijrest ) jpj = jpj - 1
[3294]	378	#endif
[7646]	379	ENDIF
	380
	381	jpk = jpkglo ! third dim
	382
[5656]	383	#if defined key_agrif
[7646]	384	! simple trick to use same vertical grid as parent but different number of levels:
	385	! Save maximum number of levels in jpkglo, then define all vertical grids with this number.
	386	! Suppress once vertical online interpolation is ok
	387	IF(.NOT.Agrif_Root()) jpkglo = Agrif_Parent( jpkglo )
[5656]	388	#endif
[7646]	389	jpim1 = jpi-1 ! inner domain indices
	390	jpjm1 = jpj-1 ! " "
[7761]	391	jpkm1 = MAX( 1, jpk-1 ) ! " "
[7646]	392	jpij = jpi*jpj ! jpi x j
[2715]	393
[1593]	394	IF(lwp) THEN ! open listing units
	395	!
[1581]	396	CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea )
[1593]	397	!
[1579]	398	WRITE(numout,*)
[3294]	399	WRITE(numout,*) ' CNRS - NERC - Met OFFICE - MERCATOR-ocean - INGV - CMCC'
[1593]	400	WRITE(numout,*) ' NEMO team'
[1579]	401	WRITE(numout,*) ' Ocean General Circulation Model'
[7646]	402	WRITE(numout,*) ' NEMO version 3.7 (2016) '
[1579]	403	WRITE(numout,*)
	404	WRITE(numout,*)
[3764]	405	DO ji = 1, SIZE(cltxt)
[7646]	406	IF( TRIM(cltxt (ji)) /= '' ) WRITE(numout,*) cltxt(ji) ! control print of mynode
[1579]	407	END DO
[7646]	408	WRITE(numout,*)
	409	WRITE(numout,*)
	410	DO ji = 1, SIZE(cltxt2)
	411	IF( TRIM(cltxt2(ji)) /= '' ) WRITE(numout,*) cltxt2(ji) ! control print of domain size
	412	END DO
[1593]	413	!
[7646]	414	WRITE(numout,cform_aaa) ! Flag AAAAAAA
	415	!
[473]	416	ENDIF
[2715]	417
[7646]	418	! Now we know the dimensions of the grid and numout has been set: we can allocate arrays
[2715]	419	CALL nemo_alloc()
	420
[2496]	421	! !-------------------------------!
	422	! ! NEMO general initialization !
	423	! !-------------------------------!
[473]	424
[7646]	425	CALL nemo_ctl ! Control prints
[531]	426
[2082]	427	! ! Domain decomposition
[8314]	428	CALL mpp_init
[8758]	429	IF( ln_nnogather ) CALL nemo_northcomms! northfold neighbour lists (must be done after the masks are defined)
[2382]	430	!
[3294]	431	IF( nn_timing == 1 ) CALL timing_init
	432	!
[2082]	433	! ! General initialization
[2027]	434	CALL phy_cst ! Physical constants
	435	CALL eos_init ! Equation of state
[4245]	436	IF( lk_c1d ) CALL c1d_init ! 1D column configuration
[6152]	437	CALL wad_init ! Wetting and drying options
[2027]	438	CALL dom_init ! Domain
[5836]	439	IF( ln_crs ) CALL crs_init ! coarsened grid: domain initialization
[8758]	440	!IF( ln_nnogather ) CALL nemo_northcomms! northfold neighbour lists (must be done after the masks are defined)
[2027]	441	IF( ln_ctl ) CALL prt_ctl_init ! Print control
[6140]	442
	443	CALL diurnal_sst_bulk_init ! diurnal sst
	444	IF ( ln_diurnal ) CALL diurnal_sst_coolskin_init ! cool skin
	445
	446	! IF ln_diurnal_only, then we only want a subset of the initialisation routines
	447	IF ( ln_diurnal_only ) THEN
	448	CALL istate_init ! ocean initial state (Dynamics and tracers)
	449	CALL sbc_init ! Forcings : surface module
	450	CALL tra_qsr_init ! penetrative solar radiation qsr
	451	IF( ln_diaobs ) THEN ! Observation & model comparison
	452	CALL dia_obs_init ! Initialize observational data
	453	CALL dia_obs( nit000 - 1 ) ! Observation operator for restart
	454	ENDIF
	455	! ! Assimilation increments
	456	IF( lk_asminc ) CALL asm_inc_init ! Initialize assimilation increments
	457
	458	IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler
	459	RETURN
	460	ENDIF
	461
[3651]	462	CALL istate_init ! ocean initial state (Dynamics and tracers)
	463
[5836]	464	! ! external forcing
	465	!!gm to be added : creation and call of sbc_apr_init
[7646]	466	CALL tide_init ! tidal harmonics
[5836]	467	CALL sbc_init ! surface boundary conditions (including sea-ice)
[7646]	468	CALL bdy_init ! Open boundaries initialisation
[5836]	469	! ! Ocean physics
[2082]	470	! ! Vertical physics
	471	CALL zdf_init ! namelist read
	472	CALL zdf_bfr_init ! bottom friction
	473	IF( lk_zdfric ) CALL zdf_ric_init ! Richardson number dependent Kz
[2329]	474	IF( lk_zdftke ) CALL zdf_tke_init ! TKE closure scheme
	475	IF( lk_zdfgls ) CALL zdf_gls_init ! GLS closure scheme
[2082]	476	IF( lk_zdftmx ) CALL zdf_tmx_init ! tidal vertical mixing
[5836]	477	IF( lk_zdfddm ) CALL zdf_ddm_init ! double diffusive mixing
	478
[2082]	479	! ! Lateral physics
	480	CALL ldf_tra_init ! Lateral ocean tracer physics
[5836]	481	CALL ldf_eiv_init ! eddy induced velocity param.
[2082]	482	CALL ldf_dyn_init ! Lateral ocean momentum physics
	483
[5836]	484	! ! Active tracers
	485	CALL tra_qsr_init ! penetrative solar radiation qsr
	486	CALL tra_bbc_init ! bottom heat flux
	487	IF( lk_trabbl ) CALL tra_bbl_init ! advective (and/or diffusive) bottom boundary layer scheme
	488	CALL tra_dmp_init ! internal tracer damping
	489	CALL tra_adv_init ! horizontal & vertical advection
	490	CALL tra_ldf_init ! lateral mixing
	491	CALL tra_zdf_init ! vertical mixing and after tracer fields
[2027]	492
[5836]	493	! ! Dynamics
	494	IF( lk_c1d ) CALL dyn_dmp_init ! internal momentum damping
	495	CALL dyn_adv_init ! advection (vector or flux form)
	496	CALL dyn_vor_init ! vorticity term including Coriolis
	497	CALL dyn_ldf_init ! lateral mixing
	498	CALL dyn_hpg_init ! horizontal gradient of Hydrostatic pressure
	499	CALL dyn_zdf_init ! vertical diffusion
	500	CALL dyn_spg_init ! surface pressure gradient
[3764]	501
[5836]	502	#if defined key_top
	503	! ! Passive tracers
	504	CALL trc_init
	505	#endif
	506	IF( l_ldfslp ) CALL ldf_slp_init ! slope of lateral mixing
	507
	508	! ! Icebergs
[3609]	509	CALL icb_init( rdt, nit000) ! initialise icebergs instance
[5836]	510
	511	! ! Misc. options
[5329]	512	CALL sto_par_init ! Stochastic parametrization
	513	IF( ln_sto_eos ) CALL sto_pts_init ! RRandom T/S fluctuations
[4147]	514
[5836]	515	! ! Diagnostics
[3294]	516	IF( lk_floats ) CALL flo_init ! drifting Floats
[6140]	517	CALL dia_cfl_init ! Initialise CFL diagnostics
[2027]	518	CALL dia_ptr_init ! Poleward TRansports initialization
[3294]	519	IF( lk_diadct ) CALL dia_dct_init ! Sections tranports
[2148]	520	CALL dia_hsb_init ! heat content, salt content and volume budgets
[4990]	521	CALL trd_init ! Mixed-layer/Vorticity/Integral constraints trends
[2382]	522	CALL dia_obs_init ! Initialize observational data
[6140]	523	IF( ln_diaobs ) CALL dia_obs( nit000 - 1 ) ! Observation operator for restart
	524
	525	! ! Assimilation increments
[2392]	526	IF( lk_asminc ) CALL asm_inc_init ! Initialize assimilation increments
[2382]	527	IF(lwp) WRITE(numout,*) 'Euler time step switch is ', neuler
[6140]	528	CALL dia_tmb_init ! TMB outputs
	529	CALL dia_25h_init ! 25h mean outputs
[1593]	530	!
[2496]	531	END SUBROUTINE nemo_init
[467]	532
	533
[2496]	534	SUBROUTINE nemo_ctl
[467]	535	!!----------------------------------------------------------------------
[2496]	536	!! * ROUTINE nemo_ctl *
[467]	537	!!
[3764]	538	!! ** Purpose : control print setting
[467]	539	!!
[2442]	540	!! ** Method : - print namctl information and check some consistencies
[467]	541	!!----------------------------------------------------------------------
[2442]	542	!
[2496]	543	IF(lwp) THEN ! control print
[531]	544	WRITE(numout,*)
[7646]	545	WRITE(numout,*) 'nemo_ctl: Control prints'
[531]	546	WRITE(numout,*) '~~~~~~~ '
[1593]	547	WRITE(numout,*) ' Namelist namctl'
[1601]	548	WRITE(numout,*) ' run control (for debugging) ln_ctl = ', ln_ctl
	549	WRITE(numout,*) ' level of print nn_print = ', nn_print
	550	WRITE(numout,*) ' Start i indice for SUM control nn_ictls = ', nn_ictls
	551	WRITE(numout,*) ' End i indice for SUM control nn_ictle = ', nn_ictle
	552	WRITE(numout,*) ' Start j indice for SUM control nn_jctls = ', nn_jctls
	553	WRITE(numout,*) ' End j indice for SUM control nn_jctle = ', nn_jctle
	554	WRITE(numout,*) ' number of proc. following i nn_isplt = ', nn_isplt
	555	WRITE(numout,*) ' number of proc. following j nn_jsplt = ', nn_jsplt
[3610]	556	WRITE(numout,*) ' timing activated (0/1) nn_timing = ', nn_timing
[531]	557	ENDIF
[2442]	558	!
[1601]	559	nprint = nn_print ! convert DOCTOR namelist names into OLD names
	560	nictls = nn_ictls
	561	nictle = nn_ictle
	562	njctls = nn_jctls
	563	njctle = nn_jctle
	564	isplt = nn_isplt
	565	jsplt = nn_jsplt
[4147]	566
	567	IF(lwp) THEN ! control print
	568	WRITE(numout,*)
[7646]	569	WRITE(numout,*) 'namcfg : configuration initialization through namelist read'
	570	WRITE(numout,*) '~~~~~~ '
[4147]	571	WRITE(numout,*) ' Namelist namcfg'
[7646]	572	WRITE(numout,*) ' read domain configuration file ln_read_cfg = ', ln_read_cfg
	573	WRITE(numout,*) ' filename to be read cn_domcfg = ', TRIM(cn_domcfg)
	574	WRITE(numout,*) ' write configuration definition file ln_write_cfg = ', ln_write_cfg
	575	WRITE(numout,*) ' filename to be written cn_domcfg_out = ', TRIM(cn_domcfg_out)
	576	WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr
[4147]	577	ENDIF
[2442]	578	! ! Parameter control
[1593]	579	!
	580	IF( ln_ctl ) THEN ! sub-domain area indices for the control prints
[3294]	581	IF( lk_mpp .AND. jpnij > 1 ) THEN
[2496]	582	isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj ! the domain is forced to the real split domain
[531]	583	ELSE
	584	IF( isplt == 1 .AND. jsplt == 1 ) THEN
[1593]	585	CALL ctl_warn( ' - isplt & jsplt are equal to 1', &
	586	& ' - the print control will be done over the whole domain' )
[531]	587	ENDIF
[1593]	588	ijsplt = isplt * jsplt ! total number of processors ijsplt
[531]	589	ENDIF
	590	IF(lwp) WRITE(numout,*)' - The total number of processors over which the'
	591	IF(lwp) WRITE(numout,*)' print control will be done is ijsplt : ', ijsplt
[1593]	592	!
	593	! ! indices used for the SUM control
	594	IF( nictls+nictle+njctls+njctle == 0 ) THEN ! print control done over the default area
[3764]	595	lsp_area = .FALSE.
[1593]	596	ELSE ! print control done over a specific area
[531]	597	lsp_area = .TRUE.
	598	IF( nictls < 1 .OR. nictls > jpiglo ) THEN
	599	CALL ctl_warn( ' - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )
	600	nictls = 1
	601	ENDIF
	602	IF( nictle < 1 .OR. nictle > jpiglo ) THEN
	603	CALL ctl_warn( ' - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )
	604	nictle = jpiglo
	605	ENDIF
	606	IF( njctls < 1 .OR. njctls > jpjglo ) THEN
	607	CALL ctl_warn( ' - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )
	608	njctls = 1
	609	ENDIF
	610	IF( njctle < 1 .OR. njctle > jpjglo ) THEN
	611	CALL ctl_warn( ' - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )
	612	njctle = jpjglo
	613	ENDIF
[1593]	614	ENDIF
	615	ENDIF
[2442]	616	!
[3764]	617	IF( 1_wp /= SIGN(1._wp,-0._wp) ) CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ', &
	618	& 'f2003 standard. ' , &
	619	& 'Compile with key_nosignedzero enabled' )
	620	!
[2496]	621	END SUBROUTINE nemo_ctl
[467]	622
	623
[2496]	624	SUBROUTINE nemo_closefile
[467]	625	!!----------------------------------------------------------------------
[2496]	626	!! * ROUTINE nemo_closefile *
[467]	627	!!
	628	!! ** Purpose : Close the files
	629	!!----------------------------------------------------------------------
[1593]	630	!
	631	IF( lk_mpp ) CALL mppsync
	632	!
[1685]	633	CALL iom_close ! close all input/output files managed by iom_*
[1593]	634	!
[4147]	635	IF( numstp /= -1 ) CLOSE( numstp ) ! time-step file
[8170]	636	IF( numrun /= -1 ) CLOSE( numrun ) ! run statistics file
[4147]	637	IF( numnam_ref /= -1 ) CLOSE( numnam_ref ) ! oce reference namelist
	638	IF( numnam_cfg /= -1 ) CLOSE( numnam_cfg ) ! oce configuration namelist
[4624]	639	IF( lwm.AND.numond /= -1 ) CLOSE( numond ) ! oce output namelist
[4147]	640	IF( numnam_ice_ref /= -1 ) CLOSE( numnam_ice_ref ) ! ice reference namelist
	641	IF( numnam_ice_cfg /= -1 ) CLOSE( numnam_ice_cfg ) ! ice configuration namelist
[4624]	642	IF( lwm.AND.numoni /= -1 ) CLOSE( numoni ) ! ice output namelist
[4147]	643	IF( numevo_ice /= -1 ) CLOSE( numevo_ice ) ! ice variables (temp. evolution)
	644	IF( numout /= 6 ) CLOSE( numout ) ! standard model output file
	645	IF( numdct_vol /= -1 ) CLOSE( numdct_vol ) ! volume transports
	646	IF( numdct_heat /= -1 ) CLOSE( numdct_heat ) ! heat transports
	647	IF( numdct_salt /= -1 ) CLOSE( numdct_salt ) ! salt transports
[1593]	648	!
[2442]	649	numout = 6 ! redefine numout in case it is used after this point...
	650	!
[2496]	651	END SUBROUTINE nemo_closefile
[467]	652
[2715]	653
	654	SUBROUTINE nemo_alloc
	655	!!----------------------------------------------------------------------
	656	!! * ROUTINE nemo_alloc *
	657	!!
	658	!! ** Purpose : Allocate all the dynamic arrays of the OPA modules
	659	!!
	660	!! ** Method :
	661	!!----------------------------------------------------------------------
	662	USE diawri , ONLY: dia_wri_alloc
	663	USE dom_oce , ONLY: dom_oce_alloc
	664	USE trc_oce , ONLY: trc_oce_alloc
[3680]	665	#if defined key_diadct
	666	USE diadct , ONLY: diadct_alloc
	667	#endif
[4354]	668	USE bdy_oce , ONLY: bdy_oce_alloc
[2715]	669	!
	670	INTEGER :: ierr
	671	!!----------------------------------------------------------------------
	672	!
[7646]	673	ierr = oce_alloc () ! ocean
[2715]	674	ierr = ierr + dia_wri_alloc ()
	675	ierr = ierr + dom_oce_alloc () ! ocean domain
	676	ierr = ierr + zdf_oce_alloc () ! ocean vertical physics
	677	!
	678	ierr = ierr + trc_oce_alloc () ! shared TRC / TRA arrays
	679	!
[3680]	680	#if defined key_diadct
	681	ierr = ierr + diadct_alloc () !
	682	#endif
[4354]	683	ierr = ierr + bdy_oce_alloc () ! bdy masks (incl. initialization)
[3680]	684	!
[2715]	685	IF( lk_mpp ) CALL mpp_sum( ierr )
	686	IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'nemo_alloc : unable to allocate standard ocean arrays' )
	687	!
	688	END SUBROUTINE nemo_alloc
	689
	690
	691	SUBROUTINE nemo_partition( num_pes )
	692	!!----------------------------------------------------------------------
	693	!! * ROUTINE nemo_partition *
	694	!!
[3764]	695	!! ** Purpose :
[2715]	696	!!
	697	!! ** Method :
	698	!!----------------------------------------------------------------------
[4990]	699	INTEGER, INTENT(in) :: num_pes ! The number of MPI processes we have
[2715]	700	!
	701	INTEGER, PARAMETER :: nfactmax = 20
	702	INTEGER :: nfact ! The no. of factors returned
	703	INTEGER :: ierr ! Error flag
	704	INTEGER :: ji
	705	INTEGER :: idiff, mindiff, imin ! For choosing pair of factors that are closest in value
	706	INTEGER, DIMENSION(nfactmax) :: ifact ! Array of factors
	707	!!----------------------------------------------------------------------
[4990]	708	!
[2715]	709	ierr = 0
[4990]	710	!
[2715]	711	CALL factorise( ifact, nfactmax, nfact, num_pes, ierr )
[4990]	712	!
[2715]	713	IF( nfact <= 1 ) THEN
	714	WRITE (numout, *) 'WARNING: factorisation of number of PEs failed'
	715	WRITE (numout, *) ' : using grid of ',num_pes,' x 1'
	716	jpnj = 1
	717	jpni = num_pes
	718	ELSE
	719	! Search through factors for the pair that are closest in value
	720	mindiff = 1000000
	721	imin = 1
	722	DO ji = 1, nfact-1, 2
	723	idiff = ABS( ifact(ji) - ifact(ji+1) )
	724	IF( idiff < mindiff ) THEN
	725	mindiff = idiff
	726	imin = ji
	727	ENDIF
	728	END DO
	729	jpnj = ifact(imin)
	730	jpni = ifact(imin + 1)
	731	ENDIF
	732	!
	733	jpnij = jpni*jpnj
	734	!
	735	END SUBROUTINE nemo_partition
	736
	737
	738	SUBROUTINE factorise( kfax, kmaxfax, knfax, kn, kerr )
	739	!!----------------------------------------------------------------------
	740	!! * ROUTINE factorise *
	741	!!
	742	!! ** Purpose : return the prime factors of n.
[3764]	743	!! knfax factors are returned in array kfax which is of
[2715]	744	!! maximum dimension kmaxfax.
	745	!! ** Method :
	746	!!----------------------------------------------------------------------
	747	INTEGER , INTENT(in ) :: kn, kmaxfax
	748	INTEGER , INTENT( out) :: kerr, knfax
	749	INTEGER, DIMENSION(kmaxfax), INTENT( out) :: kfax
	750	!
	751	INTEGER :: ifac, jl, inu
	752	INTEGER, PARAMETER :: ntest = 14
[5836]	753	INTEGER, DIMENSION(ntest) :: ilfax
[5656]	754	!!----------------------------------------------------------------------
[5836]	755	!
[2715]	756	! lfax contains the set of allowed factors.
[5656]	757	ilfax(:) = (/(2**jl,jl=ntest,1,-1)/)
[5836]	758	!
[2715]	759	! Clear the error flag and initialise output vars
[5836]	760	kerr = 0
	761	kfax = 1
[2715]	762	knfax = 0
[5836]	763	!
[2715]	764	! Find the factors of n.
	765	IF( kn == 1 ) GOTO 20
	766
	767	! nu holds the unfactorised part of the number.
	768	! knfax holds the number of factors found.
	769	! l points to the allowed factor list.
	770	! ifac holds the current factor.
[5836]	771	!
[2715]	772	inu = kn
	773	knfax = 0
[5836]	774	!
[2715]	775	DO jl = ntest, 1, -1
	776	!
	777	ifac = ilfax(jl)
	778	IF( ifac > inu ) CYCLE
	779
	780	! Test whether the factor will divide.
	781
	782	IF( MOD(inu,ifac) == 0 ) THEN
	783	!
	784	knfax = knfax + 1 ! Add the factor to the list
	785	IF( knfax > kmaxfax ) THEN
	786	kerr = 6
	787	write (,) 'FACTOR: insufficient space in factor array ', knfax
	788	return
	789	ENDIF
	790	kfax(knfax) = ifac
	791	! Store the other factor that goes with this one
	792	knfax = knfax + 1
	793	kfax(knfax) = inu / ifac
	794	!WRITE (,) 'ARPDBG, factors ',knfax-1,' & ',knfax,' are ', kfax(knfax-1),' and ',kfax(knfax)
	795	ENDIF
	796	!
	797	END DO
[5836]	798	!
[2715]	799	20 CONTINUE ! Label 20 is the exit point from the factor search loop.
	800	!
	801	END SUBROUTINE factorise
	802
[3294]	803	#if defined key_mpp_mpi
[4990]	804
[3294]	805	SUBROUTINE nemo_northcomms
[5836]	806	!!----------------------------------------------------------------------
[3294]	807	!! * ROUTINE nemo_northcomms *
[5836]	808	!! ** Purpose : Setup for north fold exchanges with explicit
	809	!! point-to-point messaging
[3764]	810	!!
[5836]	811	!! ** Method : Initialization of the northern neighbours lists.
[3294]	812	!!----------------------------------------------------------------------
[3764]	813	!! 1.0 ! 2011-10 (A. C. Coward, NOCS & J. Donners, PRACE)
[4230]	814	!! 2.0 ! 2013-06 Setup avoiding MPI communication (I. Epicoco, S. Mocavero, CMCC)
[3294]	815	!!----------------------------------------------------------------------
[4230]	816	INTEGER :: sxM, dxM, sxT, dxT, jn
	817	INTEGER :: njmppmax
[5836]	818	!!----------------------------------------------------------------------
	819	!
[4230]	820	njmppmax = MAXVAL( njmppt )
[5836]	821	!
[4230]	822	!initializes the north-fold communication variables
	823	isendto(:) = 0
[5836]	824	nsndto = 0
	825	!
[4230]	826	!if I am a process in the north
	827	IF ( njmpp == njmppmax ) THEN
	828	!sxM is the first point (in the global domain) needed to compute the
	829	!north-fold for the current process
	830	sxM = jpiglo - nimppt(narea) - nlcit(narea) + 1
	831	!dxM is the last point (in the global domain) needed to compute the
	832	!north-fold for the current process
	833	dxM = jpiglo - nimppt(narea) + 2
[3294]	834
[4230]	835	!loop over the other north-fold processes to find the processes
	836	!managing the points belonging to the sxT-dxT range
[4671]	837
	838	DO jn = 1, jpni
[4230]	839	!sxT is the first point (in the global domain) of the jn
	840	!process
[4671]	841	sxT = nfiimpp(jn, jpnj)
[4230]	842	!dxT is the last point (in the global domain) of the jn
	843	!process
[4671]	844	dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1
[4230]	845	IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN
	846	nsndto = nsndto + 1
[7646]	847	isendto(nsndto) = jn
[4645]	848	ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN
[4230]	849	nsndto = nsndto + 1
[7646]	850	isendto(nsndto) = jn
[4230]	851	ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN
	852	nsndto = nsndto + 1
[7646]	853	isendto(nsndto) = jn
	854	ENDIF
[4230]	855	END DO
[4671]	856	nfsloop = 1
	857	nfeloop = nlci
	858	DO jn = 2,jpni-1
	859	IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN
	860	IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN
	861	nfsloop = nldi
	862	ENDIF
	863	IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN
	864	nfeloop = nlei
	865	ENDIF
	866	ENDIF
	867	END DO
	868
[3294]	869	ENDIF
[4230]	870	l_north_nogather = .TRUE.
[3294]	871	END SUBROUTINE nemo_northcomms
[5836]	872
[3294]	873	#else
	874	SUBROUTINE nemo_northcomms ! Dummy routine
	875	WRITE(,) 'nemo_northcomms: You should not have seen this print! error?'
	876	END SUBROUTINE nemo_northcomms
	877	#endif
[4990]	878
[3]	879	!!======================================================================
[2496]	880	END MODULE nemogcm
[4354]	881

Note: See TracBrowser for help on using the repository browser.

Download in other formats: