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 1457 – NEMO

Changeset 1457


Ignore:
Timestamp:
2009-05-23T10:16:38+02:00 (15 years ago)
Author:
cetlod
Message:

distribution of iom_put in TOP routines, see ticket:437

Location:
trunk/NEMO
Files:
2 added
1 deleted
21 edited

Legend:

Unmodified
Added
Removed

  • trunk/NEMO/OFF_SRC/IOM/iom.F90

    r1450 r1457  
    3333   PUBLIC   !   must be public to be able to access iom_def through iom 
    3434    
     35#if defined key_iomput 
     36   LOGICAL, PUBLIC, PARAMETER ::   lk_iomput = .TRUE.       !: iom_put flag 
     37#else 
     38   LOGICAL, PUBLIC, PARAMETER ::   lk_iomput = .FALSE.       !: iom_put flag 
     39#endif 
     40 
    3541   PUBLIC iom_init, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_gettime, iom_rstput, iom_put 
    3642 

  • trunk/NEMO/OFF_SRC/opa.F90

    r1450 r1457  
    225225       
    226226      CALL dta_dyn( nit000 )                 ! Initialization for the dynamics 
    227       
     227       
    228228      CALL trc_ini                           ! Passive tracers 
    229  
    230       CALL day_init                          ! Calendar 
    231229      !                                     ! Ocean physics 
    232230      CALL tra_qsr_init                         ! Solar radiation penetration 

  • trunk/NEMO/OFF_SRC/step.F90

    r1291 r1457  
    2222   USE trcrst          ! restart for passive tracers 
    2323   USE stpctl          ! time stepping control            (stp_ctl routine) 
     24   USE iom 
    2425 
    2526   IMPLICIT NONE 
    … …  
    7071      !! * Arguments 
    7172      INTEGER, INTENT( in ) ::   kstp   ! ocean time-step index 
    72  
    73       !! * local declarations 
    74       INTEGER ::   indic    ! error indicator if < 0 
    7573      !! --------------------------------------------------------------------- 
    76  
    77       indic = 1                    ! reset to no error condition 
    7874 
    7975      CALL day( kstp )             ! Calendar 
    8076 
    81       CALL dta_dyn( kstp )          ! Interpolation of the dynamical fields 
     77      IF( lk_iomput ) CALL iom_setkt( kstp )       ! say to iom that we are at time step kstp 
    8278 
    83       CALL trc_stp( kstp, indic)           ! time-stepping 
     79      CALL dta_dyn( kstp )         ! Interpolation of the dynamical fields 
     80 
     81      CALL trc_stp( kstp )         ! time-stepping 
    8482 
    8583 

  • trunk/NEMO/OPA_SRC/IOM/iom.F90

    r1441 r1457  
    3333   PUBLIC   !   must be public to be able to access iom_def through iom 
    3434    
     35#if defined key_iomput 
     36   LOGICAL, PUBLIC, PARAMETER ::   lk_iomput = .TRUE.       !: iom_put flag 
     37#else 
     38   LOGICAL, PUBLIC, PARAMETER ::   lk_iomput = .FALSE.       !: iom_put flag 
     39#endif 
    3540   PUBLIC iom_init, iom_open, iom_close, iom_setkt, iom_varid, iom_get, iom_gettime, iom_rstput, iom_put 
    3641 
    … …  
    892897 
    893898   !!---------------------------------------------------------------------- 
    894    !!                   INTERFACE iom_rstput 
     899   !!                   INTERFACE iom_put 
    895900   !!---------------------------------------------------------------------- 
    896901   SUBROUTINE iom_p2d( cdname, pfield2d ) 

  • trunk/NEMO/OPA_SRC/step.F90

    r1438 r1457  
    281281      ! N.B. ua, va, ta, sa arrays are used as workspace in this section 
    282282      !----------------------------------------------------------------------- 
    283                              CALL trc_stp( kstp, indic )            ! time-stepping 
     283                             CALL trc_stp( kstp )            ! time-stepping 
    284284#endif 
    285285 

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

    r1264 r1457  
    2222   USE trdmld_trc 
    2323   USE trdmld_trc_oce 
     24   USE iom 
    2425    
    2526   IMPLICIT NONE 
    … …  
    2930 
    3031   !!* Substitution 
    31 #  include "domzgr_substitute.h90" 
     32#  include "top_substitute.h90" 
    3233   !!---------------------------------------------------------------------- 
    3334   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
    … …  
    7172      REAL(wp) ::   znh4a, zdeta, zdoma, zzoobod, zboddet, zdomaju 
    7273#if defined key_trc_diaadd 
    73       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze3t 
     74      REAL(wp) ::   ze3t 
     75#endif 
     76#if defined key_trc_diaadd && defined key_iomput 
     77      REAL(wp), DIMENSION(jpi,jpj,17)     :: zw2d 
     78# if defined key_trc_dia3d 
     79      REAL(wp), DIMENSION(jpi,jpj,jpk,3) :: zw3d 
     80# endif 
    7481#endif 
    7582      REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::   ztrbio 
    … …  
    8390      ENDIF 
    8491 
    85 #if defined key_trc_diaadd 
    86       ! convert fluxes in per day 
    87       ze3t(:,:,:) = 0.e0 
    88       DO jk = 1, jpkbm1 
    89          ze3t(:,:,jk) = fse3t(:,:,jk) * 86400. 
    90       END DO  
    91 #endif 
    92  
    9392      fbod(:,:) = 0.e0 
    94 #if defined key_trc_diaadd 
     93#if defined key_trc_diaadd && ! defined key_iomput 
    9594      DO jl = jp_lob0_2d, jp_lob1_2d 
    9695         trc2d(:,:,jl) = 0.e0 
    9796      END DO  
     97#endif 
     98#if defined key_trc_diaadd && defined key_iomput 
     99      zw2d(:,:,:) = 0.e0 
     100# if defined key_trc_dia3d 
     101      zw3d(:,:,:,:) = 0.e0 
     102# endif 
    98103#endif 
    99104 
    … …  
    107112         !                                   ! -------------------------- ! 
    108113         DO jj = 2, jpjm1 
    109             DO ji = 2, jpim1           !!gm  use of fs_2 fs_jpm1  required here 
    110  
     114            DO ji = fs_2, fs_jpim1  
    111115               ! trophic variables( det, zoo, phy, no3, nh4, dom) 
    112116               ! ------------------------------------------------ 
    … …  
    126130               zlno3 = zno3 * EXP( -psinut * znh4 ) / ( akno3 + zno3 ) 
    127131               zlnh4 = znh4 / (znh4+aknh4)  
    128  
    129132 
    130133               ! sinks and sources 
    … …  
    189192               zdeta =   zphydet + zzoodet - zdetzoo - zdetnh4 - zdetdom + zboddet 
    190193               zdoma =   zphydom + zzoodom + zdetdom - zdomnh4 - zdomaju 
     194 
     195               ! tracer flux at totox-point added to the general trend 
     196               tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + zdeta 
     197               tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) + zzooa 
     198               tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zphya 
     199               tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zno3a 
     200               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + znh4a 
     201               tra(ji,jj,jk,jpdom) = tra(ji,jj,jk,jpdom) + zdoma 
    191202 
    192203#if defined key_trc_diabio 
    … …  
    206217               trbio(ji,jj,jk,jp_lob0_trd + 14) = zdetnh4 
    207218               trbio(ji,jj,jk,jp_lob0_trd + 15) = zdetdom 
    208 #endif 
    209 #if defined key_trc_diaadd 
    210                trc2d(ji,jj,jp_lob0_2d    ) = trc2d(ji,jj, jp_lob0_2d    ) + zno3phy * ze3t(ji,jj,jk)  
    211                trc2d(ji,jj,jp_lob0_2d + 1) = trc2d(ji,jj, jp_lob0_2d + 1) + znh4phy * ze3t(ji,jj,jk) 
    212                trc2d(ji,jj,jp_lob0_2d + 2) = trc2d(ji,jj, jp_lob0_2d + 2) + zphydom * ze3t(ji,jj,jk) 
    213                trc2d(ji,jj,jp_lob0_2d + 3) = trc2d(ji,jj, jp_lob0_2d + 3) + zphynh4 * ze3t(ji,jj,jk) 
    214                trc2d(ji,jj,jp_lob0_2d + 4) = trc2d(ji,jj, jp_lob0_2d + 4) + zphyzoo * ze3t(ji,jj,jk) 
    215                trc2d(ji,jj,jp_lob0_2d + 5) = trc2d(ji,jj, jp_lob0_2d + 5) + zphydet * ze3t(ji,jj,jk) 
    216                trc2d(ji,jj,jp_lob0_2d + 6) = trc2d(ji,jj, jp_lob0_2d + 6) + zdetzoo * ze3t(ji,jj,jk) 
    217 ! trend number 8 is in trcsed.F             
    218                trc2d(ji,jj,jp_lob0_2d +  8) = trc2d(ji,jj,jp_lob0_2d +  8) + zzoodet * ze3t(ji,jj,jk) 
    219                trc2d(ji,jj,jp_lob0_2d +  9) = trc2d(ji,jj,jp_lob0_2d +  9) + zzoobod * ze3t(ji,jj,jk) 
    220                trc2d(ji,jj,jp_lob0_2d + 10) = trc2d(ji,jj,jp_lob0_2d + 10) + zzoonh4 * ze3t(ji,jj,jk) 
    221                trc2d(ji,jj,jp_lob0_2d + 11) = trc2d(ji,jj,jp_lob0_2d + 11) + zzoodom * ze3t(ji,jj,jk) 
    222                trc2d(ji,jj,jp_lob0_2d + 12) = trc2d(ji,jj,jp_lob0_2d + 12) + znh4no3 * ze3t(ji,jj,jk) 
    223                trc2d(ji,jj,jp_lob0_2d + 13) = trc2d(ji,jj,jp_lob0_2d + 13) + zdomnh4 * ze3t(ji,jj,jk) 
    224                trc2d(ji,jj,jp_lob0_2d + 14) = trc2d(ji,jj,jp_lob0_2d + 14) + zdetnh4 * ze3t(ji,jj,jk)              
    225                trc2d(ji,jj,jp_lob0_2d + 15) = trc2d(ji,jj,jp_lob0_2d + 15) + (  zno3phy + znh4phy - zphynh4   & 
    226                   &                                 - zphydom - zphyzoo - zphydet ) * ze3t(ji,jj,jk) 
    227                trc2d(ji,jj,jp_lob0_2d + 16) = trc2d(ji,jj,jp_lob0_2d + 16) + (  zphyzoo + zdetzoo - zzoodet   & 
    228                   &                                 - zzoobod - zzoonh4 - zzoodom ) * ze3t(ji,jj,jk) 
    229                trc2d(ji,jj,jp_lob0_2d + 17) = trc2d(ji,jj,jp_lob0_2d + 17) + zdetdom * ze3t(ji,jj,jk) 
    230 ! trend number 19 is in trcexp.F 
    231                trc3d(ji,jj,jk,jp_lob0_3d    ) = zno3phy * 86400      
    232                trc3d(ji,jj,jk,jp_lob0_3d + 1) = znh4phy * 86400      
    233                trc3d(ji,jj,jk,jp_lob0_3d + 2) = znh4no3 * 86400      
    234219#endif 
    235220               IF( l_trdtrc ) THEN 
    … …  
    253238                ENDIF 
    254239 
    255  
    256                ! tracer flux at totox-point added to the general trend 
    257                tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + zdeta 
    258                tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) + zzooa 
    259                tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zphya 
    260                tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zno3a 
    261                tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + znh4a 
    262                tra(ji,jj,jk,jpdom) = tra(ji,jj,jk,jpdom) + zdoma 
    263  
     240#if defined key_trc_diaadd 
     241               ! convert fluxes in per day 
     242               ze3t = fse3t(ji,jj,jk) * 86400. 
     243#if ! defined key_iomput 
     244               trc2d(ji,jj,jp_lob0_2d    ) = trc2d(ji,jj, jp_lob0_2d    ) + zno3phy * ze3t  
     245               trc2d(ji,jj,jp_lob0_2d + 1) = trc2d(ji,jj, jp_lob0_2d + 1) + znh4phy * ze3t 
     246               trc2d(ji,jj,jp_lob0_2d + 2) = trc2d(ji,jj, jp_lob0_2d + 2) + zphydom * ze3t 
     247               trc2d(ji,jj,jp_lob0_2d + 3) = trc2d(ji,jj, jp_lob0_2d + 3) + zphynh4 * ze3t 
     248               trc2d(ji,jj,jp_lob0_2d + 4) = trc2d(ji,jj, jp_lob0_2d + 4) + zphyzoo * ze3t 
     249               trc2d(ji,jj,jp_lob0_2d + 5) = trc2d(ji,jj, jp_lob0_2d + 5) + zphydet * ze3t 
     250               trc2d(ji,jj,jp_lob0_2d + 6) = trc2d(ji,jj, jp_lob0_2d + 6) + zdetzoo * ze3t 
     251               ! trend number 8 is in trcsed.F             
     252               trc2d(ji,jj,jp_lob0_2d +  8) = trc2d(ji,jj,jp_lob0_2d +  8) + zzoodet * ze3t 
     253               trc2d(ji,jj,jp_lob0_2d +  9) = trc2d(ji,jj,jp_lob0_2d +  9) + zzoobod * ze3t 
     254               trc2d(ji,jj,jp_lob0_2d + 10) = trc2d(ji,jj,jp_lob0_2d + 10) + zzoonh4 * ze3t 
     255               trc2d(ji,jj,jp_lob0_2d + 11) = trc2d(ji,jj,jp_lob0_2d + 11) + zzoodom * ze3t 
     256               trc2d(ji,jj,jp_lob0_2d + 12) = trc2d(ji,jj,jp_lob0_2d + 12) + znh4no3 * ze3t 
     257               trc2d(ji,jj,jp_lob0_2d + 13) = trc2d(ji,jj,jp_lob0_2d + 13) + zdomnh4 * ze3t 
     258               trc2d(ji,jj,jp_lob0_2d + 14) = trc2d(ji,jj,jp_lob0_2d + 14) + zdetnh4 * ze3t              
     259               trc2d(ji,jj,jp_lob0_2d + 15) = trc2d(ji,jj,jp_lob0_2d + 15) + (  zno3phy + znh4phy - zphynh4   & 
     260                  &                                 - zphydom - zphyzoo - zphydet ) * ze3t 
     261               trc2d(ji,jj,jp_lob0_2d + 16) = trc2d(ji,jj,jp_lob0_2d + 16) + (  zphyzoo + zdetzoo - zzoodet   & 
     262                  &                                 - zzoobod - zzoonh4 - zzoodom ) * ze3t 
     263               trc2d(ji,jj,jp_lob0_2d + 17) = trc2d(ji,jj,jp_lob0_2d + 17) + zdetdom * ze3t 
     264               ! trend number 19 is in trcexp.F 
     265#else 
     266               zw2d(ji,jj,1)  = zw2d(ji,jj,1)  + zno3phy * ze3t  
     267               zw2d(ji,jj,2)  = zw2d(ji,jj,2)  + znh4phy * ze3t 
     268               zw2d(ji,jj,3)  = zw2d(ji,jj,3)  + zphydom * ze3t 
     269               zw2d(ji,jj,4)  = zw2d(ji,jj,4)  + zphynh4 * ze3t 
     270               zw2d(ji,jj,5)  = zw2d(ji,jj,5)  + zphyzoo * ze3t 
     271               zw2d(ji,jj,6)  = zw2d(ji,jj,6)  + zphydet * ze3t 
     272               zw2d(ji,jj,7)  = zw2d(ji,jj,7)  + zdetzoo * ze3t 
     273               zw2d(ji,jj,8)  = zw2d(ji,jj,8)  + zzoodet * ze3t 
     274               zw2d(ji,jj,9)  = zw2d(ji,jj,9)  + zzoobod * ze3t 
     275               zw2d(ji,jj,10) = zw2d(ji,jj,10) + zzoonh4 * ze3t 
     276               zw2d(ji,jj,11) = zw2d(ji,jj,11) + zzoodom * ze3t 
     277               zw2d(ji,jj,12) = zw2d(ji,jj,12) + znh4no3 * ze3t 
     278               zw2d(ji,jj,13) = zw2d(ji,jj,13) + zdomnh4 * ze3t 
     279               zw2d(ji,jj,14) = zw2d(ji,jj,14) + zdetnh4 * ze3t              
     280               zw2d(ji,jj,15) = zw2d(ji,jj,15) + ( zno3phy + znh4phy - zphynh4 - zphydom - zphyzoo - zphydet ) * ze3t 
     281               zw2d(ji,jj,16) = zw2d(ji,jj,16) + ( zphyzoo + zdetzoo - zzoodet - zzoobod - zzoonh4 - zzoodom ) * ze3t 
     282               zw2d(ji,jj,17) = zw2d(ji,jj,17) + zdetdom * ze3t 
     283#endif 
     284#if defined key_trc_dia3d  
     285# if ! defined key_iomput 
     286               trc3d(ji,jj,jk,jp_lob0_3d    ) = zno3phy * 86400      
     287               trc3d(ji,jj,jk,jp_lob0_3d + 1) = znh4phy * 86400      
     288               trc3d(ji,jj,jk,jp_lob0_3d + 2) = znh4no3 * 86400    
     289# else 
     290               zw3d(ji,jj,jk,1) = zno3phy * 86400      
     291               zw3d(ji,jj,jk,2) = znh4phy * 86400      
     292               zw3d(ji,jj,jk,3) = znh4no3 * 86400    
     293# endif 
     294#endif   
     295#endif 
    264296            END DO 
    265297         END DO 
    266298      END DO 
    267299 
    268       ! 
    269  
    270 !!gm do loop until jpkm1 only! 
    271300      !                                      ! -------------------------- ! 
    272       DO jk = jpkb, jpk                      !  Upper ocean (bio-layers)  ! 
     301      DO jk = jpkb, jpkm1                    !  Upper ocean (bio-layers)  ! 
    273302         !                                   ! -------------------------- ! 
    274  
    275303         DO jj = 2, jpjm1 
    276             DO ji = 2,jpim1             !!gm use of fs_2 & fs_jpim1 required 
    277   
     304            DO ji = fs_2, fs_jpim1  
    278305               ! remineralisation of all quantities towards nitrate  
    279306 
    … …  
    335362               zdoma = zphydom + zzoodom + zdetdom - zdomnh4 - zdomaju 
    336363 
     364               ! tracer flux at totox-point added to the general trend 
     365               tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + zdeta 
     366               tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) + zzooa 
     367               tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zphya 
     368               tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zno3a 
     369               tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + znh4a 
     370               tra(ji,jj,jk,jpdom) = tra(ji,jj,jk,jpdom) + zdoma 
     371               ! 
    337372#if defined key_trc_diabio 
    338373               trbio(ji,jj,jk,jp_lob0_trd     ) = zno3phy 
    … …  
    351386               trbio(ji,jj,jk,jp_lob0_trd + 14) = zdetnh4 
    352387               trbio(ji,jj,jk,jp_lob0_trd + 15) = zdetdom 
    353 #endif 
    354 #if defined key_trc_diaadd 
    355                trc2d(ji,jj, jp_lob0_2d    ) = trc2d(ji,jj, jp_lob0_2d    ) + zno3phy * ze3t(ji,jj,jk)           
    356                trc2d(ji,jj, jp_lob0_2d + 1) = trc2d(ji,jj, jp_lob0_2d + 1) + znh4phy * ze3t(ji,jj,jk) 
    357                trc2d(ji,jj, jp_lob0_2d + 2) = trc2d(ji,jj, jp_lob0_2d + 2) + zphydom * ze3t(ji,jj,jk) 
    358                trc2d(ji,jj, jp_lob0_2d + 3) = trc2d(ji,jj, jp_lob0_2d + 3) + zphynh4 * ze3t(ji,jj,jk) 
    359                trc2d(ji,jj, jp_lob0_2d + 4) = trc2d(ji,jj, jp_lob0_2d + 4) + zphyzoo * ze3t(ji,jj,jk) 
    360                trc2d(ji,jj, jp_lob0_2d + 5) = trc2d(ji,jj, jp_lob0_2d + 5) + zphydet * ze3t(ji,jj,jk) 
    361                trc2d(ji,jj, jp_lob0_2d + 6) = trc2d(ji,jj, jp_lob0_2d + 6) + zdetzoo * ze3t(ji,jj,jk) 
    362                ! trend number 8 is in trcsed.F             
    363                trc2d(ji,jj,jp_lob0_2d +  8) = trc2d(ji,jj,jp_lob0_2d +  8) + zzoodet * ze3t(ji,jj,jk) 
    364                trc2d(ji,jj,jp_lob0_2d +  9) = trc2d(ji,jj,jp_lob0_2d +  9) + zzoobod * ze3t(ji,jj,jk) 
    365                trc2d(ji,jj,jp_lob0_2d + 10) = trc2d(ji,jj,jp_lob0_2d + 10) + zzoonh4 * ze3t(ji,jj,jk) 
    366                trc2d(ji,jj,jp_lob0_2d + 11) = trc2d(ji,jj,jp_lob0_2d + 11) + zzoodom * ze3t(ji,jj,jk) 
    367                trc2d(ji,jj,jp_lob0_2d + 12) = trc2d(ji,jj,jp_lob0_2d + 12) + znh4no3 * ze3t(ji,jj,jk) 
    368                trc2d(ji,jj,jp_lob0_2d + 13) = trc2d(ji,jj,jp_lob0_2d + 13) + zdomnh4 * ze3t(ji,jj,jk) 
    369                trc2d(ji,jj,jp_lob0_2d + 14) = trc2d(ji,jj,jp_lob0_2d + 14) + zdetnh4 * ze3t(ji,jj,jk) 
    370               
    371                trc2d(ji,jj,jp_lob0_2d + 15) = trc2d(ji,jj,jp_lob0_2d + 15) + (  zno3phy + znh4phy - zphynh4   & 
    372                   &                                 - zphydom - zphyzoo - zphydet  ) * ze3t(ji,jj,jk) 
    373                trc2d(ji,jj,jp_lob0_2d + 16) = trc2d(ji,jj,jp_lob0_2d + 16) + (  zphyzoo + zdetzoo - zzoodet   & 
    374                   &                                 - zzoobod - zzoonh4 - zzoodom  ) * ze3t(ji,jj,jk) 
    375                trc2d(ji,jj,jp_lob0_2d + 17) = trc2d(ji,jj,jp_lob0_2d + 17) + zdetdom * ze3t(ji,jj,jk) 
    376  
    377                trc3d(ji,jj,jk,jp_lob0_3d    ) =  zno3phy * 86400      
    378                trc3d(ji,jj,jk,jp_lob0_3d + 1) =  znh4phy * 86400      
    379                trc3d(ji,jj,jk,jp_lob0_3d + 2) =  znh4no3 * 86400      
    380388#endif 
    381389               IF( l_trdtrc ) THEN 
    … …  
    398406                  !  trend number 17 in trcexp 
    399407                ENDIF 
    400  
    401  
    402                ! tracer flux at totox-point added to the general trend 
    403                tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + zdeta 
    404                tra(ji,jj,jk,jpzoo) = tra(ji,jj,jk,jpzoo) + zzooa 
    405                tra(ji,jj,jk,jpphy) = tra(ji,jj,jk,jpphy) + zphya 
    406                tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + zno3a 
    407                tra(ji,jj,jk,jpnh4) = tra(ji,jj,jk,jpnh4) + znh4a 
    408                tra(ji,jj,jk,jpdom) = tra(ji,jj,jk,jpdom) + zdoma 
    409                ! 
     408#if defined key_trc_diaadd && defined key_trc_dia3d 
     409# if ! defined key_iomput 
     410               trc3d(ji,jj,jk,jp_lob0_3d    ) =  zno3phy * 86400      
     411               trc3d(ji,jj,jk,jp_lob0_3d + 1) =  znh4phy * 86400      
     412               trc3d(ji,jj,jk,jp_lob0_3d + 2) =  znh4no3 * 86400      
     413# else 
     414               zw3d(ji,jj,jk,1) = zno3phy * 86400      
     415               zw3d(ji,jj,jk,2) = znh4phy * 86400      
     416               zw3d(ji,jj,jk,3) = znh4no3 * 86400    
     417# endif 
     418#endif 
    410419            END DO 
    411420         END DO 
    … …  
    413422 
    414423#if defined key_trc_diaadd 
    415       ! Lateral boundary conditions on trc2d and trc3d 
     424      ! Lateral boundary conditions  
     425# if ! defined key_iomput 
    416426      DO jl = jp_lob0_2d, jp_lob1_2d 
    417427          CALL lbc_lnk( trc2d(:,:,jl),'T', 1. ) 
    418428      END DO  
     429# else 
     430      DO jl = 1, 17  
     431          CALL lbc_lnk( zw2d(:,:,jl),'T', 1. ) 
     432      END DO 
     433      ! Save diagnostics 
     434      CALL iom_put( "TNO3PHY", zw2d(:,:,1) ) 
     435      CALL iom_put( "TNH4PHY", zw2d(:,:,2) ) 
     436      CALL iom_put( "TPHYDOM", zw2d(:,:,3) ) 
     437      CALL iom_put( "TPHYNH4", zw2d(:,:,4) ) 
     438      CALL iom_put( "TPHYZOO", zw2d(:,:,5) ) 
     439      CALL iom_put( "TPHYDET", zw2d(:,:,6) ) 
     440      CALL iom_put( "TDETZOO", zw2d(:,:,7) ) 
     441      CALL iom_put( "TZOODET", zw2d(:,:,8) ) 
     442      CALL iom_put( "TZOOBOD", zw2d(:,:,9) ) 
     443      CALL iom_put( "TZOONH4", zw2d(:,:,10) ) 
     444      CALL iom_put( "TZOODOM", zw2d(:,:,11) ) 
     445      CALL iom_put( "TNH4NO3", zw2d(:,:,12) ) 
     446      CALL iom_put( "TDOMNH4", zw2d(:,:,13) ) 
     447      CALL iom_put( "TDETNH4", zw2d(:,:,14) ) 
     448      CALL iom_put( "TPHYTOT", zw2d(:,:,15) ) 
     449      CALL iom_put( "TZOOTOT", zw2d(:,:,16) ) 
     450      CALL iom_put( "TDETDOM", zw2d(:,:,17) ) 
     451# endif 
     452#endif 
     453 
     454#if defined key_trc_diaadd && defined key_trc_dia3d 
     455      ! Lateral boundary conditions  
     456# if ! defined key_iomput 
    419457      DO jl = jp_lob0_3d, jp_lob1_3d 
    420458          CALL lbc_lnk( trc3d(:,:,1,jl),'T', 1. ) 
    421459      END DO  
     460# else 
     461      DO jl = 1, 3 
     462          CALL lbc_lnk( zw3d(:,:,:,jl),'T', 1. ) 
     463      END DO 
     464      ! save diagnostics 
     465      CALL iom_put( "FNO3PHY", zw3d(:,:,:,1) ) 
     466      CALL iom_put( "FNH4PHY", zw3d(:,:,:,2) ) 
     467      CALL iom_put( "FNH4NO3", zw3d(:,:,:,3) ) 
     468# endif  
    422469#endif 
    423470 

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

    r1255 r1457  
    2323   USE trdmld_trc 
    2424   USE trdmld_trc_oce 
     25   USE iom 
    2526 
    2627   IMPLICIT NONE 
    … …  
    3031 
    3132   !!* Substitution 
    32 #  include "domzgr_substitute.h90" 
     33#  include "top_substitute.h90" 
    3334   !!---------------------------------------------------------------------- 
    3435   !! NEMO/TOP 2.0 , LOCEAN-IPSL (2007)  
    … …  
    5455      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index       
    5556      !! 
    56       INTEGER  ::   ji, jj, jk, jl 
    57       REAL(wp) ::   zgeolpoc, zfact 
    58       INTEGER , DIMENSION(jpi,jpj) ::   ikbot 
    59       REAL(wp), DIMENSION(jpi,jpj) ::   zwork 
     57      INTEGER  ::   ji, jj, jk, jl, ikbot 
     58      REAL(wp) ::   zgeolpoc, zfact, zwork, ze3t 
    6059      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrbio 
    6160      CHARACTER (len=25) :: charout 
    … …  
    8180      DO jk = 1, jpkm1 
    8281         DO jj = 2, jpjm1 
    83             DO ji = 2, jpim1 
    84                tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3)   & 
    85      &                             + (1./fse3t(ji,jj,jk)) * dmin3(ji,jj,jk) * fbod(ji,jj) 
     82            DO ji = fs_2, fs_jpim1 
     83               ze3t = 1. / fse3t(ji,jj,jk) 
     84               tra(ji,jj,jk,jpno3) = tra(ji,jj,jk,jpno3) + ze3t * dmin3(ji,jj,jk) * fbod(ji,jj) 
    8685            END DO 
    8786         END DO 
    8887      END DO 
    8988 
    90 !    Find the last level of the water column 
    91 !    Compute fluxes due to sinking particles (slow) 
     89      ! Find the last level of the water column 
     90      ! Compute fluxes due to sinking particles (slow) 
    9291    
    93       ikbot(:,:) = jpk 
    94       zwork(:,:) = 0.e0 
    9592 
    96 !!gm ikbot already exist in opa... 
    97       DO jk = 1, jpkm1 
    98          DO jj = 2, jpjm1 
    99             DO ji = 2, jpim1 
    100                IF( tmask(ji,jj,jk) == 1 .AND.  tmask(ji,jj,jk+1) == 0 ) THEN 
    101                   ikbot(ji,jj) = jk 
    102                   zwork(ji,jj) = vsed * trn(ji,jj,jk,jpdet) 
    103                ENDIF 
    104             END DO 
     93      zgeolpoc = 0.e0         !     Initialization 
     94      ! Release of nutrients from the "simple" sediment 
     95      DO jj = 2, jpjm1 
     96         DO ji = fs_2, fs_jpim1 
     97            ikbot = mbathy(ji,jj) - 1 
     98            tra(ji,jj,ikbot,jpno3) = tra(ji,jj,ikbot,jpno3) + sedlam * sedpocn(ji,jj) / fse3t(ji,jj,ikbot)  
     99            ! Deposition of organic matter in the sediment 
     100            zwork = vsed * trn(ji,jj,ikbot,jpdet) 
     101            sedpoca(ji,jj) = ( zwork + dminl(ji,jj) * fbod(ji,jj)   & 
     102               &           - sedlam * sedpocn(ji,jj) - sedlostpoc * sedpocn(ji,jj) ) * rdt 
     103            zgeolpoc = zgeolpoc + sedlostpoc * sedpocn(ji,jj) * e1t(ji,jj) * e2t(ji,jj) 
    105104         END DO 
    106105      END DO 
    107106 
    108       zgeolpoc = 0.e0         !     Initialization 
    109  
    110       ! Release of nutrients from the "simple" sediment 
    111107      DO jj = 2, jpjm1 
    112          DO ji = 2, jpim1 
    113             tra(ji,jj,ikbot(ji,jj),jpno3) = tra(ji,jj,ikbot(ji,jj),jpno3)   & 
    114                &                          + sedlam * sedpocn(ji,jj) / fse3t(ji,jj,ikbot(ji,jj)) 
    115  
    116             !     Deposition of organic matter in the sediment 
    117             zgeolpoc = zgeolpoc + sedlostpoc * sedpocn(ji,jj) * e1t(ji,jj) * e2t(ji,jj) 
    118  
    119 !!gm factorisationof rdt just bellow... 
    120             sedpoca(ji,jj) = zwork(ji,jj) * rdt + dminl(ji,jj) * fbod(ji,jj) * rdt   & 
    121                &           - sedlam * sedpocn(ji,jj) * rdt - sedlostpoc * sedpocn(ji,jj) * rdt 
    122  
    123          END DO 
    124       END DO 
    125  
    126       DO jj = 2,jpjm1 
    127          DO ji = 2,jpim1 
     108         DO ji = fs_2, fs_jpim1 
    128109            tra(ji,jj,1,jpno3) = tra(ji,jj,1,jpno3) + zgeolpoc * cmask(ji,jj) / areacot / fse3t(ji,jj,1) 
    129110         END DO 
    … …  
    133114  
    134115      ! Oa & Ek: diagnostics depending on jpdia2d !          left as example 
    135 # if defined key_trc_diaadd 
     116#if defined key_trc_diaadd 
     117# if ! defined key_iomput 
    136118      trc2d(:,:,jp_lob0_2d + 18) = sedpocn(:,:) 
     119# else 
     120     CALL iom_put( "SEDPOC" , sedpocn ) 
    137121# endif 
     122#endif 
    138123 
    139124      ! Leap-frog scheme (only in explicit case, otherwise the  

  • trunk/NEMO/TOP_SRC/LOBSTER/trclsm_lobster.F90

    r1283 r1457  
    4242      INTEGER ::   numnatl 
    4343      !! 
    44 #if defined key_trc_diaadd 
     44#if defined key_trc_diaadd && ! defined key_iomput 
    4545      INTEGER :: jl, jn 
    4646      ! definition of additional diagnostic as a structure 
    … …  
    7878 
    7979      NAMELIST/namlobopt/ xkg0, xkr0, xkgp, xkrp, xlg, xlr, rpig 
    80 #if defined key_trc_diaadd 
     80#if defined key_trc_diaadd && ! defined key_iomput 
    8181      NAMELIST/namlobdia/nwritedia, lobdia3d, lobdia2d     ! additional diagnostics 
    8282#endif 
    … …  
    280280      ENDIF 
    281281 
    282 #if defined key_trc_diaadd 
     282#if defined key_trc_diaadd && ! defined key_iomput 
    283283 
    284284      ! Namelist namlobdia 

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

    r1255 r1457  
    2020   USE trdmld_trc 
    2121   USE trdmld_trc_oce 
    22  
     22   USE iom 
    2323   USE prtctl_trc      ! Print control for debbuging 
    2424 
    … …  
    6161      REAL(wp) ::   ztra 
    6262      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwork 
     63#if defined key_trc_diaadd && defined key_iomput 
     64      REAL(wp), DIMENSION(jpi,jpj) ::  zw2d 
     65#endif 
    6366      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrbio 
    6467      CHARACTER (len=25) :: charout 
    … …  
    7578 
    7679      ! for detritus sedimentation only - jpdet 
    77  
    7880      zwork(:,:,1  ) = 0.e0      ! surface value set to zero 
    7981      zwork(:,:,jpk) = 0.e0      ! bottom value  set to zero 
     82 
     83#if defined key_trc_diaadd && defined key_iomput 
     84      zw2d(:,:) = 0. 
     85# endif 
    8086 
    8187      IF( l_trdtrc )THEN 
    … …  
    8591 
    8692      ! tracer flux at w-point: we use -vsed (downward flux)  with simplification : no e1*e2 
    87  
    88       DO jk = 2, jpk 
     93      DO jk = 2, jpkm1 
    8994         zwork(:,:,jk) = -vsed * trn(:,:,jk-1,jpdet) 
    9095      END DO 
    9196 
    9297      ! tracer flux divergence at t-point added to the general trend 
    93  
    9498      DO jk = 1, jpkm1 
    9599         DO jj = 1, jpj 
    … …  
    97101               ztra  = - ( zwork(ji,jj,jk) - zwork(ji,jj,jk+1) ) / fse3t(ji,jj,jk) 
    98102               tra(ji,jj,jk,jpdet) = tra(ji,jj,jk,jpdet) + ztra 
    99 # if defined key_trc_diabio 
     103#if defined key_trc_diabio 
    100104               trbio(ji,jj,jk,jp_lob0_trd + 7) = ztra 
     105#endif 
     106#if defined key_trc_diaadd 
     107# if ! defined key_iomput 
     108               trc2d(ji,jj,jp_lob0_2d + 7) = trc2d(ji,jj,jp_lob0_2d + 7) + ztra * fse3t(ji,jj,jk) * 86400. 
     109# else 
     110               zw2d(ji,jj) = zw2d(ji,jj) + ztra * fse3t(ji,jj,jk) * 86400. 
    101111# endif 
    102 # if defined key_trc_diaadd 
    103                trc2d(ji,jj,jp_lob0_2d + 7) = trc2d(ji,jj,jp_lob0_2d + 7) + ztra * fse3t(ji,jj,jk) * 86400. 
    104 # endif 
     112#endif 
    105113            END DO 
    106114         END DO 
    … …  
    112120#endif 
    113121#if defined key_trc_diaadd 
     122# if ! defined key_iomput 
    114123      jl = jp_lob0_2d + 7 
    115124      CALL lbc_lnk( trc2d(:,:,jl), 'T', 1. )      ! Lateral boundary conditions on trc2d 
     125# else 
     126      CALL lbc_lnk( zw2d(:,:), 'T', 1. )      ! Lateral boundary conditions on zw2d 
     127      CALL iom_put( "TDETSED", zw2d ) 
     128# endif 
    116129#endif 
    117130      ! 

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

    r1329 r1457  
    2626   USE p4zrem          !  
    2727   USE prtctl_trc 
    28     
     28   USE iom 
     29   
    2930   IMPLICIT NONE 
    3031   PRIVATE 
    … …  
    6263#if defined key_kriest 
    6364      REAL(wp) ::  zcoef1, zcoef2 
     65#endif 
     66#if defined key_trc_dia3d && defined key_kriest && defined key_iomput 
     67      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zw3d 
    6468#endif 
    6569      CHARACTER (len=25) :: charout 
    … …  
    128132 
    129133# if defined key_trc_dia3d && defined key_kriest 
    130       trc3d(:,:,:,jp_pcs0_3d + 10) = tra(:,:,:,jpcal) & 
    131      &                              * xnegtr(:,:,:) * 1.e3 * rfact2r  * tmask(:,:,:) 
     134#if ! defined key_iomput 
     135      trc3d(:,:,:,jp_pcs0_3d + 10) = tra(:,:,:,jpcal) * xnegtr(:,:,:) * 1.e3 * rfact2r  * tmask(:,:,:) 
     136#else 
     137      zw3d(:,:,:) = tra(:,:,:,jpcal) * xnegtr(:,:,:) * 1.e3 * rfact2r  * tmask(:,:,:) 
     138      IF( jnt == nrdttrc ) CALL iom_put( "PBSi", zw3d ) 
    132139# endif 
     140#endif 
    133141      ! 
    134142      IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 

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

    r1329 r1457  
    2323   USE prtctl_trc 
    2424   USE p4zche 
     25   USE iom 
    2526 
    2627   USE lib_mpp 
    … …  
    3233 
    3334   REAL(wp) :: &  ! pre-industrial atmospheric [co2] (ppm)   
    34      atcox  = 0.20946 ,   &  !: 
    35      atcco2 = 278.           !: 
    36  
    37    REAL(wp) :: & 
    38      tco2flx                 !: Total flux of carbon per year 
     35      atcox  = 0.20946 ,    &  !: 
     36      atcco2 = 278.            !: 
     37  
     38   REAL(wp) :: &           
     39      xconv  = 0.01/3600.,  &  ! coefficients for conversion        
     40      tco2flx                 !: Total flux of carbon per year 
    3941 
    4042   !!* Substitution 
    … …  
    5860      INTEGER, INTENT(in) :: kt 
    5961      INTEGER  ::   ji, jj, jrorr, nspyr 
    60       REAL(wp) ::   zttc, zws, zkgwan 
     62      REAL(wp) ::   ztc, ztc2, ztc3, zws, zkgwan 
    6163      REAL(wp) ::   zfld, zflu, zfld16, zflu16, zfact 
    62       REAL(wp) ::   zph, zah2, zbot, zdic, zalk, zschmitto2, zalka, zschmittco2 
     64      REAL(wp) ::   zph, zah2, zbot, zdic, zalk, zsch_o2, zalka, zsch_co2 
    6365      REAL(wp), DIMENSION(jpi,jpj) ::   zkgco2, zkgo2, zh2co3, ztco2flx 
     66#if defined key_trc_diaadd && defined key_iomput 
     67      REAL(wp), DIMENSION(jpi,jpj) ::  zcflx, zoflx, zkg, zdelc 
     68#endif 
    6469      CHARACTER (len=25) :: charout 
    6570 
    … …  
    120125!CDIR NOVERRCHK 
    121126         DO ji = 1, jpi 
    122  
    123             zttc = MIN( 35., tn(ji,jj,1) ) 
    124  
    125       ! Compute the schmidt Number both O2 and CO2 
    126       ! ------------------------------------------ 
    127  
    128             zschmittco2 = 2073.1 - 125.62 * zttc + 3.6276 * zttc**2 - 0.043126 * zttc**3 
    129             zschmitto2  = 1953.4 - 128.0 * zttc + 3.9918 * zttc**2 - 0.050091 * zttc**3 
    130  
     127            ztc  = MIN( 35., tn(ji,jj,1) ) 
     128            ztc2 = ztc * ztc 
     129            ztc3 = ztc * ztc2  
     130            ! Compute the schmidt Number both O2 and CO2 
     131            zsch_co2 = 2073.1 - 125.62 * ztc + 3.6276 * ztc2 - 0.043126 * ztc3 
     132            zsch_o2  = 1953.4 - 128.0  * ztc + 3.9918 * ztc2 - 0.050091 * ztc3 
    131133            !  wind speed  
    132             zws  = wndm(ji,jj) 
    133  
    134       ! Compute the piston velocity for O2 and CO2 
    135       ! ------------------------------------------ 
    136  
    137             zkgwan = (  0.3 * zws * zws    & 
    138                &   + 2.5 * ( 0.5246 + zttc * ( 0.016256+zttc*0.00049946 ) ) ) & 
     134            zws  = wndm(ji,jj) * wndm(ji,jj) 
     135            ! Compute the piston velocity for O2 and CO2 
     136            zkgwan = 0.3 * zws  + 2.5 * ( 0.5246 + 0.016256 * ztc + 0.00049946  * ztc2 ) 
    139137# if defined key_off_degrad 
    140                &         * facvol(ji,jj,1)      & 
    141 # endif 
    142                &   / (100. * 3600.)* ( 1.- fr_i(ji,jj) ) * tmask(ji,jj,1)   
    143  
    144             ! COMPUTE GAS EXCHANGE FOR CO2 
    145             zkgco2(ji,jj) = zkgwan * SQRT( 660./ zschmittco2 ) 
    146             zkgo2(ji,jj)  = zkgwan * SQRT( 660./ zschmitto2 ) 
    147  
    148          END DO 
    149       END DO 
    150  
    151       ztco2flx(:,:) = 0. 
     138            zkgwan = zkgwan * xconv * ( 1.- fr_i(ji,jj) ) * tmask(ji,jj,1) * facvol(ji,jj,1) 
     139#else 
     140            zkgwan = zkgwan * xconv * ( 1.- fr_i(ji,jj) ) * tmask(ji,jj,1) 
     141#endif  
     142            ! compute gas exchange for CO2 and O2 
     143            zkgco2(ji,jj) = zkgwan * SQRT( 660./ zsch_co2 ) 
     144            zkgo2 (ji,jj) = zkgwan * SQRT( 660./ zsch_o2 ) 
     145         END DO 
     146      END DO 
     147 
     148#if ! defined key_iomput 
    152149      DO jj = 1, jpj 
    153150         DO ji = 1, jpi 
    … …  
    167164            tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + ( zfld16 - zflu16 ) / fse3t(ji,jj,1) 
    168165 
    169 # if defined key_trc_diaadd 
     166# if defined key_trc_diaadd  
    170167            ! Save diagnostics 
    171168            trc2d(ji,jj,jp_pcs0_2d    ) = ( zfld - zflu ) * 1000.  * tmask(ji,jj,1) 
    … …  
    177174      END DO 
    178175      ! 
     176#else 
     177      DO jj = 1, jpj 
     178         DO ji = 1, jpi 
     179            ! Compute CO2 flux for the sea and air 
     180            zfld = atcco2 * tmask(ji,jj,1) * chemc(ji,jj,1) * zkgco2(ji,jj) 
     181            zflu = zh2co3(ji,jj) * tmask(ji,jj,1) * zkgco2(ji,jj) 
     182            tra(ji,jj,1,jpdic) = tra(ji,jj,1,jpdic) + ( zfld - zflu ) / fse3t(ji,jj,1) 
     183 
     184            ! compute flux of carbon 
     185            ztco2flx(ji,jj) = ( zfld - zflu ) * rfact & 
     186               &             * e1t(ji,jj) * e2t(ji,jj) * tmask(ji,jj,1) * 1000. 
     187 
     188            ! Compute O2 flux  
     189            zfld16 = atcox * chemc(ji,jj,2) *tmask(ji,jj,1) * zkgo2(ji,jj) 
     190            zflu16 = trn(ji,jj,1,jpoxy) * tmask(ji,jj,1) * zkgo2(ji,jj) 
     191            tra(ji,jj,1,jpoxy) = tra(ji,jj,1,jpoxy) + ( zfld16 - zflu16 ) / fse3t(ji,jj,1) 
     192# if defined key_trc_diaadd  
     193            ! Save diagnostics 
     194            zcflx(ji,jj) = ( zfld - zflu ) * 1000.  * tmask(ji,jj,1) 
     195            zoflx(ji,jj) = ( zfld16 - zflu16 ) * 1000. * tmask(ji,jj,1) 
     196            zkg  (ji,jj) = zkgco2(ji,jj) * tmask(ji,jj,1) 
     197            zdelc(ji,jj) = atcco2 - zh2co3(ji,jj) / ( chemc(ji,jj,1) + rtrn ) * tmask(ji,jj,1) 
     198# endif 
     199         END DO 
     200      END DO 
     201#endif 
    179202 
    180203      ! Total Flux of Carbon 
    … …  
    203226      ENDIF 
    204227 
     228# if defined key_trc_diaadd && defined key_iomput 
     229      CALL iom_put( "Cflx", zcflx ) 
     230      CALL iom_put( "Oflx", zoflx ) 
     231      CALL iom_put( "Kg"  , zkg   ) 
     232      CALL iom_put( "DelC", zdelc ) 
     233#endif 
    205234 
    206235   END SUBROUTINE p4z_flx 

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

    r1329 r1457  
    2222   USE sms_pisces 
    2323   USE prtctl_trc 
     24   USE iom 
    2425 
    2526   IMPLICIT NONE 
    … …  
    6162      REAL(wp) ::   zomegaca, zexcess, zexcess0 
    6263      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zco3 
     64#if defined key_trc_dia3d && defined key_iomput 
     65      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zw3d 
     66#endif 
    6367      CHARACTER (len=25) :: charout 
    6468      !!--------------------------------------------------------------------- 
    … …  
    151155 
    152156# if defined key_trc_diaadd &&  defined key_trc_dia3d 
    153       DO jk = 1, jpk 
    154          DO jj = 1, jpj 
    155             DO ji = 1, jpi 
    156                trc3d(ji,jj,jk,jp_pcs0_3d    ) = hi  (ji,jj,jk)          * tmask(ji,jj,jk) 
    157                trc3d(ji,jj,jk,jp_pcs0_3d + 1) = zco3(ji,jj,jk)          * tmask(ji,jj,jk) 
    158                trc3d(ji,jj,jk,jp_pcs0_3d + 2) = aksp(ji,jj,jk) / calcon * tmask(ji,jj,jk) 
    159             ENDDO 
    160          ENDDO 
    161       ENDDO 
     157#  if ! defined key_iomput 
     158      trc3d(:,:,:,jp_pcs0_3d    ) = hi  (:,:,:)          * tmask(:,:,:) 
     159      trc3d(:,:,:,jp_pcs0_3d + 1) = zco3(:,:,:)          * tmask(:,:,:) 
     160      trc3d(:,:,:,jp_pcs0_3d + 2) = aksp(:,:,:) / calcon * tmask(:,:,:) 
     161#  else 
     162      zw3d(:,:,:) = hi  (:,:,:)          * tmask(:,:,:) 
     163      CALL iom_put( "PH", zw3d ) 
     164      zw3d(:,:,:) = zco3(:,:,:)          * tmask(:,:,:) 
     165      CALL iom_put( "CO3", zw3d ) 
     166      zw3d(:,:,:) = aksp(:,:,:) / calcon * tmask(:,:,:) 
     167      CALL iom_put( "CO3sat", zw3d ) 
     168#  endif 
    162169# endif 
    163170      ! 

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

    r1445 r1457  
    1818   USE trc_oce        ! ocean-tracer share variables 
    1919   USE sms_pisces     ! Source Minus Sink of PISCES 
     20   USE iom 
    2021 
    2122   IMPLICIT NONE 
    … …  
    6061      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zekg, zekr, zekb 
    6162      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   ze1 , ze2 , ze3, ze0 
     63#if defined key_trc_diaadd && defined key_iomput 
     64     REAL(wp), DIMENSION(jpi,jpj)      ::   zw2d 
     65     REAL(wp), DIMENSION(jpi,jpj,jpk)  ::   zw3d 
     66#endif 
    6267      !!--------------------------------------------------------------------- 
    6368 
    … …  
    226231      END DO 
    227232 
    228 # if defined key_trc_diaadd 
    229       trc2d(:,:,  jp_pcs0_2d + 10) = heup (:,:) * tmask(:,:,1)      ! save for outputs 
     233#if defined key_trc_diaadd 
     234# if ! defined key_iomput 
     235      ! save for outputs 
     236      trc2d(:,:,  jp_pcs0_2d + 10) = heup(:,:  ) * tmask(:,:,1)   
     237      trc3d(:,:,:,jp_pcs0_3d + 3)  = etot(:,:,:) * tmask(:,:,:) 
     238# else 
     239      ! write diagnostics  
     240      zw2d(:,:  ) =  heup(:,:  ) * tmask(:,:,1) 
     241      zw3d(:,:,:) =  etot(:,:,:) * tmask(:,:,:) 
     242      IF( jnt == nrdttrc ) CALL iom_put( "heup", zw2d )                
     243      IF( jnt == nrdttrc ) CALL iom_put( "PAR" , zw3d ) 
    230244# endif 
     245#endif 
    231246      ! 
    232247   END SUBROUTINE p4z_opt 

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

    r1351 r1457  
    2020   USE p4zint 
    2121   USE p4zlim 
     22   USE iom 
    2223 
    2324   USE lib_mpp 
    … …  
    7879#if defined key_trc_diaadd && defined key_trc_dia3d 
    7980      REAL(wp) ::   zrfact2 
     81#if  defined key_iomput 
     82      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zw3d 
     83#endif 
    8084#endif 
    8185      REAL(wp), DIMENSION(jpi,jpj)     ::   zmixnano   , zmixdiat, zstrn 
    … …  
    107111 
    108112 
    109 !     Computation of the optimal production 
    110 !     ------------------------------------- 
     113      ! Computation of the optimal production 
    111114 
    112115# if defined key_off_degrad 
    … …  
    117120 
    118121      ! compute the day length depending on latitude and the day 
    119       !-------------------------------------------------------- 
    120122      IF(lwp) write(numout,*) 
    121123      IF(lwp) write(numout,*) 'p4zday : - Julian day ', nday_year 
    … …  
    147149            DO ji = 1, jpi 
    148150 
    149 !      Computation of the P-I slope for nanos and diatoms 
    150 !      -------------------------------------------------- 
    151                 IF( etot(ji,jj,jk) > 1.E-3 ) THEN 
     151               ! Computation of the P-I slope for nanos and diatoms 
     152               IF( etot(ji,jj,jk) > 1.E-3 ) THEN 
    152153                   ztn    = MAX( 0., tn(ji,jj,jk) - 15. ) 
    153154                   zadap  = 0.+ 1.* ztn / ( 2.+ ztn ) 
    … …  
    167168                     &          / ( prmax(ji,jj,jk) * rjjss * xlimdia(ji,jj,jk) + rtrn ) 
    168169 
    169 !     Computation of production function 
    170 !     ---------------------------------- 
    171  
     170                   ! Computation of production function 
    172171                   zprbio(ji,jj,jk) = prmax(ji,jj,jk) * & 
    173172                     &                (  1.- EXP( -zpislopen * enano(ji,jj,jk) )  ) 
    … …  
    185184 
    186185                IF( etot(ji,jj,jk) > 1.E-3 ) THEN 
    187 !    Si/C of diatoms 
    188 !    ------------------------ 
    189 !    Si/C increases with iron stress and silicate availability 
    190 !    Si/C is arbitrariliy increased for very high Si concentrations 
    191 !    to mimic the very high ratios observed in the Southern Ocean (silpot2) 
     186                   !    Si/C of diatoms 
     187                   !    ------------------------ 
     188                   !    Si/C increases with iron stress and silicate availability 
     189                   !    Si/C is arbitrariliy increased for very high Si concentrations 
     190                   !    to mimic the very high ratios observed in the Southern Ocean (silpot2) 
    192191 
    193192                  zlim1  = trn(ji,jj,jk,jpsil) / ( trn(ji,jj,jk,jpsil) + xksi1 ) 
    … …  
    209208      END DO 
    210209 
    211 !    Computation of the limitation term due to 
    212 !    A mixed layer deeper than the euphotic depth 
    213 !    -------------------------------------------- 
    214  
     210      !  Computation of the limitation term due to 
     211      !  A mixed layer deeper than the euphotic depth 
    215212      DO jj = 1, jpj 
    216213         DO ji = 1, jpi 
    … …  
    221218         END DO 
    222219      END DO 
    223                                                                                  
     220  
     221      !  Mixed-layer effect on production                                                                                
    224222      DO jk = 1, jpkm1 
    225223         DO jj = 1, jpj 
    226224            DO ji = 1, jpi 
    227225               IF( fsdepw(ji,jj,jk+1) <= hmld(ji,jj) ) THEN 
    228  
    229 !     Mixed-layer effect on production 
    230 !     -------------------------------- 
    231226                  zprbio(ji,jj,jk) = zprbio(ji,jj,jk) * zmixnano(ji,jj) 
    232227                  zprdia(ji,jj,jk) = zprdia(ji,jj,jk) * zmixdiat(ji,jj) 
    … …  
    365360      zrfact2 = 1.e3 * rfact2r 
    366361      !   Supplementary diagnostics 
    367       DO jk = 1, jpk 
    368          DO jj = 1, jpj 
    369             DO ji = 1, jpi  
    370                trc3d(ji,jj,jk,jp_pcs0_3d + 3)  = etot(ji,jj,jk)               * tmask(ji,jj,jk) 
    371                trc3d(ji,jj,jk,jp_pcs0_3d + 4)  = zprorca (ji,jj,jk) * zrfact2 * tmask(ji,jj,jk) 
    372                trc3d(ji,jj,jk,jp_pcs0_3d + 5)  = zprorcad(ji,jj,jk) * zrfact2 * tmask(ji,jj,jk) 
    373                trc3d(ji,jj,jk,jp_pcs0_3d + 6)  = zpronew (ji,jj,jk) * zrfact2 * tmask(ji,jj,jk) 
    374                trc3d(ji,jj,jk,jp_pcs0_3d + 7)  = zpronewd(ji,jj,jk) * zrfact2 * tmask(ji,jj,jk) 
    375                trc3d(ji,jj,jk,jp_pcs0_3d + 8)  = zprorcad(ji,jj,jk) * zrfact2 * tmask(ji,jj,jk) & 
    376      &                                         * zysopt(ji,jj,jk) 
    377                trc3d(ji,jj,jk,jp_pcs0_3d + 9)  = zprofed (ji,jj,jk) * zrfact2 * tmask(ji,jj,jk) 
     362#  if ! defined key_iomput 
     363      trc3d(:,:,:,jp_pcs0_3d + 4)  = zprorca (:,:,:) * zrfact2 * tmask(:,:,:) 
     364      trc3d(:,:,:,jp_pcs0_3d + 5)  = zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) 
     365      trc3d(:,:,:,jp_pcs0_3d + 6)  = zpronew (:,:,:) * zrfact2 * tmask(:,:,:) 
     366      trc3d(:,:,:,jp_pcs0_3d + 7)  = zpronewd(:,:,:) * zrfact2 * tmask(:,:,:) 
     367      trc3d(:,:,:,jp_pcs0_3d + 8)  = zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) * zysopt(:,:,:) 
     368      trc3d(:,:,:,jp_pcs0_3d + 9)  = zprofed (:,:,:) * zrfact2 * tmask(:,:,:) 
    378369#if ! defined key_kriest 
    379                trc3d(ji,jj,jk,jp_pcs0_3d + 10) = zprofen (ji,jj,jk) * zrfact2 * tmask(ji,jj,jk) 
     370      trc3d(:,:,:,jp_pcs0_3d + 10) = zprofen (:,:,:) * zrfact2 * tmask(:,:,:) 
    380371#endif 
    381             ENDDO 
    382          ENDDO 
    383       ENDDO 
     372 
     373# else 
     374      zw3d(:,:,:) = zprorca (:,:,:) * zrfact2 * tmask(:,:,:) 
     375      IF( jnt == nrdttrc ) CALL iom_put( "PPPHY" , zw3d ) 
     376      zw3d(:,:,:) = zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) 
     377      IF( jnt == nrdttrc ) CALL iom_put( "PPPHY2", zw3d ) 
     378      zw3d(:,:,:) = zpronew (:,:,:) * zrfact2 * tmask(:,:,:) 
     379      IF( jnt == nrdttrc ) CALL iom_put( "PPZOO" , zw3d ) 
     380      zw3d(:,:,:) = zpronewd(:,:,:) * zrfact2 * tmask(:,:,:) 
     381      IF( jnt == nrdttrc ) CALL iom_put( "PPZOO2", zw3d ) 
     382      zw3d(:,:,:) = zprorcad(:,:,:) * zrfact2 * tmask(:,:,:) * zysopt(:,:,:) 
     383      IF( jnt == nrdttrc ) CALL iom_put( "PBSi"  , zw3d ) 
     384      zw3d(:,:,:) = zprofed (:,:,:) * zrfact2 * tmask(:,:,:) 
     385      IF( jnt == nrdttrc ) CALL iom_put( "PFeD"  , zw3d ) 
     386      zw3d(:,:,:) = zprofen (:,:,:) * zrfact2 * tmask(:,:,:) 
     387      IF( jnt == nrdttrc ) CALL iom_put( "PFeN"  , zw3d ) 
     388# endif 
    384389#endif 
    385390 

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

    r1329 r1457  
    8989      REAL(wp), DIMENSION(jpi,jpj)     ::   zsidep 
    9090      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   znitrpot, zirondep 
     91#if defined key_trc_diaadd && defined key_iomput 
     92     REAL(wp), DIMENSION(jpi,jpj)     ::   zw2d 
     93#endif 
    9194      CHARACTER (len=25) :: charout 
    9295      !!--------------------------------------------------------------------- 
    … …  
    9497 
    9598      IF( ( kt * jnt ) == nittrc000  )   CALL p4z_sed_init      ! Initialization (first time-step only) 
    96  
    9799      IF( (jnt == 1) .and. (bdustfer) )  CALL p4z_sbc( kt ) 
    98100 
    … …  
    136138 
    137139      DO jk = 1, jpkm1 
    138          trn(:,:,jk,jpfer) = trn(:,:,jk,jpfer)   & 
    139          &       + zirondep(:,:,jk) + ironsed(:,:,jk) * rfact2 
     140         trn(:,:,jk,jpfer) = trn(:,:,jk,jpfer) + zirondep(:,:,jk) + ironsed(:,:,jk) * rfact2 
    140141      END DO 
    141142 
    142143 
    143144#if ! defined key_sed 
    144  
    145145      ! Initialisation of variables used to compute Sinking Speed 
    146       ! --------------------------------------------------------- 
    147  
    148146      zsumsedsi  = 0.e0 
    149147      zsumsedpo4 = 0.e0 
    … …  
    154152      ! The factor for calcite comes from the alkalinity effect 
    155153      ! ------------------------------------------------------------- 
    156  
    157154      DO jj = 1, jpj 
    158155         DO ji = 1, jpi 
    159156            ikt = MAX( mbathy(ji,jj)-1, 1 ) 
    160157            zfact = e1t(ji,jj) * e2t(ji,jj) / rjjss * tmask_i(ji,jj) 
    161  
    162158# if defined key_kriest 
    163159            zsumsedsi  = zsumsedsi  + zfact *  trn(ji,jj,ikt,jpdsi) * wscal (ji,jj,ikt) 
    … …  
    168164               &       + trn(ji,jj,ikt,jppoc) * wsbio3(ji,jj,ikt) ) 
    169165# endif 
    170  
    171166            zsumsedcal = zsumsedcal + zfact *  trn(ji,jj,ikt,jpcal) * wscal (ji,jj,ikt) * 2.e0 
    172  
    173167         END DO 
    174168      END DO 
    … …  
    197191     &             * wsbio4(ji,jj,ikt) 
    198192# endif 
    199  
    200193            trn(ji,jj,ikt,jpdsi) = trn(ji,jj,ikt,jpdsi) - zconctmp 
    201194 
    … …  
    226219            ikt = MAX( mbathy(ji,jj) - 1, 1 ) 
    227220            zfact = zstep / fse3t(ji,jj,ikt) 
    228  
    229221# if ! defined key_kriest 
    230222            zconctmp  = trn(ji,jj,ikt,jpgoc) 
    … …  
    241233 
    242234# else 
    243  
    244235            zconctmp  = trn(ji,jj,ikt,jpnum) 
    245236            zconctmp2 = trn(ji,jj,ikt,jppoc) 
    … …  
    327318      END DO 
    328319 
    329 # if defined key_trc_diaadd 
    330       DO jj = 1,jpj 
    331          DO ji = 1,jpi 
    332             trc2d(ji,jj,jp_pcs0_2d + 11) = zirondep(ji,jj,1) * 1.e+3 * rfact2r & 
    333       &                                   * fse3t(ji,jj,1) * tmask(ji,jj,1) 
    334             trc2d(ji,jj,jp_pcs0_2d + 12) = znitrpot(ji,jj,1) * 1.e-7 & 
    335       &                                   * fse3t(ji,jj,1) * 1.e+3 / rfact2 * tmask(ji,jj,1) 
    336          END DO 
    337       END DO 
     320#if defined key_trc_diaadd 
     321#  if  ! defined key_iomput 
     322      trc2d(:,:,jp_pcs0_2d + 11) = zirondep(:,:,1)         * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1) 
     323      trc2d(:,:,jp_pcs0_2d + 12) = znitrpot(:,:,1) * 1.e-7 * 1.e+3 / rfact2  * fse3t(:,:,1) * tmask(:,:,1) 
     324# else 
     325      ! write diagnostics 
     326      zw2d(:,:) = zirondep(:,:,1)         * 1.e+3 * rfact2r * fse3t(:,:,1) * tmask(:,:,1) 
     327      IF( jnt == nrdttrc ) CALL iom_put( "Fedep", zw2d ) 
     328      zw2d(:,:) = znitrpot(:,:,1) * 1.e-7 * 1.e+3 / rfact2  * fse3t(:,:,1) * tmask(:,:,1) 
     329      IF( jnt == nrdttrc ) CALL iom_put( "Nfix", zw2d  )  
     330# endif 
     331 
    338332# endif 
    339333      ! 

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

    r1329 r1457  
    1414   USE sms_pisces 
    1515   USE prtctl_trc 
    16  
     16   USE iom 
    1717 
    1818   IMPLICIT NONE 
    … …  
    3434   REAL(wp) ::   & 
    3535     xstep , xstep2            !: Time step duration for biology 
     36 
     37   INTEGER  :: & 
     38      iksed  = 10              ! 
    3639 
    3740#if  defined key_kriest 
    … …  
    8992      INTEGER, INTENT(in) :: kt, jnt 
    9093      INTEGER  :: ji, jj, jk 
    91       INTEGER  :: iksed 
    9294      REAL(wp) :: zagg1, zagg2, zagg3, zagg4, zagg5, zaggsi, zaggsh 
    9395      REAL(wp) :: zagg , zaggdoc, znumdoc 
    … …  
    9597      REAL(wp) :: zdiv , zdiv1, zdiv2, zdiv3, zdiv4, zdiv5 
    9698      REAL(wp) :: zval1, zval2, zval3, zval4 
    97 #if defined key_trc_dia3d 
    98       REAL(wp) ::   zrfact2 
     99#if defined key_trc_diaadd 
     100      REAL(wp) :: zrfact2 
     101      INTEGER  :: iksed1 
     102#if defined key_iomput 
     103      REAL(wp), DIMENSION(jpi,jpj)     ::   zw2d 
     104      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zw3d 
     105#endif 
    99106#endif 
    100107      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   znum3d 
    … …  
    113120 
    114121       znum3d(:,:,:) = 0.e0 
    115        iksed = 10 
    116122       zval1 = 1. + xkr_zeta 
    117123       zval2 = 1. + xkr_zeta + xkr_eta 
    … …  
    281287#if defined key_trc_diaadd 
    282288      zrfact2 = 1.e3 * rfact2r 
    283       DO jj = 1, jpj  
    284          DO ji = 1, jpi 
    285             trc2d(ji,jj, jp_pcs0_2d + 4) = sinking (ji,jj,iksed+1) * zrfact2 * tmask(ji,jj,1) 
    286             trc2d(ji,jj, jp_pcs0_2d + 5) = sinking2(ji,jj,iksed+1) * zrfact2 * tmask(ji,jj,1) 
    287             trc2d(ji,jj, jp_pcs0_2d + 6) = sinkfer (ji,jj,iksed+1) * zrfact2 * tmask(ji,jj,1) 
    288             trc2d(ji,jj, jp_pcs0_2d + 7) = sinksil (ji,jj,iksed+1) * zrfact2 * tmask(ji,jj,1) 
    289             trc2d(ji,jj, jp_pcs0_2d + 8) = sinkcal (ji,jj,iksed+1) * zrfact2 * tmask(ji,jj,1) 
    290          ENDDO 
    291       ENDDO 
    292 #  if defined key_trc_dia3d 
    293       DO jk = 1, jpk 
    294          DO jj = 1, jpj 
    295             DO ji = 1, jpi 
    296                trc3d(ji,jj,jk,jp_pcs0_3d + 11) = sinking (ji,jj,jk) * zrfact2 * tmask(ji,jj,jk) 
    297                trc3d(ji,jj,jk,jp_pcs0_3d + 12) = sinking2(ji,jj,jk) * zrfact2 * tmask(ji,jj,jk) 
    298                trc3d(ji,jj,jk,jp_pcs0_3d + 13) = sinksil (ji,jj,jk) * zrfact2 * tmask(ji,jj,jk) 
    299                trc3d(ji,jj,jk,jp_pcs0_3d + 14) = sinkcal (ji,jj,jk) * zrfact2 * tmask(ji,jj,jk) 
    300                trc3d(ji,jj,jk,jp_pcs0_3d + 15) = znum3d  (ji,jj,jk)           * tmask(ji,jj,jk) 
    301                trc3d(ji,jj,jk,jp_pcs0_3d + 16) = wsbio3  (ji,jj,jk)           * tmask(ji,jj,jk) 
    302                trc3d(ji,jj,jk,jp_pcs0_3d + 17) = wsbio4  (ji,jj,jk)           * tmask(ji,jj,jk) 
    303             ENDDO 
    304          ENDDO 
    305       ENDDO 
     289      iksed1 = iksed + 1 
     290#  if ! defined key_iomput 
     291      trc2d(:,:  ,jp_pcs0_2d + 4)  = sinking (:,:,iksed1) * zrfact2 * tmask(:,:,1) 
     292      trc2d(:,:  ,jp_pcs0_2d + 5)  = sinking2(:,:,iksed1) * zrfact2 * tmask(:,:,1) 
     293      trc2d(:,:  ,jp_pcs0_2d + 6)  = sinkfer (:,:,iksed1) * zrfact2 * tmask(:,:,1) 
     294      trc2d(:,:  ,jp_pcs0_2d + 7)  = sinksil (:,:,iksed1) * zrfact2 * tmask(:,:,1) 
     295      trc2d(:,:  ,jp_pcs0_2d + 8)  = sinkcal (:,:,iksed1) * zrfact2 * tmask(:,:,1) 
     296      trc3d(:,:,:,jp_pcs0_3d + 11) = sinking (:,:,:)      * zrfact2 * tmask(:,:,:) 
     297      trc3d(:,:,:,jp_pcs0_3d + 12) = sinking2(:,:,:)      * zrfact2 * tmask(:,:,:) 
     298      trc3d(:,:,:,jp_pcs0_3d + 13) = sinksil (:,:,:)      * zrfact2 * tmask(:,:,:) 
     299      trc3d(:,:,:,jp_pcs0_3d + 14) = sinkcal (:,:,:)      * zrfact2 * tmask(:,:,:) 
     300      trc3d(:,:,:,jp_pcs0_3d + 15) = znum3d  (:,:,:)                * tmask(:,:,:) 
     301      trc3d(:,:,:,jp_pcs0_3d + 16) = wsbio3  (:,:,:)                * tmask(:,:,:) 
     302      trc3d(:,:,:,jp_pcs0_3d + 17) = wsbio4  (:,:,:)                * tmask(:,:,:) 
     303#else 
     304      zw2d(:,:  )  = sinking (:,:,iksed1) * zrfact2 * tmask(:,:,1) 
     305      IF( jnt == nrdttrc ) CALL iom_put( "PMO", zw2d ) 
     306      zw2d(:,:  )  = sinking2(:,:,iksed1) * zrfact2 * tmask(:,:,1) 
     307      IF( jnt == nrdttrc ) CALL iom_put( "PMO2", zw2d ) 
     308      zw2d(:,:  )  = sinkfer (:,:,iksed1) * zrfact2 * tmask(:,:,1) 
     309      IF( jnt == nrdttrc ) CALL iom_put( "ExpFe1", zw2d ) 
     310      zw2d(:,:  )  = sinksil (:,:,iksed1) * zrfact2 * tmask(:,:,1) 
     311      IF( jnt == nrdttrc ) CALL iom_put( "ExpSi", zw2d ) 
     312      zw2d(:,:  )  = sinkcal (:,:,iksed1) * zrfact2 * tmask(:,:,1) 
     313      IF( jnt == nrdttrc ) CALL iom_put( "ExpCaCO3", zw2d ) 
     314      zw3d(:,:,:)  = sinking (:,:,:)      * zrfact2 * tmask(:,:,:) 
     315      IF( jnt == nrdttrc ) CALL iom_put( "POCFlx", zw3d ) 
     316      zw3d(:,:,:)  = sinking2(:,:,:)      * zrfact2 * tmask(:,:,:) 
     317      IF( jnt == nrdttrc ) CALL iom_put( "GOCFlx", zw3d ) 
     318      zw3d(:,:,:)  = sinksil (:,:,:)      * zrfact2 * tmask(:,:,:) 
     319      IF( jnt == nrdttrc ) CALL iom_put( "SiFlx", zw3d ) 
     320      zw3d(:,:,:)  = sinkcal (:,:,:)      * zrfact2 * tmask(:,:,:) 
     321      IF( jnt == nrdttrc ) CALL iom_put( "CaCO3Flx", zw3d ) 
     322      zw3d(:,:,:)  = znum3d  (:,:,:)                * tmask(:,:,:) 
     323      IF( jnt == nrdttrc ) CALL iom_put( "xnum", zw3d ) 
     324      zw3d(:,:,:)  = wsbio3  (:,:,:)                * tmask(:,:,:) 
     325      IF( jnt == nrdttrc ) CALL iom_put( "W1", zw3d ) 
     326      zw3d(:,:,:)  = wsbio4  (:,:,:)                * tmask(:,:,:) 
     327      IF( jnt == nrdttrc ) CALL iom_put( "W2", zw3d ) 
    306328#  endif 
    307329 
    … …  
    463485      INTEGER, INTENT(in) :: kt, jnt 
    464486      INTEGER  ::   ji, jj, jk 
    465       INTEGER  ::   iksed 
    466487      REAL(wp) ::   zagg1, zagg2, zagg3, zagg4 
    467488      REAL(wp) ::   zagg , zaggfe, zaggdoc, zaggdoc2 
    … …  
    469490#if defined key_trc_dia3d 
    470491      REAL(wp) ::   zrfact2 
     492      INTEGER  ::   iksed1 
     493#endif 
     494#if defined key_iomput 
     495      REAL(wp), DIMENSION(jpi,jpj) ::   zw2d 
    471496#endif 
    472497      CHARACTER (len=25) :: charout 
    … …  
    481506!    by data and from the coagulation theory 
    482507!    ----------------------------------------------------------- 
    483  
    484       iksed = 10 
    485  
    486508      DO jk = 1, jpkm1 
    487509         DO jj = 1, jpj 
    … …  
    546568            DO ji = 1, jpi 
    547569               zfact = xstep * xdiss(ji,jj,jk) 
    548  
    549 !    Part I : Coagulation dependent on turbulence 
    550 !    ---------------------------------------------- 
    551  
     570               !  Part I : Coagulation dependent on turbulence 
    552571# if defined key_off_degrad 
    553572               zagg1 = 940.* zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) * facvol(ji,jj,jk) 
     573               zagg2 = 1.054e4 * zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) * facvol(ji,jj,jk) 
    554574# else 
    555575               zagg1 = 940.* zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) 
    556 # endif 
    557  
    558 # if defined key_off_degrad 
    559                zagg2 = 1.054e4 * zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) * facvol(ji,jj,jk) 
    560 # else 
    561576               zagg2 = 1.054e4 * zfact * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) 
    562577# endif 
    563578 
    564 !    Aggregation of small into large particles 
    565 !    Part II : Differential settling 
    566 !    ---------------------------------------------- 
    567  
     579               ! Part II : Differential settling 
     580 
     581               !  Aggregation of small into large particles 
    568582# if defined key_off_degrad 
    569583               zagg3 = 0.66 * xstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) * facvol(ji,jj,jk) 
     584               zagg4 = 0.e0 * xstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) * facvol(ji,jj,jk) 
    570585# else 
    571586               zagg3 = 0.66 * xstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jpgoc) 
    572 # endif 
    573  
    574 # if defined key_off_degrad 
    575                zagg4 = 0.e0 * xstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) * facvol(ji,jj,jk) 
    576 # else 
    577587               zagg4 = 0.e0 * xstep * trn(ji,jj,jk,jppoc) * trn(ji,jj,jk,jppoc) 
    578588# endif 
    579  
    580589               zagg   = zagg1 + zagg2 + zagg3 + zagg4 
    581590               zaggfe = zagg * trn(ji,jj,jk,jpsfe) / ( trn(ji,jj,jk,jppoc) + rtrn ) 
    582591 
    583 !     Aggregation of DOC to small particles 
    584 !     -------------------------------------- 
    585  
     592               ! Aggregation of DOC to small particles 
     593#if defined key_off_degrad 
    586594               zaggdoc = ( 80.* trn(ji,jj,jk,jpdoc) + 698. * trn(ji,jj,jk,jppoc) )       & 
    587 # if defined key_off_degrad 
    588                   &      * facvol(ji,jj,jk)                           & 
    589 # endif 
    590                   &      * zfact * trn(ji,jj,jk,jpdoc) 
    591  
     595                  &      * facvol(ji,jj,jk)  * zfact * trn(ji,jj,jk,jpdoc) 
    592596               zaggdoc2 = 1.05e4 * zfact * trn(ji,jj,jk,jpgoc)   & 
    593 # if defined key_off_degrad 
    594                   &        * facvol(ji,jj,jk)                            & 
    595 # endif       
    596                   &        * trn(ji,jj,jk,jpdoc) 
    597 ! 
    598 !  Update the trends 
    599 !  ----------------- 
    600 ! 
     597                  &      * facvol(ji,jj,jk) * trn(ji,jj,jk,jpdoc) 
     598#else 
     599               zaggdoc = ( 80.* trn(ji,jj,jk,jpdoc) + 698. * trn(ji,jj,jk,jppoc) )    & 
     600                  &      *  zfact * trn(ji,jj,jk,jpdoc) 
     601               zaggdoc2 = 1.05e4 * zfact * trn(ji,jj,jk,jpgoc) * trn(ji,jj,jk,jpdoc) 
     602#endif 
     603               !  Update the trends 
    601604               tra(ji,jj,jk,jppoc) = tra(ji,jj,jk,jppoc) - zagg + zaggdoc 
    602605               tra(ji,jj,jk,jpgoc) = tra(ji,jj,jk,jpgoc) + zagg + zaggdoc2 
    … …  
    604607               tra(ji,jj,jk,jpbfe) = tra(ji,jj,jk,jpbfe) + zaggfe 
    605608               tra(ji,jj,jk,jpdoc) = tra(ji,jj,jk,jpdoc) - zaggdoc - zaggdoc2 
    606  
     609               ! 
    607610            END DO 
    608611         END DO 
    609612      END DO 
    610613 
    611 # if defined key_trc_diaadd 
     614#if defined key_trc_diaadd 
    612615      zrfact2 = 1.e3 * rfact2r 
    613       DO jj = 1, jpj 
    614          DO ji = 1, jpi 
    615             trc2d(ji,jj, jp_pcs0_2d + 4) = sinking (ji,jj,iksed+1) * zrfact2 * tmask(ji,jj,1) 
    616             trc2d(ji,jj, jp_pcs0_2d + 5) = sinking2(ji,jj,iksed+1) * zrfact2 * tmask(ji,jj,1) 
    617             trc2d(ji,jj, jp_pcs0_2d + 6) = sinkfer (ji,jj,iksed+1) * zrfact2 * tmask(ji,jj,1) 
    618             trc2d(ji,jj, jp_pcs0_2d + 7) = sinkfer2(ji,jj,iksed+1) * zrfact2 * tmask(ji,jj,1) 
    619             trc2d(ji,jj, jp_pcs0_2d + 8) = sinksil (ji,jj,iksed+1) * zrfact2 * tmask(ji,jj,1) 
    620             trc2d(ji,jj, jp_pcs0_2d + 9) = sinkcal (ji,jj,iksed+1) * zrfact2 * tmask(ji,jj,1) 
    621          ENDDO 
    622       ENDDO 
    623 # endif 
     616      iksed1 = iksed + 1 
     617#  if ! defined key_iomput 
     618      trc2d(:,:,jp_pcs0_2d + 4) = sinking (:,:,iksed1) * zrfact2 * tmask(:,:,1) 
     619      trc2d(:,:,jp_pcs0_2d + 5) = sinking2(:,:,iksed1) * zrfact2 * tmask(:,:,1) 
     620      trc2d(:,:,jp_pcs0_2d + 6) = sinkfer (:,:,iksed1) * zrfact2 * tmask(:,:,1) 
     621      trc2d(:,:,jp_pcs0_2d + 7) = sinkfer2(:,:,iksed1) * zrfact2 * tmask(:,:,1) 
     622      trc2d(:,:,jp_pcs0_2d + 8) = sinksil (:,:,iksed1) * zrfact2 * tmask(:,:,1) 
     623      trc2d(:,:,jp_pcs0_2d + 9) = sinkcal (:,:,iksed1) * zrfact2 * tmask(:,:,1) 
     624#  else 
     625      ! write diagnostics  
     626      zw2d(:,:) = sinking (:,:,iksed1) * zrfact2 * tmask(:,:,1) 
     627      IF( jnt == nrdttrc ) CALL iom_put( "PMO", zw2d ) 
     628      zw2d(:,:) = sinking2(:,:,iksed1) * zrfact2 * tmask(:,:,1) 
     629      IF( jnt == nrdttrc ) CALL iom_put( "PMO2", zw2d ) 
     630      zw2d(:,:) = sinkfer (:,:,iksed1) * zrfact2 * tmask(:,:,1) 
     631      IF( jnt == nrdttrc ) CALL iom_put( "ExpFe1", zw2d ) 
     632      zw2d(:,:) = sinkfer2(:,:,iksed1) * zrfact2 * tmask(:,:,1) 
     633      IF( jnt == nrdttrc ) CALL iom_put( "ExpFe2", zw2d ) 
     634      zw2d(:,:) = sinksil (:,:,iksed1) * zrfact2 * tmask(:,:,1) 
     635      IF( jnt == nrdttrc ) CALL iom_put( "ExpSi", zw2d ) 
     636      zw2d(:,:) = sinkcal (:,:,iksed1) * zrfact2 * tmask(:,:,1) 
     637      IF( jnt == nrdttrc ) CALL iom_put( "ExpCaCO3", zw2d ) 
     638#  endif 
     639#endif 
    624640      ! 
    625641       IF(ln_ctl)   THEN  ! print mean trends (used for debugging) 

  • trunk/NEMO/TOP_SRC/PISCES/trclsm_pisces.F90

    r1288 r1457  
    4747      CHARACTER (len=32) ::  clname 
    4848      !! 
    49 #if defined key_trc_diaadd 
     49#if defined key_trc_diaadd && ! defined key_iomput 
    5050      INTEGER ::  jl, jn 
    5151      ! definition of additional diagnostic as a structure 
    … …  
    6464      NAMELIST/nampiskrp/ xkr_eta, xkr_zeta, xkr_mass_min, xkr_mass_max 
    6565#endif 
    66 #if defined key_trc_diaadd 
     66#if defined key_trc_diaadd && ! defined key_iomput 
    6767      NAMELIST/nampisdia/ nwritedia, pisdia3d, pisdia2d     ! additional diagnostics 
    6868#endif 
    … …  
    122122#endif 
    123123      ! 
    124 #if defined key_trc_diaadd 
     124#if defined key_trc_diaadd && ! defined key_iomput 
    125125 
    126126      ! Namelist namlobdia 

  • trunk/NEMO/TOP_SRC/trc.F90

    r1283 r1457  
    6464   INTEGER , PUBLIC ::   nwritetrc   !: time step frequency for concentration outputs (namelist) 
    6565    
    66 # if defined key_trc_diaadd 
     66# if defined key_trc_diaadd && ! defined key_iomput 
    6767   !! additional 2D/3D outputs namelist 
    6868   !! -------------------------------------------------- 

  • trunk/NEMO/TOP_SRC/trcdia.F90

    r1450 r1457  
    1111   !!                  !  2008-05 (C. Ethe re-organization) 
    1212   !!---------------------------------------------------------------------- 
    13 #if defined key_top 
     13#if defined key_top && ! defined key_iomput 
    1414   !!---------------------------------------------------------------------- 
    1515   !!   'key_top'                                                TOP models 
    … …  
    2929   USE lib_mpp 
    3030   USE ioipsl 
    31    USE iom 
    3231 
    3332   IMPLICIT NONE 
    … …  
    7069CONTAINS 
    7170 
    72    SUBROUTINE trc_dia( kt, kindic )   
     71   SUBROUTINE trc_dia( kt )   
    7372      !!--------------------------------------------------------------------- 
    7473      !!                     ***  ROUTINE trc_dia  *** 
    … …  
    7675      !! ** Purpose :   output passive tracers fields  
    7776      !!--------------------------------------------------------------------- 
    78       INTEGER, INTENT( in ) :: kt, kindic 
     77      INTEGER, INTENT( in ) :: kt 
     78      INTEGER               :: kindic 
    7979      !!--------------------------------------------------------------------- 
    8080       
    … …  
    117117      ! Initialisation 
    118118      ! -------------- 
    119  
    120       CALL iom_setkt( kt + ndttrc - 1 ) 
    121119 
    122120      ! local variable for debugging 
    … …  
    212210         cltra = ctrcnm(jn)      ! short title for tracer 
    213211         IF( lutsav(jn) ) CALL histwrite( nit5, cltra, it, trn(:,:,:,jn), ndimt50, ndext50 ) 
    214          CALL iom_put( ctrcnm(jn), trn(:,:,:,jn) ) 
    215212      END DO 
    216213 
    … …  
    219216      IF( kt == nitend .OR. kindic < 0 )   CALL histclo( nit5 ) 
    220217      ! 
    221       CALL iom_setkt( kt ) 
    222218 
    223219   END SUBROUTINE trcdit_wr 
    … …  
    257253      ! ----------------- 
    258254       
    259       CALL iom_setkt( kt + ndttrc - 1 ) 
    260255 
    261256      ! local variable for debugging 
    … …  
    445440            END DO 
    446441         END IF 
    447          CALL iom_put( ctrcnm(jn), trn(:,:,:,jn) ) 
    448442      END DO 
    449443 
    … …  
    456450      ENDIF 
    457451      ! 
    458       CALL iom_setkt( kt ) 
    459452 
    460453   END SUBROUTINE trcdid_wr 
    … …  
    500493      ! Initialisation 
    501494      ! -------------- 
    502     
    503       CALL iom_setkt( kt + ndttrc - 1 ) 
    504495       
    505496      ! local variable for debugging 
    … …  
    597588         cltra = ctrc3d(jl)   ! short title for 3D diagnostic 
    598589         CALL histwrite( nitd, cltra, it, trc3d(:,:,:,jl), ndimt50 ,ndext50) 
    599          CALL iom_put( cltra, trc3d(:,:,:,jl) ) 
    600590      END DO 
    601591 
    … …  
    604594         cltra = ctrc2d(jl)   ! short title for 2D diagnostic 
    605595         CALL histwrite(nitd, cltra, it, trc2d(:,:,jl), ndimt51  ,ndext51) 
    606          CALL iom_put( cltra, trc2d(:,:,jl) ) 
    607596      END DO 
    608597 
    … …  
    611600      IF( kt == nitend .OR. kindic < 0 )   CALL histclo(nitd) 
    612601      ! 
    613       CALL iom_setkt( kt ) 
    614602 
    615603   END SUBROUTINE trcdii_wr 
    … …  
    657645      ! -------------- 
    658646 
    659       CALL iom_setkt( kt + ndttrc - 1 ) 
    660647       
    661648      ! local variable for debugging 
    … …  
    735722         cltra = ctrbio(jl)  ! short title for biological diagnostic 
    736723         CALL histwrite(nitb, cltra, it, trbio(:,:,:,jl), ndimt50,ndext50) 
    737          CALL iom_put( cltra, trbio(:,:,:,jl) ) 
    738724      END DO 
    739725 
    … …  
    742728      IF( kt == nitend .OR. kindic < 0 )   CALL histclo( nitb ) 
    743729      ! 
    744       CALL iom_setkt( kt ) 
    745730 
    746731   END SUBROUTINE trcdib_wr 
    … …  
    759744   !!---------------------------------------------------------------------- 
    760745CONTAINS 
    761    SUBROUTINE trc_dia                      ! Empty routine    
     746   SUBROUTINE trc_dia( kt )                      ! Empty routine    
     747      INTEGER, INTENT(in) :: kt 
    762748   END SUBROUTINE trc_dia    
    763749 

  • trunk/NEMO/TOP_SRC/trcini.F90

    r1286 r1457  
    2727   USE trcini_c14b     ! C14 bomb initialisation 
    2828   USE trcini_my_trc   ! MY_TRC   initialisation 
    29    USE trcdta     
     29   USE trcdta    
     30#if defined key_off_tra  
     31   USE daymod 
     32#endif 
    3033   USE zpshde_trc      ! partial step: hor. derivative  
    3134   USE in_out_manager  ! I/O manager 
    … …  
    107110 
    108111      IF( .NOT. lrsttr ) THEN  
     112#if defined key_off_tra 
     113         CALL day_init      ! calendar 
     114#endif 
    109115# if defined key_dtatrc 
    110116         ! Initialization of tracer from a file that may also be used for damping 
    … …  
    117123      ELSE 
    118124         CALL trc_rst_read      ! restart from a file 
     125#if defined key_off_tra 
     126         CALL day_init          ! calendar 
     127#endif 
    119128      ENDIF 
    120129 

  • trunk/NEMO/TOP_SRC/trcrst.F90

    r1329 r1457  
    154154                  zco3    = ( zcaralk - trn(ji,jj,jk,jpdic) ) * ztmas + 0.5e-3 * ztmas1 
    155155                  zbicarb = ( 2. * trn(ji,jj,jk,jpdic) - zcaralk ) 
    156 !!                  write(numout,*) 'plante :',ji,jj,jk,ztmas,ztmas1,ak23(ji,jj,jk),zbicarb ,zco3 
    157156                  hi(ji,jj,jk) = ( ak23(ji,jj,jk) * zbicarb / zco3 ) * ztmas + 1.e-9 * ztmas1 
    158157               END DO 
Note: See TracChangeset for help on using the changeset viewer.