Changeset 10975 for NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zsms.F90
- Timestamp:
- 2019-05-13T18:34:33+02:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zsms.F90
r10966 r10975 46 46 CONTAINS 47 47 48 SUBROUTINE p4z_sms( kt, Kbb, Kmm )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 index61 INTEGER, INTENT( in ) :: Kbb, Kmm 60 INTEGER, INTENT( in ) :: kt ! ocean time-step index 61 INTEGER, INTENT( in ) :: Kbb, Kmm, Krhs ! time level index 62 62 !! 63 63 INTEGER :: ji, jj, jk, jnt, jn, jl … … 73 73 ! 74 74 IF( .NOT. ln_rsttr ) THEN 75 CALL p4z_che 76 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 77 77 t_oce_co2_flx_cum = 0._wp 78 78 ELSE 79 CALL p4z_rst( nittrc000, 'READ' ) !* read or initialize all required fields79 CALL p4z_rst( nittrc000, Kbb, Kmm, 'READ' ) !* read or initialize all required fields 80 80 ENDIF 81 81 ! 82 82 ENDIF 83 83 ! 84 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 - nn_dttrc, nn_pisdmp ) == 0 ) CALL p4z_dmp( kt, Kbb, Kmm ) ! Relaxation of some tracers 85 85 ! 86 86 rfact = r2dttrc … … 99 99 IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN 100 100 DO jn = jp_pcs0, jp_pcs1 ! SMS on tracer without Asselin time-filter 101 tr b(:,:,:,jn) = trn(:,:,:,jn)101 tr(:,:,:,jn,Kbb) = tr(:,:,:,jn,Kmm) 102 102 END DO 103 103 ENDIF 104 104 ! 105 IF( ll_sbc ) CALL p4z_sbc( kt ) ! external sources of nutrients105 IF( ll_sbc ) CALL p4z_sbc( kt, Kmm ) ! external sources of nutrients 106 106 ! 107 107 #if ! defined key_sed_off 108 CALL p4z_che 109 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 110 110 ! 111 111 DO jnt = 1, nrdttrc ! Potential time splitting if requested 112 112 ! 113 CALL p4z_bio( kt, jnt, Kbb, Kmm ) ! Biology114 CALL p4z_lys( kt, jnt ) ! Compute CaCO3 saturation115 CALL p4z_sed( kt, jnt ) ! Surface and Bottom boundary conditions116 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 117 117 ! 118 118 xnegtr(:,:,:) = 1.e0 … … 121 121 DO jj = 1, jpj 122 122 DO ji = 1, jpi 123 IF( ( tr b(ji,jj,jk,jn) + tra(ji,jj,jk,jn) ) < 0.e0 ) THEN124 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 ) 125 125 xnegtr(ji,jj,jk) = MIN( xnegtr(ji,jj,jk), ztra ) 126 126 ENDIF … … 132 132 ! ! 133 133 DO jn = jp_pcs0, jp_pcs1 134 tr b(:,:,:,jn) = trb(:,:,:,jn) + xnegtr(:,:,:) * tra(:,:,:,jn)134 tr(:,:,:,jn,Kbb) = tr(:,:,:,jn,Kbb) + xnegtr(:,:,:) * tr(:,:,:,jn,Krhs) 135 135 END DO 136 136 ! 137 137 DO jn = jp_pcs0, jp_pcs1 138 tr a(:,:,:,jn) = 0._wp138 tr(:,:,:,jn,Krhs) = 0._wp 139 139 END DO 140 140 ! 141 141 IF( ln_top_euler ) THEN 142 142 DO jn = jp_pcs0, jp_pcs1 143 tr n(:,:,:,jn) = trb(:,:,:,jn)143 tr(:,:,:,jn,Kmm) = tr(:,:,:,jn,Kbb) 144 144 END DO 145 145 ENDIF … … 149 149 IF( l_trdtrc ) THEN 150 150 DO jn = jp_pcs0, jp_pcs1 151 CALL trd_trc( tr a(:,:,:,jn), jn, jptra_sms, kt, Kmm ) ! save trends151 CALL trd_trc( tr(:,:,:,jn,Krhs), jn, jptra_sms, kt, Kmm ) ! save trends 152 152 END DO 153 153 END IF … … 156 156 IF( ln_sediment ) THEN 157 157 ! 158 CALL sed_model( kt, K mm) ! Main program of Sediment model158 CALL sed_model( kt, Kbb, Kmm, Krhs ) ! Main program of Sediment model 159 159 ! 160 160 IF( ln_top_euler ) THEN 161 161 DO jn = jp_pcs0, jp_pcs1 162 tr n(:,:,:,jn) = trb(:,:,:,jn)162 tr(:,:,:,jn,Kmm) = tr(:,:,:,jn,Kbb) 163 163 END DO 164 164 ENDIF … … 166 166 ENDIF 167 167 ! 168 IF( lrst_trc ) CALL p4z_rst( kt, 'WRITE' )!* Write PISCES informations in restart file169 ! 170 171 IF( lk_iomput .OR. ln_check_mass ) CALL p4z_chk_mass( kt )! Mass conservation checking172 173 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 174 174 ! 175 175 IF( ln_timing ) CALL timing_stop('p4z_sms') … … 265 265 266 266 267 SUBROUTINE p4z_rst( kt, cdrw )267 SUBROUTINE p4z_rst( kt, Kbb, Kmm, cdrw ) 268 268 !!--------------------------------------------------------------------- 269 269 !! *** ROUTINE p4z_rst *** … … 276 276 !!--------------------------------------------------------------------- 277 277 INTEGER , INTENT(in) :: kt ! ocean time-step 278 INTEGER , INTENT(in) :: Kbb, Kmm ! time level indices 278 279 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 279 280 !!--------------------------------------------------------------------- … … 288 289 CALL iom_get( numrtr, jpdom_autoglo, 'PH' , hi(:,:,:) ) 289 290 ELSE 290 CALL p4z_che 291 CALL ahini_for_at( hi)291 CALL p4z_che( Kbb, Kmm ) ! initialize the chemical constants 292 CALL ahini_for_at( hi, Kbb ) 292 293 ENDIF 293 294 CALL iom_get( numrtr, jpdom_autoglo, 'Silicalim', xksi(:,:) ) … … 336 337 337 338 338 SUBROUTINE p4z_dmp( kt )339 SUBROUTINE p4z_dmp( kt, Kbb, Kmm ) 339 340 !!---------------------------------------------------------------------- 340 341 !! *** p4z_dmp *** … … 343 344 !!---------------------------------------------------------------------- 344 345 ! 345 INTEGER, INTENT( in ) :: kt ! time step 346 INTEGER, INTENT( in ) :: kt ! time step 347 INTEGER, INTENT( in ) :: Kbb, Kmm ! time level indices 346 348 ! 347 349 REAL(wp) :: alkmean = 2426. ! mean value of alkalinity ( Glodap ; for Goyet 2391. ) … … 364 366 zarea = 1._wp / glob_sum( 'p4zsms', cvol(:,:,:) ) * 1e6 365 367 366 zalksumn = glob_sum( 'p4zsms', tr n(:,:,:,jptal) * cvol(:,:,:) ) * zarea367 zpo4sumn = glob_sum( 'p4zsms', tr n(:,:,:,jppo4) * cvol(:,:,:) ) * zarea * po4r368 zno3sumn = glob_sum( 'p4zsms', tr n(:,:,:,jpno3) * cvol(:,:,:) ) * zarea * rno3369 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 370 372 371 373 IF(lwp) WRITE(numout,*) ' TALKN mean : ', zalksumn 372 tr n(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / zalksumn374 tr(:,:,:,jptal,Kmm) = tr(:,:,:,jptal,Kmm) * alkmean / zalksumn 373 375 374 376 IF(lwp) WRITE(numout,*) ' PO4N mean : ', zpo4sumn 375 tr n(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / zpo4sumn377 tr(:,:,:,jppo4,Kmm) = tr(:,:,:,jppo4,Kmm) * po4mean / zpo4sumn 376 378 377 379 IF(lwp) WRITE(numout,*) ' NO3N mean : ', zno3sumn 378 tr n(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / zno3sumn380 tr(:,:,:,jpno3,Kmm) = tr(:,:,:,jpno3,Kmm) * no3mean / zno3sumn 379 381 380 382 IF(lwp) WRITE(numout,*) ' SiO3N mean : ', zsilsumn 381 tr n(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * silmean / zsilsumn )383 tr(:,:,:,jpsil,Kmm) = MIN( 400.e-6,tr(:,:,:,jpsil,Kmm) * silmean / zsilsumn ) 382 384 ! 383 385 ! 384 386 IF( .NOT. ln_top_euler ) THEN 385 zalksumb = glob_sum( 'p4zsms', tr b(:,:,:,jptal) * cvol(:,:,:) ) * zarea386 zpo4sumb = glob_sum( 'p4zsms', tr b(:,:,:,jppo4) * cvol(:,:,:) ) * zarea * po4r387 zno3sumb = glob_sum( 'p4zsms', tr b(:,:,:,jpno3) * cvol(:,:,:) ) * zarea * rno3388 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 389 391 390 392 IF(lwp) WRITE(numout,*) ' ' 391 393 IF(lwp) WRITE(numout,*) ' TALKB mean : ', zalksumb 392 tr b(:,:,:,jptal) = trb(:,:,:,jptal) * alkmean / zalksumb394 tr(:,:,:,jptal,Kbb) = tr(:,:,:,jptal,Kbb) * alkmean / zalksumb 393 395 394 396 IF(lwp) WRITE(numout,*) ' PO4B mean : ', zpo4sumb 395 tr b(:,:,:,jppo4) = trb(:,:,:,jppo4) * po4mean / zpo4sumb397 tr(:,:,:,jppo4,Kbb) = tr(:,:,:,jppo4,Kbb) * po4mean / zpo4sumb 396 398 397 399 IF(lwp) WRITE(numout,*) ' NO3B mean : ', zno3sumb 398 tr b(:,:,:,jpno3) = trb(:,:,:,jpno3) * no3mean / zno3sumb400 tr(:,:,:,jpno3,Kbb) = tr(:,:,:,jpno3,Kbb) * no3mean / zno3sumb 399 401 400 402 IF(lwp) WRITE(numout,*) ' SiO3B mean : ', zsilsumb 401 tr b(:,:,:,jpsil) = MIN( 400.e-6,trb(:,:,:,jpsil) * silmean / zsilsumb )403 tr(:,:,:,jpsil,Kbb) = MIN( 400.e-6,tr(:,:,:,jpsil,Kbb) * silmean / zsilsumb ) 402 404 ENDIF 403 405 ENDIF … … 408 410 409 411 410 SUBROUTINE p4z_chk_mass( kt )412 SUBROUTINE p4z_chk_mass( kt, Kmm ) 411 413 !!---------------------------------------------------------------------- 412 414 !! *** ROUTINE p4z_chk_mass *** … … 416 418 !!--------------------------------------------------------------------- 417 419 INTEGER, INTENT( in ) :: kt ! ocean time-step index 420 INTEGER, INTENT( in ) :: Kmm ! time level indices 418 421 REAL(wp) :: zrdenittot, zsdenittot, znitrpottot 419 422 CHARACTER(LEN=100) :: cltxt … … 439 442 ! Compute the budget of NO3, ALK, Si, Fer 440 443 IF( ln_p4z ) THEN 441 zwork(:,:,:) = tr n(:,:,:,jpno3) + trn(:,:,:,jpnh4) &442 & + tr n(:,:,:,jpphy) + trn(:,:,:,jpdia) &443 & + tr n(:,:,:,jppoc) + trn(:,:,:,jpgoc) + trn(:,:,:,jpdoc) &444 & + 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) 445 448 ELSE 446 zwork(:,:,:) = tr n(:,:,:,jpno3) + trn(:,:,:,jpnh4) + trn(:,:,:,jpnph) &447 & + tr n(:,:,:,jpndi) + trn(:,:,:,jpnpi) &448 & + tr n(:,:,:,jppon) + trn(:,:,:,jpgon) + trn(:,:,:,jpdon) &449 & + ( 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 450 453 ENDIF 451 454 ! … … 457 460 IF( iom_use( "ppo4tot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN 458 461 IF( ln_p4z ) THEN 459 zwork(:,:,:) = tr n(:,:,:,jppo4) &460 & + tr n(:,:,:,jpphy) + trn(:,:,:,jpdia) &461 & + tr n(:,:,:,jppoc) + trn(:,:,:,jpgoc) + trn(:,:,:,jpdoc) &462 & + 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) 463 466 ELSE 464 zwork(:,:,:) = tr n(:,:,:,jppo4) + trn(:,:,:,jppph) &465 & + tr n(:,:,:,jppdi) + trn(:,:,:,jpppi) &466 & + tr n(:,:,:,jppop) + trn(:,:,:,jpgop) + trn(:,:,:,jpdop) &467 & + ( 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 468 471 ENDIF 469 472 ! … … 474 477 ! 475 478 IF( iom_use( "psiltot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN 476 zwork(:,:,:) = tr n(:,:,:,jpsil) + trn(:,:,:,jpgsi) + trn(:,:,:,jpdsi)479 zwork(:,:,:) = tr(:,:,:,jpsil,Kmm) + tr(:,:,:,jpgsi,Kmm) + tr(:,:,:,jpdsi,Kmm) 477 480 ! 478 481 silbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:) ) … … 482 485 ! 483 486 IF( iom_use( "palktot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN 484 zwork(:,:,:) = tr n(:,:,:,jpno3) * rno3 + trn(:,:,:,jptal) + trn(:,:,:,jpcal) * 2.487 zwork(:,:,:) = tr(:,:,:,jpno3,Kmm) * rno3 + tr(:,:,:,jptal,Kmm) + tr(:,:,:,jpcal,Kmm) * 2. 485 488 ! 486 489 alkbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:) ) ! … … 490 493 ! 491 494 IF( iom_use( "pfertot" ) .OR. ( ln_check_mass .AND. kt == nitend ) ) THEN 492 zwork(:,:,:) = tr n(:,:,:,jpfer) + trn(:,:,:,jpnfe) + trn(:,:,:,jpdfe) &493 & + tr n(:,:,:,jpbfe) + trn(:,:,:,jpsfe) &494 & + ( 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 495 498 ! 496 499 ferbudget = glob_sum( 'p4zsms', zwork(:,:,:) * cvol(:,:,:) )
Note: See TracChangeset
for help on using the changeset viewer.