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.

trcdta.F90 in NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/src/TOP – NEMO

Context Navigation

source: NEMO/branches/2020/dev_r12527_Gurvan_ShallowWater/src/TOP/trcdta.F90 @ 13151

Last change on this file since 13151 was 13151, checked in by gm, 4 years ago
result from merge with qco r12983
Property svn:keywords set to `Id`
File size: 12.5 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
[7646]	11	!! 3.6 ! 2015-03 (T. Lovato) revisit code I/O
[274]	12	!!----------------------------------------------------------------------
[6140]	13	#if defined key_top
[268]	14	!!----------------------------------------------------------------------
[3294]	15	!! 'key_top' TOP model
[268]	16	!!----------------------------------------------------------------------
[3294]	17	!! trc_dta : read and time interpolated passive tracer data
[268]	18	!!----------------------------------------------------------------------
[3294]	19	USE par_trc ! passive tracers parameters
	20	USE oce_trc ! shared variables between ocean and passive tracers
	21	USE trc ! passive tracers common variables
[9124]	22	!
[3294]	23	USE iom ! I/O manager
	24	USE lib_mpp ! MPP library
	25	USE fldread ! read input fields
[268]	26
	27	IMPLICIT NONE
	28	PRIVATE
	29
[2715]	30	PUBLIC trc_dta ! called in trcini.F90 and trcdmp.F90
[7646]	31	PUBLIC trc_dta_ini ! called in trcini.F90
[268]	32
[3294]	33	INTEGER , SAVE, PUBLIC :: nb_trcdta ! number of tracers to be initialised with data
	34	INTEGER , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: n_trc_index ! indice of tracer which is initialised with data
[4230]	35	INTEGER , SAVE, PUBLIC :: ntra ! MAX( 1, nb_trcdta ) to avoid compilation error with bounds checking
	36	REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: rf_trfac ! multiplicative factor for tracer values
[4489]	37	!$AGRIF_DO_NOT_TREAT
[4230]	38	TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:) :: sf_trcdta ! structure of input SST (file informations, fields read)
[4489]	39	!$AGRIF_END_DO_NOT_TREAT
[6140]	40
[12377]	41	!! Substitutions
	42	#include "do_loop_substitute.h90"
[13151]	43	#include "domzgr_substitute.h90"
[268]	44	!!----------------------------------------------------------------------
[10068]	45	!! NEMO/TOP 4.0 , NEMO Consortium (2018)
[1152]	46	!! $Id$
[10068]	47	!! Software governed by the CeCILL license (see ./LICENSE)
[268]	48	!!----------------------------------------------------------------------
	49	CONTAINS
	50
[7646]	51	SUBROUTINE trc_dta_ini(ntrc)
[335]	52	!!----------------------------------------------------------------------
[7646]	53	!! * ROUTINE trc_dta_ini *
[3294]	54	!!
	55	!! ** Purpose : initialisation of passive tracer input data
	56	!!
	57	!! ** Method : - Read namtsd namelist
	58	!! - allocates passive tracer data structure
[335]	59	!!----------------------------------------------------------------------
[9169]	60	INTEGER,INTENT(in) :: ntrc ! number of tracers
[3294]	61	!
[9169]	62	INTEGER :: jl, jn ! dummy loop indices
	63	INTEGER :: ios, ierr0, ierr1, ierr2, ierr3 ! local integers
	64	REAL(wp) :: zfact
	65	CHARACTER(len=100) :: clndta, clntrc
[3294]	66	!
[9169]	67	CHARACTER(len=100) :: cn_dir
[4230]	68	TYPE(FLD_N), ALLOCATABLE, DIMENSION(:) :: slf_i ! array of namelist informations on the fields to read
	69	TYPE(FLD_N), DIMENSION(jpmaxtrc) :: sn_trcdta
	70	REAL(wp) , DIMENSION(jpmaxtrc) :: rn_trfac ! multiplicative factor for tracer values
[945]	71	!!
[3294]	72	NAMELIST/namtrc_dta/ sn_trcdta, cn_dir, rn_trfac
[335]	73	!!----------------------------------------------------------------------
[3294]	74	!
[6140]	75	IF( lwp ) THEN
[9169]	76	WRITE(numout,*)
	77	WRITE(numout,*) 'trc_dta_ini : Tracers Initial Conditions (IC)'
	78	WRITE(numout,*) '~~~~~~~~~~~ '
[6140]	79	ENDIF
	80	!
[3294]	81	! Initialisation
	82	ierr0 = 0 ; ierr1 = 0 ; ierr2 = 0 ; ierr3 = 0
	83	! Compute the number of tracers to be initialised with data
[4230]	84	ALLOCATE( n_trc_index(ntrc), slf_i(ntrc), STAT=ierr0 )
[3294]	85	IF( ierr0 > 0 ) THEN
[7646]	86	CALL ctl_stop( 'trc_dta_ini: unable to allocate n_trc_index' ) ; RETURN
[3294]	87	ENDIF
	88	nb_trcdta = 0
	89	n_trc_index(:) = 0
[4230]	90	DO jn = 1, ntrc
[3294]	91	IF( ln_trc_ini(jn) ) THEN
	92	nb_trcdta = nb_trcdta + 1
	93	n_trc_index(jn) = nb_trcdta
	94	ENDIF
[9169]	95	END DO
[3294]	96	!
	97	ntra = MAX( 1, nb_trcdta ) ! To avoid compilation error with bounds checking
[3827]	98	IF(lwp) THEN
[9169]	99	WRITE(numout,*)
	100	WRITE(numout,*) ' number of passive tracers to be initialize by data :', ntra
[3827]	101	ENDIF
[3294]	102	!
[4147]	103	READ ( numnat_ref, namtrc_dta, IOSTAT = ios, ERR = 901)
[11536]	104	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_ini in reference namelist' )
[4147]	105	READ ( numnat_cfg, namtrc_dta, IOSTAT = ios, ERR = 902 )
[11536]	106	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namtrc_dta_ini in configuration namelist' )
[4624]	107	IF(lwm) WRITE ( numont, namtrc_dta )
[4147]	108
[3294]	109	IF( lwp ) THEN
[4230]	110	DO jn = 1, ntrc
[3294]	111	IF( ln_trc_ini(jn) ) THEN ! open input file only if ln_trc_ini(jn) is true
	112	clndta = TRIM( sn_trcdta(jn)%clvar )
	113	clntrc = TRIM( ctrcnm (jn) )
[6140]	114	if (jn > jptra) clntrc='Dummy' ! By pass weird formats in ocean.output if ntrc > jptra
[3294]	115	zfact = rn_trfac(jn)
	116	IF( clndta /= clntrc ) THEN
[7646]	117	CALL ctl_warn( 'trc_dta_ini: passive tracer data initialisation ', &
[6140]	118	& 'Input name of data file : '//TRIM(clndta)// &
	119	& ' differs from that of tracer : '//TRIM(clntrc)//' ')
[3294]	120	ENDIF
[9169]	121	WRITE(numout,*)
	122	WRITE(numout,'(a, i4,3a,e11.3)') ' Read IC file for tracer number :', &
[6140]	123	& jn, ', name : ', TRIM(clndta), ', Multiplicative Scaling factor : ', zfact
[335]	124	ENDIF
[3294]	125	END DO
	126	ENDIF
	127	!
	128	IF( nb_trcdta > 0 ) THEN ! allocate only if the number of tracer to initialise is greater than zero
	129	ALLOCATE( sf_trcdta(nb_trcdta), rf_trfac(nb_trcdta), STAT=ierr1 )
	130	IF( ierr1 > 0 ) THEN
[7646]	131	CALL ctl_stop( 'trc_dta_ini: unable to allocate sf_trcdta structure' ) ; RETURN
[3294]	132	ENDIF
	133	!
[4230]	134	DO jn = 1, ntrc
[3294]	135	IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file
	136	jl = n_trc_index(jn)
	137	slf_i(jl) = sn_trcdta(jn)
	138	rf_trfac(jl) = rn_trfac(jn)
	139	ALLOCATE( sf_trcdta(jl)%fnow(jpi,jpj,jpk) , STAT=ierr2 )
	140	IF( sn_trcdta(jn)%ln_tint ) ALLOCATE( sf_trcdta(jl)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 )
	141	IF( ierr2 + ierr3 > 0 ) THEN
[7646]	142	CALL ctl_stop( 'trc_dta_ini : unable to allocate passive tracer data arrays' ) ; RETURN
[3294]	143	ENDIF
	144	ENDIF
	145	!
	146	ENDDO
	147	! ! fill sf_trcdta with slf_i and control print
[7646]	148	CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta_ini', 'Passive tracer data', 'namtrc' )
[3294]	149	!
	150	ENDIF
	151	!
[4230]	152	DEALLOCATE( slf_i ) ! deallocate local field structure
[3294]	153	!
[7646]	154	END SUBROUTINE trc_dta_ini
[268]	155
[493]	156
[12377]	157	SUBROUTINE trc_dta( kt, Kmm, sf_trcdta, ptrcfac, ptrcdta)
[3294]	158	!!----------------------------------------------------------------------
	159	!! * ROUTINE trc_dta *
	160	!!
	161	!! ** Purpose : provides passive tracer data at kt
	162	!!
	163	!! ** Method : - call fldread routine
	164	!! - s- or mixed z-s coordinate: vertical interpolation on model mesh
	165	!! - ln_trcdmp=F: deallocates the data structure as they are not used
	166	!!
[7646]	167	!! ** Action : sf_trcdta passive tracer data on meld mesh and interpolated at time-step kt
[3294]	168	!!----------------------------------------------------------------------
[7646]	169	INTEGER , INTENT(in ) :: kt ! ocean time-step
[12377]	170	INTEGER , INTENT(in ) :: Kmm ! time level index
[7646]	171	TYPE(FLD), DIMENSION(1) , INTENT(inout) :: sf_trcdta ! array of information on the field to read
	172	REAL(wp) , INTENT(in ) :: ptrcfac ! multiplication factor
	173	REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout ) :: ptrcdta ! 3D data array
[3294]	174	!
[4230]	175	INTEGER :: ji, jj, jk, jl, jkk, ik ! dummy loop indices
[3294]	176	REAL(wp):: zl, zi
	177	REAL(wp), DIMENSION(jpk) :: ztp ! 1D workspace
[6701]	178	CHARACTER(len=100) :: clndta
[3294]	179	!!----------------------------------------------------------------------
	180	!
[9124]	181	IF( ln_timing ) CALL timing_start('trc_dta')
[3294]	182	!
[12377]	183	IF( kt == nit000 .AND. lwp) THEN
	184	WRITE(numout,*)
	185	WRITE(numout,*) 'trc_dta : passive tracers data for IC'
	186	WRITE(numout,*) '~~~~~~~ '
	187	ENDIF
	188	!
[3294]	189	IF( nb_trcdta > 0 ) THEN
	190	!
[7646]	191	! read data at kt time step
	192	CALL fld_read( kt, 1, sf_trcdta )
	193	ptrcdta(:,:,:) = sf_trcdta(1)%fnow(:,:,:) * tmask(:,:,:)
	194	!
	195	IF( ln_sco ) THEN !== s- or mixed s-zps-coordinate ==!
[3294]	196	!
	197	IF( kt == nit000 .AND. lwp )THEN
	198	WRITE(numout,*)
	199	WRITE(numout,*) 'trc_dta: interpolates passive tracer data onto the s- or mixed s-z-coordinate mesh'
[268]	200	ENDIF
[12377]	201	DO_2D_11_11
	202	DO jk = 1, jpk ! determines the intepolated T-S profiles at each (i,j) points
	203	zl = gdept(ji,jj,jk,Kmm)
	204	IF( zl < gdept_1d(1 ) ) THEN ! above the first level of data
	205	ztp(jk) = ptrcdta(ji,jj,1)
	206	ELSEIF( zl > gdept_1d(jpk) ) THEN ! below the last level of data
	207	ztp(jk) = ptrcdta(ji,jj,jpkm1)
	208	ELSE ! inbetween : vertical interpolation between jkk & jkk+1
[13151]	209	DO jkk = 1, jpkm1 ! when gdept_1d(jkk) < zl < gdept_1d(jkk+1)
[12377]	210	IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN
	211	zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk))
	212	ztp(jk) = ptrcdta(ji,jj,jkk) + ( ptrcdta(ji,jj,jkk+1) - ptrcdta(ji,jj,jkk) ) * zi
	213	ENDIF
	214	END DO
	215	ENDIF
	216	END DO
	217	DO jk = 1, jpkm1
	218	ptrcdta(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk) ! mask required for mixed zps-s-coord
	219	END DO
	220	ptrcdta(ji,jj,jpk) = 0._wp
	221	END_2D
[3294]	222	!
	223	ELSE !== z- or zps- coordinate ==!
[7646]	224	! zps-coordinate (partial steps) interpolation at the last ocean level
[10222]	225	! IF( ln_zps ) THEN
	226	! DO jj = 1, jpj
	227	! DO ji = 1, jpi
	228	! ik = mbkt(ji,jj)
	229	! IF( ik > 1 ) THEN
	230	! zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) )
	231	! ptrcdta(ji,jj,ik) = (1.-zl) * ptrcdta(ji,jj,ik) + zl * ptrcdta(ji,jj,ik-1)
	232	! ENDIF
	233	! ik = mikt(ji,jj)
	234	! IF( ik > 1 ) THEN
	235	! zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) )
	236	! ptrcdta(ji,jj,ik) = (1.-zl) * ptrcdta(ji,jj,ik) + zl * ptrcdta(ji,jj,ik+1)
	237	! ENDIF
	238	! END DO
	239	! END DO
	240	! ENDIF
[3294]	241	!
	242	ENDIF
	243	!
[7646]	244	! Scale by multiplicative factor
	245	ptrcdta(:,:,:) = ptrcdta(:,:,:) * ptrcfac
[6701]	246	!
[3294]	247	ENDIF
[4230]	248	!
[9124]	249	IF( ln_timing ) CALL timing_stop('trc_dta')
[945]	250	!
[1011]	251	END SUBROUTINE trc_dta
[6607]	252
[268]	253	#else
	254	!!----------------------------------------------------------------------
[945]	255	!! Dummy module NO 3D passive tracer data
[268]	256	!!----------------------------------------------------------------------
	257	CONTAINS
[7646]	258	SUBROUTINE trc_dta( kt, sf_trcdta, ptrcfac, ptrcdta) ! Empty routine
[1011]	259	WRITE(,) 'trc_dta: You should not have seen this print! error?', kt
	260	END SUBROUTINE trc_dta
[268]	261	#endif
[6140]	262
[945]	263	!!======================================================================
[268]	264	END MODULE trcdta

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

Download in other formats: