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.

dynspg_flt.F90 in branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN – NEMO

Context Navigation

source: branches/2011/DEV_r2739_STFC_dCSE/NEMOGCM/NEMO/OPA_SRC/DYN/dynspg_flt.F90 @ 4400

Last change on this file since 4400 was 3837, checked in by trackstand2, 11 years ago
Merge of finiss
Property svn:keywords set to `Id`
File size: 20.2 KB

Rev	Line
[358]	1	MODULE dynspg_flt
	2	!!======================================================================
	3	!! * MODULE dynspg_flt *
	4	!! Ocean dynamics: surface pressure gradient trend
	5	!!======================================================================
[1438]	6	!! History OPA ! 1998-05 (G. Roullet) free surface
	7	!! ! 1998-10 (G. Madec, M. Imbard) release 8.2
	8	!! NEMO O.1 ! 2002-08 (G. Madec) F90: Free form and module
	9	!! - ! 2002-11 (C. Talandier, A-M Treguier) Open boundaries
	10	!! 1.0 ! 2004-08 (C. Talandier) New trends organization
	11	!! - ! 2005-11 (V. Garnier) Surface pressure gradient organization
	12	!! 2.0 ! 2006-07 (S. Masson) distributed restart using iom
	13	!! - ! 2006-08 (J.Chanut, A.Sellar) Calls to BDY routines.
	14	!! 3.2 ! 2009-03 (G. Madec, M. Leclair, R. Benshila) introduce sshwzv module
[358]	15	!!----------------------------------------------------------------------
[575]	16	#if defined key_dynspg_flt \|\| defined key_esopa
[508]	17	!!----------------------------------------------------------------------
[358]	18	!! 'key_dynspg_flt' filtered free surface
	19	!!----------------------------------------------------------------------
[1601]	20	!! dyn_spg_flt : update the momentum trend with the surface pressure gradient in the filtered free surface case
[508]	21	!! flt_rst : read/write the time-splitting restart fields in the ocean restart file
[358]	22	!!----------------------------------------------------------------------
	23	USE oce ! ocean dynamics and tracers
	24	USE dom_oce ! ocean space and time domain
	25	USE zdf_oce ! ocean vertical physics
[888]	26	USE sbc_oce ! surface boundary condition: ocean
	27	USE obc_oce ! Lateral open boundary condition
	28	USE sol_oce ! ocean elliptic solver
[719]	29	USE phycst ! physical constants
[888]	30	USE domvvl ! variable volume
[1683]	31	USE dynadv ! advection
[1601]	32	USE solmat ! matrix construction for elliptic solvers
[358]	33	USE solpcg ! preconditionned conjugate gradient solver
	34	USE solsor ! Successive Over-relaxation solver
	35	USE obcdyn ! ocean open boundary condition (obc_dyn routines)
	36	USE obcvol ! ocean open boundary condition (obc_vol routines)
[911]	37	USE bdy_oce ! Unstructured open boundaries condition
	38	USE bdydyn ! Unstructured open boundaries condition (bdy_dyn routine)
	39	USE bdyvol ! Unstructured open boundaries condition (bdy_vol routine)
[2528]	40	USE cla ! cross land advection
[888]	41	USE in_out_manager ! I/O manager
[358]	42	USE lib_mpp ! distributed memory computing library
	43	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
	44	USE prtctl ! Print control
[508]	45	USE iom
	46	USE restart ! only for lrst_oce
[2528]	47	USE lib_fortran
	48	#if defined key_agrif
	49	USE agrif_opa_interp
	50	#endif
[358]	51
	52	IMPLICIT NONE
	53	PRIVATE
	54
[1438]	55	PUBLIC dyn_spg_flt ! routine called by step.F90
	56	PUBLIC flt_rst ! routine called by istate.F90
[358]	57
[3211]	58	!! * Control permutation of array indices
	59	# include "oce_ftrans.h90"
	60	# include "dom_oce_ftrans.h90"
	61	# include "zdf_oce_ftrans.h90"
	62	# include "sbc_oce_ftrans.h90"
	63	# include "obc_oce_ftrans.h90"
	64	# include "domvvl_ftrans.h90"
	65
[358]	66	!! * Substitutions
	67	# include "domzgr_substitute.h90"
	68	# include "vectopt_loop_substitute.h90"
	69	!!----------------------------------------------------------------------
[2528]	70	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
[888]	71	!! $Id$
[2715]	72	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[358]	73	!!----------------------------------------------------------------------
	74	CONTAINS
	75
	76	SUBROUTINE dyn_spg_flt( kt, kindic )
	77	!!----------------------------------------------------------------------
	78	!! * routine dyn_spg_flt *
	79	!!
	80	!! ** Purpose : Compute the now trend due to the surface pressure
	81	!! gradient in case of filtered free surface formulation and add
	82	!! it to the general trend of momentum equation.
	83	!!
	84	!! ** Method : Filtered free surface formulation. The surface
	85	!! pressure gradient is given by:
[1601]	86	!! spgu = 1/rau0 d/dx(ps) = 1/e1u di( sshn + btda )
	87	!! spgv = 1/rau0 d/dy(ps) = 1/e2v dj( sshn + btda )
[358]	88	!! where sshn is the free surface elevation and btda is the after
[1438]	89	!! time derivative of the free surface elevation
	90	!! -1- evaluate the surface presure trend (including the addi-
[358]	91	!! tional force) in three steps:
	92	!! a- compute the right hand side of the elliptic equation:
	93	!! gcb = 1/(e1t e2t) [ di(e2u spgu) + dj(e1v spgv) ]
	94	!! where (spgu,spgv) are given by:
	95	!! spgu = vertical sum[ e3u (ub+ 2 rdt ua ) ]
[2528]	96	!! - grav 2 rdt hu /e1u di[sshn + (emp-rnf)]
[358]	97	!! spgv = vertical sum[ e3v (vb+ 2 rdt va) ]
[2528]	98	!! - grav 2 rdt hv /e2v dj[sshn + (emp-rnf)]
[358]	99	!! and define the first guess from previous computation :
	100	!! zbtd = btda
	101	!! btda = 2 zbtd - btdb
	102	!! btdb = zbtd
	103	!! b- compute the relative accuracy to be reached by the
	104	!! iterative solver
	105	!! c- apply the solver by a call to sol... routine
[1438]	106	!! -2- compute and add the free surface pressure gradient inclu-
[358]	107	!! ding the additional force used to stabilize the equation.
	108	!!
	109	!! ** Action : - Update (ua,va) with the surf. pressure gradient trend
	110	!!
[508]	111	!! References : Roullet and Madec 1999, JGR.
[358]	112	!!---------------------------------------------------------------------
[2715]	113	USE oce, ONLY: zub => ta , zvb => sa ! (ta,sa) used as workspace
[3837]	114	! USE arpdebugging, ONLY: dump_array
[3211]	115	!! DCSE_NEMO: need additional directives for renamed module variables
	116	!FTRANS zub :I :I :z
	117	!FTRANS zvb :I :I :z
[1438]	118	!!
[1601]	119	INTEGER, INTENT(in ) :: kt ! ocean time-step index
	120	INTEGER, INTENT( out) :: kindic ! solver convergence flag (<0 if not converge)
[508]	121	!!
[2715]	122	INTEGER :: ji, jj, jk ! dummy loop indices
	123	REAL(wp) :: z2dt, z2dtg, zgcb, zbtd, ztdgu, ztdgv ! local scalars
[358]	124	!!----------------------------------------------------------------------
[508]	125	!
[358]	126	IF( kt == nit000 ) THEN
	127	IF(lwp) WRITE(numout,*)
	128	IF(lwp) WRITE(numout,*) 'dyn_spg_flt : surface pressure gradient trend'
	129	IF(lwp) WRITE(numout,*) '~~~~~~~~~~~ (free surface constant volume case)'
	130
	131	! set to zero free surface specific arrays
[2715]	132	spgu(:,:) = 0._wp ! surface pressure gradient (i-direction)
	133	spgv(:,:) = 0._wp ! surface pressure gradient (j-direction)
[508]	134
	135	! read filtered free surface arrays in restart file
[1200]	136	! when using agrif, sshn, gcx have to be read in istate
[1601]	137	IF(.NOT. lk_agrif) CALL flt_rst( nit000, 'READ' ) ! read or initialize the following fields:
[1438]	138	! ! gcx, gcxb
[358]	139	ENDIF
	140
[3837]	141	! CALL dump_array(kt, 'spgu',spgu,withHalos=.TRUE.)
	142	! CALL dump_array(kt, 'sshn',sshn,withHalos=.TRUE.)
	143	!#if defined key_z_first
	144	! CALL dump_array(kt, 'ua',ua(1,:,:),withHalos=.TRUE.)
	145	!#else
	146	! CALL dump_array(kt, 'ua',ua(:,:,1),withHalos=.TRUE.)
	147	!#endif
	148
[358]	149	! Local constant initialization
[1601]	150	z2dt = 2. * rdt ! time step: leap-frog
	151	IF( neuler == 0 .AND. kt == nit000 ) z2dt = rdt ! time step: Euler if restart from rest
	152	IF( neuler == 0 .AND. kt == nit000+1 ) CALL sol_mat( kt )
[358]	153	z2dtg = grav * z2dt
	154
[1683]	155	! Evaluate the masked next velocity (effect of the additional force not included)
	156	! ---------------------------------
	157	IF( lk_vvl ) THEN ! variable volume (surface pressure gradient already included in dyn_hpg)
	158	!
	159	IF( ln_dynadv_vec ) THEN ! vector form : applied on velocity
[3211]	160	#if defined key_z_first
	161	DO jj = 2, jpjm1
	162	DO ji = 2, jpim1
	163	DO jk = 1, jpkm1
	164	#else
[1683]	165	DO jk = 1, jpkm1
	166	DO jj = 2, jpjm1
	167	DO ji = fs_2, fs_jpim1 ! vector opt.
[3211]	168	#endif
[1683]	169	ua(ji,jj,jk) = ( ub(ji,jj,jk) + z2dt * ua(ji,jj,jk) ) * umask(ji,jj,jk)
	170	va(ji,jj,jk) = ( vb(ji,jj,jk) + z2dt * va(ji,jj,jk) ) * vmask(ji,jj,jk)
	171	END DO
[592]	172	END DO
	173	END DO
[1683]	174	!
	175	ELSE ! flux form : applied on thickness weighted velocity
[3211]	176	#if defined key_z_first
	177	DO jj = 2, jpjm1
	178	DO ji = 2, jpim1
	179	DO jk = 1, jpkm1
	180	#else
[1683]	181	DO jk = 1, jpkm1
	182	DO jj = 2, jpjm1
	183	DO ji = fs_2, fs_jpim1 ! vector opt.
[3211]	184	#endif
[1683]	185	ua(ji,jj,jk) = ( ub(ji,jj,jk) * fse3u_b(ji,jj,jk) &
	186	& + z2dt * ua(ji,jj,jk) * fse3u_n(ji,jj,jk) ) &
	187	& / fse3u_a(ji,jj,jk) * umask(ji,jj,jk)
	188	va(ji,jj,jk) = ( vb(ji,jj,jk) * fse3v_b(ji,jj,jk) &
	189	& + z2dt * va(ji,jj,jk) * fse3v_n(ji,jj,jk) ) &
	190	& / fse3v_a(ji,jj,jk) * vmask(ji,jj,jk)
	191	END DO
	192	END DO
	193	END DO
	194	!
	195	ENDIF
	196	!
	197	ELSE ! fixed volume (add the surface pressure gradient + unweighted time stepping)
	198	!
	199	DO jj = 2, jpjm1 ! Surface pressure gradient (now)
[358]	200	DO ji = fs_2, fs_jpim1 ! vector opt.
[592]	201	spgu(ji,jj) = - grav * ( sshn(ji+1,jj) - sshn(ji,jj) ) / e1u(ji,jj)
	202	spgv(ji,jj) = - grav * ( sshn(ji,jj+1) - sshn(ji,jj) ) / e2v(ji,jj)
	203	END DO
	204	END DO
[3211]	205	#if defined key_z_first
	206	DO jj = 2, jpjm1 ! unweighted time stepping
	207	DO ji = 2, jpim1
	208	DO jk = 1, jpkm1
	209	#else
[1683]	210	DO jk = 1, jpkm1 ! unweighted time stepping
[592]	211	DO jj = 2, jpjm1
	212	DO ji = fs_2, fs_jpim1 ! vector opt.
[3211]	213	#endif
[1438]	214	ua(ji,jj,jk) = ( ub(ji,jj,jk) + z2dt * ( ua(ji,jj,jk) + spgu(ji,jj) ) ) * umask(ji,jj,jk)
	215	va(ji,jj,jk) = ( vb(ji,jj,jk) + z2dt * ( va(ji,jj,jk) + spgv(ji,jj) ) ) * vmask(ji,jj,jk)
[592]	216	END DO
[358]	217	END DO
	218	END DO
[1438]	219	!
[592]	220	ENDIF
	221
[358]	222	#if defined key_obc
[2528]	223	CALL obc_dyn( kt ) ! Update velocities on each open boundary with the radiation algorithm
	224	CALL obc_vol( kt ) ! Correction of the barotropic componant velocity to control the volume of the system
[358]	225	#endif
[911]	226	#if defined key_bdy
[2528]	227	CALL bdy_dyn_frs( kt ) ! Update velocities on unstructured boundary using the Flow Relaxation Scheme
	228	CALL bdy_vol( kt ) ! Correction of the barotropic component velocity to control the volume of the system
[911]	229	#endif
[392]	230	#if defined key_agrif
[508]	231	CALL Agrif_dyn( kt ) ! Update velocities on each coarse/fine interfaces
[389]	232	#endif
[2528]	233	IF( nn_cla == 1 ) CALL cla_dynspg( kt ) ! Cross Land Advection (update (ua,va))
[358]	234
	235	! compute the next vertically averaged velocity (effect of the additional force not included)
	236	! ---------------------------------------------
	237	DO jj = 2, jpjm1
	238	DO ji = fs_2, fs_jpim1 ! vector opt.
[2715]	239	spgu(ji,jj) = 0._wp
	240	spgv(ji,jj) = 0._wp
[358]	241	END DO
	242	END DO
	243
	244	! vertical sum
	245	!CDIR NOLOOPCHG
	246	IF( lk_vopt_loop ) THEN ! vector opt., forced unroll
	247	DO jk = 1, jpkm1
	248	DO ji = 1, jpij
	249	spgu(ji,1) = spgu(ji,1) + fse3u(ji,1,jk) * ua(ji,1,jk)
	250	spgv(ji,1) = spgv(ji,1) + fse3v(ji,1,jk) * va(ji,1,jk)
	251	END DO
	252	END DO
	253	ELSE ! No vector opt.
[3211]	254	#if defined key_z_first
	255	DO jj = 2, jpjm1
	256	DO ji = 2, jpim1
	257	DO jk = 1, jpkm1
	258	#else
[358]	259	DO jk = 1, jpkm1
	260	DO jj = 2, jpjm1
	261	DO ji = 2, jpim1
[3211]	262	#endif
[358]	263	spgu(ji,jj) = spgu(ji,jj) + fse3u(ji,jj,jk) * ua(ji,jj,jk)
	264	spgv(ji,jj) = spgv(ji,jj) + fse3v(ji,jj,jk) * va(ji,jj,jk)
	265	END DO
	266	END DO
	267	END DO
	268	ENDIF
	269
	270	! transport: multiplied by the horizontal scale factor
	271	DO jj = 2, jpjm1
	272	DO ji = fs_2, fs_jpim1 ! vector opt.
	273	spgu(ji,jj) = spgu(ji,jj) * e2u(ji,jj)
	274	spgv(ji,jj) = spgv(ji,jj) * e1v(ji,jj)
	275	END DO
	276	END DO
[1601]	277	CALL lbc_lnk( spgu, 'U', -1. ) ! lateral boundary conditions
[358]	278	CALL lbc_lnk( spgv, 'V', -1. )
	279
[1438]	280	IF( lk_vvl ) CALL sol_mat( kt ) ! build the matrix at kt (vvl case only)
[592]	281
[358]	282	! Right hand side of the elliptic equation and first guess
[1601]	283	! --------------------------------------------------------
[358]	284	DO jj = 2, jpjm1
	285	DO ji = fs_2, fs_jpim1 ! vector opt.
	286	! Divergence of the after vertically averaged velocity
	287	zgcb = spgu(ji,jj) - spgu(ji-1,jj) &
	288	+ spgv(ji,jj) - spgv(ji,jj-1)
	289	gcb(ji,jj) = gcdprc(ji,jj) * zgcb
	290	! First guess of the after barotropic transport divergence
	291	zbtd = gcx(ji,jj)
	292	gcx (ji,jj) = 2. * zbtd - gcxb(ji,jj)
	293	gcxb(ji,jj) = zbtd
	294	END DO
	295	END DO
	296	! applied the lateral boundary conditions
[1601]	297	IF( nn_solv == 2 .AND. MAX( jpr2di, jpr2dj ) > 0 ) CALL lbc_lnk_e( gcb, c_solver_pt, 1. )
[358]	298
[392]	299	#if defined key_agrif
[413]	300	IF( .NOT. AGRIF_ROOT() ) THEN
[389]	301	! add contribution of gradient of after barotropic transport divergence
[508]	302	IF( nbondi == -1 .OR. nbondi == 2 ) gcb(3 ,:) = &
[1601]	303	& gcb(3 ,:) - z2dtg * z2dt * laplacu(2 ,:) * gcdprc(3 ,:) * hu(2 ,:) * e2u(2 ,:)
[508]	304	IF( nbondi == 1 .OR. nbondi == 2 ) gcb(nlci-2,:) = &
[1601]	305	& gcb(nlci-2,:) + z2dtg * z2dt * laplacu(nlci-2,:) * gcdprc(nlci-2,:) * hu(nlci-2,:) * e2u(nlci-2,:)
[508]	306	IF( nbondj == -1 .OR. nbondj == 2 ) gcb(: ,3) = &
[1601]	307	& gcb(:,3 ) - z2dtg * z2dt * laplacv(:,2 ) * gcdprc(:,3 ) * hv(:,2 ) * e1v(:,2 )
[508]	308	IF( nbondj == 1 .OR. nbondj == 2 ) gcb(:,nlcj-2) = &
[1601]	309	& gcb(:,nlcj-2) + z2dtg * z2dt * laplacv(:,nlcj-2) * gcdprc(:,nlcj-2) * hv(:,nlcj-2) * e1v(:,nlcj-2)
[413]	310	ENDIF
[389]	311	#endif
	312
	313
[358]	314	! Relative precision (computation on one processor)
	315	! ------------------
[1438]	316	rnorme =0.e0
[2528]	317	rnorme = GLOB_SUM( gcb(1:jpi,1:jpj) * gcdmat(1:jpi,1:jpj) * gcb(1:jpi,1:jpj) * bmask(:,:) )
[358]	318
	319	epsr = eps * eps * rnorme
	320	ncut = 0
[508]	321	! if rnorme is 0, the solution is 0, the solver is not called
[2715]	322	IF( rnorme == 0._wp ) THEN
	323	gcx(:,:) = 0._wp
	324	res = 0._wp
[358]	325	niter = 0
	326	ncut = 999
	327	ENDIF
	328
	329	! Evaluate the next transport divergence
	330	! --------------------------------------
	331	! Iterarive solver for the elliptic equation (except IF sol.=0)
	332	! (output in gcx with boundary conditions applied)
	333	kindic = 0
	334	IF( ncut == 0 ) THEN
[1601]	335	IF ( nn_solv == 1 ) THEN ; CALL sol_pcg( kindic ) ! diagonal preconditioned conjuguate gradient
	336	ELSEIF( nn_solv == 2 ) THEN ; CALL sol_sor( kindic ) ! successive-over-relaxation
[358]	337	ENDIF
	338	ENDIF
	339
	340	! Transport divergence gradient multiplied by z2dt
	341	! --------------------------------------------====
	342	DO jj = 2, jpjm1
	343	DO ji = fs_2, fs_jpim1 ! vector opt.
	344	! trend of Transport divergence gradient
[1601]	345	ztdgu = z2dtg * (gcx(ji+1,jj ) - gcx(ji,jj) ) / e1u(ji,jj)
	346	ztdgv = z2dtg * (gcx(ji ,jj+1) - gcx(ji,jj) ) / e2v(ji,jj)
[358]	347	! multiplied by z2dt
	348	#if defined key_obc
	349	! caution : grad D = 0 along open boundaries
[2528]	350	spgu(ji,jj) = z2dt * ztdgu * obcumask(ji,jj)
	351	spgv(ji,jj) = z2dt * ztdgv * obcvmask(ji,jj)
[911]	352	#elif defined key_bdy
	353	! caution : grad D = 0 along open boundaries
	354	! Remark: The filtering force could be reduced here in the FRS zone
	355	! by multiplying spgu/spgv by (1-alpha) ??
	356	spgu(ji,jj) = z2dt * ztdgu * bdyumask(ji,jj)
	357	spgv(ji,jj) = z2dt * ztdgv * bdyvmask(ji,jj)
[358]	358	#else
	359	spgu(ji,jj) = z2dt * ztdgu
	360	spgv(ji,jj) = z2dt * ztdgv
	361	#endif
	362	END DO
	363	END DO
	364
[1876]	365	#if defined key_agrif
[413]	366	IF( .NOT. Agrif_Root() ) THEN
	367	! caution : grad D (fine) = grad D (coarse) at coarse/fine interface
[1601]	368	IF( nbondi == -1 .OR. nbondi == 2 ) spgu(2 ,:) = z2dtg * z2dt * laplacu(2 ,:) * umask(2 ,:,1)
	369	IF( nbondi == 1 .OR. nbondi == 2 ) spgu(nlci-2,:) = z2dtg * z2dt * laplacu(nlci-2,:) * umask(nlci-2,:,1)
	370	IF( nbondj == -1 .OR. nbondj == 2 ) spgv(:,2 ) = z2dtg * z2dt * laplacv(:,2 ) * vmask(: ,2,1)
	371	IF( nbondj == 1 .OR. nbondj == 2 ) spgv(:,nlcj-2) = z2dtg * z2dt * laplacv(:,nlcj-2) * vmask(:,nlcj-2,1)
[389]	372	ENDIF
[1876]	373	#endif
[1438]	374	! Add the trends multiplied by z2dt to the after velocity
	375	! -------------------------------------------------------
[358]	376	! ( c a u t i o n : (ua,va) here are the after velocity not the
	377	! trend, the leap-frog time stepping will not
[508]	378	! be done in dynnxt.F90 routine)
[3211]	379	#if defined key_z_first
	380	DO jj = 2, jpjm1
	381	DO ji = 2, jpim1
	382	DO jk = 1, jpkm1
	383	#else
[358]	384	DO jk = 1, jpkm1
	385	DO jj = 2, jpjm1
	386	DO ji = fs_2, fs_jpim1 ! vector opt.
[3211]	387	#endif
[1438]	388	ua(ji,jj,jk) = ( ua(ji,jj,jk) + spgu(ji,jj) ) * umask(ji,jj,jk)
	389	va(ji,jj,jk) = ( va(ji,jj,jk) + spgv(ji,jj) ) * vmask(ji,jj,jk)
[358]	390	END DO
	391	END DO
	392	END DO
	393
[508]	394	! write filtered free surface arrays in restart file
	395	! --------------------------------------------------
	396	IF( lrst_oce ) CALL flt_rst( kt, 'WRITE' )
	397	!
[358]	398	END SUBROUTINE dyn_spg_flt
	399
[508]	400
	401	SUBROUTINE flt_rst( kt, cdrw )
[2715]	402	!!---------------------------------------------------------------------
	403	!! * ROUTINE ts_rst *
	404	!!
	405	!! ** Purpose : Read or write filtered free surface arrays in restart file
	406	!!----------------------------------------------------------------------
	407	INTEGER , INTENT(in) :: kt ! ocean time-step
	408	CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag
	409	!!----------------------------------------------------------------------
	410	!
	411	IF( TRIM(cdrw) == 'READ' ) THEN
	412	IF( iom_varid( numror, 'gcx', ldstop = .FALSE. ) > 0 ) THEN
[508]	413	! Caution : extra-hallow
	414	! gcx and gcxb are defined as: DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)
[2715]	415	CALL iom_get( numror, jpdom_autoglo, 'gcx' , gcx (1:jpi,1:jpj) )
	416	CALL iom_get( numror, jpdom_autoglo, 'gcxb', gcxb(1:jpi,1:jpj) )
	417	IF( neuler == 0 ) gcxb(:,:) = gcx (:,:)
	418	ELSE
	419	gcx (:,:) = 0.e0
	420	gcxb(:,:) = 0.e0
	421	ENDIF
	422	ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN
[508]	423	! Caution : extra-hallow
	424	! gcx and gcxb are defined as: DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj)
[2715]	425	CALL iom_rstput( kt, nitrst, numrow, 'gcx' , gcx (1:jpi,1:jpj) )
	426	CALL iom_rstput( kt, nitrst, numrow, 'gcxb', gcxb(1:jpi,1:jpj) )
	427	ENDIF
	428	!
[508]	429	END SUBROUTINE flt_rst
	430
[358]	431	#else
	432	!!----------------------------------------------------------------------
	433	!! Default case : Empty module No standart free surface cst volume
	434	!!----------------------------------------------------------------------
	435	CONTAINS
	436	SUBROUTINE dyn_spg_flt( kt, kindic ) ! Empty routine
	437	WRITE(,) 'dyn_spg_flt: You should not have seen this print! error?', kt, kindic
	438	END SUBROUTINE dyn_spg_flt
[657]	439	SUBROUTINE flt_rst ( kt, cdrw ) ! Empty routine
	440	INTEGER , INTENT(in) :: kt ! ocean time-step
	441	CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag
	442	WRITE(,) 'flt_rst: You should not have seen this print! error?', kt, cdrw
	443	END SUBROUTINE flt_rst
[358]	444	#endif
	445
	446	!!======================================================================
	447	END MODULE dynspg_flt

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

Download in other formats: