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 branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/OFF_SRC – NEMO

Context Navigation

source: branches/2015/dev_r5204_CNRS_PISCES_dcy/NEMOGCM/NEMO/OFF_SRC/dtadyn.F90 @ 5225

Last change on this file since 5225 was 5210, checked in by cetlod, 9 years ago
dev_r5204_CNRS_PISCES_dcy:minor corrections for offline
Property svn:keywords set to `Id`
File size: 31.4 KB

Rev	Line
[325]	1	MODULE dtadyn
	2	!!======================================================================
	3	!! * MODULE dtadyn *
[2528]	4	!! Off-line : interpolation of the physical fields
	5	!!======================================================================
	6	!! History : OPA ! 1992-01 (M. Imbard) Original code
	7	!! 8.0 ! 1998-04 (L.Bopp MA Foujols) slopes for isopyc.
	8	!! - ! 1998-05 (L. Bopp) read output of coupled run
	9	!! 8.2 ! 2001-01 (M. Levy et M. Benjelloul) add netcdf FORMAT
	10	!! NEMO 1.0 ! 2005-03 (O. Aumont and A. El Moussaoui) F90
	11	!! - ! 2005-12 (C. Ethe) Adapted for DEGINT
	12	!! 3.0 ! 2007-06 (C. Ethe) use of iom module
	13	!! 3.3 ! 2010-11 (C. Ethe) Full reorganization of the off-line: phasing with the on-line
[3294]	14	!! 3.4 ! 2011-05 (C. Ethe) Use of fldread
[2528]	15	!!----------------------------------------------------------------------
[325]	16
	17	!!----------------------------------------------------------------------
[3294]	18	!! dta_dyn_init : initialization, namelist read, and SAVEs control
[325]	19	!! dta_dyn : Interpolation of the fields
	20	!!----------------------------------------------------------------------
	21	USE oce ! ocean dynamics and tracers variables
[2528]	22	USE c1d ! 1D configuration: lk_c1d
	23	USE dom_oce ! ocean domain: variables
	24	USE zdf_oce ! ocean vertical physics: variables
	25	USE sbc_oce ! surface module: variables
[3294]	26	USE trc_oce ! share ocean/biogeo variables
[325]	27	USE phycst ! physical constants
[2528]	28	USE trabbl ! active tracer: bottom boundary layer
	29	USE ldfslp ! lateral diffusion: iso-neutral slopes
	30	USE ldfeiv ! eddy induced velocity coef.
[446]	31	USE ldftra_oce ! ocean tracer lateral physics
[2528]	32	USE zdfmxl ! vertical physics: mixed layer depth
	33	USE eosbn2 ! equation of state - Brunt Vaisala frequency
[325]	34	USE lbclnk ! ocean lateral boundary conditions (or mpp link)
[2528]	35	USE zpshde ! z-coord. with partial steps: horizontal derivatives
	36	USE in_out_manager ! I/O manager
	37	USE iom ! I/O library
[325]	38	USE lib_mpp ! distributed memory computing library
[3294]	39	USE prtctl ! print control
	40	USE fldread ! read input fields
	41	USE timing ! Timing
[325]	42
	43	IMPLICIT NONE
	44	PRIVATE
	45
[2528]	46	PUBLIC dta_dyn_init ! called by opa.F90
	47	PUBLIC dta_dyn ! called by step.F90
[325]	48
[4147]	49	CHARACTER(len=100) :: cn_dir !: Root directory for location of ssr files
	50	LOGICAL :: ln_dynwzv !: vertical velocity read in a file (T) or computed from u/v (F)
	51	LOGICAL :: ln_dynbbl !: bbl coef read in a file (T) or computed (F)
[4570]	52	LOGICAL :: ln_degrad !: degradation option enabled or not
	53	LOGICAL :: ln_dynrnf !: read runoff data in file (T) or set to zero (F)
[325]	54
[5210]	55	INTEGER , PARAMETER :: jpfld = 21 ! maximum number of fields to read
[3294]	56	INTEGER , SAVE :: jf_tem ! index of temperature
	57	INTEGER , SAVE :: jf_sal ! index of salinity
	58	INTEGER , SAVE :: jf_uwd ! index of u-wind
	59	INTEGER , SAVE :: jf_vwd ! index of v-wind
	60	INTEGER , SAVE :: jf_wwd ! index of w-wind
	61	INTEGER , SAVE :: jf_avt ! index of Kz
	62	INTEGER , SAVE :: jf_mld ! index of mixed layer deptht
	63	INTEGER , SAVE :: jf_emp ! index of water flux
	64	INTEGER , SAVE :: jf_qsr ! index of solar radiation
	65	INTEGER , SAVE :: jf_wnd ! index of wind speed
	66	INTEGER , SAVE :: jf_ice ! index of sea ice cover
[4570]	67	INTEGER , SAVE :: jf_rnf ! index of river runoff
[3294]	68	INTEGER , SAVE :: jf_ubl ! index of u-bbl coef
	69	INTEGER , SAVE :: jf_vbl ! index of v-bbl coef
	70	INTEGER , SAVE :: jf_ahu ! index of u-diffusivity coef
	71	INTEGER , SAVE :: jf_ahv ! index of v-diffusivity coef
	72	INTEGER , SAVE :: jf_ahw ! index of w-diffusivity coef
	73	INTEGER , SAVE :: jf_eiu ! index of u-eiv
	74	INTEGER , SAVE :: jf_eiv ! index of v-eiv
	75	INTEGER , SAVE :: jf_eiw ! index of w-eiv
[4148]	76	INTEGER , SAVE :: jf_fmf ! index of downward salt flux
[325]	77
[3294]	78	TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_dyn ! structure of input fields (file informations, fields read)
	79	! !
	80	REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: wdta ! vertical velocity at 2 time step
	81	REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,: ) :: wnow ! vertical velocity at 2 time step
	82	REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: uslpdta ! zonal isopycnal slopes
	83	REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: vslpdta ! meridional isopycnal slopes
	84	REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: wslpidta ! zonal diapycnal slopes
	85	REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: wslpjdta ! meridional diapycnal slopes
	86	REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: uslpnow ! zonal isopycnal slopes
	87	REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: vslpnow ! meridional isopycnal slopes
	88	REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wslpinow ! zonal diapycnal slopes
	89	REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: wslpjnow ! meridional diapycnal slopes
[1735]	90
[3294]	91	INTEGER :: nrecprev_tem , nrecprev_uwd
[325]	92
	93	!! * Substitutions
	94	# include "domzgr_substitute.h90"
	95	# include "vectopt_loop_substitute.h90"
[343]	96	!!----------------------------------------------------------------------
[2528]	97	!! NEMO/OFF 3.3 , NEMO Consortium (2010)
	98	!! $Id$
	99	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[343]	100	!!----------------------------------------------------------------------
[325]	101	CONTAINS
	102
[1501]	103	SUBROUTINE dta_dyn( kt )
[325]	104	!!----------------------------------------------------------------------
	105	!! * ROUTINE dta_dyn *
	106	!!
[3294]	107	!! ** Purpose : Prepares dynamics and physics fields from a NEMO run
	108	!! for an off-line simulation of passive tracers
[325]	109	!!
[3294]	110	!! ** Method : calculates the position of data
	111	!! - computes slopes if needed
	112	!! - interpolates data if needed
[2528]	113	!!----------------------------------------------------------------------
[3294]	114	!
	115	USE oce, ONLY: zts => tsa
	116	USE oce, ONLY: zuslp => ua , zvslp => va
	117	USE oce, ONLY: zwslpi => rotb , zwslpj => rotn
	118	USE oce, ONLY: zu => ub , zv => vb, zw => hdivb
	119	!
[2528]	120	INTEGER, INTENT(in) :: kt ! ocean time-step index
[3294]	121	!
	122	INTEGER :: ji, jj ! dummy loop indices
	123	INTEGER :: isecsbc ! number of seconds between Jan. 1st 00h of nit000 year and the middle of time step
	124	REAL(wp) :: ztinta ! ratio applied to after records when doing time interpolation
	125	REAL(wp) :: ztintb ! ratio applied to before records when doing time interpolation
	126	INTEGER :: iswap_tem, iswap_uwd !
[325]	127	!!----------------------------------------------------------------------
[3294]	128
	129	!
	130	IF( nn_timing == 1 ) CALL timing_start( 'dta_dyn')
	131	!
	132	isecsbc = nsec_year + nsec1jan000
	133	!
	134	IF( kt == nit000 ) THEN
	135	nrecprev_tem = 0
	136	nrecprev_uwd = 0
[1501]	137	!
[3294]	138	CALL fld_read( kt, 1, sf_dyn ) !== read data at kt time step ==!
[2528]	139	!
[3294]	140	IF( lk_ldfslp .AND. .NOT.lk_c1d .AND. sf_dyn(jf_tem)%ln_tint ) THEN ! Computes slopes (here avt is used as workspace)
	141	zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:,1) * tmask(:,:,:) ! temperature
	142	zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:,1) * tmask(:,:,:) ! salinity
	143	avt(:,:,:) = sf_dyn(jf_avt)%fdta(:,:,:,1) * tmask(:,:,:) ! vertical diffusive coef.
	144	CALL dta_dyn_slp( kt, zts, zuslp, zvslp, zwslpi, zwslpj )
	145	uslpdta (:,:,:,1) = zuslp (:,:,:)
	146	vslpdta (:,:,:,1) = zvslp (:,:,:)
	147	wslpidta(:,:,:,1) = zwslpi(:,:,:)
	148	wslpjdta(:,:,:,1) = zwslpj(:,:,:)
	149	ENDIF
	150	IF( ln_dynwzv .AND. sf_dyn(jf_uwd)%ln_tint ) THEN ! compute vertical velocity from u/v
	151	zu(:,:,:) = sf_dyn(jf_uwd)%fdta(:,:,:,1)
	152	zv(:,:,:) = sf_dyn(jf_vwd)%fdta(:,:,:,1)
	153	CALL dta_dyn_wzv( zu, zv, zw )
	154	wdta(:,:,:,1) = zw(:,:,:) * tmask(:,:,:)
	155	ENDIF
	156	ELSE
	157	nrecprev_tem = sf_dyn(jf_tem)%nrec_a(2)
	158	nrecprev_uwd = sf_dyn(jf_uwd)%nrec_a(2)
[2528]	159	!
[3294]	160	CALL fld_read( kt, 1, sf_dyn ) !== read data at kt time step ==!
[1501]	161	!
[325]	162	ENDIF
[3294]	163	!
	164	IF( lk_ldfslp .AND. .NOT.lk_c1d ) THEN ! Computes slopes (here avt is used as workspace)
	165	iswap_tem = 0
	166	IF( kt /= nit000 .AND. ( sf_dyn(jf_tem)%nrec_a(2) - nrecprev_tem ) /= 0 ) iswap_tem = 1
	167	IF( ( isecsbc > sf_dyn(jf_tem)%nrec_b(2) .AND. iswap_tem == 1 ) .OR. kt == nit000 ) THEN ! read/update the after data
[3827]	168	IF(lwp) WRITE(numout,*) ' Compute new slopes at kt = ', kt
[3294]	169	IF( sf_dyn(jf_tem)%ln_tint ) THEN ! time interpolation of data
	170	IF( kt /= nit000 ) THEN
	171	uslpdta (:,:,:,1) = uslpdta (:,:,:,2) ! swap the data
	172	vslpdta (:,:,:,1) = vslpdta (:,:,:,2)
	173	wslpidta(:,:,:,1) = wslpidta(:,:,:,2)
	174	wslpjdta(:,:,:,1) = wslpjdta(:,:,:,2)
	175	ENDIF
	176	!
	177	zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fdta(:,:,:,2) * tmask(:,:,:) ! temperature
	178	zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fdta(:,:,:,2) * tmask(:,:,:) ! salinity
	179	avt(:,:,:) = sf_dyn(jf_avt)%fdta(:,:,:,2) * tmask(:,:,:) ! vertical diffusive coef.
	180	CALL dta_dyn_slp( kt, zts, zuslp, zvslp, zwslpi, zwslpj )
	181	!
	182	uslpdta (:,:,:,2) = zuslp (:,:,:)
	183	vslpdta (:,:,:,2) = zvslp (:,:,:)
	184	wslpidta(:,:,:,2) = zwslpi(:,:,:)
	185	wslpjdta(:,:,:,2) = zwslpj(:,:,:)
	186	ELSE
	187	zts(:,:,:,jp_tem) = sf_dyn(jf_tem)%fnow(:,:,:) * tmask(:,:,:)
	188	zts(:,:,:,jp_sal) = sf_dyn(jf_sal)%fnow(:,:,:) * tmask(:,:,:)
	189	avt(:,:,:) = sf_dyn(jf_avt)%fnow(:,:,:) * tmask(:,:,:)
	190	CALL dta_dyn_slp( kt, zts, zuslp, zvslp, zwslpi, zwslpj )
	191	uslpnow (:,:,:) = zuslp (:,:,:)
	192	vslpnow (:,:,:) = zvslp (:,:,:)
	193	wslpinow(:,:,:) = zwslpi(:,:,:)
	194	wslpjnow(:,:,:) = zwslpj(:,:,:)
	195	ENDIF
	196	ENDIF
	197	IF( sf_dyn(jf_tem)%ln_tint ) THEN
	198	ztinta = REAL( isecsbc - sf_dyn(jf_tem)%nrec_b(2), wp ) &
	199	& / REAL( sf_dyn(jf_tem)%nrec_a(2) - sf_dyn(jf_tem)%nrec_b(2), wp )
	200	ztintb = 1. - ztinta
	201	uslp (:,:,:) = ztintb * uslpdta (:,:,:,1) + ztinta * uslpdta (:,:,:,2)
	202	vslp (:,:,:) = ztintb * vslpdta (:,:,:,1) + ztinta * vslpdta (:,:,:,2)
	203	wslpi(:,:,:) = ztintb * wslpidta(:,:,:,1) + ztinta * wslpidta(:,:,:,2)
	204	wslpj(:,:,:) = ztintb * wslpjdta(:,:,:,1) + ztinta * wslpjdta(:,:,:,2)
	205	ELSE
	206	uslp (:,:,:) = uslpnow (:,:,:)
	207	vslp (:,:,:) = vslpnow (:,:,:)
	208	wslpi(:,:,:) = wslpinow(:,:,:)
	209	wslpj(:,:,:) = wslpjnow(:,:,:)
	210	ENDIF
	211	ENDIF
[325]	212	!
[3294]	213	IF( ln_dynwzv ) THEN ! compute vertical velocity from u/v
	214	iswap_uwd = 0
	215	IF( kt /= nit000 .AND. ( sf_dyn(jf_uwd)%nrec_a(2) - nrecprev_uwd ) /= 0 ) iswap_uwd = 1
	216	IF( ( isecsbc > sf_dyn(jf_uwd)%nrec_b(2) .AND. iswap_uwd == 1 ) .OR. kt == nit000 ) THEN ! read/update the after data
[3827]	217	IF(lwp) WRITE(numout,*) ' Compute new vertical velocity at kt = ', kt
	218	IF(lwp) WRITE(numout,*)
[3294]	219	IF( sf_dyn(jf_uwd)%ln_tint ) THEN ! time interpolation of data
	220	IF( kt /= nit000 ) THEN
	221	wdta(:,:,:,1) = wdta(:,:,:,2) ! swap the data for initialisation
	222	ENDIF
	223	zu(:,:,:) = sf_dyn(jf_uwd)%fdta(:,:,:,2)
	224	zv(:,:,:) = sf_dyn(jf_vwd)%fdta(:,:,:,2)
	225	CALL dta_dyn_wzv( zu, zv, zw )
	226	wdta(:,:,:,2) = zw(:,:,:) * tmask(:,:,:)
	227	ELSE
	228	zu(:,:,:) = sf_dyn(jf_uwd)%fnow(:,:,:)
	229	zv(:,:,:) = sf_dyn(jf_vwd)%fnow(:,:,:)
	230	CALL dta_dyn_wzv( zu, zv, zw )
	231	wnow(:,:,:) = zw(:,:,:) * tmask(:,:,:)
[1501]	232	ENDIF
	233	ENDIF
[3294]	234	IF( sf_dyn(jf_uwd)%ln_tint ) THEN
	235	ztinta = REAL( isecsbc - sf_dyn(jf_uwd)%nrec_b(2), wp ) &
	236	& / REAL( sf_dyn(jf_uwd)%nrec_a(2) - sf_dyn(jf_uwd)%nrec_b(2), wp )
	237	ztintb = 1. - ztinta
	238	wn(:,:,:) = ztintb * wdta(:,:,:,1) + ztinta * wdta(:,:,:,2)
	239	ELSE
	240	wn(:,:,:) = wnow(:,:,:)
	241	ENDIF
	242	ENDIF
[325]	243	!
[3680]	244	tsn(:,:,:,jp_tem) = sf_dyn(jf_tem)%fnow(:,:,:) * tmask(:,:,:) ! temperature
	245	tsn(:,:,:,jp_sal) = sf_dyn(jf_sal)%fnow(:,:,:) * tmask(:,:,:) ! salinity
[2528]	246	!
[5131]	247	!
	248	CALL eos ( tsn, rhd, rhop, gdept_0(:,:,:) ) ! In any case, we need rhop
	249	CALL eos_rab( tsn, rab_n ) ! now local thermal/haline expension ratio at T-points
	250	CALL bn2 ( tsn, rab_n, rn2 ) ! before Brunt-Vaisala frequency need for zdfmxl
	251
	252	rn2b(:,:,:) = rn2(:,:,:) ! need for zdfmxl
[3294]	253	CALL zdf_mxl( kt ) ! In any case, we need mxl
[2528]	254	!
[3680]	255	avt(:,:,:) = sf_dyn(jf_avt)%fnow(:,:,:) * tmask(:,:,:) ! vertical diffusive coefficient
	256	un (:,:,:) = sf_dyn(jf_uwd)%fnow(:,:,:) * umask(:,:,:) ! u-velocity
	257	vn (:,:,:) = sf_dyn(jf_vwd)%fnow(:,:,:) * vmask(:,:,:) ! v-velocity
[3625]	258	IF( .NOT.ln_dynwzv ) & ! w-velocity read in file
[3294]	259	wn (:,:,:) = sf_dyn(jf_wwd)%fnow(:,:,:) * tmask(:,:,:)
	260	hmld(:,:) = sf_dyn(jf_mld)%fnow(:,:,1) * tmask(:,:,1) ! mixed layer depht
	261	wndm(:,:) = sf_dyn(jf_wnd)%fnow(:,:,1) * tmask(:,:,1) ! wind speed - needed for gas exchange
	262	emp (:,:) = sf_dyn(jf_emp)%fnow(:,:,1) * tmask(:,:,1) ! E-P
[4148]	263	fmmflx(:,:) = sf_dyn(jf_fmf)%fnow(:,:,1) * tmask(:,:,1) ! downward salt flux (v3.5+)
[3625]	264	fr_i(:,:) = sf_dyn(jf_ice)%fnow(:,:,1) * tmask(:,:,1) ! Sea-ice fraction
[3294]	265	qsr (:,:) = sf_dyn(jf_qsr)%fnow(:,:,1) * tmask(:,:,1) ! solar radiation
[5210]	266	IF( ln_dm2dc ) qsr_mean(:,:) = qsr(:,:) ! daily mean solar radiation
[5209]	267	IF( ln_dynrnf ) &
[4570]	268	rnf (:,:) = sf_dyn(jf_rnf)%fnow(:,:,1) * tmask(:,:,1) ! river runoffs
[3294]	269
	270	! ! bbl diffusive coef
	271	#if defined key_trabbl && ! defined key_c1d
	272	IF( ln_dynbbl ) THEN ! read in a file
	273	ahu_bbl(:,:) = sf_dyn(jf_ubl)%fnow(:,:,1) * umask(:,:,1)
	274	ahv_bbl(:,:) = sf_dyn(jf_vbl)%fnow(:,:,1) * vmask(:,:,1)
	275	ELSE ! Compute bbl coefficients if needed
[2528]	276	tsb(:,:,:,:) = tsn(:,:,:,:)
[3294]	277	CALL bbl( kt, nit000, 'TRC')
[2528]	278	END IF
[3294]	279	#endif
	280	#if ( ! defined key_degrad && defined key_traldf_c2d && defined key_traldf_eiv ) && ! defined key_c1d
	281	aeiw(:,:) = sf_dyn(jf_eiw)%fnow(:,:,1) * tmask(:,:,1) ! w-eiv
	282	! ! Computes the horizontal values from the vertical value
	283	DO jj = 2, jpjm1
	284	DO ji = fs_2, fs_jpim1 ! vector opt.
	285	aeiu(ji,jj) = .5 * ( aeiw(ji,jj) + aeiw(ji+1,jj ) ) ! Average the diffusive coefficient at u- v- points
	286	aeiv(ji,jj) = .5 * ( aeiw(ji,jj) + aeiw(ji ,jj+1) ) ! at u- v- points
	287	END DO
	288	END DO
	289	CALL lbc_lnk( aeiu, 'U', 1. ) ; CALL lbc_lnk( aeiv, 'V', 1. ) ! lateral boundary condition
	290	#endif
	291
	292	#if defined key_degrad && ! defined key_c1d
	293	! ! degrad option : diffusive and eiv coef are 3D
	294	ahtu(:,:,:) = sf_dyn(jf_ahu)%fnow(:,:,:) * umask(:,:,:)
	295	ahtv(:,:,:) = sf_dyn(jf_ahv)%fnow(:,:,:) * vmask(:,:,:)
	296	ahtw(:,:,:) = sf_dyn(jf_ahw)%fnow(:,:,:) * tmask(:,:,:)
	297	# if defined key_traldf_eiv
	298	aeiu(:,:,:) = sf_dyn(jf_eiu)%fnow(:,:,:) * umask(:,:,:)
	299	aeiv(:,:,:) = sf_dyn(jf_eiv)%fnow(:,:,:) * vmask(:,:,:)
	300	aeiw(:,:,:) = sf_dyn(jf_eiw)%fnow(:,:,:) * tmask(:,:,:)
	301	# endif
	302	#endif
[2762]	303	!
[3294]	304	IF(ln_ctl) THEN ! print control
[2528]	305	CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' tn - : ', mask1=tmask, ovlap=1, kdim=jpk )
	306	CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_sal), clinfo1=' sn - : ', mask1=tmask, ovlap=1, kdim=jpk )
[3294]	307	CALL prt_ctl(tab3d_1=un , clinfo1=' un - : ', mask1=umask, ovlap=1, kdim=jpk )
	308	CALL prt_ctl(tab3d_1=vn , clinfo1=' vn - : ', mask1=vmask, ovlap=1, kdim=jpk )
[2528]	309	CALL prt_ctl(tab3d_1=wn , clinfo1=' wn - : ', mask1=tmask, ovlap=1, kdim=jpk )
	310	CALL prt_ctl(tab3d_1=avt , clinfo1=' kz - : ', mask1=tmask, ovlap=1, kdim=jpk )
	311	CALL prt_ctl(tab2d_1=fr_i , clinfo1=' fr_i - : ', mask1=tmask, ovlap=1 )
	312	CALL prt_ctl(tab2d_1=hmld , clinfo1=' hmld - : ', mask1=tmask, ovlap=1 )
[4148]	313	CALL prt_ctl(tab2d_1=fmmflx , clinfo1=' fmmflx - : ', mask1=tmask, ovlap=1 )
[3680]	314	CALL prt_ctl(tab2d_1=emp , clinfo1=' emp - : ', mask1=tmask, ovlap=1 )
[2528]	315	CALL prt_ctl(tab2d_1=wndm , clinfo1=' wspd - : ', mask1=tmask, ovlap=1 )
	316	CALL prt_ctl(tab2d_1=qsr , clinfo1=' qsr - : ', mask1=tmask, ovlap=1 )
	317	ENDIF
	318	!
[3294]	319	IF( nn_timing == 1 ) CALL timing_stop( 'dta_dyn')
	320	!
[325]	321	END SUBROUTINE dta_dyn
	322
[2528]	323
[3294]	324	SUBROUTINE dta_dyn_init
[325]	325	!!----------------------------------------------------------------------
[3294]	326	!! * ROUTINE dta_dyn_init *
[325]	327	!!
[3294]	328	!! ** Purpose : Initialisation of the dynamical data
	329	!! ** Method : - read the data namdta_dyn namelist
	330	!!
	331	!! ** Action : - read parameters
[325]	332	!!----------------------------------------------------------------------
[3294]	333	INTEGER :: ierr, ierr0, ierr1, ierr2, ierr3 ! return error code
	334	INTEGER :: ifpr ! dummy loop indice
	335	INTEGER :: jfld ! dummy loop arguments
	336	INTEGER :: inum, idv, idimv ! local integer
[4147]	337	INTEGER :: ios ! Local integer output status for namelist read
[3294]	338	!!
	339	CHARACTER(len=100) :: cn_dir ! Root directory for location of core files
	340	TYPE(FLD_N), DIMENSION(jpfld) :: slf_d ! array of namelist informations on the fields to read
[5210]	341	TYPE(FLD_N) :: sn_tem, sn_sal, sn_mld, sn_emp, sn_ice, sn_qsr, sn_wnd, sn_rnf ! informations about the fields to be read
[3294]	342	TYPE(FLD_N) :: sn_uwd, sn_vwd, sn_wwd, sn_avt, sn_ubl, sn_vbl ! " "
[4148]	343	TYPE(FLD_N) :: sn_ahu, sn_ahv, sn_ahw, sn_eiu, sn_eiv, sn_eiw, sn_fmf ! " "
	344	!!----------------------------------------------------------------------
[2715]	345	!
[4570]	346	NAMELIST/namdta_dyn/cn_dir, ln_dynwzv, ln_dynbbl, ln_degrad, ln_dynrnf, &
[5210]	347	& sn_tem, sn_sal, sn_mld, sn_emp, sn_ice, sn_qsr, sn_wnd, sn_rnf, &
[3294]	348	& sn_uwd, sn_vwd, sn_wwd, sn_avt, sn_ubl, sn_vbl, &
[4148]	349	& sn_ahu, sn_ahv, sn_ahw, sn_eiu, sn_eiv, sn_eiw, sn_fmf
[4147]	350	!
	351	REWIND( numnam_ref ) ! Namelist namdta_dyn in reference namelist : Offline: init. of dynamical data
	352	READ ( numnam_ref, namdta_dyn, IOSTAT = ios, ERR = 901)
	353	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdta_dyn in reference namelist', lwp )
[3294]	354
[4147]	355	REWIND( numnam_cfg ) ! Namelist namdta_dyn in configuration namelist : Offline: init. of dynamical data
	356	READ ( numnam_cfg, namdta_dyn, IOSTAT = ios, ERR = 902 )
	357	902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namdta_dyn in configuration namelist', lwp )
[4624]	358	IF(lwm) WRITE ( numond, namdta_dyn )
[3294]	359	! ! store namelist information in an array
	360	! ! Control print
[325]	361	IF(lwp) THEN
	362	WRITE(numout,*)
[3294]	363	WRITE(numout,*) 'dta_dyn : offline dynamics '
	364	WRITE(numout,*) '~~~~~~~ '
	365	WRITE(numout,*) ' Namelist namdta_dyn'
	366	WRITE(numout,*) ' vertical velocity read from file (T) or computed (F) ln_dynwzv = ', ln_dynwzv
	367	WRITE(numout,*) ' bbl coef read from file (T) or computed (F) ln_dynbbl = ', ln_dynbbl
	368	WRITE(numout,*) ' degradation option enabled (T) or not (F) ln_degrad = ', ln_degrad
[4570]	369	WRITE(numout,*) ' river runoff option enabled (T) or not (F) ln_dynrnf = ', ln_dynrnf
[325]	370	WRITE(numout,*)
	371	ENDIF
[3294]	372	!
	373	IF( ln_degrad .AND. .NOT.lk_degrad ) THEN
	374	CALL ctl_warn( 'dta_dyn_init: degradation option requires key_degrad activated ; force ln_degrad to false' )
	375	ln_degrad = .FALSE.
[325]	376	ENDIF
[3294]	377	IF( ln_dynbbl .AND. ( .NOT.lk_trabbl .OR. lk_c1d ) ) THEN
	378	CALL ctl_warn( 'dta_dyn_init: bbl option requires key_trabbl activated ; force ln_dynbbl to false' )
	379	ln_dynbbl = .FALSE.
	380	ENDIF
[325]	381
[4148]	382	jf_tem = 1 ; jf_sal = 2 ; jf_mld = 3 ; jf_emp = 4 ; jf_fmf = 5 ; jf_ice = 6 ; jf_qsr = 7
[4570]	383	jf_wnd = 8 ; jf_uwd = 9 ; jf_vwd = 10 ; jf_wwd = 11 ; jf_avt = 12 ; jfld = jf_avt
[3294]	384	!
[3680]	385	slf_d(jf_tem) = sn_tem ; slf_d(jf_sal) = sn_sal ; slf_d(jf_mld) = sn_mld
[4148]	386	slf_d(jf_emp) = sn_emp ; slf_d(jf_fmf ) = sn_fmf ; slf_d(jf_ice) = sn_ice
[3680]	387	slf_d(jf_qsr) = sn_qsr ; slf_d(jf_wnd) = sn_wnd ; slf_d(jf_avt) = sn_avt
	388	slf_d(jf_uwd) = sn_uwd ; slf_d(jf_vwd) = sn_vwd ; slf_d(jf_wwd) = sn_wwd
[4570]	389
[3294]	390	!
[5209]	391	IF( ln_dynrnf ) THEN
[4570]	392	jf_rnf = jfld + 1 ; jfld = jf_rnf
	393	slf_d(jf_rnf) = sn_rnf
	394	ELSE
	395	rnf (:,:) = 0._wp
	396	ENDIF
	397
	398	!
[3294]	399	IF( .NOT.ln_degrad ) THEN ! no degrad option
	400	IF( lk_traldf_eiv .AND. ln_dynbbl ) THEN ! eiv & bbl
[4570]	401	jf_ubl = jfld + 1 ; jf_vbl = jfld + 2 ; jf_eiw = jfld + 3 ; jfld = jf_eiw
[3294]	402	slf_d(jf_ubl) = sn_ubl ; slf_d(jf_vbl) = sn_vbl ; slf_d(jf_eiw) = sn_eiw
	403	ENDIF
	404	IF( .NOT.lk_traldf_eiv .AND. ln_dynbbl ) THEN ! no eiv & bbl
[4570]	405	jf_ubl = jfld + 1 ; jf_vbl = jfld + 2 ; jfld = jf_vbl
[3294]	406	slf_d(jf_ubl) = sn_ubl ; slf_d(jf_vbl) = sn_vbl
	407	ENDIF
	408	IF( lk_traldf_eiv .AND. .NOT.ln_dynbbl ) THEN ! eiv & no bbl
[4570]	409	jf_eiw = jfld + 1 ; jfld = jf_eiw ; slf_d(jf_eiw) = sn_eiw
[3294]	410	ENDIF
[1501]	411	ELSE
[4570]	412	jf_ahu = jfld + 1 ; jf_ahv = jfld + 2 ; jf_ahw = jfld + 3 ; jfld = jf_ahw
[3294]	413	slf_d(jf_ahu) = sn_ahu ; slf_d(jf_ahv) = sn_ahv ; slf_d(jf_ahw) = sn_ahw
	414	IF( lk_traldf_eiv .AND. ln_dynbbl ) THEN ! eiv & bbl
[4570]	415	jf_ubl = jfld + 1 ; jf_vbl = jfld + 2 ;
	416	slf_d(jf_ubl) = sn_ubl ; slf_d(jf_vbl) = sn_vbl
	417	jf_eiu = jfld + 3 ; jf_eiv = jfld + 4 ; jf_eiw = jfld + 5 ; jfld = jf_eiw
[3294]	418	slf_d(jf_eiu) = sn_eiu ; slf_d(jf_eiv) = sn_eiv ; slf_d(jf_eiw) = sn_eiw
	419	ENDIF
	420	IF( .NOT.lk_traldf_eiv .AND. ln_dynbbl ) THEN ! no eiv & bbl
[4570]	421	jf_ubl = jfld + 1 ; jf_vbl = jfld + 2 ; jfld = jf_vbl
[3294]	422	slf_d(jf_ubl) = sn_ubl ; slf_d(jf_vbl) = sn_vbl
	423	ENDIF
	424	IF( lk_traldf_eiv .AND. .NOT.ln_dynbbl ) THEN ! eiv & no bbl
[4570]	425	jf_eiu = jfld + 1 ; jf_eiv = jfld + 2 ; jf_eiw = jfld + 3 ; jfld = jf_eiw
[3294]	426	slf_d(jf_eiu) = sn_eiu ; slf_d(jf_eiv) = sn_eiv ; slf_d(jf_eiw) = sn_eiw
	427	ENDIF
[1501]	428	ENDIF
[3294]	429
	430	ALLOCATE( sf_dyn(jfld), STAT=ierr ) ! set sf structure
	431	IF( ierr > 0 ) THEN
	432	CALL ctl_stop( 'dta_dyn: unable to allocate sf structure' ) ; RETURN
	433	ENDIF
	434	! Open file for each variable to get his number of dimension
	435	DO ifpr = 1, jfld
[3680]	436	CALL iom_open( TRIM( cn_dir )//TRIM( slf_d(ifpr)%clname ), inum )
[3294]	437	idv = iom_varid( inum , slf_d(ifpr)%clvar ) ! id of the variable sdjf%clvar
	438	idimv = iom_file ( inum )%ndims(idv) ! number of dimension for variable sdjf%clvar
	439	IF( inum /= 0 ) CALL iom_close( inum ) ! close file if already open
	440	IF( idimv == 3 ) THEN ! 2D variable
	441	ALLOCATE( sf_dyn(ifpr)%fnow(jpi,jpj,1) , STAT=ierr0 )
	442	IF( slf_d(ifpr)%ln_tint ) ALLOCATE( sf_dyn(ifpr)%fdta(jpi,jpj,1,2) , STAT=ierr1 )
	443	ELSE ! 3D variable
	444	ALLOCATE( sf_dyn(ifpr)%fnow(jpi,jpj,jpk) , STAT=ierr0 )
	445	IF( slf_d(ifpr)%ln_tint ) ALLOCATE( sf_dyn(ifpr)%fdta(jpi,jpj,jpk,2), STAT=ierr1 )
[2528]	446	ENDIF
[3294]	447	IF( ierr0 + ierr1 > 0 ) THEN
	448	CALL ctl_stop( 'dta_dyn_init : unable to allocate sf_dyn array structure' ) ; RETURN
	449	ENDIF
	450	END DO
	451	! ! fill sf with slf_i and control print
	452	CALL fld_fill( sf_dyn, slf_d, cn_dir, 'dta_dyn_init', 'Data in file', 'namdta_dyn' )
[325]	453	!
[3294]	454	IF( lk_ldfslp .AND. .NOT.lk_c1d ) THEN ! slopes
	455	IF( sf_dyn(jf_tem)%ln_tint ) THEN ! time interpolation
	456	ALLOCATE( uslpdta (jpi,jpj,jpk,2), vslpdta (jpi,jpj,jpk,2), &
	457	& wslpidta(jpi,jpj,jpk,2), wslpjdta(jpi,jpj,jpk,2), STAT=ierr2 )
	458	ELSE
	459	ALLOCATE( uslpnow (jpi,jpj,jpk) , vslpnow (jpi,jpj,jpk) , &
	460	& wslpinow(jpi,jpj,jpk) , wslpjnow(jpi,jpj,jpk) , STAT=ierr2 )
	461	ENDIF
	462	IF( ierr2 > 0 ) THEN
	463	CALL ctl_stop( 'dta_dyn_init : unable to allocate slope arrays' ) ; RETURN
	464	ENDIF
[2528]	465	ENDIF
[3294]	466	IF( ln_dynwzv ) THEN ! slopes
	467	IF( sf_dyn(jf_uwd)%ln_tint ) THEN ! time interpolation
	468	ALLOCATE( wdta(jpi,jpj,jpk,2), STAT=ierr3 )
	469	ELSE
	470	ALLOCATE( wnow(jpi,jpj,jpk) , STAT=ierr3 )
	471	ENDIF
	472	IF( ierr3 > 0 ) THEN
	473	CALL ctl_stop( 'dta_dyn_init : unable to allocate wdta arrays' ) ; RETURN
	474	ENDIF
[495]	475	ENDIF
[2715]	476	!
[2528]	477	CALL dta_dyn( nit000 )
	478	!
[1501]	479	END SUBROUTINE dta_dyn_init
	480
[3294]	481	SUBROUTINE dta_dyn_wzv( pu, pv, pw )
[1501]	482	!!----------------------------------------------------------------------
	483	!! * ROUTINE wzv *
	484	!!
	485	!! ** Purpose : Compute the now vertical velocity after the array swap
	486	!!
[2528]	487	!! ** Method : - compute the now divergence given by :
	488	!! * z-coordinate ONLY !!!!
[1501]	489	!! hdiv = 1/(e1t*e2t) [ di(e2u u) + dj(e1v v) ]
	490	!! - Using the incompressibility hypothesis, the vertical
	491	!! velocity is computed by integrating the horizontal divergence
	492	!! from the bottom to the surface.
[2528]	493	!! The boundary conditions are w=0 at the bottom (no flux).
	494	!!----------------------------------------------------------------------
[3294]	495	USE oce, ONLY: zhdiv => hdivn
	496	!
[2528]	497	REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pu, pv !: horizontal velocities
[3294]	498	REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out) :: pw !: vertical velocity
[1501]	499	!!
	500	INTEGER :: ji, jj, jk
	501	REAL(wp) :: zu, zu1, zv, zv1, zet
[2528]	502	!!----------------------------------------------------------------------
	503	!
[1501]	504	! Computation of vertical velocity using horizontal divergence
[3294]	505	zhdiv(:,:,:) = 0._wp
[1501]	506	DO jk = 1, jpkm1
	507	DO jj = 2, jpjm1
	508	DO ji = fs_2, fs_jpim1 ! vector opt.
	509	zu = pu(ji ,jj ,jk) * umask(ji ,jj ,jk) * e2u(ji ,jj ) * fse3u(ji ,jj ,jk)
	510	zu1 = pu(ji-1,jj ,jk) * umask(ji-1,jj ,jk) * e2u(ji-1,jj ) * fse3u(ji-1,jj ,jk)
	511	zv = pv(ji ,jj ,jk) * vmask(ji ,jj ,jk) * e1v(ji ,jj ) * fse3v(ji ,jj ,jk)
	512	zv1 = pv(ji ,jj-1,jk) * vmask(ji ,jj-1,jk) * e1v(ji ,jj-1) * fse3v(ji ,jj-1,jk)
	513	zet = 1. / ( e1t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,jk) )
[2762]	514	zhdiv(ji,jj,jk) = ( zu - zu1 + zv - zv1 ) * zet
[1501]	515	END DO
	516	END DO
[2528]	517	END DO
[2762]	518	CALL lbc_lnk( zhdiv, 'T', 1. ) ! Lateral boundary conditions on zhdiv
[2528]	519	!
[1501]	520	! computation of vertical velocity from the bottom
[2528]	521	pw(:,:,jpk) = 0._wp
[1501]	522	DO jk = jpkm1, 1, -1
[2762]	523	pw(:,:,jk) = pw(:,:,jk+1) - fse3t(:,:,jk) * zhdiv(:,:,jk)
[1501]	524	END DO
[2528]	525	!
[3294]	526	END SUBROUTINE dta_dyn_wzv
[1501]	527
[3294]	528	SUBROUTINE dta_dyn_slp( kt, pts, puslp, pvslp, pwslpi, pwslpj )
[1501]	529	!!---------------------------------------------------------------------
[3294]	530	!! * ROUTINE dta_dyn_slp *
[1501]	531	!!
[3294]	532	!! ** Purpose : Computation of slope
[1501]	533	!!
	534	!!---------------------------------------------------------------------
[3294]	535	INTEGER , INTENT(in ) :: kt ! time step
	536	REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! temperature/salinity
	537	REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(out) :: puslp ! zonal isopycnal slopes
	538	REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(out) :: pvslp ! meridional isopycnal slopes
	539	REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(out) :: pwslpi ! zonal diapycnal slopes
	540	REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(out) :: pwslpj ! meridional diapycnal slopes
[1501]	541	!!---------------------------------------------------------------------
[2528]	542	#if defined key_ldfslp && ! defined key_c1d
[5131]	543	CALL eos ( pts, rhd, rhop, gdept_0(:,:,:) )
[4990]	544	CALL eos_rab( pts, rab_n ) ! now local thermal/haline expension ratio at T-points
	545	CALL bn2 ( pts, rab_n, rn2 ) ! now Brunt-Vaisala
[5131]	546
	547	! Partial steps: before Horizontal DErivative
[5120]	548	IF( ln_zps .AND. .NOT. ln_isfcav) &
	549	& CALL zps_hde ( kt, jpts, pts, gtsu, gtsv, & ! Partial steps: before horizontal gradient
	550	& rhd, gru , grv ) ! of t, s, rd at the last ocean level
	551	IF( ln_zps .AND. ln_isfcav) &
	552	& CALL zps_hde_isf( kt, jpts, pts, gtsu, gtsv, & ! Partial steps for top cell (ISF)
	553	& rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv , &
	554	& gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi ) ! of t, s, rd at the first ocean level
[4990]	555
[5131]	556	rn2b(:,:,:) = rn2(:,:,:) ! need for zdfmxl
[3294]	557	CALL zdf_mxl( kt ) ! mixed layer depth
	558	CALL ldf_slp( kt, rhd, rn2 ) ! slopes
	559	puslp (:,:,:) = uslp (:,:,:)
	560	pvslp (:,:,:) = vslp (:,:,:)
	561	pwslpi(:,:,:) = wslpi(:,:,:)
	562	pwslpj(:,:,:) = wslpj(:,:,:)
	563	#else
	564	puslp (:,:,:) = 0. ! to avoid warning when compiling
	565	pvslp (:,:,:) = 0.
	566	pwslpi(:,:,:) = 0.
	567	pwslpj(:,:,:) = 0.
[1501]	568	#endif
[2528]	569	!
[3294]	570	END SUBROUTINE dta_dyn_slp
[2528]	571	!!======================================================================
[325]	572	END MODULE dtadyn

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

Download in other formats: