Context Navigation

nemogcm.F90 @ 12489

Last change on this file since 12489 was 12377, checked in by acc, 4 years ago

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

Property svn:keywords set to Id

File size: 29.1 KB

Rev	Line
[2574]	1	MODULE nemogcm
	2	!!======================================================================
	3	!! * MODULE nemogcm *
	4	!! Off-line Ocean : passive tracer evolution, dynamics read in files
	5	!!======================================================================
	6	!! History : 3.3 ! 2010-05 (C. Ethe) Full reorganization of the off-line: phasing with the on-line
[7646]	7	!! 3.4 ! 2011-01 (C. Ethe, A. R. Porter, STFC Daresbury) dynamical allocation
	8	!! 4.0 ! 2016-10 (C. Ethe, G. Madec, S. Flavoni) domain configuration / user defined interface
[12377]	9	!! 4.1 ! 2019-08 (A. Coward, D. Storkey) rewrite in preparation for new timestepping scheme
[2574]	10	!!----------------------------------------------------------------------
	11
	12	!!----------------------------------------------------------------------
[9213]	13	!! nemo_gcm : off-line: solve ocean tracer only
	14	!! nemo_gcm : solve ocean dynamics, tracer, biogeochemistry and/or sea-ice
	15	!! nemo_init : initialization of the NEMO system
	16	!! nemo_ctl : initialisation of the contol print
	17	!! nemo_closefile: close remaining open files
	18	!! nemo_alloc : dynamical allocation
	19	!! istate_init : simple initialization to zero of ocean fields
	20	!! stp_ctl : reduced step control (no dynamics in off-line)
[2574]	21	!!----------------------------------------------------------------------
[9213]	22	USE dom_oce ! ocean space domain variables
	23	USE oce ! dynamics and tracers variables
	24	USE trc_oce ! Shared ocean/passive tracers variables
	25	USE c1d ! 1D configuration
	26	USE domain ! domain initialization from coordinate & bathymetry (dom_init routine)
	27	USE closea ! treatment of closed seas (for ln_closea)
	28	USE usrdef_nam ! user defined configuration
	29	USE eosbn2 ! equation of state (eos bn2 routine)
[2574]	30	! ! ocean physics
[9213]	31	USE ldftra ! lateral diffusivity setting (ldf_tra_init routine)
	32	USE ldfslp ! slopes of neutral surfaces (ldf_slp_init routine)
[9751]	33	USE traqsr ! solar radiation penetration (tra_qsr_init routine)
[9213]	34	USE trabbl ! bottom boundary layer (tra_bbl_init routine)
	35	USE traldf ! lateral physics (tra_ldf_init routine)
	36	USE sbcmod ! surface boundary condition (sbc_init routine)
	37	USE phycst ! physical constant (par_cst routine)
	38	USE dtadyn ! Lecture and Interpolation of the dynamical fields
	39	USE trcini ! Initilization of the passive tracers
	40	USE daymod ! calendar (day routine)
	41	USE trcstp ! passive tracer time-stepping (trc_stp routine)
	42	USE dtadyn ! Lecture and interpolation of the dynamical fields
[7646]	43	! ! Passive tracers needs
[9213]	44	USE trc ! passive tracer : variables
	45	USE trcnam ! passive tracer : namelist
	46	USE trcrst ! passive tracer restart
	47	USE diaptr ! Need to initialise this as some variables are used in if statements later
	48	USE sbc_oce , ONLY : ln_rnf
	49	USE sbcrnf ! surface boundary condition : runoffs
[2574]	50	! ! I/O & MPP
[9213]	51	USE iom ! I/O library
	52	USE in_out_manager ! I/O manager
	53	USE mppini ! shared/distributed memory setting (mpp_init routine)
	54	USE lib_mpp ! distributed memory computing
[2574]	55	#if defined key_iomput
[9213]	56	USE xios ! xIOserver
[2574]	57	#endif
[9213]	58	USE prtctl ! Print control (prt_ctl_init routine)
	59	USE timing ! Timing
	60	USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)
	61	USE lbcnfd , ONLY : isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges
[12377]	62	USE step, ONLY : Nbb, Nnn, Naa, Nrhs ! time level indices
[2574]	63
	64	IMPLICIT NONE
	65	PRIVATE
	66
	67	PUBLIC nemo_gcm ! called by nemo.F90
	68
	69	CHARACTER (len=64) :: cform_aaa="( /, 'AAAAAAAA', / ) " ! flag for output listing
	70
	71	!!----------------------------------------------------------------------
[9213]	72	!! NEMO/OFF 4.0 , NEMO Consortium (2018)
[5215]	73	!! $Id$
[10068]	74	!! Software governed by the CeCILL license (see ./LICENSE)
[2574]	75	!!----------------------------------------------------------------------
	76	CONTAINS
	77
	78	SUBROUTINE nemo_gcm
	79	!!----------------------------------------------------------------------
	80	!! * ROUTINE nemo_gcm *
	81	!!
[9213]	82	!! ** Purpose : NEMO solves the primitive equations on an orthogonal
	83	!! curvilinear mesh on the sphere.
[2574]	84	!!
	85	!! ** Method : - model general initialization
	86	!! - launch the time-stepping (dta_dyn and trc_stp)
	87	!! - finalize the run by closing files and communications
	88	!!
	89	!! References : Madec, Delecluse,Imbard, and Levy, 1997: internal report, IPSL.
	90	!! Madec, 2008, internal report, IPSL.
	91	!!----------------------------------------------------------------------
	92	INTEGER :: istp, indic ! time step index
	93	!!----------------------------------------------------------------------
	94
	95	CALL nemo_init ! Initializations
	96
	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 )
[2574]	100
	101	! !-----------------------!
	102	! !== time stepping ==!
	103	! !-----------------------!
	104	istp = nit000
[6140]	105	!
[9213]	106	IF( ln_rnf ) CALL sbc_rnf(istp) ! runoffs initialization
[3827]	107	!
[9213]	108	CALL iom_init( cxios_context ) ! iom_put initialization (must be done after nemo_init for AGRIF+XIOS+OASIS)
[3827]	109	!
[9213]	110	DO WHILE ( istp <= nitend .AND. nstop == 0 ) !== OFF time-stepping ==!
[2574]	111	!
[7646]	112	IF( istp /= nit000 ) CALL day ( istp ) ! Calendar (day was already called at nit000 in day_init)
[9539]	113	CALL iom_setkt ( istp - nit000 + 1, cxios_context ) ! say to iom that we are at time step kstp
[10222]	114	#if defined key_sed_off
[12377]	115	CALL dta_dyn_sed( istp, Nnn ) ! Interpolation of the dynamical fields
[10222]	116	#else
[12377]	117	CALL dta_dyn ( istp, Nbb, Nnn, Naa ) ! Interpolation of the dynamical fields
[12026]	118	#endif
[12377]	119	CALL trc_stp ( istp, Nbb, Nnn, Nrhs, Naa ) ! time-stepping
[12026]	120	#if ! defined key_sed_off
[12377]	121	IF( .NOT.ln_linssh ) CALL dta_dyn_atf( istp, Nbb, Nnn, Naa ) ! time filter of sea surface height and vertical scale factors
[10222]	122	#endif
[12377]	123	! Swap time levels
	124	Nrhs = Nbb
	125	Nbb = Nnn
	126	Nnn = Naa
	127	Naa = Nrhs
	128	!
	129	#if ! defined key_sed_off
	130	IF( .NOT.ln_linssh ) CALL dta_dyn_sf_interp( istp, Nnn ) ! calculate now grid parameters
	131	#endif
[7646]	132	CALL stp_ctl ( istp, indic ) ! Time loop: control and print
[2574]	133	istp = istp + 1
	134	END DO
[9213]	135	!
[3769]	136	#if defined key_iomput
[5504]	137	CALL iom_context_finalize( cxios_context ) ! needed for XIOS+AGRIF
[3769]	138	#endif
[2574]	139
	140	! !------------------------!
	141	! !== finalize the run ==!
	142	! !------------------------!
	143	IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA
	144
	145	IF( nstop /= 0 .AND. lwp ) THEN ! error print
[11536]	146	WRITE(ctmp1,*) ' ==>>> nemo_gcm: a total of ', nstop, ' errors have been found'
	147	CALL ctl_stop( ctmp1 )
[2574]	148	ENDIF
	149	!
[9124]	150	IF( ln_timing ) CALL timing_finalize
[3294]	151	!
[2574]	152	CALL nemo_closefile
	153	!
[9213]	154	#if defined key_iomput
	155	CALL xios_finalize ! end mpp communications with xios
	156	#else
	157	IF( lk_mpp ) CALL mppstop ! end mpp communications
	158	#endif
[2574]	159	!
[11536]	160	IF(lwm) THEN
	161	IF( nstop == 0 ) THEN ; STOP 0
	162	ELSE ; STOP 123
	163	ENDIF
	164	ENDIF
	165	!
[2574]	166	END SUBROUTINE nemo_gcm
	167
	168
	169	SUBROUTINE nemo_init
	170	!!----------------------------------------------------------------------
[9213]	171	!! * ROUTINE nemo_init *
[2574]	172	!!
	173	!! ** Purpose : initialization of the nemo model in off-line mode
	174	!!----------------------------------------------------------------------
[11536]	175	INTEGER :: ios, ilocal_comm ! local integers
[2574]	176	!!
[12377]	177	NAMELIST/namctl/ sn_cfctl, nn_print, nn_ictls, nn_ictle, &
[10570]	178	& nn_isplt , nn_jsplt, nn_jctls, nn_jctle, &
[9019]	179	& ln_timing, ln_diacfl
[9213]	180	NAMELIST/namcfg/ ln_read_cfg, cn_domcfg, ln_closea, ln_write_cfg, cn_domcfg_out, ln_use_jattr
[2574]	181	!!----------------------------------------------------------------------
[9213]	182	!
[5407]	183	cxios_context = 'nemo'
[3716]	184	!
[11536]	185	! !-------------------------------------------------!
	186	! ! set communicator & select the local rank !
	187	! ! must be done as soon as possible to get narea !
	188	! !-------------------------------------------------!
[2574]	189	!
[11536]	190	#if defined key_iomput
	191	CALL xios_initialize( "for_xios_mpi_id", return_comm=ilocal_comm ) ! nemo local communicator given by xios
	192	CALL mpp_start( ilocal_comm )
	193	#else
	194	CALL mpp_start( )
	195	#endif
	196	!
	197	narea = mpprank + 1 ! mpprank: the rank of proc (0 --> mppsize -1 )
	198	lwm = (narea == 1) ! control of output namelists
	199	!
	200	! !---------------------------------------------------------------!
	201	! ! Open output files, reference and configuration namelist files !
	202	! !---------------------------------------------------------------!
	203	!
	204	! open ocean.output as soon as possible to get all output prints (including errors messages)
	205	IF( lwm ) CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
	206	! open reference and configuration namelist files
[12377]	207	CALL load_nml( numnam_ref, 'namelist_ref', -1, lwm )
	208	CALL load_nml( numnam_cfg, 'namelist_cfg', -1, lwm )
[11536]	209	IF( lwm ) CALL ctl_opn( numond, 'output.namelist.dyn', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
	210	! open /dev/null file to be able to supress output write easily
	211	CALL ctl_opn( numnul, '/dev/null', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE. )
	212	!
	213	! !--------------------!
[12377]	214	! ! Open listing units ! -> need sn_cfctl from namctl to define lwp
[11536]	215	! !--------------------!
	216	!
[4147]	217	READ ( numnam_ref, namctl, IOSTAT = ios, ERR = 901 )
[11536]	218	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namctl in reference namelist' )
[4147]	219	READ ( numnam_cfg, namctl, IOSTAT = ios, ERR = 902 )
[11536]	220	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namctl in configuration namelist' )
[4147]	221	!
[12377]	222	! finalize the definition of namctl variables
	223	IF( sn_cfctl%l_allon ) THEN
	224	! Turn on all options.
	225	CALL nemo_set_cfctl( sn_cfctl, .TRUE., .TRUE. )
	226	! Ensure all processors are active
	227	sn_cfctl%procmin = 0 ; sn_cfctl%procmax = 1000000 ; sn_cfctl%procincr = 1
	228	ELSEIF( sn_cfctl%l_config ) THEN
	229	! Activate finer control of report outputs
	230	! optionally switch off output from selected areas (note this only
	231	! applies to output which does not involve global communications)
	232	IF( ( narea < sn_cfctl%procmin .OR. narea > sn_cfctl%procmax ) .OR. &
	233	& ( MOD( narea - sn_cfctl%procmin, sn_cfctl%procincr ) /= 0 ) ) &
	234	& CALL nemo_set_cfctl( sn_cfctl, .FALSE., .FALSE. )
	235	ELSE
	236	! turn off all options.
	237	CALL nemo_set_cfctl( sn_cfctl, .FALSE., .TRUE. )
	238	ENDIF
[7646]	239	!
[12377]	240	lwp = (narea == 1) .OR. sn_cfctl%l_oceout ! control of all listing output print
	241	!
[2574]	242	IF(lwp) THEN ! open listing units
	243	!
[11536]	244	IF( .NOT. lwm ) & ! alreay opened for narea == 1
	245	& CALL ctl_opn( numout, 'ocean.output', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, -1, .FALSE., narea )
[2574]	246	!
	247	WRITE(numout,*)
[11536]	248	WRITE(numout,*) ' CNRS - NERC - Met OFFICE - MERCATOR-ocean - CMCC'
[2574]	249	WRITE(numout,*) ' NEMO team'
[9213]	250	WRITE(numout,*) ' Off-line TOP Model'
[10570]	251	WRITE(numout,*) ' NEMO version 4.0 (2019) '
[2574]	252	WRITE(numout,*)
[10570]	253	WRITE(numout,*) " ._ ._ ._ ._ ._ "
	254	WRITE(numout,*) " _.-._)`\_.-._)`\_.-._)`\_.-._)`\_.-._)`\_ "
[2574]	255	WRITE(numout,*)
[10570]	256	WRITE(numout,*) " o _, _, "
	257	WRITE(numout,*) " o .' ( .-' / "
	258	WRITE(numout,*) " o _/..._'. .' / "
	259	WRITE(numout,*) " ( o .-'` ` '-./ _.' "
	260	WRITE(numout,*) " ) ( o) ;= <_ ( "
	261	WRITE(numout,*) " ( '-.,\\__ __.-;`\ '. ) "
	262	WRITE(numout,*) " ) ) \) \|`\ \) '. \ ( ( "
	263	WRITE(numout,*) " ( ( \_/ '-._\ ) ) "
	264	WRITE(numout,*) " ) ) ` ( ( "
	265	WRITE(numout,*) " ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ "
	266	WRITE(numout,*)
[2574]	267	!
[9213]	268	WRITE(numout,cform_aaa) ! Flag AAAAAAA
	269	!
[2574]	270	ENDIF
[10457]	271	!
[11536]	272	IF(lwm) WRITE( numond, namctl )
	273	!
	274	! !------------------------------------!
	275	! ! Set global domain size parameters !
	276	! !------------------------------------!
	277	!
	278	READ ( numnam_ref, namcfg, IOSTAT = ios, ERR = 903 )
	279	903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfg in reference namelist' )
	280	READ ( numnam_cfg, namcfg, IOSTAT = ios, ERR = 904 )
	281	904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namcfg in configuration namelist' )
	282	!
	283	IF( ln_read_cfg ) THEN ! Read sizes in domain configuration file
	284	CALL domain_cfg ( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )
	285	ELSE ! user-defined namelist
	286	CALL usr_def_nam( cn_cfg, nn_cfg, jpiglo, jpjglo, jpkglo, jperio )
	287	ENDIF
	288	!
	289	IF(lwm) WRITE( numond, namcfg )
	290	l_offline = .true. ! passive tracers are run offline
	291	!
	292	! !-----------------------------------------!
	293	! ! mpp parameters and domain decomposition !
	294	! !-----------------------------------------!
	295	!
	296	CALL mpp_init
[2715]	297
[9213]	298	! Now we know the dimensions of the grid and numout has been set: we can allocate arrays
[2715]	299	CALL nemo_alloc()
	300
[12377]	301	! Initialise time level indices
	302	Nbb = 1; Nnn = 2; Naa = 3; Nrhs = Naa
	303
	304
[9213]	305	! !-------------------------------!
	306	! ! NEMO general initialization !
	307	! !-------------------------------!
[2574]	308
[9213]	309	CALL nemo_ctl ! Control prints
[2574]	310	!
[9213]	311	! ! General initialization
[9019]	312	IF( ln_timing ) CALL timing_init
	313	IF( ln_timing ) CALL timing_start( 'nemo_init')
[3294]	314	!
[9367]	315	CALL phy_cst ! Physical constants
	316	CALL eos_init ! Equation of state
	317	IF( lk_c1d ) CALL c1d_init ! 1D column configuration
[12377]	318	CALL dom_init( Nbb, Nnn, Naa, "OPA") ! Domain
	319	IF( sn_cfctl%l_prtctl ) &
	320	& CALL prt_ctl_init ! Print control
[7646]	321
[12377]	322	CALL istate_init( Nnn, Naa ) ! ocean initial state (Dynamics and tracers)
[7646]	323
[12377]	324	CALL sbc_init( Nbb, Nnn, Naa ) ! Forcings : surface module
[2574]	325
[9213]	326	! ! Tracer physics
	327	CALL ldf_tra_init ! Lateral ocean tracer physics
	328	CALL ldf_eiv_init ! Eddy induced velocity param
	329	CALL tra_ldf_init ! lateral mixing
	330	IF( l_ldfslp ) CALL ldf_slp_init ! slope of lateral mixing
[9751]	331	IF( ln_traqsr ) CALL tra_qsr_init ! penetrative solar radiation
[9213]	332	IF( ln_trabbl ) CALL tra_bbl_init ! advective (and/or diffusive) bottom boundary layer scheme
[2715]	333
[9213]	334	! ! Passive tracers
[9019]	335	CALL trc_nam_run ! Needed to get restart parameters for passive tracers
	336	CALL trc_rst_cal( nit000, 'READ' ) ! calendar
[10222]	337	#if defined key_sed_off
[12377]	338	CALL dta_dyn_sed_init( Nnn ) ! Initialization for the dynamics
[10222]	339	#else
[12377]	340	CALL dta_dyn_init( Nbb, Nnn, Naa ) ! Initialization for the dynamics
[10222]	341	#endif
[2574]	342
[12377]	343	CALL trc_init( Nbb, Nnn, Naa ) ! Passive tracers initialization
[9213]	344	CALL dia_ptr_init ! Poleward TRansports initialization
	345
[5504]	346	IF(lwp) WRITE(numout,cform_aaa) ! Flag AAAAAAA
[4749]	347	!
[9019]	348	IF( ln_timing ) CALL timing_stop( 'nemo_init')
[3294]	349	!
[2574]	350	END SUBROUTINE nemo_init
	351
	352
	353	SUBROUTINE nemo_ctl
	354	!!----------------------------------------------------------------------
	355	!! * ROUTINE nemo_ctl *
	356	!!
[7646]	357	!! ** Purpose : control print setting
[2574]	358	!!
[12377]	359	!! ** Method : - print namctl and namcfg information and check some consistencies
[2574]	360	!!----------------------------------------------------------------------
	361	!
[7646]	362	IF(lwp) THEN ! control print
[2574]	363	WRITE(numout,*)
[7646]	364	WRITE(numout,*) 'nemo_ctl: Control prints'
[9213]	365	WRITE(numout,*) '~~~~~~~~'
[2574]	366	WRITE(numout,*) ' Namelist namctl'
[12377]	367	WRITE(numout,*) ' sn_cfctl%l_glochk = ', sn_cfctl%l_glochk
	368	WRITE(numout,*) ' sn_cfctl%l_allon = ', sn_cfctl%l_allon
[10570]	369	WRITE(numout,*) ' finer control over o/p sn_cfctl%l_config = ', sn_cfctl%l_config
	370	WRITE(numout,*) ' sn_cfctl%l_runstat = ', sn_cfctl%l_runstat
	371	WRITE(numout,*) ' sn_cfctl%l_trcstat = ', sn_cfctl%l_trcstat
	372	WRITE(numout,*) ' sn_cfctl%l_oceout = ', sn_cfctl%l_oceout
	373	WRITE(numout,*) ' sn_cfctl%l_layout = ', sn_cfctl%l_layout
[12377]	374	WRITE(numout,*) ' sn_cfctl%l_prtctl = ', sn_cfctl%l_prtctl
	375	WRITE(numout,*) ' sn_cfctl%l_prttrc = ', sn_cfctl%l_prttrc
	376	WRITE(numout,*) ' sn_cfctl%l_oasout = ', sn_cfctl%l_oasout
[10570]	377	WRITE(numout,*) ' sn_cfctl%procmin = ', sn_cfctl%procmin
	378	WRITE(numout,*) ' sn_cfctl%procmax = ', sn_cfctl%procmax
	379	WRITE(numout,*) ' sn_cfctl%procincr = ', sn_cfctl%procincr
	380	WRITE(numout,*) ' sn_cfctl%ptimincr = ', sn_cfctl%ptimincr
[2574]	381	WRITE(numout,*) ' level of print nn_print = ', nn_print
	382	WRITE(numout,*) ' Start i indice for SUM control nn_ictls = ', nn_ictls
	383	WRITE(numout,*) ' End i indice for SUM control nn_ictle = ', nn_ictle
	384	WRITE(numout,*) ' Start j indice for SUM control nn_jctls = ', nn_jctls
	385	WRITE(numout,*) ' End j indice for SUM control nn_jctle = ', nn_jctle
	386	WRITE(numout,*) ' number of proc. following i nn_isplt = ', nn_isplt
	387	WRITE(numout,*) ' number of proc. following j nn_jsplt = ', nn_jsplt
[9019]	388	WRITE(numout,*) ' timing by routine ln_timing = ', ln_timing
	389	WRITE(numout,*) ' CFL diagnostics ln_diacfl = ', ln_diacfl
[2574]	390	ENDIF
	391	!
	392	nprint = nn_print ! convert DOCTOR namelist names into OLD names
	393	nictls = nn_ictls
	394	nictle = nn_ictle
	395	njctls = nn_jctls
	396	njctle = nn_jctle
	397	isplt = nn_isplt
	398	jsplt = nn_jsplt
[7646]	399
	400	IF(lwp) THEN ! control print
[4147]	401	WRITE(numout,*)
	402	WRITE(numout,*) ' Namelist namcfg'
[9213]	403	WRITE(numout,*) ' read domain configuration file ln_read_cfg = ', ln_read_cfg
[7646]	404	WRITE(numout,*) ' filename to be read cn_domcfg = ', TRIM(cn_domcfg)
[9436]	405	WRITE(numout,*) ' keep closed seas in the domain (if exist) ln_closea = ', ln_closea
[9213]	406	WRITE(numout,*) ' create a configuration definition file ln_write_cfg = ', ln_write_cfg
[7646]	407	WRITE(numout,*) ' filename to be written cn_domcfg_out = ', TRIM(cn_domcfg_out)
	408	WRITE(numout,*) ' use file attribute if exists as i/p j-start ln_use_jattr = ', ln_use_jattr
[4147]	409	ENDIF
[9213]	410	IF( .NOT.ln_read_cfg ) ln_closea = .false. ! dealing possible only with a domcfg file
	411	!
[2574]	412	! ! Parameter control
	413	!
[12377]	414	IF( sn_cfctl%l_prtctl .OR. sn_cfctl%l_prttrc ) THEN ! sub-domain area indices for the control prints
[7646]	415	IF( lk_mpp .AND. jpnij > 1 ) THEN
	416	isplt = jpni ; jsplt = jpnj ; ijsplt = jpni*jpnj ! the domain is forced to the real split domain
[2574]	417	ELSE
	418	IF( isplt == 1 .AND. jsplt == 1 ) THEN
	419	CALL ctl_warn( ' - isplt & jsplt are equal to 1', &
	420	& ' - the print control will be done over the whole domain' )
	421	ENDIF
	422	ijsplt = isplt * jsplt ! total number of processors ijsplt
	423	ENDIF
	424	IF(lwp) WRITE(numout,*)' - The total number of processors over which the'
	425	IF(lwp) WRITE(numout,*)' print control will be done is ijsplt : ', ijsplt
	426	!
	427	! ! indices used for the SUM control
	428	IF( nictls+nictle+njctls+njctle == 0 ) THEN ! print control done over the default area
	429	lsp_area = .FALSE.
	430	ELSE ! print control done over a specific area
	431	lsp_area = .TRUE.
	432	IF( nictls < 1 .OR. nictls > jpiglo ) THEN
	433	CALL ctl_warn( ' - nictls must be 1<=nictls>=jpiglo, it is forced to 1' )
	434	nictls = 1
	435	ENDIF
	436	IF( nictle < 1 .OR. nictle > jpiglo ) THEN
	437	CALL ctl_warn( ' - nictle must be 1<=nictle>=jpiglo, it is forced to jpiglo' )
	438	nictle = jpiglo
	439	ENDIF
	440	IF( njctls < 1 .OR. njctls > jpjglo ) THEN
	441	CALL ctl_warn( ' - njctls must be 1<=njctls>=jpjglo, it is forced to 1' )
	442	njctls = 1
	443	ENDIF
	444	IF( njctle < 1 .OR. njctle > jpjglo ) THEN
	445	CALL ctl_warn( ' - njctle must be 1<=njctle>=jpjglo, it is forced to jpjglo' )
	446	njctle = jpjglo
	447	ENDIF
	448	ENDIF
	449	ENDIF
	450	!
[9213]	451	IF( 1._wp /= SIGN(1._wp,-0._wp) ) CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows f2003 standard.', &
	452	& 'Compile with key_nosignedzero enabled' )
[3764]	453	!
[2574]	454	END SUBROUTINE nemo_ctl
	455
	456
	457	SUBROUTINE nemo_closefile
	458	!!----------------------------------------------------------------------
	459	!! * ROUTINE nemo_closefile *
	460	!!
	461	!! ** Purpose : Close the files
	462	!!----------------------------------------------------------------------
	463	!
[9213]	464	IF( lk_mpp ) CALL mppsync
[2574]	465	!
	466	CALL iom_close ! close all input/output files managed by iom_*
	467	!
	468	IF( numstp /= -1 ) CLOSE( numstp ) ! time-step file
[7646]	469	IF( lwm.AND.numond /= -1 ) CLOSE( numond ) ! oce output namelist
[9213]	470	!
[2574]	471	numout = 6 ! redefine numout in case it is used after this point...
	472	!
	473	END SUBROUTINE nemo_closefile
	474
[2715]	475
	476	SUBROUTINE nemo_alloc
	477	!!----------------------------------------------------------------------
	478	!! * ROUTINE nemo_alloc *
	479	!!
	480	!! ** Purpose : Allocate all the dynamic arrays of the OPA modules
	481	!!
	482	!! ** Method :
	483	!!----------------------------------------------------------------------
[9213]	484	USE diawri , ONLY : dia_wri_alloc
	485	USE dom_oce, ONLY : dom_oce_alloc
	486	USE zdf_oce, ONLY : zdf_oce_alloc
	487	USE trc_oce, ONLY : trc_oce_alloc
[2715]	488	!
	489	INTEGER :: ierr
	490	!!----------------------------------------------------------------------
	491	!
[9213]	492	ierr = oce_alloc () ! ocean
	493	ierr = ierr + dia_wri_alloc()
	494	ierr = ierr + dom_oce_alloc() ! ocean domain
	495	ierr = ierr + zdf_oce_alloc() ! ocean vertical physics
	496	ierr = ierr + trc_oce_alloc() ! shared TRC / TRA arrays
[2715]	497	!
[10425]	498	CALL mpp_sum( 'nemogcm', ierr )
[2715]	499	IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'nemo_alloc: unable to allocate standard ocean arrays' )
	500	!
	501	END SUBROUTINE nemo_alloc
	502
[10570]	503	SUBROUTINE nemo_set_cfctl(sn_cfctl, setto, for_all )
	504	!!----------------------------------------------------------------------
	505	!! * ROUTINE nemo_set_cfctl *
	506	!!
	507	!! ** Purpose : Set elements of the output control structure to setto.
	508	!! for_all should be .false. unless all areas are to be
	509	!! treated identically.
	510	!!
	511	!! ** Method : Note this routine can be used to switch on/off some
	512	!! types of output for selected areas but any output types
	513	!! that involve global communications (e.g. mpp_max, glob_sum)
	514	!! should be protected from selective switching by the
	515	!! for_all argument
	516	!!----------------------------------------------------------------------
	517	LOGICAL :: setto, for_all
[10601]	518	TYPE(sn_ctl) :: sn_cfctl
[10570]	519	!!----------------------------------------------------------------------
	520	IF( for_all ) THEN
	521	sn_cfctl%l_runstat = setto
	522	sn_cfctl%l_trcstat = setto
	523	ENDIF
	524	sn_cfctl%l_oceout = setto
	525	sn_cfctl%l_layout = setto
[12377]	526	sn_cfctl%l_prtctl = setto
	527	sn_cfctl%l_prttrc = setto
	528	sn_cfctl%l_oasout = setto
[10570]	529	END SUBROUTINE nemo_set_cfctl
	530
[12377]	531	SUBROUTINE istate_init( Kmm, Kaa )
[5504]	532	!!----------------------------------------------------------------------
	533	!! * ROUTINE istate_init *
	534	!!
	535	!! ** Purpose : Initialization to zero of the dynamics and tracers.
	536	!!----------------------------------------------------------------------
[12377]	537	INTEGER, INTENT(in) :: Kmm, Kaa ! ocean time level indices
[5504]	538	!
	539	! now fields ! after fields !
[12377]	540	uu (:,:,:,Kmm) = 0._wp ; uu(:,:,:,Kaa) = 0._wp !
	541	vv (:,:,:,Kmm) = 0._wp ; vv(:,:,:,Kaa) = 0._wp !
	542	ww (:,:,:) = 0._wp ! !
	543	hdiv (:,:,:) = 0._wp ! !
	544	ts (:,:,:,:,Kmm) = 0._wp ! !
[5504]	545	!
	546	rhd (:,:,:) = 0.e0
	547	rhop (:,:,:) = 0.e0
	548	rn2 (:,:,:) = 0.e0
	549	!
	550	END SUBROUTINE istate_init
	551
[9213]	552
[5504]	553	SUBROUTINE stp_ctl( kt, kindic )
	554	!!----------------------------------------------------------------------
	555	!! * ROUTINE stp_ctl *
	556	!!
	557	!! ** Purpose : Control the run
	558	!!
	559	!! ** Method : - Save the time step in numstp
	560	!!
	561	!! ** Actions : 'time.step' file containing the last ocean time-step
	562	!!----------------------------------------------------------------------
	563	INTEGER, INTENT(in ) :: kt ! ocean time-step index
	564	INTEGER, INTENT(inout) :: kindic ! indicator of solver convergence
	565	!!----------------------------------------------------------------------
	566	!
[10425]	567	IF( kt == nit000 .AND. lwm ) THEN
[5504]	568	WRITE(numout,*)
	569	WRITE(numout,*) 'stp_ctl : time-stepping control'
	570	WRITE(numout,*) '~~~~~~~'
	571	! open time.step file
	572	CALL ctl_opn( numstp, 'time.step', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea )
	573	ENDIF
	574	!
[10425]	575	IF(lwm) WRITE ( numstp, '(1x, i8)' ) kt !* save the current time step in numstp
	576	IF(lwm) REWIND( numstp ) ! --------------------------
[5504]	577	!
	578	END SUBROUTINE stp_ctl
[2574]	579	!!======================================================================
	580	END MODULE nemogcm

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

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

Context Navigation

source: NEMO/trunk/src/OFF/nemogcm.F90 @ 12489

Download in other formats: