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

Context Navigation

source: NEMO/branches/2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles/src/SAS/nemogcm.F90 @ 11624

Last change on this file since 11624 was 11624, checked in by acc, 5 years ago
Branch 2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles. Substantive changes required to replace all namelists with internal files. These are the key changes only; to compile and run tests all REWIND and CLOSE operations on the (no longer) units have to be removed. These changes affect many more files but can be scripted so are not included here in order to make a later merge easier. The scripts used to prepare code for testing are included on: wiki:2019WP/ENHANCE-04_AndrewC-reporting/Internal_Namelists. With these additional changes this code passes most SETTE tests but the AGRIF preprocessor does not currently accept the new allocatable character strings. To be investigated.
Property svn:keywords set to `Id`
File size: 27.0 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
[11536]	153	WRITE(ctmp1,*) ' ==>>> nemo_gcm: a total of ', nstop, ' errors have been found'
	154	CALL ctl_stop( ctmp1 )
[3324]	155	ENDIF
	156	!
[9019]	157	IF( ln_timing ) CALL timing_finalize
[3324]	158	!
	159	CALL nemo_closefile
[5407]	160	!
[3769]	161	#if defined key_iomput
[9213]	162	CALL xios_finalize ! end mpp communications with xios
	163	IF( lk_oasis ) CALL cpl_finalize ! end coupling and mpp communications with OASIS
[3769]	164	#else
[9213]	165	IF ( lk_oasis ) THEN ; CALL cpl_finalize ! end coupling and mpp communications with OASIS
[11536]	166	ELSEIF( lk_mpp ) THEN ; CALL mppstop ! end mpp communications
[5407]	167	ENDIF
[3769]	168	#endif
[3324]	169	!
[11229]	170	IF(lwm) THEN
	171	IF( nstop == 0 ) THEN ; STOP 0
[11536]	172	ELSE ; STOP 123
[11229]	173	ENDIF
	174	ENDIF
	175	!
[3324]	176	END SUBROUTINE nemo_gcm
	177
	178
	179	SUBROUTINE nemo_init
	180	!!----------------------------------------------------------------------
	181	!! * ROUTINE nemo_init *
	182	!!
	183	!! ** Purpose : initialization of the NEMO GCM
	184	!!----------------------------------------------------------------------
[11536]	185	INTEGER :: ios, ilocal_comm ! local integers
[9213]	186	!!
[10570]	187	NAMELIST/namctl/ ln_ctl , sn_cfctl, nn_print, nn_ictls, nn_ictle, &
	188	& nn_isplt , nn_jsplt, nn_jctls, nn_jctle, &
[9019]	189	& ln_timing, ln_diacfl
[9213]	190	NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr
[3324]	191	!!----------------------------------------------------------------------
[5407]	192	!
[11536]	193	IF( lk_oasis ) THEN ; cxios_context = 'sas'
	194	ELSE ; cxios_context = 'nemo'
[7646]	195	ENDIF
	196	!
[11536]	197	! !-------------------------------------------------!
	198	! ! set communicator & select the local rank !
	199	! ! must be done as soon as possible to get narea !
	200	! !-------------------------------------------------!
[7646]	201	!
[3324]	202	#if defined key_iomput
	203	IF( Agrif_Root() ) THEN
[5407]	204	IF( lk_oasis ) THEN
[11536]	205	CALL cpl_init( "sas", ilocal_comm ) ! nemo local communicator given by oasis
	206	CALL xios_initialize( "not used",local_comm=ilocal_comm ) ! send nemo communicator to xios
[5407]	207	ELSE
[7646]	208	CALL xios_initialize( "for_xios_mpi_id",return_comm=ilocal_comm ) ! nemo local communicator given by xios
[5407]	209	ENDIF
[3324]	210	ENDIF
[11536]	211	CALL mpp_start( ilocal_comm )
[3324]	212	#else
[5407]	213	IF( lk_oasis ) THEN
	214	IF( Agrif_Root() ) THEN
[11536]	215	CALL cpl_init( "sas", ilocal_comm ) ! nemo local communicator given by oasis
[5407]	216	ENDIF
[11536]	217	CALL mpp_start( ilocal_comm )
[5407]	218	ELSE
[11536]	219	CALL mpp_start( )
[5407]	220	ENDIF
[3324]	221	#endif
[11536]	222	!
	223	narea = mpprank + 1 ! mpprank: the rank of proc (0 --> mppsize -1 )
	224	lwm = (narea == 1) ! control of output namelists
	225	!
	226	! !---------------------------------------------------------------!
	227	! ! Open output files, reference and configuration namelist files !
	228	! !---------------------------------------------------------------!
	229	!
	230	! open ocean.output as soon as possible to get all output prints (including errors messages)
	231	IF( lk_oasis ) THEN
[11624]	232	IF( lwm ) CALL ctl_opn( numout, 'sas.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
[11536]	233	! open reference and configuration namelist files
[11624]	234	CALL load_nml( numnam_ref, 'namelist_sas_ref', -1, .FALSE. )
	235	CALL load_nml( numnam_cfg, 'namelist_sas_cfg', -1, .FALSE. )
	236	IF( lwm ) CALL ctl_opn( numond, 'output.namelist_sas.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
[10570]	237	ELSE
[11624]	238	IF( lwm ) CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
[11536]	239	! open reference and configuration namelist files
[11624]	240	CALL load_nml( numnam_ref, 'namelist_ref', -1, .FALSE. )
	241	CALL load_nml( numnam_cfg, 'namelist_cfg', -1, .FALSE. )
	242	IF( lwm ) CALL ctl_opn( numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
[10570]	243	ENDIF
[11536]	244	! open /dev/null file to be able to supress output write easily
	245	CALL ctl_opn( numnul, '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
	246	!
	247	! !--------------------!
	248	! ! Open listing units ! -> need ln_ctl from namctl to define lwp
	249	! !--------------------!
	250	!
	251	READ ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 )
	252	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist' )
	253	READ ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 )
	254	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist' )
	255	!
	256	lwp = (narea == 1) .OR. ln_ctl ! control of all listing output print
	257	!
	258	IF(lwp) THEN ! open listing units
[3324]	259	!
[11536]	260	IF( .NOT. lwm ) THEN ! alreay opened for narea == 1
	261	IF(lk_oasis) THEN ; CALL ctl_opn( numout, 'sas.output','REPLACE','FORMATTED','SEQUENTIAL',-1,-1, .FALSE., narea )
	262	ELSE ; CALL ctl_opn( numout, 'ocean.output','REPLACE','FORMATTED','SEQUENTIAL',-1,-1, .FALSE., narea )
	263	ENDIF
[5407]	264	ENDIF
[3324]	265	!
	266	WRITE(numout,*)
[11536]	267	WRITE(numout,*) ' CNRS - NERC - Met OFFICE - MERCATOR-ocean - CMCC'
[3324]	268	WRITE(numout,*) ' NEMO team'
	269	WRITE(numout,*) ' Ocean General Circulation Model'
[10570]	270	WRITE(numout,*) ' NEMO version 4.0 (2019) '
[3331]	271	WRITE(numout,*) ' StandAlone Surface version (SAS) '
[10570]	272	WRITE(numout,*) " ._ ._ ._ ._ ._ "
	273	WRITE(numout,*) " _.-._)`\_.-._)`\_.-._)`\_.-._)`\_.-._)`\_ "
[3324]	274	WRITE(numout,*)
[10570]	275	WRITE(numout,*) " o _, _, "
	276	WRITE(numout,*) " o .' ( .-' / "
	277	WRITE(numout,*) " o _/..._'. .' / "
	278	WRITE(numout,*) " ( o .-'` ` '-./ _.' "
	279	WRITE(numout,*) " ) ( o) ;= <_ ( "
	280	WRITE(numout,*) " ( '-.,\\__ __.-;`\ '. ) "
	281	WRITE(numout,*) " ) ) \) \|`\ \) '. \ ( ( "
	282	WRITE(numout,*) " ( ( \_/ '-._\ ) ) "
[11229]	283	WRITE(numout,*) " ) ) jgs ` ( ( "
[10570]	284	WRITE(numout,*) " ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ "
[3324]	285	WRITE(numout,*)
[7646]	286	WRITE(numout,*)
[3324]	287	!
[7646]	288	WRITE(numout,cform_aaa) ! Flag AAAAAAA
	289	!
[3324]	290	ENDIF
[11536]	291	!
	292	! finalize the definition of namctl variables
	293	IF( sn_cfctl%l_config ) THEN
	294	! Activate finer control of report outputs
	295	! optionally switch off output from selected areas (note this only
	296	! applies to output which does not involve global communications)
	297	IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax ) .OR. &
	298	& ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) ) &
	299	& CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. )
	300	ELSE
	301	! Use ln_ctl to turn on or off all options.
	302	CALL nemo_set_cfctl( sn_cfctl, ln_ctl, .TRUE. )
	303	ENDIF
[10459]	304	!
[11536]	305	IF(lwm) WRITE( numond, namctl )
	306	!
	307	! !------------------------------------!
	308	! ! Set global domain size parameters !
	309	! !------------------------------------!
	310	!
	311	READ ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 )
	312	903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist' )
	313	READ ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 )
	314	904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist' )
	315	!
	316	IF( ln_read_cfg ) THEN ! Read sizes in domain configuration file
	317	CALL domain_cfg ( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )
	318	ELSE ! user-defined namelist
	319	CALL usr_def_nam( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )
	320	ENDIF
	321	!
	322	IF(lwm) WRITE( numond, namcfg )
	323	!
	324	! !-----------------------------------------!
	325	! ! mpp parameters and domain decomposition !
	326	! !-----------------------------------------!
	327	CALL mpp_init
[3324]	328
[7646]	329	! Now we know the dimensions of the grid and numout has been set: we can allocate arrays
[3324]	330	CALL nemo_alloc()
[9213]	331
[3324]	332	! !-------------------------------!
	333	! ! NEMO general initialization !
	334	! !-------------------------------!
	335
[7646]	336	CALL nemo_ctl ! Control prints
[3324]	337	!
[9213]	338	! ! General initialization
	339	IF( ln_timing ) CALL timing_init ! timing
	340	IF( ln_timing ) CALL timing_start( 'nemo_init')
[3324]	341
[9213]	342	CALL phy_cst ! Physical constants
	343	CALL eos_init ! Equation of seawater
[9367]	344	CALL dom_init('SAS') ! Domain
[9213]	345	IF( ln_ctl ) CALL prt_ctl_init ! Print control
	346
	347	CALL day_init ! model calendar (using both namelist and restart infos)
	348	IF( ln_rstart ) CALL rst_read_open
[3324]	349
[9213]	350	! ! external forcing
	351	CALL sbc_init ! Forcings : surface module
[3324]	352
[9019]	353	! ==> clem: open boundaries init. is mandatory for sea-ice because ice BDY is not decoupled from
[5510]	354	! the environment of ocean BDY. Therefore bdy is called in both OPA and SAS modules.
	355	! This is not clean and should be changed in the future.
[9019]	356	CALL bdy_init
[5510]	357	! ==>
[9019]	358	CALL icb_init( rdt, nit000) ! initialise icebergs instance
[3324]	359	!
[9213]	360	IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA
	361	!
	362	IF( ln_timing ) CALL timing_stop( 'nemo_init')
	363	!
[3324]	364	END SUBROUTINE nemo_init
	365
	366
	367	SUBROUTINE nemo_ctl
	368	!!----------------------------------------------------------------------
	369	!! * ROUTINE nemo_ctl *
	370	!!
[9213]	371	!! ** Purpose : control print setting
[3324]	372	!!
	373	!! ** Method : - print namctl information and check some consistencies
	374	!!----------------------------------------------------------------------
	375	!
	376	IF(lwp) THEN ! control print
	377	WRITE(numout,*)
[7646]	378	WRITE(numout,*) 'nemo_ctl: Control prints'
[9213]	379	WRITE(numout,*) '~~~~~~~~'
[3324]	380	WRITE(numout,*) ' Namelist namctl'
	381	WRITE(numout,*) ' run control (for debugging) ln_ctl = ', ln_ctl
[10570]	382	WRITE(numout,*) ' finer control over o/p sn_cfctl%l_config = ', sn_cfctl%l_config
	383	WRITE(numout,*) ' sn_cfctl%l_runstat = ', sn_cfctl%l_runstat
	384	WRITE(numout,*) ' sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat
	385	WRITE(numout,*) ' sn_cfctl%l_oceout = ', sn_cfctl%l_oceout
	386	WRITE(numout,*) ' sn_cfctl%l_layout = ', sn_cfctl%l_layout
	387	WRITE(numout,*) ' sn_cfctl%l_mppout = ', sn_cfctl%l_mppout
	388	WRITE(numout,*) ' sn_cfctl%l_mpptop = ', sn_cfctl%l_mpptop
	389	WRITE(numout,*) ' sn_cfctl%procmin = ', sn_cfctl%procmin
	390	WRITE(numout,*) ' sn_cfctl%procmax = ', sn_cfctl%procmax
	391	WRITE(numout,*) ' sn_cfctl%procincr = ', sn_cfctl%procincr
	392	WRITE(numout,*) ' sn_cfctl%ptimincr = ', sn_cfctl%ptimincr
[3324]	393	WRITE(numout,*) ' level of print nn_print = ', nn_print
	394	WRITE(numout,*) ' Start i indice for SUM control nn_ictls = ', nn_ictls
	395	WRITE(numout,*) ' End i indice for SUM control nn_ictle = ', nn_ictle
	396	WRITE(numout,*) ' Start j indice for SUM control nn_jctls = ', nn_jctls
	397	WRITE(numout,*) ' End j indice for SUM control nn_jctle = ', nn_jctle
	398	WRITE(numout,*) ' number of proc. following i nn_isplt = ', nn_isplt
	399	WRITE(numout,*) ' number of proc. following j nn_jsplt = ', nn_jsplt
[9019]	400	WRITE(numout,*) ' timing by routine ln_timing = ', ln_timing
	401	WRITE(numout,*) ' CFL diagnostics ln_diacfl = ', ln_diacfl
[3324]	402	ENDIF
	403	!
	404	nprint = nn_print ! convert DOCTOR namelist names into OLD names
	405	nictls = nn_ictls
	406	nictle = nn_ictle
	407	njctls = nn_jctls
	408	njctle = nn_jctle
	409	isplt = nn_isplt
	410	jsplt = nn_jsplt
[4147]	411
	412	IF(lwp) THEN ! control print
	413	WRITE(numout,*)
	414	WRITE(numout,*) ' Namelist namcfg'
[9213]	415	WRITE(numout,*) ' read domain configuration file ln_read_cfg = ', ln_read_cfg
[7646]	416	WRITE(numout,*) ' filename to be read cn_domcfg = ', TRIM(cn_domcfg)
[9213]	417	WRITE(numout,*) ' keep closed seas in the domain (if exist) ln_closea = ', ln_closea
	418	WRITE(numout,*) ' create a configuration definition file ln_write_cfg = ', ln_write_cfg
[7646]	419	WRITE(numout,*) ' filename to be written cn_domcfg_out = ', TRIM(cn_domcfg_out)
	420	WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr
[4147]	421	ENDIF
[9213]	422	IF( .NOT.ln_read_cfg ) ln_closea = .false. ! dealing possible only with a domcfg file
	423	!
[3324]	424	! ! Parameter control
	425	!
	426	IF( ln_ctl ) THEN ! sub-domain area indices for the control prints
	427	IF( lk_mpp .AND. jpnij > 1 ) THEN
	428	isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj ! the domain is forced to the real split domain
	429	ELSE
	430	IF( isplt == 1 .AND. jsplt == 1 ) THEN
	431	CALL ctl_warn( ' - isplt & jsplt are equal to 1', &
	432	& ' - the print control will be done over the whole domain' )
	433	ENDIF
	434	ijsplt = isplt * jsplt ! total number of processors ijsplt
	435	ENDIF
	436	IF(lwp) WRITE(numout,*)' - The total number of processors over which the'
	437	IF(lwp) WRITE(numout,*)' print control will be done is ijsplt : ', ijsplt
	438	!
	439	! ! indices used for the SUM control
	440	IF( nictls+nictle+njctls+njctle == 0 ) THEN ! print control done over the default area
[7646]	441	lsp_area = .FALSE.
[3324]	442	ELSE ! print control done over a specific area
	443	lsp_area = .TRUE.
	444	IF( nictls < 1 .OR. nictls > jpiglo ) THEN
	445	CALL ctl_warn( ' - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )
	446	nictls = 1
	447	ENDIF
	448	IF( nictle < 1 .OR. nictle > jpiglo ) THEN
	449	CALL ctl_warn( ' - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )
	450	nictle = jpiglo
	451	ENDIF
	452	IF( njctls < 1 .OR. njctls > jpjglo ) THEN
	453	CALL ctl_warn( ' - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )
	454	njctls = 1
	455	ENDIF
	456	IF( njctle < 1 .OR. njctle > jpjglo ) THEN
	457	CALL ctl_warn( ' - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )
	458	njctle = jpjglo
	459	ENDIF
	460	ENDIF
	461	ENDIF
	462	!
[9213]	463	IF( 1._wp /= SIGN(1._wp,-0._wp) ) CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows f2003 standard.', &
[11229]	464	& 'Compile with key_nosignedzero enabled:', &
	465	& '--> add -Dkey_nosignedzero to the definition of %CPP in your arch file' )
[5407]	466	!
[9213]	467	#if defined key_agrif
	468	IF( ln_timing ) CALL ctl_stop( 'AGRIF not implemented with ln_timing = true')
	469	#endif
	470	!
[3324]	471	END SUBROUTINE nemo_ctl
	472
	473
	474	SUBROUTINE nemo_closefile
	475	!!----------------------------------------------------------------------
	476	!! * ROUTINE nemo_closefile *
	477	!!
	478	!! ** Purpose : Close the files
	479	!!----------------------------------------------------------------------
	480	!
	481	IF( lk_mpp ) CALL mppsync
	482	!
	483	CALL iom_close ! close all input/output files managed by iom_*
	484	!
[9213]	485	IF( numstp /= -1 ) CLOSE( numstp ) ! time-step file
[9267]	486	IF( numrun /= -1 ) CLOSE( numrun ) ! run statistics file
[4624]	487	IF( lwm.AND.numond /= -1 ) CLOSE( numond ) ! oce output namelist
	488	IF( lwm.AND.numoni /= -1 ) CLOSE( numoni ) ! ice output namelist
[9213]	489	IF( numevo_ice /= -1 ) CLOSE( numevo_ice ) ! ice variables (temp. evolution)
	490	IF( numout /= 6 ) CLOSE( numout ) ! standard model output file
[3324]	491	!
	492	numout = 6 ! redefine numout in case it is used after this point...
	493	!
	494	END SUBROUTINE nemo_closefile
	495
	496
	497	SUBROUTINE nemo_alloc
	498	!!----------------------------------------------------------------------
	499	!! * ROUTINE nemo_alloc *
	500	!!
	501	!! ** Purpose : Allocate all the dynamic arrays of the OPA modules
	502	!!
	503	!! ** Method :
	504	!!----------------------------------------------------------------------
[9213]	505	USE diawri , ONLY : dia_wri_alloc
	506	USE dom_oce , ONLY : dom_oce_alloc
	507	USE bdy_oce , ONLY : ln_bdy, bdy_oce_alloc
[9019]	508	USE oce ! mandatory for sea-ice because needed for bdy arrays
[3324]	509	!
[7646]	510	INTEGER :: ierr
[3324]	511	!!----------------------------------------------------------------------
	512	!
[9213]	513	ierr = dia_wri_alloc()
	514	ierr = ierr + dom_oce_alloc() ! ocean domain
[9570]	515	ierr = ierr + oce_alloc () ! (tsn...) needed for agrif and/or SI3 and bdy
[9213]	516	ierr = ierr + bdy_oce_alloc() ! bdy masks (incl. initialization)
[3324]	517	!
[10425]	518	CALL mpp_sum( 'nemogcm', ierr )
[9213]	519	IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'nemo_alloc: unable to allocate standard ocean arrays' )
[3324]	520	!
	521	END SUBROUTINE nemo_alloc
	522
[10570]	523	SUBROUTINE nemo_set_cfctl(sn_cfctl, setto, for_all )
	524	!!----------------------------------------------------------------------
	525	!! * ROUTINE nemo_set_cfctl *
	526	!!
	527	!! ** Purpose : Set elements of the output control structure to setto.
	528	!! for_all should be .false. unless all areas are to be
	529	!! treated identically.
	530	!!
	531	!! ** Method : Note this routine can be used to switch on/off some
	532	!! types of output for selected areas but any output types
	533	!! that involve global communications (e.g. mpp_max, glob_sum)
	534	!! should be protected from selective switching by the
	535	!! for_all argument
	536	!!----------------------------------------------------------------------
	537	LOGICAL :: setto, for_all
[10601]	538	TYPE(sn_ctl) :: sn_cfctl
[10570]	539	!!----------------------------------------------------------------------
	540	IF( for_all ) THEN
	541	sn_cfctl%l_runstat = setto
	542	sn_cfctl%l_trcstat = setto
	543	ENDIF
	544	sn_cfctl%l_oceout = setto
	545	sn_cfctl%l_layout = setto
	546	sn_cfctl%l_mppout = setto
	547	sn_cfctl%l_mpptop = setto
	548	END SUBROUTINE nemo_set_cfctl
	549
[3324]	550	!!======================================================================
	551	END MODULE nemogcm
[9213]	552

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

Download in other formats: