Changeset 3294 for trunk/NEMOGCM/NEMO/TOP_SRC/PISCES
- Timestamp:
- 2012-01-28T17:44:18+01:00 (12 years ago)
- Location:
- trunk/NEMOGCM/NEMO/TOP_SRC/PISCES
- Files:
-
- 20 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zbio.F90
r2715 r3294 14 14 !! compartments of PISCES 15 15 !!---------------------------------------------------------------------- 16 USE oce_trc ! 17 USE trc !18 USE sms_pisces ! 19 USE p4zsink ! 20 USE p4zopt ! 21 USE p4zlim ! 22 USE p4zprod ! 23 USE p4zmort ! 24 USE p4zmicro ! 25 USE p4zmeso ! 26 USE p4zrem ! 27 USE prtctl_trc 28 USE iom 16 USE oce_trc ! shared variables between ocean and passive tracers 17 USE trc ! passive tracers common variables 18 USE sms_pisces ! PISCES Source Minus Sink variables 19 USE p4zsink ! vertical flux of particulate matter due to sinking 20 USE p4zopt ! optical model 21 USE p4zlim ! Co-limitations of differents nutrients 22 USE p4zprod ! Growth rate of the 2 phyto groups 23 USE p4zmort ! Mortality terms for phytoplankton 24 USE p4zmicro ! Sources and sinks of microzooplankton 25 USE p4zmeso ! Sources and sinks of mesozooplankton 26 USE p4zrem ! Remineralisation of organic matter 27 USE prtctl_trc ! print control for debugging 28 USE iom ! I/O manager 29 29 30 30 IMPLICIT NONE … … 62 62 63 63 !!--------------------------------------------------------------------- 64 64 ! 65 IF( nn_timing == 1 ) CALL timing_start('p4z_bio') 66 ! 65 67 ! ASSIGN THE SHEAR RATE THAT IS USED FOR AGGREGATION 66 68 ! OF PHYTOPLANKTON AND DETRITUS … … 129 131 ENDIF 130 132 ! 133 IF( nn_timing == 1 ) CALL timing_stop('p4z_bio') 134 ! 131 135 END SUBROUTINE p4z_bio 132 136 -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zche.F90
r2715 r3294 10 10 !! - ! 2006 (R. Gangsto) modification 11 11 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) F90 12 !! ! 2011-02 (J. Simeon, J.Orr ) update O2 solubility constants 12 13 !!---------------------------------------------------------------------- 13 14 #if defined key_pisces … … 17 18 !! p4z_che : Sea water chemistry computed following OCMIP protocol 18 19 !!---------------------------------------------------------------------- 19 USE oce_trc ! 20 USE trc ! 21 USE sms_pisces ! 22 USE lib_mpp ! MPP library20 USE oce_trc ! shared variables between ocean and passive tracers 21 USE trc ! passive tracers common variables 22 USE sms_pisces ! PISCES Source Minus Sink variables 23 USE lib_mpp ! MPP library 23 24 24 25 IMPLICIT NONE … … 32 33 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: chemc ! Solubilities of O2 and CO2 33 34 34 REAL(wp) :: salchl = 1._wp / 1.80655_wp ! conversion factor for salinity --> chlorinity (Wooster et al. 1969) 35 36 REAL(wp) :: akcc1 = -171.9065_wp ! coeff. for apparent solubility equilibrium 37 REAL(wp) :: akcc2 = -0.077993_wp ! Millero et al. 1995 from Mucci 1983 38 REAL(wp) :: akcc3 = 2839.319_wp ! 39 REAL(wp) :: akcc4 = 71.595_wp ! 40 REAL(wp) :: akcc5 = -0.77712_wp ! 41 REAL(wp) :: akcc6 = 0.0028426_wp ! 42 REAL(wp) :: akcc7 = 178.34_wp ! 43 REAL(wp) :: akcc8 = -0.07711_wp ! 44 REAL(wp) :: akcc9 = 0.0041249_wp ! 45 46 REAL(wp) :: rgas = 83.143_wp ! universal gas constants 47 REAL(wp) :: oxyco = 1._wp / 22.4144_wp 48 49 REAL(wp) :: bor1 = 0.00023_wp ! borat constants 50 REAL(wp) :: bor2 = 1._wp / 10.82_wp 51 52 REAL(wp) :: ca0 = -162.8301_wp 53 REAL(wp) :: ca1 = 218.2968_wp 54 REAL(wp) :: ca2 = 90.9241_wp 55 REAL(wp) :: ca3 = -1.47696_wp 56 REAL(wp) :: ca4 = 0.025695_wp 57 REAL(wp) :: ca5 = -0.025225_wp 58 REAL(wp) :: ca6 = 0.0049867_wp 59 60 REAL(wp) :: c10 = -3670.7_wp ! coeff. for 1. dissoc. of carbonic acid (Edmond and Gieskes, 1970) 61 REAL(wp) :: c11 = 62.008_wp 62 REAL(wp) :: c12 = -9.7944_wp 63 REAL(wp) :: c13 = 0.0118_wp 64 REAL(wp) :: c14 = -0.000116_wp 65 66 REAL(wp) :: & ! coeff. for 2. dissoc. of carbonic acid (Millero, 1995) 67 c20 = -1394.7 , & 68 c21 = -4.777 , & 69 c22 = 0.0184 , & 70 c23 = -0.000118 71 72 REAL(wp) :: & ! constants for calculate concentrations 73 st1 = 0.14 , & ! for sulfate (Morris & Riley 1966) 74 st2 = 1./96.062, & 75 ks0 = 141.328 , & 76 ks1 = -4276.1 , & 77 ks2 = -23.093 , & 78 ks3 = -13856. , & 79 ks4 = 324.57 , & 80 ks5 = -47.986 , & 81 ks6 = 35474. , & 82 ks7 = -771.54 , & 83 ks8 = 114.723 , & 84 ks9 = -2698. , & 85 ks10 = 1776. , & 86 ks11 = 1. , & 87 ks12 = -0.001005 88 89 REAL(wp) :: & ! constants for calculate concentrations 90 ft1 = 0.000067 , & ! fluorides (Dickson & Riley 1979 ) 91 ft2 = 1./18.9984 , & 92 kf0 = -12.641 , & 93 kf1 = 1590.2 , & 94 kf2 = 1.525 , & 95 kf3 = 1.0 , & 96 kf4 =-0.001005 97 98 REAL(wp) :: & ! coeff. for 1. dissoc. of boric acid (Dickson and Goyet, 1994) 99 cb0 = -8966.90, & 100 cb1 = -2890.53, & 101 cb2 = -77.942 , & 102 cb3 = 1.728 , & 103 cb4 = -0.0996 , & 104 cb5 = 148.0248, & 105 cb6 = 137.1942, & 106 cb7 = 1.62142 , & 107 cb8 = -24.4344, & 108 cb9 = -25.085 , & 109 cb10 = -0.2474 , & 110 cb11 = 0.053105 111 112 REAL(wp) :: & ! coeff. for dissoc. of water (Dickson and Riley, 1979 ) 113 cw0 = -13847.26 , & 114 cw1 = 148.9652 , & 115 cw2 = -23.6521 , & 116 cw3 = 118.67 , & 117 cw4 = -5.977 , & 118 cw5 = 1.0495 , & 119 cw6 = -0.01615 120 121 REAL(wp) :: & ! volumetric solubility constants for o2 in ml/l (Weiss, 1974) 122 ox0 = -58.3877 , & 123 ox1 = 85.8079 , & 124 ox2 = 23.8439 , & 125 ox3 = -0.034892 , & 126 ox4 = 0.015568 , & 127 ox5 = -0.0019387 128 129 REAL(wp), DIMENSION(5) :: & ! coeff. for seawater pressure correction 130 devk1, devk2, devk3, & ! (millero 95) 131 devk4, devk5 132 35 REAL(wp), PUBLIC :: atcox = 0.20946 ! units atm 36 37 REAL(wp) :: salchl = 1. / 1.80655 ! conversion factor for salinity --> chlorinity (Wooster et al. 1969) 38 REAL(wp) :: o2atm = 1. / ( 1000. * 0.20946 ) 39 40 REAL(wp) :: akcc1 = -171.9065 ! coeff. for apparent solubility equilibrium 41 REAL(wp) :: akcc2 = -0.077993 ! Millero et al. 1995 from Mucci 1983 42 REAL(wp) :: akcc3 = 2839.319 43 REAL(wp) :: akcc4 = 71.595 44 REAL(wp) :: akcc5 = -0.77712 45 REAL(wp) :: akcc6 = 0.00284263 46 REAL(wp) :: akcc7 = 178.34 47 REAL(wp) :: akcc8 = -0.07711 48 REAL(wp) :: akcc9 = 0.0041249 49 50 REAL(wp) :: rgas = 83.143 ! universal gas constants 51 REAL(wp) :: oxyco = 1. / 22.4144 ! converts from liters of an ideal gas to moles 52 53 REAL(wp) :: bor1 = 0.00023 ! borat constants 54 REAL(wp) :: bor2 = 1. / 10.82 55 56 REAL(wp) :: ca0 = -162.8301 ! WEISS & PRICE 1980, units mol/(kg atm) 57 REAL(wp) :: ca1 = 218.2968 58 REAL(wp) :: ca2 = 90.9241 59 REAL(wp) :: ca3 = -1.47696 60 REAL(wp) :: ca4 = 0.025695 61 REAL(wp) :: ca5 = -0.025225 62 REAL(wp) :: ca6 = 0.0049867 63 64 REAL(wp) :: c10 = -3670.7 ! Coeff. for 1. dissoc. of carbonic acid (Edmond and Gieskes, 1970) 65 REAL(wp) :: c11 = 62.008 66 REAL(wp) :: c12 = -9.7944 67 REAL(wp) :: c13 = 0.0118 68 REAL(wp) :: c14 = -0.000116 69 70 REAL(wp) :: c20 = -1394.7 ! coeff. for 2. dissoc. of carbonic acid (Millero, 1995) 71 REAL(wp) :: c21 = -4.777 72 REAL(wp) :: c22 = 0.0184 73 REAL(wp) :: c23 = -0.000118 74 75 REAL(wp) :: st1 = 0.14 ! constants for calculate concentrations for sulfate 76 REAL(wp) :: st2 = 1./96.062 ! (Morris & Riley 1966) 77 REAL(wp) :: ks0 = 141.328 78 REAL(wp) :: ks1 = -4276.1 79 REAL(wp) :: ks2 = -23.093 80 REAL(wp) :: ks3 = -13856. 81 REAL(wp) :: ks4 = 324.57 82 REAL(wp) :: ks5 = -47.986 83 REAL(wp) :: ks6 = 35474. 84 REAL(wp) :: ks7 = -771.54 85 REAL(wp) :: ks8 = 114.723 86 REAL(wp) :: ks9 = -2698. 87 REAL(wp) :: ks10 = 1776. 88 REAL(wp) :: ks11 = 1. 89 REAL(wp) :: ks12 = -0.001005 90 91 REAL(wp) :: ft1 = 0.000067 ! constants for calculate concentrations for fluorides 92 REAL(wp) :: ft2 = 1./18.9984 ! (Dickson & Riley 1979 ) 93 REAL(wp) :: kf0 = -12.641 94 REAL(wp) :: kf1 = 1590.2 95 REAL(wp) :: kf2 = 1.525 96 REAL(wp) :: kf3 = 1.0 97 REAL(wp) :: kf4 = -0.001005 98 99 REAL(wp) :: cb0 = -8966.90 ! Coeff. for 1. dissoc. of boric acid 100 REAL(wp) :: cb1 = -2890.53 ! (Dickson and Goyet, 1994) 101 REAL(wp) :: cb2 = -77.942 102 REAL(wp) :: cb3 = 1.728 103 REAL(wp) :: cb4 = -0.0996 104 REAL(wp) :: cb5 = 148.0248 105 REAL(wp) :: cb6 = 137.1942 106 REAL(wp) :: cb7 = 1.62142 107 REAL(wp) :: cb8 = -24.4344 108 REAL(wp) :: cb9 = -25.085 109 REAL(wp) :: cb10 = -0.2474 110 REAL(wp) :: cb11 = 0.053105 111 112 REAL(wp) :: cw0 = -13847.26 ! Coeff. for dissoc. of water (Dickson and Riley, 1979 ) 113 REAL(wp) :: cw1 = 148.9652 114 REAL(wp) :: cw2 = -23.6521 115 REAL(wp) :: cw3 = 118.67 116 REAL(wp) :: cw4 = -5.977 117 REAL(wp) :: cw5 = 1.0495 118 REAL(wp) :: cw6 = -0.01615 119 120 ! ! volumetric solubility constants for o2 in ml/L 121 REAL(wp) :: ox0 = 2.00856 ! from Table 1 for Eq 8 of Garcia and Gordon, 1992. 122 REAL(wp) :: ox1 = 3.22400 ! corrects for moisture and fugacity, but not total atmospheric pressure 123 REAL(wp) :: ox2 = 3.99063 ! Original PISCES code noted this was a solubility, but 124 REAL(wp) :: ox3 = 4.80299 ! was in fact a bunsen coefficient with units L-O2/(Lsw atm-O2) 125 REAL(wp) :: ox4 = 9.78188e-1 ! Hence, need to divide EXP( zoxy ) by 1000, ml-O2 => L-O2 126 REAL(wp) :: ox5 = 1.71069 ! and atcox = 0.20946 to add the 1/atm dimension. 127 REAL(wp) :: ox6 = -6.24097e-3 128 REAL(wp) :: ox7 = -6.93498e-3 129 REAL(wp) :: ox8 = -6.90358e-3 130 REAL(wp) :: ox9 = -4.29155e-3 131 REAL(wp) :: ox10 = -3.11680e-7 132 133 REAL(wp), DIMENSION(5) :: devk1, devk2, devk3, devk4, devk5 ! coeff. for seawater pressure correction 134 ! ! (millero 95) 133 135 DATA devk1 / -25.5 , -15.82 , -29.48 , -25.60 , -48.76 / 134 136 DATA devk2 / 0.1271 , -0.0219 , 0.1622 , 0.2324 , 0.5304 / … … 155 157 !!--------------------------------------------------------------------- 156 158 INTEGER :: ji, jj, jk 157 REAL(wp) :: ztkel, zsal , zqtt , zbuf1 , zbuf2 159 REAL(wp) :: ztkel, zt , zt2 , zsal , zsal2 , zbuf1 , zbuf2 160 REAL(wp) :: ztgg , ztgg2, ztgg3 , ztgg4 , ztgg5 158 161 REAL(wp) :: zpres, ztc , zcl , zcpexp, zoxy , zcpexp2 159 162 REAL(wp) :: zsqrt, ztr , zlogt , zcek1 160 REAL(wp) :: z lqtt, zqtt2, zsal15, zis , zis2, zisqrt163 REAL(wp) :: zis , zis2 , zsal15, zisqrt 161 164 REAL(wp) :: zckb , zck1 , zck2 , zckw , zak1 , zak2 , zakb , zaksp0, zakw 162 165 REAL(wp) :: zst , zft , zcks , zckf , zaksp1 163 166 !!--------------------------------------------------------------------- 164 167 ! 168 IF( nn_timing == 1 ) CALL timing_start('p4z_che') 169 ! 165 170 ! CHEMICAL CONSTANTS - SURFACE LAYER 166 171 ! ---------------------------------- … … 171 176 ! ! SET ABSOLUTE TEMPERATURE 172 177 ztkel = tsn(ji,jj,1,jp_tem) + 273.16 173 z qtt= ztkel * 0.01174 z qtt2 = zqtt * zqtt175 zsal = tsn(ji,jj,1,jp_sal) + ( 1.- tmask(ji,jj,1) ) * 35.176 z lqtt = LOG( zqtt )177 178 zt = ztkel * 0.01 179 zt2 = zt * zt 180 zsal = tsn(ji,jj,1,jp_sal) + ( 1.- tmask(ji,jj,1) ) * 35. 181 zsal2 = zsal * zsal 182 zlogt = LOG( zt ) 178 183 ! ! LN(K0) OF SOLUBILITY OF CO2 (EQ. 12, WEISS, 1980) 179 184 ! ! AND FOR THE ATMOSPHERE FOR NON IDEAL GAS 180 zcek1 = ca0 + ca1 / zqtt + ca2 * zlqtt + ca3 * zqtt2 + zsal*( ca4 + ca5 * zqtt + ca6 * zqtt2 ) 181 182 ! ! LN(K0) OF SOLUBILITY OF O2 and N2 (EQ. 4, WEISS, 1970) 183 zoxy = ox0 + ox1 / zqtt + ox2 * zlqtt + zsal * ( ox3 + ox4 * zqtt + ox5 * zqtt2 ) 184 185 ! ! SET SOLUBILITIES OF O2 AND CO2 186 chemc(ji,jj,1) = EXP( zcek1 ) * 1.e-6 * rhop(ji,jj,1) / 1000. 187 chemc(ji,jj,2) = EXP( zoxy ) * oxyco 188 185 zcek1 = ca0 + ca1 / zt + ca2 * zlogt + ca3 * zt2 + zsal * ( ca4 + ca5 * zt + ca6 * zt2 ) 186 ! ! LN(K0) OF SOLUBILITY OF O2 and N2 in ml/L (EQ. 8, GARCIA AND GORDON, 1992) 187 ztgg = LOG( ( 298.15 - tsn(ji,jj,1,jp_tem) ) / ztkel ) ! Set the GORDON & GARCIA scaled temperature 188 ztgg2 = ztgg * ztgg 189 ztgg3 = ztgg2 * ztgg 190 ztgg4 = ztgg3 * ztgg 191 ztgg5 = ztgg4 * ztgg 192 zoxy = ox0 + ox1 * ztgg + ox2 * ztgg2 + ox3 * ztgg3 + ox4 * ztgg4 + ox5 * ztgg5 & 193 + zsal * ( ox6 + ox7 * ztgg + ox8 * ztgg2 + ox9 * ztgg3 ) + ox10 * zsal2 194 195 ! ! SET SOLUBILITIES OF O2 AND CO2 196 chemc(ji,jj,1) = EXP( zcek1 ) * 1.e-6 * rhop(ji,jj,1) / 1000. ! mol/(L uatm) 197 chemc(ji,jj,2) = ( EXP( zoxy ) * o2atm ) * oxyco ! mol/(L atm) 198 ! 189 199 END DO 190 200 END DO … … 204 214 ! SET ABSOLUTE TEMPERATURE 205 215 ztkel = tsn(ji,jj,jk,jp_tem) + 273.16 206 zqtt = ztkel * 0.01207 216 zsal = tsn(ji,jj,jk,jp_sal) + ( 1.-tmask(ji,jj,jk) ) * 35. 208 217 zsqrt = SQRT( zsal ) … … 311 320 END DO 312 321 ! 322 IF( nn_timing == 1 ) CALL timing_stop('p4z_che') 323 ! 313 324 END SUBROUTINE p4z_che 314 325 -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zflx.F90
r2715 r3294 9 9 !! 1.0 ! 2004 (O. Aumont) modifications 10 10 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) F90 11 !! ! 2011-02 (J. Simeon, J. Orr) Include total atm P correction 11 12 !!---------------------------------------------------------------------- 12 13 #if defined key_pisces … … 16 17 !! p4z_flx : CALCULATES GAS EXCHANGE AND CHEMISTRY AT SEA SURFACE 17 18 !! p4z_flx_init : Read the namelist 18 !!---------------------------------------------------------------------- 19 USE trc 20 USE oce_trc ! 21 USE trc 22 USE sms_pisces 23 USE prtctl_trc 24 USE p4zche 25 USE iom 19 !! p4z_patm : Read sfc atm pressure [atm] for each grid cell 20 !!---------------------------------------------------------------------- 21 USE oce_trc ! shared variables between ocean and passive tracers 22 USE trc ! passive tracers common variables 23 USE sms_pisces ! PISCES Source Minus Sink variables 24 USE p4zche ! Chemical model 25 USE prtctl_trc ! print control for debugging 26 USE iom ! I/O manager 27 USE fldread ! read input fields 26 28 #if defined key_cpl_carbon_cycle 27 USE sbc_oce , ONLY : atm_co229 USE sbc_oce, ONLY : atm_co2 ! atmospheric pCO2 28 30 #endif 29 31 … … 35 37 PUBLIC p4z_flx_alloc 36 38 39 ! !!** Namelist nampisext ** 40 REAL(wp) :: atcco2 = 278._wp !: pre-industrial atmospheric [co2] (ppm) 41 LOGICAL :: ln_co2int = .FALSE. !: flag to read in a file and interpolate atmospheric pco2 or not 42 CHARACTER(len=34) :: clname = 'atcco2.txt' !: filename of pco2 values 43 INTEGER :: nn_offset = 0 !: Offset model-data start year (default = 0) 44 45 !! Variables related to reading atmospheric CO2 time history 46 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: atcco2h, years 47 INTEGER :: nmaxrec, numco2 48 49 ! !!* nampisatm namelist (Atmospheric PRessure) * 50 LOGICAL, PUBLIC :: ln_presatm = .true. !: ref. pressure: global mean Patm (F) or a constant (F) 51 52 REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) :: patm ! atmospheric pressure at kt [N/m2] 53 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_patm ! structure of input fields (file informations, fields read) 54 55 37 56 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: oce_co2 !: ocean carbon flux 38 57 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: satmco2 !: atmospheric pco2 … … 41 60 REAL(wp) :: t_atm_co2_flx !: global mean of atmospheric pco2 42 61 REAL(wp) :: area !: ocean surface 43 REAL(wp) :: atcco2 = 278._wp !: pre-industrial atmospheric [co2] (ppm)44 REAL(wp) :: atcox = 0.20946_wp !:45 62 REAL(wp) :: xconv = 0.01_wp / 3600._wp !: coefficients for conversion 46 63 … … 60 77 !! ** Purpose : CALCULATES GAS EXCHANGE AND CHEMISTRY AT SEA SURFACE 61 78 !! 62 !! ** Method : - ??? 79 !! ** Method : 80 !! - Include total atm P correction via Esbensen & Kushnir (1981) 81 !! - Pressure correction NOT done for key_cpl_carbon_cycle 82 !! - Remove Wanninkhof chemical enhancement; 83 !! - Add option for time-interpolation of atcco2.txt 63 84 !!--------------------------------------------------------------------- 64 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released65 USE wrk_nemo, ONLY: zkgco2 => wrk_2d_1 , zkgo2 => wrk_2d_2 , zh2co3 => wrk_2d_366 USE wrk_nemo, ONLY: zoflx => wrk_2d_4 , zkg => wrk_2d_567 USE wrk_nemo, ONLY: zdpco2 => wrk_2d_6 , zdpo2 => wrk_2d_768 85 ! 69 86 INTEGER, INTENT(in) :: kt ! 70 87 ! 71 INTEGER :: ji, jj, j rorr88 INTEGER :: ji, jj, jm, iind, iindm1 72 89 REAL(wp) :: ztc, ztc2, ztc3, zws, zkgwan 73 90 REAL(wp) :: zfld, zflu, zfld16, zflu16, zfact 74 91 REAL(wp) :: zph, zah2, zbot, zdic, zalk, zsch_o2, zalka, zsch_co2 92 REAL(wp) :: zyr_dec, zdco2dt 75 93 CHARACTER (len=25) :: charout 94 REAL(wp), POINTER, DIMENSION(:,:) :: zkgco2, zkgo2, zh2co3, zoflx 76 95 !!--------------------------------------------------------------------- 77 78 IF( wrk_in_use(2, 1,2,3,4,5,6,7) ) THEN 79 CALL ctl_stop('p4z_flx: requested workspace arrays unavailable') ; RETURN 80 ENDIF 96 ! 97 IF( nn_timing == 1 ) CALL timing_start('p4z_flx') 98 ! 99 CALL wrk_alloc( jpi, jpj, zkgco2, zkgo2, zh2co3, zoflx ) 100 ! 81 101 82 102 ! SURFACE CHEMISTRY (PCO2 AND [H+] IN … … 84 104 ! IS USED TO COMPUTE AIR-SEA FLUX OF CO2 85 105 106 IF( kt /= nit000 ) CALL p4z_patm( kt ) ! Get sea-level pressure (E&K [1981] climatology) for use in flux calcs 107 108 IF( ln_co2int ) THEN 109 ! Linear temporal interpolation of atmospheric pco2. atcco2.txt has annual values. 110 ! Caveats: First column of .txt must be in years, decimal years preferably. 111 ! For nn_offset, if your model year is iyy, nn_offset=(years(1)-iyy) 112 ! then the first atmospheric CO2 record read is at years(1) 113 zyr_dec = REAL( nyear + nn_offset, wp ) + REAL( nday_year, wp ) / REAL( nyear_len(1), wp ) 114 jm = 2 115 DO WHILE( jm <= nmaxrec .AND. years(jm-1) < zyr_dec .AND. years(jm) >= zyr_dec ) ; jm = jm + 1 ; END DO 116 iind = jm ; iindm1 = jm - 1 117 zdco2dt = ( atcco2h(iind) - atcco2h(iindm1) ) / ( years(iind) - years(iindm1) + rtrn ) 118 atcco2 = zdco2dt * ( zyr_dec - years(iindm1) ) + atcco2h(iindm1) 119 satmco2(:,:) = atcco2 120 ENDIF 121 86 122 #if defined key_cpl_carbon_cycle 87 123 satmco2(:,:) = atm_co2(:,:) 88 124 #endif 89 125 90 DO jrorr = 1, 10 91 126 DO jm = 1, 10 92 127 !CDIR NOVERRCHK 93 128 DO jj = 1, jpj … … 137 172 ! Compute the piston velocity for O2 and CO2 138 173 zkgwan = 0.3 * zws + 2.5 * ( 0.5246 + 0.016256 * ztc + 0.00049946 * ztc2 ) 174 zkgwan = zkgwan * xconv * ( 1.- fr_i(ji,jj) ) * tmask(ji,jj,1) 139 175 # if defined key_degrad 140 zkgwan = zkgwan * xconv * ( 1.- fr_i(ji,jj) ) * tmask(ji,jj,1) * facvol(ji,jj,1) 141 #else 142 zkgwan = zkgwan * xconv * ( 1.- fr_i(ji,jj) ) * tmask(ji,jj,1) 176 zkgwan = zkgwan * facvol(ji,jj,1) 143 177 #endif 144 178 ! compute gas exchange for CO2 and O2 … … 151 185 DO ji = 1, jpi 152 186 ! Compute CO2 flux for the sea and air 153 zfld = satmco2(ji,jj) * tmask(ji,jj,1) * chemc(ji,jj,1) * zkgco2(ji,jj)154 zflu = zh2co3(ji,jj) * tmask(ji,jj,1) * zkgco2(ji,jj) 187 zfld = satmco2(ji,jj) * patm(ji,jj) * tmask(ji,jj,1) * chemc(ji,jj,1) * zkgco2(ji,jj) ! (mol/L) * (m/s) 188 zflu = zh2co3(ji,jj) * tmask(ji,jj,1) * zkgco2(ji,jj) ! (mol/L) (m/s) ? 155 189 oce_co2(ji,jj) = ( zfld - zflu ) * rfact * e1e2t(ji,jj) * tmask(ji,jj,1) * 1000. 156 190 ! compute the trend … … 158 192 159 193 ! Compute O2 flux 160 zfld16 = atcox * chemc(ji,jj,2) * tmask(ji,jj,1) * zkgo2(ji,jj)194 zfld16 = atcox * patm(ji,jj) * chemc(ji,jj,2) * tmask(ji,jj,1) * zkgo2(ji,jj) ! (mol/L) * (m/s) 161 195 zflu16 = trn(ji,jj,1,jpoxy) * tmask(ji,jj,1) * zkgo2(ji,jj) 162 tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + ( zfld16 - zflu16 ) / fse3t(ji,jj,1) 163 164 #if defined key_diatrc 165 ! Save diagnostics 166 # if ! defined key_iomput 167 zfact = 1. / e1e2t(ji,jj) / rfact 168 trc2d(ji,jj,jp_pcs0_2d ) = oce_co2(ji,jj) * zfact 169 trc2d(ji,jj,jp_pcs0_2d + 1) = ( zfld16 - zflu16 ) * 1000. * tmask(ji,jj,1) 170 trc2d(ji,jj,jp_pcs0_2d + 2) = zkgco2(ji,jj) * tmask(ji,jj,1) 171 trc2d(ji,jj,jp_pcs0_2d + 3) = ( satmco2(ji,jj) - zh2co3(ji,jj) / ( chemc(ji,jj,1) + rtrn ) ) & 172 & * tmask(ji,jj,1) 173 # else 174 zoflx(ji,jj) = ( zfld16 - zflu16 ) * 1000. * tmask(ji,jj,1) 175 zkg (ji,jj) = zkgco2(ji,jj) * tmask(ji,jj,1) 176 zdpco2(ji,jj) = ( satmco2(ji,jj) - zh2co3(ji,jj) / ( chemc(ji,jj,1) + rtrn ) ) * tmask(ji,jj,1) 177 zdpo2 (ji,jj) = ( atcox - trn(ji,jj,1,jpoxy) / ( chemc(ji,jj,2) + rtrn ) ) * tmask(ji,jj,1) 178 # endif 179 #endif 196 zoflx(ji,jj) = zfld16 - zflu16 197 tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + zoflx(ji,jj) / fse3t(ji,jj,1) 180 198 END DO 181 199 END DO 182 200 183 t_oce_co2_flx = t_oce_co2_flx + glob_sum( oce_co2(:,:) ) 201 t_oce_co2_flx = t_oce_co2_flx + glob_sum( oce_co2(:,:) ) ! Cumulative Total Flux of Carbon 184 202 IF( kt == nitend ) THEN 185 t_atm_co2_flx = glob_sum( satmco2(:,:) * e1e2t(:,:) ) ! Total atmospheric pCO2186 ! 187 t_oce_co2_flx = (-1.) * t_oce_co2_flx * 12. / 1.e15 188 t_atm_co2_flx = t_atm_co2_flx / area 203 t_atm_co2_flx = glob_sum( satmco2(:,:) * patm(:,:) * e1e2t(:,:) ) ! Total atmospheric pCO2 204 ! 205 t_oce_co2_flx = (-1.) * t_oce_co2_flx * 12. / 1.e15 ! Conversion in PgC ; negative for out of the ocean 206 t_atm_co2_flx = t_atm_co2_flx / area ! global mean of atmospheric pCO2 189 207 ! 190 208 IF( lwp) THEN … … 205 223 ENDIF 206 224 207 # if defined key_diatrc && defined key_iomput 208 CALL iom_put( "Cflx" , oce_co2(:,:) / e1e2t(:,:) / rfact ) 209 CALL iom_put( "Oflx" , zoflx ) 210 CALL iom_put( "Kg" , zkg ) 211 CALL iom_put( "Dpco2", zdpco2 ) 212 CALL iom_put( "Dpo2" , zdpo2 ) 213 #endif 214 ! 215 IF( wrk_not_released(2, 1,2,3,4,5,6,7) ) CALL ctl_stop('p4z_flx: failed to release workspace arrays') 225 IF( ln_diatrc ) THEN 226 IF( lk_iomput ) THEN 227 CALL iom_put( "Cflx" , oce_co2(:,:) / e1e2t(:,:) / rfact ) 228 CALL iom_put( "Oflx" , zoflx(:,:) * 1000 * tmask(:,:,1) ) 229 CALL iom_put( "Kg" , zkgco2(:,:) * tmask(:,:,1) ) 230 CALL iom_put( "Dpco2", ( satmco2(:,:) * patm(:,:) - zh2co3(:,:) / ( chemc(:,:,1) + rtrn ) ) * tmask(:,:,1) ) 231 CALL iom_put( "Dpo2" , ( atcox * patm(:,:) - trn(:,:,1,jpoxy) / ( chemc(:,:,2) + rtrn ) ) * tmask(:,:,1) ) 232 ELSE 233 trc2d(:,:,jp_pcs0_2d ) = oce_co2(:,:) / e1e2t(:,:) / rfact 234 trc2d(:,:,jp_pcs0_2d + 1) = zoflx(:,:) * 1000 * tmask(:,:,1) 235 trc2d(:,:,jp_pcs0_2d + 2) = zkgco2(:,:) * tmask(:,:,1) 236 trc2d(:,:,jp_pcs0_2d + 3) = ( satmco2(:,:) * patm(:,:) - zh2co3(:,:) / ( chemc(:,:,1) + rtrn ) ) * tmask(:,:,1) 237 ENDIF 238 ENDIF 239 ! 240 CALL wrk_dealloc( jpi, jpj, zkgco2, zkgo2, zh2co3, zoflx ) 241 ! 242 IF( nn_timing == 1 ) CALL timing_stop('p4z_flx') 216 243 ! 217 244 END SUBROUTINE p4z_flx … … 225 252 !! 226 253 !! ** Method : Read the nampisext namelist and check the parameters 227 !! called at the first timestep (nit 000)254 !! called at the first timestep (nittrc000) 228 255 !! ** input : Namelist nampisext 229 256 !!---------------------------------------------------------------------- 230 NAMELIST/nampisext/ atcco2 231 !!---------------------------------------------------------------------- 232 ! 233 REWIND( numnat ) ! read numnat 234 READ ( numnat, nampisext ) 257 NAMELIST/nampisext/ln_co2int, atcco2, clname, nn_offset 258 INTEGER :: jm 259 !!---------------------------------------------------------------------- 260 ! 261 REWIND( numnatp ) ! read numnatp 262 READ ( numnatp, nampisext ) 235 263 ! 236 264 IF(lwp) THEN ! control print … … 238 266 WRITE(numout,*) ' Namelist parameters for air-sea exchange, nampisext' 239 267 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 240 WRITE(numout,*) ' Atmospheric pCO2 atcco2 =', atcco2 268 WRITE(numout,*) ' Choice for reading in the atm pCO2 file or constant value, ln_co2int =', ln_co2int 269 WRITE(numout,*) ' ' 270 ENDIF 271 IF( .NOT.ln_co2int ) THEN 272 IF(lwp) THEN ! control print 273 WRITE(numout,*) ' Constant Atmospheric pCO2 value atcco2 =', atcco2 274 WRITE(numout,*) ' ' 275 ENDIF 276 satmco2(:,:) = atcco2 ! Initialisation of atmospheric pco2 277 ELSE 278 IF(lwp) THEN 279 WRITE(numout,*) ' Atmospheric pCO2 value from file clname =', TRIM( clname ) 280 WRITE(numout,*) ' Offset model-data start year nn_offset =', nn_offset 281 WRITE(numout,*) ' ' 282 ENDIF 283 CALL ctl_opn( numco2, TRIM( clname) , 'OLD', 'FORMATTED', 'SEQUENTIAL', -1 , numout, lwp ) 284 jm = 0 ! Count the number of record in co2 file 285 DO 286 READ(numco2,*,END=100) 287 jm = jm + 1 288 END DO 289 100 nmaxrec = jm - 1 290 ALLOCATE( years (nmaxrec) ) ; years (:) = 0._wp 291 ALLOCATE( atcco2h(nmaxrec) ) ; atcco2h(:) = 0._wp 292 293 REWIND(numco2) 294 DO jm = 1, nmaxrec ! get xCO2 data 295 READ(numco2, *) years(jm), atcco2h(jm) 296 IF(lwp) WRITE(numout, '(f6.0,f7.2)') years(jm), atcco2h(jm) 297 END DO 298 CLOSE(numco2) 241 299 ENDIF 242 300 ! … … 245 303 oce_co2(:,:) = 0._wp ! Initialization of Flux of Carbon 246 304 t_atm_co2_flx = 0._wp 247 !248 satmco2(:,:) = atcco2 ! Initialisation of atmospheric pco2249 305 t_oce_co2_flx = 0._wp 250 306 ! 307 CALL p4z_patm( nit000 ) 308 ! 251 309 END SUBROUTINE p4z_flx_init 252 310 311 SUBROUTINE p4z_patm( kt ) 312 313 !!---------------------------------------------------------------------- 314 !! *** ROUTINE p4z_atm *** 315 !! 316 !! ** Purpose : Read and interpolate the external atmospheric sea-levl pressure 317 !! ** Method : Read the files and interpolate the appropriate variables 318 !! 319 !!---------------------------------------------------------------------- 320 !! * arguments 321 INTEGER, INTENT( in ) :: kt ! ocean time step 322 ! 323 INTEGER :: ierr 324 CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files 325 TYPE(FLD_N) :: sn_patm ! informations about the fields to be read 326 !! 327 NAMELIST/nampisatm/ ln_presatm, sn_patm, cn_dir 328 329 ! ! -------------------- ! 330 IF( kt == nit000 ) THEN ! First call kt=nittrc000 ! 331 ! ! -------------------- ! 332 ! !* set file information (default values) 333 ! ... default values (NB: frequency positive => hours, negative => months) 334 ! ! file ! frequency ! variable ! time intep ! clim ! 'yearly' or ! weights ! rotation ! 335 ! ! name ! (hours) ! name ! (T/F) ! (T/F) ! 'monthly' ! filename ! pairs ! 336 sn_patm = FLD_N( 'pres' , 24 , 'patm' , .false. , .true. , 'yearly' , '' , '' ) 337 cn_dir = './' ! directory in which the Patm data are 338 339 REWIND( numnatp ) !* read in namlist nampisatm 340 READ ( numnatp, nampisatm ) 341 ! 342 ! 343 IF(lwp) THEN !* control print 344 WRITE(numout,*) 345 WRITE(numout,*) ' Namelist nampisatm : Atmospheric Pressure as external forcing' 346 WRITE(numout,*) ' constant atmopsheric pressure (F) or from a file (T) ln_presatm = ', ln_presatm 347 WRITE(numout,*) 348 ENDIF 349 ! 350 IF( ln_presatm ) THEN 351 ALLOCATE( sf_patm(1), STAT=ierr ) !* allocate and fill sf_patm (forcing structure) with sn_patm 352 IF( ierr > 0 ) CALL ctl_stop( 'STOP', 'p4z_flx: unable to allocate sf_patm structure' ) 353 ! 354 CALL fld_fill( sf_patm, (/ sn_patm /), cn_dir, 'p4z_flx', 'Atmospheric pressure ', 'nampisatm' ) 355 ALLOCATE( sf_patm(1)%fnow(jpi,jpj,1) ) 356 IF( sn_patm%ln_tint ) ALLOCATE( sf_patm(1)%fdta(jpi,jpj,1,2) ) 357 ENDIF 358 ! 359 IF( .NOT.ln_presatm ) patm(:,:) = 1.e0 ! Initialize patm if no reading from a file 360 ! 361 ENDIF 362 ! 363 IF( ln_presatm ) THEN 364 CALL fld_read( kt, 1, sf_patm ) !* input Patm provided at kt + 1/2 365 patm(:,:) = sf_patm(1)%fnow(:,:,1) ! atmospheric pressure 366 ENDIF 367 ! 368 END SUBROUTINE p4z_patm 253 369 254 370 INTEGER FUNCTION p4z_flx_alloc() … … 256 372 !! *** ROUTINE p4z_flx_alloc *** 257 373 !!---------------------------------------------------------------------- 258 ALLOCATE( oce_co2(jpi,jpj), satmco2(jpi,jpj), STAT=p4z_flx_alloc )374 ALLOCATE( oce_co2(jpi,jpj), satmco2(jpi,jpj), patm(jpi,jpj), STAT=p4z_flx_alloc ) 259 375 ! 260 376 IF( p4z_flx_alloc /= 0 ) CALL ctl_warn('p4z_flx_alloc : failed to allocate arrays') -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zint.F90
r2715 r3294 13 13 !! p4z_int : interpolation and computation of various accessory fields 14 14 !!---------------------------------------------------------------------- 15 USE oce_trc ! 16 USE trc 17 USE sms_pisces 15 USE oce_trc ! shared variables between ocean and passive tracers 16 USE trc ! passive tracers common variables 17 USE sms_pisces ! PISCES Source Minus Sink variables 18 18 19 19 IMPLICIT NONE … … 21 21 22 22 PUBLIC p4z_int 23 PUBLIC p4z_int_alloc24 25 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tgfunc !: Temp. dependancy of various biological rates26 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tgfunc2 !: Temp. dependancy of mesozooplankton rates27 28 23 REAL(wp) :: xksilim = 16.5e-6_wp ! Half-saturation constant for the Si half-saturation constant computation 29 24 … … 41 36 !! ** Purpose : interpolation and computation of various accessory fields 42 37 !! 43 !! ** Method : - ???44 38 !!--------------------------------------------------------------------- 45 INTEGER :: ji, jj 46 REAL(wp) :: z dum39 INTEGER :: ji, jj ! dummy loop indices 40 REAL(wp) :: zvar ! local variable 47 41 !!--------------------------------------------------------------------- 48 42 ! 43 IF( nn_timing == 1 ) CALL timing_start('p4z_int') 44 ! 49 45 ! Computation of phyto and zoo metabolic rate 50 46 ! ------------------------------------------- … … 57 53 DO ji = 1, jpi 58 54 DO jj = 1, jpj 59 z dum= trn(ji,jj,1,jpsil) * trn(ji,jj,1,jpsil)60 xksimax(ji,jj) = MAX( xksimax(ji,jj), ( 1.+ 7.* z dum / ( xksilim * xksilim + zdum) ) * 1e-6 )55 zvar = trn(ji,jj,1,jpsil) * trn(ji,jj,1,jpsil) 56 xksimax(ji,jj) = MAX( xksimax(ji,jj), ( 1.+ 7.* zvar / ( xksilim * xksilim + zvar ) ) * 1e-6 ) 61 57 END DO 62 58 END DO … … 67 63 ENDIF 68 64 ! 65 IF( nn_timing == 1 ) CALL timing_stop('p4z_int') 66 ! 69 67 END SUBROUTINE p4z_int 70 71 72 INTEGER FUNCTION p4z_int_alloc()73 !!----------------------------------------------------------------------74 !! *** ROUTINE p4z_int_alloc ***75 !!----------------------------------------------------------------------76 ALLOCATE( tgfunc(jpi,jpj,jpk), tgfunc2(jpi,jpj,jpk), STAT=p4z_int_alloc )77 !78 IF( p4z_int_alloc /= 0 ) CALL ctl_warn('p4z_int_alloc : failed to allocate arrays.')79 !80 END FUNCTION p4z_int_alloc81 68 82 69 #else -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zlim.F90
r2528 r3294 6 6 !! History : 1.0 ! 2004 (O. Aumont) Original code 7 7 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) F90 8 !! 3.4 ! 2011-04 (O. Aumont, C. Ethe) Limitation for iron modelled in quota 8 9 !!---------------------------------------------------------------------- 9 10 #if defined key_pisces … … 14 15 !! p4z_lim_init : Read the namelist 15 16 !!---------------------------------------------------------------------- 16 USE trc17 USE oce_trc !18 USE trc !19 USE sms_pisces !17 USE oce_trc ! Shared ocean-passive tracers variables 18 USE trc ! Tracers defined 19 USE sms_pisces ! PISCES variables 20 USE p4zopt ! Optical 20 21 21 22 IMPLICIT NONE … … 26 27 27 28 !! * Shared module variables 28 REAL(wp), PUBLIC :: & 29 conc0 = 2.e-6_wp , & !: 30 conc1 = 10.e-6_wp , & !: 31 conc2 = 2.e-11_wp , & !: 32 conc2m = 8.E-11_wp , & !: 33 conc3 = 1.e-10_wp , & !: 34 conc3m = 4.e-10_wp , & !: 35 concnnh4 = 1.e-7_wp , & !: 36 concdnh4 = 5.e-7_wp , & !: 37 xksi1 = 2.E-6_wp , & !: 38 xksi2 = 3.33E-6_wp , & !: 39 xkdoc = 417.E-6_wp , & !: 40 caco3r = 0.3_wp !: 41 42 29 REAL(wp), PUBLIC :: conc0 = 2.e-6_wp !: NO3, PO4 half saturation 30 REAL(wp), PUBLIC :: conc1 = 8.e-6_wp !: Phosphate half saturation for diatoms 31 REAL(wp), PUBLIC :: conc2 = 1.e-9_wp !: Iron half saturation for nanophyto 32 REAL(wp), PUBLIC :: conc2m = 3.e-9_wp !: Max iron half saturation for nanophyto 33 REAL(wp), PUBLIC :: conc3 = 2.e-9_wp !: Iron half saturation for diatoms 34 REAL(wp), PUBLIC :: conc3m = 8.e-9_wp !: Max iron half saturation for diatoms 35 REAL(wp), PUBLIC :: xsizedia = 5.e-7_wp !: Minimum size criteria for diatoms 36 REAL(wp), PUBLIC :: xsizephy = 1.e-6_wp !: Minimum size criteria for nanophyto 37 REAL(wp), PUBLIC :: concnnh4 = 1.e-7_wp !: NH4 half saturation for phyto 38 REAL(wp), PUBLIC :: concdnh4 = 4.e-7_wp !: NH4 half saturation for diatoms 39 REAL(wp), PUBLIC :: xksi1 = 2.E-6_wp !: half saturation constant for Si uptake 40 REAL(wp), PUBLIC :: xksi2 = 3.33e-6_wp !: half saturation constant for Si/C 41 REAL(wp), PUBLIC :: xkdoc = 417.e-6_wp !: 2nd half-sat. of DOC remineralization 42 REAL(wp), PUBLIC :: concfebac = 1.E-11_wp !: Fe half saturation for bacteria 43 REAL(wp), PUBLIC :: qnfelim = 7.E-6_wp !: optimal Fe quota for nanophyto 44 REAL(wp), PUBLIC :: qdfelim = 7.E-6_wp !: optimal Fe quota for diatoms 45 REAL(wp), PUBLIC :: caco3r = 0.16_wp !: mean rainratio 46 47 ! Coefficient for iron limitation 48 REAL(wp) :: xcoef1 = 0.0016 / 55.85 49 REAL(wp) :: xcoef2 = 1.21E-5 * 14. / 55.85 / 7.625 * 0.5 * 1.5 50 REAL(wp) :: xcoef3 = 1.15E-4 * 14. / 55.85 / 7.625 * 0.5 43 51 !!* Substitution 44 52 # include "top_substitute.h90" … … 60 68 !! ** Method : - ??? 61 69 !!--------------------------------------------------------------------- 70 ! 62 71 INTEGER, INTENT(in) :: kt 72 ! 63 73 INTEGER :: ji, jj, jk 64 74 REAL(wp) :: zlim1, zlim2, zlim3, zlim4, zno3, zferlim 65 REAL(wp) :: zconctemp, zconctemp2, zconctempn, zconctempn2 66 REAL(wp) :: ztemp, zdenom 75 REAL(wp) :: zconcd, zconcd2, zconcn, zconcn2 76 REAL(wp) :: z1_trndia, z1_trnphy, ztem1, ztem2, zetot1, zetot2 77 REAL(wp) :: zdenom, zratio, zironmin 78 REAL(wp) :: zconc1d, zconc1dnh4, zconc0n, zconc0nnh4 67 79 !!--------------------------------------------------------------------- 68 69 70 ! Tuning of the iron concentration to a minimum 71 ! level that is set to the detection limit 72 ! ------------------------------------- 73 80 ! 81 IF( nn_timing == 1 ) CALL timing_start('p4z_lim') 82 ! 74 83 DO jk = 1, jpkm1 75 84 DO jj = 1, jpj 76 85 DO ji = 1, jpi 77 zno3=trn(ji,jj,jk,jpno3) 78 zferlim = MAX( 1.5e-11*(zno3/40E-6)**2, 3e-12 ) 79 zferlim = MIN( zferlim, 1.5e-11 ) 86 87 ! Tuning of the iron concentration to a minimum level that is set to the detection limit 88 !------------------------------------- 89 zno3 = trn(ji,jj,jk,jpno3) / 40.e-6 90 zferlim = MAX( 2e-11 * zno3 * zno3, 5e-12 ) 91 zferlim = MIN( zferlim, 3e-11 ) 80 92 trn(ji,jj,jk,jpfer) = MAX( trn(ji,jj,jk,jpfer), zferlim ) 93 94 ! Computation of a variable Ks for iron on diatoms taking into account 95 ! that increasing biomass is made of generally bigger cells 96 !------------------------------------------------ 97 zconcd = MAX( 0.e0 , trn(ji,jj,jk,jpdia) - xsizedia ) 98 zconcd2 = trn(ji,jj,jk,jpdia) - zconcd 99 zconcn = MAX( 0.e0 , trn(ji,jj,jk,jpphy) - xsizephy ) 100 zconcn2 = trn(ji,jj,jk,jpphy) - zconcn 101 z1_trnphy = 1. / ( trn(ji,jj,jk,jpphy) + rtrn ) 102 z1_trndia = 1. / ( trn(ji,jj,jk,jpdia) + rtrn ) 103 104 concdfe(ji,jj,jk) = MAX( conc3 , ( zconcd2 * conc3 + conc3m * zconcd ) * z1_trndia ) 105 zconc1d = MAX( 2.* conc0 , ( zconcd2 * 2. * conc0 + conc1 * zconcd ) * z1_trndia ) 106 zconc1dnh4 = MAX( 2.* concnnh4, ( zconcd2 * 2. * concnnh4 + concdnh4 * zconcd ) * z1_trndia ) 107 108 concnfe(ji,jj,jk) = MAX( conc2 , ( zconcn2 * conc2 + conc2m * zconcn ) * z1_trnphy ) 109 zconc0n = MAX( conc0 , ( zconcn2 * conc0 + 2. * conc0 * zconcn ) * z1_trnphy ) 110 zconc0nnh4 = MAX( concnnh4 , ( zconcn2 * concnnh4 + 2. * concnnh4 * zconcn ) * z1_trnphy ) 111 112 ! Michaelis-Menten Limitation term for nutrients Small flagellates 113 ! ----------------------------------------------- 114 zdenom = 1. / ( zconc0n * zconc0nnh4 + zconc0nnh4 * trn(ji,jj,jk,jpno3) + zconc0n * trn(ji,jj,jk,jpnh4) ) 115 xnanono3(ji,jj,jk) = trn(ji,jj,jk,jpno3) * zconc0nnh4 * zdenom 116 xnanonh4(ji,jj,jk) = trn(ji,jj,jk,jpnh4) * zconc0n * zdenom 117 ! 118 zlim1 = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) 119 zlim2 = trn(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + zconc0nnh4 ) 120 zratio = trn(ji,jj,jk,jpnfe) * z1_trnphy 121 zironmin = xcoef1 * trn(ji,jj,jk,jpnch) * z1_trnphy + xcoef2 * zlim1 + xcoef3 * xnanono3(ji,jj,jk) 122 zlim3 = MAX( 0.,( zratio - zironmin ) / qnfelim ) 123 xlimnfe(ji,jj,jk) = MIN( 1., zlim3 ) 124 xlimphy(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) 125 ! 126 zlim1 = trn(ji,jj,jk,jpnh4) / ( concnnh4 + trn(ji,jj,jk,jpnh4) ) 127 zlim3 = trn(ji,jj,jk,jpfer) / ( concfebac+ trn(ji,jj,jk,jpfer) ) 128 zlim4 = trn(ji,jj,jk,jpdoc) / ( xkdoc + trn(ji,jj,jk,jpdoc) ) 129 xlimbac(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) * zlim4 130 131 ! Michaelis-Menten Limitation term for nutrients Diatoms 132 ! ---------------------------------------------- 133 zdenom = 1. / ( zconc1d * zconc1dnh4 + zconc1dnh4 * trn(ji,jj,jk,jpno3) + zconc1d * trn(ji,jj,jk,jpnh4) ) 134 xdiatno3(ji,jj,jk) = trn(ji,jj,jk,jpno3) * zconc1dnh4 * zdenom 135 xdiatnh4(ji,jj,jk) = trn(ji,jj,jk,jpnh4) * zconc1d * zdenom 136 ! 137 zlim1 = xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) 138 zlim2 = trn(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + zconc1dnh4 ) 139 zlim3 = trn(ji,jj,jk,jpsil) / ( trn(ji,jj,jk,jpsil) + xksi(ji,jj) ) 140 zratio = trn(ji,jj,jk,jpdfe)/(trn(ji,jj,jk,jpdia)+rtrn) 141 zironmin = xcoef1 * trn(ji,jj,jk,jpdch) * z1_trndia + xcoef2 * zlim1 + xcoef3 * xdiatno3(ji,jj,jk) 142 zlim4 = MAX( 0., ( zratio - zironmin ) / qdfelim ) 143 xlimdfe(ji,jj,jk) = MIN( 1., zlim4 ) 144 xlimdia(ji,jj,jk) = MIN( zlim1, zlim2, zlim3, zlim4 ) 145 xlimsi(ji,jj,jk) = MIN( zlim1, zlim2, zlim4 ) 146 END DO 147 END DO 148 END DO 149 150 ! Compute the fraction of nanophytoplankton that is made of calcifiers 151 ! -------------------------------------------------------------------- 152 DO jk = 1, jpkm1 153 DO jj = 1, jpj 154 DO ji = 1, jpi 155 zlim1 = ( trn(ji,jj,jk,jpno3) * concnnh4 + trn(ji,jj,jk,jpnh4) * conc0 ) & 156 & / ( conc0 * concnnh4 + concnnh4 * trn(ji,jj,jk,jpno3) + conc0 * trn(ji,jj,jk,jpnh4) ) 157 zlim2 = trn(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + concnnh4 ) 158 zlim3 = trn(ji,jj,jk,jpfer) / ( trn(ji,jj,jk,jpfer) + concfebac ) 159 ztem1 = MAX( 0., tsn(ji,jj,jk,jp_tem) ) 160 ztem2 = tsn(ji,jj,jk,jp_tem) - 10. 161 zetot1 = MAX( 0., etot(ji,jj,jk) - 1.) / ( 4. + etot(ji,jj,jk) ) 162 zetot2 = 1. / ( 30. + etot(ji,jj,jk) ) 163 164 xfracal(ji,jj,jk) = caco3r * MIN( zlim1, zlim2, zlim3 ) & 165 & * ztem1 / ( 0.1 + ztem1 ) & 166 & * MAX( 1., trn(ji,jj,jk,jpphy) * 1.e6 / 2. ) & 167 & * 2.325 * zetot1 * 30. * zetot2 & 168 & * ( 1. + EXP(-ztem2 * ztem2 / 25. ) ) & 169 & * MIN( 1., 50. / ( hmld(ji,jj) + rtrn ) ) 170 xfracal(ji,jj,jk) = MIN( 0.8 , xfracal(ji,jj,jk) ) 171 xfracal(ji,jj,jk) = MAX( 0.02, xfracal(ji,jj,jk) ) 81 172 END DO 82 173 END DO 83 174 END DO 84 85 ! Computation of a variable Ks for iron on diatoms taking into account 86 ! that increasing biomass is made of generally bigger cells 87 ! ------------------------------------------------ 88 89 DO jk = 1, jpkm1 90 DO jj = 1, jpj 91 DO ji = 1, jpi 92 zconctemp = MAX( 0.e0 , trn(ji,jj,jk,jpdia)-5e-7 ) 93 zconctemp2 = trn(ji,jj,jk,jpdia) - zconctemp 94 zconctempn = MAX( 0.e0 , trn(ji,jj,jk,jpphy)-1e-6 ) 95 zconctempn2 = trn(ji,jj,jk,jpphy) - zconctempn 96 concdfe(ji,jj,jk) = ( zconctemp2 * conc3 + conc3m * zconctemp) & 97 & / ( trn(ji,jj,jk,jpdia) + rtrn ) 98 concdfe(ji,jj,jk) = MAX( conc3, concdfe(ji,jj,jk) ) 99 concnfe(ji,jj,jk) = ( zconctempn2 * conc2 + conc2m * zconctempn) & 100 & / ( trn(ji,jj,jk,jpphy) + rtrn ) 101 concnfe(ji,jj,jk) = MAX( conc2, concnfe(ji,jj,jk) ) 102 END DO 103 END DO 104 END DO 105 106 ! Michaelis-Menten Limitation term for nutrients Small flagellates 107 ! ----------------------------------------------- 108 DO jk = 1, jpkm1 109 DO jj = 1, jpj 110 DO ji = 1, jpi 111 zdenom = 1. / & 112 & ( conc0 * concnnh4 + concnnh4 * trn(ji,jj,jk,jpno3) + conc0 * trn(ji,jj,jk,jpnh4) ) 113 xnanono3(ji,jj,jk) = trn(ji,jj,jk,jpno3) * concnnh4 * zdenom 114 xnanonh4(ji,jj,jk) = trn(ji,jj,jk,jpnh4) * conc0 * zdenom 115 116 zlim1 = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) 117 zlim2 = trn(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + concnnh4 ) 118 zlim3 = trn(ji,jj,jk,jpfer) / ( trn(ji,jj,jk,jpfer) + concnfe(ji,jj,jk) ) 119 xlimphy(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) 120 zlim1 = trn(ji,jj,jk,jpnh4) / ( concnnh4 + trn(ji,jj,jk,jpnh4) ) 121 zlim3 = trn(ji,jj,jk,jpfer) / ( conc2 + trn(ji,jj,jk,jpfer) ) 122 zlim4 = trn(ji,jj,jk,jpdoc) / ( xkdoc + trn(ji,jj,jk,jpdoc) ) 123 xlimbac(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) * zlim4 124 125 END DO 126 END DO 127 END DO 128 129 ! Michaelis-Menten Limitation term for nutrients Diatoms 130 ! ---------------------------------------------- 131 DO jk = 1, jpkm1 132 DO jj = 1, jpj 133 DO ji = 1, jpi 134 zdenom = 1. / & 135 & ( conc1 * concdnh4 + concdnh4 * trn(ji,jj,jk,jpno3) + conc1 * trn(ji,jj,jk,jpnh4) ) 136 137 xdiatno3(ji,jj,jk) = trn(ji,jj,jk,jpno3) * concdnh4 * zdenom 138 xdiatnh4(ji,jj,jk) = trn(ji,jj,jk,jpnh4) * conc1 * zdenom 139 140 zlim1 = xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) 141 zlim2 = trn(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + concdnh4 ) 142 zlim3 = trn(ji,jj,jk,jpsil) / ( trn(ji,jj,jk,jpsil) + xksi (ji,jj) ) 143 zlim4 = trn(ji,jj,jk,jpfer) / ( trn(ji,jj,jk,jpfer) + concdfe(ji,jj,jk) ) 144 xlimdia(ji,jj,jk) = MIN( zlim1, zlim2, zlim3, zlim4 ) 145 146 END DO 147 END DO 148 END DO 149 150 151 ! Compute the fraction of nanophytoplankton that is made of calcifiers 152 ! -------------------------------------------------------------------- 153 154 DO jk = 1, jpkm1 155 DO jj = 1, jpj 156 DO ji = 1, jpi 157 ztemp = MAX( 0., tsn(ji,jj,jk,jp_tem) ) 158 xfracal(ji,jj,jk) = caco3r * xlimphy(ji,jj,jk) & 159 & * MAX( 0.0001, ztemp / ( 2.+ ztemp ) ) & 160 & * MAX( 1., trn(ji,jj,jk,jpphy) * 1.e6 / 2. ) 161 xfracal(ji,jj,jk) = MIN( 0.8 , xfracal(ji,jj,jk) ) 162 xfracal(ji,jj,jk) = MAX( 0.01, xfracal(ji,jj,jk) ) 163 END DO 164 END DO 165 END DO 175 ! 176 IF( nn_timing == 1 ) CALL timing_stop('p4z_lim') 166 177 ! 167 178 END SUBROUTINE p4z_lim … … 175 186 !! 176 187 !! ** Method : Read the nampislim namelist and check the parameters 177 !! called at the first timestep (nit 000)188 !! called at the first timestep (nittrc000) 178 189 !! 179 190 !! ** input : Namelist nampislim … … 182 193 183 194 NAMELIST/nampislim/ conc0, conc1, conc2, conc2m, conc3, conc3m, & 184 & concnnh4, concdnh4, xksi1, xksi2, xkdoc, caco3r 185 186 REWIND( numnat ) ! read numnat 187 READ ( numnat, nampislim ) 195 & xsizedia, xsizephy, concnnh4, concdnh4, & 196 & xksi1, xksi2, xkdoc, concfebac, qnfelim, qdfelim, caco3r 197 198 REWIND( numnatp ) ! read numnat 199 READ ( numnatp, nampislim ) 188 200 189 201 IF(lwp) THEN ! control print … … 191 203 WRITE(numout,*) ' Namelist parameters for nutrient limitations, nampislim' 192 204 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 193 WRITE(numout,*) ' mean rainratio caco3r =', caco3r 194 WRITE(numout,*) ' NO3, PO4 half saturation conc0 =', conc0 195 WRITE(numout,*) ' half saturation constant for Si uptake xksi1 =', xksi1 196 WRITE(numout,*) ' half saturation constant for Si/C xksi2 =', xksi2 197 WRITE(numout,*) ' 2nd half-sat. of DOC remineralization xkdoc =', xkdoc 198 WRITE(numout,*) ' Phosphate half saturation for diatoms conc1 =', conc1 199 WRITE(numout,*) ' Iron half saturation for phyto conc2 =', conc2 200 WRITE(numout,*) ' Max iron half saturation for phyto conc2m =', conc2m 201 WRITE(numout,*) ' Iron half saturation for diatoms conc3 =', conc3 202 WRITE(numout,*) ' Maxi iron half saturation for diatoms conc3m =', conc3m 203 WRITE(numout,*) ' NH4 half saturation for phyto concnnh4 =', concnnh4 204 WRITE(numout,*) ' NH4 half saturation for diatoms concdnh4 =', concdnh4 205 WRITE(numout,*) ' mean rainratio caco3r = ', caco3r 206 WRITE(numout,*) ' NO3, PO4 half saturation conc0 = ', conc0 207 WRITE(numout,*) ' half saturation constant for Si uptake xksi1 = ', xksi1 208 WRITE(numout,*) ' half saturation constant for Si/C xksi2 = ', xksi2 209 WRITE(numout,*) ' 2nd half-sat. of DOC remineralization xkdoc = ', xkdoc 210 WRITE(numout,*) ' Phosphate half saturation for diatoms conc1 = ', conc1 211 WRITE(numout,*) ' Iron half saturation for phyto conc2 = ', conc2 212 WRITE(numout,*) ' Max iron half saturation for phyto conc2m = ', conc2m 213 WRITE(numout,*) ' Iron half saturation for diatoms conc3 = ', conc3 214 WRITE(numout,*) ' Maxi iron half saturation for diatoms conc3m = ', conc3m 215 WRITE(numout,*) ' Minimum size criteria for diatoms xsizedia = ', xsizedia 216 WRITE(numout,*) ' Minimum size criteria for nanophyto xsizephy = ', xsizephy 217 WRITE(numout,*) ' NH4 half saturation for phyto concnnh4 = ', concnnh4 218 WRITE(numout,*) ' NH4 half saturation for diatoms concdnh4 = ', concdnh4 219 WRITE(numout,*) ' Fe half saturation for bacteria concfebac = ', concfebac 220 WRITE(numout,*) ' optimal Fe quota for nano. qnfelim = ', qnfelim 221 WRITE(numout,*) ' Optimal Fe quota for diatoms qdfelim = ', qdfelim 205 222 ENDIF 206 223 -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zlys.F90
r2715 r3294 9 9 !! 1.0 ! 2004 (O. Aumont) modifications 10 10 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) F90 11 !! ! 2011-02 (J. Simeon, J. Orr) Calcon salinity dependence 12 !! 3.4 ! 2011-06 (O. Aumont, C. Ethe) Improvment of calcite dissolution 11 13 !!---------------------------------------------------------------------- 12 14 #if defined key_pisces … … 17 19 !! p4z_lys_init : Read the namelist parameters 18 20 !!---------------------------------------------------------------------- 19 USE trc 20 USE oce_trc ! 21 USE trc 22 USE sms_pisces 23 USE prtctl_trc 24 USE iom 21 USE oce_trc ! shared variables between ocean and passive tracers 22 USE trc ! passive tracers common variables 23 USE sms_pisces ! PISCES Source Minus Sink variables 24 USE prtctl_trc ! print control for debugging 25 USE iom ! I/O manager 25 26 26 27 IMPLICIT NONE … … 57 58 !! ** Method : - ??? 58 59 !!--------------------------------------------------------------------- 59 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released60 USE wrk_nemo, ONLY: zco3 => wrk_3d_2, zcaldiss => wrk_3d_361 60 ! 62 61 INTEGER, INTENT(in) :: kt ! ocean time step 63 62 INTEGER :: ji, jj, jk, jn 64 REAL(wp) :: z bot, zalk, zdic, zph, zremco3, zah265 REAL(wp) :: zdispot, zfact, z alka63 REAL(wp) :: zalk, zdic, zph, zah2 64 REAL(wp) :: zdispot, zfact, zcalcon, zalka, zaldi 66 65 REAL(wp) :: zomegaca, zexcess, zexcess0 67 #if defined key_diatrc && defined key_iomput68 66 REAL(wp) :: zrfact2 69 #endif70 67 CHARACTER (len=25) :: charout 68 REAL(wp), POINTER, DIMENSION(:,:,:) :: zco3, zcaldiss 71 69 !!--------------------------------------------------------------------- 72 73 IF( wrk_in_use(3, 2,3) ) THEN 74 CALL ctl_stop('p4z_lys: requested workspace arrays unavailable') ; RETURN 75 END IF 76 77 zco3(:,:,:) = 0. 78 # if defined key_diatrc && defined key_iomput 70 ! 71 IF( nn_timing == 1 ) CALL timing_start('p4z_lys') 72 ! 73 CALL wrk_alloc( jpi, jpj, jpk, zco3, zcaldiss ) 74 ! 75 zco3 (:,:,:) = 0. 79 76 zcaldiss(:,:,:) = 0. 80 # endif81 77 ! ------------------------------------------- 82 78 ! COMPUTE [CO3--] and [H+] CONCENTRATIONS … … 91 87 !CDIR NOVERRCHK 92 88 DO ji = 1, jpi 93 94 ! SET DUMMY VARIABLE FOR TOTAL BORATE 95 zbot = borat(ji,jj,jk) 96 97 ! SET DUMMY VARIABLE FOR TOTAL BORATE 98 zbot = borat(ji,jj,jk) 99 zfact = rhop (ji,jj,jk) / 1000. + rtrn 100 101 ! SET DUMMY VARIABLE FOR [H+] 102 zph = hi(ji,jj,jk) * tmask(ji,jj,jk) / zfact + ( 1.-tmask(ji,jj,jk) ) * 1.e-9 103 104 ! SET DUMMY VARIABLE FOR [SUM(CO2)]GIVEN 89 zfact = rhop(ji,jj,jk) / 1000. + rtrn 90 zph = hi(ji,jj,jk) * tmask(ji,jj,jk) / zfact + ( 1.-tmask(ji,jj,jk) ) * 1.e-9 ! [H+] 105 91 zdic = trn(ji,jj,jk,jpdic) / zfact 106 92 zalka = trn(ji,jj,jk,jptal) / zfact 107 108 93 ! CALCULATE [ALK]([CO3--], [HCO3-]) 109 zalk = zalka - ( akw3(ji,jj,jk) / zph - zph & 110 & + zbot / (1.+ zph / akb3(ji,jj,jk) ) ) 111 94 zalk = zalka - ( akw3(ji,jj,jk) / zph - zph + borat(ji,jj,jk) / ( 1. + zph / akb3(ji,jj,jk) ) ) 112 95 ! CALCULATE [H+] and [CO3--] 113 zah2 = SQRT( (zdic-zalk)*(zdic-zalk)+ & 114 & 4.*(zalk*ak23(ji,jj,jk)/ak13(ji,jj,jk)) & 115 & *(2*zdic-zalk)) 116 117 zah2=0.5*ak13(ji,jj,jk)/zalk*((zdic-zalk)+zah2) 118 zco3(ji,jj,jk) = zalk/(2.+zah2/ak23(ji,jj,jk))*zfact 119 120 hi(ji,jj,jk) = zah2*zfact 121 96 zaldi = zdic - zalk 97 zah2 = SQRT( zaldi * zaldi + 4.* ( zalk * ak23(ji,jj,jk) / ak13(ji,jj,jk) ) * ( zdic + zaldi ) ) 98 zah2 = 0.5 * ak13(ji,jj,jk) / zalk * ( zaldi + zah2 ) 99 ! 100 zco3(ji,jj,jk) = zalk / ( 2. + zah2 / ak23(ji,jj,jk) ) * zfact 101 hi(ji,jj,jk) = zah2 * zfact 122 102 END DO 123 103 END DO … … 137 117 138 118 ! DEVIATION OF [CO3--] FROM SATURATION VALUE 139 zomegaca = ( calcon * zco3(ji,jj,jk) ) / aksp(ji,jj,jk) 119 ! Salinity dependance in zomegaca and divide by rhop/1000 to have good units 120 zcalcon = calcon * ( tsn(ji,jj,jk,jp_sal) / 35._wp ) 121 zfact = rhop(ji,jj,jk) / 1000._wp 122 zomegaca = ( zcalcon * zco3(ji,jj,jk) * zfact ) / aksp(ji,jj,jk) 140 123 141 124 ! SET DEGREE OF UNDER-/SUPERSATURATION 142 zexcess0 = MAX( 0., ( 1.- zomegaca ) ) 125 excess(ji,jj,jk) = 1._wp - zomegaca 126 zexcess0 = MAX( 0., excess(ji,jj,jk) ) 143 127 zexcess = zexcess0**nca 144 128 … … 146 130 ! (ACCORDING TO THIS FORMULATION ALSO SOME PARTICULATE 147 131 ! CACO3 GETS DISSOLVED EVEN IN THE CASE OF OVERSATURATION) 132 zdispot = kdca * zexcess * trn(ji,jj,jk,jpcal) 148 133 # if defined key_degrad 149 zdispot = kdca * zexcess * trn(ji,jj,jk,jpcal) * facvol(ji,jj,jk) 150 # else 151 zdispot = kdca * zexcess * trn(ji,jj,jk,jpcal) 134 zdispot = zdispot * facvol(ji,jj,jk) 152 135 # endif 153 154 136 ! CHANGE OF [CO3--] , [ALK], PARTICULATE [CACO3], 155 137 ! AND [SUM(CO2)] DUE TO CACO3 DISSOLUTION/PRECIPITATION 156 zremco3 = zdispot / rmtss 157 zco3(ji,jj,jk) = zco3(ji,jj,jk) + zremco3 * rfact 158 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + 2. * zremco3 159 tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) - zremco3 160 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zremco3 161 162 # if defined key_diatrc && defined key_iomput 163 zcaldiss(ji,jj,jk) = zremco3 ! calcite dissolution 164 # endif 138 zcaldiss(ji,jj,jk) = zdispot / rmtss ! calcite dissolution 139 zco3(ji,jj,jk) = zco3(ji,jj,jk) + zcaldiss(ji,jj,jk) * rfact 140 ! 141 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + 2. * zcaldiss(ji,jj,jk) 142 tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) - zcaldiss(ji,jj,jk) 143 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zcaldiss(ji,jj,jk) 165 144 END DO 166 145 END DO 167 146 END DO 168 169 # if defined key_diatrc 170 # if ! defined key_iomput 171 trc3d(:,:,:,jp_pcs0_3d ) = hi (:,:,:) * tmask(:,:,:) 172 trc3d(:,:,:,jp_pcs0_3d + 1) = zco3(:,:,:) * tmask(:,:,:) 173 trc3d(:,:,:,jp_pcs0_3d + 2) = aksp(:,:,:) / calcon * tmask(:,:,:) 174 # else 175 zrfact2 = 1.e3 * rfact2r 176 CALL iom_put( "PH" , hi (:,:,:) * tmask(:,:,:) ) 177 CALL iom_put( "CO3" , zco3 (:,:,:) * tmask(:,:,:) ) 178 CALL iom_put( "CO3sat", aksp (:,:,:) / calcon * tmask(:,:,:) ) 179 CALL iom_put( "DCAL" , zcaldiss(:,:,:) * zrfact2 * tmask(:,:,:) ) 180 # endif 181 # endif 182 ! 183 IF(ln_ctl) THEN ! print mean trends (used for debugging) 184 WRITE(charout, FMT="('lys ')") 185 CALL prt_ctl_trc_info(charout) 186 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 187 ENDIF 188 189 IF( wrk_not_released(3, 2,3) ) CALL ctl_stop('p4z_lys: failed to release workspace arrays') 147 ! 148 IF( ln_diatrc ) THEN 149 ! 150 IF( lk_iomput ) THEN 151 zrfact2 = 1.e3 * rfact2r 152 CALL iom_put( "PH" , hi (:,:,:) * tmask(:,:,:) ) 153 CALL iom_put( "CO3" , zco3 (:,:,:) * tmask(:,:,:) ) 154 CALL iom_put( "CO3sat", aksp (:,:,:) / calcon * tmask(:,:,:) ) 155 CALL iom_put( "DCAL" , zcaldiss(:,:,:) * zrfact2 * tmask(:,:,:) ) 156 ELSE 157 trc3d(:,:,:,jp_pcs0_3d ) = hi (:,:,:) * tmask(:,:,:) 158 trc3d(:,:,:,jp_pcs0_3d + 1) = zco3(:,:,:) * tmask(:,:,:) 159 trc3d(:,:,:,jp_pcs0_3d + 2) = aksp(:,:,:) / calcon * tmask(:,:,:) 160 ENDIF 161 ! 162 ENDIF 163 ! 164 IF(ln_ctl) THEN ! print mean trends (used for debugging) 165 WRITE(charout, FMT="('lys ')") 166 CALL prt_ctl_trc_info(charout) 167 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 168 ENDIF 169 ! 170 CALL wrk_dealloc( jpi, jpj, jpk, zco3, zcaldiss ) 171 ! 172 IF( nn_timing == 1 ) CALL timing_stop('p4z_lys') 190 173 ! 191 174 END SUBROUTINE p4z_lys … … 199 182 !! 200 183 !! ** Method : Read the nampiscal namelist and check the parameters 201 !! called at the first timestep (nit 000)184 !! called at the first timestep (nittrc000) 202 185 !! 203 186 !! ** input : Namelist nampiscal … … 207 190 NAMELIST/nampiscal/ kdca, nca 208 191 209 REWIND( numnat ) ! read numnat210 READ ( numnat , nampiscal )192 REWIND( numnatp ) ! read numnatp 193 READ ( numnatp, nampiscal ) 211 194 212 195 IF(lwp) THEN ! control print -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmeso.F90
r2528 r3294 6 6 !! History : 1.0 ! 2002 (O. Aumont) Original code 7 7 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) F90 8 !! 3.4 ! 2011-06 (O. Aumont, C. Ethe) Quota model for iron 8 9 !!---------------------------------------------------------------------- 9 10 #if defined key_pisces … … 14 15 !! p4z_meso_init : Initialization of the parameters for mesozooplankton 15 16 !!---------------------------------------------------------------------- 16 USE trc17 USE oce_trc !18 USE trc !19 USE sms_pisces !20 USE p rtctl_trc21 USE p4z int22 USE p 4zsink23 USE iom 17 USE oce_trc ! shared variables between ocean and passive tracers 18 USE trc ! passive tracers common variables 19 USE sms_pisces ! PISCES Source Minus Sink variables 20 USE p4zsink ! vertical flux of particulate matter due to sinking 21 USE p4zint ! interpolation and computation of various fields 22 USE p4zprod ! production 23 USE prtctl_trc ! print control for debugging 24 USE iom ! I/O manager 24 25 25 26 IMPLICIT NONE … … 30 31 31 32 !! * Shared module variables 32 REAL(wp), PUBLIC :: & 33 xprefc = 1.0_wp , & !: 34 xprefp = 0.2_wp , & !: 35 xprefz = 1.0_wp , & !: 36 xprefpoc = 0.0_wp , & !: 37 resrat2 = 0.005_wp , & !: 38 mzrat2 = 0.03_wp , & !: 39 grazrat2 = 0.7_wp , & !: 40 xkgraz2 = 20E-6_wp , & !: 41 unass2 = 0.3_wp , & !: 42 sigma2 = 0.6_wp , & !: 43 epsher2 = 0.33_wp , & !: 44 grazflux = 5.E3_wp 45 33 REAL(wp), PUBLIC :: part2 = 0.5_wp !: part of calcite not dissolved in mesozoo guts 34 REAL(wp), PUBLIC :: xprefc = 1.0_wp !: mesozoo preference for POC 35 REAL(wp), PUBLIC :: xprefp = 0.3_wp !: mesozoo preference for nanophyto 36 REAL(wp), PUBLIC :: xprefz = 1.0_wp !: mesozoo preference for diatoms 37 REAL(wp), PUBLIC :: xprefpoc = 0.3_wp !: mesozoo preference for POC 38 REAL(wp), PUBLIC :: xthresh2zoo = 1E-8_wp !: zoo feeding threshold for mesozooplankton 39 REAL(wp), PUBLIC :: xthresh2dia = 1E-8_wp !: diatoms feeding threshold for mesozooplankton 40 REAL(wp), PUBLIC :: xthresh2phy = 2E-7_wp !: nanophyto feeding threshold for mesozooplankton 41 REAL(wp), PUBLIC :: xthresh2poc = 1E-8_wp !: poc feeding threshold for mesozooplankton 42 REAL(wp), PUBLIC :: xthresh2 = 0._wp !: feeding threshold for mesozooplankton 43 REAL(wp), PUBLIC :: resrat2 = 0.005_wp !: exsudation rate of mesozooplankton 44 REAL(wp), PUBLIC :: mzrat2 = 0.04_wp !: microzooplankton mortality rate 45 REAL(wp), PUBLIC :: grazrat2 = 0.9_wp !: maximal mesozoo grazing rate 46 REAL(wp), PUBLIC :: xkgraz2 = 20E-6_wp !: non assimilated fraction of P by mesozoo 47 REAL(wp), PUBLIC :: unass2 = 0.3_wp !: Efficicency of mesozoo growth 48 REAL(wp), PUBLIC :: sigma2 = 0.6_wp !: Fraction of mesozoo excretion as DOM 49 REAL(wp), PUBLIC :: epsher2 = 0.3_wp !: half sturation constant for grazing 2 50 REAL(wp), PUBLIC :: grazflux = 3.E3_wp !: mesozoo flux feeding rate 46 51 47 52 !!* Substitution … … 65 70 INTEGER, INTENT(in) :: kt, jnt ! ocean time step 66 71 INTEGER :: ji, jj, jk 67 REAL(wp) :: zcompadi, zcompaph, zcompapoc, zcompaz 68 REAL(wp) :: zfact, zcompam, zdenom, zgraze2, zstep 69 REAL(wp) :: zgrarem2, zgrafer2, zgrapoc2, zprcaca, zmortz2 72 REAL(wp) :: zcompadi, zcompaph, zcompapoc, zcompaz, zcompam 73 REAL(wp) :: zgraze2 , zdenom, zdenom2, zncratio 74 REAL(wp) :: zfact , zstep, zfood, zfoodlim 75 REAL(wp) :: zepshert, zepsherv, zgrarsig, zgraztot, zgraztotf 76 REAL(wp) :: zgrarem2, zgrafer2, zgrapoc2, zprcaca, zmortz2, zgrasrat 70 77 #if defined key_kriest 71 78 REAL znumpoc 72 79 #endif 73 REAL(wp) :: zrespz2, ztortz2,zgrazd,zgrazz,zgrazpof74 REAL(wp) :: zgrazn, zgrazpoc,zgraznf,zgrazf75 REAL(wp) :: zgrazfff, zgrazffe80 REAL(wp) :: zrespz2, ztortz2, zgrazd, zgrazz, zgrazpof 81 REAL(wp) :: zgrazn, zgrazpoc, zgraznf, zgrazf 82 REAL(wp) :: zgrazfff, zgrazffe 76 83 CHARACTER (len=25) :: charout 77 #if defined key_diatrc && defined key_iomput78 84 REAL(wp) :: zrfact2 79 #endif80 81 85 !!--------------------------------------------------------------------- 86 ! 87 IF( nn_timing == 1 ) CALL timing_start('p4z_meso') 88 ! 82 89 83 90 DO jk = 1, jpkm1 84 91 DO jj = 1, jpj 85 92 DO ji = 1, jpi 86 87 zcompam = MAX( ( trn(ji,jj,jk,jpmes) - 1.e-9 ), 0.e0 ) 93 zcompam = MAX( ( trn(ji,jj,jk,jpmes) - 1.e-8 ), 0.e0 ) 88 94 # if defined key_degrad 89 zstep = xstep * facvol(ji,jj,jk)95 zstep = xstep * facvol(ji,jj,jk) 90 96 # else 91 zstep = xstep97 zstep = xstep 92 98 # endif 93 zfact = zstep * tgfunc(ji,jj,jk) * zcompam99 zfact = zstep * tgfunc(ji,jj,jk) * zcompam 94 100 95 101 ! Respiration rates of both zooplankton 96 102 ! ------------------------------------- 97 zrespz2 = resrat2 * zfact * ( 1. + 3. * nitrfac(ji,jj,jk) )&98 & * trn(ji,jj,jk,jpmes) / ( xkmort + trn(ji,jj,jk,jpmes))103 zrespz2 = resrat2 * zfact * trn(ji,jj,jk,jpmes) / ( xkmort + trn(ji,jj,jk,jpmes) ) & 104 & + resrat2 * zfact * 3. * nitrfac(ji,jj,jk) 99 105 100 106 ! Zooplankton mortality. A square function has been selected with 101 107 ! no real reason except that it seems to be more stable and may mimic predation 102 108 ! --------------------------------------------------------------- 103 ztortz2 = mzrat2 * 1.e6 * zfact * trn(ji,jj,jk,jpmes)109 ztortz2 = mzrat2 * 1.e6 * zfact * trn(ji,jj,jk,jpmes) 104 110 ! 105 111 106 zcompadi = MAX( ( trn(ji,jj,jk,jpdia) - 1.e-8 ), 0.e0 ) 107 zcompaz = MAX( ( trn(ji,jj,jk,jpzoo) - 1.e-8 ), 0.e0 ) 108 zcompaph = MAX( ( trn(ji,jj,jk,jpphy) - 2.e-7 ), 0.e0 ) 109 zcompapoc = MAX( ( trn(ji,jj,jk,jppoc) - 1.e-8 ), 0.e0 ) 110 111 ! Microzooplankton grazing 112 ! ------------------------ 113 zdenom = 1. / ( xkgraz2 + xprefc * trn(ji,jj,jk,jpdia) & 114 & + xprefz * trn(ji,jj,jk,jpzoo) & 115 & + xprefp * trn(ji,jj,jk,jpphy) & 116 & + xprefpoc * trn(ji,jj,jk,jppoc) ) 117 118 zgraze2 = grazrat2 * zstep * Tgfunc2(ji,jj,jk) * zdenom * trn(ji,jj,jk,jpmes) 119 120 zgrazd = zgraze2 * xprefc * zcompadi 121 zgrazz = zgraze2 * xprefz * zcompaz 122 zgrazn = zgraze2 * xprefp * zcompaph 123 zgrazpoc = zgraze2 * xprefpoc * zcompapoc 124 125 zgraznf = zgrazn * trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn) 126 zgrazf = zgrazd * trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn) 127 zgrazpof = zgrazpoc * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 128 112 zcompadi = MAX( ( trn(ji,jj,jk,jpdia) - xthresh2dia ), 0.e0 ) 113 zcompaz = MAX( ( trn(ji,jj,jk,jpzoo) - xthresh2zoo ), 0.e0 ) 114 zcompaph = MAX( ( trn(ji,jj,jk,jpphy) - xthresh2phy ), 0.e0 ) 115 zcompapoc = MAX( ( trn(ji,jj,jk,jppoc) - xthresh2poc ), 0.e0 ) 116 117 zfood = xprefc * zcompadi + xprefz * zcompaz + xprefp * zcompaph + xprefpoc * zcompapoc 118 zfoodlim = MAX( 0., zfood - xthresh2 ) 119 zdenom = zfoodlim / ( xkgraz2 + zfoodlim ) 120 zdenom2 = zdenom / ( zfood + rtrn ) 121 zgraze2 = grazrat2 * zstep * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpmes) 122 123 zgrazd = zgraze2 * xprefc * zcompadi * zdenom2 124 zgrazz = zgraze2 * xprefz * zcompaz * zdenom2 125 zgrazn = zgraze2 * xprefp * zcompaph * zdenom2 126 zgrazpoc = zgraze2 * xprefpoc * zcompapoc * zdenom2 127 128 zgraznf = zgrazn * trn(ji,jj,jk,jpnfe) / ( trn(ji,jj,jk,jpphy) + rtrn) 129 zgrazf = zgrazd * trn(ji,jj,jk,jpdfe) / ( trn(ji,jj,jk,jpdia) + rtrn) 130 zgrazpof = zgrazpoc * trn(ji,jj,jk,jpsfe) / ( trn(ji,jj,jk,jppoc) + rtrn) 131 129 132 ! Mesozooplankton flux feeding on GOC 130 133 ! ---------------------------------- 131 134 # if ! defined key_kriest 132 zgrazffe = grazflux * zstep * wsbio4(ji,jj,jk) &133 134 zgrazfff = zgrazffe * trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn)135 zgrazffe = grazflux * zstep * wsbio4(ji,jj,jk) & 136 & * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpmes) 137 zgrazfff = zgrazffe * trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn) 135 138 # else 136 !!--------------------------- KRIEST3 ------------------------------------------- 137 !! zgrazffe = 0.5 * 1.3e-2 / 5.5e-7 * 0.3 * zstep * wsbio3(ji,jj,jk) & 138 !! & * tgfunc(ji,jj,jk) * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpmes) & 139 !! # if defined key_degrad 140 !! & * facvol(ji,jj,jk) & 141 !! # endif 142 !! & / (trn(ji,jj,jk,jppoc) * 1.e7 + 0.1) 143 !!--------------------------- KRIEST3 ------------------------------------------- 144 145 zgrazffe = grazflux * zstep * wsbio3(ji,jj,jk) & 146 & * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpmes) 147 zgrazfff = zgrazffe * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 139 zgrazffe = grazflux * zstep * wsbio3(ji,jj,jk) & 140 zgrazfff = zgrazffe * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 148 141 # endif 149 150 #if defined key_diatrc 151 ! Total grazing ( grazing by microzoo is already computed in p4zmicro )152 grazing(ji,jj,jk) = grazing(ji,jj,jk) + ( zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffe ) 153 #endif 154 142 ! 143 zgraztot = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffe 144 zgraztotf = zgrazf + zgraznf + zgrazz * ferat3 + zgrazpof + zgrazfff 145 146 ! Total grazing ( grazing by microzoo is already computed in p4zmicro ) 147 grazing(ji,jj,jk) = grazing(ji,jj,jk) + zgraztot 155 148 ! Mesozooplankton efficiency 156 149 ! -------------------------- 157 zgrarem2 = ( zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffe ) * ( 1. - epsher2 - unass2 ) 158 #if ! defined key_kriest 159 zgrafer2 = ( zgrazf + zgraznf + zgrazz * ferat3 + zgrazpof + zgrazfff ) * ( 1.- epsher2 - unass2 ) & 160 & + epsher2 * ( zgrazd * MAX((trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn)-ferat3),0.) & 161 & + zgrazn * MAX((trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn)-ferat3),0.) & 162 & + zgrazpoc * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)-ferat3),0.) & 163 & + zgrazffe * MAX((trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn)-ferat3),0.) ) 150 zgrasrat = zgraztotf / ( zgraztot + rtrn ) 151 zncratio = ( xprefc * zcompadi * quotad(ji,jj,jk) & 152 & + xprefp * zcompaph * quotan(ji,jj,jk) & 153 & + xprefz * zcompaz & 154 & + xprefpoc * zcompapoc ) / ( zfood + rtrn ) 155 zepshert = epsher2 * MIN( 1., zncratio ) 156 zepsherv = zepshert * MIN( 1., zgrasrat / ferat3 ) 157 zgrarem2 = zgraztot * ( 1. - zepsherv - unass2 ) 158 zgrafer2 = zgraztot * MAX( 0. , ( 1. - unass2 ) * zgrasrat - ferat3 * zepshert ) 159 zgrapoc2 = zgraztot * unass2 160 161 ! Update the arrays TRA which contain the biological sources and sinks 162 zgrarsig = zgrarem2 * sigma2 163 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarsig 164 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarsig 165 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem2 - zgrarsig 166 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarsig 167 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer2 168 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarsig 169 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zgrarsig 170 #if defined key_kriest 171 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc2 172 tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc2 * xkr_dmeso 173 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zgraztotf * unass2 164 174 #else 165 zgrafer2 = ( zgrazf + zgraznf + zgrazz * ferat3 + zgrazpof + zgrazfff ) * ( 1. - epsher2 - unass2 ) & 166 & + epsher2 * ( zgrazd * MAX((trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn)-ferat3),0.) & 167 & + zgrazn * MAX((trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn)-ferat3),0.) & 168 & + zgrazpoc * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)-ferat3),0.) & 169 & + zgrazffe * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)-ferat3),0.) ) 170 171 #endif 172 ! Update the arrays TRA which contain the biological sources and sinks 173 174 zgrapoc2 = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffe 175 176 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarem2 * sigma2 177 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarem2 * sigma2 178 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem2 * ( 1. - sigma2 ) 179 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarem2 * sigma2 180 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer2 181 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarem2 * sigma2 182 183 #if defined key_kriest 184 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc2 * unass2 185 tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc2 * unass2 * xkr_dmeso 186 #else 187 tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zgrapoc2 * unass2 175 tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zgrapoc2 176 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zgraztotf * unass2 188 177 #endif 189 178 zmortz2 = ztortz2 + zrespz2 190 tra(ji,jj,jk,jpmes) = tra(ji,jj,jk,jpmes) - zmortz2 + epsher2 * zgrapoc2179 tra(ji,jj,jk,jpmes) = tra(ji,jj,jk,jpmes) - zmortz2 + zepsherv * zgraztot 191 180 tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazd 192 181 tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zgrazz … … 199 188 tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazf 200 189 201 zprcaca = xfracal(ji,jj,jk) * unass2 *zgrazn202 #if defined key_diatrc 190 zprcaca = xfracal(ji,jj,jk) * zgrazn 191 ! calcite production 203 192 prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 204 #endif 205 zprcaca = part * zprcaca193 ! 194 zprcaca = part2 * zprcaca 206 195 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca 207 196 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca … … 212 201 tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) - zgrazpoc * znumpoc & 213 202 & + zmortz2 * xkr_dmeso - zgrazffe * znumpoc * wsbio4(ji,jj,jk) / ( wsbio3(ji,jj,jk) + rtrn ) 214 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz2 & 215 & + unass2 * ( ferat3 * zgrazz + zgraznf + zgrazf + zgrazpof + zgrazfff ) - zgrazfff - zgrazpof 203 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz2 - zgrazfff - zgrazpof 216 204 #else 217 205 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zgrazpoc 218 206 tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zmortz2 - zgrazffe 219 207 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zgrazpof 220 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + ferat3 * zmortz2 & 221 & + unass2 * ( ferat3 * zgrazz + zgraznf + zgrazf + zgrazpof + zgrazfff ) - zgrazfff 208 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + ferat3 * zmortz2 - zgrazfff 222 209 #endif 223 210 … … 226 213 END DO 227 214 ! 228 #if defined key_diatrc && defined key_iomput 229 zrfact2 = 1.e3 * rfact2r 230 ! Total grazing of phyto by zoo 231 grazing(:,:,:) = grazing(:,:,:) * zrfact2 * tmask(:,:,:) 232 ! Calcite production 233 prodcal(:,:,:) = prodcal(:,:,:) * zrfact2 * tmask(:,:,:) 234 IF( jnt == nrdttrc ) then 235 CALL iom_put( "GRAZ" , grazing ) ! Total grazing of phyto by zooplankton 236 CALL iom_put( "PCAL" , prodcal ) ! Calcite production 215 IF( ln_diatrc .AND. lk_iomput ) THEN 216 zrfact2 = 1.e3 * rfact2r 217 grazing(:,:,:) = grazing(:,:,:) * zrfact2 * tmask(:,:,:) ! Total grazing of phyto by zoo 218 prodcal(:,:,:) = prodcal(:,:,:) * zrfact2 * tmask(:,:,:) ! Calcite production 219 IF( jnt == nrdttrc ) THEN 220 CALL iom_put( "GRAZ" , grazing ) ! Total grazing of phyto by zooplankton 221 CALL iom_put( "PCAL" , prodcal ) ! Calcite production 222 ENDIF 237 223 ENDIF 238 #endif 239 240 IF(ln_ctl) THEN ! print mean trends (used for debugging) 241 WRITE(charout, FMT="('meso')") 242 CALL prt_ctl_trc_info(charout) 243 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 244 ENDIF 245 224 ! 225 IF(ln_ctl) THEN ! print mean trends (used for debugging) 226 WRITE(charout, FMT="('meso')") 227 CALL prt_ctl_trc_info(charout) 228 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 229 ENDIF 230 ! 231 IF( nn_timing == 1 ) CALL timing_stop('p4z_meso') 232 ! 246 233 END SUBROUTINE p4z_meso 247 234 … … 254 241 !! 255 242 !! ** Method : Read the nampismes namelist and check the parameters 256 !! called at the first timestep (nit 000)243 !! called at the first timestep (nittrc000) 257 244 !! 258 245 !! ** input : Namelist nampismes … … 260 247 !!---------------------------------------------------------------------- 261 248 262 NAMELIST/nampismes/ grazrat2,resrat2,mzrat2,xprefc, xprefp, & 263 & xprefz, xprefpoc, xkgraz2, epsher2, sigma2, unass2, grazflux 264 265 REWIND( numnat ) ! read numnat 266 READ ( numnat, nampismes ) 249 NAMELIST/nampismes/ part2, grazrat2, resrat2, mzrat2, xprefc, xprefp, xprefz, & 250 & xprefpoc, xthresh2dia, xthresh2phy, xthresh2zoo, xthresh2poc, & 251 & xthresh2, xkgraz2, epsher2, sigma2, unass2, grazflux 252 253 REWIND( numnatp ) ! read numnatp 254 READ ( numnatp, nampismes ) 267 255 268 256 … … 271 259 WRITE(numout,*) ' Namelist parameters for mesozooplankton, nampismes' 272 260 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 273 WRITE(numout,*) ' zoo preference for phyto xprefc =', xprefc 274 WRITE(numout,*) ' zoo preference for POC xprefp =', xprefp 275 WRITE(numout,*) ' zoo preference for zoo xprefz =', xprefz 276 WRITE(numout,*) ' zoo preference for poc xprefpoc =', xprefpoc 277 WRITE(numout,*) ' exsudation rate of mesozooplankton resrat2 =', resrat2 278 WRITE(numout,*) ' mesozooplankton mortality rate mzrat2 =', mzrat2 279 WRITE(numout,*) ' maximal mesozoo grazing rate grazrat2 =', grazrat2 280 WRITE(numout,*) ' mesozoo flux feeding rate grazflux =', grazflux 281 WRITE(numout,*) ' non assimilated fraction of P by mesozoo unass2 =', unass2 282 WRITE(numout,*) ' Efficicency of Mesozoo growth epsher2 =', epsher2 283 WRITE(numout,*) ' Fraction of mesozoo excretion as DOM sigma2 =', sigma2 284 WRITE(numout,*) ' half sturation constant for grazing 2 xkgraz2 =', xkgraz2 261 WRITE(numout,*) ' part of calcite not dissolved in mesozoo guts part2 =', part2 262 WRITE(numout,*) ' mesozoo preference for phyto xprefc =', xprefc 263 WRITE(numout,*) ' mesozoo preference for POC xprefp =', xprefp 264 WRITE(numout,*) ' mesozoo preference for zoo xprefz =', xprefz 265 WRITE(numout,*) ' mesozoo preference for poc xprefpoc =', xprefpoc 266 WRITE(numout,*) ' microzoo feeding threshold for mesozoo xthresh2zoo =', xthresh2zoo 267 WRITE(numout,*) ' diatoms feeding threshold for mesozoo xthresh2dia =', xthresh2dia 268 WRITE(numout,*) ' nanophyto feeding threshold for mesozoo xthresh2phy =', xthresh2phy 269 WRITE(numout,*) ' poc feeding threshold for mesozoo xthresh2poc =', xthresh2poc 270 WRITE(numout,*) ' feeding threshold for mesozooplankton xthresh2 =', xthresh2 271 WRITE(numout,*) ' exsudation rate of mesozooplankton resrat2 =', resrat2 272 WRITE(numout,*) ' mesozooplankton mortality rate mzrat2 =', mzrat2 273 WRITE(numout,*) ' maximal mesozoo grazing rate grazrat2 =', grazrat2 274 WRITE(numout,*) ' mesozoo flux feeding rate grazflux =', grazflux 275 WRITE(numout,*) ' non assimilated fraction of P by mesozoo unass2 =', unass2 276 WRITE(numout,*) ' Efficicency of Mesozoo growth epsher2 =', epsher2 277 WRITE(numout,*) ' Fraction of mesozoo excretion as DOM sigma2 =', sigma2 278 WRITE(numout,*) ' half sturation constant for grazing 2 xkgraz2 =', xkgraz2 285 279 ENDIF 286 280 -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmicro.F90
r2528 r3294 6 6 !! History : 1.0 ! 2004 (O. Aumont) Original code 7 7 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) F90 8 !! 3.4 ! 2011-06 (O. Aumont, C. Ethe) Quota model for iron 8 9 !!---------------------------------------------------------------------- 9 10 #if defined key_pisces … … 14 15 !! p4z_micro_init : Initialize and read the appropriate namelist 15 16 !!---------------------------------------------------------------------- 16 USE trc17 USE oce_trc !18 USE trc !19 USE sms_pisces !20 USE p rtctl_trc21 USE p4zint 22 USE p4z sink23 USE iom17 USE oce_trc ! shared variables between ocean and passive tracers 18 USE trc ! passive tracers common variables 19 USE sms_pisces ! PISCES Source Minus Sink variables 20 USE p4zlim ! Co-limitations 21 USE p4zsink ! vertical flux of particulate matter due to sinking 22 USE p4zint ! interpolation and computation of various fields 23 USE p4zprod ! production 24 USE prtctl_trc ! print control for debugging 24 25 25 26 IMPLICIT NONE … … 28 29 PUBLIC p4z_micro ! called in p4zbio.F90 29 30 PUBLIC p4z_micro_init ! called in trcsms_pisces.F90 31 PUBLIC p4z_micro_alloc ! called in trcsms_pisces.F90 30 32 31 33 !! * Shared module variables 32 REAL(wp), PUBLIC :: & 33 xpref2c = 0.0_wp , & !: 34 xpref2p = 0.5_wp , & !: 35 xpref2d = 0.5_wp , & !: 36 resrat = 0.03_wp , & !: 37 mzrat = 0.0_wp , & !: 38 grazrat = 4.0_wp , & !: 39 xkgraz = 20E-6_wp , & !: 40 unass = 0.3_wp , & !: 41 sigma1 = 0.6_wp , & !: 42 epsher = 0.33_wp 34 REAL(wp), PUBLIC :: part = 0.5_wp !: part of calcite not dissolved in microzoo guts 35 REAL(wp), PUBLIC :: xpref2c = 0.2_wp !: microzoo preference for POC 36 REAL(wp), PUBLIC :: xpref2p = 1.0_wp !: microzoo preference for nanophyto 37 REAL(wp), PUBLIC :: xpref2d = 0.6_wp !: microzoo preference for diatoms 38 REAL(wp), PUBLIC :: xthreshdia = 1E-8_wp !: diatoms feeding threshold for microzooplankton 39 REAL(wp), PUBLIC :: xthreshphy = 2E-7_wp !: nanophyto threshold for microzooplankton 40 REAL(wp), PUBLIC :: xthreshpoc = 1E-8_wp !: poc threshold for microzooplankton 41 REAL(wp), PUBLIC :: xthresh = 0._wp !: feeding threshold for microzooplankton 42 REAL(wp), PUBLIC :: resrat = 0.03_wp !: exsudation rate of microzooplankton 43 REAL(wp), PUBLIC :: mzrat = 0.0_wp !: microzooplankton mortality rate 44 REAL(wp), PUBLIC :: grazrat = 3.0_wp !: maximal microzoo grazing rate 45 REAL(wp), PUBLIC :: xkgraz = 20E-6_wp !: non assimilated fraction of P by microzoo 46 REAL(wp), PUBLIC :: unass = 0.3_wp !: Efficicency of microzoo growth 47 REAL(wp), PUBLIC :: sigma1 = 0.6_wp !: Fraction of microzoo excretion as DOM 48 REAL(wp), PUBLIC :: epsher = 0.3_wp !: half sturation constant for grazing 1 43 49 44 50 … … 63 69 INTEGER, INTENT(in) :: kt ! ocean time step 64 70 INTEGER :: ji, jj, jk 65 REAL(wp) :: zcompadi, zcompadi2, zcompaz , zcompaph, zcompapoc 66 REAL(wp) :: zgraze , zdenom , zdenom2, zstep 67 REAL(wp) :: zfact , zinano , zidiat, zipoc 71 REAL(wp) :: zcompadi, zcompaz , zcompaph, zcompapoc 72 REAL(wp) :: zgraze , zdenom, zdenom2, zncratio 73 REAL(wp) :: zfact , zstep, zfood, zfoodlim 74 REAL(wp) :: zepshert, zepsherv, zgrarsig, zgraztot, zgraztotf 68 75 REAL(wp) :: zgrarem, zgrafer, zgrapoc, zprcaca, zmortz 69 REAL(wp) :: zrespz, ztortz 76 REAL(wp) :: zrespz, ztortz, zgrasrat 70 77 REAL(wp) :: zgrazp, zgrazm, zgrazsd 71 78 REAL(wp) :: zgrazmf, zgrazsf, zgrazpf 72 79 CHARACTER (len=25) :: charout 73 74 80 !!--------------------------------------------------------------------- 75 76 77 #if defined key_diatrc 78 grazing(:,:,:) = 0. !: Initialisation of grazing 79 #endif 80 81 zstep = rfact2 / rday ! Time step duration for biology 82 81 ! 82 IF( nn_timing == 1 ) CALL timing_start('p4z_micro') 83 ! 84 grazing(:,:,:) = 0. !: grazing set to zero 83 85 DO jk = 1, jpkm1 84 86 DO jj = 1, jpj 85 87 DO ji = 1, jpi 86 zcompaz = MAX( ( trn(ji,jj,jk,jpzoo) - 1.e-9 ), 0.e0 ) 88 zcompaz = MAX( ( trn(ji,jj,jk,jpzoo) - 1.e-8 ), 0.e0 ) 89 zstep = xstep 87 90 # if defined key_degrad 88 zstep = xstep * facvol(ji,jj,jk) 89 # else 90 zstep = xstep 91 zstep = zstep * facvol(ji,jj,jk) 91 92 # endif 92 zfact = zstep * tgfunc (ji,jj,jk) * zcompaz93 zfact = zstep * tgfunc2(ji,jj,jk) * zcompaz 93 94 94 95 ! Respiration rates of both zooplankton 95 96 ! ------------------------------------- 96 zrespz = resrat * zfact * ( 1.+ 3.* nitrfac(ji,jj,jk) )&97 & * trn(ji,jj,jk,jpzoo) / ( xkmort + trn(ji,jj,jk,jpzoo))97 zrespz = resrat * zfact * trn(ji,jj,jk,jpzoo) / ( 2. * xkmort + trn(ji,jj,jk,jpzoo) ) & 98 & + resrat * zfact * 3. * nitrfac(ji,jj,jk) 98 99 99 100 ! Zooplankton mortality. A square function has been selected with … … 102 103 ztortz = mzrat * 1.e6 * zfact * trn(ji,jj,jk,jpzoo) 103 104 104 zcompadi = MAX( ( trn(ji,jj,jk,jpdia) - 1.e-8 ), 0.e0 ) 105 zcompadi2 = MIN( zcompadi, 5.e-7 ) 106 zcompaph = MAX( ( trn(ji,jj,jk,jpphy) - 2.e-7 ), 0.e0 ) 107 zcompapoc = MAX( ( trn(ji,jj,jk,jppoc) - 1.e-8 ), 0.e0 ) 105 zcompadi = MIN( MAX( ( trn(ji,jj,jk,jpdia) - xthreshdia ), 0.e0 ), xsizedia ) 106 zcompaph = MAX( ( trn(ji,jj,jk,jpphy) - xthreshphy ), 0.e0 ) 107 zcompapoc = MAX( ( trn(ji,jj,jk,jppoc) - xthreshpoc ), 0.e0 ) 108 108 109 109 ! Microzooplankton grazing 110 110 ! ------------------------ 111 zdenom2 = 1./ ( xpref2p * zcompaph + xpref2c * zcompapoc + xpref2d * zcompadi2 + rtrn ) 112 113 zgraze = grazrat * zstep * tgfunc(ji,jj,jk) * trn(ji,jj,jk,jpzoo) 114 115 zinano = xpref2p * zcompaph * zdenom2 116 zipoc = xpref2c * zcompapoc * zdenom2 117 zidiat = xpref2d * zcompadi2 * zdenom2 118 119 zdenom = 1./ ( xkgraz + zinano * zcompaph + zipoc * zcompapoc + zidiat * zcompadi2 ) 120 121 zgrazp = zgraze * zinano * zcompaph * zdenom 122 zgrazm = zgraze * zipoc * zcompapoc * zdenom 123 zgrazsd = zgraze * zidiat * zcompadi2 * zdenom 124 125 zgrazpf = zgrazp * trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn) 126 zgrazmf = zgrazm * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 127 zgrazsf = zgrazsd * trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn) 128 #if defined key_diatrc 111 zfood = xpref2p * zcompaph + xpref2c * zcompapoc + xpref2d * zcompadi 112 zfoodlim = MAX( 0. , zfood - xthresh ) 113 zdenom = zfoodlim / ( xkgraz + zfoodlim ) 114 zdenom2 = zdenom / ( zfood + rtrn ) 115 zgraze = grazrat * zstep * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpzoo) 116 117 zgrazp = zgraze * xpref2p * zcompaph * zdenom2 118 zgrazm = zgraze * xpref2c * zcompapoc * zdenom2 119 zgrazsd = zgraze * xpref2d * zcompadi * zdenom2 120 121 zgrazpf = zgrazp * trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn) 122 zgrazmf = zgrazm * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 123 zgrazsf = zgrazsd * trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn) 124 ! 125 zgraztot = zgrazp + zgrazm + zgrazsd 126 zgraztotf = zgrazpf + zgrazsf + zgrazmf 127 129 128 ! Grazing by microzooplankton 130 grazing(ji,jj,jk) = grazing(ji,jj,jk) + zgrazp + zgrazm + zgrazsd 131 #endif 129 grazing(ji,jj,jk) = grazing(ji,jj,jk) + zgraztot 132 130 133 131 ! Various remineralization and excretion terms 134 132 ! -------------------------------------------- 135 zgrarem = ( zgrazp + zgrazm + zgrazsd ) * ( 1.- epsher - unass ) 136 zgrafer = ( zgrazpf + zgrazsf + zgrazmf ) * ( 1.- epsher - unass ) & 137 & + epsher * ( zgrazm * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc)+ rtrn)-ferat3),0.e0) & 138 & + zgrazp * MAX((trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy)+ rtrn)-ferat3),0.e0) & 139 & + zgrazsd * MAX((trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia)+ rtrn)-ferat3),0.e0 ) ) 140 141 zgrapoc = ( zgrazp + zgrazm + zgrazsd ) 133 zgrasrat = zgraztotf / ( zgraztot + rtrn ) 134 zncratio = ( xpref2p * zcompaph * quotan(ji,jj,jk) & 135 & + xpref2d * zcompadi * quotad(ji,jj,jk) + xpref2c * zcompapoc ) / ( zfood + rtrn ) 136 zepshert = epsher * MIN( 1., zncratio ) 137 zepsherv = zepshert * MIN( 1., zgrasrat / ferat3 ) 138 zgrafer = zgraztot * MAX( 0. , ( 1. - unass ) * zgrasrat - ferat3 * zepshert ) 139 zgrarem = zgraztot * ( 1. - zepsherv - unass ) 140 zgrapoc = zgraztot * unass 142 141 143 142 ! Update of the TRA arrays 144 143 ! ------------------------ 145 146 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrar em * sigma1147 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrar em * sigma1148 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem * (1.-sigma1)149 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrar em * sigma1144 zgrarsig = zgrarem * sigma1 145 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarsig 146 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarsig 147 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem - zgrarsig 148 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarsig 150 149 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer 151 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc * unass 152 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarem * sigma1 150 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc 151 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zgraztotf * unass 152 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarsig 153 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zgrarsig 153 154 #if defined key_kriest 154 tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc * unass *xkr_ddiat155 tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc * xkr_ddiat 155 156 #endif 156 157 !158 157 ! Update the arrays TRA which contain the biological sources and sinks 159 158 ! -------------------------------------------------------------------- 160 161 159 zmortz = ztortz + zrespz 162 tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zmortz + epsher * zgrapoc160 tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zmortz + zepsherv * zgraztot 163 161 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazp 164 162 tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazsd … … 170 168 tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazsf 171 169 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortz - zgrazm 172 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz + unass * ( zgrazpf + zgrazsf ) - (1.-unass) * zgrazmf 173 zprcaca = xfracal(ji,jj,jk) * unass * zgrazp 174 #if defined key_diatrc 170 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz - zgrazmf 171 zprcaca = xfracal(ji,jj,jk) * zgrazp 172 ! 173 ! calcite production 175 174 prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 176 #endif 175 ! 177 176 zprcaca = part * zprcaca 178 177 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca … … 191 190 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 192 191 ENDIF 193 192 ! 193 IF( nn_timing == 1 ) CALL timing_stop('p4z_micro') 194 ! 194 195 END SUBROUTINE p4z_micro 195 196 … … 203 204 !! 204 205 !! ** Method : Read the nampiszoo namelist and check the parameters 205 !! called at the first timestep (nit000)206 !! called at the first timestep (nittrc000) 206 207 !! 207 208 !! ** input : Namelist nampiszoo … … 209 210 !!---------------------------------------------------------------------- 210 211 211 NAMELIST/nampiszoo/ grazrat,resrat,mzrat,xpref2c, xpref2p, & 212 & xpref2d, xkgraz, epsher, sigma1, unass 213 214 REWIND( numnat ) ! read numnat 215 READ ( numnat, nampiszoo ) 212 NAMELIST/nampiszoo/ part, grazrat, resrat, mzrat, xpref2c, xpref2p, & 213 & xpref2d, xthreshdia, xthreshphy, xthreshpoc, & 214 & xthresh, xkgraz, epsher, sigma1, unass 215 216 REWIND( numnatp ) ! read numnatp 217 READ ( numnatp, nampiszoo ) 216 218 217 219 IF(lwp) THEN ! control print … … 219 221 WRITE(numout,*) ' Namelist parameters for microzooplankton, nampiszoo' 220 222 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 221 WRITE(numout,*) ' zoo preference for POC xpref2c =', xpref2c 222 WRITE(numout,*) ' zoo preference for nano xpref2p =', xpref2p 223 WRITE(numout,*) ' zoo preference for diatoms xpref2d =', xpref2d 224 WRITE(numout,*) ' exsudation rate of microzooplankton resrat =', resrat 225 WRITE(numout,*) ' microzooplankton mortality rate mzrat =', mzrat 226 WRITE(numout,*) ' maximal microzoo grazing rate grazrat =', grazrat 227 WRITE(numout,*) ' non assimilated fraction of P by microzoo unass =', unass 228 WRITE(numout,*) ' Efficicency of microzoo growth epsher =', epsher 229 WRITE(numout,*) ' Fraction of microzoo excretion as DOM sigma1 =', sigma1 230 WRITE(numout,*) ' half sturation constant for grazing 1 xkgraz =', xkgraz 223 WRITE(numout,*) ' part of calcite not dissolved in microzoo guts part =', part 224 WRITE(numout,*) ' microzoo preference for POC xpref2c =', xpref2c 225 WRITE(numout,*) ' microzoo preference for nano xpref2p =', xpref2p 226 WRITE(numout,*) ' microzoo preference for diatoms xpref2d =', xpref2d 227 WRITE(numout,*) ' diatoms feeding threshold for microzoo xthreshdia =', xthreshdia 228 WRITE(numout,*) ' nanophyto feeding threshold for microzoo xthreshphy =', xthreshphy 229 WRITE(numout,*) ' poc feeding threshold for microzoo xthreshpoc =', xthreshpoc 230 WRITE(numout,*) ' feeding threshold for microzooplankton xthresh =', xthresh 231 WRITE(numout,*) ' exsudation rate of microzooplankton resrat =', resrat 232 WRITE(numout,*) ' microzooplankton mortality rate mzrat =', mzrat 233 WRITE(numout,*) ' maximal microzoo grazing rate grazrat =', grazrat 234 WRITE(numout,*) ' non assimilated fraction of P by microzoo unass =', unass 235 WRITE(numout,*) ' Efficicency of microzoo growth epsher =', epsher 236 WRITE(numout,*) ' Fraction of microzoo excretion as DOM sigma1 =', sigma1 237 WRITE(numout,*) ' half sturation constant for grazing 1 xkgraz =', xkgraz 231 238 ENDIF 232 239 233 240 END SUBROUTINE p4z_micro_init 241 242 INTEGER FUNCTION p4z_micro_alloc() 243 !!---------------------------------------------------------------------- 244 !! *** ROUTINE p4z_micro_alloc *** 245 !!---------------------------------------------------------------------- 246 ALLOCATE( grazing(jpi,jpj,jpk), STAT=p4z_micro_alloc ) 247 IF( p4z_micro_alloc /= 0 ) CALL ctl_warn('p4z_micro_alloc : failed to allocate arrays.') 248 249 END FUNCTION p4z_micro_alloc 234 250 235 251 #else -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmort.F90
r2528 r3294 14 14 !! p4z_mort_init : Initialize the mortality params for phytoplankton 15 15 !!---------------------------------------------------------------------- 16 USE trc 17 USE oce_trc ! 18 USE trc ! 19 USE sms_pisces ! 20 USE p4zsink 21 USE prtctl_trc 16 USE oce_trc ! shared variables between ocean and passive tracers 17 USE trc ! passive tracers common variables 18 USE sms_pisces ! PISCES Source Minus Sink variables 19 USE p4zsink ! vertical flux of particulate matter due to sinking 20 USE prtctl_trc ! print control for debugging 22 21 23 22 IMPLICIT NONE … … 27 26 PUBLIC p4z_mort_init 28 27 29 30 28 !! * Shared module variables 31 REAL(wp), PUBLIC :: & 32 wchl = 0.001_wp , & !: 33 wchld = 0.02_wp , & !: 34 mprat = 0.01_wp , & !: 35 mprat2 = 0.01_wp , & !: 36 mpratm = 0.01_wp !: 29 REAL(wp), PUBLIC :: wchl = 0.001_wp !: 30 REAL(wp), PUBLIC :: wchld = 0.02_wp !: 31 REAL(wp), PUBLIC :: mprat = 0.01_wp !: 32 REAL(wp), PUBLIC :: mprat2 = 0.01_wp !: 33 REAL(wp), PUBLIC :: mpratm = 0.01_wp !: 37 34 38 35 … … 80 77 CHARACTER (len=25) :: charout 81 78 !!--------------------------------------------------------------------- 82 83 84 #if defined key_diatrc 85 prodcal(:,:,:) = 0. !: Initialisation of calcite production variable 86 #endif 87 79 ! 80 IF( nn_timing == 1 ) CALL timing_start('p4z_nano') 81 ! 82 prodcal(:,:,:) = 0. !: calcite production variable set to zero 88 83 DO jk = 1, jpkm1 89 84 DO jj = 1, jpj 90 85 DO ji = 1, jpi 91 92 86 zcompaph = MAX( ( trn(ji,jj,jk,jpphy) - 1e-8 ), 0.e0 ) 93 87 zstep = xstep 94 88 # if defined key_degrad 95 zstep = xstep * facvol(ji,jj,jk) 96 # else 97 zstep = xstep 89 zstep = zstep * facvol(ji,jj,jk) 98 90 # endif 99 91 ! Squared mortality of Phyto similar to a sedimentation term during … … 117 109 tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zmortp * zfactfe 118 110 zprcaca = xfracal(ji,jj,jk) * zmortp 119 #if defined key_diatrc 111 ! 120 112 prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 121 #endif 113 ! 122 114 zfracal = 0.5 * xfracal(ji,jj,jk) 123 115 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca … … 143 135 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 144 136 ENDIF 145 137 ! 138 IF( nn_timing == 1 ) CALL timing_stop('p4z_nano') 139 ! 146 140 END SUBROUTINE p4z_nano 147 141 … … 158 152 REAL(wp) :: zrespp2, ztortp2, zmortp2, zstep 159 153 CHARACTER (len=25) :: charout 160 161 !!--------------------------------------------------------------------- 162 154 !!--------------------------------------------------------------------- 155 ! 156 IF( nn_timing == 1 ) CALL timing_start('p4z_diat') 157 ! 163 158 164 159 ! Aggregation term for diatoms is increased in case of nutrient … … 177 172 ! sticky and coagulate to sink quickly out of the euphotic zone 178 173 ! ------------------------------------------------------------ 179 174 zstep = xstep 180 175 # if defined key_degrad 181 zstep = xstep * facvol(ji,jj,jk) 182 # else 183 zstep = xstep 176 zstep = zstep * facvol(ji,jj,jk) 184 177 # endif 185 178 ! Phytoplankton respiration … … 219 212 END DO 220 213 ! 221 214 IF(ln_ctl) THEN ! print mean trends (used for debugging) 222 215 WRITE(charout, FMT="('diat')") 223 216 CALL prt_ctl_trc_info(charout) 224 217 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 225 ENDIF 226 218 ENDIF 219 ! 220 IF( nn_timing == 1 ) CALL timing_stop('p4z_diat') 221 ! 227 222 END SUBROUTINE p4z_diat 228 223 … … 243 238 NAMELIST/nampismort/ wchl, wchld, mprat, mprat2, mpratm 244 239 245 REWIND( numnat ) ! read numnat246 READ ( numnat , nampismort )240 REWIND( numnatp ) ! read numnatp 241 READ ( numnatp, nampismort ) 247 242 248 243 IF(lwp) THEN ! control print -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zopt.F90
r2715 r3294 7 7 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) F90 8 8 !! 3.2 ! 2009-04 (C. Ethe, G. Madec) optimisation 9 !! 3.4 ! 2011-06 (O. Aumont, C. Ethe) Improve light availability of nano & diat 9 10 !!---------------------------------------------------------------------- 10 11 #if defined key_pisces … … 17 18 USE oce_trc ! tracer-ocean share variables 18 19 USE sms_pisces ! Source Minus Sink of PISCES 19 USE iom 20 USE iom ! I/O manager 20 21 21 22 IMPLICIT NONE … … 52 53 !! ** Method : - ??? 53 54 !!--------------------------------------------------------------------- 54 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released55 USE wrk_nemo, ONLY: zdepmoy => wrk_2d_1 , zetmp => wrk_2d_256 USE wrk_nemo, ONLY: zekg => wrk_3d_2 , zekr => wrk_3d_3 , zekb => wrk_3d_457 USE wrk_nemo, ONLY: ze0 => wrk_3d_5 , ze1 => wrk_3d_658 USE wrk_nemo, ONLY: ze2 => wrk_3d_7 , ze3 => wrk_3d_859 55 ! 60 56 INTEGER, INTENT(in) :: kt, jnt ! ocean time step … … 63 59 INTEGER :: irgb 64 60 REAL(wp) :: zchl, zxsi0r 65 REAL(wp) :: zc0 , zc1 , zc2, zc3 61 REAL(wp) :: zc0 , zc1 , zc2, zc3, z1_dep 62 REAL(wp), POINTER, DIMENSION(:,: ) :: zdepmoy, zetmp, zetmp1, zetmp2 63 REAL(wp), POINTER, DIMENSION(:,:,:) :: zekg, zekr, zekb, ze0, ze1, ze2, ze3 66 64 !!--------------------------------------------------------------------- 67 68 IF( wrk_in_use(2, 1,2) .OR. wrk_in_use(3, 2,3,4,5,6,7,8) ) THEN 69 CALL ctl_stop('p4z_opt: requested workspace arrays unavailable') ; RETURN 70 ENDIF 65 ! 66 IF( nn_timing == 1 ) CALL timing_start('p4z_opt') 67 ! 68 ! Allocate temporary workspace 69 CALL wrk_alloc( jpi, jpj, zdepmoy, zetmp, zetmp1, zetmp2 ) 70 CALL wrk_alloc( jpi, jpj, jpk, zekg, zekr, zekb, ze0, ze1, ze2, ze3 ) 71 71 72 72 ! Initialisation of variables used to compute PAR … … 83 83 DO ji = 1, jpi 84 84 zchl = ( trn(ji,jj,jk,jpnch) + trn(ji,jj,jk,jpdch) + rtrn ) * 1.e6 85 zchl = MIN( 10. , MAX( 0.0 3, zchl ) )85 zchl = MIN( 10. , MAX( 0.05, zchl ) ) 86 86 irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn ) 87 87 ! … … 92 92 END DO 93 93 END DO 94 95 !!gm Potential BUG must discuss with Olivier about this implementation....96 !!gm the questions are : - PAR at T-point or mean PAR over T-level....97 !!gm - shallow water: no penetration of light through the bottom....98 94 99 95 … … 145 141 etot3(:,:,1) = qsr(:,:) * tmask(:,:,1) 146 142 ! 147 DO jk = 2, nksrp +1143 DO jk = 2, nksrp + 1 148 144 !CDIR NOVERRCHK 149 145 DO jj = 1, jpj … … 188 184 zdepmoy(:,:) = 0.e0 ! ------------------------------- 189 185 zetmp (:,:) = 0.e0 190 emoy (:,:,:) = 0.e0 186 zetmp1 (:,:) = 0.e0 187 zetmp2 (:,:) = 0.e0 191 188 192 189 DO jk = 1, nksrp … … 196 193 DO ji = 1, jpi 197 194 IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 198 zetmp (ji,jj) = zetmp (ji,jj) + etot(ji,jj,jk) * fse3t(ji,jj,jk) 195 zetmp (ji,jj) = zetmp (ji,jj) + etot (ji,jj,jk) * fse3t(ji,jj,jk) 196 zetmp1 (ji,jj) = zetmp1 (ji,jj) + enano(ji,jj,jk) * fse3t(ji,jj,jk) 197 zetmp2 (ji,jj) = zetmp2 (ji,jj) + ediat(ji,jj,jk) * fse3t(ji,jj,jk) 199 198 zdepmoy(ji,jj) = zdepmoy(ji,jj) + fse3t(ji,jj,jk) 200 199 ENDIF … … 210 209 !CDIR NOVERRCHK 211 210 DO ji = 1, jpi 212 IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) emoy(ji,jj,jk) = zetmp(ji,jj) / ( zdepmoy(ji,jj) + rtrn ) 213 END DO 214 END DO 215 END DO 216 217 #if defined key_diatrc 218 # if ! defined key_iomput 219 ! save for outputs 220 trc2d(:,:, jp_pcs0_2d + 10) = heup(:,: ) * tmask(:,:,1) 221 trc3d(:,:,:,jp_pcs0_3d + 3) = etot(:,:,:) * tmask(:,:,:) 222 # else 223 ! write diagnostics 224 IF( jnt == nrdttrc ) then 225 CALL iom_put( "Heup", heup(:,: ) * tmask(:,:,1) ) ! euphotic layer deptht 226 CALL iom_put( "PAR" , etot(:,:,:) * tmask(:,:,:) ) ! Photosynthetically Available Radiation 211 IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 212 z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 213 emoy (ji,jj,jk) = zetmp (ji,jj) * z1_dep 214 enano(ji,jj,jk) = zetmp1(ji,jj) * z1_dep 215 ediat(ji,jj,jk) = zetmp2(ji,jj) * z1_dep 216 ENDIF 217 END DO 218 END DO 219 END DO 220 221 IF( ln_diatrc ) THEN ! save output diagnostics 222 ! 223 IF( lk_iomput ) THEN 224 IF( jnt == nrdttrc ) THEN 225 CALL iom_put( "Heup", heup(:,: ) * tmask(:,:,1) ) ! euphotic layer deptht 226 CALL iom_put( "PAR" , etot(:,:,:) * tmask(:,:,:) ) ! Photosynthetically Available Radiation 227 ENDIF 228 ELSE 229 trc2d(:,:, jp_pcs0_2d + 10) = heup(:,: ) * tmask(:,:,1) 230 trc3d(:,:,:,jp_pcs0_3d + 3) = etot(:,:,:) * tmask(:,:,:) 231 ENDIF 232 ! 227 233 ENDIF 228 # endif 229 #endif 230 !231 IF( wrk_not_released(2, 1,2) .OR. &232 wrk_not_released(3, 2,3,4,5,6,7,8) ) CALL ctl_stop('p4z_opt: failed to release workspace arrays')234 ! 235 CALL wrk_dealloc( jpi, jpj, zdepmoy, zetmp, zetmp1, zetmp2 ) 236 CALL wrk_dealloc( jpi, jpj, jpk, zekg, zekr, zekb, ze0, ze1, ze2, ze3 ) 237 ! 238 IF( nn_timing == 1 ) CALL timing_stop('p4z_opt') 233 239 ! 234 240 END SUBROUTINE p4z_opt … … 241 247 !! ** Purpose : Initialization of tabulated attenuation coef 242 248 !!---------------------------------------------------------------------- 249 ! 250 IF( nn_timing == 1 ) CALL timing_start('p4z_opt_init') 243 251 ! 244 252 CALL trc_oce_rgb( xkrgb ) ! tabulated attenuation coefficients … … 252 260 IF( ln_qsr_bio ) etot3(:,:,:) = 0._wp 253 261 ! 262 IF( nn_timing == 1 ) CALL timing_stop('p4z_opt_init') 263 ! 254 264 END SUBROUTINE p4z_opt_init 255 265 -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zprod.F90
r2730 r3294 2 2 !!====================================================================== 3 3 !! *** MODULE p4zprod *** 4 !! TOP : PISCES4 !! TOP : Growth Rate of the two phytoplanktons groups 5 5 !!====================================================================== 6 6 !! History : 1.0 ! 2004 (O. Aumont) Original code 7 7 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) F90 8 !! 3.4 ! 2011-05 (O. Aumont, C. Ethe) New parameterization of light limitation 8 9 !!---------------------------------------------------------------------- 9 10 #if defined key_pisces … … 11 12 !! 'key_pisces' PISCES bio-model 12 13 !!---------------------------------------------------------------------- 13 !! p4z_prod : 14 !! p4z_prod : Compute the growth Rate of the two phytoplanktons groups 15 !! p4z_prod_init : Initialization of the parameters for growth 16 !! p4z_prod_alloc : Allocate variables for growth 14 17 !!---------------------------------------------------------------------- 15 USE trc 16 USE oce_trc ! 17 USE sms_pisces ! 18 USE prtctl_trc 19 USE p4zopt 20 USE p4zint 21 USE p4zlim 22 USE iom 18 USE oce_trc ! shared variables between ocean and passive tracers 19 USE trc ! passive tracers common variables 20 USE sms_pisces ! PISCES Source Minus Sink variables 21 USE p4zopt ! optical model 22 USE p4zlim ! Co-limitations of differents nutrients 23 USE prtctl_trc ! print control for debugging 24 USE iom ! I/O manager 23 25 24 26 IMPLICIT NONE … … 29 31 PUBLIC p4z_prod_alloc 30 32 31 REAL(wp), PUBLIC :: & 32 pislope = 3.0_wp , & !: 33 pislope2 = 3.0_wp , & !: 34 excret = 10.e-5_wp , & !: 35 excret2 = 0.05_wp , & !: 36 chlcnm = 0.033_wp , & !: 37 chlcdm = 0.05_wp , & !: 38 fecnm = 10.E-6_wp , & !: 39 fecdm = 15.E-6_wp , & !: 40 grosip = 0.151_wp 41 42 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: prmax !: 33 !! * Shared module variables 34 LOGICAL , PUBLIC :: ln_newprod = .FALSE. 35 REAL(wp), PUBLIC :: pislope = 3.0_wp !: 36 REAL(wp), PUBLIC :: pislope2 = 3.0_wp !: 37 REAL(wp), PUBLIC :: excret = 10.e-5_wp !: 38 REAL(wp), PUBLIC :: excret2 = 0.05_wp !: 39 REAL(wp), PUBLIC :: bresp = 0.00333_wp !: 40 REAL(wp), PUBLIC :: chlcnm = 0.033_wp !: 41 REAL(wp), PUBLIC :: chlcdm = 0.05_wp !: 42 REAL(wp), PUBLIC :: chlcmin = 0.00333_wp !: 43 REAL(wp), PUBLIC :: fecnm = 10.E-6_wp !: 44 REAL(wp), PUBLIC :: fecdm = 15.E-6_wp !: 45 REAL(wp), PUBLIC :: grosip = 0.151_wp !: 46 47 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: prmax !: optimal production = f(temperature) 48 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: quotan !: proxy of N quota in Nanophyto 49 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: quotad !: proxy of N quota in diatomee 43 50 44 REAL(wp) :: &45 rday1 , & !: 0.6 / rday46 texcret , & !: 1 - excret47 texcret2 , & !: 1 - excret248 tpp !: Total primary production 51 REAL(wp) :: r1_rday !: 1 / rday 52 REAL(wp) :: texcret !: 1 - excret 53 REAL(wp) :: texcret2 !: 1 - excret2 54 REAL(wp) :: tpp !: Total primary production 55 49 56 50 57 !!* Substitution … … 66 73 !! ** Method : - ??? 67 74 !!--------------------------------------------------------------------- 68 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released69 USE wrk_nemo, ONLY: zmixnano => wrk_2d_1 , zmixdiat => wrk_2d_2 , zstrn => wrk_2d_370 USE wrk_nemo, ONLY: zpislopead => wrk_3d_2 , zpislopead2 => wrk_3d_371 USE wrk_nemo, ONLY: zprdia => wrk_3d_4 , zprbio => wrk_3d_5 , zysopt => wrk_3d_672 USE wrk_nemo, ONLY: zprorca => wrk_3d_7 , zprorcad => wrk_3d_873 USE wrk_nemo, ONLY: zprofed => wrk_3d_9 , zprofen => wrk_3d_1074 USE wrk_nemo, ONLY: zprochln => wrk_3d_11 , zprochld => wrk_3d_1275 USE wrk_nemo, ONLY: zpronew => wrk_3d_13 , zpronewd => wrk_3d_1476 75 ! 77 76 INTEGER, INTENT(in) :: kt, jnt 78 77 ! 79 78 INTEGER :: ji, jj, jk 80 REAL(wp) :: zsilfac, zfact 81 REAL(wp) :: z prdiachl, zprbiochl, zsilim, ztn, zadap, zadap282 REAL(wp) :: zlim, zsilfac2, zsiborn, zprod, z etot2, zmax, zproreg, zproreg283 REAL(wp) :: zmxltst, zmxlday, z lim179 REAL(wp) :: zsilfac, zfact, znanotot, zdiattot, zconctemp, zconctemp2 80 REAL(wp) :: zratio, zmax, zsilim, ztn, zadap 81 REAL(wp) :: zlim, zsilfac2, zsiborn, zprod, zproreg, zproreg2 82 REAL(wp) :: zmxltst, zmxlday, zmaxday 84 83 REAL(wp) :: zpislopen , zpislope2n 85 REAL(wp) :: zrum, zcodel, zargu, zval, zvol 86 #if defined key_diatrc 84 REAL(wp) :: zrum, zcodel, zargu, zval 87 85 REAL(wp) :: zrfact2 88 #endif89 86 CHARACTER (len=25) :: charout 87 REAL(wp), POINTER, DIMENSION(:,: ) :: zmixnano, zmixdiat, zstrn 88 REAL(wp), POINTER, DIMENSION(:,:,:) :: zpislopead, zpislopead2, zprdia, zprbio, zprdch, zprnch, zysopt 89 REAL(wp), POINTER, DIMENSION(:,:,:) :: zprorca, zprorcad, zprofed, zprofen, zprochln, zprochld, zpronew, zpronewd 90 90 !!--------------------------------------------------------------------- 91 92 IF( wrk_in_use(2, 1,2,3) .OR. & 93 wrk_in_use(3, 2,3,4,5,6,7,8,9,10,11,12,13,14) ) THEN 94 CALL ctl_stop('p4z_prod: requested workspace arrays unavailable') ; RETURN 95 ENDIF 96 91 ! 92 IF( nn_timing == 1 ) CALL timing_start('p4z_prod') 93 ! 94 ! Allocate temporary workspace 95 CALL wrk_alloc( jpi, jpj, zmixnano, zmixdiat, zstrn ) 96 CALL wrk_alloc( jpi, jpj, jpk, zpislopead, zpislopead2, zprdia, zprbio, zprdch, zprnch, zysopt ) 97 CALL wrk_alloc( jpi, jpj, jpk, zprorca, zprorcad, zprofed, zprofen, zprochln, zprochld, zpronew, zpronewd ) 98 ! 97 99 zprorca (:,:,:) = 0._wp 98 100 zprorcad(:,:,:) = 0._wp … … 105 107 zprdia (:,:,:) = 0._wp 106 108 zprbio (:,:,:) = 0._wp 109 zprdch (:,:,:) = 0._wp 110 zprnch (:,:,:) = 0._wp 107 111 zysopt (:,:,:) = 0._wp 108 112 109 113 ! Computation of the optimal production 110 # if defined key_degrad 111 prmax(:,:,:) = rday1 * tgfunc(:,:,:) * facvol(:,:,:) 112 # else 113 prmax(:,:,:) = rday1 * tgfunc(:,:,:) 114 # endif 114 prmax(:,:,:) = 0.6_wp * r1_rday * tgfunc(:,:,:) 115 IF( lk_degrad ) prmax(:,:,:) = prmax(:,:,:) * facvol(:,:,:) 115 116 116 117 ! compute the day length depending on latitude and the day … … 119 120 120 121 ! day length in hours 121 zstrn(:,:) = 0. _wp122 zstrn(:,:) = 0. 122 123 DO jj = 1, jpj 123 124 DO ji = 1, jpi 124 125 zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad ) 125 126 zargu = MAX( -1., MIN( 1., zargu ) ) 126 zval = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. ) 127 IF( zval < 1.e0 ) zval = 24. 128 zstrn(ji,jj) = 24. / zval 127 zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. ) 129 128 END DO 130 129 END DO 131 130 132 131 IF( ln_newprod ) THEN 132 ! Impact of the day duration on phytoplankton growth 133 DO jk = 1, jpkm1 134 DO jj = 1 ,jpj 135 DO ji = 1, jpi 136 zval = MAX( 1., zstrn(ji,jj) ) 137 zval = 1.5 * zval / ( 12. + zval ) 138 zprbio(ji,jj,jk) = prmax(ji,jj,jk) * zval 139 zprdia(ji,jj,jk) = zprbio(ji,jj,jk) 140 END DO 141 END DO 142 END DO 143 ENDIF 144 145 ! Maximum light intensity 146 WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24. 147 zstrn(:,:) = 24. / zstrn(:,:) 148 149 IF( ln_newprod ) THEN 150 !CDIR NOVERRCHK 151 DO jk = 1, jpkm1 152 !CDIR NOVERRCHK 153 DO jj = 1, jpj 154 !CDIR NOVERRCHK 155 DO ji = 1, jpi 156 157 ! Computation of the P-I slope for nanos and diatoms 158 IF( etot(ji,jj,jk) > 1.E-3 ) THEN 159 ztn = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 160 zadap = ztn / ( 2.+ ztn ) 161 162 zconctemp = MAX( 0.e0 , trn(ji,jj,jk,jpdia) - 5e-7 ) 163 zconctemp2 = trn(ji,jj,jk,jpdia) - zconctemp 164 165 znanotot = enano(ji,jj,jk) * zstrn(ji,jj) 166 zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj) 167 168 zfact = EXP( -0.21 * znanotot ) 169 zpislopead (ji,jj,jk) = pislope * ( 1.+ zadap * zfact ) & 170 & * trn(ji,jj,jk,jpnch) /( trn(ji,jj,jk,jpphy) * 12. + rtrn) 171 172 zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp) / ( trn(ji,jj,jk,jpdia) + rtrn ) & 173 & * trn(ji,jj,jk,jpdch) /( trn(ji,jj,jk,jpdia) * 12. + rtrn) 174 175 ! Computation of production function for Carbon 176 ! --------------------------------------------- 177 zpislopen = zpislopead (ji,jj,jk) / ( ( r1_rday + bresp * r1_rday / chlcnm ) * rday + rtrn) 178 zpislope2n = zpislopead2(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday / chlcdm ) * rday + rtrn) 179 zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * znanotot ) ) 180 zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpislope2n * zdiattot ) ) 181 182 ! Computation of production function for Chlorophyll 183 !-------------------------------------------------- 184 zmaxday = 1._wp / ( prmax(ji,jj,jk) * rday + rtrn ) 185 zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopead (ji,jj,jk) * zmaxday * znanotot ) ) 186 zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopead2(ji,jj,jk) * zmaxday * zdiattot ) ) 187 ENDIF 188 END DO 189 END DO 190 END DO 191 ELSE 192 !CDIR NOVERRCHK 193 DO jk = 1, jpkm1 194 !CDIR NOVERRCHK 195 DO jj = 1, jpj 196 !CDIR NOVERRCHK 197 DO ji = 1, jpi 198 199 ! Computation of the P-I slope for nanos and diatoms 200 IF( etot(ji,jj,jk) > 1.E-3 ) THEN 201 ztn = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 202 zadap = ztn / ( 2.+ ztn ) 203 204 zfact = EXP( -0.21 * enano(ji,jj,jk) ) 205 zpislopead (ji,jj,jk) = pislope * ( 1.+ zadap * zfact ) 206 zpislopead2(ji,jj,jk) = pislope2 207 208 zpislopen = zpislopead(ji,jj,jk) * trn(ji,jj,jk,jpnch) & 209 & / ( trn(ji,jj,jk,jpphy) * 12. + rtrn ) & 210 & / ( prmax(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn ) 211 212 zpislope2n = zpislopead2(ji,jj,jk) * trn(ji,jj,jk,jpdch) & 213 & / ( trn(ji,jj,jk,jpdia) * 12. + rtrn ) & 214 & / ( prmax(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn ) 215 216 ! Computation of production function for Carbon 217 ! --------------------------------------------- 218 zprbio(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) ) 219 zprdia(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope2n * ediat(ji,jj,jk) ) ) 220 221 ! Computation of production function for Chlorophyll 222 !-------------------------------------------------- 223 zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) * zstrn(ji,jj) ) ) 224 zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope2n * ediat(ji,jj,jk) * zstrn(ji,jj) ) ) 225 ENDIF 226 END DO 227 END DO 228 END DO 229 ENDIF 230 231 ! Computation of a proxy of the N/C ratio 232 ! --------------------------------------- 133 233 !CDIR NOVERRCHK 134 234 DO jk = 1, jpkm1 … … 137 237 !CDIR NOVERRCHK 138 238 DO ji = 1, jpi 139 140 ! Computation of the P-I slope for nanos and diatoms 141 IF( etot(ji,jj,jk) > 1.E-3 ) THEN 142 ztn = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 143 zadap = 0.+ 1.* ztn / ( 2.+ ztn ) 144 zadap2 = 0.e0 145 146 zfact = EXP( -0.21 * emoy(ji,jj,jk) ) 147 148 zpislopead (ji,jj,jk) = pislope * ( 1.+ zadap * zfact ) 149 zpislopead2(ji,jj,jk) = pislope2 * ( 1.+ zadap2 * zfact ) 150 151 zpislopen = zpislopead(ji,jj,jk) * trn(ji,jj,jk,jpnch) & 152 & / ( trn(ji,jj,jk,jpphy) * 12. + rtrn ) & 153 & / ( prmax(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn ) 154 155 zpislope2n = zpislopead2(ji,jj,jk) * trn(ji,jj,jk,jpdch) & 156 & / ( trn(ji,jj,jk,jpdia) * 12. + rtrn ) & 157 & / ( prmax(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn ) 158 159 ! Computation of production function 160 zprbio(ji,jj,jk) = prmax(ji,jj,jk) * & 161 & ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) ) 162 zprdia(ji,jj,jk) = prmax(ji,jj,jk) * & 163 & ( 1.- EXP( -zpislope2n * ediat(ji,jj,jk) ) ) 164 ENDIF 239 zval = ( xnanonh4(ji,jj,jk) + xnanono3(ji,jj,jk) ) * prmax(ji,jj,jk) / ( zprbio(ji,jj,jk) + rtrn ) 240 quotan(ji,jj,jk) = MIN( 1., 0.5 + 0.5 * zval ) 241 zval = ( xdiatnh4(ji,jj,jk) + xdiatno3(ji,jj,jk) ) * prmax(ji,jj,jk) / ( zprdia(ji,jj,jk) + rtrn ) 242 quotad(ji,jj,jk) = MIN( 1., 0.5 + 0.5 * zval ) 165 243 END DO 166 244 END DO … … 178 256 ! Si/C is arbitrariliy increased for very high Si concentrations 179 257 ! to mimic the very high ratios observed in the Southern Ocean (silpot2) 180 181 zlim1 = trn(ji,jj,jk,jpsil) / ( trn(ji,jj,jk,jpsil) + xksi1 ) 182 zlim = xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) 183 184 zsilim = MIN( zprdia(ji,jj,jk) / ( rtrn + prmax(ji,jj,jk) ), & 185 & trn(ji,jj,jk,jpfer) / ( concdfe(ji,jj,jk) + trn(ji,jj,jk,jpfer) ), & 186 & trn(ji,jj,jk,jppo4) / ( concdnh4 + trn(ji,jj,jk,jppo4) ), & 187 & zlim ) 188 zsilfac = 5.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim1 - 0.5 ) ) ) + 1.e0 258 zlim = trn(ji,jj,jk,jpsil) / ( trn(ji,jj,jk,jpsil) + xksi1 ) 259 zsilim = MIN( zprdia(ji,jj,jk) / ( prmax(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) ) 260 zsilfac = 4.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) ) ) + 1.e0 189 261 zsiborn = MAX( 0.e0, ( trn(ji,jj,jk,jpsil) - 15.e-6 ) ) 190 zsilfac2 = 1.+ 3.* zsiborn / ( zsiborn + xksi2 )191 zsilfac = MIN( 6.4,zsilfac * zsilfac2)192 zysopt(ji,jj,jk) = grosip * zlim 1* zsilfac262 zsilfac2 = 1.+ 2.* zsiborn / ( zsiborn + xksi2 ) 263 zsilfac = MIN( 5.4, zsilfac * zsilfac2) 264 zysopt(ji,jj,jk) = grosip * zlim * zsilfac 193 265 ENDIF 194 266 END DO … … 196 268 END DO 197 269 198 ! Computation of the limitation term due to 199 ! A mixed layer deeper than the euphotic depth 270 ! Computation of the limitation term due to a mixed layer deeper than the euphotic depth 200 271 DO jj = 1, jpj 201 272 DO ji = 1, jpi 202 273 zmxltst = MAX( 0.e0, hmld(ji,jj) - heup(ji,jj) ) 203 zmxlday = zmxltst **2 /rday204 zmixnano(ji,jj) = 1. - zmxlday / ( 1.+ zmxlday )205 zmixdiat(ji,jj) = 1. - zmxlday / ( 3.+ zmxlday )274 zmxlday = zmxltst * zmxltst * r1_rday 275 zmixnano(ji,jj) = 1. - zmxlday / ( 3. + zmxlday ) 276 zmixdiat(ji,jj) = 1. - zmxlday / ( 4. + zmxlday ) 206 277 END DO 207 278 END DO … … 219 290 END DO 220 291 221 222 !CDIR NOVERRCHK 223 DO jk = 1, jpkm1 224 !CDIR NOVERRCHK 225 DO jj = 1, jpj 226 !CDIR NOVERRCHK 227 DO ji = 1, jpi 228 229 IF( etot(ji,jj,jk) > 1.E-3 ) THEN 230 ! Computation of the various production terms for nanophyto. 231 zetot2 = enano(ji,jj,jk) * zstrn(ji,jj) 232 zmax = MAX( 0.1, xlimphy(ji,jj,jk) ) 233 zpislopen = zpislopead(ji,jj,jk) & 234 & * trn(ji,jj,jk,jpnch) / ( rtrn + trn(ji,jj,jk,jpphy) * 12.) & 235 & / ( prmax(ji,jj,jk) * rday * zmax + rtrn ) 236 237 zprbiochl = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen * zetot2 ) ) 238 239 zprorca(ji,jj,jk) = zprbio(ji,jj,jk) * xlimphy(ji,jj,jk) * trn(ji,jj,jk,jpphy) * rfact2 240 241 zpronew(ji,jj,jk) = zprorca(ji,jj,jk) * xnanono3(ji,jj,jk) & 242 & / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn ) 243 zprod = rday * zprorca(ji,jj,jk) * zprbiochl * trn(ji,jj,jk,jpphy) *zmax 244 245 zprofen(ji,jj,jk) = (fecnm)**2 * zprod / chlcnm & 246 & / ( zpislopead(ji,jj,jk) * zetot2 * trn(ji,jj,jk,jpnfe) + rtrn ) 247 248 zprochln(ji,jj,jk) = chlcnm * 144. * zprod & 249 & / ( zpislopead(ji,jj,jk) * zetot2 * trn(ji,jj,jk,jpnch) + rtrn ) 250 ENDIF 251 END DO 252 END DO 253 END DO 254 292 ! Computation of the various production terms 255 293 !CDIR NOVERRCHK 256 294 DO jk = 1, jpkm1 … … 260 298 DO ji = 1, jpi 261 299 IF( etot(ji,jj,jk) > 1.E-3 ) THEN 262 ! Computation of the various production terms for diatoms 263 zetot2 = ediat(ji,jj,jk) * zstrn(ji,jj) 264 zmax = MAX( 0.1, xlimdia(ji,jj,jk) ) 265 zpislope2n = zpislopead2(ji,jj,jk) * trn(ji,jj,jk,jpdch) & 266 & / ( rtrn + trn(ji,jj,jk,jpdia) * 12.) & 267 & / ( prmax(ji,jj,jk) * rday * zmax + rtrn ) 268 269 zprdiachl = prmax(ji,jj,jk) * ( 1.- EXP( -zetot2 * zpislope2n ) ) 270 300 ! production terms for nanophyto. 301 zprorca(ji,jj,jk) = zprbio(ji,jj,jk) * xlimphy(ji,jj,jk) * trn(ji,jj,jk,jpphy) * rfact2 302 zpronew(ji,jj,jk) = zprorca(ji,jj,jk) * xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn ) 303 ! 304 zratio = trn(ji,jj,jk,jpnfe) / ( trn(ji,jj,jk,jpphy) + rtrn ) 305 zratio = zratio / fecnm 306 zmax = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) ) 307 zprofen(ji,jj,jk) = fecnm * prmax(ji,jj,jk) & 308 & * ( 4. - 4.5 * xlimnfe(ji,jj,jk) / ( xlimnfe(ji,jj,jk) + 0.5 ) ) & 309 & * trn(ji,jj,jk,jpfer) / ( trn(ji,jj,jk,jpfer) + concnfe(ji,jj,jk) ) & 310 & * zmax * trn(ji,jj,jk,jpphy) * rfact2 311 ! production terms for diatomees 271 312 zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * trn(ji,jj,jk,jpdia) * rfact2 272 273 zpronewd(ji,jj,jk) = zprorcad(ji,jj,jk) * xdiatno3(ji,jj,jk) & 274 & / ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) + rtrn ) 275 276 zprod = rday * zprorcad(ji,jj,jk) * zprdiachl * trn(ji,jj,jk,jpdia) * zmax 277 278 zprofed(ji,jj,jk) = (fecdm)**2 * zprod / chlcdm & 279 & / ( zpislopead2(ji,jj,jk) * zetot2 * trn(ji,jj,jk,jpdfe) + rtrn ) 280 281 zprochld(ji,jj,jk) = chlcdm * 144. * zprod & 282 & / ( zpislopead2(ji,jj,jk) * zetot2 * trn(ji,jj,jk,jpdch) + rtrn ) 283 313 zpronewd(ji,jj,jk) = zprorcad(ji,jj,jk) * xdiatno3(ji,jj,jk) / ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) + rtrn ) 314 ! 315 zratio = trn(ji,jj,jk,jpdfe) / ( trn(ji,jj,jk,jpdia) + rtrn ) 316 zratio = zratio / fecdm 317 zmax = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) ) 318 zprofed(ji,jj,jk) = fecdm * prmax(ji,jj,jk) & 319 & * ( 4. - 4.5 * xlimdfe(ji,jj,jk) / ( xlimdfe(ji,jj,jk) + 0.5 ) ) & 320 & * trn(ji,jj,jk,jpfer) / ( trn(ji,jj,jk,jpfer) + concdfe(ji,jj,jk) ) & 321 & * zmax * trn(ji,jj,jk,jpdia) * rfact2 284 322 ENDIF 285 323 END DO 286 324 END DO 287 325 END DO 288 ! 326 327 IF( ln_newprod ) THEN 328 !CDIR NOVERRCHK 329 DO jk = 1, jpkm1 330 !CDIR NOVERRCHK 331 DO jj = 1, jpj 332 !CDIR NOVERRCHK 333 DO ji = 1, jpi 334 IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 335 zprnch(ji,jj,jk) = zprnch(ji,jj,jk) * zmixnano(ji,jj) 336 zprdch(ji,jj,jk) = zprdch(ji,jj,jk) * zmixdiat(ji,jj) 337 ENDIF 338 IF( etot(ji,jj,jk) > 1.E-3 ) THEN 339 ! production terms for nanophyto. ( chlorophyll ) 340 znanotot = enano(ji,jj,jk) * zstrn(ji,jj) 341 zprod = rday * zprorca(ji,jj,jk) * zprnch(ji,jj,jk) * xlimphy(ji,jj,jk) 342 zprochln(ji,jj,jk) = chlcmin * 12. * zprorca (ji,jj,jk) 343 zprochln(ji,jj,jk) = zprochln(ji,jj,jk) + chlcnm * 12. * zprod / ( zpislopead(ji,jj,jk) * znanotot +rtrn) 344 ! production terms for diatomees ( chlorophyll ) 345 zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj) 346 zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * xlimdia(ji,jj,jk) 347 zprochld(ji,jj,jk) = chlcmin * 12. * zprorcad(ji,jj,jk) 348 zprochld(ji,jj,jk) = zprochld(ji,jj,jk) + chlcdm * 12. * zprod / ( zpislopead2(ji,jj,jk) * zdiattot +rtrn ) 349 ENDIF 350 END DO 351 END DO 352 END DO 353 ELSE 354 !CDIR NOVERRCHK 355 DO jk = 1, jpkm1 356 !CDIR NOVERRCHK 357 DO jj = 1, jpj 358 !CDIR NOVERRCHK 359 DO ji = 1, jpi 360 IF( etot(ji,jj,jk) > 1.E-3 ) THEN 361 ! production terms for nanophyto. ( chlorophyll ) 362 znanotot = enano(ji,jj,jk) * zstrn(ji,jj) 363 zprod = rday * zprorca(ji,jj,jk) * zprnch(ji,jj,jk) * trn(ji,jj,jk,jpphy) * xlimphy(ji,jj,jk) 364 zprochln(ji,jj,jk) = chlcnm * 144. * zprod / ( zpislopead(ji,jj,jk) * trn(ji,jj,jk,jpnch) * znanotot +rtrn) 365 ! production terms for diatomees ( chlorophyll ) 366 zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj) 367 zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * trn(ji,jj,jk,jpdia) * xlimdia(ji,jj,jk) 368 zprochld(ji,jj,jk) = chlcdm * 144. * zprod / ( zpislopead2(ji,jj,jk) * trn(ji,jj,jk,jpdch) * zdiattot +rtrn ) 369 ENDIF 370 END DO 371 END DO 372 END DO 373 ENDIF 289 374 290 375 ! Update the arrays TRA which contain the biological sources and sinks … … 304 389 tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) + zprofed(ji,jj,jk) * texcret2 305 390 tra(ji,jj,jk,jpbsi) = tra(ji,jj,jk,jpbsi) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcret2 306 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + & 307 & excret2 * zprorcad(ji,jj,jk) + excret * zprorca(ji,jj,jk) 391 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + excret2 * zprorcad(ji,jj,jk) + excret * zprorca(ji,jj,jk) 308 392 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2ut * ( zproreg + zproreg2) & 309 & + ( o2ut + o2nit ) * ( zpronew(ji,jj,jk) + zpronewd(ji,jj,jk) ) 310 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) & 311 & - texcret * zprofen(ji,jj,jk) - texcret2 * zprofed(ji,jj,jk) 312 tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) & 313 & - texcret2 * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 393 & + ( o2ut + o2nit ) * ( zpronew(ji,jj,jk) + zpronewd(ji,jj,jk) ) 394 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - texcret * zprofen(ji,jj,jk) - texcret2 * zprofed(ji,jj,jk) 395 tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) - texcret2 * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 314 396 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprorca(ji,jj,jk) - zprorcad(ji,jj,jk) 315 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) &316 & + rno3 * ( zpronew(ji,jj,jk) + zpronewd(ji,jj,jk))397 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zpronew(ji,jj,jk) + zpronewd(ji,jj,jk) ) & 398 & - rno3 * ( zproreg + zproreg2 ) 317 399 END DO 318 400 END DO … … 320 402 321 403 ! Total primary production per year 322 323 #if defined key_degrad324 tpp = tpp + glob_sum( ( zprorca(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) * facvol(:,:,:) )325 #else326 404 tpp = tpp + glob_sum( ( zprorca(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) ) 327 #endif 328 329 IF( kt == nitend .AND. jnt == nrdttrc .AND. lwp ) THEN 405 406 IF( kt == nitend .AND. jnt == nrdttrc ) THEN 330 407 WRITE(numout,*) 'Total PP (Gtc) :' 331 408 WRITE(numout,*) '-------------------- : ',tpp * 12. / 1.E12 … … 333 410 ENDIF 334 411 335 #if defined key_diatrc && ! defined key_iomput 336 ! Supplementary diagnostics 337 zrfact2 = 1.e3 * rfact2r 338 trc3d(:,:,:,jp_pcs0_3d + 4) = zprorca (:,:,:) * zrfact2 * tmask(:,:,:) 339 trc3d(:,:,:,jp_pcs0_3d + 5) = zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) 340 trc3d(:,:,:,jp_pcs0_3d + 6) = zpronew (:,:,:) * zrfact2 * tmask(:,:,:) 341 trc3d(:,:,:,jp_pcs0_3d + 7) = zpronewd(:,:,:) * zrfact2 * tmask(:,:,:) 342 trc3d(:,:,:,jp_pcs0_3d + 8) = zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) * zysopt(:,:,:) 343 trc3d(:,:,:,jp_pcs0_3d + 9) = zprofed (:,:,:) * zrfact2 * tmask(:,:,:) 412 IF( ln_diatrc ) THEN 413 ! 414 zrfact2 = 1.e3 * rfact2r 415 IF( lk_iomput ) THEN 416 IF( jnt == nrdttrc ) THEN 417 CALL iom_put( "PPPHY" , zprorca (:,:,:) * zrfact2 * tmask(:,:,:) ) ! primary production by nanophyto 418 CALL iom_put( "PPPHY2", zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) ) ! primary production by diatom 419 CALL iom_put( "PPNEWN", zpronew (:,:,:) * zrfact2 * tmask(:,:,:) ) ! new primary production by nanophyto 420 CALL iom_put( "PPNEWD", zpronewd(:,:,:) * zrfact2 * tmask(:,:,:) ) ! new primary production by diatom 421 CALL iom_put( "PBSi" , zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) * zysopt(:,:,:) ) ! biogenic silica production 422 CALL iom_put( "PFeD" , zprofed (:,:,:) * zrfact2 * tmask(:,:,:) ) ! biogenic iron production by diatom 423 CALL iom_put( "PFeN" , zprofen (:,:,:) * zrfact2 * tmask(:,:,:) ) ! biogenic iron production by nanophyto 424 ENDIF 425 ELSE 426 trc3d(:,:,:,jp_pcs0_3d + 4) = zprorca (:,:,:) * zrfact2 * tmask(:,:,:) 427 trc3d(:,:,:,jp_pcs0_3d + 5) = zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) 428 trc3d(:,:,:,jp_pcs0_3d + 6) = zpronew (:,:,:) * zrfact2 * tmask(:,:,:) 429 trc3d(:,:,:,jp_pcs0_3d + 7) = zpronewd(:,:,:) * zrfact2 * tmask(:,:,:) 430 trc3d(:,:,:,jp_pcs0_3d + 8) = zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) * zysopt(:,:,:) 431 trc3d(:,:,:,jp_pcs0_3d + 9) = zprofed (:,:,:) * zrfact2 * tmask(:,:,:) 344 432 # if ! defined key_kriest 345 trc3d(:,:,:,jp_pcs0_3d + 10) = zprofen (:,:,:) * zrfact2 * tmask(:,:,:)433 trc3d(:,:,:,jp_pcs0_3d + 10) = zprofen (:,:,:) * zrfact2 * tmask(:,:,:) 346 434 # endif 347 #endif 348 349 #if defined key_diatrc && defined key_iomput 350 zrfact2 = 1.e3 * rfact2r 351 IF ( jnt == nrdttrc ) then 352 CALL iom_put( "PPPHY" , zprorca (:,:,:) * zrfact2 * tmask(:,:,:) ) ! primary production by nanophyto 353 CALL iom_put( "PPPHY2", zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) ) ! primary production by diatom 354 CALL iom_put( "PPNEWN", zpronew (:,:,:) * zrfact2 * tmask(:,:,:) ) ! new primary production by nanophyto 355 CALL iom_put( "PPNEWD", zpronewd(:,:,:) * zrfact2 * tmask(:,:,:) ) ! new primary production by diatom 356 CALL iom_put( "PBSi" , zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) * zysopt(:,:,:) ) ! biogenic silica production 357 CALL iom_put( "PFeD" , zprofed (:,:,:) * zrfact2 * tmask(:,:,:) ) ! biogenic iron production by diatom 358 CALL iom_put( "PFeN" , zprofen (:,:,:) * zrfact2 * tmask(:,:,:) ) ! biogenic iron production by nanophyto 359 ENDIF 360 #endif 435 ENDIF 436 ! 437 ENDIF 361 438 362 439 IF(ln_ctl) THEN ! print mean trends (used for debugging) … … 365 442 CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 366 443 ENDIF 367 368 IF( wrk_not_released(2, 1,2,3) .OR. & 369 wrk_not_released(3, 2,3,4,5,6,7,8,9,10,11,12,13,14) ) & 370 CALL ctl_stop('p4z_prod: failed to release workspace arrays') 444 ! 445 CALL wrk_dealloc( jpi, jpj, zmixnano, zmixdiat, zstrn ) 446 CALL wrk_dealloc( jpi, jpj, jpk, zpislopead, zpislopead2, zprdia, zprbio, zprdch, zprnch, zysopt ) 447 CALL wrk_dealloc( jpi, jpj, jpk, zprorca, zprorcad, zprofed, zprofen, zprochln, zprochld, zpronew, zpronewd ) 448 ! 449 IF( nn_timing == 1 ) CALL timing_stop('p4z_prod') 371 450 ! 372 451 END SUBROUTINE p4z_prod … … 380 459 !! 381 460 !! ** Method : Read the nampisprod namelist and check the parameters 382 !! called at the first timestep (nit 000)461 !! called at the first timestep (nittrc000) 383 462 !! 384 463 !! ** input : Namelist nampisprod 385 464 !!---------------------------------------------------------------------- 386 NAMELIST/nampisprod/ pislope, pislope2, excret, excret2, chlcnm, chlcdm, & 387 & fecnm, fecdm, grosip 465 ! 466 NAMELIST/nampisprod/ pislope, pislope2, ln_newprod, bresp, excret, excret2, & 467 & chlcnm, chlcdm, chlcmin, fecnm, fecdm, grosip 388 468 !!---------------------------------------------------------------------- 389 469 390 REWIND( numnat ) ! read numnat391 READ ( numnat , nampisprod )470 REWIND( numnatp ) ! read numnatp 471 READ ( numnatp, nampisprod ) 392 472 393 473 IF(lwp) THEN ! control print … … 395 475 WRITE(numout,*) ' Namelist parameters for phytoplankton growth, nampisprod' 396 476 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 397 WRITE(numout,*) ' mean Si/C ratio grosip =', grosip 398 WRITE(numout,*) ' P-I slope pislope =', pislope 399 WRITE(numout,*) ' excretion ratio of nanophytoplankton excret =', excret 400 WRITE(numout,*) ' excretion ratio of diatoms excret2 =', excret2 401 WRITE(numout,*) ' P-I slope for diatoms pislope2 =', pislope2 402 WRITE(numout,*) ' Minimum Chl/C in nanophytoplankton chlcnm =', chlcnm 403 WRITE(numout,*) ' Minimum Chl/C in diatoms chlcdm =', chlcdm 404 WRITE(numout,*) ' Maximum Fe/C in nanophytoplankton fecnm =', fecnm 405 WRITE(numout,*) ' Minimum Fe/C in diatoms fecdm =', fecdm 406 ENDIF 407 ! 408 rday1 = 0.6 / rday 409 texcret = 1.0 - excret 410 texcret2 = 1.0 - excret2 411 tpp = 0. 477 WRITE(numout,*) ' Enable new parame. of production (T/F) ln_newprod =', ln_newprod 478 WRITE(numout,*) ' mean Si/C ratio grosip =', grosip 479 WRITE(numout,*) ' P-I slope pislope =', pislope 480 WRITE(numout,*) ' excretion ratio of nanophytoplankton excret =', excret 481 WRITE(numout,*) ' excretion ratio of diatoms excret2 =', excret2 482 IF( ln_newprod ) THEN 483 WRITE(numout,*) ' basal respiration in phytoplankton bresp =', bresp 484 WRITE(numout,*) ' Maximum Chl/C in phytoplankton chlcmin =', chlcmin 485 ENDIF 486 WRITE(numout,*) ' P-I slope for diatoms pislope2 =', pislope2 487 WRITE(numout,*) ' Minimum Chl/C in nanophytoplankton chlcnm =', chlcnm 488 WRITE(numout,*) ' Minimum Chl/C in diatoms chlcdm =', chlcdm 489 WRITE(numout,*) ' Maximum Fe/C in nanophytoplankton fecnm =', fecnm 490 WRITE(numout,*) ' Minimum Fe/C in diatoms fecdm =', fecdm 491 ENDIF 492 ! 493 r1_rday = 1._wp / rday 494 texcret = 1._wp - excret 495 texcret2 = 1._wp - excret2 496 tpp = 0._wp 412 497 ! 413 498 END SUBROUTINE p4z_prod_init … … 418 503 !! *** ROUTINE p4z_prod_alloc *** 419 504 !!---------------------------------------------------------------------- 420 ALLOCATE( prmax(jpi,jpj,jpk), STAT=p4z_prod_alloc )505 ALLOCATE( prmax(jpi,jpj,jpk), quotan(jpi,jpj,jpk), quotad(jpi,jpj,jpk), STAT = p4z_prod_alloc ) 421 506 ! 422 507 IF( p4z_prod_alloc /= 0 ) CALL ctl_warn('p4z_prod_alloc : failed to allocate arrays.') -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zrem.F90
r2773 r3294 6 6 !! History : 1.0 ! 2004 (O. Aumont) Original code 7 7 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) F90 8 !! 3.4 ! 2011-06 (O. Aumont, C. Ethe) Quota model for iron 8 9 !!---------------------------------------------------------------------- 9 10 #if defined key_pisces … … 12 13 !! 'key_pisces' PISCES bio-model 13 14 !!---------------------------------------------------------------------- 14 !! p4z_rem : Compute remineralization/scavenging of organic compounds 15 !!---------------------------------------------------------------------- 16 USE trc 17 USE oce_trc ! 18 USE sms_pisces ! 19 USE prtctl_trc 20 USE p4zint 21 USE p4zopt 22 USE p4zmeso 23 USE p4zprod 24 USE p4zche 15 !! p4z_rem : Compute remineralization/scavenging of organic compounds 16 !! p4z_rem_init : Initialisation of parameters for remineralisation 17 !! p4z_rem_alloc : Allocate remineralisation variables 18 !!---------------------------------------------------------------------- 19 USE oce_trc ! shared variables between ocean and passive tracers 20 USE trc ! passive tracers common variables 21 USE sms_pisces ! PISCES Source Minus Sink variables 22 USE p4zopt ! optical model 23 USE p4zche ! chemical model 24 USE p4zprod ! Growth rate of the 2 phyto groups 25 USE p4zmeso ! Sources and sinks of mesozooplankton 26 USE p4zint ! interpolation and computation of various fields 27 USE prtctl_trc ! print control for debugging 25 28 26 29 IMPLICIT NONE … … 31 34 PUBLIC p4z_rem_alloc 32 35 33 REAL(wp), PUBLIC :: & 34 xremik = 0.3_wp , & !: 35 xremip = 0.025_wp , & !: 36 nitrif = 0.05_wp , & !: 37 xsirem = 0.015_wp , & !: 38 xlam1 = 0.005_wp , & !: 39 oxymin = 1.e-6_wp !: 40 41 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: denitr !: denitrification array 36 !! * Shared module variables 37 REAL(wp), PUBLIC :: xremik = 0.3_wp !: remineralisation rate of POC 38 REAL(wp), PUBLIC :: xremip = 0.025_wp !: remineralisation rate of DOC 39 REAL(wp), PUBLIC :: nitrif = 0.05_wp !: NH4 nitrification rate 40 REAL(wp), PUBLIC :: xsirem = 0.003_wp !: remineralisation rate of POC 41 REAL(wp), PUBLIC :: xsiremlab = 0.025_wp !: fast remineralisation rate of POC 42 REAL(wp), PUBLIC :: xsilab = 0.31_wp !: fraction of labile biogenic silica 43 REAL(wp), PUBLIC :: xlam1 = 0.005_wp !: scavenging rate of Iron 44 REAL(wp), PUBLIC :: oxymin = 1.e-6_wp !: halk saturation constant for anoxia 45 REAL(wp), PUBLIC :: ligand = 0.6E-9_wp !: ligand concentration in the ocean 46 47 48 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: denitr !: denitrification array 49 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: denitnh4 !: - - - - - 42 50 43 51 … … 59 67 !! ** Method : - ??? 60 68 !!--------------------------------------------------------------------- 61 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released62 USE wrk_nemo, ONLY: ztempbac => wrk_2d_163 USE wrk_nemo, ONLY: zdepbac => wrk_3d_2 , zolimi => wrk_3d_364 69 ! 65 70 INTEGER, INTENT(in) :: kt ! ocean time step 66 71 ! 67 72 INTEGER :: ji, jj, jk 68 REAL(wp) :: zremip, zremik , zlam1b 73 REAL(wp) :: zremip, zremik , zlam1b, zdepbac2 69 74 REAL(wp) :: zkeq , zfeequi, zsiremin, zfesatur 70 REAL(wp) :: zsatur, zsatur2, znusil 75 REAL(wp) :: zsatur, zsatur2, znusil, zdep, zfactdep 71 76 REAL(wp) :: zbactfer, zorem, zorem2, zofer 72 REAL(wp) :: zosil, zdenom1, zscave, zaggdfe 77 REAL(wp) :: zosil, zdenom1, zscave, zaggdfe, zcoag 73 78 #if ! defined key_kriest 74 79 REAL(wp) :: zofer2, zdenom, zdenom2 … … 76 81 REAL(wp) :: zlamfac, zonitr, zstep 77 82 CHARACTER (len=25) :: charout 83 REAL(wp), POINTER, DIMENSION(:,: ) :: ztempbac 84 REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepbac, zolimi, zolimi2 78 85 !!--------------------------------------------------------------------- 79 80 IF( wrk_in_use(2, 1) .OR. wrk_in_use(3, 2,3) ) THEN 81 CALL ctl_stop('p4z_rem: requested workspace arrays unavailable') ; RETURN 82 ENDIF 86 ! 87 IF( nn_timing == 1 ) CALL timing_start('p4z_rem') 88 ! 89 ! Allocate temporary workspace 90 CALL wrk_alloc( jpi, jpj, ztempbac ) 91 CALL wrk_alloc( jpi, jpj, jpk, zdepbac, zolimi, zolimi2 ) 83 92 84 93 ! Initialisation of temprary arrys 85 94 zdepbac (:,:,:) = 0._wp 86 95 zolimi (:,:,:) = 0._wp 96 zolimi2 (:,:,:) = 0._wp 87 97 ztempbac(:,:) = 0._wp 88 98 … … 93 103 DO jj = 1, jpj 94 104 DO ji = 1, jpi 95 IF( fsdept(ji,jj,jk) < 120. ) THEN 105 zdep = MAX( hmld(ji,jj), heup(ji,jj) ) 106 IF( fsdept(ji,jj,jk) < zdep ) THEN 96 107 zdepbac(ji,jj,jk) = MIN( 0.7 * ( trn(ji,jj,jk,jpzoo) + 2.* trn(ji,jj,jk,jpmes) ), 4.e-6 ) 97 108 ztempbac(ji,jj) = zdepbac(ji,jj,jk) 98 109 ELSE 99 zdepbac(ji,jj,jk) = MIN( 1., 120./ fsdept(ji,jj,jk) ) * ztempbac(ji,jj)110 zdepbac(ji,jj,jk) = MIN( 1., zdep / fsdept(ji,jj,jk) ) * ztempbac(ji,jj) 100 111 ENDIF 101 112 END DO … … 117 128 DO jj = 1, jpj 118 129 DO ji = 1, jpi 130 zstep = xstep 119 131 # if defined key_degrad 120 zstep = xstep * facvol(ji,jj,jk) 121 # else 122 zstep = xstep 132 zstep = zstep * facvol(ji,jj,jk) 123 133 # endif 124 134 ! DOC ammonification. Depends on depth, phytoplankton biomass … … 126 136 ! of the bacterial activity. 127 137 zremik = xremik * zstep / 1.e-6 * xlimbac(ji,jj,jk) * zdepbac(ji,jj,jk) 128 zremik = MAX( zremik, 5.5e-4 * xstep ) 129 138 zremik = MAX( zremik, 2.e-4 * xstep ) 130 139 ! Ammonification in oxic waters with oxygen consumption 131 140 ! ----------------------------------------------------- 132 zolimi(ji,jj,jk) = MIN( ( trn(ji,jj,jk,jpoxy) - rtrn ) / o2ut, & 133 & zremik * ( 1.- nitrfac(ji,jj,jk) ) * trn(ji,jj,jk,jpdoc) ) 134 141 zolimi (ji,jj,jk) = zremik * ( 1.- nitrfac(ji,jj,jk) ) * trn(ji,jj,jk,jpdoc) 142 zolimi2(ji,jj,jk) = MIN( ( trn(ji,jj,jk,jpoxy) - rtrn ) / o2ut, zolimi(ji,jj,jk) ) 135 143 ! Ammonification in suboxic waters with denitrification 136 144 ! ------------------------------------------------------- 137 denitr(ji,jj,jk) = MIN( ( trn(ji,jj,jk,jpno3) - rtrn ) / rdenit, &145 denitr(ji,jj,jk) = MIN( ( trn(ji,jj,jk,jpno3) - rtrn ) / rdenit, & 138 146 & zremik * nitrfac(ji,jj,jk) * trn(ji,jj,jk,jpdoc) ) 139 END DO 140 END DO 141 END DO 142 143 DO jk = 1, jpkm1 144 DO jj = 1, jpj 145 DO ji = 1, jpi 147 ! 146 148 zolimi (ji,jj,jk) = MAX( 0.e0, zolimi (ji,jj,jk) ) 149 zolimi2(ji,jj,jk) = MAX( 0.e0, zolimi2(ji,jj,jk) ) 147 150 denitr (ji,jj,jk) = MAX( 0.e0, denitr (ji,jj,jk) ) 148 END DO 149 END DO 150 END DO 151 152 DO jk = 1, jpkm1 153 DO jj = 1, jpj 154 DO ji = 1, jpi 151 ! 152 END DO 153 END DO 154 END DO 155 156 157 DO jk = 1, jpkm1 158 DO jj = 1, jpj 159 DO ji = 1, jpi 160 zstep = xstep 155 161 # if defined key_degrad 156 zstep = xstep * facvol(ji,jj,jk) 157 # else 158 zstep = xstep 162 zstep = zstep * facvol(ji,jj,jk) 159 163 # endif 160 164 ! NH4 nitrification to NO3. Ceased for oxygen concentrations 161 165 ! below 2 umol/L. Inhibited at strong light 162 166 ! ---------------------------------------------------------- 163 zonitr = 164 167 zonitr =nitrif * zstep * trn(ji,jj,jk,jpnh4) / ( 1.+ emoy(ji,jj,jk) ) * ( 1.- nitrfac(ji,jj,jk) ) 168 denitnh4(ji,jj,jk) = nitrif * zstep * trn(ji,jj,jk,jpnh4) * nitrfac(ji,jj,jk) 165 169 ! Update of the tracers trends 166 170 ! ---------------------------- 167 168 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zonitr 169 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zonitr 171 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zonitr - denitnh4(ji,jj,jk) 172 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zonitr - rdenita * denitnh4(ji,jj,jk) 170 173 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2nit * zonitr 171 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - rno3 * zonitr 172 174 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2 * rno3 * zonitr + rno3 * ( rdenita - 1. ) * denitnh4(ji,jj,jk) 173 175 END DO 174 176 END DO … … 189 191 ! studies (especially at Papa) have shown this uptake to be significant 190 192 ! ---------------------------------------------------------- 191 z bactfer = 15.e-6 * rfact2 * 4.* 0.4 * prmax(ji,jj,jk) &192 & * ( xlimphy(ji,jj,jk) * zdepbac(ji,jj,jk))&193 & * ( xlimphy(ji,jj,jk) * zdepbac(ji,jj,jk))&194 & / ( xkgraz2 + zdepbac(ji,jj,jk) )&195 & 193 zdepbac2 = zdepbac(ji,jj,jk) * zdepbac(ji,jj,jk) 194 zbactfer = 20.e-6 * rfact2 * prmax(ji,jj,jk) & 195 & * trn(ji,jj,jk,jpfer) / ( 5E-10 + trn(ji,jj,jk,jpfer) ) & 196 & * zdepbac2 / ( xkgraz2 + zdepbac(ji,jj,jk) ) & 197 & * ( 0.5 + SIGN( 0.5, trn(ji,jj,jk,jpfer) -2.e-11 ) ) 196 198 197 199 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zbactfer … … 214 216 DO jj = 1, jpj 215 217 DO ji = 1, jpi 218 zstep = xstep 216 219 # if defined key_degrad 217 zstep = xstep * facvol(ji,jj,jk) 218 # else 219 zstep = xstep 220 zstep = zstep * facvol(ji,jj,jk) 220 221 # endif 221 222 ! POC disaggregation by turbulence and bacterial activity. 222 223 ! ------------------------------------------------------------- 223 zremip = xremip * zstep * tgfunc(ji,jj,jk) * ( 1.- 0. 5* nitrfac(ji,jj,jk) )224 zremip = xremip * zstep * tgfunc(ji,jj,jk) * ( 1.- 0.7 * nitrfac(ji,jj,jk) ) 224 225 225 226 ! POC disaggregation rate is reduced in anoxic zone as shown by … … 266 267 DO jj = 1, jpj 267 268 DO ji = 1, jpi 269 zstep = xstep 268 270 # if defined key_degrad 269 zstep = xstep * facvol(ji,jj,jk) 270 # else 271 zstep = xstep 271 zstep = zstep * facvol(ji,jj,jk) 272 272 # endif 273 273 ! Remineralization rate of BSi depedant on T and saturation 274 274 ! --------------------------------------------------------- 275 zsatur = ( sio3eq(ji,jj,jk) - trn(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn ) 276 zsatur = MAX( rtrn, zsatur ) 277 zsatur2 = zsatur * ( 1. + tsn(ji,jj,jk,jp_tem) / 400.)**4 278 znusil = 0.225 * ( 1. + tsn(ji,jj,jk,jp_tem) / 15.) * zsatur + 0.775 * zsatur2**9 279 zsiremin = xsirem * zstep * znusil 280 zosil = zsiremin * trn(ji,jj,jk,jpdsi) 281 275 zsatur = ( sio3eq(ji,jj,jk) - trn(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn ) 276 zsatur = MAX( rtrn, zsatur ) 277 zsatur2 = zsatur * ( 1. + tsn(ji,jj,jk,jp_tem) / 400.)**4 278 znusil = 0.225 * ( 1. + tsn(ji,jj,jk,jp_tem) / 15.) * zsatur + 0.775 * zsatur2**9.25 279 zdep = MAX( hmld(ji,jj), heup(ji,jj) ) 280 zdep = MAX( 0., fsdept(ji,jj,jk) - zdep ) 281 zfactdep = xsilab * EXP(-( xsiremlab - xsirem ) * zdep / wsbio2 ) 282 zsiremin = ( xsiremlab * zfactdep + xsirem * ( 1. - zfactdep ) ) * zstep * znusil 283 zosil = zsiremin * trn(ji,jj,jk,jpdsi) 284 ! 282 285 tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zosil 283 286 tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) + zosil … … 293 296 ENDIF 294 297 295 zfesatur = 0.6e-9298 zfesatur = ligand 296 299 !CDIR NOVERRCHK 297 300 DO jk = 1, jpkm1 … … 300 303 !CDIR NOVERRCHK 301 304 DO ji = 1, jpi 305 zstep = xstep 302 306 # if defined key_degrad 303 zstep = xstep * facvol(ji,jj,jk) 304 # else 305 zstep = xstep 307 zstep = zstep * facvol(ji,jj,jk) 306 308 # endif 307 309 ! Compute de different ratios for scavenging of iron … … 312 314 & ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpdsi) + trn(ji,jj,jk,jpcal) + rtrn ) 313 315 #else 314 zdenom = 1. / ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpgoc) & 315 & + trn(ji,jj,jk,jpdsi) + trn(ji,jj,jk,jpcal) + rtrn ) 316 316 zdenom = 1. / ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpgoc) + trn(ji,jj,jk,jpdsi) + trn(ji,jj,jk,jpcal) + rtrn ) 317 317 zdenom1 = trn(ji,jj,jk,jppoc) * zdenom 318 318 zdenom2 = trn(ji,jj,jk,jpgoc) * zdenom … … 337 337 ! Increased scavenging for very high iron concentrations 338 338 ! found near the coasts due to increased lithogenic particles 339 ! and let s say itunknown processes (precipitation, ...)339 ! and let say it is unknown processes (precipitation, ...) 340 340 ! ----------------------------------------------------------- 341 zlam1b = xlam1 * MAX( 0.e0, ( trn(ji,jj,jk,jpfer) * 1.e9 - 1. ) ) 342 zcoag = zfeequi * zlam1b * zstep 341 343 zlamfac = MAX( 0.e0, ( gphit(ji,jj) + 55.) / 30. ) 342 344 zlamfac = MIN( 1. , zlamfac ) 345 zdep = MIN(1., 1000. / fsdept(ji,jj,jk) ) 343 346 #if ! defined key_kriest 344 347 zlam1b = ( 80.* ( trn(ji,jj,jk,jpdoc) + 35.e-6 ) & 345 & + 698.* trn(ji,jj,jk,jppoc) + 1.05e4 * trn(ji,jj,jk,jpgoc) ) & 346 & * xdiss(ji,jj,jk) + 1E-4 * (1.-zlamfac) & 347 & + xlam1 * MAX( 0.e0, ( trn(ji,jj,jk,jpfer) * 1.e9 - 1.) ) 348 #else 349 zlam1b = ( 80.* (trn(ji,jj,jk,jpdoc) + 35E-6) & 348 & + 698.* trn(ji,jj,jk,jppoc) + 1.05e4 * trn(ji,jj,jk,jpgoc) ) & 349 & * xdiss(ji,jj,jk) + 1E-4 * ( 1. - zlamfac ) * zdep 350 #else 351 zlam1b = ( 80.* (trn(ji,jj,jk,jpdoc) + 35E-6) & 350 352 & + 698.* trn(ji,jj,jk,jppoc) ) & 351 & * xdiss(ji,jj,jk) + 1E-4 * (1.-zlamfac) & 352 & + xlam1 * MAX( 0.e0, ( trn(ji,jj,jk,jpfer) * 1.e9 - 1.) ) 353 #endif 354 353 & * xdiss(ji,jj,jk) + 1E-4 * ( 1. - zlamfac ) * zdep 354 #endif 355 355 zaggdfe = zlam1b * zstep * 0.5 * ( trn(ji,jj,jk,jpfer) - zfeequi ) 356 357 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zscave - zaggdfe 358 356 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zscave - zaggdfe - zcoag 359 357 #if defined key_kriest 360 358 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zscave * zdenom1 … … 378 376 379 377 DO jk = 1, jpkm1 380 tra(:,:,jk,jppo4) = tra(:,:,jk,jppo4) + zolimi (:,:,jk) + denitr(:,:,jk)381 tra(:,:,jk,jpnh4) = tra(:,:,jk,jpnh4) + zolimi (:,:,jk) + denitr(:,:,jk)382 tra(:,:,jk,jpno3) = tra(:,:,jk,jpno3) - denitr (:,:,jk) * rdenit383 tra(:,:,jk,jpdoc) = tra(:,:,jk,jpdoc) - zolimi (:,:,jk) - denitr(:,:,jk)384 tra(:,:,jk,jpoxy) = tra(:,:,jk,jpoxy) - zolimi (:,:,jk) * o2ut385 tra(:,:,jk,jpdic) = tra(:,:,jk,jpdic) + zolimi (:,:,jk) + denitr(:,:,jk)386 tra(:,:,jk,jptal) = tra(:,:,jk,jptal) + denitr(:,:,jk) * rno3 * rdenit378 tra(:,:,jk,jppo4) = tra(:,:,jk,jppo4) + zolimi (:,:,jk) + denitr(:,:,jk) 379 tra(:,:,jk,jpnh4) = tra(:,:,jk,jpnh4) + zolimi (:,:,jk) + denitr(:,:,jk) 380 tra(:,:,jk,jpno3) = tra(:,:,jk,jpno3) - denitr (:,:,jk) * rdenit 381 tra(:,:,jk,jpdoc) = tra(:,:,jk,jpdoc) - zolimi (:,:,jk) - denitr(:,:,jk) 382 tra(:,:,jk,jpoxy) = tra(:,:,jk,jpoxy) - zolimi2(:,:,jk) * o2ut 383 tra(:,:,jk,jpdic) = tra(:,:,jk,jpdic) + zolimi (:,:,jk) + denitr(:,:,jk) 384 tra(:,:,jk,jptal) = tra(:,:,jk,jptal) + rno3 * ( zolimi(:,:,jk) + ( rdenit + 1.) * denitr(:,:,jk) ) 387 385 END DO 388 386 … … 393 391 ENDIF 394 392 ! 395 IF( wrk_not_released(2, 1) .OR. & 396 wrk_not_released(3, 2,3) ) CALL ctl_stop('p4z_rem: failed to release workspace arrays') 393 CALL wrk_dealloc( jpi, jpj, ztempbac ) 394 CALL wrk_dealloc( jpi, jpj, jpk, zdepbac, zolimi, zolimi2 ) 395 ! 396 IF( nn_timing == 1 ) CALL timing_stop('p4z_rem') 397 397 ! 398 398 END SUBROUTINE p4z_rem … … 411 411 !! 412 412 !!---------------------------------------------------------------------- 413 NAMELIST/nampisrem/ xremik, xremip, nitrif, xsirem, x lam1, oxymin414 !!----------------------------------------------------------------------415 416 REWIND( numnat ) ! read numnat417 READ ( numnat , nampisrem )413 NAMELIST/nampisrem/ xremik, xremip, nitrif, xsirem, xsiremlab, xsilab, & 414 & xlam1, oxymin, ligand 415 416 REWIND( numnatp ) ! read numnatp 417 READ ( numnatp, nampisrem ) 418 418 419 419 IF(lwp) THEN ! control print … … 424 424 WRITE(numout,*) ' remineralization rate of DOC xremik =', xremik 425 425 WRITE(numout,*) ' remineralization rate of Si xsirem =', xsirem 426 WRITE(numout,*) ' fast remineralization rate of Si xsiremlab =', xsiremlab 427 WRITE(numout,*) ' fraction of labile biogenic silica xsilab =', xsilab 426 428 WRITE(numout,*) ' scavenging rate of Iron xlam1 =', xlam1 427 429 WRITE(numout,*) ' NH4 nitrification rate nitrif =', nitrif 428 430 WRITE(numout,*) ' halk saturation constant for anoxia oxymin =', oxymin 431 WRITE(numout,*) ' ligand concentration in the ocean ligand =', ligand 429 432 ENDIF 430 433 ! 431 nitrfac(:,:,:) = 0._wp 432 denitr (:,:,:) = 0._wp 434 nitrfac (:,:,:) = 0._wp 435 denitr (:,:,:) = 0._wp 436 denitnh4(:,:,:) = 0._wp 433 437 ! 434 438 END SUBROUTINE p4z_rem_init … … 439 443 !! *** ROUTINE p4z_rem_alloc *** 440 444 !!---------------------------------------------------------------------- 441 ALLOCATE( denitr(jpi,jpj,jpk), STAT=p4z_rem_alloc )445 ALLOCATE( denitr(jpi,jpj,jpk), denitnh4(jpi,jpj,jpk), STAT=p4z_rem_alloc ) 442 446 ! 443 447 IF( p4z_rem_alloc /= 0 ) CALL ctl_warn('p4z_rem_alloc: failed to allocate arrays') -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsed.F90
r2774 r3294 6 6 !! History : 1.0 ! 2004-03 (O. Aumont) Original code 7 7 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) F90 8 !! 3.4 ! 2011-06 (O. Aumont, C. Ethe) USE of fldread 8 9 !!---------------------------------------------------------------------- 9 10 #if defined key_pisces … … 15 16 !! p4z_sed_init : Initialization of p4z_sed 16 17 !!---------------------------------------------------------------------- 17 USE trc 18 USE oce_trc ! 19 USE sms_pisces 20 USE prtctl_trc 21 USE p4zbio 22 USE p4zint 23 USE p4zopt 24 USE p4zsink 25 USE p4zrem 26 USE p4zlim 27 USE iom 28 18 USE oce_trc ! shared variables between ocean and passive tracers 19 USE trc ! passive tracers common variables 20 USE sms_pisces ! PISCES Source Minus Sink variables 21 USE p4zsink ! vertical flux of particulate matter due to sinking 22 USE p4zopt ! optical model 23 USE p4zlim ! Co-limitations of differents nutrients 24 USE p4zrem ! Remineralisation of organic matter 25 USE p4zint ! interpolation and computation of various fields 26 USE iom ! I/O manager 27 USE fldread ! time interpolation 28 USE prtctl_trc ! print control for debugging 29 29 30 30 IMPLICIT NONE … … 36 36 37 37 !! * Shared module variables 38 LOGICAL, PUBLIC :: ln_dustfer = .FALSE. !: boolean for dust input from the atmosphere 39 LOGICAL, PUBLIC :: ln_river = .FALSE. !: boolean for river input of nutrients 40 LOGICAL, PUBLIC :: ln_ndepo = .FALSE. !: boolean for atmospheric deposition of N 41 LOGICAL, PUBLIC :: ln_sedinput = .FALSE. !: boolean for Fe input from sediments 42 43 REAL(wp), PUBLIC :: sedfeinput = 1.E-9_wp !: Coastal release of Iron 44 REAL(wp), PUBLIC :: dustsolub = 0.014_wp !: Solubility of the dust 38 LOGICAL :: ln_dust = .FALSE. !: boolean for dust input from the atmosphere 39 LOGICAL :: ln_river = .FALSE. !: boolean for river input of nutrients 40 LOGICAL :: ln_ndepo = .FALSE. !: boolean for atmospheric deposition of N 41 LOGICAL :: ln_ironsed = .FALSE. !: boolean for Fe input from sediments 42 43 REAL(wp) :: sedfeinput = 1.E-9_wp !: Coastal release of Iron 44 REAL(wp) :: dustsolub = 0.014_wp !: Solubility of the dust 45 REAL(wp) :: wdust = 2.0_wp !: Sinking speed of the dust 46 REAL(wp) :: nitrfix = 1E-7_wp !: Nitrogen fixation rate 47 REAL(wp) :: diazolight = 50._wp !: Nitrogen fixation sensitivty to light 48 REAL(wp) :: concfediaz = 1.E-10_wp !: Fe half-saturation Cste for diazotrophs 49 45 50 46 51 !! * Module variables 47 52 REAL(wp) :: ryyss !: number of seconds per year 48 REAL(wp) :: r yyss1!: inverse of ryyss53 REAL(wp) :: r1_ryyss !: inverse of ryyss 49 54 REAL(wp) :: rmtss !: number of seconds per month 50 REAL(wp) :: rday1 !: inverse of rday 51 52 INTEGER , PARAMETER :: jpmth = 12 !: number of months per year 53 INTEGER , PARAMETER :: jpyr = 1 !: one year 54 55 INTEGER :: numdust !: logical unit for surface fluxes data 56 INTEGER :: nflx1 , nflx2 !: first and second record used 57 INTEGER :: nflx11, nflx12 58 59 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dustmo !: set of dust fields 55 REAL(wp) :: r1_rday !: inverse of rday 56 LOGICAL :: ll_sbc 57 58 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_dust ! structure of input dust 59 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_riverdic ! structure of input riverdic 60 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_riverdoc ! structure of input riverdoc 61 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_ndepo ! structure of input nitrogen deposition 62 TYPE(FLD), ALLOCATABLE, DIMENSION(:) :: sf_ironsed ! structure of input iron from sediment 63 64 INTEGER , PARAMETER :: nbtimes = 365 !: maximum number of times record in a file 65 INTEGER :: ntimes_dust, ntimes_riv, ntimes_ndep ! number of time steps in a file 66 60 67 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: dust !: dust fields 61 68 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: rivinp, cotdep !: river input fields … … 86 93 !! ** Method : - ??? 87 94 !!--------------------------------------------------------------------- 88 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released89 USE wrk_nemo, ONLY: zsidep => wrk_2d_1, zwork => wrk_2d_2, zwork1 => wrk_2d_390 USE wrk_nemo, ONLY: znitrpot => wrk_3d_2, zirondep => wrk_3d_391 95 ! 92 96 INTEGER, INTENT(in) :: kt, jnt ! ocean time step … … 96 100 REAL(wp) :: zrivalk, zrivsil, zrivpo4 97 101 #endif 98 REAL(wp) :: zdenitot, znitrpottot, zlim, zfact 99 REAL(wp) :: z wsbio3, zwsbio4, zwscal102 REAL(wp) :: zdenitot, znitrpottot, zlim, zfact, zfactcal 103 REAL(wp) :: zsiloss, zcaloss, zwsbio3, zwsbio4, zwscal, zdep 100 104 CHARACTER (len=25) :: charout 105 REAL(wp), POINTER, DIMENSION(:,: ) :: zsidep, zwork1, zwork2, zwork3 106 REAL(wp), POINTER, DIMENSION(:,:,:) :: znitrpot, zirondep 101 107 !!--------------------------------------------------------------------- 102 103 IF( ( wrk_in_use(2, 1,2,3) ) .OR. ( wrk_in_use(3, 2,3) ) ) THEN 104 CALL ctl_stop('p4z_sed: requested workspace arrays unavailable') ; RETURN 105 END IF 106 107 IF( jnt == 1 .AND. ln_dustfer ) CALL p4z_sbc( kt ) 108 ! 109 IF( nn_timing == 1 ) CALL timing_start('p4z_sed') 110 ! 111 ! Allocate temporary workspace 112 CALL wrk_alloc( jpi, jpj, zsidep, zwork1, zwork2, zwork3 ) 113 CALL wrk_alloc( jpi, jpj, jpk, znitrpot, zirondep ) 114 115 IF( jnt == 1 .AND. ll_sbc ) CALL p4z_sbc( kt ) 116 117 zirondep(:,:,:) = 0.e0 ! Initialisation of variables USEd to compute deposition 118 zsidep (:,:) = 0.e0 108 119 109 120 ! Iron and Si deposition at the surface 110 121 ! ------------------------------------- 111 112 122 DO jj = 1, jpj 113 123 DO ji = 1, jpi 114 z irondep(ji,jj,1) = ( dustsolub * dust(ji,jj) / ( 55.85 * rmtss ) + 3.e-10 * ryyss1 ) &115 & * rfact2 / fse3t(ji,jj,1)116 zsidep (ji,jj) = 8.8 * 0.075 * dust(ji,jj) * rfact2 / ( fse3t(ji,jj,1) *28.1 * rmtss )124 zdep = rfact2 / fse3t(ji,jj,1) 125 zirondep(ji,jj,1) = ( dustsolub * dust(ji,jj) / ( 55.85 * rmtss ) + 3.e-10 * r1_ryyss ) * zdep 126 zsidep (ji,jj) = 8.8 * 0.075 * dust(ji,jj) * zdep / ( 28.1 * rmtss ) 117 127 END DO 118 128 END DO … … 120 130 ! Iron solubilization of particles in the water column 121 131 ! ---------------------------------------------------- 122 123 132 DO jk = 2, jpkm1 124 zirondep(:,:,jk) = dust(:,:) / ( 10. * 55.85 * rmtss ) * rfact2 * 1.e-4133 zirondep(:,:,jk) = dust(:,:) / ( wdust * 55.85 * rmtss ) * rfact2 * 1.e-4 * EXP( -fsdept(:,:,jk) / 1000. ) 125 134 END DO 126 135 127 136 ! Add the external input of nutrients, carbon and alkalinity 128 137 ! ---------------------------------------------------------- 129 130 138 trn(:,:,1,jppo4) = trn(:,:,1,jppo4) + rivinp(:,:) * rfact2 131 139 trn(:,:,1,jpno3) = trn(:,:,1,jpno3) + (rivinp(:,:) + nitdep(:,:)) * rfact2 … … 139 147 ! (dust, river and sediment mobilization) 140 148 ! ------------------------------------------------------ 141 142 149 DO jk = 1, jpkm1 143 150 trn(:,:,jk,jpfer) = trn(:,:,jk,jpfer) + zirondep(:,:,jk) + ironsed(:,:,jk) * rfact2 144 151 END DO 145 146 152 147 153 #if ! defined key_sed … … 154 160 ikt = mbkt(ji,jj) 155 161 # if defined key_kriest 156 zwork 157 zwork 1(ji,jj) = trn(ji,jj,ikt,jppoc) * wsbio3(ji,jj,ikt)162 zwork1(ji,jj) = trn(ji,jj,ikt,jpdsi) * wscal (ji,jj,ikt) 163 zwork2(ji,jj) = trn(ji,jj,ikt,jppoc) * wsbio3(ji,jj,ikt) 158 164 # else 159 zwork 160 zwork 1(ji,jj) = trn(ji,jj,ikt,jpgoc) * wsbio4(ji,jj,ikt) + trn(ji,jj,ikt,jppoc) * wsbio3(ji,jj,ikt)165 zwork1(ji,jj) = trn(ji,jj,ikt,jpdsi) * wsbio4(ji,jj,ikt) 166 zwork2(ji,jj) = trn(ji,jj,ikt,jpgoc) * wsbio4(ji,jj,ikt) + trn(ji,jj,ikt,jppoc) * wsbio3(ji,jj,ikt) 161 167 # endif 162 END DO 163 END DO 164 zsumsedsi = glob_sum( zwork (:,:) * e1e2t(:,:) ) * rday1 165 zsumsedpo4 = glob_sum( zwork1(:,:) * e1e2t(:,:) ) * rday1 166 DO jj = 1, jpj 167 DO ji = 1, jpi 168 ikt = mbkt(ji,jj) 169 zwork (ji,jj) = trn(ji,jj,ikt,jpcal) * wscal (ji,jj,ikt) 170 END DO 171 END DO 172 zsumsedcal = glob_sum( zwork (:,:) * e1e2t(:,:) ) * 2.0 * rday1 168 ! For calcite, burial efficiency is made a function of saturation 169 zfactcal = MIN( excess(ji,jj,ikt), 0.2 ) 170 zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) ) 171 zwork3(ji,jj) = trn(ji,jj,ikt,jpcal) * wscal (ji,jj,ikt) * 2.e0 * zfactcal 172 END DO 173 END DO 174 zsumsedsi = glob_sum( zwork1(:,:) * e1e2t(:,:) ) * r1_rday 175 zsumsedpo4 = glob_sum( zwork2(:,:) * e1e2t(:,:) ) * r1_rday 176 zsumsedcal = glob_sum( zwork3(:,:) * e1e2t(:,:) ) * r1_rday 173 177 #endif 174 178 175 ! T henthis loss is scaled at each bottom grid cell for179 ! THEN this loss is scaled at each bottom grid cell for 176 180 ! equilibrating the total budget of silica in the ocean. 177 181 ! Thus, the amount of silica lost in the sediments equal 178 182 ! the supply at the surface (dust+rivers) 179 183 ! ------------------------------------------------------ 184 #if ! defined key_sed 185 zrivsil = 1._wp - ( sumdepsi + rivalkinput * r1_ryyss / 6. ) / zsumsedsi 186 zrivpo4 = 1._wp - ( rivpo4input * r1_ryyss ) / zsumsedpo4 187 #endif 180 188 181 189 DO jj = 1, jpj 182 190 DO ji = 1, jpi 183 ikt = mbkt(ji,jj) 184 zfact = xstep / fse3t(ji,jj,ikt) 185 zwsbio3 = 1._wp - zfact * wsbio3(ji,jj,ikt) 186 zwsbio4 = 1._wp - zfact * wsbio4(ji,jj,ikt) 187 zwscal = 1._wp - zfact * wscal (ji,jj,ikt) 191 ikt = mbkt(ji,jj) 192 zdep = xstep / fse3t(ji,jj,ikt) 193 zwsbio4 = wsbio4(ji,jj,ikt) * zdep 194 zwscal = wscal (ji,jj,ikt) * zdep 195 # if defined key_kriest 196 zsiloss = trn(ji,jj,ikt,jpdsi) * zwsbio4 197 # else 198 zsiloss = trn(ji,jj,ikt,jpdsi) * zwscal 199 # endif 200 zcaloss = trn(ji,jj,ikt,jpcal) * zwscal 188 201 ! 189 # if defined key_kriest 190 trn(ji,jj,ikt,jpdsi) = trn(ji,jj,ikt,jpdsi) * zwsbio4 191 trn(ji,jj,ikt,jpnum) = trn(ji,jj,ikt,jpnum) * zwsbio4 192 trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) * zwsbio3 193 trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) * zwsbio3 194 # else 195 trn(ji,jj,ikt,jpdsi) = trn(ji,jj,ikt,jpdsi) * zwscal 196 trn(ji,jj,ikt,jpgoc) = trn(ji,jj,ikt,jpgoc) * zwsbio4 197 trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) * zwsbio3 198 trn(ji,jj,ikt,jpbfe) = trn(ji,jj,ikt,jpbfe) * zwsbio4 199 trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) * zwsbio3 200 # endif 201 trn(ji,jj,ikt,jpcal) = trn(ji,jj,ikt,jpcal) * zwscal 202 END DO 203 END DO 204 202 trn(ji,jj,ikt,jpdsi) = trn(ji,jj,ikt,jpdsi) - zsiloss 203 trn(ji,jj,ikt,jpcal) = trn(ji,jj,ikt,jpcal) - zcaloss 205 204 #if ! defined key_sed 206 zrivsil = 1._wp - ( sumdepsi + rivalkinput * ryyss1 / 6. ) / zsumsedsi 207 zrivalk = 1._wp - ( rivalkinput * ryyss1 ) / zsumsedcal 208 zrivpo4 = 1._wp - ( rivpo4input * ryyss1 ) / zsumsedpo4 205 trn(ji,jj,ikt,jpsil) = trn(ji,jj,ikt,jpsil) + zsiloss * zrivsil 206 zfactcal = MIN( excess(ji,jj,ikt), 0.2 ) 207 zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) ) 208 zrivalk = 1._wp - ( rivalkinput * r1_ryyss ) * zfactcal / zsumsedcal 209 trn(ji,jj,ikt,jptal) = trn(ji,jj,ikt,jptal) + zcaloss * zrivalk * 2.0 210 trn(ji,jj,ikt,jpdic) = trn(ji,jj,ikt,jpdic) + zcaloss * zrivalk 211 #endif 212 END DO 213 END DO 214 209 215 DO jj = 1, jpj 210 216 DO ji = 1, jpi 211 ikt = mbkt(ji,jj) 212 zfact = xstep / fse3t(ji,jj,ikt) 213 zwsbio3 = zfact * wsbio3(ji,jj,ikt) 214 zwsbio4 = zfact * wsbio4(ji,jj,ikt) 215 zwscal = zfact * wscal (ji,jj,ikt) 216 trn(ji,jj,ikt,jptal) = trn(ji,jj,ikt,jptal) + trn(ji,jj,ikt,jpcal) * zwscal * zrivalk * 2.0 217 trn(ji,jj,ikt,jpdic) = trn(ji,jj,ikt,jpdic) + trn(ji,jj,ikt,jpcal) * zwscal * zrivalk 218 # if defined key_kriest 219 trn(ji,jj,ikt,jpsil) = trn(ji,jj,ikt,jpsil) + trn(ji,jj,ikt,jpdsi) * zwsbio4 * zrivsil 220 trn(ji,jj,ikt,jpdoc) = trn(ji,jj,ikt,jpdoc) + trn(ji,jj,ikt,jppoc) * zwsbio3 * zrivpo4 217 ikt = mbkt(ji,jj) 218 zdep = xstep / fse3t(ji,jj,ikt) 219 zwsbio4 = wsbio4(ji,jj,ikt) * zdep 220 zwsbio3 = wsbio3(ji,jj,ikt) * zdep 221 # if ! defined key_kriest 222 trn(ji,jj,ikt,jpgoc) = trn(ji,jj,ikt,jpgoc) - trn(ji,jj,ikt,jpgoc) * zwsbio4 223 trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) - trn(ji,jj,ikt,jppoc) * zwsbio3 224 trn(ji,jj,ikt,jpbfe) = trn(ji,jj,ikt,jpbfe) - trn(ji,jj,ikt,jpbfe) * zwsbio4 225 trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) - trn(ji,jj,ikt,jpsfe) * zwsbio3 226 #if ! defined key_sed 227 trn(ji,jj,ikt,jpdoc) = trn(ji,jj,ikt,jpdoc) & 228 & + ( trn(ji,jj,ikt,jpgoc) * zwsbio4 + trn(ji,jj,ikt,jppoc) * zwsbio3 ) * zrivpo4 229 #endif 230 221 231 # else 222 trn(ji,jj,ikt,jpsil) = trn(ji,jj,ikt,jpsil) + trn(ji,jj,ikt,jpdsi) * zwscal * zrivsil 223 trn(ji,jj,ikt,jpdoc) = trn(ji,jj,ikt,jpdoc) & 224 & + ( trn(ji,jj,ikt,jppoc) * zwsbio3 + trn(ji,jj,ikt,jpgoc) * zwsbio4 ) * zrivpo4 232 trn(ji,jj,ikt,jpnum) = trn(ji,jj,ikt,jpnum) - trn(ji,jj,ikt,jpnum) * zwsbio4 233 trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) - trn(ji,jj,ikt,jppoc) * zwsbio3 234 trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) - trn(ji,jj,ikt,jpsfe) * zwsbio3 235 #if ! defined key_sed 236 trn(ji,jj,ikt,jpdoc) = trn(ji,jj,ikt,jpdoc) & 237 & + ( trn(ji,jj,ikt,jpnum) * zwsbio4 + trn(ji,jj,ikt,jppoc) * zwsbio3 ) * zrivpo4 238 #endif 239 225 240 # endif 226 241 END DO 227 242 END DO 228 # endif 243 229 244 230 245 ! Nitrogen fixation (simple parameterization). The total gain … … 233 248 ! ------------------------------------------------------------- 234 249 235 zdenitot = glob_sum( denitr(:,:,:) * cvol(:,:,:) * xnegtr(:,:,:) ) * rdenit250 zdenitot = glob_sum( ( denitr(:,:,:) * rdenit + denitnh4(:,:,:) * rdenita ) * cvol(:,:,:) ) 236 251 237 252 ! Potential nitrogen fixation dependant on temperature and iron … … 246 261 zlim = ( 1.- xnanono3(ji,jj,jk) - xnanonh4(ji,jj,jk) ) 247 262 IF( zlim <= 0.2 ) zlim = 0.01 248 znitrpot(ji,jj,jk) = MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) * rday1 ) & 249 # if defined key_degrad 250 & * facvol(ji,jj,jk) & 251 # endif 252 & * zlim * rfact2 * trn(ji,jj,jk,jpfer) & 253 & / ( conc3 + trn(ji,jj,jk,jpfer) ) * ( 1.- EXP( -etot(ji,jj,jk) / 50.) ) 263 #if defined key_degrad 264 zfact = zlim * rfact2 * facvol(ji,jj,jk) 265 #else 266 zfact = zlim * rfact2 267 #endif 268 znitrpot(ji,jj,jk) = MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) * r1_rday ) & 269 & * zfact * trn(ji,jj,jk,jpfer) / ( concfediaz + trn(ji,jj,jk,jpfer) ) & 270 & * ( 1.- EXP( -etot(ji,jj,jk) / diazolight ) ) 254 271 END DO 255 272 END DO … … 260 277 ! Nitrogen change due to nitrogen fixation 261 278 ! ---------------------------------------- 262 263 279 DO jk = 1, jpk 264 280 DO jj = 1, jpj 265 281 DO ji = 1, jpi 266 zfact = znitrpot(ji,jj,jk) * 1.e-7282 zfact = znitrpot(ji,jj,jk) * nitrfix 267 283 trn(ji,jj,jk,jpnh4) = trn(ji,jj,jk,jpnh4) + zfact 284 trn(ji,jj,jk,jptal) = trn(ji,jj,jk,jptal) + rno3 * zfact 268 285 trn(ji,jj,jk,jpoxy) = trn(ji,jj,jk,jpoxy) + zfact * o2nit 269 trn(ji,jj,jk,jppo4) = trn(ji,jj,jk,jppo4) + 30./ 46.* zfact 270 END DO 271 END DO 272 END DO 273 274 #if defined key_diatrc 275 zfact = 1.e+3 * rfact2r 276 # if ! defined key_iomput 277 trc2d(:,:,jp_pcs0_2d + 11) = zirondep(:,:,1) * zfact * fse3t(:,:,1) * tmask(:,:,1) 278 trc2d(:,:,jp_pcs0_2d + 12) = znitrpot(:,:,1) * 1.e-7 * zfact * fse3t(:,:,1) * tmask(:,:,1) 279 # else 280 zwork (:,:) = ( zirondep(:,:,1) + ironsed(:,:,1) * rfact2 ) * zfact * fse3t(:,:,1) * tmask(:,:,1) 281 zwork1(:,:) = znitrpot(:,:,1) * 1.e-7 * zfact * fse3t(:,:,1) * tmask(:,:,1) 282 IF( jnt == nrdttrc ) THEN 283 CALL iom_put( "Irondep", zwork ) ! surface downward net flux of iron 284 CALL iom_put( "Nfix" , zwork1 ) ! nitrogen fixation at surface 285 ENDIF 286 # endif 287 #endif 288 ! 289 IF(ln_ctl) THEN ! print mean trends (used for debugging) 290 WRITE(charout, FMT="('sed ')") 286 trn(ji,jj,jk,jppo4) = trn(ji,jj,jk,jppo4) + 30. / 46. * zfact 287 ! trn(ji,jj,jk,jppo4) = trn(ji,jj,jk,jppo4) + zfact 288 END DO 289 END DO 290 END DO 291 ! 292 IF( ln_diatrc ) THEN 293 zfact = 1.e+3 * rfact2r 294 IF( lk_iomput ) THEN 295 zwork1(:,:) = ( zirondep(:,:,1) + ironsed(:,:,1) * rfact2 ) * zfact * fse3t(:,:,1) * tmask(:,:,1) 296 zwork2(:,:) = znitrpot(:,:,1) * nitrfix * zfact * fse3t(:,:,1) * tmask(:,:,1) 297 IF( jnt == nrdttrc ) THEN 298 CALL iom_put( "Irondep", zwork1 ) ! surface downward net flux of iron 299 CALL iom_put( "Nfix" , zwork2 ) ! nitrogen fixation at surface 300 ENDIF 301 ELSE 302 trc2d(:,:,jp_pcs0_2d + 11) = zirondep(:,:,1) * zfact * fse3t(:,:,1) * tmask(:,:,1) 303 trc2d(:,:,jp_pcs0_2d + 12) = znitrpot(:,:,1) * nitrfix * zfact * fse3t(:,:,1) * tmask(:,:,1) 304 ENDIF 305 ENDIF 306 ! 307 IF(ln_ctl) THEN ! print mean trends (USEd for debugging) 308 WRITE(charout, fmt="('sed ')") 291 309 CALL prt_ctl_trc_info(charout) 292 310 CALL prt_ctl_trc(tab4d=trn, mask=tmask, clinfo=ctrcnm) 293 ENDIF 294 295 IF( ( wrk_not_released(2, 1,2,3) ) .OR. ( wrk_not_released(3, 2,3) ) ) & 296 & CALL ctl_stop('p4z_sed: failed to release workspace arrays') 297 311 ENDIF 312 ! 313 CALL wrk_dealloc( jpi, jpj, zsidep, zwork1, zwork2, zwork3 ) 314 CALL wrk_dealloc( jpi, jpj, jpk, znitrpot, zirondep ) 315 ! 316 IF( nn_timing == 1 ) CALL timing_stop('p4z_sed') 317 ! 298 318 END SUBROUTINE p4z_sed 299 319 300 320 SUBROUTINE p4z_sbc( kt ) 301 302 321 !!---------------------------------------------------------------------- 303 !! *** ROUTINEp4z_sbc ***304 !! 305 !! ** Purpose : Read and interpolate the external sources of322 !! *** routine p4z_sbc *** 323 !! 324 !! ** purpose : read and interpolate the external sources of 306 325 !! nutrients 307 326 !! 308 !! ** Method : Read the files and interpolate the appropriate variables327 !! ** method : read the files and interpolate the appropriate variables 309 328 !! 310 329 !! ** input : external netcdf files … … 314 333 INTEGER, INTENT( in ) :: kt ! ocean time step 315 334 316 !! * Local declarations 317 INTEGER :: imois, i15, iman 318 REAL(wp) :: zxy 319 335 !! * local declarations 336 INTEGER :: ji,jj 337 REAL(wp) :: zcoef 320 338 !!--------------------------------------------------------------------- 321 322 ! Initialization 323 ! -------------- 324 325 i15 = nday / 16 326 iman = INT( raamo ) 327 imois = nmonth + i15 - 1 328 IF( imois == 0 ) imois = iman 329 330 ! Calendar computation 331 IF( kt == nit000 .OR. imois /= nflx1 ) THEN 332 333 IF( kt == nit000 ) nflx1 = 0 334 335 ! nflx1 number of the first file record used in the simulation 336 ! nflx2 number of the last file record 337 338 nflx1 = imois 339 nflx2 = nflx1 + 1 340 nflx1 = MOD( nflx1, iman ) 341 nflx2 = MOD( nflx2, iman ) 342 IF( nflx1 == 0 ) nflx1 = iman 343 IF( nflx2 == 0 ) nflx2 = iman 344 IF(lwp) WRITE(numout,*) 345 IF(lwp) WRITE(numout,*) ' p4z_sbc : first record file used nflx1 ',nflx1 346 IF(lwp) WRITE(numout,*) ' p4z_sbc : last record file used nflx2 ',nflx2 347 348 ENDIF 349 350 ! 3. at every time step interpolation of fluxes 351 ! --------------------------------------------- 352 353 zxy = FLOAT( nday + 15 - 30 * i15 ) / 30 354 dust(:,:) = ( (1.-zxy) * dustmo(:,:,nflx1) + zxy * dustmo(:,:,nflx2) ) 355 339 ! 340 IF( nn_timing == 1 ) CALL timing_start('p4z_sbc') 341 ! 342 ! Compute dust at nit000 or only if there is more than 1 time record in dust file 343 IF( ln_dust ) THEN 344 IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_dust > 1 ) ) THEN 345 CALL fld_read( kt, 1, sf_dust ) 346 dust(:,:) = sf_dust(1)%fnow(:,:,1) 347 ENDIF 348 ENDIF 349 350 ! N/P and Si releases due to coastal rivers 351 ! Compute river at nit000 or only if there is more than 1 time record in river file 352 ! ----------------------------------------- 353 IF( ln_river ) THEN 354 IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_riv > 1 ) ) THEN 355 CALL fld_read( kt, 1, sf_riverdic ) 356 CALL fld_read( kt, 1, sf_riverdoc ) 357 DO jj = 1, jpj 358 DO ji = 1, jpi 359 zcoef = ryyss * cvol(ji,jj,1) 360 cotdep(ji,jj) = sf_riverdic(1)%fnow(ji,jj,1) * 1E9 / ( 12. * zcoef + rtrn ) 361 rivinp(ji,jj) = ( sf_riverdic(1)%fnow(ji,jj,1) + sf_riverdoc(1)%fnow(ji,jj,1) ) * 1E9 / ( 31.6* zcoef + rtrn ) 362 END DO 363 END DO 364 ENDIF 365 ENDIF 366 367 ! Compute N deposition at nit000 or only if there is more than 1 time record in N deposition file 368 IF( ln_ndepo ) THEN 369 IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_ndep > 1 ) ) THEN 370 CALL fld_read( kt, 1, sf_ndepo ) 371 DO jj = 1, jpj 372 DO ji = 1, jpi 373 nitdep(ji,jj) = 7.6 * sf_ndepo(1)%fnow(ji,jj,1) / ( 14E6 * ryyss * fse3t(ji,jj,1) + rtrn ) 374 END DO 375 END DO 376 ENDIF 377 ENDIF 378 ! 379 IF( nn_timing == 1 ) CALL timing_stop('p4z_sbc') 380 ! 356 381 END SUBROUTINE p4z_sbc 357 382 358 359 383 SUBROUTINE p4z_sed_init 360 384 361 385 !!---------------------------------------------------------------------- 362 !! *** ROUTINEp4z_sed_init ***363 !! 364 !! ** Purpose : Initialization of the external sources of nutrients365 !! 366 !! ** Method : Read the files and compute the budget367 !! called at the first timestep (nit000)386 !! *** routine p4z_sed_init *** 387 !! 388 !! ** purpose : initialization of the external sources of nutrients 389 !! 390 !! ** method : read the files and compute the budget 391 !! called at the first timestep (nittrc000) 368 392 !! 369 393 !! ** input : external netcdf files 370 394 !! 371 395 !!---------------------------------------------------------------------- 372 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 373 USE wrk_nemo, ONLY: zriverdoc => wrk_2d_1, zriver => wrk_2d_2, zndepo => wrk_2d_3 374 USE wrk_nemo, ONLY: zcmask => wrk_3d_2 375 ! 376 INTEGER :: ji, jj, jk, jm 377 INTEGER :: numriv, numbath, numdep 378 REAL(wp) :: zcoef 379 REAL(wp) :: expide, denitide,zmaskt 380 ! 381 NAMELIST/nampissed/ ln_dustfer, ln_river, ln_ndepo, ln_sedinput, sedfeinput, dustsolub 396 ! 397 INTEGER :: ji, jj, jk, jm 398 INTEGER :: numdust, numriv, numiron, numdepo 399 INTEGER :: ierr, ierr1, ierr2, ierr3 400 REAL(wp) :: zexpide, zdenitide, zmaskt 401 REAL(wp), DIMENSION(nbtimes) :: zsteps ! times records 402 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zdust, zndepo, zriverdic, zriverdoc, zcmask 403 ! 404 CHARACTER(len=100) :: cn_dir ! Root directory for location of ssr files 405 TYPE(FLD_N) :: sn_dust, sn_riverdoc, sn_riverdic, sn_ndepo, sn_ironsed ! informations about the fields to be read 406 NAMELIST/nampissed/cn_dir, sn_dust, sn_riverdic, sn_riverdoc, sn_ndepo, sn_ironsed, & 407 & ln_dust, ln_river, ln_ndepo, ln_ironsed, & 408 & sedfeinput, dustsolub, wdust, nitrfix, diazolight, concfediaz 382 409 !!---------------------------------------------------------------------- 383 384 IF( ( wrk_in_use(2, 1,2,3) ) .OR. ( wrk_in_use(3, 2) ) ) THEN 385 CALL ctl_stop('p4z_sed_init: requested workspace arrays unavailable') ; RETURN 386 END IF 387 ! 388 REWIND( numnat ) ! read numnat 389 READ ( numnat, nampissed ) 410 ! 411 IF( nn_timing == 1 ) CALL timing_start('p4z_sed_init') 412 ! 413 ! ! number of seconds per year and per month 414 ryyss = nyear_len(1) * rday 415 rmtss = ryyss / raamo 416 r1_rday = 1. / rday 417 r1_ryyss = 1. / ryyss 418 ! !* set file information 419 cn_dir = './' ! directory in which the model is executed 420 ! ... default values (NB: frequency positive => hours, negative => months) 421 ! ! file ! frequency ! variable ! time intep ! clim ! 'yearly' or ! weights ! rotation ! 422 ! ! name ! (hours) ! name ! (T/F) ! (T/F) ! 'monthly' ! filename ! pairs ! 423 sn_dust = FLD_N( 'dust' , -1 , 'dust' , .true. , .true. , 'yearly' , '' , '' ) 424 sn_riverdic = FLD_N( 'river' , -12 , 'riverdic' , .false. , .true. , 'yearly' , '' , '' ) 425 sn_riverdoc = FLD_N( 'river' , -12 , 'riverdoc' , .false. , .true. , 'yearly' , '' , '' ) 426 sn_ndepo = FLD_N( 'ndeposition', -12 , 'ndep' , .false. , .true. , 'yearly' , '' , '' ) 427 sn_ironsed = FLD_N( 'ironsed' , -12 , 'bathy' , .false. , .true. , 'yearly' , '' , '' ) 428 429 REWIND( numnatp ) ! read numnatp 430 READ ( numnatp, nampissed ) 390 431 391 432 IF(lwp) THEN 392 433 WRITE(numout,*) ' ' 393 WRITE(numout,*) ' Namelist : nampissed '434 WRITE(numout,*) ' namelist : nampissed ' 394 435 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~ ' 395 WRITE(numout,*) ' Dust input from the atmosphere ln_dustfer = ', ln_dustfer 396 WRITE(numout,*) ' River input of nutrients ln_river = ', ln_river 397 WRITE(numout,*) ' Atmospheric deposition of N ln_ndepo = ', ln_ndepo 398 WRITE(numout,*) ' Fe input from sediments ln_sedinput = ', ln_sedinput 399 WRITE(numout,*) ' Coastal release of Iron sedfeinput =', sedfeinput 400 WRITE(numout,*) ' Solubility of the dust dustsolub =', dustsolub 401 ENDIF 402 403 ! Dust input from the atmosphere 436 WRITE(numout,*) ' dust input from the atmosphere ln_dust = ', ln_dust 437 WRITE(numout,*) ' river input of nutrients ln_river = ', ln_river 438 WRITE(numout,*) ' atmospheric deposition of n ln_ndepo = ', ln_ndepo 439 WRITE(numout,*) ' fe input from sediments ln_sedinput = ', ln_ironsed 440 WRITE(numout,*) ' coastal release of iron sedfeinput = ', sedfeinput 441 WRITE(numout,*) ' solubility of the dust dustsolub = ', dustsolub 442 WRITE(numout,*) ' sinking speed of the dust wdust = ', wdust 443 WRITE(numout,*) ' nitrogen fixation rate nitrfix = ', nitrfix 444 WRITE(numout,*) ' nitrogen fixation sensitivty to light diazolight = ', diazolight 445 WRITE(numout,*) ' fe half-saturation cste for diazotrophs concfediaz = ', concfediaz 446 END IF 447 448 IF( ln_dust .OR. ln_river .OR. ln_ndepo ) THEN 449 ll_sbc = .TRUE. 450 ELSE 451 ll_sbc = .FALSE. 452 ENDIF 453 454 ! dust input from the atmosphere 404 455 ! ------------------------------ 405 IF( ln_dust fer) THEN406 IF(lwp) WRITE(numout,*) ' Initialize dust input from atmosphere '456 IF( ln_dust ) THEN 457 IF(lwp) WRITE(numout,*) ' initialize dust input from atmosphere ' 407 458 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' 408 CALL iom_open ( 'dust.orca.nc', numdust ) 409 DO jm = 1, jpmth 410 CALL iom_get( numdust, jpdom_data, 'dust', dustmo(:,:,jm), jm ) 459 ! 460 ALLOCATE( sf_dust(1), STAT=ierr ) !* allocate and fill sf_sst (forcing structure) with sn_sst 461 IF( ierr > 0 ) CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_apr structure' ) 462 ! 463 CALL fld_fill( sf_dust, (/ sn_dust /), cn_dir, 'p4z_sed_init', 'Iron from sediment ', 'nampissed' ) 464 ALLOCATE( sf_dust(1)%fnow(jpi,jpj,1) ) 465 IF( sn_dust%ln_tint ) ALLOCATE( sf_dust(1)%fdta(jpi,jpj,1,2) ) 466 ! 467 ! Get total input dust ; need to compute total atmospheric supply of Si in a year 468 CALL iom_open ( TRIM( sn_dust%clname ) , numdust ) 469 CALL iom_gettime( numdust, zsteps, kntime=ntimes_dust) ! get number of record in file 470 ALLOCATE( zdust(jpi,jpj,ntimes_dust) ) 471 DO jm = 1, ntimes_dust 472 CALL iom_get( numdust, jpdom_data, TRIM( sn_dust%clvar ), zdust(:,:,jm), jm ) 411 473 END DO 412 474 CALL iom_close( numdust ) 475 sumdepsi = 0.e0 476 DO jm = 1, ntimes_dust 477 sumdepsi = sumdepsi + glob_sum( zdust(:,:,jm) * e1e2t(:,:) * tmask(:,:,1) ) 478 ENDDO 479 sumdepsi = sumdepsi * r1_ryyss * 8.8 * 0.075 / 28.1 480 DEALLOCATE( zdust) 413 481 ELSE 414 dust mo(:,:,:) = 0.e0415 dust(:,:) = 0.0416 END IF417 418 ! Nutrient input from rivers482 dust(:,:) = 0._wp 483 sumdepsi = 0._wp 484 END IF 485 486 ! nutrient input from rivers 419 487 ! -------------------------- 420 488 IF( ln_river ) THEN 421 IF(lwp) WRITE(numout,*) ' Initialize the nutrient input by rivers from river.orca.nc file' 422 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 423 CALL iom_open ( 'river.orca.nc', numriv ) 424 CALL iom_get ( numriv, jpdom_data, 'riverdic', zriver (:,:), jpyr ) 425 CALL iom_get ( numriv, jpdom_data, 'riverdoc', zriverdoc(:,:), jpyr ) 489 ALLOCATE( sf_riverdic(1), STAT=ierr1 ) !* allocate and fill sf_sst (forcing structure) with sn_sst 490 ALLOCATE( sf_riverdoc(1), STAT=ierr2 ) !* allocate and fill sf_sst (forcing structure) with sn_sst 491 IF( ierr1 + ierr2 > 0 ) CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_apr structure' ) 492 ! 493 CALL fld_fill( sf_riverdic, (/ sn_riverdic /), cn_dir, 'p4z_sed_init', 'Input DOC from river ', 'nampissed' ) 494 CALL fld_fill( sf_riverdoc, (/ sn_riverdoc /), cn_dir, 'p4z_sed_init', 'Input DOC from river ', 'nampissed' ) 495 ALLOCATE( sf_riverdic(1)%fnow(jpi,jpj,1) ) 496 ALLOCATE( sf_riverdoc(1)%fnow(jpi,jpj,1) ) 497 IF( sn_riverdic%ln_tint ) ALLOCATE( sf_riverdic(1)%fdta(jpi,jpj,1,2) ) 498 IF( sn_riverdoc%ln_tint ) ALLOCATE( sf_riverdoc(1)%fdta(jpi,jpj,1,2) ) 499 ! Get total input rivers ; need to compute total river supply in a year 500 CALL iom_open ( TRIM( sn_riverdic%clname ), numriv ) 501 CALL iom_gettime( numriv, zsteps, kntime=ntimes_riv) 502 ALLOCATE( zriverdic(jpi,jpj,ntimes_riv) ) ; ALLOCATE( zriverdoc(jpi,jpj,ntimes_riv) ) 503 DO jm = 1, ntimes_riv 504 CALL iom_get( numriv, jpdom_data, TRIM( sn_riverdic%clvar ), zriverdic(:,:,jm), jm ) 505 CALL iom_get( numriv, jpdom_data, TRIM( sn_riverdoc%clvar ), zriverdoc(:,:,jm), jm ) 506 END DO 426 507 CALL iom_close( numriv ) 508 ! N/P and Si releases due to coastal rivers 509 ! ----------------------------------------- 510 rivpo4input = 0._wp 511 rivalkinput = 0._wp 512 DO jm = 1, ntimes_riv 513 rivpo4input = rivpo4input + glob_sum( ( zriverdic(:,:,jm) + zriverdoc(:,:,jm) ) * tmask(:,:,1) ) 514 rivalkinput = rivalkinput + glob_sum( zriverdic(:,:,jm) * tmask(:,:,1) ) 515 END DO 516 rivpo4input = rivpo4input * 1E9 / 31.6_wp 517 rivalkinput = rivalkinput * 1E9 / 12._wp 518 DEALLOCATE( zriverdic) ; DEALLOCATE( zriverdoc) 427 519 ELSE 428 zriver (:,:) = 0.e0 429 zriverdoc(:,:) = 0.e0 430 endif 431 432 ! Nutrient input from dust 520 rivinp(:,:) = 0._wp 521 cotdep(:,:) = 0._wp 522 rivpo4input = 0._wp 523 rivalkinput = 0._wp 524 END IF 525 526 ! nutrient input from dust 433 527 ! ------------------------ 434 528 IF( ln_ndepo ) THEN 435 IF(lwp) WRITE(numout,*) ' Initialize the nutrient input by dust from ndeposition.orca.nc'529 IF(lwp) WRITE(numout,*) ' initialize the nutrient input by dust from ndeposition.orca.nc' 436 530 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 437 CALL iom_open ( 'ndeposition.orca.nc', numdep ) 438 CALL iom_get ( numdep, jpdom_data, 'ndep', zndepo(:,:), jpyr ) 439 CALL iom_close( numdep ) 531 ALLOCATE( sf_ndepo(1), STAT=ierr3 ) !* allocate and fill sf_sst (forcing structure) with sn_sst 532 IF( ierr3 > 0 ) CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_apr structure' ) 533 ! 534 CALL fld_fill( sf_ndepo, (/ sn_ndepo /), cn_dir, 'p4z_sed_init', 'Iron from sediment ', 'nampissed' ) 535 ALLOCATE( sf_ndepo(1)%fnow(jpi,jpj,1) ) 536 IF( sn_ndepo%ln_tint ) ALLOCATE( sf_ndepo(1)%fdta(jpi,jpj,1,2) ) 537 ! 538 ! Get total input dust ; need to compute total atmospheric supply of N in a year 539 CALL iom_open ( TRIM( sn_ndepo%clname ), numdepo ) 540 CALL iom_gettime( numdepo, zsteps, kntime=ntimes_ndep) 541 ALLOCATE( zndepo(jpi,jpj,ntimes_ndep) ) 542 DO jm = 1, ntimes_ndep 543 CALL iom_get( numdepo, jpdom_data, TRIM( sn_ndepo%clvar ), zndepo(:,:,jm), jm ) 544 END DO 545 CALL iom_close( numdepo ) 546 nitdepinput = 0._wp 547 DO jm = 1, ntimes_ndep 548 nitdepinput = nitdepinput + glob_sum( zndepo(:,:,jm) * e1e2t(:,:) * tmask(:,:,1) ) 549 ENDDO 550 nitdepinput = nitdepinput * 7.6 / 14E6 551 DEALLOCATE( zndepo) 440 552 ELSE 441 zndepo(:,:) = 0.e0 442 ENDIF 443 444 ! Coastal and island masks 553 nitdep(:,:) = 0._wp 554 nitdepinput = 0._wp 555 ENDIF 556 557 ! coastal and island masks 445 558 ! ------------------------ 446 IF( ln_ sedinput) THEN447 IF(lwp) WRITE(numout,*) ' Computation of an island mask to enhance coastal supply of iron'559 IF( ln_ironsed ) THEN 560 IF(lwp) WRITE(numout,*) ' computation of an island mask to enhance coastal supply of iron' 448 561 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 449 IF(lwp) WRITE(numout,*) ' from bathy.orca.nc file '450 CALL iom_open ( 'bathy.orca.nc', numbath)451 CALL iom_get ( num bath, jpdom_data, 'bathy', zcmask(:,:,:), jpyr)452 CALL iom_close( num bath)562 CALL iom_open ( TRIM( sn_ironsed%clname ), numiron ) 563 ALLOCATE( zcmask(jpi,jpj,jpk) ) 564 CALL iom_get ( numiron, jpdom_data, TRIM( sn_ironsed%clvar ), zcmask(:,:,:), 1 ) 565 CALL iom_close( numiron ) 453 566 ! 454 567 DO jk = 1, 5 … … 459 572 & * tmask(ji,jj-1,jk) * tmask(ji,jj,jk+1) 460 573 IF( zmaskt == 0. ) zcmask(ji,jj,jk ) = MAX( 0.1, zcmask(ji,jj,jk) ) 461 END IF574 END IF 462 575 END DO 463 576 END DO 464 577 END DO 578 CALL lbc_lnk( zcmask , 'T', 1. ) ! lateral boundary conditions on cmask (sign unchanged) 465 579 DO jk = 1, jpk 466 580 DO jj = 1, jpj 467 581 DO ji = 1, jpi 468 expide = MIN( 8.,( fsdept(ji,jj,jk) / 500. )**(-1.5) )469 denitide = -0.9543 + 0.7662 * LOG( expide ) - 0.235 * LOG(expide )**2470 zcmask(ji,jj,jk) = zcmask(ji,jj,jk) * MIN( 1., EXP( denitide ) / 0.5 )582 zexpide = MIN( 8.,( fsdept(ji,jj,jk) / 500. )**(-1.5) ) 583 zdenitide = -0.9543 + 0.7662 * LOG( zexpide ) - 0.235 * LOG( zexpide )**2 584 zcmask(ji,jj,jk) = zcmask(ji,jj,jk) * MIN( 1., EXP( zdenitide ) / 0.5 ) 471 585 END DO 472 586 END DO 473 587 END DO 588 ! Coastal supply of iron 589 ! ------------------------- 590 ironsed(:,:,jpk) = 0._wp 591 DO jk = 1, jpkm1 592 ironsed(:,:,jk) = sedfeinput * zcmask(:,:,jk) / ( fse3t(:,:,jk) * rday ) 593 END DO 594 DEALLOCATE( zcmask) 474 595 ELSE 475 zcmask(:,:,:) = 0.e0 476 ENDIF 477 478 CALL lbc_lnk( zcmask , 'T', 1. ) ! Lateral boundary conditions on zcmask (sign unchanged) 479 480 481 ! ! Number of seconds per year and per month 482 ryyss = nyear_len(1) * rday 483 rmtss = ryyss / raamo 484 rday1 = 1. / rday 485 ryyss1 = 1. / ryyss 486 ! ! ocean surface cell 487 488 ! total atmospheric supply of Si 489 ! ------------------------------ 490 sumdepsi = 0.e0 491 DO jm = 1, jpmth 492 zcoef = 1. / ( 12. * rmtss ) * 8.8 * 0.075 / 28.1 493 sumdepsi = sumdepsi + glob_sum( dustmo(:,:,jm) * e1e2t(:,:) ) * zcoef 494 ENDDO 495 496 ! N/P and Si releases due to coastal rivers 497 ! ----------------------------------------- 498 DO jj = 1, jpj 499 DO ji = 1, jpi 500 zcoef = ryyss * e1e2t(ji,jj) * fse3t(ji,jj,1) * tmask(ji,jj,1) 501 cotdep(ji,jj) = zriver(ji,jj) *1E9 / ( 12. * zcoef + rtrn ) 502 rivinp(ji,jj) = (zriver(ji,jj)+zriverdoc(ji,jj)) *1E9 / ( 31.6* zcoef + rtrn ) 503 nitdep(ji,jj) = 7.6 * zndepo(ji,jj) / ( 14E6*ryyss*fse3t(ji,jj,1) + rtrn ) 504 END DO 505 END DO 506 ! Lateral boundary conditions on ( cotdep, rivinp, nitdep ) (sign unchanged) 507 CALL lbc_lnk( cotdep , 'T', 1. ) ; CALL lbc_lnk( rivinp , 'T', 1. ) ; CALL lbc_lnk( nitdep , 'T', 1. ) 508 509 rivpo4input = glob_sum( rivinp(:,:) * cvol(:,:,1) ) * ryyss 510 rivalkinput = glob_sum( cotdep(:,:) * cvol(:,:,1) ) * ryyss 511 nitdepinput = glob_sum( nitdep(:,:) * cvol(:,:,1) ) * ryyss 512 513 514 ! Coastal supply of iron 515 ! ------------------------- 516 DO jk = 1, jpkm1 517 ironsed(:,:,jk) = sedfeinput * zcmask(:,:,jk) / ( fse3t(:,:,jk) * rday ) 518 END DO 519 CALL lbc_lnk( ironsed , 'T', 1. ) ! Lateral boundary conditions on ( ironsed ) (sign unchanged) 520 521 IF( ( wrk_not_released(2, 1,2,3) ) .OR. ( wrk_not_released(3, 2) ) ) & 522 & CALL ctl_stop('p4z_sed_init: failed to release workspace arrays') 523 596 ironsed(:,:,:) = 0._wp 597 ENDIF 598 ! 599 IF( ll_sbc ) CALL p4z_sbc( nit000 ) 600 ! 601 IF(lwp) THEN 602 WRITE(numout,*) 603 WRITE(numout,*) ' Total input of elements from river supply' 604 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 605 WRITE(numout,*) ' N Supply : ', rivpo4input/7.6*1E3/1E12*14.,' TgN/yr' 606 WRITE(numout,*) ' Si Supply : ', rivalkinput/6.*1E3/1E12*32.,' TgSi/yr' 607 WRITE(numout,*) ' Alk Supply : ', rivalkinput*1E3/1E12,' Teq/yr' 608 WRITE(numout,*) ' DIC Supply : ', rivpo4input*2.631*1E3*12./1E12,'TgC/yr' 609 WRITE(numout,*) 610 WRITE(numout,*) ' Total input of elements from atmospheric supply' 611 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 612 WRITE(numout,*) ' N Supply : ', nitdepinput/7.6*1E3/1E12*14.,' TgN/yr' 613 WRITE(numout,*) 614 ENDIF 615 ! 616 IF( nn_timing == 1 ) CALL timing_stop('p4z_sed_init') 617 ! 524 618 END SUBROUTINE p4z_sed_init 525 619 … … 529 623 !!---------------------------------------------------------------------- 530 624 531 ALLOCATE( dustmo(jpi,jpj,jpmth), dust(jpi,jpj) , & 532 & rivinp(jpi,jpj) , cotdep(jpi,jpj) , & 533 & nitdep(jpi,jpj) , ironsed(jpi,jpj,jpk), STAT=p4z_sed_alloc ) 625 ALLOCATE( dust (jpi,jpj), rivinp(jpi,jpj) , cotdep(jpi,jpj), & 626 & nitdep(jpi,jpj), ironsed(jpi,jpj,jpk), STAT=p4z_sed_alloc ) 534 627 535 628 IF( p4z_sed_alloc /= 0 ) CALL ctl_warn('p4z_sed_alloc : failed to allocate arrays.') -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsink.F90
r2715 r3294 2 2 !!====================================================================== 3 3 !! *** MODULE p4zsink *** 4 !! TOP : PISCES Computevertical flux of particulate matter due to gravitational sinking4 !! TOP : PISCES vertical flux of particulate matter due to gravitational sinking 5 5 !!====================================================================== 6 6 !! History : 1.0 ! 2004 (O. Aumont) Original code 7 7 !! 2.0 ! 2007-12 (C. Ethe, G. Madec) F90 8 !! 3.4 ! 2011-06 (O. Aumont, C. Ethe) Change aggregation formula 9 !!---------------------------------------------------------------------- 8 10 #if defined key_pisces 9 11 !!---------------------------------------------------------------------- 10 12 !! p4z_sink : Compute vertical flux of particulate matter due to gravitational sinking 13 !! p4z_sink_init : Unitialisation of sinking speed parameters 14 !! p4z_sink_alloc : Allocate sinking speed variables 11 15 !!---------------------------------------------------------------------- 12 USE trc13 USE oce_trc !14 USE sms_pisces 15 USE prtctl_trc 16 USE iom 16 USE oce_trc ! shared variables between ocean and passive tracers 17 USE trc ! passive tracers common variables 18 USE sms_pisces ! PISCES Source Minus Sink variables 19 USE prtctl_trc ! print control for debugging 20 USE iom ! I/O manager 17 21 18 22 IMPLICIT NONE … … 80 84 !! ** Method : - ??? 81 85 !!--------------------------------------------------------------------- 82 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released83 USE wrk_nemo, ONLY: znum3d => wrk_3d_284 86 ! 85 87 INTEGER, INTENT(in) :: kt, jnt … … 91 93 REAL(wp) :: zdiv , zdiv1, zdiv2, zdiv3, zdiv4, zdiv5 92 94 REAL(wp) :: zval1, zval2, zval3, zval4 93 #if defined key_diatrc94 95 REAL(wp) :: zrfact2 95 96 INTEGER :: ik1 96 #endif97 97 CHARACTER (len=25) :: charout 98 !!--------------------------------------------------------------------- 99 ! 100 IF( wrk_in_use(3, 2 ) ) THEN 101 CALL ctl_stop('p4z_sink: requested workspace arrays unavailable') ; RETURN 102 ENDIF 103 98 REAL(wp), POINTER, DIMENSION(:,:,:) :: znum3d 99 !!--------------------------------------------------------------------- 100 ! 101 IF( nn_timing == 1 ) CALL timing_start('p4z_sink') 102 ! 103 CALL wrk_alloc( jpi, jpj, jpk, znum3d ) 104 ! 104 105 ! Initialisation of variables used to compute Sinking Speed 105 106 ! --------------------------------------------------------- … … 193 194 & * (zeps-1)/zdiv1 + 3.*(zfm*xkr_mass_max-xkr_mass_min) & 194 195 & * (zfm*xkr_mass_max**2-xkr_mass_min**2) & 195 & * (zeps-1.)**2/(zdiv2*zdiv3)) & 196 # if defined key_degrad 197 & *facvol(ji,jj,jk) & 198 # endif 199 & ) 200 201 zagg2 = ( 2*0.163*trn(ji,jj,jk,jpnum)**2*zfm* & 196 & * (zeps-1.)**2/(zdiv2*zdiv3)) 197 zagg2 = 2*0.163*trn(ji,jj,jk,jpnum)**2*zfm* & 202 198 & ((xkr_mass_max**3+3.*(xkr_mass_max**2 & 203 199 & *xkr_mass_min*(zeps-1.)/zdiv2 & … … 205 201 & +xkr_mass_min**3*(zeps-1)/zdiv1) & 206 202 & -zfm*xkr_mass_max**3*(1.+3.*((zeps-1.)/ & 207 & (zeps-2.)+(zeps-1.)/zdiv3)+(zeps-1.)/zdiv1)) & 208 # if defined key_degrad 209 & *facvol(ji,jj,jk) & 210 # endif 211 & ) 212 213 zagg3 = ( 0.163*trn(ji,jj,jk,jpnum)**2*zfm**2*8. * xkr_mass_max**3 & 214 # if defined key_degrad 215 & *facvol(ji,jj,jk) & 216 # endif 217 & ) 218 219 zaggsh = ( zagg1 + zagg2 + zagg3 ) * rfact2 * xdiss(ji,jj,jk) / 1000. 220 203 & (zeps-2.)+(zeps-1.)/zdiv3)+(zeps-1.)/zdiv1)) 204 205 zagg3 = 0.163*trn(ji,jj,jk,jpnum)**2*zfm**2*8. * xkr_mass_max**3 206 221 207 ! Aggregation of small into large particles 222 208 ! Part II : Differential settling 223 209 ! ---------------------------------------------- 224 210 225 zagg4 = (2.*3.141*0.125*trn(ji,jj,jk,jpnum)**2* &211 zagg4 = 2.*3.141*0.125*trn(ji,jj,jk,jpnum)**2* & 226 212 & xkr_wsbio_min*(zeps-1.)**2 & 227 213 & *(xkr_mass_min**2*((1.-zsm*zfm)/(zdiv3*zdiv4) & 228 214 & -(1.-zfm)/(zdiv*(zeps-1.)))- & 229 215 & ((zfm*zfm*xkr_mass_max**2*zsm-xkr_mass_min**2) & 230 & *xkr_eta)/(zdiv*zdiv3*zdiv5) ) & 231 # if defined key_degrad 232 & *facvol(ji,jj,jk) & 233 # endif 234 & ) 235 236 zagg5 = ( 2.*3.141*0.125*trn(ji,jj,jk,jpnum)**2 & 216 & *xkr_eta)/(zdiv*zdiv3*zdiv5) ) 217 218 zagg5 = 2.*3.141*0.125*trn(ji,jj,jk,jpnum)**2 & 237 219 & *(zeps-1.)*zfm*xkr_wsbio_min & 238 220 & *(zsm*(xkr_mass_min**2-zfm*xkr_mass_max**2) & 239 221 & /zdiv3-(xkr_mass_min**2-zfm*zsm*xkr_mass_max**2) & 240 & /zdiv) & 241 # if defined key_degrad 242 & *facvol(ji,jj,jk) & 243 # endif 244 & ) 245 222 & /zdiv) 246 223 zaggsi = ( zagg4 + zagg5 ) * xstep / 10. 247 224 … … 253 230 zaggdoc = ( 0.4 * trn(ji,jj,jk,jpdoc) & 254 231 & + 1018. * trn(ji,jj,jk,jppoc) ) * xstep & 232 & * xdiss(ji,jj,jk) * trn(ji,jj,jk,jpdoc) 233 255 234 # if defined key_degrad 256 & * facvol(ji,jj,jk) & 235 zagg1 = zagg1 * facvol(ji,jj,jk) 236 zagg2 = zagg2 * facvol(ji,jj,jk) 237 zagg3 = zagg3 * facvol(ji,jj,jk) 238 zagg4 = zagg4 * facvol(ji,jj,jk) 239 zagg5 = zagg5 * facvol(ji,jj,jk) 240 zaggdoc = zaggdoc * facvol(ji,jj,jk) 257 241 # endif 258 & * xdiss(ji,jj,jk) * trn(ji,jj,jk,jpdoc) 259 242 zaggsh = ( zagg1 + zagg2 + zagg3 ) * rfact2 * xdiss(ji,jj,jk) / 1000. 243 zaggsi = ( zagg4 + zagg5 ) * xstep / 10. 244 zagg = 0.5 * xkr_stick * ( zaggsh + zaggsi ) 245 ! 260 246 znumdoc = trn(ji,jj,jk,jpnum) / ( trn(ji,jj,jk,jppoc) + rtrn ) 261 247 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zaggdoc … … 268 254 END DO 269 255 270 #if defined key_diatrc 271 zrfact2 = 1.e3 * rfact2r272 ik1 = iksed + 1273 # if ! defined key_iomput 274 trc2d(:,: ,jp_pcs0_2d + 4) = sinking (:,:,ik1) * zrfact2 * tmask(:,:,1)275 trc2d(:,: ,jp_pcs0_2d + 5) = sinking2(:,:,ik1) * zrfact2 * tmask(:,:,1)276 trc2d(:,: ,jp_pcs0_2d + 6) = sinkfer (:,:,ik1) * zrfact2 * tmask(:,:,1)277 trc2d(:,: ,jp_pcs0_2d + 7) = sinksil (:,:,ik1) * zrfact2 * tmask(:,:,1)278 trc2d(:,: ,jp_pcs0_2d + 8) = sinkcal (:,:,ik1) * zrfact2 * tmask(:,:,1)279 trc3d(:,:,:,jp_pcs0_3d + 11) = sinking (:,:,:) * zrfact2 * tmask(:,:,:)280 trc3d(:,:,:,jp_pcs0_3d + 12) = sinking2(:,:,:) * zrfact2 * tmask(:,:,:)281 trc3d(:,:,:,jp_pcs0_3d + 13) = sinksil (:,:,:) * zrfact2 * tmask(:,:,:)282 trc3d(:,:,:,jp_pcs0_3d + 14) = sinkcal (:,:,:) * zrfact2 * tmask(:,:,:)283 trc3d(:,:,:,jp_pcs0_3d + 15) = znum3d (:,:,:) * tmask(:,:,:)284 trc3d(:,:,:,jp_pcs0_3d + 16) = wsbio3 (:,:,:) * tmask(:,:,:)285 trc3d(:,:,:,jp_pcs0_3d + 17) = wsbio4 (:,:,:) * tmask(:,:,:)286 #else 287 IF( jnt == nrdttrc ) then288 CALL iom_put( "POCFlx" , sinking (:,:,:) * zrfact2 * tmask(:,:,:) ) ! POC export289 CALL iom_put( "NumFlx" , sinking2 (:,:,:) * zrfact2 * tmask(:,:,:) ) ! Num export290 CALL iom_put( "SiFlx" , sinksil (:,:,:) * zrfact2 * tmask(:,:,:) ) ! Silica export291 CALL iom_put( "CaCO3Flx", sinkcal (:,:,:) * zrfact2 * tmask(:,:,:) ) ! Calcite export292 CALL iom_put( "xnum" , znum3d (:,:,:) * tmask(:,:,:) ) ! Number of particles in aggregats293 CALL iom_put( "W1" , wsbio3 (:,:,:) * tmask(:,:,:) ) ! sinking speed of POC294 CALL iom_put( "W2" , wsbio4 (:,:,:) * tmask(:,:,:) ) ! sinking speed of aggregats295 CALL iom_put( "PMO" , sinking (:,:,ik1) * zrfact2 * tmask(:,:,1) ) ! POC export at 100m296 CALL iom_put( "PMO2" , sinking2(:,:,ik1) * zrfact2 * tmask(:,:,1) ) ! Num export at 100m297 CALL iom_put( "ExpFe1" , sinkfer (:,:,ik1) * zrfact2 * tmask(:,:,1) ) ! Export of iron at 100m298 CALL iom_put( "ExpSi" , sinksil (:,:,ik1) * zrfact2 * tmask(:,:,1) ) ! export of silica at 100m299 CALL iom_put( "ExpCaCO3", sinkcal (:,:,ik1) * zrfact2 * tmask(:,:,1) ) ! export of calcite at 100m300 ENDIF301 # 302 303 #endif 256 IF( ln_diatrc ) THEN 257 ! 258 ik1 = iksed + 1 259 zrfact2 = 1.e3 * rfact2r 260 IF( jnt == nrdttrc ) THEN 261 CALL iom_put( "POCFlx" , sinking (:,:,:) * zrfact2 * tmask(:,:,:) ) ! POC export 262 CALL iom_put( "NumFlx" , sinking2 (:,:,:) * zrfact2 * tmask(:,:,:) ) ! Num export 263 CALL iom_put( "SiFlx" , sinksil (:,:,:) * zrfact2 * tmask(:,:,:) ) ! Silica export 264 CALL iom_put( "CaCO3Flx", sinkcal (:,:,:) * zrfact2 * tmask(:,:,:) ) ! Calcite export 265 CALL iom_put( "xnum" , znum3d (:,:,:) * tmask(:,:,:) ) ! Number of particles in aggregats 266 CALL iom_put( "W1" , wsbio3 (:,:,:) * tmask(:,:,:) ) ! sinking speed of POC 267 CALL iom_put( "W2" , wsbio4 (:,:,:) * tmask(:,:,:) ) ! sinking speed of aggregats 268 CALL iom_put( "PMO" , sinking (:,:,ik1) * zrfact2 * tmask(:,:,1) ) ! POC export at 100m 269 CALL iom_put( "PMO2" , sinking2(:,:,ik1) * zrfact2 * tmask(:,:,1) ) ! Num export at 100m 270 CALL iom_put( "ExpFe1" , sinkfer (:,:,ik1) * zrfact2 * tmask(:,:,1) ) ! Export of iron at 100m 271 CALL iom_put( "ExpSi" , sinksil (:,:,ik1) * zrfact2 * tmask(:,:,1) ) ! export of silica at 100m 272 CALL iom_put( "ExpCaCO3", sinkcal (:,:,ik1) * zrfact2 * tmask(:,:,1) ) ! export of calcite at 100m 273 ENDIF 274 # if ! defined key_iomput 275 trc2d(:,: ,jp_pcs0_2d + 4) = sinking (:,:,ik1) * zrfact2 * tmask(:,:,1) 276 trc2d(:,: ,jp_pcs0_2d + 5) = sinking2(:,:,ik1) * zrfact2 * tmask(:,:,1) 277 trc2d(:,: ,jp_pcs0_2d + 6) = sinkfer (:,:,ik1) * zrfact2 * tmask(:,:,1) 278 trc2d(:,: ,jp_pcs0_2d + 7) = sinksil (:,:,ik1) * zrfact2 * tmask(:,:,1) 279 trc2d(:,: ,jp_pcs0_2d + 8) = sinkcal (:,:,ik1) * zrfact2 * tmask(:,:,1) 280 trc3d(:,:,:,jp_pcs0_3d + 11) = sinking (:,:,:) * zrfact2 * tmask(:,:,:) 281 trc3d(:,:,:,jp_pcs0_3d + 12) = sinking2(:,:,:) * zrfact2 * tmask(:,:,:) 282 trc3d(:,:,:,jp_pcs0_3d + 13) = sinksil (:,:,:) * zrfact2 * tmask(:,:,:) 283 trc3d(:,:,:,jp_pcs0_3d + 14) = sinkcal (:,:,:) * zrfact2 * tmask(:,:,:) 284 trc3d(:,:,:,jp_pcs0_3d + 15) = znum3d (:,:,:) * tmask(:,:,:) 285 trc3d(:,:,:,jp_pcs0_3d + 16) = wsbio3 (:,:,:) * tmask(:,:,:) 286 trc3d(:,:,:,jp_pcs0_3d + 17) = wsbio4 (:,:,:) * tmask(:,:,:) 287 # endif 288 ! 289 ENDIF 304 290 ! 305 291 IF(ln_ctl) THEN ! print mean trends (used for debugging) … … 309 295 ENDIF 310 296 ! 311 IF( wrk_not_released(3, 2 ) ) CALL ctl_stop('p4z_sink: failed to release workspace arrays') 297 CALL wrk_alloc( jpi, jpj, jpk, znum3d ) 298 ! 299 IF( nn_timing == 1 ) CALL timing_stop('p4z_sink') 312 300 ! 313 301 END SUBROUTINE p4z_sink … … 335 323 !!---------------------------------------------------------------------- 336 324 ! 337 REWIND( numnat ) ! read nampiskrs 338 READ ( numnat, nampiskrs ) 325 IF( nn_timing == 1 ) CALL timing_start('p4z_sink_init') 326 ! 327 REWIND( numnatp ) ! read nampiskrs 328 READ ( numnatp, nampiskrs ) 339 329 340 330 IF(lwp) THEN … … 441 431 END DO 442 432 ! 433 IF( nn_timing == 1 ) CALL timing_stop('p4z_sink_init') 434 ! 443 435 END SUBROUTINE p4z_sink_init 444 436 … … 457 449 INTEGER :: ji, jj, jk 458 450 REAL(wp) :: zagg1, zagg2, zagg3, zagg4 459 REAL(wp) :: zagg , zaggfe, zaggdoc, zaggdoc2 460 REAL(wp) :: zfact, zwsmax, zstep 461 #if defined key_diatrc 451 REAL(wp) :: zagg , zaggfe, zaggdoc, zaggdoc2, zaggdoc3 452 REAL(wp) :: zfact, zwsmax, zmax, zstep 462 453 REAL(wp) :: zrfact2 463 454 INTEGER :: ik1 464 #endif465 455 CHARACTER (len=25) :: charout 466 456 !!--------------------------------------------------------------------- 467 457 ! 458 IF( nn_timing == 1 ) CALL timing_start('p4z_sink') 459 ! 468 460 ! Sinking speeds of detritus is increased with depth as shown 469 461 ! by data and from the coagulation theory … … 471 463 DO jk = 1, jpkm1 472 464 DO jj = 1, jpj 473 DO ji=1,jpi 474 zfact = MAX( 0., fsdepw(ji,jj,jk+1) - hmld(ji,jj) ) / 4000._wp 465 DO ji = 1,jpi 466 ! zmax = MAX( heup(ji,jj), hmld(ji,jj) ) 467 ! zfact = MAX( 0., fsdepw(ji,jj,jk+1) - zmax ) / 5000._wp 468 zmax = hmld(ji,jj) 469 zfact = MAX( 0., fsdepw(ji,jj,jk+1) - zmax ) / 4000._wp 475 470 wsbio4(ji,jj,jk) = wsbio2 + ( 200.- wsbio2 ) * zfact 476 471 END DO … … 526 521 DO jj = 1, jpj 527 522 DO ji = 1, jpi 523 ! 524 zstep = xstep 528 525 # if defined key_degrad 529 zstep = xstep * facvol(ji,jj,jk) 530 # else 531 zstep = xstep 526 zstep = zstep * facvol(ji,jj,jk) 532 527 # endif 533 528 zfact = zstep * xdiss(ji,jj,jk) 534 529 ! Part I : Coagulation dependent on turbulence 535 zagg1 = 940.* zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc)536 zagg2 = 1.054e4* zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc)530 zagg1 = 354. * zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) 531 zagg2 = 4452. * zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) 537 532 538 533 ! Part II : Differential settling 539 534 540 535 ! Aggregation of small into large particles 541 zagg3 = 0.66* zstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc)542 zagg4 = 0.e0* zstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc)536 zagg3 = 4.7 * zstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) 537 zagg4 = 0.4 * zstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) 543 538 544 539 zagg = zagg1 + zagg2 + zagg3 + zagg4 … … 546 541 547 542 ! Aggregation of DOC to small particles 548 zaggdoc = ( 80.* trn(ji,jj,jk,jpdoc) + 698. * trn(ji,jj,jk,jppoc) ) * zfact * trn(ji,jj,jk,jpdoc) 549 zaggdoc2 = 1.05e4 * zfact * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpdoc) 543 zaggdoc = ( 0.83 * trn(ji,jj,jk,jpdoc) + 271. * trn(ji,jj,jk,jppoc) ) * zfact * trn(ji,jj,jk,jpdoc) 544 zaggdoc2 = 1.07e4 * zfact * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpdoc) 545 zaggdoc3 = 0.02 * ( 16706. * trn(ji,jj,jk,jppoc) + 231. * trn(ji,jj,jk,jpdoc) ) * zstep * trn(ji,jj,jk,jpdoc) 550 546 551 547 ! Update the trends 552 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zagg + zaggdoc 548 tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zagg + zaggdoc + zaggdoc3 553 549 tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zagg + zaggdoc2 554 550 tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zaggfe 555 551 tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zaggfe 556 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zaggdoc - zaggdoc2 552 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zaggdoc - zaggdoc2 - zaggdoc3 557 553 ! 558 554 END DO … … 560 556 END DO 561 557 562 #if defined key_diatrc 563 zrfact2 = 1.e3 * rfact2r 564 ik1 = iksed + 1 565 # if ! defined key_iomput 566 trc2d(:,:,jp_pcs0_2d + 4) = sinking (:,:,ik1) * zrfact2 * tmask(:,:,1) 567 trc2d(:,:,jp_pcs0_2d + 5) = sinking2(:,:,ik1) * zrfact2 * tmask(:,:,1) 568 trc2d(:,:,jp_pcs0_2d + 6) = sinkfer (:,:,ik1) * zrfact2 * tmask(:,:,1) 569 trc2d(:,:,jp_pcs0_2d + 7) = sinkfer2(:,:,ik1) * zrfact2 * tmask(:,:,1) 570 trc2d(:,:,jp_pcs0_2d + 8) = sinksil (:,:,ik1) * zrfact2 * tmask(:,:,1) 571 trc2d(:,:,jp_pcs0_2d + 9) = sinkcal (:,:,ik1) * zrfact2 * tmask(:,:,1) 572 # else 573 IF( jnt == nrdttrc ) then 574 CALL iom_put( "EPC100" , ( sinking(:,:,ik1) + sinking2(:,:,ik1) ) * zrfact2 * tmask(:,:,1) ) ! Export of carbon at 100m 575 CALL iom_put( "EPFE100" , ( sinkfer(:,:,ik1) + sinkfer2(:,:,ik1) ) * zrfact2 * tmask(:,:,1) ) ! Export of iron at 100m 576 CALL iom_put( "EPCAL100", sinkcal(:,:,ik1) * zrfact2 * tmask(:,:,1) ) ! Export of calcite at 100m 577 CALL iom_put( "EPSI100" , sinksil(:,:,ik1) * zrfact2 * tmask(:,:,1) ) ! Export of biogenic silica at 100m 558 IF( ln_diatrc ) THEN 559 zrfact2 = 1.e3 * rfact2r 560 ik1 = iksed + 1 561 IF( lk_iomput ) THEN 562 IF( jnt == nrdttrc ) THEN 563 CALL iom_put( "EPC100" , ( sinking(:,:,ik1) + sinking2(:,:,ik1) ) * zrfact2 * tmask(:,:,1) ) ! Export of carbon at 100m 564 CALL iom_put( "EPFE100" , ( sinkfer(:,:,ik1) + sinkfer2(:,:,ik1) ) * zrfact2 * tmask(:,:,1) ) ! Export of iron at 100m 565 CALL iom_put( "EPCAL100", sinkcal(:,:,ik1) * zrfact2 * tmask(:,:,1) ) ! Export of calcite at 100m 566 CALL iom_put( "EPSI100" , sinksil(:,:,ik1) * zrfact2 * tmask(:,:,1) ) ! Export of biogenic silica at 100m 567 ENDIF 568 ELSE 569 trc2d(:,:,jp_pcs0_2d + 4) = sinking (:,:,ik1) * zrfact2 * tmask(:,:,1) 570 trc2d(:,:,jp_pcs0_2d + 5) = sinking2(:,:,ik1) * zrfact2 * tmask(:,:,1) 571 trc2d(:,:,jp_pcs0_2d + 6) = sinkfer (:,:,ik1) * zrfact2 * tmask(:,:,1) 572 trc2d(:,:,jp_pcs0_2d + 7) = sinkfer2(:,:,ik1) * zrfact2 * tmask(:,:,1) 573 trc2d(:,:,jp_pcs0_2d + 8) = sinksil (:,:,ik1) * zrfact2 * tmask(:,:,1) 574 trc2d(:,:,jp_pcs0_2d + 9) = sinkcal (:,:,ik1) * zrfact2 * tmask(:,:,1) 575 ENDIF 578 576 ENDIF 579 #endif580 #endif581 577 ! 582 578 IF(ln_ctl) THEN ! print mean trends (used for debugging) … … 586 582 ENDIF 587 583 ! 584 IF( nn_timing == 1 ) CALL timing_stop('p4z_sink') 585 ! 588 586 END SUBROUTINE p4z_sink 589 590 587 591 588 SUBROUTINE p4z_sink_init … … 597 594 #endif 598 595 596 597 599 598 SUBROUTINE p4z_sink2( pwsink, psinkflx, jp_tra ) 600 599 !!--------------------------------------------------------------------- … … 608 607 !! transport term, i.e. div(u*tra). 609 608 !!--------------------------------------------------------------------- 610 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released611 USE wrk_nemo, ONLY: ztraz => wrk_3d_2, zakz => wrk_3d_3, zwsink2 => wrk_3d_4612 609 ! 613 610 INTEGER , INTENT(in ) :: jp_tra ! tracer index index … … 617 614 INTEGER :: ji, jj, jk, jn 618 615 REAL(wp) :: zigma,zew,zign, zflx, zstep 619 !!--------------------------------------------------------------------- 620 621 IF( wrk_in_use(3, 2,3,4 ) ) THEN 622 CALL ctl_stop('p4z_sink2: requested workspace arrays unavailable') 623 RETURN 624 END IF 616 REAL(wp), POINTER, DIMENSION(:,:,:) :: ztraz, zakz, zwsink2 617 !!--------------------------------------------------------------------- 618 ! 619 IF( nn_timing == 1 ) CALL timing_start('p4z_sink2') 620 ! 621 ! Allocate temporary workspace 622 CALL wrk_alloc( jpi, jpj, jpk, ztraz, zakz, zwsink2 ) 625 623 626 624 zstep = rfact2 / 2. … … 630 628 631 629 DO jk = 1, jpkm1 632 # if defined key_degrad 633 zwsink2(:,:,jk+1) = -pwsink(:,:,jk) / rday * tmask(:,:,jk+1) * facvol(:,:,jk) 634 # else 635 zwsink2(:,:,jk+1) = -pwsink(:,:,jk) / rday * tmask(:,:,jk+1) 636 # endif 630 zwsink2(:,:,jk+1) = -pwsink(:,:,jk) / rday * tmask(:,:,jk+1) 637 631 END DO 638 632 zwsink2(:,:,1) = 0.e0 633 IF( lk_degrad ) THEN 634 zwsink2(:,:,:) = zwsink2(:,:,:) * facvol(:,:,:) 635 ENDIF 639 636 640 637 … … 706 703 psinkflx(:,:,:) = 2. * psinkflx(:,:,:) 707 704 ! 708 IF( wrk_not_released(3, 2,3,4) ) CALL ctl_stop('p4z_sink2: failed to release workspace arrays') 705 CALL wrk_dealloc( jpi, jpj, jpk, ztraz, zakz, zwsink2 ) 706 ! 707 IF( nn_timing == 1 ) CALL timing_stop('p4z_sink2') 709 708 ! 710 709 END SUBROUTINE p4z_sink2 -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/par_pisces.F90
r2528 r3294 29 29 LOGICAL, PUBLIC, PARAMETER :: lk_kriest = .TRUE. !: Kriest flag 30 30 INTEGER, PUBLIC, PARAMETER :: jp_pisces = 23 !: number of passive tracers 31 INTEGER, PUBLIC, PARAMETER :: jp_pisces_2d = 13 !: additional 2d output ('key_diatrc')32 INTEGER, PUBLIC, PARAMETER :: jp_pisces_3d = 18 !: additional 3d output ('key_diatrc')31 INTEGER, PUBLIC, PARAMETER :: jp_pisces_2d = 13 !: additional 2d output 32 INTEGER, PUBLIC, PARAMETER :: jp_pisces_3d = 18 !: additional 3d output 33 33 INTEGER, PUBLIC, PARAMETER :: jp_pisces_trd = 1 !: number of sms trends for PISCES 34 34 … … 67 67 LOGICAL, PUBLIC, PARAMETER :: lk_kriest = .FALSE. !: Kriest flag 68 68 INTEGER, PUBLIC, PARAMETER :: jp_pisces = 24 !: number of PISCES passive tracers 69 INTEGER, PUBLIC, PARAMETER :: jp_pisces_2d = 13 !: additional 2d output ('key_diatrc')70 INTEGER, PUBLIC, PARAMETER :: jp_pisces_3d = 11 !: additional 3d output ('key_diatrc')69 INTEGER, PUBLIC, PARAMETER :: jp_pisces_2d = 13 !: additional 2d output 70 INTEGER, PUBLIC, PARAMETER :: jp_pisces_3d = 11 !: additional 3d output 71 71 INTEGER, PUBLIC, PARAMETER :: jp_pisces_trd = 1 !: number of sms trends for PISCES 72 72 -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90
r2715 r3294 17 17 PUBLIC 18 18 19 INTEGER :: numnatp 20 19 21 !!* Time variables 20 22 INTEGER :: nrdttrc !: ??? … … 25 27 26 28 !!* Biological parameters 27 REAL(wp) :: part !: ???28 29 REAL(wp) :: rno3 !: ??? 29 30 REAL(wp) :: o2ut !: ??? 30 31 REAL(wp) :: po4r !: ??? 31 32 REAL(wp) :: rdenit !: ??? 33 REAL(wp) :: rdenita !: ??? 32 34 REAL(wp) :: o2nit !: ??? 33 35 REAL(wp) :: wsbio, wsbio2 !: ??? … … 37 39 !!* Damping 38 40 LOGICAL :: ln_pisdmp !: relaxation or not of nutrients to a mean value 41 INTEGER :: nn_pisdmp !: frequency of relaxation or not of nutrients to a mean value 39 42 LOGICAL :: ln_pisclo !: Restoring or not of nutrients to initial value 40 43 !: on close seas … … 55 58 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: concdfe !: ??? 56 59 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: concnfe !: ??? 60 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xlimnfe !: ??? 61 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xlimdfe !: ??? 62 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xlimsi !: ??? 63 57 64 58 65 !!* SMS for the organic matter … … 61 68 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xlimbac !: ?? 62 69 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: xdiss !: ?? 63 #if defined key_diatrc 64 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: prodcal !: Calcite production 65 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: grazing !: Total zooplankton grazing 66 #endif 70 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: prodcal !: Calcite production 71 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: grazing !: Total zooplankton grazing 67 72 68 73 !!* Variable for chemistry of the CO2 cycle … … 74 79 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: borat !: ??? 75 80 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: hi !: ??? 81 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: excess !: ??? 82 83 !!* Temperature dependancy of SMS terms 84 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tgfunc !: Temp. dependancy of various biological rates 85 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: tgfunc2 !: Temp. dependancy of mesozooplankton rates 76 86 77 87 !!* Array used to indicate negative tracer values … … 98 108 !!---------------------------------------------------------------------- 99 109 USE lib_mpp , ONLY: ctl_warn 100 INTEGER :: ierr( 5) ! Local variables110 INTEGER :: ierr(6) ! Local variables 101 111 !!---------------------------------------------------------------------- 102 112 ierr(:) = 0 103 !104 113 !* Biological fluxes for light 105 ALLOCATE( neln(jpi,jpj), heup(jpi,jpj), 114 ALLOCATE( neln(jpi,jpj), heup(jpi,jpj), STAT=ierr(1) ) 106 115 ! 107 116 !* Biological fluxes for primary production 108 ALLOCATE( xksimax(jpi,jpj) , xksi(jpi,jpj) , & 109 & xnanono3(jpi,jpj,jpk), xdiatno3(jpi,jpj,jpk), & 110 & xnanonh4(jpi,jpj,jpk), xdiatnh4(jpi,jpj,jpk), & 111 & xlimphy (jpi,jpj,jpk), xlimdia (jpi,jpj,jpk), & 112 & concdfe (jpi,jpj,jpk), concnfe (jpi,jpj,jpk), STAT=ierr(2) ) 117 ALLOCATE( xksimax(jpi,jpj) , xksi(jpi,jpj) , & 118 & xnanono3(jpi,jpj,jpk), xdiatno3(jpi,jpj,jpk), & 119 & xnanonh4(jpi,jpj,jpk), xdiatnh4(jpi,jpj,jpk), & 120 & xlimphy (jpi,jpj,jpk), xlimdia (jpi,jpj,jpk), & 121 & xlimnfe (jpi,jpj,jpk), xlimdfe (jpi,jpj,jpk), & 122 & xlimsi (jpi,jpj,jpk), concdfe (jpi,jpj,jpk), & 123 & concnfe (jpi,jpj,jpk), STAT=ierr(2) ) 113 124 ! 114 125 !* SMS for the organic matter 115 ALLOCATE( xfracal (jpi,jpj,jpk), nitrfac (jpi,jpj,jpk), & 116 #if defined key_diatrc 117 & prodcal(jpi,jpj,jpk) , grazing(jpi,jpj,jpk) , & 118 #endif 119 & xlimbac (jpi,jpj,jpk), xdiss(jpi,jpj,jpk) , STAT=ierr(3) ) 126 ALLOCATE( xfracal (jpi,jpj,jpk), nitrfac(jpi,jpj,jpk), & 127 & prodcal(jpi,jpj,jpk) , grazing(jpi,jpj,jpk), & 128 & xlimbac (jpi,jpj,jpk), xdiss (jpi,jpj,jpk), STAT=ierr(3) ) 120 129 ! 121 130 !* Variable for chemistry of the CO2 cycle 122 ALLOCATE( akb3(jpi,jpj,jpk), ak13(jpi,jpj,jpk) , & 123 & ak23(jpi,jpj,jpk), aksp(jpi,jpj,jpk) , & 124 & akw3(jpi,jpj,jpk), borat(jpi,jpj,jpk), hi(jpi,jpj,jpk), STAT=ierr(4) ) 131 ALLOCATE( akb3(jpi,jpj,jpk) , ak13 (jpi,jpj,jpk) , & 132 & ak23(jpi,jpj,jpk) , aksp (jpi,jpj,jpk) , & 133 & akw3(jpi,jpj,jpk) , borat (jpi,jpj,jpk) , & 134 & hi (jpi,jpj,jpk) , excess(jpi,jpj,jpk) , STAT=ierr(4) ) 135 ! 136 !* Temperature dependancy of SMS terms 137 ALLOCATE( tgfunc(jpi,jpj,jpk) , tgfunc2(jpi,jpj,jpk) , STAT=ierr(5) ) 125 138 ! 126 139 !* Array used to indicate negative tracer values 127 ALLOCATE( xnegtr(jpi,jpj,jpk) , STAT=ierr(5) )140 ALLOCATE( xnegtr(jpi,jpj,jpk) , STAT=ierr(6) ) 128 141 ! 129 142 sms_pisces_alloc = MAXVAL( ierr ) -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90
r2715 r3294 17 17 !!---------------------------------------------------------------------- 18 18 USE par_trc ! TOP parameters 19 USE sms_pisces ! Source Minus Sink variables 20 USE trc 21 USE oce_trc ! ocean variables 22 USE p4zche 23 USE p4zche ! 24 USE p4zsink ! 25 USE p4zopt ! 26 USE p4zprod ! 27 USE p4zrem ! 28 USE p4zsed ! 29 USE p4zflx ! 19 USE oce_trc ! shared variables between ocean and passive tracers 20 USE trc ! passive tracers common variables 21 USE sms_pisces ! PISCES Source Minus Sink variables 22 USE p4zche ! Chemical model 23 USE p4zsink ! vertical flux of particulate matter due to sinking 24 USE p4zopt ! optical model 25 USE p4zrem ! Remineralisation of organic matter 26 USE p4zflx ! Gas exchange 27 USE p4zsed ! Sedimentation 28 USE p4zlim ! Co-limitations of differents nutrients 29 USE p4zprod ! Growth rate of the 2 phyto groups 30 USE p4zmicro ! Sources and sinks of microzooplankton 31 USE p4zmeso ! Sources and sinks of mesozooplankton 32 USE p4zmort ! Mortality terms for phytoplankton 33 USE p4zlys ! Calcite saturation 34 USE p4zsed ! Sedimentation 30 35 31 36 IMPLICIT NONE … … 40 45 REAL(wp) :: bioma0 = 1.000e-8_wp 41 46 REAL(wp) :: silic1 = 91.65e-6_wp 42 REAL(wp) :: no3 = 31.04e-6_wp * 7.6 _wp47 REAL(wp) :: no3 = 31.04e-6_wp * 7.625_wp 43 48 44 49 # include "top_substitute.h90" … … 57 62 !!---------------------------------------------------------------------- 58 63 ! 64 INTEGER :: ji, jj, jk 65 REAL(wp) :: zcaralk, zbicarb, zco3 66 REAL(wp) :: ztmas, ztmas1 67 !!---------------------------------------------------------------------- 59 68 IF(lwp) WRITE(numout,*) 60 69 IF(lwp) WRITE(numout,*) ' trc_ini_pisces : PISCES biochemical model initialisation' … … 76 85 ! Set biological ratios 77 86 ! --------------------- 78 rno3 = (16.+2.) / 122. 79 po4r = 1.e0 / 122. 80 o2nit = 32. / 122. 81 rdenit = 97.6 / 16. 82 o2ut = 140. / 122. 87 rno3 = 16._wp / 122._wp 88 po4r = 1._wp / 122._wp 89 o2nit = 32._wp / 122._wp 90 rdenit = 105._wp / 16._wp 91 rdenita = 3._wp / 5._wp 92 o2ut = 131._wp / 122._wp 83 93 84 94 CALL p4z_che ! initialize the chemical constants … … 124 134 ENDIF 125 135 136 IF( .NOT. ln_rsttr ) THEN 137 ! Initialization of chemical variables of the carbon cycle 138 ! -------------------------------------------------------- 139 DO jk = 1, jpk 140 DO jj = 1, jpj 141 DO ji = 1, jpi 142 ztmas = tmask(ji,jj,jk) 143 ztmas1 = 1. - tmask(ji,jj,jk) 144 zcaralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / ( 1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) ) ) 145 zco3 = ( zcaralk - trn(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1 146 zbicarb = ( 2. * trn(ji,jj,jk,jpdic) - zcaralk ) 147 hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1 148 END DO 149 END DO 150 END DO 151 ! 152 END IF 153 154 ! Time step duration for biology 155 xstep = rfact2 / rday 156 157 CALL p4z_sink_init ! vertical flux of particulate organic matter 158 CALL p4z_opt_init ! Optic: PAR in the water column 159 CALL p4z_lim_init ! co-limitations by the various nutrients 160 CALL p4z_prod_init ! phytoplankton growth rate over the global ocean. 161 CALL p4z_rem_init ! remineralisation 162 CALL p4z_mort_init ! phytoplankton mortality 163 CALL p4z_micro_init ! microzooplankton 164 CALL p4z_meso_init ! mesozooplankton 165 CALL p4z_sed_init ! sedimentation 166 CALL p4z_lys_init ! calcite saturation 167 CALL p4z_flx_init ! gas exchange 168 169 ndayflxtr = 0 170 171 IF(lwp) WRITE(numout,*) 126 172 IF(lwp) WRITE(numout,*) 'Initialization of PISCES tracers done' 127 IF(lwp) WRITE(numout,*) ' '173 IF(lwp) WRITE(numout,*) 128 174 ! 129 175 END SUBROUTINE trc_ini_pisces … … 136 182 !! ** Purpose : Allocate all the dynamic arrays of PISCES 137 183 !!---------------------------------------------------------------------- 138 USE p4zint , ONLY : p4z_int_alloc139 USE p4zsink, ONLY : p4z_sink_alloc140 USE p4zopt , ONLY : p4z_opt_alloc141 USE p4zprod, ONLY : p4z_prod_alloc142 USE p4zrem , ONLY : p4z_rem_alloc143 USE p4zsed , ONLY : p4z_sed_alloc144 USE p4zflx , ONLY : p4z_flx_alloc145 184 ! 146 185 INTEGER :: ierr … … 148 187 ! 149 188 ierr = sms_pisces_alloc() ! Start of PISCES-related alloc routines... 150 ierr = ierr + p4z_che_alloc() 151 ierr = ierr + p4z_int_alloc() 152 ierr = ierr + p4z_sink_alloc() 153 ierr = ierr + p4z_opt_alloc() 154 ierr = ierr + p4z_prod_alloc() 155 ierr = ierr + p4z_rem_alloc() 156 ierr = ierr + p4z_sed_alloc() 157 ierr = ierr + p4z_flx_alloc() 189 ierr = ierr + p4z_che_alloc() 190 ierr = ierr + p4z_sink_alloc() 191 ierr = ierr + p4z_opt_alloc() 192 ierr = ierr + p4z_prod_alloc() 193 ierr = ierr + p4z_rem_alloc() 194 ierr = ierr + p4z_sed_alloc() 195 ierr = ierr + p4z_flx_alloc() 158 196 ! 159 197 IF( lk_mpp ) CALL mpp_sum( ierr ) -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcnam_pisces.F90
r2715 r3294 19 19 USE trc ! TOP variables 20 20 USE sms_pisces ! sms trends 21 USE iom ! I/O manager 21 22 22 23 … … 46 47 !!---------------------------------------------------------------------- 47 48 !! 48 #if defined key_diatrc && ! defined key_iomput 49 INTEGER :: jl, jn 50 ! definition of additional diagnostic as a structure 51 TYPE DIAG 52 CHARACTER(len = 20) :: snamedia !: short name 53 CHARACTER(len = 80 ) :: lnamedia !: long name 54 CHARACTER(len = 20 ) :: unitdia !: unit 55 END TYPE DIAG 56 57 TYPE(DIAG) , DIMENSION(jp_pisces_2d) :: pisdia2d 58 TYPE(DIAG) , DIMENSION(jp_pisces_3d) :: pisdia3d 59 #endif 60 61 NAMELIST/nampisbio/ part, nrdttrc, wsbio, xkmort, ferat3, wsbio2 49 INTEGER :: jl, jn 50 TYPE(DIAG), DIMENSION(jp_pisces_2d) :: pisdia2d 51 TYPE(DIAG), DIMENSION(jp_pisces_3d) :: pisdia3d 52 !! 53 NAMELIST/nampisbio/ nrdttrc, wsbio, xkmort, ferat3, wsbio2 62 54 #if defined key_kriest 63 55 NAMELIST/nampiskrp/ xkr_eta, xkr_zeta, xkr_mass_min, xkr_mass_max 64 56 #endif 65 #if defined key_diatrc && ! defined key_iomput 66 NAMELIST/nampisdia/ nn_writedia, pisdia3d, pisdia2d ! additional diagnostics 67 #endif 68 NAMELIST/nampisdmp/ ln_pisdmp, ln_pisclo 57 NAMELIST/nampisdia/ pisdia3d, pisdia2d ! additional diagnostics 58 NAMELIST/nampisdmp/ ln_pisdmp, nn_pisdmp, ln_pisclo 69 59 70 60 !!---------------------------------------------------------------------- … … 77 67 ! ! Open the namelist file 78 68 ! ! ---------------------- 79 CALL ctl_opn( numnat , 'namelist_pisces', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. )69 CALL ctl_opn( numnatp, 'namelist_pisces', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 80 70 81 REWIND( numnat )82 READ ( numnat , nampisbio )71 REWIND( numnatp ) 72 READ ( numnatp, nampisbio ) 83 73 84 74 IF(lwp) THEN ! control print 85 75 WRITE(numout,*) ' Namelist : nampisbio' 86 WRITE(numout,*) ' part of calcite not dissolved in guts part =', part87 76 WRITE(numout,*) ' frequence pour la biologie nrdttrc =', nrdttrc 88 77 WRITE(numout,*) ' POC sinking speed wsbio =', wsbio … … 101 90 xkr_mass_max = 1. 102 91 103 REWIND( numnat ) ! read natkriest104 READ ( numnat , nampiskrp )92 REWIND( numnatp ) ! read natkriest 93 READ ( numnatp, nampiskrp ) 105 94 106 95 IF(lwp) THEN … … 120 109 #endif 121 110 ! 122 #if defined key_diatrc && ! defined key_iomput 111 IF( .NOT.lk_iomput .AND. ln_diatrc ) THEN 112 ! 113 ! Namelist nampisdia 114 ! ------------------- 115 DO jl = 1, jp_pisces_2d 116 WRITE(pisdia2d(jl)%sname,'("2D_",I1)') jl ! short name 117 WRITE(pisdia2d(jl)%lname,'("2D DIAGNOSTIC NUMBER ",I2)') jl ! long name 118 pisdia2d(jl)%units = ' ' ! units 119 END DO 120 ! ! 3D output arrays 121 DO jl = 1, jp_pisces_3d 122 WRITE(pisdia3d(jl)%sname,'("3D_",I1)') jl ! short name 123 WRITE(pisdia3d(jl)%lname,'("3D DIAGNOSTIC NUMBER ",I2)') jl ! long name 124 pisdia3d(jl)%units = ' ' ! units 125 END DO 123 126 124 ! Namelist namlobdia 125 ! ------------------- 126 nn_writedia = 10 ! default values 127 128 DO jl = 1, jp_pisces_2d 129 jn = jp_pcs0_2d + jl - 1 130 WRITE(ctrc2d(jn),'("2D_",I1)') jn ! short name 131 WRITE(ctrc2l(jn),'("2D DIAGNOSTIC NUMBER ",I2)') jn ! long name 132 ctrc2u(jn) = ' ' ! units 133 END DO 134 ! ! 3D output arrays 135 DO jl = 1, jp_pisces_3d 136 jn = jp_pcs0_3d + jl - 1 137 WRITE(ctrc3d(jn),'("3D_",I1)') jn ! short name 138 WRITE(ctrc3l(jn),'("3D DIAGNOSTIC NUMBER ",I2)') jn ! long name 139 ctrc3u(jn) = ' ' ! units 140 END DO 141 142 REWIND( numnat ) ! read natrtd 143 READ ( numnat, nampisdia ) 144 145 DO jl = 1, jp_pisces_2d 146 jn = jp_pcs0_2d + jl - 1 147 ctrc2d(jn) = pisdia2d(jl)%snamedia 148 ctrc2l(jn) = pisdia2d(jl)%lnamedia 149 ctrc2u(jn) = pisdia2d(jl)%unitdia 150 END DO 151 152 DO jl = 1, jp_pisces_3d 153 jn = jp_pcs0_3d + jl - 1 154 ctrc3d(jn) = pisdia3d(jl)%snamedia 155 ctrc3l(jn) = pisdia3d(jl)%lnamedia 156 ctrc3u(jn) = pisdia3d(jl)%unitdia 157 END DO 158 159 IF(lwp) THEN ! control print 160 WRITE(numout,*) 161 WRITE(numout,*) ' Namelist : natadd' 162 WRITE(numout,*) ' frequency of outputs for additional arrays nn_writedia = ', nn_writedia 163 DO jl = 1, jp_pisces_3d 164 jn = jp_pcs0_3d + jl - 1 165 WRITE(numout,*) ' 3d output field No : ',jn 166 WRITE(numout,*) ' short name : ', TRIM(ctrc3d(jn)) 167 WRITE(numout,*) ' long name : ', TRIM(ctrc3l(jn)) 168 WRITE(numout,*) ' unit : ', TRIM(ctrc3u(jn)) 169 WRITE(numout,*) ' ' 170 END DO 127 REWIND( numnatp ) ! 128 READ ( numnatp, nampisdia ) 171 129 172 130 DO jl = 1, jp_pisces_2d 173 131 jn = jp_pcs0_2d + jl - 1 174 WRITE(numout,*) ' 2d output field No : ',jn 175 WRITE(numout,*) ' short name : ', TRIM(ctrc2d(jn)) 176 WRITE(numout,*) ' long name : ', TRIM(ctrc2l(jn)) 177 WRITE(numout,*) ' unit : ', TRIM(ctrc2u(jn)) 132 ctrc2d(jn) = pisdia2d(jl)%sname 133 ctrc2l(jn) = pisdia2d(jl)%lname 134 ctrc2u(jn) = pisdia2d(jl)%units 135 END DO 136 137 DO jl = 1, jp_pisces_3d 138 jn = jp_pcs0_3d + jl - 1 139 ctrc3d(jn) = pisdia3d(jl)%sname 140 ctrc3l(jn) = pisdia3d(jl)%lname 141 ctrc3u(jn) = pisdia3d(jl)%units 142 END DO 143 144 IF(lwp) THEN ! control print 145 WRITE(numout,*) 146 WRITE(numout,*) ' Namelist : natadd' 147 DO jl = 1, jp_pisces_3d 148 jn = jp_pcs0_3d + jl - 1 149 WRITE(numout,*) ' 3d diag nb : ', jn, ' short name : ', ctrc3d(jn), & 150 & ' long name : ', ctrc3l(jn), ' unit : ', ctrc3u(jn) 151 END DO 178 152 WRITE(numout,*) ' ' 179 END DO 153 154 DO jl = 1, jp_pisces_2d 155 jn = jp_pcs0_2d + jl - 1 156 WRITE(numout,*) ' 2d diag nb : ', jn, ' short name : ', ctrc2d(jn), & 157 & ' long name : ', ctrc2l(jn), ' unit : ', ctrc2u(jn) 158 END DO 159 WRITE(numout,*) ' ' 160 ENDIF 161 ! 180 162 ENDIF 181 #endif182 163 183 REWIND( numnat )184 READ ( numnat , nampisdmp )164 REWIND( numnatp ) 165 READ ( numnatp, nampisdmp ) 185 166 186 167 IF(lwp) THEN ! control print 187 168 WRITE(numout,*) 188 169 WRITE(numout,*) ' Namelist : nampisdmp' 189 WRITE(numout,*) ' Relaxation of tracer to glodap mean value ln_pisdmp =', ln_pisdmp 170 WRITE(numout,*) ' Relaxation of tracer to glodap mean value ln_pisdmp =', ln_pisdmp 171 WRITE(numout,*) ' Frequency of Relaxation nn_pisdmp =', nn_pisdmp 190 172 WRITE(numout,*) ' Restoring of tracer to initial value on closed seas ln_pisclo =', ln_pisclo 191 173 WRITE(numout,*) ' ' -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcrst_pisces.F90
r2715 r3294 43 43 44 44 ! 45 IF( lk_dtatrc .AND. ln_pisclo ) CALL pis_dmp_clo ! restoring of nutrients on close seas 46 IF( ln_pisdmp ) CALL pis_dmp_ini ! relaxation of some tracers 45 IF( ln_trcdta .AND. ln_pisclo ) CALL pis_dmp_clo ! restoring of nutrients on close seas 47 46 ! 48 47 IF(lwp) WRITE(numout,*) … … 53 52 CALL iom_get( knum, jpdom_autoglo, 'PH' , hi(:,:,:) ) 54 53 ELSE 54 ! hi(:,:,:) = 1.e-9 55 55 ! Set PH from total alkalinity, borat (???), akb3 (???) and ak23 (???) 56 56 ! -------------------------------------------------------- … … 63 63 zco3 = ( zcaralk - trn(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1 64 64 zbicarb = ( 2. * trn(ji,jj,jk,jpdic) - zcaralk ) 65 65 hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1 66 66 END DO 67 67 END DO … … 99 99 END SUBROUTINE trc_rst_wri_pisces 100 100 101 SUBROUTINE pis_dmp_ini102 !!----------------------------------------------------------------------103 !! *** pis_dmp_ini ***104 !!105 !! ** purpose : Relaxation of some tracers106 !!----------------------------------------------------------------------107 REAL(wp) :: alkmean = 2426. ! mean value of alkalinity ( Glodap ; for Goyet 2391. )108 REAL(wp) :: po4mean = 2.165 ! mean value of phosphates109 REAL(wp) :: no3mean = 30.90 ! mean value of nitrate110 REAL(wp) :: silmean = 91.51 ! mean value of silicate111 112 REAL(wp) :: zarea, zalksum, zpo4sum, zno3sum, zsilsum113 114 115 IF(lwp) WRITE(numout,*)116 117 IF( cp_cfg == "orca" .AND. .NOT. lk_c1d ) THEN ! ORCA condiguration (not 1D) !118 ! ! --------------------------- !119 ! set total alkalinity, phosphate, nitrate & silicate120 121 zarea = 1. / areatot * 1.e6122 # if defined key_degrad123 zalksum = glob_sum( trn(:,:,:,jptal) * cvol(:,:,:) * facvol(:,:,:) ) * zarea124 zpo4sum = glob_sum( trn(:,:,:,jppo4) * cvol(:,:,:) * facvol(:,:,:) ) * zarea / 122.125 zno3sum = glob_sum( trn(:,:,:,jpno3) * cvol(:,:,:) * facvol(:,:,:) ) * zarea / 7.6126 zsilsum = glob_sum( trn(:,:,:,jpsil) * cvol(:,:,:) * facvol(:,:,:) ) * zarea127 # else128 zalksum = glob_sum( trn(:,:,:,jptal) * cvol(:,:,:) ) * zarea129 zpo4sum = glob_sum( trn(:,:,:,jppo4) * cvol(:,:,:) ) * zarea / 122.130 zno3sum = glob_sum( trn(:,:,:,jpno3) * cvol(:,:,:) ) * zarea / 7.6131 zsilsum = glob_sum( trn(:,:,:,jpsil) * cvol(:,:,:) ) * zarea132 # endif133 134 IF(lwp) WRITE(numout,*) ' TALK mean : ', zalksum135 trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / zalksum136 137 IF(lwp) WRITE(numout,*) ' PO4 mean : ', zpo4sum138 trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / zpo4sum139 140 IF(lwp) WRITE(numout,*) ' NO3 mean : ', zno3sum141 trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / zno3sum142 143 IF(lwp) WRITE(numout,*) ' SiO3 mean : ', zsilsum144 trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * silmean / zsilsum )145 !146 ENDIF147 148 !#if defined key_kriest149 ! !! Initialize number of particles from a standart restart file150 ! !! The name of big organic particles jpgoc has been only change151 ! !! and replace by jpnum but the values here are concentration152 ! trn(:,:,:,jppoc) = trn(:,:,:,jppoc) + trn(:,:,:,jpnum)153 ! trn(:,:,:,jpnum) = trn(:,:,:,jppoc) / ( 6. * xkr_massp )154 !#endif155 156 END SUBROUTINE pis_dmp_ini157 158 101 SUBROUTINE pis_dmp_clo 159 102 !!--------------------------------------------------------------------- … … 168 111 !! ictsi2(), ictsj2() : north-east Closed sea limits (i,j) 169 112 !!---------------------------------------------------------------------- 170 INTEGER, PARAMETER :: npicts = 4 !: number of closed sea 171 INTEGER, DIMENSION(npicts) :: ictsi1, ictsj1 !: south-west closed sea limits (i,j) 172 INTEGER, DIMENSION(npicts) :: ictsi2, ictsj2 !: north-east closed sea limits (i,j) 173 INTEGER :: ji, jj, jk, jn, jc ! dummy loop indices 113 INTEGER, PARAMETER :: npicts = 4 ! number of closed sea 114 INTEGER, DIMENSION(npicts) :: ictsi1, ictsj1 ! south-west closed sea limits (i,j) 115 INTEGER, DIMENSION(npicts) :: ictsi2, ictsj2 ! north-east closed sea limits (i,j) 116 INTEGER :: ji, jj, jk, jn, jl, jc ! dummy loop indices 117 INTEGER :: ierr ! local integer 118 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) :: ztrcdta ! 4D workspace 174 119 !!---------------------------------------------------------------------- 175 120 … … 243 188 END DO 244 189 245 #if defined key_dtatrc246 190 ! Restore close seas values to initial data 247 CALL trc_dta( nit000 ) 248 DO jn = 1, jptra 249 IF( lutini(jn) ) THEN 250 DO jc = 1, npicts 251 DO jk = 1, jpkm1 252 DO jj = ictsj1(jc), ictsj2(jc) 253 DO ji = ictsi1(jc), ictsi2(jc) 254 trn(ji,jj,jk,jn) = trdta(ji,jj,jk,jn) * tmask(ji,jj,jk) 255 trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 256 ENDDO 257 ENDDO 258 ENDDO 259 ENDDO 260 ENDIF 261 ENDDO 262 #endif 263 ! 191 IF( nb_trcdta > 0 ) THEN ! Initialisation of tracer from a file that may also be used for damping 192 ALLOCATE( ztrcdta(jpi,jpj,jpk,nb_trcdta), STAT=ierr ) 193 IF( ierr > 0 ) THEN 194 CALL ctl_stop( 'trc_ini: unable to allocate ztrcdta array' ) ; RETURN 195 ENDIF 196 ! 197 CALL trc_dta( nittrc000, ztrcdta ) ! read tracer data at nittrc000 198 ! 199 DO jn = 1, jptra 200 IF( ln_trc_ini(jn) ) THEN ! update passive tracers arrays with input data read from file 201 jl = n_trc_index(jn) 202 DO jc = 1, npicts 203 DO jk = 1, jpkm1 204 DO jj = ictsj1(jc), ictsj2(jc) 205 DO ji = ictsi1(jc), ictsi2(jc) 206 trn(ji,jj,jk,jn) = ztrcdta(ji,jj,jk,jl) * tmask(ji,jj,jk) 207 trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 208 ENDDO 209 ENDDO 210 ENDDO 211 ENDDO 212 ENDIF 213 ENDDO 214 DEALLOCATE( ztrcdta ) 215 ENDIF 216 ! 264 217 END SUBROUTINE pis_dmp_clo 265 218 -
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcsms_pisces.F90
r2715 r3294 13 13 !! trcsms_pisces : Time loop of passive tracers sms 14 14 !!---------------------------------------------------------------------- 15 USE oce_trc ! 16 USE trc 17 USE sms_pisces 18 19 USE p4zint ! 20 USE p4zche ! 21 USE p4zbio ! 22 USE p4zsink ! 23 USE p4zopt ! 24 USE p4zlim ! 25 USE p4zprod ! 26 USE p4zmort ! 27 USE p4zmicro ! 28 USE p4zmeso ! 29 USE p4zrem ! 30 USE p4zsed ! 31 USE p4zlys ! 32 USE p4zflx ! 33 34 USE prtctl_trc 35 36 USE trdmod_oce 37 USE trdmod_trc 38 39 USE sedmodel 15 USE oce_trc ! shared variables between ocean and passive tracers 16 USE trc ! passive tracers common variables 17 USE sms_pisces ! PISCES Source Minus Sink variables 18 USE p4zbio ! Biological model 19 USE p4zche ! Chemical model 20 USE p4zlys ! Calcite saturation 21 USE p4zflx ! Gas exchange 22 USE p4zsed ! Sedimentation 23 USE p4zint ! time interpolation 24 USE trdmod_oce ! Ocean trends variables 25 USE trdmod_trc ! TOP trends variables 26 USE sedmodel ! Sediment model 27 USE prtctl_trc ! print control for debugging 40 28 41 29 IMPLICIT NONE … … 43 31 44 32 PUBLIC trc_sms_pisces ! called in trcsms.F90 33 34 LOGICAL :: ln_check_mass = .false. !: Flag to check mass conservation 35 36 INTEGER :: numno3 !: logical unit for NO3 budget 37 INTEGER :: numalk !: logical unit for talk budget 38 INTEGER :: numsil !: logical unit for Si budget 45 39 46 40 !!---------------------------------------------------------------------- … … 63 57 !! - ... 64 58 !!--------------------------------------------------------------------- 65 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released66 USE wrk_nemo, ONLY: ztrpis => wrk_3d_1 ! used for pisces sms trends67 59 ! 68 60 INTEGER, INTENT( in ) :: kt ! ocean time-step index … … 71 63 CHARACTER (len=25) :: charout 72 64 !!--------------------------------------------------------------------- 73 74 IF( kt == nit000 ) CALL trc_sms_pisces_init ! Initialization (first time-step only) 75 76 IF( wrk_in_use(3,1) ) THEN 77 CALL ctl_stop('trc_sms_pisces : requested workspace array unavailable.') ; RETURN 78 ENDIF 65 ! 66 IF( nn_timing == 1 ) CALL timing_start('trc_sms_pisces') 67 ! 68 IF( ln_pisdmp .AND. MOD( kt - nn_dttrc, nn_pisdmp ) == 0 ) CALL trc_sms_pisces_dmp( kt ) ! Relaxation of some tracers 69 CALL trc_sms_pisces_mass_conserv( kt ) ! Mass conservation checking 79 70 80 71 IF( ndayflxtr /= nday_year ) THEN ! New days … … 86 77 IF(lwp) write(numout,*) '~~~~~~' 87 78 88 CALL p4z_che ! computation of chemical constants89 CALL p4z_int ! computation of various rates for biogeochemistry79 CALL p4z_che ! computation of chemical constants 80 CALL p4z_int ! computation of various rates for biogeochemistry 90 81 ! 91 82 ENDIF … … 109 100 END DO 110 101 111 112 102 IF( l_trdtrc ) THEN 113 103 DO jn = jp_pcs0, jp_pcs1 114 ztrpis(:,:,:) = tra(:,:,:,jn) 115 CALL trd_mod_trc( ztrpis, jn, jptra_trd_sms, kt ) ! save trends 104 CALL trd_mod_trc( tra(:,:,:,jn), jn, jptra_trd_sms, kt ) ! save trends 116 105 END DO 117 DEALLOCATE( ztrpis )118 106 END IF 119 107 … … 127 115 ! 128 116 ENDIF 129 130 IF( wrk_not_released(3,1) ) CALL ctl_stop('trc_sms_pisces : failed to release workspace array.')131 117 ! 118 IF( nn_timing == 1 ) CALL timing_stop('trc_sms_pisces') 119 ! 132 120 END SUBROUTINE trc_sms_pisces 133 121 134 SUBROUTINE trc_sms_pisces_ init122 SUBROUTINE trc_sms_pisces_dmp( kt ) 135 123 !!---------------------------------------------------------------------- 136 !! *** ROUTINE trc_sms_pisces_init *** 137 !! 138 !! ** Purpose : Initialization of PH variable 139 !! 124 !! *** trc_sms_pisces_dmp *** 125 !! 126 !! ** purpose : Relaxation of some tracers 140 127 !!---------------------------------------------------------------------- 141 INTEGER :: ji, jj, jk 142 REAL(wp) :: zcaralk, zbicarb, zco3 143 REAL(wp) :: ztmas, ztmas1 144 145 IF( .NOT. ln_rsttr ) THEN 146 ! Initialization of chemical variables of the carbon cycle 147 ! -------------------------------------------------------- 148 DO jk = 1, jpk 149 DO jj = 1, jpj 150 DO ji = 1, jpi 151 ztmas = tmask(ji,jj,jk) 152 ztmas1 = 1. - tmask(ji,jj,jk) 153 zcaralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / ( 1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) ) ) 154 zco3 = ( zcaralk - trn(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1 155 zbicarb = ( 2. * trn(ji,jj,jk,jpdic) - zcaralk ) 156 hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1 157 END DO 158 END DO 159 END DO 160 ! 161 END IF 162 163 ! Time step duration for biology 164 xstep = rfact2 / rday 165 166 CALL p4z_sink_init ! vertical flux of particulate organic matter 167 CALL p4z_opt_init ! Optic: PAR in the water column 168 CALL p4z_lim_init ! co-limitations by the various nutrients 169 CALL p4z_prod_init ! phytoplankton growth rate over the global ocean. 170 CALL p4z_rem_init ! remineralisation 171 CALL p4z_mort_init ! phytoplankton mortality 172 CALL p4z_micro_init ! microzooplankton 173 CALL p4z_meso_init ! mesozooplankton 174 CALL p4z_sed_init ! sedimentation 175 CALL p4z_lys_init ! calcite saturation 176 CALL p4z_flx_init ! gas exchange 177 178 ndayflxtr = 0 179 180 END SUBROUTINE trc_sms_pisces_init 128 ! 129 INTEGER, INTENT( in ) :: kt ! time step 130 ! 131 REAL(wp) :: alkmean = 2426. ! mean value of alkalinity ( Glodap ; for Goyet 2391. ) 132 REAL(wp) :: po4mean = 2.165 ! mean value of phosphates 133 REAL(wp) :: no3mean = 30.90 ! mean value of nitrate 134 REAL(wp) :: silmean = 91.51 ! mean value of silicate 135 ! 136 REAL(wp) :: zarea, zalksum, zpo4sum, zno3sum, zsilsum 137 !!--------------------------------------------------------------------- 138 139 140 IF(lwp) WRITE(numout,*) 141 IF(lwp) WRITE(numout,*) ' trc_sms_pisces_dmp : Relaxation of nutrients at time-step kt = ', kt 142 IF(lwp) WRITE(numout,*) 143 144 IF( cp_cfg == "orca" .AND. .NOT. lk_c1d ) THEN ! ORCA condiguration (not 1D) ! 145 ! ! --------------------------- ! 146 ! set total alkalinity, phosphate, nitrate & silicate 147 zarea = 1._wp / glob_sum( cvol(:,:,:) ) * 1e6 148 149 zalksum = glob_sum( trn(:,:,:,jptal) * cvol(:,:,:) ) * zarea 150 zpo4sum = glob_sum( trn(:,:,:,jppo4) * cvol(:,:,:) ) * zarea / 122. 151 zno3sum = glob_sum( trn(:,:,:,jpno3) * cvol(:,:,:) ) * zarea / 7.6 152 zsilsum = glob_sum( trn(:,:,:,jpsil) * cvol(:,:,:) ) * zarea 153 154 IF(lwp) WRITE(numout,*) ' TALK mean : ', zalksum 155 trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / zalksum 156 157 IF(lwp) WRITE(numout,*) ' PO4 mean : ', zpo4sum 158 trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / zpo4sum 159 160 IF(lwp) WRITE(numout,*) ' NO3 mean : ', zno3sum 161 trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / zno3sum 162 163 IF(lwp) WRITE(numout,*) ' SiO3 mean : ', zsilsum 164 trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * silmean / zsilsum ) 165 ! 166 ENDIF 167 168 END SUBROUTINE trc_sms_pisces_dmp 169 170 SUBROUTINE trc_sms_pisces_mass_conserv ( kt ) 171 !!---------------------------------------------------------------------- 172 !! *** ROUTINE trc_sms_pisces_mass_conserv *** 173 !! 174 !! ** Purpose : Mass conservation check 175 !! 176 !!--------------------------------------------------------------------- 177 ! 178 INTEGER, INTENT( in ) :: kt ! ocean time-step index 179 !! 180 REAL(wp) :: zalkbudget, zno3budget, zsilbudget 181 ! 182 NAMELIST/nampismass/ ln_check_mass 183 !!--------------------------------------------------------------------- 184 185 IF( kt == nittrc000 ) THEN 186 REWIND( numnatp ) 187 READ ( numnatp, nampismass ) 188 IF(lwp) THEN ! control print 189 WRITE(numout,*) ' ' 190 WRITE(numout,*) ' Namelist parameter for mass conservation checking' 191 WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 192 WRITE(numout,*) ' Flag to check mass conservation of NO3/Si/TALK ln_check_mass = ', ln_check_mass 193 ENDIF 194 195 IF( ln_check_mass .AND. lwp) THEN ! Open budget file of NO3, ALK, Si 196 CALL ctl_opn( numno3, 'no3.budget' , 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 197 CALL ctl_opn( numsil, 'sil.budget' , 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 198 CALL ctl_opn( numalk, 'talk.budget', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 199 ENDIF 200 ENDIF 201 202 IF( ln_check_mass ) THEN ! Compute the budget of NO3, ALK, Si 203 zno3budget = glob_sum( ( trn(:,:,:,jpno3) + trn(:,:,:,jpnh4) & 204 & + trn(:,:,:,jpphy) + trn(:,:,:,jpdia) & 205 & + trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) & 206 & + trn(:,:,:,jppoc) + trn(:,:,:,jpgoc) & 207 & + trn(:,:,:,jpdoc) ) * cvol(:,:,:) ) 208 ! 209 zsilbudget = glob_sum( ( trn(:,:,:,jpsil) + trn(:,:,:,jpdsi) & 210 & + trn(:,:,:,jpbsi) ) * cvol(:,:,:) ) 211 ! 212 zalkbudget = glob_sum( ( trn(:,:,:,jpno3) * rno3 & 213 & + trn(:,:,:,jptal) & 214 & + trn(:,:,:,jpcal) * 2. ) * cvol(:,:,:) ) 215 216 IF( lwp ) THEN 217 WRITE(numno3,9500) kt, zno3budget / areatot 218 WRITE(numsil,9500) kt, zsilbudget / areatot 219 WRITE(numalk,9500) kt, zalkbudget / areatot 220 ENDIF 221 ENDIF 222 9500 FORMAT(i10,e18.10) 223 ! 224 END SUBROUTINE trc_sms_pisces_mass_conserv 181 225 182 226 #else
Note: See TracChangeset
for help on using the changeset viewer.