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.

trcini.F90 in branches/UKMO/dev_r5518_medusa_chg_trc_bio_medusa/NEMOGCM/NEMO/TOP_SRC – NEMO

Context Navigation

source: branches/UKMO/dev_r5518_medusa_chg_trc_bio_medusa/NEMOGCM/NEMO/TOP_SRC/trcini.F90 @ 7912

Last change on this file since 7912 was 7912, checked in by marc, 7 years ago
Moved initialisation from trcbio_medusa.F90 into bio_medusa_init.F90
File size: 13.9 KB

Rev	Line
[268]	1	MODULE trcini
[945]	2	!!======================================================================
	3	!! * MODULE trcini *
	4	!! TOP : Manage the passive tracer initialization
	5	!!======================================================================
[2715]	6	!! History : - ! 1991-03 (O. Marti) original code
	7	!! 1.0 ! 2005-03 (O. Aumont, A. El Moussaoui) F90
	8	!! 2.0 ! 2005-10 (C. Ethe, G. Madec) revised architecture
	9	!! 4.0 ! 2011-01 (A. R. Porter, STFC Daresbury) dynamical allocation
[5726]	10	!! - ! 2014-06 (A. Yool, J. Palmieri) adding MEDUSA-2
[274]	11	!!----------------------------------------------------------------------
[1011]	12	#if defined key_top
	13	!!----------------------------------------------------------------------
	14	!! 'key_top' TOP models
	15	!!----------------------------------------------------------------------
[2715]	16	!! trc_init : Initialization for passive tracer
	17	!! top_alloc : allocate the TOP arrays
[1011]	18	!!----------------------------------------------------------------------
[3294]	19	USE oce_trc ! shared variables between ocean and passive tracers
	20	USE trc ! passive tracers common variables
	21	USE trcrst ! passive tracers restart
[2528]	22	USE trcnam ! Namelist read
[1254]	23	USE trcini_cfc ! CFC initialisation
	24	USE trcini_pisces ! PISCES initialisation
	25	USE trcini_c14b ! C14 bomb initialisation
	26	USE trcini_my_trc ! MY_TRC initialisation
[5726]	27	USE trcini_medusa ! MEDUSA initialisation
	28	USE trcini_idtra ! idealize tracer initialisation
[6715]	29	USE trcini_age ! AGE initialisation
[4230]	30	USE trcdta ! initialisation from files
[3294]	31	USE daymod ! calendar manager
[2528]	32	USE zpshde ! partial step: hor. derivative (zps_hde routine)
[1011]	33	USE prtctl_trc ! Print control passive tracers (prt_ctl_trc_init routine)
[4306]	34	USE trcsub ! variables to substep passive tracers
	35	USE lib_mpp ! distribued memory computing library
	36	USE sbc_oce
[5385]	37	USE trcice ! tracers in sea ice
[4306]	38
[335]	39	IMPLICIT NONE
	40	PRIVATE
[1011]	41
[2528]	42	PUBLIC trc_init ! called by opa
[268]	43
[1011]	44	!! * Substitutions
	45	# include "domzgr_substitute.h90"
[2715]	46	!!----------------------------------------------------------------------
	47	!! NEMO/TOP 4.0 , NEMO Consortium (2011)
[5726]	48	!! $Id$
[2715]	49	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
	50	!!----------------------------------------------------------------------
[335]	51	CONTAINS
[1011]	52
[2528]	53	SUBROUTINE trc_init
[1011]	54	!!---------------------------------------------------------------------
[2528]	55	!! * ROUTINE trc_init *
[335]	56	!!
[1011]	57	!! ** Purpose : Initialization of the passive tracer fields
	58	!!
	59	!! ** Method : - read namelist
	60	!! - control the consistancy
	61	!! - compute specific initialisations
	62	!! - set initial tracer fields (either read restart
	63	!! or read data or analytical formulation
	64	!!---------------------------------------------------------------------
[3294]	65	INTEGER :: jk, jn, jl ! dummy loop indices
[1011]	66	CHARACTER (len=25) :: charout
[4230]	67	REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrcdta ! 4D workspace
[1011]	68	!!---------------------------------------------------------------------
[3294]	69	!
	70	IF( nn_timing == 1 ) CALL timing_start('trc_init')
	71	!
[945]	72	IF(lwp) WRITE(numout,*)
[2528]	73	IF(lwp) WRITE(numout,*) 'trc_init : initial set up of the passive tracers'
[945]	74	IF(lwp) WRITE(numout,*) '~~~~~~~'
[1011]	75
[2715]	76	CALL top_alloc() ! allocate TOP arrays
	77
[5407]	78	l_trcdm2dc = ln_dm2dc .OR. ( ln_cpl .AND. ncpl_qsr_freq /= 1 )
[5385]	79	l_trcdm2dc = l_trcdm2dc .AND. .NOT. lk_offline
	80	IF( l_trcdm2dc .AND. lwp ) &
	81	& CALL ctl_warn(' Coupling with passive tracers and used of diurnal cycle. &
	82	& Computation of a daily mean shortwave for some biogeochemical models) ')
[5726]	83	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	84	!!!!! CHECK For MEDUSA
	85	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[3294]	86	IF( nn_cla == 1 ) &
	87	& CALL ctl_stop( ' Cross Land Advection not yet implemented with passive tracer ; nn_cla must be 0' )
[1011]	88
[4152]	89	CALL trc_nam ! read passive tracers namelists
[3294]	90	!
	91	IF(lwp) WRITE(numout,*)
[4152]	92	!
	93	IF( ln_rsttr .AND. .NOT. lk_offline ) CALL trc_rst_cal( nit000, 'READ' ) ! calendar
	94	!
[3294]	95	IF(lwp) WRITE(numout,*)
	96	! masked grid volume
	97	! ! masked grid volume
	98	DO jk = 1, jpk
	99	cvol(:,:,jk) = e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk)
	100	END DO
	101	IF( lk_degrad ) cvol(:,:,:) = cvol(:,:,:) * facvol(:,:,:) ! degrad option: reduction by facvol
	102	! ! total volume of the ocean
	103	areatot = glob_sum( cvol(:,:,:) )
[1011]	104
[3294]	105	IF( lk_pisces ) CALL trc_ini_pisces ! PISCES bio-model
[6164]	106	IF( lk_medusa ) CALL trc_ini_medusa ! MEDUSA tracers
	107	IF( lk_idtra ) CALL trc_ini_idtra ! Idealize tracers
[3294]	108	IF( lk_cfc ) CALL trc_ini_cfc ! CFC tracers
	109	IF( lk_c14b ) CALL trc_ini_c14b ! C14 bomb tracer
[6715]	110	IF( lk_age ) CALL trc_ini_age ! AGE tracer
[3294]	111	IF( lk_my_trc ) CALL trc_ini_my_trc ! MY_TRC tracers
[2528]	112
[5385]	113	CALL trc_ice_ini ! Tracers in sea ice
	114
[5726]	115	# if defined key_debug_medusa
	116	IF (lwp) write (numout,*) '------------------------------'
	117	IF (lwp) write (numout,*) 'Jpalm - debug'
	118	IF (lwp) write (numout,*) ' in trc_init'
	119	IF (lwp) write (numout,*) ' sms init OK'
	120	IF (lwp) write (numout,*) ' next: open tracer.stat'
	121	IF (lwp) write (numout,*) ' '
	122	CALL flush(numout)
	123	# endif
	124
[7709]	125	IF( ln_ctl ) THEN
[3294]	126	!
[7709]	127	IF (narea == 1) THEN
	128	! The tracer.stat file only contains global tracer sum values, if
	129	! it contains anything at all. Hence it only needs to be opened
	130	! and written to on the master PE, not on all PEs.
	131	CALL ctl_opn( numstr, 'tracer.stat', 'REPLACE','FORMATTED', &
	132	'SEQUENTIAL', -1, numout, lwp , narea )
	133	ENDIF
[3294]	134	!
[945]	135	ENDIF
[1254]	136
[5726]	137	# if defined key_debug_medusa
	138	IF (lwp) write (numout,*) '------------------------------'
	139	IF (lwp) write (numout,*) 'Jpalm - debug'
	140	IF (lwp) write (numout,*) ' in trc_init'
	141	IF (lwp) write (numout,*) 'open tracer.stat -- OK'
	142	IF (lwp) write (numout,*) ' '
	143	CALL flush(numout)
	144	# endif
[1011]	145
[3294]	146
[5726]	147	IF( ln_trcdta ) THEN
	148	#if defined key_medusa
	149	IF(lwp) WRITE(numout,*) 'AXY: calling trc_dta_init'
	150	IF(lwp) CALL flush(numout)
	151	#endif
	152	CALL trc_dta_init(jptra)
	153	ENDIF
	154
[2528]	155	IF( ln_rsttr ) THEN
	156	!
[5726]	157	#if defined key_medusa
	158	IF(lwp) WRITE(numout,*) 'AXY: calling trc_rst_read'
	159	IF(lwp) CALL flush(numout)
	160	#endif
[2528]	161	CALL trc_rst_read ! restart from a file
	162	!
[1011]	163	ELSE
[3294]	164	!
	165	IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN ! Initialisation of tracer from a file that may also be used for damping
	166	!
[4230]	167	CALL wrk_alloc( jpi, jpj, jpk, ztrcdta ) ! Memory allocation
[3294]	168	!
	169	DO jn = 1, jptra
	170	IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file
	171	jl = n_trc_index(jn)
[4230]	172	CALL trc_dta( nit000, sf_trcdta(jl),rf_trfac(jl) ) ! read tracer data at nit000
	173	ztrcdta(:,:,:) = sf_trcdta(jl)%fnow(:,:,:)
	174	trn(:,:,:,jn) = ztrcdta(:,:,:) * tmask(:,:,:)
[6645]	175	IF( .NOT.ln_trcdmp .AND. .NOT.ln_trcdmp_clo ) THEN !== deallocate data structure ==!
[4230]	176	! (data used only for initialisation)
	177	IF(lwp) WRITE(numout,*) 'trc_dta: deallocate data arrays as they are only used to initialize the run'
	178	DEALLOCATE( sf_trcdta(jl)%fnow ) ! arrays in the structure
	179	IF( sf_trcdta(jl)%ln_tint ) DEALLOCATE( sf_trcdta(jl)%fdta )
	180	!
	181	ENDIF
[3294]	182	ENDIF
	183	ENDDO
[4230]	184	CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta )
[2528]	185	ENDIF
[3294]	186	!
[5726]	187	# if defined key_debug_medusa
	188	IF (lwp) write (numout,*) '------------------------------'
	189	IF (lwp) write (numout,*) 'Jpalm - debug'
	190	IF (lwp) write (numout,*) ' in trc_init'
	191	IF (lwp) write (numout,*) ' before trb = trn'
	192	IF (lwp) write (numout,*) ' '
	193	CALL flush(numout)
	194	# endif
	195	!
[2528]	196	trb(:,:,:,:) = trn(:,:,:,:)
	197	!
[5726]	198	# if defined key_debug_medusa
	199	IF (lwp) write (numout,*) '------------------------------'
	200	IF (lwp) write (numout,*) 'Jpalm - debug'
	201	IF (lwp) write (numout,*) ' in trc_init'
	202	IF (lwp) write (numout,*) ' trb = trn -- OK'
	203	IF (lwp) write (numout,*) ' '
	204	CALL flush(numout)
	205	# endif
	206	!
[1011]	207	ENDIF
[2528]	208
[2715]	209	tra(:,:,:,:) = 0._wp
[5120]	210	IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav ) & ! Partial steps: before horizontal gradient of passive
	211	& CALL zps_hde ( nit000, jptra, trn, gtru, gtrv ) ! Partial steps: before horizontal gradient
	212	IF( ln_zps .AND. .NOT. lk_c1d .AND. ln_isfcav ) &
	213	& CALL zps_hde_isf( nit000, jptra, trn, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi ) ! tracers at the bottom ocean level
[3294]	214	!
[5726]	215	# if defined key_debug_medusa
	216	IF (lwp) write (numout,*) '------------------------------'
	217	IF (lwp) write (numout,*) 'Jpalm - debug'
	218	IF (lwp) write (numout,*) ' in trc_init'
	219	IF (lwp) write (numout,*) ' partial step -- OK'
	220	IF (lwp) write (numout,*) ' '
	221	CALL flush(numout)
	222	# endif
	223	!
[3294]	224	IF( nn_dttrc /= 1 ) CALL trc_sub_ini ! Initialize variables for substepping passive tracers
	225	!
[5726]	226	# if defined key_debug_medusa
	227	IF (lwp) write (numout,*) '------------------------------'
	228	IF (lwp) write (numout,*) 'Jpalm - debug'
	229	IF (lwp) write (numout,*) ' in trc_init'
	230	IF (lwp) write (numout,*) ' before initiate tracer contents'
	231	IF (lwp) write (numout,*) ' '
	232	CALL flush(numout)
	233	# endif
	234	!
[3294]	235	trai(:) = 0._wp ! initial content of all tracers
[1011]	236	DO jn = 1, jptra
[3294]	237	trai(jn) = trai(jn) + glob_sum( trn(:,:,:,jn) * cvol(:,:,:) )
	238	END DO
[1011]	239
[2715]	240	IF(lwp) THEN ! control print
	241	WRITE(numout,*)
	242	WRITE(numout,*)
	243	WRITE(numout,) ' ** Total number of passive tracer jptra = ', jptra
	244	WRITE(numout,) ' ** Total volume of ocean = ', areatot
[3294]	245	WRITE(numout,) ' ** Total inital content of all tracers '
[2715]	246	WRITE(numout,*)
[5726]	247	# if defined key_debug_medusa
	248	CALL flush(numout)
	249	# endif
	250	!
	251	# if defined key_debug_medusa
	252	WRITE(numout,*) ' litle check : ', ctrcnm(1)
	253	CALL flush(numout)
	254	# endif
[3294]	255	DO jn = 1, jptra
	256	WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), trai(jn)
	257	ENDDO
	258	WRITE(numout,*)
[2715]	259	ENDIF
[3294]	260	IF(lwp) WRITE(numout,*)
[2715]	261	IF(ln_ctl) THEN ! print mean trends (used for debugging)
	262	CALL prt_ctl_trc_init
[1011]	263	WRITE(charout, FMT="('ini ')")
	264	CALL prt_ctl_trc_info( charout )
	265	CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm )
	266	ENDIF
[5726]	267
	268	IF(lwp) WRITE(numout,*)
	269	IF(lwp) WRITE(numout,*) 'trc_init : passive tracer set up completed'
	270	IF(lwp) WRITE(numout,*) '~~~~~~~'
	271	IF(lwp) CALL flush(numout)
[6230]	272	# if defined key_debug_medusa
	273	CALL trc_rst_stat
	274	CALL flush(numout)
	275	# endif
[5726]	276
[3294]	277	9000 FORMAT(' tracer nb : ',i2,' name :',a10,' initial content :',e18.10)
[2715]	278	!
[3294]	279	IF( nn_timing == 1 ) CALL timing_stop('trc_init')
	280	!
[2528]	281	END SUBROUTINE trc_init
[268]	282
[2715]	283
	284	SUBROUTINE top_alloc
	285	!!----------------------------------------------------------------------
	286	!! * ROUTINE top_alloc *
	287	!!
	288	!! ** Purpose : Allocate all the dynamic arrays of the OPA modules
	289	!!----------------------------------------------------------------------
	290	USE trcadv , ONLY: trc_adv_alloc ! TOP-related alloc routines...
	291	USE trc , ONLY: trc_alloc
	292	USE trcnxt , ONLY: trc_nxt_alloc
	293	USE trczdf , ONLY: trc_zdf_alloc
[4990]	294	USE trdtrc_oce , ONLY: trd_trc_oce_alloc
	295	#if defined key_trdmxl_trc
	296	USE trdmxl_trc , ONLY: trd_mxl_trc_alloc
[2715]	297	#endif
[7912]	298	# if defined key_medusa
	299	USE bio_medusa_mod, ONLY: bio_medusa_alloc
	300	# endif
	301
[2715]	302	!
	303	INTEGER :: ierr
	304	!!----------------------------------------------------------------------
	305	!
	306	ierr = trc_adv_alloc() ! Start of TOP-related alloc routines...
	307	ierr = ierr + trc_alloc ()
	308	ierr = ierr + trc_nxt_alloc()
	309	ierr = ierr + trc_zdf_alloc()
[4990]	310	ierr = ierr + trd_trc_oce_alloc()
	311	#if defined key_trdmxl_trc
	312	ierr = ierr + trd_mxl_trc_alloc()
[2715]	313	#endif
[7912]	314	#if defined key_medusa
	315	ierr = ierr + bio_medusa_alloc()
	316	#endif
[2715]	317	!
	318	IF( lk_mpp ) CALL mpp_sum( ierr )
	319	IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'top_alloc : unable to allocate standard ocean arrays' )
	320	!
	321	END SUBROUTINE top_alloc
	322
[1011]	323	#else
	324	!!----------------------------------------------------------------------
	325	!! Empty module : No passive tracer
	326	!!----------------------------------------------------------------------
	327	CONTAINS
[2528]	328	SUBROUTINE trc_init ! Dummy routine
	329	END SUBROUTINE trc_init
[1011]	330	#endif
	331
[335]	332	!!======================================================================
[268]	333	END MODULE trcini

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

Download in other formats: