Changeset 8657
- Timestamp:
- 2017-10-25T14:46:18+02:00 (7 years ago)
- Location:
- branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM
- Files:
-
- 2 deleted
- 39 edited
- 18 copied
Legend:
- Unmodified
- Added
- Removed
-
branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/CONFIG/SHARED/field_def_bgc.xml
r8308 r8657 448 448 <field id= "DMS_HALL" long_name="DMS Surface Concentration, Halloran" unit="nmol/L" /> 449 449 <field id= "DMS_ANDM" long_name="DMS Surface Concentration, Anderson modif" unit="nmol/L" /> 450 <field id= "CHL_MLD" long_name="MLD averaged Chlorophyll" unit="mg Chl/m3" /> 450 451 <field id= "ATM_XCO2" long_name="Atmospheric xCO2" unit="ppm" /> 451 452 <field id= "OCN_FCO2" long_name="Surface ocean fCO2" unit="uatm" /> … … 784 785 <field field_ref= "CO2STARAIR" name="CO2STARAIR" /> 785 786 <field field_ref= "OCN_DPCO2" name="OCN_DPCO2" /> 787 <field field_ref= "CHL_MLD" name="CHL_MLD" /> 786 788 </field_group> 787 789 -
branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/CONFIG/SHARED/namelist_ref
r8280 r8657 971 971 ! = 0 constant 10 m length scale 972 972 ! = 1 0.5m at the equator to 30m poleward of 40 degrees 973 rn_c = 0.8 ! Default value only used when nn_htau = 2 (typically never!) 973 974 / 974 975 !------------------------------------------------------------------------ … … 1225 1226 ln_s3d = .false. ! Logical switch for S profile observations 1226 1227 ln_ena = .false. ! Logical switch for ENACT insitu data set 1227 ln_cor = .false. !Logical switch for Coriolis insitu data set1228 ! ! ln_cor Logical switch for Coriolis insitu data set 1228 1229 ln_profb = .false. ! Logical switch for feedback insitu data set 1229 1230 ln_sla = .false. ! Logical switch for SLA observations 1231 1230 1232 ln_sladt = .false. ! Logical switch for AVISO SLA data 1233 1231 1234 ln_slafb = .false. ! Logical switch for feedback SLA data 1232 ln_ssh = .false. ! Logical switch for SSH observations 1233 ln_sst = .false. ! Logical switch for SST observations 1234 ln_reysst = .false. ! Logical switch for Reynolds observations 1235 ln_ghrsst = .false. ! Logical switch for GHRSST observations 1235 ! ln_ssh Logical switch for SSH observations 1236 1237 ln_sst = .false. ! Logical switch for SST observations 1238 ln_reysst = .false. ! ln_reysst Logical switch for Reynolds observations 1239 ln_ghrsst = .false. ! ln_ghrsst Logical switch for GHRSST observations 1240 1236 1241 ln_sstfb = .false. ! Logical switch for feedback SST data 1237 ln_sss = .false. !Logical switch for SSS observations1242 ! ln_sss Logical switch for SSS observations 1238 1243 ln_seaice = .false. ! Logical switch for Sea Ice observations 1239 ln_vel3d = .false. ! Logical switch for velocity observations 1240 ln_velavcur= .false ! Logical switch for velocity daily av. cur. 1241 ln_velhrcur= .false ! Logical switch for velocity high freq. cur. 1242 ln_velavadcp = .false. ! Logical switch for velocity daily av. ADCP 1243 ln_velhradcp = .false. ! Logical switch for velocity high freq. ADCP 1244 ln_velfb = .false. ! Logical switch for feedback velocity data 1245 ln_grid_global = .false. ! Global distribtion of observations 1246 ln_grid_search_lookup = .false. ! Logical switch for obs grid search w/lookup table 1247 grid_search_file = 'grid_search' ! Grid search lookup file header 1248 ! All of the *files* variables below are arrays. Use namelist_cfg to add more files 1249 enactfiles = 'enact.nc' ! ENACT input observation file names (specify full array in namelist_cfg) 1250 coriofiles = 'corio.nc' ! Coriolis input observation file name 1251 profbfiles = 'profiles_01.nc' ! Profile feedback input observation file name 1252 ln_profb_enatim = .false ! Enact feedback input time setting switch 1253 slafilesact = 'sla_act.nc' ! Active SLA input observation file names 1254 slafilespas = 'sla_pass.nc' ! Passive SLA input observation file names 1255 slafbfiles = 'sla_01.nc' ! slafbfiles: Feedback SLA input observation file names 1256 sstfiles = 'ghrsst.nc' ! GHRSST input observation file names 1257 sstfbfiles = 'sst_01.nc' ! Feedback SST input observation file names 1258 seaicefiles = 'seaice_01.nc' ! Sea Ice input observation file names 1259 velavcurfiles = 'velavcurfile.nc' ! Vel. cur. daily av. input file name 1260 velhrcurfiles = 'velhrcurfile.nc' ! Vel. cur. high freq. input file name 1261 velavadcpfiles = 'velavadcpfile.nc' ! Vel. ADCP daily av. input file name 1262 velhradcpfiles = 'velhradcpfile.nc' ! Vel. ADCP high freq. input file name 1263 velfbfiles = 'velfbfile.nc' ! Vel. feedback input observation file name 1264 dobsini = 20000101.000000 ! Initial date in window YYYYMMDD.HHMMSS 1265 dobsend = 20010101.000000 ! Final date in window YYYYMMDD.HHMMSS 1266 n1dint = 0 ! Type of vertical interpolation method 1267 n2dint = 0 ! Type of horizontal interpolation method 1268 ln_nea = .false. ! Rejection of observations near land switch 1269 nmsshc = 0 ! MSSH correction scheme 1270 mdtcorr = 1.61 ! MDT correction 1271 mdtcutoff = 65.0 ! MDT cutoff for computed correction 1244 ! ln_vel3d Logical switch for velocity observations 1245 ! ln_velavcur Logical switch for velocity daily av. cur. 1246 ! ln_velhrcur Logical switch for velocity high freq. cur. 1247 ! ln_velavadcp Logical switch for velocity daily av. ADCP 1248 ! ln_velhradcp Logical switch for velocity high freq. ADCP 1249 ! ln_velfb Logical switch for feedback velocity data 1250 ! ln_grid_global Global distribtion of observations 1251 ! ln_grid_search_lookup Logical switch for obs grid search w/lookup table 1252 ! grid_search_file Grid search lookup file header 1253 ! enactfiles ENACT input observation file names 1254 ! coriofiles Coriolis input observation file name 1255 ! ! profbfiles: Profile feedback input observation file name 1256 profbfiles = 'profiles_01.nc' 1257 ! ln_profb_enatim Enact feedback input time setting switch 1258 ! slafilesact Active SLA input observation file name 1259 ! slafilespas Passive SLA input observation file name 1260 ! ! slafbfiles: Feedback SLA input observation file name 1261 slafbfiles = 'sla_01.nc' 1262 ! sstfiles GHRSST input observation file name 1263 ! ! sstfbfiles: Feedback SST input observation file name 1264 sstfbfiles = 'sst_01.nc' 1265 ! seaicefiles Sea Ice input observation file names 1266 seaicefiles = 'seaice_01.nc' 1267 ! velavcurfiles Vel. cur. daily av. input file name 1268 ! velhvcurfiles Vel. cur. high freq. input file name 1269 ! velavadcpfiles Vel. ADCP daily av. input file name 1270 ! velhvadcpfiles Vel. ADCP high freq. input file name 1271 ! velfbfiles Vel. feedback input observation file name 1272 ! dobsini Initial date in window YYYYMMDD.HHMMSS 1273 ! dobsend Final date in window YYYYMMDD.HHMMSS 1274 ! n1dint Type of vertical interpolation method 1275 ! n2dint Type of horizontal interpolation method 1276 ! ln_nea Rejection of observations near land switch 1277 nmsshc = 0 ! MSSH correction scheme 1278 ! mdtcorr MDT correction 1279 ! mdtcutoff MDT cutoff for computed correction 1272 1280 ln_altbias = .false. ! Logical switch for alt bias 1273 1281 ln_ignmis = .true. ! Logical switch for ignoring missing files 1274 endailyavtypes = 820 ! ENACT daily average types - array (use namelist_cfg to set more values)1282 ! endailyavtypes ENACT daily average types 1275 1283 ln_grid_global = .true. 1276 1284 ln_grid_search_lookup = .false. … … 1285 1293 ln_asmdin = .false. ! Logical switch for Direct Initialization (DI) 1286 1294 ln_asmiau = .false. ! Logical switch for Incremental Analysis Updating (IAU) 1295 ln_seaiceinc = .false. ! Logical switch for applying sea ice increments 1296 ln_temnofreeze = .false. ! Logical to not add increments if temperature would fall below freezing 1287 1297 nitbkg = 0 ! Timestep of background in [0,nitend-nit000-1] 1288 1298 nitdin = 0 ! Timestep of background for DI in [0,nitend-nit000-1] … … 1321 1331 rn_htrmax = 200.0 ! max. depth of transition range 1322 1332 / 1333 !----------------------------------------------------------------------- 1334 &nambias ! Bias pressure correctiom 1335 !----------------------------------------------------------------------- 1336 ln_bias = .false. 1337 ln_bias_asm = .false. 1338 ln_bias_rlx = .false. 1339 ln_bias_ofl = .false. 1340 ln_bias_ts_app = .false. 1341 ln_bias_pc_app = .false. 1342 fb_t_asm = 0.0 1343 fb_t_rlx = 0.0 1344 fb_t_ofl = 1.0 1345 fb_p_asm = 1.0 1346 fb_p_rlx = 1.0 1347 fb_p_ofl = 0.0 1348 eft_rlx = 365.0 1349 eft_asm = 365.0 1350 t_rlx_upd = 0.1 1351 t_asm_upd = 0.1 1352 nn_lat_ramp = 0 1353 bias_time_unit_asm = 86400.0 1354 bias_time_unit_rlx = 1.0 1355 bias_time_unit_ofl = 1.0 1356 cn_bias_tot = "bias_tot.nc" 1357 cn_bias_asm = "bias_asm.nc" 1358 cn_dir = './' 1359 ln_bsyncro = .FALSE. 1360 fctamp = 1. 1361 rn_maxlat_bias = 23.0 1362 rn_minlat_bias = 10.0 1363 nn_bias_itwrt = 15 1364 ln_itdecay = .FALSE. 1365 ln_incpc = .FALSE. 1366 / -
branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/CONFIG/SHARED/namelist_top_MEDUSA_et_al_ref
r8280 r8657 62 62 rn_ahtrc_0 = 2000. ! horizontal eddy diffusivity for tracers [m2/s] 63 63 rn_ahtrb_0 = 0. ! background eddy diffusivity for ldf_iso [m2/s] 64 rn_fact_lap = 1. ! enhanced zonal eddy diffusivity 64 65 / 65 66 !----------------------------------------------------------------------- -
branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/OPA_SRC/ASM/asmbkg.F90
r6486 r8657 119 119 CALL iom_rstput( kt, nitbkg_r, inum, 'en' , en ) 120 120 #endif 121 CALL iom_rstput( kt, nitbkg_r, inum, 'gcx' , gcx ) 121 ! CALL iom_rstput( kt, nitbkg_r, inum, 'gcx' , gcx ) 122 CALL iom_rstput( kt, nitbkg_r, inum, 'avt' , avt ) 122 123 ! 123 124 CALL iom_close( inum ) … … 153 154 CALL iom_rstput( kt, nitdin_r, inum, 'tn' , tsn(:,:,:,jp_tem) ) 154 155 CALL iom_rstput( kt, nitdin_r, inum, 'sn' , tsn(:,:,:,jp_sal) ) 156 CALL iom_rstput( kt, nitdin_r, inum, 'avt' , avt ) 155 157 CALL iom_rstput( kt, nitdin_r, inum, 'sshn' , sshn ) 156 158 #if defined key_lim2 || defined key_lim3 -
branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/OPA_SRC/ASM/asminc.F90
r7962 r8657 39 39 USE ice_2 ! LIM2 40 40 #endif 41 #if defined key_cice && defined key_asminc 42 USE sbc_ice, ONLY : & ! CICE Ice model variables 43 & ndaice_da, nfresh_da, nfsalt_da 44 #endif 41 45 USE sbc_oce ! Surface boundary condition variables. 42 46 … … 133 137 & ln_asmdin, ln_asmiau, & 134 138 & nitbkg, nitdin, nitiaustr, nitiaufin, niaufn, & 135 & ln_salfix, salfixmin, nn_divdmp 139 & ln_salfix, salfixmin, nn_divdmp, & 140 & ln_seaiceinc, ln_temnofreeze 136 141 !!---------------------------------------------------------------------- 137 142 … … 892 897 ENDIF 893 898 899 ELSE 900 #if defined key_asminc 901 ssh_iau(:,:) = 0.0 902 #endif 894 903 ENDIF 895 904 -
branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
r7747 r8657 84 84 REAL(wp), DIMENSION(jpi,jpj) :: z2d ! 2D workspace 85 85 REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3d ! 3D workspace 86 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvn ! 3D workspace 86 87 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zmask ! 3D workspace 87 88 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts) :: zts ! 3D workspace … … 93 94 REAL(wp), DIMENSION(jpj,jpk,nptr) :: sjk , r1_sjk ! i-mean i-k-surface and its inverse 94 95 REAL(wp), DIMENSION(jpj,jpk,nptr) :: v_msf, sn_jk , tn_jk ! i-mean T and S, j-Stream-Function 95 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvn ! 3D workspace96 96 97 97 … … 130 130 zmask(:,:,:) = 0._wp 131 131 zts(:,:,:,:) = 0._wp 132 zvn(:,:,:) = 0._wp133 132 DO jk = 1, jpkm1 134 133 DO jj = 1, jpjm1 … … 138 137 zts(ji,jj,jk,jp_tem) = (tsn(ji,jj,jk,jp_tem)+tsn(ji,jj+1,jk,jp_tem)) * 0.5 * zvfc !Tracers averaged onto V grid 139 138 zts(ji,jj,jk,jp_sal) = (tsn(ji,jj,jk,jp_sal)+tsn(ji,jj+1,jk,jp_sal)) * 0.5 * zvfc 140 zvn(ji,jj,jk) = vn(ji,jj,jk) * zvfc141 139 ENDDO 142 140 ENDDO … … 151 149 tn_jk(:,:,1) = ptr_sjk( zts(:,:,:,jp_tem) ) * r1_sjk(:,:,1) 152 150 sn_jk(:,:,1) = ptr_sjk( zts(:,:,:,jp_sal) ) * r1_sjk(:,:,1) 153 v_msf(:,:,1) = ptr_sjk( zvn(:,:,:) )151 v_msf(:,:,1) = ptr_sjk( pvtr(:,:,:) ) 154 152 155 153 htr_ove(:,1) = SUM( v_msf(:,:,1)*tn_jk(:,:,1) ,2 ) … … 177 175 tn_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 178 176 sn_jk(:,:,jn) = ptr_sjk( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) * r1_sjk(:,:,jn) 179 v_msf(:,:,jn) = ptr_sjk( zvn(:,:,:), btmsk(:,:,jn) )177 v_msf(:,:,jn) = ptr_sjk( pvtr(:,:,:), btmsk(:,:,jn) ) 180 178 htr_ove(:,jn) = SUM( v_msf(:,:,jn)*tn_jk(:,:,jn) ,2 ) 181 179 str_ove(:,jn) = SUM( v_msf(:,:,jn)*sn_jk(:,:,jn) ,2 ) … … 202 200 WHERE( sjk(:,1,1) /= 0._wp ) r1_sjk(:,1,1) = 1._wp / sjk(:,1,1) 203 201 204 vsum = ptr_sj( zvn(:,:,:), btmsk(:,:,1))202 vsum = ptr_sj( pvtr(:,:,:), btmsk(:,:,1)) 205 203 tssum(:,jp_tem) = ptr_sj( zts(:,:,:,jp_tem), btmsk(:,:,1) ) 206 204 tssum(:,jp_sal) = ptr_sj( zts(:,:,:,jp_sal), btmsk(:,:,1) ) … … 224 222 r1_sjk(:,1,jn) = 0._wp 225 223 WHERE( sjk(:,1,jn) /= 0._wp ) r1_sjk(:,1,jn) = 1._wp / sjk(:,1,jn) 226 vsum = ptr_sj( zvn(:,:,:), btmsk(:,:,jn))224 vsum = ptr_sj( pvtr(:,:,:), btmsk(:,:,jn)) 227 225 tssum(:,jp_tem) = ptr_sj( zts(:,:,:,jp_tem), btmsk(:,:,jn) ) 228 226 tssum(:,jp_sal) = ptr_sj( zts(:,:,:,jp_sal), btmsk(:,:,jn) ) … … 408 406 ENDIF 409 407 IF( iom_use("zomsfeivglo") ) THEN 410 z3d(1,:,:) = ptr_sjk( v_eiv(:,:,:) ) ! zonal cumulative effective transport 408 DO jk=1,jpk 409 DO jj=1,jpj 410 DO ji=1,jpi 411 zvn(ji,jj,jk) = v_eiv(ji,jj,jk) * fse3v(ji,jj,jk) * e1v(ji,jj) 412 ENDDO 413 ENDDO 414 ENDDO 415 z3d(1,:,:) = ptr_sjk( zvn(:,:,:) ) ! zonal cumulative effective transport 411 416 DO jk = jpkm1,1,-1 412 417 z3d(1,:,jk) = z3d(1,:,jk+1) - z3d(1,:,jk) ! effective j-Stream-Function (MSF) … … 419 424 IF( ln_subbas ) THEN 420 425 DO jn = 2, nptr ! by sub-basins 421 z3d(1,:,:) = ptr_sjk( v_eiv(:,:,:), btmsk(:,:,jn) )426 z3d(1,:,:) = ptr_sjk( zvn(:,:,:), btmsk(:,:,jn) ) 422 427 DO jk = jpkm1,1,-1 423 428 z3d(1,:,jk) = z3d(1,:,jk+1) - z3d(1,:,jk) ! effective j-Stream-Function (MSF) -
branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/OPA_SRC/DIA/diawri.F90
r8280 r8657 47 47 USE iom 48 48 USE ioipsl 49 USE dynspg_oce, ONLY: un_adv, vn_adv ! barotropic velocities 50 49 USE dynspg_oce, ONLY: un_adv, vn_adv ! barotropic velocities 50 USE insitu_tem, ONLY: insitu_t, theta2t 51 51 #if defined key_lim2 52 52 USE limwri_2 … … 164 164 165 165 CALL iom_put( "toce", tsn(:,:,:,jp_tem) ) ! 3D temperature 166 CALL theta2t ! in-situ temperature conversion 167 CALL iom_put( "tinsitu", insitu_t(:,:,:)) ! in-situ temperature 166 168 CALL iom_put( "sst", tsn(:,:,1,jp_tem) ) ! surface temperature 167 169 IF ( iom_use("sbt") ) THEN … … 202 204 CALL iom_put( "taubot", z2d ) 203 205 ENDIF 204 206 205 207 CALL iom_put( "uoce", un(:,:,:) ) ! 3D i-current 206 208 CALL iom_put( "ssu", un(:,:,1) ) ! surface i-current -
branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90
r6486 r8657 355 355 & gdept_0 (jpi,jpj,jpk) , e3t_0(jpi,jpj,jpk) , e3u_0 (jpi,jpj,jpk) , & 356 356 & gdepw_0 (jpi,jpj,jpk) , e3w_0(jpi,jpj,jpk) , e3vw_0(jpi,jpj,jpk) , e3uw_0(jpi,jpj,jpk) , STAT=ierr(4) ) 357 358 ! Initilaise key variables at risk of being intercepted before properly set up. 359 e3t_0(:,:,:) = 0.0 357 360 ! 358 361 #if defined key_vvl … … 368 371 & ehu_b (jpi,jpj) , ehv_b (jpi,jpj), & 369 372 & ehur_b (jpi,jpj) , ehvr_b (jpi,jpj), STAT=ierr(5) ) 373 374 ! Initilaise key variables at risk of being intercepted before properly set up. 375 e3t_n(:,:,:) = 0.0 370 376 #endif 371 377 ! -
branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/OPA_SRC/DYN/dynhpg.F90
r6486 r8657 44 44 USE wrk_nemo ! Memory Allocation 45 45 USE timing ! Timing 46 USE biaspar ! bias correction variables 46 47 47 48 IMPLICIT NONE … … 84 85 INTEGER, INTENT(in) :: kt ! ocean time-step index 85 86 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdu, ztrdv 87 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: z_rhd_st ! tmp density storage for pressure corr 88 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_gru_st ! tmp ua trends storage for pressure corr 89 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: z_grv_st ! tmp va trends storage for pressure corr 86 90 !!---------------------------------------------------------------------- 87 91 ! … … 94 98 ENDIF 95 99 ! 100 IF ( ln_bias .AND. ln_bias_pc_app ) THEN 101 102 !Allocate space for tempory variables 103 ALLOCATE( z_rhd_st(jpi,jpj,jpk), & 104 & z_gru_st(jpi,jpj), & 105 & z_grv_st(jpi,jpj) ) 106 107 z_rhd_st(:,:,:) = rhd(:,:,:) ! store orig density 108 rhd(:,:,:) = rhd_pc(:,:,:) ! use pressure corrected density 109 z_gru_st(:,:) = gru(:,:) 110 gru(:,:) = gru_pc(:,:) 111 z_grv_st(:,:) = grv(:,:) 112 grv(:,:) = grv_pc(:,:) 113 114 ENDIF 115 96 116 SELECT CASE ( nhpg ) ! Hydrostatic pressure gradient computation 97 117 CASE ( 0 ) ; CALL hpg_zco ( kt ) ! z-coordinate … … 112 132 IF(ln_ctl) CALL prt_ctl( tab3d_1=ua, clinfo1=' hpg - Ua: ', mask1=umask, & 113 133 & tab3d_2=va, clinfo2= ' Va: ', mask2=vmask, clinfo3='dyn' ) 134 ! 135 IF ( ln_bias .AND. ln_bias_pc_app ) THEN 136 IF(lwp) THEN 137 WRITE(numout,*) " ! restore original density" 138 ENDIF 139 rhd(:,:,:) = z_rhd_st(:,:,:) ! restore original density 140 gru(:,:) = z_gru_st(:,:) 141 grv(:,:) = z_grv_st(:,:) 142 143 !Deallocate tempory variables 144 DEALLOCATE( z_rhd_st, & 145 & z_gru_st, & 146 & z_grv_st ) 147 ENDIF 114 148 ! 115 149 IF( nn_timing == 1 ) CALL timing_stop('dyn_hpg') -
branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/OPA_SRC/DYN/sshwzv.F90
r6487 r8657 74 74 INTEGER, INTENT(in) :: kt ! time step 75 75 ! 76 INTEGER :: jk ! dummy loop indice 76 INTEGER :: jk ! dummy loop indices 77 77 REAL(wp) :: z2dt, z1_rau0 ! local scalars 78 78 !!---------------------------------------------------------------------- … … 94 94 z2dt = 2._wp * rdt ! set time step size (Euler/Leapfrog) 95 95 IF( neuler == 0 .AND. kt == nit000 ) z2dt = rdt 96 97 98 #if defined key_asminc 99 ! ! Include the IAU weighted SSH increment 100 IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN 101 CALL ssh_asm_inc( kt ) 102 #if defined key_vvl 103 ! Don't directly adjust ssh but change hdivn at all levels instead 104 ! In trasbc also add in the heat and salt content associated with these changes at each level 105 DO jk = 1, jpkm1 106 hdivn(:,:,jk) = hdivn(:,:,jk) - ( ssh_iau(:,:) / ( ht_0(:,:) + 1.0 - ssmask(:,:) ) ) * ( e3t_0(:,:,jk) / fse3t_n(:,:,jk) ) * tmask(:,:,jk) 107 END DO 108 ENDIF 109 #endif 110 #endif 111 96 112 97 113 ! !------------------------------! … … 123 139 #endif 124 140 125 #if defined key_asminc126 ! ! Include the IAU weighted SSH increment127 IF( lk_asminc .AND. ln_sshinc .AND. ln_asmiau ) THEN128 CALL ssh_asm_inc( kt )129 ssha(:,:) = ssha(:,:) + z2dt * ssh_iau(:,:)130 ENDIF131 #endif132 141 133 142 ! !------------------------------! -
branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/OPA_SRC/SBC/sbc_ice.F90
r6498 r8657 110 110 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: u_ice, v_ice ! jpi, jpj 111 111 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: a_p, ht_p ! Meltpond fraction and depth 112 113 ! 114 115 ! 116 #if defined key_asminc 117 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ndaice_da !: NEMO fresh water flux to ocean due to data assim 118 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: nfresh_da !: NEMO salt flux to ocean due to data assim 119 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: nfsalt_da !: NEMO ice concentration change/second from data assim 120 #endif 121 112 122 #endif 113 123 … … 162 172 ss_iov(jpi,jpj) , fr_iu(jpi,jpj) , fr_iv(jpi,jpj) , & 163 173 a_i(jpi,jpj,ncat) , topmelt(jpi,jpj,ncat) , botmelt(jpi,jpj,ncat) , & 174 #if defined key_asminc 175 ndaice_da(jpi,jpj) , nfresh_da(jpi,jpj) , nfsalt_da(jpi,jpj) , & 176 #endif 164 177 sstfrz(jpi,jpj) , STAT= ierr(1) ) 165 178 ! Alex West: Allocating tn_ice with 5 categories. When NEMO is used with CICE, this variable -
branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/OPA_SRC/SBC/sbccpl.F90
r8280 r8657 2137 2137 REAL(wp) :: zumax, zvmax 2138 2138 REAL(wp), POINTER, DIMENSION(:,:) :: zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 2139 REAL(wp), POINTER, DIMENSION(:,:) :: zotx1_in, zoty1_in 2139 2140 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztmp3, ztmp4 2140 2141 !!---------------------------------------------------------------------- … … 2143 2144 ! 2144 2145 CALL wrk_alloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 ) 2146 CALL wrk_alloc( jpi,jpj, zotx1_in, zoty1_in) 2145 2147 CALL wrk_alloc( jpi,jpj,jpl, ztmp3, ztmp4 ) 2146 2148 … … 2411 2413 zotx1(:,:) = un(:,:,1) 2412 2414 zoty1(:,:) = vn(:,:,1) 2413 ELSE 2415 ELSE 2414 2416 SELECT CASE( TRIM( sn_snd_crt%cldes ) ) 2415 2417 CASE( 'oce only' ) ! C-grid ==> T … … 2547 2549 ENDDO 2548 2550 ENDDO 2549 2551 2550 2552 ! Ensure any N fold and wrap columns are updated 2551 2553 CALL lbc_lnk(ztmp1, 'V', -1.0) 2552 2554 CALL lbc_lnk(ztmp2, 'U', -1.0) 2553 2555 2554 2556 ikchoix = -1 2555 CALL repcmo (zotx1,ztmp2,ztmp1,zoty1,zotx1,zoty1,ikchoix) 2557 ! We need copies of zotx1 and zoty2 in order to avoid problems 2558 ! caused by INTENTs used in the following subroutine. 2559 zotx1_in(:,:) = zotx1(:,:) 2560 zoty1_in(:,:) = zoty1(:,:) 2561 CALL repcmo (zotx1_in,ztmp2,ztmp1,zoty1_in,zotx1,zoty1,ikchoix) 2556 2562 ENDIF 2557 2563 ENDIF … … 2622 2628 ! 2623 2629 CALL wrk_dealloc( jpi,jpj, zfr_l, ztmp1, ztmp2, zotx1, zoty1, zotz1, zitx1, zity1, zitz1 ) 2630 CALL wrk_dealloc( jpi,jpj, zotx1_in, zoty1_in ) 2624 2631 CALL wrk_dealloc( jpi,jpj,jpl, ztmp3, ztmp4 ) 2625 2632 ! -
branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/OPA_SRC/SBC/sbcice_cice.F90
r8280 r8657 56 56 fresh_ai,fhocn_ai,fswthru_ai,frzmlt, & 57 57 flatn_f,fsurfn_f,fcondtopn_f, & 58 #ifdef key_asminc 59 daice_da,fresh_da,fsalt_da, & 60 #endif 58 61 uatm,vatm,wind,fsw,flw,Tair,potT,Qa,rhoa,zlvl, & 59 62 swvdr,swvdf,swidr,swidf,Tf, & … … 301 304 302 305 CALL wrk_dealloc( jpi,jpj, ztmp1, ztmp2 ) 306 307 #if defined key_asminc 308 ! Initialize fresh water and salt fluxes from data assim 309 ! and data assimilation index to cice 310 nfresh_da(:,:) = 0.0 311 nfsalt_da(:,:) = 0.0 312 ndaice_da(:,:) = 0.0 313 #endif 303 314 ! 304 315 ! In coupled mode get extra fields from CICE for passing back to atmosphere … … 454 465 ENDIF 455 466 467 #if defined key_asminc 468 !Ice concentration change (from assimilation) 469 ztmp(:,:)=ndaice_da(:,:)*tmask(:,:,1) 470 Call nemo2cice(ztmp,daice_da,'T', 1. ) 471 #endif 472 456 473 ! Snowfall 457 474 ! Ensure fsnow is positive (as in CICE routine prepare_forcing) … … 716 733 snwice_fmass (:,:) = ( snwice_mass(:,:) - snwice_mass_b(:,:) ) / dt 717 734 ENDIF 735 736 #if defined key_asminc 737 ! Import fresh water and salt flux due to seaice da 738 CALL cice2nemo(fresh_da, nfresh_da,'T',1.0) 739 CALL cice2nemo(fsalt_da, nfsalt_da,'T',1.0) 740 #endif 718 741 719 742 ! Release work space -
branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/OPA_SRC/TRA/eosbn2.F90
r7993 r8657 312 312 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! 1 : potential temperature [Celcius] 313 313 ! ! 2 : salinity [psu] 314 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( 315 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( 314 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(inout) :: prd ! in situ density [-] 315 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(inout) :: prhop ! potential density (surface referenced) 316 316 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pdep ! depth [m] 317 317 ! … … 457 457 END SELECT 458 458 ! 459 CALL lbc_lnk( prd, 'T', 1.0_wp ) 460 ! 459 461 IF(ln_ctl) CALL prt_ctl( tab3d_1=prd, clinfo1=' eos-pot: ', tab3d_2=prhop, clinfo2=' pot : ', ovlap=1, kdim=jpk ) 460 462 ! … … 902 904 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pts ! pot. temperature and salinity [Celcius,psu] 903 905 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts), INTENT(in ) :: pab ! thermal/haline expansion coef. [Celcius-1,psu-1] 904 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT( 906 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(inout) :: pn2 ! Brunt-Vaisala frequency squared [1/s^2] 905 907 ! 906 908 INTEGER :: ji, jj, jk ! dummy loop indices -
branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90
r7771 r8657 549 549 zmbk(:,:) = REAL( mbkv_d(:,:), wp ) ; CALL lbc_lnk(zmbk,'V',1.) ; mbkv_d(:,:) = MAX( INT( zmbk(:,:) ), 1 ) 550 550 551 !* sign of grad(H) at u- and v-points 552 mgrhu(jpi,:) = 0 ; mgrhu(:,jpj) = 0 ; mgrhv(jpi,:) = 0 ; mgrhv(:,jpj) = 0 551 !! AXY (16/08/17): remove the following per George and Andrew bug-hunt 552 !! !* sign of grad(H) at u- and v-points 553 !! mgrhu(jpi,:) = 0 ; mgrhu(:,jpj) = 0 ; mgrhv(jpi,:) = 0 ; mgrhv(:,jpj) = 0 554 !! DO jj = 1, jpjm1 555 !! DO ji = 1, jpim1 556 !! mgrhu(ji,jj) = INT( SIGN( 1.e0, gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) ) ) 557 !! mgrhv(ji,jj) = INT( SIGN( 1.e0, gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) ) ) 558 !! END DO 559 !! END DO 560 561 !! AXY (16/08/17): add the following replacement per George and Andrew bug-hunt 562 !* sign of grad(H) at u- and v-points; zero if grad(H) = 0 563 mgrhu(:,:) = 0 ; mgrhv(:,:) = 0 553 564 DO jj = 1, jpjm1 554 565 DO ji = 1, jpim1 555 mgrhu(ji,jj) = INT( SIGN( 1.e0, gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) ) ) 556 mgrhv(ji,jj) = INT( SIGN( 1.e0, gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) ) ) 566 #if defined key_bbl_old_nonconserve 567 ! This key allows old (non conservative version) to be used for continuity of results 568 mgrhu(ji,jj) = INT( SIGN( 1.e0, gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) ) ) 569 mgrhv(ji,jj) = INT( SIGN( 1.e0, gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) ) ) 570 #else 571 IF( gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) /= 0._wp ) THEN 572 mgrhu(ji,jj) = INT( SIGN( 1.e0, & 573 gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) ) ) 574 ENDIF 575 ! 576 IF( gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) /= 0._wp ) THEN 577 mgrhv(ji,jj) = INT( SIGN( 1.e0, & 578 gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) ) ) 579 ENDIF 580 #endif 557 581 END DO 558 582 END DO -
branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/OPA_SRC/TRA/trasbc.F90
r7993 r8657 33 33 USE timing ! Timing 34 34 USE eosbn2 35 #if defined key_asminc 36 USE asminc ! Assimilation increment 37 #endif 35 38 36 39 IMPLICIT NONE … … 120 123 REAL(wp) :: zfact, z1_e3t, zdep 121 124 REAL(wp) :: zalpha, zhk 125 REAL(wp) :: zt_frz, zpress 122 126 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrdt, ztrds 123 127 !!---------------------------------------------------------------------- … … 283 287 IF( iom_use('rnf_x_sss') ) CALL iom_put( "rnf_x_sss", rnf*tsn(:,:,1,jp_sal) ) ! runoff term on sss 284 288 289 #if defined key_asminc 290 ! WARNING: THIS MAY WELL NOT BE REQUIRED - WE DON'T WANT TO CHANGE T&S BUT THIS MAY COMPENSATE ANOTHER TERM... 291 ! Rate of change in e3t for each level is ssh_iau*e3t_0/ht_0 292 ! Contribution to tsa should be rate of change in level / per m of ocean? (hence the division by fse3t_n) 293 IF( ln_sshinc ) THEN ! input of heat and salt due to assimilation 294 DO jj = 2, jpj 295 DO ji = fs_2, fs_jpim1 296 zdep = ssh_iau(ji,jj) / ( ht_0(ji,jj) + 1.0 - ssmask(ji, jj) ) 297 DO jk = 1, jpkm1 298 tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) & 299 & + tsn(ji,jj,jk,jp_tem) * zdep * ( e3t_0(ji,jj,jk) / fse3t_n(ji,jj,jk) ) 300 tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) & 301 & + tsn(ji,jj,jk,jp_sal) * zdep * ( e3t_0(ji,jj,jk) / fse3t_n(ji,jj,jk) ) 302 END DO 303 END DO 304 END DO 305 ENDIF 306 #endif 307 285 308 IF( l_trdtra ) THEN ! send trends for further diagnostics 286 309 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) -
branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90
r8280 r8657 227 227 #endif 228 228 ! 229 ! Met Office addition: if failed, return non-zero exit code 230 IF( nstop /= 0 ) CALL exit( 9 ) 231 ! 229 232 END SUBROUTINE nemo_gcm 230 233 … … 480 483 CALL dia_hsb_init ! heat content, salt content and volume budgets 481 484 CALL trd_init ! Mixed-layer/Vorticity/Integral constraints trends 485 CALL bias_init ! Pressure correction bias 482 486 IF( lk_diaobs ) THEN ! Observation & model comparison 483 487 CALL dia_obs_init ! Initialize observational data … … 646 650 !!---------------------------------------------------------------------- 647 651 USE diawri , ONLY: dia_wri_alloc 652 USE insitu_tem, ONLY: insitu_tem_alloc 648 653 USE dom_oce , ONLY: dom_oce_alloc 649 654 USE ldfdyn_oce, ONLY: ldfdyn_oce_alloc … … 662 667 ierr = oce_alloc () ! ocean 663 668 ierr = ierr + dia_wri_alloc () 669 ierr = ierr + insitu_tem_alloc() 664 670 ierr = ierr + dom_oce_alloc () ! ocean domain 665 671 ierr = ierr + ldfdyn_oce_alloc() ! ocean lateral physics : dynamics -
branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/OPA_SRC/step.F90
r8280 r8657 103 103 IF( ln_crs ) CALL iom_setkt( kstp - nit000 + 1, TRIM(cxios_context)//"_crs" ) ! tell iom we are at time step kstp 104 104 105 IF( ln_bias ) CALL bias_opn( kstp ) 106 105 107 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 106 108 ! Update data, open boundaries, surface boundary condition (including sea-ice) … … 267 269 IF( lk_trabbl ) CALL tra_bbl ( kstp ) ! advective (and/or diffusive) bottom boundary layer scheme 268 270 IF( ln_tradmp ) CALL tra_dmp ( kstp ) ! internal damping trends 271 IF( ln_bias ) CALL tra_bias ( kstp ) 269 272 IF( lk_bdy ) CALL bdy_tra_dmp( kstp ) ! bdy damping trends 270 273 CALL tra_adv ( kstp ) ! horizontal & vertical advection … … 290 293 & rhd, gru , grv , aru , arv , gzu , gzv , ge3ru , ge3rv , & 291 294 & gtui, gtvi, grui, grvi, arui, arvi, gzui, gzvi, ge3rui, ge3rvi ) ! of t, s, rd at the last ocean level 295 IF( ln_bias ) CALL dyn_bias( kstp ) 292 296 ELSE ! centered hpg (eos then time stepping) 293 297 IF ( .NOT. lk_dynspg_ts ) THEN ! eos already called in time-split case … … 303 307 IF( ln_zdfnpc ) CALL tra_npc( kstp ) ! update after fields by non-penetrative convection 304 308 CALL tra_nxt( kstp ) ! tracer fields at next time step 309 IF( ln_bias ) CALL dyn_bias( kstp ) 305 310 ENDIF 306 311 … … 377 382 ENDIF 378 383 384 385 IF( lrst_bias ) CALL bias_wrt ( kstp ) 386 379 387 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 380 388 ! Coupled mode -
branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/OPA_SRC/step_oce.F90
r6491 r8657 100 100 101 101 USE crsfld ! Standard output on coarse grid (crs_fld routine) 102 102 USE biaspar ! bias param 103 USE bias ! bias routines (tra_bias routine 104 ! dyn_bias routine) 103 105 USE asminc ! assimilation increments (tra_asm_inc routine) 104 106 ! (dyn_asm_inc routine) -
branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/TOP_SRC/AGE/trcsms_age.F90
r6715 r8657 57 57 IF( nn_timing == 1 ) CALL timing_start('trc_sms_age') 58 58 ! 59 IF(lwp) WRITE(numout,*) 60 IF(lwp) WRITE(numout,*) ' trc_sms_age: AGE model' 61 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 59 IF( kt == nittrc000 ) THEN 60 IF(lwp) WRITE(numout,*) 61 IF(lwp) WRITE(numout,*) ' trc_sms_age: AGE model' 62 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 63 ENDIF 62 64 63 65 IF( l_trdtrc ) CALL wrk_alloc( jpi, jpj, jpk, ztrage ) -
branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/TOP_SRC/C14b/trcnam_c14b.F90
r6486 r8657 49 49 ! definition of additional diagnostic as a structure 50 50 INTEGER :: jl, jn 51 TYPE(DIAG), DIMENSION(jp_c14b_2d) :: c14dia2d52 TYPE(DIAG), DIMENSION(jp_c14b_3d) :: c14dia3d53 51 !! 54 52 NAMELIST/namc14date/ ndate_beg_b, nyear_res_b 55 NAMELIST/namc14dia/ c14dia2d, c14dia3d ! additional diagnostics56 53 !!------------------------------------------------------------------- 57 54 ! ! Open namelist file … … 77 74 IF(lwp) WRITE(numout,*) ' initial year (aa) nyear_beg_b = ', nyear_beg_b 78 75 ! 79 IF( .NOT.lk_iomput .AND. ln_diatrc ) THEN80 !81 ! Namelist namc14dia82 ! -------------------83 REWIND( numnatb_ref ) ! Namelist namc14dia in reference namelist : c14b diagnostics84 READ ( numnatb_ref, namc14dia, IOSTAT = ios, ERR = 903)85 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc14dia in reference namelist', lwp )86 87 REWIND( numnatb_cfg ) ! Namelist namc14dia in configuration namelist : c14b diagnostics88 READ ( numnatb_cfg, namc14dia, IOSTAT = ios, ERR = 904 )89 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namc14dia in configuration namelist', lwp )90 IF(lwm) WRITE ( numonb, namc14dia )91 92 DO jl = 1, jp_c14b_2d93 jn = jp_c14b0_2d + jl - 194 ctrc2d(jn) = c14dia2d(jl)%sname95 ctrc2l(jn) = c14dia2d(jl)%lname96 ctrc2u(jn) = c14dia2d(jl)%units97 END DO98 99 DO jl = 1, jp_c14b_3d100 jn = jp_c14b0_3d + jl - 1101 ctrc3d(jn) = c14dia3d(jl)%sname102 ctrc3l(jn) = c14dia3d(jl)%lname103 ctrc3u(jn) = c14dia3d(jl)%units104 END DO105 106 IF(lwp) THEN ! control print107 WRITE(numout,*)108 WRITE(numout,*) ' Namelist : natadd'109 DO jl = 1, jp_c14b_3d110 jn = jp_c14b0_3d + jl - 1111 WRITE(numout,*) ' 3d diag nb : ', jn, ' short name : ', ctrc3d(jn), &112 & ' long name : ', ctrc3l(jn), ' unit : ', ctrc3u(jn)113 END DO114 WRITE(numout,*) ' '115 116 DO jl = 1, jp_c14b_2d117 jn = jp_c14b0_2d + jl - 1118 WRITE(numout,*) ' 2d diag nb : ', jn, ' short name : ', ctrc2d(jn), &119 & ' long name : ', ctrc2l(jn), ' unit : ', ctrc2u(jn)120 END DO121 WRITE(numout,*) ' '122 ENDIF123 !124 ENDIF125 76 126 77 IF(lwm) CALL FLUSH ( numonb ) ! flush output namelist C14b -
branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/TOP_SRC/CFC/trcnam_cfc.F90
r8280 r8657 47 47 INTEGER :: ios ! Local integer output status for namelist read 48 48 INTEGER :: jl, jn 49 TYPE(DIAG), DIMENSION(jp_cfc_2d) :: cfcdia2d50 49 !! 51 50 NAMELIST/namcfcdate/ ndate_beg, nyear_res, simu_type 52 NAMELIST/namcfcdia/ cfcdia2d ! additional diagnostics53 51 !!---------------------------------------------------------------------- 54 52 ! ! Open namelist files … … 82 80 ! 83 81 84 IF( .NOT.lk_iomput .AND. ln_diatrc ) THEN85 !86 ! Namelist namcfcdia87 ! -------------------88 REWIND( numnatc_ref ) ! Namelist namcfcdia in reference namelist : CFC diagnostics89 READ ( numnatc_ref, namcfcdia, IOSTAT = ios, ERR = 903)90 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfcdia in reference namelist', lwp )91 92 REWIND( numnatc_cfg ) ! Namelist namcfcdia in configuration namelist : CFC diagnostics93 READ ( numnatc_cfg, namcfcdia, IOSTAT = ios, ERR = 904 )94 904 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfcdia in configuration namelist', lwp )95 IF(lwm) WRITE ( numonc, namcfcdia )96 97 DO jl = 1, jp_cfc_2d98 jn = jp_cfc0_2d + jl - 199 ctrc2d(jn) = TRIM( cfcdia2d(jl)%sname )100 ctrc2l(jn) = TRIM( cfcdia2d(jl)%lname )101 ctrc2u(jn) = TRIM( cfcdia2d(jl)%units )102 END DO103 104 IF(lwp) THEN ! control print105 WRITE(numout,*)106 WRITE(numout,*) ' Namelist : natadd'107 DO jl = 1, jp_cfc_2d108 jn = jp_cfc0_2d + jl - 1109 WRITE(numout,*) ' 2d diag nb : ', jn, ' short name : ', ctrc2d(jn), &110 & ' long name : ', ctrc2l(jn), ' unit : ', ctrc2u(jn)111 END DO112 WRITE(numout,*) ' '113 ENDIF114 !115 ENDIF116 117 82 IF(lwm) CALL FLUSH ( numonc ) ! flush output namelist CFC 118 83 -
branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90
r8280 r8657 257 257 !ENDIF 258 258 ! 259 IF( lk_iomput ) THEN 260 IF (iom_use("qtrCFC11")) CALL iom_put( "qtrCFC11" , qtr_cfc (:,:,1) ) 261 IF (iom_use("qintCFC11")) CALL iom_put( "qintCFC11" , qint_cfc(:,:,1) ) 262 IF (iom_use("qtrCFC12")) CALL iom_put( "qtrCFC12" , qtr_cfc (:,:,2) ) 263 IF (iom_use("qintCFC12")) CALL iom_put( "qintCFC12" , qint_cfc(:,:,2) ) 264 IF (iom_use("qtrSF6")) CALL iom_put( "qtrSF6" , qtr_cfc (:,:,3) ) 265 IF (iom_use("qintSF6")) CALL iom_put( "qintSF6" , qint_cfc(:,:,3) ) 266 ELSE 267 IF( ln_diatrc ) THEN 268 trc2d(:,:,jp_cfc0_2d ) = qtr_cfc (:,:,1) 269 trc2d(:,:,jp_cfc0_2d + 1) = qint_cfc(:,:,1) 270 trc2d(:,:,jp_cfc0_2d + 2) = qtr_cfc (:,:,2) 271 trc2d(:,:,jp_cfc0_2d + 3) = qint_cfc(:,:,2) 272 trc2d(:,:,jp_cfc0_2d + 4) = qtr_cfc (:,:,3) 273 trc2d(:,:,jp_cfc0_2d + 5) = qint_cfc(:,:,3) 274 END IF 275 END IF 259 IF (iom_use("qtrCFC11")) CALL iom_put( "qtrCFC11" , qtr_cfc (:,:,1) ) 260 IF (iom_use("qintCFC11")) CALL iom_put( "qintCFC11" , qint_cfc(:,:,1) ) 261 IF (iom_use("qtrCFC12")) CALL iom_put( "qtrCFC12" , qtr_cfc (:,:,2) ) 262 IF (iom_use("qintCFC12")) CALL iom_put( "qintCFC12" , qint_cfc(:,:,2) ) 263 IF (iom_use("qtrSF6")) CALL iom_put( "qtrSF6" , qtr_cfc (:,:,3) ) 264 IF (iom_use("qintSF6")) CALL iom_put( "qintSF6" , qint_cfc(:,:,3) ) 276 265 ! 277 266 IF( l_trdtrc ) THEN -
branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/TOP_SRC/IDTRA/trcsms_idtra.F90
r6829 r8657 165 165 !ENDIF 166 166 ! 167 IF( lk_iomput ) THEN168 167 CALL iom_put( "qtrIDTRA" , qtr_idtra (:,:,1) ) 169 168 CALL iom_put( "qintIDTRA" , qint_idtra(:,:,1) ) 170 169 CALL iom_put( "invIDTRA" , inv_idtra(:,:,1) ) 171 ELSE172 IF( ln_diatrc ) THEN173 trc2d(:,:,jp_idtra0_2d ) = qtr_idtra (:,:,1)174 trc2d(:,:,jp_idtra0_2d + 1) = qint_idtra(:,:,1)175 trc2d(:,:,jp_idtra0_2d + 2) = inv_idtra(:,:,1)176 END IF177 END IF178 170 ! 179 171 # if defined key_debug_medusa -
branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/TOP_SRC/MEDUSA/par_medusa.F90
r6164 r8657 63 63 # endif 64 64 65 ! assign an index in trc arrays for each PTS prognostic variables 66 INTEGER, PUBLIC, PARAMETER :: jpchn_lc = 1 !: non-diatom chlorophyll concentration 67 INTEGER, PUBLIC, PARAMETER :: jpchd_lc = 2 !: diatom chlorophyll concentration 68 INTEGER, PUBLIC, PARAMETER :: jpphn_lc = 3 !: non-diatom concentration 69 INTEGER, PUBLIC, PARAMETER :: jpphd_lc = 4 !: diatom concentration 70 INTEGER, PUBLIC, PARAMETER :: jpzmi_lc = 5 !: microzooplankton concentration 71 INTEGER, PUBLIC, PARAMETER :: jpzme_lc = 6 !: mesozooplankton concentration 72 INTEGER, PUBLIC, PARAMETER :: jpdin_lc = 7 !: dissolved inorganic nitrogen concentration 73 INTEGER, PUBLIC, PARAMETER :: jpsil_lc = 8 !: silicic acid concentration 74 INTEGER, PUBLIC, PARAMETER :: jpfer_lc = 9 !: total iron concentration 75 INTEGER, PUBLIC, PARAMETER :: jpdet_lc = 10 !: slow-sinking detritus concentration 76 INTEGER, PUBLIC, PARAMETER :: jppds_lc = 11 !: diatom silicon concentration 77 # if defined key_roam 78 INTEGER, PUBLIC, PARAMETER :: jpdtc_lc = 12 !: slow-sinking detritus carbon concentration 79 INTEGER, PUBLIC, PARAMETER :: jpdic_lc = 13 !: dissolved inorganic carbon concentration 80 INTEGER, PUBLIC, PARAMETER :: jpalk_lc = 14 !: alkalinity 81 INTEGER, PUBLIC, PARAMETER :: jpoxy_lc = 15 !: dissolved oxygen concentration 82 # endif 83 65 84 #else 66 85 !!--------------------------------------------------------------------- -
branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcbio_medusa.F90
r8224 r8657 6 6 !! History : 7 7 !! - ! 1999-07 (M. Levy) original code 8 !! - ! 2000-12 (E. Kestenare) assign parameters to name individual tracers 8 !! - ! 2000-12 (E. Kestenare) assign parameters to name 9 !! individual tracers 9 10 !! - ! 2001-03 (M. Levy) LNO3 + dia2d 10 11 !! 2.0 ! 2007-12 (C. Deltel, G. Madec) F90 … … 18 19 !! - ! 2015-06 (A. Yool) Update to include MOCSY 19 20 !! - ! 2015-07 (A. Yool) Update for rolling averages 20 !! - ! 2015-10 (J. Palm) Update for diag outputs through iom_use 21 !! - ! 2015-10 (J. Palm) Update for diag outputs through 22 !! iom_use 21 23 !! - ! 2016-11 (A. Yool) Updated diags for CMIP6 22 24 !! - ! 2017-05 (A. Yool) Added extra DMS calculation … … 60 62 !! trc_bio_medusa : 61 63 !!---------------------------------------------------------------------- 62 USE oce_trc63 USE trc64 USE sms_medusa65 USE lbclnk66 USE prtctl_trc ! Print control for debugging67 USE trcsed_medusa68 USE sbc_oce ! surface forcing69 USE sbcrnf ! surface boundary condition: runoff variables70 USE in_out_manager ! I/O manager71 # if defined key_iomput72 USE iom73 USE trcnam_medusa ! JPALM 13-11-2015 -- if iom_use for diag74 !!USE trc_nam_iom_medusa ! JPALM 13-11-2015 -- if iom_use for diag75 # endif76 # if defined key_roam77 USE gastransfer78 # if defined key_mocsy79 USE mocsy_wrapper80 # else81 USE trcco2_medusa82 # endif83 USE trcoxy_medusa84 !! Jpalm (08/08/2014)85 USE trcdms_medusa86 # endif87 !! AXY (18/01/12): brought in for benthic timestepping88 USE trcnam_trp ! AXY (24/05/2013)89 USE trdmxl_trc90 USE trdtrc_oce ! AXY (24/05/2013)91 92 64 !! AXY (30/01/14): necessary to find NaNs on HECTOR 93 65 USE, INTRINSIC :: ieee_arithmetic 94 66 67 USE bio_medusa_mod, ONLY: b0, fdep1, & 68 ibenthic, idf, idfval, & 69 # if defined key_roam 70 f_xco2a, & 71 zalk, zdic, zoxy, zsal, ztmp, & 72 # endif 73 # if defined key_mocsy 74 zpho, & 75 # endif 76 zchd, zchn, zdet, zdin, zdtc, & 77 zfer, zpds, zphd, zphn, zsil, & 78 zzme, zzmi 79 USE dom_oce, ONLY: e3t_0, e3t_n, & 80 gdept_0, gdept_n, & 81 gdepw_0, gdepw_n, & 82 nday_year, nsec_day, nyear, & 83 rdt, tmask 84 USE in_out_manager, ONLY: lwp, numout, nn_date0 85 # if defined key_iomput 86 USE iom, ONLY: lk_iomput 87 # endif 88 USE lbclnk, ONLY: lbc_lnk 89 USE lib_mpp, ONLY: ctl_stop 90 USE oce, ONLY: tsb, tsn 91 USE par_kind, ONLY: wp 92 USE par_medusa, ONLY: jpalk, jpchd, jpchn, jpdet, & 93 jpdic, jpdin, jpdtc, jpfer, & 94 jpoxy, jppds, jpphd, jpphn, & 95 jpsil, jpzme, jpzmi 96 USE par_oce, ONLY: jp_sal, jp_tem, jpi, jpim1, & 97 jpj, jpjm1, jpk 95 98 !! JPALM (27-06-2016): add lk_oasis for CO2 and DMS coupling with atm 96 USE sbc_oce, ONLY: lk_oasis 97 USE oce, ONLY: CO2Flux_out_cpl, DMS_out_cpl, PCO2a_in_cpl, chloro_out_cpl 99 USE sbc_oce, ONLY: lk_oasis 100 USE sms_medusa, ONLY: hist_pco2 101 USE trc, ONLY: ln_rsttr, nittrc000, trn 102 USE bio_medusa_init_mod, ONLY: bio_medusa_init 103 USE carb_chem_mod, ONLY: carb_chem 104 USE air_sea_mod, ONLY: air_sea 105 USE plankton_mod, ONLY: plankton 106 USE iron_chem_scav_mod, ONLY: iron_chem_scav 107 USE detritus_mod, ONLY: detritus 108 USE bio_medusa_update_mod, ONLY: bio_medusa_update 109 USE bio_medusa_diag_mod, ONLY: bio_medusa_diag 110 USE bio_medusa_diag_slice_mod, ONLY: bio_medusa_diag_slice 111 USE bio_medusa_fin_mod, ONLY: bio_medusa_fin 98 112 99 113 IMPLICIT NONE 100 114 PRIVATE 101 115 102 PUBLIC trc_bio_medusa ! called in ???116 PUBLIC trc_bio_medusa ! called in trcsms_medusa.F90 103 117 104 118 !!* Substitution … … 113 127 114 128 SUBROUTINE trc_bio_medusa( kt ) 115 !!------------------------------------------------------------------ ---129 !!------------------------------------------------------------------ 116 130 !! *** ROUTINE trc_bio *** 117 131 !! 118 !! ** Purpose : compute the now trend due to biogeochemical processes 119 !! and add it to the general trend of passive tracers equations 120 !! 121 !! ** Method : each now biological flux is calculated in function of now 122 !! concentrations of tracers. 123 !! depending on the tracer, these fluxes are sources or sinks. 124 !! the total of the sources and sinks for each tracer 132 !! ** Purpose : compute the now trend due to biogeochemical processes 133 !! and add it to the general trend of passive tracers 134 !! equations 135 !! 136 !! ** Method : each now biological flux is calculated in function of 137 !! now concentrations of tracers. 138 !! depending on the tracer, these fluxes are sources or 139 !! sinks. 140 !! The total of the sources and sinks for each tracer 125 141 !! is added to the general trend. 126 142 !! … … 132 148 !! IF 'key_trc_diabio' defined , the biogeochemical trends 133 149 !! for passive tracers are saved for futher diagnostics. 134 !!------------------------------------------------------------------ ---135 !! 136 !! 137 !!------------------------------------------------------------------ ----150 !!------------------------------------------------------------------ 151 !! 152 !! 153 !!------------------------------------------------------------------ 138 154 !! Variable conventions 139 !!------------------------------------------------------------------ ----155 !!------------------------------------------------------------------ 140 156 !! 141 157 !! names: z*** - state variable 142 !! f*** - function (or temporary variable used in part of a function) 158 !! f*** - function (or temporary variable used in part of 159 !! a function) 143 160 !! x*** - parameter 144 161 !! b*** - right-hand part (sources and sinks) … … 151 168 INTEGER :: ji,jj,jk,jn 152 169 !! 153 !! AXY (27/07/10): add in indices for depth horizons (for sinking flux 154 !! and seafloor iron inputs) 155 !! INTEGER :: i0100, i0200, i0500, i1000, i1100 156 !! 157 !! model state variables 158 REAL(wp) :: zchn,zchd,zphn,zphd,zpds,zzmi 159 REAL(wp) :: zzme,zdet,zdtc,zdin,zsil,zfer 160 REAL(wp) :: zage 170 INTEGER :: iball 161 171 # if defined key_roam 162 REAL(wp) :: zdic, zalk, zoxy 163 REAL(wp) :: ztmp, zsal 164 # endif 165 # if defined key_mocsy 166 REAL(wp) :: zpho 167 # endif 168 !! 169 !! integrated source and sink terms 170 REAL(wp) :: b0 171 !! AXY (23/08/13): changed from individual variables for each flux to 172 !! an array that holds all fluxes 173 REAL(wp), DIMENSION(jp_medusa) :: btra 174 !! 175 !! primary production and chl related quantities 176 REAL(wp) :: fthetan,faln,fchn1,fchn,fjln,fprn,frn 177 REAL(wp) :: fthetad,fald,fchd1,fchd,fjld,fprd,frd 178 !! AXY (23/11/16): add in light-only limitation term (normalised 0-1 range) 179 REAL(wp) :: fjlim_pn, fjlim_pd 180 !! AXY (03/02/11): add in Liebig terms 181 REAL(wp) :: fpnlim, fpdlim 182 !! AXY (16/07/09): add in Eppley curve functionality 183 REAL(wp) :: loc_T,fun_T,xvpnT,xvpdT 184 INTEGER :: ieppley 185 !! AXY (16/05/11): per Katya's prompting, add in new T-dependence 186 !! for phytoplankton growth only (i.e. no change 187 !! for remineralisation) 188 REAL(wp) :: fun_Q10 189 !! AXY (01/03/10): add in mixed layer PP diagnostics 190 REAL(wp), DIMENSION(jpi,jpj) :: fprn_ml,fprd_ml 191 !! 192 !! nutrient limiting factors 193 REAL(wp) :: fnln,ffln !! N and Fe 194 REAL(wp) :: fnld,ffld,fsld,fsld2 !! N, Fe and Si 195 !! 196 !! silicon cycle 197 REAL(wp) :: fsin,fnsi,fsin1,fnsi1,fnsi2,fprds,fsdiss 198 !! 199 !! iron cycle; includes parameters for Parekh et al. (2005) iron scheme 200 REAL(wp) :: ffetop,ffebot,ffescav 201 REAL(wp) :: xLgF, xFeT, xFeF, xFeL !! state variables for iron-ligand system 202 REAL(wp), DIMENSION(jpi,jpj) :: xFree !! state variables for iron-ligand system 203 REAL(wp) :: xb_coef_tmp, xb2M4ac !! iron-ligand parameters 204 REAL(wp) :: xmaxFeF,fdeltaFe !! max Fe' parameters 205 !! 206 !! local parameters for Moore et al. (2004) alternative scavenging scheme 207 REAL(wp) :: fbase_scav,fscal_sink,fscal_part,fscal_scav 208 !! 209 !! local parameters for Moore et al. (2008) alternative scavenging scheme 210 REAL(wp) :: fscal_csink,fscal_sisink,fscal_casink 211 !! 212 !! local parameters for Galbraith et al. (2010) alternative scavenging scheme 213 REAL(wp) :: xCscav1, xCscav2, xk_org, xORGscav !! organic portion of scavenging 214 REAL(wp) :: xk_inorg, xINORGscav !! inorganic portion of scavenging 215 !! 216 !! microzooplankton grazing 217 REAL(wp) :: fmi1,fmi,fgmipn,fgmid,fgmidc 218 REAL(wp) :: finmi,ficmi,fstarmi,fmith,fmigrow,fmiexcr,fmiresp 219 !! 220 !! mesozooplankton grazing 221 REAL(wp) :: fme1,fme,fgmepn,fgmepd,fgmepds,fgmezmi,fgmed,fgmedc 222 REAL(wp) :: finme,ficme,fstarme,fmeth,fmegrow,fmeexcr,fmeresp 223 !! 224 !! mortality/Remineralisation (defunct parameter "fz" removed) 225 REAL(wp) :: fdpn,fdpd,fdpds,fdzmi,fdzme,fdd 226 # if defined key_roam 227 REAL(wp) :: fddc 228 # endif 229 REAL(wp) :: fdpn2,fdpd2,fdpds2,fdzmi2,fdzme2 230 REAL(wp) :: fslown, fslowc 231 REAL(wp), DIMENSION(jpi,jpj) :: fslownflux, fslowcflux 232 REAL(wp) :: fregen,fregensi 233 REAL(wp), DIMENSION(jpi,jpj) :: fregenfast,fregenfastsi 234 # if defined key_roam 235 REAL(wp) :: fregenc 236 REAL(wp), DIMENSION(jpi,jpj) :: fregenfastc 237 # endif 238 !! 239 !! particle flux 240 REAL(WP) :: fthk,fdep,fdep1,fdep2,flat,fcaco3 241 REAL(WP) :: ftempn,ftempsi,ftempfe,ftempc,ftempca 242 REAL(wp) :: freminn,freminsi,freminfe,freminc,freminca 243 REAL(wp), DIMENSION(jpi,jpj) :: ffastn,ffastsi,ffastfe,ffastc,ffastca 244 REAL(wp) :: fleftn,fleftsi,fleftfe,fleftc,fleftca 245 REAL(wp) :: fheren,fheresi,fherefe,fherec,fhereca 246 REAL(wp) :: fprotf 247 REAL(wp), DIMENSION(jpi,jpj) :: fsedn,fsedsi,fsedfe,fsedc,fsedca 248 REAL(wp), DIMENSION(jpi,jpj) :: fccd 249 REAL(wp) :: fccd_dep 250 !! AXY (28/11/16): fix mbathy bug 251 INTEGER :: jmbathy 252 !! 253 !! AXY (06/07/11): alternative fast detritus schemes 254 REAL(wp) :: fb_val, fl_sst 255 !! 256 !! AXY (08/07/11): fate of fast detritus reaching the seafloor 257 REAL(wp) :: ffast2slown,ffast2slowfe,ffast2slowc 258 !! 259 !! conservation law 260 REAL(wp) :: fnit0,fsil0,ffer0 261 # if defined key_roam 262 REAL(wp) :: fcar0,falk0,foxy0 263 # endif 172 !! 173 INTEGER :: iyr1, iyr2 174 !! 175 # endif 264 176 !! 265 177 !! temporary variables 266 REAL(wp) :: fq0,fq1,fq2,fq3,fq4,fq5,fq6,fq7,fq8,fq9 267 !! 268 !! water column nutrient and flux integrals 269 REAL(wp), DIMENSION(jpi,jpj) :: ftot_n,ftot_si,ftot_fe 270 REAL(wp), DIMENSION(jpi,jpj) :: fflx_n,fflx_si,fflx_fe 271 REAL(wp), DIMENSION(jpi,jpj) :: fifd_n,fifd_si,fifd_fe 272 REAL(wp), DIMENSION(jpi,jpj) :: fofd_n,fofd_si,fofd_fe 273 # if defined key_roam 274 REAL(wp), DIMENSION(jpi,jpj) :: ftot_c,ftot_a,ftot_o2 275 REAL(wp), DIMENSION(jpi,jpj) :: fflx_c,fflx_a,fflx_o2 276 REAL(wp), DIMENSION(jpi,jpj) :: fifd_c,fifd_a,fifd_o2 277 REAL(wp), DIMENSION(jpi,jpj) :: fofd_c,fofd_a,fofd_o2 278 # endif 279 !! 280 !! zooplankton grazing integrals 281 REAL(wp), DIMENSION(jpi,jpj) :: fzmi_i,fzmi_o,fzme_i,fzme_o 282 !! 283 !! limitation term temporary variables 284 REAL(wp), DIMENSION(jpi,jpj) :: ftot_pn,ftot_pd 285 REAL(wp), DIMENSION(jpi,jpj) :: ftot_zmi,ftot_zme,ftot_det,ftot_dtc 286 !! use ballast scheme (1) or simple exponential scheme (0; a conservation test) 287 INTEGER :: iball 288 !! use biological fluxes (1) or not (0) 289 INTEGER :: ibio_switch 290 !! 291 !! diagnose fluxes (should only be used in 1D runs) 292 INTEGER :: idf, idfval 293 !! 294 !! nitrogen and silicon production and consumption 295 REAL(wp) :: fn_prod, fn_cons, fs_prod, fs_cons 296 REAL(wp), DIMENSION(jpi,jpj) :: fnit_prod, fnit_cons, fsil_prod, fsil_cons 297 # if defined key_roam 298 !! 299 !! flags to help with calculating the position of the CCD 300 INTEGER, DIMENSION(jpi,jpj) :: i2_omcal,i2_omarg 301 !! 302 !! ROAM air-sea flux and diagnostic parameters 303 REAL(wp) :: f_wind 304 !! AXY (24/11/16): add xCO2 variable for atmosphere (what we actually have) 305 REAL(wp) :: f_xco2a 306 REAL(wp) :: f_ph, f_pco2w, f_h2co3, f_hco3, f_co3, f_co2flux 307 REAL(wp) :: f_TDIC, f_TALK, f_dcf, f_henry 308 REAL(wp) :: f_uwind, f_vwind, f_pp0 309 REAL(wp) :: f_kw660, f_o2flux, f_o2sat, f_o2sat3 310 REAL(wp), DIMENSION(jpi,jpj) :: f_omcal, f_omarg 311 !! 312 !! AXY (23/06/15): additional diagnostics for MOCSY and oxygen 313 REAL(wp) :: f_fco2w, f_BetaD, f_rhosw, f_opres, f_insitut, f_pco2atm, f_fco2atm 314 REAL(wp) :: f_schmidtco2, f_kwco2, f_K0, f_co2starair, f_dpco2, f_kwo2 315 !! jpalm 14-07-2016: convert CO2flux diag from mmol/m2/d to kg/m2/s 316 REAL, PARAMETER :: weight_CO2_mol = 44.0095 !! g / mol 317 REAL, PARAMETER :: secs_in_day = 86400.0 !! s / d 318 REAL, PARAMETER :: CO2flux_conv = (1.e-6 * weight_CO2_mol) / secs_in_day 319 320 !! 321 INTEGER :: iters 322 REAL(wp) :: f_year 323 INTEGER :: i_year 324 INTEGER :: iyr1, iyr2 325 !! 326 !! carbon, alkalinity production and consumption 327 REAL(wp) :: fc_prod, fc_cons, fa_prod, fa_cons 328 REAL(wp), DIMENSION(jpi,jpj) :: fcomm_resp 329 REAL(wp), DIMENSION(jpi,jpj) :: fcar_prod, fcar_cons 330 !! 331 !! oxygen production and consumption (and non-consumption) 332 REAL(wp) :: fo2_prod, fo2_cons, fo2_ncons, fo2_ccons 333 REAL(wp), DIMENSION(jpi,jpj) :: foxy_prod, foxy_cons, foxy_anox 334 !! Jpalm (11-08-2014) 335 !! add DMS in MEDUSA for UKESM1 model 336 REAL(wp) :: dms_surf 337 !! AXY (13/03/15): add in other DMS calculations 338 REAL(wp) :: dms_andr, dms_simo, dms_aran, dms_hall, dms_andm, dms_nlim, dms_wtkn 339 340 # endif 341 !! 342 !! benthic fluxes 343 INTEGER :: ibenthic 344 REAL(wp), DIMENSION(jpi,jpj) :: f_sbenin_n, f_sbenin_fe, f_sbenin_c 345 REAL(wp), DIMENSION(jpi,jpj) :: f_fbenin_n, f_fbenin_fe, f_fbenin_si, f_fbenin_c, f_fbenin_ca 346 REAL(wp), DIMENSION(jpi,jpj) :: f_benout_n, f_benout_fe, f_benout_si, f_benout_c, f_benout_ca 347 REAL(wp) :: zfact 348 !! 349 !! benthic fluxes of CaCO3 that shouldn't happen because of lysocline 350 REAL(wp), DIMENSION(jpi,jpj) :: f_benout_lyso_ca 351 !! 352 !! riverine fluxes 353 REAL(wp), DIMENSION(jpi,jpj) :: f_runoff, f_riv_n, f_riv_si, f_riv_c, f_riv_alk 354 !! AXY (19/07/12): variables for local riverine fluxes to handle inputs below surface 355 REAL(wp) :: f_riv_loc_n, f_riv_loc_si, f_riv_loc_c, f_riv_loc_alk 356 !! 357 !! Jpalm -- 11-10-2015 -- adapt diag to iom_use 358 !! 2D var for diagnostics. 359 REAL(wp), POINTER, DIMENSION(:,: ) :: fprn2d, fdpn2d, fprd2d, fdpd2d, fprds2d, fsdiss2d, fgmipn2d 360 REAL(wp), POINTER, DIMENSION(:,: ) :: fgmid2d, fdzmi2d, fgmepn2d, fgmepd2d, fgmezmi2d, fgmed2d 361 REAL(wp), POINTER, DIMENSION(:,: ) :: fdzme2d, fslown2d, fdd2d, ffetop2d, ffebot2d, ffescav2d 362 REAL(wp), POINTER, DIMENSION(:,: ) :: fjln2d, fnln2d, ffln2d, fjld2d, fnld2d, ffld2d, fsld2d2 363 REAL(wp), POINTER, DIMENSION(:,: ) :: fsld2d, fregen2d, fregensi2d, ftempn2d, ftempsi2d, ftempfe2d 364 REAL(wp), POINTER, DIMENSION(:,: ) :: ftempc2d, ftempca2d, freminn2d, freminsi2d, freminfe2d 365 REAL(wp), POINTER, DIMENSION(:,: ) :: freminc2d, freminca2d 366 REAL(wp), POINTER, DIMENSION(:,: ) :: zw2d 367 # if defined key_roam 368 REAL(wp), POINTER, DIMENSION(:,: ) :: ffastca2d, rivn2d, rivsi2d, rivc2d, rivalk2d, fslowc2d 369 REAL(wp), POINTER, DIMENSION(:,: ) :: fdpn22d, fdpd22d, fdzmi22d, fdzme22d, zimesn2d, zimesd2d 370 REAL(wp), POINTER, DIMENSION(:,: ) :: zimesc2d, zimesdc2d, ziexcr2d, ziresp2d, zigrow2d, zemesn2d 371 REAL(wp), POINTER, DIMENSION(:,: ) :: zemesd2d, zemesc2d, zemesdc2d, zeexcr2d, zeresp2d, zegrow2d 372 REAL(wp), POINTER, DIMENSION(:,: ) :: mdetc2d, gmidc2d, gmedc2d, f_pco2a2d, f_pco2w2d, f_co2flux2d 373 REAL(wp), POINTER, DIMENSION(:,: ) :: f_TDIC2d, f_TALK2d, f_kw6602d, f_pp02d, f_o2flux2d, f_o2sat2d 374 REAL(wp), POINTER, DIMENSION(:,: ) :: dms_andr2d, dms_simo2d, dms_aran2d, dms_hall2d, dms_andm2d, dms_surf2d 375 REAL(wp), POINTER, DIMENSION(:,: ) :: iben_n2d, iben_fe2d, iben_c2d, iben_si2d, iben_ca2d, oben_n2d 376 REAL(wp), POINTER, DIMENSION(:,: ) :: oben_fe2d, oben_c2d, oben_si2d, oben_ca2d, sfr_ocal2d 377 REAL(wp), POINTER, DIMENSION(:,: ) :: sfr_oarg2d, lyso_ca2d 378 !! AXY (23/11/16): extra MOCSY diagnostics 379 REAL(wp), POINTER, DIMENSION(:,: ) :: f_xco2a_2d, f_fco2w_2d, f_fco2a_2d 380 REAL(wp), POINTER, DIMENSION(:,: ) :: f_ocnrhosw_2d, f_ocnschco2_2d, f_ocnkwco2_2d 381 REAL(wp), POINTER, DIMENSION(:,: ) :: f_ocnk0_2d, f_co2starair_2d, f_ocndpco2_2d 382 # endif 383 !! 384 !! 3D var for diagnostics. 385 REAL(wp), POINTER, DIMENSION(:,:,:) :: tpp3d, detflux3d, remin3dn 386 !! 387 # if defined key_roam 388 !! AXY (04/11/16) 389 !! 2D var for new CMIP6 diagnostics (behind a key_roam ifdef for simplicity) 390 REAL(wp), POINTER, DIMENSION(:,: ) :: fgco2, intdissic, intdissin, intdissisi, inttalk, o2min, zo2min 391 REAL(wp), POINTER, DIMENSION(:,: ) :: fbddtalk, fbddtdic, fbddtdife, fbddtdin, fbddtdisi 392 !! 393 !! 3D var for new CMIP6 diagnostics 394 REAL(wp), POINTER, DIMENSION(:,:,:) :: tppd3 395 REAL(wp), POINTER, DIMENSION(:,:,:) :: bddtalk3, bddtdic3, bddtdife3, bddtdin3, bddtdisi3 396 REAL(wp), POINTER, DIMENSION(:,:,:) :: fd_nit3, fd_sil3, fd_car3, fd_cal3 397 REAL(wp), POINTER, DIMENSION(:,:,:) :: co33, co3satarag3, co3satcalc3, dcalc3 398 REAL(wp), POINTER, DIMENSION(:,:,:) :: expc3, expn3 399 REAL(wp), POINTER, DIMENSION(:,:,:) :: fediss3, fescav3 400 REAL(wp), POINTER, DIMENSION(:,:,:) :: migrazp3, migrazd3, megrazp3, megrazd3, megrazz3 401 REAL(wp), POINTER, DIMENSION(:,:,:) :: o2sat3, pbsi3, pcal3, remoc3 402 REAL(wp), POINTER, DIMENSION(:,:,:) :: pnlimj3, pnlimn3, pnlimfe3, pdlimj3, pdlimn3, pdlimfe3, pdlimsi3 403 # endif 404 !!--------------------------------------------------------------------- 178 REAL(wp) :: fq0,fq1,fq2,fq3,fq4 179 !! 180 !!------------------------------------------------------------------ 405 181 406 182 # if defined key_debug_medusa … … 421 197 ibenthic = 1 422 198 423 !! not sure what this is for; it's not used anywhere; commenting out 424 !! fbodn(:,:) = 0.e0 425 426 !! 427 IF( ln_diatrc ) THEN 428 !! blank 2D diagnostic array 429 trc2d(:,:,:) = 0.e0 430 !! 431 !! blank 3D diagnostic array 432 trc3d(:,:,:,:) = 0.e0 433 ENDIF 434 435 !!---------------------------------------------------------------------- 199 !!------------------------------------------------------------------ 436 200 !! b0 is present for debugging purposes; using b0 = 0 sets the tendency 437 201 !! terms of all biological equations to 0. 438 !!------------------------------------------------------------------ ----202 !!------------------------------------------------------------------ 439 203 !! 440 204 !! AXY (03/09/14): probably not the smartest move ever, but it'll fit … … 446 210 b0 = 1. 447 211 # endif 448 !!------------------------------------------------------------------ ----212 !!------------------------------------------------------------------ 449 213 !! fast detritus ballast scheme (0 = no; 1 = yes) 450 214 !! alternative to ballast scheme is same scheme but with no ballast 451 215 !! protection (not dissimilar to Martin et al., 1987) 452 !!------------------------------------------------------------------ ----216 !!------------------------------------------------------------------ 453 217 !! 454 218 iball = 1 455 219 456 !!------------------------------------------------------------------ ----220 !!------------------------------------------------------------------ 457 221 !! full flux diagnostics (0 = no; 1 = yes); appear in ocean.output 458 222 !! these should *only* be used in 1D since they give comprehensive 459 223 !! output for ecological functions in the model; primarily used in 460 224 !! debugging 461 !!------------------------------------------------------------------ ----225 !!------------------------------------------------------------------ 462 226 !! 463 227 idf = 0 … … 470 234 endif 471 235 472 !!---------------------------------------------------------------------- 473 !! blank fast-sinking detritus 2D fields 474 !!---------------------------------------------------------------------- 475 !! 476 ffastn(:,:) = 0.0 !! organic nitrogen 477 ffastsi(:,:) = 0.0 !! biogenic silicon 478 ffastfe(:,:) = 0.0 !! organic iron 479 ffastc(:,:) = 0.0 !! organic carbon 480 ffastca(:,:) = 0.0 !! biogenic calcium carbonate 481 !! 482 fsedn(:,:) = 0.0 !! Seafloor flux of N 483 fsedsi(:,:) = 0.0 !! Seafloor flux of Si 484 fsedfe(:,:) = 0.0 !! Seafloor flux of Fe 485 fsedc(:,:) = 0.0 !! Seafloor flux of C 486 fsedca(:,:) = 0.0 !! Seafloor flux of CaCO3 487 !! 488 fregenfast(:,:) = 0.0 !! integrated N regeneration (fast detritus) 489 fregenfastsi(:,:) = 0.0 !! integrated Si regeneration (fast detritus) 490 # if defined key_roam 491 fregenfastc(:,:) = 0.0 !! integrated C regeneration (fast detritus) 492 # endif 493 !! 494 fccd(:,:) = 0.0 !! last depth level before CCD 495 496 !!---------------------------------------------------------------------- 497 !! blank nutrient/flux inventories 498 !!---------------------------------------------------------------------- 499 !! 500 fflx_n(:,:) = 0.0 !! nitrogen flux total 501 fflx_si(:,:) = 0.0 !! silicon flux total 502 fflx_fe(:,:) = 0.0 !! iron flux total 503 fifd_n(:,:) = 0.0 !! nitrogen fast detritus production 504 fifd_si(:,:) = 0.0 !! silicon fast detritus production 505 fifd_fe(:,:) = 0.0 !! iron fast detritus production 506 fofd_n(:,:) = 0.0 !! nitrogen fast detritus remineralisation 507 fofd_si(:,:) = 0.0 !! silicon fast detritus remineralisation 508 fofd_fe(:,:) = 0.0 !! iron fast detritus remineralisation 509 # if defined key_roam 510 fflx_c(:,:) = 0.0 !! carbon flux total 511 fflx_a(:,:) = 0.0 !! alkalinity flux total 512 fflx_o2(:,:) = 0.0 !! oxygen flux total 513 ftot_c(:,:) = 0.0 !! carbon inventory 514 ftot_a(:,:) = 0.0 !! alkalinity inventory 515 ftot_o2(:,:) = 0.0 !! oxygen inventory 516 fifd_c(:,:) = 0.0 !! carbon fast detritus production 517 fifd_a(:,:) = 0.0 !! alkalinity fast detritus production 518 fifd_o2(:,:) = 0.0 !! oxygen fast detritus production 519 fofd_c(:,:) = 0.0 !! carbon fast detritus remineralisation 520 fofd_a(:,:) = 0.0 !! alkalinity fast detritus remineralisation 521 fofd_o2(:,:) = 0.0 !! oxygen fast detritus remineralisation 522 !! 523 fnit_prod(:,:) = 0.0 !! (organic) nitrogen production 524 fnit_cons(:,:) = 0.0 !! (organic) nitrogen consumption 525 fsil_prod(:,:) = 0.0 !! (inorganic) silicon production 526 fsil_cons(:,:) = 0.0 !! (inorganic) silicon consumption 527 fcar_prod(:,:) = 0.0 !! (organic) carbon production 528 fcar_cons(:,:) = 0.0 !! (organic) carbon consumption 529 !! 530 foxy_prod(:,:) = 0.0 !! oxygen production 531 foxy_cons(:,:) = 0.0 !! oxygen consumption 532 foxy_anox(:,:) = 0.0 !! unrealised oxygen consumption 533 !! 534 # endif 535 ftot_n(:,:) = 0.0 !! N inventory 536 ftot_si(:,:) = 0.0 !! Si inventory 537 ftot_fe(:,:) = 0.0 !! Fe inventory 538 ftot_pn(:,:) = 0.0 !! integrated non-diatom phytoplankton 539 ftot_pd(:,:) = 0.0 !! integrated diatom phytoplankton 540 ftot_zmi(:,:) = 0.0 !! integrated microzooplankton 541 ftot_zme(:,:) = 0.0 !! integrated mesozooplankton 542 ftot_det(:,:) = 0.0 !! integrated slow detritus, nitrogen 543 ftot_dtc(:,:) = 0.0 !! integrated slow detritus, carbon 544 !! 545 fzmi_i(:,:) = 0.0 !! material grazed by microzooplankton 546 fzmi_o(:,:) = 0.0 !! ... sum of fate of this material 547 fzme_i(:,:) = 0.0 !! material grazed by mesozooplankton 548 fzme_o(:,:) = 0.0 !! ... sum of fate of this material 549 !! 550 f_sbenin_n(:,:) = 0.0 !! slow detritus N -> benthic pool 551 f_sbenin_fe(:,:) = 0.0 !! slow detritus Fe -> benthic pool 552 f_sbenin_c(:,:) = 0.0 !! slow detritus C -> benthic pool 553 f_fbenin_n(:,:) = 0.0 !! fast detritus N -> benthic pool 554 f_fbenin_fe(:,:) = 0.0 !! fast detritus Fe -> benthic pool 555 f_fbenin_si(:,:) = 0.0 !! fast detritus Si -> benthic pool 556 f_fbenin_c(:,:) = 0.0 !! fast detritus C -> benthic pool 557 f_fbenin_ca(:,:) = 0.0 !! fast detritus Ca -> benthic pool 558 !! 559 f_benout_n(:,:) = 0.0 !! benthic N pool -> dissolved 560 f_benout_fe(:,:) = 0.0 !! benthic Fe pool -> dissolved 561 f_benout_si(:,:) = 0.0 !! benthic Si pool -> dissolved 562 f_benout_c(:,:) = 0.0 !! benthic C pool -> dissolved 563 f_benout_ca(:,:) = 0.0 !! benthic Ca pool -> dissolved 564 !! 565 f_benout_lyso_ca(:,:) = 0.0 !! benthic Ca pool -> dissolved (when it shouldn't!) 566 !! 567 f_runoff(:,:) = 0.0 !! riverine runoff 568 f_riv_n(:,:) = 0.0 !! riverine N input 569 f_riv_si(:,:) = 0.0 !! riverine Si input 570 f_riv_c(:,:) = 0.0 !! riverine C input 571 f_riv_alk(:,:) = 0.0 !! riverine alk input 572 !! 573 !! Jpalm -- 06-03-2017 -- Forgotten var to init 574 f_omarg(:,:) = 0.0 !! 575 f_omcal(:,:) = 0.0 576 xFree(:,:) = 0.0 !! state variables for iron-ligand system 577 fcomm_resp(:,:) = 0.0 578 fprn_ml(:,:) = 0.0 !! mixed layer PP diagnostics 579 fprd_ml(:,:) = 0.0 !! mixed layer PP diagnostics 580 !! 581 fslownflux(:,:) = 0.0 582 fslowcflux(:,:) = 0.0 583 584 !! 585 !! allocate and initiate 2D diag 586 !! ----------------------------- 587 !! Juju :: add kt condition !! 588 IF ( lk_iomput .AND. .NOT. ln_diatrc ) THEN 589 !! 590 if ( kt == nittrc000 ) CALL trc_nam_iom_medusa !! initialise iom_use test 591 !! 592 CALL wrk_alloc( jpi, jpj, zw2d ) 593 zw2d(:,:) = 0.0 !! 594 IF ( med_diag%PRN%dgsave ) THEN 595 CALL wrk_alloc( jpi, jpj, fprn2d ) 596 fprn2d(:,:) = 0.0 !! 597 ENDIF 598 IF ( med_diag%MPN%dgsave ) THEN 599 CALL wrk_alloc( jpi, jpj, fdpn2d ) 600 fdpn2d(:,:) = 0.0 !! 601 ENDIF 602 IF ( med_diag%PRD%dgsave ) THEN 603 CALL wrk_alloc( jpi, jpj, fprd2d ) 604 fprd2d(:,:) = 0.0 !! 605 ENDIF 606 IF( med_diag%MPD%dgsave ) THEN 607 CALL wrk_alloc( jpi, jpj, fdpd2d ) 608 fdpd2d(:,:) = 0.0 !! 609 ENDIF 610 IF( med_diag%OPAL%dgsave ) THEN 611 CALL wrk_alloc( jpi, jpj, fprds2d ) 612 fprds2d(:,:) = 0.0 !! 613 ENDIF 614 IF( med_diag%OPALDISS%dgsave ) THEN 615 CALL wrk_alloc( jpi, jpj, fsdiss2d ) 616 fsdiss2d(:,:) = 0.0 !! 617 ENDIF 618 IF( med_diag%GMIPn%dgsave ) THEN 619 CALL wrk_alloc( jpi, jpj, fgmipn2d ) 620 fgmipn2d(:,:) = 0.0 !! 621 ENDIF 622 IF( med_diag%GMID%dgsave ) THEN 623 CALL wrk_alloc( jpi, jpj, fgmid2d ) 624 fgmid2d(:,:) = 0.0 !! 625 ENDIF 626 IF( med_diag%MZMI%dgsave ) THEN 627 CALL wrk_alloc( jpi, jpj, fdzmi2d ) 628 fdzmi2d(:,:) = 0.0 !! 629 ENDIF 630 IF( med_diag%GMEPN%dgsave ) THEN 631 CALL wrk_alloc( jpi, jpj, fgmepn2d ) 632 fgmepn2d(:,:) = 0.0 !! 633 ENDIF 634 IF( med_diag%GMEPD%dgsave ) THEN 635 CALL wrk_alloc( jpi, jpj, fgmepd2d ) 636 fgmepd2d(:,:) = 0.0 !! 637 ENDIF 638 IF( med_diag%GMEZMI%dgsave ) THEN 639 CALL wrk_alloc( jpi, jpj, fgmezmi2d ) 640 fgmezmi2d(:,:) = 0.0 !! 641 ENDIF 642 IF( med_diag%GMED%dgsave ) THEN 643 CALL wrk_alloc( jpi, jpj, fgmed2d ) 644 fgmed2d(:,:) = 0.0 !! 645 ENDIF 646 IF( med_diag%MZME%dgsave ) THEN 647 CALL wrk_alloc( jpi, jpj, fdzme2d ) 648 fdzme2d(:,:) = 0.0 !! 649 ENDIF 650 IF( med_diag%DETN%dgsave ) THEN 651 CALL wrk_alloc( jpi, jpj, fslown2d ) 652 fslown2d(:,:) = 0.0 !! 653 ENDIF 654 IF( med_diag%MDET%dgsave ) THEN 655 CALL wrk_alloc( jpi, jpj, fdd2d ) 656 fdd2d(:,:) = 0.0 !! 657 ENDIF 658 IF( med_diag%AEOLIAN%dgsave ) THEN 659 CALL wrk_alloc( jpi, jpj, ffetop2d ) 660 ffetop2d(:,:) = 0.0 !! 661 ENDIF 662 IF( med_diag%BENTHIC%dgsave ) THEN 663 CALL wrk_alloc( jpi, jpj, ffebot2d ) 664 ffebot2d(:,:) = 0.0 !! 665 ENDIF 666 IF( med_diag%SCAVENGE%dgsave ) THEN 667 CALL wrk_alloc( jpi, jpj, ffescav2d ) 668 ffescav2d(:,:) = 0.0 !! 669 ENDIF 670 IF( med_diag%PN_JLIM%dgsave ) THEN 671 CALL wrk_alloc( jpi, jpj, fjln2d ) 672 fjln2d(:,:) = 0.0 !! 673 ENDIF 674 IF( med_diag%PN_NLIM%dgsave ) THEN 675 CALL wrk_alloc( jpi, jpj, fnln2d ) 676 fnln2d(:,:) = 0.0 !! 677 ENDIF 678 IF( med_diag%PN_FELIM%dgsave ) THEN 679 CALL wrk_alloc( jpi, jpj, ffln2d ) 680 ffln2d(:,:) = 0.0 !! 681 ENDIF 682 IF( med_diag%PD_JLIM%dgsave ) THEN 683 CALL wrk_alloc( jpi, jpj, fjld2d ) 684 fjld2d(:,:) = 0.0 !! 685 ENDIF 686 IF( med_diag%PD_NLIM%dgsave ) THEN 687 CALL wrk_alloc( jpi, jpj, fnld2d ) 688 fnld2d(:,:) = 0.0 !! 689 ENDIF 690 IF( med_diag%PD_FELIM%dgsave ) THEN 691 CALL wrk_alloc( jpi, jpj, ffld2d ) 692 ffld2d(:,:) = 0.0 !! 693 ENDIF 694 IF( med_diag%PD_SILIM%dgsave ) THEN 695 CALL wrk_alloc( jpi, jpj, fsld2d2 ) 696 fsld2d2(:,:) = 0.0 !! 697 ENDIF 698 IF( med_diag%PDSILIM2%dgsave ) THEN 699 CALL wrk_alloc( jpi, jpj, fsld2d ) 700 fsld2d(:,:) = 0.0 !! 701 ENDIF 702 !! 703 !! skip SDT_XXXX diagnostics here 704 !! 705 IF( med_diag%TOTREG_N%dgsave ) THEN 706 CALL wrk_alloc( jpi, jpj, fregen2d ) 707 fregen2d(:,:) = 0.0 !! 708 ENDIF 709 IF( med_diag%TOTRG_SI%dgsave ) THEN 710 CALL wrk_alloc( jpi, jpj, fregensi2d ) 711 fregensi2d(:,:) = 0.0 !! 712 ENDIF 713 !! 714 !! skip REG_XXXX diagnostics here 715 !! 716 IF( med_diag%FASTN%dgsave ) THEN 717 CALL wrk_alloc( jpi, jpj, ftempn2d ) 718 ftempn2d(:,:) = 0.0 !! 719 ENDIF 720 IF( med_diag%FASTSI%dgsave ) THEN 721 CALL wrk_alloc( jpi, jpj, ftempsi2d ) 722 ftempsi2d(:,:) = 0.0 !! 723 ENDIF 724 IF( med_diag%FASTFE%dgsave ) THEN 725 CALL wrk_alloc( jpi, jpj, ftempfe2d ) 726 ftempfe2d(:,:) = 0.0 !! 727 ENDIF 728 IF( med_diag%FASTC%dgsave ) THEN 729 CALL wrk_alloc( jpi, jpj, ftempc2d ) 730 ftempc2d(:,:) = 0.0 !! 731 ENDIF 732 IF( med_diag%FASTCA%dgsave ) THEN 733 CALL wrk_alloc( jpi, jpj, ftempca2d ) 734 ftempca2d(:,:) = 0.0 !! 735 ENDIF 736 !! 737 !! skip FDT_XXXX, RG_XXXXF, FDS_XXXX, RGS_XXXXF diagnostics here 738 !! 739 IF( med_diag%REMINN%dgsave ) THEN 740 CALL wrk_alloc( jpi, jpj, freminn2d ) 741 freminn2d(:,:) = 0.0 !! 742 ENDIF 743 IF( med_diag%REMINSI%dgsave ) THEN 744 CALL wrk_alloc( jpi, jpj, freminsi2d ) 745 freminsi2d(:,:) = 0.0 !! 746 ENDIF 747 IF( med_diag%REMINFE%dgsave ) THEN 748 CALL wrk_alloc( jpi, jpj, freminfe2d ) 749 freminfe2d(:,:) = 0.0 !! 750 ENDIF 751 IF( med_diag%REMINC%dgsave ) THEN 752 CALL wrk_alloc( jpi, jpj, freminc2d ) 753 freminc2d(:,:) = 0.0 !! 754 ENDIF 755 IF( med_diag%REMINCA%dgsave ) THEN 756 CALL wrk_alloc( jpi, jpj, freminca2d ) 757 freminca2d(:,:) = 0.0 !! 758 ENDIF 759 # if defined key_roam 760 !! 761 !! skip SEAFLRXX, MED_XXXX, INTFLX_XX, INT_XX, ML_XXX, OCAL_XXX, FE_XXXX, MED_XZE, WIND diagnostics here 762 !! 763 IF( med_diag%RR_0100%dgsave ) THEN 764 CALL wrk_alloc( jpi, jpj, ffastca2d ) 765 ffastca2d(:,:) = 0.0 !! 766 ENDIF 767 768 IF( med_diag%ATM_PCO2%dgsave ) THEN 769 CALL wrk_alloc( jpi, jpj, f_pco2a2d ) 770 f_pco2a2d(:,:) = 0.0 !! 771 ENDIF 772 !! 773 !! skip OCN_PH diagnostic here 774 !! 775 IF( med_diag%OCN_PCO2%dgsave ) THEN 776 CALL wrk_alloc( jpi, jpj, f_pco2w2d ) 777 f_pco2w2d(:,:) = 0.0 !! 778 ENDIF 779 !! 780 !! skip OCNH2CO3, OCN_HCO3, OCN_CO3 diagnostics here 781 !! 782 IF( med_diag%CO2FLUX%dgsave ) THEN 783 CALL wrk_alloc( jpi, jpj, f_co2flux2d ) 784 f_co2flux2d(:,:) = 0.0 !! 785 ENDIF 786 !! 787 !! skip OM_XXX diagnostics here 788 !! 789 IF( med_diag%TCO2%dgsave ) THEN 790 CALL wrk_alloc( jpi, jpj, f_TDIC2d ) 791 f_TDIC2d(:,:) = 0.0 !! 792 ENDIF 793 IF( med_diag%TALK%dgsave ) THEN 794 CALL wrk_alloc( jpi, jpj, f_TALK2d ) 795 f_TALK2d(:,:) = 0.0 !! 796 ENDIF 797 IF( med_diag%KW660%dgsave ) THEN 798 CALL wrk_alloc( jpi, jpj, f_kw6602d ) 799 f_kw6602d(:,:) = 0.0 !! 800 ENDIF 801 IF( med_diag%ATM_PP0%dgsave ) THEN 802 CALL wrk_alloc( jpi, jpj, f_pp02d ) 803 f_pp02d(:,:) = 0.0 !! 804 ENDIF 805 IF( med_diag%O2FLUX%dgsave ) THEN 806 CALL wrk_alloc( jpi, jpj, f_o2flux2d ) 807 f_o2flux2d(:,:) = 0.0 !! 808 ENDIF 809 IF( med_diag%O2SAT%dgsave ) THEN 810 CALL wrk_alloc( jpi, jpj, f_o2sat2d ) 811 f_o2sat2d(:,:) = 0.0 !! 812 ENDIF 813 !! 814 !! skip XXX_CCD diagnostics here 815 !! 816 IF( med_diag%SFR_OCAL%dgsave ) THEN 817 CALL wrk_alloc( jpi, jpj, sfr_ocal2d ) 818 sfr_ocal2d(:,:) = 0.0 !! 819 ENDIF 820 IF( med_diag%SFR_OARG%dgsave ) THEN 821 CALL wrk_alloc( jpi, jpj, sfr_oarg2d ) 822 sfr_oarg2d(:,:) = 0.0 !! 823 ENDIF 824 !! 825 !! skip XX_PROD, XX_CONS, O2_ANOX, RR_XXXX diagnostics here 826 !! 827 IF( med_diag%IBEN_N%dgsave ) THEN 828 CALL wrk_alloc( jpi, jpj, iben_n2d ) 829 iben_n2d(:,:) = 0.0 !! 830 ENDIF 831 IF( med_diag%IBEN_FE%dgsave ) THEN 832 CALL wrk_alloc( jpi, jpj, iben_fe2d ) 833 iben_fe2d(:,:) = 0.0 !! 834 ENDIF 835 IF( med_diag%IBEN_C%dgsave ) THEN 836 CALL wrk_alloc( jpi, jpj, iben_c2d ) 837 iben_c2d(:,:) = 0.0 !! 838 ENDIF 839 IF( med_diag%IBEN_SI%dgsave ) THEN 840 CALL wrk_alloc( jpi, jpj, iben_si2d ) 841 iben_si2d(:,:) = 0.0 !! 842 ENDIF 843 IF( med_diag%IBEN_CA%dgsave ) THEN 844 CALL wrk_alloc( jpi, jpj, iben_ca2d ) 845 iben_ca2d(:,:) = 0.0 !! 846 ENDIF 847 IF( med_diag%OBEN_N%dgsave ) THEN 848 CALL wrk_alloc( jpi, jpj, oben_n2d ) 849 oben_n2d(:,:) = 0.0 !! 850 ENDIF 851 IF( med_diag%OBEN_FE%dgsave ) THEN 852 CALL wrk_alloc( jpi, jpj, oben_fe2d ) 853 oben_fe2d(:,:) = 0.0 !! 854 ENDIF 855 IF( med_diag%OBEN_C%dgsave ) THEN 856 CALL wrk_alloc( jpi, jpj, oben_c2d ) 857 oben_c2d(:,:) = 0.0 !! 858 ENDIF 859 IF( med_diag%OBEN_SI%dgsave ) THEN 860 CALL wrk_alloc( jpi, jpj, oben_si2d ) 861 oben_si2d(:,:) = 0.0 !! 862 ENDIF 863 IF( med_diag%OBEN_CA%dgsave ) THEN 864 CALL wrk_alloc( jpi, jpj, oben_ca2d ) 865 oben_ca2d(:,:) = 0.0 !! 866 ENDIF 867 !! 868 !! skip BEN_XX diagnostics here 869 !! 870 IF( med_diag%RIV_N%dgsave ) THEN 871 CALL wrk_alloc( jpi, jpj, rivn2d ) 872 rivn2d(:,:) = 0.0 !! 873 ENDIF 874 IF( med_diag%RIV_SI%dgsave ) THEN 875 CALL wrk_alloc( jpi, jpj, rivsi2d ) 876 rivsi2d(:,:) = 0.0 !! 877 ENDIF 878 IF( med_diag%RIV_C%dgsave ) THEN 879 CALL wrk_alloc( jpi, jpj, rivc2d ) 880 rivc2d(:,:) = 0.0 !! 881 ENDIF 882 IF( med_diag%RIV_ALK%dgsave ) THEN 883 CALL wrk_alloc( jpi, jpj, rivalk2d ) 884 rivalk2d(:,:) = 0.0 !! 885 ENDIF 886 IF( med_diag%DETC%dgsave ) THEN 887 CALL wrk_alloc( jpi, jpj, fslowc2d ) 888 fslowc2d(:,:) = 0.0 !! 889 ENDIF 890 !! 891 !! skip SDC_XXXX, INVTXXX diagnostics here 892 !! 893 IF( med_diag%LYSO_CA%dgsave ) THEN 894 CALL wrk_alloc( jpi, jpj, lyso_ca2d ) 895 lyso_ca2d(:,:) = 0.0 !! 896 ENDIF 897 !! 898 !! skip COM_RESP diagnostic here 899 !! 900 IF( med_diag%PN_LLOSS%dgsave ) THEN 901 CALL wrk_alloc( jpi, jpj, fdpn22d ) 902 fdpn22d(:,:) = 0.0 !! 903 ENDIF 904 IF( med_diag%PD_LLOSS%dgsave ) THEN 905 CALL wrk_alloc( jpi, jpj, fdpd22d ) 906 fdpd22d(:,:) = 0.0 !! 907 ENDIF 908 IF( med_diag%ZI_LLOSS%dgsave ) THEN 909 CALL wrk_alloc( jpi, jpj, fdzmi22d ) 910 fdzmi22d(:,:) = 0.0 !! 911 ENDIF 912 IF( med_diag%ZE_LLOSS%dgsave ) THEN 913 CALL wrk_alloc( jpi, jpj, fdzme22d ) 914 fdzme22d(:,:) = 0.0 !! 915 ENDIF 916 IF( med_diag%ZI_MES_N%dgsave ) THEN 917 CALL wrk_alloc( jpi, jpj, zimesn2d ) 918 zimesn2d(:,:) = 0.0 !! 919 ENDIF 920 IF( med_diag%ZI_MES_D%dgsave ) THEN 921 CALL wrk_alloc( jpi, jpj, zimesd2d ) 922 zimesd2d(:,:) = 0.0 !! 923 ENDIF 924 IF( med_diag%ZI_MES_C%dgsave ) THEN 925 CALL wrk_alloc( jpi, jpj, zimesc2d ) 926 zimesc2d(:,:) = 0.0 !! 927 ENDIF 928 IF( med_diag%ZI_MESDC%dgsave ) THEN 929 CALL wrk_alloc( jpi, jpj, zimesdc2d ) 930 zimesdc2d(:,:) = 0.0 !! 931 ENDIF 932 IF( med_diag%ZI_EXCR%dgsave ) THEN 933 CALL wrk_alloc( jpi, jpj, ziexcr2d ) 934 ziexcr2d(:,:) = 0.0 !! 935 ENDIF 936 IF( med_diag%ZI_RESP%dgsave ) THEN 937 CALL wrk_alloc( jpi, jpj, ziresp2d ) 938 ziresp2d(:,:) = 0.0 !! 939 ENDIF 940 IF( med_diag%ZI_GROW%dgsave ) THEN 941 CALL wrk_alloc( jpi, jpj, zigrow2d ) 942 zigrow2d(:,:) = 0.0 !! 943 ENDIF 944 IF( med_diag%ZE_MES_N%dgsave ) THEN 945 CALL wrk_alloc( jpi, jpj, zemesn2d ) 946 zemesn2d(:,:) = 0.0 !! 947 ENDIF 948 IF( med_diag%ZE_MES_D%dgsave ) THEN 949 CALL wrk_alloc( jpi, jpj, zemesd2d ) 950 zemesd2d(:,:) = 0.0 !! 951 ENDIF 952 IF( med_diag%ZE_MES_C%dgsave ) THEN 953 CALL wrk_alloc( jpi, jpj, zemesc2d ) 954 zemesc2d(:,:) = 0.0 !! 955 ENDIF 956 IF( med_diag%ZE_MESDC%dgsave ) THEN 957 CALL wrk_alloc( jpi, jpj, zemesdc2d ) 958 zemesdc2d(:,:) = 0.0 !! 959 ENDIF 960 IF( med_diag%ZE_EXCR%dgsave ) THEN 961 CALL wrk_alloc( jpi, jpj, zeexcr2d ) 962 zeexcr2d(:,:) = 0.0 !! 963 ENDIF 964 IF( med_diag%ZE_RESP%dgsave ) THEN 965 CALL wrk_alloc( jpi, jpj, zeresp2d ) 966 zeresp2d(:,:) = 0.0 !! 967 ENDIF 968 IF( med_diag%ZE_GROW%dgsave ) THEN 969 CALL wrk_alloc( jpi, jpj, zegrow2d ) 970 zegrow2d(:,:) = 0.0 !! 971 ENDIF 972 IF( med_diag%MDETC%dgsave ) THEN 973 CALL wrk_alloc( jpi, jpj, mdetc2d ) 974 mdetc2d(:,:) = 0.0 !! 975 ENDIF 976 IF( med_diag%GMIDC%dgsave ) THEN 977 CALL wrk_alloc( jpi, jpj, gmidc2d ) 978 gmidc2d(:,:) = 0.0 !! 979 ENDIF 980 IF( med_diag%GMEDC%dgsave ) THEN 981 CALL wrk_alloc( jpi, jpj, gmedc2d ) 982 gmedc2d(:,:) = 0.0 !! 983 ENDIF 984 !! 985 !! skip INT_XXX diagnostics here 986 !! 987 IF (jdms .eq. 1) THEN 988 IF( med_diag%DMS_SURF%dgsave ) THEN 989 CALL wrk_alloc( jpi, jpj, dms_surf2d ) 990 dms_surf2d(:,:) = 0.0 !! 991 ENDIF 992 IF( med_diag%DMS_ANDR%dgsave ) THEN 993 CALL wrk_alloc( jpi, jpj, dms_andr2d ) 994 dms_andr2d(:,:) = 0.0 !! 995 ENDIF 996 IF( med_diag%DMS_SIMO%dgsave ) THEN 997 CALL wrk_alloc( jpi, jpj, dms_simo2d ) 998 dms_simo2d(:,:) = 0.0 !! 999 ENDIF 1000 IF( med_diag%DMS_ARAN%dgsave ) THEN 1001 CALL wrk_alloc( jpi, jpj, dms_aran2d ) 1002 dms_aran2d(:,:) = 0.0 !! 1003 ENDIF 1004 IF( med_diag%DMS_HALL%dgsave ) THEN 1005 CALL wrk_alloc( jpi, jpj, dms_hall2d ) 1006 dms_hall2d(:,:) = 0.0 !! 1007 ENDIF 1008 IF( med_diag%DMS_ANDM%dgsave ) THEN 1009 CALL wrk_alloc( jpi, jpj, dms_andm2d ) 1010 dms_andm2d(:,:) = 0.0 !! 1011 ENDIF 1012 ENDIF 1013 !! 1014 !! AXY (24/11/16): extra MOCSY diagnostics, 2D 1015 IF( med_diag%ATM_XCO2%dgsave ) THEN 1016 CALL wrk_alloc( jpi, jpj, f_xco2a_2d ) 1017 f_xco2a_2d(:,:) = 0.0 !! 1018 ENDIF 1019 IF( med_diag%OCN_FCO2%dgsave ) THEN 1020 CALL wrk_alloc( jpi, jpj, f_fco2w_2d ) 1021 f_fco2w_2d(:,:) = 0.0 !! 1022 ENDIF 1023 IF( med_diag%ATM_FCO2%dgsave ) THEN 1024 CALL wrk_alloc( jpi, jpj, f_fco2a_2d ) 1025 f_fco2a_2d(:,:) = 0.0 !! 1026 ENDIF 1027 IF( med_diag%OCN_RHOSW%dgsave ) THEN 1028 CALL wrk_alloc( jpi, jpj, f_ocnrhosw_2d ) 1029 f_ocnrhosw_2d(:,:) = 0.0 !! 1030 ENDIF 1031 IF( med_diag%OCN_SCHCO2%dgsave ) THEN 1032 CALL wrk_alloc( jpi, jpj, f_ocnschco2_2d ) 1033 f_ocnschco2_2d(:,:) = 0.0 !! 1034 ENDIF 1035 IF( med_diag%OCN_KWCO2%dgsave ) THEN 1036 CALL wrk_alloc( jpi, jpj, f_ocnkwco2_2d ) 1037 f_ocnkwco2_2d(:,:) = 0.0 !! 1038 ENDIF 1039 IF( med_diag%OCN_K0%dgsave ) THEN 1040 CALL wrk_alloc( jpi, jpj, f_ocnk0_2d ) 1041 f_ocnk0_2d(:,:) = 0.0 !! 1042 ENDIF 1043 IF( med_diag%CO2STARAIR%dgsave ) THEN 1044 CALL wrk_alloc( jpi, jpj, f_co2starair_2d ) 1045 f_co2starair_2d(:,:) = 0.0 !! 1046 ENDIF 1047 IF( med_diag%OCN_DPCO2%dgsave ) THEN 1048 CALL wrk_alloc( jpi, jpj, f_ocndpco2_2d ) 1049 f_ocndpco2_2d(:,:) = 0.0 !! 1050 ENDIF 1051 # endif 1052 IF( med_diag%TPP3%dgsave ) THEN 1053 CALL wrk_alloc( jpi, jpj, jpk, tpp3d ) 1054 tpp3d(:,:,:) = 0.0 !! 1055 ENDIF 1056 IF( med_diag%DETFLUX3%dgsave ) THEN 1057 CALL wrk_alloc( jpi, jpj, jpk, detflux3d ) 1058 detflux3d(:,:,:) = 0.0 !! 1059 ENDIF 1060 IF( med_diag%REMIN3N%dgsave ) THEN 1061 CALL wrk_alloc( jpi, jpj, jpk, remin3dn ) 1062 remin3dn(:,:,:) = 0.0 !! 1063 ENDIF 1064 !! 1065 !! AXY (10/11/16): CMIP6 diagnostics, 2D 1066 !! JPALM -- 17-11-16 -- put fgco2 alloc out of diag request 1067 !! needed for coupling/passed through restart 1068 !! IF( med_diag%FGCO2%dgsave ) THEN 1069 CALL wrk_alloc( jpi, jpj, fgco2 ) 1070 fgco2(:,:) = 0.0 !! 1071 !! ENDIF 1072 IF( med_diag%INTDISSIC%dgsave ) THEN 1073 CALL wrk_alloc( jpi, jpj, intdissic ) 1074 intdissic(:,:) = 0.0 !! 1075 ENDIF 1076 IF( med_diag%INTDISSIN%dgsave ) THEN 1077 CALL wrk_alloc( jpi, jpj, intdissin ) 1078 intdissin(:,:) = 0.0 !! 1079 ENDIF 1080 IF( med_diag%INTDISSISI%dgsave ) THEN 1081 CALL wrk_alloc( jpi, jpj, intdissisi ) 1082 intdissisi(:,:) = 0.0 !! 1083 ENDIF 1084 IF( med_diag%INTTALK%dgsave ) THEN 1085 CALL wrk_alloc( jpi, jpj, inttalk ) 1086 inttalk(:,:) = 0.0 !! 1087 ENDIF 1088 IF( med_diag%O2min%dgsave ) THEN 1089 CALL wrk_alloc( jpi, jpj, o2min ) 1090 o2min(:,:) = 1.e3 !! set to high value as we're looking for min(o2) 1091 ENDIF 1092 IF( med_diag%ZO2min%dgsave ) THEN 1093 CALL wrk_alloc( jpi, jpj, zo2min ) 1094 zo2min(:,:) = 0.0 !! 1095 ENDIF 1096 IF( med_diag%FBDDTALK%dgsave ) THEN 1097 CALL wrk_alloc( jpi, jpj, fbddtalk ) 1098 fbddtalk(:,:) = 0.0 !! 1099 ENDIF 1100 IF( med_diag%FBDDTDIC%dgsave ) THEN 1101 CALL wrk_alloc( jpi, jpj, fbddtdic ) 1102 fbddtdic(:,:) = 0.0 !! 1103 ENDIF 1104 IF( med_diag%FBDDTDIFE%dgsave ) THEN 1105 CALL wrk_alloc( jpi, jpj, fbddtdife ) 1106 fbddtdife(:,:) = 0.0 !! 1107 ENDIF 1108 IF( med_diag%FBDDTDIN%dgsave ) THEN 1109 CALL wrk_alloc( jpi, jpj, fbddtdin ) 1110 fbddtdin(:,:) = 0.0 !! 1111 ENDIF 1112 IF( med_diag%FBDDTDISI%dgsave ) THEN 1113 CALL wrk_alloc( jpi, jpj, fbddtdisi ) 1114 fbddtdisi(:,:) = 0.0 !! 1115 ENDIF 1116 !! 1117 !! AXY (10/11/16): CMIP6 diagnostics, 3D 1118 IF( med_diag%TPPD3%dgsave ) THEN 1119 CALL wrk_alloc( jpi, jpj, jpk, tppd3 ) 1120 tppd3(:,:,:) = 0.0 !! 1121 ENDIF 1122 IF( med_diag%BDDTALK3%dgsave ) THEN 1123 CALL wrk_alloc( jpi, jpj, jpk, bddtalk3 ) 1124 bddtalk3(:,:,:) = 0.0 !! 1125 ENDIF 1126 IF( med_diag%BDDTDIC3%dgsave ) THEN 1127 CALL wrk_alloc( jpi, jpj, jpk, bddtdic3 ) 1128 bddtdic3(:,:,:) = 0.0 !! 1129 ENDIF 1130 IF( med_diag%BDDTDIFE3%dgsave ) THEN 1131 CALL wrk_alloc( jpi, jpj, jpk, bddtdife3 ) 1132 bddtdife3(:,:,:) = 0.0 !! 1133 ENDIF 1134 IF( med_diag%BDDTDIN3%dgsave ) THEN 1135 CALL wrk_alloc( jpi, jpj, jpk, bddtdin3 ) 1136 bddtdin3(:,:,:) = 0.0 !! 1137 ENDIF 1138 IF( med_diag%BDDTDISI3%dgsave ) THEN 1139 CALL wrk_alloc( jpi, jpj, jpk, bddtdisi3 ) 1140 bddtdisi3(:,:,:) = 0.0 !! 1141 ENDIF 1142 IF( med_diag%FD_NIT3%dgsave ) THEN 1143 CALL wrk_alloc( jpi, jpj, jpk, fd_nit3 ) 1144 fd_nit3(:,:,:) = 0.0 !! 1145 ENDIF 1146 IF( med_diag%FD_SIL3%dgsave ) THEN 1147 CALL wrk_alloc( jpi, jpj, jpk, fd_sil3 ) 1148 fd_sil3(:,:,:) = 0.0 !! 1149 ENDIF 1150 IF( med_diag%FD_CAR3%dgsave ) THEN 1151 CALL wrk_alloc( jpi, jpj, jpk, fd_car3 ) 1152 fd_car3(:,:,:) = 0.0 !! 1153 ENDIF 1154 IF( med_diag%FD_CAL3%dgsave ) THEN 1155 CALL wrk_alloc( jpi, jpj, jpk, fd_cal3 ) 1156 fd_cal3(:,:,:) = 0.0 !! 1157 ENDIF 1158 IF( med_diag%DCALC3%dgsave ) THEN 1159 CALL wrk_alloc( jpi, jpj, jpk, dcalc3 ) 1160 dcalc3(:,:,: ) = 0.0 !! 1161 ENDIF 1162 IF( med_diag%EXPC3%dgsave ) THEN 1163 CALL wrk_alloc( jpi, jpj, jpk, expc3 ) 1164 expc3(:,:,: ) = 0.0 !! 1165 ENDIF 1166 IF( med_diag%EXPN3%dgsave ) THEN 1167 CALL wrk_alloc( jpi, jpj, jpk, expn3 ) 1168 expn3(:,:,: ) = 0.0 !! 1169 ENDIF 1170 IF( med_diag%FEDISS3%dgsave ) THEN 1171 CALL wrk_alloc( jpi, jpj, jpk, fediss3 ) 1172 fediss3(:,:,: ) = 0.0 !! 1173 ENDIF 1174 IF( med_diag%FESCAV3%dgsave ) THEN 1175 CALL wrk_alloc( jpi, jpj, jpk, fescav3 ) 1176 fescav3(:,:,: ) = 0.0 !! 1177 ENDIF 1178 IF( med_diag%MIGRAZP3%dgsave ) THEN 1179 CALL wrk_alloc( jpi, jpj, jpk, migrazp3 ) 1180 migrazp3(:,:,: ) = 0.0 !! 1181 ENDIF 1182 IF( med_diag%MIGRAZD3%dgsave ) THEN 1183 CALL wrk_alloc( jpi, jpj, jpk, migrazd3 ) 1184 migrazd3(:,:,: ) = 0.0 !! 1185 ENDIF 1186 IF( med_diag%MEGRAZP3%dgsave ) THEN 1187 CALL wrk_alloc( jpi, jpj, jpk, megrazp3 ) 1188 megrazp3(:,:,: ) = 0.0 !! 1189 ENDIF 1190 IF( med_diag%MEGRAZD3%dgsave ) THEN 1191 CALL wrk_alloc( jpi, jpj, jpk, megrazd3 ) 1192 megrazd3(:,:,: ) = 0.0 !! 1193 ENDIF 1194 IF( med_diag%MEGRAZZ3%dgsave ) THEN 1195 CALL wrk_alloc( jpi, jpj, jpk, megrazz3 ) 1196 megrazz3(:,:,: ) = 0.0 !! 1197 ENDIF 1198 IF( med_diag%O2SAT3%dgsave ) THEN 1199 CALL wrk_alloc( jpi, jpj, jpk, o2sat3 ) 1200 o2sat3(:,:,: ) = 0.0 !! 1201 ENDIF 1202 IF( med_diag%PBSI3%dgsave ) THEN 1203 CALL wrk_alloc( jpi, jpj, jpk, pbsi3 ) 1204 pbsi3(:,:,: ) = 0.0 !! 1205 ENDIF 1206 IF( med_diag%PCAL3%dgsave ) THEN 1207 CALL wrk_alloc( jpi, jpj, jpk, pcal3 ) 1208 pcal3(:,:,: ) = 0.0 !! 1209 ENDIF 1210 IF( med_diag%REMOC3%dgsave ) THEN 1211 CALL wrk_alloc( jpi, jpj, jpk, remoc3 ) 1212 remoc3(:,:,: ) = 0.0 !! 1213 ENDIF 1214 IF( med_diag%PNLIMJ3%dgsave ) THEN 1215 CALL wrk_alloc( jpi, jpj, jpk, pnlimj3 ) 1216 pnlimj3(:,:,: ) = 0.0 !! 1217 ENDIF 1218 IF( med_diag%PNLIMN3%dgsave ) THEN 1219 CALL wrk_alloc( jpi, jpj, jpk, pnlimn3 ) 1220 pnlimn3(:,:,: ) = 0.0 !! 1221 ENDIF 1222 IF( med_diag%PNLIMFE3%dgsave ) THEN 1223 CALL wrk_alloc( jpi, jpj, jpk, pnlimfe3 ) 1224 pnlimfe3(:,:,: ) = 0.0 !! 1225 ENDIF 1226 IF( med_diag%PDLIMJ3%dgsave ) THEN 1227 CALL wrk_alloc( jpi, jpj, jpk, pdlimj3 ) 1228 pdlimj3(:,:,: ) = 0.0 !! 1229 ENDIF 1230 IF( med_diag%PDLIMN3%dgsave ) THEN 1231 CALL wrk_alloc( jpi, jpj, jpk, pdlimn3 ) 1232 pdlimn3(:,:,: ) = 0.0 !! 1233 ENDIF 1234 IF( med_diag%PDLIMFE3%dgsave ) THEN 1235 CALL wrk_alloc( jpi, jpj, jpk, pdlimfe3 ) 1236 pdlimfe3(:,:,: ) = 0.0 !! 1237 ENDIF 1238 IF( med_diag%PDLIMSI3%dgsave ) THEN 1239 CALL wrk_alloc( jpi, jpj, jpk, pdlimsi3 ) 1240 pdlimsi3(:,:,: ) = 0.0 !! 1241 ENDIF 1242 1243 ENDIF 1244 !! lk_iomput 1245 !! 236 !!------------------------------------------------------------------ 237 !! Initialise arrays to zero and set up arrays for diagnostics 238 !!------------------------------------------------------------------ 239 CALL bio_medusa_init( kt ) 240 1246 241 # if defined key_axy_nancheck 1247 DO jn = 1,jptra242 DO jn = jp_msa0,jp_msa1 1248 243 !! fq0 = MINVAL(trn(:,:,:,jn)) 1249 244 !! fq1 = MAXVAL(trn(:,:,:,jn)) 1250 245 fq2 = SUM(trn(:,:,:,jn)) 1251 !! if (lwp) write (numout,'(a,2i6,3(1x,1pe15.5))') 'NAN-CHECK', & 1252 !! & kt, jn, fq0, fq1, fq2 1253 !! AXY (30/01/14): much to our surprise, the next line doesn't work on HECTOR 1254 !! and has been replaced here with a specialist routine 246 !! if (lwp) write (numout,'(a,2i6,3(1x,1pe15.5))') 'NAN-CHECK', & 247 !! kt, jn, fq0, fq1, fq2 248 !! AXY (30/01/14): much to our surprise, the next line doesn't 249 !! work on HECTOR and has been replaced here with 250 !! a specialist routine 1255 251 !! if (fq2 /= fq2 ) then 1256 252 if ( ieee_is_nan( fq2 ) ) then 1257 253 !! there's a NaN here 1258 if (lwp) write(numout,*) 'NAN detected in field', jn, 'at time', kt, 'at position:' 254 if (lwp) write(numout,*) 'NAN detected in field', jn, & 255 'at time', kt, 'at position:' 1259 256 DO jk = 1,jpk 1260 257 DO jj = 1,jpj … … 1263 260 !! if (trn(ji,jj,jk,jn) /= trn(ji,jj,jk,jn)) then 1264 261 if ( ieee_is_nan( trn(ji,jj,jk,jn) ) ) then 1265 if (lwp) write (numout,'(a,1pe12.2,4i6)') 'NAN-CHECK',&1266 &tmask(ji,jj,jk), ji, jj, jk, jn262 if (lwp) write (numout,'(a,1pe12.2,4i6)') & 263 'NAN-CHECK', tmask(ji,jj,jk), ji, jj, jk, jn 1267 264 endif 1268 265 enddo … … 1276 273 1277 274 # if defined key_debug_medusa 1278 IF (lwp) write (numout,*) 'trc_bio_medusa: variables initialised and checked' 275 IF (lwp) write (numout,*) & 276 'trc_bio_medusa: variables initialised and checked' 1279 277 CALL flush(numout) 1280 278 # endif 1281 279 1282 280 # if defined key_roam 1283 !!------------------------------------------------------------------ ----281 !!------------------------------------------------------------------ 1284 282 !! calculate atmospheric pCO2 1285 !!------------------------------------------------------------------ ----283 !!------------------------------------------------------------------ 1286 284 !! 1287 285 !! what's atmospheric pCO2 doing? (data start in 1859) … … 1290 288 if (iyr1 .le. 1) then 1291 289 !! before 1860 1292 f_xco2a = hist_pco2(1)290 f_xco2a(:,:) = hist_pco2(1) 1293 291 elseif (iyr2 .ge. 242) then 1294 292 !! after 2099 1295 f_xco2a = hist_pco2(242)293 f_xco2a(:,:) = hist_pco2(242) 1296 294 else 1297 295 !! just right … … 1301 299 !! AXY (14/06/12): tweaked to make more sense (and be correct) 1302 300 # if defined key_bs_axy_yrlen 1303 fq3 = (real(nday_year) - 1.0 + fq2) / 360.0 !! bugfix: for 360d year with HadGEM2-ES forcing 301 !! bugfix: for 360d year with HadGEM2-ES forcing 302 fq3 = (real(nday_year) - 1.0 + fq2) / 360.0 1304 303 # else 1305 fq3 = (real(nday_year) - 1.0 + fq2) / 365.0 !! original use of 365 days (not accounting for leap year or 360d year) 304 !! original use of 365 days (not accounting for leap year or 305 !! 360d year) 306 fq3 = (real(nday_year) - 1.0 + fq2) / 365.0 1306 307 # endif 1307 308 fq4 = (fq0 * (1.0 - fq3)) + (fq1 * fq3) 1308 f_xco2a = fq4309 f_xco2a(:,:) = fq4 1309 310 endif 1310 311 # if defined key_axy_pi_co2 1311 !! f_xco2a = 284.725 !! CMIP5 pre-industrial pCO2 1312 f_xco2a = 284.317 !! CMIP6 pre-industrial pCO2 312 !! OCMIP pre-industrial pCO2 313 !! f_xco2a(:,:) = 284.725 !! CMIP5 pre-industrial pCO2 314 f_xco2a = 284.317 !! CMIP6 pre-industrial pCO2 1313 315 # endif 1314 316 !! IF(lwp) WRITE(numout,*) ' MEDUSA nyear =', nyear … … 1320 322 !! IF(lwp) WRITE(numout,*) ' MEDUSA fq2 =', fq2 1321 323 !! IF(lwp) WRITE(numout,*) ' MEDUSA fq3 =', fq3 1322 IF(lwp) WRITE(numout,*) ' MEDUSA atm pCO2 =', f_xco2a 324 IF(lwp) WRITE(numout,*) ' MEDUSA atm pCO2 =', f_xco2a(1,1) 1323 325 # endif 1324 326 … … 1338 340 !!============================= 1339 341 !! Jpalm -- 07-10-2016 -- need to change carb-chem frequency call : 1340 !! we don't want to call on the first time-step of all run submission, 1341 !! but only on the very first time-step, and then every month 1342 !! So we call on nittrc000 if not restarted run, 1343 !! else if one month after last call. 1344 !! assume one month is 30d --> 3600*24*30 : 2592000s 1345 !! try to call carb-chem at 1st month's tm-stp : x * 30d + 1*rdt(i.e: mod = rdt) 342 !! we don't want to call on the first time-step of all run 343 !! submission, but only on the very first time-step, and 344 !! then every month. So we call on nittrc000 if not 345 !! restarted run, else if one month after last call. 346 !! Assume one month is 30d --> 3600*24*30 : 2592000s 347 !! try to call carb-chem at 1st month's tm-stp : 348 !! x * 30d + 1*rdt(i.e: mod = rdt) 1346 349 !! ++ need to pass carb-chem output var through restarts 1347 !! We want this to be start of month or if starting afresh from1348 !! climatology - marc 20/6/171349 350 If ( (kt == nittrc000 .AND. .NOT.ln_rsttr) .OR. & 1350 351 ((86400*mod(nn_date0,100) + mod(kt*rdt,2592000.)) == rdt) ) THEN 1351 !!--------------------------------------------------------------- -------352 !!--------------------------------------------------------------- 1352 353 !! Calculate the carbonate chemistry for the whole ocean on the first 1353 354 !! simulation timestep and every month subsequently; the resulting 3D 1354 355 !! field of omega calcite is used to determine the depth of the CCD 1355 !!---------------------------------------------------------------------- 1356 !! 1357 IF(lwp) WRITE(numout,*) ' MEDUSA calculating all carbonate chemistry at kt =', kt 1358 CALL flush(numout) 1359 !! blank flags 1360 i2_omcal(:,:) = 0 1361 i2_omarg(:,:) = 0 1362 !! loop over 3D space 1363 DO jk = 1,jpk 1364 DO jj = 2,jpjm1 1365 DO ji = 2,jpim1 1366 !! OPEN wet point IF..THEN loop 1367 if (tmask(ji,jj,jk).eq.1) then 1368 IF (lk_oasis) THEN 1369 f_xco2a = PCO2a_in_cpl(ji,jj) !! use 2D atm xCO2 from atm coupling 1370 ENDIF 1371 !! do carbonate chemistry 1372 !! 1373 fdep2 = fsdept(ji,jj,jk) !! set up level midpoint 1374 !! AXY (28/11/16): local seafloor depth 1375 !! previously mbathy(ji,jj) - 1, now mbathy(ji,jj) 1376 jmbathy = mbathy(ji,jj) 1377 !! 1378 !! set up required state variables 1379 zdic = max(0.,trn(ji,jj,jk,jpdic)) !! dissolved inorganic carbon 1380 zalk = max(0.,trn(ji,jj,jk,jpalk)) !! alkalinity 1381 ztmp = tsn(ji,jj,jk,jp_tem) !! temperature 1382 zsal = tsn(ji,jj,jk,jp_sal) !! salinity 1383 # if defined key_mocsy 1384 zsil = max(0.,trn(ji,jj,jk,jpsil)) !! silicic acid 1385 zpho = max(0.,trn(ji,jj,jk,jpdin)) / 16.0 !! phosphate via DIN and Redfield 1386 # endif 1387 !! 1388 !! AXY (28/02/14): check input fields 1389 if (ztmp .lt. -3.0 .or. ztmp .gt. 40.0 ) then 1390 IF(lwp) WRITE(numout,*) ' trc_bio_medusa: T WARNING 3D, ', & 1391 tsb(ji,jj,jk,jp_tem), tsn(ji,jj,jk,jp_tem), ' at (', & 1392 ji, ',', jj, ',', jk, ') at time', kt 1393 IF(lwp) WRITE(numout,*) ' trc_bio_medusa: T SWITCHING 3D, ', & 1394 tsn(ji,jj,jk,jp_tem), ' -> ', tsb(ji,jj,jk,jp_tem) 1395 ztmp = tsb(ji,jj,jk,jp_tem) !! temperature 1396 endif 1397 if (zsal .lt. 0.0 .or. zsal .gt. 45.0 ) then 1398 IF(lwp) WRITE(numout,*) ' trc_bio_medusa: S WARNING 3D, ', & 1399 tsb(ji,jj,jk,jp_sal), tsn(ji,jj,jk,jp_sal), ' at (', & 1400 ji, ',', jj, ',', jk, ') at time', kt 1401 endif 1402 !! 1403 !! blank input variables not used at this stage (they relate to air-sea flux) 1404 f_kw660 = 1.0 1405 f_pp0 = 1.0 1406 !! 1407 !! calculate carbonate chemistry at grid cell midpoint 1408 # if defined key_mocsy 1409 !! AXY (22/06/15): use Orr & Epitalon (2015) MOCSY-2 carbonate 1410 !! chemistry package 1411 CALL mocsy_interface( ztmp, zsal, zalk, zdic, zsil, zpho, & ! inputs 1412 f_pp0, fdep2, gphit(ji,jj), f_kw660, f_xco2a, 1, & ! inputs 1413 f_ph, f_pco2w, f_fco2w, f_h2co3, f_hco3, f_co3, f_omarg(ji,jj), & ! outputs 1414 f_omcal(ji,jj), f_BetaD, f_rhosw, f_opres, f_insitut, & ! outputs 1415 f_pco2atm, f_fco2atm, f_schmidtco2, f_kwco2, f_K0, & ! outputs 1416 f_co2starair, f_co2flux, f_dpco2 ) ! outputs 1417 !! 1418 f_TDIC = (zdic / f_rhosw) * 1000. ! mmol / m3 -> umol / kg 1419 f_TALK = (zalk / f_rhosw) * 1000. ! meq / m3 -> ueq / kg 1420 f_dcf = f_rhosw 1421 # else 1422 !! AXY (22/06/15): use old PML carbonate chemistry package (the 1423 !! MEDUSA-2 default) 1424 CALL trc_co2_medusa( ztmp, zsal, zdic, zalk, fdep2, f_kw660, & ! inputs 1425 f_xco2a, f_ph, f_pco2w, f_h2co3, f_hco3, f_co3, f_omcal(ji,jj), & ! outputs 1426 f_omarg(ji,jj), f_co2flux, f_TDIC, f_TALK, f_dcf, f_henry, iters) ! outputs 1427 !! 1428 !! AXY (28/02/14): check output fields 1429 if (iters .eq. 25) then 1430 IF(lwp) WRITE(numout,*) ' trc_bio_medusa: 3D ITERS WARNING, ', & 1431 iters, ' AT (', ji, ', ', jj, ', ', jk, ') AT ', kt 1432 endif 1433 # endif 1434 !! 1435 !! store 3D outputs 1436 f3_pH(ji,jj,jk) = f_ph 1437 f3_h2co3(ji,jj,jk) = f_h2co3 1438 f3_hco3(ji,jj,jk) = f_hco3 1439 f3_co3(ji,jj,jk) = f_co3 1440 f3_omcal(ji,jj,jk) = f_omcal(ji,jj) 1441 f3_omarg(ji,jj,jk) = f_omarg(ji,jj) 1442 !! 1443 !! CCD calculation: calcite 1444 if (i2_omcal(ji,jj) .eq. 0 .and. f_omcal(ji,jj) .lt. 1.0) then 1445 if (jk .eq. 1) then 1446 f2_ccd_cal(ji,jj) = fdep2 1447 else 1448 fq0 = f3_omcal(ji,jj,jk-1) - f_omcal(ji,jj) 1449 fq1 = f3_omcal(ji,jj,jk-1) - 1.0 1450 fq2 = fq1 / (fq0 + tiny(fq0)) 1451 fq3 = fdep2 - fsdept(ji,jj,jk-1) 1452 fq4 = fq2 * fq3 1453 f2_ccd_cal(ji,jj) = fsdept(ji,jj,jk-1) + fq4 1454 endif 1455 i2_omcal(ji,jj) = 1 1456 endif 1457 if ( i2_omcal(ji,jj) .eq. 0 .and. jk .eq. jmbathy ) then 1458 !! reached seafloor and still no dissolution; set to seafloor (W-point) 1459 f2_ccd_cal(ji,jj) = fsdepw(ji,jj,jk+1) 1460 i2_omcal(ji,jj) = 1 1461 endif 1462 !! 1463 !! CCD calculation: aragonite 1464 if (i2_omarg(ji,jj) .eq. 0 .and. f_omarg(ji,jj) .lt. 1.0) then 1465 if (jk .eq. 1) then 1466 f2_ccd_arg(ji,jj) = fdep2 1467 else 1468 fq0 = f3_omarg(ji,jj,jk-1) - f_omarg(ji,jj) 1469 fq1 = f3_omarg(ji,jj,jk-1) - 1.0 1470 fq2 = fq1 / (fq0 + tiny(fq0)) 1471 fq3 = fdep2 - fsdept(ji,jj,jk-1) 1472 fq4 = fq2 * fq3 1473 f2_ccd_arg(ji,jj) = fsdept(ji,jj,jk-1) + fq4 1474 endif 1475 i2_omarg(ji,jj) = 1 1476 endif 1477 if ( i2_omarg(ji,jj) .eq. 0 .and. jk .eq. jmbathy ) then 1478 !! reached seafloor and still no dissolution; set to seafloor (W-point) 1479 f2_ccd_arg(ji,jj) = fsdepw(ji,jj,jk+1) 1480 i2_omarg(ji,jj) = 1 1481 endif 1482 endif 1483 ENDDO 1484 ENDDO 1485 ENDDO 356 !!--------------------------------------------------------------- 357 CALL carb_chem( kt ) 358 1486 359 ENDIF 1487 360 # endif … … 1492 365 # endif 1493 366 1494 !!------------------------------------------------------------------ ----367 !!------------------------------------------------------------------ 1495 368 !! MEDUSA has unified equation through the water column 1496 369 !! (Diff. from LOBSTER which has two sets: bio- and non-bio layers) 1497 370 !! Statement below in LOBSTER is different: DO jk = 1, jpkbm1 1498 !!------------------------------------------------------------------ ----371 !!------------------------------------------------------------------ 1499 372 !! 1500 373 !! NOTE: the ordering of the loops below differs from that of some other … … 1512 385 !! OPEN horizontal loops 1513 386 DO jj = 2,jpjm1 1514 DO ji = 2,jpim1 1515 !! OPEN wet point IF..THEN loop 1516 if (tmask(ji,jj,jk).eq.1) then 1517 !!====================================================================== 1518 !! SETUP LOCAL GRID CELL 1519 !!====================================================================== 1520 !! 1521 !!--------------------------------------------------------------------- 1522 !! Some notes on grid vertical structure 1523 !! - fsdepw(ji,jj,jk) is the depth of the upper surface of level jk 1524 !! - fsde3w(ji,jj,jk) is *approximately* the midpoint of level jk 1525 !! - fse3t(ji,jj,jk) is the thickness of level jk 1526 !!--------------------------------------------------------------------- 1527 !! 1528 !! AXY (11/12/08): set up level thickness 1529 fthk = fse3t(ji,jj,jk) 1530 !! AXY (25/02/10): set up level depth (top of level) 1531 fdep = fsdepw(ji,jj,jk) 1532 !! AXY (01/03/10): set up level depth (bottom of level) 1533 fdep1 = fdep + fthk 1534 !! AXY (28/11/16): local seafloor depth 1535 !! previously mbathy(ji,jj) - 1, now mbathy(ji,jj) 1536 jmbathy = mbathy(ji,jj) 1537 !! 1538 !! set up model tracers 1539 !! negative values of state variables are not allowed to 1540 !! contribute to the calculated fluxes 1541 zchn = max(0.,trn(ji,jj,jk,jpchn)) !! non-diatom chlorophyll 1542 zchd = max(0.,trn(ji,jj,jk,jpchd)) !! diatom chlorophyll 1543 zphn = max(0.,trn(ji,jj,jk,jpphn)) !! non-diatoms 1544 zphd = max(0.,trn(ji,jj,jk,jpphd)) !! diatoms 1545 zpds = max(0.,trn(ji,jj,jk,jppds)) !! diatom silicon 1546 !! AXY (28/01/10): probably need to take account of chl/biomass connection 1547 if (zchn.eq.0.) zphn = 0. 1548 if (zchd.eq.0.) zphd = 0. 1549 if (zphn.eq.0.) zchn = 0. 1550 if (zphd.eq.0.) zchd = 0. 1551 !! AXY (23/01/14): duh - why did I forget diatom silicon? 1552 if (zpds.eq.0.) zphd = 0. 1553 if (zphd.eq.0.) zpds = 0. 1554 zzmi = max(0.,trn(ji,jj,jk,jpzmi)) !! microzooplankton 1555 zzme = max(0.,trn(ji,jj,jk,jpzme)) !! mesozooplankton 1556 zdet = max(0.,trn(ji,jj,jk,jpdet)) !! detrital nitrogen 1557 zdin = max(0.,trn(ji,jj,jk,jpdin)) !! dissolved inorganic nitrogen 1558 zsil = max(0.,trn(ji,jj,jk,jpsil)) !! dissolved silicic acid 1559 zfer = max(0.,trn(ji,jj,jk,jpfer)) !! dissolved "iron" 1560 # if defined key_roam 1561 zdtc = max(0.,trn(ji,jj,jk,jpdtc)) !! detrital carbon 1562 zdic = max(0.,trn(ji,jj,jk,jpdic)) !! dissolved inorganic carbon 1563 zalk = max(0.,trn(ji,jj,jk,jpalk)) !! alkalinity 1564 zoxy = max(0.,trn(ji,jj,jk,jpoxy)) !! oxygen 1565 # if defined key_axy_carbchem && defined key_mocsy 1566 zpho = max(0.,trn(ji,jj,jk,jpdin)) / 16.0 !! phosphate via DIN and Redfield 1567 # endif 1568 !! 1569 !! also need physical parameters for gas exchange calculations 1570 ztmp = tsn(ji,jj,jk,jp_tem) 1571 zsal = tsn(ji,jj,jk,jp_sal) 1572 !! 1573 !! AXY (28/02/14): check input fields 1574 if (ztmp .lt. -3.0 .or. ztmp .gt. 40.0 ) then 1575 IF(lwp) WRITE(numout,*) ' trc_bio_medusa: T WARNING 2D, ', & 1576 tsb(ji,jj,jk,jp_tem), tsn(ji,jj,jk,jp_tem), ' at (', & 1577 ji, ',', jj, ',', jk, ') at time', kt 1578 IF(lwp) WRITE(numout,*) ' trc_bio_medusa: T SWITCHING 2D, ', & 1579 tsn(ji,jj,jk,jp_tem), ' -> ', tsb(ji,jj,jk,jp_tem) 1580 ztmp = tsb(ji,jj,jk,jp_tem) !! temperature 1581 endif 1582 if (zsal .lt. 0.0 .or. zsal .gt. 45.0 ) then 1583 IF(lwp) WRITE(numout,*) ' trc_bio_medusa: S WARNING 2D, ', & 1584 tsb(ji,jj,jk,jp_sal), tsn(ji,jj,jk,jp_sal), ' at (', & 1585 ji, ',', jj, ',', jk, ') at time', kt 1586 endif 1587 # else 1588 zdtc = zdet * xthetad !! implicit detrital carbon 1589 # endif 1590 # if defined key_debug_medusa 1591 if (idf.eq.1) then 1592 !! AXY (15/01/10) 1593 if (trn(ji,jj,jk,jpdin).lt.0.) then 1594 IF (lwp) write (numout,*) '------------------------------' 1595 IF (lwp) write (numout,*) 'NEGATIVE DIN ERROR =', trn(ji,jj,jk,jpdin) 1596 IF (lwp) write (numout,*) 'NEGATIVE DIN ERROR @', ji, jj, jk, kt 1597 endif 1598 if (trn(ji,jj,jk,jpsil).lt.0.) then 1599 IF (lwp) write (numout,*) '------------------------------' 1600 IF (lwp) write (numout,*) 'NEGATIVE SIL ERROR =', trn(ji,jj,jk,jpsil) 1601 IF (lwp) write (numout,*) 'NEGATIVE SIL ERROR @', ji, jj, jk, kt 1602 endif 1603 # if defined key_roam 1604 if (trn(ji,jj,jk,jpdic).lt.0.) then 1605 IF (lwp) write (numout,*) '------------------------------' 1606 IF (lwp) write (numout,*) 'NEGATIVE DIC ERROR =', trn(ji,jj,jk,jpdic) 1607 IF (lwp) write (numout,*) 'NEGATIVE DIC ERROR @', ji, jj, jk, kt 1608 endif 1609 if (trn(ji,jj,jk,jpalk).lt.0.) then 1610 IF (lwp) write (numout,*) '------------------------------' 1611 IF (lwp) write (numout,*) 'NEGATIVE ALK ERROR =', trn(ji,jj,jk,jpalk) 1612 IF (lwp) write (numout,*) 'NEGATIVE ALK ERROR @', ji, jj, jk, kt 1613 endif 1614 if (trn(ji,jj,jk,jpoxy).lt.0.) then 1615 IF (lwp) write (numout,*) '------------------------------' 1616 IF (lwp) write (numout,*) 'NEGATIVE OXY ERROR =', trn(ji,jj,jk,jpoxy) 1617 IF (lwp) write (numout,*) 'NEGATIVE OXY ERROR @', ji, jj, jk, kt 1618 endif 1619 # endif 1620 endif 1621 # endif 1622 # if defined key_debug_medusa 1623 !! report state variable values 1624 if (idf.eq.1.AND.idfval.eq.1) then 1625 IF (lwp) write (numout,*) '------------------------------' 1626 IF (lwp) write (numout,*) 'fthk(',jk,') = ', fthk 1627 IF (lwp) write (numout,*) 'zphn(',jk,') = ', zphn 1628 IF (lwp) write (numout,*) 'zphd(',jk,') = ', zphd 1629 IF (lwp) write (numout,*) 'zpds(',jk,') = ', zpds 1630 IF (lwp) write (numout,*) 'zzmi(',jk,') = ', zzmi 1631 IF (lwp) write (numout,*) 'zzme(',jk,') = ', zzme 1632 IF (lwp) write (numout,*) 'zdet(',jk,') = ', zdet 1633 IF (lwp) write (numout,*) 'zdin(',jk,') = ', zdin 1634 IF (lwp) write (numout,*) 'zsil(',jk,') = ', zsil 1635 IF (lwp) write (numout,*) 'zfer(',jk,') = ', zfer 1636 # if defined key_roam 1637 IF (lwp) write (numout,*) 'zdtc(',jk,') = ', zdtc 1638 IF (lwp) write (numout,*) 'zdic(',jk,') = ', zdic 1639 IF (lwp) write (numout,*) 'zalk(',jk,') = ', zalk 1640 IF (lwp) write (numout,*) 'zoxy(',jk,') = ', zoxy 1641 # endif 1642 endif 1643 # endif 1644 1645 # if defined key_debug_medusa 1646 if (idf.eq.1.AND.idfval.eq.1.AND.jk.eq.1) then 1647 IF (lwp) write (numout,*) '------------------------------' 1648 IF (lwp) write (numout,*) 'dust = ', dust(ji,jj) 1649 endif 1650 # endif 1651 1652 !! sum tracers for inventory checks 1653 IF( lk_iomput ) THEN 1654 IF ( med_diag%INVTN%dgsave ) THEN 1655 ftot_n(ji,jj) = ftot_n(ji,jj) + & 1656 (fthk * ( zphn + zphd + zzmi + zzme + zdet + zdin ) ) 1657 ENDIF 1658 IF ( med_diag%INVTSI%dgsave ) THEN 1659 ftot_si(ji,jj) = ftot_si(ji,jj) + & 1660 (fthk * ( zpds + zsil ) ) 1661 ENDIF 1662 IF ( med_diag%INVTFE%dgsave ) THEN 1663 ftot_fe(ji,jj) = ftot_fe(ji,jj) + & 1664 (fthk * ( xrfn * ( zphn + zphd + zzmi + zzme + zdet ) + zfer ) ) 1665 ENDIF 1666 # if defined key_roam 1667 IF ( med_diag%INVTC%dgsave ) THEN 1668 ftot_c(ji,jj) = ftot_c(ji,jj) + & 1669 (fthk * ( (xthetapn * zphn) + (xthetapd * zphd) + & 1670 (xthetazmi * zzmi) + (xthetazme * zzme) + zdtc + & 1671 zdic ) ) 1672 ENDIF 1673 IF ( med_diag%INVTALK%dgsave ) THEN 1674 ftot_a(ji,jj) = ftot_a(ji,jj) + (fthk * ( zalk ) ) 1675 ENDIF 1676 IF ( med_diag%INVTO2%dgsave ) THEN 1677 ftot_o2(ji,jj) = ftot_o2(ji,jj) + (fthk * ( zoxy ) ) 1678 ENDIF 387 DO ji = 2,jpim1 388 !! OPEN wet point IF..THEN loop 389 if (tmask(ji,jj,jk) == 1) then 390 !!====================================================== 391 !! SETUP LOCAL GRID CELL 392 !!====================================================== 1679 393 !! 1680 !! AXY (10/11/16): CMIP6 diagnostics 1681 IF ( med_diag%INTDISSIC%dgsave ) THEN 1682 intdissic(ji,jj) = intdissic(ji,jj) + (fthk * zdic) 1683 ENDIF 1684 IF ( med_diag%INTDISSIN%dgsave ) THEN 1685 intdissin(ji,jj) = intdissin(ji,jj) + (fthk * zdin) 1686 ENDIF 1687 IF ( med_diag%INTDISSISI%dgsave ) THEN 1688 intdissisi(ji,jj) = intdissisi(ji,jj) + (fthk * zsil) 1689 ENDIF 1690 IF ( med_diag%INTTALK%dgsave ) THEN 1691 inttalk(ji,jj) = inttalk(ji,jj) + (fthk * zalk) 1692 ENDIF 1693 IF ( med_diag%O2min%dgsave ) THEN 1694 if ( zoxy < o2min(ji,jj) ) then 1695 o2min(ji,jj) = zoxy 1696 IF ( med_diag%ZO2min%dgsave ) THEN 1697 zo2min(ji,jj) = (fdep + fdep1) / 2. !! layer midpoint 1698 ENDIF 1699 endif 1700 ENDIF 1701 # endif 1702 ENDIF 1703 1704 CALL flush(numout) 1705 1706 !!====================================================================== 1707 !! LOCAL GRID CELL CALCULATIONS 1708 !!====================================================================== 1709 !! 1710 # if defined key_roam 1711 if ( jk .eq. 1 ) then 1712 !!---------------------------------------------------------------------- 1713 !! Air-sea gas exchange 1714 !!---------------------------------------------------------------------- 394 !!------------------------------------------------------ 395 !! Some notes on grid vertical structure 396 !! - fsdepw(ji,jj,jk) is the depth of the upper surface of 397 !! level jk 398 !! - fsde3w(ji,jj,jk) is *approximately* the midpoint of 399 !! level jk 400 !! - fse3t(ji,jj,jk) is the thickness of level jk 401 !!------------------------------------------------------ 1715 402 !! 1716 !! AXY (17/07/14): zwind_i and zwind_j do not exist in this 1717 !! version of NEMO because it does not include 1718 !! the SBC changes that our local version has 1719 !! for accessing the HadGEM2 forcing; they 1720 !! could be added, but an alternative approach 1721 !! is to make use of wndm from oce_trc.F90 1722 !! which is wind speed at 10m (which is what 1723 !! is required here; this may need to be 1724 !! revisited when MEDUSA properly interacts 1725 !! with UKESM1 physics 403 !! AXY (01/03/10): set up level depth (bottom of level) 404 fdep1(ji,jj) = fsdepw(ji,jj,jk) + fse3t(ji,jj,jk) 1726 405 !! 1727 f_wind = wndm(ji,jj) 1728 IF (lk_oasis) THEN 1729 f_xco2a = PCO2a_in_cpl(ji,jj) !! use 2D atm xCO2 from atm coupling 1730 ENDIF 1731 !! 1732 !! AXY (23/06/15): as part of an effort to update the carbonate chemistry 1733 !! in MEDUSA, the gas transfer velocity used in the carbon 1734 !! and oxygen cycles has been harmonised and is calculated 1735 !! by the same function here; this harmonisation includes 1736 !! changes to the PML carbonate chemistry scheme so that 1737 !! it too makes use of the same gas transfer velocity; the 1738 !! preferred parameterisation of this is Wanninkhof (2014), 1739 !! option 7 1740 !! 1741 # if defined key_debug_medusa 1742 IF (lwp) write (numout,*) 'trc_bio_medusa: entering gas_transfer' 1743 CALL flush(numout) 1744 # endif 1745 CALL gas_transfer( f_wind, 1, 7, & ! inputs 1746 f_kw660 ) ! outputs 1747 # if defined key_debug_medusa 1748 IF (lwp) write (numout,*) 'trc_bio_medusa: exiting gas_transfer' 1749 CALL flush(numout) 1750 # endif 1751 !! 1752 !! air pressure (atm); ultimately this will use air pressure at the base 1753 !! of the UKESM1 atmosphere 1754 !! 1755 f_pp0 = 1.0 1756 !! 1757 !! IF(lwp) WRITE(numout,*) ' MEDUSA ztmp =', ztmp 1758 !! IF(lwp) WRITE(numout,*) ' MEDUSA zwind_i =', zwind_i(ji,jj) 1759 !! IF(lwp) WRITE(numout,*) ' MEDUSA zwind_j =', zwind_j(ji,jj) 1760 !! IF(lwp) WRITE(numout,*) ' MEDUSA f_wind =', f_wind 1761 !! IF(lwp) WRITE(numout,*) ' MEDUSA fr_i =', fr_i(ji,jj) 1762 !! 1763 # if defined key_axy_carbchem 1764 # if defined key_mocsy 1765 !! 1766 !! AXY (22/06/15): use Orr & Epitalon (2015) MOCSY-2 carbonate 1767 !! chemistry package; note that depth is set to 1768 !! zero in this call 1769 CALL mocsy_interface( ztmp, zsal, zalk, zdic, zsil, zpho, & ! inputs 1770 f_pp0, 0.0, gphit(ji,jj), f_kw660, f_xco2a, 1, & ! inputs 1771 f_ph, f_pco2w, f_fco2w, f_h2co3, f_hco3, f_co3, f_omarg(ji,jj), & ! outputs 1772 f_omcal(ji,jj), f_BetaD, f_rhosw, f_opres, f_insitut, & ! outputs 1773 f_pco2atm, f_fco2atm, f_schmidtco2, f_kwco2, f_K0, & ! outputs 1774 f_co2starair, f_co2flux, f_dpco2 ) ! outputs 1775 !! 1776 f_TDIC = (zdic / f_rhosw) * 1000. ! mmol / m3 -> umol / kg 1777 f_TALK = (zalk / f_rhosw) * 1000. ! meq / m3 -> ueq / kg 1778 f_dcf = f_rhosw 1779 # else 1780 iters = 0 1781 !! 1782 !! carbon dioxide (CO2); Jerry Blackford code (ostensibly OCMIP-2, but not) 1783 CALL trc_co2_medusa( ztmp, zsal, zdic, zalk, 0.0, f_kw660, f_xco2a, & ! inputs 1784 f_ph, f_pco2w, f_h2co3, f_hco3, f_co3, f_omcal(ji,jj), & ! outputs 1785 f_omarg(ji,jj), f_co2flux, f_TDIC, f_TALK, f_dcf, f_henry, iters ) ! outputs 1786 !! 1787 !! AXY (09/01/14): removed iteration and NaN checks; these have 1788 !! been moved to trc_co2_medusa together with a 1789 !! fudge that amends erroneous values (this is 1790 !! intended to be a temporary fudge!); the 1791 !! output warnings are retained here so that 1792 !! failure position can be determined 1793 if (iters .eq. 25) then 1794 IF(lwp) WRITE(numout,*) ' trc_bio_medusa: ITERS WARNING, ', & 1795 iters, ' AT (', ji, ', ', jj, ', ', jk, ') AT ', kt 1796 endif 1797 # endif 1798 # else 1799 !! AXY (18/04/13): switch off carbonate chemistry calculations; provide 1800 !! quasi-sensible alternatives 1801 f_ph = 8.1 1802 f_pco2w = f_xco2a 1803 f_h2co3 = 0.005 * zdic 1804 f_hco3 = 0.865 * zdic 1805 f_co3 = 0.130 * zdic 1806 f_omcal(ji,jj) = 4. 1807 f_omarg(ji,jj) = 2. 1808 f_co2flux = 0. 1809 f_TDIC = zdic 1810 f_TALK = zalk 1811 f_dcf = 1.026 1812 f_henry = 1. 1813 !! AXY (23/06/15): add in some extra MOCSY diagnostics 1814 f_fco2w = f_xco2a 1815 f_BetaD = 1. 1816 f_rhosw = 1.026 1817 f_opres = 0. 1818 f_insitut = ztmp 1819 f_pco2atm = f_xco2a 1820 f_fco2atm = f_xco2a 1821 f_schmidtco2 = 660. 1822 f_kwco2 = 0. 1823 f_K0 = 0. 1824 f_co2starair = f_xco2a 1825 f_dpco2 = 0. 1826 # endif 1827 !! 1828 !! mmol/m2/s -> mmol/m3/d; correct for sea-ice; divide through by layer thickness 1829 f_co2flux = (1. - fr_i(ji,jj)) * f_co2flux * 86400. / fthk 1830 !! 1831 !! oxygen (O2); OCMIP-2 code 1832 !! AXY (23/06/15): amend input list for oxygen to account for common gas 1833 !! transfer velocity 1834 !! CALL trc_oxy_medusa( ztmp, zsal, f_uwind, f_vwind, f_pp0, zoxy / 1000., fthk, & ! inputs 1835 !! f_kw660, f_o2flux, f_o2sat ) ! outputs 1836 CALL trc_oxy_medusa( ztmp, zsal, f_kw660, f_pp0, zoxy, & ! inputs 1837 f_kwo2, f_o2flux, f_o2sat ) ! outputs 1838 !! 1839 !! mmol/m2/s -> mol/m3/d; correct for sea-ice; divide through by layer thickness 1840 f_o2flux = (1. - fr_i(ji,jj)) * f_o2flux * 86400. / fthk 1841 !! 1842 !! Jpalm (08-2014) 1843 !! DMS surface concentration calculation 1844 !! initialy added for UKESM1 model. 1845 !! using MET-OFFICE subroutine. 1846 !! DMS module only needs Chl concentration and MLD 1847 !! to get an aproximate value of DMS concentration. 1848 !! air-sea fluxes are calculated by atmospheric chemitry model 1849 !! from atm and oc-surface concentrations. 1850 !! 1851 !! AXY (13/03/15): this is amended to calculate all of the DMS 1852 !! estimates examined during UKESM1 (see comments 1853 !! in trcdms_medusa.F90) 1854 !! 1855 !! AXY (25/05/17): amended to additionally pass DIN limitation as well as [DIN]; 1856 !! accounts for differences in nutrient half-saturations; changes 1857 !! also made in trc_dms_medusa; this permits an additional DMS 1858 !! calculation while retaining the existing Anderson one 1859 !! 1860 IF (jdms .eq. 1) THEN 1861 !! 1862 !! calculate weighted half-saturation for DIN uptake 1863 dms_wtkn = ((zphn * xnln) + (zphd * xnld)) / (zphn + zphd) 1864 !! 1865 !! feed in correct inputs 1866 if (jdms_input .eq. 0) then 1867 !! use instantaneous inputs 1868 dms_nlim = zdin / (zdin + dms_wtkn) 1869 !! 1870 CALL trc_dms_medusa( zchn, zchd, & ! inputs 1871 hmld(ji,jj), qsr(ji,jj), & ! inputs 1872 zdin, dms_nlim, & ! inputs 1873 dms_andr, dms_simo, dms_aran, dms_hall, dms_andm ) ! outputs 1874 else 1875 !! use diel-average inputs 1876 dms_nlim = zn_dms_din(ji,jj) / (zn_dms_din(ji,jj) + dms_wtkn) 1877 !! 1878 CALL trc_dms_medusa( zn_dms_chn(ji,jj), zn_dms_chd(ji,jj), & ! inputs 1879 zn_dms_mld(ji,jj), zn_dms_qsr(ji,jj), & ! inputs 1880 zn_dms_din(ji,jj), dms_nlim, & ! inputs 1881 dms_andr, dms_simo, dms_aran, dms_hall, dms_andm ) ! outputs 1882 endif 1883 !! 1884 !! assign correct output to variable passed to atmosphere 1885 if (jdms_model .eq. 1) then 1886 dms_surf = dms_andr 1887 elseif (jdms_model .eq. 2) then 1888 dms_surf = dms_simo 1889 elseif (jdms_model .eq. 3) then 1890 dms_surf = dms_aran 1891 elseif (jdms_model .eq. 4) then 1892 dms_surf = dms_hall 1893 elseif (jdms_model .eq. 5) then 1894 dms_surf = dms_andm 1895 endif 1896 !! 1897 !! 2D diag through iom_use 1898 IF( lk_iomput ) THEN 1899 IF( med_diag%DMS_SURF%dgsave ) THEN 1900 dms_surf2d(ji,jj) = dms_surf 1901 ENDIF 1902 IF( med_diag%DMS_ANDR%dgsave ) THEN 1903 dms_andr2d(ji,jj) = dms_andr 1904 ENDIF 1905 IF( med_diag%DMS_SIMO%dgsave ) THEN 1906 dms_simo2d(ji,jj) = dms_simo 1907 ENDIF 1908 IF( med_diag%DMS_ARAN%dgsave ) THEN 1909 dms_aran2d(ji,jj) = dms_aran 1910 ENDIF 1911 IF( med_diag%DMS_HALL%dgsave ) THEN 1912 dms_hall2d(ji,jj) = dms_hall 1913 ENDIF 1914 IF( med_diag%DMS_ANDM%dgsave ) THEN 1915 dms_andm2d(ji,jj) = dms_andm 1916 ENDIF 1917 # if defined key_debug_medusa 1918 IF (lwp) write (numout,*) 'trc_bio_medusa: finish calculating dms' 1919 CALL flush(numout) 1920 # endif 1921 ENDIF 1922 !! End iom 1923 ENDIF 1924 !! End DMS Loop 1925 !! 1926 !! store 2D outputs 1927 !! 1928 !! JPALM -- 17-11-16 -- put fgco2 out of diag request 1929 !! is needed for coupling; pass through restart 1930 !! IF( med_diag%FGCO2%dgsave ) THEN 1931 !! convert from mol/m2/day to kg/m2/s 1932 fgco2(ji,jj) = f_co2flux * fthk * CO2flux_conv !! mmol-C/m3/d -> kg-CO2/m2/s 1933 !! ENDIF 1934 IF ( lk_iomput ) THEN 1935 IF( med_diag%ATM_PCO2%dgsave ) THEN 1936 f_pco2a2d(ji,jj) = f_pco2atm 1937 ENDIF 1938 IF( med_diag%OCN_PCO2%dgsave ) THEN 1939 f_pco2w2d(ji,jj) = f_pco2w 1940 ENDIF 1941 IF( med_diag%CO2FLUX%dgsave ) THEN 1942 f_co2flux2d(ji,jj) = f_co2flux * fthk !! mmol/m3/d -> mmol/m2/d 1943 ENDIF 1944 IF( med_diag%TCO2%dgsave ) THEN 1945 f_TDIC2d(ji,jj) = f_TDIC 1946 ENDIF 1947 IF( med_diag%TALK%dgsave ) THEN 1948 f_TALK2d(ji,jj) = f_TALK 1949 ENDIF 1950 IF( med_diag%KW660%dgsave ) THEN 1951 f_kw6602d(ji,jj) = f_kw660 1952 ENDIF 1953 IF( med_diag%ATM_PP0%dgsave ) THEN 1954 f_pp02d(ji,jj) = f_pp0 1955 ENDIF 1956 IF( med_diag%O2FLUX%dgsave ) THEN 1957 f_o2flux2d(ji,jj) = f_o2flux 1958 ENDIF 1959 IF( med_diag%O2SAT%dgsave ) THEN 1960 f_o2sat2d(ji,jj) = f_o2sat 1961 ENDIF 1962 !! AXY (24/11/16): add in extra MOCSY diagnostics 1963 IF( med_diag%ATM_XCO2%dgsave ) THEN 1964 f_xco2a_2d(ji,jj) = f_xco2a 1965 ENDIF 1966 IF( med_diag%OCN_FCO2%dgsave ) THEN 1967 f_fco2w_2d(ji,jj) = f_fco2w 1968 ENDIF 1969 IF( med_diag%ATM_FCO2%dgsave ) THEN 1970 f_fco2a_2d(ji,jj) = f_fco2atm 1971 ENDIF 1972 IF( med_diag%OCN_RHOSW%dgsave ) THEN 1973 f_ocnrhosw_2d(ji,jj) = f_rhosw 1974 ENDIF 1975 IF( med_diag%OCN_SCHCO2%dgsave ) THEN 1976 f_ocnschco2_2d(ji,jj) = f_schmidtco2 1977 ENDIF 1978 IF( med_diag%OCN_KWCO2%dgsave ) THEN 1979 f_ocnkwco2_2d(ji,jj) = f_kwco2 1980 ENDIF 1981 IF( med_diag%OCN_K0%dgsave ) THEN 1982 f_ocnk0_2d(ji,jj) = f_K0 1983 ENDIF 1984 IF( med_diag%CO2STARAIR%dgsave ) THEN 1985 f_co2starair_2d(ji,jj) = f_co2starair 1986 ENDIF 1987 IF( med_diag%OCN_DPCO2%dgsave ) THEN 1988 f_ocndpco2_2d(ji,jj) = f_dpco2 1989 ENDIF 1990 ENDIF 1991 !! 1992 endif 1993 !! End jk = 1 loop within ROAM key 1994 1995 !! AXY (11/11/16): CMIP6 oxygen saturation 3D diagnostic 1996 IF ( med_diag%O2SAT3%dgsave ) THEN 1997 call oxy_sato( ztmp, zsal, f_o2sat3 ) 1998 o2sat3(ji, jj, jk) = f_o2sat3 1999 ENDIF 2000 2001 # endif 2002 2003 if ( jk .eq. 1 ) then 2004 !!---------------------------------------------------------------------- 2005 !! River inputs 2006 !!---------------------------------------------------------------------- 2007 !! 2008 !! runoff comes in as kg / m2 / s 2009 !! used and written out as m3 / m2 / d (= m / d) 2010 !! where 1000 kg / m2 / d = 1 m3 / m2 / d = 1 m / d 2011 !! 2012 !! AXY (17/07/14): the compiler doesn't like this line for some reason; 2013 !! as MEDUSA doesn't even use runoff for riverine inputs, 2014 !! a temporary solution is to switch off runoff entirely 2015 !! here; again, this change is one of several that will 2016 !! need revisiting once MEDUSA has bedded down in UKESM1; 2017 !! particularly so if the land scheme provides information 2018 !! concerning nutrient fluxes 2019 !! 2020 !! f_runoff(ji,jj) = sf_rnf(1)%fnow(ji,jj,1) / 1000. * 60. * 60. * 24. 2021 f_runoff(ji,jj) = 0.0 2022 !! 2023 !! nutrients are added via rivers to the model in one of two ways: 2024 !! 1. via river concentration; i.e. the average nutrient concentration 2025 !! of a river water is described by a spatial file, and this is 2026 !! multiplied by runoff to give a nutrient flux 2027 !! 2. via direct river flux; i.e. the average nutrient flux due to 2028 !! rivers is described by a spatial file, and this is simply applied 2029 !! as a direct nutrient flux (i.e. it does not relate or respond to 2030 !! model runoff) 2031 !! nutrient fields are derived from the GlobalNEWS 2 database; carbon and 2032 !! alkalinity are derived from continent-scale DIC estimates (Huang et al., 2033 !! 2012) and some Arctic river alkalinity estimates (Katya?) 2034 !! 2035 !! as of 19/07/12, riverine nutrients can now be spread vertically across 2036 !! several grid cells rather than just poured into the surface box; this 2037 !! block of code is still executed, however, to set up the total amounts 2038 !! of nutrient entering via rivers 2039 !! 2040 !! nitrogen 2041 if (jriver_n .eq. 1) then 2042 !! river concentration specified; use runoff to calculate input 2043 f_riv_n(ji,jj) = f_runoff(ji,jj) * riv_n(ji,jj) 2044 elseif (jriver_n .eq. 2) then 2045 !! river flux specified; independent of runoff 2046 f_riv_n(ji,jj) = riv_n(ji,jj) 2047 endif 2048 !! 2049 !! silicon 2050 if (jriver_si .eq. 1) then 2051 !! river concentration specified; use runoff to calculate input 2052 f_riv_si(ji,jj) = f_runoff(ji,jj) * riv_si(ji,jj) 2053 elseif (jriver_si .eq. 2) then 2054 !! river flux specified; independent of runoff 2055 f_riv_si(ji,jj) = riv_si(ji,jj) 2056 endif 2057 !! 2058 !! carbon 2059 if (jriver_c .eq. 1) then 2060 !! river concentration specified; use runoff to calculate input 2061 f_riv_c(ji,jj) = f_runoff(ji,jj) * riv_c(ji,jj) 2062 elseif (jriver_c .eq. 2) then 2063 !! river flux specified; independent of runoff 2064 f_riv_c(ji,jj) = riv_c(ji,jj) 2065 endif 2066 !! 2067 !! alkalinity 2068 if (jriver_alk .eq. 1) then 2069 !! river concentration specified; use runoff to calculate input 2070 f_riv_alk(ji,jj) = f_runoff(ji,jj) * riv_alk(ji,jj) 2071 elseif (jriver_alk .eq. 2) then 2072 !! river flux specified; independent of runoff 2073 f_riv_alk(ji,jj) = riv_alk(ji,jj) 2074 endif 2075 2076 endif 2077 2078 !!---------------------------------------------------------------------- 2079 !! Chlorophyll calculations 2080 !!---------------------------------------------------------------------- 2081 !! 2082 !! non-diatoms 2083 if (zphn.GT.rsmall) then 2084 fthetan = max(tiny(zchn), (zchn * xxi) / (zphn + tiny(zphn))) 2085 faln = xaln * fthetan 2086 else 2087 fthetan = 0. 2088 faln = 0. 2089 endif 2090 !! 2091 !! diatoms 2092 if (zphd.GT.rsmall) then 2093 fthetad = max(tiny(zchd), (zchd * xxi) / (zphd + tiny(zphd))) 2094 fald = xald * fthetad 2095 else 2096 fthetad = 0. 2097 fald = 0. 2098 endif 2099 2100 # if defined key_debug_medusa 2101 !! report biological calculations 2102 if (idf.eq.1.AND.idfval.eq.1) then 2103 IF (lwp) write (numout,*) '------------------------------' 2104 IF (lwp) write (numout,*) 'faln(',jk,') = ', faln 2105 IF (lwp) write (numout,*) 'fald(',jk,') = ', fald 2106 endif 2107 # endif 2108 2109 !!---------------------------------------------------------------------- 2110 !! Phytoplankton light limitation 2111 !!---------------------------------------------------------------------- 2112 !! 2113 !! It is assumed xpar is the depth-averaged (vertical layer) PAR 2114 !! Light limitation (check self-shading) in W/m2 2115 !! 2116 !! Note that there is no temperature dependence in phytoplankton 2117 !! growth rate or any other function. 2118 !! In calculation of Chl/Phy ratio tiny(phyto) is introduced to avoid 2119 !! NaNs in case of Phy==0. 2120 !! 2121 !! fthetad and fthetan are Chl:C ratio (gChl/gC) in diat and non-diat: 2122 !! for 1:1 Chl:P ratio (mgChl/mmolN) theta=0.012 2123 !! 2124 !! AXY (16/07/09) 2125 !! temperature for new Eppley style phytoplankton growth 2126 loc_T = tsn(ji,jj,jk,jp_tem) 2127 fun_T = 1.066**(1.0 * loc_T) 2128 !! AXY (16/05/11): add in new Q10 (1.5, not 2.0) for 2129 !phytoplankton 2130 !! growth; remin. unaffected 2131 fun_Q10 = jq10**((loc_T - 0.0) / 10.0) 2132 if (jphy.eq.1) then 2133 xvpnT = xvpn * fun_T 2134 xvpdT = xvpd * fun_T 2135 elseif (jphy.eq.2) then 2136 xvpnT = xvpn * fun_Q10 2137 xvpdT = xvpd * fun_Q10 2138 else 2139 xvpnT = xvpn 2140 xvpdT = xvpd 2141 endif 2142 !! 2143 !! non-diatoms 2144 fchn1 = (xvpnT * xvpnT) + (faln * faln * xpar(ji,jj,jk) * xpar(ji,jj,jk)) 2145 if (fchn1.GT.rsmall) then 2146 fchn = xvpnT / (sqrt(fchn1) + tiny(fchn1)) 2147 else 2148 fchn = 0. 2149 endif 2150 fjln = fchn * faln * xpar(ji,jj,jk) !! non-diatom J term 2151 fjlim_pn = fjln / xvpnT 2152 !! 2153 !! diatoms 2154 fchd1 = (xvpdT * xvpdT) + (fald * fald * xpar(ji,jj,jk) * xpar(ji,jj,jk)) 2155 if (fchd1.GT.rsmall) then 2156 fchd = xvpdT / (sqrt(fchd1) + tiny(fchd1)) 2157 else 2158 fchd = 0. 2159 endif 2160 fjld = fchd * fald * xpar(ji,jj,jk) !! diatom J term 2161 fjlim_pd = fjld / xvpdT 2162 2163 # if defined key_debug_medusa 2164 !! report phytoplankton light limitation 2165 if (idf.eq.1.AND.idfval.eq.1) then 2166 IF (lwp) write (numout,*) '------------------------------' 2167 IF (lwp) write (numout,*) 'fchn(',jk,') = ', fchn 2168 IF (lwp) write (numout,*) 'fchd(',jk,') = ', fchd 2169 IF (lwp) write (numout,*) 'fjln(',jk,') = ', fjln 2170 IF (lwp) write (numout,*) 'fjld(',jk,') = ', fjld 2171 endif 2172 # endif 2173 2174 !!---------------------------------------------------------------------- 2175 !! Phytoplankton nutrient limitation 2176 !!---------------------------------------------------------------------- 2177 !! 2178 !! non-diatoms (N, Fe) 2179 fnln = zdin / (zdin + xnln) !! non-diatom Qn term 2180 ffln = zfer / (zfer + xfln) !! non-diatom Qf term 2181 !! 2182 !! diatoms (N, Si, Fe) 2183 fnld = zdin / (zdin + xnld) !! diatom Qn term 2184 fsld = zsil / (zsil + xsld) !! diatom Qs term 2185 ffld = zfer / (zfer + xfld) !! diatom Qf term 2186 2187 # if defined key_debug_medusa 2188 !! report phytoplankton nutrient limitation 2189 if (idf.eq.1.AND.idfval.eq.1) then 2190 IF (lwp) write (numout,*) '------------------------------' 2191 IF (lwp) write (numout,*) 'fnln(',jk,') = ', fnln 2192 IF (lwp) write (numout,*) 'fnld(',jk,') = ', fnld 2193 IF (lwp) write (numout,*) 'ffln(',jk,') = ', ffln 2194 IF (lwp) write (numout,*) 'ffld(',jk,') = ', ffld 2195 IF (lwp) write (numout,*) 'fsld(',jk,') = ', fsld 2196 endif 2197 # endif 2198 2199 !!---------------------------------------------------------------------- 2200 !! Primary production (non-diatoms) 2201 !! (note: still needs multiplying by phytoplankton concentration) 2202 !!---------------------------------------------------------------------- 2203 !! 2204 if (jliebig .eq. 0) then 2205 !! multiplicative nutrient limitation 2206 fpnlim = fnln * ffln 2207 elseif (jliebig .eq. 1) then 2208 !! Liebig Law (= most limiting) nutrient limitation 2209 fpnlim = min(fnln, ffln) 2210 endif 2211 fprn = fjln * fpnlim 2212 2213 !!---------------------------------------------------------------------- 2214 !! Primary production (diatoms) 2215 !! (note: still needs multiplying by phytoplankton concentration) 2216 !! 2217 !! production here is split between nitrogen production and that of 2218 !! silicon; depending upon the "intracellular" ratio of Si:N, model 2219 !! diatoms will uptake nitrogen/silicon differentially; this borrows 2220 !! from the diatom model of Mongin et al. (2006) 2221 !!---------------------------------------------------------------------- 2222 !! 2223 if (jliebig .eq. 0) then 2224 !! multiplicative nutrient limitation 2225 fpdlim = fnld * ffld 2226 elseif (jliebig .eq. 1) then 2227 !! Liebig Law (= most limiting) nutrient limitation 2228 fpdlim = min(fnld, ffld) 2229 endif 2230 !! 2231 if (zphd.GT.rsmall .AND. zpds.GT.rsmall) then 2232 !! "intracellular" elemental ratios 2233 ! fsin = zpds / (zphd + tiny(zphd)) 2234 ! fnsi = zphd / (zpds + tiny(zpds)) 2235 fsin = 0.0 2236 IF( zphd .GT. rsmall) fsin = zpds / zphd 2237 fnsi = 0.0 2238 IF( zpds .GT. rsmall) fnsi = zphd / zpds 2239 !! AXY (23/02/10): these next variables derive from Mongin et al. (2003) 2240 fsin1 = 3.0 * xsin0 !! = 0.6 2241 fnsi1 = 1.0 / fsin1 !! = 1.667 2242 fnsi2 = 1.0 / xsin0 !! = 5.0 2243 !! 2244 !! conditionalities based on ratios 2245 !! nitrogen (and iron and carbon) 2246 if (fsin.le.xsin0) then 2247 fprd = 0.0 2248 fsld2 = 0.0 2249 elseif (fsin.lt.fsin1) then 2250 fprd = xuif * ((fsin - xsin0) / (fsin + tiny(fsin))) * (fjld * fpdlim) 2251 fsld2 = xuif * ((fsin - xsin0) / (fsin + tiny(fsin))) 2252 elseif (fsin.ge.fsin1) then 2253 fprd = (fjld * fpdlim) 2254 fsld2 = 1.0 2255 endif 2256 !! 2257 !! silicon 2258 if (fsin.lt.fnsi1) then 2259 fprds = (fjld * fsld) 2260 elseif (fsin.lt.fnsi2) then 2261 fprds = xuif * ((fnsi - xnsi0) / (fnsi + tiny(fnsi))) * (fjld * fsld) 2262 else 2263 fprds = 0.0 2264 endif 2265 else 2266 fsin = 0.0 2267 fnsi = 0.0 2268 fprd = 0.0 2269 fsld2 = 0.0 2270 fprds = 0.0 2271 endif 2272 2273 # if defined key_debug_medusa 2274 !! report phytoplankton growth (including diatom silicon submodel) 2275 if (idf.eq.1.AND.idfval.eq.1) then 2276 IF (lwp) write (numout,*) '------------------------------' 2277 IF (lwp) write (numout,*) 'fsin(',jk,') = ', fsin 2278 IF (lwp) write (numout,*) 'fnsi(',jk,') = ', fnsi 2279 IF (lwp) write (numout,*) 'fsld2(',jk,') = ', fsld2 2280 IF (lwp) write (numout,*) 'fprn(',jk,') = ', fprn 2281 IF (lwp) write (numout,*) 'fprd(',jk,') = ', fprd 2282 IF (lwp) write (numout,*) 'fprds(',jk,') = ', fprds 2283 endif 2284 # endif 2285 2286 !!---------------------------------------------------------------------- 2287 !! Mixed layer primary production 2288 !! this block calculates the amount of primary production that occurs 2289 !! within the upper mixed layer; this allows the separate diagnosis 2290 !! of "sub-surface" primary production; it does assume that short- 2291 !! term variability in mixed layer depth doesn't mess with things 2292 !! though 2293 !!---------------------------------------------------------------------- 2294 !! 2295 if (fdep1.le.hmld(ji,jj)) then 2296 !! this level is entirely in the mixed layer 2297 fq0 = 1.0 2298 elseif (fdep.ge.hmld(ji,jj)) then 2299 !! this level is entirely below the mixed layer 2300 fq0 = 0.0 2301 else 2302 !! this level straddles the mixed layer 2303 fq0 = (hmld(ji,jj) - fdep) / fthk 2304 endif 2305 !! 2306 fprn_ml(ji,jj) = fprn_ml(ji,jj) + (fprn * zphn * fthk * fq0) 2307 fprd_ml(ji,jj) = fprd_ml(ji,jj) + (fprd * zphd * fthk * fq0) 2308 2309 !!---------------------------------------------------------------------- 2310 !! Vertical Integral -- 2311 !!---------------------------------------------------------------------- 2312 ftot_pn(ji,jj) = ftot_pn(ji,jj) + (zphn * fthk) !! vertical integral non-diatom phytoplankton 2313 ftot_pd(ji,jj) = ftot_pd(ji,jj) + (zphd * fthk) !! vertical integral diatom phytoplankton 2314 ftot_zmi(ji,jj) = ftot_zmi(ji,jj) + (zzmi * fthk) !! vertical integral microzooplankton 2315 ftot_zme(ji,jj) = ftot_zme(ji,jj) + (zzme * fthk) !! vertical integral mesozooplankton 2316 ftot_det(ji,jj) = ftot_det(ji,jj) + (zdet * fthk) !! vertical integral slow detritus, nitrogen 2317 ftot_dtc(ji,jj) = ftot_dtc(ji,jj) + (zdtc * fthk) !! vertical integral slow detritus, carbon 2318 2319 !!---------------------------------------------------------------------- 2320 !! More chlorophyll calculations 2321 !!---------------------------------------------------------------------- 2322 !! 2323 !! frn = (xthetam / fthetan) * (fprn / (fthetan * xpar(ji,jj,jk))) 2324 !! frd = (xthetam / fthetad) * (fprd / (fthetad * xpar(ji,jj,jk))) 2325 frn = (xthetam * fchn * fnln * ffln ) / (fthetan + tiny(fthetan)) 2326 !! AXY (12/05/09): there's potentially a problem here; fsld, silicic acid 2327 !! limitation, is used in the following line to regulate chlorophyll 2328 !! growth in a manner that is inconsistent with its use in the regulation 2329 !! of biomass growth; the Mongin term term used in growth is more complex 2330 !! than the simple multiplicative function used below 2331 !! frd = (xthetam * fchd * fnld * ffld * fsld) / (fthetad + tiny(fthetad)) 2332 !! AXY (12/05/09): this replacement line uses the new variable, fsld2, to 2333 !! regulate chlorophyll growth 2334 frd = (xthetamd * fchd * fnld * ffld * fsld2) / (fthetad + tiny(fthetad)) 2335 2336 # if defined key_debug_medusa 2337 !! report chlorophyll calculations 2338 if (idf.eq.1.AND.idfval.eq.1) then 2339 IF (lwp) write (numout,*) '------------------------------' 2340 IF (lwp) write (numout,*) 'fthetan(',jk,') = ', fthetan 2341 IF (lwp) write (numout,*) 'fthetad(',jk,') = ', fthetad 2342 IF (lwp) write (numout,*) 'frn(',jk,') = ', frn 2343 IF (lwp) write (numout,*) 'frd(',jk,') = ', frd 2344 endif 2345 # endif 2346 2347 !!---------------------------------------------------------------------- 2348 !! Zooplankton Grazing 2349 !! this code supplements the base grazing model with one that 2350 !! considers the C:N ratio of grazed food and balances this against 2351 !! the requirements of zooplankton growth; this model is derived 2352 !! from that of Anderson & Pondaven (2003) 2353 !! 2354 !! the current version of the code assumes a fixed C:N ratio for 2355 !! detritus (in contrast to Anderson & Pondaven, 2003), though the 2356 !! full equations are retained for future extension 2357 !!---------------------------------------------------------------------- 2358 !! 2359 !!---------------------------------------------------------------------- 2360 !! Microzooplankton first 2361 !!---------------------------------------------------------------------- 2362 !! 2363 fmi1 = (xkmi * xkmi) + (xpmipn * zphn * zphn) + (xpmid * zdet * zdet) 2364 fmi = xgmi * zzmi / fmi1 2365 fgmipn = fmi * xpmipn * zphn * zphn !! grazing on non-diatoms 2366 fgmid = fmi * xpmid * zdet * zdet !! grazing on detrital nitrogen 2367 # if defined key_roam 2368 fgmidc = rsmall !acc 2369 IF ( zdet .GT. rsmall ) fgmidc = (zdtc / (zdet + tiny(zdet))) * fgmid !! grazing on detrital carbon 2370 # else 2371 !! AXY (26/11/08): implicit detrital carbon change 2372 fgmidc = xthetad * fgmid !! grazing on detrital carbon 2373 # endif 2374 !! 2375 !! which translates to these incoming N and C fluxes 2376 finmi = (1.0 - xphi) * (fgmipn + fgmid) 2377 ficmi = (1.0 - xphi) * ((xthetapn * fgmipn) + fgmidc) 2378 !! 2379 !! the ideal food C:N ratio for microzooplankton 2380 !! xbetan = 0.77; xthetaz = 5.625; xbetac = 0.64; xkc = 0.80 2381 fstarmi = (xbetan * xthetazmi) / (xbetac * xkc) 2382 !! 2383 !! process these to determine proportioning of grazed N and C 2384 !! (since there is no explicit consideration of respiration, 2385 !! only growth and excretion are calculated here) 2386 fmith = (ficmi / (finmi + tiny(finmi))) 2387 if (fmith.ge.fstarmi) then 2388 fmigrow = xbetan * finmi 2389 fmiexcr = 0.0 2390 else 2391 fmigrow = (xbetac * xkc * ficmi) / xthetazmi 2392 fmiexcr = ficmi * ((xbetan / (fmith + tiny(fmith))) - ((xbetac * xkc) / xthetazmi)) 2393 endif 2394 # if defined key_roam 2395 fmiresp = (xbetac * ficmi) - (xthetazmi * fmigrow) 2396 # endif 2397 2398 # if defined key_debug_medusa 2399 !! report microzooplankton grazing 2400 if (idf.eq.1.AND.idfval.eq.1) then 2401 IF (lwp) write (numout,*) '------------------------------' 2402 IF (lwp) write (numout,*) 'fmi1(',jk,') = ', fmi1 2403 IF (lwp) write (numout,*) 'fmi(',jk,') = ', fmi 2404 IF (lwp) write (numout,*) 'fgmipn(',jk,') = ', fgmipn 2405 IF (lwp) write (numout,*) 'fgmid(',jk,') = ', fgmid 2406 IF (lwp) write (numout,*) 'fgmidc(',jk,') = ', fgmidc 2407 IF (lwp) write (numout,*) 'finmi(',jk,') = ', finmi 2408 IF (lwp) write (numout,*) 'ficmi(',jk,') = ', ficmi 2409 IF (lwp) write (numout,*) 'fstarmi(',jk,') = ', fstarmi 2410 IF (lwp) write (numout,*) 'fmith(',jk,') = ', fmith 2411 IF (lwp) write (numout,*) 'fmigrow(',jk,') = ', fmigrow 2412 IF (lwp) write (numout,*) 'fmiexcr(',jk,') = ', fmiexcr 2413 # if defined key_roam 2414 IF (lwp) write (numout,*) 'fmiresp(',jk,') = ', fmiresp 2415 # endif 2416 endif 2417 # endif 2418 2419 !!---------------------------------------------------------------------- 2420 !! Mesozooplankton second 2421 !!---------------------------------------------------------------------- 2422 !! 2423 fme1 = (xkme * xkme) + (xpmepn * zphn * zphn) + (xpmepd * zphd * zphd) + & 2424 (xpmezmi * zzmi * zzmi) + (xpmed * zdet * zdet) 2425 fme = xgme * zzme / fme1 2426 fgmepn = fme * xpmepn * zphn * zphn !! grazing on non-diatoms 2427 fgmepd = fme * xpmepd * zphd * zphd !! grazing on diatoms 2428 fgmepds = fsin * fgmepd !! grazing on diatom silicon 2429 fgmezmi = fme * xpmezmi * zzmi * zzmi !! grazing on microzooplankton 2430 fgmed = fme * xpmed * zdet * zdet !! grazing on detrital nitrogen 2431 # if defined key_roam 2432 fgmedc = rsmall !acc 2433 IF ( zdet .GT. rsmall ) fgmedc = (zdtc / (zdet + tiny(zdet))) * fgmed !! grazing on detrital carbon 2434 # else 2435 !! AXY (26/11/08): implicit detrital carbon change 2436 fgmedc = xthetad * fgmed !! grazing on detrital carbon 2437 # endif 2438 !! 2439 !! which translates to these incoming N and C fluxes 2440 finme = (1.0 - xphi) * (fgmepn + fgmepd + fgmezmi + fgmed) 2441 ficme = (1.0 - xphi) * ((xthetapn * fgmepn) + (xthetapd * fgmepd) + & 2442 (xthetazmi * fgmezmi) + fgmedc) 2443 !! 2444 !! the ideal food C:N ratio for mesozooplankton 2445 !! xbetan = 0.77; xthetaz = 5.625; xbetac = 0.64; xkc = 0.80 2446 fstarme = (xbetan * xthetazme) / (xbetac * xkc) 2447 !! 2448 !! process these to determine proportioning of grazed N and C 2449 !! (since there is no explicit consideration of respiration, 2450 !! only growth and excretion are calculated here) 2451 fmeth = (ficme / (finme + tiny(finme))) 2452 if (fmeth.ge.fstarme) then 2453 fmegrow = xbetan * finme 2454 fmeexcr = 0.0 2455 else 2456 fmegrow = (xbetac * xkc * ficme) / xthetazme 2457 fmeexcr = ficme * ((xbetan / (fmeth + tiny(fmeth))) - ((xbetac * xkc) / xthetazme)) 2458 endif 2459 # if defined key_roam 2460 fmeresp = (xbetac * ficme) - (xthetazme * fmegrow) 2461 # endif 2462 2463 # if defined key_debug_medusa 2464 !! report mesozooplankton grazing 2465 if (idf.eq.1.AND.idfval.eq.1) then 2466 IF (lwp) write (numout,*) '------------------------------' 2467 IF (lwp) write (numout,*) 'fme1(',jk,') = ', fme1 2468 IF (lwp) write (numout,*) 'fme(',jk,') = ', fme 2469 IF (lwp) write (numout,*) 'fgmepn(',jk,') = ', fgmepn 2470 IF (lwp) write (numout,*) 'fgmepd(',jk,') = ', fgmepd 2471 IF (lwp) write (numout,*) 'fgmepds(',jk,') = ', fgmepds 2472 IF (lwp) write (numout,*) 'fgmezmi(',jk,') = ', fgmezmi 2473 IF (lwp) write (numout,*) 'fgmed(',jk,') = ', fgmed 2474 IF (lwp) write (numout,*) 'fgmedc(',jk,') = ', fgmedc 2475 IF (lwp) write (numout,*) 'finme(',jk,') = ', finme 2476 IF (lwp) write (numout,*) 'ficme(',jk,') = ', ficme 2477 IF (lwp) write (numout,*) 'fstarme(',jk,') = ', fstarme 2478 IF (lwp) write (numout,*) 'fmeth(',jk,') = ', fmeth 2479 IF (lwp) write (numout,*) 'fmegrow(',jk,') = ', fmegrow 2480 IF (lwp) write (numout,*) 'fmeexcr(',jk,') = ', fmeexcr 2481 # if defined key_roam 2482 IF (lwp) write (numout,*) 'fmeresp(',jk,') = ', fmeresp 2483 # endif 2484 endif 2485 # endif 2486 2487 fzmi_i(ji,jj) = fzmi_i(ji,jj) + fthk * ( & 2488 fgmipn + fgmid ) 2489 fzmi_o(ji,jj) = fzmi_o(ji,jj) + fthk * ( & 2490 fmigrow + (xphi * (fgmipn + fgmid)) + fmiexcr + ((1.0 - xbetan) * finmi) ) 2491 fzme_i(ji,jj) = fzme_i(ji,jj) + fthk * ( & 2492 fgmepn + fgmepd + fgmezmi + fgmed ) 2493 fzme_o(ji,jj) = fzme_o(ji,jj) + fthk * ( & 2494 fmegrow + (xphi * (fgmepn + fgmepd + fgmezmi + fgmed)) + fmeexcr + ((1.0 - xbetan) * finme) ) 2495 2496 !!---------------------------------------------------------------------- 2497 !! Plankton metabolic losses 2498 !! Linear loss processes assumed to be metabolic in origin 2499 !!---------------------------------------------------------------------- 2500 !! 2501 fdpn2 = xmetapn * zphn 2502 fdpd2 = xmetapd * zphd 2503 fdpds2 = xmetapd * zpds 2504 fdzmi2 = xmetazmi * zzmi 2505 fdzme2 = xmetazme * zzme 2506 2507 !!---------------------------------------------------------------------- 2508 !! Plankton mortality losses 2509 !! EKP (26/02/09): phytoplankton hyperbolic mortality term introduced 2510 !! to improve performance in gyres 2511 !!---------------------------------------------------------------------- 2512 !! 2513 !! non-diatom phytoplankton 2514 if (jmpn.eq.1) fdpn = xmpn * zphn !! linear 2515 if (jmpn.eq.2) fdpn = xmpn * zphn * zphn !! quadratic 2516 if (jmpn.eq.3) fdpn = xmpn * zphn * & !! hyperbolic 2517 (zphn / (xkphn + zphn)) 2518 if (jmpn.eq.4) fdpn = xmpn * zphn * & !! sigmoid 2519 ((zphn * zphn) / (xkphn + (zphn * zphn))) 2520 !! 2521 !! diatom phytoplankton 2522 if (jmpd.eq.1) fdpd = xmpd * zphd !! linear 2523 if (jmpd.eq.2) fdpd = xmpd * zphd * zphd !! quadratic 2524 if (jmpd.eq.3) fdpd = xmpd * zphd * & !! hyperbolic 2525 (zphd / (xkphd + zphd)) 2526 if (jmpd.eq.4) fdpd = xmpd * zphd * & !! sigmoid 2527 ((zphd * zphd) / (xkphd + (zphd * zphd))) 2528 fdpds = fdpd * fsin 2529 !! 2530 !! microzooplankton 2531 if (jmzmi.eq.1) fdzmi = xmzmi * zzmi !! linear 2532 if (jmzmi.eq.2) fdzmi = xmzmi * zzmi * zzmi !! quadratic 2533 if (jmzmi.eq.3) fdzmi = xmzmi * zzmi * & !! hyperbolic 2534 (zzmi / (xkzmi + zzmi)) 2535 if (jmzmi.eq.4) fdzmi = xmzmi * zzmi * & !! sigmoid 2536 ((zzmi * zzmi) / (xkzmi + (zzmi * zzmi))) 2537 !! 2538 !! mesozooplankton 2539 if (jmzme.eq.1) fdzme = xmzme * zzme !! linear 2540 if (jmzme.eq.2) fdzme = xmzme * zzme * zzme !! quadratic 2541 if (jmzme.eq.3) fdzme = xmzme * zzme * & !! hyperbolic 2542 (zzme / (xkzme + zzme)) 2543 if (jmzme.eq.4) fdzme = xmzme * zzme * & !! sigmoid 2544 ((zzme * zzme) / (xkzme + (zzme * zzme))) 2545 2546 !!---------------------------------------------------------------------- 2547 !! Detritus remineralisation 2548 !! Constant or temperature-dependent 2549 !!---------------------------------------------------------------------- 2550 !! 2551 if (jmd.eq.1) then 2552 !! temperature-dependent 2553 fdd = xmd * fun_T * zdet 2554 # if defined key_roam 2555 fddc = xmdc * fun_T * zdtc 2556 # endif 2557 elseif (jmd.eq.2) then 2558 !! AXY (16/05/13): add in Q10-based parameterisation (def in nmlst) 2559 !! temperature-dependent 2560 fdd = xmd * fun_Q10 * zdet 2561 # if defined key_roam 2562 fddc = xmdc * fun_Q10 * zdtc 2563 # endif 2564 else 2565 !! temperature-independent 2566 fdd = xmd * zdet 2567 # if defined key_roam 2568 fddc = xmdc * zdtc 2569 # endif 2570 endif 2571 !! 2572 !! AXY (22/07/09): accelerate detrital remineralisation in the bottom box 2573 if ((jk.eq.jmbathy) .and. jsfd.eq.1) then 2574 fdd = 1.0 * zdet 2575 # if defined key_roam 2576 fddc = 1.0 * zdtc 2577 # endif 2578 endif 2579 2580 # if defined key_debug_medusa 2581 !! report plankton mortality and remineralisation 2582 if (idf.eq.1.AND.idfval.eq.1) then 2583 IF (lwp) write (numout,*) '------------------------------' 2584 IF (lwp) write (numout,*) 'fdpn2(',jk,') = ', fdpn2 2585 IF (lwp) write (numout,*) 'fdpd2(',jk,') = ', fdpd2 2586 IF (lwp) write (numout,*) 'fdpds2(',jk,')= ', fdpds2 2587 IF (lwp) write (numout,*) 'fdzmi2(',jk,')= ', fdzmi2 2588 IF (lwp) write (numout,*) 'fdzme2(',jk,')= ', fdzme2 2589 IF (lwp) write (numout,*) 'fdpn(',jk,') = ', fdpn 2590 IF (lwp) write (numout,*) 'fdpd(',jk,') = ', fdpd 2591 IF (lwp) write (numout,*) 'fdpds(',jk,') = ', fdpds 2592 IF (lwp) write (numout,*) 'fdzmi(',jk,') = ', fdzmi 2593 IF (lwp) write (numout,*) 'fdzme(',jk,') = ', fdzme 2594 IF (lwp) write (numout,*) 'fdd(',jk,') = ', fdd 2595 # if defined key_roam 2596 IF (lwp) write (numout,*) 'fddc(',jk,') = ', fddc 2597 # endif 2598 endif 2599 # endif 2600 2601 !!---------------------------------------------------------------------- 2602 !! Detritus addition to benthos 2603 !! If activated, slow detritus in the bottom box will enter the 2604 !! benthic pool 2605 !!---------------------------------------------------------------------- 2606 !! 2607 if ((jk.eq.jmbathy) .and. jorgben.eq.1) then 2608 !! this is the BOTTOM OCEAN BOX -> into the benthic pool! 2609 !! 2610 f_sbenin_n(ji,jj) = (zdet * vsed * 86400.) 2611 f_sbenin_fe(ji,jj) = (zdet * vsed * 86400. * xrfn) 2612 # if defined key_roam 2613 f_sbenin_c(ji,jj) = (zdtc * vsed * 86400.) 2614 # else 2615 f_sbenin_c(ji,jj) = (zdet * vsed * 86400. * xthetad) 2616 # endif 2617 endif 2618 2619 !!---------------------------------------------------------------------- 2620 !! Iron chemistry and fractionation 2621 !! following the Parekh et al. (2004) scheme adopted by the Met. 2622 !! Office, Medusa models total iron but considers "free" and 2623 !! ligand-bound forms for the purposes of scavenging (only "free" 2624 !! iron can be scavenged 2625 !!---------------------------------------------------------------------- 2626 !! 2627 !! total iron concentration (mmol Fe / m3 -> umol Fe / m3) 2628 xFeT = zfer * 1.e3 2629 !! 2630 !! calculate fractionation (based on Diat-HadOCC; in turn based on Parekh et al., 2004) 2631 xb_coef_tmp = xk_FeL * (xLgT - xFeT) - 1.0 2632 xb2M4ac = max(((xb_coef_tmp * xb_coef_tmp) + (4.0 * xk_FeL * xLgT)), 0.0) 2633 !! 2634 !! "free" ligand concentration 2635 xLgF = 0.5 * (xb_coef_tmp + (xb2M4ac**0.5)) / xk_FeL 2636 !! 2637 !! ligand-bound iron concentration 2638 xFeL = xLgT - xLgF 2639 !! 2640 !! "free" iron concentration (and convert to mmol Fe / m3) 2641 xFeF = (xFeT - xFeL) * 1.e-3 2642 xFree(ji,jj)= xFeF / (zfer + tiny(zfer)) 2643 !! 2644 !! scavenging of iron (multiple schemes); I'm only really happy with the 2645 !! first one at the moment - the others involve assumptions (sometimes 2646 !! guessed at by me) that are potentially questionable 2647 !! 2648 if (jiron.eq.1) then 2649 !!---------------------------------------------------------------------- 2650 !! Scheme 1: Dutkiewicz et al. (2005) 2651 !! This scheme includes a single scavenging term based solely on a 2652 !! fixed rate and the availablility of "free" iron 2653 !!---------------------------------------------------------------------- 2654 !! 2655 ffescav = xk_sc_Fe * xFeF ! = mmol/m3/d 2656 !! 2657 !!---------------------------------------------------------------------- 2658 !! 2659 !! Mick's code contains a further (optional) implicit "scavenging" of 2660 !! iron that sets an upper bound on "free" iron concentration, and 2661 !! essentially caps the concentration of total iron as xFeL + "free" 2662 !! iron; since the former is constrained by a fixed total ligand 2663 !! concentration (= 1.0 umol/m3), and the latter isn't allowed above 2664 !! this upper bound, total iron is constrained to a maximum of ... 2665 !! 2666 !! xFeL + min(xFeF, 0.3 umol/m3) = 1.0 + 0.3 = 1.3 umol / m3 2667 !! 2668 !! In Mick's code, the actual value of total iron is reset to this 2669 !! sum (i.e. TFe = FeL + Fe'; but Fe' <= 0.3 umol/m3); this isn't 2670 !! our favoured approach to tracer updating here (not least because 2671 !! of the leapfrog), so here the amount scavenged is augmented by an 2672 !! additional amount that serves to drag total iron back towards that 2673 !! expected from this limitation on iron concentration ... 2674 !! 2675 xmaxFeF = min((xFeF * 1.e3), 0.3) ! = umol/m3 2676 !! 2677 !! Here, the difference between current total Fe and (FeL + Fe') is 2678 !! calculated and added to the scavenging flux already calculated 2679 !! above ... 2680 !! 2681 fdeltaFe = (xFeT - (xFeL + xmaxFeF)) * 1.e-3 ! = mmol/m3 2682 !! 2683 !! This assumes that the "excess" iron is dissipated with a time- 2684 !! scale of 1 day; seems reasonable to me ... (famous last words) 2685 !! 2686 ffescav = ffescav + fdeltaFe ! = mmol/m3/d 2687 !! 2688 # if defined key_deep_fe_fix 2689 !! AXY (17/01/13) 2690 !! stop scavenging for iron concentrations below 0.5 umol / m3 2691 !! at depths greater than 1000 m; this aims to end MEDUSA's 2692 !! continual loss of iron at depth without impacting things 2693 !! at the surface too much; the justification for this is that 2694 !! it appears to be what Mick Follows et al. do in their work 2695 !! (as evidenced by the iron initial condition they supplied 2696 !! me with); to be honest, it looks like Follow et al. do this 2697 !! at shallower depths than 1000 m, but I'll stick with this 2698 !! for now; I suspect that this seemingly arbitrary approach 2699 !! effectively "parameterises" the particle-based scavenging 2700 !! rates that other models use (i.e. at depth there are no 2701 !! sinking particles, so scavenging stops); it might be fun 2702 !! justifying this in a paper though! 2703 !! 2704 if ((fdep.gt.1000.) .and. (xFeT.lt.0.5)) then 2705 ffescav = 0. 2706 endif 2707 # endif 2708 !! 2709 elseif (jiron.eq.2) then 2710 !!---------------------------------------------------------------------- 2711 !! Scheme 2: Moore et al. (2004) 2712 !! This scheme includes a single scavenging term that accounts for 2713 !! both suspended and sinking particles in the water column; this 2714 !! term scavenges total iron rather than "free" iron 2715 !!---------------------------------------------------------------------- 2716 !! 2717 !! total iron concentration (mmol Fe / m3 -> umol Fe / m3) 2718 xFeT = zfer * 1.e3 2719 !! 2720 !! this has a base scavenging rate (12% / y) which is modified by local 2721 !! particle concentration and sinking flux (and dust - but I'm ignoring 2722 !! that here for now) and which is accelerated when Fe concentration gets 2723 !! 0.6 nM (= 0.6 umol/m3 = 0.0006 mmol/m3), and decreased as concentrations 2724 !! below 0.4 nM (= 0.4 umol/m3 = 0.0004 mmol/m3) 2725 !! 2726 !! base scavenging rate (0.12 / y) 2727 fbase_scav = 0.12 / 365.25 2728 !! 2729 !! calculate sinking particle part of scaling factor 2730 !! this takes local fast sinking carbon (mmol C / m2 / d) and 2731 !! gets it into nmol C / cm3 / s ("rdt" below is the number of seconds in 2732 !! a model timestep) 2733 !! 2734 !! fscal_sink = ffastc(ji,jj) * 1.e2 / (86400.) 2735 !! 2736 !! ... actually, re-reading Moore et al.'s equations, it looks like he uses 2737 !! his sinking flux directly, without scaling it by time-step or anything, 2738 !! so I'll copy this here ... 2739 !! 2740 fscal_sink = ffastc(ji,jj) * 1.e2 2741 !! 2742 !! calculate particle part of scaling factor 2743 !! this totals up the carbon in suspended particles (Pn, Pd, Zmi, Zme, D), 2744 !! which comes out in mmol C / m3 (= nmol C / cm3), and then multiplies it 2745 !! by a magic factor, 0.002, to get it into nmol C / cm2 / s 2746 !! 2747 fscal_part = ((xthetapn * zphn) + (xthetapd * zphd) + (xthetazmi * zzmi) + & 2748 (xthetazme * zzme) + (xthetad * zdet)) * 0.002 2749 !! 2750 !! calculate scaling factor for base scavenging rate 2751 !! this uses the (now correctly scaled) sinking flux and standing 2752 !! particle concentration, divides through by some sort of reference 2753 !! value (= 0.0066 nmol C / cm2 / s) and then uses this, or not if its 2754 !! too high, to rescale the base scavenging rate 2755 !! 2756 fscal_scav = fbase_scav * min(((fscal_sink + fscal_part) / 0.0066), 4.0) 2757 !! 2758 !! the resulting scavenging rate is then scaled further according to the 2759 !! local iron concentration (i.e. diminished in low iron regions; enhanced 2760 !! in high iron regions; less alone in intermediate iron regions) 2761 !! 2762 if (xFeT.lt.0.4) then 2763 !! 2764 !! low iron region 2765 !! 2766 fscal_scav = fscal_scav * (xFeT / 0.4) 2767 !! 2768 elseif (xFeT.gt.0.6) then 2769 !! 2770 !! high iron region 2771 !! 2772 fscal_scav = fscal_scav + ((xFeT / 0.6) * (6.0 / 1.4)) 2773 !! 2774 else 2775 !! 2776 !! intermediate iron region: do nothing 2777 !! 2778 endif 2779 !! 2780 !! apply the calculated scavenging rate ... 2781 !! 2782 ffescav = fscal_scav * zfer 2783 !! 2784 elseif (jiron.eq.3) then 2785 !!---------------------------------------------------------------------- 2786 !! Scheme 3: Moore et al. (2008) 2787 !! This scheme includes a single scavenging term that accounts for 2788 !! sinking particles in the water column, and includes organic C, 2789 !! biogenic opal, calcium carbonate and dust in this (though the 2790 !! latter is ignored here until I work out what units the incoming 2791 !! "dust" flux is in); this term scavenges total iron rather than 2792 !! "free" iron 2793 !!---------------------------------------------------------------------- 2794 !! 2795 !! total iron concentration (mmol Fe / m3 -> umol Fe / m3) 2796 xFeT = zfer * 1.e3 2797 !! 2798 !! this has a base scavenging rate which is modified by local 2799 !! particle sinking flux (including dust - but I'm ignoring that 2800 !! here for now) and which is accelerated when Fe concentration 2801 !! is > 0.6 nM (= 0.6 umol/m3 = 0.0006 mmol/m3), and decreased as 2802 !! concentrations < 0.5 nM (= 0.5 umol/m3 = 0.0005 mmol/m3) 2803 !! 2804 !! base scavenging rate (Fe_b in paper; units may be wrong there) 2805 fbase_scav = 0.00384 ! (ng)^-1 cm 2806 !! 2807 !! calculate sinking particle part of scaling factor; this converts 2808 !! mmol / m2 / d fluxes of organic carbon, silicon and calcium 2809 !! carbonate into ng / cm2 / s fluxes; it is assumed here that the 2810 !! mass conversions simply consider the mass of the main element 2811 !! (C, Si and Ca) and *not* the mass of the molecules that they are 2812 !! part of; Moore et al. (2008) is unclear on the conversion that 2813 !! should be used 2814 !! 2815 !! milli -> nano; mol -> gram; /m2 -> /cm2; /d -> /s 2816 fscal_csink = (ffastc(ji,jj) * 1.e6 * xmassc * 1.e-4 / 86400.) ! ng C / cm2 / s 2817 fscal_sisink = (ffastsi(ji,jj) * 1.e6 * xmasssi * 1.e-4 / 86400.) ! ng Si / cm2 / s 2818 fscal_casink = (ffastca(ji,jj) * 1.e6 * xmassca * 1.e-4 / 86400.) ! ng Ca / cm2 / s 2819 !! 2820 !! sum up these sinking fluxes and convert to ng / cm by dividing 2821 !! through by a sinking rate of 100 m / d = 1.157 cm / s 2822 fscal_sink = ((fscal_csink * 6.) + fscal_sisink + fscal_casink) / & 2823 (100. * 1.e3 / 86400) ! ng / cm 2824 !! 2825 !! now calculate the scavenging rate based upon the base rate and 2826 !! this particle flux scaling; according to the published units, 2827 !! the result actually has *no* units, but as it must be expressed 2828 !! per unit time for it to make any sense, I'm assuming a missing 2829 !! "per second" 2830 fscal_scav = fbase_scav * fscal_sink ! / s 2831 !! 2832 !! the resulting scavenging rate is then scaled further according to the 2833 !! local iron concentration (i.e. diminished in low iron regions; enhanced 2834 !! in high iron regions; less alone in intermediate iron regions) 2835 !! 2836 if (xFeT.lt.0.5) then 2837 !! 2838 !! low iron region (0.5 instead of the 0.4 in Moore et al., 2004) 2839 !! 2840 fscal_scav = fscal_scav * (xFeT / 0.5) 2841 !! 2842 elseif (xFeT.gt.0.6) then 2843 !! 2844 !! high iron region (functional form different in Moore et al., 2004) 2845 !! 2846 fscal_scav = fscal_scav + ((xFeT - 0.6) * 0.00904) 2847 !! 2848 else 2849 !! 2850 !! intermediate iron region: do nothing 2851 !! 2852 endif 2853 !! 2854 !! apply the calculated scavenging rate ... 2855 !! 2856 ffescav = fscal_scav * zfer 2857 !! 2858 elseif (jiron.eq.4) then 2859 !!---------------------------------------------------------------------- 2860 !! Scheme 4: Galbraith et al. (2010) 2861 !! This scheme includes two scavenging terms, one for organic, 2862 !! particle-based scavenging, and another for inorganic scavenging; 2863 !! both terms scavenge "free" iron only 2864 !!---------------------------------------------------------------------- 2865 !! 2866 !! Galbraith et al. (2010) present a more straightforward outline of 2867 !! the scheme in Parekh et al. (2005) ... 2868 !! 2869 !! sinking particulate carbon available for scavenging 2870 !! this assumes a sinking rate of 100 m / d (Moore & Braucher, 2008), 2871 xCscav1 = (ffastc(ji,jj) * xmassc) / 100. ! = mg C / m3 2872 !! 2873 !! scale by Honeyman et al. (1981) exponent coefficient 2874 !! multiply by 1.e-3 to express C flux in g C rather than mg C 2875 xCscav2 = (xCscav1 * 1.e-3)**0.58 2876 !! 2877 !! multiply by Galbraith et al. (2010) scavenging rate 2878 xk_org = 0.5 ! ((g C m/3)^-1) / d 2879 xORGscav = xk_org * xCscav2 * xFeF 2880 !! 2881 !! Galbraith et al. (2010) also include an inorganic bit ... 2882 !! 2883 !! this occurs at a fixed rate, again based on the availability of 2884 !! "free" iron 2885 !! 2886 !! k_inorg = 1000 d**-1 nmol Fe**-0.5 kg**-0.5 2887 !! 2888 !! to implement this here, scale xFeF by 1026 to put in units of 2889 !! umol/m3 which approximately equal nmol/kg 2890 !! 2891 xk_inorg = 1000. ! ((nmol Fe / kg)^1.5) 2892 xINORGscav = (xk_inorg * (xFeF * 1026.)**1.5) * 1.e-3 2893 !! 2894 !! sum these two terms together 2895 ffescav = xORGscav + xINORGscav 2896 else 2897 !!---------------------------------------------------------------------- 2898 !! No Scheme: you coward! 2899 !! This scheme puts its head in the sand and eskews any decision about 2900 !! how iron is removed from the ocean; prepare to get deluged in iron 2901 !! you fool! 2902 !!---------------------------------------------------------------------- 2903 ffescav = 0. 2904 endif 2905 2906 !!---------------------------------------------------------------------- 2907 !! Other iron cycle processes 2908 !!---------------------------------------------------------------------- 2909 !! 2910 !! aeolian iron deposition 2911 if (jk.eq.1) then 2912 !! zirondep is in mmol-Fe / m2 / day 2913 !! ffetop is in mmol-dissolved-Fe / m3 / day 2914 ffetop = zirondep(ji,jj) * xfe_sol / fthk 2915 else 2916 ffetop = 0.0 2917 endif 2918 !! 2919 !! seafloor iron addition 2920 !! AXY (10/07/12): amended to only apply sedimentary flux up to ~500 m down 2921 !! if (jk.eq.(mbathy(ji,jj)-1).AND.jk.lt.i1100) then 2922 if ((jk.eq.jmbathy).AND.jk.le.i0500) then 2923 !! Moore et al. (2004) cite a coastal California value of 5 umol/m2/d, but adopt a 2924 !! global value of 2 umol/m2/d for all areas < 1100 m; here we use this latter value 2925 !! but apply it everywhere 2926 !! AXY (21/07/09): actually, let's just apply it below 1100 m (levels 1-37) 2927 ffebot = (xfe_sed / fthk) 2928 else 2929 ffebot = 0.0 2930 endif 2931 2932 !! AXY (16/12/09): remove iron addition/removal processes 2933 !! For the purposes of the quarter degree run, the iron cycle is being pegged to the 2934 !! initial condition supplied by Mick Follows via restoration with a 30 day period; 2935 !! iron addition at the seafloor is still permitted with the idea that this extra 2936 !! iron will be removed by the restoration away from the source 2937 !! ffescav = 0.0 2938 !! ffetop = 0.0 2939 !! ffebot = 0.0 2940 2941 # if defined key_debug_medusa 2942 !! report miscellaneous calculations 2943 if (idf.eq.1.AND.idfval.eq.1) then 2944 IF (lwp) write (numout,*) '------------------------------' 2945 IF (lwp) write (numout,*) 'xfe_sol = ', xfe_sol 2946 IF (lwp) write (numout,*) 'xfe_mass = ', xfe_mass 2947 IF (lwp) write (numout,*) 'ffetop(',jk,') = ', ffetop 2948 IF (lwp) write (numout,*) 'ffebot(',jk,') = ', ffebot 2949 IF (lwp) write (numout,*) 'xFree(',jk,') = ', xFree(ji,jj) 2950 IF (lwp) write (numout,*) 'ffescav(',jk,') = ', ffescav 2951 endif 2952 # endif 2953 2954 !!---------------------------------------------------------------------- 2955 !! Miscellaneous 2956 !!---------------------------------------------------------------------- 2957 !! 2958 !! diatom frustule dissolution 2959 fsdiss = xsdiss * zpds 2960 2961 # if defined key_debug_medusa 2962 !! report miscellaneous calculations 2963 if (idf.eq.1.AND.idfval.eq.1) then 2964 IF (lwp) write (numout,*) '------------------------------' 2965 IF (lwp) write (numout,*) 'fsdiss(',jk,') = ', fsdiss 2966 endif 2967 # endif 2968 2969 !!---------------------------------------------------------------------- 2970 !! Slow detritus creation 2971 !!---------------------------------------------------------------------- 2972 !! this variable integrates the creation of slow sinking detritus 2973 !! to allow the split between fast and slow detritus to be 2974 !! diagnosed 2975 fslown = fdpn + fdzmi + ((1.0 - xfdfrac1) * fdpd) + & 2976 ((1.0 - xfdfrac2) * fdzme) + ((1.0 - xbetan) * (finmi + finme)) 2977 !! 2978 !! this variable records the slow detrital sinking flux at this 2979 !! particular depth; it is used in the output of this flux at 2980 !! standard depths in the diagnostic outputs; needs to be 2981 !! adjusted from per second to per day because of parameter vsed 2982 fslownflux(ji,jj) = zdet * vsed * 86400. 2983 # if defined key_roam 2984 !! 2985 !! and the same for detrital carbon 2986 fslowc = (xthetapn * fdpn) + (xthetazmi * fdzmi) + & 2987 (xthetapd * (1.0 - xfdfrac1) * fdpd) + & 2988 (xthetazme * (1.0 - xfdfrac2) * fdzme) + & 2989 ((1.0 - xbetac) * (ficmi + ficme)) 2990 !! 2991 !! this variable records the slow detrital sinking flux at this 2992 !! particular depth; it is used in the output of this flux at 2993 !! standard depths in the diagnostic outputs; needs to be 2994 !! adjusted from per second to per day because of parameter vsed 2995 fslowcflux(ji,jj) = zdtc * vsed * 86400. 2996 # endif 2997 2998 !!---------------------------------------------------------------------- 2999 !! Nutrient regeneration 3000 !! this variable integrates total nitrogen regeneration down the 3001 !! watercolumn; its value is stored and output as a 2D diagnostic; 3002 !! the corresponding dissolution flux of silicon (from sources 3003 !! other than fast detritus) is also integrated; note that, 3004 !! confusingly, the linear loss terms from plankton compartments 3005 !! are labelled as fdX2 when one might have expected fdX or fdX1 3006 !!---------------------------------------------------------------------- 3007 !! 3008 !! nitrogen 3009 fregen = (( (xphi * (fgmipn + fgmid)) + & ! messy feeding 3010 (xphi * (fgmepn + fgmepd + fgmezmi + fgmed)) + & ! messy feeding 3011 fmiexcr + fmeexcr + fdd + & ! excretion + D remin. 3012 fdpn2 + fdpd2 + fdzmi2 + fdzme2) * fthk) ! linear mortality 3013 !! 3014 !! silicon 3015 fregensi = (( fsdiss + ((1.0 - xfdfrac1) * fdpds) + & ! dissolution + non-lin. mortality 3016 ((1.0 - xfdfrac3) * fgmepds) + & ! egestion by zooplankton 3017 fdpds2) * fthk) ! linear mortality 3018 # if defined key_roam 3019 !! 3020 !! carbon 3021 fregenc = (( (xphi * ((xthetapn * fgmipn) + fgmidc)) + & ! messy feeding 3022 (xphi * ((xthetapn * fgmepn) + (xthetapd * fgmepd) + & ! messy feeding 3023 (xthetazmi * fgmezmi) + fgmedc)) + & ! messy feeding 3024 fmiresp + fmeresp + fddc + & ! respiration + D remin. 3025 (xthetapn * fdpn2) + (xthetapd * fdpd2) + & ! linear mortality 3026 (xthetazmi * fdzmi2) + (xthetazme * fdzme2)) * fthk) ! linear mortality 3027 # endif 3028 3029 !!---------------------------------------------------------------------- 3030 !! Fast-sinking detritus terms 3031 !! "local" variables declared so that conservation can be checked; 3032 !! the calculated terms are added to the fast-sinking flux later on 3033 !! only after the flux entering this level has experienced some 3034 !! remineralisation 3035 !! note: these fluxes need to be scaled by the level thickness 3036 !!---------------------------------------------------------------------- 3037 !! 3038 !! nitrogen: diatom and mesozooplankton mortality 3039 ftempn = b0 * ((xfdfrac1 * fdpd) + (xfdfrac2 * fdzme)) 3040 !! 3041 !! silicon: diatom mortality and grazed diatoms 3042 ftempsi = b0 * ((xfdfrac1 * fdpds) + (xfdfrac3 * fgmepds)) 3043 !! 3044 !! iron: diatom and mesozooplankton mortality 3045 ftempfe = b0 * (((xfdfrac1 * fdpd) + (xfdfrac2 * fdzme)) * xrfn) 3046 !! 3047 !! carbon: diatom and mesozooplankton mortality 3048 ftempc = b0 * ((xfdfrac1 * xthetapd * fdpd) + & 3049 (xfdfrac2 * xthetazme * fdzme)) 3050 !! 3051 # if defined key_roam 3052 if (jrratio.eq.0) then 3053 !! CaCO3: latitudinally-based fraction of total primary production 3054 !! absolute latitude of current grid cell 3055 flat = abs(gphit(ji,jj)) 3056 !! 0.10 at equator; 0.02 at pole 3057 fcaco3 = xcaco3a + ((xcaco3b - xcaco3a) * ((90.0 - flat) / 90.0)) 3058 elseif (jrratio.eq.1) then 3059 !! CaCO3: Ridgwell et al. (2007) submodel, version 1 3060 !! this uses SURFACE omega calcite to regulate rain ratio 3061 if (f_omcal(ji,jj).ge.1.0) then 3062 fq1 = (f_omcal(ji,jj) - 1.0)**0.81 3063 else 3064 fq1 = 0. 3065 endif 3066 fcaco3 = xridg_r0 * fq1 3067 elseif (jrratio.eq.2) then 3068 !! CaCO3: Ridgwell et al. (2007) submodel, version 2 3069 !! this uses FULL 3D omega calcite to regulate rain ratio 3070 if (f3_omcal(ji,jj,jk).ge.1.0) then 3071 fq1 = (f3_omcal(ji,jj,jk) - 1.0)**0.81 3072 else 3073 fq1 = 0. 3074 endif 3075 fcaco3 = xridg_r0 * fq1 3076 endif 3077 # else 3078 !! CaCO3: latitudinally-based fraction of total primary production 3079 !! absolute latitude of current grid cell 3080 flat = abs(gphit(ji,jj)) 3081 !! 0.10 at equator; 0.02 at pole 3082 fcaco3 = xcaco3a + ((xcaco3b - xcaco3a) * ((90.0 - flat) / 90.0)) 3083 # endif 3084 !! AXY (09/03/09): convert CaCO3 production from function of 3085 !! primary production into a function of fast-sinking material; 3086 !! technically, this is what Dunne et al. (2007) do anyway; they 3087 !! convert total primary production estimated from surface 3088 !! chlorophyll to an export flux for which they apply conversion 3089 !! factors to estimate the various elemental fractions (Si, Ca) 3090 ftempca = ftempc * fcaco3 3091 3092 # if defined key_debug_medusa 3093 !! integrate total fast detritus production 3094 if (idf.eq.1) then 3095 fifd_n(ji,jj) = fifd_n(ji,jj) + (ftempn * fthk) 3096 fifd_si(ji,jj) = fifd_si(ji,jj) + (ftempsi * fthk) 3097 fifd_fe(ji,jj) = fifd_fe(ji,jj) + (ftempfe * fthk) 3098 # if defined key_roam 3099 fifd_c(ji,jj) = fifd_c(ji,jj) + (ftempc * fthk) 3100 # endif 3101 endif 3102 3103 !! report quantities of fast-sinking detritus for each component 3104 if (idf.eq.1.AND.idfval.eq.1) then 3105 IF (lwp) write (numout,*) '------------------------------' 3106 IF (lwp) write (numout,*) 'fdpd(',jk,') = ', fdpd 3107 IF (lwp) write (numout,*) 'fdzme(',jk,') = ', fdzme 3108 IF (lwp) write (numout,*) 'ftempn(',jk,') = ', ftempn 3109 IF (lwp) write (numout,*) 'ftempsi(',jk,') = ', ftempsi 3110 IF (lwp) write (numout,*) 'ftempfe(',jk,') = ', ftempfe 3111 IF (lwp) write (numout,*) 'ftempc(',jk,') = ', ftempc 3112 IF (lwp) write (numout,*) 'ftempca(',jk,') = ', ftempca 3113 IF (lwp) write (numout,*) 'flat(',jk,') = ', flat 3114 IF (lwp) write (numout,*) 'fcaco3(',jk,') = ', fcaco3 3115 endif 3116 # endif 3117 3118 !!---------------------------------------------------------------------- 3119 !! This version of MEDUSA offers a choice of three methods for 3120 !! handling the remineralisation of fast detritus. All three 3121 !! do so in broadly the same way: 3122 !! 3123 !! 1. Fast detritus is stored as a 2D array [ ffastX ] 3124 !! 2. Fast detritus is added level-by-level [ ftempX ] 3125 !! 3. Fast detritus is not remineralised in the top box [ freminX ] 3126 !! 4. Remaining fast detritus is remineralised in the bottom [ fsedX ] 3127 !! box 3128 !! 3129 !! The three remineralisation methods are: 3130 !! 3131 !! 1. Ballast model (i.e. that published in Yool et al., 2011) 3132 !! (1b. Ballast-sans-ballast model) 3133 !! 2. Martin et al. (1987) 3134 !! 3. Henson et al. (2011) 3135 !! 3136 !! The first of these couples C, N and Fe remineralisation to 3137 !! the remineralisation of particulate Si and CaCO3, but the 3138 !! latter two treat remineralisation of C, N, Fe, Si and CaCO3 3139 !! completely separately. At present a switch within the code 3140 !! regulates which submodel is used, but this should be moved 3141 !! to the namelist file. 3142 !! 3143 !! The ballast-sans-ballast submodel is an original development 3144 !! feature of MEDUSA in which the ballast submodel's general 3145 !! framework and parameterisation is used, but in which there 3146 !! is no protection of organic material afforded by ballasting 3147 !! minerals. While similar, it is not the same as the Martin 3148 !! et al. (1987) submodel. 3149 !! 3150 !! Since the three submodels behave the same in terms of 3151 !! accumulating sinking material and remineralising it all at 3152 !! the seafloor, these portions of the code below are common to 3153 !! all three. 3154 !!---------------------------------------------------------------------- 3155 3156 if (jexport.eq.1) then 3157 !!====================================================================== 3158 !! BALLAST SUBMODEL 3159 !!====================================================================== 3160 !! 3161 !!---------------------------------------------------------------------- 3162 !! Fast-sinking detritus fluxes, pt. 1: REMINERALISATION 3163 !! aside from explicitly modelled, slow-sinking detritus, the 3164 !! model includes an implicit representation of detrital 3165 !! particles that sink too quickly to be modelled with 3166 !! explicit state variables; this sinking flux is instead 3167 !! instantaneously remineralised down the water column using 3168 !! the version of Armstrong et al. (2002)'s ballast model 3169 !! used by Dunne et al. (2007); the version of this model 3170 !! here considers silicon and calcium carbonate ballast 3171 !! minerals; this section of the code redistributes the fast 3172 !! sinking material generated locally down the water column; 3173 !! this differs from Dunne et al. (2007) in that fast sinking 3174 !! material is distributed at *every* level below that it is 3175 !! generated, rather than at every level below some fixed 3176 !! depth; this scheme is also different in that sinking material 3177 !! generated in one level is aggregated with that generated by 3178 !! shallower levels; this should make the ballast model more 3179 !! self-consistent (famous last words) 3180 !!---------------------------------------------------------------------- 3181 !! 3182 if (jk.eq.1) then 3183 !! this is the SURFACE OCEAN BOX (no remineralisation) 3184 !! 3185 freminc = 0.0 3186 freminn = 0.0 3187 freminfe = 0.0 3188 freminsi = 0.0 3189 freminca = 0.0 3190 elseif (jk.le.jmbathy) then 3191 !! this is an OCEAN BOX (remineralise some material) 3192 !! 3193 !! set up CCD depth to be used depending on user choice 3194 if (jocalccd.eq.0) then 3195 !! use default CCD field 3196 fccd_dep = ocal_ccd(ji,jj) 3197 elseif (jocalccd.eq.1) then 3198 !! use calculated CCD field 3199 fccd_dep = f2_ccd_cal(ji,jj) 3200 endif 3201 !! 3202 !! === organic carbon === 3203 fq0 = ffastc(ji,jj) !! how much organic C enters this box (mol) 3204 if (iball.eq.1) then 3205 fq1 = (fq0 * xmassc) !! how much it weighs (mass) 3206 fq2 = (ffastca(ji,jj) * xmassca) !! how much CaCO3 enters this box (mass) 3207 fq3 = (ffastsi(ji,jj) * xmasssi) !! how much opal enters this box (mass) 3208 fq4 = (fq2 * xprotca) + (fq3 * xprotsi) !! total protected organic C (mass) 3209 !! this next term is calculated for C but used for N and Fe as well 3210 !! it needs to be protected in case ALL C is protected 3211 if (fq4.lt.fq1) then 3212 fprotf = (fq4 / (fq1 + tiny(fq1))) !! protected fraction of total organic C (non-dim) 3213 else 3214 fprotf = 1.0 !! all organic C is protected (non-dim) 3215 endif 3216 fq5 = (1.0 - fprotf) !! unprotected fraction of total organic C (non-dim) 3217 fq6 = (fq0 * fq5) !! how much organic C is unprotected (mol) 3218 fq7 = (fq6 * exp(-(fthk / xfastc))) !! how much unprotected C leaves this box (mol) 3219 fq8 = (fq7 + (fq0 * fprotf)) !! how much total C leaves this box (mol) 3220 freminc = (fq0 - fq8) / fthk !! C remineralisation in this box (mol) 3221 ffastc(ji,jj) = fq8 3222 # if defined key_debug_medusa 3223 !! report in/out/remin fluxes of carbon for this level 3224 if (idf.eq.1.AND.idfval.eq.1) then 3225 IF (lwp) write (numout,*) '------------------------------' 3226 IF (lwp) write (numout,*) 'totalC(',jk,') = ', fq1 3227 IF (lwp) write (numout,*) 'prtctC(',jk,') = ', fq4 3228 IF (lwp) write (numout,*) 'fprotf(',jk,') = ', fprotf 3229 IF (lwp) write (numout,*) '------------------------------' 3230 IF (lwp) write (numout,*) 'IN C(',jk,') = ', fq0 3231 IF (lwp) write (numout,*) 'LOST C(',jk,') = ', freminc * fthk 3232 IF (lwp) write (numout,*) 'OUT C(',jk,') = ', fq8 3233 IF (lwp) write (numout,*) 'NEW C(',jk,') = ', ftempc * fthk 3234 endif 3235 # endif 3236 else 3237 fq1 = fq0 * exp(-(fthk / xfastc)) !! how much organic C leaves this box (mol) 3238 freminc = (fq0 - fq1) / fthk !! C remineralisation in this box (mol) 3239 ffastc(ji,jj) = fq1 3240 endif 3241 !! 3242 !! === organic nitrogen === 3243 fq0 = ffastn(ji,jj) !! how much organic N enters this box (mol) 3244 if (iball.eq.1) then 3245 fq5 = (1.0 - fprotf) !! unprotected fraction of total organic N (non-dim) 3246 fq6 = (fq0 * fq5) !! how much organic N is unprotected (mol) 3247 fq7 = (fq6 * exp(-(fthk / xfastc))) !! how much unprotected N leaves this box (mol) 3248 fq8 = (fq7 + (fq0 * fprotf)) !! how much total N leaves this box (mol) 3249 freminn = (fq0 - fq8) / fthk !! N remineralisation in this box (mol) 3250 ffastn(ji,jj) = fq8 3251 # if defined key_debug_medusa 3252 !! report in/out/remin fluxes of carbon for this level 3253 if (idf.eq.1.AND.idfval.eq.1) then 3254 IF (lwp) write (numout,*) '------------------------------' 3255 IF (lwp) write (numout,*) 'totalN(',jk,') = ', fq1 3256 IF (lwp) write (numout,*) 'prtctN(',jk,') = ', fq4 3257 IF (lwp) write (numout,*) 'fprotf(',jk,') = ', fprotf 3258 IF (lwp) write (numout,*) '------------------------------' 3259 if (freminn < 0.0) then 3260 IF (lwp) write (numout,*) '** FREMIN ERROR **' 3261 endif 3262 IF (lwp) write (numout,*) 'IN N(',jk,') = ', fq0 3263 IF (lwp) write (numout,*) 'LOST N(',jk,') = ', freminn * fthk 3264 IF (lwp) write (numout,*) 'OUT N(',jk,') = ', fq8 3265 IF (lwp) write (numout,*) 'NEW N(',jk,') = ', ftempn * fthk 3266 endif 3267 # endif 3268 else 3269 fq1 = fq0 * exp(-(fthk / xfastc)) !! how much organic N leaves this box (mol) 3270 freminn = (fq0 - fq1) / fthk !! N remineralisation in this box (mol) 3271 ffastn(ji,jj) = fq1 3272 endif 3273 !! 3274 !! === organic iron === 3275 fq0 = ffastfe(ji,jj) !! how much organic Fe enters this box (mol) 3276 if (iball.eq.1) then 3277 fq5 = (1.0 - fprotf) !! unprotected fraction of total organic Fe (non-dim) 3278 fq6 = (fq0 * fq5) !! how much organic Fe is unprotected (mol) 3279 fq7 = (fq6 * exp(-(fthk / xfastc))) !! how much unprotected Fe leaves this box (mol) 3280 fq8 = (fq7 + (fq0 * fprotf)) !! how much total Fe leaves this box (mol) 3281 freminfe = (fq0 - fq8) / fthk !! Fe remineralisation in this box (mol) 3282 ffastfe(ji,jj) = fq8 3283 else 3284 fq1 = fq0 * exp(-(fthk / xfastc)) !! how much total Fe leaves this box (mol) 3285 freminfe = (fq0 - fq1) / fthk !! Fe remineralisation in this box (mol) 3286 ffastfe(ji,jj) = fq1 3287 endif 3288 !! 3289 !! === biogenic silicon === 3290 fq0 = ffastsi(ji,jj) !! how much opal centers this box (mol) 3291 fq1 = fq0 * exp(-(fthk / xfastsi)) !! how much opal leaves this box (mol) 3292 freminsi = (fq0 - fq1) / fthk !! Si remineralisation in this box (mol) 3293 ffastsi(ji,jj) = fq1 3294 !! 3295 !! === biogenic calcium carbonate === 3296 fq0 = ffastca(ji,jj) !! how much CaCO3 enters this box (mol) 3297 if (fdep.le.fccd_dep) then 3298 !! whole grid cell above CCD 3299 fq1 = fq0 !! above lysocline, no Ca dissolves (mol) 3300 freminca = 0.0 !! above lysocline, no Ca dissolves (mol) 3301 fccd(ji,jj) = real(jk) !! which is the last level above the CCD? (#) 3302 elseif (fdep.ge.fccd_dep) then 3303 !! whole grid cell below CCD 3304 fq1 = fq0 * exp(-(fthk / xfastca)) !! how much CaCO3 leaves this box (mol) 3305 freminca = (fq0 - fq1) / fthk !! Ca remineralisation in this box (mol) 3306 else 3307 !! partial grid cell below CCD 3308 fq2 = fdep1 - fccd_dep !! amount of grid cell below CCD (m) 3309 fq1 = fq0 * exp(-(fq2 / xfastca)) !! how much CaCO3 leaves this box (mol) 3310 freminca = (fq0 - fq1) / fthk !! Ca remineralisation in this box (mol) 3311 endif 3312 ffastca(ji,jj) = fq1 3313 else 3314 !! this is BELOW THE LAST OCEAN BOX (do nothing) 3315 freminc = 0.0 3316 freminn = 0.0 3317 freminfe = 0.0 3318 freminsi = 0.0 3319 freminca = 0.0 3320 endif 3321 3322 elseif (jexport.eq.2.or.jexport.eq.3) then 3323 if (jexport.eq.2) then 3324 !!====================================================================== 3325 !! MARTIN ET AL. (1987) SUBMODEL 3326 !!====================================================================== 3327 !! 3328 !!---------------------------------------------------------------------- 3329 !! This submodel uses the classic Martin et al. (1987) curve 3330 !! to determine the attenuation of fast-sinking detritus down 3331 !! the water column. All three organic elements, C, N and Fe, 3332 !! are handled identically, and their quantities in sinking 3333 !! particles attenuate according to a power relationship 3334 !! governed by parameter "b". This is assigned a canonical 3335 !! value of -0.858. Biogenic opal and calcium carbonate are 3336 !! attentuated using the same function as in the ballast 3337 !! submodel 3338 !!---------------------------------------------------------------------- 3339 !! 3340 fb_val = -0.858 3341 elseif (jexport.eq.3) then 3342 !!====================================================================== 3343 !! HENSON ET AL. (2011) SUBMODEL 3344 !!====================================================================== 3345 !! 3346 !!---------------------------------------------------------------------- 3347 !! This submodel reconfigures the Martin et al. (1987) curve by 3348 !! allowing the "b" value to vary geographically. Its value is 3349 !! set, following Henson et al. (2011), as a function of local 3350 !! sea surface temperature: 3351 !! b = -1.06 + (0.024 * SST) 3352 !! This means that remineralisation length scales are longer in 3353 !! warm, tropical areas and shorter in cold, polar areas. This 3354 !! does seem back-to-front (i.e. one would expect GREATER 3355 !! remineralisation in warmer waters), but is an outcome of 3356 !! analysis of sediment trap data, and it may reflect details 3357 !! of ecosystem structure that pertain to particle production 3358 !! rather than simply Q10. 3359 !!---------------------------------------------------------------------- 3360 !! 3361 fl_sst = tsn(ji,jj,1,jp_tem) 3362 fb_val = -1.06 + (0.024 * fl_sst) 3363 endif 3364 !! 3365 if (jk.eq.1) then 3366 !! this is the SURFACE OCEAN BOX (no remineralisation) 3367 !! 3368 freminc = 0.0 3369 freminn = 0.0 3370 freminfe = 0.0 3371 freminsi = 0.0 3372 freminca = 0.0 3373 elseif (jk.le.jmbathy) then 3374 !! this is an OCEAN BOX (remineralise some material) 3375 !! 3376 !! === organic carbon === 3377 fq0 = ffastc(ji,jj) !! how much organic C enters this box (mol) 3378 fq1 = fq0 * ((fdep1/fdep)**fb_val) !! how much organic C leaves this box (mol) 3379 freminc = (fq0 - fq1) / fthk !! C remineralisation in this box (mol) 3380 ffastc(ji,jj) = fq1 3381 !! 3382 !! === organic nitrogen === 3383 fq0 = ffastn(ji,jj) !! how much organic N enters this box (mol) 3384 fq1 = fq0 * ((fdep1/fdep)**fb_val) !! how much organic N leaves this box (mol) 3385 freminn = (fq0 - fq1) / fthk !! N remineralisation in this box (mol) 3386 ffastn(ji,jj) = fq1 3387 !! 3388 !! === organic iron === 3389 fq0 = ffastfe(ji,jj) !! how much organic Fe enters this box (mol) 3390 fq1 = fq0 * ((fdep1/fdep)**fb_val) !! how much organic Fe leaves this box (mol) 3391 freminfe = (fq0 - fq1) / fthk !! Fe remineralisation in this box (mol) 3392 ffastfe(ji,jj) = fq1 3393 !! 3394 !! === biogenic silicon === 3395 fq0 = ffastsi(ji,jj) !! how much opal centers this box (mol) 3396 fq1 = fq0 * exp(-(fthk / xfastsi)) !! how much opal leaves this box (mol) 3397 freminsi = (fq0 - fq1) / fthk !! Si remineralisation in this box (mol) 3398 ffastsi(ji,jj) = fq1 3399 !! 3400 !! === biogenic calcium carbonate === 3401 fq0 = ffastca(ji,jj) !! how much CaCO3 enters this box (mol) 3402 if (fdep.le.ocal_ccd(ji,jj)) then 3403 !! whole grid cell above CCD 3404 fq1 = fq0 !! above lysocline, no Ca dissolves (mol) 3405 freminca = 0.0 !! above lysocline, no Ca dissolves (mol) 3406 fccd(ji,jj) = real(jk) !! which is the last level above the CCD? (#) 3407 elseif (fdep.ge.ocal_ccd(ji,jj)) then 3408 !! whole grid cell below CCD 3409 fq1 = fq0 * exp(-(fthk / xfastca)) !! how much CaCO3 leaves this box (mol) 3410 freminca = (fq0 - fq1) / fthk !! Ca remineralisation in this box (mol) 3411 else 3412 !! partial grid cell below CCD 3413 fq2 = fdep1 - ocal_ccd(ji,jj) !! amount of grid cell below CCD (m) 3414 fq1 = fq0 * exp(-(fq2 / xfastca)) !! how much CaCO3 leaves this box (mol) 3415 freminca = (fq0 - fq1) / fthk !! Ca remineralisation in this box (mol) 3416 endif 3417 ffastca(ji,jj) = fq1 3418 else 3419 !! this is BELOW THE LAST OCEAN BOX (do nothing) 3420 freminc = 0.0 3421 freminn = 0.0 3422 freminfe = 0.0 3423 freminsi = 0.0 3424 freminca = 0.0 3425 endif 3426 3427 endif 3428 3429 !!---------------------------------------------------------------------- 3430 !! Fast-sinking detritus fluxes, pt. 2: UPDATE FAST FLUXES 3431 !! here locally calculated additions to the fast-sinking flux are added 3432 !! to the total fast-sinking flux; this is done here such that material 3433 !! produced in a particular layer is only remineralised below this 3434 !! layer 3435 !!---------------------------------------------------------------------- 3436 !! 3437 !! add sinking material generated in this layer to running totals 3438 !! 3439 !! === organic carbon === (diatom and mesozooplankton mortality) 3440 ffastc(ji,jj) = ffastc(ji,jj) + (ftempc * fthk) 3441 !! 3442 !! === organic nitrogen === (diatom and mesozooplankton mortality) 3443 ffastn(ji,jj) = ffastn(ji,jj) + (ftempn * fthk) 3444 !! 3445 !! === organic iron === (diatom and mesozooplankton mortality) 3446 ffastfe(ji,jj) = ffastfe(ji,jj) + (ftempfe * fthk) 3447 !! 3448 !! === biogenic silicon === (diatom mortality and grazed diatoms) 3449 ffastsi(ji,jj) = ffastsi(ji,jj) + (ftempsi * fthk) 3450 !! 3451 !! === biogenic calcium carbonate === (latitudinally-based fraction of total primary production) 3452 ffastca(ji,jj) = ffastca(ji,jj) + (ftempca * fthk) 3453 3454 !!---------------------------------------------------------------------- 3455 !! Fast-sinking detritus fluxes, pt. 3: SEAFLOOR 3456 !! remineralise all remaining fast-sinking detritus to dissolved 3457 !! nutrients; the sedimentation fluxes calculated here allow the 3458 !! separation of what's remineralised sinking through the final 3459 !! ocean box from that which is added to the final box by the 3460 !! remineralisation of material that reaches the seafloor (i.e. 3461 !! the model assumes that *all* material that hits the seafloor 3462 !! is remineralised and that none is permanently buried; hey, 3463 !! this is a giant GCM model that can't be run for long enough 3464 !! to deal with burial fluxes!) 3465 !! 3466 !! in a change to this process, in part so that MEDUSA behaves 3467 !! a little more like ERSEM et al., fast-sinking detritus (N, Fe 3468 !! and C) is converted to slow sinking detritus at the seafloor 3469 !! instead of being remineralised; the rationale is that in 3470 !! shallower shelf regions (... that are not fully mixed!) this 3471 !! allows the detrital material to return slowly to dissolved 3472 !! nutrient rather than instantaneously as now; the alternative 3473 !! would be to explicitly handle seafloor organic material - a 3474 !! headache I don't wish to experience at this point; note that 3475 !! fast-sinking Si and Ca detritus is just remineralised as 3476 !! per usual 3477 !! 3478 !! AXY (13/01/12) 3479 !! in a further change to this process, again so that MEDUSA is 3480 !! a little more like ERSEM et al., material that reaches the 3481 !! seafloor can now be added to sediment pools and stored for 3482 !! slow release; there are new 2D arrays for organic nitrogen, 3483 !! iron and carbon and inorganic silicon and carbon that allow 3484 !! fast and slow detritus that reaches the seafloor to be held 3485 !! and released back to the water column more slowly; these arrays 3486 !! are transferred via the tracer restart files between repeat 3487 !! submissions of the model 3488 !!---------------------------------------------------------------------- 3489 !! 3490 ffast2slowc = 0.0 3491 ffast2slown = 0.0 3492 ffast2slowfe = 0.0 3493 !! 3494 if (jk.eq.jmbathy) then 3495 !! this is the BOTTOM OCEAN BOX (remineralise everything) 3496 !! 3497 !! AXY (17/01/12): tweaked to include benthos pools 3498 !! 3499 !! === organic carbon === 3500 if (jfdfate.eq.0 .and. jorgben.eq.0) then 3501 freminc = freminc + (ffastc(ji,jj) / fthk) !! C remineralisation in this box (mol/m3) 3502 elseif (jfdfate.eq.1 .and. jorgben.eq.0) then 3503 ffast2slowc = ffastc(ji,jj) / fthk !! fast C -> slow C (mol/m3) 3504 fslowc = fslowc + ffast2slowc 3505 elseif (jfdfate.eq.0 .and. jorgben.eq.1) then 3506 f_fbenin_c(ji,jj) = ffastc(ji,jj) !! fast C -> benthic C (mol/m2) 3507 endif 3508 fsedc(ji,jj) = ffastc(ji,jj) !! record seafloor C (mol/m2) 3509 ffastc(ji,jj) = 0.0 3510 !! 3511 !! === organic nitrogen === 3512 if (jfdfate.eq.0 .and. jorgben.eq.0) then 3513 freminn = freminn + (ffastn(ji,jj) / fthk) !! N remineralisation in this box (mol/m3) 3514 elseif (jfdfate.eq.1 .and. jorgben.eq.0) then 3515 ffast2slown = ffastn(ji,jj) / fthk !! fast N -> slow N (mol/m3) 3516 fslown = fslown + ffast2slown 3517 elseif (jfdfate.eq.0 .and. jorgben.eq.1) then 3518 f_fbenin_n(ji,jj) = ffastn(ji,jj) !! fast N -> benthic N (mol/m2) 3519 endif 3520 fsedn(ji,jj) = ffastn(ji,jj) !! record seafloor N (mol/m2) 3521 ffastn(ji,jj) = 0.0 3522 !! 3523 !! === organic iron === 3524 if (jfdfate.eq.0 .and. jorgben.eq.0) then 3525 freminfe = freminfe + (ffastfe(ji,jj) / fthk) !! Fe remineralisation in this box (mol/m3) 3526 elseif (jfdfate.eq.1 .and. jorgben.eq.0) then 3527 ffast2slowfe = ffastn(ji,jj) / fthk !! fast Fe -> slow Fe (mol/m3) 3528 elseif (jfdfate.eq.0 .and. jorgben.eq.1) then 3529 f_fbenin_fe(ji,jj) = ffastfe(ji,jj) !! fast Fe -> benthic Fe (mol/m2) 3530 endif 3531 fsedfe(ji,jj) = ffastfe(ji,jj) !! record seafloor Fe (mol/m2) 3532 ffastfe(ji,jj) = 0.0 3533 !! 3534 !! === biogenic silicon === 3535 if (jinorgben.eq.0) then 3536 freminsi = freminsi + (ffastsi(ji,jj) / fthk) !! Si remineralisation in this box (mol/m3) 3537 elseif (jinorgben.eq.1) then 3538 f_fbenin_si(ji,jj) = ffastsi(ji,jj) !! fast Si -> benthic Si (mol/m2) 3539 endif 3540 fsedsi(ji,jj) = ffastsi(ji,jj) !! record seafloor Si (mol/m2) 3541 ffastsi(ji,jj) = 0.0 3542 !! 3543 !! === biogenic calcium carbonate === 3544 if (jinorgben.eq.0) then 3545 freminca = freminca + (ffastca(ji,jj) / fthk) !! Ca remineralisation in this box (mol/m3) 3546 elseif (jinorgben.eq.1) then 3547 f_fbenin_ca(ji,jj) = ffastca(ji,jj) !! fast Ca -> benthic Ca (mol/m2) 3548 endif 3549 fsedca(ji,jj) = ffastca(ji,jj) !! record seafloor Ca (mol/m2) 3550 ffastca(ji,jj) = 0.0 3551 endif 3552 3553 # if defined key_debug_medusa 3554 if (idf.eq.1) then 3555 !!---------------------------------------------------------------------- 3556 !! Integrate total fast detritus remineralisation 3557 !!---------------------------------------------------------------------- 3558 !! 3559 fofd_n(ji,jj) = fofd_n(ji,jj) + (freminn * fthk) 3560 fofd_si(ji,jj) = fofd_si(ji,jj) + (freminsi * fthk) 3561 fofd_fe(ji,jj) = fofd_fe(ji,jj) + (freminfe * fthk) 3562 # if defined key_roam 3563 fofd_c(ji,jj) = fofd_c(ji,jj) + (freminc * fthk) 3564 # endif 3565 endif 3566 # endif 3567 3568 !!---------------------------------------------------------------------- 3569 !! Sort out remineralisation tally of fast-sinking detritus 3570 !!---------------------------------------------------------------------- 3571 !! 3572 !! update fast-sinking regeneration arrays 3573 fregenfast(ji,jj) = fregenfast(ji,jj) + (freminn * fthk) 3574 fregenfastsi(ji,jj) = fregenfastsi(ji,jj) + (freminsi * fthk) 3575 # if defined key_roam 3576 fregenfastc(ji,jj) = fregenfastc(ji,jj) + (freminc * fthk) 3577 # endif 3578 3579 !!---------------------------------------------------------------------- 3580 !! Benthic remineralisation fluxes 3581 !!---------------------------------------------------------------------- 3582 !! 3583 if (jk.eq.jmbathy) then 3584 !! 3585 !! organic components 3586 if (jorgben.eq.1) then 3587 f_benout_n(ji,jj) = xsedn * zn_sed_n(ji,jj) 3588 f_benout_fe(ji,jj) = xsedfe * zn_sed_fe(ji,jj) 3589 f_benout_c(ji,jj) = xsedc * zn_sed_c(ji,jj) 3590 endif 3591 !! 3592 !! inorganic components 3593 if (jinorgben.eq.1) then 3594 f_benout_si(ji,jj) = xsedsi * zn_sed_si(ji,jj) 3595 f_benout_ca(ji,jj) = xsedca * zn_sed_ca(ji,jj) 3596 !! 3597 !! account for CaCO3 that dissolves when it shouldn't 3598 if ( fdep .le. fccd_dep ) then 3599 f_benout_lyso_ca(ji,jj) = xsedca * zn_sed_ca(ji,jj) 3600 endif 3601 endif 3602 endif 3603 CALL flush(numout) 3604 3605 !!====================================================================== 3606 !! LOCAL GRID CELL TRENDS 3607 !!====================================================================== 3608 !! 3609 !!---------------------------------------------------------------------- 3610 !! Determination of trends 3611 !!---------------------------------------------------------------------- 3612 !! 3613 !!---------------------------------------------------------------------- 3614 !! chlorophyll 3615 btra(jpchn) = b0 * ( & 3616 + ((frn * fprn * zphn) - fgmipn - fgmepn - fdpn - fdpn2) * (fthetan / xxi) ) 3617 btra(jpchd) = b0 * ( & 3618 + ((frd * fprd * zphd) - fgmepd - fdpd - fdpd2) * (fthetad / xxi) ) 3619 !! 3620 !!---------------------------------------------------------------------- 3621 !! phytoplankton 3622 btra(jpphn) = b0 * ( & 3623 + (fprn * zphn) - fgmipn - fgmepn - fdpn - fdpn2 ) 3624 btra(jpphd) = b0 * ( & 3625 + (fprd * zphd) - fgmepd - fdpd - fdpd2 ) 3626 btra(jppds) = b0 * ( & 3627 + (fprds * zpds) - fgmepds - fdpds - fsdiss - fdpds2 ) 3628 !! 3629 !!---------------------------------------------------------------------- 3630 !! zooplankton 3631 btra(jpzmi) = b0 * ( & 3632 + fmigrow - fgmezmi - fdzmi - fdzmi2 ) 3633 btra(jpzme) = b0 * ( & 3634 + fmegrow - fdzme - fdzme2 ) 3635 !! 3636 !!---------------------------------------------------------------------- 3637 !! detritus 3638 btra(jpdet) = b0 * ( & 3639 + fdpn + ((1.0 - xfdfrac1) * fdpd) & ! mort. losses 3640 + fdzmi + ((1.0 - xfdfrac2) * fdzme) & ! mort. losses 3641 + ((1.0 - xbetan) * (finmi + finme)) & ! assim. inefficiency 3642 - fgmid - fgmed - fdd & ! grazing and remin. 3643 + ffast2slown ) ! seafloor fast->slow 3644 !! 3645 !!---------------------------------------------------------------------- 3646 !! dissolved inorganic nitrogen nutrient 3647 fn_cons = 0.0 & 3648 - (fprn * zphn) - (fprd * zphd) ! primary production 3649 fn_prod = 0.0 & 3650 + (xphi * (fgmipn + fgmid)) & ! messy feeding remin. 3651 + (xphi * (fgmepn + fgmepd + fgmezmi + fgmed)) & ! messy feeding remin. 3652 + fmiexcr + fmeexcr + fdd + freminn & ! excretion and remin. 3653 + fdpn2 + fdpd2 + fdzmi2 + fdzme2 ! metab. losses 3654 !! 3655 !! riverine flux 3656 if ( jriver_n .gt. 0 ) then 3657 f_riv_loc_n = f_riv_n(ji,jj) * friver_dep(jk,jmbathy) / fthk 3658 fn_prod = fn_prod + f_riv_loc_n 3659 endif 3660 !! 3661 !! benthic remineralisation 3662 if (jk.eq.jmbathy .and. jorgben.eq.1 .and. ibenthic.eq.1) then 3663 fn_prod = fn_prod + (f_benout_n(ji,jj) / fthk) 3664 endif 3665 !! 3666 btra(jpdin) = b0 * ( & 3667 fn_prod + fn_cons ) 3668 !! 3669 fnit_cons(ji,jj) = fnit_cons(ji,jj) + ( fthk * ( & ! consumption of dissolved nitrogen 3670 fn_cons ) ) 3671 fnit_prod(ji,jj) = fnit_prod(ji,jj) + ( fthk * ( & ! production of dissolved nitrogen 3672 fn_prod ) ) 3673 !! 3674 !!---------------------------------------------------------------------- 3675 !! dissolved silicic acid nutrient 3676 fs_cons = 0.0 & 3677 - (fprds * zpds) ! opal production 3678 fs_prod = 0.0 & 3679 + fsdiss & ! opal dissolution 3680 + ((1.0 - xfdfrac1) * fdpds) & ! mort. loss 3681 + ((1.0 - xfdfrac3) * fgmepds) & ! egestion of grazed Si 3682 + freminsi + fdpds2 ! fast diss. and metab. losses 3683 !! 3684 !! riverine flux 3685 if ( jriver_si .gt. 0 ) then 3686 f_riv_loc_si = f_riv_si(ji,jj) * friver_dep(jk,jmbathy) / fthk 3687 fs_prod = fs_prod + f_riv_loc_si 3688 endif 3689 !! 3690 !! benthic remineralisation 3691 if (jk.eq.jmbathy .and. jinorgben.eq.1 .and. ibenthic.eq.1) then 3692 fs_prod = fs_prod + (f_benout_si(ji,jj) / fthk) 3693 endif 3694 !! 3695 btra(jpsil) = b0 * ( & 3696 fs_prod + fs_cons ) 3697 !! 3698 fsil_cons(ji,jj) = fsil_cons(ji,jj) + ( fthk * ( & ! consumption of dissolved silicon 3699 fs_cons ) ) 3700 fsil_prod(ji,jj) = fsil_prod(ji,jj) + ( fthk * ( & ! production of dissolved silicon 3701 fs_prod ) ) 3702 !! 3703 !!---------------------------------------------------------------------- 3704 !! dissolved "iron" nutrient 3705 btra(jpfer) = b0 * ( & 3706 + (xrfn * btra(jpdin)) + ffetop + ffebot - ffescav ) 3707 3708 # if defined key_roam 3709 !! 3710 !!---------------------------------------------------------------------- 3711 !! AXY (26/11/08): implicit detrital carbon change 3712 btra(jpdtc) = b0 * ( & 3713 + (xthetapn * fdpn) + ((1.0 - xfdfrac1) * (xthetapd * fdpd)) & ! mort. losses 3714 + (xthetazmi * fdzmi) + ((1.0 - xfdfrac2) * (xthetazme * fdzme)) & ! mort. losses 3715 + ((1.0 - xbetac) * (ficmi + ficme)) & ! assim. inefficiency 3716 - fgmidc - fgmedc - fddc & ! grazing and remin. 3717 + ffast2slowc ) ! seafloor fast->slow 3718 !! 3719 !!---------------------------------------------------------------------- 3720 !! dissolved inorganic carbon 3721 fc_cons = 0.0 & 3722 - (xthetapn * fprn * zphn) - (xthetapd * fprd * zphd) ! primary production 3723 fc_prod = 0.0 & 3724 + (xthetapn * xphi * fgmipn) + (xphi * fgmidc) & ! messy feeding remin 3725 + (xthetapn * xphi * fgmepn) + (xthetapd * xphi * fgmepd) & ! messy feeding remin 3726 + (xthetazmi * xphi * fgmezmi) + (xphi * fgmedc) & ! messy feeding remin 3727 + fmiresp + fmeresp + fddc + freminc + (xthetapn * fdpn2) & ! resp., remin., losses 3728 + (xthetapd * fdpd2) + (xthetazmi * fdzmi2) & ! losses 3729 + (xthetazme * fdzme2) ! losses 3730 !! 3731 !! riverine flux 3732 if ( jriver_c .gt. 0 ) then 3733 f_riv_loc_c = f_riv_c(ji,jj) * friver_dep(jk,jmbathy) / fthk 3734 fc_prod = fc_prod + f_riv_loc_c 3735 endif 3736 !! 3737 !! benthic remineralisation 3738 if (jk.eq.jmbathy .and. jorgben.eq.1 .and. ibenthic.eq.1) then 3739 fc_prod = fc_prod + (f_benout_c(ji,jj) / fthk) 3740 endif 3741 if (jk.eq.jmbathy .and. jinorgben.eq.1 .and. ibenthic.eq.1) then 3742 fc_prod = fc_prod + (f_benout_ca(ji,jj) / fthk) 3743 endif 3744 !! 3745 !! community respiration (does not include CaCO3 terms - obviously!) 3746 fcomm_resp(ji,jj) = fcomm_resp(ji,jj) + fc_prod 3747 !! 3748 !! CaCO3 3749 fc_prod = fc_prod - ftempca + freminca 3750 !! 3751 !! riverine flux 3752 if ( jk .eq. 1 .and. jriver_c .gt. 0 ) then 3753 fc_prod = fc_prod + f_riv_c(ji,jj) 3754 endif 3755 !! 3756 btra(jpdic) = b0 * ( & 3757 fc_prod + fc_cons ) 3758 !! 3759 fcar_cons(ji,jj) = fcar_cons(ji,jj) + ( fthk * ( & ! consumption of dissolved carbon 3760 fc_cons ) ) 3761 fcar_prod(ji,jj) = fcar_prod(ji,jj) + ( fthk * ( & ! production of dissolved carbon 3762 fc_prod ) ) 3763 !! 3764 !!---------------------------------------------------------------------- 3765 !! alkalinity 3766 fa_prod = 0.0 & 3767 + (2.0 * freminca) ! CaCO3 dissolution 3768 fa_cons = 0.0 & 3769 - (2.0 * ftempca) ! CaCO3 production 3770 !! 3771 !! riverine flux 3772 if ( jriver_alk .gt. 0 ) then 3773 f_riv_loc_alk = f_riv_alk(ji,jj) * friver_dep(jk,jmbathy) / fthk 3774 fa_prod = fa_prod + f_riv_loc_alk 3775 endif 3776 !! 3777 !! benthic remineralisation 3778 if (jk.eq.jmbathy .and. jinorgben.eq.1 .and. ibenthic.eq.1) then 3779 fa_prod = fa_prod + (2.0 * f_benout_ca(ji,jj) / fthk) 3780 endif 3781 !! 3782 btra(jpalk) = b0 * ( & 3783 fa_prod + fa_cons ) 3784 !! 3785 !!---------------------------------------------------------------------- 3786 !! oxygen (has protection at low O2 concentrations; OCMIP-2 style) 3787 fo2_prod = 0.0 & 3788 + (xthetanit * fprn * zphn) & ! Pn primary production, N 3789 + (xthetanit * fprd * zphd) & ! Pd primary production, N 3790 + (xthetarem * xthetapn * fprn * zphn) & ! Pn primary production, C 3791 + (xthetarem * xthetapd * fprd * zphd) ! Pd primary production, C 3792 fo2_ncons = 0.0 & 3793 - (xthetanit * xphi * fgmipn) & ! Pn messy feeding remin., N 3794 - (xthetanit * xphi * fgmid) & ! D messy feeding remin., N 3795 - (xthetanit * xphi * fgmepn) & ! Pn messy feeding remin., N 3796 - (xthetanit * xphi * fgmepd) & ! Pd messy feeding remin., N 3797 - (xthetanit * xphi * fgmezmi) & ! Zi messy feeding remin., N 3798 - (xthetanit * xphi * fgmed) & ! D messy feeding remin., N 3799 - (xthetanit * fmiexcr) & ! microzoo excretion, N 3800 - (xthetanit * fmeexcr) & ! mesozoo excretion, N 3801 - (xthetanit * fdd) & ! slow detritus remin., N 3802 - (xthetanit * freminn) & ! fast detritus remin., N 3803 - (xthetanit * fdpn2) & ! Pn losses, N 3804 - (xthetanit * fdpd2) & ! Pd losses, N 3805 - (xthetanit * fdzmi2) & ! Zmi losses, N 3806 - (xthetanit * fdzme2) ! Zme losses, N 3807 !! 3808 !! benthic remineralisation 3809 if (jk.eq.jmbathy .and. jorgben.eq.1 .and. ibenthic.eq.1) then 3810 fo2_ncons = fo2_ncons - (xthetanit * f_benout_n(ji,jj) / fthk) 3811 endif 3812 fo2_ccons = 0.0 & 3813 - (xthetarem * xthetapn * xphi * fgmipn) & ! Pn messy feeding remin., C 3814 - (xthetarem * xphi * fgmidc) & ! D messy feeding remin., C 3815 - (xthetarem * xthetapn * xphi * fgmepn) & ! Pn messy feeding remin., C 3816 - (xthetarem * xthetapd * xphi * fgmepd) & ! Pd messy feeding remin., C 3817 - (xthetarem * xthetazmi * xphi * fgmezmi) & ! Zi messy feeding remin., C 3818 - (xthetarem * xphi * fgmedc) & ! D messy feeding remin., C 3819 - (xthetarem * fmiresp) & ! microzoo respiration, C 3820 - (xthetarem * fmeresp) & ! mesozoo respiration, C 3821 - (xthetarem * fddc) & ! slow detritus remin., C 3822 - (xthetarem * freminc) & ! fast detritus remin., C 3823 - (xthetarem * xthetapn * fdpn2) & ! Pn losses, C 3824 - (xthetarem * xthetapd * fdpd2) & ! Pd losses, C 3825 - (xthetarem * xthetazmi * fdzmi2) & ! Zmi losses, C 3826 - (xthetarem * xthetazme * fdzme2) ! Zme losses, C 3827 !! 3828 !! benthic remineralisation 3829 if (jk.eq.jmbathy .and. jorgben.eq.1 .and. ibenthic.eq.1) then 3830 fo2_ccons = fo2_ccons - (xthetarem * f_benout_c(ji,jj) / fthk) 3831 endif 3832 fo2_cons = fo2_ncons + fo2_ccons 3833 !! 3834 !! is this a suboxic zone? 3835 if (zoxy.lt.xo2min) then ! deficient O2; production fluxes only 3836 btra(jpoxy) = b0 * ( & 3837 fo2_prod ) 3838 foxy_prod(ji,jj) = foxy_prod(ji,jj) + ( fthk * fo2_prod ) 3839 foxy_anox(ji,jj) = foxy_anox(ji,jj) + ( fthk * fo2_cons ) 3840 else ! sufficient O2; production + consumption fluxes 3841 btra(jpoxy) = b0 * ( & 3842 fo2_prod + fo2_cons ) 3843 foxy_prod(ji,jj) = foxy_prod(ji,jj) + ( fthk * fo2_prod ) 3844 foxy_cons(ji,jj) = foxy_cons(ji,jj) + ( fthk * fo2_cons ) 3845 endif 3846 !! 3847 !! air-sea fluxes (if this is the surface box) 3848 if (jk.eq.1) then 3849 !! 3850 !! CO2 flux 3851 btra(jpdic) = btra(jpdic) + (b0 * f_co2flux) 3852 !! 3853 !! O2 flux (mol/m3/s -> mmol/m3/d) 3854 btra(jpoxy) = btra(jpoxy) + (b0 * f_o2flux) 3855 endif 3856 # endif 3857 3858 # if defined key_debug_medusa 3859 !! report state variable fluxes (not including fast-sinking detritus) 3860 if (idf.eq.1.AND.idfval.eq.1) then 3861 IF (lwp) write (numout,*) '------------------------------' 3862 IF (lwp) write (numout,*) 'btra(jpchn)(',jk,') = ', btra(jpchn) 3863 IF (lwp) write (numout,*) 'btra(jpchd)(',jk,') = ', btra(jpchd) 3864 IF (lwp) write (numout,*) 'btra(jpphn)(',jk,') = ', btra(jpphn) 3865 IF (lwp) write (numout,*) 'btra(jpphd)(',jk,') = ', btra(jpphd) 3866 IF (lwp) write (numout,*) 'btra(jppds)(',jk,') = ', btra(jppds) 3867 IF (lwp) write (numout,*) 'btra(jpzmi)(',jk,') = ', btra(jpzmi) 3868 IF (lwp) write (numout,*) 'btra(jpzme)(',jk,') = ', btra(jpzme) 3869 IF (lwp) write (numout,*) 'btra(jpdet)(',jk,') = ', btra(jpdet) 3870 IF (lwp) write (numout,*) 'btra(jpdin)(',jk,') = ', btra(jpdin) 3871 IF (lwp) write (numout,*) 'btra(jpsil)(',jk,') = ', btra(jpsil) 3872 IF (lwp) write (numout,*) 'btra(jpfer)(',jk,') = ', btra(jpfer) 3873 # if defined key_roam 3874 IF (lwp) write (numout,*) 'btra(jpdtc)(',jk,') = ', btra(jpdtc) 3875 IF (lwp) write (numout,*) 'btra(jpdic)(',jk,') = ', btra(jpdic) 3876 IF (lwp) write (numout,*) 'btra(jpalk)(',jk,') = ', btra(jpalk) 3877 IF (lwp) write (numout,*) 'btra(jpoxy)(',jk,') = ', btra(jpoxy) 3878 # endif 3879 endif 3880 # endif 3881 3882 !!---------------------------------------------------------------------- 3883 !! Integrate calculated fluxes for mass balance 3884 !!---------------------------------------------------------------------- 3885 !! 3886 !! === nitrogen === 3887 fflx_n(ji,jj) = fflx_n(ji,jj) + & 3888 fthk * ( btra(jpphn) + btra(jpphd) + btra(jpzmi) + btra(jpzme) + btra(jpdet) + btra(jpdin) ) 3889 !! === silicon === 3890 fflx_si(ji,jj) = fflx_si(ji,jj) + & 3891 fthk * ( btra(jppds) + btra(jpsil) ) 3892 !! === iron === 3893 fflx_fe(ji,jj) = fflx_fe(ji,jj) + & 3894 fthk * ( ( xrfn * ( btra(jpphn) + btra(jpphd) + btra(jpzmi) + btra(jpzme) + btra(jpdet)) ) + btra(jpfer) ) 3895 # if defined key_roam 3896 !! === carbon === 3897 fflx_c(ji,jj) = fflx_c(ji,jj) + & 3898 fthk * ( (xthetapn * btra(jpphn)) + (xthetapd * btra(jpphd)) + & 3899 (xthetazmi * btra(jpzmi)) + (xthetazme * btra(jpzme)) + btra(jpdtc) + btra(jpdic) ) 3900 !! === alkalinity === 3901 fflx_a(ji,jj) = fflx_a(ji,jj) + & 3902 fthk * ( btra(jpalk) ) 3903 !! === oxygen === 3904 fflx_o2(ji,jj) = fflx_o2(ji,jj) + & 3905 fthk * ( btra(jpoxy) ) 3906 # endif 3907 3908 !!---------------------------------------------------------------------- 3909 !! Apply calculated tracer fluxes 3910 !!---------------------------------------------------------------------- 3911 !! 3912 !! units: [unit of tracer] per second (fluxes are calculated above per day) 3913 !! 3914 ibio_switch = 1 3915 # if defined key_gulf_finland 3916 !! AXY (17/05/13): fudge in a Gulf of Finland correction; uses longitude- 3917 !! latitude range to establish if this is a Gulf of Finland 3918 !! grid cell; if so, then BGC fluxes are ignored (though 3919 !! still calculated); for reference, this is meant to be a 3920 !! temporary fix to see if all of my problems can be done 3921 !! away with if I switch off BGC fluxes in the Gulf of 3922 !! Finland, which currently appears the source of trouble 3923 if ( glamt(ji,jj).gt.24.7 .and. glamt(ji,jj).lt.27.8 .and. & 3924 & gphit(ji,jj).gt.59.2 .and. gphit(ji,jj).lt.60.2 ) then 3925 ibio_switch = 0 3926 endif 3927 # endif 3928 if (ibio_switch.eq.1) then 3929 tra(ji,jj,jk,jpchn) = tra(ji,jj,jk,jpchn) + (btra(jpchn) / 86400.) 3930 tra(ji,jj,jk,jpchd) = tra(ji,jj,jk,jpchd) + (btra(jpchd) / 86400.) 3931 tra(ji,jj,jk,jpphn) = tra(ji,jj,jk,jpphn) + (btra(jpphn) / 86400.) 3932 tra(ji,jj,jk,jpphd) = tra(ji,jj,jk,jpphd) + (btra(jpphd) / 86400.) 3933 tra(ji,jj,jk,jppds) = tra(ji,jj,jk,jppds) + (btra(jppds) / 86400.) 3934 tra(ji,jj,jk,jpzmi) = tra(ji,jj,jk,jpzmi) + (btra(jpzmi) / 86400.) 3935 tra(ji,jj,jk,jpzme) = tra(ji,jj,jk,jpzme) + (btra(jpzme) / 86400.) 3936 tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + (btra(jpdet) / 86400.) 3937 tra(ji,jj,jk,jpdin) = tra(ji,jj,jk,jpdin) + (btra(jpdin) / 86400.) 3938 tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) + (btra(jpsil) / 86400.) 3939 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + (btra(jpfer) / 86400.) 3940 # if defined key_roam 3941 tra(ji,jj,jk,jpdtc) = tra(ji,jj,jk,jpdtc) + (btra(jpdtc) / 86400.) 3942 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + (btra(jpdic) / 86400.) 3943 tra(ji,jj,jk,jpalk) = tra(ji,jj,jk,jpalk) + (btra(jpalk) / 86400.) 3944 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + (btra(jpoxy) / 86400.) 3945 # endif 3946 endif 3947 3948 !! AXY (18/11/16): CMIP6 diagnostics 3949 IF( med_diag%FBDDTALK%dgsave ) THEN 3950 fbddtalk(ji,jj) = fbddtalk(ji,jj) + (btra(jpalk) * fthk) 3951 ENDIF 3952 IF( med_diag%FBDDTDIC%dgsave ) THEN 3953 fbddtdic(ji,jj) = fbddtdic(ji,jj) + (btra(jpdic) * fthk) 3954 ENDIF 3955 IF( med_diag%FBDDTDIFE%dgsave ) THEN 3956 fbddtdife(ji,jj) = fbddtdife(ji,jj) + (btra(jpfer) * fthk) 3957 ENDIF 3958 IF( med_diag%FBDDTDIN%dgsave ) THEN 3959 fbddtdin(ji,jj) = fbddtdin(ji,jj) + (btra(jpdin) * fthk) 3960 ENDIF 3961 IF( med_diag%FBDDTDISI%dgsave ) THEN 3962 fbddtdisi(ji,jj) = fbddtdisi(ji,jj) + (btra(jpsil) * fthk) 3963 ENDIF 3964 !! 3965 IF( med_diag%BDDTALK3%dgsave ) THEN 3966 bddtalk3(ji,jj,jk) = btra(jpalk) 3967 ENDIF 3968 IF( med_diag%BDDTDIC3%dgsave ) THEN 3969 bddtdic3(ji,jj,jk) = btra(jpdic) 3970 ENDIF 3971 IF( med_diag%BDDTDIFE3%dgsave ) THEN 3972 bddtdife3(ji,jj,jk) = btra(jpfer) 3973 ENDIF 3974 IF( med_diag%BDDTDIN3%dgsave ) THEN 3975 bddtdin3(ji,jj,jk) = btra(jpdin) 3976 ENDIF 3977 IF( med_diag%BDDTDISI3%dgsave ) THEN 3978 bddtdisi3(ji,jj,jk) = btra(jpsil) 3979 ENDIF 3980 3981 # if defined key_debug_medusa 3982 IF (lwp) write (numout,*) '------' 3983 IF (lwp) write (numout,*) 'trc_bio_medusa: end all calculations' 3984 IF (lwp) write (numout,*) 'trc_bio_medusa: now outputs' 3985 CALL flush(numout) 3986 # endif 3987 3988 # if defined key_axy_nancheck 3989 !!---------------------------------------------------------------------- 3990 !! Check calculated tracer fluxes 3991 !!---------------------------------------------------------------------- 3992 !! 3993 DO jn = 1,jptra 3994 fq0 = btra(jn) 3995 !! AXY (30/01/14): "isnan" problem on HECTOR 3996 !! if (fq0 /= fq0 ) then 3997 if ( ieee_is_nan( fq0 ) ) then 3998 !! there's a NaN here 3999 if (lwp) write(numout,*) 'NAN detected in btra(', ji, ',', & 4000 & jj, ',', jk, ',', jn, ') at time', kt 4001 CALL ctl_stop( 'trcbio_medusa, NAN in btra field' ) 4002 endif 4003 ENDDO 4004 DO jn = 1,jptra 4005 fq0 = tra(ji,jj,jk,jn) 4006 !! AXY (30/01/14): "isnan" problem on HECTOR 4007 !! if (fq0 /= fq0 ) then 4008 if ( ieee_is_nan( fq0 ) ) then 4009 !! there's a NaN here 4010 if (lwp) write(numout,*) 'NAN detected in tra(', ji, ',', & 4011 & jj, ',', jk, ',', jn, ') at time', kt 4012 CALL ctl_stop( 'trcbio_medusa, NAN in tra field' ) 4013 endif 4014 ENDDO 4015 CALL flush(numout) 4016 # endif 4017 4018 !!---------------------------------------------------------------------- 4019 !! Check model conservation 4020 !! these terms merely sum up the tendency terms of the relevant 4021 !! state variables, which should sum to zero; the iron cycle is 4022 !! complicated by fluxes that add (aeolian deposition and seafloor 4023 !! remineralisation) and remove (scavenging) dissolved iron from 4024 !! the model (i.e. the sum of iron fluxes is unlikely to be zero) 4025 !!---------------------------------------------------------------------- 4026 !! 4027 !! fnit0 = btra(jpphn) + btra(jpphd) + btra(jpzmi) + btra(jpzme) + btra(jpdet) + btra(jpdin) ! + ftempn 4028 !! fsil0 = btra(jppds) + btra(jpsil) ! + ftempsi 4029 !! ffer0 = (xrfn * fnit0) + btra(jpfer) 4030 # if defined key_roam 4031 !! fcar0 = 0. 4032 !! falk0 = 0. 4033 !! foxy0 = 0. 4034 # endif 4035 !! 4036 !! if (kt/240*240.eq.kt) then 4037 !! if (ji.eq.2.and.jj.eq.2.and.jk.eq.1) then 4038 !! IF (lwp) write (*,*) '*******!MEDUSA Conservation!*******',kt 4039 # if defined key_roam 4040 !! IF (lwp) write (*,*) fnit0,fsil0,ffer0,fcar0,falk0,foxy0 4041 # else 4042 !! IF (lwp) write (*,*) fnit0,fsil0,ffer0 4043 # endif 4044 !! endif 4045 !! endif 4046 4047 # if defined key_trc_diabio 4048 !!====================================================================== 4049 !! LOCAL GRID CELL DIAGNOSTICS 4050 !!====================================================================== 4051 !! 4052 !!---------------------------------------------------------------------- 4053 !! Full diagnostics key_trc_diabio: 4054 !! LOBSTER and PISCES support full diagnistics option key_trc_diabio 4055 !! which gives an option of FULL output of biological sourses and sinks. 4056 !! I cannot see any reason for doing this. If needed, it can be done 4057 !! as shown below. 4058 !!---------------------------------------------------------------------- 4059 !! 4060 IF(lwp) WRITE(numout,*) ' MEDUSA does not support key_trc_diabio' 4061 !! trbio(ji,jj,jk, 1) = fprn 4062 # endif 4063 4064 IF( lk_iomput .AND. .NOT. ln_diatrc ) THEN 4065 !!---------------------------------------------------------------------- 4066 !! Add in XML diagnostics stuff 4067 !!---------------------------------------------------------------------- 4068 !! 4069 !! ** 2D diagnostics 4070 # if defined key_debug_medusa 4071 IF (lwp) write (numout,*) 'trc_bio_medusa: diag in ij-jj-jk loop' 4072 CALL flush(numout) 4073 # endif 4074 IF ( med_diag%PRN%dgsave ) THEN 4075 fprn2d(ji,jj) = fprn2d(ji,jj) + (fprn * zphn * fthk) 4076 ENDIF 4077 IF ( med_diag%MPN%dgsave ) THEN 4078 fdpn2d(ji,jj) = fdpn2d(ji,jj) + (fdpn * fthk) 4079 ENDIF 4080 IF ( med_diag%PRD%dgsave ) THEN 4081 fprd2d(ji,jj) = fprd2d(ji,jj) + (fprd * zphd * fthk) 4082 ENDIF 4083 IF( med_diag%MPD%dgsave ) THEN 4084 fdpd2d(ji,jj) = fdpd2d(ji,jj) + (fdpd * fthk) 4085 ENDIF 4086 ! IF( med_diag%DSED%dgsave ) THEN 4087 ! CALL iom_put( "DSED" , ftot_n ) 4088 ! ENDIF 4089 IF( med_diag%OPAL%dgsave ) THEN 4090 fprds2d(ji,jj) = fprds2d(ji,jj) + (fprds * zpds * fthk) 4091 ENDIF 4092 IF( med_diag%OPALDISS%dgsave ) THEN 4093 fsdiss2d(ji,jj) = fsdiss2d(ji,jj) + (fsdiss * fthk) 4094 ENDIF 4095 IF( med_diag%GMIPn%dgsave ) THEN 4096 fgmipn2d(ji,jj) = fgmipn2d(ji,jj) + (fgmipn * fthk) 4097 ENDIF 4098 IF( med_diag%GMID%dgsave ) THEN 4099 fgmid2d(ji,jj) = fgmid2d(ji,jj) + (fgmid * fthk) 4100 ENDIF 4101 IF( med_diag%MZMI%dgsave ) THEN 4102 fdzmi2d(ji,jj) = fdzmi2d(ji,jj) + (fdzmi * fthk) 4103 ENDIF 4104 IF( med_diag%GMEPN%dgsave ) THEN 4105 fgmepn2d(ji,jj) = fgmepn2d(ji,jj) + (fgmepn * fthk) 4106 ENDIF 4107 IF( med_diag%GMEPD%dgsave ) THEN 4108 fgmepd2d(ji,jj) = fgmepd2d(ji,jj) + (fgmepd * fthk) 4109 ENDIF 4110 IF( med_diag%GMEZMI%dgsave ) THEN 4111 fgmezmi2d(ji,jj) = fgmezmi2d(ji,jj) + (fgmezmi * fthk) 4112 ENDIF 4113 IF( med_diag%GMED%dgsave ) THEN 4114 fgmed2d(ji,jj) = fgmed2d(ji,jj) + (fgmed * fthk) 4115 ENDIF 4116 IF( med_diag%MZME%dgsave ) THEN 4117 fdzme2d(ji,jj) = fdzme2d(ji,jj) + (fdzme * fthk) 4118 ENDIF 4119 ! IF( med_diag%DEXP%dgsave ) THEN 4120 ! CALL iom_put( "DEXP" , ftot_n ) 4121 ! ENDIF 4122 IF( med_diag%DETN%dgsave ) THEN 4123 fslown2d(ji,jj) = fslown2d(ji,jj) + (fslown * fthk) 4124 ENDIF 4125 IF( med_diag%MDET%dgsave ) THEN 4126 fdd2d(ji,jj) = fdd2d(ji,jj) + (fdd * fthk) 4127 ENDIF 4128 IF( med_diag%AEOLIAN%dgsave ) THEN 4129 ffetop2d(ji,jj) = ffetop2d(ji,jj) + (ffetop * fthk) 4130 ENDIF 4131 IF( med_diag%BENTHIC%dgsave ) THEN 4132 ffebot2d(ji,jj) = ffebot2d(ji,jj) + (ffebot * fthk) 4133 ENDIF 4134 IF( med_diag%SCAVENGE%dgsave ) THEN 4135 ffescav2d(ji,jj) = ffescav2d(ji,jj) + (ffescav * fthk) 4136 ENDIF 4137 IF( med_diag%PN_JLIM%dgsave ) THEN 4138 ! fjln2d(ji,jj) = fjln2d(ji,jj) + (fjln * zphn * fthk) 4139 fjln2d(ji,jj) = fjln2d(ji,jj) + (fjlim_pn * zphn * fthk) 4140 ENDIF 4141 IF( med_diag%PN_NLIM%dgsave ) THEN 4142 fnln2d(ji,jj) = fnln2d(ji,jj) + (fnln * zphn * fthk) 4143 ENDIF 4144 IF( med_diag%PN_FELIM%dgsave ) THEN 4145 ffln2d(ji,jj) = ffln2d(ji,jj) + (ffln * zphn * fthk) 4146 ENDIF 4147 IF( med_diag%PD_JLIM%dgsave ) THEN 4148 ! fjld2d(ji,jj) = fjld2d(ji,jj) + (fjld * zphd * fthk) 4149 fjld2d(ji,jj) = fjld2d(ji,jj) + (fjlim_pd * zphd * fthk) 4150 ENDIF 4151 IF( med_diag%PD_NLIM%dgsave ) THEN 4152 fnld2d(ji,jj) = fnld2d(ji,jj) + (fnld * zphd * fthk) 4153 ENDIF 4154 IF( med_diag%PD_FELIM%dgsave ) THEN 4155 ffld2d(ji,jj) = ffld2d(ji,jj) + (ffld * zphd * fthk) 4156 ENDIF 4157 IF( med_diag%PD_SILIM%dgsave ) THEN 4158 fsld2d2(ji,jj) = fsld2d2(ji,jj) + (fsld2 * zphd * fthk) 4159 ENDIF 4160 IF( med_diag%PDSILIM2%dgsave ) THEN 4161 fsld2d(ji,jj) = fsld2d(ji,jj) + (fsld * zphd * fthk) 4162 ENDIF 4163 !! 4164 IF( med_diag%TOTREG_N%dgsave ) THEN 4165 fregen2d(ji,jj) = fregen2d(ji,jj) + fregen 4166 ENDIF 4167 IF( med_diag%TOTRG_SI%dgsave ) THEN 4168 fregensi2d(ji,jj) = fregensi2d(ji,jj) + fregensi 4169 ENDIF 4170 !! 4171 IF( med_diag%FASTN%dgsave ) THEN 4172 ftempn2d(ji,jj) = ftempn2d(ji,jj) + (ftempn * fthk) 4173 ENDIF 4174 IF( med_diag%FASTSI%dgsave ) THEN 4175 ftempsi2d(ji,jj) = ftempsi2d(ji,jj) + (ftempsi * fthk) 4176 ENDIF 4177 IF( med_diag%FASTFE%dgsave ) THEN 4178 ftempfe2d(ji,jj) =ftempfe2d(ji,jj) + (ftempfe * fthk) 4179 ENDIF 4180 IF( med_diag%FASTC%dgsave ) THEN 4181 ftempc2d(ji,jj) = ftempc2d(ji,jj) + (ftempc * fthk) 4182 ENDIF 4183 IF( med_diag%FASTCA%dgsave ) THEN 4184 ftempca2d(ji,jj) = ftempca2d(ji,jj) + (ftempca * fthk) 4185 ENDIF 4186 !! 4187 IF( med_diag%REMINN%dgsave ) THEN 4188 freminn2d(ji,jj) = freminn2d(ji,jj) + (freminn * fthk) 4189 ENDIF 4190 IF( med_diag%REMINSI%dgsave ) THEN 4191 freminsi2d(ji,jj) = freminsi2d(ji,jj) + (freminsi * fthk) 4192 ENDIF 4193 IF( med_diag%REMINFE%dgsave ) THEN 4194 freminfe2d(ji,jj)= freminfe2d(ji,jj) + (freminfe * fthk) 4195 ENDIF 4196 IF( med_diag%REMINC%dgsave ) THEN 4197 freminc2d(ji,jj) = freminc2d(ji,jj) + (freminc * fthk) 4198 ENDIF 4199 IF( med_diag%REMINCA%dgsave ) THEN 4200 freminca2d(ji,jj) = freminca2d(ji,jj) + (freminca * fthk) 4201 ENDIF 4202 !! 4203 # if defined key_roam 4204 !! 4205 !! AXY (09/11/16): CMIP6 diagnostics 4206 IF( med_diag%FD_NIT3%dgsave ) THEN 4207 fd_nit3(ji,jj,jk) = ffastn(ji,jj) 4208 ENDIF 4209 IF( med_diag%FD_SIL3%dgsave ) THEN 4210 fd_sil3(ji,jj,jk) = ffastsi(ji,jj) 4211 ENDIF 4212 IF( med_diag%FD_CAR3%dgsave ) THEN 4213 fd_car3(ji,jj,jk) = ffastc(ji,jj) 4214 ENDIF 4215 IF( med_diag%FD_CAL3%dgsave ) THEN 4216 fd_cal3(ji,jj,jk) = ffastca(ji,jj) 4217 ENDIF 4218 !! 4219 IF (jk.eq.i0100) THEN 4220 IF( med_diag%RR_0100%dgsave ) THEN 4221 ffastca2d(ji,jj) = & 4222 ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall) 4223 ENDIF 4224 ELSE IF (jk.eq.i0500) THEN 4225 IF( med_diag%RR_0500%dgsave ) THEN 4226 ffastca2d(ji,jj) = & 4227 ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall) 4228 ENDIF 4229 ELSE IF (jk.eq.i1000) THEN 4230 IF( med_diag%RR_1000%dgsave ) THEN 4231 ffastca2d(ji,jj) = & 4232 ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall) 4233 ENDIF 4234 ELSE IF (jk.eq.jmbathy) THEN 4235 IF( med_diag%IBEN_N%dgsave ) THEN 4236 iben_n2d(ji,jj) = f_sbenin_n(ji,jj) + f_fbenin_n(ji,jj) 4237 ENDIF 4238 IF( med_diag%IBEN_FE%dgsave ) THEN 4239 iben_fe2d(ji,jj) = f_sbenin_fe(ji,jj) + f_fbenin_fe(ji,jj) 4240 ENDIF 4241 IF( med_diag%IBEN_C%dgsave ) THEN 4242 iben_c2d(ji,jj) = f_sbenin_c(ji,jj) + f_fbenin_c(ji,jj) 4243 ENDIF 4244 IF( med_diag%IBEN_SI%dgsave ) THEN 4245 iben_si2d(ji,jj) = f_fbenin_si(ji,jj) 4246 ENDIF 4247 IF( med_diag%IBEN_CA%dgsave ) THEN 4248 iben_ca2d(ji,jj) = f_fbenin_ca(ji,jj) 4249 ENDIF 4250 IF( med_diag%OBEN_N%dgsave ) THEN 4251 oben_n2d(ji,jj) = f_benout_n(ji,jj) 4252 ENDIF 4253 IF( med_diag%OBEN_FE%dgsave ) THEN 4254 oben_fe2d(ji,jj) = f_benout_fe(ji,jj) 4255 ENDIF 4256 IF( med_diag%OBEN_C%dgsave ) THEN 4257 oben_c2d(ji,jj) = f_benout_c(ji,jj) 4258 ENDIF 4259 IF( med_diag%OBEN_SI%dgsave ) THEN 4260 oben_si2d(ji,jj) = f_benout_si(ji,jj) 4261 ENDIF 4262 IF( med_diag%OBEN_CA%dgsave ) THEN 4263 oben_ca2d(ji,jj) = f_benout_ca(ji,jj) 4264 ENDIF 4265 IF( med_diag%SFR_OCAL%dgsave ) THEN 4266 sfr_ocal2d(ji,jj) = f3_omcal(ji,jj,jk) 4267 ENDIF 4268 IF( med_diag%SFR_OARG%dgsave ) THEN 4269 sfr_oarg2d(ji,jj) = f3_omarg(ji,jj,jk) 4270 ENDIF 4271 IF( med_diag%LYSO_CA%dgsave ) THEN 4272 lyso_ca2d(ji,jj) = f_benout_lyso_ca(ji,jj) 4273 ENDIF 4274 ENDIF 4275 !! end bathy-1 diags 4276 !! 4277 IF( med_diag%RIV_N%dgsave ) THEN 4278 rivn2d(ji,jj) = rivn2d(ji,jj) + (f_riv_loc_n * fthk) 4279 ENDIF 4280 IF( med_diag%RIV_SI%dgsave ) THEN 4281 rivsi2d(ji,jj) = rivsi2d(ji,jj) + (f_riv_loc_si * fthk) 4282 ENDIF 4283 IF( med_diag%RIV_C%dgsave ) THEN 4284 rivc2d(ji,jj) = rivc2d(ji,jj) + (f_riv_loc_c * fthk) 4285 ENDIF 4286 IF( med_diag%RIV_ALK%dgsave ) THEN 4287 rivalk2d(ji,jj) = rivalk2d(ji,jj) + (f_riv_loc_alk * fthk) 4288 ENDIF 4289 IF( med_diag%DETC%dgsave ) THEN 4290 fslowc2d(ji,jj) = fslowc2d(ji,jj) + (fslowc * fthk) 4291 ENDIF 4292 !! 4293 !! 4294 !! 4295 IF( med_diag%PN_LLOSS%dgsave ) THEN 4296 fdpn22d(ji,jj) = fdpn22d(ji,jj) + (fdpn2 * fthk) 4297 ENDIF 4298 IF( med_diag%PD_LLOSS%dgsave ) THEN 4299 fdpd22d(ji,jj) = fdpd22d(ji,jj) + (fdpd2 * fthk) 4300 ENDIF 4301 IF( med_diag%ZI_LLOSS%dgsave ) THEN 4302 fdzmi22d(ji,jj) = fdzmi22d(ji,jj) + (fdzmi2 * fthk) 4303 ENDIF 4304 IF( med_diag%ZE_LLOSS%dgsave ) THEN 4305 fdzme22d(ji,jj) = fdzme22d(ji,jj) + (fdzme2 * fthk) 4306 ENDIF 4307 IF( med_diag%ZI_MES_N%dgsave ) THEN 4308 zimesn2d(ji,jj) = zimesn2d(ji,jj) + & 4309 (xphi * (fgmipn + fgmid) * fthk) 4310 ENDIF 4311 IF( med_diag%ZI_MES_D%dgsave ) THEN 4312 zimesd2d(ji,jj) = zimesd2d(ji,jj) + & 4313 ((1. - xbetan) * finmi * fthk) 4314 ENDIF 4315 IF( med_diag%ZI_MES_C%dgsave ) THEN 4316 zimesc2d(ji,jj) = zimesc2d(ji,jj) + & 4317 (xphi * ((xthetapn * fgmipn) + fgmidc) * fthk) 4318 ENDIF 4319 IF( med_diag%ZI_MESDC%dgsave ) THEN 4320 zimesdc2d(ji,jj) = zimesdc2d(ji,jj) + & 4321 ((1. - xbetac) * ficmi * fthk) 4322 ENDIF 4323 IF( med_diag%ZI_EXCR%dgsave ) THEN 4324 ziexcr2d(ji,jj) = ziexcr2d(ji,jj) + (fmiexcr * fthk) 4325 ENDIF 4326 IF( med_diag%ZI_RESP%dgsave ) THEN 4327 ziresp2d(ji,jj) = ziresp2d(ji,jj) + (fmiresp * fthk) 4328 ENDIF 4329 IF( med_diag%ZI_GROW%dgsave ) THEN 4330 zigrow2d(ji,jj) = zigrow2d(ji,jj) + (fmigrow * fthk) 4331 ENDIF 4332 IF( med_diag%ZE_MES_N%dgsave ) THEN 4333 zemesn2d(ji,jj) = zemesn2d(ji,jj) + & 4334 (xphi * (fgmepn + fgmepd + fgmezmi + fgmed) * fthk) 4335 ENDIF 4336 IF( med_diag%ZE_MES_D%dgsave ) THEN 4337 zemesd2d(ji,jj) = zemesd2d(ji,jj) + & 4338 ((1. - xbetan) * finme * fthk) 4339 ENDIF 4340 IF( med_diag%ZE_MES_C%dgsave ) THEN 4341 zemesc2d(ji,jj) = zemesc2d(ji,jj) + & 4342 (xphi * ((xthetapn * fgmepn) + (xthetapd * fgmepd) + & 4343 (xthetazmi * fgmezmi) + fgmedc) * fthk) 4344 ENDIF 4345 IF( med_diag%ZE_MESDC%dgsave ) THEN 4346 zemesdc2d(ji,jj) = zemesdc2d(ji,jj) + & 4347 ((1. - xbetac) * ficme * fthk) 4348 ENDIF 4349 IF( med_diag%ZE_EXCR%dgsave ) THEN 4350 zeexcr2d(ji,jj) = zeexcr2d(ji,jj) + (fmeexcr * fthk) 4351 ENDIF 4352 IF( med_diag%ZE_RESP%dgsave ) THEN 4353 zeresp2d(ji,jj) = zeresp2d(ji,jj) + (fmeresp * fthk) 4354 ENDIF 4355 IF( med_diag%ZE_GROW%dgsave ) THEN 4356 zegrow2d(ji,jj) = zegrow2d(ji,jj) + (fmegrow * fthk) 4357 ENDIF 4358 IF( med_diag%MDETC%dgsave ) THEN 4359 mdetc2d(ji,jj) = mdetc2d(ji,jj) + (fddc * fthk) 4360 ENDIF 4361 IF( med_diag%GMIDC%dgsave ) THEN 4362 gmidc2d(ji,jj) = gmidc2d(ji,jj) + (fgmidc * fthk) 4363 ENDIF 4364 IF( med_diag%GMEDC%dgsave ) THEN 4365 gmedc2d(ji,jj) = gmedc2d(ji,jj) + (fgmedc * fthk) 4366 ENDIF 4367 !! 4368 # endif 4369 !! 4370 !! ** 3D diagnostics 4371 IF( med_diag%TPP3%dgsave ) THEN 4372 tpp3d(ji,jj,jk) = (fprn * zphn) + (fprd * zphd) 4373 !CALL iom_put( "TPP3" , tpp3d ) 4374 ENDIF 4375 IF( med_diag%TPPD3%dgsave ) THEN 4376 tppd3(ji,jj,jk) = (fprd * zphd) 4377 ENDIF 4378 4379 IF( med_diag%REMIN3N%dgsave ) THEN 4380 remin3dn(ji,jj,jk) = fregen + (freminn * fthk) !! remineralisation 4381 !CALL iom_put( "REMIN3N" , remin3dn ) 4382 ENDIF 4383 !! IF( med_diag%PH3%dgsave ) THEN 4384 !! CALL iom_put( "PH3" , f3_pH ) 4385 !! ENDIF 4386 !! IF( med_diag%OM_CAL3%dgsave ) THEN 4387 !! CALL iom_put( "OM_CAL3" , f3_omcal ) 4388 !! ENDIF 4389 !! 4390 !! AXY (09/11/16): CMIP6 diagnostics 4391 IF ( med_diag%DCALC3%dgsave ) THEN 4392 dcalc3(ji,jj,jk) = freminca 4393 ENDIF 4394 IF ( med_diag%FEDISS3%dgsave ) THEN 4395 fediss3(ji,jj,jk) = ffetop 4396 ENDIF 4397 IF ( med_diag%FESCAV3%dgsave ) THEN 4398 fescav3(ji,jj,jk) = ffescav 4399 ENDIF 4400 IF ( med_diag%MIGRAZP3%dgsave ) THEN 4401 migrazp3(ji,jj,jk) = fgmipn * xthetapn 4402 ENDIF 4403 IF ( med_diag%MIGRAZD3%dgsave ) THEN 4404 migrazd3(ji,jj,jk) = fgmidc 4405 ENDIF 4406 IF ( med_diag%MEGRAZP3%dgsave ) THEN 4407 megrazp3(ji,jj,jk) = (fgmepn * xthetapn) + (fgmepd * xthetapd) 4408 ENDIF 4409 IF ( med_diag%MEGRAZD3%dgsave ) THEN 4410 megrazd3(ji,jj,jk) = fgmedc 4411 ENDIF 4412 IF ( med_diag%MEGRAZZ3%dgsave ) THEN 4413 megrazz3(ji,jj,jk) = (fgmezmi * xthetazmi) 4414 ENDIF 4415 IF ( med_diag%PBSI3%dgsave ) THEN 4416 pbsi3(ji,jj,jk) = (fprds * zpds) 4417 ENDIF 4418 IF ( med_diag%PCAL3%dgsave ) THEN 4419 pcal3(ji,jj,jk) = ftempca 4420 ENDIF 4421 IF ( med_diag%REMOC3%dgsave ) THEN 4422 remoc3(ji,jj,jk) = freminc 4423 ENDIF 4424 IF ( med_diag%PNLIMJ3%dgsave ) THEN 4425 ! pnlimj3(ji,jj,jk) = fjln 4426 pnlimj3(ji,jj,jk) = fjlim_pn 4427 ENDIF 4428 IF ( med_diag%PNLIMN3%dgsave ) THEN 4429 pnlimn3(ji,jj,jk) = fnln 4430 ENDIF 4431 IF ( med_diag%PNLIMFE3%dgsave ) THEN 4432 pnlimfe3(ji,jj,jk) = ffln 4433 ENDIF 4434 IF ( med_diag%PDLIMJ3%dgsave ) THEN 4435 ! pdlimj3(ji,jj,jk) = fjld 4436 pdlimj3(ji,jj,jk) = fjlim_pd 4437 ENDIF 4438 IF ( med_diag%PDLIMN3%dgsave ) THEN 4439 pdlimn3(ji,jj,jk) = fnld 4440 ENDIF 4441 IF ( med_diag%PDLIMFE3%dgsave ) THEN 4442 pdlimfe3(ji,jj,jk) = ffld 4443 ENDIF 4444 IF ( med_diag%PDLIMSI3%dgsave ) THEN 4445 pdlimsi3(ji,jj,jk) = fsld2 4446 ENDIF 4447 !! 4448 !! ** Without using iom_use 4449 ELSE IF( ln_diatrc ) THEN 4450 # if defined key_debug_medusa 4451 IF (lwp) write (numout,*) 'trc_bio_medusa: diag in ij-jj-jk ln_diatrc' 4452 CALL flush(numout) 4453 # endif 4454 !!---------------------------------------------------------------------- 4455 !! Prepare 2D diagnostics 4456 !!---------------------------------------------------------------------- 4457 !! 4458 !! if ((kt / 240*240).eq.kt) then 4459 !! IF (lwp) write (*,*) '*******!MEDUSA DIAADD!*******',kt 4460 !! endif 4461 trc2d(ji,jj,1) = ftot_n(ji,jj) !! nitrogen inventory 4462 trc2d(ji,jj,2) = ftot_si(ji,jj) !! silicon inventory 4463 trc2d(ji,jj,3) = ftot_fe(ji,jj) !! iron inventory 4464 trc2d(ji,jj,4) = trc2d(ji,jj,4) + (fprn * zphn * fthk) !! non-diatom production 4465 trc2d(ji,jj,5) = trc2d(ji,jj,5) + (fdpn * fthk) !! non-diatom non-grazing losses 4466 trc2d(ji,jj,6) = trc2d(ji,jj,6) + (fprd * zphd * fthk) !! diatom production 4467 trc2d(ji,jj,7) = trc2d(ji,jj,7) + (fdpd * fthk) !! diatom non-grazing losses 4468 !! diagnostic field 8 is (ostensibly) supplied by trcsed.F 4469 trc2d(ji,jj,9) = trc2d(ji,jj,9) + (fprds * zpds * fthk) !! diatom silicon production 4470 trc2d(ji,jj,10) = trc2d(ji,jj,10) + (fsdiss * fthk) !! diatom silicon dissolution 4471 trc2d(ji,jj,11) = trc2d(ji,jj,11) + (fgmipn * fthk) !! microzoo grazing on non-diatoms 4472 trc2d(ji,jj,12) = trc2d(ji,jj,12) + (fgmid * fthk) !! microzoo grazing on detrital nitrogen 4473 trc2d(ji,jj,13) = trc2d(ji,jj,13) + (fdzmi * fthk) !! microzoo non-grazing losses 4474 trc2d(ji,jj,14) = trc2d(ji,jj,14) + (fgmepn * fthk) !! mesozoo grazing on non-diatoms 4475 trc2d(ji,jj,15) = trc2d(ji,jj,15) + (fgmepd * fthk) !! mesozoo grazing on diatoms 4476 trc2d(ji,jj,16) = trc2d(ji,jj,16) + (fgmezmi * fthk) !! mesozoo grazing on microzoo 4477 trc2d(ji,jj,17) = trc2d(ji,jj,17) + (fgmed * fthk) !! mesozoo grazing on detrital nitrogen 4478 trc2d(ji,jj,18) = trc2d(ji,jj,18) + (fdzme * fthk) !! mesozoo non-grazing losses 4479 !! diagnostic field 19 is (ostensibly) supplied by trcexp.F 4480 trc2d(ji,jj,20) = trc2d(ji,jj,20) + (fslown * fthk) !! slow sinking detritus N production 4481 trc2d(ji,jj,21) = trc2d(ji,jj,21) + (fdd * fthk) !! detrital remineralisation 4482 trc2d(ji,jj,22) = trc2d(ji,jj,22) + (ffetop * fthk) !! aeolian iron addition 4483 trc2d(ji,jj,23) = trc2d(ji,jj,23) + (ffebot * fthk) !! seafloor iron addition 4484 trc2d(ji,jj,24) = trc2d(ji,jj,24) + (ffescav * fthk) !! "free" iron scavenging 4485 trc2d(ji,jj,25) = trc2d(ji,jj,25) + (fjlim_pn * zphn * fthk) !! non-diatom J limitation term 4486 trc2d(ji,jj,26) = trc2d(ji,jj,26) + (fnln * zphn * fthk) !! non-diatom N limitation term 4487 trc2d(ji,jj,27) = trc2d(ji,jj,27) + (ffln * zphn * fthk) !! non-diatom Fe limitation term 4488 trc2d(ji,jj,28) = trc2d(ji,jj,28) + (fjlim_pd * zphd * fthk) !! diatom J limitation term 4489 trc2d(ji,jj,29) = trc2d(ji,jj,29) + (fnld * zphd * fthk) !! diatom N limitation term 4490 trc2d(ji,jj,30) = trc2d(ji,jj,30) + (ffld * zphd * fthk) !! diatom Fe limitation term 4491 trc2d(ji,jj,31) = trc2d(ji,jj,31) + (fsld2 * zphd * fthk) !! diatom Si limitation term 4492 trc2d(ji,jj,32) = trc2d(ji,jj,32) + (fsld * zphd * fthk) !! diatom Si uptake limitation term 4493 if (jk.eq.i0100) trc2d(ji,jj,33) = fslownflux(ji,jj) !! slow detritus flux at 100 m 4494 if (jk.eq.i0200) trc2d(ji,jj,34) = fslownflux(ji,jj) !! slow detritus flux at 200 m 4495 if (jk.eq.i0500) trc2d(ji,jj,35) = fslownflux(ji,jj) !! slow detritus flux at 500 m 4496 if (jk.eq.i1000) trc2d(ji,jj,36) = fslownflux(ji,jj) !! slow detritus flux at 1000 m 4497 trc2d(ji,jj,37) = trc2d(ji,jj,37) + fregen !! non-fast N full column regeneration 4498 trc2d(ji,jj,38) = trc2d(ji,jj,38) + fregensi !! non-fast Si full column regeneration 4499 if (jk.eq.i0100) trc2d(ji,jj,39) = trc2d(ji,jj,37) !! non-fast N regeneration to 100 m 4500 if (jk.eq.i0200) trc2d(ji,jj,40) = trc2d(ji,jj,37) !! non-fast N regeneration to 200 m 4501 if (jk.eq.i0500) trc2d(ji,jj,41) = trc2d(ji,jj,37) !! non-fast N regeneration to 500 m 4502 if (jk.eq.i1000) trc2d(ji,jj,42) = trc2d(ji,jj,37) !! non-fast N regeneration to 1000 m 4503 trc2d(ji,jj,43) = trc2d(ji,jj,43) + (ftempn * fthk) !! fast sinking detritus N production 4504 trc2d(ji,jj,44) = trc2d(ji,jj,44) + (ftempsi * fthk) !! fast sinking detritus Si production 4505 trc2d(ji,jj,45) = trc2d(ji,jj,45) + (ftempfe * fthk) !! fast sinking detritus Fe production 4506 trc2d(ji,jj,46) = trc2d(ji,jj,46) + (ftempc * fthk) !! fast sinking detritus C production 4507 trc2d(ji,jj,47) = trc2d(ji,jj,47) + (ftempca * fthk) !! fast sinking detritus CaCO3 production 4508 if (jk.eq.i0100) trc2d(ji,jj,48) = ffastn(ji,jj) !! fast detritus N flux at 100 m 4509 if (jk.eq.i0200) trc2d(ji,jj,49) = ffastn(ji,jj) !! fast detritus N flux at 200 m 4510 if (jk.eq.i0500) trc2d(ji,jj,50) = ffastn(ji,jj) !! fast detritus N flux at 500 m 4511 if (jk.eq.i1000) trc2d(ji,jj,51) = ffastn(ji,jj) !! fast detritus N flux at 1000 m 4512 if (jk.eq.i0100) trc2d(ji,jj,52) = fregenfast(ji,jj) !! N regeneration to 100 m 4513 if (jk.eq.i0200) trc2d(ji,jj,53) = fregenfast(ji,jj) !! N regeneration to 200 m 4514 if (jk.eq.i0500) trc2d(ji,jj,54) = fregenfast(ji,jj) !! N regeneration to 500 m 4515 if (jk.eq.i1000) trc2d(ji,jj,55) = fregenfast(ji,jj) !! N regeneration to 1000 m 4516 if (jk.eq.i0100) trc2d(ji,jj,56) = ffastsi(ji,jj) !! fast detritus Si flux at 100 m 4517 if (jk.eq.i0200) trc2d(ji,jj,57) = ffastsi(ji,jj) !! fast detritus Si flux at 200 m 4518 if (jk.eq.i0500) trc2d(ji,jj,58) = ffastsi(ji,jj) !! fast detritus Si flux at 500 m 4519 if (jk.eq.i1000) trc2d(ji,jj,59) = ffastsi(ji,jj) !! fast detritus Si flux at 1000 m 4520 if (jk.eq.i0100) trc2d(ji,jj,60) = fregenfastsi(ji,jj) !! Si regeneration to 100 m 4521 if (jk.eq.i0200) trc2d(ji,jj,61) = fregenfastsi(ji,jj) !! Si regeneration to 200 m 4522 if (jk.eq.i0500) trc2d(ji,jj,62) = fregenfastsi(ji,jj) !! Si regeneration to 500 m 4523 if (jk.eq.i1000) trc2d(ji,jj,63) = fregenfastsi(ji,jj) !! Si regeneration to 1000 m 4524 trc2d(ji,jj,64) = trc2d(ji,jj,64) + (freminn * fthk) !! sum of fast-sinking N fluxes 4525 trc2d(ji,jj,65) = trc2d(ji,jj,65) + (freminsi * fthk) !! sum of fast-sinking Si fluxes 4526 trc2d(ji,jj,66) = trc2d(ji,jj,66) + (freminfe * fthk) !! sum of fast-sinking Fe fluxes 4527 trc2d(ji,jj,67) = trc2d(ji,jj,67) + (freminc * fthk) !! sum of fast-sinking C fluxes 4528 trc2d(ji,jj,68) = trc2d(ji,jj,68) + (freminca * fthk) !! sum of fast-sinking Ca fluxes 4529 if (jk.eq.jmbathy) then 4530 trc2d(ji,jj,69) = fsedn(ji,jj) !! N sedimentation flux 4531 trc2d(ji,jj,70) = fsedsi(ji,jj) !! Si sedimentation flux 4532 trc2d(ji,jj,71) = fsedfe(ji,jj) !! Fe sedimentation flux 4533 trc2d(ji,jj,72) = fsedc(ji,jj) !! C sedimentation flux 4534 trc2d(ji,jj,73) = fsedca(ji,jj) !! Ca sedimentation flux 4535 endif 4536 if (jk.eq.1) trc2d(ji,jj,74) = qsr(ji,jj) 4537 if (jk.eq.1) trc2d(ji,jj,75) = xpar(ji,jj,jk) 4538 !! if (jk.eq.1) trc2d(ji,jj,75) = real(iters) 4539 !! diagnostic fields 76 to 80 calculated below 4540 trc2d(ji,jj,81) = trc2d(ji,jj,81) + fprn_ml(ji,jj) !! mixed layer non-diatom production 4541 trc2d(ji,jj,82) = trc2d(ji,jj,82) + fprd_ml(ji,jj) !! mixed layer diatom production 4542 # if defined key_gulf_finland 4543 if (jk.eq.1) trc2d(ji,jj,83) = real(ibio_switch) !! Gulf of Finland check 4544 # else 4545 trc2d(ji,jj,83) = ocal_ccd(ji,jj) !! calcite CCD depth 4546 # endif 4547 trc2d(ji,jj,84) = fccd(ji,jj) !! last model level above calcite CCD depth 4548 if (jk.eq.1) trc2d(ji,jj,85) = xFree(ji,jj) !! surface "free" iron 4549 if (jk.eq.i0200) trc2d(ji,jj,86) = xFree(ji,jj) !! "free" iron at 100 m 4550 if (jk.eq.i0200) trc2d(ji,jj,87) = xFree(ji,jj) !! "free" iron at 200 m 4551 if (jk.eq.i0500) trc2d(ji,jj,88) = xFree(ji,jj) !! "free" iron at 500 m 4552 if (jk.eq.i1000) trc2d(ji,jj,89) = xFree(ji,jj) !! "free" iron at 1000 m 4553 !! AXY (27/06/12): extract "euphotic depth" 4554 if (jk.eq.1) trc2d(ji,jj,90) = xze(ji,jj) 4555 !! 4556 # if defined key_roam 4557 !! ROAM provisionally has access to a further 20 2D diagnostics 4558 if (jk .eq. 1) then 4559 trc2d(ji,jj,91) = trc2d(ji,jj,91) + f_wind !! surface wind 4560 trc2d(ji,jj,92) = trc2d(ji,jj,92) + f_pco2atm !! atmospheric pCO2 4561 trc2d(ji,jj,93) = trc2d(ji,jj,93) + f_ph !! ocean pH 4562 trc2d(ji,jj,94) = trc2d(ji,jj,94) + f_pco2w !! ocean pCO2 4563 trc2d(ji,jj,95) = trc2d(ji,jj,95) + f_h2co3 !! ocean H2CO3 conc. 4564 trc2d(ji,jj,96) = trc2d(ji,jj,96) + f_hco3 !! ocean HCO3 conc. 4565 trc2d(ji,jj,97) = trc2d(ji,jj,97) + f_co3 !! ocean CO3 conc. 4566 trc2d(ji,jj,98) = trc2d(ji,jj,98) + f_co2flux !! air-sea CO2 flux 4567 trc2d(ji,jj,99) = trc2d(ji,jj,99) + f_omcal(ji,jj) !! ocean omega calcite 4568 trc2d(ji,jj,100) = trc2d(ji,jj,100) + f_omarg(ji,jj) !! ocean omega aragonite 4569 trc2d(ji,jj,101) = trc2d(ji,jj,101) + f_TDIC !! ocean TDIC 4570 trc2d(ji,jj,102) = trc2d(ji,jj,102) + f_TALK !! ocean TALK 4571 trc2d(ji,jj,103) = trc2d(ji,jj,103) + f_kw660 !! surface kw660 4572 trc2d(ji,jj,104) = trc2d(ji,jj,104) + f_pp0 !! surface pressure 4573 trc2d(ji,jj,105) = trc2d(ji,jj,105) + f_o2flux !! air-sea O2 flux 4574 trc2d(ji,jj,106) = trc2d(ji,jj,106) + f_o2sat !! ocean O2 saturation 4575 trc2d(ji,jj,107) = f2_ccd_cal(ji,jj) !! depth calcite CCD 4576 trc2d(ji,jj,108) = f2_ccd_arg(ji,jj) !! depth aragonite CCD 4577 endif 4578 if (jk .eq. jmbathy) then 4579 trc2d(ji,jj,109) = f3_omcal(ji,jj,jk) !! seafloor omega calcite 4580 trc2d(ji,jj,110) = f3_omarg(ji,jj,jk) !! seafloor omega aragonite 4581 endif 4582 !! diagnostic fields 111 to 117 calculated below 4583 if (jk.eq.i0100) trc2d(ji,jj,118) = ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall) !! rain ratio at 100 m 4584 if (jk.eq.i0500) trc2d(ji,jj,119) = ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall) !! rain ratio at 500 m 4585 if (jk.eq.i1000) trc2d(ji,jj,120) = ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall) !! rain ratio at 1000 m 4586 !! AXY (18/01/12): benthic flux diagnostics 4587 if (jk.eq.jmbathy) then 4588 trc2d(ji,jj,121) = f_sbenin_n(ji,jj) + f_fbenin_n(ji,jj) 4589 trc2d(ji,jj,122) = f_sbenin_fe(ji,jj) + f_fbenin_fe(ji,jj) 4590 trc2d(ji,jj,123) = f_sbenin_c(ji,jj) + f_fbenin_c(ji,jj) 4591 trc2d(ji,jj,124) = f_fbenin_si(ji,jj) 4592 trc2d(ji,jj,125) = f_fbenin_ca(ji,jj) 4593 trc2d(ji,jj,126) = f_benout_n(ji,jj) 4594 trc2d(ji,jj,127) = f_benout_fe(ji,jj) 4595 trc2d(ji,jj,128) = f_benout_c(ji,jj) 4596 trc2d(ji,jj,129) = f_benout_si(ji,jj) 4597 trc2d(ji,jj,130) = f_benout_ca(ji,jj) 4598 endif 4599 !! diagnostics fields 131 to 135 calculated below 4600 trc2d(ji,jj,136) = f_runoff(ji,jj) 4601 !! AXY (19/07/12): amended to allow for riverine nutrient addition below surface 4602 trc2d(ji,jj,137) = trc2d(ji,jj,137) + (f_riv_loc_n * fthk) 4603 trc2d(ji,jj,138) = trc2d(ji,jj,138) + (f_riv_loc_si * fthk) 4604 trc2d(ji,jj,139) = trc2d(ji,jj,139) + (f_riv_loc_c * fthk) 4605 trc2d(ji,jj,140) = trc2d(ji,jj,140) + (f_riv_loc_alk * fthk) 4606 trc2d(ji,jj,141) = trc2d(ji,jj,141) + (fslowc * fthk) !! slow sinking detritus C production 4607 if (jk.eq.i0100) trc2d(ji,jj,142) = fslowcflux(ji,jj) !! slow detritus flux at 100 m 4608 if (jk.eq.i0200) trc2d(ji,jj,143) = fslowcflux(ji,jj) !! slow detritus flux at 200 m 4609 if (jk.eq.i0500) trc2d(ji,jj,144) = fslowcflux(ji,jj) !! slow detritus flux at 500 m 4610 if (jk.eq.i1000) trc2d(ji,jj,145) = fslowcflux(ji,jj) !! slow detritus flux at 1000 m 4611 trc2d(ji,jj,146) = trc2d(ji,jj,146) + ftot_c(ji,jj) !! carbon inventory 4612 trc2d(ji,jj,147) = trc2d(ji,jj,147) + ftot_a(ji,jj) !! alkalinity inventory 4613 trc2d(ji,jj,148) = trc2d(ji,jj,148) + ftot_o2(ji,jj) !! oxygen inventory 4614 if (jk.eq.jmbathy) then 4615 trc2d(ji,jj,149) = f_benout_lyso_ca(ji,jj) 4616 endif 4617 trc2d(ji,jj,150) = fcomm_resp(ji,jj) * fthk !! community respiration 4618 !! 4619 !! AXY (14/02/14): a Valentines Day gift to BASIN - a shedload of new 4620 !! diagnostics that they'll most likely never need! 4621 !! (actually, as with all such gifts, I'm giving them 4622 !! some things I'd like myself!) 4623 !! 4624 !! ---------------------------------------------------------------------- 4625 !! linear losses 4626 !! non-diatom 4627 trc2d(ji,jj,151) = trc2d(ji,jj,151) + (fdpn2 * fthk) 4628 !! diatom 4629 trc2d(ji,jj,152) = trc2d(ji,jj,152) + (fdpd2 * fthk) 4630 !! microzooplankton 4631 trc2d(ji,jj,153) = trc2d(ji,jj,153) + (fdzmi2 * fthk) 4632 !! mesozooplankton 4633 trc2d(ji,jj,154) = trc2d(ji,jj,154) + (fdzme2 * fthk) 4634 !! ---------------------------------------------------------------------- 4635 !! microzooplankton grazing 4636 !! microzooplankton messy -> N 4637 trc2d(ji,jj,155) = trc2d(ji,jj,155) + (xphi * (fgmipn + fgmid) * fthk) 4638 !! microzooplankton messy -> D 4639 trc2d(ji,jj,156) = trc2d(ji,jj,156) + ((1. - xbetan) * finmi * fthk) 4640 !! microzooplankton messy -> DIC 4641 trc2d(ji,jj,157) = trc2d(ji,jj,157) + (xphi * ((xthetapn * fgmipn) + fgmidc) * fthk) 4642 !! microzooplankton messy -> Dc 4643 trc2d(ji,jj,158) = trc2d(ji,jj,158) + ((1. - xbetac) * ficmi * fthk) 4644 !! microzooplankton excretion 4645 trc2d(ji,jj,159) = trc2d(ji,jj,159) + (fmiexcr * fthk) 4646 !! microzooplankton respiration 4647 trc2d(ji,jj,160) = trc2d(ji,jj,160) + (fmiresp * fthk) 4648 !! microzooplankton growth 4649 trc2d(ji,jj,161) = trc2d(ji,jj,161) + (fmigrow * fthk) 4650 !! ---------------------------------------------------------------------- 4651 !! mesozooplankton grazing 4652 !! mesozooplankton messy -> N 4653 trc2d(ji,jj,162) = trc2d(ji,jj,162) + (xphi * (fgmepn + fgmepd + fgmezmi + fgmed) * fthk) 4654 !! mesozooplankton messy -> D 4655 trc2d(ji,jj,163) = trc2d(ji,jj,163) + ((1. - xbetan) * finme * fthk) 4656 !! mesozooplankton messy -> DIC 4657 trc2d(ji,jj,164) = trc2d(ji,jj,164) + (xphi * ((xthetapn * fgmepn) + (xthetapd * fgmepd) + & 4658 & (xthetazmi * fgmezmi) + fgmedc) * fthk) 4659 !! mesozooplankton messy -> Dc 4660 trc2d(ji,jj,165) = trc2d(ji,jj,165) + ((1. - xbetac) * ficme * fthk) 4661 !! mesozooplankton excretion 4662 trc2d(ji,jj,166) = trc2d(ji,jj,166) + (fmeexcr * fthk) 4663 !! mesozooplankton respiration 4664 trc2d(ji,jj,167) = trc2d(ji,jj,167) + (fmeresp * fthk) 4665 !! mesozooplankton growth 4666 trc2d(ji,jj,168) = trc2d(ji,jj,168) + (fmegrow * fthk) 4667 !! ---------------------------------------------------------------------- 4668 !! miscellaneous 4669 trc2d(ji,jj,169) = trc2d(ji,jj,169) + (fddc * fthk) !! detrital C remineralisation 4670 trc2d(ji,jj,170) = trc2d(ji,jj,170) + (fgmidc * fthk) !! microzoo grazing on detrital carbon 4671 trc2d(ji,jj,171) = trc2d(ji,jj,171) + (fgmedc * fthk) !! mesozoo grazing on detrital carbon 4672 !! 4673 !! ---------------------------------------------------------------------- 4674 !! 4675 !! AXY (23/10/14): extract primary production related surface fields to 4676 !! deal with diel cycle issues; hijacking BASIN 150m 4677 !! diagnostics to do so (see commented out diagnostics 4678 !! below this section) 4679 !! 4680 !! extract fields at surface 4681 !! if (jk .eq. 1) then 4682 !! trc2d(ji,jj,172) = zchn !! Pn chlorophyll 4683 !! trc2d(ji,jj,173) = zphn !! Pn biomass 4684 !! trc2d(ji,jj,174) = fjln !! Pn J-term 4685 !! trc2d(ji,jj,175) = (fprn * zphn) !! Pn PP 4686 !! trc2d(ji,jj,176) = zchd !! Pd chlorophyll 4687 !! trc2d(ji,jj,177) = zphd !! Pd biomass 4688 !! trc2d(ji,jj,178) = fjld !! Pd J-term 4689 !! trc2d(ji,jj,179) = xpar(ji,jj,jk) !! Pd PP 4690 !! trc2d(ji,jj,180) = loc_T !! local temperature 4691 !! endif 4692 !! !! 4693 !! !! extract fields at 50m (actually 44-50m) 4694 !! if (jk .eq. 18) then 4695 !! trc2d(ji,jj,181) = zchn !! Pn chlorophyll 4696 !! trc2d(ji,jj,182) = zphn !! Pn biomass 4697 !! trc2d(ji,jj,183) = fjln !! Pn J-term 4698 !! trc2d(ji,jj,184) = (fprn * zphn) !! Pn PP 4699 !! trc2d(ji,jj,185) = zchd !! Pd chlorophyll 4700 !! trc2d(ji,jj,186) = zphd !! Pd biomass 4701 !! trc2d(ji,jj,187) = fjld !! Pd J-term 4702 !! trc2d(ji,jj,188) = xpar(ji,jj,jk) !! Pd PP 4703 !! trc2d(ji,jj,189) = loc_T !! local temperature 4704 !! endif 4705 !! !! 4706 !! !! extract fields at 100m 4707 !! if (jk .eq. i0100) then 4708 !! trc2d(ji,jj,190) = zchn !! Pn chlorophyll 4709 !! trc2d(ji,jj,191) = zphn !! Pn biomass 4710 !! trc2d(ji,jj,192) = fjln !! Pn J-term 4711 !! trc2d(ji,jj,193) = (fprn * zphn) !! Pn PP 4712 !! trc2d(ji,jj,194) = zchd !! Pd chlorophyll 4713 !! trc2d(ji,jj,195) = zphd !! Pd biomass 4714 !! trc2d(ji,jj,196) = fjld !! Pd J-term 4715 !! trc2d(ji,jj,197) = xpar(ji,jj,jk) !! Pd PP 4716 !! trc2d(ji,jj,198) = loc_T !! local temperature 4717 !! endif 4718 !! 4719 !! extract relevant BASIN fields at 150m 4720 if (jk .eq. i0150) then 4721 trc2d(ji,jj,172) = trc2d(ji,jj,4) !! Pn PP 4722 trc2d(ji,jj,173) = trc2d(ji,jj,151) !! Pn linear loss 4723 trc2d(ji,jj,174) = trc2d(ji,jj,5) !! Pn non-linear loss 4724 trc2d(ji,jj,175) = trc2d(ji,jj,11) !! Pn grazing to Zmi 4725 trc2d(ji,jj,176) = trc2d(ji,jj,14) !! Pn grazing to Zme 4726 trc2d(ji,jj,177) = trc2d(ji,jj,6) !! Pd PP 4727 trc2d(ji,jj,178) = trc2d(ji,jj,152) !! Pd linear loss 4728 trc2d(ji,jj,179) = trc2d(ji,jj,7) !! Pd non-linear loss 4729 trc2d(ji,jj,180) = trc2d(ji,jj,15) !! Pd grazing to Zme 4730 trc2d(ji,jj,181) = trc2d(ji,jj,12) !! Zmi grazing on D 4731 trc2d(ji,jj,182) = trc2d(ji,jj,170) !! Zmi grazing on Dc 4732 trc2d(ji,jj,183) = trc2d(ji,jj,155) !! Zmi messy feeding loss to N 4733 trc2d(ji,jj,184) = trc2d(ji,jj,156) !! Zmi messy feeding loss to D 4734 trc2d(ji,jj,185) = trc2d(ji,jj,157) !! Zmi messy feeding loss to DIC 4735 trc2d(ji,jj,186) = trc2d(ji,jj,158) !! Zmi messy feeding loss to Dc 4736 trc2d(ji,jj,187) = trc2d(ji,jj,159) !! Zmi excretion 4737 trc2d(ji,jj,188) = trc2d(ji,jj,160) !! Zmi respiration 4738 trc2d(ji,jj,189) = trc2d(ji,jj,161) !! Zmi growth 4739 trc2d(ji,jj,190) = trc2d(ji,jj,153) !! Zmi linear loss 4740 trc2d(ji,jj,191) = trc2d(ji,jj,13) !! Zmi non-linear loss 4741 trc2d(ji,jj,192) = trc2d(ji,jj,16) !! Zmi grazing to Zme 4742 trc2d(ji,jj,193) = trc2d(ji,jj,17) !! Zme grazing on D 4743 trc2d(ji,jj,194) = trc2d(ji,jj,171) !! Zme grazing on Dc 4744 trc2d(ji,jj,195) = trc2d(ji,jj,162) !! Zme messy feeding loss to N 4745 trc2d(ji,jj,196) = trc2d(ji,jj,163) !! Zme messy feeding loss to D 4746 trc2d(ji,jj,197) = trc2d(ji,jj,164) !! Zme messy feeding loss to DIC 4747 trc2d(ji,jj,198) = trc2d(ji,jj,165) !! Zme messy feeding loss to Dc 4748 trc2d(ji,jj,199) = trc2d(ji,jj,166) !! Zme excretion 4749 trc2d(ji,jj,200) = trc2d(ji,jj,167) !! Zme respiration 4750 trc2d(ji,jj,201) = trc2d(ji,jj,168) !! Zme growth 4751 trc2d(ji,jj,202) = trc2d(ji,jj,154) !! Zme linear loss 4752 trc2d(ji,jj,203) = trc2d(ji,jj,18) !! Zme non-linear loss 4753 trc2d(ji,jj,204) = trc2d(ji,jj,20) !! Slow detritus production, N 4754 trc2d(ji,jj,205) = trc2d(ji,jj,21) !! Slow detritus remineralisation, N 4755 trc2d(ji,jj,206) = trc2d(ji,jj,141) !! Slow detritus production, C 4756 trc2d(ji,jj,207) = trc2d(ji,jj,169) !! Slow detritus remineralisation, C 4757 trc2d(ji,jj,208) = trc2d(ji,jj,43) !! Fast detritus production, N 4758 trc2d(ji,jj,209) = trc2d(ji,jj,21) !! Fast detritus remineralisation, N 4759 trc2d(ji,jj,210) = trc2d(ji,jj,64) !! Fast detritus production, C 4760 trc2d(ji,jj,211) = trc2d(ji,jj,67) !! Fast detritus remineralisation, C 4761 trc2d(ji,jj,212) = trc2d(ji,jj,150) !! Community respiration 4762 trc2d(ji,jj,213) = fslownflux(ji,jj) !! Slow detritus N flux at 150 m 4763 trc2d(ji,jj,214) = fslowcflux(ji,jj) !! Slow detritus C flux at 150 m 4764 trc2d(ji,jj,215) = ffastn(ji,jj) !! Fast detritus N flux at 150 m 4765 trc2d(ji,jj,216) = ffastc(ji,jj) !! Fast detritus C flux at 150 m 4766 endif 4767 !! 4768 !! Jpalm (11-08-2014) 4769 !! Add UKESM1 diagnoatics 4770 !!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ 4771 if ((jk .eq. 1) .and.( jdms.eq.1)) then 4772 trc2d(ji,jj,221) = dms_surf !! DMS surface concentration 4773 !! AXY (13/03/15): add in other DMS estimates 4774 trc2d(ji,jj,222) = dms_andr !! DMS surface concentration 4775 trc2d(ji,jj,223) = dms_simo !! DMS surface concentration 4776 trc2d(ji,jj,224) = dms_aran !! DMS surface concentration 4777 trc2d(ji,jj,225) = dms_hall !! DMS surface concentration 4778 endif 4779 # endif 4780 !! other possible future diagnostics include: 4781 !! - integrated tracer values (esp. biological) 4782 !! - mixed layer tracer values 4783 !! - sub-surface chlorophyll maxima (plus depth) 4784 !! - different mixed layer depth criteria (T, sigma, var. sigma) 4785 4786 !!---------------------------------------------------------------------- 4787 !! Prepare 3D diagnostics 4788 !!---------------------------------------------------------------------- 4789 !! 4790 trc3d(ji,jj,jk,1) = ((fprn + fprd) * zphn) !! primary production 4791 trc3d(ji,jj,jk,2) = fslownflux(ji,jj) + ffastn(ji,jj) !! detrital flux 4792 trc3d(ji,jj,jk,3) = fregen + (freminn * fthk) !! remineralisation 4793 # if defined key_roam 4794 trc3d(ji,jj,jk,4) = f3_pH(ji,jj,jk) !! pH 4795 trc3d(ji,jj,jk,5) = f3_omcal(ji,jj,jk) !! omega calcite 4796 # else 4797 trc3d(ji,jj,jk,4) = ffastsi(ji,jj) !! fast Si flux 4798 # endif 4799 ENDIF ! end of ln_diatrc option 4800 !! CLOSE wet point IF..THEN loop 4801 endif 4802 !! CLOSE horizontal loops 4803 ENDDO 4804 ENDDO 4805 !! 4806 IF( lk_iomput .AND. .NOT. ln_diatrc ) THEN 4807 !! first - 2D diag implemented 4808 !! on every K level 4809 !!----------------------------------------- 4810 !! -- 4811 !!second - 2d specific k level diags 4812 !! 4813 !!----------------------------------------- 4814 IF (jk.eq.1) THEN 4815 # if defined key_debug_medusa 4816 IF (lwp) write (numout,*) 'trc_bio_medusa: diag jk = 1' 4817 CALL flush(numout) 4818 # endif 4819 !! JPALM -- 02-06-2017 -- 4820 !! add Chl surf coupling 4821 !! no need to output, just pass to cpl var 4822 IF (lk_oasis) THEN 4823 zn_chl_srf(:,:) = (trn(:,:,1,jpchd) + trn(:,:,1,jpchn)) * 1.0E-6 !! surf Chl in Kg-chl/m3 as needed for cpl 4824 chloro_out_cpl(:,:) = zn_chl_srf(:,:) !! Coupling Chl 4825 END IF 4826 IF( med_diag%MED_QSR%dgsave ) THEN 4827 CALL iom_put( "MED_QSR" , qsr ) ! 4828 ENDIF 4829 IF( med_diag%MED_XPAR%dgsave ) THEN 4830 CALL iom_put( "MED_XPAR" , xpar(:,:,jk) ) ! 4831 ENDIF 4832 IF( med_diag%OCAL_CCD%dgsave ) THEN 4833 CALL iom_put( "OCAL_CCD" , ocal_ccd ) ! 4834 ENDIF 4835 IF( med_diag%FE_0000%dgsave ) THEN 4836 CALL iom_put( "FE_0000" , xFree ) ! 4837 ENDIF 4838 IF( med_diag%MED_XZE%dgsave ) THEN 4839 CALL iom_put( "MED_XZE" , xze ) ! 4840 ENDIF 4841 # if defined key_roam 4842 IF( med_diag%WIND%dgsave ) THEN 4843 CALL iom_put( "WIND" , wndm ) 4844 ENDIF 4845 IF( med_diag%ATM_PCO2%dgsave ) THEN 4846 CALL iom_put( "ATM_PCO2" , f_pco2a2d ) 4847 CALL wrk_dealloc( jpi, jpj, f_pco2a2d ) 4848 ENDIF 4849 IF( med_diag%OCN_PH%dgsave ) THEN 4850 zw2d(:,:) = f3_pH(:,:,jk) 4851 CALL iom_put( "OCN_PH" , zw2d ) 4852 ENDIF 4853 IF( med_diag%OCN_PCO2%dgsave ) THEN 4854 CALL iom_put( "OCN_PCO2" , f_pco2w2d ) 4855 CALL wrk_dealloc( jpi, jpj, f_pco2w2d ) 4856 ENDIF 4857 IF( med_diag%OCNH2CO3%dgsave ) THEN 4858 zw2d(:,:) = f3_h2co3(:,:,jk) 4859 CALL iom_put( "OCNH2CO3" , zw2d ) 4860 ENDIF 4861 IF( med_diag%OCN_HCO3%dgsave ) THEN 4862 zw2d(:,:) = f3_hco3(:,:,jk) 4863 CALL iom_put( "OCN_HCO3" , zw2d ) 4864 ENDIF 4865 IF( med_diag%OCN_CO3%dgsave ) THEN 4866 zw2d(:,:) = f3_co3(:,:,jk) 4867 CALL iom_put( "OCN_CO3" , zw2d ) 4868 ENDIF 4869 IF( med_diag%CO2FLUX%dgsave ) THEN 4870 CALL iom_put( "CO2FLUX" , f_co2flux2d ) 4871 CALL wrk_dealloc( jpi, jpj, f_co2flux2d ) 4872 ENDIF 4873 !! 4874 !! AXY (10/11/16): repeat CO2 flux diagnostic in UKMO/CMIP6 units; this 4875 !! both outputs the CO2 flux in specified units and 4876 !! sends the resulting field to the coupler 4877 !! JPALM (17/11/16): put CO2 flux (fgco2) alloc/unalloc/pass to zn 4878 !! out of diag list request 4879 CALL lbc_lnk( fgco2(:,:),'T',1. ) 4880 IF( med_diag%FGCO2%dgsave ) THEN 4881 CALL iom_put( "FGCO2" , fgco2 ) 4882 ENDIF 4883 !! JPALM (17/11/16): should mv this fgco2 part 4884 !! out of lk_iomput loop 4885 zb_co2_flx = zn_co2_flx 4886 zn_co2_flx = fgco2 4887 IF (lk_oasis) THEN 4888 CO2Flux_out_cpl = zn_co2_flx 4889 ENDIF 4890 CALL wrk_dealloc( jpi, jpj, fgco2 ) 4891 !! --- 4892 IF( med_diag%OM_CAL%dgsave ) THEN 4893 CALL iom_put( "OM_CAL" , f_omcal ) 4894 ENDIF 4895 IF( med_diag%OM_ARG%dgsave ) THEN 4896 CALL iom_put( "OM_ARG" , f_omarg ) 4897 ENDIF 4898 IF( med_diag%TCO2%dgsave ) THEN 4899 CALL iom_put( "TCO2" , f_TDIC2d ) 4900 CALL wrk_dealloc( jpi, jpj, f_TDIC2d ) 4901 ENDIF 4902 IF( med_diag%TALK%dgsave ) THEN 4903 CALL iom_put( "TALK" , f_TALK2d ) 4904 CALL wrk_dealloc( jpi, jpj, f_TALK2d ) 4905 ENDIF 4906 IF( med_diag%KW660%dgsave ) THEN 4907 CALL iom_put( "KW660" , f_kw6602d ) 4908 CALL wrk_dealloc( jpi, jpj, f_kw6602d ) 4909 ENDIF 4910 IF( med_diag%ATM_PP0%dgsave ) THEN 4911 CALL iom_put( "ATM_PP0" , f_pp02d ) 4912 CALL wrk_dealloc( jpi, jpj, f_pp02d ) 4913 ENDIF 4914 IF( med_diag%O2FLUX%dgsave ) THEN 4915 CALL iom_put( "O2FLUX" , f_o2flux2d ) 4916 CALL wrk_dealloc( jpi, jpj, f_o2flux2d ) 4917 ENDIF 4918 IF( med_diag%O2SAT%dgsave ) THEN 4919 CALL iom_put( "O2SAT" , f_o2sat2d ) 4920 CALL wrk_dealloc( jpi, jpj, f_o2sat2d ) 4921 ENDIF 4922 IF( med_diag%CAL_CCD%dgsave ) THEN 4923 CALL iom_put( "CAL_CCD" , f2_ccd_cal ) 4924 ENDIF 4925 IF( med_diag%ARG_CCD%dgsave ) THEN 4926 CALL iom_put( "ARG_CCD" , f2_ccd_arg ) 4927 ENDIF 4928 IF (jdms .eq. 1) THEN 4929 IF( med_diag%DMS_SURF%dgsave ) THEN 4930 CALL lbc_lnk(dms_surf2d(:,:),'T',1. ) 4931 CALL iom_put( "DMS_SURF" , dms_surf2d ) 4932 zb_dms_srf = zn_dms_srf 4933 zn_dms_srf = dms_surf2d 4934 IF (lk_oasis) THEN 4935 DMS_out_cpl = zn_dms_srf 4936 ENDIF 4937 CALL wrk_dealloc( jpi, jpj, dms_surf2d ) 4938 ENDIF 4939 IF( med_diag%DMS_ANDR%dgsave ) THEN 4940 CALL iom_put( "DMS_ANDR" , dms_andr2d ) 4941 CALL wrk_dealloc( jpi, jpj, dms_andr2d ) 4942 ENDIF 4943 IF( med_diag%DMS_SIMO%dgsave ) THEN 4944 CALL iom_put( "DMS_SIMO" , dms_simo2d ) 4945 CALL wrk_dealloc( jpi, jpj, dms_simo2d ) 4946 ENDIF 4947 IF( med_diag%DMS_ARAN%dgsave ) THEN 4948 CALL iom_put( "DMS_ARAN" , dms_aran2d ) 4949 CALL wrk_dealloc( jpi, jpj, dms_aran2d ) 4950 ENDIF 4951 IF( med_diag%DMS_HALL%dgsave ) THEN 4952 CALL iom_put( "DMS_HALL" , dms_hall2d ) 4953 CALL wrk_dealloc( jpi, jpj, dms_hall2d ) 4954 ENDIF 4955 IF( med_diag%DMS_ANDM%dgsave ) THEN 4956 CALL iom_put( "DMS_ANDM" , dms_andm2d ) 4957 CALL wrk_dealloc( jpi, jpj, dms_andm2d ) 4958 ENDIF 4959 ENDIF 4960 !! AXY (24/11/16): extra MOCSY diagnostics 4961 IF( med_diag%ATM_XCO2%dgsave ) THEN 4962 CALL iom_put( "ATM_XCO2" , f_xco2a_2d ) 4963 CALL wrk_dealloc( jpi, jpj, f_xco2a_2d ) 4964 ENDIF 4965 IF( med_diag%OCN_FCO2%dgsave ) THEN 4966 CALL iom_put( "OCN_FCO2" , f_fco2w_2d ) 4967 CALL wrk_dealloc( jpi, jpj, f_fco2w_2d ) 4968 ENDIF 4969 IF( med_diag%ATM_FCO2%dgsave ) THEN 4970 CALL iom_put( "ATM_FCO2" , f_fco2a_2d ) 4971 CALL wrk_dealloc( jpi, jpj, f_fco2a_2d ) 4972 ENDIF 4973 IF( med_diag%OCN_RHOSW%dgsave ) THEN 4974 CALL iom_put( "OCN_RHOSW" , f_ocnrhosw_2d ) 4975 CALL wrk_dealloc( jpi, jpj, f_ocnrhosw_2d ) 4976 ENDIF 4977 IF( med_diag%OCN_SCHCO2%dgsave ) THEN 4978 CALL iom_put( "OCN_SCHCO2" , f_ocnschco2_2d ) 4979 CALL wrk_dealloc( jpi, jpj, f_ocnschco2_2d ) 4980 ENDIF 4981 IF( med_diag%OCN_KWCO2%dgsave ) THEN 4982 CALL iom_put( "OCN_KWCO2" , f_ocnkwco2_2d ) 4983 CALL wrk_dealloc( jpi, jpj, f_ocnkwco2_2d ) 4984 ENDIF 4985 IF( med_diag%OCN_K0%dgsave ) THEN 4986 CALL iom_put( "OCN_K0" , f_ocnk0_2d ) 4987 CALL wrk_dealloc( jpi, jpj, f_ocnk0_2d ) 4988 ENDIF 4989 IF( med_diag%CO2STARAIR%dgsave ) THEN 4990 CALL iom_put( "CO2STARAIR" , f_co2starair_2d ) 4991 CALL wrk_dealloc( jpi, jpj, f_co2starair_2d ) 4992 ENDIF 4993 IF( med_diag%OCN_DPCO2%dgsave ) THEN 4994 CALL iom_put( "OCN_DPCO2" , f_ocndpco2_2d ) 4995 CALL wrk_dealloc( jpi, jpj, f_ocndpco2_2d ) 4996 ENDIF 4997 # endif 4998 ELSE IF (jk.eq.i0100) THEN 4999 # if defined key_debug_medusa 5000 IF (lwp) write (numout,*) 'trc_bio_medusa: diag jk = 100' 5001 CALL flush(numout) 5002 # endif 5003 IF( med_diag%SDT__100%dgsave ) THEN 5004 zw2d(:,:) = fslownflux(:,:) * tmask(:,:,jk) 5005 CALL iom_put( "SDT__100" , zw2d ) 5006 ENDIF 5007 IF( med_diag%REG__100%dgsave ) THEN 5008 CALL iom_put( "REG__100" , fregen2d ) 5009 ENDIF 5010 IF( med_diag%FDT__100%dgsave ) THEN 5011 CALL iom_put( "FDT__100" , ffastn ) 5012 ENDIF 5013 IF( med_diag%RG__100F%dgsave ) THEN 5014 CALL iom_put( "RG__100F" , fregenfast ) 5015 ENDIF 5016 IF( med_diag%FDS__100%dgsave ) THEN 5017 CALL iom_put( "FDS__100" , ffastsi ) 5018 ENDIF 5019 IF( med_diag%RGS_100F%dgsave ) THEN 5020 CALL iom_put( "RGS_100F" , fregenfastsi ) 5021 ENDIF 5022 IF( med_diag%FE_0100%dgsave ) THEN 5023 CALL iom_put( "FE_0100" , xFree ) 5024 ENDIF 5025 # if defined key_roam 5026 IF( med_diag%RR_0100%dgsave ) THEN 5027 CALL iom_put( "RR_0100" , ffastca2d ) 5028 ENDIF 5029 IF( med_diag%SDC__100%dgsave ) THEN 5030 zw2d(:,:) = fslowcflux(:,:) * tmask(:,:,jk) 5031 CALL iom_put( "SDC__100" , zw2d ) 5032 ENDIF 5033 IF( med_diag%epC100%dgsave ) THEN 5034 zw2d(:,:) = (fslowcflux + ffastc) * tmask(:,:,jk) 5035 CALL iom_put( "epC100" , zw2d ) 5036 ENDIF 5037 IF( med_diag%epCALC100%dgsave ) THEN 5038 CALL iom_put( "epCALC100" , ffastca ) 5039 ENDIF 5040 IF( med_diag%epN100%dgsave ) THEN 5041 zw2d(:,:) = (fslownflux + ffastn) * tmask(:,:,jk) 5042 CALL iom_put( "epN100" , zw2d ) 5043 ENDIF 5044 IF( med_diag%epSI100%dgsave ) THEN 5045 CALL iom_put( "epSI100" , ffastsi ) 5046 ENDIF 5047 ELSE IF (jk.eq.i0150) THEN 5048 # if defined key_debug_medusa 5049 IF (lwp) write (numout,*) 'trc_bio_medusa: diag jk = 150' 5050 CALL flush(numout) 5051 # endif 5052 # endif 5053 ELSE IF (jk.eq.i0200) THEN 5054 # if defined key_debug_medusa 5055 IF (lwp) write (numout,*) 'trc_bio_medusa: diag jk = 200' 5056 CALL flush(numout) 5057 # endif 5058 IF( med_diag%SDT__200%dgsave ) THEN 5059 zw2d(:,:) = fslownflux(:,:) * tmask(:,:,jk) 5060 CALL iom_put( "SDT__200" , zw2d ) 5061 ENDIF 5062 IF( med_diag%REG__200%dgsave ) THEN 5063 CALL iom_put( "REG__200" , fregen2d ) 5064 ENDIF 5065 IF( med_diag%FDT__200%dgsave ) THEN 5066 CALL iom_put( "FDT__200" , ffastn ) 5067 ENDIF 5068 IF( med_diag%RG__200F%dgsave ) THEN 5069 CALL iom_put( "RG__200F" , fregenfast ) 5070 ENDIF 5071 IF( med_diag%FDS__200%dgsave ) THEN 5072 CALL iom_put( "FDS__200" , ffastsi ) 5073 ENDIF 5074 IF( med_diag%RGS_200F%dgsave ) THEN 5075 CALL iom_put( "RGS_200F" , fregenfastsi ) 5076 ENDIF 5077 IF( med_diag%FE_0200%dgsave ) THEN 5078 CALL iom_put( "FE_0200" , xFree ) 5079 ENDIF 5080 # if defined key_roam 5081 IF( med_diag%SDC__200%dgsave ) THEN 5082 zw2d(:,:) = fslowcflux(:,:) * tmask(:,:,jk) 5083 CALL iom_put( "SDC__200" , zw2d ) 5084 ENDIF 5085 # endif 5086 ELSE IF (jk.eq.i0500) THEN 5087 # if defined key_debug_medusa 5088 IF (lwp) write (numout,*) 'trc_bio_medusa: diag jk = 500' 5089 CALL flush(numout) 5090 # endif 5091 IF( med_diag%SDT__500%dgsave ) THEN 5092 zw2d(:,:) = fslownflux(:,:) * tmask(:,:,jk) 5093 CALL iom_put( "SDT__500" , zw2d ) 5094 ENDIF 5095 IF( med_diag%REG__500%dgsave ) THEN 5096 CALL iom_put( "REG__500" , fregen2d ) 5097 ENDIF 5098 IF( med_diag%FDT__500%dgsave ) THEN 5099 CALL iom_put( "FDT__500" , ffastn ) 5100 ENDIF 5101 IF( med_diag%RG__500F%dgsave ) THEN 5102 CALL iom_put( "RG__500F" , fregenfast ) 5103 ENDIF 5104 IF( med_diag%FDS__500%dgsave ) THEN 5105 CALL iom_put( "FDS__500" , ffastsi ) 5106 ENDIF 5107 IF( med_diag%RGS_500F%dgsave ) THEN 5108 CALL iom_put( "RGS_500F" , fregenfastsi ) 5109 ENDIF 5110 IF( med_diag%FE_0500%dgsave ) THEN 5111 CALL iom_put( "FE_0500" , xFree ) 5112 ENDIF 5113 # if defined key_roam 5114 IF( med_diag%RR_0500%dgsave ) THEN 5115 CALL iom_put( "RR_0500" , ffastca2d ) 5116 ENDIF 5117 IF( med_diag%SDC__500%dgsave ) THEN 5118 zw2d(:,:) = fslowcflux(:,:) * tmask(:,:,jk) 5119 CALL iom_put( "SDC__500" , zw2d ) 5120 ENDIF 5121 # endif 5122 ELSE IF (jk.eq.i1000) THEN 5123 # if defined key_debug_medusa 5124 IF (lwp) write (numout,*) 'trc_bio_medusa: diag jk = 1000' 5125 CALL flush(numout) 5126 # endif 5127 IF( med_diag%SDT_1000%dgsave ) THEN 5128 zw2d(:,:) = fslownflux(:,:) * tmask(:,:,jk) 5129 CALL iom_put( "SDT_1000" , zw2d ) 5130 ENDIF 5131 IF( med_diag%REG_1000%dgsave ) THEN 5132 CALL iom_put( "REG_1000" , fregen2d ) 5133 ENDIF 5134 IF( med_diag%FDT_1000%dgsave ) THEN 5135 CALL iom_put( "FDT_1000" , ffastn ) 5136 ENDIF 5137 IF( med_diag%RG_1000F%dgsave ) THEN 5138 CALL iom_put( "RG_1000F" , fregenfast ) 5139 ENDIF 5140 IF( med_diag%FDS_1000%dgsave ) THEN 5141 CALL iom_put( "FDS_1000" , ffastsi ) 5142 ENDIF 5143 IF( med_diag%RGS1000F%dgsave ) THEN 5144 CALL iom_put( "RGS1000F" , fregenfastsi ) 5145 ENDIF 5146 IF( med_diag%FE_1000%dgsave ) THEN 5147 CALL iom_put( "FE_1000" , xFree ) 5148 ENDIF 5149 # if defined key_roam 5150 IF( med_diag%RR_1000%dgsave ) THEN 5151 CALL iom_put( "RR_1000" , ffastca2d ) 5152 CALL wrk_dealloc( jpi, jpj, ffastca2d ) 5153 ENDIF 5154 IF( med_diag%SDC_1000%dgsave ) THEN 5155 zw2d(:,:) = fslowcflux(:,:) * tmask(:,:,jk) 5156 CALL iom_put( "SDC_1000" , zw2d ) 5157 ENDIF 5158 # endif 5159 ENDIF 5160 !! to do on every k loop : 5161 IF( med_diag%DETFLUX3%dgsave ) THEN 5162 detflux3d(:,:,jk) = (fslownflux(:,:) + ffastn(:,:)) * tmask(:,:,jk) !! detrital flux 5163 !CALL iom_put( "DETFLUX3" , ftot_n ) 5164 ENDIF 5165 # if defined key_roam 5166 IF( med_diag%EXPC3%dgsave ) THEN 5167 expc3(:,:,jk) = (fslowcflux(:,:) + ffastc(:,:)) * tmask(:,:,jk) 5168 ENDIF 5169 IF( med_diag%EXPN3%dgsave ) THEN 5170 expn3(:,:,jk) = (fslownflux(:,:) + ffastn(:,:)) * tmask(:,:,jk) 5171 ENDIF 5172 # endif 5173 ENDIF 5174 !! CLOSE vertical loop 5175 ENDDO 5176 5177 !!---------------------------------------------------------------------- 5178 !! Process benthic in/out fluxes 5179 !! These can be handled outside of the 3D calculations since the 5180 !! benthic pools (and fluxes) are 2D in nature; this code is 5181 !! (shamelessly) borrowed from corresponding code in the LOBSTER 5182 !! model 5183 !!---------------------------------------------------------------------- 5184 !! 5185 !! IF(lwp) WRITE(numout,*) 'AXY: rdt = ', rdt 5186 if (jorgben.eq.1) then 5187 za_sed_n(:,:) = zn_sed_n(:,:) + & 5188 & ( f_sbenin_n(:,:) + f_fbenin_n(:,:) - f_benout_n(:,:) ) * (rdt / 86400.) 5189 zn_sed_n(:,:) = za_sed_n(:,:) 5190 !! 5191 za_sed_fe(:,:) = zn_sed_fe(:,:) + & 5192 & ( f_sbenin_fe(:,:) + f_fbenin_fe(:,:) - f_benout_fe(:,:) ) * (rdt / 86400.) 5193 zn_sed_fe(:,:) = za_sed_fe(:,:) 5194 !! 5195 za_sed_c(:,:) = zn_sed_c(:,:) + & 5196 & ( f_sbenin_c(:,:) + f_fbenin_c(:,:) - f_benout_c(:,:) ) * (rdt / 86400.) 5197 zn_sed_c(:,:) = za_sed_c(:,:) 5198 endif 5199 if (jinorgben.eq.1) then 5200 za_sed_si(:,:) = zn_sed_si(:,:) + & 5201 & ( f_fbenin_si(:,:) - f_benout_si(:,:) ) * (rdt / 86400.) 5202 zn_sed_si(:,:) = za_sed_si(:,:) 5203 !! 5204 za_sed_ca(:,:) = zn_sed_ca(:,:) + & 5205 & ( f_fbenin_ca(:,:) - f_benout_ca(:,:) ) * (rdt / 86400.) 5206 zn_sed_ca(:,:) = za_sed_ca(:,:) 5207 endif 5208 IF( ln_diatrc ) THEN 5209 DO jj = 2,jpjm1 5210 DO ji = 2,jpim1 5211 trc2d(ji,jj,131) = za_sed_n(ji,jj) 5212 trc2d(ji,jj,132) = za_sed_fe(ji,jj) 5213 trc2d(ji,jj,133) = za_sed_c(ji,jj) 5214 trc2d(ji,jj,134) = za_sed_si(ji,jj) 5215 trc2d(ji,jj,135) = za_sed_ca(ji,jj) 5216 ENDDO 5217 ENDDO 5218 !! AXY (07/07/15): temporary hijacking 5219 # if defined key_roam 5220 !! trc2d(:,:,126) = zn_dms_chn(:,:) 5221 !! trc2d(:,:,127) = zn_dms_chd(:,:) 5222 !! trc2d(:,:,128) = zn_dms_mld(:,:) 5223 !! trc2d(:,:,129) = zn_dms_qsr(:,:) 5224 !! trc2d(:,:,130) = zn_dms_din(:,:) 5225 # endif 5226 ENDIF 5227 !! 5228 if (ibenthic.eq.2) then 5229 !! The code below (in this if ... then ... endif loop) is 5230 !! effectively commented out because it does not work as 5231 !! anticipated; it can be deleted at a later date 5232 if (jorgben.eq.1) then 5233 za_sed_n(:,:) = ( f_sbenin_n(:,:) + f_fbenin_n(:,:) - f_benout_n(:,:) ) * rdt 5234 za_sed_fe(:,:) = ( f_sbenin_fe(:,:) + f_fbenin_fe(:,:) - f_benout_fe(:,:) ) * rdt 5235 za_sed_c(:,:) = ( f_sbenin_c(:,:) + f_fbenin_c(:,:) - f_benout_c(:,:) ) * rdt 5236 endif 5237 if (jinorgben.eq.1) then 5238 za_sed_si(:,:) = ( f_fbenin_si(:,:) - f_benout_si(:,:) ) * rdt 5239 za_sed_ca(:,:) = ( f_fbenin_ca(:,:) - f_benout_ca(:,:) ) * rdt 5240 endif 5241 !! 5242 !! Leap-frog scheme - only in explicit case, otherwise the time stepping 5243 !! is already being done in trczdf 5244 !! IF( l_trczdf_exp .AND. (ln_trcadv_cen2 .OR. ln_trcadv_tvd) ) THEN 5245 !! zfact = 2. * rdttra(jk) * FLOAT( ndttrc ) 5246 !! IF( neuler == 0 .AND. kt == nittrc000 ) zfact = rdttra(jk) * FLOAT(ndttrc) 5247 !! if (jorgben.eq.1) then 5248 !! za_sed_n(:,:) = zb_sed_n(:,:) + ( zfact * za_sed_n(:,:) ) 5249 !! za_sed_fe(:,:) = zb_sed_fe(:,:) + ( zfact * za_sed_fe(:,:) ) 5250 !! za_sed_c(:,:) = zb_sed_c(:,:) + ( zfact * za_sed_c(:,:) ) 5251 !! endif 5252 !! if (jinorgben.eq.1) then 5253 !! za_sed_si(:,:) = zb_sed_si(:,:) + ( zfact * za_sed_si(:,:) ) 5254 !! za_sed_ca(:,:) = zb_sed_ca(:,:) + ( zfact * za_sed_ca(:,:) ) 5255 !! endif 5256 !! ENDIF 5257 !! 5258 !! Time filter and swap of arrays 5259 IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd ) THEN ! centred or tvd scheme 5260 IF( neuler == 0 .AND. kt == nittrc000 ) THEN 5261 if (jorgben.eq.1) then 5262 zb_sed_n(:,:) = zn_sed_n(:,:) 5263 zn_sed_n(:,:) = za_sed_n(:,:) 5264 za_sed_n(:,:) = 0.0 5265 !! 5266 zb_sed_fe(:,:) = zn_sed_fe(:,:) 5267 zn_sed_fe(:,:) = za_sed_fe(:,:) 5268 za_sed_fe(:,:) = 0.0 5269 !! 5270 zb_sed_c(:,:) = zn_sed_c(:,:) 5271 zn_sed_c(:,:) = za_sed_c(:,:) 5272 za_sed_c(:,:) = 0.0 5273 endif 5274 if (jinorgben.eq.1) then 5275 zb_sed_si(:,:) = zn_sed_si(:,:) 5276 zn_sed_si(:,:) = za_sed_si(:,:) 5277 za_sed_si(:,:) = 0.0 5278 !! 5279 zb_sed_ca(:,:) = zn_sed_ca(:,:) 5280 zn_sed_ca(:,:) = za_sed_ca(:,:) 5281 za_sed_ca(:,:) = 0.0 5282 endif 5283 ELSE 5284 if (jorgben.eq.1) then 5285 zb_sed_n(:,:) = (atfp * ( zb_sed_n(:,:) + za_sed_n(:,:) )) + (atfp1 * zn_sed_n(:,:) ) 5286 zn_sed_n(:,:) = za_sed_n(:,:) 5287 za_sed_n(:,:) = 0.0 5288 !! 5289 zb_sed_fe(:,:) = (atfp * ( zb_sed_fe(:,:) + za_sed_fe(:,:) )) + (atfp1 * zn_sed_fe(:,:)) 5290 zn_sed_fe(:,:) = za_sed_fe(:,:) 5291 za_sed_fe(:,:) = 0.0 5292 !! 5293 zb_sed_c(:,:) = (atfp * ( zb_sed_c(:,:) + za_sed_c(:,:) )) + (atfp1 * zn_sed_c(:,:) ) 5294 zn_sed_c(:,:) = za_sed_c(:,:) 5295 za_sed_c(:,:) = 0.0 5296 endif 5297 if (jinorgben.eq.1) then 5298 zb_sed_si(:,:) = (atfp * ( zb_sed_si(:,:) + za_sed_si(:,:) )) + (atfp1 * zn_sed_si(:,:)) 5299 zn_sed_si(:,:) = za_sed_si(:,:) 5300 za_sed_si(:,:) = 0.0 5301 !! 5302 zb_sed_ca(:,:) = (atfp * ( zb_sed_ca(:,:) + za_sed_ca(:,:) )) + (atfp1 * zn_sed_ca(:,:)) 5303 zn_sed_ca(:,:) = za_sed_ca(:,:) 5304 za_sed_ca(:,:) = 0.0 5305 endif 5306 ENDIF 5307 ELSE ! case of smolar scheme or muscl 5308 if (jorgben.eq.1) then 5309 zb_sed_n(:,:) = za_sed_n(:,:) 5310 zn_sed_n(:,:) = za_sed_n(:,:) 5311 za_sed_n(:,:) = 0.0 5312 !! 5313 zb_sed_fe(:,:) = za_sed_fe(:,:) 5314 zn_sed_fe(:,:) = za_sed_fe(:,:) 5315 za_sed_fe(:,:) = 0.0 5316 !! 5317 zb_sed_c(:,:) = za_sed_c(:,:) 5318 zn_sed_c(:,:) = za_sed_c(:,:) 5319 za_sed_c(:,:) = 0.0 5320 endif 5321 if (jinorgben.eq.1) then 5322 zb_sed_si(:,:) = za_sed_si(:,:) 5323 zn_sed_si(:,:) = za_sed_si(:,:) 5324 za_sed_si(:,:) = 0.0 5325 !! 5326 zb_sed_ca(:,:) = za_sed_ca(:,:) 5327 zn_sed_ca(:,:) = za_sed_ca(:,:) 5328 za_sed_ca(:,:) = 0.0 5329 endif 5330 ENDIF 5331 endif 5332 5333 IF( ln_diatrc ) THEN 5334 !!---------------------------------------------------------------------- 5335 !! Output several accumulated diagnostics 5336 !! - biomass-average phytoplankton limitation terms 5337 !! - integrated tendency terms 5338 !!---------------------------------------------------------------------- 5339 !! 5340 DO jj = 2,jpjm1 5341 DO ji = 2,jpim1 5342 !! non-diatom phytoplankton limitations 5343 trc2d(ji,jj,25) = trc2d(ji,jj,25) / MAX(ftot_pn(ji,jj), rsmall) 5344 trc2d(ji,jj,26) = trc2d(ji,jj,26) / MAX(ftot_pn(ji,jj), rsmall) 5345 trc2d(ji,jj,27) = trc2d(ji,jj,27) / MAX(ftot_pn(ji,jj), rsmall) 5346 !! diatom phytoplankton limitations 5347 trc2d(ji,jj,28) = trc2d(ji,jj,28) / MAX(ftot_pd(ji,jj), rsmall) 5348 trc2d(ji,jj,29) = trc2d(ji,jj,29) / MAX(ftot_pd(ji,jj), rsmall) 5349 trc2d(ji,jj,30) = trc2d(ji,jj,30) / MAX(ftot_pd(ji,jj), rsmall) 5350 trc2d(ji,jj,31) = trc2d(ji,jj,31) / MAX(ftot_pd(ji,jj), rsmall) 5351 trc2d(ji,jj,32) = trc2d(ji,jj,32) / MAX(ftot_pd(ji,jj), rsmall) 5352 !! tendency terms 5353 trc2d(ji,jj,76) = fflx_n(ji,jj) 5354 trc2d(ji,jj,77) = fflx_si(ji,jj) 5355 trc2d(ji,jj,78) = fflx_fe(ji,jj) 5356 !! integrated biomass 5357 trc2d(ji,jj,79) = ftot_pn(ji,jj) !! integrated non-diatom phytoplankton 5358 trc2d(ji,jj,80) = ftot_pd(ji,jj) !! integrated diatom phytoplankton 5359 trc2d(ji,jj,217) = ftot_zmi(ji,jj) !! Integrated microzooplankton 5360 trc2d(ji,jj,218) = ftot_zme(ji,jj) !! Integrated mesozooplankton 5361 trc2d(ji,jj,219) = ftot_det(ji,jj) !! Integrated slow detritus, nitrogen 5362 trc2d(ji,jj,220) = ftot_dtc(ji,jj) !! Integrated slow detritus, carbon 5363 # if defined key_roam 5364 !! the balance of nitrogen production/consumption 5365 trc2d(ji,jj,111) = fnit_prod(ji,jj) !! integrated nitrogen production 5366 trc2d(ji,jj,112) = fnit_cons(ji,jj) !! integrated nitrogen consumption 5367 !! the balance of carbon production/consumption 5368 trc2d(ji,jj,113) = fcar_prod(ji,jj) !! integrated carbon production 5369 trc2d(ji,jj,114) = fcar_cons(ji,jj) !! integrated carbon consumption 5370 !! the balance of oxygen production/consumption 5371 trc2d(ji,jj,115) = foxy_prod(ji,jj) !! integrated oxygen production 5372 trc2d(ji,jj,116) = foxy_cons(ji,jj) !! integrated oxygen consumption 5373 trc2d(ji,jj,117) = foxy_anox(ji,jj) !! integrated unrealised oxygen consumption 5374 # endif 5375 ENDDO 5376 ENDDO 5377 5378 # if defined key_roam 5379 # if defined key_axy_nancheck 5380 !!---------------------------------------------------------------------- 5381 !! Check for NaNs in diagnostic outputs 5382 !!---------------------------------------------------------------------- 5383 !! 5384 !! 2D diagnostics 5385 DO jn = 1,150 5386 fq0 = SUM(trc2d(:,:,jn)) 5387 !! AXY (30/01/14): "isnan" problem on HECTOR 5388 !! if (fq0 /= fq0 ) then 5389 if ( ieee_is_nan( fq0 ) ) then 5390 !! there's a NaN here 5391 if (lwp) write(numout,*) 'NAN detected in 2D diagnostic field', jn, 'at time', kt, 'at position:' 5392 DO jj = 1,jpj 5393 DO ji = 1,jpi 5394 if ( ieee_is_nan( trc2d(ji,jj,jn) ) ) then 5395 if (lwp) write (numout,'(a,3i6)') 'NAN-CHECK', & 5396 & ji, jj, jn 5397 endif 5398 ENDDO 5399 ENDDO 5400 CALL ctl_stop( 'trcbio_medusa, NAN in 2D diagnostic field' ) 5401 endif 5402 ENDDO 5403 !! 5404 !! 3D diagnostics 5405 DO jn = 1,5 5406 fq0 = SUM(trc3d(:,:,:,jn)) 5407 !! AXY (30/01/14): "isnan" problem on HECTOR 5408 !! if (fq0 /= fq0 ) then 5409 if ( ieee_is_nan( fq0 ) ) then 5410 !! there's a NaN here 5411 if (lwp) write(numout,*) 'NAN detected in 3D diagnostic field', jn, 'at time', kt, 'at position:' 5412 DO jk = 1,jpk 5413 DO jj = 1,jpj 5414 DO ji = 1,jpi 5415 if ( ieee_is_nan( trc3d(ji,jj,jk,jn) ) ) then 5416 if (lwp) write (numout,'(a,4i6)') 'NAN-CHECK', & 5417 & ji, jj, jk, jn 5418 endif 5419 ENDDO 5420 ENDDO 5421 ENDDO 5422 CALL ctl_stop( 'trcbio_medusa, NAN in 3D diagnostic field' ) 5423 endif 5424 ENDDO 5425 CALL flush(numout) 5426 # endif 5427 # endif 5428 5429 !!---------------------------------------------------------------------- 5430 !! Don't know what this does; belongs to someone else ... 5431 !!---------------------------------------------------------------------- 5432 !! 5433 !! Lateral boundary conditions on trc2d 5434 DO jn=1,jp_medusa_2d 5435 CALL lbc_lnk(trc2d(:,:,jn),'T',1. ) 5436 ENDDO 5437 5438 !! Lateral boundary conditions on trc3d 5439 DO jn=1,jp_medusa_3d 5440 CALL lbc_lnk(trc3d(:,:,1,jn),'T',1. ) 5441 ENDDO 5442 5443 5444 # if defined key_axy_nodiag 5445 !!---------------------------------------------------------------------- 5446 !! Blank diagnostics as a NaN-trap 5447 !!---------------------------------------------------------------------- 5448 !! 5449 !! blank 2D diagnostic array 5450 trc2d(:,:,:) = 0.e0 5451 !! 5452 !! blank 3D diagnostic array 5453 trc3d(:,:,:,:) = 0.e0 5454 # endif 5455 5456 5457 !!---------------------------------------------------------------------- 5458 !! Add in XML diagnostics stuff 5459 !!---------------------------------------------------------------------- 5460 !! 5461 !! ** 2D diagnostics 5462 DO jn=1,jp_medusa_2d 5463 CALL iom_put(TRIM(ctrc2d(jn)), trc2d(:,:,jn)) 5464 END DO 5465 !! AXY (17/02/14): don't think I need this if I modify the above for all diagnostics 5466 !! # if defined key_roam 5467 !! DO jn=91,jp_medusa_2d 5468 !! CALL iom_put(TRIM(ctrc2d(jn)), trc2d(:,:,jn)) 5469 !! END DO 5470 !! # endif 5471 !! 5472 !! ** 3D diagnostics 5473 DO jn=1,jp_medusa_3d 5474 CALL iom_put(TRIM(ctrc3d(jn)), trc3d(:,:,:,jn)) 5475 END DO 5476 !! AXY (17/02/14): don't think I need this if I modify the above for all diagnostics 5477 !! # if defined key_roam 5478 !! CALL iom_put(TRIM(ctrc3d(5)), trc3d(:,:,:,5)) 5479 !! # endif 5480 5481 5482 ELSE IF( lk_iomput .AND. .NOT. ln_diatrc ) THEN 5483 !!!---------------------------------------------------------------------- 5484 !! Add very last diag calculations 5485 !!!---------------------------------------------------------------------- 5486 DO jj = 2,jpjm1 5487 DO ji = 2,jpim1 5488 !! 5489 IF( med_diag%PN_JLIM%dgsave ) THEN 5490 fjln2d(ji,jj) = fjln2d(ji,jj) / MAX(ftot_pn(ji,jj), rsmall) 5491 ENDIF 5492 IF( med_diag%PN_NLIM%dgsave ) THEN 5493 fnln2d(ji,jj) = fnln2d(ji,jj) / MAX(ftot_pn(ji,jj), rsmall) 5494 ENDIF 5495 IF( med_diag%PN_FELIM%dgsave ) THEN 5496 ffln2d(ji,jj) = ffln2d(ji,jj) / MAX(ftot_pn(ji,jj), rsmall) 5497 ENDIF 5498 IF( med_diag%PD_JLIM%dgsave ) THEN 5499 fjld2d(ji,jj) = fjld2d(ji,jj) / MAX(ftot_pd(ji,jj), rsmall) 5500 ENDIF 5501 IF( med_diag%PD_NLIM%dgsave ) THEN 5502 fnld2d(ji,jj) = fnld2d(ji,jj) / MAX(ftot_pd(ji,jj), rsmall) 5503 ENDIF 5504 IF( med_diag%PD_FELIM%dgsave ) THEN 5505 ffld2d(ji,jj) = ffld2d(ji,jj) / MAX(ftot_pd(ji,jj), rsmall) 5506 ENDIF 5507 IF( med_diag%PD_SILIM%dgsave ) THEN 5508 fsld2d2(ji,jj) = fsld2d2(ji,jj) / MAX(ftot_pd(ji,jj), rsmall) 5509 ENDIF 5510 IF( med_diag%PDSILIM2%dgsave ) THEN 5511 fsld2d(ji,jj) = fsld2d(ji,jj) / MAX(ftot_pd(ji,jj), rsmall) 406 !! set up model tracers 407 !! negative values of state variables are not allowed to 408 !! contribute to the calculated fluxes 409 !! non-diatom chlorophyll 410 zchn(ji,jj) = max(0.,trn(ji,jj,jk,jpchn)) 411 !! diatom chlorophyll 412 zchd(ji,jj) = max(0.,trn(ji,jj,jk,jpchd)) 413 !! non-diatoms 414 zphn(ji,jj) = max(0.,trn(ji,jj,jk,jpphn)) 415 !! diatoms 416 zphd(ji,jj) = max(0.,trn(ji,jj,jk,jpphd)) 417 !! diatom silicon 418 zpds(ji,jj) = max(0.,trn(ji,jj,jk,jppds)) 419 !! AXY (28/01/10): probably need to take account of 420 !! chl/biomass connection 421 if (zchn(ji,jj).eq.0.) zphn(ji,jj) = 0. 422 if (zchd(ji,jj).eq.0.) zphd(ji,jj) = 0. 423 if (zphn(ji,jj).eq.0.) zchn(ji,jj) = 0. 424 if (zphd(ji,jj).eq.0.) zchd(ji,jj) = 0. 425 !! AXY (23/01/14): duh - why did I forget diatom silicon? 426 if (zpds(ji,jj).eq.0.) zphd(ji,jj) = 0. 427 if (zphd(ji,jj).eq.0.) zpds(ji,jj) = 0. 5512 428 ENDIF 5513 429 ENDDO 5514 430 ENDDO 5515 !!---------------------------------------------------------------------- 5516 !! Add in XML diagnostics stuff 5517 !!---------------------------------------------------------------------- 5518 !! 5519 !! ** 2D diagnostics 5520 # if defined key_debug_medusa 5521 IF (lwp) write (numout,*) 'trc_bio_medusa: export all diag.' 5522 CALL flush(numout) 5523 # endif 5524 IF ( med_diag%INVTN%dgsave ) THEN 5525 CALL iom_put( "INVTN" , ftot_n ) 431 432 DO jj = 2,jpjm1 433 DO ji = 2,jpim1 434 if (tmask(ji,jj,jk) == 1) then 435 !! microzooplankton 436 zzmi(ji,jj) = max(0.,trn(ji,jj,jk,jpzmi)) 437 !! mesozooplankton 438 zzme(ji,jj) = max(0.,trn(ji,jj,jk,jpzme)) 439 !! detrital nitrogen 440 zdet(ji,jj) = max(0.,trn(ji,jj,jk,jpdet)) 441 !! dissolved inorganic nitrogen 442 zdin(ji,jj) = max(0.,trn(ji,jj,jk,jpdin)) 443 !! dissolved silicic acid 444 zsil(ji,jj) = max(0.,trn(ji,jj,jk,jpsil)) 445 !! dissolved "iron" 446 zfer(ji,jj) = max(0.,trn(ji,jj,jk,jpfer)) 447 ENDIF 448 ENDDO 449 ENDDO 450 451 # if defined key_roam 452 DO jj = 2,jpjm1 453 DO ji = 2,jpim1 454 if (tmask(ji,jj,jk) == 1) then 455 !! detrital carbon 456 zdtc(ji,jj) = max(0.,trn(ji,jj,jk,jpdtc)) 457 !! dissolved inorganic carbon 458 zdic(ji,jj) = max(0.,trn(ji,jj,jk,jpdic)) 459 !! alkalinity 460 zalk(ji,jj) = max(0.,trn(ji,jj,jk,jpalk)) 461 !! oxygen 462 zoxy(ji,jj) = max(0.,trn(ji,jj,jk,jpoxy)) 463 # if defined key_axy_carbchem && defined key_mocsy 464 !! phosphate via DIN and Redfield 465 zpho(ji,jj) = max(0.,trn(ji,jj,jk,jpdin)) / 16.0 466 # endif 467 !! 468 !! also need physical parameters for gas exchange 469 !! calculations 470 ztmp(ji,jj) = tsn(ji,jj,jk,jp_tem) 471 zsal(ji,jj) = tsn(ji,jj,jk,jp_sal) 472 !! 473 !! AXY (28/02/14): check input fields 474 if (ztmp(ji,jj) .lt. -3.0 .or. ztmp(ji,jj) .gt. 40.0 ) then 475 IF(lwp) WRITE(numout,*) & 476 ' trc_bio_medusa: T WARNING 2D, ', & 477 tsb(ji,jj,jk,jp_tem), tsn(ji,jj,jk,jp_tem), & 478 ' at (', ji, ',', jj, ',', jk, ') at time', kt 479 IF(lwp) WRITE(numout,*) & 480 ' trc_bio_medusa: T SWITCHING 2D, ', & 481 tsn(ji,jj,jk,jp_tem), ' -> ', tsb(ji,jj,jk,jp_tem) 482 !! temperatur 483 ztmp(ji,jj) = tsb(ji,jj,jk,jp_tem) 484 endif 485 if (zsal(ji,jj) .lt. 0.0 .or. zsal(ji,jj) .gt. 45.0 ) then 486 IF(lwp) WRITE(numout,*) & 487 ' trc_bio_medusa: S WARNING 2D, ', & 488 tsb(ji,jj,jk,jp_sal), tsn(ji,jj,jk,jp_sal), & 489 ' at (', ji, ',', jj, ',', jk, ') at time', kt 490 endif 491 ENDIF 492 ENDDO 493 ENDDO 494 # else 495 DO jj = 2,jpjm1 496 DO ji = 2,jpim1 497 if (tmask(ji,jj,jk) == 1) then 498 !! implicit detrital carbon 499 zdtc(ji,jj) = zdet(ji,jj) * xthetad 500 ENDIF 501 ENDDO 502 ENDDO 503 # endif 504 # if defined key_debug_medusa 505 DO jj = 2,jpjm1 506 DO ji = 2,jpim1 507 if (tmask(ji,jj,jk) == 1) then 508 if (idf.eq.1) then 509 !! AXY (15/01/10) 510 if (trn(ji,jj,jk,jpdin).lt.0.) then 511 IF (lwp) write (numout,*) & 512 '------------------------------' 513 IF (lwp) write (numout,*) 'NEGATIVE DIN ERROR =', & 514 trn(ji,jj,jk,jpdin) 515 IF (lwp) write (numout,*) 'NEGATIVE DIN ERROR @', & 516 ji, jj, jk, kt 517 endif 518 if (trn(ji,jj,jk,jpsil).lt.0.) then 519 IF (lwp) write (numout,*) & 520 '------------------------------' 521 IF (lwp) write (numout,*) 'NEGATIVE SIL ERROR =', & 522 trn(ji,jj,jk,jpsil) 523 IF (lwp) write (numout,*) 'NEGATIVE SIL ERROR @', & 524 ji, jj, jk, kt 525 endif 526 # if defined key_roam 527 if (trn(ji,jj,jk,jpdic).lt.0.) then 528 IF (lwp) write (numout,*) & 529 '------------------------------' 530 IF (lwp) write (numout,*) 'NEGATIVE DIC ERROR =', & 531 trn(ji,jj,jk,jpdic) 532 IF (lwp) write (numout,*) 'NEGATIVE DIC ERROR @', & 533 ji, jj, jk, kt 534 endif 535 if (trn(ji,jj,jk,jpalk).lt.0.) then 536 IF (lwp) write (numout,*) & 537 '------------------------------' 538 IF (lwp) write (numout,*) 'NEGATIVE ALK ERROR =', & 539 trn(ji,jj,jk,jpalk) 540 IF (lwp) write (numout,*) 'NEGATIVE ALK ERROR @', & 541 ji, jj, jk, kt 542 endif 543 if (trn(ji,jj,jk,jpoxy).lt.0.) then 544 IF (lwp) write (numout,*) & 545 '------------------------------' 546 IF (lwp) write (numout,*) 'NEGATIVE OXY ERROR =', & 547 trn(ji,jj,jk,jpoxy) 548 IF (lwp) write (numout,*) 'NEGATIVE OXY ERROR @', & 549 ji, jj, jk, kt 550 endif 551 # endif 552 endif 553 ENDIF 554 ENDDO 555 ENDDO 556 # endif 557 # if defined key_debug_medusa 558 ! I'M NOT SURE THIS IS USEFUL NOW THAT I'VE SPLIT THE DO LOOP - marc 8/5/17 559 ! if (idf.eq.1.AND.idfval.eq.1) then 560 ! DO jj = 2,jpjm1 561 ! DO ji = 2,jpim1 562 ! if (tmask(ji,jj,jk) == 1) then 563 ! !! report state variable values 564 ! IF (lwp) write (numout,*) & 565 ! '------------------------------' 566 ! IF (lwp) write (numout,*) 'fthk(',jk,') = ', & 567 ! fse3t(ji,jj,jk) 568 ! IF (lwp) write (numout,*) 'zphn(',jk,') = ', zphn(ji,jj) 569 ! IF (lwp) write (numout,*) 'zphd(',jk,') = ', zphd(ji,jj) 570 ! IF (lwp) write (numout,*) 'zpds(',jk,') = ', zpds(ji,jj) 571 ! IF (lwp) write (numout,*) 'zzmi(',jk,') = ', zzmi(ji,jj) 572 ! IF (lwp) write (numout,*) 'zzme(',jk,') = ', zzme(ji,jj) 573 ! IF (lwp) write (numout,*) 'zdet(',jk,') = ', zdet(ji,jj) 574 ! IF (lwp) write (numout,*) 'zdin(',jk,') = ', zdin(ji,jj) 575 ! IF (lwp) write (numout,*) 'zsil(',jk,') = ', zsil(ji,jj) 576 ! IF (lwp) write (numout,*) 'zfer(',jk,') = ', zfer(ji,jj) 577 # if defined key_roam 578 ! IF (lwp) write (numout,*) 'zdtc(',jk,') = ', zdtc(ji,jj) 579 ! IF (lwp) write (numout,*) 'zdic(',jk,') = ', zdic(ji,jj) 580 ! IF (lwp) write (numout,*) 'zalk(',jk,') = ', zalk(ji,jj) 581 ! IF (lwp) write (numout,*) 'zoxy(',jk,') = ', zoxy(ji,jj) 582 # endif 583 ! ENDIF 584 ! ENDDO 585 ! ENDDO 586 ! endif 587 # endif 588 589 # if defined key_debug_medusa 590 ! I'M NOT SURE THIS IS USEFUL NOW THAT I'VE SPLIT THE DO LOOP - marc 8/5/17 591 ! if (idf.eq.1.AND.idfval.eq.1.AND.jk.eq.1) then 592 ! DO jj = 2,jpjm1 593 ! DO ji = 2,jpim1 594 ! if (tmask(ji,jj,jk) == 1) then 595 ! IF (lwp) write (numout,*) & 596 ! '------------------------------' 597 ! IF (lwp) write (numout,*) 'dust = ', dust(ji,jj) 598 ! ENDIF 599 ! ENDDO 600 ! ENDDO 601 ! endif 602 # endif 603 604 !!--------------------------------------------------------------- 605 !! Calculate air-sea gas exchange and river inputs 606 !!--------------------------------------------------------------- 607 IF ( jk == 1 ) THEN 608 CALL air_sea( kt ) 5526 609 ENDIF 5527 IF ( med_diag%INVTSI%dgsave ) THEN 5528 CALL iom_put( "INVTSI" , ftot_si ) 610 611 !!--------------------------------------------------------------- 612 !! Phytoplankton growth, zooplankton grazing and miscellaneous 613 !! plankton losses. 614 !!--------------------------------------------------------------- 615 CALL plankton( jk ) 616 617 !!--------------------------------------------------------------- 618 !! Iron chemistry and scavenging 619 !!--------------------------------------------------------------- 620 CALL iron_chem_scav( jk ) 621 622 !!--------------------------------------------------------------- 623 !! Detritus processes 624 !!--------------------------------------------------------------- 625 CALL detritus( jk, iball ) 626 627 !!--------------------------------------------------------------- 628 !! Updating tracers 629 !!--------------------------------------------------------------- 630 CALL bio_medusa_update( kt, jk ) 631 632 !!--------------------------------------------------------------- 633 !! Diagnostics 634 !!--------------------------------------------------------------- 635 CALL bio_medusa_diag( jk ) 636 637 !!------------------------------------------------------- 638 !! 2d specific k level diags 639 !!------------------------------------------------------- 640 IF( lk_iomput ) THEN 641 CALL bio_medusa_diag_slice( jk ) 5529 642 ENDIF 5530 IF ( med_diag%INVTFE%dgsave ) THEN 5531 CALL iom_put( "INVTFE" , ftot_fe ) 5532 ENDIF 5533 IF ( med_diag%ML_PRN%dgsave ) THEN 5534 CALL iom_put( "ML_PRN" , fprn_ml ) 5535 ENDIF 5536 IF ( med_diag%ML_PRD%dgsave ) THEN 5537 CALL iom_put( "ML_PRD" , fprd_ml ) 5538 ENDIF 5539 IF ( med_diag%OCAL_LVL%dgsave ) THEN 5540 CALL iom_put( "OCAL_LVL" , fccd ) 5541 ENDIF 5542 IF ( med_diag%PN_JLIM%dgsave ) THEN 5543 CALL iom_put( "PN_JLIM" , fjln2d ) 5544 CALL wrk_dealloc( jpi, jpj, fjln2d ) 5545 ENDIF 5546 IF ( med_diag%PN_NLIM%dgsave ) THEN 5547 CALL iom_put( "PN_NLIM" , fnln2d ) 5548 CALL wrk_dealloc( jpi, jpj, fnln2d ) 5549 ENDIF 5550 IF ( med_diag%PN_FELIM%dgsave ) THEN 5551 CALL iom_put( "PN_FELIM" , ffln2d ) 5552 CALL wrk_dealloc( jpi, jpj, ffln2d ) 5553 ENDIF 5554 IF ( med_diag%PD_JLIM%dgsave ) THEN 5555 CALL iom_put( "PD_JLIM" , fjld2d ) 5556 CALL wrk_dealloc( jpi, jpj, fjld2d ) 5557 ENDIF 5558 IF ( med_diag%PD_NLIM%dgsave ) THEN 5559 CALL iom_put( "PD_NLIM" , fnld2d ) 5560 CALL wrk_dealloc( jpi, jpj, fnld2d ) 5561 ENDIF 5562 IF ( med_diag%PD_FELIM%dgsave ) THEN 5563 CALL iom_put( "PD_FELIM" , ffld2d ) 5564 CALL wrk_dealloc( jpi, jpj, ffld2d ) 5565 ENDIF 5566 IF ( med_diag%PD_SILIM%dgsave ) THEN 5567 CALL iom_put( "PD_SILIM" , fsld2d2 ) 5568 CALL wrk_dealloc( jpi, jpj, fsld2d2 ) 5569 ENDIF 5570 IF ( med_diag%PDSILIM2%dgsave ) THEN 5571 CALL iom_put( "PDSILIM2" , fsld2d ) 5572 CALL wrk_dealloc( jpi, jpj, fsld2d ) 5573 ENDIF 5574 IF ( med_diag%INTFLX_N%dgsave ) THEN 5575 CALL iom_put( "INTFLX_N" , fflx_n ) 5576 ENDIF 5577 IF ( med_diag%INTFLX_SI%dgsave ) THEN 5578 CALL iom_put( "INTFLX_SI" , fflx_si ) 5579 ENDIF 5580 IF ( med_diag%INTFLX_FE%dgsave ) THEN 5581 CALL iom_put( "INTFLX_FE" , fflx_fe ) 5582 ENDIF 5583 IF ( med_diag%INT_PN%dgsave ) THEN 5584 CALL iom_put( "INT_PN" , ftot_pn ) 5585 ENDIF 5586 IF ( med_diag%INT_PD%dgsave ) THEN 5587 CALL iom_put( "INT_PD" , ftot_pd ) 5588 ENDIF 5589 IF ( med_diag%INT_ZMI%dgsave ) THEN 5590 CALL iom_put( "INT_ZMI" , ftot_zmi ) 5591 ENDIF 5592 IF ( med_diag%INT_ZME%dgsave ) THEN 5593 CALL iom_put( "INT_ZME" , ftot_zme ) 5594 ENDIF 5595 IF ( med_diag%INT_DET%dgsave ) THEN 5596 CALL iom_put( "INT_DET" , ftot_det ) 5597 ENDIF 5598 IF ( med_diag%INT_DTC%dgsave ) THEN 5599 CALL iom_put( "INT_DTC" , ftot_dtc ) 5600 ENDIF 5601 IF ( med_diag%BEN_N%dgsave ) THEN 5602 CALL iom_put( "BEN_N" , za_sed_n ) 5603 ENDIF 5604 IF ( med_diag%BEN_FE%dgsave ) THEN 5605 CALL iom_put( "BEN_FE" , za_sed_fe ) 5606 ENDIF 5607 IF ( med_diag%BEN_C%dgsave ) THEN 5608 CALL iom_put( "BEN_C" , za_sed_c ) 5609 ENDIF 5610 IF ( med_diag%BEN_SI%dgsave ) THEN 5611 CALL iom_put( "BEN_SI" , za_sed_si ) 5612 ENDIF 5613 IF ( med_diag%BEN_CA%dgsave ) THEN 5614 CALL iom_put( "BEN_CA" , za_sed_ca ) 5615 ENDIF 5616 IF ( med_diag%RUNOFF%dgsave ) THEN 5617 CALL iom_put( "RUNOFF" , f_runoff ) 5618 ENDIF 5619 # if defined key_roam 5620 IF ( med_diag%N_PROD%dgsave ) THEN 5621 CALL iom_put( "N_PROD" , fnit_prod ) 5622 ENDIF 5623 IF ( med_diag%N_CONS%dgsave ) THEN 5624 CALL iom_put( "N_CONS" , fnit_cons ) 5625 ENDIF 5626 IF ( med_diag%C_PROD%dgsave ) THEN 5627 CALL iom_put( "C_PROD" , fcar_prod ) 5628 ENDIF 5629 IF ( med_diag%C_CONS%dgsave ) THEN 5630 CALL iom_put( "C_CONS" , fcar_cons ) 5631 ENDIF 5632 IF ( med_diag%O2_PROD%dgsave ) THEN 5633 CALL iom_put( "O2_PROD" , foxy_prod ) 5634 ENDIF 5635 IF ( med_diag%O2_CONS%dgsave ) THEN 5636 CALL iom_put( "O2_CONS" , foxy_cons ) 5637 ENDIF 5638 IF ( med_diag%O2_ANOX%dgsave ) THEN 5639 CALL iom_put( "O2_ANOX" , foxy_anox ) 5640 ENDIF 5641 IF ( med_diag%INVTC%dgsave ) THEN 5642 CALL iom_put( "INVTC" , ftot_c ) 5643 ENDIF 5644 IF ( med_diag%INVTALK%dgsave ) THEN 5645 CALL iom_put( "INVTALK" , ftot_a ) 5646 ENDIF 5647 IF ( med_diag%INVTO2%dgsave ) THEN 5648 CALL iom_put( "INVTO2" , ftot_o2 ) 5649 ENDIF 5650 IF ( med_diag%COM_RESP%dgsave ) THEN 5651 CALL iom_put( "COM_RESP" , fcomm_resp ) 5652 ENDIF 5653 # endif 5654 !! 5655 !! diagnostic filled in the i-j-k main loop 5656 !!-------------------------------------------- 5657 IF ( med_diag%PRN%dgsave ) THEN 5658 CALL iom_put( "PRN" , fprn2d ) 5659 CALL wrk_dealloc( jpi, jpj, fprn2d ) 5660 ENDIF 5661 IF ( med_diag%MPN%dgsave ) THEN 5662 CALL iom_put( "MPN" ,fdpn2d ) 5663 CALL wrk_dealloc( jpi, jpj, fdpn2d ) 5664 ENDIF 5665 IF ( med_diag%PRD%dgsave ) THEN 5666 CALL iom_put( "PRD" ,fprd2d ) 5667 CALL wrk_dealloc( jpi, jpj, fprd2d ) 5668 ENDIF 5669 IF( med_diag%MPD%dgsave ) THEN 5670 CALL iom_put( "MPD" , fdpd2d ) 5671 CALL wrk_dealloc( jpi, jpj, fdpd2d ) 5672 ENDIF 5673 ! IF( med_diag%DSED%dgsave ) THEN 5674 ! CALL iom_put( "DSED" , ftot_n ) 5675 ! ENDIF 5676 IF( med_diag%OPAL%dgsave ) THEN 5677 CALL iom_put( "OPAL" , fprds2d ) 5678 CALL wrk_dealloc( jpi, jpj, fprds2d ) 5679 ENDIF 5680 IF( med_diag%OPALDISS%dgsave ) THEN 5681 CALL iom_put( "OPALDISS" , fsdiss2d ) 5682 CALL wrk_dealloc( jpi, jpj, fsdiss2d ) 5683 ENDIF 5684 IF( med_diag%GMIPn%dgsave ) THEN 5685 CALL iom_put( "GMIPn" , fgmipn2d ) 5686 CALL wrk_dealloc( jpi, jpj, fgmipn2d ) 5687 ENDIF 5688 IF( med_diag%GMID%dgsave ) THEN 5689 CALL iom_put( "GMID" , fgmid2d ) 5690 CALL wrk_dealloc( jpi, jpj, fgmid2d ) 5691 ENDIF 5692 IF( med_diag%MZMI%dgsave ) THEN 5693 CALL iom_put( "MZMI" , fdzmi2d ) 5694 CALL wrk_dealloc( jpi, jpj, fdzmi2d ) 5695 ENDIF 5696 IF( med_diag%GMEPN%dgsave ) THEN 5697 CALL iom_put( "GMEPN" , fgmepn2d ) 5698 CALL wrk_dealloc( jpi, jpj, fgmepn2d ) 5699 ENDIF 5700 IF( med_diag%GMEPD%dgsave ) THEN 5701 CALL iom_put( "GMEPD" , fgmepd2d ) 5702 CALL wrk_dealloc( jpi, jpj, fgmepd2d ) 5703 ENDIF 5704 IF( med_diag%GMEZMI%dgsave ) THEN 5705 CALL iom_put( "GMEZMI" , fgmezmi2d ) 5706 CALL wrk_dealloc( jpi, jpj, fgmezmi2d ) 5707 ENDIF 5708 IF( med_diag%GMED%dgsave ) THEN 5709 CALL iom_put( "GMED" , fgmed2d ) 5710 CALL wrk_dealloc( jpi, jpj, fgmed2d ) 5711 ENDIF 5712 IF( med_diag%MZME%dgsave ) THEN 5713 CALL iom_put( "MZME" , fdzme2d ) 5714 CALL wrk_dealloc( jpi, jpj, fdzme2d ) 5715 ENDIF 5716 ! IF( med_diag%DEXP%dgsave ) THEN 5717 ! CALL iom_put( "DEXP" , ftot_n ) 5718 ! ENDIF 5719 IF( med_diag%DETN%dgsave ) THEN 5720 CALL iom_put( "DETN" , fslown2d ) 5721 CALL wrk_dealloc( jpi, jpj, fslown2d ) 5722 ENDIF 5723 IF( med_diag%MDET%dgsave ) THEN 5724 CALL iom_put( "MDET" , fdd2d ) 5725 CALL wrk_dealloc( jpi, jpj, fdd2d ) 5726 ENDIF 5727 IF( med_diag%AEOLIAN%dgsave ) THEN 5728 CALL iom_put( "AEOLIAN" , ffetop2d ) 5729 CALL wrk_dealloc( jpi, jpj, ffetop2d ) 5730 ENDIF 5731 IF( med_diag%BENTHIC%dgsave ) THEN 5732 CALL iom_put( "BENTHIC" , ffebot2d ) 5733 CALL wrk_dealloc( jpi, jpj, ffebot2d ) 5734 ENDIF 5735 IF( med_diag%SCAVENGE%dgsave ) THEN 5736 CALL iom_put( "SCAVENGE" , ffescav2d ) 5737 CALL wrk_dealloc( jpi, jpj, ffescav2d ) 5738 ENDIF 5739 !! 5740 IF( med_diag%TOTREG_N%dgsave ) THEN 5741 CALL iom_put( "TOTREG_N" , fregen2d ) 5742 CALL wrk_dealloc( jpi, jpj, fregen2d ) 5743 ENDIF 5744 IF( med_diag%TOTRG_SI%dgsave ) THEN 5745 CALL iom_put( "TOTRG_SI" , fregensi2d ) 5746 CALL wrk_dealloc( jpi, jpj, fregensi2d ) 5747 ENDIF 5748 !! 5749 IF( med_diag%FASTN%dgsave ) THEN 5750 CALL iom_put( "FASTN" , ftempn2d ) 5751 CALL wrk_dealloc( jpi, jpj, ftempn2d ) 5752 ENDIF 5753 IF( med_diag%FASTSI%dgsave ) THEN 5754 CALL iom_put( "FASTSI" , ftempsi2d ) 5755 CALL wrk_dealloc( jpi, jpj, ftempsi2d ) 5756 ENDIF 5757 IF( med_diag%FASTFE%dgsave ) THEN 5758 CALL iom_put( "FASTFE" , ftempfe2d ) 5759 CALL wrk_dealloc( jpi, jpj, ftempfe2d ) 5760 ENDIF 5761 IF( med_diag%FASTC%dgsave ) THEN 5762 CALL iom_put( "FASTC" , ftempc2d ) 5763 CALL wrk_dealloc( jpi, jpj, ftempc2d ) 5764 ENDIF 5765 IF( med_diag%FASTCA%dgsave ) THEN 5766 CALL iom_put( "FASTCA" , ftempca2d ) 5767 CALL wrk_dealloc( jpi, jpj, ftempca2d ) 5768 ENDIF 5769 !! 5770 IF( med_diag%REMINN%dgsave ) THEN 5771 CALL iom_put( "REMINN" , freminn2d ) 5772 CALL wrk_dealloc( jpi, jpj, freminn2d ) 5773 ENDIF 5774 IF( med_diag%REMINSI%dgsave ) THEN 5775 CALL iom_put( "REMINSI" , freminsi2d ) 5776 CALL wrk_dealloc( jpi, jpj, freminsi2d ) 5777 ENDIF 5778 IF( med_diag%REMINFE%dgsave ) THEN 5779 CALL iom_put( "REMINFE" , freminfe2d ) 5780 CALL wrk_dealloc( jpi, jpj, freminfe2d ) 5781 ENDIF 5782 IF( med_diag%REMINC%dgsave ) THEN 5783 CALL iom_put( "REMINC" , freminc2d ) 5784 CALL wrk_dealloc( jpi, jpj, freminc2d ) 5785 ENDIF 5786 IF( med_diag%REMINCA%dgsave ) THEN 5787 CALL iom_put( "REMINCA" , freminca2d ) 5788 CALL wrk_dealloc( jpi, jpj, freminca2d ) 5789 ENDIF 5790 IF( med_diag%SEAFLRN%dgsave ) THEN 5791 CALL iom_put( "SEAFLRN" , fsedn ) 5792 ENDIF 5793 IF( med_diag%SEAFLRSI%dgsave ) THEN 5794 CALL iom_put( "SEAFLRSI" , fsedsi ) 5795 ENDIF 5796 IF( med_diag%SEAFLRFE%dgsave ) THEN 5797 CALL iom_put( "SEAFLRFE" , fsedfe ) 5798 ENDIF 5799 IF( med_diag%SEAFLRC%dgsave ) THEN 5800 CALL iom_put( "SEAFLRC" , fsedc ) 5801 ENDIF 5802 IF( med_diag%SEAFLRCA%dgsave ) THEN 5803 CALL iom_put( "SEAFLRCA" , fsedca ) 5804 ENDIF 5805 !! 5806 # if defined key_roam 5807 !! 5808 IF( med_diag%RIV_N%dgsave ) THEN 5809 CALL iom_put( "RIV_N" , rivn2d ) 5810 CALL wrk_dealloc( jpi, jpj, rivn2d ) 5811 ENDIF 5812 IF( med_diag%RIV_SI%dgsave ) THEN 5813 CALL iom_put( "RIV_SI" , rivsi2d ) 5814 CALL wrk_dealloc( jpi, jpj, rivsi2d ) 5815 ENDIF 5816 IF( med_diag%RIV_C%dgsave ) THEN 5817 CALL iom_put( "RIV_C" , rivc2d ) 5818 CALL wrk_dealloc( jpi, jpj, rivc2d ) 5819 ENDIF 5820 IF( med_diag%RIV_ALK%dgsave ) THEN 5821 CALL iom_put( "RIV_ALK" , rivalk2d ) 5822 CALL wrk_dealloc( jpi, jpj, rivalk2d ) 5823 ENDIF 5824 IF( med_diag%DETC%dgsave ) THEN 5825 CALL iom_put( "DETC" , fslowc2d ) 5826 CALL wrk_dealloc( jpi, jpj, fslowc2d ) 5827 ENDIF 5828 !! 5829 IF( med_diag%PN_LLOSS%dgsave ) THEN 5830 CALL iom_put( "PN_LLOSS" , fdpn22d ) 5831 CALL wrk_dealloc( jpi, jpj, fdpn22d ) 5832 ENDIF 5833 IF( med_diag%PD_LLOSS%dgsave ) THEN 5834 CALL iom_put( "PD_LLOSS" , fdpd22d ) 5835 CALL wrk_dealloc( jpi, jpj, fdpd22d ) 5836 ENDIF 5837 IF( med_diag%ZI_LLOSS%dgsave ) THEN 5838 CALL iom_put( "ZI_LLOSS" , fdzmi22d ) 5839 CALL wrk_dealloc( jpi, jpj, fdzmi22d ) 5840 ENDIF 5841 IF( med_diag%ZE_LLOSS%dgsave ) THEN 5842 CALL iom_put( "ZE_LLOSS" , fdzme22d ) 5843 CALL wrk_dealloc( jpi, jpj, fdzme22d ) 5844 ENDIF 5845 IF( med_diag%ZI_MES_N%dgsave ) THEN 5846 CALL iom_put( "ZI_MES_N" , zimesn2d ) 5847 CALL wrk_dealloc( jpi, jpj, zimesn2d ) 5848 ENDIF 5849 IF( med_diag%ZI_MES_D%dgsave ) THEN 5850 CALL iom_put( "ZI_MES_D" , zimesd2d ) 5851 CALL wrk_dealloc( jpi, jpj, zimesd2d ) 5852 ENDIF 5853 IF( med_diag%ZI_MES_C%dgsave ) THEN 5854 CALL iom_put( "ZI_MES_C" , zimesc2d ) 5855 CALL wrk_dealloc( jpi, jpj, zimesc2d ) 5856 ENDIF 5857 IF( med_diag%ZI_MESDC%dgsave ) THEN 5858 CALL iom_put( "ZI_MESDC" ,zimesdc2d ) 5859 CALL wrk_dealloc( jpi, jpj, zimesdc2d ) 5860 ENDIF 5861 IF( med_diag%ZI_EXCR%dgsave ) THEN 5862 CALL iom_put( "ZI_EXCR" , ziexcr2d ) 5863 CALL wrk_dealloc( jpi, jpj, ziexcr2d ) 5864 ENDIF 5865 IF( med_diag%ZI_RESP%dgsave ) THEN 5866 CALL iom_put( "ZI_RESP" , ziresp2d ) 5867 CALL wrk_dealloc( jpi, jpj, ziresp2d ) 5868 ENDIF 5869 IF( med_diag%ZI_GROW%dgsave ) THEN 5870 CALL iom_put( "ZI_GROW" , zigrow2d ) 5871 CALL wrk_dealloc( jpi, jpj, zigrow2d ) 5872 ENDIF 5873 IF( med_diag%ZE_MES_N%dgsave ) THEN 5874 CALL iom_put( "ZE_MES_N" , zemesn2d ) 5875 CALL wrk_dealloc( jpi, jpj, zemesn2d ) 5876 ENDIF 5877 IF( med_diag%ZE_MES_D%dgsave ) THEN 5878 CALL iom_put( "ZE_MES_D" , zemesd2d ) 5879 CALL wrk_dealloc( jpi, jpj, zemesd2d ) 5880 ENDIF 5881 IF( med_diag%ZE_MES_C%dgsave ) THEN 5882 CALL iom_put( "ZE_MES_C" , zemesc2d ) 5883 CALL wrk_dealloc( jpi, jpj, zemesc2d ) 5884 ENDIF 5885 IF( med_diag%ZE_MESDC%dgsave ) THEN 5886 CALL iom_put( "ZE_MESDC" , zemesdc2d ) 5887 CALL wrk_dealloc( jpi, jpj, zemesdc2d ) 5888 ENDIF 5889 IF( med_diag%ZE_EXCR%dgsave ) THEN 5890 CALL iom_put( "ZE_EXCR" , zeexcr2d ) 5891 CALL wrk_dealloc( jpi, jpj, zeexcr2d ) 5892 ENDIF 5893 IF( med_diag%ZE_RESP%dgsave ) THEN 5894 CALL iom_put( "ZE_RESP" , zeresp2d ) 5895 CALL wrk_dealloc( jpi, jpj, zeresp2d ) 5896 ENDIF 5897 IF( med_diag%ZE_GROW%dgsave ) THEN 5898 CALL iom_put( "ZE_GROW" , zegrow2d ) 5899 CALL wrk_dealloc( jpi, jpj, zegrow2d ) 5900 ENDIF 5901 IF( med_diag%MDETC%dgsave ) THEN 5902 CALL iom_put( "MDETC" , mdetc2d ) 5903 CALL wrk_dealloc( jpi, jpj, mdetc2d ) 5904 ENDIF 5905 IF( med_diag%GMIDC%dgsave ) THEN 5906 CALL iom_put( "GMIDC" , gmidc2d ) 5907 CALL wrk_dealloc( jpi, jpj, gmidc2d ) 5908 ENDIF 5909 IF( med_diag%GMEDC%dgsave ) THEN 5910 CALL iom_put( "GMEDC" , gmedc2d ) 5911 CALL wrk_dealloc( jpi, jpj, gmedc2d ) 5912 ENDIF 5913 IF( med_diag%IBEN_N%dgsave ) THEN 5914 CALL iom_put( "IBEN_N" , iben_n2d ) 5915 CALL wrk_dealloc( jpi, jpj, iben_n2d ) 5916 ENDIF 5917 IF( med_diag%IBEN_FE%dgsave ) THEN 5918 CALL iom_put( "IBEN_FE" , iben_fe2d ) 5919 CALL wrk_dealloc( jpi, jpj, iben_fe2d ) 5920 ENDIF 5921 IF( med_diag%IBEN_C%dgsave ) THEN 5922 CALL iom_put( "IBEN_C" , iben_c2d ) 5923 CALL wrk_dealloc( jpi, jpj, iben_c2d ) 5924 ENDIF 5925 IF( med_diag%IBEN_SI%dgsave ) THEN 5926 CALL iom_put( "IBEN_SI" , iben_si2d ) 5927 CALL wrk_dealloc( jpi, jpj, iben_si2d ) 5928 ENDIF 5929 IF( med_diag%IBEN_CA%dgsave ) THEN 5930 CALL iom_put( "IBEN_CA" , iben_ca2d ) 5931 CALL wrk_dealloc( jpi, jpj, iben_ca2d ) 5932 ENDIF 5933 IF( med_diag%OBEN_N%dgsave ) THEN 5934 CALL iom_put( "OBEN_N" , oben_n2d ) 5935 CALL wrk_dealloc( jpi, jpj, oben_n2d ) 5936 ENDIF 5937 IF( med_diag%OBEN_FE%dgsave ) THEN 5938 CALL iom_put( "OBEN_FE" , oben_fe2d ) 5939 CALL wrk_dealloc( jpi, jpj, oben_fe2d ) 5940 ENDIF 5941 IF( med_diag%OBEN_C%dgsave ) THEN 5942 CALL iom_put( "OBEN_C" , oben_c2d ) 5943 CALL wrk_dealloc( jpi, jpj, oben_c2d ) 5944 ENDIF 5945 IF( med_diag%OBEN_SI%dgsave ) THEN 5946 CALL iom_put( "OBEN_SI" , oben_si2d ) 5947 CALL wrk_dealloc( jpi, jpj, oben_si2d ) 5948 ENDIF 5949 IF( med_diag%OBEN_CA%dgsave ) THEN 5950 CALL iom_put( "OBEN_CA" , oben_ca2d ) 5951 CALL wrk_dealloc( jpi, jpj, oben_ca2d ) 5952 ENDIF 5953 IF( med_diag%SFR_OCAL%dgsave ) THEN 5954 CALL iom_put( "SFR_OCAL" , sfr_ocal2d ) 5955 CALL wrk_dealloc( jpi, jpj, sfr_ocal2d ) 5956 ENDIF 5957 IF( med_diag%SFR_OARG%dgsave ) THEN 5958 CALL iom_put( "SFR_OARG" , sfr_oarg2d ) 5959 CALL wrk_dealloc( jpi, jpj, sfr_oarg2d ) 5960 ENDIF 5961 IF( med_diag%LYSO_CA%dgsave ) THEN 5962 CALL iom_put( "LYSO_CA" , lyso_ca2d ) 5963 CALL wrk_dealloc( jpi, jpj, lyso_ca2d ) 5964 ENDIF 5965 # endif 5966 !! 5967 !! ** 3D diagnostics 5968 IF( med_diag%TPP3%dgsave ) THEN 5969 CALL iom_put( "TPP3" , tpp3d ) 5970 CALL wrk_dealloc( jpi, jpj, jpk, tpp3d ) 5971 ENDIF 5972 IF( med_diag%DETFLUX3%dgsave ) THEN 5973 CALL iom_put( "DETFLUX3" , detflux3d ) 5974 CALL wrk_dealloc( jpi, jpj, jpk, detflux3d ) 5975 ENDIF 5976 IF( med_diag%REMIN3N%dgsave ) THEN 5977 CALL iom_put( "REMIN3N" , remin3dn ) 5978 CALL wrk_dealloc( jpi, jpj, jpk, remin3dn ) 5979 ENDIF 5980 # if defined key_roam 5981 IF( med_diag%PH3%dgsave ) THEN 5982 CALL iom_put( "PH3" , f3_pH ) 5983 ENDIF 5984 IF( med_diag%OM_CAL3%dgsave ) THEN 5985 CALL iom_put( "OM_CAL3" , f3_omcal ) 5986 ENDIF 5987 !! 5988 !! AXY (09/11/16): 2D CMIP6 diagnostics 5989 IF( med_diag%INTDISSIC%dgsave ) THEN 5990 CALL iom_put( "INTDISSIC" , intdissic ) 5991 CALL wrk_dealloc( jpi, jpj, intdissic ) 5992 ENDIF 5993 IF( med_diag%INTDISSIN%dgsave ) THEN 5994 CALL iom_put( "INTDISSIN" , intdissin ) 5995 CALL wrk_dealloc( jpi, jpj, intdissin ) 5996 ENDIF 5997 IF( med_diag%INTDISSISI%dgsave ) THEN 5998 CALL iom_put( "INTDISSISI" , intdissisi ) 5999 CALL wrk_dealloc( jpi, jpj, intdissisi ) 6000 ENDIF 6001 IF( med_diag%INTTALK%dgsave ) THEN 6002 CALL iom_put( "INTTALK" , inttalk ) 6003 CALL wrk_dealloc( jpi, jpj, inttalk ) 6004 ENDIF 6005 IF( med_diag%O2min%dgsave ) THEN 6006 CALL iom_put( "O2min" , o2min ) 6007 CALL wrk_dealloc( jpi, jpj, o2min ) 6008 ENDIF 6009 IF( med_diag%ZO2min%dgsave ) THEN 6010 CALL iom_put( "ZO2min" , zo2min ) 6011 CALL wrk_dealloc( jpi, jpj, zo2min ) 6012 ENDIF 6013 IF( med_diag%FBDDTALK%dgsave ) THEN 6014 CALL iom_put( "FBDDTALK" , fbddtalk ) 6015 CALL wrk_dealloc( jpi, jpj, fbddtalk ) 6016 ENDIF 6017 IF( med_diag%FBDDTDIC%dgsave ) THEN 6018 CALL iom_put( "FBDDTDIC" , fbddtdic ) 6019 CALL wrk_dealloc( jpi, jpj, fbddtdic ) 6020 ENDIF 6021 IF( med_diag%FBDDTDIFE%dgsave ) THEN 6022 CALL iom_put( "FBDDTDIFE" , fbddtdife ) 6023 CALL wrk_dealloc( jpi, jpj, fbddtdife ) 6024 ENDIF 6025 IF( med_diag%FBDDTDIN%dgsave ) THEN 6026 CALL iom_put( "FBDDTDIN" , fbddtdin ) 6027 CALL wrk_dealloc( jpi, jpj, fbddtdin ) 6028 ENDIF 6029 IF( med_diag%FBDDTDISI%dgsave ) THEN 6030 CALL iom_put( "FBDDTDISI" , fbddtdisi ) 6031 CALL wrk_dealloc( jpi, jpj, fbddtdisi ) 6032 ENDIF 6033 !! 6034 !! AXY (09/11/16): 3D CMIP6 diagnostics 6035 IF( med_diag%TPPD3%dgsave ) THEN 6036 CALL iom_put( "TPPD3" , tppd3 ) 6037 CALL wrk_dealloc( jpi, jpj, jpk, tppd3 ) 6038 ENDIF 6039 IF( med_diag%BDDTALK3%dgsave ) THEN 6040 CALL iom_put( "BDDTALK3" , bddtalk3 ) 6041 CALL wrk_dealloc( jpi, jpj, jpk, bddtalk3 ) 6042 ENDIF 6043 IF( med_diag%BDDTDIC3%dgsave ) THEN 6044 CALL iom_put( "BDDTDIC3" , bddtdic3 ) 6045 CALL wrk_dealloc( jpi, jpj, jpk, bddtdic3 ) 6046 ENDIF 6047 IF( med_diag%BDDTDIFE3%dgsave ) THEN 6048 CALL iom_put( "BDDTDIFE3" , bddtdife3 ) 6049 CALL wrk_dealloc( jpi, jpj, jpk, bddtdife3 ) 6050 ENDIF 6051 IF( med_diag%BDDTDIN3%dgsave ) THEN 6052 CALL iom_put( "BDDTDIN3" , bddtdin3 ) 6053 CALL wrk_dealloc( jpi, jpj, jpk, bddtdin3 ) 6054 ENDIF 6055 IF( med_diag%BDDTDISI3%dgsave ) THEN 6056 CALL iom_put( "BDDTDISI3" , bddtdisi3 ) 6057 CALL wrk_dealloc( jpi, jpj, jpk, bddtdisi3 ) 6058 ENDIF 6059 IF( med_diag%FD_NIT3%dgsave ) THEN 6060 CALL iom_put( "FD_NIT3" , fd_nit3 ) 6061 CALL wrk_dealloc( jpi, jpj, jpk, fd_nit3 ) 6062 ENDIF 6063 IF( med_diag%FD_SIL3%dgsave ) THEN 6064 CALL iom_put( "FD_SIL3" , fd_sil3 ) 6065 CALL wrk_dealloc( jpi, jpj, jpk, fd_sil3 ) 6066 ENDIF 6067 IF( med_diag%FD_CAL3%dgsave ) THEN 6068 CALL iom_put( "FD_CAL3" , fd_cal3 ) 6069 CALL wrk_dealloc( jpi, jpj, jpk, fd_cal3 ) 6070 ENDIF 6071 IF( med_diag%FD_CAR3%dgsave ) THEN 6072 CALL iom_put( "FD_CAR3" , fd_car3 ) 6073 CALL wrk_dealloc( jpi, jpj, jpk, fd_car3 ) 6074 ENDIF 6075 IF( med_diag%CO33%dgsave ) THEN 6076 CALL iom_put( "CO33" , f3_co3 ) 6077 ENDIF 6078 IF( med_diag%CO3SATARAG3%dgsave ) THEN 6079 CALL iom_put( "CO3SATARAG3" , f3_omarg ) 6080 ENDIF 6081 IF( med_diag%CO3SATCALC3%dgsave ) THEN 6082 CALL iom_put( "CO3SATCALC3" , f3_omcal ) 6083 ENDIF 6084 IF( med_diag%EXPC3%dgsave ) THEN 6085 CALL iom_put( "EXPC3" , expc3 ) 6086 CALL wrk_dealloc( jpi, jpj, jpk, expc3 ) 6087 ENDIF 6088 IF( med_diag%EXPN3%dgsave ) THEN 6089 CALL iom_put( "EXPN3" , expn3 ) 6090 CALL wrk_dealloc( jpi, jpj, jpk, expn3 ) 6091 ENDIF 6092 IF( med_diag%DCALC3%dgsave ) THEN 6093 CALL iom_put( "DCALC3" , dcalc3 ) 6094 CALL wrk_dealloc( jpi, jpj, jpk, dcalc3 ) 6095 ENDIF 6096 IF( med_diag%FEDISS3%dgsave ) THEN 6097 CALL iom_put( "FEDISS3" , fediss3 ) 6098 CALL wrk_dealloc( jpi, jpj, jpk, fediss3 ) 6099 ENDIF 6100 IF( med_diag%FESCAV3%dgsave ) THEN 6101 CALL iom_put( "FESCAV3" , fescav3 ) 6102 CALL wrk_dealloc( jpi, jpj, jpk, fescav3 ) 6103 ENDIF 6104 IF( med_diag%MIGRAZP3%dgsave ) THEN 6105 CALL iom_put( "MIGRAZP3" , migrazp3 ) 6106 CALL wrk_dealloc( jpi, jpj, jpk, migrazp3 ) 6107 ENDIF 6108 IF( med_diag%MIGRAZD3%dgsave ) THEN 6109 CALL iom_put( "MIGRAZD3" , migrazd3 ) 6110 CALL wrk_dealloc( jpi, jpj, jpk, migrazd3 ) 6111 ENDIF 6112 IF( med_diag%MEGRAZP3%dgsave ) THEN 6113 CALL iom_put( "MEGRAZP3" , megrazp3 ) 6114 CALL wrk_dealloc( jpi, jpj, jpk, megrazp3 ) 6115 ENDIF 6116 IF( med_diag%MEGRAZD3%dgsave ) THEN 6117 CALL iom_put( "MEGRAZD3" , megrazd3 ) 6118 CALL wrk_dealloc( jpi, jpj, jpk, megrazd3 ) 6119 ENDIF 6120 IF( med_diag%MEGRAZZ3%dgsave ) THEN 6121 CALL iom_put( "MEGRAZZ3" , megrazz3 ) 6122 CALL wrk_dealloc( jpi, jpj, jpk, megrazz3 ) 6123 ENDIF 6124 IF( med_diag%O2SAT3%dgsave ) THEN 6125 CALL iom_put( "O2SAT3" , o2sat3 ) 6126 CALL wrk_dealloc( jpi, jpj, jpk, o2sat3 ) 6127 ENDIF 6128 IF( med_diag%PBSI3%dgsave ) THEN 6129 CALL iom_put( "PBSI3" , pbsi3 ) 6130 CALL wrk_dealloc( jpi, jpj, jpk, pbsi3 ) 6131 ENDIF 6132 IF( med_diag%PCAL3%dgsave ) THEN 6133 CALL iom_put( "PCAL3" , pcal3 ) 6134 CALL wrk_dealloc( jpi, jpj, jpk, pcal3 ) 6135 ENDIF 6136 IF( med_diag%REMOC3%dgsave ) THEN 6137 CALL iom_put( "REMOC3" , remoc3 ) 6138 CALL wrk_dealloc( jpi, jpj, jpk, remoc3 ) 6139 ENDIF 6140 IF( med_diag%PNLIMJ3%dgsave ) THEN 6141 CALL iom_put( "PNLIMJ3" , pnlimj3 ) 6142 CALL wrk_dealloc( jpi, jpj, jpk, pnlimj3 ) 6143 ENDIF 6144 IF( med_diag%PNLIMN3%dgsave ) THEN 6145 CALL iom_put( "PNLIMN3" , pnlimn3 ) 6146 CALL wrk_dealloc( jpi, jpj, jpk, pnlimn3 ) 6147 ENDIF 6148 IF( med_diag%PNLIMFE3%dgsave ) THEN 6149 CALL iom_put( "PNLIMFE3" , pnlimfe3 ) 6150 CALL wrk_dealloc( jpi, jpj, jpk, pnlimfe3 ) 6151 ENDIF 6152 IF( med_diag%PDLIMJ3%dgsave ) THEN 6153 CALL iom_put( "PDLIMJ3" , pdlimj3 ) 6154 CALL wrk_dealloc( jpi, jpj, jpk, pdlimj3 ) 6155 ENDIF 6156 IF( med_diag%PDLIMN3%dgsave ) THEN 6157 CALL iom_put( "PDLIMN3" , pdlimn3 ) 6158 CALL wrk_dealloc( jpi, jpj, jpk, pdlimn3 ) 6159 ENDIF 6160 IF( med_diag%PDLIMFE3%dgsave ) THEN 6161 CALL iom_put( "PDLIMFE3" , pdlimfe3 ) 6162 CALL wrk_dealloc( jpi, jpj, jpk, pdlimfe3 ) 6163 ENDIF 6164 IF( med_diag%PDLIMSI3%dgsave ) THEN 6165 CALL iom_put( "PDLIMSI3" , pdlimsi3 ) 6166 CALL wrk_dealloc( jpi, jpj, jpk, pdlimsi3 ) 6167 ENDIF 6168 6169 # endif 6170 6171 CALL wrk_dealloc( jpi, jpj, zw2d ) 6172 6173 ENDIF ! end of ln_diatrc option 6174 6175 # if defined key_trc_diabio 6176 !! Lateral boundary conditions on trcbio 6177 DO jn=1,jp_medusa_trd 6178 CALL lbc_lnk(trbio(:,:,1,jn),'T',1. ) 6179 ENDDO 6180 # endif 643 644 !! CLOSE vertical loop 645 ENDDO 646 647 !!------------------------------------------------------------------ 648 !! Final calculations for diagnostics 649 !!------------------------------------------------------------------ 650 CALL bio_medusa_fin( kt ) 6181 651 6182 652 # if defined key_debug_medusa … … 6188 658 6189 659 #else 6190 !!===================================================================== =660 !!===================================================================== 6191 661 !! Dummy module : No MEDUSA bio-model 6192 !!===================================================================== =662 !!===================================================================== 6193 663 CONTAINS 6194 664 SUBROUTINE trc_bio_medusa( kt ) ! Empty routine … … 6198 668 #endif 6199 669 6200 !!===================================================================== =670 !!===================================================================== 6201 671 END MODULE trcbio_medusa -
branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcnam_medusa.F90
r8131 r8657 93 93 INTEGER :: jl, jn 94 94 INTEGER :: ios ! Local integer output status for namelist read 95 TYPE(DIAG), DIMENSION(jp_medusa_2d) :: meddia2d96 TYPE(DIAG), DIMENSION(jp_medusa_3d) :: meddia3d97 TYPE(DIAG), DIMENSION(jp_medusa_trd) :: meddiabio98 95 CHARACTER(LEN=32) :: clname 99 96 !! 100 NAMELIST/nammeddia/ meddia3d, meddia2d ! additional diagnostics101 102 97 !!---------------------------------------------------------------------- 103 98 … … 126 121 # if defined key_debug_medusa 127 122 CALL flush(numout) 128 # endif129 !130 # if defined key_debug_medusa131 IF (lwp) write (numout,*) '------------------------------'132 IF (lwp) write (numout,*) 'Jpalm - debug'133 IF (lwp) write (numout,*) 'Just before reading namelist_medusa :: nammeddia'134 IF (lwp) write (numout,*) ' '135 CALL flush(numout)136 # endif137 138 IF( ( .NOT.lk_iomput .AND. ln_diatrc ) .OR. ( ln_diatrc .AND. lk_medusa ) ) THEN139 !140 ! Namelist nammeddia141 ! -------------------142 REWIND( numnatp_ref ) ! Namelist nammeddia in reference namelist : MEDUSA diagnostics143 READ ( numnatp_ref, nammeddia, IOSTAT = ios, ERR = 901)144 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammeddia in reference namelist', lwp )145 146 REWIND( numnatp_cfg ) ! Namelist nammeddia in configuration namelist : MEDUSA diagnostics147 READ ( numnatp_cfg, nammeddia, IOSTAT = ios, ERR = 902 )148 902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nammeddia in configuration namelist', lwp )149 IF(lwm) WRITE ( numonp, nammeddia )150 151 # if defined key_debug_medusa152 IF (lwp) write (numout,*) '------------------------------'153 IF (lwp) write (numout,*) 'Jpalm - debug'154 IF (lwp) write (numout,*) 'reading namelist_medusa :: nammeddia OK'155 IF (lwp) write (numout,*) 'Check number of variable in nammeddia:'156 IF (lwp) write (numout,*) 'jp_medusa_2d: ',jp_medusa_2d ,'jp_medusa_3d: ',jp_medusa_3d157 IF (lwp) write (numout,*) ' '158 CALL flush(numout)159 # endif160 DO jl = 1, jp_medusa_2d161 jn = jp_msa0_2d + jl - 1162 # if defined key_debug_medusa163 IF (lwp) write (numout,*) 'Check what is readden in nammeddia: -- 2D'164 IF (lwp) write (numout,*) jl,'meddia2d-sname: ',meddia2d(jl)%sname165 IF (lwp) write (numout,*) jl,'meddia2d-lname: ',meddia2d(jl)%lname166 IF (lwp) write (numout,*) jl,'meddia2d-units: ',meddia2d(jl)%units167 CALL flush(numout)168 # endif169 ctrc2d(jn) = meddia2d(jl)%sname170 ctrc2l(jn) = meddia2d(jl)%lname171 ctrc2u(jn) = meddia2d(jl)%units172 END DO173 174 DO jl = 1, jp_medusa_3d175 jn = jp_msa0_3d + jl - 1176 # if defined key_debug_medusa177 IF (lwp) write (numout,*) 'Check what is readden in nammeddia: -- 3D'178 IF (lwp) write (numout,*) jl,'meddia3d-sname: ',meddia3d(jl)%sname179 IF (lwp) write (numout,*) jl,'meddia3d-lname: ',meddia3d(jl)%lname180 IF (lwp) write (numout,*) jl,'meddia3d-units: ',meddia3d(jl)%units181 CALL flush(numout)182 # endif183 ctrc3d(jn) = meddia3d(jl)%sname184 ctrc3l(jn) = meddia3d(jl)%lname185 ctrc3u(jn) = meddia3d(jl)%units186 END DO187 188 IF(lwp) THEN ! control print189 # if defined key_debug_medusa190 IF (lwp) write (numout,*) '------------------------------'191 IF (lwp) write (numout,*) 'Jpalm - debug'192 IF (lwp) write (numout,*) 'Var name assignation OK'193 IF (lwp) write (numout,*) 'next check var names'194 IF (lwp) write (numout,*) ' '195 CALL flush(numout)196 # endif197 WRITE(numout,*)198 WRITE(numout,*) ' Namelist : natadd'199 DO jl = 1, jp_medusa_3d200 jn = jp_msa0_3d + jl - 1201 WRITE(numout,*) ' 3d diag nb : ', jn, ' short name : ', ctrc3d(jn), &202 & ' long name : ', ctrc3l(jn), ' unit : ', ctrc3u(jn)203 END DO204 WRITE(numout,*) ' '205 206 DO jl = 1, jp_medusa_2d207 jn = jp_msa0_2d + jl - 1208 WRITE(numout,*) ' 2d diag nb : ', jn, ' short name : ', ctrc2d(jn), &209 & ' long name : ', ctrc2l(jn), ' unit : ', ctrc2u(jn)210 END DO211 WRITE(numout,*) ' '212 ENDIF213 !214 ENDIF215 !216 # if defined key_debug_medusa217 CALL flush(numout)218 123 # endif 219 124 … … 2148 2053 med_diag%OCN_DPCO2%dgsave = .FALSE. 2149 2054 ENDIF 2150 !! 2055 !! UKESM additional 2056 IF (iom_use("CHL_MLD")) THEN 2057 med_diag%CHL_MLD%dgsave = .TRUE. 2058 ELSE 2059 med_diag%CHL_MLD%dgsave = .FALSE. 2060 ENDIF 2061 !! 3D 2151 2062 IF (iom_use("TPP3")) THEN 2152 2063 med_diag%TPP3%dgsave = .TRUE. -
branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcsed_medusa.F90
r8074 r8657 45 45 46 46 !! * Module variables 47 INTEGER :: &48 ryyss, & !: number of seconds per year49 rmtss !: number of seconds per month47 !! INTEGER :: & 48 !! ryyss, & !: number of seconds per year 49 !! rmtss !: number of seconds per month 50 50 51 51 !! AXY (10/02/09) … … 123 123 124 124 ! Number of seconds per year and per month 125 ryyss = nyear_len(1) * rday126 rmtss = ryyss / raamo125 !! ryyss = nyear_len(1) * rday 126 !! rmtss = ryyss / raamo 127 127 128 128 !! AXY (20/11/14): alter this to report on first MEDUSA call … … 173 173 ztra = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / fse3t(ji,jj,jk) 174 174 tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + ztra 175 # if defined key_trc_diabio 176 trbio(ji,jj,jk,8) = ztra 177 # endif 178 IF (lk_iomput .AND. .NOT. ln_diatrc) THEN 179 IF( med_diag%DSED%dgsave ) THEN 180 zw2d(ji,jj) = zw2d(ji,jj) + ztra * fse3t(ji,jj,jk) * 86400. 181 ENDIF 182 ELSE IF( ln_diatrc ) THEN 183 trc2d(ji,jj,8) = trc2d(ji,jj,8) + ztra * fse3t(ji,jj,jk) * 86400. 184 ENDIF 175 IF( med_diag%DSED%dgsave ) THEN 176 zw2d(ji,jj) = zw2d(ji,jj) + ztra * fse3t(ji,jj,jk) * 86400. 177 ENDIF 185 178 186 179 END DO … … 188 181 END DO 189 182 ! 190 # if defined key_trc_diabio 191 CALL lbc_lnk (trbio(:,:,1,8), 'T', 1. ) ! Lateral boundary conditions on trcbio 192 # endif 193 IF( ln_diatrc ) CALL lbc_lnk( trc2d(:,:,8), 'T', 1. ) ! Lateral boundary conditions on trc2d 194 !! 195 IF (lk_iomput .AND. .NOT. ln_diatrc) THEN 196 IF( med_diag%DSED%dgsave ) THEN 197 CALL iom_put( "DSED" , zw2d) 198 CALL wrk_dealloc( jpi, jpj, zw2d ) 199 ENDIF 200 ELSE IF (lk_iomput .AND. ln_diatrc) THEN 201 CALL iom_put( "DSED",trc2d(:,:,8) ) 183 IF( med_diag%DSED%dgsave ) THEN 184 CALL iom_put( "DSED" , zw2d) 185 CALL wrk_dealloc( jpi, jpj, zw2d ) 202 186 ENDIF 203 187 !! … … 229 213 ztra = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / fse3t(ji,jj,jk) 230 214 tra(ji,jj,jk,jpdtc) = tra(ji,jj,jk,jpdtc) + ztra 231 !! # if defined key_trc_diabio232 !! trbio(ji,jj,jk,8) = ztra233 !! # endif234 !! IF( ln_diatrc ) &235 !! & trc2d(ji,jj,8) = trc2d(ji,jj,8) + ztra * fse3t(ji,jj,jk) * 86400.236 215 END DO 237 216 END DO 238 217 END DO 239 218 ! 240 !! # if defined key_trc_diabio241 !! CALL lbc_lnk (trbio(:,:,1,8), 'T', 1. ) ! Lateral boundary conditions on trcbio242 !! # endif243 !! IF( ln_diatrc ) CALL lbc_lnk( trc2d(:,:,8), 'T', 1. ) ! Lateral boundary conditions on trc2d244 !! # if defined key_iomput245 !! CALL iom_put( "DSED",trc2d(:,:,8) )246 !! # endif247 219 248 220 # endif -
branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcsms_medusa.F90
r8074 r8657 8 8 !! - ! 2008-11 (A. Yool) continuing adaptation for MEDUSA 9 9 !! - ! 2010-03 (A. Yool) updated for branch inclusion 10 !! - ! 2017-08 (A. Yool) amend for slow detritus bug 10 11 !!---------------------------------------------------------------------- 11 12 #if defined key_medusa … … 88 89 # endif 89 90 90 CALL trc_sed_medusa( kt ) ! sedimentation model 91 # if defined key_debug_medusa 92 IF(lwp) WRITE(numout,*) ' MEDUSA done trc_sed_medusa' 93 CALL flush(numout) 94 # endif 91 !! AXY (08/08/2017): remove call to buggy subroutine (now handled by detritus.F90) 92 !! CALL trc_sed_medusa( kt ) ! sedimentation model 93 !! # if defined key_debug_medusa 94 !! IF(lwp) WRITE(numout,*) ' MEDUSA done trc_sed_medusa' 95 !! CALL flush(numout) 96 !! # endif 95 97 # endif 96 98 -
branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90
r8280 r8657 29 29 USE trdtra 30 30 USE prtctl_trc ! Print control 31 !! USE lbclnk ! ocean lateral boundary conditions (or mpp link)32 31 33 32 IMPLICIT NONE … … 109 108 zvn(:,:,jpk) = 0._wp ! no transport trough the bottom 110 109 zwn(:,:,jpk) = 0._wp ! no transport trough the bottom 111 !112 !! Jpalm -- 14-01-2016 -- restart and proc pb - try this...113 !! DO jn = 1, jptra114 !! CALL lbc_lnk( trn(:,:,:,jn), 'T', 1. )115 !! CALL lbc_lnk( trb(:,:,:,jn), 'T', 1. )116 !! END DO117 !118 110 119 111 IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif ) & ! add the eiv transport (if necessary) -
branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90
r8356 r8657 77 77 IF( ln_trcdmp ) CALL trc_dmp( kstp ) ! internal damping trends 78 78 CALL trc_adv( kstp ) ! horizontal & vertical advection 79 # if defined key_debug_medusa80 IF(lwp) WRITE(numout,*) ' MEDUSA trc_trp after trc_adv at kt =', kstp81 CALL trc_rst_tra_stat82 CALL flush(numout)83 # endif84 85 79 IF( ln_zps ) THEN 86 80 IF( ln_isfcav ) THEN ; CALL zps_hde_isf( kstp, jptra, trb, pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi ) ! both top & bottom … … 95 89 #endif 96 90 CALL trc_zdf( kstp ) ! vertical mixing and after tracer fields 97 # if defined key_debug_medusa98 IF(lwp) WRITE(numout,*) ' MEDUSA trc_trp after trc_zdf at kt =', kstp99 CALL trc_rst_tra_stat100 CALL flush(numout)101 # endif102 91 CALL trc_nxt( kstp ) ! tracer fields at next time step 103 92 # if defined key_debug_medusa -
branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/TOP_SRC/par_trc.F90
r8280 r8657 15 15 USE par_c14b ! C14 bomb tracer 16 16 USE par_cfc ! CFC 11 and 12 tracers 17 USE par_age ! AGE tracer 17 18 USE par_my_trc ! user defined passive tracers 19 USE par_idtra ! Idealize tracer 18 20 USE par_medusa ! MEDUSA model 19 USE par_idtra ! Idealize tracer20 USE par_age ! AGE tracer21 21 22 22 IMPLICIT NONE … … 28 28 ! Passive tracers : Total size 29 29 ! --------------- ! total number of passive tracers, of 2d and 3d output and trend arrays 30 INTEGER, PUBLIC, PARAMETER :: jptra = jp_pisces + jp_cfc + jp_c14b + jp_ my_trc + jp_medusa + jp_idtra + jp_age31 INTEGER, PUBLIC, PARAMETER :: jpdia2d = jp_pisces_2d + jp_cfc_2d + jp_c14b_2d + jp_ my_trc_2d + jp_medusa_2d + jp_idtra_2d + jp_age_2d32 INTEGER, PUBLIC, PARAMETER :: jpdia3d = jp_pisces_3d + jp_cfc_3d + jp_c14b_3d + jp_ my_trc_3d + jp_medusa_3d + jp_idtra_3d + jp_age_3d30 INTEGER, PUBLIC, PARAMETER :: jptra = jp_pisces + jp_cfc + jp_c14b + jp_age + jp_my_trc + jp_idtra + jp_medusa 31 INTEGER, PUBLIC, PARAMETER :: jpdia2d = jp_pisces_2d + jp_cfc_2d + jp_c14b_2d + jp_age_2d + jp_my_trc_2d + jp_idtra_2d + jp_medusa_2d 32 INTEGER, PUBLIC, PARAMETER :: jpdia3d = jp_pisces_3d + jp_cfc_3d + jp_c14b_3d + jp_age_3d + jp_my_trc_3d + jp_idtra_3d + jp_medusa_3d 33 33 ! ! total number of sms diagnostic arrays 34 INTEGER, PUBLIC, PARAMETER :: jpdiabio = jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_ my_trc_trd + jp_medusa_trd + jp_idtra_trd + jp_age_trd34 INTEGER, PUBLIC, PARAMETER :: jpdiabio = jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_age_trd + jp_my_trc_trd + jp_idtra_trd + jp_medusa_trd 35 35 36 36 ! 1D configuration ("key_c1d") -
branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/TOP_SRC/trc.F90
r8280 r8657 134 134 OCN_KWCO2, OCN_K0, CO2STARAIR, OCN_DPCO2, & ! end of regular 2D 135 135 TPP3, DETFLUX3, REMIN3N, PH3, OM_CAL3, & ! end of regular 3D 136 ! JPALM (01/09/17): additional UKESM 2D diag 137 CHL_MLD, & 136 138 ! AXY (11/11/16): additional CMIP6 2D diagnostics 137 139 epC100, epCALC100, epN100, epSI100, & -
branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/TOP_SRC/trcini.F90
r8356 r8657 24 24 USE trcini_pisces ! PISCES initialisation 25 25 USE trcini_c14b ! C14 bomb initialisation 26 USE trcini_age ! AGE initialisation 26 27 USE trcini_my_trc ! MY_TRC initialisation 28 USE trcini_idtra ! idealize tracer initialisation 27 29 USE trcini_medusa ! MEDUSA initialisation 28 USE trcini_idtra ! idealize tracer initialisation29 USE trcini_age ! AGE initialisation30 30 USE trcdta ! initialisation from files 31 31 USE daymod ! calendar manager … … 79 79 & CALL ctl_warn(' Coupling with passive tracers and used of diurnal cycle. & 80 80 & Computation of a daily mean shortwave for some biogeochemical models) ') 81 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 82 !!!!! CHECK For MEDUSA 83 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 81 84 82 IF( nn_cla == 1 ) & 85 83 & CALL ctl_stop( ' Cross Land Advection not yet implemented with passive tracer ; nn_cla must be 0' ) … … 102 100 103 101 IF( lk_pisces ) CALL trc_ini_pisces ! PISCES bio-model 104 IF( lk_medusa ) CALL trc_ini_medusa ! MEDUSA tracers105 IF( lk_idtra ) CALL trc_ini_idtra ! Idealize tracers106 102 IF( lk_cfc ) CALL trc_ini_cfc ! CFC tracers 107 103 IF( lk_c14b ) CALL trc_ini_c14b ! C14 bomb tracer 108 104 IF( lk_age ) CALL trc_ini_age ! AGE tracer 109 105 IF( lk_my_trc ) CALL trc_ini_my_trc ! MY_TRC tracers 106 IF( lk_idtra ) CALL trc_ini_idtra ! Idealize tracers 107 IF( lk_medusa ) CALL trc_ini_medusa ! MEDUSA tracers 110 108 111 109 CALL trc_ice_ini ! Tracers in sea ice 112 113 # if defined key_debug_medusa114 IF (lwp) write (numout,*) '------------------------------'115 IF (lwp) write (numout,*) 'Jpalm - debug'116 IF (lwp) write (numout,*) ' in trc_init'117 IF (lwp) write (numout,*) ' sms init OK'118 IF (lwp) write (numout,*) ' next: open tracer.stat'119 IF (lwp) write (numout,*) ' '120 CALL flush(numout)121 # endif122 110 123 111 IF( ln_ctl ) THEN … … 133 121 ENDIF 134 122 135 # if defined key_debug_medusa136 IF (lwp) write (numout,*) '------------------------------'137 IF (lwp) write (numout,*) 'Jpalm - debug'138 IF (lwp) write (numout,*) ' in trc_init'139 IF (lwp) write (numout,*) 'open tracer.stat -- OK'140 IF (lwp) write (numout,*) ' '141 CALL flush(numout)142 # endif143 144 145 123 IF( ln_trcdta ) THEN 146 #if defined key_medusa147 IF(lwp) WRITE(numout,*) 'AXY: calling trc_dta_init'148 IF(lwp) CALL flush(numout)149 #endif150 124 CALL trc_dta_init(jptra) 151 125 ENDIF … … 153 127 IF( ln_rsttr ) THEN 154 128 ! 155 #if defined key_medusa156 IF(lwp) WRITE(numout,*) 'AXY: calling trc_rst_read'157 IF(lwp) CALL flush(numout)158 #endif159 129 CALL trc_rst_read ! restart from a file 160 130 ! 161 131 ELSE 162 !163 # if defined key_debug_medusa164 IF (lwp) write (numout,*) '------------------------------'165 IF (lwp) write (numout,*) 'Jpalm - debug'166 IF (lwp) write (numout,*) ' Init from file -- will call trc_dta'167 IF (lwp) write (numout,*) ' '168 CALL flush(numout)169 # endif170 132 ! 171 133 IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN ! Initialisation of tracer from a file that may also be used for damping … … 188 150 ENDIF 189 151 ! 190 # if defined key_debug_medusa191 IF (lwp) write (numout,*) '------------------------------'192 IF (lwp) write (numout,*) 'Jpalm - debug'193 IF (lwp) write (numout,*) ' in trc_init'194 IF (lwp) write (numout,*) ' before trb = trn'195 IF (lwp) write (numout,*) ' '196 CALL flush(numout)197 # endif198 !199 152 trb(:,:,:,:) = trn(:,:,:,:) 200 153 ! 201 # if defined key_debug_medusa202 IF (lwp) write (numout,*) '------------------------------'203 IF (lwp) write (numout,*) 'Jpalm - debug'204 IF (lwp) write (numout,*) ' in trc_init'205 IF (lwp) write (numout,*) ' trb = trn -- OK'206 IF (lwp) write (numout,*) ' '207 CALL flush(numout)208 # endif209 !210 154 ENDIF 211 155 212 156 tra(:,:,:,:) = 0._wp 213 157 ! 214 # if defined key_debug_medusa215 IF (lwp) write (numout,*) '------------------------------'216 IF (lwp) write (numout,*) 'Jpalm - debug'217 IF (lwp) write (numout,*) ' in trc_init'218 IF (lwp) write (numout,*) ' partial step -- OK'219 IF (lwp) write (numout,*) ' '220 CALL flush(numout)221 # endif222 !223 158 IF( nn_dttrc /= 1 ) CALL trc_sub_ini ! Initialize variables for substepping passive tracers 224 159 ! 225 # if defined key_debug_medusa 226 IF (lwp) write (numout,*) '------------------------------' 227 IF (lwp) write (numout,*) 'Jpalm - debug' 228 IF (lwp) write (numout,*) ' in trc_init' 229 IF (lwp) write (numout,*) ' before initiate tracer contents' 230 IF (lwp) write (numout,*) ' ' 231 CALL flush(numout) 232 # endif 233 ! 160 234 161 trai(:) = 0._wp ! initial content of all tracers 235 162 DO jn = 1, jptra … … 295 222 USE trdmxl_trc , ONLY: trd_mxl_trc_alloc 296 223 #endif 224 # if defined key_medusa 225 USE bio_medusa_mod, ONLY: bio_medusa_alloc 226 # endif 227 297 228 ! 298 229 INTEGER :: ierr … … 307 238 ierr = ierr + trd_mxl_trc_alloc() 308 239 #endif 240 #if defined key_medusa 241 ierr = ierr + bio_medusa_alloc() 242 #endif 309 243 ! 310 244 IF( lk_mpp ) CALL mpp_sum( ierr ) -
branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/TOP_SRC/trcnam.F90
r8280 r8657 25 25 USE trcnam_cfc ! CFC SMS namelist 26 26 USE trcnam_c14b ! C14 SMS namelist 27 USE trcnam_age ! AGE SMS namelist 27 28 USE trcnam_my_trc ! MY_TRC SMS namelist 29 USE trcnam_idtra ! Idealise tracer namelist 28 30 USE trcnam_medusa ! MEDUSA namelist 29 USE trcnam_idtra ! Idealise tracer namelist30 USE trcnam_age ! AGE SMS namelist31 31 USE trd_oce 32 32 USE trdtrc_oce … … 65 65 66 66 ! ! passive tracer informations 67 # if defined key_debug_medusa68 CALL flush(numout)69 IF (lwp) write (numout,*) '------------------------------'70 IF (lwp) write (numout,*) 'Jpalm - debug'71 IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_trc'72 IF (lwp) write (numout,*) ' '73 # endif74 !75 67 CALL trc_nam_trc 76 68 77 69 ! ! Parameters of additional diagnostics 78 # if defined key_debug_medusa79 CALL flush(numout)80 IF (lwp) write (numout,*) '------------------------------'81 IF (lwp) write (numout,*) 'Jpalm - debug'82 IF (lwp) write (numout,*) 'CALL trc_nam_trc -- OK'83 IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_dia'84 IF (lwp) write (numout,*) ' '85 # endif86 !87 88 70 CALL trc_nam_dia 89 71 90 72 ! ! namelist of transport 91 # if defined key_debug_medusa92 CALL flush(numout)93 IF (lwp) write (numout,*) '------------------------------'94 IF (lwp) write (numout,*) 'Jpalm - debug'95 IF (lwp) write (numout,*) 'CALL trc_nam_dia -- OK'96 IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_trp'97 IF (lwp) write (numout,*) ' '98 # endif99 !100 73 CALL trc_nam_trp 101 !102 # if defined key_debug_medusa103 CALL flush(numout)104 IF (lwp) write (numout,*) '------------------------------'105 IF (lwp) write (numout,*) 'Jpalm - debug'106 IF (lwp) write (numout,*) 'CALL trc_nam_trp -- OK'107 IF (lwp) write (numout,*) 'continue trc_nam '108 IF (lwp) write (numout,*) ' '109 CALL flush(numout)110 # endif111 !112 74 113 75 … … 131 93 END DO 132 94 WRITE(numout,*) ' ' 133 # if defined key_debug_medusa134 CALL flush(numout)135 # endif136 95 ENDIF 137 96 … … 152 111 WRITE(numout,*) 153 112 ENDIF 154 # if defined key_debug_medusa155 CALL flush(numout)156 # endif157 113 ENDIF 158 114 … … 170 126 WRITE(numout,*) ' Passive Tracer time step rdttrc = ', rdttrc(1) 171 127 WRITE(numout,*) 172 # if defined key_debug_medusa173 CALL flush(numout)174 # endif175 128 ENDIF 176 129 … … 200 153 IF( ln_trdtrc(jn) ) WRITE(numout,*) ' compute ML trends for tracer number :', jn 201 154 END DO 202 WRITE(numout,*) ' '203 CALL flush(numout)204 155 ENDIF 205 156 #endif 206 157 207 # if defined key_debug_medusa208 CALL flush(numout)209 IF (lwp) write (numout,*) '------------------------------'210 IF (lwp) write (numout,*) 'Jpalm - debug'211 IF (lwp) write (numout,*) 'just before ice module for tracers call : '212 IF (lwp) write (numout,*) ' '213 # endif214 !215 158 216 159 ! Call the ice module for tracers 217 160 ! ------------------------------- 218 161 CALL trc_nam_ice 219 220 # if defined key_debug_medusa221 CALL flush(numout)222 IF (lwp) write (numout,*) '------------------------------'223 IF (lwp) write (numout,*) 'Jpalm - debug'224 IF (lwp) write (numout,*) 'Will now read SMS namelists : '225 IF (lwp) write (numout,*) ' '226 # endif227 !228 162 229 163 ! namelist of SMS … … 232 166 ELSE ; IF(lwp) WRITE(numout,*) ' PISCES not used' 233 167 ENDIF 234 ! 235 # if defined key_debug_medusa 236 CALL flush(numout) 237 IF (lwp) write (numout,*) '------------------------------' 238 IF (lwp) write (numout,*) 'Jpalm - debug' 239 IF (lwp) write (numout,*) 'CALL trc_nam_pisces -- OK' 240 IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_medusa' 241 IF (lwp) write (numout,*) ' ' 242 # endif 243 ! 168 169 IF( lk_cfc ) THEN ; CALL trc_nam_cfc ! CFC tracers 170 ELSE ; IF(lwp) WRITE(numout,*) ' CFC not used' 171 ENDIF 172 173 IF( lk_c14b ) THEN ; CALL trc_nam_c14b ! C14 bomb tracers 174 ELSE ; IF(lwp) WRITE(numout,*) ' C14 not used' 175 ENDIF 176 177 IF( lk_age ) THEN ; CALL trc_nam_age ! AGE tracer 178 ELSE ; IF(lwp) WRITE(numout,*) ' AGE not used' 179 ENDIF 180 181 IF( lk_my_trc ) THEN ; CALL trc_nam_my_trc ! MY_TRC tracers 182 ELSE ; IF(lwp) WRITE(numout,*) ' MY_TRC not used' 183 ENDIF 184 185 IF( lk_idtra ) THEN ; CALL trc_nam_idtra ! Idealize tracers 186 ELSE ; IF(lwp) WRITE(numout,*) ' Idealize tracers not used' 187 ENDIF 188 244 189 IF( lk_medusa ) THEN ; CALL trc_nam_medusa ! MEDUSA tracers 245 190 ELSE ; IF(lwp) WRITE(numout,*) ' MEDUSA not used' 246 191 ENDIF 247 192 ! 248 # if defined key_debug_medusa249 CALL flush(numout)250 IF (lwp) write (numout,*) '------------------------------'251 IF (lwp) write (numout,*) 'Jpalm - debug'252 IF (lwp) write (numout,*) 'CALL trc_nam_medusa -- OK'253 IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_idtra'254 IF (lwp) write (numout,*) ' '255 # endif256 !257 IF( lk_idtra ) THEN ; CALL trc_nam_idtra ! Idealize tracers258 ELSE ; IF(lwp) WRITE(numout,*) ' Idealize tracers not used'259 ENDIF260 !261 # if defined key_debug_medusa262 CALL flush(numout)263 IF (lwp) write (numout,*) '------------------------------'264 IF (lwp) write (numout,*) 'Jpalm - debug'265 IF (lwp) write (numout,*) 'CALL trc_nam_idtra -- OK'266 IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_cfc'267 IF (lwp) write (numout,*) ' '268 # endif269 !270 IF( lk_cfc ) THEN ; CALL trc_nam_cfc ! CFC tracers271 ELSE ; IF(lwp) WRITE(numout,*) ' CFC not used'272 ENDIF273 !274 # if defined key_debug_medusa275 CALL flush(numout)276 IF (lwp) write (numout,*) '------------------------------'277 IF (lwp) write (numout,*) 'Jpalm - debug'278 IF (lwp) write (numout,*) 'CALL trc_nam_cfc -- OK'279 IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_c14'280 IF (lwp) write (numout,*) ' '281 # endif282 !283 IF( lk_c14b ) THEN ; CALL trc_nam_c14b ! C14 bomb tracers284 ELSE ; IF(lwp) WRITE(numout,*) ' C14 not used'285 ENDIF286 !287 # if defined key_debug_medusa288 CALL flush(numout)289 IF (lwp) write (numout,*) '------------------------------'290 IF (lwp) write (numout,*) 'Jpalm - debug'291 IF (lwp) write (numout,*) 'CALL trc_nam_c14 -- OK'292 IF (lwp) write (numout,*) 'in trc_nam - just before CALL trc_nam_age'293 IF (lwp) write (numout,*) ' '294 # endif295 !296 IF( lk_age ) THEN ; CALL trc_nam_age ! AGE tracer297 ELSE ; IF(lwp) WRITE(numout,*) ' AGE not used'298 ENDIF299 !300 # if defined key_debug_medusa301 CALL flush(numout)302 IF (lwp) write (numout,*) '------------------------------'303 IF (lwp) write (numout,*) 'Jpalm - debug'304 IF (lwp) write (numout,*) 'CALL trc_nam_age -- OK'305 IF (lwp) write (numout,*) 'in trc_nam - CALL trc_nam -- OK'306 IF (lwp) write (numout,*) ' '307 # endif308 !309 IF( lk_my_trc ) THEN ; CALL trc_nam_my_trc ! MY_TRC tracers310 ELSE ; IF(lwp) WRITE(numout,*) ' MY_TRC not used'311 ENDIF312 313 IF(lwp) CALL flush(numout)314 193 END SUBROUTINE trc_nam 315 194 … … 450 329 ln_trc_wri(jn) = sn_tracer(jn)%llsave 451 330 END DO 452 IF(lwp) CALL flush(numout) 453 331 454 332 END SUBROUTINE trc_nam_trc 455 333 … … 504 382 CALL flush(numout) 505 383 ENDIF 506 !! 507 !! JPALM -- 17-07-2015 -- 508 !! MEDUSA is not yet up-to-date with the iom server. 509 !! we use it for the main tracer, but not fully with diagnostics. 510 !! will have to adapt it properly when visiting Christian Ethee 511 !! for now, we change 512 !! IF( ln_diatrc .AND. .NOT. lk_iomput ) THEN 513 !! to : 514 !! 384 515 385 IF( ( ln_diatrc .AND. .NOT. lk_iomput ) .OR. ( ln_diatrc .AND. lk_medusa ) ) THEN 516 386 ALLOCATE( trc2d(jpi,jpj,jpdia2d), trc3d(jpi,jpj,jpk,jpdia3d), & … … 522 392 trc3d(:,:,:,:) = 0._wp ; ctrc3d(:) = ' ' ; ctrc3l(:) = ' ' ; ctrc3u(:) = ' ' 523 393 ! 524 !! ELSE IF ( lk_iomput .AND. lk_medusa .AND. .NOT. ln_diatrc) THEN525 !! CALL trc_nam_iom_medusa526 394 ENDIF 527 395 -
branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/TOP_SRC/trcrst.F90
r8280 r8657 745 745 !!--------------------------------------------------------------------- 746 746 INTEGER :: jk, jn 747 CHARACTER (LEN=18) :: text_zmean 747 748 REAL(wp) :: ztraf, zmin, zmax, zmean, areasf 748 749 REAL(wp), DIMENSION(jpi,jpj) :: zvol … … 750 751 751 752 IF( lwp ) WRITE(numout,*) 'STAT- ', names 752 ! 753 754 ! fse3t_a will be undefined at the start of a run, but this routine 755 ! may be called at any stage! Hence we MUST make sure it is 756 ! initialised to zero when allocated to enable us to test for 757 ! zero content here and avoid potentially dangerous and non-portable 758 ! operations (e.g. divide by zero, global sums of junk values etc.) 753 759 zvol(:,:) = e1e2t(:,:) * fse3t_a(:,:,1) * tmask(:,:,1) 754 760 ztraf = glob_sum( dgtr(:,:) * zvol(:,:) ) … … 761 767 CALL mpp_max( zmax ) ! max over the global domain 762 768 END IF 763 zmean = ztraf / areasf 764 IF(lwp) WRITE(numout,9002) TRIM( names ), zmean, zmin, zmax 765 ! 766 IF(lwp) WRITE(numout,*) 767 9002 FORMAT(' tracer name :',a10,' mean :',e18.10,' min :',e18.10, & 769 770 text_zmean = "N/A" 771 ! Avoid divide by zero. areasf must be positive. 772 IF (areasf > 0.0) THEN 773 zmean = ztraf / areasf 774 WRITE(text_zmean,'(e18.10)') zmean 775 ENDIF 776 777 IF(lwp) WRITE(numout,9002) TRIM( names ), text_zmean, zmin, zmax 778 779 9002 FORMAT(' tracer name :',A,' mean :',A,' min :',e18.10, & 768 780 & ' max :',e18.10 ) 769 781 ! -
branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/TOP_SRC/trcsms.F90
r8280 r8657 16 16 USE trc ! 17 17 USE trcsms_pisces ! PISCES biogeo-model 18 USE trcsms_medusa ! MEDUSA tracers19 USE trcsms_idtra ! Idealize Tracer20 18 USE trcsms_cfc ! CFC 11 & 12 21 19 USE trcsms_c14b ! C14b tracer 22 20 USE trcsms_age ! AGE tracer 23 21 USE trcsms_my_trc ! MY_TRC tracers 22 USE trcsms_idtra ! Idealize Tracer 23 USE trcsms_medusa ! MEDUSA tracers 24 24 USE prtctl_trc ! Print control for debbuging 25 25 … … 46 46 INTEGER, INTENT( in ) :: kt ! ocean time-step index 47 47 !! 48 INTEGER :: jn49 48 CHARACTER (len=25) :: charout 50 49 !!--------------------------------------------------------------------- … … 53 52 ! 54 53 IF( lk_pisces ) CALL trc_sms_pisces ( kt ) ! main program of PISCES 54 IF( lk_cfc ) CALL trc_sms_cfc ( kt ) ! surface fluxes of CFC 55 IF( lk_c14b ) CALL trc_sms_c14b ( kt ) ! surface fluxes of C14 56 IF( lk_age ) CALL trc_sms_age ( kt ) ! AGE tracer 57 IF( lk_my_trc ) CALL trc_sms_my_trc ( kt ) ! MY_TRC tracers 58 IF( lk_idtra ) CALL trc_sms_idtra ( kt ) ! radioactive decay of Id. tracer 55 59 IF( lk_medusa ) CALL trc_sms_medusa ( kt ) ! MEDUSA tracers 56 # if defined key_debug_medusa57 IF(lwp) WRITE(numout,*) '--trcsms : MEDUSA OK -- next IDTRA -- '58 CALL flush(numout)59 # endif60 IF( lk_idtra ) CALL trc_sms_idtra ( kt ) ! radioactive decay of Id. tracer61 # if defined key_debug_medusa62 IF(lwp) WRITE(numout,*) '--trcsms : IDTRA OK -- next CFC -- '63 CALL flush(numout)64 # endif65 IF( lk_cfc ) CALL trc_sms_cfc ( kt ) ! surface fluxes of CFC66 # if defined key_debug_medusa67 IF(lwp) WRITE(numout,*) '--trcsms : CFC OK -- next C14 -- '68 CALL flush(numout)69 # endif70 IF( lk_c14b ) CALL trc_sms_c14b ( kt ) ! surface fluxes of C1471 # if defined key_debug_medusa72 IF(lwp) WRITE(numout,*) '--trcsms : C14 OK -- next C14 -- '73 CALL flush(numout)74 # endif75 IF( lk_age ) CALL trc_sms_age ( kt ) ! AGE tracer76 # if defined key_debug_medusa77 IF(lwp) WRITE(numout,*) '--trcsms : Age OK -- Continue -- '78 CALL flush(numout)79 # endif80 IF( lk_my_trc ) CALL trc_sms_my_trc ( kt ) ! MY_TRC tracers81 60 82 61 IF(ln_ctl) THEN ! print mean trends (used for debugging) -
branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/TOP_SRC/trcstp.F90
r8356 r8657 89 89 tra(:,:,:,:) = 0.e0 90 90 ! 91 # if defined key_debug_medusa92 IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp begins at kt =', kt93 CALL flush(numout)94 # endif95 91 CALL trc_rst_opn ( kt ) ! Open tracer restart file 96 # if defined key_debug_medusa97 CALL trc_rst_stat98 CALL trc_rst_tra_stat99 # endif100 92 IF( lrst_trc ) CALL trc_rst_cal ( kt, 'WRITE' ) ! calendar 101 93 IF( lk_iomput ) THEN ; CALL trc_wri ( kt ) ! output of passive tracers with iom I/O manager … … 124 116 ! 125 117 IF( nn_dttrc /= 1 ) CALL trc_sub_reset( kt ) ! resetting physical variables when sub-stepping 126 # if defined key_debug_medusa127 IF(lwp) WRITE(numout,*) ' MEDUSA trc_stp ends at kt =', kt128 CALL flush(numout)129 # endif130 118 ! 131 119 ENDIF -
branches/NERC/dev_r5518_GO6_COAREbulk/NEMOGCM/NEMO/TOP_SRC/trcwri.F90
r8280 r8657 21 21 USE trcwri_cfc 22 22 USE trcwri_c14b 23 USE trcwri_age 23 24 USE trcwri_my_trc 25 USE trcwri_idtra 24 26 USE trcwri_medusa 25 USE trcwri_idtra26 USE trcwri_age27 27 28 28 IMPLICIT NONE … … 61 61 ! --------------------------------------- 62 62 IF( lk_pisces ) CALL trc_wri_pisces ! PISCES 63 IF( lk_medusa ) CALL trc_wri_medusa ! MESDUSA64 IF( lk_idtra ) CALL trc_wri_idtra ! Idealize tracers65 63 IF( lk_cfc ) CALL trc_wri_cfc ! surface fluxes of CFC 66 64 IF( lk_c14b ) CALL trc_wri_c14b ! surface fluxes of C14 67 65 IF( lk_age ) CALL trc_wri_age ! AGE tracer 68 66 IF( lk_my_trc ) CALL trc_wri_my_trc ! MY_TRC tracers 67 IF( lk_idtra ) CALL trc_wri_idtra ! Idealize tracers 68 IF( lk_medusa ) CALL trc_wri_medusa ! MESDUSA 69 69 ! 70 70 IF( nn_timing == 1 ) CALL timing_stop('trc_wri')
Note: See TracChangeset
for help on using the changeset viewer.