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/releases/r4.0/r4.0-HEAD/src/SAS – NEMO

Context Navigation

source: NEMO/releases/r4.0/r4.0-HEAD/src/SAS/nemogcm.F90 @ 13013

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

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

Download in other formats: