Context Navigation

trcdta.F90 @ 10149

Last change on this file since 10149 was 6793, checked in by davestorkey, 8 years ago

Merge in changes r6482:6692 from the nemo_v3_6_STABLE branch. Only part that changes results for GO6 configurations is a bug fix for the TVD advection scheme put in at r6692.
Custom merge into /branches/UKMO/dev_r5518_GO6_package/NEMOGCM: r6692 cf. r6688 of /branches/2015/nemo_v3_6_STABLE/NEMOGCM@6791

Custom merge into /branches/UKMO/dev_r5518_GO6_package/NEMOGCM: r6688 cf. r6482 of /branches/2015/nemo_v3_6_STABLE/NEMOGCM@6791

File size: 13.9 KB

Rev	Line
[268]	1	MODULE trcdta
	2	!!======================================================================
[433]	3	!! * MODULE trcdta *
[945]	4	!! TOP : reads passive tracer data
[268]	5	!!=====================================================================
[945]	6	!! History : 1.0 ! 2002-04 (O. Aumont) original code
	7	!! - ! 2004-03 (C. Ethe) module
	8	!! - ! 2005-03 (O. Aumont, A. El Moussaoui) F90
[3294]	9	!! 3.4 ! 2010-11 (C. Ethe, G. Madec) use of fldread + dynamical allocation
[4230]	10	!! 3.5 ! 2013-08 (M. Vichi) generalization for other BGC models
[274]	11	!!----------------------------------------------------------------------
[3294]	12	#if defined key_top
[268]	13	!!----------------------------------------------------------------------
[3294]	14	!! 'key_top' TOP model
[268]	15	!!----------------------------------------------------------------------
[3294]	16	!! trc_dta : read and time interpolated passive tracer data
[268]	17	!!----------------------------------------------------------------------
[3294]	18	USE par_trc ! passive tracers parameters
	19	USE oce_trc ! shared variables between ocean and passive tracers
	20	USE trc ! passive tracers common variables
	21	USE iom ! I/O manager
	22	USE lib_mpp ! MPP library
	23	USE fldread ! read input fields
[268]	24
	25	IMPLICIT NONE
	26	PRIVATE
	27
[2715]	28	PUBLIC trc_dta ! called in trcini.F90 and trcdmp.F90
[3294]	29	PUBLIC trc_dta_init ! called in trcini.F90
[268]	30
[3294]	31	INTEGER , SAVE, PUBLIC :: nb_trcdta ! number of tracers to be initialised with data
	32	INTEGER , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: n_trc_index ! indice of tracer which is initialised with data
[4230]	33	INTEGER , SAVE, PUBLIC :: ntra ! MAX( 1, nb_trcdta ) to avoid compilation error with bounds checking
	34	REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: rf_trfac ! multiplicative factor for tracer values
[4489]	35	!$AGRIF_DO_NOT_TREAT
[4230]	36	TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: sf_trcdta ! structure of input SST (file informations, fields read)
[4489]	37	!$AGRIF_END_DO_NOT_TREAT
[268]	38	!! * Substitutions
[3294]	39	# include "domzgr_substitute.h90"
[268]	40	!!----------------------------------------------------------------------
[3294]	41	!! NEMO/OPA 3.3 , NEMO Consortium (2010)
[6486]	42	!! $Id$
[2715]	43	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
[268]	44	!!----------------------------------------------------------------------
	45	CONTAINS
	46
[4230]	47	SUBROUTINE trc_dta_init(ntrc)
[335]	48	!!----------------------------------------------------------------------
[3294]	49	!! * ROUTINE trc_dta_init *
	50	!!
	51	!! ** Purpose : initialisation of passive tracer input data
	52	!!
	53	!! ** Method : - Read namtsd namelist
	54	!! - allocates passive tracer data structure
[335]	55	!!----------------------------------------------------------------------
[3294]	56	!
[4230]	57	INTEGER,INTENT(IN) :: ntrc ! number of tracers
	58	INTEGER :: jl, jn ! dummy loop indices
[3294]	59	INTEGER :: ierr0, ierr1, ierr2, ierr3 ! temporary integers
[4147]	60	INTEGER :: ios ! Local integer output status for namelist read
[3294]	61	CHARACTER(len=100) :: clndta, clntrc
	62	REAL(wp) :: zfact
	63	!
[4147]	64	CHARACTER(len=100) :: cn_dir
[4230]	65	TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_i ! array of namelist informations on the fields to read
	66	TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trcdta
	67	REAL(wp) , DIMENSION(jpmaxtrc) :: rn_trfac ! multiplicative factor for tracer values
[945]	68	!!
[3294]	69	NAMELIST/namtrc_dta/ sn_trcdta, cn_dir, rn_trfac
[335]	70	!!----------------------------------------------------------------------
[3294]	71	!
	72	IF( nn_timing == 1 ) CALL timing_start('trc_dta_init')
	73	!
	74	! Initialisation
	75	ierr0 = 0 ; ierr1 = 0 ; ierr2 = 0 ; ierr3 = 0
	76	! Compute the number of tracers to be initialised with data
[4230]	77	ALLOCATE( n_trc_index(ntrc), slf_i(ntrc), STAT=ierr0 )
[3294]	78	IF( ierr0 > 0 ) THEN
[6793]	79	CALL ctl_stop( 'trc_dta_init: unable to allocate n_trc_index' ) ; RETURN
[3294]	80	ENDIF
	81	nb_trcdta = 0
	82	n_trc_index(:) = 0
[4230]	83	DO jn = 1, ntrc
[3294]	84	IF( ln_trc_ini(jn) ) THEN
	85	nb_trcdta = nb_trcdta + 1
	86	n_trc_index(jn) = nb_trcdta
	87	ENDIF
	88	ENDDO
	89	!
	90	ntra = MAX( 1, nb_trcdta ) ! To avoid compilation error with bounds checking
[3827]	91	IF(lwp) THEN
	92	WRITE(numout,*) ' '
[6793]	93	WRITE(numout,*) 'trc_dta_init : Passive tracers Initial Conditions '
	94	WRITE(numout,*) '~~~~~~~~~~~~~~ '
[3827]	95	WRITE(numout,*) ' number of passive tracers to be initialize by data :', ntra
	96	WRITE(numout,*) ' '
	97	ENDIF
[3294]	98	!
[4147]	99	REWIND( numnat_ref ) ! Namelist namtrc_dta in reference namelist : Passive tracer input data
	100	READ ( numnat_ref, namtrc_dta, IOSTAT = ios, ERR = 901)
	101	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta in reference namelist', lwp )
[268]	102
[4147]	103	REWIND( numnat_cfg ) ! Namelist namtrc_dta in configuration namelist : Passive tracer input data
	104	READ ( numnat_cfg, namtrc_dta, IOSTAT = ios, ERR = 902 )
	105	902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta in configuration namelist', lwp )
[4624]	106	IF(lwm) WRITE ( numont, namtrc_dta )
[4147]	107
[3294]	108	IF( lwp ) THEN
[4230]	109	DO jn = 1, ntrc
[3294]	110	IF( ln_trc_ini(jn) ) THEN ! open input file only if ln_trc_ini(jn) is true
[6793]	111	clndta = TRIM( sn_trcdta(jn)%clvar )
	112	if (jn > jptra) then
	113	clntrc='Dummy' ! By pass weird formats in ocean.output if ntrc > jptra
	114	else
	115	clntrc = TRIM( ctrcnm (jn) )
	116	endif
[3294]	117	zfact = rn_trfac(jn)
[6793]	118	IF( clndta /= clntrc ) THEN
	119	CALL ctl_warn( 'trc_dta_init: passive tracer data initialisation ', &
	120	& 'Input name of data file : '//TRIM(clndta)// &
	121	& ' differs from that of tracer : '//TRIM(clntrc)//' ')
[3294]	122	ENDIF
[6793]	123	WRITE(numout,'(a, i4,3a,e11.3)') ' Read IC file for tracer number :', &
	124	& jn, ', name : ', TRIM(clndta), ', Multiplicative Scaling factor : ', zfact
[335]	125	ENDIF
[3294]	126	END DO
	127	ENDIF
	128	!
	129	IF( nb_trcdta > 0 ) THEN ! allocate only if the number of tracer to initialise is greater than zero
	130	ALLOCATE( sf_trcdta(nb_trcdta), rf_trfac(nb_trcdta), STAT=ierr1 )
	131	IF( ierr1 > 0 ) THEN
[6793]	132	CALL ctl_stop( 'trc_dta_init: unable to allocate sf_trcdta structure' ) ; RETURN
[3294]	133	ENDIF
	134	!
[4230]	135	DO jn = 1, ntrc
[3294]	136	IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file
	137	jl = n_trc_index(jn)
	138	slf_i(jl) = sn_trcdta(jn)
	139	rf_trfac(jl) = rn_trfac(jn)
	140	ALLOCATE( sf_trcdta(jl)%fnow(jpi,jpj,jpk) , STAT=ierr2 )
	141	IF( sn_trcdta(jn)%ln_tint ) ALLOCATE( sf_trcdta(jl)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 )
	142	IF( ierr2 + ierr3 > 0 ) THEN
[6793]	143	CALL ctl_stop( 'trc_dta_init : unable to allocate passive tracer data arrays' ) ; RETURN
[3294]	144	ENDIF
	145	ENDIF
	146	!
	147	ENDDO
	148	! ! fill sf_trcdta with slf_i and control print
[6793]	149	CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta_init', 'Passive tracer data', 'namtrc' )
[3294]	150	!
	151	ENDIF
	152	!
[4230]	153	DEALLOCATE( slf_i ) ! deallocate local field structure
[3294]	154	IF( nn_timing == 1 ) CALL timing_stop('trc_dta_init')
	155	!
	156	END SUBROUTINE trc_dta_init
[268]	157
[493]	158
[6793]	159	SUBROUTINE trc_dta( kt, sf_dta, ptrfac, ptrc)
[3294]	160	!!----------------------------------------------------------------------
	161	!! * ROUTINE trc_dta *
	162	!!
	163	!! ** Purpose : provides passive tracer data at kt
	164	!!
	165	!! ** Method : - call fldread routine
	166	!! - s- or mixed z-s coordinate: vertical interpolation on model mesh
	167	!! - ln_trcdmp=F: deallocates the data structure as they are not used
	168	!!
[4230]	169	!! ** Action : sf_dta passive tracer data on medl mesh and interpolated at time-step kt
[3294]	170	!!----------------------------------------------------------------------
	171	INTEGER , INTENT(in ) :: kt ! ocean time-step
[6793]	172	TYPE(FLD), DIMENSION(1) , INTENT(inout) :: sf_dta ! array of information on the field to read
	173	REAL(wp) , INTENT(in ) :: ptrfac ! multiplication factor
	174	REAL(wp), DIMENSION(jpi,jpj,jpk), OPTIONAL , INTENT(out ) :: ptrc
[3294]	175	!
[4230]	176	INTEGER :: ji, jj, jk, jl, jkk, ik ! dummy loop indices
[3294]	177	REAL(wp):: zl, zi
	178	REAL(wp), DIMENSION(jpk) :: ztp ! 1D workspace
[6793]	179	REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcdta ! 3D workspace
[3294]	180	CHARACTER(len=100) :: clndta
	181	!!----------------------------------------------------------------------
	182	!
	183	IF( nn_timing == 1 ) CALL timing_start('trc_dta')
	184	!
	185	IF( nb_trcdta > 0 ) THEN
	186	!
[6793]	187	CALL wrk_alloc( jpi, jpj, jpk, ztrcdta ) ! Memory allocation
	188	!
[4230]	189	CALL fld_read( kt, 1, sf_dta ) !== read data at kt time step ==!
[6793]	190	ztrcdta(:,:,:) = sf_dta(1)%fnow(:,:,:) * tmask(:,:,:) ! Mask
[3294]	191	!
	192	IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==!
	193	!
	194	IF( kt == nit000 .AND. lwp )THEN
	195	WRITE(numout,*)
	196	WRITE(numout,*) 'trc_dta: interpolates passive tracer data onto the s- or mixed s-z-coordinate mesh'
[268]	197	ENDIF
[3294]	198	!
[6793]	199	DO jj = 1, jpj ! vertical interpolation of T & S
	200	DO ji = 1, jpi
	201	DO jk = 1, jpk ! determines the intepolated T-S profiles at each (i,j) points
	202	zl = fsdept_n(ji,jj,jk)
	203	IF( zl < gdept_1d(1 ) ) THEN ! above the first level of data
	204	ztp(jk) = ztrcdta(ji,jj,1)
	205	ELSEIF( zl > gdept_1d(jpk) ) THEN ! below the last level of data
	206	ztp(jk) = ztrcdta(ji,jj,jpkm1)
	207	ELSE ! inbetween : vertical interpolation between jkk & jkk+1
	208	DO jkk = 1, jpkm1 ! when gdept(jkk) < zl < gdept(jkk+1)
	209	IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN
	210	zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk))
	211	ztp(jk) = ztrcdta(ji,jj,jkk) + ( ztrcdta(ji,jj,jkk+1) - &
	212	ztrcdta(ji,jj,jkk) ) * zi
	213	ENDIF
	214	END DO
	215	ENDIF
[3294]	216	END DO
[6793]	217	DO jk = 1, jpkm1
	218	ztrcdta(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord
	219	END DO
	220	ztrcdta(ji,jj,jpk) = 0._wp
	221	END DO
	222	END DO
[3294]	223	!
	224	ELSE !== z- or zps- coordinate ==!
[6793]	225	!
	226	IF( ln_zps ) THEN ! zps-coordinate (partial steps) interpolation at the last ocean level
	227	DO jj = 1, jpj
	228	DO ji = 1, jpi
	229	ik = mbkt(ji,jj)
	230	IF( ik > 1 ) THEN
	231	zl = ( gdept_1d(ik) - fsdept_n(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )
	232	ztrcdta(ji,jj,ik) = (1.-zl) * ztrcdta(ji,jj,ik) + zl * ztrcdta(ji,jj,ik-1)
	233	ENDIF
	234	ik = mikt(ji,jj)
	235	IF( ik > 1 ) THEN
	236	zl = ( fsdept_n(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) )
	237	ztrcdta(ji,jj,ik) = (1.-zl) * ztrcdta(ji,jj,ik) + zl * ztrcdta(ji,jj,ik+1)
	238	ENDIF
[3294]	239	END DO
[6793]	240	END DO
	241	ENDIF
[3294]	242	!
	243	ENDIF
	244	!
[6793]	245	! Add multiplicative factor
	246	ztrcdta(:,:,:) = ztrcdta(:,:,:) * ptrfac
	247	!
	248	! Data structure for trc_ini (and BFMv5.1 coupling)
	249	IF( .NOT. PRESENT(ptrc) ) sf_dta(1)%fnow(:,:,:) = ztrcdta(:,:,:)
	250	!
	251	! Data structure for trc_dmp
	252	IF( PRESENT(ptrc) ) ptrc(:,:,:) = ztrcdta(:,:,:)
	253	!
[3294]	254	IF( lwp .AND. kt == nit000 ) THEN
[4230]	255	clndta = TRIM( sf_dta(1)%clvar )
[3294]	256	WRITE(numout,*) ''//clndta//' data '
[335]	257	WRITE(numout,*)
[3294]	258	WRITE(numout,*)' level = 1'
[6793]	259	CALL prihre( ztrcdta(:,:,1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
[3294]	260	WRITE(numout,*)' level = ', jpk/2
[6793]	261	CALL prihre( ztrcdta(:,:,jpk/2), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
[3294]	262	WRITE(numout,*)' level = ', jpkm1
[6793]	263	CALL prihre( ztrcdta(:,:,jpkm1), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout )
[3294]	264	WRITE(numout,*)
[945]	265	ENDIF
[6793]	266	!
	267	CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta )
	268	!
[3294]	269	ENDIF
[4230]	270	!
[3294]	271	IF( nn_timing == 1 ) CALL timing_stop('trc_dta')
[945]	272	!
[1011]	273	END SUBROUTINE trc_dta
[268]	274	#else
	275	!!----------------------------------------------------------------------
[945]	276	!! Dummy module NO 3D passive tracer data
[268]	277	!!----------------------------------------------------------------------
	278	CONTAINS
[6793]	279	SUBROUTINE trc_dta( kt, sf_dta, ptrfac, ptrc) ! Empty routine
[1011]	280	WRITE(,) 'trc_dta: You should not have seen this print! error?', kt
	281	END SUBROUTINE trc_dta
[268]	282	#endif
[945]	283	!!======================================================================
[268]	284	END MODULE trcdta

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

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

Context Navigation

source: branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/trcdta.F90 @ 10149

Download in other formats: