Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

trdvor.F90 @ 11738

Last change on this file since 11738 was 11738, checked in by marc, 5 years ago
The Dr Hook changes from my perl code.
File size: 28.6 KB

Rev	Line
[109]	1	MODULE trdvor
	2	!!======================================================================
	3	!! * MODULE trdvor *
	4	!! Ocean diagnostics: momentum trends
	5	!!=====================================================================
[4990]	6	!! History : 1.0 ! 2006-01 (L. Brunier, A-M. Treguier) Original code
	7	!! 2.0 ! 2008-04 (C. Talandier) New trends organization
	8	!! 3.5 ! 2012-02 (G. Madec) regroup beta.V computation with pvo trend
[503]	9	!!----------------------------------------------------------------------
[4990]	10
[109]	11	!!----------------------------------------------------------------------
	12	!! trd_vor : momentum trends averaged over the depth
[216]	13	!! trd_vor_zint : vorticity vertical integration
	14	!! trd_vor_init : initialization step
[109]	15	!!----------------------------------------------------------------------
[129]	16	USE oce ! ocean dynamics and tracers variables
[109]	17	USE dom_oce ! ocean space and time domain variables
[4990]	18	USE trd_oce ! trends: ocean variables
[109]	19	USE zdf_oce ! ocean vertical physics
[4990]	20	USE sbc_oce ! surface boundary condition: ocean
[109]	21	USE phycst ! Define parameters for the routines
[129]	22	USE ldfdyn_oce ! ocean active tracers: lateral physics
[109]	23	USE dianam ! build the name of file (routine)
[216]	24	USE zdfmxl ! mixed layer depth
[4990]	25	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
	26	USE in_out_manager ! I/O manager
[216]	27	USE ioipsl ! NetCDF library
[2715]	28	USE lib_mpp ! MPP library
[3294]	29	USE wrk_nemo ! Memory allocation
[109]	30
[11738]	31	USE yomhook, ONLY: lhook, dr_hook
	32	USE parkind1, ONLY: jprb, jpim
	33
[109]	34	IMPLICIT NONE
	35	PRIVATE
[129]	36
[216]	37	INTERFACE trd_vor_zint
	38	MODULE PROCEDURE trd_vor_zint_2d, trd_vor_zint_3d
	39	END INTERFACE
[129]	40
[4990]	41	PUBLIC trd_vor ! routine called by trddyn.F90
[503]	42	PUBLIC trd_vor_init ! routine called by opa.F90
[2715]	43	PUBLIC trd_vor_alloc ! routine called by nemogcm.F90
[109]	44
[2715]	45	INTEGER :: nh_t, nmoydpvor, nidvor, nhoridvor, ndimvor1, icount ! needs for IOIPSL output
	46	INTEGER, SAVE, ALLOCATABLE, DIMENSION(:) :: ndexvor1 ! needed for IOIPSL output
[2528]	47	INTEGER :: ndebug ! (0/1) set it to 1 in case of problem to have more print
[109]	48
[2715]	49	REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: vor_avr ! average
	50	REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: vor_avrb ! before vorticity (kt-1)
	51	REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: vor_avrbb ! vorticity at begining of the nwrite-1 timestep averaging period
	52	REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: vor_avrbn ! after vorticity at time step after the
	53	REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: rotot ! begining of the NWRITE-1 timesteps
	54	REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: vor_avrtot !
	55	REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:) :: vor_avrres !
	56	REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) :: vortrd ! curl of trends
[503]	57
[216]	58	CHARACTER(len=12) :: cvort
	59
[109]	60	!! * Substitutions
	61	# include "domzgr_substitute.h90"
	62	# include "ldfdyn_substitute.h90"
	63	# include "vectopt_loop_substitute.h90"
	64	!!----------------------------------------------------------------------
[2528]	65	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
[6486]	66	!! $Id$
[2528]	67	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[109]	68	!!----------------------------------------------------------------------
	69	CONTAINS
	70
[2715]	71	INTEGER FUNCTION trd_vor_alloc()
[11738]	72	INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
	73	INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
	74	REAL(KIND=jprb) :: zhook_handle
	75
	76	CHARACTER(LEN=*), PARAMETER :: RoutineName='TRD_VOR_ALLOC'
	77
	78	IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
	79
[2715]	80	!!----------------------------------------------------------------------------
	81	!! * ROUTINE trd_vor_alloc *
	82	!!----------------------------------------------------------------------------
	83	ALLOCATE( vor_avr (jpi,jpj) , vor_avrb(jpi,jpj) , vor_avrbb (jpi,jpj) , &
	84	& vor_avrbn (jpi,jpj) , rotot (jpi,jpj) , vor_avrtot(jpi,jpj) , &
	85	& vor_avrres(jpi,jpj) , vortrd (jpi,jpj,jpltot_vor) , &
	86	& ndexvor1 (jpi*jpj) , STAT= trd_vor_alloc )
	87	!
	88	IF( lk_mpp ) CALL mpp_sum ( trd_vor_alloc )
	89	IF( trd_vor_alloc /= 0 ) CALL ctl_warn('trd_vor_alloc: failed to allocate arrays')
[11738]	90	IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
[2715]	91	END FUNCTION trd_vor_alloc
	92
	93
[4990]	94	SUBROUTINE trd_vor( putrd, pvtrd, ktrd, kt )
	95	!!----------------------------------------------------------------------
	96	!! * ROUTINE trd_vor *
	97	!!
	98	!! ** Purpose : computation of cumulated trends over analysis period
	99	!! and make outputs (NetCDF or DIMG format)
	100	!!----------------------------------------------------------------------
	101	REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: putrd, pvtrd ! U and V trends
	102	INTEGER , INTENT(in ) :: ktrd ! trend index
	103	INTEGER , INTENT(in ) :: kt ! time step
	104	!
	105	INTEGER :: ji, jj ! dummy loop indices
	106	REAL(wp), POINTER, DIMENSION(:,:) :: ztswu, ztswv ! 2D workspace
[11738]	107	INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
	108	INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
	109	REAL(KIND=jprb) :: zhook_handle
	110
	111	CHARACTER(LEN=*), PARAMETER :: RoutineName='TRD_VOR'
	112
	113	IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
	114
[4990]	115	!!----------------------------------------------------------------------
	116
	117	CALL wrk_alloc( jpi, jpj, ztswu, ztswv )
	118
	119	SELECT CASE( ktrd )
	120	CASE( jpdyn_hpg ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_prg ) ! Hydrostatique Pressure Gradient
	121	CASE( jpdyn_keg ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_keg ) ! KE Gradient
	122	CASE( jpdyn_rvo ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_rvo ) ! Relative Vorticity
	123	CASE( jpdyn_pvo ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_pvo ) ! Planetary Vorticity Term
	124	CASE( jpdyn_ldf ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_ldf ) ! Horizontal Diffusion
	125	CASE( jpdyn_zad ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_zad ) ! Vertical Advection
	126	CASE( jpdyn_spg ) ; CALL trd_vor_zint( putrd, pvtrd, jpvor_spg ) ! Surface Pressure Grad.
	127	CASE( jpdyn_zdf ) ! Vertical Diffusion
	128	ztswu(:,:) = 0.e0 ; ztswv(:,:) = 0.e0
	129	DO jj = 2, jpjm1 ! wind stress trends
	130	DO ji = fs_2, fs_jpim1 ! vector opt.
	131	ztswu(ji,jj) = 0.5 * ( utau_b(ji,jj) + utau(ji,jj) ) / ( fse3u(ji,jj,1) * rau0 )
	132	ztswv(ji,jj) = 0.5 * ( vtau_b(ji,jj) + vtau(ji,jj) ) / ( fse3v(ji,jj,1) * rau0 )
	133	END DO
	134	END DO
	135	!
	136	CALL trd_vor_zint( putrd, pvtrd, jpvor_zdf ) ! zdf trend including surf./bot. stresses
	137	CALL trd_vor_zint( ztswu, ztswv, jpvor_swf ) ! surface wind stress
	138	CASE( jpdyn_bfr )
	139	CALL trd_vor_zint( putrd, pvtrd, jpvor_bfr ) ! Bottom stress
	140	!
	141	CASE( jpdyn_atf ) ! last trends: perform the output of 2D vorticity trends
	142	CALL trd_vor_iom( kt )
	143	END SELECT
	144	!
	145	CALL wrk_dealloc( jpi, jpj, ztswu, ztswv )
	146	!
[11738]	147	IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
[4990]	148	END SUBROUTINE trd_vor
	149
	150
[216]	151	SUBROUTINE trd_vor_zint_2d( putrdvor, pvtrdvor, ktrd )
[129]	152	!!----------------------------------------------------------------------------
[216]	153	!! * ROUTINE trd_vor_zint *
[109]	154	!!
	155	!! ** Purpose : computation of vertically integrated vorticity budgets
[2528]	156	!! from ocean surface down to control surface (NetCDF output)
[109]	157	!!
[2528]	158	!! ** Method/usage : integration done over nwrite-1 time steps
[109]	159	!!
[2528]	160	!! ** Action : trends :
[503]	161	!! vortrd (,, 1) = Pressure Gradient Trend
	162	!! vortrd (,, 2) = KE Gradient Trend
	163	!! vortrd (,, 3) = Relative Vorticity Trend
	164	!! vortrd (,, 4) = Coriolis Term Trend
	165	!! vortrd (,, 5) = Horizontal Diffusion Trend
	166	!! vortrd (,, 6) = Vertical Advection Trend
	167	!! vortrd (,, 7) = Vertical Diffusion Trend
	168	!! vortrd (,, 8) = Surface Pressure Grad. Trend
	169	!! vortrd (,, 9) = Beta V
[109]	170	!! vortrd (,,10) = forcing term
[2528]	171	!! vortrd (,,11) = bottom friction term
[109]	172	!! rotot(,) : total cumulative trends over nwrite-1 time steps
	173	!! vor_avrtot(,) : first membre of vrticity equation
	174	!! vor_avrres(,) : residual = dh/dt entrainment
	175	!!
	176	!! trends output in netCDF format using ioipsl
	177	!!----------------------------------------------------------------------
[2528]	178	INTEGER , INTENT(in ) :: ktrd ! ocean trend index
	179	REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: putrdvor ! u vorticity trend
	180	REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: pvtrdvor ! v vorticity trend
[2715]	181	!
[2528]	182	INTEGER :: ji, jj ! dummy loop indices
	183	INTEGER :: ikbu, ikbv ! local integers
[3294]	184	REAL(wp), POINTER, DIMENSION(:,:) :: zudpvor, zvdpvor ! total cmulative trends
[11738]	185	INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
	186	INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
	187	REAL(KIND=jprb) :: zhook_handle
	188
	189	CHARACTER(LEN=*), PARAMETER :: RoutineName='TRD_VOR_ZINT_2D'
	190
	191	IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
	192
[216]	193	!!----------------------------------------------------------------------
[109]	194
[3294]	195	!
	196	CALL wrk_alloc( jpi, jpj, zudpvor, zvdpvor ) ! Memory allocation
	197	!
[2715]	198
[3294]	199	zudpvor(:,:) = 0._wp ; zvdpvor(:,:) = 0._wp ! Initialisation
[2715]	200	CALL lbc_lnk( putrdvor, 'U', -1. ) ; CALL lbc_lnk( pvtrdvor, 'V', -1. ) ! lateral boundary condition
	201
[216]	202
	203	! =====================================
	204	! I vertical integration of 2D trends
	205	! =====================================
	206
[4990]	207	SELECT CASE( ktrd )
[2528]	208	!
[4990]	209	CASE( jpvor_bfr ) ! bottom friction
[216]	210	DO jj = 2, jpjm1
	211	DO ji = fs_2, fs_jpim1
[2528]	212	ikbu = mbkv(ji,jj)
	213	ikbv = mbkv(ji,jj)
	214	zudpvor(ji,jj) = putrdvor(ji,jj) * fse3u(ji,jj,ikbu) * e1u(ji,jj) * umask(ji,jj,ikbu)
	215	zvdpvor(ji,jj) = pvtrdvor(ji,jj) * fse3v(ji,jj,ikbv) * e2v(ji,jj) * vmask(ji,jj,ikbv)
[216]	216	END DO
	217	END DO
[2528]	218	!
[4990]	219	CASE( jpvor_swf ) ! wind stress
[216]	220	zudpvor(:,:) = putrdvor(:,:) * fse3u(:,:,1) * e1u(:,:) * umask(:,:,1)
	221	zvdpvor(:,:) = pvtrdvor(:,:) * fse3v(:,:,1) * e2v(:,:) * vmask(:,:,1)
[2528]	222	!
[216]	223	END SELECT
	224
	225	! Average except for Beta.V
	226	zudpvor(:,:) = zudpvor(:,:) * hur(:,:)
	227	zvdpvor(:,:) = zvdpvor(:,:) * hvr(:,:)
	228
	229	! Curl
[4990]	230	DO ji = 1, jpim1
	231	DO jj = 1, jpjm1
[2528]	232	vortrd(ji,jj,ktrd) = ( zvdpvor(ji+1,jj) - zvdpvor(ji,jj) &
	233	& - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) )
[216]	234	END DO
	235	END DO
[2528]	236	vortrd(:,:,ktrd) = vortrd(:,:,ktrd) * fmask(:,:,1) ! Surface mask
[216]	237
[2528]	238	IF( ndebug /= 0 ) THEN
[216]	239	IF(lwp) WRITE(numout,*) ' debuging trd_vor_zint: I done'
	240	CALL FLUSH(numout)
	241	ENDIF
[503]	242	!
[3294]	243	CALL wrk_dealloc( jpi, jpj, zudpvor, zvdpvor )
[2715]	244	!
[11738]	245	IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
[216]	246	END SUBROUTINE trd_vor_zint_2d
	247
	248
	249	SUBROUTINE trd_vor_zint_3d( putrdvor, pvtrdvor, ktrd )
	250	!!----------------------------------------------------------------------------
	251	!! * ROUTINE trd_vor_zint *
	252	!!
	253	!! ** Purpose : computation of vertically integrated vorticity budgets
[2528]	254	!! from ocean surface down to control surface (NetCDF output)
[216]	255	!!
[2528]	256	!! ** Method/usage : integration done over nwrite-1 time steps
[216]	257	!!
[2528]	258	!! ** Action : trends :
[216]	259	!! vortrd (,,1) = Pressure Gradient Trend
	260	!! vortrd (,,2) = KE Gradient Trend
	261	!! vortrd (,,3) = Relative Vorticity Trend
	262	!! vortrd (,,4) = Coriolis Term Trend
	263	!! vortrd (,,5) = Horizontal Diffusion Trend
	264	!! vortrd (,,6) = Vertical Advection Trend
	265	!! vortrd (,,7) = Vertical Diffusion Trend
	266	!! vortrd (,,8) = Surface Pressure Grad. Trend
	267	!! vortrd (,,9) = Beta V
	268	!! vortrd (,,10) = forcing term
	269	!! vortrd (,,11) = bottom friction term
	270	!! rotot(,) : total cumulative trends over nwrite-1 time steps
	271	!! vor_avrtot(,) : first membre of vrticity equation
	272	!! vor_avrres(,) : residual = dh/dt entrainment
	273	!!
	274	!! trends output in netCDF format using ioipsl
[109]	275	!!----------------------------------------------------------------------
[2715]	276	!
[2528]	277	INTEGER , INTENT(in ) :: ktrd ! ocean trend index
	278	REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: putrdvor ! u vorticity trend
	279	REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) :: pvtrdvor ! v vorticity trend
[2715]	280	!
	281	INTEGER :: ji, jj, jk ! dummy loop indices
[3294]	282	REAL(wp), POINTER, DIMENSION(:,:) :: zubet , zvbet ! Beta.V
	283	REAL(wp), POINTER, DIMENSION(:,:) :: zudpvor, zvdpvor ! total cmulative trends
[11738]	284	INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
	285	INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
	286	REAL(KIND=jprb) :: zhook_handle
	287
	288	CHARACTER(LEN=*), PARAMETER :: RoutineName='TRD_VOR_ZINT_3D'
	289
	290	IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
	291
[216]	292	!!----------------------------------------------------------------------
[109]	293
[3294]	294	CALL wrk_alloc( jpi,jpj, zubet, zvbet, zudpvor, zvdpvor )
[2715]	295
[216]	296	! Initialization
[2528]	297	zubet (:,:) = 0._wp
	298	zvbet (:,:) = 0._wp
	299	zudpvor(:,:) = 0._wp
	300	zvdpvor(:,:) = 0._wp
	301	!
[2715]	302	CALL lbc_lnk( putrdvor, 'U', -1. ) ! lateral boundary condition on input momentum trends
	303	CALL lbc_lnk( pvtrdvor, 'V', -1. )
[109]	304
[216]	305	! =====================================
	306	! I vertical integration of 3D trends
	307	! =====================================
	308	! putrdvor and pvtrdvor terms
	309	DO jk = 1,jpk
	310	zudpvor(:,:) = zudpvor(:,:) + putrdvor(:,:,jk) * fse3u(:,:,jk) * e1u(:,:) * umask(:,:,jk)
	311	zvdpvor(:,:) = zvdpvor(:,:) + pvtrdvor(:,:,jk) * fse3v(:,:,jk) * e2v(:,:) * vmask(:,:,jk)
	312	END DO
[109]	313
[4990]	314	! Planetary vorticity: 2nd computation (Beta.V term) store the vertical sum
	315	! as Beta.V term need intergration, not average
	316	IF( ktrd == jpvor_pvo ) THEN
[216]	317	zubet(:,:) = zudpvor(:,:)
	318	zvbet(:,:) = zvdpvor(:,:)
[4990]	319	DO ji = 1, jpim1
	320	DO jj = 1, jpjm1
	321	vortrd(ji,jj,jpvor_bev) = ( zvbet(ji+1,jj) - zvbet(ji,jj) &
	322	& - ( zubet(ji,jj+1) - zubet(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) )
	323	END DO
	324	END DO
	325	! Average of the Curl and Surface mask
	326	vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * hur(:,:) * fmask(:,:,1)
[216]	327	ENDIF
[4990]	328	!
	329	! Average
[216]	330	zudpvor(:,:) = zudpvor(:,:) * hur(:,:)
	331	zvdpvor(:,:) = zvdpvor(:,:) * hvr(:,:)
[4990]	332	!
[216]	333	! Curl
	334	DO ji=1,jpim1
	335	DO jj=1,jpjm1
[2528]	336	vortrd(ji,jj,ktrd) = ( zvdpvor(ji+1,jj) - zvdpvor(ji,jj) &
	337	& - ( zudpvor(ji,jj+1) - zudpvor(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) )
[216]	338	END DO
	339	END DO
	340	! Surface mask
	341	vortrd(:,:,ktrd) = vortrd(:,:,ktrd) * fmask(:,:,1)
	342
[2528]	343	IF( ndebug /= 0 ) THEN
[216]	344	IF(lwp) WRITE(numout,*) ' debuging trd_vor_zint: I done'
	345	CALL FLUSH(numout)
	346	ENDIF
[503]	347	!
[3294]	348	CALL wrk_dealloc( jpi,jpj, zubet, zvbet, zudpvor, zvdpvor )
[2715]	349	!
[11738]	350	IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
[216]	351	END SUBROUTINE trd_vor_zint_3d
[109]	352
[216]	353
[4990]	354	SUBROUTINE trd_vor_iom( kt )
[216]	355	!!----------------------------------------------------------------------
	356	!! * ROUTINE trd_vor *
	357	!!
	358	!! ** Purpose : computation of cumulated trends over analysis period
	359	!! and make outputs (NetCDF or DIMG format)
	360	!!----------------------------------------------------------------------
[4990]	361	INTEGER , INTENT(in ) :: kt ! time step
[2715]	362	!
[2528]	363	INTEGER :: ji, jj, jk, jl ! dummy loop indices
	364	INTEGER :: it, itmod ! local integers
	365	REAL(wp) :: zmean ! local scalars
[3294]	366	REAL(wp), POINTER, DIMENSION(:,:) :: zun, zvn
[11738]	367	INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
	368	INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
	369	REAL(KIND=jprb) :: zhook_handle
	370
	371	CHARACTER(LEN=*), PARAMETER :: RoutineName='TRD_VOR_IOM'
	372
	373	IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
	374
[216]	375	!!----------------------------------------------------------------------
	376
[3294]	377	CALL wrk_alloc( jpi, jpj, zun, zvn )
[2715]	378
[216]	379	! =================
	380	! I. Initialization
	381	! =================
	382
	383
	384	! I.1 set before values of vertically average u and v
	385	! ---------------------------------------------------
	386
[2528]	387	IF( kt > nit000 ) vor_avrb(:,:) = vor_avr(:,:)
[109]	388
[216]	389	! I.2 vertically integrated vorticity
	390	! ----------------------------------
[109]	391
[2528]	392	vor_avr (:,:) = 0._wp
	393	zun (:,:) = 0._wp
	394	zvn (:,:) = 0._wp
	395	vor_avrtot(:,:) = 0._wp
	396	vor_avrres(:,:) = 0._wp
[109]	397
[216]	398	! Vertically averaged velocity
[109]	399	DO jk = 1, jpk - 1
[2528]	400	zun(:,:) = zun(:,:) + e1u(:,:) * un(:,:,jk) * fse3u(:,:,jk)
	401	zvn(:,:) = zvn(:,:) + e2v(:,:) * vn(:,:,jk) * fse3v(:,:,jk)
[109]	402	END DO
	403
[2528]	404	zun(:,:) = zun(:,:) * hur(:,:)
	405	zvn(:,:) = zvn(:,:) * hvr(:,:)
[109]	406
[216]	407	! Curl
[4990]	408	DO ji = 1, jpim1
	409	DO jj = 1, jpjm1
[2528]	410	vor_avr(ji,jj) = ( ( zvn(ji+1,jj) - zvn(ji,jj) ) &
	411	& - ( zun(ji,jj+1) - zun(ji,jj) ) ) / ( e1f(ji,jj) * e2f(ji,jj) ) * fmask(ji,jj,1)
[129]	412	END DO
[109]	413	END DO
	414
	415	! =================================
[216]	416	! II. Cumulated trends
[109]	417	! =================================
	418
[216]	419	! II.1 set `before' mixed layer values for kt = nit000+1
	420	! ------------------------------------------------------
[109]	421	IF( kt == nit000+1 ) THEN
	422	vor_avrbb(:,:) = vor_avrb(:,:)
	423	vor_avrbn(:,:) = vor_avr (:,:)
	424	ENDIF
	425
[216]	426	! II.2 cumulated trends over analysis period (kt=2 to nwrite)
[109]	427	! ----------------------
	428	! trends cumulated over nwrite-2 time steps
	429
	430	IF( kt >= nit000+2 ) THEN
	431	nmoydpvor = nmoydpvor + 1
[503]	432	DO jl = 1, jpltot_vor
[129]	433	IF( jl /= 9 ) THEN
	434	rotot(:,:) = rotot(:,:) + vortrd(:,:,jl)
	435	ENDIF
[109]	436	END DO
	437	ENDIF
	438
	439	! =============================================
[216]	440	! III. Output in netCDF + residual computation
[109]	441	! =============================================
[216]	442
[1317]	443	! define time axis
[2528]	444	it = kt
[1334]	445	itmod = kt - nit000 + 1
[109]	446
[1601]	447	IF( MOD( it, nn_trd ) == 0 ) THEN
[1317]	448
[216]	449	! III.1 compute total trend
[109]	450	! ------------------------
[2528]	451	zmean = 1._wp / ( REAL( nmoydpvor, wp ) * 2._wp * rdt )
	452	vor_avrtot(:,:) = ( vor_avr(:,:) - vor_avrbn(:,:) + vor_avrb(:,:) - vor_avrbb(:,:) ) * zmean
[109]	453
	454
[216]	455	! III.2 compute residual
[109]	456	! ---------------------
[2528]	457	zmean = 1._wp / REAL( nmoydpvor, wp )
[109]	458	vor_avrres(:,:) = vor_avrtot(:,:) - rotot(:,:) / zmean
	459
[129]	460	! Boundary conditions
[109]	461	CALL lbc_lnk( vor_avrtot, 'F', 1. )
	462	CALL lbc_lnk( vor_avrres, 'F', 1. )
	463
	464
[216]	465	! III.3 time evolution array swap
[109]	466	! ------------------------------
	467	vor_avrbb(:,:) = vor_avrb(:,:)
[2528]	468	vor_avrbn(:,:) = vor_avr (:,:)
	469	!
	470	nmoydpvor = 0
	471	!
[109]	472	ENDIF
	473
[216]	474	! III.4 write trends to output
[109]	475	! ---------------------------
[216]	476
[109]	477	IF( kt >= nit000+1 ) THEN
	478
[1601]	479	IF( lwp .AND. MOD( itmod, nn_trd ) == 0 ) THEN
[503]	480	WRITE(numout,*) ''
	481	WRITE(numout,*) 'trd_vor : write trends in the NetCDF file at kt = ', kt
	482	WRITE(numout,*) '~~~~~~~ '
[216]	483	ENDIF
	484
[503]	485	CALL histwrite( nidvor,"sovortPh",it,vortrd(:,:,jpvor_prg),ndimvor1,ndexvor1) ! grad Ph
	486	CALL histwrite( nidvor,"sovortEk",it,vortrd(:,:,jpvor_keg),ndimvor1,ndexvor1) ! Energy
	487	CALL histwrite( nidvor,"sovozeta",it,vortrd(:,:,jpvor_rvo),ndimvor1,ndexvor1) ! rel vorticity
	488	CALL histwrite( nidvor,"sovortif",it,vortrd(:,:,jpvor_pvo),ndimvor1,ndexvor1) ! coriolis
	489	CALL histwrite( nidvor,"sovodifl",it,vortrd(:,:,jpvor_ldf),ndimvor1,ndexvor1) ! lat diff
	490	CALL histwrite( nidvor,"sovoadvv",it,vortrd(:,:,jpvor_zad),ndimvor1,ndexvor1) ! vert adv
	491	CALL histwrite( nidvor,"sovodifv",it,vortrd(:,:,jpvor_zdf),ndimvor1,ndexvor1) ! vert diff
	492	CALL histwrite( nidvor,"sovortPs",it,vortrd(:,:,jpvor_spg),ndimvor1,ndexvor1) ! grad Ps
	493	CALL histwrite( nidvor,"sovortbv",it,vortrd(:,:,jpvor_bev),ndimvor1,ndexvor1) ! beta.V
	494	CALL histwrite( nidvor,"sovowind",it,vortrd(:,:,jpvor_swf),ndimvor1,ndexvor1) ! wind stress
	495	CALL histwrite( nidvor,"sovobfri",it,vortrd(:,:,jpvor_bfr),ndimvor1,ndexvor1) ! bottom friction
[216]	496	CALL histwrite( nidvor,"1st_mbre",it,vor_avrtot ,ndimvor1,ndexvor1) ! First membre
	497	CALL histwrite( nidvor,"sovorgap",it,vor_avrres ,ndimvor1,ndexvor1) ! gap between 1st and 2 nd mbre
[503]	498	!
[2528]	499	IF( ndebug /= 0 ) THEN
[216]	500	WRITE(numout,*) ' debuging trd_vor: III.4 done'
[109]	501	CALL FLUSH(numout)
	502	ENDIF
[503]	503	!
[109]	504	ENDIF
[503]	505	!
[1601]	506	IF( MOD( it, nn_trd ) == 0 ) rotot(:,:)=0
[503]	507	!
[216]	508	IF( kt == nitend ) CALL histclo( nidvor )
[503]	509	!
[3294]	510	CALL wrk_dealloc( jpi, jpj, zun, zvn )
[2715]	511	!
[11738]	512	IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
[4990]	513	END SUBROUTINE trd_vor_iom
[216]	514
	515
	516	SUBROUTINE trd_vor_init
	517	!!----------------------------------------------------------------------
	518	!! * ROUTINE trd_vor_init *
	519	!!
	520	!! ** Purpose : computation of vertically integrated T and S budgets
	521	!! from ocean surface down to control surface (NetCDF output)
	522	!!----------------------------------------------------------------------
[503]	523	REAL(wp) :: zjulian, zsto, zout
[216]	524	CHARACTER (len=40) :: clhstnam
	525	CHARACTER (len=40) :: clop
[11738]	526	INTEGER(KIND=jpim), PARAMETER :: zhook_in = 0
	527	INTEGER(KIND=jpim), PARAMETER :: zhook_out = 1
	528	REAL(KIND=jprb) :: zhook_handle
	529
	530	CHARACTER(LEN=*), PARAMETER :: RoutineName='TRD_VOR_INIT'
	531
	532	IF (lhook) CALL dr_hook(RoutineName,zhook_in,zhook_handle)
	533
[216]	534	!!----------------------------------------------------------------------
	535
	536	! ===================
	537	! I. initialization
	538	! ===================
	539
	540	cvort='averaged-vor'
	541
	542	! Open specifier
[2528]	543	ndebug = 0 ! set it to 1 in case of problem to have more Print
[216]	544
	545	IF(lwp) THEN
	546	WRITE(numout,*) ' '
[503]	547	WRITE(numout,*) ' trd_vor_init: vorticity trends'
	548	WRITE(numout,*) ' ~~~~~~~~~~~~'
[216]	549	WRITE(numout,*) ' '
[503]	550	WRITE(numout,*) ' ##########################################################################'
	551	WRITE(numout,*) ' CAUTION: The interpretation of the vorticity trends is'
	552	WRITE(numout,*) ' not obvious, please contact Anne-Marie TREGUIER at: treguier@ifremer.fr '
	553	WRITE(numout,*) ' ##########################################################################'
[216]	554	WRITE(numout,*) ' '
[129]	555	ENDIF
[109]	556
[2715]	557	IF( trd_vor_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'trd_vor_init : unable to allocate trdvor arrays' )
	558
	559
[216]	560	! cumulated trends array init
	561	nmoydpvor = 0
	562	rotot(:,:)=0
	563	vor_avrtot(:,:)=0
	564	vor_avrres(:,:)=0
	565
[2528]	566	IF( ndebug /= 0 ) THEN
[216]	567	WRITE(numout,*) ' debuging trd_vor_init: I. done'
	568	CALL FLUSH(numout)
[129]	569	ENDIF
[109]	570
[216]	571	! =================================
	572	! II. netCDF output initialization
	573	! =================================
[109]	574
[216]	575	!-----------------------------------------
	576	! II.1 Define frequency of output and means
	577	! -----------------------------------------
[1312]	578	IF( ln_mskland ) THEN ; clop = "only(x)" ! put 1.e+20 on land (very expensive!!)
	579	ELSE ; clop = "x" ! no use of the mask value (require less cpu time)
	580	ENDIF
[216]	581	#if defined key_diainstant
	582	zsto = nwrite*rdt
[1312]	583	clop = "inst("//TRIM(clop)//")"
[109]	584	#else
[216]	585	zsto = rdt
[1312]	586	clop = "ave("//TRIM(clop)//")"
[216]	587	#endif
[1601]	588	zout = nn_trd*rdt
[216]	589
[503]	590	IF(lwp) WRITE(numout,*) ' netCDF initialization'
[216]	591
	592	! II.2 Compute julian date from starting date of the run
	593	! ------------------------
[1310]	594	CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian )
	595	zjulian = zjulian - adatrj ! set calendar origin to the beginning of the experiment
[503]	596	IF(lwp) WRITE(numout,*)' '
	597	IF(lwp) WRITE(numout,*)' Date 0 used :',nit000, &
	598	& ' YEAR ', nyear,' MONTH ' , nmonth, &
	599	& ' DAY ' , nday, 'Julian day : ', zjulian
[216]	600
	601	! II.3 Define the T grid trend file (nidvor)
	602	! ---------------------------------
[1601]	603	CALL dia_nam( clhstnam, nn_trd, 'vort' ) ! filename
[216]	604	IF(lwp) WRITE(numout,*) ' Name of NETCDF file ', clhstnam
	605	CALL histbeg( clhstnam, jpi, glamf, jpj, gphif,1, jpi, & ! Horizontal grid : glamt and gphit
[2528]	606	& 1, jpj, nit000-1, zjulian, rdt, nh_t, nidvor, domain_id=nidom, snc4chunks=snc4set )
[216]	607	CALL wheneq( jpi*jpj, fmask, 1, 1., ndexvor1, ndimvor1 ) ! surface
	608
	609	! Declare output fields as netCDF variables
	610	CALL histdef( nidvor, "sovortPh", cvort//"grad Ph" , "s-2", & ! grad Ph
	611	& jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
	612	CALL histdef( nidvor, "sovortEk", cvort//"Energy", "s-2", & ! Energy
	613	& jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
	614	CALL histdef( nidvor, "sovozeta", cvort//"rel vorticity", "s-2", & ! rel vorticity
	615	& jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
	616	CALL histdef( nidvor, "sovortif", cvort//"coriolis", "s-2", & ! coriolis
	617	& jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
	618	CALL histdef( nidvor, "sovodifl", cvort//"lat diff ", "s-2", & ! lat diff
	619	& jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
	620	CALL histdef( nidvor, "sovoadvv", cvort//"vert adv", "s-2", & ! vert adv
	621	& jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
	622	CALL histdef( nidvor, "sovodifv", cvort//"vert diff" , "s-2", & ! vert diff
	623	& jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
	624	CALL histdef( nidvor, "sovortPs", cvort//"grad Ps", "s-2", & ! grad Ps
	625	& jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
	626	CALL histdef( nidvor, "sovortbv", cvort//"Beta V", "s-2", & ! beta.V
	627	& jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
	628	CALL histdef( nidvor, "sovowind", cvort//"wind stress", "s-2", & ! wind stress
	629	& jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
	630	CALL histdef( nidvor, "sovobfri", cvort//"bottom friction", "s-2", & ! bottom friction
	631	& jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
	632	CALL histdef( nidvor, "1st_mbre", cvort//"1st mbre", "s-2", & ! First membre
	633	& jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
	634	CALL histdef( nidvor, "sovorgap", cvort//"gap", "s-2", & ! gap between 1st and 2 nd mbre
	635	& jpi,jpj,nh_t,1,1,1,-99,32,clop,zsto,zout)
[2528]	636	CALL histend( nidvor, snc4set )
[216]	637
[2528]	638	IF( ndebug /= 0 ) THEN
[216]	639	WRITE(numout,*) ' debuging trd_vor_init: II. done'
	640	CALL FLUSH(numout)
	641	ENDIF
[503]	642	!
[11738]	643	IF (lhook) CALL dr_hook(RoutineName,zhook_out,zhook_handle)
[216]	644	END SUBROUTINE trd_vor_init
	645
[109]	646	!!======================================================================
	647	END MODULE trdvor

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

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

Context Navigation

source: branches/UKMO/dev_r5518_GO6_under_ice_relax_dr_hook/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90 @ 11738

Download in other formats: