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.

trdvor.F90 in trunk/NEMOGCM/NEMO/OPA_SRC/TRD – NEMO

Context Navigation

source: trunk/NEMOGCM/NEMO/OPA_SRC/TRD/trdvor.F90 @ 2760

Last change on this file since 2760 was 2715, checked in by rblod, 13 years ago
First attempt to put dynamic allocation on the trunk
Property svn:keywords set to `Id`
File size: 26.6 KB

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

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

Download in other formats: