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

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

Merge of 3.4beta into the trunk

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

Legend:

Unmodified
Added
Removed

  • trunk/NEMOGCM/NEMO/TOP_SRC/C14b/trcini_c14b.F90

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

  • trunk/NEMOGCM/NEMO/TOP_SRC/C14b/trcnam_c14b.F90

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

  • trunk/NEMOGCM/NEMO/TOP_SRC/C14b/trcsms_c14b.F90

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

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

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

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

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

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

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

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

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

  • trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/par_lobster.F90

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

  • trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcbio.F90

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

  • trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcexp.F90

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

  • trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcini_lobster.F90

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

  • trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcnam_lobster.F90

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

  • trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcopt.F90

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

  • trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcsed.F90

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

  • trunk/NEMOGCM/NEMO/TOP_SRC/LOBSTER/trcsms_lobster.F90

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    r2773 r3294  
    66   !! History :   1.0  !  2004     (O. Aumont) Original code 
    77   !!             2.0  !  2007-12  (C. Ethe, G. Madec)  F90 
     8   !!             3.4  !  2011-06  (O. Aumont, C. Ethe) Quota model for iron 
    89   !!---------------------------------------------------------------------- 
    910#if defined key_pisces 
    … …  
    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 
    … …  
    5967      !! ** Method  : - ??? 
    6068      !!--------------------------------------------------------------------- 
    61       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    62       USE wrk_nemo, ONLY:   ztempbac => wrk_2d_1 
    63       USE wrk_nemo, ONLY:   zdepbac  => wrk_3d_2 , zolimi => wrk_3d_3 
    6469      ! 
    6570      INTEGER, INTENT(in) ::   kt ! ocean time step 
    6671      ! 
    6772      INTEGER  ::   ji, jj, jk 
    68       REAL(wp) ::   zremip, zremik , zlam1b 
     73      REAL(wp) ::   zremip, zremik , zlam1b, zdepbac2 
    6974      REAL(wp) ::   zkeq  , zfeequi, zsiremin, zfesatur 
    70       REAL(wp) ::   zsatur, zsatur2, znusil 
     75      REAL(wp) ::   zsatur, zsatur2, znusil, zdep, zfactdep 
    7176      REAL(wp) ::   zbactfer, zorem, zorem2, zofer 
    72       REAL(wp) ::   zosil, zdenom1, zscave, zaggdfe 
     77      REAL(wp) ::   zosil, zdenom1, zscave, zaggdfe, zcoag 
    7378#if ! defined key_kriest 
    7479      REAL(wp) ::   zofer2, zdenom, zdenom2 
    … …  
    7681      REAL(wp) ::   zlamfac, zonitr, zstep 
    7782      CHARACTER (len=25) :: charout 
     83      REAL(wp), POINTER, DIMENSION(:,:  ) :: ztempbac  
     84      REAL(wp), POINTER, DIMENSION(:,:,:) :: zdepbac, zolimi, zolimi2 
    7885      !!--------------------------------------------------------------------- 
    79  
    80       IF(  wrk_in_use(2, 1)  .OR.  wrk_in_use(3, 2,3)  ) THEN 
    81          CALL ctl_stop('p4z_rem: requested workspace arrays unavailable')   ;   RETURN 
    82       ENDIF 
     86      ! 
     87      IF( nn_timing == 1 )  CALL timing_start('p4z_rem') 
     88      ! 
     89      ! Allocate temporary workspace 
     90      CALL wrk_alloc( jpi, jpj,      ztempbac                 ) 
     91      CALL wrk_alloc( jpi, jpj, jpk, zdepbac, zolimi, zolimi2 ) 
    8392 
    8493       ! Initialisation of temprary arrys 
    8594       zdepbac (:,:,:) = 0._wp 
    8695       zolimi  (:,:,:) = 0._wp 
     96       zolimi2 (:,:,:) = 0._wp 
    8797       ztempbac(:,:)   = 0._wp 
    8898 
    … …  
    93103         DO jj = 1, jpj 
    94104            DO ji = 1, jpi 
    95                IF( fsdept(ji,jj,jk) < 120. ) THEN 
     105               zdep = MAX( hmld(ji,jj), heup(ji,jj) ) 
     106               IF( fsdept(ji,jj,jk) < zdep ) THEN 
    96107                  zdepbac(ji,jj,jk) = MIN( 0.7 * ( trn(ji,jj,jk,jpzoo) + 2.* trn(ji,jj,jk,jpmes) ), 4.e-6 ) 
    97108                  ztempbac(ji,jj)   = zdepbac(ji,jj,jk) 
    98109               ELSE 
    99                   zdepbac(ji,jj,jk) = MIN( 1., 120./ fsdept(ji,jj,jk) ) * ztempbac(ji,jj) 
     110                  zdepbac(ji,jj,jk) = MIN( 1., zdep / fsdept(ji,jj,jk) ) * ztempbac(ji,jj) 
    100111               ENDIF 
    101112            END DO 
    … …  
    117128         DO jj = 1, jpj 
    118129            DO ji = 1, jpi 
     130               zstep   = xstep 
    119131# if defined key_degrad 
    120                zstep = xstep * facvol(ji,jj,jk) 
    121 # else 
    122                zstep = xstep 
     132               zstep = zstep * facvol(ji,jj,jk) 
    123133# endif 
    124134               ! DOC ammonification. Depends on depth, phytoplankton biomass 
    … …  
    126136               !     of the bacterial activity.  
    127137               zremik = xremik * zstep / 1.e-6 * xlimbac(ji,jj,jk) * zdepbac(ji,jj,jk)  
    128                zremik = MAX( zremik, 5.5e-4 * xstep ) 
    129  
     138               zremik = MAX( zremik, 2.e-4 * xstep ) 
    130139               !     Ammonification in oxic waters with oxygen consumption 
    131140               !     ----------------------------------------------------- 
    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  
     141               zolimi (ji,jj,jk) = zremik * ( 1.- nitrfac(ji,jj,jk) ) * trn(ji,jj,jk,jpdoc)  
     142               zolimi2(ji,jj,jk) = MIN( ( trn(ji,jj,jk,jpoxy) - rtrn ) / o2ut, zolimi(ji,jj,jk) )  
    135143               !     Ammonification in suboxic waters with denitrification 
    136144               !     ------------------------------------------------------- 
    137                denitr(ji,jj,jk) = MIN(  ( trn(ji,jj,jk,jpno3) - rtrn ) / rdenit,   & 
     145               denitr(ji,jj,jk)  = MIN(  ( trn(ji,jj,jk,jpno3) - rtrn ) / rdenit,   & 
    138146                  &                     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 
     147               ! 
    146148               zolimi (ji,jj,jk) = MAX( 0.e0, zolimi (ji,jj,jk) ) 
     149               zolimi2(ji,jj,jk) = MAX( 0.e0, zolimi2(ji,jj,jk) ) 
    147150               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 
     151               ! 
     152            END DO 
     153         END DO 
     154      END DO 
     155 
     156 
     157      DO jk = 1, jpkm1 
     158         DO jj = 1, jpj 
     159            DO ji = 1, jpi 
     160               zstep   = xstep 
    155161# if defined key_degrad 
    156                zstep = xstep * facvol(ji,jj,jk) 
    157 # else 
    158                zstep = xstep 
     162               zstep = zstep * facvol(ji,jj,jk) 
    159163# endif 
    160164               !    NH4 nitrification to NO3. Ceased for oxygen concentrations 
    161165               !    below 2 umol/L. Inhibited at strong light  
    162166               !    ---------------------------------------------------------- 
    163                zonitr  = nitrif * zstep * trn(ji,jj,jk,jpnh4) / ( 1.+ emoy(ji,jj,jk) ) * ( 1.- nitrfac(ji,jj,jk) )  
    164  
     167               zonitr  =nitrif * zstep * trn(ji,jj,jk,jpnh4) / ( 1.+ emoy(ji,jj,jk) ) * ( 1.- nitrfac(ji,jj,jk) )  
     168               denitnh4(ji,jj,jk) = nitrif * zstep * trn(ji,jj,jk,jpnh4) * nitrfac(ji,jj,jk)  
    165169               !   Update of the tracers trends 
    166170               !   ---------------------------- 
    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 
     171               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) - zonitr - denitnh4(ji,jj,jk) 
     172               tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zonitr - rdenita * denitnh4(ji,jj,jk) 
    170173               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  
     174               tra(ji,jj,jk,jptal) = tra(ji,jj,jk,jptal) - 2 * rno3 * zonitr + rno3 * ( rdenita - 1. ) * denitnh4(ji,jj,jk) 
    173175            END DO 
    174176         END DO 
    … …  
    189191               !    studies (especially at Papa) have shown this uptake to be significant 
    190192               !    ---------------------------------------------------------- 
    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 )  ) 
     193               zdepbac2 = zdepbac(ji,jj,jk) * zdepbac(ji,jj,jk) 
     194               zbactfer = 20.e-6 * rfact2 * prmax(ji,jj,jk)                                 & 
     195                  &              * trn(ji,jj,jk,jpfer) / ( 5E-10 + trn(ji,jj,jk,jpfer) )    & 
     196                  &              * zdepbac2 / ( xkgraz2 + zdepbac(ji,jj,jk) )               & 
     197                  &              * ( 0.5 + SIGN( 0.5, trn(ji,jj,jk,jpfer) -2.e-11 )  ) 
    196198 
    197199               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zbactfer 
    … …  
    214216         DO jj = 1, jpj 
    215217            DO ji = 1, jpi 
     218               zstep   = xstep 
    216219# if defined key_degrad 
    217                zstep = xstep * facvol(ji,jj,jk) 
    218 # else 
    219                zstep = xstep 
     220               zstep = zstep * facvol(ji,jj,jk) 
    220221# endif 
    221222               !    POC disaggregation by turbulence and bacterial activity.  
    222223               !    ------------------------------------------------------------- 
    223                zremip = xremip * zstep * tgfunc(ji,jj,jk) * ( 1.- 0.5 * nitrfac(ji,jj,jk) )  
     224               zremip = xremip * zstep * tgfunc(ji,jj,jk) * ( 1.- 0.7 * nitrfac(ji,jj,jk) )  
    224225 
    225226               !    POC disaggregation rate is reduced in anoxic zone as shown by 
    … …  
    266267         DO jj = 1, jpj 
    267268            DO ji = 1, jpi 
     269               zstep   = xstep 
    268270# if defined key_degrad 
    269                zstep = xstep * facvol(ji,jj,jk) 
    270 # else 
    271                zstep = xstep 
     271               zstep = zstep * facvol(ji,jj,jk) 
    272272# endif 
    273273               !     Remineralization rate of BSi depedant on T and saturation 
    274274               !     --------------------------------------------------------- 
    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  
     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.25 
     279               zdep     = MAX( hmld(ji,jj), heup(ji,jj) )  
     280               zdep     = MAX( 0., fsdept(ji,jj,jk) - zdep ) 
     281               zfactdep = xsilab * EXP(-( xsiremlab - xsirem ) * zdep / wsbio2 ) 
     282               zsiremin = ( xsiremlab * zfactdep + xsirem * ( 1. - zfactdep ) ) * zstep * znusil 
     283               zosil    = zsiremin * trn(ji,jj,jk,jpdsi) 
     284               ! 
    282285               tra(ji,jj,jk,jpdsi) = tra(ji,jj,jk,jpdsi) - zosil 
    283286               tra(ji,jj,jk,jpsil) = tra(ji,jj,jk,jpsil) + zosil 
    … …  
    293296       ENDIF 
    294297 
    295       zfesatur = 0.6e-9 
     298      zfesatur = ligand 
    296299!CDIR NOVERRCHK 
    297300      DO jk = 1, jpkm1 
    … …  
    300303!CDIR NOVERRCHK 
    301304            DO ji = 1, jpi 
     305               zstep   = xstep 
    302306# if defined key_degrad 
    303                zstep = xstep * facvol(ji,jj,jk) 
    304 # else 
    305                zstep = xstep 
     307               zstep = zstep * facvol(ji,jj,jk) 
    306308# endif 
    307309               !  Compute de different ratios for scavenging of iron 
    … …  
    312314           &           ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpdsi) + trn(ji,jj,jk,jpcal) + rtrn ) 
    313315#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  
     316               zdenom = 1. / ( trn(ji,jj,jk,jppoc) + trn(ji,jj,jk,jpgoc) + trn(ji,jj,jk,jpdsi) + trn(ji,jj,jk,jpcal) + rtrn ) 
    317317               zdenom1 = trn(ji,jj,jk,jppoc) * zdenom 
    318318               zdenom2 = trn(ji,jj,jk,jpgoc) * zdenom 
    … …  
    337337               !  Increased scavenging for very high iron concentrations 
    338338               !  found near the coasts due to increased lithogenic particles 
    339                !  and let s say it unknown processes (precipitation, ...) 
     339               !  and let say it is unknown processes (precipitation, ...) 
    340340               !  ----------------------------------------------------------- 
     341               zlam1b  = xlam1 * MAX( 0.e0, ( trn(ji,jj,jk,jpfer) * 1.e9 - 1. ) ) 
     342               zcoag   = zfeequi * zlam1b * zstep 
    341343               zlamfac = MAX( 0.e0, ( gphit(ji,jj) + 55.) / 30. ) 
    342344               zlamfac = MIN( 1.  , zlamfac ) 
     345               zdep    =  MIN(1., 1000. / fsdept(ji,jj,jk) ) 
    343346#if ! defined key_kriest 
    344347               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)           & 
     348                  &     + 698.*   trn(ji,jj,jk,jppoc) + 1.05e4 * trn(ji,jj,jk,jpgoc)  )    & 
     349                  &   * xdiss(ji,jj,jk) + 1E-4 * ( 1. - zlamfac ) * zdep 
     350#else 
     351               zlam1b = (  80.* (trn(ji,jj,jk,jpdoc) + 35E-6)              & 
    350352                  &     + 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  
     353                  &   * xdiss(ji,jj,jk) + 1E-4 * ( 1. - zlamfac ) * zdep 
     354#endif 
    355355               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  
     356               tra(ji,jj,jk,jpfer) = tra(ji,jj,jk,jpfer) - zscave - zaggdfe - zcoag 
    359357#if defined key_kriest 
    360358               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) + zscave * zdenom1 
    … …  
    378376 
    379377      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 
     378         tra(:,:,jk,jppo4) = tra(:,:,jk,jppo4) + zolimi (:,:,jk) + denitr(:,:,jk) 
     379         tra(:,:,jk,jpnh4) = tra(:,:,jk,jpnh4) + zolimi (:,:,jk) + denitr(:,:,jk) 
     380         tra(:,:,jk,jpno3) = tra(:,:,jk,jpno3) - denitr (:,:,jk) * rdenit 
     381         tra(:,:,jk,jpdoc) = tra(:,:,jk,jpdoc) - zolimi (:,:,jk) - denitr(:,:,jk) 
     382         tra(:,:,jk,jpoxy) = tra(:,:,jk,jpoxy) - zolimi2(:,:,jk) * o2ut 
     383         tra(:,:,jk,jpdic) = tra(:,:,jk,jpdic) + zolimi (:,:,jk) + denitr(:,:,jk) 
     384         tra(:,:,jk,jptal) = tra(:,:,jk,jptal) + rno3 * ( zolimi(:,:,jk) + ( rdenit + 1.) * denitr(:,:,jk) ) 
    387385      END DO 
    388386 
    … …  
    393391      ENDIF 
    394392      ! 
    395       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      CALL wrk_dealloc( jpi, jpj,      ztempbac                 ) 
     394      CALL wrk_dealloc( jpi, jpj, jpk, zdepbac, zolimi, zolimi2 ) 
     395      ! 
     396      IF( nn_timing == 1 )  CALL timing_stop('p4z_rem') 
    397397      ! 
    398398   END SUBROUTINE p4z_rem 
    … …  
    411411      !! 
    412412      !!---------------------------------------------------------------------- 
    413       NAMELIST/nampisrem/ xremik, xremip, nitrif, xsirem, xlam1, oxymin 
    414       !!---------------------------------------------------------------------- 
    415  
    416       REWIND( numnat )                     ! read numnat 
    417       READ  ( numnat, nampisrem ) 
     413      NAMELIST/nampisrem/ xremik, xremip, nitrif, xsirem, xsiremlab, xsilab,   & 
     414      &                   xlam1, oxymin, ligand  
     415 
     416      REWIND( numnatp )                     ! read numnatp 
     417      READ  ( numnatp, nampisrem ) 
    418418 
    419419      IF(lwp) THEN                         ! control print 
    … …  
    424424         WRITE(numout,*) '    remineralization rate of DOC              xremik    =', xremik 
    425425         WRITE(numout,*) '    remineralization rate of Si               xsirem    =', xsirem 
     426         WRITE(numout,*) '    fast remineralization rate of Si          xsiremlab =', xsiremlab 
     427         WRITE(numout,*) '    fraction of labile biogenic silica        xsilab    =', xsilab 
    426428         WRITE(numout,*) '    scavenging rate of Iron                   xlam1     =', xlam1 
    427429         WRITE(numout,*) '    NH4 nitrification rate                    nitrif    =', nitrif 
    428430         WRITE(numout,*) '    halk saturation constant for anoxia       oxymin    =', oxymin 
     431         WRITE(numout,*) '    ligand concentration in the ocean         ligand    =', ligand 
    429432      ENDIF 
    430433      ! 
    431       nitrfac(:,:,:) = 0._wp 
    432       denitr (:,:,:) = 0._wp 
     434      nitrfac (:,:,:) = 0._wp 
     435      denitr  (:,:,:) = 0._wp 
     436      denitnh4(:,:,:) = 0._wp 
    433437      ! 
    434438   END SUBROUTINE p4z_rem_init 
    … …  
    439443      !!                     ***  ROUTINE p4z_rem_alloc  *** 
    440444      !!---------------------------------------------------------------------- 
    441       ALLOCATE( denitr(jpi,jpj,jpk), STAT=p4z_rem_alloc ) 
     445      ALLOCATE( denitr(jpi,jpj,jpk), denitnh4(jpi,jpj,jpk), STAT=p4z_rem_alloc ) 
    442446      ! 
    443447      IF( p4z_rem_alloc /= 0 )   CALL ctl_warn('p4z_rem_alloc: failed to allocate arrays') 

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

    r2774 r3294  
    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 
    90       USE wrk_nemo, ONLY: znitrpot => wrk_3d_2, zirondep => wrk_3d_3 
    9195      ! 
    9296      INTEGER, INTENT(in) ::   kt, jnt ! ocean time step 
    … …  
    96100      REAL(wp) ::   zrivalk, zrivsil, zrivpo4 
    97101#endif 
    98       REAL(wp) ::   zdenitot, znitrpottot, zlim, zfact 
    99       REAL(wp) ::   zwsbio3, zwsbio4, zwscal 
     102      REAL(wp) ::   zdenitot, znitrpottot, zlim, zfact, zfactcal 
     103      REAL(wp) ::   zsiloss, zcaloss, zwsbio3, zwsbio4, zwscal, zdep 
    100104      CHARACTER (len=25) :: charout 
     105      REAL(wp), POINTER, DIMENSION(:,:  ) :: zsidep, zwork1, zwork2, zwork3 
     106      REAL(wp), POINTER, DIMENSION(:,:,:) :: znitrpot, zirondep 
    101107      !!--------------------------------------------------------------------- 
    102  
    103       IF( ( wrk_in_use(2, 1,2,3) ) .OR. ( wrk_in_use(3, 2,3) ) ) THEN 
    104          CALL ctl_stop('p4z_sed: requested workspace arrays unavailable')  ;  RETURN 
    105       END IF 
    106  
    107       IF( jnt == 1  .AND.  ln_dustfer  )  CALL p4z_sbc( kt ) 
     108      ! 
     109      IF( nn_timing == 1 )  CALL timing_start('p4z_sed') 
     110      ! 
     111      ! Allocate temporary workspace 
     112      CALL wrk_alloc( jpi, jpj,      zsidep, zwork1, zwork2, zwork3 ) 
     113      CALL wrk_alloc( jpi, jpj, jpk, znitrpot, zirondep             ) 
     114 
     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 
    288       ! 
    289        IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    290          WRITE(charout, FMT="('sed ')") 
     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 
     291      ! 
     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) ) )   & 
    296         &         CALL ctl_stop('p4z_sed: failed to release workspace arrays') 
    297  
     311      ENDIF 
     312      ! 
     313      CALL wrk_dealloc( jpi, jpj,      zsidep, zwork1, zwork2, zwork3 ) 
     314      CALL wrk_dealloc( jpi, jpj, jpk, znitrpot, zirondep             ) 
     315      ! 
     316      IF( nn_timing == 1 )  CALL timing_stop('p4z_sed') 
     317      ! 
    298318   END SUBROUTINE p4z_sed 
    299319 
    300320   SUBROUTINE p4z_sbc( kt ) 
    301  
    302321      !!---------------------------------------------------------------------- 
    303       !!                  ***  ROUTINE p4z_sbc  *** 
    304       !! 
    305       !! ** Purpose :   Read and interpolate the external sources of  
     322      !!                  ***  routine p4z_sbc  *** 
     323      !! 
     324      !! ** purpose :   read and interpolate the external sources of  
    306325      !!                nutrients 
    307326      !! 
    308       !! ** Method  :   Read the files and interpolate the appropriate variables 
     327      !! ** method  :   read the files and interpolate the appropriate variables 
    309328      !! 
    310329      !! ** input   :   external netcdf files 
    … …  
    314333      INTEGER, INTENT( in  ) ::   kt   ! ocean time step 
    315334 
    316       !! * Local declarations 
    317       INTEGER :: imois, i15, iman  
    318       REAL(wp) :: zxy 
    319  
     335      !! * local declarations 
     336      INTEGER  :: ji,jj  
     337      REAL(wp) :: zcoef 
    320338      !!--------------------------------------------------------------------- 
    321  
    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      ! 
     340      IF( nn_timing == 1 )  CALL timing_start('p4z_sbc') 
     341      ! 
     342      ! Compute dust at nit000 or only if there is more than 1 time record in dust file 
     343      IF( ln_dust ) THEN 
     344         IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_dust > 1 ) ) THEN 
     345            CALL fld_read( kt, 1, sf_dust ) 
     346            dust(:,:) = sf_dust(1)%fnow(:,:,1) 
     347         ENDIF 
     348      ENDIF 
     349 
     350      ! N/P and Si releases due to coastal rivers 
     351      ! Compute river at nit000 or only if there is more than 1 time record in river file 
     352      ! ----------------------------------------- 
     353      IF( ln_river ) THEN 
     354         IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_riv > 1 ) ) THEN 
     355            CALL fld_read( kt, 1, sf_riverdic ) 
     356            CALL fld_read( kt, 1, sf_riverdoc ) 
     357            DO jj = 1, jpj 
     358               DO ji = 1, jpi 
     359                  zcoef = ryyss * cvol(ji,jj,1)  
     360                  cotdep(ji,jj) =   sf_riverdic(1)%fnow(ji,jj,1)                                  * 1E9 / ( 12. * zcoef + rtrn ) 
     361                  rivinp(ji,jj) = ( sf_riverdic(1)%fnow(ji,jj,1) + sf_riverdoc(1)%fnow(ji,jj,1) ) * 1E9 / ( 31.6* zcoef + rtrn ) 
     362               END DO 
     363            END DO 
     364         ENDIF 
     365      ENDIF 
     366 
     367      ! Compute N deposition at nit000 or only if there is more than 1 time record in N deposition file 
     368      IF( ln_ndepo ) THEN 
     369         IF( kt == nit000 .OR. ( kt /= nit000 .AND. ntimes_ndep > 1 ) ) THEN 
     370            CALL fld_read( kt, 1, sf_ndepo ) 
     371            DO jj = 1, jpj 
     372               DO ji = 1, jpi 
     373                  nitdep(ji,jj) = 7.6 * sf_ndepo(1)%fnow(ji,jj,1) / ( 14E6 * ryyss * fse3t(ji,jj,1) + rtrn ) 
     374               END DO 
     375            END DO 
     376         ENDIF 
     377      ENDIF 
     378      ! 
     379      IF( nn_timing == 1 )  CALL timing_stop('p4z_sbc') 
     380      ! 
    356381   END SUBROUTINE p4z_sbc 
    357382 
    358  
    359383   SUBROUTINE p4z_sed_init 
    360384 
    361385      !!---------------------------------------------------------------------- 
    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) 
     386      !!                  ***  routine p4z_sed_init  *** 
     387      !! 
     388      !! ** purpose :   initialization of the external sources of nutrients 
     389      !! 
     390      !! ** method  :   read the files and compute the budget 
     391      !!                called at the first timestep (nittrc000) 
    368392      !! 
    369393      !! ** input   :   external netcdf files 
    370394      !! 
    371395      !!---------------------------------------------------------------------- 
    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 
    375       ! 
    376       INTEGER :: ji, jj, jk, jm 
    377       INTEGER :: numriv, numbath, numdep 
    378       REAL(wp) ::   zcoef 
    379       REAL(wp) ::   expide, denitide,zmaskt 
    380       ! 
    381       NAMELIST/nampissed/ ln_dustfer, ln_river, ln_ndepo, ln_sedinput, sedfeinput, dustsolub 
     396      ! 
     397      INTEGER  :: ji, jj, jk, jm 
     398      INTEGER  :: numdust, numriv, numiron, numdepo 
     399      INTEGER  :: ierr, ierr1, ierr2, ierr3 
     400      REAL(wp) :: zexpide, zdenitide, zmaskt 
     401      REAL(wp), DIMENSION(nbtimes) :: zsteps                 ! times records 
     402      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zdust, zndepo, zriverdic, zriverdoc, zcmask 
     403      ! 
     404      CHARACTER(len=100) ::  cn_dir          ! Root directory for location of ssr files 
     405      TYPE(FLD_N) ::   sn_dust, sn_riverdoc, sn_riverdic, sn_ndepo, sn_ironsed        ! informations about the fields to be read 
     406      NAMELIST/nampissed/cn_dir, sn_dust, sn_riverdic, sn_riverdoc, sn_ndepo, sn_ironsed, & 
     407        &                ln_dust, ln_river, ln_ndepo, ln_ironsed,         & 
     408        &                sedfeinput, dustsolub, wdust, nitrfix, diazolight, concfediaz  
    382409      !!---------------------------------------------------------------------- 
    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 ) 
     410      ! 
     411      IF( nn_timing == 1 )  CALL timing_start('p4z_sed_init') 
     412      ! 
     413      !                                    ! number of seconds per year and per month 
     414      ryyss    = nyear_len(1) * rday 
     415      rmtss    = ryyss / raamo 
     416      r1_rday  = 1. / rday 
     417      r1_ryyss = 1. / ryyss 
     418      !                            !* set file information 
     419      cn_dir  = './'            ! directory in which the model is executed 
     420      ! ... default values (NB: frequency positive => hours, negative => months) 
     421      !                  !   file       ! frequency !  variable   ! time intep !  clim   ! 'yearly' or ! weights  ! rotation   ! 
     422      !                  !   name       !  (hours)  !   name      !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs      ! 
     423      sn_dust     = FLD_N( 'dust'       ,    -1     ,  'dust'     ,  .true.    , .true.  ,   'yearly'  , ''       , ''         ) 
     424      sn_riverdic = FLD_N( 'river'      ,   -12     ,  'riverdic' ,  .false.   , .true.  ,   'yearly'  , ''       , ''         ) 
     425      sn_riverdoc = FLD_N( 'river'      ,   -12     ,  'riverdoc' ,  .false.   , .true.  ,   'yearly'  , ''       , ''         ) 
     426      sn_ndepo    = FLD_N( 'ndeposition',   -12     ,  'ndep'     ,  .false.   , .true.  ,   'yearly'  , ''       , ''         ) 
     427      sn_ironsed  = FLD_N( 'ironsed'    ,   -12     ,  'bathy'    ,  .false.   , .true.  ,   'yearly'  , ''       , ''         ) 
     428 
     429      REWIND( numnatp )                     ! read numnatp 
     430      READ  ( numnatp, nampissed ) 
    390431 
    391432      IF(lwp) THEN 
    392433         WRITE(numout,*) ' ' 
    393          WRITE(numout,*) ' Namelist : nampissed ' 
     434         WRITE(numout,*) ' namelist : nampissed ' 
    394435         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 
     436         WRITE(numout,*) '    dust input from the atmosphere           ln_dust     = ', ln_dust 
     437         WRITE(numout,*) '    river input of nutrients                 ln_river    = ', ln_river 
     438         WRITE(numout,*) '    atmospheric deposition of n              ln_ndepo    = ', ln_ndepo 
     439         WRITE(numout,*) '    fe input from sediments                  ln_sedinput = ', ln_ironsed 
     440         WRITE(numout,*) '    coastal release of iron                  sedfeinput  = ', sedfeinput 
     441         WRITE(numout,*) '    solubility of the dust                   dustsolub   = ', dustsolub 
     442         WRITE(numout,*) '    sinking speed of the dust                wdust       = ', wdust 
     443         WRITE(numout,*) '    nitrogen fixation rate                   nitrfix     = ', nitrfix 
     444         WRITE(numout,*) '    nitrogen fixation sensitivty to light    diazolight  = ', diazolight 
     445         WRITE(numout,*) '    fe half-saturation cste for diazotrophs  concfediaz  = ', concfediaz 
     446       END IF 
     447 
     448      IF( ln_dust .OR. ln_river .OR. ln_ndepo ) THEN 
     449          ll_sbc = .TRUE. 
     450      ELSE 
     451          ll_sbc = .FALSE. 
     452      ENDIF 
     453 
     454      ! dust input from the atmosphere 
    404455      ! ------------------------------ 
    405       IF( ln_dustfer ) THEN  
    406          IF(lwp) WRITE(numout,*) '    Initialize dust input from atmosphere ' 
     456      IF( ln_dust ) THEN  
     457         IF(lwp) WRITE(numout,*) '    initialize dust input from atmosphere ' 
    407458         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 ) 
     459         ! 
     460         ALLOCATE( sf_dust(1), STAT=ierr )           !* allocate and fill sf_sst (forcing structure) with sn_sst 
     461         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_apr structure' ) 
     462         ! 
     463         CALL fld_fill( sf_dust, (/ sn_dust /), cn_dir, 'p4z_sed_init', 'Iron from sediment ', 'nampissed' ) 
     464                                   ALLOCATE( sf_dust(1)%fnow(jpi,jpj,1)   ) 
     465         IF( sn_dust%ln_tint )     ALLOCATE( sf_dust(1)%fdta(jpi,jpj,1,2) ) 
     466         ! 
     467         ! Get total input dust ; need to compute total atmospheric supply of Si in a year 
     468         CALL iom_open (  TRIM( sn_dust%clname ) , numdust ) 
     469         CALL iom_gettime( numdust, zsteps, kntime=ntimes_dust)  ! get number of record in file 
     470         ALLOCATE( zdust(jpi,jpj,ntimes_dust) ) 
     471         DO jm = 1, ntimes_dust 
     472            CALL iom_get( numdust, jpdom_data, TRIM( sn_dust%clvar ), zdust(:,:,jm), jm ) 
    411473         END DO 
    412474         CALL iom_close( numdust ) 
     475         sumdepsi = 0.e0 
     476         DO jm = 1, ntimes_dust 
     477            sumdepsi = sumdepsi + glob_sum( zdust(:,:,jm) * e1e2t(:,:) * tmask(:,:,1) )  
     478         ENDDO 
     479         sumdepsi = sumdepsi * r1_ryyss * 8.8 * 0.075 / 28.1  
     480         DEALLOCATE( zdust) 
    413481      ELSE 
    414          dustmo(:,:,:) = 0.e0 
    415          dust(:,:) = 0.0 
    416       ENDIF 
    417  
    418       ! Nutrient input from rivers 
     482         dust(:,:) = 0._wp 
     483         sumdepsi  = 0._wp 
     484      END IF 
     485 
     486      ! nutrient input from rivers 
    419487      ! -------------------------- 
    420488      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 ) 
     489         ALLOCATE( sf_riverdic(1), STAT=ierr1 )           !* allocate and fill sf_sst (forcing structure) with sn_sst 
     490         ALLOCATE( sf_riverdoc(1), STAT=ierr2 )           !* allocate and fill sf_sst (forcing structure) with sn_sst 
     491         IF( ierr1 + ierr2 > 0 )   CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_apr structure' ) 
     492         ! 
     493         CALL fld_fill( sf_riverdic, (/ sn_riverdic /), cn_dir, 'p4z_sed_init', 'Input DOC from river ', 'nampissed' ) 
     494         CALL fld_fill( sf_riverdoc, (/ sn_riverdoc /), cn_dir, 'p4z_sed_init', 'Input DOC from river ', 'nampissed' ) 
     495                                   ALLOCATE( sf_riverdic(1)%fnow(jpi,jpj,1)   ) 
     496                                   ALLOCATE( sf_riverdoc(1)%fnow(jpi,jpj,1)   ) 
     497         IF( sn_riverdic%ln_tint ) ALLOCATE( sf_riverdic(1)%fdta(jpi,jpj,1,2) ) 
     498         IF( sn_riverdoc%ln_tint ) ALLOCATE( sf_riverdoc(1)%fdta(jpi,jpj,1,2) ) 
     499         ! Get total input rivers ; need to compute total river supply in a year 
     500         CALL iom_open ( TRIM( sn_riverdic%clname ), numriv ) 
     501         CALL iom_gettime( numriv, zsteps, kntime=ntimes_riv) 
     502         ALLOCATE( zriverdic(jpi,jpj,ntimes_riv) )   ;     ALLOCATE( zriverdoc(jpi,jpj,ntimes_riv) ) 
     503         DO jm = 1, ntimes_riv 
     504            CALL iom_get( numriv, jpdom_data, TRIM( sn_riverdic%clvar ), zriverdic(:,:,jm), jm ) 
     505            CALL iom_get( numriv, jpdom_data, TRIM( sn_riverdoc%clvar ), zriverdoc(:,:,jm), jm ) 
     506         END DO 
    426507         CALL iom_close( numriv ) 
     508         ! N/P and Si releases due to coastal rivers 
     509         ! ----------------------------------------- 
     510         rivpo4input = 0._wp  
     511         rivalkinput = 0._wp  
     512         DO jm = 1, ntimes_riv 
     513            rivpo4input = rivpo4input + glob_sum( ( zriverdic(:,:,jm) + zriverdoc(:,:,jm) ) * tmask(:,:,1) )  
     514            rivalkinput = rivalkinput + glob_sum(   zriverdic(:,:,jm)                       * tmask(:,:,1) )  
     515         END DO 
     516         rivpo4input = rivpo4input * 1E9 / 31.6_wp 
     517         rivalkinput = rivalkinput * 1E9 / 12._wp  
     518         DEALLOCATE( zriverdic)   ;    DEALLOCATE( zriverdoc)  
    427519      ELSE 
    428          zriver   (:,:) = 0.e0 
    429          zriverdoc(:,:) = 0.e0 
    430       endif 
    431  
    432       ! Nutrient input from dust 
     520         rivinp(:,:) = 0._wp 
     521         cotdep(:,:) = 0._wp 
     522         rivpo4input = 0._wp 
     523         rivalkinput = 0._wp 
     524      END IF  
     525 
     526      ! nutrient input from dust 
    433527      ! ------------------------ 
    434528      IF( ln_ndepo ) THEN 
    435          IF(lwp) WRITE(numout,*) '    Initialize the nutrient input by dust from ndeposition.orca.nc' 
     529         IF(lwp) WRITE(numout,*) '    initialize the nutrient input by dust from ndeposition.orca.nc' 
    436530         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 ) 
     531         ALLOCATE( sf_ndepo(1), STAT=ierr3 )           !* allocate and fill sf_sst (forcing structure) with sn_sst 
     532         IF( ierr3 > 0 )   CALL ctl_stop( 'STOP', 'p4z_sed_init: unable to allocate sf_apr structure' ) 
     533         ! 
     534         CALL fld_fill( sf_ndepo, (/ sn_ndepo /), cn_dir, 'p4z_sed_init', 'Iron from sediment ', 'nampissed' ) 
     535                                   ALLOCATE( sf_ndepo(1)%fnow(jpi,jpj,1)   ) 
     536         IF( sn_ndepo%ln_tint )    ALLOCATE( sf_ndepo(1)%fdta(jpi,jpj,1,2) ) 
     537         ! 
     538         ! Get total input dust ; need to compute total atmospheric supply of N in a year 
     539         CALL iom_open ( TRIM( sn_ndepo%clname ), numdepo ) 
     540         CALL iom_gettime( numdepo, zsteps, kntime=ntimes_ndep) 
     541         ALLOCATE( zndepo(jpi,jpj,ntimes_ndep) ) 
     542         DO jm = 1, ntimes_ndep 
     543            CALL iom_get( numdepo, jpdom_data, TRIM( sn_ndepo%clvar ), zndepo(:,:,jm), jm ) 
     544         END DO 
     545         CALL iom_close( numdepo ) 
     546         nitdepinput = 0._wp 
     547         DO jm = 1, ntimes_ndep 
     548           nitdepinput = nitdepinput + glob_sum( zndepo(:,:,jm) * e1e2t(:,:) * tmask(:,:,1) )  
     549         ENDDO 
     550         nitdepinput = nitdepinput * 7.6 / 14E6  
     551         DEALLOCATE( zndepo) 
    440552      ELSE 
    441          zndepo(:,:) = 0.e0 
    442       ENDIF 
    443  
    444       ! Coastal and island masks 
     553         nitdep(:,:) = 0._wp 
     554         nitdepinput = 0._wp 
     555      ENDIF 
     556 
     557      ! coastal and island masks 
    445558      ! ------------------------ 
    446       IF( ln_sedinput ) THEN      
    447          IF(lwp) WRITE(numout,*) '    Computation of an island mask to enhance coastal supply of iron' 
     559      IF( ln_ironsed ) THEN      
     560         IF(lwp) WRITE(numout,*) '    computation of an island mask to enhance coastal supply of iron' 
    448561         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 ) 
     562         CALL iom_open ( TRIM( sn_ironsed%clname ), numiron ) 
     563         ALLOCATE( zcmask(jpi,jpj,jpk) ) 
     564         CALL iom_get  ( numiron, jpdom_data, TRIM( sn_ironsed%clvar ), zcmask(:,:,:), 1 ) 
     565         CALL iom_close( numiron ) 
    453566         ! 
    454567         DO jk = 1, 5 
    … …  
    459572                        &                       * tmask(ji,jj-1,jk) * tmask(ji,jj,jk+1) 
    460573                     IF( zmaskt == 0. )   zcmask(ji,jj,jk ) = MAX( 0.1, zcmask(ji,jj,jk) )  
    461                   ENDIF 
     574                  END IF 
    462575               END DO 
    463576            END DO 
    464577         END DO 
     578         CALL lbc_lnk( zcmask , 'T', 1. )      ! lateral boundary conditions on cmask   (sign unchanged) 
    465579         DO jk = 1, jpk 
    466580            DO jj = 1, jpj 
    467581               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 ) 
     582                  zexpide   = MIN( 8.,( fsdept(ji,jj,jk) / 500. )**(-1.5) ) 
     583                  zdenitide = -0.9543 + 0.7662 * LOG( zexpide ) - 0.235 * LOG( zexpide )**2 
     584                  zcmask(ji,jj,jk) = zcmask(ji,jj,jk) * MIN( 1., EXP( zdenitide ) / 0.5 ) 
    471585               END DO 
    472586            END DO 
    473587         END DO 
     588         ! Coastal supply of iron 
     589         ! ------------------------- 
     590         ironsed(:,:,jpk) = 0._wp 
     591         DO jk = 1, jpkm1 
     592            ironsed(:,:,jk) = sedfeinput * zcmask(:,:,jk) / ( fse3t(:,:,jk) * rday ) 
     593         END DO 
     594         DEALLOCATE( zcmask) 
    474595      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  
     596         ironsed(:,:,:) = 0._wp 
     597      ENDIF 
     598      ! 
     599      IF( ll_sbc ) CALL p4z_sbc( nit000 )  
     600      ! 
     601      IF(lwp) THEN  
     602         WRITE(numout,*) 
     603         WRITE(numout,*) '    Total input of elements from river supply' 
     604         WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
     605         WRITE(numout,*) '    N Supply   : ', rivpo4input/7.6*1E3/1E12*14.,' TgN/yr' 
     606         WRITE(numout,*) '    Si Supply  : ', rivalkinput/6.*1E3/1E12*32.,' TgSi/yr' 
     607         WRITE(numout,*) '    Alk Supply : ', rivalkinput*1E3/1E12,' Teq/yr' 
     608         WRITE(numout,*) '    DIC Supply : ', rivpo4input*2.631*1E3*12./1E12,'TgC/yr' 
     609         WRITE(numout,*)  
     610         WRITE(numout,*) '    Total input of elements from atmospheric supply' 
     611         WRITE(numout,*) '    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
     612         WRITE(numout,*) '    N Supply   : ', nitdepinput/7.6*1E3/1E12*14.,' TgN/yr' 
     613         WRITE(numout,*)  
     614      ENDIF 
     615      ! 
     616      IF( nn_timing == 1 )  CALL timing_stop('p4z_sed_init') 
     617      ! 
    524618   END SUBROUTINE p4z_sed_init 
    525619 
    … …  
    529623      !!---------------------------------------------------------------------- 
    530624 
    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 )   
     625      ALLOCATE( dust  (jpi,jpj), rivinp(jpi,jpj)     , cotdep(jpi,jpj),      & 
     626        &       nitdep(jpi,jpj), ironsed(jpi,jpj,jpk), STAT=p4z_sed_alloc )   
    534627 
    535628      IF( p4z_sed_alloc /= 0 ) CALL ctl_warn('p4z_sed_alloc : failed to allocate arrays.') 

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

    r2715 r3294  
    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 
    … …  
    8084      !! ** Method  : - ??? 
    8185      !!--------------------------------------------------------------------- 
    82       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    83       USE wrk_nemo, ONLY:   znum3d => wrk_3d_2 
    8486      ! 
    8587      INTEGER, INTENT(in) :: kt, jnt 
    … …  
    9193      REAL(wp) :: zdiv , zdiv1, zdiv2, zdiv3, zdiv4, zdiv5 
    9294      REAL(wp) :: zval1, zval2, zval3, zval4 
    93 #if defined key_diatrc 
    9495      REAL(wp) :: zrfact2 
    9596      INTEGER  :: ik1 
    96 #endif 
    9797      CHARACTER (len=25) :: charout 
    98       !!--------------------------------------------------------------------- 
    99       ! 
    100       IF( wrk_in_use(3, 2 ) ) THEN 
    101          CALL ctl_stop('p4z_sink: requested workspace arrays unavailable')   ;   RETURN 
    102       ENDIF 
    103        
     98      REAL(wp), POINTER, DIMENSION(:,:,:) :: znum3d  
     99      !!--------------------------------------------------------------------- 
     100      ! 
     101      IF( nn_timing == 1 )  CALL timing_start('p4z_sink') 
     102      ! 
     103      CALL wrk_alloc( jpi, jpj, jpk, znum3d ) 
     104      ! 
    104105      !     Initialisation of variables used to compute Sinking Speed 
    105106      !     --------------------------------------------------------- 
    … …  
    193194                     &            * (zeps-1)/zdiv1 + 3.*(zfm*xkr_mass_max-xkr_mass_min)    & 
    194195                     &            * (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*                       & 
     196                     &            * (zeps-1.)**2/(zdiv2*zdiv3))  
     197                  zagg2 =  2*0.163*trn(ji,jj,jk,jpnum)**2*zfm*                       & 
    202198                     &                   ((xkr_mass_max**3+3.*(xkr_mass_max**2          & 
    203199                     &                    *xkr_mass_min*(zeps-1.)/zdiv2                 & 
    … …  
    205201                     &                    +xkr_mass_min**3*(zeps-1)/zdiv1)                  & 
    206202                     &                    -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  
     203                     &                    (zeps-2.)+(zeps-1.)/zdiv3)+(zeps-1.)/zdiv1))     
     204 
     205                  zagg3 =  0.163*trn(ji,jj,jk,jpnum)**2*zfm**2*8. * xkr_mass_max**3   
     206                   
    221207                 !    Aggregation of small into large particles 
    222208                 !    Part II : Differential settling 
    223209                 !    ---------------------------------------------- 
    224210 
    225                   zagg4 = ( 2.*3.141*0.125*trn(ji,jj,jk,jpnum)**2*                       & 
     211                  zagg4 = 2.*3.141*0.125*trn(ji,jj,jk,jpnum)**2*                       & 
    226212                     &                 xkr_wsbio_min*(zeps-1.)**2                         & 
    227213                     &                 *(xkr_mass_min**2*((1.-zsm*zfm)/(zdiv3*zdiv4)      & 
    228214                     &                 -(1.-zfm)/(zdiv*(zeps-1.)))-                       & 
    229215                     &                 ((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                         & 
     216                     &                 *xkr_eta)/(zdiv*zdiv3*zdiv5) )    
     217 
     218                  zagg5 =   2.*3.141*0.125*trn(ji,jj,jk,jpnum)**2                         & 
    237219                     &                 *(zeps-1.)*zfm*xkr_wsbio_min                        & 
    238220                     &                 *(zsm*(xkr_mass_min**2-zfm*xkr_mass_max**2)         & 
    239221                     &                 /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  
     222                     &                 /zdiv)   
    246223                  zaggsi = ( zagg4 + zagg5 ) * xstep / 10. 
    247224 
    … …  
    253230                  zaggdoc = ( 0.4 * trn(ji,jj,jk,jpdoc)               & 
    254231                     &        + 1018.  * trn(ji,jj,jk,jppoc)  ) * xstep    & 
     232                     &        * xdiss(ji,jj,jk) * trn(ji,jj,jk,jpdoc) 
     233 
    255234# if defined key_degrad 
    256                      &        * facvol(ji,jj,jk)                              & 
     235                   zagg1   = zagg1   * facvol(ji,jj,jk)                  
     236                   zagg2   = zagg2   * facvol(ji,jj,jk)                  
     237                   zagg3   = zagg3   * facvol(ji,jj,jk)                  
     238                   zagg4   = zagg4   * facvol(ji,jj,jk)                  
     239                   zagg5   = zagg5   * facvol(ji,jj,jk)                  
     240                   zaggdoc = zaggdoc * facvol(ji,jj,jk)                  
    257241# endif 
    258                      &        * xdiss(ji,jj,jk) * trn(ji,jj,jk,jpdoc) 
    259  
     242                  zaggsh = ( zagg1 + zagg2 + zagg3 ) * rfact2 * xdiss(ji,jj,jk) / 1000. 
     243                  zaggsi = ( zagg4 + zagg5 ) * xstep / 10. 
     244                  zagg = 0.5 * xkr_stick * ( zaggsh + zaggsi ) 
     245                  ! 
    260246                  znumdoc = trn(ji,jj,jk,jpnum) / ( trn(ji,jj,jk,jppoc) + rtrn ) 
    261247                  tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) + zaggdoc 
    … …  
    268254      END DO 
    269255 
    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 
     256      IF( ln_diatrc ) THEN 
     257         ! 
     258         ik1 = iksed + 1 
     259         zrfact2 = 1.e3 * rfact2r 
     260         IF( jnt == nrdttrc ) THEN 
     261           CALL iom_put( "POCFlx"  , sinking (:,:,:)      * zrfact2 * tmask(:,:,:) )  ! POC export 
     262           CALL iom_put( "NumFlx"  , sinking2 (:,:,:)     * zrfact2 * tmask(:,:,:) )  ! Num export 
     263           CALL iom_put( "SiFlx"   , sinksil (:,:,:)      * zrfact2 * tmask(:,:,:) )  ! Silica export 
     264           CALL iom_put( "CaCO3Flx", sinkcal (:,:,:)      * zrfact2 * tmask(:,:,:) )  ! Calcite export 
     265           CALL iom_put( "xnum"    , znum3d  (:,:,:)                * tmask(:,:,:) )  ! Number of particles in aggregats 
     266           CALL iom_put( "W1"      , wsbio3  (:,:,:)                * tmask(:,:,:) )  ! sinking speed of POC 
     267           CALL iom_put( "W2"      , wsbio4  (:,:,:)                * tmask(:,:,:) )  ! sinking speed of aggregats 
     268           CALL iom_put( "PMO"     , sinking (:,:,ik1)    * zrfact2 * tmask(:,:,1) )  ! POC export at 100m 
     269           CALL iom_put( "PMO2"    , sinking2(:,:,ik1)    * zrfact2 * tmask(:,:,1) )  ! Num export at 100m 
     270           CALL iom_put( "ExpFe1"  , sinkfer (:,:,ik1)    * zrfact2 * tmask(:,:,1) )  ! Export of iron at 100m 
     271           CALL iom_put( "ExpSi"   , sinksil (:,:,ik1)    * zrfact2 * tmask(:,:,1) )  ! export of silica at 100m 
     272           CALL iom_put( "ExpCaCO3", sinkcal (:,:,ik1)    * zrfact2 * tmask(:,:,1) )  ! export of calcite at 100m 
     273         ENDIF 
     274# if ! defined key_iomput 
     275         trc2d(:,:  ,jp_pcs0_2d + 4)  = sinking (:,:,ik1)    * zrfact2 * tmask(:,:,1) 
     276         trc2d(:,:  ,jp_pcs0_2d + 5)  = sinking2(:,:,ik1)    * zrfact2 * tmask(:,:,1) 
     277         trc2d(:,:  ,jp_pcs0_2d + 6)  = sinkfer (:,:,ik1)    * zrfact2 * tmask(:,:,1) 
     278         trc2d(:,:  ,jp_pcs0_2d + 7)  = sinksil (:,:,ik1)    * zrfact2 * tmask(:,:,1) 
     279         trc2d(:,:  ,jp_pcs0_2d + 8)  = sinkcal (:,:,ik1)    * zrfact2 * tmask(:,:,1) 
     280         trc3d(:,:,:,jp_pcs0_3d + 11) = sinking (:,:,:)      * zrfact2 * tmask(:,:,:) 
     281         trc3d(:,:,:,jp_pcs0_3d + 12) = sinking2(:,:,:)      * zrfact2 * tmask(:,:,:) 
     282         trc3d(:,:,:,jp_pcs0_3d + 13) = sinksil (:,:,:)      * zrfact2 * tmask(:,:,:) 
     283         trc3d(:,:,:,jp_pcs0_3d + 14) = sinkcal (:,:,:)      * zrfact2 * tmask(:,:,:) 
     284         trc3d(:,:,:,jp_pcs0_3d + 15) = znum3d  (:,:,:)                * tmask(:,:,:) 
     285         trc3d(:,:,:,jp_pcs0_3d + 16) = wsbio3  (:,:,:)                * tmask(:,:,:) 
     286         trc3d(:,:,:,jp_pcs0_3d + 17) = wsbio4  (:,:,:)                * tmask(:,:,:) 
     287# endif 
     288        ! 
     289      ENDIF 
    304290      ! 
    305291      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    … …  
    309295      ENDIF 
    310296      ! 
    311       IF( wrk_not_released(3, 2 ) )   CALL ctl_stop('p4z_sink: failed to release workspace arrays') 
     297      CALL wrk_alloc( jpi, jpj, jpk, znum3d ) 
     298      ! 
     299      IF( nn_timing == 1 )  CALL timing_stop('p4z_sink') 
    312300      ! 
    313301   END SUBROUTINE p4z_sink 
    … …  
    335323      !!---------------------------------------------------------------------- 
    336324      ! 
    337       REWIND( numnat )                     ! read nampiskrs 
    338       READ  ( numnat, nampiskrs ) 
     325      IF( nn_timing == 1 )  CALL timing_start('p4z_sink_init') 
     326      ! 
     327      REWIND( numnatp )                     ! read nampiskrs 
     328      READ  ( numnatp, nampiskrs ) 
    339329 
    340330      IF(lwp) THEN 
    … …  
    441431      END DO 
    442432      ! 
     433      IF( nn_timing == 1 )  CALL timing_stop('p4z_sink_init') 
     434      ! 
    443435  END SUBROUTINE p4z_sink_init 
    444436 
    … …  
    457449      INTEGER  ::   ji, jj, jk 
    458450      REAL(wp) ::   zagg1, zagg2, zagg3, zagg4 
    459       REAL(wp) ::   zagg , zaggfe, zaggdoc, zaggdoc2 
    460       REAL(wp) ::   zfact, zwsmax, zstep 
    461 #if defined key_diatrc 
     451      REAL(wp) ::   zagg , zaggfe, zaggdoc, zaggdoc2, zaggdoc3 
     452      REAL(wp) ::   zfact, zwsmax, zmax, zstep 
    462453      REAL(wp) ::   zrfact2 
    463454      INTEGER  ::   ik1 
    464 #endif 
    465455      CHARACTER (len=25) :: charout 
    466456      !!--------------------------------------------------------------------- 
    467  
     457      ! 
     458      IF( nn_timing == 1 )  CALL timing_start('p4z_sink') 
     459      ! 
    468460      !    Sinking speeds of detritus is increased with depth as shown 
    469461      !    by data and from the coagulation theory 
    … …  
    471463      DO jk = 1, jpkm1 
    472464         DO jj = 1, jpj 
    473             DO ji=1,jpi 
    474                zfact = MAX( 0., fsdepw(ji,jj,jk+1) - hmld(ji,jj) ) / 4000._wp 
     465            DO ji = 1,jpi 
     466      !         zmax  = MAX( heup(ji,jj), hmld(ji,jj) ) 
     467      !         zfact = MAX( 0., fsdepw(ji,jj,jk+1) - zmax ) / 5000._wp 
     468               zmax = hmld(ji,jj) 
     469               zfact = MAX( 0., fsdepw(ji,jj,jk+1) - zmax ) / 4000._wp 
    475470               wsbio4(ji,jj,jk) = wsbio2 + ( 200.- wsbio2 ) * zfact 
    476471            END DO 
    … …  
    526521         DO jj = 1, jpj 
    527522            DO ji = 1, jpi 
     523               ! 
     524               zstep = xstep  
    528525# if defined key_degrad 
    529                zstep = xstep * facvol(ji,jj,jk) 
    530 # else 
    531                zstep = xstep  
     526               zstep = zstep * facvol(ji,jj,jk) 
    532527# endif 
    533528               zfact = zstep * xdiss(ji,jj,jk) 
    534529               !  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) 
     530               zagg1 = 354.  * zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) 
     531               zagg2 = 4452. * zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) 
    537532 
    538533               ! Part II : Differential settling 
    539534 
    540535               !  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) 
     536               zagg3 =  4.7 * zstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) 
     537               zagg4 =  0.4 * zstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) 
    543538 
    544539               zagg   = zagg1 + zagg2 + zagg3 + zagg4 
    … …  
    546541 
    547542               ! 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) 
     543               zaggdoc  = ( 0.83 * trn(ji,jj,jk,jpdoc) + 271. * trn(ji,jj,jk,jppoc) ) * zfact * trn(ji,jj,jk,jpdoc) 
     544               zaggdoc2 = 1.07e4 * zfact * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpdoc) 
     545               zaggdoc3 =   0.02 * ( 16706. * trn(ji,jj,jk,jppoc) + 231. * trn(ji,jj,jk,jpdoc) ) * zstep * trn(ji,jj,jk,jpdoc) 
    550546 
    551547               !  Update the trends 
    552                tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zagg + zaggdoc 
     548               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zagg + zaggdoc + zaggdoc3 
    553549               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zagg + zaggdoc2 
    554550               tra(ji,jj,jk,jpsfe) = tra(ji,jj,jk,jpsfe) - zaggfe 
    555551               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zaggfe 
    556                tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zaggdoc - zaggdoc2 
     552               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zaggdoc - zaggdoc2 - zaggdoc3 
    557553               ! 
    558554            END DO 
    … …  
    560556      END DO 
    561557 
    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 
     558      IF( ln_diatrc ) THEN 
     559         zrfact2 = 1.e3 * rfact2r 
     560         ik1  = iksed + 1 
     561         IF( lk_iomput ) THEN 
     562           IF( jnt == nrdttrc ) THEN 
     563              CALL iom_put( "EPC100"  , ( sinking(:,:,ik1) + sinking2(:,:,ik1) ) * zrfact2 * tmask(:,:,1) ) ! Export of carbon at 100m 
     564              CALL iom_put( "EPFE100" , ( sinkfer(:,:,ik1) + sinkfer2(:,:,ik1) ) * zrfact2 * tmask(:,:,1) ) ! Export of iron at 100m 
     565              CALL iom_put( "EPCAL100",   sinkcal(:,:,ik1)                       * zrfact2 * tmask(:,:,1) ) ! Export of calcite  at 100m 
     566              CALL iom_put( "EPSI100" ,   sinksil(:,:,ik1)                       * zrfact2 * tmask(:,:,1) ) ! Export of biogenic silica at 100m 
     567           ENDIF 
     568         ELSE 
     569           trc2d(:,:,jp_pcs0_2d + 4) = sinking (:,:,ik1) * zrfact2 * tmask(:,:,1) 
     570           trc2d(:,:,jp_pcs0_2d + 5) = sinking2(:,:,ik1) * zrfact2 * tmask(:,:,1) 
     571           trc2d(:,:,jp_pcs0_2d + 6) = sinkfer (:,:,ik1) * zrfact2 * tmask(:,:,1) 
     572           trc2d(:,:,jp_pcs0_2d + 7) = sinkfer2(:,:,ik1) * zrfact2 * tmask(:,:,1) 
     573           trc2d(:,:,jp_pcs0_2d + 8) = sinksil (:,:,ik1) * zrfact2 * tmask(:,:,1) 
     574           trc2d(:,:,jp_pcs0_2d + 9) = sinkcal (:,:,ik1) * zrfact2 * tmask(:,:,1) 
     575         ENDIF 
    578576      ENDIF 
    579 #endif 
    580 #endif 
    581577      ! 
    582578      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 
    … …  
    586582      ENDIF 
    587583      ! 
     584      IF( nn_timing == 1 )  CALL timing_stop('p4z_sink') 
     585      ! 
    588586   END SUBROUTINE p4z_sink 
    589  
    590587 
    591588   SUBROUTINE p4z_sink_init 
    … …  
    597594#endif 
    598595 
     596 
     597 
    599598   SUBROUTINE p4z_sink2( pwsink, psinkflx, jp_tra ) 
    600599      !!--------------------------------------------------------------------- 
    … …  
    608607      !!      transport term, i.e.  div(u*tra). 
    609608      !!--------------------------------------------------------------------- 
    610       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    611       USE wrk_nemo, ONLY: ztraz => wrk_3d_2, zakz => wrk_3d_3, zwsink2 => wrk_3d_4 
    612609      ! 
    613610      INTEGER , INTENT(in   )                         ::   jp_tra    ! tracer index index       
    … …  
    617614      INTEGER  ::   ji, jj, jk, jn 
    618615      REAL(wp) ::   zigma,zew,zign, zflx, zstep 
    619       !!--------------------------------------------------------------------- 
    620  
    621       IF(  wrk_in_use(3, 2,3,4 ) ) THEN 
    622          CALL ctl_stop('p4z_sink2: requested workspace arrays unavailable') 
    623          RETURN 
    624       END IF 
     616      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztraz, zakz, zwsink2  
     617      !!--------------------------------------------------------------------- 
     618      ! 
     619      IF( nn_timing == 1 )  CALL timing_start('p4z_sink2') 
     620      ! 
     621      ! Allocate temporary workspace 
     622      CALL wrk_alloc( jpi, jpj, jpk, ztraz, zakz, zwsink2 ) 
    625623 
    626624      zstep = rfact2 / 2. 
    … …  
    630628 
    631629      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 
     630         zwsink2(:,:,jk+1) = -pwsink(:,:,jk) / rday * tmask(:,:,jk+1)  
    637631      END DO 
    638632      zwsink2(:,:,1) = 0.e0 
     633      IF( lk_degrad ) THEN 
     634         zwsink2(:,:,:) = zwsink2(:,:,:) * facvol(:,:,:) 
     635      ENDIF 
    639636 
    640637 
    … …  
    706703      psinkflx(:,:,:)        = 2. * psinkflx(:,:,:) 
    707704      ! 
    708       IF( wrk_not_released(3, 2,3,4) )   CALL ctl_stop('p4z_sink2: failed to release workspace arrays') 
     705      CALL wrk_dealloc( jpi, jpj, jpk, ztraz, zakz, zwsink2 ) 
     706      ! 
     707      IF( nn_timing == 1 )  CALL timing_stop('p4z_sink2') 
    709708      ! 
    710709   END SUBROUTINE p4z_sink2 

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

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

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

    r2715 r3294  
    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 ) 

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

    r2715 r3294  
    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 
     28   USE p4zlim          !  Co-limitations of differents nutrients 
     29   USE p4zprod         !  Growth rate of the 2 phyto groups 
     30   USE p4zmicro        !  Sources and sinks of microzooplankton 
     31   USE p4zmeso         !  Sources and sinks of mesozooplankton 
     32   USE p4zmort         !  Mortality terms for phytoplankton 
     33   USE p4zlys          !  Calcite saturation 
     34   USE p4zsed          !  Sedimentation 
    3035 
    3136   IMPLICIT NONE 
    … …  
    4045   REAL(wp) :: bioma0 =  1.000e-8_wp   
    4146   REAL(wp) :: silic1 =  91.65e-6_wp   
    42    REAL(wp) :: no3    =  31.04e-6_wp * 7.6_wp 
     47   REAL(wp) :: no3    =  31.04e-6_wp * 7.625_wp 
    4348 
    4449#  include "top_substitute.h90" 
    … …  
    5762      !!---------------------------------------------------------------------- 
    5863      ! 
     64      INTEGER  ::  ji, jj, jk 
     65      REAL(wp) ::  zcaralk, zbicarb, zco3 
     66      REAL(wp) ::  ztmas, ztmas1 
     67      !!---------------------------------------------------------------------- 
    5968      IF(lwp) WRITE(numout,*) 
    6069      IF(lwp) WRITE(numout,*) ' trc_ini_pisces :   PISCES biochemical model initialisation' 
    … …  
    7685      ! Set biological ratios 
    7786      ! --------------------- 
    78       rno3   = (16.+2.) / 122. 
    79       po4r   =   1.e0   / 122. 
    80       o2nit  =  32.     / 122. 
    81       rdenit =  97.6    /  16. 
    82       o2ut   = 140.     / 122. 
     87      rno3    =  16._wp / 122._wp 
     88      po4r    =   1._wp / 122._wp 
     89      o2nit   =  32._wp / 122._wp 
     90      rdenit  = 105._wp /  16._wp 
     91      rdenita =   3._wp /  5._wp 
     92      o2ut    = 131._wp / 122._wp 
    8393 
    8494      CALL p4z_che        ! initialize the chemical constants 
    … …  
    124134      ENDIF 
    125135 
     136      IF( .NOT. ln_rsttr ) THEN 
     137         ! Initialization of chemical variables of the carbon cycle 
     138         ! -------------------------------------------------------- 
     139         DO jk = 1, jpk 
     140            DO jj = 1, jpj 
     141               DO ji = 1, jpi 
     142                  ztmas   = tmask(ji,jj,jk) 
     143                  ztmas1  = 1. - tmask(ji,jj,jk) 
     144                  zcaralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / (  1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) )  ) 
     145                  zco3    = ( zcaralk - trn(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1 
     146                  zbicarb = ( 2. * trn(ji,jj,jk,jpdic) - zcaralk ) 
     147                  hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1 
     148               END DO 
     149            END DO 
     150         END DO 
     151         ! 
     152      END IF 
     153 
     154      ! Time step duration for biology 
     155      xstep = rfact2 / rday 
     156 
     157      CALL p4z_sink_init      !  vertical flux of particulate organic matter 
     158      CALL p4z_opt_init       !  Optic: PAR in the water column 
     159      CALL p4z_lim_init       !  co-limitations by the various nutrients 
     160      CALL p4z_prod_init      !  phytoplankton growth rate over the global ocean. 
     161      CALL p4z_rem_init       !  remineralisation 
     162      CALL p4z_mort_init      !  phytoplankton mortality  
     163      CALL p4z_micro_init     !  microzooplankton 
     164      CALL p4z_meso_init      !  mesozooplankton 
     165      CALL p4z_sed_init       !  sedimentation  
     166      CALL p4z_lys_init       !  calcite saturation 
     167      CALL p4z_flx_init       !  gas exchange  
     168 
     169      ndayflxtr = 0 
     170 
     171      IF(lwp) WRITE(numout,*)  
    126172      IF(lwp) WRITE(numout,*) 'Initialization of PISCES tracers done' 
    127       IF(lwp) WRITE(numout,*) ' ' 
     173      IF(lwp) WRITE(numout,*)  
    128174      ! 
    129175   END SUBROUTINE trc_ini_pisces 
    … …  
    136182      !! ** Purpose :   Allocate all the dynamic arrays of PISCES  
    137183      !!---------------------------------------------------------------------- 
    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 
    145184      ! 
    146185      INTEGER :: ierr 
    … …  
    148187      ! 
    149188      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() 
     189      ierr = ierr +  p4z_che_alloc() 
     190      ierr = ierr +  p4z_sink_alloc() 
     191      ierr = ierr +  p4z_opt_alloc() 
     192      ierr = ierr +  p4z_prod_alloc() 
     193      ierr = ierr +  p4z_rem_alloc() 
     194      ierr = ierr +  p4z_sed_alloc() 
     195      ierr = ierr +  p4z_flx_alloc() 
    158196      ! 
    159197      IF( lk_mpp    )   CALL mpp_sum( ierr ) 

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

    r2715 r3294  
    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  
    61       NAMELIST/nampisbio/ part, nrdttrc, wsbio, xkmort, ferat3, wsbio2 
     49      INTEGER :: jl, jn 
     50      TYPE(DIAG), DIMENSION(jp_pisces_2d) :: pisdia2d 
     51      TYPE(DIAG), DIMENSION(jp_pisces_3d) :: pisdia3d 
     52      !! 
     53      NAMELIST/nampisbio/ 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 
    8575         WRITE(numout,*) ' Namelist : nampisbio' 
    86          WRITE(numout,*) '    part of calcite not dissolved in guts     part      =', part 
    8776         WRITE(numout,*) '    frequence pour la biologie                nrdttrc   =', nrdttrc 
    8877         WRITE(numout,*) '    POC sinking speed                         wsbio     =', wsbio 
    … …  
    10190      xkr_mass_max = 1.       
    10291 
    103       REWIND( numnat )                     ! read natkriest 
    104       READ  ( numnat, nampiskrp ) 
     92      REWIND( numnatp )                     ! read natkriest 
     93      READ  ( numnatp, nampiskrp ) 
    10594 
    10695      IF(lwp) THEN 
    … …  
    120109#endif 
    121110      ! 
    122 #if defined key_diatrc && ! defined key_iomput 
     111      IF( .NOT.lk_iomput .AND. ln_diatrc ) THEN 
     112         ! 
     113         ! Namelist nampisdia 
     114         ! ------------------- 
     115         DO jl = 1, jp_pisces_2d 
     116            WRITE(pisdia2d(jl)%sname,'("2D_",I1)') jl                      ! short name 
     117            WRITE(pisdia2d(jl)%lname,'("2D DIAGNOSTIC NUMBER ",I2)') jl    ! long name 
     118            pisdia2d(jl)%units = ' '                                       ! units 
     119         END DO 
     120         !                                 ! 3D output arrays 
     121         DO jl = 1, jp_pisces_3d 
     122            WRITE(pisdia3d(jl)%sname,'("3D_",I1)') jl                      ! short name 
     123            WRITE(pisdia3d(jl)%lname,'("3D DIAGNOSTIC NUMBER ",I2)') jl    ! long name 
     124            pisdia3d(jl)%units = ' '                                       ! units 
     125         END DO 
    123126 
    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 
     127         REWIND( numnatp )               !  
     128         READ  ( numnatp, nampisdia ) 
    171129 
    172130         DO jl = 1, jp_pisces_2d 
    173131            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)) 
     132            ctrc2d(jn) = pisdia2d(jl)%sname 
     133            ctrc2l(jn) = pisdia2d(jl)%lname 
     134            ctrc2u(jn) = pisdia2d(jl)%units 
     135         END DO 
     136 
     137         DO jl = 1, jp_pisces_3d 
     138            jn = jp_pcs0_3d + jl - 1 
     139            ctrc3d(jn) = pisdia3d(jl)%sname 
     140            ctrc3l(jn) = pisdia3d(jl)%lname 
     141            ctrc3u(jn) = pisdia3d(jl)%units 
     142         END DO 
     143 
     144         IF(lwp) THEN                   ! control print 
     145            WRITE(numout,*) 
     146            WRITE(numout,*) ' Namelist : natadd' 
     147            DO jl = 1, jp_pisces_3d 
     148               jn = jp_pcs0_3d + jl - 1 
     149               WRITE(numout,*) '  3d diag nb : ', jn, '    short name : ', ctrc3d(jn), & 
     150                 &             '  long name  : ', ctrc3l(jn), '   unit : ', ctrc3u(jn) 
     151            END DO 
    178152            WRITE(numout,*) ' ' 
    179          END DO 
     153 
     154            DO jl = 1, jp_pisces_2d 
     155               jn = jp_pcs0_2d + jl - 1 
     156               WRITE(numout,*) '  2d diag nb : ', jn, '    short name : ', ctrc2d(jn), & 
     157                 &             '  long name  : ', ctrc2l(jn), '   unit : ', ctrc2u(jn) 
     158            END DO 
     159            WRITE(numout,*) ' ' 
     160         ENDIF 
     161         ! 
    180162      ENDIF 
    181 #endif 
    182163 
    183       REWIND( numnat ) 
    184       READ  ( numnat, nampisdmp ) 
     164      REWIND( numnatp ) 
     165      READ  ( numnatp, nampisdmp ) 
    185166 
    186167      IF(lwp) THEN                         ! control print 
    187168         WRITE(numout,*) 
    188169         WRITE(numout,*) ' Namelist : nampisdmp' 
    189          WRITE(numout,*) '    Relaxation of tracer to glodap mean value            ln_pisdmp      =', ln_pisdmp 
     170         WRITE(numout,*) '    Relaxation of tracer to glodap mean value             ln_pisdmp      =', ln_pisdmp 
     171         WRITE(numout,*) '    Frequency of Relaxation                               nn_pisdmp      =', nn_pisdmp 
    190172         WRITE(numout,*) '    Restoring of tracer to initial value  on closed seas  ln_pisclo      =', ln_pisclo 
    191173         WRITE(numout,*) ' ' 

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

    r2715 r3294  
    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( nittrc000, ztrcdta )   ! read tracer data at nittrc000 
     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 

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

    r2715 r3294  
    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 p4zlys          !  Calcite saturation 
     21   USE p4zflx          !  Gas exchange 
     22   USE p4zsed          !  Sedimentation 
     23   USE p4zint          !  time interpolation 
     24   USE trdmod_oce      !  Ocean trends variables 
     25   USE trdmod_trc      !  TOP trends variables 
     26   USE sedmodel        !  Sediment model 
     27   USE prtctl_trc      !  print control for debugging 
    4028 
    4129   IMPLICIT NONE 
    … …  
    4331 
    4432   PUBLIC   trc_sms_pisces    ! called in trcsms.F90 
     33 
     34   LOGICAL ::  ln_check_mass = .false.       !: Flag to check mass conservation  
     35 
     36   INTEGER ::  numno3  !: logical unit for NO3 budget 
     37   INTEGER ::  numalk  !: logical unit for talk budget 
     38   INTEGER ::  numsil  !: logical unit for Si budget 
    4539 
    4640   !!---------------------------------------------------------------------- 
    … …  
    6357      !!              - ... 
    6458      !!--------------------------------------------------------------------- 
    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 
    6759      ! 
    6860      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
    … …  
    7163      CHARACTER (len=25) :: charout 
    7264      !!--------------------------------------------------------------------- 
    73  
    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 
     65      ! 
     66      IF( nn_timing == 1 )  CALL timing_start('trc_sms_pisces') 
     67      ! 
     68      IF( ln_pisdmp .AND. MOD( kt - nn_dttrc, nn_pisdmp ) == 0 )   CALL trc_sms_pisces_dmp( kt )  ! Relaxation of some tracers 
     69                                                                   CALL trc_sms_pisces_mass_conserv( kt ) ! Mass conservation checking 
    7970 
    8071      IF( ndayflxtr /= nday_year ) THEN      ! New days 
    … …  
    8677         IF(lwp) write(numout,*) '~~~~~~' 
    8778 
    88          CALL p4z_che          ! computation of chemical constants 
    89          CALL p4z_int          ! computation of various rates for biogeochemistry 
     79         CALL p4z_che              ! computation of chemical constants 
     80         CALL p4z_int              ! computation of various rates for biogeochemistry 
    9081         ! 
    9182      ENDIF 
    … …  
    109100      END DO 
    110101 
    111  
    112102      IF( l_trdtrc ) THEN 
    113103          DO jn = jp_pcs0, jp_pcs1 
    114             ztrpis(:,:,:) = tra(:,:,:,jn) 
    115             CALL trd_mod_trc( ztrpis, jn, jptra_trd_sms, kt )   ! save trends 
     104            CALL trd_mod_trc( tra(:,:,:,jn), jn, jptra_trd_sms, kt )   ! save trends 
    116105          END DO 
    117           DEALLOCATE( ztrpis ) 
    118106      END IF 
    119107 
    … …  
    127115         ! 
    128116      ENDIF 
    129  
    130       IF( wrk_not_released(3,1) ) CALL ctl_stop('trc_sms_pisces : failed to release workspace array.')  
    131  
     117      ! 
     118      IF( nn_timing == 1 )  CALL timing_stop('trc_sms_pisces') 
     119      ! 
    132120   END SUBROUTINE trc_sms_pisces 
    133121 
    134    SUBROUTINE trc_sms_pisces_init 
     122   SUBROUTINE trc_sms_pisces_dmp( kt ) 
    135123      !!---------------------------------------------------------------------- 
    136       !!                  ***  ROUTINE trc_sms_pisces_init  *** 
    137       !! 
    138       !! ** Purpose :   Initialization of PH variable 
    139       !! 
     124      !!                    ***  trc_sms_pisces_dmp  *** 
     125      !! 
     126      !! ** purpose  : Relaxation of some tracers 
    140127      !!---------------------------------------------------------------------- 
    141       INTEGER  ::  ji, jj, jk 
    142       REAL(wp) ::  zcaralk, zbicarb, zco3 
    143       REAL(wp) ::  ztmas, ztmas1 
    144  
    145       IF( .NOT. ln_rsttr ) THEN 
    146          ! Initialization of chemical variables of the carbon cycle 
    147          ! -------------------------------------------------------- 
    148          DO jk = 1, jpk 
    149             DO jj = 1, jpj 
    150                DO ji = 1, jpi 
    151                   ztmas   = tmask(ji,jj,jk) 
    152                   ztmas1  = 1. - tmask(ji,jj,jk) 
    153                   zcaralk = trn(ji,jj,jk,jptal) - borat(ji,jj,jk) / (  1. + 1.E-8 / ( rtrn + akb3(ji,jj,jk) )  ) 
    154                   zco3    = ( zcaralk - trn(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1 
    155                   zbicarb = ( 2. * trn(ji,jj,jk,jpdic) - zcaralk ) 
    156                   hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1 
    157                END DO 
    158             END DO 
    159          END DO 
    160          ! 
    161       END IF 
    162  
    163       ! Time step duration for biology 
    164       xstep = rfact2 / rday 
    165  
    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 
    177  
    178       ndayflxtr = 0 
    179  
    180    END SUBROUTINE trc_sms_pisces_init 
     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 
     169 
     170   SUBROUTINE trc_sms_pisces_mass_conserv ( kt ) 
     171      !!---------------------------------------------------------------------- 
     172      !!                  ***  ROUTINE trc_sms_pisces_mass_conserv  *** 
     173      !! 
     174      !! ** Purpose :  Mass conservation check  
     175      !! 
     176      !!--------------------------------------------------------------------- 
     177      ! 
     178      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
     179      !! 
     180      REAL(wp) :: zalkbudget, zno3budget, zsilbudget 
     181      ! 
     182      NAMELIST/nampismass/ ln_check_mass 
     183      !!--------------------------------------------------------------------- 
     184 
     185      IF( kt == nittrc000 ) THEN  
     186         REWIND( numnatp )        
     187         READ  ( numnatp, nampismass ) 
     188         IF(lwp) THEN                         ! control print 
     189            WRITE(numout,*) ' ' 
     190            WRITE(numout,*) ' Namelist parameter for mass conservation checking' 
     191            WRITE(numout,*) ' ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~' 
     192            WRITE(numout,*) '    Flag to check mass conservation of NO3/Si/TALK ln_check_mass = ', ln_check_mass 
     193         ENDIF 
     194 
     195         IF( ln_check_mass .AND. lwp) THEN      !   Open budget file of NO3, ALK, Si 
     196            CALL ctl_opn( numno3, 'no3.budget' , 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 
     197            CALL ctl_opn( numsil, 'sil.budget' , 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 
     198            CALL ctl_opn( numalk, 'talk.budget', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 
     199         ENDIF 
     200      ENDIF 
     201 
     202      IF( ln_check_mass ) THEN      !   Compute the budget of NO3, ALK, Si 
     203         zno3budget = glob_sum( (   trn(:,:,:,jpno3) + trn(:,:,:,jpnh4)  & 
     204            &                     + trn(:,:,:,jpphy) + trn(:,:,:,jpdia)  & 
     205            &                     + trn(:,:,:,jpzoo) + trn(:,:,:,jpmes)  & 
     206            &                     + trn(:,:,:,jppoc) + trn(:,:,:,jpgoc)  & 
     207            &                     + trn(:,:,:,jpdoc)                     ) * cvol(:,:,:)  )  
     208         !  
     209         zsilbudget = glob_sum( (   trn(:,:,:,jpsil) + trn(:,:,:,jpdsi)  & 
     210            &                     + trn(:,:,:,jpbsi)                     ) * cvol(:,:,:)  ) 
     211         !  
     212         zalkbudget = glob_sum( (   trn(:,:,:,jpno3) * rno3              & 
     213            &                     + trn(:,:,:,jptal)                     & 
     214            &                     + trn(:,:,:,jpcal) * 2.                ) * cvol(:,:,:)  ) 
     215 
     216         IF( lwp ) THEN 
     217            WRITE(numno3,9500) kt,  zno3budget / areatot 
     218            WRITE(numsil,9500) kt,  zsilbudget / areatot 
     219            WRITE(numalk,9500) kt,  zalkbudget / areatot 
     220         ENDIF 
     221       ENDIF 
     222 9500  FORMAT(i10,e18.10)      
     223       ! 
     224   END SUBROUTINE trc_sms_pisces_mass_conserv 
    181225 
    182226#else 

  • trunk/NEMOGCM/NEMO/TOP_SRC/SED/sedini.F90

    r2761 r3294  
    449449 
    450450      dtsed = rdt 
    451       nitsed000 = nit000 
     451      nitsed000 = nittrc000 
    452452      nitsedend = nitend 
    453453#if ! defined key_sed_off 

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

    r2528 r3294  
    3535 
    3636 
    37       IF( kt == nit000 ) CALL sed_init       ! Initialization of sediment model 
     37      IF( kt == nittrc000 ) CALL sed_init       ! Initialization of sediment model 
    3838 
    3939                         CALL sed_stp( kt )  ! Time stepping of Sediment model 

  • trunk/NEMOGCM/NEMO/TOP_SRC/SED/sedwri.F90

    r2761 r3294  
    5656      ! Initialisation 
    5757      ! -----------------  
    58       IF( kt == nit000 )   ALLOCATE( ndext52(jpij*jpksed), ndext51(jpij) ) 
     58      IF( kt == nittrc000 )   ALLOCATE( ndext52(jpij*jpksed), ndext51(jpij) ) 
    5959 
    6060      ! Define frequency of output and means 

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

    r2715 r3294  
    3535   INTEGER ::   nadv   ! choice of the type of advection scheme 
    3636   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::   r2dt  ! vertical profile time-step, = 2 rdttra 
    37    !                                                    ! except at nit000 (=rdttra) if neuler=0 
     37   !                                                    ! except at nitrrc000 (=rdttra) if neuler=0 
    3838 
    3939   !! * Substitutions 
    … …  
    6767      !! ** Method  : - Update the tracer with the advection term following nadv 
    6868      !!---------------------------------------------------------------------- 
    69       USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 
    70       USE wrk_nemo, ONLY: zun => wrk_3d_4, zvn => wrk_3d_5, zwn => wrk_3d_6   ! effective velocity 
    7169      !! 
    7270      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    … …  
    7472      INTEGER ::   jk  
    7573      CHARACTER (len=22) ::   charout 
    76       !!---------------------------------------------------------------------- 
    77       ! 
    78       IF( wrk_in_use(3, 4,5,6) ) THEN 
    79          CALL ctl_stop('trc_adv : requested workspace arrays unavailable')   ;   RETURN 
    80       ENDIF 
    81  
    82       IF( kt == nit000 )   CALL trc_adv_ctl          ! initialisation & control of options 
     74      REAL(wp), POINTER, DIMENSION(:,:,:) :: zun, zvn, zwn  ! effective velocity 
     75      !!---------------------------------------------------------------------- 
     76      ! 
     77      IF( nn_timing == 1 )  CALL timing_start('trc_adv') 
     78      ! 
     79      CALL wrk_alloc( jpi, jpj, jpk, zun, zvn, zwn ) 
     80      ! 
     81 
     82      IF( kt == nittrc000 )   CALL trc_adv_ctl          ! initialisation & control of options 
    8383 
    8484#if ! defined key_pisces 
    85       IF( neuler == 0 .AND. kt == nit000 ) THEN     ! at nit000 
     85      IF( neuler == 0 .AND. kt == nittrc000 ) THEN     ! at nittrc000 
    8686         r2dt(:) =  rdttrc(:)           ! = rdttrc (restarting with Euler time stepping) 
    87       ELSEIF( kt <= nit000 + nn_dttrc ) THEN          ! at nit000 or nit000+1 
     87      ELSEIF( kt <= nittrc000 + 1 ) THEN          ! at nittrc000 or nittrc000+1 
    8888         r2dt(:) = 2. * rdttrc(:)       ! = 2 rdttrc (leapfrog) 
    8989      ENDIF 
    … …  
    102102      zwn(:,:,jpk) = 0.e0                                 ! no transport trough the bottom 
    103103 
    104       !                                                   ! add the eiv transport (if necessary) 
    105       IF( lk_traldf_eiv )   CALL tra_adv_eiv( kt, zun, zvn, zwn, 'TRC' ) 
     104      IF( lk_traldf_eiv .AND. .NOT. ln_traldf_grif )   &  ! add the eiv transport (if necessary) 
     105         &              CALL tra_adv_eiv( kt, nittrc000, zun, zvn, zwn, 'TRC' ) 
    106106      ! 
    107107      SELECT CASE ( nadv )                            !==  compute advection trend and add it to general trend  ==! 
    108       CASE ( 1 )   ;    CALL tra_adv_cen2  ( kt, 'TRC',       zun, zvn, zwn, trb, trn, tra, jptra )   !  2nd order centered 
    109       CASE ( 2 )   ;    CALL tra_adv_tvd   ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  TVD  
    110       CASE ( 3 )   ;    CALL tra_adv_muscl ( kt, 'TRC', r2dt, zun, zvn, zwn, trb,      tra, jptra )   !  MUSCL  
    111       CASE ( 4 )   ;    CALL tra_adv_muscl2( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  MUSCL2  
    112       CASE ( 5 )   ;    CALL tra_adv_ubs   ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  UBS  
    113       CASE ( 6 )   ;    CALL tra_adv_qck   ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  QUICKEST  
     108      CASE ( 1 )   ;    CALL tra_adv_cen2  ( kt, nittrc000, 'TRC',       zun, zvn, zwn, trb, trn, tra, jptra )   !  2nd order centered 
     109      CASE ( 2 )   ;    CALL tra_adv_tvd   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  TVD  
     110      CASE ( 3 )   ;    CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb,      tra, jptra )   !  MUSCL  
     111      CASE ( 4 )   ;    CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  MUSCL2  
     112      CASE ( 5 )   ;    CALL tra_adv_ubs   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  UBS  
     113      CASE ( 6 )   ;    CALL tra_adv_qck   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )   !  QUICKEST  
    114114      ! 
    115115      CASE (-1 )                                      !==  esopa: test all possibility with control print  ==! 
    116          CALL tra_adv_cen2  ( kt, 'TRC',       zun, zvn, zwn, trb, trn, tra, jptra )           
     116         CALL tra_adv_cen2  ( kt, nittrc000, 'TRC',       zun, zvn, zwn, trb, trn, tra, jptra )           
    117117         WRITE(charout, FMT="('adv1')")  ; CALL prt_ctl_trc_info(charout) 
    118118                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
    119          CALL tra_adv_tvd   ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )           
     119         CALL tra_adv_tvd   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )           
    120120         WRITE(charout, FMT="('adv2')")  ; CALL prt_ctl_trc_info(charout) 
    121121                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
    122          CALL tra_adv_muscl ( kt, 'TRC', r2dt, zun, zvn, zwn, trb,      tra, jptra )           
     122         CALL tra_adv_muscl ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb,      tra, jptra )           
    123123         WRITE(charout, FMT="('adv3')")  ; CALL prt_ctl_trc_info(charout) 
    124124                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
    125          CALL tra_adv_muscl2( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )           
     125         CALL tra_adv_muscl2( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )           
    126126         WRITE(charout, FMT="('adv4')")  ; CALL prt_ctl_trc_info(charout) 
    127127                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
    128          CALL tra_adv_ubs   ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )           
     128         CALL tra_adv_ubs   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )           
    129129         WRITE(charout, FMT="('adv5')")  ; CALL prt_ctl_trc_info(charout) 
    130130                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
    131          CALL tra_adv_qck   ( kt, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )           
     131         CALL tra_adv_qck   ( kt, nittrc000, 'TRC', r2dt, zun, zvn, zwn, trb, trn, tra, jptra )           
    132132         WRITE(charout, FMT="('adv6')")  ; CALL prt_ctl_trc_info(charout) 
    133133                                           CALL prt_ctl_trc(tab4d=tra, mask=tmask, clinfo=ctrcnm,clinfo2='trd') 
    … …  
    141141      END IF 
    142142      ! 
    143       IF( wrk_not_released(3, 4,5,6) ) CALL ctl_stop('trc_adv : failed to release workspace arrays.') 
     143      CALL wrk_dealloc( jpi, jpj, jpk, zun, zvn, zwn ) 
     144      ! 
     145      IF( nn_timing == 1 )  CALL timing_stop('trc_adv') 
    144146      ! 
    145147   END SUBROUTINE trc_adv 

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

    r2528 r3294  
    5353      INTEGER, INTENT( in ) ::   kt   ! ocean time-step  
    5454      CHARACTER (len=22) :: charout 
    55       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   ztrtrd 
     55      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrtrd 
    5656      !!---------------------------------------------------------------------- 
    57  
    58       IF( .NOT. lk_offline ) THEN 
    59          CALL bbl( kt, 'TRC' )         ! Online coupling with dynamics  : Computation of bbl coef and bbl transport 
    60          l_bbl = .FALSE.               ! Offline coupling with dynamics : Read bbl coef and bbl transport from input files 
     57      ! 
     58      IF( nn_timing == 1 )  CALL timing_start('trc_bbl') 
     59      ! 
     60      IF( .NOT. lk_offline .AND. nn_dttrc == 1 ) THEN 
     61         CALL bbl( kt, nittrc000, 'TRC' )      ! Online coupling with dynamics  : Computation of bbl coef and bbl transport 
     62         l_bbl = .FALSE.                       ! Offline coupling with dynamics : Read bbl coef and bbl transport from input files 
    6163      ENDIF 
    6264 
    6365      IF( l_trdtrc )  THEN 
    64          ALLOCATE( ztrtrd(jpi,jpj,jpk,jptra) )  ! temporary save of trends 
     66         CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrtrd ) ! temporary save of trends 
    6567         ztrtrd(:,:,:,:)  = tra(:,:,:,:) 
    6668      ENDIF 
    … …  
    9395           CALL trd_tra( kt, 'TRC', jn, jptra_trd_ldf, ztrtrd(:,:,:,jn) ) 
    9496        END DO 
    95         DEALLOCATE( ztrtrd ) 
     97        CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd ) ! temporary save of trends 
    9698      ENDIF 
     99      ! 
     100      IF( nn_timing == 1 ) CALL timing_stop('trc_bbl') 
    97101      ! 
    98102   END SUBROUTINE trc_bbl 

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

    r2715 r3294  
    8989      REAL(wp) ::   ztra                 ! temporary scalars 
    9090      CHARACTER (len=22) :: charout 
    91       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrd 
    92       !!---------------------------------------------------------------------- 
    93  
     91      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrtrd 
     92      !!---------------------------------------------------------------------- 
     93      ! 
     94      IF( nn_timing == 1 )  CALL timing_start('trc_dmp') 
     95      ! 
    9496      ! 0. Initialization (first time-step only) 
    9597      !    -------------- 
    96       IF( kt == nit000 ) CALL trc_dmp_init 
    97  
    98       IF( l_trdtrc )   ALLOCATE( ztrtrd(jpi,jpj,jpk) )   ! temporary save of trends 
     98      IF( kt == nittrc000 ) CALL trc_dmp_init 
     99 
     100      IF( l_trdtrc )   CALL wrk_alloc( jpi, jpj, jpk, ztrtrd )   ! temporary save of trends 
    99101 
    100102      ! 1. Newtonian damping trends on tracer fields 
    … …  
    156158      END DO                                                     ! tracer loop 
    157159      !                                                          ! =========== 
    158       IF( l_trdtrc )  DEALLOCATE( ztrtrd ) 
     160      IF( l_trdtrc )  CALL wrk_dealloc( jpi, jpj, jpk, ztrtrd ) 
    159161      !                                          ! print mean trends (used for debugging) 
    160162      IF( ln_ctl )   THEN 
    … …  
    163165      ENDIF 
    164166      ! 
     167      IF( nn_timing == 1 )  CALL timing_stop('trc_dmp') 
     168      ! 
    165169   END SUBROUTINE trc_dmp 
    166170 
    … …  
    173177      !! 
    174178      !! ** Method  :   read the nammbf namelist and check the parameters 
    175       !!              called by trc_dmp at the first timestep (nit000) 
    176       !!---------------------------------------------------------------------- 
    177  
     179      !!              called by trc_dmp at the first timestep (nittrc000) 
     180      !!---------------------------------------------------------------------- 
     181      ! 
     182      IF( nn_timing == 1 )  CALL timing_start('trc_dmp_init') 
     183      ! 
    178184      SELECT CASE ( nn_hdmp_tr ) 
    179185      CASE (  -1  )   ;   IF(lwp) WRITE(numout,*) '   tracer damping in the Med & Red seas only' 
    … …  
    204210                             &            nn_file_tr, 'TRC'     , restotr                ) 
    205211      ENDIF 
     212      ! 
     213      IF( nn_timing == 1 )  CALL timing_stop('trc_dmp_init') 
    206214      ! 
    207215   END SUBROUTINE trc_dmp_init 

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

    r2715 r3294  
    22   !!====================================================================== 
    33   !!                       ***  MODULE  trcldf  *** 
    4    !! Ocean Passive tracers : lateral diffusive trends  
     4   !! Ocean Passive tracers : lateral diffusive trends 
    55   !!===================================================================== 
    66   !! History :  9.0  ! 2005-11 (G. Madec)  Original code 
    7    !!       NEMO 3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA  
     7   !!       NEMO 3.0  ! 2008-01  (C. Ethe, G. Madec)  merge TRC-TRA 
    88   !!---------------------------------------------------------------------- 
    99#if defined key_top 
    … …  
    2323   USE traldf_bilap    ! lateral mixing            (tra_ldf_bilap routine) 
    2424   USE traldf_iso      ! lateral mixing            (tra_ldf_iso routine) 
     25   USE traldf_iso_grif ! lateral mixing          (tra_ldf_iso_grif routine) 
    2526   USE traldf_lap      ! lateral mixing            (tra_ldf_lap routine) 
    2627   USE trdmod_oce 
    … …  
    3132   PRIVATE 
    3233 
    33    PUBLIC   trc_ldf    ! called by step.F90  
     34   PUBLIC   trc_ldf    ! called by step.F90 
    3435   !                                                 !!: ** lateral mixing namelist (nam_trcldf) ** 
    35    INTEGER ::   nldf = 0   ! type of lateral diffusion used defined from ln_trcldf_... namlist logicals) 
     36   REAL(wp) ::  rldf_rat    ! ratio between active and passive tracers diffusive coefficient 
     37   INTEGER  ::  nldf = 0   ! type of lateral diffusion used defined from ln_trcldf_... namlist logicals) 
    3638   !! * Substitutions 
    3739#  include "domzgr_substitute.h90" 
    … …  
    3941   !!---------------------------------------------------------------------- 
    4042   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    41    !! $Id$  
     43   !! $Id$ 
    4244   !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 
    4345   !!---------------------------------------------------------------------- 
    … …  
    4850      !!---------------------------------------------------------------------- 
    4951      !!                  ***  ROUTINE tra_ldf  *** 
    50       !!  
     52      !! 
    5153      !! ** Purpose :   compute the lateral ocean tracer physics. 
    5254      !! 
    … …  
    5658      INTEGER            :: jn 
    5759      CHARACTER (len=22) :: charout 
    58       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   ztrtrd 
    59       !!---------------------------------------------------------------------- 
    60  
    61       IF( kt == nit000 )   CALL ldf_ctl          ! initialisation & control of options 
    62  
    63       IF( l_trdtrc )  THEN  
    64          ALLOCATE( ztrtrd(jpi,jpj,jpk,jptra) )  ! temporary save of trends 
     60      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrtrd 
     61      !!---------------------------------------------------------------------- 
     62      ! 
     63      IF( nn_timing == 1 )   CALL timing_start('trc_ldf') 
     64      ! 
     65      IF( kt == nittrc000 )   CALL ldf_ctl          ! initialisation & control of options 
     66 
     67      rldf = rldf_rat 
     68 
     69      IF( l_trdtrc )  THEN 
     70         CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrtrd ) 
    6571         ztrtrd(:,:,:,:)  = tra(:,:,:,:) 
    6672      ENDIF 
    6773 
    6874      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 
     75      CASE ( 0 )   ;   CALL tra_ldf_lap   ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra            )  ! iso-level laplacian 
     76      CASE ( 1 )                                                                                            ! rotated laplacian 
     77                       IF( ln_traldf_grif ) THEN 
     78                          CALL tra_ldf_iso_grif( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) 
     79                       ELSE 
     80                          CALL tra_ldf_iso     ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) 
     81                       ENDIF 
     82      CASE ( 2 )   ;   CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra            )  ! iso-level bilaplacian 
     83      CASE ( 3 )   ;   CALL tra_ldf_bilapg( kt, nittrc000, 'TRC',             trb, tra, jptra            )  ! s-coord. horizontal bilaplacian 
    7384         ! 
    7485      CASE ( -1 )                                     ! esopa: test all possibility with control print 
    75          CALL tra_ldf_lap   ( kt, 'TRC', gtru, gtrv, trb, tra, jptra            ) 
     86         CALL tra_ldf_lap   ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra            ) 
    7687         WRITE(charout, FMT="('ldf0 ')") ;  CALL prt_ctl_trc_info(charout) 
    7788                                            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 ) 
     89         IF( ln_traldf_grif ) THEN 
     90            CALL tra_ldf_iso_grif( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) 
     91         ELSE 
     92            CALL tra_ldf_iso     ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra, rn_ahtb_0 ) 
     93         ENDIF 
    7994         WRITE(charout, FMT="('ldf1 ')") ;  CALL prt_ctl_trc_info(charout) 
    8095                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    81          CALL tra_ldf_bilap ( kt, 'TRC', gtru, gtrv, trb, tra, jptra            ) 
     96         CALL tra_ldf_bilap ( kt, nittrc000, 'TRC', gtru, gtrv, trb, tra, jptra            ) 
    8297         WRITE(charout, FMT="('ldf2 ')") ;  CALL prt_ctl_trc_info(charout) 
    8398                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    84          CALL tra_ldf_bilapg( kt, 'TRC',             trb, tra, jptra            ) 
     99         CALL tra_ldf_bilapg( kt, nittrc000, 'TRC',             trb, tra, jptra            ) 
    85100         WRITE(charout, FMT="('ldf3 ')") ;  CALL prt_ctl_trc_info(charout) 
    86101                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    … …  
    92107           CALL trd_tra( kt, 'TRC', jn, jptra_trd_ldf, ztrtrd(:,:,:,jn) ) 
    93108        END DO 
    94         DEALLOCATE( ztrtrd )  
     109        CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd ) 
    95110      ENDIF 
    96111      !                                          ! print mean trends (used for debugging) 
    … …  
    100115      ENDIF 
    101116      ! 
     117      IF( nn_timing == 1 )   CALL timing_stop('trc_ldf') 
     118      ! 
    102119   END SUBROUTINE trc_ldf 
    103120 
    … …  
    106123      !!---------------------------------------------------------------------- 
    107124      !!                  ***  ROUTINE ldf_ctl  *** 
    108       !!  
     125      !! 
    109126      !! ** Purpose :   Choice of the operator for the lateral tracer diffusion 
    110127      !! 
    111128      !! ** Method  :   set nldf from the namtra_ldf logicals 
    112       !!      nldf == -2   No lateral diffusion   
     129      !!      nldf == -2   No lateral diffusion 
    113130      !!      nldf == -1   ESOPA test: ALL operators are used 
    114131      !!      nldf ==  0   laplacian operator 
    … …  
    117134      !!      nldf ==  3   Rotated bilaplacian 
    118135      !!---------------------------------------------------------------------- 
    119       INTEGER ::   ioptio, ierr         ! temporary integers  
    120       !!---------------------------------------------------------------------- 
    121  
     136      INTEGER ::   ioptio, ierr         ! temporary integers 
     137      !!---------------------------------------------------------------------- 
     138 
     139      IF (ABS(rn_aht_0) < 2._wp*TINY(1.e0)) THEN 
     140         IF (ABS(rn_ahtrc_0) < 2._wp*TINY(1.e0)) THEN 
     141            rldf_rat = 1.0_wp 
     142         ELSE 
     143            CALL ctl_stop( 'STOP', 'ldf_ctl : cannot define rldf_rat, rn_aht_0==0, rn_ahtrc_0 /=0' ) 
     144         END IF 
     145      ELSE 
     146         rldf_rat = rn_ahtrc_0 / rn_aht_0 
     147      END IF 
    122148      !  Define the lateral mixing oparator for tracers 
    123149      ! =============================================== 
    124      
     150 
    125151      !                               ! control the input 
    126152      ioptio = 0 
    … …  
    163189         ENDIF 
    164190         IF ( ln_zps ) THEN             ! z-coordinate 
    165             IF ( ln_trcldf_level )   ierr = 1      ! iso-level not allowed  
     191            IF ( ln_trcldf_level )   ierr = 1      ! iso-level not allowed 
    166192            IF ( ln_trcldf_hor   )   nldf = 2      ! horizontal (no rotation) 
    167193            IF ( ln_trcldf_iso   )   ierr = 2      ! isoneutral (   rotation) 
    … …  
    206232      ENDIF 
    207233 
     234      IF( ln_trcldf_bilap ) THEN 
     235         IF(lwp) WRITE(numout,*) '          biharmonic tracer diffusion' 
     236         IF( rn_ahtrc_0 > 0 .AND. .NOT. lk_esopa )   CALL ctl_stop( 'The horizontal diffusivity coef. rn_ahtrc_0 must be negative' ) 
     237      ELSE 
     238         IF(lwp) WRITE(numout,*) '          harmonic tracer diffusion (default)' 
     239         IF( rn_ahtrc_0 < 0 .AND. .NOT. lk_esopa )   CALL ctl_stop('The horizontal diffusivity coef. rn_ahtrc_0 must be positive' ) 
     240      ENDIF 
     241 
     242      ! ratio between active and passive tracers diffusive coef. 
     243      IF (ABS(rn_aht_0) < 2._wp*TINY(1.e0)) THEN 
     244         IF (ABS(rn_ahtrc_0) < 2._wp*TINY(1.e0)) THEN 
     245            rldf_rat = 1.0_wp 
     246         ELSE 
     247            CALL ctl_stop( 'STOP', 'ldf_ctl : cannot define rldf_rat, rn_aht_0==0, rn_ahtrc_0 /=0' ) 
     248         END IF 
     249      ELSE 
     250         rldf_rat = rn_ahtrc_0 / rn_aht_0 
     251      END IF 
     252      IF( rldf_rat < 0 ) THEN 
     253         IF( .NOT.lk_offline ) THEN  
     254            CALL ctl_stop( 'Choose the same type of diffusive scheme both for active & passive tracers' ) 
     255         ELSE 
     256            CALL ctl_stop( 'Change the sign of rn_aht_0 in namelist to -/+1' ) 
     257         ENDIF  
     258      ENDIF 
    208259      ! 
    209260   END SUBROUTINE ldf_ctl 

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

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

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

    r2715 r3294  
    9393      REAL(wp) ::   zfact            ! temporary scalar 
    9494      CHARACTER (len=22) :: charout 
    95       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  ztrdt  
     95      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  ztrdt  
    9696      !!---------------------------------------------------------------------- 
    97  
    98       IF( kt == nit000 .AND. lwp ) THEN 
     97      ! 
     98      IF( nn_timing == 1 )  CALL timing_start('trc_nxt') 
     99      ! 
     100      IF( kt == nittrc000 .AND. lwp ) THEN 
    99101         WRITE(numout,*) 
    100102         WRITE(numout,*) 'trc_nxt : time stepping on passive tracers' 
    … …  
    119121 
    120122      ! set time step size (Euler/Leapfrog) 
    121       IF( neuler == 0 .AND. kt ==  nit000) THEN  ;  r2dt(:) =     rdttrc(:)   ! at nit000             (Euler) 
    122       ELSEIF( kt <= nit000 + 1 )           THEN  ;  r2dt(:) = 2.* rdttrc(:)   ! at nit000 or nit000+1 (Leapfrog) 
     123      IF( neuler == 0 .AND. kt ==  nittrc000 ) THEN  ;  r2dt(:) =     rdttrc(:)   ! at nittrc000             (Euler) 
     124      ELSEIF( kt <= nittrc000 + 1 )            THEN  ;  r2dt(:) = 2.* rdttrc(:)   ! at nit000 or nit000+1 (Leapfrog) 
    123125      ENDIF 
    124126 
    125127      ! trends computation initialisation 
    126128      IF( l_trdtrc )  THEN 
    127          ALLOCATE( ztrdt(jpi,jpj,jpk,jptra) )  !* store now fields before applying the Asselin filter 
     129         CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrdt )  !* store now fields before applying the Asselin filter 
    128130         ztrdt(:,:,:,:)  = trn(:,:,:,:) 
    129131      ENDIF 
    130132      ! Leap-Frog + Asselin filter time stepping 
    131       IF( neuler == 0 .AND. kt == nit000 ) THEN        ! Euler time-stepping at first time-step 
    132          !                                             ! (only swap) 
     133      IF( neuler == 0 .AND. kt == nittrc000 ) THEN        ! Euler time-stepping at first time-step 
     134         !                                                ! (only swap) 
    133135         DO jn = 1, jptra 
    134136            DO jk = 1, jpkm1 
    … …  
    139141      ELSE 
    140142         ! Leap-Frog + Asselin filter time stepping 
    141          IF( lk_vvl ) THEN   ;   CALL tra_nxt_vvl( kt, 'TRC', trb, trn, tra, jptra )      ! variable volume level (vvl)  
    142          ELSE                ;   CALL tra_nxt_fix( kt, 'TRC', trb, trn, tra, jptra )      ! fixed    volume level  
     143         IF( lk_vvl ) THEN   ;   CALL tra_nxt_vvl( kt, nittrc000, 'TRC', trb, trn, tra, jptra )      ! variable volume level (vvl)  
     144         ELSE                ;   CALL tra_nxt_fix( kt, nittrc000, 'TRC', trb, trn, tra, jptra )      ! fixed    volume level  
    143145         ENDIF 
    144146      ENDIF 
    … …  
    158160            END DO 
    159161         END DO 
    160          DEALLOCATE( ztrdt ) 
     162         CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrdt )  
    161163      END IF 
    162164      ! 
    … …  
    166168         CALL prt_ctl_trc(tab4d=trn, mask=tmask, clinfo=ctrcnm) 
    167169      ENDIF 
     170      ! 
     171      IF( nn_timing == 1 )  CALL timing_stop('trc_nxt') 
    168172      ! 
    169173   END SUBROUTINE trc_nxt 

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

    r2715 r3294  
    5252      CHARACTER (len=22) :: charout 
    5353      !!---------------------------------------------------------------------- 
    54  
    55       IF( kt == nit000 ) THEN 
     54      ! 
     55      IF( nn_timing == 1 )  CALL timing_start('trc_rad') 
     56      ! 
     57      IF( kt == nittrc000 ) THEN 
    5658         IF(lwp) WRITE(numout,*) 
    5759         IF(lwp) WRITE(numout,*) 'trc_rad : Correct artificial negative concentrations ' 
    … …  
    6567      IF( lk_my_trc  )   CALL trc_rad_sms( kt, trb, trn, jp_myt0 , jp_myt1               )  ! MY_TRC model 
    6668 
    67  
    6869      ! 
    6970      IF(ln_ctl) THEN      ! print mean trends (used for debugging) 
    … …  
    7273         CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 
    7374      ENDIF 
     75      ! 
     76      IF( nn_timing == 1 )  CALL timing_stop('trc_rad') 
    7477      ! 
    7578   END SUBROUTINE trc_rad 
    … …  
    104107       
    105108      ! Local declarations 
    106       INTEGER  ::  ji, jj, jk, jn     ! dummy loop indices 
    107       REAL(wp) :: zvolk, ztrcorb, ztrmasb   ! temporary scalars 
     109      INTEGER  :: ji, jj, jk, jn     ! dummy loop indices 
     110      REAL(wp) :: ztrcorb, ztrmasb   ! temporary scalars 
    108111      REAL(wp) :: zcoef, ztrcorn, ztrmasn   !    "         " 
    109       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrdb  ! workspace arrays 
    110       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrtrdn  ! workspace arrays 
     112      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztrtrdb, ztrtrdn   ! workspace arrays 
    111113      REAL(wp) :: zs2rdt 
    112114      LOGICAL ::   lldebug = .FALSE. 
    113  
    114       !!---------------------------------------------------------------------- 
    115  
    116       IF( l_trdtrc ) THEN 
    117         ! 
    118         ALLOCATE( ztrtrdb(jpi,jpj,jpk) ) 
    119         ALLOCATE( ztrtrdn(jpi,jpj,jpk) ) 
    120         ! 
    121       ENDIF 
     115      !!---------------------------------------------------------------------- 
     116 
     117  
     118      IF( l_trdtrc )  CALL wrk_alloc( jpi, jpj, jpk, ztrtrdb, ztrtrdn ) 
    122119       
    123120      IF( PRESENT( cpreserv )  ) THEN   !  total tracer concentration is preserved  
    124121       
    125122         DO jn = jp_sms0, jp_sms1 
    126          !                                                        ! =========== 
     123            !                                                        ! =========== 
    127124            ztrcorb = 0.e0   ;   ztrmasb = 0.e0 
    128125            ztrcorn = 0.e0   ;   ztrmasn = 0.e0 
    129126 
    130            IF( l_trdtrc ) THEN 
    131               ztrtrdb(:,:,:) = ptrb(:,:,:,jn)                        ! save input trb for trend computation 
    132               ztrtrdn(:,:,:) = ptrn(:,:,:,jn)                        ! save input trn for trend computation 
    133            ENDIF 
    134  
    135  
    136             DO jk = 1, jpkm1 
    137                DO jj = 1, jpj 
    138                   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 
    145  
    146                      ptrb(ji,jj,jk,jn) = MAX( 0., ptrb(ji,jj,jk,jn) ) 
    147                      ptrn(ji,jj,jk,jn) = MAX( 0., ptrn(ji,jj,jk,jn) ) 
    148  
    149                      ztrmasb = ztrmasb + ptrb(ji,jj,jk,jn) * zvolk 
    150                      ztrmasn = ztrmasn + ptrn(ji,jj,jk,jn) * zvolk 
    151                   END DO 
    152                END DO 
    153             END DO 
    154  
    155             IF( lk_mpp ) THEN 
    156                CALL mpp_sum( ztrcorb )      ! sum over the global domain 
    157                CALL mpp_sum( ztrcorn )      ! sum over the global domain 
    158                CALL mpp_sum( ztrmasb )      ! sum over the global domain 
    159                CALL mpp_sum( ztrmasn )      ! sum over the global domain 
    160             ENDIF 
     127            IF( l_trdtrc ) THEN 
     128               ztrtrdb(:,:,:) = ptrb(:,:,:,jn)                        ! save input trb for trend computation 
     129               ztrtrdn(:,:,:) = ptrn(:,:,:,jn)                        ! save input trn for trend computation 
     130            ENDIF 
     131            !                                                         ! sum over the global domain  
     132            ztrcorb = glob_sum( MIN( 0., ptrb(:,:,:,jn) ) * cvol(:,:,:) ) 
     133            ztrcorn = glob_sum( MIN( 0., ptrn(:,:,:,jn) ) * cvol(:,:,:) ) 
     134 
     135            ztrmasb = glob_sum( MAX( 0., ptrb(:,:,:,jn) ) * cvol(:,:,:) ) 
     136            ztrmasn = glob_sum( MAX( 0., ptrn(:,:,:,jn) ) * cvol(:,:,:) ) 
    161137 
    162138            IF( ztrcorb /= 0 ) THEN 
    163139               zcoef = 1. + ztrcorb / ztrmasb 
    164140               DO jk = 1, jpkm1 
     141                  ptrb(:,:,jk,jn) = MAX( 0., ptrb(:,:,jk,jn) ) 
    165142                  ptrb(:,:,jk,jn) = ptrb(:,:,jk,jn) * zcoef * tmask(:,:,jk) 
    166143               END DO 
    … …  
    170147               zcoef = 1. + ztrcorn / ztrmasn 
    171148               DO jk = 1, jpkm1 
     149                  ptrn(:,:,jk,jn) = MAX( 0., ptrn(:,:,jk,jn) ) 
    172150                  ptrn(:,:,jk,jn) = ptrn(:,:,jk,jn) * zcoef * tmask(:,:,jk) 
    173151               END DO 
    … …  
    207185            IF( l_trdtrc ) THEN 
    208186               ! 
    209                zs2rdt = 1. / ( 2. * rdt * FLOAT(nn_dttrc) ) 
     187               zs2rdt = 1. / ( 2. * rdt * FLOAT( nn_dttrc ) ) 
    210188               ztrtrdb(:,:,:) = ( ptrb(:,:,:,jn) - ztrtrdb(:,:,:) ) * zs2rdt 
    211189               ztrtrdn(:,:,:) = ( ptrn(:,:,:,jn) - ztrtrdn(:,:,:) ) * zs2rdt  
    … …  
    219197      ENDIF 
    220198 
    221       IF( l_trdtrc )   DEALLOCATE( ztrtrdb, ztrtrdn ) 
     199      IF( l_trdtrc )  CALL wrk_dealloc( jpi, jpj, jpk, ztrtrdb, ztrtrdn ) 
    222200 
    223201   END SUBROUTINE trc_rad_sms 

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

    r2715 r3294  
    5757      !! 
    5858      !!---------------------------------------------------------------------- 
    59       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    60       USE wrk_nemo, ONLY:   zemps  => wrk_2d_1 
    61       USE wrk_nemo, ONLY:   ztrtrd => wrk_3d_1 
    6259      ! 
    6360      INTEGER, INTENT( in ) ::   kt          ! ocean time-step index 
    … …  
    6663      REAL(wp) ::   zsrau, zse3t   ! temporary scalars 
    6764      CHARACTER (len=22) :: charout 
    68       !!---------------------------------------------------------------------- 
     65      REAL(wp), POINTER, DIMENSION(:,:  ) :: zemps 
     66      REAL(wp), POINTER, DIMENSION(:,:,:) :: ztrtrd 
     67      !!--------------------------------------------------------------------- 
     68      ! 
     69      IF( nn_timing == 1 )  CALL timing_start('trc_sbc') 
     70      ! 
     71      ! Allocate temporary workspace 
     72                      CALL wrk_alloc( jpi, jpj,      zemps  ) 
     73      IF( l_trdtrc )  CALL wrk_alloc( jpi, jpj, jpk, ztrtrd ) 
    6974 
    70       IF( wrk_in_use(2, 1) .OR.  wrk_in_use(3, 1) ) THEN 
    71          CALL ctl_stop('trc_sbc: requested workspace array unavailable.')   ;   RETURN 
    72       END IF 
    73  
    74       IF( kt == nit000 ) THEN 
     75      IF( kt == nittrc000 ) THEN 
    7576         IF(lwp) WRITE(numout,*) 
    7677         IF(lwp) WRITE(numout,*) 'trc_sbc : Passive tracers surface boundary condition' 
    … …  
    116117                                           CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    117118      ENDIF 
    118  
    119       IF( wrk_not_released(2, 1) .OR. wrk_not_released(3, 1) )   & 
    120       &       CALL ctl_stop('trc_sbc: failed to release workspace array.') 
    121  
     119                      CALL wrk_dealloc( jpi, jpj,      zemps  ) 
     120      IF( l_trdtrc )  CALL wrk_dealloc( jpi, jpj, jpk, ztrtrd ) 
     121      ! 
     122      IF( nn_timing == 1 )  CALL timing_stop('trc_sbc') 
     123      ! 
    122124   END SUBROUTINE trc_sbc 
    123125 

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

    r2528 r3294  
    5858      INTEGER, INTENT( in ) ::  kstp  ! ocean time-step index 
    5959      !! --------------------------------------------------------------------- 
     60      ! 
     61      IF( nn_timing == 1 )   CALL timing_start('trc_trp') 
     62      ! 
    6063      IF( .NOT. lk_c1d ) THEN 
    6164         ! 
    … …  
    8689      END IF 
    8790      ! 
     91      IF( nn_timing == 1 )   CALL timing_stop('trc_trp') 
     92      ! 
    8893   END SUBROUTINE trc_trp 
    8994 

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

    r2715 r3294  
    3232      !                                ! defined from ln_zdf...  namlist logicals) 
    3333   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:) ::  r2dt   ! vertical profile time-step, = 2 rdttra 
    34       !                                                 ! except at nit000 (=rdttra) if neuler=0 
     34      !                                                 ! except at nittrc000 (=rdttra) if neuler=0 
    3535 
    3636   !! * Substitutions 
    … …  
    6666      INTEGER               ::  jk, jn 
    6767      CHARACTER (len=22)    :: charout 
    68       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   ztrtrd   ! 4D workspace 
     68      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::   ztrtrd   ! 4D workspace 
    6969      !!--------------------------------------------------------------------- 
    70  
    71       IF( kt == nit000 )   CALL zdf_ctl          ! initialisation & control of options 
     70      ! 
     71      IF( nn_timing == 1 )  CALL timing_start('trc_zdf') 
     72      ! 
     73      IF( kt == nittrc000 )   CALL zdf_ctl          ! initialisation & control of options 
    7274 
    7375#if ! defined key_pisces 
    74       IF( neuler == 0 .AND. kt == nit000 ) THEN     ! at nit000 
     76      IF( neuler == 0 .AND. kt == nittrc000 ) THEN     ! at nittrc000 
    7577         r2dt(:) =  rdttrc(:)           ! = rdttrc (restarting with Euler time stepping) 
    76       ELSEIF( kt <= nit000 + nn_dttrc ) THEN          ! at nit000 or nit000+1 
     78      ELSEIF( kt <= nittrc000 + 1 ) THEN          ! at nittrc000 or nittrc000+1 
    7779         r2dt(:) = 2. * rdttrc(:)       ! = 2 rdttrc (leapfrog) 
    7880      ENDIF 
    … …  
    8284 
    8385      IF( l_trdtrc )  THEN 
    84          ALLOCATE( ztrtrd(jpi,jpj,jpk,jptra) )   ! temporary save of trends 
     86         CALL wrk_alloc( jpi, jpj, jpk, jptra, ztrtrd ) 
    8587         ztrtrd(:,:,:,:)  = tra(:,:,:,:) 
    8688      ENDIF 
    … …  
    8890      SELECT CASE ( nzdf )                       ! compute lateral mixing trend and add it to the general trend 
    8991      CASE ( -1 )                                       ! esopa: test all possibility with control print 
    90          CALL tra_zdf_exp( kt, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra )  
     92         CALL tra_zdf_exp( kt, nittrc000, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra )  
    9193         WRITE(charout, FMT="('zdf1 ')") ;  CALL prt_ctl_trc_info(charout) 
    9294                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    93          CALL tra_zdf_imp( kt, 'TRC', r2dt,                trb, tra, jptra )  
     95         CALL tra_zdf_imp( kt, nittrc000, 'TRC', r2dt,                trb, tra, jptra )  
    9496         WRITE(charout, FMT="('zdf2 ')") ;  CALL prt_ctl_trc_info(charout) 
    9597                                            CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    96       CASE ( 0 ) ;  CALL tra_zdf_exp( kt, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra )    !   explicit scheme  
    97       CASE ( 1 ) ;  CALL tra_zdf_imp( kt, 'TRC', r2dt,                trb, tra, jptra )    !   implicit scheme           
     98      CASE ( 0 ) ;  CALL tra_zdf_exp( kt, nittrc000, 'TRC', r2dt, nn_trczdf_exp, trb, tra, jptra )    !   explicit scheme  
     99      CASE ( 1 ) ;  CALL tra_zdf_imp( kt, nittrc000, 'TRC', r2dt,                trb, tra, jptra )    !   implicit scheme           
    98100 
    99101      END SELECT 
    … …  
    106108            CALL trd_tra( kt, 'TRC', jn, jptra_trd_zdf, ztrtrd(:,:,:,jn) ) 
    107109         END DO 
    108          DEALLOCATE( ztrtrd ) 
     110         CALL wrk_dealloc( jpi, jpj, jpk, jptra, ztrtrd ) 
    109111      ENDIF 
    110  
    111112      !                                          ! print mean trends (used for debugging) 
    112113      IF( ln_ctl )   THEN 
    … …  
    114115                                           CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=ctrcnm, clinfo2='trd' ) 
    115116      END IF 
     117      ! 
     118      IF( nn_timing == 1 )  CALL timing_stop('trc_zdf') 
    116119      ! 
    117120   END SUBROUTINE trc_zdf 

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

    r2715 r3294  
    3333   USE trdmld_trc_rst    ! restart for diagnosing the ML trends 
    3434   USE prtctl            ! print control 
    35    USE sms_pisces         
    36    USE sms_lobster 
     35   USE sms_pisces        ! PISCES bio-model 
     36   USE sms_lobster       ! LOBSTER bio-model 
    3737 
    3838   IMPLICIT NONE 
    … …  
    6060   LOGICAL :: lldebug = .TRUE. 
    6161 
    62    ! Workspace array for trd_mld_trc() routine. Declared here as is 4D and 
    63    ! cannot use workspaces in wrk_nemo module. 
    6462   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  ztmltrd2   ! 
    6563#if defined key_lobster 
    … …  
    112110      !!            surface and the control surface is called "mixed-layer" 
    113111      !!---------------------------------------------------------------------- 
    114       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    115       USE wrk_nemo, ONLY:   zvlmsk => wrk_2d_1 
    116112      !! 
    117113      INTEGER, INTENT( in ) ::   ktrd, kjn                        ! ocean trend index and passive tracer rank 
    118114      CHARACTER(len=2), INTENT( in ) ::  ctype                    ! surface/bottom (2D) or interior (3D) physics 
    119115      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( in ) ::  ptrc_trdmld ! passive tracer trend 
     116      ! 
    120117      INTEGER ::   ji, jj, jk, isum 
    121       !!---------------------------------------------------------------------- 
    122  
    123       IF( wrk_in_use(2, 1) ) THEN 
    124          CALL ctl_stop('trd_mld_trc_zint: requested workspace array unavailable')   ;   RETURN 
    125       ENDIF 
     118      REAL(wp), POINTER, DIMENSION(:,:) :: zvlmsk 
     119      !!---------------------------------------------------------------------- 
     120 
     121      CALL wrk_alloc( jpi, jpj, zvlmsk ) 
    126122 
    127123      ! I. Definition of control surface and integration weights 
    … …  
    208204      END SELECT 
    209205      ! 
    210       IF( wrk_not_released(2, 1) )   CALL ctl_stop('trd_mld_trc_zint: failed to release workspace array') 
     206      CALL wrk_dealloc( jpi, jpj, zvlmsk ) 
    211207      ! 
    212208   END SUBROUTINE trd_mld_trc_zint 
    … …  
    231227      !!            surface and the control surface is called "mixed-layer" 
    232228      !!---------------------------------------------------------------------- 
    233       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    234       USE wrk_nemo, ONLY:   zvlmsk => wrk_2d_1 
    235229      !! 
    236230      INTEGER                         , INTENT(in) ::   ktrd          ! bio trend index 
    … …  
    239233      ! 
    240234      INTEGER ::   ji, jj, jk, isum 
    241       !!---------------------------------------------------------------------- 
    242  
    243       IF( wrk_in_use(2, 1) ) THEN 
    244          CALL ctl_stop('trd_mld_bio_zint: requested workspace array unavailable')   ;   RETURN 
    245       ENDIF 
     235      REAL(wp), POINTER, DIMENSION(:,:) :: zvlmsk 
     236      !!---------------------------------------------------------------------- 
     237 
     238      CALL wrk_alloc( jpi, jpj, zvlmsk ) 
    246239 
    247240      ! I. Definition of control surface and integration weights 
    … …  
    325318      END DO 
    326319 
    327       IF( wrk_not_released(2, 1) )   CALL ctl_stop('trd_mld_bio_zint: failed to release workspace array') 
     320      CALL wrk_alloc( jpi, jpj, zvlmsk ) 
    328321#endif 
    329322      ! 
    … …  
    378371      !!       - See NEMO documentation (in preparation) 
    379372      !!---------------------------------------------------------------------- 
    380       USE wrk_nemo, ONLY:   wrk_in_use, wrk_not_released 
    381       USE wrk_nemo, ONLY:   wrk_3d_1, wrk_3d_2, wrk_3d_3, wrk_3d_4 
    382       USE wrk_nemo, ONLY:   wrk_3d_5, wrk_3d_6, wrk_3d_7, wrk_3d_8, wrk_3d_9 
    383373      ! 
    384374      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    … …  
    397387      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmlatf2            !  | passive tracers 
    398388      REAL(wp), POINTER, DIMENSION(:,:,:) ::   ztmlrad2            !  | (-> for trb<0 corr in trcrad) 
    399       !REAL(wp), DIMENSION(jpi,jpj,jpltrd_trc,jptra) ::  ztmltrd2  ! -+ 
    400389      ! 
    401390      CHARACTER (LEN= 5) ::   clvar 
    … …  
    406395      !!---------------------------------------------------------------------- 
    407396 
    408       IF( wrk_in_use(3, 1,2,3,4,5,6,7,8,9) ) THEN 
    409          CALL ctl_stop('trd_mld_trc : requested workspace arrays unavailable')   ;   RETURN 
    410       ENDIF 
    411397      ! Set-up pointers into sub-arrays of workspaces 
    412       ztmltot   => wrk_3d_1(:,:,1:jptra) 
    413       ztmlres   => wrk_3d_2(:,:,1:jptra) 
    414       ztmlatf   => wrk_3d_3(:,:,1:jptra) 
    415       ztmlrad   => wrk_3d_4(:,:,1:jptra) 
    416       ztmltot2  => wrk_3d_5(:,:,1:jptra) 
    417       ztmlres2  => wrk_3d_6(:,:,1:jptra) 
    418       ztmltrdm2 => wrk_3d_7(:,:,1:jptra) 
    419       ztmlatf2  => wrk_3d_8(:,:,1:jptra) 
    420       ztmlrad2  => wrk_3d_9(:,:,1:jptra) 
    421  
     398      CALL wrk_alloc( jpi, jpj, jptra, ztmltot , ztmlres , ztmlatf , ztmlrad             ) 
     399      CALL wrk_alloc( jpi, jpj, jptra, ztmltot2, ztmlres2, ztmlatf2, ztmlrad2, ztmltrdm2 ) 
    422400 
    423401      IF( nn_dttrc  /= 1  )   CALL ctl_stop( " Be careful, trends diags never validated " ) 
    … …  
    475453      ! II.1 Set before values of vertically averages passive tracers 
    476454      ! ------------------------------------------------------------- 
    477       IF( kt > nit000 ) THEN 
     455      IF( kt > nittrc000 ) THEN 
    478456         DO jn = 1, jptra 
    479457            IF( ln_trdtrc(jn) ) THEN 
    … …  
    497475      ! II.3 Initialize mixed-layer "before" arrays for the 1rst analysis window     
    498476      ! ------------------------------------------------------------------------ 
    499       IF( kt == 2 ) THEN  !  i.e. ( .NOT. ln_rstart ).AND.( kt == nit000 + 1)    ??? 
     477      IF( kt == nittrc000 + nn_dttrc ) THEN  !  i.e. ( .NOT. ln_rstart ).AND.( kt == nit000 + 1)    ??? 
    500478         ! 
    501479         DO jn = 1, jptra 
    … …  
    560538      tmltrd_trc(:,:,:,:) = tmltrd_trc(:,:,:,:) * rn_ucf_trc 
    561539 
    562       itmod = kt - nit000 + 1 
     540      itmod = kt - nittrc000 + 1 
    563541      it    = kt 
    564542 
    … …  
    907885      IF( lrst_trc )   CALL trd_mld_trc_rst_write( kt )  ! this must be after the array swap above (III.3) 
    908886 
    909       IF( wrk_not_released(3, 1,2,3,4,5,6,7,8,9) )   CALL ctl_stop('trd_mld_trc: failed to release workspace arrays') 
     887      CALL wrk_dealloc( jpi, jpj, jptra, ztmltot , ztmlres , ztmlatf , ztmlrad             ) 
     888      CALL wrk_dealloc( jpi, jpj, jptra, ztmltot2, ztmlres2, ztmlatf2, ztmlrad2, ztmltrdm2 ) 
    910889      ! 
    911890   END SUBROUTINE trd_mld_trc 
    … …  
    980959      ! II.3 Initialize mixed-layer "before" arrays for the 1rst analysis window 
    981960      ! ------------------------------------------------------------------------ 
    982       IF( kt == 2 ) THEN  !  i.e. ( .NOT. ln_rstart ).AND.( kt == nit000 + 1) 
     961      IF( kt == nittrc000 + nn_dttrc ) THEN  !  i.e. ( .NOT. ln_rstart ).AND.( kt == nit000 + 1) 
    983962         ! 
    984963         tmltrd_csum_ub_bio (:,:,:) = 0.e0 
    … …  
    10861065 
    10871066      ! define time axis 
    1088       itmod = kt - nit000 + 1 
     1067      itmod = kt - nittrc000 + 1 
    10891068      it    = kt 
    10901069 
    … …  
    13311310      zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment 
    13321311      IF(lwp) WRITE(numout,*)' '   
    1333       IF(lwp) WRITE(numout,*)' Date 0 used :', nit000                  & 
     1312      IF(lwp) WRITE(numout,*)' Date 0 used :', nittrc000               & 
    13341313           &   ,' YEAR ', nyear, ' MONTH ', nmonth,' DAY ', nday       & 
    13351314           &   ,'Julian day : ', zjulian 
    … …  
    13601339            CALL dia_nam( clhstnam, nn_trd_trc, csuff ) 
    13611340            CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,                                            & 
    1362                &        1, jpi, 1, jpj, nit000, zjulian, rdt, nh_t(jn), nidtrd(jn), domain_id=nidom, snc4chunks=snc4set ) 
     1341               &        1, jpi, 1, jpj, nittrc000, zjulian, rdt, nh_t(jn), nidtrd(jn), domain_id=nidom, snc4chunks=snc4set ) 
    13631342       
    13641343            !-- Define the ML depth variable 
    … …  
    13731352          CALL dia_nam( clhstnam, nn_trd_trc, 'trdbio' ) 
    13741353          CALL histbeg( clhstnam, jpi, glamt, jpj, gphit,                                            & 
    1375              &             1, jpi, 1, jpj, nit000, zjulian, rdt, nh_tb, nidtrdbio, domain_id=nidom, snc4chunks=snc4set ) 
     1354             &             1, jpi, 1, jpj, nittrc000, zjulian, rdt, nh_tb, nidtrdbio, domain_id=nidom, snc4chunks=snc4set ) 
    13761355#endif 
    13771356 

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

    r2528 r3294  
    5050      !!---------------------------------------------------------------------- 
    5151 
    52       IF( kt == nit000 ) THEN 
     52      IF( kt == nittrc000 ) THEN 
    5353!         IF(lwp)WRITE(numout,*) 
    5454!         IF(lwp)WRITE(numout,*) 'trd_mod_trc:' 

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

    r2787 r3294  
    3333   !* IO manager * 
    3434   USE in_out_manager     
     35  
     36   !* Memory Allocation * 
     37   USE wrk_nemo       
     38  
     39   !* Timing * 
     40   USE timing     
    3541  
    3642   !* MPP library                          
    … …  
    108114   USE dom_oce , ONLY :   e3w_0      =>   e3w_0      !: reference depth of w-points (m) 
    109115   USE dom_oce , ONLY :   gdepw_0    =>   gdepw_0    !: reference depth of w-points (m) 
     116# if ! defined key_zco 
    110117   USE dom_oce , ONLY :   gdep3w     =>  gdep3w      !: ??? 
    111118   USE dom_oce , ONLY :   gdept      =>  gdept       !: depth of t-points (m) 
    … …  
    118125   USE dom_oce , ONLY :   e3uw       =>  e3uw        !: uw-points (m) 
    119126   USE dom_oce , ONLY :   e3vw       =>  e3vw        !: vw-points (m) 
    120  
     127# endif 
    121128   USE dom_oce , ONLY :   ln_zps     =>  ln_zps      !: partial steps flag 
    122129   USE dom_oce , ONLY :   ln_sco     =>  ln_sco      !: s-coordinate flag 
    … …  
    184191   USE oce , ONLY :   vn      =>    vn      !: j-horizontal velocity (m s-1) 
    185192   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) 
    188193   USE oce , ONLY :   tsn     =>    tsn     !: 4D array contaning ( tn, sn ) 
    189194   USE oce , ONLY :   tsb     =>    tsb     !: 4D array contaning ( tb, sb ) 
    … …  
    192197   USE oce , ONLY :   rhd     =>    rhd     !: in situ density anomalie rhd=(rho-rau0)/rau0 (no units) 
    193198   USE oce , ONLY :   hdivn   =>    hdivn   !: horizontal divergence (1/s) 
     199   USE oce , ONLY :   rotn    =>    rotn    !: relative vorticity    [s-1] 
     200   USE oce , ONLY :   hdivb   =>    hdivb   !: horizontal divergence (1/s) 
     201   USE oce , ONLY :   rotb    =>    rotb    !: relative vorticity    [s-1] 
     202   USE oce , ONLY :   sshn    =>    sshn    !: sea surface height at t-point [m]    
     203   USE oce , ONLY :   sshb    =>    sshb    !: sea surface height at t-point [m]    
     204   USE oce , ONLY :   ssha    =>    ssha    !: sea surface height at t-point [m]    
     205   USE oce , ONLY :   sshu_n  =>    sshu_n  !: sea surface height at u-point [m]    
     206   USE oce , ONLY :   sshu_b  =>    sshu_b  !: sea surface height at u-point [m]    
     207   USE oce , ONLY :   sshu_a  =>    sshu_a  !: sea surface height at u-point [m]    
     208   USE oce , ONLY :   sshv_n  =>    sshv_n  !: sea surface height at v-point [m]    
     209   USE oce , ONLY :   sshv_b  =>    sshv_b  !: sea surface height at v-point [m]    
     210   USE oce , ONLY :   sshv_a  =>    sshv_a  !: sea surface height at v-point [m]    
     211   USE oce , ONLY :   sshf_n  =>    sshf_n  !: sea surface height at v-point [m]    
    194212   USE oce , ONLY :   l_traldf_rot => l_traldf_rot  !: rotated laplacian operator for lateral diffusion 
    195213#if defined key_offline 
    … …  
    198216   USE oce , ONLY :   gru     =>    gru     !: 
    199217   USE oce , ONLY :   grv     =>    grv     !:  
    200 # if defined key_degrad 
    201    USE dommsk , ONLY :   facvol     =>   facvol     !: volume factor for degradation 
    202 # endif 
    203  
    204218#endif 
    205219 
    … …  
    212226   USE sbc_oce , ONLY :   qsr        =>    qsr        !: penetrative solar radiation (w m-2)   
    213227   USE sbc_oce , ONLY :   emp        =>    emp        !: freshwater budget: volume flux               [Kg/m2/s] 
     228   USE sbc_oce , ONLY :   emp_b      =>    emp_b      !: freshwater budget: volume flux               [Kg/m2/s] 
    214229   USE sbc_oce , ONLY :   emps       =>    emps       !: freshwater budget: concentration/dillution   [Kg/m2/s] 
    215230   USE sbc_oce , ONLY :   rnf        =>    rnf        !: river runoff   [Kg/m2/s] 
    … …  
    222237   USE sbcrnf  , ONLY :   rnfmsk     =>    rnfmsk     !: mixed adv scheme in runoffs vicinity (hori.)  
    223238   USE sbcrnf  , ONLY :   rnfmsk_z   =>    rnfmsk_z   !: mixed adv scheme in runoffs vicinity (vert.) 
     239   USE sbcrnf  , ONLY :   h_rnf      =>    h_rnf      !: river runoff   [Kg/m2/s] 
    224240 
    225241   USE trc_oce 
    226242 
    227243   !* 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)  
     244   USE ldftra_oce , ONLY :  rldf     =>   rldf        !: multiplicative coef. for lateral diffusivity 
     245   USE ldftra_oce , ONLY :  rn_aht_0 =>   rn_aht_0    !: horizontal eddy diffusivity for tracers (m2/s) 
     246   USE ldftra_oce , ONLY :  aht0     =>   aht0        !: horizontal eddy diffusivity for tracers (m2/s) 
     247   USE ldftra_oce , ONLY :  ahtb0    =>   ahtb0       !: background eddy diffusivity for isopycnal diff. (m2/s) 
     248   USE ldftra_oce , ONLY :  ahtu     =>   ahtu        !: lateral diffusivity coef. at u-points  
     249   USE ldftra_oce , ONLY :  ahtv     =>   ahtv        !: lateral diffusivity coef. at v-points  
     250   USE ldftra_oce , ONLY :  ahtw     =>   ahtw        !: lateral diffusivity coef. at w-points  
     251   USE ldftra_oce , ONLY :  ahtt     =>   ahtt        !: lateral diffusivity coef. at t-points 
     252   USE ldftra_oce , ONLY :  aeiv0    =>   aeiv0       !: eddy induced velocity coefficient (m2/s)  
     253   USE ldftra_oce , ONLY :  aeiu     =>   aeiu        !: eddy induced velocity coef. at u-points (m2/s)    
     254   USE ldftra_oce , ONLY :  aeiv     =>   aeiv        !: eddy induced velocity coef. at v-points (m2/s)  
     255   USE ldftra_oce , ONLY :  aeiw     =>   aeiw        !: eddy induced velocity coef. at w-points (m2/s)  
     256   USE ldftra_oce , ONLY :  lk_traldf_eiv  =>  lk_traldf_eiv     !: eddy induced velocity flag 
    238257 
    239258   !* vertical diffusion * 
    240259   USE zdf_oce , ONLY :   avt        =>   avt         !: vert. diffusivity coef. at w-point for temp   
    241260# if defined key_zdfddm 
    242    USE zdfddm  , ONLY :   avs        =>   avs        !: salinity vertical diffusivity coeff. at w-point 
     261   USE zdfddm  , ONLY :   avs        =>   avs         !: salinity vertical diffusivity coeff. at w-point 
    243262# endif 
    244263 

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

    r2715 r3294  
    6767      INTEGER                              , INTENT(in), OPTIONAL ::   kdim      ! k- direction for 4D arrays 
    6868      !! 
    69       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zmask, ztab3d  
    7069      INTEGER  ::   overlap, jn, js, sind, eind, kdir, j_id 
    7170      REAL(wp) ::   zsum, zvctl 
    7271      CHARACTER (len=20), DIMENSION(jptra) ::   cl 
    7372      CHARACTER (len=10) ::   cl2 
    74       !!---------------------------------------------------------------------- 
    75  
    76       ALLOCATE( zmask (jpi,jpj,jpk) ) 
    77       ALLOCATE( ztab3d(jpi,jpj,jpk) ) 
     73      REAL(wp), POINTER, DIMENSION(:,:,:)  :: zmask, ztab3d  
     74      !!---------------------------------------------------------------------- 
     75 
     76      CALL wrk_alloc( jpi, jpj, jpk, zmask, ztab3d ) 
    7877      !                                      ! Arrays, scalars initialization  
    7978      overlap       = 0 
    … …  
    151150      END DO 
    152151      ! 
    153       DEALLOCATE( zmask  ) 
    154       DEALLOCATE( ztab3d ) 
     152      CALL wrk_dealloc( jpi, jpj, jpk, zmask, ztab3d ) 
    155153      ! 
    156154   END SUBROUTINE prt_ctl_trc 
    … …  
    336334      INTEGER ::   nrecil, nrecjl, nldil, nleil, nldjl, nlejl 
    337335      REAL(wp) ::   zidom, zjdom            ! temporary scalars 
    338       INTEGER, DIMENSION(:,:), ALLOCATABLE ::   iimpptl, ijmpptl, ilcitl, ilcjtl   ! temporary workspace 
    339       !!---------------------------------------------------------------------- 
    340  
     336      INTEGER, POINTER, DIMENSION(:,:) ::   iimpptl, ijmpptl, ilcitl, ilcjtl   ! temporary workspace 
     337      !!---------------------------------------------------------------------- 
     338      ! 
     339      CALL wrk_alloc( isplt, jsplt, ilcitl, ilcjtl, iimpptl, ijmpptl ) 
     340      ! 
    341341      ! Dimension arrays for subdomains 
    342342      ! ------------------------------- 
    … …  
    350350      ijpj = ( jpjglo-2*jprecj + (jsplt-1) ) / jsplt + 2*jprecj 
    351351 
    352       ALLOCATE( ilcitl (isplt,jsplt) ) 
    353       ALLOCATE( ilcjtl (isplt,jsplt) ) 
    354  
    355352      nrecil  = 2 * jpreci 
    356353      nrecjl  = 2 * jprecj 
    … …  
    391388      ! --------------------------- 
    392389 
    393       ALLOCATE( iimpptl(isplt,jsplt) ) 
    394       ALLOCATE( ijmpptl(isplt,jsplt) ) 
    395        
    396390      iimpptl(:,:) = 1 
    397391      ijmpptl(:,:) = 1 
    … …  
    450444         nlejtl(js) = nlejl 
    451445      END DO 
    452  
    453       DEALLOCATE( iimpptl ) 
    454       DEALLOCATE( ijmpptl ) 
    455       DEALLOCATE( ilcitl ) 
    456       DEALLOCATE( ilcjtl ) 
     446      ! 
     447      CALL wrk_dealloc( isplt, jsplt, ilcitl, ilcjtl, iimpptl, ijmpptl ) 
    457448      ! 
    458449   END SUBROUTINE sub_dom 

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

    r2715 r3294  
    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        !: logicla unit for the passive tracer NAMELIST 
     26   INTEGER, PUBLIC                                                 ::   numstr        !: logical unit for tracer statistics 
    3527 
    3628   !! passive tracers fields (before,now,after) 
    3729   !! -------------------------------------------------- 
    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 
     30   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)               ::  trai           !: initial total tracer 
     31   REAL(wp), PUBLIC                                                ::  areatot        !: total volume  
     32   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  )         ::  cvol           !: volume correction -degrad option-  
     33   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  trn            !: traceur concentration for now time step 
     34   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  tra            !: traceur concentration for next time step 
     35   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)         ::  trb            !: traceur concentration for before time step 
    4436 
    4537   !! interpolated gradient 
    4638   !!--------------------------------------------------   
    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 
     39   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)           ::  gtru           !: hor. gradient at u-points at bottom ocean level 
     40   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)           ::  gtrv           !: hor. gradient at v-points at bottom ocean level 
    4941    
    50    !! passive tracers restart (input and output) 
     42   !! passive tracers (input and output) 
    5143   !! ------------------------------------------   
    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     
     44   LOGICAL             , PUBLIC                                    ::  ln_rsttr       !: boolean term for restart i/o for passive tracers (namelist) 
     45   LOGICAL             , PUBLIC                                    ::  lrst_trc       !: logical to control the trc restart write 
     46   INTEGER             , PUBLIC                                    ::  nn_dttrc       !: frequency of step on passive tracers 
     47   INTEGER             , PUBLIC                                    ::  nn_writetrc    !: time step frequency for concentration outputs (namelist) 
     48   INTEGER             , PUBLIC                                    ::  nutwrs         !: output FILE for passive tracers restart 
     49   INTEGER             , PUBLIC                                    ::  nutrst         !: logical unit for restart FILE for passive tracers 
     50   INTEGER             , PUBLIC                                    ::  nn_rsttr       !: control of the time step ( 0 or 1 ) for pass. tr. 
     51   CHARACTER(len = 80) , PUBLIC                                    ::  cn_trcrst_in   !: suffix of pass. tracer restart name (input) 
     52   CHARACTER(len = 80) , PUBLIC                                    ::  cn_trcrst_out  !: suffix of pass. tracer restart name (output) 
     53   REAL(wp)            , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)   ::  rdttrc         !: vertical profile of passive tracer time step 
     54   LOGICAL             , PUBLIC                                    ::  ln_trcdta      !: Read inputs data from files 
     55   LOGICAL             , PUBLIC                                    ::  ln_trcdmp      !: internal damping flag 
     56   INTEGER             , PUBLIC                                    ::  nittrc000       !: first time step of passive tracers model 
     57 
    6158   !! information for outputs 
    6259   !! -------------------------------------------------- 
    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 
     60   TYPE, PUBLIC :: PTRACER                                                            !: Passive tracer type 
     61       CHARACTER(len = 20)  :: clsname  !: short name 
     62       CHARACTER(len = 80)  :: cllname  !: long name 
     63       CHARACTER(len = 20)  :: clunit   !: unit 
     64       LOGICAL              :: llinit   !: read in a file or not 
     65       LOGICAL              :: llsave   !: save the tracer or not 
     66   END TYPE PTRACER 
     67   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ctrcnm         !: tracer name  
     68   CHARACTER(len = 80), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ctrcln         !: trccer field long name 
     69   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ctrcun         !: tracer unit 
     70   LOGICAL            , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ln_trc_ini     !: Initialisation from data input file 
     71   LOGICAL            , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)    ::  ln_trc_wri     !: save the tracer or not 
     72 
     73   TYPE, PUBLIC :: DIAG                                                               !: passive trcacer ddditional diagnostic type 
     74      CHARACTER(len = 20)  :: sname    !: short name 
     75      CHARACTER(len = 80)  :: lname    !: long name 
     76      CHARACTER(len = 20)  :: units    !: unit 
     77   END TYPE DIAG 
     78 
    6779   !! additional 2D/3D outputs namelist 
    6880   !! -------------------------------------------------- 
    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 
    76  
    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 
     81   REAL(wp)           , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,  :) ::   trc2d         !: additional 2d outputs array  
     82   REAL(wp)           , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   trc3d         !: additional 3d outputs array  
     83   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   ctrc2d        !: 2d field short name 
     84   CHARACTER(len = 80), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   ctrc2l        !: 2d field long name 
     85   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   ctrc2u        !: 2d field unit 
     86   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   ctrc3d        !: 3d field short name 
     87   CHARACTER(len = 80), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   ctrc3l        !: 3d field long name 
     88   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::   ctrc3u        !: 3d field unit 
     89   LOGICAL            , PUBLIC                                        ::  ln_diatrc      !: boolean term for additional diagnostic 
     90   INTEGER            , PUBLIC                                        ::  nn_writedia    !: frequency of additional outputs 
     91 
    8992   !! Biological trends 
    9093   !! ----------------- 
    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 
     94   LOGICAL            , PUBLIC                                        ::  ln_diabio      !: boolean term for biological diagnostic 
     95   INTEGER            , PUBLIC                                        ::  nn_writebio    !: frequency of biological outputs 
     96   REAL(wp)           , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  trbio          !: biological trends 
     97   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  ctrbio         !: bio field short name 
     98   CHARACTER(len = 80), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  ctrbil         !: bio field long name 
     99   CHARACTER(len = 20), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  ctrbiu         !: bio field unit 
     100 
     101   !! variables to average over physics over passive tracer sub-steps. 
     102   !! ---------------------------------------------------------------- 
     103   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  un_tm       !: i-horizontal velocity average     [m/s] 
     104   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  vn_tm       !: j-horizontal velocity average     [m/s] 
     105   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  tsn_tm      !: t/s average     [m/s] 
     106   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  avt_tm      !: vertical diffusivity coeff. at  w-point   [m2/s] 
     107   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  rhop_tm     !:  
     108# if defined key_zdfddm 
     109   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  avs_tm      !: vertical double diffusivity coeff. at w-point   [m/s] 
     110# endif 
     111#if defined key_ldfslp 
     112   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  wslpi_tm    !: i-direction slope at u-, w-points 
     113   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  wslpj_tm    !: j-direction slope at u-, w-points 
     114   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  uslp_tm     !: j-direction slope at u-, w-points 
     115   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  vslp_tm     !: j-direction slope at u-, w-points 
     116#endif 
     117#if defined key_trabbl 
     118   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  ahu_bbl_tm  !: u-, w-points 
     119   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  ahv_bbl_tm  !: j-direction slope at u-, w-points 
     120   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  utr_bbl_tm  !: j-direction slope at u-, w-points 
     121   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  vtr_bbl_tm  !: j-direction slope at u-, w-points 
     122#endif 
     123   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshn_tm     !: average ssh for the now step [m] 
     124   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshu_n_tm   !: average ssh for the now step [m] 
     125   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshv_n_tm   !: average ssh for the now step [m] 
     126   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshb_hold   !:hold sshb from the beginning of each sub-stepping[m]   
     127   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshu_b_hold !:hold sshb from the beginning of each sub-stepping[m]   
     128   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshv_b_hold !:hold sshb from the beginning of each sub-stepping[m]  
     129 
     130   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  rnf_tm     !: river runoff 
     131   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  h_rnf_tm   !: depth in metres to the bottom of the relevant grid box 
     132   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  hmld_tm    !: mixed layer depth average [m] 
     133   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  fr_i_tm    !: average ice fraction     [m/s] 
     134   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  emp_tm     !: freshwater budget: volume flux [Kg/m2/s] 
     135   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  emps_tm    !: freshwater budget:concentration/dilution [Kg/m2/s] 
     136   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  emp_b_hold !: hold emp from the beginning of each sub-stepping[m]   
     137   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  qsr_tm     !: solar radiation average [m] 
     138   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  wndm_tm    !: 10m wind average [m] 
     139   ! 
     140#if defined key_traldf_c3d 
     141   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  ahtt_tm, ahtu_tm, ahtv_tm, ahtw_tm   !: ** 3D coefficients ** at T-,U-,V-,W-points 
     142#elif defined key_traldf_c2d 
     143   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  ahtt_tm, ahtu_tm, ahtv_tm, ahtw_tm   !: ** 2D coefficients ** at T-,U-,V-,W-points 
     144#elif defined key_traldf_c1d 
     145   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  ahtt_tm, ahtu_tm, ahtv_tm, ahtw_tm   !: ** 1D coefficients ** at T-,U-,V-,W-points 
     146#else 
     147   REAL(wp), PUBLIC                                        ::  ahtt_tm, ahtu_tm, ahtv_tm, ahtw_tm   !: ** 0D coefficients ** at T-,U-,V-,W-points 
     148#endif 
     149   ! 
     150#if defined key_traldf_eiv 
     151#  if defined key_traldf_c3d 
     152   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  aeiu_tm , aeiv_tm , aeiw_tm   !: ** 3D coefficients ** 
     153#  elif defined key_traldf_c2d 
     154   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  aeiu_tm , aeiv_tm , aeiw_tm   !: ** 2D coefficients ** 
     155#  elif defined key_traldf_c1d 
     156   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  aeiu_tm , aeiv_tm, aeiw_tm   !: ** 1D coefficients ** 
     157#  else 
     158   REAL(wp), PUBLIC                                        ::  aeiu_tm , aeiv_tm , aeiw_tm   !: ** 0D coefficients ** 
     159#  endif 
     160#endif 
     161 
     162   ! Temporary physical arrays for sub_stepping 
     163   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  tsn_temp 
     164   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  un_temp,vn_temp,wn_temp     !: hold current values of avt, un, vn, wn 
     165   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  avt_temp, rhop_temp     !: hold current values of avt, un, vn, wn 
     166   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  e3t_temp,e3u_temp,e3v_temp,e3w_temp     !: hold current values 
     167   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshn_temp, sshb_temp, ssha_temp, rnf_temp,h_rnf_temp 
     168   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshu_n_temp, sshu_b_temp, sshu_a_temp 
     169   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshf_n_temp 
     170   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  sshv_n_temp, sshv_b_temp, sshv_a_temp 
     171   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  hu_temp, hv_temp, hur_temp, hvr_temp 
     172   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  hdivn_temp, rotn_temp 
     173   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  hdivb_temp, rotb_temp 
     174   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  hmld_temp, qsr_temp, fr_i_temp,wndm_temp 
     175   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  emp_temp, emps_temp, emp_b_temp 
     176   ! 
     177#if defined key_trabbl 
     178   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  ahu_bbl_temp, ahv_bbl_temp, utr_bbl_temp, vtr_bbl_temp !: hold current values  
     179#endif 
     180   ! 
     181#if defined key_ldfslp 
     182   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  wslpi_temp, wslpj_temp, uslp_temp, vslp_temp    !: hold current values  
     183#endif 
     184   !  
     185# if defined key_zdfddm 
     186   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  avs_temp      !: salinity vertical diffusivity coeff. at w-point   [m/s] 
     187# endif 
     188   ! 
     189#if defined key_traldf_c3d 
     190   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  ahtt_temp, ahtu_temp, ahtv_temp, ahtw_temp    
     191#elif defined key_traldf_c2d 
     192   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  ahtt_temp, ahtu_temp, ahtv_temp, ahtw_temp   
     193#elif defined key_traldf_c1d 
     194   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  ahtt_temp, ahtu_temp, ahtv_temp, ahtw_temp  
     195#else 
     196   REAL(wp), PUBLIC                                        ::  ahtt_temp, ahtu_temp, ahtv_temp, ahtw_temp 
     197#endif 
     198   ! 
     199#if defined key_traldf_eiv 
     200# if defined key_traldf_c3d 
     201   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  aeiu_temp , aeiv_temp , aeiw_temp   !: ** 3D coefficients ** 
     202# elif defined key_traldf_c2d 
     203   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)     ::  aeiu_temp , aeiv_temp , aeiw_temp   !: ** 2D coefficients ** 
     204# elif defined key_traldf_c1d 
     205   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)       ::  aeiu_temp , aeiv_temp, aeiw_temp   !: ** 1D coefficients ** 
     206# else 
     207   REAL(wp), PUBLIC                                        ::  aeiu_temp , aeiv_temp , aeiw_temp   !: ** 0D coefficients ** 
     208# endif 
    99209# endif 
    100210 
    … …  
    113223      !!------------------------------------------------------------------- 
    114224      ! 
    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 )       
     225      ALLOCATE( trn(jpi,jpj,jpk,jptra), trb(jpi,jpj,jpk,jptra), tra(jpi,jpj,jpk,jptra),       &   
     226         &      gtru(jpi,jpj,jpk)     , gtrv(jpi,jpj,jpk)                             ,       & 
     227         &      cvol(jpi,jpj,jpk)     , rdttrc(jpk)           , trai(jptra)           ,       & 
     228         &      ctrcnm(jptra)         , ctrcln(jptra)         , ctrcun(jptra)         ,       &  
     229         &      ln_trc_ini(jptra)     , ln_trc_wri(jptra)                             ,  STAT = trc_alloc  )   
    127230 
    128231      IF( trc_alloc /= 0 )   CALL ctl_warn('trc_alloc: failed to allocate arrays') 

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

    r2715 r3294  
    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   ! 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 == nittrc000 )  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 )      ! outputs for tracer concentration 
     82         IF( ln_diatrc )  CALL trcdii_wr( kt )      ! outputs for additional arrays 
     83         IF( ln_diabio )  CALL trcdib_wr( kt )      ! outputs for biological trends 
     84      ENDIF 
    7785      ! 
    7886   END SUBROUTINE trc_dia 
    7987 
    8088 
    81    SUBROUTINE trcdit_wr( kt, kindic ) 
     89   SUBROUTINE trcdit_wr( kt ) 
    8290      !!---------------------------------------------------------------------- 
    8391      !!                     ***  ROUTINE trcdit_wr  *** 
    … …  
    8593      !! ** Purpose :   Standard output of passive tracer : concentration fields 
    8694      !! 
    87       !! ** Method  :   At the beginning of the first time step (nit000), define all 
     95      !! ** Method  :   At the beginning of the first time step (nittrc000), define all 
    8896      !!             the NETCDF files and fields for concentration of passive tracer 
    8997      !! 
    … …  
    9199      !!        Each nwritetrc time step, output the instantaneous or mean fields 
    92100      !! 
    93       !!        IF kindic <0, output of fields before the model interruption. 
    94       !!        IF kindic =0, time step loop 
    95       !!        IF kindic >0, output of fields before the time step loop 
    96101      !!---------------------------------------------------------------------- 
    97102      INTEGER, INTENT(in) ::   kt       ! ocean time-step 
    98       INTEGER, INTENT(in) ::   kindic   ! indicator of abnormal termination 
    99103      ! 
    100104      INTEGER ::   jn 
    … …  
    135139 
    136140      ! define time axis 
    137       itmod = kt - nit000 + 1 
     141      itmod = kt - nittrc000 + 1 
    138142      it    = kt 
    139       iiter = ( nit000 - 1 ) / nn_dttrc 
     143      iiter = ( nittrc000 - 1 ) / nn_dttrc 
    140144 
    141145      ! Define NETCDF files and fields at beginning of first time step 
    142146      ! -------------------------------------------------------------- 
    143147 
    144       IF(ll_print)WRITE(numout,*)'trcdit_wr kt=',kt,' kindic ',kindic 
     148      IF(ll_print)WRITE(numout,*)'trcdit_wr kt=',kt 
    145149       
    146       IF( kt == nit000 ) THEN 
     150      IF( kt == nittrc000 ) THEN 
     151 
     152         IF(lwp) THEN                   ! control print 
     153            WRITE(numout,*) 
     154            WRITE(numout,*) '    frequency of outputs for passive tracers nn_writetrc = ', nn_writetrc 
     155            DO jn = 1, jptra 
     156               IF( ln_trc_wri(jn) )  WRITE(numout,*) ' ouput tracer nb : ', jn, '    short name : ', ctrcnm(jn)  
     157            END DO 
     158            WRITE(numout,*) ' ' 
     159         ENDIF 
    147160 
    148161         ! Compute julian date from starting date of the run 
    … …  
    150163         zjulian = zjulian - adatrj   !   set calendar origin to the beginning of the experiment 
    151164         IF(lwp)WRITE(numout,*)' '   
    152          IF(lwp)WRITE(numout,*)' Date 0 used :', nit000                         & 
     165         IF(lwp)WRITE(numout,*)' Date 0 used :', nittrc000                         & 
    153166            &                 ,' YEAR ', nyear, ' MONTH ', nmonth, ' DAY ', nday   & 
    154167            &                 ,'Julian day : ', zjulian   
    … …  
    182195         ! Declare all the output fields as NETCDF variables 
    183196         DO jn = 1, jptra 
    184             IF( lutsav(jn) ) THEN 
     197            IF( ln_trc_wri(jn) ) THEN 
    185198               cltra  = TRIM( ctrcnm(jn) )   ! short title for tracer 
    186                cltral = TRIM( ctrcnl(jn) )   ! long title for tracer 
     199               cltral = TRIM( ctrcln(jn) )   ! long title for tracer 
    187200               cltrau = TRIM( ctrcun(jn) )   ! UNIT for tracer 
    188201               CALL histdef( nit5, cltra, cltral, cltrau, jpi, jpj, nhorit5,  & 
    … …  
    209222      DO jn = 1, jptra 
    210223         cltra  = TRIM( ctrcnm(jn) )   ! short title for tracer 
    211          IF( lutsav(jn) ) CALL histwrite( nit5, cltra, it, trn(:,:,:,jn), ndimt50, ndext50 ) 
     224         IF( ln_trc_wri(jn) ) CALL histwrite( nit5, cltra, it, trn(:,:,:,jn), ndimt50, ndext50 ) 
    212225      END DO 
    213226 
    214227      ! close the file  
    215228      ! -------------- 
    216       IF( kt == nitend .OR. kindic < 0 )   CALL histclo( nit5 ) 
     229      IF( kt == nitend )   CALL histclo( nit5 ) 
    217230      ! 
    218231   END SUBROUTINE trcdit_wr 
    219232 
    220 #if defined key_diatrc 
    221  
    222    SUBROUTINE trcdii_wr( kt, kindic ) 
     233   SUBROUTINE trcdii_wr( kt ) 
    223234      !!---------------------------------------------------------------------- 
    224235      !!                     ***  ROUTINE trcdii_wr  *** 
    … …  
    226237      !! ** Purpose :   output of passive tracer : additional 2D and 3D arrays 
    227238      !! 
    228       !! ** Method  :   At the beginning of the first time step (nit000), define all 
     239      !! ** Method  :   At the beginning of the first time step (nittrc000), define all 
    229240      !!             the NETCDF files and fields for concentration of passive tracer 
    230241      !! 
    … …  
    232243      !!        Each nn_writedia time step, output the instantaneous or mean fields 
    233244      !! 
    234       !!        IF kindic <0, output of fields before the model interruption. 
    235       !!        IF kindic =0, time step loop 
    236       !!        IF kindic >0, output of fields before the time step loop 
    237245      !!---------------------------------------------------------------------- 
    238246      INTEGER, INTENT(in) ::   kt       ! ocean time-step 
    239       INTEGER, INTENT(in) ::   kindic   ! indicator of abnormal termination 
    240247      !! 
    241248      LOGICAL ::   ll_print = .FALSE. 
    … …  
    275282 
    276283      ! define time axis 
    277       itmod = kt - nit000 + 1 
     284      itmod = kt - nittrc000 + 1 
    278285      it    = kt 
    279       iiter = ( nit000 - 1 ) / nn_dttrc 
     286      iiter = ( nittrc000 - 1 ) / nn_dttrc 
    280287 
    281288      ! 1. Define NETCDF files and fields at beginning of first time step 
    282289      ! ----------------------------------------------------------------- 
    283290 
    284       IF( ll_print ) WRITE(numout,*) 'trcdii_wr kt=', kt, ' kindic ', kindic 
    285  
    286       IF( kt == nit000 ) THEN 
     291      IF( ll_print ) WRITE(numout,*) 'trcdii_wr kt=', kt 
     292 
     293      IF( kt == nittrc000 ) THEN 
    287294 
    288295         ! Define the NETCDF files for additional arrays : 2D or 3D 
    … …  
    356363      ! Closing all files 
    357364      ! ----------------- 
    358       IF( kt == nitend .OR. kindic < 0 )   CALL histclo(nitd) 
     365      IF( kt == nitend )   CALL histclo(nitd) 
    359366      ! 
    360367 
    361368   END SUBROUTINE trcdii_wr 
    362369 
    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 
    370  
    371    SUBROUTINE trcdib_wr( kt, kindic ) 
     370   SUBROUTINE trcdib_wr( kt ) 
    372371      !!---------------------------------------------------------------------- 
    373372      !!                     ***  ROUTINE trcdib_wr  *** 
    … …  
    375374      !! ** Purpose :   output of passive tracer : biological fields 
    376375      !! 
    377       !! ** Method  :   At the beginning of the first time step (nit000), define all 
     376      !! ** Method  :   At the beginning of the first time step (nittrc000), define all 
    378377      !!             the NETCDF files and fields for concentration of passive tracer 
    379378      !! 
    … …  
    381380      !!        Each nn_writebio time step, output the instantaneous or mean fields 
    382381      !! 
    383       !!        IF kindic <0, output of fields before the model interruption. 
    384       !!        IF kindic =0, time step loop 
    385       !!        IF kindic >0, output of fields before the time step loop 
    386382      !!---------------------------------------------------------------------- 
    387383      INTEGER, INTENT( in ) ::   kt          ! ocean time-step 
    388       INTEGER, INTENT( in ) ::   kindic      ! indicator of abnormal termination 
    389384      !! 
    390385      LOGICAL ::   ll_print = .FALSE. 
    … …  
    424419 
    425420      ! define time axis 
    426       itmod = kt - nit000 + 1 
     421      itmod = kt - nittrc000 + 1 
    427422      it    = kt 
    428       iiter = ( nit000 - 1 ) / nn_dttrc 
     423      iiter = ( nittrc000 - 1 ) / nn_dttrc 
    429424 
    430425      ! Define NETCDF files and fields at beginning of first time step 
    431426      ! -------------------------------------------------------------- 
    432427 
    433       IF(ll_print) WRITE(numout,*)'trcdib_wr kt=',kt,' kindic ',kindic 
    434  
    435       IF( kt == nit000 ) THEN 
     428      IF(ll_print) WRITE(numout,*)'trcdib_wr kt=',kt 
     429 
     430      IF( kt == nittrc000 ) THEN 
    436431 
    437432         ! Define the NETCDF files for biological trends 
    … …  
    481476      ! Closing all files 
    482477      ! ----------------- 
    483       IF( kt == nitend .OR. kindic < 0 )   CALL histclo( nitb ) 
     478      IF( kt == nitend )   CALL histclo( nitb ) 
    484479      ! 
    485480   END SUBROUTINE trcdib_wr 
    486481 
    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 
    504482#else 
    505483   !!---------------------------------------------------------------------- 

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

    r2715 r3294  
    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      IF( nn_timing == 1 )  CALL timing_start('trc_dta_init') 
     69      ! 
     70      !  Initialisation 
     71      ierr0 = 0  ;  ierr1 = 0  ;  ierr2 = 0  ;  ierr3 = 0   
     72      ! Compute the number of tracers to be initialised with data 
     73      ALLOCATE( n_trc_index(jptra), STAT=ierr0 ) 
     74      IF( ierr0 > 0 ) THEN 
     75         CALL ctl_stop( 'trc_nam: unable to allocate n_trc_index' )   ;   RETURN 
     76      ENDIF 
     77      nb_trcdta      = 0 
     78      n_trc_index(:) = 0 
     79      DO jn = 1, jptra 
     80         IF( ln_trc_ini(jn) ) THEN 
     81             nb_trcdta       = nb_trcdta + 1  
     82             n_trc_index(jn) = nb_trcdta  
     83         ENDIF 
     84      ENDDO 
     85      ! 
     86      ntra = MAX( 1, nb_trcdta )   ! To avoid compilation error with bounds checking 
     87      WRITE(numout,*) ' ' 
     88      WRITE(numout,*) ' number of passive tracers to be initialize by data :', ntra 
     89      WRITE(numout,*) ' ' 
     90      !                         ! allocate the arrays (if necessary) 
     91      ! 
     92      cn_dir  = './'            ! directory in which the model is executed 
     93      DO jn = 1, jptra 
     94         WRITE( clndta,'("TR_",I1)' ) jn 
     95         clndta = TRIM( clndta ) 
     96         !                 !  file      ! frequency ! variable  ! time intep !  clim   ! 'yearly' or ! weights  ! rotation ! 
     97         !                 !  name      !  (hours)  !  name     !   (T/F)    !  (T/F)  !  'monthly'  ! filename ! pairs    ! 
     98         sn_trcdta(jn)  = FLD_N( clndta ,   -1      , clndta    ,  .false.   , .true.  ,  'monthly'  , ''       , ''       ) 
     99         ! 
     100         rn_trfac(jn) = 1._wp 
     101      END DO 
     102      ! 
     103      REWIND( numnat )               ! read nattrc 
     104      READ  ( numnat, namtrc_dta ) 
     105 
     106      IF( lwp ) THEN 
     107         DO jn = 1, jptra 
     108            IF( ln_trc_ini(jn) )  THEN    ! open input file only if ln_trc_ini(jn) is true 
     109               clndta = TRIM( sn_trcdta(jn)%clvar )  
     110               clntrc = TRIM( ctrcnm   (jn)       )  
     111               zfact  = rn_trfac(jn) 
     112               IF( clndta /=  clntrc ) THEN  
     113                  CALL ctl_warn( 'trc_dta_init: passive tracer data initialisation :  ',   & 
     114                  &              'the variable name in the data file : '//clndta//   &  
     115                  &              '  must be the same than the name of the passive tracer : '//clntrc//' ') 
     116               ENDIF 
     117               WRITE(numout,*) ' read an initial file for passive tracer number :', jn, ' name : ', clndta, &  
     118               &               ' multiplicative factor : ', zfact 
     119            ENDIF 
     120         END DO 
     121      ENDIF 
     122      ! 
     123      IF( nb_trcdta > 0 ) THEN       !  allocate only if the number of tracer to initialise is greater than zero 
     124         ALLOCATE( sf_trcdta(nb_trcdta), rf_trfac(nb_trcdta), STAT=ierr1 ) 
     125         IF( ierr1 > 0 ) THEN 
     126            CALL ctl_stop( 'trc_dta_ini: unable to allocate  sf_trcdta structure' )   ;   RETURN 
     127         ENDIF 
     128         ! 
     129         DO jn = 1, jptra 
     130            IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file 
     131               jl = n_trc_index(jn) 
     132               slf_i(jl)    = sn_trcdta(jn) 
     133               rf_trfac(jl) = rn_trfac(jn) 
     134                                            ALLOCATE( sf_trcdta(jl)%fnow(jpi,jpj,jpk)   , STAT=ierr2 ) 
     135               IF( sn_trcdta(jn)%ln_tint )  ALLOCATE( sf_trcdta(jl)%fdta(jpi,jpj,jpk,2) , STAT=ierr3 ) 
     136               IF( ierr2 + ierr3 > 0 ) THEN 
     137                 CALL ctl_stop( 'trc_dta : unable to allocate passive tracer data arrays' )   ;   RETURN 
     138               ENDIF 
     139            ENDIF 
     140            !    
     141         ENDDO 
     142         !                         ! fill sf_trcdta with slf_i and control print 
     143         CALL fld_fill( sf_trcdta, slf_i, cn_dir, 'trc_dta', 'Passive tracer data', 'namtrc' ) 
     144         ! 
     145      ENDIF 
     146      ! 
     147      IF( nn_timing == 1 )  CALL timing_stop('trc_dta_init') 
     148      ! 
     149   END SUBROUTINE trc_dta_init 
     150 
     151 
     152   SUBROUTINE trc_dta( kt, ptrc ) 
    46153      !!---------------------------------------------------------------------- 
    47154      !!                   ***  ROUTINE trc_dta  *** 
     155      !!                     
     156      !! ** Purpose :   provides passive tracer data at kt 
     157      !!  
     158      !! ** Method  : - call fldread routine 
     159      !!              - s- or mixed z-s coordinate: vertical interpolation on model mesh 
     160      !!              - ln_trcdmp=F: deallocates the data structure as they are not used 
    48161      !! 
    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 
     162      !! ** Action  :   ptrc   passive tracer data on medl mesh and interpolated at time-step kt 
     163      !!---------------------------------------------------------------------- 
     164      INTEGER                     , INTENT(in   ) ::   kt     ! ocean time-step 
     165      REAL(wp), DIMENSION(:,:,:,:), INTENT(  out) ::   ptrc   ! passive tracer data 
     166      ! 
     167      INTEGER ::   ji, jj, jk, jl, jn, jkk, ik    ! dummy loop indicies 
     168      REAL(wp)::   zl, zi 
     169      REAL(wp), DIMENSION(jpk) ::  ztp                ! 1D workspace 
     170      CHARACTER(len=100) :: clndta 
     171      !!---------------------------------------------------------------------- 
     172      ! 
     173      IF( nn_timing == 1 )  CALL timing_start('trc_dta') 
     174      ! 
     175      IF( nb_trcdta > 0 ) THEN 
     176         ! 
     177         CALL fld_read( kt, 1, sf_trcdta )      !==   read data at kt time step   ==! 
     178         ! 
     179         DO jn = 1, ntra 
     180            ptrc(:,:,:,jn) = sf_trcdta(jn)%fnow(:,:,:)    ! NO mask 
     181         ENDDO 
     182         ! 
     183         IF( ln_sco ) THEN                   !==   s- or mixed s-zps-coordinate   ==! 
     184            ! 
     185            IF( kt == nit000 .AND. lwp )THEN 
     186               WRITE(numout,*) 
     187               WRITE(numout,*) 'trc_dta: interpolates passive tracer data onto the s- or mixed s-z-coordinate mesh' 
    80188            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,*) 
     189            ! 
     190            DO jn = 1, ntra 
     191               DO jj = 1, jpj                         ! vertical interpolation of T & S 
     192                  DO ji = 1, jpi 
     193                     DO jk = 1, jpk                        ! determines the intepolated T-S profiles at each (i,j) points 
     194                        zl = fsdept_0(ji,jj,jk) 
     195                        IF(     zl < gdept_0(1  ) ) THEN          ! above the first level of data 
     196                           ztp(jk) =  ptrc(ji,jj,1    ,jn) 
     197                        ELSEIF( zl > gdept_0(jpk) ) THEN          ! below the last level of data 
     198                           ztp(jk) =  ptrc(ji,jj,jpkm1,jn) 
     199                        ELSE                                      ! inbetween : vertical interpolation between jkk & jkk+1 
     200                           DO jkk = 1, jpkm1                                  ! when  gdept(jkk) < zl < gdept(jkk+1) 
     201                              IF( (zl-gdept_0(jkk)) * (zl-gdept_0(jkk+1)) <= 0._wp ) THEN 
     202                                 zi = ( zl - gdept_0(jkk) ) / (gdept_0(jkk+1)-gdept_0(jkk)) 
     203                                 ztp(jk) = ptrc(ji,jj,jkk,jn) + ( ptrc(ji,jj,jkk+1,jn) - ptrc(ji,jj,jkk,jn) ) * zi  
     204                              ENDIF 
     205                           END DO 
     206                        ENDIF 
     207                     END DO 
     208                     DO jk = 1, jpkm1 
     209                        ptrc(ji,jj,jk,jn) = ztp(jk) * tmask(ji,jj,jk)     ! mask required for mixed zps-s-coord 
     210                     END DO 
     211                     ptrc(ji,jj,jpk,jn) = 0._wp 
     212                  END DO 
     213               END DO 
     214            ENDDO  
     215            !  
     216         ELSE                                !==   z- or zps- coordinate   ==! 
     217            !                              
     218            DO jn = 1, ntra 
     219               ptrc(:,:,:,jn) = ptrc(:,:,:,jn) * tmask(:,:,:)    ! Mask 
     220               ! 
     221               IF( ln_zps ) THEN                      ! zps-coordinate (partial steps) interpolation at the last ocean level 
     222                  DO jj = 1, jpj 
     223                     DO ji = 1, jpi 
     224                        ik = mbkt(ji,jj)  
     225                        IF( ik > 1 ) THEN 
     226                           zl = ( gdept_0(ik) - fsdept_0(ji,jj,ik) ) / ( gdept_0(ik) - gdept_0(ik-1) ) 
     227                           ptrc(ji,jj,ik,jn) = (1.-zl) * ptrc(ji,jj,ik,jn) + zl * ptrc(ji,jj,ik-1,jn) 
     228                        ENDIF 
     229                     END DO 
     230                  END DO 
    132231               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) 
     232            ENDDO  
     233            ! 
     234         ENDIF 
     235         ! 
     236         DO jn = 1, ntra 
     237            ptrc(:,:,:,jn) = ptrc(:,:,:,jn) * rf_trfac(jn)   !  multiplicative factor 
     238         ENDDO  
     239         ! 
     240         IF( lwp .AND. kt == nit000 ) THEN 
     241            DO jn = 1, ntra 
     242               clndta = TRIM( sf_trcdta(jn)%clvar )  
     243               WRITE(numout,*) ''//clndta//' data ' 
    157244               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 
     245               WRITE(numout,*)'  level = 1' 
     246               CALL prihre( ptrc(:,:,1    ,jn), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
     247               WRITE(numout,*)'  level = ', jpk/2 
     248               CALL prihre( ptrc(:,:,jpk/2,jn), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
     249               WRITE(numout,*)'  level = ', jpkm1 
     250               CALL prihre( ptrc(:,:,jpkm1,jn), jpi, jpj, 1, jpi, 20, 1, jpj, 20, 1., numout ) 
     251               WRITE(numout,*) 
     252            ENDDO 
     253         ENDIF 
     254         ! 
     255         IF( .NOT.ln_trcdmp ) THEN                   !==   deallocate data structure   ==!  
     256            !                                              (data used only for initialisation) 
     257            IF(lwp) WRITE(numout,*) 'trc_dta: deallocate data arrays as they are only use to initialize the run' 
     258            DO jn = 1, ntra 
     259                                             DEALLOCATE( sf_trcdta(jn)%fnow )     !  arrays in the structure 
     260               IF( sf_trcdta(jn)%ln_tint )   DEALLOCATE( sf_trcdta(jn)%fdta ) 
     261            ENDDO 
     262                                             DEALLOCATE( sf_trcdta          )     ! the structure itself 
     263            ! 
     264         ENDIF 
     265         ! 
     266      ENDIF 
     267      !  
     268      IF( nn_timing == 1 )  CALL timing_stop('trc_dta') 
    198269      ! 
    199270   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  
    214271#else 
    215272   !!---------------------------------------------------------------------- 
    216273   !!   Dummy module                              NO 3D passive tracer data 
    217274   !!---------------------------------------------------------------------- 
    218    LOGICAL , PUBLIC, PARAMETER ::   lk_dtatrc = .FALSE.   !: temperature data flag 
    219275CONTAINS 
    220276   SUBROUTINE trc_dta( kt )        ! Empty routine 
    … …  
    222278   END SUBROUTINE trc_dta 
    223279#endif 
    224  
    225280   !!====================================================================== 
    226281END MODULE trcdta 

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

    r2715 r3294  
    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) 
     31   USE trcsub       ! variables to substep passive tracers 
    3132    
    3233   IMPLICIT NONE 
    … …  
    5657      !!                or read data or analytical formulation 
    5758      !!--------------------------------------------------------------------- 
    58       INTEGER ::   jk, jn    ! dummy loop indices 
     59      INTEGER ::   jk, jn, jl    ! dummy loop indices 
    5960      CHARACTER (len=25) :: charout 
     61      REAL(wp), POINTER, DIMENSION(:,:,:,:) ::  ztrcdta   ! 4D  workspace 
    6062      !!--------------------------------------------------------------------- 
    61  
     63      ! 
     64      IF( nn_timing == 1 )   CALL timing_start('trc_init') 
     65      ! 
    6266      IF(lwp) WRITE(numout,*) 
    6367      IF(lwp) WRITE(numout,*) 'trc_init : initial set up of the passive tracers' 
    … …  
    6670      CALL top_alloc()              ! allocate TOP arrays 
    6771 
    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 
     72      IF( ln_dm2dc .AND. ( lk_pisces .OR. lk_lobster ) )    & 
     73         &  CALL ctl_stop( ' The diurnal cycle is not compatible with PISCES or LOBSTER  ' ) 
     74 
     75      IF( nn_cla == 1 )   & 
     76         &  CALL ctl_stop( ' Cross Land Advection not yet implemented with passive tracer ; nn_cla must be 0' ) 
    7977 
    8078      CALL trc_nam                  ! read passive tracers namelists 
    81  
    82       !                             ! restart for passive tracer (input) 
     79      ! 
     80      IF(lwp) WRITE(numout,*) 
    8381      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' ) 
    101  
    102       IF( lk_lobster ) THEN   ;   CALL trc_ini_lobster      ! LOBSTER bio-model 
    103       ELSE                    ;   IF(lwp) WRITE(numout,*) '          LOBSTER not used' 
    104       ENDIF 
    105        
    106       IF( lk_pisces  ) THEN   ;   CALL trc_ini_pisces       ! PISCES  bio-model 
    107       ELSE                    ;   IF(lwp) WRITE(numout,*) '          PISCES not used' 
    108       ENDIF 
    109        
    110       IF( lk_cfc     ) THEN   ;   CALL trc_ini_cfc          ! CFC     tracers 
    111       ELSE                    ;   IF(lwp) WRITE(numout,*) '          CFC not used' 
    112       ENDIF 
    113  
    114       IF( lk_c14b    ) THEN   ;   CALL trc_ini_c14b         ! C14 bomb  tracer 
    115       ELSE                    ;   IF(lwp) WRITE(numout,*) '          C14 not used' 
    116       ENDIF 
    117        
    118       IF( lk_my_trc  ) THEN   ;   CALL trc_ini_my_trc       ! MY_TRC  tracers 
    119       ELSE                    ;   IF(lwp) WRITE(numout,*) '          MY_TRC not used' 
    120       ENDIF 
    121  
    122       IF( ln_rsttr ) THEN 
    12382        ! 
    12483        IF( lk_offline )  neuler = 1   ! Set time-step indicator at nit000 (leap-frog) 
    125         CALL trc_rst_read              ! restart from a file 
     84        CALL trc_rst_cal( nittrc000, 'READ' )   ! calendar 
    12685        ! 
    12786      ELSE 
    … …  
    13089           CALL day_init               ! set calendar 
    13190        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 
     91        ! 
     92      ENDIF 
     93      IF(lwp) WRITE(numout,*) 
     94                                                              ! masked grid volume 
     95      !                                                              ! masked grid volume 
     96      DO jk = 1, jpk 
     97         cvol(:,:,jk) = e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk) 
     98      END DO 
     99      IF( lk_degrad ) cvol(:,:,:) = cvol(:,:,:) * facvol(:,:,:)      ! degrad option: reduction by facvol 
     100      !                                                              ! total volume of the ocean  
     101      areatot = glob_sum( cvol(:,:,:) ) 
     102 
     103      IF( lk_lobster )       CALL trc_ini_lobster      ! LOBSTER bio-model 
     104      IF( lk_pisces  )       CALL trc_ini_pisces       ! PISCES  bio-model 
     105      IF( lk_cfc     )       CALL trc_ini_cfc          ! CFC     tracers 
     106      IF( lk_c14b    )       CALL trc_ini_c14b         ! C14 bomb  tracer 
     107      IF( lk_my_trc  )       CALL trc_ini_my_trc       ! MY_TRC  tracers 
     108 
     109      IF( lwp ) THEN 
     110         ! 
     111         CALL ctl_opn( numstr, 'tracer.stat', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, 6, .FALSE., narea ) 
     112         ! 
     113      ENDIF 
     114 
     115      IF( ln_trcdta )      CALL trc_dta_init 
     116 
     117 
     118      IF( ln_rsttr ) THEN 
     119        ! 
     120        CALL trc_rst_read              ! restart from a file 
     121        ! 
     122      ELSE 
     123        ! 
     124        IF( ln_trcdta .AND. nb_trcdta > 0 ) THEN  ! Initialisation of tracer from a file that may also be used for damping 
     125            ! 
     126            CALL wrk_alloc( jpi, jpj, jpk, nb_trcdta, ztrcdta )    ! Memory allocation 
     127            ! 
     128            CALL trc_dta( nit000, ztrcdta )   ! read tracer data at nit000 
     129            ! 
     130            DO jn = 1, jptra 
     131               IF( ln_trc_ini(jn) ) THEN      ! update passive tracers arrays with input data read from file 
     132                  jl = n_trc_index(jn)  
     133                  trn(:,:,:,jn) = ztrcdta(:,:,:,jl) * tmask(:,:,:)   
     134               ENDIF 
     135            ENDDO 
     136            CALL wrk_dealloc( jpi, jpj, jpk, nb_trcdta, ztrcdta ) 
     137        ENDIF 
     138        ! 
    138139        trb(:,:,:,:) = trn(:,:,:,:) 
    139140        !  
    … …  
    145146        &    CALL zps_hde( nit000, jptra, trn, gtru, gtrv )       ! tracers at the bottom ocean level 
    146147 
    147  
    148       !            
    149       trai = 0._wp         ! Computation content of all tracers 
     148      ! 
     149      IF( nn_dttrc /= 1 )        CALL trc_sub_ini      ! Initialize variables for substepping passive tracers 
     150      ! 
     151 
     152      trai(:) = 0._wp                                                   ! initial content of all tracers 
    150153      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       
     154         trai(jn) = trai(jn) + glob_sum( trn(:,:,:,jn) * cvol(:,:,:)   ) 
     155      END DO 
    157156 
    158157      IF(lwp) THEN               ! control print 
    … …  
    161160         WRITE(numout,*) '          *** Total number of passive tracer jptra = ', jptra 
    162161         WRITE(numout,*) '          *** Total volume of ocean                = ', areatot 
    163          WRITE(numout,*) '          *** Total inital content of all tracers  = ', trai 
    164          WRITE(numout,*) 
    165       ENDIF 
    166  
     162         WRITE(numout,*) '          *** Total inital content of all tracers ' 
     163         WRITE(numout,*) 
     164         DO jn = 1, jptra 
     165            WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), trai(jn) 
     166         ENDDO 
     167         WRITE(numout,*) 
     168      ENDIF 
     169      IF(lwp) WRITE(numout,*) 
    167170      IF(ln_ctl) THEN            ! print mean trends (used for debugging) 
    168171         CALL prt_ctl_trc_init 
    … …  
    171174         CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 
    172175      ENDIF 
     1769000  FORMAT(' tracer nb : ',i2,'      name :',a10,'      initial content :',e18.10) 
     177      ! 
     178      IF( nn_timing == 1 )   CALL timing_stop('trc_init') 
    173179      ! 
    174180   END SUBROUTINE trc_init 
    … …  
    186192      USE trczdf        , ONLY:   trc_zdf_alloc 
    187193      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 
     194#if defined key_trdmld_trc  
    198195      USE trdmld_trc    , ONLY:   trd_mld_trc_alloc 
    199196#endif 
    … …  
    207204      ierr = ierr + trc_zdf_alloc() 
    208205      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 
     206#if defined key_trdmld_trc  
    219207      ierr = ierr + trd_mld_trc_alloc() 
    220208#endif 

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

    r2715 r3294  
    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 
     107      !!KPE  computes the first time step of tracer model 
     108      nittrc000 = nit000 + nn_dttrc - 1 
     109  
    111110 
    112111      IF(lwp) THEN                   ! control print 
    113112         WRITE(numout,*) 
    114113         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 
     114         WRITE(numout,*) '   time step freq. for passive tracer           nn_dttrc      = ', nn_dttrc 
     115         WRITE(numout,*) '   restart  for passive tracer                  ln_rsttr      = ', ln_rsttr 
     116         WRITE(numout,*) '   control of time step for passive tracer      nn_rsttr      = ', nn_rsttr 
     117         WRITE(numout,*) '    first time step for pass. trac.             nittrc000     = ', nittrc000 
     118         WRITE(numout,*) '    frequency of outputs for passive tracers    nn_writetrc   = ', nn_writetrc   
     119         WRITE(numout,*) '   Read inputs data from file                   ln_trcdta     = ', ln_trcdta 
    119120         WRITE(numout,*) ' ' 
    120121         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,*) ' ' 
     122            WRITE(numout,*) '  tracer nb : ', jn, '    short name : ', ctrcnm(jn) 
    127123         END DO 
     124         WRITE(numout,*) ' ' 
    128125      ENDIF 
    129126 
    130127      rdttrc(:) = rdttra(:) * FLOAT( nn_dttrc )   ! vertical profile of passive tracer time-step 
    131128   
    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. 
     129      IF(lwp) THEN                   ! control print 
     130        WRITE(numout,*)  
     131        WRITE(numout,*) '    Passive Tracer  time step    rdttrc  = ', rdttrc(1) 
     132        WRITE(numout,*)  
     133      ENDIF 
     134 
     135      ln_diatrc = .FALSE. 
     136      ln_diabio = .FALSE. 
     137      nn_writedia = 10 
     138      nn_writebio = 10 
    145139 
    146140      REWIND( numnat )               !  namelist namtoptrd : passive tracer trends diagnostic 
    147       READ  ( numnat, namtrc_trd ) 
    148  
    149      IF(lwp) THEN 
     141      READ  ( numnat, namtrc_dia ) 
     142 
     143      IF(lwp) THEN 
    150144         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 
     145         WRITE(numout,*) 
     146         WRITE(numout,*) ' Namelist : namtrc_dia' 
     147         WRITE(numout,*) '    save additionnal diagnostics arrays         ln_diatrc   = ', ln_diatrc 
     148         WRITE(numout,*) '    save additionnal biology diagnostics arrays ln_diabio   = ', ln_diabio 
     149         WRITE(numout,*) '    frequency of outputs for additional arrays  nn_writedia = ', nn_writedia 
     150         WRITE(numout,*) '    frequency of outputs for biological trends  nn_writebio = ', nn_writebio 
     151         WRITE(numout,*) ' ' 
     152      ENDIF 
     153 
     154      IF( ln_diatrc .AND. .NOT. lk_iomput ) THEN  
     155         ALLOCATE( trc2d(jpi,jpj,jpdia2d), trc3d(jpi,jpj,jpk,jpdia3d),  & 
     156           &       ctrc2d(jpdia2d), ctrc2l(jpdia2d), ctrc2u(jpdia2d) ,  &  
     157           &       ctrc3d(jpdia3d), ctrc3l(jpdia3d), ctrc3u(jpdia3d) ,  STAT = ierr )  
     158         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'trcnam: unable to allocate add. diag. array' ) 
     159      ENDIF 
     160 
     161      IF( ( ln_diabio .AND. .NOT. lk_iomput ) .OR. l_trdtrc ) THEN 
     162         ALLOCATE( trbio (jpi,jpj,jpk,jpdiabio) , & 
     163           &       ctrbio(jpdiabio), ctrbil(jpdiabio), ctrbiu(jpdiabio), STAT = ierr )  
     164         IF( ierr > 0 )   CALL ctl_stop( 'STOP', 'trcnam: unable to allocate bio. diag. array' ) 
     165      ENDIF 
    164166 
    165167      ! namelist of transport 
    166168      ! --------------------- 
    167169      CALL trc_nam_trp 
     170 
     171 
     172      IF( ln_trcdmp .AND. .NOT.ln_trcdta ) THEN 
     173         CALL ctl_warn( 'trc_nam: passive tracer damping requires data from files we set ln_trcdta to TRUE' ) 
     174         ln_trcdta = .TRUE. 
     175      ENDIF 
     176      ! 
     177      IF( ln_rsttr .AND. .NOT.ln_trcdmp .AND. ln_trcdta ) THEN 
     178          CALL ctl_warn( 'trc_nam: passive tracer restart and  data intialisation, ',   & 
     179             &           'we keep the restart values and set ln_trcdta to FALSE' ) 
     180         ln_trcdta = .FALSE. 
     181      ENDIF 
     182      ! 
     183      IF( .NOT.ln_trcdta ) THEN 
     184         ln_trc_ini(:) = .FALSE. 
     185      ENDIF 
     186 
     187      IF(lwp) THEN                   ! control print 
     188         IF( ln_rsttr ) THEN 
     189            WRITE(numout,*) 
     190            WRITE(numout,*) '    read a restart file for passive tracer : ', TRIM( cn_trcrst_in ) 
     191            WRITE(numout,*) 
     192         ELSE 
     193            IF( .NOT.ln_trcdta ) THEN 
     194                WRITE(numout,*) 
     195                WRITE(numout,*) '  All the passive tracers are initialised with constant values ' 
     196                WRITE(numout,*) 
     197            ENDIF 
     198         ENDIF 
     199      ENDIF 
     200 
     201 
     202#if defined key_trdmld_trc || defined key_trdtrc 
     203         nn_trd_trc  = 20 
     204         nn_ctls_trc =  9 
     205         rn_ucf_trc   =  1. 
     206         ln_trdmld_trc_instant = .TRUE. 
     207         ln_trdmld_trc_restart =.FALSE. 
     208         cn_trdrst_trc_in  = "restart_mld_trc" 
     209         cn_trdrst_trc_out = "restart_mld_trc" 
     210         ln_trdtrc(:) = .FALSE. 
     211 
     212         REWIND( numnat )               !  namelist namtoptrd : passive tracer trends diagnostic 
     213         READ  ( numnat, namtrc_trd ) 
     214 
     215         IF(lwp) THEN 
     216            WRITE(numout,*) 
     217            WRITE(numout,*) ' trd_mld_trc_init : read namelist namtrc_trd                    ' 
     218            WRITE(numout,*) ' ~~~~~~~~~~~~~~~~                                               ' 
     219            WRITE(numout,*) '   * frequency of trends diagnostics   nn_trd_trc             = ', nn_trd_trc 
     220            WRITE(numout,*) '   * control surface type              nn_ctls_trc            = ', nn_ctls_trc 
     221            WRITE(numout,*) '   * restart for ML diagnostics        ln_trdmld_trc_restart  = ', ln_trdmld_trc_restart 
     222            WRITE(numout,*) '   * flag to diagnose trends of                                 ' 
     223            WRITE(numout,*) '     instantantaneous or mean ML T/S   ln_trdmld_trc_instant  = ', ln_trdmld_trc_instant 
     224            WRITE(numout,*) '   * unit conversion factor            rn_ucf_trc             = ', rn_ucf_trc 
     225            DO jn = 1, jptra 
     226               IF( ln_trdtrc(jn) ) WRITE(numout,*) '    compute ML trends for tracer number :', jn 
     227            END DO 
     228         ENDIF 
     229#endif 
    168230 
    169231 

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

    r2715 r3294  
    3939   PUBLIC   trc_rst_read      ! called by ??? 
    4040   PUBLIC   trc_rst_wri       ! called by ??? 
     41   PUBLIC   trc_rst_cal 
    4142 
    4243   INTEGER, PUBLIC ::   numrtr, numrtw   !: logical unit for trc restart (read and write) 
    … …  
    6061      ! 
    6162      IF( lk_offline ) THEN 
    62          IF( kt == nit000 ) THEN 
     63         IF( kt == nittrc000 ) THEN 
    6364            lrst_trc = .FALSE. 
    6465            nitrst = nitend 
    … …  
    6667 
    6768         IF( MOD( kt - 1, nstock ) == 0 ) THEN 
    68             ! we use kt - 1 and not kt - nit000 to keep the same periodicity from the beginning of the experiment 
     69            ! we use kt - 1 and not kt - nittrc000 to keep the same periodicity from the beginning of the experiment 
    6970            nitrst = kt + nstock - 1                  ! define the next value of nitrst for restart writing 
    7071            IF( nitrst > nitend )   nitrst = nitend   ! make sure we write a restart at the end of the run 
    7172         ENDIF 
    7273      ELSE 
    73          IF( kt == nit000 ) lrst_trc = .FALSE. 
     74         IF( kt == nittrc000 ) lrst_trc = .FALSE. 
    7475      ENDIF 
    7576 
    … …  
    7778      ! we open and define the tracer restart file one tracer time step before writing the data (-> at nitrst - 2*nn_dttrc + 1) 
    7879      ! except if we write tracer restart files every tracer time step or if a tracer restart file was writen at nitend - 2*nn_dttrc + 1 
    79       IF( kt == nitrst - 2*nn_dttrc + 1 .OR. nstock == nn_dttrc .OR. ( kt == nitend - nn_dttrc + 1 .AND. .NOT. lrst_trc ) ) THEN 
     80      IF( kt == nitrst - 2*nn_dttrc .OR. nstock == nn_dttrc .OR. ( kt == nitend - nn_dttrc .AND. .NOT. lrst_trc ) ) THEN 
    8081         ! beware of the format used to write kt (default is i8.8, that should be large enough) 
    8182         IF( nitrst > 1.0e9 ) THEN   ;   WRITE(clkt,*       ) nitrst 
    … …  
    99100      !!---------------------------------------------------------------------- 
    100101      INTEGER  ::  jn      
    101       INTEGER  ::  jlibalt = jprstlib 
    102       LOGICAL  ::  llok 
    103  
    104       !!---------------------------------------------------------------------- 
    105  
     102 
     103      !!---------------------------------------------------------------------- 
     104      ! 
    106105      IF(lwp) WRITE(numout,*) 
    107       IF(lwp) WRITE(numout,*) 'trc_rst_read : read the TOP restart file' 
     106      IF(lwp) WRITE(numout,*) 'trc_rst_read : read data in the TOP restart file' 
    108107      IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
    109  
    110       IF ( jprstlib == jprstdimg ) THEN 
    111         ! eventually read netcdf file (monobloc)  for restarting on different number of processors 
    112         ! if {cn_trcrst_in}.nc exists, then set jlibalt to jpnf90  
    113         INQUIRE( FILE = TRIM(cn_trcrst_in)//'.nc', EXIST = llok ) 
    114         IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF  
    115       ENDIF 
    116  
    117       CALL iom_open( cn_trcrst_in, numrtr, kiolib = jlibalt )  
    118  
    119       ! Time domain : restart 
    120       ! --------------------- 
    121       CALL trc_rst_cal( nit000, 'READ' )   ! calendar 
    122108 
    123109      ! READ prognostic variables and computes diagnostic variable 
    … …  
    151137      REAL(wp) :: zarak0 
    152138      !!---------------------------------------------------------------------- 
    153  
    154  
     139      ! 
    155140      CALL trc_rst_cal( kt, 'WRITE' )   ! calendar 
    156141      CALL iom_rstput( kt, nitrst, numrtw, 'rdttrc1', rdttrc(1) )   ! surface passive tracer time step 
    … …  
    196181      !! 
    197182      !!   According to namelist parameter nrstdt, 
    198       !!       nn_rsttr = 0  no control on the date (nit000 is  arbitrary). 
    199       !!       nn_rsttr = 1  we verify that nit000 is equal to the last 
     183      !!       nn_rsttr = 0  no control on the date (nittrc000 is  arbitrary). 
     184      !!       nn_rsttr = 1  we verify that nittrc000 is equal to the last 
    200185      !!                   time step of previous run + 1. 
    201186      !!       In both those options, the  exact duration of the experiment 
    202187      !!       since the beginning (cumulated duration of all previous restart runs) 
    203       !!       is not stored in the restart and is assumed to be (nit000-1)*rdt. 
     188      !!       is not stored in the restart and is assumed to be (nittrc000-1)*rdt. 
    204189      !!       This is valid is the time step has remained constant. 
    205190      !! 
    … …  
    210195      CHARACTER(len=*), INTENT(in) ::   cdrw       ! "READ"/"WRITE" flag 
    211196      ! 
     197      INTEGER  ::  jlibalt = jprstlib 
     198      LOGICAL  ::  llok 
    212199      REAL(wp) ::  zkt, zrdttrc1 
    213200      REAL(wp) ::  zndastp 
    … …  
    217204 
    218205      IF( TRIM(cdrw) == 'READ' ) THEN 
     206 
     207         IF(lwp) WRITE(numout,*) 
     208         IF(lwp) WRITE(numout,*) 'trc_rst_cal : read the TOP restart file for calendar' 
     209         IF(lwp) WRITE(numout,*) '~~~~~~~~~~~~' 
     210 
     211         IF ( jprstlib == jprstdimg ) THEN 
     212           ! eventually read netcdf file (monobloc)  for restarting on different number of processors 
     213           ! if {cn_trcrst_in}.nc exists, then set jlibalt to jpnf90  
     214           INQUIRE( FILE = TRIM(cn_trcrst_in)//'.nc', EXIST = llok ) 
     215           IF ( llok ) THEN ; jlibalt = jpnf90  ; ELSE ; jlibalt = jprstlib ; ENDIF 
     216         ENDIF 
     217 
     218         CALL iom_open( cn_trcrst_in, numrtr, kiolib = jlibalt ) 
     219 
    219220         CALL iom_get ( numrtr, 'kt', zkt )   ! last time-step of previous run 
    220221         IF(lwp) THEN 
    … …  
    223224            WRITE(numout,*) ' *** restart option' 
    224225            SELECT CASE ( nn_rsttr ) 
    225             CASE ( 0 )   ;   WRITE(numout,*) ' nn_rsttr = 0 : no control of nit000' 
    226             CASE ( 1 )   ;   WRITE(numout,*) ' nn_rsttr = 1 : no control the date at nit000 (use ndate0 read in the namelist)' 
     226            CASE ( 0 )   ;   WRITE(numout,*) ' nn_rsttr = 0 : no control of nittrc000' 
     227            CASE ( 1 )   ;   WRITE(numout,*) ' nn_rsttr = 1 : no control the date at nittrc000 (use ndate0 read in the namelist)' 
    227228            CASE ( 2 )   ;   WRITE(numout,*) ' nn_rsttr = 2 : calendar parameters read in restart' 
    228229            END SELECT 
    … …  
    230231         ENDIF 
    231232         ! Control of date  
    232          IF( nit000  - NINT( zkt ) /= 1 .AND.  nn_rsttr /= 0 )                                  & 
    233             &   CALL ctl_stop( ' ===>>>> : problem with nit000 for the restart',                 & 
     233         IF( nittrc000  - NINT( zkt ) /= nn_dttrc .AND.  nn_rsttr /= 0 )                                  & 
     234            &   CALL ctl_stop( ' ===>>>> : problem with nittrc000 for the restart',                 & 
    234235            &                  ' verify the restart file or rerun with nn_rsttr = 0 (namelist)' ) 
    235236         IF( lk_offline ) THEN      ! set the date in offline mode 
    … …  
    246247            ELSE 
    247248               ndastp = ndate0 - 1     ! ndate0 read in the namelist in dom_nam 
    248                adatrj = ( REAL( nit000-1, wp ) * rdttra(1) ) / rday 
     249               adatrj = ( REAL( nittrc000-1, wp ) * rdttra(1) ) / rday 
    249250               ! note this is wrong if time step has changed during run 
    250251            ENDIF 
    … …  
    283284      !! ** purpose  :   Compute tracers statistics 
    284285      !!---------------------------------------------------------------------- 
    285  
    286       INTEGER  :: jn 
    287       REAL(wp) :: zdiag_var, zdiag_varmin, zdiag_varmax, zdiag_tot 
    288       REAL(wp) :: zder 
    289       !!---------------------------------------------------------------------- 
    290  
     286      INTEGER  :: jk, jn 
     287      REAL(wp) :: ztraf, zmin, zmax, zmean, zdrift 
     288      !!---------------------------------------------------------------------- 
    291289 
    292290      IF( lwp ) THEN 
    … …  
    295293         WRITE(numout,*)  
    296294      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 
    305          zdiag_varmin = MINVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) ) 
    306          zdiag_varmax = MAXVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) ) 
     295      ! 
     296      DO jn = 1, jptra 
     297         ztraf = glob_sum( trn(:,:,:,jn) * cvol(:,:,:) ) 
     298         zmin  = MINVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) ) 
     299         zmax  = MAXVAL( trn(:,:,:,jn), mask= ((tmask*SPREAD(tmask_i,DIM=3,NCOPIES=jpk).NE.0.)) ) 
    307300         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 
     301            CALL mpp_min( zmin )      ! min over the global domain 
     302            CALL mpp_max( zmax )      ! max over the global domain 
    310303         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, ' %' 
    320        
     304         zmean  = ztraf / areatot 
     305         zdrift = ( ( ztraf - trai(jn) ) / ( trai(jn) + 1.e-12 )  ) * 100._wp 
     306         IF(lwp) WRITE(numout,9000) jn, TRIM( ctrcnm(jn) ), zmean, zmin, zmax, zdrift 
     307      END DO 
     308      WRITE(numout,*)  
     3099000  FORMAT(' tracer nb :',i2,'    name :',a10,'    mean :',e18.10,'    min :',e18.10, & 
     310      &      '    max :',e18.10,'    drift :',e18.10, ' %') 
     311      ! 
    321312   END SUBROUTINE trc_rst_stat 
    322313 

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

    r2715 r3294  
    4646      CHARACTER (len=25) :: charout 
    4747      !!--------------------------------------------------------------------- 
    48  
    49       IF ( MOD( kt, nn_dttrc) /= 0 ) RETURN      ! this ROUTINE is called only every ndttrc time step 
    50  
     48      ! 
     49      IF( nn_timing == 1 )   CALL timing_start('trc_sms') 
     50      ! 
    5151      IF( lk_lobster )   CALL trc_sms_lobster( kt )    ! main program of LOBSTER 
    5252      IF( lk_pisces  )   CALL trc_sms_pisces ( kt )    ! main program of PISCES  
    … …  
    6060         CALL prt_ctl_trc( tab4d=trn, mask=tmask, clinfo=ctrcnm ) 
    6161      ENDIF 
     62      ! 
     63      IF( nn_timing == 1 )   CALL timing_stop('trc_sms') 
    6264      ! 
    6365   END SUBROUTINE trc_sms 

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

    r2528 r3294  
    2222   USE iom 
    2323   USE in_out_manager 
     24   USE trcsub 
    2425 
    2526   IMPLICIT NONE 
    … …  
    2728 
    2829   PUBLIC   trc_stp    ! called by step 
    29     
     30 
     31   !! * Substitutions 
     32#  include "domzgr_substitute.h90" 
    3033   !!---------------------------------------------------------------------- 
    3134   !! NEMO/TOP 3.3 , NEMO Consortium (2010) 
    … …  
    4548      !!              Update the passive tracers 
    4649      !!------------------------------------------------------------------- 
    47       INTEGER, INTENT( in ) ::  kt  ! ocean time-step index 
     50      INTEGER, INTENT( in ) ::  kt      ! ocean time-step index 
     51      INTEGER               ::  jk, jn  ! dummy loop indices 
     52      REAL(wp)              ::  ztrai 
    4853      CHARACTER (len=25)    ::  charout 
    4954      !!------------------------------------------------------------------- 
     55      ! 
     56      IF( nn_timing == 1 )   CALL timing_start('trc_stp') 
     57      ! 
     58      IF( kt == nittrc000 ) THEN 
     59                               CALL iom_close( numrtr )     ! close input  passive tracers restart file 
     60         IF( lk_trdmld_trc  )  CALL trd_mld_trc_init        ! trends: Mixed-layer 
     61      ENDIF 
     62      ! 
     63      IF( lk_vvl ) THEN                              ! update ocean volume due to ssh temporal evolution 
     64         DO jk = 1, jpk 
     65            cvol(:,:,jk) = e1e2t(:,:) * fse3t(:,:,jk) * tmask(:,:,jk) 
     66         END DO 
     67         IF( lk_degrad )  cvol(:,:,:) = cvol(:,:,:) * facvol(:,:,:)      ! degrad option: reduction by facvol 
     68         areatot         = glob_sum( cvol(:,:,:) ) 
     69      ENDIF 
     70      !     
     71     IF( nn_dttrc /= 1 )   CALL trc_sub_stp( kt )  ! averaging physical variables for sub-stepping 
    5072 
    51       IF( MOD( kt - 1 , nn_dttrc ) == 0 ) THEN      ! only every nn_dttrc time step 
     73     IF( MOD( kt , nn_dttrc ) == 0 ) THEN      ! only every nn_dttrc time step 
    5274         ! 
    5375         IF(ln_ctl) THEN 
    … …  
    5880         tra(:,:,:,:) = 0.e0 
    5981         ! 
    60          IF( kt == nit000 .AND. lk_trdmld_trc  )  & 
    61             &                      CALL trd_mld_trc_init        ! trends: Mixed-layer 
    62                                    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 ) 
     82                                   CALL trc_rst_opn  ( kt )       ! Open tracer restart file  
     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 
    67                                    CALL trc_trp( kt )           ! transport of passive tracers 
    68          IF( kt == nit000 )     CALL iom_close( numrtr )     ! close input  passive tracers restart file 
    69          IF( lrst_trc )            CALL trc_rst_wri( kt )       ! write tracer restart file 
    70          IF( lk_trdmld_trc  )      CALL trd_mld_trc( kt )       ! trends: Mixed-layer 
     86                                   CALL trc_sms      ( kt )       ! tracers: sinks and sources 
     87                                   CALL trc_trp      ( kt )       ! transport of passive tracers 
     88         IF( lrst_trc )            CALL trc_rst_wri  ( kt )       ! write tracer restart file 
     89         IF( lk_trdmld_trc  )      CALL trd_mld_trc  ( kt )       ! trends: Mixed-layer 
     90         ! 
     91         IF( nn_dttrc /= 1   )     CALL trc_sub_reset( kt )       ! resetting physical variables when sub-stepping 
    7192         ! 
    7293      ENDIF 
    73  
     94      ! 
     95      ztrai = 0._wp                                                   !  content of all tracers 
     96      DO jn = 1, jptra 
     97         ztrai = ztrai + glob_sum( trn(:,:,:,jn) * cvol(:,:,:)   ) 
     98      END DO 
     99      IF( lwp ) WRITE(numstr,9300) kt,  ztrai / areatot 
     1009300  FORMAT(i10,e18.10) 
     101      ! 
     102      IF( nn_timing == 1 )   CALL timing_stop('trc_stp') 
     103      ! 
    74104   END SUBROUTINE trc_stp 
    75105 

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

    r2567 r3294  
    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 
    … …  
    3636      INTEGER, INTENT( in ) :: kt 
    3737      !!--------------------------------------------------------------------- 
    38  
     38      ! 
     39      IF( nn_timing == 1 )  CALL timing_start('trc_wri') 
    3940      ! 
    4041      CALL iom_setkt  ( kt + nn_dttrc - 1 )       ! set the passive tracer time step 
    4142      CALL trc_wri_trc( kt              )       ! outputs for tracer concentration 
    4243      CALL iom_setkt  ( kt              )       ! set the model time step 
     44      ! 
     45      IF( nn_timing == 1 )  CALL timing_stop('trc_wri') 
    4346      ! 
    4447   END SUBROUTINE trc_wri 
    … …  
    5053      !! ** Purpose :   output passive tracers fields  
    5154      !!--------------------------------------------------------------------- 
    52       INTEGER, INTENT( in ) :: kt       ! ocean time-step 
    53       INTEGER               :: jn 
    54       CHARACTER (len=20)    :: cltra 
    55       CHARACTER (len=40) :: clhstnam 
     55      INTEGER, INTENT( in )     :: kt       ! ocean time-step 
     56      INTEGER                   :: jn 
     57      CHARACTER (len=20)        :: cltra 
     58      CHARACTER (len=40)        :: clhstnam 
    5659      INTEGER ::   inum = 11            ! temporary logical unit 
    5760      !!--------------------------------------------------------------------- 
    5861  
    59       IF( lk_offline .AND. kt == nit000 .AND. lwp ) THEN    ! WRITE root name in date.file for use by postpro 
     62      IF( lk_offline .AND. kt == nittrc000 .AND. lwp ) THEN    ! WRITE root name in date.file for use by postpro 
    6063         CALL dia_nam( clhstnam, nn_writetrc,' ' ) 
    6164         CALL ctl_opn( inum, 'date.file', 'REPLACE', 'FORMATTED', 'SEQUENTIAL', -1, numout, lwp, narea ) 
Note: See TracChangeset for help on using the changeset viewer.