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 13373 for NEMO/branches/2020 – NEMO

Changeset 13373 for NEMO/branches/2020


Ignore:
Timestamp:
2020-08-03T11:46:38+02:00 (4 years ago)
Author:
cetlod
Message:

TOP-05_Ethe_Agrif : 1st step of changes to successfully compile, see ticket #2508

Location:
NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src
Files:
30 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/NST/agrif_top_sponge.F90

    r12489 r13373  
    6767      ! 
    6868      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    69       REAL(wp) ::   zabe1, zabe2, ztrelax 
    70       REAL(wp), DIMENSION(i1:i2,j1:j2)               ::   ztu, ztv 
    71       REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,1:jptra) ::   trbdiff 
     69      INTEGER  ::   iku, ikv 
     70      REAL(wp) ::   ztra, zabe1, zabe2, zbtr 
     71      REAL(wp), DIMENSION(i1:i2,j1:j2,jpk)  ::   ztu, ztv 
     72      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2) ::   trbdiff 
    7273      ! vertical interpolation: 
    73       REAL(wp), DIMENSION(i1:i2,j1:j2,jpk,1:jptra) ::tabres_child 
     74      REAL(wp), DIMENSION(i1:i2,j1:j2,jpk,n1:n2) ::tabres_child 
    7475      REAL(wp), DIMENSION(k1:k2,1:jptra) :: tabin 
    7576      REAL(wp), DIMENSION(k1:k2) :: h_in 
    7677      REAL(wp), DIMENSION(1:jpk) :: h_out 
    7778      INTEGER :: N_in, N_out 
    78       REAL(wp) :: h_diff 
    7979      !!---------------------------------------------------------------------- 
    8080      ! 
     
    9494            DO jj=j1,j2 
    9595               DO ji=i1,i2 
    96                   tabres(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kbb_a)  
     96                  tabres(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kbb_a) 
    9797               END DO 
    9898            END DO 
     
    128128               DO jk=1,jpkm1 
    129129# if defined key_vertical 
    130                   trbdiff(ji,jj,jk,1:jptra) = tr(ji,jj,jk,1:jptra,Kbb_a) - tabres_child(ji,jj,jk,1:jptra) 
     130                  trbdiff(ji,jj,jk,1:jptra) = ( tr(ji,jj,jk,1:jptra,Kbb_a) - tabres_child(ji,jj,jk,1:jptra) ) * tmask(ji,jj,jk) 
    131131# else 
    132                   trbdiff(ji,jj,jk,1:jptra) = tr(ji,jj,jk,1:jptra,Kbb_a) - tabres(ji,jj,jk,1:jptra) 
     132                  trbdiff(ji,jj,jk,1:jptra) = ( tr(ji,jj,jk,1:jptra,Kbb_a) - tabres(ji,jj,jk,1:jptra)) * tmask(ji,jj,jk) 
    133133# endif 
    134134               ENDDO 
     
    136136         ENDDO 
    137137 
    138          !* set relaxation time scale 
    139          IF( l_1st_euler .AND. lk_agrif_fstep ) THEN   ;   ztrelax =   rn_trelax_tra  / (        rn_Dt ) 
    140          ELSE                                          ;   ztrelax =   rn_trelax_tra  / (2._wp * rn_Dt ) 
    141          ENDIF 
    142  
    143138         DO jn = 1, jptra 
    144139            DO jk = 1, jpkm1 
    145                DO jj = j1,j2-1 
     140               ztu(i1:i2,j1:j2,jk) = 0._wp 
     141               DO jj = j1,j2 
    146142                  DO ji = i1,i2-1 
    147                      zabe1 = rn_sponge_tra * fspu(ji,jj) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm_a) * umask(ji,jj,jk) 
    148                      zabe2 = rn_sponge_tra * fspv(ji,jj) * e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm_a) * vmask(ji,jj,jk) 
    149                      ztu(ji,jj) = zabe1 * ( trbdiff(ji+1,jj  ,jk,jn) - trbdiff(ji,jj,jk,jn) ) 
    150                      ztv(ji,jj) = zabe2 * ( trbdiff(ji  ,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) ) 
     143                     zabe1 = rn_sponge_tra * r1_Dt * fspu(ji,jj) * umask(ji,jj,jk) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm_a) 
     144                     ztu(ji,jj,jk) = zabe1 * ( trbdiff(ji+1,jj,jk,jn) - trbdiff(ji,jj,jk,jn) ) 
     145                  END DO 
     146               END DO 
     147               ztv(i1:i2,j1:j2,jk) = 0._wp 
     148               DO ji = i1,i2 
     149                  DO jj = j1,j2-1 
     150                     zabe2 = rn_sponge_tra * r1_Dt * fspv(ji,jj) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm_a) 
     151                     ztv(ji,jj,jk) = zabe2 * ( trbdiff(ji,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) ) 
    151152                  END DO 
    152153               END DO 
    153154               ! 
     155               IF( ln_zps ) THEN      ! set gradient at partial step level 
     156                  DO jj = j1,j2 
     157                     DO ji = i1,i2 
     158                        ! last level 
     159                        iku = mbku(ji,jj) 
     160                        ikv = mbkv(ji,jj) 
     161                        IF( iku == jk )   ztu(ji,jj,jk) = 0._wp 
     162                        IF( ikv == jk )   ztv(ji,jj,jk) = 0._wp 
     163                     END DO 
     164                  END DO 
     165               ENDIF 
     166            END DO 
     167            ! 
     168            DO jk = 1, jpkm1 
    154169               DO jj = j1+1,j2-1 
    155170                  DO ji = i1+1,i2-1 
    156                      IF( .NOT. tabspongedone_trn(ji,jj) ) THEN  
    157                         tr(ji,jj,jk,jn,Krhs_a) = tr(ji,jj,jk,jn,Krhs_a) + (  ztu(ji,jj) - ztu(ji-1,jj  )     & 
    158                            &                                   + ztv(ji,jj) - ztv(ji  ,jj-1)  )  & 
    159                            &                                * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm_a)  & 
    160                            &                                - ztrelax * fspt(ji,jj) * trbdiff(ji,jj,jk,jn) 
     171                     IF( .NOT. tabspongedone_trn(ji,jj) ) THEN 
     172                        zbtr = r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm_a) 
     173                                                ! horizontal diffusive trends 
     174                        ztra = zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  ) & 
     175                             &  - rn_trelax_tra * r1_Dt * fspt(ji,jj) * trbdiff(ji,jj,jk,jn) 
     176                        ! add it to the general tracer trends 
     177                        tr(ji,jj,jk,jn,Krhs_a) = tr(ji,jj,jk,jn,Krhs_a) + ztra 
    161178                     ENDIF 
    162179                  END DO 
    163180               END DO 
    164181            END DO 
    165             ! 
    166182         END DO 
    167183         ! 
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/NST/agrif_user.F90

    r13295 r13373  
    749749      CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge) 
    750750      ! reset tsa to zero 
    751       tra(:,:,:,:) = 0._wp 
     751      tr(:,:,:,:,Krhs_a) = 0._wp 
    752752 
    753753      ! 3. Some controls 
     
    808808# else 
    809809! LAURENT: STRANGE why (3,3) here ? 
    810       CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_id) 
    811       CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_sponge_id) 
     810      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_id) 
     811      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_sponge_id) 
    812812# endif 
    813813 
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/OCE/IOM/iom_def.F90

    r13286 r13373  
    2525   INTEGER, PARAMETER, PUBLIC ::   jp_i1    = 204      !: write INTEGER(1) 
    2626 
    27    INTEGER, PARAMETER, PUBLIC ::   jpmax_files  = 100  !: maximum number of simultaneously opened file 
     27   INTEGER, PARAMETER, PUBLIC ::   jpmax_files  = 200  !: maximum number of simultaneously opened file 
    2828   INTEGER, PARAMETER, PUBLIC ::   jpmax_vars   = 1200 !: maximum number of variables in one file 
    2929   INTEGER, PARAMETER, PUBLIC ::   jpmax_dims   =  4   !: maximum number of dimensions for one variable 
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/PISCES/P4Z/p4zche.F90

    r13295 r13373  
    188188      ! CHEMICAL CONSTANTS - SURFACE LAYER 
    189189      ! ---------------------------------- 
    190 !CDIR NOVERRCHK 
    191       DO jj = 1, jpj 
    192 !CDIR NOVERRCHK 
    193          DO ji = 1, jpi 
    194             !                             ! SET ABSOLUTE TEMPERATURE 
    195             ztkel = tempis(ji,jj,1) + 273.15 
    196             zt    = ztkel * 0.01 
    197             zsal  = salinprac(ji,jj,1) + ( 1.- tmask(ji,jj,1) ) * 35. 
    198             !                             ! LN(K0) OF SOLUBILITY OF CO2 (EQ. 12, WEISS, 1980) 
    199             !                             !     AND FOR THE ATMOSPHERE FOR NON IDEAL GAS 
    200             zcek1 = 9345.17/ztkel - 60.2409 + 23.3585 * LOG(zt) + zsal*(0.023517 - 0.00023656*ztkel    & 
    201             &       + 0.0047036e-4*ztkel**2) 
    202             chemc(ji,jj,1) = EXP( zcek1 ) * 1E-6 * rhop(ji,jj,1) / 1000. ! mol/(L atm) 
    203             chemc(ji,jj,2) = -1636.75 + 12.0408*ztkel - 0.0327957*ztkel**2 + 0.0000316528*ztkel**3 
    204             chemc(ji,jj,3) = 57.7 - 0.118*ztkel 
    205             ! 
    206          END DO 
    207       END DO 
     190      DO_2D( 1, 1, 1, 1 ) 
     191         !                             ! SET ABSOLUTE TEMPERATURE 
     192         ztkel = tempis(ji,jj,1) + 273.15 
     193         zt    = ztkel * 0.01 
     194         zsal  = salinprac(ji,jj,1) + ( 1.- tmask(ji,jj,1) ) * 35. 
     195         !                             ! LN(K0) OF SOLUBILITY OF CO2 (EQ. 12, WEISS, 1980) 
     196         !                             !     AND FOR THE ATMOSPHERE FOR NON IDEAL GAS 
     197         zcek1 = 9345.17/ztkel - 60.2409 + 23.3585 * LOG(zt) + zsal*(0.023517 - 0.00023656*ztkel    & 
     198         &       + 0.0047036e-4*ztkel**2) 
     199         chemc(ji,jj,1) = EXP( zcek1 ) * 1E-6 * rhop(ji,jj,1) / 1000. ! mol/(L atm) 
     200         chemc(ji,jj,2) = -1636.75 + 12.0408*ztkel - 0.0327957*ztkel**2 + 0.0000316528*ztkel**3 
     201         chemc(ji,jj,3) = 57.7 - 0.118*ztkel 
     202      END_2D 
    208203 
    209204      ! OXYGEN SOLUBILITY - DEEP OCEAN 
    210205      ! ------------------------------- 
    211 !CDIR NOVERRCHK 
    212       DO jk = 1, jpk 
    213 !CDIR NOVERRCHK 
    214          DO jj = 1, jpj 
    215 !CDIR NOVERRCHK 
    216             DO ji = 1, jpi 
    217               ztkel = tempis(ji,jj,jk) + 273.15 
    218               zsal  = salinprac(ji,jj,jk) + ( 1.- tmask(ji,jj,jk) ) * 35. 
    219               zsal2 = zsal * zsal 
    220               ztgg  = LOG( ( 298.15 - tempis(ji,jj,jk) ) / ztkel )  ! Set the GORDON & GARCIA scaled temperature 
    221               ztgg2 = ztgg  * ztgg 
    222               ztgg3 = ztgg2 * ztgg 
    223               ztgg4 = ztgg3 * ztgg 
    224               ztgg5 = ztgg4 * ztgg 
    225  
    226               zoxy  = 2.00856 + 3.22400 * ztgg + 3.99063 * ztgg2 + 4.80299 * ztgg3    & 
    227               &       + 9.78188e-1 * ztgg4 + 1.71069 * ztgg5 + zsal * ( -6.24097e-3   & 
    228               &       - 6.93498e-3 * ztgg - 6.90358e-3 * ztgg2 - 4.29155e-3 * ztgg3 )   & 
    229               &       - 3.11680e-7 * zsal2 
    230               chemo2(ji,jj,jk) = ( EXP( zoxy ) * o2atm ) * oxyco * atcox     ! mol/(L atm) 
    231             END DO 
    232           END DO 
    233         END DO 
     206      DO_3D( 1, 1, 1, 1, 1, jpk ) 
     207         ztkel = tempis(ji,jj,jk) + 273.15 
     208         zsal  = salinprac(ji,jj,jk) + ( 1.- tmask(ji,jj,jk) ) * 35. 
     209         zsal2 = zsal * zsal 
     210         ztgg  = LOG( ( 298.15 - tempis(ji,jj,jk) ) / ztkel )  ! Set the GORDON & GARCIA scaled temperature 
     211         ztgg2 = ztgg  * ztgg 
     212         ztgg3 = ztgg2 * ztgg 
     213         ztgg4 = ztgg3 * ztgg 
     214         ztgg5 = ztgg4 * ztgg 
     215 
     216         zoxy  = 2.00856 + 3.22400 * ztgg + 3.99063 * ztgg2 + 4.80299 * ztgg3    & 
     217         &       + 9.78188e-1 * ztgg4 + 1.71069 * ztgg5 + zsal * ( -6.24097e-3   & 
     218         &       - 6.93498e-3 * ztgg - 6.90358e-3 * ztgg2 - 4.29155e-3 * ztgg3 )   & 
     219         &       - 3.11680e-7 * zsal2 
     220         chemo2(ji,jj,jk) = ( EXP( zoxy ) * o2atm ) * oxyco * atcox     ! mol/(L atm) 
     221      END_3D 
    234222 
    235223      ! CHEMICAL CONSTANTS - DEEP OCEAN 
    236224      ! ------------------------------- 
    237 !CDIR NOVERRCHK 
    238       DO jk = 1, jpk 
    239 !CDIR NOVERRCHK 
    240          DO jj = 1, jpj 
    241 !CDIR NOVERRCHK 
    242             DO ji = 1, jpi 
    243  
    244                ! SET PRESSION ACCORDING TO SAUNDER (1980) 
    245                zplat   = SIN ( ABS(gphit(ji,jj)*3.141592654/180.) ) 
    246                zc1 = 5.92E-3 + zplat**2 * 5.25E-3 
    247                zpres = ((1-zc1)-SQRT(((1-zc1)**2)-(8.84E-6*gdept(ji,jj,jk,Kmm)))) / 4.42E-6 
    248                zpres = zpres / 10.0 
    249  
    250                ! SET ABSOLUTE TEMPERATURE 
    251                ztkel   = tempis(ji,jj,jk) + 273.15 
    252                zsal    = salinprac(ji,jj,jk) + ( 1.-tmask(ji,jj,jk) ) * 35. 
    253                zsqrt  = SQRT( zsal ) 
    254                zsal15  = zsqrt * zsal 
    255                zlogt  = LOG( ztkel ) 
    256                ztr    = 1. / ztkel 
    257                zis    = 19.924 * zsal / ( 1000.- 1.005 * zsal ) 
    258                zis2   = zis * zis 
    259                zisqrt = SQRT( zis ) 
    260                ztc     = tempis(ji,jj,jk) + ( 1.- tmask(ji,jj,jk) ) * 20. 
    261  
    262                ! CHLORINITY (WOOSTER ET AL., 1969) 
    263                zcl     = zsal / 1.80655 
    264  
    265                ! TOTAL SULFATE CONCENTR. [MOLES/kg soln] 
    266                zst     = 0.14 * zcl /96.062 
    267  
    268                ! TOTAL FLUORIDE CONCENTR. [MOLES/kg soln] 
    269                zft     = 0.000067 * zcl /18.9984 
    270  
    271                ! DISSOCIATION CONSTANT FOR SULFATES on free H scale (Dickson 1990) 
    272                zcks    = EXP(-4276.1 * ztr + 141.328 - 23.093 * zlogt         & 
    273                &         + (-13856. * ztr + 324.57 - 47.986 * zlogt) * zisqrt & 
    274                &         + (35474. * ztr - 771.54 + 114.723 * zlogt) * zis    & 
    275                &         - 2698. * ztr * zis**1.5 + 1776.* ztr * zis2         & 
    276                &         + LOG(1.0 - 0.001005 * zsal)) 
    277  
    278                ! DISSOCIATION CONSTANT FOR FLUORIDES on free H scale (Dickson and Riley 79) 
    279                zckf    = EXP( 1590.2*ztr - 12.641 + 1.525*zisqrt   & 
    280                &         + LOG(1.0d0 - 0.001005d0*zsal)            & 
    281                &         + LOG(1.0d0 + zst/zcks)) 
    282  
    283                ! DISSOCIATION CONSTANT FOR CARBONATE AND BORATE 
    284                zckb=  (-8966.90 - 2890.53*zsqrt - 77.942*zsal        & 
    285                &      + 1.728*zsal15 - 0.0996*zsal*zsal)*ztr         & 
    286                &      + (148.0248 + 137.1942*zsqrt + 1.62142*zsal)   & 
    287                &      + (-24.4344 - 25.085*zsqrt - 0.2474*zsal)      &  
    288                &      * zlogt + 0.053105*zsqrt*ztkel 
    289  
    290                ! DISSOCIATION COEFFICIENT FOR CARBONATE ACCORDING TO  
    291                ! MEHRBACH (1973) REFIT BY MILLERO (1995), seawater scale 
    292                zck1    = -1.0*(3633.86*ztr - 61.2172 + 9.6777*zlogt  & 
    293                   - 0.011555*zsal + 0.0001152*zsal*zsal) 
    294                zck2    = -1.0*(471.78*ztr + 25.9290 - 3.16967*zlogt      & 
    295                   - 0.01781*zsal + 0.0001122*zsal*zsal) 
    296  
    297                ! PKW (H2O) (MILLERO, 1995) from composite data 
    298                zckw    = -13847.26 * ztr + 148.9652 - 23.6521 * zlogt + ( 118.67 * ztr    & 
    299                          - 5.977 + 1.0495 * zlogt ) * zsqrt - 0.01615 * zsal 
    300  
    301                ! CONSTANTS FOR PHOSPHATE (MILLERO, 1995) 
    302               zck1p    = -4576.752*ztr + 115.540 - 18.453*zlogt   & 
    303               &          + (-106.736*ztr + 0.69171) * zsqrt       & 
    304               &          + (-0.65643*ztr - 0.01844) * zsal 
    305  
    306               zck2p    = -8814.715*ztr + 172.1033 - 27.927*zlogt  & 
    307               &          + (-160.340*ztr + 1.3566)*zsqrt          & 
    308               &          + (0.37335*ztr - 0.05778)*zsal 
    309  
    310               zck3p    = -3070.75*ztr - 18.126                    & 
    311               &          + (17.27039*ztr + 2.81197) * zsqrt       & 
    312               &          + (-44.99486*ztr - 0.09984) * zsal  
    313  
    314               ! CONSTANT FOR SILICATE, MILLERO (1995) 
    315               zcksi    = -8904.2*ztr  + 117.400 - 19.334*zlogt   & 
    316               &          + (-458.79*ztr + 3.5913) * zisqrt       & 
    317               &          + (188.74*ztr - 1.5998) * zis           & 
    318               &          + (-12.1652*ztr + 0.07871) * zis2       & 
    319               &          + LOG(1.0 - 0.001005*zsal) 
    320  
    321                ! APPARENT SOLUBILITY PRODUCT K'SP OF CALCITE IN SEAWATER 
    322                !       (S=27-43, T=2-25 DEG C) at pres =0 (atmos. pressure) (MUCCI 1983) 
    323                zaksp0  = -171.9065 -0.077993*ztkel + 2839.319*ztr + 71.595*LOG10( ztkel )   & 
    324                   &      + (-0.77712 + 0.00284263*ztkel + 178.34*ztr) * zsqrt  & 
    325                   &      - 0.07711*zsal + 0.0041249*zsal15 
    326  
    327                ! CONVERT FROM DIFFERENT PH SCALES 
    328                total2free  = 1.0/(1.0 + zst/zcks) 
    329                free2SWS    = 1. + zst/zcks + zft/(zckf*total2free) 
    330                total2SWS   = total2free * free2SWS 
    331                SWS2total   = 1.0 / total2SWS 
    332  
    333                ! K1, K2 OF CARBONIC ACID, KB OF BORIC ACID, KW (H2O) (LIT.?) 
    334                zak1    = 10**(zck1) * total2SWS 
    335                zak2    = 10**(zck2) * total2SWS 
    336                zakb    = EXP( zckb ) * total2SWS 
    337                zakw    = EXP( zckw ) 
    338                zaksp1  = 10**(zaksp0) 
    339                zak1p   = exp( zck1p ) 
    340                zak2p   = exp( zck2p ) 
    341                zak3p   = exp( zck3p ) 
    342                zaksi   = exp( zcksi ) 
    343                zckf    = zckf * total2SWS 
    344  
    345                ! FORMULA FOR CPEXP AFTER EDMOND & GIESKES (1970) 
    346                !        (REFERENCE TO CULBERSON & PYTKOQICZ (1968) AS MADE 
    347                !        IN BROECKER ET AL. (1982) IS INCORRECT; HERE RGAS IS 
    348                !        TAKEN TENFOLD TO CORRECT FOR THE NOTATION OF pres  IN 
    349                !        DBAR INSTEAD OF BAR AND THE EXPRESSION FOR CPEXP IS 
    350                !        MULTIPLIED BY LN(10.) TO ALLOW USE OF EXP-FUNCTION 
    351                !        WITH BASIS E IN THE FORMULA FOR AKSPP (CF. EDMOND 
    352                !        & GIESKES (1970), P. 1285-1286 (THE SMALL 
    353                !        FORMULA ON P. 1286 IS RIGHT AND CONSISTENT WITH THE 
    354                !        SIGN IN PARTIAL MOLAR VOLUME CHANGE AS SHOWN ON P. 1285)) 
    355                zcpexp  = zpres / (rgas*ztkel) 
    356                zcpexp2 = zpres * zcpexp 
    357  
    358                ! KB OF BORIC ACID, K1,K2 OF CARBONIC ACID PRESSURE 
    359                !        CORRECTION AFTER CULBERSON AND PYTKOWICZ (1968) 
    360                !        (CF. BROECKER ET AL., 1982) 
    361  
    362                zbuf1  = -     ( devk10 + devk20 * ztc + devk30 * ztc * ztc ) 
    363                zbuf2  = 0.5 * ( devk40 + devk50 * ztc ) 
    364                ak13(ji,jj,jk) = zak1 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
    365  
    366                zbuf1  =     - ( devk11 + devk21 * ztc + devk31 * ztc * ztc ) 
    367                zbuf2  = 0.5 * ( devk41 + devk51 * ztc ) 
    368                ak23(ji,jj,jk) = zak2 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
    369  
    370                zbuf1  =     - ( devk12 + devk22 * ztc + devk32 * ztc * ztc ) 
    371                zbuf2  = 0.5 * ( devk42 + devk52 * ztc ) 
    372                akb3(ji,jj,jk) = zakb * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
    373  
    374                zbuf1  =     - ( devk13 + devk23 * ztc + devk33 * ztc * ztc ) 
    375                zbuf2  = 0.5 * ( devk43 + devk53 * ztc ) 
    376                akw3(ji,jj,jk) = zakw * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
    377  
    378                zbuf1  =     - ( devk14 + devk24 * ztc + devk34 * ztc * ztc ) 
    379                zbuf2  = 0.5 * ( devk44 + devk54 * ztc ) 
    380                aks3(ji,jj,jk) = zcks * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
    381  
    382                zbuf1  =     - ( devk15 + devk25 * ztc + devk35 * ztc * ztc ) 
    383                zbuf2  = 0.5 * ( devk45 + devk55 * ztc ) 
    384                akf3(ji,jj,jk) = zckf * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
    385  
    386                zbuf1  =     - ( devk17 + devk27 * ztc + devk37 * ztc * ztc ) 
    387                zbuf2  = 0.5 * ( devk47 + devk57 * ztc ) 
    388                ak1p3(ji,jj,jk) = zak1p * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
    389  
    390                zbuf1  =     - ( devk18 + devk28 * ztc + devk38 * ztc * ztc ) 
    391                zbuf2  = 0.5 * ( devk48 + devk58 * ztc ) 
    392                ak2p3(ji,jj,jk) = zak2p * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
    393  
    394                zbuf1  =     - ( devk19 + devk29 * ztc + devk39 * ztc * ztc ) 
    395                zbuf2  = 0.5 * ( devk49 + devk59 * ztc ) 
    396                ak3p3(ji,jj,jk) = zak3p * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
    397  
    398                zbuf1  =     - ( devk110 + devk210 * ztc + devk310 * ztc * ztc ) 
    399                zbuf2  = 0.5 * ( devk410 + devk510 * ztc ) 
    400                aksi3(ji,jj,jk) = zaksi * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
    401  
    402                ! CONVERT FROM DIFFERENT PH SCALES 
    403                total2free  = 1.0/(1.0 + zst/aks3(ji,jj,jk)) 
    404                free2SWS    = 1. + zst/aks3(ji,jj,jk) + zft/akf3(ji,jj,jk) 
    405                total2SWS   = total2free * free2SWS 
    406                SWS2total   = 1.0 / total2SWS 
    407  
    408                ! Convert to total scale 
    409                ak13(ji,jj,jk)  = ak13(ji,jj,jk)  * SWS2total 
    410                ak23(ji,jj,jk)  = ak23(ji,jj,jk)  * SWS2total 
    411                akb3(ji,jj,jk)  = akb3(ji,jj,jk)  * SWS2total 
    412                akw3(ji,jj,jk)  = akw3(ji,jj,jk)  * SWS2total 
    413                ak1p3(ji,jj,jk) = ak1p3(ji,jj,jk) * SWS2total 
    414                ak2p3(ji,jj,jk) = ak2p3(ji,jj,jk) * SWS2total 
    415                ak3p3(ji,jj,jk) = ak3p3(ji,jj,jk) * SWS2total 
    416                aksi3(ji,jj,jk) = aksi3(ji,jj,jk) * SWS2total 
    417                akf3(ji,jj,jk)  = akf3(ji,jj,jk)  / total2free 
    418  
    419                ! APPARENT SOLUBILITY PRODUCT K'SP OF CALCITE  
    420                !        AS FUNCTION OF PRESSURE FOLLOWING MILLERO 
    421                !        (P. 1285) AND BERNER (1976) 
    422                zbuf1  =     - ( devk16 + devk26 * ztc + devk36 * ztc * ztc ) 
    423                zbuf2  = 0.5 * ( devk46 + devk56 * ztc ) 
    424                aksp(ji,jj,jk) = zaksp1 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
    425  
    426                ! TOTAL F, S, and BORATE CONCENTR. [MOLES/L] 
    427                borat(ji,jj,jk) = 0.0002414 * zcl / 10.811 
    428                sulfat(ji,jj,jk) = zst 
    429                fluorid(ji,jj,jk) = zft  
    430  
    431                ! Iron and SIO3 saturation concentration from ... 
    432                sio3eq(ji,jj,jk) = EXP(  LOG( 10.) * ( 6.44 - 968. / ztkel )  ) * 1.e-6 
    433                fekeq (ji,jj,jk) = 10**( 17.27 - 1565.7 / ztkel ) 
    434  
    435                ! Liu and Millero (1999) only valid 5 - 50 degC 
    436                ztkel1 = MAX( 5. , tempis(ji,jj,jk) ) + 273.16 
    437                fesol(ji,jj,jk,1) = 10**(-13.486 - 0.1856* zis**0.5 + 0.3073*zis + 5254.0/ztkel1) 
    438                fesol(ji,jj,jk,2) = 10**(2.517 - 0.8885*zis**0.5 + 0.2139 * zis - 1320.0/ztkel1 ) 
    439                fesol(ji,jj,jk,3) = 10**(0.4511 - 0.3305*zis**0.5 - 1996.0/ztkel1 ) 
    440                fesol(ji,jj,jk,4) = 10**(-0.2965 - 0.7881*zis**0.5 - 4086.0/ztkel1 ) 
    441                fesol(ji,jj,jk,5) = 10**(4.4466 - 0.8505*zis**0.5 - 7980.0/ztkel1 ) 
    442             END DO 
    443          END DO 
    444       END DO 
     225      DO_3D( 1, 1, 1, 1, 1, jpk ) 
     226          ! SET PRESSION ACCORDING TO SAUNDER (1980) 
     227          zplat   = SIN ( ABS(gphit(ji,jj)*3.141592654/180.) ) 
     228          zc1 = 5.92E-3 + zplat**2 * 5.25E-3 
     229          zpres = ((1-zc1)-SQRT(((1-zc1)**2)-(8.84E-6*gdept(ji,jj,jk,Kmm)))) / 4.42E-6 
     230          zpres = zpres / 10.0 
     231 
     232          ! SET ABSOLUTE TEMPERATURE 
     233          ztkel   = tempis(ji,jj,jk) + 273.15 
     234          zsal    = salinprac(ji,jj,jk) + ( 1.-tmask(ji,jj,jk) ) * 35. 
     235          zsqrt  = SQRT( zsal ) 
     236          zsal15  = zsqrt * zsal 
     237          zlogt  = LOG( ztkel ) 
     238          ztr    = 1. / ztkel 
     239          zis    = 19.924 * zsal / ( 1000.- 1.005 * zsal ) 
     240          zis2   = zis * zis 
     241          zisqrt = SQRT( zis ) 
     242          ztc     = tempis(ji,jj,jk) + ( 1.- tmask(ji,jj,jk) ) * 20. 
     243 
     244          ! CHLORINITY (WOOSTER ET AL., 1969) 
     245          zcl     = zsal / 1.80655 
     246 
     247          ! TOTAL SULFATE CONCENTR. [MOLES/kg soln] 
     248          zst     = 0.14 * zcl /96.062 
     249 
     250          ! TOTAL FLUORIDE CONCENTR. [MOLES/kg soln] 
     251          zft     = 0.000067 * zcl /18.9984 
     252 
     253          ! DISSOCIATION CONSTANT FOR SULFATES on free H scale (Dickson 1990) 
     254          zcks    = EXP(-4276.1 * ztr + 141.328 - 23.093 * zlogt         & 
     255          &         + (-13856. * ztr + 324.57 - 47.986 * zlogt) * zisqrt & 
     256          &         + (35474. * ztr - 771.54 + 114.723 * zlogt) * zis    & 
     257          &         - 2698. * ztr * zis**1.5 + 1776.* ztr * zis2         & 
     258          &         + LOG(1.0 - 0.001005 * zsal)) 
     259 
     260          ! DISSOCIATION CONSTANT FOR FLUORIDES on free H scale (Dickson and Riley 79) 
     261          zckf    = EXP( 1590.2*ztr - 12.641 + 1.525*zisqrt   & 
     262          &         + LOG(1.0d0 - 0.001005d0*zsal)            & 
     263          &         + LOG(1.0d0 + zst/zcks)) 
     264 
     265          ! DISSOCIATION CONSTANT FOR CARBONATE AND BORATE 
     266          zckb=  (-8966.90 - 2890.53*zsqrt - 77.942*zsal        & 
     267          &      + 1.728*zsal15 - 0.0996*zsal*zsal)*ztr         & 
     268          &      + (148.0248 + 137.1942*zsqrt + 1.62142*zsal)   & 
     269          &      + (-24.4344 - 25.085*zsqrt - 0.2474*zsal)      &  
     270          &      * zlogt + 0.053105*zsqrt*ztkel 
     271 
     272          ! DISSOCIATION COEFFICIENT FOR CARBONATE ACCORDING TO  
     273          ! MEHRBACH (1973) REFIT BY MILLERO (1995), seawater scale 
     274          zck1    = -1.0*(3633.86*ztr - 61.2172 + 9.6777*zlogt  & 
     275             - 0.011555*zsal + 0.0001152*zsal*zsal) 
     276          zck2    = -1.0*(471.78*ztr + 25.9290 - 3.16967*zlogt      & 
     277             - 0.01781*zsal + 0.0001122*zsal*zsal) 
     278 
     279          ! PKW (H2O) (MILLERO, 1995) from composite data 
     280          zckw    = -13847.26 * ztr + 148.9652 - 23.6521 * zlogt + ( 118.67 * ztr    & 
     281                    - 5.977 + 1.0495 * zlogt ) * zsqrt - 0.01615 * zsal 
     282 
     283          ! CONSTANTS FOR PHOSPHATE (MILLERO, 1995) 
     284         zck1p    = -4576.752*ztr + 115.540 - 18.453*zlogt   & 
     285         &          + (-106.736*ztr + 0.69171) * zsqrt       & 
     286         &          + (-0.65643*ztr - 0.01844) * zsal 
     287 
     288         zck2p    = -8814.715*ztr + 172.1033 - 27.927*zlogt  & 
     289         &          + (-160.340*ztr + 1.3566)*zsqrt          & 
     290         &          + (0.37335*ztr - 0.05778)*zsal 
     291 
     292         zck3p    = -3070.75*ztr - 18.126                    & 
     293         &          + (17.27039*ztr + 2.81197) * zsqrt       & 
     294         &          + (-44.99486*ztr - 0.09984) * zsal  
     295 
     296         ! CONSTANT FOR SILICATE, MILLERO (1995) 
     297         zcksi    = -8904.2*ztr  + 117.400 - 19.334*zlogt   & 
     298         &          + (-458.79*ztr + 3.5913) * zisqrt       & 
     299         &          + (188.74*ztr - 1.5998) * zis           & 
     300         &          + (-12.1652*ztr + 0.07871) * zis2       & 
     301         &          + LOG(1.0 - 0.001005*zsal) 
     302 
     303          ! APPARENT SOLUBILITY PRODUCT K'SP OF CALCITE IN SEAWATER 
     304          !       (S=27-43, T=2-25 DEG C) at pres =0 (atmos. pressure) (MUCCI 1983) 
     305          zaksp0  = -171.9065 -0.077993*ztkel + 2839.319*ztr + 71.595*LOG10( ztkel )   & 
     306             &      + (-0.77712 + 0.00284263*ztkel + 178.34*ztr) * zsqrt  & 
     307             &      - 0.07711*zsal + 0.0041249*zsal15 
     308 
     309          ! CONVERT FROM DIFFERENT PH SCALES 
     310          total2free  = 1.0/(1.0 + zst/zcks) 
     311          free2SWS    = 1. + zst/zcks + zft/(zckf*total2free) 
     312          total2SWS   = total2free * free2SWS 
     313          SWS2total   = 1.0 / total2SWS 
     314 
     315          ! K1, K2 OF CARBONIC ACID, KB OF BORIC ACID, KW (H2O) (LIT.?) 
     316          zak1    = 10**(zck1) * total2SWS 
     317          zak2    = 10**(zck2) * total2SWS 
     318          zakb    = EXP( zckb ) * total2SWS 
     319          zakw    = EXP( zckw ) 
     320          zaksp1  = 10**(zaksp0) 
     321          zak1p   = exp( zck1p ) 
     322          zak2p   = exp( zck2p ) 
     323          zak3p   = exp( zck3p ) 
     324          zaksi   = exp( zcksi ) 
     325          zckf    = zckf * total2SWS 
     326 
     327          ! FORMULA FOR CPEXP AFTER EDMOND & GIESKES (1970) 
     328          !        (REFERENCE TO CULBERSON & PYTKOQICZ (1968) AS MADE 
     329          !        IN BROECKER ET AL. (1982) IS INCORRECT; HERE RGAS IS 
     330          !        TAKEN TENFOLD TO CORRECT FOR THE NOTATION OF pres  IN 
     331          !        DBAR INSTEAD OF BAR AND THE EXPRESSION FOR CPEXP IS 
     332          !        MULTIPLIED BY LN(10.) TO ALLOW USE OF EXP-FUNCTION 
     333          !        WITH BASIS E IN THE FORMULA FOR AKSPP (CF. EDMOND 
     334          !        & GIESKES (1970), P. 1285-1286 (THE SMALL 
     335          !        FORMULA ON P. 1286 IS RIGHT AND CONSISTENT WITH THE 
     336          !        SIGN IN PARTIAL MOLAR VOLUME CHANGE AS SHOWN ON P. 1285)) 
     337          zcpexp  = zpres / (rgas*ztkel) 
     338          zcpexp2 = zpres * zcpexp 
     339 
     340          ! KB OF BORIC ACID, K1,K2 OF CARBONIC ACID PRESSURE 
     341          !        CORRECTION AFTER CULBERSON AND PYTKOWICZ (1968) 
     342          !        (CF. BROECKER ET AL., 1982) 
     343 
     344          zbuf1  = -     ( devk10 + devk20 * ztc + devk30 * ztc * ztc ) 
     345          zbuf2  = 0.5 * ( devk40 + devk50 * ztc ) 
     346          ak13(ji,jj,jk) = zak1 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
     347 
     348          zbuf1  =     - ( devk11 + devk21 * ztc + devk31 * ztc * ztc ) 
     349          zbuf2  = 0.5 * ( devk41 + devk51 * ztc ) 
     350          ak23(ji,jj,jk) = zak2 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
     351 
     352          zbuf1  =     - ( devk12 + devk22 * ztc + devk32 * ztc * ztc ) 
     353          zbuf2  = 0.5 * ( devk42 + devk52 * ztc ) 
     354          akb3(ji,jj,jk) = zakb * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
     355 
     356          zbuf1  =     - ( devk13 + devk23 * ztc + devk33 * ztc * ztc ) 
     357          zbuf2  = 0.5 * ( devk43 + devk53 * ztc ) 
     358          akw3(ji,jj,jk) = zakw * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
     359 
     360          zbuf1  =     - ( devk14 + devk24 * ztc + devk34 * ztc * ztc ) 
     361          zbuf2  = 0.5 * ( devk44 + devk54 * ztc ) 
     362          aks3(ji,jj,jk) = zcks * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
     363 
     364          zbuf1  =     - ( devk15 + devk25 * ztc + devk35 * ztc * ztc ) 
     365          zbuf2  = 0.5 * ( devk45 + devk55 * ztc ) 
     366          akf3(ji,jj,jk) = zckf * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
     367 
     368          zbuf1  =     - ( devk17 + devk27 * ztc + devk37 * ztc * ztc ) 
     369          zbuf2  = 0.5 * ( devk47 + devk57 * ztc ) 
     370          ak1p3(ji,jj,jk) = zak1p * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
     371 
     372          zbuf1  =     - ( devk18 + devk28 * ztc + devk38 * ztc * ztc ) 
     373          zbuf2  = 0.5 * ( devk48 + devk58 * ztc ) 
     374          ak2p3(ji,jj,jk) = zak2p * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
     375 
     376          zbuf1  =     - ( devk19 + devk29 * ztc + devk39 * ztc * ztc ) 
     377          zbuf2  = 0.5 * ( devk49 + devk59 * ztc ) 
     378          ak3p3(ji,jj,jk) = zak3p * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
     379 
     380          zbuf1  =     - ( devk110 + devk210 * ztc + devk310 * ztc * ztc ) 
     381          zbuf2  = 0.5 * ( devk410 + devk510 * ztc ) 
     382          aksi3(ji,jj,jk) = zaksi * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
     383 
     384          ! CONVERT FROM DIFFERENT PH SCALES 
     385          total2free  = 1.0/(1.0 + zst/aks3(ji,jj,jk)) 
     386          free2SWS    = 1. + zst/aks3(ji,jj,jk) + zft/akf3(ji,jj,jk) 
     387          total2SWS   = total2free * free2SWS 
     388          SWS2total   = 1.0 / total2SWS 
     389 
     390          ! Convert to total scale 
     391          ak13(ji,jj,jk)  = ak13(ji,jj,jk)  * SWS2total 
     392          ak23(ji,jj,jk)  = ak23(ji,jj,jk)  * SWS2total 
     393          akb3(ji,jj,jk)  = akb3(ji,jj,jk)  * SWS2total 
     394          akw3(ji,jj,jk)  = akw3(ji,jj,jk)  * SWS2total 
     395          ak1p3(ji,jj,jk) = ak1p3(ji,jj,jk) * SWS2total 
     396          ak2p3(ji,jj,jk) = ak2p3(ji,jj,jk) * SWS2total 
     397          ak3p3(ji,jj,jk) = ak3p3(ji,jj,jk) * SWS2total 
     398          aksi3(ji,jj,jk) = aksi3(ji,jj,jk) * SWS2total 
     399          akf3(ji,jj,jk)  = akf3(ji,jj,jk)  / total2free 
     400 
     401          ! APPARENT SOLUBILITY PRODUCT K'SP OF CALCITE  
     402          !        AS FUNCTION OF PRESSURE FOLLOWING MILLERO 
     403          !        (P. 1285) AND BERNER (1976) 
     404          zbuf1  =     - ( devk16 + devk26 * ztc + devk36 * ztc * ztc ) 
     405          zbuf2  = 0.5 * ( devk46 + devk56 * ztc ) 
     406          aksp(ji,jj,jk) = zaksp1 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
     407 
     408          ! TOTAL F, S, and BORATE CONCENTR. [MOLES/L] 
     409          borat(ji,jj,jk) = 0.0002414 * zcl / 10.811 
     410          sulfat(ji,jj,jk) = zst 
     411          fluorid(ji,jj,jk) = zft  
     412 
     413          ! Iron and SIO3 saturation concentration from ... 
     414          sio3eq(ji,jj,jk) = EXP(  LOG( 10.) * ( 6.44 - 968. / ztkel )  ) * 1.e-6 
     415          fekeq (ji,jj,jk) = 10**( 17.27 - 1565.7 / ztkel )  
     416          ! Liu and Millero (1999) only valid 5 - 50 degC 
     417          ztkel1 = MAX( 5. , tempis(ji,jj,jk) ) + 273.16 
     418          fesol(ji,jj,jk,1) = 10**(-13.486 - 0.1856* zis**0.5 + 0.3073*zis + 5254.0/ztkel1) 
     419          fesol(ji,jj,jk,2) = 10**(2.517 - 0.8885*zis**0.5 + 0.2139 * zis - 1320.0/ztkel1 ) 
     420          fesol(ji,jj,jk,3) = 10**(0.4511 - 0.3305*zis**0.5 - 1996.0/ztkel1 ) 
     421          fesol(ji,jj,jk,4) = 10**(-0.2965 - 0.7881*zis**0.5 - 4086.0/ztkel1 ) 
     422          fesol(ji,jj,jk,5) = 10**(4.4466 - 0.8505*zis**0.5 - 7980.0/ztkel1 ) 
     423      END_3D 
    445424      ! 
    446425      IF( ln_timing )  CALL timing_stop('p4z_che') 
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/PISCES/P4Z/p4zint.F90

    r12377 r13373  
    1919   REAL(wp) ::   xksilim = 16.5e-6_wp   ! Half-saturation constant for the Si half-saturation constant computation 
    2020 
     21#  include "do_loop_substitute.h90" 
    2122   !!---------------------------------------------------------------------- 
    2223   !! NEMO/TOP 4.0 , NEMO Consortium (2018) 
     
    4950      ! Computation of the silicon dependant half saturation  constant for silica uptake 
    5051      ! --------------------------------------------------- 
    51       DO ji = 1, jpi 
    52          DO jj = 1, jpj 
    53             zvar = tr(ji,jj,1,jpsil,Kbb) * tr(ji,jj,1,jpsil,Kbb) 
    54             xksimax(ji,jj) = MAX( xksimax(ji,jj), ( 1.+ 7.* zvar / ( xksilim * xksilim + zvar ) ) * 1e-6 ) 
    55          END DO 
    56       END DO 
     52      DO_2D( 1, 1, 1, 1 ) 
     53         zvar = tr(ji,jj,1,jpsil,Kbb) * tr(ji,jj,1,jpsil,Kbb) 
     54         xksimax(ji,jj) = MAX( xksimax(ji,jj), ( 1.+ 7.* zvar / ( xksilim * xksilim + zvar ) ) * 1e-6 ) 
     55      END_2D 
    5756      ! 
    5857      IF( nday_year == nyear_len(1) ) THEN 
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/PISCES/P4Z/p4zopt.F90

    r13333 r13373  
    3232   REAL(wp) ::   xsi0r       ! 1. /rn_si0 
    3333 
     34  INTEGER  ::   nksr1        ! levels below which the light cannot penetrate ( depth larger than 391 m) 
     35 
    3436   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_par      ! structure of input par 
    35    INTEGER , PARAMETER :: nbtimes = 366  !: maximum number of times record in a file 
    36    INTEGER  :: ntimes_par                ! number of time steps in a file 
    3737   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   par_varsw      ! PAR fraction of shortwave 
    3838   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ekb, ekg, ekr  ! wavelength (Red-Green-Blue) 
     
    279279         pe3(:,:,1) = zqsr(:,:) 
    280280         ! 
    281          DO jk = 2, nksr + 1 
    282             DO jj = 1, jpj 
    283                DO ji = 1, jpi 
    284                   pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -e3t(ji,jj,jk-1,Kmm) * xsi0r ) 
    285                   pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -ekb  (ji,jj,jk-1 )        ) 
    286                   pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -ekg  (ji,jj,jk-1 )        ) 
    287                   pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -ekr  (ji,jj,jk-1 )        ) 
    288                END DO 
    289               ! 
    290             END DO 
    291             ! 
    292          END DO 
     281         DO_3D( 1, 1, 1, 1, 2, nksr1 ) 
     282            pe0(ji,jj,jk) = pe0(ji,jj,jk-1) * EXP( -e3t(ji,jj,jk-1,Kmm) * xsi0r ) 
     283            pe1(ji,jj,jk) = pe1(ji,jj,jk-1) * EXP( -ekb  (ji,jj,jk-1 )        ) 
     284            pe2(ji,jj,jk) = pe2(ji,jj,jk-1) * EXP( -ekg  (ji,jj,jk-1 )        ) 
     285            pe3(ji,jj,jk) = pe3(ji,jj,jk-1) * EXP( -ekr  (ji,jj,jk-1 )        ) 
     286         END_3D 
    293287        ! 
    294288      ELSE   ! T- level 
     
    331325      ! Compute par_varsw at nit000 or only if there is more than 1 time record in par coefficient file 
    332326      IF( ln_varpar ) THEN 
    333          IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_par > 1 ) ) THEN 
    334             CALL fld_read( kt, 1, sf_par ) 
    335             par_varsw(:,:) = ( sf_par(1)%fnow(:,:,1) ) / 3.0 
    336          ENDIF 
     327         CALL fld_read( kt, 1, sf_par ) 
     328         par_varsw(:,:) = ( sf_par(1)%fnow(:,:,1) ) / 3.0 
    337329      ENDIF 
    338330      ! 
     
    377369      xparsw = parlux / 3.0 
    378370      xsi0r  = 1.e0 / rn_si0 
     371      nksr1  = nksr + 1 
    379372      ! 
    380373      ! Variable PAR at the surface of the ocean 
     
    392385                                   ALLOCATE( sf_par(1)%fnow(jpi,jpj,1)   ) 
    393386         IF( sn_par%ln_tint )      ALLOCATE( sf_par(1)%fdta(jpi,jpj,1,2) ) 
    394  
    395          CALL iom_open (  TRIM( sn_par%clname ) , numpar ) 
    396          ntimes_par = iom_getszuld( numpar )   ! get number of record in file 
    397387      ENDIF 
    398388      ! 
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/PISCES/P4Z/p4zsms.F90

    r13295 r13373  
    1111   USE oce_trc         ! shared variables between ocean and passive tracers 
    1212   USE trc             ! passive tracers common variables  
    13    USE trcdta          !  
    1413   USE sms_pisces      ! PISCES Source Minus Sink variables 
    1514   USE p4zbio          ! Biological model 
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/PISCES/SED/oce_sed.F90

    r13237 r13373  
    88   !!---------------------------------------------------------------------- 
    99   USE par_sed 
     10   USE par_trc , ONLY : rtrn  => rtrn 
     11   USE par_pisces 
    1012   USE timing 
    11    USE par_trc 
    1213 
    1314   USE dom_oce , ONLY :   glamt     =>   glamt          !: longitude of t-point (degre) 
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/PISCES/SED/par_sed.F90

    r10222 r13373  
    2020      jp_sal   =>   jp_sal     !: indice of salintity 
    2121 
    22    INTEGER, PARAMETER :: jpdta = 17 
     22   INTEGER, PUBLIC, PARAMETER :: jpdta = 17 
    2323 
    2424   ! Vertical sediment geometry 
    25    INTEGER, PUBLIC   ::      & 
    26       jpksed   = 11 ,        & 
    27       jpksedm1 = 10 
     25   INTEGER, PUBLIC  :: jpksed  = 11  
     26   INTEGER, PUBLIC  :: jpksedm1  
    2827 
    2928   ! sediment tracer species 
    30    INTEGER, PARAMETER ::    & 
     29   INTEGER, PUBLIC, PARAMETER ::    & 
    3130      jpsol =  8,           &  !: number of solid component 
    3231      jpwat = 10,           &   !: number of pore water component 
     
    3635    
    3736   ! pore water components        
    38    INTEGER, PARAMETER :: & 
     37   INTEGER, PUBLIC, PARAMETER :: & 
    3938      jwsil  = 1,        & !: silic acid 
    4039      jwoxy  = 2,        & !: oxygen 
     
    4948 
    5049   ! solid components        
    51    INTEGER, PARAMETER ::  & 
     50   INTEGER, PUBLIC, PARAMETER ::  & 
    5251      jsopal  = 1,        & !: opal sediment 
    5352      jsclay  = 2,        & !: clay 
     
    5958      jsfes   = 8           !: FeS 
    6059 
    61    INTEGER, PARAMETER ::  & 
     60   INTEGER, PUBLIC, PARAMETER ::  & 
    6261      jptrased   = jpsol + jpwat , & 
    6362      jpdia3dsed = 2             , & 
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/PISCES/SED/sed.F90

    r10425 r13373  
    77   !!        !  06-12  (C. Ethe)  Orignal 
    88   !!---------------------------------------------------------------------- 
    9    USE par_sed 
    109   USE oce_sed 
    1110   USE in_out_manager 
     
    6362   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::  solcp      !: solid sediment data at given time-step 
    6463   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::  solcp0     !: solid sediment data at initial time 
    65    REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::  trc_dta 
    6664   REAL(wp), PUBLIC, DIMENSION(:,:,:), ALLOCATABLE ::  diff 
    6765 
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/PISCES/SED/sedarr.F90

    r10222 r13373  
    1010   !!---------------------------------------------------------------------- 
    1111   !! * Modules used 
     12   USE par_oce 
    1213   USE par_sed 
    13    USE dom_oce 
    14    USE sed 
     14   USE in_out_manager, ONLY : ln_timing 
     15   USE timing 
    1516 
    1617   IMPLICIT NONE 
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/PISCES/SED/sedchem.F90

    r13295 r13373  
    66   !!====================================================================== 
    77   !!   modules used 
     8   USE par_sed 
    89   USE sed     ! sediment global variable 
    910   USE sedarr 
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/PISCES/SED/sedini.F90

    r13295 r13373  
    99   !!---------------------------------------------------------------------- 
    1010   !! * Modules used 
     11   USE par_trc        ! need jptra, number of passive tracers 
     12   USE par_sed 
    1113   USE sed     ! sediment global variable 
    1214   USE sed_oce 
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/PISCES/SED/sedwri.F90

    r12489 r13373  
    44   !!         Sediment diagnostics :  write sediment output files 
    55   !!====================================================================== 
     6   USE par_sed 
    67   USE sed 
    78   USE sedarr 
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/PISCES/SED/trcdmp_sed.F90

    r13295 r13373  
    9191               ! 
    9292               jl = n_trc_index(jn)  
    93                CALL trc_dta( kt, Kmm, sf_trcdta(jl), rf_trfac(jl), ztrcdta )   ! read tracer data at nit000 
     93               CALL trc_dta( kt, jl, ztrcdta )   ! read tracer data at nit000 
    9494               ! 
    9595               DO_2D( 1, 1, 1, 1 ) 
     
    108108         WRITE(charout, FMT="('dmp ')") 
    109109         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    110          CALL prt_ctl( tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm, clinfo3='trd' ) 
     110         CALL prt_ctl( tab4d_1=tr(:,:,:,:,Krhs), mask1=tmask, clinfo=ctrcnm,clinfo3='trd' ) 
    111111      ENDIF 
    112112      ! 
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/PISCES/trcini_pisces.F90

    r12377 r13373  
    7979      ! 
    8080      INTEGER, INTENT(in)  ::  Kmm      ! time level indices 
    81       REAL(wp), SAVE ::   sco2   =  2.312e-3_wp 
    82       REAL(wp), SAVE ::   alka0  =  2.426e-3_wp 
    83       REAL(wp), SAVE ::   oxyg0  =  177.6e-6_wp  
    84       REAL(wp), SAVE ::   po4    =  2.165e-6_wp  
    85       REAL(wp), SAVE ::   bioma0 =  1.000e-8_wp   
    86       REAL(wp), SAVE ::   silic1 =  91.51e-6_wp   
    87       REAL(wp), SAVE ::   no3    =  30.9e-6_wp * 7.625_wp 
    8881      ! 
    8982      INTEGER  ::  ji, jj, jk, jn, ierr 
    9083      REAL(wp) ::  zcaralk, zbicarb, zco3 
    9184      REAL(wp) ::  ztmas, ztmas1 
     85      REAL(wp) ::  sco2, alka0, oxyg0, po4, bioma0, silic1, no3    
    9286      CHARACTER(len = 20)  ::  cltra 
    9387      !!---------------------------------------------------------------------- 
     
    10397         ENDIF 
    10498      ENDIF 
     99      ! 
     100      sco2   =  2.312e-3_wp 
     101      alka0  =  2.426e-3_wp 
     102      oxyg0  =  177.6e-6_wp  
     103      po4    =  2.165e-6_wp  
     104      bioma0 =  1.000e-8_wp   
     105      silic1 =  91.51e-6_wp   
     106      no3    =  30.9e-6_wp * 7.625_wp 
    105107      ! 
    106108      ! Allocate PISCES arrays 
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/TRP/trcadv.F90

    r13286 r13373  
    1616   !!   trc_adv_ini   : control the different options of advection scheme 
    1717   !!---------------------------------------------------------------------- 
     18   USE par_trc        ! need jptra, number of passive tracers 
    1819   USE oce_trc        ! ocean dynamics and active tracers 
    1920   USE trc            ! ocean passive tracers variables 
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/TRP/trcatf.F90

    r13295 r13373  
    2727   !!   trc_atf     : time stepping on passive tracers 
    2828   !!---------------------------------------------------------------------- 
     29   USE par_trc        ! need jptra, number of passive tracers 
    2930   USE oce_trc         ! ocean dynamics and tracers variables 
    3031   USE trc             ! ocean passive tracers variables 
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/TRP/trcbbl.F90

    r13286 r13373  
    2020   !!    trc_bbl      : update the tracer trends due to the bottom boundary layer (advective and/or diffusive) 
    2121   !!---------------------------------------------------------------------- 
     22   USE par_trc        ! need jptra, number of passive tracers 
    2223   USE oce_trc        ! ocean dynamics and passive tracers variables 
    2324   USE trc            ! ocean passive tracers variables 
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/TRP/trcdmp.F90

    r13295 r13373  
    1616   !!   trc_dmp_init : initialization, namlist read, parameters control 
    1717   !!---------------------------------------------------------------------- 
     18   USE par_trc        ! need jptra, number of passive tracers 
    1819   USE oce_trc         ! ocean dynamics and tracers variables 
    1920   USE trc             ! ocean passive tracers variables 
     
    108109               ! 
    109110               jl = n_trc_index(jn)  
    110                CALL trc_dta( kt, Kmm, sf_trcdta(jl), rf_trfac(jl), ztrcdta )   ! read tracer data at nit000 
     111               CALL trc_dta( kt, jl, ztrcdta )   ! read tracer data at nit000 
    111112               ! 
    112113               SELECT CASE ( nn_zdmp_tr ) 
     
    350351            IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file 
    351352                jl = n_trc_index(jn) 
    352                 CALL trc_dta( kt, Kmm, sf_trcdta(jl), rf_trfac(jl), ztrcdta )   ! read tracer data at nit000 
     353                CALL trc_dta( kt, jl, ztrcdta )   ! read tracer data at nit000 
    353354                DO jc = 1, npncts 
    354355                   DO jk = 1, jpkm1 
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/TRP/trcldf.F90

    r13295 r13373  
    1515   !!   trc_ldf_ini   : initialization, namelist read, and parameters control 
    1616   !!---------------------------------------------------------------------- 
     17   USE par_trc        ! need jptra, number of passive tracers 
    1718   USE trc            ! ocean passive tracers variables 
    1819   USE oce_trc        ! ocean dynamics and active tracers 
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/TRP/trcsbc.F90

    r13295 r13373  
    1616   !!   trc_sbc      : update the tracer trend at ocean surface 
    1717   !!---------------------------------------------------------------------- 
     18   USE par_trc        ! need jptra, number of passive tracers 
    1819   USE oce_trc         ! ocean dynamics and active tracers variables 
    1920   USE trc             ! ocean  passive tracers variables 
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/TRP/trctrp.F90

    r12377 r13373  
    1313   !!   trc_trp        : passive tracer transport 
    1414   !!---------------------------------------------------------------------- 
     15   USE par_trc         ! need jptra, number of passive tracers 
    1516   USE oce_trc         ! ocean dynamics and active tracers variables 
    1617   USE trc             ! ocean passive tracers variables  
     
    2728   USE bdy_oce   , ONLY: ln_bdy 
    2829   USE trcbdy          ! BDY open boundaries 
     30   USE in_out_manager 
    2931 
    3032#if defined key_agrif 
     
    6264      IF( .NOT. lk_c1d ) THEN 
    6365         ! 
     66         !                                                         ! Partial top/bottom cell: GRADh( trb )   
     67         IF( ln_zps ) THEN 
     68            IF( ln_isfcav ) THEN ; CALL zps_hde_isf( kt, Kmm, jptra, tr(:,:,:,:,Kbb), pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi )  ! both top & bottom 
     69            ELSE                 ; CALL zps_hde    ( kt, Kmm, jptra, tr(:,:,:,:,Kbb), gtru, gtrv )                                      !  only bottom 
     70            ENDIF 
     71         ENDIF 
     72         ! 
    6473                                CALL trc_sbc    ( kt,      Kmm, tr, Krhs )      ! surface boundary condition 
    6574         IF( ln_trcbc .AND. lltrcbc .AND. kt /= nit000 )  & 
     
    6877         IF( ln_trcdmp )        CALL trc_dmp    ( kt, Kbb, Kmm, tr, Krhs )      ! internal damping trends 
    6978         IF( ln_bdy )           CALL trc_bdy_dmp( kt, Kbb,      Krhs )      ! BDY damping trends 
    70                                 CALL trc_adv    ( kt, Kbb, Kmm, tr, Krhs )      ! horizontal & vertical advection  
    71          !                                                         ! Partial top/bottom cell: GRADh( trb )   
    72          IF( ln_zps ) THEN 
    73            IF( ln_isfcav ) THEN ; CALL zps_hde_isf( kt, Kmm, jptra, tr(:,:,:,:,Kbb), pgtu=gtru, pgtv=gtrv, pgtui=gtrui, pgtvi=gtrvi )  ! both top & bottom 
    74            ELSE                 ; CALL zps_hde    ( kt, Kmm, jptra, tr(:,:,:,:,Kbb), gtru, gtrv )                                      !  only bottom 
    75            ENDIF 
    76          ENDIF 
    77          !                                                       
    78                                 CALL trc_ldf    ( kt, Kbb, Kmm,       tr, Krhs )  ! lateral mixing 
    7979#if defined key_agrif 
    8080         IF(.NOT. Agrif_Root()) CALL Agrif_Sponge_trc       ! tracers sponge 
    8181#endif 
     82                                CALL trc_adv    ( kt, Kbb, Kmm, tr, Krhs )      ! horizontal & vertical advection  
     83                                CALL trc_ldf    ( kt, Kbb, Kmm,       tr, Krhs )  ! lateral mixing 
    8284                                CALL trc_zdf    ( kt, Kbb, Kmm, Krhs, tr, Kaa  )  ! vert. mixing & after tracer   ==> after 
    8385                                CALL trc_atf    ( kt, Kbb, Kmm, Kaa , tr )        ! time filtering of "now" tracer fields     
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/TRP/trczdf.F90

    r13286 r13373  
    1414   !!   trc_zdf      : update the tracer trend with the vertical diffusion 
    1515   !!---------------------------------------------------------------------- 
     16   USE par_trc        ! need jptra, number of passive tracers 
    1617   USE trc           ! ocean passive tracers variables 
    1718   USE oce_trc       ! ocean dynamics and active tracers 
    1819   USE trd_oce       ! trends: ocean variables 
    1920   USE trazdf        ! tracer: vertical diffusion 
    20 !!gm do we really need this ? 
    21    USE trcldf        ! passive tracers: lateral diffusion 
    22 !!gm 
    2321   USE trdtra        ! trends manager: tracers  
    2422   USE prtctl        ! Print control 
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/trcdta.F90

    r13295 r13373  
    3131   PUBLIC   trc_dta_ini     ! called in trcini.F90  
    3232 
    33    INTEGER  , SAVE, PUBLIC                             :: nb_trcdta   ! number of tracers to be initialised with data 
    34    INTEGER  , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: n_trc_index ! indice of tracer which is initialised with data 
    35    INTEGER  , SAVE, PUBLIC                             :: ntra        ! MAX( 1, nb_trcdta ) to avoid compilation error with bounds checking 
    36    REAL(wp) , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: rf_trfac    ! multiplicative factor for tracer values 
    37 !$AGRIF_DO_NOT_TREAT 
    38    TYPE(FLD), SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: sf_trcdta   ! structure of input SST (file informations, fields read) 
    39 !$AGRIF_END_DO_NOT_TREAT 
     33   INTEGER  , PUBLIC                             :: nb_trcdta   ! number of tracers to be initialised with data 
     34   INTEGER  , PUBLIC, ALLOCATABLE, DIMENSION(:)  :: n_trc_index ! indice of tracer which is initialised with data 
     35   INTEGER  , PUBLIC                             :: ntra        ! MAX( 1, nb_trcdta ) to avoid compilation error with bounds checking 
     36   REAL(wp) ,         ALLOCATABLE, DIMENSION(:)  :: rf_trfac    ! multiplicative factor for tracer values 
     37   TYPE(FLD),         ALLOCATABLE, DIMENSION(:)  :: sf_trcdta   ! structure of input SST (file informations, fields read) 
    4038 
    4139   !! Substitutions 
     
    155153 
    156154 
    157    SUBROUTINE trc_dta( kt, Kmm, sf_trcdta, ptrcfac, ptrcdta) 
     155   SUBROUTINE trc_dta( kt, kjl, ptrcdta) 
    158156      !!---------------------------------------------------------------------- 
    159157      !!                   ***  ROUTINE trc_dta  *** 
     
    168166      !!---------------------------------------------------------------------- 
    169167      INTEGER                          , INTENT(in   )   ::   kt         ! ocean time-step 
    170       INTEGER                          , INTENT(in   )   ::   Kmm        ! time level index 
    171       TYPE(FLD), DIMENSION(1)          , INTENT(inout)   ::   sf_trcdta  ! array of information on the field to read 
    172       REAL(wp)                         , INTENT(in   )   ::   ptrcfac    ! multiplication factor 
     168      INTEGER                          , INTENT(in   )   ::   kjl        ! tracer index 
    173169      REAL(wp),  DIMENSION(jpi,jpj,jpk), INTENT(inout  ) ::   ptrcdta    ! 3D data array 
    174170      ! 
     
    191187         ! read data at kt time step 
    192188         CALL fld_read( kt, 1, sf_trcdta ) 
    193          ptrcdta(:,:,:) = sf_trcdta(1)%fnow(:,:,:) * tmask(:,:,:) 
     189         ptrcdta(:,:,:) = sf_trcdta(kjl)%fnow(:,:,:) * tmask(:,:,:) 
    194190         !  
    195191         IF( ln_sco ) THEN                !== s- or mixed s-zps-coordinate  ==! 
     
    201197            DO_2D( 1, 1, 1, 1 ) 
    202198               DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points 
    203                   zl = gdept(ji,jj,jk,Kmm) 
     199                  zl = gdept_0(ji,jj,jk) 
    204200                  IF(     zl < gdept_1d(1  ) ) THEN         ! above the first level of data 
    205201                     ztp(jk) = ptrcdta(ji,jj,1) 
     
    223219         ELSE                                !==   z- or zps- coordinate   ==! 
    224220            ! zps-coordinate (partial steps) interpolation at the last ocean level 
    225 !            IF( ln_zps ) THEN 
    226 !               DO jj = 1, jpj 
    227 !                  DO ji = 1, jpi 
    228 !                     ik = mbkt(ji,jj)  
    229 !                     IF( ik > 1 ) THEN 
    230 !                        zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 
    231 !                        ptrcdta(ji,jj,ik) = (1.-zl) * ptrcdta(ji,jj,ik) + zl * ptrcdta(ji,jj,ik-1) 
    232 !                     ENDIF 
    233 !                     ik = mikt(ji,jj) 
    234 !                     IF( ik > 1 ) THEN 
    235 !                        zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) ) 
    236 !                        ptrcdta(ji,jj,ik) = (1.-zl) * ptrcdta(ji,jj,ik) + zl * ptrcdta(ji,jj,ik+1) 
    237 !                     ENDIF 
    238 !                  END DO 
    239 !              END DO 
    240 !            ENDIF 
     221            IF( ln_zps ) THEN 
     222                DO_2D( 1, 1, 1, 1 ) 
     223                   ik = mbkt(ji,jj) 
     224                   IF( ik > 1 ) THEN 
     225                      zl = ( gdept_1d(ik) - gdept_0(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 
     226                      ptrcdta(ji,jj,ik) = (1.-zl) * ptrcdta(ji,jj,ik) + zl * ptrcdta(ji,jj,ik-1) 
     227                   ENDIF 
     228                   ik = mikt(ji,jj) 
     229                   IF( ik > 1 ) THEN 
     230                      zl = ( gdept_0(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) ) 
     231                      ptrcdta(ji,jj,ik) = (1.-zl) * ptrcdta(ji,jj,ik) + zl * ptrcdta(ji,jj,ik+1) 
     232                   ENDIF 
     233                 END_2D 
     234            ENDIF 
    241235            ! 
    242236         ENDIF 
    243          ! 
    244237         ! Scale by multiplicative factor 
    245          ptrcdta(:,:,:) = ptrcdta(:,:,:) * ptrcfac 
     238         ptrcdta(:,:,:) = ptrcdta(:,:,:) * rf_trfac(kjl) 
    246239         ! 
    247240      ENDIF 
     
    256249   !!---------------------------------------------------------------------- 
    257250CONTAINS 
    258    SUBROUTINE trc_dta( kt, sf_trcdta, ptrcfac, ptrcdta)        ! Empty routine 
     251   SUBROUTINE trc_dta( kt, kjl, ptrcdta)        ! Empty routine 
    259252      WRITE(*,*) 'trc_dta: You should not have seen this print! error?', kt 
    260253   END SUBROUTINE trc_dta 
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/trcice.F90

    r12377 r13373  
    1212   !!   trc_ice       :  Call the appropriate sea ice tracer subroutine 
    1313   !!---------------------------------------------------------------------- 
     14   USE par_trc         ! need jptra, number of passive tracers 
    1415   USE oce_trc        ! shared variables between ocean and passive tracers 
    1516   USE trc            ! passive tracers common variables 
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/trcini.F90

    r13286 r13373  
    1616   !!   top_alloc :   allocate the TOP arrays 
    1717   !!---------------------------------------------------------------------- 
     18   USE par_trc         ! need jptra, number of passive tracers 
    1819   USE oce_trc         ! shared variables between ocean and passive tracers 
    1920   USE trc             ! passive tracers common variables 
     
    9596      CHARACTER (len=25) :: charout 
    9697      REAL(wp), DIMENSION(jpi,jpj,jpk,jptra) :: zzmsk 
    97       CHARACTER (len=25), DIMENSION(jptra) :: clseb   
    9898      !!---------------------------------------------------------------------- 
    9999      ! 
     
    131131         CALL prt_ctl_info( charout, cdcomp = 'top' ) 
    132132         CALL prt_ctl( tab4d_1=tr(:,:,:,:,Kmm), mask1=tmask, clinfo=ctrcnm ) 
    133          DO jn = 1, jptra 
    134             zzmsk(:,:,:,jn) = tmask(:,:,:) 
    135             WRITE(clseb(jn),'(a,i2.2)') 'seb ', jn 
    136          END DO 
    137          CALL prt_ctl( tab4d_1=zzmsk, mask1=tmask, clinfo=clseb ) 
    138133      ENDIF 
    1391349000  FORMAT('      tracer nb : ',i2,'      name :',a10,'      initial content :',e18.10) 
     
    254249        ! 
    255250      ELSE                             ! Initialisation of tracer from a file that may also be used for damping 
    256 !!gm BUG ?   if damping and restart, what's happening ? 
    257251        IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN 
    258252            ! update passive tracers arrays with input data read from file 
     
    260254               IF( ln_trc_ini(jn) ) THEN 
    261255                  jl = n_trc_index(jn)  
    262                   CALL trc_dta( nit000, Kmm, sf_trcdta(jl), rf_trfac(jl), tr(:,:,:,jn,Kmm) ) 
    263                   ! 
    264                   ! deallocate data structure if data are not used for damping 
    265                   IF( .NOT.ln_trcdmp .AND. .NOT.ln_trcdmp_clo ) THEN 
    266                      IF(lwp) WRITE(numout,*) 'trc_ini_state: deallocate data arrays as they are only used to initialize the run' 
    267                                                   DEALLOCATE( sf_trcdta(jl)%fnow ) 
    268                      IF( sf_trcdta(jl)%ln_tint )  DEALLOCATE( sf_trcdta(jl)%fdta ) 
    269                      ! 
    270                   ENDIF 
     256                  CALL trc_dta( nit000, jl, tr(:,:,:,jn,Kmm) ) 
    271257               ENDIF 
    272258            END DO 
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/trcnam.F90

    r12489 r13373  
    1818   !!   trc_nam    :  Read and print options for the passive tracer run (namelist) 
    1919   !!---------------------------------------------------------------------- 
     20   USE par_trc        ! need jptra, number of passive tracers 
    2021   USE oce_trc     ! shared variables between ocean and passive tracers 
    2122   USE trc         ! passive tracers common variables 
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/trcrst.F90

    r13286 r13373  
    1919   !!   trc_rst_wri    : write restart file 
    2020   !!---------------------------------------------------------------------- 
     21   USE par_trc        ! need jptra, number of passive tracers 
    2122   USE oce_trc 
    2223   USE trc 
  • NEMO/branches/2020/dev_r13333_TOP-05_Ethe_Agrif/src/TOP/trcstp.F90

    r13286 r13373  
    1111   !!   trc_stp       : passive tracer system time-stepping 
    1212   !!---------------------------------------------------------------------- 
     13   USE par_trc        ! need jptra, number of passive tracers 
    1314   USE oce_trc        ! ocean dynamics and active tracers variables 
    1415   USE sbc_oce 
Note: See TracChangeset for help on using the changeset viewer.