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/trunk/src/SAS – NEMO

Context Navigation

source: NEMO/trunk/src/SAS/nemogcm.F90 @ 10570

Last change on this file since 10570 was 10570, checked in by acc, 5 years ago
Trunk update to implement finer control over the choice of text report files generated. See ticket: #2167
Property svn:keywords set to `Id`
File size: 27.4 KB

Rev	Line
[3324]	1	MODULE nemogcm
	2	!!======================================================================
	3	!! * MODULE nemogcm *
[7646]	4	!! StandAlone Surface module : surface fluxes + sea-ice + iceberg floats
[3324]	5	!!======================================================================
[7646]	6	!! History : 3.6 ! 2011-11 (S. Alderson, G. Madec) original code
	7	!! - ! 2013-06 (I. Epicoco, S. Mocavero, CMCC) nemo_northcomms: setup avoiding MPI communication
	8	!! - ! 2014-12 (G. Madec) remove KPP scheme and cross-land advection (cla)
	9	!! 4.0 ! 2016-10 (G. Madec, S. Flavoni) domain configuration / user defined interface
[3324]	10	!!----------------------------------------------------------------------
	11
	12	!!----------------------------------------------------------------------
[7646]	13	!! nemo_gcm : solve ocean dynamics, tracer, biogeochemistry and/or sea-ice
	14	!! nemo_init : initialization of the NEMO system
	15	!! nemo_ctl : initialisation of the contol print
	16	!! nemo_closefile: close remaining open files
	17	!! nemo_alloc : dynamical allocation
[3324]	18	!!----------------------------------------------------------------------
[7646]	19	USE step_oce ! module used in the ocean time stepping module
	20	USE sbc_oce ! surface boundary condition: ocean
	21	USE phycst ! physical constant (par_cst routine)
	22	USE domain ! domain initialization (dom_init & dom_cfg routines)
[9200]	23	USE closea ! treatment of closed seas (for ln_closea)
[7646]	24	USE usrdef_nam ! user defined configuration
	25	USE daymod ! calendar
[8583]	26	USE restart ! open restart file
[7646]	27	USE step ! NEMO time-stepping (stp routine)
	28	USE cpl_oasis3 !
	29	USE sbcssm !
	30	USE icbini ! handle bergs, initialisation
	31	USE icbstp ! handle bergs, calving, themodynamics and transport
[9019]	32	USE bdyini ! open boundary cond. setting (bdy_init routine). mandatory for sea-ice
	33	USE bdydta ! open boundary cond. setting (bdy_dta_init routine). mandatory for sea-ice
[7646]	34	!
	35	USE lib_mpp ! distributed memory computing
	36	USE mppini ! shared/distributed memory setting (mpp_init routine)
[9213]	37	USE lbcnfd , ONLY : isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges
[7646]	38	USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
[3324]	39	#if defined key_iomput
[7646]	40	USE xios ! xIOserver
[3324]	41	#endif
[9781]	42	#if defined key_agrif && defined key_si3
	43	USE agrif_ice_update ! ice update
	44	#endif
[3324]	45
	46	IMPLICIT NONE
	47	PRIVATE
	48
	49	PUBLIC nemo_gcm ! called by model.F90
	50	PUBLIC nemo_init ! needed by AGRIF
	51
	52	CHARACTER(lc) :: cform_aaa="( /, 'AAAAAAAA', / ) " ! flag for output listing
	53
	54	!!----------------------------------------------------------------------
[10068]	55	!! NEMO/SAS 4.0 , NEMO Consortium (2018)
[5215]	56	!! $Id$
[10068]	57	!! Software governed by the CeCILL license (see ./LICENSE)
[3324]	58	!!----------------------------------------------------------------------
	59	CONTAINS
	60
	61	SUBROUTINE nemo_gcm
	62	!!----------------------------------------------------------------------
	63	!! * ROUTINE nemo_gcm *
	64	!!
[7646]	65	!! ** Purpose : NEMO solves the primitive equations on an orthogonal
[3324]	66	!! curvilinear mesh on the sphere.
	67	!!
	68	!! ** Method : - model general initialization
	69	!! - launch the time-stepping (stp routine)
	70	!! - finalize the run by closing files and communications
	71	!!
	72	!! References : Madec, Delecluse, Imbard, and Levy, 1997: internal report, IPSL.
	73	!! Madec, 2008, internal report, IPSL.
	74	!!----------------------------------------------------------------------
[7646]	75	INTEGER :: istp ! time step index
[3324]	76	!!----------------------------------------------------------------------
	77	!
	78	#if defined key_agrif
[9213]	79	CALL Agrif_Init_Grids() ! AGRIF: set the meshes
[3324]	80	#endif
	81	! !-----------------------!
	82	CALL nemo_init !== Initialisations ==!
	83	! !-----------------------!
	84	#if defined key_agrif
[5407]	85	CALL Agrif_Declare_Var_dom ! AGRIF: set the meshes for DOM
	86	CALL Agrif_Declare_Var ! " " " " " DYN/TRA
	87	# if defined key_top
	88	CALL Agrif_Declare_Var_top ! " " " " " TOP
	89	# endif
[9570]	90	# if defined key_si3
[9611]	91	CALL Agrif_Declare_Var_ice ! " " " " " Sea ice
[7646]	92	# endif
[3324]	93	#endif
	94	! check that all process are still there... If some process have an error,
	95	! they will never enter in step and other processes will wait until the end of the cpu time!
[10425]	96	CALL mpp_max( 'nemogcm', nstop )
[3324]	97
	98	IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA
	99
	100	! !-----------------------!
	101	! !== time stepping ==!
	102	! !-----------------------!
	103	istp = nit000
[9213]	104	!
[7646]	105	#if defined key_agrif
[9213]	106	! !== AGRIF time-stepping ==!
[7646]	107	CALL Agrif_Regrid()
[9213]	108	!
[9781]	109	#if defined key_si3
	110	! Recursive update from highest nested level to lowest:
	111	CALL Agrif_step_child_adj(Agrif_update_ice)
	112	#endif
	113	!
[9213]	114	DO WHILE( istp <= nitend .AND. nstop == 0 )
	115	CALL stp
	116	istp = istp + 1
	117	END DO
	118	!
	119	IF( .NOT. Agrif_Root() ) THEN
	120	CALL Agrif_ParentGrid_To_ChildGrid()
	121	IF( ln_timing ) CALL timing_finalize
	122	CALL Agrif_ChildGrid_To_ParentGrid()
	123	ENDIF
	124	!
[3324]	125	#else
[9213]	126	!
	127	IF( .NOT.ln_diurnal_only ) THEN !== Standard time-stepping ==!
	128	!
	129	DO WHILE( istp <= nitend .AND. nstop == 0 )
	130	CALL stp ( istp )
	131	istp = istp + 1
[7646]	132	END DO
[9213]	133	!
	134	ELSE !== diurnal SST time-steeping only ==!
	135	!
	136	DO WHILE( istp <= nitend .AND. nstop == 0 )
	137	CALL stp_diurnal( istp ) ! time step only the diurnal SST
	138	istp = istp + 1
	139	END DO
	140	!
	141	ENDIF
[5407]	142	!
[9213]	143	#endif
	144	!
[5407]	145	IF( ln_icebergs ) CALL icb_end( nitend )
	146
[3324]	147	! !------------------------!
	148	! !== finalize the run ==!
	149	! !------------------------!
[7646]	150	IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA
[3324]	151	!
[7646]	152	IF( nstop /= 0 .AND. lwp ) THEN ! error print
[3324]	153	WRITE(numout,cform_err)
[9213]	154	WRITE(numout,*) ' ==>>> nemo_gcm: a total of ', nstop, ' errors have been found'
	155	WRITE(numout,*)
[3324]	156	ENDIF
	157	!
[9019]	158	IF( ln_timing ) CALL timing_finalize
[3324]	159	!
	160	CALL nemo_closefile
[5407]	161	!
[3769]	162	#if defined key_iomput
[9213]	163	CALL xios_finalize ! end mpp communications with xios
	164	IF( lk_oasis ) CALL cpl_finalize ! end coupling and mpp communications with OASIS
[3769]	165	#else
[9213]	166	IF ( lk_oasis ) THEN ; CALL cpl_finalize ! end coupling and mpp communications with OASIS
	167	ELSEIF( lk_mpp ) THEN ; CALL mppstop ! end mpp communications
[5407]	168	ENDIF
[3769]	169	#endif
[3324]	170	!
	171	END SUBROUTINE nemo_gcm
	172
	173
	174	SUBROUTINE nemo_init
	175	!!----------------------------------------------------------------------
	176	!! * ROUTINE nemo_init *
	177	!!
	178	!! ** Purpose : initialization of the NEMO GCM
	179	!!----------------------------------------------------------------------
[9213]	180	INTEGER :: ji ! dummy loop indices
	181	INTEGER :: ios, ilocal_comm ! local integers
[7646]	182	CHARACTER(len=120), DIMENSION(30) :: cltxt, cltxt2, clnam
	183	CHARACTER(len=80) :: clname
[9213]	184	!!
[10570]	185	NAMELIST/namctl/ ln_ctl , sn_cfctl, nn_print, nn_ictls, nn_ictle, &
	186	& nn_isplt , nn_jsplt, nn_jctls, nn_jctle, &
[9019]	187	& ln_timing, ln_diacfl
[9213]	188	NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr
[3324]	189	!!----------------------------------------------------------------------
[5407]	190	!
[7646]	191	cltxt = ''
	192	cltxt2 = ''
	193	clnam = ''
	194	cxios_context = 'nemo'
[3324]	195	!
[4147]	196	! ! Open reference namelist and configuration namelist files
[5407]	197	IF( lk_oasis ) THEN
	198	CALL ctl_opn( numnam_ref, 'namelist_sas_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
	199	CALL ctl_opn( numnam_cfg, 'namelist_sas_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
	200	cxios_context = 'sas'
	201	clname = 'output.namelist_sas.dyn'
	202	ELSE
	203	CALL ctl_opn( numnam_ref, 'namelist_ref', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
	204	CALL ctl_opn( numnam_cfg, 'namelist_cfg', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
	205	cxios_context = 'nemo'
	206	clname = 'output.namelist.dyn'
	207	ENDIF
[3324]	208	!
[9213]	209	REWIND( numnam_ref ) ! Namelist namctl in reference namelist
[4147]	210	READ ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 )
[9169]	211	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist', .TRUE. )
[7646]	212	REWIND( numnam_cfg ) ! Namelist namctl in confguration namelist
[4147]	213	READ ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 )
[9169]	214	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist', .TRUE. )
[3324]	215	!
[9213]	216	REWIND( numnam_ref ) ! Namelist namcfg in reference namelist
[4147]	217	READ ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 )
[9169]	218	903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist', .TRUE. )
[9213]	219	REWIND( numnam_cfg ) ! Namelist namcfg in confguration namelist
[4147]	220	READ ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 )
[9169]	221	904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist', .TRUE. )
[4290]	222
[7646]	223	! !--------------------------!
	224	! ! Set global domain size ! (control print return in cltxt2)
	225	! !--------------------------!
	226	IF( ln_read_cfg ) THEN ! Read sizes in domain configuration file
	227	CALL domain_cfg ( cltxt2, cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )
	228	!
	229	ELSE ! user-defined namelist
	230	CALL usr_def_nam( cltxt2, clnam, cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )
	231	ENDIF
	232	!
	233	!
[3324]	234	! !--------------------------------------------!
	235	! ! set communicator & select the local node !
[4624]	236	! ! NB: mynode also opens output.namelist.dyn !
	237	! ! on unit number numond on first proc !
[3324]	238	! !--------------------------------------------!
	239	#if defined key_iomput
	240	IF( Agrif_Root() ) THEN
[5407]	241	IF( lk_oasis ) THEN
	242	CALL cpl_init( "sas", ilocal_comm ) ! nemo local communicator given by oasis
	243	CALL xios_initialize( "not used",local_comm=ilocal_comm ) ! send nemo communicator to xios
	244	ELSE
[7646]	245	CALL xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm ) ! nemo local communicator given by xios
[5407]	246	ENDIF
[3324]	247	ENDIF
[5407]	248	narea = mynode ( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection
[3324]	249	#else
[5407]	250	IF( lk_oasis ) THEN
	251	IF( Agrif_Root() ) THEN
	252	CALL cpl_init( "sas", ilocal_comm ) ! nemo local communicator given by oasis
	253	ENDIF
	254	narea = mynode( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop, ilocal_comm ) ! Nodes selection (control print return in cltxt)
	255	ELSE
	256	ilocal_comm = 0
	257	narea = mynode( cltxt, clname, numnam_ref, numnam_cfg, numond , nstop ) ! Nodes selection (control print return in cltxt)
	258	ENDIF
[3324]	259	#endif
[7646]	260
[3324]	261	narea = narea + 1 ! mynode return the rank of proc (0 --> jpnij -1 )
	262
[10570]	263	IF( sn_cfctl%l_config ) THEN
	264	! Activate finer control of report outputs
	265	! optionally switch off output from selected areas (note this only
	266	! applies to output which does not involve global communications)
	267	IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax ) .OR. &
	268	& ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) ) &
	269	& CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. )
	270	ELSE
	271	! Use ln_ctl to turn on or off all options.
	272	CALL nemo_set_cfctl( sn_cfctl, ln_ctl, .TRUE. )
	273	ENDIF
	274
[4624]	275	lwm = (narea == 1) ! control of output namelists
[3324]	276	lwp = (narea == 1) .OR. ln_ctl ! control of all listing output print
	277
[7646]	278	IF(lwm) THEN ! write merged namelists from earlier to output namelist
	279	! ! now that the file has been opened in call to mynode.
	280	! ! NB: nammpp has already been written in mynode (if lk_mpp_mpi)
[4624]	281	WRITE( numond, namctl )
	282	WRITE( numond, namcfg )
[7646]	283	IF( .NOT.ln_read_cfg ) THEN
	284	DO ji = 1, SIZE(clnam)
	285	IF( TRIM(clnam(ji)) /= '' ) WRITE(numond, * ) clnam(ji) ! namusr_def print
	286	END DO
	287	ENDIF
[4624]	288	ENDIF
	289
[3324]	290	IF(lwp) THEN ! open listing units
	291	!
[9213]	292	IF( lk_oasis ) THEN ; CALL ctl_opn( numout, 'sas.output', 'REPLACE','FORMATTED','SEQUENTIAL', -1, 6, .FALSE., narea )
	293	ELSE ; CALL ctl_opn( numout, 'ocean.output', 'REPLACE','FORMATTED','SEQUENTIAL', -1, 6, .FALSE., narea )
[5407]	294	ENDIF
[3324]	295	!
	296	WRITE(numout,*)
	297	WRITE(numout,*) ' CNRS - NERC - Met OFFICE - MERCATOR-ocean - INGV - CMCC'
	298	WRITE(numout,*) ' NEMO team'
	299	WRITE(numout,*) ' Ocean General Circulation Model'
[10570]	300	WRITE(numout,*) ' NEMO version 4.0 (2019) '
[3331]	301	WRITE(numout,*) ' StandAlone Surface version (SAS) '
[10570]	302	WRITE(numout,*) " ._ ._ ._ ._ ._ "
	303	WRITE(numout,*) " _.-._)`\_.-._)`\_.-._)`\_.-._)`\_.-._)`\_ "
[3324]	304	WRITE(numout,*)
[10570]	305	WRITE(numout,*) " o _, _, "
	306	WRITE(numout,*) " o .' ( .-' / "
	307	WRITE(numout,*) " o _/..._'. .' / "
	308	WRITE(numout,*) " ( o .-'` ` '-./ _.' "
	309	WRITE(numout,*) " ) ( o) ;= <_ ( "
	310	WRITE(numout,*) " ( '-.,\\__ __.-;`\ '. ) "
	311	WRITE(numout,*) " ) ) \) \|`\ \) '. \ ( ( "
	312	WRITE(numout,*) " ( ( \_/ '-._\ ) ) "
	313	WRITE(numout,*) " ) ) ` ( ( "
	314	WRITE(numout,*) " ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ "
[3324]	315	WRITE(numout,*)
[7646]	316	DO ji = 1, SIZE(cltxt)
	317	IF( TRIM(cltxt (ji)) /= '' ) WRITE(numout,*) cltxt(ji) ! control print of mynode
[3324]	318	END DO
[7646]	319	WRITE(numout,*)
	320	WRITE(numout,*)
	321	DO ji = 1, SIZE(cltxt2)
	322	IF( TRIM(cltxt2(ji)) /= '' ) WRITE(numout,*) cltxt2(ji) ! control print of domain size
	323	END DO
[3324]	324	!
[7646]	325	WRITE(numout,cform_aaa) ! Flag AAAAAAA
	326	!
[3324]	327	ENDIF
[10459]	328	! open /dev/null file to be able to supress output write easily
	329	CALL ctl_opn( numnul, '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE. )
	330	!
[9436]	331	! ! Domain decomposition
	332	CALL mpp_init ! MPP
[3324]	333
[7646]	334	! Now we know the dimensions of the grid and numout has been set: we can allocate arrays
[3324]	335	CALL nemo_alloc()
[9213]	336
[3324]	337	! !-------------------------------!
	338	! ! NEMO general initialization !
	339	! !-------------------------------!
	340
[7646]	341	CALL nemo_ctl ! Control prints
[3324]	342	!
[9213]	343	! ! General initialization
	344	IF( ln_timing ) CALL timing_init ! timing
	345	IF( ln_timing ) CALL timing_start( 'nemo_init')
[3324]	346
[9213]	347	CALL phy_cst ! Physical constants
	348	CALL eos_init ! Equation of seawater
[9367]	349	CALL dom_init('SAS') ! Domain
[9213]	350	IF( ln_ctl ) CALL prt_ctl_init ! Print control
	351
	352	CALL day_init ! model calendar (using both namelist and restart infos)
	353	IF( ln_rstart ) CALL rst_read_open
[3324]	354
[9213]	355	! ! external forcing
	356	CALL sbc_init ! Forcings : surface module
[3324]	357
[9019]	358	! ==> clem: open boundaries init. is mandatory for sea-ice because ice BDY is not decoupled from
[5510]	359	! the environment of ocean BDY. Therefore bdy is called in both OPA and SAS modules.
	360	! This is not clean and should be changed in the future.
[9019]	361	CALL bdy_init
[5510]	362	! ==>
[9019]	363	CALL icb_init( rdt, nit000) ! initialise icebergs instance
[3324]	364	!
[9213]	365	IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA
	366	!
	367	IF( ln_timing ) CALL timing_stop( 'nemo_init')
	368	!
[3324]	369	END SUBROUTINE nemo_init
	370
	371
	372	SUBROUTINE nemo_ctl
	373	!!----------------------------------------------------------------------
	374	!! * ROUTINE nemo_ctl *
	375	!!
[9213]	376	!! ** Purpose : control print setting
[3324]	377	!!
	378	!! ** Method : - print namctl information and check some consistencies
	379	!!----------------------------------------------------------------------
	380	!
	381	IF(lwp) THEN ! control print
	382	WRITE(numout,*)
[7646]	383	WRITE(numout,*) 'nemo_ctl: Control prints'
[9213]	384	WRITE(numout,*) '~~~~~~~~'
[3324]	385	WRITE(numout,*) ' Namelist namctl'
	386	WRITE(numout,*) ' run control (for debugging) ln_ctl = ', ln_ctl
[10570]	387	WRITE(numout,*) ' finer control over o/p sn_cfctl%l_config = ', sn_cfctl%l_config
	388	WRITE(numout,*) ' sn_cfctl%l_runstat = ', sn_cfctl%l_runstat
	389	WRITE(numout,*) ' sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat
	390	WRITE(numout,*) ' sn_cfctl%l_oceout = ', sn_cfctl%l_oceout
	391	WRITE(numout,*) ' sn_cfctl%l_layout = ', sn_cfctl%l_layout
	392	WRITE(numout,*) ' sn_cfctl%l_mppout = ', sn_cfctl%l_mppout
	393	WRITE(numout,*) ' sn_cfctl%l_mpptop = ', sn_cfctl%l_mpptop
	394	WRITE(numout,*) ' sn_cfctl%procmin = ', sn_cfctl%procmin
	395	WRITE(numout,*) ' sn_cfctl%procmax = ', sn_cfctl%procmax
	396	WRITE(numout,*) ' sn_cfctl%procincr = ', sn_cfctl%procincr
	397	WRITE(numout,*) ' sn_cfctl%ptimincr = ', sn_cfctl%ptimincr
[3324]	398	WRITE(numout,*) ' level of print nn_print = ', nn_print
	399	WRITE(numout,*) ' Start i indice for SUM control nn_ictls = ', nn_ictls
	400	WRITE(numout,*) ' End i indice for SUM control nn_ictle = ', nn_ictle
	401	WRITE(numout,*) ' Start j indice for SUM control nn_jctls = ', nn_jctls
	402	WRITE(numout,*) ' End j indice for SUM control nn_jctle = ', nn_jctle
	403	WRITE(numout,*) ' number of proc. following i nn_isplt = ', nn_isplt
	404	WRITE(numout,*) ' number of proc. following j nn_jsplt = ', nn_jsplt
[9019]	405	WRITE(numout,*) ' timing by routine ln_timing = ', ln_timing
	406	WRITE(numout,*) ' CFL diagnostics ln_diacfl = ', ln_diacfl
[3324]	407	ENDIF
	408	!
	409	nprint = nn_print ! convert DOCTOR namelist names into OLD names
	410	nictls = nn_ictls
	411	nictle = nn_ictle
	412	njctls = nn_jctls
	413	njctle = nn_jctle
	414	isplt = nn_isplt
	415	jsplt = nn_jsplt
[4147]	416
	417	IF(lwp) THEN ! control print
	418	WRITE(numout,*)
	419	WRITE(numout,*) ' Namelist namcfg'
[9213]	420	WRITE(numout,*) ' read domain configuration file ln_read_cfg = ', ln_read_cfg
[7646]	421	WRITE(numout,*) ' filename to be read cn_domcfg = ', TRIM(cn_domcfg)
[9213]	422	WRITE(numout,*) ' keep closed seas in the domain (if exist) ln_closea = ', ln_closea
	423	WRITE(numout,*) ' create a configuration definition file ln_write_cfg = ', ln_write_cfg
[7646]	424	WRITE(numout,*) ' filename to be written cn_domcfg_out = ', TRIM(cn_domcfg_out)
	425	WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr
[4147]	426	ENDIF
[9213]	427	IF( .NOT.ln_read_cfg ) ln_closea = .false. ! dealing possible only with a domcfg file
	428	!
[3324]	429	! ! Parameter control
	430	!
	431	IF( ln_ctl ) THEN ! sub-domain area indices for the control prints
	432	IF( lk_mpp .AND. jpnij > 1 ) THEN
	433	isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj ! the domain is forced to the real split domain
	434	ELSE
	435	IF( isplt == 1 .AND. jsplt == 1 ) THEN
	436	CALL ctl_warn( ' - isplt & jsplt are equal to 1', &
	437	& ' - the print control will be done over the whole domain' )
	438	ENDIF
	439	ijsplt = isplt * jsplt ! total number of processors ijsplt
	440	ENDIF
	441	IF(lwp) WRITE(numout,*)' - The total number of processors over which the'
	442	IF(lwp) WRITE(numout,*)' print control will be done is ijsplt : ', ijsplt
	443	!
	444	! ! indices used for the SUM control
	445	IF( nictls+nictle+njctls+njctle == 0 ) THEN ! print control done over the default area
[7646]	446	lsp_area = .FALSE.
[3324]	447	ELSE ! print control done over a specific area
	448	lsp_area = .TRUE.
	449	IF( nictls < 1 .OR. nictls > jpiglo ) THEN
	450	CALL ctl_warn( ' - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )
	451	nictls = 1
	452	ENDIF
	453	IF( nictle < 1 .OR. nictle > jpiglo ) THEN
	454	CALL ctl_warn( ' - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )
	455	nictle = jpiglo
	456	ENDIF
	457	IF( njctls < 1 .OR. njctls > jpjglo ) THEN
	458	CALL ctl_warn( ' - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )
	459	njctls = 1
	460	ENDIF
	461	IF( njctle < 1 .OR. njctle > jpjglo ) THEN
	462	CALL ctl_warn( ' - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )
	463	njctle = jpjglo
	464	ENDIF
	465	ENDIF
	466	ENDIF
	467	!
[9213]	468	IF( 1._wp /= SIGN(1._wp,-0._wp) ) CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows f2003 standard.', &
	469	& 'Compile with key_nosignedzero enabled' )
[5407]	470	!
[9213]	471	#if defined key_agrif
	472	IF( ln_timing ) CALL ctl_stop( 'AGRIF not implemented with ln_timing = true')
	473	#endif
	474	!
[3324]	475	END SUBROUTINE nemo_ctl
	476
	477
	478	SUBROUTINE nemo_closefile
	479	!!----------------------------------------------------------------------
	480	!! * ROUTINE nemo_closefile *
	481	!!
	482	!! ** Purpose : Close the files
	483	!!----------------------------------------------------------------------
	484	!
	485	IF( lk_mpp ) CALL mppsync
	486	!
	487	CALL iom_close ! close all input/output files managed by iom_*
	488	!
[9213]	489	IF( numstp /= -1 ) CLOSE( numstp ) ! time-step file
[9267]	490	IF( numrun /= -1 ) CLOSE( numrun ) ! run statistics file
[4147]	491	IF( numnam_ref /= -1 ) CLOSE( numnam_ref ) ! oce reference namelist
	492	IF( numnam_cfg /= -1 ) CLOSE( numnam_cfg ) ! oce configuration namelist
[4624]	493	IF( lwm.AND.numond /= -1 ) CLOSE( numond ) ! oce output namelist
[4147]	494	IF( numnam_ice_ref /= -1 ) CLOSE( numnam_ice_ref ) ! ice reference namelist
	495	IF( numnam_ice_cfg /= -1 ) CLOSE( numnam_ice_cfg ) ! ice configuration namelist
[4624]	496	IF( lwm.AND.numoni /= -1 ) CLOSE( numoni ) ! ice output namelist
[9213]	497	IF( numevo_ice /= -1 ) CLOSE( numevo_ice ) ! ice variables (temp. evolution)
	498	IF( numout /= 6 ) CLOSE( numout ) ! standard model output file
[3324]	499	!
	500	numout = 6 ! redefine numout in case it is used after this point...
	501	!
	502	END SUBROUTINE nemo_closefile
	503
	504
	505	SUBROUTINE nemo_alloc
	506	!!----------------------------------------------------------------------
	507	!! * ROUTINE nemo_alloc *
	508	!!
	509	!! ** Purpose : Allocate all the dynamic arrays of the OPA modules
	510	!!
	511	!! ** Method :
	512	!!----------------------------------------------------------------------
[9213]	513	USE diawri , ONLY : dia_wri_alloc
	514	USE dom_oce , ONLY : dom_oce_alloc
	515	USE bdy_oce , ONLY : ln_bdy, bdy_oce_alloc
[9019]	516	USE oce ! mandatory for sea-ice because needed for bdy arrays
[3324]	517	!
[7646]	518	INTEGER :: ierr
[3324]	519	!!----------------------------------------------------------------------
	520	!
[9213]	521	ierr = dia_wri_alloc()
	522	ierr = ierr + dom_oce_alloc() ! ocean domain
[9570]	523	ierr = ierr + oce_alloc () ! (tsn...) needed for agrif and/or SI3 and bdy
[9213]	524	ierr = ierr + bdy_oce_alloc() ! bdy masks (incl. initialization)
[3324]	525	!
[10425]	526	CALL mpp_sum( 'nemogcm', ierr )
[9213]	527	IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'nemo_alloc: unable to allocate standard ocean arrays' )
[3324]	528	!
	529	END SUBROUTINE nemo_alloc
	530
[10570]	531	SUBROUTINE nemo_set_cfctl(sn_cfctl, setto, for_all )
	532	!!----------------------------------------------------------------------
	533	!! * ROUTINE nemo_set_cfctl *
	534	!!
	535	!! ** Purpose : Set elements of the output control structure to setto.
	536	!! for_all should be .false. unless all areas are to be
	537	!! treated identically.
	538	!!
	539	!! ** Method : Note this routine can be used to switch on/off some
	540	!! types of output for selected areas but any output types
	541	!! that involve global communications (e.g. mpp_max, glob_sum)
	542	!! should be protected from selective switching by the
	543	!! for_all argument
	544	!!----------------------------------------------------------------------
	545	LOGICAL :: setto, for_all
	546	TYPE (sn_ctl) :: sn_cfctl
	547	!!----------------------------------------------------------------------
	548	IF( for_all ) THEN
	549	sn_cfctl%l_runstat = setto
	550	sn_cfctl%l_trcstat = setto
	551	ENDIF
	552	sn_cfctl%l_oceout = setto
	553	sn_cfctl%l_layout = setto
	554	sn_cfctl%l_mppout = setto
	555	sn_cfctl%l_mpptop = setto
	556	END SUBROUTINE nemo_set_cfctl
	557
[3324]	558	!!======================================================================
	559	END MODULE nemogcm
[9213]	560

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

Download in other formats: