Context Navigation

domain.F90 @ 12377

Last change on this file since 12377 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: 35.8 KB

Rev	Line
[3]	1	MODULE domain
	2	!!==============================================================================
	3	!! * MODULE domain *
	4	!! Ocean initialization : domain initialization
	5	!!==============================================================================
[1438]	6	!! History : OPA ! 1990-10 (C. Levy - G. Madec) Original code
	7	!! ! 1992-01 (M. Imbard) insert time step initialization
	8	!! ! 1996-06 (G. Madec) generalized vertical coordinate
	9	!! ! 1997-02 (G. Madec) creation of domwri.F
	10	!! ! 2001-05 (E.Durand - G. Madec) insert closed sea
	11	!! NEMO 1.0 ! 2002-08 (G. Madec) F90: Free form and module
	12	!! 2.0 ! 2005-11 (V. Garnier) Surface pressure gradient organization
[2528]	13	!! 3.3 ! 2010-11 (G. Madec) initialisation in C1D configuration
[4152]	14	!! 3.6 ! 2013 ( J. Simeon, C. Calone, G. Madec, C. Ethe ) Online coarsening of outputs
[6140]	15	!! 3.7 ! 2015-11 (G. Madec, A. Coward) time varying zgr by default
[7646]	16	!! 4.0 ! 2016-10 (G. Madec, S. Flavoni) domain configuration / user defined interface
[3]	17	!!----------------------------------------------------------------------
[1438]	18
	19	!!----------------------------------------------------------------------
[7646]	20	!! dom_init : initialize the space and time domain
	21	!! dom_glo : initialize global domain <--> local domain indices
	22	!! dom_nam : read and contral domain namelists
	23	!! dom_ctl : control print for the ocean domain
	24	!! domain_cfg : read the global domain size in domain configuration file
	25	!! cfg_write : create the domain configuration file
[3]	26	!!----------------------------------------------------------------------
[7646]	27	USE oce ! ocean variables
	28	USE dom_oce ! domain: ocean
	29	USE sbc_oce ! surface boundary condition: ocean
	30	USE trc_oce ! shared ocean & passive tracers variab
	31	USE phycst ! physical constants
	32	USE domhgr ! domain: set the horizontal mesh
	33	USE domzgr ! domain: set the vertical mesh
	34	USE dommsk ! domain: set the mask system
	35	USE domwri ! domain: write the meshmask file
	36	USE domvvl ! variable volume
	37	USE c1d ! 1D configuration
	38	USE dyncor_c1d ! 1D configuration: Coriolis term (cor_c1d routine)
[12377]	39	USE wet_dry, ONLY : ll_wd
	40	USE closea , ONLY : dom_clo ! closed seas
[5836]	41	!
[7646]	42	USE in_out_manager ! I/O manager
	43	USE iom ! I/O library
	44	USE lbclnk ! ocean lateral boundary condition (or mpp link)
	45	USE lib_mpp ! distributed memory computing library
[3]	46
	47	IMPLICIT NONE
	48	PRIVATE
	49
[7646]	50	PUBLIC dom_init ! called by nemogcm.F90
	51	PUBLIC domain_cfg ! called by nemogcm.F90
[3]	52
[1438]	53	!!-------------------------------------------------------------------------
[9598]	54	!! NEMO/OCE 4.0 , NEMO Consortium (2018)
[888]	55	!! $Id$
[10068]	56	!! Software governed by the CeCILL license (see ./LICENSE)
[1438]	57	!!-------------------------------------------------------------------------
[3]	58	CONTAINS
	59
[12377]	60	SUBROUTINE dom_init( Kbb, Kmm, Kaa, cdstr )
[3]	61	!!----------------------------------------------------------------------
	62	!! * ROUTINE dom_init *
	63	!!
	64	!! ** Purpose : Domain initialization. Call the routines that are
[1601]	65	!! required to create the arrays which define the space
	66	!! and time domain of the ocean model.
[3]	67	!!
[1601]	68	!! ** Method : - dom_msk: compute the masks from the bathymetry file
	69	!! - dom_hgr: compute or read the horizontal grid-point position
	70	!! and scale factors, and the coriolis factor
	71	!! - dom_zgr: define the vertical coordinate and the bathymetry
[9169]	72	!! - dom_wri: create the meshmask file (ln_meshmask=T)
[2528]	73	!! - 1D configuration, move Coriolis, u and v at T-point
[3]	74	!!----------------------------------------------------------------------
[12377]	75	INTEGER , INTENT(in) :: Kbb, Kmm, Kaa ! ocean time level indices
	76	CHARACTER (len=*), INTENT(in) :: cdstr ! model: NEMO or SAS. Determines core restart variables
	77	!
[7646]	78	INTEGER :: ji, jj, jk, ik ! dummy loop indices
	79	INTEGER :: iconf = 0 ! local integers
	80	CHARACTER (len=64) :: cform = "(A12, 3(A13, I7))"
	81	INTEGER , DIMENSION(jpi,jpj) :: ik_top , ik_bot ! top and bottom ocean level
	82	REAL(wp), DIMENSION(jpi,jpj) :: z1_hu_0, z1_hv_0
[3]	83	!!----------------------------------------------------------------------
[1601]	84	!
[7646]	85	IF(lwp) THEN ! Ocean domain Parameters (control print)
[3]	86	WRITE(numout,*)
	87	WRITE(numout,*) 'dom_init : domain initialization'
	88	WRITE(numout,*) '~~~~~~~~'
[7646]	89	!
	90	WRITE(numout,*) ' Domain info'
	91	WRITE(numout,*) ' dimension of model:'
	92	WRITE(numout,*) ' Local domain Global domain Data domain '
	93	WRITE(numout,cform) ' ',' jpi : ', jpi, ' jpiglo : ', jpiglo
	94	WRITE(numout,cform) ' ',' jpj : ', jpj, ' jpjglo : ', jpjglo
	95	WRITE(numout,cform) ' ',' jpk : ', jpk, ' jpkglo : ', jpkglo
	96	WRITE(numout,cform) ' ' ,' jpij : ', jpij
	97	WRITE(numout,*) ' mpp local domain info (mpp):'
[9019]	98	WRITE(numout,*) ' jpni : ', jpni, ' nn_hls : ', nn_hls
	99	WRITE(numout,*) ' jpnj : ', jpnj, ' nn_hls : ', nn_hls
[7646]	100	WRITE(numout,*) ' jpnij : ', jpnij
	101	WRITE(numout,*) ' lateral boundary of the Global domain : jperio = ', jperio
	102	SELECT CASE ( jperio )
	103	CASE( 0 ) ; WRITE(numout,*) ' (i.e. closed)'
	104	CASE( 1 ) ; WRITE(numout,*) ' (i.e. cyclic east-west)'
[11536]	105	CASE( 2 ) ; WRITE(numout,*) ' (i.e. cyclic north-south)'
[7646]	106	CASE( 3 ) ; WRITE(numout,*) ' (i.e. north fold with T-point pivot)'
	107	CASE( 4 ) ; WRITE(numout,*) ' (i.e. cyclic east-west and north fold with T-point pivot)'
	108	CASE( 5 ) ; WRITE(numout,*) ' (i.e. north fold with F-point pivot)'
	109	CASE( 6 ) ; WRITE(numout,*) ' (i.e. cyclic east-west and north fold with F-point pivot)'
[7822]	110	CASE( 7 ) ; WRITE(numout,*) ' (i.e. cyclic east-west and north-south)'
[7646]	111	CASE DEFAULT
	112	CALL ctl_stop( 'jperio is out of range' )
	113	END SELECT
	114	WRITE(numout,*) ' Ocean model configuration used:'
[9169]	115	WRITE(numout,*) ' cn_cfg = ', TRIM( cn_cfg ), ' nn_cfg = ', nn_cfg
[3]	116	ENDIF
[9405]	117	lwxios = .FALSE.
	118	ln_xios_read = .FALSE.
[1601]	119	!
[7646]	120	! !== Reference coordinate system ==!
[6140]	121	!
[7646]	122	CALL dom_glo ! global domain versus local domain
	123	CALL dom_nam ! read namelist ( namrun, namdom )
[9367]	124	!
	125	IF( lwxios ) THEN
	126	!define names for restart write and set core output (restart.F90)
	127	CALL iom_set_rst_vars(rst_wfields)
	128	CALL iom_set_rstw_core(cdstr)
	129	ENDIF
	130	!reset namelist for SAS
	131	IF(cdstr == 'SAS') THEN
	132	IF(lrxios) THEN
	133	IF(lwp) write(numout,*) 'Disable reading restart file using XIOS for SAS'
	134	lrxios = .FALSE.
	135	ENDIF
	136	ENDIF
	137	!
[12377]	138	CALL dom_hgr ! Horizontal mesh
	139
	140	IF( ln_closea ) CALL dom_clo ! Read in masks to define closed seas and lakes
	141
	142	CALL dom_zgr( ik_top, ik_bot ) ! Vertical mesh and bathymetry
	143
	144	CALL dom_msk( ik_top, ik_bot ) ! Masks
[7646]	145	!
[7753]	146	ht_0(:,:) = 0._wp ! Reference ocean thickness
	147	hu_0(:,:) = 0._wp
	148	hv_0(:,:) = 0._wp
[7646]	149	DO jk = 1, jpk
[7753]	150	ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk)
	151	hu_0(:,:) = hu_0(:,:) + e3u_0(:,:,jk) * umask(:,:,jk)
	152	hv_0(:,:) = hv_0(:,:) + e3v_0(:,:,jk) * vmask(:,:,jk)
[4490]	153	END DO
	154	!
[7646]	155	! !== time varying part of coordinate system ==!
[1601]	156	!
[7646]	157	IF( ln_linssh ) THEN != Fix in time : set to the reference one for all
	158	!
[6140]	159	! before ! now ! after !
[12377]	160	gdept(:,:,:,Kbb) = gdept_0 ; gdept(:,:,:,Kmm) = gdept_0 ; gdept(:,:,:,Kaa) = gdept_0 ! depth of grid-points
	161	gdepw(:,:,:,Kbb) = gdepw_0 ; gdepw(:,:,:,Kmm) = gdepw_0 ; gdepw(:,:,:,Kaa) = gdepw_0 !
	162	gde3w = gde3w_0 ! --- !
[6140]	163	!
[12377]	164	e3t(:,:,:,Kbb) = e3t_0 ; e3t(:,:,:,Kmm) = e3t_0 ; e3t(:,:,:,Kaa) = e3t_0 ! scale factors
	165	e3u(:,:,:,Kbb) = e3u_0 ; e3u(:,:,:,Kmm) = e3u_0 ; e3u(:,:,:,Kaa) = e3u_0 !
	166	e3v(:,:,:,Kbb) = e3v_0 ; e3v(:,:,:,Kmm) = e3v_0 ; e3v(:,:,:,Kaa) = e3v_0 !
	167	e3f = e3f_0 ! --- !
	168	e3w(:,:,:,Kbb) = e3w_0 ; e3w(:,:,:,Kmm) = e3w_0 ; e3w(:,:,:,Kaa) = e3w_0 !
	169	e3uw(:,:,:,Kbb) = e3uw_0 ; e3uw(:,:,:,Kmm) = e3uw_0 ; e3uw(:,:,:,Kaa) = e3uw_0 !
	170	e3vw(:,:,:,Kbb) = e3vw_0 ; e3vw(:,:,:,Kmm) = e3vw_0 ; e3vw(:,:,:,Kaa) = e3vw_0 !
[6140]	171	!
[7753]	172	z1_hu_0(:,:) = ssumask(:,:) / ( hu_0(:,:) + 1._wp - ssumask(:,:) ) ! _i mask due to ISF
	173	z1_hv_0(:,:) = ssvmask(:,:) / ( hv_0(:,:) + 1._wp - ssvmask(:,:) )
[6140]	174	!
	175	! before ! now ! after !
[12377]	176	ht = ht_0 ! ! water column thickness
	177	hu(:,:,Kbb) = hu_0 ; hu(:,:,Kmm) = hu_0 ; hu(:,:,Kaa) = hu_0 !
	178	hv(:,:,Kbb) = hv_0 ; hv(:,:,Kmm) = hv_0 ; hv(:,:,Kaa) = hv_0 !
	179	r1_hu(:,:,Kbb) = z1_hu_0 ; r1_hu(:,:,Kmm) = z1_hu_0 ; r1_hu(:,:,Kaa) = z1_hu_0 ! inverse of water column thickness
	180	r1_hv(:,:,Kbb) = z1_hv_0 ; r1_hv(:,:,Kmm) = z1_hv_0 ; r1_hv(:,:,Kaa) = z1_hv_0 !
[6140]	181	!
	182	!
[7646]	183	ELSE != time varying : initialize before/now/after variables
[6140]	184	!
[12377]	185	IF( .NOT.l_offline ) CALL dom_vvl_init( Kbb, Kmm, Kaa )
[6140]	186	!
	187	ENDIF
[2528]	188	!
[6140]	189	IF( lk_c1d ) CALL cor_c1d ! 1D configuration: Coriolis set at T-point
[4370]	190	!
[12377]	191	IF( ln_meshmask ) CALL dom_wri ! Create a domain file
	192	IF( .NOT.ln_rstart ) CALL dom_ctl ! Domain control
[1438]	193	!
[12377]	194	IF( ln_write_cfg ) CALL cfg_write ! create the configuration file
[9169]	195	!
[7646]	196	IF(lwp) THEN
	197	WRITE(numout,*)
[9169]	198	WRITE(numout,*) 'dom_init : ==>>> END of domain initialization'
	199	WRITE(numout,*) '~~~~~~~~'
[7646]	200	WRITE(numout,*)
	201	ENDIF
	202	!
[3]	203	END SUBROUTINE dom_init
	204
	205
[7646]	206	SUBROUTINE dom_glo
	207	!!----------------------------------------------------------------------
	208	!! * ROUTINE dom_glo *
	209	!!
	210	!! ** Purpose : initialization of global domain <--> local domain indices
	211	!!
	212	!! ** Method :
	213	!!
	214	!! ** Action : - mig , mjg : local domain indices ==> global domain indices
	215	!! - mi0 , mi1 : global domain indices ==> local domain indices
	216	!! - mj0,, mj1 (global point not in the local domain ==> mi0>mi1 and/or mj0>mj1)
	217	!!----------------------------------------------------------------------
	218	INTEGER :: ji, jj ! dummy loop argument
	219	!!----------------------------------------------------------------------
	220	!
	221	DO ji = 1, jpi ! local domain indices ==> global domain indices
	222	mig(ji) = ji + nimpp - 1
	223	END DO
	224	DO jj = 1, jpj
	225	mjg(jj) = jj + njmpp - 1
	226	END DO
	227	! ! global domain indices ==> local domain indices
	228	! ! (return (m.0,m.1)=(1,0) if data domain gridpoint is to the west/south of the
	229	! ! local domain, or (m.0,m.1)=(jp.+1,jp.) to the east/north of local domain.
	230	DO ji = 1, jpiglo
	231	mi0(ji) = MAX( 1 , MIN( ji - nimpp + 1, jpi+1 ) )
	232	mi1(ji) = MAX( 0 , MIN( ji - nimpp + 1, jpi ) )
	233	END DO
	234	DO jj = 1, jpjglo
	235	mj0(jj) = MAX( 1 , MIN( jj - njmpp + 1, jpj+1 ) )
	236	mj1(jj) = MAX( 0 , MIN( jj - njmpp + 1, jpj ) )
	237	END DO
	238	IF(lwp) THEN ! control print
	239	WRITE(numout,*)
	240	WRITE(numout,*) 'dom_glo : domain: global <<==>> local '
	241	WRITE(numout,*) '~~~~~~~ '
	242	WRITE(numout,*) ' global domain: jpiglo = ', jpiglo, ' jpjglo = ', jpjglo, ' jpkglo = ', jpkglo
	243	WRITE(numout,*) ' local domain: jpi = ', jpi , ' jpj = ', jpj , ' jpk = ', jpk
	244	WRITE(numout,*)
	245	WRITE(numout,*) ' conversion from local to global domain indices (and vise versa) done'
	246	IF( nn_print >= 1 ) THEN
	247	WRITE(numout,*)
[9019]	248	WRITE(numout,*) ' conversion local ==> global i-index domain (mig)'
[7646]	249	WRITE(numout,25) (mig(ji),ji = 1,jpi)
	250	WRITE(numout,*)
	251	WRITE(numout,*) ' conversion global ==> local i-index domain'
[9019]	252	WRITE(numout,*) ' starting index (mi0)'
[7646]	253	WRITE(numout,25) (mi0(ji),ji = 1,jpiglo)
[9019]	254	WRITE(numout,*) ' ending index (mi1)'
[7646]	255	WRITE(numout,25) (mi1(ji),ji = 1,jpiglo)
	256	WRITE(numout,*)
[9019]	257	WRITE(numout,*) ' conversion local ==> global j-index domain (mjg)'
[7646]	258	WRITE(numout,25) (mjg(jj),jj = 1,jpj)
	259	WRITE(numout,*)
	260	WRITE(numout,*) ' conversion global ==> local j-index domain'
[9019]	261	WRITE(numout,*) ' starting index (mj0)'
[7646]	262	WRITE(numout,25) (mj0(jj),jj = 1,jpjglo)
[9019]	263	WRITE(numout,*) ' ending index (mj1)'
[7646]	264	WRITE(numout,25) (mj1(jj),jj = 1,jpjglo)
	265	ENDIF
	266	ENDIF
	267	25 FORMAT( 100(10x,19i4,/) )
	268	!
	269	END SUBROUTINE dom_glo
	270
	271
[3]	272	SUBROUTINE dom_nam
	273	!!----------------------------------------------------------------------
	274	!! * ROUTINE dom_nam *
	275	!!
	276	!! ** Purpose : read domaine namelists and print the variables.
	277	!!
	278	!! ** input : - namrun namelist
	279	!! - namdom namelist
[2528]	280	!! - namnc4 namelist ! "key_netcdf4" only
[3]	281	!!----------------------------------------------------------------------
	282	USE ioipsl
[9169]	283	!!
	284	INTEGER :: ios ! Local integer
	285	!
[6140]	286	NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list, &
[7646]	287	& nn_no , cn_exp , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl , &
[6140]	288	& nn_it000, nn_itend , nn_date0 , nn_time0 , nn_leapy , nn_istate , &
	289	& nn_stock, nn_write , ln_mskland , ln_clobber , nn_chunksz, nn_euler , &
[12377]	290	& ln_cfmeta, ln_xios_read, nn_wxios
	291	NAMELIST/namdom/ ln_linssh, rn_rdt, rn_atfp, ln_crs, ln_meshmask
[2528]	292	#if defined key_netcdf4
	293	NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
	294	#endif
[3]	295	!!----------------------------------------------------------------------
[7646]	296	!
[9169]	297	IF(lwp) THEN
	298	WRITE(numout,*)
[9190]	299	WRITE(numout,*) 'dom_nam : domain initialization through namelist read'
[9169]	300	WRITE(numout,*) '~~~~~~~ '
	301	ENDIF
	302	!
[9367]	303	!
[4147]	304	READ ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
[11536]	305	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in reference namelist' )
[4147]	306	READ ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
[11536]	307	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namrun in configuration namelist' )
[4624]	308	IF(lwm) WRITE ( numond, namrun )
[1601]	309	!
	310	IF(lwp) THEN ! control print
[9190]	311	WRITE(numout,*) ' Namelist : namrun --- run parameters'
[9490]	312	WRITE(numout,*) ' Assimilation cycle nn_no = ', nn_no
[9169]	313	WRITE(numout,*) ' experiment name for output cn_exp = ', TRIM( cn_exp )
	314	WRITE(numout,*) ' file prefix restart input cn_ocerst_in = ', TRIM( cn_ocerst_in )
	315	WRITE(numout,*) ' restart input directory cn_ocerst_indir = ', TRIM( cn_ocerst_indir )
	316	WRITE(numout,*) ' file prefix restart output cn_ocerst_out = ', TRIM( cn_ocerst_out )
	317	WRITE(numout,*) ' restart output directory cn_ocerst_outdir= ', TRIM( cn_ocerst_outdir )
	318	WRITE(numout,*) ' restart logical ln_rstart = ', ln_rstart
	319	WRITE(numout,*) ' start with forward time step nn_euler = ', nn_euler
	320	WRITE(numout,*) ' control of time step nn_rstctl = ', nn_rstctl
	321	WRITE(numout,*) ' number of the first time step nn_it000 = ', nn_it000
	322	WRITE(numout,*) ' number of the last time step nn_itend = ', nn_itend
	323	WRITE(numout,*) ' initial calendar date aammjj nn_date0 = ', nn_date0
	324	WRITE(numout,*) ' initial time of day in hhmm nn_time0 = ', nn_time0
	325	WRITE(numout,*) ' leap year calendar (0/1) nn_leapy = ', nn_leapy
	326	WRITE(numout,*) ' initial state output nn_istate = ', nn_istate
[5341]	327	IF( ln_rst_list ) THEN
[9169]	328	WRITE(numout,*) ' list of restart dump times nn_stocklist =', nn_stocklist
[5341]	329	ELSE
[9169]	330	WRITE(numout,*) ' frequency of restart file nn_stock = ', nn_stock
[5341]	331	ENDIF
[11536]	332	#if ! defined key_iomput
[9169]	333	WRITE(numout,*) ' frequency of output file nn_write = ', nn_write
[11536]	334	#endif
[9169]	335	WRITE(numout,*) ' mask land points ln_mskland = ', ln_mskland
	336	WRITE(numout,*) ' additional CF standard metadata ln_cfmeta = ', ln_cfmeta
	337	WRITE(numout,*) ' overwrite an existing file ln_clobber = ', ln_clobber
	338	WRITE(numout,*) ' NetCDF chunksize (bytes) nn_chunksz = ', nn_chunksz
[9367]	339	IF( TRIM(Agrif_CFixed()) == '0' ) THEN
	340	WRITE(numout,*) ' READ restart for a single file using XIOS ln_xios_read =', ln_xios_read
	341	WRITE(numout,*) ' Write restart using XIOS nn_wxios = ', nn_wxios
	342	ELSE
	343	WRITE(numout,*) " AGRIF: nn_wxios will be ingored. See setting for parent"
	344	WRITE(numout,*) " AGRIF: ln_xios_read will be ingored. See setting for parent"
	345	ENDIF
[3]	346	ENDIF
	347
[9490]	348	cexper = cn_exp ! conversion DOCTOR names into model names (this should disappear soon)
[1601]	349	nrstdt = nn_rstctl
	350	nit000 = nn_it000
	351	nitend = nn_itend
	352	ndate0 = nn_date0
	353	nleapy = nn_leapy
	354	ninist = nn_istate
[4370]	355	neuler = nn_euler
[9168]	356	IF( neuler == 1 .AND. .NOT. ln_rstart ) THEN
	357	IF(lwp) WRITE(numout,*)
[9169]	358	IF(lwp) WRITE(numout,*)' ==>>> Start from rest (ln_rstart=F)'
	359	IF(lwp) WRITE(numout,*)' an Euler initial time step is used : nn_euler is forced to 0 '
[4370]	360	neuler = 0
	361	ENDIF
[1601]	362	! ! control of output frequency
[11536]	363	IF( .NOT. ln_rst_list ) THEN ! we use nn_stock
	364	IF( nn_stock == -1 ) CALL ctl_warn( 'nn_stock = -1 --> no restart will be done' )
	365	IF( nn_stock == 0 .OR. nn_stock > nitend ) THEN
	366	WRITE(ctmp1,*) 'nn_stock = ', nn_stock, ' it is forced to ', nitend
	367	CALL ctl_warn( ctmp1 )
	368	nn_stock = nitend
	369	ENDIF
[3]	370	ENDIF
[11536]	371	#if ! defined key_iomput
	372	IF( nn_write == -1 ) CALL ctl_warn( 'nn_write = -1 --> no output files will be done' )
	373	IF ( nn_write == 0 ) THEN
	374	WRITE(ctmp1,*) 'nn_write = ', nn_write, ' it is forced to ', nitend
[783]	375	CALL ctl_warn( ctmp1 )
[11536]	376	nn_write = nitend
[3]	377	ENDIF
[11536]	378	#endif
[3]	379
[2528]	380	#if defined key_agrif
[1601]	381	IF( Agrif_Root() ) THEN
[2528]	382	#endif
[9190]	383	IF(lwp) WRITE(numout,*)
[2528]	384	SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL
	385	CASE ( 1 )
	386	CALL ioconf_calendar('gregorian')
[9190]	387	IF(lwp) WRITE(numout,*) ' ==>>> The IOIPSL calendar is "gregorian", i.e. leap year'
[2528]	388	CASE ( 0 )
	389	CALL ioconf_calendar('noleap')
[9190]	390	IF(lwp) WRITE(numout,*) ' ==>>> The IOIPSL calendar is "noleap", i.e. no leap year'
[2528]	391	CASE ( 30 )
	392	CALL ioconf_calendar('360d')
[9190]	393	IF(lwp) WRITE(numout,*) ' ==>>> The IOIPSL calendar is "360d", i.e. 360 days in a year'
[2528]	394	END SELECT
	395	#if defined key_agrif
[1601]	396	ENDIF
[2528]	397	#endif
[3]	398
[4147]	399	READ ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
[11536]	400	903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist' )
[4147]	401	READ ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
[11536]	402	904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist' )
[9169]	403	IF(lwm) WRITE( numond, namdom )
[5836]	404	!
[3]	405	IF(lwp) THEN
[72]	406	WRITE(numout,*)
[9169]	407	WRITE(numout,*) ' Namelist : namdom --- space & time domain'
	408	WRITE(numout,*) ' linear free surface (=T) ln_linssh = ', ln_linssh
	409	WRITE(numout,*) ' create mesh/mask file ln_meshmask = ', ln_meshmask
	410	WRITE(numout,*) ' ocean time step rn_rdt = ', rn_rdt
	411	WRITE(numout,*) ' asselin time filter parameter rn_atfp = ', rn_atfp
	412	WRITE(numout,*) ' online coarsening of dynamical fields ln_crs = ', ln_crs
[223]	413	ENDIF
[5836]	414	!
[9169]	415	! ! conversion DOCTOR names into model names (this should disappear soon)
	416	atfp = rn_atfp
	417	rdt = rn_rdt
[1601]	418
[9367]	419	IF( TRIM(Agrif_CFixed()) == '0' ) THEN
	420	lrxios = ln_xios_read.AND.ln_rstart
	421	!set output file type for XIOS based on NEMO namelist
	422	IF (nn_wxios > 0) lwxios = .TRUE.
	423	nxioso = nn_wxios
	424	ENDIF
	425
[2528]	426	#if defined key_netcdf4
	427	! ! NetCDF 4 case ("key_netcdf4" defined)
[4147]	428	READ ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907)
[11536]	429	907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in reference namelist' )
[4147]	430	READ ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 )
[11536]	431	908 IF( ios > 0 ) CALL ctl_nam ( ios , 'namnc4 in configuration namelist' )
[4624]	432	IF(lwm) WRITE( numond, namnc4 )
[4147]	433
[2528]	434	IF(lwp) THEN ! control print
	435	WRITE(numout,*)
	436	WRITE(numout,*) ' Namelist namnc4 - Netcdf4 chunking parameters'
[9169]	437	WRITE(numout,*) ' number of chunks in i-dimension nn_nchunks_i = ', nn_nchunks_i
	438	WRITE(numout,*) ' number of chunks in j-dimension nn_nchunks_j = ', nn_nchunks_j
	439	WRITE(numout,*) ' number of chunks in k-dimension nn_nchunks_k = ', nn_nchunks_k
	440	WRITE(numout,*) ' apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip
[2528]	441	ENDIF
[1601]	442
[2528]	443	! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
	444	! Note the chunk size in the unlimited (time) dimension will be fixed at 1
	445	snc4set%ni = nn_nchunks_i
	446	snc4set%nj = nn_nchunks_j
	447	snc4set%nk = nn_nchunks_k
	448	snc4set%luse = ln_nc4zip
	449	#else
	450	snc4set%luse = .FALSE. ! No NetCDF 4 case
	451	#endif
[1438]	452	!
[3]	453	END SUBROUTINE dom_nam
	454
	455
	456	SUBROUTINE dom_ctl
	457	!!----------------------------------------------------------------------
	458	!! * ROUTINE dom_ctl *
	459	!!
	460	!! ** Purpose : Domain control.
	461	!!
	462	!! ** Method : compute and print extrema of masked scale factors
	463	!!----------------------------------------------------------------------
[10425]	464	INTEGER, DIMENSION(2) :: imi1, imi2, ima1, ima2
[1601]	465	INTEGER, DIMENSION(2) :: iloc !
[3]	466	REAL(wp) :: ze1min, ze1max, ze2min, ze2max
	467	!!----------------------------------------------------------------------
[1601]	468	!
	469	IF(lk_mpp) THEN
[10425]	470	CALL mpp_minloc( 'domain', e1t(:,:), tmask_i(:,:), ze1min, imi1 )
	471	CALL mpp_minloc( 'domain', e2t(:,:), tmask_i(:,:), ze2min, imi2 )
	472	CALL mpp_maxloc( 'domain', e1t(:,:), tmask_i(:,:), ze1max, ima1 )
	473	CALL mpp_maxloc( 'domain', e2t(:,:), tmask_i(:,:), ze2max, ima2 )
[181]	474	ELSE
[4990]	475	ze1min = MINVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
	476	ze2min = MINVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
	477	ze1max = MAXVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
	478	ze2max = MAXVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
[7646]	479	!
[4990]	480	iloc = MINLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
[10425]	481	imi1(1) = iloc(1) + nimpp - 1
	482	imi1(2) = iloc(2) + njmpp - 1
[4990]	483	iloc = MINLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
[10425]	484	imi2(1) = iloc(1) + nimpp - 1
	485	imi2(2) = iloc(2) + njmpp - 1
[4990]	486	iloc = MAXLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
[10425]	487	ima1(1) = iloc(1) + nimpp - 1
	488	ima1(2) = iloc(2) + njmpp - 1
[4990]	489	iloc = MAXLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
[10425]	490	ima2(1) = iloc(1) + nimpp - 1
	491	ima2(2) = iloc(2) + njmpp - 1
[32]	492	ENDIF
[3]	493	IF(lwp) THEN
[1601]	494	WRITE(numout,*)
	495	WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
	496	WRITE(numout,*) '~~~~~~~'
[10425]	497	WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, ima1(1), ima1(2)
	498	WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, imi1(1), imi1(2)
	499	WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, ima2(1), ima2(2)
	500	WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, imi2(1), imi2(2)
[3]	501	ENDIF
[1438]	502	!
[3]	503	END SUBROUTINE dom_ctl
	504
[5836]	505
[11536]	506	SUBROUTINE domain_cfg( cd_cfg, kk_cfg, kpi, kpj, kpk, kperio )
[3680]	507	!!----------------------------------------------------------------------
[7646]	508	!! * ROUTINE dom_nam *
	509	!!
	510	!! ** Purpose : read the domain size in domain configuration file
[3680]	511	!!
[9169]	512	!! ** Method : read the cn_domcfg NetCDF file
[3680]	513	!!----------------------------------------------------------------------
[7646]	514	CHARACTER(len=*) , INTENT(out) :: cd_cfg ! configuration name
	515	INTEGER , INTENT(out) :: kk_cfg ! configuration resolution
	516	INTEGER , INTENT(out) :: kpi, kpj, kpk ! global domain sizes
	517	INTEGER , INTENT(out) :: kperio ! lateral global domain b.c.
	518	!
[11536]	519	INTEGER :: inum ! local integer
[7646]	520	REAL(wp) :: zorca_res ! local scalars
[11536]	521	REAL(wp) :: zperio ! - -
	522	INTEGER, DIMENSION(4) :: idvar, idimsz ! size of dimensions
[3680]	523	!!----------------------------------------------------------------------
[5836]	524	!
[11536]	525	IF(lwp) THEN
	526	WRITE(numout,*) ' '
	527	WRITE(numout,*) 'domain_cfg : domain size read in ', TRIM( cn_domcfg ), ' file'
	528	WRITE(numout,*) '~~~~~~~~~~ '
	529	ENDIF
[5836]	530	!
[7646]	531	CALL iom_open( cn_domcfg, inum )
[5836]	532	!
[7646]	533	! !- ORCA family specificity
	534	IF( iom_varid( inum, 'ORCA' , ldstop = .FALSE. ) > 0 .AND. &
	535	& iom_varid( inum, 'ORCA_index' , ldstop = .FALSE. ) > 0 ) THEN
	536	!
	537	cd_cfg = 'ORCA'
[9919]	538	CALL iom_get( inum, 'ORCA_index', zorca_res ) ; kk_cfg = NINT( zorca_res )
[7646]	539	!
[11536]	540	IF(lwp) THEN
	541	WRITE(numout,*) ' .'
	542	WRITE(numout,*) ' ==>>> ORCA configuration '
	543	WRITE(numout,*) ' .'
	544	ENDIF
[7646]	545	!
	546	ELSE !- cd_cfg & k_cfg are not used
	547	cd_cfg = 'UNKNOWN'
	548	kk_cfg = -9999999
	549	!- or they may be present as global attributes
	550	!- (netcdf only)
[10425]	551	CALL iom_getatt( inum, 'cn_cfg', cd_cfg ) ! returns ! if not found
	552	CALL iom_getatt( inum, 'nn_cfg', kk_cfg ) ! returns -999 if not found
	553	IF( TRIM(cd_cfg) == '!') cd_cfg = 'UNKNOWN'
	554	IF( kk_cfg == -999 ) kk_cfg = -9999999
[7646]	555	!
	556	ENDIF
[11536]	557	!
	558	idvar = iom_varid( inum, 'e3t_0', kdimsz = idimsz ) ! use e3t_0, that must exist, to get jp(ijk)glo
	559	kpi = idimsz(1)
	560	kpj = idimsz(2)
	561	kpk = idimsz(3)
[9919]	562	CALL iom_get( inum, 'jperio', zperio ) ; kperio = NINT( zperio )
[7646]	563	CALL iom_close( inum )
	564	!
[11536]	565	IF(lwp) THEN
	566	WRITE(numout,*) ' cn_cfg = ', TRIM(cd_cfg), ' nn_cfg = ', kk_cfg
	567	WRITE(numout,*) ' jpiglo = ', kpi
	568	WRITE(numout,*) ' jpjglo = ', kpj
	569	WRITE(numout,*) ' jpkglo = ', kpk
	570	WRITE(numout,*) ' type of global domain lateral boundary jperio = ', kperio
	571	ENDIF
[7646]	572	!
	573	END SUBROUTINE domain_cfg
	574
	575
	576	SUBROUTINE cfg_write
	577	!!----------------------------------------------------------------------
	578	!! * ROUTINE cfg_write *
	579	!!
	580	!! ** Purpose : Create the "cn_domcfg_out" file, a NetCDF file which
	581	!! contains all the ocean domain informations required to
	582	!! define an ocean configuration.
	583	!!
	584	!! ** Method : Write in a file all the arrays required to set up an
	585	!! ocean configuration.
	586	!!
	587	!! ** output file : domcfg_out.nc : domain size, characteristics, horizontal
	588	!! mesh, Coriolis parameter, and vertical scale factors
	589	!! NB: also contain ORCA family information
	590	!!----------------------------------------------------------------------
	591	INTEGER :: ji, jj, jk ! dummy loop indices
	592	INTEGER :: izco, izps, isco, icav
	593	INTEGER :: inum ! local units
	594	CHARACTER(len=21) :: clnam ! filename (mesh and mask informations)
	595	REAL(wp), DIMENSION(jpi,jpj) :: z2d ! workspace
	596	!!----------------------------------------------------------------------
	597	!
	598	IF(lwp) WRITE(numout,*)
	599	IF(lwp) WRITE(numout,*) 'cfg_write : create the domain configuration file (', TRIM(cn_domcfg_out),'.nc)'
	600	IF(lwp) WRITE(numout,*) '~~~~~~~~~'
	601	!
	602	! ! ============================= !
	603	! ! create 'domcfg_out.nc' file !
	604	! ! ============================= !
	605	!
[9019]	606	clnam = cn_domcfg_out ! filename (configuration information)
[10425]	607	CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE. )
[7646]	608
	609	!
	610	! !== ORCA family specificities ==!
	611	IF( cn_cfg == "ORCA" ) THEN
	612	CALL iom_rstput( 0, 0, inum, 'ORCA' , 1._wp , ktype = jp_i4 )
	613	CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 )
[3680]	614	ENDIF
[5836]	615	!
[7646]	616	! !== global domain size ==!
	617	!
	618	CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 )
	619	CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 )
	620	CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpk , wp), ktype = jp_i4 )
	621	!
	622	! !== domain characteristics ==!
	623	!
	624	! ! lateral boundary of the global domain
	625	CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 )
	626	!
	627	! ! type of vertical coordinate
	628	IF( ln_zco ) THEN ; izco = 1 ; ELSE ; izco = 0 ; ENDIF
	629	IF( ln_zps ) THEN ; izps = 1 ; ELSE ; izps = 0 ; ENDIF
	630	IF( ln_sco ) THEN ; isco = 1 ; ELSE ; isco = 0 ; ENDIF
	631	CALL iom_rstput( 0, 0, inum, 'ln_zco' , REAL( izco, wp), ktype = jp_i4 )
	632	CALL iom_rstput( 0, 0, inum, 'ln_zps' , REAL( izps, wp), ktype = jp_i4 )
	633	CALL iom_rstput( 0, 0, inum, 'ln_sco' , REAL( isco, wp), ktype = jp_i4 )
	634	!
	635	! ! ocean cavities under iceshelves
	636	IF( ln_isfcav ) THEN ; icav = 1 ; ELSE ; icav = 0 ; ENDIF
	637	CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL( icav, wp), ktype = jp_i4 )
	638	!
	639	! !== horizontal mesh !
	640	!
	641	CALL iom_rstput( 0, 0, inum, 'glamt', glamt, ktype = jp_r8 ) ! latitude
	642	CALL iom_rstput( 0, 0, inum, 'glamu', glamu, ktype = jp_r8 )
	643	CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 )
	644	CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 )
	645	!
	646	CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 ) ! longitude
	647	CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 )
	648	CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 )
	649	CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 )
	650	!
	651	CALL iom_rstput( 0, 0, inum, 'e1t' , e1t , ktype = jp_r8 ) ! i-scale factors (e1.)
	652	CALL iom_rstput( 0, 0, inum, 'e1u' , e1u , ktype = jp_r8 )
	653	CALL iom_rstput( 0, 0, inum, 'e1v' , e1v , ktype = jp_r8 )
	654	CALL iom_rstput( 0, 0, inum, 'e1f' , e1f , ktype = jp_r8 )
	655	!
	656	CALL iom_rstput( 0, 0, inum, 'e2t' , e2t , ktype = jp_r8 ) ! j-scale factors (e2.)
	657	CALL iom_rstput( 0, 0, inum, 'e2u' , e2u , ktype = jp_r8 )
	658	CALL iom_rstput( 0, 0, inum, 'e2v' , e2v , ktype = jp_r8 )
	659	CALL iom_rstput( 0, 0, inum, 'e2f' , e2f , ktype = jp_r8 )
	660	!
	661	CALL iom_rstput( 0, 0, inum, 'ff_f' , ff_f , ktype = jp_r8 ) ! coriolis factor
	662	CALL iom_rstput( 0, 0, inum, 'ff_t' , ff_t , ktype = jp_r8 )
	663	!
	664	! !== vertical mesh ==!
	665	!
	666	CALL iom_rstput( 0, 0, inum, 'e3t_1d' , e3t_1d , ktype = jp_r8 ) ! reference 1D-coordinate
	667	CALL iom_rstput( 0, 0, inum, 'e3w_1d' , e3w_1d , ktype = jp_r8 )
	668	!
	669	CALL iom_rstput( 0, 0, inum, 'e3t_0' , e3t_0 , ktype = jp_r8 ) ! vertical scale factors
	670	CALL iom_rstput( 0, 0, inum, 'e3u_0' , e3u_0 , ktype = jp_r8 )
	671	CALL iom_rstput( 0, 0, inum, 'e3v_0' , e3v_0 , ktype = jp_r8 )
	672	CALL iom_rstput( 0, 0, inum, 'e3f_0' , e3f_0 , ktype = jp_r8 )
	673	CALL iom_rstput( 0, 0, inum, 'e3w_0' , e3w_0 , ktype = jp_r8 )
	674	CALL iom_rstput( 0, 0, inum, 'e3uw_0' , e3uw_0 , ktype = jp_r8 )
	675	CALL iom_rstput( 0, 0, inum, 'e3vw_0' , e3vw_0 , ktype = jp_r8 )
	676	!
	677	! !== wet top and bottom level ==! (caution: multiplied by ssmask)
	678	!
	679	CALL iom_rstput( 0, 0, inum, 'top_level' , REAL( mikt, wp )*ssmask , ktype = jp_i4 ) ! nb of ocean T-points (ISF)
	680	CALL iom_rstput( 0, 0, inum, 'bottom_level' , REAL( mbkt, wp )*ssmask , ktype = jp_i4 ) ! nb of ocean T-points
	681	!
	682	IF( ln_sco ) THEN ! s-coordinate: store grid stiffness ratio (Not required anyway)
	683	CALL dom_stiff( z2d )
	684	CALL iom_rstput( 0, 0, inum, 'stiffness', z2d ) ! ! Max. grid stiffness ratio
	685	ENDIF
	686	!
[9023]	687	IF( ll_wd ) THEN ! wetting and drying domain
[7646]	688	CALL iom_rstput( 0, 0, inum, 'ht_0' , ht_0 , ktype = jp_r8 )
	689	ENDIF
	690	!
	691	! Add some global attributes ( netcdf only )
[10425]	692	CALL iom_putatt( inum, 'nn_cfg', nn_cfg )
	693	CALL iom_putatt( inum, 'cn_cfg', TRIM(cn_cfg) )
[7646]	694	!
	695	! ! ============================
	696	! ! close the files
	697	! ! ============================
	698	CALL iom_close( inum )
	699	!
	700	END SUBROUTINE cfg_write
[3680]	701
[3]	702	!!======================================================================
	703	END MODULE domain

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/OCE/DOM/domain.F90 @ 12377

Download in other formats: