Context Navigation

source: CONFIG/UNIFORM/v7/IPSLCM7/SOURCES/NEMO/trcstp.F90 @ 6883

Last change on this file since 6883 was 6883, checked in by cetlod, 3 months ago
CM7_work : Bugfix to ensure NEMO-PISCES restartability
File size: 13.3 KB

Line
1	MODULE trcstp
2	!!======================================================================
3	!! * MODULE trcstp *
4	!! Time-stepping : time loop of opa for passive tracer
5	!!======================================================================
6	!! History : 1.0 ! 2004-03 (C. Ethe) Original
7	!! 4.1 ! 2019-08 (A. Coward, D. Storkey) rewrite in preparation for new timestepping scheme
8	!!----------------------------------------------------------------------
9	#if defined key_top
10	!!----------------------------------------------------------------------
11	!! trc_stp : passive tracer system time-stepping
12	!!----------------------------------------------------------------------
13	USE par_trc ! need jptra, number of passive tracers
14	USE oce_trc ! ocean dynamics and active tracers variables
15	USE sbc_oce
16	USE trc
17	USE trcbc ! Tracers boundary condtions ( trc_bc routine)
18	USE trcais ! Antarctic Ice Sheet tracers (trc_ais routine)
19	USE trctrp ! passive tracers transport
20	USE trcsms ! passive tracers sources and sinks
21	USE trcwri
22	USE trcrst
23	USE trdtrc_oce
24	USE trdmxl_trc
25	USE sms_pisces, ONLY : ln_check_mass
26	!
27	USE prtctl ! Print control for debbuging
28	USE iom !
29	USE in_out_manager !
30
31	IMPLICIT NONE
32	PRIVATE
33
34	PUBLIC trc_stp ! called by step
35
36	LOGICAL :: llnew ! ???
37	REAL(wp) :: rdt_sampl ! ???
38	INTEGER :: nb_rec_per_day, ktdcy ! ???
39	REAL(wp) :: rsecfst, rseclast ! ???
40	REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE :: qsr_arr ! save qsr during TOP time-step
41
42	# include "domzgr_substitute.h90"
43	!!----------------------------------------------------------------------
44	!! NEMO/TOP 4.0 , NEMO Consortium (2018)
45	!! $Id: trcstp.F90 15446 2021-10-26 14:34:38Z cetlod $
46	!! Software governed by the CeCILL license (see ./LICENSE)
47	!!----------------------------------------------------------------------
48	CONTAINS
49
50	SUBROUTINE trc_stp( kt, Kbb, Kmm, Krhs, Kaa )
51	!!-------------------------------------------------------------------
52	!! * ROUTINE trc_stp *
53	!!
54	!! ** Purpose : Time loop of opa for passive tracer
55	!!
56	!! ** Method : Compute the passive tracers trends
57	!! Update the passive tracers
58	!!-------------------------------------------------------------------
59	INTEGER, INTENT( in ) :: kt ! ocean time-step index
60	INTEGER, INTENT( in ) :: Kbb, Kmm, Krhs, Kaa ! time level indices
61	!
62	INTEGER :: jk, jn ! dummy loop indices
63	INTEGER :: ibb ! local time-level index
64	REAL(wp):: ztrai ! local scalar
65	LOGICAL :: ll_trcstat, ll_trcpis ! local logical
66	CHARACTER (len=25) :: charout !
67	!!-------------------------------------------------------------------
68	!
69	IF( ln_timing ) CALL timing_start('trc_stp')
70	!
71	ibb = Kbb ! default "before" time-level index
72	IF( l_1st_euler .OR. ln_top_euler ) THEN ! at nittrc000
73	rDt_trc = rn_Dt ! = rn_Dt (use or restarting with Euler time stepping)
74	ibb = Kmm ! time-level index used to substitute the "before" with the "now" time level
75	ELSEIF( kt <= nittrc000 + 1 ) THEN ! at nittrc000 or nittrc000+1
76	rDt_trc = 2. * rn_Dt ! = 2 rn_Dt (leapfrog)
77	ENDIF
78	!
79	ll_trcstat = ( sn_cfctl%l_trcstat ) .AND. &
80	& ( ( MOD( kt, sn_cfctl%ptimincr ) == 0 ) .OR. ( kt == nitend ) )
81
82	IF( kt == nittrc000 ) CALL trc_stp_ctl ! control
83	IF( kt == nittrc000 .AND. lk_trdmxl_trc ) CALL trd_mxl_trc_init ! trends: Mixed-layer
84	!
85	IF( .NOT.ln_linssh ) THEN ! update ocean volume due to ssh temporal evolution
86	DO jk = 1, jpk
87	cvol(:,:,jk) = e1e2t(:,:) * e3t(:,:,jk,Kmm) * tmask(:,:,jk)
88	END DO
89	IF( ln_pisces ) THEN
90	IF ( iom_use( "pno3tot" ) .OR. iom_use( "ppo4tot" ) .OR. iom_use( "psiltot" ) &
91	& .OR. iom_use( "palktot" ) .OR. iom_use( "pfertot" ) ) &
92	& ll_trcpis = .TRUE.
93	ELSE
94	ll_trcpis = .FALSE.
95	ENDIF
96	IF ( ll_trcstat .OR. kt == nitrst .OR. ( ln_check_mass .AND. kt == nitend ) .OR. ll_trcpis ) &
97	& areatot = glob_sum( 'trcstp', cvol(:,:,:) )
98	ENDIF
99	!
100	IF( l_trcdm2dc ) CALL trc_mean_qsr( kt )
101	!
102	!
103	IF(sn_cfctl%l_prttrc) THEN
104	WRITE(charout,FMT="('kt =', I4,' d/m/y =',I2,I2,I4)") kt, nday, nmonth, nyear
105	CALL prt_ctl_info( charout, cdcomp = 'top' )
106	ENDIF
107	!
108	tr(:,:,:,:,Krhs) = 0._wp
109	!
110	CALL trc_rst_opn ( kt ) ! Open tracer restart file
111	IF( lrst_trc ) CALL trc_rst_cal ( kt, 'WRITE' ) ! calendar
112	CALL trc_wri ( kt, Kmm ) ! output of passive tracers with iom I/O manager
113	IF( ln_trcbc .AND. lltrcbc ) CALL trc_bc ( kt, Kmm, tr, Krhs ) ! tracers: surface and lateral Boundary Conditions
114	IF( ln_trcais ) CALL trc_ais( kt, Kmm, tr, Krhs ) ! tracers from Antarctic Ice Sheet (icb, isf)
115	CALL trc_sms ( kt, ibb, Kmm, Krhs ) ! tracers: sinks and sources
116	#if ! defined key_sed_off
117	CALL trc_trp ( kt, ibb, Kmm, Krhs, Kaa ) ! transport of passive tracers
118	#endif
119	!
120	! Note passive tracers have been time-filtered in trc_trp but the time level
121	! indices will not be swapped until after tra_atf/dyn_atf/ssh_atf in stp. Subsequent calls here
122	! anticipate this update which will be: Nrhs= Nbb ; Nbb = Nnn ; Nnn = Naa ; Naa = Nrhs
123	! and use the filtered levels explicitly.
124	!
125	IF( kt == nittrc000 ) THEN
126	CALL iom_close( numrtr ) ! close input tracer restart file
127	IF(lrxios) CALL iom_context_finalize( cr_toprst_cxt )
128	IF(lwm) CALL FLUSH( numont ) ! flush namelist output
129	ENDIF
130	IF( lk_trdmxl_trc ) CALL trd_mxl_trc ( kt, Kaa ) ! trends: Mixed-layer
131	!
132	IF( ln_top_euler ) THEN
133	! For Euler timestepping for TOP we need to copy the "after" to the "now" fields
134	! here then after the (leapfrog) swapping of the time-level indices in OCE/step.F90 we have
135	! "before" fields = "now" fields.
136	tr(:,:,:,:,Kmm) = tr(:,:,:,:,Kaa)
137	ENDIF
138	!
139	IF( lrst_trc ) CALL trc_rst_wri( kt, Kmm, Kaa, ibb ) ! write tracer restart file
140	!
141	IF (ll_trcstat) THEN
142	ztrai = 0._wp ! content of all tracers
143	DO jn = 1, jptra
144	ztrai = ztrai + glob_sum( 'trcstp', tr(:,:,:,jn,Kaa) * cvol(:,:,:) )
145	END DO
146	IF( lwm ) WRITE(numstr,9300) kt, ztrai / areatot
147	ENDIF
148	9300 FORMAT(i10,D23.16)
149	!
150	IF( ln_timing ) CALL timing_stop('trc_stp')
151	!
152	END SUBROUTINE trc_stp
153
154
155	SUBROUTINE trc_stp_ctl
156	!!----------------------------------------------------------------------
157	!! * ROUTINE trc_stp_ctl *
158	!!----------------------------------------------------------------------
159	!
160	! Define logical parameter ton control dirunal cycle in TOP
161	l_trcdm2dc = ( ln_trcdc2dm .AND. .NOT. ln_dm2dc )
162	!
163	IF( l_trcdm2dc .AND. lwp ) CALL ctl_warn( 'Coupling with passive tracers and used of diurnal cycle.', &
164	& 'Computation of a daily mean shortwave for some biogeochemical models ' )
165	!
166	END SUBROUTINE trc_stp_ctl
167
168
169	SUBROUTINE trc_mean_qsr( kt )
170	!!----------------------------------------------------------------------
171	!! * ROUTINE trc_mean_qsr *
172	!!
173	!! ** Purpose : Compute daily mean qsr for biogeochemical model in case
174	!! of diurnal cycle
175	!!
176	!! ** Method : store in TOP the qsr every hour ( or every time-step if the latter
177	!! is greater than 1 hour ) and then, compute the mean with
178	!! a moving average over 24 hours.
179	!! In coupled mode, the sampling is done at every coupling frequency
180	!!----------------------------------------------------------------------
181	INTEGER, INTENT( in ) :: kt ! ocean time-step index
182	!
183	INTEGER :: jn ! dummy loop indices
184	REAL(wp) :: zkt, zrec ! local scalars
185	CHARACTER(len=1) :: cl1 ! 1 character
186	CHARACTER(len=2) :: cl2 ! 2 characters
187	!!----------------------------------------------------------------------
188	!
189	IF( ln_timing ) CALL timing_start('trc_mean_qsr')
190	!
191	IF( kt == nittrc000 ) THEN
192	!
193	rdt_sampl = REAL( ncpl_qsr_freq )
194	nb_rec_per_day = INT( rday / ncpl_qsr_freq )
195	!
196	IF(lwp) THEN
197	WRITE(numout,*)
198	WRITE(numout,*) ' Sampling frequency dt = ', rdt_sampl, 's',' Number of sampling per day nrec = ', nb_rec_per_day
199	WRITE(numout,*)
200	ENDIF
201	!
202	ALLOCATE( qsr_arr(jpi,jpj,nb_rec_per_day ) )
203	!
204	! !* Restart: read in restart file
205	IF( ln_rsttr .AND. nn_rsttr /= 0 .AND. iom_varid( numrtr, 'qsr_mean' , ldstop = .FALSE. ) > 0 &
206	& .AND. iom_varid( numrtr, 'qsr_arr_1', ldstop = .FALSE. ) > 0 &
207	& .AND. iom_varid( numrtr, 'ktdcy' , ldstop = .FALSE. ) > 0 &
208	& .AND. iom_varid( numrtr, 'nrdcy' , ldstop = .FALSE. ) > 0 ) THEN
209	CALL iom_get( numrtr, 'ktdcy', zkt )
210	rsecfst = INT( zkt ) * rn_Dt
211	IF(lwp) WRITE(numout,*) 'trc_qsr_mean: qsr_mean read in the restart file at time-step rsecfst =', rsecfst, ' s '
212	CALL iom_get( numrtr, jpdom_auto, 'qsr_mean', qsr_mean ) ! A mean of qsr
213	CALL iom_get( numrtr, 'nrdcy', zrec ) ! Number of record per days
214	IF( INT( zrec ) == nb_rec_per_day ) THEN
215	DO jn = 1, nb_rec_per_day
216	IF( jn <= 9 ) THEN
217	WRITE(cl1,'(i1)') jn
218	CALL iom_get( numrtr, jpdom_auto, 'qsr_arr_'//cl1, qsr_arr(:,:,jn) ) ! A mean of qsr
219	ELSE
220	WRITE(cl2,'(i2.2)') jn
221	CALL iom_get( numrtr, jpdom_auto, 'qsr_arr_'//cl2, qsr_arr(:,:,jn) ) ! A mean of qsr
222	ENDIF
223	END DO
224	ELSE
225	DO jn = 1, nb_rec_per_day
226	qsr_arr(:,:,jn) = qsr_mean(:,:)
227	ENDDO
228	ENDIF
229	ELSE !* no restart: set from nit000 values
230	IF(lwp) WRITE(numout,*) 'trc_qsr_mean: qsr_mean set to nit000 values'
231	rsecfst = kt * rn_Dt
232	!
233	qsr_mean(:,:) = qsr(:,:)
234	DO jn = 1, nb_rec_per_day
235	qsr_arr(:,:,jn) = qsr_mean(:,:)
236	END DO
237	ENDIF
238	!
239	ENDIF
240	!
241	rseclast = kt * rn_Dt
242	!
243	llnew = ( rseclast - rsecfst ) .ge. rdt_sampl ! new shortwave to store
244	IF( llnew ) THEN
245	ktdcy = kt
246	IF( lwp .AND. kt < nittrc000 + 100 ) WRITE(numout,*) ' New shortwave to sample for TOP at time kt = ', ktdcy, &
247	& ' time = ', rseclast/3600.,'hours '
248	rsecfst = rseclast
249	DO jn = 1, nb_rec_per_day - 1
250	qsr_arr(:,:,jn) = qsr_arr(:,:,jn+1)
251	ENDDO
252	qsr_arr (:,:,nb_rec_per_day) = qsr(:,:)
253	qsr_mean(:,: ) = SUM( qsr_arr(:,:,:), 3 ) / nb_rec_per_day
254	ENDIF
255	!
256	IF( lrst_trc ) THEN !* Write the mean of qsr in restart file
257	IF(lwp) WRITE(numout,*)
258	IF(lwp) WRITE(numout,*) 'trc_mean_qsr : write qsr_mean in restart file kt =', kt
259	IF(lwp) WRITE(numout,*) '~~~~~~~'
260	zkt = REAL( ktdcy, wp )
261	zrec = REAL( nb_rec_per_day, wp )
262	CALL iom_rstput( kt, nitrst, numrtw, 'ktdcy', zkt )
263	CALL iom_rstput( kt, nitrst, numrtw, 'nrdcy', zrec )
264	DO jn = 1, nb_rec_per_day
265	IF( jn <= 9 ) THEN
266	WRITE(cl1,'(i1)') jn
267	CALL iom_rstput( kt, nitrst, numrtw, 'qsr_arr_'//cl1, qsr_arr(:,:,jn) )
268	ELSE
269	WRITE(cl2,'(i2.2)') jn
270	CALL iom_rstput( kt, nitrst, numrtw, 'qsr_arr_'//cl2, qsr_arr(:,:,jn) )
271	ENDIF
272	END DO
273	CALL iom_rstput( kt, nitrst, numrtw, 'qsr_mean', qsr_mean(:,:) )
274	ENDIF
275	!
276	IF( ln_timing ) CALL timing_stop('trc_mean_qsr')
277	!
278	END SUBROUTINE trc_mean_qsr
279
280	#else
281	!!----------------------------------------------------------------------
282	!! Default key NO passive tracers
283	!!----------------------------------------------------------------------
284	CONTAINS
285	SUBROUTINE trc_stp( kt ) ! Empty routine
286	WRITE(,) 'trc_stp: You should not have seen this print! error?', kt
287	END SUBROUTINE trc_stp
288	#endif
289
290	!!======================================================================
291	END MODULE trcstp

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

Download in other formats: