Changeset 7347 for branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM
- Timestamp:
- 2016-11-28T12:05:05+01:00 (8 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/NERC/dev_r5518_NOC_MEDUSA_Stable/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcbio_medusa.F90
r7331 r7347 247 247 REAL(wp), DIMENSION(jpi,jpj) :: fccd 248 248 REAL(wp) :: fccd_dep 249 !! AXY (28/11/16): fix mbathy bug 250 INTEGER :: jmbathy 249 251 !! 250 252 !! AXY (06/07/11): alternative fast detritus schemes … … 1351 1353 !! 1352 1354 fdep2 = fsdept(ji,jj,jk) !! set up level midpoint 1355 !! AXY (28/11/16): local seafloor depth 1356 !! previously mbathy(ji,jj) - 1, now mbathy(ji,jj) 1357 jmbathy = mbathy(ji,jj) 1353 1358 !! 1354 1359 !! set up required state variables … … 1431 1436 i2_omcal(ji,jj) = 1 1432 1437 endif 1433 if ( i2_omcal(ji,jj) .eq. 0 .and. jk .eq. (mbathy(ji,jj)-1)) then1438 if ( i2_omcal(ji,jj) .eq. 0 .and. jk .eq. jmbathy ) then 1434 1439 !! reached seafloor and still no dissolution; set to seafloor (W-point) 1435 1440 f2_ccd_cal(ji,jj) = fsdepw(ji,jj,jk+1) … … 1451 1456 i2_omarg(ji,jj) = 1 1452 1457 endif 1453 if ( i2_omarg(ji,jj) .eq. 0 .and. jk .eq. (mbathy(ji,jj)-1)) then1458 if ( i2_omarg(ji,jj) .eq. 0 .and. jk .eq. jmbathy ) then 1454 1459 !! reached seafloor and still no dissolution; set to seafloor (W-point) 1455 1460 f2_ccd_arg(ji,jj) = fsdepw(ji,jj,jk+1) … … 1511 1516 flatx = gphit(ji,jj) 1512 1517 flonx = glamt(ji,jj) 1518 !! AXY (28/11/16): local seafloor depth 1519 !! previously mbathy(ji,jj) - 1, now mbathy(ji,jj) 1520 jmbathy = mbathy(ji,jj) 1513 1521 !! 1514 1522 !! set up model tracers … … 2524 2532 !! 2525 2533 !! AXY (22/07/09): accelerate detrital remineralisation in the bottom box 2526 if (jk.eq. (mbathy(ji,jj)-1) .and. jsfd.eq.1) then2534 if (jk.eq.jmbathy) .and. jsfd.eq.1) then 2527 2535 fdd = 1.0 * zdet 2528 2536 # if defined key_roam … … 2558 2566 !!---------------------------------------------------------------------- 2559 2567 !! 2560 if (jk.eq. (mbathy(ji,jj)-1) .and. jorgben.eq.1) then2568 if (jk.eq.jmbathy) .and. jorgben.eq.1) then 2561 2569 !! this is the BOTTOM OCEAN BOX -> into the benthic pool! 2562 2570 !! … … 2873 2881 !! AXY (10/07/12): amended to only apply sedimentary flux up to ~500 m down 2874 2882 !! if (jk.eq.(mbathy(ji,jj)-1).AND.jk.lt.i1100) then 2875 if (jk.eq. (mbathy(ji,jj)-1).AND.jk.le.i0500) then2883 if (jk.eq.jmbathy).AND.jk.le.i0500) then 2876 2884 !! Moore et al. (2004) cite a coastal California value of 5 umol/m2/d, but adopt a 2877 2885 !! global value of 2 umol/m2/d for all areas < 1100 m; here we use this latter value … … 3141 3149 freminsi = 0.0 3142 3150 freminca = 0.0 3143 elseif (jk.l t.(mbathy(ji,jj))) then3151 elseif (jk.le.jmbathy) then 3144 3152 !! this is an OCEAN BOX (remineralise some material) 3145 3153 !! … … 3324 3332 freminsi = 0.0 3325 3333 freminca = 0.0 3326 elseif (jk.l t.(mbathy(ji,jj))) then3334 elseif (jk.le.jmbathy) then 3327 3335 !! this is an OCEAN BOX (remineralise some material) 3328 3336 !! … … 3445 3453 ffast2slowfe = 0.0 3446 3454 !! 3447 if (jk.eq. (mbathy(ji,jj)-1)) then3455 if (jk.eq.jmbathy) then 3448 3456 !! this is the BOTTOM OCEAN BOX (remineralise everything) 3449 3457 !! … … 3534 3542 !!---------------------------------------------------------------------- 3535 3543 !! 3536 if (jk.eq. (mbathy(ji,jj)-1)) then3544 if (jk.eq.jmbathy) then 3537 3545 !! 3538 3546 !! organic components … … 3608 3616 !! riverine flux 3609 3617 if ( jriver_n .gt. 0 ) then 3610 f_riv_loc_n = f_riv_n(ji,jj) * friver_dep(jk, (mbathy(ji,jj)-1)) / fthk3618 f_riv_loc_n = f_riv_n(ji,jj) * friver_dep(jk,jmbathy) / fthk 3611 3619 fn_prod = fn_prod + f_riv_loc_n 3612 3620 endif 3613 3621 !! 3614 3622 !! benthic remineralisation 3615 if (jk.eq. (mbathy(ji,jj)-1).and. jorgben.eq.1 .and. ibenthic.eq.1) then3623 if (jk.eq.jmbathy .and. jorgben.eq.1 .and. ibenthic.eq.1) then 3616 3624 fn_prod = fn_prod + (f_benout_n(ji,jj) / fthk) 3617 3625 endif … … 3637 3645 !! riverine flux 3638 3646 if ( jriver_si .gt. 0 ) then 3639 f_riv_loc_si = f_riv_si(ji,jj) * friver_dep(jk, (mbathy(ji,jj)-1)) / fthk3647 f_riv_loc_si = f_riv_si(ji,jj) * friver_dep(jk,jmbathy) / fthk 3640 3648 fs_prod = fs_prod + f_riv_loc_si 3641 3649 endif 3642 3650 !! 3643 3651 !! benthic remineralisation 3644 if (jk.eq. (mbathy(ji,jj)-1).and. jinorgben.eq.1 .and. ibenthic.eq.1) then3652 if (jk.eq.jmbathy .and. jinorgben.eq.1 .and. ibenthic.eq.1) then 3645 3653 fs_prod = fs_prod + (f_benout_si(ji,jj) / fthk) 3646 3654 endif … … 3684 3692 !! riverine flux 3685 3693 if ( jriver_c .gt. 0 ) then 3686 f_riv_loc_c = f_riv_c(ji,jj) * friver_dep(jk, (mbathy(ji,jj)-1)) / fthk3694 f_riv_loc_c = f_riv_c(ji,jj) * friver_dep(jk,jmbathy) / fthk 3687 3695 fc_prod = fc_prod + f_riv_loc_c 3688 3696 endif 3689 3697 !! 3690 3698 !! benthic remineralisation 3691 if (jk.eq. (mbathy(ji,jj)-1).and. jorgben.eq.1 .and. ibenthic.eq.1) then3699 if (jk.eq.jmbathy .and. jorgben.eq.1 .and. ibenthic.eq.1) then 3692 3700 fc_prod = fc_prod + (f_benout_c(ji,jj) / fthk) 3693 3701 endif 3694 if (jk.eq. (mbathy(ji,jj)-1).and. jinorgben.eq.1 .and. ibenthic.eq.1) then3702 if (jk.eq.jmbathy .and. jinorgben.eq.1 .and. ibenthic.eq.1) then 3695 3703 fc_prod = fc_prod + (f_benout_ca(ji,jj) / fthk) 3696 3704 endif … … 3724 3732 !! riverine flux 3725 3733 if ( jriver_alk .gt. 0 ) then 3726 f_riv_loc_alk = f_riv_alk(ji,jj) * friver_dep(jk, (mbathy(ji,jj)-1)) / fthk3734 f_riv_loc_alk = f_riv_alk(ji,jj) * friver_dep(jk,jmbathy) / fthk 3727 3735 fa_prod = fa_prod + f_riv_loc_alk 3728 3736 endif 3729 3737 !! 3730 3738 !! benthic remineralisation 3731 if (jk.eq. (mbathy(ji,jj)-1).and. jinorgben.eq.1 .and. ibenthic.eq.1) then3739 if (jk.eq.jmbathy .and. jinorgben.eq.1 .and. ibenthic.eq.1) then 3732 3740 fa_prod = fa_prod + (2.0 * f_benout_ca(ji,jj) / fthk) 3733 3741 endif … … 3760 3768 !! 3761 3769 !! benthic remineralisation 3762 if (jk.eq. (mbathy(ji,jj)-1).and. jorgben.eq.1 .and. ibenthic.eq.1) then3770 if (jk.eq.jmbathy .and. jorgben.eq.1 .and. ibenthic.eq.1) then 3763 3771 fo2_ncons = fo2_ncons - (xthetanit * f_benout_n(ji,jj) / fthk) 3764 3772 endif … … 3780 3788 !! 3781 3789 !! benthic remineralisation 3782 if (jk.eq. (mbathy(ji,jj)-1).and. jorgben.eq.1 .and. ibenthic.eq.1) then3790 if (jk.eq.jmbathy .and. jorgben.eq.1 .and. ibenthic.eq.1) then 3783 3791 fo2_ccons = fo2_ccons - (xthetarem * f_benout_c(ji,jj) / fthk) 3784 3792 endif … … 4185 4193 ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall) 4186 4194 ENDIF 4187 ELSE IF (jk.eq. (mbathy(ji,jj)-1)) THEN4195 ELSE IF (jk.eq.jmbathy) THEN 4188 4196 IF( med_diag%IBEN_N%dgsave ) THEN 4189 4197 iben_n2d(ji,jj) = f_sbenin_n(ji,jj) + f_fbenin_n(ji,jj) … … 4480 4488 trc2d(ji,jj,67) = trc2d(ji,jj,67) + (freminc * fthk) !! sum of fast-sinking C fluxes 4481 4489 trc2d(ji,jj,68) = trc2d(ji,jj,68) + (freminca * fthk) !! sum of fast-sinking Ca fluxes 4482 if (jk.eq. (mbathy(ji,jj)-1)) then4490 if (jk.eq.jmbathy) then 4483 4491 trc2d(ji,jj,69) = fsedn(ji,jj) !! N sedimentation flux 4484 4492 trc2d(ji,jj,70) = fsedsi(ji,jj) !! Si sedimentation flux … … 4529 4537 trc2d(ji,jj,108) = f2_ccd_arg(ji,jj) !! depth aragonite CCD 4530 4538 endif 4531 if (jk .eq. (mbathy(ji,jj)-1)) then4539 if (jk .eq. jmbathy) then 4532 4540 trc2d(ji,jj,109) = f3_omcal(ji,jj,jk) !! seafloor omega calcite 4533 4541 trc2d(ji,jj,110) = f3_omarg(ji,jj,jk) !! seafloor omega aragonite … … 4538 4546 if (jk.eq.i1000) trc2d(ji,jj,120) = ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall) !! rain ratio at 1000 m 4539 4547 !! AXY (18/01/12): benthic flux diagnostics 4540 if (jk.eq. (mbathy(ji,jj)-1)) then4548 if (jk.eq.jmbathy) then 4541 4549 trc2d(ji,jj,121) = f_sbenin_n(ji,jj) + f_fbenin_n(ji,jj) 4542 4550 trc2d(ji,jj,122) = f_sbenin_fe(ji,jj) + f_fbenin_fe(ji,jj) … … 4565 4573 trc2d(ji,jj,147) = trc2d(ji,jj,147) + ftot_a(ji,jj) !! alkalinity inventory 4566 4574 trc2d(ji,jj,148) = trc2d(ji,jj,148) + ftot_o2(ji,jj) !! oxygen inventory 4567 if (jk.eq. (mbathy(ji,jj)-1)) then4575 if (jk.eq.jmbathy) then 4568 4576 trc2d(ji,jj,149) = f_benout_lyso_ca(ji,jj) 4569 4577 endif … … 4944 4952 # endif 4945 4953 IF( med_diag%SDT__100%dgsave ) THEN 4946 CALL iom_put( "SDT__100" , fslownflux ) 4954 zw2d(:,:) = fslownflux(:,:) * tmask(:,:,jk) 4955 CALL iom_put( "SDT__100" , zw2d ) 4947 4956 ENDIF 4948 4957 IF( med_diag%REG__100%dgsave ) THEN … … 4969 4978 ENDIF 4970 4979 IF( med_diag%SDC__100%dgsave ) THEN 4971 CALL iom_put( "SDC__100" , fslowcflux ) 4980 zw2d(:,:) = fslowcflux(:,:) * tmask(:,:,jk) 4981 CALL iom_put( "SDC__100" , zw2d ) 4972 4982 ENDIF 4973 4983 IF( med_diag%epC100%dgsave ) THEN 4974 zw2d(:,:) = fslowcflux + ffastc4984 zw2d(:,:) = (fslowcflux + ffastc) * tmask(:,:,jk) 4975 4985 CALL iom_put( "epC100" , zw2d ) 4976 4986 ENDIF … … 4979 4989 ENDIF 4980 4990 IF( med_diag%epN100%dgsave ) THEN 4981 zw2d(:,:) = fslownflux + ffastn4991 zw2d(:,:) = (fslownflux + ffastn) * tmask(:,:,jk) 4982 4992 CALL iom_put( "epN100" , zw2d ) 4983 4993 ENDIF … … 4997 5007 # endif 4998 5008 IF( med_diag%SDT__200%dgsave ) THEN 4999 CALL iom_put( "SDT__200" , fslownflux ) 5009 zw2d(:,:) = fslownflux(:,:) * tmask(:,:,jk) 5010 CALL iom_put( "SDT__200" , zw2d ) 5000 5011 ENDIF 5001 5012 IF( med_diag%REG__200%dgsave ) THEN 5002 5013 CALL iom_put( "REG__200" , fregen2d ) 5003 5014 ENDIF 5004 5015 IF( med_diag%FDT__200%dgsave ) THEN 5005 5016 CALL iom_put( "FDT__200" , ffastn ) 5006 5017 ENDIF 5007 5018 IF( med_diag%RG__200F%dgsave ) THEN 5008 5019 CALL iom_put( "RG__200F" , fregenfast ) 5009 5020 ENDIF 5010 5021 IF( med_diag%FDS__200%dgsave ) THEN 5011 5022 CALL iom_put( "FDS__200" , ffastsi ) 5012 5023 ENDIF 5013 5024 IF( med_diag%RGS_200F%dgsave ) THEN 5014 5025 CALL iom_put( "RGS_200F" , fregenfastsi ) 5015 5026 ENDIF 5016 5027 IF( med_diag%FE_0200%dgsave ) THEN 5017 CALL iom_put( "FE_0200", xFree )5028 CALL iom_put( "FE_0200" , xFree ) 5018 5029 ENDIF 5019 5030 # if defined key_roam 5020 5031 IF( med_diag%SDC__200%dgsave ) THEN 5021 CALL iom_put( "SDC__200" , fslowcflux ) 5032 zw2d(:,:) = fslowcflux(:,:) * tmask(:,:,jk) 5033 CALL iom_put( "SDC__200" , zw2d ) 5022 5034 ENDIF 5023 5035 # endif … … 5028 5040 # endif 5029 5041 IF( med_diag%SDT__500%dgsave ) THEN 5030 CALL iom_put( "SDT__500" , fslownflux ) 5042 zw2d(:,:) = fslownflux(:,:) * tmask(:,:,jk) 5043 CALL iom_put( "SDT__500" , zw2d ) 5031 5044 ENDIF 5032 5045 IF( med_diag%REG__500%dgsave ) THEN 5033 5046 CALL iom_put( "REG__500" , fregen2d ) 5034 5047 ENDIF 5035 5048 IF( med_diag%FDT__500%dgsave ) THEN 5036 5049 CALL iom_put( "FDT__500" , ffastn ) 5037 5050 ENDIF 5038 5051 IF( med_diag%RG__500F%dgsave ) THEN 5039 5052 CALL iom_put( "RG__500F" , fregenfast ) 5040 5053 ENDIF 5041 5054 IF( med_diag%FDS__500%dgsave ) THEN 5042 5055 CALL iom_put( "FDS__500" , ffastsi ) 5043 5056 ENDIF 5044 5057 IF( med_diag%RGS_500F%dgsave ) THEN 5045 5058 CALL iom_put( "RGS_500F" , fregenfastsi ) 5046 5059 ENDIF 5047 5060 IF( med_diag%FE_0500%dgsave ) THEN 5048 5061 CALL iom_put( "FE_0500" , xFree ) 5049 5062 ENDIF 5050 5063 # if defined key_roam 5051 5064 IF( med_diag%RR_0500%dgsave ) THEN 5052 5065 CALL iom_put( "RR_0500" , ffastca2d ) 5053 5066 ENDIF 5054 5067 IF( med_diag%SDC__500%dgsave ) THEN 5055 CALL iom_put( "SDC__500" , fslowcflux ) 5068 zw2d(:,:) = fslowcflux(:,:) * tmask(:,:,jk) 5069 CALL iom_put( "SDC__500" , zw2d ) 5056 5070 ENDIF 5057 5071 # endif … … 5062 5076 # endif 5063 5077 IF( med_diag%SDT_1000%dgsave ) THEN 5064 CALL iom_put( "SDT_1000" , fslownflux ) 5078 zw2d(:,:) = fslownflux(:,:) * tmask(:,:,jk) 5079 CALL iom_put( "SDT_1000" , zw2d ) 5065 5080 ENDIF 5066 5081 IF( med_diag%REG_1000%dgsave ) THEN 5067 5082 CALL iom_put( "REG_1000" , fregen2d ) 5068 5083 ENDIF 5069 5084 IF( med_diag%FDT_1000%dgsave ) THEN 5070 5085 CALL iom_put( "FDT_1000" , ffastn ) 5071 5086 ENDIF 5072 5087 IF( med_diag%RG_1000F%dgsave ) THEN 5073 5088 CALL iom_put( "RG_1000F" , fregenfast ) 5074 5089 ENDIF 5075 5090 IF( med_diag%FDS_1000%dgsave ) THEN 5076 5091 CALL iom_put( "FDS_1000" , ffastsi ) 5077 5092 ENDIF 5078 5093 IF( med_diag%RGS1000F%dgsave ) THEN 5079 5094 CALL iom_put( "RGS1000F" , fregenfastsi ) 5080 5095 ENDIF 5081 5096 IF( med_diag%FE_1000%dgsave ) THEN 5082 5097 CALL iom_put( "FE_1000" , xFree ) 5083 5098 ENDIF 5084 5099 # if defined key_roam 5085 5100 IF( med_diag%RR_1000%dgsave ) THEN 5086 5087 5101 CALL iom_put( "RR_1000" , ffastca2d ) 5102 CALL wrk_dealloc( jpi, jpj, ffastca2d ) 5088 5103 ENDIF 5089 5104 IF( med_diag%SDC_1000%dgsave ) THEN 5090 CALL iom_put( "SDC_1000" , fslowcflux ) 5105 zw2d(:,:) = fslowcflux(:,:) * tmask(:,:,jk) 5106 CALL iom_put( "SDC_1000" , zw2d ) 5091 5107 ENDIF 5092 5108 # endif … … 5094 5110 !! to do on every k loop : 5095 5111 IF( med_diag%DETFLUX3%dgsave ) THEN 5096 detflux3d(:,:,jk) = fslownflux(:,:) + ffastn(:,:) !! detrital flux5112 detflux3d(:,:,jk) = (fslownflux(:,:) + ffastn(:,:)) * tmask(:,:,jk) !! detrital flux 5097 5113 !CALL iom_put( "DETFLUX3" , ftot_n ) 5098 5114 ENDIF 5099 5115 # if defined key_roam 5100 5101 expc3(:,:,jk) = fslowcflux(:,:) + ffastc(:,:)5102 5103 5104 expn3(:,:,jk) = fslownflux(:,:) + ffastn(:,:)5105 5116 IF( med_diag%EXPC3%dgsave ) THEN 5117 expc3(:,:,jk) = (fslowcflux(:,:) + ffastc(:,:)) * tmask(:,:,jk) 5118 ENDIF 5119 IF( med_diag%EXPN3%dgsave ) THEN 5120 expn3(:,:,jk) = (fslownflux(:,:) + ffastn(:,:)) * tmask(:,:,jk) 5121 ENDIF 5106 5122 # endif 5107 ENDIF5123 ENDIF 5108 5124 !! CLOSE vertical loop 5109 5125 ENDDO
Note: See TracChangeset
for help on using the changeset viewer.