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 trunk/NEMOGCM/NEMO/OPA_SRC – NEMO

Context Navigation

source: trunk/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90 @ 4627

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

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

Download in other formats: