Changeset 10345 for NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/PISCES/SED/sedadv.F90
- Timestamp:
- 2018-11-21T11:25:53+01:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2018/dev_r10164_HPC09_ESIWACE_PREP_MERGE/src/TOP/PISCES/SED/sedadv.F90
r9124 r10345 4 4 !! Sediment : vertical advection and burial 5 5 !!===================================================================== 6 #if defined key_sed 7 !!---------------------------------------------------------------------- 8 !! 'key_sed' Sediment 6 !! * Modules used 9 7 !!---------------------------------------------------------------------- 10 8 !! sed_adv : 11 9 !!---------------------------------------------------------------------- 12 10 USE sed ! sediment global variable 11 USE lib_mpp ! distribued memory computing library 12 13 IMPLICIT NONE 14 PRIVATE 13 15 14 16 PUBLIC sed_adv 15 16 !! * Module variable 17 INTEGER, PARAMETER :: nztime = jpksed ! number of time step between sunrise and sunset 18 19 REAL(wp), DIMENSION(jpksed), SAVE :: dvolsp, dvolsm 20 REAL(wp), DIMENSION(jpksed), SAVE :: c2por, ckpor 17 PUBLIC sed_adv_alloc 18 19 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: dvolsp, dvolsm 20 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: c2por, ckpor 21 21 22 22 REAL(wp) :: cpor … … 49 49 ! * local variables 50 50 INTEGER :: ji, jk, js 51 INTEGER :: jn, ntimes, ikwneg51 INTEGER :: jn, ntimes, nztime, ikwneg 52 52 53 REAL(wp), DIMENSION( :,:), ALLOCATABLE:: zsolcpno54 REAL(wp), DIMENSION( : ), ALLOCATABLE:: zfilled, zfull, zfromup, zempty55 REAL(wp), DIMENSION( :,:), ALLOCATABLE:: zgap, zwb56 REAL(wp), DIMENSION( :,:), ALLOCATABLE:: zrainrf57 REAL(wp), DIMENSION( nztime) ::zraipush58 59 REAL(wp) :: zkwnup, zkwnlo, zfrac, zfromce, zrest 53 REAL(wp), DIMENSION(jpksed,jpsol) :: zsolcpno 54 REAL(wp), DIMENSION(jpksed) :: zfilled, zfull, zfromup, zempty 55 REAL(wp), DIMENSION(jpoce,jpksed) :: zgap, zwb 56 REAL(wp), DIMENSION(jpoce,jpsol) :: zrainrf 57 REAL(wp), DIMENSION(: ), ALLOCATABLE :: zraipush 58 59 REAL(wp) :: zkwnup, zkwnlo, zfrac, zfromce, zrest, sumtot, zsumtot1 60 60 61 61 !------------------------------------------------------------------------ 62 62 63 63 64 IF( ln_timing ) CALL timing_start('sed_adv') 65 ! 64 66 IF( kt == nitsed000 ) THEN 65 WRITE(numsed,*) ' ' 66 WRITE(numsed,*) ' sed_adv : vertical sediment advection ' 67 WRITE(numsed,*) ' ' 68 por1clay = dens * por1(jpksed) * dz(jpksed) / mol_wgt(jsclay) 67 IF (lwp) THEN 68 WRITE(numsed,*) ' ' 69 WRITE(numsed,*) ' sed_adv : vertical sediment advection ' 70 WRITE(numsed,*) ' ' 71 ENDIF 72 por1clay = denssol * por1(jpksed) * dz(jpksed) 69 73 cpor = por1(jpksed) / por1(2) 70 74 DO jk = 2, jpksed … … 80 84 ENDIF 81 85 82 ALLOCATE( zsolcpno(jpksed,jpsol), zrainrf(jpoce,jpsol) )83 ALLOCATE( zfilled(jpksed), zfull(jpksed), zfromup(jpksed), zempty(jpksed) )84 ALLOCATE( zgap (jpoce,jpksed) , zwb(jpoce,jpksed) )85 86 86 ! Initialization of data for mass balance calculation 87 87 !--------------------------------------------------- … … 89 89 tosed (:,:) = 0. 90 90 rloss (:,:) = 0. 91 91 ikwneg = 1 92 nztime = jpksed 93 94 ALLOCATE( zraipush(nztime) ) 92 95 93 96 ! Initiate gap … … 104 107 zgap(1:jpoce,1:jpksed) = 1. - zgap(1:jpoce,1:jpksed) 105 108 106 107 109 ! Initiate burial rates 108 110 !----------------------- 109 111 zwb(:,:) = 0. 110 112 DO jk = 2, jpksed 111 zfrac = dtsed / ( dens * por1(jk) )113 zfrac = dtsed / ( denssol * por1(jk) ) 112 114 DO ji = 1, jpoce 113 115 zwb(ji,jk) = zfrac * raintg(ji) … … 127 129 ENDDO 128 130 129 130 131 zrainrf(:,:) = 0. 131 132 DO ji = 1, jpoce … … 206 207 ! quantities to push in deeper sediment 207 208 tosed (ji,js) = zsolcpno(jpksed,js) & 208 & * zwb(ji,jpksed) * dens * por1(jpksed) / mol_wgt(js)209 ENDDO 210 209 & * zwb(ji,jpksed) * denssol * por1(jpksed) 210 ENDDO 211 211 212 ELSE ! what is remaining is great than dz(2) 212 213 213 214 ntimes = INT( zrest / dz(2) ) + 1 214 IF( ntimes > nztime ) THEN 215 WRITE( numsed,* ) ' sedadv : rest too large at sediment point ji = ', ji 216 STOP 217 ENDIF 215 IF( ntimes > nztime ) CALL ctl_stop( 'STOP', 'sed_adv : rest too large ' ) 218 216 zraipush(1) = dz(2) 219 217 zrest = zrest - zraipush(1) … … 249 247 fromsed(ji,js) = 0. 250 248 tosed (ji,js) = tosed(ji,js) + zsolcpno(jpksed,js) * zraipush(jn) & 251 & * dens * por1(2) / mol_wgt(js)249 & * denssol * por1(2) 252 250 ENDDO 253 251 ENDDO … … 279 277 ! for the last layer, one make go up clay 280 278 solcp(ji,jpksed,jsclay) = solcp(ji,jpksed,jsclay) + zempty(jpksed) * 1. 281 !! C. Heinze fromsed(ji,jsclay) = zempty(jpksed) * 1. * dens * por1(jpksed) / mol_wgt(jsclay)282 279 fromsed(ji,jsclay) = zempty(jpksed) * 1. * por1clay 283 284 280 ELSE ! rain > 0 and rain < total reaction loss 285 281 … … 323 319 ENDDO 324 320 solcp(ji,jpksed,jsclay) = solcp(ji,jpksed,jsclay) + zempty(jpksed) * 1. 325 !! C. Heinze fromsed(ji,jsclay) = zempty(jpksed) * 1. * dens * por1(jpksed) / mol_wgt(jsclay)321 !! C. Heinze fromsed(ji,jsclay) = zempty(jpksed) * 1. * denssol * por1(jpksed) / mol_wgt(jsclay) 326 322 fromsed(ji,jsclay) = zempty(jpksed) * 1. * por1clay 327 323 … … 339 335 solcp(ji,2,js) = zfull(2) * zsolcpno(2,js) + zempty(2) * zrainrf(ji,js) 340 336 ENDDO 341 DO js = 1, jpsol 337 DO js = 1, jpsol 342 338 DO jk = jpksedm1, 3, -1 343 339 solcp(ji,jk,js) = zfull(jk) * zsolcpno(jk,js) + zempty(jk) * zsolcpno(jk-1,js) … … 349 345 ENDDO 350 346 solcp(ji,jpksed,jsclay) = solcp(ji,jpksed,jsclay) + zkwnlo * 1. 351 ! Heinze fromsed(ji,jsclay) = zkwnlo * 1. * dens * por1(jpksed) / mol_wgt(jsclay)347 ! Heinze fromsed(ji,jsclay) = zkwnlo * 1. * denssol * por1(jpksed) / mol_wgt(jsclay) 352 348 fromsed(ji,jsclay) = zkwnlo * 1.* por1clay 353 349 ELSE ! 2 < ikwneg(ji) <= jpksedm1 … … 415 411 fromsed(ji,js) = 0. 416 412 ENDDO 417 ! Heinze fromsed(ji,jsclay) = zempty * 1. * dens * por1(jpksed) / mol_wgt(jsclay)413 ! Heinze fromsed(ji,jsclay) = zempty * 1. * denssol * por1(jpksed) / mol_wgt(jsclay) 418 414 fromsed(ji,jsclay) = zempty(jpksed) * 1. * por1clay 415 419 416 ENDIF ! ikwneg(ji) = 2 420 417 ENDIF ! zwb > 0 … … 425 422 raintg(:) = 0. 426 423 427 DEALLOCATE( zsolcpno ) 428 DEALLOCATE( zrainrf ) 429 DEALLOCATE( zfilled ) 430 DEALLOCATE( zfull ) 431 DEALLOCATE( zfromup ) 432 DEALLOCATE( zempty ) 433 DEALLOCATE( zgap ) 434 DEALLOCATE( zwb ) 435 424 DEALLOCATE( zraipush ) 425 426 IF( ln_timing ) CALL timing_stop('sed_adv') 436 427 437 428 END SUBROUTINE sed_adv 438 #else 439 !!====================================================================== 440 !! MODULE sedbtb : Dummy module 441 !!====================================================================== 442 !! $Id$ 443 CONTAINS 444 SUBROUTINE sed_adv( kt ) ! Empty routine 445 INTEGER, INTENT(in) :: kt 446 WRITE(*,*) 'sed_adv: You should not have seen this print! error?', kt 447 END SUBROUTINE sed_adv 448 449 !!====================================================================== 450 451 #endif 429 430 431 INTEGER FUNCTION sed_adv_alloc() 432 !!---------------------------------------------------------------------- 433 !! *** ROUTINE p4z_prod_alloc *** 434 !!---------------------------------------------------------------------- 435 ALLOCATE( dvolsp(jpksed), dvolsm(jpksed), c2por(jpksed), & 436 & ckpor(jpksed) , STAT = sed_adv_alloc ) 437 ! 438 IF( sed_adv_alloc /= 0 ) CALL ctl_warn('sed_adv_alloc : failed to allocate arrays.') 439 ! 440 END FUNCTION sed_adv_alloc 441 452 442 END MODULE sedadv
Note: See TracChangeset
for help on using the changeset viewer.
