New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 12377 for NEMO/trunk/src/TOP/PISCES/P4Z/p4zche.F90 – NEMO

Ignore:
Timestamp:
2020-02-12T15:39:06+01:00 (4 years ago)
Author:
acc
Message:

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

​svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
​svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

Location:
NEMO/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/trunk

    • Property svn:externals

      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         5^/vendors/AGRIF/dev_r11615_ENHANCE-04_namelists_as_internalfiles_agrif@HEAD      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 

  • NEMO/trunk/src/TOP/PISCES/P4Z/p4zche.F90

    r10425 r12377  
    130130   INTEGER :: niter_atgen    = jp_maxniter_atgen 
    131131 
     132   !! * Substitutions 
     133#  include "do_loop_substitute.h90" 
    132134   !!---------------------------------------------------------------------- 
    133135   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
    … …  
    137139CONTAINS 
    138140 
    139    SUBROUTINE p4z_che 
     141   SUBROUTINE p4z_che( Kbb, Kmm ) 
    140142      !!--------------------------------------------------------------------- 
    141143      !!                     ***  ROUTINE p4z_che  *** 
    … …  
    145147      !! ** Method  : - ... 
    146148      !!--------------------------------------------------------------------- 
     149      INTEGER, INTENT(in) ::   Kbb, Kmm  ! time level indices 
    147150      INTEGER  ::   ji, jj, jk 
    148151      REAL(wp) ::   ztkel, ztkel1, zt , zsal  , zsal2 , zbuf1 , zbuf2 
    … …  
    164167      ! ------------------------------------------------------------- 
    165168      IF (neos == -1) THEN 
    166          salinprac(:,:,:) = tsn(:,:,:,jp_sal) * 35.0 / 35.16504 
     169         salinprac(:,:,:) = ts(:,:,:,jp_sal,Kmm) * 35.0 / 35.16504 
    167170      ELSE 
    168          salinprac(:,:,:) = tsn(:,:,:,jp_sal) 
     171         salinprac(:,:,:) = ts(:,:,:,jp_sal,Kmm) 
    169172      ENDIF 
    170173 
    … …  
    175178      ! 0.04°C relative to an exact computation 
    176179      ! --------------------------------------------------------------------- 
    177       DO jk = 1, jpk 
    178          DO jj = 1, jpj 
    179             DO ji = 1, jpi 
    180                zpres = gdept_n(ji,jj,jk) / 1000. 
    181                za1 = 0.04 * ( 1.0 + 0.185 * tsn(ji,jj,jk,jp_tem) + 0.035 * (salinprac(ji,jj,jk) - 35.0) ) 
    182                za2 = 0.0075 * ( 1.0 - tsn(ji,jj,jk,jp_tem) / 30.0 ) 
    183                tempis(ji,jj,jk) = tsn(ji,jj,jk,jp_tem) - za1 * zpres + za2 * zpres**2 
    184             END DO 
    185          END DO 
    186       END DO 
     180      DO_3D_11_11( 1, jpk ) 
     181         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 
     185      END_3D 
    187186      ! 
    188187      ! CHEMICAL CONSTANTS - SURFACE LAYER 
    … …  
    245244               zplat   = SIN ( ABS(gphit(ji,jj)*3.141592654/180.) ) 
    246245               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-6 
     246               zpres = ((1-zc1)-SQRT(((1-zc1)**2)-(8.84E-6*gdept(ji,jj,jk,Kmm)))) / 4.42E-6 
    248247               zpres = zpres / 10.0 
    249248 
    … …  
    448447   END SUBROUTINE p4z_che 
    449448 
    450    SUBROUTINE ahini_for_at(p_hini) 
     449   SUBROUTINE ahini_for_at(p_hini, Kbb ) 
    451450      !!--------------------------------------------------------------------- 
    452451      !!                     ***  ROUTINE ahini_for_at  *** 
    … …  
    462461      !!--------------------------------------------------------------------- 
    463462      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT)  ::  p_hini 
     463      INTEGER,                          INTENT(in)   ::  Kbb      ! time level indices 
    464464      INTEGER  ::   ji, jj, jk 
    465465      REAL(wp)  ::  zca1, zba1 
    … …  
    471471      IF( ln_timing )  CALL timing_start('ahini_for_at') 
    472472      ! 
    473       DO jk = 1, jpk 
    474         DO jj = 1, jpj 
    475           DO ji = 1, jpi 
    476             p_alkcb  = trb(ji,jj,jk,jptal) * 1000. / (rhop(ji,jj,jk) + rtrn) 
    477             p_dictot = trb(ji,jj,jk,jpdic) * 1000. / (rhop(ji,jj,jk) + rtrn) 
    478             p_bortot = borat(ji,jj,jk) 
    479             IF (p_alkcb <= 0.) THEN 
    480                 p_hini(ji,jj,jk) = 1.e-3 
    481             ELSEIF (p_alkcb >= (2.*p_dictot + p_bortot)) THEN 
    482                 p_hini(ji,jj,jk) = 1.e-10_wp 
     473      DO_3D_11_11( 1, jpk ) 
     474      p_alkcb  = tr(ji,jj,jk,jptal,Kbb) * 1000. / (rhop(ji,jj,jk) + rtrn) 
     475      p_dictot = tr(ji,jj,jk,jpdic,Kbb) * 1000. / (rhop(ji,jj,jk) + rtrn) 
     476      p_bortot = borat(ji,jj,jk) 
     477      IF (p_alkcb <= 0.) THEN 
     478          p_hini(ji,jj,jk) = 1.e-3 
     479      ELSEIF (p_alkcb >= (2.*p_dictot + p_bortot)) THEN 
     480          p_hini(ji,jj,jk) = 1.e-10_wp 
     481      ELSE 
     482          zca1 = p_dictot/( p_alkcb + rtrn ) 
     483          zba1 = p_bortot/ (p_alkcb + rtrn ) 
     484     ! Coefficients of the cubic polynomial 
     485          za2 = aKb3(ji,jj,jk)*(1. - zba1) + ak13(ji,jj,jk)*(1.-zca1) 
     486          za1 = ak13(ji,jj,jk)*akb3(ji,jj,jk)*(1. - zba1 - zca1)    & 
     487          &     + ak13(ji,jj,jk)*ak23(ji,jj,jk)*(1. - (zca1+zca1)) 
     488          za0 = ak13(ji,jj,jk)*ak23(ji,jj,jk)*akb3(ji,jj,jk)*(1. - zba1 - (zca1+zca1)) 
     489                                  ! Taylor expansion around the minimum 
     490          zd = za2*za2 - 3.*za1   ! Discriminant of the quadratic equation 
     491                                  ! for the minimum close to the root 
     492 
     493          IF(zd > 0.) THEN        ! If the discriminant is positive 
     494            zsqrtd = SQRT(zd) 
     495            IF(za2 < 0) THEN 
     496              zhmin = (-za2 + zsqrtd)/3. 
    483497            ELSE 
    484                 zca1 = p_dictot/( p_alkcb + rtrn ) 
    485                 zba1 = p_bortot/ (p_alkcb + rtrn ) 
    486            ! Coefficients of the cubic polynomial 
    487                 za2 = aKb3(ji,jj,jk)*(1. - zba1) + ak13(ji,jj,jk)*(1.-zca1) 
    488                 za1 = ak13(ji,jj,jk)*akb3(ji,jj,jk)*(1. - zba1 - zca1)    & 
    489                 &     + ak13(ji,jj,jk)*ak23(ji,jj,jk)*(1. - (zca1+zca1)) 
    490                 za0 = ak13(ji,jj,jk)*ak23(ji,jj,jk)*akb3(ji,jj,jk)*(1. - zba1 - (zca1+zca1)) 
    491                                         ! Taylor expansion around the minimum 
    492                 zd = za2*za2 - 3.*za1   ! Discriminant of the quadratic equation 
    493                                         ! for the minimum close to the root 
    494  
    495                 IF(zd > 0.) THEN        ! If the discriminant is positive 
    496                   zsqrtd = SQRT(zd) 
    497                   IF(za2 < 0) THEN 
    498                     zhmin = (-za2 + zsqrtd)/3. 
    499                   ELSE 
    500                     zhmin = -za1/(za2 + zsqrtd) 
    501                   ENDIF 
    502                   p_hini(ji,jj,jk) = zhmin + SQRT(-(za0 + zhmin*(za1 + zhmin*(za2 + zhmin)))/zsqrtd) 
    503                 ELSE 
    504                   p_hini(ji,jj,jk) = 1.e-7 
    505                 ENDIF 
    506              ! 
    507              ENDIF 
    508           END DO 
    509         END DO 
    510       END DO 
     498              zhmin = -za1/(za2 + zsqrtd) 
     499            ENDIF 
     500            p_hini(ji,jj,jk) = zhmin + SQRT(-(za0 + zhmin*(za1 + zhmin*(za2 + zhmin)))/zsqrtd) 
     501          ELSE 
     502            p_hini(ji,jj,jk) = 1.e-7 
     503          ENDIF 
     504       ! 
     505       ENDIF 
     506      END_3D 
    511507      ! 
    512508      IF( ln_timing )  CALL timing_stop('ahini_for_at') 
    … …  
    516512   !=============================================================================== 
    517513 
    518    SUBROUTINE anw_infsup( p_alknw_inf, p_alknw_sup ) 
     514   SUBROUTINE anw_infsup( p_alknw_inf, p_alknw_sup, Kbb ) 
    519515 
    520516   ! Subroutine returns the lower and upper bounds of "non-water-selfionization" 
    … …  
    525521   REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_alknw_inf 
    526522   REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_alknw_sup 
    527  
    528    p_alknw_inf(:,:,:) =  -trb(:,:,:,jppo4) * 1000. / (rhop(:,:,:) + rtrn) - sulfat(:,:,:)  & 
     523   INTEGER,                          INTENT(in)  ::  Kbb      ! time level indices 
     524 
     525   p_alknw_inf(:,:,:) =  -tr(:,:,:,jppo4,Kbb) * 1000. / (rhop(:,:,:) + rtrn) - sulfat(:,:,:)  & 
    529526   &              - fluorid(:,:,:) 
    530    p_alknw_sup(:,:,:) =   (2. * trb(:,:,:,jpdic) + 2. * trb(:,:,:,jppo4) + trb(:,:,:,jpsil) )    & 
     527   p_alknw_sup(:,:,:) =   (2. * tr(:,:,:,jpdic,Kbb) + 2. * tr(:,:,:,jppo4,Kbb) + tr(:,:,:,jpsil,Kbb) )    & 
    531528   &               * 1000. / (rhop(:,:,:) + rtrn) + borat(:,:,:)  
    532529 
    … …  
    534531 
    535532 
    536    SUBROUTINE solve_at_general( p_hini, zhi ) 
     533   SUBROUTINE solve_at_general( p_hini, zhi, Kbb ) 
    537534 
    538535   ! Universal pH solver that converges from any given initial value, 
    … …  
    543540   REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(IN)   :: p_hini 
    544541   REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT)  :: zhi 
     542   INTEGER,                          INTENT(in)   :: Kbb  ! time level indices 
    545543 
    546544   ! Local variables 
    … …  
    565563   IF( ln_timing )  CALL timing_start('solve_at_general') 
    566564 
    567    CALL anw_infsup( zalknw_inf, zalknw_sup ) 
     565   CALL anw_infsup( zalknw_inf, zalknw_sup, Kbb ) 
    568566 
    569567   rmask(:,:,:) = tmask(:,:,:) 
    … …  
    571569 
    572570   ! TOTAL H+ scale: conversion factor for Htot = aphscale * Hfree 
    573    DO jk = 1, jpk 
    574       DO jj = 1, jpj 
    575          DO ji = 1, jpi 
    576             IF (rmask(ji,jj,jk) == 1.) THEN 
    577                p_alktot = trb(ji,jj,jk,jptal) * 1000. / (rhop(ji,jj,jk) + rtrn) 
    578                aphscale = 1. + sulfat(ji,jj,jk)/aks3(ji,jj,jk) 
    579                zh_ini = p_hini(ji,jj,jk) 
    580  
    581                zdelta = (p_alktot-zalknw_inf(ji,jj,jk))**2 + 4.*akw3(ji,jj,jk)/aphscale 
    582  
    583                IF(p_alktot >= zalknw_inf(ji,jj,jk)) THEN 
    584                  zh_min(ji,jj,jk) = 2.*akw3(ji,jj,jk) /( p_alktot-zalknw_inf(ji,jj,jk) + SQRT(zdelta) ) 
    585                ELSE 
    586                  zh_min(ji,jj,jk) = aphscale*(-(p_alktot-zalknw_inf(ji,jj,jk)) + SQRT(zdelta) ) / 2. 
    587                ENDIF 
    588  
    589                zdelta = (p_alktot-zalknw_sup(ji,jj,jk))**2 + 4.*akw3(ji,jj,jk)/aphscale 
    590  
    591                IF(p_alktot <= zalknw_sup(ji,jj,jk)) THEN 
    592                  zh_max(ji,jj,jk) = aphscale*(-(p_alktot-zalknw_sup(ji,jj,jk)) + SQRT(zdelta) ) / 2. 
    593                ELSE 
    594                  zh_max(ji,jj,jk) = 2.*akw3(ji,jj,jk) /( p_alktot-zalknw_sup(ji,jj,jk) + SQRT(zdelta) ) 
    595                ENDIF 
    596  
    597                zhi(ji,jj,jk) = MAX(MIN(zh_max(ji,jj,jk), zh_ini), zh_min(ji,jj,jk)) 
     571   DO_3D_11_11( 1, jpk ) 
     572      IF (rmask(ji,jj,jk) == 1.) THEN 
     573         p_alktot = tr(ji,jj,jk,jptal,Kbb) * 1000. / (rhop(ji,jj,jk) + rtrn) 
     574         aphscale = 1. + sulfat(ji,jj,jk)/aks3(ji,jj,jk) 
     575         zh_ini = p_hini(ji,jj,jk) 
     576 
     577         zdelta = (p_alktot-zalknw_inf(ji,jj,jk))**2 + 4.*akw3(ji,jj,jk)/aphscale 
     578 
     579         IF(p_alktot >= zalknw_inf(ji,jj,jk)) THEN 
     580           zh_min(ji,jj,jk) = 2.*akw3(ji,jj,jk) /( p_alktot-zalknw_inf(ji,jj,jk) + SQRT(zdelta) ) 
     581         ELSE 
     582           zh_min(ji,jj,jk) = aphscale*(-(p_alktot-zalknw_inf(ji,jj,jk)) + SQRT(zdelta) ) / 2. 
     583         ENDIF 
     584 
     585         zdelta = (p_alktot-zalknw_sup(ji,jj,jk))**2 + 4.*akw3(ji,jj,jk)/aphscale 
     586 
     587         IF(p_alktot <= zalknw_sup(ji,jj,jk)) THEN 
     588           zh_max(ji,jj,jk) = aphscale*(-(p_alktot-zalknw_sup(ji,jj,jk)) + SQRT(zdelta) ) / 2. 
     589         ELSE 
     590           zh_max(ji,jj,jk) = 2.*akw3(ji,jj,jk) /( p_alktot-zalknw_sup(ji,jj,jk) + SQRT(zdelta) ) 
     591         ENDIF 
     592 
     593         zhi(ji,jj,jk) = MAX(MIN(zh_max(ji,jj,jk), zh_ini), zh_min(ji,jj,jk)) 
     594      ENDIF 
     595   END_3D 
     596 
     597   zeqn_absmin(:,:,:) = HUGE(1._wp) 
     598 
     599   DO jn = 1, jp_maxniter_atgen  
     600   DO_3D_11_11( 1, jpk ) 
     601      IF (rmask(ji,jj,jk) == 1.) THEN 
     602         zfact = rhop(ji,jj,jk) / 1000. + rtrn 
     603         p_alktot = tr(ji,jj,jk,jptal,Kbb) / zfact 
     604         zdic  = tr(ji,jj,jk,jpdic,Kbb) / zfact 
     605         zbot  = borat(ji,jj,jk) 
     606         zpt = tr(ji,jj,jk,jppo4,Kbb) / zfact * po4r 
     607         zsit = tr(ji,jj,jk,jpsil,Kbb) / zfact 
     608         zst = sulfat (ji,jj,jk) 
     609         zft = fluorid(ji,jj,jk) 
     610         aphscale = 1. + sulfat(ji,jj,jk)/aks3(ji,jj,jk) 
     611         zh = zhi(ji,jj,jk) 
     612         zh_prev = zh 
     613 
     614         ! H2CO3 - HCO3 - CO3 : n=2, m=0 
     615         znumer_dic = 2.*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*ak13(ji,jj,jk) 
     616         zdenom_dic = ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*(ak13(ji,jj,jk) + zh) 
     617         zalk_dic   = zdic * (znumer_dic/zdenom_dic) 
     618         zdnumer_dic = ak13(ji,jj,jk)*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh     & 
     619                       *(4.*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*ak13(ji,jj,jk)) 
     620         zdalk_dic   = -zdic*(zdnumer_dic/zdenom_dic**2) 
     621 
     622 
     623         ! B(OH)3 - B(OH)4 : n=1, m=0 
     624         znumer_bor = akb3(ji,jj,jk) 
     625         zdenom_bor = akb3(ji,jj,jk) + zh 
     626         zalk_bor   = zbot * (znumer_bor/zdenom_bor) 
     627         zdnumer_bor = akb3(ji,jj,jk) 
     628         zdalk_bor   = -zbot*(zdnumer_bor/zdenom_bor**2) 
     629 
     630 
     631         ! H3PO4 - H2PO4 - HPO4 - PO4 : n=3, m=1 
     632         znumer_po4 = 3.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)  & 
     633         &            + zh*(2.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh* ak1p3(ji,jj,jk)) 
     634         zdenom_po4 = ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)     & 
     635         &            + zh*( ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh*(ak1p3(ji,jj,jk) + zh)) 
     636         zalk_po4   = zpt * (znumer_po4/zdenom_po4 - 1.) ! Zero level of H3PO4 = 1 
     637         zdnumer_po4 = ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)  & 
     638         &             + zh*(4.*ak1p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)         & 
     639         &             + zh*(9.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)                         & 
     640         &             + ak1p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)                                & 
     641         &             + zh*(4.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh * ak1p3(ji,jj,jk) ) ) ) 
     642         zdalk_po4   = -zpt * (zdnumer_po4/zdenom_po4**2) 
     643 
     644         ! H4SiO4 - H3SiO4 : n=1, m=0 
     645         znumer_sil = aksi3(ji,jj,jk) 
     646         zdenom_sil = aksi3(ji,jj,jk) + zh 
     647         zalk_sil   = zsit * (znumer_sil/zdenom_sil) 
     648         zdnumer_sil = aksi3(ji,jj,jk) 
     649         zdalk_sil   = -zsit * (zdnumer_sil/zdenom_sil**2) 
     650 
     651         ! HSO4 - SO4 : n=1, m=1 
     652         aphscale = 1.0 + zst/aks3(ji,jj,jk) 
     653         znumer_so4 = aks3(ji,jj,jk) * aphscale 
     654         zdenom_so4 = aks3(ji,jj,jk) * aphscale + zh 
     655         zalk_so4   = zst * (znumer_so4/zdenom_so4 - 1.) 
     656         zdnumer_so4 = aks3(ji,jj,jk) 
     657         zdalk_so4   = -zst * (zdnumer_so4/zdenom_so4**2) 
     658 
     659         ! HF - F : n=1, m=1 
     660         znumer_flu =  akf3(ji,jj,jk) 
     661         zdenom_flu =  akf3(ji,jj,jk) + zh 
     662         zalk_flu   =  zft * (znumer_flu/zdenom_flu - 1.) 
     663         zdnumer_flu = akf3(ji,jj,jk) 
     664         zdalk_flu   = -zft * (zdnumer_flu/zdenom_flu**2) 
     665 
     666         ! H2O - OH 
     667         aphscale = 1.0 + zst/aks3(ji,jj,jk) 
     668         zalk_wat   = akw3(ji,jj,jk)/zh - zh/aphscale 
     669         zdalk_wat  = -akw3(ji,jj,jk)/zh**2 - 1./aphscale 
     670 
     671         ! CALCULATE [ALK]([CO3--], [HCO3-]) 
     672         zeqn = zalk_dic + zalk_bor + zalk_po4 + zalk_sil   & 
     673         &      + zalk_so4 + zalk_flu                       & 
     674         &      + zalk_wat - p_alktot 
     675 
     676         zalka = p_alktot - (zalk_bor + zalk_po4 + zalk_sil   & 
     677         &       + zalk_so4 + zalk_flu + zalk_wat) 
     678 
     679         zdeqndh = zdalk_dic + zdalk_bor + zdalk_po4 + zdalk_sil & 
     680         &         + zdalk_so4 + zdalk_flu + zdalk_wat 
     681 
     682         ! Adapt bracketing interval 
     683         IF(zeqn > 0._wp) THEN 
     684           zh_min(ji,jj,jk) = zh_prev 
     685         ELSEIF(zeqn < 0._wp) THEN 
     686           zh_max(ji,jj,jk) = zh_prev 
     687         ENDIF 
     688 
     689         IF(ABS(zeqn) >= 0.5_wp*zeqn_absmin(ji,jj,jk)) THEN 
     690         ! if the function evaluation at the current point is 
     691         ! not decreasing faster than with a bisection step (at least linearly) 
     692         ! in absolute value take one bisection step on [ph_min, ph_max] 
     693         ! ph_new = (ph_min + ph_max)/2d0 
     694         ! 
     695         ! In terms of [H]_new: 
     696         ! [H]_new = 10**(-ph_new) 
     697         !         = 10**(-(ph_min + ph_max)/2d0) 
     698         !         = SQRT(10**(-(ph_min + phmax))) 
     699         !         = SQRT(zh_max * zh_min) 
     700            zh = SQRT(zh_max(ji,jj,jk) * zh_min(ji,jj,jk)) 
     701            zh_lnfactor = (zh - zh_prev)/zh_prev ! Required to test convergence below 
     702         ELSE 
     703         ! dzeqn/dpH = dzeqn/d[H] * d[H]/dpH 
     704         !           = -zdeqndh * LOG(10) * [H] 
     705         ! \Delta pH = -zeqn/(zdeqndh*d[H]/dpH) = zeqn/(zdeqndh*[H]*LOG(10)) 
     706         ! 
     707         ! pH_new = pH_old + \deltapH 
     708         ! 
     709         ! [H]_new = 10**(-pH_new) 
     710         !         = 10**(-pH_old - \Delta pH) 
     711         !         = [H]_old * 10**(-zeqn/(zdeqndh*[H]_old*LOG(10))) 
     712         !         = [H]_old * EXP(-LOG(10)*zeqn/(zdeqndh*[H]_old*LOG(10))) 
     713         !         = [H]_old * EXP(-zeqn/(zdeqndh*[H]_old)) 
     714 
     715            zh_lnfactor = -zeqn/(zdeqndh*zh_prev) 
     716 
     717            IF(ABS(zh_lnfactor) > pz_exp_threshold) THEN 
     718               zh          = zh_prev*EXP(zh_lnfactor) 
     719            ELSE 
     720               zh_delta    = zh_lnfactor*zh_prev 
     721               zh          = zh_prev + zh_delta 
    598722            ENDIF 
    599          END DO 
    600       END DO 
    601    END DO 
    602  
    603    zeqn_absmin(:,:,:) = HUGE(1._wp) 
    604  
    605    DO jn = 1, jp_maxniter_atgen  
    606    DO jk = 1, jpk 
    607       DO jj = 1, jpj 
    608          DO ji = 1, jpi 
    609             IF (rmask(ji,jj,jk) == 1.) THEN 
    610                zfact = rhop(ji,jj,jk) / 1000. + rtrn 
    611                p_alktot = trb(ji,jj,jk,jptal) / zfact 
    612                zdic  = trb(ji,jj,jk,jpdic) / zfact 
    613                zbot  = borat(ji,jj,jk) 
    614                zpt = trb(ji,jj,jk,jppo4) / zfact * po4r 
    615                zsit = trb(ji,jj,jk,jpsil) / zfact 
    616                zst = sulfat (ji,jj,jk) 
    617                zft = fluorid(ji,jj,jk) 
    618                aphscale = 1. + sulfat(ji,jj,jk)/aks3(ji,jj,jk) 
    619                zh = zhi(ji,jj,jk) 
    620                zh_prev = zh 
    621  
    622                ! H2CO3 - HCO3 - CO3 : n=2, m=0 
    623                znumer_dic = 2.*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*ak13(ji,jj,jk) 
    624                zdenom_dic = ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*(ak13(ji,jj,jk) + zh) 
    625                zalk_dic   = zdic * (znumer_dic/zdenom_dic) 
    626                zdnumer_dic = ak13(ji,jj,jk)*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh     & 
    627                              *(4.*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*ak13(ji,jj,jk)) 
    628                zdalk_dic   = -zdic*(zdnumer_dic/zdenom_dic**2) 
    629  
    630  
    631                ! B(OH)3 - B(OH)4 : n=1, m=0 
    632                znumer_bor = akb3(ji,jj,jk) 
    633                zdenom_bor = akb3(ji,jj,jk) + zh 
    634                zalk_bor   = zbot * (znumer_bor/zdenom_bor) 
    635                zdnumer_bor = akb3(ji,jj,jk) 
    636                zdalk_bor   = -zbot*(zdnumer_bor/zdenom_bor**2) 
    637  
    638  
    639                ! H3PO4 - H2PO4 - HPO4 - PO4 : n=3, m=1 
    640                znumer_po4 = 3.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)  & 
    641                &            + zh*(2.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh* ak1p3(ji,jj,jk)) 
    642                zdenom_po4 = ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)     & 
    643                &            + zh*( ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh*(ak1p3(ji,jj,jk) + zh)) 
    644                zalk_po4   = zpt * (znumer_po4/zdenom_po4 - 1.) ! Zero level of H3PO4 = 1 
    645                zdnumer_po4 = ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)  & 
    646                &             + zh*(4.*ak1p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)         & 
    647                &             + zh*(9.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)                         & 
    648                &             + ak1p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)                                & 
    649                &             + zh*(4.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh * ak1p3(ji,jj,jk) ) ) ) 
    650                zdalk_po4   = -zpt * (zdnumer_po4/zdenom_po4**2) 
    651  
    652                ! H4SiO4 - H3SiO4 : n=1, m=0 
    653                znumer_sil = aksi3(ji,jj,jk) 
    654                zdenom_sil = aksi3(ji,jj,jk) + zh 
    655                zalk_sil   = zsit * (znumer_sil/zdenom_sil) 
    656                zdnumer_sil = aksi3(ji,jj,jk) 
    657                zdalk_sil   = -zsit * (zdnumer_sil/zdenom_sil**2) 
    658  
    659                ! HSO4 - SO4 : n=1, m=1 
    660                aphscale = 1.0 + zst/aks3(ji,jj,jk) 
    661                znumer_so4 = aks3(ji,jj,jk) * aphscale 
    662                zdenom_so4 = aks3(ji,jj,jk) * aphscale + zh 
    663                zalk_so4   = zst * (znumer_so4/zdenom_so4 - 1.) 
    664                zdnumer_so4 = aks3(ji,jj,jk) 
    665                zdalk_so4   = -zst * (zdnumer_so4/zdenom_so4**2) 
    666  
    667                ! HF - F : n=1, m=1 
    668                znumer_flu =  akf3(ji,jj,jk) 
    669                zdenom_flu =  akf3(ji,jj,jk) + zh 
    670                zalk_flu   =  zft * (znumer_flu/zdenom_flu - 1.) 
    671                zdnumer_flu = akf3(ji,jj,jk) 
    672                zdalk_flu   = -zft * (zdnumer_flu/zdenom_flu**2) 
    673  
    674                ! H2O - OH 
    675                aphscale = 1.0 + zst/aks3(ji,jj,jk) 
    676                zalk_wat   = akw3(ji,jj,jk)/zh - zh/aphscale 
    677                zdalk_wat  = -akw3(ji,jj,jk)/zh**2 - 1./aphscale 
    678  
    679                ! CALCULATE [ALK]([CO3--], [HCO3-]) 
    680                zeqn = zalk_dic + zalk_bor + zalk_po4 + zalk_sil   & 
    681                &      + zalk_so4 + zalk_flu                       & 
    682                &      + zalk_wat - p_alktot 
    683  
    684                zalka = p_alktot - (zalk_bor + zalk_po4 + zalk_sil   & 
    685                &       + zalk_so4 + zalk_flu + zalk_wat) 
    686  
    687                zdeqndh = zdalk_dic + zdalk_bor + zdalk_po4 + zdalk_sil & 
    688                &         + zdalk_so4 + zdalk_flu + zdalk_wat 
    689  
    690                ! Adapt bracketing interval 
    691                IF(zeqn > 0._wp) THEN 
    692                  zh_min(ji,jj,jk) = zh_prev 
    693                ELSEIF(zeqn < 0._wp) THEN 
    694                  zh_max(ji,jj,jk) = zh_prev 
    695                ENDIF 
    696  
    697                IF(ABS(zeqn) >= 0.5_wp*zeqn_absmin(ji,jj,jk)) THEN 
    698                ! if the function evaluation at the current point is 
    699                ! not decreasing faster than with a bisection step (at least linearly) 
    700                ! in absolute value take one bisection step on [ph_min, ph_max] 
    701                ! ph_new = (ph_min + ph_max)/2d0 
    702                ! 
     723 
     724            IF( zh < zh_min(ji,jj,jk) ) THEN 
     725               ! if [H]_new < [H]_min 
     726               ! i.e., if ph_new > ph_max then 
     727               ! take one bisection step on [ph_prev, ph_max] 
     728               ! ph_new = (ph_prev + ph_max)/2d0 
    703729               ! In terms of [H]_new: 
    704730               ! [H]_new = 10**(-ph_new) 
    705                !         = 10**(-(ph_min + ph_max)/2d0) 
    706                !         = SQRT(10**(-(ph_min + phmax))) 
    707                !         = SQRT(zh_max * zh_min) 
    708                   zh = SQRT(zh_max(ji,jj,jk) * zh_min(ji,jj,jk)) 
    709                   zh_lnfactor = (zh - zh_prev)/zh_prev ! Required to test convergence below 
    710                ELSE 
    711                ! dzeqn/dpH = dzeqn/d[H] * d[H]/dpH 
    712                !           = -zdeqndh * LOG(10) * [H] 
    713                ! \Delta pH = -zeqn/(zdeqndh*d[H]/dpH) = zeqn/(zdeqndh*[H]*LOG(10)) 
    714                ! 
    715                ! pH_new = pH_old + \deltapH 
    716                ! 
    717                ! [H]_new = 10**(-pH_new) 
    718                !         = 10**(-pH_old - \Delta pH) 
    719                !         = [H]_old * 10**(-zeqn/(zdeqndh*[H]_old*LOG(10))) 
    720                !         = [H]_old * EXP(-LOG(10)*zeqn/(zdeqndh*[H]_old*LOG(10))) 
    721                !         = [H]_old * EXP(-zeqn/(zdeqndh*[H]_old)) 
    722  
    723                   zh_lnfactor = -zeqn/(zdeqndh*zh_prev) 
    724  
    725                   IF(ABS(zh_lnfactor) > pz_exp_threshold) THEN 
    726                      zh          = zh_prev*EXP(zh_lnfactor) 
    727                   ELSE 
    728                      zh_delta    = zh_lnfactor*zh_prev 
    729                      zh          = zh_prev + zh_delta 
    730                   ENDIF 
    731  
    732                   IF( zh < zh_min(ji,jj,jk) ) THEN 
    733                      ! if [H]_new < [H]_min 
    734                      ! i.e., if ph_new > ph_max then 
    735                      ! take one bisection step on [ph_prev, ph_max] 
    736                      ! ph_new = (ph_prev + ph_max)/2d0 
    737                      ! In terms of [H]_new: 
    738                      ! [H]_new = 10**(-ph_new) 
    739                      !         = 10**(-(ph_prev + ph_max)/2d0) 
    740                      !         = SQRT(10**(-(ph_prev + phmax))) 
    741                      !         = SQRT([H]_old*10**(-ph_max)) 
    742                      !         = SQRT([H]_old * zh_min) 
    743                      zh                = SQRT(zh_prev * zh_min(ji,jj,jk)) 
    744                      zh_lnfactor       = (zh - zh_prev)/zh_prev ! Required to test convergence below 
    745                   ENDIF 
    746  
    747                   IF( zh > zh_max(ji,jj,jk) ) THEN 
    748                      ! if [H]_new > [H]_max 
    749                      ! i.e., if ph_new < ph_min, then 
    750                      ! take one bisection step on [ph_min, ph_prev] 
    751                      ! ph_new = (ph_prev + ph_min)/2d0 
    752                      ! In terms of [H]_new: 
    753                      ! [H]_new = 10**(-ph_new) 
    754                      !         = 10**(-(ph_prev + ph_min)/2d0) 
    755                      !         = SQRT(10**(-(ph_prev + ph_min))) 
    756                      !         = SQRT([H]_old*10**(-ph_min)) 
    757                      !         = SQRT([H]_old * zhmax) 
    758                      zh                = SQRT(zh_prev * zh_max(ji,jj,jk)) 
    759                      zh_lnfactor       = (zh - zh_prev)/zh_prev ! Required to test convergence below 
    760                   ENDIF 
    761                ENDIF 
    762  
    763                zeqn_absmin(ji,jj,jk) = MIN( ABS(zeqn), zeqn_absmin(ji,jj,jk)) 
    764  
    765                ! Stop iterations once |\delta{[H]}/[H]| < rdel 
    766                ! <=> |(zh - zh_prev)/zh_prev| = |EXP(-zeqn/(zdeqndh*zh_prev)) -1| < rdel 
    767                ! |EXP(-zeqn/(zdeqndh*zh_prev)) -1| ~ |zeqn/(zdeqndh*zh_prev)| 
    768  
    769                ! Alternatively: 
    770                ! |\Delta pH| = |zeqn/(zdeqndh*zh_prev*LOG(10))| 
    771                !             ~ 1/LOG(10) * |\Delta [H]|/[H] 
    772                !             < 1/LOG(10) * rdel 
    773  
    774                ! Hence |zeqn/(zdeqndh*zh)| < rdel 
    775  
    776                ! rdel <-- pp_rdel_ah_target 
    777                l_exitnow = (ABS(zh_lnfactor) < pp_rdel_ah_target) 
    778  
    779                IF(l_exitnow) THEN  
    780                   rmask(ji,jj,jk) = 0. 
    781                ENDIF 
    782  
    783                zhi(ji,jj,jk) =  zh 
    784  
    785                IF(jn >= jp_maxniter_atgen) THEN 
    786                   zhi(ji,jj,jk) = -1._wp 
    787                ENDIF 
    788  
     731               !         = 10**(-(ph_prev + ph_max)/2d0) 
     732               !         = SQRT(10**(-(ph_prev + phmax))) 
     733               !         = SQRT([H]_old*10**(-ph_max)) 
     734               !         = SQRT([H]_old * zh_min) 
     735               zh                = SQRT(zh_prev * zh_min(ji,jj,jk)) 
     736               zh_lnfactor       = (zh - zh_prev)/zh_prev ! Required to test convergence below 
    789737            ENDIF 
    790          END DO 
    791       END DO 
    792    END DO 
     738 
     739            IF( zh > zh_max(ji,jj,jk) ) THEN 
     740               ! if [H]_new > [H]_max 
     741               ! i.e., if ph_new < ph_min, then 
     742               ! take one bisection step on [ph_min, ph_prev] 
     743               ! ph_new = (ph_prev + ph_min)/2d0 
     744               ! In terms of [H]_new: 
     745               ! [H]_new = 10**(-ph_new) 
     746               !         = 10**(-(ph_prev + ph_min)/2d0) 
     747               !         = SQRT(10**(-(ph_prev + ph_min))) 
     748               !         = SQRT([H]_old*10**(-ph_min)) 
     749               !         = SQRT([H]_old * zhmax) 
     750               zh                = SQRT(zh_prev * zh_max(ji,jj,jk)) 
     751               zh_lnfactor       = (zh - zh_prev)/zh_prev ! Required to test convergence below 
     752            ENDIF 
     753         ENDIF 
     754 
     755         zeqn_absmin(ji,jj,jk) = MIN( ABS(zeqn), zeqn_absmin(ji,jj,jk)) 
     756 
     757         ! Stop iterations once |\delta{[H]}/[H]| < rdel 
     758         ! <=> |(zh - zh_prev)/zh_prev| = |EXP(-zeqn/(zdeqndh*zh_prev)) -1| < rdel 
     759         ! |EXP(-zeqn/(zdeqndh*zh_prev)) -1| ~ |zeqn/(zdeqndh*zh_prev)| 
     760 
     761         ! Alternatively: 
     762         ! |\Delta pH| = |zeqn/(zdeqndh*zh_prev*LOG(10))| 
     763         !             ~ 1/LOG(10) * |\Delta [H]|/[H] 
     764         !             < 1/LOG(10) * rdel 
     765 
     766         ! Hence |zeqn/(zdeqndh*zh)| < rdel 
     767 
     768         ! rdel <-- pp_rdel_ah_target 
     769         l_exitnow = (ABS(zh_lnfactor) < pp_rdel_ah_target) 
     770 
     771         IF(l_exitnow) THEN  
     772            rmask(ji,jj,jk) = 0. 
     773         ENDIF 
     774 
     775         zhi(ji,jj,jk) =  zh 
     776 
     777         IF(jn >= jp_maxniter_atgen) THEN 
     778            zhi(ji,jj,jk) = -1._wp 
     779         ENDIF 
     780 
     781      ENDIF 
     782   END_3D 
    793783   END DO 
    794784   ! 
Note: See TracChangeset for help on using the changeset viewer.