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 7646 for trunk/NEMOGCM/NEMO/TOP_SRC – NEMO

Ignore:
Timestamp:
2017-02-06T10:25:03+01:00 (7 years ago)
Author:
timgraham
Message:

Merge of dev_merge_2016 into trunk. UPDATE TO ARCHFILES NEEDED for XIOS2.
LIM_SRC_s/limrhg.F90 to follow in next commit due to change of kind (I'm unable to do it in this commit).
Merged using the following steps:

1) svn merge --reintegrate ​svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk .
2) Resolve minor conflicts in sette.sh and namelist_cfg for ORCA2LIM3 (due to a change in trunk after branch was created)
3) svn commit
4) svn switch ​svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/trunk
5) svn merge ​svn+ssh://forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/branches/2016/dev_merge_2016 .
6) At this stage I checked out a clean copy of the branch to compare against what is about to be committed to the trunk.
6) svn commit #Commit code to the trunk

In this commit I have also reverted a change to Fcheck_archfile.sh which was causing problems on the Paris machine.

Location:
trunk/NEMOGCM/NEMO/TOP_SRC
Files:
2 deleted
71 edited
10 copied

Legend:

Unmodified
Added
Removed

  • trunk/NEMOGCM/NEMO/TOP_SRC/CFC/par_cfc.F90

    r3680 r7646  
    1010   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    1111   !!---------------------------------------------------------------------- 
    12    USE par_pisces , ONLY : jp_pisces       !: number of tracers in PISCES 
    13    USE par_pisces , ONLY : jp_pisces_2d    !: number of 2D diag in PISCES 
    14    USE par_pisces , ONLY : jp_pisces_3d    !: number of 3D diag in PISCES 
    15    USE par_pisces , ONLY : jp_pisces_trd   !: number of biological diag in PISCES 
    1612 
    1713   IMPLICIT NONE 
    18  
    19    INTEGER, PARAMETER ::   jp_lc      =  jp_pisces     !: cumulative number of passive tracers 
    20    INTEGER, PARAMETER ::   jp_lc_2d   =  jp_pisces_2d  !: 
    21    INTEGER, PARAMETER ::   jp_lc_3d   =  jp_pisces_3d  !: 
    22    INTEGER, PARAMETER ::   jp_lc_trd  =  jp_pisces_trd !: 
    23     
    24 #if defined key_cfc 
    25    !!--------------------------------------------------------------------- 
    26    !!   'key_cfc'   :                                          CFC tracers 
    27    !!--------------------------------------------------------------------- 
    28    LOGICAL, PUBLIC, PARAMETER ::   lk_cfc     = .TRUE.      !: CFC flag  
    29    INTEGER, PUBLIC, PARAMETER ::   jp_cfc     =  1          !: number of passive tracers 
    30    INTEGER, PUBLIC, PARAMETER ::   jp_cfc_2d  =  2          !: additional 2d output arrays ('key_trc_diaadd') 
    31    INTEGER, PUBLIC, PARAMETER ::   jp_cfc_3d  =  0          !: additional 3d output arrays ('key_trc_diaadd') 
    32    INTEGER, PUBLIC, PARAMETER ::   jp_cfc_trd =  0          !: number of sms trends for CFC 
    33     
    34    ! assign an index in trc arrays for each CFC prognostic variables 
    35    INTEGER, PUBLIC, PARAMETER ::   jpc11       = jp_lc + 1   !: CFC-11  
    36    INTEGER, PUBLIC, PARAMETER ::   jpc12       = jp_lc + 2   !: CFC-12    
    37 #else 
    38    !!--------------------------------------------------------------------- 
    39    !!   Default     :                                       No CFC tracers 
    40    !!--------------------------------------------------------------------- 
    41    LOGICAL, PUBLIC, PARAMETER ::   lk_cfc     = .FALSE.     !: CFC flag  
    42    INTEGER, PUBLIC, PARAMETER ::   jp_cfc     =  0          !: No CFC tracers 
    43    INTEGER, PUBLIC, PARAMETER ::   jp_cfc_2d  =  0          !: No CFC additional 2d output arrays  
    44    INTEGER, PUBLIC, PARAMETER ::   jp_cfc_3d  =  0          !: No CFC additional 3d output arrays  
    45    INTEGER, PUBLIC, PARAMETER ::   jp_cfc_trd =  0          !: number of sms trends for CFC 
    46 #endif 
    47  
    48    ! Starting/ending CFC do-loop indices (N.B. no CFC : jp_cfc0 > jp_cfc1 the do-loop are never done) 
    49    INTEGER, PUBLIC, PARAMETER ::   jp_cfc0     = jp_lc + 1       !: First index of CFC tracers 
    50    INTEGER, PUBLIC, PARAMETER ::   jp_cfc1     = jp_lc + jp_cfc  !: Last  index of CFC tracers 
    51    INTEGER, PUBLIC, PARAMETER ::   jp_cfc0_2d  = jp_lc_2d  + 1       !: First index of CFC tracers 
    52    INTEGER, PUBLIC, PARAMETER ::   jp_cfc1_2d  = jp_lc_2d  + jp_cfc_2d  !: Last  index of CFC tracers 
    53    INTEGER, PUBLIC, PARAMETER ::   jp_cfc0_3d  = jp_lc_3d  + 1       !: First index of CFC tracers 
    54    INTEGER, PUBLIC, PARAMETER ::   jp_cfc1_3d  = jp_lc_3d  + jp_cfc_3d  !: Last  index of CFC tracers 
    55    INTEGER, PUBLIC, PARAMETER ::   jp_cfc0_trd = jp_lc_trd + 1       !: First index of CFC tracers 
    56    INTEGER, PUBLIC, PARAMETER ::   jp_cfc1_trd = jp_lc_trd + jp_cfc_trd  !: Last  index of CFC tracers 
     14   INTEGER, PUBLIC  :: jp_cfc0, jp_cfc1  !:  First/last index of CFC tracers 
    5715 
    5816   !!====================================================================== 

  • trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trcice_cfc.F90

    r5434 r7646  
    55   !!====================================================================== 
    66   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) Original code 
    7    !!---------------------------------------------------------------------- 
    8 #if defined key_cfc 
    9    !!---------------------------------------------------------------------- 
    10    !!   'key_cfc'                                               CFC tracers 
    117   !!---------------------------------------------------------------------- 
    128   !! trc_ice_cfc       : MY_TRC model main routine 
    … …  
    4036   END SUBROUTINE trc_ice_ini_cfc 
    4137 
    42  
    43 #else 
    44    !!---------------------------------------------------------------------- 
    45    !!   Dummy module                                        No MY_TRC model 
    46    !!---------------------------------------------------------------------- 
    47 CONTAINS 
    48    SUBROUTINE trc_ice_ini_cfc             ! Empty routine 
    49    END SUBROUTINE trc_ice_ini_cfc 
    50 #endif 
    51  
    5238   !!====================================================================== 
    5339END MODULE trcice_cfc 

  • trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trcini_cfc.F90

    r3294 r7646  
    66   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec)  
    77   !!---------------------------------------------------------------------- 
    8 #if defined key_cfc 
    9    !!---------------------------------------------------------------------- 
    10    !!   'key_cfc'                                               CFC tracers 
    118   !!---------------------------------------------------------------------- 
    129   !! trc_ini_cfc      : CFC model initialisation 
    … …  
    1512   USE par_trc         ! TOP parameters 
    1613   USE trc             ! TOP variables 
     14   USE trcnam_cfc      ! CFC SMS namelist 
    1715   USE trcsms_cfc      ! CFC sms trends 
    1816 
    … …  
    2119 
    2220   PUBLIC   trc_ini_cfc   ! called by trcini.F90 module 
    23  
    24    CHARACTER (len=34) ::   clname = 'cfc1112.atm'   ! ??? 
    2521 
    2622   INTEGER  ::   inum                   ! unit number 
    … …  
    4642      INTEGER  ::  iskip = 6   ! number of 1st descriptor lines 
    4743      REAL(wp) ::  zyy, zyd 
     44      CHARACTER(len = 20)  ::  cltra 
    4845      !!---------------------------------------------------------------------- 
    49  
     46      ! 
     47      CALL trc_nam_cfc 
     48      ! 
    5049      IF(lwp) WRITE(numout,*) 
    5150      IF(lwp) WRITE(numout,*) ' trc_ini_cfc: initialisation of CFC chemical model' 
    5251      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~' 
    53  
    54  
    55       IF(lwp) WRITE(numout,*) 'read of formatted file cfc1112atm' 
     52      ! 
     53      IF(lwp) WRITE(numout,*) 'Read annual atmospheric concentratioins from formatted file : ' // TRIM(clname) 
    5654       
    5755      CALL ctl_opn( inum, clname, 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
    … …  
    6664      END DO 
    6765 100  jpyear = jn - 1 - iskip 
    68       IF ( lwp) WRITE(numout,*) '    ', jpyear ,' years read' 
     66      IF ( lwp) WRITE(numout,*) '   ---> ', jpyear ,' years read' 
    6967      !                                ! Allocate CFC arrays 
    7068 
    71       ALLOCATE( p_cfc(jpyear,jphem,2), STAT=ierr ) 
     69      ALLOCATE( p_cfc(jpyear,jphem,3), STAT=ierr ) 
    7270      IF( ierr > 0 ) THEN 
    7371         CALL ctl_stop( 'trc_ini_cfc: unable to allocate p_cfc array' )   ;   RETURN 
    … …  
    8785         IF(lwp) THEN 
    8886            WRITE(numout,*) 
    89             WRITE(numout,*) 'Initialization de qint ; No restart : qint equal zero ' 
     87            WRITE(numout,*) 'Initialisation of qint ; No restart : qint equal zero ' 
    9088         ENDIF 
    9189         qint_cfc(:,:,:) = 0._wp 
    … …  
    105103      jn = 31 
    106104      DO  
    107         READ(inum,*, IOSTAT=io) zyy, p_cfc(jn,1,1), p_cfc(jn,1,2), p_cfc(jn,2,1), p_cfc(jn,2,2) 
     105        READ(inum,*, IOSTAT=io) zyy, p_cfc(jn,1:2,1), p_cfc(jn,1:2,2), p_cfc(jn,1:2,3) 
    108106        IF( io < 0 ) exit 
    109107        jn = jn + 1 
    110108      END DO 
    111109 
    112       p_cfc(32,1:2,1) = 5.e-4      ! modify the values of the first years 
    113       p_cfc(33,1:2,1) = 8.e-4 
    114       p_cfc(34,1:2,1) = 1.e-6 
    115       p_cfc(35,1:2,1) = 2.e-3 
    116       p_cfc(36,1:2,1) = 4.e-3 
    117       p_cfc(37,1:2,1) = 6.e-3 
    118       p_cfc(38,1:2,1) = 8.e-3 
    119       p_cfc(39,1:2,1) = 1.e-2 
    120        
     110      !p_cfc(32,1:2,1) = 5.e-4      ! modify the values of the first years 
     111      !p_cfc(33,1:2,1) = 8.e-4 
     112      !p_cfc(34,1:2,1) = 1.e-6 
     113      !p_cfc(35,1:2,1) = 2.e-3 
     114      !p_cfc(36,1:2,1) = 4.e-3 
     115      !p_cfc(37,1:2,1) = 6.e-3 
     116      !p_cfc(38,1:2,1) = 8.e-3 
     117      !p_cfc(39,1:2,1) = 1.e-2 
    121118      IF(lwp) THEN        ! Control print 
    122119         WRITE(numout,*) 
    123          WRITE(numout,*) ' Year   p11HN    p11HS    p12HN    p12HS ' 
     120         WRITE(numout,*) ' Year   c11NH     c11SH     c12NH     c12SH     SF6NH     SF6SH' 
    124121         DO jn = 30, jpyear 
    125             WRITE(numout, '( 1I4, 4F9.2)') jn, p_cfc(jn,1,1), p_cfc(jn,2,1), p_cfc(jn,1,2), p_cfc(jn,2,2) 
     122            WRITE(numout, '( 1I4, 6F10.4)') jn, p_cfc(jn,1:2,1), p_cfc(jn,1:2,2), p_cfc(jn,1:2,3) 
    126123         END DO 
    127124      ENDIF 
    … …  
    145142      ! 
    146143   END SUBROUTINE trc_ini_cfc 
    147     
    148 #else 
    149    !!---------------------------------------------------------------------- 
    150    !!   Dummy module                                         No CFC tracers 
    151    !!---------------------------------------------------------------------- 
    152 CONTAINS 
    153    SUBROUTINE trc_ini_cfc             ! Empty routine 
    154    END SUBROUTINE trc_ini_cfc 
    155 #endif 
    156144 
    157145   !!====================================================================== 

  • trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trcnam_cfc.F90

    r4624 r7646  
    66   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) from trcnam.cfc.h90 
    77   !!---------------------------------------------------------------------- 
    8 #if defined key_cfc 
    9    !!---------------------------------------------------------------------- 
    10    !!   'key_cfc'                                               CFC tracers 
    11    !!---------------------------------------------------------------------- 
    128   !! trc_nam_cfc      : CFC model initialisation 
    139   !!---------------------------------------------------------------------- 
    1410   USE oce_trc         ! Ocean variables 
    15    USE par_trc         ! TOP parameters 
    1611   USE trc             ! TOP variables 
    1712   USE trcsms_cfc      ! CFC specific variable 
    18    USE iom             ! I/O manager 
    1913 
    2014   IMPLICIT NONE 
    2115   PRIVATE 
     16 
     17   CHARACTER(len=34), PUBLIC ::   clname ! Input filename of CFCs atm. concentrations 
    2218 
    2319   PUBLIC   trc_nam_cfc   ! called by trcnam.F90 module 
    … …  
    4238      !! ** input   :   Namelist namcfc 
    4339      !!---------------------------------------------------------------------- 
    44       INTEGER ::  numnatc_ref = -1   ! Logical unit for reference CFC namelist 
    45       INTEGER ::  numnatc_cfg = -1   ! Logical unit for configuration CFC namelist 
    46       INTEGER ::  numonc      = -1   ! Logical unit for output namelist 
    4740      INTEGER :: ios                 ! Local integer output status for namelist read 
    4841      INTEGER :: jl, jn 
    49       TYPE(DIAG), DIMENSION(jp_cfc_2d) :: cfcdia2d 
    5042      !! 
    51       NAMELIST/namcfcdate/ ndate_beg, nyear_res 
    52       NAMELIST/namcfcdia/  cfcdia2d     ! additional diagnostics 
     43      NAMELIST/namcfc/ ndate_beg, nyear_res, clname 
    5344      !!---------------------------------------------------------------------- 
    54       !                             ! Open namelist files 
    55       CALL ctl_opn( numnatc_ref, 'namelist_cfc_ref'   ,     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
    56       CALL ctl_opn( numnatc_cfg, 'namelist_cfc_cfg'   ,     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
    57       IF(lwm) CALL ctl_opn( numonc, 'output.namelist.cfc', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
     45      ! 
     46      jn = jp_cfc0 - 1 
     47      ! Variables setting 
     48      IF( ln_cfc11 ) THEN 
     49         jn = jn + 1 
     50         ctrcnm    (jn) = 'CFC11' 
     51         ctrcln    (jn) = 'Chlorofluoro carbon 11 Concentration' 
     52         ctrcun    (jn) = 'umolC/L' 
     53         ln_trc_ini(jn) = .false. 
     54         ln_trc_sbc(jn) = .false. 
     55         ln_trc_cbc(jn) = .false. 
     56         ln_trc_obc(jn) = .false. 
     57      ENDIF 
     58      ! 
     59      IF( ln_cfc12 ) THEN 
     60         jn = jn + 1 
     61         ctrcnm    (jn) = 'CFC12' 
     62         ctrcln    (jn) = 'Chlorofluoro carbon 12 Concentration' 
     63         ctrcun    (jn) = 'umolC/L' 
     64         ln_trc_ini(jn) = .false. 
     65         ln_trc_sbc(jn) = .false. 
     66         ln_trc_cbc(jn) = .false. 
     67         ln_trc_obc(jn) = .false. 
     68      ENDIF 
     69      ! 
     70      IF( ln_sf6 ) THEN 
     71         jn = jn + 1 
     72         ctrcnm    (jn) = 'SF6' 
     73         ctrcln    (jn) = 'Sulfur hexafluoride Concentration' 
     74         ctrcun    (jn) = 'umol/L' 
     75         ln_trc_ini(jn) = .false. 
     76         ln_trc_sbc(jn) = .false. 
     77         ln_trc_cbc(jn) = .false. 
     78         ln_trc_obc(jn) = .false. 
     79      ENDIF 
     80      ! 
     81      REWIND( numtrc_ref )              ! Namelist namcfcdate in reference namelist : CFC parameters 
     82      READ  ( numtrc_ref, namcfc, IOSTAT = ios, ERR = 901) 
     83901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfc in reference namelist', lwp ) 
    5884 
    59       REWIND( numnatc_ref )              ! Namelist namcfcdate in reference namelist : CFC parameters 
    60       READ  ( numnatc_ref, namcfcdate, IOSTAT = ios, ERR = 901) 
    61 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfcdate in reference namelist', lwp ) 
    62  
    63       REWIND( numnatc_cfg )              ! Namelist namcfcdate in configuration namelist : CFC parameters 
    64       READ  ( numnatc_cfg, namcfcdate, IOSTAT = ios, ERR = 902 ) 
    65 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfcdate in configuration namelist', lwp ) 
    66       IF(lwm) WRITE ( numonc, namcfcdate ) 
     85      REWIND( numtrc_cfg )              ! Namelist namcfcdate in configuration namelist : CFC parameters 
     86      READ  ( numtrc_cfg, namcfc, IOSTAT = ios, ERR = 902 ) 
     87902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfc in configuration namelist', lwp ) 
     88      IF(lwm) WRITE ( numonr, namcfc ) 
    6789 
    6890      IF(lwp) THEN                  ! control print 
    69          WRITE(numout,*) 
     91         WRITE(numout,*) ' ' 
     92         WRITE(numout,*) ' CFCs' 
     93         WRITE(numout,*) ' ' 
    7094         WRITE(numout,*) ' trc_nam: Read namdates, namelist for CFC chemical model' 
    7195         WRITE(numout,*) ' ~~~~~~~' 
    … …  
    76100      IF(lwp) WRITE(numout,*) '    initial year (aa)                       nyear_beg = ', nyear_beg 
    77101      ! 
    78  
    79       IF( .NOT.lk_iomput .AND. ln_diatrc ) THEN 
    80          ! 
    81          ! Namelist namcfcdia 
    82          ! ------------------- 
    83          REWIND( numnatc_ref )              ! Namelist namcfcdia in reference namelist : CFC diagnostics 
    84          READ  ( numnatc_ref, namcfcdia, IOSTAT = ios, ERR = 903) 
    85 903      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfcdia in reference namelist', lwp ) 
    86  
    87          REWIND( numnatc_cfg )              ! Namelist namcfcdia in configuration namelist : CFC diagnostics 
    88          READ  ( numnatc_cfg, namcfcdia, IOSTAT = ios, ERR = 904 ) 
    89 904      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namcfcdia in configuration namelist', lwp ) 
    90          IF(lwm) WRITE ( numonc, namcfcdia ) 
    91  
    92          DO jl = 1, jp_cfc_2d 
    93             jn = jp_cfc0_2d + jl - 1 
    94             ctrc2d(jn) = TRIM( cfcdia2d(jl)%sname ) 
    95             ctrc2l(jn) = TRIM( cfcdia2d(jl)%lname ) 
    96             ctrc2u(jn) = TRIM( cfcdia2d(jl)%units ) 
    97          END DO 
    98  
    99          IF(lwp) THEN                   ! control print 
    100             WRITE(numout,*) 
    101             WRITE(numout,*) ' Namelist : natadd' 
    102             DO jl = 1, jp_cfc_2d 
    103                jn = jp_cfc0_2d + jl - 1 
    104                WRITE(numout,*) '  2d diag nb : ', jn, '    short name : ', ctrc2d(jn), & 
    105                  &             '  long name  : ', ctrc2l(jn), '   unit : ', ctrc2u(jn) 
    106             END DO 
    107             WRITE(numout,*) ' ' 
    108          ENDIF 
    109          ! 
    110       ENDIF 
    111  
    112    IF(lwm) CALL FLUSH ( numonc )     ! flush output namelist CFC 
     102      IF(lwm) CALL FLUSH ( numonr )     ! flush output namelist CFC 
    113103 
    114104   END SUBROUTINE trc_nam_cfc 
    115105    
    116 #else 
    117    !!---------------------------------------------------------------------- 
    118    !!  Dummy module :                                                No CFC 
    119    !!---------------------------------------------------------------------- 
    120 CONTAINS 
    121    SUBROUTINE trc_nam_cfc                      ! Empty routine 
    122    END  SUBROUTINE  trc_nam_cfc 
    123 #endif   
    124  
    125106   !!====================================================================== 
    126107END MODULE trcnam_cfc 

  • trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90

    r6140 r7646  
    77   !!  NEMO      1.0  !  2004-03  (C. Ethe) free form + modularity 
    88   !!            2.0  !  2007-12  (C. Ethe, G. Madec)  reorganisation 
    9    !!---------------------------------------------------------------------- 
    10 #if defined key_cfc 
    11    !!---------------------------------------------------------------------- 
    12    !!   'key_cfc'                                               CFC tracers 
     9   !!            4.0  !  2016-11  (T. Lovato) Add SF6, Update Schmidt number 
    1310   !!---------------------------------------------------------------------- 
    1411   !!   trc_sms_cfc  :  compute and add CFC suface forcing to CFC trends 
    … …  
    2926 
    3027   INTEGER , PUBLIC, PARAMETER ::   jphem  =   2   ! parameter for the 2 hemispheres 
    31    INTEGER , PUBLIC            ::   jpyear         ! Number of years read in CFC1112 file 
     28   INTEGER , PUBLIC            ::   jpyear         ! Number of years read in input data file (in trcini_cfc) 
    3229   INTEGER , PUBLIC            ::   ndate_beg      ! initial calendar date (aammjj) for CFC 
    3330   INTEGER , PUBLIC            ::   nyear_res      ! restoring time constant (year) 
    3431   INTEGER , PUBLIC            ::   nyear_beg      ! initial year (aa)  
    3532    
    36    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   p_cfc    ! partial hemispheric pressure for CFC 
     33   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   p_cfc    ! partial hemispheric pressure for all CFC 
    3734   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   xphem    ! spatial interpolation factor for patm 
    3835   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qtr_cfc  ! flux at surface 
    3936   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qint_cfc ! cumulative flux  
     37   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   atm_cfc  ! partial hemispheric pressure for used CFC 
    4038   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   patm     ! atmospheric function 
    4139 
    42    REAL(wp), DIMENSION(4,2) ::   soa   ! coefficient for solubility of CFC [mol/l/atm] 
    43    REAL(wp), DIMENSION(3,2) ::   sob   !    "               " 
    44    REAL(wp), DIMENSION(4,2) ::   sca   ! coefficients for schmidt number in degre Celcius 
    45        
     40   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   soa      ! coefficient for solubility of CFC [mol/l/atm] 
     41   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sob      !    "               " 
     42   REAL(wp),         ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   sca      ! coefficients for schmidt number in degrees Celsius 
    4643   !                          ! coefficients for conversion 
    4744   REAL(wp) ::   xconv1 = 1.0          ! conversion from to  
    … …  
    7976      INTEGER  ::   im1, im2, ierr 
    8077      REAL(wp) ::   ztap, zdtap         
    81       REAL(wp) ::   zt1, zt2, zt3, zv2 
     78      REAL(wp) ::   zt1, zt2, zt3, zt4, zv2 
    8279      REAL(wp) ::   zsol      ! solubility 
    8380      REAL(wp) ::   zsch      ! schmidt number  
    … …  
    117114         ! time interpolation at time kt 
    118115         DO jm = 1, jphem 
    119             zpatm(jm,jl) = (  p_cfc(iyear_beg, jm, jl) * FLOAT (im1)  & 
    120                &           +  p_cfc(iyear_end, jm, jl) * FLOAT (im2) ) / 12. 
     116            zpatm(jm,jl) = (  atm_cfc(iyear_beg, jm, jl) * REAL(im1, wp)  & 
     117               &           +  atm_cfc(iyear_end, jm, jl) * REAL(im2, wp) ) / 12. 
    121118         END DO 
    122119          
    … …  
    145142   
    146143               ! Computation of speed transfert 
    147                !    Schmidt number 
     144               !    Schmidt number revised in Wanninkhof (2014) 
    148145               zt1  = tsn(ji,jj,1,jp_tem) 
    149146               zt2  = zt1 * zt1  
    150147               zt3  = zt1 * zt2 
    151                zsch = sca(1,jl) + sca(2,jl) * zt1 + sca(3,jl) * zt2 + sca(4,jl) * zt3 
    152  
    153                !    speed transfert : formulae of wanninkhof 1992 
     148               zt4  = zt2 * zt2 
     149               zsch = sca(1,jl) + sca(2,jl) * zt1 + sca(3,jl) * zt2 + sca(4,jl) * zt3 + sca(5,jl) * zt4 
     150 
     151               !    speed transfert : formulae revised in Wanninkhof (2014) 
    154152               zv2     = wndm(ji,jj) * wndm(ji,jj) 
    155153               zsch    = zsch / 660. 
    156                zak_cfc = ( 0.39 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1) 
     154               zak_cfc = ( 0.31 * xconv2 * zv2 / SQRT(zsch) ) * tmask(ji,jj,1) 
    157155 
    158156               ! Input function  : speed *( conc. at equil - concen at surface ) 
    159157               ! trn in pico-mol/l idem qtr; ak in en m/a 
    160158               qtr_cfc(ji,jj,jl) = -zak_cfc * ( trb(ji,jj,1,jn) - zca_cfc )   & 
    161 #if defined key_degrad 
    162                   &                         * facvol(ji,jj,1)                           & 
    163 #endif 
    164159                  &                         * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) ) 
    165160               ! Add the surface flux to the trend 
    … …  
    185180      ! 
    186181      IF( lk_iomput ) THEN 
    187          CALL iom_put( "qtrCFC11"  , qtr_cfc (:,:,1) ) 
    188          CALL iom_put( "qintCFC11" , qint_cfc(:,:,1) ) 
    189       ELSE 
    190          IF( ln_diatrc ) THEN 
    191             trc2d(:,:,jp_cfc0_2d    ) = qtr_cfc (:,:,1) 
    192             trc2d(:,:,jp_cfc0_2d + 1) = qint_cfc(:,:,1) 
    193          END IF 
     182         DO jn = jp_cfc0, jp_cfc1 
     183            CALL iom_put( 'qtr_'//ctrcnm(jn) , qtr_cfc (:,:,jn) ) 
     184            CALL iom_put( 'qint_'//ctrcnm(jn), qint_cfc(:,:,jn) ) 
     185         ENDDO 
    194186      END IF 
    195187      ! 
    … …  
    212204      !!--------------------------------------------------------------------- 
    213205      INTEGER :: jn 
    214  
     206      !!---------------------------------------------------------------------- 
     207      ! 
     208      jn = 0  
    215209      ! coefficient for CFC11  
    216210      !---------------------- 
    217  
    218       ! Solubility 
    219       soa(1,1) = -229.9261  
    220       soa(2,1) =  319.6552 
    221       soa(3,1) =  119.4471 
    222       soa(4,1) =  -1.39165 
    223  
    224       sob(1,1) =  -0.142382 
    225       sob(2,1) =   0.091459 
    226       sob(3,1) =  -0.0157274 
    227  
    228       ! Schmidt number  
    229       sca(1,1) = 3501.8 
    230       sca(2,1) = -210.31 
    231       sca(3,1) =  6.1851 
    232       sca(4,1) = -0.07513 
     211      if ( ln_cfc11 ) then 
     212         jn = jn + 1 
     213         ! Solubility 
     214         soa(1,jn) = -229.9261  
     215         soa(2,jn) =  319.6552 
     216         soa(3,jn) =  119.4471 
     217         soa(4,jn) =  -1.39165 
     218 
     219         sob(1,jn) =  -0.142382 
     220         sob(2,jn) =   0.091459 
     221         sob(3,jn) =  -0.0157274 
     222 
     223         ! Schmidt number  
     224         sca(1,jn) = 3579.2 
     225         sca(2,jn) = -222.63 
     226         sca(3,jn) = 7.5749 
     227         sca(4,jn) = -0.14595 
     228         sca(5,jn) = 0.0011874 
     229 
     230         ! atm. concentration 
     231         atm_cfc(:,:,jn) = p_cfc(:,:,1) 
     232      endif 
    233233 
    234234      ! coefficient for CFC12  
    235235      !---------------------- 
    236  
    237       ! Solubility 
    238       soa(1,2) = -218.0971 
    239       soa(2,2) =  298.9702 
    240       soa(3,2) =  113.8049 
    241       soa(4,2) =  -1.39165 
    242  
    243       sob(1,2) =  -0.143566 
    244       sob(2,2) =   0.091015 
    245       sob(3,2) =  -0.0153924 
    246  
    247       ! schmidt number  
    248       sca(1,2) =  3845.4  
    249       sca(2,2) =  -228.95 
    250       sca(3,2) =  6.1908  
    251       sca(4,2) =  -0.067430 
     236      if ( ln_cfc12 ) then 
     237         jn = jn + 1 
     238         ! Solubility 
     239         soa(1,jn) = -218.0971 
     240         soa(2,jn) =  298.9702 
     241         soa(3,jn) =  113.8049 
     242         soa(4,jn) =  -1.39165 
     243 
     244         sob(1,jn) =  -0.143566 
     245         sob(2,jn) =   0.091015 
     246         sob(3,jn) =  -0.0153924 
     247 
     248         ! schmidt number  
     249         sca(1,jn) = 3828.1 
     250         sca(2,jn) = -249.86 
     251         sca(3,jn) = 8.7603 
     252         sca(4,jn) = -0.1716 
     253         sca(5,jn) = 0.001408 
     254 
     255         ! atm. concentration 
     256         atm_cfc(:,:,jn) = p_cfc(:,:,2) 
     257      endif 
     258 
     259      ! coefficient for SF6 
     260      !---------------------- 
     261      if ( ln_sf6 ) then 
     262         jn = jn + 1 
     263         ! Solubility 
     264         soa(1,jn) = -80.0343 
     265         soa(2,jn) = 117.232 
     266         soa(3,jn) =  29.5817 
     267         soa(4,jn) =   0.0 
     268 
     269         sob(1,jn) =  0.0335183  
     270         sob(2,jn) = -0.0373942  
     271         sob(3,jn) =  0.00774862 
     272 
     273         ! schmidt number 
     274         sca(1,jn) = 3177.5 
     275         sca(2,jn) = -200.57 
     276         sca(3,jn) = 6.8865 
     277         sca(4,jn) = -0.13335 
     278         sca(5,jn) = 0.0010877 
     279   
     280         ! atm. concentration 
     281         atm_cfc(:,:,jn) = p_cfc(:,:,3) 
     282       endif 
    252283 
    253284      IF( ln_rsttr ) THEN 
    … …  
    269300      !!                     ***  ROUTINE trc_sms_cfc_alloc  *** 
    270301      !!---------------------------------------------------------------------- 
    271       ALLOCATE( xphem   (jpi,jpj)        ,     & 
    272          &      qtr_cfc (jpi,jpj,jp_cfc) ,     & 
    273          &      qint_cfc(jpi,jpj,jp_cfc) , STAT=trc_sms_cfc_alloc ) 
     302      ALLOCATE( xphem   (jpi,jpj)        , atm_cfc(jpyear,jphem,jp_cfc)  ,    & 
     303         &      qtr_cfc (jpi,jpj,jp_cfc) , qint_cfc(jpi,jpj,jp_cfc)      ,    & 
     304         &      soa(4,jp_cfc)    ,  sob(3,jp_cfc)   ,  sca(5,jp_cfc)     ,    & 
     305         &      STAT=trc_sms_cfc_alloc ) 
    274306         ! 
    275307      IF( trc_sms_cfc_alloc /= 0 ) CALL ctl_warn('trc_sms_cfc_alloc : failed to allocate arrays.') 
    … …  
    277309   END FUNCTION trc_sms_cfc_alloc 
    278310 
    279 #else 
    280    !!---------------------------------------------------------------------- 
    281    !!   Dummy module                                         No CFC tracers 
    282    !!---------------------------------------------------------------------- 
    283 CONTAINS 
    284    SUBROUTINE trc_sms_cfc( kt )       ! Empty routine 
    285       WRITE(*,*) 'trc_sms_cfc: You should not have seen this print! error?', kt 
    286    END SUBROUTINE trc_sms_cfc 
    287 #endif 
    288  
    289311   !!====================================================================== 
    290312END MODULE trcsms_cfc 

  • trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trcwri_cfc.F90

    r5836 r7646  
    66   !! History :   1.0  !  2009-05 (C. Ethe)  Original code 
    77   !!---------------------------------------------------------------------- 
    8 #if defined key_top && defined key_cfc && defined key_iomput 
    9    !!---------------------------------------------------------------------- 
    10    !!   'key_cfc'                                           cfc model 
     8#if defined key_top && defined key_iomput 
    119   !!---------------------------------------------------------------------- 
    1210   !! trc_wri_cfc   :  outputs of concentration fields 

  • trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/par_my_trc.F90

    r3680 r7646  
    1010   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    1111   !!---------------------------------------------------------------------- 
    12    USE par_pisces , ONLY : jp_pisces       !: number of tracers in PISCES 
    13    USE par_pisces , ONLY : jp_pisces_2d    !: number of 2D diag in PISCES 
    14    USE par_pisces , ONLY : jp_pisces_3d    !: number of 3D diag in PISCES 
    15    USE par_pisces , ONLY : jp_pisces_trd   !: number of biological diag in PISCES 
    16  
    17    USE par_cfc    , ONLY : jp_cfc          !: number of tracers in CFC 
    18    USE par_cfc    , ONLY : jp_cfc_2d       !: number of tracers in CFC 
    19    USE par_cfc    , ONLY : jp_cfc_3d       !: number of tracers in CFC 
    20    USE par_cfc    , ONLY : jp_cfc_trd      !: number of tracers in CFC 
    21  
    22    USE par_c14b   , ONLY : jp_c14b         !: number of tracers in C14 
    23    USE par_c14b   , ONLY : jp_c14b_2d      !: number of tracers in C14 
    24    USE par_c14b   , ONLY : jp_c14b_3d      !: number of tracers in C14 
    25    USE par_c14b   , ONLY : jp_c14b_trd     !: number of tracers in C14 
    2612 
    2713   IMPLICIT NONE 
    2814 
    29    INTEGER, PARAMETER ::   jp_lm      =  jp_pisces     + jp_cfc     + jp_c14b     !:  
    30    INTEGER, PARAMETER ::   jp_lm_2d   =  jp_pisces_2d  + jp_cfc_2d  + jp_c14b_2d  !: 
    31    INTEGER, PARAMETER ::   jp_lm_3d   =  jp_pisces_3d  + jp_cfc_3d  + jp_c14b_3d  !: 
    32    INTEGER, PARAMETER ::   jp_lm_trd  =  jp_pisces_trd + jp_cfc_trd + jp_c14b_trd !: 
    33  
    34 #if defined key_my_trc 
    35    !!--------------------------------------------------------------------- 
    36    !!   'key_my_trc'                     user defined tracers (MY_TRC) 
    37    !!--------------------------------------------------------------------- 
    38    LOGICAL, PUBLIC, PARAMETER ::   lk_my_trc     = .TRUE.   !: PTS flag  
    39    INTEGER, PUBLIC, PARAMETER ::   jp_my_trc     =  1       !: number of PTS tracers 
    40    INTEGER, PUBLIC, PARAMETER ::   jp_my_trc_2d  =  0       !: additional 2d output arrays ('key_trc_diaadd') 
    41    INTEGER, PUBLIC, PARAMETER ::   jp_my_trc_3d  =  0       !: additional 3d output arrays ('key_trc_diaadd') 
    42    INTEGER, PUBLIC, PARAMETER ::   jp_my_trc_trd =  0       !: number of sms trends for MY_TRC 
    43  
    44    ! assign an index in trc arrays for each PTS prognostic variables 
    45    INTEGER, PUBLIC, PARAMETER ::   jpmyt1 = jp_lm + 1     !: 1st MY_TRC tracer 
    46  
    47 #else 
    48    !!--------------------------------------------------------------------- 
    49    !!   Default                           No user defined tracers (MY_TRC) 
    50    !!--------------------------------------------------------------------- 
    51    LOGICAL, PUBLIC, PARAMETER ::   lk_my_trc     = .FALSE.  !: MY_TRC flag  
    52    INTEGER, PUBLIC, PARAMETER ::   jp_my_trc     =  0       !: No MY_TRC tracers 
    53    INTEGER, PUBLIC, PARAMETER ::   jp_my_trc_2d  =  0       !: No MY_TRC additional 2d output arrays  
    54    INTEGER, PUBLIC, PARAMETER ::   jp_my_trc_3d  =  0       !: No MY_TRC additional 3d output arrays  
    55    INTEGER, PUBLIC, PARAMETER ::   jp_my_trc_trd =  0       !: number of sms trends for MY_TRC 
    56 #endif 
    57  
    5815   ! Starting/ending PISCES do-loop indices (N.B. no PISCES : jpl_pcs < jpf_pcs the do-loop are never done) 
    59    INTEGER, PUBLIC, PARAMETER ::   jp_myt0     = jp_lm     + 1              !: First index of MY_TRC passive tracers 
    60    INTEGER, PUBLIC, PARAMETER ::   jp_myt1     = jp_lm     + jp_my_trc      !: Last  index of MY_TRC passive tracers 
    61    INTEGER, PUBLIC, PARAMETER ::   jp_myt0_2d  = jp_lm_2d  + 1              !: First index of MY_TRC passive tracers 
    62    INTEGER, PUBLIC, PARAMETER ::   jp_myt1_2d  = jp_lm_2d  + jp_my_trc_2d   !: Last  index of MY_TRC passive tracers 
    63    INTEGER, PUBLIC, PARAMETER ::   jp_myt0_3d  = jp_lm_3d  + 1              !: First index of MY_TRC passive tracers 
    64    INTEGER, PUBLIC, PARAMETER ::   jp_myt1_3d  = jp_lm_3d  + jp_my_trc_3d   !: Last  index of MY_TRC passive tracers 
    65    INTEGER, PUBLIC, PARAMETER ::   jp_myt0_trd = jp_lm_trd + 1              !: First index of MY_TRC passive tracers 
    66    INTEGER, PUBLIC, PARAMETER ::   jp_myt1_trd = jp_lm_trd + jp_my_trc_trd  !: Last  index of MY_TRC passive tracers 
    67  
     16   INTEGER, PUBLIC ::   jp_myt0             !: First index of MY_TRC passive tracers 
     17   INTEGER, PUBLIC ::   jp_myt1             !: Last  index of MY_TRC passive tracers 
    6818   !!====================================================================== 
    6919END MODULE par_my_trc 

  • trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcice_my_trc.F90

    r5439 r7646  
    33   !!                         ***  MODULE trcice_my_trc  *** 
    44   !!---------------------------------------------------------------------- 
    5 #if defined key_my_trc 
     5   !! trc_ice_my_trc       : MY_TRC model seaice coupling routine 
    66   !!---------------------------------------------------------------------- 
    7    !!   'key_my_trc'                                               CFC tracers 
    8    !!---------------------------------------------------------------------- 
    9    !! trc_ice_my_trc       : MY_TRC model main routine 
     7   !! History :        !  2016  (C. Ethe, T. Lovato) Revised architecture 
    108   !!---------------------------------------------------------------------- 
    119   USE par_trc         ! TOP parameters 
    … …  
    1917 
    2018   !!---------------------------------------------------------------------- 
    21    !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    22    !! $Id: trcice_my_trc.F90 4990 2014-12-15 16:42:49Z timgraham $ 
     19   !! NEMO/TOP 4.0 , NEMO Consortium (2016) 
     20   !! $Id$ 
    2321   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    2422   !!---------------------------------------------------------------------- 
    … …  
    3432   END SUBROUTINE trc_ice_ini_my_trc 
    3533 
    36 #else 
    37    !!---------------------------------------------------------------------- 
    38    !!   Dummy module                                        No MY_TRC model 
    39    !!---------------------------------------------------------------------- 
    40 CONTAINS 
    41    SUBROUTINE trc_ice_ini_my_trc             ! Empty routine 
    42    END SUBROUTINE trc_ice_ini_my_trc 
    43 #endif 
    44  
    4534   !!====================================================================== 
    4635END MODULE trcice_my_trc 

  • trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcini_my_trc.F90

    r5385 r7646  
    44   !! TOP :   initialisation of the MY_TRC tracers 
    55   !!====================================================================== 
    6    !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) Original code 
    7    !!---------------------------------------------------------------------- 
    8 #if defined key_my_trc 
    9    !!---------------------------------------------------------------------- 
    10    !!   'key_my_trc'                                               CFC tracers 
     6   !! History :        !  2007  (C. Ethe, G. Madec) Original code 
     7   !!                  !  2016  (C. Ethe, T. Lovato) Revised architecture 
    118   !!---------------------------------------------------------------------- 
    129   !! trc_ini_my_trc   : MY_TRC model initialisation 
    … …  
    1512   USE oce_trc 
    1613   USE trc 
     14   USE par_my_trc 
     15   USE trcnam_my_trc     ! MY_TRC SMS namelist 
    1716   USE trcsms_my_trc 
    1817 
    … …  
    2322 
    2423   !!---------------------------------------------------------------------- 
    25    !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     24   !! NEMO/TOP 4.0 , NEMO Consortium (2016) 
    2625   !! $Id$  
    2726   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    3736      !! ** Method  : - Read the namcfc namelist and check the parameter values 
    3837      !!---------------------------------------------------------------------- 
    39  
     38      ! 
     39      CALL trc_nam_my_trc 
     40      ! 
    4041      !                       ! Allocate MY_TRC arrays 
    4142      IF( trc_sms_my_trc_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trc_ini_my_trc: unable to allocate MY_TRC arrays' ) 
    … …  
    5354   END SUBROUTINE trc_ini_my_trc 
    5455 
    55 #else 
    56    !!---------------------------------------------------------------------- 
    57    !!   Dummy module                                        No MY_TRC model 
    58    !!---------------------------------------------------------------------- 
    59 CONTAINS 
    60    SUBROUTINE trc_ini_my_trc             ! Empty routine 
    61    END SUBROUTINE trc_ini_my_trc 
    62 #endif 
    63  
    6456   !!====================================================================== 
    6557END MODULE trcini_my_trc 

  • trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcnam_my_trc.F90

    r3680 r7646  
    44   !! TOP :   initialisation of some run parameters for MY_TRC bio-model 
    55   !!====================================================================== 
    6    !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) Original code 
    7    !!---------------------------------------------------------------------- 
    8 #if defined key_my_trc 
    9    !!---------------------------------------------------------------------- 
    10    !!   'key_my_trc'   :                                       MY_TRC model 
     6   !! History :      !  2007  (C. Ethe, G. Madec) Original code 
     7   !!                !  2016  (C. Ethe, T. Lovato) Revised architecture 
    118   !!---------------------------------------------------------------------- 
    129   !! trc_nam_my_trc      : MY_TRC model initialisation 
    … …  
    2219 
    2320   !!---------------------------------------------------------------------- 
    24    !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     21   !! NEMO/TOP 4.0 , NEMO Consortium (2016) 
    2522   !! $Id$  
    2623   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    4340   END SUBROUTINE trc_nam_my_trc 
    4441    
    45 #else 
    46    !!---------------------------------------------------------------------- 
    47    !!  Dummy module :                                             No MY_TRC 
    48    !!---------------------------------------------------------------------- 
    49 CONTAINS 
    50    SUBROUTINE trc_nam_my_trc                      ! Empty routine 
    51    END  SUBROUTINE  trc_nam_my_trc 
    52 #endif   
    53  
    5442   !!====================================================================== 
    5543END MODULE trcnam_my_trc 

  • trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90

    r6140 r7646  
    44   !! TOP :   Main module of the MY_TRC tracers 
    55   !!====================================================================== 
    6    !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) Original code 
    7    !!---------------------------------------------------------------------- 
    8 #if defined key_my_trc 
    9    !!---------------------------------------------------------------------- 
    10    !!   'key_my_trc'                                               CFC tracers 
     6   !! History :      !  2007  (C. Ethe, G. Madec)  Original code 
     7   !!                !  2016  (C. Ethe, T. Lovato) Revised architecture 
    118   !!---------------------------------------------------------------------- 
    129   !! trc_sms_my_trc       : MY_TRC model main routine 
    … …  
    1815   USE trd_oce 
    1916   USE trdtrc 
    20    USE trcbc, only : trc_bc_read 
     17   USE trcbc, only : trc_bc 
    2118 
    2219   IMPLICIT NONE 
    … …  
    2926 
    3027   !!---------------------------------------------------------------------- 
    31    !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     28   !! NEMO/TOP 4.0 , NEMO Consortium (2016) 
    3229   !! $Id$ 
    3330   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    5754      IF( l_trdtrc )  CALL wrk_alloc( jpi, jpj, jpk, ztrmyt ) 
    5855 
    59       CALL trc_bc_read ( kt )       ! tracers: surface and lateral Boundary Conditions 
     56      CALL trc_bc ( kt )       ! tracers: surface and lateral Boundary Conditions 
    6057 
    6158      ! add here the call to BGC model 
    … …  
    7471   END SUBROUTINE trc_sms_my_trc 
    7572 
    76  
    7773   INTEGER FUNCTION trc_sms_my_trc_alloc() 
    7874      !!---------------------------------------------------------------------- 
    … …  
    8884   END FUNCTION trc_sms_my_trc_alloc 
    8985 
    90  
    91 #else 
    92    !!---------------------------------------------------------------------- 
    93    !!   Dummy module                                        No MY_TRC model 
    94    !!---------------------------------------------------------------------- 
    95 CONTAINS 
    96    SUBROUTINE trc_sms_my_trc( kt )             ! Empty routine 
    97       INTEGER, INTENT( in ) ::   kt 
    98       WRITE(*,*) 'trc_sms_my_trc: You should not have seen this print! error?', kt 
    99    END SUBROUTINE trc_sms_my_trc 
    100 #endif 
    101  
    10286   !!====================================================================== 
    10387END MODULE trcsms_my_trc 

  • trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcwri_my_trc.F90

    r6140 r7646  
    22   !!====================================================================== 
    33   !!                       *** MODULE trcwri *** 
    4    !!    my_trc :   Output of my_trc tracers 
     4   !!     trc_wri_my_trc   :  outputs of concentration fields 
    55   !!====================================================================== 
    6    !! History :   1.0  !  2009-05 (C. Ethe)  Original code 
     6#if defined key_top && defined key_iomput 
    77   !!---------------------------------------------------------------------- 
    8 #if defined key_top && defined key_my_trc && defined key_iomput 
     8   !! History :      !  2007  (C. Ethe, G. Madec)  Original code 
     9   !!                !  2016  (C. Ethe, T. Lovato) Revised architecture 
    910   !!---------------------------------------------------------------------- 
    10    !!   'key_my_trc'                                           my_trc model 
    11    !!---------------------------------------------------------------------- 
    12    !! trc_wri_my_trc   :  outputs of concentration fields 
    13    !!---------------------------------------------------------------------- 
     11   USE par_trc         ! passive tracers common variables 
    1412   USE trc         ! passive tracers common variables  
    1513   USE iom         ! I/O manager 
    … …  
    2018   PUBLIC trc_wri_my_trc  
    2119 
     20   !!---------------------------------------------------------------------- 
     21   !! NEMO/TOP 4.0 , NEMO Consortium (2016) 
     22   !! $Id$ 
     23   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
     24   !!---------------------------------------------------------------------- 
    2225CONTAINS 
    2326 
    … …  
    3639      DO jn = jp_myt0, jp_myt1 
    3740         cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer 
    38          IF( ln_trc_wri(jn) ) CALL iom_put( cltra, trn(:,:,:,jn) ) 
     41         CALL iom_put( cltra, trn(:,:,:,jn) ) 
    3942      END DO 
    4043      ! 
    … …  
    4245 
    4346#else 
    44    !!---------------------------------------------------------------------- 
    45    !!  Dummy module :                                     No passive tracer 
    46    !!---------------------------------------------------------------------- 
    47    PUBLIC trc_wri_my_trc 
     47 
    4848CONTAINS 
    49    SUBROUTINE trc_wri_my_trc                     ! Empty routine   
     49 
     50   SUBROUTINE trc_wri_my_trc 
     51      ! 
    5052   END SUBROUTINE trc_wri_my_trc 
     53 
    5154#endif 
    5255 
    53    !!---------------------------------------------------------------------- 
    54    !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    55    !! $Id: trcwri_my_trc.F90 3160 2011-11-20 14:27:18Z cetlod $  
    56    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    57    !!====================================================================== 
    5856END MODULE trcwri_my_trc 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zbio.F90

    r6140 r7646  
    88   !!              -   !  2001-03  (M. Levy)  LNO3 + dia2d  
    99   !!             2.0  !  2007-12  (C. Deltel, G. Madec)  F90 
    10    !!---------------------------------------------------------------------- 
    11 #if defined key_pisces_reduced 
    12    !!---------------------------------------------------------------------- 
    13    !!   'key_pisces_reduced'                                     LOBSTER bio-model 
    1410   !!---------------------------------------------------------------------- 
    1511   !!   p2z_bio        :   
    … …  
    8682      !!                                  source      sink 
    8783      !!         
    88       !!              IF 'key_diabio' defined , the biogeochemical trends 
    89       !!              for passive tracers are saved for futher diagnostics. 
    9084      !!--------------------------------------------------------------------- 
    9185      !! 
    … …  
    109103      IF( nn_timing == 1 )  CALL timing_start('p2z_bio') 
    110104      ! 
    111       IF( ln_diatrc .OR. lk_iomput ) THEN 
     105      IF( lk_iomput ) THEN 
    112106         CALL wrk_alloc( jpi, jpj,     17, zw2d ) 
    113107         CALL wrk_alloc( jpi, jpj, jpk, 3, zw3d ) 
    … …  
    121115 
    122116      xksi(:,:) = 0.e0        ! zooplakton closure ( fbod) 
    123       IF( ln_diatrc .OR. lk_iomput ) THEN 
     117      IF( lk_iomput ) THEN 
    124118         zw2d  (:,:,:) = 0.e0 
    125119         zw3d(:,:,:,:) = 0.e0 
    … …  
    218212               tra(ji,jj,jk,jpdom) = tra(ji,jj,jk,jpdom) + zdoma 
    219213 
    220  
    221                IF( ( ln_diabio .AND. .NOT. lk_iomput ) .OR. l_trdtrc ) THEN 
    222                   trbio(ji,jj,jk,jp_pcs0_trd     ) = zno3phy 
    223                   trbio(ji,jj,jk,jp_pcs0_trd +  1) = znh4phy 
    224                   trbio(ji,jj,jk,jp_pcs0_trd +  2) = zphynh4 
    225                   trbio(ji,jj,jk,jp_pcs0_trd +  3) = zphydom 
    226                   trbio(ji,jj,jk,jp_pcs0_trd +  4) = zphyzoo 
    227                   trbio(ji,jj,jk,jp_pcs0_trd +  5) = zphydet 
    228                   trbio(ji,jj,jk,jp_pcs0_trd +  6) = zdetzoo 
    229                   !  trend number 8 in p2zsed 
    230                   trbio(ji,jj,jk,jp_pcs0_trd +  8) = zzoodet 
    231                   trbio(ji,jj,jk,jp_pcs0_trd +  9) = zzoobod 
    232                   trbio(ji,jj,jk,jp_pcs0_trd + 10) = zzoonh4 
    233                   trbio(ji,jj,jk,jp_pcs0_trd + 11) = zzoodom 
    234                   trbio(ji,jj,jk,jp_pcs0_trd + 12) = znh4no3 
    235                   trbio(ji,jj,jk,jp_pcs0_trd + 13) = zdomnh4 
    236                   trbio(ji,jj,jk,jp_pcs0_trd + 14) = zdetnh4 
    237                   trbio(ji,jj,jk,jp_pcs0_trd + 15) = zdetdom 
    238                   !  trend number 17 in p2zexp 
    239                 ENDIF 
    240                 IF( ln_diatrc .OR. lk_iomput ) THEN 
     214                IF( lk_iomput ) THEN 
    241215                  ! convert fluxes in per day 
    242216                  ze3t = e3t_n(ji,jj,jk) * 86400._wp 
    … …  
    340314               tra(ji,jj,jk,jpdom) = tra(ji,jj,jk,jpdom) + zdoma 
    341315               ! 
    342                IF( ( ln_diabio .AND. .NOT. lk_iomput ) .OR. l_trdtrc ) THEN 
    343                   trbio(ji,jj,jk,jp_pcs0_trd     ) = zno3phy 
    344                   trbio(ji,jj,jk,jp_pcs0_trd +  1) = znh4phy 
    345                   trbio(ji,jj,jk,jp_pcs0_trd +  2) = zphynh4 
    346                   trbio(ji,jj,jk,jp_pcs0_trd +  3) = zphydom 
    347                   trbio(ji,jj,jk,jp_pcs0_trd +  4) = zphyzoo 
    348                   trbio(ji,jj,jk,jp_pcs0_trd +  5) = zphydet 
    349                   trbio(ji,jj,jk,jp_pcs0_trd +  6) = zdetzoo 
    350                   !  trend number 8 in p2zsed 
    351                   trbio(ji,jj,jk,jp_pcs0_trd +  8) = zzoodet 
    352                   trbio(ji,jj,jk,jp_pcs0_trd +  9) = zzoobod 
    353                   trbio(ji,jj,jk,jp_pcs0_trd + 10) = zzoonh4 
    354                   trbio(ji,jj,jk,jp_pcs0_trd + 11) = zzoodom 
    355                   trbio(ji,jj,jk,jp_pcs0_trd + 12) = znh4no3 
    356                   trbio(ji,jj,jk,jp_pcs0_trd + 13) = zdomnh4 
    357                   trbio(ji,jj,jk,jp_pcs0_trd + 14) = zdetnh4 
    358                   trbio(ji,jj,jk,jp_pcs0_trd + 15) = zdetdom 
    359                   !  trend number 17 in p2zexp  
    360                 ENDIF 
    361                 IF( ln_diatrc .OR. lk_iomput ) THEN 
     316                IF( lk_iomput ) THEN 
    362317                  ! convert fluxes in per day 
    363318                  ze3t = e3t_n(ji,jj,jk) * 86400._wp 
    … …  
    389344      END DO 
    390345 
    391       IF( ln_diatrc .OR. lk_iomput ) THEN 
     346      IF( lk_iomput ) THEN 
    392347         DO jl = 1, 17  
    393348            CALL lbc_lnk( zw2d(:,:,jl),'T', 1. ) 
    … …  
    420375        CALL iom_put( "FNH4NO3", zw3d(:,:,:,3) ) 
    421376         ! 
    422        ELSE 
    423           IF( ln_diatrc ) THEN 
    424             ! 
    425             trc2d(:,:,jp_pcs0_2d    ) = zw2d(:,:,1)  
    426             trc2d(:,:,jp_pcs0_2d + 1) = zw2d(:,:,2)  
    427             trc2d(:,:,jp_pcs0_2d + 2) = zw2d(:,:,3)  
    428             trc2d(:,:,jp_pcs0_2d + 3) = zw2d(:,:,4)  
    429             trc2d(:,:,jp_pcs0_2d + 4) = zw2d(:,:,5)  
    430             trc2d(:,:,jp_pcs0_2d + 5) = zw2d(:,:,6)  
    431             trc2d(:,:,jp_pcs0_2d + 6) = zw2d(:,:,7)  
    432                      ! trend number 8 is in p2zsed.F 
    433             trc2d(:,:,jp_pcs0_2d +  8) = zw2d(:,:,8)  
    434             trc2d(:,:,jp_pcs0_2d +  9) = zw2d(:,:,9)  
    435             trc2d(:,:,jp_pcs0_2d + 10) = zw2d(:,:,10)  
    436             trc2d(:,:,jp_pcs0_2d + 11) = zw2d(:,:,11)  
    437             trc2d(:,:,jp_pcs0_2d + 12) = zw2d(:,:,12)  
    438             trc2d(:,:,jp_pcs0_2d + 13) = zw2d(:,:,13)  
    439             trc2d(:,:,jp_pcs0_2d + 14) = zw2d(:,:,14)  
    440             trc2d(:,:,jp_pcs0_2d + 15) = zw2d(:,:,15)  
    441             trc2d(:,:,jp_pcs0_2d + 16) = zw2d(:,:,16)  
    442             trc2d(:,:,jp_pcs0_2d + 17) = zw2d(:,:,17)  
    443             ! trend number 19 is in p2zexp.F 
    444             trc3d(:,:,:,jp_pcs0_3d    ) = zw3d(:,:,:,1)  
    445             trc3d(:,:,:,jp_pcs0_3d + 1) = zw3d(:,:,:,2)  
    446             trc3d(:,:,:,jp_pcs0_3d + 2) = zw3d(:,:,:,3)  
    447          ENDIF 
    448         ! 
    449       ENDIF 
    450  
    451       IF( ln_diabio .AND. .NOT. lk_iomput )  THEN 
    452          DO jl = jp_pcs0_trd, jp_pcs1_trd 
    453             CALL lbc_lnk( trbio(:,:,1,jl),'T', 1. ) 
    454          END DO  
    455       ENDIF 
    456       ! 
    457       IF( l_trdtrc ) THEN 
    458          DO jl = jp_pcs0_trd, jp_pcs1_trd 
    459             CALL trd_trc( trbio(:,:,:,jl), jl, kt )   ! handle the trend 
    460          END DO 
    461377      ENDIF 
    462378 
    … …  
    467383      ENDIF 
    468384      ! 
    469       IF( ln_diatrc .OR. lk_iomput ) THEN 
     385      IF( lk_iomput ) THEN 
    470386         CALL wrk_dealloc( jpi, jpj,     17, zw2d ) 
    471387         CALL wrk_dealloc( jpi, jpj, jpk, 3, zw3d ) 
    … …  
    586502   END SUBROUTINE p2z_bio_init 
    587503 
    588 #else 
    589    !!====================================================================== 
    590    !!  Dummy module :                                   No PISCES bio-model 
    591    !!====================================================================== 
    592 CONTAINS 
    593    SUBROUTINE p2z_bio( kt )                   ! Empty routine 
    594       INTEGER, INTENT( in ) ::   kt 
    595       WRITE(*,*) 'p2z_bio: You should not have seen this print! error?', kt 
    596    END SUBROUTINE p2z_bio 
    597 #endif  
    598  
    599504   !!====================================================================== 
    600505END MODULE p2zbio 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zexp.F90

    r6140 r7646  
    1010   !!             3.5  !  2012-03  (C. Ethe)  Merge PISCES-LOBSTER 
    1111   !!---------------------------------------------------------------------- 
    12 #if defined key_pisces_reduced 
    13    !!---------------------------------------------------------------------- 
    14    !!   'key_pisces_reduced'                                     LOBSTER bio-model 
    15    !!---------------------------------------------------------------------- 
    1612   !!   p2z_exp        :  Compute loss of organic matter in the sediments 
    1713   !!---------------------------------------------------------------------- 
    … …  
    6864      INTEGER  ::   ji, jj, jk, jl, ikt 
    6965      REAL(wp) ::   zgeolpoc, zfact, zwork, ze3t, zsedpocd, zmaskt 
    70       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrbio 
    7166      REAL(wp), POINTER, DIMENSION(:,:)   ::  zsedpoca 
    7267      CHARACTER (len=25) :: charout 
    … …  
    8075      zsedpoca(:,:) = 0. 
    8176 
    82       IF( l_trdtrc )  THEN 
    83          CALL wrk_alloc( jpi, jpj, jpk, ztrbio )   ! temporary save of trends 
    84          ztrbio(:,:,:) = tra(:,:,:,jpno3) 
    85       ENDIF 
    8677 
    8778      ! VERTICAL DISTRIBUTION OF NEWLY PRODUCED BIOGENIC 
    … …  
    126117  
    127118      ! Oa & Ek: diagnostics depending on jpdia2d !          left as example 
    128       IF( lk_iomput ) THEN   
    129          CALL iom_put( "SEDPOC" , sedpocn ) 
    130       ELSE 
    131          IF( ln_diatrc )           trc2d(:,:,jp_pcs0_2d + 18) = sedpocn(:,:) 
    132       ENDIF 
     119      IF( lk_iomput )  CALL iom_put( "SEDPOC" , sedpocn ) 
    133120 
    134121       
    … …  
    160147      ENDIF 
    161148      ! 
    162       IF( l_trdtrc ) THEN 
    163          ztrbio(:,:,:) = tra(:,:,:,jpno3) - ztrbio(:,:,:) 
    164          jl = jp_pcs0_trd + 16 
    165          CALL trd_trc( ztrbio, jl, kt )   ! handle the trend 
    166          CALL wrk_dealloc( jpi, jpj, jpk, ztrbio )   ! temporary save of trends 
    167       ENDIF 
    168       ! 
    169149      CALL wrk_dealloc( jpi, jpj, zsedpoca)   ! temporary save of trends 
    170150 
    … …  
    281261   END FUNCTION p2z_exp_alloc 
    282262 
    283 #else 
    284    !!====================================================================== 
    285    !!  Dummy module :                                   No PISCES bio-model 
    286    !!====================================================================== 
    287 CONTAINS 
    288    SUBROUTINE p2z_exp( kt )                   ! Empty routine 
    289       INTEGER, INTENT( in ) ::   kt 
    290       WRITE(*,*) 'p2z_exp: You should not have seen this print! error?', kt 
    291    END SUBROUTINE p2z_exp 
    292 #endif  
    293  
    294263   !!====================================================================== 
    295264END MODULE  p2zexp 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zopt.F90

    r6140 r7646  
    1010   !!   NEMO      2.0  !  2007-12  (C. Deltel, G. Madec)  F90 
    1111   !!             3.2  !  2009-04  (C. Ethe, G. Madec)  minor optimisation + style 
    12    !!---------------------------------------------------------------------- 
    13 #if defined key_pisces_reduced 
    14    !!---------------------------------------------------------------------- 
    15    !!   'key_pisces_reduced'                                     LOBSTER bio-model 
    1612   !!---------------------------------------------------------------------- 
    1713   !!   p2z_opt        :   Compute the light availability in the water column 
    … …  
    208204   END SUBROUTINE p2z_opt_init 
    209205 
    210 #else 
    211    !!====================================================================== 
    212    !!  Dummy module :                                   No PISCES bio-model 
    213    !!====================================================================== 
    214 CONTAINS 
    215    SUBROUTINE p2z_opt( kt )                   ! Empty routine 
    216       INTEGER, INTENT( in ) ::   kt 
    217       WRITE(*,*) 'p2z_opt: You should not have seen this print! error?', kt 
    218    END SUBROUTINE p2z_opt 
    219 #endif  
    220  
    221206   !!====================================================================== 
    222207END MODULE  p2zopt 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsed.F90

    r6140 r7646  
    77   !!              -   !  2000-12 (E. Kestenare)  clean up 
    88   !!             2.0  !  2007-12  (C. Deltel, G. Madec)  F90 + simplifications 
    9    !!---------------------------------------------------------------------- 
    10 #if defined key_pisces_reduced 
    11    !!---------------------------------------------------------------------- 
    12    !!   'key_pisces_reduced'                                     LOBSTER bio-model 
    139   !!---------------------------------------------------------------------- 
    1410   !!   p2z_sed        :  Compute loss of organic matter in the sediments 
    … …  
    6662      CHARACTER (len=25) :: charout 
    6763      REAL(wp), POINTER, DIMENSION(:,:  ) :: zw2d 
    68       REAL(wp), POINTER, DIMENSION(:,:,:) :: zwork, ztra, ztrbio 
     64      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwork, ztra 
    6965      !!--------------------------------------------------------------------- 
    7066      ! 
    … …  
    7975      ! Allocate temporary workspace 
    8076      CALL wrk_alloc( jpi, jpj, jpk, zwork, ztra ) 
    81       IF( l_trdtrc ) THEN 
    82          CALL wrk_alloc( jpi, jpj, jpk, ztrbio ) 
    83          ztrbio(:,:,:) = tra(:,:,:,jpdet) 
    84       ENDIF 
    8577 
    8678      ! sedimentation of detritus  : upstream scheme 
    … …  
    116108            CALL wrk_dealloc( jpi, jpj, zw2d ) 
    117109         ENDIF 
    118       ELSE 
    119          IF( ln_diatrc ) THEN  
    120             CALL wrk_alloc( jpi, jpj, zw2d ) 
    121             zw2d(:,:) =  ztra(:,:,1) * e3t_n(:,:,1) * 86400._wp 
    122             DO jk = 2, jpkm1 
    123                zw2d(:,:) = zw2d(:,:) + ztra(:,:,jk) * e3t_n(:,:,jk) * 86400._wp 
    124             END DO 
    125             trc2d(:,:,jp_pcs0_2d + 7) = zw2d(:,:) 
    126             CALL wrk_dealloc( jpi, jpj, zw2d ) 
    127          ENDIF 
    128110      ENDIF 
    129111      ! 
    130       IF( ln_diabio .AND. .NOT. lk_iomput )  trbio(:,:,:,jp_pcs0_trd + 7) = ztra(:,:,:) 
    131112      CALL wrk_dealloc( jpi, jpj, jpk, zwork, ztra ) 
    132113      ! 
    133       IF( l_trdtrc ) THEN 
    134          ztrbio(:,:,:) = tra(:,:,:,jpdet) - ztrbio(:,:,:) 
    135          jl = jp_pcs0_trd + 7 
    136          CALL trd_trc( ztrbio, jl, kt )   ! handle the trend 
    137          CALL wrk_dealloc( jpi, jpj, jpk, ztrbio ) 
    138       ENDIF 
    139114 
    140115      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    … …  
    180155   END SUBROUTINE p2z_sed_init 
    181156 
    182 #else 
    183    !!====================================================================== 
    184    !!  Dummy module :                                   No PISCES bio-model 
    185    !!====================================================================== 
    186 CONTAINS 
    187    SUBROUTINE p2z_sed( kt )                   ! Empty routine 
    188       INTEGER, INTENT( in ) ::   kt 
    189       WRITE(*,*) 'p2z_sed: You should not have seen this print! error?', kt 
    190    END SUBROUTINE p2z_sed 
    191 #endif  
    192  
    193157   !!====================================================================== 
    194158END MODULE  p2zsed 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P2Z/p2zsms.F90

    r5656 r7646  
    66   !! History :   1.0  !            M. Levy 
    77   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  revised architecture 
    8    !!---------------------------------------------------------------------- 
    9 #if defined key_pisces_reduced 
    10    !!---------------------------------------------------------------------- 
    11    !!   'key_pisces_reduced'                              LOBSTER bio-model 
    128   !!---------------------------------------------------------------------- 
    139   !!   p2zsms        :  Time loop of passive tracers sms 
    … …  
    7268   END SUBROUTINE p2z_sms 
    7369 
    74 #else 
    75    !!====================================================================== 
    76    !!  Dummy module :                                     No passive tracer 
    77    !!====================================================================== 
    78 CONTAINS 
    79    SUBROUTINE p2z_sms( kt )                   ! Empty routine 
    80       INTEGER, INTENT( in ) ::   kt 
    81       WRITE(*,*) 'p2z_sms: You should not have seen this print! error?', kt 
    82    END SUBROUTINE p2z_sms 
    83 #endif  
    84  
    8570   !!====================================================================== 
    8671END MODULE p2zsms 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zbio.F90

    r6140 r7646  
    66   !! History :   1.0  !  2004     (O. Aumont) Original code 
    77   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
    8    !!---------------------------------------------------------------------- 
    9 #if defined key_pisces 
    10    !!---------------------------------------------------------------------- 
    11    !!   'key_pisces'                                       PISCES bio-model 
    128   !!---------------------------------------------------------------------- 
    139   !!   p4z_bio        :   computes the interactions between the different 
    … …  
    2420   USE p4zmicro        !  Sources and sinks of microzooplankton 
    2521   USE p4zmeso         !  Sources and sinks of mesozooplankton 
     22   USE p5zlim          !  Co-limitations of differents nutrients 
     23   USE p5zprod         !  Growth rate of the 2 phyto groups 
     24   USE p5zmort         !  Mortality terms for phytoplankton 
     25   USE p5zmicro        !  Sources and sinks of microzooplankton 
     26   USE p5zmeso         !  Sources and sinks of mesozooplankton 
    2627   USE p4zrem          !  Remineralisation of organic matter 
     28   USE p4zpoc          !  Remineralization of organic particles 
     29   USE p4zagg          !  Aggregation of particles 
    2730   USE p4zfechem 
     31   USE p4zligand       !  Prognostic ligand model 
    2832   USE prtctl_trc      !  print control for debugging 
    2933   USE iom             !  I/O manager 
    … …  
    7377      END DO 
    7478 
    75       CALL p4z_opt  ( kt, knt )     ! Optic: PAR in the water column 
    76       CALL p4z_sink ( kt, knt )     ! vertical flux of particulate organic matter 
    77       CALL p4z_fechem(kt, knt )     ! Iron chemistry/scavenging 
    78       CALL p4z_lim  ( kt, knt )     ! co-limitations by the various nutrients 
    79       CALL p4z_prod ( kt, knt )     ! phytoplankton growth rate over the global ocean.  
    80       !                             ! (for each element : C, Si, Fe, Chl ) 
    81       CALL p4z_mort ( kt      )     ! phytoplankton mortality 
    82      !                             ! zooplankton sources/sinks routines  
    83       CALL p4z_micro( kt, knt )           ! microzooplankton 
    84       CALL p4z_meso ( kt, knt )           ! mesozooplankton 
    85       CALL p4z_rem  ( kt, knt )     ! remineralization terms of organic matter+scavenging of Fe 
    86       !                             ! test if tracers concentrations fall below 0. 
     79      CALL p4z_opt     ( kt, knt )     ! Optic: PAR in the water column 
     80      CALL p4z_sink    ( kt, knt )     ! vertical flux of particulate organic matter 
     81      CALL p4z_fechem  ( kt, knt )     ! Iron chemistry/scavenging 
     82      ! 
     83      IF( ln_p4z ) THEN 
     84         CALL p4z_lim  ( kt, knt )     ! co-limitations by the various nutrients 
     85         CALL p4z_prod ( kt, knt )     ! phytoplankton growth rate over the global ocean.  
     86         !                             ! (for each element : C, Si, Fe, Chl ) 
     87         CALL p4z_mort ( kt      )     ! phytoplankton mortality 
     88         !                             ! zooplankton sources/sinks routines  
     89         CALL p4z_micro( kt, knt )           ! microzooplankton 
     90         CALL p4z_meso ( kt, knt )           ! mesozooplankton 
     91      ELSE 
     92         CALL p5z_lim  ( kt, knt )     ! co-limitations by the various nutrients 
     93         CALL p5z_prod ( kt, knt )     ! phytoplankton growth rate over the global ocean.  
     94         !                             ! (for each element : C, Si, Fe, Chl ) 
     95         CALL p5z_mort ( kt      )     ! phytoplankton mortality 
     96         !                             ! zooplankton sources/sinks routines  
     97         CALL p5z_micro( kt, knt )           ! microzooplankton 
     98         CALL p5z_meso ( kt, knt )           ! mesozooplankton 
     99      ENDIF 
     100      ! 
     101      CALL p4z_agg  ( kt, knt )     ! Aggregation of particles 
     102      CALL p4z_rem     ( kt, knt )     ! remineralization terms of organic matter+scavenging of Fe 
     103      CALL p4z_poc     ( kt, knt )     ! Remineralization of organic particles 
     104      IF( ln_ligand ) THEN 
     105        CALL p4z_ligand( kt, knt ) 
     106      ENDIF 
    87107      !                                                             ! 
    88108      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    … …  
    96116   END SUBROUTINE p4z_bio 
    97117 
    98 #else 
    99    !!====================================================================== 
    100    !!  Dummy module :                                   No PISCES bio-model 
    101    !!====================================================================== 
    102 CONTAINS 
    103    SUBROUTINE p4z_bio                         ! Empty routine 
    104    END SUBROUTINE p4z_bio 
    105 #endif  
    106  
    107118   !!====================================================================== 
    108119END MODULE p4zbio 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zche.F90

    r6945 r7646  
    1111   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
    1212   !!                  !  2011-02  (J. Simeon, J.Orr ) update O2 solubility constants 
    13    !!---------------------------------------------------------------------- 
    14 #if defined key_pisces 
    15    !!---------------------------------------------------------------------- 
    16    !!   'key_pisces'                                       PISCES bio-model 
     13   !!             3.6  !  2016-03  (O. Aumont) Change chemistry to MOCSY standards 
    1714   !!---------------------------------------------------------------------- 
    1815   !!   p4z_che      :  Sea water chemistry computed following OCMIP protocol 
    … …  
    2219   USE sms_pisces    !  PISCES Source Minus Sink variables 
    2320   USE lib_mpp       !  MPP library 
     21   USE eosbn2, ONLY : neos 
    2422 
    2523   IMPLICIT NONE 
    2624   PRIVATE 
    2725 
    28    PUBLIC   p4z_che         ! 
    29    PUBLIC   p4z_che_alloc   ! 
    30  
    31    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sio3eq   ! chemistry of Si 
    32    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   fekeq    ! chemistry of Fe 
    33    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   chemc    ! Solubilities of O2 and CO2 
    34    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   chemo2   ! Solubilities of O2 and CO2 
     26   PUBLIC   p4z_che          ! 
     27   PUBLIC   p4z_che_alloc    ! 
     28   PUBLIC   ahini_for_at     ! 
     29   PUBLIC   solve_at_general ! 
     30 
     31   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: sio3eq   ! chemistry of Si 
     32   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: fekeq    ! chemistry of Fe 
     33   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: chemc    ! Solubilities of O2 and CO2 
     34   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   :: chemo2    ! Solubilities of O2 and CO2 
     35   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) :: fesol    ! solubility of Fe 
     36   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   salinprac  ! Practical salinity 
    3537   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tempis   ! In situ temperature 
    3638 
     39   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   akb3       !: ??? 
     40   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   akw3       !: ??? 
     41   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   akf3       !: ??? 
     42   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   aks3       !: ??? 
     43   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ak1p3      !: ??? 
     44   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ak2p3      !: ??? 
     45   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ak3p3      !: ??? 
     46   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   aksi3      !: ??? 
     47   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   borat      !: ??? 
     48   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   fluorid    !: ??? 
     49   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sulfat     !: ??? 
     50 
     51   !!* Variable for chemistry of the CO2 cycle 
     52 
    3753   REAL(wp), PUBLIC ::   atcox  = 0.20946         ! units atm 
    3854 
    39    REAL(wp) ::   salchl = 1. / 1.80655    ! conversion factor for salinity --> chlorinity (Wooster et al. 1969) 
    4055   REAL(wp) ::   o2atm  = 1. / ( 1000. * 0.20946 )   
    4156 
    42    REAL(wp) ::   rgas   = 83.14472       ! universal gas constants 
    43    REAL(wp) ::   oxyco  = 1. / 22.4144   ! converts from liters of an ideal gas to moles 
    44  
    45    REAL(wp) ::   bor1   = 0.00023        ! borat constants 
    46    REAL(wp) ::   bor2   = 1. / 10.82 
    47  
    48    REAL(wp) ::   st1    =      0.14     ! constants for calculate concentrations for sulfate 
    49    REAL(wp) ::   st2    =  1./96.062    !  (Morris & Riley 1966) 
    50  
    51    REAL(wp) ::   ft1    =    0.000067   ! constants for calculate concentrations for fluorides 
    52    REAL(wp) ::   ft2    = 1./18.9984    ! (Dickson & Riley 1979 ) 
    53  
    54    !                                    ! volumetric solubility constants for o2 in ml/L   
    55    REAL(wp) ::   ox0    =  2.00856      ! from Table 1 for Eq 8 of Garcia and Gordon, 1992. 
    56    REAL(wp) ::   ox1    =  3.22400      ! corrects for moisture and fugacity, but not total atmospheric pressure 
    57    REAL(wp) ::   ox2    =  3.99063      !      Original PISCES code noted this was a solubility, but  
    58    REAL(wp) ::   ox3    =  4.80299      ! was in fact a bunsen coefficient with units L-O2/(Lsw atm-O2) 
    59    REAL(wp) ::   ox4    =  9.78188e-1   ! Hence, need to divide EXP( zoxy ) by 1000, ml-O2 => L-O2 
    60    REAL(wp) ::   ox5    =  1.71069      ! and atcox = 0.20946 to add the 1/atm dimension. 
    61    REAL(wp) ::   ox6    = -6.24097e-3    
    62    REAL(wp) ::   ox7    = -6.93498e-3  
    63    REAL(wp) ::   ox8    = -6.90358e-3 
    64    REAL(wp) ::   ox9    = -4.29155e-3  
    65    REAL(wp) ::   ox10   = -3.11680e-7  
    66  
     57   REAL(wp) ::   rgas   = 83.14472      ! universal gas constants 
     58   REAL(wp) ::   oxyco  = 1. / 22.4144  ! converts from liters of an ideal gas to moles 
    6759   !                                    ! coeff. for seawater pressure correction : millero 95 
    6860   !                                    ! AGRIF doesn't like the DATA instruction 
    69    REAL(wp) :: devk11  = -25.5 
    70    REAL(wp) :: devk12  = -15.82 
    71    REAL(wp) :: devk13  = -29.48 
    72    REAL(wp) :: devk14  = -25.60 
    73    REAL(wp) :: devk15  = -48.76 
     61   REAL(wp) :: devk10  = -25.5 
     62   REAL(wp) :: devk11  = -15.82 
     63   REAL(wp) :: devk12  = -29.48 
     64   REAL(wp) :: devk13  = -20.02 
     65   REAL(wp) :: devk14  = -18.03 
     66   REAL(wp) :: devk15  = -9.78 
     67   REAL(wp) :: devk16  = -48.76 
     68   REAL(wp) :: devk17  = -14.51 
     69   REAL(wp) :: devk18  = -23.12 
     70   REAL(wp) :: devk19  = -26.57 
     71   REAL(wp) :: devk110  = -29.48 
    7472   ! 
    75    REAL(wp) :: devk21  = 0.1271 
    76    REAL(wp) :: devk22  = -0.0219 
    77    REAL(wp) :: devk23  = 0.1622 
    78    REAL(wp) :: devk24  = 0.2324 
    79    REAL(wp) :: devk25  = 0.5304 
     73   REAL(wp) :: devk20  = 0.1271 
     74   REAL(wp) :: devk21  = -0.0219 
     75   REAL(wp) :: devk22  = 0.1622 
     76   REAL(wp) :: devk23  = 0.1119 
     77   REAL(wp) :: devk24  = 0.0466 
     78   REAL(wp) :: devk25  = -0.0090 
     79   REAL(wp) :: devk26  = 0.5304 
     80   REAL(wp) :: devk27  = 0.1211 
     81   REAL(wp) :: devk28  = 0.1758 
     82   REAL(wp) :: devk29  = 0.2020 
     83   REAL(wp) :: devk210  = 0.1622 
    8084   ! 
     85   REAL(wp) :: devk30  = 0. 
    8186   REAL(wp) :: devk31  = 0. 
    82    REAL(wp) :: devk32  = 0. 
    83    REAL(wp) :: devk33  = 2.608E-3 
    84    REAL(wp) :: devk34  = -3.6246E-3 
    85    REAL(wp) :: devk35  = 0. 
     87   REAL(wp) :: devk32  = 2.608E-3 
     88   REAL(wp) :: devk33  = -1.409e-3 
     89   REAL(wp) :: devk34  = 0.316e-3 
     90   REAL(wp) :: devk35  = -0.942e-3 
     91   REAL(wp) :: devk36  = 0. 
     92   REAL(wp) :: devk37  = -0.321e-3 
     93   REAL(wp) :: devk38  = -2.647e-3 
     94   REAL(wp) :: devk39  = -3.042e-3 
     95   REAL(wp) :: devk310  = -2.6080e-3 
    8696   ! 
    87    REAL(wp) :: devk41  = -3.08E-3 
    88    REAL(wp) :: devk42  = 1.13E-3 
    89    REAL(wp) :: devk43  = -2.84E-3 
    90    REAL(wp) :: devk44  = -5.13E-3 
    91    REAL(wp) :: devk45  = -11.76E-3 
     97   REAL(wp) :: devk40  = -3.08E-3 
     98   REAL(wp) :: devk41  = 1.13E-3 
     99   REAL(wp) :: devk42  = -2.84E-3 
     100   REAL(wp) :: devk43  = -5.13E-3 
     101   REAL(wp) :: devk44  = -4.53e-3 
     102   REAL(wp) :: devk45  = -3.91e-3 
     103   REAL(wp) :: devk46  = -11.76e-3 
     104   REAL(wp) :: devk47  = -2.67e-3 
     105   REAL(wp) :: devk48  = -5.15e-3 
     106   REAL(wp) :: devk49  = -4.08e-3 
     107   REAL(wp) :: devk410  = -2.84e-3 
    92108   ! 
    93    REAL(wp) :: devk51  = 0.0877E-3 
    94    REAL(wp) :: devk52  = -0.1475E-3      
    95    REAL(wp) :: devk53  = 0. 
    96    REAL(wp) :: devk54  = 0.0794E-3       
    97    REAL(wp) :: devk55  = 0.3692E-3       
     109   REAL(wp) :: devk50  = 0.0877E-3 
     110   REAL(wp) :: devk51  = -0.1475E-3      
     111   REAL(wp) :: devk52  = 0. 
     112   REAL(wp) :: devk53  = 0.0794E-3       
     113   REAL(wp) :: devk54  = 0.09e-3 
     114   REAL(wp) :: devk55  = 0.054e-3 
     115   REAL(wp) :: devk56  = 0.3692E-3 
     116   REAL(wp) :: devk57  = 0.0427e-3 
     117   REAL(wp) :: devk58  = 0.09e-3 
     118   REAL(wp) :: devk59  = 0.0714e-3 
     119   REAL(wp) :: devk510  = 0.0 
     120   ! 
     121   ! General parameters 
     122   REAL(wp), PARAMETER :: pp_rdel_ah_target = 1.E-4_wp 
     123   REAL(wp), PARAMETER :: pp_ln10 = 2.302585092994045684018_wp 
     124 
     125   ! Maximum number of iterations for each method 
     126   INTEGER, PARAMETER :: jp_maxniter_atgen    = 20 
     127 
     128   ! Bookkeeping variables for each method 
     129   ! - SOLVE_AT_GENERAL 
     130   INTEGER :: niter_atgen    = jp_maxniter_atgen 
    98131 
    99132   !!---------------------------------------------------------------------- 
    … …  
    113146      !!--------------------------------------------------------------------- 
    114147      INTEGER  ::   ji, jj, jk 
    115       REAL(wp) ::   ztkel, zt   , zt2  , zsal  , zsal2 , zbuf1 , zbuf2 
     148      REAL(wp) ::   ztkel, ztkel1, zt , zsal  , zsal2 , zbuf1 , zbuf2 
    116149      REAL(wp) ::   ztgg , ztgg2, ztgg3 , ztgg4 , ztgg5 
    117150      REAL(wp) ::   zpres, ztc  , zcl   , zcpexp, zoxy  , zcpexp2 
    118151      REAL(wp) ::   zsqrt, ztr  , zlogt , zcek1, zc1, zplat 
    119       REAL(wp) ::   zis  , zis2 , zsal15, zisqrt, za1  , za2 
     152      REAL(wp) ::   zis  , zis2 , zsal15, zisqrt, za1, za2 
    120153      REAL(wp) ::   zckb , zck1 , zck2  , zckw  , zak1 , zak2  , zakb , zaksp0, zakw 
     154      REAL(wp) ::   zck1p, zck2p, zck3p, zcksi, zak1p, zak2p, zak3p, zaksi 
    121155      REAL(wp) ::   zst  , zft  , zcks  , zckf  , zaksp1 
     156      REAL(wp) ::   total2free, free2SWS, total2SWS, SWS2total 
     157 
    122158      !!--------------------------------------------------------------------- 
    123159      ! 
    124160      IF( nn_timing == 1 )  CALL timing_start('p4z_che') 
     161      ! 
     162      ! Computation of chemical constants require practical salinity 
     163      ! Thus, when TEOS08 is used, absolute salinity is converted to  
     164      ! practical salinity 
     165      ! ------------------------------------------------------------- 
     166      IF (neos == -1) THEN 
     167         salinprac(:,:,:) = tsn(:,:,:,jp_sal) * 35.0 / 35.16504 
     168      ELSE 
     169         salinprac(:,:,:) = tsn(:,:,:,jp_sal) 
     170      ENDIF 
     171 
    125172      ! 
    126173      ! Computations of chemical constants require in situ temperature 
    … …  
    133180            DO ji = 1, jpi 
    134181               zpres = gdept_n(ji,jj,jk) / 1000. 
    135                za1 = 0.04 * ( 1.0 + 0.185 * tsn(ji,jj,jk,jp_tem) + 0.035 * (tsn(ji,jj,jk,jp_sal) - 35.0) ) 
     182               za1 = 0.04 * ( 1.0 + 0.185 * tsn(ji,jj,jk,jp_tem) + 0.035 * (salinprac(ji,jj,jk) - 35.0) ) 
    136183               za2 = 0.0075 * ( 1.0 - tsn(ji,jj,jk,jp_tem) / 30.0 ) 
    137184               tempis(ji,jj,jk) = tsn(ji,jj,jk,jp_tem) - za1 * zpres + za2 * zpres**2 
    … …  
    142189      ! CHEMICAL CONSTANTS - SURFACE LAYER 
    143190      ! ---------------------------------- 
     191!CDIR NOVERRCHK 
    144192      DO jj = 1, jpj 
     193!CDIR NOVERRCHK 
    145194         DO ji = 1, jpi 
    146195            !                             ! SET ABSOLUTE TEMPERATURE 
    147196            ztkel = tempis(ji,jj,1) + 273.15 
    148197            zt    = ztkel * 0.01 
    149             zt2   = zt * zt 
    150             zsal  = tsn(ji,jj,1,jp_sal) + ( 1.- tmask(ji,jj,1) ) * 35. 
    151             zsal2 = zsal * zsal 
    152             zlogt = LOG( zt ) 
     198            zsal  = salinprac(ji,jj,1) + ( 1.- tmask(ji,jj,1) ) * 35. 
    153199            !                             ! LN(K0) OF SOLUBILITY OF CO2 (EQ. 12, WEISS, 1980) 
    154200            !                             !     AND FOR THE ATMOSPHERE FOR NON IDEAL GAS 
    155201            zcek1 = 9345.17/ztkel - 60.2409 + 23.3585 * LOG(zt) + zsal*(0.023517 - 0.00023656*ztkel    & 
    156202            &       + 0.0047036e-4*ztkel**2) 
    157             !                             ! SET SOLUBILITIES OF O2 AND CO2  
    158             chemc(ji,jj,1) = EXP( zcek1 ) * 1.e-6 * rhop(ji,jj,1) / 1000. ! mol/(kg uatm) 
     203            chemc(ji,jj,1) = EXP( zcek1 ) * 1E-6 * rhop(ji,jj,1) / 1000. ! mol/(L atm) 
    159204            chemc(ji,jj,2) = -1636.75 + 12.0408*ztkel - 0.0327957*ztkel**2 + 0.0000316528*ztkel**3 
    160205            chemc(ji,jj,3) = 57.7 - 0.118*ztkel 
    … …  
    165210      ! OXYGEN SOLUBILITY - DEEP OCEAN 
    166211      ! ------------------------------- 
     212!CDIR NOVERRCHK 
    167213      DO jk = 1, jpk 
     214!CDIR NOVERRCHK 
    168215         DO jj = 1, jpj 
     216!CDIR NOVERRCHK 
    169217            DO ji = 1, jpi 
    170218              ztkel = tempis(ji,jj,jk) + 273.15 
    171               zsal  = tsn(ji,jj,jk,jp_sal) + ( 1.- tmask(ji,jj,jk) ) * 35. 
     219              zsal  = salinprac(ji,jj,jk) + ( 1.- tmask(ji,jj,jk) ) * 35. 
    172220              zsal2 = zsal * zsal 
    173221              ztgg  = LOG( ( 298.15 - tempis(ji,jj,jk) ) / ztkel )  ! Set the GORDON & GARCIA scaled temperature 
    … …  
    176224              ztgg4 = ztgg3 * ztgg 
    177225              ztgg5 = ztgg4 * ztgg 
    178               zoxy  = ox0 + ox1 * ztgg + ox2 * ztgg2 + ox3 * ztgg3 + ox4 * ztgg4 + ox5 * ztgg5   & 
    179                      + zsal * ( ox6 + ox7 * ztgg + ox8 * ztgg2 + ox9 * ztgg3 ) +  ox10 * zsal2 
     226 
     227              zoxy  = 2.00856 + 3.22400 * ztgg + 3.99063 * ztgg2 + 4.80299 * ztgg3    & 
     228              &       + 9.78188e-1 * ztgg4 + 1.71069 * ztgg5 + zsal * ( -6.24097e-3   & 
     229              &       - 6.93498e-3 * ztgg - 6.90358e-3 * ztgg2 - 4.29155e-3 * ztgg3 )   & 
     230              &       - 3.11680e-7 * zsal2 
    180231              chemo2(ji,jj,jk) = ( EXP( zoxy ) * o2atm ) * oxyco * atcox     ! mol/(L atm) 
    181232            END DO 
    … …  
    187238      ! CHEMICAL CONSTANTS - DEEP OCEAN 
    188239      ! ------------------------------- 
     240!CDIR NOVERRCHK 
    189241      DO jk = 1, jpk 
     242!CDIR NOVERRCHK 
    190243         DO jj = 1, jpj 
     244!CDIR NOVERRCHK 
    191245            DO ji = 1, jpi 
    192246 
    … …  
    199253               ! SET ABSOLUTE TEMPERATURE 
    200254               ztkel   = tempis(ji,jj,jk) + 273.15 
    201                zsal    = tsn(ji,jj,jk,jp_sal) + ( 1.-tmask(ji,jj,jk) ) * 35. 
     255               zsal    = salinprac(ji,jj,jk) + ( 1.-tmask(ji,jj,jk) ) * 35. 
    202256               zsqrt  = SQRT( zsal ) 
    203257               zsal15  = zsqrt * zsal 
    … …  
    210264 
    211265               ! CHLORINITY (WOOSTER ET AL., 1969) 
    212                zcl     = zsal * salchl 
     266               zcl     = zsal / 1.80655 
    213267 
    214268               ! TOTAL SULFATE CONCENTR. [MOLES/kg soln] 
    215                zst     = st1 * zcl * st2 
     269               zst     = 0.14 * zcl /96.062 
    216270 
    217271               ! TOTAL FLUORIDE CONCENTR. [MOLES/kg soln] 
    218                zft     = ft1 * zcl * ft2 
     272               zft     = 0.000067 * zcl /18.9984 
    219273 
    220274               ! DISSOCIATION CONSTANT FOR SULFATES on free H scale (Dickson 1990) 
    … …  
    224278               &         - 2698. * ztr * zis**1.5 + 1776.* ztr * zis2         & 
    225279               &         + LOG(1.0 - 0.001005 * zsal)) 
    226                ! 
    227                aphscale(ji,jj,jk) = ( 1. + zst / zcks ) 
    228280 
    229281               ! DISSOCIATION CONSTANT FOR FLUORIDES on free H scale (Dickson and Riley 79) 
    … …  
    239291               &      * zlogt + 0.053105*zsqrt*ztkel 
    240292 
    241  
    242293               ! DISSOCIATION COEFFICIENT FOR CARBONATE ACCORDING TO  
    243294               ! MEHRBACH (1973) REFIT BY MILLERO (1995), seawater scale 
    … …  
    247298                  - 0.01781*zsal + 0.0001122*zsal*zsal) 
    248299 
    249                ! PKW (H2O) (DICKSON AND RILEY, 1979) 
    250                zckw = -13847.26*ztr + 148.9652 - 23.6521 * zlogt    &  
    251                &     + (118.67*ztr - 5.977 + 1.0495 * zlogt)        & 
    252                &     * zsqrt - 0.01615 * zsal 
     300               ! PKW (H2O) (MILLERO, 1995) from composite data 
     301               zckw    = -13847.26 * ztr + 148.9652 - 23.6521 * zlogt + ( 118.67 * ztr    & 
     302                         - 5.977 + 1.0495 * zlogt ) * zsqrt - 0.01615 * zsal 
     303 
     304               ! CONSTANTS FOR PHOSPHATE (MILLERO, 1995) 
     305              zck1p    = -4576.752*ztr + 115.540 - 18.453*zlogt   & 
     306              &          + (-106.736*ztr + 0.69171) * zsqrt       & 
     307              &          + (-0.65643*ztr - 0.01844) * zsal 
     308 
     309              zck2p    = -8814.715*ztr + 172.1033 - 27.927*zlogt  & 
     310              &          + (-160.340*ztr + 1.3566)*zsqrt          & 
     311              &          + (0.37335*ztr - 0.05778)*zsal 
     312 
     313              zck3p    = -3070.75*ztr - 18.126                    & 
     314              &          + (17.27039*ztr + 2.81197) * zsqrt       & 
     315              &          + (-44.99486*ztr - 0.09984) * zsal  
     316 
     317              ! CONSTANT FOR SILICATE, MILLERO (1995) 
     318              zcksi    = -8904.2*ztr  + 117.400 - 19.334*zlogt   & 
     319              &          + (-458.79*ztr + 3.5913) * zisqrt       & 
     320              &          + (188.74*ztr - 1.5998) * zis           & 
     321              &          + (-12.1652*ztr + 0.07871) * zis2       & 
     322              &          + LOG(1.0 - 0.001005*zsal) 
    253323 
    254324               ! APPARENT SOLUBILITY PRODUCT K'SP OF CALCITE IN SEAWATER 
    … …  
    258328                  &      - 0.07711*zsal + 0.0041249*zsal15 
    259329 
     330               ! CONVERT FROM DIFFERENT PH SCALES 
     331               total2free  = 1.0/(1.0 + zst/zcks) 
     332               free2SWS    = 1. + zst/zcks + zft/(zckf*total2free) 
     333               total2SWS   = total2free * free2SWS 
     334               SWS2total   = 1.0 / total2SWS 
     335 
    260336               ! K1, K2 OF CARBONIC ACID, KB OF BORIC ACID, KW (H2O) (LIT.?) 
    261                zak1    = 10**(zck1) 
    262                zak2    = 10**(zck2) 
    263                zakb    = EXP( zckb  ) 
     337               zak1    = 10**(zck1) * total2SWS 
     338               zak2    = 10**(zck2) * total2SWS 
     339               zakb    = EXP( zckb ) * total2SWS 
    264340               zakw    = EXP( zckw ) 
    265341               zaksp1  = 10**(zaksp0) 
     342               zak1p   = exp( zck1p ) 
     343               zak2p   = exp( zck2p ) 
     344               zak3p   = exp( zck3p ) 
     345               zaksi   = exp( zcksi ) 
     346               zckf    = zckf * total2SWS 
    266347 
    267348               ! FORMULA FOR CPEXP AFTER EDMOND & GIESKES (1970) 
    … …  
    275356               !        FORMULA ON P. 1286 IS RIGHT AND CONSISTENT WITH THE 
    276357               !        SIGN IN PARTIAL MOLAR VOLUME CHANGE AS SHOWN ON P. 1285)) 
    277                zcpexp  = zpres /(rgas*ztkel) 
    278                zcpexp2 = zpres * zpres/(rgas*ztkel) 
     358               zcpexp  = zpres / (rgas*ztkel) 
     359               zcpexp2 = zpres * zcpexp 
    279360 
    280361               ! KB OF BORIC ACID, K1,K2 OF CARBONIC ACID PRESSURE 
    … …  
    282363               !        (CF. BROECKER ET AL., 1982) 
    283364 
    284                zbuf1  = -     ( devk11 + devk21 * ztc + devk31 * ztc * ztc ) 
     365               zbuf1  = -     ( devk10 + devk20 * ztc + devk30 * ztc * ztc ) 
     366               zbuf2  = 0.5 * ( devk40 + devk50 * ztc ) 
     367               ak13(ji,jj,jk) = zak1 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
     368 
     369               zbuf1  =     - ( devk11 + devk21 * ztc + devk31 * ztc * ztc ) 
    285370               zbuf2  = 0.5 * ( devk41 + devk51 * ztc ) 
    286                ak13(ji,jj,jk) = zak1 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
     371               ak23(ji,jj,jk) = zak2 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
    287372 
    288373               zbuf1  =     - ( devk12 + devk22 * ztc + devk32 * ztc * ztc ) 
    289374               zbuf2  = 0.5 * ( devk42 + devk52 * ztc ) 
    290                ak23(ji,jj,jk) = zak2 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
     375               akb3(ji,jj,jk) = zakb * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
    291376 
    292377               zbuf1  =     - ( devk13 + devk23 * ztc + devk33 * ztc * ztc ) 
    293378               zbuf2  = 0.5 * ( devk43 + devk53 * ztc ) 
    294                akb3(ji,jj,jk) = zakb * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
     379               akw3(ji,jj,jk) = zakw * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
    295380 
    296381               zbuf1  =     - ( devk14 + devk24 * ztc + devk34 * ztc * ztc ) 
    297382               zbuf2  = 0.5 * ( devk44 + devk54 * ztc ) 
    298                akw3(ji,jj,jk) = zakw * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
    299  
     383               aks3(ji,jj,jk) = zcks * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
     384 
     385               zbuf1  =     - ( devk15 + devk25 * ztc + devk35 * ztc * ztc ) 
     386               zbuf2  = 0.5 * ( devk45 + devk55 * ztc ) 
     387               akf3(ji,jj,jk) = zckf * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
     388 
     389               zbuf1  =     - ( devk17 + devk27 * ztc + devk37 * ztc * ztc ) 
     390               zbuf2  = 0.5 * ( devk47 + devk57 * ztc ) 
     391               ak1p3(ji,jj,jk) = zak1p * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
     392 
     393               zbuf1  =     - ( devk18 + devk28 * ztc + devk38 * ztc * ztc ) 
     394               zbuf2  = 0.5 * ( devk48 + devk58 * ztc ) 
     395               ak2p3(ji,jj,jk) = zak2p * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
     396 
     397               zbuf1  =     - ( devk19 + devk29 * ztc + devk39 * ztc * ztc ) 
     398               zbuf2  = 0.5 * ( devk49 + devk59 * ztc ) 
     399               ak3p3(ji,jj,jk) = zak3p * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
     400 
     401               zbuf1  =     - ( devk110 + devk210 * ztc + devk310 * ztc * ztc ) 
     402               zbuf2  = 0.5 * ( devk410 + devk510 * ztc ) 
     403               aksi3(ji,jj,jk) = zaksi * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
     404 
     405               ! CONVERT FROM DIFFERENT PH SCALES 
     406               total2free  = 1.0/(1.0 + zst/aks3(ji,jj,jk)) 
     407               free2SWS    = 1. + zst/aks3(ji,jj,jk) + zft/akf3(ji,jj,jk) 
     408               total2SWS   = total2free * free2SWS 
     409               SWS2total   = 1.0 / total2SWS 
     410 
     411               ! Convert to total scale 
     412               ak13(ji,jj,jk)  = ak13(ji,jj,jk)  * SWS2total 
     413               ak23(ji,jj,jk)  = ak23(ji,jj,jk)  * SWS2total 
     414               akb3(ji,jj,jk)  = akb3(ji,jj,jk)  * SWS2total 
     415               akw3(ji,jj,jk)  = akw3(ji,jj,jk)  * SWS2total 
     416               ak1p3(ji,jj,jk) = ak1p3(ji,jj,jk) * SWS2total 
     417               ak2p3(ji,jj,jk) = ak2p3(ji,jj,jk) * SWS2total 
     418               ak3p3(ji,jj,jk) = ak3p3(ji,jj,jk) * SWS2total 
     419               aksi3(ji,jj,jk) = aksi3(ji,jj,jk) * SWS2total 
     420               akf3(ji,jj,jk)  = akf3(ji,jj,jk)  / total2free 
    300421 
    301422               ! APPARENT SOLUBILITY PRODUCT K'SP OF CALCITE  
    302423               !        AS FUNCTION OF PRESSURE FOLLOWING MILLERO 
    303424               !        (P. 1285) AND BERNER (1976) 
    304                zbuf1  =     - ( devk15 + devk25 * ztc + devk35 * ztc * ztc ) 
    305                zbuf2  = 0.5 * ( devk45 + devk55 * ztc ) 
     425               zbuf1  =     - ( devk16 + devk26 * ztc + devk36 * ztc * ztc ) 
     426               zbuf2  = 0.5 * ( devk46 + devk56 * ztc ) 
    306427               aksp(ji,jj,jk) = zaksp1 * EXP( zbuf1 * zcpexp + zbuf2 * zcpexp2 ) 
    307428 
    308                ! TOTAL BORATE CONCENTR. [MOLES/L] 
    309                borat(ji,jj,jk) = bor1 * zcl * bor2 
     429               ! TOTAL F, S, and BORATE CONCENTR. [MOLES/L] 
     430               borat(ji,jj,jk) = 0.0002414 * zcl / 10.811 
     431               sulfat(ji,jj,jk) = zst 
     432               fluorid(ji,jj,jk) = zft  
    310433 
    311434               ! Iron and SIO3 saturation concentration from ... 
    312435               sio3eq(ji,jj,jk) = EXP(  LOG( 10.) * ( 6.44 - 968. / ztkel )  ) * 1.e-6 
    313                fekeq (ji,jj,jk) = 10**( 17.27 - 1565.7 / ( 273.15 + ztc ) ) 
    314  
     436               fekeq (ji,jj,jk) = 10**( 17.27 - 1565.7 / ztkel ) 
     437 
     438               ! Liu and Millero (1999) only valid 5 - 50 degC 
     439               ztkel1 = MAX( 5. , tempis(ji,jj,jk) ) + 273.16 
     440               fesol(ji,jj,jk,1) = 10**(-13.486 - 0.1856* zis**0.5 + 0.3073*zis + 5254.0/ztkel1) 
     441               fesol(ji,jj,jk,2) = 10**(2.517 - 0.8885*zis**0.5 + 0.2139 * zis - 1320.0/ztkel1 ) 
     442               fesol(ji,jj,jk,3) = 10**(0.4511 - 0.3305*zis**0.5 - 1996.0/ztkel1 ) 
     443               fesol(ji,jj,jk,4) = 10**(-0.2965 - 0.7881*zis**0.5 - 4086.0/ztkel1 ) 
     444               fesol(ji,jj,jk,5) = 10**(4.4466 - 0.8505*zis**0.5 - 7980.0/ztkel1 ) 
    315445            END DO 
    316446         END DO 
    … …  
    321451   END SUBROUTINE p4z_che 
    322452 
     453   SUBROUTINE ahini_for_at(p_hini) 
     454      !!--------------------------------------------------------------------- 
     455      !!                     ***  ROUTINE ahini_for_at  *** 
     456      !! 
     457      !! Subroutine returns the root for the 2nd order approximation of the 
     458      !! DIC -- B_T -- A_CB equation for [H+] (reformulated as a cubic  
     459      !! polynomial) around the local minimum, if it exists. 
     460      !! Returns * 1E-03_wp if p_alkcb <= 0 
     461      !!         * 1E-10_wp if p_alkcb >= 2*p_dictot + p_bortot 
     462      !!         * 1E-07_wp if 0 < p_alkcb < 2*p_dictot + p_bortot 
     463      !!                    and the 2nd order approximation does not have  
     464      !!                    a solution 
     465      !!--------------------------------------------------------------------- 
     466      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT)  ::  p_hini 
     467      INTEGER  ::   ji, jj, jk 
     468      REAL(wp)  ::  zca1, zba1 
     469      REAL(wp)  ::  zd, zsqrtd, zhmin 
     470      REAL(wp)  ::  za2, za1, za0 
     471      REAL(wp)  ::  p_dictot, p_bortot, p_alkcb  
     472 
     473      IF( nn_timing == 1 )  CALL timing_start('ahini_for_at') 
     474      ! 
     475      DO jk = 1, jpk 
     476        DO jj = 1, jpj 
     477          DO ji = 1, jpi 
     478            p_alkcb  = trb(ji,jj,jk,jptal) * 1000. / (rhop(ji,jj,jk) + rtrn) 
     479            p_dictot = trb(ji,jj,jk,jpdic) * 1000. / (rhop(ji,jj,jk) + rtrn) 
     480            p_bortot = borat(ji,jj,jk) 
     481            IF (p_alkcb <= 0.) THEN 
     482                p_hini(ji,jj,jk) = 1.e-3 
     483            ELSEIF (p_alkcb >= (2.*p_dictot + p_bortot)) THEN 
     484                p_hini(ji,jj,jk) = 1.e-10_wp 
     485            ELSE 
     486                zca1 = p_dictot/( p_alkcb + rtrn ) 
     487                zba1 = p_bortot/ (p_alkcb + rtrn ) 
     488           ! Coefficients of the cubic polynomial 
     489                za2 = aKb3(ji,jj,jk)*(1. - zba1) + ak13(ji,jj,jk)*(1.-zca1) 
     490                za1 = ak13(ji,jj,jk)*akb3(ji,jj,jk)*(1. - zba1 - zca1)    & 
     491                &     + ak13(ji,jj,jk)*ak23(ji,jj,jk)*(1. - (zca1+zca1)) 
     492                za0 = ak13(ji,jj,jk)*ak23(ji,jj,jk)*akb3(ji,jj,jk)*(1. - zba1 - (zca1+zca1)) 
     493                                        ! Taylor expansion around the minimum 
     494                zd = za2*za2 - 3.*za1   ! Discriminant of the quadratic equation 
     495                                        ! for the minimum close to the root 
     496 
     497                IF(zd > 0.) THEN        ! If the discriminant is positive 
     498                  zsqrtd = SQRT(zd) 
     499                  IF(za2 < 0) THEN 
     500                    zhmin = (-za2 + zsqrtd)/3. 
     501                  ELSE 
     502                    zhmin = -za1/(za2 + zsqrtd) 
     503                  ENDIF 
     504                  p_hini(ji,jj,jk) = zhmin + SQRT(-(za0 + zhmin*(za1 + zhmin*(za2 + zhmin)))/zsqrtd) 
     505                ELSE 
     506                  p_hini(ji,jj,jk) = 1.e-7 
     507                ENDIF 
     508             ! 
     509             ENDIF 
     510          END DO 
     511        END DO 
     512      END DO 
     513      ! 
     514      IF( nn_timing == 1 )  CALL timing_stop('ahini_for_at') 
     515      ! 
     516   END SUBROUTINE ahini_for_at 
     517 
     518   !=============================================================================== 
     519   SUBROUTINE anw_infsup( p_alknw_inf, p_alknw_sup ) 
     520 
     521   ! Subroutine returns the lower and upper bounds of "non-water-selfionization" 
     522   ! contributions to total alkalinity (the infimum and the supremum), i.e 
     523   ! inf(TA - [OH-] + [H+]) and sup(TA - [OH-] + [H+]) 
     524 
     525   ! Argument variables 
     526   REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_alknw_inf 
     527   REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT) :: p_alknw_sup 
     528 
     529   p_alknw_inf(:,:,:) =  -trb(:,:,:,jppo4) * 1000. / (rhop(:,:,:) + rtrn) - sulfat(:,:,:)  & 
     530   &              - fluorid(:,:,:) 
     531   p_alknw_sup(:,:,:) =   (2. * trb(:,:,:,jpdic) + 2. * trb(:,:,:,jppo4) + trb(:,:,:,jpsil) )    & 
     532   &               * 1000. / (rhop(:,:,:) + rtrn) + borat(:,:,:)  
     533 
     534   END SUBROUTINE anw_infsup 
     535 
     536 
     537   SUBROUTINE solve_at_general( p_hini, zhi ) 
     538 
     539   ! Universal pH solver that converges from any given initial value, 
     540   ! determines upper an lower bounds for the solution if required 
     541 
     542   ! Argument variables 
     543   !-------------------- 
     544   REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(IN)   :: p_hini 
     545   REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(OUT)  :: zhi 
     546 
     547   ! Local variables 
     548   !----------------- 
     549   INTEGER   ::  ji, jj, jk, jn 
     550   REAL(wp)  ::  zh_ini, zh, zh_prev, zh_lnfactor 
     551   REAL(wp)  ::  zdelta, zh_delta 
     552   REAL(wp)  ::  zeqn, zdeqndh, zalka 
     553   REAL(wp)  ::  aphscale 
     554   REAL(wp)  ::  znumer_dic, zdnumer_dic, zdenom_dic, zalk_dic, zdalk_dic 
     555   REAL(wp)  ::  znumer_bor, zdnumer_bor, zdenom_bor, zalk_bor, zdalk_bor 
     556   REAL(wp)  ::  znumer_po4, zdnumer_po4, zdenom_po4, zalk_po4, zdalk_po4 
     557   REAL(wp)  ::  znumer_sil, zdnumer_sil, zdenom_sil, zalk_sil, zdalk_sil 
     558   REAL(wp)  ::  znumer_so4, zdnumer_so4, zdenom_so4, zalk_so4, zdalk_so4 
     559   REAL(wp)  ::  znumer_flu, zdnumer_flu, zdenom_flu, zalk_flu, zdalk_flu 
     560   REAL(wp)  ::  zalk_wat, zdalk_wat 
     561   REAL(wp)  ::  zfact, p_alktot, zdic, zbot, zpt, zst, zft, zsit 
     562   LOGICAL   ::  l_exitnow 
     563   REAL(wp), PARAMETER :: pz_exp_threshold = 1.0 
     564   REAL(wp), POINTER, DIMENSION(:,:,:) :: zalknw_inf, zalknw_sup, rmask, zh_min, zh_max, zeqn_absmin 
     565 
     566   IF( nn_timing == 1 )  CALL timing_start('solve_at_general') 
     567      !  Allocate temporary workspace 
     568   CALL wrk_alloc( jpi, jpj, jpk, zalknw_inf, zalknw_sup, rmask ) 
     569   CALL wrk_alloc( jpi, jpj, jpk, zh_min, zh_max, zeqn_absmin ) 
     570 
     571   CALL anw_infsup( zalknw_inf, zalknw_sup ) 
     572 
     573   rmask(:,:,:) = tmask(:,:,:) 
     574   zhi(:,:,:)   = 0. 
     575 
     576   ! TOTAL H+ scale: conversion factor for Htot = aphscale * Hfree 
     577   DO jk = 1, jpk 
     578      DO jj = 1, jpj 
     579         DO ji = 1, jpi 
     580            IF (rmask(ji,jj,jk) == 1.) THEN 
     581               p_alktot = trb(ji,jj,jk,jptal) * 1000. / (rhop(ji,jj,jk) + rtrn) 
     582               aphscale = 1. + sulfat(ji,jj,jk)/aks3(ji,jj,jk) 
     583               zh_ini = p_hini(ji,jj,jk) 
     584 
     585               zdelta = (p_alktot-zalknw_inf(ji,jj,jk))**2 + 4.*akw3(ji,jj,jk)/aphscale 
     586 
     587               IF(p_alktot >= zalknw_inf(ji,jj,jk)) THEN 
     588                 zh_min(ji,jj,jk) = 2.*akw3(ji,jj,jk) /( p_alktot-zalknw_inf(ji,jj,jk) + SQRT(zdelta) ) 
     589               ELSE 
     590                 zh_min(ji,jj,jk) = aphscale*(-(p_alktot-zalknw_inf(ji,jj,jk)) + SQRT(zdelta) ) / 2. 
     591               ENDIF 
     592 
     593               zdelta = (p_alktot-zalknw_sup(ji,jj,jk))**2 + 4.*akw3(ji,jj,jk)/aphscale 
     594 
     595               IF(p_alktot <= zalknw_sup(ji,jj,jk)) THEN 
     596                 zh_max(ji,jj,jk) = aphscale*(-(p_alktot-zalknw_sup(ji,jj,jk)) + SQRT(zdelta) ) / 2. 
     597               ELSE 
     598                 zh_max(ji,jj,jk) = 2.*akw3(ji,jj,jk) /( p_alktot-zalknw_sup(ji,jj,jk) + SQRT(zdelta) ) 
     599               ENDIF 
     600 
     601               zhi(ji,jj,jk) = MAX(MIN(zh_max(ji,jj,jk), zh_ini), zh_min(ji,jj,jk)) 
     602            ENDIF 
     603         END DO 
     604      END DO 
     605   END DO 
     606 
     607   zeqn_absmin(:,:,:) = HUGE(1._wp) 
     608 
     609   DO jn = 1, jp_maxniter_atgen  
     610   DO jk = 1, jpk 
     611      DO jj = 1, jpj 
     612         DO ji = 1, jpi 
     613            IF (rmask(ji,jj,jk) == 1.) THEN 
     614               zfact = rhop(ji,jj,jk) / 1000. + rtrn 
     615               p_alktot = trb(ji,jj,jk,jptal) / zfact 
     616               zdic  = trb(ji,jj,jk,jpdic) / zfact 
     617               zbot  = borat(ji,jj,jk) 
     618               zpt = trb(ji,jj,jk,jppo4) / zfact * po4r 
     619               zsit = trb(ji,jj,jk,jpsil) / zfact 
     620               zst = sulfat (ji,jj,jk) 
     621               zft = fluorid(ji,jj,jk) 
     622               aphscale = 1. + sulfat(ji,jj,jk)/aks3(ji,jj,jk) 
     623               zh = zhi(ji,jj,jk) 
     624               zh_prev = zh 
     625 
     626               ! H2CO3 - HCO3 - CO3 : n=2, m=0 
     627               znumer_dic = 2.*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*ak13(ji,jj,jk) 
     628               zdenom_dic = ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*(ak13(ji,jj,jk) + zh) 
     629               zalk_dic   = zdic * (znumer_dic/zdenom_dic) 
     630               zdnumer_dic = ak13(ji,jj,jk)*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh     & 
     631                             *(4.*ak13(ji,jj,jk)*ak23(ji,jj,jk) + zh*ak13(ji,jj,jk)) 
     632               zdalk_dic   = -zdic*(zdnumer_dic/zdenom_dic**2) 
     633 
     634 
     635               ! B(OH)3 - B(OH)4 : n=1, m=0 
     636               znumer_bor = akb3(ji,jj,jk) 
     637               zdenom_bor = akb3(ji,jj,jk) + zh 
     638               zalk_bor   = zbot * (znumer_bor/zdenom_bor) 
     639               zdnumer_bor = akb3(ji,jj,jk) 
     640               zdalk_bor   = -zbot*(zdnumer_bor/zdenom_bor**2) 
     641 
     642 
     643               ! H3PO4 - H2PO4 - HPO4 - PO4 : n=3, m=1 
     644               znumer_po4 = 3.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)  & 
     645               &            + zh*(2.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh* ak1p3(ji,jj,jk)) 
     646               zdenom_po4 = ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)     & 
     647               &            + zh*( ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh*(ak1p3(ji,jj,jk) + zh)) 
     648               zalk_po4   = zpt * (znumer_po4/zdenom_po4 - 1.) ! Zero level of H3PO4 = 1 
     649               zdnumer_po4 = ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)  & 
     650               &             + zh*(4.*ak1p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)         & 
     651               &             + zh*(9.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)*ak3p3(ji,jj,jk)                         & 
     652               &             + ak1p3(ji,jj,jk)*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk)                                & 
     653               &             + zh*(4.*ak1p3(ji,jj,jk)*ak2p3(ji,jj,jk) + zh * ak1p3(ji,jj,jk) ) ) ) 
     654               zdalk_po4   = -zpt * (zdnumer_po4/zdenom_po4**2) 
     655 
     656               ! H4SiO4 - H3SiO4 : n=1, m=0 
     657               znumer_sil = aksi3(ji,jj,jk) 
     658               zdenom_sil = aksi3(ji,jj,jk) + zh 
     659               zalk_sil   = zsit * (znumer_sil/zdenom_sil) 
     660               zdnumer_sil = aksi3(ji,jj,jk) 
     661               zdalk_sil   = -zsit * (zdnumer_sil/zdenom_sil**2) 
     662 
     663               ! HSO4 - SO4 : n=1, m=1 
     664               aphscale = 1.0 + zst/aks3(ji,jj,jk) 
     665               znumer_so4 = aks3(ji,jj,jk) * aphscale 
     666               zdenom_so4 = aks3(ji,jj,jk) * aphscale + zh 
     667               zalk_so4   = zst * (znumer_so4/zdenom_so4 - 1.) 
     668               zdnumer_so4 = aks3(ji,jj,jk) 
     669               zdalk_so4   = -zst * (zdnumer_so4/zdenom_so4**2) 
     670 
     671               ! HF - F : n=1, m=1 
     672               znumer_flu =  akf3(ji,jj,jk) 
     673               zdenom_flu =  akf3(ji,jj,jk) + zh 
     674               zalk_flu   =  zft * (znumer_flu/zdenom_flu - 1.) 
     675               zdnumer_flu = akf3(ji,jj,jk) 
     676               zdalk_flu   = -zft * (zdnumer_flu/zdenom_flu**2) 
     677 
     678               ! H2O - OH 
     679               aphscale = 1.0 + zst/aks3(ji,jj,jk) 
     680               zalk_wat   = akw3(ji,jj,jk)/zh - zh/aphscale 
     681               zdalk_wat  = -akw3(ji,jj,jk)/zh**2 - 1./aphscale 
     682 
     683               ! CALCULATE [ALK]([CO3--], [HCO3-]) 
     684               zeqn = zalk_dic + zalk_bor + zalk_po4 + zalk_sil   & 
     685               &      + zalk_so4 + zalk_flu                       & 
     686               &      + zalk_wat - p_alktot 
     687 
     688               zalka = p_alktot - (zalk_bor + zalk_po4 + zalk_sil   & 
     689               &       + zalk_so4 + zalk_flu + zalk_wat) 
     690 
     691               zdeqndh = zdalk_dic + zdalk_bor + zdalk_po4 + zdalk_sil & 
     692               &         + zdalk_so4 + zdalk_flu + zdalk_wat 
     693 
     694               ! Adapt bracketing interval 
     695               IF(zeqn > 0._wp) THEN 
     696                 zh_min(ji,jj,jk) = zh_prev 
     697               ELSEIF(zeqn < 0._wp) THEN 
     698                 zh_max(ji,jj,jk) = zh_prev 
     699               ENDIF 
     700 
     701               IF(ABS(zeqn) >= 0.5_wp*zeqn_absmin(ji,jj,jk)) THEN 
     702               ! if the function evaluation at the current point is 
     703               ! not decreasing faster than with a bisection step (at least linearly) 
     704               ! in absolute value take one bisection step on [ph_min, ph_max] 
     705               ! ph_new = (ph_min + ph_max)/2d0 
     706               ! 
     707               ! In terms of [H]_new: 
     708               ! [H]_new = 10**(-ph_new) 
     709               !         = 10**(-(ph_min + ph_max)/2d0) 
     710               !         = SQRT(10**(-(ph_min + phmax))) 
     711               !         = SQRT(zh_max * zh_min) 
     712                  zh = SQRT(zh_max(ji,jj,jk) * zh_min(ji,jj,jk)) 
     713                  zh_lnfactor = (zh - zh_prev)/zh_prev ! Required to test convergence below 
     714               ELSE 
     715               ! dzeqn/dpH = dzeqn/d[H] * d[H]/dpH 
     716               !           = -zdeqndh * LOG(10) * [H] 
     717               ! \Delta pH = -zeqn/(zdeqndh*d[H]/dpH) = zeqn/(zdeqndh*[H]*LOG(10)) 
     718               ! 
     719               ! pH_new = pH_old + \deltapH 
     720               ! 
     721               ! [H]_new = 10**(-pH_new) 
     722               !         = 10**(-pH_old - \Delta pH) 
     723               !         = [H]_old * 10**(-zeqn/(zdeqndh*[H]_old*LOG(10))) 
     724               !         = [H]_old * EXP(-LOG(10)*zeqn/(zdeqndh*[H]_old*LOG(10))) 
     725               !         = [H]_old * EXP(-zeqn/(zdeqndh*[H]_old)) 
     726 
     727                  zh_lnfactor = -zeqn/(zdeqndh*zh_prev) 
     728 
     729                  IF(ABS(zh_lnfactor) > pz_exp_threshold) THEN 
     730                     zh          = zh_prev*EXP(zh_lnfactor) 
     731                  ELSE 
     732                     zh_delta    = zh_lnfactor*zh_prev 
     733                     zh          = zh_prev + zh_delta 
     734                  ENDIF 
     735 
     736                  IF( zh < zh_min(ji,jj,jk) ) THEN 
     737                     ! if [H]_new < [H]_min 
     738                     ! i.e., if ph_new > ph_max then 
     739                     ! take one bisection step on [ph_prev, ph_max] 
     740                     ! ph_new = (ph_prev + ph_max)/2d0 
     741                     ! In terms of [H]_new: 
     742                     ! [H]_new = 10**(-ph_new) 
     743                     !         = 10**(-(ph_prev + ph_max)/2d0) 
     744                     !         = SQRT(10**(-(ph_prev + phmax))) 
     745                     !         = SQRT([H]_old*10**(-ph_max)) 
     746                     !         = SQRT([H]_old * zh_min) 
     747                     zh                = SQRT(zh_prev * zh_min(ji,jj,jk)) 
     748                     zh_lnfactor       = (zh - zh_prev)/zh_prev ! Required to test convergence below 
     749                  ENDIF 
     750 
     751                  IF( zh > zh_max(ji,jj,jk) ) THEN 
     752                     ! if [H]_new > [H]_max 
     753                     ! i.e., if ph_new < ph_min, then 
     754                     ! take one bisection step on [ph_min, ph_prev] 
     755                     ! ph_new = (ph_prev + ph_min)/2d0 
     756                     ! In terms of [H]_new: 
     757                     ! [H]_new = 10**(-ph_new) 
     758                     !         = 10**(-(ph_prev + ph_min)/2d0) 
     759                     !         = SQRT(10**(-(ph_prev + ph_min))) 
     760                     !         = SQRT([H]_old*10**(-ph_min)) 
     761                     !         = SQRT([H]_old * zhmax) 
     762                     zh                = SQRT(zh_prev * zh_max(ji,jj,jk)) 
     763                     zh_lnfactor       = (zh - zh_prev)/zh_prev ! Required to test convergence below 
     764                  ENDIF 
     765               ENDIF 
     766 
     767               zeqn_absmin(ji,jj,jk) = MIN( ABS(zeqn), zeqn_absmin(ji,jj,jk)) 
     768 
     769               ! Stop iterations once |\delta{[H]}/[H]| < rdel 
     770               ! <=> |(zh - zh_prev)/zh_prev| = |EXP(-zeqn/(zdeqndh*zh_prev)) -1| < rdel 
     771               ! |EXP(-zeqn/(zdeqndh*zh_prev)) -1| ~ |zeqn/(zdeqndh*zh_prev)| 
     772 
     773               ! Alternatively: 
     774               ! |\Delta pH| = |zeqn/(zdeqndh*zh_prev*LOG(10))| 
     775               !             ~ 1/LOG(10) * |\Delta [H]|/[H] 
     776               !             < 1/LOG(10) * rdel 
     777 
     778               ! Hence |zeqn/(zdeqndh*zh)| < rdel 
     779 
     780               ! rdel <-- pp_rdel_ah_target 
     781               l_exitnow = (ABS(zh_lnfactor) < pp_rdel_ah_target) 
     782 
     783               IF(l_exitnow) THEN  
     784                  rmask(ji,jj,jk) = 0. 
     785               ENDIF 
     786 
     787               zhi(ji,jj,jk) =  zh 
     788 
     789               IF(jn >= jp_maxniter_atgen) THEN 
     790                  zhi(ji,jj,jk) = -1._wp 
     791               ENDIF 
     792 
     793            ENDIF 
     794         END DO 
     795      END DO 
     796   END DO 
     797   END DO 
     798   ! 
     799   CALL wrk_dealloc( jpi, jpj, jpk, zalknw_inf, zalknw_sup, rmask ) 
     800   CALL wrk_dealloc( jpi, jpj, jpk, zh_min, zh_max, zeqn_absmin ) 
     801 
     802 
     803   IF( nn_timing == 1 )  CALL timing_stop('solve_at_general') 
     804 
     805 
     806   END SUBROUTINE solve_at_general 
    323807 
    324808   INTEGER FUNCTION p4z_che_alloc() 
    … …  
    326810      !!                     ***  ROUTINE p4z_che_alloc  *** 
    327811      !!---------------------------------------------------------------------- 
    328       ALLOCATE( sio3eq(jpi,jpj,jpk), fekeq(jpi,jpj,jpk), chemc(jpi,jpj,3), chemo2(jpi,jpj,jpk),   & 
    329       &         tempis(jpi,jpj,jpk), STAT=p4z_che_alloc ) 
     812      INTEGER ::   ierr(3)        ! Local variables 
     813      !!---------------------------------------------------------------------- 
     814 
     815      ierr(:) = 0 
     816 
     817      ALLOCATE( sio3eq(jpi,jpj,jpk), fekeq(jpi,jpj,jpk), chemc(jpi,jpj,3), chemo2(jpi,jpj,jpk), STAT=ierr(1) ) 
     818 
     819      ALLOCATE( akb3(jpi,jpj,jpk)     , tempis(jpi, jpj, jpk),       & 
     820         &      akw3(jpi,jpj,jpk)     , borat (jpi,jpj,jpk)  ,       & 
     821         &      aks3(jpi,jpj,jpk)     , akf3(jpi,jpj,jpk)    ,       & 
     822         &      ak1p3(jpi,jpj,jpk)    , ak2p3(jpi,jpj,jpk)   ,       & 
     823         &      ak3p3(jpi,jpj,jpk)    , aksi3(jpi,jpj,jpk)   ,       & 
     824         &      fluorid(jpi,jpj,jpk)  , sulfat(jpi,jpj,jpk)  ,       & 
     825         &      salinprac(jpi,jpj,jpk),                 STAT=ierr(2) ) 
     826 
     827      ALLOCATE( fesol(jpi,jpj,jpk,5), STAT=ierr(3) ) 
     828 
     829      !* Variable for chemistry of the CO2 cycle 
     830      p4z_che_alloc = MAXVAL( ierr ) 
    330831      ! 
    331832      IF( p4z_che_alloc /= 0 )   CALL ctl_warn('p4z_che_alloc : failed to allocate arrays.') 
    … …  
    333834   END FUNCTION p4z_che_alloc 
    334835 
    335 #else 
    336836   !!====================================================================== 
    337    !!  Dummy module :                                   No PISCES bio-model 
    338    !!====================================================================== 
    339 CONTAINS 
    340    SUBROUTINE p4z_che( kt )                   ! Empty routine 
    341       INTEGER, INTENT(in) ::   kt 
    342       WRITE(*,*) 'p4z_che: You should not have seen this print! error?', kt 
    343    END SUBROUTINE p4z_che 
    344 #endif  
    345  
    346    !!====================================================================== 
    347 END MODULE p4zche 
     837END MODULE  p4zche 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zfechem.F90

    r6140 r7646  
    55   !!====================================================================== 
    66   !! History :   3.5  !  2012-07 (O. Aumont, A. Tagliabue, C. Ethe) Original code 
    7    !!---------------------------------------------------------------------- 
    8 #if defined key_pisces 
    9    !!---------------------------------------------------------------------- 
    10    !!   'key_top'       and                                      TOP models 
    11    !!   'key_pisces'                                       PISCES bio-model 
     7   !!             3.6  !  2015-05  (O. Aumont) PISCES quota 
    128   !!---------------------------------------------------------------------- 
    139   !!   p4z_fechem       :  Compute remineralization/scavenging of iron 
    … …  
    1814   USE trc             !  passive tracers common variables  
    1915   USE sms_pisces      !  PISCES Source Minus Sink variables 
    20    USE p4zopt          !  optical model 
    2116   USE p4zche          !  chemical model 
    2217   USE p4zsbc          !  Boundary conditions from sediments 
    … …  
    3025   PUBLIC   p4z_fechem_init ! called in trcsms_pisces.F90 
    3126 
    32    LOGICAL          ::   ln_fechem    !: boolean for complex iron chemistry following Tagliabue and voelker 
    33    LOGICAL          ::   ln_ligvar    !: boolean for variable ligand concentration following Tagliabue and voelker 
    34    REAL(wp), PUBLIC ::   xlam1        !: scavenging rate of Iron  
    35    REAL(wp), PUBLIC ::   xlamdust     !: scavenging rate of Iron by dust  
    36    REAL(wp), PUBLIC ::   ligand       !: ligand concentration in the ocean  
    37  
    38 !!gm Not DOCTOR norm !!! 
     27   !! * Shared module variables 
     28   LOGICAL          ::  ln_fechem    !: boolean for complex iron chemistry following Tagliabue and voelker 
     29   LOGICAL          ::  ln_ligvar    !: boolean for variable ligand concentration following Tagliabue and voelker 
     30   LOGICAL          ::  ln_fecolloid !: boolean for variable colloidal fraction 
     31   REAL(wp), PUBLIC ::  xlam1        !: scavenging rate of Iron  
     32   REAL(wp), PUBLIC ::  xlamdust     !: scavenging rate of Iron by dust  
     33   REAL(wp), PUBLIC ::  ligand       !: ligand concentration in the ocean  
     34   REAL(wp), PUBLIC ::  kfep         !: rate constant for nanoparticle formation 
     35 
    3936   REAL(wp) :: kl1, kl2, kb1, kb2, ks, kpr, spd, con, kth 
    4037 
    … …  
    5956      !!                    and one particulate form (ln_fechem) 
    6057      !!--------------------------------------------------------------------- 
    61       INTEGER, INTENT(in) ::   kt, knt   ! ocean time step 
    62       ! 
    63       INTEGER  ::   ji, jj, jk, jic 
    64       CHARACTER (len=25) :: charout 
     58      ! 
     59      INTEGER, INTENT(in) ::   kt, knt ! ocean time step 
     60      ! 
     61      INTEGER  ::   ji, jj, jk, jic, jn 
    6562      REAL(wp) ::   zdep, zlam1a, zlam1b, zlamfac 
    66       REAL(wp) ::   zkeq, zfeequi, zfesatur, zfecoll 
     63      REAL(wp) ::   zkeq, zfeequi, zfesatur, zfecoll, fe3sol 
    6764      REAL(wp) ::   zdenom1, zscave, zaggdfea, zaggdfeb, zcoag 
    6865      REAL(wp) ::   ztrc, zdust 
    69 #if ! defined key_kriest 
    70       REAL(wp) ::   zdenom, zdenom2 
    71 #endif 
    72       REAL(wp), POINTER, DIMENSION(:,:,:) :: zTL1, zFe3, ztotlig 
    73       REAL(wp), POINTER, DIMENSION(:,:,:) :: zFeL1, zFeL2, zTL2, zFe2, zFeP 
     66      REAL(wp) ::   zdenom2 
     67      REAL(wp) ::   zzFeL1, zzFeL2, zzFe2, zzFeP, zzFe3, zzstrn2 
     68      REAL(wp) ::   zrum, zcodel, zargu, zlight 
    7469      REAL(wp) :: zkox, zkph1, zkph2, zph, zionic, ztligand 
    7570      REAL(wp) :: za, zb, zc, zkappa1, zkappa2, za0, za1, za2 
    7671      REAL(wp) :: zxs, zfunc, zp, zq, zd, zr, zphi, zfff, zp3, zq2 
    77       REAL(wp) :: ztfe, zoxy 
    78       REAL(wp) :: zstep 
     72      REAL(wp) :: ztfe, zoxy, zhplus 
     73      REAL(wp) :: zaggliga, zaggligb 
     74      REAL(wp) :: dissol, zligco 
     75      CHARACTER (len=25) :: charout 
     76      REAL(wp), POINTER, DIMENSION(:,:,:) :: zTL1, zFe3, ztotlig, precip 
     77      REAL(wp), POINTER, DIMENSION(:,:,:) :: zFeL1, zFeL2, zTL2, zFe2, zFeP 
     78      REAL(wp), POINTER, DIMENSION(:,:  ) :: zstrn, zstrn2 
    7979      !!--------------------------------------------------------------------- 
    8080      ! 
    8181      IF( nn_timing == 1 )  CALL timing_start('p4z_fechem') 
    8282      ! 
    83       CALL wrk_alloc( jpi,jpj,jpk,   zFe3, zFeL1, zTL1, ztotlig ) 
     83      ! Allocate temporary workspace 
     84      CALL wrk_alloc( jpi, jpj, jpk, zFe3, zFeL1, zTL1, ztotlig, precip ) 
    8485      zFe3 (:,:,:) = 0. 
    8586      zFeL1(:,:,:) = 0. 
    8687      zTL1 (:,:,:) = 0. 
    8788      IF( ln_fechem ) THEN 
    88          CALL wrk_alloc( jpi,jpj,jpk,   zFe2, zFeL2, zTL2, zFeP ) 
     89         CALL wrk_alloc( jpi, jpj,      zstrn, zstrn2 ) 
     90         CALL wrk_alloc( jpi, jpj, jpk, zFe2, zFeL2, zTL2, zFeP ) 
    8991         zFe2 (:,:,:) = 0. 
    9092         zFeL2(:,:,:) = 0. 
    … …  
    100102         ztotlig(:,:,:) =  MIN( ztotlig(:,:,:), 10. ) 
    101103      ELSE 
    102          ztotlig(:,:,:) = ligand * 1E9 
     104        IF( ln_ligand ) THEN  ;   ztotlig(:,:,:) = trb(:,:,:,jplgw) * 1E9 
     105        ELSE                  ;   ztotlig(:,:,:) = ligand * 1E9 
     106        ENDIF 
    103107      ENDIF 
    104108 
    105109      IF( ln_fechem ) THEN 
     110         ! compute the day length depending on latitude and the day 
     111         zrum = REAL( nday_year - 80, wp ) / REAL( nyear_len(1), wp ) 
     112         zcodel = ASIN(  SIN( zrum * rpi * 2._wp ) * SIN( rad * 23.5_wp )  ) 
     113 
     114         ! day length in hours 
     115         zstrn(:,:) = 0. 
     116         DO jj = 1, jpj 
     117            DO ji = 1, jpi 
     118               zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad ) 
     119               zargu = MAX( -1., MIN(  1., zargu ) ) 
     120               zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. ) 
     121            END DO 
     122         END DO 
     123 
     124         ! Maximum light intensity 
     125         zstrn2(:,:) = zstrn(:,:) / 24. 
     126         WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24. 
     127         zstrn(:,:) = 24. / zstrn(:,:) 
     128 
    106129         ! ------------------------------------------------------------ 
    107130         ! NEW FE CHEMISTRY ROUTINE from Tagliabue and Volker (2009) 
    … …  
    109132         ! Chemistry is supposed to be fast enough to be at equilibrium 
    110133         ! ------------------------------------------------------------ 
    111          DO jk = 1, jpkm1 
     134         DO jn = 1, 2 
     135          DO jk = 1, jpkm1 
    112136            DO jj = 1, jpj 
    113137               DO ji = 1, jpi 
     138                  zlight = etot(ji,jj,jk) * zstrn(ji,jj) * REAL( 2-jn, wp ) 
     139                  zzstrn2 = zstrn2(ji,jj) * REAL( 2-jn, wp ) + (1. - zstrn2(ji,jj) ) * REAL( jn-1, wp ) 
    114140                  ! Calculate ligand concentrations : assume 2/3rd of excess goes to 
    115141                  ! strong ligands (L1) and 1/3rd to weak ligands (L2) 
    … …  
    118144                  zTL2(ji,jj,jk) = ligand * 1E9 - 0.000001 + 0.33 * ztligand 
    119145                  ! ionic strength from Millero et al. 1987 
    120                   zionic = 19.9201 * tsn(ji,jj,jk,jp_sal) / ( 1000. - 1.00488 * tsn(ji,jj,jk,jp_sal) + rtrn ) 
    121146                  zph    = -LOG10( MAX( hi(ji,jj,jk), rtrn) ) 
    122                   zoxy   = trb(ji,jj,jk,jpoxy) * ( rhop(ji,jj,jk) / 1.e3 ) 
     147                  zoxy   = trb(ji,jj,jk,jpoxy) 
    123148                  ! Fe2+ oxydation rate from Santana-Casiano et al. (2005) 
    124                   zkox   = 35.407 - 6.7109 * zph + 0.5342 * zph * zph - 5362.6 / ( tsn(ji,jj,jk,jp_tem) + 273.15 )  & 
    125                     &    - 0.04406 * SQRT( tsn(ji,jj,jk,jp_sal) ) - 0.002847 * tsn(ji,jj,jk,jp_sal) 
     149                  zkox   = 35.407 - 6.7109 * zph + 0.5342 * zph * zph - 5362.6 / ( tempis(ji,jj,jk) + 273.15 )  & 
     150                    &    - 0.04406 * SQRT( salinprac(ji,jj,jk) ) - 0.002847 * salinprac(ji,jj,jk) 
    126151                  zkox   = ( 10.** zkox ) * spd 
    127152                  zkox   = zkox * MAX( 1.e-6, zoxy) / ( chemo2(ji,jj,jk) + rtrn ) 
    128153                  ! PHOTOREDUCTION of complexed iron : Tagliabue and Arrigo (2006) 
    129                   zkph2 = MAX( 0., 15. * etot(ji,jj,jk) / ( etot(ji,jj,jk) + 2. ) ) 
     154                  zkph2 = MAX( 0., 15. * zlight / ( zlight + 2. ) ) * (1. - fr_i(ji,jj)) 
    130155                  zkph1 = zkph2 / 5. 
    131156                  ! pass the dfe concentration from PISCES 
    … …  
    167192                        zphi = ACOS( zfff ) 
    168193                        DO jic = 1, 3 
    169                            zfunc = -2 * zr * COS( zphi / 3. + 2. * FLOAT( jic - 1 ) * rpi / 3. ) - za2 / 3. 
     194                           zfunc = -2 * zr * COS( zphi / 3. + 2. * REAL( jic - 1, wp ) * rpi / 3. ) - za2 / 3. 
    170195                           IF( zfunc > 0. .AND. zfunc <= ztfe)  zxs = zfunc 
    171196                        END DO 
    … …  
    173198                  ENDIF 
    174199                  ! solve for the other Fe species 
    175                   zFe3(ji,jj,jk) = MAX( 0., zxs )  
    176                   zFep(ji,jj,jk) = MAX( 0., ( ks * zFe3(ji,jj,jk) / kpr ) ) 
     200                  zzFe3 = MAX( 0., zxs ) 
     201                  zzFep = MAX( 0., ( ks * zzFe3 / kpr ) ) 
    177202                  zkappa2 = ( kb2 + zkph2 ) / kl2 
    178                   zFeL2(ji,jj,jk) = MAX( 0., ( zFe3(ji,jj,jk) * zTL2(ji,jj,jk) ) / ( zkappa2 + zFe3(ji,jj,jk) ) ) 
    179                   zFeL1(ji,jj,jk) = MAX( 0., ( ztfe / zb - za / zb * zFe3(ji,jj,jk) - zc / zb * zFeL2(ji,jj,jk) ) ) 
    180                   zFe2 (ji,jj,jk) = MAX( 0., ( ( zkph1 * zFeL1(ji,jj,jk) + zkph2 * zFeL2(ji,jj,jk) ) / zkox ) ) 
     203                  zzFeL2 = MAX( 0., ( zzFe3 * zTL2(ji,jj,jk) ) / ( zkappa2 + zzFe3 ) ) 
     204                  zzFeL1 = MAX( 0., ( ztfe / zb - za / zb * zzFe3 - zc / zb * zzFeL2 ) ) 
     205                  zzFe2  = MAX( 0., ( ( zkph1 * zzFeL1 + zkph2 * zzFeL2 ) / zkox ) ) 
     206                  zFe3(ji,jj,jk)  = zFe3(ji,jj,jk)  + zzFe3 * zzstrn2 
     207                  zFe2(ji,jj,jk)  = zFe2(ji,jj,jk)  + zzFe2 * zzstrn2 
     208                  zFeL2(ji,jj,jk) = zFeL2(ji,jj,jk) + zzFeL2 * zzstrn2 
     209                  zFeL1(ji,jj,jk) = zFeL1(ji,jj,jk) + zzFeL1 * zzstrn2 
     210                  zFeP(ji,jj,jk)  = zFeP(ji,jj,jk)  + zzFeP * zzstrn2 
    181211               END DO 
    182212            END DO 
     213         END DO 
    183214         END DO 
    184215      ELSE 
    … …  
    206237         ! 
    207238      ENDIF 
    208       ! 
     239 
    209240      zdust = 0.         ! if no dust available 
    210       ! 
    211241      DO jk = 1, jpkm1 
    212242         DO jj = 1, jpj 
    213243            DO ji = 1, jpi 
    214                zstep = xstep 
    215 # if defined key_degrad 
    216                zstep = zstep * facvol(ji,jj,jk) 
    217 # endif 
    218244               ! Scavenging rate of iron. This scavenging rate depends on the load of particles of sea water.  
    219245               ! This parameterization assumes a simple second order kinetics (k[Particles][Fe]). 
    … …  
    224250                  zfecoll = ( 0.3 * zFeL1(ji,jj,jk) + 0.5 * zFeL2(ji,jj,jk) ) * 1E-9 
    225251               ELSE 
    226                   zfeequi = zFe3(ji,jj,jk) * 1E-9  
    227                   zfecoll = 0.5 * zFeL1(ji,jj,jk) * 1E-9 
     252                  zfeequi = zFe3(ji,jj,jk) * 1E-9 
     253                  IF (ln_fecolloid) THEN 
     254                     zhplus   = max( rtrn, hi(ji,jj,jk) ) 
     255                     fe3sol  = fesol(ji,jj,jk,1) * ( zhplus**3 + fesol(ji,jj,jk,2) * zhplus**2  & 
     256                     &         + fesol(ji,jj,jk,3) * zhplus + fesol(ji,jj,jk,4)     & 
     257                     &         + fesol(ji,jj,jk,5) / zhplus ) 
     258                     zfecoll = max( ( 0.1 * zFeL1(ji,jj,jk) * 1E-9 ), ( zFeL1(ji,jj,jk) * 1E-9 -fe3sol ) ) 
     259                  ELSE 
     260                     zfecoll = 0.5 * zFeL1(ji,jj,jk) * 1E-9 
     261                     fe3sol  = 0. 
     262                  ENDIF 
    228263               ENDIF 
    229 #if defined key_kriest 
    230                ztrc   = ( trb(ji,jj,jk,jppoc) + trb(ji,jj,jk,jpcal) + trb(ji,jj,jk,jpgsi) ) * 1.e6  
    231 #else 
     264               ! 
    232265               ztrc   = ( trb(ji,jj,jk,jppoc) + trb(ji,jj,jk,jpgoc) + trb(ji,jj,jk,jpcal) + trb(ji,jj,jk,jpgsi) ) * 1.e6  
    233 #endif 
    234266               IF( ln_dust )  zdust  = dust(ji,jj) / ( wdust / rday ) * tmask(ji,jj,jk) ! dust in kg/m2/s 
    235267               zlam1b = 3.e-5 + xlamdust * zdust + xlam1 * ztrc 
    236                zscave = zfeequi * zlam1b * zstep 
     268               zscave = zfeequi * zlam1b * xstep 
    237269 
    238270               ! Compute the different ratios for scavenging of iron 
    … …  
    240272               ! --------------------------------------------------------- 
    241273               zdenom1 = xlam1 * trb(ji,jj,jk,jppoc) / zlam1b 
    242 #if ! defined key_kriest 
    243274               zdenom2 = xlam1 * trb(ji,jj,jk,jpgoc) / zlam1b 
    244 #endif 
    245275 
    246276               !  Increased scavenging for very high iron concentrations found near the coasts  
    … …  
    249279               zlamfac = MAX( 0.e0, ( gphit(ji,jj) + 55.) / 30. ) 
    250280               zlamfac = MIN( 1.  , zlamfac ) 
    251 !!gm very small BUG :  it is unlikely but possible that gdept_n = 0  ..... 
    252281               zdep    = MIN( 1., 1000. / gdept_n(ji,jj,jk) ) 
    253282               zlam1b  = xlam1 * MAX( 0.e0, ( trb(ji,jj,jk,jpfer) * 1.e9 - ztotlig(ji,jj,jk) ) ) 
    254                zcoag   = zfeequi * zlam1b * zstep + 1E-4 * ( 1. - zlamfac ) * zdep * zstep * trb(ji,jj,jk,jpfer) 
     283               zcoag   = zfeequi * zlam1b * xstep + 1E-4 * ( 1. - zlamfac ) * zdep * xstep * trb(ji,jj,jk,jpfer) 
    255284 
    256285               !  Compute the coagulation of colloidal iron. This parameterization  
    … …  
    259288               !  ---------------------------------------------------------------- 
    260289               zlam1a  = ( 0.369  * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4  * trb(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk)    & 
    261                    &   + ( 114.   * 0.3 * trb(ji,jj,jk,jpdoc) + 5.09E3 * trb(ji,jj,jk,jppoc) ) 
    262                zaggdfea = zlam1a * zstep * zfecoll 
    263 #if defined key_kriest 
    264                zaggdfeb = 0. 
     290                   &   + ( 114.   * 0.3 * trb(ji,jj,jk,jpdoc) ) 
     291               zaggdfea = zlam1a * xstep * zfecoll 
    265292               ! 
    266                tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zscave - zaggdfea - zaggdfeb - zcoag 
    267                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zscave * zdenom1 + zaggdfea + zaggdfeb 
    268 #else 
    269293               zlam1b = 3.53E3 *   trb(ji,jj,jk,jpgoc) * xdiss(ji,jj,jk) 
    270                zaggdfeb = zlam1b * zstep * zfecoll 
     294               zaggdfeb = zlam1b * xstep * zfecoll 
    271295               ! 
    272                tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zscave - zaggdfea - zaggdfeb - zcoag 
     296               ! precipitation of Fe3+, creation of nanoparticles 
     297               precip(ji,jj,jk) = MAX( 0., ( zfeequi - fe3sol ) ) * kfep * xstep 
     298               ! 
     299               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zscave - zaggdfea - zaggdfeb & 
     300               &                     - zcoag - precip(ji,jj,jk) 
    273301               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zscave * zdenom1 + zaggdfea 
    274302               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zscave * zdenom2 + zaggdfeb 
    275 #endif 
     303               ! 
    276304            END DO 
    277305         END DO 
    … …  
    280308      !  Define the bioavailable fraction of iron 
    281309      !  ---------------------------------------- 
    282       IF( ln_fechem ) THEN 
    283           biron(:,:,:) = MAX( 0., trb(:,:,:,jpfer) - zFeP(:,:,:) * 1E-9 ) 
    284       ELSE 
    285           biron(:,:,:) = trb(:,:,:,jpfer)  
    286       ENDIF 
    287  
     310      IF( ln_fechem ) THEN  ;  biron(:,:,:) = MAX( 0., trb(:,:,:,jpfer) - zFeP(:,:,:) * 1E-9 ) 
     311      ELSE                  ;  biron(:,:,:) = trb(:,:,:,jpfer)  
     312      ENDIF 
     313      ! 
     314      IF( ln_ligand ) THEN 
     315         ! 
     316         DO jk = 1, jpkm1 
     317            DO jj = 1, jpj 
     318               DO ji = 1, jpi 
     319                  zlam1a   = ( 0.369  * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4  * trb(ji,jj,jk,jppoc) ) * xdiss(ji,jj,jk)    & 
     320                      &    + ( 114.   * 0.3 * trb(ji,jj,jk,jpdoc) ) 
     321                  ! 
     322                  zlam1b   = 3.53E3 *   trb(ji,jj,jk,jpgoc) * xdiss(ji,jj,jk) 
     323                  zligco   = MAX( ( 0.1 * trb(ji,jj,jk,jplgw) ), ( trb(ji,jj,jk,jplgw) - fe3sol ) ) 
     324                  zaggliga = zlam1a * xstep * zligco 
     325                  zaggligb = zlam1b * xstep * zligco 
     326                  tra(ji,jj,jk,jpfep) = tra(ji,jj,jk,jpfep) + precip(ji,jj,jk) 
     327                  tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) - zaggliga - zaggligb 
     328               END DO 
     329            END DO 
     330         END DO 
     331         ! 
     332         IF( .NOT.ln_fechem) THEN 
     333            plig(:,:,:) =  MAX( 0., ( ( zFeL1(:,:,:) * 1E-9 ) / ( trb(:,:,:,jpfer) +rtrn ) ) ) 
     334            plig(:,:,:) =  MAX( 0. , plig(:,:,:) ) 
     335         ENDIF 
     336         ! 
     337      ENDIF 
    288338      !  Output of some diagnostics variables 
    289339      !     --------------------------------- 
    290       IF( lk_iomput .AND. knt == nrdttrc ) THEN 
     340      IF( lk_iomput ) THEN 
     341         IF( knt == nrdttrc ) THEN 
    291342         IF( iom_use("Fe3")    )  CALL iom_put("Fe3"    , zFe3   (:,:,:)       * tmask(:,:,:) )   ! Fe3+ 
    292343         IF( iom_use("FeL1")   )  CALL iom_put("FeL1"   , zFeL1  (:,:,:)       * tmask(:,:,:) )   ! FeL1 
    … …  
    300351            IF( iom_use("TL2")  ) CALL iom_put("TL2"    , zTL2   (:,:,:)       * tmask(:,:,:) )   ! TL2 
    301352         ENDIF 
     353         ENDIF 
    302354      ENDIF 
    303355 
    … …  
    308360      ENDIF 
    309361      ! 
    310                        CALL wrk_dealloc( jpi, jpj, jpk, zFe3, zFeL1, zTL1, ztotlig ) 
    311       IF( ln_fechem )  CALL wrk_dealloc( jpi, jpj, jpk, zFe2, zFeL2, zTL2, zFeP ) 
     362      CALL wrk_dealloc( jpi, jpj, jpk, zFe3, zFeL1, zTL1, ztotlig, precip ) 
     363      IF( ln_fechem )  THEN 
     364         CALL wrk_dealloc( jpi, jpj,      zstrn, zstrn2 ) 
     365         CALL wrk_dealloc( jpi, jpj, jpk, zFe2, zFeL2, zTL2, zFeP ) 
     366      ENDIF 
    312367      ! 
    313368      IF( nn_timing == 1 )  CALL timing_stop('p4z_fechem') 
    … …  
    328383      !! 
    329384      !!---------------------------------------------------------------------- 
    330       NAMELIST/nampisfer/ ln_fechem, ln_ligvar, xlam1, xlamdust, ligand  
     385      NAMELIST/nampisfer/ ln_fechem, ln_ligvar, ln_fecolloid, xlam1, xlamdust, ligand, kfep  
    331386      INTEGER :: ios                 ! Local integer output status for namelist read 
    332387 
    … …  
    344399         WRITE(numout,*) ' Namelist parameters for Iron chemistry, nampisfer' 
    345400         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    346          WRITE(numout,*) '    enable complex iron chemistry scheme      ln_fechem =', ln_fechem 
    347          WRITE(numout,*) '    variable concentration of ligand          ln_ligvar =', ln_ligvar 
    348          WRITE(numout,*) '    scavenging rate of Iron                   xlam1     =', xlam1 
    349          WRITE(numout,*) '    scavenging rate of Iron by dust           xlamdust  =', xlamdust 
    350          WRITE(numout,*) '    ligand concentration in the ocean         ligand    =', ligand 
     401         WRITE(numout,*) '    enable complex iron chemistry scheme      ln_fechem    =', ln_fechem 
     402         WRITE(numout,*) '    variable concentration of ligand          ln_ligvar    =', ln_ligvar 
     403         WRITE(numout,*) '    Variable colloidal fraction of Fe3+       ln_fecolloid =', ln_fecolloid 
     404         WRITE(numout,*) '    scavenging rate of Iron                   xlam1        =', xlam1 
     405         WRITE(numout,*) '    scavenging rate of Iron by dust           xlamdust     =', xlamdust 
     406         WRITE(numout,*) '    ligand concentration in the ocean         ligand       =', ligand 
     407         WRITE(numout,*) '    rate constant for nanoparticle formation  kfep         =', kfep 
    351408      ENDIF 
    352409      ! 
    … …  
    377434      ! 
    378435   END SUBROUTINE p4z_fechem_init 
    379  
    380 #else 
    381    !!====================================================================== 
    382    !!  Dummy module :                                   No PISCES bio-model 
    383    !!====================================================================== 
    384 CONTAINS 
    385    SUBROUTINE p4z_fechem                    ! Empty routine 
    386    END SUBROUTINE p4z_fechem 
    387 #endif  
    388  
    389436   !!====================================================================== 
    390437END MODULE p4zfechem 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zflx.F90

    r6962 r7646  
    1111   !!                  !  2011-02  (J. Simeon, J. Orr) Include total atm P correction  
    1212   !!---------------------------------------------------------------------- 
    13 #if defined key_pisces 
    14    !!---------------------------------------------------------------------- 
    15    !!   'key_pisces'                                       PISCES bio-model 
    16    !!---------------------------------------------------------------------- 
    1713   !!   p4z_flx       :   CALCULATES GAS EXCHANGE AND CHEMISTRY AT SEA SURFACE 
    1814   !!   p4z_flx_init  :   Read the namelist 
    … …  
    2622   USE iom                          !  I/O manager 
    2723   USE fldread                      !  read input fields 
    28 #if defined key_cpl_carbon_cycle 
    29    USE sbc_oce, ONLY :  atm_co2     !  atmospheric pCO2                
    30 #endif 
    3124 
    3225   IMPLICIT NONE 
    … …  
    4841 
    4942   !                               !!* nampisatm namelist (Atmospheric PRessure) * 
    50    LOGICAL, PUBLIC ::   ln_presatm  !: ref. pressure: global mean Patm (F) or a constant (F) 
    51  
    52    REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:)  ::  patm      ! atmospheric pressure at kt                 [N/m2] 
    53    TYPE(FLD), ALLOCATABLE,       DIMENSION(:)    ::  sf_patm   ! structure of input fields (file informations, fields read) 
    54  
    55  
    56    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: oce_co2   !: ocean carbon flux  
     43   LOGICAL, PUBLIC ::   ln_presatm     !: ref. pressure: global mean Patm (F) or a constant (F) 
     44   LOGICAL, PUBLIC ::   ln_presatmco2  !: accounting for spatial atm CO2 in the compuation of carbon flux (T) or not (F) 
     45 
     46   REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:) ::  patm      ! atmospheric pressure at kt                 [N/m2] 
     47   TYPE(FLD), ALLOCATABLE,       DIMENSION(:)   ::  sf_patm   ! structure of input fields (file informations, fields read) 
     48   TYPE(FLD), ALLOCATABLE,       DIMENSION(:)   ::  sf_atmco2 ! structure of input fields (file informations, fields read) 
     49 
    5750   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: satmco2   !: atmospheric pco2  
    5851 
    … …  
    7467      !! ** Method  :  
    7568      !!              - Include total atm P correction via Esbensen & Kushnir (1981)  
    76       !!              - Pressure correction NOT done for key_cpl_carbon_cycle 
    7769      !!              - Remove Wanninkhof chemical enhancement; 
    7870      !!              - Add option for time-interpolation of atcco2.txt   
    … …  
    8577      REAL(wp) ::   zfld, zflu, zfld16, zflu16, zfact 
    8678      REAL(wp) ::   zvapsw, zsal, zfco2, zxc2, xCO2approx, ztkel, zfugcoeff 
    87       REAL(wp) ::   zph, zah2, zbot, zdic, zalk, zsch_o2, zalka, zsch_co2 
     79      REAL(wp) ::   zph, zdic, zsch_o2, zsch_co2 
    8880      REAL(wp) ::   zyr_dec, zdco2dt 
    8981      CHARACTER (len=25) :: charout 
    … …  
    10092      !     IS USED TO COMPUTE AIR-SEA FLUX OF CO2 
    10193 
    102       IF( kt /= nit000 .AND. knt == 1 ) CALL p4z_patm( kt )    ! Get sea-level pressure (E&K [1981] climatology) for use in flux calcs 
    103  
    104       IF( ln_co2int ) THEN  
     94      IF( kt /= nit000 .AND. .NOT.l_co2cpl .AND. knt == 1 ) CALL p4z_patm( kt )    ! Get sea-level pressure (E&K [1981] climatology) for use in flux calcs 
     95 
     96      IF( ln_co2int .AND. .NOT.ln_presatmco2 .AND. .NOT.l_co2cpl ) THEN  
    10597         ! Linear temporal interpolation  of atmospheric pco2.  atcco2.txt has annual values. 
    10698         ! Caveats: First column of .txt must be in years, decimal  years preferably.  
    … …  
    116108      ENDIF 
    117109 
    118 #if defined key_cpl_carbon_cycle 
    119       satmco2(:,:) = atm_co2(:,:) 
    120 #endif 
    121  
    122       DO jm = 1, 10 
    123          DO jj = 1, jpj 
    124             DO ji = 1, jpi 
    125  
    126                ! DUMMY VARIABLES FOR DIC, H+, AND BORATE 
    127                zbot  = borat(ji,jj,1) 
    128                zfact = rhop(ji,jj,1) / 1000. + rtrn 
    129                zdic  = trb(ji,jj,1,jpdic) / zfact 
    130                zph   = MAX( hi(ji,jj,1), 1.e-10 ) / zfact 
    131                zalka = trb(ji,jj,1,jptal) / zfact 
    132  
    133                ! CALCULATE [ALK]([CO3--], [HCO3-]) 
    134                zalk  = zalka - (  akw3(ji,jj,1) / zph - zph / aphscale(ji,jj,1)    & 
    135                &       + zbot / ( 1.+ zph / akb3(ji,jj,1) )  ) 
    136  
    137                ! CALCULATE [H+] AND [H2CO3] 
    138                zah2   = SQRT(  (zdic-zalk)**2 + 4.* ( zalk * ak23(ji,jj,1)   & 
    139                   &                                        / ak13(ji,jj,1) ) * ( 2.* zdic - zalk )  ) 
    140                zah2   = 0.5 * ak13(ji,jj,1) / zalk * ( ( zdic - zalk ) + zah2 ) 
    141                zh2co3(ji,jj) = ( 2.* zdic - zalk ) / ( 2.+ ak13(ji,jj,1) / zah2 ) * zfact 
    142                hi(ji,jj,1)   = zah2 * zfact 
    143             END DO 
     110      IF( l_co2cpl )   satmco2(:,:) = atm_co2(:,:) 
     111 
     112      DO jj = 1, jpj 
     113         DO ji = 1, jpi 
     114            ! DUMMY VARIABLES FOR DIC, H+, AND BORATE 
     115            zfact = rhop(ji,jj,1) / 1000. + rtrn 
     116            zdic  = trb(ji,jj,1,jpdic) 
     117            zph   = MAX( hi(ji,jj,1), 1.e-10 ) / zfact 
     118            ! CALCULATE [H2CO3] 
     119            zh2co3(ji,jj) = zdic/(1. + ak13(ji,jj,1)/zph + ak13(ji,jj,1)*ak23(ji,jj,1)/zph**2) 
    144120         END DO 
    145121      END DO 
    146  
    147122 
    148123      ! -------------- 
    … …  
    167142            zkgwan = 0.251 * zws 
    168143            zkgwan = zkgwan * xconv * ( 1.- fr_i(ji,jj) ) * tmask(ji,jj,1) 
    169 # if defined key_degrad 
    170             zkgwan = zkgwan * facvol(ji,jj,1) 
    171 #endif  
    172144            ! compute gas exchange for CO2 and O2 
    173145            zkgco2(ji,jj) = zkgwan * SQRT( 660./ zsch_co2 ) 
    … …  
    176148      END DO 
    177149 
     150 
    178151      DO jj = 1, jpj 
    179152         DO ji = 1, jpi 
    180             ztkel     = tsn(ji,jj,1,jp_tem) + 273.15 
    181             zsal      = tsn(ji,jj,1,jp_sal) + ( 1.- tmask(ji,jj,1) ) * 35. 
     153            ztkel = tempis(ji,jj,1) + 273.15 
     154            zsal  = salinprac(ji,jj,1) + ( 1.- tmask(ji,jj,1) ) * 35. 
    182155            zvapsw    = EXP(24.4543 - 67.4509*(100.0/ztkel) - 4.8489*LOG(ztkel/100) - 0.000544*zsal) 
    183156            zpco2atm(ji,jj) = satmco2(ji,jj) * ( patm(ji,jj) - zvapsw ) 
    … …  
    232205         ENDIF 
    233206         IF( iom_use( "Dpo2" ) )  THEN 
    234            zw2d(:,:) = ( atcox * patm(:,:) - atcox * trn(:,:,1,jpoxy) / ( chemo2(:,:,1) + rtrn ) ) * tmask(:,:,1) 
     207           zw2d(:,:) = ( atcox * patm(:,:) - atcox * trb(:,:,1,jpoxy) / ( chemo2(:,:,1) + rtrn ) ) * tmask(:,:,1) 
    235208           CALL iom_put( "Dpo2"  , zw2d ) 
    236209         ENDIF 
    … …  
    239212         ! 
    240213         CALL wrk_dealloc( jpi, jpj, zw2d ) 
    241       ELSE 
    242          IF( ln_diatrc ) THEN 
    243             trc2d(:,:,jp_pcs0_2d    ) = oce_co2(:,:) / e1e2t(:,:) * rfact2r  
    244             trc2d(:,:,jp_pcs0_2d + 1) = zoflx(:,:) * 1000 * tmask(:,:,1)  
    245             trc2d(:,:,jp_pcs0_2d + 2) = zkgco2(:,:) * tmask(:,:,1)  
    246             trc2d(:,:,jp_pcs0_2d + 3) = ( zpco2atm(:,:) - zh2co3(:,:) / ( chemc(:,:,1) + rtrn ) ) * tmask(:,:,1)  
    247          ENDIF 
    248214      ENDIF 
    249215      ! 
    … …  
    287253         WRITE(numout,*) ' ' 
    288254      ENDIF 
    289       IF( .NOT.ln_co2int ) THEN 
     255     IF( .NOT.ln_co2int .AND. .NOT.ln_presatmco2 ) THEN 
    290256         IF(lwp) THEN                         ! control print 
    291257            WRITE(numout,*) '    Constant Atmospheric pCO2 value  atcco2    =', atcco2 
    … …  
    293259         ENDIF 
    294260         satmco2(:,:)  = atcco2      ! Initialisation of atmospheric pco2 
    295       ELSE 
     261      ELSEIF( ln_co2int .AND. .NOT.ln_presatmco2 ) THEN 
    296262         IF(lwp)  THEN 
    297263            WRITE(numout,*) '    Atmospheric pCO2 value  from file clname      =', TRIM( clname ) 
    … …  
    315281         END DO 
    316282         CLOSE(numco2) 
    317       ENDIF 
     283      ELSEIF( .NOT.ln_co2int .AND. ln_presatmco2 ) THEN 
     284         IF(lwp)  THEN 
     285            WRITE(numout,*) '    Spatialized Atmospheric pCO2 from an external file' 
     286            WRITE(numout,*) ' ' 
     287         ENDIF 
     288      ELSE 
     289         IF(lwp)  THEN 
     290            WRITE(numout,*) '    Spatialized Atmospheric pCO2 from an external file' 
     291            WRITE(numout,*) ' ' 
     292         ENDIF 
     293      ENDIF 
     294 
    318295      ! 
    319296      oce_co2(:,:)  = 0._wp                ! Initialization of Flux of Carbon 
    … …  
    341318      CHARACTER(len=100) ::  cn_dir   ! Root directory for location of ssr files 
    342319      TYPE(FLD_N)        ::  sn_patm  ! informations about the fields to be read 
    343       !! 
    344       NAMELIST/nampisatm/ ln_presatm, sn_patm, cn_dir 
     320      TYPE(FLD_N)        ::  sn_atmco2 ! informations about the fields to be read 
     321      !! 
     322      NAMELIST/nampisatm/ ln_presatm, ln_presatmco2, sn_patm, sn_atmco2, cn_dir 
    345323 
    346324      !                                         ! ----------------------- ! 
    … …  
    361339            WRITE(numout,*) '   Namelist nampisatm : Atmospheric Pressure as external forcing' 
    362340            WRITE(numout,*) '      constant atmopsheric pressure (F) or from a file (T)  ln_presatm = ', ln_presatm 
     341            WRITE(numout,*) '      spatial atmopsheric CO2 for flux calcs  ln_presatmco2 = ', ln_presatmco2 
    363342            WRITE(numout,*) 
    364343         ENDIF 
    … …  
    373352         ENDIF 
    374353         !                                          
     354         IF( ln_presatmco2 ) THEN 
     355            ALLOCATE( sf_atmco2(1), STAT=ierr )           !* allocate and fill sf_atmco2 (forcing structure) with sn_atmco2 
     356            IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'p4z_flx: unable to allocate sf_atmco2 structure' ) 
     357            ! 
     358            CALL fld_fill( sf_atmco2, (/ sn_atmco2 /), cn_dir, 'p4z_flx', 'Atmospheric co2 partial pressure ', 'nampisatm' ) 
     359                                   ALLOCATE( sf_atmco2(1)%fnow(jpi,jpj,1)   ) 
     360            IF( sn_atmco2%ln_tint )  ALLOCATE( sf_atmco2(1)%fdta(jpi,jpj,1,2) ) 
     361         ENDIF 
     362         ! 
    375363         IF( .NOT.ln_presatm )   patm(:,:) = 1.e0    ! Initialize patm if no reading from a file 
    376364         ! 
    … …  
    382370      ENDIF 
    383371      ! 
     372      IF( ln_presatmco2 ) THEN 
     373         CALL fld_read( kt, 1, sf_atmco2 )               !* input atmco2 provided at kt + 1/2 
     374         satmco2(:,:) = sf_atmco2(1)%fnow(:,:,1)                        ! atmospheric pressure 
     375      ELSE 
     376         satmco2(:,:) = atcco2    ! Initialize atmco2 if no reading from a file 
     377      ENDIF 
     378      ! 
    384379   END SUBROUTINE p4z_patm 
    385380 
     381 
    386382   INTEGER FUNCTION p4z_flx_alloc() 
    387383      !!---------------------------------------------------------------------- 
    388384      !!                     ***  ROUTINE p4z_flx_alloc  *** 
    389385      !!---------------------------------------------------------------------- 
    390       ALLOCATE( oce_co2(jpi,jpj), satmco2(jpi,jpj), patm(jpi,jpj), STAT=p4z_flx_alloc ) 
     386      ALLOCATE( satmco2(jpi,jpj), patm(jpi,jpj), STAT=p4z_flx_alloc ) 
    391387      ! 
    392388      IF( p4z_flx_alloc /= 0 )   CALL ctl_warn('p4z_flx_alloc : failed to allocate arrays') 
    393389      ! 
    394390   END FUNCTION p4z_flx_alloc 
    395  
    396 #else 
    397    !!====================================================================== 
    398    !!  Dummy module :                                   No PISCES bio-model 
    399    !!====================================================================== 
    400 CONTAINS 
    401    SUBROUTINE p4z_flx( kt )                   ! Empty routine 
    402       INTEGER, INTENT( in ) ::   kt 
    403       WRITE(*,*) 'p4z_flx: You should not have seen this print! error?', kt 
    404    END SUBROUTINE p4z_flx 
    405 #endif  
    406391 
    407392   !!====================================================================== 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zint.F90

    r5656 r7646  
    77   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
    88   !!---------------------------------------------------------------------- 
    9 #if defined key_pisces 
    10    !!---------------------------------------------------------------------- 
    11    !!   'key_pisces'                                       PISCES bio-model 
    12    !!---------------------------------------------------------------------- 
    139   !!   p4z_int        :  interpolation and computation of various accessory fields 
    1410   !!---------------------------------------------------------------------- 
    … …  
    1612   USE trc             !  passive tracers common variables  
    1713   USE sms_pisces      !  PISCES Source Minus Sink variables 
    18    USE iom 
    1914 
    2015   IMPLICIT NONE 
    … …  
    7065   END SUBROUTINE p4z_int 
    7166 
    72 #else 
    73    !!====================================================================== 
    74    !!  Dummy module :                                   No PISCES bio-model 
    75    !!====================================================================== 
    76 CONTAINS 
    77    SUBROUTINE p4z_int                   ! Empty routine 
    78       WRITE(*,*) 'p4z_int: You should not have seen this print! error?' 
    79    END SUBROUTINE p4z_int 
    80 #endif  
    81  
    8267   !!====================================================================== 
    8368END MODULE p4zint 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlim.F90

    r6945 r7646  
    88   !!             3.4  !  2011-04  (O. Aumont, C. Ethe) Limitation for iron modelled in quota  
    99   !!---------------------------------------------------------------------- 
    10 #if defined key_pisces 
    11    !!---------------------------------------------------------------------- 
    12    !!   'key_pisces'                                       PISCES bio-model 
    13    !!---------------------------------------------------------------------- 
    1410   !!   p4z_lim        :   Compute the nutrients limitation terms  
    1511   !!   p4z_lim_init   :   Read the namelist  
    … …  
    1814   USE trc             ! Tracers defined 
    1915   USE sms_pisces      ! PISCES variables 
    20    USE p4zopt          ! Optical 
    2116   USE iom             !  I/O manager 
    2217 
    … …  
    2621   PUBLIC p4z_lim     
    2722   PUBLIC p4z_lim_init     
     23   PUBLIC p4z_lim_alloc 
    2824 
    2925   !! * Shared module variables 
    … …  
    4844   REAL(wp), PUBLIC ::  qdfelim     !:  optimal Fe quota for diatoms 
    4945   REAL(wp), PUBLIC ::  caco3r      !:  mean rainratio  
     46 
     47   !!* Phytoplankton limitation terms 
     48   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xnanono3   !: ??? 
     49   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xdiatno3   !: ??? 
     50   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xnanonh4   !: ??? 
     51   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xdiatnh4   !: ??? 
     52   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xnanopo4   !: ??? 
     53   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xdiatpo4   !: ??? 
     54   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimphy    !: ??? 
     55   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimdia    !: ??? 
     56   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimnfe    !: ??? 
     57   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimdfe    !: ??? 
     58   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimsi     !: ??? 
     59   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimbac    !: ?? 
     60   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimbacl   !: ?? 
     61   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   concdfe    !: ??? 
     62   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   concnfe    !: ??? 
    5063 
    5164   ! Coefficient for iron limitation 
    … …  
    224237      !!---------------------------------------------------------------------- 
    225238 
    226       NAMELIST/nampislim/ concnno3, concdno3, concnnh4, concdnh4, concnfer, concdfer, concbfe,   & 
     239      NAMELIST/namp4zlim/ concnno3, concdno3, concnnh4, concdnh4, concnfer, concdfer, concbfe,   & 
    227240         &                concbno3, concbnh4, xsizedia, xsizephy, xsizern, xsizerd,          &  
    228241         &                xksi1, xksi2, xkdoc, qnfelim, qdfelim, caco3r, oxymin 
    … …  
    230243 
    231244      REWIND( numnatp_ref )              ! Namelist nampislim in reference namelist : Pisces nutrient limitation parameters 
    232       READ  ( numnatp_ref, nampislim, IOSTAT = ios, ERR = 901) 
    233 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampislim in reference namelist', lwp ) 
     245      READ  ( numnatp_ref, namp4zlim, IOSTAT = ios, ERR = 901) 
     246901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zlim in reference namelist', lwp ) 
    234247 
    235248      REWIND( numnatp_cfg )              ! Namelist nampislim in configuration namelist : Pisces nutrient limitation parameters  
    236       READ  ( numnatp_cfg, nampislim, IOSTAT = ios, ERR = 902 ) 
    237 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampislim in configuration namelist', lwp ) 
    238       IF(lwm) WRITE ( numonp, nampislim ) 
     249      READ  ( numnatp_cfg, namp4zlim, IOSTAT = ios, ERR = 902 ) 
     250902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zlim in configuration namelist', lwp ) 
     251      IF(lwm) WRITE ( numonp, namp4zlim ) 
    239252 
    240253      IF(lwp) THEN                         ! control print 
    241254         WRITE(numout,*) ' ' 
    242          WRITE(numout,*) ' Namelist parameters for nutrient limitations, nampislim' 
     255         WRITE(numout,*) ' Namelist parameters for nutrient limitations, namp4zlim' 
    243256         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    244257         WRITE(numout,*) '    mean rainratio                           caco3r    = ', caco3r 
    … …  
    268281   END SUBROUTINE p4z_lim_init 
    269282 
    270 #else 
    271    !!====================================================================== 
    272    !!  Dummy module :                                   No PISCES bio-model 
    273    !!====================================================================== 
    274 CONTAINS 
    275    SUBROUTINE p4z_lim                   ! Empty routine 
    276    END SUBROUTINE p4z_lim 
    277 #endif  
     283   INTEGER FUNCTION p4z_lim_alloc() 
     284      !!---------------------------------------------------------------------- 
     285      !!                     ***  ROUTINE p5z_lim_alloc  *** 
     286      !!---------------------------------------------------------------------- 
     287      USE lib_mpp , ONLY: ctl_warn 
     288      !!---------------------------------------------------------------------- 
     289 
     290      !*  Biological arrays for phytoplankton growth 
     291      ALLOCATE( xnanono3(jpi,jpj,jpk), xdiatno3(jpi,jpj,jpk),       & 
     292         &      xnanonh4(jpi,jpj,jpk), xdiatnh4(jpi,jpj,jpk),       & 
     293         &      xnanopo4(jpi,jpj,jpk), xdiatpo4(jpi,jpj,jpk),       & 
     294         &      xlimphy (jpi,jpj,jpk), xlimdia (jpi,jpj,jpk),       & 
     295         &      xlimnfe (jpi,jpj,jpk), xlimdfe (jpi,jpj,jpk),       & 
     296         &      xlimbac (jpi,jpj,jpk), xlimbacl(jpi,jpj,jpk),       & 
     297         &      concnfe (jpi,jpj,jpk), concdfe (jpi,jpj,jpk),       & 
     298         &      xlimsi  (jpi,jpj,jpk), STAT=p4z_lim_alloc ) 
     299      ! 
     300      IF( p4z_lim_alloc /= 0 ) CALL ctl_warn('p4z_lim_alloc : failed to allocate arrays.') 
     301      ! 
     302   END FUNCTION p4z_lim_alloc 
    278303 
    279304   !!====================================================================== 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zlys.F90

    r6945 r7646  
    1111   !!                  !  2011-02  (J. Simeon, J. Orr)  Calcon salinity dependence 
    1212   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Improvment of calcite dissolution 
    13    !!---------------------------------------------------------------------- 
    14 #if defined key_pisces 
    15    !!---------------------------------------------------------------------- 
    16    !!   'key_pisces'                                       PISCES bio-model 
     13   !!             3.6  !  2015-05  (O. Aumont) PISCES quota 
    1714   !!---------------------------------------------------------------------- 
    1815   !!   p4z_lys        :   Compute the CaCO3 dissolution  
    … …  
    2219   USE trc             !  passive tracers common variables  
    2320   USE sms_pisces      !  PISCES Source Minus Sink variables 
     21   USE p4zche          !  Chemical model 
    2422   USE prtctl_trc      !  print control for debugging 
    2523   USE iom             !  I/O manager 
    … …  
    6159      INTEGER, INTENT(in) ::   kt, knt ! ocean time step 
    6260      INTEGER  ::   ji, jj, jk, jn 
    63       REAL(wp) ::   zalk, zdic, zph, zah2 
    64       REAL(wp) ::   zdispot, zfact, zcalcon, zalka, zaldi 
     61      REAL(wp) ::   zdispot, zfact, zcalcon 
    6562      REAL(wp) ::   zomegaca, zexcess, zexcess0 
    6663      CHARACTER (len=25) :: charout 
    67       REAL(wp), POINTER, DIMENSION(:,:,:) :: zco3, zco3sat, zcaldiss    
     64      REAL(wp), POINTER, DIMENSION(:,:,:) :: zco3, zcaldiss, zhinit, zhi, zco3sat 
    6865      !!--------------------------------------------------------------------- 
    6966      ! 
    7067      IF( nn_timing == 1 )  CALL timing_start('p4z_lys') 
    7168      ! 
    72       CALL wrk_alloc( jpi, jpj, jpk, zco3, zco3sat, zcaldiss ) 
     69      CALL wrk_alloc( jpi, jpj, jpk, zco3, zcaldiss, zhinit, zhi, zco3sat ) 
    7370      ! 
    7471      zco3    (:,:,:) = 0. 
    7572      zcaldiss(:,:,:) = 0. 
     73      zhinit(:,:,:)   = hi(:,:,:) * 1000. / ( rhop(:,:,:) + rtrn ) 
    7674      !     ------------------------------------------- 
    7775      !     COMPUTE [CO3--] and [H+] CONCENTRATIONS 
    7876      !     ------------------------------------------- 
    79        
    80       DO jn = 1, 5                               !  BEGIN OF ITERATION 
    81          ! 
    82          DO jk = 1, jpkm1 
    83             DO jj = 1, jpj 
    84                DO ji = 1, jpi 
    85                   zfact = rhop(ji,jj,jk) / 1000. + rtrn 
    86                   zph  = hi(ji,jj,jk) * tmask(ji,jj,jk) / zfact + ( 1.-tmask(ji,jj,jk) ) * 1.e-9 ! [H+] 
    87                   zdic  = trb(ji,jj,jk,jpdic) / zfact 
    88                   zalka = trb(ji,jj,jk,jptal) / zfact 
    89                   ! CALCULATE [ALK]([CO3--], [HCO3-]) 
    90                   zalk  = zalka - ( akw3(ji,jj,jk) / zph - zph / ( aphscale(ji,jj,jk) + rtrn )  & 
    91                   &       + borat(ji,jj,jk) / ( 1. + zph / akb3(ji,jj,jk) ) ) 
    92                   ! CALCULATE [H+] and [CO3--] 
    93                   zaldi = zdic - zalk 
    94                   zah2  = SQRT( zaldi * zaldi + 4.* ( zalk * ak23(ji,jj,jk) / ak13(ji,jj,jk) ) * ( zdic + zaldi ) ) 
    95                   zah2  = 0.5 * ak13(ji,jj,jk) / zalk * ( zaldi + zah2 ) 
    96                   ! 
    97                   zco3(ji,jj,jk) = zalk / ( 2. + zah2 / ak23(ji,jj,jk) ) * zfact 
    98                   hi(ji,jj,jk)   = zah2 * zfact 
    99                END DO 
     77 
     78      CALL solve_at_general(zhinit, zhi) 
     79 
     80      DO jk = 1, jpkm1 
     81         DO jj = 1, jpj 
     82            DO ji = 1, jpi 
     83               zco3(ji,jj,jk) = trb(ji,jj,jk,jpdic) * ak13(ji,jj,jk) * ak23(ji,jj,jk) / (zhi(ji,jj,jk)**2   & 
     84               &                + ak13(ji,jj,jk) * zhi(ji,jj,jk) + ak13(ji,jj,jk) * ak23(ji,jj,jk) + rtrn ) 
     85               hi(ji,jj,jk)   = zhi(ji,jj,jk) * rhop(ji,jj,jk) / 1000. 
    10086            END DO 
    10187         END DO 
    102          ! 
    103       END DO  
     88      END DO 
    10489 
    10590      !     --------------------------------------------------------- 
    … …  
    115100               ! DEVIATION OF [CO3--] FROM SATURATION VALUE 
    116101               ! Salinity dependance in zomegaca and divide by rhop/1000 to have good units 
    117                zcalcon  = calcon * ( tsn(ji,jj,jk,jp_sal) / 35._wp ) 
     102               zcalcon  = calcon * ( salinprac(ji,jj,jk) / 35._wp ) 
    118103               zfact    = rhop(ji,jj,jk) / 1000._wp 
    119104               zomegaca = ( zcalcon * zco3(ji,jj,jk) ) / ( aksp(ji,jj,jk) * zfact + rtrn ) 
    … …  
    129114               !       CACO3 GETS DISSOLVED EVEN IN THE CASE OF OVERSATURATION) 
    130115               zdispot = kdca * zexcess * trb(ji,jj,jk,jpcal) 
    131 # if defined key_degrad 
    132                zdispot = zdispot * facvol(ji,jj,jk) 
    133 # endif 
    134116              !  CHANGE OF [CO3--] , [ALK], PARTICULATE [CACO3], 
    135117              !       AND [SUM(CO2)] DUE TO CACO3 DISSOLUTION/PRECIPITATION 
    136118              zcaldiss(ji,jj,jk)  = zdispot * rfact2 / rmtss ! calcite dissolution 
    137               zco3(ji,jj,jk)      = zco3(ji,jj,jk) + zcaldiss(ji,jj,jk) 
    138119              ! 
    139120              tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + 2. * zcaldiss(ji,jj,jk) 
    … …  
    150131         IF( iom_use( "CO3sat" ) ) CALL iom_put( "CO3sat", zco3sat(:,:,:) * 1.e+3            * tmask(:,:,:) ) 
    151132         IF( iom_use( "DCAL"   ) ) CALL iom_put( "DCAL"  , zcaldiss(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:) ) 
    152       ELSE 
    153          IF( ln_diatrc ) THEN 
    154             trc3d(:,:,:,jp_pcs0_3d    ) = -1. * LOG10( hi(:,:,:) ) * tmask(:,:,:) 
    155             trc3d(:,:,:,jp_pcs0_3d + 1) = zco3(:,:,:)              * tmask(:,:,:) 
    156             trc3d(:,:,:,jp_pcs0_3d + 2) = zco3sat(:,:,:)           * tmask(:,:,:) 
    157          ENDIF 
    158133      ENDIF 
    159134      ! 
    … …  
    164139      ENDIF 
    165140      ! 
    166       CALL wrk_dealloc( jpi, jpj, jpk, zco3, zco3sat, zcaldiss ) 
     141      CALL wrk_dealloc( jpi, jpj, jpk, zco3, zcaldiss, zhinit, zhi, zco3sat ) 
    167142      ! 
    168143      IF( nn_timing == 1 )  CALL timing_stop('p4z_lys') 
    … …  
    183158      !! 
    184159      !!---------------------------------------------------------------------- 
    185       INTEGER  ::  ji, jj, jk 
    186160      INTEGER  ::  ios                 ! Local integer output status for namelist read 
    187       REAL(wp) ::  zcaralk, zbicarb, zco3 
    188       REAL(wp) ::  ztmas, ztmas1 
    189161 
    190162      NAMELIST/nampiscal/ kdca, nca 
    … …  
    212184      ! 
    213185   END SUBROUTINE p4z_lys_init 
    214  
    215 #else 
    216    !!====================================================================== 
    217    !!  Dummy module :                                   No PISCES bio-model 
    218    !!====================================================================== 
    219 CONTAINS 
    220    SUBROUTINE p4z_lys( kt )                   ! Empty routine 
    221       INTEGER, INTENT( in ) ::   kt 
    222       WRITE(*,*) 'p4z_lys: You should not have seen this print! error?', kt 
    223    END SUBROUTINE p4z_lys 
    224 #endif  
    225186   !!====================================================================== 
    226187END MODULE p4zlys 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmeso.F90

    r5836 r7646  
    88   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Quota model for iron 
    99   !!---------------------------------------------------------------------- 
    10 #if defined key_pisces 
    11    !!---------------------------------------------------------------------- 
    12    !!   'key_pisces'                                       PISCES bio-model 
    13    !!---------------------------------------------------------------------- 
    1410   !!   p4z_meso       :   Compute the sources/sinks for mesozooplankton 
    1511   !!   p4z_meso_init  :   Initialization of the parameters for mesozooplankton 
    … …  
    1814   USE trc             !  passive tracers common variables  
    1915   USE sms_pisces      !  PISCES Source Minus Sink variables 
    20    USE p4zsink         !  vertical flux of particulate matter due to sinking 
    21    USE p4zint          !  interpolation and computation of various fields 
    2216   USE p4zprod         !  production 
    2317   USE prtctl_trc      !  print control for debugging 
    … …  
    7064      REAL(wp) :: zcompadi, zcompaph, zcompapoc, zcompaz, zcompam 
    7165      REAL(wp) :: zgraze2 , zdenom, zdenom2 
    72       REAL(wp) :: zfact   , zstep, zfood, zfoodlim, zproport 
    73       REAL(wp) :: zmortzgoc, zfrac, zfracfe, zratio, zratio2 
     66      REAL(wp) :: zfact   , zfood, zfoodlim, zproport 
     67      REAL(wp) :: zmortzgoc, zfrac, zfracfe, zratio, zratio2, zfracal, zgrazcal 
    7468      REAL(wp) :: zepshert, zepsherv, zgrarsig, zgraztot, zgraztotn, zgraztotf 
    7569      REAL(wp) :: zgrarem2, zgrafer2, zgrapoc2, zprcaca, zmortz2, zgrasrat, zgrasratn 
    76 #if defined key_kriest 
    77       REAL znumpoc 
    78 #endif 
    7970      REAL(wp) :: zrespz2, ztortz2, zgrazd, zgrazz, zgrazpof 
    8071      REAL(wp) :: zgrazn, zgrazpoc, zgraznf, zgrazf 
    … …  
    8778      IF( nn_timing == 1 )  CALL timing_start('p4z_meso') 
    8879      ! 
    89       IF( lk_iomput ) THEN 
    90          CALL wrk_alloc( jpi, jpj, jpk, zgrazing ) 
    91          zgrazing(:,:,:) = 0._wp 
    92       ENDIF 
     80      CALL wrk_alloc( jpi, jpj, jpk, zgrazing ) 
     81      zgrazing(:,:,:) = 0._wp 
    9382 
    9483      DO jk = 1, jpkm1 
    … …  
    9685            DO ji = 1, jpi 
    9786               zcompam   = MAX( ( trb(ji,jj,jk,jpmes) - 1.e-9 ), 0.e0 ) 
    98 # if defined key_degrad 
    99                zstep     = xstep * facvol(ji,jj,jk) 
    100 # else 
    101                zstep     = xstep 
    102 # endif 
    103                zfact     = zstep * tgfunc2(ji,jj,jk) * zcompam 
     87               zfact     = xstep * tgfunc2(ji,jj,jk) * zcompam 
    10488 
    10589               !  Respiration rates of both zooplankton 
    … …  
    126110               zdenom    = zfoodlim / ( xkgraz2 + zfoodlim ) 
    127111               zdenom2   = zdenom / ( zfood + rtrn ) 
    128                zgraze2   = grazrat2 * zstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpmes)  
     112               zgraze2   = grazrat2 * xstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpmes)  
    129113 
    130114               zgrazd    = zgraze2  * xprefc   * zcompadi  * zdenom2  
    … …  
    140124               !  ---------------------------------- 
    141125               !  ---------------------------------- 
    142 # if ! defined key_kriest 
    143                zgrazffeg = grazflux  * zstep * wsbio4(ji,jj,jk)      & 
     126               zgrazffeg = grazflux  * xstep * wsbio4(ji,jj,jk)      & 
    144127               &           * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes) 
    145128               zgrazfffg = zgrazffeg * trb(ji,jj,jk,jpbfe) / (trb(ji,jj,jk,jpgoc) + rtrn) 
    146 # endif 
    147                zgrazffep = grazflux  * zstep *  wsbio3(ji,jj,jk)     & 
     129               zgrazffep = grazflux  * xstep *  wsbio3(ji,jj,jk)     & 
    148130               &           * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpmes) 
    149131               zgrazfffp = zgrazffep * trb(ji,jj,jk,jpsfe) / (trb(ji,jj,jk,jppoc) + rtrn) 
    150132              ! 
    151 # if ! defined key_kriest 
    152133              zgraztot  = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffep + zgrazffeg 
    153134              ! Compute the proportion of filter feeders 
    … …  
    158139              zratio    = trb(ji,jj,jk,jpgsi) / ( trb(ji,jj,jk,jpgoc) + rtrn ) 
    159140              zratio2   = zratio * zratio 
    160               zfrac     = zproport * grazflux  * zstep * wsbio4(ji,jj,jk)      & 
     141              zfrac     = zproport * grazflux  * xstep * wsbio4(ji,jj,jk)      & 
    161142               &          * trb(ji,jj,jk,jpgoc) * trb(ji,jj,jk,jpmes)          & 
    162143               &          * ( 0.2 + 3.8 * zratio2 / ( 1.**2 + zratio2 ) ) 
    … …  
    171152              &   + zgrazpoc + zgrazffep + zgrazffeg 
    172153              zgraztotf = zgrazf + zgraznf + zgrazz * ferat3 + zgrazpof + zgrazfffp + zgrazfffg 
    173 # else 
    174               zgraztot  = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffep 
    175               ! Compute the proportion of filter feeders 
    176               zproport  = zgrazffep / ( zgraztot + rtrn ) 
    177               zgrazffep = zproport * zgrazffep 
    178               zgrazfffp = zproport * zgrazfffp 
    179               zgraztot  = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffep 
    180               zgraztotn = zgrazd * quotad(ji,jj,jk) + zgrazz + zgrazn * quotan(ji,jj,jk) + zgrazpoc + zgrazffep 
    181               zgraztotf = zgrazf + zgraznf + zgrazz * ferat3 + zgrazpof + zgrazfffp 
    182 # endif 
    183154 
    184155              ! Total grazing ( grazing by microzoo is already computed in p4zmicro ) 
    185               IF( lk_iomput )  zgrazing(ji,jj,jk) = zgraztot 
     156              zgrazing(ji,jj,jk) = zgraztot 
    186157 
    187158              !    Mesozooplankton efficiency 
    … …  
    202173               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarsig 
    203174               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem2 - zgrarsig 
     175               ! 
     176               IF( ln_ligand ) tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + (zgrarem2 - zgrarsig) * ldocz 
     177               ! 
    204178               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarsig 
    205179               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer2 
    … …  
    220194               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazf 
    221195 
    222                ! calcite production 
    223                zprcaca = xfracal(ji,jj,jk) * zgrazn 
    224                prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
    225                ! 
    226                zprcaca = part2 * zprcaca 
    227                tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca 
    228                tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca 
    229                tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca 
    230 #if defined key_kriest 
    231               znumpoc = trb(ji,jj,jk,jpnum) / ( trb(ji,jj,jk,jppoc) + rtrn ) 
    232               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortzgoc - zgrazpoc - zgrazffep + zgrapoc2 
    233               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) - zgrazpoc * znumpoc + zgrapoc2 * xkr_dmeso      & 
    234                  &   + zmortzgoc * xkr_dmeso - zgrazffep * znumpoc * wsbio4(ji,jj,jk) / ( wsbio3(ji,jj,jk) + rtrn ) 
    235               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortzgoc - zgrazfffp - zgrazpof    & 
    236                  &                 + zgraztotf * unass2 
    237 #else 
    238196              tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zgrazpoc - zgrazffep + zfrac 
     197              prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zfrac 
     198              conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazpoc - zgrazffep 
    239199              tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zmortzgoc - zgrazffeg + zgrapoc2 - zfrac 
     200              prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zmortzgoc + zgrapoc2 
     201              consgoc(ji,jj,jk) = consgoc(ji,jj,jk) - zgrazffeg - zfrac 
    240202              tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zgrazpof - zgrazfffp + zfracfe 
    241203              tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + ferat3 * zmortzgoc - zgrazfffg     & 
    242204                 &                + zgraztotf * unass2 - zfracfe 
    243 #endif 
     205              zfracal = trb(ji,jj,jk,jpcal) / (trb(ji,jj,jk,jppoc) + trb(ji,jj,jk,jpgoc) + rtrn ) 
     206              zgrazcal = (zgrazffeg + zgrazpoc) * (1. - part2) * zfracal 
     207              ! calcite production 
     208              zprcaca = xfracal(ji,jj,jk) * zgrazn 
     209              prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
     210              ! 
     211              zprcaca = part2 * zprcaca 
     212              tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrazcal - zprcaca 
     213              tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * ( zgrazcal + zprcaca ) 
     214              tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) - zgrazcal + zprcaca 
    244215            END DO 
    245216         END DO 
    … …  
    265236      ENDIF 
    266237      ! 
    267       IF( lk_iomput )  CALL wrk_dealloc( jpi, jpj, jpk, zgrazing ) 
     238      CALL wrk_dealloc( jpi, jpj, jpk, zgrazing ) 
    268239      ! 
    269240      IF( nn_timing == 1 )  CALL timing_stop('p4z_meso') 
    … …  
    285256      !!---------------------------------------------------------------------- 
    286257 
    287       NAMELIST/nampismes/ part2, grazrat2, resrat2, mzrat2, xprefc, xprefp, xprefz,   & 
     258      NAMELIST/namp4zmes/ part2, grazrat2, resrat2, mzrat2, xprefc, xprefp, xprefz,   & 
    288259         &                xprefpoc, xthresh2dia, xthresh2phy, xthresh2zoo, xthresh2poc, & 
    289260         &                xthresh2, xkgraz2, epsher2, sigma2, unass2, grazflux 
    … …  
    291262 
    292263      REWIND( numnatp_ref )              ! Namelist nampismes in reference namelist : Pisces mesozooplankton 
    293       READ  ( numnatp_ref, nampismes, IOSTAT = ios, ERR = 901) 
    294 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismes in reference namelist', lwp ) 
     264      READ  ( numnatp_ref, namp4zmes, IOSTAT = ios, ERR = 901) 
     265901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zmes in reference namelist', lwp ) 
    295266 
    296267      REWIND( numnatp_cfg )              ! Namelist nampismes in configuration namelist : Pisces mesozooplankton 
    297       READ  ( numnatp_cfg, nampismes, IOSTAT = ios, ERR = 902 ) 
    298 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismes in configuration namelist', lwp ) 
    299       IF(lwm) WRITE ( numonp, nampismes ) 
     268      READ  ( numnatp_cfg, namp4zmes, IOSTAT = ios, ERR = 902 ) 
     269902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zmes in configuration namelist', lwp ) 
     270      IF(lwm) WRITE ( numonp, namp4zmes ) 
    300271 
    301272 
    302273      IF(lwp) THEN                         ! control print 
    303274         WRITE(numout,*) ' '  
    304          WRITE(numout,*) ' Namelist parameters for mesozooplankton, nampismes' 
     275         WRITE(numout,*) ' Namelist parameters for mesozooplankton, namp4zmes' 
    305276         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    306277         WRITE(numout,*) '    part of calcite not dissolved in mesozoo guts  part2        =', part2 
    … …  
    327298   END SUBROUTINE p4z_meso_init 
    328299 
    329  
    330 #else 
    331    !!====================================================================== 
    332    !!  Dummy module :                                   No PISCES bio-model 
    333    !!====================================================================== 
    334 CONTAINS 
    335    SUBROUTINE p4z_meso                    ! Empty routine 
    336    END SUBROUTINE p4z_meso 
    337 #endif  
    338  
    339300   !!====================================================================== 
    340301END MODULE p4zmeso 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmicro.F90

    r5836 r7646  
    88   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Quota model for iron 
    99   !!---------------------------------------------------------------------- 
    10 #if defined key_pisces 
    11    !!---------------------------------------------------------------------- 
    12    !!   'key_pisces'                                       PISCES bio-model 
    13    !!---------------------------------------------------------------------- 
    1410   !!   p4z_micro       :   Compute the sources/sinks for microzooplankton 
    1511   !!   p4z_micro_init  :   Initialize and read the appropriate namelist 
    … …  
    1915   USE sms_pisces      !  PISCES Source Minus Sink variables 
    2016   USE p4zlim          !  Co-limitations 
    21    USE p4zsink         !  vertical flux of particulate matter due to sinking 
    22    USE p4zint          !  interpolation and computation of various fields 
    2317   USE p4zprod         !  production 
    2418   USE iom             !  I/O manager 
    … …  
    7165      REAL(wp) :: zcompadi, zcompaz , zcompaph, zcompapoc 
    7266      REAL(wp) :: zgraze  , zdenom, zdenom2 
    73       REAL(wp) :: zfact   , zstep, zfood, zfoodlim 
     67      REAL(wp) :: zfact   , zfood, zfoodlim 
    7468      REAL(wp) :: zepshert, zepsherv, zgrarsig, zgraztot, zgraztotn, zgraztotf 
    7569      REAL(wp) :: zgrarem, zgrafer, zgrapoc, zprcaca, zmortz 
    … …  
    8377      IF( nn_timing == 1 )  CALL timing_start('p4z_micro') 
    8478      ! 
    85       IF( lk_iomput )  CALL wrk_alloc( jpi, jpj, jpk, zgrazing ) 
     79      CALL wrk_alloc( jpi, jpj, jpk, zgrazing ) 
    8680      ! 
    8781      DO jk = 1, jpkm1 
    … …  
    8983            DO ji = 1, jpi 
    9084               zcompaz = MAX( ( trb(ji,jj,jk,jpzoo) - 1.e-9 ), 0.e0 ) 
    91                zstep   = xstep 
    92 # if defined key_degrad 
    93                zstep = zstep * facvol(ji,jj,jk) 
    94 # endif 
    95                zfact   = zstep * tgfunc2(ji,jj,jk) * zcompaz 
     85               zfact   = xstep * tgfunc2(ji,jj,jk) * zcompaz 
    9686 
    9787               !  Respiration rates of both zooplankton 
    … …  
    115105               zdenom    = zfoodlim / ( xkgraz + zfoodlim ) 
    116106               zdenom2   = zdenom / ( zfood + rtrn ) 
    117                zgraze    = grazrat * zstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpzoo)  
     107               zgraze    = grazrat * xstep * tgfunc2(ji,jj,jk) * trb(ji,jj,jk,jpzoo)  
    118108 
    119109               zgrazp    = zgraze  * xpref2p * zcompaph  * zdenom2  
    … …  
    130120 
    131121               ! Grazing by microzooplankton 
    132                IF( ln_diatrc .AND. lk_iomput )  zgrazing(ji,jj,jk) = zgraztot 
     122               zgrazing(ji,jj,jk) = zgraztot 
    133123 
    134124               !    Various remineralization and excretion terms 
    … …  
    148138               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarsig 
    149139               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem - zgrarsig 
     140               ! 
     141               IF( ln_ligand ) tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + (zgrarem - zgrarsig) * ldocz 
     142               ! 
    150143               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarsig 
    151144               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer 
    152145               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc 
     146               prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zgrapoc 
    153147               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zgraztotf * unass 
    154148               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarsig 
    155149               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zgrarsig 
    156 #if defined key_kriest 
    157                tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc * xkr_dmicro 
    158 #endif 
    159150               !   Update the arrays TRA which contain the biological sources and sinks 
    160151               !   -------------------------------------------------------------------- 
    … …  
    170161               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazsf 
    171162               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortz - zgrazm 
     163               prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + zmortz 
     164               conspoc(ji,jj,jk) = conspoc(ji,jj,jk) - zgrazm 
    172165               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz - zgrazmf 
    173166               ! 
    … …  
    180173               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca 
    181174               tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca 
    182 #if defined key_kriest 
    183                tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zmortz * xkr_dmicro & 
    184                                                          - zgrazm * trb(ji,jj,jk,jpnum) / ( trb(ji,jj,jk,jppoc) + rtrn ) 
    185 #endif 
    186175            END DO 
    187176         END DO 
    188177      END DO 
    189178      ! 
    190       IF( lk_iomput .AND. knt == nrdttrc ) THEN 
    191          CALL wrk_alloc( jpi, jpj, jpk, zw3d ) 
    192          IF( iom_use( "GRAZ1" ) ) THEN 
    193             zw3d(:,:,:) = zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:)  !  Total grazing of phyto by zooplankton 
    194             CALL iom_put( "GRAZ1", zw3d ) 
     179      IF( lk_iomput ) THEN 
     180         IF( knt == nrdttrc ) THEN 
     181           CALL wrk_alloc( jpi, jpj, jpk, zw3d ) 
     182           IF( iom_use( "GRAZ1" ) ) THEN 
     183              zw3d(:,:,:) = zgrazing(:,:,:) * 1.e+3 * rfact2r * tmask(:,:,:)  !  Total grazing of phyto by zooplankton 
     184              CALL iom_put( "GRAZ1", zw3d ) 
     185           ENDIF 
     186           CALL wrk_dealloc( jpi, jpj, jpk, zw3d ) 
    195187         ENDIF 
    196          CALL wrk_dealloc( jpi, jpj, jpk, zw3d ) 
    197188      ENDIF 
    198189      ! 
    … …  
    203194      ENDIF 
    204195      ! 
    205       IF( lk_iomput )  CALL wrk_dealloc( jpi, jpj, jpk, zgrazing ) 
     196      CALL wrk_dealloc( jpi, jpj, jpk, zgrazing ) 
    206197      ! 
    207198      IF( nn_timing == 1 )  CALL timing_stop('p4z_micro') 
    … …  
    224215      !!---------------------------------------------------------------------- 
    225216 
    226       NAMELIST/nampiszoo/ part, grazrat, resrat, mzrat, xpref2c, xpref2p, & 
     217      NAMELIST/namp4zzoo/ part, grazrat, resrat, mzrat, xpref2c, xpref2p, & 
    227218         &                xpref2d,  xthreshdia,  xthreshphy,  xthreshpoc, & 
    228219         &                xthresh, xkgraz, epsher, sigma1, unass 
    … …  
    230221 
    231222      REWIND( numnatp_ref )              ! Namelist nampiszoo in reference namelist : Pisces microzooplankton 
    232       READ  ( numnatp_ref, nampiszoo, IOSTAT = ios, ERR = 901) 
    233 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampiszoo in reference namelist', lwp ) 
     223      READ  ( numnatp_ref, namp4zzoo, IOSTAT = ios, ERR = 901) 
     224901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zzoo in reference namelist', lwp ) 
    234225 
    235226      REWIND( numnatp_cfg )              ! Namelist nampiszoo in configuration namelist : Pisces microzooplankton 
    236       READ  ( numnatp_cfg, nampiszoo, IOSTAT = ios, ERR = 902 ) 
    237 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampiszoo in configuration namelist', lwp ) 
    238       IF(lwm) WRITE ( numonp, nampiszoo ) 
     227      READ  ( numnatp_cfg, namp4zzoo, IOSTAT = ios, ERR = 902 ) 
     228902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zzoo in configuration namelist', lwp ) 
     229      IF(lwm) WRITE ( numonp, namp4zzoo ) 
    239230 
    240231      IF(lwp) THEN                         ! control print 
    241232         WRITE(numout,*) ' ' 
    242          WRITE(numout,*) ' Namelist parameters for microzooplankton, nampiszoo' 
     233         WRITE(numout,*) ' Namelist parameters for microzooplankton, namp4zzoo' 
    243234         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    244235         WRITE(numout,*) '    part of calcite not dissolved in microzoo guts  part        =', part 
    … …  
    261252   END SUBROUTINE p4z_micro_init 
    262253 
    263 #else 
    264    !!====================================================================== 
    265    !!  Dummy module :                                   No PISCES bio-model 
    266    !!====================================================================== 
    267 CONTAINS 
    268    SUBROUTINE p4z_micro                    ! Empty routine 
    269    END SUBROUTINE p4z_micro 
    270 #endif  
    271  
    272254   !!====================================================================== 
    273255END MODULE p4zmicro 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zmort.F90

    r5836 r7646  
    77   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
    88   !!---------------------------------------------------------------------- 
    9 #if defined key_pisces 
    10    !!---------------------------------------------------------------------- 
    11    !!   'key_pisces'                                       PISCES bio-model 
    12    !!---------------------------------------------------------------------- 
    139   !!   p4z_mort       :   Compute the mortality terms for phytoplankton 
    1410   !!   p4z_mort_init  :   Initialize the mortality params for phytoplankton 
    … …  
    1713   USE trc             !  passive tracers common variables  
    1814   USE sms_pisces      !  PISCES Source Minus Sink variables 
    19    USE p4zsink         !  vertical flux of particulate matter due to sinking 
    2015   USE p4zprod         !  Primary productivity  
     16   USE p4zlim          !  Phytoplankton limitation terms 
    2117   USE prtctl_trc      !  print control for debugging 
    2218 
    … …  
    3430   REAL(wp), PUBLIC :: mprat2  !: 
    3531 
    36  
    3732   !!---------------------------------------------------------------------- 
    3833   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    7368      REAL(wp) :: zsizerat, zcompaph 
    7469      REAL(wp) :: zfactfe, zfactch, zprcaca, zfracal 
    75       REAL(wp) :: ztortp , zrespp , zmortp , zstep 
     70      REAL(wp) :: ztortp , zrespp , zmortp  
    7671      CHARACTER (len=25) :: charout 
    7772      !!--------------------------------------------------------------------- 
    … …  
    8479            DO ji = 1, jpi 
    8580               zcompaph = MAX( ( trb(ji,jj,jk,jpphy) - 1e-8 ), 0.e0 ) 
    86                zstep    = xstep 
    87 # if defined key_degrad 
    88                zstep    = zstep * facvol(ji,jj,jk) 
    89 # endif 
    9081               !     When highly limited by macronutrients, very small cells  
    9182               !     dominate the community. As a consequence, aggregation 
    … …  
    9586               !     Squared mortality of Phyto similar to a sedimentation term during 
    9687               !     blooms (Doney et al. 1996) 
    97                zrespp = wchl * 1.e6 * zstep * xdiss(ji,jj,jk) * zcompaph * zsizerat  
     88               zrespp = wchl * 1.e6 * xstep * xdiss(ji,jj,jk) * zcompaph * zsizerat  
    9889 
    9990               !     Phytoplankton mortality. This mortality loss is slightly 
    … …  
    119110               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca 
    120111               tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) + zprcaca 
    121 #if defined key_kriest 
    122                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortp 
    123                tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + ztortp * xkr_dnano + zrespp * xkr_ddiat 
    124                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zmortp * zfactfe 
    125 #else 
    126112               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zfracal * zmortp 
    127113               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + ( 1. - zfracal ) * zmortp 
     114               prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + ( 1. - zfracal ) * zmortp 
     115               prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zfracal * zmortp 
    128116               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ( 1. - zfracal ) * zmortp * zfactfe 
    129117               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zfracal * zmortp * zfactfe 
    130 #endif 
    131118            END DO 
    132119         END DO 
    … …  
    153140      INTEGER  ::  ji, jj, jk 
    154141      REAL(wp) ::  zfactfe,zfactsi,zfactch, zcompadi 
    155       REAL(wp) ::  zrespp2, ztortp2, zmortp2, zstep 
     142      REAL(wp) ::  zrespp2, ztortp2, zmortp2 
    156143      REAL(wp) ::  zlim2, zlim1 
    157144      CHARACTER (len=25) :: charout 
    … …  
    176163               !    sticky and coagulate to sink quickly out of the euphotic zone 
    177164               !     ------------------------------------------------------------ 
    178                zstep   = xstep 
    179 # if defined key_degrad 
    180                zstep = zstep * facvol(ji,jj,jk) 
    181 # endif 
    182165               !  Phytoplankton respiration  
    183166               !     ------------------------ 
    184167               zlim2   = xlimdia(ji,jj,jk) * xlimdia(ji,jj,jk) 
    185168               zlim1   = 0.25 * ( 1. - zlim2 ) / ( 0.25 + zlim2 )  
    186                zrespp2 = 1.e6 * zstep * (  wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * trb(ji,jj,jk,jpdia) 
     169               zrespp2 = 1.e6 * xstep * (  wchld + wchldm * zlim1 ) * xdiss(ji,jj,jk) * zcompadi * trb(ji,jj,jk,jpdia) 
    187170 
    188171               !     Phytoplankton mortality.  
    189172               !     ------------------------ 
    190                ztortp2 = mprat2 * zstep * trb(ji,jj,jk,jpdia)  / ( xkmort + trb(ji,jj,jk,jpdia) ) * zcompadi  
     173               ztortp2 = mprat2 * xstep * trb(ji,jj,jk,jpdia)  / ( xkmort + trb(ji,jj,jk,jpdia) ) * zcompadi  
    191174 
    192175               zmortp2 = zrespp2 + ztortp2 
    … …  
    202185               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zmortp2 * zfactsi 
    203186               tra(ji,jj,jk,jpgsi) = tra(ji,jj,jk,jpgsi) + zmortp2 * zfactsi 
    204 #if defined key_kriest 
    205                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortp2   
    206                tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + ztortp2 * xkr_ddiat + zrespp2 * xkr_daggr 
    207                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zmortp2 * zfactfe 
    208 #else 
    209187               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zrespp2 + 0.5 * ztortp2 
    210188               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + 0.5 * ztortp2 
     189               prodpoc(ji,jj,jk) = prodpoc(ji,jj,jk) + 0.5 * ztortp2 
     190               prodgoc(ji,jj,jk) = prodgoc(ji,jj,jk) + zrespp2 + 0.5 * ztortp2 
    211191               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + 0.5 * ztortp2 * zfactfe 
    212192               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + ( zrespp2 + 0.5 * ztortp2 ) * zfactfe 
    213 #endif 
    214193            END DO 
    215194         END DO 
    … …  
    240219      !!---------------------------------------------------------------------- 
    241220 
    242       NAMELIST/nampismort/ wchl, wchld, wchldm, mprat, mprat2 
     221      NAMELIST/namp4zmort/ wchl, wchld, wchldm, mprat, mprat2 
    243222      INTEGER :: ios                 ! Local integer output status for namelist read 
    244223 
    245224      REWIND( numnatp_ref )              ! Namelist nampismort in reference namelist : Pisces phytoplankton 
    246       READ  ( numnatp_ref, nampismort, IOSTAT = ios, ERR = 901) 
    247 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismort in reference namelist', lwp ) 
     225      READ  ( numnatp_ref, namp4zmort, IOSTAT = ios, ERR = 901) 
     226901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zmort in reference namelist', lwp ) 
    248227 
    249228      REWIND( numnatp_cfg )              ! Namelist nampismort in configuration namelist : Pisces phytoplankton 
    250       READ  ( numnatp_cfg, nampismort, IOSTAT = ios, ERR = 902 ) 
    251 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismort in configuration namelist', lwp ) 
    252       IF(lwm) WRITE ( numonp, nampismort ) 
     229      READ  ( numnatp_cfg, namp4zmort, IOSTAT = ios, ERR = 902 ) 
     230902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zmort in configuration namelist', lwp ) 
     231      IF(lwm) WRITE ( numonp, namp4zmort ) 
    253232 
    254233      IF(lwp) THEN                         ! control print 
    255234         WRITE(numout,*) ' ' 
    256          WRITE(numout,*) ' Namelist parameters for phytoplankton mortality, nampismort' 
     235         WRITE(numout,*) ' Namelist parameters for phytoplankton mortality, namp4zmort' 
    257236         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    258237         WRITE(numout,*) '    quadratic mortality of phytoplankton      wchl      =', wchl 
    … …  
    265244   END SUBROUTINE p4z_mort_init 
    266245 
    267 #else 
    268    !!====================================================================== 
    269    !!  Dummy module :                                   No PISCES bio-model 
    270    !!====================================================================== 
    271 CONTAINS 
    272    SUBROUTINE p4z_mort                    ! Empty routine 
    273    END SUBROUTINE p4z_mort 
    274 #endif  
    275  
    276246   !!====================================================================== 
    277247END MODULE p4zmort 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zopt.F90

    r6962 r7646  
    99   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Improve light availability of nano & diat 
    1010   !!---------------------------------------------------------------------- 
    11 #if defined  key_pisces 
    12    !!---------------------------------------------------------------------- 
    13    !!   'key_pisces'                                       PISCES bio-model 
    14    !!---------------------------------------------------------------------- 
    1511   !!   p4z_opt       : light availability in the water column 
    1612   !!---------------------------------------------------------------------- 
    … …  
    4137   INTEGER  :: ntimes_par                ! number of time steps in a file 
    4238   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:) :: par_varsw    !: PAR fraction of shortwave 
    43  
    44    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: enano, ediat   !: PAR for phyto, nano and diat  
    45    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: etot_ndcy      !: PAR over 24h in case of diurnal cycle 
    46    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: emoy           !: averaged PAR in the mixed layer 
    47    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ekb, ekg, ekr  !: wavelength (Red-Green-Blue) 
     39   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ekb, ekg, ekr  !: wavelength (Red-Green-Blue) 
    4840 
    4941   INTEGER  ::   nksrp   ! levels below which the light cannot penetrate ( depth larger than 391 m) 
    5042 
    51    REAL(wp), DIMENSION(3,61), PUBLIC ::   xkrgb   !: tabulated attenuation coefficients for RGB absorption 
     43   REAL(wp), DIMENSION(3,61) ::   xkrgb   !: tabulated attenuation coefficients for RGB absorption 
    5244    
    5345   !!---------------------------------------------------------------------- 
    … …  
    7567      REAL(wp) ::   zc0 , zc1 , zc2, zc3, z1_dep 
    7668      REAL(wp), POINTER, DIMENSION(:,:  ) :: zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 
     69      REAL(wp), POINTER, DIMENSION(:,:  ) :: zetmp5 
    7770      REAL(wp), POINTER, DIMENSION(:,:  ) :: zqsr100, zqsr_corr 
    78       REAL(wp), POINTER, DIMENSION(:,:,:) :: zpar, ze0, ze1, ze2, ze3 
     71      REAL(wp), POINTER, DIMENSION(:,:,:) :: zpar, ze0, ze1, ze2, ze3, zchl3d 
    7972      !!--------------------------------------------------------------------- 
    8073      ! 
    … …  
    8275      ! 
    8376      ! Allocate temporary workspace 
    84       CALL wrk_alloc( jpi, jpj,      zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 ) 
    85       CALL wrk_alloc( jpi, jpj,      zqsr100, zqsr_corr ) 
    86       CALL wrk_alloc( jpi, jpj, jpk, zpar   , ze0, ze1, ze2, ze3 ) 
     77                   CALL wrk_alloc( jpi, jpj,      zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 ) 
     78                   CALL wrk_alloc( jpi, jpj,      zqsr100, zqsr_corr ) 
     79      IF( ln_p5z ) CALL wrk_alloc( jpi, jpj,      zetmp5 ) 
     80                   CALL wrk_alloc( jpi, jpj, jpk, zpar   , ze0, ze1, ze2, ze3, zchl3d ) 
    8781 
    8882      IF( knt == 1 .AND. ln_varpar ) CALL p4z_opt_sbc( kt ) 
    … …  
    9387      ze2(:,:,:) = 0._wp 
    9488      ze3(:,:,:) = 0._wp 
     89      ! 
    9590      !                                        !* attenuation coef. function of Chlorophyll and wavelength (Red-Green-Blue) 
    96       DO jk = 1, jpkm1                         !  -------------------------------------------------------- 
     91                                               !  -------------------------------------------------------- 
     92                    zchl3d(:,:,:) = trb(:,:,:,jpnch) + trb(:,:,:,jpdch) 
     93      IF( ln_p5z )  zchl3d(:,:,:) = zchl3d(:,:,:) + trb(:,:,:,jppch) 
     94      ! 
     95      DO jk = 1, jpkm1    
    9796         DO jj = 1, jpj 
    9897            DO ji = 1, jpi 
    99                zchl = ( trb(ji,jj,jk,jpnch) + trb(ji,jj,jk,jpdch) + rtrn ) * 1.e6 
     98               zchl = ( zchl3d(ji,jj,jk) + rtrn ) * 1.e6 
    10099               zchl = MIN(  10. , MAX( 0.05, zchl )  ) 
    101100               irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn ) 
    … …  
    120119            ediat    (:,:,jk) =  1.6 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.7 * ze3(:,:,jk) 
    121120         END DO 
     121         IF( ln_p5z ) THEN 
     122            DO jk = 1, nksrp       
     123              epico  (:,:,jk) =  2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk) 
     124            END DO 
     125         ENDIF 
    122126         ! 
    123127         zqsr_corr(:,:) = qsr(:,:) / ( 1. - fr_i(:,:) + rtrn ) 
    … …  
    140144            ediat(:,:,jk) =  1.6 * ze1(:,:,jk) + 0.69 * ze2(:,:,jk) + 0.7 * ze3(:,:,jk) 
    141145         END DO 
     146         IF( ln_p5z ) THEN 
     147            DO jk = 1, nksrp       
     148              epico(:,:,jk) =  2.1 * ze1(:,:,jk) + 0.42 * ze2(:,:,jk) + 0.4 * ze3(:,:,jk) 
     149            END DO 
     150         ENDIF 
    142151         etot_ndcy(:,:,:) =  etot(:,:,:)  
    143152      ENDIF 
    … …  
    155164      ENDIF 
    156165      !                                        !* Euphotic depth and level 
    157       neln(:,:) = 1                            !  ------------------------ 
    158       heup(:,:) = 300. 
     166      neln   (:,:) = 1                            !  ------------------------ 
     167      heup   (:,:) = gdepw_n(:,:,2) 
     168      heup_01(:,:) = gdepw_n(:,:,2) 
    159169 
    160170      DO jk = 2, nksrp 
    … …  
    166176                 heup(ji,jj) = gdepw_n(ji,jj,jk+1)     ! Euphotic layer depth 
    167177              ENDIF 
     178              IF( etot_ndcy(ji,jj,jk) * tmask(ji,jj,jk) >= 0.50 )  THEN 
     179                 heup_01(ji,jj) = gdepw_n(ji,jj,jk+1)  ! Euphotic layer depth (light level definition) 
     180              ENDIF 
    168181           END DO 
    169182        END DO 
    170183      END DO 
    171184      ! 
    172       heup(:,:) = MIN( 300., heup(:,:) ) 
     185      heup   (:,:) = MIN( 300., heup   (:,:) ) 
     186      heup_01(:,:) = MIN( 300., heup_01(:,:) ) 
    173187      !                                        !* mean light over the mixed layer 
    174188      zdepmoy(:,:)   = 0.e0                    !  ------------------------------- 
    … …  
    209223      END DO 
    210224      ! 
     225      IF( ln_p5z ) THEN 
     226         zetmp5 (:,:) = 0.e0 
     227         DO jk = 1, nksrp 
     228            DO jj = 1, jpj 
     229               DO ji = 1, jpi 
     230                  IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN  
     231                     z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 
     232                     zetmp5(ji,jj)  = zetmp5 (ji,jj) + epico(ji,jj,jk) * e3t_n(ji,jj,jk) ! production 
     233                     epico(ji,jj,jk) = zetmp5(ji,jj) * z1_dep 
     234                  ENDIF 
     235               END DO 
     236            END DO 
     237         END DO 
     238      ENDIF 
    211239      IF( lk_iomput ) THEN 
    212240        IF( knt == nrdttrc ) THEN 
    … …  
    215243           IF( iom_use( "PAR"   ) ) CALL iom_put( "PAR"  , emoy(:,:,:) * tmask(:,:,:) )  ! Photosynthetically Available Radiation 
    216244        ENDIF 
    217       ELSE 
    218          IF( ln_diatrc ) THEN        ! save output diagnostics 
    219             trc2d(:,:,  jp_pcs0_2d + 10) = heup(:,:  ) * tmask(:,:,1) 
    220             trc3d(:,:,:,jp_pcs0_3d + 3)  = etot(:,:,:) * tmask(:,:,:) 
    221          ENDIF 
    222       ENDIF 
    223       ! 
    224       CALL wrk_dealloc( jpi, jpj,      zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 ) 
    225       CALL wrk_dealloc( jpi, jpj,      zqsr100, zqsr_corr ) 
    226       CALL wrk_dealloc( jpi, jpj, jpk, zpar   ,  ze0, ze1, ze2, ze3 ) 
     245      ENDIF 
     246      ! 
     247                   CALL wrk_dealloc( jpi, jpj,      zdepmoy, zetmp1, zetmp2, zetmp3, zetmp4 ) 
     248                   CALL wrk_dealloc( jpi, jpj,      zqsr100, zqsr_corr ) 
     249      IF( ln_p5z ) CALL wrk_dealloc( jpi, jpj,      zetmp5 ) 
     250                   CALL wrk_dealloc( jpi, jpj, jpk, zpar   ,  ze0, ze1, ze2, ze3, zchl3d ) 
    227251      ! 
    228252      IF( nn_timing == 1 )  CALL timing_stop('p4z_opt') 
    … …  
    407431                         enano    (:,:,:) = 0._wp 
    408432                         ediat    (:,:,:) = 0._wp 
     433      IF( ln_p5z     )   epico    (:,:,:) = 0._wp 
    409434      IF( ln_qsr_bio )   etot3    (:,:,:) = 0._wp 
    410435      !  
    … …  
    418443      !!                     ***  ROUTINE p4z_opt_alloc  *** 
    419444      !!---------------------------------------------------------------------- 
    420       ALLOCATE( ekb(jpi,jpj,jpk)      , ekr(jpi,jpj,jpk), ekg(jpi,jpj,jpk),   & 
    421         &       enano(jpi,jpj,jpk)    , ediat(jpi,jpj,jpk), & 
    422         &       etot_ndcy(jpi,jpj,jpk), emoy (jpi,jpj,jpk), STAT=p4z_opt_alloc )  
    423          ! 
     445      ! 
     446      ALLOCATE( ekb(jpi,jpj,jpk), ekr(jpi,jpj,jpk), & 
     447                ekg(jpi,jpj,jpk), STAT= p4z_opt_alloc )  
     448      ! 
    424449      IF( p4z_opt_alloc /= 0 ) CALL ctl_warn('p4z_opt_alloc : failed to allocate arrays.') 
    425450      ! 
    426451   END FUNCTION p4z_opt_alloc 
    427  
    428 #else 
    429    !!---------------------------------------------------------------------- 
    430    !!  Dummy module :                                   No PISCES bio-model 
    431    !!---------------------------------------------------------------------- 
    432 CONTAINS 
    433    SUBROUTINE p4z_opt                   ! Empty routine 
    434    END SUBROUTINE p4z_opt 
    435 #endif  
    436452 
    437453   !!====================================================================== 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zprod.F90

    r6945 r7646  
    88   !!             3.4  !  2011-05  (O. Aumont, C. Ethe) New parameterization of light limitation 
    99   !!---------------------------------------------------------------------- 
    10 #if defined key_pisces 
    11    !!---------------------------------------------------------------------- 
    12    !!   'key_pisces'                                       PISCES bio-model 
    13    !!---------------------------------------------------------------------- 
    1410   !!   p4z_prod       :   Compute the growth Rate of the two phytoplanktons groups 
    1511   !!   p4z_prod_init  :   Initialization of the parameters for growth 
    … …  
    1915   USE trc             !  passive tracers common variables  
    2016   USE sms_pisces      !  PISCES Source Minus Sink variables 
    21    USE p4zopt          !  optical model 
    2217   USE p4zlim          !  Co-limitations of differents nutrients 
    2318   USE prtctl_trc      !  print control for debugging 
    … …  
    3328   !! * Shared module variables 
    3429   LOGICAL , PUBLIC ::  ln_newprod      !: 
    35    REAL(wp), PUBLIC ::  pislope         !: 
    36    REAL(wp), PUBLIC ::  pislope2        !: 
     30   REAL(wp), PUBLIC ::  pislopen         !: 
     31   REAL(wp), PUBLIC ::  pisloped        !: 
    3732   REAL(wp), PUBLIC ::  xadap           !: 
    38    REAL(wp), PUBLIC ::  excret          !: 
    39    REAL(wp), PUBLIC ::  excret2         !: 
     33   REAL(wp), PUBLIC ::  excretn          !: 
     34   REAL(wp), PUBLIC ::  excretd         !: 
    4035   REAL(wp), PUBLIC ::  bresp           !: 
    4136   REAL(wp), PUBLIC ::  chlcnm          !: 
    … …  
    5146    
    5247   REAL(wp) :: r1_rday                !: 1 / rday 
    53    REAL(wp) :: texcret                !: 1 - excret  
    54    REAL(wp) :: texcret2               !: 1 - excret2         
     48   REAL(wp) :: texcretn               !: 1 - excretn  
     49   REAL(wp) :: texcretd               !: 1 - excretd         
    5550 
    5651   !!---------------------------------------------------------------------- 
    … …  
    7570      INTEGER  ::   ji, jj, jk 
    7671      REAL(wp) ::   zsilfac, znanotot, zdiattot, zconctemp, zconctemp2 
    77       REAL(wp) ::   zratio, zmax, zsilim, ztn, zadap 
    78       REAL(wp) ::   zlim, zsilfac2, zsiborn, zprod, zproreg, zproreg2 
    79       REAL(wp) ::   zmxltst, zmxlday, zmaxday 
    80       REAL(wp) ::   zpislopen  , zpislope2n 
    81       REAL(wp) ::   zrum, zcodel, zargu, zval 
     72      REAL(wp) ::   zratio, zmax, zsilim, ztn, zadap, zlim, zsilfac2, zsiborn 
     73      REAL(wp) ::   zprod, zproreg, zproreg2, zprochln, zprochld 
     74      REAL(wp) ::   zmaxday, zdocprod, zpislopen, zpisloped 
     75      REAL(wp) ::   zmxltst, zmxlday 
     76      REAL(wp) ::   zrum, zcodel, zargu, zval, zfeup, chlcnm_n, chlcdm_n 
    8277      REAL(wp) ::   zfact 
    8378      CHARACTER (len=25) :: charout 
    84       REAL(wp), POINTER, DIMENSION(:,:  ) :: zmixnano, zmixdiat, zstrn, zw2d 
    85       REAL(wp), POINTER, DIMENSION(:,:,:) :: zpislopead, zpislopead2, zprdia, zprbio, zprdch, zprnch, zysopt, zw3d    
    86       REAL(wp), POINTER, DIMENSION(:,:,:) :: zprorca, zprorcad, zprofed, zprofen, zprochln, zprochld, zpronew, zpronewd 
     79      REAL(wp), POINTER, DIMENSION(:,:  ) :: zstrn, zw2d, zmixnano, zmixdiat 
     80      REAL(wp), POINTER, DIMENSION(:,:,:) :: zpislopeadn, zpislopeadd, zysopt, zw3d    
     81      REAL(wp), POINTER, DIMENSION(:,:,:) :: zprdia, zprbio, zprdch, zprnch    
     82      REAL(wp), POINTER, DIMENSION(:,:,:) :: zprorcan, zprorcad, zprofed, zprofen 
     83      REAL(wp), POINTER, DIMENSION(:,:,:) :: zpronewn, zpronewd 
     84      REAL(wp), POINTER, DIMENSION(:,:,:) :: zmxl_fac, zmxl_chl 
    8785      !!--------------------------------------------------------------------- 
    8886      ! 
    … …  
    9088      ! 
    9189      !  Allocate temporary workspace 
    92       CALL wrk_alloc( jpi, jpj,      zmixnano, zmixdiat, zstrn                                                  ) 
    93       CALL wrk_alloc( jpi, jpj, jpk, zpislopead, zpislopead2, zprdia, zprbio, zprdch, zprnch, zysopt            )  
    94       CALL wrk_alloc( jpi, jpj, jpk, zprorca, zprorcad, zprofed, zprofen, zprochln, zprochld, zpronew, zpronewd ) 
    95       ! 
    96       zprorca (:,:,:) = 0._wp 
    97       zprorcad(:,:,:) = 0._wp 
    98       zprofed (:,:,:) = 0._wp 
    99       zprofen (:,:,:) = 0._wp 
    100       zprochln(:,:,:) = 0._wp 
    101       zprochld(:,:,:) = 0._wp 
    102       zpronew (:,:,:) = 0._wp 
    103       zpronewd(:,:,:) = 0._wp 
    104       zprdia  (:,:,:) = 0._wp 
    105       zprbio  (:,:,:) = 0._wp 
    106       zprdch  (:,:,:) = 0._wp 
    107       zprnch  (:,:,:) = 0._wp 
    108       zysopt  (:,:,:) = 0._wp 
     90      CALL wrk_alloc( jpi, jpj,      zmixnano, zmixdiat, zstrn ) 
     91      CALL wrk_alloc( jpi, jpj, jpk, zpislopeadn, zpislopeadd, zprdia, zprbio, zprdch, zprnch, zysopt )  
     92      CALL wrk_alloc( jpi, jpj, jpk, zmxl_fac, zmxl_chl ) 
     93      CALL wrk_alloc( jpi, jpj, jpk, zprorcan, zprorcad, zprofed, zprofen, zpronewn, zpronewd ) 
     94      ! 
     95      zprorcan(:,:,:) = 0._wp ; zprorcad(:,:,:) = 0._wp ; zprofed (:,:,:) = 0._wp 
     96      zprofen (:,:,:) = 0._wp ; zysopt  (:,:,:) = 0._wp 
     97      zpronewn(:,:,:) = 0._wp ; zpronewd(:,:,:) = 0._wp ; zprdia  (:,:,:) = 0._wp 
     98      zprbio  (:,:,:) = 0._wp ; zprdch  (:,:,:) = 0._wp ; zprnch  (:,:,:) = 0._wp  
     99      zmxl_fac(:,:,:) = 0._wp ; zmxl_chl(:,:,:) = 0._wp  
    109100 
    110101      ! Computation of the optimal production 
    111       prmax(:,:,:) = 0.6_wp * r1_rday * tgfunc(:,:,:)  
    112       IF( lk_degrad )  prmax(:,:,:) = prmax(:,:,:) * facvol(:,:,:)  
     102      prmax(:,:,:) = 0.8_wp * r1_rday * tgfunc(:,:,:)  
    113103 
    114104      ! compute the day length depending on latitude and the day 
    … …  
    126116      END DO 
    127117 
    128       ! Impact of the day duration on phytoplankton growth 
     118      ! Impact of the day duration and light intermittency on phytoplankton growth 
    129119      DO jk = 1, jpkm1 
    130120         DO jj = 1 ,jpj 
    … …  
    132122               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    133123                  zval = MAX( 1., zstrn(ji,jj) ) 
    134                   zval = 1.5 * zval / ( 12. + zval ) 
    135                   zprbio(ji,jj,jk) = prmax(ji,jj,jk) * zval * ( 1. - fr_i(ji,jj) ) 
    136                   zprdia(ji,jj,jk) = zprbio(ji,jj,jk) 
     124                  IF( gdept_n(ji,jj,jk) <= hmld(ji,jj) ) THEN 
     125                     zval = zval * MIN(1., heup_01(ji,jj) / ( hmld(ji,jj) + rtrn )) 
     126                  ENDIF 
     127                  zmxl_chl(ji,jj,jk) = zval / 24. 
     128                  zmxl_fac(ji,jj,jk) = 1.5 * zval / ( 12. + zval ) 
    137129               ENDIF 
    138130            END DO 
    139131         END DO 
    140132      END DO 
     133 
     134      zprbio(:,:,:) = prmax(:,:,:) * zmxl_fac(:,:,:) 
     135      zprdia(:,:,:) = zprbio(:,:,:) 
    141136 
    142137      ! Maximum light intensity 
    143138      WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24. 
    144       zstrn(:,:) = 24. / zstrn(:,:) 
     139 
     140      ! Computation of the P-I slope for nanos and diatoms 
     141      DO jk = 1, jpkm1 
     142         DO jj = 1, jpj 
     143            DO ji = 1, jpi 
     144               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     145                  ztn         = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 
     146                  zadap       = xadap * ztn / ( 2.+ ztn ) 
     147                  zconctemp   = MAX( 0.e0 , trb(ji,jj,jk,jpdia) - xsizedia ) 
     148                  zconctemp2  = trb(ji,jj,jk,jpdia) - zconctemp 
     149                  ! 
     150                  zpislopeadn(ji,jj,jk) = pislopen * ( 1.+ zadap  * EXP( -0.25 * enano(ji,jj,jk) ) )  & 
     151                  &                   * trb(ji,jj,jk,jpnch) /( trb(ji,jj,jk,jpphy) * 12. + rtrn) 
     152                  ! 
     153                  zpislopeadd(ji,jj,jk) = (pislopen * zconctemp2 + pisloped * zconctemp) / ( trb(ji,jj,jk,jpdia) + rtrn )   & 
     154                  &                   * trb(ji,jj,jk,jpdch) /( trb(ji,jj,jk,jpdia) * 12. + rtrn) 
     155               ENDIF 
     156            END DO 
     157         END DO 
     158      END DO 
    145159 
    146160      IF( ln_newprod ) THEN 
    … …  
    148162            DO jj = 1, jpj 
    149163               DO ji = 1, jpi 
    150                   ! Computation of the P-I slope for nanos and diatoms 
    151164                  IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    152                       ztn         = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 
    153                       zadap       = xadap * ztn / ( 2.+ ztn ) 
    154                       zconctemp   = MAX( 0.e0 , trb(ji,jj,jk,jpdia) - xsizedia ) 
    155                       zconctemp2  = trb(ji,jj,jk,jpdia) - zconctemp 
    156                       znanotot    = enano(ji,jj,jk) * zstrn(ji,jj) 
    157                       zdiattot    = ediat(ji,jj,jk) * zstrn(ji,jj) 
    158                       ! 
    159                       zpislopead (ji,jj,jk) = pislope * ( 1.+ zadap  * EXP( -znanotot ) )  & 
    160                          &                   * trb(ji,jj,jk,jpnch) /( trb(ji,jj,jk,jpphy) * 12. + rtrn) 
    161                       ! 
    162                       zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp) / ( trb(ji,jj,jk,jpdia) + rtrn )   & 
    163                          &                   * trb(ji,jj,jk,jpdch) /( trb(ji,jj,jk,jpdia) * 12. + rtrn) 
    164  
    165165                      ! Computation of production function for Carbon 
    166166                      !  --------------------------------------------- 
    167                       zpislopen  = zpislopead (ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) * rday + rtrn) 
    168                       zpislope2n = zpislopead2(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) * rday + rtrn) 
    169                       zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen  * znanotot )  ) 
    170                       zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpislope2n * zdiattot )  ) 
    171  
     167                      zpislopen = zpislopeadn(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) & 
     168                      &            * zmxl_fac(ji,jj,jk) * rday + rtrn) 
     169                      zpisloped = zpislopeadd(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday ) & 
     170                      &            * zmxl_fac(ji,jj,jk) * rday + rtrn) 
     171                      zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) )  ) 
     172                      zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) )  ) 
    172173                      !  Computation of production function for Chlorophyll 
    173174                      !-------------------------------------------------- 
    174                       zmaxday  = 1._wp / ( prmax(ji,jj,jk) * rday + rtrn ) 
    175                       zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopead (ji,jj,jk) * zmaxday * znanotot ) ) 
    176                       zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopead2(ji,jj,jk) * zmaxday * zdiattot ) ) 
     175                      zpislopen = zpislopeadn(ji,jj,jk) / ( prmax(ji,jj,jk) * zmxl_chl(ji,jj,jk) * rday + rtrn ) 
     176                      zpisloped = zpislopeadd(ji,jj,jk) / ( prmax(ji,jj,jk) * zmxl_chl(ji,jj,jk) * rday + rtrn ) 
     177                      zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) ) 
     178                      zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) ) ) 
    177179                  ENDIF 
    178180               END DO 
    … …  
    183185            DO jj = 1, jpj 
    184186               DO ji = 1, jpi 
    185  
    186                   ! Computation of the P-I slope for nanos and diatoms 
    187187                  IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    188                       ztn         = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 
    189                       zadap       = ztn / ( 2.+ ztn ) 
    190                       zconctemp   = MAX( 0.e0 , trb(ji,jj,jk,jpdia) - xsizedia ) 
    191                       zconctemp2  = trb(ji,jj,jk,jpdia) - zconctemp 
    192                       znanotot    = enano(ji,jj,jk) * zstrn(ji,jj) 
    193                       zdiattot    = ediat(ji,jj,jk) * zstrn(ji,jj) 
    194                       ! 
    195                       zpislopead (ji,jj,jk) = pislope  * ( 1.+ zadap  * EXP( -znanotot ) ) 
    196                       zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp)  / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    197  
    198                       zpislopen =  zpislopead(ji,jj,jk) * trb(ji,jj,jk,jpnch)                & 
    199                         &          / ( trb(ji,jj,jk,jpphy) * 12.                  + rtrn )   & 
    200                         &          / ( prmax(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn ) 
    201  
    202                       zpislope2n = zpislopead2(ji,jj,jk) * trb(ji,jj,jk,jpdch)                & 
    203                         &          / ( trb(ji,jj,jk,jpdia) * 12.                  + rtrn )   & 
    204                         &          / ( prmax(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn ) 
    205  
    206188                      ! Computation of production function for Carbon 
    207189                      !  --------------------------------------------- 
    208                       zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen  * znanotot ) ) 
    209                       zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpislope2n * zdiattot ) ) 
    210  
     190                      zpislopen = zpislopeadn(ji,jj,jk)  / ( zprbio(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn ) 
     191                      zpisloped = zpislopeadd(ji,jj,jk) / ( zprdia(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn ) 
     192                      zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) ) 
     193                      zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) ) ) 
    211194                      !  Computation of production function for Chlorophyll 
    212195                      !-------------------------------------------------- 
    213                       zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen  * enano(ji,jj,jk) ) ) 
    214                       zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope2n * ediat(ji,jj,jk) ) ) 
     196                      zpislopen = zpislopen * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
     197                      zpisloped = zpisloped * zmxl_fac(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
     198                      zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen * enano(ji,jj,jk) ) ) 
     199                      zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpisloped * ediat(ji,jj,jk) ) ) 
    215200                  ENDIF 
    216201               END DO 
    … …  
    218203         END DO 
    219204      ENDIF 
    220  
    221205 
    222206      !  Computation of a proxy of the N/C ratio 
    … …  
    261245      END DO 
    262246 
    263       !  Computation of the limitation term due to a mixed layer deeper than the euphotic depth 
    264       DO jj = 1, jpj 
    265          DO ji = 1, jpi 
    266             zmxltst = MAX( 0.e0, hmld(ji,jj) - heup(ji,jj) ) 
    267             zmxlday = zmxltst * zmxltst * r1_rday 
    268             zmixnano(ji,jj) = 1. - zmxlday / ( 2. + zmxlday ) 
    269             zmixdiat(ji,jj) = 1. - zmxlday / ( 4. + zmxlday ) 
    270          END DO 
    271       END DO 
    272   
    273       !  Mixed-layer effect on production                                                                                
    274       DO jk = 1, jpkm1 
    275          DO jj = 1, jpj 
    276             DO ji = 1, jpi 
    277                IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
    278                   zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * zmixnano(ji,jj) 
    279                   zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * zmixdiat(ji,jj) 
    280                ENDIF 
     247      !  Mixed-layer effect on production  
     248      !  Sea-ice effect on production 
     249 
     250      DO jk = 1, jpkm1 
     251         DO jj = 1, jpj 
     252            DO ji = 1, jpi 
    281253               zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 
    282254               zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 
     255               zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 
     256               zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1. - fr_i(ji,jj) ) 
    283257            END DO 
    284258         END DO 
    … …  
    290264            DO ji = 1, jpi 
    291265               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    292                   !  production terms for nanophyto. 
    293                   zprorca(ji,jj,jk) = zprbio(ji,jj,jk)  * xlimphy(ji,jj,jk) * trb(ji,jj,jk,jpphy) * rfact2 
    294                   zpronew(ji,jj,jk) = zprorca(ji,jj,jk) * xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn ) 
     266                  !  production terms for nanophyto. (C) 
     267                  zprorcan(ji,jj,jk) = zprbio(ji,jj,jk)  * xlimphy(ji,jj,jk) * trb(ji,jj,jk,jpphy) * rfact2 
     268                  zpronewn(ji,jj,jk)  = zprorcan(ji,jj,jk)* xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn ) 
    295269                  ! 
    296                   zratio = trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) + rtrn ) 
    297                   zratio = zratio / fecnm  
     270                  zratio = trb(ji,jj,jk,jpnfe) / ( trb(ji,jj,jk,jpphy) * fecnm + rtrn ) 
    298271                  zmax   = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) )  
    299                   zprofen(ji,jj,jk) = fecnm * prmax(ji,jj,jk) & 
     272                  zprofen(ji,jj,jk) = fecnm * prmax(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) ) & 
    300273                  &             * ( 4. - 4.5 * xlimnfe(ji,jj,jk) / ( xlimnfe(ji,jj,jk) + 0.5 ) )    & 
    301274                  &             * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concnfe(ji,jj,jk) )  & 
    302275                  &             * zmax * trb(ji,jj,jk,jpphy) * rfact2 
    303                   !  production terms for diatomees 
     276                  !  production terms for diatoms (C) 
    304277                  zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * trb(ji,jj,jk,jpdia) * rfact2 
    305278                  zpronewd(ji,jj,jk) = zprorcad(ji,jj,jk) * xdiatno3(ji,jj,jk) / ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) + rtrn ) 
    306279                  ! 
    307                   zratio = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) + rtrn ) 
    308                   zratio = zratio / fecdm  
     280                  zratio = trb(ji,jj,jk,jpdfe) / ( trb(ji,jj,jk,jpdia) * fecdm + rtrn ) 
    309281                  zmax   = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) )  
    310                   zprofed(ji,jj,jk) = fecdm * prmax(ji,jj,jk) & 
     282                  zprofed(ji,jj,jk) = fecdm * prmax(ji,jj,jk) * ( 1.0 - fr_i(ji,jj) ) & 
    311283                  &             * ( 4. - 4.5 * xlimdfe(ji,jj,jk) / ( xlimdfe(ji,jj,jk) + 0.5 ) )    & 
    312284                  &             * biron(ji,jj,jk) / ( biron(ji,jj,jk) + concdfe(ji,jj,jk) )  & 
    … …  
    317289      END DO 
    318290 
    319       DO jk = 1, jpkm1 
    320          DO jj = 1, jpj 
    321             DO ji = 1, jpi 
    322                IF( gdepw_n(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
    323                   zprnch(ji,jj,jk) = zprnch(ji,jj,jk) * zmixnano(ji,jj) 
    324                   zprdch(ji,jj,jk) = zprdch(ji,jj,jk) * zmixdiat(ji,jj) 
    325                ENDIF 
     291      ! Computation of the chlorophyll production terms 
     292      DO jk = 1, jpkm1 
     293         DO jj = 1, jpj 
     294            DO ji = 1, jpi 
    326295               IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
    327296                  !  production terms for nanophyto. ( chlorophyll ) 
    328                   znanotot = enano(ji,jj,jk) * zstrn(ji,jj) 
    329                   zprod    = rday * zprorca(ji,jj,jk) * zprnch(ji,jj,jk) * xlimphy(ji,jj,jk) 
    330                   zprochln(ji,jj,jk) = chlcmin * 12. * zprorca (ji,jj,jk) 
    331                   zprochln(ji,jj,jk) = zprochln(ji,jj,jk) + (chlcnm-chlcmin) * 12. * zprod / & 
    332                                      & (  zpislopead(ji,jj,jk) * znanotot +rtrn) 
    333                   !  production terms for diatomees ( chlorophyll ) 
    334                   zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj) 
    335                   zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * xlimdia(ji,jj,jk) 
    336                   zprochld(ji,jj,jk) = chlcmin * 12. * zprorcad(ji,jj,jk) 
    337                   zprochld(ji,jj,jk) = zprochld(ji,jj,jk) + (chlcdm-chlcmin) * 12. * zprod / & 
    338                                      & ( zpislopead2(ji,jj,jk) * zdiattot +rtrn ) 
     297                  znanotot = enano(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
     298                  zprod    = rday * zprorcan(ji,jj,jk) * zprnch(ji,jj,jk) * xlimphy(ji,jj,jk) 
     299                  zprochln = chlcmin * 12. * zprorcan (ji,jj,jk) 
     300                  chlcnm_n   = MIN ( chlcnm, ( chlcnm / (1. - 1.14 / 43.4 *tsn(ji,jj,jk,jp_tem))) * (1. - 1.14 / 43.4 * 20.)) 
     301                  zprochln = zprochln + (chlcnm_n-chlcmin) * 12. * zprod / & 
     302                                        & (  zpislopeadn(ji,jj,jk) * znanotot +rtrn) 
     303                  !  production terms for diatoms ( chlorophyll ) 
     304                  zdiattot = ediat(ji,jj,jk) / ( zmxl_chl(ji,jj,jk) + rtrn ) 
     305                  zprod    = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * xlimdia(ji,jj,jk) 
     306                  zprochld = chlcmin * 12. * zprorcad(ji,jj,jk) 
     307                  chlcdm_n   = MIN ( chlcdm, ( chlcdm / (1. - 1.14 / 43.4 * tsn(ji,jj,jk,jp_tem))) * (1. - 1.14 / 43.4 * 20.)) 
     308                  zprochld = zprochld + (chlcdm_n-chlcmin) * 12. * zprod / & 
     309                                        & ( zpislopeadd(ji,jj,jk) * zdiattot +rtrn ) 
     310                  !   Update the arrays TRA which contain the Chla sources and sinks 
     311                  tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) + zprochln * texcretn 
     312                  tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) + zprochld * texcretd 
    339313               ENDIF 
    340314            END DO 
    … …  
    346320         DO jj = 1, jpj 
    347321           DO ji =1 ,jpi 
    348               zproreg  = zprorca(ji,jj,jk) - zpronew(ji,jj,jk) 
    349               zproreg2 = zprorcad(ji,jj,jk) - zpronewd(ji,jj,jk) 
    350               tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - zprorca(ji,jj,jk) - zprorcad(ji,jj,jk) 
    351               tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - zpronew(ji,jj,jk) - zpronewd(ji,jj,jk) 
    352               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zproreg - zproreg2 
    353               tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zprorca(ji,jj,jk) * texcret 
    354               tra(ji,jj,jk,jpnch) = tra(ji,jj,jk,jpnch) + zprochln(ji,jj,jk) * texcret 
    355               tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) + zprofen(ji,jj,jk) * texcret 
    356               tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) + zprorcad(ji,jj,jk) * texcret2 
    357               tra(ji,jj,jk,jpdch) = tra(ji,jj,jk,jpdch) + zprochld(ji,jj,jk) * texcret2 
    358               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) + zprofed(ji,jj,jk) * texcret2 
    359               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcret2 
    360               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + excret2 * zprorcad(ji,jj,jk) + excret * zprorca(ji,jj,jk) 
    361               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2ut * ( zproreg + zproreg2) & 
    362                  &                + ( o2ut + o2nit ) * ( zpronew(ji,jj,jk) + zpronewd(ji,jj,jk) ) 
    363               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - texcret * zprofen(ji,jj,jk) - texcret2 * zprofed(ji,jj,jk) 
    364               tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) - texcret2 * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 
    365               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprorca(ji,jj,jk) - zprorcad(ji,jj,jk) 
    366               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zpronew(ji,jj,jk) + zpronewd(ji,jj,jk) ) & 
    367                  &                                      - rno3 * ( zproreg + zproreg2 ) 
    368           END DO 
     322              IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     323                 zproreg  = zprorcan(ji,jj,jk) - zpronewn(ji,jj,jk) 
     324                 zproreg2 = zprorcad(ji,jj,jk) - zpronewd(ji,jj,jk) 
     325                 zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) 
     326                 tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) 
     327                 tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - zpronewn(ji,jj,jk) - zpronewd(ji,jj,jk) 
     328                 tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zproreg - zproreg2 
     329                 tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zprorcan(ji,jj,jk) * texcretn 
     330                 tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) + zprofen(ji,jj,jk) * texcretn 
     331                 tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) + zprorcad(ji,jj,jk) * texcretd 
     332                 tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) + zprofed(ji,jj,jk) * texcretd 
     333                 tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcretd 
     334                 tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zdocprod 
     335                 tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2ut * ( zproreg + zproreg2) & 
     336                 &                   + ( o2ut + o2nit ) * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) 
     337                 ! 
     338                 zfeup = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) 
     339                 tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zfeup 
     340                 tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) - texcretd * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 
     341                 tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprorcan(ji,jj,jk) - zprorcad(ji,jj,jk) 
     342                 tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zpronewn(ji,jj,jk) + zpronewd(ji,jj,jk) ) & 
     343                 &                                         - rno3 * ( zproreg + zproreg2 ) 
     344              ENDIF 
     345           END DO 
    369346        END DO 
    370347     END DO 
     348     ! 
     349     IF( ln_ligand ) THEN 
     350         DO jk = 1, jpkm1 
     351            DO jj = 1, jpj 
     352              DO ji =1 ,jpi 
     353                 IF( etot_ndcy(ji,jj,jk) > 1.E-3 ) THEN 
     354                    zdocprod = excretd * zprorcad(ji,jj,jk) + excretn * zprorcan(ji,jj,jk) 
     355                    zfeup    = texcretn * zprofen(ji,jj,jk) + texcretd * zprofed(ji,jj,jk) 
     356                    tra(ji,jj,jk,jplgw) = tra(ji,jj,jk,jplgw) + zdocprod * ldocp - zfeup * plig(ji,jj,jk) * lthet 
     357                 ENDIF 
     358              END DO 
     359           END DO 
     360        END DO 
     361     ENDIF 
    371362 
    372363 
    373364    ! Total primary production per year 
    374365    IF( iom_use( "tintpp" ) .OR. ( ln_check_mass .AND. kt == nitend .AND. knt == nrdttrc )  )  & 
    375          & tpp = glob_sum( ( zprorca(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) ) 
     366         & tpp = glob_sum( ( zprorcan(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) ) 
    376367 
    377368    IF( lk_iomput ) THEN 
    … …  
    381372          zfact = 1.e+3 * rfact2r  !  conversion from mol/l/kt to  mol/m3/s 
    382373          ! 
    383           IF( iom_use( "PPPHY" ) .OR. iom_use( "PPPHY2" ) )  THEN 
    384               zw3d(:,:,:) = zprorca (:,:,:) * zfact * tmask(:,:,:)  ! primary production by nanophyto 
    385               CALL iom_put( "PPPHY"  , zw3d ) 
     374          IF( iom_use( "PPPHYN" ) .OR. iom_use( "PPPHYD" ) )  THEN 
     375              zw3d(:,:,:) = zprorcan(:,:,:) * zfact * tmask(:,:,:)  ! primary production by nanophyto 
     376              CALL iom_put( "PPPHYN"  , zw3d ) 
    386377              ! 
    387378              zw3d(:,:,:) = zprorcad(:,:,:) * zfact * tmask(:,:,:)  ! primary production by diatomes 
    388               CALL iom_put( "PPPHY2"  , zw3d ) 
     379              CALL iom_put( "PPPHYD"  , zw3d ) 
    389380          ENDIF 
    390381          IF( iom_use( "PPNEWN" ) .OR. iom_use( "PPNEWD" ) )  THEN 
    391               zw3d(:,:,:) = zpronew (:,:,:) * zfact * tmask(:,:,:)  ! new primary production by nanophyto 
     382              zw3d(:,:,:) = zpronewn(:,:,:) * zfact * tmask(:,:,:)  ! new primary production by nanophyto 
    392383              CALL iom_put( "PPNEWN"  , zw3d ) 
    393384              ! 
    … …  
    425416          ENDIF 
    426417          IF( iom_use( "TPP" ) )  THEN 
    427               zw3d(:,:,:) = ( zprorca(:,:,:) + zprorcad(:,:,:) ) * zfact * tmask(:,:,:)  ! total primary production 
     418              zw3d(:,:,:) = ( zprorcan(:,:,:) + zprorcad(:,:,:) ) * zfact * tmask(:,:,:)  ! total primary production 
    428419              CALL iom_put( "TPP"  , zw3d ) 
    429420          ENDIF 
    430421          IF( iom_use( "TPNEW" ) )  THEN 
    431               zw3d(:,:,:) = ( zpronew(:,:,:) + zpronewd(:,:,:) ) * zfact * tmask(:,:,:)  ! total new production 
     422              zw3d(:,:,:) = ( zpronewn(:,:,:) + zpronewd(:,:,:) ) * zfact * tmask(:,:,:)  ! total new production 
    432423              CALL iom_put( "TPNEW"  , zw3d ) 
    433424          ENDIF 
    … …  
    436427              CALL iom_put( "TPBFE"  , zw3d ) 
    437428          ENDIF 
    438           IF( iom_use( "INTPPPHY" ) .OR. iom_use( "INTPPPHY2" ) ) THEN   
     429          IF( iom_use( "INTPPPHYN" ) .OR. iom_use( "INTPPPHYD" ) ) THEN   
    439430             zw2d(:,:) = 0. 
    440431             DO jk = 1, jpkm1 
    441                zw2d(:,:) = zw2d(:,:) + zprorca (:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk)  ! vert. integrated  primary produc. by nano 
     432               zw2d(:,:) = zw2d(:,:) + zprorcan(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk)  ! vert. integrated  primary produc. by nano 
    442433             ENDDO 
    443              CALL iom_put( "INTPPPHY" , zw2d ) 
     434             CALL iom_put( "INTPPPHYN" , zw2d ) 
    444435             ! 
    445436             zw2d(:,:) = 0. 
    … …  
    447438                zw2d(:,:) = zw2d(:,:) + zprorcad(:,:,jk) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated  primary produc. by diatom 
    448439             ENDDO 
    449              CALL iom_put( "INTPPPHY2" , zw2d ) 
     440             CALL iom_put( "INTPPPHYD" , zw2d ) 
    450441          ENDIF 
    451442          IF( iom_use( "INTPP" ) ) THEN    
    452443             zw2d(:,:) = 0. 
    453444             DO jk = 1, jpkm1 
    454                 zw2d(:,:) = zw2d(:,:) + ( zprorca(:,:,jk) + zprorcad(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated pp 
     445                zw2d(:,:) = zw2d(:,:) + ( zprorcan(:,:,jk) + zprorcad(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk) ! vert. integrated pp 
    455446             ENDDO 
    456447             CALL iom_put( "INTPP" , zw2d ) 
    … …  
    459450             zw2d(:,:) = 0. 
    460451             DO jk = 1, jpkm1 
    461                 zw2d(:,:) = zw2d(:,:) + ( zpronew(:,:,jk) + zpronewd(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk)  ! vert. integrated new prod 
     452                zw2d(:,:) = zw2d(:,:) + ( zpronewn(:,:,jk) + zpronewd(:,:,jk) ) * e3t_n(:,:,jk) * zfact * tmask(:,:,jk)  ! vert. integrated new prod 
    462453             ENDDO 
    463454             CALL iom_put( "INTPNEW" , zw2d ) 
    … …  
    482473          CALL wrk_dealloc( jpi, jpj, jpk, zw3d ) 
    483474       ENDIF 
    484      ELSE 
    485         IF( ln_diatrc ) THEN 
    486            zfact = 1.e+3 * rfact2r 
    487            trc3d(:,:,:,jp_pcs0_3d + 4)  = zprorca (:,:,:) * zfact * tmask(:,:,:) 
    488            trc3d(:,:,:,jp_pcs0_3d + 5)  = zprorcad(:,:,:) * zfact * tmask(:,:,:) 
    489            trc3d(:,:,:,jp_pcs0_3d + 6)  = zpronew (:,:,:) * zfact * tmask(:,:,:) 
    490            trc3d(:,:,:,jp_pcs0_3d + 7)  = zpronewd(:,:,:) * zfact * tmask(:,:,:) 
    491            trc3d(:,:,:,jp_pcs0_3d + 8)  = zprorcad(:,:,:) * zfact * tmask(:,:,:) * zysopt(:,:,:) 
    492            trc3d(:,:,:,jp_pcs0_3d + 9)  = zprofed (:,:,:) * zfact * tmask(:,:,:) 
    493 #  if ! defined key_kriest 
    494            trc3d(:,:,:,jp_pcs0_3d + 10) = zprofen (:,:,:) * zfact * tmask(:,:,:) 
    495 #  endif 
    496         ENDIF 
    497475     ENDIF 
    498476 
    … …  
    503481     ENDIF 
    504482     ! 
    505      CALL wrk_dealloc( jpi, jpj,      zmixnano, zmixdiat, zstrn                                                  ) 
    506      CALL wrk_dealloc( jpi, jpj, jpk, zpislopead, zpislopead2, zprdia, zprbio, zprdch, zprnch, zysopt            )  
    507      CALL wrk_dealloc( jpi, jpj, jpk, zprorca, zprorcad, zprofed, zprofen, zprochln, zprochld, zpronew, zpronewd ) 
     483     CALL wrk_dealloc( jpi, jpj,  zmixnano, zmixdiat,    zstrn ) 
     484     CALL wrk_dealloc( jpi, jpj, jpk, zpislopeadn, zpislopeadd, zprdia, zprbio, zprdch, zprnch, zysopt )  
     485     CALL wrk_dealloc( jpi, jpj, jpk, zmxl_fac, zmxl_chl ) 
     486     CALL wrk_dealloc( jpi, jpj, jpk, zprorcan, zprorcad, zprofed, zprofen, zpronewn, zpronewd ) 
    508487     ! 
    509488     IF( nn_timing == 1 )  CALL timing_stop('p4z_prod') 
    … …  
    524503      !!---------------------------------------------------------------------- 
    525504      ! 
    526       NAMELIST/nampisprod/ pislope, pislope2, xadap, ln_newprod, bresp, excret, excret2,  & 
     505      NAMELIST/namp4zprod/ pislopen, pisloped, xadap, ln_newprod, bresp, excretn, excretd,  & 
    527506         &                 chlcnm, chlcdm, chlcmin, fecnm, fecdm, grosip 
    528507      INTEGER :: ios                 ! Local integer output status for namelist read 
    … …  
    530509 
    531510      REWIND( numnatp_ref )              ! Namelist nampisprod in reference namelist : Pisces phytoplankton production 
    532       READ  ( numnatp_ref, nampisprod, IOSTAT = ios, ERR = 901) 
    533 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisprod in reference namelist', lwp ) 
     511      READ  ( numnatp_ref, namp4zprod, IOSTAT = ios, ERR = 901) 
     512901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zprod in reference namelist', lwp ) 
    534513 
    535514      REWIND( numnatp_cfg )              ! Namelist nampisprod in configuration namelist : Pisces phytoplankton production 
    536       READ  ( numnatp_cfg, nampisprod, IOSTAT = ios, ERR = 902 ) 
    537 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisprod in configuration namelist', lwp ) 
    538       IF(lwm) WRITE ( numonp, nampisprod ) 
     515      READ  ( numnatp_cfg, namp4zprod, IOSTAT = ios, ERR = 902 ) 
     516902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namp4zprod in configuration namelist', lwp ) 
     517      IF(lwm) WRITE ( numonp, namp4zprod ) 
    539518 
    540519      IF(lwp) THEN                         ! control print 
    541520         WRITE(numout,*) ' ' 
    542          WRITE(numout,*) ' Namelist parameters for phytoplankton growth, nampisprod' 
     521         WRITE(numout,*) ' Namelist parameters for phytoplankton growth, namp4zprod' 
    543522         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    544          WRITE(numout,*) '    Enable new parame. of production (T/F)   ln_newprod   =', ln_newprod 
     523         WRITE(numout,*) '    Enable new parame. of production (T/F)   ln_newprod    =', ln_newprod 
    545524         WRITE(numout,*) '    mean Si/C ratio                           grosip       =', grosip 
    546          WRITE(numout,*) '    P-I slope                                 pislope      =', pislope 
    547          WRITE(numout,*) '    Acclimation factor to low light           xadap       =', xadap 
    548          WRITE(numout,*) '    excretion ratio of nanophytoplankton      excret       =', excret 
    549          WRITE(numout,*) '    excretion ratio of diatoms                excret2      =', excret2 
     525         WRITE(numout,*) '    P-I slope                                 pislopen     =', pislopen 
     526         WRITE(numout,*) '    Acclimation factor to low light           xadap        =', xadap 
     527         WRITE(numout,*) '    excretion ratio of nanophytoplankton      excretn      =', excretn 
     528         WRITE(numout,*) '    excretion ratio of diatoms                excretd      =', excretd 
    550529         IF( ln_newprod )  THEN 
    551530            WRITE(numout,*) '    basal respiration in phytoplankton        bresp        =', bresp 
    552531            WRITE(numout,*) '    Maximum Chl/C in phytoplankton            chlcmin      =', chlcmin 
    553532         ENDIF 
    554          WRITE(numout,*) '    P-I slope  for diatoms                    pislope2     =', pislope2 
     533         WRITE(numout,*) '    P-I slope  for diatoms                    pisloped     =', pisloped 
    555534         WRITE(numout,*) '    Minimum Chl/C in nanophytoplankton        chlcnm       =', chlcnm 
    556535         WRITE(numout,*) '    Minimum Chl/C in diatoms                  chlcdm       =', chlcdm 
    … …  
    560539      ! 
    561540      r1_rday   = 1._wp / rday  
    562       texcret   = 1._wp - excret 
    563       texcret2  = 1._wp - excret2 
     541      texcretn  = 1._wp - excretn 
     542      texcretd  = 1._wp - excretd 
    564543      tpp       = 0._wp 
    565544      ! 
    … …  
    576555      ! 
    577556   END FUNCTION p4z_prod_alloc 
    578  
    579 #else 
    580    !!====================================================================== 
    581    !!  Dummy module :                                   No PISCES bio-model 
    582    !!====================================================================== 
    583 CONTAINS 
    584    SUBROUTINE p4z_prod                    ! Empty routine 
    585    END SUBROUTINE p4z_prod 
    586 #endif  
    587  
    588557   !!====================================================================== 
    589558END MODULE p4zprod 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zrem.F90

    r6945 r7646  
    88   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Quota model for iron 
    99   !!---------------------------------------------------------------------- 
    10 #if defined key_pisces 
    11    !!---------------------------------------------------------------------- 
    12    !!   'key_top'       and                                      TOP models 
    13    !!   'key_pisces'                                       PISCES bio-model 
    14    !!---------------------------------------------------------------------- 
    1510   !!   p4z_rem       :  Compute remineralization/dissolution of organic compounds 
    1611   !!   p4z_rem_init  :  Initialisation of parameters for remineralisation 
    … …  
    2015   USE trc             !  passive tracers common variables  
    2116   USE sms_pisces      !  PISCES Source Minus Sink variables 
    22    USE p4zopt          !  optical model 
    2317   USE p4zche          !  chemical model 
    2418   USE p4zprod         !  Growth rate of the 2 phyto groups 
    25    USE p4zmeso         !  Sources and sinks of mesozooplankton 
    26    USE p4zint          !  interpolation and computation of various fields 
    2719   USE p4zlim 
    2820   USE prtctl_trc      !  print control for debugging 
    … …  
    3830 
    3931   !! * Shared module variables 
     32   REAL(wp), PUBLIC ::  xremikc    !: remineralisation rate of DOC  
     33   REAL(wp), PUBLIC ::  xremikn    !: remineralisation rate of DON  
     34   REAL(wp), PUBLIC ::  xremikp    !: remineralisation rate of DOP  
    4035   REAL(wp), PUBLIC ::  xremik     !: remineralisation rate of POC  
    41    REAL(wp), PUBLIC ::  xremip     !: remineralisation rate of DOC 
    4236   REAL(wp), PUBLIC ::  nitrif     !: NH4 nitrification rate  
    4337   REAL(wp), PUBLIC ::  xsirem     !: remineralisation rate of POC  
    4438   REAL(wp), PUBLIC ::  xsiremlab  !: fast remineralisation rate of POC  
    4539   REAL(wp), PUBLIC ::  xsilab     !: fraction of labile biogenic silica  
    46  
     40   REAL(wp), PUBLIC ::  feratb     !: Fe/C quota in bacteria 
     41   REAL(wp), PUBLIC ::  xkferb     !: Half-saturation constant for bacteria Fe/C 
    4742 
    4843   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   denitr     !: denitrification array 
    49    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   denitnh4   !: -    -    -    -   - 
    5044 
    5145   !!---------------------------------------------------------------------- 
    … …  
    6862      ! 
    6963      INTEGER  ::   ji, jj, jk 
    70       REAL(wp) ::   zremip, zremik, zsiremin  
     64      REAL(wp) ::   zremik, zremikc, zremikn, zremikp, zsiremin, zfact  
    7165      REAL(wp) ::   zsatur, zsatur2, znusil, znusil2, zdep, zdepmin, zfactdep 
    72       REAL(wp) ::   zbactfer, zorem, zorem2, zofer, zolimit 
    73       REAL(wp) ::   zosil, ztem 
    74 #if ! defined key_kriest 
    75       REAL(wp) ::   zofer2 
    76 #endif 
    77       REAL(wp) ::   zonitr, zstep, zfact 
     66      REAL(wp) ::   zbactfer, zolimit, zonitr, zrfact2 
     67      REAL(wp) ::   zosil, ztem, zdenitnh4, zolimic, zolimin, zolimip, zdenitrn, zdenitrp 
    7868      CHARACTER (len=25) :: charout 
    7969      REAL(wp), POINTER, DIMENSION(:,:  ) :: ztempbac 
    80       REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepbac, zolimi, zdepprod, zw3d 
     70      REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepbac, zolimi, zdepprod, zfacsi, zw3d, zfacsib 
    8171      !!--------------------------------------------------------------------- 
    8272      ! 
    … …  
    8575      ! Allocate temporary workspace 
    8676      CALL wrk_alloc( jpi, jpj,      ztempbac                  ) 
    87       CALL wrk_alloc( jpi, jpj, jpk, zdepbac, zdepprod, zolimi ) 
     77      CALL wrk_alloc( jpi, jpj, jpk, zdepbac, zdepprod, zolimi, zfacsi, zfacsib ) 
    8878 
    8979      ! Initialisation of temprary arrys 
    9080      zdepprod(:,:,:) = 1._wp 
    9181      ztempbac(:,:)   = 0._wp 
     82      zfacsib(:,:,:)  = xsilab / ( 1.0 - xsilab ) 
     83      zfacsi(:,:,:)   = xsilab 
    9284 
    9385      ! Computation of the mean phytoplankton concentration as 
    … …  
    112104      END DO 
    113105 
     106      IF( ln_p4z ) THEN 
     107         DO jk = 1, jpkm1 
     108            DO jj = 1, jpj 
     109               DO ji = 1, jpi 
     110                  ! DOC ammonification. Depends on depth, phytoplankton biomass 
     111                  ! and a limitation term which is supposed to be a parameterization of the bacterial activity.  
     112                  zremik = xremik * xstep / 1.e-6 * xlimbac(ji,jj,jk) * zdepbac(ji,jj,jk)  
     113                  zremik = MAX( zremik, 2.74e-4 * xstep ) 
     114                  ! Ammonification in oxic waters with oxygen consumption 
     115                  ! ----------------------------------------------------- 
     116                  zolimit = zremik * ( 1.- nitrfac(ji,jj,jk) ) * trb(ji,jj,jk,jpdoc)  
     117                  zolimi(ji,jj,jk) = MIN( ( trb(ji,jj,jk,jpoxy) - rtrn ) / o2ut, zolimit )  
     118                  ! Ammonification in suboxic waters with denitrification 
     119                  ! ------------------------------------------------------- 
     120                  denitr(ji,jj,jk)  = MIN(  ( trb(ji,jj,jk,jpno3) - rtrn ) / rdenit,   & 
     121                     &                     zremik * nitrfac(ji,jj,jk) * trb(ji,jj,jk,jpdoc)  ) 
     122                  ! 
     123                  zolimi (ji,jj,jk) = MAX( 0.e0, zolimi (ji,jj,jk) ) 
     124                  denitr (ji,jj,jk) = MAX( 0.e0, denitr (ji,jj,jk) ) 
     125                  ! 
     126                  tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) 
     127                  tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) 
     128                  tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - denitr (ji,jj,jk) * rdenit 
     129                  tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zolimi (ji,jj,jk) - denitr(ji,jj,jk) 
     130                  tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - zolimi (ji,jj,jk) * o2ut 
     131                  tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zolimi (ji,jj,jk) + denitr(ji,jj,jk) 
     132                  tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zolimi(ji,jj,jk)    & 
     133                  &                     + ( rdenit + 1.) * denitr(ji,jj,jk) ) 
     134               END DO 
     135            END DO 
     136         END DO 
     137      ELSE 
     138         DO jk = 1, jpkm1 
     139            DO jj = 1, jpj 
     140               DO ji = 1, jpi 
     141                  ! DOC ammonification. Depends on depth, phytoplankton biomass 
     142                  ! and a limitation term which is supposed to be a parameterization of the bacterial activity.  
     143                  ! ----------------------------------------------------------------- 
     144                  zremik = xstep / 1.e-6 * MAX(0.01, xlimbac(ji,jj,jk)) * zdepbac(ji,jj,jk)  
     145                  zremik = MAX( zremik, 2.74e-4 * xstep / xremikc ) 
     146 
     147                  zremikc = xremikc * zremik 
     148                  zremikn = xremikn / xremikc 
     149                  zremikp = xremikp / xremikc 
     150 
     151                  ! Ammonification in oxic waters with oxygen consumption 
     152                  ! ----------------------------------------------------- 
     153                  zolimit = zremikc * ( 1.- nitrfac(ji,jj,jk) ) * trb(ji,jj,jk,jpdoc)  
     154                  zolimic = MAX( 0.e0, MIN( ( trb(ji,jj,jk,jpoxy) - rtrn ) / o2ut, zolimit ) )  
     155                  zolimi(ji,jj,jk) = zolimic 
     156                  zolimin = zremikn * zolimic * trb(ji,jj,jk,jpdon) / ( trb(ji,jj,jk,jpdoc) + rtrn ) 
     157                  zolimip = zremikp * zolimic * trb(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdoc) + rtrn )  
     158 
     159                  ! Ammonification in suboxic waters with denitrification 
     160                  ! ------------------------------------------------------- 
     161                  zolimit = zremikc * nitrfac(ji,jj,jk) * trb(ji,jj,jk,jpdoc) 
     162                  denitr(ji,jj,jk)  = MIN(  ( trb(ji,jj,jk,jpno3) - rtrn ) / rdenit, zolimit ) 
     163                  denitr(ji,jj,jk) = MAX( 0.e0, denitr(ji,jj,jk) ) 
     164                  zdenitrn  = zremikn * denitr(ji,jj,jk) * trb(ji,jj,jk,jpdon) / ( trb(ji,jj,jk,jpdoc) + rtrn ) 
     165                  zdenitrp  = zremikp * denitr(ji,jj,jk) * trb(ji,jj,jk,jpdop) / ( trb(ji,jj,jk,jpdoc) + rtrn ) 
     166 
     167                  tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zolimip + zdenitrp 
     168                  tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zolimin + zdenitrn 
     169                  tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) - denitr(ji,jj,jk) * rdenit 
     170                  tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zolimic - denitr(ji,jj,jk) 
     171                  tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) - zolimin - zdenitrn 
     172                  tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) - zolimip - zdenitrp 
     173                  tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - zolimic * o2ut 
     174                  tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zolimic + denitr(ji,jj,jk) 
     175                  tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zolimin + ( rdenit + 1.) * zdenitrn ) 
     176               END DO 
     177            END DO 
     178         END DO 
     179         ! 
     180      ENDIF 
     181 
     182 
    114183      DO jk = 1, jpkm1 
    115184         DO jj = 1, jpj 
    116185            DO ji = 1, jpi 
    117                zstep   = xstep 
    118 # if defined key_degrad 
    119                zstep = zstep * facvol(ji,jj,jk) 
    120 # endif 
    121                ! DOC ammonification. Depends on depth, phytoplankton biomass 
    122                ! and a limitation term which is supposed to be a parameterization 
    123                !     of the bacterial activity.  
    124                zremik = xremik * zstep / 1.e-6 * xlimbac(ji,jj,jk) * zdepbac(ji,jj,jk)  
    125                zremik = MAX( zremik, 2.74e-4 * xstep ) 
    126                ! Ammonification in oxic waters with oxygen consumption 
    127                ! ----------------------------------------------------- 
    128                zolimit = zremik * ( 1.- nitrfac(ji,jj,jk) ) * trb(ji,jj,jk,jpdoc)  
    129                zolimi(ji,jj,jk) = MIN( ( trb(ji,jj,jk,jpoxy) - rtrn ) / o2ut, zolimit )  
    130                ! Ammonification in suboxic waters with denitrification 
    131                ! ------------------------------------------------------- 
    132                denitr(ji,jj,jk)  = MIN(  ( trb(ji,jj,jk,jpno3) - rtrn ) / rdenit,   & 
    133                   &                     zremik * nitrfac(ji,jj,jk) * trb(ji,jj,jk,jpdoc)  ) 
    134                ! 
    135                zolimi (ji,jj,jk) = MAX( 0.e0, zolimi (ji,jj,jk) ) 
    136                denitr (ji,jj,jk) = MAX( 0.e0, denitr (ji,jj,jk) ) 
    137                ! 
    138             END DO 
    139          END DO 
    140       END DO 
    141  
    142  
    143       DO jk = 1, jpkm1 
    144          DO jj = 1, jpj 
    145             DO ji = 1, jpi 
    146                zstep   = xstep 
    147 # if defined key_degrad 
    148                zstep = zstep * facvol(ji,jj,jk) 
    149 # endif 
    150186               ! NH4 nitrification to NO3. Ceased for oxygen concentrations 
    151187               ! below 2 umol/L. Inhibited at strong light  
    152188               ! ---------------------------------------------------------- 
    153                zonitr  =nitrif * zstep * trb(ji,jj,jk,jpnh4) / ( 1.+ emoy(ji,jj,jk) ) * ( 1.- nitrfac(ji,jj,jk) )  
    154                denitnh4(ji,jj,jk) = nitrif * zstep * trb(ji,jj,jk,jpnh4) * nitrfac(ji,jj,jk)  
     189               zonitr  = nitrif * xstep * trb(ji,jj,jk,jpnh4) * ( 1.- nitrfac(ji,jj,jk) )  & 
     190               &         / ( 1.+ emoy(ji,jj,jk) ) * ( 1. + fr_i(ji,jj) * emoy(ji,jj,jk) )  
     191               zdenitnh4 = nitrif * xstep * trb(ji,jj,jk,jpnh4) * nitrfac(ji,jj,jk) 
    155192               ! Update of the tracers trends 
    156193               ! ---------------------------- 
    157                tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zonitr - denitnh4(ji,jj,jk) 
    158                tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zonitr - rdenita * denitnh4(ji,jj,jk) 
     194               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zonitr - zdenitnh4 
     195               tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zonitr - rdenita * zdenitnh4 
    159196               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2nit * zonitr 
    160                tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2 * rno3 * zonitr + rno3 * ( rdenita - 1. ) * denitnh4(ji,jj,jk) 
     197               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2 * rno3 * zonitr + rno3 * ( rdenita - 1. ) * zdenitnh4 
    161198            END DO 
    162199         END DO 
    … …  
    177214               ! studies (especially at Papa) have shown this uptake to be significant 
    178215               ! ---------------------------------------------------------- 
    179                zbactfer = 10.e-6 *  rfact2 * prmax(ji,jj,jk) * xlimbacl(ji,jj,jk)             & 
    180                   &              * trb(ji,jj,jk,jpfer) / ( 2.5E-10 + trb(ji,jj,jk,jpfer) )    & 
     216               zbactfer = feratb *  rfact2 * prmax(ji,jj,jk) * xlimbacl(ji,jj,jk)             & 
     217                  &              * trb(ji,jj,jk,jpfer) / ( xkferb + trb(ji,jj,jk,jpfer) )    & 
    181218                  &              * zdepprod(ji,jj,jk) * zdepbac(ji,jj,jk) 
    182 #if defined key_kriest 
    183                tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zbactfer*0.05 
    184                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zbactfer*0.05 
    185 #else 
    186219               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zbactfer*0.16 
    187220               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zbactfer*0.12 
    188221               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zbactfer*0.04 
    189 #endif 
    190222            END DO 
    191223         END DO 
    … …  
    198230       ENDIF 
    199231 
     232      ! Initialization of the array which contains the labile fraction 
     233      ! of bSi. Set to a constant in the upper ocean 
     234      ! --------------------------------------------------------------- 
     235 
    200236      DO jk = 1, jpkm1 
    201237         DO jj = 1, jpj 
    202238            DO ji = 1, jpi 
    203                zstep   = xstep 
    204 # if defined key_degrad 
    205                zstep = zstep * facvol(ji,jj,jk) 
    206 # endif 
    207                ! POC disaggregation by turbulence and bacterial activity.  
    208                ! -------------------------------------------------------- 
    209                zremip = xremip * zstep * tgfunc(ji,jj,jk) * ( 1.- 0.55 * nitrfac(ji,jj,jk) )  
    210  
    211                ! POC disaggregation rate is reduced in anoxic zone as shown by 
    212                ! sediment traps data. In oxic area, the exponent of the martin s 
    213                ! law is around -0.87. In anoxic zone, it is around -0.35. This 
    214                ! means a disaggregation constant about 0.5 the value in oxic zones 
    215                ! ----------------------------------------------------------------- 
    216                zorem  = zremip * trb(ji,jj,jk,jppoc) 
    217                zofer  = zremip * trb(ji,jj,jk,jpsfe) 
    218 #if ! defined key_kriest 
    219                zorem2 = zremip * trb(ji,jj,jk,jpgoc) 
    220                zofer2 = zremip * trb(ji,jj,jk,jpbfe) 
    221 #else 
    222                zorem2 = zremip * trb(ji,jj,jk,jpnum) 
    223 #endif 
    224  
    225                ! Update the appropriate tracers trends 
    226                ! ------------------------------------- 
    227  
    228                tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zorem 
    229                tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zofer 
    230 #if defined key_kriest 
    231                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zorem 
    232                tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) - zorem2 
    233                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zofer 
    234 #else 
    235                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zorem2 - zorem 
    236                tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) - zorem2 
    237                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zofer2 - zofer 
    238                tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) - zofer2 
    239 #endif 
    240  
    241             END DO 
    242          END DO 
    243       END DO 
    244  
    245        IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    246          WRITE(charout, FMT="('rem3')") 
    247          CALL prt_ctl_trc_info(charout) 
    248          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
    249        ENDIF 
    250  
    251       DO jk = 1, jpkm1 
    252          DO jj = 1, jpj 
    253             DO ji = 1, jpi 
    254                zstep   = xstep 
    255 # if defined key_degrad 
    256                zstep = zstep * facvol(ji,jj,jk) 
    257 # endif 
     239               zdep     = MAX( hmld(ji,jj), heup_01(ji,jj) ) 
     240               zsatur   = MAX( rtrn, ( sio3eq(ji,jj,jk) - trb(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn ) ) 
     241               zsatur2  = ( 1. + tsn(ji,jj,jk,jp_tem) / 400.)**37 
     242               znusil   = 0.225  * ( 1. + tsn(ji,jj,jk,jp_tem) / 15.) * zsatur + 0.775 * zsatur2 * zsatur**9.25 
    258243               ! Remineralization rate of BSi depedant on T and saturation 
    259244               ! --------------------------------------------------------- 
    260                zsatur   = ( sio3eq(ji,jj,jk) - trb(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn ) 
    261                zsatur   = MAX( rtrn, zsatur ) 
    262                zsatur2  = ( 1. + tsn(ji,jj,jk,jp_tem) / 400.)**37 
    263                znusil   = 0.225  * ( 1. + tsn(ji,jj,jk,jp_tem) / 15.) * zsatur + 0.775 * zsatur2 * zsatur**9.25 
    264                znusil2  = 0.225  * ( 1. + tsn(ji,jj,1,jp_tem) / 15.) + 0.775 * zsatur2 
    265  
    266                ! Two classes of BSi are considered : a labile fraction and  
    267                ! a more refractory one. The ratio between both fractions is 
    268                ! constant and specified in the namelist. 
    269                ! ---------------------------------------------------------- 
    270                zdep     = MAX( hmld(ji,jj), heup(ji,jj) )  
    271                zdep     = MAX( 0., gdept_n(ji,jj,jk) - zdep ) 
    272                ztem     = MAX( tsn(ji,jj,1,jp_tem), 0. ) 
    273                zfactdep = xsilab * EXP(-( xsiremlab - xsirem ) * znusil2 * zdep / wsbio2 ) * ztem / ( ztem + 10. ) 
    274                zsiremin = ( xsiremlab * zfactdep + xsirem * ( 1. - zfactdep ) ) * zstep * znusil 
     245               IF ( gdept_n(ji,jj,jk) > zdep ) THEN 
     246                  zfacsib(ji,jj,jk) = zfacsib(ji,jj,jk-1) * EXP( -0.5 * ( xsiremlab - xsirem )  & 
     247                  &                   * znusil * e3t_n(ji,jj,jk) / wsbio4(ji,jj,jk) ) 
     248                  zfacsi(ji,jj,jk)  = zfacsib(ji,jj,jk) / ( 1.0 + zfacsib(ji,jj,jk) ) 
     249                  zfacsib(ji,jj,jk) = zfacsib(ji,jj,jk) * EXP( -0.5 * ( xsiremlab - xsirem )    & 
     250                  &                   * znusil * e3t_n(ji,jj,jk) / wsbio4(ji,jj,jk) ) 
     251               ENDIF 
     252               zsiremin = ( xsiremlab * zfacsi(ji,jj,jk) + xsirem * ( 1. - zfacsi(ji,jj,jk) ) ) * xstep * znusil 
    275253               zosil    = zsiremin * trb(ji,jj,jk,jpgsi) 
    276254               ! 
    … …  
    283261 
    284262      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    285          WRITE(charout, FMT="('rem4')") 
     263         WRITE(charout, FMT="('rem3')") 
    286264         CALL prt_ctl_trc_info(charout) 
    287265         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
    288266       ENDIF 
    289  
    290       ! Update the arrays TRA which contain the biological sources and sinks 
    291       ! -------------------------------------------------------------------- 
    292  
    293       DO jk = 1, jpkm1 
    294          tra(:,:,jk,jppo4) = tra(:,:,jk,jppo4) + zolimi (:,:,jk) + denitr(:,:,jk) 
    295          tra(:,:,jk,jpnh4) = tra(:,:,jk,jpnh4) + zolimi (:,:,jk) + denitr(:,:,jk) 
    296          tra(:,:,jk,jpno3) = tra(:,:,jk,jpno3) - denitr (:,:,jk) * rdenit 
    297          tra(:,:,jk,jpdoc) = tra(:,:,jk,jpdoc) - zolimi (:,:,jk) - denitr(:,:,jk) 
    298          tra(:,:,jk,jpoxy) = tra(:,:,jk,jpoxy) - zolimi (:,:,jk) * o2ut 
    299          tra(:,:,jk,jpdic) = tra(:,:,jk,jpdic) + zolimi (:,:,jk) + denitr(:,:,jk) 
    300          tra(:,:,jk,jptal) = tra(:,:,jk,jptal) + rno3 * ( zolimi(:,:,jk) + ( rdenit + 1.) * denitr(:,:,jk) ) 
    301       END DO 
    302267 
    303268      IF( knt == nrdttrc ) THEN 
    … …  
    316281          CALL wrk_dealloc( jpi, jpj, jpk, zw3d ) 
    317282       ENDIF 
    318  
    319       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    320          WRITE(charout, FMT="('rem6')") 
    321          CALL prt_ctl_trc_info(charout) 
    322          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
    323       ENDIF 
    324283      ! 
    325284      CALL wrk_dealloc( jpi, jpj,      ztempbac                  ) 
    326       CALL wrk_dealloc( jpi, jpj, jpk, zdepbac, zdepprod, zolimi ) 
     285      CALL wrk_dealloc( jpi, jpj, jpk, zdepbac, zdepprod, zolimi, zfacsi, zfacsib ) 
    327286      ! 
    328287      IF( nn_timing == 1 )  CALL timing_stop('p4z_rem') 
    … …  
    343302      !! 
    344303      !!---------------------------------------------------------------------- 
    345       NAMELIST/nampisrem/ xremik, xremip, nitrif, xsirem, xsiremlab, xsilab 
     304      NAMELIST/nampisrem/ xremik, nitrif, xsirem, xsiremlab, xsilab, feratb, xkferb, &  
     305         &                xremikc, xremikn, xremikp 
    346306      INTEGER :: ios                 ! Local integer output status for namelist read 
    347307 
    … …  
    359319         WRITE(numout,*) ' Namelist parameters for remineralization, nampisrem' 
    360320         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    361          WRITE(numout,*) '    remineralisation rate of POC              xremip    =', xremip 
    362          WRITE(numout,*) '    remineralization rate of DOC              xremik    =', xremik 
     321         IF( ln_p4z ) THEN 
     322            WRITE(numout,*) '    remineralization rate of DOC              xremik    =', xremik 
     323         ELSE 
     324            WRITE(numout,*) '    remineralization rate of DOC              xremikc   =', xremikc 
     325            WRITE(numout,*) '    remineralization rate of DON              xremikn   =', xremikn 
     326            WRITE(numout,*) '    remineralization rate of DOP              xremikp   =', xremikp 
     327         ENDIF 
    363328         WRITE(numout,*) '    remineralization rate of Si               xsirem    =', xsirem 
    364329         WRITE(numout,*) '    fast remineralization rate of Si          xsiremlab =', xsiremlab 
    365330         WRITE(numout,*) '    fraction of labile biogenic silica        xsilab    =', xsilab 
    366331         WRITE(numout,*) '    NH4 nitrification rate                    nitrif    =', nitrif 
     332         WRITE(numout,*) '    Bacterial Fe/C ratio                      feratb    =', feratb 
     333         WRITE(numout,*) '    Half-saturation constant for bact. Fe/C   xkferb    =', xkferb 
    367334      ENDIF 
    368335      ! 
    369336      denitr  (:,:,:) = 0._wp 
    370       denitnh4(:,:,:) = 0._wp 
    371337      ! 
    372338   END SUBROUTINE p4z_rem_init 
    … …  
    377343      !!                     ***  ROUTINE p4z_rem_alloc  *** 
    378344      !!---------------------------------------------------------------------- 
    379       ALLOCATE( denitr(jpi,jpj,jpk), denitnh4(jpi,jpj,jpk), STAT=p4z_rem_alloc ) 
     345      ALLOCATE( denitr(jpi,jpj,jpk), STAT=p4z_rem_alloc ) 
    380346      ! 
    381347      IF( p4z_rem_alloc /= 0 )   CALL ctl_warn('p4z_rem_alloc: failed to allocate arrays') 
    382348      ! 
    383349   END FUNCTION p4z_rem_alloc 
    384  
    385 #else 
    386    !!====================================================================== 
    387    !!  Dummy module :                                   No PISCES bio-model 
    388    !!====================================================================== 
    389 CONTAINS 
    390    SUBROUTINE p4z_rem                    ! Empty routine 
    391    END SUBROUTINE p4z_rem 
    392 #endif  
    393350 
    394351   !!====================================================================== 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsbc.F90

    r6962 r7646  
    55   !!====================================================================== 
    66   !! History :   3.5  !  2012-07 (O. Aumont, C. Ethe) Original code 
    7    !!---------------------------------------------------------------------- 
    8 #if defined key_pisces 
    9    !!---------------------------------------------------------------------- 
    10    !!   'key_pisces'                                       PISCES bio-model 
    117   !!---------------------------------------------------------------------- 
    128   !!   p4z_sbc        :  Read and interpolate time-varying nutrients fluxes 
    … …  
    4137   REAL(wp), PUBLIC  :: concfediaz  !: Fe half-saturation Cste for diazotrophs  
    4238   REAL(wp)          :: hratio      !: Fe:3He ratio assumed for vent iron supply 
     39   REAL(wp), PUBLIC  :: fep_rats    !: Fep/Fer ratio from sed  sources 
     40   REAL(wp), PUBLIC  :: fep_rath    !: Fep/Fer ratio from hydro sources 
     41   REAL(wp), PUBLIC  :: lgw_rath    !: Weak ligand ratio from hydro sources 
     42 
    4343 
    4444   LOGICAL , PUBLIC  :: ll_sbc 
    … …  
    7070   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:) :: rivdic, rivalk    !: river input fields 
    7171   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:) :: rivdin, rivdip    !: river input fields 
     72   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:) :: rivdon, rivdop    !: river input fields 
     73   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:) :: rivdoc    !: river input fields 
    7274   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:) :: rivdsi    !: river input fields 
    7375   REAL(wp), PUBLIC, ALLOCATABLE, SAVE,   DIMENSION(:,:) :: nitdep    !: atmospheric N deposition  
    … …  
    134136         IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_riv > 1 ) ) THEN 
    135137            CALL fld_read( kt, 1, sf_river ) 
    136             DO jj = 1, jpj 
    137                DO ji = 1, jpi 
    138                   zcoef = ryyss * e1e2t(ji,jj) * h_rnf(ji,jj)  
    139                   rivalk(ji,jj) =   sf_river(jr_dic)%fnow(ji,jj,1)                                    & 
    140                      &              * 1.E3        / ( 12. * zcoef + rtrn ) 
    141                   rivdic(ji,jj) = ( sf_river(jr_dic)%fnow(ji,jj,1) + sf_river(jr_doc)%fnow(ji,jj,1) ) & 
    142                      &              * 1.E3         / ( 12. * zcoef + rtrn ) 
    143                   rivdin(ji,jj) = ( sf_river(jr_din)%fnow(ji,jj,1) + sf_river(jr_don)%fnow(ji,jj,1) ) & 
    144                      &              * 1.E3 / rno3 / ( 14. * zcoef + rtrn ) 
    145                   rivdip(ji,jj) = ( sf_river(jr_dip)%fnow(ji,jj,1) + sf_river(jr_dop)%fnow(ji,jj,1) ) & 
    146                      &              * 1.E3 / po4r / ( 31. * zcoef + rtrn ) 
    147                   rivdsi(ji,jj) =   sf_river(jr_dsi)%fnow(ji,jj,1)                                    & 
    148                      &              * 1.E3        / ( 28.1 * zcoef + rtrn ) 
     138            IF( ln_p4z ) THEN 
     139               DO jj = 1, jpj 
     140                  DO ji = 1, jpi 
     141                     zcoef = ryyss * e1e2t(ji,jj) * h_rnf(ji,jj)  
     142                     rivalk(ji,jj) =   sf_river(jr_dic)%fnow(ji,jj,1)                                    & 
     143                        &              * 1.E3        / ( 12. * zcoef + rtrn ) 
     144                     rivdic(ji,jj) = ( sf_river(jr_dic)%fnow(ji,jj,1) + sf_river(jr_doc)%fnow(ji,jj,1) ) & 
     145                        &              * 1.E3         / ( 12. * zcoef + rtrn ) 
     146                     rivdin(ji,jj) = ( sf_river(jr_din)%fnow(ji,jj,1) + sf_river(jr_don)%fnow(ji,jj,1) ) & 
     147                        &              * 1.E3 / rno3 / ( 14. * zcoef + rtrn ) 
     148                     rivdip(ji,jj) = ( sf_river(jr_dip)%fnow(ji,jj,1) + sf_river(jr_dop)%fnow(ji,jj,1) ) & 
     149                        &              * 1.E3 / po4r / ( 31. * zcoef + rtrn ) 
     150                     rivdsi(ji,jj) =   sf_river(jr_dsi)%fnow(ji,jj,1)                                    & 
     151                        &              * 1.E3        / ( 28.1 * zcoef + rtrn ) 
     152                  END DO 
    149153               END DO 
    150             END DO 
     154            ELSE    !  ln_p5z 
     155               DO jj = 1, jpj 
     156                  DO ji = 1, jpi 
     157                     zcoef = ryyss * e1e2t(ji,jj) * h_rnf(ji,jj)  
     158                     rivalk(ji,jj) =   sf_river(jr_dic)%fnow(ji,jj,1)                                    & 
     159                        &              * 1.E3        / ( 12. * zcoef + rtrn ) 
     160                     rivdic(ji,jj) = ( sf_river(jr_dic)%fnow(ji,jj,1) ) & 
     161                        &              * 1.E3 / ( 12. * zcoef + rtrn ) * tmask(ji,jj,1) 
     162                     rivdin(ji,jj) = ( sf_river(jr_din)%fnow(ji,jj,1) ) & 
     163                        &              * 1.E3 / rno3 / ( 14. * zcoef + rtrn ) * tmask(ji,jj,1) 
     164                     rivdip(ji,jj) = ( sf_river(jr_dip)%fnow(ji,jj,1) ) & 
     165                        &              * 1.E3 / po4r / ( 31. * zcoef + rtrn ) * tmask(ji,jj,1) 
     166                     rivdoc(ji,jj) = ( sf_river(jr_doc)%fnow(ji,jj,1) ) & 
     167                        &              * 1.E3 / ( 12. * zcoef + rtrn ) * tmask(ji,jj,1) 
     168                     rivdon(ji,jj) = ( sf_river(jr_don)%fnow(ji,jj,1) ) & 
     169                        &              * 1.E3 / rno3 / ( 14. * zcoef + rtrn ) * tmask(ji,jj,1) 
     170                     rivdop(ji,jj) = ( sf_river(jr_dop)%fnow(ji,jj,1) ) & 
     171                        &              * 1.E3 / po4r / ( 31. * zcoef + rtrn ) * tmask(ji,jj,1) 
     172                  END DO 
     173               END DO 
     174            ENDIF 
    151175         ENDIF 
    152176      ENDIF 
    … …  
    205229        &                sn_riverdip, sn_riverdop, sn_riverdsi, sn_ndepo, sn_ironsed, sn_hydrofe, & 
    206230        &                ln_dust, ln_solub, ln_river, ln_ndepo, ln_ironsed, ln_ironice, ln_hydrofe,    & 
    207         &                sedfeinput, dustsolub, icefeinput, wdust, mfrac, nitrfix, diazolight, concfediaz, hratio 
     231        &                sedfeinput, dustsolub, icefeinput, wdust, mfrac, nitrfix, diazolight, concfediaz, & 
     232        &                hratio, fep_rats, fep_rath, lgw_rath 
    208233      !!---------------------------------------------------------------------- 
    209234      ! 
    … …  
    249274         WRITE(numout,*) '    fe half-saturation cste for diazotrophs  concfediaz  = ', concfediaz 
    250275         WRITE(numout,*) '    Fe to 3He ratio assumed for vent iron supply hratio  = ', hratio 
     276         IF( ln_ligand ) THEN 
     277            WRITE(numout,*) '    Fep/Fer ratio from sed sources            fep_rats   = ', fep_rats 
     278            WRITE(numout,*) '    Fep/Fer ratio from sed hydro sources      fep_rath   = ', fep_rath 
     279            WRITE(numout,*) '    Weak ligand ratio from sed hydro sources  lgw_rath   = ', lgw_rath 
     280         ENDIF 
    251281      END IF 
    252282 
    … …  
    261291      ! set the number of level over which river runoffs are applied  
    262292      ! online configuration : computed in sbcrnf 
    263       IF( lk_offline ) THEN 
     293      IF( l_offline ) THEN 
    264294        nk_rnf(:,:) = 1 
    265295        h_rnf (:,:) = gdept_n(:,:,1) 
    … …  
    291321            END DO 
    292322            CALL iom_close( numdust ) 
    293             ztimes_dust = 1._wp / FLOAT( ntimes_dust )  
     323            ztimes_dust = 1._wp / REAL(ntimes_dust, wp)  
    294324            sumdepsi = 0.e0 
    295325            DO jm = 1, ntimes_dust 
    … …  
    334364         ! 
    335365         ALLOCATE( rivdic(jpi,jpj), rivalk(jpi,jpj), rivdin(jpi,jpj), rivdip(jpi,jpj), rivdsi(jpi,jpj) )  
     366         IF( ln_p5z )  ALLOCATE( rivdon(jpi,jpj), rivdop(jpi,jpj), rivdoc(jpi,jpj) ) 
    336367         ! 
    337368         ALLOCATE( sf_river(jpriv), rivinput(jpriv), STAT=ierr1 )           !* allocate and fill sf_river (forcing structure) with sn_river_ 
    … …  
    355386               END DO 
    356387               CALL iom_close( numriv ) 
    357                ztimes_riv = 1._wp / FLOAT(ntimes_riv)  
     388               ztimes_riv = 1._wp / REAL(ntimes_riv, wp)  
    358389               DO jm = 1, ntimes_riv 
    359390                  rivinput(ifpr) = rivinput(ifpr) + glob_sum( zriver(:,:,jm) * tmask(:,:,1) * ztimes_riv )  
    … …  
    402433            END DO 
    403434            CALL iom_close( numdepo ) 
    404             ztimes_ndep = 1._wp / FLOAT( ntimes_ndep )  
     435            ztimes_ndep = 1._wp / REAL(ntimes_ndep, wp)  
    405436            nitdepinput = 0._wp 
    406437            DO jm = 1, ntimes_ndep 
    … …  
    508539   END SUBROUTINE p4z_sbc_init 
    509540 
    510 #else 
    511    !!====================================================================== 
    512    !!  Dummy module :                                   No PISCES bio-model 
    513    !!====================================================================== 
    514 CONTAINS 
    515    SUBROUTINE p4z_sbc                         ! Empty routine 
    516    END SUBROUTINE p4z_sbc 
    517 #endif  
    518  
    519541   !!====================================================================== 
    520542END MODULE p4zsbc 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsed.F90

    r6140 r7646  
    99   !!             3.5  !  2012-07 (O. Aumont) improvment of river input of nutrients  
    1010   !!---------------------------------------------------------------------- 
    11 #if defined key_pisces 
    12    !!---------------------------------------------------------------------- 
    13    !!   'key_pisces'                                       PISCES bio-model 
    14    !!---------------------------------------------------------------------- 
    1511   !!   p4z_sed        :  Compute loss of organic matter in the sediments 
    1612   !!---------------------------------------------------------------------- 
    … …  
    1814   USE trc             !  passive tracers common variables  
    1915   USE sms_pisces      !  PISCES Source Minus Sink variables 
    20    USE p4zsink         !  vertical flux of particulate matter due to sinking 
    21    USE p4zopt          !  optical model 
    2216   USE p4zlim          !  Co-limitations of differents nutrients 
    2317   USE p4zsbc          !  External source of nutrients  
    … …  
    5650      INTEGER, INTENT(in) ::   kt, knt ! ocean time step 
    5751      INTEGER  ::   ji, jj, jk, ikt 
    58 #if ! defined key_sed 
    5952      REAL(wp) ::   zsumsedsi, zsumsedpo4, zsumsedcal 
    6053      REAL(wp) ::   zrivalk, zrivsil, zrivno3 
    61 #endif 
    6254      REAL(wp) ::  zwflux, zfminus, zfplus 
    6355      REAL(wp) ::  zlim, zfact, zfactcal 
    6456      REAL(wp) ::  zo2, zno3, zflx, zpdenit, z1pdenit, zdenitt, zolimit 
    65       REAL(wp) ::  zsiloss, zcaloss, zws3, zws4, zwsc, zdep, zwstpoc 
    66       REAL(wp) ::  ztrfer, ztrpo4, zwdust, zlight 
     57      REAL(wp) ::  zsiloss, zcaloss, zws3, zws4, zwsc, zdep 
     58      REAL(wp) ::  zwstpoc, zwstpon, zwstpop 
     59      REAL(wp) ::  ztrfer, ztrpo4s, ztrdp, zwdust, zmudia, ztemp 
     60      REAL(wp) ::  xdiano3, xdianh4 
     61      REAL(wp) ::  zwssfep 
    6762      ! 
    6863      CHARACTER (len=25) :: charout 
    69       REAL(wp), POINTER, DIMENSION(:,:  ) :: zpdep, zsidep, zwork1, zwork2, zwork3 
     64      REAL(wp), POINTER, DIMENSION(:,:  ) :: zsidep, zwork1, zwork2, zwork3 
    7065      REAL(wp), POINTER, DIMENSION(:,:  ) :: zdenit2d, zironice, zbureff 
    7166      REAL(wp), POINTER, DIMENSION(:,:  ) :: zwsbio3, zwsbio4, zwscal 
    72       REAL(wp), POINTER, DIMENSION(:,:,:) :: zirondep, zsoufer 
     67      REAL(wp), POINTER, DIMENSION(:,:  ) :: zsedcal, zsedsi, zsedc 
     68      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrpo4, ztrdop, zirondep, zsoufer, zpdep, zlight 
     69      REAL(wp), POINTER, DIMENSION(:,:  ) :: zwsfep 
     70 
    7371      !!--------------------------------------------------------------------- 
    7472      ! 
    … …  
    7876      ! 
    7977      ! Allocate temporary workspace 
    80       CALL wrk_alloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zbureff ) 
    81       CALL wrk_alloc( jpi, jpj, zwsbio3, zwsbio4, zwscal ) 
    82       CALL wrk_alloc( jpi, jpj, jpk, zsoufer ) 
     78                      CALL wrk_alloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zbureff ) 
     79                      CALL wrk_alloc( jpi, jpj, zwsbio3, zwsbio4, zwscal ) 
     80                      CALL wrk_alloc( jpi, jpj, zsedcal,  zsedsi, zsedc ) 
     81                      CALL wrk_alloc( jpi, jpj, jpk, zlight, zsoufer ) 
     82      IF( ln_p5z )    CALL wrk_alloc( jpi, jpj, jpk, ztrpo4, ztrdop ) 
     83      IF( ln_ligand ) CALL wrk_alloc( jpi, jpj, zwsfep ) 
     84 
    8385 
    8486      zdenit2d(:,:) = 0.e0 
    … …  
    8789      zwork2  (:,:) = 0.e0 
    8890      zwork3  (:,:) = 0.e0 
     91      zsedsi  (:,:) = 0.e0 
     92      zsedcal (:,:) = 0.e0 
     93      zsedc   (:,:) = 0.e0 
     94 
    8995 
    9096      ! Iron input/uptake due to sea ice : Crude parameterization based on Lancelot et al. 
    … …  
    117123      IF( ln_dust ) THEN 
    118124         !                                               
    119          CALL wrk_alloc( jpi, jpj,      zpdep, zsidep ) 
    120          CALL wrk_alloc( jpi, jpj, jpk, zirondep      ) 
     125         CALL wrk_alloc( jpi, jpj,      zsidep ) 
     126         CALL wrk_alloc( jpi, jpj, jpk, zpdep, zirondep      ) 
    121127         !                                              ! Iron and Si deposition at the surface 
    122128         IF( ln_solub ) THEN 
    … …  
    125131            zirondep(:,:,1) = dustsolub  * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 55.85 + 3.e-10 * r1_ryyss  
    126132         ENDIF 
    127          zsidep(:,:) = 8.8 * 0.075 * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 28.1  
    128          zpdep (:,:) = 0.1 * 0.021 * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 31. / po4r  
     133         zsidep(:,:)   = 8.8 * 0.075 * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 28.1  
     134         zpdep (:,:,1) = 0.1 * 0.021 * dust(:,:) * mfrac * rfact2 / e3t_n(:,:,1) / 31. / po4r  
    129135         !                                              ! Iron solubilization of particles in the water column 
    130136         !                                              ! dust in kg/m2/s ---> 1/55.85 to put in mol/Fe ;  wdust in m/j 
    … …  
    132138         DO jk = 2, jpkm1 
    133139            zirondep(:,:,jk) = dust(:,:) * mfrac * zwdust * rfact2 * EXP( -gdept_n(:,:,jk) / 540. ) 
     140            zpdep   (:,:,jk) = zirondep(:,:,jk) * 0.023 
    134141         END DO 
    135142         !                                              ! Iron solubilization of particles in the water column 
    136          tra(:,:,1,jppo4) = tra(:,:,1,jppo4) + zpdep   (:,:) 
    137143         tra(:,:,1,jpsil) = tra(:,:,1,jpsil) + zsidep  (:,:) 
     144         tra(:,:,:,jppo4) = tra(:,:,:,jppo4) + zpdep   (:,:,:) 
    138145         tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + zirondep(:,:,:)  
    139146         !  
    … …  
    145152                &  CALL iom_put( "pdust"  , dust(:,:) / ( wdust * rday )  * tmask(:,:,1) ) ! dust concentration at surface 
    146153            ENDIF 
    147          ELSE                                     
    148             IF( ln_diatrc )  & 
    149               &  trc2d(:,:,jp_pcs0_2d + 11) = zirondep(:,:,1) * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1) 
    150154         ENDIF 
    151          CALL wrk_dealloc( jpi, jpj,      zpdep, zsidep ) 
    152          CALL wrk_dealloc( jpi, jpj, jpk, zirondep      ) 
     155         CALL wrk_dealloc( jpi, jpj,      zsidep ) 
     156         CALL wrk_dealloc( jpi, jpj, jpk, zpdep, zirondep      ) 
    153157         !                                               
    154158      ENDIF 
    … …  
    169173            ENDDO 
    170174         ENDDO 
     175         IF( ln_p5z ) THEN 
     176            DO jj = 1, jpj 
     177               DO ji = 1, jpi 
     178                  DO jk = 1, nk_rnf(ji,jj) 
     179                     tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + rivdop(ji,jj) * rfact2 
     180                     tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + rivdon(ji,jj) * rfact2 
     181                     tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + rivdoc(ji,jj) * rfact2 
     182                  ENDDO 
     183               ENDDO 
     184            ENDDO 
     185         ENDIF 
    171186      ENDIF 
    172187       
    … …  
    181196      ! ------------------------------------------------------ 
    182197      IF( ln_ironsed ) THEN 
    183          tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + ironsed(:,:,:) * rfact2 
     198                         tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + ironsed(:,:,:) * rfact2 
     199         IF( ln_ligand ) tra(:,:,:,jpfep) = tra(:,:,:,jpfep) + ( ironsed(:,:,:) * fep_rats ) * rfact2 
    184200         ! 
    185201         IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "Ironsed" ) )   & 
    … …  
    190206      ! ------------------------------------------------------ 
    191207      IF( ln_hydrofe ) THEN 
    192          tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + hydrofe(:,:,:) * rfact2 
     208            tra(:,:,:,jpfer) = tra(:,:,:,jpfer) + hydrofe(:,:,:) * rfact2 
     209         IF( ln_ligand ) THEN 
     210            tra(:,:,:,jpfep) = tra(:,:,:,jpfep) + ( hydrofe(:,:,:) * fep_rath ) * rfact2 
     211            tra(:,:,:,jplgw) = tra(:,:,:,jplgw) + ( hydrofe(:,:,:) * lgw_rath ) * rfact2 
     212         ENDIF 
    193213         ! 
    194214         IF( lk_iomput .AND. knt == nrdttrc .AND. iom_use( "HYDR" ) )   & 
    … …  
    196216      ENDIF 
    197217 
    198       ! OA: Warning, the following part is necessary, especially with Kriest 
    199       ! to avoid CFL problems above the sediments 
     218      ! OA: Warning, the following part is necessary to avoid CFL problems above the sediments 
    200219      ! -------------------------------------------------------------------- 
    201220      DO jj = 1, jpj 
    … …  
    208227         END DO 
    209228      END DO 
    210  
    211 #if ! defined key_sed 
    212       ! Computation of the sediment denitrification proportion: The metamodel from midlleburg (2006) is being used 
    213       ! Computation of the fraction of organic matter that is permanently buried from Dunne's model 
    214       ! ------------------------------------------------------- 
    215       DO jj = 1, jpj 
    216          DO ji = 1, jpi 
    217            IF( tmask(ji,jj,1) == 1 ) THEN 
    218               ikt = mbkt(ji,jj) 
    219 # if defined key_kriest 
    220               zflx =    trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj)    * 1E3 * 1E6 / 1E4 
    221 # else 
    222               zflx = (  trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj)   & 
    223                 &     + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) )  * 1E3 * 1E6 / 1E4 
    224 #endif 
    225               zflx  = LOG10( MAX( 1E-3, zflx ) ) 
    226               zo2   = LOG10( MAX( 10. , trb(ji,jj,ikt,jpoxy) * 1E6 ) ) 
    227               zno3  = LOG10( MAX( 1.  , trb(ji,jj,ikt,jpno3) * 1E6 * rno3 ) ) 
    228               zdep  = LOG10( gdepw_n(ji,jj,ikt+1) ) 
    229               zdenit2d(ji,jj) = -2.2567 - 1.185 * zflx - 0.221 * zflx**2 - 0.3995 * zno3 * zo2 + 1.25 * zno3    & 
    230               &                + 0.4721 * zo2 - 0.0996 * zdep + 0.4256 * zflx * zo2 
    231               zdenit2d(ji,jj) = 10.0**( zdenit2d(ji,jj) ) 
    232               ! 
    233               zflx = (  trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj)   & 
    234                 &     + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) ) * 1E6 
    235               zbureff(ji,jj) = 0.013 + 0.53 * zflx**2 / ( 7.0 + zflx )**2 
    236            ENDIF 
    237          END DO 
    238       END DO  
    239  
    240       ! Loss of biogenic silicon, Caco3 organic carbon in the sediments.  
    241       ! First, the total loss is computed. 
    242       ! The factor for calcite comes from the alkalinity effect 
    243       ! ------------------------------------------------------------- 
    244       DO jj = 1, jpj 
    245          DO ji = 1, jpi 
    246             IF( tmask(ji,jj,1) == 1 ) THEN 
    247                ikt = mbkt(ji,jj)  
    248 # if defined key_kriest 
    249                zwork1(ji,jj) = trb(ji,jj,ikt,jpgsi) * zwscal (ji,jj) 
    250                zwork2(ji,jj) = trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) 
    251 # else 
    252                zwork1(ji,jj) = trb(ji,jj,ikt,jpgsi) * zwsbio4(ji,jj) 
    253                zwork2(ji,jj) = trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj)  
    254 # endif 
    255                ! For calcite, burial efficiency is made a function of saturation 
    256                zfactcal      = MIN( excess(ji,jj,ikt), 0.2 ) 
    257                zfactcal      = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) ) 
    258                zwork3(ji,jj) = trb(ji,jj,ikt,jpcal) * zwscal(ji,jj) * 2.e0 * zfactcal 
    259             ENDIF 
    260          END DO 
    261       END DO 
    262       zsumsedsi  = glob_sum( zwork1(:,:) * e1e2t(:,:) ) * r1_rday 
    263       zsumsedpo4 = glob_sum( zwork2(:,:) * e1e2t(:,:) ) * r1_rday 
    264       zsumsedcal = glob_sum( zwork3(:,:) * e1e2t(:,:) ) * r1_rday 
    265 #endif 
     229      ! 
     230      IF( ln_ligand ) THEN 
     231         DO jj = 1, jpj 
     232            DO ji = 1, jpi 
     233               ikt  = mbkt(ji,jj) 
     234               zdep = e3t_n(ji,jj,ikt) / xstep 
     235               zwsfep(ji,jj)  = MIN( 0.99 * zdep, wsfep(ji,jj,ikt)  ) 
     236            END DO 
     237         ENDDO 
     238      ENDIF 
     239 
     240      IF( .NOT.lk_sed ) THEN 
     241         ! Computation of the sediment denitrification proportion: The metamodel from midlleburg (2006) is being used 
     242         ! Computation of the fraction of organic matter that is permanently buried from Dunne's model 
     243         ! ------------------------------------------------------- 
     244         DO jj = 1, jpj 
     245            DO ji = 1, jpi 
     246              IF( tmask(ji,jj,1) == 1 ) THEN 
     247                 ikt = mbkt(ji,jj) 
     248                 zflx = (  trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj)   & 
     249                   &     + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) )  * 1E3 * 1E6 / 1E4 
     250                 zflx  = LOG10( MAX( 1E-3, zflx ) ) 
     251                 zo2   = LOG10( MAX( 10. , trb(ji,jj,ikt,jpoxy) * 1E6 ) ) 
     252                 zno3  = LOG10( MAX( 1.  , trb(ji,jj,ikt,jpno3) * 1E6 * rno3 ) ) 
     253                 zdep  = LOG10( gdepw_n(ji,jj,ikt+1) ) 
     254                 zdenit2d(ji,jj) = -2.2567 - 1.185 * zflx - 0.221 * zflx**2 - 0.3995 * zno3 * zo2 + 1.25 * zno3    & 
     255                   &                + 0.4721 * zo2 - 0.0996 * zdep + 0.4256 * zflx * zo2 
     256                 zdenit2d(ji,jj) = 10.0**( zdenit2d(ji,jj) ) 
     257                   ! 
     258                 zflx = (  trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj)   & 
     259                   &     + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj) ) * 1E6 
     260                 zbureff(ji,jj) = 0.013 + 0.53 * zflx**2 / ( 7.0 + zflx )**2 
     261                ENDIF 
     262              END DO 
     263           END DO  
     264 
     265           ! Loss of biogenic silicon, Caco3 organic carbon in the sediments.  
     266           ! First, the total loss is computed. 
     267           ! The factor for calcite comes from the alkalinity effect 
     268           ! ------------------------------------------------------------- 
     269           DO jj = 1, jpj 
     270              DO ji = 1, jpi 
     271                 IF( tmask(ji,jj,1) == 1 ) THEN 
     272                    ikt = mbkt(ji,jj)  
     273                    zwork1(ji,jj) = trb(ji,jj,ikt,jpgsi) * zwsbio4(ji,jj) 
     274                    zwork2(ji,jj) = trb(ji,jj,ikt,jpgoc) * zwsbio4(ji,jj) + trb(ji,jj,ikt,jppoc) * zwsbio3(ji,jj)  
     275                    ! For calcite, burial efficiency is made a function of saturation 
     276                    zfactcal      = MIN( excess(ji,jj,ikt), 0.2 ) 
     277                    zfactcal      = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) ) 
     278                    zwork3(ji,jj) = trb(ji,jj,ikt,jpcal) * zwscal(ji,jj) * 2.e0 * zfactcal 
     279                ENDIF 
     280            END DO 
     281         END DO 
     282         zsumsedsi  = glob_sum( zwork1(:,:) * e1e2t(:,:) ) * r1_rday 
     283         zsumsedpo4 = glob_sum( zwork2(:,:) * e1e2t(:,:) ) * r1_rday 
     284         zsumsedcal = glob_sum( zwork3(:,:) * e1e2t(:,:) ) * r1_rday 
     285         ! 
     286      ENDIF 
    266287 
    267288      ! This loss is scaled at each bottom grid cell for equilibrating the total budget of silica in the ocean. 
    268289      ! Thus, the amount of silica lost in the sediments equal the supply at the surface (dust+rivers) 
    269290      ! ------------------------------------------------------ 
    270 #if ! defined key_sed 
    271       zrivsil =  1._wp - ( sumdepsi + rivdsiinput * r1_ryyss ) / ( zsumsedsi + rtrn ) 
    272 #endif 
     291      IF( .NOT.lk_sed )  zrivsil =  1._wp - ( sumdepsi + rivdsiinput * r1_ryyss ) / ( zsumsedsi + rtrn ) 
    273292 
    274293      DO jj = 1, jpj 
    … …  
    276295            ikt  = mbkt(ji,jj) 
    277296            zdep = xstep / e3t_n(ji,jj,ikt)  
    278             zws4 = zwsbio4(ji,jj) * zdep 
    279297            zwsc = zwscal (ji,jj) * zdep 
    280 # if defined key_kriest 
    281             zsiloss = trb(ji,jj,ikt,jpgsi) * zws4 
    282 # else 
    283298            zsiloss = trb(ji,jj,ikt,jpgsi) * zwsc 
    284 # endif 
    285299            zcaloss = trb(ji,jj,ikt,jpcal) * zwsc 
    286300            ! 
    287301            tra(ji,jj,ikt,jpgsi) = tra(ji,jj,ikt,jpgsi) - zsiloss 
    288302            tra(ji,jj,ikt,jpcal) = tra(ji,jj,ikt,jpcal) - zcaloss 
    289 #if ! defined key_sed 
    290             tra(ji,jj,ikt,jpsil) = tra(ji,jj,ikt,jpsil) + zsiloss * zrivsil  
    291             zfactcal = MIN( excess(ji,jj,ikt), 0.2 ) 
    292             zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) ) 
    293             zrivalk  =  1._wp - ( rivalkinput * r1_ryyss ) * zfactcal / ( zsumsedcal + rtrn ) 
    294             tra(ji,jj,ikt,jptal) =  tra(ji,jj,ikt,jptal) + zcaloss * zrivalk * 2.0 
    295             tra(ji,jj,ikt,jpdic) =  tra(ji,jj,ikt,jpdic) + zcaloss * zrivalk 
    296 #endif 
    297303         END DO 
    298304      END DO 
    299  
     305      ! 
     306      IF( .NOT.lk_sed ) THEN 
     307         DO jj = 1, jpj 
     308            DO ji = 1, jpi 
     309               ikt  = mbkt(ji,jj) 
     310               zdep = xstep / e3t_n(ji,jj,ikt)  
     311               zwsc = zwscal (ji,jj) * zdep 
     312               zsiloss = trb(ji,jj,ikt,jpgsi) * zwsc 
     313               zcaloss = trb(ji,jj,ikt,jpcal) * zwsc 
     314               tra(ji,jj,ikt,jpsil) = tra(ji,jj,ikt,jpsil) + zsiloss * zrivsil  
     315               ! 
     316               zfactcal = MIN( excess(ji,jj,ikt), 0.2 ) 
     317               zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) ) 
     318               zrivalk  =  1._wp - ( rivalkinput * r1_ryyss ) * zfactcal / ( zsumsedcal + rtrn ) 
     319               tra(ji,jj,ikt,jptal) =  tra(ji,jj,ikt,jptal) + zcaloss * zrivalk * 2.0 
     320               tra(ji,jj,ikt,jpdic) =  tra(ji,jj,ikt,jpdic) + zcaloss * zrivalk 
     321               zsedcal(ji,jj) = (1.0 - zrivalk) * zcaloss / zdep 
     322               zsedsi (ji,jj) = (1.0 - zrivsil) * zsiloss / zdep 
     323            END DO 
     324         END DO 
     325      ENDIF 
     326      ! 
    300327      DO jj = 1, jpj 
    301328         DO ji = 1, jpi 
    … …  
    304331            zws4 = zwsbio4(ji,jj) * zdep 
    305332            zws3 = zwsbio3(ji,jj) * zdep 
    306             zrivno3 = 1. - zbureff(ji,jj) 
    307 # if ! defined key_kriest 
    308333            tra(ji,jj,ikt,jpgoc) = tra(ji,jj,ikt,jpgoc) - trb(ji,jj,ikt,jpgoc) * zws4  
    309334            tra(ji,jj,ikt,jppoc) = tra(ji,jj,ikt,jppoc) - trb(ji,jj,ikt,jppoc) * zws3 
    310335            tra(ji,jj,ikt,jpbfe) = tra(ji,jj,ikt,jpbfe) - trb(ji,jj,ikt,jpbfe) * zws4 
    311336            tra(ji,jj,ikt,jpsfe) = tra(ji,jj,ikt,jpsfe) - trb(ji,jj,ikt,jpsfe) * zws3 
    312             zwstpoc              = trb(ji,jj,ikt,jpgoc) * zws4 + trb(ji,jj,ikt,jppoc) * zws3 
    313 # else 
    314             tra(ji,jj,ikt,jpnum) = tra(ji,jj,ikt,jpnum) - trb(ji,jj,ikt,jpnum) * zws4  
    315             tra(ji,jj,ikt,jppoc) = tra(ji,jj,ikt,jppoc) - trb(ji,jj,ikt,jppoc) * zws3 
    316             tra(ji,jj,ikt,jpsfe) = tra(ji,jj,ikt,jpsfe) - trb(ji,jj,ikt,jpsfe) * zws3 
    317             zwstpoc = trb(ji,jj,ikt,jppoc) * zws3  
    318 # endif 
    319  
    320 #if ! defined key_sed 
    321             ! The 0.5 factor in zpdenit and zdenitt is to avoid negative NO3 concentration after both denitrification 
    322             ! in the sediments and just above the sediments. Not very clever, but simpliest option. 
    323             zpdenit  = MIN( 0.5 * ( trb(ji,jj,ikt,jpno3) - rtrn ) / rdenit, zdenit2d(ji,jj) * zwstpoc * zrivno3 ) 
    324             z1pdenit = zwstpoc * zrivno3 - zpdenit 
    325             zolimit = MIN( ( trb(ji,jj,ikt,jpoxy) - rtrn ) / o2ut, z1pdenit * ( 1.- nitrfac(ji,jj,ikt) ) ) 
    326             zdenitt = MIN(  0.5 * ( trb(ji,jj,ikt,jpno3) - rtrn ) / rdenit, z1pdenit * nitrfac(ji,jj,ikt) ) 
    327             tra(ji,jj,ikt,jpdoc) = tra(ji,jj,ikt,jpdoc) + z1pdenit - zolimit - zdenitt 
    328             tra(ji,jj,ikt,jppo4) = tra(ji,jj,ikt,jppo4) + zpdenit + zolimit + zdenitt 
    329             tra(ji,jj,ikt,jpnh4) = tra(ji,jj,ikt,jpnh4) + zpdenit + zolimit + zdenitt 
    330             tra(ji,jj,ikt,jpno3) = tra(ji,jj,ikt,jpno3) - rdenit * (zpdenit + zdenitt) 
    331             tra(ji,jj,ikt,jpoxy) = tra(ji,jj,ikt,jpoxy) - zolimit * o2ut 
    332             tra(ji,jj,ikt,jptal) = tra(ji,jj,ikt,jptal) + rno3 * (zolimit + (1.+rdenit) * (zpdenit + zdenitt) ) 
    333             tra(ji,jj,ikt,jpdic) = tra(ji,jj,ikt,jpdic) + zpdenit + zolimit + zdenitt 
    334             sdenit(ji,jj) = rdenit * zpdenit * e3t_n(ji,jj,ikt) 
    335 #endif 
    336337         END DO 
    337338      END DO 
     339      ! 
     340      IF( ln_ligand ) THEN 
     341         DO jj = 1, jpj 
     342            DO ji = 1, jpi 
     343               ikt     = mbkt(ji,jj) 
     344               zdep    = xstep / e3t_n(ji,jj,ikt)  
     345               zwssfep = zwsfep(ji,jj) * zdep 
     346               tra(ji,jj,ikt,jpfep) = tra(ji,jj,ikt,jpfep) - trb(ji,jj,ikt,jpfep) * zwssfep 
     347            END DO 
     348         END DO 
     349      ENDIF 
     350      ! 
     351      IF( ln_p5z ) THEN 
     352         DO jj = 1, jpj 
     353            DO ji = 1, jpi 
     354               ikt  = mbkt(ji,jj) 
     355               zdep = xstep / e3t_n(ji,jj,ikt)  
     356               zws4 = zwsbio4(ji,jj) * zdep 
     357               zws3 = zwsbio3(ji,jj) * zdep 
     358               tra(ji,jj,ikt,jpgon) = tra(ji,jj,ikt,jpgon) - trb(ji,jj,ikt,jpgon) * zws4 
     359               tra(ji,jj,ikt,jppon) = tra(ji,jj,ikt,jppon) - trb(ji,jj,ikt,jppon) * zws3 
     360               tra(ji,jj,ikt,jpgop) = tra(ji,jj,ikt,jpgop) - trb(ji,jj,ikt,jpgop) * zws4 
     361               tra(ji,jj,ikt,jppop) = tra(ji,jj,ikt,jppop) - trb(ji,jj,ikt,jppop) * zws3 
     362            END DO 
     363         END DO 
     364      ENDIF 
     365 
     366      IF( .NOT.lk_sed ) THEN 
     367         ! The 0.5 factor in zpdenit and zdenitt is to avoid negative NO3 concentration after both denitrification 
     368         ! in the sediments and just above the sediments. Not very clever, but simpliest option. 
     369         DO jj = 1, jpj 
     370            DO ji = 1, jpi 
     371               ikt  = mbkt(ji,jj) 
     372               zdep = xstep / e3t_n(ji,jj,ikt)  
     373               zws4 = zwsbio4(ji,jj) * zdep 
     374               zws3 = zwsbio3(ji,jj) * zdep 
     375               zrivno3 = 1. - zbureff(ji,jj) 
     376               zwstpoc = trb(ji,jj,ikt,jpgoc) * zws4 + trb(ji,jj,ikt,jppoc) * zws3 
     377               zpdenit  = MIN( 0.5 * ( trb(ji,jj,ikt,jpno3) - rtrn ) / rdenit, zdenit2d(ji,jj) * zwstpoc * zrivno3 ) 
     378               z1pdenit = zwstpoc * zrivno3 - zpdenit 
     379               zolimit = MIN( ( trb(ji,jj,ikt,jpoxy) - rtrn ) / o2ut, z1pdenit * ( 1.- nitrfac(ji,jj,ikt) ) ) 
     380               zdenitt = MIN(  0.5 * ( trb(ji,jj,ikt,jpno3) - rtrn ) / rdenit, z1pdenit * nitrfac(ji,jj,ikt) ) 
     381               tra(ji,jj,ikt,jpdoc) = tra(ji,jj,ikt,jpdoc) + z1pdenit - zolimit - zdenitt 
     382               tra(ji,jj,ikt,jppo4) = tra(ji,jj,ikt,jppo4) + zpdenit + zolimit + zdenitt 
     383               tra(ji,jj,ikt,jpnh4) = tra(ji,jj,ikt,jpnh4) + zpdenit + zolimit + zdenitt 
     384               tra(ji,jj,ikt,jpno3) = tra(ji,jj,ikt,jpno3) - rdenit * (zpdenit + zdenitt) 
     385               tra(ji,jj,ikt,jpoxy) = tra(ji,jj,ikt,jpoxy) - zolimit * o2ut 
     386               tra(ji,jj,ikt,jptal) = tra(ji,jj,ikt,jptal) + rno3 * (zolimit + (1.+rdenit) * (zpdenit + zdenitt) ) 
     387               tra(ji,jj,ikt,jpdic) = tra(ji,jj,ikt,jpdic) + zpdenit + zolimit + zdenitt 
     388               sdenit(ji,jj) = rdenit * zpdenit * e3t_n(ji,jj,ikt) 
     389               zsedc(ji,jj)   = (1. - zrivno3) * zwstpoc / zdep 
     390               IF( ln_p5z ) THEN 
     391                  zwstpop              = trb(ji,jj,ikt,jpgop) * zws4 + trb(ji,jj,ikt,jppop) * zws3 
     392                  zwstpon              = trb(ji,jj,ikt,jpgon) * zws4 + trb(ji,jj,ikt,jppon) * zws3 
     393                  tra(ji,jj,ikt,jpdon) = tra(ji,jj,ikt,jpdon) + (z1pdenit - zolimit - zdenitt) * zwstpon / (zwstpoc + rtrn) 
     394                  tra(ji,jj,ikt,jpdop) = tra(ji,jj,ikt,jpdop) + (z1pdenit - zolimit - zdenitt) * zwstpop / (zwstpoc + rtrn) 
     395               ENDIF 
     396            END DO 
     397         END DO 
     398       ENDIF 
     399 
    338400 
    339401      ! Nitrogen fixation process 
    … …  
    341403      !----------------------------------- 
    342404      DO jk = 1, jpkm1 
    343          DO jj = 1, jpj 
    344             DO ji = 1, jpi 
    345                !                      ! Potential nitrogen fixation dependant on temperature and iron 
    346                zlim = ( 1.- xnanono3(ji,jj,jk) - xnanonh4(ji,jj,jk) ) 
    347                IF( zlim <= 0.2 )   zlim = 0.01 
    348 #if defined key_degrad 
    349                zfact = zlim * rfact2 * facvol(ji,jj,jk) 
    350 #else 
    351                zfact = zlim * rfact2 
    352 #endif 
    353                ztrfer = biron(ji,jj,jk)       / ( concfediaz + biron(ji,jj,jk)       ) 
    354                ztrpo4 = trb  (ji,jj,jk,jppo4) / ( concnnh4   + trb  (ji,jj,jk,jppo4) )  
    355                zlight =  ( 1.- EXP( -etot_ndcy(ji,jj,jk) / diazolight ) )  
    356                nitrpot(ji,jj,jk) =  MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) * r1_rday )   & 
    357                  &         *  zfact * MIN( ztrfer, ztrpo4 ) * zlight 
    358                zsoufer(ji,jj,jk) = zlight * 2E-11 / (2E-11 + biron(ji,jj,jk)) 
    359             END DO 
    360          END DO 
    361       END DO 
     405         zlight (:,:,jk) =  ( 1.- EXP( -etot_ndcy(:,:,jk) / diazolight ) ) * ( 1. - fr_i(:,:) )  
     406         zsoufer(:,:,jk) = zlight(:,:,jk) * 2E-11 / ( 2E-11 + biron(:,:,jk) ) 
     407      ENDDO 
     408      IF( ln_p4z ) THEN 
     409         DO jk = 1, jpkm1 
     410            DO jj = 1, jpj 
     411               DO ji = 1, jpi 
     412                  !                      ! Potential nitrogen fixation dependant on temperature and iron 
     413                  zlim = ( 1.- xnanono3(ji,jj,jk) - xnanonh4(ji,jj,jk) ) 
     414                  IF( zlim <= 0.2 )   zlim = 0.01 
     415                  zfact = zlim * rfact2 
     416 
     417                  ztrfer  = biron(ji,jj,jk)       / ( concfediaz + biron(ji,jj,jk)       ) 
     418                  ztrpo4s = trb  (ji,jj,jk,jppo4) / ( concnnh4   + trb  (ji,jj,jk,jppo4) )  
     419                  nitrpot(ji,jj,jk) =  MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) * r1_rday ) & 
     420                    &                *  zfact * MIN( ztrfer, ztrpo4s ) * zlight(ji,jj,jk) 
     421               END DO 
     422            END DO 
     423         END DO 
     424      ELSE       ! p5z 
     425         DO jk = 1, jpkm1 
     426            DO jj = 1, jpj 
     427               DO ji = 1, jpi 
     428                  !                      ! Potential nitrogen fixation dependant on temperature and iron 
     429                  ztemp = tsn(ji,jj,jk,jp_tem) 
     430                  zmudia = MAX( 0.,-0.001096*ztemp**2 + 0.057*ztemp -0.637 ) * 7.625 
     431                  !       Potential nitrogen fixation dependant on temperature and iron 
     432                  xdianh4 = trb(ji,jj,jk,jpnh4) / ( concnnh4 + trb(ji,jj,jk,jpnh4) ) 
     433                  xdiano3 = trb(ji,jj,jk,jpno3) / ( concnno3 + trb(ji,jj,jk,jpno3) ) * (1. - xdianh4) 
     434                  zlim = ( 1.- xdiano3 - xdianh4 ) 
     435                  IF( zlim <= 0.1 )   zlim = 0.01 
     436                  zfact = zlim * rfact2 
     437                  ztrfer = biron(ji,jj,jk) / ( concfediaz + biron(ji,jj,jk) ) 
     438                  ztrpo4(ji,jj,jk) = trb(ji,jj,jk,jppo4) / ( 1E-6 + trb(ji,jj,jk,jppo4) ) 
     439                  ztrdop(ji,jj,jk) = trb(ji,jj,jk,jpdop) / ( 1E-6 + trb(ji,jj,jk,jpdop) ) * (1. - ztrpo4(ji,jj,jk)) 
     440                  ztrdp = ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) 
     441                  nitrpot(ji,jj,jk) =  zmudia * r1_rday * zfact * MIN( ztrfer, ztrdp ) * zlight(ji,jj,jk) 
     442               END DO 
     443            END DO 
     444         END DO 
     445      ENDIF 
    362446 
    363447      ! Nitrogen change due to nitrogen fixation 
    364448      ! ---------------------------------------- 
    365       DO jk = 1, jpkm1 
    366          DO jj = 1, jpj 
    367             DO ji = 1, jpi 
    368                zfact = nitrpot(ji,jj,jk) * nitrfix 
    369                tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) +             zfact 
    370                tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3      * zfact 
    371                tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2nit     * zfact  
    372                tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + concdnh4 / ( concdnh4 + trb(ji,jj,jk,jppo4) ) & 
    373                &                     * 0.002 * trb(ji,jj,jk,jpdoc) * xstep 
    374                tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * xstep 
    375            END DO 
    376          END DO  
    377       END DO 
     449      IF( ln_p4z ) THEN 
     450         DO jk = 1, jpkm1 
     451            DO jj = 1, jpj 
     452               DO ji = 1, jpi 
     453                  zfact = nitrpot(ji,jj,jk) * nitrfix 
     454                  tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) +             zfact 
     455                  tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3      * zfact 
     456                  tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2nit     * zfact  
     457                  tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + concdnh4 / ( concdnh4 + trb(ji,jj,jk,jppo4) ) & 
     458                  &                     * 0.002 * trb(ji,jj,jk,jpdoc) * xstep 
     459                  tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * xstep 
     460              END DO 
     461            END DO  
     462         END DO 
     463      ELSE    ! p5z 
     464         DO jk = 1, jpkm1 
     465            DO jj = 1, jpj 
     466               DO ji = 1, jpi 
     467                  zfact = nitrpot(ji,jj,jk) * nitrfix 
     468                  tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zfact / 3.0 
     469                  tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zfact / 3.0 
     470                  tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) - 16.0 / 46.0 * zfact * ( 1.0 - 1.0 / 3.0 ) & 
     471                  &                     * ztrpo4(ji,jj,jk) / (ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) + rtrn) 
     472                  tra(ji,jj,jk,jpdon) = tra(ji,jj,jk,jpdon) + zfact * 1.0 / 3.0 
     473                  tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zfact * 1.0 / 3.0 
     474                  tra(ji,jj,jk,jpdop) = tra(ji,jj,jk,jpdop) + 16.0 / 46.0 * zfact / 3.0  & 
     475                  &                     - 16.0 / 46.0 * zfact * ztrdop(ji,jj,jk)   & 
     476                  &                     / (ztrpo4(ji,jj,jk) + ztrdop(ji,jj,jk) + rtrn) 
     477                  tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zfact * 1.0 / 3.0 * 2.0 / 3.0 
     478                  tra(ji,jj,jk,jppon) = tra(ji,jj,jk,jppon) + zfact * 1.0 / 3.0 * 2.0 /3.0 
     479                  tra(ji,jj,jk,jppop) = tra(ji,jj,jk,jppop) + 16.0 / 46.0 * zfact * 1.0 / 3.0 * 2.0 /3.0 
     480                  tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zfact * 1.0 / 3.0 * 1.0 / 3.0 
     481                  tra(ji,jj,jk,jpgon) = tra(ji,jj,jk,jpgon) + zfact * 1.0 / 3.0 * 1.0 /3.0 
     482                  tra(ji,jj,jk,jpgop) = tra(ji,jj,jk,jpgop) + 16.0 / 46.0 * zfact * 1.0 / 3.0 * 1.0 /3.0 
     483                  tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + ( o2ut + o2nit ) * zfact * 2.0 / 3.0 + o2nit * zfact / 3.0 
     484                  tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - 30E-6 * zfact * 1.0 / 3.0  
     485                  tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + 30E-6 * zfact * 1.0 / 3.0 * 2.0 / 3.0 
     486                  tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + 30E-6 * zfact * 1.0 / 3.0 * 1.0 / 3.0 
     487                  tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + 0.002 * 4E-10 * zsoufer(ji,jj,jk) * rfact2 / rday 
     488              END DO 
     489            END DO  
     490         END DO 
     491         ! 
     492      ENDIF 
    378493 
    379494      IF( lk_iomput ) THEN 
    … …  
    388503               CALL iom_put( "INTNFIX" , zwork1 )  
    389504            ENDIF 
     505            IF( iom_use("SedCal" ) ) CALL iom_put( "SedCal", zsedcal(:,:) * 1.e+3 ) 
     506            IF( iom_use("SedSi" ) )  CALL iom_put( "SedSi",  zsedsi (:,:) * 1.e+3 ) 
     507            IF( iom_use("SedC" ) )   CALL iom_put( "SedC",   zsedc  (:,:) * 1.e+3 ) 
     508            IF( iom_use("Sdenit" ) ) CALL iom_put( "Sdenit", sdenit (:,:) * 1.e+3 * rno3 ) 
    390509         ENDIF 
    391       ELSE 
    392          IF( ln_diatrc )  & 
    393             &  trc2d(:,:,jp_pcs0_2d + 12) = nitrpot(:,:,1) * nitrfix * rno3 * 1.e+3 * rfact2r * e3t_n(:,:,1) * tmask(:,:,1) 
    394510      ENDIF 
    395511      ! 
    … …  
    400516      ENDIF 
    401517      ! 
    402       CALL wrk_dealloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zbureff ) 
    403       CALL wrk_dealloc( jpi, jpj, zwsbio3, zwsbio4, zwscal ) 
    404       CALL wrk_dealloc( jpi, jpj, jpk, zsoufer ) 
     518                      CALL wrk_dealloc( jpi, jpj, zdenit2d, zwork1, zwork2, zwork3, zbureff ) 
     519                      CALL wrk_dealloc( jpi, jpj, zwsbio3, zwsbio4, zwscal ) 
     520                      CALL wrk_dealloc( jpi, jpj, zsedcal,  zsedsi, zsedc ) 
     521                      CALL wrk_dealloc( jpi, jpj, jpk, zlight, zsoufer ) 
     522      IF( ln_p5z )    CALL wrk_dealloc( jpi, jpj, jpk, ztrpo4, ztrdop ) 
     523      IF( ln_ligand ) CALL wrk_dealloc( jpi, jpj, zwsfep ) 
    405524      ! 
    406525      IF( nn_timing == 1 )  CALL timing_stop('p4z_sed') 
    407       ! 
    408  9100  FORMAT(i8,3f10.5) 
    409526      ! 
    410527   END SUBROUTINE p4z_sed 
    … …  
    422539 
    423540 
    424 #else 
    425    !!====================================================================== 
    426    !!  Dummy module :                                   No PISCES bio-model 
    427    !!====================================================================== 
    428 CONTAINS 
    429    SUBROUTINE p4z_sed                         ! Empty routine 
    430    END SUBROUTINE p4z_sed 
    431 #endif  
    432  
    433541   !!====================================================================== 
    434542END MODULE p4zsed 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsink.F90

    r6140 r7646  
    99   !!             3.5  !  2012-07  (O. Aumont) Introduce potential time-splitting 
    1010   !!---------------------------------------------------------------------- 
    11 #if defined key_pisces 
    12    !!---------------------------------------------------------------------- 
    1311   !!   p4z_sink       :  Compute vertical flux of particulate matter due to gravitational sinking 
    1412   !!   p4z_sink_init  :  Unitialisation of sinking speed parameters 
    … …  
    2927   PUBLIC   p4z_sink_alloc 
    3028 
    31    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   wsbio3   !: POC sinking speed  
    32    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   wsbio4   !: GOC sinking speed 
    33    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   wscal    !: Calcite and BSi sinking speeds 
    34  
    3529   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sinking, sinking2  !: POC sinking fluxes  
    3630   !                                                          !  (different meanings depending on the parameterization) 
     31   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sinkingn, sinking2n  !: POC sinking fluxes  
     32   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sinkingp, sinking2p  !: POC sinking fluxes  
    3733   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sinkcal, sinksil   !: CaCO3 and BSi sinking fluxes 
    3834   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sinkfer            !: Small BFe sinking fluxes 
    39 #if ! defined key_kriest 
    4035   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sinkfer2           !: Big iron sinking fluxes 
    41 #endif 
     36   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sinkfep      !: Fep sinking fluxes 
    4237 
    4338   INTEGER  :: ik100 
    44  
    45 #if  defined key_kriest 
    46    REAL(wp) ::  xkr_sfact    !: Sinking factor 
    47    REAL(wp) ::  xkr_stick    !: Stickiness 
    48    REAL(wp) ::  xkr_nnano    !: Nbr of cell in nano size class 
    49    REAL(wp) ::  xkr_ndiat    !: Nbr of cell in diatoms size class 
    50    REAL(wp) ::  xkr_nmicro   !: Nbr of cell in microzoo size class 
    51    REAL(wp) ::  xkr_nmeso    !: Nbr of cell in mesozoo  size class 
    52    REAL(wp) ::  xkr_naggr    !: Nbr of cell in aggregates  size class 
    53  
    54    REAL(wp) ::  xkr_frac  
    55  
    56    REAL(wp), PUBLIC ::  xkr_dnano       !: Size of particles in nano pool 
    57    REAL(wp), PUBLIC ::  xkr_ddiat       !: Size of particles in diatoms pool 
    58    REAL(wp), PUBLIC ::  xkr_dmicro      !: Size of particles in microzoo pool 
    59    REAL(wp), PUBLIC ::  xkr_dmeso       !: Size of particles in mesozoo pool 
    60    REAL(wp), PUBLIC ::  xkr_daggr       !: Size of particles in aggregates pool 
    61    REAL(wp), PUBLIC ::  xkr_wsbio_min   !: min vertical particle speed 
    62    REAL(wp), PUBLIC ::  xkr_wsbio_max   !: max vertical particle speed 
    63  
    64    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   xnumm   !:  maximum number of particles in aggregates 
    65 #endif 
    6639 
    6740   !!---------------------------------------------------------------------- 
    … …  
    7245CONTAINS 
    7346 
    74 #if ! defined key_kriest 
    7547   !!---------------------------------------------------------------------- 
    7648   !!   'standard sinking parameterisation'                  ??? 
    … …  
    9163      REAL(wp) ::   zagg1, zagg2, zagg3, zagg4 
    9264      REAL(wp) ::   zagg , zaggfe, zaggdoc, zaggdoc2, zaggdoc3 
    93       REAL(wp) ::   zfact, zwsmax, zmax, zstep 
     65      REAL(wp) ::   zfact, zwsmax, zmax 
    9466      CHARACTER (len=25) :: charout 
    9567      REAL(wp), POINTER, DIMENSION(:,:,:) :: zw3d 
    … …  
    9870      ! 
    9971      IF( nn_timing == 1 )  CALL timing_start('p4z_sink') 
     72 
     73 
     74      ! Initialization of some global variables 
     75      ! --------------------------------------- 
     76      prodpoc(:,:,:) = 0. 
     77      conspoc(:,:,:) = 0. 
     78      prodgoc(:,:,:) = 0. 
     79      consgoc(:,:,:) = 0. 
     80 
    10081      ! 
    10182      !    Sinking speeds of detritus is increased with depth as shown 
    … …  
    10586         DO jj = 1, jpj 
    10687            DO ji = 1,jpi 
    107                zmax  = MAX( heup(ji,jj), hmld(ji,jj) ) 
    108                zfact = MAX( 0., gdepw_n(ji,jj,jk+1) - zmax ) / 5000._wp 
    109                wsbio4(ji,jj,jk) = wsbio2 + ( 200.- wsbio2 ) * zfact 
     88               zmax  = MAX( heup_01(ji,jj), hmld(ji,jj) ) 
     89               zfact = MAX( 0., gdepw_n(ji,jj,jk+1) - zmax ) / wsbio2scale 
     90               wsbio4(ji,jj,jk) = wsbio2 + MAX(0., ( wsbio2max - wsbio2 )) * zfact 
    11091            END DO 
    11192         END DO 
    … …  
    11495      ! limit the values of the sinking speeds to avoid numerical instabilities   
    11596      wsbio3(:,:,:) = wsbio 
    116       wscal (:,:,:) = wsbio4(:,:,:) 
     97 
    11798      ! 
    11899      ! OA This is (I hope) a temporary solution for the problem that may  
    … …  
    155136               IF( tmask(ji,jj,jk) == 1 ) THEN 
    156137                 zwsmax = 0.5 * e3t_n(ji,jj,jk) / xstep 
    157                  wsbio3(ji,jj,jk) = MIN( wsbio3(ji,jj,jk), zwsmax * FLOAT( iiter1 ) ) 
    158                  wsbio4(ji,jj,jk) = MIN( wsbio4(ji,jj,jk), zwsmax * FLOAT( iiter2 ) ) 
     138                 wsbio3(ji,jj,jk) = MIN( wsbio3(ji,jj,jk), zwsmax * REAL( iiter1, wp ) ) 
     139                 wsbio4(ji,jj,jk) = MIN( wsbio4(ji,jj,jk), zwsmax * REAL( iiter2, wp ) ) 
    159140               ENDIF 
    160141            END DO 
    161142         END DO 
    162143      END DO 
     144 
     145      wscal (:,:,:) = wsbio4(:,:,:) 
    163146 
    164147      !  Initializa to zero all the sinking arrays  
    … …  
    185168      END DO 
    186169 
    187       !  Exchange between organic matter compartments due to coagulation/disaggregation 
    188       !  --------------------------------------------------- 
    189       DO jk = 1, jpkm1 
    190          DO jj = 1, jpj 
    191             DO ji = 1, jpi 
    192                ! 
    193                zstep = xstep  
    194 # if defined key_degrad 
    195                zstep = zstep * facvol(ji,jj,jk) 
    196 # endif 
    197                zfact = zstep * xdiss(ji,jj,jk) 
    198                !  Part I : Coagulation dependent on turbulence 
    199                zagg1 = 25.9  * zfact * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jppoc) 
    200                zagg2 = 4452. * zfact * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpgoc) 
    201  
    202                ! Part II : Differential settling 
    203  
    204                !  Aggregation of small into large particles 
    205                zagg3 =  47.1 * zstep * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jpgoc) 
    206                zagg4 =  3.3  * zstep * trb(ji,jj,jk,jppoc) * trb(ji,jj,jk,jppoc) 
    207  
    208                zagg   = zagg1 + zagg2 + zagg3 + zagg4 
    209                zaggfe = zagg * trb(ji,jj,jk,jpsfe) / ( trb(ji,jj,jk,jppoc) + rtrn ) 
    210  
    211                ! Aggregation of DOC to POC :  
    212                ! 1st term is shear aggregation of DOC-DOC 
    213                ! 2nd term is shear aggregation of DOC-POC 
    214                ! 3rd term is differential settling of DOC-POC 
    215                zaggdoc  = ( ( 0.369 * 0.3 * trb(ji,jj,jk,jpdoc) + 102.4 * trb(ji,jj,jk,jppoc) ) * zfact       & 
    216                &            + 2.4 * zstep * trb(ji,jj,jk,jppoc) ) * 0.3 * trb(ji,jj,jk,jpdoc) 
    217                ! transfer of DOC to GOC :  
    218                ! 1st term is shear aggregation 
    219                ! 2nd term is differential settling  
    220                zaggdoc2 = ( 3.53E3 * zfact + 0.1 * zstep ) * trb(ji,jj,jk,jpgoc) * 0.3 * trb(ji,jj,jk,jpdoc) 
    221                ! tranfer of DOC to POC due to brownian motion 
    222                zaggdoc3 =  ( 5095. * trb(ji,jj,jk,jppoc) + 114. * 0.3 * trb(ji,jj,jk,jpdoc) ) *zstep * 0.3 * trb(ji,jj,jk,jpdoc) 
    223  
    224                !  Update the trends 
    225                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zagg + zaggdoc + zaggdoc3 
    226                tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zagg + zaggdoc2 
    227                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zaggfe 
    228                tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zaggfe 
    229                tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zaggdoc - zaggdoc2 - zaggdoc3 
    230                ! 
    231             END DO 
    232          END DO 
    233       END DO 
    234  
     170      IF( ln_p5z ) THEN 
     171         sinkingn (:,:,:) = 0.e0 
     172         sinking2n(:,:,:) = 0.e0 
     173         sinkingp (:,:,:) = 0.e0 
     174         sinking2p(:,:,:) = 0.e0 
     175 
     176         !   Compute the sedimentation term using p4zsink2 for all the sinking particles 
     177         !   ----------------------------------------------------- 
     178         DO jit = 1, iiter1 
     179           CALL p4z_sink2( wsbio3, sinkingn , jppon, iiter1 ) 
     180           CALL p4z_sink2( wsbio3, sinkingp , jppop, iiter1 ) 
     181         END DO 
     182 
     183         DO jit = 1, iiter2 
     184           CALL p4z_sink2( wsbio4, sinking2n, jpgon, iiter2 ) 
     185           CALL p4z_sink2( wsbio4, sinking2p, jpgop, iiter2 ) 
     186         END DO 
     187      ENDIF 
     188 
     189      IF( ln_ligand ) THEN 
     190         wsfep (:,:,:) = wfep 
     191         DO jk = 1,jpkm1 
     192            DO jj = 1, jpj 
     193               DO ji = 1, jpi 
     194                  IF( tmask(ji,jj,jk) == 1 ) THEN 
     195                    zwsmax = 0.5 * e3t_n(ji,jj,jk) / xstep 
     196                    wsfep(ji,jj,jk) = MIN( wsfep(ji,jj,jk), zwsmax * REAL( iiter1, wp ) ) 
     197                  ENDIF 
     198               END DO 
     199            END DO 
     200         END DO 
     201         ! 
     202         sinkfep(:,:,:) = 0.e0 
     203         DO jit = 1, iiter1 
     204           CALL p4z_sink2( wsfep, sinkfep , jpfep, iiter1 ) 
     205         END DO 
     206      ENDIF 
    235207 
    236208     ! Total carbon export per year 
    … …  
    281253          CALL wrk_dealloc( jpi, jpj, jpk, zw3d ) 
    282254        ENDIF 
    283       ELSE 
    284          IF( ln_diatrc ) THEN 
    285             zfact = 1.e3 * rfact2r 
    286             trc2d(:,:,jp_pcs0_2d + 4) = sinking (:,:,ik100) * zfact * tmask(:,:,1) 
    287             trc2d(:,:,jp_pcs0_2d + 5) = sinking2(:,:,ik100) * zfact * tmask(:,:,1) 
    288             trc2d(:,:,jp_pcs0_2d + 6) = sinkfer (:,:,ik100) * zfact * tmask(:,:,1) 
    289             trc2d(:,:,jp_pcs0_2d + 7) = sinkfer2(:,:,ik100) * zfact * tmask(:,:,1) 
    290             trc2d(:,:,jp_pcs0_2d + 8) = sinksil (:,:,ik100) * zfact * tmask(:,:,1) 
    291             trc2d(:,:,jp_pcs0_2d + 9) = sinkcal (:,:,ik100) * zfact * tmask(:,:,1) 
    292          ENDIF 
    293255      ENDIF 
    294256      ! 
    … …  
    320282      ! 
    321283   END SUBROUTINE p4z_sink_init 
    322  
    323 #else 
    324    !!---------------------------------------------------------------------- 
    325    !!   'Kriest sinking parameterisation'        key_kriest          ??? 
    326    !!---------------------------------------------------------------------- 
    327  
    328    SUBROUTINE p4z_sink ( kt, knt ) 
    329       !!--------------------------------------------------------------------- 
    330       !!                ***  ROUTINE p4z_sink  *** 
    331       !! 
    332       !! ** Purpose :   Compute vertical flux of particulate matter due to 
    333       !!              gravitational sinking - Kriest parameterization 
    334       !! 
    335       !! ** Method  : - ??? 
    336       !!--------------------------------------------------------------------- 
    337       ! 
    338       INTEGER, INTENT(in) :: kt, knt 
    339       ! 
    340       INTEGER  :: ji, jj, jk, jit, niter1, niter2 
    341       REAL(wp) :: zagg1, zagg2, zagg3, zagg4, zagg5, zfract, zaggsi, zaggsh 
    342       REAL(wp) :: zagg , zaggdoc, zaggdoc1, znumdoc 
    343       REAL(wp) :: znum , zeps, zfm, zgm, zsm 
    344       REAL(wp) :: zdiv , zdiv1, zdiv2, zdiv3, zdiv4, zdiv5 
    345       REAL(wp) :: zval1, zval2, zval3, zval4 
    346       REAL(wp) :: zfact 
    347       INTEGER  :: ik1 
    348       CHARACTER (len=25) :: charout 
    349       REAL(wp), POINTER, DIMENSION(:,:,:) :: znum3d  
    350       REAL(wp), POINTER, DIMENSION(:,:,:) :: zw3d 
    351       REAL(wp), POINTER, DIMENSION(:,:  ) :: zw2d 
    352       !!--------------------------------------------------------------------- 
    353       ! 
    354       IF( nn_timing == 1 )  CALL timing_start('p4z_sink') 
    355       ! 
    356       CALL wrk_alloc( jpi, jpj, jpk, znum3d ) 
    357       ! 
    358       !     Initialisation of variables used to compute Sinking Speed 
    359       !     --------------------------------------------------------- 
    360  
    361       znum3d(:,:,:) = 0.e0 
    362       zval1 = 1. + xkr_zeta 
    363       zval2 = 1. + xkr_zeta + xkr_eta 
    364       zval3 = 1. + xkr_eta 
    365  
    366       !     Computation of the vertical sinking speed : Kriest et Evans, 2000 
    367       !     ----------------------------------------------------------------- 
    368  
    369       DO jk = 1, jpkm1 
    370          DO jj = 1, jpj 
    371             DO ji = 1, jpi 
    372                IF( tmask(ji,jj,jk) /= 0.e0 ) THEN 
    373                   znum = trb(ji,jj,jk,jppoc) / ( trb(ji,jj,jk,jpnum) + rtrn ) / xkr_massp 
    374                   ! -------------- To avoid sinking speed over 50 m/day ------- 
    375                   znum  = MIN( xnumm(jk), znum ) 
    376                   znum  = MAX( 1.1      , znum ) 
    377                   znum3d(ji,jj,jk) = znum 
    378                   !------------------------------------------------------------ 
    379                   zeps  = ( zval1 * znum - 1. )/ ( znum - 1. ) 
    380                   zfm   = xkr_frac**( 1. - zeps ) 
    381                   zgm   = xkr_frac**( zval1 - zeps ) 
    382                   zdiv  = MAX( 1.e-4, ABS( zeps - zval2 ) ) * SIGN( 1., ( zeps - zval2 ) ) 
    383                   zdiv1 = zeps - zval3 
    384                   wsbio3(ji,jj,jk) = xkr_wsbio_min * ( zeps - zval1 ) / zdiv    & 
    385                      &             - xkr_wsbio_max *   zgm * xkr_eta  / zdiv 
    386                   wsbio4(ji,jj,jk) = xkr_wsbio_min *   ( zeps-1. )    / zdiv1   & 
    387                      &             - xkr_wsbio_max *   zfm * xkr_eta  / zdiv1 
    388                   IF( znum == 1.1)   wsbio3(ji,jj,jk) = wsbio4(ji,jj,jk) 
    389                ENDIF 
    390             END DO 
    391          END DO 
    392       END DO 
    393  
    394       wscal(:,:,:) = MAX( wsbio3(:,:,:), 30._wp ) 
    395  
    396       !   INITIALIZE TO ZERO ALL THE SINKING ARRAYS 
    397       !   ----------------------------------------- 
    398  
    399       sinking (:,:,:) = 0.e0 
    400       sinking2(:,:,:) = 0.e0 
    401       sinkcal (:,:,:) = 0.e0 
    402       sinkfer (:,:,:) = 0.e0 
    403       sinksil (:,:,:) = 0.e0 
    404  
    405      !   Compute the sedimentation term using p4zsink2 for all the sinking particles 
    406      !   ----------------------------------------------------- 
    407  
    408       niter1 = niter1max 
    409       niter2 = niter2max 
    410  
    411       DO jit = 1, niter1 
    412         CALL p4z_sink2( wsbio3, sinking , jppoc, niter1 ) 
    413         CALL p4z_sink2( wsbio3, sinkfer , jpsfe, niter1 ) 
    414         CALL p4z_sink2( wscal , sinksil , jpgsi, niter1 ) 
    415         CALL p4z_sink2( wscal , sinkcal , jpcal, niter1 ) 
    416       END DO 
    417  
    418       DO jit = 1, niter2 
    419         CALL p4z_sink2( wsbio4, sinking2, jpnum, niter2 ) 
    420       END DO 
    421  
    422      !  Exchange between organic matter compartments due to coagulation/disaggregation 
    423      !  --------------------------------------------------- 
    424  
    425       zval1 = 1. + xkr_zeta 
    426       zval2 = 1. + xkr_eta 
    427       zval3 = 3. + xkr_eta 
    428       zval4 = 4. + xkr_eta 
    429  
    430       DO jk = 1,jpkm1 
    431          DO jj = 1,jpj 
    432             DO ji = 1,jpi 
    433                IF( tmask(ji,jj,jk) /= 0.e0 ) THEN 
    434  
    435                   znum = trb(ji,jj,jk,jppoc)/(trb(ji,jj,jk,jpnum)+rtrn) / xkr_massp 
    436                   !-------------- To avoid sinking speed over 50 m/day ------- 
    437                   znum  = min(xnumm(jk),znum) 
    438                   znum  = MAX( 1.1,znum) 
    439                   !------------------------------------------------------------ 
    440                   zeps  = ( zval1 * znum - 1.) / ( znum - 1.) 
    441                   zdiv  = MAX( 1.e-4, ABS( zeps - zval3) ) * SIGN( 1., zeps - zval3 ) 
    442                   zdiv1 = MAX( 1.e-4, ABS( zeps - 4.   ) ) * SIGN( 1., zeps - 4.    ) 
    443                   zdiv2 = zeps - 2. 
    444                   zdiv3 = zeps - 3. 
    445                   zdiv4 = zeps - zval2 
    446                   zdiv5 = 2.* zeps - zval4 
    447                   zfm   = xkr_frac**( 1.- zeps ) 
    448                   zsm   = xkr_frac**xkr_eta 
    449  
    450                   !    Part I : Coagulation dependant on turbulence 
    451                   !    ---------------------------------------------- 
    452  
    453                   zagg1 =  0.163 * trb(ji,jj,jk,jpnum)**2               & 
    454                      &            * 2.*( (zfm-1.)*(zfm*xkr_mass_max**3-xkr_mass_min**3)    & 
    455                      &            * (zeps-1)/zdiv1 + 3.*(zfm*xkr_mass_max-xkr_mass_min)    & 
    456                      &            * (zfm*xkr_mass_max**2-xkr_mass_min**2)                  & 
    457                      &            * (zeps-1.)**2/(zdiv2*zdiv3))  
    458                   zagg2 =  2*0.163*trb(ji,jj,jk,jpnum)**2*zfm*                       & 
    459                      &                   ((xkr_mass_max**3+3.*(xkr_mass_max**2          & 
    460                      &                    *xkr_mass_min*(zeps-1.)/zdiv2                 & 
    461                      &                    +xkr_mass_max*xkr_mass_min**2*(zeps-1.)/zdiv3)    & 
    462                      &                    +xkr_mass_min**3*(zeps-1)/zdiv1)                  & 
    463                      &                    -zfm*xkr_mass_max**3*(1.+3.*((zeps-1.)/           & 
    464                      &                    (zeps-2.)+(zeps-1.)/zdiv3)+(zeps-1.)/zdiv1))     
    465  
    466                   zagg3 =  0.163*trb(ji,jj,jk,jpnum)**2*zfm**2*8. * xkr_mass_max**3   
    467                    
    468                  !    Aggregation of small into large particles 
    469                  !    Part II : Differential settling 
    470                  !    ---------------------------------------------- 
    471  
    472                   zagg4 =  2.*3.141*0.125*trb(ji,jj,jk,jpnum)**2*                       & 
    473                      &                 xkr_wsbio_min*(zeps-1.)**2                         & 
    474                      &                 *(xkr_mass_min**2*((1.-zsm*zfm)/(zdiv3*zdiv4)      & 
    475                      &                 -(1.-zfm)/(zdiv*(zeps-1.)))-                       & 
    476                      &                 ((zfm*zfm*xkr_mass_max**2*zsm-xkr_mass_min**2)     & 
    477                      &                 *xkr_eta)/(zdiv*zdiv3*zdiv5) )    
    478  
    479                   zagg5 =   2.*3.141*0.125*trb(ji,jj,jk,jpnum)**2                         & 
    480                      &                 *(zeps-1.)*zfm*xkr_wsbio_min                        & 
    481                      &                 *(zsm*(xkr_mass_min**2-zfm*xkr_mass_max**2)         & 
    482                      &                 /zdiv3-(xkr_mass_min**2-zfm*zsm*xkr_mass_max**2)    & 
    483                      &                 /zdiv)   
    484  
    485                   ! 
    486                   !     Fractionnation by swimming organisms 
    487                   !     ------------------------------------ 
    488  
    489                   zfract = 2.*3.141*0.125*trb(ji,jj,jk,jpmes)*12./0.12/0.06**3*trb(ji,jj,jk,jpnum)  & 
    490                     &      * (0.01/xkr_mass_min)**(1.-zeps)*0.1**2  & 
    491                     &      * 10000.*xstep 
    492  
    493                   !     Aggregation of DOC to small particles 
    494                   !     -------------------------------------- 
    495  
    496                   zaggdoc = 0.83 * trb(ji,jj,jk,jpdoc) * xstep * xdiss(ji,jj,jk) * trb(ji,jj,jk,jpdoc)   & 
    497                      &        + 0.005 * 231. * trb(ji,jj,jk,jpdoc) * xstep * trb(ji,jj,jk,jpdoc) 
    498                   zaggdoc1 = 271. * trb(ji,jj,jk,jppoc) * xstep * xdiss(ji,jj,jk) * trb(ji,jj,jk,jpdoc)  & 
    499                      &  + 0.02 * 16706. * trb(ji,jj,jk,jppoc) * xstep * trb(ji,jj,jk,jpdoc) 
    500  
    501 # if defined key_degrad 
    502                    zagg1   = zagg1   * facvol(ji,jj,jk)                  
    503                    zagg2   = zagg2   * facvol(ji,jj,jk)                  
    504                    zagg3   = zagg3   * facvol(ji,jj,jk)                  
    505                    zagg4   = zagg4   * facvol(ji,jj,jk)                  
    506                    zagg5   = zagg5   * facvol(ji,jj,jk)                  
    507                    zaggdoc = zaggdoc * facvol(ji,jj,jk)                  
    508                    zaggdoc1 = zaggdoc1 * facvol(ji,jj,jk) 
    509 # endif 
    510                   zaggsh = ( zagg1 + zagg2 + zagg3 ) * rfact2 * xdiss(ji,jj,jk) / 1000. 
    511                   zaggsi = ( zagg4 + zagg5 ) * xstep / 10. 
    512                   zagg = 0.5 * xkr_stick * ( zaggsh + zaggsi ) 
    513                   ! 
    514                   znumdoc = trb(ji,jj,jk,jpnum) / ( trb(ji,jj,jk,jppoc) + rtrn ) 
    515                   tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zaggdoc + zaggdoc1 
    516                   tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zfract + zaggdoc / xkr_massp - zagg 
    517                   tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zaggdoc - zaggdoc1 
    518  
    519                ENDIF 
    520             END DO 
    521          END DO 
    522       END DO 
    523  
    524      ! Total primary production per year 
    525      t_oce_co2_exp = t_oce_co2_exp + glob_sum( ( sinking(:,:,ik100) * e1e2t(:,:) * tmask(:,:,1) ) 
    526      ! 
    527      IF( lk_iomput ) THEN 
    528         IF( knt == nrdttrc ) THEN 
    529           CALL wrk_alloc( jpi, jpj,      zw2d ) 
    530           CALL wrk_alloc( jpi, jpj, jpk, zw3d ) 
    531           zfact = 1.e+3 * rfact2r  !  conversion from mol/l/kt to  mol/m3/s 
    532           ! 
    533           IF( iom_use( "EPC100" ) )  THEN 
    534               zw2d(:,:) = sinking(:,:,ik100) * zfact * tmask(:,:,1) ! Export of carbon at 100m 
    535               CALL iom_put( "EPC100"  , zw2d ) 
    536           ENDIF 
    537           IF( iom_use( "EPN100" ) )  THEN 
    538               zw2d(:,:) = sinking2(:,:,ik100) * zfact * tmask(:,:,1) ! Export of number of aggregates ? 
    539               CALL iom_put( "EPN100"  , zw2d ) 
    540           ENDIF 
    541           IF( iom_use( "EPCAL100" ) )  THEN 
    542               zw2d(:,:) = sinkcal(:,:,ik100) * zfact * tmask(:,:,1) ! Export of calcite at 100m 
    543               CALL iom_put( "EPCAL100"  , zw2d ) 
    544           ENDIF 
    545           IF( iom_use( "EPSI100" ) )  THEN 
    546               zw2d(:,:) = sinksil(:,:,ik100) * zfact * tmask(:,:,1) ! Export of bigenic silica at 100m 
    547               CALL iom_put( "EPSI100"  , zw2d ) 
    548           ENDIF 
    549           IF( iom_use( "EXPC" ) )  THEN 
    550               zw3d(:,:,:) = sinking(:,:,:) * zfact * tmask(:,:,:) ! Export of carbon in the water column 
    551               CALL iom_put( "EXPC"  , zw3d ) 
    552           ENDIF 
    553           IF( iom_use( "EXPN" ) )  THEN 
    554               zw3d(:,:,:) = sinking(:,:,:) * zfact * tmask(:,:,:) ! Export of carbon in the water column 
    555               CALL iom_put( "EXPN"  , zw3d ) 
    556           ENDIF 
    557           IF( iom_use( "EXPCAL" ) )  THEN 
    558               zw3d(:,:,:) = sinkcal(:,:,:) * zfact * tmask(:,:,:) ! Export of calcite  
    559               CALL iom_put( "EXPCAL"  , zw3d ) 
    560           ENDIF 
    561           IF( iom_use( "EXPSI" ) )  THEN 
    562               zw3d(:,:,:) = sinksil(:,:,:) * zfact * tmask(:,:,:) ! Export of bigenic silica 
    563               CALL iom_put( "EXPSI"  , zw3d ) 
    564           ENDIF 
    565           IF( iom_use( "XNUM" ) )  THEN 
    566               zw3d(:,:,:) =  znum3d(:,:,:) * tmask(:,:,:) !  Number of particles on aggregats 
    567               CALL iom_put( "XNUM"  , zw3d ) 
    568           ENDIF 
    569           IF( iom_use( "WSC" ) )  THEN 
    570               zw3d(:,:,:) = wsbio3(:,:,:) * tmask(:,:,:) ! Sinking speed of carbon particles 
    571               CALL iom_put( "WSC"  , zw3d ) 
    572           ENDIF 
    573           IF( iom_use( "WSN" ) )  THEN 
    574               zw3d(:,:,:) = wsbio4(:,:,:) * tmask(:,:,:) ! Sinking speed of particles number 
    575               CALL iom_put( "WSN"  , zw3d ) 
    576           ENDIF 
    577           ! 
    578           CALL wrk_dealloc( jpi, jpj,      zw2d ) 
    579           CALL wrk_dealloc( jpi, jpj, jpk, zw3d ) 
    580       ELSE 
    581          IF( ln_diatrc ) THEN 
    582             zfact = 1.e3 * rfact2r 
    583             trc2d(:,:  ,jp_pcs0_2d + 4)  = sinking (:,:,ik100)  * zfact * tmask(:,:,1) 
    584             trc2d(:,:  ,jp_pcs0_2d + 5)  = sinking2(:,:,ik100)  * zfact * tmask(:,:,1) 
    585             trc2d(:,:  ,jp_pcs0_2d + 6)  = sinkfer (:,:,ik100)  * zfact * tmask(:,:,1) 
    586             trc2d(:,:  ,jp_pcs0_2d + 7)  = sinksil (:,:,ik100)  * zfact * tmask(:,:,1) 
    587             trc2d(:,:  ,jp_pcs0_2d + 8)  = sinkcal (:,:,ik100)  * zfact * tmask(:,:,1) 
    588             trc3d(:,:,:,jp_pcs0_3d + 11) = sinking (:,:,:)      * zfact * tmask(:,:,:) 
    589             trc3d(:,:,:,jp_pcs0_3d + 12) = sinking2(:,:,:)      * zfact * tmask(:,:,:) 
    590             trc3d(:,:,:,jp_pcs0_3d + 13) = sinksil (:,:,:)      * zfact * tmask(:,:,:) 
    591             trc3d(:,:,:,jp_pcs0_3d + 14) = sinkcal (:,:,:)      * zfact * tmask(:,:,:) 
    592             trc3d(:,:,:,jp_pcs0_3d + 15) = znum3d  (:,:,:)              * tmask(:,:,:) 
    593             trc3d(:,:,:,jp_pcs0_3d + 16) = wsbio3  (:,:,:)              * tmask(:,:,:) 
    594             trc3d(:,:,:,jp_pcs0_3d + 17) = wsbio4  (:,:,:)              * tmask(:,:,:) 
    595          ENDIF 
    596       ENDIF 
    597  
    598       ! 
    599       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    600          WRITE(charout, FMT="('sink')") 
    601          CALL prt_ctl_trc_info(charout) 
    602          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
    603       ENDIF 
    604       ! 
    605       CALL wrk_dealloc( jpi, jpj, jpk, znum3d ) 
    606       ! 
    607       IF( nn_timing == 1 )  CALL timing_stop('p4z_sink') 
    608       ! 
    609    END SUBROUTINE p4z_sink 
    610  
    611  
    612    SUBROUTINE p4z_sink_init 
    613       !!---------------------------------------------------------------------- 
    614       !!                  ***  ROUTINE p4z_sink_init  *** 
    615       !! 
    616       !! ** Purpose :   Initialization of sinking parameters 
    617       !!                Kriest parameterization only 
    618       !! 
    619       !! ** Method  :   Read the nampiskrs namelist and check the parameters 
    620       !!      called at the first timestep  
    621       !! 
    622       !! ** input   :   Namelist nampiskrs 
    623       !!---------------------------------------------------------------------- 
    624       INTEGER  ::   jk, jn, kiter 
    625       INTEGER  ::   ios                 ! Local integer output status for namelist read 
    626       REAL(wp) ::   znum, zdiv 
    627       REAL(wp) ::   zws, zwr, zwl,wmax, znummax 
    628       REAL(wp) ::   zmin, zmax, zl, zr, xacc 
    629       ! 
    630       NAMELIST/nampiskrs/ xkr_sfact, xkr_stick ,  & 
    631          &                xkr_nnano, xkr_ndiat, xkr_nmicro, xkr_nmeso, xkr_naggr 
    632       !!---------------------------------------------------------------------- 
    633       ! 
    634       IF( nn_timing == 1 )  CALL timing_start('p4z_sink_init') 
    635       ! 
    636  
    637       REWIND( numnatp_ref )              ! Namelist nampiskrs in reference namelist : Pisces sinking Kriest 
    638       READ  ( numnatp_ref, nampiskrs, IOSTAT = ios, ERR = 901) 
    639 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampiskrs in reference namelist', lwp ) 
    640  
    641       REWIND( numnatp_cfg )              ! Namelist nampiskrs in configuration namelist : Pisces sinking Kriest 
    642       READ  ( numnatp_cfg, nampiskrs, IOSTAT = ios, ERR = 902 ) 
    643 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampiskrs in configuration namelist', lwp ) 
    644       IF(lwm) WRITE ( numonp, nampiskrs ) 
    645  
    646       IF(lwp) THEN 
    647          WRITE(numout,*) 
    648          WRITE(numout,*) ' Namelist : nampiskrs' 
    649          WRITE(numout,*) '    Sinking factor                           xkr_sfact    = ', xkr_sfact 
    650          WRITE(numout,*) '    Stickiness                               xkr_stick    = ', xkr_stick 
    651          WRITE(numout,*) '    Nbr of cell in nano size class           xkr_nnano    = ', xkr_nnano 
    652          WRITE(numout,*) '    Nbr of cell in diatoms size class        xkr_ndiat    = ', xkr_ndiat 
    653          WRITE(numout,*) '    Nbr of cell in microzoo size class       xkr_nmicro   = ', xkr_nmicro 
    654          WRITE(numout,*) '    Nbr of cell in mesozoo size class        xkr_nmeso    = ', xkr_nmeso 
    655          WRITE(numout,*) '    Nbr of cell in aggregates size class     xkr_naggr    = ', xkr_naggr 
    656       ENDIF 
    657  
    658  
    659       ! max and min vertical particle speed 
    660       xkr_wsbio_min = xkr_sfact * xkr_mass_min**xkr_eta 
    661       xkr_wsbio_max = xkr_sfact * xkr_mass_max**xkr_eta 
    662       IF (lwp) WRITE(numout,*) ' max and min vertical particle speed ', xkr_wsbio_min, xkr_wsbio_max 
    663  
    664       ! 
    665       !    effect of the sizes of the different living pools on particle numbers 
    666       !    nano = 2um-20um -> mean size=6.32 um -> ws=2.596 -> xnum=xnnano=2.337 
    667       !    diat and microzoo = 10um-200um -> 44.7 -> 8.732 -> xnum=xndiat=3.718 
    668       !    mesozoo = 200um-2mm -> 632.45 -> 45.14 -> xnum=xnmeso=7.147 
    669       !    aggregates = 200um-10mm -> 1414 -> 74.34 -> xnum=xnaggr=9.877 
    670       !    doc aggregates = 1um 
    671       ! ---------------------------------------------------------- 
    672  
    673       xkr_dnano = 1. / ( xkr_massp * xkr_nnano ) 
    674       xkr_ddiat = 1. / ( xkr_massp * xkr_ndiat ) 
    675       xkr_dmicro = 1. / ( xkr_massp * xkr_nmicro ) 
    676       xkr_dmeso = 1. / ( xkr_massp * xkr_nmeso ) 
    677       xkr_daggr = 1. / ( xkr_massp * xkr_naggr ) 
    678  
    679       !!--------------------------------------------------------------------- 
    680       !!    'key_kriest'                                                  ??? 
    681       !!--------------------------------------------------------------------- 
    682       !  COMPUTATION OF THE VERTICAL PROFILE OF MAXIMUM SINKING SPEED 
    683       !  Search of the maximum number of particles in aggregates for each k-level. 
    684       !  Bissection Method 
    685       !-------------------------------------------------------------------- 
    686       IF (lwp) THEN 
    687         WRITE(numout,*) 
    688         WRITE(numout,*)'    kriest : Compute maximum number of particles in aggregates' 
    689       ENDIF 
    690  
    691       xacc     =  0.001_wp 
    692       kiter    = 50 
    693       zmin     =  1.10_wp 
    694       zmax     = xkr_mass_max / xkr_mass_min 
    695       xkr_frac = zmax 
    696  
    697       DO jk = 1,jpk 
    698          zl = zmin 
    699          zr = zmax 
    700          wmax = 0.5 * e3t_n(1,1,jk) * rday * float(niter1max) / rfact2 
    701          zdiv = xkr_zeta + xkr_eta - xkr_eta * zl 
    702          znum = zl - 1. 
    703          zwl =  xkr_wsbio_min * xkr_zeta / zdiv & 
    704             & - ( xkr_wsbio_max * xkr_eta * znum * & 
    705             &     xkr_frac**( -xkr_zeta / znum ) / zdiv ) & 
    706             & - wmax 
    707  
    708          zdiv = xkr_zeta + xkr_eta - xkr_eta * zr 
    709          znum = zr - 1. 
    710          zwr =  xkr_wsbio_min * xkr_zeta / zdiv & 
    711             & - ( xkr_wsbio_max * xkr_eta * znum * & 
    712             &     xkr_frac**( -xkr_zeta / znum ) / zdiv ) & 
    713             & - wmax 
    714 iflag:   DO jn = 1, kiter 
    715             IF    ( zwl == 0._wp ) THEN   ;   znummax = zl 
    716             ELSEIF( zwr == 0._wp ) THEN   ;   znummax = zr 
    717             ELSE 
    718                znummax = ( zr + zl ) / 2. 
    719                zdiv = xkr_zeta + xkr_eta - xkr_eta * znummax 
    720                znum = znummax - 1. 
    721                zws =  xkr_wsbio_min * xkr_zeta / zdiv & 
    722                   & - ( xkr_wsbio_max * xkr_eta * znum * & 
    723                   &     xkr_frac**( -xkr_zeta / znum ) / zdiv ) & 
    724                   & - wmax 
    725                IF( zws * zwl < 0. ) THEN   ;   zr = znummax 
    726                ELSE                        ;   zl = znummax 
    727                ENDIF 
    728                zdiv = xkr_zeta + xkr_eta - xkr_eta * zl 
    729                znum = zl - 1. 
    730                zwl =  xkr_wsbio_min * xkr_zeta / zdiv & 
    731                   & - ( xkr_wsbio_max * xkr_eta * znum * & 
    732                   &     xkr_frac**( -xkr_zeta / znum ) / zdiv ) & 
    733                   & - wmax 
    734  
    735                zdiv = xkr_zeta + xkr_eta - xkr_eta * zr 
    736                znum = zr - 1. 
    737                zwr =  xkr_wsbio_min * xkr_zeta / zdiv & 
    738                   & - ( xkr_wsbio_max * xkr_eta * znum * & 
    739                   &     xkr_frac**( -xkr_zeta / znum ) / zdiv ) & 
    740                   & - wmax 
    741                ! 
    742                IF ( ABS ( zws )  <= xacc ) EXIT iflag 
    743                ! 
    744             ENDIF 
    745             ! 
    746          END DO iflag 
    747  
    748          xnumm(jk) = znummax 
    749          IF (lwp) WRITE(numout,*) '       jk = ', jk, ' wmax = ', wmax,' xnum max = ', xnumm(jk) 
    750          ! 
    751       END DO 
    752       ! 
    753       ik100 = 10        !  last level where depth less than 100 m 
    754       DO jk = jpkm1, 1, -1 
    755          IF( gdept_1d(jk) > 100. )  iksed = jk - 1 
    756       END DO 
    757       IF (lwp) WRITE(numout,*) 
    758       IF (lwp) WRITE(numout,*) ' Level corresponding to 100m depth ',  ik100 + 1 
    759       IF (lwp) WRITE(numout,*) 
    760       ! 
    761       t_oce_co2_exp = 0._wp 
    762       ! 
    763       IF( nn_timing == 1 )  CALL timing_stop('p4z_sink_init') 
    764       ! 
    765   END SUBROUTINE p4z_sink_init 
    766  
    767 #endif 
    768284 
    769285   SUBROUTINE p4z_sink2( pwsink, psinkflx, jp_tra, kiter ) 
    … …  
    794310      CALL wrk_alloc( jpi, jpj, jpk, ztraz, zakz, zwsink2, ztrb ) 
    795311 
    796       zstep = rfact2 / FLOAT( kiter ) / 2. 
     312      zstep = rfact2 / REAL( kiter, wp ) / 2. 
    797313 
    798314      ztraz(:,:,:) = 0.e0 
    … …  
    804320      END DO 
    805321      zwsink2(:,:,1) = 0.e0 
    806       IF( lk_degrad ) THEN 
    807          zwsink2(:,:,:) = zwsink2(:,:,:) * facvol(:,:,:) 
    808       ENDIF 
    809322 
    810323 
    … …  
    887400      !!                     ***  ROUTINE p4z_sink_alloc  *** 
    888401      !!---------------------------------------------------------------------- 
    889       ALLOCATE( wsbio3 (jpi,jpj,jpk) , wsbio4  (jpi,jpj,jpk) , wscal(jpi,jpj,jpk) ,     & 
    890          &      sinking(jpi,jpj,jpk) , sinking2(jpi,jpj,jpk)                      ,     &                 
    891          &      sinkcal(jpi,jpj,jpk) , sinksil (jpi,jpj,jpk)                      ,     &                 
    892 #if defined key_kriest 
    893          &      xnumm(jpk)                                                        ,     &                 
    894 #else 
    895          &      sinkfer2(jpi,jpj,jpk)                                             ,     &                 
    896 #endif 
    897          &      sinkfer(jpi,jpj,jpk)                                              , STAT=p4z_sink_alloc )                 
     402      INTEGER :: ierr(3) 
     403 
     404      ierr(:) = 0 
     405      ! 
     406      ALLOCATE( sinking(jpi,jpj,jpk) , sinking2(jpi,jpj,jpk)                    ,     &                 
     407         &      sinkcal(jpi,jpj,jpk) , sinksil (jpi,jpj,jpk)                    ,     &                 
     408         &      sinkfer2(jpi,jpj,jpk)                                           ,     &                 
     409         &      sinkfer(jpi,jpj,jpk)                                            , STAT=ierr(1) )                 
    898410         ! 
     411      IF( ln_ligand ) ALLOCATE( sinkfep(jpi,jpj,jpk)                            , STAT=ierr(2) )   
     412          
     413      IF( ln_p5z    ) ALLOCATE( sinkingn(jpi,jpj,jpk), sinking2n(jpi,jpj,jpk)   ,     & 
     414         &                      sinkingp(jpi,jpj,jpk), sinking2p(jpi,jpj,jpk)   , STAT=ierr(3) ) 
     415      ! 
     416      p4z_sink_alloc = MAXVAL( ierr ) 
    899417      IF( p4z_sink_alloc /= 0 ) CALL ctl_warn('p4z_sink_alloc : failed to allocate arrays.') 
    900418      ! 
    901419   END FUNCTION p4z_sink_alloc 
    902420    
    903 #else 
    904    !!====================================================================== 
    905    !!  Dummy module :                                   No PISCES bio-model 
    906    !!====================================================================== 
    907 CONTAINS 
    908    SUBROUTINE p4z_sink                    ! Empty routine 
    909    END SUBROUTINE p4z_sink 
    910 #endif  
    911  
    912421   !!====================================================================== 
    913422END MODULE p4zsink 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/P4Z/p4zsms.F90

    r6421 r7646  
    66   !! History :   1.0  !  2004-03 (O. Aumont) Original code 
    77   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
    8    !!---------------------------------------------------------------------- 
    9 #if defined key_pisces 
    10    !!---------------------------------------------------------------------- 
    11    !!   'key_pisces'                                       PISCES bio-model 
    128   !!---------------------------------------------------------------------- 
    139   !!   p4zsms         :  Time loop of passive tracers sms 
    … …  
    6965      INTEGER ::   ji, jj, jk, jnt, jn, jl 
    7066      REAL(wp) ::  ztra 
    71 #if defined key_kriest 
    72       REAL(wp) ::  zcoef1, zcoef2 
    73 #endif 
    7467      CHARACTER (len=25) :: charout 
    7568      !!--------------------------------------------------------------------- 
    … …  
    8376        CALL p4z_che                              ! initialize the chemical constants 
    8477        ! 
    85         IF( .NOT. ln_rsttr ) THEN  ;   CALL p4z_ph_ini   !  set PH at kt=nit000  
     78        IF( .NOT. ln_rsttr ) THEN  ;   CALL ahini_for_at(hi)   !  set PH at kt=nit000  
    8679        ELSE                       ;   CALL p4z_rst( nittrc000, 'READ' )  !* read or initialize all required fields  
    8780        ENDIF 
    … …  
    9184      IF( ln_pisdmp .AND. MOD( kt - nn_dttrc, nn_pisdmp ) == 0 )   CALL p4z_dmp( kt )      ! Relaxation of some tracers 
    9285      ! 
    93       !                                                                    !   set time step size (Euler/Leapfrog) 
    94       IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN   ;    rfact = rdttrc     !  at nittrc000 
    95       ELSEIF( kt <= nittrc000 + nn_dttrc )                          THEN   ;    rfact = 2. * rdttrc   ! at nittrc000 or nittrc000+nn_dttrc (Leapfrog) 
    96       ENDIF 
     86      rfact = r2dttrc 
    9787      ! 
    9888      IF( ( ln_top_euler .AND. kt == nittrc000 )  .OR. ( .NOT.ln_top_euler .AND. kt <= nittrc000 + nn_dttrc ) ) THEN 
    9989         rfactr  = 1. / rfact 
    100          rfact2  = rfact / FLOAT( nrdttrc ) 
     90         rfact2  = rfact / REAL( nrdttrc, wp ) 
    10191         rfact2r = 1. / rfact2 
    10292         xstep = rfact2 / rday         ! Time step duration for biology 
    … …  
    165155      END DO 
    166156 
    167 #if defined key_kriest 
    168       !  
    169       zcoef1 = 1.e0 / xkr_massp  
    170       zcoef2 = 1.e0 / xkr_massp / 1.1 
    171       DO jk = 1,jpkm1 
    172          trb(:,:,jk,jpnum) = MAX(  trb(:,:,jk,jpnum), trb(:,:,jk,jppoc) * zcoef1 / xnumm(jk)  ) 
    173          trb(:,:,jk,jpnum) = MIN(  trb(:,:,jk,jpnum), trb(:,:,jk,jppoc) * zcoef2              ) 
    174       END DO 
    175       ! 
    176 #endif 
    177       ! 
    178157      ! 
    179158      IF( l_trdtrc ) THEN 
    … …  
    212191      !! ** input   :   file 'namelist.trc.s' containing the following 
    213192      !!             namelist: natext, natbio, natsms 
    214       !!                       natkriest ("key_kriest") 
    215       !!---------------------------------------------------------------------- 
    216       NAMELIST/nampisbio/ nrdttrc, wsbio, xkmort, ferat3, wsbio2, niter1max, niter2max 
    217 #if defined key_kriest 
    218       NAMELIST/nampiskrp/ xkr_eta, xkr_zeta, xkr_ncontent, xkr_mass_min, xkr_mass_max 
    219 #endif 
     193      !!---------------------------------------------------------------------- 
     194      NAMELIST/nampisbio/ nrdttrc, wsbio, xkmort, ferat3, wsbio2, wsbio2max, wsbio2scale,    & 
     195         &                   niter1max, niter2max, wfep, ldocp, ldocz, lthet,  & 
     196         &                   no3rat3, po4rat3 
     197 
    220198      NAMELIST/nampisdmp/ ln_pisdmp, nn_pisdmp 
    221199      NAMELIST/nampismass/ ln_check_mass 
    … …  
    234212      IF(lwp) THEN                         ! control print 
    235213         WRITE(numout,*) ' Namelist : nampisbio' 
    236          WRITE(numout,*) '    frequence pour la biologie                nrdttrc   =', nrdttrc 
    237          WRITE(numout,*) '    POC sinking speed                         wsbio     =', wsbio 
    238          WRITE(numout,*) '    half saturation constant for mortality    xkmort    =', xkmort 
    239          WRITE(numout,*) '    Fe/C in zooplankton                       ferat3    =', ferat3 
    240          WRITE(numout,*) '    Big particles sinking speed               wsbio2    =', wsbio2 
     214         WRITE(numout,*) '    frequence pour la biologie                nrdttrc    =', nrdttrc 
     215         WRITE(numout,*) '    POC sinking speed                         wsbio      =', wsbio 
     216         WRITE(numout,*) '    half saturation constant for mortality    xkmort     =', xkmort  
     217         IF( ln_p5z ) THEN 
     218            WRITE(numout,*) '    N/C in zooplankton                        no3rat3    =', no3rat3 
     219            WRITE(numout,*) '    P/C in zooplankton                        po4rat3    =', po4rat3 
     220         ENDIF 
     221         WRITE(numout,*) '    Fe/C in zooplankton                       ferat3     =', ferat3 
     222         WRITE(numout,*) '    Big particles sinking speed               wsbio2     =', wsbio2 
     223         WRITE(numout,*) '    Big particles maximum sinking speed       wsbio2max  =', wsbio2max 
     224         WRITE(numout,*) '    Big particles sinking speed length scale  wsbio2scale =', wsbio2scale 
    241225         WRITE(numout,*) '    Maximum number of iterations for POC      niter1max =', niter1max 
    242226         WRITE(numout,*) '    Maximum number of iterations for GOC      niter2max =', niter2max 
    243       ENDIF 
    244  
    245 #if defined key_kriest 
    246  
    247       !                               ! nampiskrp : kriest parameters 
    248       !                               ! ----------------------------- 
    249       REWIND( numnatp_ref )              ! Namelist nampiskrp in reference namelist : Pisces Kriest 
    250       READ  ( numnatp_ref, nampiskrp, IOSTAT = ios, ERR = 903) 
    251 903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampiskrp in reference namelist', lwp ) 
    252  
    253       REWIND( numnatp_cfg )              ! Namelist nampiskrp in configuration namelist : Pisces Kriest 
    254       READ  ( numnatp_cfg, nampiskrp, IOSTAT = ios, ERR = 904 ) 
    255 904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampiskrp in configuration namelist', lwp ) 
    256       IF(lwm) WRITE ( numonp, nampiskrp ) 
    257  
    258       IF(lwp) THEN 
    259          WRITE(numout,*) 
    260          WRITE(numout,*) ' Namelist : nampiskrp' 
    261          WRITE(numout,*) '    Sinking  exponent                        xkr_eta      = ', xkr_eta 
    262          WRITE(numout,*) '    N content exponent                       xkr_zeta     = ', xkr_zeta 
    263          WRITE(numout,*) '    N content factor                         xkr_ncontent = ', xkr_ncontent 
    264          WRITE(numout,*) '    Minimum mass for Aggregates              xkr_mass_min = ', xkr_mass_min 
    265          WRITE(numout,*) '    Maximum mass for Aggregates              xkr_mass_max = ', xkr_mass_max 
    266          WRITE(numout,*) 
    267      ENDIF 
    268  
    269  
    270      ! Computation of some variables 
    271      xkr_massp = xkr_ncontent * 7.625 * xkr_mass_min**xkr_zeta 
    272  
    273 #endif 
     227         IF( ln_ligand ) THEN 
     228            WRITE(numout,*) '    FeP sinking speed                             wfep   =', wfep 
     229            IF( ln_p4z ) THEN 
     230              WRITE(numout,*) '    Phyto ligand production per unit doc          ldocp  =', ldocp 
     231              WRITE(numout,*) '    Zoo ligand production per unit doc            ldocz  =', ldocz 
     232              WRITE(numout,*) '    Proportional loss of ligands due to Fe uptake lthet  =', lthet 
     233            ENDIF 
     234         ENDIF 
     235      ENDIF 
     236 
    274237 
    275238      REWIND( numnatp_ref )              ! Namelist nampisdmp in reference namelist : Pisces damping 
    … …  
    308271   END SUBROUTINE p4z_sms_init 
    309272 
    310    SUBROUTINE p4z_ph_ini 
    311       !!--------------------------------------------------------------------- 
    312       !!                   ***  ROUTINE p4z_ini_ph  *** 
    313       !! 
    314       !!  ** Purpose : Initialization of chemical variables of the carbon cycle 
    315       !!--------------------------------------------------------------------- 
    316       INTEGER  ::  ji, jj, jk 
    317       REAL(wp) ::  zcaralk, zbicarb, zco3 
    318       REAL(wp) ::  ztmas, ztmas1 
    319       !!--------------------------------------------------------------------- 
    320  
    321       ! Set PH from  total alkalinity, borat (???), akb3 (???) and ak23 (???) 
    322       ! -------------------------------------------------------- 
    323       DO jk = 1, jpk 
    324          DO jj = 1, jpj 
    325             DO ji = 1, jpi 
    326                ztmas   = tmask(ji,jj,jk) 
    327                ztmas1  = 1. - tmask(ji,jj,jk) 
    328                zcaralk = trb(ji,jj,jk,jptal) - borat(ji,jj,jk) / (  1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) )  ) 
    329                zco3    = ( zcaralk - trb(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1 
    330                zbicarb = ( 2. * trb(ji,jj,jk,jpdic) - zcaralk ) 
    331                hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1 
    332             END DO 
    333          END DO 
    334      END DO 
    335      ! 
    336    END SUBROUTINE p4z_ph_ini 
    337  
    338273   SUBROUTINE p4z_rst( kt, cdrw ) 
    339274      !!--------------------------------------------------------------------- 
    … …  
    349284      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag 
    350285      ! 
    351       INTEGER  ::  ji, jj, jk 
    352       REAL(wp) ::  zcaralk, zbicarb, zco3 
    353       REAL(wp) ::  ztmas, ztmas1 
    354286      !!--------------------------------------------------------------------- 
    355287 
    … …  
    363295            CALL iom_get( numrtr, jpdom_autoglo, 'PH' , hi(:,:,:)  ) 
    364296         ELSE 
    365 !            hi(:,:,:) = 1.e-9  
    366             CALL p4z_ph_ini 
     297            CALL ahini_for_at(hi) 
    367298         ENDIF 
    368299         CALL iom_get( numrtr, jpdom_autoglo, 'Silicalim', xksi(:,:) ) 
    … …  
    379310         ENDIF 
    380311         ! 
     312         IF( ln_p5z ) THEN 
     313            IF( iom_varid( numrtr, 'sized', ldstop = .FALSE. ) > 0 ) THEN 
     314               CALL iom_get( numrtr, jpdom_autoglo, 'sizep' , sized(:,:,:)  ) 
     315               CALL iom_get( numrtr, jpdom_autoglo, 'sizen' , sized(:,:,:)  ) 
     316               CALL iom_get( numrtr, jpdom_autoglo, 'sized' , sized(:,:,:)  ) 
     317            ELSE 
     318               sizep(:,:,:) = 1. 
     319               sizen(:,:,:) = 1. 
     320               sized(:,:,:) = 1. 
     321            ENDIF 
     322        ENDIF 
     323        ! 
    381324      ELSEIF( TRIM(cdrw) == 'WRITE' ) THEN 
    382325         IF( kt == nitrst ) THEN 
    … …  
    389332         CALL iom_rstput( kt, nitrst, numrtw, 'Silicamax', xksimax(:,:) ) 
    390333         CALL iom_rstput( kt, nitrst, numrtw, 'tcflxcum', t_oce_co2_flx_cum ) 
     334         IF( ln_p5z ) THEN 
     335            CALL iom_rstput( kt, nitrst, numrtw, 'sizep', sized(:,:,:) ) 
     336            CALL iom_rstput( kt, nitrst, numrtw, 'sizen', sized(:,:,:) ) 
     337            CALL iom_rstput( kt, nitrst, numrtw, 'sized', sized(:,:,:) ) 
     338         ENDIF 
    391339      ENDIF 
    392340      ! 
    … …  
    416364      IF(lwp)  WRITE(numout,*) 
    417365 
    418       IF( cp_cfg == "orca" .AND. .NOT. lk_c1d ) THEN      ! ORCA configuration (not 1D) ! 
    419          !                                                    ! --------------------------- ! 
     366      IF( cn_cfg == "orca" .AND. .NOT. lk_c1d ) THEN      ! ORCA configuration (not 1D) ! 
     367         !                                                ! --------------------------- ! 
    420368         ! set total alkalinity, phosphate, nitrate & silicate 
    421369         zarea          = 1._wp / glob_sum( cvol(:,:,:) ) * 1e6               
    … …  
    475423      REAL(wp)             ::  zrdenittot, zsdenittot, znitrpottot 
    476424      CHARACTER(LEN=100)   ::   cltxt 
    477       REAL(wp), DIMENSION(jpi,jpj,jpk) :: zvol 
    478425      INTEGER :: jk 
     426      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwork 
    479427      !!---------------------------------------------------------------------- 
    480428 
    … …  
    496444      ENDIF 
    497445 
     446      CALL wrk_alloc( jpi, jpj, jpk, zwork ) 
    498447      ! 
    499448      IF( iom_use( "pno3tot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN 
    500449         !   Compute the budget of NO3, ALK, Si, Fer 
    501          no3budget = glob_sum( (   trn(:,:,:,jpno3) + trn(:,:,:,jpnh4)  & 
    502             &                    + trn(:,:,:,jpphy) + trn(:,:,:,jpdia)  & 
    503             &                    + trn(:,:,:,jpzoo) + trn(:,:,:,jpmes)  & 
    504             &                    + trn(:,:,:,jppoc)                     & 
    505 #if ! defined key_kriest 
    506             &                    + trn(:,:,:,jpgoc)                     & 
    507 #endif 
    508             &                    + trn(:,:,:,jpdoc)                     ) * cvol(:,:,:)  ) 
    509          ! 
    510          no3budget = no3budget / areatot 
    511          CALL iom_put( "pno3tot", no3budget ) 
     450         IF( ln_p4z ) THEN 
     451            zwork(:,:,:) =    trn(:,:,:,jpno3) + trn(:,:,:,jpnh4)                      & 
     452               &          +   trn(:,:,:,jpphy) + trn(:,:,:,jpdia)                      & 
     453               &          +   trn(:,:,:,jppoc) + trn(:,:,:,jpgoc)  + trn(:,:,:,jpdoc)  &         
     454               &          +   trn(:,:,:,jpzoo) + trn(:,:,:,jpmes)  
     455        ELSE 
     456            zwork(:,:,:) =    trn(:,:,:,jpno3) + trn(:,:,:,jpnh4) + trn(:,:,:,jpnph)   & 
     457               &          +   trn(:,:,:,jpndi) + trn(:,:,:,jpnpi)                      &  
     458               &          +   trn(:,:,:,jppon) + trn(:,:,:,jpgon) + trn(:,:,:,jpdon)   & 
     459               &          + ( trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) ) * no3rat3  
     460        ENDIF 
     461        ! 
     462        no3budget = glob_sum( zwork(:,:,:) * cvol(:,:,:)  )   
     463        no3budget = no3budget / areatot 
     464        CALL iom_put( "pno3tot", no3budget ) 
    512465      ENDIF 
    513466      ! 
    514467      IF( iom_use( "ppo4tot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN 
    515          po4budget = glob_sum( (   trn(:,:,:,jppo4)                     & 
    516             &                    + trn(:,:,:,jpphy) + trn(:,:,:,jpdia)  & 
    517             &                    + trn(:,:,:,jpzoo) + trn(:,:,:,jpmes)  & 
    518             &                    + trn(:,:,:,jppoc)                     & 
    519 #if ! defined key_kriest 
    520             &                    + trn(:,:,:,jpgoc)                     & 
    521 #endif 
    522             &                    + trn(:,:,:,jpdoc)                     ) * cvol(:,:,:)  ) 
    523          po4budget = po4budget / areatot 
    524          CALL iom_put( "ppo4tot", po4budget ) 
     468         IF( ln_p4z ) THEN 
     469            zwork(:,:,:) =    trn(:,:,:,jppo4)                                         & 
     470               &          +   trn(:,:,:,jpphy) + trn(:,:,:,jpdia)                      & 
     471               &          +   trn(:,:,:,jppoc) + trn(:,:,:,jpgoc)  + trn(:,:,:,jpdoc)  &         
     472               &          +   trn(:,:,:,jpzoo) + trn(:,:,:,jpmes)  
     473        ELSE 
     474            zwork(:,:,:) =    trn(:,:,:,jppo4) + trn(:,:,:,jppph)                      & 
     475               &          +   trn(:,:,:,jppdi) + trn(:,:,:,jpppi)                      &  
     476               &          +   trn(:,:,:,jppop) + trn(:,:,:,jpgop) + trn(:,:,:,jpdop)   & 
     477               &          + ( trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) ) * po4rat3  
     478        ENDIF 
     479        ! 
     480        po4budget = glob_sum( zwork(:,:,:) * cvol(:,:,:)  )   
     481        po4budget = po4budget / areatot 
     482        CALL iom_put( "ppo4tot", po4budget ) 
    525483      ENDIF 
    526484      ! 
    527485      IF( iom_use( "psiltot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN 
    528          silbudget = glob_sum( (   trn(:,:,:,jpsil) + trn(:,:,:,jpgsi)  & 
    529             &                    + trn(:,:,:,jpdsi)                     ) * cvol(:,:,:)  ) 
    530          ! 
     486         zwork(:,:,:) =  trn(:,:,:,jpsil) + trn(:,:,:,jpgsi) + trn(:,:,:,jpdsi)  
     487         ! 
     488         silbudget = glob_sum( zwork(:,:,:) * cvol(:,:,:)  )   
    531489         silbudget = silbudget / areatot 
    532490         CALL iom_put( "psiltot", silbudget ) 
    … …  
    534492      ! 
    535493      IF( iom_use( "palktot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN 
    536          alkbudget = glob_sum( (   trn(:,:,:,jpno3) * rno3              & 
    537             &                    + trn(:,:,:,jptal)                     & 
    538             &                    + trn(:,:,:,jpcal) * 2.                ) * cvol(:,:,:)  ) 
    539          ! 
     494         zwork(:,:,:) =  trn(:,:,:,jpno3) * rno3 + trn(:,:,:,jptal) + trn(:,:,:,jpcal) * 2.               
     495         ! 
     496         alkbudget = glob_sum( zwork(:,:,:) * cvol(:,:,:)  )         ! 
    540497         alkbudget = alkbudget / areatot 
    541498         CALL iom_put( "palktot", alkbudget ) 
    … …  
    543500      ! 
    544501      IF( iom_use( "pfertot" ) .OR. ( ln_check_mass .AND. kt == nitend )  ) THEN 
    545          ferbudget = glob_sum( (   trn(:,:,:,jpfer) + trn(:,:,:,jpnfe)  & 
    546             &                    + trn(:,:,:,jpdfe)                     & 
    547 #if ! defined key_kriest 
    548             &                    + trn(:,:,:,jpbfe)                     & 
    549 #endif 
    550             &                    + trn(:,:,:,jpsfe)                     & 
    551             &                    + trn(:,:,:,jpzoo) * ferat3            & 
    552             &                    + trn(:,:,:,jpmes) * ferat3            ) * cvol(:,:,:)  ) 
    553          ! 
     502         zwork(:,:,:) =   trn(:,:,:,jpfer) + trn(:,:,:,jpnfe) + trn(:,:,:,jpdfe)   & 
     503            &         +   trn(:,:,:,jpbfe) + trn(:,:,:,jpsfe)                      & 
     504            &         + ( trn(:,:,:,jpzoo) + trn(:,:,:,jpmes) )  * ferat3     
     505         IF( ln_ligand)  zwork(:,:,:) = zwork(:,:,:) + trn(:,:,:,jpfep)                 
     506         ! 
     507         ferbudget = glob_sum( zwork(:,:,:) * cvol(:,:,:)  )   
    554508         ferbudget = ferbudget / areatot 
    555509         CALL iom_put( "pfertot", ferbudget ) 
    556510      ENDIF 
    557511      ! 
    558  
     512      CALL wrk_dealloc( jpi, jpj, jpk, zwork ) 
     513      ! 
    559514      ! Global budget of N SMS : denitrification in the water column and in the sediment 
    560515      !                          nitrogen fixation by the diazotrophs 
    … …  
    600555   END SUBROUTINE p4z_chk_mass 
    601556 
    602 #else 
    603    !!====================================================================== 
    604    !!  Dummy module :                                   No PISCES bio-model 
    605    !!====================================================================== 
    606 CONTAINS 
    607    SUBROUTINE p4z_sms( kt )                   ! Empty routine 
    608       INTEGER, INTENT( in ) ::   kt 
    609       WRITE(*,*) 'p4z_sms: You should not have seen this print! error?', kt 
    610    END SUBROUTINE p4z_sms 
    611 #endif  
    612  
    613557   !!====================================================================== 
    614558END MODULE p4zsms  

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/par_sed.F90

    r5215 r7646  
    2424#endif 
    2525 
    26 #if defined key_kriest 
    27    INTEGER, PARAMETER :: jpdta = 11 
    28 #else 
    2926   INTEGER, PARAMETER :: jpdta = 12 
    30 #endif 
    3127 
    3228 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sed.F90

    r5215 r7646  
    4040 
    4141   USE p4zsink , ONLY :  sinking    =>   sinking         !: sinking flux for POC 
    42 #if ! defined key_kriest 
    4342   USE p4zsink , ONLY :  sinking2   =>   sinking2        !: sinking flux for GOC 
    44 #endif 
    4543   USE p4zsink , ONLY :  sinkcal    =>   sinkcal         !: sinking flux for calcite 
    4644   USE p4zsink , ONLY :  sinksil    =>   sinksil         !: sinking flux for opal ( dsi ) 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/seddta.F90

    r5215 r7646  
    5555 
    5656      REAL(wp), DIMENSION(:,:), ALLOCATABLE :: zdta 
    57 #if ! defined key_kriest 
    5857      REAL(wp), DIMENSION(:)  , ALLOCATABLE :: zdtap, zdtag 
    59 #endif  
    6058 
    6159 
    … …  
    9795      ENDIF 
    9896 
    99  
    100 #if ! defined key_kriest    
    10197      ! Initialization of temporaries arrays   
    10298      ALLOCATE( zdtap(jpoce) )    ;   zdtap(:)    = 0.  
    10399      ALLOCATE( zdtag(jpoce) )    ;   zdtag(:)    = 0.   
    104 #endif 
    105  
    106100 
    107101      IF( MOD( kt - 1, nfreq ) == 0 ) THEN 
    … …  
    122116                  trc_data(ji,jj,5)  = trn  (ji,jj,ikt,jpoxy) 
    123117                  trc_data(ji,jj,6)  = trn  (ji,jj,ikt,jpsil) 
    124 #   if ! defined key_kriest 
    125118                  trc_data(ji,jj,7 ) = sinksil (ji,jj,ikt) 
    126119                  trc_data(ji,jj,8 ) = sinking (ji,jj,ikt) 
    … …  
    129122                  trc_data(ji,jj,11) = tsn     (ji,jj,ikt,jp_tem) 
    130123                  trc_data(ji,jj,12) = tsn     (ji,jj,ikt,jp_sal) 
    131 #   else 
    132                   trc_data(ji,jj,7 ) = sinksil (ji,jj,ikt) 
    133                   trc_data(ji,jj,8 ) = sinking (ji,jj,ikt) 
    134                   trc_data(ji,jj,9 ) = sinkcal (ji,jj,ikt) 
    135                   trc_data(ji,jj,10) = tsn     (ji,jj,ikt,jp_tem) 
    136                   trc_data(ji,jj,11) = tsn     (ji,jj,ikt,jp_sal)        
    137 #   endif 
    138124               ENDIF 
    139125            ENDDO 
    … …  
    147133         CALL iom_get( numbio, jpdom_data, 'O2BOT'      , trc_data(:,:,5 ) ) 
    148134         CALL iom_get( numbio, jpdom_data, 'SIBOT'      , trc_data(:,:,6 ) ) 
    149 #   if ! defined key_kriest 
    150135         CALL iom_get( numbio, jpdom_data, 'OPALFLXBOT' , trc_data(:,:,7 ) )  
    151136         CALL iom_get( numbio, jpdom_data, 'POCFLXBOT'  , trc_data(:,:,8 ) )  
    … …  
    154139         CALL iom_get( numoce, jpdom_data, 'TBOT'       , trc_data(:,:,11) )  
    155140         CALL iom_get( numoce, jpdom_data, 'SBOT'       , trc_data(:,:,12) )  
    156 #   else 
    157          CALL iom_get( numbio, jpdom_data, 'OPALFLXBOT' , trc_data(:,:,7 ) )  
    158          CALL iom_get( numbio, jpdom_data, 'POCFLXBOT'  , trc_data(:,:,8 ) )  
    159          CALL iom_get( numbio, jpdom_data, 'CACO3FLXBOT', trc_data(:,:,9 ) )  
    160          CALL iom_get( numoce, jpdom_data, 'TBOT'       , trc_data(:,:,10) )  
    161          CALL iom_get( numoce, jpdom_data, 'SBOT'       , trc_data(:,:,11) )  
    162 #   endif 
    163141#endif 
    164142 
    … …  
    186164         !  Solid components :  
    187165         !----------------------- 
    188 #if ! defined key_kriest 
    189166         !  Sinking fluxes for OPAL in mol.m-2.s-1 ; conversion in mol.cm-2.s-1 
    190167         CALL pack_arr ( jpoce, rainrm_dta(1:jpoce,jsopal), trc_data(1:jpi,1:jpj,7), iarroce(1:jpoce) )  
    … …  
    200177         CALL pack_arr ( jpoce,  temp(1:jpoce), trc_data(1:jpi,1:jpj,11), iarroce(1:jpoce) ) 
    201178         CALL pack_arr ( jpoce,  salt(1:jpoce), trc_data(1:jpi,1:jpj,12), iarroce(1:jpoce) ) 
    202 #else 
    203          !  Sinking fluxes for OPAL in mol.m-2.s-1 ; conversion in mol.cm-2.s-1 
    204          CALL pack_arr ( jpoce, rainrm_dta(1:jpoce,jsopal), trc_data(1:jpi,1:jpj,7), iarroce(1:jpoce) )  
    205          rainrm_dta(1:jpoce,jsopal) = rainrm_dta(1:jpoce,jsopal) * 1e-4 
    206          !  Sinking fluxes for POC in mol.m-2.s-1 ; conversion in mol.cm-2.s-1 
    207          CALL pack_arr ( jpoce, rainrm_dta(1:jpoce,jspoc), trc_data(1:jpi,1:jpj,8) , iarroce(1:jpoce) )       
    208          rainrm_dta(1:jpoce,jspoc) = rainrm_dta(1:jpoce,jspoc) * 1e-4 
    209          !  Sinking fluxes for Calcite in mol.m-2.s-1 ; conversion in mol.cm-2.s-1 
    210          CALL pack_arr ( jpoce,  rainrm_dta(1:jpoce,jscal), trc_data(1:jpi,1:jpj,9), iarroce(1:jpoce) ) 
    211          rainrm_dta(1:jpoce,jscal) = rainrm_dta(1:jpoce,jscal) * 1e-4 
    212          ! vector temperature [°C] and salinity  
    213          CALL pack_arr ( jpoce,  temp(1:jpoce), trc_data(1:jpi,1:jpj,10), iarroce(1:jpoce) ) 
    214          CALL pack_arr ( jpoce,  salt(1:jpoce), trc_data(1:jpi,1:jpj,11), iarroce(1:jpoce) ) 
    215  
    216 #endif 
    217179         
    218180         ! Clay rain rate in [mol/(cm**2.s)]  
    … …  
    252214 
    253215      DEALLOCATE( zdta )  
    254 #if ! defined key_kriest 
    255216      DEALLOCATE( zdtap    ) ;  DEALLOCATE( zdtag    )  
    256 #endif       
    257217 
    258218      IF( kt == nitsedend )   THEN 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/SED/sedmodel.F90

    r5215 r7646  
    1515   PUBLIC sed_model  ! called by step.F90 
    1616 
    17    LOGICAL, PUBLIC, PARAMETER ::   lk_sed = .TRUE.     !: sediment flag 
    18  
    19    !! $Id$ 
    2017CONTAINS 
    2118 
    … …  
    4744   !! MODULE sedmodel  :   Dummy module  
    4845   !!====================================================================== 
    49    LOGICAL, PUBLIC, PARAMETER ::   lk_sed = .FALSE.     !: sediment flag 
    50    !! $Id$ 
    5146CONTAINS 
    5247   SUBROUTINE sed_model( kt )         ! Empty routine 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/par_pisces.F90

    r5385 r7646  
    1313   IMPLICIT NONE 
    1414 
    15 #if defined key_pisces_reduced 
    16    !!--------------------------------------------------------------------- 
    17    !!   'key_pisces_reduced'   :                                LOBSTER bio-model 
    18    !!--------------------------------------------------------------------- 
    19    LOGICAL, PUBLIC, PARAMETER ::   lk_pisces     = .TRUE.  !: PISCES flag  
    20    LOGICAL, PUBLIC, PARAMETER ::   lk_p4z        = .FALSE. !: p4z flag  
    21    INTEGER, PUBLIC, PARAMETER ::   jp_pisces     =  6      !: number of passive tracers 
    22    INTEGER, PUBLIC, PARAMETER ::   jp_pisces_2d  =  19     !: additional 2d output  
    23    INTEGER, PUBLIC, PARAMETER ::   jp_pisces_3d  =   3     !: additional 3d output  
    24    INTEGER, PUBLIC, PARAMETER ::   jp_pisces_trd =   17    !: number of sms trends for PISCES 
     15   ! productive layer depth 
     16   INTEGER, PUBLIC ::   jpkb       !: first vertical layers where biology is active 
     17   INTEGER, PUBLIC ::   jpkbm1     !: first vertical layers where biology is active 
    2518 
    2619   ! assign an index in trc arrays for each LOBSTER prognostic variables 
    27    INTEGER, PUBLIC, PARAMETER ::   jpdet     =  1        !: detritus                    [mmoleN/m3] 
    28    INTEGER, PUBLIC, PARAMETER ::   jpzoo     =  2        !: zooplancton concentration   [mmoleN/m3] 
    29    INTEGER, PUBLIC, PARAMETER ::   jpphy     =  3        !: phytoplancton concentration [mmoleN/m3] 
    30    INTEGER, PUBLIC, PARAMETER ::   jpno3     =  4        !: nitrate concentration       [mmoleN/m3] 
    31    INTEGER, PUBLIC, PARAMETER ::   jpnh4     =  5        !: ammonium concentration      [mmoleN/m3] 
    32    INTEGER, PUBLIC, PARAMETER ::   jpdom     =  6        !: dissolved organic matter    [mmoleN/m3] 
     20   INTEGER, PUBLIC ::   jpdet     !: detritus                    
     21   INTEGER, PUBLIC ::   jpdom     !: dissolved organic matter  
     22   INTEGER, PUBLIC ::   jpdic     !: dissolved inoganic carbon concentration  
     23   INTEGER, PUBLIC ::   jptal     !: total alkalinity  
     24   INTEGER, PUBLIC ::   jpoxy     !: oxygen carbon concentration  
     25   INTEGER, PUBLIC ::   jpcal     !: calcite  concentration  
     26   INTEGER, PUBLIC ::   jppo4     !: phosphate concentration  
     27   INTEGER, PUBLIC ::   jppoc     !: small particulate organic phosphate concentration 
     28   INTEGER, PUBLIC ::   jpsil     !: silicate concentration 
     29   INTEGER, PUBLIC ::   jpphy     !: phytoplancton concentration  
     30   INTEGER, PUBLIC ::   jpzoo     !: zooplancton concentration 
     31   INTEGER, PUBLIC ::   jpdoc     !: dissolved organic carbon concentration  
     32   INTEGER, PUBLIC ::   jpdia     !: Diatoms Concentration 
     33   INTEGER, PUBLIC ::   jpmes     !: Mesozooplankton Concentration 
     34   INTEGER, PUBLIC ::   jpdsi     !: Diatoms Silicate Concentration 
     35   INTEGER, PUBLIC ::   jpfer     !: Iron Concentration 
     36   INTEGER, PUBLIC ::   jpbfe     !: Big iron particles Concentration 
     37   INTEGER, PUBLIC ::   jpgoc     !: big particulate organic phosphate concentration 
     38   INTEGER, PUBLIC ::   jpsfe     !: Small iron particles Concentration 
     39   INTEGER, PUBLIC ::   jpdfe     !: Diatoms iron Concentration 
     40   INTEGER, PUBLIC ::   jpgsi     !: (big) Silicate Concentration 
     41   INTEGER, PUBLIC ::   jpnfe     !: Nano iron Concentration 
     42   INTEGER, PUBLIC ::   jpnch     !: Nano Chlorophyll Concentration 
     43   INTEGER, PUBLIC ::   jpdch     !: Diatoms Chlorophyll Concentration 
     44   INTEGER, PUBLIC ::   jpno3     !: Nitrates Concentration 
     45   INTEGER, PUBLIC ::   jpnh4     !: Ammonium Concentration 
     46   INTEGER, PUBLIC ::   jpdon     !: dissolved organic nitrogen concentration 
     47   INTEGER, PUBLIC ::   jpdop     !: dissolved organic phosphorus concentration 
     48   INTEGER, PUBLIC ::   jppon     !: small particulate organic nitrogen concentration 
     49   INTEGER, PUBLIC ::   jppop     !: small particulate organic phosphorus concentration 
     50   INTEGER, PUBLIC ::   jpnph     !: small particulate organic phosphorus concentration 
     51   INTEGER, PUBLIC ::   jppph     !: small particulate organic phosphorus concentration 
     52   INTEGER, PUBLIC ::   jpndi     !: small particulate organic phosphorus concentration 
     53   INTEGER, PUBLIC ::   jppdi     !: small particulate organic phosphorus concentration 
     54   INTEGER, PUBLIC ::   jppic     !: small particulate organic phosphorus concentration 
     55   INTEGER, PUBLIC ::   jpnpi     !: small particulate organic phosphorus concentration 
     56   INTEGER, PUBLIC ::   jpppi     !: small particulate organic phosphorus concentration 
     57   INTEGER, PUBLIC ::   jppfe     !: small particulate organic phosphorus concentration 
     58   INTEGER, PUBLIC ::   jppch     !: small particulate organic phosphorus concentration 
     59   INTEGER, PUBLIC ::   jpgon     !: Big nitrogen particles Concentration 
     60   INTEGER, PUBLIC ::   jpgop     !: Big phosphorus particles Concentration 
     61   INTEGER, PUBLIC ::   jplgw     !: Weak Ligands 
     62   INTEGER, PUBLIC ::   jpfep     !: Fe nanoparticle 
    3363 
    34    ! productive layer depth 
    35    INTEGER, PUBLIC, PARAMETER ::   jpkb      = 12        !: first vertical layers where biology is active 
    36    INTEGER, PUBLIC, PARAMETER ::   jpkbm1    = jpkb - 1  !: first vertical layers where biology is active 
    37  
    38 #elif defined key_pisces  &&  defined key_kriest 
    39    !!--------------------------------------------------------------------- 
    40    !!   'key_pisces' & 'key_kriest'                 PISCES bio-model + ??? 
    41    !!--------------------------------------------------------------------- 
    42    LOGICAL, PUBLIC, PARAMETER ::   lk_pisces     = .TRUE.  !: PISCES flag  
    43    LOGICAL, PUBLIC, PARAMETER ::   lk_p4z        = .TRUE. !: p4z flag  
    44    LOGICAL, PUBLIC, PARAMETER ::   lk_kriest     = .TRUE.  !: Kriest flag  
    45    INTEGER, PUBLIC, PARAMETER ::   jp_pisces     =  23     !: number of passive tracers 
    46    INTEGER, PUBLIC, PARAMETER ::   jp_pisces_2d  =  13     !: additional 2d output  
    47    INTEGER, PUBLIC, PARAMETER ::   jp_pisces_3d  =  18     !: additional 3d output  
    48    INTEGER, PUBLIC, PARAMETER ::   jp_pisces_trd =   1     !: number of sms trends for PISCES 
    49  
    50    ! assign an index in trc arrays for each LOBSTER prognostic variables 
    51    !    WARNING: be carefull about the order when reading the restart 
    52         !   !!gm  this warning should be obsolet with IOM 
    53    INTEGER, PUBLIC, PARAMETER ::   jpdic =  1    !: dissolved inoganic carbon concentration  
    54    INTEGER, PUBLIC, PARAMETER ::   jptal =  2    !: total alkalinity  
    55    INTEGER, PUBLIC, PARAMETER ::   jpoxy =  3    !: oxygen carbon concentration  
    56    INTEGER, PUBLIC, PARAMETER ::   jpcal =  4    !: calcite  concentration  
    57    INTEGER, PUBLIC, PARAMETER ::   jppo4 =  5    !: phosphate concentration  
    58    INTEGER, PUBLIC, PARAMETER ::   jppoc =  6    !: small particulate organic phosphate concentration 
    59    INTEGER, PUBLIC, PARAMETER ::   jpsil =  7    !: silicate concentration 
    60    INTEGER, PUBLIC, PARAMETER ::   jpphy =  8    !: phytoplancton concentration  
    61    INTEGER, PUBLIC, PARAMETER ::   jpzoo =  9    !: zooplancton concentration 
    62    INTEGER, PUBLIC, PARAMETER ::   jpdoc = 10    !: dissolved organic carbon concentration  
    63    INTEGER, PUBLIC, PARAMETER ::   jpdia = 11    !: Diatoms Concentration 
    64    INTEGER, PUBLIC, PARAMETER ::   jpmes = 12    !: Mesozooplankton Concentration 
    65    INTEGER, PUBLIC, PARAMETER ::   jpdsi = 13    !: Diatoms Silicate Concentration 
    66    INTEGER, PUBLIC, PARAMETER ::   jpfer = 14    !: Iron Concentration 
    67    INTEGER, PUBLIC, PARAMETER ::   jpnum = 15    !: Big iron particles Concentration 
    68    INTEGER, PUBLIC, PARAMETER ::   jpsfe = 16    !: number of particulate organic phosphate concentration 
    69    INTEGER, PUBLIC, PARAMETER ::   jpdfe = 17    !: Diatoms iron Concentration 
    70    INTEGER, PUBLIC, PARAMETER ::   jpgsi = 18    !: (big) Silicate Concentration 
    71    INTEGER, PUBLIC, PARAMETER ::   jpnfe = 19    !: Nano iron Concentration 
    72    INTEGER, PUBLIC, PARAMETER ::   jpnch = 20    !: Nano Chlorophyll Concentration 
    73    INTEGER, PUBLIC, PARAMETER ::   jpdch = 21    !: Diatoms Chlorophyll Concentration 
    74    INTEGER, PUBLIC, PARAMETER ::   jpno3 = 22    !: Nitrates Concentration 
    75    INTEGER, PUBLIC, PARAMETER ::   jpnh4 = 23    !: Ammonium Concentration 
    76  
    77 #elif defined key_pisces 
    78    !!--------------------------------------------------------------------- 
    79    !!   'key_pisces'   :                         standard PISCES bio-model 
    80    !!--------------------------------------------------------------------- 
    81    LOGICAL, PUBLIC, PARAMETER ::   lk_pisces     = .TRUE.  !: PISCES flag  
    82    LOGICAL, PUBLIC, PARAMETER ::   lk_p4z        = .TRUE.  !: p4z flag  
    83    LOGICAL, PUBLIC, PARAMETER ::   lk_kriest     = .FALSE. !: Kriest flag  
    84    INTEGER, PUBLIC, PARAMETER ::   jp_pisces     = 24      !: number of PISCES passive tracers 
    85    INTEGER, PUBLIC, PARAMETER ::   jp_pisces_2d  = 13      !: additional 2d output  
    86    INTEGER, PUBLIC, PARAMETER ::   jp_pisces_3d  = 11      !: additional 3d output  
    87    INTEGER, PUBLIC, PARAMETER ::   jp_pisces_trd =  1      !: number of sms trends for PISCES 
    88  
    89    ! assign an index in trc arrays for each LOBSTER prognostic variables 
    90    !    WARNING: be carefull about the order when reading the restart 
    91         !   !!gm  this warning should be obsolet with IOM 
    92    INTEGER, PUBLIC, PARAMETER ::   jpdic =  1    !: dissolved inoganic carbon concentration  
    93    INTEGER, PUBLIC, PARAMETER ::   jptal =  2    !: total alkalinity  
    94    INTEGER, PUBLIC, PARAMETER ::   jpoxy =  3    !: oxygen carbon concentration  
    95    INTEGER, PUBLIC, PARAMETER ::   jpcal =  4    !: calcite  concentration  
    96    INTEGER, PUBLIC, PARAMETER ::   jppo4 =  5    !: phosphate concentration  
    97    INTEGER, PUBLIC, PARAMETER ::   jppoc =  6    !: small particulate organic phosphate concentration 
    98    INTEGER, PUBLIC, PARAMETER ::   jpsil =  7    !: silicate concentration 
    99    INTEGER, PUBLIC, PARAMETER ::   jpphy =  8    !: phytoplancton concentration  
    100    INTEGER, PUBLIC, PARAMETER ::   jpzoo =  9    !: zooplancton concentration 
    101    INTEGER, PUBLIC, PARAMETER ::   jpdoc = 10    !: dissolved organic carbon concentration  
    102    INTEGER, PUBLIC, PARAMETER ::   jpdia = 11    !: Diatoms Concentration 
    103    INTEGER, PUBLIC, PARAMETER ::   jpmes = 12    !: Mesozooplankton Concentration 
    104    INTEGER, PUBLIC, PARAMETER ::   jpdsi = 13    !: Diatoms Silicate Concentration 
    105    INTEGER, PUBLIC, PARAMETER ::   jpfer = 14    !: Iron Concentration 
    106    INTEGER, PUBLIC, PARAMETER ::   jpbfe = 15    !: Big iron particles Concentration 
    107    INTEGER, PUBLIC, PARAMETER ::   jpgoc = 16    !: big particulate organic phosphate concentration 
    108    INTEGER, PUBLIC, PARAMETER ::   jpsfe = 17    !: Small iron particles Concentration 
    109    INTEGER, PUBLIC, PARAMETER ::   jpdfe = 18    !: Diatoms iron Concentration 
    110    INTEGER, PUBLIC, PARAMETER ::   jpgsi = 19    !: (big) Silicate Concentration 
    111    INTEGER, PUBLIC, PARAMETER ::   jpnfe = 20    !: Nano iron Concentration 
    112    INTEGER, PUBLIC, PARAMETER ::   jpnch = 21    !: Nano Chlorophyll Concentration 
    113    INTEGER, PUBLIC, PARAMETER ::   jpdch = 22    !: Diatoms Chlorophyll Concentration 
    114    INTEGER, PUBLIC, PARAMETER ::   jpno3 = 23    !: Nitrates Concentration 
    115    INTEGER, PUBLIC, PARAMETER ::   jpnh4 = 24    !: Ammonium Concentration 
    116  
    117 #else 
    11864   !!--------------------------------------------------------------------- 
    11965   !!   Default                                   No CFC geochemical model 
    120    !!--------------------------------------------------------------------- 
    121    LOGICAL, PUBLIC, PARAMETER ::   lk_pisces     = .FALSE.  !: PISCES flag  
    122    LOGICAL, PUBLIC, PARAMETER ::   lk_p4z        = .FALSE.  !: p4z flag  
    123    INTEGER, PUBLIC, PARAMETER ::   jp_pisces     =  0       !: No CFC tracers 
    124    INTEGER, PUBLIC, PARAMETER ::   jp_pisces_2d  =  0       !: No CFC additional 2d output arrays  
    125    INTEGER, PUBLIC, PARAMETER ::   jp_pisces_3d  =  0       !: No CFC additional 3d output arrays  
    126    INTEGER, PUBLIC, PARAMETER ::   jp_pisces_trd =  0       !: number of sms trends for PISCES 
    127 #endif 
    128  
    12966   ! Starting/ending PISCES do-loop indices (N.B. no PISCES : jpl_pcs < jpf_pcs the do-loop are never done) 
    130    INTEGER, PUBLIC, PARAMETER ::   jp_pcs0     = 1                  !: First index of PISCES tracers 
    131    INTEGER, PUBLIC, PARAMETER ::   jp_pcs1     = jp_pisces          !: Last  index of PISCES tracers 
    132    INTEGER, PUBLIC, PARAMETER ::   jp_pcs0_2d  = 1               !: First index of 2D diag 
    133    INTEGER, PUBLIC, PARAMETER ::   jp_pcs1_2d  = jp_pisces_2d    !: Last  index of 2D diag 
    134    INTEGER, PUBLIC, PARAMETER ::   jp_pcs0_3d  = 1               !: First index of 3D diag 
    135    INTEGER, PUBLIC, PARAMETER ::   jp_pcs1_3d  = jp_pisces_3d    !: Last  index of 3d diag 
    136    INTEGER, PUBLIC, PARAMETER ::   jp_pcs0_trd = 1              !: First index of bio diag 
    137    INTEGER, PUBLIC, PARAMETER ::   jp_pcs1_trd = jp_pisces_trd  !: Last  index of bio diag 
    138  
     67   INTEGER, PUBLIC  ::   jp_pcs0  !: First index of PISCES tracers 
     68   INTEGER, PUBLIC  ::   jp_pcs1  !: Last  index of PISCES tracers 
    13969 
    14070   !!====================================================================== 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90

    r6291 r7646  
    66   !! History :   1.0  !  2000-02 (O. Aumont) original code 
    77   !!             3.2  !  2009-04 (C. Ethe & NEMO team) style 
    8    !!---------------------------------------------------------------------- 
    9 #if defined key_pisces || defined key_pisces_reduced  
    10    !!---------------------------------------------------------------------- 
    11    !!   'key_pisces'                                         PISCES model 
    128   !!---------------------------------------------------------------------- 
    139   USE par_oce 
    … …  
    2117   INTEGER ::   numonp      = -1           !! Logical unit for namelist pisces output 
    2218 
    23    !!*  Biological fluxes for light : variables shared by pisces & lobster 
    24    INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:)   ::  neln  !: number of T-levels + 1 in the euphotic layer 
    25    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::  heup  !: euphotic layer depth 
    26    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  etot  !: par (photosynthetic available radiation) 
    27    ! 
    28    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::  xksi  !:  LOBSTER : zooplakton closure 
    2919   !                                                       !:  PISCES  : silicon dependant half saturation 
    3020 
    31 #if defined key_pisces  
     21   !!* Model used 
     22   LOGICAL  ::  ln_p2z            !: Flag to use LOBSTER model 
     23   LOGICAL  ::  ln_p4z            !: Flag to use PISCES  model 
     24   LOGICAL  ::  ln_p5z            !: Flag to use PISCES  quota model 
     25   LOGICAL  ::  ln_ligand         !: Flag to enable organic ligands 
     26 
    3227   !!*  Time variables 
    3328   INTEGER  ::   nrdttrc           !: ??? 
    … …  
    4944   REAL(wp) ::   o2nit             !: ??? 
    5045   REAL(wp) ::   wsbio, wsbio2     !: ??? 
     46   REAL(wp) ::   wsbio2max         !: ??? 
     47   REAL(wp) ::   wsbio2scale       !: ??? 
    5148   REAL(wp) ::   xkmort            !: ??? 
    5249   REAL(wp) ::   ferat3            !: ??? 
     50   REAL(wp) ::   wfep              !: ??? 
     51   REAL(wp) ::   ldocp             !: ??? 
     52   REAL(wp) ::   ldocz             !: ??? 
     53   REAL(wp) ::   lthet             !: ??? 
     54   REAL(wp) ::   no3rat3           !: ??? 
     55   REAL(wp) ::   po4rat3           !: ??? 
     56 
    5357 
    5458   !!*  diagnostic parameters  
    … …  
    6670   LOGICAL  ::  ln_check_mass      !: Flag to check mass conservation 
    6771 
     72   !!*  Biological fluxes for light : variables shared by pisces & lobster 
     73   INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:)   ::  neln  !: number of T-levels + 1 in the euphotic layer 
     74   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::  heup  !: euphotic layer depth 
     75   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  etot  !: par (photosynthetic available radiation) 
     76   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  etot_ndcy      !: PAR over 24h in case of diurnal cycle 
     77   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  enano, ediat   !: PAR for phyto, nano and diat  
     78   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  epico          !: PAR for pico 
     79   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  emoy           !: averaged PAR in the mixed layer 
     80   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::  heup_01 !: Absolute euphotic layer depth 
     81   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::  xksi  !:  LOBSTER : zooplakton closure 
     82 
    6883   !!*  Biological fluxes for primary production 
    69    REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:)  ::   xksimax    !: ??? 
    70    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xnanono3   !: ??? 
    71    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xdiatno3   !: ??? 
    72    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xnanonh4   !: ??? 
    73    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xdiatnh4   !: ??? 
    74    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xnanopo4   !: ??? 
    75    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xdiatpo4   !: ??? 
    76    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimphy    !: ??? 
    77    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimdia    !: ??? 
    78    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   concdfe    !: ??? 
    79    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   concnfe    !: ??? 
    80    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimnfe    !: ??? 
    81    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimdfe    !: ??? 
    82    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimsi     !: ??? 
     84   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)    ::   xksimax    !: ??? 
    8385   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   biron      !: bioavailable fraction of iron 
     86   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   plig       !: proportion of iron organically complexed 
     87 
     88   !!*  Sinking speed 
     89   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   wsbio3   !: POC sinking speed  
     90   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   wsbio4   !: GOC sinking speed 
     91   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   wscal    !: Calcite and BSi sinking speeds 
     92   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   wsfep 
     93 
    8494 
    8595 
    … …  
    8797   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xfracal    !: ?? 
    8898   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   nitrfac    !: ?? 
    89    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xlimbac    !: ?? 
    90    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xlimbacl   !: ?? 
     99   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   orem       !: ?? 
    91100   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xdiss      !: ?? 
    92101   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   prodcal    !: Calcite production 
     102   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   prodpoc    !: Calcite production 
     103   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   conspoc    !: Calcite production 
     104   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   prodgoc    !: Calcite production 
     105   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   consgoc    !: Calcite production 
     106 
     107   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sizen      !: size of diatoms  
     108   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sizep      !: size of diatoms  
     109   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   sized      !: size of diatoms  
     110 
    93111 
    94112   !!* Variable for chemistry of the CO2 cycle 
    95    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   akb3       !: ??? 
    96113   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ak13       !: ??? 
    97114   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ak23       !: ??? 
    98115   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   aksp       !: ??? 
    99    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   akw3       !: ??? 
    100    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   borat      !: ??? 
    101116   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hi         !: ??? 
    102117   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   excess     !: ??? 
    … …  
    108123   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tgfunc2   !: Temp. dependancy of mesozooplankton rates 
    109124 
    110 #if defined key_kriest 
    111    !!*  Kriest parameter for aggregation 
    112    REAL(wp) ::   xkr_eta                            !: Sinking  exponent  
    113    REAL(wp) ::   xkr_zeta                           !:  N content exponent  
    114    REAL(wp) ::   xkr_ncontent                       !:  N content factor    
    115    REAL(wp) ::   xkr_massp                          !:  
    116    REAL(wp) ::   xkr_mass_min, xkr_mass_max         !:  Minimum, Maximum mass for Aggregates  
     125#if defined key_sed 
     126   LOGICAL, PUBLIC, PARAMETER ::   lk_sed = .TRUE.     !: sediment flag 
     127#else 
     128   LOGICAL, PUBLIC, PARAMETER ::   lk_sed = .FALSE.     !: sediment flag 
    117129#endif 
    118130 
    119 #endif 
    120131   !!---------------------------------------------------------------------- 
    121132   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    124135   !!---------------------------------------------------------------------- 
    125136CONTAINS 
     137 
    126138 
    127139   INTEGER FUNCTION sms_pisces_alloc() 
    … …  
    130142      !!---------------------------------------------------------------------- 
    131143      USE lib_mpp , ONLY: ctl_warn 
    132       INTEGER ::   ierr(5)        ! Local variables 
     144      INTEGER ::   ierr(10)        ! Local variables 
    133145      !!---------------------------------------------------------------------- 
    134146      ierr(:) = 0 
    135147      !*  Biological fluxes for light : shared variables for pisces & lobster 
    136       ALLOCATE( etot(jpi,jpj,jpk), neln(jpi,jpj), heup(jpi,jpj), xksi(jpi,jpj), STAT=ierr(1) ) 
    137       ! 
    138 #if defined key_pisces 
    139       !*  Biological fluxes for primary production 
    140       ALLOCATE( xksimax(jpi,jpj)     , biron   (jpi,jpj,jpk),       & 
    141          &      xnanono3(jpi,jpj,jpk), xdiatno3(jpi,jpj,jpk),       & 
    142          &      xnanonh4(jpi,jpj,jpk), xdiatnh4(jpi,jpj,jpk),       & 
    143          &      xnanopo4(jpi,jpj,jpk), xdiatpo4(jpi,jpj,jpk),       & 
    144          &      xlimphy (jpi,jpj,jpk), xlimdia (jpi,jpj,jpk),       & 
    145          &      xlimnfe (jpi,jpj,jpk), xlimdfe (jpi,jpj,jpk),       & 
    146          &      xlimsi  (jpi,jpj,jpk), concdfe (jpi,jpj,jpk),       & 
    147          &      concnfe (jpi,jpj,jpk),                           STAT=ierr(2) )  
    148          ! 
    149       !*  SMS for the organic matter 
    150       ALLOCATE( xfracal (jpi,jpj,jpk), nitrfac(jpi,jpj,jpk),       & 
    151          &      xlimbac (jpi,jpj,jpk), xdiss  (jpi,jpj,jpk),       &  
    152          &      xlimbacl(jpi,jpj,jpk), prodcal(jpi,jpj,jpk),     STAT=ierr(3) ) 
    153  
    154       !* Variable for chemistry of the CO2 cycle 
    155       ALLOCATE( akb3(jpi,jpj,jpk)    , ak13  (jpi,jpj,jpk) ,       & 
    156          &      ak23(jpi,jpj,jpk)    , aksp  (jpi,jpj,jpk) ,       & 
    157          &      akw3(jpi,jpj,jpk)    , borat (jpi,jpj,jpk) ,       & 
    158          &      hi  (jpi,jpj,jpk)    , excess(jpi,jpj,jpk) ,       & 
    159          &      aphscale(jpi,jpj,jpk),                           STAT=ierr(4) ) 
    160          ! 
    161       !* Temperature dependancy of SMS terms 
    162       ALLOCATE( tgfunc(jpi,jpj,jpk)  , tgfunc2(jpi,jpj,jpk) ,    STAT=ierr(5) ) 
    163          ! 
    164 #endif 
     148      ALLOCATE( etot(jpi,jpj,jpk), neln(jpi,jpj), heup(jpi,jpj),    & 
     149        &       heup_01(jpi,jpj) , xksi(jpi,jpj)               ,  STAT=ierr(1) ) 
     150      ! 
     151   
     152      IF( ln_p4z .OR. ln_p5z ) THEN 
     153         !*  Biological fluxes for light  
     154         ALLOCATE(  enano(jpi,jpj,jpk)    , ediat(jpi,jpj,jpk) ,   & 
     155           &        etot_ndcy(jpi,jpj,jpk), emoy(jpi,jpj,jpk)  ,  STAT=ierr(2) )  
     156 
     157         !*  Biological fluxes for primary production 
     158         ALLOCATE( xksimax(jpi,jpj)  , biron(jpi,jpj,jpk)      ,  STAT=ierr(3) ) 
     159         ! 
     160         !*  SMS for the organic matter 
     161         ALLOCATE( xfracal (jpi,jpj,jpk), nitrfac(jpi,jpj,jpk) ,    & 
     162            &      orem    (jpi,jpj,jpk),                           & 
     163            &      prodcal(jpi,jpj,jpk),  xdiss   (jpi,jpj,jpk),    & 
     164            &      prodpoc(jpi,jpj,jpk) , conspoc(jpi,jpj,jpk) ,    & 
     165            &      prodgoc(jpi,jpj,jpk) , consgoc(jpi,jpj,jpk) ,  STAT=ierr(4) ) 
     166 
     167         !* Variable for chemistry of the CO2 cycle 
     168         ALLOCATE( ak13  (jpi,jpj,jpk) ,                            & 
     169            &      ak23(jpi,jpj,jpk)    , aksp  (jpi,jpj,jpk) ,     & 
     170            &      hi  (jpi,jpj,jpk)    , excess(jpi,jpj,jpk) ,     & 
     171            &      aphscale(jpi,jpj,jpk),                         STAT=ierr(5) ) 
     172         ! 
     173         !* Temperature dependancy of SMS terms 
     174         ALLOCATE( tgfunc(jpi,jpj,jpk)  , tgfunc2(jpi,jpj,jpk),   STAT=ierr(6) ) 
     175         ! 
     176         !* Sinkong speed 
     177         ALLOCATE( wsbio3 (jpi,jpj,jpk) , wsbio4 (jpi,jpj,jpk),     & 
     178            &      wscal(jpi,jpj,jpk)                         ,   STAT=ierr(7) )    
     179         !  
     180         IF( ln_ligand ) THEN 
     181           ALLOCATE( plig(jpi,jpj,jpk)  , wsfep(jpi,jpj,jpk)  ,   STAT=ierr(8) ) 
     182         ENDIF 
     183         ! 
     184      ENDIF 
     185      ! 
     186      IF( ln_p5z ) THEN 
     187         !        
     188         ALLOCATE( epico(jpi,jpj,jpk)                         ,   STAT=ierr(9) )  
     189 
     190         !*  Size of phytoplankton cells 
     191         ALLOCATE( sizen(jpi,jpj,jpk), sizep(jpi,jpj,jpk),         & 
     192           &       sized(jpi,jpj,jpk),                            STAT=ierr(10) ) 
     193      ENDIF 
    165194      ! 
    166195      sms_pisces_alloc = MAXVAL( ierr ) 
    … …  
    170199   END FUNCTION sms_pisces_alloc 
    171200 
    172 #else 
    173    !!----------------------------------------------------------------------    
    174    !!  Empty module :                                     NO PISCES model 
    175    !!---------------------------------------------------------------------- 
    176 #endif 
    177     
    178201   !!======================================================================    
    179202END MODULE sms_pisces     

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcice_pisces.F90

    r5725 r7646  
    55   !!====================================================================== 
    66   !! History :  3.5  ! 2013    (M. Vancoppenolle, O. Aumont, G. Madec), original code 
    7    !! Comment ! probably not properly done when the second particle export 
    8    !! scheme (kriest) is used 
    9    !!---------------------------------------------------------------------- 
    10 #if defined key_pisces || defined key_pisces_reduced 
    11    !!---------------------------------------------------------------------- 
    12    !!   'key_pisces'                                       PISCES bio-model 
    137   !!---------------------------------------------------------------------- 
    148   !! trc_ice_pisces   : PISCES fake sea ice model setting 
    … …  
    1812   USE oce_trc         ! Shared variables between ocean and passive tracers 
    1913   USE trc             ! Passive tracers common variables  
    20    USE phycst          ! Ocean physics parameters 
    2114   USE sms_pisces      ! PISCES Source Minus Sink variables 
    2215   USE in_out_manager 
    … …  
    3730      !!---------------------------------------------------------------------- 
    3831 
    39       IF( lk_p4z ) THEN  ;   CALL p4z_ice_ini   !  PISCES 
    40       ELSE               ;   CALL p2z_ice_ini   !  LOBSTER 
     32      IF( ln_p4z .OR. ln_p5z ) THEN  ;   CALL p4z_ice_ini   !  PISCES 
     33      ELSE                           ;   CALL p2z_ice_ini   !  LOBSTER 
    4134      ENDIF 
    4235 
    … …  
    4538 
    4639   SUBROUTINE p4z_ice_ini 
    47  
    48 #if defined key_pisces  
    4940      !!---------------------------------------------------------------------- 
    5041      !!                   ***  ROUTINE p4z_ice_ini *** 
    … …  
    7566 
    7667                                        !--- Dummy variables 
    77       REAL(wp), DIMENSION(jp_pisces,2) :: zratio  ! effective ice-ocean tracer cc ratio 
    78       REAL(wp), DIMENSION(jp_pisces,4) :: zpisc   ! prescribes concentration  
     68      REAL(wp), DIMENSION(jpmaxtrc,2) :: zratio  ! effective ice-ocean tracer cc ratio 
     69      REAL(wp), DIMENSION(jpmaxtrc,4) :: zpisc   ! prescribes concentration  
    7970      !                                            !  1:global, 2:Arctic, 3:Antarctic, 4:Baltic 
    8071 
    … …  
    10798      zpisc(jppo4,1) =  5.77e-7_wp / po4r  
    10899      zpisc(jppoc,1) =  1.27e-6_wp   
    109 #  if ! defined key_kriest 
    110100      zpisc(jpgoc,1) =  5.23e-8_wp   
    111101      zpisc(jpbfe,1) =  9.84e-13_wp  
    112 #  else 
    113       zpisc(jpnum,1) = 0. ! could not get this value since did not use it 
    114 #  endif 
    115102      zpisc(jpsil,1) =  7.36e-6_wp   
    116103      zpisc(jpdsi,1) =  1.07e-7_wp  
    … …  
    129116      zpisc(jpnh4,1) =  3.22e-7_wp / rno3 
    130117 
     118      ! ln_p5z 
     119      zpisc(jppic,1) =  9.57e-8_wp 
     120      zpisc(jpnpi,1) =  9.57e-8_wp 
     121      zpisc(jpppi,1) =  9.57e-8_wp 
     122      zpisc(jppfe,1) =  1.76e-11_wp 
     123      zpisc(jppch,1) =  1.67e-7_wp 
     124      zpisc(jpnph,1) =  9.57e-8_wp 
     125      zpisc(jppph,1) =  9.57e-8_wp 
     126      zpisc(jpndi,1) =  4.24e-7_wp 
     127      zpisc(jppdi,1) =  4.24e-7_wp 
     128      zpisc(jppon,1) =  9.57e-8_wp 
     129      zpisc(jppop,1) =  9.57e-8_wp 
     130      zpisc(jpdon,1) =  2.04e-5_wp 
     131      zpisc(jpdop,1) =  2.04e-5_wp 
     132      zpisc(jpgon,1) =  5.23e-8_wp 
     133      zpisc(jpgop,1) =  5.23e-8_wp 
     134 
    131135      !--- Arctic specificities (dissolved inorganic & DOM) 
    132136      zpisc(jpdic,2) =  1.98e-3_wp  
    … …  
    137141      zpisc(jppo4,2) =  4.09e-7_wp / po4r  
    138142      zpisc(jppoc,2) =  4.05e-7_wp   
    139 #  if ! defined key_kriest 
    140143      zpisc(jpgoc,2) =  2.84e-8_wp   
    141144      zpisc(jpbfe,2) =  7.03e-13_wp  
    142 #  else 
    143       zpisc(jpnum,2) =  0.00e-00_wp  
    144 #  endif 
    145145      zpisc(jpsil,2) =  6.87e-6_wp   
    146146      zpisc(jpdsi,2) =  1.73e-7_wp  
    … …  
    159159      zpisc(jpnh4,2) =  6.15e-08_wp / rno3  
    160160 
     161      ! ln_p5z 
     162      zpisc(jppic,2) =  5.25e-7_wp 
     163      zpisc(jpnpi,2) =  5.25e-7_wp 
     164      zpisc(jpppi,2) =  5.25e-7_wp 
     165      zpisc(jppfe,2) =  1.75e-11_wp 
     166      zpisc(jppch,2) =  1.46e-07_wp 
     167      zpisc(jpnph,2) =  5.25e-7_wp 
     168      zpisc(jppph,2) =  5.25e-7_wp 
     169      zpisc(jpndi,2) =  7.75e-7_wp 
     170      zpisc(jppdi,2) =  7.75e-7_wp 
     171      zpisc(jppon,2) =  4.05e-7_wp 
     172      zpisc(jppop,2) =  4.05e-7_wp 
     173      zpisc(jpdon,2) =  6.00e-6_wp 
     174      zpisc(jpdop,2) =  6.00e-6_wp 
     175      zpisc(jpgon,2) =  2.84e-8_wp 
     176      zpisc(jpgop,2) =  2.84e-8_wp 
     177 
    161178      !--- Antarctic specificities (dissolved inorganic & DOM) 
    162179      zpisc(jpdic,3) =  2.20e-3_wp   
    … …  
    167184      zpisc(jppo4,3) =  1.88e-6_wp / po4r   
    168185      zpisc(jppoc,3) =  1.13e-6_wp   
    169 #  if ! defined key_kriest 
    170186      zpisc(jpgoc,3) =  2.89e-8_wp   
    171187      zpisc(jpbfe,3) =  5.63e-13_wp  
    172 #  else 
    173       zpisc(jpnum,3) =  0.00e-00_wp  
    174 #  endif 
    175188      zpisc(jpsil,3) =  4.96e-5_wp   
    176189      zpisc(jpdsi,3) =  5.63e-7_wp  
    … …  
    189202      zpisc(jpnh4,3) =  3.39e-7_wp / rno3   
    190203 
     204      ! ln_p5z 
     205      zpisc(jppic,3) =  8.10e-7_wp 
     206      zpisc(jpnpi,3) =  8.10e-7_wp 
     207      zpisc(jpppi,3) =  8.10e-7_wp  
     208      zpisc(jppfe,3) =  1.48e-11_wp 
     209      zpisc(jppch,3) =  2.02e-7_wp 
     210      zpisc(jpnph,3) =  9.57e-8_wp 
     211      zpisc(jppph,3) =  9.57e-8_wp 
     212      zpisc(jpndi,3) =  5.77e-7_wp 
     213      zpisc(jppdi,3) =  5.77e-7_wp 
     214      zpisc(jppon,3) =  1.13e-6_wp 
     215      zpisc(jppop,3) =  1.13e-6_wp 
     216      zpisc(jpdon,3) =  7.02e-6_wp 
     217      zpisc(jpdop,3) =  7.02e-6_wp 
     218      zpisc(jpgon,3) =  2.89e-8_wp 
     219      zpisc(jpgop,3) =  2.89e-8_wp 
     220 
     221 
    191222      !--- Baltic Sea particular case for ORCA configurations 
    192223      zpisc(jpdic,4) = 1.14e-3_wp 
    … …  
    197228      zpisc(jppo4,4) = 2.85e-9_wp / po4r 
    198229      zpisc(jppoc,4) = 4.84e-7_wp 
    199 #  if ! defined key_kriest 
    200230      zpisc(jpgoc,4) = 1.05e-8_wp 
    201231      zpisc(jpbfe,4) = 4.97e-13_wp 
    202 #  else 
    203       zpisc(jpnum,4) = 0. ! could not get this value 
    204 #  endif 
    205232      zpisc(jpsil,4) = 4.91e-5_wp 
    206233      zpisc(jpdsi,4) = 3.25e-7_wp 
    … …  
    218245      zpisc(jpno3,4) = 5.36e-5_wp / rno3 
    219246      zpisc(jpnh4,4) = 7.18e-7_wp / rno3 
     247 
     248      ! ln_p5z 
     249      zpisc(jppic,4) =  6.64e-7_wp 
     250      zpisc(jpnpi,4) =  6.64e-7_wp 
     251      zpisc(jpppi,4) =  6.64e-7_wp 
     252      zpisc(jppfe,4) =  3.89e-11_wp 
     253      zpisc(jppch,4) =  1.17e-7_wp 
     254      zpisc(jpnph,4) =  6.64e-7_wp 
     255      zpisc(jppph,4) =  6.64e-7_wp 
     256      zpisc(jpndi,4) =  3.41e-7_wp 
     257      zpisc(jppdi,4) =  3.41e-7_wp 
     258      zpisc(jppon,4) =  4.84e-7_wp 
     259      zpisc(jppop,4) =  4.84e-7_wp 
     260      zpisc(jpdon,4) =  1.06e-5_wp 
     261      zpisc(jpdop,4) =  1.06e-5_wp 
     262      zpisc(jpgon,4) =  1.05e-8_wp 
     263      zpisc(jpgop,4) =  1.05e-8_wp 
    220264  
    221265      DO jn = jp_pcs0, jp_pcs1 
    … …  
    225269            WHERE( gphit(:,:) <  0._wp ) ; trc_o(:,:,jn) = zpisc(jn,3) ; END WHERE ! Antarctic  
    226270         ENDIF 
    227          IF( cp_cfg == "orca" ) THEN     !  Baltic Sea particular case for ORCA configurations 
     271         IF( cn_cfg == "orca" ) THEN     !  Baltic Sea particular case for ORCA configurations 
    228272             WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.    & 
    229273                    54._wp <= gphit(:,:) .AND. gphit(:,:) <= 66._wp ) 
    … …  
    264308        
    265309         !-- Baltic 
    266          IF( cp_cfg == "orca" ) THEN  ! Baltic treated seperately for ORCA configs 
     310         IF( cn_cfg == "orca" ) THEN  ! Baltic treated seperately for ORCA configs 
    267311            IF ( trc_ice_ratio(jn) >= - 1._wp ) THEN ! no prescribed conc. ; typically everything but iron)  
    268312               WHERE( 14._wp <= glamt(:,:) .AND. glamt(:,:) <= 32._wp .AND.    & 
    … …  
    279323      ! 
    280324      END DO ! jn 
    281 #endif 
    282  
     325      ! 
    283326   END SUBROUTINE p4z_ice_ini 
    284327 
    285328   SUBROUTINE p2z_ice_ini 
    286 #if defined key_pisces_reduced  
    287329      !!---------------------------------------------------------------------- 
    288330      !!                   ***  ROUTINE p2z_ice_ini *** 
    … …  
    290332      !! ** Purpose :   Initialisation of the LOBSTER biochemical model 
    291333      !!---------------------------------------------------------------------- 
    292 #endif 
    293334   END SUBROUTINE p2z_ice_ini 
    294335 
    295  
    296 #else 
    297    !!---------------------------------------------------------------------- 
    298    !!   Dummy module                            No PISCES biochemical model 
    299    !!---------------------------------------------------------------------- 
    300 CONTAINS 
    301    SUBROUTINE trc_ice_ini_pisces         ! Empty routine 
    302    END SUBROUTINE trc_ice_ini_pisces 
    303 #endif 
    304336 
    305337   !!====================================================================== 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90

    r6325 r7646  
    1111   !!             3.5  !  2012-05  (C. Ethe) Merge PISCES-LOBSTER 
    1212   !!---------------------------------------------------------------------- 
    13 #if defined key_pisces || defined key_pisces_reduced 
    14    !!---------------------------------------------------------------------- 
    15    !!   'key_pisces'                                       PISCES bio-model 
    16    !!---------------------------------------------------------------------- 
    1713   !! trc_ini_pisces   : PISCES biochemical model initialisation 
    1814   !!---------------------------------------------------------------------- 
    19    USE par_trc         ! TOP parameters 
     15   USE par_trc         !  TOP parameters 
    2016   USE oce_trc         !  shared variables between ocean and passive tracers 
    2117   USE trc             !  passive tracers common variables  
     18   USE trcnam_pisces   !  PISCES namelist 
    2219   USE sms_pisces      !  PISCES Source Minus Sink variables 
    2320 
    … …  
    4138      !!---------------------------------------------------------------------- 
    4239 
    43       IF( lk_p4z ) THEN  ;   CALL p4z_ini   !  PISCES 
    44       ELSE               ;   CALL p2z_ini   !  LOBSTER 
     40      ! 
     41      CALL trc_nam_pisces 
     42      ! 
     43      IF( ln_p4z .OR. ln_p5z ) THEN  ;   CALL p4z_ini   !  PISCES 
     44      ELSE                           ;   CALL p2z_ini   !  LOBSTER 
    4545      ENDIF 
    4646 
    … …  
    5353      !! ** Purpose :   Initialisation of the PISCES biochemical model 
    5454      !!---------------------------------------------------------------------- 
    55 #if defined key_pisces  
    5655      ! 
    5756      USE p4zsms          ! Main P4Z routine 
    … …  
    7069      USE p4zlys          !  Calcite saturation 
    7170      USE p4zsed          !  Sedimentation & burial 
     71      USE p4zpoc          !  Remineralization of organic particles 
     72      USE p4zligand       !  Remineralization of organic ligands 
     73      USE p5zlim          !  Co-limitations of differents nutrients 
     74      USE p5zprod         !  Growth rate of the 2 phyto groups 
     75      USE p5zmicro        !  Sources and sinks of microzooplankton 
     76      USE p5zmeso         !  Sources and sinks of mesozooplankton 
     77      USE p5zmort         !  Mortality terms for phytoplankton 
     78 
    7279      ! 
    7380      REAL(wp), SAVE :: sco2   =  2.312e-3_wp 
    … …  
    7986      REAL(wp), SAVE :: no3    =  30.9e-6_wp * 7.625_wp 
    8087      ! 
    81       INTEGER  ::  ji, jj, jk, ierr 
     88      INTEGER  ::  ji, jj, jk, jn, ierr 
    8289      REAL(wp) ::  zcaralk, zbicarb, zco3 
    8390      REAL(wp) ::  ztmas, ztmas1 
    84       !!---------------------------------------------------------------------- 
    85  
    86       IF(lwp) WRITE(numout,*) 
    87       IF(lwp) WRITE(numout,*) ' p4z_ini :   PISCES biochemical model initialisation' 
    88       IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
    89  
    90                                                  ! Allocate PISCES arrays 
     91      CHARACTER(len = 20)  ::  cltra 
     92 
     93      !!---------------------------------------------------------------------- 
     94 
     95      IF(lwp) THEN 
     96         WRITE(numout,*) 
     97         IF( ln_p4z ) THEN  
     98            WRITE(numout,*) ' p4z_ini :   PISCES biochemical model initialisation' 
     99         ELSE 
     100            WRITE(numout,*) ' p5z_ini :   PISCES biochemical model initialisation' 
     101            WRITE(numout,*) '             With variable stoichiometry' 
     102         ENDIF 
     103         WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
     104      ENDIF 
     105      ! 
     106      ! Allocate PISCES arrays 
    91107      ierr =         sms_pisces_alloc()           
    92108      ierr = ierr +  p4z_che_alloc() 
    93109      ierr = ierr +  p4z_sink_alloc() 
    94110      ierr = ierr +  p4z_opt_alloc() 
    95       ierr = ierr +  p4z_prod_alloc() 
    96       ierr = ierr +  p4z_rem_alloc() 
    97111      ierr = ierr +  p4z_flx_alloc() 
    98112      ierr = ierr +  p4z_sed_alloc() 
     113      ierr = ierr +  p4z_rem_alloc() 
     114      IF( ln_p4z ) THEN 
     115         ierr = ierr +  p4z_lim_alloc() 
     116         ierr = ierr +  p4z_prod_alloc() 
     117      ELSE 
     118         ierr = ierr +  p5z_lim_alloc() 
     119         ierr = ierr +  p5z_prod_alloc() 
     120      ENDIF 
    99121      ! 
    100122      IF( lk_mpp    )   CALL mpp_sum( ierr ) 
    … …  
    104126      r1_ryyss = 1. / ryyss 
    105127      ! 
     128 
     129      ! assign an index in trc arrays for each prognostic variables 
     130      DO jn = 1, jptra 
     131        cltra = ctrcnm(jn)  
     132        IF( cltra == 'DIC'      )   jpdic = jn      !: dissolved inoganic carbon concentration  
     133        IF( cltra == 'Alkalini' )   jptal = jn      !: total alkalinity  
     134        IF( cltra == 'O2'       )   jpoxy = jn      !: oxygen carbon concentration  
     135        IF( cltra == 'CaCO3'    )   jpcal = jn      !: calcite  concentration  
     136        IF( cltra == 'PO4'      )   jppo4 = jn      !: phosphate concentration  
     137        IF( cltra == 'POC'      )   jppoc = jn      !: small particulate organic phosphate concentration 
     138        IF( cltra == 'Si'       )   jpsil = jn      !: silicate concentration 
     139        IF( cltra == 'PHY'      )   jpphy = jn      !: phytoplancton concentration  
     140        IF( cltra == 'ZOO'      )   jpzoo = jn      !: zooplancton concentration 
     141        IF( cltra == 'DOC'      )   jpdoc = jn      !: dissolved organic carbon concentration  
     142        IF( cltra == 'PHY2'     )   jpdia = jn      !: Diatoms Concentration 
     143        IF( cltra == 'ZOO2'     )   jpmes = jn      !: Mesozooplankton Concentration 
     144        IF( cltra == 'DSi'      )   jpdsi = jn      !: Diatoms Silicate Concentration 
     145        IF( cltra == 'Fer'      )   jpfer = jn      !: Iron Concentration 
     146        IF( cltra == 'BFe'      )   jpbfe = jn      !: Big iron particles Concentration 
     147        IF( cltra == 'GOC'      )   jpgoc = jn      !: Big particulate organic phosphate concentration 
     148        IF( cltra == 'SFe'      )   jpsfe = jn      !: Small iron particles Concentration 
     149        IF( cltra == 'DFe'      )   jpdfe = jn      !: Diatoms iron Concentration 
     150        IF( cltra == 'GSi'      )   jpgsi = jn      !: (big) Silicate Concentration 
     151        IF( cltra == 'NFe'      )   jpnfe = jn      !: Nano iron Concentration 
     152        IF( cltra == 'NCHL'     )   jpnch = jn      !: Nano Chlorophyll Concentration 
     153        IF( cltra == 'DCHL'     )   jpdch = jn      !: Diatoms Chlorophyll Concentration 
     154        IF( cltra == 'NO3'      )   jpno3 = jn      !: Nitrates Concentration 
     155        IF( cltra == 'NH4'      )   jpnh4 = jn      !: Ammonium Concentration 
     156        IF( cltra == 'DON'      )   jpdon = jn      !: Dissolved organic N Concentration 
     157        IF( cltra == 'DOP'      )   jpdop = jn      !: Dissolved organic P Concentration 
     158        IF( cltra == 'PON'      )   jppon = jn      !: Small Nitrogen particle Concentration 
     159        IF( cltra == 'POP'      )   jppop = jn      !: Small Phosphorus particle Concentration 
     160        IF( cltra == 'GON'      )   jpgon = jn      !: Big Nitrogen particles Concentration 
     161        IF( cltra == 'GOP'      )   jpgop = jn      !: Big Phosphorus Concentration 
     162        IF( cltra == 'PHYN'     )   jpnph = jn      !: Nanophytoplankton N biomass 
     163        IF( cltra == 'PHYP'     )   jppph = jn      !: Nanophytoplankton P biomass 
     164        IF( cltra == 'DIAN'     )   jpndi = jn      !: Diatoms N biomass 
     165        IF( cltra == 'DIAP'     )   jppdi = jn      !: Diatoms P biomass 
     166        IF( cltra == 'PIC'      )   jppic = jn      !: Picophytoplankton C biomass 
     167        IF( cltra == 'PICN'     )   jpnpi = jn      !: Picophytoplankton N biomass 
     168        IF( cltra == 'PICP'     )   jpppi = jn      !: Picophytoplankton P biomass 
     169        IF( cltra == 'PFe'      )   jppfe = jn      !: Picophytoplankton Fe biomass 
     170        IF( cltra == 'LGW'      )   jplgw = jn      !: Weak ligands 
     171        IF( cltra == 'LFe'      )   jpfep = jn      !: Fe nanoparticle 
     172      ENDDO 
    106173 
    107174      CALL p4z_sms_init       !  Maint routine 
    … …  
    116183      rdenit  =  ( ( o2ut + o2nit ) * 0.80 - rno3 - rno3 * 0.60 ) / rno3 
    117184      rdenita =   3._wp /  5._wp 
    118  
     185      IF( ln_p5z ) THEN 
     186         no3rat3 = no3rat3 / rno3 
     187         po4rat3 = po4rat3 / po4r 
     188      ENDIF 
    119189 
    120190      ! Initialization of tracer concentration in case of  no restart  
    121191      !-------------------------------------------------------------- 
    122       IF( .NOT. ln_rsttr ) THEN   
    123           
     192      IF( .NOT.ln_rsttr ) THEN   
    124193         trn(:,:,:,jpdic) = sco2 
    125194         trn(:,:,:,jpdoc) = bioma0 
    … …  
    129198         trn(:,:,:,jppo4) = po4 / po4r 
    130199         trn(:,:,:,jppoc) = bioma0 
    131 #  if ! defined key_kriest 
    132200         trn(:,:,:,jpgoc) = bioma0 
    133201         trn(:,:,:,jpbfe) = bioma0 * 5.e-6 
    134 #  else 
    135          trn(:,:,:,jpnum) = bioma0 / ( 6. * xkr_massp ) 
    136 #  endif 
    137202         trn(:,:,:,jpsil) = silic1 
    138203         trn(:,:,:,jpdsi) = bioma0 * 0.15 
    … …  
    150215         trn(:,:,:,jpno3) = no3 
    151216         trn(:,:,:,jpnh4) = bioma0 
    152  
     217         IF( ln_ligand) THEN 
     218            trn(:,:,:,jplgw) = 0.6E-9 
     219            trn(:,:,:,jpfep) = 0. * 5.e-6 
     220         ENDIF 
     221         IF( ln_p5z ) THEN 
     222            trn(:,:,:,jpdon) = bioma0 
     223            trn(:,:,:,jpdop) = bioma0 
     224            trn(:,:,:,jppon) = bioma0 
     225            trn(:,:,:,jppop) = bioma0 
     226            trn(:,:,:,jpgon) = bioma0 
     227            trn(:,:,:,jpgop) = bioma0 
     228            trn(:,:,:,jpnph) = bioma0 
     229            trn(:,:,:,jppph) = bioma0 
     230            trn(:,:,:,jppic) = bioma0 
     231            trn(:,:,:,jpnpi) = bioma0 
     232            trn(:,:,:,jpppi) = bioma0 
     233            trn(:,:,:,jpndi) = bioma0 
     234            trn(:,:,:,jppdi) = bioma0 
     235            trn(:,:,:,jppfe) = bioma0 * 5.e-6 
     236            trn(:,:,:,jppch) = bioma0 * 12. / 55. 
     237         ENDIF 
    153238         ! initialize the half saturation constant for silicate 
    154239         ! ---------------------------------------------------- 
    … …  
    158243 
    159244 
    160       CALL p4z_sink_init      !  vertical flux of particulate organic matter 
    161       CALL p4z_opt_init       !  Optic: PAR in the water column 
    162       CALL p4z_lim_init       !  co-limitations by the various nutrients 
    163       CALL p4z_prod_init      !  phytoplankton growth rate over the global ocean. 
    164       CALL p4z_sbc_init       !  boundary conditions 
    165       CALL p4z_fechem_init    !  Iron chemistry 
    166       CALL p4z_rem_init       !  remineralisation 
    167       CALL p4z_mort_init      !  phytoplankton mortality  
    168       CALL p4z_micro_init     !  microzooplankton 
    169       CALL p4z_meso_init      !  mesozooplankton 
    170       CALL p4z_lys_init       !  calcite saturation 
    171       CALL p4z_flx_init       !  gas exchange  
     245      CALL p4z_sink_init         !  vertical flux of particulate organic matter 
     246      CALL p4z_opt_init          !  Optic: PAR in the water column 
     247      IF( ln_p4z ) THEN 
     248         CALL p4z_lim_init       !  co-limitations by the various nutrients 
     249         CALL p4z_prod_init      !  phytoplankton growth rate over the global ocean. 
     250      ELSE 
     251         CALL p5z_lim_init       !  co-limitations by the various nutrients 
     252         CALL p5z_prod_init      !  phytoplankton growth rate over the global ocean. 
     253      ENDIF 
     254      CALL p4z_sbc_init          !  boundary conditions 
     255      CALL p4z_fechem_init       !  Iron chemistry 
     256      CALL p4z_rem_init          !  remineralisation 
     257      CALL p4z_poc_init          !  remineralisation of organic particles 
     258      IF( ln_ligand ) & 
     259         & CALL p4z_ligand_init  !  remineralisation of organic ligands 
     260 
     261      IF( ln_p4z ) THEN 
     262         CALL p4z_mort_init      !  phytoplankton mortality  
     263         CALL p4z_micro_init     !  microzooplankton 
     264         CALL p4z_meso_init      !  mesozooplankton 
     265      ELSE 
     266         CALL p5z_mort_init      !  phytoplankton mortality  
     267         CALL p5z_micro_init     !  microzooplankton 
     268         CALL p5z_meso_init      !  mesozooplankton 
     269      ENDIF 
     270      CALL p4z_lys_init          !  calcite saturation 
     271      IF( .NOT.l_co2cpl ) & 
     272        & CALL p4z_flx_init      !  gas exchange  
    172273 
    173274      ndayflxtr = 0 
    … …  
    176277      IF(lwp) WRITE(numout,*) 'Initialization of PISCES tracers done' 
    177278      IF(lwp) WRITE(numout,*)  
    178 #endif 
    179279      ! 
    180280   END SUBROUTINE p4z_ini 
    … …  
    186286      !! ** Purpose :   Initialisation of the LOBSTER biochemical model 
    187287      !!---------------------------------------------------------------------- 
    188 #if defined key_pisces_reduced  
    189288      ! 
    190289      USE p2zopt 
    … …  
    193292      USE p2zsed 
    194293      ! 
    195       INTEGER  ::  ji, jj, jk, ierr 
     294      INTEGER  ::  ji, jj, jk, jn, ierr 
     295      CHARACTER(len = 10)  ::  cltra 
    196296      !!---------------------------------------------------------------------- 
    197297 
    … …  
    205305      IF( lk_mpp    )   CALL mpp_sum( ierr ) 
    206306      IF( ierr /= 0 )   CALL ctl_stop( 'STOP', 'p2z_ini: unable to allocate LOBSTER arrays' ) 
     307 
     308      DO jn = 1, jptra 
     309        cltra = ctrcnm(jn)  
     310        IF( cltra == 'DET' )   jpdet = jn       !: detritus                    [mmoleN/m3] 
     311        IF( cltra == 'ZOO' )   jpzoo = jn       !: zooplancton concentration   [mmoleN/m3] 
     312        IF( cltra == 'PHY' )   jpphy = jn       !: phytoplancton concentration [mmoleN/m3] 
     313        IF( cltra == 'NO3' )   jpno3 = jn       !: nitrate concentration       [mmoleN/m3] 
     314        IF( cltra == 'NH4' )   jpnh4 = jn       !: ammonium concentration      [mmoleN/m3] 
     315        IF( cltra == 'DOM' )   jpdom = jn       !: dissolved organic matter    [mmoleN/m3] 
     316      ENDDO 
     317 
     318      jpkb = 10        !  last level where depth less than 200 m 
     319      DO jk = jpkm1, 1, -1 
     320         IF( gdept_1d(jk) > 200. ) jpkb = jk  
     321      END DO 
     322      IF (lwp) WRITE(numout,*) 
     323      IF (lwp) WRITE(numout,*) ' first vertical layers where biology is active (200m depth ) ', jpkb 
     324      IF (lwp) WRITE(numout,*) 
     325      jpkbm1 = jpkb - 1 
     326      ! 
     327 
    207328 
    208329      ! LOBSTER initialisation for GYRE : init NO3=f(density) by asklod AS Kremeur 2005-07 
    … …  
    214335         trn(:,:,:,jpphy) = 0.1 * tmask(:,:,:) 
    215336         trn(:,:,:,jpdom) = 1.0 * tmask(:,:,:) 
    216          WHERE( rhd(:,:,:) <= 24.5e-3 )  ;  trn(:,:,:,jpno3 ) = 2._wp * tmask(:,:,:) 
     337         WHERE( rhd(:,:,:) <= 24.5e-3 )  ;  trn(:,:,:,jpno3) = 2._wp * tmask(:,:,:) 
    217338         ELSE WHERE                      ;  trn(:,:,:,jpno3) = ( 15.55 * ( rhd(:,:,:) * 1000. ) - 380.11 ) * tmask(:,:,:) 
    218339         END WHERE                        
    … …  
    227348      IF(lwp) WRITE(numout,*) 'Initialization of LOBSTER tracers done' 
    228349      IF(lwp) WRITE(numout,*)  
    229 #endif 
    230350      ! 
    231351   END SUBROUTINE p2z_ini 
    232 #else 
    233    !!---------------------------------------------------------------------- 
    234    !!   Dummy module                            No PISCES biochemical model 
    235    !!---------------------------------------------------------------------- 
    236 CONTAINS 
    237    SUBROUTINE trc_ini_pisces             ! Empty routine 
    238    END SUBROUTINE trc_ini_pisces 
    239 #endif 
    240352 
    241353   !!====================================================================== 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcnam_pisces.F90

    r4990 r7646  
    88   !!             1.0  !  2003-08 (C. Ethe)  module F90 
    99   !!             2.0  !  2007-12  (C. Ethe, G. Madec) from trcnam.pisces.h90 
    10    !!---------------------------------------------------------------------- 
    11 #if defined key_pisces || defined key_pisces_reduced 
    12    !!---------------------------------------------------------------------- 
    13    !!   'key_pisces'   :                                   PISCES bio-model 
    1410   !!---------------------------------------------------------------------- 
    1511   !! trc_nam_pisces       : PISCES model namelist read 
    … …  
    4541      !! ** input   :   file 'namelist.trc.sms' containing the following 
    4642      !!             namelist: natext, natbio, natsms 
    47       !!                       natkriest ("key_kriest") 
    4843      !!---------------------------------------------------------------------- 
    4944      !! 
    5045      INTEGER :: jl, jn 
    51       INTEGER :: ios                 ! Local integer output status for namelist read 
    52       TYPE(DIAG), DIMENSION(jp_pisces_2d)  :: pisdia2d 
    53       TYPE(DIAG), DIMENSION(jp_pisces_3d)  :: pisdia3d 
    54       TYPE(DIAG), DIMENSION(jp_pisces_trd) :: pisdiabio 
     46      INTEGER :: ios, ioptio                 ! Local integer output status for namelist read 
    5547      CHARACTER(LEN=20)   ::   clname 
    5648      !! 
    57       NAMELIST/nampisdia/ pisdia3d, pisdia2d     ! additional diagnostics 
    58 #if defined key_pisces_reduced 
    59       NAMELIST/nampisdbi/ pisdiabio 
    60 #endif 
    61  
     49      NAMELIST/nampismod/ln_p2z, ln_p4z, ln_p5z, ln_ligand 
    6250      !!---------------------------------------------------------------------- 
    6351 
    6452      IF(lwp) WRITE(numout,*) 
    6553      clname = 'namelist_pisces' 
    66 #if defined key_pisces 
     54 
    6755      IF(lwp) WRITE(numout,*) ' trc_nam_pisces : read PISCES namelist' 
    68 #else 
    69       IF(lwp) WRITE(numout,*) ' trc_nam_pisces : read LOBSTER namelist' 
    70 #endif 
    7156      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
    7257      CALL ctl_opn( numnatp_ref, TRIM( clname )//'_ref', 'OLD'    , 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
    … …  
    7459      IF(lwm) CALL ctl_opn( numonp     , 'output.namelist.pis' , 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
    7560      ! 
    76       IF( .NOT.lk_iomput .AND. ln_diatrc ) THEN 
    77          ! 
    78          ! Namelist nampisdia 
    79          ! ------------------- 
    80          REWIND( numnatp_ref )              ! Namelist nampisdia in reference namelist : Pisces diagnostics 
    81          READ  ( numnatp_ref, nampisdia, IOSTAT = ios, ERR = 901) 
    82 901      IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisdia in reference namelist', lwp ) 
    8361 
    84          REWIND( numnatp_cfg )              ! Namelist nampisdia in configuration namelist : Pisces diagnostics 
    85          READ  ( numnatp_cfg, nampisdia, IOSTAT = ios, ERR = 902 ) 
    86 902      IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisdia in configuration namelist', lwp ) 
    87          IF(lwm) WRITE ( numonp, nampisdia ) 
     62      REWIND( numnatp_ref )              ! Namelist nampisbio in reference namelist : Pisces variables 
     63      READ  ( numnatp_ref, nampismod, IOSTAT = ios, ERR = 901) 
     64901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismod in reference namelist', lwp ) 
    8865 
    89          DO jl = 1, jp_pisces_2d 
    90             jn = jp_pcs0_2d + jl - 1 
    91             ctrc2d(jn) = pisdia2d(jl)%sname 
    92             ctrc2l(jn) = pisdia2d(jl)%lname 
    93             ctrc2u(jn) = pisdia2d(jl)%units 
    94          END DO 
     66      REWIND( numnatp_cfg )              ! Namelist nampisbio in configuration namelist : Pisces variables 
     67      READ  ( numnatp_cfg, nampismod, IOSTAT = ios, ERR = 902 ) 
     68902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampismod in configuration namelist', lwp ) 
     69      IF(lwm) WRITE ( numonp, nampismod ) 
    9570 
    96          DO jl = 1, jp_pisces_3d 
    97             jn = jp_pcs0_3d + jl - 1 
    98             ctrc3d(jn) = pisdia3d(jl)%sname 
    99             ctrc3l(jn) = pisdia3d(jl)%lname 
    100             ctrc3u(jn) = pisdia3d(jl)%units 
    101          END DO 
    102  
    103          IF(lwp) THEN                   ! control print 
    104             WRITE(numout,*) 
    105             WRITE(numout,*) ' Namelist : natadd' 
    106             DO jl = 1, jp_pisces_3d 
    107                jn = jp_pcs0_3d + jl - 1 
    108                WRITE(numout,*) '  3d diag nb : ', jn, '    short name : ', ctrc3d(jn), & 
    109                  &             '  long name  : ', ctrc3l(jn), '   unit : ', ctrc3u(jn) 
    110             END DO 
    111             WRITE(numout,*) ' ' 
    112  
    113             DO jl = 1, jp_pisces_2d 
    114                jn = jp_pcs0_2d + jl - 1 
    115                WRITE(numout,*) '  2d diag nb : ', jn, '    short name : ', ctrc2d(jn), & 
    116                  &             '  long name  : ', ctrc2l(jn), '   unit : ', ctrc2u(jn) 
    117             END DO 
    118             WRITE(numout,*) ' ' 
    119          ENDIF 
    120          ! 
     71     IF(lwp) THEN                  ! control print 
     72         WRITE(numout,*) ' ' 
     73         WRITE(numout,*) ' Flag to use LOBSTER model            ln_p2z    = ', ln_p2z 
     74         WRITE(numout,*) ' Flag to use PISCES standard  model   ln_p4z    = ', ln_p4z 
     75         WRITE(numout,*) ' Flag to use PISCES quota     model   ln_p5z    = ', ln_p5z 
     76         WRITE(numout,*) ' Flag to ligand                       ln_ligand = ', ln_ligand 
     77         WRITE(numout,*) ' ' 
    12178      ENDIF 
    12279 
    123 #if defined key_pisces_reduced 
    124  
    125       IF( ( .NOT.lk_iomput .AND. ln_diabio ) .OR. lk_trdmxl_trc ) THEN 
    126          ! 
    127          ! Namelist nampisdbi 
    128          ! ------------------- 
    129          REWIND( numnatp_ref )              ! Namelist nampisdbi in reference namelist : Pisces add. diagnostics 
    130          READ  ( numnatp_ref, nampisdbi, IOSTAT = ios, ERR = 903) 
    131 903      IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisdbi in reference namelist', lwp ) 
    132  
    133          REWIND( numnatp_cfg )              ! Namelist nampisdbi in configuration namelist : Pisces add. diagnostics 
    134          READ  ( numnatp_cfg, nampisdbi, IOSTAT = ios, ERR = 904 ) 
    135 904      IF( ios /= 0 ) CALL ctl_nam ( ios , 'nampisdbi in configuration namelist', lwp ) 
    136          IF(lwm) WRITE ( numonp, nampisdbi ) 
    137  
    138          DO jl = 1, jp_pisces_trd 
    139             jn = jp_pcs0_trd + jl - 1 
    140             ctrbio(jl) = pisdiabio(jl)%sname 
    141             ctrbil(jl) = pisdiabio(jl)%lname 
    142             ctrbiu(jl) = pisdiabio(jl)%units 
    143          END DO 
    144  
    145          IF(lwp) THEN                   ! control print 
    146             WRITE(numout,*) 
    147             WRITE(numout,*) ' Namelist : nampisdbi' 
    148             DO jl = 1, jp_pisces_trd 
    149                jn = jp_pcs0_trd + jl - 1 
    150                WRITE(numout,*) '  biological trend No : ', jn, '    short name : ', ctrbio(jn), & 
    151                  &             '  long name  : ', ctrbio(jn), '   unit : ', ctrbio(jn) 
    152             END DO 
    153             WRITE(numout,*) ' ' 
    154          END IF 
    155          ! 
    156       END IF 
    157  
    158 #endif 
    159  
     80      IF(lwp) THEN                         ! control print 
     81         WRITE(numout,*) ' ' 
     82         IF( ln_p5z    )  WRITE(numout,*) '  PISCES QUOTA model is used' 
     83         IF( ln_p4z    )  WRITE(numout,*) '  PISCES STANDARD model is used' 
     84         IF( ln_p2z    )  WRITE(numout,*) '  LOBSTER model is used' 
     85         IF( ln_ligand )  WRITE(numout,*) '  Compute remineralization/dissolution of organic ligands' 
     86         WRITE(numout,*) ' ' 
     87      ENDIF 
     88     
     89      ioptio = 0 
     90      IF( ln_p2z )    ioptio = ioptio + 1 
     91      IF( ln_p4z )    ioptio = ioptio + 1 
     92      IF( ln_p5z )    ioptio = ioptio + 1 
     93      ! 
     94      IF( ioptio /= 1 )   CALL ctl_stop( 'Choose ONE PISCES model namelist nampismod' ) 
     95       ! 
    16096   END SUBROUTINE trc_nam_pisces 
    161  
    162 #else 
    163    !!---------------------------------------------------------------------- 
    164    !!  Dummy module :                                   No PISCES bio-model 
    165    !!---------------------------------------------------------------------- 
    166 CONTAINS 
    167    SUBROUTINE trc_nam_pisces                      ! Empty routine 
    168    END  SUBROUTINE  trc_nam_pisces 
    169 #endif   
    17097 
    17198   !!====================================================================== 

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcsms_pisces.F90

    r4147 r7646  
    77   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
    88   !!---------------------------------------------------------------------- 
    9 #if defined key_pisces || defined key_pisces_reduced 
    10    !!---------------------------------------------------------------------- 
    11    !!   'key_pisces'                                       PISCES bio-model 
    12    !!---------------------------------------------------------------------- 
    139   !!   trcsms_pisces        :  Time loop of passive tracers sms 
    1410   !!---------------------------------------------------------------------- 
    1511   USE par_pisces 
     12   USE sms_pisces 
    1613   USE p4zsms 
    1714   USE p2zsms 
    … …  
    4845      !!--------------------------------------------------------------------- 
    4946      ! 
    50       IF( lk_p4z ) THEN  ;   CALL p4z_sms( kt )   !  PISCES 
    51       ELSE               ;   CALL p2z_sms( kt )   !  LOBSTER 
     47      IF( ln_p4z .OR. ln_p5z ) THEN  ;   CALL p4z_sms( kt )   !  PISCES 
     48      ELSE                           ;   CALL p2z_sms( kt )   !  LOBSTER 
    5249      ENDIF 
    5350 
    … …  
    5552   END SUBROUTINE trc_sms_pisces 
    5653 
    57 #else 
    58    !!====================================================================== 
    59    !!  Dummy module :                                   No PISCES bio-model 
    60    !!====================================================================== 
    61 CONTAINS 
    62    SUBROUTINE trc_sms_pisces( kt )                   ! Empty routine 
    63       INTEGER, INTENT( in ) ::   kt 
    64       WRITE(*,*) 'trc_sms_pisces: You should not have seen this print! error?', kt 
    65    END SUBROUTINE trc_sms_pisces 
    66 #endif  
    67  
    6854   !!====================================================================== 
    6955END MODULE trcsms_pisces  

  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/trcwri_pisces.F90

    r6140 r7646  
    66   !! History :   1.0  !  2009-05 (C. Ethe)  Original code 
    77   !!---------------------------------------------------------------------- 
    8 #if defined key_top && defined key_iomput && ( defined key_pisces || defined key_pisces_reduced ) 
    9    !!---------------------------------------------------------------------- 
    10    !!   'key_pisces or key_pisces_reduced'                     PISCES model 
     8#if defined key_top && defined key_iomput  
    119   !!---------------------------------------------------------------------- 
    1210   !! trc_wri_pisces   :  outputs of concentration fields 
    … …  
    4240      ! write the tracer concentrations in the file 
    4341      ! --------------------------------------- 
    44 #if defined key_pisces_reduced 
    45       DO jn = jp_pcs0, jp_pcs1 
    46          cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer 
    47          CALL iom_put( cltra, trn(:,:,:,jn) ) 
    48       END DO 
    49 #else 
    50       DO jn = jp_pcs0, jp_pcs1 
    51          zfact = 1.0e+6  
    52          IF( jn == jpno3 .OR. jn == jpnh4 ) zfact = rno3 * 1.0e+6  
    53          IF( jn == jppo4  )                 zfact = po4r * 1.0e+6 
    54          cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer 
    55          IF( iom_use( cltra ) )  CALL iom_put( cltra, trn(:,:,:,jn) * zfact ) 
    56       END DO 
     42      IF( ln_p2z ) THEN 
     43         DO jn = jp_pcs0, jp_pcs1 
     44            cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer 
     45            CALL iom_put( cltra, trn(:,:,:,jn) ) 
     46         END DO 
     47      ELSE 
     48         DO jn = jp_pcs0, jp_pcs1 
     49            zfact = 1.0e+6  
     50            IF( jn == jpno3 .OR. jn == jpnh4 ) zfact = rno3 * 1.0e+6  
     51            IF( jn == jppo4  )                 zfact = po4r * 1.0e+6 
     52            cltra = TRIM( ctrcnm(jn) )                  ! short title for tracer 
     53            IF( iom_use( cltra ) )  CALL iom_put( cltra, trn(:,:,:,jn) * zfact ) 
     54         END DO 
    5755 
    58       IF( iom_use( "INTDIC" ) ) THEN                     !   DIC content in kg/m2 
    59          zdic(:,:) = 0. 
    60          DO jk = 1, jpkm1 
    61             zdic(:,:) = zdic(:,:) + trn(:,:,jk,jpdic) * e3t_n(:,:,jk) * tmask(:,:,jk) * 12. 
    62          ENDDO 
    63          CALL iom_put( 'INTDIC', zdic )      
    64       ENDIF 
    65       ! 
    66       IF( iom_use( "O2MIN" ) .OR. iom_use ( "ZO2MIN" ) ) THEN  ! Oxygen minimum concentration and depth  
    67          zo2min   (:,:) = trn(:,:,1,jpoxy) * tmask(:,:,1) 
    68          zdepo2min(:,:) = gdepw_n(:,:,1)   * tmask(:,:,1) 
    69          DO jk = 2, jpkm1 
    70             DO jj = 1, jpj 
    71                DO ji = 1, jpi 
    72                   IF( tmask(ji,jj,jk) == 1 ) then 
    73                      IF( trn(ji,jj,jk,jpoxy) < zo2min(ji,jj) ) then 
    74                         zo2min   (ji,jj) = trn(ji,jj,jk,jpoxy) 
    75                         zdepo2min(ji,jj) = gdepw_n(ji,jj,jk) 
     56         IF( iom_use( "INTDIC" ) ) THEN                     !   DIC content in kg/m2 
     57            zdic(:,:) = 0. 
     58            DO jk = 1, jpkm1 
     59               zdic(:,:) = zdic(:,:) + trn(:,:,jk,jpdic) * e3t_n(:,:,jk) * tmask(:,:,jk) * 12. 
     60            ENDDO 
     61            CALL iom_put( 'INTDIC', zdic )      
     62         ENDIF 
     63         ! 
     64         IF( iom_use( "O2MIN" ) .OR. iom_use ( "ZO2MIN" ) ) THEN  ! Oxygen minimum concentration and depth  
     65            zo2min   (:,:) = trn(:,:,1,jpoxy) * tmask(:,:,1) 
     66            zdepo2min(:,:) = gdepw_n(:,:,1)   * tmask(:,:,1) 
     67            DO jk = 2, jpkm1 
     68               DO jj = 1, jpj 
     69                  DO ji = 1, jpi 
     70                     IF( tmask(ji,jj,jk) == 1 ) then 
     71                        IF( trn(ji,jj,jk,jpoxy) < zo2min(ji,jj) ) then 
     72                           zo2min   (ji,jj) = trn(ji,jj,jk,jpoxy) 
     73                           zdepo2min(ji,jj) = gdepw_n(ji,jj,jk) 
     74                        ENDIF 
    7675                     ENDIF 
    77                   ENDIF 
     76                  END DO 
    7877               END DO 
    7978            END DO 
    80          END DO 
    81          ! 
    82          CALL iom_put('O2MIN' , zo2min     )                              ! oxygen minimum concentration 
    83          CALL iom_put('ZO2MIN', zdepo2min  )                              ! depth of oxygen minimum concentration 
    84           ! 
    85       ENDIF 
    86 #endif 
     79            ! 
     80            CALL iom_put('O2MIN' , zo2min     )                              ! oxygen minimum concentration 
     81            CALL iom_put('ZO2MIN', zdepo2min  )                              ! depth of oxygen minimum concentration 
     82             ! 
     83         ENDIF 
     84     ENDIF 
    8785      ! 
    8886   END SUBROUTINE trc_wri_pisces 

  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcadv.F90

    r6140 r7646  
    5757   INTEGER ::              nadv             ! chosen advection scheme 
    5858   ! 
    59    REAL(wp) ::   r2dttrc  ! vertical profile time-step, = 2 rdt 
    60    !                                                    ! except at nitrrc000 (=rdt) if neuler=0 
    61  
    6259   !! * Substitutions 
    6360#  include "vectopt_loop_substitute.h90" 
    … …  
    8784      ! 
    8885      CALL wrk_alloc( jpi,jpj,jpk,   zun, zvn, zwn ) 
    89       ! 
    90       IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN     ! at nittrc000 
    91          r2dttrc =  rdttrc           ! = rdttrc (use or restarting with Euler time stepping) 
    92       ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN          ! at nittrc000 or nittrc000+1 
    93          r2dttrc = 2. * rdttrc       ! = 2 rdttrc (leapfrog) 
    94       ENDIF 
    9586      !                                               !==  effective transport  ==! 
    96       DO jk = 1, jpkm1 
    97          zun(:,:,jk) = e2u  (:,:) * e3u_n(:,:,jk) * un(:,:,jk)                   ! eulerian transport 
    98          zvn(:,:,jk) = e1v  (:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 
    99          zwn(:,:,jk) = e1e2t(:,:)                 * wn(:,:,jk) 
    100       END DO 
    101       ! 
    102       IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN                                 ! add z-tilde and/or vvl corrections 
    103          zun(:,:,:) = zun(:,:,:) + un_td(:,:,:) 
    104          zvn(:,:,:) = zvn(:,:,:) + vn_td(:,:,:) 
    105       ENDIF 
    106       ! 
    107       IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad )   &  
    108          &              CALL ldf_eiv_trp( kt, nittrc000, zun, zvn, zwn, 'TRC' )  ! add the eiv transport 
    109       ! 
    110       IF( ln_mle    )   CALL tra_adv_mle( kt, nittrc000, zun, zvn, zwn, 'TRC' )  ! add the mle transport 
    111       ! 
    112       zun(:,:,jpk) = 0._wp                                                       ! no transport trough the bottom 
    113       zvn(:,:,jpk) = 0._wp 
    114       zwn(:,:,jpk) = 0._wp 
    115       ! 
     87      IF( l_offline ) THEN 
     88         zun(:,:,:) = un(:,:,:)     ! effective transport already in un/vn/wn 
     89         zvn(:,:,:) = vn(:,:,:) 
     90         zwn(:,:,:) = wn(:,:,:) 
     91      ELSE 
     92         !        
     93         DO jk = 1, jpkm1 
     94            zun(:,:,jk) = e2u  (:,:) * e3u_n(:,:,jk) * un(:,:,jk)                   ! eulerian transport 
     95            zvn(:,:,jk) = e1v  (:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 
     96            zwn(:,:,jk) = e1e2t(:,:)                 * wn(:,:,jk) 
     97         END DO 
     98         ! 
     99         IF( ln_vvl_ztilde .OR. ln_vvl_layer ) THEN                                 ! add z-tilde and/or vvl corrections 
     100            zun(:,:,:) = zun(:,:,:) + un_td(:,:,:) 
     101            zvn(:,:,:) = zvn(:,:,:) + vn_td(:,:,:) 
     102         ENDIF 
     103         ! 
     104         IF( ln_ldfeiv .AND. .NOT. ln_traldf_triad )   &  
     105            &              CALL ldf_eiv_trp( kt, nittrc000, zun, zvn, zwn, 'TRC' )  ! add the eiv transport 
     106         ! 
     107         IF( ln_mle    )   CALL tra_adv_mle( kt, nittrc000, zun, zvn, zwn, 'TRC' )  ! add the mle transport 
     108         ! 
     109         zun(:,:,jpk) = 0._wp                                                       ! no transport trough the bottom 
     110         zvn(:,:,jpk) = 0._wp 
     111         zwn(:,:,jpk) = 0._wp 
     112         ! 
     113      ENDIF 
    116114      ! 
    117115      SELECT CASE ( nadv )                      !==  compute advection trend and add it to general trend  ==! 

  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcbbl.F90

    r5836 r7646  
    5454      IF( nn_timing == 1 )  CALL timing_start('trc_bbl') 
    5555      ! 
    56       IF( .NOT. lk_offline .AND. nn_dttrc == 1 ) THEN 
     56      IF( .NOT. l_offline .AND. nn_dttrc == 1 ) THEN 
    5757         CALL bbl( kt, nittrc000, 'TRC' )      ! Online coupling with dynamics  : Computation of bbl coef and bbl transport 
    5858         l_bbl = .FALSE.                       ! Offline coupling with dynamics : Read bbl coef and bbl transport from input files 

  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcdmp.F90

    r6701 r7646  
    202202      IF( trc_dmp_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trc_dmp_ini: unable to allocate arrays' ) 
    203203      ! 
    204       IF( lzoom .AND. .NOT.lk_c1d )   nn_zdmp_tr = 0           ! restoring to climatology at closed north or south boundaries 
    205204      SELECT CASE ( nn_zdmp_tr ) 
    206205      CASE ( 0 )   ;   IF(lwp) WRITE(numout,*) '   tracer damping throughout the water column' 
    … …  
    256255         ! ------------------- 
    257256 
    258          IF( cp_cfg == "orca" ) THEN 
    259             ! 
    260             SELECT CASE ( jp_cfg ) 
     257         IF( cn_cfg == "orca" ) THEN 
     258            ! 
     259            SELECT CASE ( nn_cfg ) 
    261260            !                                           ! ======================= 
    262261            CASE ( 1 )                                  ! eORCA_R1 configuration 

  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcnxt.F90

    r6140 r7646  
    3333   USE trdtra 
    3434   USE tranxt 
     35   USE bdy_oce   , ONLY: ln_bdy 
    3536   USE trcbdy          ! BDY open boundaries 
    36    USE bdy_par, only: lk_bdy 
    3737# if defined key_agrif 
    3838   USE agrif_top_interp 
    … …  
    4343 
    4444   PUBLIC   trc_nxt          ! routine called by step.F90 
    45  
    46    REAL(wp) ::   r2dttrc 
    4745 
    4846   !!---------------------------------------------------------------------- 
    … …  
    9997      END DO 
    10098 
    101       IF( lk_bdy )  CALL trc_bdy( kt ) 
    102  
    103       !                                ! set time step size (Euler/Leapfrog) 
    104       IF( neuler == 0 .AND. kt ==  nittrc000 ) THEN  ;  r2dttrc =     rdttrc   ! at nittrc000             (Euler) 
    105       ELSEIF( kt <= nittrc000 + nn_dttrc )     THEN  ;  r2dttrc = 2.* rdttrc   ! at nit000 or nit000+1 (Leapfrog) 
    106       ENDIF 
     99      IF( ln_bdy )  CALL trc_bdy( kt ) 
    107100 
    108101      IF( l_trdtrc )  THEN             ! trends: store now fields before the Asselin filter application 

  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90

    r5836 r7646  
    6262      ENDIF 
    6363 
    64       IF( lk_cfc     )   CALL trc_rad_sms( kt, trb, trn, jp_cfc0 , jp_cfc1               )  ! CFC model 
    65       IF( lk_c14b    )   CALL trc_rad_sms( kt, trb, trn, jp_c14b0, jp_c14b1              )  ! bomb C14 
    66       IF( lk_pisces  )   CALL trc_rad_sms( kt, trb, trn, jp_pcs0 , jp_pcs1, cpreserv='Y' )  ! PISCES model 
    67       IF( lk_my_trc  )   CALL trc_rad_sms( kt, trb, trn, jp_myt0 , jp_myt1               )  ! MY_TRC model 
     64      IF( ln_age     )   CALL trc_rad_sms( kt, trb, trn, jp_age , jp_age               )  !  AGE 
     65      IF( ll_cfc     )   CALL trc_rad_sms( kt, trb, trn, jp_cfc0, jp_cfc1               )  !  CFC model 
     66      IF( ln_c14     )   CALL trc_rad_sms( kt, trb, trn, jp_c14 , jp_c14               )  !  C14 
     67      IF( ln_pisces  )   CALL trc_rad_sms( kt, trb, trn, jp_pcs0, jp_pcs1, cpreserv='Y' )  !  PISCES model 
     68      IF( ln_my_trc  )   CALL trc_rad_sms( kt, trb, trn, jp_myt0, jp_myt1               )  !  MY_TRC model 
    6869 
    6970      ! 
    … …  
    213214            IF( l_trdtrc ) THEN 
    214215               ! 
    215                zs2rdt = 1. / ( 2. * rdt * FLOAT( nn_dttrc ) ) 
     216               zs2rdt = 1. / ( 2. * rdt * REAL( nn_dttrc, wp ) ) 
    216217               ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 
    217218               ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt  

  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trcsbc.F90

    r6942 r7646  
    8484      END SELECT 
    8585 
    86       IF( ln_top_euler) THEN 
    87          r2dt =  rdttrc              ! = rdttrc (use Euler time stepping) 
    88       ELSE 
    89          IF( neuler == 0 .AND. kt == nittrc000 ) THEN     ! at nittrc000 
    90             r2dt = rdttrc            ! = rdttrc (restarting with Euler time stepping) 
    91          ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN          ! at nittrc000 or nittrc000+1 
    92             r2dt = 2. * rdttrc       ! = 2 rdttrc (leapfrog) 
    93          ENDIF 
    94       ENDIF 
    95  
    96  
    9786      IF( kt == nittrc000 ) THEN 
    9887         IF(lwp) WRITE(numout,*) 
    … …  
    126115      ! Coupling offline : runoff are in emp which contains E-P-R 
    127116      ! 
    128       IF( .NOT. lk_offline .AND. .NOT.ln_linssh ) THEN  ! online coupling with vvl 
     117      IF( .NOT.ln_linssh ) THEN  ! online coupling with vvl 
    129118         zsfx(:,:) = 0._wp 
    130119      ELSE                                      ! online coupling free surface or offline with free surface 
    … …  
    160149                  zdtra = r1_rau0 * ( ztfx + zsfx(ji,jj) * trn(ji,jj,1,jn) )  
    161150                  IF ( zdtra < 0. ) THEN 
    162                      zratio = -zdtra * zse3t * r2dt / ( trn(ji,jj,1,jn) + zrtrn ) 
     151                     zratio = -zdtra * zse3t * r2dttrc / ( trn(ji,jj,1,jn) + zrtrn ) 
    163152                     zdtra = MIN(1.0, zratio) * zdtra ! avoid negative concentrations to arise 
    164153                  ENDIF 

  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trctrp.F90

    r6309 r7646  
    2525   USE trcsbc          ! surface boundary condition          (trc_sbc routine) 
    2626   USE zpshde          ! partial step: hor. derivative       (zps_hde routine) 
     27   USE bdy_oce   , ONLY: ln_bdy 
    2728   USE trcbdy          ! BDY open boundaries 
    28    USE bdy_par, only: lk_bdy 
    2929 
    3030#if defined key_agrif 
    … …  
    6565         IF( lk_trabbl )        CALL trc_bbl    ( kt )      ! advective (and/or diffusive) bottom boundary layer scheme 
    6666         IF( ln_trcdmp )        CALL trc_dmp    ( kt )      ! internal damping trends 
    67          IF( lk_bdy )           CALL trc_bdy_dmp( kt )      ! BDY damping trends 
     67         IF( ln_bdy )           CALL trc_bdy_dmp( kt )      ! BDY damping trends 
    6868                                CALL trc_adv    ( kt )      ! horizontal & vertical advection  
    6969         !                                                         ! Partial top/bottom cell: GRADh( trb )   

  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trczdf.F90

    r6140 r7646  
    3535   INTEGER ::   nzdf = 0               ! type vertical diffusion algorithm used 
    3636      !                                ! defined from ln_zdf...  namlist logicals) 
    37    REAL(wp) ::  r2dttrc   ! vertical profile time-step, = 2 rdt 
    38       !                   ! except at nittrc000 (=rdt) if neuler=0 
    39  
    4037   !! * Substitutions 
    4138#  include "zdfddm_substitute.h90" 
    … …  
    6360      IF( nn_timing == 1 )  CALL timing_start('trc_zdf') 
    6461      ! 
    65       IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN     ! at nittrc000 
    66          r2dttrc =  rdttrc           ! = rdttrc (use or restarting with Euler time stepping) 
    67       ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN          ! at nittrc000 or nittrc000+1 
    68          r2dttrc = 2. * rdttrc       ! = 2 rdttrc (leapfrog) 
    69       ENDIF 
    70  
    7162      IF( l_trdtrc )  THEN 
    7263         CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrtrd ) 

  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc.F90

    r6140 r7646  
    4141   PUBLIC trd_mxl_trc 
    4242   PUBLIC trd_mxl_trc_alloc 
    43    PUBLIC trd_mxl_bio 
    4443   PUBLIC trd_mxl_trc_init 
    4544   PUBLIC trd_mxl_trc_zint 
    46    PUBLIC trd_mxl_bio_zint 
    4745 
    4846   CHARACTER (LEN=40) ::  clhstnam                                ! name of the trends NetCDF file 
    4947   INTEGER ::   nmoymltrd 
    50    INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) ::   ndextrd1 
    51    INTEGER, DIMENSION(jptra) ::   nidtrd, nh_t 
     48   INTEGER, ALLOCATABLE, SAVE, DIMENSION(:) ::   ndextrd1, nidtrd, nh_t 
    5249   INTEGER ::   ndimtrd1                         
    5350   INTEGER, SAVE ::  ionce, icount 
    54 #if defined key_pisces_reduced 
    55    INTEGER ::   nidtrdbio, nh_tb 
    56    INTEGER, SAVE ::  ioncebio, icountbio 
    57    INTEGER, SAVE ::   nmoymltrdbio 
    58 #endif 
    5951   LOGICAL :: llwarn  = .TRUE.                                    ! this should always be .TRUE. 
    6052   LOGICAL :: lldebug = .TRUE. 
    6153 
    6254   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  ztmltrd2   ! 
    63 #if defined key_pisces_reduced 
    64    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  ztmltrdbio2  ! only needed for mean diagnostics in trd_mxl_bio() 
    65 #endif 
    6655 
    6756   !! * Substitutions 
    … …  
    7968      !!---------------------------------------------------------------------- 
    8069      ALLOCATE( ztmltrd2(jpi,jpj,jpltrd_trc,jptra) ,      & 
    81 #if defined key_pisces_reduced 
    82          &      ztmltrdbio2(jpi,jpj,jpdiabio)      ,      & 
    83 #endif 
    84          &      ndextrd1(jpi*jpj)                  ,  STAT=trd_mxl_trc_alloc) 
     70         &      ndextrd1(jpi*jpj), nidtrd(jptra), nh_t(jptra),  STAT=trd_mxl_trc_alloc) 
    8571         ! 
    8672      IF( lk_mpp                )   CALL mpp_sum ( trd_mxl_trc_alloc ) 
    … …  
    131117         SELECT CASE ( nn_ctls_trc )                                ! choice of the control surface 
    132118            CASE ( -2  )   ;   STOP 'trdmxl_trc : not ready '     !     -> isopycnal surface (see ???) 
    133 #if defined key_pisces || defined key_pisces_reduced 
    134119            CASE ( -1  )   ;   nmld_trc(:,:) = neln(:,:)          !     -> euphotic layer with light criterion 
    135 #endif 
    136120            CASE (  0  )   ;   nmld_trc(:,:) = nmln(:,:)          !     -> ML with density criterion (see zdfmxl) 
    137121            CASE (  1  )   ;   nmld_trc(:,:) = nbol_trc(:,:)          !     -> read index from file 
    … …  
    207191      ! 
    208192   END SUBROUTINE trd_mxl_trc_zint 
    209  
    210  
    211    SUBROUTINE trd_mxl_bio_zint( ptrc_trdmxl, ktrd ) 
    212       !!---------------------------------------------------------------------- 
    213       !!                  ***  ROUTINE trd_mxl_bio_zint  *** 
    214       !! 
    215       !! ** Purpose :   Compute the vertical average of the 3D fields given as arguments 
    216       !!                to the subroutine. This vertical average is performed from ocean 
    217       !!                surface down to a chosen control surface. 
    218       !! 
    219       !! ** Method/usage : 
    220       !!      The control surface can be either a mixed layer depth (time varying) 
    221       !!      or a fixed surface (jk level or bowl). 
    222       !!      Choose control surface with nctls in namelist NAMTRD : 
    223       !!        nctls_trc = 0  : use mixed layer with density criterion 
    224       !!        nctls_trc = 1  : read index from file 'ctlsurf_idx' 
    225       !!        nctls_trc > 1  : use fixed level surface jk = nctls_trc 
    226       !!      Note: in the remainder of the routine, the volume between the 
    227       !!            surface and the control surface is called "mixed-layer" 
    228       !!---------------------------------------------------------------------- 
    229       !! 
    230       INTEGER                         , INTENT(in) ::   ktrd          ! bio trend index 
    231       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) ::   ptrc_trdmxl   ! passive trc trend 
    232 #if defined key_pisces_reduced 
    233       ! 
    234       INTEGER ::   ji, jj, jk, isum 
    235       REAL(wp), POINTER, DIMENSION(:,:) :: zvlmsk 
    236       !!---------------------------------------------------------------------- 
    237  
    238       CALL wrk_alloc( jpi, jpj, zvlmsk ) 
    239  
    240       ! I. Definition of control surface and integration weights 
    241       ! -------------------------------------------------------- 
    242       !            ==> only once per time step <== 
    243  
    244       IF( icountbio == 1 ) THEN 
    245          ! 
    246          tmltrd_bio(:,:,:) = 0.e0    ! <<< reset trend arrays to zero 
    247          ! ... Set nmld(ji,jj) = index of first T point below control surf. or outside mixed-layer 
    248          SELECT CASE ( nn_ctls_trc )                                    ! choice of the control surface 
    249             CASE ( -2  )   ;   STOP 'trdmxl_trc : not ready '     !     -> isopycnal surface (see ???) 
    250             CASE ( -1  )   ;   nmld_trc(:,:) = neln(:,:)          !     -> euphotic layer with light criterion 
    251             CASE (  0  )   ;   nmld_trc(:,:) = nmln(:,:)          !     -> ML with density criterion (see zdfmxl) 
    252             CASE (  1  )   ;   nmld_trc(:,:) = nbol_trc(:,:)          !     -> read index from file 
    253             CASE (  2: )   ;   nn_ctls_trc = MIN( nn_ctls_trc, jpktrd_trc - 1 ) 
    254                                nmld_trc(:,:) = nn_ctls_trc + 1          !     -> model level 
    255          END SELECT 
    256  
    257          ! ... Compute ndextrd1 and ndimtrd1 only once 
    258          IF( ioncebio == 1 ) THEN 
    259             ! 
    260             ! Check of validity : nmld_trc(ji,jj) <= jpktrd_trc 
    261             isum        = 0 
    262             zvlmsk(:,:) = 0.e0 
    263  
    264             IF( jpktrd_trc < jpk ) THEN 
    265                DO jj = 1, jpj 
    266                   DO ji = 1, jpi 
    267                      IF( nmld_trc(ji,jj) <= jpktrd_trc ) THEN 
    268                         zvlmsk(ji,jj) = tmask(ji,jj,1) 
    269                      ELSE 
    270                         isum = isum + 1 
    271                         zvlmsk(ji,jj) = 0. 
    272                      END IF 
    273                   END DO 
    274                END DO 
    275             END IF 
    276  
    277             ! Index of ocean points (2D only) 
    278             IF( isum > 0 ) THEN 
    279                WRITE(numout,*)' tmltrd_trc : Number of invalid points nmld_trc > jpktrd', isum 
    280                CALL wheneq( jpi*jpj, zvlmsk(:,:) , 1, 1., ndextrd1, ndimtrd1 ) 
    281             ELSE 
    282                CALL wheneq( jpi*jpj, tmask(:,:,1), 1, 1., ndextrd1, ndimtrd1 ) 
    283             END IF 
    284  
    285             ioncebio = 0                  ! no more pass here 
    286             ! 
    287          END IF !  ( ioncebio == 1 ) 
    288  
    289          ! ... Weights for vertical averaging 
    290          wkx_trc(:,:,:) = 0.e0 
    291          DO jk = 1, jpktrd_trc         ! initialize wkx_trc with vertical scale factor in mixed-layer 
    292             DO jj = 1,jpj 
    293               DO ji = 1,jpi 
    294                   IF( jk - nmld_trc(ji,jj) < 0. )   wkx_trc(ji,jj,jk) = e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
    295                END DO 
    296             END DO 
    297          END DO 
    298  
    299          rmld_trc(:,:) = 0. 
    300          DO jk = 1, jpktrd_trc         ! compute mixed-layer depth : rmld_trc 
    301             rmld_trc(:,:) = rmld_trc(:,:) + wkx_trc(:,:,jk) 
    302          END DO 
    303  
    304          DO jk = 1, jpktrd_trc         ! compute integration weights 
    305             wkx_trc(:,:,jk) = wkx_trc(:,:,jk) / MAX( 1., rmld_trc(:,:) ) 
    306          END DO 
    307  
    308          icountbio = 0                    ! <<< flag = off : control surface & integr. weights 
    309          !                             !     computed only once per time step 
    310       END IF ! ( icountbio == 1 ) 
    311  
    312       ! II. Vertical integration of trends in the mixed-layer 
    313       ! ----------------------------------------------------- 
    314  
    315  
    316       DO jk = 1, jpktrd_trc 
    317          tmltrd_bio(:,:,ktrd) = tmltrd_bio(:,:,ktrd) + ptrc_trdmxl(:,:,jk) * wkx_trc(:,:,jk) 
    318       END DO 
    319  
    320       CALL wrk_dealloc( jpi, jpj, zvlmsk ) 
    321 #endif 
    322       ! 
    323    END SUBROUTINE trd_mxl_bio_zint 
    324193 
    325194 
    … …  
    428297      ENDIF 
    429298 
    430       IF ( cp_cfg .NE. 'gyre' ) THEN            ! other than GYRE configuration 
    431       ! GYRE : for diagnostic fields, are needed if cyclic B.C. are present, but not for purely MPI comm.  
    432       ! therefore we do not call lbc_lnk in GYRE config. (closed basin, no cyclic B.C.) 
     299!!gm Test removed, nothing specific to a configuration should survive out of usrdef modules 
     300!!gm      IF ( cn_cfg .NE. 'gyre' ) THEN            ! other than GYRE configuration 
     301!!gm      ! GYRE : for diagnostic fields, are needed if cyclic B.C. are present, but not for purely MPI comm.  
     302!!gm      ! therefore we do not call lbc_lnk in GYRE config. (closed basin, no cyclic B.C.) 
    433303         DO jn = 1, jptra 
    434304            IF( ln_trdtrc(jn) ) THEN 
    … …  
    438308            ENDIF 
    439309         END DO 
    440       ENDIF 
     310!!gm      ENDIF 
     311       
    441312      ! ====================================================================== 
    442313      ! II. Cumulate the trends over the analysis window 
    … …  
    567438                
    568439         !-- Lateral boundary conditions 
    569                IF ( cp_cfg .NE. 'gyre' ) THEN 
     440               IF ( cn_cfg .NE. 'gyre' ) THEN 
    570441                  CALL lbc_lnk( ztmltot(:,:,jn) , 'T', 1. )   ;   CALL lbc_lnk( ztmlres(:,:,jn) , 'T', 1. ) 
    571442                  CALL lbc_lnk( ztmlatf(:,:,jn) , 'T', 1. )   ;   CALL lbc_lnk( ztmlrad(:,:,jn) , 'T', 1. ) 
    … …  
    618489 
    619490         !-- Lateral boundary conditions  
    620                IF ( cp_cfg .NE. 'gyre' ) THEN            ! other than GYRE configuration     
     491               IF ( cn_cfg .NE. 'gyre' ) THEN            ! other than GYRE configuration     
    621492                  CALL lbc_lnk( ztmltot2(:,:,jn), 'T', 1. ) 
    622493                  CALL lbc_lnk( ztmlres2(:,:,jn), 'T', 1. ) 
    … …  
    876747   END SUBROUTINE trd_mxl_trc 
    877748 
    878  
    879    SUBROUTINE trd_mxl_bio( kt ) 
    880       !!---------------------------------------------------------------------- 
    881       !!                  ***  ROUTINE trd_mld  *** 
    882       !! 
    883       !! ** Purpose :  Compute and cumulate the mixed layer biological trends over an analysis 
    884       !!               period, and write NetCDF outputs. 
    885       !! 
    886       !! ** Method/usage : 
    887       !!          The stored trends can be chosen twofold (according to the ln_trdmxl_trc_instant 
    888       !!          logical namelist variable) : 
    889       !!          1) to explain the difference between initial and final 
    890       !!             mixed-layer T & S (where initial and final relate to the 
    891       !!             current analysis window, defined by ntrd in the namelist) 
    892       !!          2) to explain the difference between the current and previous 
    893       !!             TIME-AVERAGED mixed-layer T & S (where time-averaging is 
    894       !!             performed over each analysis window). 
    895       !! 
    896       !! ** Consistency check : 
    897       !!        If the control surface is fixed ( nctls > 1 ), the residual term (dh/dt 
    898       !!        entrainment) should be zero, at machine accuracy. Note that in the case 
    899       !!        of time-averaged mixed-layer fields, this residual WILL NOT BE ZERO 
    900       !!        over the first two analysis windows (except if restart). 
    901       !!        N.B. For ORCA2_LIM, use e.g. ntrd=5, ucf=1., nctls=8 
    902       !!             for checking residuals. 
    903       !!             On a NEC-SX5 computer, this typically leads to: 
    904       !!                   O(1.e-20) temp. residuals (tml_res) when ln_trdmxl_trc_instant=.false. 
    905       !!                   O(1.e-21) temp. residuals (tml_res) when ln_trdmxl_trc_instant=.true. 
    906       !! 
    907       !! ** Action : 
    908       !!       At each time step, mixed-layer averaged trends are stored in the 
    909       !!       tmltrd(:,:,jpmxl_xxx) array (see trdmxl_oce.F90 for definitions of jpmxl_xxx). 
    910       !!       This array is known when trd_mld is called, at the end of the stp subroutine, 
    911       !!       except for the purely vertical K_z diffusion term, which is embedded in the 
    912       !!       lateral diffusion trend. 
    913       !! 
    914       !!       In I), this K_z term is diagnosed and stored, thus its contribution is removed 
    915       !!       from the lateral diffusion trend. 
    916       !!       In II), the instantaneous mixed-layer T & S are computed, and misc. cumulative 
    917       !!       arrays are updated. 
    918       !!       In III), called only once per analysis window, we compute the total trends, 
    919       !!       along with the residuals and the Asselin correction terms. 
    920       !!       In IV), the appropriate trends are written in the trends NetCDF file. 
    921       !! 
    922       !! References : 
    923       !!       - Vialard & al. 
    924       !!       - See NEMO documentation (in preparation) 
    925       !!---------------------------------------------------------------------- 
    926       INTEGER, INTENT( in ) ::   kt                       ! ocean time-step index 
    927 #if defined key_pisces_reduced 
    928       INTEGER  ::  jl, it, itmod 
    929       LOGICAL  :: llwarn  = .TRUE., lldebug = .TRUE. 
    930       REAL(wp) :: zfn, zfn2 
    931       !!---------------------------------------------------------------------- 
    932       ! ... Warnings 
    933       IF( nn_dttrc  /= 1  ) CALL ctl_stop( " Be careful, trends diags never validated " ) 
    934  
    935       ! ====================================================================== 
    936       ! II. Cumulate the trends over the analysis window 
    937       ! ====================================================================== 
    938  
    939       ztmltrdbio2(:,:,:) = 0.e0  ! <<< reset arrays to zero 
    940  
    941       ! II.3 Initialize mixed-layer "before" arrays for the 1rst analysis window 
    942       ! ------------------------------------------------------------------------ 
    943       IF( kt == nittrc000 + nn_dttrc ) THEN  !  i.e. ( .NOT. ln_rstart ).AND.( kt == nit000 + 1) 
    944          ! 
    945          tmltrd_csum_ub_bio (:,:,:) = 0.e0 
    946          ! 
    947       END IF 
    948  
    949       ! II.4 Cumulated trends over the analysis period 
    950       ! ---------------------------------------------- 
    951       ! 
    952       !         [  1rst analysis window ] [     2nd analysis window     ] 
    953       ! 
    954       ! 
    955       !     o---[--o-----o-----o-----o--]-[--o-----o-----o-----o-----o--]---o-----o--> time steps 
    956       !                            ntrd                             2*ntrd       etc. 
    957       !     1      2     3     4    =5 e.g.                          =10 
    958       ! 
    959       IF( ( kt >= 2 ).OR.( ln_rsttr ) ) THEN 
    960          ! 
    961          nmoymltrdbio = nmoymltrdbio + 1 
    962  
    963          ! ... Trends associated with the time mean of the ML passive tracers 
    964          tmltrd_sum_bio    (:,:,:) = tmltrd_sum_bio    (:,:,:) + tmltrd_bio    (:,:,:) 
    965          tmltrd_csum_ln_bio(:,:,:) = tmltrd_csum_ln_bio(:,:,:) + tmltrd_sum_bio(:,:,:) 
    966          ! 
    967       END IF 
    968  
    969       ! ====================================================================== 
    970       ! III. Prepare fields for output (get here ONCE PER ANALYSIS PERIOD) 
    971       ! ====================================================================== 
    972  
    973       ! Convert to appropriate physical units 
    974       tmltrd_bio(:,:,:) = tmltrd_bio(:,:,:) * rn_ucf_trc 
    975  
    976       MODULO_NTRD : IF( MOD( kt, nn_trd_trc ) == 0 ) THEN      ! nitend MUST be multiple of ntrd 
    977          ! 
    978          zfn  = float(nmoymltrdbio)    ;    zfn2 = zfn * zfn 
    979  
    980          ! III.1 Prepare fields for output ("instantaneous" diagnostics) 
    981          ! ------------------------------------------------------------- 
    982  
    983 #if defined key_diainstant 
    984          STOP 'tmltrd_bio : key_diainstant was never checked within trdmxl. Comment this to proceed.' 
    985 #endif 
    986          ! III.2 Prepare fields for output ("mean" diagnostics) 
    987          ! ---------------------------------------------------- 
    988  
    989          ztmltrdbio2(:,:,:) = tmltrd_csum_ub_bio(:,:,:) + tmltrd_csum_ln_bio(:,:,:) 
    990  
    991          !-- Lateral boundary conditions 
    992          IF ( cp_cfg .NE. 'gyre' ) THEN            ! other than GYRE configuration  
    993             ! ES_B27_CD_WARN : lbc inutile GYRE, cf. + haut 
    994             DO jn = 1, jpdiabio 
    995               CALL lbc_lnk( ztmltrdbio2(:,:,jn), 'T', 1. ) 
    996             ENDDO 
    997          ENDIF 
    998  
    999          IF( lldebug ) THEN 
    1000             ! 
    1001             WRITE(numout,*) 'trd_mxl_bio : write trends in the Mixed Layer for debugging process:' 
    1002             WRITE(numout,*) '~~~~~~~~~~~  ' 
    1003             WRITE(numout,*) 'TRC kt = ', kt, 'nmoymltrdbio = ', nmoymltrdbio 
    1004             WRITE(numout,*) 
    1005  
    1006             DO jl = 1, jpdiabio 
    1007               IF( ln_trdmxl_trc_instant ) THEN 
    1008                   WRITE(numout,97) 'TRC jl =', jl, ' bio TREND INDEX  = ', jl, & 
    1009                      & ' SUM tmltrd_bio : ', SUM2D(tmltrd_bio(:,:,jl)) 
    1010               ELSE 
    1011                   WRITE(numout,97) 'TRC jl =', jl, ' bio TREND INDEX  = ', jl, & 
    1012                      & ' SUM ztmltrdbio2 : ', SUM2D(ztmltrdbio2(:,:,jl)) 
    1013               endif 
    1014             END DO 
    1015  
    1016 97          FORMAT(a10, i3, 2x, a30, i3, a20, 2x, g20.10) 
    1017 98          FORMAT(a10, i3, 2x, a30, 2x, g20.10) 
    1018 99          FORMAT('TRC jj =', i3,' : ', 10(g10.3,2x)) 
    1019             WRITE(numout,*) 
    1020             ! 
    1021          ENDIF 
    1022  
    1023          ! III.3 Time evolution array swap 
    1024          ! ------------------------------- 
    1025  
    1026          ! For passive tracer mean diagnostics 
    1027          tmltrd_csum_ub_bio (:,:,:) = zfn * tmltrd_sum_bio(:,:,:) - tmltrd_csum_ln_bio(:,:,:) 
    1028  
    1029          ! III.4 Convert to appropriate physical units 
    1030          ! ------------------------------------------- 
    1031          ztmltrdbio2    (:,:,:) = ztmltrdbio2    (:,:,:) * rn_ucf_trc/zfn2 
    1032  
    1033       END IF MODULO_NTRD 
    1034  
    1035       ! ====================================================================== 
    1036       ! IV. Write trends in the NetCDF file 
    1037       ! ====================================================================== 
    1038  
    1039       ! IV.1 Code for IOIPSL/NetCDF output 
    1040       ! ---------------------------------- 
    1041  
    1042       ! define time axis 
    1043       itmod = kt - nittrc000 + 1 
    1044       it    = kt 
    1045  
    1046       IF( lwp .AND. MOD( itmod , nn_trd_trc ) == 0 ) THEN 
    1047          WRITE(numout,*) ' ' 
    1048          WRITE(numout,*) 'trd_mxl_bio : write ML bio trends in the NetCDF file :' 
    1049          WRITE(numout,*) '~~~~~~~~~~~ ' 
    1050          WRITE(numout,*) '          ', TRIM(clhstnam), ' at kt = ', kt 
    1051          WRITE(numout,*) '          N.B. nmoymltrdbio = ', nmoymltrdbio 
    1052          WRITE(numout,*) ' ' 
    1053       END IF 
    1054  
    1055  
    1056       ! 2. Start writing data 
    1057       ! --------------------- 
    1058  
    1059       NETCDF_OUTPUT : IF( ln_trdmxl_trc_instant ) THEN    ! <<< write the trends for passive tracer instant. diags 
    1060          ! 
    1061             DO jl = 1, jpdiabio 
    1062                CALL histwrite( nidtrdbio,TRIM("ML_"//ctrd_bio(jl,2)) ,            & 
    1063                     &          it, tmltrd_bio(:,:,jl), ndimtrd1, ndextrd1 ) 
    1064             END DO 
    1065  
    1066  
    1067          IF( kt == nitend )   CALL histclo( nidtrdbio ) 
    1068  
    1069       ELSE    ! <<< write the trends for passive tracer mean diagnostics 
    1070  
    1071             DO jl = 1, jpdiabio 
    1072                CALL histwrite( nidtrdbio, TRIM("ML_"//ctrd_bio(jl,2)) ,            & 
    1073                     &          it, ztmltrdbio2(:,:,jl), ndimtrd1, ndextrd1 ) 
    1074             END DO 
    1075  
    1076             IF( kt == nitend )   CALL histclo( nidtrdbio ) 
    1077             ! 
    1078       END IF NETCDF_OUTPUT 
    1079  
    1080       ! Compute the control surface (for next time step) : flag = on 
    1081       icountbio = 1 
    1082  
    1083  
    1084  
    1085       IF( MOD( itmod, nn_trd_trc ) == 0 ) THEN 
    1086          ! 
    1087          ! III.5 Reset cumulative arrays to zero 
    1088          ! ------------------------------------- 
    1089          nmoymltrdbio = 0 
    1090          tmltrd_csum_ln_bio (:,:,:) = 0.e0 
    1091          tmltrd_sum_bio     (:,:,:) = 0.e0 
    1092       END IF 
    1093  
    1094       ! ====================================================================== 
    1095       ! Write restart file 
    1096       ! ====================================================================== 
    1097  
    1098 ! restart write is done in trd_mxl_trc_write which is called by trd_mxl_bio (Marina) 
    1099 ! 
    1100 #endif 
    1101    END SUBROUTINE trd_mxl_bio 
    1102  
    1103  
    1104749   REAL FUNCTION sum2d( ztab ) 
    1105750      !!---------------------------------------------------------------------- 
    … …  
    1191836      tmltrd_csum_ln_trc (:,:,:,:) = 0.e0   ;   rmld_sum_trc       (:,:)     = 0.e0 
    1192837 
    1193 #if defined key_pisces_reduced 
    1194       nmoymltrdbio   = 0 
    1195       tmltrd_sum_bio     (:,:,:) = 0.e0     ;   tmltrd_csum_ln_bio (:,:,:) = 0.e0 
    1196       DO jl = 1, jp_pisces_trd 
    1197           ctrd_bio(jl,1) = ctrbil(jl)   ! long name 
    1198           ctrd_bio(jl,2) = ctrbio(jl)   ! short name 
    1199        ENDDO 
    1200 #endif 
    1201  
    1202838      IF( ln_rsttr .AND. ln_trdmxl_trc_restart ) THEN 
    1203839         CALL trd_mxl_trc_rst_read 
    … …  
    1208844         tml_sumb_trc       (:,:,:)   = 0.e0   ;   tmltrd_csum_ub_trc (:,:,:,:) = 0.e0     ! mean 
    1209845         tmltrd_atf_sumb_trc(:,:,:)   = 0.e0   ;   tmltrd_rad_sumb_trc(:,:,:)   = 0.e0  
    1210 #if defined key_pisces_reduced 
    1211          tmltrd_csum_ub_bio (:,:,:) = 0.e0 
    1212 #endif 
    1213846 
    1214847       ENDIF 
    … …  
    1216849      icount = 1   ;   ionce  = 1  ! open specifier    
    1217850 
    1218 #if defined key_pisces_reduced 
    1219       icountbio = 1   ;   ioncebio  = 1  ! open specifier 
    1220 #endif 
    1221851 
    1222852      ! I.3 Read control surface from file ctlsurf_idx 
    … …  
    1308938      END DO 
    1309939 
    1310 #if defined key_pisces_reduced 
    1311           !-- Create a NetCDF file and enter the define mode 
    1312           CALL dia_nam( clhstnam, nn_trd_trc, 'trdbio' ) 
    1313           CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,                                            & 
    1314              &             1, jpi, 1, jpj, iiter, zjulian, rdt, nh_tb, nidtrdbio, domain_id=nidom, snc4chunks=snc4set ) 
    1315 #endif 
    1316  
    1317940      !-- Define physical units 
    1318941      IF( rn_ucf_trc == 1. ) THEN 
    … …  
    1354977      END DO 
    1355978 
    1356 #if defined key_pisces_reduced 
    1357       DO jl = 1, jp_pisces_trd 
    1358          CALL histdef(nidtrdbio, TRIM("ML_"//ctrd_bio(jl,2)), TRIM(clmxl//" ML_"//ctrd_bio(jl,1))   ,            & 
    1359              &    cltrcu, jpi, jpj, nh_tb, 1  , 1, 1  , -99 , 32, clop, zsto, zout ) ! IOIPSL: time mean 
    1360       END DO                                                                         ! if zsto=rdt above 
    1361 #endif 
    1362  
    1363979      !-- Leave IOIPSL/NetCDF define mode 
    1364980      DO jn = 1, jptra 
    … …  
    1366982      END DO 
    1367983 
    1368 #if defined key_pisces_reduced 
    1369       !-- Leave IOIPSL/NetCDF define mode 
    1370       CALL histend( nidtrdbio, snc4set ) 
    1371  
    1372984      IF(lwp) WRITE(numout,*) 
    1373        IF(lwp) WRITE(numout,*) 'End of NetCDF Initialization for ML bio trends' 
    1374 #endif 
    1375985 
    1376986   END SUBROUTINE trd_mxl_trc_init 
    … …  
    1385995      WRITE(*,*) 'trd_mxl_trc: You should not have seen this print! error?', kt 
    1386996   END SUBROUTINE trd_mxl_trc 
    1387    SUBROUTINE trd_mxl_bio( kt ) 
    1388       INTEGER, INTENT( in) ::   kt 
    1389       WRITE(*,*) 'trd_mxl_bio: You should not have seen this print! error?', kt 
    1390    END SUBROUTINE trd_mxl_bio 
    1391997   SUBROUTINE trd_mxl_trc_zint( ptrc_trdmxl, ktrd, ctype, kjn ) 
    1392998      INTEGER               , INTENT( in ) ::  ktrd, kjn              ! ocean trend index and passive tracer rank 

  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trdmxl_trc_rst.F90

    r6140 r7646  
    107107            END DO                                                     ! tracer loop 
    108108            !                                                          ! =========== 
    109 #if defined key_pisces_reduced 
    110             DO jl = 1, jp_pisces_trd 
    111                CALL iom_rstput( kt, nitrst, nummldw_trc, 'tmltrd_csum_ub_bio'//ctrd_bio(jl,2), tmltrd_csum_ub_bio(:,:,jl) ) 
    112             ENDDO 
    113 #endif 
    114  
    115109         ENDIF 
    116110          
    … …  
    188182         !                                                          ! =========== 
    189183 
    190 #if defined key_pisces_reduced 
    191          DO jl = 1, jp_pisces_trd 
    192             CALL iom_get( inum, jpdom_autoglo, 'tmltrd_csum_ub_bio'//ctrd_bio(jl,2), tmltrd_csum_ub_bio(:,:,jl) ) 
    193          ENDDO 
    194 #endif 
    195           
    196184         CALL iom_close( inum ) 
    197185      ENDIF 

  • trunk/NEMOGCM/NEMO/TOP_SRC/TRP/trdtrc_oce.F90

    r5836 r7646  
    2222   CHARACTER(len=50) ::  cn_trdrst_trc_in     !: suffix of pass. tracer restart name (input) 
    2323   CHARACTER(len=50) ::  cn_trdrst_trc_out    !: suffix of pass. tracer restart name (output) 
    24    LOGICAL, DIMENSION(jptra) ::   ln_trdtrc   !: large trends diagnostic to write or not (namelist) 
     24   LOGICAL, DIMENSION(:), ALLOCATABLE ::   ln_trdtrc   !: large trends diagnostic to write or not (namelist) 
    2525 
    2626# if defined key_trdtrc && defined key_iomput 
    … …  
    106106# endif 
    107107 
    108 # if defined key_pisces_reduced 
    109    CHARACTER(LEN=80) :: clname_bio, ctrd_bio(jpdiabio,2) 
    110    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::  & 
    111       tmltrd_bio,                         &      !: \ biological contributions to the total trend , 
    112                                                  !: / cumulated over the current analysis window 
    113       tmltrd_sum_bio,                     &      !: sum of these trends over the analysis period 
    114       tmltrd_csum_ln_bio,                 &      !: now cumulated sum of trends over the "lower triangle" 
    115       tmltrd_csum_ub_bio                         !: before (prev. analysis period) cumulated sum over the 
    116                                                  !: upper triangle 
    117 #endif 
    118108   !!---------------------------------------------------------------------- 
    119109   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    154144#endif 
    155145      ! 
    156 # if defined key_pisces_reduced 
    157       ALLOCATE( tmltrd_bio        (jpi,jpj,jpdiabio) ,     & 
    158          &      tmltrd_sum_bio    (jpi,jpj,jpdiabio) ,     & 
    159          &      tmltrd_csum_ln_bio(jpi,jpj,jpdiabio) ,     & 
    160          &      tmltrd_csum_ub_bio(jpi,jpj,jpdiabio) , STAT=ierr(2) ) 
    161 # endif 
    162       ! 
    163146      trd_trc_oce_alloc = MAXVAL(ierr) 
    164147      ! 

  • trunk/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90

    r5836 r7646  
    3131   USE phycst                                   !* physical constants * 
    3232   USE c1d                                      !* 1D configuration 
     33 
    3334   USE dom_oce                                  !* model domain * 
    3435 
    … …  
    5051   USE oce , ONLY :   sshb    =>    sshb    !: sea surface height at t-point [m]    
    5152   USE oce , ONLY :   ssha    =>    ssha    !: sea surface height at t-point [m]    
    52 #if defined key_offline 
    5353   USE oce , ONLY :   rab_n   =>    rab_n   !: local thermal/haline expension ratio at T-points 
    54 #endif 
    5554 
    5655   !* surface fluxes * 
    … …  
    6362   USE sbc_oce , ONLY :   fmmflx     =>    fmmflx     !: freshwater budget: volume flux               [Kg/m2/s] 
    6463   USE sbc_oce , ONLY :   rnf        =>    rnf        !: river runoff   [Kg/m2/s] 
     64   USE sbc_oce , ONLY :   rnf_b      =>    rnf_b      !: river runoff at previus step   [Kg/m2/s] 
    6565   USE sbc_oce , ONLY :   ln_dm2dc   =>    ln_dm2dc   !: Diurnal Cycle  
     66   USE sbc_oce , ONLY :   ln_cpl     =>    ln_cpl     !: ocean-atmosphere coupled formulation 
    6667   USE sbc_oce , ONLY :   ncpl_qsr_freq   =>   ncpl_qsr_freq   !: qsr coupling frequency per days from atmospher 
    6768   USE sbc_oce , ONLY :   ln_rnf     =>    ln_rnf     !: runoffs / runoff mouths 
    6869   USE sbc_oce , ONLY :   fr_i       =>    fr_i       !: ice fraction (between 0 to 1) 
    6970   USE sbc_oce , ONLY :   nn_ice_embd => nn_ice_embd  !: flag for  levitating/embedding sea-ice in the ocean 
     71   USE sbc_oce , ONLY :   atm_co2    =>    atm_co2    !  atmospheric pCO2 
    7072   USE traqsr  , ONLY :   rn_abs     =>    rn_abs     !: fraction absorbed in the very near surface 
    7173   USE traqsr  , ONLY :   rn_si0     =>    rn_si0     !: very near surface depth of extinction 
    … …  
    7577   USE sbcrnf  , ONLY :   h_rnf      =>    h_rnf      !: river runoff   [Kg/m2/s] 
    7678   USE sbcrnf  , ONLY :   nk_rnf     =>    nk_rnf     !: depth of runoff in model level 
     79   USE sbcrnf  , ONLY :   rn_rfact   =>    rn_rfact   !: multiplicative factor for runoff 
    7780 
    7881   USE trc_oce 
    … …  
    114117   USE zdfmxl , ONLY :   hmlpt       =>   hmlpt       !: mixed layer depth at t-points (m) 
    115118 
    116    USE diaar5 , ONLY :   lk_diaar5  =>   lk_diaar5 
    117119#else 
    118120   !!---------------------------------------------------------------------- 

  • trunk/NEMOGCM/NEMO/TOP_SRC/par_trc.F90

    r4529 r7646  
    1010   !!---------------------------------------------------------------------- 
    1111   USE par_kind          ! kind parameters 
     12   USE par_pisces        ! PISCES model  parameters 
     13   USE par_cfc           ! CFCs  tracers parameters 
     14   USE par_c14           ! C14 tracer    parameters 
     15   USE par_age           ! AGE tracer    parameters 
     16   USE par_my_trc        ! MY_TRC model  parameters 
    1217   ! 
    13    USE par_pisces    ! PISCES  model 
    14    USE par_c14b      ! C14 bomb tracer 
    15    USE par_cfc       ! CFC 11 and 12 tracers 
    16    USE par_my_trc    ! user defined passive tracers 
    1718 
    1819   IMPLICIT NONE 
    1920 
    20    ! Passive tracers : Maximum number of tracers. Needed to define data structures 
    21    ! ---------------  
    22    INTEGER, PUBLIC,  PARAMETER ::   jpmaxtrc = 100 
     21   INTEGER, PUBLIC,  PARAMETER :: jpmaxtrc = 100  ! Maximum number of tracers 
    2322 
    24    ! Passive tracers : Total size 
    25    ! ---------------               ! total number of passive tracers, of 2d and 3d output and trend arrays 
    26    INTEGER, PUBLIC,  PARAMETER ::   jptra    =  jp_pisces     + jp_cfc     + jp_c14b    + jp_my_trc 
    27    INTEGER, PUBLIC,  PARAMETER ::   jpdia2d  =  jp_pisces_2d  + jp_cfc_2d  + jp_c14b_2d + jp_my_trc_2d 
    28    INTEGER, PUBLIC,  PARAMETER ::   jpdia3d  =  jp_pisces_3d  + jp_cfc_3d  + jp_c14b_3d + jp_my_trc_3d 
    29    !                     ! total number of sms diagnostic arrays 
    30    INTEGER, PUBLIC,  PARAMETER ::   jpdiabio =  jp_pisces_trd + jp_cfc_trd + jp_c14b_trd + jp_my_trc_trd 
    31     
    32    !  1D configuration ("key_c1d") 
    33    ! ----------------- 
    34 # if defined key_c1d 
    35    LOGICAL, PUBLIC, PARAMETER ::   lk_trc_c1d   = .TRUE.   !: 1D pass. tracer configuration flag 
    36 # else    
    37    LOGICAL, PUBLIC, PARAMETER ::   lk_trc_c1d   = .FALSE.  !: 1D pass. tracer configuration flag 
    38 # endif 
     23   INTEGER, PUBLIC             :: jptra           !: Total number of passive tracers 
     24   INTEGER, PUBLIC             :: jp_pisces       !: number of passive tracers in PISCES model 
     25   INTEGER, PUBLIC             :: jp_cfc          !: number of CFC passive tracers  
     26   INTEGER, PUBLIC             :: jp_my_trc       !: number of passive tracers in MY_TRC model 
     27   INTEGER, PUBLIC             :: jp_bgc          !: number of passive tracers for the BGC model 
    3928 
    40    REAL(wp), PUBLIC  :: rtrn  = 0.5 * EPSILON( 1.e0 )    !: truncation value 
     29   INTEGER, PUBLIC             :: jp_dia3d        !: number of 3D diagnostic variables 
     30   INTEGER, PUBLIC             :: jp_dia2d        !: number of 2D diagnostic variables 
    4131 
    42    !!---------------------------------------------------------------------- 
    43    !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    44    !! $Id$  
    45    !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    46    !!====================================================================== 
     32   LOGICAL, PUBLIC             :: ln_pisces       !: PISCES flag  
     33   LOGICAL, PUBLIC             :: ln_age          !: AGE flag  
     34   LOGICAL, PUBLIC             :: ln_cfc11        !: CFC11 flag  
     35   LOGICAL, PUBLIC             :: ln_cfc12        !: CFC12 flag  
     36   LOGICAL, PUBLIC             :: ln_sf6          !: SF6 flag  
     37   LOGICAL, PUBLIC             :: ll_cfc          !: CFC flag  
     38   LOGICAL, PUBLIC             :: ln_c14          !: C14 flag  
     39   LOGICAL, PUBLIC             :: ln_my_trc       !: MY_TRC flag  
     40 
     41   REAL(wp), PUBLIC            :: rtrn  = 0.5 * EPSILON( 1.e0 )    !: truncation value 
     42 
    4743END MODULE par_trc 

  • trunk/NEMOGCM/NEMO/TOP_SRC/prtctl_trc.F90

    r4520 r7646  
    7070      INTEGER  ::   overlap, jn, js, sind, eind, kdir, j_id 
    7171      REAL(wp) ::   zsum, zvctl 
    72       CHARACTER (len=20), DIMENSION(jptra) ::   cl 
     72      CHARACTER (len=20), ALLOCATABLE, DIMENSION(:) ::   cl 
    7373      CHARACTER (len=10) ::   cl2 
    7474      REAL(wp), POINTER, DIMENSION(:,:,:)  :: zmask, ztab3d  
    … …  
    7676 
    7777      CALL wrk_alloc( jpi, jpj, jpk, zmask, ztab3d ) 
     78      ALLOCATE( cl(jptra) ) 
    7879      !                                      ! Arrays, scalars initialization  
    7980      overlap       = 0 
    … …  
    152153      ! 
    153154      CALL wrk_dealloc( jpi, jpj, jpk, zmask, ztab3d ) 
     155      DEALLOCATE( cl ) 
    154156      ! 
    155157   END SUBROUTINE prt_ctl_trc 

  • trunk/NEMOGCM/NEMO/TOP_SRC/trc.F90

    r6140 r7646  
    1414   USE par_oce 
    1515   USE par_trc 
    16 #if defined key_bdy 
    17    USE bdy_oce, only: nb_bdy, OBC_DATA 
    18 #endif 
     16   USE bdy_oce, only: ln_bdy, nb_bdy, OBC_DATA 
    1917    
    2018   IMPLICIT NONE 
    … …  
    2826   INTEGER, PUBLIC                                                 ::   numnat_cfg = -1   !: logical unit for the reference passive tracer namelist_top_cfg 
    2927   INTEGER, PUBLIC                                                 ::   numont     = -1   !: logical unit for the reference passive tracer namelist output output.namelist.top 
     28   INTEGER, PUBLIC                                                 ::   numtrc_ref = -1   !: logical unit for the reference passive tracer namelist_top_ref 
     29   INTEGER, PUBLIC                                                 ::   numtrc_cfg = -1   !: logical unit for the reference passive tracer namelist_top_cfg 
     30   INTEGER, PUBLIC                                                 ::   numonr     = -1   !: logical unit for the reference passive tracer namelist output output.namelist.top 
    3031   INTEGER, PUBLIC                                                 ::   numstr        !: logical unit for tracer statistics 
    3132   INTEGER, PUBLIC                                                 ::   numrtr        !: logical unit for trc restart (read ) 
    … …  
    6869   CHARACTER(len = 256), PUBLIC                                    ::  cn_trcrst_outdir  !: restart output directory 
    6970   REAL(wp)            , PUBLIC                                    ::  rdttrc         !: passive tracer time step 
    70    LOGICAL             , PUBLIC                                    ::  ln_top_euler  !: boolean term for euler integration  
     71   REAL(wp)            , PUBLIC                                    ::  r2dttrc        !: = 2*rdttrc except at nit000 (=rdttrc) if neuler=0 
     72   LOGICAL             , PUBLIC                                    ::  ln_top_euler   !: boolean term for euler integration  
    7173   LOGICAL             , PUBLIC                                    ::  ln_trcdta      !: Read inputs data from files 
    7274   LOGICAL             , PUBLIC                                    ::  ln_trcdmp      !: internal damping flag 
    7375   LOGICAL             , PUBLIC                                    ::  ln_trcdmp_clo  !: internal damping flag on closed seas 
    74    INTEGER             , PUBLIC                                    ::  nittrc000       !: first time step of passive tracers model 
     76   INTEGER             , PUBLIC                                    ::  nittrc000      !: first time step of passive tracers model 
    7577   LOGICAL             , PUBLIC                                    ::  l_trcdm2dc     !: Diurnal cycle for TOP 
    7678 
    … …  
    8385   END TYPE 
    8486 
    85    REAL(wp), DIMENSION(jptra), PUBLIC         :: trc_ice_ratio, & ! ice-ocean tracer ratio 
    86                                                  trc_ice_prescr   ! prescribed ice trc cc 
    87    CHARACTER(len=2), DIMENSION(jptra), PUBLIC :: cn_trc_o ! choice of ocean tracer cc 
     87   REAL(wp)        , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)  :: trc_ice_ratio      ! ice-ocean tracer ratio 
     88   REAL(wp)        , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)  :: trc_ice_prescr     ! prescribed ice trc cc 
     89   CHARACTER(len=2), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)  :: cn_trc_o ! choice of ocean tracer cc 
     90 
    8891 
    8992   !! information for outputs 
    … …  
    9497       CHARACTER(len = 20)  :: clunit   !: unit 
    9598       LOGICAL              :: llinit   !: read in a file or not 
    96 #if defined  key_my_trc 
    9799       LOGICAL              :: llsbc   !: read in a file or not 
    98100       LOGICAL              :: llcbc   !: read in a file or not 
    99101       LOGICAL              :: llobc   !: read in a file or not 
    100 #endif 
    101        LOGICAL              :: llsave   !: save the tracer or not 
    102102   END TYPE PTRACER 
     103 
    103104   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ctrcnm         !: tracer name  
    104105   CHARACTER(len = 80), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ctrcln         !: trccer field long name 
    105106   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ctrcun         !: tracer unit 
    106    LOGICAL            , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ln_trc_wri     !: save the tracer or not 
    107107 
    108108   TYPE, PUBLIC :: DIAG                                                               !: passive trcacer ddditional diagnostic type 
    … …  
    112112   END TYPE DIAG 
    113113 
     114   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  trc3d          !: 3D diagnostics for tracers 
     115   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  trc2d          !: 2D diagnostics for tracers 
     116 
    114117   !! information for inputs 
    115118   !! -------------------------------------------------- 
    116    LOGICAL            , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ln_trc_ini     !: Initialisation from data input file 
    117    LOGICAL            , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ln_trc_obc     !: Use open boundary condition data 
    118    LOGICAL            , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ln_trc_sbc     !: Use surface boundary condition data 
    119    LOGICAL            , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ln_trc_cbc     !: Use coastal boundary condition data 
    120  
    121    !! additional 2D/3D outputs namelist 
    122    !! -------------------------------------------------- 
    123    REAL(wp)           , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,  :) ::   trc2d         !: additional 2d outputs array  
    124    REAL(wp)           , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   trc3d         !: additional 3d outputs array  
    125    CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   ctrc2d        !: 2d field short name 
    126    CHARACTER(len = 80), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   ctrc2l        !: 2d field long name 
    127    CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   ctrc2u        !: 2d field unit 
    128    CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   ctrc3d        !: 3d field short name 
    129    CHARACTER(len = 80), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   ctrc3l        !: 3d field long name 
    130    CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   ctrc3u        !: 3d field unit 
    131    LOGICAL            , PUBLIC                                        ::  ln_diatrc      !: boolean term for additional diagnostic 
    132    INTEGER            , PUBLIC                                        ::  nn_writedia    !: frequency of additional outputs 
    133  
    134    !! Biological trends 
    135    !! ----------------- 
    136    LOGICAL            , PUBLIC                                        ::  ln_diabio      !: boolean term for biological diagnostic 
    137    INTEGER            , PUBLIC                                        ::  nn_writebio    !: frequency of biological outputs 
    138    REAL(wp)           , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  trbio          !: biological trends 
    139    CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  ctrbio         !: bio field short name 
    140    CHARACTER(len = 80), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  ctrbil         !: bio field long name 
    141    CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  ctrbiu         !: bio field unit 
     119   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ln_trc_ini     !: Initialisation from data input file 
     120   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ln_trc_obc     !: Use open boundary condition data 
     121   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ln_trc_sbc     !: Use surface boundary condition data 
     122   LOGICAL , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ln_trc_cbc     !: Use coastal boundary condition data 
     123   LOGICAL , PUBLIC                                     ::  ln_rnf_ctl     !: remove runoff dilution on tracers 
     124   REAL(wp), PUBLIC                                     ::  rn_bc_time     !: Time scaling factor for SBC and CBC data (seconds in a day) 
     125 
    142126 
    143127   !! variables to average over physics over passive tracer sub-steps. 
    … …  
    189173# endif 
    190174   ! 
    191 #if defined key_bdy 
    192175   CHARACTER(len=20), PUBLIC, ALLOCATABLE,  SAVE,  DIMENSION(:)   ::  cn_trc_dflt          ! Default OBC condition for all tracers 
    193176   CHARACTER(len=20), PUBLIC, ALLOCATABLE,  SAVE,  DIMENSION(:)   ::  cn_trc               ! Choice of boundary condition for tracers 
    … …  
    195178   ! External data structure of BDY for TOP. Available elements: cn_obc, ll_trc, trcnow, dmp 
    196179   TYPE(OBC_DATA),    PUBLIC, ALLOCATABLE, DIMENSION(:,:), TARGET ::  trcdta_bdy           !: bdy external data (local process) 
    197 #endif 
    198180   ! 
    199181 
    … …  
    211193      USE lib_mpp, ONLY: ctl_warn 
    212194      !!------------------------------------------------------------------- 
     195      INTEGER :: ierr(4) 
     196      !!------------------------------------------------------------------- 
     197      ierr(:) = 0 
    213198      ! 
    214199      ALLOCATE( trn(jpi,jpj,jpk,jptra), trb(jpi,jpj,jpk,jptra), tra(jpi,jpj,jpk,jptra),       &   
    … …  
    216201         &      gtru (jpi,jpj,jptra)  , gtrv (jpi,jpj,jptra)                          ,       & 
    217202         &      gtrui(jpi,jpj,jptra)  , gtrvi(jpi,jpj,jptra)                          ,       & 
     203         &      trc_ice_ratio(jptra)  , trc_ice_prescr(jptra) , cn_trc_o(jptra)       ,       & 
    218204         &      sbc_trc_b(jpi,jpj,jptra), sbc_trc(jpi,jpj,jptra)                      ,       &   
    219          &      cvol(jpi,jpj,jpk)     , trai(jptra)                                   ,       & 
    220          &      ctrcnm(jptra)         , ctrcln(jptra)         , ctrcun(jptra)         ,       &  
    221          &      ln_trc_ini(jptra)     , ln_trc_wri(jptra)     , qsr_mean(jpi,jpj)     ,       & 
    222 #if defined key_my_trc 
     205         &      cvol(jpi,jpj,jpk)     , trai(jptra)           , qsr_mean(jpi,jpj)     ,       & 
     206         &      ctrcnm(jptra)         , ctrcln(jptra)         , ctrcun(jptra)         ,       & 
     207         &      ln_trc_ini(jptra)     ,                                                       & 
    223208         &      ln_trc_sbc(jptra)     , ln_trc_cbc(jptra)     , ln_trc_obc(jptra)     ,       & 
    224 #endif 
    225 #if defined key_bdy 
    226          &      cn_trc_dflt(nb_bdy)   , cn_trc(nb_bdy)        , nn_trcdmp_bdy(nb_bdy) ,       & 
     209         &      STAT = ierr(1)  ) 
     210      ! 
     211      IF ( ln_bdy ) THEN 
     212         ALLOCATE( cn_trc_dflt(nb_bdy)   , cn_trc(nb_bdy)     , nn_trcdmp_bdy(nb_bdy) ,       & 
    227213         &      trcdta_bdy(jptra,nb_bdy)                                              ,       & 
    228 #endif 
    229          &      STAT = trc_alloc  ) 
    230  
     214         &      STAT = ierr(2)  ) 
     215      ENDIF 
     216      ! 
     217      IF (jp_dia3d > 0 ) ALLOCATE( trc3d(jpi,jpj,jpk,jp_dia3d), STAT = ierr(3) ) 
     218      ! 
     219      IF (jp_dia2d > 0 ) ALLOCATE( trc2d(jpi,jpj,jpk,jp_dia2d), STAT = ierr(4) ) 
     220      !  
     221      trc_alloc = MAXVAL( ierr ) 
    231222      IF( trc_alloc /= 0 )   CALL ctl_warn('trc_alloc: failed to allocate arrays') 
    232223      ! 

  • trunk/NEMOGCM/NEMO/TOP_SRC/trcbc.F90

    r6140 r7646  
    44   !! TOP :  module for passive tracer boundary conditions 
    55   !!===================================================================== 
    6    !! History :  3.5 !  2014-04  (M. Vichi, T. Lovato)  Original 
    7    !!            3.6 !  2015-03  (T . Lovato) Revision and BDY support 
     6   !! History :  3.5 !  2014 (M. Vichi, T. Lovato)  Original 
     7   !!            3.6 !  2015 (T . Lovato) Revision and BDY support 
     8   !!            4.0 !  2016 (T . Lovato) Include application of sbc and cbc 
    89   !!---------------------------------------------------------------------- 
    910#if defined key_top 
    … …  
    1112   !!   'key_top'                                                TOP model  
    1213   !!---------------------------------------------------------------------- 
    13    !!   trc_bc       : read and time interpolated tracer Boundary Conditions 
     14   !!   trc_bc       :  Apply tracer Boundary Conditions 
    1415   !!---------------------------------------------------------------------- 
    1516   USE par_trc       !  passive tracers parameters 
    … …  
    1920   USE lib_mpp       !  MPP library 
    2021   USE fldread       !  read input fields 
    21 #if defined key_bdy 
    22    USE bdy_oce, only: nb_bdy , idx_bdy, ln_coords_file, rn_time_dmp, rn_time_dmp_out 
    23 #endif 
     22   USE bdy_oce,  ONLY: ln_bdy, nb_bdy , idx_bdy, ln_coords_file, rn_time_dmp, rn_time_dmp_out 
    2423 
    2524   IMPLICIT NONE 
    2625   PRIVATE 
    2726 
    28    PUBLIC   trc_bc_init    ! called in trcini.F90  
    29    PUBLIC   trc_bc_read    ! called in trcstp.F90 or within 
     27   PUBLIC   trc_bc         ! called in trcstp.F90 or within TOP modules 
     28   PUBLIC   trc_bc_ini     ! called in trcini.F90  
    3029 
    3130   INTEGER  , SAVE, PUBLIC                             :: nb_trcobc    ! number of tracers with open BC 
    … …  
    4342   TYPE(MAP_POINTER), ALLOCATABLE, DIMENSION(:) :: nbmap_ptr   ! array of pointers to nbmap 
    4443 
    45    !!---------------------------------------------------------------------- 
    46    !! NEMO/OPA 3.6 , NEMO Consortium (2015) 
     44   !! * Substitutions 
     45#  include "vectopt_loop_substitute.h90" 
     46   !!---------------------------------------------------------------------- 
     47   !! NEMO/TOP 4.0 , NEMO Consortium (2016) 
    4748   !! $Id$ 
    4849   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    5051CONTAINS 
    5152 
    52    SUBROUTINE trc_bc_init( ntrc ) 
     53   SUBROUTINE trc_bc_ini( ntrc ) 
    5354      !!---------------------------------------------------------------------- 
    54       !!                   ***  ROUTINE trc_bc_init  *** 
     55      !!                   ***  ROUTINE trc_bc_ini  *** 
    5556      !!                     
    5657      !! ** Purpose :   initialisation of passive tracer BC data  
    … …  
    7778      REAL(wp)   , DIMENSION(jpmaxtrc) :: rn_trcfac    ! multiplicative factor for tracer values 
    7879      !! 
    79       NAMELIST/namtrc_bc/ cn_dir_sbc, cn_dir_cbc, cn_dir_obc, sn_trcobc, rn_trofac, sn_trcsbc, rn_trsfac, sn_trccbc, rn_trcfac 
    80 #if defined key_bdy 
     80      NAMELIST/namtrc_bc/ cn_dir_obc, sn_trcobc, rn_trofac, cn_dir_sbc, sn_trcsbc, rn_trsfac, &  
     81                        & cn_dir_cbc, sn_trccbc, rn_trcfac, ln_rnf_ctl, rn_bc_time 
    8182      NAMELIST/namtrc_bdy/ cn_trc_dflt, cn_trc, nn_trcdmp_bdy 
    82 #endif 
     83 
    8384      !!---------------------------------------------------------------------- 
    84       IF( nn_timing == 1 )  CALL timing_start('trc_bc_init') 
     85      IF( nn_timing == 1 )  CALL timing_start('trc_bc_ini') 
    8586      ! 
    8687      IF( lwp ) THEN 
    8788         WRITE(numout,*) ' ' 
    88          WRITE(numout,*) 'trc_bc_init : Tracers Boundary Conditions (BC)' 
     89         WRITE(numout,*) 'trc_bc_ini : Tracers Boundary Conditions (BC)' 
    8990         WRITE(numout,*) '~~~~~~~~~~~ ' 
    9091      ENDIF 
    … …  
    9394      ALLOCATE( slf_i(ntrc), STAT=ierr0 ) 
    9495      IF( ierr0 > 0 ) THEN 
    95          CALL ctl_stop( 'trc_bc_init: unable to allocate local slf_i' )   ;   RETURN 
     96         CALL ctl_stop( 'trc_bc_ini: unable to allocate local slf_i' )   ;   RETURN 
    9697      ENDIF 
    9798 
    … …  
    99100      ALLOCATE( n_trc_indobc(ntrc), STAT=ierr0 ) 
    100101      IF( ierr0 > 0 ) THEN 
    101          CALL ctl_stop( 'trc_bc_init: unable to allocate n_trc_indobc' )   ;   RETURN 
     102         CALL ctl_stop( 'trc_bc_ini: unable to allocate n_trc_indobc' )   ;   RETURN 
    102103      ENDIF 
    103104      nb_trcobc      = 0 
    … …  
    106107      ALLOCATE( n_trc_indsbc(ntrc), STAT=ierr0 ) 
    107108      IF( ierr0 > 0 ) THEN 
    108          CALL ctl_stop( 'trc_bc_init: unable to allocate n_trc_indsbc' )   ;   RETURN 
     109         CALL ctl_stop( 'trc_bc_ini: unable to allocate n_trc_indsbc' )   ;   RETURN 
    109110      ENDIF 
    110111      nb_trcsbc      = 0 
    … …  
    113114      ALLOCATE( n_trc_indcbc(ntrc), STAT=ierr0 ) 
    114115      IF( ierr0 > 0 ) THEN 
    115          CALL ctl_stop( 'trc_bc_init: unable to allocate n_trc_indcbc' )   ;   RETURN 
     116         CALL ctl_stop( 'trc_bc_ini: unable to allocate n_trc_indcbc' )   ;   RETURN 
    116117      ENDIF 
    117118      nb_trccbc      = 0 
    … …  
    128129      IF(lwm) WRITE ( numont, namtrc_bc ) 
    129130 
    130 #if defined key_bdy 
    131       REWIND( numnat_ref )              ! Namelist namtrc_bc in reference namelist : Passive tracer data structure 
    132       READ  ( numnat_ref, namtrc_bdy, IOSTAT = ios, ERR = 903) 
    133 903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bdy in reference namelist', lwp ) 
    134  
    135       REWIND( numnat_cfg )              ! Namelist namtrc_bc in configuration namelist : Passive tracer data structure 
    136       READ  ( numnat_cfg, namtrc_bdy, IOSTAT = ios, ERR = 904 ) 
    137 904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bdy in configuration namelist', lwp ) 
    138       IF(lwm) WRITE ( numont, namtrc_bdy ) 
    139       ! setup up preliminary informations for BDY structure 
    140       DO jn = 1, ntrc 
    141          DO ib = 1, nb_bdy 
    142             ! Set type of obc in BDY data structure (around here we may plug user override of obc type from nml) 
    143             IF ( ln_trc_obc(jn) ) THEN 
    144                trcdta_bdy(jn,ib)%cn_obc = TRIM( cn_trc(ib) ) 
    145             ELSE 
    146                trcdta_bdy(jn,ib)%cn_obc = TRIM( cn_trc_dflt(ib) ) 
    147             ENDIF 
    148             ! set damping use in BDY data structure 
    149             trcdta_bdy(jn,ib)%dmp = .false. 
    150             IF(nn_trcdmp_bdy(ib) .EQ. 1 .AND. ln_trc_obc(jn) ) trcdta_bdy(jn,ib)%dmp = .true. 
    151             IF(nn_trcdmp_bdy(ib) .EQ. 2 ) trcdta_bdy(jn,ib)%dmp = .true. 
    152             IF(trcdta_bdy(jn,ib)%cn_obc == 'frs' .AND. nn_trcdmp_bdy(ib) .NE. 0 )  & 
    153                 & CALL ctl_stop( 'Use FRS OR relaxation' ) 
    154             IF (nn_trcdmp_bdy(ib) .LT. 0 .OR. nn_trcdmp_bdy(ib) .GT. 2)            & 
    155                 & CALL ctl_stop( 'Not a valid option for nn_trcdmp_bdy. Allowed: 0,1,2.' ) 
     131      IF ( ln_bdy ) THEN 
     132         REWIND( numnat_ref )              ! Namelist namtrc_bdy in reference namelist : Passive tracer data structure 
     133         READ  ( numnat_ref, namtrc_bdy, IOSTAT = ios, ERR = 903) 
     134903      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bdy in reference namelist', lwp ) 
     135 
     136         REWIND( numnat_cfg )              ! Namelist namtrc_bdy in configuration namelist : Passive tracer data structure 
     137         READ  ( numnat_cfg, namtrc_bdy, IOSTAT = ios, ERR = 904 ) 
     138904      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_bdy in configuration namelist', lwp ) 
     139         IF(lwm) WRITE ( numont, namtrc_bdy ) 
     140       
     141         ! setup up preliminary informations for BDY structure 
     142         DO jn = 1, ntrc 
     143            DO ib = 1, nb_bdy 
     144               ! Set type of obc in BDY data structure (around here we may plug user override of obc type from nml) 
     145               IF ( ln_trc_obc(jn) ) THEN 
     146                  trcdta_bdy(jn,ib)%cn_obc = TRIM( cn_trc(ib) ) 
     147               ELSE 
     148                  trcdta_bdy(jn,ib)%cn_obc = TRIM( cn_trc_dflt(ib) ) 
     149               ENDIF 
     150               ! set damping use in BDY data structure 
     151               trcdta_bdy(jn,ib)%dmp = .false. 
     152               IF(nn_trcdmp_bdy(ib) .EQ. 1 .AND. ln_trc_obc(jn) ) trcdta_bdy(jn,ib)%dmp = .true. 
     153               IF(nn_trcdmp_bdy(ib) .EQ. 2 ) trcdta_bdy(jn,ib)%dmp = .true. 
     154               IF(trcdta_bdy(jn,ib)%cn_obc == 'frs' .AND. nn_trcdmp_bdy(ib) .NE. 0 )  & 
     155                   & CALL ctl_stop( 'Use FRS OR relaxation' ) 
     156               IF (nn_trcdmp_bdy(ib) .LT. 0 .OR. nn_trcdmp_bdy(ib) .GT. 2)            & 
     157                   & CALL ctl_stop( 'Not a valid option for nn_trcdmp_bdy. Allowed: 0,1,2.' ) 
     158            ENDDO 
    156159         ENDDO 
    157       ENDDO 
    158  
    159 #else 
    160       ! Force all tracers OBC to false if bdy not used 
    161       ln_trc_obc = .false. 
    162 #endif 
     160      ELSE 
     161         ! Force all tracers OBC to false if bdy not used 
     162         ln_trc_obc = .false. 
     163      ENDIF 
     164 
    163165      ! compose BC data indexes 
    164166      DO jn = 1, ntrc 
    … …  
    188190         WRITE(numout,*) ' ' 
    189191         WRITE(numout,'(a,i3)') '   Total tracers to be initialized with COASTAL BCs data:', nb_trccbc 
    190          IF ( nb_trccbc > 0 ) THEN 
     192         IF( nb_trccbc > 0 ) THEN 
    191193            WRITE(numout,*) '   #trc        NAME        Boundary     Mult.Fact. ' 
    192194            DO jn = 1, ntrc 
    … …  
    195197         ENDIF 
    196198         WRITE(numout,'(2a)') '   COASTAL BC data repository : ', TRIM(cn_dir_cbc) 
    197  
     199         IF( .NOT.ln_rnf .OR. .NOT.ln_linssh ) ln_rnf_ctl = .FALSE. 
     200         IF( ln_rnf_ctl )  WRITE(numout,'(a)') ' -> Remove runoff dilution effect on tracers with absent river load (ln_rnf_ctl = .TRUE.)'  
    198201         WRITE(numout,*) ' ' 
    199202         WRITE(numout,'(a,i3)') '   Total tracers to be initialized with OPEN BCs data:', nb_trcobc 
    200 #if defined key_bdy 
    201          IF ( nb_trcobc > 0 ) THEN 
     203 
     204         IF( ln_bdy .AND. nb_trcobc > 0 ) THEN 
    202205            WRITE(numout,*) '   #trc        NAME        Boundary     Mult.Fact.   OBC Settings' 
    203206            DO jn = 1, ntrc 
    204                IF ( ln_trc_obc(jn) )  WRITE(numout, 9001) jn, TRIM( sn_trcobc(jn)%clvar ), 'OBC', rn_trofac(jn), (trcdta_bdy(jn,ib)%cn_obc,ib=1,nb_bdy) 
    205                IF ( .NOT. ln_trc_obc(jn) )  WRITE(numout, 9002) jn, 'Set data to IC and use default condition', (trcdta_bdy(jn,ib)%cn_obc,ib=1,nb_bdy) 
     207               IF( ln_trc_obc(jn) )  WRITE(numout, 9001) jn, TRIM( sn_trcobc(jn)%clvar ), 'OBC', rn_trofac(jn), (trcdta_bdy(jn,ib)%cn_obc,ib=1,nb_bdy) 
     208               IF( .NOT. ln_trc_obc(jn) )  WRITE(numout, 9002) jn, 'Set data to IC and use default condition', (trcdta_bdy(jn,ib)%cn_obc,ib=1,nb_bdy) 
    206209            ENDDO 
    207210            WRITE(numout,*) ' ' 
    208211            DO ib = 1, nb_bdy 
    209                 IF (nn_trcdmp_bdy(ib) .EQ. 0) WRITE(numout,9003) '   Boundary ',ib,' -> NO damping of tracers' 
    210                 IF (nn_trcdmp_bdy(ib) .EQ. 1) WRITE(numout,9003) '   Boundary ',ib,' -> damping ONLY for tracers with external data provided' 
    211                 IF (nn_trcdmp_bdy(ib) .EQ. 2) WRITE(numout,9003) '   Boundary ',ib,' -> damping of ALL tracers' 
    212                 IF (nn_trcdmp_bdy(ib) .GT. 0) THEN 
     212                IF(nn_trcdmp_bdy(ib) .EQ. 0) WRITE(numout,9003) '   Boundary ',ib,' -> NO damping of tracers' 
     213                IF(nn_trcdmp_bdy(ib) .EQ. 1) WRITE(numout,9003) '   Boundary ',ib,' -> damping ONLY for tracers with external data provided' 
     214                IF(nn_trcdmp_bdy(ib) .EQ. 2) WRITE(numout,9003) '   Boundary ',ib,' -> damping of ALL tracers' 
     215                IF(nn_trcdmp_bdy(ib) .GT. 0) THEN 
    213216                   WRITE(numout,9003) '     USE damping parameters from nambdy for boundary ', ib,' : ' 
    214217                   WRITE(numout,'(a,f10.2,a)') '     - Inflow damping time scale  : ',rn_time_dmp(ib),' days' 
    … …  
    217220            ENDDO 
    218221         ENDIF 
    219 #endif 
     222 
    220223         WRITE(numout,'(2a)') '   OPEN BC data repository : ', TRIM(cn_dir_obc) 
    221224      ENDIF 
    … …  
    225228 
    226229      ! 
    227 #if defined key_bdy 
    228230      ! OPEN Lateral boundary conditions 
    229       IF( nb_trcobc > 0 ) THEN  
     231      IF( ln_bdy .AND. nb_trcobc > 0 ) THEN  
    230232         ALLOCATE ( sf_trcobc(nb_trcobc), rf_trofac(nb_trcobc), nbmap_ptr(nb_trcobc), STAT=ierr1 ) 
    231233         IF( ierr1 > 0 ) THEN 
    232             CALL ctl_stop( 'trc_bc_init: unable to allocate sf_trcobc structure' )   ;   RETURN 
     234            CALL ctl_stop( 'trc_bc_ini: unable to allocate sf_trcobc structure' )   ;   RETURN 
    233235         ENDIF 
    234236 
    … …  
    248250                  IF( sn_trcobc(jn)%ln_tint )  ALLOCATE( sf_trcobc(jl)%fdta(nblen,1,jpk,2) , STAT=ierr3 ) 
    249251                  IF( ierr2 + ierr3 > 0 ) THEN 
    250                     CALL ctl_stop( 'trc_bc_init : unable to allocate passive tracer OBC data arrays' )   ;   RETURN 
     252                    CALL ctl_stop( 'trc_bc_ini : unable to allocate passive tracer OBC data arrays' )   ;   RETURN 
    251253                  ENDIF 
    252254                  trcdta_bdy(jn,ib)%trc => sf_trcobc(jl)%fnow(:,1,:) 
    … …  
    270272         ENDDO 
    271273 
    272          CALL fld_fill( sf_trcobc, slf_i, cn_dir_obc, 'trc_bc_init', 'Passive tracer OBC data', 'namtrc_bc' ) 
    273       ENDIF 
    274 #endif 
     274         CALL fld_fill( sf_trcobc, slf_i, cn_dir_obc, 'trc_bc_ini', 'Passive tracer OBC data', 'namtrc_bc' ) 
     275      ENDIF 
     276 
    275277      ! SURFACE Boundary conditions 
    276278      IF( nb_trcsbc > 0 ) THEN       !  allocate only if the number of tracer to initialise is greater than zero 
    277279         ALLOCATE( sf_trcsbc(nb_trcsbc), rf_trsfac(nb_trcsbc), STAT=ierr1 ) 
    278280         IF( ierr1 > 0 ) THEN 
    279             CALL ctl_stop( 'trc_bc_init: unable to allocate  sf_trcsbc structure' )   ;   RETURN 
     281            CALL ctl_stop( 'trc_bc_ini: unable to allocate  sf_trcsbc structure' )   ;   RETURN 
    280282         ENDIF 
    281283         ! 
    … …  
    288290               IF( sn_trcsbc(jn)%ln_tint )  ALLOCATE( sf_trcsbc(jl)%fdta(jpi,jpj,1,2) , STAT=ierr3 ) 
    289291               IF( ierr2 + ierr3 > 0 ) THEN 
    290                  CALL ctl_stop( 'trc_bc_init : unable to allocate passive tracer SBC data arrays' )   ;   RETURN 
     292                 CALL ctl_stop( 'trc_bc_ini : unable to allocate passive tracer SBC data arrays' )   ;   RETURN 
    291293               ENDIF 
    292294            ENDIF 
    … …  
    294296         ENDDO 
    295297         !                         ! fill sf_trcsbc with slf_i and control print 
    296          CALL fld_fill( sf_trcsbc, slf_i, cn_dir_sbc, 'trc_bc_init', 'Passive tracer SBC data', 'namtrc_bc' ) 
     298         CALL fld_fill( sf_trcsbc, slf_i, cn_dir_sbc, 'trc_bc_ini', 'Passive tracer SBC data', 'namtrc_bc' ) 
    297299         ! 
    298300      ENDIF 
    … …  
    319321         ENDDO 
    320322         !                         ! fill sf_trccbc with slf_i and control print 
    321          CALL fld_fill( sf_trccbc, slf_i, cn_dir_cbc, 'trc_bc_init', 'Passive tracer CBC data', 'namtrc_bc' ) 
     323         CALL fld_fill( sf_trccbc, slf_i, cn_dir_cbc, 'trc_bc_ini', 'Passive tracer CBC data', 'namtrc_bc' ) 
    322324         ! 
    323325      ENDIF 
    324326      ! 
    325327      DEALLOCATE( slf_i )          ! deallocate local field structure 
    326       IF( nn_timing == 1 )  CALL timing_stop('trc_bc_init') 
    327       ! 
    328    END SUBROUTINE trc_bc_init 
    329  
    330  
    331    SUBROUTINE trc_bc_read(kt, jit) 
     328      IF( nn_timing == 1 )  CALL timing_stop('trc_bc_ini') 
     329      ! 
     330   END SUBROUTINE trc_bc_ini 
     331 
     332 
     333   SUBROUTINE trc_bc(kt, jit) 
    332334      !!---------------------------------------------------------------------- 
    333       !!                   ***  ROUTINE trc_bc_init  *** 
     335      !!                   ***  ROUTINE trc_bc  *** 
    334336      !! 
    335       !! ** Purpose :  Read passive tracer Boundary Conditions data 
     337      !! ** Purpose :  Apply Boundary Conditions data to tracers 
    336338      !! 
    337       !! ** Method  :  Read BC inputs and update data structures using fldread 
     339      !! ** Method  :  1) Read BC inputs and update data structures using fldread 
     340      !!               2) Apply Boundary Conditions to tracers 
    338341      !!               
    339342      !!---------------------------------------------------------------------- 
    … …  
    341344       
    342345      !! * Arguments 
    343       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
     346      INTEGER, INTENT( in ) ::   kt              ! ocean time-step index 
    344347      INTEGER, INTENT( in ), OPTIONAL ::   jit   ! subcycle time-step index (for timesplitting option) 
     348      !! 
     349      INTEGER  :: ji, jj, jk, jn, jl             ! Loop index 
     350      REAL(wp) :: zfact, zrnf 
    345351      !!--------------------------------------------------------------------- 
    346352      ! 
    347       IF( nn_timing == 1 )  CALL timing_start('trc_bc_read') 
     353      IF( nn_timing == 1 )  CALL timing_start('trc_bc') 
    348354 
    349355      IF( kt == nit000 .AND. lwp) THEN 
    350356         WRITE(numout,*) 
    351          WRITE(numout,*) 'trc_bc_read : Surface boundary conditions for passive tracers.' 
     357         WRITE(numout,*) 'trc_bc : Surface boundary conditions for passive tracers.' 
    352358         WRITE(numout,*) '~~~~~~~~~~~ ' 
    353359      ENDIF 
    354360 
     361      ! 1. Update Boundary conditions data 
    355362      IF ( PRESENT(jit) ) THEN  
    356363 
    … …  
    395402      ENDIF 
    396403 
    397       ! 
    398       IF( nn_timing == 1 )  CALL timing_stop('trc_bc_read') 
    399       ! 
    400    END SUBROUTINE trc_bc_read 
     404      ! 2. Apply Boundary conditions data 
     405      !  
     406      DO jn = 1 , jptra 
     407         ! 
     408         ! Remove river dilution for tracers with absent river load 
     409         IF ( ln_rnf_ctl .AND. .NOT. ln_trc_cbc(jn) ) THEN 
     410            DO jj = 2, jpj 
     411               DO ji = fs_2, fs_jpim1 
     412                  DO jk = 1, nk_rnf(ji,jj) 
     413                     zrnf = (rnf(ji,jj) + rnf_b(ji,jj)) * 0.5_wp * r1_rau0 / h_rnf(ji,jj) 
     414                     tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn)  + (trn(ji,jj,jk,jn) * zrnf) 
     415                  ENDDO 
     416               ENDDO 
     417            ENDDO 
     418         ENDIF 
     419           
     420         ! OPEN boundary conditions: trcbdy is called in trcnxt ! 
     421 
     422         ! SURFACE boundary conditions 
     423         IF (ln_trc_sbc(jn)) THEN 
     424            jl = n_trc_indsbc(jn) 
     425            DO jj = 2, jpj 
     426               DO ji = fs_2, fs_jpim1   ! vector opt. 
     427                  zfact = 1. / ( e3t_n(ji,jj,1) * rn_bc_time ) 
     428                  tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + rf_trsfac(jl) * sf_trcsbc(jl)%fnow(ji,jj,1) * zfact 
     429               END DO 
     430            END DO 
     431         END IF 
     432 
     433         ! COASTAL boundary conditions 
     434         IF ( ln_rnf .AND. ln_trc_cbc(jn)) THEN 
     435            jl = n_trc_indcbc(jn) 
     436            DO jj = 2, jpj 
     437               DO ji = fs_2, fs_jpim1   ! vector opt. 
     438                  DO jk = 1, nk_rnf(ji,jj) 
     439                     zfact = rn_rfact / ( e1e2t(ji,jj) * h_rnf(ji,jj) * rn_bc_time )  
     440                     tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + rf_trcfac(jl) * sf_trccbc(jl)%fnow(ji,jj,1) * zfact 
     441                  ENDDO 
     442               END DO 
     443            END DO 
     444         END IF 
     445         !                                                       ! =========== 
     446      END DO                                                     ! tracer loop 
     447      !                                                          ! =========== 
     448      ! 
     449      IF( nn_timing == 1 )  CALL timing_stop('trc_bc') 
     450      ! 
     451   END SUBROUTINE trc_bc 
    401452 
    402453#else 
    … …  
    406457CONTAINS 
    407458 
    408    SUBROUTINE trc_bc_init( ntrc )        ! Empty routine 
     459   SUBROUTINE trc_bc_ini( ntrc )        ! Empty routine 
    409460      INTEGER,INTENT(IN) :: ntrc                           ! number of tracers 
    410       WRITE(*,*) 'trc_bc_init: You should not have seen this print! error?', kt 
    411    END SUBROUTINE trc_bc_init 
    412  
    413    SUBROUTINE trc_bc_read( kt )        ! Empty routine 
    414       WRITE(*,*) 'trc_bc_read: You should not have seen this print! error?', kt 
    415    END SUBROUTINE trc_bc_read 
     461      WRITE(*,*) 'trc_bc_ini: You should not have seen this print! error?', kt 
     462   END SUBROUTINE trc_bc_ini 
     463 
     464   SUBROUTINE trc_bc( kt )        ! Empty routine 
     465      WRITE(*,*) 'trc_bc: You should not have seen this print! error?', kt 
     466   END SUBROUTINE trc_bc 
    416467#endif 
    417468 

  • trunk/NEMOGCM/NEMO/TOP_SRC/trcbdy.F90

    r6140 r7646  
    99   !!            3.5  !  2012     (S. Mocavero, I. Epicoco) Optimization of BDY communications 
    1010   !!            3.6  !  2015     (T. Lovato) Adapt BDY for tracers in TOP component 
     11   !!            4.0  !  2016     (T. Lovato) Generalize OBC structure 
    1112   !!---------------------------------------------------------------------- 
    12 #if defined key_bdy && key_top 
     13#if defined key_top 
    1314   !!---------------------------------------------------------------------- 
    14    !!   'key_bdy'                     Unstructured Open Boundary Conditions 
    15    !!---------------------------------------------------------------------- 
    16    !!   trc_bdy            : Apply open boundary conditions to T and S 
    17    !!   trc_bdy_frs        : Apply Flow Relaxation Scheme 
     15   !!   trc_bdy       : Apply open boundary conditions & damping to tracers 
    1816   !!---------------------------------------------------------------------- 
    1917   USE timing                       ! Timing 
    … …  
    2422   USE lbclnk                       ! ocean lateral boundary conditions (or mpp link) 
    2523   USE in_out_manager               ! I/O manager 
    26    USE bdy_oce, only: idx_bdy, OBC_INDEX, BDYTMASK, lk_bdy       ! ocean open boundary conditions 
     24   USE bdy_oce, only: idx_bdy       ! ocean open boundary conditions 
    2725 
    2826   IMPLICIT NONE 
    … …  
    3331 
    3432   !!---------------------------------------------------------------------- 
    35    !! NEMO/OPA 3.6 , NEMO Consortium (2015) 
     33   !! NEMO/OPA 4.0 , NEMO Consortium (2016) 
    3634   !! $Id$  
    3735   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    4341      !!                  ***  SUBROUTINE trc_bdy  *** 
    4442      !! 
    45       !! ** Purpose : - Apply open boundary conditions for tracers in TOP component 
    46       !!                and scale the tracer data 
     43      !! ** Purpose : - Apply open boundary conditions for TOP tracers 
    4744      !! 
    4845      !!---------------------------------------------------------------------- 
    4946      INTEGER, INTENT( in ) :: kt     ! Main time step counter 
    5047      !! 
    51       INTEGER               :: ib_bdy, jn ! Loop indeces 
     48      INTEGER                           :: ib_bdy ,jn ,igrd ! Loop indeces 
     49      REAL(wp), POINTER, DIMENSION(:,:) ::  ztrc 
     50      REAL(wp), POINTER                 ::  zfac 
    5251      !!---------------------------------------------------------------------- 
    5352      ! 
    5453      IF( nn_timing == 1 ) CALL timing_start('trc_bdy') 
    5554      ! 
    56       DO jn = 1, jptra 
    57          DO ib_bdy=1, nb_bdy 
    58  
    59             SELECT CASE( trcdta_bdy(jn,ib_bdy)%cn_obc ) 
    60             CASE('none') 
    61                CYCLE 
    62             CASE('frs') 
    63                CALL bdy_trc_frs( jn, idx_bdy(ib_bdy), trcdta_bdy(jn,ib_bdy), kt ) 
    64             CASE('specified') 
    65                CALL bdy_trc_spe( jn, idx_bdy(ib_bdy), trcdta_bdy(jn,ib_bdy), kt ) 
    66             CASE('neumann') 
    67                CALL bdy_trc_nmn( jn, idx_bdy(ib_bdy), trcdta_bdy(jn,ib_bdy), kt ) 
    68             CASE('orlanski') 
    69                CALL bdy_trc_orlanski( jn, idx_bdy(ib_bdy), trcdta_bdy(jn,ib_bdy), ll_npo=.false. ) 
    70             CASE('orlanski_npo') 
    71                CALL bdy_trc_orlanski( jn, idx_bdy(ib_bdy), trcdta_bdy(jn,ib_bdy), ll_npo=.true. ) 
    72             CASE DEFAULT 
    73                CALL ctl_stop( 'trc_bdy : unrecognised option for open boundaries for passive tracers' ) 
     55      igrd = 1  
     56      ! 
     57      DO ib_bdy=1, nb_bdy 
     58         DO jn = 1, jptra 
     59            ! 
     60            ztrc => trcdta_bdy(jn,ib_bdy)%trc  
     61            zfac => trcdta_bdy(jn,ib_bdy)%rn_fac 
     62            ! 
     63            SELECT CASE( TRIM(trcdta_bdy(jn,ib_bdy)%cn_obc) ) 
     64            CASE('none'        )   ;   CYCLE 
     65            CASE('frs'         )   ;   CALL bdy_frs( idx_bdy(ib_bdy),                tra(:,:,:,jn), ztrc*zfac ) 
     66            CASE('specified'   )   ;   CALL bdy_spe( idx_bdy(ib_bdy),                tra(:,:,:,jn), ztrc*zfac ) 
     67            CASE('neumann'     )   ;   CALL bdy_nmn( idx_bdy(ib_bdy), igrd         , tra(:,:,:,jn) ) 
     68            CASE('orlanski'    )   ;   CALL bdy_orl( idx_bdy(ib_bdy), trb(:,:,:,jn), tra(:,:,:,jn), ztrc*zfac, ll_npo=.false. ) 
     69            CASE('orlanski_npo')   ;   CALL bdy_orl( idx_bdy(ib_bdy), trb(:,:,:,jn), tra(:,:,:,jn), ztrc*zfac, ll_npo=.true. ) 
     70            CASE DEFAULT           ;   CALL ctl_stop( 'trc_bdy : unrecognised option for open boundaries for passive tracers' ) 
    7471            END SELECT 
    75  
    7672            ! Boundary points should be updated 
    7773            CALL lbc_bdy_lnk( tra(:,:,:,jn), 'T', 1., ib_bdy ) 
    78  
    79          ENDDO 
    80       ENDDO 
     74            ! 
     75         END DO 
     76      END DO 
    8177      ! 
    8278      IF( nn_timing == 1 ) CALL timing_stop('trc_bdy') 
    8379 
    8480   END SUBROUTINE trc_bdy 
    85  
    86    SUBROUTINE bdy_trc_frs( jn, idx, dta, kt ) 
    87       !!---------------------------------------------------------------------- 
    88       !!                 ***  SUBROUTINE bdy_trc_frs  *** 
    89       !!                     
    90       !! ** Purpose : Apply the Flow Relaxation Scheme for tracers at open boundaries. 
    91       !!  
    92       !! Reference : Engedahl H., 1995, Tellus, 365-382. 
    93       !!---------------------------------------------------------------------- 
    94       INTEGER,         INTENT(in) ::   kt 
    95       INTEGER,         INTENT(in) ::   jn   ! Tracer index 
    96       TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
    97       TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data 
    98       !!  
    99       REAL(wp) ::   zwgt           ! boundary weight 
    100       INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
    101       INTEGER  ::   ii, ij         ! 2D addresses 
    102       !!---------------------------------------------------------------------- 
    103       ! 
    104       IF( nn_timing == 1 ) CALL timing_start('bdy_trc_frs') 
    105       !  
    106       igrd = 1                       ! Everything is at T-points here 
    107       DO ib = 1, idx%nblen(igrd) 
    108          DO ik = 1, jpkm1 
    109             ii = idx%nbi(ib,igrd) 
    110             ij = idx%nbj(ib,igrd) 
    111             zwgt = idx%nbw(ib,igrd) 
    112             tra(ii,ij,ik,jn) = ( tra(ii,ij,ik,jn) + zwgt * ( ( dta%trc(ib,ik) * dta%rn_fac)  &  
    113                         &  - tra(ii,ij,ik,jn) ) ) * tmask(ii,ij,ik) 
    114          END DO 
    115       END DO  
    116       ! 
    117       IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 
    118       ! 
    119       IF( nn_timing == 1 ) CALL timing_stop('bdy_trc_frs') 
    120       ! 
    121    END SUBROUTINE bdy_trc_frs 
    122    
    123    SUBROUTINE bdy_trc_spe( jn, idx, dta, kt ) 
    124       !!---------------------------------------------------------------------- 
    125       !!                 ***  SUBROUTINE bdy_trc_frs  *** 
    126       !!                     
    127       !! ** Purpose : Apply a specified value for tracers at open boundaries. 
    128       !!  
    129       !!---------------------------------------------------------------------- 
    130       INTEGER,         INTENT(in) ::   kt 
    131       INTEGER,         INTENT(in) ::   jn   ! Tracer index 
    132       TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
    133       TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data 
    134       !!  
    135       REAL(wp) ::   zwgt           ! boundary weight 
    136       INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
    137       INTEGER  ::   ii, ij         ! 2D addresses 
    138       !!---------------------------------------------------------------------- 
    139       ! 
    140       IF( nn_timing == 1 ) CALL timing_start('bdy_trc_spe') 
    141       ! 
    142       igrd = 1                       ! Everything is at T-points here 
    143       DO ib = 1, idx%nblenrim(igrd) 
    144          ii = idx%nbi(ib,igrd) 
    145          ij = idx%nbj(ib,igrd) 
    146          DO ik = 1, jpkm1 
    147             tra(ii,ij,ik,jn) = dta%trc(ib,ik) * dta%rn_fac * tmask(ii,ij,ik) 
    148          END DO 
    149       END DO 
    150       ! 
    151       IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 
    152       ! 
    153       IF( nn_timing == 1 ) CALL timing_stop('bdy_trc_spe') 
    154       ! 
    155    END SUBROUTINE bdy_trc_spe 
    156  
    157    SUBROUTINE bdy_trc_nmn( jn, idx, dta, kt ) 
    158       !!---------------------------------------------------------------------- 
    159       !!                 ***  SUBROUTINE bdy_trc_nmn  *** 
    160       !!                     
    161       !! ** Purpose : Duplicate the value for tracers at open boundaries. 
    162       !!  
    163       !!---------------------------------------------------------------------- 
    164       INTEGER,         INTENT(in) ::   kt 
    165       INTEGER,         INTENT(in) ::   jn   ! Tracer index 
    166       TYPE(OBC_INDEX), INTENT(in) ::   idx  ! OBC indices 
    167       TYPE(OBC_DATA),  INTENT(in) ::   dta  ! OBC external data 
    168       !!  
    169       REAL(wp) ::   zwgt           ! boundary weight 
    170       INTEGER  ::   ib, ik, igrd   ! dummy loop indices 
    171       INTEGER  ::   ii, ij, zcoef, zcoef1, zcoef2, ip, jp   ! 2D addresses 
    172       !!---------------------------------------------------------------------- 
    173       ! 
    174       IF( nn_timing == 1 ) CALL timing_start('bdy_trc_nmn') 
    175       ! 
    176       igrd = 1                       ! Everything is at T-points here 
    177       DO ib = 1, idx%nblenrim(igrd) 
    178          ii = idx%nbi(ib,igrd) 
    179          ij = idx%nbj(ib,igrd) 
    180          DO ik = 1, jpkm1 
    181             ! search the sense of the gradient 
    182             zcoef1 = bdytmask(ii-1,ij  ) +  bdytmask(ii+1,ij  ) 
    183             zcoef2 = bdytmask(ii  ,ij-1) +  bdytmask(ii  ,ij+1) 
    184             IF ( zcoef1+zcoef2 == 0) THEN 
    185                ! corner 
    186                zcoef = tmask(ii-1,ij,ik) + tmask(ii+1,ij,ik) +  tmask(ii,ij-1,ik) +  tmask(ii,ij+1,ik) 
    187                tra(ii,ij,ik,jn) = tra(ii-1,ij  ,ik,jn) * tmask(ii-1,ij  ,ik) + & 
    188                  &                tra(ii+1,ij  ,ik,jn) * tmask(ii+1,ij  ,ik) + & 
    189                  &                tra(ii  ,ij-1,ik,jn) * tmask(ii  ,ij-1,ik) + & 
    190                  &                tra(ii  ,ij+1,ik,jn) * tmask(ii  ,ij+1,ik) 
    191                tra(ii,ij,ik,jn) = ( tra(ii,ij,ik,jn) / MAX( 1, zcoef) ) * tmask(ii,ij,ik) 
    192             ELSE 
    193                ip = bdytmask(ii+1,ij  ) - bdytmask(ii-1,ij  ) 
    194                jp = bdytmask(ii  ,ij+1) - bdytmask(ii  ,ij-1) 
    195                tra(ii,ij,ik,jn) = tra(ii+ip,ij+jp,ik,jn) * tmask(ii+ip,ij+jp,ik) 
    196             ENDIF 
    197          END DO 
    198       END DO 
    199       ! 
    200       IF( kt .eq. nit000 ) CLOSE( unit = 102 ) 
    201       ! 
    202       IF( nn_timing == 1 ) CALL timing_stop('bdy_trc_nmn') 
    203       ! 
    204    END SUBROUTINE bdy_trc_nmn 
    205   
    206  
    207    SUBROUTINE bdy_trc_orlanski( jn, idx, dta, ll_npo ) 
    208       !!---------------------------------------------------------------------- 
    209       !!                 ***  SUBROUTINE bdy_trc_orlanski  *** 
    210       !!              
    211       !!              - Apply Orlanski radiation to tracers of TOP component.  
    212       !!              - Wrapper routine for bdy_orlanski_3d 
    213       !!  
    214       !! 
    215       !! References:  Marchesiello, McWilliams and Shchepetkin, Ocean Modelling vol. 3 (2001)     
    216       !!---------------------------------------------------------------------- 
    217       INTEGER,                      INTENT(in) ::   jn      ! Tracer index 
    218       TYPE(OBC_INDEX),              INTENT(in) ::   idx     ! OBC indices 
    219       TYPE(OBC_DATA),               INTENT(in) ::   dta     ! OBC external data 
    220       LOGICAL,                      INTENT(in) ::   ll_npo  ! switch for NPO version 
    221  
    222       INTEGER  ::   igrd                                    ! grid index 
    223       !!---------------------------------------------------------------------- 
    224  
    225       IF( nn_timing == 1 ) CALL timing_start('bdy_trc_orlanski') 
    226       ! 
    227       igrd = 1      ! Orlanski bc on tracers;  
    228       !             
    229       CALL bdy_orlanski_3d( idx, igrd, trb(:,:,:,jn), tra(:,:,:,jn), (dta%trc * dta%rn_fac), ll_npo ) 
    230       ! 
    231       IF( nn_timing == 1 ) CALL timing_stop('bdy_trc_orlanski') 
    232       ! 
    233  
    234    END SUBROUTINE bdy_trc_orlanski 
    23581 
    23682   SUBROUTINE trc_bdy_dmp( kt ) 

  • trunk/NEMOGCM/NEMO/TOP_SRC/trcdta.F90

    r6701 r7646  
    99   !!            3.4   !  2010-11  (C. Ethe, G. Madec)  use of fldread + dynamical allocation  
    1010   !!            3.5   !  2013-08  (M. Vichi)  generalization for other BGC models 
    11    !!            3.6   !  2015-03  (T. Lovato) revision of code log info 
     11   !!            3.6   !  2015-03  (T. Lovato) revisit code I/O 
    1212   !!---------------------------------------------------------------------- 
    1313#if defined key_top  
    … …  
    2828 
    2929   PUBLIC   trc_dta         ! called in trcini.F90 and trcdmp.F90 
    30    PUBLIC   trc_dta_init    ! called in trcini.F90  
     30   PUBLIC   trc_dta_ini     ! called in trcini.F90  
    3131 
    3232   INTEGER  , SAVE, PUBLIC                             :: nb_trcdta   ! number of tracers to be initialised with data 
    … …  
    4545CONTAINS 
    4646 
    47    SUBROUTINE trc_dta_init(ntrc) 
    48       !!---------------------------------------------------------------------- 
    49       !!                   ***  ROUTINE trc_dta_init  *** 
     47   SUBROUTINE trc_dta_ini(ntrc) 
     48      !!---------------------------------------------------------------------- 
     49      !!                   ***  ROUTINE trc_dta_ini  *** 
    5050      !!                     
    5151      !! ** Purpose :   initialisation of passive tracer input data  
    … …  
    7070      !!---------------------------------------------------------------------- 
    7171      ! 
    72       IF( nn_timing == 1 )  CALL timing_start('trc_dta_init') 
     72      IF( nn_timing == 1 )  CALL timing_start('trc_dta_ini') 
    7373      ! 
    7474      IF( lwp ) THEN 
    7575         WRITE(numout,*) ' ' 
    76          WRITE(numout,*) '  trc_dta_init : Tracers Initial Conditions (IC)' 
     76         WRITE(numout,*) '  trc_dta_ini : Tracers Initial Conditions (IC)' 
    7777         WRITE(numout,*) '  ~~~~~~~~~~~ ' 
    7878      ENDIF 
    … …  
    8383      ALLOCATE( n_trc_index(ntrc), slf_i(ntrc), STAT=ierr0 ) 
    8484      IF( ierr0 > 0 ) THEN 
    85          CALL ctl_stop( 'trc_dta_init: unable to allocate n_trc_index' )   ;   RETURN 
     85         CALL ctl_stop( 'trc_dta_ini: unable to allocate n_trc_index' )   ;   RETURN 
    8686      ENDIF 
    8787      nb_trcdta      = 0 
    … …  
    103103      REWIND( numnat_ref )              ! Namelist namtrc_dta in reference namelist : Passive tracer input data 
    104104      READ  ( numnat_ref, namtrc_dta, IOSTAT = ios, ERR = 901) 
    105 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_init in reference namelist', lwp ) 
     105901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_ini in reference namelist', lwp ) 
    106106 
    107107      REWIND( numnat_cfg )              ! Namelist namtrc_dta in configuration namelist : Passive tracer input data 
    108108      READ  ( numnat_cfg, namtrc_dta, IOSTAT = ios, ERR = 902 ) 
    109 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_init in configuration namelist', lwp ) 
     109902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dta_ini in configuration namelist', lwp ) 
    110110      IF(lwm) WRITE ( numont, namtrc_dta ) 
    111111 
    … …  
    118118               zfact  = rn_trfac(jn) 
    119119               IF( clndta /=  clntrc ) THEN  
    120                   CALL ctl_warn( 'trc_dta_init: passive tracer data initialisation    ',   & 
     120                  CALL ctl_warn( 'trc_dta_ini: passive tracer data initialisation    ',   & 
    121121                  &              'Input name of data file : '//TRIM(clndta)//   & 
    122122                  &              ' differs from that of tracer : '//TRIM(clntrc)//' ') 
    … …  
    132132         ALLOCATE( sf_trcdta(nb_trcdta), rf_trfac(nb_trcdta), STAT=ierr1 ) 
    133133         IF( ierr1 > 0 ) THEN 
    134             CALL ctl_stop( 'trc_dta_init: unable to allocate  sf_trcdta structure' )   ;   RETURN 
     134            CALL ctl_stop( 'trc_dta_ini: unable to allocate  sf_trcdta structure' )   ;   RETURN 
    135135         ENDIF 
    136136         ! 
    … …  
    143143               IF( sn_trcdta(jn)%ln_tint )  ALLOCATE( sf_trcdta(jl)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 ) 
    144144               IF( ierr2 + ierr3 > 0 ) THEN 
    145                  CALL ctl_stop( 'trc_dta_init : unable to allocate passive tracer data arrays' )   ;   RETURN 
     145                 CALL ctl_stop( 'trc_dta_ini : unable to allocate passive tracer data arrays' )   ;   RETURN 
    146146               ENDIF 
    147147            ENDIF 
    … …  
    149149         ENDDO 
    150150         !                         ! fill sf_trcdta with slf_i and control print 
    151          CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta_init', 'Passive tracer data', 'namtrc' ) 
     151         CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta_ini', 'Passive tracer data', 'namtrc' ) 
    152152         ! 
    153153      ENDIF 
    154154      ! 
    155155      DEALLOCATE( slf_i )          ! deallocate local field structure 
    156       IF( nn_timing == 1 )  CALL timing_stop('trc_dta_init') 
    157       ! 
    158    END SUBROUTINE trc_dta_init 
    159  
    160  
    161    SUBROUTINE trc_dta( kt, sf_trcdta, ptrfac, ptrc) 
     156      IF( nn_timing == 1 )  CALL timing_stop('trc_dta_ini') 
     157      ! 
     158   END SUBROUTINE trc_dta_ini 
     159 
     160 
     161   SUBROUTINE trc_dta( kt, sf_trcdta, ptrcfac, ptrcdta) 
    162162      !!---------------------------------------------------------------------- 
    163163      !!                   ***  ROUTINE trc_dta  *** 
    … …  
    169169      !!              - ln_trcdmp=F: deallocates the data structure as they are not used 
    170170      !! 
    171       !! ** Action  :   sf_trcdta   passive tracer data on medl mesh and interpolated at time-step kt 
    172       !!---------------------------------------------------------------------- 
    173       INTEGER                     , INTENT(in   ) ::   kt     ! ocean time-step 
    174       TYPE(FLD), DIMENSION(1)     , INTENT(inout) ::   sf_trcdta     ! array of information on the field to read 
    175       REAL(wp)                    , INTENT(in   ) ::   ptrfac  ! multiplication factor 
    176       REAL(wp), DIMENSION(jpi,jpj,jpk), OPTIONAL  , INTENT(out  ) ::   ptrc 
     171      !! ** Action  :   sf_trcdta   passive tracer data on meld mesh and interpolated at time-step kt 
     172      !!---------------------------------------------------------------------- 
     173      INTEGER                          , INTENT(in   )   ::   kt         ! ocean time-step 
     174      TYPE(FLD), DIMENSION(1)          , INTENT(inout)   ::   sf_trcdta  ! array of information on the field to read 
     175      REAL(wp)                         , INTENT(in   )   ::   ptrcfac    ! multiplication factor 
     176      REAL(wp),  DIMENSION(jpi,jpj,jpk), INTENT(inout  ) ::   ptrcdta    ! 3D data array 
    177177      ! 
    178178      INTEGER ::   ji, jj, jk, jl, jkk, ik    ! dummy loop indices 
    179179      REAL(wp)::   zl, zi 
    180180      REAL(wp), DIMENSION(jpk) ::  ztp                ! 1D workspace 
    181       REAL(wp), POINTER, DIMENSION(:,:,:) ::  ztrcdta   ! 3D  workspace 
    182181      CHARACTER(len=100) :: clndta 
    183182      !!---------------------------------------------------------------------- 
    … …  
    187186      IF( nb_trcdta > 0 ) THEN 
    188187         ! 
    189          CALL wrk_alloc( jpi, jpj, jpk, ztrcdta )    ! Memory allocation 
    190          ! 
    191          CALL fld_read( kt, 1, sf_trcdta )      !==   read data at kt time step   ==! 
    192          ztrcdta(:,:,:) = sf_trcdta(1)%fnow(:,:,:) * tmask(:,:,:)    ! Mask 
    193          ! 
    194          IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==! 
     188         ! read data at kt time step 
     189         CALL fld_read( kt, 1, sf_trcdta ) 
     190         ptrcdta(:,:,:) = sf_trcdta(1)%fnow(:,:,:) * tmask(:,:,:) 
     191         !  
     192         IF( ln_sco ) THEN                !== s- or mixed s-zps-coordinate  ==! 
    195193            ! 
    196194            IF( kt == nit000 .AND. lwp )THEN 
    … …  
    203201                     zl = gdept_n(ji,jj,jk) 
    204202                     IF(     zl < gdept_1d(1  ) ) THEN         ! above the first level of data 
    205                         ztp(jk) = ztrcdta(ji,jj,1) 
     203                        ztp(jk) = ptrcdta(ji,jj,1) 
    206204                     ELSEIF( zl > gdept_1d(jpk) ) THEN         ! below the last level of data 
    207                         ztp(jk) =  ztrcdta(ji,jj,jpkm1) 
     205                        ztp(jk) = ptrcdta(ji,jj,jpkm1) 
    208206                     ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1 
    209207                        DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(jkk+1) 
    210208                           IF( (zl-gdept_1d(jkk)) * (zl-gdept_1d(jkk+1)) <= 0._wp ) THEN 
    211209                              zi = ( zl - gdept_1d(jkk) ) / (gdept_1d(jkk+1)-gdept_1d(jkk)) 
    212                               ztp(jk) = ztrcdta(ji,jj,jkk) + ( ztrcdta(ji,jj,jkk+1) - & 
    213                                         ztrcdta(ji,jj,jkk) ) * zi  
     210                              ztp(jk) = ptrcdta(ji,jj,jkk) + ( ptrcdta(ji,jj,jkk+1) - ptrcdta(ji,jj,jkk) ) * zi 
    214211                           ENDIF 
    215212                        END DO 
    … …  
    217214                  END DO 
    218215                  DO jk = 1, jpkm1 
    219                     ztrcdta(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord 
     216                     ptrcdta(ji,jj,jk) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord 
    220217                  END DO 
    221                   ztrcdta(ji,jj,jpk) = 0._wp 
     218                  ptrcdta(ji,jj,jpk) = 0._wp 
    222219                END DO 
    223220            END DO 
    224221            !  
    225222         ELSE                                !==   z- or zps- coordinate   ==! 
    226             ! 
    227             IF( ln_zps ) THEN                      ! zps-coordinate (partial steps) interpolation at the last ocean level 
     223            ! zps-coordinate (partial steps) interpolation at the last ocean level 
     224            IF( ln_zps ) THEN 
    228225               DO jj = 1, jpj 
    229226                  DO ji = 1, jpi 
    … …  
    231228                     IF( ik > 1 ) THEN 
    232229                        zl = ( gdept_1d(ik) - gdept_n(ji,jj,ik) ) / ( gdept_1d(ik) - gdept_1d(ik-1) ) 
    233                         ztrcdta(ji,jj,ik) = (1.-zl) * ztrcdta(ji,jj,ik) + zl * ztrcdta(ji,jj,ik-1) 
     230                        ptrcdta(ji,jj,ik) = (1.-zl) * ptrcdta(ji,jj,ik) + zl * ptrcdta(ji,jj,ik-1) 
    234231                     ENDIF 
    235232                     ik = mikt(ji,jj) 
    236233                     IF( ik > 1 ) THEN 
    237234                        zl = ( gdept_n(ji,jj,ik) - gdept_1d(ik) ) / ( gdept_1d(ik+1) - gdept_1d(ik) ) 
    238                         ztrcdta(ji,jj,ik) = (1.-zl) * ztrcdta(ji,jj,ik) + zl * ztrcdta(ji,jj,ik+1) 
     235                        ptrcdta(ji,jj,ik) = (1.-zl) * ptrcdta(ji,jj,ik) + zl * ptrcdta(ji,jj,ik+1) 
    239236                     ENDIF 
    240237                  END DO 
    … …  
    244241         ENDIF 
    245242         ! 
    246          ! Add multiplicative factor 
    247          ztrcdta(:,:,:) = ztrcdta(:,:,:) * ptrfac 
    248          ! 
    249          ! Data structure for trc_ini (and BFMv5.1 coupling) 
    250          IF( .NOT. PRESENT(ptrc) ) sf_trcdta(1)%fnow(:,:,:) = ztrcdta(:,:,:) 
    251          ! 
    252          ! Data structure for trc_dmp 
    253          IF( PRESENT(ptrc) )  ptrc(:,:,:) = ztrcdta(:,:,:) 
    254          ! 
    255          CALL wrk_dealloc( jpi, jpj, jpk, ztrcdta ) 
     243         ! Scale by multiplicative factor 
     244         ptrcdta(:,:,:) = ptrcdta(:,:,:) * ptrcfac 
    256245         ! 
    257246      ENDIF 
    … …  
    266255   !!---------------------------------------------------------------------- 
    267256CONTAINS 
    268    SUBROUTINE trc_dta( kt, sf_trcdta, ptrfac, ptrc)        ! Empty routine 
     257   SUBROUTINE trc_dta( kt, sf_trcdta, ptrcfac, ptrcdta)        ! Empty routine 
    269258      WRITE(*,*) 'trc_dta: You should not have seen this print! error?', kt 
    270259   END SUBROUTINE trc_dta 

  • trunk/NEMOGCM/NEMO/TOP_SRC/trcice.F90

    r5385 r7646  
    1717   USE trcice_cfc      ! CFC      initialisation 
    1818   USE trcice_pisces   ! PISCES   initialisation 
    19    USE trcice_c14b     ! C14 bomb initialisation 
     19   USE trcice_c14      ! C14 bomb initialisation 
     20   USE trcice_age      ! aGE initialisation 
    2021   USE trcice_my_trc   ! MY_TRC   initialisation 
    2122    
    … …  
    4546 
    4647      IF( nn_timing == 1 )  CALL timing_start('trc_ice_ini') 
    47  
     48      ! 
     49      CALL trc_nam_ice 
    4850      ! 
    4951      trc_i(:,:,:) = 0.0d0 ! by default 
    … …  
    5153 
    5254      IF ( nn_ice_tr == 1 ) THEN 
    53          IF( lk_pisces  )    CALL trc_ice_ini_pisces       ! PISCES  bio-model 
    54          IF( lk_cfc     )    CALL trc_ice_ini_cfc          ! CFC     tracers 
    55          IF( lk_c14b    )    CALL trc_ice_ini_c14b         ! C14 bomb  tracer 
    56          IF( lk_my_trc  )    CALL trc_ice_ini_my_trc       ! MY_TRC  tracers 
     55         IF( ln_pisces  )    CALL trc_ice_ini_pisces       ! PISCES  bio-model 
     56         IF( ll_cfc     )    CALL trc_ice_ini_cfc          ! CFC     tracers 
     57         IF( ln_c14     )    CALL trc_ice_ini_c14          ! C14     tracer 
     58         IF( ln_age     )    CALL trc_ice_ini_age          ! AGE     tracer 
     59         IF( ln_my_trc  )    CALL trc_ice_ini_my_trc       ! MY_TRC  tracers 
    5760      ENDIF 
    5861 
    … …  
    6063      ! 
    6164   END SUBROUTINE trc_ice_ini 
     65 
     66   SUBROUTINE trc_nam_ice 
     67      !!--------------------------------------------------------------------- 
     68      !!                     ***  ROUTINE trc_nam_ice *** 
     69      !! 
     70      !! ** Purpose :   Read the namelist for the ice effect on tracers 
     71      !! 
     72      !! ** Method  : - 
     73      !! 
     74      !!--------------------------------------------------------------------- 
     75      INTEGER :: jn      ! dummy loop indices 
     76      INTEGER :: ios, ierr     ! Local integer output status for namelist read 
     77      ! 
     78      TYPE(TRC_I_NML), DIMENSION(jpmaxtrc) :: sn_tri_tracer 
     79      !! 
     80      NAMELIST/namtrc_ice/ nn_ice_tr, sn_tri_tracer 
     81      !!--------------------------------------------------------------------- 
     82      ! 
     83      IF(lwp) THEN 
     84         WRITE(numout,*) 
     85         WRITE(numout,*) 'trc_nam_ice : Read the namelist for trc_ice' 
     86         WRITE(numout,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
     87      ENDIF 
     88 
     89      IF( nn_timing == 1 )  CALL timing_start('trc_nam_ice') 
     90 
     91      ! 
     92      REWIND( numnat_ref )              ! Namelist namtrc_ice in reference namelist : Passive tracer input data 
     93      READ  ( numnat_ref, namtrc_ice, IOSTAT = ios, ERR = 901) 
     94 901  IF( ios /= 0 ) CALL ctl_nam ( ios , ' namtrc_ice in reference namelist ', lwp ) 
     95 
     96      REWIND( numnat_cfg )              ! Namelist namtrc_ice in configuration namelist : Pisces external sources of nutrients 
     97      READ  ( numnat_cfg, namtrc_ice, IOSTAT = ios, ERR = 902 ) 
     98 902  IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_ice in configuration namelist', lwp ) 
     99 
     100      IF( lwp ) THEN 
     101         WRITE(numout,*) ' ' 
     102         WRITE(numout,*) ' Sea ice tracers option (nn_ice_tr) : ', nn_ice_tr 
     103         WRITE(numout,*) ' ' 
     104      ENDIF 
     105      ! 
     106      ! Assign namelist stuff 
     107      DO jn = 1, jptra 
     108         trc_ice_ratio (jn) = sn_tri_tracer(jn)%trc_ratio 
     109         trc_ice_prescr(jn) = sn_tri_tracer(jn)%trc_prescr 
     110         cn_trc_o      (jn) = sn_tri_tracer(jn)%ctrc_o 
     111      END DO 
     112 
     113      IF( nn_timing == 1 )   CALL timing_stop('trc_nam_ice') 
     114      ! 
     115   END SUBROUTINE trc_nam_ice 
    62116 
    63117#else 
    … …  
    68122   SUBROUTINE trc_ice_ini                   ! Dummy routine    
    69123   END SUBROUTINE trc_ice_ini 
     124 
     125   SUBROUTINE trc_nam_ice 
     126   END SUBROUTINE trc_nam_ice 
     127 
    70128#endif 
    71129 

  • trunk/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r6701 r7646  
    2424   USE trcrst 
    2525   USE lib_mpp         ! distribued memory computing library 
    26    USE sbc_oce 
    2726   USE trcice          ! tracers in sea ice 
    28    USE trcbc,   only : trc_bc_init ! generalized Boundary Conditions 
     27   USE trcbc,   only : trc_bc_ini ! generalized Boundary Conditions 
    2928  
    3029   IMPLICIT NONE 
    … …  
    5857      IF(lwp) WRITE(numout,*) 'trc_init : initial set up of the passive tracers' 
    5958      IF(lwp) WRITE(numout,*) '~~~~~~~' 
    60  
    61       ! 
     59      ! 
     60      CALL trc_ini_ctl   ! control  
     61      CALL trc_nam       ! read passive tracers namelists 
    6262      CALL top_alloc()   ! allocate TOP arrays 
    6363      ! 
    64       CALL trc_ini_ctl   ! control  
    65       ! 
    66       CALL trc_nam       ! read passive tracers namelists 
     64      IF(.NOT.ln_trcdta )   ln_trc_ini(:) = .FALSE. 
    6765      ! 
    6866      IF(lwp) WRITE(numout,*) 
    69       ! 
    70       IF( ln_rsttr .AND. .NOT. lk_offline ) CALL trc_rst_cal( nit000, 'READ' )   ! calendar 
    71       ! 
     67      IF( ln_rsttr .AND. .NOT. l_offline ) CALL trc_rst_cal( nit000, 'READ' )   ! calendar 
    7268      IF(lwp) WRITE(numout,*) 
    7369      ! 
    7470      CALL trc_ini_sms   ! SMS 
    75       ! 
     71      CALL trc_ini_inv   ! Inventories 
    7672      CALL trc_ini_trp   ! passive tracers transport 
    77       ! 
    7873      CALL trc_ice_ini   ! Tracers in sea ice 
    7974      ! 
    80       IF( lwp )  & 
    81          &  CALL ctl_opn( numstr, 'tracer.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp , narea ) 
     75      IF(lwp) CALL ctl_opn( numstr, 'tracer.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp , narea ) 
    8276      ! 
    8377      CALL trc_ini_state  !  passive tracers initialisation : from a restart or from clim 
    84       ! 
    85       IF( nn_dttrc /= 1 )        CALL trc_sub_ini      ! Initialize variables for substepping passive tracers 
    86       ! 
    87       CALL trc_ini_inv   ! Inventories 
     78      IF( nn_dttrc /= 1 ) & 
     79      CALL trc_sub_ini    ! Initialize variables for substepping passive tracers 
    8880      ! 
    8981      IF( nn_timing == 1 )   CALL timing_stop('trc_init') 
    … …  
    10193      ! Define logical parameter ton control dirunal cycle in TOP 
    10294      l_trcdm2dc = ln_dm2dc .OR. ( ln_cpl .AND. ncpl_qsr_freq /= 1 ) 
    103       l_trcdm2dc = l_trcdm2dc  .AND. .NOT. lk_offline 
     95      l_trcdm2dc = l_trcdm2dc  .AND. .NOT. l_offline 
    10496      IF( l_trcdm2dc .AND. lwp )   CALL ctl_warn( 'Coupling with passive tracers and used of diurnal cycle.',   & 
    10597         &                           'Computation of a daily mean shortwave for some biogeochemical models ' ) 
    … …  
    120112         cvol(:,:,jk) = e1e2t(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk) 
    121113      END DO 
    122       IF( lk_degrad )   cvol(:,:,:) = cvol(:,:,:) * facvol(:,:,:)    ! degrad option: reduction by facvol 
    123114      !                                                              ! total volume of the ocean  
    124115      areatot = glob_sum( cvol(:,:,:) ) 
    … …  
    131122      IF(lwp) THEN               ! control print 
    132123         WRITE(numout,*) 
    133          WRITE(numout,*) 
    134          WRITE(numout,*) '          *** Total number of passive tracer jptra = ', jptra 
    135          WRITE(numout,*) '          *** Total volume of ocean                = ', areatot 
    136          WRITE(numout,*) '          *** Total inital content of all tracers ' 
     124         WRITE(numout,*) '  *** Total number of passive tracer jptra = ', jptra 
     125         WRITE(numout,*) '  *** Total volume of ocean                = ', areatot 
     126         WRITE(numout,*) '  *** Total inital content of all tracers ' 
    137127         WRITE(numout,*) 
    138128         DO jn = 1, jptra 
    … …  
    148138         CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 
    149139      ENDIF 
    150 9000  FORMAT(' tracer nb : ',i2,'      name :',a10,'      initial content :',e18.10) 
     1409000  FORMAT('  tracer nb : ',i2,'      name :',a10,'      initial content :',e18.10) 
    151141      ! 
    152142   END SUBROUTINE trc_ini_inv 
    … …  
    158148      !! ** Purpose :   SMS initialisation 
    159149      !!---------------------------------------------------------------------- 
    160       USE trcini_cfc      ! CFC      initialisation 
    161       USE trcini_pisces   ! PISCES   initialisation 
    162       USE trcini_c14b     ! C14 bomb initialisation 
    163       USE trcini_my_trc   ! MY_TRC   initialisation 
    164       !!---------------------------------------------------------------------- 
    165       IF( lk_pisces  )       CALL trc_ini_pisces       ! PISCES  bio-model 
    166       IF( lk_cfc     )       CALL trc_ini_cfc          ! CFC     tracers 
    167       IF( lk_c14b    )       CALL trc_ini_c14b         ! C14 bomb  tracer 
    168       IF( lk_my_trc  )       CALL trc_ini_my_trc       ! MY_TRC  tracers 
     150      USE trcini_pisces  ! PISCES   initialisation 
     151      USE trcini_cfc     ! CFC      initialisation 
     152      USE trcini_c14     ! C14  initialisation 
     153      USE trcini_age     ! age initialisation 
     154      USE trcini_my_trc  ! MY_TRC   initialisation 
     155      ! 
     156      INTEGER :: jn 
     157      !!---------------------------------------------------------------------- 
     158      ! 
     159      ! Pass sn_tracer fields to specialized arrays  
     160      DO jn = 1, jp_bgc 
     161         ctrcnm    (jn) = TRIM( sn_tracer(jn)%clsname ) 
     162         ctrcln    (jn) = TRIM( sn_tracer(jn)%cllname ) 
     163         ctrcun    (jn) = TRIM( sn_tracer(jn)%clunit  ) 
     164         ln_trc_ini(jn) =       sn_tracer(jn)%llinit 
     165         ln_trc_sbc(jn) =       sn_tracer(jn)%llsbc 
     166         ln_trc_cbc(jn) =       sn_tracer(jn)%llcbc 
     167         ln_trc_obc(jn) =       sn_tracer(jn)%llobc 
     168      END DO 
     169      !     
     170      IF( ln_pisces  )   CALL trc_ini_pisces     !  PISCES model 
     171      IF( ln_my_trc  )   CALL trc_ini_my_trc     !  MY_TRC model 
     172      IF( ll_cfc     )   CALL trc_ini_cfc        !  CFC's 
     173      IF( ln_c14     )   CALL trc_ini_c14        !  C14 model 
     174      IF( ln_age     )   CALL trc_ini_age        !  AGE 
     175      ! 
     176      IF(lwp) THEN                   ! control print 
     177         WRITE(numout,*) 
     178         WRITE(numout,*) ' trc_init: Summary for selected passive tracers' 
     179         WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
     180         WRITE(numout,*) ' ID     NAME     INI  SBC  CBC  OBC' 
     181         DO jn = 1, jptra 
     182            WRITE(numout,9001) jn, TRIM(ctrcnm(jn)), ln_trc_ini(jn), ln_trc_sbc(jn),ln_trc_cbc(jn),ln_trc_obc(jn) 
     183         END DO 
     184      ENDIF 
     1859001  FORMAT(1x,i3,1x,a10,3x,l2,3x,l2,3x,l2,3x,l2) 
    169186      ! 
    170187   END SUBROUTINE trc_ini_sms 
    … …  
    207224      ! 
    208225      ! Initialisation of tracers Initial Conditions 
    209       IF( ln_trcdta )      CALL trc_dta_init(jptra) 
     226      IF( ln_trcdta )      CALL trc_dta_ini(jptra) 
    210227 
    211228      ! Initialisation of tracers Boundary Conditions 
    212       IF( lk_my_trc )     CALL trc_bc_init(jptra) 
     229      IF( ln_my_trc )     CALL trc_bc_ini(jptra) 
    213230 
    214231      IF( ln_rsttr ) THEN 
    … …  
    217234        ! 
    218235      ELSE 
    219         ! 
    220         IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN  ! Initialisation of tracer from a file that may also be used for damping 
    221             ! 
     236        ! Initialisation of tracer from a file that may also be used for damping 
     237        IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN 
     238            ! update passive tracers arrays with input data read from file 
    222239            DO jn = 1, jptra 
    223                IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file 
     240               IF( ln_trc_ini(jn) ) THEN 
    224241                  jl = n_trc_index(jn)  
    225                   CALL trc_dta( nit000, sf_trcdta(jl), rf_trfac(jl) )   ! read tracer data at nit000 
    226                   trn(:,:,:,jn) = sf_trcdta(jl)%fnow(:,:,:)  
     242                  CALL trc_dta( nit000, sf_trcdta(jl), rf_trfac(jl), trn(:,:,:,jn) ) 
    227243                  ! 
    228                   IF( .NOT.ln_trcdmp .AND. .NOT.ln_trcdmp_clo ) THEN      !== deallocate data structure   ==! 
    229                      !                                                    (data used only for initialisation) 
     244                  ! deallocate data structure if data are not used for damping 
     245                  IF( .NOT.ln_trcdmp .AND. .NOT.ln_trcdmp_clo ) THEN 
    230246                     IF(lwp) WRITE(numout,*) 'trc_dta: deallocate data arrays as they are only used to initialize the run' 
    231                                                   DEALLOCATE( sf_trcdta(jl)%fnow )     !  arrays in the structure 
     247                                                  DEALLOCATE( sf_trcdta(jl)%fnow ) 
    232248                     IF( sf_trcdta(jl)%ln_tint )  DEALLOCATE( sf_trcdta(jl)%fdta ) 
    233249                     ! 

  • trunk/NEMOGCM/NEMO/TOP_SRC/trcnam.F90

    r6140 r7646  
    2020   USE oce_trc           ! shared variables between ocean and passive tracers 
    2121   USE trc               ! passive tracers common variables 
    22    USE trcnam_pisces     ! PISCES namelist 
    23    USE trcnam_cfc        ! CFC SMS namelist 
    24    USE trcnam_c14b       ! C14 SMS namelist 
    25    USE trcnam_my_trc     ! MY_TRC SMS namelist 
    2622   USE trd_oce        
    2723   USE trdtrc_oce 
    … …  
    3430   PUBLIC trc_nam      ! called in trcini 
    3531 
     32   TYPE(PTRACER), DIMENSION(jpmaxtrc), PUBLIC  :: sn_tracer  ! type of tracer for saving if not key_iomput 
     33 
    3634   !!---------------------------------------------------------------------- 
    3735   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    5250      !!--------------------------------------------------------------------- 
    5351      INTEGER  ::   jn                  ! dummy loop indice 
    54       !                                   
    55       IF( .NOT.lk_offline )   CALL trc_nam_run     ! Parameters of the run  
     52      ! 
     53      IF( .NOT.l_offline )   CALL trc_nam_run     ! Parameters of the run                                   
    5654      !                
    57                               CALL trc_nam_trc     ! passive tracer informations 
     55      CALL trc_nam_trc     ! passive tracer informations 
    5856      !                                         
    59                               CALL trc_nam_dia     ! Parameters of additional diagnostics 
    60       !                                       
    61       ! 
    6257      IF( ln_rsttr                     )   ln_trcdta     = .FALSE.   ! restart : no need of clim data 
    6358      ! 
    6459      IF( ln_trcdmp .OR. ln_trcdmp_clo )   ln_trcdta     = .TRUE.   ! damping : need to have clim data 
    6560      ! 
    66       IF( .NOT.ln_trcdta               )   ln_trc_ini(:) = .FALSE. 
    67  
    68       IF(lwp) THEN                   ! control print 
    69          WRITE(numout,*) 
    70          WRITE(numout,*) ' Namelist : namtrc' 
    71          WRITE(numout,*) '   Read inputs data from file (y/n)             ln_trcdta     = ', ln_trcdta 
    72          WRITE(numout,*) '   Damping of passive tracer (y/n)              ln_trcdmp     = ', ln_trcdmp 
    73          WRITE(numout,*) '   Restoring of tracer on closed seas           ln_trcdmp_clo = ', ln_trcdmp_clo 
    74          WRITE(numout,*) ' ' 
    75          DO jn = 1, jptra 
    76             WRITE(numout,*) '  tracer nb : ', jn, '    short name : ', ctrcnm(jn) 
    77          END DO 
    78          WRITE(numout,*) ' ' 
    79       ENDIF 
    8061 
    8162      IF(lwp) THEN                   ! control print 
    … …  
    9677         ENDIF 
    9778      ENDIF 
    98  
    99        
    100       rdttrc = rdt * FLOAT( nn_dttrc )   ! passive tracer time-step 
    101    
    102       IF(lwp) THEN                   ! control print 
     79      ! 
     80      rdttrc = rdt * FLOAT( nn_dttrc )          ! passive tracer time-step 
     81      !  
     82      IF(lwp) THEN                              ! control print 
    10383        WRITE(numout,*)  
    10484        WRITE(numout,*) '    Passive Tracer  time step    rdttrc  = ', rdttrc 
    10585        WRITE(numout,*)  
    10686      ENDIF 
    107  
    108  
    109 #if defined key_trdmxl_trc || defined key_trdtrc 
    110  
    111          REWIND( numnat_ref )              ! Namelist namtrc_trd in reference namelist : Passive tracer trends 
    112          READ  ( numnat_ref, namtrc_trd, IOSTAT = ios, ERR = 905) 
    113 905      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_trd in reference namelist', lwp ) 
    114  
    115          REWIND( numnat_cfg )              ! Namelist namtrc_trd in configuration namelist : Passive tracer trends 
    116          READ  ( numnat_cfg, namtrc_trd, IOSTAT = ios, ERR = 906 ) 
    117 906      IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_trd in configuration namelist', lwp ) 
    118          IF(lwm) WRITE ( numont, namtrc_trd ) 
    119  
    120          IF(lwp) THEN 
    121             WRITE(numout,*) 
    122             WRITE(numout,*) ' trd_mxl_trc_init : read namelist namtrc_trd                    ' 
    123             WRITE(numout,*) ' ~~~~~~~~~~~~~~~~                                               ' 
    124             WRITE(numout,*) '   * frequency of trends diagnostics   nn_trd_trc             = ', nn_trd_trc 
    125             WRITE(numout,*) '   * control surface type              nn_ctls_trc            = ', nn_ctls_trc 
    126             WRITE(numout,*) '   * restart for ML diagnostics        ln_trdmxl_trc_restart  = ', ln_trdmxl_trc_restart 
    127             WRITE(numout,*) '   * flag to diagnose trends of                                 ' 
    128             WRITE(numout,*) '     instantantaneous or mean ML T/S   ln_trdmxl_trc_instant  = ', ln_trdmxl_trc_instant 
    129             WRITE(numout,*) '   * unit conversion factor            rn_ucf_trc             = ', rn_ucf_trc 
    130             DO jn = 1, jptra 
    131                IF( ln_trdtrc(jn) ) WRITE(numout,*) '    compute ML trends for tracer number :', jn 
    132             END DO 
    133          ENDIF 
    134 #endif 
    135  
    136  
    137       ! Call the ice module for tracers 
    138       ! ------------------------------- 
    139                                   CALL trc_nam_ice 
    140  
    141       ! namelist of SMS 
    142       ! ---------------       
    143       IF( lk_pisces  ) THEN   ;   CALL trc_nam_pisces      ! PISCES  bio-model 
    144       ELSE                    ;   IF(lwp) WRITE(numout,*) '          PISCES not used' 
    145       ENDIF 
    146  
    147       IF( lk_cfc     ) THEN   ;   CALL trc_nam_cfc         ! CFC     tracers 
    148       ELSE                    ;   IF(lwp) WRITE(numout,*) '          CFC not used' 
    149       ENDIF 
    150  
    151       IF( lk_c14b     ) THEN   ;   CALL trc_nam_c14b         ! C14 bomb     tracers 
    152       ELSE                    ;   IF(lwp) WRITE(numout,*) '          C14 not used' 
    153       ENDIF 
    154  
    155       IF( lk_my_trc  ) THEN   ;   CALL trc_nam_my_trc      ! MY_TRC  tracers 
    156       ELSE                    ;   IF(lwp) WRITE(numout,*) '          MY_TRC not used' 
    157       ENDIF 
     87      ! 
     88      IF( l_trdtrc )        CALL trc_nam_trd    ! Passive tracer trends 
    15889      ! 
    15990   END SUBROUTINE trc_nam 
    … …  
    16798      !! 
    16899      !!--------------------------------------------------------------------- 
    169       NAMELIST/namtrc_run/ nn_dttrc, nn_writetrc, ln_rsttr, nn_rsttr, ln_top_euler, & 
     100      NAMELIST/namtrc_run/ nn_dttrc, ln_rsttr, nn_rsttr, ln_top_euler, & 
    170101        &                  cn_trcrst_indir, cn_trcrst_outdir, cn_trcrst_in, cn_trcrst_out 
    171102      ! 
    … …  
    199130         WRITE(numout,*) '   control of time step for passive tracer      nn_rsttr      = ', nn_rsttr 
    200131         WRITE(numout,*) '   first time step for pass. trac.              nittrc000     = ', nittrc000 
    201          WRITE(numout,*) '   frequency of outputs for passive tracers     nn_writetrc   = ', nn_writetrc  
    202132         WRITE(numout,*) '   Use euler integration for TRC (y/n)          ln_top_euler  = ', ln_top_euler 
    203133         WRITE(numout,*) ' ' 
    … …  
    206136    END SUBROUTINE trc_nam_run 
    207137 
    208  
    209    SUBROUTINE trc_nam_ice 
    210       !!--------------------------------------------------------------------- 
    211       !!                     ***  ROUTINE trc_nam_ice *** 
    212       !! 
    213       !! ** Purpose :   Read the namelist for the ice effect on tracers 
    214       !! 
    215       !! ** Method  : - 
    216       !! 
    217       !!--------------------------------------------------------------------- 
    218       INTEGER :: jn      ! dummy loop indices 
    219       INTEGER :: ios     ! Local integer output status for namelist read 
    220       ! 
    221       TYPE(TRC_I_NML), DIMENSION(jptra) :: sn_tri_tracer 
    222       !! 
    223       NAMELIST/namtrc_ice/ nn_ice_tr, sn_tri_tracer 
    224       !!--------------------------------------------------------------------- 
    225       ! 
    226       IF(lwp) THEN 
    227          WRITE(numout,*) 
    228          WRITE(numout,*) 'trc_nam_ice : Read the namelist for trc_ice' 
    229          WRITE(numout,*) '~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    230       ENDIF 
    231  
    232       IF( nn_timing == 1 )  CALL timing_start('trc_nam_ice') 
    233  
    234       ! 
    235       REWIND( numnat_ref )              ! Namelist namtrc_ice in reference namelist : Passive tracer input data 
    236       READ  ( numnat_ref, namtrc_ice, IOSTAT = ios, ERR = 901) 
    237  901  IF( ios /= 0 ) CALL ctl_nam ( ios , ' namtrc_ice in reference namelist ', lwp ) 
    238  
    239       REWIND( numnat_cfg )              ! Namelist namtrc_ice in configuration namelist : Pisces external sources of nutrients 
    240       READ  ( numnat_cfg, namtrc_ice, IOSTAT = ios, ERR = 902 ) 
    241  902  IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_ice in configuration namelist', lwp ) 
    242  
    243       IF( lwp ) THEN 
    244          WRITE(numout,*) ' ' 
    245          WRITE(numout,*) ' Sea ice tracers option (nn_ice_tr) : ', nn_ice_tr 
    246          WRITE(numout,*) ' ' 
    247       ENDIF 
    248  
    249       ! Assign namelist stuff 
    250       DO jn = 1, jptra 
    251          trc_ice_ratio(jn)  = sn_tri_tracer(jn)%trc_ratio 
    252          trc_ice_prescr(jn) = sn_tri_tracer(jn)%trc_prescr 
    253          cn_trc_o      (jn) = sn_tri_tracer(jn)%ctrc_o 
    254       END DO 
    255  
    256       IF( nn_timing == 1 )   CALL timing_stop('trc_nam_ice') 
    257       ! 
    258    END SUBROUTINE trc_nam_ice 
    259  
    260  
    261138   SUBROUTINE trc_nam_trc 
    262139      !!--------------------------------------------------------------------- 
    … …  
    266143      !! 
    267144      !!--------------------------------------------------------------------- 
    268       INTEGER  ::   ios                 ! Local integer output status for namelist read 
    269       INTEGER  ::   jn                  ! dummy loop indice 
    270       ! 
    271       TYPE(PTRACER), DIMENSION(jptra) :: sn_tracer  ! type of tracer for saving if not key_iomput 
    272       !! 
    273       NAMELIST/namtrc/ sn_tracer, ln_trcdta, ln_trcdmp, ln_trcdmp_clo 
    274       !!--------------------------------------------------------------------- 
     145      INTEGER  ::   ios, ierr, icfc       ! Local integer output status for namelist read 
     146      !! 
     147      NAMELIST/namtrc/jp_bgc, ln_pisces, ln_my_trc, ln_age, ln_cfc11, ln_cfc12, ln_sf6, ln_c14, & 
     148         &            sn_tracer, ln_trcdta, ln_trcdmp, ln_trcdmp_clo, jp_dia3d, jp_dia2d 
     149      !!--------------------------------------------------------------------- 
     150      ! Dummy settings to fill tracers data structure 
     151      !                  !   name   !   title   !   unit   !   init  !   sbc   !   cbc   !   obc  ! 
     152      sn_tracer = PTRACER( 'NONAME' , 'NOTITLE' , 'NOUNIT' , .false. , .false. , .false. , .false.) 
     153      ! 
    275154      IF(lwp) WRITE(numout,*) 
    276155      IF(lwp) WRITE(numout,*) 'trc_nam_trc : read the passive tracer namelists' 
    … …  
    286165      IF(lwm) WRITE ( numont, namtrc ) 
    287166 
    288       DO jn = 1, jptra 
    289          ctrcnm    (jn) = TRIM( sn_tracer(jn)%clsname ) 
    290          ctrcln    (jn) = TRIM( sn_tracer(jn)%cllname ) 
    291          ctrcun    (jn) = TRIM( sn_tracer(jn)%clunit  ) 
    292          ln_trc_ini(jn) =       sn_tracer(jn)%llinit 
    293 #if defined key_my_trc 
    294          ln_trc_sbc(jn) =       sn_tracer(jn)%llsbc 
    295          ln_trc_cbc(jn) =       sn_tracer(jn)%llcbc 
    296          ln_trc_obc(jn) =       sn_tracer(jn)%llobc 
    297 #endif 
    298          ln_trc_wri(jn) =       sn_tracer(jn)%llsave 
    299       END DO 
    300       ! 
     167      ! Control settings 
     168      IF( ln_pisces .AND. ln_my_trc )   CALL ctl_stop( 'Choose only ONE BGC model - PISCES or MY_TRC' ) 
     169      IF( .NOT. ln_pisces .AND. .NOT. ln_my_trc )   jp_bgc = 0 
     170      ll_cfc = ln_cfc11 .OR. ln_cfc12 .OR. ln_sf6 
     171      ! 
     172      jptra       =  0 
     173      jp_pisces   =  0    ;   jp_pcs0  =  0    ;   jp_pcs1  = 0 
     174      jp_my_trc   =  0    ;   jp_myt0  =  0    ;   jp_myt1  = 0 
     175      jp_cfc      =  0    ;   jp_cfc0  =  0    ;   jp_cfc1  = 0 
     176      jp_age      =  0    ;   jp_c14   =  0 
     177      ! 
     178      IF( ln_pisces )  THEN 
     179         jp_pisces = jp_bgc 
     180         jp_pcs0   = 1 
     181         jp_pcs1   = jp_pisces 
     182      ENDIF 
     183      IF( ln_my_trc )  THEN 
     184          jp_my_trc = jp_bgc 
     185          jp_myt0   = 1 
     186          jp_myt1   = jp_my_trc 
     187      ENDIF 
     188      ! 
     189      jptra  = jp_bgc 
     190      ! 
     191      IF( ln_age )    THEN 
     192         jptra     = jptra + 1 
     193         jp_age    = jptra 
     194      ENDIF 
     195      IF( ln_cfc11 )  jp_cfc = jp_cfc + 1 
     196      IF( ln_cfc12 )  jp_cfc = jp_cfc + 1 
     197      IF( ln_sf6   )  jp_cfc = jp_cfc + 1 
     198      IF( ll_cfc )    THEN 
     199          jptra     = jptra + jp_cfc 
     200          jp_cfc0   = jptra - jp_cfc + 1 
     201          jp_cfc1   = jptra 
     202      ENDIF 
     203      IF( ln_c14 )    THEN 
     204           jptra     = jptra + 1 
     205           jp_c14    = jptra 
     206      ENDIF 
     207      ! 
     208      IF( jptra == 0 )   CALL ctl_stop( 'All TOP tracers disabled: change namtrc setting or check if key_top is active' ) 
     209      ! 
     210      IF(lwp) THEN                   ! control print 
     211         WRITE(numout,*) 
     212         WRITE(numout,*) ' Namelist : namtrc' 
     213         WRITE(numout,*) '   Total number of passive tracers              jptra         = ', jptra 
     214         WRITE(numout,*) '   Total number of BGC tracers                  jp_bgc        = ', jp_bgc 
     215         WRITE(numout,*) '   Simulating PISCES model                      ln_pisces     = ', ln_pisces 
     216         WRITE(numout,*) '   Simulating MY_TRC  model                     ln_my_trc     = ', ln_my_trc 
     217         WRITE(numout,*) '   Simulating water mass age                    ln_age        = ', ln_age 
     218         WRITE(numout,*) '   Simulating CFC11 passive tracer              ln_cfc11      = ', ln_cfc11 
     219         WRITE(numout,*) '   Simulating CFC12 passive tracer              ln_cfc12      = ', ln_cfc12 
     220         WRITE(numout,*) '   Simulating SF6 passive tracer                ln_sf6        = ', ln_sf6 
     221         WRITE(numout,*) '   Total number of CFCs tracers                 jp_cfc        = ', jp_cfc 
     222         WRITE(numout,*) '   Simulating C14   passive tracer              ln_c14        = ', ln_c14 
     223         WRITE(numout,*) '   Read inputs data from file (y/n)             ln_trcdta     = ', ln_trcdta 
     224         WRITE(numout,*) '   Damping of passive tracer (y/n)              ln_trcdmp     = ', ln_trcdmp 
     225         WRITE(numout,*) '   Restoring of tracer on closed seas           ln_trcdmp_clo = ', ln_trcdmp_clo 
     226         WRITE(numout,*) ' ' 
     227         WRITE(numout,*) ' ' 
     228      ENDIF 
     229      ! 
     230      IF( ll_cfc .OR. ln_c14 ) THEN 
     231        !                             ! Open namelist files 
     232        CALL ctl_opn( numtrc_ref, 'namelist_trc_ref'   ,     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
     233        CALL ctl_opn( numtrc_cfg, 'namelist_trc_cfg'   ,     'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
     234        IF(lwm) CALL ctl_opn( numonr, 'output.namelist.trc', 'UNKNOWN', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
     235        ! 
     236      ENDIF 
     237 
    301238   END SUBROUTINE trc_nam_trc 
    302239 
    303  
    304    SUBROUTINE trc_nam_dia 
     240   SUBROUTINE trc_nam_trd 
    305241      !!--------------------------------------------------------------------- 
    306242      !!                     ***  ROUTINE trc_nam_dia  *** 
    … …  
    312248      !!                ( (PISCES, CFC, MY_TRC ) 
    313249      !!--------------------------------------------------------------------- 
     250 
     251#if defined key_trdmxl_trc  || defined key_trdtrc 
    314252      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    315253      INTEGER ::  ierr 
    316254      !! 
    317 #if defined key_trdmxl_trc  || defined key_trdtrc 
    318255      NAMELIST/namtrc_trd/ nn_trd_trc, nn_ctls_trc, rn_ucf_trc, & 
    319256         &                ln_trdmxl_trc_restart, ln_trdmxl_trc_instant, & 
    320257         &                cn_trdrst_trc_in, cn_trdrst_trc_out, ln_trdtrc 
    321 #endif 
    322       NAMELIST/namtrc_dia/ ln_diatrc, ln_diabio, nn_writedia, nn_writebio 
    323258      !!--------------------------------------------------------------------- 
    324259 
    325260      IF(lwp) WRITE(numout,*) 
    326       IF(lwp) WRITE(numout,*) 'trc_nam_dia : read the passive tracer diagnostics options' 
     261      IF(lwp) WRITE(numout,*) 'trc_nam_trd : read the passive tracer diagnostics options' 
    327262      IF(lwp) WRITE(numout,*) '~~~~~~~' 
    328263 
    329       REWIND( numnat_ref )              ! Namelist namtrc_dia in reference namelist : Passive tracer diagnostics 
    330       READ  ( numnat_ref, namtrc_dia, IOSTAT = ios, ERR = 903) 
    331 903   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dia in reference namelist', lwp ) 
    332  
    333       REWIND( numnat_cfg )              ! Namelist namtrc_dia in configuration namelist : Passive tracer diagnostics 
    334       READ  ( numnat_cfg, namtrc_dia, IOSTAT = ios, ERR = 904 ) 
    335 904   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_dia in configuration namelist', lwp ) 
    336       IF(lwm) WRITE ( numont, namtrc_dia ) 
     264      ! 
     265      ALLOCATE( ln_trdtrc(jptra) )  
     266      ! 
     267      REWIND( numnat_ref )              ! Namelist namtrc_trd in reference namelist : Passive tracer trends 
     268      READ  ( numnat_ref, namtrc_trd, IOSTAT = ios, ERR = 905) 
     269905   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_trd in reference namelist', lwp ) 
     270 
     271      REWIND( numnat_cfg )              ! Namelist namtrc_trd in configuration namelist : Passive tracer trends 
     272      READ  ( numnat_cfg, namtrc_trd, IOSTAT = ios, ERR = 906 ) 
     273906   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namtrc_trd in configuration namelist', lwp ) 
     274      IF(lwm) WRITE ( numont, namtrc_trd ) 
    337275 
    338276      IF(lwp) THEN 
    339277         WRITE(numout,*) 
    340          WRITE(numout,*) 
    341          WRITE(numout,*) ' Namelist : namtrc_dia' 
    342          WRITE(numout,*) '    save additionnal diagnostics arrays         ln_diatrc   = ', ln_diatrc 
    343          WRITE(numout,*) '    save additionnal biology diagnostics arrays ln_diabio   = ', ln_diabio 
    344          WRITE(numout,*) '    frequency of outputs for additional arrays  nn_writedia = ', nn_writedia 
    345          WRITE(numout,*) '    frequency of outputs for biological trends  nn_writebio = ', nn_writebio 
    346          WRITE(numout,*) ' ' 
    347       ENDIF 
    348  
    349       IF( ln_diatrc .AND. .NOT. lk_iomput ) THEN  
    350          ALLOCATE( trc2d(jpi,jpj,jpdia2d), trc3d(jpi,jpj,jpk,jpdia3d),  & 
    351            &       ctrc2d(jpdia2d), ctrc2l(jpdia2d), ctrc2u(jpdia2d) ,  &  
    352            &       ctrc3d(jpdia3d), ctrc3l(jpdia3d), ctrc3u(jpdia3d) ,  STAT = ierr )  
    353          IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'trcnam: unable to allocate add. diag. array' ) 
    354          ! 
    355          trc2d(:,:,:  ) = 0._wp  ;   ctrc2d(:) = ' '   ;   ctrc2l(:) = ' '    ;    ctrc2u(:) = ' '  
    356          trc3d(:,:,:,:) = 0._wp  ;   ctrc3d(:) = ' '   ;   ctrc3l(:) = ' '    ;    ctrc3u(:) = ' '  
    357          ! 
    358       ENDIF 
    359  
    360       IF( ( ln_diabio .AND. .NOT. lk_iomput ) .OR. l_trdtrc ) THEN 
    361          ALLOCATE( trbio (jpi,jpj,jpk,jpdiabio) , & 
    362            &       ctrbio(jpdiabio), ctrbil(jpdiabio), ctrbiu(jpdiabio), STAT = ierr )  
    363          IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'trcnam: unable to allocate bio. diag. array' ) 
    364          ! 
    365          trbio(:,:,:,:) = 0._wp  ;   ctrbio(:) = ' '   ;   ctrbil(:) = ' '    ;    ctrbiu(:) = ' '  
    366          ! 
    367       ENDIF 
    368       ! 
    369    END SUBROUTINE trc_nam_dia 
     278         WRITE(numout,*) ' trd_mxl_trc_init : read namelist namtrc_trd                    ' 
     279         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~                                               ' 
     280         WRITE(numout,*) '   * frequency of trends diagnostics   nn_trd_trc             = ', nn_trd_trc 
     281         WRITE(numout,*) '   * control surface type              nn_ctls_trc            = ', nn_ctls_trc 
     282         WRITE(numout,*) '   * restart for ML diagnostics        ln_trdmxl_trc_restart  = ', ln_trdmxl_trc_restart 
     283         WRITE(numout,*) '   * flag to diagnose trends of                                 ' 
     284         WRITE(numout,*) '     instantantaneous or mean ML T/S   ln_trdmxl_trc_instant  = ', ln_trdmxl_trc_instant 
     285         WRITE(numout,*) '   * unit conversion factor            rn_ucf_trc             = ', rn_ucf_trc 
     286         DO jn = 1, jptra 
     287            IF( ln_trdtrc(jn) ) WRITE(numout,*) '    compute ML trends for tracer number :', jn 
     288         END DO 
     289      ENDIF 
     290#endif 
     291      ! 
     292   END SUBROUTINE trc_nam_trd 
    370293 
    371294#else 

  • trunk/NEMOGCM/NEMO/TOP_SRC/trcrst.F90

    r7055 r7646  
    5252      !!---------------------------------------------------------------------- 
    5353      ! 
    54       IF( lk_offline ) THEN 
     54      IF( l_offline ) THEN 
    5555         IF( kt == nittrc000 ) THEN 
    5656            lrst_trc = .FALSE. 
    … …  
    147147          lrst_trc = .FALSE. 
    148148#endif 
    149           IF( lk_offline .AND. ln_rst_list ) THEN 
     149          IF( l_offline .AND. ln_rst_list ) THEN 
    150150             nrst_lst = nrst_lst + 1 
    151151             nitrst = nstocklist( nrst_lst ) 
    … …  
    219219         ENDIF 
    220220         ! 
    221          IF( lk_offline ) THEN     
     221         IF( l_offline ) THEN     
    222222            !                                          ! set the date in offline mode 
    223223            IF( ln_rsttr .AND. nn_rsttr == 2 ) THEN 

  • trunk/NEMOGCM/NEMO/TOP_SRC/trcsms.F90

    r5656 r7646  
    1616   USE trc                ! 
    1717   USE trcsms_pisces      ! PISCES biogeo-model 
    18    USE trcsms_cfc         ! CFC 11 & 12 
    19    USE trcsms_c14b        ! C14b tracer  
     18   USE trcsms_cfc         ! CFC 11 &/or 12 
     19   USE trcsms_c14         ! C14  
     20   USE trcsms_age         ! AGE 
    2021   USE trcsms_my_trc      ! MY_TRC  tracers 
    2122   USE prtctl_trc         ! Print control for debbuging 
    … …  
    4849      IF( nn_timing == 1 )   CALL timing_start('trc_sms') 
    4950      ! 
    50       IF( lk_pisces  )   CALL trc_sms_pisces ( kt )    ! main program of PISCES  
    51       IF( lk_cfc     )   CALL trc_sms_cfc    ( kt )    ! surface fluxes of CFC 
    52       IF( lk_c14b    )   CALL trc_sms_c14b   ( kt )    ! surface fluxes of C14 
    53       IF( lk_my_trc  )   CALL trc_sms_my_trc ( kt )    ! MY_TRC  tracers 
     51      IF( ln_pisces  )   CALL trc_sms_pisces ( kt )    ! main program of PISCES  
     52      IF( ll_cfc     )   CALL trc_sms_cfc    ( kt )    ! surface fluxes of CFC 
     53      IF( ln_c14     )   CALL trc_sms_c14    ( kt )    ! surface fluxes of C14 
     54      IF( ln_age     )   CALL trc_sms_age    ( kt )    ! Age tracer 
     55      IF( ln_my_trc  )   CALL trc_sms_my_trc ( kt )    ! MY_TRC  tracers 
    5456 
    5557      IF(ln_ctl) THEN      ! print mean trends (used for debugging) 

  • trunk/NEMOGCM/NEMO/TOP_SRC/trcstp.F90

    r6981 r7646  
    1515   USE trctrp           ! passive tracers transport 
    1616   USE trcsms           ! passive tracers sources and sinks 
    17    USE prtctl_trc       ! Print control for debbuging 
    18    USE trcdia 
    1917   USE trcwri 
    2018   USE trcrst 
    2119   USE trdtrc_oce 
    2220   USE trdmxl_trc 
     21   USE prtctl_trc       ! Print control for debbuging 
    2322   USE iom 
    2423   USE in_out_manager 
    … …  
    6261      IF( nn_timing == 1 )   CALL timing_start('trc_stp') 
    6362      ! 
     63      IF( ( neuler == 0 .AND. kt == nittrc000 ) .OR. ln_top_euler ) THEN     ! at nittrc000 
     64         r2dttrc =  rdttrc           ! = rdttrc (use or restarting with Euler time stepping) 
     65      ELSEIF( kt <= nittrc000 + nn_dttrc ) THEN          ! at nittrc000 or nittrc000+1 
     66         r2dttrc = 2. * rdttrc       ! = 2 rdttrc (leapfrog) 
     67      ENDIF 
     68      ! 
    6469      IF( kt == nittrc000 .AND. lk_trdmxl_trc )  CALL trd_mxl_trc_init    ! trends: Mixed-layer 
    6570      ! 
    … …  
    6873            cvol(:,:,jk) = e1e2t(:,:) * e3t_n(:,:,jk) * tmask(:,:,jk) 
    6974         END DO 
    70          IF( lk_degrad )  cvol(:,:,:) = cvol(:,:,:) * facvol(:,:,:)       ! degrad option: reduction by facvol 
    7175         areatot         = glob_sum( cvol(:,:,:) ) 
    7276      ENDIF 
    … …  
    8791                                   CALL trc_rst_opn  ( kt )       ! Open tracer restart file  
    8892         IF( lrst_trc )            CALL trc_rst_cal  ( kt, 'WRITE' )   ! calendar 
    89          IF( lk_iomput ) THEN  ;   CALL trc_wri      ( kt )       ! output of passive tracers with iom I/O manager 
    90          ELSE                  ;   CALL trc_dia      ( kt )       ! output of passive tracers with old I/O manager 
    91          ENDIF 
     93                                   CALL trc_wri      ( kt )       ! output of passive tracers with iom I/O manager 
    9294                                   CALL trc_sms      ( kt )       ! tracers: sinks and sources 
    9395                                   CALL trc_trp      ( kt )       ! transport of passive tracers 

  • trunk/NEMOGCM/NEMO/TOP_SRC/trcsub.F90

    r7091 r7646  
    2020   USE domvvl 
    2121   USE divhor          ! horizontal divergence            (div_hor routine) 
    22    USE sbcrnf, ONLY: h_rnf, nk_rnf   ! River runoff  
    23    USE bdy_oce 
     22   USE sbcrnf    , ONLY: h_rnf, nk_rnf    ! River runoff 
     23   USE bdy_oce   , ONLY: ln_bdy, bdytmask ! BDY 
    2424#if defined key_agrif 
    2525   USE agrif_opa_update 
    … …  
    493493      z1_rau0 = 0.5 / rau0 
    494494      ssha(:,:) = (  sshb(:,:) - z2dt * ( z1_rau0 * ( emp_b(:,:) + emp(:,:) ) + zhdiv(:,:) )  ) * tmask(:,:,1) 
    495 #if ! defined key_dynspg_ts 
     495 
     496      IF( .NOT.ln_dynspg_ts ) THEN 
    496497      ! These lines are not necessary with time splitting since 
    497498      ! boundary condition on sea level is set during ts loop 
    … …  
    499500      CALL agrif_ssh( kt ) 
    500501#endif 
    501 #if defined key_bdy 
    502       ssha(:,:) = ssha(:,:) * bdytmask(:,:) 
    503       CALL lbc_lnk( ssha, 'T', 1. )  
    504 #endif 
    505 #endif 
     502         IF( ln_bdy ) THEN 
     503            ssha(:,:) = ssha(:,:) * bdytmask(:,:) 
     504            CALL lbc_lnk( ssha, 'T', 1. )  
     505         ENDIF 
     506      ENDIF 
    506507      ! 
    507508      !                                           !------------------------------! 
    … …  
    514515            &                      - ( e3t_a(:,:,jk) - e3t_b(:,:,jk) )    & 
    515516            &                         * tmask(:,:,jk) * z1_2dt 
    516 #if defined key_bdy 
    517          wn(:,:,jk) = wn(:,:,jk) * bdytmask(:,:) 
    518 #endif 
     517         IF( ln_bdy ) wn(:,:,jk) = wn(:,:,jk) * bdytmask(:,:) 
    519518      END DO 
    520519      ! 

  • trunk/NEMOGCM/NEMO/TOP_SRC/trcwri.F90

    r5836 r7646  
    1919   USE trcwri_pisces 
    2020   USE trcwri_cfc 
    21    USE trcwri_c14b 
     21   USE trcwri_c14 
     22   USE trcwri_age 
    2223   USE trcwri_my_trc 
    2324 
    … …  
    4546      IF( nn_timing == 1 )  CALL timing_start('trc_wri') 
    4647      ! 
    47       IF( lk_offline .AND. kt == nittrc000 .AND. lwp ) THEN    ! WRITE root name in date.file for use by postpro 
     48      IF( l_offline .AND. kt == nittrc000 .AND. lwp ) THEN    ! WRITE root name in date.file for use by postpro 
    4849         CALL dia_nam( clhstnam, nn_writetrc,' ' ) 
    4950         CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
    … …  
    5354      ! write the tracer concentrations in the file 
    5455      ! --------------------------------------- 
    55       IF( lk_pisces  )   CALL trc_wri_pisces     ! PISCES  
    56       IF( lk_cfc     )   CALL trc_wri_cfc        ! surface fluxes of CFC 
    57       IF( lk_c14b    )   CALL trc_wri_c14b       ! surface fluxes of C14 
    58       IF( lk_my_trc  )   CALL trc_wri_my_trc     ! MY_TRC  tracers 
     56      IF( ln_pisces  )   CALL trc_wri_pisces     ! PISCES  
     57      IF( ll_cfc     )   CALL trc_wri_cfc        ! surface fluxes of CFC 
     58      IF( ln_c14     )   CALL trc_wri_c14        ! surface fluxes of C14 
     59      IF( ln_age     )   CALL trc_wri_age        ! AGE tracer 
     60      IF( ln_my_trc  )   CALL trc_wri_my_trc     ! MY_TRC  tracers 
    5961      ! 
    6062      IF( nn_timing == 1 )  CALL timing_stop('trc_wri') 
Note: See TracChangeset for help on using the changeset viewer.