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_GO6_package/NEMOGCM/NEMO/TOP_SRC – NEMO

Context Navigation

source: branches/UKMO/dev_r5518_GO6_package/NEMOGCM/NEMO/TOP_SRC/trcini.F90 @ 8280

Last change on this file since 8280 was 8280, checked in by timgraham, 7 years ago
331: Merge of MEDUSA stable branch and HadGEM3 coupling branches into GO6 package branch.
File size: 13.8 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
[8280]	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
[8280]	27	USE trcini_medusa ! MEDUSA initialisation
	28	USE trcini_idtra ! idealize tracer initialisation
	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)
[6486]	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
	67	!!---------------------------------------------------------------------
[3294]	68	!
	69	IF( nn_timing == 1 ) CALL timing_start('trc_init')
	70	!
[945]	71	IF(lwp) WRITE(numout,*)
[2528]	72	IF(lwp) WRITE(numout,*) 'trc_init : initial set up of the passive tracers'
[945]	73	IF(lwp) WRITE(numout,*) '~~~~~~~'
[1011]	74
[2715]	75	CALL top_alloc() ! allocate TOP arrays
	76
[5407]	77	l_trcdm2dc = ln_dm2dc .OR. ( ln_cpl .AND. ncpl_qsr_freq /= 1 )
[5385]	78	l_trcdm2dc = l_trcdm2dc .AND. .NOT. lk_offline
	79	IF( l_trcdm2dc .AND. lwp ) &
	80	& CALL ctl_warn(' Coupling with passive tracers and used of diurnal cycle. &
	81	& Computation of a daily mean shortwave for some biogeochemical models) ')
[8280]	82	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
	83	!!!!! CHECK For MEDUSA
	84	!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
[3294]	85	IF( nn_cla == 1 ) &
	86	& CALL ctl_stop( ' Cross Land Advection not yet implemented with passive tracer ; nn_cla must be 0' )
[1011]	87
[4152]	88	CALL trc_nam ! read passive tracers namelists
[3294]	89	!
	90	IF(lwp) WRITE(numout,*)
[4152]	91	!
	92	IF( ln_rsttr .AND. .NOT. lk_offline ) CALL trc_rst_cal( nit000, 'READ' ) ! calendar
	93	!
[3294]	94	IF(lwp) WRITE(numout,*)
	95	! masked grid volume
	96	! ! masked grid volume
	97	DO jk = 1, jpk
	98	cvol(:,:,jk) = e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk)
	99	END DO
	100	IF( lk_degrad ) cvol(:,:,:) = cvol(:,:,:) * facvol(:,:,:) ! degrad option: reduction by facvol
	101	! ! total volume of the ocean
	102	areatot = glob_sum( cvol(:,:,:) )
[1011]	103
[3294]	104	IF( lk_pisces ) CALL trc_ini_pisces ! PISCES bio-model
[8280]	105	IF( lk_medusa ) CALL trc_ini_medusa ! MEDUSA tracers
	106	IF( lk_idtra ) CALL trc_ini_idtra ! Idealize tracers
[3294]	107	IF( lk_cfc ) CALL trc_ini_cfc ! CFC tracers
	108	IF( lk_c14b ) CALL trc_ini_c14b ! C14 bomb tracer
[8280]	109	IF( lk_age ) CALL trc_ini_age ! AGE tracer
[7203]	110	IF( lk_my_trc ) CALL trc_ini_my_trc ! MY_TRC tracers
[2528]	111
[5385]	112	CALL trc_ice_ini ! Tracers in sea ice
	113
[8280]	114	# if defined key_debug_medusa
	115	IF (lwp) write (numout,*) '------------------------------'
	116	IF (lwp) write (numout,*) 'Jpalm - debug'
	117	IF (lwp) write (numout,*) ' in trc_init'
	118	IF (lwp) write (numout,*) ' sms init OK'
	119	IF (lwp) write (numout,*) ' next: open tracer.stat'
	120	IF (lwp) write (numout,*) ' '
	121	CALL flush(numout)
	122	# endif
	123
	124	IF( ln_ctl ) THEN
[3294]	125	!
[8280]	126	IF (narea == 1) THEN
	127	! The tracer.stat file only contains global tracer sum values, if
	128	! it contains anything at all. Hence it only needs to be opened
	129	! and written to on the master PE, not on all PEs.
	130	CALL ctl_opn( numstr, 'tracer.stat', 'REPLACE','FORMATTED', &
	131	'SEQUENTIAL', -1, numout, lwp , narea )
	132	ENDIF
[3294]	133	!
[945]	134	ENDIF
[1254]	135
[8280]	136	# if defined key_debug_medusa
	137	IF (lwp) write (numout,*) '------------------------------'
	138	IF (lwp) write (numout,*) 'Jpalm - debug'
	139	IF (lwp) write (numout,*) ' in trc_init'
	140	IF (lwp) write (numout,*) 'open tracer.stat -- OK'
	141	IF (lwp) write (numout,*) ' '
	142	CALL flush(numout)
	143	# endif
[1011]	144
[3294]	145
[8280]	146	IF( ln_trcdta ) THEN
	147	#if defined key_medusa
	148	IF(lwp) WRITE(numout,*) 'AXY: calling trc_dta_init'
	149	IF(lwp) CALL flush(numout)
	150	#endif
	151	CALL trc_dta_init(jptra)
	152	ENDIF
	153
[2528]	154	IF( ln_rsttr ) THEN
	155	!
[8280]	156	#if defined key_medusa
	157	IF(lwp) WRITE(numout,*) 'AXY: calling trc_rst_read'
	158	IF(lwp) CALL flush(numout)
	159	#endif
[2528]	160	CALL trc_rst_read ! restart from a file
	161	!
[1011]	162	ELSE
[3294]	163	!
[8280]	164	# if defined key_debug_medusa
	165	IF (lwp) write (numout,*) '------------------------------'
	166	IF (lwp) write (numout,*) 'Jpalm - debug'
	167	IF (lwp) write (numout,*) ' Init from file -- will call trc_dta'
	168	IF (lwp) write (numout,*) ' '
	169	CALL flush(numout)
	170	# endif
	171	!
[3294]	172	IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN ! Initialisation of tracer from a file that may also be used for damping
	173	!
	174	DO jn = 1, jptra
	175	IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file
	176	jl = n_trc_index(jn)
[6793]	177	CALL trc_dta( nit000, sf_trcdta(jl), rf_trfac(jl) ) ! read tracer data at nit000
	178	trn(:,:,:,jn) = sf_trcdta(jl)%fnow(:,:,:)
[4230]	179	IF( .NOT.ln_trcdmp .AND. .NOT.ln_trcdmp_clo ) THEN !== deallocate data structure ==!
	180	! (data used only for initialisation)
	181	IF(lwp) WRITE(numout,*) 'trc_dta: deallocate data arrays as they are only used to initialize the run'
	182	DEALLOCATE( sf_trcdta(jl)%fnow ) ! arrays in the structure
	183	IF( sf_trcdta(jl)%ln_tint ) DEALLOCATE( sf_trcdta(jl)%fdta )
	184	!
	185	ENDIF
[3294]	186	ENDIF
	187	ENDDO
[6498]	188	!
[2528]	189	ENDIF
[3294]	190	!
[8280]	191	# if defined key_debug_medusa
	192	IF (lwp) write (numout,*) '------------------------------'
	193	IF (lwp) write (numout,*) 'Jpalm - debug'
	194	IF (lwp) write (numout,*) ' in trc_init'
	195	IF (lwp) write (numout,*) ' before trb = trn'
	196	IF (lwp) write (numout,*) ' '
	197	CALL flush(numout)
	198	# endif
	199	!
[2528]	200	trb(:,:,:,:) = trn(:,:,:,:)
	201	!
[8280]	202	# if defined key_debug_medusa
	203	IF (lwp) write (numout,*) '------------------------------'
	204	IF (lwp) write (numout,*) 'Jpalm - debug'
	205	IF (lwp) write (numout,*) ' in trc_init'
	206	IF (lwp) write (numout,*) ' trb = trn -- OK'
	207	IF (lwp) write (numout,*) ' '
	208	CALL flush(numout)
	209	# endif
	210	!
[1011]	211	ENDIF
[2528]	212
[2715]	213	tra(:,:,:,:) = 0._wp
[5120]	214	IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav ) & ! Partial steps: before horizontal gradient of passive
	215	& CALL zps_hde ( nit000, jptra, trn, gtru, gtrv ) ! Partial steps: before horizontal gradient
	216	IF( ln_zps .AND. .NOT. lk_c1d .AND. ln_isfcav ) &
	217	& CALL zps_hde_isf( nit000, jptra, trn, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi ) ! tracers at the bottom ocean level
[3294]	218	!
[8280]	219	# if defined key_debug_medusa
	220	IF (lwp) write (numout,*) '------------------------------'
	221	IF (lwp) write (numout,*) 'Jpalm - debug'
	222	IF (lwp) write (numout,*) ' in trc_init'
	223	IF (lwp) write (numout,*) ' partial step -- OK'
	224	IF (lwp) write (numout,*) ' '
	225	CALL flush(numout)
	226	# endif
	227	!
[3294]	228	IF( nn_dttrc /= 1 ) CALL trc_sub_ini ! Initialize variables for substepping passive tracers
	229	!
[8280]	230	# if defined key_debug_medusa
	231	IF (lwp) write (numout,*) '------------------------------'
	232	IF (lwp) write (numout,*) 'Jpalm - debug'
	233	IF (lwp) write (numout,*) ' in trc_init'
	234	IF (lwp) write (numout,*) ' before initiate tracer contents'
	235	IF (lwp) write (numout,*) ' '
	236	CALL flush(numout)
	237	# endif
	238	!
[3294]	239	trai(:) = 0._wp ! initial content of all tracers
[1011]	240	DO jn = 1, jptra
[3294]	241	trai(jn) = trai(jn) + glob_sum( trn(:,:,:,jn) * cvol(:,:,:) )
	242	END DO
[1011]	243
[2715]	244	IF(lwp) THEN ! control print
	245	WRITE(numout,*)
	246	WRITE(numout,*)
	247	WRITE(numout,) ' ** Total number of passive tracer jptra = ', jptra
	248	WRITE(numout,) ' ** Total volume of ocean = ', areatot
[3294]	249	WRITE(numout,) ' ** Total inital content of all tracers '
[2715]	250	WRITE(numout,*)
[8280]	251	# if defined key_debug_medusa
	252	CALL flush(numout)
	253	# endif
	254	!
	255	# if defined key_debug_medusa
	256	WRITE(numout,*) ' litle check : ', ctrcnm(1)
	257	CALL flush(numout)
	258	# endif
[3294]	259	DO jn = 1, jptra
	260	WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), trai(jn)
	261	ENDDO
	262	WRITE(numout,*)
[2715]	263	ENDIF
[3294]	264	IF(lwp) WRITE(numout,*)
[2715]	265	IF(ln_ctl) THEN ! print mean trends (used for debugging)
	266	CALL prt_ctl_trc_init
[1011]	267	WRITE(charout, FMT="('ini ')")
	268	CALL prt_ctl_trc_info( charout )
	269	CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm )
	270	ENDIF
[8280]	271
	272	IF(lwp) WRITE(numout,*)
	273	IF(lwp) WRITE(numout,*) 'trc_init : passive tracer set up completed'
	274	IF(lwp) WRITE(numout,*) '~~~~~~~'
	275	IF(lwp) CALL flush(numout)
	276	# if defined key_debug_medusa
	277	CALL trc_rst_stat
	278	CALL flush(numout)
	279	# endif
	280
[3294]	281	9000 FORMAT(' tracer nb : ',i2,' name :',a10,' initial content :',e18.10)
[2715]	282	!
[3294]	283	IF( nn_timing == 1 ) CALL timing_stop('trc_init')
	284	!
[2528]	285	END SUBROUTINE trc_init
[268]	286
[2715]	287
	288	SUBROUTINE top_alloc
	289	!!----------------------------------------------------------------------
	290	!! * ROUTINE top_alloc *
	291	!!
	292	!! ** Purpose : Allocate all the dynamic arrays of the OPA modules
	293	!!----------------------------------------------------------------------
	294	USE trcadv , ONLY: trc_adv_alloc ! TOP-related alloc routines...
	295	USE trc , ONLY: trc_alloc
	296	USE trcnxt , ONLY: trc_nxt_alloc
	297	USE trczdf , ONLY: trc_zdf_alloc
[4990]	298	USE trdtrc_oce , ONLY: trd_trc_oce_alloc
	299	#if defined key_trdmxl_trc
	300	USE trdmxl_trc , ONLY: trd_mxl_trc_alloc
[2715]	301	#endif
	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
	314	!
	315	IF( lk_mpp ) CALL mpp_sum( ierr )
	316	IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'top_alloc : unable to allocate standard ocean arrays' )
	317	!
	318	END SUBROUTINE top_alloc
	319
[1011]	320	#else
	321	!!----------------------------------------------------------------------
	322	!! Empty module : No passive tracer
	323	!!----------------------------------------------------------------------
	324	CONTAINS
[2528]	325	SUBROUTINE trc_init ! Dummy routine
	326	END SUBROUTINE trc_init
[1011]	327	#endif
	328
[335]	329	!!======================================================================
[268]	330	END MODULE trcini

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

Download in other formats: