Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

nemogcm.F90 @ 14238

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

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

New URL for NEMO forge! http://forge.nemo-ocean.eu

Context Navigation

source: NEMO/branches/UKMO/NEMO_4.0_mirror_SI3_decoupled/src/SAS/nemogcm.F90 @ 14238

Download in other formats: