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.

trj_tam.F90 in NEMO/branches/NERC/dev_release-3.4_NEMOTAM_consolidated/NEMOGCM/NEMO/OPATAM_SRC/TAM – NEMO

Context Navigation

source: NEMO/branches/NERC/dev_release-3.4_NEMOTAM_consolidated/NEMOGCM/NEMO/OPATAM_SRC/TAM/trj_tam.F90 @ 11809

Last change on this file since 11809 was 11809, checked in by smueller, 5 years ago
Inclusion of river runoff (arrays rnf and rnf_b of module sbc_oce) in the nonlinear-model trajectory used by NEMOTAM; elimination of the use of an uninitialised array (array rnf_b of module sbc_oce) in the reconstruction of the vertical velocity field of the nonlinear-model trajectory used by NEMOTAM (fix for the bugs described in ticket #1876)
Property svn:executable set to ``*
File size: 34.1 KB

Rev	Line
[3611]	1	MODULE trj_tam
	2	#ifdef key_tam
	3	!!======================================================================
	4	!! * MODULE trj_tam *
	5	!! NEMOVAR trajectory: Allocate and read the trajectory for linearzation
	6	!!======================================================================
	7
	8	!!----------------------------------------------------------------------
	9	!!----------------------------------------------------------------------
	10	!! bkg_init : Initialize the background fields from disk
	11	!!----------------------------------------------------------------------
	12	!! * Modules used
	13	USE par_oce
	14	USE tamtrj ! Parameters for the assmilation interface
	15	USE in_out_manager
	16	USE oce ! Model variables
	17	USE zdf_oce ! Vertical mixing variables
	18	USE zdfddm ! Double diffusion mixing parameterization
	19	USE zdfbfr
	20	USE trc_oce
	21	USE ldftra_oce ! Lateral tracer mixing coefficient defined in memory
	22	USE ldfslp ! Slopes of neutral surfaces
	23	USE tradmp ! Tracer damping
	24	USE sbc_oce ! Ocean surface boundary conditions
	25	USE iom ! Library to read input files
	26	USE zdfmxl
	27	USE divcur ! horizontal divergence and relative vorticity
	28	USE sshwzv
	29	USE oce_tam
	30
	31	IMPLICIT NONE
	32
	33	!! * Routine accessibility
	34	PRIVATE
	35	PUBLIC &
	36	& trj_rea, & !: Read trajectory at time step kstep into now fields
	37	& trj_rd_spl, & !: Read simple data (without interpolation)
	38	& trj_wri_spl, & !: Write simple data (without interpolation)
	39	& tl_trj_wri, & !: Write simple linear-tangent data
	40	& tl_trj_ini, & !: initialize the model-tangent state trajectory
	41	& trj_deallocate !: Deallocate all the saved variable
	42
	43	LOGICAL, PUBLIC :: &
	44	& ln_trjwri_tan = .FALSE. !: No output of the state trajectory fields
	45
	46	CHARACTER (LEN=40), PUBLIC :: &
	47	& cn_tantrj !: Filename for storing the
	48	!: linear-tangent trajectory
	49	INTEGER, PUBLIC :: &
	50	& nn_ittrjfrq_tan !: Frequency of trajectory output for linear-tangent
	51
	52	!! * Module variables
	53	LOGICAL, SAVE :: &
	54	& ln_mem = .FALSE. !: Flag for allocation
	55	INTEGER, SAVE :: inumtrj1 = -1, inumtrj2 = -1
	56	REAL(wp), SAVE :: &
	57	& stpr1, &
	58	& stpr2
	59	REAL(wp), ALLOCATABLE, DIMENSION(:,:), SAVE :: &
	60	& empr1, &
	61	& empsr1, &
	62	& empr2, &
	63	& empsr2, &
	64	& bfruar1, &
	65	& bfrvar1, &
	66	& bfruar2, &
	67	& bfrvar2
	68	#if defined key_traldf_eiv
	69	#if defined key_traldf_c3d
	70	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), SAVE :: &
	71	#elif defined key_traldf_c2d
	72	REAL(wp), ALLOCATABLE, DIMENSION(:,:), SAVE :: &
	73	#elif defined key_traldf_c1d
	74	REAL(wp), ALLOCATABLE, DIMENSION(:), SAVE :: &
	75	#else
	76	REAL(wp) ::
	77	#endif
	78	& aeiur1, &
	79	& aeivr1, &
	80	& aeiwr1, &
	81	& aeiur2, &
	82	& aeivr2, &
	83	& aeiwr2
	84	#endif
	85	REAL(wp), ALLOCATABLE, DIMENSION(:,:,:), SAVE :: &
	86	& unr1, &
	87	& vnr1, &
	88	& tnr1, &
	89	& snr1, &
	90	& avmur1, &
	91	& avmvr1, &
	92	& avtr1, &
	93	& uslpr1, &
	94	& vslpr1, &
	95	& wslpir1, &
	96	& wslpjr1, &
	97	& avsr1, &
	98	& etot3r1, &
	99	& unr2, &
	100	& vnr2, &
	101	& tnr2, &
	102	& snr2, &
	103	& avmur2, &
	104	& avmvr2, &
	105	& avtr2, &
	106	& uslpr2, &
	107	& vslpr2, &
	108	& wslpir2, &
	109	& wslpjr2, &
	110	& avsr2, &
	111	& etot3r2
	112	REAL(wp), ALLOCATABLE, DIMENSION(:,:), SAVE :: &
	113	& hmlp1, &
	114	& hmlp2
[11809]	115	REAL(wp), ALLOCATABLE, DIMENSION(:,:), SAVE :: &
	116	& rnfr1, &
	117	& rnfr2, &
	118	& rnf_br1, &
	119	& rnf_br2
[3611]	120
	121	CONTAINS
	122
	123	SUBROUTINE tl_trj_ini
	124	!!-----------------------------------------------------------------------
	125	!!
	126	!! * ROUTINE tl_trj_ini *
	127	!!
	128	!! ** Purpose : initialize the model-tangent state trajectory
	129	!!
	130	!! ** Method :
	131	!!
	132	!! ** Action :
	133	!!
	134	!! References :
	135	!!
	136	!! History :
	137	!! ! 10-07 (F. Vigilant)
	138	!!-----------------------------------------------------------------------
	139
	140	IMPLICIT NONE
	141
	142	!! * Modules used
	143	NAMELIST/namtl_trj/ nn_ittrjfrq_tan, ln_trjwri_tan, cn_tantrj
	144
	145	ln_trjwri_tan = .FALSE.
	146	nn_ittrjfrq_tan = 1
	147	cn_tantrj = 'tl_trajectory'
	148	REWIND ( numnam )
	149	READ ( numnam, namtl_trj )
	150
	151	! Control print
	152	IF(lwp) THEN
	153	WRITE(numout,*)
	154	WRITE(numout,*) 'tl_trj_ini : Linear-Tagent Trajectory handling:'
	155	WRITE(numout,*) '~~~~~~~~~~~~'
	156	WRITE(numout,*) ' Namelist namtl_trj : set trajectory parameters'
	157	WRITE(numout,*) ' Logical switch for writing out state trajectory ', &
	158	& ' ln_trjwri_tan = ', ln_trjwri_tan
	159	WRITE(numout,*) ' Frequency of trajectory output ', &
	160	& ' nn_ittrjfrq_tan = ', nn_ittrjfrq_tan
	161	END IF
	162	END SUBROUTINE tl_trj_ini
	163
	164	SUBROUTINE trj_rea( kstp, kdir )
	165	!!-----------------------------------------------------------------------
	166	!!
	167	!! * ROUTINE trj_reat *
	168	!!
	169	!! ** Purpose : Read from file the trjectory from the outer loop
	170	!!
	171	!! ** Method : IOM
	172	!!
	173	!! ** Action :
	174	!!
	175	!! References :
	176	!!
	177	!! History :
	178	!! ! 08-05 (K. Mogensen) Initial version
	179	!! ! 09-03 (F.Vigilant) Add reading of hmlp and calls (divcur, wzvmod)
	180	!! ! 2010-04 (F. Vigilant) converison to 3.2
	181	!! ! 2012-07 (P.-A. Bouttier) converison to 3.4
	182	!!-----------------------------------------------------------------------
	183	!! * Modules used
	184	!! * Arguments
	185	INTEGER, INTENT(in) :: &
	186	& kstp, & ! Step for requested trajectory
	187	& kdir ! Direction for stepping (1 forward, -1 backward)
	188	!! * Local declarations
	189	CHARACTER (LEN=100) :: &
	190	& cl_dirtrj
	191	INTEGER :: &
	192	& inrcm, &
	193	& inrcp, &
	194	& inrc, &
	195	& istpr1, &
	196	& istpr2, &
	197	& it
	198	REAL(KIND=wp) :: &
	199	& zwtr1, &
	200	& zwtr2, &
	201	& zden, &
	202	& zstp
	203	! Initialize data and open file
	204	!! if step time is corresponding to a saved state
	205	IF ( ( MOD( kstp - nit000 + 1, nn_ittrjfrq ) == 0 ) ) THEN
	206
	207	it = kstp - nit000 + 1
	208
	209	IF ( inumtrj1 == -1 ) THEN
	210
	211	! Define the input file
	212	WRITE(cl_dirtrj, FMT='(I5.5,A,A,".nc")' ) it, '_', TRIM( cn_dirtrj )
	213
	214	! WRITE(cl_dirtrj, FMT='(A,".nc")' ) TRIM( c_dirtrj )
	215	cl_dirtrj = TRIM( cl_dirtrj )
	216
	217	IF(lwp) THEN
	218
	219	WRITE(numout,*)
	220	WRITE(numout,*)'Reading non-linear fields from : ',TRIM(cl_dirtrj)
	221	WRITE(numout,*)
	222
	223	ENDIF
	224	CALL iom_open( cl_dirtrj, inumtrj1 )
	225	if ( inumtrj1 == -1) CALL ctl_stop( 'No tam_trajectory cl_amstrj found' )
[3662]	226	IF ( .NOT. ln_mem ) THEN
	227	ALLOCATE( &
	228	& empr1(jpi,jpj), &
	229	& empsr1(jpi,jpj), &
	230	& empr2(jpi,jpj), &
	231	& empsr2(jpi,jpj), &
	232	& bfruar1(jpi,jpj),&
	233	& bfrvar1(jpi,jpj),&
	234	& bfruar2(jpi,jpj),&
	235	& bfrvar2(jpi,jpj) &
	236	& )
[3611]	237
[3662]	238	ALLOCATE( &
	239	& unr1(jpi,jpj,jpk), &
	240	& vnr1(jpi,jpj,jpk), &
	241	& tnr1(jpi,jpj,jpk), &
	242	& snr1(jpi,jpj,jpk), &
	243	& avmur1(jpi,jpj,jpk), &
	244	& avmvr1(jpi,jpj,jpk), &
	245	& avtr1(jpi,jpj,jpk), &
	246	& etot3r1(jpi,jpj,jpk), &
	247	& unr2(jpi,jpj,jpk), &
	248	& vnr2(jpi,jpj,jpk), &
	249	& tnr2(jpi,jpj,jpk), &
	250	& snr2(jpi,jpj,jpk), &
	251	& avmur2(jpi,jpj,jpk), &
	252	& avmvr2(jpi,jpj,jpk), &
	253	& avtr2(jpi,jpj,jpk), &
	254	& etot3r2(jpi,jpj,jpk) &
	255	& )
[3611]	256	#if defined key_traldf_eiv
	257	#if defined key_traldf_c3d
	258	#elif defined key_traldf_c2d
[3662]	259	ALLOCATE( &
	260	& aeiur1(jpi,jpj), &
	261	& aeivr1(jpi,jpj), &
	262	& aeiwr1(jpi,jpj), &
	263	& aeiur2(jpi,jpj), &
	264	& aeivr2(jpi,jpj), &
	265	& aeiwr2(jpi,jpj) &
	266	& )
[3611]	267	#elif defined key_traldf_c1d
	268	#endif
	269	#endif
	270
	271	#if defined key_ldfslp
[3662]	272	ALLOCATE( &
	273	& uslpr1(jpi,jpj,jpk), &
	274	& vslpr1(jpi,jpj,jpk), &
	275	& wslpir1(jpi,jpj,jpk), &
	276	& wslpjr1(jpi,jpj,jpk), &
	277	& uslpr2(jpi,jpj,jpk), &
	278	& vslpr2(jpi,jpj,jpk), &
	279	& wslpir2(jpi,jpj,jpk), &
	280	& wslpjr2(jpi,jpj,jpk) &
	281	& )
[3611]	282	#endif
	283
	284	#if defined key_zdfddm
[3662]	285	ALLOCATE( &
	286	& avsr1(jpi,jpj,jpk), &
	287	& avsr2(jpi,jpj,jpk) &
	288	& )
[3611]	289	#endif
	290
	291	#if defined key_tradmp
[3662]	292	ALLOCATE( &
	293	& hmlp1(jpi,jpj), &
	294	& hmlp2(jpi,jpj) &
	295	& )
[3611]	296	#endif
[11809]	297	ALLOCATE( &
	298	& rnfr1(jpi, jpj), &
	299	& rnfr2(jpi, jpj), &
	300	& rnf_br1(jpi, jpj), &
	301	& rnf_br2(jpi, jpj))
[3662]	302	ln_mem = .TRUE.
	303	ENDIF
[3611]	304	ENDIF
	305
	306
	307	! Read records
	308
	309	inrcm = INT( ( kstp - nit000 + 1 ) / nn_ittrjfrq ) + 1
	310
	311	! Copy record 1 into record 2
	312
	313	IF ( ( kstp /= nitend ) .AND. &
	314	& ( kstp - nit000 + 1 /= 0 ) .AND. &
	315	& ( kdir == -1 ) ) THEN
	316
	317	stpr2 = stpr1
	318
	319	empr2 (:,:) = empr1 (:,:)
	320	empsr2 (:,:) = empsr1 (:,:)
	321	bfruar2 (:,:) = bfruar1 (:,:)
	322	bfrvar2 (:,:) = bfrvar1 (:,:)
	323
	324	unr2 (:,:,:) = unr1 (:,:,:)
	325	vnr2 (:,:,:) = vnr1 (:,:,:)
	326	tnr2 (:,:,:) = tnr1 (:,:,:)
	327	snr2 (:,:,:) = snr1 (:,:,:)
	328	avmur2 (:,:,:) = avmur1 (:,:,:)
	329	avmvr2 (:,:,:) = avmvr1 (:,:,:)
	330	avtr2 (:,:,:) = avtr1 (:,:,:)
	331	#if defined key_ldfslp
	332	uslpr2 (:,:,:) = uslpr1 (:,:,:)
	333	vslpr2 (:,:,:) = vslpr1 (:,:,:)
	334	wslpir2 (:,:,:) = wslpir1 (:,:,:)
	335	wslpjr2 (:,:,:) = wslpjr1 (:,:,:)
	336	#endif
	337	#if defined key_zdfddm
	338	avsr2 (:,:,:) = avsr1 (:,:,:)
	339	#endif
	340	etot3r2 (:,:,:) = etot3r1 (:,:,:)
	341	#if defined key_tradmp
	342	hmlp1 (:,:) = hmlp2 (:,:)
	343	#endif
	344	#if defined key_traldf_eiv
	345	#if defined key_traldf_c3d
	346	aeiur2 (:,:,:) = aeiur1 (:,:,:)
	347	aeivr2 (:,:,:) = aeivr1 (:,:.:)
	348	aeiwr2 (:,:,:) = aeiwr1 (:,:.:)
	349	#elif defined key_traldf_c2d
	350	aeiur2 (:,:) = aeiur1 (:,:)
	351	aeivr2 (:,:) = aeivr1 (:,:)
	352	aeiwr2 (:,:) = aeiwr1 (:,:)
	353	#elif defined key_traldf_c1d
	354	aeiur2 (:) = aeiur1 (:)
	355	aeivr2 (:) = aeivr1 (:)
	356	aeiwr2 (:) = aeiwr1 (:)
	357	#else
	358	aeiur2 = aeiur1
	359	aeivr2 = aeivr1
	360	aeiwr2 = aeiwr1
	361	#endif
	362	#endif
[11809]	363	rnfr2 (:,:) = rnfr1 (:,:)
	364	rnf_br2 (:,:) = rnf_br1 (:,:)
[3611]	365
	366	istpr1 = INT( stpr1 )
	367
	368	IF(lwp) WRITE(numout,*) &
	369	& ' Trajectory record copy time step = ', istpr1
	370
	371	ENDIF
	372
	373	IF ( ( kstp - nit000 + 1 /= 0 ) .AND. ( kdir == -1 ) ) THEN
	374	! We update the input filename
	375	WRITE(cl_dirtrj, FMT='(I5.5,A,A,".nc")' ) (it-nn_ittrjfrq), '_', TRIM(cn_dirtrj )
	376	cl_dirtrj = TRIM( cl_dirtrj )
	377	IF(lwp) THEN
	378	WRITE(numout,*)
	379	WRITE(numout,*)'Reading non-linear fields from : ',TRIM(cl_dirtrj)
	380	WRITE(numout,*)
	381	ENDIF
	382	ENDIF
	383
	384	! Read record 1
	385
	386	IF ( ( kstp - nit000 + 1 == 0 ) .AND.( kdir == 1 ) .OR. &
	387	& ( kstp - nit000 + 1 /= 0 ) .AND.( kdir == -1 ) ) THEN
	388
	389	IF ( kdir == -1 ) inrcm = inrcm - 1
	390	! inrc = inrcm
	391	! temporary fix: currently, only one field by step time
	392	inrc = 1
	393	stpr1 = (inrcm - 1) * nn_ittrjfrq
	394
	395	! bug fixed to read several time the initial data
	396	IF ( ( kstp - nit000 + 1 == 0 ) .AND. ( kdir == 1 ) ) THEN
	397	! Define the input file
	398	WRITE(cl_dirtrj, FMT='(I5.5, A,A,".nc")' ) it, '_', TRIM( cn_dirtrj )
	399
	400	cl_dirtrj = TRIM( cl_dirtrj )
	401
	402	IF(lwp) THEN
	403	WRITE(numout,*)
	404	WRITE(numout,*)'Reading non-linear fields from : ',TRIM(cl_dirtrj)
	405	WRITE(numout,*)
	406	ENDIF
	407	END IF
	408	IF ( inumtrj1 /= -1 ) CALL iom_open( cl_dirtrj, inumtrj1 )
	409
	410	CALL iom_get( inumtrj1, jpdom_autoglo, 'emp' , empr1 , inrc )
	411	CALL iom_get( inumtrj1, jpdom_autoglo, 'emps' , empsr1 , inrc )
	412	CALL iom_get( inumtrj1, jpdom_autoglo, 'un' , unr1 , inrc )
	413	CALL iom_get( inumtrj1, jpdom_autoglo, 'vn' , vnr1 , inrc )
	414	CALL iom_get( inumtrj1, jpdom_autoglo, 'tn' , tnr1 , inrc )
	415	CALL iom_get( inumtrj1, jpdom_autoglo, 'sn' , snr1 , inrc )
	416	CALL iom_get( inumtrj1, jpdom_autoglo, 'avmu' , avmur1 , inrc )
	417	CALL iom_get( inumtrj1, jpdom_autoglo, 'avmv' , avmvr1 , inrc )
	418	CALL iom_get( inumtrj1, jpdom_autoglo, 'avt' , avtr1 , inrc )
	419	CALL iom_get( inumtrj1, jpdom_autoglo, 'bfrua' , bfruar1 , inrc )
	420	CALL iom_get( inumtrj1, jpdom_autoglo, 'bfrva' , bfrvar1 , inrc )
	421	#if defined key_ldfslp
	422	CALL iom_get( inumtrj1, jpdom_autoglo, 'uslp' , uslpr1 , inrc )
	423	CALL iom_get( inumtrj1, jpdom_autoglo, 'vslp' , vslpr1 , inrc )
	424	CALL iom_get( inumtrj1, jpdom_autoglo, 'wslpi' , wslpir1 , inrc )
	425	CALL iom_get( inumtrj1, jpdom_autoglo, 'wslpj' , wslpjr1 , inrc )
	426	#endif
	427	#if defined key_zdfddm
	428	CALL iom_get( inumtrj1, jpdom_autoglo, 'avs' , avsr1 , inrc )
	429	#endif
	430	CALL iom_get( inumtrj1, jpdom_autoglo, 'etot3' , etot3r1 , inrc )
	431	#if defined key_tradmp
	432	CALL iom_get( inumtrj1, jpdom_autoglo, 'hmlp' , hmlp1 , inrc )
	433	#endif
	434	#if defined key_traldf_eiv
	435	CALL iom_get( inumtrj1, jpdom_autoglo, 'aeiu' , aeiur1 , inrc )
	436	CALL iom_get( inumtrj1, jpdom_autoglo, 'aeiv' , aeivr1 , inrc )
	437	CALL iom_get( inumtrj1, jpdom_autoglo, 'aeiw' , aeiwr1 , inrc )
	438	#endif
[11809]	439	CALL iom_get( inumtrj1, jpdom_autoglo, 'rnf' , rnfr1 , inrc )
	440	CALL iom_get( inumtrj1, jpdom_autoglo, 'rnf_b' , rnf_br1 , inrc )
[3611]	441	CALL iom_close( inumtrj1 )
	442
	443	istpr1 = INT( stpr1 )
	444	IF(lwp)WRITE(numout,*) ' trajectory read time step = ', istpr1,&
	445	& ' record = ', inrc
	446
	447	ENDIF
	448
	449
	450	! Copy record 2 into record 1
	451
	452	IF ( ( kstp - nit000 + 1 /= 0 ) .AND. &
	453	& ( kstp /= nitend ) .AND. &
	454	& ( kdir == 1 ) ) THEN
	455
	456	stpr1 = stpr2
	457	empr1 (:,:) = empr2 (:,:)
	458	empsr1 (:,:) = empsr2 (:,:)
	459	bfruar1 (:,:) = bfruar2 (:,:)
	460	bfrvar1 (:,:) = bfrvar2 (:,:)
	461	unr1 (:,:,:) = unr2 (:,:,:)
	462	vnr1 (:,:,:) = vnr2 (:,:,:)
	463	tnr1 (:,:,:) = tnr2 (:,:,:)
	464	snr1 (:,:,:) = snr2 (:,:,:)
	465	avmur1 (:,:,:) = avmur2 (:,:,:)
	466	avmvr1 (:,:,:) = avmvr2 (:,:,:)
	467	avtr1 (:,:,:) = avtr2 (:,:,:)
	468	#if defined key_ldfslp
	469	uslpr1 (:,:,:) = uslpr2 (:,:,:)
	470	vslpr1 (:,:,:) = vslpr2 (:,:,:)
	471	wslpir1 (:,:,:) = wslpir2 (:,:,:)
	472	wslpjr1 (:,:,:) = wslpjr2 (:,:,:)
	473	#endif
	474	#if defined key_zdfddm
	475	avsr1 (:,:,:) = avsr2 (:,:,:)
	476	#endif
	477	etot3r1 (:,:,:) = etot3r2 (:,:,:)
	478	#if defined key_tradmp
	479	hmlp1 (:,:) = hmlp2 (:,:)
	480	#endif
	481	#if defined key_traldf_eiv
	482	#if defined key_traldf_c3d
	483	aeiur1 (:,:,:) = aeiur2 (:,:,:)
	484	aeivr1 (:,:,:) = aeivr2 (:,:.:)
	485	aeiwr1 (:,:,:) = aeiwr2 (:,:.:)
	486	#elif defined key_traldf_c2d
	487	aeiur1 (:,:) = aeiur2 (:,:)
	488	aeivr1 (:,:) = aeivr2 (:,:)
	489	aeiwr1 (:,:) = aeiwr2 (:,:)
	490	#elif defined key_traldf_c1d
	491	aeiur1 (:) = aeiur2 (:)
	492	aeivr1 (:) = aeivr2 (:)
	493	aeiwr1 (:) = aeiwr2 (:)
	494	#else
	495	aeiur1 = aeiur2
	496	aeivr1 = aeivr2
	497	aeiwr1 = aeiwr2
	498	#endif
	499	#endif
[11809]	500	rnfr1 (:,:) = rnfr2 (:,:)
	501	rnf_br1 (:,:) = rnf_br2 (:,:)
[3611]	502
	503	istpr1 = INT( stpr1 )
	504	IF(lwp) WRITE(numout,*) &
	505	& ' Trajectory record copy time step = ', istpr1
	506
	507	ENDIF
	508
	509	! Read record 2
	510
	511	IF ( ( ( kstp /= nitend ) .AND. ( kdir == 1 )) .OR. &
	512	& ( kstp == nitend ) .AND.( kdir == -1 ) ) THEN
	513
	514	! Define the input file
	515	IF ( kdir == -1 ) THEN
	516	WRITE(cl_dirtrj, FMT='(I5.5,A,A,".nc")' ) it, '_', TRIM( cn_dirtrj )
	517	ELSE
	518	WRITE(cl_dirtrj, FMT='(I5.5,A,A,".nc")' ) (it+nn_ittrjfrq), '_', TRIM( cn_dirtrj )
	519	ENDIF
	520	cl_dirtrj = TRIM( cl_dirtrj )
	521
	522	IF(lwp) THEN
	523	WRITE(numout,*)
	524	WRITE(numout,*)'Reading non-linear fields from : ',TRIM(cl_dirtrj)
	525	WRITE(numout,*)
	526	ENDIF
	527
	528	CALL iom_open( cl_dirtrj, inumtrj2 )
	529
	530
	531	inrcp = inrcm + 1
	532	! inrc = inrcp
	533	inrc = 1 ! temporary fix
	534
	535	stpr2 = (inrcp - 1) * nn_ittrjfrq
	536	CALL iom_get( inumtrj2, jpdom_autoglo, 'emp' , empr2 , inrc )
	537	CALL iom_get( inumtrj2, jpdom_autoglo, 'emps' , empsr2 , inrc )
	538	CALL iom_get( inumtrj2, jpdom_autoglo, 'un' , unr2 , inrc )
	539	CALL iom_get( inumtrj2, jpdom_autoglo, 'vn' , vnr2 , inrc )
	540	CALL iom_get( inumtrj2, jpdom_autoglo, 'tn' , tnr2 , inrc )
	541	CALL iom_get( inumtrj2, jpdom_autoglo, 'sn' , snr2 , inrc )
	542	CALL iom_get( inumtrj2, jpdom_autoglo, 'avmu' , avmur2 , inrc )
	543	CALL iom_get( inumtrj2, jpdom_autoglo, 'avmv' , avmvr2 , inrc )
	544	CALL iom_get( inumtrj2, jpdom_autoglo, 'avt' , avtr2 , inrc )
	545	CALL iom_get( inumtrj2, jpdom_autoglo, 'bfrua' , bfruar2 , inrc )
	546	CALL iom_get( inumtrj2, jpdom_autoglo, 'bfrva' , bfrvar2 , inrc )
	547	#if defined key_ldfslp
	548	CALL iom_get( inumtrj2, jpdom_autoglo, 'uslp' , uslpr2 , inrc )
	549	CALL iom_get( inumtrj2, jpdom_autoglo, 'vslp' , vslpr2 , inrc )
	550	CALL iom_get( inumtrj2, jpdom_autoglo, 'wslpi' , wslpir2 , inrc )
	551	CALL iom_get( inumtrj2, jpdom_autoglo, 'wslpj' , wslpjr2 , inrc )
	552	#endif
	553	#if defined key_zdfddm
	554	CALL iom_get( inumtrj2, jpdom_autoglo, 'avs' , avsr2 , inrc )
	555	#endif
	556	CALL iom_get( inumtrj2, jpdom_autoglo, 'etot3' , etot3r2 , inrc )
	557	#if defined key_tradmp
	558	CALL iom_get( inumtrj2, jpdom_autoglo, 'hmlp' , hmlp2 , inrc )
	559	#endif
	560	#if defined key_traldf_eiv
	561	CALL iom_get( inumtrj2, jpdom_autoglo, 'aeiu' , aeiur2 , inrc )
	562	CALL iom_get( inumtrj2, jpdom_autoglo, 'aeiv' , aeivr2 , inrc )
	563	CALL iom_get( inumtrj2, jpdom_autoglo, 'aeiw' , aeiwr2 , inrc )
	564	#endif
[11809]	565	CALL iom_get( inumtrj2, jpdom_autoglo, 'rnf' , rnfr2 , inrc )
	566	CALL iom_get( inumtrj2, jpdom_autoglo, 'rnf_b' , rnf_br2 , inrc )
[3611]	567	CALL iom_close( inumtrj2 )
	568
	569	istpr2 = INT( stpr2 )
	570	IF(lwp)WRITE(numout,*) ' trajectory read2 time step = ', istpr2,&
	571	& ' record = ', inrc
	572	ENDIF
	573
	574	ENDIF
	575
	576	! Add warning for user
	577	IF ( (kstp == nitend) .AND. ( MOD( kstp - nit000 + 1, nn_ittrjfrq ) /= 0 ) ) THEN
	578	IF(lwp) WRITE(numout,*) ' Warning ! nitend (=',nitend, ')', &
	579	& ' and saving frequency (=',nn_ittrjfrq,') not compatible.'
	580	ENDIF
	581
	582	! Linear interpolate to the current step
	583
	584	IF(lwp)WRITE(numout,*) ' linear interpolate to current', &
	585	& ' time step = ', kstp
	586
	587	! Interpolation coefficients
	588
	589	zstp = kstp - nit000 + 1
	590	zden = 1.0 / ( stpr2 - stpr1 )
	591
	592	zwtr1 = ( stpr2 - zstp ) * zden
	593	zwtr2 = ( zstp - stpr1 ) * zden
	594
	595	IF(lwp)WRITE(numout,*) ' linear interpolate coeff.', &
	596	& ' = ', zwtr1, zwtr2
	597
[11774]	598	IF ( ( kstp /= nit000-1 ).AND.( kdir == 1 ) ) THEN
[3611]	599	tsb(:,:,:,:) = tsn(:,:,:,:)
	600	ub(:,:,:) = un(:,:,:)
	601	vb(:,:,:) = vn(:,:,:)
	602	END IF
	603	emp(:,:) = zwtr1 * empr1 (:,:) + zwtr2 * empr2 (:,:)
	604	emps(:,:) = zwtr1 * empsr1 (:,:) + zwtr2 * empsr2 (:,:)
	605	bfrua(:,:) = zwtr1 * bfruar1 (:,:) + zwtr2 * bfruar2 (:,:)
	606	bfrva(:,:) = zwtr1 * bfrvar1 (:,:) + zwtr2 * bfrvar2 (:,:)
	607	un(:,:,:) = zwtr1 * unr1 (:,:,:) + zwtr2 * unr2 (:,:,:)
	608	vn(:,:,:) = zwtr1 * vnr1 (:,:,:) + zwtr2 * vnr2 (:,:,:)
	609	tsn(:,:,:,jp_tem) = zwtr1 * tnr1 (:,:,:) + zwtr2 * tnr2 (:,:,:)
	610	tsn(:,:,:,jp_sal) = zwtr1 * snr1 (:,:,:) + zwtr2 * snr2 (:,:,:)
[11774]	611	IF ( kdir == -1 ) THEN
	612	zwtr1 = ( stpr2 - zstp + 1 ) * zden
	613	zwtr2 = ( zstp - 1 - stpr1 ) * zden
	614	ub(:,:,:) = zwtr1 * unr1 (:,:,:) + zwtr2 * unr2 (:,:,:)
	615	vb(:,:,:) = zwtr1 * vnr1 (:,:,:) + zwtr2 * vnr2 (:,:,:)
	616	tsb(:,:,:,jp_tem) = zwtr1 * tnr1 (:,:,:) + zwtr2 * tnr2 (:,:,:)
	617	tsb(:,:,:,jp_sal) = zwtr1 * snr1 (:,:,:) + zwtr2 * snr2 (:,:,:)
	618	IF(lwp)WRITE(numout,*) ' before lin. interp. coeff.', &
	619	& ' = ', zwtr1, zwtr2
	620
	621	zwtr1 = ( stpr2 - zstp ) * zden
	622	zwtr2 = ( zstp - stpr1 ) * zden
	623	END IF
[3611]	624	IF ( kstp == nit000-1 ) THEN
	625	tsb(:,:,:,:) = tsn(:,:,:,:)
	626	ub(:,:,:) = un(:,:,:)
	627	vb(:,:,:) = vn(:,:,:)
	628	END IF
	629	avmu(:,:,:) = zwtr1 * avmur1 (:,:,:) + zwtr2 * avmur2 (:,:,:)
	630	avmv(:,:,:) = zwtr1 * avmvr1 (:,:,:) + zwtr2 * avmvr2 (:,:,:)
	631	avt(:,:,:) = zwtr1 * avtr1 (:,:,:) + zwtr2 * avtr2 (:,:,:)
	632	#if defined key_ldfslp
	633	uslp(:,:,:) = zwtr1 * uslpr1 (:,:,:) + zwtr2 * uslpr2 (:,:,:)
	634	vslp(:,:,:) = zwtr1 * vslpr1 (:,:,:) + zwtr2 * vslpr2 (:,:,:)
	635	wslpi(:,:,:) = zwtr1 * wslpir1 (:,:,:) + zwtr2 * wslpir2 (:,:,:)
	636	wslpj(:,:,:) = zwtr1 * wslpjr1 (:,:,:) + zwtr2 * wslpjr2 (:,:,:)
	637	#endif
	638	#if defined key_zdfddm
	639	avs(:,:,:) = zwtr1 * avsr1 (:,:,:) + zwtr2 * avsr2 (:,:,:)
	640	#endif
	641	etot3(:,:,:) = zwtr1 * etot3r1 (:,:,:) + zwtr2 * etot3r2 (:,:,:)
	642	#if defined key_tradmp
	643	hmlp(:,:) = zwtr1 * hmlp1(:,:) + zwtr2 * hmlp2(:,:)
	644	#endif
	645	#if defined key_traldf_eiv
	646	#if defined key_traldf_c3d
	647	aeiu(:,:,:) = zwtr1 * aeiur1 (:,:,:) + zwtr2 * aeiur2 (:,:,:)
	648	aeiv(:,:,:) = zwtr1 * aeivr1 (:,:,:) + zwtr2 * aeivr2 (:,:.:)
	649	aeiw(:,:,:) = zwtr1 * aeiwr1 (:,:,:) + zwtr2 * aeiwr2 (:,:.:)
	650	#elif defined key_traldf_c2d
	651	aeiu(:,:) = zwtr1 * aeiur1 (:,:) + zwtr2 * aeiur2 (:,:)
	652	aeiv(:,:) = zwtr1 * aeivr1 (:,:) + zwtr2 * aeivr2 (:,:)
	653	aeiw(:,:) = zwtr1 * aeiwr1 (:,:) + zwtr2 * aeiwr2 (:,:)
	654	#elif defined key_traldf_c1d
	655	aeiu(:) = zwtr1 * aeiur1 (:) + zwtr2 * aeiur2 (:)
	656	aeiv(:) = zwtr1 * aeivr1 (:) + zwtr2 * aeivr2 (:)
	657	aeiw(:) = zwtr1 * aeiwr1 (:) + zwtr2 * aeiwr2 (:)
	658	#else
	659	aeiu = zwtr1 * aeiur1 + zwtr2 * aeiur2
	660	aeiv = zwtr1 * aeivr1 + zwtr2 * aeivr2
	661	aeiw = zwtr1 * aeiwr1 + zwtr2 * aeiwr2
	662	#endif
	663	#endif
[11809]	664	rnf(:,:) = zwtr1 * rnfr1 (:,:) + zwtr2 * rnfr2 (:,:)
	665	rnf_b(:,:) = zwtr1 * rnf_br1 (:,:) + zwtr2 * rnf_br2 (:,:)
[3611]	666
	667	CALL ssh_wzv( kstp )
	668
	669	END SUBROUTINE trj_rea
	670
	671
	672	SUBROUTINE trj_wri_spl(filename)
	673	!!-----------------------------------------------------------------------
	674	!!
	675	!! * ROUTINE trj_wri_spl *
	676	!!
	677	!! ** Purpose : Write SimPLe data to file the model state trajectory
	678	!!
	679	!! ** Method :
	680	!!
	681	!! ** Action :
	682	!!
	683	!! History :
	684	!! ! 09-07 (F. Vigilant)
	685	!!-----------------------------------------------------------------------
	686	!! *Module udes
	687	USE iom
	688	USE sol_oce, ONLY : & ! solver variables
	689	& gcb, gcx
	690	!! * Arguments
	691	!! * Local declarations
	692	INTEGER :: &
	693	& inum, & ! File unit number
	694	& fd ! field number
	695	CHARACTER (LEN=50) :: &
	696	& filename
	697
	698	fd=1
	699	WRITE(filename, FMT='(A,A)' ) TRIM( filename ), '.nc'
	700	filename = TRIM( filename )
	701	CALL iom_open( filename, inum, ldwrt = .TRUE., kiolib = jprstlib)
	702
	703	! Output trajectory fields
	704	CALL iom_rstput( fd, fd, inum, 'un' , un )
	705	CALL iom_rstput( fd, fd, inum, 'vn' , vn )
	706	CALL iom_rstput( fd, fd, inum, 'tn' , tsn(:,:,:,jp_tem) )
	707	CALL iom_rstput( fd, fd, inum, 'sn' , tsn(:,:,:,jp_sal) )
	708	CALL iom_rstput( fd, fd, inum, 'sshn' , sshn )
	709	CALL iom_rstput( fd, fd, inum, 'wn' , wn )
	710	CALL iom_rstput( fd, fd, inum, 'tb' , tsb(:,:,:,jp_tem) )
	711	CALL iom_rstput( fd, fd, inum, 'sb' , tsb(:,:,:,jp_sal) )
	712	CALL iom_rstput( fd, fd, inum, 'ua' , ua )
	713	CALL iom_rstput( fd, fd, inum, 'va' , va )
	714	CALL iom_rstput( fd, fd, inum, 'ta' , tsa(:,:,:,jp_tem) )
	715	CALL iom_rstput( fd, fd, inum, 'sa' , tsa(:,:,:,jp_sal) )
	716	CALL iom_rstput( fd, fd, inum, 'sshb' , sshb )
	717	CALL iom_rstput( fd, fd, inum, 'rhd' , rhd )
	718	CALL iom_rstput( fd, fd, inum, 'rhop' , rhop )
	719	CALL iom_rstput( fd, fd, inum, 'gtu' , gtsu(:,:,jp_tem) )
	720	CALL iom_rstput( fd, fd, inum, 'gsu' , gtsu(:,:,jp_sal) )
	721	CALL iom_rstput( fd, fd, inum, 'gru' , gru )
	722	CALL iom_rstput( fd, fd, inum, 'gtv' , gtsv(:,:,jp_tem) )
	723	CALL iom_rstput( fd, fd, inum, 'gsv' , gtsv(:,:,jp_sal) )
	724	CALL iom_rstput( fd, fd, inum, 'grv' , grv )
	725	CALL iom_rstput( fd, fd, inum, 'rn2' , rn2 )
	726	CALL iom_rstput( fd, fd, inum, 'gcb' , gcb )
	727	CALL iom_rstput( fd, fd, inum, 'gcx' , gcx )
	728
	729	CALL iom_close( inum )
	730
	731	END SUBROUTINE trj_wri_spl
	732
	733	SUBROUTINE trj_rd_spl(filename)
	734	!!-----------------------------------------------------------------------
	735	!!
	736	!! * ROUTINE asm_trj__wop_rd *
	737	!!
	738	!! ** Purpose : Read SimPLe data from file the model state trajectory
	739	!!
	740	!! ** Method :
	741	!!
	742	!! ** Action :
	743	!!
	744	!! History :
	745	!! ! 09-07 (F. Vigilant)
	746	!!-----------------------------------------------------------------------
	747	!! *Module udes
	748	USE iom ! I/O module
	749	USE sol_oce, ONLY : & ! solver variables
	750	& gcb, gcx
	751	!! * Arguments
	752	!! * Local declarations
	753	INTEGER :: &
	754	& inum, & ! File unit number
	755	& fd ! field number
	756	CHARACTER (LEN=50) :: &
	757	& filename
	758
	759	fd=1
	760	WRITE(filename, FMT='(A,A)' ) TRIM( filename ), '.nc'
	761	filename = TRIM( filename )
	762	CALL iom_open( filename, inum)
	763
	764	! Output trajectory fields
	765	CALL iom_get( inum, jpdom_autoglo, 'un' , un, fd )
	766	CALL iom_get( inum, jpdom_autoglo, 'vn' , vn, fd )
	767	CALL iom_get( inum, jpdom_autoglo, 'tn' , tsn(:,:,:,jp_tem), fd )
	768	CALL iom_get( inum, jpdom_autoglo, 'sn' , tsn(:,:,:,jp_sal), fd )
	769	CALL iom_get( inum, jpdom_autoglo, 'sshn' , sshn, fd )
	770	CALL iom_get( inum, jpdom_autoglo, 'wn' , wn, fd )
	771	CALL iom_get( inum, jpdom_autoglo, 'tb' , tsb(:,:,:,jp_tem), fd )
	772	CALL iom_get( inum, jpdom_autoglo, 'sb' , tsb(:,:,:,jp_sal), fd )
	773	CALL iom_get( inum, jpdom_autoglo, 'ua' , ua, fd )
	774	CALL iom_get( inum, jpdom_autoglo, 'va' , va, fd )
	775	CALL iom_get( inum, jpdom_autoglo, 'ta' , tsa(:,:,:,jp_tem), fd )
	776	CALL iom_get( inum, jpdom_autoglo, 'sa' , tsa(:,:,:,jp_sal), fd )
	777	CALL iom_get( inum, jpdom_autoglo, 'sshb' , sshb, fd )
	778	CALL iom_get( inum, jpdom_autoglo, 'rhd' , rhd, fd )
	779	CALL iom_get( inum, jpdom_autoglo, 'rhop' , rhop, fd )
	780	CALL iom_get( inum, jpdom_autoglo, 'gtu' , gtsu(:,:,jp_tem), fd )
	781	CALL iom_get( inum, jpdom_autoglo, 'gsu' , gtsu(:,:,jp_sal), fd )
	782	CALL iom_get( inum, jpdom_autoglo, 'gru' , gru, fd )
	783	CALL iom_get( inum, jpdom_autoglo, 'gtv' , gtsv(:,:,jp_tem), fd )
	784	CALL iom_get( inum, jpdom_autoglo, 'gsv' , gtsv(:,:,jp_sal), fd )
	785	CALL iom_get( inum, jpdom_autoglo, 'grv' , grv, fd )
	786	CALL iom_get( inum, jpdom_autoglo, 'rn2' , rn2, fd )
	787	CALL iom_get( inum, jpdom_autoglo, 'gcb' , gcb, fd )
	788	CALL iom_get( inum, jpdom_autoglo, 'gcx' , gcx, fd )
	789
	790	CALL iom_close( inum )
	791
	792	END SUBROUTINE trj_rd_spl
	793
	794	SUBROUTINE tl_trj_wri(kstp)
	795	!!-----------------------------------------------------------------------
	796	!!
	797	!! * ROUTINE tl_trj_wri *
	798	!!
	799	!! ** Purpose : Write SimPLe data to file the model state trajectory
	800	!!
	801	!! ** Method :
	802	!!
	803	!! ** Action :
	804	!!
	805	!! History :
	806	!! ! 10-07 (F. Vigilant)
	807	!!-----------------------------------------------------------------------
	808	!! *Module udes
	809	USE iom
	810	!! * Arguments
	811	INTEGER, INTENT(in) :: &
	812	& kstp ! Step for requested trajectory
	813	!! * Local declarations
	814	INTEGER :: &
	815	& inum ! File unit number
	816	INTEGER :: &
	817	& it
	818	CHARACTER (LEN=50) :: &
	819	& filename
	820	CHARACTER (LEN=100) :: &
	821	& cl_tantrj
	822
	823	! Initialize data and open file
	824	!! if step time is corresponding to a saved state
	825	IF ( ( MOD( kstp - nit000 + 1, nn_ittrjfrq_tan ) == 0 ) ) THEN
	826
	827	it = kstp - nit000 + 1
	828
	829	! Define the input file
	830	WRITE(cl_tantrj, FMT='(I5.5, A,A,".nc")' ) it, '_', TRIM( cn_tantrj )
	831	cl_tantrj = TRIM( cl_tantrj )
	832
	833	IF(lwp) THEN
	834	WRITE(numout,*)
	835	WRITE(numout,*)'Writing linear-tangent fields from : ',TRIM(cl_tantrj)
	836	WRITE(numout,*)
	837	ENDIF
	838
	839	CALL iom_open( cl_tantrj, inum, ldwrt = .TRUE., kiolib = jprstlib)
	840
	841	! Output trajectory fields
	842	CALL iom_rstput( it, it, inum, 'un_tl' , un_tl )
	843	CALL iom_rstput( it, it, inum, 'vn_tl' , vn_tl )
	844	CALL iom_rstput( it, it, inum, 'un' , un )
	845	CALL iom_rstput( it, it, inum, 'vn' , vn )
	846	CALL iom_rstput( it, it, inum, 'tn_tl' , tsn_tl(:,:,:,jp_tem) )
	847	CALL iom_rstput( it, it, inum, 'sn_tl' , tsn_tl(:,:,:,jp_sal) )
	848	CALL iom_rstput( it, it, inum, 'wn_tl' , wn_tl )
	849	CALL iom_rstput( it, it, inum, 'hdivn_tl', hdivn_tl)
	850	CALL iom_rstput( it, it, inum, 'rotn_tl' , rotn_tl )
	851	CALL iom_rstput( it, it, inum, 'rhd_tl' , rhd_tl )
	852	CALL iom_rstput( it, it, inum, 'rhop_tl' , rhop_tl )
	853	CALL iom_rstput( it, it, inum, 'sshn_tl' , sshn_tl )
	854
	855	CALL iom_close( inum )
	856
	857	ENDIF
	858
	859	END SUBROUTINE tl_trj_wri
	860
	861
	862	SUBROUTINE trj_deallocate
	863	!!-----------------------------------------------------------------------
	864	!!
	865	!! * ROUTINE trj_deallocate *
	866	!!
	867	!! ** Purpose : Deallocate saved trajectory arrays
	868	!!
	869	!! ** Method :
	870	!!
	871	!! ** Action :
	872	!!
	873	!! History :
	874	!! ! 2010-06 (A. Vidard)
	875	!!-----------------------------------------------------------------------
	876
	877	IF ( ln_mem ) THEN
	878	DEALLOCATE( &
	879	& empr1, &
	880	& empsr1, &
	881	& empr2, &
	882	& empsr2, &
	883	& bfruar1,&
	884	& bfrvar1,&
	885	& bfruar2,&
	886	& bfrvar2 &
	887	& )
	888
	889	DEALLOCATE( &
	890	& unr1, &
	891	& vnr1, &
	892	& tnr1, &
	893	& snr1, &
	894	& avmur1, &
	895	& avmvr1, &
	896	& avtr1, &
	897	& etot3r1, &
	898	& unr2, &
	899	& vnr2, &
	900	& tnr2, &
	901	& snr2, &
	902	& avmur2, &
	903	& avmvr2, &
	904	& avtr2, &
	905	& etot3r2 &
	906	& )
	907
	908	#if defined key_traldf_eiv
	909	#if defined key_traldf_c3d
	910	#elif defined key_traldf_c2d
	911	DEALLOCATE( &
	912	& aeiur1, &
	913	& aeivr1, &
	914	& aeiwr1, &
	915	& aeiur2, &
	916	& aeivr2, &
	917	& aeiwr2 &
	918	& )
	919	#elif defined key_traldf_c1d
	920	#endif
	921	#endif
	922
	923	#if defined key_ldfslp
	924	DEALLOCATE( &
	925	& uslpr1, &
	926	& vslpr1, &
	927	& wslpir1, &
	928	& wslpjr1, &
	929	& uslpr2, &
	930	& vslpr2, &
	931	& wslpir2, &
	932	& wslpjr2 &
	933	& )
	934	#endif
	935
	936	#if defined key_zdfddm
	937	DEALLOCATE( &
	938	& avsr1, &
	939	& avsr2 &
	940	& )
	941	#endif
	942
	943	#if defined key_tradmp
	944	DEALLOCATE( &
	945	& hmlp1, &
	946	& hmlp2 &
	947	& )
	948	#endif
[11809]	949	DEALLOCATE( &
	950	& rnfr1, &
	951	& rnfr2, &
	952	& rnf_br1, &
	953	& rnf_br2 &
	954	& )
[3611]	955	ENDIF
	956	END SUBROUTINE trj_deallocate
	957	#endif
	958	END MODULE trj_tam

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

Download in other formats: