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 10975 for NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/TOP/PISCES/P4Z/p4zche.F90 – NEMO

Ignore:
Timestamp:
2019-05-13T18:34:33+02:00 (5 years ago)
Author:
acc
Message:

2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps : Finish converting all TOP routines and knock-on effects of these conversions. Fully SETTE tested (SETTE tests 1-6 and 9). This completes the first stage conversion of TRA and TOP but need to revisit and pass ts and tr arrays through the argument lists where appropriate.

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  
    137137CONTAINS 
    138138 
    139    SUBROUTINE p4z_che 
     139   SUBROUTINE p4z_che( Kbb, Kmm ) 
    140140      !!--------------------------------------------------------------------- 
    141141      !!                     ***  ROUTINE p4z_che  *** 
     
    145145      !! ** Method  : - ... 
    146146      !!--------------------------------------------------------------------- 
     147      INTEGER, INTENT(in) ::   Kbb, Kmm  ! time level indices 
    147148      INTEGER  ::   ji, jj, jk 
    148149      REAL(wp) ::   ztkel, ztkel1, zt , zsal  , zsal2 , zbuf1 , zbuf2 
     
    164165      ! ------------------------------------------------------------- 
    165166      IF (neos == -1) THEN 
    166          salinprac(:,:,:) = tsn(:,:,:,jp_sal) * 35.0 / 35.16504 
     167         salinprac(:,:,:) = ts(:,:,:,jp_sal,Kmm) * 35.0 / 35.16504 
    167168      ELSE 
    168          salinprac(:,:,:) = tsn(:,:,:,jp_sal) 
     169         salinprac(:,:,:) = ts(:,:,:,jp_sal,Kmm) 
    169170      ENDIF 
    170171 
     
    178179         DO jj = 1, jpj 
    179180            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 
     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 
    184185            END DO 
    185186         END DO 
     
    245246               zplat   = SIN ( ABS(gphit(ji,jj)*3.141592654/180.) ) 
    246247               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 
     248               zpres = ((1-zc1)-SQRT(((1-zc1)**2)-(8.84E-6*gdept(ji,jj,jk,Kmm)))) / 4.42E-6 
    248249               zpres = zpres / 10.0 
    249250 
     
    448449   END SUBROUTINE p4z_che 
    449450 
    450    SUBROUTINE ahini_for_at(p_hini) 
     451   SUBROUTINE ahini_for_at(p_hini, Kbb ) 
    451452      !!--------------------------------------------------------------------- 
    452453      !!                     ***  ROUTINE ahini_for_at  *** 
     
    462463      !!--------------------------------------------------------------------- 
    463464      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT)  ::  p_hini 
     465      INTEGER,                          INTENT(in)   ::  Kbb      ! time level indices 
    464466      INTEGER  ::   ji, jj, jk 
    465467      REAL(wp)  ::  zca1, zba1 
     
    474476        DO jj = 1, jpj 
    475477          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_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) 
    478480            p_bortot = borat(ji,jj,jk) 
    479481            IF (p_alkcb <= 0.) THEN 
     
    516518   !=============================================================================== 
    517519 
    518    SUBROUTINE anw_infsup( p_alknw_inf, p_alknw_sup ) 
     520   SUBROUTINE anw_infsup( p_alknw_inf, p_alknw_sup, Kbb ) 
    519521 
    520522   ! Subroutine returns the lower and upper bounds of "non-water-selfionization" 
     
    525527   REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_alknw_inf 
    526528   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(:,:,:)  & 
    529532   &              - fluorid(:,:,:) 
    530    p_alknw_sup(:,:,:) =   (2. * trb(:,:,:,jpdic) + 2. * trb(:,:,:,jppo4) + trb(:,:,:,jpsil) )    & 
     533   p_alknw_sup(:,:,:) =   (2. * tr(:,:,:,jpdic,Kbb) + 2. * tr(:,:,:,jppo4,Kbb) + tr(:,:,:,jpsil,Kbb) )    & 
    531534   &               * 1000. / (rhop(:,:,:) + rtrn) + borat(:,:,:)  
    532535 
     
    534537 
    535538 
    536    SUBROUTINE solve_at_general( p_hini, zhi ) 
     539   SUBROUTINE solve_at_general( p_hini, zhi, Kbb ) 
    537540 
    538541   ! Universal pH solver that converges from any given initial value, 
     
    543546   REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(IN)   :: p_hini 
    544547   REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT)  :: zhi 
     548   INTEGER,                          INTENT(in)   :: Kbb  ! time level indices 
    545549 
    546550   ! Local variables 
     
    565569   IF( ln_timing )  CALL timing_start('solve_at_general') 
    566570 
    567    CALL anw_infsup( zalknw_inf, zalknw_sup ) 
     571   CALL anw_infsup( zalknw_inf, zalknw_sup, Kbb ) 
    568572 
    569573   rmask(:,:,:) = tmask(:,:,:) 
     
    575579         DO ji = 1, jpi 
    576580            IF (rmask(ji,jj,jk) == 1.) THEN 
    577                p_alktot = trb(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) 
    578582               aphscale = 1. + sulfat(ji,jj,jk)/aks3(ji,jj,jk) 
    579583               zh_ini = p_hini(ji,jj,jk) 
     
    609613            IF (rmask(ji,jj,jk) == 1.) THEN 
    610614               zfact = rhop(ji,jj,jk) / 1000. + rtrn 
    611                p_alktot = trb(ji,jj,jk,jptal) / zfact 
    612                zdic  = trb(ji,jj,jk,jpdic) / zfact 
     615               p_alktot = tr(ji,jj,jk,jptal,Kbb) / zfact 
     616               zdic  = tr(ji,jj,jk,jpdic,Kbb) / zfact 
    613617               zbot  = borat(ji,jj,jk) 
    614                zpt = trb(ji,jj,jk,jppo4) / zfact * po4r 
    615                zsit = trb(ji,jj,jk,jpsil) / zfact 
     618               zpt = tr(ji,jj,jk,jppo4,Kbb) / zfact * po4r 
     619               zsit = tr(ji,jj,jk,jpsil,Kbb) / zfact 
    616620               zst = sulfat (ji,jj,jk) 
    617621               zft = fluorid(ji,jj,jk) 
Note: See TracChangeset for help on using the changeset viewer.