- Timestamp:
- 2019-11-22T15:29:17+01:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11943_MERGE_2019/src
- Files:
-
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11943_MERGE_2019/src
- Property svn:mergeinfo deleted
-
NEMO/branches/2019/dev_r11943_MERGE_2019/src/TOP/PISCES/P4Z/p4zsms.F90
r11536 r11949 46 46 CONTAINS 47 47 48 SUBROUTINE p4z_sms( kt )48 SUBROUTINE p4z_sms( kt, Kbb, Kmm, Krhs ) 49 49 !!--------------------------------------------------------------------- 50 50 !! *** ROUTINE p4z_sms *** … … 58 58 !!--------------------------------------------------------------------- 59 59 ! 60 INTEGER, INTENT( in ) :: kt ! ocean time-step index 60 INTEGER, INTENT( in ) :: kt ! ocean time-step index 61 INTEGER, INTENT( in ) :: Kbb, Kmm, Krhs ! time level index 61 62 !! 62 63 INTEGER :: ji, jj, jk, jnt, jn, jl … … 72 73 ! 73 74 IF( .NOT. ln_rsttr ) THEN 74 CALL p4z_che 75 CALL ahini_for_at( hi)! set PH at kt=nit00075 CALL p4z_che( Kbb, Kmm ) ! initialize the chemical constants 76 CALL ahini_for_at( hi, Kbb ) ! set PH at kt=nit000 76 77 t_oce_co2_flx_cum = 0._wp 77 78 ELSE 78 CALL p4z_rst( nittrc000, 'READ' ) !* read or initialize all required fields79 CALL p4z_rst( nittrc000, Kbb, Kmm, 'READ' ) !* read or initialize all required fields 79 80 ENDIF 80 81 ! 81 82 ENDIF 82 83 ! 83 IF( ln_pisdmp .AND. MOD( kt - nn_dttrc, nn_pisdmp ) == 0 ) CALL p4z_dmp( kt) ! Relaxation of some tracers84 IF( ln_pisdmp .AND. MOD( kt - 1, nn_pisdmp ) == 0 ) CALL p4z_dmp( kt, Kbb, Kmm ) ! Relaxation of some tracers 84 85 ! 85 86 rfact = r2dttrc 86 87 ! 87 IF( ( ln_top_euler .AND. kt == nittrc000 ) .OR. ( .NOT.ln_top_euler .AND. kt <= nittrc000 + nn_dttrc) ) THEN88 IF( ( ln_top_euler .AND. kt == nittrc000 ) .OR. ( .NOT.ln_top_euler .AND. kt <= nittrc000 + 1 ) ) THEN 88 89 rfactr = 1. / rfact 89 90 rfact2 = rfact / REAL( nrdttrc, wp ) … … 98 99 IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN 99 100 DO jn = jp_pcs0, jp_pcs1 ! SMS on tracer without Asselin time-filter 100 tr b(:,:,:,jn) = trn(:,:,:,jn)101 tr(:,:,:,jn,Kbb) = tr(:,:,:,jn,Kmm) 101 102 END DO 102 103 ENDIF 103 104 ! 104 IF( ll_sbc ) CALL p4z_sbc( kt ) ! external sources of nutrients105 IF( ll_sbc ) CALL p4z_sbc( kt, Kmm ) ! external sources of nutrients 105 106 ! 106 107 #if ! defined key_sed_off 107 CALL p4z_che 108 CALL p4z_int( kt )! computation of various rates for biogeochemistry108 CALL p4z_che( Kbb, Kmm ) ! computation of chemical constants 109 CALL p4z_int( kt, Kbb, Kmm ) ! computation of various rates for biogeochemistry 109 110 ! 110 111 DO jnt = 1, nrdttrc ! Potential time splitting if requested 111 112 ! 112 CALL p4z_bio( kt, jnt ) ! Biology113 CALL p4z_lys( kt, jnt ) ! Compute CaCO3 saturation114 CALL p4z_sed( kt, jnt ) ! Surface and Bottom boundary conditions115 CALL p4z_flx( kt, jnt ) ! Compute surface fluxes113 CALL p4z_bio( kt, jnt, Kbb, Kmm, Krhs ) ! Biology 114 CALL p4z_lys( kt, jnt, Kbb, Krhs ) ! Compute CaCO3 saturation 115 CALL p4z_sed( kt, jnt, Kbb, Kmm, Krhs ) ! Surface and Bottom boundary conditions 116 CALL p4z_flx( kt, jnt, Kbb, Kmm, Krhs ) ! Compute surface fluxes 116 117 ! 117 118 xnegtr(:,:,:) = 1.e0 … … 120 121 DO jj = 1, jpj 121 122 DO ji = 1, jpi 122 IF( ( tr b(ji,jj,jk,jn) + tra(ji,jj,jk,jn) ) < 0.e0 ) THEN123 ztra = ABS( tr b(ji,jj,jk,jn) ) / ( ABS( tra(ji,jj,jk,jn) ) + rtrn )123 IF( ( tr(ji,jj,jk,jn,Kbb) + tr(ji,jj,jk,jn,Krhs) ) < 0.e0 ) THEN 124 ztra = ABS( tr(ji,jj,jk,jn,Kbb) ) / ( ABS( tr(ji,jj,jk,jn,Krhs) ) + rtrn ) 124 125 xnegtr(ji,jj,jk) = MIN( xnegtr(ji,jj,jk), ztra ) 125 126 ENDIF … … 131 132 ! ! 132 133 DO jn = jp_pcs0, jp_pcs1 133 tr b(:,:,:,jn) = trb(:,:,:,jn) + xnegtr(:,:,:) * tra(:,:,:,jn)134 tr(:,:,:,jn,Kbb) = tr(:,:,:,jn,Kbb) + xnegtr(:,:,:) * tr(:,:,:,jn,Krhs) 134 135 END DO 135 136 ! 136 137 DO jn = jp_pcs0, jp_pcs1 137 tr a(:,:,:,jn) = 0._wp138 tr(:,:,:,jn,Krhs) = 0._wp 138 139 END DO 139 140 ! 140 141 IF( ln_top_euler ) THEN 141 142 DO jn = jp_pcs0, jp_pcs1 142 tr n(:,:,:,jn) = trb(:,:,:,jn)143 tr(:,:,:,jn,Kmm) = tr(:,:,:,jn,Kbb) 143 144 END DO 144 145 ENDIF … … 148 149 IF( l_trdtrc ) THEN 149 150 DO jn = jp_pcs0, jp_pcs1 150 CALL trd_trc( tr a(:,:,:,jn), jn, jptra_sms, kt) ! save trends151 CALL trd_trc( tr(:,:,:,jn,Krhs), jn, jptra_sms, kt, Kmm ) ! save trends 151 152 END DO 152 153 END IF … … 155 156 IF( ln_sediment ) THEN 156 157 ! 157 CALL sed_model( kt ) ! Main program of Sediment model158 CALL sed_model( kt, Kbb, Kmm, Krhs ) ! Main program of Sediment model 158 159 ! 159 160 IF( ln_top_euler ) THEN 160 161 DO jn = jp_pcs0, jp_pcs1 161 tr n(:,:,:,jn) = trb(:,:,:,jn)162 tr(:,:,:,jn,Kmm) = tr(:,:,:,jn,Kbb) 162 163 END DO 163 164 ENDIF … … 165 166 ENDIF 166 167 ! 167 IF( lrst_trc ) CALL p4z_rst( kt, 'WRITE' )!* Write PISCES informations in restart file168 ! 169 170 IF( lk_iomput .OR. ln_check_mass ) CALL p4z_chk_mass( kt )! Mass conservation checking171 172 IF( lwm .AND. kt == nittrc000 ) CALL FLUSH( numonp ) ! flush output namelist PISCES168 IF( lrst_trc ) CALL p4z_rst( kt, Kbb, Kmm, 'WRITE' ) !* Write PISCES informations in restart file 169 ! 170 171 IF( lk_iomput .OR. ln_check_mass ) CALL p4z_chk_mass( kt, Kmm ) ! Mass conservation checking 172 173 IF( lwm .AND. kt == nittrc000 ) CALL FLUSH( numonp ) ! flush output namelist PISCES 173 174 ! 174 175 IF( ln_timing ) CALL timing_stop('p4z_sms') … … 264 265 265 266 266 SUBROUTINE p4z_rst( kt, cdrw )267 SUBROUTINE p4z_rst( kt, Kbb, Kmm, cdrw ) 267 268 !!--------------------------------------------------------------------- 268 269 !! *** ROUTINE p4z_rst *** … … 275 276 !!--------------------------------------------------------------------- 276 277 INTEGER , INTENT(in) :: kt ! ocean time-step 278 INTEGER , INTENT(in) :: Kbb, Kmm ! time level indices 277 279 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 278 280 !!--------------------------------------------------------------------- … … 287 289 CALL iom_get( numrtr, jpdom_autoglo, 'PH' , hi(:,:,:) ) 288 290 ELSE 289 CALL p4z_che 290 CALL ahini_for_at( hi)291 CALL p4z_che( Kbb, Kmm ) ! initialize the chemical constants 292 CALL ahini_for_at( hi, Kbb ) 291 293 ENDIF 292 294 CALL iom_get( numrtr, jpdom_autoglo, 'Silicalim', xksi(:,:) ) … … 335 337 336 338 337 SUBROUTINE p4z_dmp( kt )339 SUBROUTINE p4z_dmp( kt, Kbb, Kmm ) 338 340 !!---------------------------------------------------------------------- 339 341 !! *** p4z_dmp *** … … 342 344 !!---------------------------------------------------------------------- 343 345 ! 344 INTEGER, INTENT( in ) :: kt ! time step 346 INTEGER, INTENT( in ) :: kt ! time step 347 INTEGER, INTENT( in ) :: Kbb, Kmm ! time level indices 345 348 ! 346 349 REAL(wp) :: alkmean = 2426. ! mean value of alkalinity ( Glodap ; for Goyet 2391. ) … … 363 366 zarea = 1._wp / glob_sum( 'p4zsms', cvol(:,:,:) ) * 1e6 364 367 365 zalksumn = glob_sum( 'p4zsms', tr n(:,:,:,jptal) * cvol(:,:,:) ) * zarea366 zpo4sumn = glob_sum( 'p4zsms', tr n(:,:,:,jppo4) * cvol(:,:,:) ) * zarea * po4r367 zno3sumn = glob_sum( 'p4zsms', tr n(:,:,:,jpno3) * cvol(:,:,:) ) * zarea * rno3368 zsilsumn = glob_sum( 'p4zsms', tr n(:,:,:,jpsil) * cvol(:,:,:) ) * zarea368 zalksumn = glob_sum( 'p4zsms', tr(:,:,:,jptal,Kmm) * cvol(:,:,:) ) * zarea 369 zpo4sumn = glob_sum( 'p4zsms', tr(:,:,:,jppo4,Kmm) * cvol(:,:,:) ) * zarea * po4r 370 zno3sumn = glob_sum( 'p4zsms', tr(:,:,:,jpno3,Kmm) * cvol(:,:,:) ) * zarea * rno3 371 zsilsumn = glob_sum( 'p4zsms', tr(:,:,:,jpsil,Kmm) * cvol(:,:,:) ) * zarea 369 372 370 373 IF(lwp) WRITE(numout,*) ' TALKN mean : ', zalksumn 371 tr n(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / zalksumn374 tr(:,:,:,jptal,Kmm) = tr(:,:,:,jptal,Kmm) * alkmean / zalksumn 372 375 373 376 IF(lwp) WRITE(numout,*) ' PO4N mean : ', zpo4sumn 374 tr n(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / zpo4sumn377 tr(:,:,:,jppo4,Kmm) = tr(:,:,:,jppo4,Kmm) * po4mean / zpo4sumn 375 378 376 379 IF(lwp) WRITE(numout,*) ' NO3N mean : ', zno3sumn 377 tr n(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / zno3sumn380 tr(:,:,:,jpno3,Kmm) = tr(:,:,:,jpno3,Kmm) * no3mean / zno3sumn 378 381 379 382 IF(lwp) WRITE(numout,*) ' SiO3N mean : ', zsilsumn 380 tr n(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * silmean / zsilsumn )383 tr(:,:,:,jpsil,Kmm) = MIN( 400.e-6,tr(:,:,:,jpsil,Kmm) * silmean / zsilsumn ) 381 384 ! 382 385 ! 383 386 IF( .NOT. ln_top_euler ) THEN 384 zalksumb = glob_sum( 'p4zsms', tr b(:,:,:,jptal) * cvol(:,:,:) ) * zarea385 zpo4sumb = glob_sum( 'p4zsms', tr b(:,:,:,jppo4) * cvol(:,:,:) ) * zarea * po4r386 zno3sumb = glob_sum( 'p4zsms', tr b(:,:,:,jpno3) * cvol(:,:,:) ) * zarea * rno3387 zsilsumb = glob_sum( 'p4zsms', tr b(:,:,:,jpsil) * cvol(:,:,:) ) * zarea387 zalksumb = glob_sum( 'p4zsms', tr(:,:,:,jptal,Kbb) * cvol(:,:,:) ) * zarea 388 zpo4sumb = glob_sum( 'p4zsms', tr(:,:,:,jppo4,Kbb) * cvol(:,:,:) ) * zarea * po4r 389 zno3sumb = glob_sum( 'p4zsms', tr(:,:,:,jpno3,Kbb) * cvol(:,:,:) ) * zarea * rno3 390 zsilsumb = glob_sum( 'p4zsms', tr(:,:,:,jpsil,Kbb) * cvol(:,:,:) ) * zarea 388 391 389 392 IF(lwp) WRITE(numout,*) ' ' 390 393 IF(lwp) WRITE(numout,*) ' TALKB mean : ', zalksumb 391 tr b(:,:,:,jptal) = trb(:,:,:,jptal) * alkmean / zalksumb394 tr(:,:,:,jptal,Kbb) = tr(:,:,:,jptal,Kbb) * alkmean / zalksumb 392 395 393 396 IF(lwp) WRITE(numout,*) ' PO4B mean : ', zpo4sumb 394 tr b(:,:,:,jppo4) = trb(:,:,:,jppo4) * po4mean / zpo4sumb397 tr(:,:,:,jppo4,Kbb) = tr(:,:,:,jppo4,Kbb) * po4mean / zpo4sumb 395 398 396 399 IF(lwp) WRITE(numout,*) ' NO3B mean : ', zno3sumb 397 tr b(:,:,:,jpno3) = trb(:,:,:,jpno3) * no3mean / zno3sumb400 tr(:,:,:,jpno3,Kbb) = tr(:,:,:,jpno3,Kbb) * no3mean / zno3sumb 398 401 399 402 IF(lwp) WRITE(numout,*) ' SiO3B mean : ', zsilsumb 400 tr b(:,:,:,jpsil) = MIN( 400.e-6,trb(:,:,:,jpsil) * silmean / zsilsumb )403 tr(:,:,:,jpsil,Kbb) = MIN( 400.e-6,tr(:,:,:,jpsil,Kbb) * silmean / zsilsumb ) 401 404 ENDIF 402 405 ENDIF … … 407 410 408 411 409 SUBROUTINE p4z_chk_mass( kt )412 SUBROUTINE p4z_chk_mass( kt, Kmm ) 410 413 !!---------------------------------------------------------------------- 411 414 !! *** ROUTINE p4z_chk_mass *** … … 415 418 !!--------------------------------------------------------------------- 416 419 INTEGER, INTENT( in ) :: kt ! ocean time-step index 420 INTEGER, INTENT( in ) :: Kmm ! time level indices 417 421 REAL(wp) :: zrdenittot, zsdenittot, znitrpottot 418 422 CHARACTER(LEN=100) :: cltxt … … 438 442 ! Compute the budget of NO3, ALK, Si, Fer 439 443 IF( ln_p4z ) THEN 440 zwork(:,:,:) = tr n(:,:,:,jpno3) + trn(:,:,:,jpnh4) &441 & + tr n(:,:,:,jpphy) + trn(:,:,:,jpdia) &442 & + tr n(:,:,:,jppoc) + trn(:,:,:,jpgoc) + trn(:,:,:,jpdoc) &443 & + tr n(:,:,:,jpzoo) + trn(:,:,:,jpmes)444 zwork(:,:,:) = tr(:,:,:,jpno3,Kmm) + tr(:,:,:,jpnh4,Kmm) & 445 & + tr(:,:,:,jpphy,Kmm) + tr(:,:,:,jpdia,Kmm) & 446 & + tr(:,:,:,jppoc,Kmm) + tr(:,:,:,jpgoc,Kmm) + tr(:,:,:,jpdoc,Kmm) & 447 & + tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm) 444 448 ELSE 445 zwork(:,:,:) = tr n(:,:,:,jpno3) + trn(:,:,:,jpnh4) + trn(:,:,:,jpnph) &446 & + tr n(:,:,:,jpndi) + trn(:,:,:,jpnpi) &447 & + tr n(:,:,:,jppon) + trn(:,:,:,jpgon) + trn(:,:,:,jpdon) &448 & + ( tr n(:,:,:,jpzoo) + trn(:,:,:,jpmes) ) * no3rat3449 zwork(:,:,:) = tr(:,:,:,jpno3,Kmm) + tr(:,:,:,jpnh4,Kmm) + tr(:,:,:,jpnph,Kmm) & 450 & + tr(:,:,:,jpndi,Kmm) + tr(:,:,:,jpnpi,Kmm) & 451 & + tr(:,:,:,jppon,Kmm) + tr(:,:,:,jpgon,Kmm) + tr(:,:,:,jpdon,Kmm) & 452 & + ( tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm) ) * no3rat3 449 453 ENDIF 450 454 ! … … 456 460 IF( iom_use( "ppo4tot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN 457 461 IF( ln_p4z ) THEN 458 zwork(:,:,:) = tr n(:,:,:,jppo4) &459 & + tr n(:,:,:,jpphy) + trn(:,:,:,jpdia) &460 & + tr n(:,:,:,jppoc) + trn(:,:,:,jpgoc) + trn(:,:,:,jpdoc) &461 & + tr n(:,:,:,jpzoo) + trn(:,:,:,jpmes)462 zwork(:,:,:) = tr(:,:,:,jppo4,Kmm) & 463 & + tr(:,:,:,jpphy,Kmm) + tr(:,:,:,jpdia,Kmm) & 464 & + tr(:,:,:,jppoc,Kmm) + tr(:,:,:,jpgoc,Kmm) + tr(:,:,:,jpdoc,Kmm) & 465 & + tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm) 462 466 ELSE 463 zwork(:,:,:) = tr n(:,:,:,jppo4) + trn(:,:,:,jppph) &464 & + tr n(:,:,:,jppdi) + trn(:,:,:,jpppi) &465 & + tr n(:,:,:,jppop) + trn(:,:,:,jpgop) + trn(:,:,:,jpdop) &466 & + ( tr n(:,:,:,jpzoo) + trn(:,:,:,jpmes) ) * po4rat3467 zwork(:,:,:) = tr(:,:,:,jppo4,Kmm) + tr(:,:,:,jppph,Kmm) & 468 & + tr(:,:,:,jppdi,Kmm) + tr(:,:,:,jpppi,Kmm) & 469 & + tr(:,:,:,jppop,Kmm) + tr(:,:,:,jpgop,Kmm) + tr(:,:,:,jpdop,Kmm) & 470 & + ( tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm) ) * po4rat3 467 471 ENDIF 468 472 ! … … 473 477 ! 474 478 IF( iom_use( "psiltot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN 475 zwork(:,:,:) = tr n(:,:,:,jpsil) + trn(:,:,:,jpgsi) + trn(:,:,:,jpdsi)479 zwork(:,:,:) = tr(:,:,:,jpsil,Kmm) + tr(:,:,:,jpgsi,Kmm) + tr(:,:,:,jpdsi,Kmm) 476 480 ! 477 481 silbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:) ) … … 481 485 ! 482 486 IF( iom_use( "palktot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN 483 zwork(:,:,:) = tr n(:,:,:,jpno3) * rno3 + trn(:,:,:,jptal) + trn(:,:,:,jpcal) * 2.487 zwork(:,:,:) = tr(:,:,:,jpno3,Kmm) * rno3 + tr(:,:,:,jptal,Kmm) + tr(:,:,:,jpcal,Kmm) * 2. 484 488 ! 485 489 alkbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:) ) ! … … 489 493 ! 490 494 IF( iom_use( "pfertot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN 491 zwork(:,:,:) = tr n(:,:,:,jpfer) + trn(:,:,:,jpnfe) + trn(:,:,:,jpdfe) &492 & + tr n(:,:,:,jpbfe) + trn(:,:,:,jpsfe) &493 & + ( tr n(:,:,:,jpzoo) + trn(:,:,:,jpmes) ) * ferat3495 zwork(:,:,:) = tr(:,:,:,jpfer,Kmm) + tr(:,:,:,jpnfe,Kmm) + tr(:,:,:,jpdfe,Kmm) & 496 & + tr(:,:,:,jpbfe,Kmm) + tr(:,:,:,jpsfe,Kmm) & 497 & + ( tr(:,:,:,jpzoo,Kmm) + tr(:,:,:,jpmes,Kmm) ) * ferat3 494 498 ! 495 499 ferbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:) )
Note: See TracChangeset
for help on using the changeset viewer.