Changeset 7998


Ignore:
Timestamp:
2017-05-08T12:16:27+02:00 (3 years ago)
Author:
marc
Message:

Pull out diagnostic calculations from trcbio_medusa.F90

Location:
branches/UKMO/dev_r5518_medusa_chg_trc_bio_medusa/NEMOGCM/NEMO/TOP_SRC/MEDUSA
Files:
1 added
1 edited

Legend:

Unmodified
Added
Removed
  • branches/UKMO/dev_r5518_medusa_chg_trc_bio_medusa/NEMOGCM/NEMO/TOP_SRC/MEDUSA/trcbio_medusa.F90

    r7996 r7998  
    104104      USE detritus_mod,               ONLY: detritus 
    105105      USE bio_medusa_update_mod,      ONLY: bio_medusa_update 
     106      USE bio_medusa_diag_mod,        ONLY: bio_medusa_diag 
    106107      USE bio_medusa_diag_slice_mod,  ONLY: bio_medusa_diag_slice 
    107108      USE bio_medusa_fin_mod,         ONLY: bio_medusa_fin 
     
    603604               !!                 previously mbathy(ji,jj) - 1, now  
    604605               !!                 mbathy(ji,jj) 
    605                mbathy(ji,jj) = mbathy(ji,jj) 
     606! I should be able to remove this - marc 5/5/17 
     607!               mbathy(ji,jj) = mbathy(ji,jj) 
    606608               !! 
    607609               !! set up model tracers 
     
    942944# endif 
    943945 
    944 ! MAYBE BUT A BREAK IN HERE, FAST-SINKINIG DETRITUS - marc 20/4/17  
    945 ! (miscellaneous processes is 79 lines) 
    946946            ENDIF 
    947947         ENDDO 
     
    958958         CALL bio_medusa_update( kt, jk ) 
    959959 
    960 ! Diagnostic update - marc 
    961  
    962          DO jj = 2,jpjm1 
    963          DO ji = 2,jpim1 
    964             !! OPEN wet point IF..THEN loop 
    965             if (tmask(ji,jj,jk) == 1) then 
    966  
    967 # if defined key_trc_diabio 
    968                !!====================================================================== 
    969                !! LOCAL GRID CELL DIAGNOSTICS 
    970                !!====================================================================== 
    971                !! 
    972                !!---------------------------------------------------------------------- 
    973                !! Full diagnostics key_trc_diabio: 
    974                !! LOBSTER and PISCES support full diagnistics option key_trc_diabio     
    975                !! which gives an option of FULL output of biological sourses and sinks. 
    976                !! I cannot see any reason for doing this. If needed, it can be done 
    977                !! as shown below. 
    978                !!---------------------------------------------------------------------- 
    979                !! 
    980                IF(lwp) WRITE(numout,*) ' MEDUSA does not support key_trc_diabio' 
    981                !!               trbio(ji,jj,jk, 1) = fprn(ji,jj) 
    982 # endif 
    983  
    984                IF( lk_iomput  .AND.  .NOT.  ln_diatrc  ) THEN 
    985          !!---------------------------------------------------------------------- 
    986          !! Add in XML diagnostics stuff 
    987          !!---------------------------------------------------------------------- 
    988          !! 
    989          !! ** 2D diagnostics 
    990 #   if defined key_debug_medusa 
    991                   IF (lwp) write (numout,*) 'trc_bio_medusa: diag in ij-jj-jk loop' 
    992                   CALL flush(numout) 
    993 #   endif 
    994                   IF ( med_diag%PRN%dgsave ) THEN 
    995                       fprn2d(ji,jj) = fprn2d(ji,jj) + (fprn(ji,jj)  * zphn(ji,jj) * fse3t(ji,jj,jk))  
    996                   ENDIF 
    997                   IF ( med_diag%MPN%dgsave ) THEN 
    998                       fdpn2d(ji,jj) = fdpn2d(ji,jj) + (fdpn(ji,jj)         * fse3t(ji,jj,jk)) 
    999                   ENDIF 
    1000                   IF ( med_diag%PRD%dgsave ) THEN 
    1001                       fprd2d(ji,jj) = fprd2d(ji,jj) + (fprd(ji,jj)  * zphd(ji,jj) * fse3t(ji,jj,jk)) 
    1002                   ENDIF 
    1003                   IF( med_diag%MPD%dgsave ) THEN 
    1004                       fdpd2d(ji,jj) = fdpd2d(ji,jj) + (fdpd(ji,jj)         * fse3t(ji,jj,jk))  
    1005                   ENDIF 
    1006                   !  IF( med_diag%DSED%dgsave ) THEN 
    1007                   !      CALL iom_put( "DSED"  , ftot_n ) 
    1008                   !  ENDIF 
    1009                   IF( med_diag%OPAL%dgsave ) THEN 
    1010                       fprds2d(ji,jj) = fprds2d(ji,jj) + (fprds(ji,jj) * zpds(ji,jj) * fse3t(ji,jj,jk))  
    1011                   ENDIF 
    1012                   IF( med_diag%OPALDISS%dgsave ) THEN 
    1013                       fsdiss2d(ji,jj) = fsdiss2d(ji,jj) + (fsdiss(ji,jj)  * fse3t(ji,jj,jk))   
    1014                   ENDIF 
    1015                   IF( med_diag%GMIPn%dgsave ) THEN 
    1016                       fgmipn2d(ji,jj) = fgmipn2d(ji,jj) + (fgmipn(ji,jj)  * fse3t(ji,jj,jk))  
    1017                   ENDIF 
    1018                   IF( med_diag%GMID%dgsave ) THEN 
    1019                       fgmid2d(ji,jj) = fgmid2d(ji,jj) + (fgmid(ji,jj)   * fse3t(ji,jj,jk))  
    1020                   ENDIF 
    1021                   IF( med_diag%MZMI%dgsave ) THEN 
    1022                       fdzmi2d(ji,jj) = fdzmi2d(ji,jj) + (fdzmi(ji,jj)   * fse3t(ji,jj,jk))  
    1023                   ENDIF 
    1024                   IF( med_diag%GMEPN%dgsave ) THEN 
    1025                       fgmepn2d(ji,jj) = fgmepn2d(ji,jj) + (fgmepn(ji,jj)  * fse3t(ji,jj,jk)) 
    1026                   ENDIF 
    1027                   IF( med_diag%GMEPD%dgsave ) THEN 
    1028                       fgmepd2d(ji,jj) = fgmepd2d(ji,jj) + (fgmepd(ji,jj)  * fse3t(ji,jj,jk))  
    1029                   ENDIF 
    1030                   IF( med_diag%GMEZMI%dgsave ) THEN 
    1031                       fgmezmi2d(ji,jj) = fgmezmi2d(ji,jj) + (fgmezmi(ji,jj) * fse3t(ji,jj,jk))  
    1032                   ENDIF 
    1033                   IF( med_diag%GMED%dgsave ) THEN 
    1034                       fgmed2d(ji,jj) = fgmed2d(ji,jj) + (fgmed(ji,jj)   * fse3t(ji,jj,jk))  
    1035                   ENDIF 
    1036                   IF( med_diag%MZME%dgsave ) THEN 
    1037                       fdzme2d(ji,jj) = fdzme2d(ji,jj) + (fdzme(ji,jj)   * fse3t(ji,jj,jk))  
    1038                   ENDIF 
    1039                   !  IF( med_diag%DEXP%dgsave ) THEN 
    1040                   !      CALL iom_put( "DEXP"  , ftot_n ) 
    1041                   !  ENDIF 
    1042                   IF( med_diag%DETN%dgsave ) THEN 
    1043                       fslown2d(ji,jj) = fslown2d(ji,jj) + (fslown(ji,jj)  * fse3t(ji,jj,jk))   
    1044                   ENDIF 
    1045                   IF( med_diag%MDET%dgsave ) THEN 
    1046                       fdd2d(ji,jj) = fdd2d(ji,jj) + (fdd(ji,jj)     * fse3t(ji,jj,jk))  
    1047                   ENDIF 
    1048                   IF( med_diag%AEOLIAN%dgsave ) THEN 
    1049                       ffetop2d(ji,jj) = ffetop2d(ji,jj) + (ffetop(ji,jj)  * fse3t(ji,jj,jk))  
    1050                   ENDIF 
    1051                   IF( med_diag%BENTHIC%dgsave ) THEN 
    1052                       ffebot2d(ji,jj) = ffebot2d(ji,jj) + (ffebot(ji,jj)  * fse3t(ji,jj,jk))  
    1053                   ENDIF 
    1054                   IF( med_diag%SCAVENGE%dgsave ) THEN 
    1055                       ffescav2d(ji,jj) = ffescav2d(ji,jj) + (ffescav(ji,jj) * fse3t(ji,jj,jk))   
    1056                   ENDIF 
    1057                   IF( med_diag%PN_JLIM%dgsave ) THEN 
    1058                       ! fjln2d(ji,jj) = fjln2d(ji,jj) + (fjln(ji,jj)  * zphn(ji,jj) * fse3t(ji,jj,jk))  
    1059                       fjln2d(ji,jj) = fjln2d(ji,jj) + (fjlim_pn(ji,jj) * zphn(ji,jj) * fse3t(ji,jj,jk))  
    1060                   ENDIF 
    1061                   IF( med_diag%PN_NLIM%dgsave ) THEN 
    1062                       fnln2d(ji,jj) = fnln2d(ji,jj) + (fnln(ji,jj)  * zphn(ji,jj) * fse3t(ji,jj,jk))  
    1063                   ENDIF 
    1064                   IF( med_diag%PN_FELIM%dgsave ) THEN 
    1065                       ffln2d(ji,jj) = ffln2d(ji,jj) + (ffln2(ji,jj)  * zphn(ji,jj) * fse3t(ji,jj,jk))  
    1066                   ENDIF 
    1067                   IF( med_diag%PD_JLIM%dgsave ) THEN 
    1068                       ! fjld2d(ji,jj) = fjld2d(ji,jj) + (fjld(ji,jj)  * zphd(ji,jj) * fse3t(ji,jj,jk))  
    1069                       fjld2d(ji,jj) = fjld2d(ji,jj) + (fjlim_pd(ji,jj) * zphd(ji,jj) * fse3t(ji,jj,jk))  
    1070                   ENDIF 
    1071                   IF( med_diag%PD_NLIM%dgsave ) THEN 
    1072                       fnld2d(ji,jj) = fnld2d(ji,jj) + (fnld(ji,jj)  * zphd(ji,jj) * fse3t(ji,jj,jk))  
    1073                   ENDIF 
    1074                   IF( med_diag%PD_FELIM%dgsave ) THEN 
    1075                       ffld2d(ji,jj) = ffld2d(ji,jj) + (ffld(ji,jj)  * zphd(ji,jj) * fse3t(ji,jj,jk))  
    1076                   ENDIF 
    1077                   IF( med_diag%PD_SILIM%dgsave ) THEN 
    1078                       fsld2d2(ji,jj) = fsld2d2(ji,jj) + (fsld2(ji,jj) * zphd(ji,jj) * fse3t(ji,jj,jk))  
    1079                   ENDIF 
    1080                   IF( med_diag%PDSILIM2%dgsave ) THEN 
    1081                       fsld2d(ji,jj) = fsld2d(ji,jj) + (fsld(ji,jj)  * zphd(ji,jj) * fse3t(ji,jj,jk)) 
    1082                   ENDIF 
    1083                   !!  
    1084                   IF( med_diag%TOTREG_N%dgsave ) THEN 
    1085                       fregen2d(ji,jj) = fregen2d(ji,jj) + fregen(ji,jj) 
    1086                   ENDIF 
    1087                   IF( med_diag%TOTRG_SI%dgsave ) THEN 
    1088                       fregensi2d(ji,jj) = fregensi2d(ji,jj) + fregensi(ji,jj) 
    1089                   ENDIF 
    1090                   !!  
    1091                   IF( med_diag%FASTN%dgsave ) THEN 
    1092                       ftempn2d(ji,jj) = ftempn2d(ji,jj) + (ftempn(ji,jj)  * fse3t(ji,jj,jk)) 
    1093                   ENDIF 
    1094                   IF( med_diag%FASTSI%dgsave ) THEN 
    1095                       ftempsi2d(ji,jj) = ftempsi2d(ji,jj) + (ftempsi(ji,jj) * fse3t(ji,jj,jk)) 
    1096                   ENDIF 
    1097                   IF( med_diag%FASTFE%dgsave ) THEN 
    1098                       ftempfe2d(ji,jj) =ftempfe2d(ji,jj)  + (ftempfe(ji,jj) * fse3t(ji,jj,jk))   
    1099                   ENDIF 
    1100                   IF( med_diag%FASTC%dgsave ) THEN 
    1101                       ftempc2d(ji,jj) = ftempc2d(ji,jj) + (ftempc(ji,jj)  * fse3t(ji,jj,jk)) 
    1102                   ENDIF 
    1103                   IF( med_diag%FASTCA%dgsave ) THEN 
    1104                       ftempca2d(ji,jj) = ftempca2d(ji,jj) + (ftempca(ji,jj) * fse3t(ji,jj,jk)) 
    1105                   ENDIF 
    1106                   !!  
    1107                   IF( med_diag%REMINN%dgsave ) THEN 
    1108                       freminn2d(ji,jj) = freminn2d(ji,jj) + (freminn(ji,jj)  * fse3t(ji,jj,jk)) 
    1109                   ENDIF 
    1110                   IF( med_diag%REMINSI%dgsave ) THEN 
    1111                       freminsi2d(ji,jj) = freminsi2d(ji,jj) + (freminsi(ji,jj) * fse3t(ji,jj,jk)) 
    1112                   ENDIF 
    1113                   IF( med_diag%REMINFE%dgsave ) THEN 
    1114                       freminfe2d(ji,jj)= freminfe2d(ji,jj) + (freminfe(ji,jj) * fse3t(ji,jj,jk))  
    1115                   ENDIF 
    1116                   IF( med_diag%REMINC%dgsave ) THEN 
    1117                       freminc2d(ji,jj) = freminc2d(ji,jj) + (freminc(ji,jj)  * fse3t(ji,jj,jk))  
    1118                   ENDIF 
    1119                   IF( med_diag%REMINCA%dgsave ) THEN 
    1120                       freminca2d(ji,jj) = freminca2d(ji,jj) + (freminca(ji,jj) * fse3t(ji,jj,jk))  
    1121                   ENDIF 
    1122                   !! 
    1123 # if defined key_roam 
    1124                   !! 
    1125                   !! AXY (09/11/16): CMIP6 diagnostics 
    1126                   IF( med_diag%FD_NIT3%dgsave ) THEN 
    1127                      fd_nit3(ji,jj,jk) = ffastn(ji,jj) 
    1128                   ENDIF 
    1129                   IF( med_diag%FD_SIL3%dgsave ) THEN 
    1130                      fd_sil3(ji,jj,jk) = ffastsi(ji,jj) 
    1131                   ENDIF 
    1132                   IF( med_diag%FD_CAR3%dgsave ) THEN 
    1133                      fd_car3(ji,jj,jk) = ffastc(ji,jj) 
    1134                   ENDIF 
    1135                   IF( med_diag%FD_CAL3%dgsave ) THEN 
    1136                      fd_cal3(ji,jj,jk) = ffastca(ji,jj) 
    1137                   ENDIF 
    1138                   !! 
    1139                   IF (jk.eq.i0100) THEN 
    1140                      IF( med_diag%RR_0100%dgsave ) THEN 
    1141                         ffastca2d(ji,jj) =   & 
    1142                         ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall) 
    1143                      ENDIF                      
    1144                   ELSE IF (jk.eq.i0500) THEN  
    1145                      IF( med_diag%RR_0500%dgsave ) THEN 
    1146                         ffastca2d(ji,jj) =   & 
    1147                         ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall) 
    1148                      ENDIF                         
    1149                   ELSE IF (jk.eq.i1000) THEN 
    1150                      IF( med_diag%RR_1000%dgsave ) THEN 
    1151                         ffastca2d(ji,jj) =   & 
    1152                         ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall) 
    1153                      ENDIF 
    1154                   ELSE IF (jk.eq.mbathy(ji,jj)) THEN 
    1155                      IF( med_diag%IBEN_N%dgsave ) THEN 
    1156                         iben_n2d(ji,jj) = f_sbenin_n(ji,jj)  + f_fbenin_n(ji,jj) 
    1157                      ENDIF 
    1158                      IF( med_diag%IBEN_FE%dgsave ) THEN 
    1159                         iben_fe2d(ji,jj) = f_sbenin_fe(ji,jj) + f_fbenin_fe(ji,jj) 
    1160                      ENDIF 
    1161                      IF( med_diag%IBEN_C%dgsave ) THEN 
    1162                         iben_c2d(ji,jj) = f_sbenin_c(ji,jj)  + f_fbenin_c(ji,jj) 
    1163                      ENDIF 
    1164                      IF( med_diag%IBEN_SI%dgsave ) THEN 
    1165                         iben_si2d(ji,jj) = f_fbenin_si(ji,jj) 
    1166                      ENDIF 
    1167                      IF( med_diag%IBEN_CA%dgsave ) THEN 
    1168                         iben_ca2d(ji,jj) = f_fbenin_ca(ji,jj) 
    1169                      ENDIF 
    1170                      IF( med_diag%OBEN_N%dgsave ) THEN 
    1171                         oben_n2d(ji,jj) = f_benout_n(ji,jj) 
    1172                      ENDIF 
    1173                      IF( med_diag%OBEN_FE%dgsave ) THEN 
    1174                         oben_fe2d(ji,jj) = f_benout_fe(ji,jj) 
    1175                      ENDIF 
    1176                      IF( med_diag%OBEN_C%dgsave ) THEN 
    1177                         oben_c2d(ji,jj) = f_benout_c(ji,jj) 
    1178                      ENDIF 
    1179                      IF( med_diag%OBEN_SI%dgsave ) THEN 
    1180                         oben_si2d(ji,jj) = f_benout_si(ji,jj) 
    1181                      ENDIF 
    1182                      IF( med_diag%OBEN_CA%dgsave ) THEN 
    1183                         oben_ca2d(ji,jj) = f_benout_ca(ji,jj) 
    1184                      ENDIF 
    1185                      IF( med_diag%SFR_OCAL%dgsave ) THEN 
    1186                         sfr_ocal2d(ji,jj) = f3_omcal(ji,jj,jk) 
    1187                      ENDIF 
    1188                      IF( med_diag%SFR_OARG%dgsave ) THEN 
    1189                         sfr_oarg2d(ji,jj) =  f3_omarg(ji,jj,jk) 
    1190                      ENDIF 
    1191                      IF( med_diag%LYSO_CA%dgsave ) THEN 
    1192                         lyso_ca2d(ji,jj) = f_benout_lyso_ca(ji,jj) 
    1193                      ENDIF 
    1194                   ENDIF 
    1195                   !! end bathy-1 diags 
    1196                   !! 
    1197                   IF( med_diag%RIV_N%dgsave ) THEN 
    1198                      rivn2d(ji,jj) = rivn2d(ji,jj) +  (f_riv_loc_n(ji,jj) * fse3t(ji,jj,jk)) 
    1199                   ENDIF 
    1200                   IF( med_diag%RIV_SI%dgsave ) THEN 
    1201                      rivsi2d(ji,jj) = rivsi2d(ji,jj) +  (f_riv_loc_si(ji,jj) * fse3t(ji,jj,jk)) 
    1202                   ENDIF 
    1203                   IF( med_diag%RIV_C%dgsave ) THEN 
    1204                      rivc2d(ji,jj) = rivc2d(ji,jj) +  (f_riv_loc_c(ji,jj) * fse3t(ji,jj,jk)) 
    1205                   ENDIF 
    1206                   IF( med_diag%RIV_ALK%dgsave ) THEN 
    1207                      rivalk2d(ji,jj) = rivalk2d(ji,jj) +  (f_riv_loc_alk(ji,jj) * fse3t(ji,jj,jk)) 
    1208                   ENDIF 
    1209                   IF( med_diag%DETC%dgsave ) THEN 
    1210                      fslowc2d(ji,jj) = fslowc2d(ji,jj) + (fslowc(ji,jj)  * fse3t(ji,jj,jk))    
    1211                   ENDIF 
    1212                   !!  
    1213                   !!               
    1214                   !! 
    1215                   IF( med_diag%PN_LLOSS%dgsave ) THEN 
    1216                      fdpn22d(ji,jj) = fdpn22d(ji,jj) + (fdpn2(ji,jj)  * fse3t(ji,jj,jk)) 
    1217                   ENDIF 
    1218                   IF( med_diag%PD_LLOSS%dgsave ) THEN 
    1219                      fdpd22d(ji,jj) = fdpd22d(ji,jj) + (fdpd2(ji,jj)  * fse3t(ji,jj,jk)) 
    1220                   ENDIF 
    1221                   IF( med_diag%ZI_LLOSS%dgsave ) THEN 
    1222                      fdzmi22d(ji,jj) = fdzmi22d(ji,jj) + (fdzmi2(ji,jj) * fse3t(ji,jj,jk)) 
    1223                   ENDIF 
    1224                   IF( med_diag%ZE_LLOSS%dgsave ) THEN 
    1225                      fdzme22d(ji,jj) = fdzme22d(ji,jj) + (fdzme2(ji,jj) * fse3t(ji,jj,jk)) 
    1226                   ENDIF 
    1227                   IF( med_diag%ZI_MES_N%dgsave ) THEN 
    1228                      zimesn2d(ji,jj) = zimesn2d(ji,jj) +  & 
    1229                      (xphi * (fgmipn(ji,jj) + fgmid(ji,jj)) * fse3t(ji,jj,jk)) 
    1230                   ENDIF 
    1231                   IF( med_diag%ZI_MES_D%dgsave ) THEN 
    1232                      zimesd2d(ji,jj) = zimesd2d(ji,jj) + &  
    1233                      ((1. - xbetan) * finmi(ji,jj) * fse3t(ji,jj,jk)) 
    1234                   ENDIF 
    1235                   IF( med_diag%ZI_MES_C%dgsave ) THEN 
    1236                      zimesc2d(ji,jj) = zimesc2d(ji,jj) + & 
    1237                      (xphi * ((xthetapn * fgmipn(ji,jj)) + fgmidc(ji,jj)) * fse3t(ji,jj,jk)) 
    1238                   ENDIF 
    1239                   IF( med_diag%ZI_MESDC%dgsave ) THEN 
    1240                      zimesdc2d(ji,jj) = zimesdc2d(ji,jj) + & 
    1241                      ((1. - xbetac) * ficmi(ji,jj) * fse3t(ji,jj,jk)) 
    1242                   ENDIF 
    1243                   IF( med_diag%ZI_EXCR%dgsave ) THEN 
    1244                      ziexcr2d(ji,jj) = ziexcr2d(ji,jj) +  (fmiexcr(ji,jj) * fse3t(ji,jj,jk)) 
    1245                   ENDIF 
    1246                   IF( med_diag%ZI_RESP%dgsave ) THEN 
    1247                      ziresp2d(ji,jj) = ziresp2d(ji,jj) +  (fmiresp(ji,jj) * fse3t(ji,jj,jk)) 
    1248                   ENDIF 
    1249                   IF( med_diag%ZI_GROW%dgsave ) THEN 
    1250                      zigrow2d(ji,jj) = zigrow2d(ji,jj) + (fmigrow(ji,jj) * fse3t(ji,jj,jk)) 
    1251                   ENDIF 
    1252                   IF( med_diag%ZE_MES_N%dgsave ) THEN 
    1253                      zemesn2d(ji,jj) = zemesn2d(ji,jj) + & 
    1254                      (xphi * (fgmepn(ji,jj) + fgmepd(ji,jj) + fgmezmi(ji,jj) + fgmed(ji,jj)) * fse3t(ji,jj,jk)) 
    1255                   ENDIF 
    1256                   IF( med_diag%ZE_MES_D%dgsave ) THEN 
    1257                      zemesd2d(ji,jj) = zemesd2d(ji,jj) + & 
    1258                      ((1. - xbetan) * finme(ji,jj) * fse3t(ji,jj,jk)) 
    1259                   ENDIF 
    1260                   IF( med_diag%ZE_MES_C%dgsave ) THEN 
    1261                      zemesc2d(ji,jj) = zemesc2d(ji,jj) +                         &  
    1262                      (xphi * ((xthetapn * fgmepn(ji,jj)) + (xthetapd * fgmepd(ji,jj)) +  & 
    1263                      (xthetazmi * fgmezmi(ji,jj)) + fgmedc(ji,jj)) * fse3t(ji,jj,jk)) 
    1264                   ENDIF 
    1265                   IF( med_diag%ZE_MESDC%dgsave ) THEN 
    1266                      zemesdc2d(ji,jj) = zemesdc2d(ji,jj) +  & 
    1267                      ((1. - xbetac) * ficme(ji,jj) * fse3t(ji,jj,jk)) 
    1268                   ENDIF 
    1269                   IF( med_diag%ZE_EXCR%dgsave ) THEN 
    1270                      zeexcr2d(ji,jj) = zeexcr2d(ji,jj) + (fmeexcr(ji,jj) * fse3t(ji,jj,jk)) 
    1271                   ENDIF 
    1272                   IF( med_diag%ZE_RESP%dgsave ) THEN 
    1273                      zeresp2d(ji,jj) = zeresp2d(ji,jj) + (fmeresp(ji,jj) * fse3t(ji,jj,jk)) 
    1274                   ENDIF 
    1275                   IF( med_diag%ZE_GROW%dgsave ) THEN 
    1276                      zegrow2d(ji,jj) = zegrow2d(ji,jj) + (fmegrow(ji,jj) * fse3t(ji,jj,jk)) 
    1277                   ENDIF 
    1278                   IF( med_diag%MDETC%dgsave ) THEN 
    1279                      mdetc2d(ji,jj) = mdetc2d(ji,jj) + (fddc(ji,jj) * fse3t(ji,jj,jk)) 
    1280                   ENDIF 
    1281                   IF( med_diag%GMIDC%dgsave ) THEN 
    1282                      gmidc2d(ji,jj) = gmidc2d(ji,jj) + (fgmidc(ji,jj) * fse3t(ji,jj,jk)) 
    1283                   ENDIF 
    1284                   IF( med_diag%GMEDC%dgsave ) THEN 
    1285                      gmedc2d(ji,jj) = gmedc2d(ji,jj) + (fgmedc(ji,jj)  * fse3t(ji,jj,jk)) 
    1286                   ENDIF 
    1287                   !! 
    1288 # endif                    
    1289                   !! 
    1290                   !! ** 3D diagnostics 
    1291                   IF( med_diag%TPP3%dgsave ) THEN 
    1292                      tpp3d(ji,jj,jk) =  (fprn(ji,jj) * zphn(ji,jj)) + (fprd(ji,jj) * zphd(ji,jj)) 
    1293                      !CALL iom_put( "TPP3"  , tpp3d ) 
    1294                   ENDIF 
    1295                   IF( med_diag%TPPD3%dgsave ) THEN 
    1296                      tppd3(ji,jj,jk) =  (fprd(ji,jj) * zphd(ji,jj)) 
    1297                   ENDIF 
    1298                    
    1299                   IF( med_diag%REMIN3N%dgsave ) THEN 
    1300                      remin3dn(ji,jj,jk) = fregen(ji,jj) + (freminn(ji,jj) * fse3t(ji,jj,jk)) !! remineralisation 
    1301                      !CALL iom_put( "REMIN3N"  , remin3dn ) 
    1302                   ENDIF 
    1303                   !! IF( med_diag%PH3%dgsave ) THEN 
    1304                   !!     CALL iom_put( "PH3"  , f3_pH ) 
    1305                   !! ENDIF 
    1306                   !! IF( med_diag%OM_CAL3%dgsave ) THEN 
    1307                   !!     CALL iom_put( "OM_CAL3"  , f3_omcal ) 
    1308                   !! ENDIF 
    1309         !!  
    1310         !! AXY (09/11/16): CMIP6 diagnostics 
    1311         IF ( med_diag%DCALC3%dgsave   ) THEN 
    1312                      dcalc3(ji,jj,jk) = freminca(ji,jj) 
    1313                   ENDIF 
    1314         IF ( med_diag%FEDISS3%dgsave  ) THEN 
    1315                      fediss3(ji,jj,jk) = ffetop(ji,jj) 
    1316                   ENDIF 
    1317         IF ( med_diag%FESCAV3%dgsave  ) THEN 
    1318                      fescav3(ji,jj,jk) = ffescav(ji,jj) 
    1319                   ENDIF 
    1320         IF ( med_diag%MIGRAZP3%dgsave ) THEN 
    1321                      migrazp3(ji,jj,jk) = fgmipn(ji,jj) * xthetapn 
    1322                   ENDIF 
    1323         IF ( med_diag%MIGRAZD3%dgsave ) THEN 
    1324                      migrazd3(ji,jj,jk) = fgmidc(ji,jj) 
    1325                   ENDIF 
    1326         IF ( med_diag%MEGRAZP3%dgsave ) THEN 
    1327                      megrazp3(ji,jj,jk) = (fgmepn(ji,jj) * xthetapn) + (fgmepd(ji,jj) * xthetapd) 
    1328                   ENDIF 
    1329         IF ( med_diag%MEGRAZD3%dgsave ) THEN 
    1330                      megrazd3(ji,jj,jk) = fgmedc(ji,jj) 
    1331                   ENDIF 
    1332         IF ( med_diag%MEGRAZZ3%dgsave ) THEN 
    1333                      megrazz3(ji,jj,jk) = (fgmezmi(ji,jj) * xthetazmi) 
    1334                   ENDIF 
    1335         IF ( med_diag%PBSI3%dgsave    ) THEN 
    1336                      pbsi3(ji,jj,jk)    = (fprds(ji,jj) * zpds(ji,jj)) 
    1337                   ENDIF 
    1338         IF ( med_diag%PCAL3%dgsave    ) THEN 
    1339                      pcal3(ji,jj,jk)    = ftempca(ji,jj) 
    1340                   ENDIF 
    1341         IF ( med_diag%REMOC3%dgsave   ) THEN 
    1342                      remoc3(ji,jj,jk)   = freminc(ji,jj) 
    1343                   ENDIF 
    1344         IF ( med_diag%PNLIMJ3%dgsave  ) THEN 
    1345                      ! pnlimj3(ji,jj,jk)  = fjln(ji,jj) 
    1346                      pnlimj3(ji,jj,jk)  = fjlim_pn(ji,jj) 
    1347                   ENDIF 
    1348         IF ( med_diag%PNLIMN3%dgsave  ) THEN 
    1349                      pnlimn3(ji,jj,jk)  = fnln(ji,jj) 
    1350                   ENDIF 
    1351         IF ( med_diag%PNLIMFE3%dgsave ) THEN 
    1352                      pnlimfe3(ji,jj,jk) = ffln2(ji,jj) 
    1353                   ENDIF 
    1354         IF ( med_diag%PDLIMJ3%dgsave  ) THEN 
    1355                      ! pdlimj3(ji,jj,jk)  = fjld(ji,jj) 
    1356                      pdlimj3(ji,jj,jk)  = fjlim_pd(ji,jj) 
    1357                   ENDIF 
    1358         IF ( med_diag%PDLIMN3%dgsave  ) THEN 
    1359                      pdlimn3(ji,jj,jk)  = fnld(ji,jj) 
    1360                   ENDIF 
    1361         IF ( med_diag%PDLIMFE3%dgsave ) THEN 
    1362                      pdlimfe3(ji,jj,jk) = ffld(ji,jj) 
    1363                   ENDIF 
    1364         IF ( med_diag%PDLIMSI3%dgsave ) THEN 
    1365                      pdlimsi3(ji,jj,jk) = fsld2(ji,jj) 
    1366                   ENDIF 
    1367                   !! 
    1368                   !! ** Without using iom_use 
    1369                ELSE IF( ln_diatrc ) THEN 
    1370 #   if defined key_debug_medusa 
    1371                   IF (lwp) write (numout,*) 'trc_bio_medusa: diag in ij-jj-jk ln_diatrc' 
    1372                   CALL flush(numout) 
    1373 #   endif 
    1374                   !!---------------------------------------------------------------------- 
    1375                   !! Prepare 2D diagnostics 
    1376                   !!---------------------------------------------------------------------- 
    1377                   !! 
    1378                   !! if ((kt / 240*240).eq.kt) then 
    1379                   !!    IF (lwp) write (*,*) '*******!MEDUSA DIAADD!*******',kt 
    1380                   !! endif      
    1381                   trc2d(ji,jj,1)  =  ftot_n(ji,jj)                             !! nitrogen inventory 
    1382                   trc2d(ji,jj,2)  =  ftot_si(ji,jj)                            !! silicon  inventory 
    1383                   trc2d(ji,jj,3)  =  ftot_fe(ji,jj)                            !! iron     inventory 
    1384                   trc2d(ji,jj,4)  = trc2d(ji,jj,4)  + (fprn(ji,jj)  * zphn(ji,jj) * fse3t(ji,jj,jk))    !! non-diatom production 
    1385                   trc2d(ji,jj,5)  = trc2d(ji,jj,5)  + (fdpn(ji,jj)         * fse3t(ji,jj,jk))    !! non-diatom non-grazing losses 
    1386                   trc2d(ji,jj,6)  = trc2d(ji,jj,6)  + (fprd(ji,jj)  * zphd(ji,jj) * fse3t(ji,jj,jk))    !! diatom production 
    1387                   trc2d(ji,jj,7)  = trc2d(ji,jj,7)  + (fdpd(ji,jj)         * fse3t(ji,jj,jk))    !! diatom non-grazing losses 
    1388                   !! diagnostic field  8 is (ostensibly) supplied by trcsed.F             
    1389                   trc2d(ji,jj,9)  = trc2d(ji,jj,9)  + (fprds(ji,jj) * zpds(ji,jj) * fse3t(ji,jj,jk))    !! diatom silicon production 
    1390                   trc2d(ji,jj,10) = trc2d(ji,jj,10) + (fsdiss(ji,jj)  * fse3t(ji,jj,jk))         !! diatom silicon dissolution 
    1391                   trc2d(ji,jj,11) = trc2d(ji,jj,11) + (fgmipn(ji,jj)  * fse3t(ji,jj,jk))         !! microzoo grazing on non-diatoms 
    1392                   trc2d(ji,jj,12) = trc2d(ji,jj,12) + (fgmid(ji,jj)   * fse3t(ji,jj,jk))         !! microzoo grazing on detrital nitrogen 
    1393                   trc2d(ji,jj,13) = trc2d(ji,jj,13) + (fdzmi(ji,jj)   * fse3t(ji,jj,jk))         !! microzoo non-grazing losses 
    1394                   trc2d(ji,jj,14) = trc2d(ji,jj,14) + (fgmepn(ji,jj)  * fse3t(ji,jj,jk))         !! mesozoo  grazing on non-diatoms 
    1395                   trc2d(ji,jj,15) = trc2d(ji,jj,15) + (fgmepd(ji,jj)  * fse3t(ji,jj,jk))         !! mesozoo  grazing on diatoms 
    1396                   trc2d(ji,jj,16) = trc2d(ji,jj,16) + (fgmezmi(ji,jj) * fse3t(ji,jj,jk))         !! mesozoo  grazing on microzoo 
    1397                   trc2d(ji,jj,17) = trc2d(ji,jj,17) + (fgmed(ji,jj)   * fse3t(ji,jj,jk))         !! mesozoo  grazing on detrital nitrogen 
    1398                   trc2d(ji,jj,18) = trc2d(ji,jj,18) + (fdzme(ji,jj)   * fse3t(ji,jj,jk))         !! mesozoo  non-grazing losses 
    1399                   !! diagnostic field 19 is (ostensibly) supplied by trcexp.F 
    1400                   trc2d(ji,jj,20) = trc2d(ji,jj,20) + (fslown(ji,jj)  * fse3t(ji,jj,jk))         !! slow sinking detritus N production 
    1401                   trc2d(ji,jj,21) = trc2d(ji,jj,21) + (fdd(ji,jj)     * fse3t(ji,jj,jk))         !! detrital remineralisation 
    1402                   trc2d(ji,jj,22) = trc2d(ji,jj,22) + (ffetop(ji,jj)  * fse3t(ji,jj,jk))         !! aeolian  iron addition 
    1403                   trc2d(ji,jj,23) = trc2d(ji,jj,23) + (ffebot(ji,jj)  * fse3t(ji,jj,jk))         !! seafloor iron addition 
    1404                   trc2d(ji,jj,24) = trc2d(ji,jj,24) + (ffescav(ji,jj) * fse3t(ji,jj,jk))         !! "free" iron scavenging 
    1405                   trc2d(ji,jj,25) = trc2d(ji,jj,25) + (fjlim_pn(ji,jj) * zphn(ji,jj) * fse3t(ji,jj,jk)) !! non-diatom J  limitation term  
    1406                   trc2d(ji,jj,26) = trc2d(ji,jj,26) + (fnln(ji,jj)  * zphn(ji,jj) * fse3t(ji,jj,jk))    !! non-diatom N  limitation term  
    1407                   trc2d(ji,jj,27) = trc2d(ji,jj,27) + (ffln2(ji,jj)  * zphn(ji,jj) * fse3t(ji,jj,jk))    !! non-diatom Fe limitation term  
    1408                   trc2d(ji,jj,28) = trc2d(ji,jj,28) + (fjlim_pd(ji,jj) * zphd(ji,jj) * fse3t(ji,jj,jk)) !! diatom     J  limitation term  
    1409                   trc2d(ji,jj,29) = trc2d(ji,jj,29) + (fnld(ji,jj)  * zphd(ji,jj) * fse3t(ji,jj,jk))    !! diatom     N  limitation term  
    1410                   trc2d(ji,jj,30) = trc2d(ji,jj,30) + (ffld(ji,jj)  * zphd(ji,jj) * fse3t(ji,jj,jk))    !! diatom     Fe limitation term  
    1411                   trc2d(ji,jj,31) = trc2d(ji,jj,31) + (fsld2(ji,jj) * zphd(ji,jj) * fse3t(ji,jj,jk))    !! diatom     Si limitation term  
    1412                   trc2d(ji,jj,32) = trc2d(ji,jj,32) + (fsld(ji,jj)  * zphd(ji,jj) * fse3t(ji,jj,jk))    !! diatom     Si uptake limitation term 
    1413                   if (jk.eq.i0100) trc2d(ji,jj,33) = fslownflux(ji,jj)         !! slow detritus flux at  100 m 
    1414                   if (jk.eq.i0200) trc2d(ji,jj,34) = fslownflux(ji,jj)         !! slow detritus flux at  200 m 
    1415                   if (jk.eq.i0500) trc2d(ji,jj,35) = fslownflux(ji,jj)         !! slow detritus flux at  500 m 
    1416                   if (jk.eq.i1000) trc2d(ji,jj,36) = fslownflux(ji,jj)         !! slow detritus flux at 1000 m 
    1417                   trc2d(ji,jj,37) = trc2d(ji,jj,37) + fregen(ji,jj)                   !! non-fast N  full column regeneration 
    1418                   trc2d(ji,jj,38) = trc2d(ji,jj,38) + fregensi(ji,jj)                 !! non-fast Si full column regeneration 
    1419                   if (jk.eq.i0100) trc2d(ji,jj,39) = trc2d(ji,jj,37)           !! non-fast N  regeneration to  100 m 
    1420                   if (jk.eq.i0200) trc2d(ji,jj,40) = trc2d(ji,jj,37)           !! non-fast N  regeneration to  200 m 
    1421                   if (jk.eq.i0500) trc2d(ji,jj,41) = trc2d(ji,jj,37)           !! non-fast N  regeneration to  500 m 
    1422                   if (jk.eq.i1000) trc2d(ji,jj,42) = trc2d(ji,jj,37)           !! non-fast N  regeneration to 1000 m 
    1423                   trc2d(ji,jj,43) = trc2d(ji,jj,43) + (ftempn(ji,jj)  * fse3t(ji,jj,jk))         !! fast sinking detritus N production 
    1424                   trc2d(ji,jj,44) = trc2d(ji,jj,44) + (ftempsi(ji,jj) * fse3t(ji,jj,jk))         !! fast sinking detritus Si production 
    1425                   trc2d(ji,jj,45) = trc2d(ji,jj,45) + (ftempfe(ji,jj) * fse3t(ji,jj,jk))         !! fast sinking detritus Fe production 
    1426                   trc2d(ji,jj,46) = trc2d(ji,jj,46) + (ftempc(ji,jj)  * fse3t(ji,jj,jk))         !! fast sinking detritus C production 
    1427                   trc2d(ji,jj,47) = trc2d(ji,jj,47) + (ftempca(ji,jj) * fse3t(ji,jj,jk))         !! fast sinking detritus CaCO3 production 
    1428                   if (jk.eq.i0100) trc2d(ji,jj,48) = ffastn(ji,jj)             !! fast detritus N  flux at  100 m 
    1429                   if (jk.eq.i0200) trc2d(ji,jj,49) = ffastn(ji,jj)             !! fast detritus N  flux at  200 m 
    1430                   if (jk.eq.i0500) trc2d(ji,jj,50) = ffastn(ji,jj)             !! fast detritus N  flux at  500 m 
    1431                   if (jk.eq.i1000) trc2d(ji,jj,51) = ffastn(ji,jj)             !! fast detritus N  flux at 1000 m 
    1432                   if (jk.eq.i0100) trc2d(ji,jj,52) = fregenfast(ji,jj)         !! N  regeneration to  100 m 
    1433                   if (jk.eq.i0200) trc2d(ji,jj,53) = fregenfast(ji,jj)         !! N  regeneration to  200 m 
    1434                   if (jk.eq.i0500) trc2d(ji,jj,54) = fregenfast(ji,jj)         !! N  regeneration to  500 m 
    1435                   if (jk.eq.i1000) trc2d(ji,jj,55) = fregenfast(ji,jj)         !! N  regeneration to 1000 m 
    1436                   if (jk.eq.i0100) trc2d(ji,jj,56) = ffastsi(ji,jj)            !! fast detritus Si flux at  100 m 
    1437                   if (jk.eq.i0200) trc2d(ji,jj,57) = ffastsi(ji,jj)            !! fast detritus Si flux at  200 m 
    1438                   if (jk.eq.i0500) trc2d(ji,jj,58) = ffastsi(ji,jj)            !! fast detritus Si flux at  500 m 
    1439                   if (jk.eq.i1000) trc2d(ji,jj,59) = ffastsi(ji,jj)            !! fast detritus Si flux at 1000 m 
    1440                   if (jk.eq.i0100) trc2d(ji,jj,60) = fregenfastsi(ji,jj)       !! Si regeneration to  100 m 
    1441                   if (jk.eq.i0200) trc2d(ji,jj,61) = fregenfastsi(ji,jj)       !! Si regeneration to  200 m 
    1442                   if (jk.eq.i0500) trc2d(ji,jj,62) = fregenfastsi(ji,jj)       !! Si regeneration to  500 m 
    1443                   if (jk.eq.i1000) trc2d(ji,jj,63) = fregenfastsi(ji,jj)       !! Si regeneration to 1000 m 
    1444                   trc2d(ji,jj,64) = trc2d(ji,jj,64) + (freminn(ji,jj)  * fse3t(ji,jj,jk))        !! sum of fast-sinking N  fluxes 
    1445                   trc2d(ji,jj,65) = trc2d(ji,jj,65) + (freminsi(ji,jj) * fse3t(ji,jj,jk))        !! sum of fast-sinking Si fluxes 
    1446                   trc2d(ji,jj,66) = trc2d(ji,jj,66) + (freminfe(ji,jj) * fse3t(ji,jj,jk))        !! sum of fast-sinking Fe fluxes 
    1447                   trc2d(ji,jj,67) = trc2d(ji,jj,67) + (freminc(ji,jj)  * fse3t(ji,jj,jk))        !! sum of fast-sinking C  fluxes 
    1448                   trc2d(ji,jj,68) = trc2d(ji,jj,68) + (freminca(ji,jj) * fse3t(ji,jj,jk))        !! sum of fast-sinking Ca fluxes 
    1449                   if (jk.eq.mbathy(ji,jj)) then 
    1450                      trc2d(ji,jj,69) = fsedn(ji,jj)                                   !! N  sedimentation flux                                   
    1451                      trc2d(ji,jj,70) = fsedsi(ji,jj)                                  !! Si sedimentation flux 
    1452                      trc2d(ji,jj,71) = fsedfe(ji,jj)                                  !! Fe sedimentation flux 
    1453                      trc2d(ji,jj,72) = fsedc(ji,jj)                                   !! C  sedimentation flux 
    1454                      trc2d(ji,jj,73) = fsedca(ji,jj)                                  !! Ca sedimentation flux 
    1455                   endif 
    1456                   if (jk.eq.1)  trc2d(ji,jj,74) = qsr(ji,jj) 
    1457                   if (jk.eq.1)  trc2d(ji,jj,75) = xpar(ji,jj,jk) 
    1458                   !! if (jk.eq.1)  trc2d(ji,jj,75) = real(iters(ji,jj)) 
    1459                   !! diagnostic fields 76 to 80 calculated below 
    1460                   trc2d(ji,jj,81) = trc2d(ji,jj,81) + fprn_ml(ji,jj)           !! mixed layer non-diatom production 
    1461                   trc2d(ji,jj,82) = trc2d(ji,jj,82) + fprd_ml(ji,jj)           !! mixed layer     diatom production 
    1462 # if defined key_gulf_finland 
    1463                   if (jk.eq.1)  trc2d(ji,jj,83) = real(ibio_switch)            !! Gulf of Finland check 
    1464 # else 
    1465                   trc2d(ji,jj,83) = ocal_ccd(ji,jj)                            !! calcite CCD depth 
    1466 # endif 
    1467                   trc2d(ji,jj,84) = fccd(ji,jj)                                !! last model level above calcite CCD depth 
    1468                   if (jk.eq.1)     trc2d(ji,jj,85) = xFree(ji,jj)              !! surface "free" iron 
    1469                   if (jk.eq.i0200) trc2d(ji,jj,86) = xFree(ji,jj)              !! "free" iron at  100 m 
    1470                   if (jk.eq.i0200) trc2d(ji,jj,87) = xFree(ji,jj)              !! "free" iron at  200 m 
    1471                   if (jk.eq.i0500) trc2d(ji,jj,88) = xFree(ji,jj)              !! "free" iron at  500 m 
    1472                   if (jk.eq.i1000) trc2d(ji,jj,89) = xFree(ji,jj)              !! "free" iron at 1000 m 
    1473                   !! AXY (27/06/12): extract "euphotic depth" 
    1474                   if (jk.eq.1)     trc2d(ji,jj,90) = xze(ji,jj) 
    1475                   !!  
    1476 # if defined key_roam 
    1477                   !! ROAM provisionally has access to a further 20 2D diagnostics 
    1478                   if (jk .eq. 1) then 
    1479                      trc2d(ji,jj,91)  = trc2d(ji,jj,91)  + wndm(ji,jj)              !! surface wind 
    1480                      trc2d(ji,jj,92)  = trc2d(ji,jj,92)  + f_pco2atm(ji,jj)           !! atmospheric pCO2 
    1481                      trc2d(ji,jj,93)  = trc2d(ji,jj,93)  + f_ph(ji,jj)                !! ocean pH 
    1482                      trc2d(ji,jj,94)  = trc2d(ji,jj,94)  + f_pco2w(ji,jj)             !! ocean pCO2 
    1483                      trc2d(ji,jj,95)  = trc2d(ji,jj,95)  + f_h2co3(ji,jj)             !! ocean H2CO3 conc. 
    1484                      trc2d(ji,jj,96)  = trc2d(ji,jj,96)  + f_hco3(ji,jj)              !! ocean HCO3 conc. 
    1485                      trc2d(ji,jj,97)  = trc2d(ji,jj,97)  + f_co3(ji,jj)               !! ocean CO3 conc. 
    1486                      trc2d(ji,jj,98)  = trc2d(ji,jj,98)  + f_co2flux(ji,jj)           !! air-sea CO2 flux 
    1487                      trc2d(ji,jj,99)  = trc2d(ji,jj,99)  + f_omcal(ji,jj)      !! ocean omega calcite  
    1488                      trc2d(ji,jj,100) = trc2d(ji,jj,100) + f_omarg(ji,jj)      !! ocean omega aragonite 
    1489                      trc2d(ji,jj,101) = trc2d(ji,jj,101) + f_TDIC(ji,jj)              !! ocean TDIC 
    1490                      trc2d(ji,jj,102) = trc2d(ji,jj,102) + f_TALK(ji,jj)              !! ocean TALK 
    1491                      trc2d(ji,jj,103) = trc2d(ji,jj,103) + f_kw660(ji,jj)             !! surface kw660 
    1492                      trc2d(ji,jj,104) = trc2d(ji,jj,104) + f_pp0(ji,jj)               !! surface pressure 
    1493                      trc2d(ji,jj,105) = trc2d(ji,jj,105) + f_o2flux(ji,jj)            !! air-sea O2 flux 
    1494                      trc2d(ji,jj,106) = trc2d(ji,jj,106) + f_o2sat(ji,jj)             !! ocean O2 saturation 
    1495                      trc2d(ji,jj,107) = f2_ccd_cal(ji,jj)                      !! depth calcite CCD 
    1496                      trc2d(ji,jj,108) = f2_ccd_arg(ji,jj)                      !! depth aragonite CCD 
    1497                   endif 
    1498                   if (jk .eq. mbathy(ji,jj)) then 
    1499                      trc2d(ji,jj,109) = f3_omcal(ji,jj,jk)                     !! seafloor omega calcite 
    1500                      trc2d(ji,jj,110) = f3_omarg(ji,jj,jk)                     !! seafloor omega aragonite 
    1501                   endif 
    1502                   !! diagnostic fields 111 to 117 calculated below 
    1503                   if (jk.eq.i0100) trc2d(ji,jj,118) = ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall)  !! rain ratio at  100 m 
    1504                   if (jk.eq.i0500) trc2d(ji,jj,119) = ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall)  !! rain ratio at  500 m 
    1505                   if (jk.eq.i1000) trc2d(ji,jj,120) = ffastca(ji,jj)/MAX(ffastc(ji,jj), rsmall)  !! rain ratio at 1000 m 
    1506                   !! AXY (18/01/12): benthic flux diagnostics 
    1507                   if (jk.eq.mbathy(ji,jj)) then 
    1508                      trc2d(ji,jj,121) = f_sbenin_n(ji,jj)  + f_fbenin_n(ji,jj) 
    1509                      trc2d(ji,jj,122) = f_sbenin_fe(ji,jj) + f_fbenin_fe(ji,jj) 
    1510                      trc2d(ji,jj,123) = f_sbenin_c(ji,jj)  + f_fbenin_c(ji,jj) 
    1511                      trc2d(ji,jj,124) = f_fbenin_si(ji,jj) 
    1512                      trc2d(ji,jj,125) = f_fbenin_ca(ji,jj) 
    1513                      trc2d(ji,jj,126) = f_benout_n(ji,jj) 
    1514                      trc2d(ji,jj,127) = f_benout_fe(ji,jj) 
    1515                      trc2d(ji,jj,128) = f_benout_c(ji,jj) 
    1516                      trc2d(ji,jj,129) = f_benout_si(ji,jj) 
    1517                      trc2d(ji,jj,130) = f_benout_ca(ji,jj) 
    1518                   endif 
    1519                   !! diagnostics fields 131 to 135 calculated below 
    1520                   trc2d(ji,jj,136) = f_runoff(ji,jj) 
    1521                   !! AXY (19/07/12): amended to allow for riverine nutrient addition below surface 
    1522                   trc2d(ji,jj,137) = trc2d(ji,jj,137) + (f_riv_loc_n(ji,jj) * fse3t(ji,jj,jk)) 
    1523                   trc2d(ji,jj,138) = trc2d(ji,jj,138) + (f_riv_loc_si(ji,jj) * fse3t(ji,jj,jk)) 
    1524                   trc2d(ji,jj,139) = trc2d(ji,jj,139) + (f_riv_loc_c(ji,jj) * fse3t(ji,jj,jk)) 
    1525                   trc2d(ji,jj,140) = trc2d(ji,jj,140) + (f_riv_loc_alk(ji,jj) * fse3t(ji,jj,jk)) 
    1526                   trc2d(ji,jj,141) = trc2d(ji,jj,141) + (fslowc(ji,jj)  * fse3t(ji,jj,jk))       !! slow sinking detritus C production 
    1527                   if (jk.eq.i0100) trc2d(ji,jj,142) = fslowcflux(ji,jj)        !! slow detritus flux at  100 m 
    1528                   if (jk.eq.i0200) trc2d(ji,jj,143) = fslowcflux(ji,jj)        !! slow detritus flux at  200 m 
    1529                   if (jk.eq.i0500) trc2d(ji,jj,144) = fslowcflux(ji,jj)        !! slow detritus flux at  500 m 
    1530                   if (jk.eq.i1000) trc2d(ji,jj,145) = fslowcflux(ji,jj)        !! slow detritus flux at 1000 m 
    1531                   trc2d(ji,jj,146)  = trc2d(ji,jj,146)  + ftot_c(ji,jj)        !! carbon     inventory 
    1532                   trc2d(ji,jj,147)  = trc2d(ji,jj,147)  + ftot_a(ji,jj)        !! alkalinity inventory 
    1533                   trc2d(ji,jj,148)  = trc2d(ji,jj,148)  + ftot_o2(ji,jj)       !! oxygen     inventory 
    1534                   if (jk.eq.mbathy(ji,jj)) then 
    1535                      trc2d(ji,jj,149) = f_benout_lyso_ca(ji,jj) 
    1536                   endif 
    1537                   trc2d(ji,jj,150) = fcomm_resp(ji,jj) * fse3t(ji,jj,jk)                  !! community respiration 
    1538         !! 
    1539         !! AXY (14/02/14): a Valentines Day gift to BASIN - a shedload of new 
    1540                   !!                 diagnostics that they'll most likely never need! 
    1541                   !!                 (actually, as with all such gifts, I'm giving them 
    1542                   !!                 some things I'd like myself!) 
    1543                   !!  
    1544                   !! ---------------------------------------------------------------------- 
    1545                   !! linear losses 
    1546                   !! non-diatom 
    1547                   trc2d(ji,jj,151) = trc2d(ji,jj,151) + (fdpn2(ji,jj)  * fse3t(ji,jj,jk)) 
    1548                   !! diatom 
    1549                   trc2d(ji,jj,152) = trc2d(ji,jj,152) + (fdpd2(ji,jj)  * fse3t(ji,jj,jk)) 
    1550                   !! microzooplankton 
    1551                   trc2d(ji,jj,153) = trc2d(ji,jj,153) + (fdzmi2(ji,jj) * fse3t(ji,jj,jk)) 
    1552                   !! mesozooplankton 
    1553                   trc2d(ji,jj,154) = trc2d(ji,jj,154) + (fdzme2(ji,jj) * fse3t(ji,jj,jk)) 
    1554                   !! ---------------------------------------------------------------------- 
    1555                   !! microzooplankton grazing 
    1556                   !! microzooplankton messy -> N 
    1557                   trc2d(ji,jj,155) = trc2d(ji,jj,155) + (xphi * (fgmipn(ji,jj) + fgmid(ji,jj)) * fse3t(ji,jj,jk)) 
    1558                   !! microzooplankton messy -> D 
    1559                   trc2d(ji,jj,156) = trc2d(ji,jj,156) + ((1. - xbetan) * finmi(ji,jj) * fse3t(ji,jj,jk)) 
    1560                   !! microzooplankton messy -> DIC 
    1561                   trc2d(ji,jj,157) = trc2d(ji,jj,157) + (xphi * ((xthetapn * fgmipn(ji,jj)) + fgmidc(ji,jj)) * fse3t(ji,jj,jk)) 
    1562                   !! microzooplankton messy -> Dc 
    1563                   trc2d(ji,jj,158) = trc2d(ji,jj,158) + ((1. - xbetac) * ficmi(ji,jj) * fse3t(ji,jj,jk)) 
    1564                   !! microzooplankton excretion 
    1565                   trc2d(ji,jj,159) = trc2d(ji,jj,159) + (fmiexcr(ji,jj) * fse3t(ji,jj,jk)) 
    1566                   !! microzooplankton respiration 
    1567                   trc2d(ji,jj,160) = trc2d(ji,jj,160) + (fmiresp(ji,jj) * fse3t(ji,jj,jk)) 
    1568                   !! microzooplankton growth 
    1569                   trc2d(ji,jj,161) = trc2d(ji,jj,161) + (fmigrow(ji,jj) * fse3t(ji,jj,jk)) 
    1570                   !! ---------------------------------------------------------------------- 
    1571                   !! mesozooplankton grazing 
    1572                   !! mesozooplankton messy -> N 
    1573                   trc2d(ji,jj,162) = trc2d(ji,jj,162) + (xphi * (fgmepn(ji,jj) + fgmepd(ji,jj) + fgmezmi(ji,jj) + fgmed(ji,jj)) * fse3t(ji,jj,jk)) 
    1574                   !! mesozooplankton messy -> D 
    1575                   trc2d(ji,jj,163) = trc2d(ji,jj,163) + ((1. - xbetan) * finme(ji,jj) * fse3t(ji,jj,jk)) 
    1576                   !! mesozooplankton messy -> DIC 
    1577                   trc2d(ji,jj,164) = trc2d(ji,jj,164) + (xphi * ((xthetapn * fgmepn(ji,jj)) + (xthetapd * fgmepd(ji,jj)) + & 
    1578                   &                  (xthetazmi * fgmezmi(ji,jj)) + fgmedc(ji,jj)) * fse3t(ji,jj,jk)) 
    1579                   !! mesozooplankton messy -> Dc 
    1580                   trc2d(ji,jj,165) = trc2d(ji,jj,165) + ((1. - xbetac) * ficme(ji,jj) * fse3t(ji,jj,jk)) 
    1581                   !! mesozooplankton excretion 
    1582                   trc2d(ji,jj,166) = trc2d(ji,jj,166) + (fmeexcr(ji,jj) * fse3t(ji,jj,jk)) 
    1583                   !! mesozooplankton respiration 
    1584                   trc2d(ji,jj,167) = trc2d(ji,jj,167) + (fmeresp(ji,jj) * fse3t(ji,jj,jk)) 
    1585                   !! mesozooplankton growth 
    1586                   trc2d(ji,jj,168) = trc2d(ji,jj,168) + (fmegrow(ji,jj) * fse3t(ji,jj,jk)) 
    1587                   !! ---------------------------------------------------------------------- 
    1588                   !! miscellaneous 
    1589                   trc2d(ji,jj,169) = trc2d(ji,jj,169) + (fddc(ji,jj)    * fse3t(ji,jj,jk)) !! detrital C remineralisation 
    1590                   trc2d(ji,jj,170) = trc2d(ji,jj,170) + (fgmidc(ji,jj)  * fse3t(ji,jj,jk)) !! microzoo grazing on detrital carbon 
    1591                   trc2d(ji,jj,171) = trc2d(ji,jj,171) + (fgmedc(ji,jj)  * fse3t(ji,jj,jk)) !! mesozoo  grazing on detrital carbon 
    1592                   !! 
    1593                   !! ---------------------------------------------------------------------- 
    1594         !! 
    1595         !! AXY (23/10/14): extract primary production related surface fields to 
    1596         !!                 deal with diel cycle issues; hijacking BASIN 150m 
    1597         !!                 diagnostics to do so (see commented out diagnostics 
    1598         !!                 below this section) 
    1599         !! 
    1600                   !! extract relevant BASIN fields at 150m 
    1601                   if (jk .eq. i0150) then 
    1602                      trc2d(ji,jj,172) = trc2d(ji,jj,4)    !! Pn PP 
    1603                      trc2d(ji,jj,173) = trc2d(ji,jj,151)  !! Pn linear loss 
    1604                      trc2d(ji,jj,174) = trc2d(ji,jj,5)    !! Pn non-linear loss 
    1605                      trc2d(ji,jj,175) = trc2d(ji,jj,11)   !! Pn grazing to Zmi 
    1606                      trc2d(ji,jj,176) = trc2d(ji,jj,14)   !! Pn grazing to Zme 
    1607                      trc2d(ji,jj,177) = trc2d(ji,jj,6)    !! Pd PP 
    1608                      trc2d(ji,jj,178) = trc2d(ji,jj,152)  !! Pd linear loss 
    1609                      trc2d(ji,jj,179) = trc2d(ji,jj,7)    !! Pd non-linear loss 
    1610                      trc2d(ji,jj,180) = trc2d(ji,jj,15)   !! Pd grazing to Zme 
    1611                      trc2d(ji,jj,181) = trc2d(ji,jj,12)   !! Zmi grazing on D 
    1612                      trc2d(ji,jj,182) = trc2d(ji,jj,170)  !! Zmi grazing on Dc 
    1613                      trc2d(ji,jj,183) = trc2d(ji,jj,155)  !! Zmi messy feeding loss to N 
    1614                      trc2d(ji,jj,184) = trc2d(ji,jj,156)  !! Zmi messy feeding loss to D 
    1615                      trc2d(ji,jj,185) = trc2d(ji,jj,157)  !! Zmi messy feeding loss to DIC 
    1616                      trc2d(ji,jj,186) = trc2d(ji,jj,158)  !! Zmi messy feeding loss to Dc 
    1617                      trc2d(ji,jj,187) = trc2d(ji,jj,159)  !! Zmi excretion 
    1618                      trc2d(ji,jj,188) = trc2d(ji,jj,160)  !! Zmi respiration 
    1619                      trc2d(ji,jj,189) = trc2d(ji,jj,161)  !! Zmi growth 
    1620                      trc2d(ji,jj,190) = trc2d(ji,jj,153)  !! Zmi linear loss 
    1621                      trc2d(ji,jj,191) = trc2d(ji,jj,13)   !! Zmi non-linear loss 
    1622                      trc2d(ji,jj,192) = trc2d(ji,jj,16)   !! Zmi grazing to Zme 
    1623                      trc2d(ji,jj,193) = trc2d(ji,jj,17)   !! Zme grazing on D 
    1624                      trc2d(ji,jj,194) = trc2d(ji,jj,171)  !! Zme grazing on Dc 
    1625                      trc2d(ji,jj,195) = trc2d(ji,jj,162)  !! Zme messy feeding loss to N 
    1626                      trc2d(ji,jj,196) = trc2d(ji,jj,163)  !! Zme messy feeding loss to D 
    1627                      trc2d(ji,jj,197) = trc2d(ji,jj,164)  !! Zme messy feeding loss to DIC 
    1628                      trc2d(ji,jj,198) = trc2d(ji,jj,165)  !! Zme messy feeding loss to Dc 
    1629                      trc2d(ji,jj,199) = trc2d(ji,jj,166)  !! Zme excretion 
    1630                      trc2d(ji,jj,200) = trc2d(ji,jj,167)  !! Zme respiration 
    1631                      trc2d(ji,jj,201) = trc2d(ji,jj,168)  !! Zme growth 
    1632                      trc2d(ji,jj,202) = trc2d(ji,jj,154)  !! Zme linear loss 
    1633                      trc2d(ji,jj,203) = trc2d(ji,jj,18)   !! Zme non-linear loss 
    1634                      trc2d(ji,jj,204) = trc2d(ji,jj,20)   !! Slow detritus production, N 
    1635                      trc2d(ji,jj,205) = trc2d(ji,jj,21)   !! Slow detritus remineralisation, N 
    1636                      trc2d(ji,jj,206) = trc2d(ji,jj,141)  !! Slow detritus production, C 
    1637                      trc2d(ji,jj,207) = trc2d(ji,jj,169)  !! Slow detritus remineralisation, C 
    1638                      trc2d(ji,jj,208) = trc2d(ji,jj,43)   !! Fast detritus production, N 
    1639                      trc2d(ji,jj,209) = trc2d(ji,jj,21)   !! Fast detritus remineralisation, N 
    1640                      trc2d(ji,jj,210) = trc2d(ji,jj,64)   !! Fast detritus production, C 
    1641                      trc2d(ji,jj,211) = trc2d(ji,jj,67)   !! Fast detritus remineralisation, C 
    1642                      trc2d(ji,jj,212) = trc2d(ji,jj,150)  !! Community respiration 
    1643                      trc2d(ji,jj,213) = fslownflux(ji,jj) !! Slow detritus N flux at 150 m 
    1644                      trc2d(ji,jj,214) = fslowcflux(ji,jj) !! Slow detritus C flux at 150 m 
    1645                      trc2d(ji,jj,215) = ffastn(ji,jj)     !! Fast detritus N flux at 150 m 
    1646                      trc2d(ji,jj,216) = ffastc(ji,jj)     !! Fast detritus C flux at 150 m 
    1647                   endif 
    1648                   !!  
    1649                   !! Jpalm (11-08-2014) 
    1650                   !! Add UKESM1 diagnoatics  
    1651                   !!^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^ 
    1652                   if ((jk .eq. 1) .and.( jdms.eq.1)) then 
    1653                      trc2d(ji,jj,221) = dms_surf(ji,jj)          !! DMS surface concentration  
    1654                      !! AXY (13/03/15): add in other DMS estimates 
    1655                      trc2d(ji,jj,222) = dms_andr(ji,jj)          !! DMS surface concentration  
    1656                      trc2d(ji,jj,223) = dms_simo(ji,jj)          !! DMS surface concentration  
    1657                      trc2d(ji,jj,224) = dms_aran(ji,jj)          !! DMS surface concentration  
    1658                      trc2d(ji,jj,225) = dms_hall(ji,jj)          !! DMS surface concentration  
    1659                   endif 
    1660 # endif 
    1661                   !! other possible future diagnostics include: 
    1662                   !!   - integrated tracer values (esp. biological) 
    1663                   !!   - mixed layer tracer values 
    1664                   !!   - sub-surface chlorophyll maxima (plus depth) 
    1665                   !!   - different mixed layer depth criteria (T, sigma, var. sigma) 
    1666  
    1667                   !!---------------------------------------------------------------------- 
    1668                   !! Prepare 3D diagnostics 
    1669                   !!---------------------------------------------------------------------- 
    1670                   !! 
    1671                   trc3d(ji,jj,jk,1)  = ((fprn(ji,jj) + fprd(ji,jj)) * zphn(ji,jj))     !! primary production   
    1672                   trc3d(ji,jj,jk,2)  = fslownflux(ji,jj) + ffastn(ji,jj) !! detrital flux 
    1673                   trc3d(ji,jj,jk,3)  = fregen(ji,jj) + (freminn(ji,jj) * fse3t(ji,jj,jk))  !! remineralisation 
    1674 # if defined key_roam 
    1675                   trc3d(ji,jj,jk,4)  = f3_pH(ji,jj,jk)            !! pH 
    1676                   trc3d(ji,jj,jk,5)  = f3_omcal(ji,jj,jk)         !! omega calcite 
    1677 # else 
    1678                   trc3d(ji,jj,jk,4)  = ffastsi(ji,jj)             !! fast Si flux 
    1679 # endif 
    1680              ENDIF   ! end of ln_diatrc option 
    1681              !! CLOSE wet point IF..THEN loop 
    1682             endif 
    1683          !! CLOSE horizontal loops 
    1684          ENDDO 
    1685          ENDDO 
    1686          !! 
    1687              IF( lk_iomput  .AND.  .NOT.  ln_diatrc  ) THEN 
    1688  
    1689                 !!------------------------------------------------------- 
    1690                 !! 2d specific k level diags 
    1691                 !!------------------------------------------------------- 
    1692                 CALL bio_medusa_diag_slice( jk ) 
    1693  
    1694               ENDIF 
     960         !!------------------------------------------------------------------ 
     961         !! Diagnostics 
     962         !!------------------------------------------------------------------ 
     963         CALL bio_medusa_diag( kt, jk ) 
     964 
     965         IF( lk_iomput  .AND.  .NOT.  ln_diatrc  ) THEN 
     966 
     967            !!------------------------------------------------------- 
     968            !! 2d specific k level diags 
     969            !!------------------------------------------------------- 
     970            CALL bio_medusa_diag_slice( jk ) 
     971 
     972         ENDIF 
     973 
    1695974      !! CLOSE vertical loop 
    1696975      ENDDO 
Note: See TracChangeset for help on using the changeset viewer.