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

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.

domain.F90 in trunk/NEMOGCM/NEMO/OPA_SRC/DOM – NEMO

Context Navigation

source: trunk/NEMOGCM/NEMO/OPA_SRC/DOM/domain.F90 @ 2787

Last change on this file since 2787 was 2528, checked in by rblod, 13 years ago
Update NEMOGCM from branch nemo_v3_3_beta
Property svn:keywords set to `Id`
File size: 15.5 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
[3]	14	!!----------------------------------------------------------------------
[1438]	15
	16	!!----------------------------------------------------------------------
[3]	17	!! dom_init : initialize the space and time domain
	18	!! dom_nam : read and contral domain namelists
	19	!! dom_ctl : control print for the ocean domain
	20	!!----------------------------------------------------------------------
[2528]	21	USE oce ! ocean variables
	22	USE dom_oce ! domain: ocean
[888]	23	USE sbc_oce ! surface boundary condition: ocean
[719]	24	USE phycst ! physical constants
[1601]	25	USE closea ! closed seas
[719]	26	USE in_out_manager ! I/O manager
[3]	27	USE lib_mpp ! distributed memory computing library
	28
	29	USE domhgr ! domain: set the horizontal mesh
	30	USE domzgr ! domain: set the vertical mesh
	31	USE domstp ! domain: set the time-step
	32	USE dommsk ! domain: set the mask system
	33	USE domwri ! domain: write the meshmask file
[592]	34	USE domvvl ! variable volume
[2528]	35	USE c1d ! 1D vertical configuration
	36	USE dyncor_c1d ! Coriolis term (c1d case) (cor_c1d routine)
[3]	37
	38	IMPLICIT NONE
	39	PRIVATE
	40
[1438]	41	PUBLIC dom_init ! called by opa.F90
[3]	42
	43	!! * Substitutions
	44	# include "domzgr_substitute.h90"
[1438]	45	!!-------------------------------------------------------------------------
[2528]	46	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
[888]	47	!! $Id$
[2528]	48	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[1438]	49	!!-------------------------------------------------------------------------
[3]	50	CONTAINS
	51
	52	SUBROUTINE dom_init
	53	!!----------------------------------------------------------------------
	54	!! * ROUTINE dom_init *
	55	!!
	56	!! ** Purpose : Domain initialization. Call the routines that are
[1601]	57	!! required to create the arrays which define the space
	58	!! and time domain of the ocean model.
[3]	59	!!
[1601]	60	!! ** Method : - dom_msk: compute the masks from the bathymetry file
	61	!! - dom_hgr: compute or read the horizontal grid-point position
	62	!! and scale factors, and the coriolis factor
	63	!! - dom_zgr: define the vertical coordinate and the bathymetry
	64	!! - dom_stp: defined the model time step
	65	!! - dom_wri: create the meshmask file if nmsh=1
[2528]	66	!! - 1D configuration, move Coriolis, u and v at T-point
[3]	67	!!----------------------------------------------------------------------
	68	INTEGER :: jk ! dummy loop argument
	69	INTEGER :: iconf = 0 ! temporary integers
	70	!!----------------------------------------------------------------------
[1601]	71	!
[3]	72	IF(lwp) THEN
	73	WRITE(numout,*)
	74	WRITE(numout,*) 'dom_init : domain initialization'
	75	WRITE(numout,*) '~~~~~~~~'
	76	ENDIF
[1601]	77	!
	78	CALL dom_nam ! read namelist ( namrun, namdom, namcla )
	79	CALL dom_clo ! Closed seas and lake
	80	CALL dom_hgr ! Horizontal mesh
	81	CALL dom_zgr ! Vertical mesh and bathymetry
	82	CALL dom_msk ! Masks
	83	IF( lk_vvl ) CALL dom_vvl ! Vertical variable mesh
	84	!
[2528]	85	IF( lk_c1d ) THEN ! 1D configuration
	86	CALL cor_c1d ! Coriolis set at T-point
	87	umask(:,:,:) = tmask(:,:,:) ! U, V moved at T-point
	88	vmask(:,:,:) = tmask(:,:,:)
	89	END IF
	90	!
[1601]	91	hu(:,:) = 0.e0 ! Ocean depth at U- and V-points
[1438]	92	hv(:,:) = 0.e0
[3]	93	DO jk = 1, jpk
	94	hu(:,:) = hu(:,:) + fse3u(:,:,jk) * umask(:,:,jk)
	95	hv(:,:) = hv(:,:) + fse3v(:,:,jk) * vmask(:,:,jk)
	96	END DO
[1601]	97	! ! Inverse of the local depth
	98	hur(:,:) = 1. / ( hu(:,:) + 1.e0 - umask(:,:,1) ) * umask(:,:,1)
	99	hvr(:,:) = 1. / ( hv(:,:) + 1.e0 - vmask(:,:,1) ) * vmask(:,:,1)
[216]	100
[1601]	101	CALL dom_stp ! time step
	102	IF( nmsh /= 0 ) CALL dom_wri ! Create a domain file
	103	IF( .NOT.ln_rstart ) CALL dom_ctl ! Domain control
[1438]	104	!
[3]	105	END SUBROUTINE dom_init
	106
	107
	108	SUBROUTINE dom_nam
	109	!!----------------------------------------------------------------------
	110	!! * ROUTINE dom_nam *
	111	!!
	112	!! ** Purpose : read domaine namelists and print the variables.
	113	!!
	114	!! ** input : - namrun namelist
	115	!! - namdom namelist
	116	!! - namcla namelist
[2528]	117	!! - namnc4 namelist ! "key_netcdf4" only
[3]	118	!!----------------------------------------------------------------------
	119	USE ioipsl
[1601]	120	NAMELIST/namrun/ nn_no , cn_exp , cn_ocerst_in, cn_ocerst_out, ln_rstart , nn_rstctl, &
	121	& nn_it000, nn_itend , nn_date0 , nn_leapy , nn_istate , nn_stock , &
	122	& nn_write, ln_dimgnnn, ln_mskland , ln_clobber , nn_chunksz
[2528]	123	NAMELIST/namdom/ nn_bathy , rn_e3zps_min, rn_e3zps_rat, nn_msh , rn_hmin, &
	124	& nn_acc , rn_atfp , rn_rdt , rn_rdtmin , &
[1601]	125	& rn_rdtmax, rn_rdth , nn_baro , nn_closea
	126	NAMELIST/namcla/ nn_cla
[2528]	127	#if defined key_netcdf4
	128	NAMELIST/namnc4/ nn_nchunks_i, nn_nchunks_j, nn_nchunks_k, ln_nc4zip
	129	#endif
[3]	130	!!----------------------------------------------------------------------
	131
[1601]	132	REWIND( numnam ) ! Namelist namrun : parameters of the run
	133	READ ( numnam, namrun )
	134	!
	135	IF(lwp) THEN ! control print
[3]	136	WRITE(numout,*)
	137	WRITE(numout,*) 'dom_nam : domain initialization through namelist read'
	138	WRITE(numout,*) '~~~~~~~ '
[1601]	139	WRITE(numout,*) ' Namelist namrun'
	140	WRITE(numout,*) ' job number nn_no = ', nn_no
	141	WRITE(numout,*) ' experiment name for output cn_exp = ', cn_exp
	142	WRITE(numout,*) ' restart logical ln_rstart = ', ln_rstart
[1604]	143	WRITE(numout,*) ' control of time step nn_rstctl = ', nn_rstctl
[1601]	144	WRITE(numout,*) ' number of the first time step nn_it000 = ', nn_it000
	145	WRITE(numout,*) ' number of the last time step nn_itend = ', nn_itend
	146	WRITE(numout,*) ' initial calendar date aammjj nn_date0 = ', nn_date0
	147	WRITE(numout,*) ' leap year calendar (0/1) nn_leapy = ', nn_leapy
	148	WRITE(numout,*) ' initial state output nn_istate = ', nn_istate
	149	WRITE(numout,*) ' frequency of restart file nn_stock = ', nn_stock
	150	WRITE(numout,*) ' frequency of output file nn_write = ', nn_write
	151	WRITE(numout,*) ' multi file dimgout ln_dimgnnn = ', ln_dimgnnn
	152	WRITE(numout,*) ' mask land points ln_mskland = ', ln_mskland
	153	WRITE(numout,*) ' overwrite an existing file ln_clobber = ', ln_clobber
	154	WRITE(numout,*) ' NetCDF chunksize (bytes) nn_chunksz = ', nn_chunksz
[3]	155	ENDIF
	156
[1601]	157	no = nn_no ! conversion DOCTOR names into model names (this should disappear soon)
	158	cexper = cn_exp
	159	nrstdt = nn_rstctl
	160	nit000 = nn_it000
	161	nitend = nn_itend
	162	ndate0 = nn_date0
	163	nleapy = nn_leapy
	164	ninist = nn_istate
	165	nstock = nn_stock
	166	nwrite = nn_write
[3]	167
[1601]	168
	169	! ! control of output frequency
[1335]	170	IF ( nstock == 0 .OR. nstock > nitend ) THEN
[1601]	171	WRITE(ctmp1,*) 'nstock = ', nstock, ' it is forced to ', nitend
[783]	172	CALL ctl_warn( ctmp1 )
[1335]	173	nstock = nitend
[3]	174	ENDIF
	175	IF ( nwrite == 0 ) THEN
[1601]	176	WRITE(ctmp1,*) 'nwrite = ', nwrite, ' it is forced to ', nitend
[783]	177	CALL ctl_warn( ctmp1 )
	178	nwrite = nitend
[3]	179	ENDIF
	180
[2528]	181	#if defined key_agrif
[1601]	182	IF( Agrif_Root() ) THEN
[2528]	183	#endif
	184	SELECT CASE ( nleapy ) ! Choose calendar for IOIPSL
	185	CASE ( 1 )
	186	CALL ioconf_calendar('gregorian')
	187	IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "gregorian", i.e. leap year'
	188	CASE ( 0 )
	189	CALL ioconf_calendar('noleap')
	190	IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "noleap", i.e. no leap year'
	191	CASE ( 30 )
	192	CALL ioconf_calendar('360d')
	193	IF(lwp) WRITE(numout,*) ' The IOIPSL calendar is "360d", i.e. 360 days in a year'
	194	END SELECT
	195	#if defined key_agrif
[1601]	196	ENDIF
[2528]	197	#endif
[3]	198
[2528]	199	REWIND( numnam ) ! Namelist namdom : space & time domain (bathymetry, mesh, timestep)
[3]	200	READ ( numnam, namdom )
	201
	202	IF(lwp) THEN
[72]	203	WRITE(numout,*)
[1601]	204	WRITE(numout,*) ' Namelist namdom : space & time domain'
	205	WRITE(numout,*) ' flag read/compute bathymetry nn_bathy = ', nn_bathy
[2528]	206	WRITE(numout,*) ' min depth of the ocean (>0) or rn_hmin = ', rn_hmin
	207	WRITE(numout,*) ' min number of ocean level (<0) '
[1601]	208	WRITE(numout,*) ' minimum thickness of partial rn_e3zps_min = ', rn_e3zps_min, ' (m)'
	209	WRITE(numout,*) ' step level rn_e3zps_rat = ', rn_e3zps_rat
	210	WRITE(numout,*) ' create mesh/mask file(s) nn_msh = ', nn_msh
[2528]	211	WRITE(numout,*) ' = 0 no file created '
	212	WRITE(numout,*) ' = 1 mesh_mask '
	213	WRITE(numout,*) ' = 2 mesh and mask '
	214	WRITE(numout,*) ' = 3 mesh_hgr, msh_zgr and mask'
[1601]	215	WRITE(numout,*) ' ocean time step rn_rdt = ', rn_rdt
	216	WRITE(numout,*) ' asselin time filter parameter rn_atfp = ', rn_atfp
	217	WRITE(numout,*) ' time-splitting: nb of sub time-step nn_baro = ', nn_baro
	218	WRITE(numout,*) ' acceleration of converge nn_acc = ', nn_acc
	219	WRITE(numout,*) ' nn_acc=1: surface tracer rdt rn_rdtmin = ', rn_rdtmin
	220	WRITE(numout,*) ' bottom tracer rdt rdtmax = ', rn_rdtmax
	221	WRITE(numout,*) ' depth of transition rn_rdth = ', rn_rdth
	222	WRITE(numout,*) ' suppression of closed seas (=0) nn_closea = ', nn_closea
[223]	223	ENDIF
	224
[1601]	225	ntopo = nn_bathy ! conversion DOCTOR names into model names (this should disappear soon)
	226	e3zps_min = rn_e3zps_min
	227	e3zps_rat = rn_e3zps_rat
	228	nmsh = nn_msh
	229	nacc = nn_acc
	230	atfp = rn_atfp
	231	rdt = rn_rdt
	232	rdtmin = rn_rdtmin
	233	rdtmax = rn_rdtmin
	234	rdth = rn_rdth
	235	nclosea = nn_closea
	236
[2528]	237	REWIND( numnam ) ! Namelist cross land advection
[3]	238	READ ( numnam, namcla )
	239	IF(lwp) THEN
[72]	240	WRITE(numout,*)
[1601]	241	WRITE(numout,*) ' Namelist namcla'
	242	WRITE(numout,*) ' cross land advection nn_cla = ', nn_cla
[3]	243	ENDIF
	244
[2528]	245	#if defined key_netcdf4
	246	! ! NetCDF 4 case ("key_netcdf4" defined)
	247	REWIND( numnam ) ! Namelist namnc4 : netcdf4 chunking parameters
	248	READ ( numnam, namnc4 )
	249	IF(lwp) THEN ! control print
	250	WRITE(numout,*)
	251	WRITE(numout,*) ' Namelist namnc4 - Netcdf4 chunking parameters'
	252	WRITE(numout,*) ' number of chunks in i-dimension nn_nchunks_i = ', nn_nchunks_i
	253	WRITE(numout,*) ' number of chunks in j-dimension nn_nchunks_j = ', nn_nchunks_j
	254	WRITE(numout,*) ' number of chunks in k-dimension nn_nchunks_k = ', nn_nchunks_k
	255	WRITE(numout,*) ' apply netcdf4/hdf5 chunking & compression ln_nc4zip = ', ln_nc4zip
	256	ENDIF
[1601]	257
[2528]	258	! Put the netcdf4 settings into a simple structure (snc4set, defined in in_out_manager module)
	259	! Note the chunk size in the unlimited (time) dimension will be fixed at 1
	260	snc4set%ni = nn_nchunks_i
	261	snc4set%nj = nn_nchunks_j
	262	snc4set%nk = nn_nchunks_k
	263	snc4set%luse = ln_nc4zip
	264	#else
	265	snc4set%luse = .FALSE. ! No NetCDF 4 case
	266	#endif
[1438]	267	!
[3]	268	END SUBROUTINE dom_nam
	269
	270
	271	SUBROUTINE dom_ctl
	272	!!----------------------------------------------------------------------
	273	!! * ROUTINE dom_ctl *
	274	!!
	275	!! ** Purpose : Domain control.
	276	!!
	277	!! ** Method : compute and print extrema of masked scale factors
	278	!!----------------------------------------------------------------------
	279	INTEGER :: iimi1, ijmi1, iimi2, ijmi2, iima1, ijma1, iima2, ijma2
[1601]	280	INTEGER, DIMENSION(2) :: iloc !
[3]	281	REAL(wp) :: ze1min, ze1max, ze2min, ze2max
	282	!!----------------------------------------------------------------------
[1601]	283	!
	284	IF(lk_mpp) THEN
[181]	285	CALL mpp_minloc( e1t(:,:), tmask(:,:,1), ze1min, iimi1,ijmi1 )
	286	CALL mpp_minloc( e2t(:,:), tmask(:,:,1), ze2min, iimi2,ijmi2 )
	287	CALL mpp_maxloc( e1t(:,:), tmask(:,:,1), ze1max, iima1,ijma1 )
	288	CALL mpp_maxloc( e2t(:,:), tmask(:,:,1), ze2max, iima2,ijma2 )
	289	ELSE
	290	ze1min = MINVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
	291	ze2min = MINVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
	292	ze1max = MAXVAL( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
	293	ze2max = MAXVAL( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
[32]	294
[181]	295	iloc = MINLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
	296	iimi1 = iloc(1) + nimpp - 1
	297	ijmi1 = iloc(2) + njmpp - 1
	298	iloc = MINLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
	299	iimi2 = iloc(1) + nimpp - 1
	300	ijmi2 = iloc(2) + njmpp - 1
	301	iloc = MAXLOC( e1t(:,:), mask = tmask(:,:,1) == 1.e0 )
	302	iima1 = iloc(1) + nimpp - 1
	303	ijma1 = iloc(2) + njmpp - 1
	304	iloc = MAXLOC( e2t(:,:), mask = tmask(:,:,1) == 1.e0 )
	305	iima2 = iloc(1) + nimpp - 1
	306	ijma2 = iloc(2) + njmpp - 1
[32]	307	ENDIF
[3]	308	IF(lwp) THEN
[1601]	309	WRITE(numout,*)
	310	WRITE(numout,*) 'dom_ctl : extrema of the masked scale factors'
	311	WRITE(numout,*) '~~~~~~~'
[181]	312	WRITE(numout,"(14x,'e1t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1max, iima1, ijma1
	313	WRITE(numout,"(14x,'e1t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze1min, iimi1, ijmi1
	314	WRITE(numout,"(14x,'e2t maxi: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2max, iima2, ijma2
	315	WRITE(numout,"(14x,'e2t mini: ',1f10.2,' at i = ',i5,' j= ',i5)") ze2min, iimi2, ijmi2
[3]	316	ENDIF
[1438]	317	!
[3]	318	END SUBROUTINE dom_ctl
	319
	320	!!======================================================================
	321	END MODULE domain

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

Download in other formats: