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 1808 – NEMO

Changeset 1808


Ignore:
Timestamp:
2010-03-11T10:17:56+01:00 (14 years ago)
Author:
cetlod
Message:

update TOP_SRC component on CMIP5_IPSL branch to take into account bugfixes (ie vertical diffusion routines), re-organization of restart part, damping of passive tracers on closed seas for PISCES

Location:
branches/CMIP5_IPSL/NEMO
Files:
5 added
29 edited

Legend:

Unmodified
Added
Removed
  • branches/CMIP5_IPSL/NEMO/OFF_SRC/DOM/domrea.F90

    r1641 r1808  
    215215 
    216216  
    217          DO jk = 1,jpk 
    218             gdept(:,:,jk) = gdept_0(jk) 
    219             gdepw(:,:,jk) = gdepw_0(jk) 
    220          END DO 
    221           
    222  
    223217         IF( ln_zps ) THEN    
     218            ! Vertical coordinates and scales factors 
     219            CALL iom_get( inum4, jpdom_unknown, 'gdept_0', gdept_0 ) ! depth 
     220            CALL iom_get( inum4, jpdom_unknown, 'gdepw_0', gdepw_0 ) 
     221            CALL iom_get( inum4, jpdom_unknown, 'e3t_0'  , e3t_0   ) 
     222            CALL iom_get( inum4, jpdom_unknown, 'e3w_0'  , e3w_0   ) 
    224223                                      ! z-coordinate - partial steps 
    225224            IF( nmsh <= 6 ) THEN                                   !    ! 3D vertical scale factors 
     
    233232            END IF 
    234233 
    235             IF( nmsh <= 3 ) THEN                                   !    ! 3D depth 
     234            IF( iom_varid( inum4, 'gdept', ldstop = .FALSE. ) > 0 ) THEN 
    236235              CALL iom_get( inum4, jpdom_data, 'gdept', gdept ) ! scale factors 
    237236              CALL iom_get( inum4, jpdom_data, 'gdepw', gdepw ) 
     
    240239              CALL iom_get( inum4, jpdom_data, 'hdepw', hdepw ) 
    241240          
     241              DO jk = 1,jpk 
     242                gdept(:,:,jk) = gdept_0(jk) 
     243                gdepw(:,:,jk) = gdepw_0(jk) 
     244              ENDDO 
     245 
    242246              DO jj = 1, jpj 
    243247                DO ji = 1, jpi 
     
    252256                END DO 
    253257              END DO 
     258 
    254259            ENDIF 
    255260 
    256261         ENDIF 
    257          ! Vertical coordinates and scales factors 
    258          CALL iom_get( inum4, jpdom_unknown, 'gdept_0', gdept_0 ) ! depth 
    259          CALL iom_get( inum4, jpdom_unknown, 'gdepw_0', gdepw_0 ) 
    260          CALL iom_get( inum4, jpdom_unknown, 'e3t_0'  , e3t_0   ) 
    261          CALL iom_get( inum4, jpdom_unknown, 'e3w_0'  , e3w_0   ) 
    262262# endif 
    263263         IF( ln_zco ) THEN 
  • branches/CMIP5_IPSL/NEMO/TOP_SRC/C14b/trclsm_c14b.F90

    r1581 r1808  
    4444      INTEGER ::   numnatb 
    4545 
    46 #if defined key_trc_diaadd 
     46#if defined key_trc_diaadd && ! defined key_iomput 
    4747      ! definition of additional diagnostic as a structure 
    4848      INTEGER ::   jl, jn 
     
    5858      !! 
    5959      NAMELIST/namc14date/ ndate_beg_b, nyear_res_b 
    60 #if defined key_trc_diaadd 
     60#if defined key_trc_diaadd && ! defined key_iomput 
    6161      NAMELIST/namc14dia/nwritedia, c14dia2d, c14dia3d     ! additional diagnostics 
    6262#endif 
     
    8181      IF(lwp) WRITE(numout,*) '    initial year (aa)                  nyear_beg_b = ', nyear_beg_b 
    8282      ! 
    83 #if defined key_trc_diaadd 
     83#if defined key_trc_diaadd && ! defined key_iomput 
    8484 
    8585      ! Namelist namc14dia 
  • branches/CMIP5_IPSL/NEMO/TOP_SRC/CFC/trcctl_cfc.F90

    r1255 r1808  
    4444      IF( jp_cfc > 2) THEN  
    4545          IF(lwp) THEN  
    46               WRITE (numout,*) ' ===>>>> : w a r n i n g ' 
    47               WRITE (numout,*) ' =======   ============= ' 
     46              WRITE (numout,*) ' ===>>>> : w a r n i n g <<<<===' 
    4847              WRITE (numout,*)                             & 
    4948              &   ' STOP, change jp_cfc to 1 or 2 in par_CFC module '   
     
    6261 
    6362      IF(lwp) THEN 
    64          WRITE (numout,*) ' ===>>>> : w a r n i n g ' 
    65          WRITE (numout,*) ' =======   ============= ' 
     63         WRITE (numout,*) ' ===>>>> : w a r n i n g <<<<===' 
    6664         WRITE (numout,*) ' we force tracer names' 
    6765         DO jl = 1, jp_cfc 
     
    8078            ctrcun(jn) = 'mole/m3' 
    8179            IF(lwp) THEN 
    82                WRITE (numout,*) ' ===>>>> : w a r n i n g ' 
    83                WRITE (numout,*) ' =======   ============= ' 
     80               WRITE (numout,*) ' ===>>>> : w a r n i n g <<<<===' 
    8481               WRITE (numout,*) ' we force tracer unit' 
    8582               WRITE(numout,*) ' tracer  ',ctrcnm(jn), 'UNIT= ',ctrcun(jn) 
  • branches/CMIP5_IPSL/NEMO/TOP_SRC/CFC/trclsm_cfc.F90

    r1581 r1808  
    4343      !!---------------------------------------------------------------------- 
    4444      INTEGER ::   numnatc 
    45 #if defined key_trc_diaadd 
     45#if defined key_trc_diaadd && ! defined key_iomput 
    4646      ! definition of additional diagnostic as a structure 
    4747      INTEGER :: jl, jn 
     
    5656      !! 
    5757      NAMELIST/namcfcdate/ ndate_beg, nyear_res 
    58 #if defined key_trc_diaadd 
     58#if defined key_trc_diaadd && ! defined key_iomput 
    5959      NAMELIST/namcfcdia/nwritedia, cfcdia2d     ! additional diagnostics 
    6060#endif 
     
    7979      IF(lwp) WRITE(numout,*) '    initial year (aa)                       nyear_beg = ', nyear_beg 
    8080      ! 
    81 #if defined key_trc_diaadd 
     81#if defined key_trc_diaadd && ! defined key_iomput 
    8282 
    8383      ! Namelist namcfcdia 
  • branches/CMIP5_IPSL/NEMO/TOP_SRC/LOBSTER/trcbio.F90

    r1457 r1808  
    482482      ENDIF 
    483483 
     484      IF( l_trdtrc ) DEALLOCATE( ztrbio ) 
     485 
    484486      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    485487         WRITE(charout, FMT="('bio')") 
  • branches/CMIP5_IPSL/NEMO/TOP_SRC/LOBSTER/trcexp.F90

    r1457 r1808  
    164164      ENDIF 
    165165 
     166      IF( l_trdtrc ) DEALLOCATE( ztrbio ) 
     167 
    166168      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    167169         WRITE(charout, FMT="('exp')") 
  • branches/CMIP5_IPSL/NEMO/TOP_SRC/LOBSTER/trcini_lobster.F90

    r1542 r1808  
    2626   PUBLIC   trc_ini_lobster   ! called by trcini.F90 module 
    2727 
    28 #  include "domzgr_substitute.h90" 
    2928#  include "top_substitute.h90" 
    3029   !!---------------------------------------------------------------------- 
  • branches/CMIP5_IPSL/NEMO/TOP_SRC/LOBSTER/trcopt.F90

    r1445 r1808  
    2828 
    2929   !!* Substitution 
    30 #  include "domzgr_substitute.h90" 
     30#  include "top_substitute.h90" 
    3131   !!---------------------------------------------------------------------- 
    3232   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
  • branches/CMIP5_IPSL/NEMO/TOP_SRC/LOBSTER/trcsed.F90

    r1457 r1808  
    2929 
    3030   !!* Substitution 
    31 #  include "domzgr_substitute.h90" 
     31#  include "top_substitute.h90" 
    3232   !!---------------------------------------------------------------------- 
    3333   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
     
    136136      ENDIF 
    137137 
     138      IF( l_trdtrc ) DEALLOCATE( ztrbio ) 
     139 
    138140      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    139141         WRITE(charout, FMT="('sed')") 
  • branches/CMIP5_IPSL/NEMO/TOP_SRC/PISCES/p4zbio.F90

    r1678 r1808  
    3939 
    4040   !!* Substitution 
    41 #  include "domzgr_substitute.h90" 
     41#  include "top_substitute.h90" 
    4242   !!---------------------------------------------------------------------- 
    4343   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
  • branches/CMIP5_IPSL/NEMO/TOP_SRC/PISCES/p4zche.F90

    r1180 r1808  
    147147 
    148148   !!* Substitution 
    149 #include "domzgr_substitute.h90" 
     149#include "top_substitute.h90" 
    150150   !!---------------------------------------------------------------------- 
    151151   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
  • branches/CMIP5_IPSL/NEMO/TOP_SRC/PISCES/p4zflx.F90

    r1737 r1808  
    5252 
    5353   !!* Substitution 
    54 #  include "domzgr_substitute.h90" 
     54#  include "top_substitute.h90" 
    5555   !!---------------------------------------------------------------------- 
    5656   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
  • branches/CMIP5_IPSL/NEMO/TOP_SRC/PISCES/p4zlim.F90

    r1152 r1808  
    4141 
    4242   !!* Substitution 
    43 #  include "domzgr_substitute.h90" 
     43#  include "top_substitute.h90" 
    4444   !!---------------------------------------------------------------------- 
    4545   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
  • branches/CMIP5_IPSL/NEMO/TOP_SRC/PISCES/p4zmeso.F90

    r1736 r1808  
    4545 
    4646   !!* Substitution 
    47 #  include "domzgr_substitute.h90" 
     47#  include "top_substitute.h90" 
    4848   !!---------------------------------------------------------------------- 
    4949   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
  • branches/CMIP5_IPSL/NEMO/TOP_SRC/PISCES/p4zmicro.F90

    r1736 r1808  
    4343 
    4444   !!* Substitution 
    45 #  include "domzgr_substitute.h90" 
     45#  include "top_substitute.h90" 
    4646   !!---------------------------------------------------------------------- 
    4747   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
  • branches/CMIP5_IPSL/NEMO/TOP_SRC/PISCES/p4zmort.F90

    r1736 r1808  
    4141 
    4242   !!* Substitution 
    43 #  include "domzgr_substitute.h90" 
     43#  include "top_substitute.h90" 
    4444   !!---------------------------------------------------------------------- 
    4545   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
  • branches/CMIP5_IPSL/NEMO/TOP_SRC/PISCES/p4zopt.F90

    r1678 r1808  
    3535    
    3636   !!* Substitution 
    37 #  include "domzgr_substitute.h90" 
     37#  include "top_substitute.h90" 
    3838   !!---------------------------------------------------------------------- 
    3939   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
  • branches/CMIP5_IPSL/NEMO/TOP_SRC/PISCES/p4zprod.F90

    r1736 r1808  
    5353 
    5454   !!* Substitution 
    55 #  include "domzgr_substitute.h90" 
     55#  include "top_substitute.h90" 
    5656   !!---------------------------------------------------------------------- 
    5757   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
  • branches/CMIP5_IPSL/NEMO/TOP_SRC/PISCES/p4zrem.F90

    r1744 r1808  
    4545 
    4646   !!* Substitution 
    47 #  include "domzgr_substitute.h90" 
     47#  include "top_substitute.h90" 
    4848   !!---------------------------------------------------------------------- 
    4949   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
  • branches/CMIP5_IPSL/NEMO/TOP_SRC/PISCES/p4zsink.F90

    r1736 r1808  
    6969 
    7070   !!* Substitution 
    71 #  include "domzgr_substitute.h90" 
     71#  include "top_substitute.h90" 
    7272   !!---------------------------------------------------------------------- 
    7373   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
  • branches/CMIP5_IPSL/NEMO/TOP_SRC/PISCES/sms_pisces.F90

    r1678 r1808  
    3838   LOGICAL  ::   ln_pisdmp         !: relaxation or not of nutrients to a mean value 
    3939                                   !: when initialize from a restart file  
     40   LOGICAL  ::   ln_pisclo         !: Restoring or not of nutrients to initial value 
     41                                   !: on close seas 
    4042 
    4143   !!*  Biological fluxes for light 
  • branches/CMIP5_IPSL/NEMO/TOP_SRC/PISCES/trcini_pisces.F90

    r1542 r1808  
    3838      no3    =  31.04e-6 * 7.6 
    3939 
    40 #  include "domzgr_substitute.h90" 
    4140#  include "top_substitute.h90" 
    4241   !!---------------------------------------------------------------------- 
  • branches/CMIP5_IPSL/NEMO/TOP_SRC/PISCES/trclsm_pisces.F90

    r1581 r1808  
    6767      NAMELIST/nampisdia/ nwritedia, pisdia3d, pisdia2d     ! additional diagnostics 
    6868#endif 
    69       NAMELIST/nampisdmp/ ln_pisdmp 
     69      NAMELIST/nampisdmp/ ln_pisdmp, ln_pisclo 
    7070 
    7171      !!---------------------------------------------------------------------- 
     
    188188         WRITE(numout,*) 
    189189         WRITE(numout,*) ' Namelist : nampisdmp' 
    190          WRITE(numout,*) '    Relaxation of tracer to glodap mean value    ln_pisdmp      =', ln_pisdmp 
     190         WRITE(numout,*) '    Relaxation of tracer to glodap mean value            ln_pisdmp      =', ln_pisdmp 
     191         WRITE(numout,*) '    Restoring of tracer to initial value  on closed seas  ln_pisclo      =', ln_pisclo 
    191192         WRITE(numout,*) ' ' 
    192193      ENDIF 
  • branches/CMIP5_IPSL/NEMO/TOP_SRC/TRP/trctrp.F90

    r1445 r1808  
    5353 
    5454   !! * Substitutions 
    55 #  include "domzgr_substitute.h90" 
     55#  include "top_substitute.h90" 
    5656   !!---------------------------------------------------------------------- 
    5757   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  
  • branches/CMIP5_IPSL/NEMO/TOP_SRC/TRP/trczdf_imp.F90

    r1271 r1808  
    112112         rdttrc(:) =  rdttra(:) * FLOAT(ndttrc)       
    113113      ENDIF 
    114      !                                                       ! =========== 
     114 
     115      ! Initialisation 
     116      zwd( 1 ,:,:) = 0.e0     ;     zwd(jpi,:,:) = 0.e0 
     117      zws( 1 ,:,:) = 0.e0     ;     zws(jpi,:,:) = 0.e0 
     118      zwi( 1 ,:,:) = 0.e0     ;     zwi(jpi,:,:) = 0.e0 
     119      !                                           
     120      ! 0. Matrix construction  
     121      ! ---------------------- 
     122 
     123      ! Diagonal, inferior, superior 
     124      ! (including the bottom boundary condition via avs masked 
     125      DO jk = 1, jpkm1                     
     126         DO jj = 2, jpjm1                                     
     127            DO ji = fs_2, fs_jpim1   ! vector opt. 
     128               zwi(ji,jj,jk) = - rdttrc(jk) * fstravs(ji,jj,jk  ) /( fse3t(ji,jj,jk) * fse3w(ji,jj,jk  ) ) 
     129               zws(ji,jj,jk) = - rdttrc(jk) * fstravs(ji,jj,jk+1) /( fse3t(ji,jj,jk) * fse3w(ji,jj,jk+1) ) 
     130               zwd(ji,jj,jk) = 1. - zwi(ji,jj,jk) - zws(ji,jj,jk) 
     131            END DO 
     132         END DO 
     133      END DO 
     134 
     135      ! Surface boudary conditions 
     136      DO jj = 2, jpjm1         
     137         DO ji = fs_2, fs_jpim1 
     138            zwi(ji,jj,1) = 0.e0 
     139            zwd(ji,jj,1) = 1. - zws(ji,jj,1)  
     140         END DO 
     141      END DO 
     142 
     143      !                                                       ! =========== 
    115144      DO jn = 1, jptra                                        ! tracer loop 
    116145         !                                                    ! =========== 
    117146         IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)         ! ??? validation needed 
    118147 
    119     ! Initialisation      
    120     zwd( 1 ,:,:) = 0.e0     ;     zwd(jpi,:,:) = 0.e0 
    121     zws( 1 ,:,:) = 0.e0     ;     zws(jpi,:,:) = 0.e0 
    122     zwi( 1 ,:,:) = 0.e0     ;     zwi(jpi,:,:) = 0.e0 
    123148    zwt( 1 ,:,:) = 0.e0     ;     zwt(jpi,:,:) = 0.e0      
    124149         zwt(  :,:,1) = 0.e0     ;     zwt(  :,:,jpk) = 0.e0 
    125          !                                           
    126          ! 0. Matrix construction 
    127          ! ---------------------- 
    128  
    129          ! Diagonal, inferior, superior 
    130          ! (including the bottom boundary condition via avs masked 
    131          DO jk = 1, jpkm1                                                      
    132             DO jj = 2, jpjm1                                       
    133                DO ji = fs_2, fs_jpim1   ! vector opt. 
    134                   zwi(ji,jj,jk) = - rdttrc(jk) * fstravs(ji,jj,jk  ) /( fse3t(ji,jj,jk) * fse3w(ji,jj,jk  ) ) 
    135                   zws(ji,jj,jk) = - rdttrc(jk) * fstravs(ji,jj,jk+1) /( fse3t(ji,jj,jk) * fse3w(ji,jj,jk+1) ) 
    136                   zwd(ji,jj,jk) = 1. - zwi(ji,jj,jk) - zws(ji,jj,jk) 
    137                END DO 
    138             END DO 
    139          END DO 
    140  
    141          ! Surface boudary conditions 
    142          DO jj = 2, jpjm1         
    143             DO ji = fs_2, fs_jpim1 
    144                zwi(ji,jj,1) = 0.e0 
    145                zwd(ji,jj,1) = 1. - zws(ji,jj,1) 
    146             END DO 
    147          END DO 
    148150          
    149151         ! Second member construction 
  • branches/CMIP5_IPSL/NEMO/TOP_SRC/TRP/trczdf_iso.F90

    r1271 r1808  
    182182 
    183183 
    184  
    185       DO jn = 1, jptra 
     184      ! 0.2 Update and save of avt (and avs if double diffusive mixing) 
     185      ! --------------------------- 
     186 
     187     DO jj = 2, jpjm1                                 !  Vertical slab 
     188        !                                             ! =============== 
     189         DO jk = 2, jpkm1 
     190            DO ji = 2, jpim1 
     191               zavi = fsahtw(ji,jj,jk)*( wslpi(ji,jj,jk)*wslpi(ji,jj,jk)   & 
     192                  &                     +wslpj(ji,jj,jk)*wslpj(ji,jj,jk) ) 
     193               ! add isopycnal vertical coeff. to avs 
     194               fstravs(ji,jj,jk) = fstravs(ji,jj,jk) + zavi 
     195            END DO 
     196         END DO 
     197       ! 
     198     END DO 
     199 
     200 
     201 
     202     DO jn = 1, jptra 
    186203 
    187204         IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)          ! save trends 
     
    262279            END DO 
    263280 
    264  
    265             ! I.3  update and save of avt (and avs if double diffusive mixing) 
    266             ! --------------------------- 
    267  
    268             DO jk = 2, jpkm1 
    269                DO ji = 2, jpim1 
    270  
    271                   zavi = fsahtw(ji,jj,jk)*( wslpi(ji,jj,jk)*wslpi(ji,jj,jk)   & 
    272                      &                     +wslpj(ji,jj,jk)*wslpj(ji,jj,jk) ) 
    273  
    274                   ! add isopycnal vertical coeff. to avs 
    275                   fstravs(ji,jj,jk) = fstravs(ji,jj,jk) + zavi 
    276  
    277                END DO 
    278             END DO 
    279281 
    280282#if defined key_trcldf_eiv 
  • branches/CMIP5_IPSL/NEMO/TOP_SRC/TRP/trczdf_iso_vopt.F90

    r1328 r1808  
    154154                            zws   => va      ! workspace 
    155155      INTEGER, INTENT( in ) ::   kt          ! ocean time-step index 
    156       INTEGER ::   ji, jj, jk, jn            ! dummy loop indices 
     156      INTEGER  ::   ji, jj, jk, jn            ! dummy loop indices 
    157157      REAL(wp) ::   zavi, zrhs               ! temporary scalars 
    158158      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   & 
     
    180180      ENDIF 
    181181 
     182          
     183      zwd  ( 1, :, : ) = 0.e0    ;     zwd  ( jpi, :,   : ) = 0.e0 
     184      zws  ( 1, :, : ) = 0.e0    ;     zws  ( jpi, :,   : ) = 0.e0 
     185      zwi  ( 1, :, : ) = 0.e0    ;     zwi  ( jpi, :,   : ) = 0.e0 
     186      zwt  ( 1, :, : ) = 0.e0    ;     zwt  ( jpi, :,   : ) = 0.e0 
     187      zwt  ( :, :, 1 ) = 0.e0    ;     zwt  (   :, :, jpk ) = 0.e0 
     188      zavsi( 1, :, : ) = 0.e0    ;     zavsi( jpi, :,   : ) = 0.e0  
     189      zavsi( :, :, 1 ) = 0.e0    ;     zavsi(   :, :, jpk ) = 0.e0 
     190 
     191 
     192      ! II. Vertical trend associated with the vertical physics 
     193      !======================================================= 
     194      !     (including the vertical flux proportional to dk[t] associated 
     195      !      with the lateral mixing, through the avt update) 
     196      !     dk[ avt dk[ (t,s) ] ] diffusive trends 
     197 
     198      ! II.0 Matrix construction 
     199      ! ------------------------         
     200      ! update and save of avt (and avs if double diffusive mixing) 
     201      DO jk = 2, jpkm1 
     202         DO jj = 2, jpjm1 
     203            DO ji = fs_2, fs_jpim1   ! vector opt. 
     204               zavi = fsahtw(ji,jj,jk) * (                 &   ! vertical mixing coef. due to lateral mixing 
     205                  &                           wslpi(ji,jj,jk) * wslpi(ji,jj,jk)      & 
     206                  &                         + wslpj(ji,jj,jk) * wslpj(ji,jj,jk)  ) 
     207               zavsi(ji,jj,jk) = fstravs(ji,jj,jk) + zavi        ! dd mixing: zavsi = total vertical mixing coef. on tracer 
     208            END DO 
     209         END DO 
     210      END DO 
     211 
     212      ! II.1 Vertical diffusion on tracer 
     213      ! --------------------------------- 
     214      ! Rebuild the Matrix as avt /= avs 
     215 
     216      ! Diagonal, inferior, superior  (including the bottom boundary condition via avs masked) 
     217      DO jk = 1, jpkm1 
     218         DO jj = 2, jpjm1 
     219            DO ji = fs_2, fs_jpim1   ! vector opt. 
     220               zwi(ji,jj,jk) = - rdttrc(jk) * zavsi(ji,jj,jk  ) / ( fse3t(ji,jj,jk) * fse3w(ji,jj,jk  ) ) 
     221               zws(ji,jj,jk) = - rdttrc(jk) * zavsi(ji,jj,jk+1) / ( fse3t(ji,jj,jk) * fse3w(ji,jj,jk+1) ) 
     222               zwd(ji,jj,jk) = 1. - zwi(ji,jj,jk) - zws(ji,jj,jk) 
     223            END DO 
     224         END DO 
     225      END DO 
     226 
     227      ! Surface boudary conditions 
     228      DO jj = 2, jpjm1 
     229         DO ji = fs_2, fs_jpim1   ! vector opt. 
     230            zwi(ji,jj,1) = 0.e0 
     231            zwd(ji,jj,1) = 1. - zws(ji,jj,1) 
     232         END DO 
     233      END DO 
     234 
     235      !! Matrix inversion from the first level 
     236      !!---------------------------------------------------------------------- 
     237      !   solve m.x = y  where m is a tri diagonal matrix ( jpk*jpk ) 
     238      ! 
     239      !        ( zwd1 zws1   0    0    0  )( zwx1 ) ( zwy1 ) 
     240      !        ( zwi2 zwd2 zws2   0    0  )( zwx2 ) ( zwy2 ) 
     241      !        (  0   zwi3 zwd3 zws3   0  )( zwx3 )=( zwy3 ) 
     242      !        (        ...               )( ...  ) ( ...  ) 
     243      !        (  0    0    0   zwik zwdk )( zwxk ) ( zwyk ) 
     244      ! 
     245      !   m is decomposed in the product of an upper and lower triangular 
     246      !   matrix 
     247      !   The 3 diagonal terms are in 2d arrays: zwd, zws, zwi 
     248      !   The second member is in 2d array zwy 
     249      !   The solution is in 2d array zwx 
     250      !   The 3d arry zwt is a work space array 
     251      !   zwy is used and then used as a work space array : its value is modified! 
     252 
     253      ! first recurrence:   Tk = Dk - Ik Sk-1 / Tk-1   (increasing k) 
     254      DO jj = 2, jpjm1 
     255         DO ji = fs_2, fs_jpim1 
     256            zwt(ji,jj,1) = zwd(ji,jj,1) 
     257         END DO 
     258      END DO 
     259      DO jk = 2, jpkm1 
     260         DO jj = 2, jpjm1 
     261            DO ji = fs_2, fs_jpim1 
     262               zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1)/zwt(ji,jj,jk-1) 
     263            END DO 
     264         END DO 
     265      END DO 
     266 
    182267      IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk) ) 
    183268 
     
    187272          
    188273         IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)          ! save trends 
    189           
    190          zwd  ( 1, :, : ) = 0.e0    ;     zwd  ( jpi, :,   : ) = 0.e0 
    191          zws  ( 1, :, : ) = 0.e0    ;     zws  ( jpi, :,   : ) = 0.e0 
    192          zwi  ( 1, :, : ) = 0.e0    ;     zwi  ( jpi, :,   : ) = 0.e0 
    193          zwt  ( 1, :, : ) = 0.e0    ;     zwt  ( jpi, :,   : ) = 0.e0 
    194          zwt  ( :, :, 1 ) = 0.e0    ;     zwt  (   :, :, jpk ) = 0.e0 
    195          zavsi( 1, :, : ) = 0.e0    ;     zavsi( jpi, :,   : ) = 0.e0  
    196          zavsi( :, :, 1 ) = 0.e0    ;     zavsi(   :, :, jpk ) = 0.e0 
    197274 
    198275#  if defined key_trc_diatrd 
     
    200277         ztrd(:,:,:) = tra(:,:,:,jn) 
    201278#  endif 
    202  
    203          ! II. Vertical trend associated with the vertical physics 
    204          ! ======================================================= 
    205          !     (including the vertical flux proportional to dk[t] associated 
    206          !      with the lateral mixing, through the avt update) 
    207          !     dk[ avt dk[ (t,s) ] ] diffusive trends 
    208  
    209  
    210          ! II.0 Matrix construction 
    211          ! ------------------------         
    212          ! update and save of avt (and avs if double diffusive mixing) 
    213          DO jk = 2, jpkm1 
    214             DO jj = 2, jpjm1 
    215                DO ji = fs_2, fs_jpim1   ! vector opt. 
    216                   zavi = fsahtw(ji,jj,jk) * (                 &   ! vertical mixing coef. due to lateral mixing 
    217                      &                           wslpi(ji,jj,jk) * wslpi(ji,jj,jk)      & 
    218                      &                         + wslpj(ji,jj,jk) * wslpj(ji,jj,jk)  ) 
    219                   zavsi(ji,jj,jk) = fstravs(ji,jj,jk) + zavi        ! dd mixing: zavsi = total vertical mixing coef. on tracer 
    220  
    221                END DO 
    222             END DO 
    223          END DO 
    224  
    225  
    226          ! II.1 Vertical diffusion on tracer 
    227          ! --------------------------------- 
    228  
    229          ! Rebuild the Matrix as avt /= avs 
    230  
    231          ! Diagonal, inferior, superior  (including the bottom boundary condition via avs masked) 
    232          DO jk = 1, jpkm1 
    233             DO jj = 2, jpjm1 
    234                DO ji = fs_2, fs_jpim1   ! vector opt. 
    235                   zwi(ji,jj,jk) = - rdttrc(jk) * zavsi(ji,jj,jk  ) / ( fse3t(ji,jj,jk) * fse3w(ji,jj,jk  ) ) 
    236                   zws(ji,jj,jk) = - rdttrc(jk) * zavsi(ji,jj,jk+1) / ( fse3t(ji,jj,jk) * fse3w(ji,jj,jk+1) ) 
    237                   zwd(ji,jj,jk) = 1. - zwi(ji,jj,jk) - zws(ji,jj,jk) 
    238                END DO 
    239             END DO 
    240          END DO 
    241  
    242          ! Surface boudary conditions 
    243          DO jj = 2, jpjm1 
    244             DO ji = fs_2, fs_jpim1   ! vector opt. 
    245                zwi(ji,jj,1) = 0.e0 
    246                zwd(ji,jj,1) = 1. - zws(ji,jj,1) 
    247             END DO 
    248          END DO 
    249  
    250          !! Matrix inversion from the first level 
    251          !!---------------------------------------------------------------------- 
    252          !   solve m.x = y  where m is a tri diagonal matrix ( jpk*jpk ) 
    253          ! 
    254          !        ( zwd1 zws1   0    0    0  )( zwx1 ) ( zwy1 ) 
    255          !        ( zwi2 zwd2 zws2   0    0  )( zwx2 ) ( zwy2 ) 
    256          !        (  0   zwi3 zwd3 zws3   0  )( zwx3 )=( zwy3 ) 
    257          !        (        ...               )( ...  ) ( ...  ) 
    258          !        (  0    0    0   zwik zwdk )( zwxk ) ( zwyk ) 
    259          ! 
    260          !   m is decomposed in the product of an upper and lower triangular 
    261          !   matrix 
    262          !   The 3 diagonal terms are in 2d arrays: zwd, zws, zwi 
    263          !   The second member is in 2d array zwy 
    264          !   The solution is in 2d array zwx 
    265          !   The 3d arry zwt is a work space array 
    266          !   zwy is used and then used as a work space array : its value is modified! 
    267  
    268          ! first recurrence:   Tk = Dk - Ik Sk-1 / Tk-1   (increasing k) 
    269          DO jj = 2, jpjm1 
    270             DO ji = fs_2, fs_jpim1 
    271                zwt(ji,jj,1) = zwd(ji,jj,1) 
    272             END DO 
    273          END DO 
    274          DO jk = 2, jpkm1 
    275             DO jj = 2, jpjm1 
    276                DO ji = fs_2, fs_jpim1 
    277                   zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1)  /zwt(ji,jj,jk-1) 
    278                END DO 
    279             END DO 
    280          END DO 
    281279 
    282280         ! second recurrence:    Zk = Yk - Ik / Tk-1  Zk-1 
  • branches/CMIP5_IPSL/NEMO/TOP_SRC/trcdta.F90

    r1645 r1808  
    2525   PUBLIC trc_dta   ! called in trcini.F90 and trcdmp.F90 
    2626 
     27   LOGICAL , PUBLIC, PARAMETER ::   lk_dtatrc = .TRUE.   !: temperature data flag 
    2728   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk,jptra) ::   trdta   !: tracer data at given time-step 
    2829 
     
    6263      !! 
    6364      CHARACTER (len=39) ::   clname(jptra) 
    64       INTEGER, PARAMETER ::   jpmois  = 12        ! number of months 
     65      INTEGER, PARAMETER ::   & 
     66         jpmonth = 12    ! number of months 
    6567      INTEGER ::   ji, jj, jn, jl  
    6668      INTEGER ::   imois, iman, i15, ik  ! temporary integers  
     
    8183            ENDIF 
    8284            ! Initialization 
    83             iman = jpmois 
     85            iman = jpmonth 
    8486            i15  = nday / 16 
    8587            imois = nmonth + i15 -1 
     
    188190            ! Read init file only 
    189191            IF( kt == nittrc000  ) THEN 
     192               ntrc1(jn) = 1 
    190193               CALL iom_get ( numtr(jn), jpdom_data, ctrcnm(jn), trdta(:,:,:,jn), ntrc1(jn) ) 
    191194               trdta(:,:,:,jn) = trdta(:,:,:,jn) * tmask(:,:,:) 
     
    204207   !!   Dummy module                              NO 3D passive tracer data 
    205208   !!---------------------------------------------------------------------- 
     209   LOGICAL , PUBLIC, PARAMETER ::   lk_dtatrc = .FALSE.   !: temperature data flag 
    206210CONTAINS 
    207211   SUBROUTINE trc_dta( kt )        ! Empty routine 
  • branches/CMIP5_IPSL/NEMO/TOP_SRC/trcrst.F90

    r1655 r1808  
    11MODULE trcrst 
    22   !!====================================================================== 
    3    !!                       ***  MODULE trcrst  *** 
    4    !! TOP :   create, write, read the restart files for passive tracers 
     3   !!                         ***  MODULE trcrst  *** 
     4   !! TOP :   Manage the passive tracer restart 
    55   !!====================================================================== 
    6    !! History :   1.0  !  2007-02 (C. Ethe) adaptation from the ocean 
     6   !! History :    -   !  1991-03  ()  original code 
     7   !!             1.0  !  2005-03 (O. Aumont, A. El Moussaoui) F90 
     8   !!              -   !  2005-10 (C. Ethe) print control 
     9   !!             2.0  !  2005-10 (C. Ethe, G. Madec) revised architecture 
    710   !!---------------------------------------------------------------------- 
    811#if defined key_top 
     12   !!---------------------------------------------------------------------- 
     13   !!   'key_top'                                                TOP models 
     14   !!---------------------------------------------------------------------- 
     15   !!---------------------------------------------------------------------- 
     16   !!   trc_rst :   Restart for passive tracer 
     17   !!---------------------------------------------------------------------- 
    918   !!---------------------------------------------------------------------- 
    1019   !!   'key_top'                                                TOP models 
     
    1625   USE oce_trc 
    1726   USE trc 
    18    USE sms_lobster         ! LOBSTER variables 
    19    USE sms_pisces          ! PISCES variables 
    20    USE trcsms_cfc          ! CFC variables 
    21    USE trcsms_c14b         ! C14 variables 
    22    USE trcsms_my_trc       ! MY_TRC variables 
    23    USE trctrp_lec    
     27   USE trctrp_lec 
    2428   USE lib_mpp 
    2529   USE iom 
    26     
     30   USE trcrst_cfc      ! CFC       
     31   USE trcrst_lobster  ! LOBSTER  restart 
     32   USE trcrst_pisces   ! PISCES   restart 
     33   USE trcrst_c14b     ! C14 bomb restart 
     34   USE trcrst_my_trc   ! MY_TRC   restart 
     35 
    2736   IMPLICIT NONE 
    2837   PRIVATE 
    29     
     38 
    3039   PUBLIC   trc_rst_opn       ! called by ??? 
    3140   PUBLIC   trc_rst_read      ! called by ??? 
    3241   PUBLIC   trc_rst_wri       ! called by ??? 
    33     
     42 
    3443   INTEGER, PUBLIC ::   numrtr, numrtw   !: logical unit for trc restart (read and write) 
    35  
    3644 
    3745   !! * Substitutions 
     
    8997   END SUBROUTINE trc_rst_opn 
    9098 
    91  
    92    SUBROUTINE trc_rst_read  
     99   SUBROUTINE trc_rst_read 
    93100      !!---------------------------------------------------------------------- 
    94101      !!                    ***  trc_rst_opn  *** 
     
    96103      !! ** purpose  :   read passive tracer fields in restart files 
    97104      !!---------------------------------------------------------------------- 
    98       INTEGER  ::  jn   
    99       INTEGER  ::  iarak0 
     105      INTEGER  ::  jn      
     106      INTEGER  ::  iarak0  
    100107      REAL(wp) ::  zarak0 
    101108      INTEGER  ::  jlibalt = jprstlib 
    102109      LOGICAL  ::  llok 
    103 #if defined key_pisces  
    104       INTEGER  ::  ji, jj, jk 
    105       REAL(wp) ::  zcaralk, zbicarb, zco3 
    106       REAL(wp) ::  ztmas, ztmas1 
    107 #endif 
    108110 
    109111      !!---------------------------------------------------------------------- 
     
    115117      IF ( jprstlib == jprstdimg ) THEN 
    116118        ! eventually read netcdf file (monobloc)  for restarting on different number of processors 
    117         ! if {cn_trcrst_in}.nc exists, then set jlibalt to jpnf90 
     119        ! if {cn_trcrst_in}.nc exists, then set jlibalt to jpnf90  
    118120        INQUIRE( FILE = TRIM(cn_trcrst_in)//'.nc', EXIST = llok ) 
    119         IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF 
    120       ENDIF 
    121        
    122       CALL iom_open( cn_trcrst_in, numrtr, kiolib = jlibalt ) 
     121        IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF  
     122      ENDIF 
     123 
     124      CALL iom_open( cn_trcrst_in, numrtr, kiolib = jlibalt )  
    123125 
    124126      ! Time domain : restart 
     
    136138         & ' centered or euler '  ) 
    137139      IF(lwp) WRITE(numout,*) 
    138  
    139140      IF(lwp) WRITE(numout,*) '    arakawa option      : ', NINT( zarak0 ) 
    140141 
    141  
    142142      ! READ prognostic variables and computes diagnostic variable 
    143143      DO jn = 1, jptra 
    144          CALL iom_get( numrtr, jpdom_autoglo, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) )  
    145       END DO 
    146  
    147       DO jn = 1, jptra 
    148          CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) )  
    149       END DO 
    150  
    151 #if defined key_lobster 
    152       CALL iom_get( numrtr, jpdom_autoglo, 'SEDB'//ctrcnm(jpdet), sedpocb(:,:) )  
    153       CALL iom_get( numrtr, jpdom_autoglo, 'SEDN'//ctrcnm(jpdet), sedpocn(:,:) )  
    154 #endif 
    155 #if defined key_pisces 
    156       ! 
    157       IF( ln_pisdmp ) CALL pis_dmp_ini  ! relaxation of some tracers 
    158       ! 
    159       IF( iom_varid( numrtr, 'PH', ldstop = .FALSE. ) > 0 ) THEN 
    160          CALL iom_get( numrtr, jpdom_autoglo, 'PH' , hi(:,:,:)  ) 
    161       ELSE 
    162          ! Set PH from  total alkalinity, borat (???), akb3 (???) and ak23 (???) 
    163          ! -------------------------------------------------------- 
    164          DO jk = 1, jpk 
    165             DO jj = 1, jpj 
    166                DO ji = 1, jpi 
    167                   ztmas   = tmask(ji,jj,jk) 
    168                   ztmas1  = 1. - tmask(ji,jj,jk) 
    169                   zcaralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / (  1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) )  ) 
    170                   zco3    = ( zcaralk - trn(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1 
    171                   zbicarb = ( 2. * trn(ji,jj,jk,jpdic) - zcaralk ) 
    172                   hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1 
    173                END DO 
    174             END DO 
    175          END DO 
    176       ENDIF 
    177       CALL iom_get( numrtr, jpdom_autoglo, 'Silicalim', xksi(:,:) )  
    178       IF( iom_varid( numrtr, 'Silicamax', ldstop = .FALSE. ) > 0 ) THEN 
    179          CALL iom_get( numrtr, jpdom_autoglo, 'Silicamax' , xksimax(:,:)  ) 
    180       ELSE 
    181          xksimax(:,:) = xksi(:,:) 
    182       ENDIF 
    183 #endif 
    184 #if defined key_cfc 
    185       DO jn = jp_cfc0, jp_cfc1 
    186          CALL iom_get( numrtr, jpdom_autoglo, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) )  
    187       END DO 
    188 #endif 
    189 #if defined key_c14b 
    190       CALL iom_get( numrtr, jpdom_autoglo, 'qint_'//ctrcnm(jn) , qint_c14(:,:) )  
    191 #endif 
    192 #if defined key_my_trc 
    193 #endif 
    194        
     144         CALL iom_get( numrtr, jpdom_autoglo, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) ) 
     145      END DO 
     146 
     147      DO jn = 1, jptra 
     148         CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 
     149      END DO 
     150 
     151      IF( lk_lobster )   CALL trc_rst_read_lobster( numrtr )      ! LOBSTER bio-model 
     152      IF( lk_pisces  )   CALL trc_rst_read_pisces ( numrtr )      ! PISCES  bio-model 
     153      IF( lk_cfc     )   CALL trc_rst_read_cfc    ( numrtr )      ! CFC     tracers 
     154      IF( lk_c14b    )   CALL trc_rst_read_c14b   ( numrtr )      ! C14 bomb  tracer 
     155      IF( lk_my_trc  )   CALL trc_rst_read_my_trc ( numrtr )      ! MY_TRC  tracers 
     156 
    195157      CALL iom_close( numrtr ) 
    196158      ! 
    197159   END SUBROUTINE trc_rst_read 
    198  
    199160 
    200161   SUBROUTINE trc_rst_wri( kt ) 
     
    218179      CALL iom_rstput( kt, nitrst, numrtw, 'arak0', zarak0 ) 
    219180 
    220       ! prognostic variables 
    221       ! -------------------- 
     181      ! prognostic variables  
     182      ! --------------------  
    222183      DO jn = 1, jptra 
    223184         CALL iom_rstput( kt, nitrst, numrtw, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) ) 
     
    228189      END DO 
    229190 
    230 #if defined key_lobster 
    231          CALL iom_rstput( kt, nitrst, numrtw, 'SEDB'//ctrcnm(jpdet), sedpocb(:,:) ) 
    232          CALL iom_rstput( kt, nitrst, numrtw, 'SEDN'//ctrcnm(jpdet), sedpocn(:,:) ) 
    233 #endif 
    234 #if defined key_pisces  
    235          CALL iom_rstput( kt, nitrst, numrtw, 'PH', hi(:,:,:) ) 
    236          CALL iom_rstput( kt, nitrst, numrtw, 'Silicalim', xksi(:,:) ) 
    237          CALL iom_rstput( kt, nitrst, numrtw, 'Silicamax', xksimax(:,:) ) 
    238 #endif 
    239 #if defined key_cfc 
    240          DO jn = jp_cfc0, jp_cfc1 
    241             CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) ) 
    242          END DO 
    243 #endif 
    244 #if defined key_c14b 
    245          CALL iom_rstput( kt, nitrst, numrtw, 'qint_'//ctrcnm(jn), qint_c14(:,:) ) 
    246 #endif 
    247 #if defined key_my_trc 
    248 #endif 
    249        
     191      IF( lk_lobster )   CALL trc_rst_wri_lobster( kt, nitrst, numrtw )      ! LOBSTER bio-model 
     192      IF( lk_pisces  )   CALL trc_rst_wri_pisces ( kt, nitrst, numrtw )      ! PISCES  bio-model 
     193      IF( lk_cfc     )   CALL trc_rst_wri_cfc    ( kt, nitrst, numrtw )      ! CFC     tracers 
     194      IF( lk_c14b    )   CALL trc_rst_wri_c14b   ( kt, nitrst, numrtw )      ! C14 bomb  tracer 
     195      IF( lk_my_trc  )   CALL trc_rst_wri_my_trc ( kt, nitrst, numrtw )      ! MY_TRC  tracers 
     196 
    250197      IF( kt == nitrst ) THEN 
    251198          CALL trc_rst_stat            ! statistics 
     
    256203      ENDIF 
    257204      ! 
    258    END SUBROUTINE trc_rst_wri 
     205   END SUBROUTINE trc_rst_wri  
     206 
    259207 
    260208   SUBROUTINE trc_rst_cal( kt, cdrw ) 
     
    347295   END SUBROUTINE trc_rst_cal 
    348296 
    349 # if defined key_pisces  
    350  
    351    SUBROUTINE pis_dmp_ini  
    352       !!---------------------------------------------------------------------- 
    353       !!                    ***  pis_dmp_ini  *** 
    354       !! 
    355       !! ** purpose  : Relaxation of some tracers 
    356       !!---------------------------------------------------------------------- 
    357       INTEGER  :: ji, jj, jk   
    358       REAL(wp) ::  & 
    359          alkmean = 2426. ,  & ! mean value of alkalinity ( Glodap ; for Goyet 2391. ) 
    360          po4mean = 2.165 ,  & ! mean value of phosphates 
    361          no3mean = 30.90 ,  & ! mean value of nitrate 
    362          siomean = 91.51      ! mean value of silicate 
    363        
    364       REAL(wp) ::   zvol, ztrasum 
    365  
    366  
    367       IF(lwp)  WRITE(numout,*) 
    368  
    369       IF( cp_cfg == "orca" .AND. .NOT. lk_trc_c1d ) THEN      ! ORCA condiguration (not 1D) ! 
    370          !                                                    ! --------------------------- ! 
    371          ! set total alkalinity, phosphate, NO3 & silicate 
    372  
    373          ! total alkalinity 
    374          ztrasum = 0.e0              
    375          DO jk = 1, jpk 
    376             DO jj = 1, jpj 
    377                DO ji = 1, jpi 
    378                   zvol = cvol(ji,jj,jk) 
    379 #  if defined key_off_degrad 
    380                   zvol = zvol * facvol(ji,jj,jk) 
    381 #  endif 
    382                   ztrasum = ztrasum + trn(ji,jj,jk,jptal) * zvol 
    383                END DO 
    384             END DO 
    385          END DO 
    386          IF( lk_mpp )   CALL mpp_sum( ztrasum )     ! sum over the global domain   
    387           
    388          ztrasum = ztrasum / areatot * 1.e6 
    389          IF(lwp) WRITE(numout,*) '       TALK mean : ', ztrasum 
    390          trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / ztrasum 
    391              
    392          ! phosphate 
    393          ztrasum = 0.e0 
    394          DO jk = 1, jpk 
    395             DO jj = 1, jpj 
    396                DO ji = 1, jpi 
    397                   zvol = cvol(ji,jj,jk) 
    398 #  if defined key_off_degrad 
    399                   zvol = zvol * facvol(ji,jj,jk) 
    400 #  endif 
    401                   ztrasum = ztrasum + trn(ji,jj,jk,jppo4) * zvol 
    402                END DO 
    403             END DO 
    404          END DO 
    405          IF( lk_mpp )   CALL mpp_sum( ztrasum )     ! sum over the global domain   
    406           
    407          ztrasum = ztrasum / areatot * 1.e6 / 122. 
    408          IF(lwp) WRITE(numout,*) '       PO4  mean : ', ztrasum 
    409          trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / ztrasum 
    410          
    411          ! Nitrates           
    412          ztrasum = 0.e0 
    413          DO jk = 1, jpk 
    414             DO jj = 1, jpj 
    415                DO ji = 1, jpi 
    416                   zvol = cvol(ji,jj,jk) 
    417 #  if defined key_off_degrad 
    418                   zvol = zvol * facvol(ji,jj,jk) 
    419 #  endif 
    420                   ztrasum = ztrasum + trn(ji,jj,jk,jpno3) * zvol 
    421                END DO 
    422             END DO 
    423          END DO 
    424          IF( lk_mpp )   CALL mpp_sum( ztrasum )     ! sum over the global domain   
    425           
    426          ztrasum = ztrasum / areatot * 1.e6 / 7.6 
    427          IF(lwp) WRITE(numout,*) '       NO3  mean : ', ztrasum 
    428          trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / ztrasum 
    429           
    430          ! Silicate 
    431          ztrasum = 0.e0 
    432          DO jk = 1, jpk 
    433             DO jj = 1, jpj 
    434                DO ji = 1, jpi 
    435                   zvol = cvol(ji,jj,jk) 
    436 #  if defined key_off_degrad 
    437                   zvol = zvol * facvol(ji,jj,jk) 
    438 #  endif 
    439                   ztrasum = ztrasum + trn(ji,jj,jk,jpsil) * zvol 
    440                END DO 
    441             END DO 
    442          END DO 
    443          IF( lk_mpp )   CALL mpp_sum( ztrasum )     ! sum over the global domain   
    444          ztrasum = ztrasum / areatot * 1.e6 
    445          IF(lwp) WRITE(numout,*) '       SiO3 mean : ', ztrasum 
    446          trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * siomean / ztrasum )  
    447          ! 
    448       ENDIF 
    449  
    450 !#if defined key_kriest 
    451 !     !! Initialize number of particles from a standart restart file 
    452 !     !! The name of big organic particles jpgoc has been only change 
    453 !     !! and replace by jpnum but the values here are concentration 
    454 !     trn(:,:,:,jppoc) = trn(:,:,:,jppoc) + trn(:,:,:,jpnum) 
    455 !     trn(:,:,:,jpnum) = trn(:,:,:,jppoc) / ( 6. * xkr_massp ) 
    456 !#endif 
    457  
    458    END SUBROUTINE pis_dmp_ini 
    459  
    460 #endif 
    461       !!---------------------------------------------------------------------- 
    462297 
    463298   SUBROUTINE trc_rst_stat 
Note: See TracChangeset for help on using the changeset viewer.