New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 2977 for branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC – NEMO

Ignore:
Timestamp:
2011-10-22T15:46:41+02:00 (13 years ago)
Author:
cetlod
Message:

Add in branch 2011/dev_LOCEAN_2011 changes from 2011/dev_r2787_PISCES_improvment, 2011/dev_r2787_LOCEAN_offline_fldread and 2011/dev_r2787_LOCEAN3_TRA_TRP branches, see ticket #877

Location:
branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC
Files:
46 edited

Legend:

Unmodified
Added
Removed

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/C14b/trcini_c14b.F90

    r2715 r2977  
    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 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/C14b/trcnam_c14b.F90

    r2715 r2977  
    1616   USE trc             ! TOP variables 
    1717   USE trcsms_c14b     ! C14b specific variable 
     18   USE iom             ! I/O manager 
    1819 
    1920   IMPLICIT NONE 
    … …  
    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 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90

    r2715 r2977  
    246246#endif 
    247247                  &                      * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) ) / 2. 
    248  
    249248            ! Add the surface flux to the trend 
    250249            tra(ji,jj,1,jpc14) = tra(ji,jj,1,jpc14) + qtr_c14(ji,jj) / fse3t(ji,jj,1)  
    … …  
    253252            qint_c14(ji,jj) = qint_c14(ji,jj) + qtr_c14(ji,jj) * rdt 
    254253 
    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            !                                        ! Save 2D diagnostics 
     255            IF( .NOT.lk_iomput .AND. ln_diatrc ) THEN 
     256               trc2d(ji,jj,jp_c14b0_2d    ) = qtr_c14 (ji,jj) 
     257               trc2d(ji,jj,jp_c14b0_2d + 1) = qint_c14(ji,jj) 
     258            ENDIF  
     259            ! 
    260260         END DO 
    261261      END DO 
    … …  
    265265         DO jj = 1, jpj 
    266266            DO ji = 1, jpi 
    267 #if ! defined key_degrad 
     267#if defined key_degrad 
     268               ztra = trn(ji,jj,jk,jpc14) * ( 1. - EXP( -xlambda * rdt * facvol(ji,jj,jk) ) ) 
     269#else 
    268270               ztra = trn(ji,jj,jk,jpc14) * xaccum 
    269 #else 
    270                ztra = trn(ji,jj,jk,jpc14) * ( 1. - EXP( -xlambda * rdt * facvol(ji,jj,jk) ) ) 
    271271#endif 
    272272               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 
     273               !                                     ! save 3D diag : radioactive decay 
     274               IF( ln_diatrc ) THEN 
     275                  IF( lk_iomput ) THEN   ;   zw3d(ji,jj,jk)               = ztra 
     276                  ELSE                   ;   trc3d(ji,jj,jk,jp_c14b0_3d ) = ztra 
     277                  ENDIF 
     278               ENDIF 
     279               ! 
    281280            END DO 
    282281         END DO 
    283282      END DO 
    284283 
    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 
     284      IF( lk_iomput ) THEN 
     285         CALL iom_put( "qtrC14b"  , qtr_c14  ) 
     286         CALL iom_put( "qintC14b" , qint_c14 ) 
     287         CALL iom_put( "fdecay"   , zw3d     ) 
     288      ENDIF 
     289 
     290      IF( l_trdtrc )  CALL trd_mod_trc( tra(:,:,:,jpc14), jpc14, jptra_trd_sms, kt )   ! save trends 
    293291 
    294292      IF( wrk_not_released(2, 1) .OR.   & 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/CFC/par_cfc.F90

    r2528 r2977  
    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') 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/CFC/trcini_cfc.F90

    r2715 r2977  
    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 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/CFC/trcnam_cfc.F90

    r2715 r2977  
    1616   USE trc             ! TOP variables 
    1717   USE trcsms_cfc      ! CFC specific variable 
     18   USE iom             ! I/O manager 
    1819 
    1920   IMPLICIT NONE 
    … …  
    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 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/CFC/trcsms_cfc.F90

    r2715 r2977  
    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      ALLOCATE( zpatm(jphem,jp_cfc), STAT=ierr ) 
     94      IF( ierr > 0 ) THEN 
     95         CALL ctl_stop( 'trc_sms_cfc: unable to allocate zpatm array' )   ;   RETURN 
    9796      ENDIF 
    9897 
    … …  
    158157 
    159158               ! Input function  : speed *( conc. at equil - concen at surface ) 
    160                ! trn in pico-mol/l idem qtr; ak in en m/s 
     159               ! trn in pico-mol/l idem qtr; ak in en m/a 
    161160               qtr_cfc(ji,jj,jl) = -zak_cfc * ( trb(ji,jj,1,jn) - zca_cfc )   & 
    162161#if defined key_degrad 
    … …  
    164163#endif 
    165164                  &                         * tmask(ji,jj,1) * ( 1. - fr_i(ji,jj) ) 
    166  
    167165               ! Add the surface flux to the trend 
    168166               tra(ji,jj,1,jn) = tra(ji,jj,1,jn) + qtr_cfc(ji,jj,jl) / fse3t(ji,jj,1)  
    … …  
    176174      END DO                                                !  end CFC loop  ! 
    177175      !                                                     !----------------! 
    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  
     176      IF( ln_diatrc ) THEN 
     177        ! 
     178        IF( lk_iomput ) THEN 
     179           CALL iom_put( "qtrCFC11"  , qtr_cfc (:,:,1) ) 
     180           CALL iom_put( "qintCFC11" , qint_cfc(:,:,1) ) 
     181        ELSE 
     182           trc2d(:,:,jp_cfc0_2d    ) = qtr_cfc (:,:,1) 
     183           trc2d(:,:,jp_cfc0_2d + 1) = qint_cfc(:,:,1) 
     184        END IF 
     185        ! 
     186      END IF 
     187  
    190188      IF( l_trdtrc ) THEN 
    191189          DO jn = jp_cfc0, jp_cfc1 
    192             ztrcfc(:,:,:) = tra(:,:,:,jn) 
    193             CALL trd_mod_trc( ztrcfc, jn, jptra_trd_sms, kt )   ! save trends 
     190            CALL trd_mod_trc( tra(:,:,:,jn), jn, jptra_trd_sms, kt )   ! save trends 
    194191          END DO 
    195192      END IF 
    196       ! 
    197       IF( wrk_not_released(3, 1) )   CALL ctl_stop('trc_sms_cfc: failed to release workspace array') 
    198193      ! 
    199194   END SUBROUTINE trc_sms_cfc 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/LOBSTER/par_lobster.F90

    r2528 r2977  
    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 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcbio.F90

    r2715 r2977  
    7474      REAL(wp) ::   zfilpz, zfildz, zphya, zzooa, zno3a 
    7575      REAL(wp) ::   znh4a, zdeta, zdoma, zzoobod, zboddet, zdomaju 
    76 #if defined key_diatrc 
    7776      REAL(wp) ::   ze3t 
    78 #endif 
    79 #if defined key_diatrc && defined key_iomput 
    8077      REAL(wp), POINTER,   DIMENSION(:,:,:) :: zw2d 
    8178      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zw3d 
    82 #endif 
    83       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   ztrbio 
    8479      CHARACTER (len=25) :: charout 
    8580      !!--------------------------------------------------------------------- 
    8681 
    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 
     82      IF( ln_diatrc .AND. lk_iomput ) THEN 
     83         IF( ( wrk_in_use(3, 2) ) .OR. ( wrk_in_use(4, 1) ) ) THEN 
     84            CALL ctl_stop('trc_bio : requested workspace arrays unavailable.')  ;  RETURN 
     85         END IF 
     86         ! Set-up pointers into sub-arrays of workspaces 
     87         zw2d => wrk_3d_2(:,:,1:17) 
     88         zw3d => wrk_4d_1(:,:,:,1:3) 
     89      ENDIF 
    9690 
    9791      IF( kt == nit000 ) THEN 
    … …  
    10296 
    10397      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. 
    118       ENDIF 
    119  
    120       !                                      ! -------------------------- ! 
    121       DO jk = 1, jpkbm1                      !  Upper ocean (bio-layers)  ! 
    122          !                                   ! -------------------------- ! 
     98      IF( ln_diatrc ) THEN 
     99         ! 
     100         IF( lk_iomput ) THEN 
     101            zw2d  (:,:,:) = 0.e0 
     102            zw3d(:,:,:,:) = 0.e0 
     103         ELSE 
     104            trc2d(:,:,  jp_lob0_2d:jp_lob1_2d) = 0.e0 
     105            trc3d(:,:,:,jp_lob0_3d:jp_lob1_3d) = 0.e0 
     106         ENDIF 
     107         ! 
     108      ENDIF 
     109 
     110      DO jk = 1, jpkm1                      
     111         !                              
    123112         DO jj = 2, jpjm1 
    124113            DO ji = fs_2, fs_jpim1  
    … …  
    133122               znh4 = MAX( 0.e0, trn(ji,jj,jk,jp_lob_nh4) ) 
    134123               zdom = MAX( 0.e0, trn(ji,jj,jk,jp_lob_dom) ) 
    135  
    136                ! Limitations 
    137                zlt   = 1. 
    138                zle   = 1. - EXP( -xpar(ji,jj,jk) / aki / zlt ) 
    139                ! psinut,akno3,aknh4 added by asklod AS Kremeur 2005-03 
    140                zlno3 = zno3 * EXP( -psinut * znh4 ) / ( akno3 + zno3 ) 
    141                zlnh4 = znh4 / (znh4+aknh4)  
    142  
    143                ! sinks and sources 
    144                !    phytoplankton production and exsudation 
    145                zno3phy = tmumax * zle * zlt * zlno3 * zphy 
    146                znh4phy = tmumax * zle * zlt * zlnh4 * zphy 
    147  
    148                !    fphylab added by asklod AS Kremeur 2005-03 
    149                zphydom = rgamma * (1 - fphylab) * (zno3phy + znh4phy) 
    150                zphynh4 = rgamma * fphylab * (zno3phy + znh4phy) 
    151  
    152                ! zooplankton production 
    153                !    preferences 
    154                zppz = rppz 
    155                zpdz = 1. - rppz 
    156                zpppz = ( zppz * zphy ) / ( ( zppz * zphy + zpdz * zdet ) + 1.e-13 ) 
    157                zppdz = ( zpdz * zdet ) / ( ( zppz * zphy + zpdz * zdet ) + 1.e-13 ) 
    158                zfood = zpppz * zphy + zppdz * zdet 
    159                !    filtration 
    160                zfilpz = taus * zpppz / (aks + zfood) 
    161                zfildz = taus * zppdz / (aks + zfood) 
    162                !    grazing 
    163                zphyzoo = zfilpz * zphy * zzoo 
    164                zdetzoo = zfildz * zdet * zzoo 
    165  
    166                ! fecal pellets production 
    167                zzoodet = rpnaz * zphyzoo + rdnaz * zdetzoo 
     124               !                                      ! -------------------------- ! 
     125               IF( jk <= jpkbm1 ) THEN                !  Upper ocean (bio-layers)  !  
     126                  !                                   ! -------------------------- ! 
     127                  ! Limitations                      
     128                  zlt   = 1. 
     129                  zle   = 1. - EXP( -xpar(ji,jj,jk) / aki / zlt ) 
     130                  ! psinut,akno3,aknh4 added by asklod AS Kremeur 2005-03 
     131                  zlno3 = zno3 * EXP( -psinut * znh4 ) / ( akno3 + zno3 ) 
     132                  zlnh4 = znh4 / (znh4+aknh4)  
     133 
     134                  ! sinks and sources 
     135                  !    phytoplankton production and exsudation 
     136                  zno3phy = tmumax * zle * zlt * zlno3 * zphy 
     137                  znh4phy = tmumax * zle * zlt * zlnh4 * zphy 
     138 
     139                  !    fphylab added by asklod AS Kremeur 2005-03 
     140                  zphydom = rgamma * (1 - fphylab) * (zno3phy + znh4phy) 
     141                  zphynh4 = rgamma * fphylab * (zno3phy + znh4phy) 
     142    
     143                  ! zooplankton production 
     144                  !    preferences 
     145                  zppz = rppz 
     146                  zpdz = 1. - rppz 
     147                  zpppz = ( zppz * zphy ) / ( ( zppz * zphy + zpdz * zdet ) + 1.e-13 ) 
     148                  zppdz = ( zpdz * zdet ) / ( ( zppz * zphy + zpdz * zdet ) + 1.e-13 ) 
     149                  zfood = zpppz * zphy + zppdz * zdet 
     150                  !    filtration 
     151                  zfilpz = taus * zpppz / (aks + zfood) 
     152                  zfildz = taus * zppdz / (aks + zfood) 
     153                  !    grazing zphyzoo = zfilpz * zphy * zzoo 
     154                  zdetzoo = zfildz * zdet * zzoo 
     155 
     156                  ! fecal pellets production 
     157                  zzoodet = rpnaz * zphyzoo + rdnaz * zdetzoo 
    168158  
    169                ! zooplankton liquide excretion 
    170                zzoonh4 = tauzn * fzoolab * zzoo  
    171                zzoodom = tauzn * (1 - fzoolab) * zzoo 
    172  
    173                ! mortality 
    174                !    phytoplankton mortality  
    175                zphydet = tmminp * zphy 
    176  
    177                !    zooplankton mortality 
    178                !    closure : flux fbod is redistributed below level jpkbio 
    179                zzoobod = tmminz * zzoo * zzoo 
    180                fbod(ji,jj) = fbod(ji,jj) + (1-fdbod) * zzoobod * fse3t(ji,jj,jk) 
    181                zboddet = fdbod * zzoobod 
    182  
    183                ! detritus and dom breakdown 
    184                zdetnh4 = taudn * fdetlab * zdet 
    185                zdetdom = taudn * (1 - fdetlab) * zdet  
    186  
    187                zdomnh4 = taudomn * zdom 
    188  
    189                ! flux added to express how the excess of nitrogen from 
    190                ! PHY, ZOO and DET to DOM goes directly to NH4 (flux of ajustment) 
    191                zdomaju = (1 - redf/reddom) * (zphydom + zzoodom + zdetdom) 
    192  
    193                ! Nitrification 
    194                znh4no3 = taunn * znh4 
     159                  ! zooplankton liquide excretion 
     160                  zzoonh4 = tauzn * fzoolab * zzoo  
     161                  zzoodom = tauzn * (1 - fzoolab) * zzoo 
     162 
     163                  ! mortality 
     164                  !    phytoplankton mortality  
     165                  zphydet = tmminp * zphy 
     166 
     167                  !    zooplankton mortality 
     168                  !    closure : flux fbod is redistributed below level jpkbio 
     169                  zzoobod = tmminz * zzoo * zzoo 
     170                  fbod(ji,jj) = fbod(ji,jj) + (1-fdbod) * zzoobod * fse3t(ji,jj,jk) 
     171                  zboddet = fdbod * zzoobod 
     172 
     173                  ! detritus and dom breakdown 
     174                  zdetnh4 = taudn * fdetlab * zdet 
     175                  zdetdom = taudn * (1 - fdetlab) * zdet  
     176 
     177                  zdomnh4 = taudomn * zdom 
     178 
     179                  ! flux added to express how the excess of nitrogen from 
     180                  ! PHY, ZOO and DET to DOM goes directly to NH4 (flux of ajustment) 
     181                  zdomaju = (1 - redf/reddom) * (zphydom + zzoodom + zdetdom) 
     182 
     183                  ! Nitrification 
     184                  znh4no3 = taunn * znh4 
     185                  !                                   ! -------------------------- ! 
     186               ELSE                                   !  Lower ocean               !  
     187                  !                                   ! -------------------------- ! 
     188                  !    Limitations 
     189                  zlt   = 0.e0 
     190                  zle   = 0.e0 
     191                  zlno3 = 0.e0 
     192                  zlnh4 = 0.e0 
     193 
     194                  !    sinks and sources 
     195                  !       phytoplankton production and exsudation 
     196                  zno3phy = 0.e0 
     197                  znh4phy = 0.e0 
     198                  zphydom = 0.e0 
     199                  zphynh4 = 0.e0 
     200 
     201                  !    zooplankton production 
     202                  zphyzoo = 0.e0      ! grazing 
     203                  zdetzoo = 0.e0 
     204 
     205                  zzoodet = 0.e0      ! fecal pellets production 
     206 
     207                  zzoonh4 = tauzn * fzoolab * zzoo         ! zooplankton liquide excretion 
     208                  zzoodom = tauzn * (1 - fzoolab) * zzoo 
     209 
     210                  !    mortality 
     211                  zphydet = tmminp * zphy      ! phytoplankton mortality  
     212 
     213                  zzoobod = 0.e0               ! zooplankton mortality 
     214                  zboddet = 0.e0               ! closure : flux fbod is redistributed below level jpkbio 
     215 
     216                  !    detritus and dom breakdown 
     217                  zdetnh4 = taudn * fdetlab * zdet 
     218                  zdetdom = taudn * (1 - fdetlab) * zdet 
     219 
     220                  zdomnh4 = taudomn * zdom 
     221                  zdomaju = (1 - redf/reddom) * (zphydom + zzoodom + zdetdom) 
     222 
     223                  !    Nitrification 
     224                  znh4no3 = taunn * znh4 
     225                  ! 
     226               ENDIF 
    195227 
    196228               ! determination of trends 
    … …  
    211243               tra(ji,jj,jk,jp_lob_dom) = tra(ji,jj,jk,jp_lob_dom) + zdoma 
    212244 
    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 
     245               IF( ( ln_diabio .AND. .NOT. lk_iomput ) .OR. l_trdtrc ) THEN 
     246                  trbio(ji,jj,jk,jp_lob0_trd     ) = zno3phy 
     247                  trbio(ji,jj,jk,jp_lob0_trd +  1) = znh4phy 
     248                  trbio(ji,jj,jk,jp_lob0_trd +  2) = zphynh4 
     249                  trbio(ji,jj,jk,jp_lob0_trd +  3) = zphydom 
     250                  trbio(ji,jj,jk,jp_lob0_trd +  4) = zphyzoo 
     251                  trbio(ji,jj,jk,jp_lob0_trd +  5) = zphydet 
     252                  trbio(ji,jj,jk,jp_lob0_trd +  6) = zdetzoo 
    238253                  !  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 
     254                  trbio(ji,jj,jk,jp_lob0_trd +  8) = zzoodet 
     255                  trbio(ji,jj,jk,jp_lob0_trd +  9) = zzoobod 
     256                  trbio(ji,jj,jk,jp_lob0_trd + 10) = zzoonh4 
     257                  trbio(ji,jj,jk,jp_lob0_trd + 11) = zzoodom 
     258                  trbio(ji,jj,jk,jp_lob0_trd + 12) = znh4no3 
     259                  trbio(ji,jj,jk,jp_lob0_trd + 13) = zdomnh4 
     260                  trbio(ji,jj,jk,jp_lob0_trd + 14) = zdetnh4 
     261                  trbio(ji,jj,jk,jp_lob0_trd + 15) = zdetdom 
    247262                  !  trend number 17 in trcexp 
    248263                ENDIF 
    249264 
    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 
     265                IF( ln_diatrc ) THEN 
     266                  ! convert fluxes in per day 
     267                  ze3t = fse3t(ji,jj,jk) * 86400. 
     268                  IF( lk_iomput ) THEN 
     269                     zw2d(ji,jj,1)  = zw2d(ji,jj,1)  + zno3phy * ze3t  
     270                     zw2d(ji,jj,2)  = zw2d(ji,jj,2)  + znh4phy * ze3t 
     271                     zw2d(ji,jj,3)  = zw2d(ji,jj,3)  + zphydom * ze3t 
     272                     zw2d(ji,jj,4)  = zw2d(ji,jj,4)  + zphynh4 * ze3t 
     273                     zw2d(ji,jj,5)  = zw2d(ji,jj,5)  + zphyzoo * ze3t 
     274                     zw2d(ji,jj,6)  = zw2d(ji,jj,6)  + zphydet * ze3t 
     275                     zw2d(ji,jj,7)  = zw2d(ji,jj,7)  + zdetzoo * ze3t 
     276                     zw2d(ji,jj,8)  = zw2d(ji,jj,8)  + zzoodet * ze3t 
     277                     zw2d(ji,jj,9)  = zw2d(ji,jj,9)  + zzoobod * ze3t 
     278                     zw2d(ji,jj,10) = zw2d(ji,jj,10) + zzoonh4 * ze3t 
     279                     zw2d(ji,jj,11) = zw2d(ji,jj,11) + zzoodom * ze3t 
     280                     zw2d(ji,jj,12) = zw2d(ji,jj,12) + znh4no3 * ze3t 
     281                     zw2d(ji,jj,13) = zw2d(ji,jj,13) + zdomnh4 * ze3t 
     282                     zw2d(ji,jj,14) = zw2d(ji,jj,14) + zdetnh4 * ze3t              
     283                     zw2d(ji,jj,15) = zw2d(ji,jj,15) + ( zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet ) * ze3t 
     284                     zw2d(ji,jj,16) = zw2d(ji,jj,16) + ( zphyzoo + zdetzoo - zzoodet - zzoobod - zzoonh4 - zzoodom ) * ze3t 
     285                     zw2d(ji,jj,17) = zw2d(ji,jj,17) + zdetdom * ze3t 
     286                     ! 
     287                     zw3d(ji,jj,jk,1) = zno3phy * 86400      
     288                     zw3d(ji,jj,jk,2) = znh4phy * 86400      
     289                     zw3d(ji,jj,jk,3) = znh4no3 * 86400    
     290                  ELSE 
     291                     trc2d(ji,jj,jp_lob0_2d    ) = trc2d(ji,jj, jp_lob0_2d    ) + zno3phy * ze3t  
     292                     trc2d(ji,jj,jp_lob0_2d + 1) = trc2d(ji,jj, jp_lob0_2d + 1) + znh4phy * ze3t 
     293                     trc2d(ji,jj,jp_lob0_2d + 2) = trc2d(ji,jj, jp_lob0_2d + 2) + zphydom * ze3t 
     294                     trc2d(ji,jj,jp_lob0_2d + 3) = trc2d(ji,jj, jp_lob0_2d + 3) + zphynh4 * ze3t 
     295                     trc2d(ji,jj,jp_lob0_2d + 4) = trc2d(ji,jj, jp_lob0_2d + 4) + zphyzoo * ze3t 
     296                     trc2d(ji,jj,jp_lob0_2d + 5) = trc2d(ji,jj, jp_lob0_2d + 5) + zphydet * ze3t 
     297                     trc2d(ji,jj,jp_lob0_2d + 6) = trc2d(ji,jj, jp_lob0_2d + 6) + zdetzoo * ze3t 
     298                     ! trend number 8 is in trcsed.F             
     299                     trc2d(ji,jj,jp_lob0_2d +  8) = trc2d(ji,jj,jp_lob0_2d +  8) + zzoodet * ze3t 
     300                     trc2d(ji,jj,jp_lob0_2d +  9) = trc2d(ji,jj,jp_lob0_2d +  9) + zzoobod * ze3t 
     301                     trc2d(ji,jj,jp_lob0_2d + 10) = trc2d(ji,jj,jp_lob0_2d + 10) + zzoonh4 * ze3t 
     302                     trc2d(ji,jj,jp_lob0_2d + 11) = trc2d(ji,jj,jp_lob0_2d + 11) + zzoodom * ze3t 
     303                     trc2d(ji,jj,jp_lob0_2d + 12) = trc2d(ji,jj,jp_lob0_2d + 12) + znh4no3 * ze3t 
     304                     trc2d(ji,jj,jp_lob0_2d + 13) = trc2d(ji,jj,jp_lob0_2d + 13) + zdomnh4 * ze3t 
     305                     trc2d(ji,jj,jp_lob0_2d + 14) = trc2d(ji,jj,jp_lob0_2d + 14) + zdetnh4 * ze3t              
     306                     trc2d(ji,jj,jp_lob0_2d + 15) = trc2d(ji,jj,jp_lob0_2d + 15) + (  zno3phy + znh4phy - zphynh4   & 
     307                        &                                 - zphydom - zphyzoo - zphydet ) * ze3t 
     308                     trc2d(ji,jj,jp_lob0_2d + 16) = trc2d(ji,jj,jp_lob0_2d + 16) + (  zphyzoo + zdetzoo - zzoodet   & 
     309                        &                                 - zzoobod - zzoonh4 - zzoodom ) * ze3t 
     310                     trc2d(ji,jj,jp_lob0_2d + 17) = trc2d(ji,jj,jp_lob0_2d + 17) + zdetdom * ze3t 
     311                     ! trend number 19 is in trcexp.F 
     312                     trc3d(ji,jj,jk,jp_lob0_3d    ) = zno3phy * 86400      
     313                     trc3d(ji,jj,jk,jp_lob0_3d + 1) = znh4phy * 86400      
     314                     trc3d(ji,jj,jk,jp_lob0_3d + 2) = znh4no3 * 86400    
     315                     ! 
     316                  ENDIF 
     317                   ! 
     318                ENDIF 
    306319            END DO 
    307320         END DO 
    308321      END DO 
    309322 
    310       !                                      ! -------------------------- ! 
    311       DO jk = jpkb, jpkm1                    !  Upper ocean (bio-layers)  ! 
    312          !                                   ! -------------------------- ! 
    313          DO jj = 2, jpjm1 
    314             DO ji = fs_2, fs_jpim1  
    315                ! remineralisation of all quantities towards nitrate  
    316  
    317                !    trophic variables( det, zoo, phy, no3, nh4, dom) 
    318                !       negative trophic variables DO not contribute to the fluxes 
    319                zdet = MAX( 0.e0, trn(ji,jj,jk,jp_lob_det) ) 
    320                zzoo = MAX( 0.e0, trn(ji,jj,jk,jp_lob_zoo) ) 
    321                zphy = MAX( 0.e0, trn(ji,jj,jk,jp_lob_phy) ) 
    322                zno3 = MAX( 0.e0, trn(ji,jj,jk,jp_lob_no3) ) 
    323                znh4 = MAX( 0.e0, trn(ji,jj,jk,jp_lob_nh4) ) 
    324                zdom = MAX( 0.e0, trn(ji,jj,jk,jp_lob_dom) ) 
    325  
    326                !    Limitations 
    327                zlt   = 0.e0 
    328                zle   = 0.e0 
    329                zlno3 = 0.e0 
    330                zlnh4 = 0.e0 
    331  
    332                !    sinks and sources 
    333                !       phytoplankton production and exsudation 
    334                zno3phy = 0.e0 
    335                znh4phy = 0.e0 
    336                zphydom = 0.e0 
    337                zphynh4 = 0.e0 
    338  
    339                !    zooplankton production 
    340                zphyzoo = 0.e0      ! grazing 
    341                zdetzoo = 0.e0 
    342  
    343                zzoodet = 0.e0      ! fecal pellets production 
    344  
    345                zzoonh4 = tauzn * fzoolab * zzoo         ! zooplankton liquide excretion 
    346                zzoodom = tauzn * (1 - fzoolab) * zzoo 
    347  
    348                !    mortality 
    349                zphydet = tmminp * zphy      ! phytoplankton mortality  
    350  
    351                zzoobod = 0.e0               ! zooplankton mortality 
    352                zboddet = 0.e0               ! closure : flux fbod is redistributed below level jpkbio 
    353  
    354                !    detritus and dom breakdown 
    355                zdetnh4 = taudn * fdetlab * zdet 
    356                zdetdom = taudn * (1 - fdetlab) * zdet  
    357  
    358                zdomnh4 = taudomn * zdom 
    359                zdomaju = (1 - redf/reddom) * (zphydom + zzoodom + zdetdom) 
    360  
    361                !    Nitrification 
    362                znh4no3 = taunn * znh4 
    363  
    364  
    365                ! determination of trends 
    366                !     total trend for each biological tracer 
    367                zphya =   zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet 
    368                zzooa =   zphyzoo + zdetzoo - zzoodet - zzoodom - zzoonh4 - zzoobod 
    369                zno3a = - zno3phy + znh4no3 
    370                znh4a = - znh4phy - znh4no3 + zphynh4 + zzoonh4 + zdomnh4 + zdetnh4 + zdomaju 
    371                zdeta = zphydet + zzoodet  - zdetzoo - zdetnh4 - zdetdom + zboddet 
    372                zdoma = zphydom + zzoodom + zdetdom - zdomnh4 - zdomaju 
    373  
    374                ! tracer flux at totox-point added to the general trend 
    375                tra(ji,jj,jk,jp_lob_det) = tra(ji,jj,jk,jp_lob_det) + zdeta 
    376                tra(ji,jj,jk,jp_lob_zoo) = tra(ji,jj,jk,jp_lob_zoo) + zzooa 
    377                tra(ji,jj,jk,jp_lob_phy) = tra(ji,jj,jk,jp_lob_phy) + zphya 
    378                tra(ji,jj,jk,jp_lob_no3) = tra(ji,jj,jk,jp_lob_no3) + zno3a 
    379                tra(ji,jj,jk,jp_lob_nh4) = tra(ji,jj,jk,jp_lob_nh4) + znh4a 
    380                tra(ji,jj,jk,jp_lob_dom) = tra(ji,jj,jk,jp_lob_dom) + zdoma 
    381                ! 
    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 
    407                   !  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 
    417                 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 
     323      IF( ln_diatrc ) THEN 
     324         ! 
     325         IF( lk_iomput ) THEN 
     326            DO jl = 1, 17  
     327               CALL lbc_lnk( zw2d(:,:,jl),'T', 1. ) 
    429328            END DO 
    430          END DO 
    431       END DO 
    432  
    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 
     329            DO jl = 1, 3 
     330               CALL lbc_lnk( zw3d(:,:,:,jl),'T', 1. ) 
     331            END DO 
     332            ! Save diagnostics 
     333            CALL iom_put( "TNO3PHY", zw2d(:,:,1) ) 
     334            CALL iom_put( "TNH4PHY", zw2d(:,:,2) ) 
     335            CALL iom_put( "TPHYDOM", zw2d(:,:,3) ) 
     336            CALL iom_put( "TPHYNH4", zw2d(:,:,4) ) 
     337            CALL iom_put( "TPHYZOO", zw2d(:,:,5) ) 
     338            CALL iom_put( "TPHYDET", zw2d(:,:,6) ) 
     339            CALL iom_put( "TDETZOO", zw2d(:,:,7) ) 
     340            CALL iom_put( "TZOODET", zw2d(:,:,8) ) 
     341            CALL iom_put( "TZOOBOD", zw2d(:,:,9) ) 
     342            CALL iom_put( "TZOONH4", zw2d(:,:,10) ) 
     343            CALL iom_put( "TZOODOM", zw2d(:,:,11) ) 
     344            CALL iom_put( "TNH4NO3", zw2d(:,:,12) ) 
     345            CALL iom_put( "TDOMNH4", zw2d(:,:,13) ) 
     346            CALL iom_put( "TDETNH4", zw2d(:,:,14) ) 
     347            CALL iom_put( "TPHYTOT", zw2d(:,:,15) ) 
     348            CALL iom_put( "TZOOTOT", zw2d(:,:,16) ) 
     349            !  
     350            CALL iom_put( "FNO3PHY", zw3d(:,:,:,1) ) 
     351            CALL iom_put( "FNH4PHY", zw3d(:,:,:,2) ) 
     352            CALL iom_put( "FNH4NO3", zw3d(:,:,:,3) ) 
     353            ! 
     354         ELSE 
     355            ! 
     356           DO jl = jp_lob0_2d, jp_lob1_2d 
     357              CALL lbc_lnk( trc2d(:,:,jl),'T', 1. ) 
     358           END DO  
     359           ! 
     360           DO jl = jp_lob0_3d, jp_lob1_3d 
     361             CALL lbc_lnk( trc3d(:,:,1,jl),'T', 1. ) 
     362           END DO  
     363           ! 
     364        ENDIF 
     365        ! 
     366      ENDIF 
     367 
     368      IF( ln_diabio .AND. .NOT. lk_iomput )  THEN 
     369         DO jl = jp_lob0_trd, jp_lob1_trd 
     370            CALL lbc_lnk( trbio(:,:,1,jl),'T', 1. ) 
     371         END DO  
     372      ENDIF 
    487373      ! 
    488374      IF( l_trdtrc ) THEN 
    489375         DO jl = jp_lob0_trd, jp_lob1_trd 
    490             CALL trd_mod_trc( ztrbio(:,:,:,jl), jl, kt )   ! handle the trend 
     376            CALL trd_mod_trc( trbio(:,:,:,jl), jl, kt )   ! handle the trend 
    491377         END DO 
    492378      ENDIF 
    493  
    494       IF( l_trdtrc ) DEALLOCATE( ztrbio ) 
    495379 
    496380      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    … …  
    500384      ENDIF 
    501385      ! 
    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 
     386      IF( ln_diatrc .AND. lk_iomput ) THEN 
     387         IF( ( wrk_not_released(3, 2) ) .OR. ( wrk_not_released(4, 1) ) )  & 
     388           &   CALL ctl_stop('trc_bio : failed to release workspace arrays.') 
     389      ENDIF 
    506390      ! 
    507391   END SUBROUTINE trc_bio 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcexp.F90

    r2715 r2977  
    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      !!--------------------------------------------------------------------- 
    … …  
    6768      ENDIF 
    6869 
     70      IF( l_trdtrc )  THEN 
     71         ALLOCATE( ztrbio(jpi,jpj,jpk) , STAT = ierr )   ! temporary save of trends 
     72         IF( ierr > 0 ) THEN 
     73            CALL ctl_stop( 'trc_exp: unable to allocate ztrbio array' )   ;   RETURN 
     74         ENDIF 
     75         ztrbio(:,:,:) = tra(:,:,:,jp_lob_no3) 
     76      ENDIF 
     77 
    6978      ! VERTICAL DISTRIBUTION OF NEWLY PRODUCED BIOGENIC 
    7079      ! POC IN THE WATER COLUMN 
    … …  
    7281      ! LAYERS IS DETERMINED BY DMIN3 DEFINED IN sms_lobster.F90 
    7382      ! ---------------------------------------------------------------------- 
    74  
    75       IF( l_trdtrc )THEN 
    76          ALLOCATE( ztrbio(jpi,jpj,jpk) ) 
    77          ztrbio(:,:,:) = tra(:,:,:,jp_lob_no3) 
    78       ENDIF 
    79  
    8083      DO jk = 1, jpkm1 
    8184         DO jj = 2, jpjm1 
    … …  
    114117  
    115118      ! 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 
     119      IF( ln_diatrc ) THEN 
     120         IF( lk_iomput ) THEN   ;   CALL iom_put( "SEDPOC" , sedpocn ) 
     121         ELSE                   ;   trc2d(:,:,jp_lob0_2d + 18) = sedpocn(:,:) 
     122         ENDIF 
     123      ENDIF 
    123124 
    124125       
    … …  
    146147         jl = jp_lob0_trd + 16 
    147148         CALL trd_mod_trc( ztrbio, jl, kt )   ! handle the trend 
     149         DEALLOCATE( ztrbio )  
    148150      ENDIF 
    149  
    150       IF( l_trdtrc ) DEALLOCATE( ztrbio ) 
    151151 
    152152      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcnam_lobster.F90

    r2715 r2977  
    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 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcsed.F90

    r2715 r2977  
    5757      !!--------------------------------------------------------------------- 
    5858      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) 
     59      USE wrk_nemo, ONLY: zw2d  => wrk_2d_1, zwork => wrk_3d_2 
    6260      !! 
    6361      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
    6462      !! 
    65       INTEGER  ::   ji, jj, jk, jl 
    66       REAL(wp) ::   ztra 
    67       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrbio 
     63      INTEGER  ::   ji, jj, jk, jl, ierr 
     64      REAL(wp) ::   ztra, ze3t 
     65      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  ztrbio 
    6866      CHARACTER (len=25) :: charout 
    6967      !!--------------------------------------------------------------------- 
    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 
    7568 
    7669      IF( kt == nit000 ) THEN 
    … …  
    8073      ENDIF 
    8174 
     75      IF( wrk_in_use(2, 1) .OR. wrk_in_use(3, 2) ) THEN 
     76         CALL ctl_stop('trc_sed : requested workspace arrays unavailable.')  ;  RETURN 
     77      END IF 
     78 
     79      IF( l_trdtrc )  THEN 
     80         ALLOCATE( ztrbio(jpi,jpj,jpk) , STAT = ierr )   ! temporary save of trends 
     81         IF( ierr > 0 ) THEN 
     82            CALL ctl_stop( 'trc_sed: unable to allocate ztrbio array' )   ;   RETURN 
     83         ENDIF 
     84         ztrbio(:,:,:) = tra(:,:,:,jp_lob_det) 
     85      ENDIF 
     86 
     87      IF( ln_diatrc .AND. lk_iomput )  zw2d(:,:) = 0. 
     88 
    8289      ! sedimentation of detritus  : upstream scheme 
    8390      ! -------------------------------------------- 
    … …  
    8693      zwork(:,:,1  ) = 0.e0      ! surface value set to zero 
    8794      zwork(:,:,jpk) = 0.e0      ! bottom value  set to zero 
    88  
    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 
    9795 
    9896      ! tracer flux at w-point: we use -vsed (downward flux)  with simplification : no e1*e2 
    … …  
    104102      DO jk = 1, jpkm1 
    105103         DO jj = 1, jpj 
    106             DO ji = 1,jpi 
     104            DO ji = 1, jpi 
    107105               ztra  = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / fse3t(ji,jj,jk) 
    108106               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 
     107               ! 
     108               IF( ln_diabio )  trbio(ji,jj,jk,jp_lob0_trd + 7) = ztra 
     109               IF( ln_diatrc ) THEN 
     110                  ze3t = ztra * fse3t(ji,jj,jk) * 86400. 
     111                  IF( lk_iomput ) THEN   ;  zw2d(ji,jj) = zw2d(ji,jj) + ze3t  
     112                  ELSE                   ;  trc2d(ji,jj,jp_lob0_2d + 7) = trc2d(ji,jj,jp_lob0_2d + 7) + ze3t 
     113                  ENDIF 
     114               ENDIF 
     115               ! 
    119116            END DO 
    120117         END DO 
    121118      END DO 
    122119 
    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 
    136       ! 
     120      IF( ln_diatrc .AND. lk_iomput )  CALL iom_put( "TDETSED", zw2d ) 
    137121 
    138122      IF( l_trdtrc ) THEN 
    … …  
    140124         jl = jp_lob0_trd + 7 
    141125         CALL trd_mod_trc( ztrbio, jl, kt )   ! handle the trend 
     126         DEALLOCATE( ztrbio )  
    142127      ENDIF 
    143  
    144       IF( l_trdtrc ) DEALLOCATE( ztrbio ) 
    145128 
    146129      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    … …  
    150133      ENDIF 
    151134 
    152       IF( ( wrk_not_released(3, 2) ) .OR. ( wrk_not_released(2, 1) ) )  & 
     135      IF( ( wrk_not_released(2, 1) ) .OR. ( wrk_not_released(3, 2) ) )  & 
    153136       &         CALL ctl_stop('trc_sed : failed to release workspace arrays.') 
    154137 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcsms_lobster.F90

    r2715 r2977  
    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 
    5752 
    5853      CALL trc_opt( kt )      ! optical model 
    … …  
    6257 
    6358      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 
     59         DO jn = jp_lob0, jp_lob1 
     60           CALL trd_mod_trc( tra(:,:,:,jn), jn, jptra_trd_sms, kt )   ! save trends 
     61         END DO 
    6862      END IF 
    6963 
    7064      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.') 
    7365      ! 
    7466   END SUBROUTINE trc_sms_lobster 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zbio.F90

    r2715 r2977  
    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 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zche.F90

    r2715 r2977  
    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 
    … …  
    171174            !                             ! SET ABSOLUTE TEMPERATURE 
    172175            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  
     176            zt    = ztkel * 0.01 
     177            zt2   = zt * zt 
     178            zsal  = tsn(ji,jj,1,jp_sal) + ( 1.- tmask(ji,jj,1) ) * 35. 
     179            zsal2 = zsal * zsal 
     180            zlogt = LOG( zt ) 
    178181            !                             ! LN(K0) OF SOLUBILITY OF CO2 (EQ. 12, WEISS, 1980) 
    179182            !                             !     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  
     183            zcek1 = ca0 + ca1 / zt + ca2 * zlogt + ca3 * zt2 + zsal * ( ca4 + ca5 * zt + ca6 * zt2 ) 
     184            !                             ! LN(K0) OF SOLUBILITY OF O2 and N2 in ml/L (EQ. 8, GARCIA AND GORDON, 1992) 
     185            ztgg  = LOG( ( 298.15 - tsn(ji,jj,1,jp_tem) ) / ztkel )  ! Set the GORDON & GARCIA scaled temperature 
     186            ztgg2 = ztgg  * ztgg 
     187            ztgg3 = ztgg2 * ztgg 
     188            ztgg4 = ztgg3 * ztgg 
     189            ztgg5 = ztgg4 * ztgg 
     190            zoxy  = ox0 + ox1 * ztgg + ox2 * ztgg2 + ox3 * ztgg3 + ox4 * ztgg4 + ox5 * ztgg5   & 
     191                   + zsal * ( ox6 + ox7 * ztgg + ox8 * ztgg2 + ox9 * ztgg3 ) +  ox10 * zsal2 
     192 
     193            !                             ! SET SOLUBILITIES OF O2 AND CO2  
     194            chemc(ji,jj,1) = EXP( zcek1 ) * 1.e-6 * rhop(ji,jj,1) / 1000.  ! mol/(L uatm) 
     195            chemc(ji,jj,2) = ( EXP( zoxy  ) * o2atm ) * oxyco              ! mol/(L atm) 
     196            ! 
    189197         END DO 
    190198      END DO 
    … …  
    204212               ! SET ABSOLUTE TEMPERATURE 
    205213               ztkel   = tsn(ji,jj,jk,jp_tem) + 273.16 
    206                zqtt    = ztkel * 0.01 
    207214               zsal    = tsn(ji,jj,jk,jp_sal) + ( 1.-tmask(ji,jj,jk) ) * 35. 
    208215               zsqrt  = SQRT( zsal ) 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zflx.F90

    r2715 r2977  
    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   REAL(wp) , ALLOCATABLE, SAVE, DIMENSION(:,:)  ::  patm      ! atmospheric pressure at kt                 [N/m2] 
     50   TYPE(FLD), ALLOCATABLE,       DIMENSION(:)    ::  sf_patm   ! structure of input fields (file informations, fields read) 
     51 
     52 
    3753   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: oce_co2   !: ocean carbon flux  
    3854   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: satmco2   !: atmospheric pco2  
    … …  
    4157   REAL(wp) ::  t_atm_co2_flx               !: global mean of atmospheric pco2 
    4258   REAL(wp) ::  area                        !: ocean surface 
    43    REAL(wp) ::  atcco2 = 278._wp            !: pre-industrial atmospheric [co2] (ppm)   
    44    REAL(wp) ::  atcox  = 0.20946_wp         !: 
    4559   REAL(wp) ::  xconv  = 0.01_wp / 3600._wp !: coefficients for conversion  
    4660 
    … …  
    6074      !! ** Purpose :   CALCULATES GAS EXCHANGE AND CHEMISTRY AT SEA SURFACE 
    6175      !! 
    62       !! ** Method  : - ??? 
     76      !! ** Method  :  
     77      !!              - Include total atm P correction via Esbensen & Kushnir (1981)  
     78      !!              - Pressure correction NOT done for key_cpl_carbon_cycle 
     79      !!              - Remove Wanninkhof chemical enhancement; 
     80      !!              - Add option for time-interpolation of atcco2.txt   
    6381      !!--------------------------------------------------------------------- 
    6482      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 
     83      USE wrk_nemo, ONLY:   zkgco2 => wrk_2d_11 , zkgo2 => wrk_2d_12 , zh2co3 => wrk_2d_13  
     84      USE wrk_nemo, ONLY:   zoflx  => wrk_2d_14 , zkg   => wrk_2d_15 
     85      USE wrk_nemo, ONLY:   zdpco2 => wrk_2d_16 , zdpo2 => wrk_2d_17 
    6886      ! 
    6987      INTEGER, INTENT(in) ::   kt   ! 
    7088      ! 
    71       INTEGER  ::   ji, jj, jrorr 
     89      INTEGER  ::   ji, jj, jm, iind, iindm1 
    7290      REAL(wp) ::   ztc, ztc2, ztc3, zws, zkgwan 
    7391      REAL(wp) ::   zfld, zflu, zfld16, zflu16, zfact 
    7492      REAL(wp) ::   zph, zah2, zbot, zdic, zalk, zsch_o2, zalka, zsch_co2 
     93      REAL(wp) ::   zyr_dec, zdco2dt 
    7594      CHARACTER (len=25) :: charout 
    7695      !!--------------------------------------------------------------------- 
    7796 
    78       IF( wrk_in_use(2, 1,2,3,4,5,6,7) ) THEN 
     97      IF( wrk_in_use(2, 11,12,13,14,15,16,17) ) THEN 
    7998         CALL ctl_stop('p4z_flx: requested workspace arrays unavailable')   ;   RETURN 
    8099      ENDIF 
    … …  
    84103      !     IS USED TO COMPUTE AIR-SEA FLUX OF CO2 
    85104 
     105      CALL p4z_patm( kt )    ! Get sea-level pressure (E&K [1981] climatology) for use in flux calcs 
     106 
     107      IF( ln_co2int ) THEN  
     108         ! Linear temporal interpolation  of atmospheric pco2.  atcco2.txt has annual values. 
     109         ! Caveats: First column of .txt must be in years, decimal  years preferably.  
     110         ! For nn_offset, if your model year is iyy, nn_offset=(years(1)-iyy)  
     111         ! then the first atmospheric CO2 record read is at years(1) 
     112         zyr_dec = REAL( nyear + nn_offset, wp ) + REAL( nday_year, wp ) / REAL( nyear_len(1), wp ) 
     113         jm = 2 
     114         DO WHILE( jm <= nmaxrec .AND. years(jm-1) < zyr_dec .AND. years(jm) >= zyr_dec ) ;  jm = jm + 1 ;  END DO 
     115         iind = jm  ;   iindm1 = jm - 1 
     116         zdco2dt = ( atcco2h(iind) - atcco2h(iindm1) ) / ( years(iind) - years(iindm1) + rtrn ) 
     117         atcco2  = zdco2dt * ( zyr_dec - years(iindm1) ) + atcco2h(iindm1) 
     118         satmco2(:,:) = atcco2  
     119      ENDIF 
     120 
    86121#if defined key_cpl_carbon_cycle 
    87122      satmco2(:,:) = atm_co2(:,:) 
    88123#endif 
    89124 
    90       DO jrorr = 1, 10 
    91  
     125      DO jm = 1, 10 
    92126!CDIR NOVERRCHK 
    93127         DO jj = 1, jpj 
    … …  
    137171            ! Compute the piston velocity for O2 and CO2 
    138172            zkgwan = 0.3 * zws  + 2.5 * ( 0.5246 + 0.016256 * ztc + 0.00049946  * ztc2 ) 
     173            zkgwan = zkgwan * xconv * ( 1.- fr_i(ji,jj) ) * tmask(ji,jj,1) 
    139174# 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) 
     175            zkgwan = zkgwan * facvol(ji,jj,1) 
    143176#endif  
    144177            ! compute gas exchange for CO2 and O2 
    … …  
    151184         DO ji = 1, jpi 
    152185            ! 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) 
     186            zfld = satmco2(ji,jj) * patm(ji,jj) * tmask(ji,jj,1) * chemc(ji,jj,1) * zkgco2(ji,jj)   ! (mol/L) * (m/s) 
     187            zflu = zh2co3(ji,jj) * tmask(ji,jj,1) * zkgco2(ji,jj)                                   ! (mol/L) (m/s) ? 
    155188            oce_co2(ji,jj) = ( zfld - zflu ) * rfact * e1e2t(ji,jj) * tmask(ji,jj,1) * 1000. 
    156189            ! compute the trend 
    … …  
    158191 
    159192            ! Compute O2 flux  
    160             zfld16 = atcox * chemc(ji,jj,2) * tmask(ji,jj,1) * zkgo2(ji,jj) 
     193            zfld16 = atcox * patm(ji,jj) * chemc(ji,jj,2) * tmask(ji,jj,1) * zkgo2(ji,jj)          ! (mol/L) * (m/s) 
    161194            zflu16 = trn(ji,jj,1,jpoxy) * tmask(ji,jj,1) * zkgo2(ji,jj) 
    162195            tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + ( zfld16 - zflu16 ) / fse3t(ji,jj,1) 
    163196 
    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 
     197            IF( ln_diatrc ) THEN          ! Save diagnostics 
     198              IF( lk_iomput ) THEN 
     199                 zoflx(ji,jj) = ( zfld16 - zflu16 ) * 1000. * tmask(ji,jj,1) 
     200                 zkg  (ji,jj) = zkgco2(ji,jj) * tmask(ji,jj,1) 
     201                 zdpco2(ji,jj) = ( satmco2(ji,jj) * patm(ji,jj) - zh2co3(ji,jj) / ( chemc(ji,jj,1) + rtrn ) ) * tmask(ji,jj,1) 
     202                 zdpo2 (ji,jj) = ( atcox * patm(ji,jj) - trn(ji,jj,1,jpoxy)    / ( chemc(ji,jj,2) + rtrn ) ) * tmask(ji,jj,1) 
     203              ELSE 
     204                 zfact = 1. / e1e2t(ji,jj) / rfact 
     205                 trc2d(ji,jj,jp_pcs0_2d    ) = oce_co2(ji,jj) * zfact 
     206                 trc2d(ji,jj,jp_pcs0_2d + 1) = ( zfld16 - zflu16 ) * 1000. * tmask(ji,jj,1) 
     207                 trc2d(ji,jj,jp_pcs0_2d + 2) = zkgco2(ji,jj) * tmask(ji,jj,1) 
     208                 trc2d(ji,jj,jp_pcs0_2d + 3) = ( satmco2(ji,jj)  * patm(ji,jj) - zh2co3(ji,jj) / ( chemc(ji,jj,1) + rtrn ) ) & 
     209                    &                            * tmask(ji,jj,1) 
     210              ENDIF 
     211           ENDIF 
    180212         END DO 
    181213      END DO 
    182214 
    183       t_oce_co2_flx = t_oce_co2_flx + glob_sum( oce_co2(:,:) )                     ! Cumulative Total Flux of Carbon 
     215      t_oce_co2_flx = t_oce_co2_flx + glob_sum( oce_co2(:,:) )            ! Cumulative Total Flux of Carbon 
    184216      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 
     217         t_atm_co2_flx = glob_sum( satmco2(:,:) * patm(:,:) * e1e2t(:,:) )            ! Total atmospheric pCO2 
     218         ! 
     219         t_oce_co2_flx = (-1.) * t_oce_co2_flx  * 12. / 1.e15             ! Conversion in PgC ; negative for out of the ocean 
     220         t_atm_co2_flx = t_atm_co2_flx  / area                            ! global mean of atmospheric pCO2 
    189221         ! 
    190222         IF( lwp) THEN 
    … …  
    205237      ENDIF 
    206238 
    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') 
     239      IF( ln_diatrc ) THEN 
     240         CALL iom_put( "Cflx" , oce_co2(:,:) / e1e2t(:,:) / rfact )  
     241         CALL iom_put( "Oflx" , zoflx  ) 
     242         CALL iom_put( "Kg"   , zkg    ) 
     243         CALL iom_put( "Dpco2", zdpco2 ) 
     244         CALL iom_put( "Dpo2" , zdpo2  ) 
     245      ENDIF 
     246      ! 
     247      IF( wrk_not_released(2, 11,12,13,14,15,16,17) )  & 
     248        &             CALL ctl_stop('p4z_flx: failed to release workspace arrays') 
    216249      ! 
    217250   END SUBROUTINE p4z_flx 
    … …  
    228261      !! ** input   :   Namelist nampisext 
    229262      !!---------------------------------------------------------------------- 
    230       NAMELIST/nampisext/ atcco2 
    231       !!---------------------------------------------------------------------- 
    232       ! 
    233       REWIND( numnat )                     ! read numnat 
    234       READ  ( numnat, nampisext ) 
     263      NAMELIST/nampisext/ln_co2int, atcco2, clname, nn_offset 
     264      INTEGER :: jm 
     265      !!---------------------------------------------------------------------- 
     266      ! 
     267      REWIND( numnatp )                     ! read numnatp 
     268      READ  ( numnatp, nampisext ) 
    235269      ! 
    236270      IF(lwp) THEN                         ! control print 
    … …  
    238272         WRITE(numout,*) ' Namelist parameters for air-sea exchange, nampisext' 
    239273         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    240          WRITE(numout,*) '    Atmospheric pCO2      atcco2      =', atcco2 
     274         WRITE(numout,*) '    Choice for reading in the atm pCO2 file or constant value, ln_co2int =', ln_co2int 
     275         WRITE(numout,*) ' ' 
     276      ENDIF 
     277      IF( .NOT.ln_co2int ) THEN 
     278         IF(lwp) THEN                         ! control print 
     279            WRITE(numout,*) '    Constant Atmospheric pCO2 value  atcco2    =', atcco2 
     280            WRITE(numout,*) ' ' 
     281         ENDIF 
     282         satmco2(:,:)  = atcco2      ! Initialisation of atmospheric pco2 
     283      ELSE 
     284         IF(lwp)  THEN 
     285            WRITE(numout,*) '    Atmospheric pCO2 value  from file clname      =', TRIM( clname ) 
     286            WRITE(numout,*) '    Offset model-data start year      nn_offset   =', nn_offset 
     287            WRITE(numout,*) ' ' 
     288         ENDIF 
     289         CALL ctl_opn( numco2, TRIM( clname) , 'OLD', 'FORMATTED', 'SEQUENTIAL', -1 , numout, lwp ) 
     290         jm = 0                      ! Count the number of record in co2 file 
     291         DO 
     292           READ(numco2,*,END=100)  
     293           jm = jm + 1 
     294         END DO 
     295 100     nmaxrec = jm - 1  
     296         ALLOCATE( years  (nmaxrec) )     ;      years  (:) = 0._wp 
     297         ALLOCATE( atcco2h(nmaxrec) )     ;      atcco2h(:) = 0._wp 
     298 
     299         REWIND(numco2) 
     300         DO jm = 1, nmaxrec          ! get  xCO2 data 
     301            READ(numco2, *)  years(jm), atcco2h(jm) 
     302            IF(lwp) WRITE(numout, '(f6.0,f7.2)')  years(jm), atcco2h(jm) 
     303         END DO 
     304         CLOSE(numco2) 
    241305      ENDIF 
    242306      ! 
    … …  
    245309      oce_co2(:,:)  = 0._wp                ! Initialization of Flux of Carbon 
    246310      t_atm_co2_flx = 0._wp 
    247       ! 
    248       satmco2(:,:)  = atcco2      ! Initialisation of atmospheric pco2 
    249311      t_oce_co2_flx = 0._wp 
    250312      ! 
    251313   END SUBROUTINE p4z_flx_init 
    252314 
     315   SUBROUTINE p4z_patm( kt ) 
     316 
     317      !!---------------------------------------------------------------------- 
     318      !!                  ***  ROUTINE p4z_atm  *** 
     319      !! 
     320      !! ** Purpose :   Read and interpolate the external atmospheric sea-levl pressure 
     321      !! ** Method  :   Read the files and interpolate the appropriate variables 
     322      !! 
     323      !!---------------------------------------------------------------------- 
     324      !! * arguments 
     325      INTEGER, INTENT( in  ) ::   kt   ! ocean time step 
     326      ! 
     327      INTEGER            ::  ierr 
     328      CHARACTER(len=100) ::  cn_dir   ! Root directory for location of ssr files 
     329      TYPE(FLD_N)        ::  sn_patm  ! informations about the fields to be read 
     330      !! 
     331      NAMELIST/nampisatm/ sn_patm, cn_dir 
     332 
     333      !                                         ! -------------------- ! 
     334      IF( kt == nit000 ) THEN                   ! First call kt=nit000 ! 
     335         !                                      ! -------------------- ! 
     336         !                                            !* set file information (default values) 
     337         ! ... default values (NB: frequency positive => hours, negative => months) 
     338         !            !   file   ! frequency !  variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation ! 
     339         !            !   name   !  (hours)  !   name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs    ! 
     340         sn_patm = FLD_N( 'pres'  ,    24     ,  'patm'    ,  .false.   , .true.  ,   'yearly'  , ''       , ''       ) 
     341         cn_dir  = './'          ! directory in which the Patm data are  
     342 
     343         REWIND( numnatp )                             !* read in namlist nampisatm 
     344         READ  ( numnatp, nampisatm )  
     345         ! 
     346         ALLOCATE( sf_patm(1), STAT=ierr )           !* allocate and fill sf_patm (forcing structure) with sn_patm 
     347         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'p4z_flx: unable to allocate sf_patm structure' ) 
     348         ! 
     349         CALL fld_fill( sf_patm, (/ sn_patm /), cn_dir, 'p4z_flx', 'Atmospheric pressure ', 'nampisatm' ) 
     350                                ALLOCATE( sf_patm(1)%fnow(jpi,jpj,1)   ) 
     351         IF( sn_patm%ln_tint )  ALLOCATE( sf_patm(1)%fdta(jpi,jpj,1,2) ) 
     352         ! 
     353      ENDIF 
     354      ! 
     355      CALL fld_read( kt, 1, sf_patm )               !* input Patm provided at kt + 1/2 
     356      patm(:,:) = sf_patm(1)%fnow(:,:,1)                        ! atmospheric pressure 
     357 
     358   END SUBROUTINE p4z_patm 
    253359 
    254360   INTEGER FUNCTION p4z_flx_alloc() 
    … …  
    256362      !!                     ***  ROUTINE p4z_flx_alloc  *** 
    257363      !!---------------------------------------------------------------------- 
    258       ALLOCATE( oce_co2(jpi,jpj), satmco2(jpi,jpj), STAT=p4z_flx_alloc ) 
     364      ALLOCATE( oce_co2(jpi,jpj), satmco2(jpi,jpj), patm(jpi,jpj), STAT=p4z_flx_alloc ) 
    259365      ! 
    260366      IF( p4z_flx_alloc /= 0 )   CALL ctl_warn('p4z_flx_alloc : failed to allocate arrays') 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zint.F90

    r2715 r2977  
    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      !!--------------------------------------------------------------------- 
    4842 
    … …  
    5751      DO ji = 1, jpi 
    5852         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 ) 
     53            zvar = trn(ji,jj,1,jpsil) * trn(ji,jj,1,jpsil) 
     54            xksimax(ji,jj) = MAX( xksimax(ji,jj), ( 1.+ 7.* zvar / ( xksilim * xksilim + zvar ) ) * 1e-6 ) 
    6155         END DO 
    6256      END DO 
    … …  
    6862      ! 
    6963   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 
    8164 
    8265#else 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zlim.F90

    r2528 r2977  
    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       !  ------------------------------------- 
    7380 
    7481      DO jk = 1, jpkm1 
    7582         DO jj = 1, jpj 
    7683            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 ) 
     84                
     85               ! Tuning of the iron concentration to a minimum level that is set to the detection limit 
     86               !------------------------------------- 
     87               zno3    = trn(ji,jj,jk,jpno3) / 40.e-6 
     88               zferlim = MAX( 2e-11 * zno3 * zno3, 5e-12 ) 
     89               zferlim = MIN( zferlim, 3e-11 ) 
    8090               trn(ji,jj,jk,jpfer) = MAX( trn(ji,jj,jk,jpfer), zferlim ) 
    81             END DO 
     91 
     92               ! Computation of a variable Ks for iron on diatoms taking into account 
     93               ! that increasing biomass is made of generally bigger cells 
     94               !------------------------------------------------ 
     95               zconcd   = MAX( 0.e0 , trn(ji,jj,jk,jpdia) - xsizedia ) 
     96               zconcd2  = trn(ji,jj,jk,jpdia) - zconcd 
     97               zconcn   = MAX( 0.e0 , trn(ji,jj,jk,jpphy) - xsizephy ) 
     98               zconcn2  = trn(ji,jj,jk,jpphy) - zconcn 
     99               z1_trnphy   = 1. / ( trn(ji,jj,jk,jpphy) + rtrn ) 
     100               z1_trndia   = 1. / ( trn(ji,jj,jk,jpdia) + rtrn ) 
     101 
     102               concdfe(ji,jj,jk) = MAX( conc3       , ( zconcd2 *      conc3    + conc3m        * zconcd ) * z1_trndia ) 
     103               zconc1d           = MAX( 2.* conc0   , ( zconcd2 * 2. * conc0    + conc1         * zconcd ) * z1_trndia ) 
     104               zconc1dnh4        = MAX( 2.* concnnh4, ( zconcd2 * 2. * concnnh4 + concdnh4      * zconcd ) * z1_trndia ) 
     105 
     106               concnfe(ji,jj,jk) = MAX( conc2       , ( zconcn2 * conc2         + conc2m        * zconcn ) * z1_trnphy ) 
     107               zconc0n           = MAX( conc0       , ( zconcn2 * conc0         + 2. * conc0    * zconcn ) * z1_trnphy ) 
     108               zconc0nnh4        = MAX( concnnh4    , ( zconcn2 * concnnh4      + 2. * concnnh4 * zconcn ) * z1_trnphy ) 
     109 
     110               ! Michaelis-Menten Limitation term for nutrients Small flagellates 
     111               ! ----------------------------------------------- 
     112               zdenom = 1. /  ( zconc0n * zconc0nnh4 + zconc0nnh4 * trn(ji,jj,jk,jpno3) + zconc0n * trn(ji,jj,jk,jpnh4) ) 
     113               xnanono3(ji,jj,jk) = trn(ji,jj,jk,jpno3) * zconc0nnh4 * zdenom 
     114               xnanonh4(ji,jj,jk) = trn(ji,jj,jk,jpnh4) * zconc0n    * zdenom 
     115               ! 
     116               zlim1    = xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) 
     117               zlim2    = trn(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + zconc0nnh4 ) 
     118               zratio   = trn(ji,jj,jk,jpnfe) * z1_trnphy  
     119               zironmin = xcoef1 * trn(ji,jj,jk,jpnch) * z1_trnphy + xcoef2 * zlim1 + xcoef3 * xnanono3(ji,jj,jk) 
     120               zlim3    = MAX( 0.,( zratio - zironmin ) / qnfelim ) 
     121               xlimnfe(ji,jj,jk) = MIN( 1., zlim3 ) 
     122               xlimphy(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) 
     123               ! 
     124               zlim1    = trn(ji,jj,jk,jpnh4) / ( concnnh4 + trn(ji,jj,jk,jpnh4) ) 
     125               zlim3    = trn(ji,jj,jk,jpfer) / ( concfebac+ trn(ji,jj,jk,jpfer) ) 
     126               zlim4    = trn(ji,jj,jk,jpdoc) / ( xkdoc   + trn(ji,jj,jk,jpdoc) ) 
     127               xlimbac(ji,jj,jk) = MIN( zlim1, zlim2, zlim3 ) * zlim4 
     128 
     129               !   Michaelis-Menten Limitation term for nutrients Diatoms 
     130               !   ---------------------------------------------- 
     131               zdenom   = 1. / ( zconc1d * zconc1dnh4 + zconc1dnh4 * trn(ji,jj,jk,jpno3) + zconc1d * trn(ji,jj,jk,jpnh4) ) 
     132               xdiatno3(ji,jj,jk) = trn(ji,jj,jk,jpno3) * zconc1dnh4 * zdenom 
     133               xdiatnh4(ji,jj,jk) = trn(ji,jj,jk,jpnh4) * zconc1d    * zdenom 
     134               ! 
     135               zlim1    = xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) 
     136               zlim2    = trn(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + zconc1dnh4  ) 
     137               zlim3    = trn(ji,jj,jk,jpsil) / ( trn(ji,jj,jk,jpsil) + xksi(ji,jj) ) 
     138               zratio   = trn(ji,jj,jk,jpdfe)/(trn(ji,jj,jk,jpdia)+rtrn) 
     139               zironmin = xcoef1 * trn(ji,jj,jk,jpdch) * z1_trndia + xcoef2 * zlim1 + xcoef3 * xdiatno3(ji,jj,jk) 
     140               zlim4    = MAX( 0., ( zratio - zironmin ) / qdfelim ) 
     141               xlimdfe(ji,jj,jk) = MIN( 1., zlim4 ) 
     142               xlimdia(ji,jj,jk) = MIN( zlim1, zlim2, zlim3, zlim4 ) 
     143               xlimsi(ji,jj,jk)  = MIN( zlim1, zlim2, zlim4 ) 
     144           END DO 
    82145         END DO 
    83146      END DO 
    84147 
    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  
     148      ! Compute the fraction of nanophytoplankton that is made of calcifiers 
     149      ! -------------------------------------------------------------------- 
    89150      DO jk = 1, jpkm1 
    90151         DO jj = 1, jpj 
    91152            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. ) 
     153               zlim1 =  ( trn(ji,jj,jk,jpno3) * concnnh4 + trn(ji,jj,jk,jpnh4) * conc0 )    & 
     154                  &   / ( conc0 * concnnh4 + concnnh4 * trn(ji,jj,jk,jpno3)  + conc0 * trn(ji,jj,jk,jpnh4) )  
     155               zlim2  = trn(ji,jj,jk,jppo4) / ( trn(ji,jj,jk,jppo4) + concnnh4 ) 
     156               zlim3  = trn(ji,jj,jk,jpfer) / ( trn(ji,jj,jk,jpfer) + concfebac ) 
     157               ztem1  = MAX( 0., tsn(ji,jj,jk,jp_tem) ) 
     158               ztem2  = tsn(ji,jj,jk,jp_tem) - 10. 
     159               zetot1 = MAX( 0., etot(ji,jj,jk) - 1.) / ( 4. + etot(ji,jj,jk) )  
     160               zetot2 = 1. / ( 30. + etot(ji,jj,jk) )  
     161 
     162               xfracal(ji,jj,jk) = caco3r * MIN( zlim1, zlim2, zlim3 )                  & 
     163                  &                       * ztem1 / ( 0.1 + ztem1 )                     & 
     164                  &                       * MAX( 1., trn(ji,jj,jk,jpphy) * 1.e6 / 2. )  & 
     165                  &                       * 2.325 * zetot1 * 30. * zetot2               & 
     166                  &                       * ( 1. + EXP(-ztem2 * ztem2 / 25. ) )         & 
     167                  &                       * MIN( 1., 50. / ( hmld(ji,jj) + rtrn ) ) 
    161168               xfracal(ji,jj,jk) = MIN( 0.8 , xfracal(ji,jj,jk) ) 
    162                xfracal(ji,jj,jk) = MAX( 0.01, xfracal(ji,jj,jk) ) 
     169               xfracal(ji,jj,jk) = MAX( 0.02, xfracal(ji,jj,jk) ) 
    163170            END DO 
    164171         END DO 
    … …  
    182189 
    183190      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 ) 
     191         &                xsizedia, xsizephy, concnnh4, concdnh4,       & 
     192         &                xksi1, xksi2, xkdoc, concfebac, qnfelim, qdfelim, caco3r 
     193 
     194      REWIND( numnatp )                     ! read numnat 
     195      READ  ( numnatp, nampislim ) 
    188196 
    189197      IF(lwp) THEN                         ! control print 
    … …  
    191199         WRITE(numout,*) ' Namelist parameters for nutrient limitations, nampislim' 
    192200         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 
     201         WRITE(numout,*) '    mean rainratio                           caco3r    = ', caco3r 
     202         WRITE(numout,*) '    NO3, PO4 half saturation                 conc0     =  ', conc0 
     203         WRITE(numout,*) '    half saturation constant for Si uptake   xksi1     = ', xksi1 
     204         WRITE(numout,*) '    half saturation constant for Si/C        xksi2     = ', xksi2 
     205         WRITE(numout,*) '    2nd half-sat. of DOC remineralization    xkdoc     = ', xkdoc 
     206         WRITE(numout,*) '    Phosphate half saturation for diatoms    conc1     = ', conc1 
     207         WRITE(numout,*) '    Iron half saturation for phyto           conc2     = ', conc2 
     208         WRITE(numout,*) '    Max iron half saturation for phyto       conc2m    = ', conc2m 
     209         WRITE(numout,*) '    Iron half saturation for diatoms         conc3     = ', conc3 
     210         WRITE(numout,*) '    Maxi iron half saturation for diatoms    conc3m    = ', conc3m 
     211         WRITE(numout,*) '    Minimum size criteria for diatoms        xsizedia  = ', xsizedia 
     212         WRITE(numout,*) '    Minimum size criteria for nanophyto      xsizephy  = ', xsizephy 
     213         WRITE(numout,*) '    NH4 half saturation for phyto            concnnh4  = ', concnnh4 
     214         WRITE(numout,*) '    NH4 half saturation for diatoms          concdnh4  = ', concdnh4 
     215         WRITE(numout,*) '    Fe half saturation for bacteria          concfebac = ', concfebac 
     216         WRITE(numout,*) '    optimal Fe quota for nano.               qnfelim   = ', qnfelim 
     217         WRITE(numout,*) '    Optimal Fe quota for diatoms             qdfelim   = ', qdfelim 
    205218      ENDIF 
    206219 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zlys.F90

    r2715 r2977  
    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 
    … …  
    6263      INTEGER, INTENT(in) ::   kt ! ocean time step 
    6364      INTEGER  ::   ji, jj, jk, jn 
    64       REAL(wp) ::   zbot, zalk, zdic, zph, zremco3, zah2 
    65       REAL(wp) ::   zdispot, zfact, zalka 
     65      REAL(wp) ::   zalk, zdic, zph, zremco3, zah2 
     66      REAL(wp) ::   zdispot, zfact, zcalcon, zalka, zaldi 
    6667      REAL(wp) ::   zomegaca, zexcess, zexcess0 
    67 #if defined key_diatrc && defined key_iomput 
    6868      REAL(wp) ::   zrfact2 
    69 #endif 
    7069      CHARACTER (len=25) :: charout 
    7170      !!--------------------------------------------------------------------- 
    … …  
    7574      END IF 
    7675 
    77       zco3(:,:,:) = 0. 
    78 # if defined key_diatrc && defined key_iomput 
     76      zco3    (:,:,:) = 0. 
    7977      zcaldiss(:,:,:) = 0. 
    80 # endif 
    8178      !     ------------------------------------------- 
    8279      !     COMPUTE [CO3--] and [H+] CONCENTRATIONS 
    … …  
    9188!CDIR NOVERRCHK 
    9289               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  
     90                  zfact = rhop(ji,jj,jk) / 1000. + rtrn 
     91                  zph  = hi(ji,jj,jk) * tmask(ji,jj,jk) / zfact + ( 1.-tmask(ji,jj,jk) ) * 1.e-9 ! [H+] 
    10592                  zdic  = trn(ji,jj,jk,jpdic) / zfact 
    10693                  zalka = trn(ji,jj,jk,jptal) / zfact 
    107  
    10894                  ! CALCULATE [ALK]([CO3--], [HCO3-]) 
    109                   zalk  = zalka - (  akw3(ji,jj,jk) / zph - zph   & 
    110                      &             + zbot / (1.+ zph / akb3(ji,jj,jk) )  ) 
    111  
     95                  zalk  = zalka - ( akw3(ji,jj,jk) / zph - zph + borat(ji,jj,jk) / ( 1. + zph / akb3(ji,jj,jk) ) ) 
    11296                  ! 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  
     97                  zaldi = zdic - zalk 
     98                  zah2  = SQRT( zaldi * zaldi + 4.* ( zalk * ak23(ji,jj,jk) / ak13(ji,jj,jk) ) * ( zdic + zaldi ) ) 
     99                  zah2  = 0.5 * ak13(ji,jj,jk) / zalk * ( zaldi + zah2 ) 
     100                  ! 
     101                  zco3(ji,jj,jk) = zalk / ( 2. + zah2 / ak23(ji,jj,jk) ) * zfact 
     102                  hi(ji,jj,jk)   = zah2 * zfact 
    122103               END DO 
    123104            END DO 
    … …  
    137118 
    138119               ! DEVIATION OF [CO3--] FROM SATURATION VALUE 
    139                zomegaca = ( calcon * zco3(ji,jj,jk) ) / aksp(ji,jj,jk) 
     120               ! Salinity dependance in zomegaca and divide by rhop/1000 to have good units 
     121               zcalcon  = calcon * ( tsn(ji,jj,jk,jp_sal) / 35._wp ) 
     122               zfact    = rhop(ji,jj,jk) / 1000._wp 
     123               zomegaca = ( zcalcon * zco3(ji,jj,jk) * zfact ) / aksp(ji,jj,jk)  
    140124 
    141125               ! SET DEGREE OF UNDER-/SUPERSATURATION 
    142                zexcess0 = MAX( 0., ( 1.- zomegaca ) ) 
     126               excess(ji,jj,jk) = 1._wp - zomegaca 
     127               zexcess0 = MAX( 0., excess(ji,jj,jk) ) 
    143128               zexcess  = zexcess0**nca 
    144129 
    … …  
    146131               !       (ACCORDING TO THIS FORMULATION ALSO SOME PARTICULATE 
    147132               !       CACO3 GETS DISSOLVED EVEN IN THE CASE OF OVERSATURATION) 
     133               zdispot = kdca * zexcess * trn(ji,jj,jk,jpcal) 
    148134# 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) 
     135               zdispot = zdispot * facvol(ji,jj,jk) 
    152136# endif 
    153  
    154137              !  CHANGE OF [CO3--] , [ALK], PARTICULATE [CACO3], 
    155138              !       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 
     139              zcaldiss(ji,jj,jk)  = zdispot / rmtss  ! calcite dissolution 
     140              zco3(ji,jj,jk)      = zco3(ji,jj,jk) + zcaldiss(ji,jj,jk) * rfact 
     141              ! 
     142              tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + 2. * zcaldiss(ji,jj,jk) 
     143              tra(ji,jj,jk,jpcal) = tra(ji,jj,jk,jpcal) -      zcaldiss(ji,jj,jk) 
     144              tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) +      zcaldiss(ji,jj,jk) 
    165145            END DO 
    166146         END DO 
    167147      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 
     148      ! 
     149      IF( ln_diatrc )  THEN 
     150         ! 
     151         IF( lk_iomput ) THEN 
     152            zrfact2 = 1.e3 * rfact2r 
     153            CALL iom_put( "PH"    , hi      (:,:,:)           * tmask(:,:,:) ) 
     154            CALL iom_put( "CO3"   , zco3    (:,:,:)           * tmask(:,:,:) ) 
     155            CALL iom_put( "CO3sat", aksp    (:,:,:) / calcon  * tmask(:,:,:) ) 
     156            CALL iom_put( "DCAL"  , zcaldiss(:,:,:) * zrfact2 * tmask(:,:,:) ) 
     157         ELSE 
     158            trc3d(:,:,:,jp_pcs0_3d    ) = hi  (:,:,:)          * tmask(:,:,:) 
     159            trc3d(:,:,:,jp_pcs0_3d + 1) = zco3(:,:,:)          * tmask(:,:,:) 
     160            trc3d(:,:,:,jp_pcs0_3d + 2) = aksp(:,:,:) / calcon * tmask(:,:,:) 
     161         ENDIF 
     162         ! 
     163      ENDIF 
    182164      ! 
    183165       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    … …  
    207189      NAMELIST/nampiscal/ kdca, nca 
    208190 
    209       REWIND( numnat )                     ! read numnat 
    210       READ  ( numnat, nampiscal ) 
     191      REWIND( numnatp )                     ! read numnatp 
     192      READ  ( numnatp, nampiscal ) 
    211193 
    212194      IF(lwp) THEN                         ! control print 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmeso.F90

    r2528 r2977  
    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 
    8085 
    8186      !!--------------------------------------------------------------------- 
    … …  
    8489         DO jj = 1, jpj 
    8590            DO ji = 1, jpi 
    86  
    87                zcompam = MAX( ( trn(ji,jj,jk,jpmes) - 1.e-9 ), 0.e0 ) 
     91               zcompam   = MAX( ( trn(ji,jj,jk,jpmes) - 1.e-8 ), 0.e0 ) 
    8892# if defined key_degrad 
    89                zstep   = xstep * facvol(ji,jj,jk) 
     93               zstep     = xstep * facvol(ji,jj,jk) 
    9094# else 
    91                zstep   = xstep 
     95               zstep     = xstep 
    9296# endif 
    93                zfact   = zstep * tgfunc(ji,jj,jk) * zcompam 
     97               zfact     = zstep * tgfunc(ji,jj,jk) * zcompam 
    9498 
    9599               !  Respiration rates of both zooplankton 
    96100               !  ------------------------------------- 
    97                zrespz2  = resrat2 * zfact * ( 1. + 3. * nitrfac(ji,jj,jk) )        & 
    98                   &     * trn(ji,jj,jk,jpmes) / ( xkmort + trn(ji,jj,jk,jpmes) ) 
     101               zrespz2   = resrat2 * zfact * trn(ji,jj,jk,jpmes) / ( xkmort + trn(ji,jj,jk,jpmes) )  & 
     102                  &      + resrat2 * zfact * 3. * nitrfac(ji,jj,jk) 
    99103 
    100104               !  Zooplankton mortality. A square function has been selected with 
    101105               !  no real reason except that it seems to be more stable and may mimic predation 
    102106               !  --------------------------------------------------------------- 
    103                ztortz2 = mzrat2 * 1.e6 * zfact * trn(ji,jj,jk,jpmes) 
     107               ztortz2   = mzrat2 * 1.e6 * zfact * trn(ji,jj,jk,jpmes) 
    104108               ! 
    105109 
    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                 
     110               zcompadi  = MAX( ( trn(ji,jj,jk,jpdia) - xthresh2dia ), 0.e0 ) 
     111               zcompaz   = MAX( ( trn(ji,jj,jk,jpzoo) - xthresh2zoo ), 0.e0 ) 
     112               zcompaph  = MAX( ( trn(ji,jj,jk,jpphy) - xthresh2phy ), 0.e0 ) 
     113               zcompapoc = MAX( ( trn(ji,jj,jk,jppoc) - xthresh2poc ), 0.e0 ) 
     114 
     115               zfood     = xprefc * zcompadi + xprefz * zcompaz + xprefp * zcompaph + xprefpoc * zcompapoc  
     116               zfoodlim  = MAX( 0., zfood - xthresh2 ) 
     117               zdenom    = zfoodlim / ( xkgraz2 + zfoodlim ) 
     118               zdenom2   = zdenom / ( zfood + rtrn ) 
     119               zgraze2   = grazrat2 * zstep * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpmes)  
     120 
     121               zgrazd    = zgraze2  * xprefc   * zcompadi  * zdenom2  
     122               zgrazz    = zgraze2  * xprefz   * zcompaz   * zdenom2  
     123               zgrazn    = zgraze2  * xprefp   * zcompaph  * zdenom2  
     124               zgrazpoc  = zgraze2  * xprefpoc * zcompapoc * zdenom2  
     125 
     126               zgraznf   = zgrazn   * trn(ji,jj,jk,jpnfe) / ( trn(ji,jj,jk,jpphy) + rtrn) 
     127               zgrazf    = zgrazd   * trn(ji,jj,jk,jpdfe) / ( trn(ji,jj,jk,jpdia) + rtrn) 
     128               zgrazpof  = zgrazpoc * trn(ji,jj,jk,jpsfe) / ( trn(ji,jj,jk,jppoc) + rtrn) 
     129 
    129130               !  Mesozooplankton flux feeding on GOC 
    130131               !  ---------------------------------- 
    131132# 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) 
     133               zgrazffe  = grazflux * zstep * wsbio4(ji,jj,jk)          & 
     134                 &                 * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpmes) 
     135               zgrazfff  = zgrazffe * trn(ji,jj,jk,jpbfe) / (trn(ji,jj,jk,jpgoc) + rtrn) 
    135136# 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) 
     137               zgrazffe = grazflux * zstep * wsbio3(ji,jj,jk)     & 
     138               zgrazfff   = zgrazffe * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 
    148139# 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  
     140              ! 
     141              zgraztot   = zgrazd + zgrazz + zgrazn + zgrazpoc + zgrazffe 
     142              zgraztotf  = zgrazf + zgraznf + zgrazz * ferat3 + zgrazpof + zgrazfff  
     143 
     144              ! Total grazing ( grazing by microzoo is already computed in p4zmicro ) 
     145              grazing(ji,jj,jk) = grazing(ji,jj,jk) + zgraztot 
    155146              !    Mesozooplankton efficiency 
    156147              !    -------------------------- 
    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.)  ) 
     148              zgrasrat   =  zgraztotf / ( zgraztot + rtrn ) 
     149              zncratio   = (  xprefc   * zcompadi * quotad(ji,jj,jk)  & 
     150                  &         + xprefp   * zcompaph * quotan(ji,jj,jk)  & 
     151                  &         + xprefz   * zcompaz                      & 
     152                  &         + xprefpoc * zcompapoc   ) / ( zfood + rtrn ) 
     153               zepshert  = epsher2 * MIN( 1., zncratio ) 
     154               zepsherv  = zepshert * MIN( 1., zgrasrat / ferat3 ) 
     155               zgrarem2  = zgraztot * ( 1. - zepsherv - unass2 ) 
     156               zgrafer2  = zgraztot * MAX( 0. , ( 1. - unass2 ) * zgrasrat - ferat3 * zepshert )  
     157               zgrapoc2  = zgraztot * unass2 
     158 
     159               !   Update the arrays TRA which contain the biological sources and sinks 
     160               zgrarsig  = zgrarem2 * sigma2 
     161               tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarsig 
     162               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarsig 
     163               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem2 - zgrarsig 
     164               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarsig 
     165               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) + zgrafer2 
     166               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarsig 
     167               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zgrarsig               
     168#if defined key_kriest 
     169               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc2 
     170               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc2 * xkr_dmeso 
     171               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zgraztotf * unass2 
    164172#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 
     173               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zgrapoc2 
     174               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zgraztotf * unass2 
    188175#endif 
    189176               zmortz2 = ztortz2 + zrespz2 
    190                tra(ji,jj,jk,jpmes) = tra(ji,jj,jk,jpmes) - zmortz2 + epsher2 * zgrapoc2 
     177               tra(ji,jj,jk,jpmes) = tra(ji,jj,jk,jpmes) - zmortz2 + zepsherv * zgraztot  
    191178               tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazd 
    192179               tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zgrazz 
    … …  
    199186               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazf 
    200187 
    201                zprcaca = xfracal(ji,jj,jk) * unass2 * zgrazn 
    202 #if defined key_diatrc 
     188               zprcaca = xfracal(ji,jj,jk) * zgrazn 
     189               ! calcite production 
    203190               prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
    204 #endif 
    205                zprcaca = part * zprcaca 
     191               ! 
     192               zprcaca = part2 * zprcaca 
    206193               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca 
    207194               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2. * zprcaca 
    … …  
    212199               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) - zgrazpoc * znumpoc & 
    213200                  &    + 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 
     201               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz2 - zgrazfff - zgrazpof 
    216202#else 
    217203               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zgrazpoc 
    218204               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zmortz2 - zgrazffe 
    219205               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 
     206               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + ferat3 * zmortz2 - zgrazfff 
    222207#endif 
    223208 
    … …  
    226211      END DO 
    227212      ! 
    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 
     213      IF( ln_diatrc .AND. lk_iomput ) THEN 
     214         zrfact2 = 1.e3 * rfact2r 
     215         grazing(:,:,:) = grazing(:,:,:) * zrfact2 * tmask(:,:,:)   ! Total grazing of phyto by zoo 
     216         prodcal(:,:,:) = prodcal(:,:,:) * zrfact2 * tmask(:,:,:)   ! Calcite production 
     217         IF( jnt == nrdttrc ) THEN 
     218            CALL iom_put( "GRAZ" , grazing  )  ! Total grazing of phyto by zooplankton 
     219            CALL iom_put( "PCAL" , prodcal  )  ! Calcite production 
     220         ENDIF 
    237221      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 
     222      ! 
     223      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
     224        WRITE(charout, FMT="('meso')") 
     225        CALL prt_ctl_trc_info(charout) 
     226        CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm) 
     227      ENDIF 
    245228 
    246229   END SUBROUTINE p4z_meso 
    … …  
    260243      !!---------------------------------------------------------------------- 
    261244 
    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 ) 
     245      NAMELIST/nampismes/ part2, grazrat2, resrat2, mzrat2, xprefc, xprefp, xprefz,   & 
     246         &                xprefpoc, xthresh2dia, xthresh2phy, xthresh2zoo, xthresh2poc, & 
     247         &                xthresh2, xkgraz2, epsher2, sigma2, unass2, grazflux 
     248 
     249      REWIND( numnatp )                     ! read numnatp 
     250      READ  ( numnatp, nampismes ) 
    267251 
    268252 
    … …  
    271255         WRITE(numout,*) ' Namelist parameters for mesozooplankton, nampismes' 
    272256         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 
     257         WRITE(numout,*) '    part of calcite not dissolved in mesozoo guts  part2        =', part2 
     258         WRITE(numout,*) '    mesozoo preference for phyto                   xprefc       =', xprefc 
     259         WRITE(numout,*) '    mesozoo preference for POC                     xprefp       =', xprefp 
     260         WRITE(numout,*) '    mesozoo preference for zoo                     xprefz       =', xprefz 
     261         WRITE(numout,*) '    mesozoo preference for poc                     xprefpoc     =', xprefpoc 
     262         WRITE(numout,*) '    microzoo feeding threshold  for mesozoo        xthresh2zoo  =', xthresh2zoo 
     263         WRITE(numout,*) '    diatoms feeding threshold  for mesozoo         xthresh2dia  =', xthresh2dia 
     264         WRITE(numout,*) '    nanophyto feeding threshold for mesozoo        xthresh2phy  =', xthresh2phy 
     265         WRITE(numout,*) '    poc feeding threshold for mesozoo              xthresh2poc  =', xthresh2poc 
     266         WRITE(numout,*) '    feeding threshold for mesozooplankton          xthresh2     =', xthresh2 
     267         WRITE(numout,*) '    exsudation rate of mesozooplankton             resrat2      =', resrat2 
     268         WRITE(numout,*) '    mesozooplankton mortality rate                 mzrat2       =', mzrat2 
     269         WRITE(numout,*) '    maximal mesozoo grazing rate                   grazrat2     =', grazrat2 
     270         WRITE(numout,*) '    mesozoo flux feeding rate                      grazflux     =', grazflux 
     271         WRITE(numout,*) '    non assimilated fraction of P by mesozoo       unass2       =', unass2 
     272         WRITE(numout,*) '    Efficicency of Mesozoo growth                  epsher2      =', epsher2 
     273         WRITE(numout,*) '    Fraction of mesozoo excretion as DOM           sigma2       =', sigma2 
     274         WRITE(numout,*) '    half sturation constant for grazing 2          xkgraz2      =', xkgraz2 
    285275      ENDIF 
    286276 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmicro.F90

    r2528 r2977  
    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 
    … …  
    7481      !!--------------------------------------------------------------------- 
    7582 
    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  
     83      grazing(:,:,:) = 0.  !: grazing set to zero 
    8384      DO jk = 1, jpkm1 
    8485         DO jj = 1, jpj 
    8586            DO ji = 1, jpi 
    86                zcompaz = MAX( ( trn(ji,jj,jk,jpzoo) - 1.e-9 ), 0.e0 ) 
     87               zcompaz = MAX( ( trn(ji,jj,jk,jpzoo) - 1.e-8 ), 0.e0 ) 
     88               zstep   = xstep 
    8789# if defined key_degrad 
    88                zstep   = xstep * facvol(ji,jj,jk) 
    89 # else 
    90                zstep   = xstep 
     90               zstep = zstep * facvol(ji,jj,jk) 
    9191# endif 
    92                zfact   = zstep * tgfunc(ji,jj,jk) * zcompaz 
     92               zfact   = zstep * tgfunc2(ji,jj,jk) * zcompaz 
    9393 
    9494               !  Respiration rates of both zooplankton 
    9595               !  ------------------------------------- 
    96                zrespz = resrat * zfact  * ( 1.+ 3.* nitrfac(ji,jj,jk) )     & 
    97                   &            * trn(ji,jj,jk,jpzoo) / ( xkmort + trn(ji,jj,jk,jpzoo) ) 
     96               zrespz = resrat * zfact * trn(ji,jj,jk,jpzoo) / ( 2. * xkmort + trn(ji,jj,jk,jpzoo) )  & 
     97                  &   + resrat * zfact * 3. * nitrfac(ji,jj,jk) 
    9898 
    9999               !  Zooplankton mortality. A square function has been selected with 
    … …  
    102102               ztortz = mzrat * 1.e6 * zfact * trn(ji,jj,jk,jpzoo) 
    103103 
    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 ) 
     104               zcompadi  = MIN( MAX( ( trn(ji,jj,jk,jpdia) - xthreshdia ), 0.e0 ), xsizedia ) 
     105               zcompaph  = MAX( ( trn(ji,jj,jk,jpphy) - xthreshphy ), 0.e0 ) 
     106               zcompapoc = MAX( ( trn(ji,jj,jk,jppoc) - xthreshpoc ), 0.e0 ) 
    108107                
    109108               !     Microzooplankton grazing 
    110109               !     ------------------------ 
    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 
     110               zfood     = xpref2p * zcompaph + xpref2c * zcompapoc + xpref2d * zcompadi 
     111               zfoodlim  = MAX( 0. , zfood - xthresh ) 
     112               zdenom    = zfoodlim / ( xkgraz + zfoodlim ) 
     113               zdenom2   = zdenom / ( zfood + rtrn ) 
     114               zgraze    = grazrat * zstep * tgfunc2(ji,jj,jk) * trn(ji,jj,jk,jpzoo)  
     115 
     116               zgrazp    = zgraze  * xpref2p * zcompaph  * zdenom2  
     117               zgrazm    = zgraze  * xpref2c * zcompapoc * zdenom2  
     118               zgrazsd   = zgraze  * xpref2d * zcompadi  * zdenom2  
     119 
     120               zgrazpf   = zgrazp  * trn(ji,jj,jk,jpnfe) / (trn(ji,jj,jk,jpphy) + rtrn) 
     121               zgrazmf   = zgrazm  * trn(ji,jj,jk,jpsfe) / (trn(ji,jj,jk,jppoc) + rtrn) 
     122               zgrazsf   = zgrazsd * trn(ji,jj,jk,jpdfe) / (trn(ji,jj,jk,jpdia) + rtrn) 
     123               ! 
     124               zgraztot  = zgrazp  + zgrazm  + zgrazsd  
     125               zgraztotf = zgrazpf + zgrazsf + zgrazmf  
     126 
    129127               ! Grazing by microzooplankton 
    130                grazing(ji,jj,jk) = grazing(ji,jj,jk) + zgrazp + zgrazm + zgrazsd  
    131 #endif 
     128               grazing(ji,jj,jk) = grazing(ji,jj,jk) + zgraztot 
    132129 
    133130               !    Various remineralization and excretion terms 
    134131               !    -------------------------------------------- 
    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 )  
     132               zgrasrat  = zgraztotf / ( zgraztot + rtrn ) 
     133               zncratio  = ( xpref2p * zcompaph * quotan(ji,jj,jk) & 
     134                  &        + xpref2d * zcompadi * quotad(ji,jj,jk) + xpref2c * zcompapoc ) / ( zfood + rtrn ) 
     135               zepshert  = epsher * MIN( 1., zncratio ) 
     136               zepsherv  = zepshert * MIN( 1., zgrasrat / ferat3 ) 
     137               zgrafer   = zgraztot * MAX( 0. , ( 1. - unass ) * zgrasrat - ferat3 * zepshert )  
     138               zgrarem   = zgraztot * ( 1. - zepsherv - unass ) 
     139               zgrapoc   = zgraztot * unass 
    142140 
    143141               !  Update of the TRA arrays 
    144142               !  ------------------------ 
    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 
     143               zgrarsig  = zgrarem * sigma1 
     144               tra(ji,jj,jk,jppo4) = tra(ji,jj,jk,jppo4) + zgrarsig 
     145               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + zgrarsig 
     146               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + zgrarem - zgrarsig 
     147               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2ut * zgrarsig 
    150148               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 
     149               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zgrapoc 
     150               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zgraztotf * unass 
     151               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) + zgrarsig 
     152               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * zgrarsig 
    153153#if defined key_kriest 
    154                tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc * unass * xkr_ddiat 
     154               tra(ji,jj,jk,jpnum) = tra(ji,jj,jk,jpnum) + zgrapoc * xkr_ddiat 
    155155#endif 
    156  
    157                ! 
    158156               !   Update the arrays TRA which contain the biological sources and sinks 
    159157               !   -------------------------------------------------------------------- 
    160  
    161158               zmortz = ztortz + zrespz 
    162                tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zmortz + epsher * zgrapoc  
     159               tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) - zmortz + zepsherv * zgraztot  
    163160               tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) - zgrazp 
    164161               tra(ji,jj,jk,jpdia) = tra(ji,jj,jk,jpdia) - zgrazsd 
    … …  
    170167               tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) - zgrazsf 
    171168               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 
     169               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + ferat3 * zmortz - zgrazmf 
     170               zprcaca = xfracal(ji,jj,jk) * zgrazp 
     171               ! 
     172               ! calcite production 
    175173               prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
    176 #endif 
     174               ! 
    177175               zprcaca = part * zprcaca 
    178176               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca 
    … …  
    203201      !! 
    204202      !! ** Method  :   Read the nampiszoo namelist and check the parameters 
    205       !!      called at the first timestep (nit000) 
     203      !!                called at the first timestep (nit000) 
    206204      !! 
    207205      !! ** input   :   Namelist nampiszoo 
    … …  
    209207      !!---------------------------------------------------------------------- 
    210208 
    211       NAMELIST/nampiszoo/ grazrat,resrat,mzrat,xpref2c, xpref2p, & 
    212          &             xpref2d, xkgraz, epsher, sigma1, unass 
    213  
    214       REWIND( numnat )                     ! read numnat 
    215       READ  ( numnat, nampiszoo ) 
     209      NAMELIST/nampiszoo/ part, grazrat, resrat, mzrat, xpref2c, xpref2p, & 
     210         &                xpref2d,  xthreshdia,  xthreshphy,  xthreshpoc, & 
     211         &                xthresh, xkgraz, epsher, sigma1, unass 
     212 
     213      REWIND( numnatp )                     ! read numnatp 
     214      READ  ( numnatp, nampiszoo ) 
    216215 
    217216      IF(lwp) THEN                         ! control print 
    … …  
    219218         WRITE(numout,*) ' Namelist parameters for microzooplankton, nampiszoo' 
    220219         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 
     220         WRITE(numout,*) '    part of calcite not dissolved in microzoo guts  part        =', part 
     221         WRITE(numout,*) '    microzoo preference for POC                     xpref2c     =', xpref2c 
     222         WRITE(numout,*) '    microzoo preference for nano                    xpref2p     =', xpref2p 
     223         WRITE(numout,*) '    microzoo preference for diatoms                 xpref2d     =', xpref2d 
     224         WRITE(numout,*) '    diatoms feeding threshold  for microzoo         xthreshdia  =', xthreshdia 
     225         WRITE(numout,*) '    nanophyto feeding threshold for microzoo        xthreshphy  =', xthreshphy 
     226         WRITE(numout,*) '    poc feeding threshold for microzoo              xthreshpoc  =', xthreshpoc 
     227         WRITE(numout,*) '    feeding threshold for microzooplankton          xthresh     =', xthresh 
     228         WRITE(numout,*) '    exsudation rate of microzooplankton             resrat      =', resrat 
     229         WRITE(numout,*) '    microzooplankton mortality rate                 mzrat       =', mzrat 
     230         WRITE(numout,*) '    maximal microzoo grazing rate                   grazrat     =', grazrat 
     231         WRITE(numout,*) '    non assimilated fraction of P by microzoo       unass       =', unass 
     232         WRITE(numout,*) '    Efficicency of microzoo growth                  epsher      =', epsher 
     233         WRITE(numout,*) '    Fraction of microzoo excretion as DOM           sigma1      =', sigma1 
     234         WRITE(numout,*) '    half sturation constant for grazing 1           xkgraz      =', xkgraz 
    231235      ENDIF 
    232236 
    233237   END SUBROUTINE p4z_micro_init 
     238 
     239   INTEGER FUNCTION p4z_micro_alloc() 
     240      !!---------------------------------------------------------------------- 
     241      !!                     ***  ROUTINE p4z_micro_alloc  *** 
     242      !!---------------------------------------------------------------------- 
     243      ALLOCATE( grazing(jpi,jpj,jpk), STAT=p4z_micro_alloc ) 
     244      IF( p4z_micro_alloc /= 0 ) CALL ctl_warn('p4z_micro_alloc : failed to allocate arrays.') 
     245 
     246   END FUNCTION p4z_micro_alloc 
    234247 
    235248#else 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zmort.F90

    r2528 r2977  
    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 
    … …  
    2625   PUBLIC   p4z_mort     
    2726   PUBLIC   p4z_mort_init     
    28  
     27   PUBLIC   p4z_mort_alloc     
    2928 
    3029   !! * 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           !: 
     30   REAL(wp), PUBLIC :: wchl   = 0.001_wp  !: 
     31   REAL(wp), PUBLIC :: wchld  = 0.02_wp   !: 
     32   REAL(wp), PUBLIC :: mprat  = 0.01_wp   !: 
     33   REAL(wp), PUBLIC :: mprat2 = 0.01_wp   !: 
     34   REAL(wp), PUBLIC :: mpratm = 0.01_wp   !: 
    3735 
    3836 
    … …  
    8179      !!--------------------------------------------------------------------- 
    8280 
    83  
    84 #if defined key_diatrc 
    85      prodcal(:,:,:) = 0.  !: Initialisation of calcite production variable 
    86 #endif 
    87  
     81      prodcal(:,:,:) = 0.  !: calcite production variable set to zero 
    8882      DO jk = 1, jpkm1 
    8983         DO jj = 1, jpj 
    9084            DO ji = 1, jpi 
    91  
    9285               zcompaph = MAX( ( trn(ji,jj,jk,jpphy) - 1e-8 ), 0.e0 ) 
    93  
     86               zstep    = xstep 
    9487# if defined key_degrad 
    95                zstep =  xstep * facvol(ji,jj,jk)   
    96 # else 
    97                zstep =  xstep   
     88               zstep    = zstep * facvol(ji,jj,jk) 
    9889# endif 
    9990               !     Squared mortality of Phyto similar to a sedimentation term during 
    … …  
    117108               tra(ji,jj,jk,jpnfe) = tra(ji,jj,jk,jpnfe) - zmortp * zfactfe 
    118109               zprcaca = xfracal(ji,jj,jk) * zmortp 
    119 #if defined key_diatrc 
     110               ! 
    120111               prodcal(ji,jj,jk) = prodcal(ji,jj,jk) + zprcaca  ! prodcal=prodcal(nanophy)+prodcal(microzoo)+prodcal(mesozoo) 
    121 #endif 
     112               ! 
    122113               zfracal = 0.5 * xfracal(ji,jj,jk) 
    123114               tra(ji,jj,jk,jpdic) = tra(ji,jj,jk,jpdic) - zprcaca 
    … …  
    177168               !    sticky and coagulate to sink quickly out of the euphotic zone 
    178169               !     ------------------------------------------------------------ 
    179  
     170               zstep   = xstep 
    180171# if defined key_degrad 
    181                zstep =  xstep * facvol(ji,jj,jk)   
    182 # else 
    183                zstep =  xstep   
     172               zstep = zstep * facvol(ji,jj,jk) 
    184173# endif 
    185174               !  Phytoplankton respiration  
    … …  
    243232      NAMELIST/nampismort/ wchl, wchld, mprat, mprat2, mpratm 
    244233 
    245       REWIND( numnat )                     ! read numnat 
    246       READ  ( numnat, nampismort ) 
     234      REWIND( numnatp )                     ! read numnatp 
     235      READ  ( numnatp, nampismort ) 
    247236 
    248237      IF(lwp) THEN                         ! control print 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zopt.F90

    r2715 r2977  
    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 
    … …  
    5354      !!--------------------------------------------------------------------- 
    5455      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 
     56      USE wrk_nemo, ONLY:   zdepmoy => wrk_2d_1 , zetmp  => wrk_2d_2 
     57      USE wrk_nemo, ONLY:   zetmp1  => wrk_2d_3 , zetmp2 => wrk_2d_4 
     58      USE wrk_nemo, ONLY:   zekg    => wrk_3d_2 , zekr   => wrk_3d_3 , zekb => wrk_3d_4 
     59      USE wrk_nemo, ONLY:   ze0     => wrk_3d_5 , ze1    => wrk_3d_6 
     60      USE wrk_nemo, ONLY:   ze2     => wrk_3d_7 , ze3    => wrk_3d_8 
    5961      ! 
    6062      INTEGER, INTENT(in) ::   kt, jnt   ! ocean time step 
    … …  
    6365      INTEGER  ::   irgb 
    6466      REAL(wp) ::   zchl, zxsi0r 
    65       REAL(wp) ::   zc0 , zc1 , zc2, zc3 
     67      REAL(wp) ::   zc0 , zc1 , zc2, zc3, z1_dep 
    6668      !!--------------------------------------------------------------------- 
    6769 
    68       IF(  wrk_in_use(2, 1,2)   .OR.   wrk_in_use(3, 2,3,4,5,6,7,8)   ) THEN 
     70      IF(  wrk_in_use(2, 1,2,3,4)   .OR.   wrk_in_use(3, 2,3,4,5,6,7,8)   ) THEN 
    6971         CALL ctl_stop('p4z_opt: requested workspace arrays unavailable')   ;   RETURN 
    7072      ENDIF 
    … …  
    8385            DO ji = 1, jpi 
    8486               zchl = ( trn(ji,jj,jk,jpnch) + trn(ji,jj,jk,jpdch) + rtrn ) * 1.e6 
    85                zchl = MIN(  10. , MAX( 0.03, zchl )  ) 
     87               zchl = MIN(  10. , MAX( 0.05, zchl )  ) 
    8688               irgb = NINT( 41 + 20.* LOG10( zchl ) + rtrn ) 
    8789               !                                                          
    … …  
    9294         END DO 
    9395      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.... 
    9896 
    9997 
    … …  
    145143         etot3(:,:,1) =          qsr(:,:) * tmask(:,:,1) 
    146144         ! 
    147          DO jk = 2, nksrp+1 
     145         DO jk = 2, nksrp + 1 
    148146!CDIR NOVERRCHK 
    149147            DO jj = 1, jpj 
    … …  
    188186      zdepmoy(:,:)   = 0.e0                    !  ------------------------------- 
    189187      zetmp  (:,:)   = 0.e0 
    190       emoy   (:,:,:) = 0.e0 
     188      zetmp1 (:,:)   = 0.e0 
     189      zetmp2 (:,:)   = 0.e0 
    191190 
    192191      DO jk = 1, nksrp 
    … …  
    196195            DO ji = 1, jpi 
    197196               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) 
     197                  zetmp  (ji,jj) = zetmp  (ji,jj) + etot (ji,jj,jk) * fse3t(ji,jj,jk) 
     198                  zetmp1 (ji,jj) = zetmp1 (ji,jj) + enano(ji,jj,jk) * fse3t(ji,jj,jk) 
     199                  zetmp2 (ji,jj) = zetmp2 (ji,jj) + ediat(ji,jj,jk) * fse3t(ji,jj,jk) 
    199200                  zdepmoy(ji,jj) = zdepmoy(ji,jj) + fse3t(ji,jj,jk) 
    200201               ENDIF 
    … …  
    210211!CDIR NOVERRCHK 
    211212            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 
     213               IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
     214                  z1_dep = 1. / ( zdepmoy(ji,jj) + rtrn ) 
     215                  emoy (ji,jj,jk) = zetmp (ji,jj) * z1_dep 
     216                  enano(ji,jj,jk) = zetmp1(ji,jj) * z1_dep 
     217                  ediat(ji,jj,jk) = zetmp2(ji,jj) * z1_dep 
     218               ENDIF 
     219            END DO 
     220         END DO 
     221      END DO 
     222 
     223      IF( ln_diatrc ) THEN        ! save output diagnostics 
     224        ! 
     225        IF( lk_iomput ) THEN 
     226           IF( jnt == nrdttrc ) THEN 
     227              CALL iom_put( "Heup", heup(:,:  ) * tmask(:,:,1) )  ! euphotic layer deptht 
     228              CALL iom_put( "PAR" , etot(:,:,:) * tmask(:,:,:) )  ! Photosynthetically Available Radiation 
     229           ENDIF 
     230        ELSE 
     231           trc2d(:,:,  jp_pcs0_2d + 10) = heup(:,:  ) * tmask(:,:,1)   
     232           trc3d(:,:,:,jp_pcs0_3d + 3)  = etot(:,:,:) * tmask(:,:,:) 
     233        ENDIF 
     234        ! 
    227235      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') 
     236      ! 
     237      IF( wrk_not_released(2, 1,2,3,4)           .OR.   & 
     238          wrk_not_released(3, 2,3,4,5,6,7,8)   )   CALL ctl_stop('p4z_opt: failed to release workspace arrays') 
    233239      ! 
    234240   END SUBROUTINE p4z_opt 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zprod.F90

    r2730 r2977  
    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 
    … …  
    6774      !!--------------------------------------------------------------------- 
    6875      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 
     76      USE wrk_nemo, ONLY:   zmixnano   => wrk_2d_1 , zmixdiat    => wrk_2d_2, zstrn => wrk_2d_3 
     77      USE wrk_nemo, ONLY:   zpislopead => wrk_3d_2 , zpislopead2 => wrk_3d_3 
     78      USE wrk_nemo, ONLY:   zprdia     => wrk_3d_4 , zprbio      => wrk_3d_5  
     79      USE wrk_nemo, ONLY:   zprdch     => wrk_3d_6 , zprnch      => wrk_3d_7 
     80      USE wrk_nemo, ONLY:   zprorca    => wrk_3d_8 , zprorcad    => wrk_3d_9 
     81      USE wrk_nemo, ONLY:   zprofed    => wrk_3d_10, zprofen     => wrk_3d_11 
     82      USE wrk_nemo, ONLY:   zprochln   => wrk_3d_12, zprochld    => wrk_3d_13 
     83      USE wrk_nemo, ONLY:   zpronew    => wrk_3d_14, zpronewd    => wrk_3d_15 
    7684      ! 
    7785      INTEGER, INTENT(in) :: kt, jnt 
    7886      ! 
    7987      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 
     88      REAL(wp) ::   zsilfac, zfact, znanotot, zdiattot, zconctemp, zconctemp2 
     89      REAL(wp) ::   zratio, zmax, zsilim, ztn, zadap 
     90      REAL(wp) ::   zlim, zsilfac2, zsiborn, zprod, zproreg, zproreg2 
     91      REAL(wp) ::   zmxltst, zmxlday, zmaxday 
    8492      REAL(wp) ::   zpislopen  , zpislope2n 
    85       REAL(wp) ::   zrum, zcodel, zargu, zval, zvol 
    86 #if defined key_diatrc 
     93      REAL(wp) ::   zrum, zcodel, zargu, zval 
     94      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: zysopt  
    8795      REAL(wp) ::   zrfact2 
    88 #endif 
    8996      CHARACTER (len=25) :: charout 
    9097      !!--------------------------------------------------------------------- 
    9198 
    9299      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 
     100          wrk_in_use(3, 2,3,4,5,6,7,8,9,10,11,12,13,14,15)  ) THEN 
    94101          CALL ctl_stop('p4z_prod: requested workspace arrays unavailable')   ;   RETURN 
    95102      ENDIF 
     103    
     104      ALLOCATE( zysopt(jpi,jpj,jpk) ) 
    96105 
    97106      zprorca (:,:,:) = 0._wp 
    … …  
    105114      zprdia  (:,:,:) = 0._wp 
    106115      zprbio  (:,:,:) = 0._wp 
     116      zprdch  (:,:,:) = 0._wp 
     117      zprnch  (:,:,:) = 0._wp 
    107118      zysopt  (:,:,:) = 0._wp 
    108119 
    109120      ! Computation of the optimal production 
    110 # if defined key_degrad 
    111       prmax(:,:,:) = rday1 * tgfunc(:,:,:) * facvol(:,:,:) 
    112 # else 
    113       prmax(:,:,:) = rday1 * tgfunc(:,:,:) 
    114 # endif 
     121      prmax(:,:,:) = 0.6_wp * r1_rday * tgfunc(:,:,:)  
     122      IF( lk_degrad )  prmax(:,:,:) = prmax(:,:,:) * facvol(:,:,:)  
    115123 
    116124      ! compute the day length depending on latitude and the day 
    … …  
    119127 
    120128      ! day length in hours 
    121       zstrn(:,:) = 0._wp 
     129      zstrn(:,:) = 0. 
    122130      DO jj = 1, jpj 
    123131         DO ji = 1, jpi 
    124132            zargu = TAN( zcodel ) * TAN( gphit(ji,jj) * rad ) 
    125133            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 
     134            zstrn(ji,jj) = MAX( 0.0, 24. - 2. * ACOS( zargu ) / rad / 15. ) 
    129135         END DO 
    130136      END DO 
    131137 
    132  
     138      IF( ln_newprod ) THEN 
     139         ! Impact of the day duration on phytoplankton growth 
     140         DO jk = 1, jpkm1 
     141            DO jj = 1 ,jpj 
     142               DO ji = 1, jpi 
     143                  zval = MAX( 1., zstrn(ji,jj) ) 
     144                  zval = 1.5 * zval / ( 12. + zval ) 
     145                  zprbio(ji,jj,jk) = prmax(ji,jj,jk) * zval 
     146                  zprdia(ji,jj,jk) = zprbio(ji,jj,jk) 
     147               END DO 
     148            END DO 
     149         END DO 
     150      ENDIF 
     151 
     152      ! Maximum light intensity 
     153      WHERE( zstrn(:,:) < 1.e0 ) zstrn(:,:) = 24. 
     154      zstrn(:,:) = 24. / zstrn(:,:) 
     155 
     156      IF( ln_newprod ) THEN 
     157!CDIR NOVERRCHK 
     158         DO jk = 1, jpkm1 
     159!CDIR NOVERRCHK 
     160            DO jj = 1, jpj 
     161!CDIR NOVERRCHK 
     162               DO ji = 1, jpi 
     163 
     164                  ! Computation of the P-I slope for nanos and diatoms 
     165                  IF( etot(ji,jj,jk) > 1.E-3 ) THEN 
     166                      ztn    = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 
     167                      zadap  = ztn / ( 2.+ ztn ) 
     168 
     169                      zconctemp   = MAX( 0.e0 , trn(ji,jj,jk,jpdia) - 5e-7 ) 
     170                      zconctemp2  = trn(ji,jj,jk,jpdia) - zconctemp 
     171 
     172                      znanotot = enano(ji,jj,jk) * zstrn(ji,jj) 
     173                      zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj) 
     174 
     175                      zfact  = EXP( -0.21 * znanotot ) 
     176                      zpislopead (ji,jj,jk) = pislope  * ( 1.+ zadap  * zfact )  & 
     177                         &                   * trn(ji,jj,jk,jpnch) /( trn(ji,jj,jk,jpphy) * 12. + rtrn) 
     178 
     179                      zpislopead2(ji,jj,jk) = (pislope * zconctemp2 + pislope2 * zconctemp) / ( trn(ji,jj,jk,jpdia) + rtrn )   & 
     180                         &                   * trn(ji,jj,jk,jpdch) /( trn(ji,jj,jk,jpdia) * 12. + rtrn) 
     181 
     182                      ! Computation of production function for Carbon 
     183                      !  --------------------------------------------- 
     184                      zpislopen  = zpislopead (ji,jj,jk) / ( ( r1_rday + bresp * r1_day / chlcnm ) * rday + rtrn) 
     185                      zpislope2n = zpislopead2(ji,jj,jk) / ( ( r1_rday + bresp * r1_day / chlcdm ) * rday + rtrn) 
     186                      zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * ( 1.- EXP( -zpislopen  * znanotot )  ) 
     187                      zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * ( 1.- EXP( -zpislope2n * zdiattot )  ) 
     188 
     189                      !  Computation of production function for Chlorophyll 
     190                      !-------------------------------------------------- 
     191                      zmaxday  = 1._wp / ( prmax(ji,jj,jk) * rday + rtrn ) 
     192                      zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopead (ji,jj,jk) * zmaxday * znanotot ) ) 
     193                      zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopead2(ji,jj,jk) * zmaxday * zdiattot ) ) 
     194                  ENDIF 
     195               END DO 
     196            END DO 
     197         END DO 
     198      ELSE 
     199!CDIR NOVERRCHK 
     200         DO jk = 1, jpkm1 
     201!CDIR NOVERRCHK 
     202            DO jj = 1, jpj 
     203!CDIR NOVERRCHK 
     204               DO ji = 1, jpi 
     205 
     206                  ! Computation of the P-I slope for nanos and diatoms 
     207                  IF( etot(ji,jj,jk) > 1.E-3 ) THEN 
     208                      ztn    = MAX( 0., tsn(ji,jj,jk,jp_tem) - 15. ) 
     209                      zadap  = ztn / ( 2.+ ztn ) 
     210 
     211                      zfact  = EXP( -0.21 * enano(ji,jj,jk) ) 
     212                      zpislopead (ji,jj,jk) = pislope  * ( 1.+ zadap  * zfact ) 
     213                      zpislopead2(ji,jj,jk) = pislope2 
     214 
     215                      zpislopen =  zpislopead(ji,jj,jk) * trn(ji,jj,jk,jpnch)                & 
     216                        &          / ( trn(ji,jj,jk,jpphy) * 12.                  + rtrn )   & 
     217                        &          / ( prmax(ji,jj,jk) * rday * xlimphy(ji,jj,jk) + rtrn ) 
     218 
     219                      zpislope2n = zpislopead2(ji,jj,jk) * trn(ji,jj,jk,jpdch)                & 
     220                        &          / ( trn(ji,jj,jk,jpdia) * 12.                  + rtrn )   & 
     221                        &          / ( prmax(ji,jj,jk) * rday * xlimdia(ji,jj,jk) + rtrn ) 
     222 
     223                      ! Computation of production function for Carbon 
     224                      !  --------------------------------------------- 
     225                      zprbio(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen  * enano(ji,jj,jk) ) ) 
     226                      zprdia(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope2n * ediat(ji,jj,jk) ) ) 
     227 
     228                      !  Computation of production function for Chlorophyll 
     229                      !-------------------------------------------------- 
     230                      zprnch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislopen  * enano(ji,jj,jk) * zstrn(ji,jj) ) ) 
     231                      zprdch(ji,jj,jk) = prmax(ji,jj,jk) * ( 1.- EXP( -zpislope2n * ediat(ji,jj,jk) * zstrn(ji,jj) ) ) 
     232                  ENDIF 
     233               END DO 
     234            END DO 
     235         END DO 
     236      ENDIF 
     237 
     238      !  Computation of a proxy of the N/C ratio 
     239      !  --------------------------------------- 
    133240!CDIR NOVERRCHK 
    134241      DO jk = 1, jpkm1 
    … …  
    137244!CDIR NOVERRCHK 
    138245            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 
     246                zval = ( xnanonh4(ji,jj,jk) + xnanono3(ji,jj,jk) ) * prmax(ji,jj,jk) / ( zprbio(ji,jj,jk) + rtrn ) 
     247                quotan(ji,jj,jk) = MIN( 1., 0.5 + 0.5 * zval ) 
     248                zval = ( xdiatnh4(ji,jj,jk) + xdiatno3(ji,jj,jk) ) * prmax(ji,jj,jk) / ( zprdia(ji,jj,jk) + rtrn ) 
     249                quotad(ji,jj,jk) = MIN( 1., 0.5 + 0.5 * zval ) 
    165250            END DO 
    166251         END DO 
    … …  
    178263                   !    Si/C is arbitrariliy increased for very high Si concentrations 
    179264                   !    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 
     265                  zlim  = trn(ji,jj,jk,jpsil) / ( trn(ji,jj,jk,jpsil) + xksi1 ) 
     266                  zsilim = MIN( zprdia(ji,jj,jk) / ( prmax(ji,jj,jk) + rtrn ), xlimsi(ji,jj,jk) ) 
     267                  zsilfac = 4.4 * EXP( -4.23 * zsilim ) * MAX( 0.e0, MIN( 1., 2.2 * ( zlim - 0.5 ) )  ) + 1.e0 
    189268                  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 
     269                  zsilfac2 = 1.+ 2.* zsiborn / ( zsiborn + xksi2 ) 
     270                  zsilfac = MIN( 5.4, zsilfac * zsilfac2) 
     271                  zysopt(ji,jj,jk) = grosip * zlim * zsilfac 
    193272              ENDIF 
    194273            END DO 
    … …  
    196275      END DO 
    197276 
    198       !  Computation of the limitation term due to 
    199       !  A mixed layer deeper than the euphotic depth 
     277      !  Computation of the limitation term due to a mixed layer deeper than the euphotic depth 
    200278      DO jj = 1, jpj 
    201279         DO ji = 1, jpi 
    202280            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 ) 
     281            zmxlday = zmxltst * zmxltst * r1_rday 
     282            zmixnano(ji,jj) = 1. - zmxlday / ( 3. + zmxlday ) 
     283            zmixdiat(ji,jj) = 1. - zmxlday / ( 4. + zmxlday ) 
    206284         END DO 
    207285      END DO 
    … …  
    219297      END DO 
    220298 
    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  
     299      ! Computation of the various production terms  
    255300!CDIR NOVERRCHK 
    256301      DO jk = 1, jpkm1 
    … …  
    260305            DO ji = 1, jpi 
    261306               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  
     307                  !  production terms for nanophyto. 
     308                  zprorca(ji,jj,jk) = zprbio(ji,jj,jk)  * xlimphy(ji,jj,jk) * trn(ji,jj,jk,jpphy) * rfact2 
     309                  zpronew(ji,jj,jk) = zprorca(ji,jj,jk) * xnanono3(ji,jj,jk) / ( xnanono3(ji,jj,jk) + xnanonh4(ji,jj,jk) + rtrn ) 
     310                  ! 
     311                  zratio = trn(ji,jj,jk,jpnfe) / ( trn(ji,jj,jk,jpphy) + rtrn ) 
     312                  zratio = zratio / fecnm  
     313                  zmax   = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) )  
     314                  zprofen(ji,jj,jk) = fecnm * prmax(ji,jj,jk)  & 
     315                  &             * ( 4. - 4.5 * xlimnfe(ji,jj,jk) / ( xlimnfe(ji,jj,jk) + 0.5 ) )    & 
     316                  &             * trn(ji,jj,jk,jpfer) / ( trn(ji,jj,jk,jpfer) + concnfe(ji,jj,jk) )  & 
     317                  &             * zmax * trn(ji,jj,jk,jpphy) * rfact2 
     318                  !  production terms for diatomees 
    271319                  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  
     320                  zpronewd(ji,jj,jk) = zprorcad(ji,jj,jk) * xdiatno3(ji,jj,jk) / ( xdiatno3(ji,jj,jk) + xdiatnh4(ji,jj,jk) + rtrn ) 
     321                  ! 
     322                  zratio = trn(ji,jj,jk,jpdfe) / ( trn(ji,jj,jk,jpdia) + rtrn ) 
     323                  zratio = zratio / fecdm  
     324                  zmax   = MAX( 0., ( 1. - zratio ) / ABS( 1.05 - zratio ) )  
     325                  zprofed(ji,jj,jk) = fecdm * prmax(ji,jj,jk)  & 
     326                  &             * ( 4. - 4.5 * xlimdfe(ji,jj,jk) / ( xlimdfe(ji,jj,jk) + 0.5 ) )    & 
     327                  &             * trn(ji,jj,jk,jpfer) / ( trn(ji,jj,jk,jpfer) + concdfe(ji,jj,jk) )  & 
     328                  &             * zmax * trn(ji,jj,jk,jpdia) * rfact2 
    284329               ENDIF 
    285330            END DO 
    286331         END DO 
    287332      END DO 
    288       ! 
     333 
     334      IF( ln_newprod ) THEN 
     335!CDIR NOVERRCHK 
     336         DO jk = 1, jpkm1 
     337!CDIR NOVERRCHK 
     338            DO jj = 1, jpj 
     339!CDIR NOVERRCHK 
     340               DO ji = 1, jpi 
     341                  IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
     342                     zprnch(ji,jj,jk) = zprnch(ji,jj,jk) * zmixnano(ji,jj) 
     343                     zprdch(ji,jj,jk) = zprdch(ji,jj,jk) * zmixdiat(ji,jj) 
     344                  ENDIF 
     345                  IF( etot(ji,jj,jk) > 1.E-3 ) THEN 
     346                     !  production terms for nanophyto. ( chlorophyll ) 
     347                     znanotot = enano(ji,jj,jk) * zstrn(ji,jj) 
     348                     zprod    = rday * zprorca(ji,jj,jk) * zprnch(ji,jj,jk) * xlimphy(ji,jj,jk) 
     349                     zprochln(ji,jj,jk) = chlcmin * 12. * zprorca (ji,jj,jk) 
     350                     zprochln(ji,jj,jk) = zprochln(ji,jj,jk) + chlcnm * 12. * zprod / (  zpislopead(ji,jj,jk) * znanotot +rtrn) 
     351                     !  production terms for diatomees ( chlorophyll ) 
     352                     zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj) 
     353                     zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * xlimdia(ji,jj,jk) 
     354                     zprochld(ji,jj,jk) = chlcmin * 12. * zprorcad(ji,jj,jk) 
     355                     zprochld(ji,jj,jk) = zprochld(ji,jj,jk) + chlcdm * 12. * zprod / ( zpislopead2(ji,jj,jk) * zdiattot +rtrn ) 
     356                  ENDIF 
     357               END DO 
     358            END DO 
     359         END DO 
     360      ELSE 
     361!CDIR NOVERRCHK 
     362         DO jk = 1, jpkm1 
     363!CDIR NOVERRCHK 
     364            DO jj = 1, jpj 
     365!CDIR NOVERRCHK 
     366               DO ji = 1, jpi 
     367                  IF( etot(ji,jj,jk) > 1.E-3 ) THEN 
     368                     !  production terms for nanophyto. ( chlorophyll ) 
     369                     znanotot = enano(ji,jj,jk) * zstrn(ji,jj) 
     370                     zprod = rday * zprorca(ji,jj,jk) * zprnch(ji,jj,jk) * trn(ji,jj,jk,jpphy) * xlimphy(ji,jj,jk) 
     371                     zprochln(ji,jj,jk) = chlcnm * 144. * zprod / (  zpislopead(ji,jj,jk) * trn(ji,jj,jk,jpnch) * znanotot +rtrn) 
     372                     !  production terms for diatomees ( chlorophyll ) 
     373                     zdiattot = ediat(ji,jj,jk) * zstrn(ji,jj) 
     374                     zprod = rday * zprorcad(ji,jj,jk) * zprdch(ji,jj,jk) * trn(ji,jj,jk,jpdia) * xlimdia(ji,jj,jk) 
     375                     zprochld(ji,jj,jk) = chlcdm * 144. * zprod / ( zpislopead2(ji,jj,jk) * trn(ji,jj,jk,jpdch) * zdiattot +rtrn ) 
     376                  ENDIF 
     377               END DO 
     378            END DO 
     379         END DO 
     380      ENDIF 
    289381 
    290382      !   Update the arrays TRA which contain the biological sources and sinks 
    … …  
    304396              tra(ji,jj,jk,jpdfe) = tra(ji,jj,jk,jpdfe) + zprofed(ji,jj,jk) * texcret2 
    305397              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) 
     398              tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) + excret2 * zprorcad(ji,jj,jk) + excret * zprorca(ji,jj,jk) 
    308399              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) 
     400                 &                + ( o2ut + o2nit ) * ( zpronew(ji,jj,jk) + zpronewd(ji,jj,jk) ) 
     401              tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - texcret * zprofen(ji,jj,jk) - texcret2 * zprofed(ji,jj,jk) 
     402              tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) - texcret2 * zprorcad(ji,jj,jk) * zysopt(ji,jj,jk) 
    314403              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) ) 
     404              tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) + rno3 * ( zpronew(ji,jj,jk) + zpronewd(ji,jj,jk) ) & 
     405                 &                                      - rno3 * ( zproreg + zproreg2 ) 
    317406          END DO 
    318407        END DO 
    … …  
    320409 
    321410     ! Total primary production per year 
    322  
    323 #if defined key_degrad 
    324      tpp = tpp + glob_sum( ( zprorca(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) * facvol(:,:,:) ) 
    325 #else 
    326411     tpp = tpp + glob_sum( ( zprorca(:,:,:) + zprorcad(:,:,:) ) * cvol(:,:,:) ) 
    327 #endif 
    328  
    329      IF( kt == nitend .AND. jnt == nrdttrc .AND. lwp ) THEN 
     412 
     413     IF( kt == nitend .AND. jnt == nrdttrc ) THEN 
    330414        WRITE(numout,*) 'Total PP (Gtc) :' 
    331415        WRITE(numout,*) '-------------------- : ',tpp * 12. / 1.E12 
    … …  
    333417      ENDIF 
    334418 
    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(:,:,:) 
     419     IF( ln_diatrc ) THEN 
     420         ! 
     421         zrfact2 = 1.e3 * rfact2r 
     422         IF( lk_iomput ) THEN 
     423           IF( jnt == nrdttrc ) THEN 
     424              CALL iom_put( "PPPHY" , zprorca (:,:,:) * zrfact2 * tmask(:,:,:) )  ! primary production by nanophyto 
     425              CALL iom_put( "PPPHY2", zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) )  ! primary production by diatom 
     426              CALL iom_put( "PPNEWN", zpronew (:,:,:) * zrfact2 * tmask(:,:,:) )  ! new primary production by nanophyto 
     427              CALL iom_put( "PPNEWD", zpronewd(:,:,:) * zrfact2 * tmask(:,:,:) )  ! new primary production by diatom 
     428              CALL iom_put( "PBSi"  , zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) * zysopt(:,:,:) ) ! biogenic silica production 
     429              CALL iom_put( "PFeD"  , zprofed (:,:,:) * zrfact2 * tmask(:,:,:) )  ! biogenic iron production by diatom 
     430              CALL iom_put( "PFeN"  , zprofen (:,:,:) * zrfact2 * tmask(:,:,:) )  ! biogenic iron production by nanophyto 
     431           ENDIF 
     432         ELSE 
     433              trc3d(:,:,:,jp_pcs0_3d + 4)  = zprorca (:,:,:) * zrfact2 * tmask(:,:,:) 
     434              trc3d(:,:,:,jp_pcs0_3d + 5)  = zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) 
     435              trc3d(:,:,:,jp_pcs0_3d + 6)  = zpronew (:,:,:) * zrfact2 * tmask(:,:,:) 
     436              trc3d(:,:,:,jp_pcs0_3d + 7)  = zpronewd(:,:,:) * zrfact2 * tmask(:,:,:) 
     437              trc3d(:,:,:,jp_pcs0_3d + 8)  = zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) * zysopt(:,:,:) 
     438              trc3d(:,:,:,jp_pcs0_3d + 9)  = zprofed (:,:,:) * zrfact2 * tmask(:,:,:) 
    344439#  if ! defined key_kriest 
    345       trc3d(:,:,:,jp_pcs0_3d + 10) = zprofen (:,:,:) * zrfact2 * tmask(:,:,:) 
     440              trc3d(:,:,:,jp_pcs0_3d + 10) = zprofen (:,:,:) * zrfact2 * tmask(:,:,:) 
    346441#  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 
     442         ENDIF 
     443         ! 
     444      ENDIF 
    361445 
    362446      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    … …  
    367451 
    368452      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)   )   & 
     453           wrk_not_released(3, 2,3,4,5,6,7,8,9,10,11,12,13,14,15)   )   & 
    370454           CALL ctl_stop('p4z_prod: failed to release workspace arrays') 
     455      ! 
     456      DEALLOCATE( zysopt ) 
    371457      ! 
    372458   END SUBROUTINE p4z_prod 
    … …  
    384470      !! ** input   :   Namelist nampisprod 
    385471      !!---------------------------------------------------------------------- 
    386       NAMELIST/nampisprod/ pislope, pislope2, excret, excret2, chlcnm, chlcdm,   & 
    387          &              fecnm, fecdm, grosip 
     472      ! 
     473      NAMELIST/nampisprod/ pislope, pislope2, ln_newprod, bresp, excret, excret2,  & 
     474         &                 chlcnm, chlcdm, chlcmin, fecnm, fecdm, grosip 
    388475      !!---------------------------------------------------------------------- 
    389476 
    390       REWIND( numnat )                     ! read numnat 
    391       READ  ( numnat, nampisprod ) 
     477      REWIND( numnatp )                     ! read numnatp 
     478      READ  ( numnatp, nampisprod ) 
    392479 
    393480      IF(lwp) THEN                         ! control print 
    … …  
    395482         WRITE(numout,*) ' Namelist parameters for phytoplankton growth, nampisprod' 
    396483         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    397          WRITE(numout,*) '    mean Si/C ratio                           grosip    =', grosip 
    398          WRITE(numout,*) '    P-I slope                                 pislope   =', pislope 
    399          WRITE(numout,*) '    excretion ratio of nanophytoplankton      excret    =', excret 
    400          WRITE(numout,*) '    excretion ratio of diatoms                excret2   =', excret2 
    401          WRITE(numout,*) '    P-I slope  for diatoms                    pislope2  =', pislope2 
    402          WRITE(numout,*) '    Minimum Chl/C in nanophytoplankton        chlcnm    =', chlcnm 
    403          WRITE(numout,*) '    Minimum Chl/C in diatoms                  chlcdm    =', chlcdm 
    404          WRITE(numout,*) '    Maximum Fe/C in nanophytoplankton         fecnm     =', fecnm 
    405          WRITE(numout,*) '    Minimum Fe/C in diatoms                   fecdm     =', fecdm 
    406       ENDIF 
    407       ! 
    408       rday1     = 0.6 / rday  
    409       texcret   = 1.0 - excret 
    410       texcret2  = 1.0 - excret2 
    411       tpp       = 0. 
     484         WRITE(numout,*) '    Enable new parame. of production (T/F)   ln_newprod   =', ln_newprod 
     485         WRITE(numout,*) '    mean Si/C ratio                           grosip       =', grosip 
     486         WRITE(numout,*) '    P-I slope                                 pislope      =', pislope 
     487         WRITE(numout,*) '    excretion ratio of nanophytoplankton      excret       =', excret 
     488         WRITE(numout,*) '    excretion ratio of diatoms                excret2      =', excret2 
     489         IF( ln_newprod ) 
     490            WRITE(numout,*) '    basal respiration in phytoplankton        bresp        =', bresp 
     491            WRITE(numout,*) '    Maximum Chl/C in phytoplankton            chlcmin      =', chlcmin 
     492         ENDIF 
     493         WRITE(numout,*) '    P-I slope  for diatoms                    pislope2     =', pislope2 
     494         WRITE(numout,*) '    Minimum Chl/C in nanophytoplankton        chlcnm       =', chlcnm 
     495         WRITE(numout,*) '    Minimum Chl/C in diatoms                  chlcdm       =', chlcdm 
     496         WRITE(numout,*) '    Maximum Fe/C in nanophytoplankton         fecnm        =', fecnm 
     497         WRITE(numout,*) '    Minimum Fe/C in diatoms                   fecdm        =', fecdm 
     498      ENDIF 
     499      ! 
     500      r1_rday   = 1._wp / rday  
     501      texcret   = 1._wp - excret 
     502      texcret2  = 1._wp - excret2 
     503      tpp       = 0._wp 
    412504      ! 
    413505   END SUBROUTINE p4z_prod_init 
    … …  
    418510      !!                     ***  ROUTINE p4z_prod_alloc  *** 
    419511      !!---------------------------------------------------------------------- 
    420       ALLOCATE( prmax(jpi,jpj,jpk), STAT=p4z_prod_alloc ) 
     512      ALLOCATE( prmax(jpi,jpj,jpk), quotan(jpi,jpj,jpk), quotad(jpi,jpj,jpk), STAT = p4z_prod_alloc ) 
    421513      ! 
    422514      IF( p4z_prod_alloc /= 0 ) CALL ctl_warn('p4z_prod_alloc : failed to allocate arrays.') 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zrem.F90

    r2773 r2977  
    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 
    … …  
    1213   !!   'key_pisces'                                       PISCES bio-model 
    1314   !!---------------------------------------------------------------------- 
    14    !!   p4z_rem       :   Compute remineralization/scavenging of organic compounds 
    15    !!---------------------------------------------------------------------- 
    16    USE trc 
    17    USE oce_trc         ! 
    18    USE sms_pisces      !  
    19    USE prtctl_trc 
    20    USE p4zint 
    21    USE p4zopt 
    22    USE p4zmeso 
    23    USE p4zprod 
    24    USE p4zche 
     15   !!   p4z_rem       :  Compute remineralization/scavenging of organic compounds 
     16   !!   p4z_rem_init  :  Initialisation of parameters for remineralisation 
     17   !!   p4z_rem_alloc :  Allocate remineralisation variables 
     18   !!---------------------------------------------------------------------- 
     19   USE oce_trc         !  shared variables between ocean and passive tracers 
     20   USE trc             !  passive tracers common variables  
     21   USE sms_pisces      !  PISCES Source Minus Sink variables 
     22   USE p4zopt          !  optical model 
     23   USE p4zche          !  chemical model 
     24   USE p4zprod         !  Growth rate of the 2 phyto groups 
     25   USE p4zmeso         !  Sources and sinks of mesozooplankton 
     26   USE p4zint          !  interpolation and computation of various fields 
     27   USE prtctl_trc      !  print control for debugging 
    2528 
    2629   IMPLICIT NONE 
    … …  
    3134   PUBLIC   p4z_rem_alloc 
    3235 
    33    REAL(wp), PUBLIC ::   & 
    34      xremik  = 0.3_wp      ,  & !: 
    35      xremip  = 0.025_wp    ,  & !: 
    36      nitrif  = 0.05_wp     ,  & !: 
    37      xsirem  = 0.015_wp    ,  & !: 
    38      xlam1   = 0.005_wp    ,  & !: 
    39      oxymin  = 1.e-6_wp         !: 
    40  
    41    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   denitr   !: denitrification array 
     36   !! * Shared module variables 
     37   REAL(wp), PUBLIC ::  xremik    = 0.3_wp     !: remineralisation rate of POC  
     38   REAL(wp), PUBLIC ::  xremip    = 0.025_wp   !: remineralisation rate of DOC 
     39   REAL(wp), PUBLIC ::  nitrif    = 0.05_wp    !: NH4 nitrification rate  
     40   REAL(wp), PUBLIC ::  xsirem    = 0.003_wp   !: remineralisation rate of POC  
     41   REAL(wp), PUBLIC ::  xsiremlab = 0.025_wp   !: fast remineralisation rate of POC  
     42   REAL(wp), PUBLIC ::  xsilab    = 0.31_wp    !: fraction of labile biogenic silica  
     43   REAL(wp), PUBLIC ::  xlam1     = 0.005_wp   !: scavenging rate of Iron  
     44   REAL(wp), PUBLIC ::  oxymin    = 1.e-6_wp   !: halk saturation constant for anoxia  
     45   REAL(wp), PUBLIC ::  ligand    = 0.6E-9_wp  !: ligand concentration in the ocean  
     46 
     47 
     48   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   denitr     !: denitrification array 
     49   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   denitnh4   !: -    -    -    -   - 
    4250 
    4351 
    … …  
    6169      USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    6270      USE wrk_nemo, ONLY:   ztempbac => wrk_2d_1 
    63       USE wrk_nemo, ONLY:   zdepbac  => wrk_3d_2 , zolimi => wrk_3d_3 
     71      USE wrk_nemo, ONLY:   zdepbac  => wrk_3d_2, zolimi => wrk_3d_3, zolimi2 => wrk_3d_4 
    6472      ! 
    6573      INTEGER, INTENT(in) ::   kt ! ocean time step 
    6674      ! 
    6775      INTEGER  ::   ji, jj, jk 
    68       REAL(wp) ::   zremip, zremik , zlam1b 
     76      REAL(wp) ::   zremip, zremik , zlam1b, zdepbac2 
    6977      REAL(wp) ::   zkeq  , zfeequi, zsiremin, zfesatur 
    70       REAL(wp) ::   zsatur, zsatur2, znusil 
     78      REAL(wp) ::   zsatur, zsatur2, znusil, zdep, zfactdep 
    7179      REAL(wp) ::   zbactfer, zorem, zorem2, zofer 
    72       REAL(wp) ::   zosil, zdenom1, zscave, zaggdfe 
     80      REAL(wp) ::   zosil, zdenom1, zscave, zaggdfe, zcoag 
    7381#if ! defined key_kriest 
    7482      REAL(wp) ::   zofer2, zdenom, zdenom2 
    … …  
    7886      !!--------------------------------------------------------------------- 
    7987 
    80       IF(  wrk_in_use(2, 1)  .OR.  wrk_in_use(3, 2,3)  ) THEN 
     88      IF(  wrk_in_use(2, 1)  .OR.  wrk_in_use(3, 2,3,4)  ) THEN 
    8189         CALL ctl_stop('p4z_rem: requested workspace arrays unavailable')   ;   RETURN 
    8290      ENDIF 
    … …  
    8593       zdepbac (:,:,:) = 0._wp 
    8694       zolimi  (:,:,:) = 0._wp 
     95       zolimi2 (:,:,:) = 0._wp 
    8796       ztempbac(:,:)   = 0._wp 
    8897 
    … …  
    93102         DO jj = 1, jpj 
    94103            DO ji = 1, jpi 
    95                IF( fsdept(ji,jj,jk) < 120. ) THEN 
     104               zdep = MAX( hmld(ji,jj), heup(ji,jj) ) 
     105               IF( fsdept(ji,jj,jk) < zdep ) THEN 
    96106                  zdepbac(ji,jj,jk) = MIN( 0.7 * ( trn(ji,jj,jk,jpzoo) + 2.* trn(ji,jj,jk,jpmes) ), 4.e-6 ) 
    97107                  ztempbac(ji,jj)   = zdepbac(ji,jj,jk) 
    98108               ELSE 
    99                   zdepbac(ji,jj,jk) = MIN( 1., 120./ fsdept(ji,jj,jk) ) * ztempbac(ji,jj) 
     109                  zdepbac(ji,jj,jk) = MIN( 1., zdep / fsdept(ji,jj,jk) ) * ztempbac(ji,jj) 
    100110               ENDIF 
    101111            END DO 
    … …  
    117127         DO jj = 1, jpj 
    118128            DO ji = 1, jpi 
     129               zstep   = xstep 
    119130# if defined key_degrad 
    120                zstep = xstep * facvol(ji,jj,jk) 
    121 # else 
    122                zstep = xstep 
     131               zstep = zstep * facvol(ji,jj,jk) 
    123132# endif 
    124133               ! DOC ammonification. Depends on depth, phytoplankton biomass 
    … …  
    126135               !     of the bacterial activity.  
    127136               zremik = xremik * zstep / 1.e-6 * xlimbac(ji,jj,jk) * zdepbac(ji,jj,jk)  
    128                zremik = MAX( zremik, 5.5e-4 * xstep ) 
    129  
     137               zremik = MAX( zremik, 2.e-4 * xstep ) 
    130138               !     Ammonification in oxic waters with oxygen consumption 
    131139               !     ----------------------------------------------------- 
    132                zolimi(ji,jj,jk) = MIN(  ( trn(ji,jj,jk,jpoxy) - rtrn ) / o2ut,  & 
    133                   &                    zremik * ( 1.- nitrfac(ji,jj,jk) ) * trn(ji,jj,jk,jpdoc)  )  
    134  
     140               zolimi (ji,jj,jk) = zremik * ( 1.- nitrfac(ji,jj,jk) ) * trn(ji,jj,jk,jpdoc)  
     141               zolimi2(ji,jj,jk) = MIN( ( trn(ji,jj,jk,jpoxy) - rtrn ) / o2ut, zolimi(ji,jj,jk) )  
    135142               !     Ammonification in suboxic waters with denitrification 
    136143               !     ------------------------------------------------------- 
    137                denitr(ji,jj,jk) = MIN(  ( trn(ji,jj,jk,jpno3) - rtrn ) / rdenit,   & 
     144               denitr(ji,jj,jk)  = MIN(  ( trn(ji,jj,jk,jpno3) - rtrn ) / rdenit,   & 
    138145                  &                     zremik * nitrfac(ji,jj,jk) * trn(ji,jj,jk,jpdoc)  ) 
    139             END DO 
    140          END DO 
    141       END DO 
    142  
    143       DO jk = 1, jpkm1 
    144          DO jj = 1, jpj 
    145             DO ji = 1, jpi 
     146               ! 
    146147               zolimi (ji,jj,jk) = MAX( 0.e0, zolimi (ji,jj,jk) ) 
     148               zolimi2(ji,jj,jk) = MAX( 0.e0, zolimi2(ji,jj,jk) ) 
    147149               denitr (ji,jj,jk) = MAX( 0.e0, denitr (ji,jj,jk) ) 
    148             END DO 
    149          END DO 
    150       END DO 
    151  
    152       DO jk = 1, jpkm1 
    153          DO jj = 1, jpj 
    154             DO ji = 1, jpi 
     150               ! 
     151            END DO 
     152         END DO 
     153      END DO 
     154 
     155 
     156      DO jk = 1, jpkm1 
     157         DO jj = 1, jpj 
     158            DO ji = 1, jpi 
     159               zstep   = xstep 
    155160# if defined key_degrad 
    156                zstep = xstep * facvol(ji,jj,jk) 
    157 # else 
    158                zstep = xstep 
     161               zstep = zstep * facvol(ji,jj,jk) 
    159162# endif 
    160163               !    NH4 nitrification to NO3. Ceased for oxygen concentrations 
    161164               !    below 2 umol/L. Inhibited at strong light  
    162165               !    ---------------------------------------------------------- 
    163                zonitr  = nitrif * zstep * trn(ji,jj,jk,jpnh4) / ( 1.+ emoy(ji,jj,jk) ) * ( 1.- nitrfac(ji,jj,jk) )  
    164  
     166               zonitr  =nitrif * zstep * trn(ji,jj,jk,jpnh4) / ( 1.+ emoy(ji,jj,jk) ) * ( 1.- nitrfac(ji,jj,jk) )  
     167               denitnh4(ji,jj,jk) = nitrif * zstep * trn(ji,jj,jk,jpnh4) * nitrfac(ji,jj,jk)  
    165168               !   Update of the tracers trends 
    166169               !   ---------------------------- 
    167  
    168                tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zonitr 
    169                tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zonitr 
     170               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zonitr - denitnh4(ji,jj,jk) 
     171               tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zonitr - rdenita * denitnh4(ji,jj,jk) 
    170172               tra(ji,jj,jk,jpoxy) = tra(ji,jj,jk,jpoxy) - o2nit * zonitr 
    171                tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - rno3  * zonitr 
    172  
     173               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2 * rno3 * zonitr + rno3 * ( rdenita - 1. ) * denitnh4(ji,jj,jk) 
    173174            END DO 
    174175         END DO 
    … …  
    189190               !    studies (especially at Papa) have shown this uptake to be significant 
    190191               !    ---------------------------------------------------------- 
    191                zbactfer = 15.e-6 * rfact2 * 4.* 0.4 * prmax(ji,jj,jk)           & 
    192                   &               * ( xlimphy(ji,jj,jk) * zdepbac(ji,jj,jk))           & 
    193                   &               * ( xlimphy(ji,jj,jk) * zdepbac(ji,jj,jk))           & 
    194                   &                  / ( xkgraz2 + zdepbac(ji,jj,jk) )                    & 
    195                   &                  * ( 0.5 + SIGN( 0.5, trn(ji,jj,jk,jpfer) -2.e-11 )  ) 
     192               zdepbac2 = zdepbac(ji,jj,jk) * zdepbac(ji,jj,jk) 
     193               zbactfer = 20.e-6 * rfact2 * prmax(ji,jj,jk)                                 & 
     194                  &              * trn(ji,jj,jk,jpfer) / ( 5E-10 + trn(ji,jj,jk,jpfer) )    & 
     195                  &              * zdepbac2 / ( xkgraz2 + zdepbac(ji,jj,jk) )               & 
     196                  &              * ( 0.5 + SIGN( 0.5, trn(ji,jj,jk,jpfer) -2.e-11 )  ) 
    196197 
    197198               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zbactfer 
    … …  
    214215         DO jj = 1, jpj 
    215216            DO ji = 1, jpi 
     217               zstep   = xstep 
    216218# if defined key_degrad 
    217                zstep = xstep * facvol(ji,jj,jk) 
    218 # else 
    219                zstep = xstep 
     219               zstep = zstep * facvol(ji,jj,jk) 
    220220# endif 
    221221               !    POC disaggregation by turbulence and bacterial activity.  
    222222               !    ------------------------------------------------------------- 
    223                zremip = xremip * zstep * tgfunc(ji,jj,jk) * ( 1.- 0.5 * nitrfac(ji,jj,jk) )  
     223               zremip = xremip * zstep * tgfunc(ji,jj,jk) * ( 1.- 0.7 * nitrfac(ji,jj,jk) )  
    224224 
    225225               !    POC disaggregation rate is reduced in anoxic zone as shown by 
    … …  
    266266         DO jj = 1, jpj 
    267267            DO ji = 1, jpi 
     268               zstep   = xstep 
    268269# if defined key_degrad 
    269                zstep = xstep * facvol(ji,jj,jk) 
    270 # else 
    271                zstep = xstep 
     270               zstep = zstep * facvol(ji,jj,jk) 
    272271# endif 
    273272               !     Remineralization rate of BSi depedant on T and saturation 
    274273               !     --------------------------------------------------------- 
    275                zsatur  = ( sio3eq(ji,jj,jk) - trn(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn ) 
    276                zsatur  = MAX( rtrn, zsatur ) 
    277                zsatur2 = zsatur * ( 1. + tsn(ji,jj,jk,jp_tem) / 400.)**4 
    278                znusil  = 0.225  * ( 1. + tsn(ji,jj,jk,jp_tem) / 15.) * zsatur + 0.775 * zsatur2**9 
    279                zsiremin = xsirem * zstep * znusil 
    280                zosil = zsiremin * trn(ji,jj,jk,jpdsi) 
    281  
     274               zsatur   = ( sio3eq(ji,jj,jk) - trn(ji,jj,jk,jpsil) ) / ( sio3eq(ji,jj,jk) + rtrn ) 
     275               zsatur   = MAX( rtrn, zsatur ) 
     276               zsatur2  = zsatur * ( 1. + tsn(ji,jj,jk,jp_tem) / 400.)**4 
     277               znusil   = 0.225  * ( 1. + tsn(ji,jj,jk,jp_tem) / 15.) * zsatur + 0.775 * zsatur2**9.25 
     278               zdep     = MAX( hmld(ji,jj), heup(ji,jj) )  
     279               zdep     = MAX( 0., fsdept(ji,jj,jk) - zdep ) 
     280               zfactdep = xsilab * EXP(-( xsiremlab - xsirem ) * zdep / wsbio2 ) 
     281               zsiremin = ( xsiremlab * zfactdep + xsirem * ( 1. - zfactdep ) ) * zstep * znusil 
     282               zosil    = zsiremin * trn(ji,jj,jk,jpdsi) 
     283               ! 
    282284               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zosil 
    283285               tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) + zosil 
    … …  
    293295       ENDIF 
    294296 
    295       zfesatur = 0.6e-9 
     297      zfesatur = ligand 
    296298!CDIR NOVERRCHK 
    297299      DO jk = 1, jpkm1 
    … …  
    300302!CDIR NOVERRCHK 
    301303            DO ji = 1, jpi 
     304               zstep   = xstep 
    302305# if defined key_degrad 
    303                zstep = xstep * facvol(ji,jj,jk) 
    304 # else 
    305                zstep = xstep 
     306               zstep = zstep * facvol(ji,jj,jk) 
    306307# endif 
    307308               !  Compute de different ratios for scavenging of iron 
    … …  
    312313           &           ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpdsi) + trn(ji,jj,jk,jpcal) + rtrn ) 
    313314#else 
    314                zdenom = 1. / ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpgoc)  & 
    315            &            + trn(ji,jj,jk,jpdsi) + trn(ji,jj,jk,jpcal) + rtrn ) 
    316  
     315               zdenom = 1. / ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpgoc) + trn(ji,jj,jk,jpdsi) + trn(ji,jj,jk,jpcal) + rtrn ) 
    317316               zdenom1 = trn(ji,jj,jk,jppoc) * zdenom 
    318317               zdenom2 = trn(ji,jj,jk,jpgoc) * zdenom 
    … …  
    337336               !  Increased scavenging for very high iron concentrations 
    338337               !  found near the coasts due to increased lithogenic particles 
    339                !  and let s say it unknown processes (precipitation, ...) 
     338               !  and let say it is unknown processes (precipitation, ...) 
    340339               !  ----------------------------------------------------------- 
     340               zlam1b  = xlam1 * MAX( 0.e0, ( trn(ji,jj,jk,jpfer) * 1.e9 - 1. ) ) 
     341               zcoag   = zfeequi * zlam1b * zstep 
    341342               zlamfac = MAX( 0.e0, ( gphit(ji,jj) + 55.) / 30. ) 
    342343               zlamfac = MIN( 1.  , zlamfac ) 
     344               zdep    =  MIN(1., 1000. / fsdept(ji,jj,jk) ) 
    343345#if ! defined key_kriest 
    344346               zlam1b = (  80.* ( trn(ji,jj,jk,jpdoc) + 35.e-6 )                           & 
    345                   &     + 698.*   trn(ji,jj,jk,jppoc) + 1.05e4 * trn(ji,jj,jk,jpgoc)  )                    & 
    346                   &   * xdiss(ji,jj,jk) + 1E-4 * (1.-zlamfac)                & 
    347                   &   + xlam1 * MAX( 0.e0, ( trn(ji,jj,jk,jpfer) * 1.e9 - 1.)  ) 
    348 #else 
    349                zlam1b = (  80.* (trn(ji,jj,jk,jpdoc) + 35E-6)           & 
     347                  &     + 698.*   trn(ji,jj,jk,jppoc) + 1.05e4 * trn(ji,jj,jk,jpgoc)  )    & 
     348                  &   * xdiss(ji,jj,jk) + 1E-4 * ( 1. - zlamfac ) * zdep 
     349#else 
     350               zlam1b = (  80.* (trn(ji,jj,jk,jpdoc) + 35E-6)              & 
    350351                  &     + 698.*  trn(ji,jj,jk,jppoc)  )                    & 
    351                   &   * xdiss(ji,jj,jk) + 1E-4 * (1.-zlamfac)           & 
    352                   &   + xlam1 * MAX( 0.e0, ( trn(ji,jj,jk,jpfer) * 1.e9 - 1.)  ) 
    353 #endif 
    354  
     352                  &   * xdiss(ji,jj,jk) + 1E-4 * ( 1. - zlamfac ) * zdep 
     353#endif 
    355354               zaggdfe = zlam1b * zstep * 0.5 * ( trn(ji,jj,jk,jpfer) - zfeequi ) 
    356  
    357                tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zscave - zaggdfe 
    358  
     355               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zscave - zaggdfe - zcoag 
    359356#if defined key_kriest 
    360357               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zscave * zdenom1 
    … …  
    378375 
    379376      DO jk = 1, jpkm1 
    380          tra(:,:,jk,jppo4) = tra(:,:,jk,jppo4) + zolimi(:,:,jk) + denitr(:,:,jk) 
    381          tra(:,:,jk,jpnh4) = tra(:,:,jk,jpnh4) + zolimi(:,:,jk) + denitr(:,:,jk) 
    382          tra(:,:,jk,jpno3) = tra(:,:,jk,jpno3) - denitr(:,:,jk) * rdenit 
    383          tra(:,:,jk,jpdoc) = tra(:,:,jk,jpdoc) - zolimi(:,:,jk) - denitr(:,:,jk) 
    384          tra(:,:,jk,jpoxy) = tra(:,:,jk,jpoxy) - zolimi(:,:,jk) * o2ut 
    385          tra(:,:,jk,jpdic) = tra(:,:,jk,jpdic) + zolimi(:,:,jk) + denitr(:,:,jk) 
    386          tra(:,:,jk,jptal) = tra(:,:,jk,jptal) + denitr(:,:,jk) * rno3 * rdenit 
     377         tra(:,:,jk,jppo4) = tra(:,:,jk,jppo4) + zolimi (:,:,jk) + denitr(:,:,jk) 
     378         tra(:,:,jk,jpnh4) = tra(:,:,jk,jpnh4) + zolimi (:,:,jk) + denitr(:,:,jk) 
     379         tra(:,:,jk,jpno3) = tra(:,:,jk,jpno3) - denitr (:,:,jk) * rdenit 
     380         tra(:,:,jk,jpdoc) = tra(:,:,jk,jpdoc) - zolimi (:,:,jk) - denitr(:,:,jk) 
     381         tra(:,:,jk,jpoxy) = tra(:,:,jk,jpoxy) - zolimi2(:,:,jk) * o2ut 
     382         tra(:,:,jk,jpdic) = tra(:,:,jk,jpdic) + zolimi (:,:,jk) + denitr(:,:,jk) 
     383         tra(:,:,jk,jptal) = tra(:,:,jk,jptal) + rno3 * ( zolimi(:,:,jk) + ( rdenit + 1.) * denitr(:,:,jk) ) 
    387384      END DO 
    388385 
    … …  
    394391      ! 
    395392      IF(  wrk_not_released(2, 1)     .OR.   & 
    396            wrk_not_released(3, 2,3)  )   CALL ctl_stop('p4z_rem: failed to release workspace arrays') 
     393           wrk_not_released(3, 2,3,4)  )   CALL ctl_stop('p4z_rem: failed to release workspace arrays') 
    397394      ! 
    398395   END SUBROUTINE p4z_rem 
    … …  
    411408      !! 
    412409      !!---------------------------------------------------------------------- 
    413       NAMELIST/nampisrem/ xremik, xremip, nitrif, xsirem, xlam1, oxymin 
    414       !!---------------------------------------------------------------------- 
    415  
    416       REWIND( numnat )                     ! read numnat 
    417       READ  ( numnat, nampisrem ) 
     410      NAMELIST/nampisrem/ xremik, xremip, nitrif, xsirem, xsiremlab, xsilab,   & 
     411      &                   xlam1, oxymin, ligand  
     412 
     413      REWIND( numnatp )                     ! read numnatp 
     414      READ  ( numnatp, nampisrem ) 
    418415 
    419416      IF(lwp) THEN                         ! control print 
    … …  
    424421         WRITE(numout,*) '    remineralization rate of DOC              xremik    =', xremik 
    425422         WRITE(numout,*) '    remineralization rate of Si               xsirem    =', xsirem 
     423         WRITE(numout,*) '    fast remineralization rate of Si          xsiremlab =', xsiremlab 
     424         WRITE(numout,*) '    fraction of labile biogenic silica        xsilab    =', xsilab 
    426425         WRITE(numout,*) '    scavenging rate of Iron                   xlam1     =', xlam1 
    427426         WRITE(numout,*) '    NH4 nitrification rate                    nitrif    =', nitrif 
    428427         WRITE(numout,*) '    halk saturation constant for anoxia       oxymin    =', oxymin 
     428         WRITE(numout,*) '    ligand concentration in the ocean         ligand    =', ligand 
    429429      ENDIF 
    430430      ! 
    431       nitrfac(:,:,:) = 0._wp 
    432       denitr (:,:,:) = 0._wp 
     431      nitrfac (:,:,:) = 0._wp 
     432      denitr  (:,:,:) = 0._wp 
     433      denitnh4(:,:,:) = 0._wp 
    433434      ! 
    434435   END SUBROUTINE p4z_rem_init 
    … …  
    439440      !!                     ***  ROUTINE p4z_rem_alloc  *** 
    440441      !!---------------------------------------------------------------------- 
    441       ALLOCATE( denitr(jpi,jpj,jpk), STAT=p4z_rem_alloc ) 
     442      ALLOCATE( denitr(jpi,jpj,jpk), denitnh4(jpi,jpj,jpk), STAT=p4z_rem_alloc ) 
    442443      ! 
    443444      IF( p4z_rem_alloc /= 0 )   CALL ctl_warn('p4z_rem_alloc: failed to allocate arrays') 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsed.F90

    r2774 r2977  
    66   !! History :   1.0  !  2004-03 (O. Aumont) Original code 
    77   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
     8   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) USE of fldread 
    89   !!---------------------------------------------------------------------- 
    910#if defined key_pisces 
    … …  
    1516   !!   p4z_sed_init   :  Initialization of p4z_sed 
    1617   !!---------------------------------------------------------------------- 
    17    USE trc 
    18    USE oce_trc         ! 
    19    USE sms_pisces 
    20    USE prtctl_trc 
    21    USE p4zbio 
    22    USE p4zint 
    23    USE p4zopt 
    24    USE p4zsink 
    25    USE p4zrem 
    26    USE p4zlim 
    27    USE iom 
    28  
     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 p4zsink         !  vertical flux of particulate matter due to sinking 
     22   USE p4zopt          !  optical model 
     23   USE p4zlim          !  Co-limitations of differents nutrients 
     24   USE p4zrem          !  Remineralisation of organic matter 
     25   USE p4zint          !  interpolation and computation of various fields 
     26   USE iom             !  I/O manager 
     27   USE fldread         !  time interpolation 
     28   USE prtctl_trc      !  print control for debugging 
    2929 
    3030   IMPLICIT NONE 
    … …  
    3636 
    3737   !! * Shared module variables 
    38    LOGICAL, PUBLIC :: ln_dustfer  = .FALSE.    !: boolean for dust input from the atmosphere 
    39    LOGICAL, PUBLIC :: ln_river    = .FALSE.    !: boolean for river input of nutrients 
    40    LOGICAL, PUBLIC :: ln_ndepo    = .FALSE.    !: boolean for atmospheric deposition of N 
    41    LOGICAL, PUBLIC :: ln_sedinput = .FALSE.    !: boolean for Fe input from sediments 
    42  
    43    REAL(wp), PUBLIC :: sedfeinput = 1.E-9_wp   !: Coastal release of Iron 
    44    REAL(wp), PUBLIC :: dustsolub  = 0.014_wp   !: Solubility of the dust 
     38   LOGICAL  :: ln_dust     = .FALSE.    !: boolean for dust input from the atmosphere 
     39   LOGICAL  :: ln_river    = .FALSE.    !: boolean for river input of nutrients 
     40   LOGICAL  :: ln_ndepo    = .FALSE.    !: boolean for atmospheric deposition of N 
     41   LOGICAL  :: ln_ironsed  = .FALSE.    !: boolean for Fe input from sediments 
     42 
     43   REAL(wp) :: sedfeinput  = 1.E-9_wp   !: Coastal release of Iron 
     44   REAL(wp) :: dustsolub   = 0.014_wp   !: Solubility of the dust 
     45   REAL(wp) :: wdust       = 2.0_wp     !: Sinking speed of the dust  
     46   REAL(wp) :: nitrfix     = 1E-7_wp    !: Nitrogen fixation rate    
     47   REAL(wp) :: diazolight  = 50._wp     !: Nitrogen fixation sensitivty to light  
     48   REAL(wp) :: concfediaz  = 1.E-10_wp  !: Fe half-saturation Cste for diazotrophs  
     49 
    4550 
    4651   !! * Module variables 
    4752   REAL(wp) :: ryyss                  !: number of seconds per year  
    48    REAL(wp) :: ryyss1                 !: inverse of ryyss 
     53   REAL(wp) :: r1_ryyss                 !: inverse of ryyss 
    4954   REAL(wp) :: rmtss                  !: number of seconds per month 
    50    REAL(wp) :: rday1                  !: inverse of rday 
    51  
    52    INTEGER , PARAMETER :: jpmth = 12  !: number of months per year 
    53    INTEGER , PARAMETER :: jpyr  = 1   !: one year 
    54  
    55    INTEGER ::  numdust                !: logical unit for surface fluxes data 
    56    INTEGER ::  nflx1 , nflx2          !: first and second record used 
    57    INTEGER ::  nflx11, nflx12 
    58  
    59    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: dustmo    !: set of dust fields 
     55   REAL(wp) :: r1_rday                  !: inverse of rday 
     56   LOGICAL  :: ll_sbc 
     57 
     58   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_dust      ! structure of input dust 
     59   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_riverdic  ! structure of input riverdic 
     60   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_riverdoc  ! structure of input riverdoc 
     61   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_ndepo     ! structure of input nitrogen deposition 
     62   TYPE(FLD), ALLOCATABLE, DIMENSION(:) ::   sf_ironsed   ! structure of input iron from sediment 
     63 
     64   INTEGER , PARAMETER :: nbtimes = 365  !: maximum number of times record in a file 
     65   INTEGER  :: ntimes_dust, ntimes_riv, ntimes_ndep       ! number of time steps in a file 
     66 
    6067   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:) :: dust      !: dust fields 
    6168   REAL(wp), ALLOCATABLE, SAVE,   DIMENSION(:,:) :: rivinp, cotdep    !: river input fields 
    … …  
    8693      !! ** Method  : - ??? 
    8794      !!--------------------------------------------------------------------- 
    88       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    89       USE wrk_nemo, ONLY: zsidep => wrk_2d_1, zwork => wrk_2d_2, zwork1 => wrk_2d_3 
     95      USE wrk_nemo, ONLY: wrk_in_USE, wrk_not_released 
     96      USE wrk_nemo, ONLY: zsidep   => wrk_2d_11 
     97      USE wrk_nemo, ONLY: zwork1   => wrk_2d_12, zwork2 => wrk_2d_13, zwork3 => wrk_2d_14 
    9098      USE wrk_nemo, ONLY: znitrpot => wrk_3d_2, zirondep => wrk_3d_3 
    9199      ! 
    … …  
    96104      REAL(wp) ::   zrivalk, zrivsil, zrivpo4 
    97105#endif 
    98       REAL(wp) ::   zdenitot, znitrpottot, zlim, zfact 
    99       REAL(wp) ::   zwsbio3, zwsbio4, zwscal 
     106      REAL(wp) ::   zdenitot, znitrpottot, zlim, zfact, zfactcal 
     107      REAL(wp) ::   zsiloss, zcaloss, zwsbio3, zwsbio4, zwscal, zdep 
    100108      CHARACTER (len=25) :: charout 
    101109      !!--------------------------------------------------------------------- 
    102110 
    103       IF( ( wrk_in_use(2, 1,2,3) ) .OR. ( wrk_in_use(3, 2,3) ) ) THEN 
     111      IF( ( wrk_in_USE(2, 11,12,13,14) ) .OR. ( wrk_in_USE(3, 2,3) ) ) THEN 
    104112         CALL ctl_stop('p4z_sed: requested workspace arrays unavailable')  ;  RETURN 
    105113      END IF 
    106114 
    107       IF( jnt == 1  .AND.  ln_dustfer  )  CALL p4z_sbc( kt ) 
     115      IF( jnt == 1 .AND. ll_sbc ) CALL p4z_sbc( kt ) 
     116 
     117      zirondep(:,:,:) = 0.e0          ! Initialisation of variables USEd to compute deposition 
     118      zsidep  (:,:)   = 0.e0 
    108119 
    109120      ! Iron and Si deposition at the surface 
    110121      ! ------------------------------------- 
    111  
    112122      DO jj = 1, jpj 
    113123         DO ji = 1, jpi 
    114             zirondep(ji,jj,1) = ( dustsolub * dust(ji,jj) / ( 55.85 * rmtss ) + 3.e-10 * ryyss1 )   & 
    115                &             * rfact2 / fse3t(ji,jj,1) 
    116             zsidep  (ji,jj)   = 8.8 * 0.075 * dust(ji,jj) * rfact2 / ( fse3t(ji,jj,1) * 28.1 * rmtss ) 
     124            zdep  = rfact2 / fse3t(ji,jj,1) 
     125            zirondep(ji,jj,1) = ( dustsolub * dust(ji,jj) / ( 55.85 * rmtss ) + 3.e-10 * r1_ryyss ) * zdep 
     126            zsidep  (ji,jj)   = 8.8 * 0.075 * dust(ji,jj) * zdep / ( 28.1 * rmtss ) 
    117127         END DO 
    118128      END DO 
    … …  
    120130      ! Iron solubilization of particles in the water column 
    121131      ! ---------------------------------------------------- 
    122  
    123132      DO jk = 2, jpkm1 
    124          zirondep(:,:,jk) = dust(:,:) / ( 10. * 55.85 * rmtss ) * rfact2 * 1.e-4 
     133         zirondep(:,:,jk) = dust(:,:) / ( wdust * 55.85 * rmtss ) * rfact2 * 1.e-4 * EXP( -fsdept(:,:,jk) / 1000. ) 
    125134      END DO 
    126135 
    127136      ! Add the external input of nutrients, carbon and alkalinity 
    128137      ! ---------------------------------------------------------- 
    129  
    130138      trn(:,:,1,jppo4) = trn(:,:,1,jppo4) + rivinp(:,:) * rfact2  
    131139      trn(:,:,1,jpno3) = trn(:,:,1,jpno3) + (rivinp(:,:) + nitdep(:,:)) * rfact2 
    … …  
    139147      ! (dust, river and sediment mobilization) 
    140148      ! ------------------------------------------------------ 
    141  
    142149      DO jk = 1, jpkm1 
    143150         trn(:,:,jk,jpfer) = trn(:,:,jk,jpfer) + zirondep(:,:,jk) + ironsed(:,:,jk) * rfact2 
    144151      END DO 
    145  
    146152 
    147153#if ! defined key_sed 
    … …  
    154160            ikt = mbkt(ji,jj)  
    155161# if defined key_kriest 
    156             zwork (ji,jj) = trn(ji,jj,ikt,jpdsi) * wscal (ji,jj,ikt) 
    157             zwork1(ji,jj) = trn(ji,jj,ikt,jppoc) * wsbio3(ji,jj,ikt) 
     162            zwork1(ji,jj) = trn(ji,jj,ikt,jpdsi) * wscal (ji,jj,ikt) 
     163            zwork2(ji,jj) = trn(ji,jj,ikt,jppoc) * wsbio3(ji,jj,ikt) 
    158164# else 
    159             zwork (ji,jj) = trn(ji,jj,ikt,jpdsi) * wsbio4(ji,jj,ikt) 
    160             zwork1(ji,jj) = trn(ji,jj,ikt,jpgoc) * wsbio4(ji,jj,ikt) + trn(ji,jj,ikt,jppoc) * wsbio3(ji,jj,ikt)  
     165            zwork1(ji,jj) = trn(ji,jj,ikt,jpdsi) * wsbio4(ji,jj,ikt) 
     166            zwork2(ji,jj) = trn(ji,jj,ikt,jpgoc) * wsbio4(ji,jj,ikt) + trn(ji,jj,ikt,jppoc) * wsbio3(ji,jj,ikt)  
    161167# endif 
    162          END DO 
    163       END DO 
    164       zsumsedsi  = glob_sum( zwork (:,:) * e1e2t(:,:) ) * rday1 
    165       zsumsedpo4 = glob_sum( zwork1(:,:) * e1e2t(:,:) ) * rday1 
    166       DO jj = 1, jpj 
    167          DO ji = 1, jpi 
    168             ikt = mbkt(ji,jj)  
    169             zwork (ji,jj) = trn(ji,jj,ikt,jpcal) * wscal (ji,jj,ikt) 
    170          END DO 
    171       END DO 
    172       zsumsedcal = glob_sum( zwork (:,:) * e1e2t(:,:) ) * 2.0 * rday1 
     168            ! For calcite, burial efficiency is made a function of saturation 
     169            zfactcal      = MIN( excess(ji,jj,ikt), 0.2 ) 
     170            zfactcal      = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) ) 
     171            zwork3(ji,jj) = trn(ji,jj,ikt,jpcal) * wscal (ji,jj,ikt) * 2.e0 * zfactcal 
     172         END DO 
     173      END DO 
     174      zsumsedsi  = glob_sum( zwork1(:,:) * e1e2t(:,:) ) * r1_rday 
     175      zsumsedpo4 = glob_sum( zwork2(:,:) * e1e2t(:,:) ) * r1_rday 
     176      zsumsedcal = glob_sum( zwork3(:,:) * e1e2t(:,:) ) * r1_rday 
    173177#endif 
    174178 
    175       ! Then this loss is scaled at each bottom grid cell for 
     179      ! THEN this loss is scaled at each bottom grid cell for 
    176180      ! equilibrating the total budget of silica in the ocean. 
    177181      ! Thus, the amount of silica lost in the sediments equal 
    178182      ! the supply at the surface (dust+rivers) 
    179183      ! ------------------------------------------------------ 
     184#if ! defined key_sed 
     185      zrivsil =  1._wp - ( sumdepsi + rivalkinput * r1_ryyss / 6. ) / zsumsedsi  
     186      zrivpo4 =  1._wp - ( rivpo4input * r1_ryyss ) / zsumsedpo4  
     187#endif 
    180188 
    181189      DO jj = 1, jpj 
    182190         DO ji = 1, jpi 
    183             ikt = mbkt(ji,jj) 
    184             zfact = xstep / fse3t(ji,jj,ikt) 
    185             zwsbio3 = 1._wp - zfact * wsbio3(ji,jj,ikt) 
    186             zwsbio4 = 1._wp - zfact * wsbio4(ji,jj,ikt) 
    187             zwscal  = 1._wp - zfact * wscal (ji,jj,ikt) 
     191            ikt  = mbkt(ji,jj) 
     192            zdep = xstep / fse3t(ji,jj,ikt) 
     193            zwsbio4 = wsbio4(ji,jj,ikt) * zdep 
     194            zwscal  = wscal (ji,jj,ikt) * zdep 
     195# if defined key_kriest 
     196            zsiloss = trn(ji,jj,ikt,jpdsi) * zwsbio4 
     197# else 
     198            zsiloss = trn(ji,jj,ikt,jpdsi) * zwscal 
     199# endif 
     200            zcaloss = trn(ji,jj,ikt,jpcal) * zwscal 
    188201            ! 
    189 # if defined key_kriest 
    190             trn(ji,jj,ikt,jpdsi) = trn(ji,jj,ikt,jpdsi) * zwsbio4 
    191             trn(ji,jj,ikt,jpnum) = trn(ji,jj,ikt,jpnum) * zwsbio4 
    192             trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) * zwsbio3 
    193             trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) * zwsbio3 
    194 # else 
    195             trn(ji,jj,ikt,jpdsi) = trn(ji,jj,ikt,jpdsi) * zwscal  
    196             trn(ji,jj,ikt,jpgoc) = trn(ji,jj,ikt,jpgoc) * zwsbio4 
    197             trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) * zwsbio3 
    198             trn(ji,jj,ikt,jpbfe) = trn(ji,jj,ikt,jpbfe) * zwsbio4 
    199             trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) * zwsbio3 
    200 # endif 
    201             trn(ji,jj,ikt,jpcal) = trn(ji,jj,ikt,jpcal) * zwscal 
    202          END DO 
    203       END DO 
    204  
     202            trn(ji,jj,ikt,jpdsi) = trn(ji,jj,ikt,jpdsi) - zsiloss 
     203            trn(ji,jj,ikt,jpcal) = trn(ji,jj,ikt,jpcal) - zcaloss 
    205204#if ! defined key_sed 
    206       zrivsil =  1._wp - ( sumdepsi + rivalkinput * ryyss1 / 6. ) / zsumsedsi  
    207       zrivalk =  1._wp - ( rivalkinput * ryyss1 ) / zsumsedcal  
    208       zrivpo4 =  1._wp - ( rivpo4input * ryyss1 ) / zsumsedpo4  
     205            trn(ji,jj,ikt,jpsil) = trn(ji,jj,ikt,jpsil) + zsiloss * zrivsil  
     206            zfactcal = MIN( excess(ji,jj,ikt), 0.2 ) 
     207            zfactcal = MIN( 1., 1.3 * ( 0.2 - zfactcal ) / ( 0.4 - zfactcal ) ) 
     208            zrivalk  =  1._wp - ( rivalkinput * r1_ryyss ) * zfactcal / zsumsedcal  
     209            trn(ji,jj,ikt,jptal) =  trn(ji,jj,ikt,jptal) + zcaloss * zrivalk * 2.0 
     210            trn(ji,jj,ikt,jpdic) =  trn(ji,jj,ikt,jpdic) + zcaloss * zrivalk 
     211#endif 
     212         END DO 
     213      END DO 
     214 
    209215      DO jj = 1, jpj 
    210216         DO ji = 1, jpi 
    211             ikt = mbkt(ji,jj) 
    212             zfact = xstep / fse3t(ji,jj,ikt) 
    213             zwsbio3 = zfact * wsbio3(ji,jj,ikt) 
    214             zwsbio4 = zfact * wsbio4(ji,jj,ikt) 
    215             zwscal  = zfact * wscal (ji,jj,ikt) 
    216             trn(ji,jj,ikt,jptal) =  trn(ji,jj,ikt,jptal) + trn(ji,jj,ikt,jpcal) * zwscal  * zrivalk * 2.0 
    217             trn(ji,jj,ikt,jpdic) =  trn(ji,jj,ikt,jpdic) + trn(ji,jj,ikt,jpcal) * zwscal  * zrivalk 
    218 # if defined key_kriest 
    219             trn(ji,jj,ikt,jpsil) =  trn(ji,jj,ikt,jpsil) + trn(ji,jj,ikt,jpdsi) * zwsbio4 * zrivsil  
    220             trn(ji,jj,ikt,jpdoc) =  trn(ji,jj,ikt,jpdoc) + trn(ji,jj,ikt,jppoc) * zwsbio3 * zrivpo4  
     217            ikt  = mbkt(ji,jj) 
     218            zdep = xstep / fse3t(ji,jj,ikt) 
     219            zwsbio4 = wsbio4(ji,jj,ikt) * zdep 
     220            zwsbio3 = wsbio3(ji,jj,ikt) * zdep 
     221# if ! defined key_kriest 
     222            trn(ji,jj,ikt,jpgoc) = trn(ji,jj,ikt,jpgoc) - trn(ji,jj,ikt,jpgoc) * zwsbio4 
     223            trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) - trn(ji,jj,ikt,jppoc) * zwsbio3 
     224            trn(ji,jj,ikt,jpbfe) = trn(ji,jj,ikt,jpbfe) - trn(ji,jj,ikt,jpbfe) * zwsbio4 
     225            trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) - trn(ji,jj,ikt,jpsfe) * zwsbio3 
     226#if ! defined key_sed 
     227            trn(ji,jj,ikt,jpdoc) = trn(ji,jj,ikt,jpdoc) & 
     228               &               + ( trn(ji,jj,ikt,jpgoc) * zwsbio4 + trn(ji,jj,ikt,jppoc) * zwsbio3 ) * zrivpo4 
     229#endif 
     230 
    221231# else 
    222             trn(ji,jj,ikt,jpsil) =  trn(ji,jj,ikt,jpsil) + trn(ji,jj,ikt,jpdsi) * zwscal  * zrivsil  
    223             trn(ji,jj,ikt,jpdoc) =  trn(ji,jj,ikt,jpdoc)   & 
    224             &                     + ( trn(ji,jj,ikt,jppoc) * zwsbio3 + trn(ji,jj,ikt,jpgoc) * zwsbio4 ) * zrivpo4 
     232            trn(ji,jj,ikt,jpnum) = trn(ji,jj,ikt,jpnum) - trn(ji,jj,ikt,jpnum) * zwsbio4 
     233            trn(ji,jj,ikt,jppoc) = trn(ji,jj,ikt,jppoc) - trn(ji,jj,ikt,jppoc) * zwsbio3 
     234            trn(ji,jj,ikt,jpsfe) = trn(ji,jj,ikt,jpsfe) - trn(ji,jj,ikt,jpsfe) * zwsbio3 
     235#if ! defined key_sed 
     236            trn(ji,jj,ikt,jpdoc) = trn(ji,jj,ikt,jpdoc) & 
     237               &               + ( trn(ji,jj,ikt,jpnum) * zwsbio4 + trn(ji,jj,ikt,jppoc) * zwsbio3 ) * zrivpo4 
     238#endif 
     239 
    225240# endif 
    226241         END DO 
    227242      END DO 
    228 # endif 
     243 
    229244 
    230245      ! Nitrogen fixation (simple parameterization). The total gain 
    … …  
    233248      ! ------------------------------------------------------------- 
    234249 
    235       zdenitot = glob_sum( denitr(:,:,:)  * cvol(:,:,:) * xnegtr(:,:,:) ) * rdenit 
     250      zdenitot = glob_sum(  ( denitr(:,:,:) * rdenit + denitnh4(:,:,:) * rdenita ) * cvol(:,:,:) )  
    236251 
    237252      ! Potential nitrogen fixation dependant on temperature and iron 
    … …  
    246261               zlim = ( 1.- xnanono3(ji,jj,jk) - xnanonh4(ji,jj,jk) ) 
    247262               IF( zlim <= 0.2 )   zlim = 0.01 
    248                znitrpot(ji,jj,jk) = MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) * rday1 )   & 
    249 # if defined key_degrad 
    250                &                  * facvol(ji,jj,jk)   & 
    251 # endif 
    252                &                  * zlim * rfact2 * trn(ji,jj,jk,jpfer)   & 
    253                &                  / ( conc3 + trn(ji,jj,jk,jpfer) ) * ( 1.- EXP( -etot(ji,jj,jk) / 50.) ) 
     263#if defined key_degrad 
     264               zfact = zlim * rfact2 * facvol(ji,jj,jk) 
     265#else 
     266               zfact = zlim * rfact2  
     267#endif 
     268               znitrpot(ji,jj,jk) =  MAX( 0.e0, ( 0.6 * tgfunc(ji,jj,jk) - 2.15 ) * r1_rday )   & 
     269                 &                 *  zfact * trn(ji,jj,jk,jpfer) / ( concfediaz + trn(ji,jj,jk,jpfer) ) & 
     270                 &                 * ( 1.- EXP( -etot(ji,jj,jk) / diazolight ) ) 
    254271            END DO 
    255272         END DO  
    … …  
    260277      ! Nitrogen change due to nitrogen fixation 
    261278      ! ---------------------------------------- 
    262  
    263279      DO jk = 1, jpk 
    264280         DO jj = 1, jpj 
    265281            DO ji = 1, jpi 
    266                zfact = znitrpot(ji,jj,jk) * 1.e-7 
     282               zfact = znitrpot(ji,jj,jk) * nitrfix 
    267283               trn(ji,jj,jk,jpnh4) = trn(ji,jj,jk,jpnh4) + zfact 
     284               trn(ji,jj,jk,jptal) = trn(ji,jj,jk,jptal) + rno3 * zfact 
    268285               trn(ji,jj,jk,jpoxy) = trn(ji,jj,jk,jpoxy) + zfact   * o2nit 
    269                trn(ji,jj,jk,jppo4) = trn(ji,jj,jk,jppo4) + 30./ 46.* zfact 
    270             END DO 
    271          END DO 
    272       END DO 
    273  
    274 #if defined key_diatrc 
    275       zfact = 1.e+3 * rfact2r 
    276 #  if  ! defined key_iomput 
    277       trc2d(:,:,jp_pcs0_2d + 11) = zirondep(:,:,1)         * zfact * fse3t(:,:,1) * tmask(:,:,1) 
    278       trc2d(:,:,jp_pcs0_2d + 12) = znitrpot(:,:,1) * 1.e-7 * zfact * fse3t(:,:,1) * tmask(:,:,1) 
    279 #  else 
    280       zwork (:,:)  =  ( zirondep(:,:,1) + ironsed(:,:,1) * rfact2 ) * zfact * fse3t(:,:,1) * tmask(:,:,1)  
    281       zwork1(:,:)  =  znitrpot(:,:,1) * 1.e-7                       * zfact * fse3t(:,:,1) * tmask(:,:,1) 
    282       IF( jnt == nrdttrc ) THEN 
    283          CALL iom_put( "Irondep", zwork  )  ! surface downward net flux of iron 
    284          CALL iom_put( "Nfix"   , zwork1 )  ! nitrogen fixation at surface 
    285       ENDIF 
    286 #  endif 
    287 #endif 
     286               trn(ji,jj,jk,jppo4) = trn(ji,jj,jk,jppo4) + 30. / 46. * zfact 
     287           !    trn(ji,jj,jk,jppo4) = trn(ji,jj,jk,jppo4) + zfact 
     288           END DO 
     289         END DO  
     290      END DO 
    288291      ! 
    289        IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    290          WRITE(charout, FMT="('sed ')") 
     292      IF( ln_diatrc ) THEN 
     293         zfact = 1.e+3 * rfact2r 
     294         IF( lk_iomput ) THEN 
     295            zwork1(:,:)  =  ( zirondep(:,:,1) + ironsed(:,:,1) * rfact2 ) * zfact * fse3t(:,:,1) * tmask(:,:,1)  
     296            zwork2(:,:)  =    znitrpot(:,:,1) * nitrfix                   * zfact * fse3t(:,:,1) * tmask(:,:,1) 
     297            IF( jnt == nrdttrc ) THEN 
     298               CALL iom_put( "Irondep", zwork1  )  ! surface downward net flux of iron 
     299               CALL iom_put( "Nfix"   , zwork2 )  ! nitrogen fixation at surface 
     300            ENDIF 
     301         ELSE 
     302            trc2d(:,:,jp_pcs0_2d + 11) = zirondep(:,:,1)           * zfact * fse3t(:,:,1) * tmask(:,:,1) 
     303            trc2d(:,:,jp_pcs0_2d + 12) = znitrpot(:,:,1) * nitrfix * zfact * fse3t(:,:,1) * tmask(:,:,1) 
     304         ENDIF 
     305      ENDIF 
     306      ! 
     307      IF(ln_ctl) THEN  ! print mean trends (USEd for debugging) 
     308         WRITE(charout, fmt="('sed ')") 
    291309         CALL prt_ctl_trc_info(charout) 
    292310         CALL prt_ctl_trc(tab4d=trn, mask=tmask, clinfo=ctrcnm) 
    293        ENDIF 
    294  
    295       IF( ( wrk_not_released(2, 1,2,3) ) .OR. ( wrk_not_released(3, 2,3) ) )   & 
     311      ENDIF 
     312 
     313      IF( ( wrk_not_released(2, 11,12,13,14) ) .OR. ( wrk_not_released(3, 2,3) ) )   & 
    296314        &         CALL ctl_stop('p4z_sed: failed to release workspace arrays') 
    297315 
    … …  
    299317 
    300318   SUBROUTINE p4z_sbc( kt ) 
    301  
    302319      !!---------------------------------------------------------------------- 
    303       !!                  ***  ROUTINE p4z_sbc  *** 
    304       !! 
    305       !! ** Purpose :   Read and interpolate the external sources of  
     320      !!                  ***  routine p4z_sbc  *** 
     321      !! 
     322      !! ** purpose :   read and interpolate the external sources of  
    306323      !!                nutrients 
    307324      !! 
    308       !! ** Method  :   Read the files and interpolate the appropriate variables 
     325      !! ** method  :   read the files and interpolate the appropriate variables 
    309326      !! 
    310327      !! ** input   :   external netcdf files 
    … …  
    314331      INTEGER, INTENT( in  ) ::   kt   ! ocean time step 
    315332 
    316       !! * Local declarations 
    317       INTEGER :: imois, i15, iman  
    318       REAL(wp) :: zxy 
     333      !! * local declarations 
     334      INTEGER  :: ji,jj  
     335      REAL(wp) :: zcoef 
    319336 
    320337      !!--------------------------------------------------------------------- 
    321338 
    322       ! Initialization 
    323       ! -------------- 
    324  
    325       i15 = nday / 16 
    326       iman  = INT( raamo ) 
    327       imois = nmonth + i15 - 1 
    328       IF( imois == 0 ) imois = iman 
    329  
    330       ! Calendar computation 
    331       IF( kt == nit000 .OR. imois /= nflx1 ) THEN 
    332  
    333          IF( kt == nit000 )  nflx1  = 0 
    334  
    335          ! nflx1 number of the first file record used in the simulation 
    336          ! nflx2 number of the last  file record 
    337  
    338          nflx1 = imois 
    339          nflx2 = nflx1 + 1 
    340          nflx1 = MOD( nflx1, iman ) 
    341          nflx2 = MOD( nflx2, iman ) 
    342          IF( nflx1 == 0 )   nflx1 = iman 
    343          IF( nflx2 == 0 )   nflx2 = iman 
    344          IF(lwp) WRITE(numout,*)  
    345          IF(lwp) WRITE(numout,*) ' p4z_sbc : first record file used nflx1 ',nflx1 
    346          IF(lwp) WRITE(numout,*) ' p4z_sbc : last  record file used nflx2 ',nflx2 
    347  
    348       ENDIF 
    349  
    350       ! 3. at every time step interpolation of fluxes 
    351       ! --------------------------------------------- 
    352  
    353       zxy = FLOAT( nday + 15 - 30 * i15 ) / 30 
    354       dust(:,:) = ( (1.-zxy) * dustmo(:,:,nflx1) + zxy * dustmo(:,:,nflx2) ) 
    355  
     339      ! Compute dust at nit000 or only if there is more than 1 time record in dust file 
     340      IF( ln_dust ) THEN 
     341         IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_dust > 1 ) ) THEN 
     342            CALL fld_read( kt, 1, sf_dust ) 
     343            dust(:,:) = sf_dust(1)%fnow(:,:,1) 
     344         ENDIF 
     345      ENDIF 
     346 
     347      ! N/P and Si releases due to coastal rivers 
     348      ! Compute river at nit000 or only if there is more than 1 time record in river file 
     349      ! ----------------------------------------- 
     350      IF( ln_river ) THEN 
     351         IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_riv > 1 ) ) THEN 
     352            CALL fld_read( kt, 1, sf_riverdic ) 
     353            CALL fld_read( kt, 1, sf_riverdoc ) 
     354            DO jj = 1, jpj 
     355               DO ji = 1, jpi 
     356                  zcoef = ryyss * cvol(ji,jj,1)  
     357                  cotdep(ji,jj) =   sf_riverdic(1)%fnow(ji,jj,1)                                  * 1E9 / ( 12. * zcoef + rtrn ) 
     358                  rivinp(ji,jj) = ( sf_riverdic(1)%fnow(ji,jj,1) + sf_riverdoc(1)%fnow(ji,jj,1) ) * 1E9 / ( 31.6* zcoef + rtrn ) 
     359               END DO 
     360            END DO 
     361         ENDIF 
     362      ENDIF 
     363 
     364      ! Compute N deposition at nit000 or only if there is more than 1 time record in N deposition file 
     365      IF( ln_ndepo ) THEN 
     366         IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_ndep > 1 ) ) THEN 
     367            CALL fld_read( kt, 1, sf_ndepo ) 
     368            DO jj = 1, jpj 
     369               DO ji = 1, jpi 
     370                  nitdep(ji,jj) = 7.6 * sf_ndepo(1)%fnow(ji,jj,1) / ( 14E6 * ryyss * fse3t(ji,jj,1) + rtrn ) 
     371               END DO 
     372            END DO 
     373         ENDIF 
     374      ENDIF 
     375      ! 
    356376   END SUBROUTINE p4z_sbc 
    357377 
    358  
    359378   SUBROUTINE p4z_sed_init 
    360379 
    361380      !!---------------------------------------------------------------------- 
    362       !!                  ***  ROUTINE p4z_sed_init  *** 
    363       !! 
    364       !! ** Purpose :   Initialization of the external sources of nutrients 
    365       !! 
    366       !! ** Method  :   Read the files and compute the budget 
    367       !!      called at the first timestep (nit000) 
     381      !!                  ***  routine p4z_sed_init  *** 
     382      !! 
     383      !! ** purpose :   initialization of the external sources of nutrients 
     384      !! 
     385      !! ** method  :   read the files and compute the budget 
     386      !!                called at the first timestep (nit000) 
    368387      !! 
    369388      !! ** input   :   external netcdf files 
    370389      !! 
    371390      !!---------------------------------------------------------------------- 
    372       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    373       USE wrk_nemo, ONLY: zriverdoc => wrk_2d_1, zriver => wrk_2d_2, zndepo => wrk_2d_3 
    374       USE wrk_nemo, ONLY: zcmask => wrk_3d_2 
    375391      ! 
    376       INTEGER :: ji, jj, jk, jm 
    377       INTEGER :: numriv, numbath, numdep 
    378       REAL(wp) ::   zcoef 
    379       REAL(wp) ::   expide, denitide,zmaskt 
     392      INTEGER  :: ji, jj, jk, jm 
     393      INTEGER  :: numdust, numriv, numiron, numdepo 
     394      INTEGER  :: ierr, ierr1, ierr2, ierr3 
     395      REAL(wp) :: zexpide, zdenitide, zmaskt 
     396      REAL(wp), DIMENSION(nbtimes) :: zsteps                 ! times records 
     397      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zdust, zndepo, zriverdic, zriverdoc, zcmask 
    380398      ! 
    381       NAMELIST/nampissed/ ln_dustfer, ln_river, ln_ndepo, ln_sedinput, sedfeinput, dustsolub 
     399      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files 
     400      TYPE(FLD_N) ::   sn_dust, sn_riverdoc, sn_riverdic, sn_ndepo, sn_ironsed        ! informations about the fields to be read 
     401      NAMELIST/nampissed/cn_dir, sn_dust, sn_riverdic, sn_riverdoc, sn_ndepo, sn_ironsed, & 
     402        &                ln_dust, ln_river, ln_ndepo, ln_ironsed,         & 
     403        &                sedfeinput, dustsolub, wdust, nitrfix, diazolight, concfediaz  
    382404      !!---------------------------------------------------------------------- 
    383  
    384       IF( ( wrk_in_use(2, 1,2,3) ) .OR. ( wrk_in_use(3, 2) ) ) THEN 
    385          CALL ctl_stop('p4z_sed_init: requested workspace arrays unavailable')  ;  RETURN 
    386       END IF 
    387       ! 
    388       REWIND( numnat )                     ! read numnat 
    389       READ  ( numnat, nampissed ) 
     405      !                                    ! number of seconds per year and per month 
     406      ryyss    = nyear_len(1) * rday 
     407      rmtss    = ryyss / raamo 
     408      r1_rday  = 1. / rday 
     409      r1_ryyss = 1. / ryyss 
     410      !                            !* set file information 
     411      cn_dir  = './'            ! directory in which the model is executed 
     412      ! ... default values (NB: frequency positive => hours, negative => months) 
     413      !                  !   file       ! frequency !  variable   ! time intep !  clim   ! 'yearly' or ! weights  ! rotation   ! 
     414      !                  !   name       !  (hours)  !   name      !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      ! 
     415      sn_dust     = FLD_N( 'dust'       ,    -1     ,  'dust'     ,  .true.    , .true.  ,   'yearly'  , ''       , ''         ) 
     416      sn_riverdic = FLD_N( 'river'      ,   -12     ,  'riverdic' ,  .false.   , .true.  ,   'yearly'  , ''       , ''         ) 
     417      sn_riverdoc = FLD_N( 'river'      ,   -12     ,  'riverdoc' ,  .false.   , .true.  ,   'yearly'  , ''       , ''         ) 
     418      sn_ndepo    = FLD_N( 'ndeposition',   -12     ,  'ndep'     ,  .false.   , .true.  ,   'yearly'  , ''       , ''         ) 
     419      sn_ironsed  = FLD_N( 'ironsed'    ,   -12     ,  'bathy'    ,  .false.   , .true.  ,   'yearly'  , ''       , ''         ) 
     420 
     421      REWIND( numnatp )                     ! read numnatp 
     422      READ  ( numnatp, nampissed ) 
    390423 
    391424      IF(lwp) THEN 
    392425         WRITE(numout,*) ' ' 
    393          WRITE(numout,*) ' Namelist : nampissed ' 
     426         WRITE(numout,*) ' namelist : nampissed ' 
    394427         WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~ ' 
    395          WRITE(numout,*) '    Dust input from the atmosphere           ln_dustfer  = ', ln_dustfer 
    396          WRITE(numout,*) '    River input of nutrients                 ln_river    = ', ln_river 
    397          WRITE(numout,*) '    Atmospheric deposition of N              ln_ndepo    = ', ln_ndepo 
    398          WRITE(numout,*) '    Fe input from sediments                  ln_sedinput = ', ln_sedinput 
    399          WRITE(numout,*) '    Coastal release of Iron                  sedfeinput  =', sedfeinput 
    400          WRITE(numout,*) '    Solubility of the dust                   dustsolub   =', dustsolub 
    401       ENDIF 
    402  
    403       ! Dust input from the atmosphere 
     428         WRITE(numout,*) '    dust input from the atmosphere           ln_dust     = ', ln_dust 
     429         WRITE(numout,*) '    river input of nutrients                 ln_river    = ', ln_river 
     430         WRITE(numout,*) '    atmospheric deposition of n              ln_ndepo    = ', ln_ndepo 
     431         WRITE(numout,*) '    fe input from sediments                  ln_sedinput = ', ln_ironsed 
     432         WRITE(numout,*) '    coastal release of iron                  sedfeinput  = ', sedfeinput 
     433         WRITE(numout,*) '    solubility of the dust                   dustsolub   = ', dustsolub 
     434         WRITE(numout,*) '    sinking speed of the dust                wdust       = ', wdust 
     435         WRITE(numout,*) '    nitrogen fixation rate                   nitrfix     = ', nitrfix 
     436         WRITE(numout,*) '    nitrogen fixation sensitivty to light    diazolight  = ', diazolight 
     437         WRITE(numout,*) '    fe half-saturation cste for diazotrophs  concfediaz  = ', concfediaz 
     438       END IF 
     439 
     440      IF( ln_dust .OR. ln_river .OR. ln_ndepo ) THEN 
     441          ll_sbc = .TRUE. 
     442      ELSE 
     443          ll_sbc = .FALSE. 
     444      ENDIF 
     445 
     446      ! dust input from the atmosphere 
    404447      ! ------------------------------ 
    405       IF( ln_dustfer ) THEN  
    406          IF(lwp) WRITE(numout,*) '    Initialize dust input from atmosphere ' 
     448      IF( ln_dust ) THEN  
     449         IF(lwp) WRITE(numout,*) '    initialize dust input from atmosphere ' 
    407450         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ' 
    408          CALL iom_open ( 'dust.orca.nc', numdust ) 
    409          DO jm = 1, jpmth 
    410             CALL iom_get( numdust, jpdom_data, 'dust', dustmo(:,:,jm), jm ) 
     451         ! 
     452         ALLOCATE( sf_dust(1), STAT=ierr )           !* allocate and fill sf_sst (forcing structure) with sn_sst 
     453         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_apr structure' ) 
     454         ! 
     455         CALL fld_fill( sf_dust, (/ sn_dust /), cn_dir, 'p4z_sed_init', 'Iron from sediment ', 'nampissed' ) 
     456                                   ALLOCATE( sf_dust(1)%fnow(jpi,jpj,1)   ) 
     457         IF( sn_dust%ln_tint )     ALLOCATE( sf_dust(1)%fdta(jpi,jpj,1,2) ) 
     458         ! 
     459         ! Get total input dust ; need to compute total atmospheric supply of Si in a year 
     460         CALL iom_open (  TRIM( sn_dust%clname ) , numdust ) 
     461         CALL iom_gettime( numdust, zsteps, kntime=ntimes_dust)  ! get number of record in file 
     462         ALLOCATE( zdust(jpi,jpj,ntimes_dust) ) 
     463         DO jm = 1, ntimes_dust 
     464            CALL iom_get( numdust, jpdom_data, TRIM( sn_dust%clvar ), zdust(:,:,jm), jm ) 
    411465         END DO 
    412466         CALL iom_close( numdust ) 
     467         sumdepsi = 0.e0 
     468         DO jm = 1, ntimes_dust 
     469            sumdepsi = sumdepsi + glob_sum( zdust(:,:,jm) * e1e2t(:,:) * tmask(:,:,1) )  
     470         ENDDO 
     471         sumdepsi = sumdepsi * r1_ryyss * 8.8 * 0.075 / 28.1  
     472         DEALLOCATE( zdust) 
    413473      ELSE 
    414          dustmo(:,:,:) = 0.e0 
    415          dust(:,:) = 0.0 
    416       ENDIF 
    417  
    418       ! Nutrient input from rivers 
     474         dust(:,:) = 0._wp 
     475         sumdepsi  = 0._wp 
     476      END IF 
     477 
     478      ! nutrient input from rivers 
    419479      ! -------------------------- 
    420480      IF( ln_river ) THEN 
    421          IF(lwp) WRITE(numout,*) '    Initialize the nutrient input by rivers from river.orca.nc file' 
    422          IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    423          CALL iom_open ( 'river.orca.nc', numriv ) 
    424          CALL iom_get  ( numriv, jpdom_data, 'riverdic', zriver   (:,:), jpyr ) 
    425          CALL iom_get  ( numriv, jpdom_data, 'riverdoc', zriverdoc(:,:), jpyr ) 
     481         ALLOCATE( sf_riverdic(1), STAT=ierr1 )           !* allocate and fill sf_sst (forcing structure) with sn_sst 
     482         ALLOCATE( sf_riverdoc(1), STAT=ierr2 )           !* allocate and fill sf_sst (forcing structure) with sn_sst 
     483         IF( ierr1 + ierr2 > 0 )   CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_apr structure' ) 
     484         ! 
     485         CALL fld_fill( sf_riverdic, (/ sn_riverdic /), cn_dir, 'p4z_sed_init', 'Input DOC from river ', 'nampissed' ) 
     486         CALL fld_fill( sf_riverdoc, (/ sn_riverdoc /), cn_dir, 'p4z_sed_init', 'Input DOC from river ', 'nampissed' ) 
     487                                   ALLOCATE( sf_riverdic(1)%fnow(jpi,jpj,1)   ) 
     488                                   ALLOCATE( sf_riverdoc(1)%fnow(jpi,jpj,1)   ) 
     489         IF( sn_riverdic%ln_tint ) ALLOCATE( sf_riverdic(1)%fdta(jpi,jpj,1,2) ) 
     490         IF( sn_riverdoc%ln_tint ) ALLOCATE( sf_riverdoc(1)%fdta(jpi,jpj,1,2) ) 
     491         ! Get total input rivers ; need to compute total river supply in a year 
     492         CALL iom_open ( TRIM( sn_riverdic%clname ), numriv ) 
     493         CALL iom_gettime( numriv, zsteps, kntime=ntimes_riv) 
     494         ALLOCATE( zriverdic(jpi,jpj,ntimes_riv) )   ;     ALLOCATE( zriverdoc(jpi,jpj,ntimes_riv) ) 
     495         DO jm = 1, ntimes_riv 
     496            CALL iom_get( numriv, jpdom_data, TRIM( sn_riverdic%clvar ), zriverdic(:,:,jm), jm ) 
     497            CALL iom_get( numriv, jpdom_data, TRIM( sn_riverdoc%clvar ), zriverdoc(:,:,jm), jm ) 
     498         END DO 
    426499         CALL iom_close( numriv ) 
     500         ! N/P and Si releases due to coastal rivers 
     501         ! ----------------------------------------- 
     502         rivpo4input = 0._wp  
     503         rivalkinput = 0._wp  
     504         DO jm = 1, ntimes_riv 
     505            rivpo4input = rivpo4input + glob_sum( ( zriverdic(:,:,jm) + zriverdoc(:,:,jm) ) * tmask(:,:,1) )  
     506            rivalkinput = rivalkinput + glob_sum(   zriverdic(:,:,jm)                       * tmask(:,:,1) )  
     507         END DO 
     508         rivpo4input = rivpo4input * 1E9 / 31.6_wp 
     509         rivalkinput = rivalkinput * 1E9 / 12._wp  
     510         DEALLOCATE( zriverdic)   ;    DEALLOCATE( zriverdoc)  
    427511      ELSE 
    428          zriver   (:,:) = 0.e0 
    429          zriverdoc(:,:) = 0.e0 
    430       endif 
    431  
    432       ! Nutrient input from dust 
     512         rivinp(:,:) = 0._wp 
     513         cotdep(:,:) = 0._wp 
     514         rivpo4input = 0._wp 
     515         rivalkinput = 0._wp 
     516      END IF  
     517 
     518      ! nutrient input from dust 
    433519      ! ------------------------ 
    434520      IF( ln_ndepo ) THEN 
    435          IF(lwp) WRITE(numout,*) '    Initialize the nutrient input by dust from ndeposition.orca.nc' 
     521         IF(lwp) WRITE(numout,*) '    initialize the nutrient input by dust from ndeposition.orca.nc' 
    436522         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    437          CALL iom_open ( 'ndeposition.orca.nc', numdep ) 
    438          CALL iom_get  ( numdep, jpdom_data, 'ndep', zndepo(:,:), jpyr ) 
    439          CALL iom_close( numdep ) 
     523         ALLOCATE( sf_ndepo(1), STAT=ierr3 )           !* allocate and fill sf_sst (forcing structure) with sn_sst 
     524         IF( ierr3 > 0 )   CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_apr structure' ) 
     525         ! 
     526         CALL fld_fill( sf_ndepo, (/ sn_ndepo /), cn_dir, 'p4z_sed_init', 'Iron from sediment ', 'nampissed' ) 
     527                                   ALLOCATE( sf_ndepo(1)%fnow(jpi,jpj,1)   ) 
     528         IF( sn_ndepo%ln_tint )    ALLOCATE( sf_ndepo(1)%fdta(jpi,jpj,1,2) ) 
     529         ! 
     530         ! Get total input dust ; need to compute total atmospheric supply of N in a year 
     531         CALL iom_open ( TRIM( sn_ndepo%clname ), numdepo ) 
     532         CALL iom_gettime( numdepo, zsteps, kntime=ntimes_ndep) 
     533         ALLOCATE( zndepo(jpi,jpj,ntimes_ndep) ) 
     534         DO jm = 1, ntimes_ndep 
     535            CALL iom_get( numdepo, jpdom_data, TRIM( sn_ndepo%clvar ), zndepo(:,:,jm), jm ) 
     536         END DO 
     537         CALL iom_close( numdepo ) 
     538         nitdepinput = 0._wp 
     539         DO jm = 1, ntimes_ndep 
     540           nitdepinput = nitdepinput + glob_sum( zndepo(:,:,jm) * e1e2t(:,:) * tmask(:,:,1) )  
     541         ENDDO 
     542         nitdepinput = nitdepinput * 7.6 / 14E6  
     543         DEALLOCATE( zndepo) 
    440544      ELSE 
    441          zndepo(:,:) = 0.e0 
    442       ENDIF 
    443  
    444       ! Coastal and island masks 
     545         nitdep(:,:) = 0._wp 
     546         nitdepinput = 0._wp 
     547      ENDIF 
     548 
     549      ! coastal and island masks 
    445550      ! ------------------------ 
    446       IF( ln_sedinput ) THEN      
    447          IF(lwp) WRITE(numout,*) '    Computation of an island mask to enhance coastal supply of iron' 
     551      IF( ln_ironsed ) THEN      
     552         IF(lwp) WRITE(numout,*) '    computation of an island mask to enhance coastal supply of iron' 
    448553         IF(lwp) WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
    449          IF(lwp) WRITE(numout,*) '       from bathy.orca.nc file ' 
    450          CALL iom_open ( 'bathy.orca.nc', numbath ) 
    451          CALL iom_get  ( numbath, jpdom_data, 'bathy', zcmask(:,:,:), jpyr ) 
    452          CALL iom_close( numbath ) 
     554         CALL iom_open ( TRIM( sn_ironsed%clname ), numiron ) 
     555         ALLOCATE( zcmask(jpi,jpj,jpk) ) 
     556         CALL iom_get  ( numiron, jpdom_data, TRIM( sn_ironsed%clvar ), zcmask(:,:,:), 1 ) 
     557         CALL iom_close( numiron ) 
    453558         ! 
    454559         DO jk = 1, 5 
    … …  
    459564                        &                       * tmask(ji,jj-1,jk) * tmask(ji,jj,jk+1) 
    460565                     IF( zmaskt == 0. )   zcmask(ji,jj,jk ) = MAX( 0.1, zcmask(ji,jj,jk) )  
    461                   ENDIF 
     566                  END IF 
    462567               END DO 
    463568            END DO 
    464569         END DO 
     570         CALL lbc_lnk( zcmask , 'T', 1. )      ! lateral boundary conditions on cmask   (sign unchanged) 
    465571         DO jk = 1, jpk 
    466572            DO jj = 1, jpj 
    467573               DO ji = 1, jpi 
    468                   expide   = MIN( 8.,( fsdept(ji,jj,jk) / 500. )**(-1.5) ) 
    469                   denitide = -0.9543 + 0.7662 * LOG( expide ) - 0.235 * LOG( expide )**2 
    470                   zcmask(ji,jj,jk) = zcmask(ji,jj,jk) * MIN( 1., EXP( denitide ) / 0.5 ) 
     574                  zexpide   = MIN( 8.,( fsdept(ji,jj,jk) / 500. )**(-1.5) ) 
     575                  zdenitide = -0.9543 + 0.7662 * LOG( zexpide ) - 0.235 * LOG( zexpide )**2 
     576                  zcmask(ji,jj,jk) = zcmask(ji,jj,jk) * MIN( 1., EXP( zdenitide ) / 0.5 ) 
    471577               END DO 
    472578            END DO 
    473579         END DO 
     580         ! Coastal supply of iron 
     581         ! ------------------------- 
     582         ironsed(:,:,jpk) = 0._wp 
     583         DO jk = 1, jpkm1 
     584            ironsed(:,:,jk) = sedfeinput * zcmask(:,:,jk) / ( fse3t(:,:,jk) * rday ) 
     585         END DO 
     586         DEALLOCATE( zcmask) 
    474587      ELSE 
    475          zcmask(:,:,:) = 0.e0 
    476       ENDIF 
    477  
    478       CALL lbc_lnk( zcmask , 'T', 1. )      ! Lateral boundary conditions on zcmask   (sign unchanged) 
    479  
    480  
    481       !                                    ! Number of seconds per year and per month 
    482       ryyss  = nyear_len(1) * rday 
    483       rmtss  = ryyss / raamo 
    484       rday1  = 1. / rday 
    485       ryyss1 = 1. / ryyss 
    486       !                                    ! ocean surface cell 
    487  
    488       ! total atmospheric supply of Si 
    489       ! ------------------------------ 
    490       sumdepsi = 0.e0 
    491       DO jm = 1, jpmth 
    492          zcoef = 1. / ( 12. * rmtss ) * 8.8 * 0.075 / 28.1         
    493          sumdepsi = sumdepsi + glob_sum( dustmo(:,:,jm) * e1e2t(:,:) ) * zcoef 
    494       ENDDO 
    495  
    496       ! N/P and Si releases due to coastal rivers 
    497       ! ----------------------------------------- 
    498       DO jj = 1, jpj 
    499          DO ji = 1, jpi 
    500             zcoef = ryyss * e1e2t(ji,jj)  * fse3t(ji,jj,1) * tmask(ji,jj,1)  
    501             cotdep(ji,jj) =  zriver(ji,jj)                  *1E9 / ( 12. * zcoef + rtrn ) 
    502             rivinp(ji,jj) = (zriver(ji,jj)+zriverdoc(ji,jj)) *1E9 / ( 31.6* zcoef + rtrn ) 
    503             nitdep(ji,jj) = 7.6 * zndepo(ji,jj)                  / ( 14E6*ryyss*fse3t(ji,jj,1) + rtrn ) 
    504          END DO 
    505       END DO 
    506       ! Lateral boundary conditions on ( cotdep, rivinp, nitdep )   (sign unchanged) 
    507       CALL lbc_lnk( cotdep , 'T', 1. )  ;  CALL lbc_lnk( rivinp , 'T', 1. )  ;  CALL lbc_lnk( nitdep , 'T', 1. ) 
    508  
    509       rivpo4input = glob_sum( rivinp(:,:) * cvol(:,:,1) ) * ryyss 
    510       rivalkinput = glob_sum( cotdep(:,:) * cvol(:,:,1) ) * ryyss 
    511       nitdepinput = glob_sum( nitdep(:,:) * cvol(:,:,1) ) * ryyss 
    512  
    513  
    514       ! Coastal supply of iron 
    515       ! ------------------------- 
    516       DO jk = 1, jpkm1 
    517          ironsed(:,:,jk) = sedfeinput * zcmask(:,:,jk) / ( fse3t(:,:,jk) * rday ) 
    518       END DO 
    519       CALL lbc_lnk( ironsed , 'T', 1. )      ! Lateral boundary conditions on ( ironsed )   (sign unchanged) 
    520  
    521       IF( ( wrk_not_released(2, 1,2,3) ) .OR. ( wrk_not_released(3, 2) ) )   & 
    522         &         CALL ctl_stop('p4z_sed_init: failed to release workspace arrays') 
    523  
     588         ironsed(:,:,:) = 0._wp 
     589      ENDIF 
     590      ! 
     591      IF(lwp) THEN  
     592         WRITE(numout,*) 
     593         WRITE(numout,*) '    Total input of elements from river supply' 
     594         WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
     595         WRITE(numout,*) '    N Supply   : ', rivpo4input/7.6*1E3/1E12*14.,' TgN/yr' 
     596         WRITE(numout,*) '    Si Supply  : ', rivalkinput/6.*1E3/1E12*32.,' TgSi/yr' 
     597         WRITE(numout,*) '    Alk Supply : ', rivalkinput*1E3/1E12,' Teq/yr' 
     598         WRITE(numout,*) '    DIC Supply : ', rivpo4input*2.631*1E3*12./1E12,'TgC/yr' 
     599         WRITE(numout,*)  
     600         WRITE(numout,*) '    Total input of elements from atmospheric supply' 
     601         WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
     602         WRITE(numout,*) '    N Supply   : ', nitdepinput/7.6*1E3/1E12*14.,' TgN/yr' 
     603         WRITE(numout,*)  
     604      ENDIF 
     605       ! 
    524606   END SUBROUTINE p4z_sed_init 
    525607 
    … …  
    529611      !!---------------------------------------------------------------------- 
    530612 
    531       ALLOCATE( dustmo(jpi,jpj,jpmth), dust(jpi,jpj)       ,     & 
    532         &       rivinp(jpi,jpj)      , cotdep(jpi,jpj)     ,     & 
    533         &       nitdep(jpi,jpj)      , ironsed(jpi,jpj,jpk), STAT=p4z_sed_alloc )   
     613      ALLOCATE( dust  (jpi,jpj), rivinp(jpi,jpj)     , cotdep(jpi,jpj),      & 
     614        &       nitdep(jpi,jpj), ironsed(jpi,jpj,jpk), STAT=p4z_sed_alloc )   
    534615 
    535616      IF( p4z_sed_alloc /= 0 ) CALL ctl_warn('p4z_sed_alloc : failed to allocate arrays.') 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/PISCES/p4zsink.F90

    r2715 r2977  
    22   !!====================================================================== 
    33   !!                         ***  MODULE p4zsink  *** 
    4    !! TOP :   PISCES Compute vertical flux of particulate matter due to gravitational sinking 
     4   !! TOP :  PISCES vertical flux of particulate matter due to gravitational sinking 
    55   !!====================================================================== 
    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) Change aggregation formula 
     9   !!---------------------------------------------------------------------- 
    810#if defined key_pisces 
    911   !!---------------------------------------------------------------------- 
    1012   !!   p4z_sink       :  Compute vertical flux of particulate matter due to gravitational sinking 
     13   !!   p4z_sink_init  :  Unitialisation of sinking speed parameters 
     14   !!   p4z_sink_alloc :  Allocate sinking speed variables 
    1115   !!---------------------------------------------------------------------- 
    12    USE trc 
    13    USE oce_trc         ! 
    14    USE sms_pisces 
    15    USE prtctl_trc 
    16    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 prtctl_trc      !  print control for debugging 
     20   USE iom             !  I/O manager 
    1721 
    1822   IMPLICIT NONE 
    … …  
    9195      REAL(wp) :: zdiv , zdiv1, zdiv2, zdiv3, zdiv4, zdiv5 
    9296      REAL(wp) :: zval1, zval2, zval3, zval4 
    93 #if defined key_diatrc 
    9497      REAL(wp) :: zrfact2 
    9598      INTEGER  :: ik1 
    96 #endif 
    9799      CHARACTER (len=25) :: charout 
    98100      !!--------------------------------------------------------------------- 
    … …  
    193195                     &            * (zeps-1)/zdiv1 + 3.*(zfm*xkr_mass_max-xkr_mass_min)    & 
    194196                     &            * (zfm*xkr_mass_max**2-xkr_mass_min**2)                  & 
    195                      &            * (zeps-1.)**2/(zdiv2*zdiv3))            & 
    196 # if defined key_degrad 
    197                      &                 *facvol(ji,jj,jk)       & 
    198 # endif 
    199                      &    ) 
    200  
    201                   zagg2 = (  2*0.163*trn(ji,jj,jk,jpnum)**2*zfm*                       & 
     197                     &            * (zeps-1.)**2/(zdiv2*zdiv3))  
     198                  zagg2 =  2*0.163*trn(ji,jj,jk,jpnum)**2*zfm*                       & 
    202199                     &                   ((xkr_mass_max**3+3.*(xkr_mass_max**2          & 
    203200                     &                    *xkr_mass_min*(zeps-1.)/zdiv2                 & 
    … …  
    205202                     &                    +xkr_mass_min**3*(zeps-1)/zdiv1)                  & 
    206203                     &                    -zfm*xkr_mass_max**3*(1.+3.*((zeps-1.)/           & 
    207                      &                    (zeps-2.)+(zeps-1.)/zdiv3)+(zeps-1.)/zdiv1))      & 
    208 #    if defined key_degrad 
    209                      &                 *facvol(ji,jj,jk)             & 
    210 #    endif 
    211                      &    ) 
    212  
    213                   zagg3 = (  0.163*trn(ji,jj,jk,jpnum)**2*zfm**2*8. * xkr_mass_max**3   & 
    214 #    if defined key_degrad 
    215                      &                 *facvol(ji,jj,jk)             & 
    216 #    endif 
    217                      &    ) 
    218  
    219                   zaggsh = ( zagg1 + zagg2 + zagg3 ) * rfact2 * xdiss(ji,jj,jk) / 1000. 
    220  
     204                     &                    (zeps-2.)+(zeps-1.)/zdiv3)+(zeps-1.)/zdiv1))     
     205 
     206                  zagg3 =  0.163*trn(ji,jj,jk,jpnum)**2*zfm**2*8. * xkr_mass_max**3   
     207                   
    221208                 !    Aggregation of small into large particles 
    222209                 !    Part II : Differential settling 
    223210                 !    ---------------------------------------------- 
    224211 
    225                   zagg4 = ( 2.*3.141*0.125*trn(ji,jj,jk,jpnum)**2*                       & 
     212                  zagg4 = 2.*3.141*0.125*trn(ji,jj,jk,jpnum)**2*                       & 
    226213                     &                 xkr_wsbio_min*(zeps-1.)**2                         & 
    227214                     &                 *(xkr_mass_min**2*((1.-zsm*zfm)/(zdiv3*zdiv4)      & 
    228215                     &                 -(1.-zfm)/(zdiv*(zeps-1.)))-                       & 
    229216                     &                 ((zfm*zfm*xkr_mass_max**2*zsm-xkr_mass_min**2)     & 
    230                      &                 *xkr_eta)/(zdiv*zdiv3*zdiv5) )                     & 
    231 # if defined key_degrad 
    232                      &                 *facvol(ji,jj,jk)        & 
    233 # endif 
    234                      &    ) 
    235  
    236                   zagg5 = (  2.*3.141*0.125*trn(ji,jj,jk,jpnum)**2                         & 
     217                     &                 *xkr_eta)/(zdiv*zdiv3*zdiv5) )    
     218 
     219                  zagg5 =   2.*3.141*0.125*trn(ji,jj,jk,jpnum)**2                         & 
    237220                     &                 *(zeps-1.)*zfm*xkr_wsbio_min                        & 
    238221                     &                 *(zsm*(xkr_mass_min**2-zfm*xkr_mass_max**2)         & 
    239222                     &                 /zdiv3-(xkr_mass_min**2-zfm*zsm*xkr_mass_max**2)    & 
    240                      &                 /zdiv)                   & 
    241 # if defined key_degrad 
    242                      &                 *facvol(ji,jj,jk)        & 
    243 # endif 
    244                      &    ) 
    245  
     223                     &                 /zdiv)   
    246224                  zaggsi = ( zagg4 + zagg5 ) * xstep / 10. 
    247225 
    … …  
    253231                  zaggdoc = ( 0.4 * trn(ji,jj,jk,jpdoc)               & 
    254232                     &        + 1018.  * trn(ji,jj,jk,jppoc)  ) * xstep    & 
     233                     &        * xdiss(ji,jj,jk) * trn(ji,jj,jk,jpdoc) 
     234 
    255235# if defined key_degrad 
    256                      &        * facvol(ji,jj,jk)                              & 
     236                   zagg1   = zagg1   * facvol(ji,jj,jk)                  
     237                   zagg2   = zagg2   * facvol(ji,jj,jk)                  
     238                   zagg3   = zagg3   * facvol(ji,jj,jk)                  
     239                   zagg4   = zagg4   * facvol(ji,jj,jk)                  
     240                   zagg5   = zagg5   * facvol(ji,jj,jk)                  
     241                   zaggdoc = zaggdoc * facvol(ji,jj,jk)                  
    257242# endif 
    258                      &        * xdiss(ji,jj,jk) * trn(ji,jj,jk,jpdoc) 
    259  
     243                  zaggsh = ( zagg1 + zagg2 + zagg3 ) * rfact2 * xdiss(ji,jj,jk) / 1000. 
     244                  zaggsi = ( zagg4 + zagg5 ) * xstep / 10. 
     245                  zagg = 0.5 * xkr_stick * ( zaggsh + zaggsi ) 
     246                  ! 
    260247                  znumdoc = trn(ji,jj,jk,jpnum) / ( trn(ji,jj,jk,jppoc) + rtrn ) 
    261248                  tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zaggdoc 
    … …  
    268255      END DO 
    269256 
    270 #if defined key_diatrc 
    271       zrfact2 = 1.e3 * rfact2r 
    272       ik1 = iksed + 1 
    273 #  if ! defined key_iomput 
    274       trc2d(:,:  ,jp_pcs0_2d + 4)  = sinking (:,:,ik1) * zrfact2 * tmask(:,:,1) 
    275       trc2d(:,:  ,jp_pcs0_2d + 5)  = sinking2(:,:,ik1) * zrfact2 * tmask(:,:,1) 
    276       trc2d(:,:  ,jp_pcs0_2d + 6)  = sinkfer (:,:,ik1) * zrfact2 * tmask(:,:,1) 
    277       trc2d(:,:  ,jp_pcs0_2d + 7)  = sinksil (:,:,ik1) * zrfact2 * tmask(:,:,1) 
    278       trc2d(:,:  ,jp_pcs0_2d + 8)  = sinkcal (:,:,ik1) * zrfact2 * tmask(:,:,1) 
    279       trc3d(:,:,:,jp_pcs0_3d + 11) = sinking (:,:,:)      * zrfact2 * tmask(:,:,:) 
    280       trc3d(:,:,:,jp_pcs0_3d + 12) = sinking2(:,:,:)      * zrfact2 * tmask(:,:,:) 
    281       trc3d(:,:,:,jp_pcs0_3d + 13) = sinksil (:,:,:)      * zrfact2 * tmask(:,:,:) 
    282       trc3d(:,:,:,jp_pcs0_3d + 14) = sinkcal (:,:,:)      * zrfact2 * tmask(:,:,:) 
    283       trc3d(:,:,:,jp_pcs0_3d + 15) = znum3d  (:,:,:)                * tmask(:,:,:) 
    284       trc3d(:,:,:,jp_pcs0_3d + 16) = wsbio3  (:,:,:)                * tmask(:,:,:) 
    285       trc3d(:,:,:,jp_pcs0_3d + 17) = wsbio4  (:,:,:)                * tmask(:,:,:) 
    286 #else 
    287       IF( jnt == nrdttrc ) then 
    288         CALL iom_put( "POCFlx"  , sinking (:,:,:)      * zrfact2 * tmask(:,:,:) )  ! POC export 
    289         CALL iom_put( "NumFlx"  , sinking2 (:,:,:)     * zrfact2 * tmask(:,:,:) )  ! Num export 
    290         CALL iom_put( "SiFlx"   , sinksil (:,:,:)      * zrfact2 * tmask(:,:,:) )  ! Silica export 
    291         CALL iom_put( "CaCO3Flx", sinkcal (:,:,:)      * zrfact2 * tmask(:,:,:) )  ! Calcite export 
    292         CALL iom_put( "xnum"    , znum3d  (:,:,:)                * tmask(:,:,:) )  ! Number of particles in aggregats 
    293         CALL iom_put( "W1"      , wsbio3  (:,:,:)                * tmask(:,:,:) )  ! sinking speed of POC 
    294         CALL iom_put( "W2"      , wsbio4  (:,:,:)                * tmask(:,:,:) )  ! sinking speed of aggregats 
    295         CALL iom_put( "PMO"     , sinking (:,:,ik1) * zrfact2 * tmask(:,:,1) )  ! POC export at 100m 
    296         CALL iom_put( "PMO2"    , sinking2(:,:,ik1) * zrfact2 * tmask(:,:,1) )  ! Num export at 100m 
    297         CALL iom_put( "ExpFe1"  , sinkfer (:,:,ik1) * zrfact2 * tmask(:,:,1) )  ! Export of iron at 100m 
    298         CALL iom_put( "ExpSi"   , sinksil (:,:,ik1) * zrfact2 * tmask(:,:,1) )  ! export of silica at 100m 
    299         CALL iom_put( "ExpCaCO3", sinkcal (:,:,ik1) * zrfact2 * tmask(:,:,1) )  ! export of calcite at 100m 
    300      ENDIF 
    301 #  endif 
    302  
    303 #endif 
     257      IF( ln_diatrc ) THEN 
     258         ! 
     259         ik1 = iksed + 1 
     260         zrfact2 = 1.e3 * rfact2r 
     261         IF( jnt == nrdttrc ) THEN 
     262           CALL iom_put( "POCFlx"  , sinking (:,:,:)      * zrfact2 * tmask(:,:,:) )  ! POC export 
     263           CALL iom_put( "NumFlx"  , sinking2 (:,:,:)     * zrfact2 * tmask(:,:,:) )  ! Num export 
     264           CALL iom_put( "SiFlx"   , sinksil (:,:,:)      * zrfact2 * tmask(:,:,:) )  ! Silica export 
     265           CALL iom_put( "CaCO3Flx", sinkcal (:,:,:)      * zrfact2 * tmask(:,:,:) )  ! Calcite export 
     266           CALL iom_put( "xnum"    , znum3d  (:,:,:)                * tmask(:,:,:) )  ! Number of particles in aggregats 
     267           CALL iom_put( "W1"      , wsbio3  (:,:,:)                * tmask(:,:,:) )  ! sinking speed of POC 
     268           CALL iom_put( "W2"      , wsbio4  (:,:,:)                * tmask(:,:,:) )  ! sinking speed of aggregats 
     269           CALL iom_put( "PMO"     , sinking (:,:,ik1)    * zrfact2 * tmask(:,:,1) )  ! POC export at 100m 
     270           CALL iom_put( "PMO2"    , sinking2(:,:,ik1)    * zrfact2 * tmask(:,:,1) )  ! Num export at 100m 
     271           CALL iom_put( "ExpFe1"  , sinkfer (:,:,ik1)    * zrfact2 * tmask(:,:,1) )  ! Export of iron at 100m 
     272           CALL iom_put( "ExpSi"   , sinksil (:,:,ik1)    * zrfact2 * tmask(:,:,1) )  ! export of silica at 100m 
     273           CALL iom_put( "ExpCaCO3", sinkcal (:,:,ik1)    * zrfact2 * tmask(:,:,1) )  ! export of calcite at 100m 
     274         ENDIF 
     275# if ! defined key_iomput 
     276         trc2d(:,:  ,jp_pcs0_2d + 4)  = sinking (:,:,ik1)    * zrfact2 * tmask(:,:,1) 
     277         trc2d(:,:  ,jp_pcs0_2d + 5)  = sinking2(:,:,ik1)    * zrfact2 * tmask(:,:,1) 
     278         trc2d(:,:  ,jp_pcs0_2d + 6)  = sinkfer (:,:,ik1)    * zrfact2 * tmask(:,:,1) 
     279         trc2d(:,:  ,jp_pcs0_2d + 7)  = sinksil (:,:,ik1)    * zrfact2 * tmask(:,:,1) 
     280         trc2d(:,:  ,jp_pcs0_2d + 8)  = sinkcal (:,:,ik1)    * zrfact2 * tmask(:,:,1) 
     281         trc3d(:,:,:,jp_pcs0_3d + 11) = sinking (:,:,:)      * zrfact2 * tmask(:,:,:) 
     282         trc3d(:,:,:,jp_pcs0_3d + 12) = sinking2(:,:,:)      * zrfact2 * tmask(:,:,:) 
     283         trc3d(:,:,:,jp_pcs0_3d + 13) = sinksil (:,:,:)      * zrfact2 * tmask(:,:,:) 
     284         trc3d(:,:,:,jp_pcs0_3d + 14) = sinkcal (:,:,:)      * zrfact2 * tmask(:,:,:) 
     285         trc3d(:,:,:,jp_pcs0_3d + 15) = znum3d  (:,:,:)                * tmask(:,:,:) 
     286         trc3d(:,:,:,jp_pcs0_3d + 16) = wsbio3  (:,:,:)                * tmask(:,:,:) 
     287         trc3d(:,:,:,jp_pcs0_3d + 17) = wsbio4  (:,:,:)                * tmask(:,:,:) 
     288# endif 
     289        ! 
     290      ENDIF 
    304291      ! 
    305292      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    … …  
    335322      !!---------------------------------------------------------------------- 
    336323      ! 
    337       REWIND( numnat )                     ! read nampiskrs 
    338       READ  ( numnat, nampiskrs ) 
     324      REWIND( numnatp )                     ! read nampiskrs 
     325      READ  ( numnatp, nampiskrs ) 
    339326 
    340327      IF(lwp) THEN 
    … …  
    457444      INTEGER  ::   ji, jj, jk 
    458445      REAL(wp) ::   zagg1, zagg2, zagg3, zagg4 
    459       REAL(wp) ::   zagg , zaggfe, zaggdoc, zaggdoc2 
    460       REAL(wp) ::   zfact, zwsmax, zstep 
    461 #if defined key_diatrc 
     446      REAL(wp) ::   zagg , zaggfe, zaggdoc, zaggdoc2, zaggdoc3 
     447      REAL(wp) ::   zfact, zwsmax, zmax, zstep 
    462448      REAL(wp) ::   zrfact2 
    463449      INTEGER  ::   ik1 
    464 #endif 
    465450      CHARACTER (len=25) :: charout 
    466451      !!--------------------------------------------------------------------- 
    … …  
    471456      DO jk = 1, jpkm1 
    472457         DO jj = 1, jpj 
    473             DO ji=1,jpi 
    474                zfact = MAX( 0., fsdepw(ji,jj,jk+1) - hmld(ji,jj) ) / 4000._wp 
     458            DO ji = 1,jpi 
     459               zmax  = MAX( heup(ji,jj), hmld(ji,jj) ) 
     460               zfact = MAX( 0., fsdepw(ji,jj,jk+1) - zmax ) / 5000._wp 
    475461               wsbio4(ji,jj,jk) = wsbio2 + ( 200.- wsbio2 ) * zfact 
    476462            END DO 
    … …  
    526512         DO jj = 1, jpj 
    527513            DO ji = 1, jpi 
     514               ! 
     515               zstep = xstep  
    528516# if defined key_degrad 
    529                zstep = xstep * facvol(ji,jj,jk) 
    530 # else 
    531                zstep = xstep  
     517               zstep = zstep * facvol(ji,jj,jk) 
    532518# endif 
    533519               zfact = zstep * xdiss(ji,jj,jk) 
    534520               !  Part I : Coagulation dependent on turbulence 
    535                zagg1 = 940.* zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) 
    536                zagg2 = 1.054e4 * zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) 
     521               zagg1 = 354.  * zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) 
     522               zagg2 = 4452. * zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) 
    537523 
    538524               ! Part II : Differential settling 
    539525 
    540526               !  Aggregation of small into large particles 
    541                zagg3 = 0.66 * zstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) 
    542                zagg4 = 0.e0 * zstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) 
     527               zagg3 =  4.7 * zstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) 
     528               zagg4 =  0.4 * zstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) 
    543529 
    544530               zagg   = zagg1 + zagg2 + zagg3 + zagg4 
    … …  
    546532 
    547533               ! Aggregation of DOC to small particles 
    548                zaggdoc = ( 80.* trn(ji,jj,jk,jpdoc) + 698. * trn(ji,jj,jk,jppoc) ) *  zfact * trn(ji,jj,jk,jpdoc)  
    549                zaggdoc2 = 1.05e4 * zfact * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpdoc) 
     534               zaggdoc  = ( 0.83 * trn(ji,jj,jk,jpdoc) + 271. * trn(ji,jj,jk,jppoc) ) * zfact * trn(ji,jj,jk,jpdoc) 
     535               zaggdoc2 = 1.07e4 * zfact * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpdoc) 
     536               zaggdoc3 =   0.02 * ( 16706. * trn(ji,jj,jk,jppoc) + 231. * trn(ji,jj,jk,jpdoc) ) * zstep * trn(ji,jj,jk,jpdoc) 
    550537 
    551538               !  Update the trends 
    552                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zagg + zaggdoc 
     539               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zagg + zaggdoc + zaggdoc3 
    553540               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zagg + zaggdoc2 
    554541               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zaggfe 
    555542               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zaggfe 
    556                tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zaggdoc - zaggdoc2 
     543               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zaggdoc - zaggdoc2 - zaggdoc3 
    557544               ! 
    558545            END DO 
    … …  
    560547      END DO 
    561548 
    562 #if defined key_diatrc 
    563       zrfact2 = 1.e3 * rfact2r 
    564       ik1  = iksed + 1 
    565 #  if ! defined key_iomput 
    566       trc2d(:,:,jp_pcs0_2d + 4) = sinking (:,:,ik1) * zrfact2 * tmask(:,:,1) 
    567       trc2d(:,:,jp_pcs0_2d + 5) = sinking2(:,:,ik1) * zrfact2 * tmask(:,:,1) 
    568       trc2d(:,:,jp_pcs0_2d + 6) = sinkfer (:,:,ik1) * zrfact2 * tmask(:,:,1) 
    569       trc2d(:,:,jp_pcs0_2d + 7) = sinkfer2(:,:,ik1) * zrfact2 * tmask(:,:,1) 
    570       trc2d(:,:,jp_pcs0_2d + 8) = sinksil (:,:,ik1) * zrfact2 * tmask(:,:,1) 
    571       trc2d(:,:,jp_pcs0_2d + 9) = sinkcal (:,:,ik1) * zrfact2 * tmask(:,:,1) 
    572 #  else 
    573       IF( jnt == nrdttrc )  then 
    574          CALL iom_put( "EPC100"  , ( sinking(:,:,ik1) + sinking2(:,:,ik1) ) * zrfact2 * tmask(:,:,1) ) ! Export of carbon at 100m 
    575          CALL iom_put( "EPFE100" , ( sinkfer(:,:,ik1) + sinkfer2(:,:,ik1) ) * zrfact2 * tmask(:,:,1) ) ! Export of iron at 100m 
    576          CALL iom_put( "EPCAL100",   sinkcal(:,:,ik1)                       * zrfact2 * tmask(:,:,1) ) ! Export of calcite  at 100m 
    577          CALL iom_put( "EPSI100" ,   sinksil(:,:,ik1)                       * zrfact2 * tmask(:,:,1) ) ! Export of biogenic silica at 100m 
     549      IF( ln_diatrc ) THEN 
     550         zrfact2 = 1.e3 * rfact2r 
     551         ik1  = iksed + 1 
     552         IF( lk_iomput ) THEN 
     553           IF( jnt == nrdttrc ) THEN 
     554              CALL iom_put( "EPC100"  , ( sinking(:,:,ik1) + sinking2(:,:,ik1) ) * zrfact2 * tmask(:,:,1) ) ! Export of carbon at 100m 
     555              CALL iom_put( "EPFE100" , ( sinkfer(:,:,ik1) + sinkfer2(:,:,ik1) ) * zrfact2 * tmask(:,:,1) ) ! Export of iron at 100m 
     556              CALL iom_put( "EPCAL100",   sinkcal(:,:,ik1)                       * zrfact2 * tmask(:,:,1) ) ! Export of calcite  at 100m 
     557              CALL iom_put( "EPSI100" ,   sinksil(:,:,ik1)                       * zrfact2 * tmask(:,:,1) ) ! Export of biogenic silica at 100m 
     558           ENDIF 
     559         ELSE 
     560           trc2d(:,:,jp_pcs0_2d + 4) = sinking (:,:,ik1) * zrfact2 * tmask(:,:,1) 
     561           trc2d(:,:,jp_pcs0_2d + 5) = sinking2(:,:,ik1) * zrfact2 * tmask(:,:,1) 
     562           trc2d(:,:,jp_pcs0_2d + 6) = sinkfer (:,:,ik1) * zrfact2 * tmask(:,:,1) 
     563           trc2d(:,:,jp_pcs0_2d + 7) = sinkfer2(:,:,ik1) * zrfact2 * tmask(:,:,1) 
     564           trc2d(:,:,jp_pcs0_2d + 8) = sinksil (:,:,ik1) * zrfact2 * tmask(:,:,1) 
     565           trc2d(:,:,jp_pcs0_2d + 9) = sinkcal (:,:,ik1) * zrfact2 * tmask(:,:,1) 
     566         ENDIF 
    578567      ENDIF 
    579 #endif 
    580 #endif 
    581568      ! 
    582569      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    … …  
    588575   END SUBROUTINE p4z_sink 
    589576 
    590  
    591577   SUBROUTINE p4z_sink_init 
    592578      !!---------------------------------------------------------------------- 
    … …  
    597583#endif 
    598584 
     585 
     586 
    599587   SUBROUTINE p4z_sink2( pwsink, psinkflx, jp_tra ) 
    600588      !!--------------------------------------------------------------------- 
    … …  
    630618 
    631619      DO jk = 1, jpkm1 
    632 # if defined key_degrad 
    633          zwsink2(:,:,jk+1) = -pwsink(:,:,jk) / rday * tmask(:,:,jk+1) * facvol(:,:,jk) 
    634 # else 
    635          zwsink2(:,:,jk+1) = -pwsink(:,:,jk) / rday * tmask(:,:,jk+1) 
    636 # endif 
     620         zwsink2(:,:,jk+1) = -pwsink(:,:,jk) / rday * tmask(:,:,jk+1)  
    637621      END DO 
    638622      zwsink2(:,:,1) = 0.e0 
     623      IF( lk_degrad ) THEN 
     624         zwsink2(:,:,:) = zwsink2(:,:,:) * facvol(:,:,:) 
     625      ENDIF 
    639626 
    640627 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/PISCES/par_pisces.F90

    r2528 r2977  
    2929   LOGICAL, PUBLIC, PARAMETER ::   lk_kriest     = .TRUE.  !: Kriest flag  
    3030   INTEGER, PUBLIC, PARAMETER ::   jp_pisces     =  23     !: number of passive tracers 
    31    INTEGER, PUBLIC, PARAMETER ::   jp_pisces_2d  =  13     !: additional 2d output ('key_diatrc') 
    32    INTEGER, PUBLIC, PARAMETER ::   jp_pisces_3d  =  18     !: additional 3d output ('key_diatrc') 
     31   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_2d  =  13     !: additional 2d output  
     32   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_3d  =  18     !: additional 3d output  
    3333   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_trd =   1     !: number of sms trends for PISCES 
    3434 
    … …  
    6767   LOGICAL, PUBLIC, PARAMETER ::   lk_kriest     = .FALSE. !: Kriest flag  
    6868   INTEGER, PUBLIC, PARAMETER ::   jp_pisces     = 24      !: number of PISCES passive tracers 
    69    INTEGER, PUBLIC, PARAMETER ::   jp_pisces_2d  = 13      !: additional 2d output ('key_diatrc') 
    70    INTEGER, PUBLIC, PARAMETER ::   jp_pisces_3d  = 11      !: additional 3d output ('key_diatrc') 
     69   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_2d  = 13      !: additional 2d output  
     70   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_3d  = 11      !: additional 3d output  
    7171   INTEGER, PUBLIC, PARAMETER ::   jp_pisces_trd =  1      !: number of sms trends for PISCES 
    7272 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/PISCES/sms_pisces.F90

    r2715 r2977  
    1717   PUBLIC 
    1818 
     19   INTEGER ::   numnatp 
     20 
    1921   !!*  Time variables 
    2022   INTEGER  ::   nrdttrc           !: ??? 
    … …  
    2527 
    2628   !!*  Biological parameters  
    27    REAL(wp) ::   part              !: ??? 
    2829   REAL(wp) ::   rno3              !: ??? 
    2930   REAL(wp) ::   o2ut              !: ??? 
    3031   REAL(wp) ::   po4r              !: ??? 
    3132   REAL(wp) ::   rdenit            !: ??? 
     33   REAL(wp) ::   rdenita           !: ??? 
    3234   REAL(wp) ::   o2nit             !: ??? 
    3335   REAL(wp) ::   wsbio, wsbio2     !: ??? 
    … …  
    3739   !!* Damping  
    3840   LOGICAL  ::   ln_pisdmp         !: relaxation or not of nutrients to a mean value 
     41   INTEGER  ::   nn_pisdmp         !: frequency of relaxation or not of nutrients to a mean value 
    3942   LOGICAL  ::   ln_pisclo         !: Restoring or not of nutrients to initial value 
    4043                                   !: on close seas 
    … …  
    5558   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   concdfe    !: ??? 
    5659   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   concnfe    !: ??? 
     60   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimnfe    !: ??? 
     61   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimdfe    !: ??? 
     62   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:)  ::   xlimsi     !: ??? 
     63 
    5764 
    5865   !!*  SMS for the organic matter 
    … …  
    6168   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xlimbac    !: ?? 
    6269   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xdiss      !: ?? 
    63 #if defined key_diatrc 
    64    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   prodcal    !: Calcite production 
    65    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   grazing    !: Total zooplankton grazing 
    66 #endif 
     70    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   prodcal    !: Calcite production 
     71    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   grazing    !: Total zooplankton grazing 
    6772 
    6873   !!* Variable for chemistry of the CO2 cycle 
    … …  
    7479   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   borat      !: ??? 
    7580   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hi         !: ??? 
     81   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   excess     !: ??? 
     82 
     83   !!* Temperature dependancy of SMS terms 
     84   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tgfunc    !: Temp. dependancy of various biological rates 
     85   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   tgfunc2   !: Temp. dependancy of mesozooplankton rates 
    7686 
    7787   !!* Array used to indicate negative tracer values 
    … …  
    98108      !!---------------------------------------------------------------------- 
    99109      USE lib_mpp , ONLY: ctl_warn 
    100       INTEGER ::   ierr(5)        ! Local variables 
     110      INTEGER ::   ierr(6)        ! Local variables 
    101111      !!---------------------------------------------------------------------- 
    102112      ierr(:) = 0 
    103       ! 
    104113      !*  Biological fluxes for light 
    105       ALLOCATE( neln(jpi,jpj), heup(jpi,jpj),                           STAT=ierr(1) ) 
     114      ALLOCATE( neln(jpi,jpj), heup(jpi,jpj),                   STAT=ierr(1) ) 
    106115      ! 
    107116      !*  Biological fluxes for primary production 
    108       ALLOCATE( xksimax(jpi,jpj)     , xksi(jpi,jpj)        ,               & 
    109          &      xnanono3(jpi,jpj,jpk), xdiatno3(jpi,jpj,jpk),               & 
    110          &      xnanonh4(jpi,jpj,jpk), xdiatnh4(jpi,jpj,jpk),               & 
    111          &      xlimphy (jpi,jpj,jpk), xlimdia (jpi,jpj,jpk),               & 
    112          &      concdfe (jpi,jpj,jpk), concnfe (jpi,jpj,jpk),           STAT=ierr(2) )  
     117      ALLOCATE( xksimax(jpi,jpj)     , xksi(jpi,jpj)        ,       & 
     118         &      xnanono3(jpi,jpj,jpk), xdiatno3(jpi,jpj,jpk),       & 
     119         &      xnanonh4(jpi,jpj,jpk), xdiatnh4(jpi,jpj,jpk),       & 
     120         &      xlimphy (jpi,jpj,jpk), xlimdia (jpi,jpj,jpk),       & 
     121         &      xlimnfe (jpi,jpj,jpk), xlimdfe (jpi,jpj,jpk),       & 
     122         &      xlimsi  (jpi,jpj,jpk), concdfe (jpi,jpj,jpk),       & 
     123         &      concnfe (jpi,jpj,jpk),                          STAT=ierr(2) )  
    113124         ! 
    114125      !*  SMS for the organic matter 
    115       ALLOCATE( xfracal (jpi,jpj,jpk), nitrfac (jpi,jpj,jpk),               & 
    116 #if defined key_diatrc 
    117          &      prodcal(jpi,jpj,jpk) , grazing(jpi,jpj,jpk) ,               & 
    118 #endif  
    119          &      xlimbac (jpi,jpj,jpk), xdiss(jpi,jpj,jpk)   ,           STAT=ierr(3) )   
     126      ALLOCATE( xfracal (jpi,jpj,jpk), nitrfac(jpi,jpj,jpk),       & 
     127         &      prodcal(jpi,jpj,jpk) , grazing(jpi,jpj,jpk),       & 
     128         &      xlimbac (jpi,jpj,jpk), xdiss  (jpi,jpj,jpk),   STAT=ierr(3) )   
    120129         ! 
    121130      !* Variable for chemistry of the CO2 cycle 
    122       ALLOCATE( akb3(jpi,jpj,jpk), ak13(jpi,jpj,jpk) ,                      & 
    123          &      ak23(jpi,jpj,jpk), aksp(jpi,jpj,jpk) ,                      & 
    124          &      akw3(jpi,jpj,jpk), borat(jpi,jpj,jpk), hi(jpi,jpj,jpk), STAT=ierr(4) ) 
     131      ALLOCATE( akb3(jpi,jpj,jpk)    , ak13  (jpi,jpj,jpk) ,       & 
     132         &      ak23(jpi,jpj,jpk)    , aksp  (jpi,jpj,jpk) ,       & 
     133         &      akw3(jpi,jpj,jpk)    , borat (jpi,jpj,jpk) ,       & 
     134         &      hi  (jpi,jpj,jpk)    , excess(jpi,jpj,jpk) ,   STAT=ierr(4) ) 
     135         ! 
     136      !* Temperature dependancy of SMS terms 
     137      ALLOCATE( tgfunc(jpi,jpj,jpk)  , tgfunc2(jpi,jpj,jpk) ,   STAT=ierr(5) ) 
    125138         ! 
    126139      !* Array used to indicate negative tracer values   
    127       ALLOCATE( xnegtr(jpi,jpj,jpk),                                    STAT=ierr(5) ) 
     140      ALLOCATE( xnegtr(jpi,jpj,jpk)  ,                          STAT=ierr(6) ) 
    128141      ! 
    129142      sms_pisces_alloc = MAXVAL( ierr ) 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/PISCES/trcini_pisces.F90

    r2715 r2977  
    1717   !!---------------------------------------------------------------------- 
    1818   USE par_trc         ! TOP parameters 
    19    USE sms_pisces      ! Source Minus Sink variables 
    20    USE trc 
    21    USE oce_trc         ! ocean variables 
    22    USE p4zche  
    23    USE p4zche          !  
    24    USE p4zsink         !  
    25    USE p4zopt          !  
    26    USE p4zprod         ! 
    27    USE p4zrem          !  
    28    USE p4zsed          !  
    29    USE p4zflx          !  
     19   USE oce_trc         !  shared variables between ocean and passive tracers 
     20   USE trc             !  passive tracers common variables  
     21   USE sms_pisces      !  PISCES Source Minus Sink variables 
     22   USE p4zche          !  Chemical model 
     23   USE p4zsink         !  vertical flux of particulate matter due to sinking 
     24   USE p4zopt          !  optical model 
     25   USE p4zrem          !  Remineralisation of organic matter 
     26   USE p4zflx          !  Gas exchange 
     27   USE p4zsed          !  Sedimentation 
    3028 
    3129   IMPLICIT NONE 
    … …  
    4038   REAL(wp) :: bioma0 =  1.000e-8_wp   
    4139   REAL(wp) :: silic1 =  91.65e-6_wp   
    42    REAL(wp) :: no3    =  31.04e-6_wp * 7.6_wp 
     40   REAL(wp) :: no3    =  31.04e-6_wp * 7.625_wp 
    4341 
    4442#  include "top_substitute.h90" 
    … …  
    7674      ! Set biological ratios 
    7775      ! --------------------- 
    78       rno3   = (16.+2.) / 122. 
    79       po4r   =   1.e0   / 122. 
    80       o2nit  =  32.     / 122. 
    81       rdenit =  97.6    /  16. 
    82       o2ut   = 140.     / 122. 
     76      rno3    =  16._wp / 122._wp 
     77      po4r    =   1._wp / 122._wp 
     78      o2nit   =  32._wp / 122._wp 
     79      rdenit  = 105._wp /  16._wp 
     80      rdenita =   3._wp /  5._wp 
     81      o2ut    = 131._wp / 122._wp 
    8382 
    8483      CALL p4z_che        ! initialize the chemical constants 
    … …  
    136135      !! ** Purpose :   Allocate all the dynamic arrays of PISCES  
    137136      !!---------------------------------------------------------------------- 
    138       USE p4zint , ONLY : p4z_int_alloc       
    139       USE p4zsink, ONLY : p4z_sink_alloc       
    140       USE p4zopt , ONLY : p4z_opt_alloc            
    141       USE p4zprod, ONLY : p4z_prod_alloc          
    142       USE p4zrem , ONLY : p4z_rem_alloc            
    143       USE p4zsed , ONLY : p4z_sed_alloc           
    144       USE p4zflx , ONLY : p4z_flx_alloc 
     137      USE p4zsink , ONLY : p4z_sink_alloc       
     138      USE p4zopt  , ONLY : p4z_opt_alloc            
     139      USE p4zprod , ONLY : p4z_prod_alloc          
     140      USE p4zrem  , ONLY : p4z_rem_alloc            
     141      USE p4zsed  , ONLY : p4z_sed_alloc           
     142      USE p4zflx  , ONLY : p4z_flx_alloc 
    145143      ! 
    146144      INTEGER :: ierr 
    … …  
    148146      ! 
    149147      ierr =         sms_pisces_alloc()          ! Start of PISCES-related alloc routines... 
    150       ierr = ierr +     p4z_che_alloc() 
    151       ierr = ierr +     p4z_int_alloc() 
    152       ierr = ierr +    p4z_sink_alloc() 
    153       ierr = ierr +     p4z_opt_alloc() 
    154       ierr = ierr +    p4z_prod_alloc() 
    155       ierr = ierr +     p4z_rem_alloc() 
    156       ierr = ierr +     p4z_sed_alloc() 
    157       ierr = ierr +     p4z_flx_alloc() 
     148      ierr = ierr +  p4z_che_alloc() 
     149      ierr = ierr +  p4z_sink_alloc() 
     150      ierr = ierr +  p4z_opt_alloc() 
     151      ierr = ierr +  p4z_prod_alloc() 
     152      ierr = ierr +  p4z_rem_alloc() 
     153      ierr = ierr +  p4z_sed_alloc() 
     154      ierr = ierr +  p4z_flx_alloc() 
    158155      ! 
    159156      IF( lk_mpp    )   CALL mpp_sum( ierr ) 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/PISCES/trcnam_pisces.F90

    r2715 r2977  
    1919   USE trc             ! TOP variables 
    2020   USE sms_pisces      ! sms trends 
     21   USE iom             ! I/O manager 
    2122 
    2223 
    … …  
    4647      !!---------------------------------------------------------------------- 
    4748      !! 
    48 #if defined key_diatrc && ! defined key_iomput 
    49       INTEGER ::  jl, jn 
    50       ! definition of additional diagnostic as a structure 
    51       TYPE DIAG 
    52          CHARACTER(len = 20)  :: snamedia   !: short name 
    53          CHARACTER(len = 80 ) :: lnamedia   !: long name 
    54          CHARACTER(len = 20 ) :: unitdia    !: unit 
    55       END TYPE DIAG 
    56  
    57       TYPE(DIAG) , DIMENSION(jp_pisces_2d) :: pisdia2d 
    58       TYPE(DIAG) , DIMENSION(jp_pisces_3d) :: pisdia3d 
    59 #endif 
    60  
     49      INTEGER :: jl, jn 
     50      TYPE(DIAG), DIMENSION(jp_pisces_2d) :: pisdia2d 
     51      TYPE(DIAG), DIMENSION(jp_pisces_3d) :: pisdia3d 
     52      !! 
    6153      NAMELIST/nampisbio/ part, nrdttrc, wsbio, xkmort, ferat3, wsbio2 
    6254#if defined key_kriest 
    6355      NAMELIST/nampiskrp/ xkr_eta, xkr_zeta, xkr_mass_min, xkr_mass_max 
    6456#endif 
    65 #if defined key_diatrc && ! defined key_iomput 
    66       NAMELIST/nampisdia/ nn_writedia, pisdia3d, pisdia2d     ! additional diagnostics 
    67 #endif 
    68       NAMELIST/nampisdmp/ ln_pisdmp, ln_pisclo 
     57      NAMELIST/nampisdia/ pisdia3d, pisdia2d     ! additional diagnostics 
     58      NAMELIST/nampisdmp/ ln_pisdmp, nn_pisdmp, ln_pisclo 
    6959 
    7060      !!---------------------------------------------------------------------- 
    … …  
    7767      !                               ! Open the namelist file 
    7868      !                               ! ---------------------- 
    79       CALL ctl_opn( numnat, 'namelist_pisces', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
     69      CALL ctl_opn( numnatp, 'namelist_pisces', 'OLD', 'FORMATTED', 'SEQUENTIAL', -1, numout, .FALSE. ) 
    8070 
    81       REWIND( numnat )                     
    82       READ  ( numnat, nampisbio ) 
     71      REWIND( numnatp )                     
     72      READ  ( numnatp, nampisbio ) 
    8373 
    8474      IF(lwp) THEN                         ! control print 
    … …  
    10191      xkr_mass_max = 1.       
    10292 
    103       REWIND( numnat )                     ! read natkriest 
    104       READ  ( numnat, nampiskrp ) 
     93      REWIND( numnatp )                     ! read natkriest 
     94      READ  ( numnatp, nampiskrp ) 
    10595 
    10696      IF(lwp) THEN 
    … …  
    120110#endif 
    121111      ! 
    122 #if defined key_diatrc && ! defined key_iomput 
     112      IF( .NOT.lk_iomput .AND. ln_diatrc ) THEN 
     113         ! 
     114         ! Namelist nampisdia 
     115         ! ------------------- 
     116         DO jl = 1, jp_pisces_2d 
     117            WRITE(pisdia2d(jl)%sname,'("2D_",I1)') jl                      ! short name 
     118            WRITE(pisdia2d(jl)%lname,'("2D DIAGNOSTIC NUMBER ",I2)') jl    ! long name 
     119            pisdia2d(jl)%units = ' '                                       ! units 
     120         END DO 
     121         !                                 ! 3D output arrays 
     122         DO jl = 1, jp_pisces_3d 
     123            WRITE(pisdia3d(jl)%sname,'("3D_",I1)') jl                      ! short name 
     124            WRITE(pisdia3d(jl)%lname,'("3D DIAGNOSTIC NUMBER ",I2)') jl    ! long name 
     125            pisdia3d(jl)%units = ' '                                       ! units 
     126         END DO 
    123127 
    124       ! Namelist namlobdia 
    125       ! ------------------- 
    126       nn_writedia = 10                   ! default values 
    127  
    128       DO jl = 1, jp_pisces_2d 
    129          jn = jp_pcs0_2d + jl - 1 
    130          WRITE(ctrc2d(jn),'("2D_",I1)') jn                      ! short name 
    131          WRITE(ctrc2l(jn),'("2D DIAGNOSTIC NUMBER ",I2)') jn    ! long name 
    132          ctrc2u(jn) = ' '                                       ! units 
    133       END DO 
    134       !                                 ! 3D output arrays 
    135       DO jl = 1, jp_pisces_3d 
    136          jn = jp_pcs0_3d + jl - 1 
    137          WRITE(ctrc3d(jn),'("3D_",I1)') jn                      ! short name 
    138          WRITE(ctrc3l(jn),'("3D DIAGNOSTIC NUMBER ",I2)') jn    ! long name 
    139          ctrc3u(jn) = ' '                                       ! units 
    140       END DO 
    141  
    142       REWIND( numnat )               ! read natrtd 
    143       READ  ( numnat, nampisdia ) 
    144  
    145       DO jl = 1, jp_pisces_2d 
    146          jn = jp_pcs0_2d + jl - 1 
    147          ctrc2d(jn) = pisdia2d(jl)%snamedia 
    148          ctrc2l(jn) = pisdia2d(jl)%lnamedia 
    149          ctrc2u(jn) = pisdia2d(jl)%unitdia 
    150       END DO 
    151  
    152       DO jl = 1, jp_pisces_3d 
    153          jn = jp_pcs0_3d + jl - 1 
    154          ctrc3d(jn) = pisdia3d(jl)%snamedia 
    155          ctrc3l(jn) = pisdia3d(jl)%lnamedia 
    156          ctrc3u(jn) = pisdia3d(jl)%unitdia 
    157       END DO 
    158  
    159       IF(lwp) THEN                   ! control print 
    160          WRITE(numout,*) 
    161          WRITE(numout,*) ' Namelist : natadd' 
    162          WRITE(numout,*) '    frequency of outputs for additional arrays nn_writedia = ', nn_writedia 
    163          DO jl = 1, jp_pisces_3d 
    164             jn = jp_pcs0_3d + jl - 1 
    165             WRITE(numout,*) '   3d output field No : ',jn 
    166             WRITE(numout,*) '   short name         : ', TRIM(ctrc3d(jn)) 
    167             WRITE(numout,*) '   long name          : ', TRIM(ctrc3l(jn)) 
    168             WRITE(numout,*) '   unit               : ', TRIM(ctrc3u(jn)) 
    169             WRITE(numout,*) ' ' 
    170          END DO 
     128         REWIND( numnatp )               !  
     129         READ  ( numnatp, nampisdia ) 
    171130 
    172131         DO jl = 1, jp_pisces_2d 
    173132            jn = jp_pcs0_2d + jl - 1 
    174             WRITE(numout,*) '   2d output field No : ',jn 
    175             WRITE(numout,*) '   short name         : ', TRIM(ctrc2d(jn)) 
    176             WRITE(numout,*) '   long name          : ', TRIM(ctrc2l(jn)) 
    177             WRITE(numout,*) '   unit               : ', TRIM(ctrc2u(jn)) 
     133            ctrc2d(jn) = pisdia2d(jl)%sname 
     134            ctrc2l(jn) = pisdia2d(jl)%lname 
     135            ctrc2u(jn) = pisdia2d(jl)%units 
     136         END DO 
     137 
     138         DO jl = 1, jp_pisces_3d 
     139            jn = jp_pcs0_3d + jl - 1 
     140            ctrc3d(jn) = pisdia3d(jl)%sname 
     141            ctrc3l(jn) = pisdia3d(jl)%lname 
     142            ctrc3u(jn) = pisdia3d(jl)%units 
     143         END DO 
     144 
     145         IF(lwp) THEN                   ! control print 
     146            WRITE(numout,*) 
     147            WRITE(numout,*) ' Namelist : natadd' 
     148            DO jl = 1, jp_pisces_3d 
     149               jn = jp_pcs0_3d + jl - 1 
     150               WRITE(numout,*) '  3d diag nb : ', jn, '    short name : ', ctrc3d(jn), & 
     151                 &             '  long name  : ', ctrc3l(jn), '   unit : ', ctrc3u(jn) 
     152            END DO 
    178153            WRITE(numout,*) ' ' 
    179          END DO 
     154 
     155            DO jl = 1, jp_pisces_2d 
     156               jn = jp_pcs0_2d + jl - 1 
     157               WRITE(numout,*) '  2d diag nb : ', jn, '    short name : ', ctrc2d(jn), & 
     158                 &             '  long name  : ', ctrc2l(jn), '   unit : ', ctrc2u(jn) 
     159            END DO 
     160            WRITE(numout,*) ' ' 
     161         ENDIF 
     162         ! 
    180163      ENDIF 
    181 #endif 
    182164 
    183       REWIND( numnat ) 
    184       READ  ( numnat, nampisdmp ) 
     165      REWIND( numnatp ) 
     166      READ  ( numnatp, nampisdmp ) 
    185167 
    186168      IF(lwp) THEN                         ! control print 
    187169         WRITE(numout,*) 
    188170         WRITE(numout,*) ' Namelist : nampisdmp' 
    189          WRITE(numout,*) '    Relaxation of tracer to glodap mean value            ln_pisdmp      =', ln_pisdmp 
     171         WRITE(numout,*) '    Relaxation of tracer to glodap mean value             ln_pisdmp      =', ln_pisdmp 
     172         WRITE(numout,*) '    Frequency of Relaxation                               nn_pisdmp      =', nn_pisdmp 
    190173         WRITE(numout,*) '    Restoring of tracer to initial value  on closed seas  ln_pisclo      =', ln_pisclo 
    191174         WRITE(numout,*) ' ' 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/PISCES/trcrst_pisces.F90

    r2715 r2977  
    4343 
    4444      ! 
    45       IF( lk_dtatrc .AND. ln_pisclo ) CALL pis_dmp_clo  ! restoring of nutrients on close seas 
    46       IF( ln_pisdmp )                 CALL pis_dmp_ini  ! relaxation of some tracers 
     45      IF( ln_trcdta .AND. ln_pisclo ) CALL pis_dmp_clo  ! restoring of nutrients on close seas 
    4746      ! 
    4847      IF(lwp) WRITE(numout,*) 
    … …  
    5352         CALL iom_get( knum, jpdom_autoglo, 'PH' , hi(:,:,:)  ) 
    5453      ELSE 
     54         hi(:,:,:) = 1.e-9  
    5555         ! Set PH from  total alkalinity, borat (???), akb3 (???) and ak23 (???) 
    5656         ! -------------------------------------------------------- 
    … …  
    6363                  zco3    = ( zcaralk - trn(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1 
    6464                  zbicarb = ( 2. * trn(ji,jj,jk,jpdic) - zcaralk ) 
    65                   hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1 
     65                 hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1 
    6666               END DO 
    6767            END DO 
    … …  
    9999   END SUBROUTINE trc_rst_wri_pisces 
    100100 
    101    SUBROUTINE pis_dmp_ini 
    102       !!---------------------------------------------------------------------- 
    103       !!                    ***  pis_dmp_ini  *** 
    104       !! 
    105       !! ** purpose  : Relaxation of some tracers 
    106       !!---------------------------------------------------------------------- 
    107       REAL(wp) ::  alkmean = 2426.     ! mean value of alkalinity ( Glodap ; for Goyet 2391. ) 
    108       REAL(wp) ::  po4mean = 2.165     ! mean value of phosphates 
    109       REAL(wp) ::  no3mean = 30.90     ! mean value of nitrate 
    110       REAL(wp) ::  silmean = 91.51     ! mean value of silicate 
    111  
    112       REAL(wp) :: zarea, zalksum, zpo4sum, zno3sum, zsilsum 
    113  
    114  
    115       IF(lwp)  WRITE(numout,*) 
    116  
    117       IF( cp_cfg == "orca" .AND. .NOT. lk_c1d ) THEN      ! ORCA condiguration (not 1D) ! 
    118          !                                                    ! --------------------------- ! 
    119          ! set total alkalinity, phosphate, nitrate & silicate 
    120  
    121          zarea   = 1. / areatot * 1.e6 
    122 # if defined key_degrad 
    123          zalksum = glob_sum( trn(:,:,:,jptal) * cvol(:,:,:) * facvol(:,:,:) ) * zarea 
    124          zpo4sum = glob_sum( trn(:,:,:,jppo4) * cvol(:,:,:) * facvol(:,:,:) ) * zarea / 122. 
    125          zno3sum = glob_sum( trn(:,:,:,jpno3) * cvol(:,:,:) * facvol(:,:,:) ) * zarea / 7.6 
    126          zsilsum = glob_sum( trn(:,:,:,jpsil) * cvol(:,:,:) * facvol(:,:,:) ) * zarea 
    127 # else 
    128          zalksum = glob_sum( trn(:,:,:,jptal) * cvol(:,:,:)  ) * zarea 
    129          zpo4sum = glob_sum( trn(:,:,:,jppo4) * cvol(:,:,:)  ) * zarea / 122. 
    130          zno3sum = glob_sum( trn(:,:,:,jpno3) * cvol(:,:,:)  ) * zarea / 7.6 
    131          zsilsum = glob_sum( trn(:,:,:,jpsil) * cvol(:,:,:)  ) * zarea 
    132 # endif 
    133  
    134          IF(lwp) WRITE(numout,*) '       TALK mean : ', zalksum 
    135          trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / zalksum 
    136              
    137          IF(lwp) WRITE(numout,*) '       PO4  mean : ', zpo4sum 
    138          trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / zpo4sum 
    139  
    140          IF(lwp) WRITE(numout,*) '       NO3  mean : ', zno3sum 
    141          trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / zno3sum 
    142  
    143          IF(lwp) WRITE(numout,*) '       SiO3 mean : ', zsilsum 
    144          trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * silmean / zsilsum ) 
    145          ! 
    146       ENDIF 
    147  
    148 !#if defined key_kriest 
    149 !     !! Initialize number of particles from a standart restart file 
    150 !     !! The name of big organic particles jpgoc has been only change 
    151 !     !! and replace by jpnum but the values here are concentration 
    152 !     trn(:,:,:,jppoc) = trn(:,:,:,jppoc) + trn(:,:,:,jpnum)  
    153 !     trn(:,:,:,jpnum) = trn(:,:,:,jppoc) / ( 6. * xkr_massp ) 
    154 !#endif 
    155  
    156    END SUBROUTINE pis_dmp_ini 
    157  
    158101   SUBROUTINE pis_dmp_clo    
    159102      !!--------------------------------------------------------------------- 
    … …  
    168111      !!                ictsi2(), ictsj2() : north-east Closed sea limits (i,j) 
    169112      !!---------------------------------------------------------------------- 
    170       INTEGER, PARAMETER           ::   npicts   = 4       !: number of closed sea 
    171       INTEGER, DIMENSION(npicts)   ::   ictsi1, ictsj1     !: south-west closed sea limits (i,j) 
    172       INTEGER, DIMENSION(npicts)   ::   ictsi2, ictsj2     !: north-east closed sea limits (i,j) 
    173       INTEGER :: ji, jj, jk, jn, jc            ! dummy loop indices 
     113      INTEGER, PARAMETER           ::   npicts   = 4        ! number of closed sea 
     114      INTEGER, DIMENSION(npicts)   ::   ictsi1, ictsj1      ! south-west closed sea limits (i,j) 
     115      INTEGER, DIMENSION(npicts)   ::   ictsi2, ictsj2      ! north-east closed sea limits (i,j) 
     116      INTEGER :: ji, jj, jk, jn, jl, jc                     ! dummy loop indices 
     117      INTEGER :: ierr                                       ! local integer 
     118      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::  ztrcdta ! 4D  workspace 
    174119      !!---------------------------------------------------------------------- 
    175120 
    … …  
    243188      END DO 
    244189 
    245 #if defined key_dtatrc 
    246190      ! Restore close seas values to initial data 
    247       CALL trc_dta( nit000 )  
    248       DO jn = 1, jptra 
    249          IF( lutini(jn) ) THEN 
    250             DO jc = 1, npicts 
    251                DO jk = 1, jpkm1 
    252                   DO jj = ictsj1(jc), ictsj2(jc) 
    253                      DO ji = ictsi1(jc), ictsi2(jc) 
    254                         trn(ji,jj,jk,jn) = trdta(ji,jj,jk,jn) * tmask(ji,jj,jk)  
    255                         trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 
    256                      ENDDO 
    257                   ENDDO 
    258                ENDDO 
    259             ENDDO 
    260          ENDIF 
    261       ENDDO 
    262 #endif 
    263    ! 
     191      IF( nb_trcdta > 0 ) THEN  ! Initialisation of tracer from a file that may also be used for damping 
     192        ALLOCATE( ztrcdta(jpi,jpj,jpk,nb_trcdta), STAT=ierr ) 
     193        IF( ierr > 0 ) THEN 
     194           CALL ctl_stop( 'trc_ini: unable to allocate ztrcdta array' )   ;   RETURN 
     195        ENDIF 
     196        ! 
     197        CALL trc_dta( nit000, ztrcdta )   ! read tracer data at nit000 
     198        ! 
     199        DO jn = 1, jptra 
     200           IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file 
     201              jl = n_trc_index(jn) 
     202              DO jc = 1, npicts 
     203                 DO jk = 1, jpkm1 
     204                    DO jj = ictsj1(jc), ictsj2(jc) 
     205                       DO ji = ictsi1(jc), ictsi2(jc) 
     206                          trn(ji,jj,jk,jn) = ztrcdta(ji,jj,jk,jl) * tmask(ji,jj,jk)  
     207                          trb(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 
     208                       ENDDO 
     209                    ENDDO 
     210                 ENDDO 
     211              ENDDO 
     212           ENDIF 
     213        ENDDO 
     214        DEALLOCATE( ztrcdta ) 
     215      ENDIF 
     216      ! 
    264217   END SUBROUTINE pis_dmp_clo 
    265218 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/PISCES/trcsms_pisces.F90

    r2715 r2977  
    1313   !!   trcsms_pisces        :  Time loop of passive tracers sms 
    1414   !!---------------------------------------------------------------------- 
    15    USE oce_trc         ! 
    16    USE trc 
    17    USE sms_pisces 
    18     
    19    USE p4zint          !  
    20    USE p4zche          !  
    21    USE p4zbio          !  
    22    USE p4zsink         !  
    23    USE p4zopt          !  
    24    USE p4zlim          !  
    25    USE p4zprod         ! 
    26    USE p4zmort         ! 
    27    USE p4zmicro        !  
    28    USE p4zmeso         !  
    29    USE p4zrem          !  
    30    USE p4zsed          !  
    31    USE p4zlys          !  
    32    USE p4zflx          !  
    33  
    34    USE prtctl_trc 
    35  
    36    USE trdmod_oce 
    37    USE trdmod_trc 
    38  
    39    USE sedmodel 
     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 
     18   USE p4zbio          !  Biological model 
     19   USE p4zche          !  Chemical model 
     20   USE p4zsink         !  vertical flux of particulate matter due to sinking 
     21   USE p4zopt          !  optical model 
     22   USE p4zlim          !  Co-limitations of differents nutrients 
     23   USE p4zprod         !  Growth rate of the 2 phyto groups 
     24   USE p4zmort         !  Mortality terms for phytoplankton 
     25   USE p4zmicro        !  Sources and sinks of microzooplankton 
     26   USE p4zmeso         !  Sources and sinks of mesozooplankton 
     27   USE p4zrem          !  Remineralisation of organic matter 
     28   USE p4zlys          !  Calcite saturation 
     29   USE p4zflx          !  Gas exchange 
     30   USE p4zsed          !  Sedimentation 
     31   USE p4zint          !  time interpolation 
     32   USE trdmod_oce      !  Ocean trends variables 
     33   USE trdmod_trc      !  TOP trends variables 
     34   USE sedmodel        !  Sediment model 
     35   USE prtctl_trc      !  print control for debugging 
    4036 
    4137   IMPLICIT NONE 
    … …  
    6359      !!              - ... 
    6460      !!--------------------------------------------------------------------- 
    65       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    66       USE wrk_nemo, ONLY: ztrpis => wrk_3d_1   ! used for pisces sms trends 
    6761      ! 
    6862      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
    … …  
    7266      !!--------------------------------------------------------------------- 
    7367 
    74       IF( kt == nit000 )   CALL trc_sms_pisces_init    ! Initialization (first time-step only) 
    75  
    76       IF( wrk_in_use(3,1) )  THEN 
    77         CALL ctl_stop('trc_sms_pisces : requested workspace array unavailable.')  ;  RETURN 
    78       ENDIF 
     68      IF( kt == nit000 )                                                   CALL trc_sms_pisces_init       ! Initialization (first time-step only) 
     69      IF( ln_rsttr .AND. ln_pisdmp .AND. MOD( kt - 1, nn_pisdmp ) == 0 )   CALL trc_sms_pisces_dmp( kt )  ! Relaxation of some tracers 
     70 
    7971 
    8072      IF( ndayflxtr /= nday_year ) THEN      ! New days 
    … …  
    8678         IF(lwp) write(numout,*) '~~~~~~' 
    8779 
    88          CALL p4z_che          ! computation of chemical constants 
    89          CALL p4z_int          ! computation of various rates for biogeochemistry 
     80         CALL p4z_che              ! computation of chemical constants 
     81         CALL p4z_int              ! computation of various rates for biogeochemistry 
    9082         ! 
    9183      ENDIF 
    … …  
    112104      IF( l_trdtrc ) THEN 
    113105          DO jn = jp_pcs0, jp_pcs1 
    114             ztrpis(:,:,:) = tra(:,:,:,jn) 
    115             CALL trd_mod_trc( ztrpis, jn, jptra_trd_sms, kt )   ! save trends 
     106            CALL trd_mod_trc( tra(:,:,:,jn), jn, jptra_trd_sms, kt )   ! save trends 
    116107          END DO 
    117           DEALLOCATE( ztrpis ) 
    118108      END IF 
    119109 
    … …  
    127117         ! 
    128118      ENDIF 
    129  
    130       IF( wrk_not_released(3,1) ) CALL ctl_stop('trc_sms_pisces : failed to release workspace array.')  
    131  
     119      ! 
    132120   END SUBROUTINE trc_sms_pisces 
     121 
     122   SUBROUTINE trc_sms_pisces_dmp( kt ) 
     123      !!---------------------------------------------------------------------- 
     124      !!                    ***  trc_sms_pisces_dmp  *** 
     125      !! 
     126      !! ** purpose  : Relaxation of some tracers 
     127      !!---------------------------------------------------------------------- 
     128      ! 
     129      INTEGER, INTENT( in )  ::     kt ! time step 
     130      ! 
     131      REAL(wp) ::  alkmean = 2426.     ! mean value of alkalinity ( Glodap ; for Goyet 2391. ) 
     132      REAL(wp) ::  po4mean = 2.165     ! mean value of phosphates 
     133      REAL(wp) ::  no3mean = 30.90     ! mean value of nitrate 
     134      REAL(wp) ::  silmean = 91.51     ! mean value of silicate 
     135      ! 
     136      REAL(wp) :: zarea, zalksum, zpo4sum, zno3sum, zsilsum 
     137      !!--------------------------------------------------------------------- 
     138 
     139 
     140      IF(lwp)  WRITE(numout,*) 
     141      IF(lwp)  WRITE(numout,*) ' trc_sms_pisces_dmp : Relaxation of nutrients at time-step kt = ', kt 
     142      IF(lwp)  WRITE(numout,*) 
     143 
     144      IF( cp_cfg == "orca" .AND. .NOT. lk_c1d ) THEN      ! ORCA condiguration (not 1D) ! 
     145         !                                                    ! --------------------------- ! 
     146         ! set total alkalinity, phosphate, nitrate & silicate 
     147         zarea          = 1._wp / glob_sum( cvol(:,:,:) ) * 1e6               
     148 
     149         zalksum = glob_sum( trn(:,:,:,jptal) * cvol(:,:,:)  ) * zarea 
     150         zpo4sum = glob_sum( trn(:,:,:,jppo4) * cvol(:,:,:)  ) * zarea / 122. 
     151         zno3sum = glob_sum( trn(:,:,:,jpno3) * cvol(:,:,:)  ) * zarea / 7.6 
     152         zsilsum = glob_sum( trn(:,:,:,jpsil) * cvol(:,:,:)  ) * zarea 
     153  
     154         IF(lwp) WRITE(numout,*) '       TALK mean : ', zalksum 
     155         trn(:,:,:,jptal) = trn(:,:,:,jptal) * alkmean / zalksum 
     156 
     157         IF(lwp) WRITE(numout,*) '       PO4  mean : ', zpo4sum 
     158         trn(:,:,:,jppo4) = trn(:,:,:,jppo4) * po4mean / zpo4sum 
     159 
     160         IF(lwp) WRITE(numout,*) '       NO3  mean : ', zno3sum 
     161         trn(:,:,:,jpno3) = trn(:,:,:,jpno3) * no3mean / zno3sum 
     162 
     163         IF(lwp) WRITE(numout,*) '       SiO3 mean : ', zsilsum 
     164         trn(:,:,:,jpsil) = MIN( 400.e-6,trn(:,:,:,jpsil) * silmean / zsilsum ) 
     165         ! 
     166      ENDIF 
     167 
     168   END SUBROUTINE trc_sms_pisces_dmp 
    133169 
    134170   SUBROUTINE trc_sms_pisces_init 
    … …  
    164200      xstep = rfact2 / rday 
    165201 
    166       CALL p4z_sink_init      ! vertical flux of particulate organic matter 
    167       CALL p4z_opt_init       ! Optic: PAR in the water column 
    168       CALL p4z_lim_init       ! co-limitations by the various nutrients 
    169       CALL p4z_prod_init      ! phytoplankton growth rate over the global ocean.  
    170       CALL p4z_rem_init       ! remineralisation 
    171       CALL p4z_mort_init      ! phytoplankton mortality 
    172       CALL p4z_micro_init     ! microzooplankton 
    173       CALL p4z_meso_init      ! mesozooplankton 
    174       CALL p4z_sed_init       ! sedimentation 
    175       CALL p4z_lys_init       ! calcite saturation 
    176       CALL p4z_flx_init       ! gas exchange 
     202      CALL p4z_sink_init      !  vertical flux of particulate organic matter 
     203      CALL p4z_opt_init       !  Optic: PAR in the water column 
     204      CALL p4z_lim_init       !  co-limitations by the various nutrients 
     205      CALL p4z_prod_init      !  phytoplankton growth rate over the global ocean.  
     206      CALL p4z_rem_init       !  remineralisation 
     207      CALL p4z_mort_init      !  phytoplankton mortality 
     208      CALL p4z_micro_init     !  microzooplankton 
     209      CALL p4z_meso_init      !  mesozooplankton 
     210      CALL p4z_sed_init       !  sedimentation 
     211      CALL p4z_lys_init       !  calcite saturation 
     212      CALL p4z_flx_init       !  gas exchange 
    177213 
    178214      ndayflxtr = 0 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/TRP/trcldf.F90

    r2715 r2977  
    1818   USE trc             ! ocean passive tracers variables 
    1919   USE trcnam_trp      ! passive tracers transport namelist variables 
    20    USE ldftra_oce      ! lateral diffusion coefficient on tracers 
    2120   USE ldfslp          ! ??? 
    2221   USE traldf_bilapg   ! lateral mixing            (tra_ldf_bilapg routine) 
    … …  
    3332   PUBLIC   trc_ldf    ! called by step.F90  
    3433   !                                                 !!: ** lateral mixing namelist (nam_trcldf) ** 
    35    INTEGER ::   nldf = 0   ! type of lateral diffusion used defined from ln_trcldf_... namlist logicals) 
     34   REAL(wp) ::  rldf_rat    ! ratio between active and passive tracers diffusive coefficient 
     35   INTEGER  ::  nldf = 0   ! type of lateral diffusion used defined from ln_trcldf_... namlist logicals) 
    3636   !! * Substitutions 
    3737#  include "domzgr_substitute.h90" 
    … …  
    6161      IF( kt == nit000 )   CALL ldf_ctl          ! initialisation & control of options 
    6262 
     63      rldf = rldf_rat 
     64 
    6365      IF( l_trdtrc )  THEN  
    6466         ALLOCATE( ztrtrd(jpi,jpj,jpk,jptra) )  ! temporary save of trends 
    … …  
    6769 
    6870      SELECT CASE ( nldf )                       ! compute lateral mixing trend and add it to the general trend 
    69       CASE ( 0 )   ;   CALL tra_ldf_lap   ( kt, 'TRC', gtru, gtrv, trb, tra, jptra            )  ! iso-level laplacian 
    70       CASE ( 1 )   ;   CALL tra_ldf_iso   ( kt, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 )  ! rotated laplacian  
    71       CASE ( 2 )   ;   CALL tra_ldf_bilap ( kt, 'TRC', gtru, gtrv, trb, tra, jptra            )  ! iso-level bilaplacian 
    72       CASE ( 3 )   ;   CALL tra_ldf_bilapg( kt, 'TRC',             trb, tra, jptra            )  ! s-coord. horizontal bilaplacian 
     71      CASE ( 0 )   ;   CALL tra_ldf_lap   ( kt, 'TRC', gtru, gtrv, trb, tra, jptra             )  ! iso-level laplacian 
     72      CASE ( 1 )   ;   CALL tra_ldf_iso   ( kt, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtrb_0 )  ! rotated laplacian  
     73      CASE ( 2 )   ;   CALL tra_ldf_bilap ( kt, 'TRC', gtru, gtrv, trb, tra, jptra             )  ! iso-level bilaplacian 
     74      CASE ( 3 )   ;   CALL tra_ldf_bilapg( kt, 'TRC',             trb, tra, jptra             )  ! s-coord. horizontal bilaplacian 
    7375         ! 
    7476      CASE ( -1 )                                     ! esopa: test all possibility with control print 
    75          CALL tra_ldf_lap   ( kt, 'TRC', gtru, gtrv, trb, tra, jptra            ) 
     77         CALL tra_ldf_lap   ( kt, 'TRC', gtru, gtrv, trb, tra, jptra             ) 
    7678         WRITE(charout, FMT="('ldf0 ')") ;  CALL prt_ctl_trc_info(charout) 
    7779                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    78          CALL tra_ldf_iso   ( kt, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) 
     80         CALL tra_ldf_iso   ( kt, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtrb_0 ) 
    7981         WRITE(charout, FMT="('ldf1 ')") ;  CALL prt_ctl_trc_info(charout) 
    8082                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    81          CALL tra_ldf_bilap ( kt, 'TRC', gtru, gtrv, trb, tra, jptra            ) 
     83         CALL tra_ldf_bilap ( kt, 'TRC', gtru, gtrv, trb, tra, jptra             ) 
    8284         WRITE(charout, FMT="('ldf2 ')") ;  CALL prt_ctl_trc_info(charout) 
    8385                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    84          CALL tra_ldf_bilapg( kt, 'TRC',             trb, tra, jptra            ) 
     86         CALL tra_ldf_bilapg( kt, 'TRC',             trb, tra, jptra             ) 
    8587         WRITE(charout, FMT="('ldf3 ')") ;  CALL prt_ctl_trc_info(charout) 
    8688                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    … …  
    119121      INTEGER ::   ioptio, ierr         ! temporary integers  
    120122      !!---------------------------------------------------------------------- 
     123 
     124      rldf_rat = rn_ahtrc_0 / rn_aht_0 
    121125 
    122126      !  Define the lateral mixing oparator for tracers 
    … …  
    206210      ENDIF 
    207211 
     212      IF( ln_trcldf_bilap ) THEN 
     213         IF(lwp) WRITE(numout,*) '          biharmonic tracer diffusion' 
     214         IF( rn_ahtrc_0 > 0 .AND. .NOT. lk_esopa )   CALL ctl_stop( 'The horizontal diffusivity coef. rn_ahtrc_0 must be negative' ) 
     215      ELSE 
     216         IF(lwp) WRITE(numout,*) '          harmonic tracer diffusion (default)' 
     217         IF( rn_ahtrc_0 < 0 .AND. .NOT. lk_esopa )   CALL ctl_stop('The horizontal diffusivity coef. rn_ahtrc_0 must be positive' ) 
     218      ENDIF 
     219 
     220      ! ratio between active and passive tracers diffusive coef. 
     221      rldf_rat = rn_ahtrc_0 / rn_aht_0 
     222      IF( rldf_rat < 0 ) THEN 
     223         IF( .NOT.lk_offline ) THEN  
     224            CALL ctl_stop( 'Choose the same type of diffusive scheme both for active & passive tracers' ) 
     225         ELSE 
     226            CALL ctl_stop( 'Change the sign of rn_aht_0 in namelist to -/+1' ) 
     227         ENDIF  
     228      ENDIF 
    208229      ! 
    209230   END SUBROUTINE ldf_ctl 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/TRP/trcnam_trp.F90

    r2528 r2977  
    3636   LOGICAL , PUBLIC ::   ln_trcldf_hor   = .FALSE.    !: horizontal (geopotential) direction 
    3737   LOGICAL , PUBLIC ::   ln_trcldf_iso   = .TRUE.     !: iso-neutral direction 
     38   REAL(wp), PUBLIC ::   rn_ahtrc_0                   !: diffusivity coefficient for passive tracer (m2/s) 
    3839   REAL(wp), PUBLIC ::   rn_ahtrb_0                   !: background diffusivity coefficient for passive tracer (m2/s) 
    3940 
    … …  
    7677      NAMELIST/namtrc_ldf/ ln_trcldf_diff , ln_trcldf_lap  ,     & 
    7778         &                 ln_trcldf_bilap, ln_trcldf_level,     & 
    78          &                 ln_trcldf_hor  , ln_trcldf_iso  , rn_ahtrb_0 
     79         &                 ln_trcldf_hor  , ln_trcldf_iso  , rn_ahtrc_0, rn_ahtrb_0 
    7980      NAMELIST/namtrc_zdf/ ln_trczdf_exp  , nn_trczdf_exp 
    8081      NAMELIST/namtrc_rad/ ln_trcrad 
    … …  
    119120         WRITE(numout,*) '      horizontal (geopotential)                          ln_trcldf_hor   = ', ln_trcldf_hor 
    120121         WRITE(numout,*) '      iso-neutral                                        ln_trcldf_iso   = ', ln_trcldf_iso 
     122         WRITE(numout,*) '      diffusivity coefficient                                 rn_ahtrc_0 = ', rn_ahtrc_0 
    121123         WRITE(numout,*) '      background hor. diffusivity                             rn_ahtrb_0 = ', rn_ahtrb_0 
    122124      ENDIF 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/TRP/trcrad.F90

    r2715 r2977  
    104104       
    105105      ! Local declarations 
    106       INTEGER  ::  ji, jj, jk, jn     ! dummy loop indices 
    107       REAL(wp) :: zvolk, ztrcorb, ztrmasb   ! temporary scalars 
     106      INTEGER  :: ji, jj, jk, jn     ! dummy loop indices 
     107      REAL(wp) :: ztrcorb, ztrmasb   ! temporary scalars 
    108108      REAL(wp) :: zcoef, ztrcorn, ztrmasn   !    "         " 
    109109      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrdb  ! workspace arrays 
    … …  
    137137               DO jj = 1, jpj 
    138138                  DO ji = 1, jpi 
    139                      zvolk  = cvol(ji,jj,jk) 
    140 # if defined key_degrad 
    141                      zvolk  = zvolk * facvol(ji,jj,jk) 
    142 # endif 
    143                      ztrcorb = ztrcorb + MIN( 0., ptrb(ji,jj,jk,jn) ) * zvolk 
    144                      ztrcorn = ztrcorn + MIN( 0., ptrn(ji,jj,jk,jn) ) * zvolk 
     139                     ztrcorb = ztrcorb + MIN( 0., ptrb(ji,jj,jk,jn) ) * cvol(ji,jj,jk) 
     140                     ztrcorn = ztrcorn + MIN( 0., ptrn(ji,jj,jk,jn) ) * cvol(ji,jj,jk) 
    145141 
    146142                     ptrb(ji,jj,jk,jn) = MAX( 0., ptrb(ji,jj,jk,jn) ) 
    147143                     ptrn(ji,jj,jk,jn) = MAX( 0., ptrn(ji,jj,jk,jn) ) 
    148144 
    149                      ztrmasb = ztrmasb + ptrb(ji,jj,jk,jn) * zvolk 
    150                      ztrmasn = ztrmasn + ptrn(ji,jj,jk,jn) * zvolk 
     145                     ztrmasb = ztrmasb + ptrb(ji,jj,jk,jn) * cvol(ji,jj,jk) 
     146                     ztrmasn = ztrmasn + ptrn(ji,jj,jk,jn) * cvol(ji,jj,jk) 
    151147                  END DO 
    152148               END DO 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/oce_trc.F90

    r2787 r2977  
    184184   USE oce , ONLY :   vn      =>    vn      !: j-horizontal velocity (m s-1) 
    185185   USE oce , ONLY :   wn      =>    wn      !: vertical velocity (m s-1)   
    186    USE oce , ONLY :   tn      =>    tn      !: pot. temperature (celsius) 
    187    USE oce , ONLY :   sn      =>    sn      !: salinity (psu) 
    188186   USE oce , ONLY :   tsn     =>    tsn     !: 4D array contaning ( tn, sn ) 
    189187   USE oce , ONLY :   tsb     =>    tsb     !: 4D array contaning ( tb, sb ) 
    … …  
    198196   USE oce , ONLY :   gru     =>    gru     !: 
    199197   USE oce , ONLY :   grv     =>    grv     !:  
    200 # if defined key_degrad 
    201    USE dommsk , ONLY :   facvol     =>   facvol     !: volume factor for degradation 
    202 # endif 
    203  
    204198#endif 
    205199 
    … …  
    226220 
    227221   !* lateral diffusivity (tracers) * 
    228    USE ldftra_oce , ONLY :   aht0    =>   aht0     !: horizontal eddy diffusivity for tracers (m2/s) 
    229    USE ldftra_oce , ONLY :   ahtb0   =>   ahtb0    !: background eddy diffusivity for isopycnal diff. (m2/s) 
    230    USE ldftra_oce , ONLY :   ahtu    =>   ahtu     !: lateral diffusivity coef. at u-points  
    231    USE ldftra_oce , ONLY :   ahtv    =>   ahtv     !: lateral diffusivity coef. at v-points  
    232    USE ldftra_oce , ONLY :   ahtw    =>   ahtw     !: lateral diffusivity coef. at w-points  
    233    USE ldftra_oce , ONLY :   ahtt    =>   ahtt     !: lateral diffusivity coef. at t-points 
    234    USE ldftra_oce , ONLY :   aeiv0   =>   aeiv0    !: eddy induced velocity coefficient (m2/s)  
    235    USE ldftra_oce , ONLY :   aeiu    =>   aeiu     !: eddy induced velocity coef. at u-points (m2/s)    
    236    USE ldftra_oce , ONLY :   aeiv    =>   aeiv     !: eddy induced velocity coef. at v-points (m2/s)  
    237    USE ldftra_oce , ONLY :   aeiw    =>   aeiw     !: eddy induced velocity coef. at w-points (m2/s)  
     222   USE ldftra_oce , ONLY :  rldf     =>   rldf        !: multiplicative coef. for lateral diffusivity 
     223   USE ldftra_oce , ONLY :  rn_aht_0 =>   rn_aht_0    !: horizontal eddy diffusivity for tracers (m2/s) 
     224   USE ldftra_oce , ONLY :  aht0     =>   aht0        !: horizontal eddy diffusivity for tracers (m2/s) 
     225   USE ldftra_oce , ONLY :  ahtb0    =>   ahtb0       !: background eddy diffusivity for isopycnal diff. (m2/s) 
     226   USE ldftra_oce , ONLY :  ahtu     =>   ahtu        !: lateral diffusivity coef. at u-points  
     227   USE ldftra_oce , ONLY :  ahtv     =>   ahtv        !: lateral diffusivity coef. at v-points  
     228   USE ldftra_oce , ONLY :  ahtw     =>   ahtw        !: lateral diffusivity coef. at w-points  
     229   USE ldftra_oce , ONLY :  ahtt     =>   ahtt        !: lateral diffusivity coef. at t-points 
     230   USE ldftra_oce , ONLY :  aeiv0    =>   aeiv0       !: eddy induced velocity coefficient (m2/s)  
     231   USE ldftra_oce , ONLY :  aeiu     =>   aeiu        !: eddy induced velocity coef. at u-points (m2/s)    
     232   USE ldftra_oce , ONLY :  aeiv     =>   aeiv        !: eddy induced velocity coef. at v-points (m2/s)  
     233   USE ldftra_oce , ONLY :  aeiw     =>   aeiw        !: eddy induced velocity coef. at w-points (m2/s)  
     234   USE ldftra_oce , ONLY :  lk_traldf_eiv  =>  lk_traldf_eiv     !: eddy induced velocity flag 
    238235 
    239236   !* vertical diffusion * 
    240237   USE zdf_oce , ONLY :   avt        =>   avt         !: vert. diffusivity coef. at w-point for temp   
    241238# if defined key_zdfddm 
    242    USE zdfddm  , ONLY :   avs        =>   avs        !: salinity vertical diffusivity coeff. at w-point 
     239   USE zdfddm  , ONLY :   avs        =>   avs         !: salinity vertical diffusivity coeff. at w-point 
    243240# endif 
    244241 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/trc.F90

    r2715 r2977  
    2121   PUBLIC   trc_alloc   ! called by nemogcm.F90 
    2222 
    23    !! passive tracers names and units (read in namelist) 
    24    !! -------------------------------------------------- 
    25    CHARACTER(len=12), PUBLIC, DIMENSION(jptra) ::   ctrcnm     !: tracer name  
    26    CHARACTER(len=12), PUBLIC, DIMENSION(jptra) ::   ctrcun     !: tracer unit 
    27    CHARACTER(len=80), PUBLIC, DIMENSION(jptra) ::   ctrcnl     !: tracer long name  
    28     
    29     
    3023   !! parameters for the control of passive tracers 
    3124   !! -------------------------------------------------- 
    32    INTEGER, PUBLIC                   ::   numnat   !: the number of the passive tracer NAMELIST 
    33    LOGICAL, PUBLIC, DIMENSION(jptra) ::   lutini   !:  initialisation from FILE or not (NAMELIST) 
    34    LOGICAL, PUBLIC, DIMENSION(jptra) ::   lutsav   !:  save the tracer or not 
     25   INTEGER, PUBLIC                                                 ::   numnat        !: the number of the passive tracer NAMELIST 
    3526 
    3627   !! passive tracers fields (before,now,after) 
    3728   !! -------------------------------------------------- 
    38    REAL(wp), PUBLIC ::   trai                          !: initial total tracer 
    39    REAL(wp), PUBLIC ::   areatot                       !: total volume  
    40    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:,:)   ::   cvol   !: volume correction -degrad option-  
    41    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:,:,:) ::   trn    !: traceur concentration for now time step 
    42    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:,:,:) ::   tra    !: traceur concentration for next time step 
    43    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:,:,:) ::   trb    !: traceur concentration for before time step 
     29   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)               ::  trai           !: initial total tracer 
     30   REAL(wp), PUBLIC                                                ::  areatot        !: total volume  
     31   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  )         ::  cvol           !: volume correction -degrad option-  
     32   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  trn            !: traceur concentration for now time step 
     33   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  tra            !: traceur concentration for next time step 
     34   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  trb            !: traceur concentration for before time step 
    4435 
    4536   !! interpolated gradient 
    4637   !!--------------------------------------------------   
    47    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::   gtru   !: hor. gradient at u-points at bottom ocean level 
    48    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION (:,:,:) ::   gtrv   !: hor. gradient at v-points at bottom ocean level 
     38   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)           ::  gtru           !: hor. gradient at u-points at bottom ocean level 
     39   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)           ::  gtrv           !: hor. gradient at v-points at bottom ocean level 
    4940    
    50    !! passive tracers restart (input and output) 
     41   !! passive tracers (input and output) 
    5142   !! ------------------------------------------   
    52    LOGICAL          , PUBLIC ::  ln_rsttr        !: boolean term for restart i/o for passive tracers (namelist) 
    53    LOGICAL          , PUBLIC ::  lrst_trc        !: logical to control the trc restart write 
    54    INTEGER          , PUBLIC ::  nn_dttrc        !: frequency of step on passive tracers 
    55    INTEGER          , PUBLIC ::  nutwrs          !: output FILE for passive tracers restart 
    56    INTEGER          , PUBLIC ::  nutrst          !: logical unit for restart FILE for passive tracers 
    57    INTEGER          , PUBLIC ::  nn_rsttr        !: control of the time step ( 0 or 1 ) for pass. tr. 
    58    CHARACTER(len=50), PUBLIC ::  cn_trcrst_in    !: suffix of pass. tracer restart name (input) 
    59    CHARACTER(len=50), PUBLIC ::  cn_trcrst_out   !: suffix of pass. tracer restart name (output) 
    60     
     43   LOGICAL             , PUBLIC                                    ::  ln_rsttr       !: boolean term for restart i/o for passive tracers (namelist) 
     44   LOGICAL             , PUBLIC                                    ::  lrst_trc       !: logical to control the trc restart write 
     45   INTEGER             , PUBLIC                                    ::  nn_dttrc       !: frequency of step on passive tracers 
     46   INTEGER             , PUBLIC                                    ::  nn_writetrc    !: time step frequency for concentration outputs (namelist) 
     47   INTEGER             , PUBLIC                                    ::  nutwrs         !: output FILE for passive tracers restart 
     48   INTEGER             , PUBLIC                                    ::  nutrst         !: logical unit for restart FILE for passive tracers 
     49   INTEGER             , PUBLIC                                    ::  nn_rsttr       !: control of the time step ( 0 or 1 ) for pass. tr. 
     50   CHARACTER(len = 80) , PUBLIC                                    ::  cn_trcrst_in   !: suffix of pass. tracer restart name (input) 
     51   CHARACTER(len = 80) , PUBLIC                                    ::  cn_trcrst_out  !: suffix of pass. tracer restart name (output) 
     52   REAL(wp)            , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::  rdttrc         !: vertical profile of passive tracer time step 
     53   LOGICAL             , PUBLIC                                    ::  ln_trcdta      !: Read inputs data from files 
     54   LOGICAL             , PUBLIC                                    ::  ln_trcdmp      !: internal damping flag 
     55 
    6156   !! information for outputs 
    6257   !! -------------------------------------------------- 
    63    INTEGER , PUBLIC ::   nn_writetrc   !: time step frequency for concentration outputs (namelist) 
    64    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   rdttrc        !: vertical profile of passive tracer time step 
    65     
    66 # if defined key_diatrc && ! defined key_iomput 
     58   TYPE, PUBLIC :: PTRACER                                                            !: Passive tracer type 
     59       CHARACTER(len = 20)  :: clsname  !: short name 
     60       CHARACTER(len = 80)  :: cllname  !: long name 
     61       CHARACTER(len = 20)  :: clunit   !: unit 
     62       LOGICAL              :: llinit   !: read in a file or not 
     63       LOGICAL              :: llsave   !: save the tracer or not 
     64   END TYPE PTRACER 
     65   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ctrcnm         !: tracer name  
     66   CHARACTER(len = 80), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ctrcln         !: trccer field long name 
     67   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ctrcun         !: tracer unit 
     68   LOGICAL            , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ln_trc_ini     !: Initialisation from data input file 
     69   LOGICAL            , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ln_trc_wri     !: save the tracer or not 
     70 
     71   TYPE, PUBLIC :: DIAG                                                               !: passive trcacer ddditional diagnostic type 
     72      CHARACTER(len = 20)  :: sname    !: short name 
     73      CHARACTER(len = 80)  :: lname    !: long name 
     74      CHARACTER(len = 20)  :: units    !: unit 
     75   END TYPE DIAG 
     76 
    6777   !! additional 2D/3D outputs namelist 
    6878   !! -------------------------------------------------- 
    69    INTEGER         , PUBLIC                      ::   nn_writedia   !: frequency of additional arrays outputs(namelist) 
    70    CHARACTER(len= 8), PUBLIC, DIMENSION(jpdia2d) ::   ctrc2d      !: 2d output field name 
    71    CHARACTER(len= 8), PUBLIC, DIMENSION(jpdia2d) ::   ctrc2u      !: 2d output field unit    
    72    CHARACTER(len= 8), PUBLIC, DIMENSION(jpdia3d) ::   ctrc3d      !: 3d output field name 
    73    CHARACTER(len= 8), PUBLIC, DIMENSION(jpdia3d) ::   ctrc3u      !: 3d output field unit 
    74    CHARACTER(len=80), PUBLIC, DIMENSION(jpdia2d) ::   ctrc2l      !: 2d output field long name 
    75    CHARACTER(len=80), PUBLIC, DIMENSION(jpdia3d) ::   ctrc3l      !: 3d output field long name 
     79   REAL(wp)           , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,  :) ::   trc2d         !: additional 2d outputs array  
     80   REAL(wp)           , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   trc3d         !: additional 3d outputs array  
     81   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   ctrc2d        !: 2d field short name 
     82   CHARACTER(len = 80), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   ctrc2l        !: 2d field long name 
     83   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   ctrc2u        !: 2d field unit 
     84   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   ctrc3d        !: 3d field short name 
     85   CHARACTER(len = 80), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   ctrc3l        !: 3d field long name 
     86   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   ctrc3u        !: 3d field unit 
     87   LOGICAL            , PUBLIC                                        ::  ln_diatrc      !: boolean term for additional diagnostic 
     88   INTEGER            , PUBLIC                                        ::  nn_writedia    !: frequency of additional outputs 
    7689 
    77    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,  :) ::   trc2d    !:  additional 2d outputs   
    78    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   trc3d    !:  additional 3d outputs   
    79 # endif 
    80  
    81 # if defined key_diabio || defined key_trdmld_trc 
    82    !                                                              !!*  namtop_XXX namelist * 
    83    INTEGER , PUBLIC                               ::   nn_writebio   !: time step frequency for biological outputs  
    84    CHARACTER(len=8 ), PUBLIC, DIMENSION(jpdiabio) ::   ctrbio      !: biological trends name       
    85    CHARACTER(len=20), PUBLIC, DIMENSION(jpdiabio) ::   ctrbiu      !: biological trends unit    
    86    CHARACTER(len=80), PUBLIC, DIMENSION(jpdiabio) ::   ctrbil      !: biological trends long name 
    87 # endif 
    88 # if defined key_diabio 
    8990   !! Biological trends 
    9091   !! ----------------- 
    91    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   trbio   !: biological trends 
    92 # endif 
    93  
    94     
    95    !! passive tracers data read and at given time_step 
    96    !! -------------------------------------------------- 
    97 # if defined key_dtatrc 
    98    INTEGER , PUBLIC, DIMENSION(jptra) ::   numtr   !: logical unit for passive tracers data 
    99 # endif 
     92   LOGICAL            , PUBLIC                                        ::  ln_diabio      !: boolean term for biological diagnostic 
     93   INTEGER            , PUBLIC                                        ::  nn_writebio    !: frequency of biological outputs 
     94   REAL(wp)           , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  trbio          !: biological trends 
     95   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  ctrbio         !: bio field short name 
     96   CHARACTER(len = 80), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  ctrbil         !: bio field long name 
     97   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  ctrbiu         !: bio field unit 
    10098 
    10199   !!---------------------------------------------------------------------- 
    … …  
    113111      !!------------------------------------------------------------------- 
    114112      ! 
    115       ALLOCATE( cvol(jpi,jpj,jpk      ) ,                           & 
    116          &      trn (jpi,jpj,jpk,jptra) ,                           & 
    117          &      tra (jpi,jpj,jpk,jptra) ,                           & 
    118          &      trb (jpi,jpj,jpk,jptra) ,                           & 
    119          &      gtru(jpi,jpj    ,jptra) , gtrv(jpi,jpj,jptra) ,     & 
    120 # if defined key_diatrc && ! defined key_iomput 
    121          &      trc2d(jpi,jpj,jpdia2d), trc3d(jpi,jpj,jpk,jpdia3d), & 
    122 # endif 
    123 # if defined key_diabio 
    124          &      trbio(jpi,jpj,jpk,jpdiabio),                        & 
    125 #endif 
    126                rdttrc(jpk) ,  STAT=trc_alloc )       
     113      ALLOCATE( trn(jpi,jpj,jpk,jptra), trb(jpi,jpj,jpk,jptra), tra(jpi,jpj,jpk,jptra),       &   
     114         &      gtru(jpi,jpj,jpk)     , gtrv(jpi,jpj,jpk)                             ,       & 
     115         &      cvol(jpi,jpj,jpk)     , rdttrc(jpk)           , trai(jptra)           ,       & 
     116         &      ctrcnm(jptra)         , ctrcln(jptra)         , ctrcun(jptra)         ,       &  
     117         &      ln_trc_ini(jptra)     , ln_trc_wri(jptra)                             ,  STAT = trc_alloc  )   
    127118 
    128119      IF( trc_alloc /= 0 )   CALL ctl_warn('trc_alloc: failed to allocate arrays') 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/trcdia.F90

    r2715 r2977  
    1111   !!                  !  2008-05 (C. Ethe re-organization) 
    1212   !!---------------------------------------------------------------------- 
    13 #if defined key_top && ! defined key_iomput 
     13#if defined key_top  
    1414   !!---------------------------------------------------------------------- 
    1515   !!   'key_top'                                                TOP models 
    … …  
    2525   USE par_trc 
    2626   USE dianam    ! build name of file (routine) 
    27    USE ioipsl 
     27   USE ioipsl    ! I/O manager 
     28   USE iom       ! I/O manager 
     29   USE lib_mpp   ! MPP library 
    2830 
    2931   IMPLICIT NONE 
    … …  
    3133 
    3234   PUBLIC   trc_dia        ! called by XXX module  
    33    PUBLIC   trc_dia_alloc  ! called by nemogcm.F90 
    3435 
    3536   INTEGER  ::   nit5      !: id for tracer output file 
    … …  
    4142   INTEGER , ALLOCATABLE, SAVE, DIMENSION (:) ::   ndext50   !: integer arrays for ocean 3D index 
    4243   INTEGER , ALLOCATABLE, SAVE, DIMENSION (:) ::   ndext51   !: integer arrays for ocean surface index 
    43 # if defined key_diatrc 
     44 
    4445   INTEGER  ::   nitd      !: id for additional array output file 
    4546   INTEGER  ::   ndepitd   !: id for depth mesh 
    4647   INTEGER  ::   nhoritd   !: id for horizontal mesh 
    47 # endif 
    48 # if defined key_diabio 
     48 
    4949   INTEGER  ::   nitb        !:         id.         for additional array output file 
    5050   INTEGER  ::   ndepitb   !:  id for depth mesh 
    5151   INTEGER  ::   nhoritb   !:  id for horizontal mesh 
    52 # endif 
    5352 
    5453   !! * Substitutions 
    … …  
    6766      !! ** Purpose :   output passive tracers fields  
    6867      !!--------------------------------------------------------------------- 
    69       INTEGER, INTENT(in) ::   kt   ! ocean time-step 
    70       ! 
    71       INTEGER ::   kindic   ! local integer 
     68      INTEGER, INTENT(in) ::   kt             ! ocean time-step 
     69      ! 
     70      INTEGER             ::  ierr,  kindic   ! local integer 
    7271      !!--------------------------------------------------------------------- 
    7372      ! 
    74       CALL trcdit_wr( kt, kindic )      ! outputs for tracer concentration 
    75       CALL trcdii_wr( kt, kindic )      ! outputs for additional arrays 
    76       CALL trcdib_wr( kt, kindic )      ! outputs for biological trends 
     73      IF( kt == nit000 )  THEN 
     74         ALLOCATE( ndext50(jpij*jpk), ndext51(jpij), STAT=ierr ) 
     75         IF( ierr > 0 ) THEN 
     76            CALL ctl_stop( 'STOP', 'trc_diat: unable to allocate arrays' )  ;   RETURN 
     77         ENDIF 
     78      ENDIF 
     79      ! 
     80      IF( .NOT.lk_iomput ) THEN 
     81                          CALL trcdit_wr( kt, kindic )      ! outputs for tracer concentration 
     82         IF( ln_diatrc )  CALL trcdii_wr( kt, kindic )      ! outputs for additional arrays 
     83         IF( ln_diabio )  CALL trcdib_wr( kt, kindic )      ! outputs for biological trends 
     84      ENDIF 
    7785      ! 
    7886   END SUBROUTINE trc_dia 
    … …  
    145153       
    146154      IF( kt == nit000 ) THEN 
     155 
     156         IF(lwp) THEN                   ! control print 
     157            WRITE(numout,*) 
     158            WRITE(numout,*) '    frequency of outputs for passive tracers nn_writetrc = ', nn_writetrc 
     159            DO jn = 1, jptra 
     160               IF( ln_trc_wri(jn) )  WRITE(numout,*) ' ouput tracer nb : ', jn, '    short name : ', ctrcnm(jn)  
     161            END DO 
     162            WRITE(numout,*) ' ' 
     163         ENDIF 
    147164 
    148165         ! Compute julian date from starting date of the run 
    … …  
    182199         ! Declare all the output fields as NETCDF variables 
    183200         DO jn = 1, jptra 
    184             IF( lutsav(jn) ) THEN 
     201            IF( ln_trc_wri(jn) ) THEN 
    185202               cltra  = TRIM( ctrcnm(jn) )   ! short title for tracer 
    186                cltral = TRIM( ctrcnl(jn) )   ! long title for tracer 
     203               cltral = TRIM( ctrcln(jn) )   ! long title for tracer 
    187204               cltrau = TRIM( ctrcun(jn) )   ! UNIT for tracer 
    188205               CALL histdef( nit5, cltra, cltral, cltrau, jpi, jpj, nhorit5,  & 
    … …  
    209226      DO jn = 1, jptra 
    210227         cltra  = TRIM( ctrcnm(jn) )   ! short title for tracer 
    211          IF( lutsav(jn) ) CALL histwrite( nit5, cltra, it, trn(:,:,:,jn), ndimt50, ndext50 ) 
     228         IF( ln_trc_wri(jn) ) CALL histwrite( nit5, cltra, it, trn(:,:,:,jn), ndimt50, ndext50 ) 
    212229      END DO 
    213230 
    … …  
    217234      ! 
    218235   END SUBROUTINE trcdit_wr 
    219  
    220 #if defined key_diatrc 
    221236 
    222237   SUBROUTINE trcdii_wr( kt, kindic ) 
    … …  
    360375 
    361376   END SUBROUTINE trcdii_wr 
    362  
    363 # else 
    364    SUBROUTINE trcdii_wr( kt, kindic )                      ! Dummy routine 
    365       INTEGER, INTENT (in) :: kt, kindic 
    366    END SUBROUTINE trcdii_wr 
    367 # endif 
    368  
    369 # if defined key_diabio 
    370377 
    371378   SUBROUTINE trcdib_wr( kt, kindic ) 
    … …  
    485492   END SUBROUTINE trcdib_wr 
    486493 
    487 # else 
    488  
    489    SUBROUTINE trcdib_wr( kt, kindic )                      ! Dummy routine 
    490       INTEGER, INTENT ( in ) ::   kt, kindic 
    491    END SUBROUTINE trcdib_wr 
    492  
    493 # endif  
    494  
    495    INTEGER FUNCTION trc_dia_alloc() 
    496       !!--------------------------------------------------------------------- 
    497       !!                     ***  ROUTINE trc_dia_alloc  *** 
    498       !!--------------------------------------------------------------------- 
    499       ALLOCATE( ndext50(jpij*jpk), ndext51(jpij), STAT=trc_dia_alloc ) 
    500       ! 
    501       IF( trc_dia_alloc /= 0 )   CALL ctl_warn('trc_dia_alloc : failed to allocate arrays') 
    502       ! 
    503    END FUNCTION trc_dia_alloc 
    504494#else 
    505495   !!---------------------------------------------------------------------- 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/trcdta.F90

    r2715 r2977  
    77   !!              -   !  2004-03  (C. Ethe)  module 
    88   !!              -   !  2005-03  (O. Aumont, A. El Moussaoui) F90 
    9    !!---------------------------------------------------------------------- 
    10 #if  defined key_top  &&  defined key_dtatrc 
    11    !!---------------------------------------------------------------------- 
    12    !!   'key_top'  and  'key_dtatrc'        TOP model + passive tracer data 
    13    !!---------------------------------------------------------------------- 
    14    !!   trc_dta      : read ocean passive tracer data 
    15    !!---------------------------------------------------------------------- 
    16    USE oce_trc 
    17    USE par_trc 
    18    USE trc 
    19    USE lib_print 
    20    USE iom 
     9   !!            3.4   !  2010-11  (C. Ethe, G. Madec)  use of fldread + dynamical allocation  
     10   !!---------------------------------------------------------------------- 
     11#if  defined key_top  
     12   !!---------------------------------------------------------------------- 
     13   !!   'key_top'                                                TOP model  
     14   !!---------------------------------------------------------------------- 
     15   !!   trc_dta    : read and time interpolated passive tracer data 
     16   !!---------------------------------------------------------------------- 
     17   USE par_trc       !  passive tracers parameters 
     18   USE oce_trc       !  shared variables between ocean and passive tracers 
     19   USE trc           !  passive tracers common variables 
     20   USE iom           !  I/O manager 
     21   USE lib_mpp       !  MPP library 
     22   USE fldread       !  read input fields 
    2123 
    2224   IMPLICIT NONE 
    … …  
    2426 
    2527   PUBLIC   trc_dta         ! called in trcini.F90 and trcdmp.F90 
    26    PUBLIC   trc_dta_alloc   ! called in nemogcm.F90 
    27  
    28    LOGICAL , PUBLIC, PARAMETER ::   lk_dtatrc = .TRUE.   !: temperature data flag 
    29    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   trdta   !: tracer data at given time-step 
    30  
    31    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) ::   tracdta       ! tracer data at two consecutive times 
    32    INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) ::   nlectr      !: switch for reading once 
    33    INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) ::   ntrc1       !: number of 1st month when reading 12 monthly value 
    34    INTEGER , ALLOCATABLE, SAVE, DIMENSION(:) ::   ntrc2       !: number of 2nd month when reading 12 monthly value 
     28   PUBLIC   trc_dta_init    ! called in trcini.F90  
     29 
     30   INTEGER  , SAVE, PUBLIC                             :: nb_trcdta   ! number of tracers to be initialised with data 
     31   INTEGER  , SAVE, PUBLIC, ALLOCATABLE, DIMENSION(:)  :: n_trc_index ! indice of tracer which is initialised with data 
     32   INTEGER  , SAVE                                     :: ntra        ! MAX( 1, nb_trcdta ) to avoid compilation error with bounds checking 
     33   REAL(wp) , SAVE,         ALLOCATABLE, DIMENSION(:)  :: rf_trfac    ! multiplicative factor for tracer values 
     34   TYPE(FLD), SAVE,         ALLOCATABLE, DIMENSION(:)  :: sf_trcdta   ! structure of input SST (file informations, fields read) 
    3535 
    3636   !! * Substitutions 
    37 #  include "top_substitute.h90" 
    38    !!---------------------------------------------------------------------- 
    39    !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
     37#  include "domzgr_substitute.h90" 
     38   !!---------------------------------------------------------------------- 
     39   !! NEMO/OPA 3.3 , NEMO Consortium (2010) 
    4040   !! $Id$  
    4141   !! Software governed by the CeCILL licence     (NEMOGCM/NEMO_CeCILL.txt) 
    … …  
    4343CONTAINS 
    4444 
    45    SUBROUTINE trc_dta( kt ) 
     45   SUBROUTINE trc_dta_init 
     46      !!---------------------------------------------------------------------- 
     47      !!                   ***  ROUTINE trc_dta_init  *** 
     48      !!                     
     49      !! ** Purpose :   initialisation of passive tracer input data  
     50      !!  
     51      !! ** Method  : - Read namtsd namelist 
     52      !!              - allocates passive tracer data structure  
     53      !!---------------------------------------------------------------------- 
     54      ! 
     55      INTEGER            :: jl, jn                   ! dummy loop indicies 
     56      INTEGER            :: ierr0, ierr1, ierr2, ierr3       ! temporary integers 
     57      CHARACTER(len=100) :: clndta, clntrc 
     58      REAL(wp)           :: zfact 
     59      ! 
     60      CHARACTER(len=100) :: cn_dir 
     61      TYPE(FLD_N), DIMENSION(jptra) :: slf_i     ! array of namelist informations on the fields to read 
     62      TYPE(FLD_N), DIMENSION(jptra) :: sn_trcdta 
     63      REAL(wp)   , DIMENSION(jptra) :: rn_trfac    ! multiplicative factor for tracer values 
     64      !! 
     65      NAMELIST/namtrc_dta/ sn_trcdta, cn_dir, rn_trfac  
     66      !!---------------------------------------------------------------------- 
     67      ! 
     68      !  Initialisation 
     69      ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0   
     70      ! Compute the number of tracers to be initialised with data 
     71      ALLOCATE( n_trc_index(jptra), STAT=ierr0 ) 
     72      IF( ierr0 > 0 ) THEN 
     73         CALL ctl_stop( 'trc_nam: unable to allocate n_trc_index' )   ;   RETURN 
     74      ENDIF 
     75      nb_trcdta      = 0 
     76      n_trc_index(:) = 0 
     77      DO jn = 1, jptra 
     78         IF( ln_trc_ini(jn) ) THEN 
     79             nb_trcdta       = nb_trcdta + 1  
     80             n_trc_index(jn) = nb_trcdta  
     81         ENDIF 
     82      ENDDO 
     83      ! 
     84      ntra = MAX( 1, nb_trcdta )   ! To avoid compilation error with bounds checking 
     85      WRITE(numout,*) ' ' 
     86      WRITE(numout,*) ' number of passive tracers to be initialize by data :', ntra 
     87      WRITE(numout,*) ' ' 
     88      !                         ! allocate the arrays (if necessary) 
     89      ! 
     90      cn_dir  = './'            ! directory in which the model is executed 
     91      DO jn = 1, jptra 
     92         WRITE( clndta,'("TR_",I1)' ) jn 
     93         clndta = TRIM( clndta ) 
     94         !                 !  file      ! frequency ! variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation ! 
     95         !                 !  name      !  (hours)  !  name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs    ! 
     96         sn_trcdta(jn)  = FLD_N( clndta ,   -1      , clndta    ,  .false.   , .true.  ,  'monthly'  , ''       , ''       ) 
     97         ! 
     98         rn_trfac(jn) = 1._wp 
     99      END DO 
     100      ! 
     101      REWIND( numnat )               ! read nattrc 
     102      READ  ( numnat, namtrc_dta ) 
     103 
     104      IF( lwp ) THEN 
     105         DO jn = 1, jptra 
     106            IF( ln_trc_ini(jn) )  THEN    ! open input file only if ln_trc_ini(jn) is true 
     107               clndta = TRIM( sn_trcdta(jn)%clvar )  
     108               clntrc = TRIM( ctrcnm   (jn)       )  
     109               zfact  = rn_trfac(jn) 
     110               IF( clndta /=  clntrc ) THEN  
     111                  CALL ctl_warn( 'trc_dta_init: passive tracer data initialisation :  ',   & 
     112                  &              'the variable name in the data file : '//clndta//   &  
     113                  &              '  must be the same than the name of the passive tracer : '//clntrc//' ') 
     114               ENDIF 
     115               WRITE(numout,*) ' read an initial file for passive tracer number :', jn, ' name : ', clndta, &  
     116               &               ' multiplicative factor : ', zfact 
     117            ENDIF 
     118         END DO 
     119      ENDIF 
     120      ! 
     121      IF( nb_trcdta > 0 ) THEN       !  allocate only if the number of tracer to initialise is greater than zero 
     122         ALLOCATE( sf_trcdta(nb_trcdta), rf_trfac(nb_trcdta), STAT=ierr1 ) 
     123         IF( ierr1 > 0 ) THEN 
     124            CALL ctl_stop( 'trc_dta_ini: unable to allocate  sf_trcdta structure' )   ;   RETURN 
     125         ENDIF 
     126         ! 
     127         DO jn = 1, jptra 
     128            IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file 
     129               jl = n_trc_index(jn) 
     130               slf_i(jl)    = sn_trcdta(jn) 
     131               rf_trfac(jl) = rn_trfac(jn) 
     132                                            ALLOCATE( sf_trcdta(jl)%fnow(jpi,jpj,jpk)   , STAT=ierr2 ) 
     133               IF( sn_trcdta(jn)%ln_tint )  ALLOCATE( sf_trcdta(jl)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 ) 
     134               IF( ierr2 + ierr3 > 0 ) THEN 
     135                 CALL ctl_stop( 'trc_dta : unable to allocate passive tracer data arrays' )   ;   RETURN 
     136               ENDIF 
     137            ENDIF 
     138            !    
     139         ENDDO 
     140         !                         ! fill sf_trcdta with slf_i and control print 
     141         CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta', 'Passive tracer data', 'namtrc' ) 
     142         ! 
     143      ENDIF 
     144      ! 
     145   END SUBROUTINE trc_dta_init 
     146 
     147 
     148   SUBROUTINE trc_dta( kt, ptrc ) 
    46149      !!---------------------------------------------------------------------- 
    47150      !!                   ***  ROUTINE trc_dta  *** 
     151      !!                     
     152      !! ** Purpose :   provides passive tracer data at kt 
     153      !!  
     154      !! ** Method  : - call fldread routine 
     155      !!              - s- or mixed z-s coordinate: vertical interpolation on model mesh 
     156      !!              - ln_trcdmp=F: deallocates the data structure as they are not used 
    48157      !! 
    49       !! ** Purpose :   Reads passive tracer data (Levitus monthly data) 
    50       !! 
    51       !! ** Method  :   Read on unit numtr the interpolated tracer concentra- 
    52       !!      tion onto the global grid. Data begin at january.  
    53       !!      The value is centered at the middle of month.  
    54       !!      In the opa model, kt=1 agree with january 1.  
    55       !!      At each time step, a linear interpolation is applied between  
    56       !!      two monthly values. 
    57       !!---------------------------------------------------------------------- 
    58       INTEGER, INTENT(in) ::   kt     ! ocean time-step 
    59       !! 
    60       CHARACTER (len=39) ::   clname(jptra) 
    61       INTEGER, PARAMETER ::   jpmonth = 12    ! number of months 
    62       INTEGER ::   ji, jj, jn, jl  
    63       INTEGER ::   imois, iman, i15, ik  ! temporary integers  
    64       REAL(wp) ::   zxy, zl 
    65 !!gm HERE the daymod should be used instead of computation of month and co !! 
    66 !!gm      better in case of real calandar and leap-years ! 
    67       !!---------------------------------------------------------------------- 
    68  
    69       DO jn = 1, jptra 
    70  
    71          IF( lutini(jn) ) THEN  
    72  
    73             IF ( kt == nit000 ) THEN 
    74                !! 3D tracer data 
    75                IF(lwp)WRITE(numout,*) 
    76                IF(lwp)WRITE(numout,*) ' dta_trc: reading tracer'  
    77                IF(lwp)WRITE(numout,*) ' data file ', jn, ctrcnm(jn) 
    78                IF(lwp)WRITE(numout,*) 
    79                nlectr(jn) = 0 
     158      !! ** Action  :   ptrc   passive tracer data on medl mesh and interpolated at time-step kt 
     159      !!---------------------------------------------------------------------- 
     160      INTEGER                     , INTENT(in   ) ::   kt     ! ocean time-step 
     161      REAL(wp), DIMENSION(:,:,:,:), INTENT(  out) ::   ptrc   ! passive tracer data 
     162      ! 
     163      INTEGER ::   ji, jj, jk, jl, jn, jkk, ik    ! dummy loop indicies 
     164      REAL(wp)::   zl, zi 
     165      REAL(wp), DIMENSION(jpk) ::  ztp                ! 1D workspace 
     166      CHARACTER(len=100) :: clndta 
     167      !!---------------------------------------------------------------------- 
     168      ! 
     169      IF( nb_trcdta > 0 ) THEN 
     170         ! 
     171         CALL fld_read( kt, 1, sf_trcdta )      !==   read data at kt time step   ==! 
     172         ! 
     173         DO jn = 1, ntra 
     174            ptrc(:,:,:,jn) = sf_trcdta(jn)%fnow(:,:,:)    ! NO mask 
     175         ENDDO 
     176         ! 
     177         IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==! 
     178            ! 
     179            IF( kt == nit000 .AND. lwp )THEN 
     180               WRITE(numout,*) 
     181               WRITE(numout,*) 'trc_dta: interpolates passive tracer data onto the s- or mixed s-z-coordinate mesh' 
    80182            ENDIF 
    81             ! Initialization 
    82             iman = jpmonth 
    83             i15  = nday / 16 
    84             imois = nmonth + i15 -1 
    85             IF( imois == 0 ) imois = iman 
    86  
    87  
    88             ! First call kt=nit000 
    89             ! -------------------- 
    90  
    91             IF ( kt == nit000 .AND. nlectr(jn) == 0 ) THEN 
    92                ntrc1(jn) = 0 
    93                IF(lwp) WRITE(numout,*) ' trc_dta : Levitus tracer data monthly fields' 
    94                ! open file  
    95 # if defined key_pisces 
    96                clname(jn) = 'data_1m_'//TRIM(ctrcnm(jn))//'_nomask' 
    97 # else 
    98                clname(jn) = TRIM(ctrcnm(jn)) 
    99 # endif 
    100                CALL iom_open ( clname(jn), numtr(jn) )               
    101  
    102             ENDIF 
    103  
    104 # if defined key_pisces 
    105             ! Read montly file 
    106             IF( ( kt == nit000 .AND. nlectr(jn) == 0)  .OR. imois /= ntrc1(jn) ) THEN 
    107                nlectr(jn) = 1 
    108  
    109                ! Calendar computation 
    110  
    111                ! ntrc1 number of the first file record used in the simulation 
    112                ! ntrc2 number of the last  file record 
    113  
    114                ntrc1(jn) = imois 
    115                ntrc2(jn) = ntrc1(jn) + 1 
    116                ntrc1(jn) = MOD( ntrc1(jn), iman ) 
    117                IF ( ntrc1(jn) == 0 ) ntrc1(jn) = iman 
    118                ntrc2(jn) = MOD( ntrc2(jn), iman ) 
    119                IF ( ntrc2(jn) == 0 ) ntrc2(jn) = iman 
    120                IF(lwp) WRITE(numout,*) 'first record file used ntrc1 ', ntrc1(jn)  
    121                IF(lwp) WRITE(numout,*) 'last  record file used ntrc2 ', ntrc2(jn) 
    122  
    123                ! Read montly passive tracer data Levitus  
    124  
    125                CALL iom_get ( numtr(jn), jpdom_data, ctrcnm(jn), tracdta(:,:,:,jn,1), ntrc1(jn) ) 
    126                CALL iom_get ( numtr(jn), jpdom_data, ctrcnm(jn), tracdta(:,:,:,jn,2), ntrc2(jn) ) 
    127  
    128                IF(lwp) THEN 
    129                   WRITE(numout,*) 
    130                   WRITE(numout,*) ' read tracer data ', ctrcnm(jn),' ok' 
    131                   WRITE(numout,*) 
     183            ! 
     184            DO jn = 1, ntra 
     185               DO jj = 1, jpj                         ! vertical interpolation of T & S 
     186                  DO ji = 1, jpi 
     187                     DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points 
     188                        zl = fsdept_0(ji,jj,jk) 
     189                        IF(     zl < gdept_0(1  ) ) THEN          ! above the first level of data 
     190                           ztp(jk) =  ptrc(ji,jj,1    ,jn) 
     191                        ELSEIF( zl > gdept_0(jpk) ) THEN          ! below the last level of data 
     192                           ztp(jk) =  ptrc(ji,jj,jpkm1,jn) 
     193                        ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1 
     194                           DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(jkk+1) 
     195                              IF( (zl-gdept_0(jkk)) * (zl-gdept_0(jkk+1)) <= 0._wp ) THEN 
     196                                 zi = ( zl - gdept_0(jkk) ) / (gdept_0(jkk+1)-gdept_0(jkk)) 
     197                                 ztp(jk) = ptrc(ji,jj,jkk,jn) + ( ptrc(ji,jj,jkk+1,jn) - ptrc(ji,jj,jkk,jn) ) * zi  
     198                              ENDIF 
     199                           END DO 
     200                        ENDIF 
     201                     END DO 
     202                     DO jk = 1, jpkm1 
     203                        ptrc(ji,jj,jk,jn) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord 
     204                     END DO 
     205                     ptrc(ji,jj,jpk,jn) = 0._wp 
     206                  END DO 
     207               END DO 
     208            ENDDO  
     209            !  
     210         ELSE                                !==   z- or zps- coordinate   ==! 
     211            !                              
     212            DO jn = 1, ntra 
     213               ptrc(:,:,:,jn) = ptrc(:,:,:,jn) * tmask(:,:,:)    ! Mask 
     214               ! 
     215               IF( ln_zps ) THEN                      ! zps-coordinate (partial steps) interpolation at the last ocean level 
     216                  DO jj = 1, jpj 
     217                     DO ji = 1, jpi 
     218                        ik = mbkt(ji,jj)  
     219                        IF( ik > 1 ) THEN 
     220                           zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) ) 
     221                           ptrc(ji,jj,ik,jn) = (1.-zl) * ptrc(ji,jj,ik,jn) + zl * ptrc(ji,jj,ik-1,jn) 
     222                        ENDIF 
     223                     END DO 
     224                  END DO 
    132225               ENDIF 
    133  
    134                ! Apply Mask 
    135                DO jl = 1, 2 
    136                   tracdta(:,:,:  ,jn,jl) = tracdta(:,:,:,jn,jl) * tmask(:,:,:)  
    137                   tracdta(:,:,jpk,jn,jl) = 0. 
    138                   IF( ln_zps ) THEN                ! z-coord. with partial steps 
    139                      DO jj = 1, jpj                ! interpolation of temperature at the last level 
    140                         DO ji = 1, jpi 
    141                            ik = mbkt(ji,jj) 
    142                            IF( ik > 2 ) THEN 
    143                               zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) ) 
    144                               tracdta(ji,jj,ik,jn,jl) = (1.-zl) * tracdta(ji,jj,ik  ,jn,jl)    & 
    145                                  &                    +     zl  * tracdta(ji,jj,ik-1,jn,jl) 
    146                            ENDIF 
    147                         END DO 
    148                      END DO 
    149                   ENDIF 
    150  
    151                END DO 
    152  
    153             ENDIF 
    154  
    155             IF(lwp) THEN 
    156                WRITE(numout,*) ctrcnm(jn), 'Levitus month ', ntrc1(jn), ntrc2(jn) 
     226            ENDDO  
     227            ! 
     228         ENDIF 
     229         ! 
     230         DO jn = 1, ntra 
     231            ptrc(:,:,:,jn) = ptrc(:,:,:,jn) * rf_trfac(jn)   !  multiplicative factor 
     232         ENDDO  
     233         ! 
     234         IF( lwp .AND. kt == nit000 ) THEN 
     235            DO jn = 1, ntra 
     236               clndta = TRIM( sf_trcdta(jn)%clvar )  
     237               WRITE(numout,*) ''//clndta//' data ' 
    157238               WRITE(numout,*) 
    158                WRITE(numout,*) ' Levitus month = ', ntrc1(jn), '  level = 1' 
    159                CALL prihre( tracdta(1,1,1,jn,1), jpi, jpj, 1, jpi, 20, 1   & 
    160                   &        ,jpj, 20, 1., numout ) 
    161                WRITE(numout,*) ' Levitus month = ', ntrc1(jn), '  level = ',jpk/2 
    162                CALL prihre( tracdta(1,1,jpk/2,jn,1), jpi, jpj, 1, jpi,    & 
    163                   &         20, 1, jpj, 20, 1., numout ) 
    164                WRITE(numout,*) ' Levitus month = ',ntrc1(jn),'  level = ',jpkm1 
    165                CALL prihre( tracdta(1,1,jpkm1,jn,1), jpi, jpj, 1, jpi,     & 
    166                   &         20, 1, jpj, 20, 1., numout ) 
    167             ENDIF 
    168  
    169             ! At every time step compute temperature data 
    170             zxy = FLOAT( nday + 15 - 30 * i15 ) / 30. 
    171             trdta(:,:,:,jn) =  ( 1. - zxy ) * tracdta(:,:,:,jn,1)    & 
    172                &              +       zxy   * tracdta(:,:,:,jn,2)  
    173  
    174             IF( jn == jpno3 )   trdta(:,:,:,jn) = trdta(:,:,:,jn) *   7.6e-6 
    175             IF( jn == jpdic )   trdta(:,:,:,jn) = trdta(:,:,:,jn) *   1.0e-6 
    176             IF( jn == jptal )   trdta(:,:,:,jn) = trdta(:,:,:,jn) *   1.0e-6 
    177             IF( jn == jpoxy )   trdta(:,:,:,jn) = trdta(:,:,:,jn) *  44.6e-6 
    178             IF( jn == jpsil )   trdta(:,:,:,jn) = trdta(:,:,:,jn) *   1.0e-6 
    179             IF( jn == jppo4 )   trdta(:,:,:,jn) = trdta(:,:,:,jn) * 122.0e-6 
    180  
    181             ! Close the file 
    182             ! -------------- 
    183              
    184             IF( kt == nitend )   CALL iom_close( numtr(jn) ) 
    185  
    186 # else 
    187             ! Read init file only 
    188             IF( kt == nit000  ) THEN 
    189                ntrc1(jn) = 1 
    190                CALL iom_get ( numtr(jn), jpdom_data, ctrcnm(jn), trdta(:,:,:,jn), ntrc1(jn) ) 
    191                trdta(:,:,:,jn) = trdta(:,:,:,jn) * tmask(:,:,:) 
    192                CALL iom_close ( numtr(jn) ) 
    193             ENDIF  
    194 # endif 
    195          ENDIF 
    196  
    197       END DO 
    198       ! 
     239               WRITE(numout,*)'  level = 1' 
     240               CALL prihre( ptrc(:,:,1    ,jn), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
     241               WRITE(numout,*)'  level = ', jpk/2 
     242               CALL prihre( ptrc(:,:,jpk/2,jn), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
     243               WRITE(numout,*)'  level = ', jpkm1 
     244               CALL prihre( ptrc(:,:,jpkm1,jn), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
     245               WRITE(numout,*) 
     246            ENDDO 
     247         ENDIF 
     248         ! 
     249         IF( .NOT.ln_trcdmp ) THEN                   !==   deallocate data structure   ==!  
     250            !                                              (data used only for initialisation) 
     251            IF(lwp) WRITE(numout,*) 'trc_dta: deallocate data arrays as they are only use to initialize the run' 
     252            DO jn = 1, ntra 
     253                                             DEALLOCATE( sf_trcdta(jn)%fnow )     !  arrays in the structure 
     254               IF( sf_trcdta(jn)%ln_tint )   DEALLOCATE( sf_trcdta(jn)%fdta ) 
     255            ENDDO 
     256            ! 
     257         ENDIF 
     258         ! 
     259      ENDIF 
     260      !  
    199261   END SUBROUTINE trc_dta 
    200  
    201  
    202    INTEGER FUNCTION trc_dta_alloc() 
    203       !!---------------------------------------------------------------------- 
    204       !!                   ***  ROUTINE trc_dta_alloc  *** 
    205       !!---------------------------------------------------------------------- 
    206       ALLOCATE( trdta  (jpi,jpj,jpk,jptra  ) ,                    & 
    207          &      tracdta(jpi,jpj,jpk,jptra,2) ,                    & 
    208          &      nlectr(jptra) , ntrc1(jptra) , ntrc2(jptra) , STAT=trc_dta_alloc) 
    209          ! 
    210       IF( trc_dta_alloc /= 0 )   CALL ctl_warn('trc_dta_alloc : failed to allocate arrays') 
    211       ! 
    212    END FUNCTION trc_dta_alloc 
    213  
    214262#else 
    215263   !!---------------------------------------------------------------------- 
    216264   !!   Dummy module                              NO 3D passive tracer data 
    217265   !!---------------------------------------------------------------------- 
    218    LOGICAL , PUBLIC, PARAMETER ::   lk_dtatrc = .FALSE.   !: temperature data flag 
    219266CONTAINS 
    220267   SUBROUTINE trc_dta( kt )        ! Empty routine 
    … …  
    222269   END SUBROUTINE trc_dta 
    223270#endif 
    224  
    225271   !!====================================================================== 
    226272END MODULE trcdta 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/trcini.F90

    r2715 r2977  
    1616   !!   top_alloc :   allocate the TOP arrays 
    1717   !!---------------------------------------------------------------------- 
    18    USE oce_trc 
    19    USE trc 
    20    USE trcrst 
     18   USE oce_trc         ! shared variables between ocean and passive tracers 
     19   USE trc             ! passive tracers common variables 
     20   USE trcrst          ! passive tracers restart 
    2121   USE trcnam          ! Namelist read 
    2222   USE trcini_cfc      ! CFC      initialisation 
    … …  
    2525   USE trcini_c14b     ! C14 bomb initialisation 
    2626   USE trcini_my_trc   ! MY_TRC   initialisation 
    27    USE trcdta    
    28    USE daymod 
     27   USE trcdta          ! initialisation form files 
     28   USE daymod          ! calendar manager 
    2929   USE zpshde          ! partial step: hor. derivative   (zps_hde routine) 
    3030   USE prtctl_trc      ! Print control passive tracers (prt_ctl_trc_init routine) 
    … …  
    5656      !!                or read data or analytical formulation 
    5757      !!--------------------------------------------------------------------- 
    58       INTEGER ::   jk, jn    ! dummy loop indices 
     58      INTEGER ::   jk, jn, jl    ! dummy loop indices 
     59      INTEGER ::   ierr          ! local integer 
    5960      CHARACTER (len=25) :: charout 
     61      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:,:) ::  ztrcdta   ! 4D  workspace 
    6062      !!--------------------------------------------------------------------- 
    6163 
    … …  
    6668      CALL top_alloc()              ! allocate TOP arrays 
    6769 
    68       !                             ! masked grid volume 
    69       DO jk = 1, jpk 
    70          cvol(:,:,jk) = e1t(:,:) * e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk)  
    71       END DO 
    72  
    73       !                             ! total volume of the ocean 
    74 #if ! defined key_degrad 
    75       areatot = glob_sum( cvol(:,:,:) ) 
    76 #else 
    77       areatot = glob_sum( cvol(:,:,:) * facvol(:,:,:) )  ! degrad option: reduction by facvol 
    78 #endif 
     70      IF( ln_dm2dc .AND. ( lk_pisces .OR. lk_lobster ) )    & 
     71         &  CALL ctl_stop( ' The diurnal cycle is not compatible with PISCES or LOBSTER  ' ) 
     72 
     73      IF( nn_cla == 1 )   & 
     74         &  CALL ctl_stop( ' Cross Land Advection not yet implemented with passive tracer ; nn_cla must be 0' ) 
    7975 
    8076      CALL trc_nam                  ! read passive tracers namelists 
    81  
    82       !                             ! restart for passive tracer (input) 
    83       IF( ln_rsttr ) THEN 
    84          IF(lwp) WRITE(numout,*) '       read a restart file for passive tracer : ', cn_trcrst_in 
    85          IF(lwp) WRITE(numout,*) ' ' 
    86       ELSE 
    87          IF( lwp .AND. lk_dtatrc ) THEN 
    88             DO jn = 1, jptra 
    89                IF( lutini(jn) )  &                  ! open input FILE only IF lutini(jn) is true 
    90                   &  WRITE(numout,*) ' read an initial file for passive tracer number :', jn, ' traceur : ', ctrcnm(jn)  
    91              END DO 
    92           ENDIF 
    93           IF( lwp ) WRITE(numout,*) 
    94       ENDIF 
    95  
    96       IF( ln_dm2dc .AND. ( lk_pisces .OR. lk_lobster ) )    & 
    97          &       CALL ctl_stop( ' The diurnal cycle is not compatible with PISCES or LOBSTER  ' ) 
    98  
    99       IF( nn_cla == 1 )   & 
    100          &       CALL ctl_stop( ' Cross Land Advection not yet implemented with passive tracer ; nn_cla must be 0' ) 
    10177 
    10278      IF( lk_lobster ) THEN   ;   CALL trc_ini_lobster      ! LOBSTER bio-model 
    … …  
    11995      ELSE                    ;   IF(lwp) WRITE(numout,*) '          MY_TRC not used' 
    12096      ENDIF 
     97 
     98      IF( ln_trcdta )             CALL trc_dta_init 
    12199 
    122100      IF( ln_rsttr ) THEN 
    … …  
    130108           CALL day_init               ! set calendar 
    131109        ENDIF 
    132 #if defined key_dtatrc 
    133         CALL trc_dta( nit000 )      ! Initialization of tracer from a file that may also be used for damping 
    134         DO jn = 1, jptra 
    135            IF( lutini(jn) )   trn(:,:,:,jn) = trdta(:,:,:,jn) * tmask(:,:,:)   ! initialisation from file if required 
    136         END DO 
    137 #endif 
     110        IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN  ! Initialisation of tracer from a file that may also be used for damping 
     111            ALLOCATE( ztrcdta(jpi,jpj,jpk,nb_trcdta), STAT=ierr ) 
     112            IF( ierr > 0 ) THEN 
     113               CALL ctl_stop( 'trc_ini: unable to allocate ztrcdta array' )   ;   RETURN 
     114            ENDIF 
     115            ! 
     116            CALL trc_dta( nit000, ztrcdta )   ! read tracer data at nit000 
     117            ! 
     118            DO jn = 1, jptra 
     119               IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file 
     120                  jl = n_trc_index(jn)  
     121                  trn(:,:,:,jn) = ztrcdta(:,:,:,jl) * tmask(:,:,:)   
     122               ENDIF 
     123            ENDDO 
     124            DEALLOCATE( ztrcdta )  
     125        ENDIF 
     126        ! 
    138127        trb(:,:,:,:) = trn(:,:,:,:) 
    139128        !  
    … …  
    145134        &    CALL zps_hde( nit000, jptra, trn, gtru, gtrv )       ! tracers at the bottom ocean level 
    146135 
    147  
    148       !            
    149       trai = 0._wp         ! Computation content of all tracers 
     136      !                                                              ! masked grid volume 
     137      DO jk = 1, jpk 
     138         cvol(:,:,jk) = e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk) 
     139      END DO 
     140      IF( lk_degrad ) cvol(:,:,:) = cvol(:,:,:) * facvol(:,:,:)      ! degrad option: reduction by facvol 
     141      !                                                              ! total volume of the ocean  
     142      areatot = glob_sum( cvol(:,:,:) ) 
     143 
     144      trai(:) = 0._wp                                                   ! initial content of all tracers 
    150145      DO jn = 1, jptra 
    151 #if ! defined key_degrad 
    152          trai = trai + glob_sum( trn(:,:,:,jn) * cvol(:,:,:) ) 
    153 #else 
    154          trai = trai + glob_sum( trn(:,:,:,jn) * cvol(:,:,:) * facvol(:,:,:) ) ! degrad option: reduction by facvol 
    155 #endif 
    156       END DO       
     146         trai(jn) = trai(jn) + glob_sum( trn(:,:,:,jn) * cvol(:,:,:)   ) 
     147      END DO 
    157148 
    158149      IF(lwp) THEN               ! control print 
    … …  
    161152         WRITE(numout,*) '          *** Total number of passive tracer jptra = ', jptra 
    162153         WRITE(numout,*) '          *** Total volume of ocean                = ', areatot 
    163          WRITE(numout,*) '          *** Total inital content of all tracers  = ', trai 
     154         WRITE(numout,*) '          *** Total inital content of all tracers ' 
     155         DO jn = 1, jptra 
     156            WRITE(numout,*) ' tracer nb : ', jn, '  name : ', ctrcnm(jn), ' initial content :', trai(jn) 
     157         ENDDO 
    164158         WRITE(numout,*) 
    165159      ENDIF 
    … …  
    186180      USE trczdf        , ONLY:   trc_zdf_alloc 
    187181      USE trdmod_trc_oce, ONLY:   trd_mod_trc_oce_alloc 
    188 #if ! defined key_iomput 
    189       USE trcdia        , ONLY:   trc_dia_alloc 
    190 #endif 
    191 #if defined key_trcdmp  
    192       USE trcdmp        , ONLY:   trc_dmp_alloc 
    193 #endif 
    194 #if defined key_dtatrc 
    195       USE trcdta        , ONLY:   trc_dta_alloc 
    196 #endif 
    197 #if defined key_trdmld_trc   ||   defined key_esopa 
     182#if defined key_trdmld_trc  
    198183      USE trdmld_trc    , ONLY:   trd_mld_trc_alloc 
    199184#endif 
    … …  
    207192      ierr = ierr + trc_zdf_alloc() 
    208193      ierr = ierr + trd_mod_trc_oce_alloc() 
    209 #if ! defined key_iomput 
    210       ierr = ierr + trc_dia_alloc() 
    211 #endif 
    212 #if defined key_trcdmp  
    213       ierr = ierr + trc_dmp_alloc() 
    214 #endif 
    215 #if defined key_dtatrc 
    216       ierr = ierr + trc_dta_alloc() 
    217 #endif 
    218 #if defined key_trdmld_trc   ||   defined key_esopa 
     194#if defined key_trdmld_trc  
    219195      ierr = ierr + trd_mld_trc_alloc() 
    220196#endif 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/trcnam.F90

    r2715 r2977  
    1818   !!   trc_nam    :  Read and print options for the passive tracer run (namelist) 
    1919   !!---------------------------------------------------------------------- 
    20    USE oce_trc 
    21    USE trc 
     20   USE oce_trc           ! shared variables between ocean and passive tracers 
     21   USE trc               ! passive tracers common variables 
    2222   USE trcnam_trp        ! Transport namelist 
    2323   USE trcnam_lobster    ! LOBSTER namelist 
    … …  
    2626   USE trcnam_c14b       ! C14 SMS namelist 
    2727   USE trcnam_my_trc     ! MY_TRC SMS namelist 
     28   USE trdmod_oce        
    2829   USE trdmod_trc_oce 
     30   USE iom               ! I/O manager 
    2931 
    3032   IMPLICIT NONE 
    … …  
    5355      !!                ( (LOBSTER, PISCES, CFC, MY_TRC ) 
    5456      !!--------------------------------------------------------------------- 
    55       INTEGER ::  jn 
    56  
     57      INTEGER ::  jn, ierr 
    5758      ! Definition of a tracer as a structure 
    58       TYPE PTRACER 
    59          CHARACTER(len = 20)  :: clsname  !: short name 
    60          CHARACTER(len = 80 ) :: cllname  !: long name 
    61          CHARACTER(len = 20 ) :: clunit   !: unit 
    62          LOGICAL              :: llinit   !: read in a file or not 
    63          LOGICAL              :: llsave   !: save the tracer or not 
    64       END TYPE PTRACER 
    65  
    66       TYPE(PTRACER) , DIMENSION(jptra) :: sn_tracer 
    67  
     59      TYPE(PTRACER), DIMENSION(jptra) :: sn_tracer  ! type of tracer for saving if not key_iomput 
    6860      !! 
    69       NAMELIST/namtrc/    nn_dttrc, nn_writetrc, ln_rsttr, nn_rsttr, & 
    70                           cn_trcrst_in, cn_trcrst_out, sn_tracer 
     61      NAMELIST/namtrc/ nn_dttrc, nn_writetrc, ln_rsttr, nn_rsttr, & 
     62         &             cn_trcrst_in, cn_trcrst_out, sn_tracer, ln_trcdta 
    7163#if defined key_trdmld_trc  || defined key_trdtrc 
    7264      NAMELIST/namtrc_trd/ nn_trd_trc, nn_ctls_trc, rn_ucf_trc, & 
    73                          ln_trdmld_trc_restart, ln_trdmld_trc_instant, & 
    74                          cn_trdrst_trc_in, cn_trdrst_trc_out, ln_trdtrc 
     65         &                ln_trdmld_trc_restart, ln_trdmld_trc_instant, & 
     66         &                cn_trdrst_trc_in, cn_trdrst_trc_out, ln_trdtrc 
    7567#endif 
     68      NAMELIST/namtrc_dia/ ln_diatrc, ln_diabio, nn_writedia, nn_writebio 
    7669 
    7770      !!--------------------------------------------------------------------- 
    … …  
    8477      ! Namelist nattrc (files) 
    8578      ! ---------------------------------------------- 
    86       nn_dttrc    = 1                 ! default values 
    87       nn_writetrc = 10       
    88       ln_rsttr    = .FALSE. 
    89       nn_rsttr    =  0 
     79      nn_dttrc      = 1                 ! default values 
     80      nn_writetrc   = 10  
     81      ln_rsttr      = .FALSE. 
     82      nn_rsttr      =  0 
    9083      cn_trcrst_in  = 'restart_trc' 
    9184      cn_trcrst_out = 'restart_trc' 
     85      ! 
    9286      DO jn = 1, jptra 
    93          WRITE(ctrcnm(jn),'("TR_",I1)'           ) jn 
    94          WRITE(ctrcnl(jn),'("TRACER NUMBER ",I1)') jn 
    95          ctrcun(jn) = 'mmole/m3' 
    96          lutini(jn) = .FALSE.  
    97          lutsav(jn) = .TRUE.  
     87         WRITE( sn_tracer(jn)%clsname,'("TR_",I1)'           ) jn 
     88         WRITE( sn_tracer(jn)%cllname,'("TRACER NUMBER ",I1)') jn 
     89         sn_tracer(jn)%clunit = 'mmole/m3' 
     90         sn_tracer(jn)%llinit  = .FALSE. 
     91         sn_tracer(jn)%llsave  = .TRUE. 
    9892      END DO 
     93      ln_trcdta = .FALSE. 
     94 
    9995 
    10096      REWIND( numnat )               ! read nattrc 
    … …  
    10298 
    10399      DO jn = 1, jptra 
    104          ctrcnm(jn) = TRIM( sn_tracer(jn)%clsname ) 
    105          ctrcnl(jn) = TRIM( sn_tracer(jn)%cllname ) 
    106          ctrcun(jn) = TRIM( sn_tracer(jn)%clunit  ) 
    107          lutini(jn) =       sn_tracer(jn)%llinit  
    108          lutsav(jn) =       sn_tracer(jn)%llsave 
     100         ctrcnm    (jn) = TRIM( sn_tracer(jn)%clsname ) 
     101         ctrcln    (jn) = TRIM( sn_tracer(jn)%cllname ) 
     102         ctrcun    (jn) = TRIM( sn_tracer(jn)%clunit  ) 
     103         ln_trc_ini(jn) =       sn_tracer(jn)%llinit 
     104         ln_trc_wri(jn) =       sn_tracer(jn)%llsave 
    109105      END DO 
    110106 
    … …  
    113109         WRITE(numout,*) 
    114110         WRITE(numout,*) ' Namelist : namtrc' 
    115          WRITE(numout,*) '    time step freq. for pass. trac. nn_dttrc             = ', nn_dttrc 
    116          WRITE(numout,*) '    frequency of outputs for passive tracers nn_writetrc = ', nn_writetrc   
    117          WRITE(numout,*) '    restart LOGICAL for passive tr. ln_rsttr             = ', ln_rsttr 
    118          WRITE(numout,*) '    control of time step for p. tr. nn_rsttr             = ', nn_rsttr 
     111         WRITE(numout,*) '   time step freq. for passive tracer           nn_dttrc      = ', nn_dttrc 
     112         WRITE(numout,*) '   restart  for passive tracer                  ln_rsttr      = ', ln_rsttr 
     113         WRITE(numout,*) '   control of time step for passive tracer      nn_rsttr      = ', nn_rsttr 
     114         WRITE(numout,*) '   Read inputs data from file                   ln_trcdta     = ', ln_trcdta 
    119115         WRITE(numout,*) ' ' 
    120116         DO jn = 1, jptra 
    121             WRITE(numout,*) '   tracer nb             : ', jn  
    122             WRITE(numout,*) '   short name            : ', ctrcnm(jn) 
    123             WRITE(numout,*) '   long name             : ', ctrcnl(jn) 
    124             WRITE(numout,*) '   unit                  : ', ctrcun(jn) 
    125             WRITE(numout,*) '   initial value in FILE : ', lutini(jn)  
    126             WRITE(numout,*) ' ' 
     117            WRITE(numout,*) '  tracer nb : ', jn, '    short name : ', ctrcnm(jn) 
    127118         END DO 
     119         WRITE(numout,*) ' ' 
    128120      ENDIF 
    129121 
    130122      rdttrc(:) = rdttra(:) * FLOAT( nn_dttrc )   ! vertical profile of passive tracer time-step 
    131123   
    132       IF(lwp) WRITE(numout,*)  
    133       IF(lwp) WRITE(numout,*) '    Passive Tracer  time step    rdttrc  = ', rdttrc(1) 
    134       IF(lwp) WRITE(numout,*)  
    135  
    136 #if defined key_trdmld_trc || defined key_trdtrc 
    137       nn_trd_trc  = 20 
    138       nn_ctls_trc =  9 
    139       rn_ucf_trc   =  1. 
    140       ln_trdmld_trc_instant = .TRUE. 
    141       ln_trdmld_trc_restart =.FALSE. 
    142       cn_trdrst_trc_in  = "restart_mld_trc" 
    143       cn_trdrst_trc_out = "restart_mld_trc" 
    144       ln_trdtrc(:) = .FALSE. 
     124      IF(lwp) THEN                   ! control print 
     125        WRITE(numout,*)  
     126        WRITE(numout,*) '    Passive Tracer  time step    rdttrc  = ', rdttrc(1) 
     127        WRITE(numout,*)  
     128      ENDIF 
     129 
     130      ln_diatrc = .FALSE. 
     131      ln_diabio = .FALSE. 
     132      nn_writedia = 10 
     133      nn_writebio = 10 
    145134 
    146135      REWIND( numnat )               !  namelist namtoptrd : passive tracer trends diagnostic 
    147       READ  ( numnat, namtrc_trd ) 
    148  
    149      IF(lwp) THEN 
     136      READ  ( numnat, namtrc_dia ) 
     137 
     138      IF(lwp) THEN 
    150139         WRITE(numout,*) 
    151          WRITE(numout,*) ' trd_mld_trc_init : read namelist namtrc_trd                    ' 
    152          WRITE(numout,*) ' ~~~~~~~~~~~~~~~~                                               ' 
    153          WRITE(numout,*) '   * frequency of trends diagnostics   nn_trd_trc             = ', nn_trd_trc 
    154          WRITE(numout,*) '   * control surface type              nn_ctls_trc            = ', nn_ctls_trc 
    155          WRITE(numout,*) '   * restart for ML diagnostics        ln_trdmld_trc_restart  = ', ln_trdmld_trc_restart 
    156          WRITE(numout,*) '   * flag to diagnose trends of                                 ' 
    157          WRITE(numout,*) '     instantantaneous or mean ML T/S   ln_trdmld_trc_instant  = ', ln_trdmld_trc_instant 
    158          WRITE(numout,*) '   * unit conversion factor            rn_ucf_trc             = ', rn_ucf_trc 
    159          DO jn = 1, jptra 
    160             IF( ln_trdtrc(jn) ) WRITE(numout,*) '    compute ML trends for tracer number :', jn 
    161          END DO 
    162       ENDIF 
    163 #endif 
     140         WRITE(numout,*) 
     141         WRITE(numout,*) ' Namelist : namtrc_dia' 
     142         WRITE(numout,*) '    save additionnal diagnostics arrays         ln_diatrc   = ', ln_diatrc 
     143         WRITE(numout,*) '    save additionnal biology diagnostics arrays ln_diabio   = ', ln_diabio 
     144         WRITE(numout,*) '    frequency of outputs for additional arrays  nn_writedia = ', nn_writedia 
     145         WRITE(numout,*) '    frequency of outputs for biological trends  nn_writebio = ', nn_writebio 
     146         WRITE(numout,*) ' ' 
     147      ENDIF 
     148 
     149      IF( ln_diatrc .AND. .NOT. lk_iomput ) THEN  
     150         ALLOCATE( trc2d(jpi,jpj,jpdia2d), trc3d(jpi,jpj,jpk,jpdia3d),  & 
     151           &       ctrc2d(jpdia2d), ctrc2l(jpdia2d), ctrc2u(jpdia2d) ,  &  
     152           &       ctrc3d(jpdia3d), ctrc3l(jpdia3d), ctrc3u(jpdia3d) ,  STAT = ierr )  
     153         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'trcnam: unable to allocate add. diag. array' ) 
     154      ENDIF 
     155 
     156      IF( ( ln_diabio .AND. .NOT. lk_iomput ) .OR. l_trdtrc ) THEN 
     157         ALLOCATE( trbio (jpi,jpj,jpk,jpdiabio) , & 
     158           &       ctrbio(jpdiabio), ctrbil(jpdiabio), ctrbiu(jpdiabio), STAT = ierr )  
     159         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'trcnam: unable to allocate bio. diag. array' ) 
     160      ENDIF 
    164161 
    165162      ! namelist of transport 
    166163      ! --------------------- 
    167164      CALL trc_nam_trp 
     165 
     166 
     167      IF( ln_trcdmp .AND. .NOT.ln_trcdta ) THEN 
     168         CALL ctl_warn( 'trc_nam: passive tracer damping requires data from files we set ln_trcdta to TRUE' ) 
     169         ln_trcdta = .TRUE. 
     170      ENDIF 
     171      ! 
     172      IF( ln_rsttr .AND. .NOT.ln_trcdmp .AND. ln_trcdta ) THEN 
     173          CALL ctl_warn( 'trc_nam: passive tracer restart and  data intialisation, ',   & 
     174             &           'we keep the restart values and set ln_trcdta to FALSE' ) 
     175         ln_trcdta = .FALSE. 
     176      ENDIF 
     177      ! 
     178      IF( .NOT.ln_trcdta ) THEN 
     179         ln_trc_ini(:) = .FALSE. 
     180      ENDIF 
     181 
     182      IF(lwp) THEN                   ! control print 
     183         IF( ln_rsttr ) THEN 
     184            WRITE(numout,*) 
     185            WRITE(numout,*) '    read a restart file for passive tracer : ', TRIM( cn_trcrst_in ) 
     186            WRITE(numout,*) 
     187         ELSE 
     188            IF( .NOT.ln_trcdta ) THEN 
     189                WRITE(numout,*) 
     190                WRITE(numout,*) '  All the passive tracers are initialised with constant values ' 
     191                WRITE(numout,*) 
     192            ENDIF 
     193         ENDIF 
     194      ENDIF 
     195 
     196 
     197#if defined key_trdmld_trc || defined key_trdtrc 
     198         nn_trd_trc  = 20 
     199         nn_ctls_trc =  9 
     200         rn_ucf_trc   =  1. 
     201         ln_trdmld_trc_instant = .TRUE. 
     202         ln_trdmld_trc_restart =.FALSE. 
     203         cn_trdrst_trc_in  = "restart_mld_trc" 
     204         cn_trdrst_trc_out = "restart_mld_trc" 
     205         ln_trdtrc(:) = .FALSE. 
     206 
     207         REWIND( numnat )               !  namelist namtoptrd : passive tracer trends diagnostic 
     208         READ  ( numnat, namtrc_trd ) 
     209 
     210         IF(lwp) THEN 
     211            WRITE(numout,*) 
     212            WRITE(numout,*) ' trd_mld_trc_init : read namelist namtrc_trd                    ' 
     213            WRITE(numout,*) ' ~~~~~~~~~~~~~~~~                                               ' 
     214            WRITE(numout,*) '   * frequency of trends diagnostics   nn_trd_trc             = ', nn_trd_trc 
     215            WRITE(numout,*) '   * control surface type              nn_ctls_trc            = ', nn_ctls_trc 
     216            WRITE(numout,*) '   * restart for ML diagnostics        ln_trdmld_trc_restart  = ', ln_trdmld_trc_restart 
     217            WRITE(numout,*) '   * flag to diagnose trends of                                 ' 
     218            WRITE(numout,*) '     instantantaneous or mean ML T/S   ln_trdmld_trc_instant  = ', ln_trdmld_trc_instant 
     219            WRITE(numout,*) '   * unit conversion factor            rn_ucf_trc             = ', rn_ucf_trc 
     220            DO jn = 1, jptra 
     221               IF( ln_trdtrc(jn) ) WRITE(numout,*) '    compute ML trends for tracer number :', jn 
     222            END DO 
     223         ENDIF 
     224#endif 
    168225 
    169226 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/trcrst.F90

    r2715 r2977  
    230230         ENDIF 
    231231         ! Control of date  
    232          IF( nit000  - NINT( zkt ) /= 1 .AND.  nn_rsttr /= 0 )                                  & 
     232         IF( nit000  - NINT( zkt ) /= nn_dttrc .AND.  nn_rsttr /= 0 )                                  & 
    233233            &   CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart',                 & 
    234234            &                  ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' ) 
    … …  
    283283      !! ** purpose  :   Compute tracers statistics 
    284284      !!---------------------------------------------------------------------- 
    285  
    286       INTEGER  :: jn 
    287       REAL(wp) :: zdiag_var, zdiag_varmin, zdiag_varmax, zdiag_tot 
    288       REAL(wp) :: zder 
    289       !!---------------------------------------------------------------------- 
    290  
     285      INTEGER  :: jk, jn 
     286      REAL(wp) :: ztraf, zmin, zmax, zmean, zdrift 
     287      !!---------------------------------------------------------------------- 
    291288 
    292289      IF( lwp ) THEN 
    … …  
    295292         WRITE(numout,*)  
    296293      ENDIF 
    297        
    298       zdiag_tot = 0.e0 
    299       DO jn = 1, jptra 
    300 #  if defined key_degrad 
    301          zdiag_var = glob_sum( trn(:,:,:,jn) * cvol(:,:,:) * facvol(:,:,:) ) 
    302 #  else 
    303          zdiag_var = glob_sum( trn(:,:,:,jn) * cvol(:,:,:)  ) 
    304 #  endif 
     294      ! 
     295      DO jn = 1, jptra 
     296         zdiag_var    = glob_sum( trn(:,:,:,jn) * cvol(:,:,:)   ) 
    305297         zdiag_varmin = MINVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) ) 
    306298         zdiag_varmax = MAXVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) ) 
    307299         IF( lk_mpp ) THEN 
    308             CALL mpp_min( zdiag_varmin )      ! min over the global domain 
    309             CALL mpp_max( zdiag_varmax )      ! max over the global domain 
     300            CALL mpp_min( zmin )      ! min over the global domain 
     301            CALL mpp_max( zmax )      ! max over the global domain 
    310302         END IF 
    311          zdiag_tot = zdiag_tot + zdiag_var 
    312          zdiag_var = zdiag_var / areatot 
    313          IF(lwp) WRITE(numout,*) '   MEAN NO ', jn, ctrcnm(jn), ' = ', zdiag_var,   & 
    314             &                    ' MIN = ', zdiag_varmin, ' MAX = ', zdiag_varmax 
    315       END DO 
    316        
    317       zder = ( ( zdiag_tot - trai ) / ( trai + 1.e-12 )  ) * 100._wp 
    318       IF(lwp) WRITE(numout,*) '   Integral of all tracers over the full domain  = ', zdiag_tot 
    319       IF(lwp) WRITE(numout,*) '   Drift of the sum of all tracers =', zder, ' %' 
     303         zmean  = ztraf / areatot 
     304         zdrift = ( ( ztraf - trai(jn) ) / ( trai(jn) + 1.e-12 )  ) * 100._wp 
     305         IF(lwp) WRITE(numout,*) ' tracer nb : ', jn,'   ', TRIM( ctrcnm(jn) ) , & 
     306            &    ' mean = ', zmean, ' min = ', zmin, ' max = ', zmax, ' drift = ', zdrift, ' %' 
     307      END DO 
     308      WRITE(numout,*)  
    320309       
    321310   END SUBROUTINE trc_rst_stat 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/trcsms.F90

    r2715 r2977  
    4747      !!--------------------------------------------------------------------- 
    4848 
    49       IF ( MOD( kt, nn_dttrc) /= 0 ) RETURN      ! this ROUTINE is called only every ndttrc time step 
    50  
    5149      IF( lk_lobster )   CALL trc_sms_lobster( kt )    ! main program of LOBSTER 
    5250      IF( lk_pisces  )   CALL trc_sms_pisces ( kt )    ! main program of PISCES  

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/trcstp.F90

    r2528 r2977  
    2727 
    2828   PUBLIC   trc_stp    ! called by step 
    29     
     29 
     30   !! * Substitutions 
     31#  include "domzgr_substitute.h90" 
    3032   !!---------------------------------------------------------------------- 
    3133   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    4648      !!------------------------------------------------------------------- 
    4749      INTEGER, INTENT( in ) ::  kt  ! ocean time-step index 
     50      INTEGER               ::  jk  ! 
    4851      CHARACTER (len=25)    ::  charout 
    4952      !!------------------------------------------------------------------- 
     53      ! 
     54      IF( kt == nit000 ) THEN 
     55                               CALL iom_close( numrtr )     ! close input  passive tracers restart file 
     56         IF( lk_trdmld_trc  )  CALL trd_mld_trc_init        ! trends: Mixed-layer 
     57      ENDIF 
     58      ! 
     59      IF( lk_vvl ) THEN                              ! update ocean volume due to ssh temporal evolution 
     60         DO jk = 1, jpk 
     61            cvol(:,:,jk) = e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk) 
     62         END DO 
     63         IF( lk_degrad )  cvol(:,:,:) = cvol(:,:,:) * facvol(:,:,:)      ! degrad option: reduction by facvol 
     64         areatot     = glob_sum( cvol(:,:,:) ) 
     65      ENDIF 
     66      !     
    5067 
     68      IF( kt == nit000 ) THEN 
     69                               CALL iom_close( numrtr )     ! close input  passive tracers restart file 
     70         IF( lk_trdmld_trc  )  CALL trd_mld_trc_init        ! trends: Mixed-layer 
     71      ENDIF 
     72      ! 
    5173      IF( MOD( kt - 1 , nn_dttrc ) == 0 ) THEN      ! only every nn_dttrc time step 
    5274         ! 
    … …  
    5880         tra(:,:,:,:) = 0.e0 
    5981         ! 
    60          IF( kt == nit000 .AND. lk_trdmld_trc  )  & 
    61             &                      CALL trd_mld_trc_init        ! trends: Mixed-layer 
    6282                                   CALL trc_rst_opn( kt )       ! Open tracer restart file  
    63          IF( lk_iomput ) THEN  ;   CALL trc_wri( kt )           ! output of passive tracers 
    64          ELSE                  ;   CALL trc_dia( kt ) 
     83         IF( lk_iomput ) THEN  ;   CALL trc_wri    ( kt )       ! output of passive tracers with iom I/O manager 
     84         ELSE                  ;   CALL trc_dia    ( kt )       ! output of passive tracers with old I/O manager 
    6585         ENDIF 
    66                                    CALL trc_sms( kt )           ! tracers: sink and source 
     86                                   CALL trc_sms( kt )           ! tracers: sinks and sources 
    6787                                   CALL trc_trp( kt )           ! transport of passive tracers 
    68          IF( kt == nit000 )     CALL iom_close( numrtr )     ! close input  passive tracers restart file 
    6988         IF( lrst_trc )            CALL trc_rst_wri( kt )       ! write tracer restart file 
    7089         IF( lk_trdmld_trc  )      CALL trd_mld_trc( kt )       ! trends: Mixed-layer 

  • branches/2011/dev_LOCEAN_2011/NEMOGCM/NEMO/TOP_SRC/trcwri.F90

    r2567 r2977  
    11MODULE trcwri 
    2    !!=================================================================================== 
     2   !!====================================================================== 
    33   !!                       *** MODULE trcwri *** 
    44   !!    TOP :   Output of passive tracers 
    5    !!==================================================================================== 
     5   !!====================================================================== 
    66   !! History :   1.0  !  2009-05 (C. Ethe)  Original code 
    77   !!---------------------------------------------------------------------- 
    8 #if defined key_top &&  defined key_iomput 
     8#if defined key_top && defined key_iomput 
    99   !!---------------------------------------------------------------------- 
    10    !!   'key_top' && 'key_iomput'                              TOP models 
     10   !!   'key_top'                                           TOP models 
    1111   !!---------------------------------------------------------------------- 
    1212   !! trc_wri_trc   :  outputs of concentration fields 
    1313   !!---------------------------------------------------------------------- 
    14    USE dom_oce         ! ocean space and time domain variables 
    15    USE oce_trc 
    16    USE trc 
    17    USE iom 
    18    USE dianam 
     14   USE dom_oce     ! ocean space and time domain variables 
     15   USE oce_trc     ! shared variables between ocean and passive tracers 
     16   USE trc         ! passive tracers common variables  
     17   USE iom         ! I/O manager 
     18   USE dianam      ! Output file name 
    1919 
    2020   IMPLICIT NONE 
    … …  
    5050      !! ** Purpose :   output passive tracers fields  
    5151      !!--------------------------------------------------------------------- 
    52       INTEGER, INTENT( in ) :: kt       ! ocean time-step 
    53       INTEGER               :: jn 
    54       CHARACTER (len=20)    :: cltra 
    55       CHARACTER (len=40) :: clhstnam 
     52      INTEGER, INTENT( in )     :: kt       ! ocean time-step 
     53      INTEGER                   :: jn 
     54      CHARACTER (len=20)        :: cltra 
     55      CHARACTER (len=40)        :: clhstnam 
    5656      INTEGER ::   inum = 11            ! temporary logical unit 
    5757      !!--------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.