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

Context Navigation

source: branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/trcini.F90 @ 8131

Last change on this file since 8131 was 8130, checked in by jpalmier, 7 years ago
JPALM -- CFC module debugg - CFC12 and SF6 up-to-date and in action from now
File size: 14.0 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	!
[8130]	165	# if defined key_debug_medusa
	166	IF (lwp) write (numout,*) '------------------------------'
	167	IF (lwp) write (numout,*) 'Jpalm - debug'
	168	IF (lwp) write (numout,*) ' Init from file -- will call trc_dta'
	169	IF (lwp) write (numout,*) ' '
	170	CALL flush(numout)
	171	# endif
	172	!
[3294]	173	IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN ! Initialisation of tracer from a file that may also be used for damping
	174	!
[4230]	175	CALL wrk_alloc( jpi, jpj, jpk, ztrcdta ) ! Memory allocation
[3294]	176	!
	177	DO jn = 1, jptra
	178	IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file
	179	jl = n_trc_index(jn)
[4230]	180	CALL trc_dta( nit000, sf_trcdta(jl),rf_trfac(jl) ) ! read tracer data at nit000
	181	ztrcdta(:,:,:) = sf_trcdta(jl)%fnow(:,:,:)
	182	trn(:,:,:,jn) = ztrcdta(:,:,:) * tmask(:,:,:)
[6645]	183	IF( .NOT.ln_trcdmp .AND. .NOT.ln_trcdmp_clo ) THEN !== deallocate data structure ==!
[4230]	184	! (data used only for initialisation)
	185	IF(lwp) WRITE(numout,*) 'trc_dta: deallocate data arrays as they are only used to initialize the run'
	186	DEALLOCATE( sf_trcdta(jl)%fnow ) ! arrays in the structure
	187	IF( sf_trcdta(jl)%ln_tint ) DEALLOCATE( sf_trcdta(jl)%fdta )
	188	!
	189	ENDIF
[3294]	190	ENDIF
	191	ENDDO
[4230]	192	CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta )
[2528]	193	ENDIF
[3294]	194	!
[5726]	195	# if defined key_debug_medusa
	196	IF (lwp) write (numout,*) '------------------------------'
	197	IF (lwp) write (numout,*) 'Jpalm - debug'
	198	IF (lwp) write (numout,*) ' in trc_init'
	199	IF (lwp) write (numout,*) ' before trb = trn'
	200	IF (lwp) write (numout,*) ' '
	201	CALL flush(numout)
	202	# endif
	203	!
[2528]	204	trb(:,:,:,:) = trn(:,:,:,:)
	205	!
[5726]	206	# if defined key_debug_medusa
	207	IF (lwp) write (numout,*) '------------------------------'
	208	IF (lwp) write (numout,*) 'Jpalm - debug'
	209	IF (lwp) write (numout,*) ' in trc_init'
	210	IF (lwp) write (numout,*) ' trb = trn -- OK'
	211	IF (lwp) write (numout,*) ' '
	212	CALL flush(numout)
	213	# endif
	214	!
[1011]	215	ENDIF
[2528]	216
[2715]	217	tra(:,:,:,:) = 0._wp
[5120]	218	IF( ln_zps .AND. .NOT. lk_c1d .AND. .NOT. ln_isfcav ) & ! Partial steps: before horizontal gradient of passive
	219	& CALL zps_hde ( nit000, jptra, trn, gtru, gtrv ) ! Partial steps: before horizontal gradient
	220	IF( ln_zps .AND. .NOT. lk_c1d .AND. ln_isfcav ) &
	221	& CALL zps_hde_isf( nit000, jptra, trn, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi ) ! tracers at the bottom ocean level
[3294]	222	!
[5726]	223	# if defined key_debug_medusa
	224	IF (lwp) write (numout,*) '------------------------------'
	225	IF (lwp) write (numout,*) 'Jpalm - debug'
	226	IF (lwp) write (numout,*) ' in trc_init'
	227	IF (lwp) write (numout,*) ' partial step -- OK'
	228	IF (lwp) write (numout,*) ' '
	229	CALL flush(numout)
	230	# endif
	231	!
[3294]	232	IF( nn_dttrc /= 1 ) CALL trc_sub_ini ! Initialize variables for substepping passive tracers
	233	!
[5726]	234	# if defined key_debug_medusa
	235	IF (lwp) write (numout,*) '------------------------------'
	236	IF (lwp) write (numout,*) 'Jpalm - debug'
	237	IF (lwp) write (numout,*) ' in trc_init'
	238	IF (lwp) write (numout,*) ' before initiate tracer contents'
	239	IF (lwp) write (numout,*) ' '
	240	CALL flush(numout)
	241	# endif
	242	!
[3294]	243	trai(:) = 0._wp ! initial content of all tracers
[1011]	244	DO jn = 1, jptra
[3294]	245	trai(jn) = trai(jn) + glob_sum( trn(:,:,:,jn) * cvol(:,:,:) )
	246	END DO
[1011]	247
[2715]	248	IF(lwp) THEN ! control print
	249	WRITE(numout,*)
	250	WRITE(numout,*)
	251	WRITE(numout,) ' ** Total number of passive tracer jptra = ', jptra
	252	WRITE(numout,) ' ** Total volume of ocean = ', areatot
[3294]	253	WRITE(numout,) ' ** Total inital content of all tracers '
[2715]	254	WRITE(numout,*)
[5726]	255	# if defined key_debug_medusa
	256	CALL flush(numout)
	257	# endif
	258	!
	259	# if defined key_debug_medusa
	260	WRITE(numout,*) ' litle check : ', ctrcnm(1)
	261	CALL flush(numout)
	262	# endif
[3294]	263	DO jn = 1, jptra
	264	WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), trai(jn)
	265	ENDDO
	266	WRITE(numout,*)
[2715]	267	ENDIF
[3294]	268	IF(lwp) WRITE(numout,*)
[2715]	269	IF(ln_ctl) THEN ! print mean trends (used for debugging)
	270	CALL prt_ctl_trc_init
[1011]	271	WRITE(charout, FMT="('ini ')")
	272	CALL prt_ctl_trc_info( charout )
	273	CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm )
	274	ENDIF
[5726]	275
	276	IF(lwp) WRITE(numout,*)
	277	IF(lwp) WRITE(numout,*) 'trc_init : passive tracer set up completed'
	278	IF(lwp) WRITE(numout,*) '~~~~~~~'
	279	IF(lwp) CALL flush(numout)
[6230]	280	# if defined key_debug_medusa
	281	CALL trc_rst_stat
	282	CALL flush(numout)
	283	# endif
[5726]	284
[3294]	285	9000 FORMAT(' tracer nb : ',i2,' name :',a10,' initial content :',e18.10)
[2715]	286	!
[3294]	287	IF( nn_timing == 1 ) CALL timing_stop('trc_init')
	288	!
[2528]	289	END SUBROUTINE trc_init
[268]	290
[2715]	291
	292	SUBROUTINE top_alloc
	293	!!----------------------------------------------------------------------
	294	!! * ROUTINE top_alloc *
	295	!!
	296	!! ** Purpose : Allocate all the dynamic arrays of the OPA modules
	297	!!----------------------------------------------------------------------
	298	USE trcadv , ONLY: trc_adv_alloc ! TOP-related alloc routines...
	299	USE trc , ONLY: trc_alloc
	300	USE trcnxt , ONLY: trc_nxt_alloc
	301	USE trczdf , ONLY: trc_zdf_alloc
[4990]	302	USE trdtrc_oce , ONLY: trd_trc_oce_alloc
	303	#if defined key_trdmxl_trc
	304	USE trdmxl_trc , ONLY: trd_mxl_trc_alloc
[2715]	305	#endif
	306	!
	307	INTEGER :: ierr
	308	!!----------------------------------------------------------------------
	309	!
	310	ierr = trc_adv_alloc() ! Start of TOP-related alloc routines...
	311	ierr = ierr + trc_alloc ()
	312	ierr = ierr + trc_nxt_alloc()
	313	ierr = ierr + trc_zdf_alloc()
[4990]	314	ierr = ierr + trd_trc_oce_alloc()
	315	#if defined key_trdmxl_trc
	316	ierr = ierr + trd_mxl_trc_alloc()
[2715]	317	#endif
	318	!
	319	IF( lk_mpp ) CALL mpp_sum( ierr )
	320	IF( ierr /= 0 ) CALL ctl_stop( 'STOP', 'top_alloc : unable to allocate standard ocean arrays' )
	321	!
	322	END SUBROUTINE top_alloc
	323
[1011]	324	#else
	325	!!----------------------------------------------------------------------
	326	!! Empty module : No passive tracer
	327	!!----------------------------------------------------------------------
	328	CONTAINS
[2528]	329	SUBROUTINE trc_init ! Dummy routine
	330	END SUBROUTINE trc_init
[1011]	331	#endif
	332
[335]	333	!!======================================================================
[268]	334	END MODULE trcini

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

Download in other formats: