Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

domain.F90 @ 8758

Last change on this file since 8758 was 8758, checked in by acc, 6 years ago
Branch 2017/dev_r8126_ROBUST08_no_ghost. Changes to eliminate ghost rows and columns. Currently the halo width is still fixed as 1 but a single variable (nn_hls) has been introduced for the halo-size in preparation for allowing this to vary. nn_hls replaces jpreci and jprecj. These changes have passed full SETTE tests but iceberg exchanges across the north-fold remain untested (SETTE tests only release bergs in the SO) and will require further attention. Note layout.dat now reports the jpi and jpj values for the reporting processor only.
Property svn:keywords set to `Id`
File size: 36.3 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 usrdef_closea ! closed seas
	33	USE domhgr ! domain: set the horizontal mesh
	34	USE domzgr ! domain: set the vertical mesh
	35	USE dommsk ! domain: set the mask system
	36	USE domwri ! domain: write the meshmask file
	37	USE domvvl ! variable volume
	38	USE c1d ! 1D configuration
	39	USE domc1d ! 1D configuration: column location
	40	USE dyncor_c1d ! 1D configuration: Coriolis term (cor_c1d routine)
	41	USE wet_dry ! wetting and drying
[5836]	42	!
[7646]	43	USE in_out_manager ! I/O manager
	44	USE iom ! I/O library
	45	USE lbclnk ! ocean lateral boundary condition (or mpp link)
	46	USE lib_mpp ! distributed memory computing library
	47	USE wrk_nemo ! Memory Allocation
	48	USE timing ! Timing
[3]	49
	50	IMPLICIT NONE
	51	PRIVATE
	52
[7646]	53	PUBLIC dom_init ! called by nemogcm.F90
	54	PUBLIC domain_cfg ! called by nemogcm.F90
[3]	55
[1438]	56	!!-------------------------------------------------------------------------
[2528]	57	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
[888]	58	!! $Id$
[2528]	59	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[1438]	60	!!-------------------------------------------------------------------------
[3]	61	CONTAINS
	62
	63	SUBROUTINE dom_init
	64	!!----------------------------------------------------------------------
	65	!! * ROUTINE dom_init *
	66	!!
	67	!! ** Purpose : Domain initialization. Call the routines that are
[1601]	68	!! required to create the arrays which define the space
	69	!! and time domain of the ocean model.
[3]	70	!!
[1601]	71	!! ** Method : - dom_msk: compute the masks from the bathymetry file
	72	!! - dom_hgr: compute or read the horizontal grid-point position
	73	!! and scale factors, and the coriolis factor
	74	!! - dom_zgr: define the vertical coordinate and the bathymetry
[7646]	75	!! - dom_wri: create the meshmask file if nn_msh=1
[2528]	76	!! - 1D configuration, move Coriolis, u and v at T-point
[3]	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	!
[3764]	85	IF( nn_timing == 1 ) CALL timing_start('dom_init')
[3294]	86	!
[7646]	87	IF(lwp) THEN ! Ocean domain Parameters (control print)
[3]	88	WRITE(numout,*)
	89	WRITE(numout,*) 'dom_init : domain initialization'
	90	WRITE(numout,*) '~~~~~~~~'
[7646]	91	!
	92	WRITE(numout,*) ' Domain info'
	93	WRITE(numout,*) ' dimension of model:'
	94	WRITE(numout,*) ' Local domain Global domain Data domain '
	95	WRITE(numout,cform) ' ',' jpi : ', jpi, ' jpiglo : ', jpiglo
	96	WRITE(numout,cform) ' ',' jpj : ', jpj, ' jpjglo : ', jpjglo
	97	WRITE(numout,cform) ' ',' jpk : ', jpk, ' jpkglo : ', jpkglo
	98	WRITE(numout,cform) ' ' ,' jpij : ', jpij
	99	WRITE(numout,*) ' mpp local domain info (mpp):'
[8758]	100	WRITE(numout,*) ' jpni : ', jpni, ' nn_hls : ', nn_hls
	101	WRITE(numout,*) ' jpnj : ', jpnj, ' nn_hls : ', nn_hls
[7646]	102	WRITE(numout,*) ' jpnij : ', jpnij
	103	WRITE(numout,*) ' lateral boundary of the Global domain : jperio = ', jperio
	104	SELECT CASE ( jperio )
	105	CASE( 0 ) ; WRITE(numout,*) ' (i.e. closed)'
	106	CASE( 1 ) ; WRITE(numout,*) ' (i.e. cyclic east-west)'
	107	CASE( 2 ) ; WRITE(numout,*) ' (i.e. equatorial symmetric)'
	108	CASE( 3 ) ; WRITE(numout,*) ' (i.e. north fold with T-point pivot)'
	109	CASE( 4 ) ; WRITE(numout,*) ' (i.e. cyclic east-west and north fold with T-point pivot)'
	110	CASE( 5 ) ; WRITE(numout,*) ' (i.e. north fold with F-point pivot)'
	111	CASE( 6 ) ; WRITE(numout,*) ' (i.e. cyclic east-west and north fold with F-point pivot)'
[7822]	112	CASE( 7 ) ; WRITE(numout,*) ' (i.e. cyclic east-west and north-south)'
[7646]	113	CASE DEFAULT
	114	CALL ctl_stop( 'jperio is out of range' )
	115	END SELECT
	116	WRITE(numout,*) ' Ocean model configuration used:'
	117	WRITE(numout,*) ' cn_cfg = ', cn_cfg
	118	WRITE(numout,*) ' nn_cfg = ', nn_cfg
[3]	119	ENDIF
[1601]	120	!
[7646]	121	!
	122	!!gm This should be removed with the new configuration interface
	123	IF( lk_c1d .AND. ln_c1d_locpt ) CALL dom_c1d( rn_lat1d, rn_lon1d )
	124	!!gm end
[4490]	125	!
[7646]	126	! !== Reference coordinate system ==!
[6140]	127	!
[7646]	128	CALL dom_glo ! global domain versus local domain
	129	CALL dom_nam ! read namelist ( namrun, namdom )
	130	CALL dom_clo( cn_cfg, nn_cfg ) ! Closed seas and lake
	131	CALL dom_hgr ! Horizontal mesh
	132	CALL dom_zgr( ik_top, ik_bot ) ! Vertical mesh and bathymetry
	133	IF( nn_closea == 0 ) CALL clo_bat( ik_top, ik_bot ) !== remove closed seas or lakes ==!
	134	CALL dom_msk( ik_top, ik_bot ) ! Masks
	135	!
	136	DO jj = 1, jpj ! depth of the iceshelves
	137	DO ji = 1, jpi
	138	ik = mikt(ji,jj)
	139	risfdep(ji,jj) = gdepw_0(ji,jj,ik)
	140	END DO
	141	END DO
	142	!
[7753]	143	ht_0(:,:) = 0._wp ! Reference ocean thickness
	144	hu_0(:,:) = 0._wp
	145	hv_0(:,:) = 0._wp
[7646]	146	DO jk = 1, jpk
[7753]	147	ht_0(:,:) = ht_0(:,:) + e3t_0(:,:,jk) * tmask(:,:,jk)
	148	hu_0(:,:) = hu_0(:,:) + e3u_0(:,:,jk) * umask(:,:,jk)
	149	hv_0(:,:) = hv_0(:,:) + e3v_0(:,:,jk) * vmask(:,:,jk)
[4490]	150	END DO
	151	!
[7646]	152	! !== time varying part of coordinate system ==!
[1601]	153	!
[7646]	154	IF( ln_linssh ) THEN != Fix in time : set to the reference one for all
	155	!
[6140]	156	! before ! now ! after !
[6981]	157	gdept_b = gdept_0 ; gdept_n = gdept_0 ! --- ! depth of grid-points
	158	gdepw_b = gdepw_0 ; gdepw_n = gdepw_0 ! --- !
	159	gde3w_n = gde3w_0 ! --- !
[6140]	160	!
[6981]	161	e3t_b = e3t_0 ; e3t_n = e3t_0 ; e3t_a = e3t_0 ! scale factors
	162	e3u_b = e3u_0 ; e3u_n = e3u_0 ; e3u_a = e3u_0 !
	163	e3v_b = e3v_0 ; e3v_n = e3v_0 ; e3v_a = e3v_0 !
	164	e3f_n = e3f_0 ! --- !
	165	e3w_b = e3w_0 ; e3w_n = e3w_0 ! --- !
	166	e3uw_b = e3uw_0 ; e3uw_n = e3uw_0 ! --- !
	167	e3vw_b = e3vw_0 ; e3vw_n = e3vw_0 ! --- !
[6140]	168	!
[7753]	169	z1_hu_0(:,:) = ssumask(:,:) / ( hu_0(:,:) + 1._wp - ssumask(:,:) ) ! _i mask due to ISF
	170	z1_hv_0(:,:) = ssvmask(:,:) / ( hv_0(:,:) + 1._wp - ssvmask(:,:) )
[6140]	171	!
	172	! before ! now ! after !
[6981]	173	ht_n = ht_0 ! ! water column thickness
	174	hu_b = hu_0 ; hu_n = hu_0 ; hu_a = hu_0 !
	175	hv_b = hv_0 ; hv_n = hv_0 ; hv_a = hv_0 !
	176	r1_hu_b = z1_hu_0 ; r1_hu_n = z1_hu_0 ; r1_hu_a = z1_hu_0 ! inverse of water column thickness
	177	r1_hv_b = z1_hv_0 ; r1_hv_n = z1_hv_0 ; r1_hv_a = z1_hv_0 !
[6140]	178	!
	179	!
[7646]	180	ELSE != time varying : initialize before/now/after variables
[6140]	181	!
[7646]	182	IF( .NOT.l_offline ) CALL dom_vvl_init
[6140]	183	!
	184	ENDIF
[2528]	185	!
[6140]	186	IF( lk_c1d ) CALL cor_c1d ! 1D configuration: Coriolis set at T-point
[4370]	187	!
[7646]	188	IF( nn_msh > 0 .AND. .NOT. ln_iscpl ) CALL dom_wri ! Create a domain file
	189	IF( nn_msh > 0 .AND. ln_iscpl .AND. .NOT. ln_rstart ) CALL dom_wri ! Create a domain file
[6140]	190	IF( .NOT.ln_rstart ) CALL dom_ctl ! Domain control
[1438]	191	!
[7646]	192
	193	IF(lwp) THEN
	194	WRITE(numout,*)
	195	WRITE(numout,*) 'dom_init : end of domain initialization nn_msh=', nn_msh
	196	WRITE(numout,*)
	197	ENDIF
	198	!
	199	IF( ln_write_cfg ) CALL cfg_write ! create the configuration file
	200	!
[3764]	201	IF( nn_timing == 1 ) CALL timing_stop('dom_init')
[3294]	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,*)
	248	WRITE(numout,*) ' conversion local ==> global i-index domain'
	249	WRITE(numout,25) (mig(ji),ji = 1,jpi)
	250	WRITE(numout,*)
	251	WRITE(numout,*) ' conversion global ==> local i-index domain'
	252	WRITE(numout,*) ' starting index'
	253	WRITE(numout,25) (mi0(ji),ji = 1,jpiglo)
	254	WRITE(numout,*) ' ending index'
	255	WRITE(numout,25) (mi1(ji),ji = 1,jpiglo)
	256	WRITE(numout,*)
	257	WRITE(numout,*) ' conversion local ==> global j-index domain'
	258	WRITE(numout,25) (mjg(jj),jj = 1,jpj)
	259	WRITE(numout,*)
	260	WRITE(numout,*) ' conversion global ==> local j-index domain'
	261	WRITE(numout,*) ' starting index'
	262	WRITE(numout,25) (mj0(jj),jj = 1,jpjglo)
	263	WRITE(numout,*) ' ending index'
	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
[6140]	283	NAMELIST/namrun/ cn_ocerst_indir, cn_ocerst_outdir, nn_stocklist, ln_rst_list, &
[7646]	284	& nn_no , cn_exp , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl , &
[6140]	285	& nn_it000, nn_itend , nn_date0 , nn_time0 , nn_leapy , nn_istate , &
	286	& nn_stock, nn_write , ln_mskland , ln_clobber , nn_chunksz, nn_euler , &
	287	& ln_cfmeta, ln_iscpl
[7646]	288	NAMELIST/namdom/ ln_linssh, nn_closea, nn_msh, rn_isfhmin, rn_rdt, rn_atfp, ln_crs
[2528]	289	#if defined key_netcdf4
	290	NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
	291	#endif
[4147]	292	INTEGER :: ios ! Local integer output status for namelist read
[3]	293	!!----------------------------------------------------------------------
[7646]	294	!
[4147]	295	REWIND( numnam_ref ) ! Namelist namrun in reference namelist : Parameters of the run
	296	READ ( numnam_ref, namrun, IOSTAT = ios, ERR = 901)
[5836]	297	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in reference namelist', lwp )
[7646]	298	!
[4147]	299	REWIND( numnam_cfg ) ! Namelist namrun in configuration namelist : Parameters of the run
	300	READ ( numnam_cfg, namrun, IOSTAT = ios, ERR = 902 )
[5836]	301	902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namrun in configuration namelist', lwp )
[4624]	302	IF(lwm) WRITE ( numond, namrun )
[1601]	303	!
	304	IF(lwp) THEN ! control print
[3]	305	WRITE(numout,*)
	306	WRITE(numout,*) 'dom_nam : domain initialization through namelist read'
	307	WRITE(numout,*) '~~~~~~~ '
[1601]	308	WRITE(numout,*) ' Namelist namrun'
	309	WRITE(numout,*) ' job number nn_no = ', nn_no
	310	WRITE(numout,*) ' experiment name for output cn_exp = ', cn_exp
[4147]	311	WRITE(numout,*) ' file prefix restart input cn_ocerst_in= ', cn_ocerst_in
[5341]	312	WRITE(numout,*) ' restart input directory cn_ocerst_indir= ', cn_ocerst_indir
[4147]	313	WRITE(numout,*) ' file prefix restart output cn_ocerst_out= ', cn_ocerst_out
[5341]	314	WRITE(numout,*) ' restart output directory cn_ocerst_outdir= ', cn_ocerst_outdir
[1601]	315	WRITE(numout,*) ' restart logical ln_rstart = ', ln_rstart
[4370]	316	WRITE(numout,*) ' start with forward time step nn_euler = ', nn_euler
[1604]	317	WRITE(numout,*) ' control of time step nn_rstctl = ', nn_rstctl
[1601]	318	WRITE(numout,*) ' number of the first time step nn_it000 = ', nn_it000
	319	WRITE(numout,*) ' number of the last time step nn_itend = ', nn_itend
	320	WRITE(numout,*) ' initial calendar date aammjj nn_date0 = ', nn_date0
[6140]	321	WRITE(numout,*) ' initial time of day in hhmm nn_time0 = ', nn_time0
[1601]	322	WRITE(numout,*) ' leap year calendar (0/1) nn_leapy = ', nn_leapy
	323	WRITE(numout,*) ' initial state output nn_istate = ', nn_istate
[5341]	324	IF( ln_rst_list ) THEN
	325	WRITE(numout,*) ' list of restart dump times nn_stocklist =', nn_stocklist
	326	ELSE
	327	WRITE(numout,*) ' frequency of restart file nn_stock = ', nn_stock
	328	ENDIF
[1601]	329	WRITE(numout,*) ' frequency of output file nn_write = ', nn_write
	330	WRITE(numout,*) ' mask land points ln_mskland = ', ln_mskland
[5363]	331	WRITE(numout,*) ' additional CF standard metadata ln_cfmeta = ', ln_cfmeta
[1601]	332	WRITE(numout,*) ' overwrite an existing file ln_clobber = ', ln_clobber
	333	WRITE(numout,*) ' NetCDF chunksize (bytes) nn_chunksz = ', nn_chunksz
[6140]	334	WRITE(numout,*) ' IS coupling at the restart step ln_iscpl = ', ln_iscpl
[3]	335	ENDIF
	336
[1601]	337	no = nn_no ! conversion DOCTOR names into model names (this should disappear soon)
	338	cexper = cn_exp
	339	nrstdt = nn_rstctl
	340	nit000 = nn_it000
	341	nitend = nn_itend
	342	ndate0 = nn_date0
	343	nleapy = nn_leapy
	344	ninist = nn_istate
	345	nstock = nn_stock
[5341]	346	nstocklist = nn_stocklist
[1601]	347	nwrite = nn_write
[4370]	348	neuler = nn_euler
[5341]	349	IF ( neuler == 1 .AND. .NOT. ln_rstart ) THEN
[4370]	350	WRITE(ctmp1,*) 'ln_rstart =.FALSE., nn_euler is forced to 0 '
	351	CALL ctl_warn( ctmp1 )
	352	neuler = 0
	353	ENDIF
[1601]	354	! ! control of output frequency
[1335]	355	IF ( nstock == 0 .OR. nstock > nitend ) THEN
[1601]	356	WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend
[783]	357	CALL ctl_warn( ctmp1 )
[1335]	358	nstock = nitend
[3]	359	ENDIF
	360	IF ( nwrite == 0 ) THEN
[1601]	361	WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
[783]	362	CALL ctl_warn( ctmp1 )
	363	nwrite = nitend
[3]	364	ENDIF
	365
[2528]	366	#if defined key_agrif
[1601]	367	IF( Agrif_Root() ) THEN
[2528]	368	#endif
	369	SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL
	370	CASE ( 1 )
	371	CALL ioconf_calendar('gregorian')
	372	IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "gregorian", i.e. leap year'
	373	CASE ( 0 )
	374	CALL ioconf_calendar('noleap')
	375	IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "noleap", i.e. no leap year'
	376	CASE ( 30 )
	377	CALL ioconf_calendar('360d')
	378	IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "360d", i.e. 360 days in a year'
	379	END SELECT
	380	#if defined key_agrif
[1601]	381	ENDIF
[2528]	382	#endif
[3]	383
[4147]	384	REWIND( numnam_ref ) ! Namelist namdom in reference namelist : space & time domain (bathymetry, mesh, timestep)
	385	READ ( numnam_ref, namdom, IOSTAT = ios, ERR = 903)
	386	903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in reference namelist', lwp )
[4152]	387	!
[4147]	388	REWIND( numnam_cfg ) ! Namelist namdom in configuration namelist : space & time domain (bathymetry, mesh, timestep)
	389	READ ( numnam_cfg, namdom, IOSTAT = ios, ERR = 904 )
	390	904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdom in configuration namelist', lwp )
[4624]	391	IF(lwm) WRITE ( numond, namdom )
[5836]	392	!
[3]	393	IF(lwp) THEN
[72]	394	WRITE(numout,*)
[1601]	395	WRITE(numout,*) ' Namelist namdom : space & time domain'
[7646]	396	WRITE(numout,*) ' linear free surface (=T) ln_linssh = ', ln_linssh
	397	WRITE(numout,*) ' suppression of closed seas (=0) nn_closea = ', nn_closea
	398	WRITE(numout,*) ' create mesh/mask file(s) nn_msh = ', nn_msh
[2528]	399	WRITE(numout,*) ' = 0 no file created '
	400	WRITE(numout,*) ' = 1 mesh_mask '
	401	WRITE(numout,*) ' = 2 mesh and mask '
	402	WRITE(numout,*) ' = 3 mesh_hgr, msh_zgr and mask'
[7646]	403	WRITE(numout,*) ' treshold to open the isf cavity rn_isfhmin = ', rn_isfhmin, ' (m)'
	404	WRITE(numout,*) ' ocean time step rn_rdt = ', rn_rdt
	405	WRITE(numout,*) ' asselin time filter parameter rn_atfp = ', rn_atfp
	406	WRITE(numout,*) ' online coarsening of dynamical fields ln_crs = ', ln_crs
[223]	407	ENDIF
[7646]	408
	409	call flush( numout )
[5836]	410	!
[7646]	411	! ! ! conversion DOCTOR names into model names (this should disappear soon)
[1601]	412	atfp = rn_atfp
	413	rdt = rn_rdt
	414
[2528]	415	#if defined key_netcdf4
	416	! ! NetCDF 4 case ("key_netcdf4" defined)
[4147]	417	REWIND( numnam_ref ) ! Namelist namnc4 in reference namelist : NETCDF
	418	READ ( numnam_ref, namnc4, IOSTAT = ios, ERR = 907)
	419	907 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in reference namelist', lwp )
[7646]	420	!
[4147]	421	REWIND( numnam_cfg ) ! Namelist namnc4 in configuration namelist : NETCDF
	422	READ ( numnam_cfg, namnc4, IOSTAT = ios, ERR = 908 )
	423	908 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namnc4 in configuration namelist', lwp )
[4624]	424	IF(lwm) WRITE( numond, namnc4 )
[4147]	425
[2528]	426	IF(lwp) THEN ! control print
	427	WRITE(numout,*)
	428	WRITE(numout,*) ' Namelist namnc4 - Netcdf4 chunking parameters'
	429	WRITE(numout,*) ' number of chunks in i-dimension nn_nchunks_i = ', nn_nchunks_i
	430	WRITE(numout,*) ' number of chunks in j-dimension nn_nchunks_j = ', nn_nchunks_j
	431	WRITE(numout,*) ' number of chunks in k-dimension nn_nchunks_k = ', nn_nchunks_k
	432	WRITE(numout,*) ' apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip
	433	ENDIF
[1601]	434
[2528]	435	! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
	436	! Note the chunk size in the unlimited (time) dimension will be fixed at 1
	437	snc4set%ni = nn_nchunks_i
	438	snc4set%nj = nn_nchunks_j
	439	snc4set%nk = nn_nchunks_k
	440	snc4set%luse = ln_nc4zip
	441	#else
	442	snc4set%luse = .FALSE. ! No NetCDF 4 case
	443	#endif
[1438]	444	!
[3]	445	END SUBROUTINE dom_nam
	446
	447
	448	SUBROUTINE dom_ctl
	449	!!----------------------------------------------------------------------
	450	!! * ROUTINE dom_ctl *
	451	!!
	452	!! ** Purpose : Domain control.
	453	!!
	454	!! ** Method : compute and print extrema of masked scale factors
	455	!!----------------------------------------------------------------------
	456	INTEGER :: iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
[1601]	457	INTEGER, DIMENSION(2) :: iloc !
[3]	458	REAL(wp) :: ze1min, ze1max, ze2min, ze2max
	459	!!----------------------------------------------------------------------
[1601]	460	!
	461	IF(lk_mpp) THEN
[4990]	462	CALL mpp_minloc( e1t(:,:), tmask_i(:,:), ze1min, iimi1,ijmi1 )
	463	CALL mpp_minloc( e2t(:,:), tmask_i(:,:), ze2min, iimi2,ijmi2 )
	464	CALL mpp_maxloc( e1t(:,:), tmask_i(:,:), ze1max, iima1,ijma1 )
	465	CALL mpp_maxloc( e2t(:,:), tmask_i(:,:), ze2max, iima2,ijma2 )
[181]	466	ELSE
[4990]	467	ze1min = MINVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
	468	ze2min = MINVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
	469	ze1max = MAXVAL( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
	470	ze2max = MAXVAL( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
[7646]	471	!
[4990]	472	iloc = MINLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
[181]	473	iimi1 = iloc(1) + nimpp - 1
	474	ijmi1 = iloc(2) + njmpp - 1
[4990]	475	iloc = MINLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
[181]	476	iimi2 = iloc(1) + nimpp - 1
	477	ijmi2 = iloc(2) + njmpp - 1
[4990]	478	iloc = MAXLOC( e1t(:,:), mask = tmask_i(:,:) == 1._wp )
[181]	479	iima1 = iloc(1) + nimpp - 1
	480	ijma1 = iloc(2) + njmpp - 1
[4990]	481	iloc = MAXLOC( e2t(:,:), mask = tmask_i(:,:) == 1._wp )
[181]	482	iima2 = iloc(1) + nimpp - 1
	483	ijma2 = iloc(2) + njmpp - 1
[32]	484	ENDIF
[3]	485	IF(lwp) THEN
[1601]	486	WRITE(numout,*)
	487	WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
	488	WRITE(numout,*) '~~~~~~~'
[181]	489	WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
	490	WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
	491	WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
	492	WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
[3]	493	ENDIF
[1438]	494	!
[3]	495	END SUBROUTINE dom_ctl
	496
[5836]	497
[7646]	498	SUBROUTINE domain_cfg( ldtxt, cd_cfg, kk_cfg, kpi, kpj, kpk, kperio )
[3680]	499	!!----------------------------------------------------------------------
[7646]	500	!! * ROUTINE dom_nam *
	501	!!
	502	!! ** Purpose : read the domain size in domain configuration file
[3680]	503	!!
[7646]	504	!! ** Method :
[3680]	505	!!
	506	!!----------------------------------------------------------------------
[7646]	507	CHARACTER(len=*), DIMENSION(:), INTENT(out) :: ldtxt ! stored print information
	508	CHARACTER(len=*) , INTENT(out) :: cd_cfg ! configuration name
	509	INTEGER , INTENT(out) :: kk_cfg ! configuration resolution
	510	INTEGER , INTENT(out) :: kpi, kpj, kpk ! global domain sizes
	511	INTEGER , INTENT(out) :: kperio ! lateral global domain b.c.
	512	!
	513	INTEGER :: inum, ii ! local integer
	514	REAL(wp) :: zorca_res ! local scalars
	515	REAL(wp) :: ziglo, zjglo, zkglo, zperio ! - -
[3680]	516	!!----------------------------------------------------------------------
[5836]	517	!
[7646]	518	ii = 1
	519	WRITE(ldtxt(ii),*) ' ' ; ii = ii+1
	520	WRITE(ldtxt(ii),*) 'domain_cfg : domain size read in ', TRIM( cn_domcfg ), ' file' ; ii = ii+1
	521	WRITE(ldtxt(ii),*) '~~~~~~~~~~ ' ; ii = ii+1
[5836]	522	!
[7646]	523	CALL iom_open( cn_domcfg, inum )
[5836]	524	!
[7646]	525	! !- ORCA family specificity
	526	IF( iom_varid( inum, 'ORCA' , ldstop = .FALSE. ) > 0 .AND. &
	527	& iom_varid( inum, 'ORCA_index' , ldstop = .FALSE. ) > 0 ) THEN
	528	!
	529	cd_cfg = 'ORCA'
	530	CALL iom_get( inum, 'ORCA_index', zorca_res ) ; kk_cfg = INT( zorca_res )
	531	!
	532	WRITE(ldtxt(ii),*) ' ' ; ii = ii+1
	533	WRITE(ldtxt(ii),*) ' ==>>> ORCA configuration ' ; ii = ii+1
	534	WRITE(ldtxt(ii),*) ' ' ; ii = ii+1
	535	!
	536	ELSE !- cd_cfg & k_cfg are not used
	537	cd_cfg = 'UNKNOWN'
	538	kk_cfg = -9999999
	539	!- or they may be present as global attributes
	540	!- (netcdf only)
	541	IF( iom_file(inum)%iolib == jpnf90 ) THEN
	542	CALL iom_getatt( inum, 'cn_cfg', cd_cfg ) ! returns ! if not found
	543	CALL iom_getatt( inum, 'nn_cfg', kk_cfg ) ! returns -999 if not found
	544	IF( TRIM(cd_cfg) .EQ. '!') cd_cfg = 'UNKNOWN'
	545	IF( kk_cfg .EQ. -999 ) kk_cfg = -9999999
	546	ENDIF
	547	!
	548	ENDIF
[5836]	549	!
[7646]	550	CALL iom_get( inum, 'jpiglo', ziglo ) ; kpi = INT( ziglo )
	551	CALL iom_get( inum, 'jpjglo', zjglo ) ; kpj = INT( zjglo )
	552	CALL iom_get( inum, 'jpkglo', zkglo ) ; kpk = INT( zkglo )
	553	CALL iom_get( inum, 'jperio', zperio ) ; kperio = INT( zperio )
	554	CALL iom_close( inum )
	555	!
	556	WRITE(ldtxt(ii),*) ' cn_cfg = ', TRIM(cd_cfg), ' nn_cfg = ', kk_cfg ; ii = ii+1
	557	WRITE(ldtxt(ii),*) ' jpiglo = ', kpi ; ii = ii+1
	558	WRITE(ldtxt(ii),*) ' jpjglo = ', kpj ; ii = ii+1
	559	WRITE(ldtxt(ii),*) ' jpkglo = ', kpk ; ii = ii+1
	560	WRITE(ldtxt(ii),*) ' type of global domain lateral boundary jperio = ', kperio ; ii = ii+1
	561	!
	562	END SUBROUTINE domain_cfg
	563
	564
	565	SUBROUTINE cfg_write
	566	!!----------------------------------------------------------------------
	567	!! * ROUTINE cfg_write *
	568	!!
	569	!! ** Purpose : Create the "cn_domcfg_out" file, a NetCDF file which
	570	!! contains all the ocean domain informations required to
	571	!! define an ocean configuration.
	572	!!
	573	!! ** Method : Write in a file all the arrays required to set up an
	574	!! ocean configuration.
	575	!!
	576	!! ** output file : domcfg_out.nc : domain size, characteristics, horizontal
	577	!! mesh, Coriolis parameter, and vertical scale factors
	578	!! NB: also contain ORCA family information
	579	!!----------------------------------------------------------------------
	580	INTEGER :: ji, jj, jk ! dummy loop indices
	581	INTEGER :: izco, izps, isco, icav
	582	INTEGER :: inum ! local units
	583	CHARACTER(len=21) :: clnam ! filename (mesh and mask informations)
	584	REAL(wp), DIMENSION(jpi,jpj) :: z2d ! workspace
	585	!!----------------------------------------------------------------------
	586	!
	587	IF(lwp) WRITE(numout,*)
	588	IF(lwp) WRITE(numout,*) 'cfg_write : create the domain configuration file (', TRIM(cn_domcfg_out),'.nc)'
	589	IF(lwp) WRITE(numout,*) '~~~~~~~~~'
	590	!
	591	! ! ============================= !
	592	! ! create 'domcfg_out.nc' file !
	593	! ! ============================= !
	594	!
	595	clnam = 'domcfg_out' ! filename (configuration information)
	596	CALL iom_open( TRIM(clnam), inum, ldwrt = .TRUE., kiolib = jprstlib )
	597
	598	!
	599	! !== ORCA family specificities ==!
	600	IF( cn_cfg == "ORCA" ) THEN
	601	CALL iom_rstput( 0, 0, inum, 'ORCA' , 1._wp , ktype = jp_i4 )
	602	CALL iom_rstput( 0, 0, inum, 'ORCA_index', REAL( nn_cfg, wp), ktype = jp_i4 )
[3680]	603	ENDIF
[5836]	604	!
[7646]	605	! !== global domain size ==!
	606	!
	607	CALL iom_rstput( 0, 0, inum, 'jpiglo', REAL( jpiglo, wp), ktype = jp_i4 )
	608	CALL iom_rstput( 0, 0, inum, 'jpjglo', REAL( jpjglo, wp), ktype = jp_i4 )
	609	CALL iom_rstput( 0, 0, inum, 'jpkglo', REAL( jpk , wp), ktype = jp_i4 )
	610	!
	611	! !== domain characteristics ==!
	612	!
	613	! ! lateral boundary of the global domain
	614	CALL iom_rstput( 0, 0, inum, 'jperio', REAL( jperio, wp), ktype = jp_i4 )
	615	!
	616	! ! type of vertical coordinate
	617	IF( ln_zco ) THEN ; izco = 1 ; ELSE ; izco = 0 ; ENDIF
	618	IF( ln_zps ) THEN ; izps = 1 ; ELSE ; izps = 0 ; ENDIF
	619	IF( ln_sco ) THEN ; isco = 1 ; ELSE ; isco = 0 ; ENDIF
	620	CALL iom_rstput( 0, 0, inum, 'ln_zco' , REAL( izco, wp), ktype = jp_i4 )
	621	CALL iom_rstput( 0, 0, inum, 'ln_zps' , REAL( izps, wp), ktype = jp_i4 )
	622	CALL iom_rstput( 0, 0, inum, 'ln_sco' , REAL( isco, wp), ktype = jp_i4 )
	623	!
	624	! ! ocean cavities under iceshelves
	625	IF( ln_isfcav ) THEN ; icav = 1 ; ELSE ; icav = 0 ; ENDIF
	626	CALL iom_rstput( 0, 0, inum, 'ln_isfcav', REAL( icav, wp), ktype = jp_i4 )
	627	!
	628	! !== horizontal mesh !
	629	!
	630	CALL iom_rstput( 0, 0, inum, 'glamt', glamt, ktype = jp_r8 ) ! latitude
	631	CALL iom_rstput( 0, 0, inum, 'glamu', glamu, ktype = jp_r8 )
	632	CALL iom_rstput( 0, 0, inum, 'glamv', glamv, ktype = jp_r8 )
	633	CALL iom_rstput( 0, 0, inum, 'glamf', glamf, ktype = jp_r8 )
	634	!
	635	CALL iom_rstput( 0, 0, inum, 'gphit', gphit, ktype = jp_r8 ) ! longitude
	636	CALL iom_rstput( 0, 0, inum, 'gphiu', gphiu, ktype = jp_r8 )
	637	CALL iom_rstput( 0, 0, inum, 'gphiv', gphiv, ktype = jp_r8 )
	638	CALL iom_rstput( 0, 0, inum, 'gphif', gphif, ktype = jp_r8 )
	639	!
	640	CALL iom_rstput( 0, 0, inum, 'e1t' , e1t , ktype = jp_r8 ) ! i-scale factors (e1.)
	641	CALL iom_rstput( 0, 0, inum, 'e1u' , e1u , ktype = jp_r8 )
	642	CALL iom_rstput( 0, 0, inum, 'e1v' , e1v , ktype = jp_r8 )
	643	CALL iom_rstput( 0, 0, inum, 'e1f' , e1f , ktype = jp_r8 )
	644	!
	645	CALL iom_rstput( 0, 0, inum, 'e2t' , e2t , ktype = jp_r8 ) ! j-scale factors (e2.)
	646	CALL iom_rstput( 0, 0, inum, 'e2u' , e2u , ktype = jp_r8 )
	647	CALL iom_rstput( 0, 0, inum, 'e2v' , e2v , ktype = jp_r8 )
	648	CALL iom_rstput( 0, 0, inum, 'e2f' , e2f , ktype = jp_r8 )
	649	!
	650	CALL iom_rstput( 0, 0, inum, 'ff_f' , ff_f , ktype = jp_r8 ) ! coriolis factor
	651	CALL iom_rstput( 0, 0, inum, 'ff_t' , ff_t , ktype = jp_r8 )
	652	!
	653	! !== vertical mesh ==!
	654	!
	655	CALL iom_rstput( 0, 0, inum, 'e3t_1d' , e3t_1d , ktype = jp_r8 ) ! reference 1D-coordinate
	656	CALL iom_rstput( 0, 0, inum, 'e3w_1d' , e3w_1d , ktype = jp_r8 )
	657	!
	658	CALL iom_rstput( 0, 0, inum, 'e3t_0' , e3t_0 , ktype = jp_r8 ) ! vertical scale factors
	659	CALL iom_rstput( 0, 0, inum, 'e3u_0' , e3u_0 , ktype = jp_r8 )
	660	CALL iom_rstput( 0, 0, inum, 'e3v_0' , e3v_0 , ktype = jp_r8 )
	661	CALL iom_rstput( 0, 0, inum, 'e3f_0' , e3f_0 , ktype = jp_r8 )
	662	CALL iom_rstput( 0, 0, inum, 'e3w_0' , e3w_0 , ktype = jp_r8 )
	663	CALL iom_rstput( 0, 0, inum, 'e3uw_0' , e3uw_0 , ktype = jp_r8 )
	664	CALL iom_rstput( 0, 0, inum, 'e3vw_0' , e3vw_0 , ktype = jp_r8 )
	665	!
	666	! !== wet top and bottom level ==! (caution: multiplied by ssmask)
	667	!
	668	CALL iom_rstput( 0, 0, inum, 'top_level' , REAL( mikt, wp )*ssmask , ktype = jp_i4 ) ! nb of ocean T-points (ISF)
	669	CALL iom_rstput( 0, 0, inum, 'bottom_level' , REAL( mbkt, wp )*ssmask , ktype = jp_i4 ) ! nb of ocean T-points
	670	!
	671	IF( ln_sco ) THEN ! s-coordinate: store grid stiffness ratio (Not required anyway)
	672	CALL dom_stiff( z2d )
	673	CALL iom_rstput( 0, 0, inum, 'stiffness', z2d ) ! ! Max. grid stiffness ratio
	674	ENDIF
	675	!
	676	IF( ln_wd ) THEN ! wetting and drying domain
	677	CALL iom_rstput( 0, 0, inum, 'ht_0' , ht_0 , ktype = jp_r8 )
	678	CALL iom_rstput( 0, 0, inum, 'ht_wd' , ht_wd , ktype = jp_r8 )
	679	ENDIF
	680	!
	681	! Add some global attributes ( netcdf only )
	682	IF( iom_file(inum)%iolib == jpnf90 ) THEN
	683	CALL iom_putatt( inum, 'nn_cfg', nn_cfg )
	684	CALL iom_putatt( inum, 'cn_cfg', TRIM(cn_cfg) )
	685	ENDIF
	686	!
	687	! ! ============================
	688	! ! close the files
	689	! ! ============================
	690	CALL iom_close( inum )
	691	!
	692	END SUBROUTINE cfg_write
[3680]	693
[3]	694	!!======================================================================
	695	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: branches/2017/dev_r8126_ROBUST08_no_ghost/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90 @ 8758

Download in other formats: