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.

dtadyn.F90 in trunk/NEMO/OFF_SRC – NEMO

Context Navigation

source: trunk/NEMO/OFF_SRC/dtadyn.F90 @ 913

Last change on this file since 913 was 723, checked in by cetlod, 17 years ago
computation of horizontal divergence needed for vertical active trends, see ticket:12
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 30.8 KB

Rev	Line
[325]	1	MODULE dtadyn
	2	!!======================================================================
	3	!! * MODULE dtadyn *
	4	!! OFFLINE : interpolation of the physical fields
	5	!!=====================================================================
	6
	7	!!----------------------------------------------------------------------
	8	!! dta_dyn_init : initialization, namelist read, and parameters control
	9	!! dta_dyn : Interpolation of the fields
	10	!!----------------------------------------------------------------------
	11	!! * Modules used
	12	USE oce ! ocean dynamics and tracers variables
	13	USE dom_oce ! ocean space and time domain variables
	14	USE zdf_oce ! ocean vertical physics
	15	USE in_out_manager ! I/O manager
	16	USE phycst ! physical constants
	17	USE ocesbc
	18	USE ldfslp
	19	USE blk_oce
[446]	20	USE ldfeiv ! eddy induced velocity coef. (ldf_eiv routine)
	21	USE ldftra_oce ! ocean tracer lateral physics
[325]	22	USE zdfmxl
	23	USE trabbl ! tracers: bottom boundary layer
	24	USE ocfzpt
	25	USE zdfddm ! vertical physics: double diffusion
	26	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
	27	USE lib_mpp ! distributed memory computing library
	28
	29	IMPLICIT NONE
	30	PRIVATE
	31
	32	!! * Routine accessibility
	33	PUBLIC dta_dyn_init ! called by opa.F90
	34	PUBLIC dta_dyn ! called by step.F90
	35
	36	!! * Module variables
	37	INTEGER , PUBLIC, PARAMETER :: jpflx = 13
	38	INTEGER , PUBLIC, PARAMETER :: &
	39	jptaux = 1 , & ! indice in flux for taux
	40	jptauy = 2 , & ! indice in flux for tauy
	41	jpwind = 3 , & ! indice in flux for wspd
	42	jpemp = 4 , & ! indice in flux for E-P
	43	jpice = 5 , & ! indice in flux for ice concentration
	44	jpqsr = 6 ! indice in flux for shortwave heat flux
	45
	46	LOGICAL , PUBLIC :: &
	47	lperdyn = .TRUE. , & ! boolean for periodic fields or not
	48	lfirdyn = .TRUE. ! boolean for the first call or not
	49
	50	INTEGER , PUBLIC :: &
	51	ndtadyn = 12 , & ! Number of dat in one year
	52	ndtatot = 12 , & ! Number of data in the input field
	53	nsptint = 1 , & ! type of spatial interpolation
	54	nficdyn = 2 ! number of dynamical fields
	55
[495]	56	INTEGER :: &
	57	ndyn1, ndyn2 , &
[325]	58	nlecoff = 0 , & ! switch for the first read
	59	numfl_t, numfl_u, &
[495]	60	numfl_v, numfl_w
[325]	61
	62
	63	REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: &
	64	tdta , & ! temperature at two consecutive times
	65	sdta , & ! salinity at two consecutive times
	66	udta , & ! zonal velocity at two consecutive times
	67	vdta , & ! meridional velocity at two consecutive times
	68	wdta , & ! vertical velocity at two consecutive times
[723]	69	#if defined key_trc_diatrd
	70	hdivdta, & ! horizontal divergence
	71	#endif
[325]	72	avtdta ! vertical diffusivity coefficient
	73
[723]	74
[325]	75	#if defined key_ldfslp
	76	REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: &
	77	uslpdta , & ! zonal isopycnal slopes
	78	vslpdta , & ! meridional isopycnal slopes
	79	wslpidta , & ! zonal diapycnal slopes
	80	wslpjdta ! meridional diapycnal slopes
	81	#endif
	82
[495]	83	#if ! defined key_off_degrad
	84
	85	# if defined key_traldf_c2d
[446]	86	REAL(wp), DIMENSION(jpi,jpj,2) :: &
[495]	87	ahtwdta ! Lateral diffusivity
	88	# if defined key_trcldf_eiv
	89	REAL(wp), DIMENSION(jpi,jpj,2) :: &
	90	aeiwdta ! G&M coefficient
	91	# endif
	92	# endif
	93
	94	#else
	95
	96	REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: &
	97	ahtudta, ahtvdta, ahtwdta ! Lateral diffusivity
	98	# if defined key_trcldf_eiv
	99	REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: &
	100	aeiudta, aeivdta, aeiwdta ! G&M coefficient
	101	# endif
	102
[446]	103	#endif
[495]	104	# if defined key_diaeiv
	105	!! GM Velocity : to be used latter
	106	REAL(wp), DIMENSION(jpi,jpj,jpk,2) :: &
	107	eivudta, eivvdta, eivwdta
	108	# endif
[446]	109
[325]	110	REAL(wp), DIMENSION(jpi,jpj,jpflx,2) :: &
	111	flxdta ! auxiliary 2-D forcing fields at two consecutive times
	112	REAL(wp), DIMENSION(jpi,jpj,2) :: &
	113	zmxldta ! mixed layer depth at two consecutive times
	114
	115	#if defined key_trcbbl_dif \|\| defined key_trcbbl_adv
	116	REAL(wp), DIMENSION(jpi,jpj,2) :: &
	117	bblxdta , & ! frequency of bbl in the x direction at 2 consecutive times
	118	bblydta ! frequency of bbl in the y direction at 2 consecutive times
	119	#endif
	120
	121	!! * Substitutions
	122	# include "domzgr_substitute.h90"
	123	# include "vectopt_loop_substitute.h90"
[343]	124	!!----------------------------------------------------------------------
	125	!! OPA 9.0 , LOCEAN-IPSL (2005)
[723]	126	!! $Header: /home/opalod/NEMOCVSROOT/NEMO/OFF_SRC/dtadyn.F90,v 1.8 2007/10/12 09:05:29 opalod Exp $
[343]	127	!! This software is governed by the CeCILL licence see modipsl/doc/NEMO_CeCILL.txt
	128	!!----------------------------------------------------------------------
[325]	129
	130	CONTAINS
	131
	132	SUBROUTINE dta_dyn_init
	133	!!----------------------------------------------------------------------
	134	!! * ROUTINE dta_dyn_init *
	135	!!
	136	!! ** Purpose : initializations of parameters for the interpolation
	137	!!
	138	!! ** Method :
	139	!!
	140	!! History :
	141	!! ! original : 92-01 (M. Imbard: sub domain)
	142	!! ! 98-04 (L.Bopp MA Foujols: slopes for isopyc.)
	143	!! ! 98-05 (L. Bopp read output of coupled run)
	144	!! ! 05-03 (O. Aumont and A. El Moussaoui) F90
	145	!!----------------------------------------------------------------------
	146	!! * Modules used
	147
	148	!! * Local declarations
	149
	150
	151	NAMELIST/nam_offdyn/ ndtadyn, ndtatot, nsptint, &
	152	& nficdyn, lperdyn
	153	!!----------------------------------------------------------------------
	154
	155	! Define the dynamical input parameters
	156	! ======================================
	157
	158	! Read Namelist nam_offdyn : Lateral physics on tracers
	159	REWIND( numnam )
	160	READ ( numnam, nam_offdyn )
	161
	162	IF(lwp) THEN
	163	WRITE(numout,*)
	164	WRITE(numout,*) 'nam_offdyn : offline dynamical selection'
	165	WRITE(numout,*) '~~~~~~~'
	166	WRITE(numout,*) ' Namelist nam_offdyn : set parameters for the lecture of the dynamical fields'
	167	WRITE(numout,*)
	168	WRITE(numout,*) ' number of elements in the FILE for a year ndtadyn = ' , ndtadyn
	169	WRITE(numout,*) ' total number of elements in the FILE ndtatot = ' , ndtatot
	170	WRITE(numout,*) ' type of interpolation nsptint = ' , nsptint
	171	WRITE(numout,*) ' number of dynamics FILE nficdyn = ' , nficdyn
	172	WRITE(numout,*) ' loop on the same FILE lperdyn = ' , lperdyn
	173	WRITE(numout,*) ' '
	174	ENDIF
	175
	176	END SUBROUTINE dta_dyn_init
	177
	178	SUBROUTINE dta_dyn(kt)
	179	!!----------------------------------------------------------------------
	180	!! * ROUTINE dta_dyn *
	181	!!
	182	!! ** Purpose : Prepares dynamics and physics fields from an
	183	!! OPA9 simulation for an off-line simulation
	184	!! for passive tracer
	185	!!
	186	!! ** Method : calculates the position of DATA to read READ DATA
	187	!! (example month changement) computes slopes IF needed
	188	!! interpolates DATA IF needed
	189	!!
	190	!! ** History :
	191	!! ! original : 92-01 (M. Imbard: sub domain)
	192	!! ! addition : 98-04 (L.Bopp MA Foujols: slopes for isopyc.)
	193	!! ! addition : 98-05 (L. Bopp read output of coupled run)
	194	!! ! addition : 05-03 (O. Aumont and A. El Moussaoui) F90
[495]	195	!! ! addition : 05-12 (C. Ethe) Adapted for DEGINT
[325]	196	!!----------------------------------------------------------------------
	197	!! * Modules used
	198	USE eosbn2
	199
	200	!! * Arguments
	201	INTEGER, INTENT( in ) :: kt ! ocean time-step index
	202
	203	!! * Local declarations
	204	INTEGER :: iper, iperm1, iswap
	205
	206	REAL(wp) :: zpdtan, zpdtpe, zdemi, zt
	207	REAL(wp) :: zweigh, zweighm1
	208
	209	REAL(wp), DIMENSION(jpi,jpj,jpflx) :: &
	210	flx ! auxiliary field for 2-D surface boundary conditions
	211
	212
	213	! 0. Initialization
	214	! -----------------
[446]	215
[431]	216	IF (lfirdyn) THEN
[446]	217	!
	218	! time step MUST BE nint000
	219	!
	220	IF (kt.ne.nit000) THEN
	221	IF (lwp) THEN
	222	WRITE (numout,*) ' kt MUST BE EQUAL to nit000. kt=',kt &
	223	,' nit000=',nit000
	224	END IF
	225	STOP 'dtadyn'
	226	END if
	227	! Initialize the parameters of the interpolation
	228	CALL dta_dyn_init
[431]	229	ENDIF
[325]	230
[446]	231
[325]	232	zpdtan = raass / rdt
	233	zpdtpe = ((zpdtan / FLOAT (ndtadyn)))
	234	zdemi = zpdtpe * 0.5
	235	zt = (FLOAT (kt) + zdemi ) / zpdtpe
	236
	237	zweigh = zt - FLOAT(INT(zt))
	238	zweighm1 = 1. - zweigh
	239
	240	IF (lperdyn) THEN
	241	iperm1 = MOD(INT(zt),ndtadyn)
	242	ELSE
[612]	243	iperm1 = MOD(INT(zt),(ndtatot-1)) + 1
[325]	244	ENDIF
	245	iper = iperm1 + 1
	246	IF (iperm1 == 0) THEN
	247	IF (lperdyn) THEN
	248	iperm1 = ndtadyn
	249	ELSE
	250	IF (lfirdyn) THEN
	251	IF (lwp) THEN
	252	WRITE (numout,*) ' dynamic file is not periodic '
	253	WRITE (numout,*) ' with or without interpolation, '
	254	WRITE (numout,*) ' we take the first value'
	255	WRITE (numout,*) ' for the previous period '
	256	WRITE (numout,*) ' iperm1 = 0 '
	257	END IF
	258	END IF
	259	END IF
	260	END IF
	261
	262	iswap = 0
	263
	264	! 1. First call lfirdyn = true
	265	! ----------------------------
	266
	267	IF (lfirdyn) THEN
	268	!
	269	! store the information of the period read
	270	!
	271	ndyn1 = iperm1
	272	ndyn2 = iper
	273
	274	IF (lwp) THEN
	275	WRITE (numout,*) &
	276	' dynamics DATA READ for the period ndyn1 =',ndyn1, &
	277	& ' and for the period ndyn2 = ',ndyn2
	278	WRITE (numout,*) ' time step is :',kt
	279	WRITE (numout,*) ' we have ndtadyn = ',ndtadyn,&
	280	& ' records in the dynamic FILE for one year'
	281	END IF
	282	!
	283	! DATA READ for the iperm1 period
	284	!
[495]	285	IF( iperm1 /= 0 ) THEN
[325]	286	CALL dynrea( kt, iperm1 )
	287	ELSE
	288	CALL dynrea( kt, 1 )
	289	ENDIF
	290	!
	291	! Computes dynamical fields
	292	!
	293	tn(:,:,:)=tdta(:,:,:,2)
	294	sn(:,:,:)=sdta(:,:,:,2)
	295	avt(:,:,:)=avtdta(:,:,:,2)
	296
[495]	297
[325]	298	IF(lwp) THEN
	299	WRITE(numout,*)' temperature '
	300	WRITE(numout,*)
[446]	301	CALL prihre(tn(1,1,1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout)
[325]	302	WRITE(numout,*) ' level = ',jpk/2
[446]	303	CALL prihre(tn(1,1,jpk/2),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout)
[325]	304	WRITE(numout,*) ' level = ',jpkm1
[446]	305	CALL prihre(tn(1,1,jpkm1),jpi,jpj,1,jpi,20,1,jpj,20,1.,numout)
[325]	306	ENDIF
	307
	308	#if defined key_ldfslp
	309	CALL eos( tn, sn, rhd, rhop ) ! Time-filtered in situ density
	310	CALL bn2( tn, sn, rn2 ) ! before Brunt-Vaisala frequency
	311	CALL zdf_mxl( kt ) ! mixed layer depth
	312	CALL ldf_slp( kt, rhd, rn2 )
	313
	314	uslpdta(:,:,:,2)=uslp(:,:,:)
	315	vslpdta(:,:,:,2)=vslp(:,:,:)
	316	wslpidta(:,:,:,2)=wslpi(:,:,:)
	317	wslpjdta(:,:,:,2)=wslpj(:,:,:)
	318	#endif
	319	!
	320	! swap from record 2 to 1
	321	!
	322	udta(:,:,:,1)=udta(:,:,:,2)
	323	vdta(:,:,:,1)=vdta(:,:,:,2)
	324	wdta(:,:,:,1)=wdta(:,:,:,2)
[723]	325	#if defined key_trc_diatrd
	326	hdivdta(:,:,:,1)=hdivdta(:,:,:,2)
	327	#endif
[325]	328	avtdta(:,:,:,1)=avtdta(:,:,:,2)
	329	tdta(:,:,:,1)=tdta(:,:,:,2)
	330	sdta(:,:,:,1)=sdta(:,:,:,2)
	331	#if defined key_ldfslp
	332	uslpdta(:,:,:,1)=uslpdta(:,:,:,2)
	333	vslpdta(:,:,:,1)=vslpdta(:,:,:,2)
	334	wslpidta(:,:,:,1)=wslpidta(:,:,:,2)
	335	wslpjdta(:,:,:,1)=wslpjdta(:,:,:,2)
	336	#endif
	337	flxdta(:,:,:,1) = flxdta(:,:,:,2)
	338	zmxldta(:,:,1)=zmxldta(:,:,2)
[495]	339	#if ! defined key_off_degrad
	340
	341	# if defined key_traldf_c2d
	342	ahtwdta(:,:,1)= ahtwdta(:,:,2)
	343	# if defined key_trcldf_eiv
	344	aeiwdta(:,:,1)= aeiwdta(:,:,2)
	345	# endif
	346	# endif
	347
	348	#else
	349	ahtudta(:,:,:,1) = ahtudta(:,:,:,2)
	350	ahtvdta(:,:,:,1) = ahtvdta(:,:,:,2)
	351	ahtwdta(:,:,:,1) = ahtwdta(:,:,:,2)
	352	# if defined key_trcldf_eiv
	353	aeiudta(:,:,:,1) = aeiudta(:,:,:,2)
	354	aeivdta(:,:,:,1) = aeivdta(:,:,:,2)
	355	aeiwdta(:,:,:,1) = aeiwdta(:,:,:,2)
	356	# endif
	357
[446]	358	#endif
[495]	359
[325]	360	#if defined key_trcbbl_dif \|\| defined key_trcbbl_adv
	361	bblxdta(:,:,1)=bblxdta(:,:,2)
	362	bblydta(:,:,1)=bblydta(:,:,2)
	363	#endif
	364	!
	365	! indicates a swap
	366	!
	367	iswap = 1
	368	!
	369	! DATA READ for the iper period
	370	!
[495]	371	CALL dynrea( kt, iper )
[325]	372	!
	373	! Computes wdta (and slopes if key_trahdfiso)
	374	!
	375	tn(:,:,:)=tdta(:,:,:,2)
	376	sn(:,:,:)=sdta(:,:,:,2)
	377	avt(:,:,:)=avtdta(:,:,:,2)
	378
	379
	380	#if defined key_ldfslp
	381	CALL eos( tn, sn, rhd, rhop ) ! Time-filtered in situ density
	382	CALL bn2( tn, sn, rn2 ) ! before Brunt-Vaisala frequency
	383	CALL zdf_mxl( kt ) ! mixed layer depth
	384	CALL ldf_slp( kt, rhd, rn2 )
	385
	386	uslpdta(:,:,:,2)=uslp(:,:,:)
	387	vslpdta(:,:,:,2)=vslp(:,:,:)
	388	wslpidta(:,:,:,2)=wslpi(:,:,:)
	389	wslpjdta(:,:,:,2)=wslpj(:,:,:)
	390	#endif
	391	!
	392	! trace the first CALL
	393	!
	394	lfirdyn=.FALSE.
	395	ENDIF
	396	!
	397	! and now what we have to DO at every time step
	398	!
	399	! check the validity of the period in memory
	400	!
	401	IF (iperm1.NE.ndyn1) THEN
	402	IF (iperm1.EQ.0.) THEN
	403	IF (lwp) THEN
	404	WRITE (numout,*) ' dynamic file is not periodic '
	405	WRITE (numout,*) ' with or without interpolation, '
	406	WRITE (numout,*) ' we take the last value'
	407	WRITE (numout,*) ' for the last period '
	408	WRITE (numout,*) ' iperm1 = 12 '
	409	WRITE (numout,*) ' iper = 13'
	410	ENDIF
	411	iperm1 = 12
	412	iper =13
	413	ENDIF
	414	!
	415	! we have to prepare a NEW READ of DATA
	416	!
	417	! swap from record 2 to 1
	418	!
[495]	419	udta(:,:,:,1) = udta(:,:,:,2)
	420	vdta(:,:,:,1) = vdta(:,:,:,2)
[723]	421	wdta(:,:,:,1) = wdta(:,:,:,2)
	422	#if defined key_trc_diatrd
	423	hdivdta(:,:,:,1)=hdivdta(:,:,:,2)
	424	#endif
[495]	425	avtdta(:,:,:,1) = avtdta(:,:,:,2)
	426	tdta(:,:,:,1) = tdta(:,:,:,2)
	427	sdta(:,:,:,1) = sdta(:,:,:,2)
[325]	428	#if defined key_ldfslp
[495]	429	uslpdta(:,:,:,1) = uslpdta(:,:,:,2)
	430	vslpdta(:,:,:,1) = vslpdta(:,:,:,2)
	431	wslpidta(:,:,:,1) = wslpidta(:,:,:,2)
	432	wslpjdta(:,:,:,1) = wslpjdta(:,:,:,2)
[325]	433	#endif
	434	flxdta(:,:,:,1) = flxdta(:,:,:,2)
[495]	435	zmxldta(:,:,1) = zmxldta(:,:,2)
	436
	437	#if ! defined key_off_degrad
	438
	439	# if defined key_traldf_c2d
	440	ahtwdta(:,:,1)= ahtwdta(:,:,2)
	441	# if defined key_trcldf_eiv
	442	aeiwdta(:,:,1)= aeiwdta(:,:,2)
	443	# endif
	444	# endif
	445
	446	#else
	447	ahtudta(:,:,:,1) = ahtudta(:,:,:,2)
	448	ahtvdta(:,:,:,1) = ahtvdta(:,:,:,2)
	449	ahtwdta(:,:,:,1) = ahtwdta(:,:,:,2)
	450	# if defined key_trcldf_eiv
	451	aeiudta(:,:,:,1) = aeiudta(:,:,:,2)
	452	aeivdta(:,:,:,1) = aeivdta(:,:,:,2)
	453	aeiwdta(:,:,:,1) = aeiwdta(:,:,:,2)
	454	# endif
	455
[446]	456	#endif
[495]	457
[325]	458	#if defined key_trcbbl_dif \|\| defined key_trcbbl_adv
[495]	459	bblxdta(:,:,1) = bblxdta(:,:,2)
	460	bblydta(:,:,1) = bblydta(:,:,2)
[325]	461	#endif
	462	!
	463	! indicates a swap
	464	!
	465	iswap = 1
	466	!
	467	! READ DATA for the iper period
	468	!
[495]	469	CALL dynrea( kt, iper )
[325]	470	!
	471	! Computes wdta (and slopes if key_trahdfiso)
	472	!
	473	tn(:,:,:)=tdta(:,:,:,2)
	474	sn(:,:,:)=sdta(:,:,:,2)
	475	avt(:,:,:)=avtdta(:,:,:,2)
	476
	477	#if defined key_ldfslp
	478	CALL eos( tn, sn, rhd, rhop ) ! Time-filtered in situ density
	479	CALL bn2( tn, sn, rn2 ) ! before Brunt-Vaisala frequency
	480	CALL zdf_mxl( kt ) ! mixed layer depth
	481	CALL ldf_slp( kt, rhd, rn2 )
	482
	483	uslpdta(:,:,:,2)=uslp(:,:,:)
	484	vslpdta(:,:,:,2)=vslp(:,:,:)
	485	wslpidta(:,:,:,2)=wslpi(:,:,:)
	486	wslpjdta(:,:,:,2)=wslpj(:,:,:)
	487	#endif
	488	!
	489	! store the information of the period read
	490	!
	491	ndyn1 = ndyn2
	492	ndyn2 = iper
	493	!
[495]	494	! we have READ another period of DATA !
[325]	495	IF (lwp) THEN
	496	WRITE (numout,*) ' dynamics DATA READ for the period ndyn1 =',ndyn1
	497	WRITE (numout,*) ' and the period ndyn2 = ',ndyn2
	498	WRITE (numout,*) ' time step is :',kt
	499	END IF
	500
	501	END IF
	502
	503	!
	504	! compute the DATA at the given time step
	505	!
[495]	506	IF ( nsptint == 0 ) THEN
[325]	507	!
	508	! no spatial interpolation
	509	!
	510	! DATA are probably correct
	511	! we have to initialize DATA IF we have changed the period
	512	!
	513	IF (iswap.eq.1) THEN
	514	!
	515	! initialize now fields with the NEW DATA READ
	516	!
	517	un(:,:,:)=udta(:,:,:,2)
	518	vn(:,:,:)=vdta(:,:,:,2)
	519	wn(:,:,:)=wdta(:,:,:,2)
[723]	520	#if defined key_trc_diatrd
	521	hdivn(:,:,:)=hdivdta(:,:,:,2)
	522	#endif
[325]	523	#if defined key_trc_zdfddm
	524	avs(:,:,:)=avtdta(:,:,:,2)
	525	#endif
	526	avt(:,:,:)=avtdta(:,:,:,2)
	527	tn(:,:,:)=tdta(:,:,:,2)
	528	sn(:,:,:)=sdta(:,:,:,2)
	529	#if defined key_ldfslp
	530	uslp(:,:,:)=uslpdta(:,:,:,2)
	531	vslp(:,:,:)=vslpdta(:,:,:,2)
	532	wslpi(:,:,:)=wslpidta(:,:,:,2)
	533	wslpj(:,:,:)=wslpjdta(:,:,:,2)
	534	#endif
	535	flx(:,:,:) = flxdta(:,:,:,2)
	536	hmld(:,:)=zmxldta(:,:,2)
[495]	537	#if ! defined key_off_degrad
	538
	539	# if defined key_traldf_c2d
	540	ahtwdta(:,:,1)= ahtwdta(:,:,2)
	541	# if defined key_trcldf_eiv
	542	aeiwdta(:,:,1)= aeiwdta(:,:,2)
	543	# endif
	544	# endif
	545
	546	#else
	547	ahtudta(:,:,:,1) = ahtudta(:,:,:,2)
	548	ahtvdta(:,:,:,1) = ahtvdta(:,:,:,2)
	549	ahtwdta(:,:,:,1) = ahtwdta(:,:,:,2)
	550	# if defined key_trcldf_eiv
	551	aeiudta(:,:,:,1) = aeiudta(:,:,:,2)
	552	aeivdta(:,:,:,1) = aeivdta(:,:,:,2)
	553	aeiwdta(:,:,:,1) = aeiwdta(:,:,:,2)
	554	# endif
	555
[446]	556	#endif
[495]	557
[325]	558	#if defined key_trcbbl_dif \|\| defined key_trcbbl_adv
	559	bblx(:,:)=bblxdta(:,:,2)
	560	bbly(:,:)=bblydta(:,:,2)
	561	#endif
	562	!
	563	! keep needed fluxes
	564	!
	565	#if defined key_flx_bulk_monthly \|\| defined key_flx_bulk_daily
	566	vatm(:,:) = flx(:,:,jpwind)
	567	#endif
	568	freeze(:,:) = flx(:,:,jpice)
	569	emp(:,:) = flx(:,:,jpemp)
[446]	570	emps(:,:) = emp(:,:)
[325]	571	qsr(:,:) = flx(:,:,jpqsr)
	572
	573	END IF
	574
	575	ELSE
[495]	576	IF ( nsptint == 1 ) THEN
[325]	577	!
	578	! linear interpolation
	579	!
	580	! initialize now fields with a linear interpolation
	581	!
	582	un(:,:,:) = zweighm1 * udta(:,:,:,1) + zweigh * udta(:,:,:,2)
	583	vn(:,:,:) = zweighm1 * vdta(:,:,:,1) + zweigh * vdta(:,:,:,2)
	584	wn(:,:,:) = zweighm1 * wdta(:,:,:,1) + zweigh * wdta(:,:,:,2)
[723]	585	#if defined key_trc_diatrd
	586	hdivn(:,:,:) = zweighm1 * hdivdta(:,:,:,1) + zweigh * hdivdta(:,:,:,2)
	587	#endif
[325]	588	#if defined key_zdfddm
	589	avs(:,:,:)= zweighm1 * avtdta(:,:,:,1) + zweigh * avtdta(:,:,:,2)
	590	#endif
	591	avt(:,:,:)= zweighm1 * avtdta(:,:,:,1) + zweigh * avtdta(:,:,:,2)
	592	tn(:,:,:) = zweighm1 * tdta(:,:,:,1) + zweigh * tdta(:,:,:,2)
	593	sn(:,:,:) = zweighm1 * sdta(:,:,:,1) + zweigh * sdta(:,:,:,2)
	594
	595
	596	#if defined key_ldfslp
	597	uslp(:,:,:) = zweighm1 * uslpdta(:,:,:,1) + zweigh * uslpdta(:,:,:,2)
	598	vslp(:,:,:) = zweighm1 * vslpdta(:,:,:,1) + zweigh * vslpdta(:,:,:,2)
	599	wslpi(:,:,:) = zweighm1 * wslpidta(:,:,:,1) + zweigh * wslpidta(:,:,:,2)
	600	wslpj(:,:,:) = zweighm1 * wslpjdta(:,:,:,1) + zweigh * wslpjdta(:,:,:,2)
	601	#endif
	602	flx(:,:,:) = zweighm1 * flxdta(:,:,:,1) + zweigh * flxdta(:,:,:,2)
	603	hmld(:,:) = zweighm1 * zmxldta(:,:,1) + zweigh * zmxldta(:,:,2)
[495]	604	#if ! defined key_off_degrad
	605
	606	# if defined key_traldf_c2d
	607	ahtw(:,:) = zweighm1 * ahtwdta(:,:,1) + zweigh * ahtwdta(:,:,2)
	608	# if defined key_trcldf_eiv
	609	aeiw(:,:) = zweighm1 * aeiwdta(:,:,1) + zweigh * aeiwdta(:,:,2)
	610	# endif
	611	# endif
	612
	613	#else
	614	ahtu(:,:,:) = zweighm1 * ahtudta(:,:,:,1) + zweigh * ahtudta(:,:,:,2)
	615	ahtv(:,:,:) = zweighm1 * ahtvdta(:,:,:,1) + zweigh * ahtvdta(:,:,:,2)
	616	ahtw(:,:,:) = zweighm1 * ahtwdta(:,:,:,1) + zweigh * ahtwdta(:,:,:,2)
	617	# if defined key_trcldf_eiv
	618	aeiu(:,:,:) = zweighm1 * aeiudta(:,:,:,1) + zweigh * aeiudta(:,:,:,2)
	619	aeiv(:,:,:) = zweighm1 * aeivdta(:,:,:,1) + zweigh * aeivdta(:,:,:,2)
	620	aeiw(:,:,:) = zweighm1 * aeiwdta(:,:,:,1) + zweigh * aeiwdta(:,:,:,2)
	621	# endif
	622
[446]	623	#endif
[495]	624
[325]	625	#if defined key_trcbbl_dif \|\| defined key_trcbbl_adv
[495]	626	bblx(:,:) = zweighm1 * bblxdta(:,:,1) + zweigh * bblxdta(:,:,2)
	627	bbly(:,:) = zweighm1 * bblydta(:,:,1) + zweigh * bblydta(:,:,2)
[325]	628	#endif
	629	!
	630	! keep needed fluxes
	631	!
	632	#if defined key_flx_bulk_monthly \|\| defined key_flx_bulk_daily
	633	vatm(:,:) = flx(:,:,jpwind)
	634	#endif
	635	freeze(:,:) = flx(:,:,jpice)
[495]	636	emp(:,:) = flx(:,:,jpemp)
	637	emps(:,:) = emp(:,:)
	638	qsr(:,:) = flx(:,:,jpqsr)
[325]	639	!
	640	! other interpolation
	641	!
	642	ELSE
	643
	644	WRITE (numout,*) ' this kind of interpolation don t EXIST'
	645	WRITE (numout,*) ' at the moment. we STOP '
	646	STOP 'dtadyn'
	647
	648	END IF
	649
	650	END IF
	651	!
	652	! lb in any case, we need rhop
	653	!
	654	CALL eos( tn, sn, rhd, rhop )
	655
[495]	656	#if ! defined key_off_degrad && defined key_traldf_c2d
[446]	657	! In case of 2D varying coefficients, we need aeiv and aeiu
	658	IF( lk_traldf_eiv ) CALL ldf_eiv( kt ) ! eddy induced velocity coefficient
	659	#endif
	660
[325]	661	END SUBROUTINE dta_dyn
	662
	663	SUBROUTINE dynrea( kt, kenr )
	664	!!----------------------------------------------------------------------
	665	!! * ROUTINE dynrea *
	666	!!
	667	!! ** Purpose : READ dynamics fiels from OPA9 netcdf output
	668	!!
	669	!! ** Method : READ the kenr records of DATA and store in
	670	!! in udta(...,2), ....
	671	!!
	672	!! ** History : additions : M. Levy et M. Benjelloul jan 2001
	673	!! (netcdf FORMAT)
	674	!! 05-03 (O. Aumont and A. El Moussaoui) F90
[495]	675	!! 06-07 : (C. Ethe) use of iom module
[325]	676	!!----------------------------------------------------------------------
	677	!! * Modules used
[495]	678	USE iom
[325]	679
	680	!! * Arguments
	681	INTEGER, INTENT( in ) :: kt, kenr ! time index
	682	!! * Local declarations
[495]	683	INTEGER :: ji, jj, jk, jkenr
[325]	684
	685	REAL(wp), DIMENSION(jpi,jpj,jpk) :: &
[495]	686	zu, zv, zw, zt, zs, zavt , & ! 3-D dynamical fields
	687	zhdiv ! horizontal divergence
[325]	688
	689	REAL(wp), DIMENSION(jpi,jpj) :: &
[495]	690	zemp, zqsr, zmld, zice, zwspd
[325]	691	#if defined key_trcbbl_dif \|\| defined key_trcbbl_adv
	692	REAL(wp), DIMENSION(jpi,jpj) :: &
	693	zbblx, zbbly
	694	#endif
	695
[495]	696	#if ! defined key_off_degrad
	697
	698	# if defined key_traldf_c2d
	699	REAL(wp), DIMENSION(jpi,jpj) :: &
	700	zahtw
	701	# if defined key_trcldf_eiv
	702	REAL(wp), DIMENSION(jpi,jpj) :: &
	703	zaeiw
	704	# endif
	705	# endif
	706
	707	#else
	708
	709	REAL(wp), DIMENSION(jpi,jpj,jpk) :: &
	710	zahtu, zahtv, zahtw ! Lateral diffusivity
	711	# if defined key_trcldf_eiv
	712	REAL(wp), DIMENSION(jpi,jpj,jpk) :: &
	713	zaeiu, zaeiv, zaeiw ! G&M coefficient
	714	# endif
	715
	716	#endif
	717
	718	# if defined key_diaeiv
	719	!! GM Velocity : to be used latter
	720	REAL(wp), DIMENSION(jpi,jpj,jpk) :: &
	721	zeivu, zeivv, zeivw
	722	# endif
	723
[325]	724	CHARACTER(len=45) :: &
	725	clname_t = 'dyna_grid_T.nc', &
	726	clname_u = 'dyna_grid_U.nc', &
	727	clname_v = 'dyna_grid_V.nc', &
[495]	728	clname_w = 'dyna_grid_W.nc'
[325]	729	!
	730	! 0. Initialization
	731	! cas d'un fichier non periodique : on utilise deux fois le premier et
	732	! le dernier champ temporel
	733
	734	jkenr = kenr
	735
	736	IF(lwp) THEN
	737	WRITE(numout,*)
	738	WRITE(numout,*) 'Dynrea : reading dynamical fields, kenr = ', jkenr
	739	WRITE(numout,*) ' ~~~~~~~'
[495]	740	#if defined key_off_degrad
	741	WRITE(numout,*) ' Degraded fields'
	742	#endif
[325]	743	WRITE(numout,*)
	744	ENDIF
	745
	746
	747	IF( kt == nit000 .AND. nlecoff == 0 ) THEN
	748
	749	nlecoff = 1
	750
[495]	751	CALL iom_open ( clname_t, numfl_t )
	752	CALL iom_open ( clname_u, numfl_u )
	753	CALL iom_open ( clname_v, numfl_v )
	754	CALL iom_open ( clname_w, numfl_w )
[325]	755
	756	ENDIF
	757
[495]	758	! file grid-T
	759	!---------------
	760	CALL iom_get ( numfl_t, jpdom_data, 'votemper', zt (:,:,:), jkenr )
	761	CALL iom_get ( numfl_t, jpdom_data, 'vosaline', zs (:,:,:), jkenr )
	762	CALL iom_get ( numfl_t, jpdom_data, 'somixhgt', zmld (:,: ), jkenr )
[723]	763	CALL iom_get ( numfl_t, jpdom_data, 'sowaflcd', zemp (:,: ), jkenr )
[495]	764	CALL iom_get ( numfl_t, jpdom_data, 'soshfldo', zqsr (:,: ), jkenr )
	765	CALL iom_get ( numfl_t, jpdom_data, 'soicecov', zice (:,: ), jkenr )
	766	CALL iom_get ( numfl_t, jpdom_data, 'sowindsp', zwspd(:,: ), jkenr )
[325]	767
[495]	768	! file grid-U
	769	!---------------
	770	CALL iom_get ( numfl_u, jpdom_data, 'vozocrtx', zu (:,:,:), jkenr )
[325]	771	#if defined key_trcbbl_dif \|\| defined key_trcbbl_adv
[495]	772	CALL iom_get ( numfl_u, jpdom_data, 'sobblcox', zbblx(:,: ), jkenr )
[325]	773	#endif
	774
[495]	775	#if defined key_diaeiv
	776	!! GM Velocity : to be used latter
	777	CALL iom_get ( numfl_u, jpdom_data, 'vozoeivu', zeivu(:,:,:), jkenr )
[446]	778	#endif
[325]	779
[495]	780	# if defined key_off_degrad
	781	CALL iom_get ( numfl_u, jpdom_data, 'vozoahtu', zahtu(:,:,:), jkenr )
	782	# if defined key_trcldf_eiv
	783	CALL iom_get ( numfl_u, jpdom_data, 'vozoaeiu', zaeiu(:,:,:), jkenr )
	784	# endif
	785	#endif
[325]	786
[495]	787	! file grid-V
	788	!---------------
	789	CALL iom_get ( numfl_v, jpdom_data, 'vomecrty', zv (:,:,:), jkenr )
[325]	790	#if defined key_trcbbl_dif \|\| defined key_trcbbl_adv
[495]	791	CALL iom_get ( numfl_v, jpdom_data, 'sobblcoy', zbbly(:,: ), jkenr )
[325]	792	#endif
	793
[495]	794	#if defined key_diaeiv
	795	!! GM Velocity : to be used latter
	796	CALL iom_get ( numfl_v, jpdom_data, 'vomeeivv', zeivv(:,:,:), jkenr )
[446]	797	#endif
	798
[495]	799	#if defined key_off_degrad
	800	CALL iom_get ( numfl_v, jpdom_data, 'vomeahtv', zahtv(:,:,:), jkenr )
	801	# if defined key_trcldf_eiv
	802	CALL iom_get ( numfl_v, jpdom_data, 'vomeaeiv', zaeiv(:,:,:), jkenr )
	803	# endif
[446]	804	#endif
[325]	805
[495]	806	! file grid-W
	807	!---------------
	808	!! CALL iom_get ( numfl_w, jpdom_data, 'vovecrtz', zw (:,:,:), jkenr )
	809	# if defined key_zdfddm
	810	CALL iom_get ( numfl_w, jpdom_data, 'voddmavs', zavt (:,:,:), jkenr )
[325]	811	#else
[495]	812	CALL iom_get ( numfl_w, jpdom_data, 'votkeavt', zavt (:,:,:), jkenr )
	813	#endif
[325]	814
[495]	815	# if defined key_diaeiv
	816	!! GM Velocity : to be used latter
	817	CALL iom_get ( numfl_w, jpdom_data, 'voveeivw', zeivw(:,:,:), jkenr )
	818	#endif
[446]	819
[495]	820	#if ! defined key_off_degrad
	821	# if defined key_traldf_c2d
	822	CALL iom_get ( numfl_w, jpdom_data, 'soleahtw', zahtw (:,: ), jkenr )
[612]	823	# if defined key_trcldf_eiv
[495]	824	CALL iom_get ( numfl_w, jpdom_data, 'soleaeiw', zaeiw (:,: ), jkenr )
	825	# endif
	826	# endif
	827	#else
	828	!! degradation-integration
	829	CALL iom_get ( numfl_w, jpdom_data, 'voveahtw', zahtw(:,:,:), jkenr )
	830	# if defined key_trcldf_eiv
	831	CALL iom_get ( numfl_w, jpdom_data, 'voveaeiw', zaeiw(:,:,:), jkenr )
	832	# endif
[446]	833	#endif
	834
[495]	835	udta(:,:,:,2) = zu(:,:,:) * umask(:,:,:)
	836	vdta(:,:,:,2) = zv(:,:,:) * vmask(:,:,:)
	837	!! wdta(:,:,:,2) = zw(:,:,:) * tmask(:,:,:)
[325]	838
	839
[495]	840	! Computation of vertical velocity using horizontal divergence
	841	zhdiv(:,:,:) = 0.
	842	DO jk = 1, jpkm1
	843	DO jj = 2, jpjm1
	844	DO ji = fs_2, fs_jpim1 ! vector opt.
[612]	845	#if defined key_zco
	846	zhdiv(ji,jj,jk) = ( e2u(ji,jj) * udta(ji,jj,jk,2) - e2u(ji-1,jj ) * udta(ji-1,jj ,jk,2) &
	847	& + e1v(ji,jj) * vdta(ji,jj,jk,2) - e1v(ji ,jj-1) * vdta(ji ,jj-1,jk,2) ) &
[495]	848	& / ( e1t(ji,jj) * e2t(ji,jj) )
[612]	849	#else
	850	zhdiv(ji,jj,jk) = &
	851	( e2u(ji,jj)fse3u(ji,jj,jk)udta(ji,jj,jk,2) - e2u(ji-1,jj)fse3u(ji-1,jj,jk)udta(ji-1,jj,jk,2) &
	852	+ e1v(ji,jj)fse3v(ji,jj,jk)vdta(ji,jj,jk,2) - e1v(ji,jj-1)fse3v(ji,jj-1,jk)vdta(ji,jj-1,jk,2) ) &
	853	/ ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
	854	#endif
[495]	855	END DO
[612]	856	END DO
	857	ENDDO
	858
	859	! Lateral boundary conditions on hdiv
	860	CALL lbc_lnk( zhdiv, 'T', 1. )
	861
	862
	863	! computation of vertical velocity from the bottom
[495]	864	zw(:,:,jpk) = 0.
	865	DO jk = jpkm1, 1, -1
	866	zw(:,:,jk) = zw(:,:,jk+1) - fse3t(:,:,jk) * zhdiv(:,:,jk)
	867	END DO
[723]	868
[495]	869	wdta(:,:,:,2) = zw(:,:,:) * tmask(:,:,:)
[723]	870	#if defined key_trc_diatrd
	871	hdivdta(:,:,:,2) = zhdiv(:,:,:) * tmask(:,:,:)
	872	#endif
[446]	873
[495]	874	tdta(:,:,:,2) = zt(:,:,:) * tmask(:,:,:)
	875	sdta(:,:,:,2) = zs(:,:,:) * tmask(:,:,:)
	876	avtdta(:,:,:,2) = zavt(:,:,:) * tmask(:,:,:)
	877	#if ! defined key_off_degrad && defined key_traldf_c2d
	878	ahtwdta(:,:,2) = zahtw(:,:) * tmask(:,:,1)
[612]	879	#if defined key_trcldf_eiv
[495]	880	aeiwdta(:,:,2) = zaeiw(:,:) * tmask(:,:,1)
[446]	881	#endif
	882	#endif
[495]	883
	884	#if defined key_off_degrad
	885	ahtudta(:,:,:,2) = zahtu(:,:,:) * umask(:,:,:)
	886	ahtvdta(:,:,:,2) = zahtv(:,:,:) * vmask(:,:,:)
	887	ahtwdta(:,:,:,2) = zahtw(:,:,:) * tmask(:,:,:)
	888	# if defined key_trcldf_eiv
	889	aeiudta(:,:,:,2) = zaeiu(:,:,:) * umask(:,:,:)
	890	aeivdta(:,:,:,2) = zaeiv(:,:,:) * vmask(:,:,:)
	891	aeiwdta(:,:,:,2) = zaeiw(:,:,:) * tmask(:,:,:)
	892	# endif
[325]	893	#endif
	894
	895	!
	896	! flux :
	897	!
[495]	898	flxdta(:,:,jpwind,2) = zwspd(:,:) * tmask(:,:,1)
	899	flxdta(:,:,jpice,2) = MIN( 1., zice(:,:) ) * tmask(:,:,1)
	900	flxdta(:,:,jpemp,2) = zemp(:,:) * tmask(:,:,1)
	901	flxdta(:,:,jpqsr,2) = zqsr(:,:) * tmask(:,:,1)
	902	zmxldta(:,:,2) = zmld(:,:) * tmask(:,:,1)
	903
[325]	904	#if defined key_trcbbl_dif \|\| defined key_trcbbl_adv
[495]	905	bblxdta(:,:,2) = MAX( 0., zbblx(:,:) )
	906	bblydta(:,:,2) = MAX( 0., zbbly(:,:) )
[325]	907
[495]	908	WHERE( bblxdta(:,:,2) > 2. ) bblxdta(:,:,2) = 0.
	909	WHERE( bblydta(:,:,2) > 2. ) bblydta(:,:,2) = 0.
	910
[325]	911	#endif
	912
[495]	913	IF( kt == nitend ) THEN
	914	CALL iom_close ( numfl_t )
	915	CALL iom_close ( numfl_u )
	916	CALL iom_close ( numfl_v )
	917	CALL iom_close ( numfl_w )
	918	ENDIF
	919
[325]	920	END SUBROUTINE dynrea
	921
	922
	923
	924	END MODULE dtadyn

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

Download in other formats: