Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

trcini_medusa.F90 @ 10045

Last change on this file since 10045 was 10045, checked in by jpalmier, 6 years ago
Andrew's changes to add the OMIP double_DIC (activated with key_omip_dic)
File size: 22.7 KB

Line
1	MODULE trcini_medusa
2	!!======================================================================
3	!! * MODULE trcini_medusa *
4	!! TOP : initialisation of the MEDUSA tracers
5	!!======================================================================
6	!! History : 2.0 ! 2007-12 (C. Ethe, G. Madec) Original code
7	!! - ! 2008-08 (K. Popova) adaptation for MEDUSA
8	!! - ! 2008-11 (A. Yool) continuing adaptation for MEDUSA
9	!! - ! 2010-03 (A. Yool) updated for branch inclusion
10	!! - ! 2011-04 (A. Yool) updated for ROAM project
11	!! - ! 2018-08 (A. Yool) add OMIP preindustrial DIC
12	!!----------------------------------------------------------------------
13	#if defined key_medusa
14	!!----------------------------------------------------------------------
15	!! 'key_medusa' MEDUSA tracers
16	!!----------------------------------------------------------------------
17	!! trc_ini_medusa : MEDUSA model initialisation
18	!!----------------------------------------------------------------------
19	USE par_trc ! TOP parameters
20	USE oce_trc
21	USE trc
22	USE in_out_manager
23	!! AXY (04/11/13): add this in for initialisation stuff
24	USE iom
25	USE par_medusa
26	!! AXY (13/01/12): add this in for sediment variables
27	USE sms_medusa
28	!! AXY (04/11/13): add this in for initialisation stuff
29	USE trcsed_medusa
30	USE sbc_oce, ONLY: lk_oasis
31	USE oce, ONLY: CO2Flux_out_cpl, DMS_out_cpl, chloro_out_cpl !! Coupling variable
32
33
34	IMPLICIT NONE
35	PRIVATE
36
37	PUBLIC trc_ini_medusa ! called by trcini.F90 module
38
39	!! AXY (25/02/10)
40	LOGICAL, PUBLIC :: &
41	bocalccd = .TRUE.
42	!! JPALM (14/09/15)
43	LOGICAL, PUBLIC :: &
44	ln_ccd = .TRUE.
45
46	INTEGER :: &
47	numccd
48
49	!! AXY (25/02/10)
50	INTEGER :: &
51	numriv
52
53	!!----------------------------------------------------------------------
54	!! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)
55	!! $Id$
56	!! Software governed by the CeCILL licence (modipsl/doc/NEMO_CeCILL.txt)
57	!!----------------------------------------------------------------------
58
59	CONTAINS
60
61	SUBROUTINE trc_ini_medusa
62	!!----------------------------------------------------------------------
63	!! * trc_ini_medusa *
64	!!
65	!! ** Purpose : initialization for MEDUSA model
66	!!
67	!! ** Method : - Read the namcfc namelist and check the parameter values
68	!!----------------------------------------------------------------------
69	!!----------------------------------------------------------------------
70
71	!! vertical array index
72	INTEGER :: jk, ierr
73	!! AXY (19/07/12): added jk2 to set up friver_dep array
74	INTEGER :: jk2
75	!! AXY (19/07/12): added tfthk to set up friver_dep array
76	REAL(wp) :: fthk, tfthk
77	!! AXY (04/11/13): add in temporary variables for checks
78	REAL(wp) :: fq0, fq1, fq2
79
80	IF(lwp) WRITE(numout,*)
81	IF(lwp) WRITE(numout,*) ' trc_ini_medusa: initialisation of MEDUSA model'
82	IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
83	# if defined key_debug_medusa
84	CALL flush(numout)
85	# endif
86
87	! Allocate MEDUSA arrays
88	ierr = sms_medusa_alloc()
89	# if defined key_debug_medusa
90	IF (lwp) write (numout,*) '------------------------------'
91	IF (lwp) write (numout,*) 'Jpalm - debug'
92	IF (lwp) write (numout,*) 'in trc_ini_medusa, just after array allocate'
93	IF (lwp) write (numout,*) ' '
94	CALL flush(numout)
95	# endif
96
97	!!
98	!! AXY (19/07/12): setup array to control distribution of river nutrients
99	friver_dep(:,:) = 0.
100	DO jk = 1,jpk
101	tfthk = 0.
102	DO jk2 = 1,jriver_dep
103	fthk = e3t_1d(jk2)
104	if (jk2 .le. jk) then
105	tfthk = tfthk + fthk
106	friver_dep(jk2,jk) = fthk
107	endif
108	ENDDO
109	DO jk2 = 1,jriver_dep
110	friver_dep(jk2,jk) = friver_dep(jk2,jk) / tfthk
111	ENDDO
112	ENDDO
113	!!
114	!! Have a look at the result of this for a single depth (jriver_dep + 1)
115	IF(lwp) THEN
116	WRITE(numout,*) '=== River nutrient fraction by depth (for a water column of jpk depth)'
117	DO jk = 1,jpk
118	WRITE(numout,*) &
119	& ' cell = ', jk, ', friver_dep value = ', friver_dep(jk,jpk)
120	ENDDO
121	IF(lwp) CALL flush(numout)
122	ENDIF
123
124	#if defined key_roam
125	!! ROAM 3D and 2D carbonate system fields (calculated on first time
126	!! step, then monthly)
127	f3_pH(:,:,:) = 0.
128	f3_h2co3(:,:,:) = 0.
129	f3_hco3(:,:,:) = 0.
130	f3_co3(:,:,:) = 0.
131	f3_omcal(:,:,:) = 0.
132	f3_omarg(:,:,:) = 0.
133	!!
134	f2_ccd_cal(:,:) = 0.
135	f2_ccd_arg(:,:) = 0.
136	IF(lwp) WRITE(numout,*) ' trc_ini_medusa: carbonate fields initialised to zero'
137	#endif
138	IF(lwp) CALL flush(numout)
139
140	!!----------------------------------------------------------------------
141	!! State variable initial conditions (all mmol / m3)
142	!!----------------------------------------------------------------------
143	!!
144	!! biological and detrital components are initialised to nominal
145	!! values above 100 m depth and zero below; the latter condition
146	!! is applied since non-linear loss processes allow significant
147	!! concentrations of these components to persist at depth
148	!!
149	trn(:,:,:,jpchn) = 0.
150	trn(:,:,:,jpchd) = 0.
151	trn(:,:,:,jpphn) = 0.
152	trn(:,:,:,jpphd) = 0.
153	trn(:,:,:,jppds) = 0.
154	trn(:,:,:,jpzmi) = 0.
155	trn(:,:,:,jpzme) = 0.
156	trn(:,:,:,jpdet) = 0.
157	!!
158	DO jk = 1,13
159	!! non-diatom chlorophyll (nominal)
160	trn(:,:,jk,jpchn) = 0.01
161	!!
162	!! diatom chlorophyll (nominal)
163	trn(:,:,jk,jpchd) = 0.01
164	!!
165	!! non-diatom (nominal)
166	trn(:,:,jk,jpphn) = 0.01
167	!!
168	!! diatom (nominal)
169	trn(:,:,jk,jpphd) = 0.01
170	!!
171	!! diatom silicon (nominal)
172	trn(:,:,jk,jppds) = 0.01
173	!!
174	!! microzooplankton (nominal)
175	trn(:,:,jk,jpzmi) = 0.01
176	!!
177	!! mesozooplankton (nominal)
178	trn(:,:,jk,jpzme) = 0.01
179	!!
180	!! detrital nitrogen (nominal)
181	trn(:,:,jk,jpdet) = 0.01
182	ENDDO
183	!!
184	!! dissolved inorganic nitrogen (nominal average value; typically initialised from climatology)
185	trn(:,:,:,jpdin) = 30.
186	!!
187	!! dissolved silicic acid (nominal average value; typically initialised from climatology)
188	trn(:,:,:,jpsil) = 90.
189	!!
190	!! dissolved "total" iron (nominal; typically initialised from model-derived climatology)
191	trn(:,:,:,jpfer) = 1.0e-4 !! = 0.1 umol Fe / m3
192	!!
193	IF(lwp) WRITE(numout,*) ' trc_ini_medusa: MEDUSA-1 fields initialised to defaults'
194	# if defined key_roam
195	!!
196	!! detrital carbon (nominal)
197	trn(:,:,:,jpdtc) = 0.
198	DO jk = 1,13
199	trn(:,:,jk,jpdtc) = 0.06625
200	ENDDO
201	!!
202	!! dissolved inorganic carbon (DIC) (nominal average value; typically initialised from climatology)
203	trn(:,:,:,jpdic) = 2330.
204	!!
205	!! total alkalinity (nominal average value; typically initialised from climatology)
206	trn(:,:,:,jpalk) = 2450.
207	!!
208	!! dissolved oxygen (nominal average value; typically initialised from climatology)
209	trn(:,:,:,jpoxy) = 175.
210	# if defined key_omip_dic
211	!!
212	!! OMIP preindustrial DIC (nominal average value; typically initialised from climatology)
213	trn(:,:,:,jpomd) = 2330.
214	# endif
215	!!
216	IF(lwp) WRITE(numout,*) ' trc_ini_medusa: MEDUSA-2 fields initialised to defaults'
217	# endif
218	IF(lwp) CALL flush(numout)
219
220	!!----------------------------------------------------------------------
221	!! Sediment pools initial conditions (all mmol / m2)
222	!!----------------------------------------------------------------------
223	!!
224	!! these pools store biogenic material that has sunk to the seabed,
225	!! and act as a temporary reservoir
226	zb_sed_n(:,:) = 0.0 !! organic N
227	zn_sed_n(:,:) = 0.0
228	za_sed_n(:,:) = 0.0
229	zb_sed_fe(:,:) = 0.0 !! organic Fe
230	zn_sed_fe(:,:) = 0.0
231	za_sed_fe(:,:) = 0.0
232	zb_sed_si(:,:) = 0.0 !! inorganic Si
233	zn_sed_si(:,:) = 0.0
234	za_sed_si(:,:) = 0.0
235	zb_sed_c(:,:) = 0.0 !! organic C
236	zn_sed_c(:,:) = 0.0
237	za_sed_c(:,:) = 0.0
238	zb_sed_ca(:,:) = 0.0 !! inorganic C
239	zn_sed_ca(:,:) = 0.0
240	za_sed_ca(:,:) = 0.0
241	!!
242	IF(lwp) WRITE(numout,*) ' trc_ini_medusa: benthic fields initialised to zero'
243	IF(lwp) CALL flush(numout)
244
245	!!----------------------------------------------------------------------
246	!! Averaged properties for DMS calculations (various units)
247	!!----------------------------------------------------------------------
248	!!
249	!! these store temporally averaged properties for DMS calculations (AXY, 07/07/15)
250	zb_dms_chn(:,:) = 0.0 !! CHN
251	zn_dms_chn(:,:) = 0.0
252	za_dms_chn(:,:) = 0.0
253	zb_dms_chd(:,:) = 0.0 !! CHD
254	zn_dms_chd(:,:) = 0.0
255	za_dms_chd(:,:) = 0.0
256	zb_dms_mld(:,:) = 0.0 !! MLD
257	zn_dms_mld(:,:) = 0.0
258	za_dms_mld(:,:) = 0.0
259	zb_dms_qsr(:,:) = 0.0 !! QSR
260	zn_dms_qsr(:,:) = 0.0
261	za_dms_qsr(:,:) = 0.0
262	zb_dms_din(:,:) = 0.0 !! DIN
263	zn_dms_din(:,:) = 0.0
264	za_dms_din(:,:) = 0.0
265	!!
266	IF(lwp) WRITE(numout,*) ' trc_ini_medusa: average fields for DMS initialised to zero'
267	IF(lwp) CALL flush(numout)
268	!!
269	!!---------------------------------------------------------------------
270	!!JPALM (14-06-2016): init dms and co2 flux for coupling with atm (UKESM)
271	!!---------------------------------------------------------------------
272	!!
273	zb_co2_flx(:,:) = 0.0 !! CO2 flx
274	zn_co2_flx(:,:) = 0.0
275	za_co2_flx(:,:) = 0.0
276	zb_dms_srf(:,:) = 0.0 !! DMS srf
277	zn_dms_srf(:,:) = 0.0
278	za_dms_srf(:,:) = 0.0
279	zn_chl_srf(:,:) = 2.0E-8 !! Chl cpl - set first as surf
280	!!
281	IF(lwp) WRITE(numout,*) ' trc_ini_medusa: DMS and CO2 flux (UKESM) initialised to zero'
282	IF(lwp) CALL flush(numout)
283	IF (lk_oasis) THEN
284	CO2Flux_out_cpl(:,:) = zn_co2_flx(:,:) !! Coupling variable
285	DMS_out_cpl(:,:) = zn_dms_srf(:,:) !! Coupling variable
286	chloro_out_cpl(:,:) = zn_chl_srf(:,:) * scl_chl !! Coupling variable
287	END IF
288	!!
289	!!----------------------------------------------------------------------
290	!! AXY (04/11/13): initialise fields previously done by trc_sed_medusa
291	!!----------------------------------------------------------------------
292	!!
293	IF(lwp) WRITE(numout,*) ' trc_ini_medusa: initialising dust deposition fields'
294	CALL trc_sed_medusa_sbc( nit000 )
295	!!
296	IF(lwp) WRITE(numout,*) ' trc_ini_medusa: initialising ocean CCD array'
297	CALL trc_ini_medusa_ccd( nit000 )
298	fq0 = MINVAL(ocal_ccd(:,:))
299	fq1 = MAXVAL(ocal_ccd(:,:))
300	if (lwp) write (numout,'(a,f10.3,a,f10.3)') &
301	& 'CCD: min ', fq0, ' max ', fq1
302	!!
303	IF(lwp) WRITE(numout,*) ' trc_ini_medusa: initialising riverine nutrient arrays'
304	riv_n(:,:) = 0.0
305	riv_si(:,:) = 0.0
306	riv_c(:,:) = 0.0
307	riv_alk(:,:) = 0.0
308	!!
309	CALL trc_ini_medusa_river( nit000 )
310	fq0 = MINVAL(riv_n(:,:))
311	fq1 = MAXVAL(riv_n(:,:))
312	if (lwp) write (numout,'(a,f10.3,a,f10.3)') &
313	& 'RIV_N: min ', fq0, ' max ', fq1
314	fq0 = MINVAL(riv_si(:,:))
315	fq1 = MAXVAL(riv_si(:,:))
316	if (lwp) write (numout,'(a,f10.3,a,f10.3)') &
317	& 'RIV_SI: min ', fq0, ' max ', fq1
318	fq0 = MINVAL(riv_c(:,:))
319	fq1 = MAXVAL(riv_c(:,:))
320	if (lwp) write (numout,'(a,f10.3,a,f10.3)') &
321	& 'RIV_C: min ', fq0, ' max ', fq1
322	fq0 = MINVAL(riv_alk(:,:))
323	fq1 = MAXVAL(riv_alk(:,:))
324	if (lwp) write (numout,'(a,f10.3,a,f10.3)') &
325	& 'RIV_ALK: min ', fq0, ' max ', fq1
326	IF(lwp) CALL flush(numout)
327
328	IF(lwp) WRITE(numout,*)
329	IF(lwp) WRITE(numout,*) ' trc_ini_medusa: MEDUSA initialised'
330	IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~'
331	IF(lwp) CALL flush(numout)
332	!!
333	!!----------------------------------------------------------------------
334	!! JPALM (23-01-2017): new way to initialize CO2-atm for cmip6
335	!! initially done in trcsms_medusa
336	!!----------------------------------------------------------------------
337	!!
338	IF( ( .NOT.lk_oasis ) .AND. ( .NOT.lk_pi_co2 ) ) THEN
339	IF(lwp) WRITE(numout,*) ' trc_ini_medusa: initialisating atm CO2 record'
340	CALL trc_ini_medusa_co2atm
341	ENDIF
342
343	END SUBROUTINE trc_ini_medusa
344
345	!! ======================================================================
346	!! ======================================================================
347	!! ======================================================================
348
349	!! AXY (25/02/10)
350	SUBROUTINE trc_ini_medusa_ccd(kt)
351
352	!!----------------------------------------------------------------------
353	!! * ROUTINE trc_ini_medusa_ccd *
354	!!
355	!! ** Purpose : Read CCD field
356	!!
357	!! ** Method : Read the file
358	!!
359	!! ** input : external netcdf files
360	!!
361	!!----------------------------------------------------------------------
362	!! * arguments
363	INTEGER, INTENT( in ) :: kt ! ocean time step
364
365	!!---------------------------------------------------------------------
366
367	!! Open the file
368	!! -------------
369	!!
370	!!!! JPALM -- 14-09-2015 --
371	!!!! -- to test on ORCA2 with Christian, no file available, so initiate to 0
372	IF (ln_ccd) THEN
373	IF(lwp) WRITE(numout,*) ' '
374	IF(lwp) WRITE(numout,) ' *** Routine trc_ini_medusa_ccd'
375	CALL iom_open ( 'ccd_ocal_nemo.nc', numccd )
376	IF(lwp) WRITE(numout,) ' *** trc_ini_medusa_ccd: ccd_ocal_nemo.nc opened'
377
378	!! Read the data
379	!! -------------
380	!!
381	CALL iom_get ( numccd, jpdom_data, 'OCAL_CCD', ocal_ccd )
382	IF(lwp) WRITE(numout,) ' *** trc_ini_medusa_ccd: data read'
383
384	!! Close the file
385	!! --------------
386	!!
387	CALL iom_close ( numccd )
388	IF(lwp) WRITE(numout,) ' *** trc_ini_medusa_ccd: ccd_ocal_nemo.nc closed'
389	IF(lwp) CALL flush(numout)
390	ELSE
391	IF(lwp) WRITE(numout,*) ' '
392	IF(lwp) WRITE(numout,) ' *** Routine trc_ini_medusa_ccd'
393	IF(lwp) WRITE(numout,) ' *** trc_ini_medusa_ccd: do not read ccd_ocal_nemo.nc'
394	IF(lwp) WRITE(numout,) ' *** ln_ccd = FALSE and ocal_ccd = 0.0 ---'
395	ocal_ccd(:,:) = 0.0
396	ENDIF
397
398	END SUBROUTINE trc_ini_medusa_ccd
399
400	!! ======================================================================
401	!! ======================================================================
402	!! ======================================================================
403
404	!! AXY (26/01/12)
405	SUBROUTINE trc_ini_medusa_river(kt)
406
407	!!----------------------------------------------------------------------
408	!! * ROUTINE trc_ini_medusa_river *
409	!!
410	!! ** Purpose : Read riverine nutrient fields
411	!!
412	!! ** Method : Read the file
413	!!
414	!! ** input : external netcdf files
415	!!
416	!!----------------------------------------------------------------------
417	!! * arguments
418	INTEGER, INTENT( in ) :: kt ! ocean time step
419
420	!!---------------------------------------------------------------------
421
422	IF(lwp) THEN
423	WRITE(numout,*) ' '
424	WRITE(numout,) ' *** Routine trc_ini_medusa_river'
425	WRITE(numout,*) ' '
426	ENDIF
427
428	!! Open and read the files
429	!! -----------------------
430	!!
431	if (jriver_n.gt.0) then
432	if (jriver_n.eq.1) CALL iom_open ( 'river_N_conc_orca100.nc', numriv )
433	if (jriver_n.eq.2) CALL iom_open ( 'river_N_flux_orca100.nc', numriv )
434	CALL iom_get ( numriv, jpdom_data, 'RIV_N', riv_n )
435	IF(lwp) THEN
436	if (jriver_n.eq.1) WRITE(numout,) ' *** trc_ini_medusa_river: N CONC data read'
437	if (jriver_n.eq.2) WRITE(numout,) ' *** trc_ini_medusa_river: N FLUX data read'
438	ENDIF
439	CALL iom_close ( numriv )
440	IF(lwp) WRITE(numout,) ' *** trc_ini_medusa_river: river N file closed'
441	else
442	IF(lwp) THEN
443	WRITE(numout,) ' *** trc_ini_medusa_river: N data NOT read'
444	ENDIF
445	endif
446	!!
447	if (jriver_si.gt.0) then
448	if (jriver_si.eq.1) CALL iom_open ( 'river_Si_conc_orca100.nc', numriv )
449	if (jriver_si.eq.2) CALL iom_open ( 'river_Si_flux_orca100.nc', numriv )
450	CALL iom_get ( numriv, jpdom_data, 'RIV_SI', riv_si )
451	IF(lwp) THEN
452	if (jriver_si.eq.1) WRITE(numout,) ' *** trc_ini_medusa_river: Si CONC data read'
453	if (jriver_si.eq.2) WRITE(numout,) ' *** trc_ini_medusa_river: Si FLUX data read'
454	ENDIF
455	CALL iom_close ( numriv )
456	IF(lwp) WRITE(numout,) ' *** trc_ini_medusa_river: river Si file closed'
457	else
458	IF(lwp) THEN
459	WRITE(numout,) ' *** trc_ini_medusa_river: Si data NOT read'
460	ENDIF
461	endif
462	!!
463	if (jriver_c.gt.0) then
464	if (jriver_c.eq.1) CALL iom_open ( 'river_C_conc_orca100.nc', numriv )
465	if (jriver_c.eq.2) CALL iom_open ( 'river_C_flux_orca100.nc', numriv )
466	CALL iom_get ( numriv, jpdom_data, 'RIV_C', riv_c )
467	IF(lwp) THEN
468	if (jriver_c.eq.1) WRITE(numout,) ' *** trc_ini_medusa_river: C CONC data read'
469	if (jriver_c.eq.2) WRITE(numout,) ' *** trc_ini_medusa_river: C FLUX data read'
470	ENDIF
471	CALL iom_close ( numriv )
472	IF(lwp) WRITE(numout,) ' *** trc_ini_medusa_river: river C file closed'
473	else
474	IF(lwp) THEN
475	WRITE(numout,) ' *** trc_ini_medusa_river: C data NOT read'
476	ENDIF
477	endif
478	!!
479	if (jriver_alk.gt.0) then
480	if (jriver_alk.eq.1) CALL iom_open ( 'river_alk_conc_orca100.nc', numriv )
481	if (jriver_alk.eq.2) CALL iom_open ( 'river_alk_flux_orca100.nc', numriv )
482	CALL iom_get ( numriv, jpdom_data, 'RIV_ALK', riv_alk )
483	IF(lwp) THEN
484	if (jriver_alk.eq.1) WRITE(numout,) ' *** trc_ini_medusa_river: alkalinity CONC data read'
485	if (jriver_alk.eq.2) WRITE(numout,) ' *** trc_ini_medusa_river: alkalinity FLUX data read'
486	ENDIF
487	CALL iom_close ( numriv )
488	IF(lwp) WRITE(numout,) ' *** trc_ini_medusa_river: river alkalinity file closed'
489	else
490	IF(lwp) THEN
491	WRITE(numout,) ' *** trc_ini_medusa_river: alkalinity data NOT read'
492	ENDIF
493	endif
494	IF(lwp) CALL flush(numout)
495
496	END SUBROUTINE trc_ini_medusa_river
497
498	SUBROUTINE trc_ini_medusa_co2atm
499	!!----------------------------------------------------------------------
500	!! * trc_ini_medusa_co2atm *
501	!!
502	!! ** Purpose : initialization atmospheric co2 record
503	!!
504	!! ** Method : - Read the xco2 file
505	!!----------------------------------------------------------------------
506	INTEGER :: jn, jm, io, ierr, inum, iostatus
507	INTEGER, PARAMETER :: iskip = 4 ! number of 1st descriptor lines
508	REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: zyy !: xCO2 record years
509	CHARACTER (len=10), PARAMETER :: clname = 'xco2.atm' !! atm CO2 record file
510	!!----------------------------------------------------------------------
511
512	IF(lwp) WRITE(numout,*)
513	IF(lwp) WRITE(numout,*) ' trc_ini_medusa_co2atm: initialisation of atm CO2 historical record'
514	IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~'
515
516
517	IF(lwp) WRITE(numout,*) 'read of formatted file xco2.atm'
518
519	CALL ctl_opn( inum, clname, 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )
520	!!!
521	! -Compute the number of year in the file
522	! -File starts in co2_yinit, jn represents the record number in the file.
523	! -Remove the file head (iskip lines) to jn
524	! -The year is jn + yinit - 1
525	!! Determine the number of lines in xCO2 input file
526	iostatus = 0
527	jn = 1
528	DO WHILE ( iostatus == 0 )
529	READ(inum,'(1x)', IOSTAT=iostatus, END=100)
530	jn = jn + 1
531	ENDDO
532	IF( iostatus .NE. 0 ) THEN
533	!! Error while reading xCO2 input file
534	CALL ctl_stop('trc_ini_medusa_co2atm: &
535	& Error on the 1st reading of xco2.atm')
536	RETURN
537	ENDIF
538	100 co2_rec = jn - 1 - iskip
539	IF ( lwp) WRITE(numout,*) ' ', co2_rec ,' years read in the file'
540	! ! Allocate CO2 hist arrays
541	ierr = 0
542	ALLOCATE( hist_pco2(co2_rec),zyy(co2_rec), STAT=ierr )
543	IF( ierr > 0 ) THEN
544	CALL ctl_stop( 'trc_ini_medusa_co2atm: unable to allocate array' )
545	RETURN
546	ENDIF
547
548	REWIND(inum)
549
550	DO jm = 1, iskip ! Skip over 1st six descriptor lines
551	READ(inum,'(1x)')
552	END DO
553	! file starts in 1931 do jn represent the year in the century.jhh
554	! Read file till the end
555	! allocate start and end year of the file
556	DO jn = 1, co2_rec
557	READ(inum,'(F6.1,F12.7)', IOSTAT=io) zyy(jn), hist_pco2(jn)
558	IF( io .NE. 0 ) THEN
559	!! Error while reading xCO2 input file
560	CALL ctl_stop('trc_ini_medusa_co2atm: &
561	& Error on the 2nd reading of xco2.atm')
562	RETURN
563	ENDIF
564
565	IF(jn==1) co2_yinit = zyy(jn)
566	END DO
567	co2_yend = co2_yinit + real(co2_rec) - 1.
568
569	IF(lwp) THEN ! Control print
570	WRITE(numout,*)
571	WRITE(numout,*) 'CO2 hist start year: ', co2_yinit
572	WRITE(numout,*) 'CO2 hist end year: ', co2_yend
573	WRITE(numout,*) ' Year xCO2 atm '
574	DO jn = 1, co2_rec
575	WRITE(numout, '(F6.1,F12.7)') zyy(jn), hist_pco2(jn)
576	END DO
577	ENDIF
578
579	END SUBROUTINE trc_ini_medusa_co2atm
580
581
582	#else
583	!!----------------------------------------------------------------------
584	!! Dummy module No MEDUSA model
585	!!----------------------------------------------------------------------
586	CONTAINS
587	SUBROUTINE trc_ini_medusa ! Empty routine
588	END SUBROUTINE trc_ini_medusa
589	#endif
590
591	!!======================================================================
592	END MODULE trcini_medusa

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

New URL for NEMO forge! http://forge.nemo-ocean.eu

Context Navigation

source: branches/NERC/dev_r5518_GO6_under_ice_relax/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcini_medusa.F90 @ 10045

Download in other formats: