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 NEMO/branches/2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles/src/OCE – NEMO

Context Navigation

source: NEMO/branches/2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles/src/OCE/nemogcm.F90 @ 11844

Last change on this file since 11844 was 11648, checked in by acc, 5 years ago
Branch 2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles. Introduce broadcast of namelist character buffer from single reader to all others. This completes the second stage but there is still an issue with AGRIF that may scupper this whole concept
Property svn:keywords set to `Id`
File size: 34.6 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)
[9656]	15	!! 8.2 ! 1999-11 (M. Imbard, H. Goosse) sea-ice model
[3764]	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	!! - ! 2011-11 (C. Harris) decomposition changes for running with CICE
	31	!! 3.6 ! 2012-05 (C. Calone, J. Simeon, G. Madec, C. Ethe) Add grid coarsening
	32	!! - ! 2014-12 (G. Madec) remove KPP scheme and cross-land advection (cla)
[7646]	33	!! 4.0 ! 2016-10 (G. Madec, S. Flavoni) domain configuration / user defined interface
[1593]	34	!!----------------------------------------------------------------------
[3]	35
	36	!!----------------------------------------------------------------------
[6140]	37	!! nemo_gcm : solve ocean dynamics, tracer, biogeochemistry and/or sea-ice
	38	!! nemo_init : initialization of the NEMO system
	39	!! nemo_ctl : initialisation of the contol print
	40	!! nemo_closefile: close remaining open files
	41	!! nemo_alloc : dynamical allocation
[3]	42	!!----------------------------------------------------------------------
[6140]	43	USE step_oce ! module used in the ocean time stepping module (step.F90)
[7646]	44	USE phycst ! physical constant (par_cst routine)
	45	USE domain ! domain initialization (dom_init & dom_cfg routines)
[9161]	46	USE closea ! treatment of closed seas (for ln_closea)
[7646]	47	USE usrdef_nam ! user defined configuration
[6140]	48	USE tideini ! tidal components initialization (tide_ini routine)
[9019]	49	USE bdy_oce, ONLY : ln_bdy
[6140]	50	USE bdyini ! open boundary cond. setting (bdy_init routine)
	51	USE istate ! initial state setting (istate_init routine)
	52	USE ldfdyn ! lateral viscosity setting (ldfdyn_init routine)
	53	USE ldftra ! lateral diffusivity setting (ldftra_init routine)
	54	USE trdini ! dyn/tra trends initialization (trd_init routine)
	55	USE asminc ! assimilation increments
	56	USE asmbkg ! writing out state trajectory
	57	USE diaptr ! poleward transports (dia_ptr_init routine)
	58	USE diadct ! sections transports (dia_dct_init routine)
	59	USE diaobs ! Observation diagnostics (dia_obs_init routine)
	60	USE diacfl ! CFL diagnostics (dia_cfl_init routine)
[11536]	61	USE diaharm ! tidal harmonics diagnostics (dia_harm_init routine)
[6140]	62	USE step ! NEMO time-stepping (stp routine)
	63	USE icbini ! handle bergs, initialisation
	64	USE icbstp ! handle bergs, calving, themodynamics and transport
	65	USE cpl_oasis3 ! OASIS3 coupling
	66	USE c1d ! 1D configuration
	67	USE step_c1d ! Time stepping loop for the 1D configuration
	68	USE dyndmp ! Momentum damping
	69	USE stopar ! Stochastic param.: ???
	70	USE stopts ! Stochastic param.: ???
[7646]	71	USE diurnal_bulk ! diurnal bulk SST
	72	USE step_diu ! diurnal bulk SST timestepping (called from here if run offline)
	73	USE crsini ! initialise grid coarsening utility
	74	USE diatmb ! Top,middle,bottom output
	75	USE dia25h ! 25h mean output
	76	USE sbc_oce , ONLY : lk_oasis
	77	USE wet_dry ! Wetting and drying setting (wad_init routine)
[1594]	78	#if defined key_top
[6140]	79	USE trcini ! passive tracer initialisation
[1594]	80	#endif
[7646]	81	#if defined key_nemocice_decomp
	82	USE ice_domain_size, only: nx_global, ny_global
	83	#endif
	84	!
[6140]	85	USE lib_mpp ! distributed memory computing
[7646]	86	USE mppini ! shared/distributed memory setting (mpp_init routine)
[9213]	87	USE lbcnfd , ONLY : isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges
[7646]	88	USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
[1412]	89	#if defined key_iomput
[6140]	90	USE xios ! xIOserver
[1359]	91	#endif
[9780]	92	#if defined key_agrif
	93	USE agrif_all_update ! Master Agrif update
	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
[10425]	105	#if defined key_mpp_mpi
[11536]	106	! need MPI_Wtime
[10425]	107	INCLUDE 'mpif.h'
	108	#endif
	109
[3]	110	!!----------------------------------------------------------------------
[9570]	111	!! NEMO/OCE 4.0 , NEMO Consortium (2018)
[2392]	112	!! $Id$
[10068]	113	!! Software governed by the CeCILL license (see ./LICENSE)
[3]	114	!!----------------------------------------------------------------------
	115	CONTAINS
	116
[2496]	117	SUBROUTINE nemo_gcm
[3]	118	!!----------------------------------------------------------------------
[2496]	119	!! * ROUTINE nemo_gcm *
[3]	120	!!
[3764]	121	!! ** Purpose : NEMO solves the primitive equations on an orthogonal
[1593]	122	!! curvilinear mesh on the sphere.
[3]	123	!!
	124	!! ** Method : - model general initialization
	125	!! - launch the time-stepping (stp routine)
[1593]	126	!! - finalize the run by closing files and communications
[3]	127	!!
[2715]	128	!! References : Madec, Delecluse, Imbard, and Levy, 1997: internal report, IPSL.
[1593]	129	!! Madec, 2008, internal report, IPSL.
[3]	130	!!----------------------------------------------------------------------
[7646]	131	INTEGER :: istp ! time step index
[11536]	132	REAL(wp):: zstptiming ! elapsed time for 1 time step
[389]	133	!!----------------------------------------------------------------------
[2382]	134	!
[392]	135	#if defined key_agrif
[1593]	136	CALL Agrif_Init_Grids() ! AGRIF: set the meshes
[389]	137	#endif
[1593]	138	! !-----------------------!
[2496]	139	CALL nemo_init !== Initialisations ==!
[1593]	140	! !-----------------------!
[2715]	141	#if defined key_agrif
[3680]	142	CALL Agrif_Declare_Var_dom ! AGRIF: set the meshes for DOM
	143	CALL Agrif_Declare_Var ! " " " " " DYN/TRA
[2715]	144	# if defined key_top
[3680]	145	CALL Agrif_Declare_Var_top ! " " " " " TOP
[2715]	146	# endif
[9570]	147	# if defined key_si3
[9611]	148	CALL Agrif_Declare_Var_ice ! " " " " " Sea ice
[7646]	149	# endif
[2715]	150	#endif
[682]	151	! check that all process are still there... If some process have an error,
	152	! they will never enter in step and other processes will wait until the end of the cpu time!
[10425]	153	CALL mpp_max( 'nemogcm', nstop )
[682]	154
[1593]	155	IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA
	156
	157	! !-----------------------!
	158	! !== time stepping ==!
	159	! !-----------------------!
[900]	160	istp = nit000
[9210]	161	!
[2236]	162	#if defined key_c1d
[9210]	163	DO WHILE ( istp <= nitend .AND. nstop == 0 ) !== C1D time-stepping ==!
	164	CALL stp_c1d( istp )
	165	istp = istp + 1
	166	END DO
[2236]	167	#else
[9210]	168	!
	169	# if defined key_agrif
	170	! !== AGRIF time-stepping ==!
	171	CALL Agrif_Regrid()
[9213]	172	!
[9780]	173	! Recursive update from highest nested level to lowest:
	174	CALL Agrif_step_child_adj(Agrif_Update_All)
	175	!
[9210]	176	DO WHILE( istp <= nitend .AND. nstop == 0 )
	177	CALL stp
	178	istp = istp + 1
	179	END DO
	180	!
	181	IF( .NOT. Agrif_Root() ) THEN
	182	CALL Agrif_ParentGrid_To_ChildGrid()
	183	IF( ln_diaobs ) CALL dia_obs_wri
	184	IF( ln_timing ) CALL timing_finalize
	185	CALL Agrif_ChildGrid_To_ParentGrid()
	186	ENDIF
	187	!
	188	# else
	189	!
	190	IF( .NOT.ln_diurnal_only ) THEN !== Standard time-stepping ==!
	191	!
	192	DO WHILE( istp <= nitend .AND. nstop == 0 )
[11536]	193
[10425]	194	ncom_stp = istp
[11536]	195	IF( ln_timing ) THEN
	196	zstptiming = MPI_Wtime()
	197	IF ( istp == ( nit000 + 1 ) ) elapsed_time = zstptiming
	198	IF ( istp == nitend ) elapsed_time = zstptiming - elapsed_time
	199	ENDIF
	200
[9210]	201	CALL stp ( istp )
[389]	202	istp = istp + 1
[11536]	203
	204	IF( lwp .AND. ln_timing ) WRITE(numtime,*) 'timing step ', istp-1, ' : ', MPI_Wtime() - zstptiming
	205
[389]	206	END DO
[9210]	207	!
	208	ELSE !== diurnal SST time-steeping only ==!
	209	!
	210	DO WHILE( istp <= nitend .AND. nstop == 0 )
	211	CALL stp_diurnal( istp ) ! time step only the diurnal SST
	212	istp = istp + 1
	213	END DO
	214	!
	215	ENDIF
	216	!
	217	# endif
	218	!
[2236]	219	#endif
[9210]	220	!
[6140]	221	IF( ln_diaobs ) CALL dia_obs_wri
[3609]	222	!
	223	IF( ln_icebergs ) CALL icb_end( nitend )
[3764]	224
[1593]	225	! !------------------------!
	226	! !== finalize the run ==!
	227	! !------------------------!
[7646]	228	IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA
[1593]	229	!
[7646]	230	IF( nstop /= 0 .AND. lwp ) THEN ! error print
[11536]	231	WRITE(ctmp1,*) ' ==>>> nemo_gcm: a total of ', nstop, ' errors have been found'
	232	CALL ctl_stop( ctmp1 )
[389]	233	ENDIF
[1593]	234	!
[9124]	235	IF( ln_timing ) CALL timing_finalize
[3294]	236	!
[2496]	237	CALL nemo_closefile
[4990]	238	!
[3769]	239	#if defined key_iomput
[9210]	240	CALL xios_finalize ! end mpp communications with xios
	241	IF( lk_oasis ) CALL cpl_finalize ! end coupling and mpp communications with OASIS
[532]	242	#else
[9210]	243	IF ( lk_oasis ) THEN ; CALL cpl_finalize ! end coupling and mpp communications with OASIS
[11536]	244	ELSEIF( lk_mpp ) THEN ; CALL mppstop ! end mpp communications
[4990]	245	ENDIF
[532]	246	#endif
[900]	247	!
[10436]	248	IF(lwm) THEN
	249	IF( nstop == 0 ) THEN ; STOP 0
[11536]	250	ELSE ; STOP 123
[10436]	251	ENDIF
[10425]	252	ENDIF
	253	!
[2496]	254	END SUBROUTINE nemo_gcm
[389]	255
	256
[2496]	257	SUBROUTINE nemo_init
[389]	258	!!----------------------------------------------------------------------
[2496]	259	!! * ROUTINE nemo_init *
[389]	260	!!
[2496]	261	!! ** Purpose : initialization of the NEMO GCM
[389]	262	!!----------------------------------------------------------------------
[11536]	263	INTEGER :: ios, ilocal_comm ! local integers
[9213]	264	!!
[10570]	265	NAMELIST/namctl/ ln_ctl , sn_cfctl, nn_print, nn_ictls, nn_ictle, &
	266	& nn_isplt , nn_jsplt, nn_jctls, nn_jctle, &
[9019]	267	& ln_timing, ln_diacfl
[9213]	268	NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr
[3]	269	!!----------------------------------------------------------------------
[1593]	270	!
[5407]	271	cxios_context = 'nemo'
[2496]	272	!
[11536]	273	! !-------------------------------------------------!
	274	! ! set communicator & select the local rank !
	275	! ! must be done as soon as possible to get narea !
	276	! !-------------------------------------------------!
[1593]	277	!
[1412]	278	#if defined key_iomput
[2200]	279	IF( Agrif_Root() ) THEN
[5407]	280	IF( lk_oasis ) THEN
[7646]	281	CALL cpl_init( "oceanx", ilocal_comm ) ! nemo local communicator given by oasis
[11536]	282	CALL xios_initialize( "not used" , local_comm =ilocal_comm ) ! send nemo communicator to xios
[4990]	283	ELSE
[11536]	284	CALL xios_initialize( "for_xios_mpi_id", return_comm=ilocal_comm ) ! nemo local communicator given by xios
[4990]	285	ENDIF
[2200]	286	ENDIF
[11536]	287	CALL mpp_start( ilocal_comm )
[532]	288	#else
[5407]	289	IF( lk_oasis ) THEN
[4990]	290	IF( Agrif_Root() ) THEN
[7646]	291	CALL cpl_init( "oceanx", ilocal_comm ) ! nemo local communicator given by oasis
[4990]	292	ENDIF
[11536]	293	CALL mpp_start( ilocal_comm )
[4990]	294	ELSE
[11536]	295	CALL mpp_start( )
[2236]	296	ENDIF
[532]	297	#endif
[11536]	298	!
	299	narea = mpprank + 1 ! mpprank: the rank of proc (0 --> mppsize -1 )
	300	lwm = (narea == 1) ! control of output namelists
	301	!
	302	! !---------------------------------------------------------------!
	303	! ! Open output files, reference and configuration namelist files !
	304	! !---------------------------------------------------------------!
	305	!
	306	! open ocean.output as soon as possible to get all output prints (including errors messages)
	307	IF( lwm ) CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
	308	! open reference and configuration namelist files
[11648]	309	CALL load_nml( numnam_ref, 'namelist_ref', -1, lwm )
	310	CALL load_nml( numnam_cfg, 'namelist_cfg', -1, lwm )
[11536]	311	IF( lwm ) CALL ctl_opn( numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
	312	! open /dev/null file to be able to supress output write easily
	313	CALL ctl_opn( numnul, '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
	314	!
	315	! !--------------------!
	316	! ! Open listing units ! -> need ln_ctl from namctl to define lwp
	317	! !--------------------!
	318	!
	319	READ ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 )
	320	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist' )
	321	READ ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 )
	322	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist' )
	323	!
	324	lwp = (narea == 1) .OR. ln_ctl ! control of all listing output print
	325	!
	326	IF(lwp) THEN ! open listing units
[1593]	327	!
[11536]	328	IF( .NOT. lwm ) & ! alreay opened for narea == 1
	329	& CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE., narea )
[1593]	330	!
[1579]	331	WRITE(numout,*)
[11536]	332	WRITE(numout,*) ' CNRS - NERC - Met OFFICE - MERCATOR-ocean - CMCC'
[1593]	333	WRITE(numout,*) ' NEMO team'
[1579]	334	WRITE(numout,*) ' Ocean General Circulation Model'
[10510]	335	WRITE(numout,*) ' NEMO version 4.0 (2019) '
[1579]	336	WRITE(numout,*)
[10510]	337	WRITE(numout,*) " ._ ._ ._ ._ ._ "
	338	WRITE(numout,*) " _.-._)`\_.-._)`\_.-._)`\_.-._)`\_.-._)`\_ "
[1579]	339	WRITE(numout,*)
[10510]	340	WRITE(numout,*) " o _, _, "
	341	WRITE(numout,*) " o .' ( .-' / "
	342	WRITE(numout,*) " o _/..._'. .' / "
	343	WRITE(numout,*) " ( o .-'` ` '-./ _.' "
	344	WRITE(numout,*) " ) ( o) ;= <_ ( "
	345	WRITE(numout,*) " ( '-.,\\__ __.-;`\ '. ) "
	346	WRITE(numout,*) " ) ) \) \|`\ \) '. \ ( ( "
	347	WRITE(numout,*) " ( ( \_/ '-._\ ) ) "
[10583]	348	WRITE(numout,*) " ) ) jgs ` ( ( "
[10510]	349	WRITE(numout,*) " ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ "
	350	WRITE(numout,*)
[1593]	351	!
[7646]	352	WRITE(numout,cform_aaa) ! Flag AAAAAAA
	353	!
[473]	354	ENDIF
[10425]	355	!
[11536]	356	! finalize the definition of namctl variables
	357	IF( sn_cfctl%l_config ) THEN
	358	! Activate finer control of report outputs
	359	! optionally switch off output from selected areas (note this only
	360	! applies to output which does not involve global communications)
	361	IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax ) .OR. &
	362	& ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) ) &
	363	& CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. )
	364	ELSE
	365	! Use ln_ctl to turn on or off all options.
	366	CALL nemo_set_cfctl( sn_cfctl, ln_ctl, .TRUE. )
	367	ENDIF
	368	!
	369	IF(lwm) WRITE( numond, namctl )
	370	!
	371	! !------------------------------------!
	372	! ! Set global domain size parameters !
	373	! !------------------------------------!
	374	!
	375	READ ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 )
	376	903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist' )
	377	READ ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 )
	378	904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist' )
	379	!
	380	IF( ln_read_cfg ) THEN ! Read sizes in domain configuration file
	381	CALL domain_cfg ( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )
	382	ELSE ! user-defined namelist
	383	CALL usr_def_nam( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )
	384	ENDIF
	385	!
	386	IF(lwm) WRITE( numond, namcfg )
	387	!
	388	! !-----------------------------------------!
	389	! ! mpp parameters and domain decomposition !
	390	! !-----------------------------------------!
	391	CALL mpp_init
[2715]	392
[7646]	393	! Now we know the dimensions of the grid and numout has been set: we can allocate arrays
[2715]	394	CALL nemo_alloc()
	395
[2496]	396	! !-------------------------------!
	397	! ! NEMO general initialization !
	398	! !-------------------------------!
[473]	399
[7646]	400	CALL nemo_ctl ! Control prints
[2382]	401	!
[9213]	402	! ! General initialization
	403	IF( ln_timing ) CALL timing_init ! timing
	404	IF( ln_timing ) CALL timing_start( 'nemo_init')
[3294]	405	!
[9367]	406	CALL phy_cst ! Physical constants
	407	CALL eos_init ! Equation of state
	408	IF( lk_c1d ) CALL c1d_init ! 1D column configuration
	409	CALL wad_init ! Wetting and drying options
	410	CALL dom_init("OPA") ! Domain
	411	IF( ln_crs ) CALL crs_init ! coarsened grid: domain initialization
	412	IF( ln_ctl ) CALL prt_ctl_init ! Print control
[6140]	413
[9213]	414	CALL diurnal_sst_bulk_init ! diurnal sst
	415	IF( ln_diurnal ) CALL diurnal_sst_coolskin_init ! cool skin
	416	!
	417	IF( ln_diurnal_only ) THEN ! diurnal only: a subset of the initialisation routines
	418	CALL istate_init ! ocean initial state (Dynamics and tracers)
	419	CALL sbc_init ! Forcings : surface module
	420	CALL tra_qsr_init ! penetrative solar radiation qsr
	421	IF( ln_diaobs ) THEN ! Observation & model comparison
	422	CALL dia_obs_init ! Initialize observational data
	423	CALL dia_obs( nit000 - 1 ) ! Observation operator for restart
[6140]	424	ENDIF
[9213]	425	IF( lk_asminc ) CALL asm_inc_init ! Assimilation increments
	426	!
	427	RETURN ! end of initialization
[6140]	428	ENDIF
	429
[9213]	430	CALL istate_init ! ocean initial state (Dynamics and tracers)
[3651]	431
[5836]	432	! ! external forcing
[9213]	433	CALL tide_init ! tidal harmonics
	434	CALL sbc_init ! surface boundary conditions (including sea-ice)
	435	CALL bdy_init ! Open boundaries initialisation
[9019]	436
[5836]	437	! ! Ocean physics
[9019]	438	CALL zdf_phy_init ! Vertical physics
	439
[2082]	440	! ! Lateral physics
[9019]	441	CALL ldf_tra_init ! Lateral ocean tracer physics
	442	CALL ldf_eiv_init ! eddy induced velocity param.
	443	CALL ldf_dyn_init ! Lateral ocean momentum physics
[2082]	444
[9019]	445	! ! Active tracers
	446	IF( ln_traqsr ) CALL tra_qsr_init ! penetrative solar radiation qsr
	447	CALL tra_bbc_init ! bottom heat flux
[10350]	448	CALL tra_bbl_init ! advective (and/or diffusive) bottom boundary layer scheme
[9019]	449	CALL tra_dmp_init ! internal tracer damping
	450	CALL tra_adv_init ! horizontal & vertical advection
	451	CALL tra_ldf_init ! lateral mixing
[2027]	452
[9019]	453	! ! Dynamics
	454	IF( lk_c1d ) CALL dyn_dmp_init ! internal momentum damping
	455	CALL dyn_adv_init ! advection (vector or flux form)
	456	CALL dyn_vor_init ! vorticity term including Coriolis
	457	CALL dyn_ldf_init ! lateral mixing
	458	CALL dyn_hpg_init ! horizontal gradient of Hydrostatic pressure
	459	CALL dyn_spg_init ! surface pressure gradient
[3764]	460
[5836]	461	#if defined key_top
	462	! ! Passive tracers
[9019]	463	CALL trc_init
[5836]	464	#endif
[9019]	465	IF( l_ldfslp ) CALL ldf_slp_init ! slope of lateral mixing
[5836]	466
	467	! ! Icebergs
[9019]	468	CALL icb_init( rdt, nit000) ! initialise icebergs instance
[5836]	469
	470	! ! Misc. options
[9019]	471	CALL sto_par_init ! Stochastic parametrization
	472	IF( ln_sto_eos ) CALL sto_pts_init ! RRandom T/S fluctuations
[4147]	473
[5836]	474	! ! Diagnostics
[11536]	475	CALL flo_init ! drifting Floats
[9019]	476	IF( ln_diacfl ) CALL dia_cfl_init ! Initialise CFL diagnostics
	477	CALL dia_ptr_init ! Poleward TRansports initialization
[11536]	478	CALL dia_dct_init ! Sections tranports
[9019]	479	CALL dia_hsb_init ! heat content, salt content and volume budgets
	480	CALL trd_init ! Mixed-layer/Vorticity/Integral constraints trends
	481	CALL dia_obs_init ! Initialize observational data
[9213]	482	CALL dia_tmb_init ! TMB outputs
	483	CALL dia_25h_init ! 25h mean outputs
[11536]	484	CALL dia_harm_init ! tidal harmonics outputs
	485	IF( ln_diaobs ) CALL dia_obs( nit000-1 ) ! Observation operator for restart
[6140]	486
[9019]	487	! ! Assimilation increments
	488	IF( lk_asminc ) CALL asm_inc_init ! Initialize assimilation increments
[1593]	489	!
[9213]	490	IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA
	491	!
	492	IF( ln_timing ) CALL timing_stop( 'nemo_init')
	493	!
[2496]	494	END SUBROUTINE nemo_init
[467]	495
	496
[2496]	497	SUBROUTINE nemo_ctl
[467]	498	!!----------------------------------------------------------------------
[2496]	499	!! * ROUTINE nemo_ctl *
[467]	500	!!
[3764]	501	!! ** Purpose : control print setting
[467]	502	!!
[11536]	503	!! ** Method : - print namctl and namcfg information and check some consistencies
[467]	504	!!----------------------------------------------------------------------
[2442]	505	!
[2496]	506	IF(lwp) THEN ! control print
[531]	507	WRITE(numout,*)
[7646]	508	WRITE(numout,*) 'nemo_ctl: Control prints'
[9213]	509	WRITE(numout,*) '~~~~~~~~'
[1593]	510	WRITE(numout,*) ' Namelist namctl'
[1601]	511	WRITE(numout,*) ' run control (for debugging) ln_ctl = ', ln_ctl
[10570]	512	WRITE(numout,*) ' finer control over o/p sn_cfctl%l_config = ', sn_cfctl%l_config
	513	WRITE(numout,*) ' sn_cfctl%l_runstat = ', sn_cfctl%l_runstat
	514	WRITE(numout,*) ' sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat
	515	WRITE(numout,*) ' sn_cfctl%l_oceout = ', sn_cfctl%l_oceout
	516	WRITE(numout,*) ' sn_cfctl%l_layout = ', sn_cfctl%l_layout
	517	WRITE(numout,*) ' sn_cfctl%l_mppout = ', sn_cfctl%l_mppout
	518	WRITE(numout,*) ' sn_cfctl%l_mpptop = ', sn_cfctl%l_mpptop
	519	WRITE(numout,*) ' sn_cfctl%procmin = ', sn_cfctl%procmin
	520	WRITE(numout,*) ' sn_cfctl%procmax = ', sn_cfctl%procmax
	521	WRITE(numout,*) ' sn_cfctl%procincr = ', sn_cfctl%procincr
	522	WRITE(numout,*) ' sn_cfctl%ptimincr = ', sn_cfctl%ptimincr
[1601]	523	WRITE(numout,*) ' level of print nn_print = ', nn_print
	524	WRITE(numout,*) ' Start i indice for SUM control nn_ictls = ', nn_ictls
	525	WRITE(numout,*) ' End i indice for SUM control nn_ictle = ', nn_ictle
	526	WRITE(numout,*) ' Start j indice for SUM control nn_jctls = ', nn_jctls
	527	WRITE(numout,*) ' End j indice for SUM control nn_jctle = ', nn_jctle
	528	WRITE(numout,*) ' number of proc. following i nn_isplt = ', nn_isplt
	529	WRITE(numout,*) ' number of proc. following j nn_jsplt = ', nn_jsplt
[9019]	530	WRITE(numout,*) ' timing by routine ln_timing = ', ln_timing
	531	WRITE(numout,*) ' CFL diagnostics ln_diacfl = ', ln_diacfl
[531]	532	ENDIF
[2442]	533	!
[1601]	534	nprint = nn_print ! convert DOCTOR namelist names into OLD names
	535	nictls = nn_ictls
	536	nictle = nn_ictle
	537	njctls = nn_jctls
	538	njctle = nn_jctle
	539	isplt = nn_isplt
[9213]	540	jsplt = nn_jsplt
[4147]	541
	542	IF(lwp) THEN ! control print
	543	WRITE(numout,*)
	544	WRITE(numout,*) ' Namelist namcfg'
[7646]	545	WRITE(numout,*) ' read domain configuration file ln_read_cfg = ', ln_read_cfg
	546	WRITE(numout,*) ' filename to be read cn_domcfg = ', TRIM(cn_domcfg)
[9213]	547	WRITE(numout,*) ' keep closed seas in the domain (if exist) ln_closea = ', ln_closea
	548	WRITE(numout,*) ' create a configuration definition file ln_write_cfg = ', ln_write_cfg
[7646]	549	WRITE(numout,*) ' filename to be written cn_domcfg_out = ', TRIM(cn_domcfg_out)
	550	WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr
[4147]	551	ENDIF
[9213]	552	IF( .NOT.ln_read_cfg ) ln_closea = .false. ! dealing possible only with a domcfg file
	553	!
[2442]	554	! ! Parameter control
[1593]	555	!
	556	IF( ln_ctl ) THEN ! sub-domain area indices for the control prints
[3294]	557	IF( lk_mpp .AND. jpnij > 1 ) THEN
[2496]	558	isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj ! the domain is forced to the real split domain
[531]	559	ELSE
	560	IF( isplt == 1 .AND. jsplt == 1 ) THEN
[1593]	561	CALL ctl_warn( ' - isplt & jsplt are equal to 1', &
	562	& ' - the print control will be done over the whole domain' )
[531]	563	ENDIF
[1593]	564	ijsplt = isplt * jsplt ! total number of processors ijsplt
[531]	565	ENDIF
	566	IF(lwp) WRITE(numout,*)' - The total number of processors over which the'
	567	IF(lwp) WRITE(numout,*)' print control will be done is ijsplt : ', ijsplt
[1593]	568	!
	569	! ! indices used for the SUM control
	570	IF( nictls+nictle+njctls+njctle == 0 ) THEN ! print control done over the default area
[3764]	571	lsp_area = .FALSE.
[1593]	572	ELSE ! print control done over a specific area
[531]	573	lsp_area = .TRUE.
	574	IF( nictls < 1 .OR. nictls > jpiglo ) THEN
	575	CALL ctl_warn( ' - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )
	576	nictls = 1
	577	ENDIF
	578	IF( nictle < 1 .OR. nictle > jpiglo ) THEN
	579	CALL ctl_warn( ' - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )
	580	nictle = jpiglo
	581	ENDIF
	582	IF( njctls < 1 .OR. njctls > jpjglo ) THEN
	583	CALL ctl_warn( ' - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )
	584	njctls = 1
	585	ENDIF
	586	IF( njctle < 1 .OR. njctle > jpjglo ) THEN
	587	CALL ctl_warn( ' - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )
	588	njctle = jpjglo
	589	ENDIF
[1593]	590	ENDIF
	591	ENDIF
[2442]	592	!
[9213]	593	IF( 1._wp /= SIGN(1._wp,-0._wp) ) CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows f2003 standard.', &
[10425]	594	& 'Compile with key_nosignedzero enabled:', &
	595	& '--> add -Dkey_nosignedzero to the definition of %CPP in your arch file' )
[3764]	596	!
[9023]	597	#if defined key_agrif
[9124]	598	IF( ln_timing ) CALL ctl_stop( 'AGRIF not implemented with ln_timing = true')
[9023]	599	#endif
	600	!
[2496]	601	END SUBROUTINE nemo_ctl
[467]	602
	603
[2496]	604	SUBROUTINE nemo_closefile
[467]	605	!!----------------------------------------------------------------------
[2496]	606	!! * ROUTINE nemo_closefile *
[467]	607	!!
	608	!! ** Purpose : Close the files
	609	!!----------------------------------------------------------------------
[1593]	610	!
	611	IF( lk_mpp ) CALL mppsync
	612	!
[1685]	613	CALL iom_close ! close all input/output files managed by iom_*
[1593]	614	!
[4147]	615	IF( numstp /= -1 ) CLOSE( numstp ) ! time-step file
[9019]	616	IF( numrun /= -1 ) CLOSE( numrun ) ! run statistics file
[4624]	617	IF( lwm.AND.numond /= -1 ) CLOSE( numond ) ! oce output namelist
	618	IF( lwm.AND.numoni /= -1 ) CLOSE( numoni ) ! ice output namelist
[4147]	619	IF( numevo_ice /= -1 ) CLOSE( numevo_ice ) ! ice variables (temp. evolution)
	620	IF( numout /= 6 ) CLOSE( numout ) ! standard model output file
	621	IF( numdct_vol /= -1 ) CLOSE( numdct_vol ) ! volume transports
	622	IF( numdct_heat /= -1 ) CLOSE( numdct_heat ) ! heat transports
	623	IF( numdct_salt /= -1 ) CLOSE( numdct_salt ) ! salt transports
[1593]	624	!
[2442]	625	numout = 6 ! redefine numout in case it is used after this point...
	626	!
[2496]	627	END SUBROUTINE nemo_closefile
[467]	628
[2715]	629
	630	SUBROUTINE nemo_alloc
	631	!!----------------------------------------------------------------------
	632	!! * ROUTINE nemo_alloc *
	633	!!
	634	!! ** Purpose : Allocate all the dynamic arrays of the OPA modules
	635	!!
	636	!! ** Method :
	637	!!----------------------------------------------------------------------
[9213]	638	USE diawri , ONLY : dia_wri_alloc
	639	USE dom_oce , ONLY : dom_oce_alloc
	640	USE trc_oce , ONLY : trc_oce_alloc
	641	USE bdy_oce , ONLY : bdy_oce_alloc
[2715]	642	!
	643	INTEGER :: ierr
	644	!!----------------------------------------------------------------------
	645	!
[9213]	646	ierr = oce_alloc () ! ocean
	647	ierr = ierr + dia_wri_alloc()
	648	ierr = ierr + dom_oce_alloc() ! ocean domain
	649	ierr = ierr + zdf_oce_alloc() ! ocean vertical physics
	650	ierr = ierr + trc_oce_alloc() ! shared TRC / TRA arrays
	651	ierr = ierr + bdy_oce_alloc() ! bdy masks (incl. initialization)
[2715]	652	!
[10425]	653	CALL mpp_sum( 'nemogcm', ierr )
[9213]	654	IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'nemo_alloc: unable to allocate standard ocean arrays' )
[2715]	655	!
	656	END SUBROUTINE nemo_alloc
	657
[11536]	658
[10570]	659	SUBROUTINE nemo_set_cfctl(sn_cfctl, setto, for_all )
	660	!!----------------------------------------------------------------------
	661	!! * ROUTINE nemo_set_cfctl *
	662	!!
	663	!! ** Purpose : Set elements of the output control structure to setto.
	664	!! for_all should be .false. unless all areas are to be
	665	!! treated identically.
	666	!!
	667	!! ** Method : Note this routine can be used to switch on/off some
	668	!! types of output for selected areas but any output types
	669	!! that involve global communications (e.g. mpp_max, glob_sum)
	670	!! should be protected from selective switching by the
	671	!! for_all argument
	672	!!----------------------------------------------------------------------
	673	LOGICAL :: setto, for_all
[10588]	674	TYPE(sn_ctl) :: sn_cfctl
[10570]	675	!!----------------------------------------------------------------------
	676	IF( for_all ) THEN
	677	sn_cfctl%l_runstat = setto
	678	sn_cfctl%l_trcstat = setto
	679	ENDIF
	680	sn_cfctl%l_oceout = setto
	681	sn_cfctl%l_layout = setto
	682	sn_cfctl%l_mppout = setto
	683	sn_cfctl%l_mpptop = setto
	684	END SUBROUTINE nemo_set_cfctl
	685
[3]	686	!!======================================================================
[2496]	687	END MODULE nemogcm
[4354]	688

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

Download in other formats: