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 2072 for branches/devmercator2010/NEMO/TOP_SRC – NEMO

Ignore:
Timestamp:
2010-09-08T16:29:38+02:00 (14 years ago)
Author:
cbricaud
Message:

add change from DEV_r1784_3DF

Location:
branches/devmercator2010/NEMO/TOP_SRC
Files:
5 deleted
42 edited

Legend:

Unmodified
Added
Removed

  • branches/devmercator2010/NEMO/TOP_SRC/C14b/par_c14b.F90

    r2047 r2072  
    2727 
    2828   IMPLICIT NONE 
     29   PUBLIC 
    2930 
    30    INTEGER, PARAMETER ::   jp_lb      = jp_lobster     + jp_pisces     + jp_cfc     !: cum. number of pass. tracers 
    31    INTEGER, PARAMETER ::   jp_lb_2d   = jp_lobster_2d  + jp_pisces_2d  + jp_cfc_2d  !: 
    32    INTEGER, PARAMETER ::   jp_lb_3d   = jp_lobster_3d  + jp_pisces_3d  + jp_cfc_3d  !: 
    33    INTEGER, PARAMETER ::   jp_lb_trd  = jp_lobster_trd + jp_pisces_trd + jp_cfc_trd !: 
     31   INTEGER, PUBLIC, PARAMETER ::   jp_lp      = jp_lobster     + jp_pisces     + jp_cfc     !: cum. number of pass. tracers 
     32   INTEGER, PUBLIC, PARAMETER ::   jp_lp_2d   = jp_lobster_2d  + jp_pisces_2d  + jp_cfc_2d  !: 
     33   INTEGER, PUBLIC, PARAMETER ::   jp_lp_3d   = jp_lobster_3d  + jp_pisces_3d  + jp_cfc_3d  !: 
     34   INTEGER, PUBLIC, PARAMETER ::   jp_lp_trd  = jp_lobster_trd + jp_pisces_trd + jp_cfc_trd !: 
    3435    
    3536#if defined key_c14b 
    … …  
    4243   INTEGER, PUBLIC, PARAMETER ::   jp_c14b_3d  =  1          !: additional 3d output arrays ('key_trc_diaadd') 
    4344   INTEGER, PUBLIC, PARAMETER ::   jp_c14b_trd =  0          !: number of sms trends for C14 
    44    INTEGER, PUBLIC, PARAMETER ::   jpc14       = jp_lb + 1   !: assign an index in trc arrays for C14 bomb  
     45    
     46   ! assign an index in trc arrays for each CFC prognostic variables 
     47   INTEGER, PUBLIC, PARAMETER ::   jpc14       = jp_lp + 1   !: C14 bomb  
    4548#else 
    4649   !!--------------------------------------------------------------------- 
    … …  
    5558 
    5659   ! Starting/ending C14 do-loop indices (N.B. no C14 : jp_c14b0 > jp_c14b1 the do-loop are never done) 
    57    INTEGER, PUBLIC, PARAMETER ::   jp_c14b0     = jp_lb + 1                !: First index of C14 tracer 
    58    INTEGER, PUBLIC, PARAMETER ::   jp_c14b1     = jp_lb + jp_c14b          !: Last  index of C14 tracer 
    59    INTEGER, PUBLIC, PARAMETER ::   jp_c14b0_2d  = jp_lb_2d  + 1            !: First index of C14 tracer 
    60    INTEGER, PUBLIC, PARAMETER ::   jp_c14b1_2d  = jp_lb_2d  + jp_c14b_2d   !: Last  index of C14 tracer 
    61    INTEGER, PUBLIC, PARAMETER ::   jp_c14b0_3d  = jp_lb_3d  + 1            !: First index of C14 tracer 
    62    INTEGER, PUBLIC, PARAMETER ::   jp_c14b1_3d  = jp_lb_3d  + jp_c14b_3d   !: Last  index of C14 tracer 
    63    INTEGER, PUBLIC, PARAMETER ::   jp_c14b0_trd = jp_lb_trd + 1            !: First index of C14 tracer 
    64    INTEGER, PUBLIC, PARAMETER ::   jp_c14b1_trd = jp_lb_trd + jp_c14b_trd  !: Last  index of C14 tracer 
     60   INTEGER, PUBLIC, PARAMETER ::   jp_c14b0     = jp_lp + 1                !: First index of C14 tracer 
     61   INTEGER, PUBLIC, PARAMETER ::   jp_c14b1     = jp_lp + jp_c14b          !: Last  index of C14 tracer 
     62   INTEGER, PUBLIC, PARAMETER ::   jp_c14b0_2d  = jp_lp_2d  + 1            !: First index of C14 tracer 
     63   INTEGER, PUBLIC, PARAMETER ::   jp_c14b1_2d  = jp_lp_2d  + jp_c14b_2d   !: Last  index of C14 tracer 
     64   INTEGER, PUBLIC, PARAMETER ::   jp_c14b0_3d  = jp_lp_3d  + 1            !: First index of C14 tracer 
     65   INTEGER, PUBLIC, PARAMETER ::   jp_c14b1_3d  = jp_lp_3d  + jp_c14b_3d   !: Last  index of C14 tracer 
     66   INTEGER, PUBLIC, PARAMETER ::   jp_c14b0_trd = jp_lp_trd + 1            !: First index of C14 tracer 
     67   INTEGER, PUBLIC, PARAMETER ::   jp_c14b1_trd = jp_lp_trd + jp_c14b_trd  !: Last  index of C14 tracer 
    6568 
    6669   !!====================================================================== 

  • branches/devmercator2010/NEMO/TOP_SRC/C14b/trclsm_c14b.F90

    r1801 r2072  
    4444      INTEGER ::   numnatb 
    4545 
    46 #if defined key_trc_diaadd && ! defined key_iomput 
     46#if defined key_trc_diaadd 
    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 && ! defined key_iomput 
     60#if defined key_trc_diaadd 
    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 && ! defined key_iomput 
     83#if defined key_trc_diaadd 
    8484 
    8585      ! Namelist namc14dia 

  • branches/devmercator2010/NEMO/TOP_SRC/CFC/par_cfc.F90

    r2047 r2072  
    2121 
    2222   IMPLICIT NONE 
     23   PUBLIC 
    2324 
    24    INTEGER, PARAMETER ::   jp_lc      = jp_lobster     + jp_pisces     !: cumulative number of passive tracers 
    25    INTEGER, PARAMETER ::   jp_lc_2d   = jp_lobster_2d  + jp_pisces_2d  !: 
    26    INTEGER, PARAMETER ::   jp_lc_3d   = jp_lobster_3d  + jp_pisces_3d  !: 
    27    INTEGER, PARAMETER ::   jp_lc_trd  = jp_lobster_trd + jp_pisces_trd !: 
     25   INTEGER, PUBLIC, PARAMETER ::   jp_lp      = jp_lobster     + jp_pisces     !: cumulative number of passive tracers 
     26   INTEGER, PUBLIC, PARAMETER ::   jp_lp_2d   = jp_lobster_2d  + jp_pisces_2d  !: 
     27   INTEGER, PUBLIC, PARAMETER ::   jp_lp_3d   = jp_lobster_3d  + jp_pisces_3d  !: 
     28   INTEGER, PUBLIC, PARAMETER ::   jp_lp_trd  = jp_lobster_trd + jp_pisces_trd !: 
    2829    
    2930#if defined key_cfc 
    … …  
    3839    
    3940   ! assign an index in trc arrays for each CFC prognostic variables 
    40    INTEGER, PUBLIC, PARAMETER ::   jpc11       = jp_lc + 1   !: CFC-11  
    41    INTEGER, PUBLIC, PARAMETER ::   jpc12       = jp_lc + 2   !: CFC-12    
     41   INTEGER, PUBLIC, PARAMETER ::   jpc11       = jp_lp + 1   !: CFC-11  
     42   INTEGER, PUBLIC, PARAMETER ::   jpc12       = jp_lp + 2   !: CFC-12    
    4243#else 
    4344   !!--------------------------------------------------------------------- 
    … …  
    5253 
    5354   ! Starting/ending CFC do-loop indices (N.B. no CFC : jp_cfc0 > jp_cfc1 the do-loop are never done) 
    54    INTEGER, PUBLIC, PARAMETER ::   jp_cfc0     = jp_lc + 1       !: First index of CFC tracers 
    55    INTEGER, PUBLIC, PARAMETER ::   jp_cfc1     = jp_lc + jp_cfc  !: Last  index of CFC tracers 
    56    INTEGER, PUBLIC, PARAMETER ::   jp_cfc0_2d  = jp_lc_2d  + 1       !: First index of CFC tracers 
    57    INTEGER, PUBLIC, PARAMETER ::   jp_cfc1_2d  = jp_lc_2d  + jp_cfc_2d  !: Last  index of CFC tracers 
    58    INTEGER, PUBLIC, PARAMETER ::   jp_cfc0_3d  = jp_lc_3d  + 1       !: First index of CFC tracers 
    59    INTEGER, PUBLIC, PARAMETER ::   jp_cfc1_3d  = jp_lc_3d  + jp_cfc_3d  !: Last  index of CFC tracers 
    60    INTEGER, PUBLIC, PARAMETER ::   jp_cfc0_trd = jp_lc_trd + 1       !: First index of CFC tracers 
    61    INTEGER, PUBLIC, PARAMETER ::   jp_cfc1_trd = jp_lc_trd + jp_cfc_trd  !: Last  index of CFC tracers 
     55   INTEGER, PUBLIC, PARAMETER ::   jp_cfc0     = jp_lp + 1       !: First index of CFC tracers 
     56   INTEGER, PUBLIC, PARAMETER ::   jp_cfc1     = jp_lp + jp_cfc  !: Last  index of CFC tracers 
     57   INTEGER, PUBLIC, PARAMETER ::   jp_cfc0_2d  = jp_lp_2d  + 1       !: First index of CFC tracers 
     58   INTEGER, PUBLIC, PARAMETER ::   jp_cfc1_2d  = jp_lp_2d  + jp_cfc_2d  !: Last  index of CFC tracers 
     59   INTEGER, PUBLIC, PARAMETER ::   jp_cfc0_3d  = jp_lp_3d  + 1       !: First index of CFC tracers 
     60   INTEGER, PUBLIC, PARAMETER ::   jp_cfc1_3d  = jp_lp_3d  + jp_cfc_3d  !: Last  index of CFC tracers 
     61   INTEGER, PUBLIC, PARAMETER ::   jp_cfc0_trd = jp_lp_trd + 1       !: First index of CFC tracers 
     62   INTEGER, PUBLIC, PARAMETER ::   jp_cfc1_trd = jp_lp_trd + jp_cfc_trd  !: Last  index of CFC tracers 
    6263 
    6364   !!====================================================================== 

  • branches/devmercator2010/NEMO/TOP_SRC/CFC/trcctl_cfc.F90

    r2047 r2072  
    4444      IF( jp_cfc > 2) THEN  
    4545          IF(lwp) THEN  
    46               WRITE (numout,*) ' ===>>>> : w a r n i n g <<<<===' 
     46              WRITE (numout,*) ' ===>>>> : w a r n i n g ' 
     47              WRITE (numout,*) ' =======   ============= ' 
    4748              WRITE (numout,*)                             & 
    4849              &   ' STOP, change jp_cfc to 1 or 2 in par_CFC module '   
    … …  
    5354      ! Check tracer names 
    5455      ! ------------------ 
    55       ctrcnm(jpc11) = 'CFC11' 
    56       ctrcnl(jpc11) = 'Chlorofuorocarbone 11 concentration' 
    57  
    58       IF ( jp_cfc == 2 ) THEN 
    59           ctrcnm(jpc12) = 'CFC12' 
    60           ctrcnl(jpc12) = 'Chlorofuorocarbone 12 concentration' 
     56      IF ( ctrcnm(jpc11) /= 'CFC11' .OR. ctrcnm(jpc12) /= 'CFC12' ) THEN  
     57            ctrcnm(jpc11) = 'CFC11' 
     58            ctrcnl(jpc11) = 'Chlorofuorocarbone 11 concentration' 
     59            ctrcnm(jpc12) = 'CFC12' 
     60            ctrcnl(jpc12) = 'Chlorofuorocarbone 12 concentration'  
    6161      ENDIF 
    6262 
    … …  
    7070         END DO 
    7171         WRITE(numout,*) ' ' 
    72       ENDIF 
     72      ENDIF  
    7373 
    7474 
    … …  
    8080            ctrcun(jn) = 'mole/m3' 
    8181            IF(lwp) THEN 
    82                WRITE (numout,*) ' ===>>>> : w a r n i n g <<<<===' 
     82               WRITE (numout,*) ' ===>>>> : w a r n i n g ' 
     83               WRITE (numout,*) ' =======   ============= ' 
    8384               WRITE (numout,*) ' we force tracer unit' 
    8485               WRITE(numout,*) ' tracer  ',ctrcnm(jn), 'UNIT= ',ctrcun(jn) 

  • branches/devmercator2010/NEMO/TOP_SRC/CFC/trcini_cfc.F90

    r2047 r2072  
    2222 
    2323   PUBLIC   trc_ini_cfc   ! called by trcini.F90 module 
    24  
    25    CHARACTER (len=34) ::   clname = 'cfc1112.atm'   ! ??? 
    2624 
    2725   INTEGER  ::   inum                   ! unit number 
    … …  
    5755      ! ---------------------------------------  
    5856      xphem (:,:)    = 0.e0 
    59       p_cfc(:,:,:)   = 0.e0 
     57      DO jl = 1, jp_cfc 
     58         jn = jp_cfc0 + jl - 1 
     59         DO jm = 1, jphem 
     60            DO js = 1, jpyear 
     61               p_cfc(js,jm,jn) = 0.0 
     62            END DO 
     63         END DO 
     64      END DO 
     65       
    6066       
    6167      ! Initialization of qint in case of  no restart  
    … …  
    6773            WRITE(numout,*) 'Initialization de qint ; No restart : qint equal zero ' 
    6874         ENDIF 
    69          qint_cfc(:,:,:) = 0.e0 
    7075         DO jl = 1, jp_cfc 
    7176            jn = jp_cfc0 + jl - 1 
    7277            trn     (:,:,:,jn) = 0.e0 
     78            qint_cfc(:,:  ,jn) = 0.e0 
    7379         END DO 
    7480      ENDIF 
    … …  
    8288      IF(lwp) WRITE(numout,*) 'read of formatted file cfc1112atm' 
    8389       
    84       CALL ctl_opn( inum, clname, 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
     90      CALL ctl_opn( inum, 'cfc1112.atm', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
    8591      REWIND(inum) 
    8692       
    … …  
    8995      END DO 
    9096    
    91       ! file starts in 1931 do jn represent the year in the century.jhh 
    92       ! Read file till the end 
    93       jn = 31 
    94       DO WHILE ( 1 /= 2 ) 
    95          READ(inum,*,END=100) zyy, p_cfc(jn,1,1), p_cfc(jn,1,2), p_cfc(jn,2,1), p_cfc(jn,2,2) 
    96          IF ( lwp) THEN 
    97            WRITE(numout,'(f7.2, 4f8.2)' ) & 
     97      DO jn = 31, 98      !   Read file 
     98         READ(inum,*) zyy, p_cfc(jn,1,1), p_cfc(jn,1,2), p_cfc(jn,2,1), p_cfc(jn,2,2) 
     99         WRITE(numout,'(f7.2, 4f8.2)' ) & 
    98100            &         zyy, p_cfc(jn,1,1), p_cfc(jn,1,2), p_cfc(jn,2,1), p_cfc(jn,2,2) 
    99          ENDIF 
    100          jn = jn + 1 
    101101      END DO 
    102  100  npyear = jn - 1 
    103       IF ( lwp) WRITE(numout,*) '    ', npyear ,' years read' 
    104102 
    105103      p_cfc(32,1:2,1) = 5.e-4      ! modify the values of the first years 

  • branches/devmercator2010/NEMO/TOP_SRC/CFC/trclsm_cfc.F90

    r1801 r2072  
    4343      !!---------------------------------------------------------------------- 
    4444      INTEGER ::   numnatc 
    45 #if defined key_trc_diaadd && ! defined key_iomput 
     45#if defined key_trc_diaadd 
    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 && ! defined key_iomput 
     58#if defined key_trc_diaadd 
    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 && ! defined key_iomput 
     81#if defined key_trc_diaadd 
    8282 
    8383      ! Namelist namcfcdia 

  • branches/devmercator2010/NEMO/TOP_SRC/CFC/trcsms_cfc.F90

    r2047 r2072  
    2727   PUBLIC   trc_sms_cfc       ! called in ???     
    2828 
    29    INTEGER , PUBLIC, PARAMETER ::   jpyear = 150   ! temporal parameter  
     29   INTEGER , PUBLIC, PARAMETER ::   jpyear = 100   ! temporal parameter  
    3030   INTEGER , PUBLIC, PARAMETER ::   jphem  =   2   ! parameter for the 2 hemispheres 
    3131   INTEGER , PUBLIC    ::   ndate_beg      ! initial calendar date (aammjj) for CFC 
    3232   INTEGER , PUBLIC    ::   nyear_res      ! restoring time constant (year) 
    3333   INTEGER , PUBLIC    ::   nyear_beg      ! initial year (aa)  
    34    INTEGER , PUBLIC    ::   npyear         ! Number of years read in CFC1112 file 
    3534    
    3635   REAL(wp), PUBLIC, DIMENSION(jpyear,jphem, jp_cfc) ::   p_cfc    ! partial hemispheric pressure for CFC           
    … …  
    9796      ! Temporal interpolation 
    9897      ! ---------------------- 
    99       iyear_beg = nyear - 1900 
     98      iyear_beg = nyear + ( nyear_res - 1900 - nyear_beg  ) 
    10099      IF ( nmonth <= 6 ) THEN 
    101          iyear_beg = iyear_beg - 1 
     100         iyear_beg = iyear_beg - 2 + nyear_beg 
    102101         im1       =  6 - nmonth + 1 
    103102         im2       =  6 + nmonth - 1 
    104103      ELSE 
     104         iyear_beg = iyear_beg - 1 + nyear_beg 
    105105         im1       = 12 - nmonth + 7 
    106106         im2       =      nmonth - 7 

  • branches/devmercator2010/NEMO/TOP_SRC/LOBSTER/par_lobster.F90

    r2047 r2072  
    1212 
    1313   IMPLICIT NONE 
     14   PUBLIC 
    1415 
    1516#if defined key_lobster 

  • branches/devmercator2010/NEMO/TOP_SRC/LOBSTER/trcbio.F90

    r1795 r2072  
    482482      ENDIF 
    483483 
    484       IF( l_trdtrc ) DEALLOCATE( ztrbio ) 
    485  
    486484      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    487485         WRITE(charout, FMT="('bio')") 

  • branches/devmercator2010/NEMO/TOP_SRC/LOBSTER/trcexp.F90

    r1795 r2072  
    164164      ENDIF 
    165165 
    166       IF( l_trdtrc ) DEALLOCATE( ztrbio ) 
    167  
    168166      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    169167         WRITE(charout, FMT="('exp')") 

  • branches/devmercator2010/NEMO/TOP_SRC/LOBSTER/trcini_lobster.F90

    r1800 r2072  
    2626   PUBLIC   trc_ini_lobster   ! called by trcini.F90 module 
    2727 
     28#  include "domzgr_substitute.h90" 
    2829#  include "top_substitute.h90" 
    2930   !!---------------------------------------------------------------------- 

  • branches/devmercator2010/NEMO/TOP_SRC/LOBSTER/trcopt.F90

    r1800 r2072  
    2828 
    2929   !!* Substitution 
    30 #  include "top_substitute.h90" 
     30#  include "domzgr_substitute.h90" 
    3131   !!---------------------------------------------------------------------- 
    3232   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  

  • branches/devmercator2010/NEMO/TOP_SRC/LOBSTER/trcsed.F90

    r1800 r2072  
    2929 
    3030   !!* Substitution 
    31 #  include "top_substitute.h90" 
     31#  include "domzgr_substitute.h90" 
    3232   !!---------------------------------------------------------------------- 
    3333   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
    … …  
    136136      ENDIF 
    137137 
    138       IF( l_trdtrc ) DEALLOCATE( ztrbio ) 
    139  
    140138      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    141139         WRITE(charout, FMT="('sed')") 

  • branches/devmercator2010/NEMO/TOP_SRC/MY_TRC/par_my_trc.F90

    r2047 r2072  
    3131 
    3232   IMPLICIT NONE 
     33   PUBLIC 
    3334 
    34    INTEGER, PARAMETER ::   jp_lm      = jp_lobster     + jp_pisces     + jp_cfc     + jp_c14b     !:  
    35    INTEGER, PARAMETER ::   jp_lm_2d   = jp_lobster_2d  + jp_pisces_2d  + jp_cfc_2d  + jp_c14b_2d  !: 
    36    INTEGER, PARAMETER ::   jp_lm_3d   = jp_lobster_3d  + jp_pisces_3d  + jp_cfc_3d  + jp_c14b_3d  !: 
    37    INTEGER, PARAMETER ::   jp_lm_trd  = jp_lobster_trd + jp_pisces_trd + jp_cfc_trd + jp_c14b_trd !: 
     35   INTEGER, PUBLIC, PARAMETER ::   jp_lpc      = jp_lobster     + jp_pisces     + jp_cfc     + jp_c14b     !:  
     36   INTEGER, PUBLIC, PARAMETER ::   jp_lpc_2d   = jp_lobster_2d  + jp_pisces_2d  + jp_cfc_2d  + jp_c14b_2d  !: 
     37   INTEGER, PUBLIC, PARAMETER ::   jp_lpc_3d   = jp_lobster_3d  + jp_pisces_3d  + jp_cfc_3d  + jp_c14b_3d  !: 
     38   INTEGER, PUBLIC, PARAMETER ::   jp_lpc_trd  = jp_lobster_trd + jp_pisces_trd + jp_cfc_trd + jp_c14b_trd !: 
    3839 
    3940#if defined key_my_trc 
    … …  
    4849 
    4950   ! assign an index in trc arrays for each PTS prognostic variables 
    50    INTEGER, PUBLIC, PARAMETER ::   jpmyt1 = jp_lm + 1     !: 1st MY_TRC tracer 
    51    INTEGER, PUBLIC, PARAMETER ::   jpmyt2 = jp_lm + 2     !: 2nd MY_TRC tracer 
     51   INTEGER, PUBLIC, PARAMETER ::   jpmyt1 = jp_lpc + 1     !: 1st MY_TRC tracer 
     52   INTEGER, PUBLIC, PARAMETER ::   jpmyt2 = jp_lpc + 2     !: 2nd MY_TRC tracer 
    5253 
    5354#else 
    … …  
    6364 
    6465   ! Starting/ending PISCES do-loop indices (N.B. no PISCES : jpl_pcs < jpf_pcs the do-loop are never done) 
    65    INTEGER, PUBLIC, PARAMETER ::   jp_myt0     = jp_lm     + 1              !: First index of MY_TRC passive tracers 
    66    INTEGER, PUBLIC, PARAMETER ::   jp_myt1     = jp_lm     + jp_my_trc      !: Last  index of MY_TRC passive tracers 
    67    INTEGER, PUBLIC, PARAMETER ::   jp_myt0_2d  = jp_lm_2d  + 1              !: First index of MY_TRC passive tracers 
    68    INTEGER, PUBLIC, PARAMETER ::   jp_myt1_2d  = jp_lm_2d  + jp_my_trc_2d   !: Last  index of MY_TRC passive tracers 
    69    INTEGER, PUBLIC, PARAMETER ::   jp_myt0_3d  = jp_lm_3d  + 1              !: First index of MY_TRC passive tracers 
    70    INTEGER, PUBLIC, PARAMETER ::   jp_myt1_3d  = jp_lm_3d  + jp_my_trc_3d   !: Last  index of MY_TRC passive tracers 
    71    INTEGER, PUBLIC, PARAMETER ::   jp_myt0_trd = jp_lm_trd + 1              !: First index of MY_TRC passive tracers 
    72    INTEGER, PUBLIC, PARAMETER ::   jp_myt1_trd = jp_lm_trd + jp_my_trc_trd  !: Last  index of MY_TRC passive tracers 
     66   INTEGER, PUBLIC, PARAMETER ::   jp_myt0     = jp_lpc     + 1              !: First index of MY_TRC passive tracers 
     67   INTEGER, PUBLIC, PARAMETER ::   jp_myt1     = jp_lpc     + jp_my_trc      !: Last  index of MY_TRC passive tracers 
     68   INTEGER, PUBLIC, PARAMETER ::   jp_myt0_2d  = jp_lpc_2d  + 1              !: First index of MY_TRC passive tracers 
     69   INTEGER, PUBLIC, PARAMETER ::   jp_myt1_2d  = jp_lpc_2d  + jp_my_trc_2d   !: Last  index of MY_TRC passive tracers 
     70   INTEGER, PUBLIC, PARAMETER ::   jp_myt0_3d  = jp_lpc_3d  + 1              !: First index of MY_TRC passive tracers 
     71   INTEGER, PUBLIC, PARAMETER ::   jp_myt1_3d  = jp_lpc_3d  + jp_my_trc_3d   !: Last  index of MY_TRC passive tracers 
     72   INTEGER, PUBLIC, PARAMETER ::   jp_myt0_trd = jp_lpc_trd + 1              !: First index of MY_TRC passive tracers 
     73   INTEGER, PUBLIC, PARAMETER ::   jp_myt1_trd = jp_lpc_trd + jp_my_trc_trd  !: Last  index of MY_TRC passive tracers 
    7374 
    7475   !!====================================================================== 

  • branches/devmercator2010/NEMO/TOP_SRC/MY_TRC/trcctl_my_trc.F90

    r2050 r2072  
    4040      IF(lwp) WRITE(numout,*) ' use COLOR tracer ' 
    4141 
    42       DO jl = 1, jp_my_trc 
     42      DO jn = 1, jp_my_trc 
    4343         jn = jp_myt0 + jl - 1 
    4444         WRITE(ctrcnm(jn),'(a,i2.2)') 'CLR',jn 

  • branches/devmercator2010/NEMO/TOP_SRC/PISCES/p4zbio.F90

    r1800 r2072  
    3939 
    4040   !!* Substitution 
    41 #  include "top_substitute.h90" 
     41#  include "domzgr_substitute.h90" 
    4242   !!---------------------------------------------------------------------- 
    4343   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  

  • branches/devmercator2010/NEMO/TOP_SRC/PISCES/p4zche.F90

    r1800 r2072  
    147147 
    148148   !!* Substitution 
    149 #include "top_substitute.h90" 
     149#include "domzgr_substitute.h90" 
    150150   !!---------------------------------------------------------------------- 
    151151   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  

  • branches/devmercator2010/NEMO/TOP_SRC/PISCES/p4zflx.F90

    r1836 r2072  
    5252 
    5353   !!* Substitution 
    54 #  include "top_substitute.h90" 
     54#  include "domzgr_substitute.h90" 
    5555   !!---------------------------------------------------------------------- 
    5656   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
    … …  
    204204          CALL mpp_sum( t_oce_co2_flx )   ! sum over the global domain 
    205205        ENDIF 
    206         ! Conversion in GtC/yr ; negative for outgoing from ocean 
    207         t_oce_co2_flx = (-1.) * t_oce_co2_flx  * 12. / 1.e15 
    208         ! 
    209206        WRITE(numout,*) ' Atmospheric pCO2    :' 
    210207        WRITE(numout,*) '-------------------- : ',kt,'  ',t_atm_co2_flx 
    211208        WRITE(numout,*) '(ppm)' 
    212         WRITE(numout,*) 'Total Flux of Carbon out of the ocean :' 
    213         WRITE(numout,*) '-------------------- : ',t_oce_co2_flx 
    214         WRITE(numout,*) '(GtC/yr)' 
     209        WRITE(numout,*) 'Total Flux of Carbon :' 
     210        WRITE(numout,*) '-------------------- : ',t_oce_co2_flx * 12. / 1e15 
     211        WRITE(numout,*) '(GtC/an)' 
    215212        t_atm_co2_flx = 0. 
    216213        t_oce_co2_flx = 0. 
    217 # if defined key_iomput 
    218         CALL iom_put( "tatpco2" , t_atm_co2_flx  ) 
    219         CALL iom_put( "tco2flx" , t_oce_co2_flx  ) 
    220 #endif 
    221214      ENDIF 
    222215#endif 

  • branches/devmercator2010/NEMO/TOP_SRC/PISCES/p4zlim.F90

    r1800 r2072  
    4141 
    4242   !!* Substitution 
    43 #  include "top_substitute.h90" 
     43#  include "domzgr_substitute.h90" 
    4444   !!---------------------------------------------------------------------- 
    4545   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  

  • branches/devmercator2010/NEMO/TOP_SRC/PISCES/p4zlys.F90

    r1836 r2072  
    6767#if defined key_trc_dia3d && defined key_iomput 
    6868      REAL(wp) ::   zrfact2 
    69       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zcaldiss 
     69      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zcaldiss, zw3d 
    7070#endif 
    7171      CHARACTER (len=25) :: charout 
    … …  
    9494                  ! SET DUMMY VARIABLE FOR TOTAL BORATE 
    9595                  zbot  = borat(ji,jj,jk) 
    96  
    97                   ! SET DUMMY VARIABLE FOR TOTAL BORATE 
    98                   zbot  = borat(ji,jj,jk) 
    9996                  zfact = rhop (ji,jj,jk) / 1000. + rtrn 
    10097 
    … …  
    174171#  else 
    175172      zrfact2 = 1.e3 * rfact2r 
    176       CALL iom_put( "PH"    , hi      (:,:,:)           * tmask(:,:,:) ) 
    177       CALL iom_put( "CO3"   , zco3    (:,:,:)           * tmask(:,:,:) ) 
    178       CALL iom_put( "CO3sat", aksp    (:,:,:) / calcon  * tmask(:,:,:) ) 
    179       CALL iom_put( "DCAL"  , zcaldiss(:,:,:) * zrfact2 * tmask(:,:,:) ) 
     173      zw3d(:,:,:) = hi  (:,:,:)                    * tmask(:,:,:) 
     174      CALL iom_put( "PH", zw3d ) 
     175      zw3d(:,:,:) = zco3(:,:,:)                    * tmask(:,:,:) 
     176      CALL iom_put( "CO3", zw3d ) 
     177      zw3d(:,:,:) = aksp(:,:,:) / calcon           * tmask(:,:,:) 
     178      CALL iom_put( "CO3sat", zw3d ) 
     179      zw3d(:,:,:) = zcaldiss(:,:,:) * zrfact2 * tmask(:,:,:) 
     180      CALL iom_put( "Dcal", zw3d ) 
    180181#  endif 
    181182# endif 
    … …  
    231232   END SUBROUTINE p4z_lys 
    232233#endif  
     234 
    233235   !!====================================================================== 
    234236END MODULE  p4zlys 

  • branches/devmercator2010/NEMO/TOP_SRC/PISCES/p4zmeso.F90

    r1836 r2072  
    4545 
    4646   !!* Substitution 
    47 #  include "top_substitute.h90" 
     47#  include "domzgr_substitute.h90" 
    4848   !!---------------------------------------------------------------------- 
    4949   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
    … …  
    7676#if defined key_trc_diaadd && defined key_trc_dia3d && defined key_iomput 
    7777      REAL(wp) :: zrfact2 
     78      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zw3d 
    7879#endif 
    7980 
    … …  
    202203      END DO 
    203204       
    204 #if defined key_trc_dia3d 
    205       ! Total grazing ( grazing by microzoo is already computed in p4zmicro )  
    206       grazing(:,:,:) = grazing(:,:,:) + (  zgrazd  (:,:,:) + zgrazz  (:,:,:) + zgrazn(:,:,:) & 
    207                      &                   + zgrazpoc(:,:,:) + zgrazffe(:,:,:)  ) 
    208 #endif 
    209  
    210205 
    211206      DO jk = 1,jpkm1 
    … …  
    316311#if defined key_trc_diaadd && defined key_trc_dia3d && defined key_iomput 
    317312      zrfact2 = 1.e3 * rfact2r 
    318       ! Total grazing of phyto by zoo 
    319       grazing(:,:,:) = grazing(:,:,:) * zrfact2 * tmask(:,:,:) 
    320       ! Calcite production 
    321       prodcal(:,:,:) = prodcal(:,:,:) * zrfact2 * tmask(:,:,:) 
    322       IF( jnt == nrdttrc ) then  
    323          CALL iom_put( "GRAZ" , grazing  )  ! Total grazing of phyto by zooplankton 
    324          CALL iom_put( "PCAL" , prodcal  )  ! Calcite production 
    325       ENDIF 
     313      zw3d(:,:,:) = (     zgrazd(:,:,:) +   zgrazz(:,:,:) + zgrazn(:,:,:) & 
     314                    & + zgrazpoc(:,:,:) + zgrazffe(:,:,:)                 ) * zrfact2 * tmask(:,:,:) 
     315      IF( jnt == nrdttrc ) CALL iom_put( "Graz2" , zw3d ) 
     316 
     317      zw3d(:,:,:) = prodcal(:,:,:) * zrfact2 * tmask(:,:,:) 
     318      IF( jnt == nrdttrc ) CALL iom_put( "Pcal"  , zw3d ) 
    326319#endif 
    327320 

  • branches/devmercator2010/NEMO/TOP_SRC/PISCES/p4zmicro.F90

    r1836 r2072  
    4343 
    4444   !!* Substitution 
    45 #  include "top_substitute.h90" 
     45#  include "domzgr_substitute.h90" 
    4646   !!---------------------------------------------------------------------- 
    4747   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
    … …  
    7070      REAL(wp), DIMENSION(jpi,jpj,jpk) :: zgrazmf, zgrazsf, zgrazpf 
    7171      CHARACTER (len=25) :: charout 
     72#if defined key_trc_diaadd && defined key_trc_dia3d && defined key_iomput 
     73      REAL(wp) :: zrfact2 
     74      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zw3d 
     75#endif 
    7276 
    7377      !!--------------------------------------------------------------------- 
    … …  
    8488      zgrazpf(:,:,:) = 0. 
    8589 
    86 #if defined key_trc_dia3d 
    87       grazing(:,:,:) = 0.  !: Initialisation of  grazing 
    88 #endif 
    8990 
    9091      zstep = rfact2 / rday      ! Time step duration for biology 
    … …  
    155156      END DO 
    156157       
    157 #if defined key_trc_dia3d 
    158       ! Grazing by microzooplankton 
    159       grazing(:,:,:) = grazing(:,:,:) + zgrazp(:,:,:) + zgrazm(:,:,:) + zgrazsd(:,:,:)  
    160 #endif 
    161158 
    162159      DO jk = 1,jpkm1 
    … …  
    234231      END DO 
    235232      ! 
    236       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     233#if defined key_trc_diaadd && defined key_trc_dia3d && defined key_iomput 
     234      zrfact2 = 1.e3 * rfact2r 
     235      zw3d(:,:,:) = ( zgrazp(:,:,:) + zgrazm(:,:,:) + zgrazsd(:,:,:) ) * zrfact2 * tmask(:,:,:) 
     236      IF( jnt == nrdttrc ) CALL iom_put( "Graz" , zw3d ) 
     237#endif 
     238 
     239       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    237240         WRITE(charout, FMT="('micro')") 
    238241         CALL prt_ctl_trc_info(charout) 
    239242         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
    240       ENDIF 
     243       ENDIF 
    241244 
    242245   END SUBROUTINE p4z_micro 

  • branches/devmercator2010/NEMO/TOP_SRC/PISCES/p4zmort.F90

    r1800 r2072  
    4141 
    4242   !!* Substitution 
    43 #  include "top_substitute.h90" 
     43#  include "domzgr_substitute.h90" 
    4444   !!---------------------------------------------------------------------- 
    4545   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  

  • branches/devmercator2010/NEMO/TOP_SRC/PISCES/p4zopt.F90

    r1836 r2072  
    3535    
    3636   !!* Substitution 
    37 #  include "top_substitute.h90" 
     37#  include "domzgr_substitute.h90" 
    3838   !!---------------------------------------------------------------------- 
    3939   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
    … …  
    6161      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zekg, zekr, zekb 
    6262      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze1 , ze2 , ze3, ze0 
     63#if defined key_trc_diaadd && defined key_iomput 
     64     REAL(wp), DIMENSION(jpi,jpj)      ::   zw2d 
     65     REAL(wp), DIMENSION(jpi,jpj,jpk)  ::   zw3d 
     66#endif 
    6367      !!--------------------------------------------------------------------- 
    6468 
    … …  
    234238# else 
    235239      ! write diagnostics  
    236       IF( jnt == nrdttrc ) then  
    237          CALL iom_put( "Heup", heup(:,:  ) * tmask(:,:,1) )  ! euphotic layer deptht 
    238          CALL iom_put( "PAR" , etot(:,:,:) * tmask(:,:,:) )  ! Photosynthetically Available Radiation 
    239       ENDIF 
     240      zw2d(:,:  ) =  heup(:,:  ) * tmask(:,:,1) 
     241      zw3d(:,:,:) =  etot(:,:,:) * tmask(:,:,:) 
     242      IF( jnt == nrdttrc ) CALL iom_put( "Heup", zw2d )                
     243      IF( jnt == nrdttrc ) CALL iom_put( "PAR" , zw3d ) 
    240244# endif 
    241245#endif 

  • branches/devmercator2010/NEMO/TOP_SRC/PISCES/p4zprod.F90

    r1836 r2072  
    5353 
    5454   !!* Substitution 
    55 #  include "top_substitute.h90" 
     55#  include "domzgr_substitute.h90" 
    5656   !!---------------------------------------------------------------------- 
    5757   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
    … …  
    8181#if defined key_trc_diaadd && defined key_trc_dia3d 
    8282      REAL(wp) ::   zrfact2 
     83#if  defined key_iomput 
     84      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zw3d 
     85#endif 
    8386#endif 
    8487      REAL(wp), DIMENSION(jpi,jpj)     ::   zmixnano   , zmixdiat, zstrn 
    … …  
    349352        WRITE(numout,*) 'Total PP :' 
    350353        WRITE(numout,*) '-------------------- : ',tpp * 12. / 1.E12 
    351         WRITE(numout,*) '(GtC/yr)' 
     354        WRITE(numout,*) '(GtC/an)' 
    352355        tpp = 0. 
    353356      ENDIF 
    354357 
    355 #if defined key_trc_diaadd && defined key_trc_dia3d && ! defined key_iomput 
     358#if defined key_trc_diaadd && defined key_trc_dia3d 
     359      zrfact2 = 1.e3 * rfact2r 
    356360      !   Supplementary diagnostics 
    357       zrfact2 = 1.e3 * rfact2r 
     361#  if ! defined key_iomput 
    358362      trc3d(:,:,:,jp_pcs0_3d + 4)  = zprorca (:,:,:) * zrfact2 * tmask(:,:,:) 
    359363      trc3d(:,:,:,jp_pcs0_3d + 5)  = zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) 
    … …  
    362366      trc3d(:,:,:,jp_pcs0_3d + 8)  = zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) * zysopt(:,:,:) 
    363367      trc3d(:,:,:,jp_pcs0_3d + 9)  = zprofed (:,:,:) * zrfact2 * tmask(:,:,:) 
    364 #  if ! defined key_kriest 
     368#if ! defined key_kriest 
    365369      trc3d(:,:,:,jp_pcs0_3d + 10) = zprofen (:,:,:) * zrfact2 * tmask(:,:,:) 
    366 #  endif 
    367370#endif 
    368371 
    369 #if defined key_trc_diaadd && defined key_trc_dia3d && defined key_iomput 
    370       zrfact2 = 1.e3 * rfact2r 
    371       IF ( jnt == nrdttrc ) then 
    372          CALL iom_put( "PPPHY" , zprorca (:,:,:) * zrfact2 * tmask(:,:,:) )  ! primary production by nanophyto 
    373          CALL iom_put( "PPPHY2", zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) )  ! primary production by diatom 
    374          CALL iom_put( "PPNEWN", zpronew (:,:,:) * zrfact2 * tmask(:,:,:) )  ! new primary production by nanophyto 
    375          CALL iom_put( "PPNEWD", zpronewd(:,:,:) * zrfact2 * tmask(:,:,:) )  ! new primary production by diatom 
    376          CALL iom_put( "PBSi"  , zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) * zysopt(:,:,:) ) ! biogenic silica production 
    377          CALL iom_put( "PFeD"  , zprofed (:,:,:) * zrfact2 * tmask(:,:,:) )  ! biogenic iron production by diatom 
    378          CALL iom_put( "PFeN"  , zprofen (:,:,:) * zrfact2 * tmask(:,:,:) )  ! biogenic iron production by nanophyto 
    379       ENDIF 
     372# else 
     373      zw3d(:,:,:) = zprorca (:,:,:) * zrfact2 * tmask(:,:,:) 
     374      IF( jnt == nrdttrc ) CALL iom_put( "PPPHY" , zw3d ) 
     375      zw3d(:,:,:) = zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) 
     376      IF( jnt == nrdttrc ) CALL iom_put( "PPPHY2", zw3d ) 
     377      zw3d(:,:,:) = zpronew (:,:,:) * zrfact2 * tmask(:,:,:) 
     378      IF( jnt == nrdttrc ) CALL iom_put( "PPNEWN" , zw3d ) 
     379      zw3d(:,:,:) = zpronewd(:,:,:) * zrfact2 * tmask(:,:,:) 
     380      IF( jnt == nrdttrc ) CALL iom_put( "PPNEWD", zw3d ) 
     381      zw3d(:,:,:) = zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) * zysopt(:,:,:) 
     382      IF( jnt == nrdttrc ) CALL iom_put( "PBSi"  , zw3d ) 
     383      zw3d(:,:,:) = zprofed (:,:,:) * zrfact2 * tmask(:,:,:) 
     384      IF( jnt == nrdttrc ) CALL iom_put( "PFeD"  , zw3d ) 
     385      zw3d(:,:,:) = zprofen (:,:,:) * zrfact2 * tmask(:,:,:) 
     386      IF( jnt == nrdttrc ) CALL iom_put( "PFeN"  , zw3d ) 
     387# endif 
    380388#endif 
    381389 

  • branches/devmercator2010/NEMO/TOP_SRC/PISCES/p4zrem.F90

    r1800 r2072  
    4545 
    4646   !!* Substitution 
    47 #  include "top_substitute.h90" 
     47#  include "domzgr_substitute.h90" 
    4848   !!---------------------------------------------------------------------- 
    4949   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  

  • branches/devmercator2010/NEMO/TOP_SRC/PISCES/p4zsed.F90

    r1836 r2072  
    9696      REAL(wp) :: zrfact2 
    9797# if defined key_iomput 
     98     REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zw3d  
    9899     REAL(wp), DIMENSION(jpi,jpj)    ::    zw2d  
    99100# endif 
    … …  
    331332      trc2d(:,:,jp_pcs0_2d + 12) = znitrpot(:,:,1) * 1.e-7 * zrfact2 * fse3t(:,:,1) * tmask(:,:,1) 
    332333# else 
    333       ! surface downward net flux of iron 
    334       zw2d(:,:)   =  ( zirondep(:,:,1) + ironsed(:,:,1) * rfact2 ) * zrfact2 * fse3t(:,:,1) * tmask(:,:,1)  
     334      ! write diagnostics 
     335      zw2d(:,:)   =  ( zirondep(:,:,1) + ironsed(:,:,1) * rfact2 ) & 
     336      &            * zrfact2 * fse3t(:,:,1) * tmask(:,:,1)      
    335337      IF( jnt == nrdttrc ) CALL iom_put( "Irondep", zw2d ) 
    336       ! nitrogen fixation at surface 
    337       zw2d(:,:)   =  znitrpot(:,:,1) * 1.e-7 * zrfact2  * fse3t(:,:,1) * tmask(:,:,1) 
    338       IF( jnt == nrdttrc ) CALL iom_put( "Nfix" , zw2d ) 
    339 # endif 
     338      zw3d(:,:,:) = znitrpot(:,:,:) * 1.e-7 * zrfact2  * fse3t(:,:,:) * tmask(:,:,:) 
     339      IF( jnt == nrdttrc ) CALL iom_put( "Nfix", zw3d  )  
     340# endif 
     341 
    340342# endif 
    341343      ! 

  • branches/devmercator2010/NEMO/TOP_SRC/PISCES/p4zsink.F90

    r1836 r2072  
    6969 
    7070   !!* Substitution 
    71 #  include "top_substitute.h90" 
     71#  include "domzgr_substitute.h90" 
    7272   !!---------------------------------------------------------------------- 
    7373   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
    … …  
    9999#if defined key_trc_diaadd 
    100100      REAL(wp) :: zrfact2 
    101       INTEGER  :: ik1 
     101      INTEGER  :: iksed1 
     102#if defined key_iomput 
     103      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zw3d 
     104#endif 
    102105#endif 
    103106      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   znum3d 
    … …  
    283286#if defined key_trc_diaadd 
    284287      zrfact2 = 1.e3 * rfact2r 
    285       ik1 = iksed + 1 
     288      iksed1 = iksed + 1 
    286289#  if ! defined key_iomput 
    287       trc2d(:,:  ,jp_pcs0_2d + 4)  = sinking (:,:,ik1) * zrfact2 * tmask(:,:,1) 
    288       trc2d(:,:  ,jp_pcs0_2d + 5)  = sinking2(:,:,ik1) * zrfact2 * tmask(:,:,1) 
    289       trc2d(:,:  ,jp_pcs0_2d + 6)  = sinkfer (:,:,ik1) * zrfact2 * tmask(:,:,1) 
    290       trc2d(:,:  ,jp_pcs0_2d + 7)  = sinksil (:,:,ik1) * zrfact2 * tmask(:,:,1) 
    291       trc2d(:,:  ,jp_pcs0_2d + 8)  = sinkcal (:,:,ik1) * zrfact2 * tmask(:,:,1) 
     290      trc2d(:,:  ,jp_pcs0_2d + 4)  = sinking (:,:,iksed1) * zrfact2 * tmask(:,:,1) 
     291      trc2d(:,:  ,jp_pcs0_2d + 5)  = sinking2(:,:,iksed1) * zrfact2 * tmask(:,:,1) 
     292      trc2d(:,:  ,jp_pcs0_2d + 6)  = sinkfer (:,:,iksed1) * zrfact2 * tmask(:,:,1) 
     293      trc2d(:,:  ,jp_pcs0_2d + 7)  = sinksil (:,:,iksed1) * zrfact2 * tmask(:,:,1) 
     294      trc2d(:,:  ,jp_pcs0_2d + 8)  = sinkcal (:,:,iksed1) * zrfact2 * tmask(:,:,1) 
    292295      trc3d(:,:,:,jp_pcs0_3d + 11) = sinking (:,:,:)      * zrfact2 * tmask(:,:,:) 
    293296      trc3d(:,:,:,jp_pcs0_3d + 12) = sinking2(:,:,:)      * zrfact2 * tmask(:,:,:) 
    … …  
    298301      trc3d(:,:,:,jp_pcs0_3d + 17) = wsbio4  (:,:,:)                * tmask(:,:,:) 
    299302#else 
    300       IF( jnt == nrdttrc ) then 
    301         CALL iom_put( "POCFlx"  , sinking (:,:,:)      * zrfact2 * tmask(:,:,:) )  ! POC export 
    302         CALL iom_put( "NumFlx"  , sinking2 (:,:,:)     * zrfact2 * tmask(:,:,:) )  ! Num export 
    303         CALL iom_put( "SiFlx"   , sinksil (:,:,:)      * zrfact2 * tmask(:,:,:) )  ! Silica export 
    304         CALL iom_put( "CaCO3Flx", sinkcal (:,:,:)      * zrfact2 * tmask(:,:,:) )  ! Calcite export 
    305         CALL iom_put( "xnum"    , znum3d  (:,:,:)                * tmask(:,:,:) )  ! Number of particles in aggregats 
    306         CALL iom_put( "W1"      , wsbio3  (:,:,:)                * tmask(:,:,:) )  ! sinking speed of POC 
    307         CALL iom_put( "W2"      , wsbio4  (:,:,:)                * tmask(:,:,:) )  ! sinking speed of aggregats 
    308         CALL iom_put( "PMO"     , sinking (:,:,ik1) * zrfact2 * tmask(:,:,1) )  ! POC export at 100m 
    309         CALL iom_put( "PMO2"    , sinking2(:,:,ik1) * zrfact2 * tmask(:,:,1) )  ! Num export at 100m 
    310         CALL iom_put( "ExpFe1"  , sinkfer (:,:,ik1) * zrfact2 * tmask(:,:,1) )  ! Export of iron at 100m 
    311         CALL iom_put( "ExpSi"   , sinksil (:,:,ik1) * zrfact2 * tmask(:,:,1) )  ! export of silica at 100m 
    312         CALL iom_put( "ExpCaCO3", sinkcal (:,:,ik1) * zrfact2 * tmask(:,:,1) )  ! export of calcite at 100m 
    313      ENDIF 
     303      zw3d(:,:,:)  = sinking (:,:,:) * zrfact2 * tmask(:,:,:) 
     304      IF( jnt == nrdttrc ) CALL iom_put( "PMO" , zw3d ) 
     305      zw3d(:,:,:)  = sinking2(:,:,:) * zrfact2 * tmask(:,:,:) 
     306      IF( jnt == nrdttrc ) CALL iom_put( "PMO2", zw3d ) 
     307      zw3d(:,:,:)  = sinkfer (:,:,:) * zrfact2 * tmask(:,:,:) 
     308      IF( jnt == nrdttrc ) CALL iom_put( "ExpFe1", zw3d ) 
     309      zw3d(:,:,:)  = sinksil (:,:,:) * zrfact2 * tmask(:,:,:) 
     310      IF( jnt == nrdttrc ) CALL iom_put( "ExpSi", zw3d ) 
     311      zw3d(:,:,:)  = sinkcal (:,:,:) * zrfact2 * tmask(:,:,:) 
     312      IF( jnt == nrdttrc ) CALL iom_put( "ExpCaCO3", zw3d ) 
     313      zw3d(:,:,:)  = sinking (:,:,:) * zrfact2 * tmask(:,:,:) 
     314      IF( jnt == nrdttrc ) CALL iom_put( "POCFlx", zw3d ) 
     315      zw3d(:,:,:)  = sinking2(:,:,:) * zrfact2 * tmask(:,:,:) 
     316      IF( jnt == nrdttrc ) CALL iom_put( "GOCFlx", zw3d ) 
     317      zw3d(:,:,:)  = sinksil (:,:,:) * zrfact2 * tmask(:,:,:) 
     318      IF( jnt == nrdttrc ) CALL iom_put( "SiFlx", zw3d ) 
     319      zw3d(:,:,:)  = sinkcal (:,:,:) * zrfact2 * tmask(:,:,:) 
     320      IF( jnt == nrdttrc ) CALL iom_put( "CaCO3Flx", zw3d ) 
     321      zw3d(:,:,:)  = znum3d  (:,:,:)           * tmask(:,:,:) 
     322      IF( jnt == nrdttrc ) CALL iom_put( "xnum", zw3d ) 
     323      zw3d(:,:,:)  = wsbio3  (:,:,:)           * tmask(:,:,:) 
     324      IF( jnt == nrdttrc ) CALL iom_put( "W1", zw3d ) 
     325      zw3d(:,:,:)  = wsbio4  (:,:,:)           * tmask(:,:,:) 
     326      IF( jnt == nrdttrc ) CALL iom_put( "W2", zw3d ) 
    314327#  endif 
    315328 
    … …  
    476489#if defined key_trc_dia3d 
    477490      REAL(wp) ::   zrfact2 
    478       INTEGER  ::   ik1 
     491      INTEGER  ::   iksed1 
     492#endif 
     493#if defined key_iomput 
     494      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zw3d 
    479495#endif 
    480496      CHARACTER (len=25) :: charout 
    … …  
    597613#if defined key_trc_diaadd 
    598614      zrfact2 = 1.e3 * rfact2r 
    599       ik1 = iksed + 1 
     615      iksed1 = iksed + 1 
    600616#  if ! defined key_iomput 
    601       trc2d(:,:,jp_pcs0_2d + 4) = sinking (:,:,ik1) * zrfact2 * tmask(:,:,1) 
    602       trc2d(:,:,jp_pcs0_2d + 5) = sinking2(:,:,ik1) * zrfact2 * tmask(:,:,1) 
    603       trc2d(:,:,jp_pcs0_2d + 6) = sinkfer (:,:,ik1) * zrfact2 * tmask(:,:,1) 
    604       trc2d(:,:,jp_pcs0_2d + 7) = sinkfer2(:,:,ik1) * zrfact2 * tmask(:,:,1) 
    605       trc2d(:,:,jp_pcs0_2d + 8) = sinksil (:,:,ik1) * zrfact2 * tmask(:,:,1) 
    606       trc2d(:,:,jp_pcs0_2d + 9) = sinkcal (:,:,ik1) * zrfact2 * tmask(:,:,1) 
     617      trc2d(:,:,jp_pcs0_2d + 4) = sinking (:,:,iksed1) * zrfact2 * tmask(:,:,1) 
     618      trc2d(:,:,jp_pcs0_2d + 5) = sinking2(:,:,iksed1) * zrfact2 * tmask(:,:,1) 
     619      trc2d(:,:,jp_pcs0_2d + 6) = sinkfer (:,:,iksed1) * zrfact2 * tmask(:,:,1) 
     620      trc2d(:,:,jp_pcs0_2d + 7) = sinkfer2(:,:,iksed1) * zrfact2 * tmask(:,:,1) 
     621      trc2d(:,:,jp_pcs0_2d + 8) = sinksil (:,:,iksed1) * zrfact2 * tmask(:,:,1) 
     622      trc2d(:,:,jp_pcs0_2d + 9) = sinkcal (:,:,iksed1) * zrfact2 * tmask(:,:,1) 
    607623#  else 
    608       IF( jnt == nrdttrc )  then 
    609          CALL iom_put( "EPC100"  , ( sinking(:,:,ik1) + sinking2(:,:,ik1) ) * zrfact2 * tmask(:,:,1) ) ! Export of carbon at 100m 
    610          CALL iom_put( "EPFE100" , ( sinkfer(:,:,ik1) + sinkfer2(:,:,ik1) ) * zrfact2 * tmask(:,:,1) ) ! Export of iron at 100m 
    611          CALL iom_put( "EPCAL100",   sinkcal(:,:,ik1)                       * zrfact2 * tmask(:,:,1) ) ! Export of calcite  at 100m 
    612          CALL iom_put( "EPSI100" ,   sinksil(:,:,ik1)                       * zrfact2 * tmask(:,:,1) ) ! Export of biogenic silica at 100m 
    613       ENDIF 
    614 #endif 
     624      zw3d(:,:,:)  = sinking (:,:,:) * zrfact2 * tmask(:,:,:) 
     625      IF( jnt == nrdttrc ) CALL iom_put( "ExpPOC" , zw3d ) 
     626      zw3d(:,:,:)  = sinking2(:,:,:) * zrfact2 * tmask(:,:,:) 
     627      IF( jnt == nrdttrc ) CALL iom_put( "ExpGOC", zw3d ) 
     628      zw3d(:,:,:)  = sinkfer (:,:,:) * zrfact2 * tmask(:,:,:) 
     629      IF( jnt == nrdttrc ) CALL iom_put( "ExpFe1", zw3d ) 
     630      zw3d(:,:,:)  = sinkfer2(:,:,:) * zrfact2 * tmask(:,:,:) 
     631      IF( jnt == nrdttrc ) CALL iom_put( "ExpFe2", zw3d ) 
     632      zw3d(:,:,:)  = sinksil (:,:,:) * zrfact2 * tmask(:,:,:) 
     633      IF( jnt == nrdttrc ) CALL iom_put( "ExpSi", zw3d ) 
     634      zw3d(:,:,:)  = sinkcal (:,:,:) * zrfact2 * tmask(:,:,:) 
     635      IF( jnt == nrdttrc ) CALL iom_put( "Expcal", zw3d ) 
     636#  endif 
    615637#endif 
    616638      ! 

  • branches/devmercator2010/NEMO/TOP_SRC/PISCES/par_pisces.F90

    r2049 r2072  
    1616 
    1717   IMPLICIT NONE 
     18   PUBLIC 
    1819 
    19    INTEGER, PARAMETER ::   jp_lp      = jp_lobster      !: cumulative number of already defined TRC 
    20    INTEGER, PARAMETER ::   jp_lp_2d   = jp_lobster_2d   !: 
    21    INTEGER, PARAMETER ::   jp_lp_3d   = jp_lobster_3d   !: 
    22    INTEGER, PARAMETER ::   jp_lp_trd  = jp_lobster_trd  !: 
     20   INTEGER, PUBLIC, PARAMETER ::   jp_l      = jp_lobster      !: cumulative number of already defined TRC 
     21   INTEGER, PUBLIC, PARAMETER ::   jp_l_2d   = jp_lobster_2d   !: 
     22   INTEGER, PUBLIC, PARAMETER ::   jp_l_3d   = jp_lobster_3d   !: 
     23   INTEGER, PUBLIC, PARAMETER ::   jp_l_trd  = jp_lobster_trd  !: 
    2324 
    2425#if defined key_pisces  &&  defined key_kriest 
    … …  
    3637   !    WARNING: be carefull about the order when reading the restart 
    3738        !   !!gm  this warning should be obsolet with IOM 
    38    INTEGER, PUBLIC, PARAMETER ::   jpdic = jp_lp +  1    !: dissolved inoganic carbon concentration  
    39    INTEGER, PUBLIC, PARAMETER ::   jptal = jp_lp +  2    !: total alkalinity  
    40    INTEGER, PUBLIC, PARAMETER ::   jpoxy = jp_lp +  3    !: oxygen carbon concentration  
    41    INTEGER, PUBLIC, PARAMETER ::   jpcal = jp_lp +  4    !: calcite  concentration  
    42    INTEGER, PUBLIC, PARAMETER ::   jppo4 = jp_lp +  5    !: phosphate concentration  
    43    INTEGER, PUBLIC, PARAMETER ::   jppoc = jp_lp +  6    !: small particulate organic phosphate concentration 
    44    INTEGER, PUBLIC, PARAMETER ::   jpsil = jp_lp +  7    !: silicate concentration 
    45    INTEGER, PUBLIC, PARAMETER ::   jpphy = jp_lp +  8    !: phytoplancton concentration  
    46    INTEGER, PUBLIC, PARAMETER ::   jpzoo = jp_lp +  9    !: zooplancton concentration 
    47    INTEGER, PUBLIC, PARAMETER ::   jpdoc = jp_lp + 10    !: dissolved organic carbon concentration  
    48    INTEGER, PUBLIC, PARAMETER ::   jpdia = jp_lp + 11    !: Diatoms Concentration 
    49    INTEGER, PUBLIC, PARAMETER ::   jpmes = jp_lp + 12    !: Mesozooplankton Concentration 
    50    INTEGER, PUBLIC, PARAMETER ::   jpbsi = jp_lp + 13    !: (big) Silicate Concentration 
    51    INTEGER, PUBLIC, PARAMETER ::   jpfer = jp_lp + 14    !: Iron Concentration 
    52    INTEGER, PUBLIC, PARAMETER ::   jpnum = jp_lp + 15    !: Big iron particles Concentration 
    53    INTEGER, PUBLIC, PARAMETER ::   jpsfe = jp_lp + 16    !: number of particulate organic phosphate concentration 
    54    INTEGER, PUBLIC, PARAMETER ::   jpdfe = jp_lp + 17    !: Diatoms iron Concentration 
    55    INTEGER, PUBLIC, PARAMETER ::   jpdsi = jp_lp + 18    !: Diatoms Silicate Concentration 
    56    INTEGER, PUBLIC, PARAMETER ::   jpnfe = jp_lp + 19    !: Nano iron Concentration 
    57    INTEGER, PUBLIC, PARAMETER ::   jpnch = jp_lp + 20    !: Nano Chlorophyll Concentration 
    58    INTEGER, PUBLIC, PARAMETER ::   jpdch = jp_lp + 21    !: Diatoms Chlorophyll Concentration 
    59    INTEGER, PUBLIC, PARAMETER ::   jpno3 = jp_lp + 22    !: Nitrates Concentration 
    60    INTEGER, PUBLIC, PARAMETER ::   jpnh4 = jp_lp + 23    !: Ammonium Concentration 
     39   INTEGER, PUBLIC, PARAMETER ::   jpdic = jp_l +  1    !: dissolved inoganic carbon concentration  
     40   INTEGER, PUBLIC, PARAMETER ::   jptal = jp_l +  2    !: total alkalinity  
     41   INTEGER, PUBLIC, PARAMETER ::   jpoxy = jp_l +  3    !: oxygen carbon concentration  
     42   INTEGER, PUBLIC, PARAMETER ::   jpcal = jp_l +  4    !: calcite  concentration  
     43   INTEGER, PUBLIC, PARAMETER ::   jppo4 = jp_l +  5    !: phosphate concentration  
     44   INTEGER, PUBLIC, PARAMETER ::   jppoc = jp_l +  6    !: small particulate organic phosphate concentration 
     45   INTEGER, PUBLIC, PARAMETER ::   jpsil = jp_l +  7    !: silicate concentration 
     46   INTEGER, PUBLIC, PARAMETER ::   jpphy = jp_l +  8    !: phytoplancton concentration  
     47   INTEGER, PUBLIC, PARAMETER ::   jpzoo = jp_l +  9    !: zooplancton concentration 
     48   INTEGER, PUBLIC, PARAMETER ::   jpdoc = jp_l + 10    !: dissolved organic carbon concentration  
     49   INTEGER, PUBLIC, PARAMETER ::   jpdia = jp_l + 11    !: Diatoms Concentration 
     50   INTEGER, PUBLIC, PARAMETER ::   jpmes = jp_l + 12    !: Mesozooplankton Concentration 
     51   INTEGER, PUBLIC, PARAMETER ::   jpbsi = jp_l + 13    !: (big) Silicate Concentration 
     52   INTEGER, PUBLIC, PARAMETER ::   jpfer = jp_l + 14    !: Iron Concentration 
     53   INTEGER, PUBLIC, PARAMETER ::   jpnum = jp_l + 15    !: Big iron particles Concentration 
     54   INTEGER, PUBLIC, PARAMETER ::   jpsfe = jp_l + 16    !: number of particulate organic phosphate concentration 
     55   INTEGER, PUBLIC, PARAMETER ::   jpdfe = jp_l + 17    !: Diatoms iron Concentration 
     56   INTEGER, PUBLIC, PARAMETER ::   jpdsi = jp_l + 18    !: Diatoms Silicate Concentration 
     57   INTEGER, PUBLIC, PARAMETER ::   jpnfe = jp_l + 19    !: Nano iron Concentration 
     58   INTEGER, PUBLIC, PARAMETER ::   jpnch = jp_l + 20    !: Nano Chlorophyll Concentration 
     59   INTEGER, PUBLIC, PARAMETER ::   jpdch = jp_l + 21    !: Diatoms Chlorophyll Concentration 
     60   INTEGER, PUBLIC, PARAMETER ::   jpno3 = jp_l + 22    !: Nitrates Concentration 
     61   INTEGER, PUBLIC, PARAMETER ::   jpnh4 = jp_l + 23    !: Ammonium Concentration 
    6162 
    6263#elif defined key_pisces 
    … …  
    7475   !    WARNING: be carefull about the order when reading the restart 
    7576        !   !!gm  this warning should be obsolet with IOM 
    76    INTEGER, PUBLIC, PARAMETER ::   jpdic = jp_lp +  1    !: dissolved inoganic carbon concentration  
    77    INTEGER, PUBLIC, PARAMETER ::   jptal = jp_lp +  2    !: total alkalinity  
    78    INTEGER, PUBLIC, PARAMETER ::   jpoxy = jp_lp +  3    !: oxygen carbon concentration  
    79    INTEGER, PUBLIC, PARAMETER ::   jpcal = jp_lp +  4    !: calcite  concentration  
    80    INTEGER, PUBLIC, PARAMETER ::   jppo4 = jp_lp +  5    !: phosphate concentration  
    81    INTEGER, PUBLIC, PARAMETER ::   jppoc = jp_lp +  6    !: small particulate organic phosphate concentration 
    82    INTEGER, PUBLIC, PARAMETER ::   jpsil = jp_lp +  7    !: silicate concentration 
    83    INTEGER, PUBLIC, PARAMETER ::   jpphy = jp_lp +  8    !: phytoplancton concentration  
    84    INTEGER, PUBLIC, PARAMETER ::   jpzoo = jp_lp +  9    !: zooplancton concentration 
    85    INTEGER, PUBLIC, PARAMETER ::   jpdoc = jp_lp + 10    !: dissolved organic carbon concentration  
    86    INTEGER, PUBLIC, PARAMETER ::   jpdia = jp_lp + 11    !: Diatoms Concentration 
    87    INTEGER, PUBLIC, PARAMETER ::   jpmes = jp_lp + 12    !: Mesozooplankton Concentration 
    88    INTEGER, PUBLIC, PARAMETER ::   jpbsi = jp_lp + 13    !: (big) Silicate Concentration 
    89    INTEGER, PUBLIC, PARAMETER ::   jpfer = jp_lp + 14    !: Iron Concentration 
    90    INTEGER, PUBLIC, PARAMETER ::   jpbfe = jp_lp + 15    !: Big iron particles Concentration 
    91    INTEGER, PUBLIC, PARAMETER ::   jpgoc = jp_lp + 16    !: big particulate organic phosphate concentration 
    92    INTEGER, PUBLIC, PARAMETER ::   jpsfe = jp_lp + 17    !: Small iron particles Concentration 
    93    INTEGER, PUBLIC, PARAMETER ::   jpdfe = jp_lp + 18    !: Diatoms iron Concentration 
    94    INTEGER, PUBLIC, PARAMETER ::   jpdsi = jp_lp + 19    !: Diatoms Silicate Concentration 
    95    INTEGER, PUBLIC, PARAMETER ::   jpnfe = jp_lp + 20    !: Nano iron Concentration 
    96    INTEGER, PUBLIC, PARAMETER ::   jpnch = jp_lp + 21    !: Nano Chlorophyll Concentration 
    97    INTEGER, PUBLIC, PARAMETER ::   jpdch = jp_lp + 22    !: Diatoms Chlorophyll Concentration 
    98    INTEGER, PUBLIC, PARAMETER ::   jpno3 = jp_lp + 23    !: Nitrates Concentration 
    99    INTEGER, PUBLIC, PARAMETER ::   jpnh4 = jp_lp + 24    !: Ammonium Concentration 
     77   INTEGER, PUBLIC, PARAMETER ::   jpdic = jp_l +  1    !: dissolved inoganic carbon concentration  
     78   INTEGER, PUBLIC, PARAMETER ::   jptal = jp_l +  2    !: total alkalinity  
     79   INTEGER, PUBLIC, PARAMETER ::   jpoxy = jp_l +  3    !: oxygen carbon concentration  
     80   INTEGER, PUBLIC, PARAMETER ::   jpcal = jp_l +  4    !: calcite  concentration  
     81   INTEGER, PUBLIC, PARAMETER ::   jppo4 = jp_l +  5    !: phosphate concentration  
     82   INTEGER, PUBLIC, PARAMETER ::   jppoc = jp_l +  6    !: small particulate organic phosphate concentration 
     83   INTEGER, PUBLIC, PARAMETER ::   jpsil = jp_l +  7    !: silicate concentration 
     84   INTEGER, PUBLIC, PARAMETER ::   jpphy = jp_l +  8    !: phytoplancton concentration  
     85   INTEGER, PUBLIC, PARAMETER ::   jpzoo = jp_l +  9    !: zooplancton concentration 
     86   INTEGER, PUBLIC, PARAMETER ::   jpdoc = jp_l + 10    !: dissolved organic carbon concentration  
     87   INTEGER, PUBLIC, PARAMETER ::   jpdia = jp_l + 11    !: Diatoms Concentration 
     88   INTEGER, PUBLIC, PARAMETER ::   jpmes = jp_l + 12    !: Mesozooplankton Concentration 
     89   INTEGER, PUBLIC, PARAMETER ::   jpbsi = jp_l + 13    !: (big) Silicate Concentration 
     90   INTEGER, PUBLIC, PARAMETER ::   jpfer = jp_l + 14    !: Iron Concentration 
     91   INTEGER, PUBLIC, PARAMETER ::   jpbfe = jp_l + 15    !: Big iron particles Concentration 
     92   INTEGER, PUBLIC, PARAMETER ::   jpgoc = jp_l + 16    !: big particulate organic phosphate concentration 
     93   INTEGER, PUBLIC, PARAMETER ::   jpsfe = jp_l + 17    !: Small iron particles Concentration 
     94   INTEGER, PUBLIC, PARAMETER ::   jpdfe = jp_l + 18    !: Diatoms iron Concentration 
     95   INTEGER, PUBLIC, PARAMETER ::   jpdsi = jp_l + 19    !: Diatoms Silicate Concentration 
     96   INTEGER, PUBLIC, PARAMETER ::   jpnfe = jp_l + 20    !: Nano iron Concentration 
     97   INTEGER, PUBLIC, PARAMETER ::   jpnch = jp_l + 21    !: Nano Chlorophyll Concentration 
     98   INTEGER, PUBLIC, PARAMETER ::   jpdch = jp_l + 22    !: Diatoms Chlorophyll Concentration 
     99   INTEGER, PUBLIC, PARAMETER ::   jpno3 = jp_l + 23    !: Nitrates Concentration 
     100   INTEGER, PUBLIC, PARAMETER ::   jpnh4 = jp_l + 24    !: Ammonium Concentration 
    100101 
    101102#else 
    … …  
    112113 
    113114   ! Starting/ending PISCES do-loop indices (N.B. no PISCES : jpl_pcs < jpf_pcs the do-loop are never done) 
    114    INTEGER, PUBLIC, PARAMETER ::   jp_pcs0     = jp_lp + 1                  !: First index of PISCES tracers 
    115    INTEGER, PUBLIC, PARAMETER ::   jp_pcs1     = jp_lp + jp_pisces          !: Last  index of PISCES tracers 
    116    INTEGER, PUBLIC, PARAMETER ::   jp_pcs0_2d  = jp_lp_2d + 1               !: First index of 2D diag 
    117    INTEGER, PUBLIC, PARAMETER ::   jp_pcs1_2d  = jp_lp_2d + jp_pisces_2d    !: Last  index of 2D diag 
    118    INTEGER, PUBLIC, PARAMETER ::   jp_pcs0_3d  = jp_lp_3d + 1               !: First index of 3D diag 
    119    INTEGER, PUBLIC, PARAMETER ::   jp_pcs1_3d  = jp_lp_3d + jp_pisces_3d    !: Last  index of 3d diag 
    120    INTEGER, PUBLIC, PARAMETER ::   jp_pcs0_trd = jp_lp_trd + 1              !: First index of bio diag 
    121    INTEGER, PUBLIC, PARAMETER ::   jp_pcs1_trd = jp_lp_trd + jp_pisces_trd  !: Last  index of bio diag 
     115   INTEGER, PUBLIC, PARAMETER ::   jp_pcs0     = jp_l + 1                  !: First index of PISCES tracers 
     116   INTEGER, PUBLIC, PARAMETER ::   jp_pcs1     = jp_l + jp_pisces          !: Last  index of PISCES tracers 
     117   INTEGER, PUBLIC, PARAMETER ::   jp_pcs0_2d  = jp_l_2d + 1               !: First index of 2D diag 
     118   INTEGER, PUBLIC, PARAMETER ::   jp_pcs1_2d  = jp_l_2d + jp_pisces_2d    !: Last  index of 2D diag 
     119   INTEGER, PUBLIC, PARAMETER ::   jp_pcs0_3d  = jp_l_3d + 1               !: First index of 3D diag 
     120   INTEGER, PUBLIC, PARAMETER ::   jp_pcs1_3d  = jp_l_3d + jp_pisces_3d    !: Last  index of 3d diag 
     121   INTEGER, PUBLIC, PARAMETER ::   jp_pcs0_trd = jp_l_trd + 1              !: First index of bio diag 
     122   INTEGER, PUBLIC, PARAMETER ::   jp_pcs1_trd = jp_l_trd + jp_pisces_trd  !: Last  index of bio diag 
    122123 
    123124 

  • branches/devmercator2010/NEMO/TOP_SRC/PISCES/sms_pisces.F90

    r1836 r2072  
    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 
    4240 
    4341   !!*  Biological fluxes for light 
    … …  
    6462#if defined key_trc_dia3d 
    6563   REAL(wp), DIMENSION(jpi,jpj,jpk) ::   prodcal    !: Calcite production 
    66    REAL(wp), DIMENSION(jpi,jpj,jpk) ::   grazing    !: Total zooplankton grazing 
    6764#endif 
    6865 

  • branches/devmercator2010/NEMO/TOP_SRC/PISCES/trcini_pisces.F90

    r1800 r2072  
    3838      no3    =  31.04e-6 * 7.6 
    3939 
     40#  include "domzgr_substitute.h90" 
    4041#  include "top_substitute.h90" 
    4142   !!---------------------------------------------------------------------- 

  • branches/devmercator2010/NEMO/TOP_SRC/PISCES/trclsm_pisces.F90

    r1801 r2072  
    6767      NAMELIST/nampisdia/ nwritedia, pisdia3d, pisdia2d     ! additional diagnostics 
    6868#endif 
    69       NAMELIST/nampisdmp/ ln_pisdmp, ln_pisclo 
     69      NAMELIST/nampisdmp/ ln_pisdmp 
    7070 
    7171      !!---------------------------------------------------------------------- 
    … …  
    188188         WRITE(numout,*) 
    189189         WRITE(numout,*) ' Namelist : nampisdmp' 
    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 
     190         WRITE(numout,*) '    Relaxation of tracer to glodap mean value    ln_pisdmp      =', ln_pisdmp 
    192191         WRITE(numout,*) ' ' 
    193192      ENDIF 

  • branches/devmercator2010/NEMO/TOP_SRC/TRP/trctrp.F90

    r1800 r2072  
    5353 
    5454   !! * Substitutions 
    55 #  include "top_substitute.h90" 
     55#  include "domzgr_substitute.h90" 
    5656   !!---------------------------------------------------------------------- 
    5757   !! NEMO/TOP 1.0 , LOCEAN-IPSL (2005)  

  • branches/devmercator2010/NEMO/TOP_SRC/TRP/trczdf_imp.F90

    r1794 r2072  
    112112         rdttrc(:) =  rdttra(:) * FLOAT(ndttrc)       
    113113      ENDIF 
    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       !                                                       ! =========== 
     114     !                                                       ! =========== 
    144115      DO jn = 1, jptra                                        ! tracer loop 
    145116         !                                                    ! =========== 
    146117         IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)         ! ??? validation needed 
    147118 
     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 
    148123    zwt( 1 ,:,:) = 0.e0     ;     zwt(jpi,:,:) = 0.e0      
    149124         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 
    150148          
    151149         ! Second member construction 

  • branches/devmercator2010/NEMO/TOP_SRC/TRP/trczdf_iso.F90

    r1794 r2072  
    182182 
    183183 
    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 
     184 
     185      DO jn = 1, jptra 
    203186 
    204187         IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn)          ! save trends 
    … …  
    279262            END DO 
    280263 
     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 
    281279 
    282280#if defined key_trcldf_eiv 

  • branches/devmercator2010/NEMO/TOP_SRC/TRP/trczdf_iso_vopt.F90

    r1794 r2072  
    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  
    267182      IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk) ) 
    268183 
    … …  
    272187          
    273188         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 
    274197 
    275198#  if defined key_trc_diatrd 
    … …  
    277200         ztrd(:,:,:) = tra(:,:,:,jn) 
    278201#  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 
    279281 
    280282         ! second recurrence:    Zk = Yk - Ik / Tk-1  Zk-1 

  • branches/devmercator2010/NEMO/TOP_SRC/par_trc.F90

    r2047 r2072  
    1818   USE par_lobster   ! LOBSTER model 
    1919   USE par_pisces    ! PISCES  model 
    20    USE par_c14b      ! C14 bomb tracer 
    2120   USE par_cfc       ! CFC 11 and 12 tracers 
     21   USE par_c14b      ! C14 bomb tracer  
    2222   USE par_my_trc    ! user defined passive tracers 
    2323 
    2424   IMPLICIT NONE 
     25   PUBLIC 
    2526 
    2627   ! Passive tracers : Total size 
    2728   ! ---------------               ! total number of passive tracers, of 2d and 3d output and trend arrays 
    28    INTEGER, PUBLIC,  PARAMETER ::   jptra    =  jp_lobster    + jp_pisces     + jp_cfc     + jp_c14b    + jp_my_trc 
    29    INTEGER, PUBLIC,  PARAMETER ::   jpdia2d  =  jp_lobster_2d + jp_pisces_2d  + jp_cfc_2d  + jp_c14b_2d + jp_my_trc_2d 
    30    INTEGER, PUBLIC,  PARAMETER ::   jpdia3d  =  jp_lobster_3d + jp_pisces_3d  + jp_cfc_3d  + jp_c14b_3d + jp_my_trc_3d 
     29   INTEGER, PUBLIC, PARAMETER ::   jptra    =  jp_lobster    + jp_pisces     + jp_cfc     + jp_c14b     + jp_my_trc 
     30   INTEGER, PUBLIC, PARAMETER ::   jpdia2d  =  jp_lobster_2d + jp_pisces_2d  + jp_cfc_2d  + jp_c14b_2d + jp_my_trc_2d 
     31   INTEGER, PUBLIC, PARAMETER ::   jpdia3d  =  jp_lobster_3d + jp_pisces_3d  + jp_cfc_3d  + jp_c14b_3d + jp_my_trc_3d 
    3132   !                     ! total number of sms diagnostic arrays 
    32    INTEGER, PUBLIC,  PARAMETER ::   jpdiabio = jp_lobster_trd + jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_my_trc_trd 
     33   INTEGER, PUBLIC, PARAMETER ::   jpdiabio = jp_lobster_trd + jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_my_trc_trd 
    3334    
    3435   !  1D configuration ("key_c1d") 
    … …  
    3940   LOGICAL, PUBLIC, PARAMETER ::   lk_trc_c1d   = .FALSE.  !: 1D pass. tracer configuration flag 
    4041# endif 
     42 
    4143   ! Passive tracers : size for TRP trends diagnotics (used if 'key_trc_diatrd' defined) 
    42 # if defined key_trc_diatrd 
    43    ! Passive tracers : size for TRP trends diagnotics (used if 'key_trc_diatrd' defined) 
    44    INTEGER, PUBLIC,  PARAMETER ::   jptrc_xad     =  1   !: x- horizontal advection 
    45    INTEGER, PUBLIC,  PARAMETER ::   jptrc_yad     =  2   !: y- horizontal advection 
    46    INTEGER, PUBLIC,  PARAMETER ::   jptrc_zad     =  3   !: z- vertical   advection 
    47    INTEGER, PUBLIC,  PARAMETER ::   jptrc_xdf     =  4   !: lateral       diffusion 
    48    INTEGER, PUBLIC,  PARAMETER ::   jptrc_ydf     =  5   !: lateral       diffusion 
    49    INTEGER, PUBLIC,  PARAMETER ::   jptrc_zdf     =  6   !: vertical diffusion (Kz) 
    50    INTEGER, PUBLIC,  PARAMETER ::   jptrc_sbc     =  7   !: surface boundary condition 
    51 #if ! defined key_trcldf_eiv && ! defined key_trcdmp 
    52    INTEGER, PUBLIC,  PARAMETER ::   jpdiatrc      =  7  !: trends: 3*(advection + diffusion       ) + sbc 
    53 #endif 
    54 #if defined key_trcldf_eiv && defined key_trcdmp 
    55    INTEGER, PUBLIC,  PARAMETER ::   jptrc_xei     =  8   !: x- horiz. EIV advection 
    56    INTEGER, PUBLIC,  PARAMETER ::   jptrc_yei     =  9   !: y- horiz. EIV advection 
    57    INTEGER, PUBLIC,  PARAMETER ::   jptrc_zei     = 10   !: z- vert.  EIV advection 
    58    INTEGER, PUBLIC,  PARAMETER ::   jptrc_dmp     = 11   !: damping 
    59    INTEGER, PUBLIC,  PARAMETER ::   jpdiatrc      = 11   !: trends: 3*(advection + diffusion + eiv ) + sbc + damping 
    60 #endif 
    61 #if defined key_trcldf_eiv && ! defined key_trcdmp 
    62    INTEGER, PUBLIC,  PARAMETER ::   jptrc_xei     =  8   !: x- horiz. EIV advection 
    63    INTEGER, PUBLIC,  PARAMETER ::   jptrc_yei     =  9   !: y- horiz. EIV advection 
    64    INTEGER, PUBLIC,  PARAMETER ::   jptrc_zei     = 10   !: z- vert.  EIV advection 
    65    INTEGER, PUBLIC,  PARAMETER ::   jpdiatrc      = 10   !: trends: 3*(advection + diffusion + eiv ) + sbc  
    66 #endif 
    67 #if ! defined key_trcldf_eiv && defined key_trcdmp 
    68    INTEGER, PUBLIC,  PARAMETER ::   jptrc_dmp     =  8   !: damping 
    69    INTEGER, PUBLIC,  PARAMETER ::   jpdiatrc      =  8   !: trends: 3*(advection + diffusion       ) + sbc + damping 
    70 #endif 
     44#if defined key_trcldf_eiv 
     45# if defined key_trcdmp 
     46   INTEGER, PARAMETER :: jpdiatrc = 11      !: trends: 3*(advection + diffusion + eiv ) + damping + sms 
     47# else 
     48   INTEGER, PARAMETER :: jpdiatrc = 10      !: trends: 3*(advection + diffusion + eiv )           + sms 
     49# endif 
     50#else 
     51# if defined key_trcdmp 
     52   INTEGER, PARAMETER :: jpdiatrc =  8      !: trends: 3*(advection + diffusion       ) + damping + sms 
     53# else 
     54   INTEGER, PARAMETER :: jpdiatrc =  7      !: trends: 3*(advection + diffusion       ) + damping + sms 
     55# endif 
    7156#endif 
    7257 

  • branches/devmercator2010/NEMO/TOP_SRC/trcdia.F90

    r1836 r2072  
    2525   USE trc 
    2626   USE trp_trc 
    27    USE par_trc 
    2827   USE trdmld_trc_oce, ONLY : luttrd 
    2928   USE dianam    ! build name of file (routine) 
    … …  
    4241   INTEGER  ::   ndimt50   !: number of ocean points in index array 
    4342   INTEGER  ::   ndimt51   !: number of ocean points in index array 
    44    REAL(wp) ::   zjulian   !: ????   not DOCTOR ! 
     43   REAL(wp) ::   xjulian   !: ????   not DOCTOR ! 
    4544   INTEGER , DIMENSION (jpij*jpk) ::   ndext50   !: integer arrays for ocean 3D index 
    4645   INTEGER , DIMENSION (jpij)     ::   ndext51   !: integer arrays for ocean surface index 
    … …  
    158157 
    159158         ! Compute julian date from starting date of the run 
    160          CALL ymds2ju( nyear, nmonth, nday, rdt, zjulian ) 
    161          zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment 
     159         CALL ymds2ju( nyear, nmonth, nday, rdt, xjulian ) 
     160         xjulian = xjulian - adatrj   !   set calendar origin to the beginning of the experiment 
    162161         IF(lwp)WRITE(numout,*)' '   
    163162         IF(lwp)WRITE(numout,*)' Date 0 used :', nittrc000                         & 
    164163            &                 ,' YEAR ', nyear, ' MONTH ', nmonth, ' DAY ', nday   & 
    165             &                 ,'Julian day : ', zjulian   
     164            &                 ,'Julian day : ', xjulian   
    166165   
    167166         IF(lwp) WRITE(numout,*) ' indexes of zoom = ', iimi, iima, ijmi, ijma,  & 
    … …  
    172171         IF(lwp) THEN 
    173172            CALL dia_nam( clhstnam, nwritetrc,' ' ) 
    174             CALL ctlopn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', 1, numout, lwp, narea ) 
     173            CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
    175174            WRITE(inum,*) clhstnam 
    176175            CLOSE(inum) 
    … …  
    185184         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,     & 
    186185            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,         &  
    187             &          nittrc000-ndttrc, zjulian, zdt, nhorit5, nit5 , domain_id=nidom) 
     186            &          nittrc000-ndttrc, xjulian, zdt, nhorit5, nit5 , domain_id=nidom) 
    188187 
    189188         ! Vertical grid for tracer : gdept 
    … …  
    259258      CHARACTER (len=80) ::   cltral 
    260259      CHARACTER (len=10) ::   csuff 
    261       INTEGER  ::   jn, jl, ikn 
     260      INTEGER  ::   jn, jl 
    262261      INTEGER  ::   iimi, iima, ijmi, ijma, ipk, it, itmod 
    263262      REAL(wp) ::   zsto, zout, zdt 
    … …  
    314313               CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,       & 
    315314                  &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,   & 
    316                   &          nittrc000-ndttrc, zjulian, zdt, nhorit6(jn),  & 
     315                  &          nittrc000-ndttrc, xjulian, zdt, nhorit6(jn),  & 
    317316                  &          nit6(jn) , domain_id=nidom ) 
    318317 
    … …  
    323322 
    324323          ! Declare all the output fields as NETCDF variables 
     324 
     325          ! trends for tracer concentrations 
    325326          DO jn = 1, jptra 
    326327            IF( luttrd(jn) ) THEN 
    327328                DO jl = 1, jpdiatrc 
    328                   IF( jl == jptrc_xad ) THEN 
     329                  IF( jl == 1 ) THEN 
    329330                      ! short and long title for x advection for tracer 
    330331                      WRITE (cltra,'("XAD_",16a)') ctrcnm(jn) 
    331                       WRITE (cltral,'("X advective trend for ",58a)') ctrcnl(jn)(1:58) 
    332                   END IF 
    333                   IF( jl == jptrc_yad ) THEN 
     332                      WRITE (cltral,'("X advective trend for ",58a)')  & 
     333                         &      ctrcnl(jn)(1:58) 
     334                  END IF 
     335                  IF( jl == 2 ) THEN 
    334336                      ! short and long title for y advection for tracer 
    335337                      WRITE (cltra,'("YAD_",16a)') ctrcnm(jn) 
    336                       WRITE (cltral,'("Y advective trend for ",58a)') ctrcnl(jn)(1:58) 
    337                   END IF 
    338                   IF( jl == jptrc_zad ) THEN 
     338                      WRITE (cltral,'("Y advective trend for ",58a)')  & 
     339                         &      ctrcnl(jn)(1:58) 
     340                  END IF 
     341                  IF( jl == 3 ) THEN 
    339342                      ! short and long title for Z advection for tracer 
    340343                      WRITE (cltra,'("ZAD_",16a)') ctrcnm(jn) 
    341                       WRITE (cltral,'("Z advective trend for ",58a)') ctrcnl(jn)(1:58) 
    342                   END IF 
    343                   IF( jl == jptrc_xdf ) THEN 
     344                      WRITE (cltral,'("Z advective trend for ",58a)')  & 
     345                         &      ctrcnl(jn)(1:58) 
     346                  END IF 
     347                  IF( jl == 4 ) THEN 
    344348                      ! short and long title for X diffusion for tracer 
    345349                      WRITE (cltra,'("XDF_",16a)') ctrcnm(jn) 
    346                       WRITE (cltral,'("X diffusion trend for ",58a)') ctrcnl(jn)(1:58) 
    347                   END IF 
    348                   IF( jl == jptrc_ydf ) THEN 
     350                      WRITE (cltral,'("X diffusion trend for ",58a)')  & 
     351                         &      ctrcnl(jn)(1:58) 
     352                  END IF 
     353                  IF( jl == 5 ) THEN 
    349354                      ! short and long title for Y diffusion for tracer 
    350355                      WRITE (cltra,'("YDF_",16a)') ctrcnm(jn) 
    351                       WRITE (cltral,'("Y diffusion trend for ",58a)') ctrcnl(jn)(1:58) 
    352                   END IF 
    353                   IF( jl == jptrc_zdf ) THEN 
     356                      WRITE (cltral,'("Y diffusion trend for ",58a)')  & 
     357                         &      ctrcnl(jn)(1:58) 
     358                  END IF 
     359                  IF( jl == 6 ) THEN 
    354360                      ! short and long title for Z diffusion for tracer 
    355361                      WRITE (cltra,'("ZDF_",16a)') ctrcnm(jn) 
    356                       WRITE (cltral,'("Z diffusion trend for ",58a)') ctrcnl(jn)(1:58) 
     362                      WRITE (cltral,'("Z diffusion trend for ",58a)')  & 
     363                         &      ctrcnl(jn)(1:58) 
    357364                  END IF 
    358365# if defined key_trcldf_eiv 
    359                   IF( jl == jptrc_xei ) THEN 
     366                  IF( jl == 7 ) THEN 
    360367                      ! short and long title for x gent velocity for tracer 
    361368                      WRITE (cltra,'("XGV_",16a)') ctrcnm(jn) 
    362                       WRITE (cltral,'("X gent velocity trend for ",53a)') ctrcnl(jn)(1:53) 
    363                   END IF 
    364                   IF( jl == jptrc_yei ) THEN 
     369                      WRITE (cltral,'("X gent velocity trend for ",53a)')  & 
     370                         &      ctrcnl(jn)(1:53) 
     371                  END IF 
     372                  IF( jl == 8 ) THEN 
    365373                      ! short and long title for y gent velocity for tracer 
    366374                      WRITE (cltra,'("YGV_",16a)') ctrcnm(jn) 
    367                       WRITE (cltral,'("Y gent velocity trend for ",53a)') ctrcnl(jn)(1:53) 
    368                   END IF 
    369                   IF( jl == jptrc_zei ) THEN 
     375                      WRITE (cltral,'("Y gent velocity trend for ",53a)')  & 
     376                         &      ctrcnl(jn)(1:53) 
     377                  END IF 
     378                  IF( jl == 9 ) THEN 
    370379                      ! short and long title for Z gent velocity for tracer 
    371380                      WRITE (cltra,'("ZGV_",16a)') ctrcnm(jn) 
    372                       WRITE (cltral,'("Z gent velocity trend for ",53a)') ctrcnl(jn)(1:53) 
     381                      WRITE (cltral,'("Z gent velocity trend for ",53a)')  & 
     382                         &      ctrcnl(jn)(1:53) 
    373383                  END IF 
    374384# endif 
    375385# if defined key_trcdmp 
    376                   IF( jl == jptrc_dmp ) THEN 
     386                  IF( jl == jpdiatrc - 1 ) THEN 
    377387                      ! last trends for tracer damping : short and long title 
    378388                      WRITE (cltra,'("TDM_",16a)') ctrcnm(jn) 
    379                       WRITE (cltral,'("Tracer damping trend for ",55a)') ctrcnl(jn)(1:55) 
    380                   END IF 
    381 # endif 
    382                   IF( jl == jptrc_sbc ) THEN 
     389                      WRITE (cltral,'("Tracer damping trend for ",55a)')  & 
     390                         &      ctrcnl(jn)(1:55) 
     391                  END IF 
     392# endif 
     393                  IF( jl == jpdiatrc ) THEN 
    383394                      ! last trends for tracer damping : short and long title 
    384395                      WRITE (cltra,'("SBC_",16a)') ctrcnm(jn) 
    385                       WRITE (cltral,'("Surface boundary flux ",58a)') ctrcnl(jn)(1:55) 
    386                   END IF 
    387                       WRITE (cltral,'("Surface boundary flux ",58a)') ctrcnl(jn)(1:55) 
    388                   END IF 
     396                      WRITE (cltral,'("Surface boundary flux ",58a)')  & 
     397                      &      ctrcnl(jn)(1:58) 
     398                  END IF 
     399 
    389400                  CALL FLUSH( numout ) 
    390401                  cltrau = ctrcun(jn)      ! UNIT for tracer /trends 
    … …  
    395406            END IF 
    396407         END DO 
     408 
    397409         ! CLOSE netcdf Files 
    398410          DO jn = 1, jptra 
    … …  
    420432      DO jn = 1, jptra 
    421433         IF( luttrd(jn) ) THEN 
    422             ikn = ikeep(jn)  
    423434            DO jl = 1, jpdiatrc 
    424                ! short titles 
    425                IF( jl == jptrc_xad)   WRITE (cltra,'("XAD_",16a)') ctrcnm(jn) 
    426                IF( jl == jptrc_yad)   WRITE (cltra,'("YAD_",16a)') ctrcnm(jn) 
    427                IF( jl == jptrc_zad)   WRITE (cltra,'("ZAD_",16a)') ctrcnm(jn) 
    428                IF( jl == jptrc_xdf)   WRITE (cltra,'("XDF_",16a)') ctrcnm(jn) 
    429                IF( jl == jptrc_ydf)   WRITE (cltra,'("YDF_",16a)') ctrcnm(jn) 
    430                IF( jl == jptrc_zdf)   WRITE (cltra,'("ZDF_",16a)') ctrcnm(jn) 
     435               ! short titles  
     436               IF( jl == 1)   WRITE (cltra,'("XAD_",16a)') ctrcnm(jn)      ! x advection for tracer 
     437               IF( jl == 2)   WRITE (cltra,'("YAD_",16a)') ctrcnm(jn)      ! z advection for tracer 
     438               IF( jl == 3)   WRITE (cltra,'("ZAD_",16a)') ctrcnm(jn)      ! z advection for tracer 
     439               IF( jl == 4)   WRITE (cltra,'("XDF_",16a)') ctrcnm(jn)      ! x diffusion for tracer 
     440               IF( jl == 5)   WRITE (cltra,'("YDF_",16a)') ctrcnm(jn)      ! y diffusion for tracer 
     441               IF( jl == 6)   WRITE (cltra,'("ZDF_",16a)') ctrcnm(jn)      ! z diffusion for tracer 
    431442# if defined key_trcldf_eiv 
    432                IF( jl == jptrc_xei)   WRITE (cltra,'("XGV_",16a)') ctrcnm(jn) 
    433                IF( jl == jptrc_yei)   WRITE (cltra,'("YGV_",16a)') ctrcnm(jn) 
    434                IF( jl == jptrc_zei)   WRITE (cltra,'("ZGV_",16a)') ctrcnm(jn) 
     443               IF( jl == 7)   WRITE (cltra,'("XGV_",16a)') ctrcnm(jn)      ! x gent velocity for tracer 
     444               IF( jl == 8)   WRITE (cltra,'("YGV_",16a)') ctrcnm(jn)      ! y gent velocity for tracer 
     445               IF( jl == 9)   WRITE (cltra,'("ZGV_",16a)') ctrcnm(jn)      ! z gent velocity for tracer 
    435446# endif 
    436447# if defined key_trcdmp 
    437                IF( jl == jptrc_dmp )  WRITE (cltra,'("TDM_",16a)') ctrcnm(jn) 
    438 # endif 
    439                IF( jl == jptrc_sbc )  WRITE (cltra,'("SBC_",16a)') ctrcnm(jn) 
     448               IF( jl == jpdiatrc - 1 )   WRITE (cltra,'("TDM_",16a)') ctrcnm(jn)      ! damping 
     449# endif 
     450               IF( jl == jpdiatrc )   WRITE (cltra,'("SBC_",a)') ctrcnm(jn)      ! surface boundary conditions 
    440451               ! 
    441                CALL histwrite(nit6(jn), cltra, it, trtrd(:,:,:,ikn,jl),ndimt50, ndext50) 
     452               CALL histwrite(nit6(jn), cltra, it, trtrd(:,:,:,ikeep(jn),jl),ndimt50, ndext50) 
    442453            END DO 
    443454         END IF 
    … …  
    541552         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,             & 
    542553            &          iimi, iima-iimi+1, ijmi, ijma-ijmi+1,         & 
    543             &          nittrc000-ndttrc, zjulian, zdt, nhoritd, nitd , domain_id=nidom ) 
     554            &          nittrc000-ndttrc, xjulian, zdt, nhoritd, nitd , domain_id=nidom ) 
    544555 
    545556         ! Vertical grid for 2d and 3d arrays 
    … …  
    689700         CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,      & 
    690701            &    iimi, iima-iimi+1, ijmi, ijma-ijmi+1,          & 
    691             &    nittrc000-ndttrc, zjulian, zdt, nhoritb, nitb , domain_id=nidom ) 
     702            &    nittrc000-ndttrc, xjulian, zdt, nhoritb, nitb , domain_id=nidom ) 
    692703         ! Vertical grid for biological trends 
    693704         CALL histvert(nitb, 'deptht', 'Vertical T levels', 'm', ipk, gdept_0, ndepitb) 

  • branches/devmercator2010/NEMO/TOP_SRC/trcdta.F90

    r1801 r2072  
    2525   PUBLIC trc_dta   ! called in trcini.F90 and trcdmp.F90 
    2626 
    27    LOGICAL , PUBLIC, PARAMETER ::   lk_dtatrc = .TRUE.   !: temperature data flag 
    2827   REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk,jptra) ::   trdta   !: tracer data at given time-step 
    2928 
    … …  
    6362      !! 
    6463      CHARACTER (len=39) ::   clname(jptra) 
    65       INTEGER, PARAMETER ::   & 
    66          jpmonth = 12    ! number of months 
     64      INTEGER, PARAMETER ::   jpmois  = 12        ! number of months 
    6765      INTEGER ::   ji, jj, jn, jl  
    6866      INTEGER ::   imois, iman, i15, ik  ! temporary integers  
    … …  
    8381            ENDIF 
    8482            ! Initialization 
    85             iman = jpmonth 
     83            iman = jpmois 
    8684            i15  = nday / 16 
    8785            imois = nmonth + i15 -1 
    … …  
    190188            ! Read init file only 
    191189            IF( kt == nittrc000  ) THEN 
    192                ntrc1(jn) = 1 
    193190               CALL iom_get ( numtr(jn), jpdom_data, ctrcnm(jn), trdta(:,:,:,jn), ntrc1(jn) ) 
    194191               trdta(:,:,:,jn) = trdta(:,:,:,jn) * tmask(:,:,:) 
    … …  
    207204   !!   Dummy module                              NO 3D passive tracer data 
    208205   !!---------------------------------------------------------------------- 
    209    LOGICAL , PUBLIC, PARAMETER ::   lk_dtatrc = .FALSE.   !: temperature data flag 
    210206CONTAINS 
    211207   SUBROUTINE trc_dta( kt )        ! Empty routine 

  • branches/devmercator2010/NEMO/TOP_SRC/trcini.F90

    r1836 r2072  
    122122         trb(:,:,:,:) = trn(:,:,:,:) 
    123123      ELSE 
    124          ! 
    125124         CALL trc_rst_read      ! restart from a file 
    126          ! 
     125#if defined key_off_tra 
     126         CALL day_init          ! calendar 
     127#endif 
    127128      ENDIF 
    128129 

  • branches/devmercator2010/NEMO/TOP_SRC/trcrst.F90

    r1836 r2072  
    11MODULE trcrst 
    22   !!====================================================================== 
    3    !!                         ***  MODULE trcrst  *** 
    4    !! TOP :   Manage the passive tracer restart 
     3   !!                       ***  MODULE trcrst  *** 
     4   !! TOP :   create, write, read the restart files for passive tracers 
    55   !!====================================================================== 
    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 
     6   !! History :   1.0  !  2007-02 (C. Ethe) adaptation from the ocean 
    107   !!---------------------------------------------------------------------- 
    118#if defined key_top 
    12    !!---------------------------------------------------------------------- 
    13    !!   'key_top'                                                TOP models 
    14    !!---------------------------------------------------------------------- 
    15    !!---------------------------------------------------------------------- 
    16    !!   trc_rst :   Restart for passive tracer 
    17    !!---------------------------------------------------------------------- 
    189   !!---------------------------------------------------------------------- 
    1910   !!   'key_top'                                                TOP models 
    … …  
    2516   USE oce_trc 
    2617   USE trc 
    27    USE trctrp_lec 
     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    
    2824   USE lib_mpp 
    2925   USE iom 
    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 #if defined key_off_tra 
    36     USE daymod 
    37 #endif 
     26    
    3827   IMPLICIT NONE 
    3928   PRIVATE 
    40  
     29    
    4130   PUBLIC   trc_rst_opn       ! called by ??? 
    4231   PUBLIC   trc_rst_read      ! called by ??? 
    4332   PUBLIC   trc_rst_wri       ! called by ??? 
    44  
     33    
    4534   INTEGER, PUBLIC ::   numrtr, numrtw   !: logical unit for trc restart (read and write) 
     35 
    4636 
    4737   !! * Substitutions 
    … …  
    9989   END SUBROUTINE trc_rst_opn 
    10090 
    101    SUBROUTINE trc_rst_read 
     91 
     92   SUBROUTINE trc_rst_read  
    10293      !!---------------------------------------------------------------------- 
    10394      !!                    ***  trc_rst_opn  *** 
    … …  
    10596      !! ** purpose  :   read passive tracer fields in restart files 
    10697      !!---------------------------------------------------------------------- 
    107       INTEGER  ::  jn      
    108       INTEGER  ::  iarak0  
     98      INTEGER  ::  jn   
     99      INTEGER  ::  iarak0 
    109100      REAL(wp) ::  zarak0 
    110101      INTEGER  ::  jlibalt = jprstlib 
    111102      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 
    112108 
    113109      !!---------------------------------------------------------------------- 
    … …  
    119115      IF ( jprstlib == jprstdimg ) THEN 
    120116        ! eventually read netcdf file (monobloc)  for restarting on different number of processors 
    121         ! if {cn_trcrst_in}.nc exists, then set jlibalt to jpnf90  
     117        ! if {cn_trcrst_in}.nc exists, then set jlibalt to jpnf90 
    122118        INQUIRE( FILE = TRIM(cn_trcrst_in)//'.nc', EXIST = llok ) 
    123         IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF  
    124       ENDIF 
    125  
    126       CALL iom_open( cn_trcrst_in, numrtr, kiolib = jlibalt )  
     119        IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF 
     120      ENDIF 
     121       
     122      CALL iom_open( cn_trcrst_in, numrtr, kiolib = jlibalt ) 
    127123 
    128124      ! Time domain : restart 
    … …  
    140136         & ' centered or euler '  ) 
    141137      IF(lwp) WRITE(numout,*) 
     138 
    142139      IF(lwp) WRITE(numout,*) '    arakawa option      : ', NINT( zarak0 ) 
     140 
    143141 
    144142      ! READ prognostic variables and computes diagnostic variable 
    145143      DO jn = 1, jptra 
    146          CALL iom_get( numrtr, jpdom_autoglo, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) ) 
     144         CALL iom_get( numrtr, jpdom_autoglo, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) )  
    147145      END DO 
    148146 
    149147      DO jn = 1, jptra 
    150          CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) ) 
     148         CALL iom_get( numrtr, jpdom_autoglo, 'TRB'//ctrcnm(jn), trb(:,:,:,jn) )  
    151149      END DO 
    152150 
    153       IF( lk_lobster )   CALL trc_rst_read_lobster( numrtr )      ! LOBSTER bio-model 
    154       IF( lk_pisces  )   CALL trc_rst_read_pisces ( numrtr )      ! PISCES  bio-model 
    155       IF( lk_cfc     )   CALL trc_rst_read_cfc    ( numrtr )      ! CFC     tracers 
    156       IF( lk_c14b    )   CALL trc_rst_read_c14b   ( numrtr )      ! C14 bomb  tracer 
    157       IF( lk_my_trc  )   CALL trc_rst_read_my_trc ( numrtr )      ! MY_TRC  tracers 
    158  
     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       
    159195      CALL iom_close( numrtr ) 
    160196      ! 
    161197   END SUBROUTINE trc_rst_read 
     198 
    162199 
    163200   SUBROUTINE trc_rst_wri( kt ) 
    … …  
    181218      CALL iom_rstput( kt, nitrst, numrtw, 'arak0', zarak0 ) 
    182219 
    183       ! prognostic variables  
    184       ! --------------------  
     220      ! prognostic variables 
     221      ! -------------------- 
    185222      DO jn = 1, jptra 
    186223         CALL iom_rstput( kt, nitrst, numrtw, 'TRN'//ctrcnm(jn), trn(:,:,:,jn) ) 
    … …  
    191228      END DO 
    192229 
    193       IF( lk_lobster )   CALL trc_rst_wri_lobster( kt, nitrst, numrtw )      ! LOBSTER bio-model 
    194       IF( lk_pisces  )   CALL trc_rst_wri_pisces ( kt, nitrst, numrtw )      ! PISCES  bio-model 
    195       IF( lk_cfc     )   CALL trc_rst_wri_cfc    ( kt, nitrst, numrtw )      ! CFC     tracers 
    196       IF( lk_c14b    )   CALL trc_rst_wri_c14b   ( kt, nitrst, numrtw )      ! C14 bomb  tracer 
    197       IF( lk_my_trc  )   CALL trc_rst_wri_my_trc ( kt, nitrst, numrtw )      ! MY_TRC  tracers 
    198  
     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       
    199250      IF( kt == nitrst ) THEN 
    200251          CALL trc_rst_stat            ! statistics 
    … …  
    205256      ENDIF 
    206257      ! 
    207    END SUBROUTINE trc_rst_wri  
    208  
     258   END SUBROUTINE trc_rst_wri 
    209259 
    210260   SUBROUTINE trc_rst_cal( kt, cdrw ) 
    … …  
    279329           WRITE(numout,*) 
    280330         ENDIF 
    281          ! 
    282          CALL day_init          ! compute calendar 
    283          ! 
    284331#endif 
    285332 
    … …  
    300347   END SUBROUTINE trc_rst_cal 
    301348 
     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      !!---------------------------------------------------------------------- 
    302462 
    303463   SUBROUTINE trc_rst_stat 

  • branches/devmercator2010/NEMO/TOP_SRC/trcwri.F90

    r1836 r2072  
    11MODULE trcwri 
    2    !!=================================================================================== 
     2   !!====================================================================== 
    33   !!                       *** MODULE trcwri *** 
    4    !!    TOP :   Output of passive tracers 
    5    !!==================================================================================== 
    6    !! History :   1.0  !  2009-05 (C. Ethe)  Original code 
    7    !!                  !  2010-03 (C. Ethe, R. Seferian ) Add the tracer transport trends 
     4   !!    TOP :   Output of passive tracers  
     5   !!====================================================================== 
     6   !!             1.0  !   
     7   !!                  !  2009-05 (C. Ethe ) 
    88   !!---------------------------------------------------------------------- 
    99#if defined key_top &&  defined key_iomput 
    … …  
    1111   !!   'key_top' && 'key_iomput'                              TOP models 
    1212   !!---------------------------------------------------------------------- 
    13    !! trc_wri_trc   :  outputs of concentration fields 
    14    !! trc_wri_trd   :  outputs of transport trends 
     13   !! trc_wri     :  outputs of concentration fields 
    1514   !!---------------------------------------------------------------------- 
    16    USE dom_oce         ! ocean space and time domain variables 
    17    USE oce_trc 
    18    USE trp_trc 
    1915   USE trc 
    20    USE trdmld_trc_oce, ONLY : luttrd 
    2116   USE iom 
    2217#if defined key_off_tra 
    … …  
    4035CONTAINS 
    4136 
    42    SUBROUTINE trc_wri( kt ) 
     37   SUBROUTINE trc_wri( kt )   
    4338      !!--------------------------------------------------------------------- 
    4439      !!                     ***  ROUTINE trc_wri  *** 
    45       !!  
    46       !! ** Purpose :   output passive tracers fields and dynamical trends 
    47       !!--------------------------------------------------------------------- 
    48       INTEGER, INTENT( in ) :: kt 
    49       !!--------------------------------------------------------------------- 
    50  
    51       ! 
    52       CALL iom_setkt  ( kt + ndttrc - 1 )       ! set the passive tracer time step 
    53       CALL trc_wri_trc( kt              )       ! outputs for tracer concentration 
    54       CALL trc_wri_trd( kt              )       ! outputs for dynamical trends 
    55       CALL iom_setkt  ( kt              )       ! set the model time step 
    56       ! 
    57    END SUBROUTINE trc_wri 
    58  
    59    SUBROUTINE trc_wri_trc( kt )   
    60       !!--------------------------------------------------------------------- 
    61       !!                     ***  ROUTINE trc_wri_trc  *** 
    6240      !! 
    6341      !! ** Purpose :   output passive tracers fields  
    … …  
    6543      INTEGER, INTENT( in ) :: kt       ! ocean time-step 
    6644      INTEGER               :: jn 
    67       CHARACTER (len=20)    :: cltra, cltras 
     45      CHARACTER (len=20)    :: cltra 
    6846#if defined key_off_tra 
    6947      CHARACTER (len=40) :: clhstnam 
    7048      INTEGER ::   inum = 11            ! temporary logical unit 
    7149#endif 
     50 
    7251      !!--------------------------------------------------------------------- 
    7352  
     53      ! Initialisation 
     54      ! -------------- 
     55 
     56      CALL iom_setkt( kt + ndttrc - 1 ) ! set the passive tracer time step 
     57 
    7458#if defined key_off_tra 
    7559      IF( kt == nittrc000 ) THEN 
    … …  
    8367      ENDIF 
    8468#endif 
     69 
     70 
    8571      ! write the tracer concentrations in the file 
    8672      ! --------------------------------------- 
    … …  
    9076      END DO 
    9177      ! 
    92    END SUBROUTINE trc_wri_trc 
     78      CALL iom_setkt( kt )       ! set the model time step 
    9379 
    94 # if defined key_trc_diatrd 
     80      ! 
     81   END SUBROUTINE trc_wri 
    9582 
    96    SUBROUTINE trc_wri_trd( kt ) 
    97       !!---------------------------------------------------------------------- 
    98       !!                     ***  ROUTINE trc_wri_trd  *** 
    99       !! 
    100       !! ** Purpose :   output of passive tracer : advection-diffusion trends 
    101       !! 
    102       !!---------------------------------------------------------------------- 
    103       INTEGER, INTENT( in ) ::   kt          ! ocean time-step 
    104       !! 
    105       CHARACTER (len=3) ::   cltra 
    106       INTEGER  ::   jn, jl, ikn 
    107       !!---------------------------------------------------------------------- 
    108  
    109       DO jn = 1, jptra 
    110          IF( luttrd(jn) ) THEN 
    111             ikn = ikeep(jn) 
    112             DO jl = 1, jpdiatrc 
    113                IF( jl == jptrc_xad ) WRITE (cltra,"(3a)") 'XAD' ! x advection for tracer 
    114                IF( jl == jptrc_yad ) WRITE (cltra,"(3a)") 'YAD'  ! y advection for tracer 
    115                IF( jl == jptrc_zad ) WRITE (cltra,"(3a)") 'ZAD'  ! z advection for tracer 
    116                IF( jl == jptrc_xdf ) WRITE (cltra,"(3a)") 'XDF'  ! x diffusion for tracer 
    117                IF( jl == jptrc_ydf ) WRITE (cltra,"(3a)") 'YDF'  ! y diffusion for tracer 
    118                IF( jl == jptrc_zdf ) WRITE (cltra,"(3a)") 'ZDF'  ! z diffusion for tracer 
    119 # if defined key_trcldf_eiv 
    120                IF( jl == jptrc_xei ) WRITE (cltra,"(3a)") 'XGV'  ! x gent velocity for tracer 
    121                IF( jl == jptrc_yei ) WRITE (cltra,"(3a)") 'YGV'  ! y gent velocity for tracer 
    122                IF( jl == jptrc_zei ) WRITE (cltra,"(3a)") 'ZGV'  ! z gent velocity for tracer 
    123 # endif 
    124 # if defined key_trcdmp 
    125                IF( jl == jptrc_dmp ) WRITE (cltra,"(3a)") 'DMP'  ! damping 
    126 # endif 
    127                IF( jl == jptrc_sbc ) WRITE (cltra,"(3a)") 'SBC'  ! surface boundary conditions 
    128                ! write the trends 
    129                CALL iom_put( cltra, trtrd(:,:,:,ikn,jl) ) 
    130             END DO 
    131          END IF 
    132       END DO 
    133       ! 
    134    END SUBROUTINE trc_wri_trd 
    135  
    136 # else 
    137    SUBROUTINE trc_wri_trd( kt )                      ! Dummy routine 
    138       INTEGER, INTENT ( in ) ::   kt 
    139    END SUBROUTINE trc_wri_trd 
    140 #endif 
    14183#else 
    14284   !!---------------------------------------------------------------------- 
    … …  
    14890   INTEGER, INTENT(in) :: kt 
    14991   END SUBROUTINE trc_wri 
     92 
    15093#endif 
    15194 
Note: See TracChangeset for help on using the changeset viewer.