Changeset 10975 for NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zche.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/p4zche.F90
r10425 r10975 137 137 CONTAINS 138 138 139 SUBROUTINE p4z_che 139 SUBROUTINE p4z_che( Kbb, Kmm ) 140 140 !!--------------------------------------------------------------------- 141 141 !! *** ROUTINE p4z_che *** … … 145 145 !! ** Method : - ... 146 146 !!--------------------------------------------------------------------- 147 INTEGER, INTENT(in) :: Kbb, Kmm ! time level indices 147 148 INTEGER :: ji, jj, jk 148 149 REAL(wp) :: ztkel, ztkel1, zt , zsal , zsal2 , zbuf1 , zbuf2 … … 164 165 ! ------------------------------------------------------------- 165 166 IF (neos == -1) THEN 166 salinprac(:,:,:) = ts n(:,:,:,jp_sal) * 35.0 / 35.16504167 salinprac(:,:,:) = ts(:,:,:,jp_sal,Kmm) * 35.0 / 35.16504 167 168 ELSE 168 salinprac(:,:,:) = ts n(:,:,:,jp_sal)169 salinprac(:,:,:) = ts(:,:,:,jp_sal,Kmm) 169 170 ENDIF 170 171 … … 178 179 DO jj = 1, jpj 179 180 DO ji = 1, jpi 180 zpres = gdept _n(ji,jj,jk) / 1000.181 za1 = 0.04 * ( 1.0 + 0.185 * ts n(ji,jj,jk,jp_tem) + 0.035 * (salinprac(ji,jj,jk) - 35.0) )182 za2 = 0.0075 * ( 1.0 - ts n(ji,jj,jk,jp_tem) / 30.0 )183 tempis(ji,jj,jk) = ts n(ji,jj,jk,jp_tem) - za1 * zpres + za2 * zpres**2181 zpres = gdept(ji,jj,jk,Kmm) / 1000. 182 za1 = 0.04 * ( 1.0 + 0.185 * ts(ji,jj,jk,jp_tem,Kmm) + 0.035 * (salinprac(ji,jj,jk) - 35.0) ) 183 za2 = 0.0075 * ( 1.0 - ts(ji,jj,jk,jp_tem,Kmm) / 30.0 ) 184 tempis(ji,jj,jk) = ts(ji,jj,jk,jp_tem,Kmm) - za1 * zpres + za2 * zpres**2 184 185 END DO 185 186 END DO … … 245 246 zplat = SIN ( ABS(gphit(ji,jj)*3.141592654/180.) ) 246 247 zc1 = 5.92E-3 + zplat**2 * 5.25E-3 247 zpres = ((1-zc1)-SQRT(((1-zc1)**2)-(8.84E-6*gdept _n(ji,jj,jk)))) / 4.42E-6248 zpres = ((1-zc1)-SQRT(((1-zc1)**2)-(8.84E-6*gdept(ji,jj,jk,Kmm)))) / 4.42E-6 248 249 zpres = zpres / 10.0 249 250 … … 448 449 END SUBROUTINE p4z_che 449 450 450 SUBROUTINE ahini_for_at(p_hini )451 SUBROUTINE ahini_for_at(p_hini, Kbb ) 451 452 !!--------------------------------------------------------------------- 452 453 !! *** ROUTINE ahini_for_at *** … … 462 463 !!--------------------------------------------------------------------- 463 464 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_hini 465 INTEGER, INTENT(in) :: Kbb ! time level indices 464 466 INTEGER :: ji, jj, jk 465 467 REAL(wp) :: zca1, zba1 … … 474 476 DO jj = 1, jpj 475 477 DO ji = 1, jpi 476 p_alkcb = tr b(ji,jj,jk,jptal) * 1000. / (rhop(ji,jj,jk) + rtrn)477 p_dictot = tr b(ji,jj,jk,jpdic) * 1000. / (rhop(ji,jj,jk) + rtrn)478 p_alkcb = tr(ji,jj,jk,jptal,Kbb) * 1000. / (rhop(ji,jj,jk) + rtrn) 479 p_dictot = tr(ji,jj,jk,jpdic,Kbb) * 1000. / (rhop(ji,jj,jk) + rtrn) 478 480 p_bortot = borat(ji,jj,jk) 479 481 IF (p_alkcb <= 0.) THEN … … 516 518 !=============================================================================== 517 519 518 SUBROUTINE anw_infsup( p_alknw_inf, p_alknw_sup )520 SUBROUTINE anw_infsup( p_alknw_inf, p_alknw_sup, Kbb ) 519 521 520 522 ! Subroutine returns the lower and upper bounds of "non-water-selfionization" … … 525 527 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_alknw_inf 526 528 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_alknw_sup 527 528 p_alknw_inf(:,:,:) = -trb(:,:,:,jppo4) * 1000. / (rhop(:,:,:) + rtrn) - sulfat(:,:,:) & 529 INTEGER, INTENT(in) :: Kbb ! time level indices 530 531 p_alknw_inf(:,:,:) = -tr(:,:,:,jppo4,Kbb) * 1000. / (rhop(:,:,:) + rtrn) - sulfat(:,:,:) & 529 532 & - fluorid(:,:,:) 530 p_alknw_sup(:,:,:) = (2. * tr b(:,:,:,jpdic) + 2. * trb(:,:,:,jppo4) + trb(:,:,:,jpsil) ) &533 p_alknw_sup(:,:,:) = (2. * tr(:,:,:,jpdic,Kbb) + 2. * tr(:,:,:,jppo4,Kbb) + tr(:,:,:,jpsil,Kbb) ) & 531 534 & * 1000. / (rhop(:,:,:) + rtrn) + borat(:,:,:) 532 535 … … 534 537 535 538 536 SUBROUTINE solve_at_general( p_hini, zhi )539 SUBROUTINE solve_at_general( p_hini, zhi, Kbb ) 537 540 538 541 ! Universal pH solver that converges from any given initial value, … … 543 546 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(IN) :: p_hini 544 547 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: zhi 548 INTEGER, INTENT(in) :: Kbb ! time level indices 545 549 546 550 ! Local variables … … 565 569 IF( ln_timing ) CALL timing_start('solve_at_general') 566 570 567 CALL anw_infsup( zalknw_inf, zalknw_sup )571 CALL anw_infsup( zalknw_inf, zalknw_sup, Kbb ) 568 572 569 573 rmask(:,:,:) = tmask(:,:,:) … … 575 579 DO ji = 1, jpi 576 580 IF (rmask(ji,jj,jk) == 1.) THEN 577 p_alktot = tr b(ji,jj,jk,jptal) * 1000. / (rhop(ji,jj,jk) + rtrn)581 p_alktot = tr(ji,jj,jk,jptal,Kbb) * 1000. / (rhop(ji,jj,jk) + rtrn) 578 582 aphscale = 1. + sulfat(ji,jj,jk)/aks3(ji,jj,jk) 579 583 zh_ini = p_hini(ji,jj,jk) … … 609 613 IF (rmask(ji,jj,jk) == 1.) THEN 610 614 zfact = rhop(ji,jj,jk) / 1000. + rtrn 611 p_alktot = tr b(ji,jj,jk,jptal) / zfact612 zdic = tr b(ji,jj,jk,jpdic) / zfact615 p_alktot = tr(ji,jj,jk,jptal,Kbb) / zfact 616 zdic = tr(ji,jj,jk,jpdic,Kbb) / zfact 613 617 zbot = borat(ji,jj,jk) 614 zpt = tr b(ji,jj,jk,jppo4) / zfact * po4r615 zsit = tr b(ji,jj,jk,jpsil) / zfact618 zpt = tr(ji,jj,jk,jppo4,Kbb) / zfact * po4r 619 zsit = tr(ji,jj,jk,jpsil,Kbb) / zfact 616 620 zst = sulfat (ji,jj,jk) 617 621 zft = fluorid(ji,jj,jk)
Note: See TracChangeset
for help on using the changeset viewer.