Changeset 2528 for trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsed.F90
- Timestamp:
- 2010-12-27T18:33:53+01:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsed.F90
- Property svn:executable deleted
r1836 r2528 19 19 USE sms_pisces 20 20 USE lib_mpp 21 USE lib_fortran 21 22 USE prtctl_trc 22 23 USE p4zbio … … 34 35 35 36 PUBLIC p4z_sed 37 PUBLIC p4z_sed_init 36 38 37 39 !! * Shared module variables … … 47 49 48 50 !! * Module variables 49 INTEGER :: & 50 ryyss, & !: number of seconds per year 51 rmtss !: number of seconds per month 52 51 REAL(wp) :: ryyss !: number of seconds per year 52 REAL(wp) :: ryyss1 !: inverse of ryyss 53 REAL(wp) :: rmtss !: number of seconds per month 54 REAL(wp) :: rday1 !: inverse of rday 55 56 INTEGER , PARAMETER :: & 57 jpmth = 12, jpyr = 1 53 58 INTEGER :: & 54 59 numdust, & !: logical unit for surface fluxes data 55 60 nflx1 , nflx2, & !: first and second record used 56 61 nflx11, nflx12 ! ??? 57 REAL(wp), DIMENSION(jpi,jpj,2) :: & !: 58 dustmo !: 2 consecutive set of dust fields 59 REAL(wp), DIMENSION(jpi,jpj) :: & 60 rivinp, cotdep, nitdep, dust 61 REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 62 ironsed 62 REAL(wp), DIMENSION(jpi,jpj,jpmth) :: dustmo !: set of dust fields 63 REAL(wp), DIMENSION(jpi,jpj) :: rivinp, cotdep, nitdep, dust 64 REAL(wp), DIMENSION(jpi,jpj) :: e1e2t 65 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ironsed 63 66 REAL(wp) :: sumdepsi, rivalkinput, rivpo4input, nitdepinput 64 67 … … 66 69 # include "top_substitute.h90" 67 70 !!---------------------------------------------------------------------- 68 !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)71 !! NEMO/TOP 3.3 , NEMO Consortium (2010) 69 72 !! $Header:$ 70 !! Software governed by the CeCILL licence ( modipsl/doc/NEMO_CeCILL.txt)73 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 71 74 !!---------------------------------------------------------------------- 72 75 73 76 CONTAINS 74 77 75 SUBROUTINE p4z_sed( kt, jnt)78 SUBROUTINE p4z_sed( kt, jnt ) 76 79 !!--------------------------------------------------------------------- 77 80 !! *** ROUTINE p4z_sed *** … … 84 87 !!--------------------------------------------------------------------- 85 88 INTEGER, INTENT(in) :: kt, jnt ! ocean time step 86 INTEGER :: ji, jj, jk 87 INTEGER :: ikt 89 INTEGER :: ji, jj, jk, ikt 88 90 #if ! defined key_sed 89 91 REAL(wp) :: zsumsedsi, zsumsedpo4, zsumsedcal 92 REAL(wp) :: zrivalk, zrivsil, zrivpo4 90 93 #endif 91 REAL(wp) :: z conctmp , zdenitot , znitrpottot92 REAL(wp) :: z lim, zconctmp2, zstep, zfact94 REAL(wp) :: zdenitot, znitrpottot, zlim, zfact 95 REAL(wp) :: zwsbio3, zwsbio4, zwscal 93 96 REAL(wp), DIMENSION(jpi,jpj) :: zsidep 97 REAL(wp), DIMENSION(jpi,jpj) :: zwork, zwork1 94 98 REAL(wp), DIMENSION(jpi,jpj,jpk) :: znitrpot, zirondep 95 #if defined key_diaadd || defined key_trc_dia3d96 REAL(wp) :: zrfact297 # if defined key_iomput98 REAL(wp), DIMENSION(jpi,jpj) :: zw2d99 # endif100 #endif101 99 CHARACTER (len=25) :: charout 102 100 !!--------------------------------------------------------------------- 103 101 104 105 IF( ( kt * jnt ) == nittrc000 ) CALL p4z_sed_init ! Initialization (first time-step only) 106 IF( (jnt == 1) .and. ( ln_dustfer ) ) CALL p4z_sbc( kt ) 107 108 zstep = rfact2 / rday ! Time step duration for the biology 109 110 zirondep(:,:,:) = 0.e0 ! Initialisation of variables used to compute deposition 111 zsidep (:,:) = 0.e0 102 IF( jnt == 1 .AND. ln_dustfer ) CALL p4z_sbc( kt ) 112 103 113 104 ! Iron and Si deposition at the surface … … 116 107 DO jj = 1, jpj 117 108 DO ji = 1, jpi 118 zirondep(ji,jj,1) = ( dustsolub * dust(ji,jj) / ( 55.85 * rmtss ) + 3.e-10 / ryyss) &109 zirondep(ji,jj,1) = ( dustsolub * dust(ji,jj) / ( 55.85 * rmtss ) + 3.e-10 * ryyss1 ) & 119 110 & * rfact2 / fse3t(ji,jj,1) 120 111 zsidep (ji,jj) = 8.8 * 0.075 * dust(ji,jj) * rfact2 / ( fse3t(ji,jj,1) * 28.1 * rmtss ) … … 150 141 151 142 #if ! defined key_sed 152 ! Initialisation of variables used to compute Sinking Speed153 zsumsedsi = 0.e0154 zsumsedpo4 = 0.e0155 zsumsedcal = 0.e0156 157 143 ! Loss of biogenic silicon, Caco3 organic carbon in the sediments. 158 144 ! First, the total loss is computed. … … 161 147 DO jj = 1, jpj 162 148 DO ji = 1, jpi 163 ikt = MAX( mbathy(ji,jj)-1, 1 ) 164 zfact = e1t(ji,jj) * e2t(ji,jj) / rday * tmask_i(ji,jj) 149 ikt = mbkt(ji,jj) 165 150 # if defined key_kriest 166 z sumsedsi = zsumsedsi + zfact *trn(ji,jj,ikt,jpdsi) * wscal (ji,jj,ikt)167 z sumsedpo4 = zsumsedpo4 + zfact *trn(ji,jj,ikt,jppoc) * wsbio3(ji,jj,ikt)151 zwork (ji,jj) = trn(ji,jj,ikt,jpdsi) * wscal (ji,jj,ikt) 152 zwork1(ji,jj) = trn(ji,jj,ikt,jppoc) * wsbio3(ji,jj,ikt) 168 153 # else 169 zsumsedsi = zsumsedsi + zfact * trn(ji,jj,ikt,jpdsi) * wsbio4(ji,jj,ikt) 170 zsumsedpo4 = zsumsedpo4 + zfact *( trn(ji,jj,ikt,jpgoc) * wsbio4(ji,jj,ikt) & 171 & + trn(ji,jj,ikt,jppoc) * wsbio3(ji,jj,ikt) ) 154 zwork (ji,jj) = trn(ji,jj,ikt,jpdsi) * wsbio4(ji,jj,ikt) 155 zwork1(ji,jj) = trn(ji,jj,ikt,jpgoc) * wsbio4(ji,jj,ikt) + trn(ji,jj,ikt,jppoc) * wsbio3(ji,jj,ikt) 172 156 # endif 173 zsumsedcal = zsumsedcal + zfact * trn(ji,jj,ikt,jpcal) * wscal (ji,jj,ikt) * 2.e0 174 END DO 175 END DO 176 177 IF( lk_mpp ) THEN 178 CALL mpp_sum( zsumsedsi ) ! sums over the global domain 179 CALL mpp_sum( zsumsedcal ) ! sums over the global domain 180 CALL mpp_sum( zsumsedpo4 ) ! sums over the global domain 181 ENDIF 182 157 END DO 158 END DO 159 zsumsedsi = glob_sum( zwork (:,:) * e1e2t(:,:) ) * rday1 160 zsumsedpo4 = glob_sum( zwork1(:,:) * e1e2t(:,:) ) * rday1 161 DO jj = 1, jpj 162 DO ji = 1, jpi 163 ikt = mbkt(ji,jj) 164 zwork (ji,jj) = trn(ji,jj,ikt,jpcal) * wscal (ji,jj,ikt) 165 END DO 166 END DO 167 zsumsedcal = glob_sum( zwork (:,:) * e1e2t(:,:) ) * 2.0 * rday1 183 168 #endif 184 169 … … 191 176 DO jj = 1, jpj 192 177 DO ji = 1, jpi 193 ikt = MAX( mbathy(ji,jj) - 1, 1 ) 194 zconctmp = trn(ji,jj,ikt,jpdsi) * zstep / fse3t(ji,jj,ikt) & 195 # if ! defined key_kriest 196 & * wscal (ji,jj,ikt) 178 ikt = mbkt(ji,jj) 179 zfact = xstep / fse3t(ji,jj,ikt) 180 zwsbio3 = 1._wp - zfact * wsbio3(ji,jj,ikt) 181 zwsbio4 = 1._wp - zfact * wsbio4(ji,jj,ikt) 182 zwscal = 1._wp - zfact * wscal (ji,jj,ikt) 183 ! 184 # if defined key_kriest 185 trn(ji,jj,ikt,jpdsi) = trn(ji,jj,ikt,jpdsi) * zwsbio4 186 trn(ji,jj,ikt,jpnum) = trn(ji,jj,ikt,jpnum) * zwsbio4 187 trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) * zwsbio3 188 trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) * zwsbio3 197 189 # else 198 & * wsbio4(ji,jj,ikt) 190 trn(ji,jj,ikt,jpdsi) = trn(ji,jj,ikt,jpdsi) * zwscal 191 trn(ji,jj,ikt,jpgoc) = trn(ji,jj,ikt,jpgoc) * zwsbio4 192 trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) * zwsbio3 193 trn(ji,jj,ikt,jpbfe) = trn(ji,jj,ikt,jpbfe) * zwsbio4 194 trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) * zwsbio3 199 195 # endif 200 trn(ji,jj,ikt,jpdsi) = trn(ji,jj,ikt,jpdsi) - zconctmp 196 trn(ji,jj,ikt,jpcal) = trn(ji,jj,ikt,jpcal) * zwscal 197 END DO 198 END DO 201 199 202 200 #if ! defined key_sed 203 trn(ji,jj,ikt,jpsil) = trn(ji,jj,ikt,jpsil) + zconctmp & 204 & * ( 1.- ( sumdepsi + rivalkinput / ryyss / 6. ) / zsumsedsi ) 205 #endif 206 END DO 207 END DO 208 201 zrivsil = 1._wp - ( sumdepsi + rivalkinput * ryyss1 / 6. ) / zsumsedsi 202 zrivalk = 1._wp - ( rivalkinput * ryyss1 ) / zsumsedcal 203 zrivpo4 = 1._wp - ( rivpo4input * ryyss1 ) / zsumsedpo4 209 204 DO jj = 1, jpj 210 205 DO ji = 1, jpi 211 ikt = MAX( mbathy(ji,jj) - 1, 1 ) 212 zconctmp = trn(ji,jj,ikt,jpcal) * wscal(ji,jj,ikt) * zstep / fse3t(ji,jj,ikt) 213 trn(ji,jj,ikt,jpcal) = trn(ji,jj,ikt,jpcal) - zconctmp 214 215 #if ! defined key_sed 216 trn(ji,jj,ikt,jptal) = trn(ji,jj,ikt,jptal) + zconctmp & 217 & * ( 1.- ( rivalkinput / ryyss ) / zsumsedcal ) * 2.e0 218 trn(ji,jj,ikt,jpdic) = trn(ji,jj,ikt,jpdic) + zconctmp & 219 & * ( 1.- ( rivalkinput / ryyss ) / zsumsedcal ) 220 #endif 221 END DO 222 END DO 223 224 DO jj = 1, jpj 225 DO ji = 1, jpi 226 ikt = MAX( mbathy(ji,jj) - 1, 1 ) 227 zfact = zstep / fse3t(ji,jj,ikt) 228 # if ! defined key_kriest 229 zconctmp = trn(ji,jj,ikt,jpgoc) 230 zconctmp2 = trn(ji,jj,ikt,jppoc) 231 trn(ji,jj,ikt,jpgoc) = trn(ji,jj,ikt,jpgoc) - zconctmp * wsbio4(ji,jj,ikt) * zfact 232 trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) - zconctmp2 * wsbio3(ji,jj,ikt) * zfact 233 #if ! defined key_sed 234 trn(ji,jj,ikt,jpdoc) = trn(ji,jj,ikt,jpdoc) & 235 & + ( zconctmp * wsbio4(ji,jj,ikt) + zconctmp2 * wsbio3(ji,jj,ikt) ) * zfact & 236 & * ( 1.- rivpo4input / (ryyss * zsumsedpo4 ) ) 237 #endif 238 trn(ji,jj,ikt,jpbfe) = trn(ji,jj,ikt,jpbfe) - trn(ji,jj,ikt,jpbfe) * wsbio4(ji,jj,ikt) * zfact 239 trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) - trn(ji,jj,ikt,jpsfe) * wsbio3(ji,jj,ikt) * zfact 240 206 ikt = mbkt(ji,jj) 207 zfact = xstep / fse3t(ji,jj,ikt) 208 zwsbio3 = zfact * wsbio3(ji,jj,ikt) 209 zwsbio4 = zfact * wsbio4(ji,jj,ikt) 210 zwscal = zfact * wscal (ji,jj,ikt) 211 trn(ji,jj,ikt,jptal) = trn(ji,jj,ikt,jptal) + trn(ji,jj,ikt,jpcal) * zwscal * zrivalk * 2.0 212 trn(ji,jj,ikt,jpdic) = trn(ji,jj,ikt,jpdic) + trn(ji,jj,ikt,jpcal) * zwscal * zrivalk 213 # if defined key_kriest 214 trn(ji,jj,ikt,jpsil) = trn(ji,jj,ikt,jpsil) + trn(ji,jj,ikt,jpdsi) * zwsbio4 * zrivsil 215 trn(ji,jj,ikt,jpdoc) = trn(ji,jj,ikt,jpdoc) + trn(ji,jj,ikt,jppoc) * zwsbio3 * zrivpo4 241 216 # else 242 zconctmp = trn(ji,jj,ikt,jpnum) 243 zconctmp2 = trn(ji,jj,ikt,jppoc) 244 trn(ji,jj,ikt,jpnum) = trn(ji,jj,ikt,jpnum) & 245 & - zconctmp * wsbio4(ji,jj,ikt) * zfact 246 trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) & 247 & - zconctmp2 * wsbio3(ji,jj,ikt) * zfact 248 #if ! defined key_sed 249 trn(ji,jj,ikt,jpdoc) = trn(ji,jj,ikt,jpdoc) & 250 & + ( zconctmp2 * wsbio3(ji,jj,ikt) ) & 251 & * zfact * ( 1.- rivpo4input / ( ryyss * zsumsedpo4 ) ) 252 #endif 253 trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) & 254 & - trn(ji,jj,ikt,jpsfe) * wsbio3(ji,jj,ikt) * zfact 255 217 trn(ji,jj,ikt,jpsil) = trn(ji,jj,ikt,jpsil) + trn(ji,jj,ikt,jpdsi) * zwscal * zrivsil 218 trn(ji,jj,ikt,jpdoc) = trn(ji,jj,ikt,jpdoc) & 219 & + ( trn(ji,jj,ikt,jppoc) * zwsbio3 + trn(ji,jj,ikt,jpgoc) * zwsbio4 ) * zrivpo4 256 220 # endif 257 221 END DO 258 222 END DO 223 # endif 259 224 260 225 ! Nitrogen fixation (simple parameterization). The total gain … … 263 228 ! ------------------------------------------------------------- 264 229 265 zdenitot = 0.e0 266 DO jk = 1, jpkm1 267 DO jj = 1,jpj 268 DO ji = 1,jpi 269 zdenitot = zdenitot + denitr(ji,jj,jk) * rdenit * cvol(ji,jj,jk) * xnegtr(ji,jj,jk) 270 END DO 271 END DO 272 END DO 273 274 IF( lk_mpp ) CALL mpp_sum( zdenitot ) ! sum over the global domain 230 zdenitot = glob_sum( denitr(:,:,:) * cvol(:,:,:) * xnegtr(:,:,:) ) * rdenit 275 231 276 232 ! Potential nitrogen fixation dependant on temperature and iron … … 285 241 zlim = ( 1.- xnanono3(ji,jj,jk) - xnanonh4(ji,jj,jk) ) 286 242 IF( zlim <= 0.2 ) zlim = 0.01 287 znitrpot(ji,jj,jk) = MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) / rday) &288 # if defined key_ off_degrad243 znitrpot(ji,jj,jk) = MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) * rday1 ) & 244 # if defined key_degrad 289 245 & * facvol(ji,jj,jk) & 290 246 # endif … … 295 251 END DO 296 252 297 znitrpottot = 0.e0 298 DO jk = 1, jpkm1 299 DO jj = 1, jpj 300 DO ji = 1, jpi 301 znitrpottot = znitrpottot + znitrpot(ji,jj,jk) * cvol(ji,jj,jk) 302 END DO 303 END DO 304 END DO 305 306 IF( lk_mpp ) CALL mpp_sum( znitrpottot ) ! sum over the global domain 253 znitrpottot = glob_sum( znitrpot(:,:,:) * cvol(:,:,:) ) 307 254 308 255 ! Nitrogen change due to nitrogen fixation … … 312 259 DO jj = 1, jpj 313 260 DO ji = 1, jpi 314 # if ! defined key_c1d && ( defined key_orca_r4 || defined key_orca_r2 || defined key_orca_r05 || defined key_orca_r025 )315 !! zfact = znitrpot(ji,jj,jk) * zdenitot / znitrpottot316 261 zfact = znitrpot(ji,jj,jk) * 1.e-7 317 # else318 zfact = znitrpot(ji,jj,jk) * 1.e-7319 # endif320 262 trn(ji,jj,jk,jpnh4) = trn(ji,jj,jk,jpnh4) + zfact 321 263 trn(ji,jj,jk,jpoxy) = trn(ji,jj,jk,jpoxy) + zfact * o2nit … … 325 267 END DO 326 268 327 #if defined key_ trc_diaadd || defined key_trc_dia3d328 z rfact2= 1.e+3 * rfact2r269 #if defined key_diatrc 270 zfact = 1.e+3 * rfact2r 329 271 # if ! defined key_iomput 330 trc2d(:,:,jp_pcs0_2d + 11) = zirondep(:,:,1) * z rfact2* fse3t(:,:,1) * tmask(:,:,1)331 trc2d(:,:,jp_pcs0_2d + 12) = znitrpot(:,:,1) * 1.e-7 * z rfact2* fse3t(:,:,1) * tmask(:,:,1)332 # else333 ! surface downward net flux of iron334 zw 2d(:,:) = ( zirondep(:,:,1) + ironsed(:,:,1) * rfact2 ) * zrfact2 * fse3t(:,:,1) * tmask(:,:,1)335 IF( jnt == nrdttrc ) CALL iom_put( "Irondep", zw2d )336 ! nitrogen fixation at surface337 zw2d(:,:) = znitrpot(:,:,1) * 1.e-7 * zrfact2 * fse3t(:,:,1) * tmask(:,:,1)338 IF( jnt == nrdttrc ) CALL iom_put( "Nfix" , zw2d )339 # endif340 # 272 trc2d(:,:,jp_pcs0_2d + 11) = zirondep(:,:,1) * zfact * fse3t(:,:,1) * tmask(:,:,1) 273 trc2d(:,:,jp_pcs0_2d + 12) = znitrpot(:,:,1) * 1.e-7 * zfact * fse3t(:,:,1) * tmask(:,:,1) 274 # else 275 zwork (:,:) = ( zirondep(:,:,1) + ironsed(:,:,1) * rfact2 ) * zfact * fse3t(:,:,1) * tmask(:,:,1) 276 zwork1(:,:) = znitrpot(:,:,1) * 1.e-7 * zfact * fse3t(:,:,1) * tmask(:,:,1) 277 IF( jnt == nrdttrc ) THEN 278 CALL iom_put( "Irondep", zwork ) ! surface downward net flux of iron 279 CALL iom_put( "Nfix" , zwork1 ) ! nitrogen fixation at surface 280 ENDIF 281 # endif 282 #endif 341 283 ! 342 284 IF(ln_ctl) THEN ! print mean trends (used for debugging) … … 348 290 END SUBROUTINE p4z_sed 349 291 350 SUBROUTINE p4z_sbc( kt)292 SUBROUTINE p4z_sbc( kt ) 351 293 352 294 !!---------------------------------------------------------------------- … … 365 307 366 308 !! * Local declarations 367 INTEGER :: & 368 imois, imois2, & ! temporary integers 369 i15 , iman ! " " 370 REAL(wp) :: & 371 zxy ! " " 372 309 INTEGER :: imois, i15, iman 310 REAL(wp) :: zxy 373 311 374 312 !!--------------------------------------------------------------------- … … 381 319 imois = nmonth + i15 - 1 382 320 IF( imois == 0 ) imois = iman 383 imois2 = nmonth 384 385 ! 1. first call kt=nit000 386 ! ----------------------- 387 388 IF( kt == nit000 ) THEN 389 ! initializations 390 nflx1 = 0 391 nflx11 = 0 392 ! open the file 393 IF(lwp) THEN 394 WRITE(numout,*) ' ' 395 WRITE(numout,*) ' **** Routine p4z_sbc' 396 ENDIF 397 CALL iom_open ( 'dust.orca.nc', numdust ) 398 ENDIF 399 400 401 ! Read monthly file 402 ! ---------------- 403 321 322 ! Calendar computation 404 323 IF( kt == nit000 .OR. imois /= nflx1 ) THEN 405 324 406 ! Calendar computation325 IF( kt == nit000 ) nflx1 = 0 407 326 408 327 ! nflx1 number of the first file record used in the simulation … … 410 329 411 330 nflx1 = imois 412 nflx2 = nflx1 +1331 nflx2 = nflx1 + 1 413 332 nflx1 = MOD( nflx1, iman ) 414 333 nflx2 = MOD( nflx2, iman ) 415 334 IF( nflx1 == 0 ) nflx1 = iman 416 335 IF( nflx2 == 0 ) nflx2 = iman 417 IF(lwp) WRITE(numout,*) 'first record file used nflx1 ',nflx1 418 IF(lwp) WRITE(numout,*) 'last record file used nflx2 ',nflx2 419 420 ! Read monthly fluxes data 421 422 ! humidity 423 CALL iom_get ( numdust, jpdom_data, 'dust', dustmo(:,:,1), nflx1 ) 424 CALL iom_get ( numdust, jpdom_data, 'dust', dustmo(:,:,2), nflx2 ) 425 426 IF(lwp .AND. nitend-nit000 <= 100 ) THEN 427 WRITE(numout,*) 428 WRITE(numout,*) ' read clio flx ok' 429 WRITE(numout,*) 430 WRITE(numout,*) 431 WRITE(numout,*) 'Clio month: ',nflx1,' field: dust' 432 CALL prihre( dustmo(:,:,1),jpi,jpj,1,jpi,20,1,jpj,10,1e9,numout ) 433 ENDIF 336 IF(lwp) WRITE(numout,*) 337 IF(lwp) WRITE(numout,*) ' p4z_sbc : first record file used nflx1 ',nflx1 338 IF(lwp) WRITE(numout,*) ' p4z_sbc : last record file used nflx2 ',nflx2 434 339 435 340 ENDIF 436 341 437 ! 3. at every time step interpolation of fluxes342 ! 3. at every time step interpolation of fluxes 438 343 ! --------------------------------------------- 439 344 440 345 zxy = FLOAT( nday + 15 - 30 * i15 ) / 30 441 dust(:,:) = ( (1.-zxy) * dustmo(:,:,1) + zxy * dustmo(:,:,2) ) 442 443 IF( kt == nitend ) CALL iom_close (numdust) 346 dust(:,:) = ( (1.-zxy) * dustmo(:,:,nflx1) + zxy * dustmo(:,:,nflx2) ) 444 347 445 348 END SUBROUTINE p4z_sbc … … 454 357 !! 455 358 !! ** Method : Read the files and compute the budget 456 !! called at the first timestep (nit trc000)359 !! called at the first timestep (nit000) 457 360 !! 458 361 !! ** input : external netcdf files … … 460 363 !!---------------------------------------------------------------------- 461 364 462 INTEGER :: ji, jj, jk, jm 463 INTEGER , PARAMETER :: jpmois = 12, jpan = 1 365 INTEGER :: ji, jj, jk, jm 464 366 INTEGER :: numriv, numbath, numdep 465 367 … … 469 371 REAL(wp) , DIMENSION (jpi,jpj) :: riverdoc, river, ndepo 470 372 REAL(wp) , DIMENSION (jpi,jpj,jpk) :: cmask 471 REAL(wp) , DIMENSION(jpi,jpj,12) :: zdustmo472 373 473 374 NAMELIST/nampissed/ ln_dustfer, ln_river, ln_ndepo, ln_sedinput, sedfeinput, dustsolub … … 495 396 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' 496 397 CALL iom_open ( 'dust.orca.nc', numdust ) 497 DO jm = 1, jpm ois498 CALL iom_get( numdust, jpdom_data, 'dust', zdustmo(:,:,jm), jm )398 DO jm = 1, jpmth 399 CALL iom_get( numdust, jpdom_data, 'dust', dustmo(:,:,jm), jm ) 499 400 END DO 500 401 CALL iom_close( numdust ) 501 402 ELSE 502 zdustmo(:,:,:) = 0.e0403 dustmo(:,:,:) = 0.e0 503 404 dust(:,:) = 0.0 504 405 ENDIF … … 510 411 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 511 412 CALL iom_open ( 'river.orca.nc', numriv ) 512 CALL iom_get ( numriv, jpdom_data, 'riverdic', river (:,:), jp an)513 CALL iom_get ( numriv, jpdom_data, 'riverdoc', riverdoc(:,:), jp an)413 CALL iom_get ( numriv, jpdom_data, 'riverdic', river (:,:), jpyr ) 414 CALL iom_get ( numriv, jpdom_data, 'riverdoc', riverdoc(:,:), jpyr ) 514 415 CALL iom_close( numriv ) 515 416 ELSE … … 524 425 IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 525 426 CALL iom_open ( 'ndeposition.orca.nc', numdep ) 526 CALL iom_get ( numdep, jpdom_data, 'ndep', ndepo(:,:), jp an)427 CALL iom_get ( numdep, jpdom_data, 'ndep', ndepo(:,:), jpyr ) 527 428 CALL iom_close( numdep ) 528 429 ELSE … … 537 438 IF(lwp) WRITE(numout,*) ' from bathy.orca.nc file ' 538 439 CALL iom_open ( 'bathy.orca.nc', numbath ) 539 CALL iom_get ( numbath, jpdom_data, 'bathy', cmask(:,:,:), jp an)440 CALL iom_get ( numbath, jpdom_data, 'bathy', cmask(:,:,:), jpyr ) 540 441 CALL iom_close( numbath ) 541 442 ! … … 546 447 zmaskt = tmask(ji+1,jj,jk) * tmask(ji-1,jj,jk) * tmask(ji,jj+1,jk) & 547 448 & * tmask(ji,jj-1,jk) * tmask(ji,jj,jk+1) 548 IF( zmaskt == 0. ) cmask(ji,jj,jk ) = 0.1449 IF( zmaskt == 0. ) cmask(ji,jj,jk ) = MAX( 0.1, cmask(ji,jj,jk) ) 549 450 ENDIF 550 451 END DO … … 567 468 568 469 569 ! Number of seconds per year and per month 570 ryyss = nyear_len(1) * rday 571 rmtss = ryyss / raamo 470 ! ! Number of seconds per year and per month 471 ryyss = nyear_len(1) * rday 472 rmtss = ryyss / raamo 473 rday1 = 1. / rday 474 ryyss1 = 1. / ryyss 475 ! ! ocean surface cell 476 e1e2t(:,:) = e1t(:,:) * e2t(:,:) 572 477 573 478 ! total atmospheric supply of Si 574 479 ! ------------------------------ 575 480 sumdepsi = 0.e0 576 DO jm = 1, jpmois 577 DO jj = 2, jpjm1 578 DO ji = fs_2, fs_jpim1 579 sumdepsi = sumdepsi + zdustmo(ji,jj,jm) / (12.*rmtss) * 8.8 & 580 & * 0.075/28.1 * e1t(ji,jj) * e2t(ji,jj) * tmask(ji,jj,1) * tmask_i(ji,jj) 581 END DO 582 END DO 583 END DO 584 IF( lk_mpp ) CALL mpp_sum( sumdepsi ) ! sum over the global domain 481 DO jm = 1, jpmth 482 zcoef = 1. / ( 12. * rmtss ) * 8.8 * 0.075 / 28.1 483 sumdepsi = sumdepsi + glob_sum( dustmo(:,:,jm) * e1e2t(:,:) ) * zcoef 484 ENDDO 585 485 586 486 ! N/P and Si releases due to coastal rivers … … 588 488 DO jj = 1, jpj 589 489 DO ji = 1, jpi 590 zcoef = ryyss * e1 t(ji,jj) * e2t(ji,jj) * fse3t(ji,jj,1) * tmask(ji,jj,1) * tmask_i(ji,jj)490 zcoef = ryyss * e1e2t(ji,jj) * fse3t(ji,jj,1) * tmask(ji,jj,1) 591 491 cotdep(ji,jj) = river(ji,jj) *1E9 / ( 12. * zcoef + rtrn ) 592 492 rivinp(ji,jj) = (river(ji,jj)+riverdoc(ji,jj)) *1E9 / ( 31.6* zcoef + rtrn ) … … 597 497 CALL lbc_lnk( cotdep , 'T', 1. ) ; CALL lbc_lnk( rivinp , 'T', 1. ) ; CALL lbc_lnk( nitdep , 'T', 1. ) 598 498 599 rivpo4input = 0.e0 600 rivalkinput = 0.e0 601 nitdepinput = 0.e0 602 DO jj = 2 , jpjm1 603 DO ji = fs_2, fs_jpim1 604 zcoef = cvol(ji,jj,1) * ryyss 605 rivpo4input = rivpo4input + rivinp(ji,jj) * zcoef 606 rivalkinput = rivalkinput + cotdep(ji,jj) * zcoef 607 nitdepinput = nitdepinput + nitdep(ji,jj) * zcoef 608 END DO 609 END DO 610 IF( lk_mpp ) THEN 611 CALL mpp_sum( rivpo4input ) ! sum over the global domain 612 CALL mpp_sum( rivalkinput ) ! sum over the global domain 613 CALL mpp_sum( nitdepinput ) ! sum over the global domain 614 ENDIF 499 rivpo4input = glob_sum( rivinp(:,:) * cvol(:,:,1) ) * ryyss 500 rivalkinput = glob_sum( cotdep(:,:) * cvol(:,:,1) ) * ryyss 501 nitdepinput = glob_sum( nitdep(:,:) * cvol(:,:,1) ) * ryyss 615 502 616 503
Note: See TracChangeset
for help on using the changeset viewer.
