Changeset 8674 for branches/NERC/dev_r5518_GO6_package_trdtrc
- Timestamp:
- 2017-11-06T17:25:01+01:00 (7 years ago)
- Location:
- branches/NERC/dev_r5518_GO6_package_trdtrc/NEMOGCM
- Files:
-
- 13 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/NERC/dev_r5518_GO6_package_trdtrc/NEMOGCM/CONFIG/SHARED/field_def_bgc.xml
r8673 r8674 472 472 <field id= "DMS_HALL" long_name="DMS Surface Concentration, Halloran" unit="nmol/L" /> 473 473 <field id= "DMS_ANDM" long_name="DMS Surface Concentration, Anderson modif" unit="nmol/L" /> 474 <field id= "CHL_MLD" long_name="MLD averaged Chlorophyll" unit="mg Chl/m3" /> 474 475 <field id= "ATM_XCO2" long_name="Atmospheric xCO2" unit="ppm" /> 475 476 <field id= "OCN_FCO2" long_name="Surface ocean fCO2" unit="uatm" /> … … 1974 1975 <field field_ref= "CO2STARAIR" name="CO2STARAIR" /> 1975 1976 <field field_ref= "OCN_DPCO2" name="OCN_DPCO2" /> 1977 <field field_ref= "CHL_MLD" name="CHL_MLD" /> 1976 1978 </field_group> 1977 1979 -
branches/NERC/dev_r5518_GO6_package_trdtrc/NEMOGCM/NEMO/OPA_SRC/DIA/diaptr.F90
r7747 r8674 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_package_trdtrc/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90
r7771 r8674 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_package_trdtrc/NEMOGCM/NEMO/TOP_SRC/MEDUSA/air_sea.F90
r8442 r8674 6 6 !! History : 7 7 !! - ! 2017-04 (M. Stringer) Code taken from trcbio_medusa.F90 8 !! - ! 2017-08 (A. Yool) Add air-sea flux kill switch 8 9 !!---------------------------------------------------------------------- 9 10 #if defined key_medusa … … 277 278 ENDDO 278 279 ENDDO 280 # endif 281 282 # if defined key_axy_killco2flux 283 !! AXY (18/08/17): single kill switch on air-sea CO2 flux for budget checking 284 f_co2flux(:,:) = 0. 279 285 # endif 280 286 -
branches/NERC/dev_r5518_GO6_package_trdtrc/NEMOGCM/NEMO/TOP_SRC/MEDUSA/bio_medusa_fin.F90
r8442 r8674 6 6 !! History : 7 7 !! - ! 2017-04 (M. Stringer) Code taken from trcbio_medusa.F90 8 !! - ! 2017-08 (A. Yool) Amend bethic reservoir updating 8 9 !!---------------------------------------------------------------------- 9 10 #if defined key_medusa … … 62 63 REAL(wp) :: fq0,fq1,fq2,fq3 63 64 65 # if defined key_roam 66 !!---------------------------------------------------------------------- 67 !! AXY (09/08/17): fix benthic submodel 64 68 !!---------------------------------------------------------------------- 65 69 !! Process benthic in/out fluxes 66 70 !! These can be handled outside of the 3D calculations since the 67 !! benthic pools (and fluxes) are 2D in nature; this code is68 !! (shamelessly) borrowed from corresponding code in the LOBSTER69 !! model71 !! benthic pools (and fluxes) are 2D in nature; this code was 72 !! developed with help from George Nurser (NOC); it cannot be run 73 !! in a configuration with variable time-stepping with depth 70 74 !!---------------------------------------------------------------------- 71 75 !! 72 !! IF(lwp) WRITE(numout,*) 'AXY: rdt = ', rdt76 !! time-step calculation 73 77 if (jorgben.eq.1) then 74 za_sed_n(:,:) = zn_sed_n(:,:) + & 75 ( f_sbenin_n(:,:) + f_fbenin_n(:,:) - & 76 f_benout_n(:,:) ) * (rdt / 86400.) 78 za_sed_n(:,:) = zb_sed_n(:,:) + ((2. * (rdt / 86400.)) * & 79 ( f_sbenin_n(:,:) + f_fbenin_n(:,:) - f_benout_n(:,:) )) 80 za_sed_fe(:,:) = zb_sed_fe(:,:) + ((2. * (rdt / 86400.)) * & 81 ( f_sbenin_fe(:,:) + f_fbenin_fe(:,:) - f_benout_fe(:,:) )) 82 za_sed_c(:,:) = zb_sed_c(:,:) + ((2. * (rdt / 86400.)) * & 83 ( f_sbenin_c(:,:) + f_fbenin_c(:,:) - f_benout_c(:,:) )) 84 endif 85 if (jinorgben.eq.1) then 86 za_sed_si(:,:) = zb_sed_si(:,:) + ((2. * (rdt / 86400.)) * & 87 ( f_fbenin_si(:,:) - f_benout_si(:,:) )) 88 za_sed_ca(:,:) = zb_sed_ca(:,:) + ((2. * (rdt / 86400.)) * & 89 ( f_fbenin_ca(:,:) - f_benout_ca(:,:) )) 90 endif 91 !! 92 !! time-level calculation 93 if (jorgben.eq.1) then 94 zb_sed_n(:,:) = zn_sed_n(:,:) + (atfp * & 95 ( za_sed_n(:,:) - (2. * zn_sed_n(:,:)) + zb_sed_n(:,:) )) 77 96 zn_sed_n(:,:) = za_sed_n(:,:) 78 !! 79 za_sed_fe(:,:) = zn_sed_fe(:,:) + & 80 ( f_sbenin_fe(:,:) + f_fbenin_fe(:,:) - & 81 f_benout_fe(:,:) ) * (rdt / 86400.) 97 zb_sed_fe(:,:) = zn_sed_fe(:,:) + (atfp * & 98 ( za_sed_fe(:,:) - (2. * zn_sed_fe(:,:)) + zb_sed_fe(:,:) )) 82 99 zn_sed_fe(:,:) = za_sed_fe(:,:) 83 !! 84 za_sed_c(:,:) = zn_sed_c(:,:) + & 85 ( f_sbenin_c(:,:) + f_fbenin_c(:,:) - & 86 f_benout_c(:,:) ) * (rdt / 86400.) 100 zb_sed_c(:,:) = zn_sed_c(:,:) + (atfp * & 101 ( za_sed_c(:,:) - (2. * zn_sed_c(:,:)) + zb_sed_c(:,:) )) 87 102 zn_sed_c(:,:) = za_sed_c(:,:) 88 103 endif 89 104 if (jinorgben.eq.1) then 90 za_sed_si(:,:) = zn_sed_si(:,:) + & 91 ( f_fbenin_si(:,:) - f_benout_si(:,:) ) * & 92 (rdt / 86400.) 105 zb_sed_si(:,:) = zn_sed_si(:,:) + (atfp * & 106 ( za_sed_si(:,:) - (2. * zn_sed_si(:,:)) + zb_sed_si(:,:) )) 93 107 zn_sed_si(:,:) = za_sed_si(:,:) 94 !! 95 za_sed_ca(:,:) = zn_sed_ca(:,:) + & 96 ( f_fbenin_ca(:,:) - f_benout_ca(:,:) ) * & 97 (rdt / 86400.) 108 zb_sed_ca(:,:) = zn_sed_ca(:,:) + (atfp * & 109 ( za_sed_ca(:,:) - (2. * zn_sed_ca(:,:)) + zb_sed_ca(:,:) )) 98 110 zn_sed_ca(:,:) = za_sed_ca(:,:) 99 111 endif 100 !! 101 if (ibenthic.eq.2) then 102 !! The code below (in this if ... then ... endif loop) is 103 !! effectively commented out because it does not work as 104 !! anticipated; it can be deleted at a later date 105 if (jorgben.eq.1) then 106 za_sed_n(:,:) = ( f_sbenin_n(:,:) + f_fbenin_n(:,:) - & 107 f_benout_n(:,:) ) * rdt 108 za_sed_fe(:,:) = ( f_sbenin_fe(:,:) + f_fbenin_fe(:,:) - & 109 f_benout_fe(:,:) ) * rdt 110 za_sed_c(:,:) = ( f_sbenin_c(:,:) + f_fbenin_c(:,:) - & 111 f_benout_c(:,:) ) * rdt 112 endif 113 if (jinorgben.eq.1) then 114 za_sed_si(:,:) = ( f_fbenin_si(:,:) - f_benout_si(:,:) ) * rdt 115 za_sed_ca(:,:) = ( f_fbenin_ca(:,:) - f_benout_ca(:,:) ) * rdt 116 endif 117 !! 118 !! Leap-frog scheme - only in explicit case, otherwise the 119 !! time stepping is already being done in trczdf 120 !! IF( l_trczdf_exp .AND. (ln_trcadv_cen2 .OR. ln_trcadv_tvd) ) THEN 121 !! zfact = 2. * rdttra(jk) * FLOAT( ndttrc ) 122 !! IF( neuler == 0 .AND. kt == nittrc000 ) zfact = rdttra(jk) * 123 !! FLOAT(ndttrc) 124 !! if (jorgben.eq.1) then 125 !! za_sed_n(:,:) = zb_sed_n(:,:) + ( zfact * za_sed_n(:,:) ) 126 !! za_sed_fe(:,:) = zb_sed_fe(:,:) + ( zfact * za_sed_fe(:,:) ) 127 !! za_sed_c(:,:) = zb_sed_c(:,:) + ( zfact * za_sed_c(:,:) ) 128 !! endif 129 !! if (jinorgben.eq.1) then 130 !! za_sed_si(:,:) = zb_sed_si(:,:) + ( zfact * za_sed_si(:,:) ) 131 !! za_sed_ca(:,:) = zb_sed_ca(:,:) + ( zfact * za_sed_ca(:,:) ) 132 !! endif 133 !! ENDIF 134 !! 135 !! Time filter and swap of arrays 136 IF( ln_trcadv_cen2 .OR. ln_trcadv_tvd ) THEN ! centred or tvd scheme 137 IF( neuler == 0 .AND. kt == nittrc000 ) THEN 138 if (jorgben.eq.1) then 139 zb_sed_n(:,:) = zn_sed_n(:,:) 140 zn_sed_n(:,:) = za_sed_n(:,:) 141 za_sed_n(:,:) = 0.0 142 !! 143 zb_sed_fe(:,:) = zn_sed_fe(:,:) 144 zn_sed_fe(:,:) = za_sed_fe(:,:) 145 za_sed_fe(:,:) = 0.0 146 !! 147 zb_sed_c(:,:) = zn_sed_c(:,:) 148 zn_sed_c(:,:) = za_sed_c(:,:) 149 za_sed_c(:,:) = 0.0 150 endif 151 if (jinorgben.eq.1) then 152 zb_sed_si(:,:) = zn_sed_si(:,:) 153 zn_sed_si(:,:) = za_sed_si(:,:) 154 za_sed_si(:,:) = 0.0 155 !! 156 zb_sed_ca(:,:) = zn_sed_ca(:,:) 157 zn_sed_ca(:,:) = za_sed_ca(:,:) 158 za_sed_ca(:,:) = 0.0 159 endif 160 ELSE 161 if (jorgben.eq.1) then 162 zb_sed_n(:,:) = (atfp * & 163 ( zb_sed_n(:,:) + za_sed_n(:,:) )) + & 164 (atfp1 * zn_sed_n(:,:) ) 165 zn_sed_n(:,:) = za_sed_n(:,:) 166 za_sed_n(:,:) = 0.0 167 !! 168 zb_sed_fe(:,:) = (atfp * & 169 ( zb_sed_fe(:,:) + za_sed_fe(:,:) )) + & 170 (atfp1 * zn_sed_fe(:,:)) 171 zn_sed_fe(:,:) = za_sed_fe(:,:) 172 za_sed_fe(:,:) = 0.0 173 !! 174 zb_sed_c(:,:) = (atfp * & 175 ( zb_sed_c(:,:) + za_sed_c(:,:) )) + & 176 (atfp1 * zn_sed_c(:,:) ) 177 zn_sed_c(:,:) = za_sed_c(:,:) 178 za_sed_c(:,:) = 0.0 179 endif 180 if (jinorgben.eq.1) then 181 zb_sed_si(:,:) = (atfp * & 182 ( zb_sed_si(:,:) + za_sed_si(:,:) )) + & 183 (atfp1 * zn_sed_si(:,:)) 184 zn_sed_si(:,:) = za_sed_si(:,:) 185 za_sed_si(:,:) = 0.0 186 !! 187 zb_sed_ca(:,:) = (atfp * & 188 ( zb_sed_ca(:,:) + za_sed_ca(:,:) )) + & 189 (atfp1 * zn_sed_ca(:,:)) 190 zn_sed_ca(:,:) = za_sed_ca(:,:) 191 za_sed_ca(:,:) = 0.0 192 endif 193 ENDIF 194 ELSE ! case of smolar scheme or muscl 195 if (jorgben.eq.1) then 196 zb_sed_n(:,:) = za_sed_n(:,:) 197 zn_sed_n(:,:) = za_sed_n(:,:) 198 za_sed_n(:,:) = 0.0 199 !! 200 zb_sed_fe(:,:) = za_sed_fe(:,:) 201 zn_sed_fe(:,:) = za_sed_fe(:,:) 202 za_sed_fe(:,:) = 0.0 203 !! 204 zb_sed_c(:,:) = za_sed_c(:,:) 205 zn_sed_c(:,:) = za_sed_c(:,:) 206 za_sed_c(:,:) = 0.0 207 endif 208 if (jinorgben.eq.1) then 209 zb_sed_si(:,:) = za_sed_si(:,:) 210 zn_sed_si(:,:) = za_sed_si(:,:) 211 za_sed_si(:,:) = 0.0 212 !! 213 zb_sed_ca(:,:) = za_sed_ca(:,:) 214 zn_sed_ca(:,:) = za_sed_ca(:,:) 215 za_sed_ca(:,:) = 0.0 216 endif 217 ENDIF 218 endif 112 # endif 219 113 220 114 # if defined key_debug_medusa … … 253 147 fq1 = f_sbenin_n(ji,jj) + f_fbenin_n(ji,jj) 254 148 fq2 = fq0 + fq1 255 IF (lwp) write (numout,'(a,2i3,a,3f15.10)') & 256 'AXY N cons: (i,j)=',ji,jj,', (flx,ben,err)=', & 257 fq0,fq1,fq2 149 fq3 = f_benout_n(ji,jj) 150 if (lwp) write (numout,'a,2i3,a,4f15,5)') & 151 'AXY N cons: (i,j)=',ji,jj,', (flx,ben,err,out)=', & 152 fq0,fq1,fq2,fq3 258 153 ENDIF 259 154 ENDDO … … 266 161 fq1 = f_fbenin_si(ji,jj) 267 162 fq2 = fq0 + fq1 268 IF (lwp) write (numout,'(a,2i3,a,3f15.10)') & 269 'AXY Si cons: (i,j)=',ji,jj,', (flx,ben,err)=', & 270 fq0,fq1,fq2 163 fq3 = f_benout_si(ji,jj) 164 if (lwp) write (numout,'a,2i3,a,4f15,5)') & 165 'AXY Si cons: (i,j)=',ji,jj,', (flx,ben,err,out)=', & 166 fq0,fq1,fq2,fq3 271 167 ENDIF 272 168 ENDDO … … 278 174 fq0 = fflx_c(ji,jj) 279 175 fq1 = f_sbenin_c(ji,jj) + f_fbenin_c(ji,jj) + f_fbenin_ca(ji,jj) 280 fq2 = f_co2flux(ji,jj) * e3t_n(ji,jj,1)176 fq2 = f_co2flux(ji,jj) * fse3t(ji,jj,1) 281 177 fq3 = fq0 + fq1 282 IF (lwp) write (numout,'(a,2i3,a,4f15.10)') & 283 'AXY C cons: (i,j)=',ji,jj,', (flx,ben,asf,err)=', & 284 fq0,fq1,fq2,fq3 285 ENDIF 286 ENDDO 287 ENDDO 288 !! alkalinity 289 DO jj = 2,jpjm1 290 DO ji = 2,jpim1 291 if (tmask(ji,jj,1) == 1) then 292 fq0 = fflx_a(ji,jj) 293 fq1 = 2.0 * f_fbenin_ca(ji,jj) 294 fq2 = fq0 + fq1 295 IF (lwp) write (numout,'(a,2i3,a,3f15.10)') & 296 'AXY alk cons: (i,j)=',ji,jj,', (flx,ben,err)=', & 297 fq0,fq1,fq2 178 fq4 = f_benout_c(ji,jj) + f_benout_ca(ji,jj) 179 if (lwp) write (numout,'a,2i3,a,5f15,5)') & 180 'AXY C cons: (i,j)=',ji,jj,', (flx,ben,asf,err,out)=', & 181 fq0,fq1,fq2,fq3,fq4 182 ENDIF 183 ENDDO 184 ENDDO 185 !! alkalinity 186 DO jj = 2,jpjm1 187 DO ji = 2,jpim1 188 if (tmask(ji,jj,1) == 1) then 189 fq0 = fflx_a(ji,jj) 190 fq1 = 2.0 * f_fbenin_ca(ji,jj) 191 fq2 = fq0 + fq1 192 fq3 = 2.0 * f_benout_ca(ji,jj) 193 if (lwp) write (numout,'a,2i3,a,4f15,5)') & 194 'AXY alk cons: (i,j)=',ji,jj,', (flx,ben,err,out)=', & 195 fq0,fq1,fq2,fq3 298 196 ENDIF 299 197 ENDDO … … 360 258 CALL iom_put( "OCAL_LVL" , fccd ) 361 259 ENDIF 260 IF ( med_diag%CHL_MLD%dgsave ) THEN 261 CALL iom_put( "CHL_MLD" , fchl_ml ) 262 ENDIF 362 263 IF ( med_diag%PN_JLIM%dgsave ) THEN 363 264 CALL iom_put( "PN_JLIM" , fjln2d ) -
branches/NERC/dev_r5518_GO6_package_trdtrc/NEMOGCM/NEMO/TOP_SRC/MEDUSA/bio_medusa_init.F90
r8442 r8674 6 6 !! History : 7 7 !! - ! 2017-04 (M. Stringer) Code taken from trcbio_medusa.F90 8 !! - ! 2017-08 (A. Yool) Add slow-sinking detrius variables 8 9 !!---------------------------------------------------------------------- 9 10 #if defined key_medusa … … 161 162 fprn_ml(:,:) = 0.0 !! mixed layer PP diagnostics 162 163 fprd_ml(:,:) = 0.0 !! mixed layer PP diagnostics 164 !! AXY (16/08/17) 165 fchl_ml(:,:) = 0.0 !! mixed layer chlorophyll diagnostics 163 166 !! 164 167 fslownflux(:,:) = 0.0 165 168 fslowcflux(:,:) = 0.0 169 !! 170 !! AXY (08/08/17): zero slow detritus fluxes 171 fslowsink(:,:) = 0.0 172 # if defined key_roam 173 fslowsinkc(:,:) = 0.0 174 # endif 166 175 !! 167 176 !! allocate and initiate 2D diag -
branches/NERC/dev_r5518_GO6_package_trdtrc/NEMOGCM/NEMO/TOP_SRC/MEDUSA/bio_medusa_mod.F90
r8442 r8674 7 7 !! History : 8 8 !! - ! 2017-04 (M. Stringer) Code taken from trcbio_medusa.F90 9 !! - ! 2017-08 (A. Yool) Slow detritus, ML-avg chl variables 9 10 !!---------------------------------------------------------------------- 10 11 #if defined key_medusa … … 54 55 !! AXY (01/03/10): add in mixed layer PP diagnostics 55 56 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fprn_ml,fprd_ml 57 !! AXY (16/08/17): add in mixed layer chlorophyll diagnostic 58 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fchl_ml 56 59 !! 57 60 !! nutrient limiting factors … … 94 97 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fregenfastc 95 98 # endif 96 99 !! 100 !! AXY (08/08/17): sinking of detritus moved here 101 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fslowsink, fslowgain, fslowloss 102 # if defined key_roam 103 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fslowsinkc, fslowgainc, fslowlossc 104 # endif 105 !! 97 106 !! Particle flux 98 107 REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: fdep1 … … 287 296 fjlim_pn(jpi,jpj),fjlim_pd(jpi,jpj), & 288 297 fun_T(jpi,jpj),fun_Q10(jpi,jpj), & 289 fprn_ml(jpi,jpj),fprd_ml(jpi,jpj), 298 fprn_ml(jpi,jpj),fprd_ml(jpi,jpj),fchl_ml(jpi,jpj), & 290 299 fnln(jpi,jpj),ffln2(jpi,jpj), & 291 300 fnld(jpi,jpj),ffld(jpi,jpj),fsld(jpi,jpj), & … … 316 325 fregenfastc(jpi,jpj), & 317 326 # endif 327 fslowsink(jpi,jpj),fslowgain(jpi,jpj), & 328 fslowloss(jpi,jpj), & 329 # if defined key_roam 330 fslowsinkc(jpi,jpj),fslowgainc(jpi,jpj), & 331 fslowlossc(jpi,jpj), & 332 # endif 318 333 fdep1(jpi,jpj), & 319 334 ftempn(jpi,jpj),ftempsi(jpi,jpj),ftempfe(jpi,jpj), & -
branches/NERC/dev_r5518_GO6_package_trdtrc/NEMOGCM/NEMO/TOP_SRC/MEDUSA/bio_medusa_update.F90
r8463 r8674 6 6 !! History : 7 7 !! - ! 2017-04 (M. Stringer) Code taken from trcbio_medusa.F90 8 !! - ! 2017-08 (A. Yool) Amend slow-detritus bug 9 !! - ! 2017-08 (A. Yool) Reformatting for clarity 8 10 !!---------------------------------------------------------------------- 9 11 #if defined key_medusa … … 60 62 fsil_cons, fsil_prod, fsdiss, & 61 63 ftempca, fthetad, fthetan, & 64 fslowsink, fslowgain, fslowloss, & ! AXY (22/08/17) 65 f_sbenin_n, f_sbenin_c, & 62 66 # if defined key_roam 67 fslowsinkc, fslowgainc, fslowlossc, & ! AXY (22/08/17) 63 68 fcar_cons, fcar_prod, fcomm_resp, & 64 69 fddc, fflx_a, fflx_c, fflx_o2, zoxy, & … … 181 186 ENDDO 182 187 183 DO jj = 2,jpjm1 184 DO ji = 2,jpim1 185 if (tmask(ji,jj,jk) == 1) then 186 !! 187 !!---------------------------------------------------------- 188 !! detritus 189 btra(ji,jj,jpdet_lc) = b0 * & 190 ! mort. losses 191 (fdpn(ji,jj) + ((1.0 - xfdfrac1) * & 192 fdpd(ji,jj)) + & 193 fdzmi(ji,jj) + & 194 ((1.0 - xfdfrac2) * fdzme(ji,jj)) + & 195 ! assim. inefficiency 196 ((1.0 - xbetan) * (finmi(ji,jj) + & 197 finme(ji,jj))) - & 198 ! grazing and remin. 199 fgmid(ji,jj) - fgmed(ji,jj) - & 200 fdd(ji,jj) + & 201 ! seafloor fast->slow 202 ffast2slown(ji,jj)) 203 !! 188 !!---------------------------------------------------------- 189 !! detritus 190 DO jj = 2,jpjm1 191 DO ji = 2,jpim1 192 if (tmask(ji,jj,jk) == 1) then 193 !! 194 btra(ji,jj,jpdet_lc) = b0 * ( & 195 fdpn(ji,jj) & ! mort. losses 196 + ((1.0 - xfdfrac1) * fdpd(ji,jj)) & ! mort. losses 197 + fdzmi(ji,jj) & ! mort. losses 198 + ((1.0 - xfdfrac2) * fdzme(ji,jj)) & ! mort. losses 199 + ((1.0 - xbetan) * (finmi(ji,jj) + finme(ji,jj))) & ! assim. inefficiency 200 - fgmid(ji,jj) - fgmed(ji,jj) & ! grazing 201 - fdd(ji,jj) & ! remin. 202 + fslowgain(ji,jj) - fslowloss(ji,jj) & ! slow-sinking 203 - (f_sbenin_n(ji,jj) / fse3t(ji,jj,jk)) & ! slow-sinking loss to seafloor 204 + ffast2slown(ji,jj) ) ! seafloor fast->slow 204 205 ENDIF 205 206 ENDDO … … 305 306 ffetop(ji,jj) + ffebot(ji,jj) - & 306 307 ffescav(ji,jj) ) 308 ENDIF 309 ENDDO 310 ENDDO 311 307 312 # if defined key_roam 308 !! 309 !!---------------------------------------------------------- 310 !! AXY (26/11/08): implicit detrital carbon change 311 btra(ji,jj,jpdtc_lc) = b0 * ( & 312 ! mort. losses 313 (xthetapn * fdpn(ji,jj)) + & 314 ((1.0 - xfdfrac1) * & 315 (xthetapd * fdpd(ji,jj))) + & 316 (xthetazmi * fdzmi(ji,jj)) + & 317 ((1.0 - xfdfrac2) * & 318 (xthetazme * fdzme(ji,jj))) + & 319 ! assim. inefficiency 320 ((1.0 - xbetac) * & 321 (ficmi(ji,jj) + ficme(ji,jj))) - & 322 ! grazing and remin. 323 fgmidc(ji,jj) - fgmedc(ji,jj) - & 324 fddc(ji,jj) + & 325 ! seafloor fast->slow 326 ffast2slowc(ji,jj) ) 313 !!---------------------------------------------------------- 314 !! AXY (26/11/08): implicit detrital carbon change 315 DO jj = 2,jpjm1 316 DO ji = 2,jpim1 317 if (tmask(ji,jj,jk) == 1) then 318 !! 319 btra(ji,jj,jpdtc_lc) = b0 * ( & 320 (xthetapn * fdpn(ji,jj)) & ! mort. losses 321 + ((1.0 - xfdfrac1) * (xthetapd * fdpd(ji,jj))) & ! mort. losses 322 + (xthetazmi * fdzmi(ji,jj)) & ! mort. losses 323 + ((1.0 - xfdfrac2) * (xthetazme * fdzme(ji,jj))) & ! mort. losses 324 + ((1.0 - xbetac) * (ficmi(ji,jj) + ficme(ji,jj))) & ! assim. inefficiency 325 - fgmidc(ji,jj) - fgmedc(ji,jj) & ! grazing 326 - fddc(ji,jj) & ! remin. 327 + fslowgainc(ji,jj) - fslowlossc(ji,jj) & ! slow-sinking 328 - (f_sbenin_c(ji,jj) / fse3t(ji,jj,jk)) & ! slow-sinking loss to seafloor 329 + ffast2slowc(ji,jj) ) ! seafloor fast->slow 327 330 ENDIF 328 331 ENDDO … … 575 578 f_o2flux(ji,jj)) 576 579 endif 580 ENDIF 581 ENDDO 582 ENDDO 577 583 # endif 578 ENDIF579 ENDDO580 ENDDO581 584 582 585 # if defined key_debug_medusa -
branches/NERC/dev_r5518_GO6_package_trdtrc/NEMOGCM/NEMO/TOP_SRC/MEDUSA/detritus.F90
r8441 r8674 6 6 !! History : 7 7 !! - ! 2017-04 (M. Stringer) Code taken from trcbio_medusa.F90 8 !! - ! 2017-08 (A. Yool) Revise slow-sinking of detritus 8 9 !!---------------------------------------------------------------------- 9 10 #if defined key_medusa … … 35 36 f_sbenin_n, fdd, & 36 37 idf, idfval, & 37 # if defined key_roam 38 fslowsink, & 39 fslowgain, fslowloss, & 40 # if defined key_roam 41 fslowsinkc, & 42 fslowgainc, fslowlossc, & 38 43 fddc, & 39 44 # endif 40 45 fun_T, fun_Q10, zdet, zdtc 41 46 USE detritus_fast_sink_mod, ONLY: detritus_fast_sink 42 USE dom_oce, ONLY: mbathy, tmask47 USE dom_oce, ONLY: mbathy, e3t_0, e3t_n, gphit, tmask 43 48 USE in_out_manager, ONLY: lwp, numout 44 49 USE par_oce, ONLY: jpim1, jpjm1 45 50 USE sms_medusa, ONLY: jmd, jorgben, jsfd, vsed, & 46 51 xrfn, xmd, xmdc, xthetad 52 53 !!* Substitution 54 # include "domzgr_substitute.h90" 47 55 48 56 !! Level … … 123 131 DO ji = 2,jpim1 124 132 if (tmask(ji,jj,jk) == 1) then 133 !!---------------------------------------------------------------------- 134 !! Detritus sinking (AXY, 08/08/18) 135 !! Replaces slow-sinking done in trcsed_medusa.F90 136 !! 137 !! Uses the fslowsink variable to carry slow-sinking detritus from one 138 !! grid level to the next, variable fslowgain to "add" detritus sinking 139 !! from above and variable fslowloss to "subtract" detritus sinking out 140 !! to below; these variables appear in the differential equations of 141 !! detrital nitrogen and carbon below 142 !!---------------------------------------------------------------------- 143 !! 144 fslowgain(ji,jj) = fslowsink(ji,jj) / fse3t(ji,jj,jk) ! = mmol N / m3 / d 145 if (jk.lt.mbathy(ji,jj)) then 146 fslowloss(ji,jj) = (zdet(ji,jj) * vsed * 86400.) / fse3t(ji,jj,jk) ! = mmol N / m3 / d 147 else 148 fslowloss(ji,jj) = 0. ! = mmol N / m3 / d 149 endif 150 fslowsink(ji,jj) = fslowloss(ji,jj) * fse3t(ji,jj,jk) ! = mmol N / m2 / d 151 !! 152 # if defined key_roam 153 fslowgainc(ji,jj) = fslowsinkc(ji,jj) / fse3t(ji,jj,jk) ! = mmol C / m3 / d 154 if (jk.lt.mbathy(ji,jj)) then 155 fslowlossc(ji,jj) = (zdtc(ji,jj) * vsed * 86400.) / fse3t(ji,jj,jk) ! = mmol C / m3 / d 156 else 157 fslowlossc(ji,jj) = 0. ! = mmol C / m3 / d 158 endif 159 fslowsinkc(ji,jj) = fslowlossc(ji,jj) * fse3t(ji,jj,jk) ! = mmol C / m2 / d 160 # endif 161 ENDIF 162 ENDDO 163 ENDDO 164 165 DO jj = 2,jpjm1 166 DO ji = 2,jpim1 167 if (tmask(ji,jj,jk) == 1) then 125 168 !!--------------------------------------------------------- 126 169 !! Detritus addition to benthos -
branches/NERC/dev_r5518_GO6_package_trdtrc/NEMOGCM/NEMO/TOP_SRC/MEDUSA/phytoplankton.F90
r8441 r8674 6 6 !! History : 7 7 !! - ! 2017-04 (M. Stringer) Code taken from trcbio_medusa.F90 8 !! - ! 2017-08 (A. Yool) Mean mixed layer chlorophyll 8 9 !!---------------------------------------------------------------------- 9 10 #if defined key_medusa … … 42 43 zchd, zchn, zdet, zdin, zdtc, & 43 44 zfer, zpds, zphd, zphn, zsil, & 44 zzme, zzmi 45 zzme, zzmi, fchl_ml 45 46 USE dom_oce, ONLY: e3t_0, e3t_n, gdepw_0, gdepw_n, tmask 46 47 USE in_out_manager, ONLY: lwp, numout … … 373 374 fprd_ml(ji,jj) = fprd_ml(ji,jj) + (fprd(ji,jj) * zphd(ji,jj) * & 374 375 fse3t(ji,jj,jk) * fq0) 376 !! AXY (16/08/17) 377 fchl_ml(ji,jj) = fchl_ml(ji,jj) + ((zchn(ji,jj) + zchd(ji,jj)) * & 378 (fse3t(ji,jj,jk) * fq0) / hmld(ji,jj)) 375 379 ENDIF 376 380 ENDDO -
branches/NERC/dev_r5518_GO6_package_trdtrc/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcnam_medusa.F90
r8442 r8674 2053 2053 med_diag%OCN_DPCO2%dgsave = .FALSE. 2054 2054 ENDIF 2055 !! 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 2056 2062 IF (iom_use("TPP3")) THEN 2057 2063 med_diag%TPP3%dgsave = .TRUE. -
branches/NERC/dev_r5518_GO6_package_trdtrc/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcsms_medusa.F90
r8673 r8674 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 … … 107 108 # endif 108 109 109 CALL trc_sed_medusa( kt ) ! sedimentation model 110 # if defined key_debug_medusa 111 IF(lwp) WRITE(numout,*) ' MEDUSA done trc_sed_medusa' 112 CALL flush(numout) 113 # endif 110 !! AXY (08/08/2017): remove call to buggy subroutine (now handled by detritus.F90) 111 !! CALL trc_sed_medusa( kt ) ! sedimentation model 112 !! # if defined key_debug_medusa 113 !! IF(lwp) WRITE(numout,*) ' MEDUSA done trc_sed_medusa' 114 !! CALL flush(numout) 115 !! # endif 114 116 # endif 115 117 -
branches/NERC/dev_r5518_GO6_package_trdtrc/NEMOGCM/NEMO/TOP_SRC/trc.F90
r8280 r8674 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, &
Note: See TracChangeset
for help on using the changeset viewer.