Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

domain.F90 @ 2236

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

Download in other formats: