Ignore:
Timestamp:
2012-01-28T17:44:18+01:00 (10 years ago)
Author:
rblod
Message:

Merge of 3.4beta into the trunk

Location:
trunk/NEMOGCM/NEMO/TOP_SRC
Files:
62 edited
1 copied

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/TOP_SRC/C14b/trcini_c14b.F90

    r2715 r3294  
    181181      IF( ctrcnm(jpc14) /= 'C14B' ) THEN 
    182182          ctrcnm(jpc14)  = 'C14B' 
    183           ctrcnl(jpc14)  = 'Bomb C14 concentration' 
     183          ctrcln(jpc14)  = 'Bomb C14 concentration' 
    184184      ENDIF 
    185185 
    186186      IF(lwp) THEN 
    187187         CALL ctl_warn( ' we force tracer names' ) 
    188          WRITE(numout,*) ' tracer nb: ',jpc14,' name = ',ctrcnm(jpc14), ctrcnl(jpc14) 
     188         WRITE(numout,*) ' tracer nb: ',jpc14,' name = ',ctrcnm(jpc14), ctrcln(jpc14) 
    189189         WRITE(numout,*) ' ' 
    190190      ENDIF 
  • trunk/NEMOGCM/NEMO/TOP_SRC/C14b/trcnam_c14b.F90

    r2715 r3294  
    1616   USE trc             ! TOP variables 
    1717   USE trcsms_c14b     ! C14b specific variable 
     18   USE iom             ! I/O manager 
    1819 
    1920   IMPLICIT NONE 
     
    3738      !! 
    3839      !! ** Method  :   Read the namc14 namelist and check the parameter  
    39       !!       values called at the first timestep (nit000) 
     40      !!       values called at the first timestep (nittrc000) 
    4041      !! 
    4142      !! ** input   :   Namelist namelist_c14b 
     
    4344      INTEGER ::   numnatb 
    4445 
    45 #if defined key_diatrc && ! defined key_iomput 
    4646      ! definition of additional diagnostic as a structure 
    47       INTEGER ::   jl, jn 
    48       TYPE DIAG 
    49          CHARACTER(len = 20)  :: snamedia   !: short name 
    50          CHARACTER(len = 80 ) :: lnamedia   !: long name 
    51          CHARACTER(len = 20 ) :: unitdia    !: unit 
    52       END TYPE DIAG 
    53  
    54       TYPE(DIAG) , DIMENSION(jp_c14b_2d) :: c14dia2d 
    55       TYPE(DIAG) , DIMENSION(jp_c14b_3d) :: c14dia3d 
    56 #endif 
     47      INTEGER :: jl, jn 
     48      TYPE(DIAG), DIMENSION(jp_c14b_2d) :: c14dia2d 
     49      TYPE(DIAG), DIMENSION(jp_c14b_3d) :: c14dia3d 
    5750      !! 
    5851      NAMELIST/namc14date/ ndate_beg_b, nyear_res_b 
    59 #if defined key_diatrc && ! defined key_iomput 
    60       NAMELIST/namc14dia/nn_writedia, c14dia2d, c14dia3d     ! additional diagnostics 
    61 #endif 
     52      NAMELIST/namc14dia/  c14dia2d, c14dia3d     ! additional diagnostics 
    6253      !!------------------------------------------------------------------- 
    6354 
     
    8071      IF(lwp) WRITE(numout,*) '    initial year (aa)                  nyear_beg_b = ', nyear_beg_b 
    8172      ! 
    82 #if defined key_diatrc && ! defined key_iomput 
     73      IF( .NOT.lk_iomput .AND. ln_diatrc ) THEN 
     74         ! 
     75         ! Namelist namc14dia 
     76         ! ------------------- 
     77         DO jl = 1, jp_c14b_2d 
     78            WRITE(c14dia2d(jl)%sname,'("2D_",I1)') jl                      ! short name 
     79            WRITE(c14dia2d(jl)%lname,'("2D DIAGNOSTIC NUMBER ",I2)') jl    ! long name 
     80            c14dia2d(jl)%units = ' '                                       ! units 
     81         END DO 
     82         !                                 ! 3D output arrays 
     83         DO jl = 1, jp_c14b_3d 
     84            WRITE(c14dia3d(jl)%sname,'("3D_",I1)') jl                      ! short name 
     85            WRITE(c14dia3d(jl)%lname,'("3D DIAGNOSTIC NUMBER ",I2)') jl    ! long name 
     86            c14dia3d(jl)%units = ' '                                       ! units 
     87         END DO 
    8388 
    84       ! Namelist namc14dia 
    85       ! ------------------- 
    86       nn_writedia = 10                   ! default values 
    87  
    88       DO jl = 1, jp_c14b_2d 
    89          jn = jp_c14b0_2d + jl - 1 
    90          WRITE(ctrc2d(jn),'("2D_",I1)') jn                      ! short name 
    91          WRITE(ctrc2l(jn),'("2D DIAGNOSTIC NUMBER ",I2)') jn    ! long name 
    92          ctrc2u(jn) = ' '                                       ! units 
    93       END DO 
    94       !                                 ! 3D output arrays 
    95       DO jl = 1, jp_c14b_3d 
    96          jn = jp_c14b0_3d + jl - 1 
    97          WRITE(ctrc3d(jn),'("3D_",I1)') jn                      ! short name 
    98          WRITE(ctrc3l(jn),'("3D DIAGNOSTIC NUMBER ",I2)') jn    ! long name 
    99          ctrc3u(jn) = ' '                                       ! units 
    100       END DO 
    101  
    102       REWIND( numnatb )               ! read natrtd 
    103       READ  ( numnatb, namc14dia ) 
    104  
    105       DO jl = 1, jp_c14b_2d 
    106          jn = jp_c14b0_2d + jl - 1 
    107          ctrc2d(jn) = c14dia2d(jl)%snamedia 
    108          ctrc2l(jn) = c14dia2d(jl)%lnamedia 
    109          ctrc2u(jn) = c14dia2d(jl)%unitdia 
    110       END DO 
    111  
    112       DO jl = 1, jp_c14b_3d 
    113          jn = jp_c14b0_3d + jl - 1 
    114          ctrc3d(jn) = c14dia3d(jl)%snamedia 
    115          ctrc3l(jn) = c14dia3d(jl)%lnamedia 
    116          ctrc3u(jn) = c14dia3d(jl)%unitdia 
    117       END DO 
    118  
    119       IF(lwp) THEN                   ! control print 
    120          WRITE(numout,*) 
    121          WRITE(numout,*) ' Namelist : natadd' 
    122          WRITE(numout,*) '    frequency of outputs for additional arrays nn_writedia = ', nn_writedia 
    123          DO jl = 1, jp_c14b_3d 
    124             jn = jp_c14b0_3d + jl - 1 
    125             WRITE(numout,*) '   3d output field No : ',jn 
    126             WRITE(numout,*) '   short name         : ', TRIM(ctrc3d(jn)) 
    127             WRITE(numout,*) '   long name          : ', TRIM(ctrc3l(jn)) 
    128             WRITE(numout,*) '   unit               : ', TRIM(ctrc3u(jn)) 
    129             WRITE(numout,*) ' ' 
    130          END DO 
     89         REWIND( numnatb )               !  
     90         READ  ( numnatb, namc14dia ) 
    13191 
    13292         DO jl = 1, jp_c14b_2d 
    13393            jn = jp_c14b0_2d + jl - 1 
    134             WRITE(numout,*) '   2d output field No : ',jn 
    135             WRITE(numout,*) '   short name         : ', TRIM(ctrc2d(jn)) 
    136             WRITE(numout,*) '   long name          : ', TRIM(ctrc2l(jn)) 
    137             WRITE(numout,*) '   unit               : ', TRIM(ctrc2u(jn)) 
     94            ctrc2d(jn) = c14dia2d(jl)%sname 
     95            ctrc2l(jn) = c14dia2d(jl)%lname 
     96            ctrc2u(jn) = c14dia2d(jl)%units 
     97         END DO 
     98 
     99         DO jl = 1, jp_c14b_3d 
     100            jn = jp_c14b0_3d + jl - 1 
     101            ctrc3d(jn) = c14dia3d(jl)%sname 
     102            ctrc3l(jn) = c14dia3d(jl)%lname 
     103            ctrc3u(jn) = c14dia3d(jl)%units 
     104         END DO 
     105 
     106         IF(lwp) THEN                   ! control print 
     107            WRITE(numout,*) 
     108            WRITE(numout,*) ' Namelist : natadd' 
     109            DO jl = 1, jp_c14b_3d 
     110               jn = jp_c14b0_3d + jl - 1 
     111               WRITE(numout,*) '  3d diag nb : ', jn, '    short name : ', ctrc3d(jn), & 
     112                 &             '  long name  : ', ctrc3l(jn), '   unit : ', ctrc3u(jn) 
     113            END DO 
    138114            WRITE(numout,*) ' ' 
    139          END DO 
     115 
     116            DO jl = 1, jp_c14b_2d 
     117               jn = jp_c14b0_2d + jl - 1 
     118               WRITE(numout,*) '  2d diag nb : ', jn, '    short name : ', ctrc2d(jn), & 
     119                 &             '  long name  : ', ctrc2l(jn), '   unit : ', ctrc2u(jn) 
     120            END DO 
     121            WRITE(numout,*) ' ' 
     122         ENDIF 
     123         ! 
    140124      ENDIF 
    141  
    142 #endif 
    143125 
    144126   END SUBROUTINE trc_nam_c14b 
  • trunk/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90

    r2715 r3294  
    9494      !! 
    9595      !!---------------------------------------------------------------------- 
    96       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    97       USE wrk_nemo, ONLY:   zatmbc14 => wrk_2d_1 
    98       USE wrk_nemo, ONLY:   zw3d     => wrk_3d_1 
    9996      ! 
    10097      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
     
    113110      REAL(wp) :: zpv               ! piston velocity  
    114111      REAL(wp) :: zdemi, ztra 
    115       !!---------------------------------------------------------------------- 
    116  
    117       IF( wrk_in_use(2, 1) .OR. wrk_in_use(3, 1) ) THEN 
    118          CALL ctl_stop('trc_sms_c14b : requested workspace arrays unavailable')   ;   RETURN 
    119       ENDIF 
    120  
    121       IF( kt == nit000 )  THEN         ! Computation of decay coeffcient 
     112      REAL(wp), POINTER, DIMENSION(:,:  ) :: zatmbc14   
     113      REAL(wp), POINTER, DIMENSION(:,:,:) :: zdecay 
     114      !!--------------------------------------------------------------------- 
     115      ! 
     116      IF( nn_timing == 1 )  CALL timing_start('trc_sms_c14b') 
     117      ! 
     118      ! Allocate temporary workspace 
     119      CALL wrk_alloc( jpi, jpj,      zatmbc14 ) 
     120      CALL wrk_alloc( jpi, jpj, jpk, zdecay   ) 
     121 
     122      IF( kt == nittrc000 )  THEN         ! Computation of decay coeffcient 
    122123         zdemi   = 5730._wp 
    123124         xlambda = LOG(2.) / zdemi / ( nyear_len(1) * rday ) 
     
    246247#endif 
    247248                  &                      * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) ) / 2. 
    248  
    249249            ! Add the surface flux to the trend 
    250250            tra(ji,jj,1,jpc14) = tra(ji,jj,1,jpc14) + qtr_c14(ji,jj) / fse3t(ji,jj,1)  
     
    252252            ! cumulation of surface flux at each time step 
    253253            qint_c14(ji,jj) = qint_c14(ji,jj) + qtr_c14(ji,jj) * rdt 
    254  
    255 # if defined key_diatrc && ! defined key_iomput 
    256             ! Save 2D diagnostics 
    257             trc2d(ji,jj,jp_c14b0_2d    ) = qtr_c14 (ji,jj) 
    258             trc2d(ji,jj,jp_c14b0_2d + 1) = qint_c14(ji,jj) 
    259 # endif  
     254            ! 
    260255         END DO 
    261256      END DO 
     
    265260         DO jj = 1, jpj 
    266261            DO ji = 1, jpi 
    267 #if ! defined key_degrad 
    268                ztra = trn(ji,jj,jk,jpc14) * xaccum 
     262#if defined key_degrad 
     263               zdecay(ji,jj,jk) = trn(ji,jj,jk,jpc14) * ( 1. - EXP( -xlambda * rdt * facvol(ji,jj,jk) ) ) 
    269264#else 
    270                ztra = trn(ji,jj,jk,jpc14) * ( 1. - EXP( -xlambda * rdt * facvol(ji,jj,jk) ) ) 
     265               zdecay(ji,jj,jk) = trn(ji,jj,jk,jpc14) * xaccum 
    271266#endif 
    272                tra(ji,jj,jk,jpc14) = tra(ji,jj,jk,jpc14) - ztra / rdt 
    273 #if defined key_diatrc 
    274                ! Save 3D diagnostics 
    275 # if ! defined key_iomput 
    276                trc3d(ji,jj,jk,jp_c14b0_3d ) = ztra    !  radioactive decay 
    277 # else  
    278                zw3d(ji,jj,jk) = ztra    !  radioactive decay 
    279 # endif 
    280 #endif 
     267               tra(ji,jj,jk,jpc14) = tra(ji,jj,jk,jpc14) - zdecay(ji,jj,jk) / rdt 
     268               ! 
    281269            END DO 
    282270         END DO 
    283271      END DO 
    284272 
    285 #if defined key_diatrc  && defined key_iomput 
    286       CALL iom_put( "qtrC14b"  , qtr_c14  ) 
    287       CALL iom_put( "qintC14b" , qint_c14 ) 
    288 #endif 
    289 #if defined key_diatrc  && defined key_iomput 
    290       CALL iom_put( "fdecay" , zw3d ) 
    291 #endif 
    292       IF( l_trdtrc )   CALL trd_mod_trc( tra(:,:,:,jpc14), jpc14, jptra_trd_sms, kt )   ! save trends 
    293  
    294       IF( wrk_not_released(2, 1) .OR.   & 
    295           wrk_not_released(3, 1) )   CALL ctl_stop('trc_sms_c14b : failed to release workspace arrays') 
     273      IF( ln_diatrc ) THEN 
     274         IF( lk_iomput ) THEN 
     275            CALL iom_put( "qtrC14b"  , qtr_c14  ) 
     276            CALL iom_put( "qintC14b" , qint_c14 ) 
     277            CALL iom_put( "fdecay"   , zdecay   ) 
     278          ELSE 
     279            trc2d(:,:  ,jp_c14b0_2d     ) = qtr_c14 (:,:) 
     280            trc2d(:,:  ,jp_c14b0_2d + 1 ) = qint_c14(:,:) 
     281            trc3d(:,:,:,jp_c14b0_3d     ) = zdecay  (:,:,:) 
     282          ENDIF 
     283      ENDIF 
     284 
     285      IF( l_trdtrc )  CALL trd_mod_trc( tra(:,:,:,jpc14), jpc14, jptra_trd_sms, kt )   ! save trends 
     286 
     287      CALL wrk_dealloc( jpi, jpj,      zatmbc14 ) 
     288      CALL wrk_dealloc( jpi, jpj, jpk, zdecay   ) 
     289      ! 
     290      IF( nn_timing == 1 )  CALL timing_stop('trc_sms_c14b') 
    296291      ! 
    297292   END SUBROUTINE trc_sms_c14b 
  • trunk/NEMOGCM/NEMO/TOP_SRC/CFC/par_cfc.F90

    r2528 r3294  
    3232   !!--------------------------------------------------------------------- 
    3333   LOGICAL, PUBLIC, PARAMETER ::   lk_cfc     = .TRUE.      !: CFC flag  
    34    INTEGER, PUBLIC, PARAMETER ::   jp_cfc     =  2          !: number of passive tracers 
     34   INTEGER, PUBLIC, PARAMETER ::   jp_cfc     =  1          !: number of passive tracers 
    3535   INTEGER, PUBLIC, PARAMETER ::   jp_cfc_2d  =  2          !: additional 2d output arrays ('key_trc_diaadd') 
    3636   INTEGER, PUBLIC, PARAMETER ::   jp_cfc_3d  =  0          !: additional 3d output arrays ('key_trc_diaadd') 
  • trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trcini_cfc.F90

    r2715 r3294  
    44   !! TOP :   initialisation of the CFC tracers 
    55   !!====================================================================== 
    6    !! History :   2.0  !  2007-12  (C. Ethe, G. Madec) from trcini.cfc.h90 
     6   !! History :   2.0  !  2007-12  (C. Ethe, G. Madec)  
    77   !!---------------------------------------------------------------------- 
    88#if defined key_cfc 
     
    4343      !! ** Method  : - Read the namcfc namelist and check the parameter values 
    4444      !!---------------------------------------------------------------------- 
    45       INTEGER  ::  ji, jj, jn, jl, jm, js 
     45      INTEGER  ::  ji, jj, jn, jl, jm, js, io, ierr 
     46      INTEGER  ::  iskip = 6   ! number of 1st descriptor lines 
    4647      REAL(wp) ::  zyy, zyd 
    4748      !!---------------------------------------------------------------------- 
     
    5152      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~' 
    5253 
     54 
     55      IF(lwp) WRITE(numout,*) 'read of formatted file cfc1112atm' 
     56       
     57      CALL ctl_opn( inum, clname, 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
     58      REWIND(inum) 
     59       
     60      ! compute the number of year in the file 
     61      ! file starts in 1931 do jn represent the year in the century 
     62      jn = 31  
     63      DO  
     64        READ(inum,'(1x)',END=100)  
     65        jn = jn + 1 
     66      END DO 
     67 100  jpyear = jn - 1 - iskip 
     68      IF ( lwp) WRITE(numout,*) '    ', jpyear ,' years read' 
    5369      !                                ! Allocate CFC arrays 
     70 
     71      ALLOCATE( p_cfc(jpyear,jphem,2), STAT=ierr ) 
     72      IF( ierr > 0 ) THEN 
     73         CALL ctl_stop( 'trc_ini_cfc: unable to allocate p_cfc array' )   ;   RETURN 
     74      ENDIF 
    5475      IF( trc_sms_cfc_alloc() /= 0 )   CALL ctl_stop( 'STOP', 'trc_ini_cfc: unable to allocate CFC arrays' ) 
    5576 
     
    7596      ENDIF 
    7697 
    77  
    78       !   READ CFC partial pressure atmospheric value : 
    79       !     p11(year,nt) = PCFC11  in northern (1) and southern (2) hemisphere  
    80       !     p12(year,nt) = PCFC12  in northern (1) and southern (2) hemisphere  
    81       !-------------------------------------------------------------------- 
    82  
    83       IF(lwp) WRITE(numout,*) 'read of formatted file cfc1112atm' 
    84        
    85       CALL ctl_opn( inum, clname, 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
    8698      REWIND(inum) 
    8799       
    88       DO jm = 1, 6        ! Skip over 1st six descriptor lines 
     100      DO jm = 1, iskip        ! Skip over 1st six descriptor lines 
    89101         READ(inum,'(1x)') 
    90102      END DO 
    91     
    92103      ! file starts in 1931 do jn represent the year in the century.jhh 
    93104      ! Read file till the end 
    94105      jn = 31 
    95       DO WHILE ( 1 /= 2 ) 
    96          READ(inum,*,END=100) zyy, p_cfc(jn,1,1), p_cfc(jn,1,2), p_cfc(jn,2,1), p_cfc(jn,2,2) 
    97          IF ( lwp) THEN 
    98            WRITE(numout,'(f7.2, 4f8.2)' ) & 
    99             &         zyy, p_cfc(jn,1,1), p_cfc(jn,1,2), p_cfc(jn,2,1), p_cfc(jn,2,2) 
    100          ENDIF 
    101          jn = jn + 1 
     106      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) 
     108        IF( io < 0 ) exit 
     109        jn = jn + 1 
    102110      END DO 
    103  100  npyear = jn - 1 
    104       IF ( lwp) WRITE(numout,*) '    ', npyear ,' years read' 
    105111 
    106112      p_cfc(32,1:2,1) = 5.e-4      ! modify the values of the first years 
     
    116122         WRITE(numout,*) 
    117123         WRITE(numout,*) ' Year   p11HN    p11HS    p12HN    p12HS ' 
    118          DO jn = 30, 100 
     124         DO jn = 30, jpyear 
    119125            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) 
    120126         END DO 
  • trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trcnam_cfc.F90

    r2715 r3294  
    1616   USE trc             ! TOP variables 
    1717   USE trcsms_cfc      ! CFC specific variable 
     18   USE iom             ! I/O manager 
    1819 
    1920   IMPLICIT NONE 
     
    3738      !! 
    3839      !! ** Method  :   Read the namcfc namelist and check the parameter  
    39       !!       values called at the first timestep (nit000) 
     40      !!       values called at the first timestep (nittrc000) 
    4041      !! 
    4142      !! ** input   :   Namelist namcfc 
    4243      !!---------------------------------------------------------------------- 
    43       INTEGER ::   numnatc 
    44 #if defined key_diatrc && ! defined key_iomput 
    45       ! definition of additional diagnostic as a structure 
     44      INTEGER ::  numnatc 
    4645      INTEGER :: jl, jn 
    47       TYPE DIAG 
    48          CHARACTER(len = 20)  :: snamedia   !: short name 
    49          CHARACTER(len = 80 ) :: lnamedia   !: long name 
    50          CHARACTER(len = 20 ) :: unitdia    !: unit 
    51       END TYPE DIAG 
    52  
    53       TYPE(DIAG) , DIMENSION(jp_cfc_2d) :: cfcdia2d 
    54 #endif 
     46      TYPE(DIAG), DIMENSION(jp_cfc_2d) :: cfcdia2d 
    5547      !! 
    5648      NAMELIST/namcfcdate/ ndate_beg, nyear_res 
    57 #if defined key_diatrc && ! defined key_iomput 
    58       NAMELIST/namcfcdia/nn_writedia, cfcdia2d     ! additional diagnostics 
    59 #endif 
     49      NAMELIST/namcfcdia/  cfcdia2d     ! additional diagnostics 
    6050      !!------------------------------------------------------------------- 
    6151 
     
    7868      IF(lwp) WRITE(numout,*) '    initial year (aa)                       nyear_beg = ', nyear_beg 
    7969      ! 
    80 #if defined key_diatrc && ! defined key_iomput 
    8170 
    82       ! Namelist namcfcdia 
    83       ! ------------------- 
    84       nn_writedia = 10                   ! default values 
     71      IF( .NOT.lk_iomput .AND. ln_diatrc ) THEN 
     72         ! 
     73         ! Namelist namcfcdia 
     74         ! ------------------- 
     75         DO jl = 1, jp_cfc_2d 
     76            WRITE(cfcdia2d(jl)%sname,'("2D_",I1)') jl                      ! short name 
     77            WRITE(cfcdia2d(jl)%lname,'("2D DIAGNOSTIC NUMBER ",I2)') jl    ! long name 
     78            cfcdia2d(jl)%units = ' '                                       ! units 
     79         END DO 
    8580 
    86       DO jl = 1, jp_cfc_2d 
    87          jn = jp_cfc0_2d + jl - 1  
    88          WRITE(ctrc2d(jn),'("2D_",I1)') jn                      ! short name 
    89          WRITE(ctrc2l(jn),'("2D DIAGNOSTIC NUMBER ",I2)') jn    ! long name 
    90          ctrc2u(jn) = ' '                                       ! units 
    91       END DO 
     81         REWIND( numnatc )               ! read natrtd 
     82         READ  ( numnatc, namcfcdia ) 
    9283 
    93       REWIND( numnatc )               ! read natrtd 
    94       READ  ( numnatc, namcfcdia ) 
    95  
    96       DO jl = 1, jp_cfc_2d 
    97          jn = jp_cfc0_2d + jl - 1 
    98          ctrc2d(jn) = cfcdia2d(jl)%snamedia 
    99          ctrc2l(jn) = cfcdia2d(jl)%lnamedia 
    100          ctrc2u(jn) = cfcdia2d(jl)%unitdia 
    101       END DO 
    102  
    103  
    104       IF(lwp) THEN                   ! control print 
    105          WRITE(numout,*) 
    106          WRITE(numout,*) ' Namelist : natadd' 
    107          WRITE(numout,*) '    frequency of outputs for additional arrays nn_writedia = ', nn_writedia 
    10884         DO jl = 1, jp_cfc_2d 
    10985            jn = jp_cfc0_2d + jl - 1 
    110             WRITE(numout,*) '   2d output field No : ',jn 
    111             WRITE(numout,*) '   short name         : ', TRIM(ctrc2d(jn)) 
    112             WRITE(numout,*) '   long name          : ', TRIM(ctrc2l(jn)) 
    113             WRITE(numout,*) '   unit               : ', TRIM(ctrc2u(jn)) 
     86            ctrc2d(jn) = TRIM( cfcdia2d(jl)%sname ) 
     87            ctrc2l(jn) = TRIM( cfcdia2d(jl)%lname ) 
     88            ctrc2u(jn) = TRIM( cfcdia2d(jl)%units ) 
     89         END DO 
     90 
     91         IF(lwp) THEN                   ! control print 
     92            WRITE(numout,*) 
     93            WRITE(numout,*) ' Namelist : natadd' 
     94            DO jl = 1, jp_cfc_2d 
     95               jn = jp_cfc0_2d + jl - 1 
     96               WRITE(numout,*) '  2d diag nb : ', jn, '    short name : ', ctrc2d(jn), & 
     97                 &             '  long name  : ', ctrc2l(jn), '   unit : ', ctrc2u(jn) 
     98            END DO 
    11499            WRITE(numout,*) ' ' 
    115          END DO 
     100         ENDIF 
     101         ! 
    116102      ENDIF 
    117 #endif 
    118103 
    119104   END SUBROUTINE trc_nam_cfc 
  • trunk/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90

    r2715 r3294  
    2828   PUBLIC   trc_sms_cfc_alloc   ! called in trcini_cfc.F90 
    2929 
    30    INTEGER , PUBLIC, PARAMETER ::   jpyear = 150   ! temporal parameter  
    3130   INTEGER , PUBLIC, PARAMETER ::   jphem  =   2   ! parameter for the 2 hemispheres 
    32    INTEGER , PUBLIC    ::   ndate_beg      ! initial calendar date (aammjj) for CFC 
    33    INTEGER , PUBLIC    ::   nyear_res      ! restoring time constant (year) 
    34    INTEGER , PUBLIC    ::   nyear_beg      ! initial year (aa)  
    35    INTEGER , PUBLIC    ::   npyear         ! Number of years read in CFC1112 file 
     31   INTEGER , PUBLIC            ::   jpyear         ! Number of years read in CFC1112 file 
     32   INTEGER , PUBLIC            ::   ndate_beg      ! initial calendar date (aammjj) for CFC 
     33   INTEGER , PUBLIC            ::   nyear_res      ! restoring time constant (year) 
     34   INTEGER , PUBLIC            ::   nyear_beg      ! initial year (aa)  
    3635    
    37    REAL(wp), PUBLIC, DIMENSION(jpyear,jphem, 2    )      ::   p_cfc    ! partial hemispheric pressure for CFC 
     36   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   p_cfc    ! partial hemispheric pressure for CFC 
    3837   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   xphem    ! spatial interpolation factor for patm 
    3938   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qtr_cfc  ! flux at surface 
    4039   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   qint_cfc ! cumulative flux  
     40   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   patm     ! atmospheric function 
    4141 
    4242   REAL(wp), DIMENSION(4,2) ::   soa   ! coefficient for solubility of CFC [mol/l/atm] 
     
    7575      !!                CFC concentration in pico-mol/m3 
    7676      !!---------------------------------------------------------------------- 
    77       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    78       USE wrk_nemo, ONLY:   ztrcfc => wrk_3d_1        ! use for CFC sms trend 
    7977      ! 
    8078      INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
     
    8280      INTEGER  ::   ji, jj, jn, jl, jm, js 
    8381      INTEGER  ::   iyear_beg, iyear_end 
    84       INTEGER  ::   im1, im2 
     82      INTEGER  ::   im1, im2, ierr 
    8583      REAL(wp) ::   ztap, zdtap         
    8684      REAL(wp) ::   zt1, zt2, zt3, zv2 
     
    9088      REAL(wp) ::   zca_cfc   ! concentration at equilibrium 
    9189      REAL(wp) ::   zak_cfc   ! transfert coefficients 
    92       REAL(wp), DIMENSION(jphem,jp_cfc) ::   zpatm   ! atmospheric function 
    93       !!---------------------------------------------------------------------- 
    94       ! 
    95       IF( wrk_in_use(3, 1) ) THEN 
    96          CALL ctl_stop('trc_sms_cfc: requested workspace array unavailable')   ;   RETURN 
     90      REAL(wp), ALLOCATABLE, DIMENSION(:,:)  ::   zpatm     ! atmospheric function 
     91      !!---------------------------------------------------------------------- 
     92      ! 
     93      ! 
     94      IF( nn_timing == 1 )  CALL timing_start('trc_sms_cfc') 
     95      ! 
     96      ALLOCATE( zpatm(jphem,jp_cfc), STAT=ierr ) 
     97      IF( ierr > 0 ) THEN 
     98         CALL ctl_stop( 'trc_sms_cfc: unable to allocate zpatm array' )   ;   RETURN 
    9799      ENDIF 
    98100 
    99       IF( kt == nit000 )   CALL trc_cfc_cst 
     101      IF( kt == nittrc000 )   CALL trc_cfc_cst 
    100102 
    101103      ! Temporal interpolation 
     
    158160 
    159161               ! Input function  : speed *( conc. at equil - concen at surface ) 
    160                ! trn in pico-mol/l idem qtr; ak in en m/s 
     162               ! trn in pico-mol/l idem qtr; ak in en m/a 
    161163               qtr_cfc(ji,jj,jl) = -zak_cfc * ( trb(ji,jj,1,jn) - zca_cfc )   & 
    162164#if defined key_degrad 
     
    164166#endif 
    165167                  &                         * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) ) 
    166  
    167168               ! Add the surface flux to the trend 
    168169               tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + qtr_cfc(ji,jj,jl) / fse3t(ji,jj,1)  
     
    176177      END DO                                                !  end CFC loop  ! 
    177178      !                                                     !----------------! 
    178  
    179 #if defined key_diatrc  
    180       ! Save diagnostics , just for CFC11 
    181 # if  defined key_iomput 
    182       CALL iom_put( "qtrCFC11"  , qtr_cfc (:,:,1) ) 
    183       CALL iom_put( "qintCFC11" , qint_cfc(:,:,1) ) 
    184 # else 
    185       trc2d(:,:,jp_cfc0_2d    ) = qtr_cfc (:,:,1) 
    186       trc2d(:,:,jp_cfc0_2d + 1) = qint_cfc(:,:,1) 
    187 # endif 
    188 #endif 
    189  
     179      IF( ln_diatrc ) THEN 
     180        ! 
     181        IF( lk_iomput ) THEN 
     182           CALL iom_put( "qtrCFC11"  , qtr_cfc (:,:,1) ) 
     183           CALL iom_put( "qintCFC11" , qint_cfc(:,:,1) ) 
     184        ELSE 
     185           trc2d(:,:,jp_cfc0_2d    ) = qtr_cfc (:,:,1) 
     186           trc2d(:,:,jp_cfc0_2d + 1) = qint_cfc(:,:,1) 
     187        END IF 
     188        ! 
     189      END IF 
     190  
    190191      IF( l_trdtrc ) THEN 
    191192          DO jn = jp_cfc0, jp_cfc1 
    192             ztrcfc(:,:,:) = tra(:,:,:,jn) 
    193             CALL trd_mod_trc( ztrcfc, jn, jptra_trd_sms, kt )   ! save trends 
     193            CALL trd_mod_trc( tra(:,:,:,jn), jn, jptra_trd_sms, kt )   ! save trends 
    194194          END DO 
    195195      END IF 
    196196      ! 
    197       IF( wrk_not_released(3, 1) )   CALL ctl_stop('trc_sms_cfc: failed to release workspace array') 
     197      IF( nn_timing == 1 )  CALL timing_stop('trc_sms_cfc') 
    198198      ! 
    199199   END SUBROUTINE trc_sms_cfc 
  • trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/par_lobster.F90

    r2528 r3294  
    1919   LOGICAL, PUBLIC, PARAMETER ::   lk_lobster     = .TRUE.    !: LOBSTER flag  
    2020   INTEGER, PUBLIC, PARAMETER ::   jp_lobster     =  6        !: number of LOBSTER tracers 
    21    INTEGER, PUBLIC, PARAMETER ::   jp_lobster_2d  = 19        !: additional 2d output arrays ('key_diatrc') 
    22    INTEGER, PUBLIC, PARAMETER ::   jp_lobster_3d  =  3        !: additional 3d output arrays ('key_diatrc') 
     21   INTEGER, PUBLIC, PARAMETER ::   jp_lobster_2d  = 19        !: additional 2d output arrays  
     22   INTEGER, PUBLIC, PARAMETER ::   jp_lobster_3d  =  3        !: additional 3d output arrays  
    2323   INTEGER, PUBLIC, PARAMETER ::   jp_lobster_trd = 17       !: number of sms trends for LOBSTER 
    2424 
  • trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcbio.F90

    r2715 r3294  
    6060      !!              for passive tracers are saved for futher diagnostics. 
    6161      !!--------------------------------------------------------------------- 
    62       USE wrk_nemo, ONLY: wrk_in_use,  wrk_not_released 
    63       USE wrk_nemo, ONLY: wrk_3d_2, wrk_4d_1 
    6462      !! 
    6563      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
     
    7472      REAL(wp) ::   zfilpz, zfildz, zphya, zzooa, zno3a 
    7573      REAL(wp) ::   znh4a, zdeta, zdoma, zzoobod, zboddet, zdomaju 
    76 #if defined key_diatrc 
    7774      REAL(wp) ::   ze3t 
    78 #endif 
    79 #if defined key_diatrc && defined key_iomput 
    8075      REAL(wp), POINTER,   DIMENSION(:,:,:) :: zw2d 
    8176      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zw3d 
    82 #endif 
    83       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   ztrbio 
    8477      CHARACTER (len=25) :: charout 
    8578      !!--------------------------------------------------------------------- 
    86  
    87 #if defined key_diatrc && defined key_iomput 
    88       IF( ( wrk_in_use(3, 2) ) .OR. ( wrk_in_use(4, 1) ) ) THEN 
    89          CALL ctl_stop('trc_bio : requested workspace arrays unavailable.') 
    90          RETURN 
    91       END IF 
    92       ! Set-up pointers into sub-arrays of workspaces 
    93       zw2d => wrk_3d_2(:,:,1:17) 
    94       zw3d => wrk_4d_1(:,:,:,1:3) 
    95 #endif 
    96  
    97       IF( kt == nit000 ) THEN 
     79      ! 
     80      IF( nn_timing == 1 )  CALL timing_start('trc_bio') 
     81      ! 
     82      IF( ln_diatrc ) THEN 
     83         CALL wrk_alloc( jpi, jpj,     17, zw2d ) 
     84         CALL wrk_alloc( jpi, jpj, jpk, 3, zw3d ) 
     85      ENDIF 
     86 
     87      IF( kt == nittrc000 ) THEN 
    9888         IF(lwp) WRITE(numout,*) 
    9989         IF(lwp) WRITE(numout,*) ' trc_bio: LOBSTER bio-model' 
     
    10292 
    10393      fbod(:,:) = 0.e0 
    104 #if defined key_diatrc && ! defined key_iomput 
    105 #  if defined key_iomput 
    106       zw2d  (:,:,:) = 0.e0 
    107       zw3d(:,:,:,:) = 0.e0 
    108 #  else 
    109       DO jl = jp_lob0_2d, jp_lob1_2d 
    110          trc2d(:,:,jl) = 0.e0 
    111       END DO  
    112 #  endif 
    113 #endif 
    114  
    115       IF( l_trdtrc )THEN 
    116          ALLOCATE( ztrbio(jpi,jpj,jpk,jp_lobster_trd) ) 
    117          ztrbio(:,:,:,:) = 0. 
     94      IF( ln_diatrc ) THEN 
     95         zw2d  (:,:,:) = 0.e0 
     96         zw3d(:,:,:,:) = 0.e0 
    11897      ENDIF 
    11998 
     
    139118               ! psinut,akno3,aknh4 added by asklod AS Kremeur 2005-03 
    140119               zlno3 = zno3 * EXP( -psinut * znh4 ) / ( akno3 + zno3 ) 
    141                zlnh4 = znh4 / (znh4+aknh4)  
     120               zlnh4 = znh4 / (znh4+aknh4)   
    142121 
    143122               ! sinks and sources 
     
    149128               zphydom = rgamma * (1 - fphylab) * (zno3phy + znh4phy) 
    150129               zphynh4 = rgamma * fphylab * (zno3phy + znh4phy) 
    151  
    152130               ! zooplankton production 
    153131               !    preferences 
     
    157135               zppdz = ( zpdz * zdet ) / ( ( zppz * zphy + zpdz * zdet ) + 1.e-13 ) 
    158136               zfood = zpppz * zphy + zppdz * zdet 
    159                !    filtration 
     137               !    filtration  
    160138               zfilpz = taus * zpppz / (aks + zfood) 
    161139               zfildz = taus * zppdz / (aks + zfood) 
     
    166144               ! fecal pellets production 
    167145               zzoodet = rpnaz * zphyzoo + rdnaz * zdetzoo 
    168   
     146 
    169147               ! zooplankton liquide excretion 
    170                zzoonh4 = tauzn * fzoolab * zzoo  
     148               zzoonh4 = tauzn * fzoolab * zzoo   
    171149               zzoodom = tauzn * (1 - fzoolab) * zzoo 
    172150 
    173151               ! mortality 
    174                !    phytoplankton mortality  
     152               !    phytoplankton mortality 
    175153               zphydet = tmminp * zphy 
    176154 
     
    183161               ! detritus and dom breakdown 
    184162               zdetnh4 = taudn * fdetlab * zdet 
    185                zdetdom = taudn * (1 - fdetlab) * zdet  
     163               zdetdom = taudn * (1 - fdetlab) * zdet 
    186164 
    187165               zdomnh4 = taudomn * zdom 
    188166 
    189                ! flux added to express how the excess of nitrogen from 
     167               ! flux added to express how the excess of nitrogen from  
    190168               ! PHY, ZOO and DET to DOM goes directly to NH4 (flux of ajustment) 
    191169               zdomaju = (1 - redf/reddom) * (zphydom + zzoodom + zdetdom) 
    192170 
    193                ! Nitrification 
     171               ! Nitrification  
    194172               znh4no3 = taunn * znh4 
    195173 
     
    211189               tra(ji,jj,jk,jp_lob_dom) = tra(ji,jj,jk,jp_lob_dom) + zdoma 
    212190 
    213 #if defined key_diabio 
    214                trbio(ji,jj,jk,jp_lob0_trd     ) = zno3phy 
    215                trbio(ji,jj,jk,jp_lob0_trd +  1) = znh4phy 
    216                trbio(ji,jj,jk,jp_lob0_trd +  2) = zphynh4 
    217                trbio(ji,jj,jk,jp_lob0_trd +  3) = zphydom 
    218                trbio(ji,jj,jk,jp_lob0_trd +  4) = zphyzoo 
    219                trbio(ji,jj,jk,jp_lob0_trd +  5) = zphydet 
    220                trbio(ji,jj,jk,jp_lob0_trd +  6) = zdetzoo 
    221                trbio(ji,jj,jk,jp_lob0_trd +  8) = zzoodet 
    222                trbio(ji,jj,jk,jp_lob0_trd +  9) = zzoobod 
    223                trbio(ji,jj,jk,jp_lob0_trd + 10) = zzoonh4 
    224                trbio(ji,jj,jk,jp_lob0_trd + 11) = zzoodom 
    225                trbio(ji,jj,jk,jp_lob0_trd + 12) = znh4no3 
    226                trbio(ji,jj,jk,jp_lob0_trd + 13) = zdomnh4 
    227                trbio(ji,jj,jk,jp_lob0_trd + 14) = zdetnh4 
    228                trbio(ji,jj,jk,jp_lob0_trd + 15) = zdetdom 
    229 #endif 
    230                IF( l_trdtrc ) THEN 
    231                   ztrbio(ji,jj,jk,jp_lob0_trd     ) = zno3phy 
    232                   ztrbio(ji,jj,jk,jp_lob0_trd +  1) = znh4phy 
    233                   ztrbio(ji,jj,jk,jp_lob0_trd +  2) = zphynh4 
    234                   ztrbio(ji,jj,jk,jp_lob0_trd +  3) = zphydom 
    235                   ztrbio(ji,jj,jk,jp_lob0_trd +  4) = zphyzoo 
    236                   ztrbio(ji,jj,jk,jp_lob0_trd +  5) = zphydet 
    237                   ztrbio(ji,jj,jk,jp_lob0_trd +  6) = zdetzoo 
     191 
     192               IF( ( ln_diabio .AND. .NOT. lk_iomput ) .OR. l_trdtrc ) THEN 
     193                  trbio(ji,jj,jk,jp_lob0_trd     ) = zno3phy 
     194                  trbio(ji,jj,jk,jp_lob0_trd +  1) = znh4phy 
     195                  trbio(ji,jj,jk,jp_lob0_trd +  2) = zphynh4 
     196                  trbio(ji,jj,jk,jp_lob0_trd +  3) = zphydom 
     197                  trbio(ji,jj,jk,jp_lob0_trd +  4) = zphyzoo 
     198                  trbio(ji,jj,jk,jp_lob0_trd +  5) = zphydet 
     199                  trbio(ji,jj,jk,jp_lob0_trd +  6) = zdetzoo 
    238200                  !  trend number 8 in trcsed 
    239                   ztrbio(ji,jj,jk,jp_lob0_trd +  8) = zzoodet 
    240                   ztrbio(ji,jj,jk,jp_lob0_trd +  9) = zzoobod 
    241                   ztrbio(ji,jj,jk,jp_lob0_trd + 10) = zzoonh4 
    242                   ztrbio(ji,jj,jk,jp_lob0_trd + 11) = zzoodom 
    243                   ztrbio(ji,jj,jk,jp_lob0_trd + 12) = znh4no3 
    244                   ztrbio(ji,jj,jk,jp_lob0_trd + 13) = zdomnh4 
    245                   ztrbio(ji,jj,jk,jp_lob0_trd + 14) = zdetnh4 
    246                   ztrbio(ji,jj,jk,jp_lob0_trd + 15) = zdetdom 
     201                  trbio(ji,jj,jk,jp_lob0_trd +  8) = zzoodet 
     202                  trbio(ji,jj,jk,jp_lob0_trd +  9) = zzoobod 
     203                  trbio(ji,jj,jk,jp_lob0_trd + 10) = zzoonh4 
     204                  trbio(ji,jj,jk,jp_lob0_trd + 11) = zzoodom 
     205                  trbio(ji,jj,jk,jp_lob0_trd + 12) = znh4no3 
     206                  trbio(ji,jj,jk,jp_lob0_trd + 13) = zdomnh4 
     207                  trbio(ji,jj,jk,jp_lob0_trd + 14) = zdetnh4 
     208                  trbio(ji,jj,jk,jp_lob0_trd + 15) = zdetdom 
    247209                  !  trend number 17 in trcexp 
    248210                ENDIF 
    249  
    250 #if defined key_diatrc 
    251                ! convert fluxes in per day 
    252                ze3t = fse3t(ji,jj,jk) * 86400. 
    253 #if ! defined key_iomput 
    254                trc2d(ji,jj,jp_lob0_2d    ) = trc2d(ji,jj, jp_lob0_2d    ) + zno3phy * ze3t  
    255                trc2d(ji,jj,jp_lob0_2d + 1) = trc2d(ji,jj, jp_lob0_2d + 1) + znh4phy * ze3t 
    256                trc2d(ji,jj,jp_lob0_2d + 2) = trc2d(ji,jj, jp_lob0_2d + 2) + zphydom * ze3t 
    257                trc2d(ji,jj,jp_lob0_2d + 3) = trc2d(ji,jj, jp_lob0_2d + 3) + zphynh4 * ze3t 
    258                trc2d(ji,jj,jp_lob0_2d + 4) = trc2d(ji,jj, jp_lob0_2d + 4) + zphyzoo * ze3t 
    259                trc2d(ji,jj,jp_lob0_2d + 5) = trc2d(ji,jj, jp_lob0_2d + 5) + zphydet * ze3t 
    260                trc2d(ji,jj,jp_lob0_2d + 6) = trc2d(ji,jj, jp_lob0_2d + 6) + zdetzoo * ze3t 
    261                ! trend number 8 is in trcsed.F             
    262                trc2d(ji,jj,jp_lob0_2d +  8) = trc2d(ji,jj,jp_lob0_2d +  8) + zzoodet * ze3t 
    263                trc2d(ji,jj,jp_lob0_2d +  9) = trc2d(ji,jj,jp_lob0_2d +  9) + zzoobod * ze3t 
    264                trc2d(ji,jj,jp_lob0_2d + 10) = trc2d(ji,jj,jp_lob0_2d + 10) + zzoonh4 * ze3t 
    265                trc2d(ji,jj,jp_lob0_2d + 11) = trc2d(ji,jj,jp_lob0_2d + 11) + zzoodom * ze3t 
    266                trc2d(ji,jj,jp_lob0_2d + 12) = trc2d(ji,jj,jp_lob0_2d + 12) + znh4no3 * ze3t 
    267                trc2d(ji,jj,jp_lob0_2d + 13) = trc2d(ji,jj,jp_lob0_2d + 13) + zdomnh4 * ze3t 
    268                trc2d(ji,jj,jp_lob0_2d + 14) = trc2d(ji,jj,jp_lob0_2d + 14) + zdetnh4 * ze3t              
    269                trc2d(ji,jj,jp_lob0_2d + 15) = trc2d(ji,jj,jp_lob0_2d + 15) + (  zno3phy + znh4phy - zphynh4   & 
    270                   &                                 - zphydom - zphyzoo - zphydet ) * ze3t 
    271                trc2d(ji,jj,jp_lob0_2d + 16) = trc2d(ji,jj,jp_lob0_2d + 16) + (  zphyzoo + zdetzoo - zzoodet   & 
    272                   &                                 - zzoobod - zzoonh4 - zzoodom ) * ze3t 
    273                trc2d(ji,jj,jp_lob0_2d + 17) = trc2d(ji,jj,jp_lob0_2d + 17) + zdetdom * ze3t 
    274                ! trend number 19 is in trcexp.F 
    275 #else 
    276                zw2d(ji,jj,1)  = zw2d(ji,jj,1)  + zno3phy * ze3t  
    277                zw2d(ji,jj,2)  = zw2d(ji,jj,2)  + znh4phy * ze3t 
    278                zw2d(ji,jj,3)  = zw2d(ji,jj,3)  + zphydom * ze3t 
    279                zw2d(ji,jj,4)  = zw2d(ji,jj,4)  + zphynh4 * ze3t 
    280                zw2d(ji,jj,5)  = zw2d(ji,jj,5)  + zphyzoo * ze3t 
    281                zw2d(ji,jj,6)  = zw2d(ji,jj,6)  + zphydet * ze3t 
    282                zw2d(ji,jj,7)  = zw2d(ji,jj,7)  + zdetzoo * ze3t 
    283                zw2d(ji,jj,8)  = zw2d(ji,jj,8)  + zzoodet * ze3t 
    284                zw2d(ji,jj,9)  = zw2d(ji,jj,9)  + zzoobod * ze3t 
    285                zw2d(ji,jj,10) = zw2d(ji,jj,10) + zzoonh4 * ze3t 
    286                zw2d(ji,jj,11) = zw2d(ji,jj,11) + zzoodom * ze3t 
    287                zw2d(ji,jj,12) = zw2d(ji,jj,12) + znh4no3 * ze3t 
    288                zw2d(ji,jj,13) = zw2d(ji,jj,13) + zdomnh4 * ze3t 
    289                zw2d(ji,jj,14) = zw2d(ji,jj,14) + zdetnh4 * ze3t              
    290                zw2d(ji,jj,15) = zw2d(ji,jj,15) + ( zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet ) * ze3t 
    291                zw2d(ji,jj,16) = zw2d(ji,jj,16) + ( zphyzoo + zdetzoo - zzoodet - zzoobod - zzoonh4 - zzoodom ) * ze3t 
    292                zw2d(ji,jj,17) = zw2d(ji,jj,17) + zdetdom * ze3t 
    293 #endif 
    294 #if defined key_diatrc  
    295 # if ! defined key_iomput 
    296                trc3d(ji,jj,jk,jp_lob0_3d    ) = zno3phy * 86400      
    297                trc3d(ji,jj,jk,jp_lob0_3d + 1) = znh4phy * 86400      
    298                trc3d(ji,jj,jk,jp_lob0_3d + 2) = znh4no3 * 86400    
    299 # else 
    300                zw3d(ji,jj,jk,1) = zno3phy * 86400      
    301                zw3d(ji,jj,jk,2) = znh4phy * 86400      
    302                zw3d(ji,jj,jk,3) = znh4no3 * 86400    
    303 # endif 
    304 #endif   
    305 #endif 
     211                IF( ln_diatrc ) THEN 
     212                  ! convert fluxes in per day 
     213                  ze3t = fse3t(ji,jj,jk) * 86400. 
     214                  zw2d(ji,jj,1)  = zw2d(ji,jj,1)  + zno3phy * ze3t 
     215                  zw2d(ji,jj,2)  = zw2d(ji,jj,2)  + znh4phy * ze3t 
     216                  zw2d(ji,jj,3)  = zw2d(ji,jj,3)  + zphydom * ze3t 
     217                  zw2d(ji,jj,4)  = zw2d(ji,jj,4)  + zphynh4 * ze3t 
     218                  zw2d(ji,jj,5)  = zw2d(ji,jj,5)  + zphyzoo * ze3t 
     219                  zw2d(ji,jj,6)  = zw2d(ji,jj,6)  + zphydet * ze3t 
     220                  zw2d(ji,jj,7)  = zw2d(ji,jj,7)  + zdetzoo * ze3t 
     221                  zw2d(ji,jj,8)  = zw2d(ji,jj,8)  + zzoodet * ze3t 
     222                  zw2d(ji,jj,9)  = zw2d(ji,jj,9)  + zzoobod * ze3t 
     223                  zw2d(ji,jj,10) = zw2d(ji,jj,10) + zzoonh4 * ze3t 
     224                  zw2d(ji,jj,11) = zw2d(ji,jj,11) + zzoodom * ze3t 
     225                  zw2d(ji,jj,12) = zw2d(ji,jj,12) + znh4no3 * ze3t 
     226                  zw2d(ji,jj,13) = zw2d(ji,jj,13) + zdomnh4 * ze3t 
     227                  zw2d(ji,jj,14) = zw2d(ji,jj,14) + zdetnh4 * ze3t 
     228                  zw2d(ji,jj,15) = zw2d(ji,jj,15) + ( zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet ) * ze3t 
     229                  zw2d(ji,jj,16) = zw2d(ji,jj,16) + ( zphyzoo + zdetzoo - zzoodet - zzoobod - zzoonh4 - zzoodom ) * ze3t 
     230                  zw2d(ji,jj,17) = zw2d(ji,jj,17) + zdetdom * ze3t 
     231                  !    
     232                  zw3d(ji,jj,jk,1) = zno3phy * 86400 
     233                  zw3d(ji,jj,jk,2) = znh4phy * 86400      
     234                  zw3d(ji,jj,jk,3) = znh4no3 * 86400    
     235                   !  
     236                ENDIF 
    306237            END DO 
    307238         END DO 
     
    347278 
    348279               !    mortality 
    349                zphydet = tmminp * zphy      ! phytoplankton mortality  
     280               zphydet = tmminp * zphy      ! phytoplankton mortality 
    350281 
    351282               zzoobod = 0.e0               ! zooplankton mortality 
     
    354285               !    detritus and dom breakdown 
    355286               zdetnh4 = taudn * fdetlab * zdet 
    356                zdetdom = taudn * (1 - fdetlab) * zdet  
     287               zdetdom = taudn * (1 - fdetlab) * zdet 
    357288 
    358289               zdomnh4 = taudomn * zdom 
     
    367298               zphya =   zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet 
    368299               zzooa =   zphyzoo + zdetzoo - zzoodet - zzoodom - zzoonh4 - zzoobod 
    369                zno3a = - zno3phy + znh4no3 
     300               zno3a = - zno3phy + znh4no3  
    370301               znh4a = - znh4phy - znh4no3 + zphynh4 + zzoonh4 + zdomnh4 + zdetnh4 + zdomaju 
    371302               zdeta = zphydet + zzoodet  - zdetzoo - zdetnh4 - zdetdom + zboddet 
     
    380311               tra(ji,jj,jk,jp_lob_dom) = tra(ji,jj,jk,jp_lob_dom) + zdoma 
    381312               ! 
    382 #if defined key_diabio 
    383                trbio(ji,jj,jk,jp_lob0_trd     ) = zno3phy 
    384                trbio(ji,jj,jk,jp_lob0_trd +  1) = znh4phy 
    385                trbio(ji,jj,jk,jp_lob0_trd +  2) = zphynh4 
    386                trbio(ji,jj,jk,jp_lob0_trd +  3) = zphydom 
    387                trbio(ji,jj,jk,jp_lob0_trd +  4) = zphyzoo 
    388                trbio(ji,jj,jk,jp_lob0_trd +  5) = zphydet 
    389                trbio(ji,jj,jk,jp_lob0_trd +  6) = zdetzoo 
    390                trbio(ji,jj,jk,jp_lob0_trd +  8) = zzoodet 
    391                trbio(ji,jj,jk,jp_lob0_trd +  9) = zzoobod 
    392                trbio(ji,jj,jk,jp_lob0_trd + 10) = zzoonh4 
    393                trbio(ji,jj,jk,jp_lob0_trd + 11) = zzoodom 
    394                trbio(ji,jj,jk,jp_lob0_trd + 12) = znh4no3 
    395                trbio(ji,jj,jk,jp_lob0_trd + 13) = zdomnh4 
    396                trbio(ji,jj,jk,jp_lob0_trd + 14) = zdetnh4 
    397                trbio(ji,jj,jk,jp_lob0_trd + 15) = zdetdom 
    398 #endif 
    399                IF( l_trdtrc ) THEN 
    400                   ztrbio(ji,jj,jk,jp_lob0_trd     ) = zno3phy 
    401                   ztrbio(ji,jj,jk,jp_lob0_trd +  1) = znh4phy 
    402                   ztrbio(ji,jj,jk,jp_lob0_trd +  2) = zphynh4 
    403                   ztrbio(ji,jj,jk,jp_lob0_trd +  3) = zphydom 
    404                   ztrbio(ji,jj,jk,jp_lob0_trd +  4) = zphyzoo 
    405                   ztrbio(ji,jj,jk,jp_lob0_trd +  5) = zphydet 
    406                   ztrbio(ji,jj,jk,jp_lob0_trd +  6) = zdetzoo 
     313               IF( ( ln_diabio .AND. .NOT. lk_iomput ) .OR. l_trdtrc ) THEN 
     314                  trbio(ji,jj,jk,jp_lob0_trd     ) = zno3phy 
     315                  trbio(ji,jj,jk,jp_lob0_trd +  1) = znh4phy 
     316                  trbio(ji,jj,jk,jp_lob0_trd +  2) = zphynh4 
     317                  trbio(ji,jj,jk,jp_lob0_trd +  3) = zphydom 
     318                  trbio(ji,jj,jk,jp_lob0_trd +  4) = zphyzoo 
     319                  trbio(ji,jj,jk,jp_lob0_trd +  5) = zphydet 
     320                  trbio(ji,jj,jk,jp_lob0_trd +  6) = zdetzoo 
    407321                  !  trend number 8 in trcsed 
    408                   ztrbio(ji,jj,jk,jp_lob0_trd +  8) = zzoodet 
    409                   ztrbio(ji,jj,jk,jp_lob0_trd +  9) = zzoobod 
    410                   ztrbio(ji,jj,jk,jp_lob0_trd + 10) = zzoonh4 
    411                   ztrbio(ji,jj,jk,jp_lob0_trd + 11) = zzoodom 
    412                   ztrbio(ji,jj,jk,jp_lob0_trd + 12) = znh4no3 
    413                   ztrbio(ji,jj,jk,jp_lob0_trd + 13) = zdomnh4 
    414                   ztrbio(ji,jj,jk,jp_lob0_trd + 14) = zdetnh4 
    415                   ztrbio(ji,jj,jk,jp_lob0_trd + 15) = zdetdom 
    416                   !  trend number 17 in trcexp 
     322                  trbio(ji,jj,jk,jp_lob0_trd +  8) = zzoodet 
     323                  trbio(ji,jj,jk,jp_lob0_trd +  9) = zzoobod 
     324                  trbio(ji,jj,jk,jp_lob0_trd + 10) = zzoonh4 
     325                  trbio(ji,jj,jk,jp_lob0_trd + 11) = zzoodom 
     326                  trbio(ji,jj,jk,jp_lob0_trd + 12) = znh4no3 
     327                  trbio(ji,jj,jk,jp_lob0_trd + 13) = zdomnh4 
     328                  trbio(ji,jj,jk,jp_lob0_trd + 14) = zdetnh4 
     329                  trbio(ji,jj,jk,jp_lob0_trd + 15) = zdetdom 
     330                  !  trend number 17 in trcexp  
    417331                ENDIF 
    418 #if defined key_diatrc 
    419 # if ! defined key_iomput 
    420                trc3d(ji,jj,jk,jp_lob0_3d    ) =  zno3phy * 86400      
    421                trc3d(ji,jj,jk,jp_lob0_3d + 1) =  znh4phy * 86400      
    422                trc3d(ji,jj,jk,jp_lob0_3d + 2) =  znh4no3 * 86400      
    423 # else 
    424                zw3d(ji,jj,jk,1) = zno3phy * 86400      
    425                zw3d(ji,jj,jk,2) = znh4phy * 86400      
    426                zw3d(ji,jj,jk,3) = znh4no3 * 86400    
    427 # endif 
    428 #endif 
     332                IF( ln_diatrc ) THEN 
     333                  ! convert fluxes in per day 
     334                  ze3t = fse3t(ji,jj,jk) * 86400. 
     335                  zw2d(ji,jj,1)  = zw2d(ji,jj,1)  + zno3phy * ze3t 
     336                  zw2d(ji,jj,2)  = zw2d(ji,jj,2)  + znh4phy * ze3t 
     337                  zw2d(ji,jj,3)  = zw2d(ji,jj,3)  + zphydom * ze3t 
     338                  zw2d(ji,jj,4)  = zw2d(ji,jj,4)  + zphynh4 * ze3t 
     339                  zw2d(ji,jj,5)  = zw2d(ji,jj,5)  + zphyzoo * ze3t 
     340                  zw2d(ji,jj,6)  = zw2d(ji,jj,6)  + zphydet * ze3t 
     341                  zw2d(ji,jj,7)  = zw2d(ji,jj,7)  + zdetzoo * ze3t 
     342                  zw2d(ji,jj,8)  = zw2d(ji,jj,8)  + zzoodet * ze3t 
     343                  zw2d(ji,jj,9)  = zw2d(ji,jj,9)  + zzoobod * ze3t 
     344                  zw2d(ji,jj,10) = zw2d(ji,jj,10) + zzoonh4 * ze3t 
     345                  zw2d(ji,jj,11) = zw2d(ji,jj,11) + zzoodom * ze3t 
     346                  zw2d(ji,jj,12) = zw2d(ji,jj,12) + znh4no3 * ze3t 
     347                  zw2d(ji,jj,13) = zw2d(ji,jj,13) + zdomnh4 * ze3t 
     348                  zw2d(ji,jj,14) = zw2d(ji,jj,14) + zdetnh4 * ze3t 
     349                  zw2d(ji,jj,15) = zw2d(ji,jj,15) + ( zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet ) * ze3t 
     350                  zw2d(ji,jj,16) = zw2d(ji,jj,16) + ( zphyzoo + zdetzoo - zzoodet - zzoobod - zzoonh4 - zzoodom ) * ze3t 
     351                  zw2d(ji,jj,17) = zw2d(ji,jj,17) + zdetdom * ze3t 
     352                  !    
     353                  zw3d(ji,jj,jk,1) = zno3phy * 86400 
     354                  zw3d(ji,jj,jk,2) = znh4phy * 86400 
     355                  zw3d(ji,jj,jk,3) = znh4no3 * 86400 
     356                   ! 
     357                ENDIF 
    429358            END DO 
    430359         END DO 
    431360      END DO 
    432361 
    433 #if defined key_diatrc 
    434       ! Lateral boundary conditions  
    435 # if ! defined key_iomput 
    436       DO jl = jp_lob0_2d, jp_lob1_2d 
    437           CALL lbc_lnk( trc2d(:,:,jl),'T', 1. ) 
    438       END DO  
    439 # else 
    440       DO jl = 1, 17  
    441           CALL lbc_lnk( zw2d(:,:,jl),'T', 1. ) 
    442       END DO 
    443       ! Save diagnostics 
    444       CALL iom_put( "TNO3PHY", zw2d(:,:,1) ) 
    445       CALL iom_put( "TNH4PHY", zw2d(:,:,2) ) 
    446       CALL iom_put( "TPHYDOM", zw2d(:,:,3) ) 
    447       CALL iom_put( "TPHYNH4", zw2d(:,:,4) ) 
    448       CALL iom_put( "TPHYZOO", zw2d(:,:,5) ) 
    449       CALL iom_put( "TPHYDET", zw2d(:,:,6) ) 
    450       CALL iom_put( "TDETZOO", zw2d(:,:,7) ) 
    451       CALL iom_put( "TZOODET", zw2d(:,:,8) ) 
    452       CALL iom_put( "TZOOBOD", zw2d(:,:,9) ) 
    453       CALL iom_put( "TZOONH4", zw2d(:,:,10) ) 
    454       CALL iom_put( "TZOODOM", zw2d(:,:,11) ) 
    455       CALL iom_put( "TNH4NO3", zw2d(:,:,12) ) 
    456       CALL iom_put( "TDOMNH4", zw2d(:,:,13) ) 
    457       CALL iom_put( "TDETNH4", zw2d(:,:,14) ) 
    458       CALL iom_put( "TPHYTOT", zw2d(:,:,15) ) 
    459       CALL iom_put( "TZOOTOT", zw2d(:,:,16) ) 
    460       CALL iom_put( "TDETDOM", zw2d(:,:,17) ) 
    461 # endif 
    462 #endif 
    463  
    464 #if defined key_diatrc 
    465       ! Lateral boundary conditions  
    466 # if ! defined key_iomput 
    467       DO jl = jp_lob0_3d, jp_lob1_3d 
    468           CALL lbc_lnk( trc3d(:,:,1,jl),'T', 1. ) 
    469       END DO  
    470 # else 
    471       DO jl = 1, 3 
    472           CALL lbc_lnk( zw3d(:,:,:,jl),'T', 1. ) 
    473       END DO 
    474       ! save diagnostics 
    475       CALL iom_put( "FNO3PHY", zw3d(:,:,:,1) ) 
    476       CALL iom_put( "FNH4PHY", zw3d(:,:,:,2) ) 
    477       CALL iom_put( "FNH4NO3", zw3d(:,:,:,3) ) 
    478 # endif  
    479 #endif 
    480  
    481 #if defined key_diabio 
    482       ! Lateral boundary conditions on trcbio 
    483       DO jl = jp_lob0_trd, jp_lob1_trd 
    484           CALL lbc_lnk( trbio(:,:,1,jl),'T', 1. ) 
    485       END DO  
    486 #endif 
     362      IF( ln_diatrc ) THEN 
     363         ! 
     364         DO jl = 1, 17  
     365            CALL lbc_lnk( zw2d(:,:,jl),'T', 1. ) 
     366         END DO 
     367         DO jl = 1, 3 
     368            CALL lbc_lnk( zw3d(:,:,:,jl),'T', 1. ) 
     369         END DO 
     370         IF( lk_iomput ) THEN 
     371            ! Save diagnostics 
     372            CALL iom_put( "TNO3PHY", zw2d(:,:,1) ) 
     373            CALL iom_put( "TNH4PHY", zw2d(:,:,2) ) 
     374            CALL iom_put( "TPHYDOM", zw2d(:,:,3) ) 
     375            CALL iom_put( "TPHYNH4", zw2d(:,:,4) ) 
     376            CALL iom_put( "TPHYZOO", zw2d(:,:,5) ) 
     377            CALL iom_put( "TPHYDET", zw2d(:,:,6) ) 
     378            CALL iom_put( "TDETZOO", zw2d(:,:,7) ) 
     379            CALL iom_put( "TZOODET", zw2d(:,:,8) ) 
     380            CALL iom_put( "TZOOBOD", zw2d(:,:,9) ) 
     381            CALL iom_put( "TZOONH4", zw2d(:,:,10) ) 
     382            CALL iom_put( "TZOODOM", zw2d(:,:,11) ) 
     383            CALL iom_put( "TNH4NO3", zw2d(:,:,12) ) 
     384            CALL iom_put( "TDOMNH4", zw2d(:,:,13) ) 
     385            CALL iom_put( "TDETNH4", zw2d(:,:,14) ) 
     386            CALL iom_put( "TPHYTOT", zw2d(:,:,15) ) 
     387            CALL iom_put( "TZOOTOT", zw2d(:,:,16) ) 
     388            !  
     389            CALL iom_put( "FNO3PHY", zw3d(:,:,:,1) ) 
     390            CALL iom_put( "FNH4PHY", zw3d(:,:,:,2) ) 
     391            CALL iom_put( "FNH4NO3", zw3d(:,:,:,3) ) 
     392            ! 
     393         ELSE 
     394            ! 
     395            trc2d(:,:,jp_lob0_2d    ) = zw2d(:,:,1)  
     396            trc2d(:,:,jp_lob0_2d + 1) = zw2d(:,:,2)  
     397            trc2d(:,:,jp_lob0_2d + 2) = zw2d(:,:,3)  
     398            trc2d(:,:,jp_lob0_2d + 3) = zw2d(:,:,4)  
     399            trc2d(:,:,jp_lob0_2d + 4) = zw2d(:,:,5)  
     400            trc2d(:,:,jp_lob0_2d + 5) = zw2d(:,:,6)  
     401            trc2d(:,:,jp_lob0_2d + 6) = zw2d(:,:,7)  
     402                     ! trend number 8 is in trcsed.F 
     403            trc2d(:,:,jp_lob0_2d +  8) = zw2d(:,:,8)  
     404            trc2d(:,:,jp_lob0_2d +  9) = zw2d(:,:,9)  
     405            trc2d(:,:,jp_lob0_2d + 10) = zw2d(:,:,10)  
     406            trc2d(:,:,jp_lob0_2d + 11) = zw2d(:,:,11)  
     407            trc2d(:,:,jp_lob0_2d + 12) = zw2d(:,:,12)  
     408            trc2d(:,:,jp_lob0_2d + 13) = zw2d(:,:,13)  
     409            trc2d(:,:,jp_lob0_2d + 14) = zw2d(:,:,14)  
     410            trc2d(:,:,jp_lob0_2d + 15) = zw2d(:,:,15)  
     411            trc2d(:,:,jp_lob0_2d + 16) = zw2d(:,:,16)  
     412            trc2d(:,:,jp_lob0_2d + 17) = zw2d(:,:,17)  
     413            ! trend number 19 is in trcexp.F 
     414            trc3d(:,:,:,jp_lob0_3d    ) = zw3d(:,:,:,1)  
     415            trc3d(:,:,:,jp_lob0_3d + 1) = zw3d(:,:,:,2)  
     416            trc3d(:,:,:,jp_lob0_3d + 2) = zw3d(:,:,:,3)  
     417         ENDIF 
     418        ! 
     419      ENDIF 
     420 
     421      IF( ln_diabio .AND. .NOT. lk_iomput )  THEN 
     422         DO jl = jp_lob0_trd, jp_lob1_trd 
     423            CALL lbc_lnk( trbio(:,:,1,jl),'T', 1. ) 
     424         END DO  
     425      ENDIF 
    487426      ! 
    488427      IF( l_trdtrc ) THEN 
    489428         DO jl = jp_lob0_trd, jp_lob1_trd 
    490             CALL trd_mod_trc( ztrbio(:,:,:,jl), jl, kt )   ! handle the trend 
     429            CALL trd_mod_trc( trbio(:,:,:,jl), jl, kt )   ! handle the trend 
    491430         END DO 
    492431      ENDIF 
    493  
    494       IF( l_trdtrc ) DEALLOCATE( ztrbio ) 
    495432 
    496433      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     
    500437      ENDIF 
    501438      ! 
    502 #if defined key_diatrc && defined key_iomput 
    503       IF( ( wrk_not_released(3, 2) ) .OR. ( wrk_not_released(4, 1) ) )  & 
    504         &   CALL ctl_stop('trc_bio : failed to release workspace arrays.') 
    505 #endif 
     439      IF( ln_diatrc ) THEN 
     440         CALL wrk_dealloc( jpi, jpj,     17, zw2d ) 
     441         CALL wrk_dealloc( jpi, jpj, jpk, 3, zw3d ) 
     442      ENDIF 
     443      ! 
     444      IF( nn_timing == 1 )  CALL timing_stop('trc_bio') 
    506445      ! 
    507446   END SUBROUTINE trc_bio 
  • trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcexp.F90

    r2715 r3294  
    5353      !!              COLUMN BELOW THE SURFACE LAYER. 
    5454      !!--------------------------------------------------------------------- 
     55      !! 
    5556      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
    5657      !! 
    57       INTEGER  ::   ji, jj, jk, jl, ikt 
     58      INTEGER  ::   ji, jj, jk, jl, ikt, ierr 
    5859      REAL(wp) ::   zgeolpoc, zfact, zwork, ze3t, zsedpocd 
    59       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrbio 
     60      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrbio 
    6061      CHARACTER (len=25) :: charout 
    6162      !!--------------------------------------------------------------------- 
    62  
    63       IF( kt == nit000 ) THEN 
     63      ! 
     64      IF( nn_timing == 1 )  CALL timing_start('trc_exp') 
     65      ! 
     66      IF( kt == nittrc000 ) THEN 
    6467         IF(lwp) WRITE(numout,*) 
    6568         IF(lwp) WRITE(numout,*) ' trc_exp: LOBSTER export' 
    6669         IF(lwp) WRITE(numout,*) ' ~~~~~~~' 
     70      ENDIF 
     71 
     72      IF( l_trdtrc )  THEN 
     73         ALLOCATE( ztrbio(jpi,jpj,jpk) , STAT = ierr )   ! temporary save of trends 
     74         IF( ierr > 0 ) THEN 
     75            CALL ctl_stop( 'trc_exp: unable to allocate ztrbio array' )   ;   RETURN 
     76         ENDIF 
     77         ztrbio(:,:,:) = tra(:,:,:,jp_lob_no3) 
    6778      ENDIF 
    6879 
     
    7283      ! LAYERS IS DETERMINED BY DMIN3 DEFINED IN sms_lobster.F90 
    7384      ! ---------------------------------------------------------------------- 
    74  
    75       IF( l_trdtrc )THEN 
    76          ALLOCATE( ztrbio(jpi,jpj,jpk) ) 
    77          ztrbio(:,:,:) = tra(:,:,:,jp_lob_no3) 
    78       ENDIF 
    79  
    8085      DO jk = 1, jpkm1 
    8186         DO jj = 2, jpjm1 
     
    114119  
    115120      ! Oa & Ek: diagnostics depending on jpdia2d !          left as example 
    116 #if defined key_diatrc 
    117 # if ! defined key_iomput 
    118       trc2d(:,:,jp_lob0_2d + 18) = sedpocn(:,:) 
    119 # else 
    120      CALL iom_put( "SEDPOC" , sedpocn ) 
    121 # endif 
    122 #endif 
     121      IF( ln_diatrc ) THEN 
     122         IF( lk_iomput ) THEN   ;   CALL iom_put( "SEDPOC" , sedpocn ) 
     123         ELSE                   ;   trc2d(:,:,jp_lob0_2d + 18) = sedpocn(:,:) 
     124         ENDIF 
     125      ENDIF 
    123126 
    124127       
    125128      ! Time filter and swap of arrays 
    126129      ! ------------------------------ 
    127       IF( neuler == 0 .AND. kt == nit000 ) THEN        ! Euler time-stepping at first time-step 
     130      IF( neuler == 0 .AND. kt == nittrc000 ) THEN        ! Euler time-stepping at first time-step 
    128131        !                                             ! (only swap) 
    129132        sedpocn(:,:) = sedpoca(:,:) 
     
    146149         jl = jp_lob0_trd + 16 
    147150         CALL trd_mod_trc( ztrbio, jl, kt )   ! handle the trend 
     151         DEALLOCATE( ztrbio )  
    148152      ENDIF 
    149  
    150       IF( l_trdtrc ) DEALLOCATE( ztrbio ) 
    151153 
    152154      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     
    155157         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
    156158      ENDIF 
    157  
     159      ! 
     160      IF( nn_timing == 1 )  CALL timing_stop('trc_exp') 
     161      ! 
    158162   END SUBROUTINE trc_exp 
    159163 
  • trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcini_lobster.F90

    r2715 r3294  
    4040      !! ** purpose :   specific initialisation for LOBSTER bio-model 
    4141      !!---------------------------------------------------------------------- 
    42       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    43       USE wrk_nemo, ONLY:   zrro => wrk_2d_1 , zdm0 => wrk_3d_1 
    4442      !! 
    4543      INTEGER  ::   ji, jj, jk, jn 
    4644      REAL(wp) ::   ztest, zfluo, zfluu 
    47       !!---------------------------------------------------------------------- 
    48       ! 
    49       IF(  wrk_in_use(2, 1)  .OR.  wrk_in_use(3, 1)  )  THEN 
    50          CALL ctl_stop('trc_ini_lobster: requested workspace arrays unavailable')   ;  RETURN 
    51       ENDIF 
     45      REAL(wp), POINTER, DIMENSION(:,:  ) :: zrro 
     46      REAL(wp), POINTER, DIMENSION(:,:,:) :: zdm0 
     47      !!--------------------------------------------------------------------- 
     48 
     49      ! Allocate temporary workspace 
     50      CALL wrk_alloc( jpi, jpj,      zrro ) 
     51      CALL wrk_alloc( jpi, jpj, jpk, zdm0 ) 
     52 
    5253 
    5354      IF(lwp) WRITE(numout,*) 
     
    254255      IF(lwp) WRITE(numout,*) 'Initialization of LOBSTER tracers done' 
    255256      ! 
    256       IF(  wrk_not_released(2, 1)  .OR.   & 
    257            wrk_not_released(3, 1)   )   CALL ctl_stop('trc_ini_lobster: failed to release workspace arrays') 
     257      CALL wrk_dealloc( jpi, jpj,      zrro ) 
     258      CALL wrk_dealloc( jpi, jpj, jpk, zdm0 ) 
    258259      ! 
    259260   END SUBROUTINE trc_ini_lobster 
  • trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcnam_lobster.F90

    r2715 r3294  
    1212   !! trc_nam_lobster   : LOBSTER model namelist read 
    1313   !!---------------------------------------------------------------------- 
    14    USE oce_trc          ! Ocean variables 
    15    USE par_trc          ! TOP parameters 
    16    USE trc              ! TOP variables 
    17    USE sms_lobster      ! sms trends 
     14   USE oce_trc                                   ! Ocean variables 
     15   USE par_trc                                   ! TOP parameters 
     16   USE trc                                       ! TOP variables 
     17   USE trdmod_trc_oce , ONLY :  lk_trdmld_trc    !  tracers  trend flag 
     18   USE sms_lobster                               ! sms trends 
     19   USE iom                                       ! I/O manager 
    1820 
    1921   IMPLICIT NONE 
     
    4143      INTEGER ::   numnatl 
    4244      !! 
    43 #if defined key_diatrc && ! defined key_iomput 
    4445      INTEGER :: jl, jn 
    45       ! definition of additional diagnostic as a structure 
    46       TYPE DIAG 
    47          CHARACTER(len = 20)  :: snamedia   !: short name 
    48          CHARACTER(len = 80 ) :: lnamedia   !: long name 
    49          CHARACTER(len = 20 ) :: unitdia    !: unit 
    50       END TYPE DIAG 
    51  
    52       TYPE(DIAG) , DIMENSION(jp_lobster_2d) :: lobdia2d 
    53       TYPE(DIAG) , DIMENSION(jp_lobster_3d) :: lobdia3d 
    54 #endif 
    55 #if defined key_diabio || defined key_trdmld_trc 
    56       INTEGER :: js, jd 
    57       ! definition of additional diagnostic as a structure 
    58       TYPE DIABIO 
    59          CHARACTER(len = 20)  :: snamebio   !: short name 
    60          CHARACTER(len = 80 ) :: lnamebio   !: long name 
    61          CHARACTER(len = 20 ) :: unitbio    !: unit 
    62       END TYPE DIABIO 
    63  
    64       TYPE(DIABIO) , DIMENSION(jp_lobster_trd) :: lobdiabio 
    65 #endif 
     46      TYPE(DIAG), DIMENSION(jp_lobster_2d )  :: lobdia2d 
     47      TYPE(DIAG), DIMENSION(jp_lobster_3d )  :: lobdia3d 
     48      TYPE(DIAG), DIMENSION(jp_lobster_trd)  :: lobdiabio 
    6649 
    6750      NAMELIST/namlobphy/ apmin, tmumax, rgamma, fphylab, tmmaxp, tmminp, & 
     
    7760 
    7861      NAMELIST/namlobopt/ xkg0, xkr0, xkgp, xkrp, xlg, xlr, rpig 
    79 #if defined key_diatrc && ! defined key_iomput 
    80       NAMELIST/namlobdia/nn_writedia, lobdia3d, lobdia2d     ! additional diagnostics 
    81 #endif 
    82 #if defined key_diabio || defined key_trdmld_trc 
    83       NAMELIST/namlobdbi/nwritebio, lobdiabio 
    84 #endif 
     62      NAMELIST/namlobdia/ lobdia3d, lobdia2d     ! additional diagnostics 
     63      NAMELIST/namlobdbi/ lobdiabio 
    8564      !!---------------------------------------------------------------------- 
    8665 
     
    278257      ENDIF 
    279258 
    280 #if defined key_diatrc && ! defined key_iomput 
    281  
    282       ! Namelist namlobdia 
    283       ! ------------------- 
    284       nn_writedia = 10                   ! default values 
    285  
    286       DO jl = 1, jp_lobster_2d 
    287          jn = jp_lob0_2d + jl - 1 
    288          WRITE(ctrc2d(jn),'("2D_",I1)') jn                      ! short name 
    289          WRITE(ctrc2l(jn),'("2D DIAGNOSTIC NUMBER ",I2)') jn    ! long name 
    290          ctrc2u(jn) = ' '                                       ! units 
    291       END DO 
    292       !                                 ! 3D output arrays 
    293       DO jl = 1, jp_lobster_3d 
    294          jn = jp_lob0_3d + jl - 1 
    295          WRITE(ctrc3d(jn),'("3D_",I1)') jn                      ! short name 
    296          WRITE(ctrc3l(jn),'("3D DIAGNOSTIC NUMBER ",I2)') jn    ! long name 
    297          ctrc3u(jn) = ' '                                       ! units 
    298       END DO 
    299  
    300       REWIND( numnatl )               ! read natrtd 
    301       READ  ( numnatl, namlobdia ) 
    302  
    303       DO jl = 1, jp_lobster_2d 
    304          jn = jp_lob0_2d + jl - 1 
    305          ctrc2d(jn) = lobdia2d(jl)%snamedia 
    306          ctrc2l(jn) = lobdia2d(jl)%lnamedia 
    307          ctrc2u(jn) = lobdia2d(jl)%unitdia 
    308       END DO 
    309  
    310       DO jl = 1, jp_lobster_3d 
    311          jn = jp_lob0_3d + jl - 1 
    312          ctrc3d(jn) = lobdia3d(jl)%snamedia 
    313          ctrc3l(jn) = lobdia3d(jl)%lnamedia 
    314          ctrc3u(jn) = lobdia3d(jl)%unitdia 
    315       END DO 
    316  
    317       IF(lwp) THEN                   ! control print 
    318          WRITE(numout,*) 
    319          WRITE(numout,*) ' Namelist : natadd' 
    320          WRITE(numout,*) '    frequency of outputs for additional arrays nn_writedia = ', nn_writedia 
     259      ! 
     260      IF( .NOT.lk_iomput .AND. ln_diatrc ) THEN 
     261         ! 
     262         ! Namelist namlobdia 
     263         ! ------------------- 
     264         DO jl = 1, jp_lobster_2d 
     265            WRITE(lobdia2d(jl)%sname,'("2D_",I1)') jl                      ! short name 
     266            WRITE(lobdia2d(jl)%lname,'("2D DIAGNOSTIC NUMBER ",I2)') jl    ! long name 
     267            lobdia2d(jl)%units = ' '                                        ! units 
     268         END DO 
     269         !                                 ! 3D output arrays 
     270         DO jl = 1, jp_lobster_3d 
     271            WRITE(lobdia3d(jl)%sname,'("3D_",I1)') jl                      ! short name 
     272            WRITE(lobdia3d(jl)%lname,'("3D DIAGNOSTIC NUMBER ",I2)') jl    ! long name 
     273            lobdia3d(jl)%units = ' '                                        ! units 
     274         END DO 
     275 
     276         REWIND( numnatl )               ! read natrtd 
     277         READ  ( numnatl, namlobdia ) 
     278 
     279         DO jl = 1, jp_lobster_2d 
     280            jn = jp_lob0_2d + jl - 1 
     281            ctrc2d(jn) = lobdia2d(jl)%sname 
     282            ctrc2l(jn) = lobdia2d(jl)%lname 
     283            ctrc2u(jn) = lobdia2d(jl)%units 
     284         END DO 
     285 
    321286         DO jl = 1, jp_lobster_3d 
    322287            jn = jp_lob0_3d + jl - 1 
    323             WRITE(numout,*) '   3d output field No : ',jn 
    324             WRITE(numout,*) '   short name         : ', TRIM(ctrc3d(jn)) 
    325             WRITE(numout,*) '   long name          : ', TRIM(ctrc3l(jn)) 
    326             WRITE(numout,*) '   unit               : ', TRIM(ctrc3u(jn)) 
     288            ctrc3d(jn) = lobdia3d(jl)%sname 
     289            ctrc3l(jn) = lobdia3d(jl)%lname 
     290            ctrc3u(jn) = lobdia3d(jl)%units 
     291         END DO 
     292 
     293         IF(lwp) THEN                   ! control print 
     294            WRITE(numout,*) 
     295            WRITE(numout,*) ' Namelist : natadd' 
     296            DO jl = 1, jp_lobster_3d 
     297               jn = jp_lob0_3d + jl - 1 
     298               WRITE(numout,*) '  3d diag nb : ', jn, '    short name : ', ctrc3d(jn), & 
     299                 &             '  long name  : ', ctrc3l(jn), '   unit : ', ctrc3u(jn) 
     300            END DO 
    327301            WRITE(numout,*) ' ' 
    328          END DO 
    329  
    330          DO jl = 1, jp_lobster_2d 
    331             jn = jp_lob0_2d + jl - 1 
    332             WRITE(numout,*) '   2d output field No : ',jn 
    333             WRITE(numout,*) '   short name         : ', TRIM(ctrc2d(jn)) 
    334             WRITE(numout,*) '   long name          : ', TRIM(ctrc2l(jn)) 
    335             WRITE(numout,*) '   unit               : ', TRIM(ctrc2u(jn)) 
     302 
     303            DO jl = 1, jp_lobster_2d 
     304               jn = jp_lob0_2d + jl - 1 
     305               WRITE(numout,*) '  2d diag nb : ', jn, '    short name : ', ctrc2d(jn), & 
     306                 &             '  long name  : ', ctrc2l(jn), '   unit : ', ctrc2u(jn) 
     307            END DO 
    336308            WRITE(numout,*) ' ' 
    337          END DO 
    338       ENDIF 
    339 #endif 
    340  
    341 #if defined key_diabio || defined key_trdmld_trc 
    342       ! namlobdbi : bio diagnostics 
    343       nwritebio = 10                     ! default values 
    344  
    345       DO js = 1, jp_lobster_trd 
    346          jd = jp_lob0_trd + js - 1 
    347          IF(     jd <  10 ) THEN   ;   WRITE (ctrbio(jd),'("BIO_",I1)') jd      ! short name 
    348          ELSEIF (jd < 100 ) THEN   ;   WRITE (ctrbio(jd),'("BIO_",I2)') jd    
    349          ELSE                      ;   WRITE (ctrbio(jd),'("BIO_",I3)') jd 
    350309         ENDIF 
    351          WRITE(ctrbil(jd),'("BIOLOGICAL TREND NUMBER ",I2)') jd                 ! long name 
    352          ctrbiu(jd) = 'mmoleN/m3/s '                                            ! units 
    353       END DO 
    354  
    355       REWIND( numnatl ) 
    356       READ  ( numnatl, namlobdbi )  
     310         ! 
     311      ENDIF 
     312 
     313      IF( ( .NOT.lk_iomput .AND. ln_diabio ) .OR. lk_trdmld_trc ) THEN 
     314         ! 
     315         ! Namelist namlobdbi 
     316         ! ------------------- 
     317         DO jl = 1, jp_lobster_trd 
     318            IF(     jl <  10 ) THEN   ;   WRITE (lobdiabio(jl)%sname,'("BIO_",I1)') jl      ! short name 
     319            ELSEIF (jl < 100 ) THEN   ;   WRITE (lobdiabio(jl)%sname,'("BIO_",I2)') jl   
     320            ELSE                      ;   WRITE (lobdiabio(jl)%sname,'("BIO_",I3)') jl 
     321            ENDIF 
     322            WRITE(lobdiabio(jl)%lname,'("BIOLOGICAL TREND NUMBER ",I2)') jl                 ! long name 
     323            lobdiabio(jl)%units = 'mmoleN/m3/s '                                            ! units 
     324         END DO 
     325 
     326         REWIND( numnatl ) 
     327         READ  ( numnatl, namlobdbi )  
    357328  
    358       DO js = 1, jp_lobster_trd 
    359          jd = jp_lob0_trd + js - 1 
    360          ctrbio(jd) = lobdiabio(js)%snamebio 
    361          ctrbil(jd) = lobdiabio(js)%lnamebio 
    362          ctrbiu(jd) = lobdiabio(js)%unitbio 
    363       END DO 
    364  
    365       IF(lwp) THEN                   ! control print 
    366          WRITE(numout,*) 
    367          WRITE(numout,*) ' Namelist : namlobdbi' 
    368          WRITE(numout,*) '    frequency of outputs for biological trends nwritebio = ', nwritebio 
    369          DO js = 1, jp_lobster_trd 
    370             jd = jp_lob0_trd + js - 1 
    371             WRITE(numout,*) '   biological trend No : ',jd 
    372             WRITE(numout,*) '   short name         : ', TRIM(ctrbio(jd)) 
    373             WRITE(numout,*) '   long name          : ', TRIM(ctrbil(jd)) 
    374             WRITE(numout,*) '   unit               : ', TRIM(ctrbiu(jd)) 
     329         DO jl = 1, jp_lobster_trd 
     330            jn = jp_lob0_trd + jl - 1 
     331            ctrbio(jl) = lobdiabio(jl)%sname 
     332            ctrbil(jl) = lobdiabio(jl)%lname 
     333            ctrbiu(jl) = lobdiabio(jl)%units 
     334         END DO 
     335 
     336         IF(lwp) THEN                   ! control print 
     337            WRITE(numout,*) 
     338            WRITE(numout,*) ' Namelist : namlobdbi' 
     339            DO jl = 1, jp_lobster_trd 
     340               jn = jp_lob0_trd + jl - 1 
     341               WRITE(numout,*) '  biological trend No : ', jn, '    short name : ', ctrbio(jn), & 
     342                 &             '  long name  : ', ctrbio(jn), '   unit : ', ctrbio(jn) 
     343            END DO 
    375344            WRITE(numout,*) ' ' 
    376          END DO 
     345         END IF 
     346         ! 
    377347      END IF 
    378 #endif 
    379348      ! 
    380349   END SUBROUTINE trc_nam_lobster 
  • trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcopt.F90

    r2715 r3294  
    5252      !!                xze    ??? 
    5353      !!--------------------------------------------------------------------- 
    54       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    55       USE wrk_nemo, ONLY: zpar100 => wrk_2d_1, & ! irradiance at euphotic layer depth 
    56                           zpar0m  => wrk_2d_2    ! irradiance just below the surface 
    57       USE wrk_nemo, ONLY: zparr => wrk_3d_2, &   ! red and green compound of par 
    58                           zparg => wrk_3d_3 
    5954      !! 
    6055      INTEGER, INTENT( in ) ::   kt   ! index of the time stepping 
     
    6560      REAL(wp) ::   zkr, zkg            ! total absorption coefficient in red and green 
    6661      REAL(wp) ::   zcoef               ! temporary scalar 
     62      REAL(wp), POINTER, DIMENSION(:,:  ) :: zpar100, zpar0m  
     63      REAL(wp), POINTER, DIMENSION(:,:,:) :: zparr, zparg 
     64      !!--------------------------------------------------------------------- 
     65      ! 
     66      IF( nn_timing == 1 )  CALL timing_start('trc_opt') 
     67      ! 
     68      ! Allocate temporary workspace 
     69      CALL wrk_alloc( jpi, jpj,      zpar100, zpar0m ) 
     70      CALL wrk_alloc( jpi, jpj, jpk, zparr, zparg    ) 
    6771 
    68       !!--------------------------------------------------------------------- 
    69  
    70       IF( ( wrk_in_use(2, 1,2)) .OR. ( wrk_in_use(3, 2,3)) )THEN 
    71          CALL ctl_stop('trc_opt : requested workspace arrays unavailable')   ;   RETURN 
    72       END IF 
    73  
    74       IF( kt == nit000 ) THEN 
     72      IF( kt == nittrc000 ) THEN 
    7573         IF(lwp) WRITE(numout,*) 
    7674         IF(lwp) WRITE(numout,*) ' trc_opt : LOBSTER optic-model' 
     
    137135      ENDIF 
    138136      ! 
    139       IF( wrk_not_released(2, 1,2)  .OR.  wrk_not_released(3, 2,3)  )   & 
    140           CALL ctl_stop('trc_opt : failed to release workspace arrays') 
     137      CALL wrk_dealloc( jpi, jpj,      zpar100, zpar0m ) 
     138      CALL wrk_dealloc( jpi, jpj, jpk, zparr, zparg    ) 
     139      ! 
     140      IF( nn_timing == 1 )  CALL timing_stop('trc_opt') 
    141141      ! 
    142142   END SUBROUTINE trc_opt 
  • trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcsed.F90

    r2715 r3294  
    5656      !!              trend of passive tracers is saved for futher diagnostics. 
    5757      !!--------------------------------------------------------------------- 
    58       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    59       USE wrk_nemo, ONLY: zwork => wrk_3d_2 
    60       USE wrk_nemo, ONLY: zw2d  => wrk_2d_1 ! only used (if defined  
    61                                             ! key_diatrc && defined key_iomput) 
    6258      !! 
    6359      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
    6460      !! 
    65       INTEGER  ::   ji, jj, jk, jl 
    66       REAL(wp) ::   ztra 
    67       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrbio 
     61      INTEGER  ::   ji, jj, jk, jl, ierr 
    6862      CHARACTER (len=25) :: charout 
     63      REAL(wp), POINTER, DIMENSION(:,:  ) :: zw2d 
     64      REAL(wp), POINTER, DIMENSION(:,:,:) :: zwork, ztra, ztrbio 
    6965      !!--------------------------------------------------------------------- 
    70  
    71       IF( ( wrk_in_use(3,2)) .OR. ( wrk_in_use(2,1)) ) THEN 
    72          CALL ctl_stop('trc_sed : requested workspace arrays unavailable.') 
    73          RETURN 
    74       END IF 
    75  
    76       IF( kt == nit000 ) THEN 
     66      ! 
     67      IF( nn_timing == 1 )  CALL timing_start('trc_sed') 
     68      ! 
     69      IF( kt == nittrc000 ) THEN 
    7770         IF(lwp) WRITE(numout,*) 
    7871         IF(lwp) WRITE(numout,*) ' trc_sed: LOBSTER sedimentation' 
    7972         IF(lwp) WRITE(numout,*) ' ~~~~~~~' 
     73      ENDIF 
     74 
     75      ! Allocate temporary workspace 
     76      CALL wrk_alloc( jpi, jpj, jpk, zwork, ztra ) 
     77 
     78      IF( ln_diatrc )  THEN 
     79         CALL wrk_alloc( jpi, jpj, zw2d ) 
     80      ENDIF 
     81 
     82      IF( l_trdtrc ) THEN 
     83         CALL wrk_alloc( jpi, jpj, jpk, ztrbio ) 
     84         ztrbio(:,:,:) = tra(:,:,:,jp_lob_det) 
    8085      ENDIF 
    8186 
     
    8792      zwork(:,:,jpk) = 0.e0      ! bottom value  set to zero 
    8893 
    89 #if defined key_diatrc && defined key_iomput 
    90       zw2d(:,:) = 0. 
    91 # endif 
    92  
    93       IF( l_trdtrc )THEN 
    94          ALLOCATE( ztrbio(jpi,jpj,jpk) ) 
    95          ztrbio(:,:,:) = tra(:,:,:,jp_lob_det) 
    96       ENDIF 
    97  
    9894      ! tracer flux at w-point: we use -vsed (downward flux)  with simplification : no e1*e2 
    9995      DO jk = 2, jpkm1 
     
    104100      DO jk = 1, jpkm1 
    105101         DO jj = 1, jpj 
    106             DO ji = 1,jpi 
    107                ztra  = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / fse3t(ji,jj,jk) 
    108                tra(ji,jj,jk,jp_lob_det) = tra(ji,jj,jk,jp_lob_det) + ztra 
    109 #if defined key_diabio 
    110                trbio(ji,jj,jk,jp_lob0_trd + 7) = ztra 
    111 #endif 
    112 #if defined key_diatrc 
    113 # if ! defined key_iomput 
    114                trc2d(ji,jj,jp_lob0_2d + 7) = trc2d(ji,jj,jp_lob0_2d + 7) + ztra * fse3t(ji,jj,jk) * 86400. 
    115 # else 
    116                zw2d(ji,jj) = zw2d(ji,jj) + ztra * fse3t(ji,jj,jk) * 86400. 
    117 # endif 
    118 #endif 
     102            DO ji = 1, jpi 
     103               ztra(ji,jj,jk)  = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / fse3t(ji,jj,jk) 
     104               tra(ji,jj,jk,jp_lob_det) = tra(ji,jj,jk,jp_lob_det) + ztra(ji,jj,jk)  
    119105            END DO 
    120106         END DO 
    121107      END DO 
    122108 
    123 #if defined key_diabio 
    124       jl = jp_lob0_trd + 7 
    125       CALL lbc_lnk (trbio(:,:,1,jl), 'T', 1. )    ! Lateral boundary conditions on trcbio 
    126 #endif 
    127 #if defined key_diatrc 
    128 # if ! defined key_iomput 
    129       jl = jp_lob0_2d + 7 
    130       CALL lbc_lnk( trc2d(:,:,jl), 'T', 1. )      ! Lateral boundary conditions on trc2d 
    131 # else 
    132       CALL lbc_lnk( zw2d(:,:), 'T', 1. )      ! Lateral boundary conditions on zw2d 
    133       CALL iom_put( "TDETSED", zw2d ) 
    134 # endif 
    135 #endif 
     109      IF( ln_diatrc ) THEN  
     110         DO jk = 1, jpkm1 
     111            DO jj = 1, jpj 
     112               DO ji = 1, jpi 
     113                  zw2d(ji,jj) = zw2d(ji,jj) + ztra(ji,jj,jk) * fse3t(ji,jj,jk) * 86400. 
     114               END DO 
     115            END DO 
     116         END DO 
     117         IF( lk_iomput )  THEN 
     118           CALL iom_put( "TDETSED", zw2d ) 
     119         ELSE 
     120           trc2d(:,:,jp_lob0_2d + 7) = zw2d(:,:) 
     121         ENDIF 
     122         CALL wrk_dealloc( jpi, jpj, zw2d ) 
     123      ENDIF 
    136124      ! 
    137  
     125      IF( ln_diabio )  trbio(:,:,:,jp_lob0_trd + 7) = ztra(:,:,:) 
     126      CALL wrk_dealloc( jpi, jpj, jpk, zwork, ztra ) 
     127      ! 
    138128      IF( l_trdtrc ) THEN 
    139129         ztrbio(:,:,:) = tra(:,:,:,jp_lob_det) - ztrbio(:,:,:) 
    140130         jl = jp_lob0_trd + 7 
    141131         CALL trd_mod_trc( ztrbio, jl, kt )   ! handle the trend 
     132         CALL wrk_dealloc( jpi, jpj, jpk, ztrbio ) 
    142133      ENDIF 
    143  
    144       IF( l_trdtrc ) DEALLOCATE( ztrbio ) 
    145134 
    146135      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     
    149138         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
    150139      ENDIF 
    151  
    152       IF( ( wrk_not_released(3, 2) ) .OR. ( wrk_not_released(2, 1) ) )  & 
    153        &         CALL ctl_stop('trc_sed : failed to release workspace arrays.') 
    154  
     140      ! 
     141      IF( nn_timing == 1 )  CALL timing_stop('trc_sed') 
     142      ! 
    155143   END SUBROUTINE trc_sed 
    156144 
  • trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcsms_lobster.F90

    r2715 r3294  
    4545      !! ** Method  : - ??? 
    4646      !! -------------------------------------------------------------------- 
    47       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    48       USE wrk_nemo, ONLY: ztrlob => wrk_3d_1   ! used for lobster sms trends 
    4947      !! 
    5048      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
     49      ! 
    5150      INTEGER :: jn 
    5251      !! -------------------------------------------------------------------- 
    53  
    54       IF( wrk_in_use(3, 1) ) THEN 
    55          CALL ctl_stop('trc_sms_lobster : requested workspace array unavailable')   ;   RETURN 
    56       ENDIF 
    57  
     52      ! 
     53      IF( nn_timing == 1 )  CALL timing_start('trc_sms_lobster') 
     54      ! 
    5855      CALL trc_opt( kt )      ! optical model 
    5956      CALL trc_bio( kt )      ! biological model 
     
    6259 
    6360      IF( l_trdtrc ) THEN 
    64           DO jn = jp_lob0, jp_lob1 
    65             ztrlob(:,:,:) = tra(:,:,:,jn) 
    66             CALL trd_mod_trc( ztrlob, jn, jptra_trd_sms, kt )   ! save trends 
    67           END DO 
     61         DO jn = jp_lob0, jp_lob1 
     62           CALL trd_mod_trc( tra(:,:,:,jn), jn, jptra_trd_sms, kt )   ! save trends 
     63         END DO 
    6864      END IF 
    6965 
    7066      IF( lk_trdmld_trc )  CALL trd_mld_bio( kt )   ! trends: Mixed-layer 
    71  
    72       IF( wrk_not_released(3, 1) )   CALL ctl_stop('trc_sms_lobster : failed to release workspace array.') 
     67      ! 
     68      IF( nn_timing == 1 )  CALL timing_stop('trc_sms_lobster') 
    7369      ! 
    7470   END SUBROUTINE trc_sms_lobster 
  • trunk/NEMOGCM/NEMO/TOP_SRC/MY_TRC/trcsms_my_trc.F90

    r2715 r3294  
    1010   !!   'key_my_trc'                                               CFC tracers 
    1111   !!---------------------------------------------------------------------- 
    12    !! trc_sms_my_trc       : MY_TRC model main routine  
     12   !! trc_sms_my_trc       : MY_TRC model main routine 
    1313   !! trc_sms_my_trc_alloc : allocate arrays specific to MY_TRC sms 
    1414   !!---------------------------------------------------------------------- 
     
    2626 
    2727   ! Defined HERE the arrays specific to MY_TRC sms and ALLOCATE them in trc_sms_my_trc_alloc 
    28     
     28 
    2929   !!---------------------------------------------------------------------- 
    3030   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    31    !! $Id$  
     31   !! $Id$ 
    3232   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    3333   !!---------------------------------------------------------------------- 
     
    3636   SUBROUTINE trc_sms_my_trc( kt ) 
    3737      !!---------------------------------------------------------------------- 
    38       !!                     ***  trc_sms_my_trc  ***   
     38      !!                     ***  trc_sms_my_trc  *** 
    3939      !! 
    4040      !! ** Purpose :   main routine of MY_TRC model 
    4141      !! 
    42       !! ** Method  : -  
     42      !! ** Method  : - 
    4343      !!---------------------------------------------------------------------- 
    44       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    45       USE wrk_nemo, ONLY:   ztrmyt => wrk_3d_1   ! used for lobster sms trends 
    4644      ! 
    4745      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    4846      INTEGER ::   jn   ! dummy loop index 
    49       !!---------------------------------------------------------------------- 
    50  
     47      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrmyt 
     48!!---------------------------------------------------------------------- 
     49      ! 
     50      IF( nn_timing == 1 )  CALL timing_start('trc_sms_my_trc') 
     51      ! 
    5152      IF(lwp) WRITE(numout,*) 
    5253      IF(lwp) WRITE(numout,*) ' trc_sms_my_trc:  MY_TRC model' 
    5354      IF(lwp) WRITE(numout,*) ' ~~~~~~~~~~~~~~' 
     55 
     56      IF( l_trdtrc )  CALL wrk_alloc( jpi, jpj, jpk, ztrmyt ) 
    5457 
    5558      WHERE( (glamt <= 170) .AND. (glamt >= 160) .AND. (gphit <= -74) .AND. (gphit >=-75.6) ) 
     
    5962      END WHERE 
    6063 
    61       WHERE( ((glamt <= -165) .OR. (glamt >= 160)) .AND. (gphit <= -76) .AND. (gphit >=-80))  
     64      WHERE( ((glamt <= -165) .OR. (glamt >= 160)) .AND. (gphit <= -76) .AND. (gphit >=-80)) 
    6265        trn(:,:,1,jpmyt2) = 1._wp 
    6366        trb(:,:,1,jpmyt2) = 1._wp 
     
    7073            CALL trd_mod_trc( ztrmyt, jn, jptra_trd_sms, kt )   ! save trends 
    7174          END DO 
     75          CALL wrk_dealloc( jpi, jpj, jpk, ztrmyt ) 
    7276      END IF 
     77      ! 
     78      IF( nn_timing == 1 )  CALL timing_stop('trc_sms_my_trc') 
    7379      ! 
    7480   END SUBROUTINE trc_sms_my_trc 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zbio.F90

    r2715 r3294  
    1414   !!                      compartments of PISCES 
    1515   !!---------------------------------------------------------------------- 
    16    USE oce_trc         ! 
    17    USE trc         !  
    18    USE sms_pisces      !  
    19    USE p4zsink         !  
    20    USE p4zopt          !  
    21    USE p4zlim          !  
    22    USE p4zprod         ! 
    23    USE p4zmort         ! 
    24    USE p4zmicro        !  
    25    USE p4zmeso         !  
    26    USE p4zrem          !  
    27    USE prtctl_trc 
    28    USE iom 
     16   USE oce_trc         !  shared variables between ocean and passive tracers 
     17   USE trc             !  passive tracers common variables  
     18   USE sms_pisces      !  PISCES Source Minus Sink variables 
     19   USE p4zsink         !  vertical flux of particulate matter due to sinking 
     20   USE p4zopt          !  optical model 
     21   USE p4zlim          !  Co-limitations of differents nutrients 
     22   USE p4zprod         !  Growth rate of the 2 phyto groups 
     23   USE p4zmort         !  Mortality terms for phytoplankton 
     24   USE p4zmicro        !  Sources and sinks of microzooplankton 
     25   USE p4zmeso         !  Sources and sinks of mesozooplankton 
     26   USE p4zrem          !  Remineralisation of organic matter 
     27   USE prtctl_trc      !  print control for debugging 
     28   USE iom             !  I/O manager 
    2929   
    3030   IMPLICIT NONE 
     
    6262 
    6363      !!--------------------------------------------------------------------- 
    64  
     64      ! 
     65      IF( nn_timing == 1 )  CALL timing_start('p4z_bio') 
     66      ! 
    6567      !     ASSIGN THE SHEAR RATE THAT IS USED FOR AGGREGATION 
    6668      !     OF PHYTOPLANKTON AND DETRITUS 
     
    129131      ENDIF 
    130132      ! 
     133      IF( nn_timing == 1 )  CALL timing_stop('p4z_bio') 
     134      ! 
    131135   END SUBROUTINE p4z_bio 
    132136 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zche.F90

    r2715 r3294  
    1010   !!              -   !  2006     (R. Gangsto)  modification 
    1111   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
     12   !!                  !  2011-02  (J. Simeon, J.Orr ) update O2 solubility constants 
    1213   !!---------------------------------------------------------------------- 
    1314#if defined key_pisces 
     
    1718   !!   p4z_che      :  Sea water chemistry computed following OCMIP protocol 
    1819   !!---------------------------------------------------------------------- 
    19    USE oce_trc       ! 
    20    USE trc           ! 
    21    USE sms_pisces    !  
    22    USE lib_mpp       ! MPP library 
     20   USE oce_trc       !  shared variables between ocean and passive tracers 
     21   USE trc           !  passive tracers common variables 
     22   USE sms_pisces    !  PISCES Source Minus Sink variables 
     23   USE lib_mpp       !  MPP library 
    2324 
    2425   IMPLICIT NONE 
     
    3233   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   chemc    ! Solubilities of O2 and CO2 
    3334 
    34    REAL(wp) ::   salchl = 1._wp / 1.80655_wp ! conversion factor for salinity --> chlorinity (Wooster et al. 1969) 
    35  
    36    REAL(wp) ::   akcc1 = -171.9065_wp      ! coeff. for apparent solubility equilibrium 
    37    REAL(wp) ::   akcc2 =   -0.077993_wp    ! Millero et al. 1995 from Mucci 1983 
    38    REAL(wp) ::   akcc3 = 2839.319_wp       ! 
    39    REAL(wp) ::   akcc4 =   71.595_wp       ! 
    40    REAL(wp) ::   akcc5 =   -0.77712_wp     ! 
    41    REAL(wp) ::   akcc6 =    0.0028426_wp   ! 
    42    REAL(wp) ::   akcc7 =  178.34_wp        ! 
    43    REAL(wp) ::   akcc8 =   -0.07711_wp     ! 
    44    REAL(wp) ::   akcc9 =    0.0041249_wp   ! 
    45  
    46    REAL(wp) ::   rgas  = 83.143_wp         ! universal gas constants 
    47    REAL(wp) ::   oxyco = 1._wp / 22.4144_wp 
    48  
    49    REAL(wp) ::   bor1 = 0.00023_wp         ! borat constants 
    50    REAL(wp) ::   bor2 = 1._wp / 10.82_wp 
    51  
    52    REAL(wp) ::   ca0 = -162.8301_wp 
    53    REAL(wp) ::   ca1 =  218.2968_wp 
    54    REAL(wp) ::   ca2 =   90.9241_wp 
    55    REAL(wp) ::   ca3 =   -1.47696_wp 
    56    REAL(wp) ::   ca4 =    0.025695_wp 
    57    REAL(wp) ::   ca5 =   -0.025225_wp 
    58    REAL(wp) ::   ca6 =    0.0049867_wp 
    59  
    60    REAL(wp) ::   c10 = -3670.7_wp        ! coeff. for 1. dissoc. of carbonic acid (Edmond and Gieskes, 1970)    
    61    REAL(wp) ::   c11 =    62.008_wp      
    62    REAL(wp) ::   c12 =    -9.7944_wp     
    63    REAL(wp) ::   c13 =     0.0118_wp      
    64    REAL(wp) ::   c14 =    -0.000116_wp 
    65  
    66    REAL(wp) :: &              ! coeff. for 2. dissoc. of carbonic acid (Millero, 1995)    
    67       c20 = -1394.7   , & 
    68       c21 = -4.777    , & 
    69       c22 = 0.0184    , & 
    70       c23 = -0.000118 
    71  
    72    REAL(wp) :: &             ! constants for calculate concentrations  
    73       st1  = 0.14     , &    ! for sulfate (Morris & Riley 1966) 
    74       st2  = 1./96.062, & 
    75       ks0  = 141.328  , & 
    76       ks1  = -4276.1  , & 
    77       ks2  = -23.093  , & 
    78       ks3  = -13856.  , & 
    79       ks4  = 324.57   , & 
    80       ks5  = -47.986  , & 
    81       ks6  = 35474.   , & 
    82       ks7  = -771.54  , & 
    83       ks8  = 114.723  , & 
    84       ks9  = -2698.   , & 
    85       ks10 = 1776.    , & 
    86       ks11 = 1.       , & 
    87       ks12 = -0.001005  
    88  
    89    REAL(wp) :: &             ! constants for calculate concentrations  
    90       ft1  = 0.000067   , &  ! fluorides (Dickson & Riley 1979 ) 
    91       ft2  = 1./18.9984 , & 
    92       kf0  = -12.641    , & 
    93       kf1  = 1590.2     , & 
    94       kf2  = 1.525      , & 
    95       kf3  = 1.0        , & 
    96       kf4  =-0.001005 
    97  
    98    REAL(wp) :: &              ! coeff. for 1. dissoc. of boric acid (Dickson and Goyet, 1994) 
    99       cb0  = -8966.90, & 
    100       cb1  = -2890.53, & 
    101       cb2  = -77.942 , & 
    102       cb3  = 1.728   , & 
    103       cb4  = -0.0996 , & 
    104       cb5  = 148.0248, & 
    105       cb6  = 137.1942, & 
    106       cb7  = 1.62142 , & 
    107       cb8  = -24.4344, & 
    108       cb9  = -25.085 , & 
    109       cb10 = -0.2474 , & 
    110       cb11 = 0.053105 
    111  
    112    REAL(wp) :: &             ! coeff. for dissoc. of water (Dickson and Riley, 1979 ) 
    113       cw0 = -13847.26  , & 
    114       cw1 = 148.9652   , & 
    115       cw2 = -23.6521   , & 
    116       cw3 = 118.67     , & 
    117       cw4 = -5.977     , & 
    118       cw5 = 1.0495     , & 
    119       cw6 = -0.01615 
    120   
    121    REAL(wp) :: &              ! volumetric solubility constants for o2 in ml/l (Weiss, 1974) 
    122       ox0 = -58.3877   , & 
    123       ox1 = 85.8079    , & 
    124       ox2 = 23.8439    , & 
    125       ox3 = -0.034892  , & 
    126       ox4 =  0.015568  , & 
    127       ox5 = -0.0019387  
    128  
    129    REAL(wp), DIMENSION(5)  :: &  ! coeff. for seawater pressure correction  
    130       devk1, devk2, devk3,    &  ! (millero 95) 
    131       devk4, devk5 
    132  
     35   REAL(wp), PUBLIC ::   atcox  = 0.20946         ! units atm 
     36 
     37   REAL(wp) ::   salchl = 1. / 1.80655    ! conversion factor for salinity --> chlorinity (Wooster et al. 1969) 
     38   REAL(wp) ::   o2atm  = 1. / ( 1000. * 0.20946 )   
     39 
     40   REAL(wp) ::   akcc1  = -171.9065       ! coeff. for apparent solubility equilibrium 
     41   REAL(wp) ::   akcc2  =   -0.077993     ! Millero et al. 1995 from Mucci 1983 
     42   REAL(wp) ::   akcc3  = 2839.319         
     43   REAL(wp) ::   akcc4  =   71.595         
     44   REAL(wp) ::   akcc5  =   -0.77712       
     45   REAL(wp) ::   akcc6  =    0.00284263    
     46   REAL(wp) ::   akcc7  =  178.34         
     47   REAL(wp) ::   akcc8  =   -0.07711      
     48   REAL(wp) ::   akcc9  =    0.0041249    
     49 
     50   REAL(wp) ::   rgas   = 83.143         ! universal gas constants 
     51   REAL(wp) ::   oxyco  = 1. / 22.4144   ! converts from liters of an ideal gas to moles 
     52 
     53   REAL(wp) ::   bor1   = 0.00023        ! borat constants 
     54   REAL(wp) ::   bor2   = 1. / 10.82 
     55 
     56   REAL(wp) ::   ca0    = -162.8301      ! WEISS & PRICE 1980, units mol/(kg atm) 
     57   REAL(wp) ::   ca1    =  218.2968 
     58   REAL(wp) ::   ca2    =   90.9241 
     59   REAL(wp) ::   ca3    =   -1.47696 
     60   REAL(wp) ::   ca4    =    0.025695 
     61   REAL(wp) ::   ca5    =   -0.025225 
     62   REAL(wp) ::   ca6    =    0.0049867 
     63 
     64   REAL(wp) ::   c10    = -3670.7        ! Coeff. for 1. dissoc. of carbonic acid (Edmond and Gieskes, 1970)    
     65   REAL(wp) ::   c11    =    62.008      
     66   REAL(wp) ::   c12    =    -9.7944     
     67   REAL(wp) ::   c13    =     0.0118      
     68   REAL(wp) ::   c14    =    -0.000116 
     69 
     70   REAL(wp) ::   c20    = -1394.7       ! coeff. for 2. dissoc. of carbonic acid (Millero, 1995)    
     71   REAL(wp) ::   c21    =    -4.777    
     72   REAL(wp) ::   c22    =     0.0184    
     73   REAL(wp) ::   c23    =    -0.000118 
     74 
     75   REAL(wp) ::   st1    =      0.14     ! constants for calculate concentrations for sulfate 
     76   REAL(wp) ::   st2    =  1./96.062    !  (Morris & Riley 1966) 
     77   REAL(wp) ::   ks0    =    141.328  
     78   REAL(wp) ::   ks1    =  -4276.1   
     79   REAL(wp) ::   ks2    =    -23.093 
     80   REAL(wp) ::   ks3    = -13856.   
     81   REAL(wp) ::   ks4    =   324.57  
     82   REAL(wp) ::   ks5    =   -47.986 
     83   REAL(wp) ::   ks6    =  35474.  
     84   REAL(wp) ::   ks7    =   -771.54 
     85   REAL(wp) ::   ks8    =    114.723 
     86   REAL(wp) ::   ks9    =  -2698.   
     87   REAL(wp) ::   ks10   =   1776.  
     88   REAL(wp) ::   ks11   =      1. 
     89   REAL(wp) ::   ks12   =     -0.001005  
     90 
     91   REAL(wp) ::   ft1    =    0.000067   ! constants for calculate concentrations for fluorides 
     92   REAL(wp) ::   ft2    = 1./18.9984    ! (Dickson & Riley 1979 ) 
     93   REAL(wp) ::   kf0    =  -12.641     
     94   REAL(wp) ::   kf1    = 1590.2     
     95   REAL(wp) ::   kf2    =    1.525     
     96   REAL(wp) ::   kf3    =    1.0      
     97   REAL(wp) ::   kf4    =   -0.001005 
     98 
     99   REAL(wp) ::   cb0    = -8966.90      ! Coeff. for 1. dissoc. of boric acid  
     100   REAL(wp) ::   cb1    = -2890.53      ! (Dickson and Goyet, 1994) 
     101   REAL(wp) ::   cb2    =   -77.942 
     102   REAL(wp) ::   cb3    =     1.728 
     103   REAL(wp) ::   cb4    =    -0.0996 
     104   REAL(wp) ::   cb5    =   148.0248 
     105   REAL(wp) ::   cb6    =   137.1942 
     106   REAL(wp) ::   cb7    =     1.62142 
     107   REAL(wp) ::   cb8    =   -24.4344 
     108   REAL(wp) ::   cb9    =   -25.085 
     109   REAL(wp) ::   cb10   =    -0.2474  
     110   REAL(wp) ::   cb11   =     0.053105 
     111 
     112   REAL(wp) ::   cw0    = -13847.26     ! Coeff. for dissoc. of water (Dickson and Riley, 1979 ) 
     113   REAL(wp) ::   cw1    =    148.9652   
     114   REAL(wp) ::   cw2    =    -23.6521 
     115   REAL(wp) ::   cw3    =    118.67  
     116   REAL(wp) ::   cw4    =     -5.977  
     117   REAL(wp) ::   cw5    =      1.0495   
     118   REAL(wp) ::   cw6    =     -0.01615 
     119 
     120   !                                    ! volumetric solubility constants for o2 in ml/L   
     121   REAL(wp) ::   ox0    =  2.00856      ! from Table 1 for Eq 8 of Garcia and Gordon, 1992. 
     122   REAL(wp) ::   ox1    =  3.22400      ! corrects for moisture and fugacity, but not total atmospheric pressure 
     123   REAL(wp) ::   ox2    =  3.99063      !      Original PISCES code noted this was a solubility, but  
     124   REAL(wp) ::   ox3    =  4.80299      ! was in fact a bunsen coefficient with units L-O2/(Lsw atm-O2) 
     125   REAL(wp) ::   ox4    =  9.78188e-1   ! Hence, need to divide EXP( zoxy ) by 1000, ml-O2 => L-O2 
     126   REAL(wp) ::   ox5    =  1.71069      ! and atcox = 0.20946 to add the 1/atm dimension. 
     127   REAL(wp) ::   ox6    = -6.24097e-3    
     128   REAL(wp) ::   ox7    = -6.93498e-3  
     129   REAL(wp) ::   ox8    = -6.90358e-3 
     130   REAL(wp) ::   ox9    = -4.29155e-3  
     131   REAL(wp) ::   ox10   = -3.11680e-7  
     132 
     133   REAL(wp), DIMENSION(5)  :: devk1, devk2, devk3, devk4, devk5   ! coeff. for seawater pressure correction  
     134   !                                                              ! (millero 95) 
    133135   DATA devk1 / -25.5    , -15.82    , -29.48  , -25.60     , -48.76    /    
    134136   DATA devk2 / 0.1271   , -0.0219   , 0.1622  , 0.2324     , 0.5304    /    
     
    155157      !!--------------------------------------------------------------------- 
    156158      INTEGER  ::   ji, jj, jk 
    157       REAL(wp) ::   ztkel, zsal , zqtt  , zbuf1 , zbuf2 
     159      REAL(wp) ::   ztkel, zt   , zt2   , zsal  , zsal2 , zbuf1 , zbuf2 
     160      REAL(wp) ::   ztgg , ztgg2, ztgg3 , ztgg4 , ztgg5 
    158161      REAL(wp) ::   zpres, ztc  , zcl   , zcpexp, zoxy  , zcpexp2 
    159162      REAL(wp) ::   zsqrt, ztr  , zlogt , zcek1 
    160       REAL(wp) ::   zlqtt, zqtt2, zsal15, zis   , zis2 , zisqrt 
     163      REAL(wp) ::   zis  , zis2 , zsal15, zisqrt 
    161164      REAL(wp) ::   zckb , zck1 , zck2  , zckw  , zak1 , zak2  , zakb , zaksp0, zakw 
    162165      REAL(wp) ::   zst  , zft  , zcks  , zckf  , zaksp1 
    163166      !!--------------------------------------------------------------------- 
    164  
     167      ! 
     168      IF( nn_timing == 1 )  CALL timing_start('p4z_che') 
     169      ! 
    165170      ! CHEMICAL CONSTANTS - SURFACE LAYER 
    166171      ! ---------------------------------- 
     
    171176            !                             ! SET ABSOLUTE TEMPERATURE 
    172177            ztkel = tsn(ji,jj,1,jp_tem) + 273.16 
    173             zqtt  = ztkel * 0.01 
    174             zqtt2 = zqtt * zqtt 
    175             zsal  = tsn(ji,jj,1,jp_sal) + (1.- tmask(ji,jj,1) ) * 35. 
    176             zlqtt = LOG( zqtt ) 
    177  
     178            z  = ztkel * 0.01 
     179            zt2   = zt * zt 
     180            zsal  = tsn(ji,jj,1,jp_sal) + ( 1.- tmask(ji,jj,1) ) * 35. 
     181            zsal2 = zsal * zsal 
     182            zlogt = LOG( zt ) 
    178183            !                             ! LN(K0) OF SOLUBILITY OF CO2 (EQ. 12, WEISS, 1980) 
    179184            !                             !     AND FOR THE ATMOSPHERE FOR NON IDEAL GAS 
    180             zcek1 = ca0 + ca1 / zqtt + ca2 * zlqtt + ca3 * zqtt2 + zsal*( ca4 + ca5 * zqtt + ca6 * zqtt2 ) 
    181  
    182             !                             ! LN(K0) OF SOLUBILITY OF O2 and N2 (EQ. 4, WEISS, 1970) 
    183             zoxy  = ox0 + ox1 / zqtt + ox2 * zlqtt + zsal * ( ox3 + ox4 * zqtt + ox5 * zqtt2 ) 
    184  
    185             !                             ! SET SOLUBILITIES OF O2 AND CO2 
    186             chemc(ji,jj,1) = EXP( zcek1 ) * 1.e-6 * rhop(ji,jj,1) / 1000. 
    187             chemc(ji,jj,2) = EXP( zoxy  ) * oxyco 
    188  
     185            zcek1 = ca0 + ca1 / zt + ca2 * zlogt + ca3 * zt2 + zsal * ( ca4 + ca5 * zt + ca6 * zt2 ) 
     186            !                             ! LN(K0) OF SOLUBILITY OF O2 and N2 in ml/L (EQ. 8, GARCIA AND GORDON, 1992) 
     187            ztgg  = LOG( ( 298.15 - tsn(ji,jj,1,jp_tem) ) / ztkel )  ! Set the GORDON & GARCIA scaled temperature 
     188            ztgg2 = ztgg  * ztgg 
     189            ztgg3 = ztgg2 * ztgg 
     190            ztgg4 = ztgg3 * ztgg 
     191            ztgg5 = ztgg4 * ztgg 
     192            zoxy  = ox0 + ox1 * ztgg + ox2 * ztgg2 + ox3 * ztgg3 + ox4 * ztgg4 + ox5 * ztgg5   & 
     193                   + zsal * ( ox6 + ox7 * ztgg + ox8 * ztgg2 + ox9 * ztgg3 ) +  ox10 * zsal2 
     194 
     195            !                             ! SET SOLUBILITIES OF O2 AND CO2  
     196            chemc(ji,jj,1) = EXP( zcek1 ) * 1.e-6 * rhop(ji,jj,1) / 1000.  ! mol/(L uatm) 
     197            chemc(ji,jj,2) = ( EXP( zoxy  ) * o2atm ) * oxyco              ! mol/(L atm) 
     198            ! 
    189199         END DO 
    190200      END DO 
     
    204214               ! SET ABSOLUTE TEMPERATURE 
    205215               ztkel   = tsn(ji,jj,jk,jp_tem) + 273.16 
    206                zqtt    = ztkel * 0.01 
    207216               zsal    = tsn(ji,jj,jk,jp_sal) + ( 1.-tmask(ji,jj,jk) ) * 35. 
    208217               zsqrt  = SQRT( zsal ) 
     
    311320      END DO 
    312321      ! 
     322      IF( nn_timing == 1 )  CALL timing_stop('p4z_che') 
     323      ! 
    313324   END SUBROUTINE p4z_che 
    314325 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zflx.F90

    r2715 r3294  
    99   !!             1.0  !  2004     (O. Aumont) modifications 
    1010   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
     11   !!                  !  2011-02  (J. Simeon, J. Orr) Include total atm P correction  
    1112   !!---------------------------------------------------------------------- 
    1213#if defined key_pisces 
     
    1617   !!   p4z_flx       :   CALCULATES GAS EXCHANGE AND CHEMISTRY AT SEA SURFACE 
    1718   !!   p4z_flx_init  :   Read the namelist 
    18    !!---------------------------------------------------------------------- 
    19    USE trc 
    20    USE oce_trc         ! 
    21    USE trc 
    22    USE sms_pisces 
    23    USE prtctl_trc 
    24    USE p4zche 
    25    USE iom 
     19   !!   p4z_patm      :   Read sfc atm pressure [atm] for each grid cell 
     20   !!---------------------------------------------------------------------- 
     21   USE oce_trc                      !  shared variables between ocean and passive tracers  
     22   USE trc                          !  passive tracers common variables 
     23   USE sms_pisces                   !  PISCES Source Minus Sink variables 
     24   USE p4zche                       !  Chemical model 
     25   USE prtctl_trc                   !  print control for debugging 
     26   USE iom                          !  I/O manager 
     27   USE fldread                      !  read input fields 
    2628#if defined key_cpl_carbon_cycle 
    27    USE sbc_oce , ONLY :  atm_co2 
     29   USE sbc_oce, ONLY :  atm_co2     !  atmospheric pCO2                
    2830#endif 
    2931 
     
    3537   PUBLIC   p4z_flx_alloc   
    3638 
     39   !                                      !!** Namelist  nampisext  ** 
     40   REAL(wp)          ::  atcco2    = 278._wp       !: pre-industrial atmospheric [co2] (ppm)     
     41   LOGICAL           ::  ln_co2int = .FALSE.       !: flag to read in a file and interpolate atmospheric pco2 or not 
     42   CHARACTER(len=34) ::  clname    = 'atcco2.txt'  !: filename of pco2 values 
     43   INTEGER           ::  nn_offset = 0             !: Offset model-data start year (default = 0)  
     44 
     45   !!  Variables related to reading atmospheric CO2 time history     
     46   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) :: atcco2h, years 
     47   INTEGER  :: nmaxrec, numco2 
     48 
     49   !                                         !!* nampisatm namelist (Atmospheric PRessure) * 
     50   LOGICAL, PUBLIC ::   ln_presatm = .true.  !: 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 
    3756   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: oce_co2   !: ocean carbon flux  
    3857   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: satmco2   !: atmospheric pco2  
     
    4160   REAL(wp) ::  t_atm_co2_flx               !: global mean of atmospheric pco2 
    4261   REAL(wp) ::  area                        !: ocean surface 
    43    REAL(wp) ::  atcco2 = 278._wp            !: pre-industrial atmospheric [co2] (ppm)   
    44    REAL(wp) ::  atcox  = 0.20946_wp         !: 
    4562   REAL(wp) ::  xconv  = 0.01_wp / 3600._wp !: coefficients for conversion  
    4663 
     
    6077      !! ** Purpose :   CALCULATES GAS EXCHANGE AND CHEMISTRY AT SEA SURFACE 
    6178      !! 
    62       !! ** Method  : - ??? 
     79      !! ** Method  :  
     80      !!              - Include total atm P correction via Esbensen & Kushnir (1981)  
     81      !!              - Pressure correction NOT done for key_cpl_carbon_cycle 
     82      !!              - Remove Wanninkhof chemical enhancement; 
     83      !!              - Add option for time-interpolation of atcco2.txt   
    6384      !!--------------------------------------------------------------------- 
    64       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    65       USE wrk_nemo, ONLY:   zkgco2 => wrk_2d_1 , zkgo2 => wrk_2d_2 , zh2co3 => wrk_2d_3  
    66       USE wrk_nemo, ONLY:   zoflx  => wrk_2d_4 , zkg   => wrk_2d_5 
    67       USE wrk_nemo, ONLY:   zdpco2 => wrk_2d_6 , zdpo2 => wrk_2d_7 
    6885      ! 
    6986      INTEGER, INTENT(in) ::   kt   ! 
    7087      ! 
    71       INTEGER  ::   ji, jj, jrorr 
     88      INTEGER  ::   ji, jj, jm, iind, iindm1 
    7289      REAL(wp) ::   ztc, ztc2, ztc3, zws, zkgwan 
    7390      REAL(wp) ::   zfld, zflu, zfld16, zflu16, zfact 
    7491      REAL(wp) ::   zph, zah2, zbot, zdic, zalk, zsch_o2, zalka, zsch_co2 
     92      REAL(wp) ::   zyr_dec, zdco2dt 
    7593      CHARACTER (len=25) :: charout 
     94      REAL(wp), POINTER, DIMENSION(:,:) :: zkgco2, zkgo2, zh2co3, zoflx  
    7695      !!--------------------------------------------------------------------- 
    77  
    78       IF( wrk_in_use(2, 1,2,3,4,5,6,7) ) THEN 
    79          CALL ctl_stop('p4z_flx: requested workspace arrays unavailable')   ;   RETURN 
    80       ENDIF 
     96      ! 
     97      IF( nn_timing == 1 )  CALL timing_start('p4z_flx') 
     98      ! 
     99      CALL wrk_alloc( jpi, jpj, zkgco2, zkgo2, zh2co3, zoflx ) 
     100      ! 
    81101 
    82102      ! SURFACE CHEMISTRY (PCO2 AND [H+] IN 
     
    84104      !     IS USED TO COMPUTE AIR-SEA FLUX OF CO2 
    85105 
     106      IF( kt /= nit000 ) CALL p4z_patm( kt )    ! Get sea-level pressure (E&K [1981] climatology) for use in flux calcs 
     107 
     108      IF( ln_co2int ) THEN  
     109         ! Linear temporal interpolation  of atmospheric pco2.  atcco2.txt has annual values. 
     110         ! Caveats: First column of .txt must be in years, decimal  years preferably.  
     111         ! For nn_offset, if your model year is iyy, nn_offset=(years(1)-iyy)  
     112         ! then the first atmospheric CO2 record read is at years(1) 
     113         zyr_dec = REAL( nyear + nn_offset, wp ) + REAL( nday_year, wp ) / REAL( nyear_len(1), wp ) 
     114         jm = 2 
     115         DO WHILE( jm <= nmaxrec .AND. years(jm-1) < zyr_dec .AND. years(jm) >= zyr_dec ) ;  jm = jm + 1 ;  END DO 
     116         iind = jm  ;   iindm1 = jm - 1 
     117         zdco2dt = ( atcco2h(iind) - atcco2h(iindm1) ) / ( years(iind) - years(iindm1) + rtrn ) 
     118         atcco2  = zdco2dt * ( zyr_dec - years(iindm1) ) + atcco2h(iindm1) 
     119         satmco2(:,:) = atcco2  
     120      ENDIF 
     121 
    86122#if defined key_cpl_carbon_cycle 
    87123      satmco2(:,:) = atm_co2(:,:) 
    88124#endif 
    89125 
    90       DO jrorr = 1, 10 
    91  
     126      DO jm = 1, 10 
    92127!CDIR NOVERRCHK 
    93128         DO jj = 1, jpj 
     
    137172            ! Compute the piston velocity for O2 and CO2 
    138173            zkgwan = 0.3 * zws  + 2.5 * ( 0.5246 + 0.016256 * ztc + 0.00049946  * ztc2 ) 
     174            zkgwan = zkgwan * xconv * ( 1.- fr_i(ji,jj) ) * tmask(ji,jj,1) 
    139175# if defined key_degrad 
    140             zkgwan = zkgwan * xconv * ( 1.- fr_i(ji,jj) ) * tmask(ji,jj,1) * facvol(ji,jj,1) 
    141 #else 
    142             zkgwan = zkgwan * xconv * ( 1.- fr_i(ji,jj) ) * tmask(ji,jj,1) 
     176            zkgwan = zkgwan * facvol(ji,jj,1) 
    143177#endif  
    144178            ! compute gas exchange for CO2 and O2 
     
    151185         DO ji = 1, jpi 
    152186            ! Compute CO2 flux for the sea and air 
    153             zfld = satmco2(ji,jj) * tmask(ji,jj,1) * chemc(ji,jj,1) * zkgco2(ji,jj) 
    154             zflu = zh2co3(ji,jj) * tmask(ji,jj,1) * zkgco2(ji,jj) 
     187            zfld = satmco2(ji,jj) * patm(ji,jj) * tmask(ji,jj,1) * chemc(ji,jj,1) * zkgco2(ji,jj)   ! (mol/L) * (m/s) 
     188            zflu = zh2co3(ji,jj) * tmask(ji,jj,1) * zkgco2(ji,jj)                                   ! (mol/L) (m/s) ? 
    155189            oce_co2(ji,jj) = ( zfld - zflu ) * rfact * e1e2t(ji,jj) * tmask(ji,jj,1) * 1000. 
    156190            ! compute the trend 
     
    158192 
    159193            ! Compute O2 flux  
    160             zfld16 = atcox * chemc(ji,jj,2) * tmask(ji,jj,1) * zkgo2(ji,jj) 
     194            zfld16 = atcox * patm(ji,jj) * chemc(ji,jj,2) * tmask(ji,jj,1) * zkgo2(ji,jj)          ! (mol/L) * (m/s) 
    161195            zflu16 = trn(ji,jj,1,jpoxy) * tmask(ji,jj,1) * zkgo2(ji,jj) 
    162             tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + ( zfld16 - zflu16 ) / fse3t(ji,jj,1) 
    163  
    164 #if defined key_diatrc  
    165             ! Save diagnostics 
    166 #  if ! defined key_iomput 
    167             zfact = 1. / e1e2t(ji,jj) / rfact 
    168             trc2d(ji,jj,jp_pcs0_2d    ) = oce_co2(ji,jj) * zfact 
    169             trc2d(ji,jj,jp_pcs0_2d + 1) = ( zfld16 - zflu16 ) * 1000. * tmask(ji,jj,1) 
    170             trc2d(ji,jj,jp_pcs0_2d + 2) = zkgco2(ji,jj) * tmask(ji,jj,1) 
    171             trc2d(ji,jj,jp_pcs0_2d + 3) = ( satmco2(ji,jj) - zh2co3(ji,jj) / ( chemc(ji,jj,1) + rtrn ) ) & 
    172                &                            * tmask(ji,jj,1) 
    173 #  else 
    174             zoflx(ji,jj) = ( zfld16 - zflu16 ) * 1000. * tmask(ji,jj,1) 
    175             zkg  (ji,jj) = zkgco2(ji,jj) * tmask(ji,jj,1) 
    176             zdpco2(ji,jj) = ( satmco2(ji,jj) - zh2co3(ji,jj) / ( chemc(ji,jj,1) + rtrn ) ) * tmask(ji,jj,1) 
    177             zdpo2 (ji,jj) = ( atcox  - trn(ji,jj,1,jpoxy) / ( chemc(ji,jj,2) + rtrn ) ) * tmask(ji,jj,1) 
    178 #  endif 
    179 #endif 
     196            zoflx(ji,jj) = zfld16 - zflu16 
     197            tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + zoflx(ji,jj) / fse3t(ji,jj,1) 
    180198         END DO 
    181199      END DO 
    182200 
    183       t_oce_co2_flx = t_oce_co2_flx + glob_sum( oce_co2(:,:) )                     ! Cumulative Total Flux of Carbon 
     201      t_oce_co2_flx = t_oce_co2_flx + glob_sum( oce_co2(:,:) )            ! Cumulative Total Flux of Carbon 
    184202      IF( kt == nitend ) THEN 
    185          t_atm_co2_flx = glob_sum( satmco2(:,:) * e1e2t(:,:) )            ! Total atmospheric pCO2 
    186          ! 
    187          t_oce_co2_flx = (-1.) * t_oce_co2_flx  * 12. / 1.e15                      ! Conversion in PgC ; negative for out of the ocean 
    188          t_atm_co2_flx = t_atm_co2_flx  / area                                     ! global mean of atmospheric pCO2 
     203         t_atm_co2_flx = glob_sum( satmco2(:,:) * patm(:,:) * e1e2t(:,:) )            ! Total atmospheric pCO2 
     204         ! 
     205         t_oce_co2_flx = (-1.) * t_oce_co2_flx  * 12. / 1.e15             ! Conversion in PgC ; negative for out of the ocean 
     206         t_atm_co2_flx = t_atm_co2_flx  / area                            ! global mean of atmospheric pCO2 
    189207         ! 
    190208         IF( lwp) THEN 
     
    205223      ENDIF 
    206224 
    207 # if defined key_diatrc && defined key_iomput 
    208       CALL iom_put( "Cflx" , oce_co2(:,:) / e1e2t(:,:) / rfact )  
    209       CALL iom_put( "Oflx" , zoflx  ) 
    210       CALL iom_put( "Kg"   , zkg    ) 
    211       CALL iom_put( "Dpco2", zdpco2 ) 
    212       CALL iom_put( "Dpo2" , zdpo2  ) 
    213 #endif 
    214       ! 
    215       IF( wrk_not_released(2, 1,2,3,4,5,6,7) )   CALL ctl_stop('p4z_flx: failed to release workspace arrays') 
     225      IF( ln_diatrc ) THEN 
     226         IF( lk_iomput ) THEN 
     227            CALL iom_put( "Cflx" , oce_co2(:,:) / e1e2t(:,:) / rfact )  
     228            CALL iom_put( "Oflx" , zoflx(:,:) * 1000 * tmask(:,:,1)  ) 
     229            CALL iom_put( "Kg"   , zkgco2(:,:) * tmask(:,:,1) ) 
     230            CALL iom_put( "Dpco2", ( satmco2(:,:) * patm(:,:) - zh2co3(:,:) / ( chemc(:,:,1) + rtrn ) ) * tmask(:,:,1) ) 
     231            CALL iom_put( "Dpo2" , ( atcox * patm(:,:) - trn(:,:,1,jpoxy) / ( chemc(:,:,2) + rtrn ) ) * tmask(:,:,1) ) 
     232         ELSE 
     233            trc2d(:,:,jp_pcs0_2d    ) = oce_co2(:,:) / e1e2t(:,:) / rfact  
     234            trc2d(:,:,jp_pcs0_2d + 1) = zoflx(:,:) * 1000 * tmask(:,:,1)  
     235            trc2d(:,:,jp_pcs0_2d + 2) = zkgco2(:,:) * tmask(:,:,1)  
     236            trc2d(:,:,jp_pcs0_2d + 3) = ( satmco2(:,:) * patm(:,:) - zh2co3(:,:) / ( chemc(:,:,1) + rtrn ) ) * tmask(:,:,1)  
     237         ENDIF 
     238      ENDIF 
     239      ! 
     240      CALL wrk_dealloc( jpi, jpj, zkgco2, zkgo2, zh2co3, zoflx ) 
     241      ! 
     242      IF( nn_timing == 1 )  CALL timing_stop('p4z_flx') 
    216243      ! 
    217244   END SUBROUTINE p4z_flx 
     
    225252      !! 
    226253      !! ** Method  :   Read the nampisext namelist and check the parameters 
    227       !!      called at the first timestep (nit000) 
     254      !!      called at the first timestep (nittrc000) 
    228255      !! ** input   :   Namelist nampisext 
    229256      !!---------------------------------------------------------------------- 
    230       NAMELIST/nampisext/ atcco2 
    231       !!---------------------------------------------------------------------- 
    232       ! 
    233       REWIND( numnat )                     ! read numnat 
    234       READ  ( numnat, nampisext ) 
     257      NAMELIST/nampisext/ln_co2int, atcco2, clname, nn_offset 
     258      INTEGER :: jm 
     259      !!---------------------------------------------------------------------- 
     260      ! 
     261      REWIND( numnatp )                     ! read numnatp 
     262      READ  ( numnatp, nampisext ) 
    235263      ! 
    236264      IF(lwp) THEN                         ! control print 
     
    238266         WRITE(numout,*) ' Namelist parameters for air-sea exchange, nampisext' 
    239267         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    240          WRITE(numout,*) '    Atmospheric pCO2      atcco2      =', atcco2 
     268         WRITE(numout,*) '    Choice for reading in the atm pCO2 file or constant value, ln_co2int =', ln_co2int 
     269         WRITE(numout,*) ' ' 
     270      ENDIF 
     271      IF( .NOT.ln_co2int ) THEN 
     272         IF(lwp) THEN                         ! control print 
     273            WRITE(numout,*) '    Constant Atmospheric pCO2 value  atcco2    =', atcco2 
     274            WRITE(numout,*) ' ' 
     275         ENDIF 
     276         satmco2(:,:)  = atcco2      ! Initialisation of atmospheric pco2 
     277      ELSE 
     278         IF(lwp)  THEN 
     279            WRITE(numout,*) '    Atmospheric pCO2 value  from file clname      =', TRIM( clname ) 
     280            WRITE(numout,*) '    Offset model-data start year      nn_offset   =', nn_offset 
     281            WRITE(numout,*) ' ' 
     282         ENDIF 
     283         CALL ctl_opn( numco2, TRIM( clname) , 'OLD', 'FORMATTED', 'SEQUENTIAL', -1 , numout, lwp ) 
     284         jm = 0                      ! Count the number of record in co2 file 
     285         DO 
     286           READ(numco2,*,END=100)  
     287           jm = jm + 1 
     288         END DO 
     289 100     nmaxrec = jm - 1  
     290         ALLOCATE( years  (nmaxrec) )     ;      years  (:) = 0._wp 
     291         ALLOCATE( atcco2h(nmaxrec) )     ;      atcco2h(:) = 0._wp 
     292 
     293         REWIND(numco2) 
     294         DO jm = 1, nmaxrec          ! get  xCO2 data 
     295            READ(numco2, *)  years(jm), atcco2h(jm) 
     296            IF(lwp) WRITE(numout, '(f6.0,f7.2)')  years(jm), atcco2h(jm) 
     297         END DO 
     298         CLOSE(numco2) 
    241299      ENDIF 
    242300      ! 
     
    245303      oce_co2(:,:)  = 0._wp                ! Initialization of Flux of Carbon 
    246304      t_atm_co2_flx = 0._wp 
    247       ! 
    248       satmco2(:,:)  = atcco2      ! Initialisation of atmospheric pco2 
    249305      t_oce_co2_flx = 0._wp 
    250306      ! 
     307      CALL p4z_patm( nit000 ) 
     308      ! 
    251309   END SUBROUTINE p4z_flx_init 
    252310 
     311   SUBROUTINE p4z_patm( kt ) 
     312 
     313      !!---------------------------------------------------------------------- 
     314      !!                  ***  ROUTINE p4z_atm  *** 
     315      !! 
     316      !! ** Purpose :   Read and interpolate the external atmospheric sea-levl pressure 
     317      !! ** Method  :   Read the files and interpolate the appropriate variables 
     318      !! 
     319      !!---------------------------------------------------------------------- 
     320      !! * arguments 
     321      INTEGER, INTENT( in  ) ::   kt   ! ocean time step 
     322      ! 
     323      INTEGER            ::  ierr 
     324      CHARACTER(len=100) ::  cn_dir   ! Root directory for location of ssr files 
     325      TYPE(FLD_N)        ::  sn_patm  ! informations about the fields to be read 
     326      !! 
     327      NAMELIST/nampisatm/ ln_presatm, sn_patm, cn_dir 
     328 
     329      !                                         ! -------------------- ! 
     330      IF( kt == nit000 ) THEN                   ! First call kt=nittrc000 ! 
     331         !                                      ! -------------------- ! 
     332         !                                            !* set file information (default values) 
     333         ! ... default values (NB: frequency positive => hours, negative => months) 
     334         !            !   file   ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation ! 
     335         !            !   name   !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs    ! 
     336         sn_patm = FLD_N( 'pres'  ,    24     ,  'patm'    ,  .false.   , .true.  ,   'yearly'  , ''       , ''       ) 
     337         cn_dir  = './'          ! directory in which the Patm data are  
     338 
     339         REWIND( numnatp )                             !* read in namlist nampisatm 
     340         READ  ( numnatp, nampisatm )  
     341         ! 
     342         ! 
     343         IF(lwp) THEN                                 !* control print 
     344            WRITE(numout,*) 
     345            WRITE(numout,*) '   Namelist nampisatm : Atmospheric Pressure as external forcing' 
     346            WRITE(numout,*) '      constant atmopsheric pressure (F) or from a file (T)  ln_presatm = ', ln_presatm 
     347            WRITE(numout,*) 
     348         ENDIF 
     349         ! 
     350         IF( ln_presatm ) THEN 
     351            ALLOCATE( sf_patm(1), STAT=ierr )           !* allocate and fill sf_patm (forcing structure) with sn_patm 
     352            IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'p4z_flx: unable to allocate sf_patm structure' ) 
     353            ! 
     354            CALL fld_fill( sf_patm, (/ sn_patm /), cn_dir, 'p4z_flx', 'Atmospheric pressure ', 'nampisatm' ) 
     355                                   ALLOCATE( sf_patm(1)%fnow(jpi,jpj,1)   ) 
     356            IF( sn_patm%ln_tint )  ALLOCATE( sf_patm(1)%fdta(jpi,jpj,1,2) ) 
     357         ENDIF 
     358         !                                          
     359         IF( .NOT.ln_presatm )   patm(:,:) = 1.e0    ! Initialize patm if no reading from a file 
     360         ! 
     361      ENDIF 
     362      ! 
     363      IF( ln_presatm ) THEN 
     364         CALL fld_read( kt, 1, sf_patm )               !* input Patm provided at kt + 1/2 
     365         patm(:,:) = sf_patm(1)%fnow(:,:,1)                        ! atmospheric pressure 
     366      ENDIF 
     367      ! 
     368   END SUBROUTINE p4z_patm 
    253369 
    254370   INTEGER FUNCTION p4z_flx_alloc() 
     
    256372      !!                     ***  ROUTINE p4z_flx_alloc  *** 
    257373      !!---------------------------------------------------------------------- 
    258       ALLOCATE( oce_co2(jpi,jpj), satmco2(jpi,jpj), STAT=p4z_flx_alloc ) 
     374      ALLOCATE( oce_co2(jpi,jpj), satmco2(jpi,jpj), patm(jpi,jpj), STAT=p4z_flx_alloc ) 
    259375      ! 
    260376      IF( p4z_flx_alloc /= 0 )   CALL ctl_warn('p4z_flx_alloc : failed to allocate arrays') 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zint.F90

    r2715 r3294  
    1313   !!   p4z_int        :  interpolation and computation of various accessory fields 
    1414   !!---------------------------------------------------------------------- 
    15    USE oce_trc         ! 
    16    USE trc 
    17    USE sms_pisces 
     15   USE oce_trc         !  shared variables between ocean and passive tracers 
     16   USE trc             !  passive tracers common variables  
     17   USE sms_pisces      !  PISCES Source Minus Sink variables 
    1818 
    1919   IMPLICIT NONE 
     
    2121 
    2222   PUBLIC   p4z_int   
    23    PUBLIC   p4z_int_alloc 
    24  
    25    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tgfunc    !: Temp. dependancy of various biological rates 
    26    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tgfunc2   !: Temp. dependancy of mesozooplankton rates 
    27  
    2823   REAL(wp) ::   xksilim = 16.5e-6_wp   ! Half-saturation constant for the Si half-saturation constant computation 
    2924 
     
    4136      !! ** Purpose :   interpolation and computation of various accessory fields 
    4237      !! 
    43       !! ** Method  : - ??? 
    4438      !!--------------------------------------------------------------------- 
    45       INTEGER  ::   ji, jj 
    46       REAL(wp) ::   zdum 
     39      INTEGER  ::   ji, jj                 ! dummy loop indices 
     40      REAL(wp) ::   zvar                   ! local variable 
    4741      !!--------------------------------------------------------------------- 
    48  
     42      ! 
     43      IF( nn_timing == 1 )  CALL timing_start('p4z_int') 
     44      ! 
    4945      ! Computation of phyto and zoo metabolic rate 
    5046      ! ------------------------------------------- 
     
    5753      DO ji = 1, jpi 
    5854         DO jj = 1, jpj 
    59             zdum = trn(ji,jj,1,jpsil) * trn(ji,jj,1,jpsil) 
    60             xksimax(ji,jj) = MAX( xksimax(ji,jj), ( 1.+ 7.* zdum / ( xksilim * xksilim + zdum ) ) * 1e-6 ) 
     55            zvar = trn(ji,jj,1,jpsil) * trn(ji,jj,1,jpsil) 
     56            xksimax(ji,jj) = MAX( xksimax(ji,jj), ( 1.+ 7.* zvar / ( xksilim * xksilim + zvar ) ) * 1e-6 ) 
    6157         END DO 
    6258      END DO 
     
    6763      ENDIF 
    6864      ! 
     65      IF( nn_timing == 1 )  CALL timing_stop('p4z_int') 
     66      ! 
    6967   END SUBROUTINE p4z_int 
    70  
    71  
    72    INTEGER FUNCTION p4z_int_alloc() 
    73       !!---------------------------------------------------------------------- 
    74       !!                     ***  ROUTINE p4z_int_alloc  *** 
    75       !!---------------------------------------------------------------------- 
    76       ALLOCATE( tgfunc(jpi,jpj,jpk), tgfunc2(jpi,jpj,jpk), STAT=p4z_int_alloc ) 
    77       ! 
    78       IF( p4z_int_alloc /= 0 )   CALL ctl_warn('p4z_int_alloc : failed to allocate arrays.') 
    79       ! 
    80    END FUNCTION p4z_int_alloc 
    8168 
    8269#else 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zlim.F90

    r2528 r3294  
    66   !! History :   1.0  !  2004     (O. Aumont) Original code 
    77   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
     8   !!             3.4  !  2011-04  (O. Aumont, C. Ethe) Limitation for iron modelled in quota  
    89   !!---------------------------------------------------------------------- 
    910#if defined key_pisces 
     
    1415   !!   p4z_lim_init   :   Read the namelist  
    1516   !!---------------------------------------------------------------------- 
    16    USE trc 
    17    USE oce_trc         ! 
    18    USE trc         !  
    19    USE sms_pisces      !  
     17   USE oce_trc         ! Shared ocean-passive tracers variables 
     18   USE trc             ! Tracers defined 
     19   USE sms_pisces      ! PISCES variables 
     20   USE p4zopt          ! Optical 
    2021 
    2122   IMPLICIT NONE 
     
    2627 
    2728   !! * Shared module variables 
    28    REAL(wp), PUBLIC ::   & 
    29      conc0     = 2.e-6_wp      ,  &  !: 
    30      conc1     = 10.e-6_wp     ,  &  !: 
    31      conc2     = 2.e-11_wp     ,  &  !: 
    32      conc2m    = 8.E-11_wp     ,  &  !: 
    33      conc3     = 1.e-10_wp     ,  &  !: 
    34      conc3m    = 4.e-10_wp     ,  &  !: 
    35      concnnh4  = 1.e-7_wp      ,  &  !: 
    36      concdnh4  = 5.e-7_wp      ,  &  !: 
    37      xksi1     = 2.E-6_wp      ,  &  !: 
    38      xksi2     = 3.33E-6_wp    ,  &  !: 
    39      xkdoc     = 417.E-6_wp    ,  &  !: 
    40      caco3r    = 0.3_wp              !: 
    41  
    42  
     29   REAL(wp), PUBLIC ::  conc0     = 2.e-6_wp      !:  NO3, PO4 half saturation    
     30   REAL(wp), PUBLIC ::  conc1     = 8.e-6_wp      !:  Phosphate half saturation for diatoms   
     31   REAL(wp), PUBLIC ::  conc2     = 1.e-9_wp      !:  Iron half saturation for nanophyto  
     32   REAL(wp), PUBLIC ::  conc2m    = 3.e-9_wp      !:  Max iron half saturation for nanophyto  
     33   REAL(wp), PUBLIC ::  conc3     = 2.e-9_wp      !:  Iron half saturation for diatoms   
     34   REAL(wp), PUBLIC ::  conc3m    = 8.e-9_wp      !:  Max iron half saturation for diatoms  
     35   REAL(wp), PUBLIC ::  xsizedia  = 5.e-7_wp      !:  Minimum size criteria for diatoms 
     36   REAL(wp), PUBLIC ::  xsizephy  = 1.e-6_wp      !:  Minimum size criteria for nanophyto 
     37   REAL(wp), PUBLIC ::  concnnh4  = 1.e-7_wp      !:  NH4 half saturation for phyto   
     38   REAL(wp), PUBLIC ::  concdnh4  = 4.e-7_wp      !:  NH4 half saturation for diatoms 
     39   REAL(wp), PUBLIC ::  xksi1     = 2.E-6_wp      !:  half saturation constant for Si uptake  
     40   REAL(wp), PUBLIC ::  xksi2     = 3.33e-6_wp    !:  half saturation constant for Si/C  
     41   REAL(wp), PUBLIC ::  xkdoc     = 417.e-6_wp    !:  2nd half-sat. of DOC remineralization   
     42   REAL(wp), PUBLIC ::  concfebac = 1.E-11_wp     !:  Fe half saturation for bacteria  
     43   REAL(wp), PUBLIC ::  qnfelim   = 7.E-6_wp      !:  optimal Fe quota for nanophyto 
     44   REAL(wp), PUBLIC ::  qdfelim   = 7.E-6_wp      !:  optimal Fe quota for diatoms 
     45   REAL(wp), PUBLIC ::  caco3r    = 0.16_wp       !:  mean rainratio  
     46 
     47   ! Coefficient for iron limitation 
     48   REAL(wp) ::  xcoef1   = 0.0016  / 55.85   
     49   REAL(wp) ::  xcoef2   = 1.21E-5 * 14. / 55.85 / 7.625 * 0.5 * 1.5 
     50   REAL(wp) ::  xcoef3   = 1.15E-4 * 14. / 55.85 / 7.625 * 0.5  
    4351   !!* Substitution 
    4452#  include "top_substitute.h90" 
     
    6068      !! ** Method  : - ??? 
    6169      !!--------------------------------------------------------------------- 
     70      ! 
    6271      INTEGER, INTENT(in)  :: kt 
     72      ! 
    6373      INTEGER  ::   ji, jj, jk 
    6474      REAL(wp) ::   zlim1, zlim2, zlim3, zlim4, zno3, zferlim 
    65       REAL(wp) ::   zconctemp, zconctemp2, zconctempn, zconctempn2 
    66       REAL(wp) ::   ztemp, zdenom 
     75      REAL(wp) ::   zconcd, zconcd2, zconcn, zconcn2 
     76      REAL(wp) ::   z1_trndia, z1_trnphy, ztem1, ztem2, zetot1, zetot2 
     77      REAL(wp) ::   zdenom, zratio, zironmin 
     78      REAL(wp) ::   zconc1d, zconc1dnh4, zconc0n, zconc0nnh4    
    6779      !!--------------------------------------------------------------------- 
    68  
    69  
    70       !  Tuning of the iron concentration to a minimum 
    71       !  level that is set to the detection limit 
    72       !  ------------------------------------- 
    73  
     80      ! 
     81      IF( nn_timing == 1 )  CALL timing_start('p4z_lim') 
     82      ! 
    7483      DO jk = 1, jpkm1 
    7584         DO jj = 1, jpj 
    7685            DO ji = 1, jpi 
    77                zno3=trn(ji,jj,jk,jpno3) 
    78                zferlim = MAX( 1.5e-11*(zno3/40E-6)**2, 3e-12 ) 
    79                zferlim = MIN( zferlim, 1.5e-11 ) 
     86                
     87               ! Tuning of the iron concentration to a minimum level that is set to the detection limit 
     88               !------------------------------------- 
     89               zno3    = trn(ji,jj,jk,jpno3) / 40.e-6 
     90               zferlim = MAX( 2e-11 * zno3 * zno3, 5e-12 ) 
     91               zferlim = MIN( zferlim, 3e-11 ) 
    8092               trn(ji,jj,jk,jpfer) = MAX( trn(ji,jj,jk,jpfer), zferlim ) 
     93 
     94               ! Computation of a variable Ks for iron on diatoms taking into account 
     95               ! that increasing biomass is made of generally bigger cells 
     96               !------------------------------------------------ 
     97               zconcd   = MAX( 0.e0 , trn(ji,jj,jk,jpdia) - xsizedia ) 
     98               zconcd2  = trn(ji,jj,jk,jpdia) - zconcd 
     99               zconcn   = MAX( 0.e0 , trn(ji,jj,jk,jpphy) - xsizephy ) 
     100               zconcn2  = trn(ji,jj,jk,jpphy) - zconcn 
     101               z1_trnphy   = 1. / ( trn(ji,jj,jk,jpphy) + rtrn ) 
     102               z1_trndia   = 1. / ( trn(ji,jj,jk,jpdia) + rtrn ) 
     103 
     104               concdfe(ji,jj,jk) = MAX( conc3       , ( zconcd2 *      conc3    + conc3m        * zconcd ) * z1_trndia ) 
     105               zconc1d           = MAX( 2.* conc0   , ( zconcd2 * 2. * conc0    + conc1         * zconcd ) * z1_trndia ) 
     106               zconc1dnh4        = MAX( 2.* concnnh4, ( zconcd2 * 2. * concnnh4 + concdnh4      * zconcd ) * z1_trndia ) 
     107 
     108               concnfe(ji,jj,jk) = MAX( conc2       , ( zconcn2 * conc2         + conc2m        * zconcn ) * z1_trnphy ) 
     109               zconc0n           = MAX( conc0       , ( zconcn2 * conc0         + 2. * conc0    * zconcn ) * z1_trnphy ) 
     110               zconc0nnh4        = MAX( concnnh4    , ( zconcn2 * concnnh4      + 2. * concnnh4 * zconcn ) * z1_trnphy ) 
     111 
     112               ! Michaelis-Menten Limitation term for nutrients Small flagellates 
     113               ! ----------------------------------------------- 
     114               zdenom = 1. /  ( zconc0n * zconc0nnh4 + zconc0nnh4 * trn(ji,jj,jk,jpno3) + zconc0n * trn(ji,jj,jk,jpnh4) ) 
     115               xnanono3(ji,jj,jk) = trn(ji,jj,jk,jpno3) * zconc0nnh4 * zdenom 
     116               xnanonh4(ji,jj,jk) = trn(ji,jj,jk,jpnh4) * zconc0n    * zdenom 
     117               ! 
     118               zlim1    = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) 
     119               zlim2    = trn(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + zconc0nnh4 ) 
     120               zratio   = trn(ji,jj,jk,jpnfe) * z1_trnphy  
     121               zironmin = xcoef1 * trn(ji,jj,jk,jpnch) * z1_trnphy + xcoef2 * zlim1 + xcoef3 * xnanono3(ji,jj,jk) 
     122               zlim3    = MAX( 0.,( zratio - zironmin ) / qnfelim ) 
     123               xlimnfe(ji,jj,jk) = MIN( 1., zlim3 ) 
     124               xlimphy(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) 
     125               ! 
     126               zlim1    = trn(ji,jj,jk,jpnh4) / ( concnnh4 + trn(ji,jj,jk,jpnh4) ) 
     127               zlim3    = trn(ji,jj,jk,jpfer) / ( concfebac+ trn(ji,jj,jk,jpfer) ) 
     128               zlim4    = trn(ji,jj,jk,jpdoc) / ( xkdoc   + trn(ji,jj,jk,jpdoc) ) 
     129               xlimbac(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) * zlim4 
     130 
     131               !   Michaelis-Menten Limitation term for nutrients Diatoms 
     132               !   ---------------------------------------------- 
     133               zdenom   = 1. / ( zconc1d * zconc1dnh4 + zconc1dnh4 * trn(ji,jj,jk,jpno3) + zconc1d * trn(ji,jj,jk,jpnh4) ) 
     134               xdiatno3(ji,jj,jk) = trn(ji,jj,jk,jpno3) * zconc1dnh4 * zdenom 
     135               xdiatnh4(ji,jj,jk) = trn(ji,jj,jk,jpnh4) * zconc1d    * zdenom 
     136               ! 
     137               zlim1    = xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) 
     138               zlim2    = trn(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + zconc1dnh4  ) 
     139               zlim3    = trn(ji,jj,jk,jpsil) / ( trn(ji,jj,jk,jpsil) + xksi(ji,jj) ) 
     140               zratio   = trn(ji,jj,jk,jpdfe)/(trn(ji,jj,jk,jpdia)+rtrn) 
     141               zironmin = xcoef1 * trn(ji,jj,jk,jpdch) * z1_trndia + xcoef2 * zlim1 + xcoef3 * xdiatno3(ji,jj,jk) 
     142               zlim4    = MAX( 0., ( zratio - zironmin ) / qdfelim ) 
     143               xlimdfe(ji,jj,jk) = MIN( 1., zlim4 ) 
     144               xlimdia(ji,jj,jk) = MIN( zlim1, zlim2, zlim3, zlim4 ) 
     145               xlimsi(ji,jj,jk)  = MIN( zlim1, zlim2, zlim4 ) 
     146           END DO 
     147         END DO 
     148      END DO 
     149 
     150      ! Compute the fraction of nanophytoplankton that is made of calcifiers 
     151      ! -------------------------------------------------------------------- 
     152      DO jk = 1, jpkm1 
     153         DO jj = 1, jpj 
     154            DO ji = 1, jpi 
     155               zlim1 =  ( trn(ji,jj,jk,jpno3) * concnnh4 + trn(ji,jj,jk,jpnh4) * conc0 )    & 
     156                  &   / ( conc0 * concnnh4 + concnnh4 * trn(ji,jj,jk,jpno3)  + conc0 * trn(ji,jj,jk,jpnh4) )  
     157               zlim2  = trn(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + concnnh4 ) 
     158               zlim3  = trn(ji,jj,jk,jpfer) / ( trn(ji,jj,jk,jpfer) + concfebac ) 
     159               ztem1  = MAX( 0., tsn(ji,jj,jk,jp_tem) ) 
     160               ztem2  = tsn(ji,jj,jk,jp_tem) - 10. 
     161               zetot1 = MAX( 0., etot(ji,jj,jk) - 1.) / ( 4. + etot(ji,jj,jk) )  
     162               zetot2 = 1. / ( 30. + etot(ji,jj,jk) )  
     163 
     164               xfracal(ji,jj,jk) = caco3r * MIN( zlim1, zlim2, zlim3 )                  & 
     165                  &                       * ztem1 / ( 0.1 + ztem1 )                     & 
     166                  &                       * MAX( 1., trn(ji,jj,jk,jpphy) * 1.e6 / 2. )  & 
     167                  &                       * 2.325 * zetot1 * 30. * zetot2               & 
     168                  &                       * ( 1. + EXP(-ztem2 * ztem2 / 25. ) )         & 
     169                  &                       * MIN( 1., 50. / ( hmld(ji,jj) + rtrn ) ) 
     170               xfracal(ji,jj,jk) = MIN( 0.8 , xfracal(ji,jj,jk) ) 
     171               xfracal(ji,jj,jk) = MAX( 0.02, xfracal(ji,jj,jk) ) 
    81172            END DO 
    82173         END DO 
    83174      END DO 
    84  
    85       !  Computation of a variable Ks for iron on diatoms taking into account 
    86       !  that increasing biomass is made of generally bigger cells 
    87       !  ------------------------------------------------ 
    88  
    89       DO jk = 1, jpkm1 
    90          DO jj = 1, jpj 
    91             DO ji = 1, jpi 
    92                zconctemp   = MAX( 0.e0 , trn(ji,jj,jk,jpdia)-5e-7 ) 
    93                zconctemp2  = trn(ji,jj,jk,jpdia) - zconctemp 
    94                zconctempn  = MAX( 0.e0 , trn(ji,jj,jk,jpphy)-1e-6 ) 
    95                zconctempn2 = trn(ji,jj,jk,jpphy) - zconctempn 
    96                concdfe(ji,jj,jk) = ( zconctemp2 * conc3 + conc3m * zconctemp)   & 
    97                   &              / ( trn(ji,jj,jk,jpdia) + rtrn ) 
    98                concdfe(ji,jj,jk) = MAX( conc3, concdfe(ji,jj,jk) ) 
    99                concnfe(ji,jj,jk) = ( zconctempn2 * conc2 + conc2m * zconctempn)   & 
    100                   &              / ( trn(ji,jj,jk,jpphy) + rtrn ) 
    101                concnfe(ji,jj,jk) = MAX( conc2, concnfe(ji,jj,jk) ) 
    102             END DO 
    103          END DO 
    104       END DO 
    105  
    106      !  Michaelis-Menten Limitation term for nutrients Small flagellates 
    107      !      ----------------------------------------------- 
    108       DO jk = 1, jpkm1 
    109          DO jj = 1, jpj 
    110             DO ji = 1, jpi 
    111               zdenom = 1. / & 
    112                   & ( conc0 * concnnh4 + concnnh4 * trn(ji,jj,jk,jpno3) + conc0 * trn(ji,jj,jk,jpnh4) ) 
    113                xnanono3(ji,jj,jk) = trn(ji,jj,jk,jpno3) * concnnh4 * zdenom 
    114                xnanonh4(ji,jj,jk) = trn(ji,jj,jk,jpnh4) * conc0    * zdenom 
    115  
    116                zlim1 = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) 
    117                zlim2 = trn(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + concnnh4          )  
    118                zlim3 = trn(ji,jj,jk,jpfer) / ( trn(ji,jj,jk,jpfer) + concnfe(ji,jj,jk) ) 
    119                xlimphy(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) 
    120                zlim1 = trn(ji,jj,jk,jpnh4) / ( concnnh4 + trn(ji,jj,jk,jpnh4) ) 
    121                zlim3 = trn(ji,jj,jk,jpfer) / ( conc2    + trn(ji,jj,jk,jpfer) ) 
    122                zlim4 = trn(ji,jj,jk,jpdoc) / ( xkdoc   + trn(ji,jj,jk,jpdoc) ) 
    123                xlimbac(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) * zlim4 
    124  
    125             END DO 
    126          END DO 
    127       END DO 
    128  
    129       !   Michaelis-Menten Limitation term for nutrients Diatoms 
    130       !   ---------------------------------------------- 
    131       DO jk = 1, jpkm1 
    132          DO jj = 1, jpj 
    133             DO ji = 1, jpi 
    134               zdenom = 1. / & 
    135                   & ( conc1 * concdnh4 + concdnh4 * trn(ji,jj,jk,jpno3) + conc1 * trn(ji,jj,jk,jpnh4) ) 
    136  
    137                xdiatno3(ji,jj,jk) = trn(ji,jj,jk,jpno3) * concdnh4 * zdenom 
    138                xdiatnh4(ji,jj,jk) = trn(ji,jj,jk,jpnh4) * conc1    * zdenom  
    139  
    140                zlim1 = xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) 
    141                zlim2 = trn(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + concdnh4          ) 
    142                zlim3 = trn(ji,jj,jk,jpsil) / ( trn(ji,jj,jk,jpsil) + xksi   (ji,jj)    ) 
    143                zlim4 = trn(ji,jj,jk,jpfer) / ( trn(ji,jj,jk,jpfer) + concdfe(ji,jj,jk) ) 
    144                xlimdia(ji,jj,jk) = MIN( zlim1, zlim2, zlim3, zlim4 ) 
    145  
    146             END DO 
    147          END DO 
    148       END DO 
    149  
    150  
    151       ! Compute the fraction of nanophytoplankton that is made of calcifiers 
    152       ! -------------------------------------------------------------------- 
    153  
    154       DO jk = 1, jpkm1 
    155          DO jj = 1, jpj 
    156             DO ji = 1, jpi 
    157                ztemp = MAX( 0., tsn(ji,jj,jk,jp_tem) ) 
    158                xfracal(ji,jj,jk) = caco3r * xlimphy(ji,jj,jk)   & 
    159                   &                       * MAX( 0.0001, ztemp / ( 2.+ ztemp ) )   & 
    160                   &                       * MAX( 1., trn(ji,jj,jk,jpphy) * 1.e6 / 2. ) 
    161                xfracal(ji,jj,jk) = MIN( 0.8 , xfracal(ji,jj,jk) ) 
    162                xfracal(ji,jj,jk) = MAX( 0.01, xfracal(ji,jj,jk) ) 
    163             END DO 
    164          END DO 
    165       END DO 
     175      ! 
     176      IF( nn_timing == 1 )  CALL timing_stop('p4z_lim') 
    166177      ! 
    167178   END SUBROUTINE p4z_lim 
     
    175186      !! 
    176187      !! ** Method  :   Read the nampislim namelist and check the parameters 
    177       !!      called at the first timestep (nit000) 
     188      !!      called at the first timestep (nittrc000) 
    178189      !! 
    179190      !! ** input   :   Namelist nampislim 
     
    182193 
    183194      NAMELIST/nampislim/ conc0, conc1, conc2, conc2m, conc3, conc3m,   & 
    184          &             concnnh4, concdnh4, xksi1, xksi2, xkdoc, caco3r 
    185  
    186       REWIND( numnat )                     ! read numnat 
    187       READ  ( numnat, nampislim ) 
     195         &                xsizedia, xsizephy, concnnh4, concdnh4,       & 
     196         &                xksi1, xksi2, xkdoc, concfebac, qnfelim, qdfelim, caco3r 
     197 
     198      REWIND( numnatp )                     ! read numnat 
     199      READ  ( numnatp, nampislim ) 
    188200 
    189201      IF(lwp) THEN                         ! control print 
     
    191203         WRITE(numout,*) ' Namelist parameters for nutrient limitations, nampislim' 
    192204         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    193          WRITE(numout,*) '    mean rainratio                            caco3r    =', caco3r 
    194          WRITE(numout,*) '    NO3, PO4 half saturation                  conc0      =', conc0 
    195          WRITE(numout,*) '    half saturation constant for Si uptake    xksi1     =', xksi1 
    196          WRITE(numout,*) '    half saturation constant for Si/C         xksi2     =', xksi2 
    197          WRITE(numout,*) '    2nd half-sat. of DOC remineralization     xkdoc    =', xkdoc 
    198          WRITE(numout,*) '    Phosphate half saturation for diatoms     conc1     =', conc1 
    199          WRITE(numout,*) '    Iron half saturation for phyto            conc2     =', conc2 
    200          WRITE(numout,*) '    Max iron half saturation for phyto        conc2m    =', conc2m 
    201          WRITE(numout,*) '    Iron half saturation for diatoms          conc3     =', conc3 
    202          WRITE(numout,*) '    Maxi iron half saturation for diatoms     conc3m    =', conc3m 
    203          WRITE(numout,*) '    NH4 half saturation for phyto             concnnh4  =', concnnh4 
    204          WRITE(numout,*) '    NH4 half saturation for diatoms           concdnh4  =', concdnh4 
     205         WRITE(numout,*) '    mean rainratio                           caco3r    = ', caco3r 
     206         WRITE(numout,*) '    NO3, PO4 half saturation                 conc0     =  ', conc0 
     207         WRITE(numout,*) '    half saturation constant for Si uptake   xksi1     = ', xksi1 
     208         WRITE(numout,*) '    half saturation constant for Si/C        xksi2     = ', xksi2 
     209         WRITE(numout,*) '    2nd half-sat. of DOC remineralization    xkdoc     = ', xkdoc 
     210         WRITE(numout,*) '    Phosphate half saturation for diatoms    conc1     = ', conc1 
     211         WRITE(numout,*) '    Iron half saturation for phyto           conc2     = ', conc2 
     212         WRITE(numout,*) '    Max iron half saturation for phyto       conc2m    = ', conc2m 
     213         WRITE(numout,*) '    Iron half saturation for diatoms         conc3     = ', conc3 
     214         WRITE(numout,*) '    Maxi iron half saturation for diatoms    conc3m    = ', conc3m 
     215         WRITE(numout,*) '    Minimum size criteria for diatoms        xsizedia  = ', xsizedia 
     216         WRITE(numout,*) '    Minimum size criteria for nanophyto      xsizephy  = ', xsizephy 
     217         WRITE(numout,*) '    NH4 half saturation for phyto            concnnh4  = ', concnnh4 
     218         WRITE(numout,*) '    NH4 half saturation for diatoms          concdnh4  = ', concdnh4 
     219         WRITE(numout,*) '    Fe half saturation for bacteria          concfebac = ', concfebac 
     220         WRITE(numout,*) '    optimal Fe quota for nano.               qnfelim   = ', qnfelim 
     221         WRITE(numout,*) '    Optimal Fe quota for diatoms             qdfelim   = ', qdfelim 
    205222      ENDIF 
    206223 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zlys.F90

    r2715 r3294  
    99   !!             1.0  !  2004     (O. Aumont) modifications 
    1010   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
     11   !!                  !  2011-02  (J. Simeon, J. Orr)  Calcon salinity dependence 
     12   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Improvment of calcite dissolution 
    1113   !!---------------------------------------------------------------------- 
    1214#if defined key_pisces 
     
    1719   !!   p4z_lys_init   :   Read the namelist parameters 
    1820   !!---------------------------------------------------------------------- 
    19    USE trc 
    20    USE oce_trc         ! 
    21    USE trc 
    22    USE sms_pisces 
    23    USE prtctl_trc 
    24    USE iom 
     21   USE oce_trc         !  shared variables between ocean and passive tracers 
     22   USE trc             !  passive tracers common variables  
     23   USE sms_pisces      !  PISCES Source Minus Sink variables 
     24   USE prtctl_trc      !  print control for debugging 
     25   USE iom             !  I/O manager 
    2526 
    2627   IMPLICIT NONE 
     
    5758      !! ** Method  : - ??? 
    5859      !!--------------------------------------------------------------------- 
    59       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    60       USE wrk_nemo, ONLY: zco3 => wrk_3d_2, zcaldiss => wrk_3d_3  
    6160      ! 
    6261      INTEGER, INTENT(in) ::   kt ! ocean time step 
    6362      INTEGER  ::   ji, jj, jk, jn 
    64       REAL(wp) ::   zbot, zalk, zdic, zph, zremco3, zah2 
    65       REAL(wp) ::   zdispot, zfact, zalka 
     63      REAL(wp) ::   zalk, zdic, zph, zah2 
     64      REAL(wp) ::   zdispot, zfact, zcalcon, zalka, zaldi 
    6665      REAL(wp) ::   zomegaca, zexcess, zexcess0 
    67 #if defined key_diatrc && defined key_iomput 
    6866      REAL(wp) ::   zrfact2 
    69 #endif 
    7067      CHARACTER (len=25) :: charout 
     68      REAL(wp), POINTER, DIMENSION(:,:,:) :: zco3, zcaldiss    
    7169      !!--------------------------------------------------------------------- 
    72  
    73       IF(  wrk_in_use(3, 2,3) ) THEN 
    74          CALL ctl_stop('p4z_lys: requested workspace arrays unavailable')  ;  RETURN 
    75       END IF 
    76  
    77       zco3(:,:,:) = 0. 
    78 # if defined key_diatrc && defined key_iomput 
     70      ! 
     71      IF( nn_timing == 1 )  CALL timing_start('p4z_lys') 
     72      ! 
     73      CALL wrk_alloc( jpi, jpj, jpk, zco3, zcaldiss ) 
     74      ! 
     75      zco3    (:,:,:) = 0. 
    7976      zcaldiss(:,:,:) = 0. 
    80 # endif 
    8177      !     ------------------------------------------- 
    8278      !     COMPUTE [CO3--] and [H+] CONCENTRATIONS 
     
    9187!CDIR NOVERRCHK 
    9288               DO ji = 1, jpi 
    93  
    94                   ! SET DUMMY VARIABLE FOR TOTAL BORATE 
    95                   zbot  = borat(ji,jj,jk) 
    96  
    97                   ! SET DUMMY VARIABLE FOR TOTAL BORATE 
    98                   zbot  = borat(ji,jj,jk) 
    99                   zfact = rhop (ji,jj,jk) / 1000. + rtrn 
    100  
    101                   ! SET DUMMY VARIABLE FOR [H+] 
    102                   zph   = hi(ji,jj,jk) * tmask(ji,jj,jk) / zfact + ( 1.-tmask(ji,jj,jk) ) * 1.e-9 
    103  
    104                   ! SET DUMMY VARIABLE FOR [SUM(CO2)]GIVEN  
     89                  zfact = rhop(ji,jj,jk) / 1000. + rtrn 
     90                  zph  = hi(ji,jj,jk) * tmask(ji,jj,jk) / zfact + ( 1.-tmask(ji,jj,jk) ) * 1.e-9 ! [H+] 
    10591                  zdic  = trn(ji,jj,jk,jpdic) / zfact 
    10692                  zalka = trn(ji,jj,jk,jptal) / zfact 
    107  
    10893                  ! CALCULATE [ALK]([CO3--], [HCO3-]) 
    109                   zalk  = zalka - (  akw3(ji,jj,jk) / zph - zph   & 
    110                      &             + zbot / (1.+ zph / akb3(ji,jj,jk) )  ) 
    111  
     94                  zalk  = zalka - ( akw3(ji,jj,jk) / zph - zph + borat(ji,jj,jk) / ( 1. + zph / akb3(ji,jj,jk) ) ) 
    11295                  ! CALCULATE [H+] and [CO3--] 
    113                   zah2 = SQRT( (zdic-zalk)*(zdic-zalk)+   & 
    114                      &     4.*(zalk*ak23(ji,jj,jk)/ak13(ji,jj,jk))   & 
    115                      &     *(2*zdic-zalk)) 
    116  
    117                   zah2=0.5*ak13(ji,jj,jk)/zalk*((zdic-zalk)+zah2) 
    118                   zco3(ji,jj,jk) = zalk/(2.+zah2/ak23(ji,jj,jk))*zfact 
    119  
    120                   hi(ji,jj,jk)  = zah2*zfact 
    121  
     96                  zaldi = zdic - zalk 
     97                  zah2  = SQRT( zaldi * zaldi + 4.* ( zalk * ak23(ji,jj,jk) / ak13(ji,jj,jk) ) * ( zdic + zaldi ) ) 
     98                  zah2  = 0.5 * ak13(ji,jj,jk) / zalk * ( zaldi + zah2 ) 
     99                  ! 
     100                  zco3(ji,jj,jk) = zalk / ( 2. + zah2 / ak23(ji,jj,jk) ) * zfact 
     101                  hi(ji,jj,jk)   = zah2 * zfact 
    122102               END DO 
    123103            END DO 
     
    137117 
    138118               ! DEVIATION OF [CO3--] FROM SATURATION VALUE 
    139                zomegaca = ( calcon * zco3(ji,jj,jk) ) / aksp(ji,jj,jk) 
     119               ! Salinity dependance in zomegaca and divide by rhop/1000 to have good units 
     120               zcalcon  = calcon * ( tsn(ji,jj,jk,jp_sal) / 35._wp ) 
     121               zfact    = rhop(ji,jj,jk) / 1000._wp 
     122               zomegaca = ( zcalcon * zco3(ji,jj,jk) * zfact ) / aksp(ji,jj,jk)  
    140123 
    141124               ! SET DEGREE OF UNDER-/SUPERSATURATION 
    142                zexcess0 = MAX( 0., ( 1.- zomegaca ) ) 
     125               excess(ji,jj,jk) = 1._wp - zomegaca 
     126               zexcess0 = MAX( 0., excess(ji,jj,jk) ) 
    143127               zexcess  = zexcess0**nca 
    144128 
     
    146130               !       (ACCORDING TO THIS FORMULATION ALSO SOME PARTICULATE 
    147131               !       CACO3 GETS DISSOLVED EVEN IN THE CASE OF OVERSATURATION) 
     132               zdispot = kdca * zexcess * trn(ji,jj,jk,jpcal) 
    148133# if defined key_degrad 
    149               zdispot = kdca * zexcess * trn(ji,jj,jk,jpcal) * facvol(ji,jj,jk) 
    150 # else 
    151               zdispot = kdca * zexcess * trn(ji,jj,jk,jpcal) 
     134               zdispot = zdispot * facvol(ji,jj,jk) 
    152135# endif 
    153  
    154136              !  CHANGE OF [CO3--] , [ALK], PARTICULATE [CACO3], 
    155137              !       AND [SUM(CO2)] DUE TO CACO3 DISSOLUTION/PRECIPITATION 
    156               zremco3 = zdispot / rmtss 
    157               zco3(ji,jj,jk) = zco3(ji,jj,jk) + zremco3 * rfact 
    158               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + 2. * zremco3 
    159               tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) -      zremco3 
    160               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) +      zremco3 
    161  
    162 # if defined key_diatrc && defined key_iomput 
    163               zcaldiss(ji,jj,jk) = zremco3  ! calcite dissolution 
    164 # endif 
     138              zcaldiss(ji,jj,jk)  = zdispot / rmtss  ! calcite dissolution 
     139              zco3(ji,jj,jk)      = zco3(ji,jj,jk) + zcaldiss(ji,jj,jk) * rfact 
     140              ! 
     141              tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + 2. * zcaldiss(ji,jj,jk) 
     142              tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) -      zcaldiss(ji,jj,jk) 
     143              tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) +      zcaldiss(ji,jj,jk) 
    165144            END DO 
    166145         END DO 
    167146      END DO 
    168  
    169 # if defined key_diatrc 
    170 #  if ! defined key_iomput 
    171       trc3d(:,:,:,jp_pcs0_3d    ) = hi  (:,:,:)          * tmask(:,:,:) 
    172       trc3d(:,:,:,jp_pcs0_3d + 1) = zco3(:,:,:)          * tmask(:,:,:) 
    173       trc3d(:,:,:,jp_pcs0_3d + 2) = aksp(:,:,:) / calcon * tmask(:,:,:) 
    174 #  else 
    175       zrfact2 = 1.e3 * rfact2r 
    176       CALL iom_put( "PH"    , hi      (:,:,:)           * tmask(:,:,:) ) 
    177       CALL iom_put( "CO3"   , zco3    (:,:,:)           * tmask(:,:,:) ) 
    178       CALL iom_put( "CO3sat", aksp    (:,:,:) / calcon  * tmask(:,:,:) ) 
    179       CALL iom_put( "DCAL"  , zcaldiss(:,:,:) * zrfact2 * tmask(:,:,:) ) 
    180 #  endif 
    181 # endif 
    182       ! 
    183        IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    184          WRITE(charout, FMT="('lys ')") 
    185          CALL prt_ctl_trc_info(charout) 
    186          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
    187        ENDIF 
    188  
    189       IF( wrk_not_released(3, 2,3) ) CALL ctl_stop('p4z_lys: failed to release workspace arrays') 
     147      ! 
     148      IF( ln_diatrc )  THEN 
     149         ! 
     150         IF( lk_iomput ) THEN 
     151            zrfact2 = 1.e3 * rfact2r 
     152            CALL iom_put( "PH"    , hi      (:,:,:)           * tmask(:,:,:) ) 
     153            CALL iom_put( "CO3"   , zco3    (:,:,:)           * tmask(:,:,:) ) 
     154            CALL iom_put( "CO3sat", aksp    (:,:,:) / calcon  * tmask(:,:,:) ) 
     155            CALL iom_put( "DCAL"  , zcaldiss(:,:,:) * zrfact2 * tmask(:,:,:) ) 
     156         ELSE 
     157            trc3d(:,:,:,jp_pcs0_3d    ) = hi  (:,:,:)          * tmask(:,:,:) 
     158            trc3d(:,:,:,jp_pcs0_3d + 1) = zco3(:,:,:)          * tmask(:,:,:) 
     159            trc3d(:,:,:,jp_pcs0_3d + 2) = aksp(:,:,:) / calcon * tmask(:,:,:) 
     160         ENDIF 
     161         ! 
     162      ENDIF 
     163      ! 
     164      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     165        WRITE(charout, FMT="('lys ')") 
     166        CALL prt_ctl_trc_info(charout) 
     167        CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     168      ENDIF 
     169      ! 
     170      CALL wrk_dealloc( jpi, jpj, jpk, zco3, zcaldiss ) 
     171      ! 
     172      IF( nn_timing == 1 )  CALL timing_stop('p4z_lys') 
    190173      ! 
    191174   END SUBROUTINE p4z_lys 
     
    199182      !! 
    200183      !! ** Method  :   Read the nampiscal namelist and check the parameters 
    201       !!      called at the first timestep (nit000) 
     184      !!      called at the first timestep (nittrc000) 
    202185      !! 
    203186      !! ** input   :   Namelist nampiscal 
     
    207190      NAMELIST/nampiscal/ kdca, nca 
    208191 
    209       REWIND( numnat )                     ! read numnat 
    210       READ  ( numnat, nampiscal ) 
     192      REWIND( numnatp )                     ! read numnatp 
     193      READ  ( numnatp, nampiscal ) 
    211194 
    212195      IF(lwp) THEN                         ! control print 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmeso.F90

    r2528 r3294  
    66   !! History :   1.0  !  2002     (O. Aumont) Original code 
    77   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
     8   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Quota model for iron 
    89   !!---------------------------------------------------------------------- 
    910#if defined key_pisces 
     
    1415   !!   p4z_meso_init  :   Initialization of the parameters for mesozooplankton 
    1516   !!---------------------------------------------------------------------- 
    16    USE trc 
    17    USE oce_trc         ! 
    18    USE trc         !  
    19    USE sms_pisces      !  
    20    USE prtctl_trc 
    21    USE p4zint 
    22    USE p4zsink 
    23    USE iom 
     17   USE oce_trc         !  shared variables between ocean and passive tracers 
     18   USE trc             !  passive tracers common variables  
     19   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 
     22   USE p4zprod         !  production 
     23   USE prtctl_trc      !  print control for debugging 
     24   USE iom             !  I/O manager 
    2425 
    2526   IMPLICIT NONE 
     
    3031 
    3132   !! * Shared module variables 
    32    REAL(wp), PUBLIC ::   & 
    33       xprefc   = 1.0_wp     ,  &  !:  
    34       xprefp   = 0.2_wp     ,  &  !: 
    35       xprefz   = 1.0_wp     ,  &  !: 
    36       xprefpoc = 0.0_wp     ,  &  !: 
    37       resrat2  = 0.005_wp   ,  &  !: 
    38       mzrat2   = 0.03_wp    ,  &  !: 
    39       grazrat2 = 0.7_wp     ,  &  !: 
    40       xkgraz2  = 20E-6_wp   ,  &  !: 
    41       unass2   = 0.3_wp     ,  &  !: 
    42       sigma2   = 0.6_wp     ,  &  !: 
    43       epsher2  = 0.33_wp    ,  &  !:    
    44       grazflux = 5.E3_wp  
    45  
     33   REAL(wp), PUBLIC ::  part2       = 0.5_wp     !: part of calcite not dissolved in mesozoo guts 
     34   REAL(wp), PUBLIC ::  xprefc      = 1.0_wp     !: mesozoo preference for POC  
     35   REAL(wp), PUBLIC ::  xprefp      = 0.3_wp     !: mesozoo preference for nanophyto 
     36   REAL(wp), PUBLIC ::  xprefz      = 1.0_wp     !: mesozoo preference for diatoms 
     37   REAL(wp), PUBLIC ::  xprefpoc    = 0.3_wp     !: mesozoo preference for POC  
     38   REAL(wp), PUBLIC ::  xthresh2zoo = 1E-8_wp    !: zoo feeding threshold for mesozooplankton  
     39   REAL(wp), PUBLIC ::  xthresh2dia = 1E-8_wp    !: diatoms feeding threshold for mesozooplankton  
     40   REAL(wp), PUBLIC ::  xthresh2phy = 2E-7_wp    !: nanophyto feeding threshold for mesozooplankton  
     41   REAL(wp), PUBLIC ::  xthresh2poc = 1E-8_wp    !: poc feeding threshold for mesozooplankton  
     42   REAL(wp), PUBLIC ::  xthresh2    = 0._wp      !: feeding threshold for mesozooplankton  
     43   REAL(wp), PUBLIC ::  resrat2     = 0.005_wp   !: exsudation rate of mesozooplankton 
     44   REAL(wp), PUBLIC ::  mzrat2      = 0.04_wp    !: microzooplankton mortality rate  
     45   REAL(wp), PUBLIC ::  grazrat2    = 0.9_wp     !: maximal mesozoo grazing rate 
     46   REAL(wp), PUBLIC ::  xkgraz2     = 20E-6_wp   !: non assimilated fraction of P by mesozoo  
     47   REAL(wp), PUBLIC ::  unass2      = 0.3_wp     !: Efficicency of mesozoo growth  
     48   REAL(wp), PUBLIC ::  sigma2      = 0.6_wp     !: Fraction of mesozoo excretion as DOM  
     49   REAL(wp), PUBLIC ::  epsher2     = 0.3_wp     !: half sturation constant for grazing 2 
     50   REAL(wp), PUBLIC ::  grazflux    = 3.E3_wp    !: mesozoo flux feeding rate 
    4651 
    4752   !!* Substitution 
     
    6570      INTEGER, INTENT(in) ::   kt, jnt ! ocean time step 
    6671      INTEGER  :: ji, jj, jk 
    67       REAL(wp) :: zcompadi, zcompaph, zcompapoc, zcompaz 
    68       REAL(wp) :: zfact, zcompam, zdenom, zgraze2, zstep 
    69       REAL(wp) :: zgrarem2, zgrafer2, zgrapoc2, zprcaca, zmortz2 
     72      REAL(wp) :: zcompadi, zcompaph, zcompapoc, zcompaz, zcompam 
     73      REAL(wp) :: zgraze2 , zdenom, zdenom2, zncratio 
     74      REAL(wp) :: zfact   , zstep, zfood, zfoodlim 
     75      REAL(wp) :: zepshert, zepsherv, zgrarsig, zgraztot, zgraztotf 
     76      REAL(wp) :: zgrarem2, zgrafer2, zgrapoc2, zprcaca, zmortz2, zgrasrat 
    7077#if defined key_kriest 
    7178      REAL znumpoc 
    7279#endif 
    73       REAL(wp) :: zrespz2,ztortz2,zgrazd,zgrazz,zgrazpof 
    74       REAL(wp) :: zgrazn,zgrazpoc,zgraznf,zgrazf 
    75       REAL(wp) :: zgrazfff,zgrazffe 
     80      REAL(wp) :: zrespz2, ztortz2, zgrazd, zgrazz, zgrazpof 
     81      REAL(wp) :: zgrazn, zgrazpoc, zgraznf, zgrazf 
     82      REAL(wp) :: zgrazfff, zgrazffe 
    7683      CHARACTER (len=25) :: charout 
    77 #if defined key_diatrc && defined key_iomput 
    7884      REAL(wp) :: zrfact2 
    79 #endif 
    80  
    8185      !!--------------------------------------------------------------------- 
     86      ! 
     87      IF( nn_timing == 1 )  CALL timing_start('p4z_meso') 
     88      ! 
    8289 
    8390      DO jk = 1, jpkm1 
    8491         DO jj = 1, jpj 
    8592            DO ji = 1, jpi 
    86  
    87                zcompam = MAX( ( trn(ji,jj,jk,jpmes) - 1.e-9 ), 0.e0 ) 
     93               zcompam   = MAX( ( trn(ji,jj,jk,jpmes) - 1.e-8 ), 0.e0 ) 
    8894# if defined key_degrad 
    89                zstep   = xstep * facvol(ji,jj,jk) 
     95               zstep     = xstep * facvol(ji,jj,jk) 
    9096# else 
    91                zstep   = xstep 
     97               zstep     = xstep 
    9298# endif 
    93                zfact   = zstep * tgfunc(ji,jj,jk) * zcompam 
     99               zfact     = zstep * tgfunc(ji,jj,jk) * zcompam 
    94100 
    95101               !  Respiration rates of both zooplankton 
    96102               !  ------------------------------------- 
    97                zrespz2  = resrat2 * zfact * ( 1. + 3. * nitrfac(ji,jj,jk) )        & 
    98                   &     * trn(ji,jj,jk,jpmes) / ( xkmort + trn(ji,jj,jk,jpmes) ) 
     103               zrespz2   = resrat2 * zfact * trn(ji,jj,jk,jpmes) / ( xkmort + trn(ji,jj,jk,jpmes) )  & 
     104                  &      + resrat2 * zfact * 3. * nitrfac(ji,jj,jk) 
    99105 
    100106               !  Zooplankton mortality. A square function has been selected with 
    101107               !  no real reason except that it seems to be more stable and may mimic predation 
    102108               !  --------------------------------------------------------------- 
    103                ztortz2 = mzrat2 * 1.e6 * zfact * trn(ji,jj,jk,jpmes) 
     109               ztortz2   = mzrat2 * 1.e6 * zfact * trn(ji,jj,jk,jpmes) 
    104110               ! 
    105111 
    106                zcompadi  = MAX( ( trn(ji,jj,jk,jpdia) - 1.e-8 ), 0.e0 ) 
    107                zcompaz   = MAX( ( trn(ji,jj,jk,jpzoo) - 1.e-8 ), 0.e0 ) 
    108                zcompaph  = MAX( ( trn(ji,jj,jk,jpphy) - 2.e-7 ), 0.e0 ) 
    109                zcompapoc = MAX( ( trn(ji,jj,jk,jppoc) - 1.e-8 ), 0.e0 ) 
    110  
    111                !  Microzooplankton grazing 
    112                !     ------------------------ 
    113                zdenom = 1. / (  xkgraz2 + xprefc   * trn(ji,jj,jk,jpdia)   & 
    114                   &                     + xprefz   * trn(ji,jj,jk,jpzoo)   & 
    115                   &                     + xprefp   * trn(ji,jj,jk,jpphy)   & 
    116                   &                     + xprefpoc * trn(ji,jj,jk,jppoc)  ) 
    117  
    118                zgraze2 = grazrat2 * zstep * Tgfunc2(ji,jj,jk) * zdenom * trn(ji,jj,jk,jpmes)  
    119  
    120                zgrazd   = zgraze2  * xprefc   * zcompadi 
    121                zgrazz   = zgraze2  * xprefz   * zcompaz 
    122                zgrazn   = zgraze2  * xprefp   * zcompaph 
    123                zgrazpoc = zgraze2  * xprefpoc * zcompapoc 
    124  
    125                zgraznf  = zgrazn   * trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn) 
    126                zgrazf   = zgrazd   * trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn) 
    127                zgrazpof = zgrazpoc * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 
    128                 
     112               zcompadi  = MAX( ( trn(ji,jj,jk,jpdia) - xthresh2dia ), 0.e0 ) 
     113               zcompaz   = MAX( ( trn(ji,jj,jk,jpzoo) - xthresh2zoo ), 0.e0 ) 
     114               zcompaph  = MAX( ( trn(ji,jj,jk,jpphy) - xthresh2phy ), 0.e0 ) 
     115               zcompapoc = MAX( ( trn(ji,jj,jk,jppoc) - xthresh2poc ), 0.e0 ) 
     116 
     117               zfood     = xprefc * zcompadi + xprefz * zcompaz + xprefp * zcompaph + xprefpoc * zcompapoc  
     118               zfoodlim  = MAX( 0., zfood - xthresh2 ) 
     119               zdenom    = zfoodlim / ( xkgraz2 + zfoodlim ) 
     120               zdenom2   = zdenom / ( zfood + rtrn ) 
     121               zgraze2   = grazrat2 * zstep * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpmes)  
     122 
     123               zgrazd    = zgraze2  * xprefc   * zcompadi  * zdenom2  
     124               zgrazz    = zgraze2  * xprefz   * zcompaz   * zdenom2  
     125               zgrazn    = zgraze2  * xprefp   * zcompaph  * zdenom2  
     126               zgrazpoc  = zgraze2  * xprefpoc * zcompapoc * zdenom2  
     127 
     128               zgraznf   = zgrazn   * trn(ji,jj,jk,jpnfe) / ( trn(ji,jj,jk,jpphy) + rtrn) 
     129               zgrazf    = zgrazd   * trn(ji,jj,jk,jpdfe) / ( trn(ji,jj,jk,jpdia) + rtrn) 
     130               zgrazpof  = zgrazpoc * trn(ji,jj,jk,jpsfe) / ( trn(ji,jj,jk,jppoc) + rtrn) 
     131 
    129132               !  Mesozooplankton flux feeding on GOC 
    130133               !  ---------------------------------- 
    131134# if ! defined key_kriest 
    132                zgrazffe = grazflux * zstep * wsbio4(ji,jj,jk)          & 
    133                   &                 * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpmes) 
    134                zgrazfff = zgrazffe * trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn) 
     135               zgrazffe  = grazflux * zstep * wsbio4(ji,jj,jk)          & 
     136                 &                 * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpmes) 
     137               zgrazfff  = zgrazffe * trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn) 
    135138# else 
    136                !!--------------------------- KRIEST3 ------------------------------------------- 
    137                !!               zgrazffe = 0.5 * 1.3e-2 / 5.5e-7 * 0.3 * zstep * wsbio3(ji,jj,jk)     & 
    138                !!                  &     * tgfunc(ji,jj,jk) * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpmes)    & 
    139                !! #  if defined key_degrad 
    140                !!                  &     * facvol(ji,jj,jk)          & 
    141                !! #  endif 
    142                !!                  &     /  (trn(ji,jj,jk,jppoc) * 1.e7 + 0.1) 
    143                !!--------------------------- KRIEST3 ------------------------------------------- 
    144  
    145               zgrazffe = grazflux * zstep * wsbio3(ji,jj,jk)     & 
    146                   &                * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpmes) 
    147               zgrazfff = zgrazffe * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 
     139               zgrazffe = grazflux * zstep * wsbio3(ji,jj,jk)     & 
     140               zgrazfff   = zgrazffe * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 
    148141# endif 
    149        
    150 #if defined key_diatrc 
    151               ! Total grazing ( grazing by microzoo is already computed in p4zmicro )  
    152               grazing(ji,jj,jk) = grazing(ji,jj,jk) + (  zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffe ) 
    153 #endif 
    154  
     142              ! 
     143              zgraztot   = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffe 
     144              zgraztotf  = zgrazf + zgraznf + zgrazz * ferat3 + zgrazpof + zgrazfff  
     145 
     146              ! Total grazing ( grazing by microzoo is already computed in p4zmicro ) 
     147              grazing(ji,jj,jk) = grazing(ji,jj,jk) + zgraztot 
    155148              !    Mesozooplankton efficiency 
    156149              !    -------------------------- 
    157               zgrarem2 = ( zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffe ) * ( 1. - epsher2 - unass2 ) 
    158 #if ! defined key_kriest 
    159               zgrafer2 = ( zgrazf + zgraznf + zgrazz * ferat3 + zgrazpof + zgrazfff ) * ( 1.- epsher2 - unass2 ) &  
    160                   &     + epsher2 * ( zgrazd   * MAX((trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn)-ferat3),0.) & 
    161                   &                 + zgrazn   * MAX((trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn)-ferat3),0.) & 
    162                   &                 + zgrazpoc * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)-ferat3),0.) & 
    163                   &                 + zgrazffe * MAX((trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn)-ferat3),0.)  ) 
     150              zgrasrat   =  zgraztotf / ( zgraztot + rtrn ) 
     151              zncratio   = (  xprefc   * zcompadi * quotad(ji,jj,jk)  & 
     152                  &         + xprefp   * zcompaph * quotan(ji,jj,jk)  & 
     153                  &         + xprefz   * zcompaz                      & 
     154                  &         + xprefpoc * zcompapoc   ) / ( zfood + rtrn ) 
     155               zepshert  = epsher2 * MIN( 1., zncratio ) 
     156               zepsherv  = zepshert * MIN( 1., zgrasrat / ferat3 ) 
     157               zgrarem2  = zgraztot * ( 1. - zepsherv - unass2 ) 
     158               zgrafer2  = zgraztot * MAX( 0. , ( 1. - unass2 ) * zgrasrat - ferat3 * zepshert )  
     159               zgrapoc2  = zgraztot * unass2 
     160 
     161               !   Update the arrays TRA which contain the biological sources and sinks 
     162               zgrarsig  = zgrarem2 * sigma2 
     163               tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarsig 
     164               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarsig 
     165               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem2 - zgrarsig 
     166               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarsig 
     167               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer2 
     168               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarsig 
     169               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zgrarsig               
     170#if defined key_kriest 
     171               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc2 
     172               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc2 * xkr_dmeso 
     173               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zgraztotf * unass2 
    164174#else 
    165               zgrafer2 = ( zgrazf + zgraznf + zgrazz * ferat3 + zgrazpof + zgrazfff ) * ( 1. - epsher2 - unass2 ) & 
    166                   &    + epsher2 * ( zgrazd   * MAX((trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn)-ferat3),0.) & 
    167                   &                + zgrazn   * MAX((trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn)-ferat3),0.) & 
    168                   &                + zgrazpoc * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)-ferat3),0.) & 
    169                   &                + zgrazffe * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn)-ferat3),0.)  ) 
    170  
    171 #endif 
    172                !   Update the arrays TRA which contain the biological sources and sinks 
    173  
    174                zgrapoc2 =  zgrazd + zgrazz  + zgrazn + zgrazpoc + zgrazffe 
    175  
    176                tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarem2 * sigma2 
    177                tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarem2 * sigma2 
    178                tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem2 * ( 1. - sigma2 ) 
    179                tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarem2 * sigma2 
    180                tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer2 
    181                tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarem2 * sigma2 
    182                 
    183 #if defined key_kriest 
    184                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc2 * unass2 
    185                tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc2 * unass2 * xkr_dmeso 
    186 #else 
    187                tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zgrapoc2 * unass2 
     175               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zgrapoc2 
     176               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zgraztotf * unass2 
    188177#endif 
    189178               zmortz2 = ztortz2 + zrespz2 
    190                tra(ji,jj,jk,jpmes) = tra(ji,jj,jk,jpmes) - zmortz2 + epsher2 * zgrapoc2 
     179               tra(ji,jj,jk,jpmes) = tra(ji,jj,jk,jpmes) - zmortz2 + zepsherv * zgraztot  
    191180               tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazd 
    192181               tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zgrazz 
     
    199188               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazf 
    200189 
    201                zprcaca = xfracal(ji,jj,jk) * unass2 * zgrazn 
    202 #if defined key_diatrc 
     190               zprcaca = xfracal(ji,jj,jk) * zgrazn 
     191               ! calcite production 
    203192               prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
    204 #endif 
    205                zprcaca = part * zprcaca 
     193               ! 
     194               zprcaca = part2 * zprcaca 
    206195               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca 
    207196               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca 
     
    212201               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) - zgrazpoc * znumpoc & 
    213202                  &    + zmortz2  * xkr_dmeso - zgrazffe * znumpoc * wsbio4(ji,jj,jk) / ( wsbio3(ji,jj,jk) + rtrn ) 
    214                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz2 & 
    215                &       + unass2 * ( ferat3 * zgrazz + zgraznf + zgrazf + zgrazpof + zgrazfff ) - zgrazfff - zgrazpof 
     203               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz2 - zgrazfff - zgrazpof 
    216204#else 
    217205               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zgrazpoc 
    218206               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zmortz2 - zgrazffe 
    219207               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zgrazpof 
    220                tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + ferat3 * zmortz2 & 
    221                &       + unass2 * ( ferat3 * zgrazz + zgraznf + zgrazf + zgrazpof + zgrazfff ) - zgrazfff 
     208               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + ferat3 * zmortz2 - zgrazfff 
    222209#endif 
    223210 
     
    226213      END DO 
    227214      ! 
    228 #if defined key_diatrc && defined key_iomput 
    229       zrfact2 = 1.e3 * rfact2r 
    230       ! Total grazing of phyto by zoo 
    231       grazing(:,:,:) = grazing(:,:,:) * zrfact2 * tmask(:,:,:) 
    232       ! Calcite production 
    233       prodcal(:,:,:) = prodcal(:,:,:) * zrfact2 * tmask(:,:,:) 
    234       IF( jnt == nrdttrc ) then  
    235          CALL iom_put( "GRAZ" , grazing  )  ! Total grazing of phyto by zooplankton 
    236          CALL iom_put( "PCAL" , prodcal  )  ! Calcite production 
     215      IF( ln_diatrc .AND. lk_iomput ) THEN 
     216         zrfact2 = 1.e3 * rfact2r 
     217         grazing(:,:,:) = grazing(:,:,:) * zrfact2 * tmask(:,:,:)   ! Total grazing of phyto by zoo 
     218         prodcal(:,:,:) = prodcal(:,:,:) * zrfact2 * tmask(:,:,:)   ! Calcite production 
     219         IF( jnt == nrdttrc ) THEN 
     220            CALL iom_put( "GRAZ" , grazing  )  ! Total grazing of phyto by zooplankton 
     221            CALL iom_put( "PCAL" , prodcal  )  ! Calcite production 
     222         ENDIF 
    237223      ENDIF 
    238 #endif 
    239  
    240        IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    241          WRITE(charout, FMT="('meso')") 
    242          CALL prt_ctl_trc_info(charout) 
    243          CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
    244        ENDIF 
    245  
     224      ! 
     225      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     226        WRITE(charout, FMT="('meso')") 
     227        CALL prt_ctl_trc_info(charout) 
     228        CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     229      ENDIF 
     230      ! 
     231      IF( nn_timing == 1 )  CALL timing_stop('p4z_meso') 
     232      ! 
    246233   END SUBROUTINE p4z_meso 
    247234 
     
    254241      !! 
    255242      !! ** Method  :   Read the nampismes namelist and check the parameters 
    256       !!      called at the first timestep (nit000) 
     243      !!      called at the first timestep (nittrc000) 
    257244      !! 
    258245      !! ** input   :   Namelist nampismes 
     
    260247      !!---------------------------------------------------------------------- 
    261248 
    262       NAMELIST/nampismes/ grazrat2,resrat2,mzrat2,xprefc, xprefp, & 
    263          &             xprefz, xprefpoc, xkgraz2, epsher2, sigma2, unass2, grazflux 
    264  
    265       REWIND( numnat )                     ! read numnat 
    266       READ  ( numnat, nampismes ) 
     249      NAMELIST/nampismes/ part2, grazrat2, resrat2, mzrat2, xprefc, xprefp, xprefz,   & 
     250         &                xprefpoc, xthresh2dia, xthresh2phy, xthresh2zoo, xthresh2poc, & 
     251         &                xthresh2, xkgraz2, epsher2, sigma2, unass2, grazflux 
     252 
     253      REWIND( numnatp )                     ! read numnatp 
     254      READ  ( numnatp, nampismes ) 
    267255 
    268256 
     
    271259         WRITE(numout,*) ' Namelist parameters for mesozooplankton, nampismes' 
    272260         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    273          WRITE(numout,*) '    zoo preference for phyto                  xprefc    =', xprefc 
    274          WRITE(numout,*) '    zoo preference for POC                    xprefp    =', xprefp 
    275          WRITE(numout,*) '    zoo preference for zoo                    xprefz    =', xprefz 
    276          WRITE(numout,*) '    zoo preference for poc                    xprefpoc  =', xprefpoc 
    277          WRITE(numout,*) '    exsudation rate of mesozooplankton        resrat2   =', resrat2 
    278          WRITE(numout,*) '    mesozooplankton mortality rate            mzrat2    =', mzrat2 
    279          WRITE(numout,*) '    maximal mesozoo grazing rate              grazrat2  =', grazrat2 
    280          WRITE(numout,*) '    mesozoo flux feeding rate                 grazflux  =', grazflux 
    281          WRITE(numout,*) '    non assimilated fraction of P by mesozoo  unass2    =', unass2 
    282          WRITE(numout,*) '    Efficicency of Mesozoo growth             epsher2   =', epsher2 
    283          WRITE(numout,*) '    Fraction of mesozoo excretion as DOM      sigma2    =', sigma2 
    284          WRITE(numout,*) '    half sturation constant for grazing 2     xkgraz2   =', xkgraz2 
     261         WRITE(numout,*) '    part of calcite not dissolved in mesozoo guts  part2        =', part2 
     262         WRITE(numout,*) '    mesozoo preference for phyto                   xprefc       =', xprefc 
     263         WRITE(numout,*) '    mesozoo preference for POC                     xprefp       =', xprefp 
     264         WRITE(numout,*) '    mesozoo preference for zoo                     xprefz       =', xprefz 
     265         WRITE(numout,*) '    mesozoo preference for poc                     xprefpoc     =', xprefpoc 
     266         WRITE(numout,*) '    microzoo feeding threshold  for mesozoo        xthresh2zoo  =', xthresh2zoo 
     267         WRITE(numout,*) '    diatoms feeding threshold  for mesozoo         xthresh2dia  =', xthresh2dia 
     268         WRITE(numout,*) '    nanophyto feeding threshold for mesozoo        xthresh2phy  =', xthresh2phy 
     269         WRITE(numout,*) '    poc feeding threshold for mesozoo              xthresh2poc  =', xthresh2poc 
     270         WRITE(numout,*) '    feeding threshold for mesozooplankton          xthresh2     =', xthresh2 
     271         WRITE(numout,*) '    exsudation rate of mesozooplankton             resrat2      =', resrat2 
     272         WRITE(numout,*) '    mesozooplankton mortality rate                 mzrat2       =', mzrat2 
     273         WRITE(numout,*) '    maximal mesozoo grazing rate                   grazrat2     =', grazrat2 
     274         WRITE(numout,*) '    mesozoo flux feeding rate                      grazflux     =', grazflux 
     275         WRITE(numout,*) '    non assimilated fraction of P by mesozoo       unass2       =', unass2 
     276         WRITE(numout,*) '    Efficicency of Mesozoo growth                  epsher2      =', epsher2 
     277         WRITE(numout,*) '    Fraction of mesozoo excretion as DOM           sigma2       =', sigma2 
     278         WRITE(numout,*) '    half sturation constant for grazing 2          xkgraz2      =', xkgraz2 
    285279      ENDIF 
    286280 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmicro.F90

    r2528 r3294  
    66   !! History :   1.0  !  2004     (O. Aumont) Original code 
    77   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
     8   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Quota model for iron 
    89   !!---------------------------------------------------------------------- 
    910#if defined key_pisces 
     
    1415   !!   p4z_micro_init  :   Initialize and read the appropriate namelist 
    1516   !!---------------------------------------------------------------------- 
    16    USE trc 
    17    USE oce_trc         ! 
    18    USE trc         !  
    19    USE sms_pisces      !  
    20    USE prtctl_trc 
    21    USE p4zint 
    22    USE p4zsink 
    23    USE iom 
     17   USE oce_trc         !  shared variables between ocean and passive tracers 
     18   USE trc             !  passive tracers common variables  
     19   USE sms_pisces      !  PISCES Source Minus Sink variables 
     20   USE p4zlim          !  Co-limitations 
     21   USE p4zsink         !  vertical flux of particulate matter due to sinking 
     22   USE p4zint          !  interpolation and computation of various fields 
     23   USE p4zprod         !  production 
     24   USE prtctl_trc      !  print control for debugging 
    2425 
    2526   IMPLICIT NONE 
     
    2829   PUBLIC   p4z_micro         ! called in p4zbio.F90 
    2930   PUBLIC   p4z_micro_init    ! called in trcsms_pisces.F90 
     31   PUBLIC   p4z_micro_alloc    ! called in trcsms_pisces.F90 
    3032 
    3133   !! * Shared module variables 
    32    REAL(wp), PUBLIC ::   & 
    33       xpref2c = 0.0_wp       ,  &  !: 
    34       xpref2p = 0.5_wp       ,  &  !: 
    35       xpref2d = 0.5_wp       ,  &  !: 
    36       resrat  = 0.03_wp      ,  &  !: 
    37       mzrat   = 0.0_wp       ,  &  !: 
    38       grazrat = 4.0_wp       ,  &  !: 
    39       xkgraz  = 20E-6_wp     ,  &  !: 
    40       unass   = 0.3_wp       ,  &  !: 
    41       sigma1  = 0.6_wp       ,  &  !: 
    42       epsher  = 0.33_wp 
     34   REAL(wp), PUBLIC ::  part       = 0.5_wp     !: part of calcite not dissolved in microzoo guts 
     35   REAL(wp), PUBLIC ::  xpref2c    = 0.2_wp     !: microzoo preference for POC  
     36   REAL(wp), PUBLIC ::  xpref2p    = 1.0_wp     !: microzoo preference for nanophyto 
     37   REAL(wp), PUBLIC ::  xpref2d    = 0.6_wp     !: microzoo preference for diatoms 
     38   REAL(wp), PUBLIC ::  xthreshdia = 1E-8_wp    !: diatoms feeding threshold for microzooplankton  
     39   REAL(wp), PUBLIC ::  xthreshphy = 2E-7_wp    !: nanophyto threshold for microzooplankton  
     40   REAL(wp), PUBLIC ::  xthreshpoc = 1E-8_wp    !: poc threshold for microzooplankton  
     41   REAL(wp), PUBLIC ::  xthresh    = 0._wp      !: feeding threshold for microzooplankton  
     42   REAL(wp), PUBLIC ::  resrat     = 0.03_wp    !: exsudation rate of microzooplankton 
     43   REAL(wp), PUBLIC ::  mzrat      = 0.0_wp     !: microzooplankton mortality rate  
     44   REAL(wp), PUBLIC ::  grazrat    = 3.0_wp     !: maximal microzoo grazing rate 
     45   REAL(wp), PUBLIC ::  xkgraz     = 20E-6_wp   !: non assimilated fraction of P by microzoo  
     46   REAL(wp), PUBLIC ::  unass      = 0.3_wp     !: Efficicency of microzoo growth  
     47   REAL(wp), PUBLIC ::  sigma1     = 0.6_wp     !: Fraction of microzoo excretion as DOM  
     48   REAL(wp), PUBLIC ::  epsher     = 0.3_wp     !: half sturation constant for grazing 1  
    4349 
    4450 
     
    6369      INTEGER, INTENT(in) ::   kt ! ocean time step 
    6470      INTEGER  :: ji, jj, jk 
    65       REAL(wp) :: zcompadi, zcompadi2, zcompaz , zcompaph, zcompapoc 
    66       REAL(wp) :: zgraze  , zdenom  , zdenom2, zstep 
    67       REAL(wp) :: zfact   , zinano , zidiat, zipoc 
     71      REAL(wp) :: zcompadi, zcompaz , zcompaph, zcompapoc 
     72      REAL(wp) :: zgraze  , zdenom, zdenom2, zncratio 
     73      REAL(wp) :: zfact   , zstep, zfood, zfoodlim 
     74      REAL(wp) :: zepshert, zepsherv, zgrarsig, zgraztot, zgraztotf 
    6875      REAL(wp) :: zgrarem, zgrafer, zgrapoc, zprcaca, zmortz 
    69       REAL(wp) :: zrespz, ztortz 
     76      REAL(wp) :: zrespz, ztortz, zgrasrat 
    7077      REAL(wp) :: zgrazp, zgrazm, zgrazsd 
    7178      REAL(wp) :: zgrazmf, zgrazsf, zgrazpf 
    7279      CHARACTER (len=25) :: charout 
    73  
    7480      !!--------------------------------------------------------------------- 
    75  
    76  
    77 #if defined key_diatrc 
    78       grazing(:,:,:) = 0.  !: Initialisation of  grazing 
    79 #endif 
    80  
    81       zstep = rfact2 / rday      ! Time step duration for biology 
    82  
     81      ! 
     82      IF( nn_timing == 1 )  CALL timing_start('p4z_micro') 
     83      ! 
     84      grazing(:,:,:) = 0.  !: grazing set to zero 
    8385      DO jk = 1, jpkm1 
    8486         DO jj = 1, jpj 
    8587            DO ji = 1, jpi 
    86                zcompaz = MAX( ( trn(ji,jj,jk,jpzoo) - 1.e-9 ), 0.e0 ) 
     88               zcompaz = MAX( ( trn(ji,jj,jk,jpzoo) - 1.e-8 ), 0.e0 ) 
     89               zstep   = xstep 
    8790# if defined key_degrad 
    88                zstep   = xstep * facvol(ji,jj,jk) 
    89 # else 
    90                zstep   = xstep 
     91               zstep = zstep * facvol(ji,jj,jk) 
    9192# endif 
    92                zfact   = zstep * tgfunc(ji,jj,jk) * zcompaz 
     93               zfact   = zstep * tgfunc2(ji,jj,jk) * zcompaz 
    9394 
    9495               !  Respiration rates of both zooplankton 
    9596               !  ------------------------------------- 
    96                zrespz = resrat * zfact  * ( 1.+ 3.* nitrfac(ji,jj,jk) )     & 
    97                   &            * trn(ji,jj,jk,jpzoo) / ( xkmort + trn(ji,jj,jk,jpzoo) ) 
     97               zrespz = resrat * zfact * trn(ji,jj,jk,jpzoo) / ( 2. * xkmort + trn(ji,jj,jk,jpzoo) )  & 
     98                  &   + resrat * zfact * 3. * nitrfac(ji,jj,jk) 
    9899 
    99100               !  Zooplankton mortality. A square function has been selected with 
     
    102103               ztortz = mzrat * 1.e6 * zfact * trn(ji,jj,jk,jpzoo) 
    103104 
    104                zcompadi  = MAX( ( trn(ji,jj,jk,jpdia) - 1.e-8 ), 0.e0 ) 
    105                zcompadi2 = MIN( zcompadi, 5.e-7 ) 
    106                zcompaph  = MAX( ( trn(ji,jj,jk,jpphy) - 2.e-7 ), 0.e0 ) 
    107                zcompapoc = MAX( ( trn(ji,jj,jk,jppoc) - 1.e-8 ), 0.e0 ) 
     105               zcompadi  = MIN( MAX( ( trn(ji,jj,jk,jpdia) - xthreshdia ), 0.e0 ), xsizedia ) 
     106               zcompaph  = MAX( ( trn(ji,jj,jk,jpphy) - xthreshphy ), 0.e0 ) 
     107               zcompapoc = MAX( ( trn(ji,jj,jk,jppoc) - xthreshpoc ), 0.e0 ) 
    108108                
    109109               !     Microzooplankton grazing 
    110110               !     ------------------------ 
    111                zdenom2 = 1./ ( xpref2p * zcompaph + xpref2c * zcompapoc + xpref2d * zcompadi2 + rtrn ) 
    112  
    113                zgraze = grazrat * zstep * tgfunc(ji,jj,jk) * trn(ji,jj,jk,jpzoo) 
    114  
    115                zinano = xpref2p * zcompaph  * zdenom2 
    116                zipoc  = xpref2c * zcompapoc * zdenom2 
    117                zidiat = xpref2d * zcompadi2 * zdenom2 
    118  
    119                zdenom = 1./ ( xkgraz + zinano * zcompaph + zipoc * zcompapoc + zidiat * zcompadi2 ) 
    120  
    121                zgrazp  = zgraze * zinano * zcompaph * zdenom 
    122                zgrazm  = zgraze * zipoc  * zcompapoc * zdenom 
    123                zgrazsd = zgraze * zidiat * zcompadi2 * zdenom 
    124  
    125                zgrazpf = zgrazp  * trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn) 
    126                zgrazmf = zgrazm  * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 
    127                zgrazsf = zgrazsd * trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn) 
    128 #if defined key_diatrc 
     111               zfood     = xpref2p * zcompaph + xpref2c * zcompapoc + xpref2d * zcompadi 
     112               zfoodlim  = MAX( 0. , zfood - xthresh ) 
     113               zdenom    = zfoodlim / ( xkgraz + zfoodlim ) 
     114               zdenom2   = zdenom / ( zfood + rtrn ) 
     115               zgraze    = grazrat * zstep * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpzoo)  
     116 
     117               zgrazp    = zgraze  * xpref2p * zcompaph  * zdenom2  
     118               zgrazm    = zgraze  * xpref2c * zcompapoc * zdenom2  
     119               zgrazsd   = zgraze  * xpref2d * zcompadi  * zdenom2  
     120 
     121               zgrazpf   = zgrazp  * trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn) 
     122               zgrazmf   = zgrazm  * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 
     123               zgrazsf   = zgrazsd * trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn) 
     124               ! 
     125               zgraztot  = zgrazp  + zgrazm  + zgrazsd  
     126               zgraztotf = zgrazpf + zgrazsf + zgrazmf  
     127 
    129128               ! Grazing by microzooplankton 
    130                grazing(ji,jj,jk) = grazing(ji,jj,jk) + zgrazp + zgrazm + zgrazsd  
    131 #endif 
     129               grazing(ji,jj,jk) = grazing(ji,jj,jk) + zgraztot 
    132130 
    133131               !    Various remineralization and excretion terms 
    134132               !    -------------------------------------------- 
    135                zgrarem = ( zgrazp + zgrazm + zgrazsd ) * ( 1.- epsher - unass ) 
    136                zgrafer = ( zgrazpf + zgrazsf + zgrazmf ) * ( 1.- epsher - unass ) & 
    137                   &      + epsher * ( zgrazm  * MAX((trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc)+ rtrn)-ferat3),0.e0) &  
    138                   &                 + zgrazp  * MAX((trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy)+ rtrn)-ferat3),0.e0) & 
    139                   &                 + zgrazsd * MAX((trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia)+ rtrn)-ferat3),0.e0 )  ) 
    140  
    141                zgrapoc = (  zgrazp + zgrazm + zgrazsd )  
     133               zgrasrat  = zgraztotf / ( zgraztot + rtrn ) 
     134               zncratio  = ( xpref2p * zcompaph * quotan(ji,jj,jk) & 
     135                  &        + xpref2d * zcompadi * quotad(ji,jj,jk) + xpref2c * zcompapoc ) / ( zfood + rtrn ) 
     136               zepshert  = epsher * MIN( 1., zncratio ) 
     137               zepsherv  = zepshert * MIN( 1., zgrasrat / ferat3 ) 
     138               zgrafer   = zgraztot * MAX( 0. , ( 1. - unass ) * zgrasrat - ferat3 * zepshert )  
     139               zgrarem   = zgraztot * ( 1. - zepsherv - unass ) 
     140               zgrapoc   = zgraztot * unass 
    142141 
    143142               !  Update of the TRA arrays 
    144143               !  ------------------------ 
    145  
    146                tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarem * sigma1 
    147                tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarem * sigma1 
    148                tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem * (1.-sigma1) 
    149                tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarem * sigma1 
     144               zgrarsig  = zgrarem * sigma1 
     145               tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarsig 
     146               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarsig 
     147               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem - zgrarsig 
     148               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarsig 
    150149               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer 
    151                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc * unass 
    152                tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarem * sigma1 
     150               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc 
     151               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zgraztotf * unass 
     152               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarsig 
     153               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zgrarsig 
    153154#if defined key_kriest 
    154                tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc * unass * xkr_ddiat 
     155               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc * xkr_ddiat 
    155156#endif 
    156  
    157                ! 
    158157               !   Update the arrays TRA which contain the biological sources and sinks 
    159158               !   -------------------------------------------------------------------- 
    160  
    161159               zmortz = ztortz + zrespz 
    162                tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zmortz + epsher * zgrapoc  
     160               tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zmortz + zepsherv * zgraztot  
    163161               tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazp 
    164162               tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazsd 
     
    170168               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazsf 
    171169               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zmortz - zgrazm 
    172                tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz + unass * ( zgrazpf + zgrazsf ) - (1.-unass) * zgrazmf 
    173                zprcaca = xfracal(ji,jj,jk) * unass * zgrazp 
    174 #if defined key_diatrc 
     170               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz - zgrazmf 
     171               zprcaca = xfracal(ji,jj,jk) * zgrazp 
     172               ! 
     173               ! calcite production 
    175174               prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
    176 #endif 
     175               ! 
    177176               zprcaca = part * zprcaca 
    178177               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca 
     
    191190         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
    192191      ENDIF 
    193  
     192      ! 
     193      IF( nn_timing == 1 )  CALL timing_stop('p4z_micro') 
     194      ! 
    194195   END SUBROUTINE p4z_micro 
    195196 
     
    203204      !! 
    204205      !! ** Method  :   Read the nampiszoo namelist and check the parameters 
    205       !!      called at the first timestep (nit000) 
     206      !!                called at the first timestep (nittrc000) 
    206207      !! 
    207208      !! ** input   :   Namelist nampiszoo 
     
    209210      !!---------------------------------------------------------------------- 
    210211 
    211       NAMELIST/nampiszoo/ grazrat,resrat,mzrat,xpref2c, xpref2p, & 
    212          &             xpref2d, xkgraz, epsher, sigma1, unass 
    213  
    214       REWIND( numnat )                     ! read numnat 
    215       READ  ( numnat, nampiszoo ) 
     212      NAMELIST/nampiszoo/ part, grazrat, resrat, mzrat, xpref2c, xpref2p, & 
     213         &                xpref2d,  xthreshdia,  xthreshphy,  xthreshpoc, & 
     214         &                xthresh, xkgraz, epsher, sigma1, unass 
     215 
     216      REWIND( numnatp )                     ! read numnatp 
     217      READ  ( numnatp, nampiszoo ) 
    216218 
    217219      IF(lwp) THEN                         ! control print 
     
    219221         WRITE(numout,*) ' Namelist parameters for microzooplankton, nampiszoo' 
    220222         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    221          WRITE(numout,*) '    zoo preference for POC                    xpref2c    =', xpref2c 
    222          WRITE(numout,*) '    zoo preference for nano                   xpref2p    =', xpref2p 
    223          WRITE(numout,*) '    zoo preference for diatoms                xpref2d    =', xpref2d 
    224          WRITE(numout,*) '    exsudation rate of microzooplankton       resrat    =', resrat 
    225          WRITE(numout,*) '    microzooplankton mortality rate           mzrat     =', mzrat 
    226          WRITE(numout,*) '    maximal microzoo grazing rate             grazrat   =', grazrat 
    227          WRITE(numout,*) '    non assimilated fraction of P by microzoo unass     =', unass 
    228          WRITE(numout,*) '    Efficicency of microzoo growth            epsher    =', epsher 
    229          WRITE(numout,*) '    Fraction of microzoo excretion as DOM     sigma1    =', sigma1 
    230          WRITE(numout,*) '    half sturation constant for grazing 1     xkgraz    =', xkgraz 
     223         WRITE(numout,*) '    part of calcite not dissolved in microzoo guts  part        =', part 
     224         WRITE(numout,*) '    microzoo preference for POC                     xpref2c     =', xpref2c 
     225         WRITE(numout,*) '    microzoo preference for nano                    xpref2p     =', xpref2p 
     226         WRITE(numout,*) '    microzoo preference for diatoms                 xpref2d     =', xpref2d 
     227         WRITE(numout,*) '    diatoms feeding threshold  for microzoo         xthreshdia  =', xthreshdia 
     228         WRITE(numout,*) '    nanophyto feeding threshold for microzoo        xthreshphy  =', xthreshphy 
     229         WRITE(numout,*) '    poc feeding threshold for microzoo              xthreshpoc  =', xthreshpoc 
     230         WRITE(numout,*) '    feeding threshold for microzooplankton          xthresh     =', xthresh 
     231         WRITE(numout,*) '    exsudation rate of microzooplankton             resrat      =', resrat 
     232         WRITE(numout,*) '    microzooplankton mortality rate                 mzrat       =', mzrat 
     233         WRITE(numout,*) '    maximal microzoo grazing rate                   grazrat     =', grazrat 
     234         WRITE(numout,*) '    non assimilated fraction of P by microzoo       unass       =', unass 
     235         WRITE(numout,*) '    Efficicency of microzoo growth                  epsher      =', epsher 
     236         WRITE(numout,*) '    Fraction of microzoo excretion as DOM           sigma1      =', sigma1 
     237         WRITE(numout,*) '    half sturation constant for grazing 1           xkgraz      =', xkgraz 
    231238      ENDIF 
    232239 
    233240   END SUBROUTINE p4z_micro_init 
     241 
     242   INTEGER FUNCTION p4z_micro_alloc() 
     243      !!---------------------------------------------------------------------- 
     244      !!                     ***  ROUTINE p4z_micro_alloc  *** 
     245      !!---------------------------------------------------------------------- 
     246      ALLOCATE( grazing(jpi,jpj,jpk), STAT=p4z_micro_alloc ) 
     247      IF( p4z_micro_alloc /= 0 ) CALL ctl_warn('p4z_micro_alloc : failed to allocate arrays.') 
     248 
     249   END FUNCTION p4z_micro_alloc 
    234250 
    235251#else 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmort.F90

    r2528 r3294  
    1414   !!   p4z_mort_init  :   Initialize the mortality params for phytoplankton 
    1515   !!---------------------------------------------------------------------- 
    16    USE trc 
    17    USE oce_trc         ! 
    18    USE trc         !  
    19    USE sms_pisces      !  
    20    USE p4zsink 
    21    USE prtctl_trc 
     16   USE oce_trc         !  shared variables between ocean and passive tracers 
     17   USE trc             !  passive tracers common variables  
     18   USE sms_pisces      !  PISCES Source Minus Sink variables 
     19   USE p4zsink         !  vertical flux of particulate matter due to sinking 
     20   USE prtctl_trc      !  print control for debugging 
    2221 
    2322   IMPLICIT NONE 
     
    2726   PUBLIC   p4z_mort_init     
    2827 
    29  
    3028   !! * Shared module variables 
    31    REAL(wp), PUBLIC ::   & 
    32      wchl   = 0.001_wp    ,  &  !: 
    33      wchld  = 0.02_wp     ,  &  !: 
    34      mprat  = 0.01_wp     ,  &  !: 
    35      mprat2 = 0.01_wp     ,  &  !: 
    36      mpratm = 0.01_wp           !: 
     29   REAL(wp), PUBLIC :: wchl   = 0.001_wp  !: 
     30   REAL(wp), PUBLIC :: wchld  = 0.02_wp   !: 
     31   REAL(wp), PUBLIC :: mprat  = 0.01_wp   !: 
     32   REAL(wp), PUBLIC :: mprat2 = 0.01_wp   !: 
     33   REAL(wp), PUBLIC :: mpratm = 0.01_wp   !: 
    3734 
    3835 
     
    8077      CHARACTER (len=25) :: charout 
    8178      !!--------------------------------------------------------------------- 
    82  
    83  
    84 #if defined key_diatrc 
    85      prodcal(:,:,:) = 0.  !: Initialisation of calcite production variable 
    86 #endif 
    87  
     79      ! 
     80      IF( nn_timing == 1 )  CALL timing_start('p4z_nano') 
     81      ! 
     82      prodcal(:,:,:) = 0.  !: calcite production variable set to zero 
    8883      DO jk = 1, jpkm1 
    8984         DO jj = 1, jpj 
    9085            DO ji = 1, jpi 
    91  
    9286               zcompaph = MAX( ( trn(ji,jj,jk,jpphy) - 1e-8 ), 0.e0 ) 
    93  
     87               zstep    = xstep 
    9488# if defined key_degrad 
    95                zstep =  xstep * facvol(ji,jj,jk)   
    96 # else 
    97                zstep =  xstep   
     89               zstep    = zstep * facvol(ji,jj,jk) 
    9890# endif 
    9991               !     Squared mortality of Phyto similar to a sedimentation term during 
     
    117109               tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zmortp * zfactfe 
    118110               zprcaca = xfracal(ji,jj,jk) * zmortp 
    119 #if defined key_diatrc 
     111               ! 
    120112               prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
    121 #endif 
     113               ! 
    122114               zfracal = 0.5 * xfracal(ji,jj,jk) 
    123115               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca 
     
    143135         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
    144136       ENDIF 
    145  
     137      ! 
     138      IF( nn_timing == 1 )  CALL timing_stop('p4z_nano') 
     139      ! 
    146140   END SUBROUTINE p4z_nano 
    147141 
     
    158152      REAL(wp) ::  zrespp2, ztortp2, zmortp2, zstep 
    159153      CHARACTER (len=25) :: charout 
    160   
    161       !!--------------------------------------------------------------------- 
    162  
     154      !!--------------------------------------------------------------------- 
     155      ! 
     156      IF( nn_timing == 1 )  CALL timing_start('p4z_diat') 
     157      ! 
    163158 
    164159      !    Aggregation term for diatoms is increased in case of nutrient 
     
    177172               !    sticky and coagulate to sink quickly out of the euphotic zone 
    178173               !     ------------------------------------------------------------ 
    179  
     174               zstep   = xstep 
    180175# if defined key_degrad 
    181                zstep =  xstep * facvol(ji,jj,jk)   
    182 # else 
    183                zstep =  xstep   
     176               zstep = zstep * facvol(ji,jj,jk) 
    184177# endif 
    185178               !  Phytoplankton respiration  
     
    219212      END DO 
    220213      ! 
    221         IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     214      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    222215         WRITE(charout, FMT="('diat')") 
    223216         CALL prt_ctl_trc_info(charout) 
    224217         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
    225        ENDIF 
    226               
     218      ENDIF 
     219      ! 
     220      IF( nn_timing == 1 )  CALL timing_stop('p4z_diat') 
     221      ! 
    227222   END SUBROUTINE p4z_diat 
    228223 
     
    243238      NAMELIST/nampismort/ wchl, wchld, mprat, mprat2, mpratm 
    244239 
    245       REWIND( numnat )                     ! read numnat 
    246       READ  ( numnat, nampismort ) 
     240      REWIND( numnatp )                     ! read numnatp 
     241      READ  ( numnatp, nampismort ) 
    247242 
    248243      IF(lwp) THEN                         ! control print 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zopt.F90

    r2715 r3294  
    77   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
    88   !!             3.2  !  2009-04  (C. Ethe, G. Madec)  optimisation 
     9   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Improve light availability of nano & diat 
    910   !!---------------------------------------------------------------------- 
    1011#if defined  key_pisces 
     
    1718   USE oce_trc        ! tracer-ocean share variables 
    1819   USE sms_pisces     ! Source Minus Sink of PISCES 
    19    USE iom 
     20   USE iom            ! I/O manager 
    2021 
    2122   IMPLICIT NONE 
     
    5253      !! ** Method  : - ??? 
    5354      !!--------------------------------------------------------------------- 
    54       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    55       USE wrk_nemo, ONLY:   zdepmoy => wrk_2d_1 , zetmp => wrk_2d_2 
    56       USE wrk_nemo, ONLY:   zekg    => wrk_3d_2 , zekr  => wrk_3d_3 , zekb => wrk_3d_4 
    57       USE wrk_nemo, ONLY:   ze0     => wrk_3d_5 , ze1   => wrk_3d_6 
    58       USE wrk_nemo, ONLY:   ze2     => wrk_3d_7 , ze3   => wrk_3d_8 
    5955      ! 
    6056      INTEGER, INTENT(in) ::   kt, jnt   ! ocean time step 
     
    6359      INTEGER  ::   irgb 
    6460      REAL(wp) ::   zchl, zxsi0r 
    65       REAL(wp) ::   zc0 , zc1 , zc2, zc3 
     61      REAL(wp) ::   zc0 , zc1 , zc2, zc3, z1_dep 
     62      REAL(wp), POINTER, DIMENSION(:,:  ) :: zdepmoy, zetmp, zetmp1, zetmp2 
     63      REAL(wp), POINTER, DIMENSION(:,:,:) :: zekg, zekr, zekb, ze0, ze1, ze2, ze3 
    6664      !!--------------------------------------------------------------------- 
    67  
    68       IF(  wrk_in_use(2, 1,2)   .OR.   wrk_in_use(3, 2,3,4,5,6,7,8)   ) THEN 
    69          CALL ctl_stop('p4z_opt: requested workspace arrays unavailable')   ;   RETURN 
    70       ENDIF 
     65      ! 
     66      IF( nn_timing == 1 )  CALL timing_start('p4z_opt') 
     67      ! 
     68      ! Allocate temporary workspace 
     69      CALL wrk_alloc( jpi, jpj,      zdepmoy, zetmp, zetmp1, zetmp2       ) 
     70      CALL wrk_alloc( jpi, jpj, jpk, zekg, zekr, zekb, ze0, ze1, ze2, ze3 ) 
    7171 
    7272      !     Initialisation of variables used to compute PAR 
     
    8383            DO ji = 1, jpi 
    8484               zchl = ( trn(ji,jj,jk,jpnch) + trn(ji,jj,jk,jpdch) + rtrn ) * 1.e6 
    85                zchl = MIN(  10. , MAX( 0.03, zchl )  ) 
     85               zchl = MIN(  10. , MAX( 0.05, zchl )  ) 
    8686               irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn ) 
    8787               !                                                          
     
    9292         END DO 
    9393      END DO 
    94  
    95 !!gm  Potential BUG  must discuss with Olivier about this implementation.... 
    96 !!gm           the questions are : - PAR at T-point or mean PAR over T-level.... 
    97 !!gm                               - shallow water: no penetration of light through the bottom.... 
    9894 
    9995 
     
    145141         etot3(:,:,1) =          qsr(:,:) * tmask(:,:,1) 
    146142         ! 
    147          DO jk = 2, nksrp+1 
     143         DO jk = 2, nksrp + 1 
    148144!CDIR NOVERRCHK 
    149145            DO jj = 1, jpj 
     
    188184      zdepmoy(:,:)   = 0.e0                    !  ------------------------------- 
    189185      zetmp  (:,:)   = 0.e0 
    190       emoy   (:,:,:) = 0.e0 
     186      zetmp1 (:,:)   = 0.e0 
     187      zetmp2 (:,:)   = 0.e0 
    191188 
    192189      DO jk = 1, nksrp 
     
    196193            DO ji = 1, jpi 
    197194               IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
    198                   zetmp  (ji,jj) = zetmp  (ji,jj) + etot(ji,jj,jk) * fse3t(ji,jj,jk) 
     195                  zetmp  (ji,jj) = zetmp  (ji,jj) + etot (ji,jj,jk) * fse3t(ji,jj,jk) 
     196                  zetmp1 (ji,jj) = zetmp1 (ji,jj) + enano(ji,jj,jk) * fse3t(ji,jj,jk) 
     197                  zetmp2 (ji,jj) = zetmp2 (ji,jj) + ediat(ji,jj,jk) * fse3t(ji,jj,jk) 
    199198                  zdepmoy(ji,jj) = zdepmoy(ji,jj) + fse3t(ji,jj,jk) 
    200199               ENDIF 
     
    210209!CDIR NOVERRCHK 
    211210            DO ji = 1, jpi 
    212                IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) )   emoy(ji,jj,jk) = zetmp(ji,jj) / ( zdepmoy(ji,jj) + rtrn ) 
    213             END DO 
    214          END DO 
    215       END DO 
    216  
    217 #if defined key_diatrc 
    218 # if ! defined key_iomput 
    219       ! save for outputs 
    220       trc2d(:,:,  jp_pcs0_2d + 10) = heup(:,:  ) * tmask(:,:,1)   
    221       trc3d(:,:,:,jp_pcs0_3d + 3)  = etot(:,:,:) * tmask(:,:,:) 
    222 # else 
    223       ! write diagnostics  
    224       IF( jnt == nrdttrc ) then  
    225          CALL iom_put( "Heup", heup(:,:  ) * tmask(:,:,1) )  ! euphotic layer deptht 
    226          CALL iom_put( "PAR" , etot(:,:,:) * tmask(:,:,:) )  ! Photosynthetically Available Radiation 
     211               IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
     212                  z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 
     213                  emoy (ji,jj,jk) = zetmp (ji,jj) * z1_dep 
     214                  enano(ji,jj,jk) = zetmp1(ji,jj) * z1_dep 
     215                  ediat(ji,jj,jk) = zetmp2(ji,jj) * z1_dep 
     216               ENDIF 
     217            END DO 
     218         END DO 
     219      END DO 
     220 
     221      IF( ln_diatrc ) THEN        ! save output diagnostics 
     222        ! 
     223        IF( lk_iomput ) THEN 
     224           IF( jnt == nrdttrc ) THEN 
     225              CALL iom_put( "Heup", heup(:,:  ) * tmask(:,:,1) )  ! euphotic layer deptht 
     226              CALL iom_put( "PAR" , etot(:,:,:) * tmask(:,:,:) )  ! Photosynthetically Available Radiation 
     227           ENDIF 
     228        ELSE 
     229           trc2d(:,:,  jp_pcs0_2d + 10) = heup(:,:  ) * tmask(:,:,1)   
     230           trc3d(:,:,:,jp_pcs0_3d + 3)  = etot(:,:,:) * tmask(:,:,:) 
     231        ENDIF 
     232        ! 
    227233      ENDIF 
    228 # endif 
    229 #endif 
    230       ! 
    231       IF(  wrk_not_released(2, 1,2)           .OR.   & 
    232            wrk_not_released(3, 2,3,4,5,6,7,8)   )   CALL ctl_stop('p4z_opt: failed to release workspace arrays') 
     234      ! 
     235      CALL wrk_dealloc( jpi, jpj,      zdepmoy, zetmp, zetmp1, zetmp2 ) 
     236      CALL wrk_dealloc( jpi, jpj, jpk, zekg, zekr, zekb, ze0, ze1, ze2, ze3 ) 
     237      ! 
     238      IF( nn_timing == 1 )  CALL timing_stop('p4z_opt') 
    233239      ! 
    234240   END SUBROUTINE p4z_opt 
     
    241247      !! ** Purpose :   Initialization of tabulated attenuation coef 
    242248      !!---------------------------------------------------------------------- 
     249      ! 
     250      IF( nn_timing == 1 )  CALL timing_start('p4z_opt_init') 
    243251      ! 
    244252      CALL trc_oce_rgb( xkrgb )                  ! tabulated attenuation coefficients 
     
    252260      IF( ln_qsr_bio )   etot3(:,:,:) = 0._wp 
    253261      !  
     262      IF( nn_timing == 1 )  CALL timing_stop('p4z_opt_init') 
     263      ! 
    254264   END SUBROUTINE p4z_opt_init 
    255265 
  • trunk/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zprod.F90

    r2730 r3294  
    22   !!====================================================================== 
    33   !!                         ***  MODULE p4zprod  *** 
    4    !! TOP :   PISCES  
     4   !! TOP :  Growth Rate of the two phytoplanktons groups  
    55   !!====================================================================== 
    66   !! History :   1.0  !  2004     (O. Aumont) Original code 
    77   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
     8   !!             3.4  !  2011-05  (O. Aumont, C. Ethe) New parameterization of light limitation 
    89   !!---------------------------------------------------------------------- 
    910#if defined key_pisces 
     
    1112   !!   'key_pisces'                                       PISCES bio-model 
    1213   !!---------------------------------------------------------------------- 
    13    !!   p4z_prod       :   
     14   !!   p4z_prod       :   Compute the growth Rate of the two phytoplanktons groups 
     15   !!   p4z_prod_init  :   Initialization of the parameters for growth 
     16   !!   p4z_prod_alloc :   Allocate variables for growth 
    1417   !!---------------------------------------------------------------------- 
    15    USE trc 
    16    USE oce_trc         ! 
    17    USE sms_pisces      !  
    18    USE prtctl_trc 
    19    USE p4zopt 
    20    USE p4zint 
    21    USE p4zlim 
    22    USE iom 
     18   USE oce_trc         !  shared variables between ocean and passive tracers 
     19   USE trc             !  passive tracers common variables  
     20   USE sms_pisces      !  PISCES Source Minus Sink variables 
     21   USE p4zopt          !  optical model 
     22   USE p4zlim          !  Co-limitations of differents nutrients 
     23   USE prtctl_trc      !  print control for debugging 
     24   USE iom             !  I/O manager 
    2325 
    2426   IMPLICIT NONE 
     
    2931   PUBLIC   p4z_prod_alloc 
    3032 
    31    REAL(wp), PUBLIC ::   & 
    32      pislope   = 3.0_wp          ,  &  !: 
    33      pislope2  = 3.0_wp          ,  &  !: 
    34      excret    = 10.e-5_wp       , &   !: 
    35      excret2   = 0.05_wp         , &   !: 
    36      chlcnm    = 0.033_wp        , &   !: 
    37      chlcdm    = 0.05_wp         , &   !: 
    38      fecnm     = 10.E-6_wp       , &   !: 
    39      fecdm     = 15.E-6_wp       , &   !: 
    40      grosip    = 0.151_wp 
    41  
    42    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   prmax   !: 
     33   !! * Shared module variables 
     34   LOGICAL , PUBLIC ::  ln_newprod = .FALSE. 
     35   REAL(wp), PUBLIC ::  pislope    = 3.0_wp            !: 
     36   REAL(wp), PUBLIC ::  pislope2   = 3.0_wp            !: 
     37   REAL(wp), PUBLIC ::  excret     = 10.e-5_wp         !: 
     38   REAL(wp), PUBLIC ::  excret2    = 0.05_wp           !: 
     39   REAL(wp), PUBLIC ::  bresp      = 0.00333_wp        !: 
     40   REAL(wp), PUBLIC ::  chlcnm     = 0.033_wp          !: 
     41   REAL(wp), PUBLIC ::  chlcdm     = 0.05_wp           !: 
     42   REAL(wp), PUBLIC ::  chlcmin    = 0.00333_wp        !: 
     43   REAL(wp), PUBLIC ::  fecnm      = 10.E-6_wp         !: 
     44   REAL(wp), PUBLIC ::  fecdm      = 15.E-6_wp         !: 
     45   REAL(wp), PUBLIC ::  grosip     = 0.151_wp          !: 
     46 
     47   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   prmax    !: optimal production = f(temperature) 
     48   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   quotan   !: proxy of N quota in Nanophyto 
     49   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   quotad   !: proxy of N quota in diatomee 
    4350    
    44    REAL(wp) ::   & 
    45       rday1                      ,  &  !: 0.6 / rday 
    46       texcret                    ,  &  !: 1 - excret  
    47       texcret2                   ,  &  !: 1 - excret2         
    48       tpp                              !: Total primary production 
     51   REAL(wp) :: r1_rday                !: 1 / rday 
     52   REAL(wp) :: texcret                !: 1 - excret  
     53   REAL(wp) :: texcret2               !: 1 - excret2         
     54   REAL(wp) :: tpp                    !: Total primary production 
     55 
    4956 
    5057   !!* Substitution 
     
    6673      !! ** Method  : - ??? 
    6774      !!--------------------------------------------------------------------- 
    68       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    69       USE wrk_nemo, ONLY:   zmixnano   => wrk_2d_1  , zmixdiat    => wrk_2d_2  , zstrn  => wrk_2d_3 
    70       USE wrk_nemo, ONLY:   zpislopead => wrk_3d_2  , zpislopead2 => wrk_3d_3 
    71       USE wrk_nemo, ONLY:   zprdia     => wrk_3d_4  , zprbio      => wrk_3d_5  , zysopt => wrk_3d_6 
    72       USE wrk_nemo, ONLY:   zprorca    => wrk_3d_7  , zprorcad    => wrk_3d_8 
    73       USE wrk_nemo, ONLY:   zprofed    => wrk_3d_9  , zprofen     => wrk_3d_10 
    74       USE wrk_nemo, ONLY:   zprochln   => wrk_3d_11 , zprochld    => wrk_3d_12 
    75       USE wrk_nemo, ONLY:   zpronew    => wrk_3d_13 , zpronewd    => wrk_3d_14 
    7675      ! 
    7776      INTEGER, INTENT(in) :: kt, jnt 
    7877      ! 
    7978      INTEGER  ::   ji, jj, jk 
    80       REAL(wp) ::   zsilfac, zfact 
    81       REAL(wp) ::   zprdiachl, zprbiochl, zsilim, ztn, zadap, zadap2 
    82       REAL(wp) ::   zlim, zsilfac2, zsiborn, zprod, zetot2, zmax, zproreg, zproreg2 
    83       REAL(wp) ::   zmxltst, zmxlday, zlim1 
     79      REAL(wp) ::   zsilfac, zfact, znanotot, zdiattot, zconctemp, zconctemp2 
     80      REAL(wp) ::   zratio, zmax, zsilim, ztn, zadap 
     81      REAL(wp) ::   zlim, zsilfac2, zsiborn, zprod, zproreg, zproreg2 
     82      REAL(wp) ::   zmxltst, zmxlday, zmaxday 
    8483      REAL(wp) ::   zpislopen  , zpislope2n 
    85       REAL(wp) ::   zrum, zcodel, zargu, zval, zvol 
    86 #if defined key_diatrc 
     84      REAL(wp) ::   zrum, zcodel, zargu, zval 
    8785      REAL(wp) ::   zrfact2 
    88 #endif 
    8986      CHARACTER (len=25) :: charout 
     87      REAL(wp), POINTER, DIMENSION(:,:  ) :: zmixnano, zmixdiat, zstrn 
     88      REAL(wp), POINTER, DIMENSION(:,:,:) :: zpislopead, zpislopead2, zprdia, zprbio, zprdch, zprnch, zysopt    
     89      REAL(wp), POINTER, DIMENSION(:,:,:) :: zprorca, zprorcad, zprofed, zprofen, zprochln, zprochld, zpronew, zpronewd 
    9090      !!--------------------------------------------------------------------- 
    91  
    92       IF( wrk_in_use(2, 1,2,3)                             .OR.  & 
    93           wrk_in_use(3, 2,3,4,5,6,7,8,9,10,11,12,13,14)  ) THEN 
    94           CALL ctl_stop('p4z_prod: requested workspace arrays unavailable')   ;   RETURN 
    95       ENDIF 
    96  
     91      ! 
     92      IF( nn_timing == 1 )  CALL timing_start('p4z_prod') 
     93      ! 
     94      !  Allocate temporary workspace 
     95      CALL wrk_alloc( jpi, jpj,      zmixnano, zmixdiat, zstrn                                                  ) 
     96      CALL wrk_alloc( jpi, jpj, jpk, zpislopead, zpislopead2, zprdia, zprbio, zprdch, zprnch, zysopt            )  
     97      CALL wrk_alloc( jpi, jpj, jpk, zprorca, zprorcad, zprofed, zprofen, zprochln, zprochld, zpronew, zpronewd ) 
     98      ! 
    9799      zprorca (:,:,:) = 0._wp 
    98100      zprorcad(:,:,:) = 0._wp 
     
    105107      zprdia  (:,:,:) = 0._wp 
    106108      zprbio  (:,:,:) = 0._wp 
     109      zprdch  (:,:,:) = 0._wp 
     110      zprnch  (:,:,:) = 0._wp 
    107111      zysopt  (:,:,:) = 0._wp 
    108112 
    109113      ! Computation of the optimal production 
    110 # if defined key_degrad 
    111       prmax(:,:,:) = rday1 * tgfunc(:,:,:) * facvol(:,:,:) 
    112 # else 
    113       prmax(:,:,:) = rday1 * tgfunc(:,:,:) 
    114 # endif 
     114      prmax(:,:,:) = 0.6_wp * r1_rday * tgfunc(:,:,:)  
     115      IF( lk_degrad )  prmax(:,:,:) = prmax(:,:,:) * facvol(:,:,:)  
    115116 
    116117      ! compute the day length depending on latitude and the day 
     
    119120 
    120121      ! day length in hours 
    121       zstrn(:,:) = 0._wp 
     122      zstrn(:,:) = 0. 
    122123      DO jj = 1, jpj 
    123124         DO ji = 1, jpi 
    124125            zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad ) 
    125126            zargu = MAX( -1., MIN(  1., zargu ) ) 
    126             zval  = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. ) 
    127             IF( zval < 1.e0 )   zval = 24. 
    128             zstrn(ji,jj) = 24. / zval 
     127            zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. ) 
    129128         END DO 
    130129      END DO 
    131130 
    132  
     131      IF( ln_newprod ) THEN 
     132         ! Impact of the day duration on phytoplankton growth 
     133         DO jk = 1, jpkm1 
     134            DO jj = 1 ,jpj 
     135               DO ji = 1, jpi 
     136                  zval = MAX( 1., zstrn(ji,jj) ) 
     137                  zval = 1.5 * zval / ( 12. + zval ) 
     138                  zprbio(ji,jj,jk) = prmax(ji,jj,jk) * zval 
     139                  zprdia(ji,jj,jk) = zprbio(ji,jj,jk) 
     140               END DO 
     141            END DO 
     142         END DO 
     143      ENDIF 
     144 
     145      ! Maximum light intensity 
     146      WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24. 
     147      zstrn(:,:) = 24. / zstrn(:,:) 
     148 
     149      IF( ln_newprod ) THEN 
     150!CDIR NOVERRCHK 
     151         DO jk = 1, jpkm1 
     152!CDIR NOVERRCHK 
     153            DO jj = 1, jpj 
     154!CDIR NOVERRCHK 
     155               DO ji = 1, jpi 
     156 
     157                  ! Computation of the P-I slope for nanos and diatoms 
     158                  IF( etot(ji,jj,jk) > 1.E-3 ) THEN 
     159                      ztn    = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 
     160                      zadap  = ztn / ( 2.+ ztn ) 
     161 
     162                      zconctemp   = MAX( 0.e0 , trn(ji,jj,jk,jpdia) - 5e-7 ) 
     163                      zconctemp2  = trn(ji,jj,jk,jpdia) - zconctemp 
     164 
     165                      znanotot = enano(ji,jj,jk) * zstrn(ji,jj) 
     166                      zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj) 
     167 
     168                      zfact  = EXP( -0.21 * znanotot ) 
     169                      zpislopead (ji,jj,jk) = pislope  * ( 1.+ zadap  * zfact )  & 
     170                         &                   * trn(ji,jj,jk,jpnch) /( trn(ji,jj,jk,jpphy) * 12. + rtrn) 
     171 
     172                      zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp) / ( trn(ji,jj,jk,jpdia) + rtrn )   & 
     173                         &                   * trn(ji,jj,jk,jpdch) /( trn(ji,jj,jk,jpdia) * 12. + rtrn) 
     174 
     175                      ! Computation of production function for Carbon 
     176                      !  --------------------------------------------- 
     177                      zpislopen  = zpislopead (ji,jj,jk) / ( ( r1_rday + bresp * r1_rday / chlcnm ) * rday + rtrn) 
     178                      zpislope2n = zpislopead2(ji,jj,jk) / ( ( r1_rday + bresp * r1_rday / chlcdm ) * rday + rtrn) 
     179                      zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen  * znanotot )  ) 
     180                      zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpislope2n * zdiattot )  ) 
     181 
     182                      !  Computation of production function for Chlorophyll 
     183                      !-------------------------------------------------- 
     184                      zmaxday  = 1._wp / ( prmax(ji,jj,jk) * rday + rtrn ) 
     185                      zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopead (ji,jj,jk) * zmaxday * znanotot ) ) 
     186                      zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopead2(ji,jj,jk) * zmaxday * zdiattot ) ) 
     187                  ENDIF 
     188               END DO 
     189            END DO 
     190         END DO 
     191      ELSE 
     192!CDIR NOVERRCHK 
     193         DO jk = 1, jpkm1 
     194!CDIR NOVERRCHK 
     195            DO jj = 1, jpj 
     196!CDIR NOVERRCHK 
     197               DO ji = 1, jpi 
     198 
     199                  ! Computation of the P-I slope for nanos and diatoms 
     200                  IF( etot(ji,jj,jk) > 1.E-3 ) THEN 
     201                      ztn    = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 
     202                      zadap  = ztn / ( 2.+ ztn ) 
     203 
     204                      zfact  = EXP( -0.21 * enano(ji,jj,jk) ) 
     205                      zpislopead (ji,jj,jk) = pislope  * ( 1.+ zadap  * zfact ) 
     206                      zpislopead2(ji,jj,jk) = pislope2 
     207 
     208                      zpislopen =  zpislopead(ji,jj,jk) * trn(ji,jj,jk,jpnch)                & 
     209                        &          / ( trn(ji,jj,jk,jpphy) * 12.                  + rtrn )   & 
     210                        &          / ( prmax(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn ) 
     211 
     212                      zpislope2n = zpislopead2(ji,jj,jk) * trn(ji,jj,jk,jpdch)                & 
     213                        &          / ( trn(ji,jj,jk,jpdia) * 12.                  + rtrn )   & 
     214                        &          / ( prmax(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn ) 
     215 
     216                      ! Computation of production function for Carbon 
     217                      !  --------------------------------------------- 
     218                      zprbio(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen  * enano(ji,jj,jk) ) ) 
     219                      zprdia(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope2n * ediat(ji,jj,jk) ) ) 
     220 
     221                      !  Computation of production function for Chlorophyll 
     222                      !-------------------------------------------------- 
     223                      zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen  * enano(ji,jj,jk) * zstrn(ji,jj) ) ) 
     224                      zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope2n * ediat(ji,jj,jk) * zstrn(ji,jj) ) ) 
     225                  ENDIF 
     226               END DO 
     227            END DO 
     228         END DO 
     229      ENDIF 
     230 
     231      !  Computation of a proxy of the N/C ratio 
     232      !  --------------------------------------- 
    133233!CDIR NOVERRCHK 
    134234      DO jk = 1, jpkm1 
     
    137237!CDIR NOVERRCHK 
    138238            DO ji = 1, jpi 
    139  
    140                ! Computation of the P-I slope for nanos and diatoms 
    141                IF( etot(ji,jj,jk) > 1.E-3 ) THEN 
    142                    ztn    = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 
    143                    zadap  = 0.+ 1.* ztn / ( 2.+ ztn ) 
    144                    zadap2 = 0.e0 
    145  
    146                    zfact  = EXP( -0.21 * emoy(ji,jj,jk) ) 
    147  
    148                    zpislopead (ji,jj,jk) = pislope  * ( 1.+ zadap  * zfact ) 
    149                    zpislopead2(ji,jj,jk) = pislope2 * ( 1.+ zadap2 * zfact ) 
    150  
    151                    zpislopen = zpislopead(ji,jj,jk) * trn(ji,jj,jk,jpnch)                 & 
    152                      &         / ( trn(ji,jj,jk,jpphy) * 12.                   + rtrn )   & 
    153                      &         / ( prmax(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn ) 
    154  
    155                    zpislope2n = zpislopead2(ji,jj,jk) * trn(ji,jj,jk,jpdch)                & 
    156                      &          / ( trn(ji,jj,jk,jpdia) * 12.                   + rtrn )   & 
    157                      &          / ( prmax(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn ) 
    158  
    159                    ! Computation of production function 
    160                    zprbio(ji,jj,jk) = prmax(ji,jj,jk) * & 
    161                      &                (  1.- EXP( -zpislopen * enano(ji,jj,jk) )  ) 
    162                    zprdia(ji,jj,jk) = prmax(ji,jj,jk) * & 
    163                      &                (  1.- EXP( -zpislope2n * ediat(ji,jj,jk) )  ) 
    164                ENDIF 
     239                zval = ( xnanonh4(ji,jj,jk) + xnanono3(ji,jj,jk) ) * prmax(ji,jj,jk) / ( zprbio(ji,jj,jk) + rtrn ) 
     240                quotan(ji,jj,jk) = MIN( 1., 0.5 + 0.5 * zval ) 
     241                zval = ( xdiatnh4(ji,jj,jk) + xdiatno3(ji,jj,jk) ) * prmax(ji,jj,jk) / ( zprdia(ji,jj,jk) + rtrn ) 
     242                quotad(ji,jj,jk) = MIN( 1., 0.5 + 0.5 * zval ) 
    165243            END DO 
    166244         END DO 
     
    178256                   !    Si/C is arbitrariliy increased for very high Si concentrations 
    179257                   !    to mimic the very high ratios observed in the Southern Ocean (silpot2) 
    180  
    181                   zlim1  = trn(ji,jj,jk,jpsil) / ( trn(ji,jj,jk,jpsil) + xksi1 ) 
    182                   zlim   = xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) 
    183  
    184                   zsilim = MIN( zprdia(ji,jj,jk)    / ( rtrn + prmax(ji,jj,jk) ),                 & 
    185                   &          trn(ji,jj,jk,jpfer) / ( concdfe(ji,jj,jk) + trn(ji,jj,jk,jpfer) ),   & 
    186                   &          trn(ji,jj,jk,jppo4) / ( concdnh4 + trn(ji,jj,jk,jppo4) ),            & 
    187                   &          zlim ) 
    188                   zsilfac = 5.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim1 - 0.5 ) )  ) + 1.e0 
     258                  zlim  = trn(ji,jj,jk,jpsil) / ( trn(ji,jj,jk,jpsil) + xksi1 ) 
     259                  zsilim = MIN( zprdia(ji,jj,jk) / ( prmax(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) ) 
     260                  zsilfac = 4.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) )  ) + 1.e0 
    189261                  zsiborn = MAX( 0.e0, ( trn(ji,jj,jk,jpsil) - 15.e-6 ) ) 
    190                   zsilfac2 = 1.+ 3.* zsiborn / ( zsiborn + xksi2 ) 
    191                   zsilfac = MIN( 6.4,zsilfac * zsilfac2) 
    192                   zysopt(ji,jj,jk) = grosip * zlim1 * zsilfac 
     262                  zsilfac2 = 1.+ 2.* zsiborn / ( zsiborn + xksi2 ) 
     263                  zsilfac = MIN( 5.4, zsilfac * zsilfac2) 
     264                  zysopt(ji,jj,jk) = grosip * zlim * zsilfac 
    193265              ENDIF 
    194266            END DO 
     
    196268      END DO 
    197269 
    198       !  Computation of the limitation term due to 
    199       !  A mixed layer deeper than the euphotic depth 
     270      !  Computation of the limitation term due to a mixed layer deeper than the euphotic depth 
    200271      DO jj = 1, jpj 
    201272         DO ji = 1, jpi 
    202273            zmxltst = MAX( 0.e0, hmld(ji,jj) - heup(ji,jj) ) 
    203             zmxlday = zmxltst**2 / rday 
    204             zmixnano(ji,jj) = 1.- zmxlday / ( 1.+ zmxlday ) 
    205             zmixdiat(ji,jj) = 1.- zmxlday / ( 3.+ zmxlday ) 
     274            zmxlday = zmxltst * zmxltst * r1_rday 
     275            zmixnano(ji,jj) = 1. - zmxlday / ( 3. + zmxlday ) 
     276            zmixdiat(ji,jj) = 1. - zmxlday / ( 4. + zmxlday ) 
    206277         END DO 
    207278      END DO 
     
    219290      END DO 
    220291 
    221  
    222 !CDIR NOVERRCHK 
    223       DO jk = 1, jpkm1 
    224 !CDIR NOVERRCHK 
    225          DO jj = 1, jpj 
    226 !CDIR NOVERRCHK 
    227             DO ji = 1, jpi 
    228  
    229                IF( etot(ji,jj,jk) > 1.E-3 ) THEN 
    230                   !     Computation of the various production terms for nanophyto. 
    231                   zetot2 = enano(ji,jj,jk) * zstrn(ji,jj) 
    232                   zmax = MAX( 0.1, xlimphy(ji,jj,jk) ) 
    233                   zpislopen = zpislopead(ji,jj,jk)          & 
    234                   &         * trn(ji,jj,jk,jpnch) / ( rtrn + trn(ji,jj,jk,jpphy) * 12.)         & 
    235                   &         / ( prmax(ji,jj,jk) * rday * zmax + rtrn ) 
    236  
    237                   zprbiochl = prmax(ji,jj,jk) * (  1.- EXP( -zpislopen * zetot2 )  ) 
    238  
    239                   zprorca(ji,jj,jk) = zprbio(ji,jj,jk)  * xlimphy(ji,jj,jk) * trn(ji,jj,jk,jpphy) * rfact2 
    240  
    241                   zpronew(ji,jj,jk) = zprorca(ji,jj,jk) * xnanono3(ji,jj,jk)    & 
    242                   &             / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn ) 
    243                   zprod = rday * zprorca(ji,jj,jk) * zprbiochl * trn(ji,jj,jk,jpphy) *zmax 
    244  
    245                   zprofen(ji,jj,jk) = (fecnm)**2 * zprod / chlcnm            & 
    246                   &              / (  zpislopead(ji,jj,jk) * zetot2 * trn(ji,jj,jk,jpnfe) + rtrn  ) 
    247  
    248                   zprochln(ji,jj,jk) = chlcnm * 144. * zprod                  & 
    249                   &              / (  zpislopead(ji,jj,jk) * zetot2 * trn(ji,jj,jk,jpnch) + rtrn  ) 
    250                ENDIF 
    251             END DO 
    252          END DO 
    253       END DO 
    254  
     292      ! Computation of the various production terms  
    255293!CDIR NOVERRCHK 
    256294      DO jk = 1, jpkm1 
     
    260298            DO ji = 1, jpi 
    261299               IF( etot(ji,jj,jk) > 1.E-3 ) THEN 
    262                   !  Computation of the various production terms for diatoms 
    263                   zetot2 = ediat(ji,jj,jk) * zstrn(ji,jj) 
    264                   zmax = MAX( 0.1, xlimdia(ji,jj,jk) ) 
    265                   zpislope2n = zpislopead2(ji,jj,jk) * trn(ji,jj,jk,jpdch)        & 
    266                   &           / ( rtrn + trn(ji,jj,jk,jpdia) * 12.)        & 
    267                   &           / ( prmax(ji,jj,jk) * rday * zmax + rtrn ) 
    268  
    269                   zprdiachl = prmax(ji,jj,jk) * (  1.- EXP( -zetot2 * zpislope2n )  ) 
    270  
     300                  !  production terms for nanophyto. 
     301                  zprorca(ji,jj,jk) = zprbio(ji,jj,jk)  * xlimphy(ji,jj,jk) * trn(ji,jj,jk,jpphy) * rfact2 
     302                  zpronew(ji,jj,jk) = zprorca(ji,jj,jk) * xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn ) 
     303                  ! 
     304                  zratio = trn(ji,jj,jk,jpnfe) / ( trn(ji,jj,jk,jpphy) + rtrn ) 
     305                  zratio = zratio / fecnm  
     306                  zmax   = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) )  
     307                  zprofen(ji,jj,jk) = fecnm * prmax(ji,jj,jk)  & 
     308                  &             * ( 4. - 4.5 * xlimnfe(ji,jj,jk) / ( xlimnfe(ji,jj,jk) + 0.5 ) )    & 
     309                  &             * trn(ji,jj,jk,jpfer) / ( trn(ji,jj,jk,jpfer) + concnfe(ji,jj,jk) )  & 
     310                  &             * zmax * trn(ji,jj,jk,jpphy) * rfact2 
     311                  !  production terms for diatomees 
    271312                  zprorcad(ji,jj,jk) = zprdia(ji,jj,jk) * xlimdia(ji,jj,jk) * trn(ji,jj,jk,jpdia) * rfact2 
    272  
    273                   zpronewd(ji,jj,jk) = zprorcad(ji,jj,jk) * xdiatno3(ji,jj,jk)     & 
    274                   &              / ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) + rtrn ) 
    275  
    276                   zprod = rday * zprorcad(ji,jj,jk) * zprdiachl * trn(ji,jj,jk,jpdia) * zmax 
    277  
    278                   zprofed(ji,jj,jk) = (fecdm)**2 * zprod / chlcdm                   & 
    279                   &              / ( zpislopead2(ji,jj,jk) * zetot2 * trn(ji,jj,jk,jpdfe) + rtrn ) 
    280  
    281                   zprochld(ji,jj,jk) = chlcdm * 144. * zprod       & 
    282                   &              / ( zpislopead2(ji,jj,jk) * zetot2 * trn(ji,jj,jk,jpdch) + rtrn ) 
    283  
     313                  zpronewd(ji,jj,jk) = zprorcad(ji,jj,jk) * xdiatno3(ji,jj,jk) / ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) + rtrn ) 
     314                  ! 
     315                  zratio = trn(ji,jj,jk,jpdfe) / ( trn(ji,jj,jk,jpdia) + rtrn ) 
     316                  zratio = zratio / fecdm  
     317                  zmax   = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) )  
     318                  zprofed(ji,jj,jk) = fecdm * prmax(ji,jj,jk)  & 
     319                  &             * ( 4. - 4.5 * xlimdfe(ji,jj,jk) / ( xlimdfe(ji,jj,jk) + 0.5 ) )    & 
     320                  &             * trn(ji,jj,jk,jpfer) / ( trn(ji,jj,jk,jpfer) + concdfe(ji,jj,jk) )  & 
     321                  &             * zmax * trn(ji,jj,jk,jpdia) * rfact2 
    284322               ENDIF 
    285323            END DO 
    286324         END DO 
    287325      END DO 
    288       ! 
     326 
     327      IF( ln_newprod ) THEN 
     328!CDIR NOVERRCHK 
     329         DO jk = 1, jpkm1 
     330!CDIR NOVERRCHK 
     331            DO jj = 1, jpj 
     332!CDIR NOVERRCHK 
     333               DO ji = 1, jpi 
     334                  IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
     335                     zprnch(ji,jj,jk) = zprnch(ji,jj,jk) * zmixnano(ji,jj) 
     336                     zprdch(ji,jj,jk) = zprdch(ji,jj,jk) * zmixdiat(ji,jj) 
     337                  ENDIF 
     338                  IF( etot(ji,jj,jk) > 1.E-3 ) THEN 
     339                     !  production terms for nanophyto. ( chlorophyll ) 
     340                     znanotot = enano(ji,jj,jk) * zstrn(ji,jj) 
     341                     zprod    = rday * zprorca(ji,jj,jk) * zprnch(ji,jj,jk) * xlimphy(ji,jj,jk) 
     342                     zprochln(ji,jj,jk) = chlcmin * 12. * zprorca (ji,jj,jk) 
     343                     zprochln(ji,jj,jk) = zprochln(ji,jj,jk) + chlcnm * 12. * zprod / (  zpislopead(ji,jj,jk) * znanotot +rtrn) 
     344                     !  production terms for diatomees ( chlorophyll ) 
     345                     zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj) 
     346                     zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * xlimdia(ji,jj,jk) 
     347                     zprochld(ji,jj,jk) = chlcmin * 12. * zprorcad(ji,jj,jk) 
     348                     zprochld(ji,jj,jk) = zprochld(ji,jj,jk) + chlcdm * 12. * zprod / ( zpislopead2(ji,jj,jk) * zdiattot +rtrn ) 
     349                  ENDIF 
     350               END DO 
     351            END DO 
     352         END DO 
     353      ELSE 
     354!CDIR NOVERRCHK 
     355         DO jk = 1, jpkm1 
     356!CDIR NOVERRCHK 
     357            DO jj = 1, jpj 
     358!CDIR NOVERRCHK 
     359               DO ji = 1, jpi 
     360                  IF( etot(ji,jj,jk) > 1.E-3 ) THEN 
     361                     !  production terms for nanophyto. ( chlorophyll ) 
     362                     znanotot = enano(ji,jj,jk) * zstrn(ji,jj) 
     363                     zprod = rday * zprorca(ji,jj,jk) * zprnch(ji,jj,jk) * trn(ji,jj,jk,jpphy) * xlimphy(ji,jj,jk) 
     364                     zprochln(ji,jj,jk) = chlcnm * 144. * zprod / (  zpislopead(ji,jj,jk) * trn(ji,jj,jk,jpnch) * znanotot +rtrn) 
     365                     !  production terms for diatomees ( chlorophyll ) 
     366                     zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj) 
     367                     zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * trn(ji,jj,jk,jpdia) * xlimdia(ji,jj,jk) 
     368                     zprochld(ji,jj,jk) = chlcdm * 144. * zprod / ( zpislopead2(ji,jj,jk) * trn(ji,jj,jk,jpdch) * zdiattot +rtrn ) 
     369                  ENDIF 
     370               END DO 
     371            END DO 
     372         END DO 
     373      ENDIF 
    289374 
    290375      !   Update the arrays TRA which contain the biological sources and sinks 
     
    304389              tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) + zprofed(ji,jj,jk) * texcret2 
    305390              tra(ji,jj,jk,jpbsi) = tra(ji,jj,jk,jpbsi) + zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) * texcret2 
    306               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + & 
    307               &                     excret2 * zprorcad(ji,jj,jk) + excret * zprorca(ji,jj,jk) 
     391              tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + excret2 * zprorcad(ji,jj,jk) + excret * zprorca(ji,jj,jk) 
    308392              tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) + o2ut * ( zproreg + zproreg2) & 
    309               &                    + ( o2ut + o2nit ) * ( zpronew(ji,jj,jk) + zpronewd(ji,jj,jk) ) 
    310               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) & 
    311               &                     - texcret * zprofen(ji,jj,jk) - texcret2 * zprofed(ji,jj,jk) 
    312               tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) & 
    313               &                     - texcret2 * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 
     393                 &                + ( o2ut + o2nit ) * ( zpronew(ji,jj,jk) + zpronewd(ji,jj,jk) ) 
     394              tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - texcret * zprofen(ji,jj,jk) - texcret2 * zprofed(ji,jj,jk) 
     395              tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) - texcret2 * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 
    314396              tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprorca(ji,jj,jk) - zprorcad(ji,jj,jk) 
    315               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) & 
    316               &                    + rno3 * ( zpronew(ji,jj,jk) + zpronewd(ji,jj,jk) ) 
     397              tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zpronew(ji,jj,jk) + zpronewd(ji,jj,jk) ) & 
     398                 &                                      - rno3 * ( zproreg + zproreg2 ) 
    317399          END DO 
    318400        END DO 
     
    320402 
    321403     ! Total primary production per year 
    322  
    323 #if defined key_degrad 
    324      tpp = tpp + glob_sum( ( zprorca(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) * facvol(:,:,:) ) 
    325 #else 
    326404     tpp = tpp + glob_sum( ( zprorca(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) ) 
    327 #endif 
    328  
    329      IF( kt == nitend .AND. jnt == nrdttrc .AND. lwp ) THEN 
     405 
     406     IF( kt == nitend .AND. jnt == nrdttrc ) THEN 
    330407        WRITE(numout,*) 'Total PP (Gtc) :' 
    331408        WRITE(numout,*) '-------------------- : ',tpp * 12. / 1.E12 
     
    333410      ENDIF 
    334411 
    335 #if defined key_diatrc && ! defined key_iomput 
    336       !   Supplementary diagnostics 
    337       zrfact2 = 1.e3 * rfact2r 
    338       trc3d(:,:,:,jp_pcs0_3d + 4)  = zprorca (:,:,:) * zrfact2 * tmask(:,:,:) 
    339       trc3d(:,:,:,jp_pcs0_3d + 5)  = zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) 
    340       trc3d(:,:,:,jp_pcs0_3d + 6)  = zpronew (:,:,:) * zrfact2 * tmask(:,:,:) 
    341       trc3d(:,:,:,jp_pcs0_3d + 7)  = zpronewd(:,:,:) * zrfact2 * tmask(:,:,:) 
    342       trc3d(:,:,:,jp_pcs0_3d + 8)  = zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) * zysopt(:,:,:) 
    343       trc3d(:,:,:,jp_pcs0_3d + 9)  = zprofed (:,:,:) * zrfact2 * tmask(:,:,:) 
     412     IF( ln_diatrc ) THEN 
     413         ! 
     414         zrfact2 = 1.e3 * rfact2r 
     415         IF( lk_iomput ) THEN 
     416           IF( jnt == nrdttrc ) THEN 
     417              CALL iom_put( "PPPHY" , zprorca (:,:,:) * zrfact2 * tmask(:,:,:) )  ! primary production by nanophyto 
     418              CALL iom_put( "PPPHY2", zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) )  ! primary production by diatom 
     419              CALL iom_put( "PPNEWN", zpronew (:,:,:) * zrfact2 * tmask(:,:,:) )  ! new primary production by nanophyto 
     420              CALL iom_put( "PPNEWD", zpronewd(:,:,:) * zrfact2 * tmask(:,:,:) )  ! new primary production by diatom 
     421              CALL iom_put( "PBSi"  , zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) * zysopt(:,:,:) ) ! biogenic silica production 
     422              CALL iom_put( "PFeD"  , zprofed (:,:,:) * zrfact2 * tmask(:,:,:) )  ! biogenic iron production by diatom 
     423              CALL iom_put( "PFeN"  , zprofen (:,:,:) * zrfact2 * tmask(:,:,:) )  ! biogenic iron production by nanophyto 
     424           ENDIF 
     425         ELSE 
     426              trc3d(:,:,:,jp_pcs0_3d + 4)  = zprorca (:,:,:) * zrfact2 * tmask(:,:,:) 
     427              trc3d(:,:,:,jp_pcs0_3d + 5)  = zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) 
     428              trc3d(:,:,:,jp_pcs0_3d + 6)  = zpronew (:,:,:) * zrfact2 * tmask(:,:,:) 
     429              trc3d(:,:,:,jp_pcs0_3d + 7)  = zpronewd(:,:,:) * zrfact2 * tmask(:,:,:) 
     430              trc3d(:,:,:,jp_pcs0_3d + 8)  = zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) * zysopt(:,:,:) 
     431              trc3d(:,:,:,jp_pcs0_3d + 9)  = zprofed (:,:,:) * zrfact2 * tmask(:,:,:) 
    344432#  if ! defined key_kriest 
    345       trc3d(:,:,:,jp_pcs0_3d + 10) = zprofen (:,:,:) * zrfact2 * tmask(:,:,:) 
     433              trc3d(:,:,:,jp_pcs0_3d + 10) = zprofen (:,:,:) * zrfact2 * tmask(:,:,:) 
    346434#  endif 
    347 #endif 
    348  
    349 #if defined key_diatrc && defined key_iomput 
    350       zrfact2 = 1.e3 * rfact2r 
    351       IF ( jnt == nrdttrc ) then 
    352          CALL iom_put( "PPPHY" , zprorca (:,:,:) * zrfact2 * tmask(:,:,:) )  ! primary production by nanophyto 
    353          CALL iom_put( "PPPHY2", zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) )  ! primary production by diatom 
    354          CALL iom_put( "PPNEWN", zpronew (:,:,:) * zrfact2 * tmask(:,:,:) )  ! new primary production by nanophyto 
    355          CALL iom_put( "PPNEWD", zpronewd(:,:,:) * zrfact2 * tmask(:,:,:) )  ! new primary production by diatom 
    356          CALL iom_put( "PBSi"  , zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) * zysopt(:,:,:) ) ! biogenic silica production 
    357          CALL iom_put( "PFeD"  , zprofed (:,:,:) * zrfact2 * tmask(:,:,:) )  ! biogenic iron production by diatom 
    358          CALL iom_put( "PFeN"  , zprofen (:,:,:) * zrfact2 * tmask(:,:,:) )  ! biogenic iron production by nanophyto 
    359       ENDIF 
    360 #endif 
     435         ENDIF 
     436         ! 
     437      ENDIF 
    361438 
    362439      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     
    365442         CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
    366443      ENDIF 
    367  
    368       IF(  wrk_not_released(2, 1,2,3)                          .OR.  & 
    369            wrk_not_released(3, 2,3,4,5,6,7,8,9,10,11,12,13,14)   )   & 
    370            CALL ctl_stop('p4z_prod: failed to release workspace arrays') 
     444      ! 
     445      CALL wrk_dealloc( jpi, jpj,      zmixnano, zmixdiat, zstrn                                                  ) 
     446      CALL wrk_dealloc( jpi, jpj, jpk, zpislopead, zpislopead2, zprdia, zprbio, zprdch, zprnch, zysopt            )  
     447      CALL wrk_dealloc( jpi, jpj, jpk, zprorca, zprorcad, zprofed, zprofen, zprochln, zprochld, zpronew, zpronewd ) 
     448      ! 
     449      IF( nn_timing == 1 )  CALL timing_stop('p4z_prod') 
    371450      ! 
    372451   END SUBROUTINE p4z_prod 
     
    380459      !! 
    381460      !! ** Method  :   Read the nampisprod namelist and check the parameters 
    382       !!      called at the first timestep (nit000) 
     461      !!      called at the first timestep (nittrc000) 
    383462      !! 
    384463      !! ** input   :   Namelist nampisprod 
    385464      !!---------------------------------------------------------------------- 
    386       NAMELIST/nampisprod/ pislope, pislope2, excret, excret2, chlcnm, chlcdm,   & 
    387          &              fecnm, fecdm, grosip 
     465      ! 
     466      NAMELIST/nampisprod/ pislope, pislope2, ln_newprod, bresp, excret, excret2,  & 
     467         &                 chlcnm, chlcdm, chlcmin, fecnm, fecdm, grosip 
    388468      !!----------------------------------------------------------------------